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

-- | 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           Codec.Serialise
import           Control.Monad.Trans.Except
import           GHC.Generics (Generic)

import qualified Byron.Spec.Chain.STS.Rule.Chain as Spec
import qualified Byron.Spec.Ledger.Delegation as Spec
import qualified Byron.Spec.Ledger.UTxO as Spec
import qualified Byron.Spec.Ledger.Update as Spec
import qualified Control.State.Transition as Spec

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
showList :: [ByronSpecGenTx] -> ShowS
$cshowList :: [ByronSpecGenTx] -> ShowS
show :: ByronSpecGenTx -> String
$cshow :: ByronSpecGenTx -> String
showsPrec :: Int -> ByronSpecGenTx -> ShowS
$cshowsPrec :: Int -> 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
$cto :: forall x. Rep ByronSpecGenTx x -> ByronSpecGenTx
$cfrom :: forall x. ByronSpecGenTx -> Rep ByronSpecGenTx x
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
decodeList :: Decoder s [ByronSpecGenTx]
$cdecodeList :: forall s. Decoder s [ByronSpecGenTx]
encodeList :: [ByronSpecGenTx] -> Encoding
$cencodeList :: [ByronSpecGenTx] -> Encoding
decode :: Decoder s ByronSpecGenTx
$cdecode :: forall s. Decoder s ByronSpecGenTx
encode :: ByronSpecGenTx -> Encoding
$cencode :: ByronSpecGenTx -> Encoding
Serialise)

-- | Transaction errors
--
-- We don't distinguish these from any other kind of CHAIN failure.
newtype ByronSpecGenTxErr = ByronSpecGenTxErr {
      ByronSpecGenTxErr -> [PredicateFailure CHAIN]
unByronSpecGenTxErr :: [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
showList :: [ByronSpecGenTxErr] -> ShowS
$cshowList :: [ByronSpecGenTxErr] -> ShowS
show :: ByronSpecGenTxErr -> String
$cshow :: ByronSpecGenTxErr -> String
showsPrec :: Int -> ByronSpecGenTxErr -> ShowS
$cshowsPrec :: Int -> 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
$cto :: forall x. Rep ByronSpecGenTxErr x -> ByronSpecGenTxErr
$cfrom :: forall x. ByronSpecGenTxErr -> Rep ByronSpecGenTxErr x
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
decodeList :: Decoder s [ByronSpecGenTxErr]
$cdecodeList :: forall s. Decoder s [ByronSpecGenTxErr]
encodeList :: [ByronSpecGenTxErr] -> Encoding
$cencodeList :: [ByronSpecGenTxErr] -> Encoding
decode :: Decoder s ByronSpecGenTxErr
$cdecode :: forall s. Decoder s ByronSpecGenTxErr
encode :: ByronSpecGenTxErr -> Encoding
$cencode :: ByronSpecGenTxErr -> Encoding
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 -> ([ChainPredicateFailure] -> ByronSpecGenTxErr)
-> Except
     [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 [ChainPredicateFailure] -> ByronSpecGenTxErr
[PredicateFailure CHAIN] -> ByronSpecGenTxErr
ByronSpecGenTxErr (Except
   [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
         [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
     [ChainPredicateFailure]
     (Slot, Seq VKeyGenesis, Hash, UTxOState, DIState, UPIState)
go ByronSpecGenTx
genTx
  where
    go :: ByronSpecGenTx
-> (Slot, Seq VKeyGenesis, Hash, UTxOState, DIState, UPIState)
-> Except
     [ChainPredicateFailure]
     (Slot, Seq VKeyGenesis, Hash, UTxOState, DIState, UPIState)
go (ByronSpecGenTxDCert DCert
dcert) = ByronSpecGenesis -> LiftedRule SDELEG
Rules.liftSDELEG  ByronSpecGenesis
cfg Signal SDELEG
DCert
dcert
    go (ByronSpecGenTxTx    Tx
tx   ) = ByronSpecGenesis -> LiftedRule UTXOW
Rules.liftUTXOW   ByronSpecGenesis
cfg Signal UTXOW
Tx
tx
    go (ByronSpecGenTxUProp UProp
prop ) = ByronSpecGenesis -> LiftedRule UPIREG
Rules.liftUPIREG  ByronSpecGenesis
cfg Signal UPIREG
UProp
prop
    go (ByronSpecGenTxVote  Vote
vote ) = ByronSpecGenesis -> LiftedRule UPIVOTE
Rules.liftUPIVOTE ByronSpecGenesis
cfg Signal UPIVOTE
Vote
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