{-# LANGUAGE DeriveAnyClass #-}
{-# LANGUAGE DeriveGeneric #-}

-- | Combine all Byron transaction types into single union type
--
-- Intended for qualified import
--
-- > import           Ouroboros.Consensus.ByronSpec.Ledger.GenTx (ByronSpecGenTx(..), ByronSpecGenTxErr(..))
-- > import qualified Ouroboros.Consensus.ByronSpec.Ledger.GenTx as GenTx
module Ouroboros.Consensus.ByronSpec.Ledger.GenTx (
    ByronSpecGenTx (..)
  , ByronSpecGenTxErr (..)
  , apply
  , partition
  ) where

import qualified Byron.Spec.Chain.STS.Rule.Chain as Spec
import qualified Byron.Spec.Ledger.Delegation as Spec
import qualified Byron.Spec.Ledger.Update as Spec
import qualified Byron.Spec.Ledger.UTxO as Spec
import           Codec.Serialise
import           Control.Monad.Trans.Except
import qualified Control.State.Transition as Spec
import           Data.List.NonEmpty (NonEmpty)
import           GHC.Generics (Generic)
import           Ouroboros.Consensus.ByronSpec.Ledger.Genesis
                     (ByronSpecGenesis (..))
import           Ouroboros.Consensus.ByronSpec.Ledger.Orphans ()
import qualified Ouroboros.Consensus.ByronSpec.Ledger.Rules as Rules

{-------------------------------------------------------------------------------
  Types
-------------------------------------------------------------------------------}

-- | Generalized transaction
--
-- The spec doesn't have a type for this, instead splitting the block body
-- into separate lists
data ByronSpecGenTx =
    ByronSpecGenTxDCert Spec.DCert
  | ByronSpecGenTxTx    Spec.Tx
  | ByronSpecGenTxUProp Spec.UProp
  | ByronSpecGenTxVote  Spec.Vote
  deriving (Int -> ByronSpecGenTx -> ShowS
[ByronSpecGenTx] -> ShowS
ByronSpecGenTx -> String
(Int -> ByronSpecGenTx -> ShowS)
-> (ByronSpecGenTx -> String)
-> ([ByronSpecGenTx] -> ShowS)
-> Show ByronSpecGenTx
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> ByronSpecGenTx -> ShowS
showsPrec :: Int -> ByronSpecGenTx -> ShowS
$cshow :: ByronSpecGenTx -> String
show :: ByronSpecGenTx -> String
$cshowList :: [ByronSpecGenTx] -> ShowS
showList :: [ByronSpecGenTx] -> ShowS
Show, (forall x. ByronSpecGenTx -> Rep ByronSpecGenTx x)
-> (forall x. Rep ByronSpecGenTx x -> ByronSpecGenTx)
-> Generic ByronSpecGenTx
forall x. Rep ByronSpecGenTx x -> ByronSpecGenTx
forall x. ByronSpecGenTx -> Rep ByronSpecGenTx x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. ByronSpecGenTx -> Rep ByronSpecGenTx x
from :: forall x. ByronSpecGenTx -> Rep ByronSpecGenTx x
$cto :: forall x. Rep ByronSpecGenTx x -> ByronSpecGenTx
to :: forall x. Rep ByronSpecGenTx x -> ByronSpecGenTx
Generic, [ByronSpecGenTx] -> Encoding
ByronSpecGenTx -> Encoding
(ByronSpecGenTx -> Encoding)
-> (forall s. Decoder s ByronSpecGenTx)
-> ([ByronSpecGenTx] -> Encoding)
-> (forall s. Decoder s [ByronSpecGenTx])
-> Serialise ByronSpecGenTx
forall s. Decoder s [ByronSpecGenTx]
forall s. Decoder s ByronSpecGenTx
forall a.
(a -> Encoding)
-> (forall s. Decoder s a)
-> ([a] -> Encoding)
-> (forall s. Decoder s [a])
-> Serialise a
$cencode :: ByronSpecGenTx -> Encoding
encode :: ByronSpecGenTx -> Encoding
$cdecode :: forall s. Decoder s ByronSpecGenTx
decode :: forall s. Decoder s ByronSpecGenTx
$cencodeList :: [ByronSpecGenTx] -> Encoding
encodeList :: [ByronSpecGenTx] -> Encoding
$cdecodeList :: forall s. Decoder s [ByronSpecGenTx]
decodeList :: forall s. Decoder s [ByronSpecGenTx]
Serialise)

-- | Transaction errors
--
-- We don't distinguish these from any other kind of CHAIN failure.
newtype ByronSpecGenTxErr = ByronSpecGenTxErr {
      ByronSpecGenTxErr -> NonEmpty (PredicateFailure CHAIN)
unByronSpecGenTxErr :: (NonEmpty (Spec.PredicateFailure Spec.CHAIN))
    }
  deriving (Int -> ByronSpecGenTxErr -> ShowS
[ByronSpecGenTxErr] -> ShowS
ByronSpecGenTxErr -> String
(Int -> ByronSpecGenTxErr -> ShowS)
-> (ByronSpecGenTxErr -> String)
-> ([ByronSpecGenTxErr] -> ShowS)
-> Show ByronSpecGenTxErr
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> ByronSpecGenTxErr -> ShowS
showsPrec :: Int -> ByronSpecGenTxErr -> ShowS
$cshow :: ByronSpecGenTxErr -> String
show :: ByronSpecGenTxErr -> String
$cshowList :: [ByronSpecGenTxErr] -> ShowS
showList :: [ByronSpecGenTxErr] -> ShowS
Show, (forall x. ByronSpecGenTxErr -> Rep ByronSpecGenTxErr x)
-> (forall x. Rep ByronSpecGenTxErr x -> ByronSpecGenTxErr)
-> Generic ByronSpecGenTxErr
forall x. Rep ByronSpecGenTxErr x -> ByronSpecGenTxErr
forall x. ByronSpecGenTxErr -> Rep ByronSpecGenTxErr x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. ByronSpecGenTxErr -> Rep ByronSpecGenTxErr x
from :: forall x. ByronSpecGenTxErr -> Rep ByronSpecGenTxErr x
$cto :: forall x. Rep ByronSpecGenTxErr x -> ByronSpecGenTxErr
to :: forall x. Rep ByronSpecGenTxErr x -> ByronSpecGenTxErr
Generic, [ByronSpecGenTxErr] -> Encoding
ByronSpecGenTxErr -> Encoding
(ByronSpecGenTxErr -> Encoding)
-> (forall s. Decoder s ByronSpecGenTxErr)
-> ([ByronSpecGenTxErr] -> Encoding)
-> (forall s. Decoder s [ByronSpecGenTxErr])
-> Serialise ByronSpecGenTxErr
forall s. Decoder s [ByronSpecGenTxErr]
forall s. Decoder s ByronSpecGenTxErr
forall a.
(a -> Encoding)
-> (forall s. Decoder s a)
-> ([a] -> Encoding)
-> (forall s. Decoder s [a])
-> Serialise a
$cencode :: ByronSpecGenTxErr -> Encoding
encode :: ByronSpecGenTxErr -> Encoding
$cdecode :: forall s. Decoder s ByronSpecGenTxErr
decode :: forall s. Decoder s ByronSpecGenTxErr
$cencodeList :: [ByronSpecGenTxErr] -> Encoding
encodeList :: [ByronSpecGenTxErr] -> Encoding
$cdecodeList :: forall s. Decoder s [ByronSpecGenTxErr]
decodeList :: forall s. Decoder s [ByronSpecGenTxErr]
Serialise)

{-------------------------------------------------------------------------------
  Functions
-------------------------------------------------------------------------------}

apply :: ByronSpecGenesis
      -> ByronSpecGenTx
      -> Spec.State Spec.CHAIN
      -> Except ByronSpecGenTxErr (Spec.State Spec.CHAIN)
apply :: ByronSpecGenesis
-> ByronSpecGenTx
-> State CHAIN
-> Except ByronSpecGenTxErr (State CHAIN)
apply ByronSpecGenesis
cfg = \ByronSpecGenTx
genTx -> (NonEmpty ChainPredicateFailure -> ByronSpecGenTxErr)
-> Except
     (NonEmpty ChainPredicateFailure)
     (Slot, Seq VKeyGenesis, Hash, UTxOState, DIState, UPIState)
-> Except
     ByronSpecGenTxErr
     (Slot, Seq VKeyGenesis, Hash, UTxOState, DIState, UPIState)
forall e e' a. (e -> e') -> Except e a -> Except e' a
withExcept NonEmpty ChainPredicateFailure -> ByronSpecGenTxErr
NonEmpty (PredicateFailure CHAIN) -> ByronSpecGenTxErr
ByronSpecGenTxErr (Except
   (NonEmpty ChainPredicateFailure)
   (Slot, Seq VKeyGenesis, Hash, UTxOState, DIState, UPIState)
 -> Except
      ByronSpecGenTxErr
      (Slot, Seq VKeyGenesis, Hash, UTxOState, DIState, UPIState))
-> ((Slot, Seq VKeyGenesis, Hash, UTxOState, DIState, UPIState)
    -> Except
         (NonEmpty ChainPredicateFailure)
         (Slot, Seq VKeyGenesis, Hash, UTxOState, DIState, UPIState))
-> (Slot, Seq VKeyGenesis, Hash, UTxOState, DIState, UPIState)
-> Except
     ByronSpecGenTxErr
     (Slot, Seq VKeyGenesis, Hash, UTxOState, DIState, UPIState)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByronSpecGenTx
-> (Slot, Seq VKeyGenesis, Hash, UTxOState, DIState, UPIState)
-> Except
     (NonEmpty ChainPredicateFailure)
     (Slot, Seq VKeyGenesis, Hash, UTxOState, DIState, UPIState)
go ByronSpecGenTx
genTx
  where
    go :: ByronSpecGenTx
-> State CHAIN
-> Except (NonEmpty (PredicateFailure CHAIN)) (State CHAIN)
go (ByronSpecGenTxDCert DCert
dcert) = ByronSpecGenesis -> LiftedRule SDELEG
Rules.liftSDELEG  ByronSpecGenesis
cfg DCert
Signal SDELEG
dcert
    go (ByronSpecGenTxTx    Tx
tx   ) = ByronSpecGenesis -> LiftedRule UTXOW
Rules.liftUTXOW   ByronSpecGenesis
cfg Tx
Signal UTXOW
tx
    go (ByronSpecGenTxUProp UProp
prop ) = ByronSpecGenesis -> LiftedRule UPIREG
Rules.liftUPIREG  ByronSpecGenesis
cfg UProp
Signal UPIREG
prop
    go (ByronSpecGenTxVote  Vote
vote ) = ByronSpecGenesis -> LiftedRule UPIVOTE
Rules.liftUPIVOTE ByronSpecGenesis
cfg Vote
Signal UPIVOTE
vote

partition :: [ByronSpecGenTx]
          -> ( [Spec.DCert]
             , [Spec.Tx]
             , [Spec.UProp]
             , [Spec.Vote]
             )
partition :: [ByronSpecGenTx] -> ([DCert], [Tx], [UProp], [Vote])
partition = ([DCert], [Tx], [UProp], [Vote])
-> [ByronSpecGenTx] -> ([DCert], [Tx], [UProp], [Vote])
go ([], [], [], [])
  where
    go :: ([DCert], [Tx], [UProp], [Vote])
-> [ByronSpecGenTx] -> ([DCert], [Tx], [UProp], [Vote])
go ([DCert]
ds, [Tx]
ts, [UProp]
us, [Vote]
vs) []     = ([DCert] -> [DCert]
forall a. [a] -> [a]
reverse [DCert]
ds, [Tx] -> [Tx]
forall a. [a] -> [a]
reverse [Tx]
ts, [UProp] -> [UProp]
forall a. [a] -> [a]
reverse [UProp]
us, [Vote] -> [Vote]
forall a. [a] -> [a]
reverse [Vote]
vs)
    go ([DCert]
ds, [Tx]
ts, [UProp]
us, [Vote]
vs) (ByronSpecGenTx
g:[ByronSpecGenTx]
gs) =
        case ByronSpecGenTx
g of
          ByronSpecGenTxDCert DCert
d -> ([DCert], [Tx], [UProp], [Vote])
-> [ByronSpecGenTx] -> ([DCert], [Tx], [UProp], [Vote])
go (DCert
dDCert -> [DCert] -> [DCert]
forall a. a -> [a] -> [a]
:[DCert]
ds,   [Tx]
ts,   [UProp]
us,   [Vote]
vs) [ByronSpecGenTx]
gs
          ByronSpecGenTxTx    Tx
t -> ([DCert], [Tx], [UProp], [Vote])
-> [ByronSpecGenTx] -> ([DCert], [Tx], [UProp], [Vote])
go (  [DCert]
ds, Tx
tTx -> [Tx] -> [Tx]
forall a. a -> [a] -> [a]
:[Tx]
ts,   [UProp]
us,   [Vote]
vs) [ByronSpecGenTx]
gs
          ByronSpecGenTxUProp UProp
u -> ([DCert], [Tx], [UProp], [Vote])
-> [ByronSpecGenTx] -> ([DCert], [Tx], [UProp], [Vote])
go (  [DCert]
ds,   [Tx]
ts, UProp
uUProp -> [UProp] -> [UProp]
forall a. a -> [a] -> [a]
:[UProp]
us,   [Vote]
vs) [ByronSpecGenTx]
gs
          ByronSpecGenTxVote  Vote
v -> ([DCert], [Tx], [UProp], [Vote])
-> [ByronSpecGenTx] -> ([DCert], [Tx], [UProp], [Vote])
go (  [DCert]
ds,   [Tx]
ts,   [UProp]
us, Vote
vVote -> [Vote] -> [Vote]
forall a. a -> [a] -> [a]
:[Vote]
vs) [ByronSpecGenTx]
gs