{-# LANGUAGE DeriveAnyClass             #-}
{-# LANGUAGE DeriveGeneric              #-}
{-# LANGUAGE DerivingVia                #-}
{-# LANGUAGE GeneralizedNewtypeDeriving #-}
{-# LANGUAGE TypeFamilies               #-}

{-# OPTIONS_GHC -Wno-orphans #-}

module Ouroboros.Consensus.ByronSpec.Ledger.Mempool (
    -- * Type family instances
    GenTx (..)
  , Validated (..)
  ) where

import           Codec.Serialise
import           GHC.Generics (Generic)
import           NoThunks.Class (AllowThunk (..), NoThunks)

import           Ouroboros.Consensus.Ledger.SupportsMempool

import           Ouroboros.Consensus.ByronSpec.Ledger.Block
import           Ouroboros.Consensus.ByronSpec.Ledger.GenTx
                     (ByronSpecGenTx (..), ByronSpecGenTxErr (..))
import qualified Ouroboros.Consensus.ByronSpec.Ledger.GenTx as GenTx
import           Ouroboros.Consensus.ByronSpec.Ledger.Ledger
import           Ouroboros.Consensus.ByronSpec.Ledger.Orphans ()

newtype instance GenTx ByronSpecBlock = ByronSpecGenTx {
      GenTx ByronSpecBlock -> ByronSpecGenTx
unByronSpecGenTx :: ByronSpecGenTx
    }
  deriving stock (Int -> GenTx ByronSpecBlock -> ShowS
[GenTx ByronSpecBlock] -> ShowS
GenTx ByronSpecBlock -> String
(Int -> GenTx ByronSpecBlock -> ShowS)
-> (GenTx ByronSpecBlock -> String)
-> ([GenTx ByronSpecBlock] -> ShowS)
-> Show (GenTx ByronSpecBlock)
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [GenTx ByronSpecBlock] -> ShowS
$cshowList :: [GenTx ByronSpecBlock] -> ShowS
show :: GenTx ByronSpecBlock -> String
$cshow :: GenTx ByronSpecBlock -> String
showsPrec :: Int -> GenTx ByronSpecBlock -> ShowS
$cshowsPrec :: Int -> GenTx ByronSpecBlock -> ShowS
Show, (forall x. GenTx ByronSpecBlock -> Rep (GenTx ByronSpecBlock) x)
-> (forall x. Rep (GenTx ByronSpecBlock) x -> GenTx ByronSpecBlock)
-> Generic (GenTx ByronSpecBlock)
forall x. Rep (GenTx ByronSpecBlock) x -> GenTx ByronSpecBlock
forall x. GenTx ByronSpecBlock -> Rep (GenTx ByronSpecBlock) x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep (GenTx ByronSpecBlock) x -> GenTx ByronSpecBlock
$cfrom :: forall x. GenTx ByronSpecBlock -> Rep (GenTx ByronSpecBlock) x
Generic)
  deriving anyclass ([GenTx ByronSpecBlock] -> Encoding
GenTx ByronSpecBlock -> Encoding
(GenTx ByronSpecBlock -> Encoding)
-> (forall s. Decoder s (GenTx ByronSpecBlock))
-> ([GenTx ByronSpecBlock] -> Encoding)
-> (forall s. Decoder s [GenTx ByronSpecBlock])
-> Serialise (GenTx ByronSpecBlock)
forall s. Decoder s [GenTx ByronSpecBlock]
forall s. Decoder s (GenTx ByronSpecBlock)
forall a.
(a -> Encoding)
-> (forall s. Decoder s a)
-> ([a] -> Encoding)
-> (forall s. Decoder s [a])
-> Serialise a
decodeList :: Decoder s [GenTx ByronSpecBlock]
$cdecodeList :: forall s. Decoder s [GenTx ByronSpecBlock]
encodeList :: [GenTx ByronSpecBlock] -> Encoding
$cencodeList :: [GenTx ByronSpecBlock] -> Encoding
decode :: Decoder s (GenTx ByronSpecBlock)
$cdecode :: forall s. Decoder s (GenTx ByronSpecBlock)
encode :: GenTx ByronSpecBlock -> Encoding
$cencode :: GenTx ByronSpecBlock -> Encoding
Serialise)
  deriving Context -> GenTx ByronSpecBlock -> IO (Maybe ThunkInfo)
Proxy (GenTx ByronSpecBlock) -> String
(Context -> GenTx ByronSpecBlock -> IO (Maybe ThunkInfo))
-> (Context -> GenTx ByronSpecBlock -> IO (Maybe ThunkInfo))
-> (Proxy (GenTx ByronSpecBlock) -> String)
-> NoThunks (GenTx ByronSpecBlock)
forall a.
(Context -> a -> IO (Maybe ThunkInfo))
-> (Context -> a -> IO (Maybe ThunkInfo))
-> (Proxy a -> String)
-> NoThunks a
showTypeOf :: Proxy (GenTx ByronSpecBlock) -> String
$cshowTypeOf :: Proxy (GenTx ByronSpecBlock) -> String
wNoThunks :: Context -> GenTx ByronSpecBlock -> IO (Maybe ThunkInfo)
$cwNoThunks :: Context -> GenTx ByronSpecBlock -> IO (Maybe ThunkInfo)
noThunks :: Context -> GenTx ByronSpecBlock -> IO (Maybe ThunkInfo)
$cnoThunks :: Context -> GenTx ByronSpecBlock -> IO (Maybe ThunkInfo)
NoThunks via AllowThunk (GenTx ByronSpecBlock)

newtype instance Validated (GenTx ByronSpecBlock) = ValidatedByronSpecGenTx {
      Validated (GenTx ByronSpecBlock) -> GenTx ByronSpecBlock
forgetValidatedByronSpecGenTx :: GenTx ByronSpecBlock
    }
  deriving stock (Int -> Validated (GenTx ByronSpecBlock) -> ShowS
[Validated (GenTx ByronSpecBlock)] -> ShowS
Validated (GenTx ByronSpecBlock) -> String
(Int -> Validated (GenTx ByronSpecBlock) -> ShowS)
-> (Validated (GenTx ByronSpecBlock) -> String)
-> ([Validated (GenTx ByronSpecBlock)] -> ShowS)
-> Show (Validated (GenTx ByronSpecBlock))
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Validated (GenTx ByronSpecBlock)] -> ShowS
$cshowList :: [Validated (GenTx ByronSpecBlock)] -> ShowS
show :: Validated (GenTx ByronSpecBlock) -> String
$cshow :: Validated (GenTx ByronSpecBlock) -> String
showsPrec :: Int -> Validated (GenTx ByronSpecBlock) -> ShowS
$cshowsPrec :: Int -> Validated (GenTx ByronSpecBlock) -> ShowS
Show, (forall x.
 Validated (GenTx ByronSpecBlock)
 -> Rep (Validated (GenTx ByronSpecBlock)) x)
-> (forall x.
    Rep (Validated (GenTx ByronSpecBlock)) x
    -> Validated (GenTx ByronSpecBlock))
-> Generic (Validated (GenTx ByronSpecBlock))
forall x.
Rep (Validated (GenTx ByronSpecBlock)) x
-> Validated (GenTx ByronSpecBlock)
forall x.
Validated (GenTx ByronSpecBlock)
-> Rep (Validated (GenTx ByronSpecBlock)) x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x.
Rep (Validated (GenTx ByronSpecBlock)) x
-> Validated (GenTx ByronSpecBlock)
$cfrom :: forall x.
Validated (GenTx ByronSpecBlock)
-> Rep (Validated (GenTx ByronSpecBlock)) x
Generic)
  deriving anyclass Context -> Validated (GenTx ByronSpecBlock) -> IO (Maybe ThunkInfo)
Proxy (Validated (GenTx ByronSpecBlock)) -> String
(Context
 -> Validated (GenTx ByronSpecBlock) -> IO (Maybe ThunkInfo))
-> (Context
    -> Validated (GenTx ByronSpecBlock) -> IO (Maybe ThunkInfo))
-> (Proxy (Validated (GenTx ByronSpecBlock)) -> String)
-> NoThunks (Validated (GenTx ByronSpecBlock))
forall a.
(Context -> a -> IO (Maybe ThunkInfo))
-> (Context -> a -> IO (Maybe ThunkInfo))
-> (Proxy a -> String)
-> NoThunks a
showTypeOf :: Proxy (Validated (GenTx ByronSpecBlock)) -> String
$cshowTypeOf :: Proxy (Validated (GenTx ByronSpecBlock)) -> String
wNoThunks :: Context -> Validated (GenTx ByronSpecBlock) -> IO (Maybe ThunkInfo)
$cwNoThunks :: Context -> Validated (GenTx ByronSpecBlock) -> IO (Maybe ThunkInfo)
noThunks :: Context -> Validated (GenTx ByronSpecBlock) -> IO (Maybe ThunkInfo)
$cnoThunks :: Context -> Validated (GenTx ByronSpecBlock) -> IO (Maybe ThunkInfo)
NoThunks

type instance ApplyTxErr ByronSpecBlock = ByronSpecGenTxErr

instance LedgerSupportsMempool ByronSpecBlock where
  applyTx :: LedgerConfig ByronSpecBlock
-> WhetherToIntervene
-> SlotNo
-> GenTx ByronSpecBlock
-> Ticked (LedgerState ByronSpecBlock)
-> Except
     (ApplyTxErr ByronSpecBlock)
     (Ticked (LedgerState ByronSpecBlock),
      Validated (GenTx ByronSpecBlock))
applyTx LedgerConfig ByronSpecBlock
cfg WhetherToIntervene
_wti SlotNo
_slot GenTx ByronSpecBlock
tx (TickedByronSpecLedgerState tip st) =
        ((Slot, Seq VKeyGenesis, Hash, UTxOState, DIState, UPIState)
 -> (Ticked (LedgerState ByronSpecBlock),
     Validated (GenTx ByronSpecBlock)))
-> ExceptT
     ByronSpecGenTxErr
     Identity
     (Slot, Seq VKeyGenesis, Hash, UTxOState, DIState, UPIState)
-> ExceptT
     ByronSpecGenTxErr
     Identity
     (Ticked (LedgerState ByronSpecBlock),
      Validated (GenTx ByronSpecBlock))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (\(Slot, Seq VKeyGenesis, Hash, UTxOState, DIState, UPIState)
st' ->
               ( Maybe SlotNo -> State CHAIN -> Ticked (LedgerState ByronSpecBlock)
TickedByronSpecLedgerState Maybe SlotNo
tip (Slot, Seq VKeyGenesis, Hash, UTxOState, DIState, UPIState)
State CHAIN
st'
               , GenTx ByronSpecBlock -> Validated (GenTx ByronSpecBlock)
ValidatedByronSpecGenTx GenTx ByronSpecBlock
tx
               )
             )
      (ExceptT
   ByronSpecGenTxErr
   Identity
   (Slot, Seq VKeyGenesis, Hash, UTxOState, DIState, UPIState)
 -> ExceptT
      ByronSpecGenTxErr
      Identity
      (Ticked (LedgerState ByronSpecBlock),
       Validated (GenTx ByronSpecBlock)))
-> ExceptT
     ByronSpecGenTxErr
     Identity
     (Slot, Seq VKeyGenesis, Hash, UTxOState, DIState, UPIState)
-> ExceptT
     ByronSpecGenTxErr
     Identity
     (Ticked (LedgerState ByronSpecBlock),
      Validated (GenTx ByronSpecBlock))
forall a b. (a -> b) -> a -> b
$ ByronSpecGenesis
-> ByronSpecGenTx
-> State CHAIN
-> Except ByronSpecGenTxErr (State CHAIN)
GenTx.apply LedgerConfig ByronSpecBlock
ByronSpecGenesis
cfg (GenTx ByronSpecBlock -> ByronSpecGenTx
unByronSpecGenTx GenTx ByronSpecBlock
tx) State CHAIN
st

  -- Byron spec doesn't have multiple validation modes
  reapplyTx :: LedgerConfig ByronSpecBlock
-> SlotNo
-> Validated (GenTx ByronSpecBlock)
-> Ticked (LedgerState ByronSpecBlock)
-> Except
     (ApplyTxErr ByronSpecBlock) (Ticked (LedgerState ByronSpecBlock))
reapplyTx LedgerConfig ByronSpecBlock
cfg SlotNo
slot Validated (GenTx ByronSpecBlock)
vtx Ticked (LedgerState ByronSpecBlock)
st =
        ((Ticked (LedgerState ByronSpecBlock),
  Validated (GenTx ByronSpecBlock))
 -> Ticked (LedgerState ByronSpecBlock))
-> ExceptT
     ByronSpecGenTxErr
     Identity
     (Ticked (LedgerState ByronSpecBlock),
      Validated (GenTx ByronSpecBlock))
-> ExceptT
     ByronSpecGenTxErr Identity (Ticked (LedgerState ByronSpecBlock))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (Ticked (LedgerState ByronSpecBlock),
 Validated (GenTx ByronSpecBlock))
-> Ticked (LedgerState ByronSpecBlock)
forall a b. (a, b) -> a
fst
      (ExceptT
   ByronSpecGenTxErr
   Identity
   (Ticked (LedgerState ByronSpecBlock),
    Validated (GenTx ByronSpecBlock))
 -> ExceptT
      ByronSpecGenTxErr Identity (Ticked (LedgerState ByronSpecBlock)))
-> ExceptT
     ByronSpecGenTxErr
     Identity
     (Ticked (LedgerState ByronSpecBlock),
      Validated (GenTx ByronSpecBlock))
-> ExceptT
     ByronSpecGenTxErr Identity (Ticked (LedgerState ByronSpecBlock))
forall a b. (a -> b) -> a -> b
$ LedgerConfig ByronSpecBlock
-> WhetherToIntervene
-> SlotNo
-> GenTx ByronSpecBlock
-> Ticked (LedgerState ByronSpecBlock)
-> Except
     (ApplyTxErr ByronSpecBlock)
     (Ticked (LedgerState ByronSpecBlock),
      Validated (GenTx ByronSpecBlock))
forall blk.
LedgerSupportsMempool blk =>
LedgerConfig blk
-> WhetherToIntervene
-> SlotNo
-> GenTx blk
-> Ticked (LedgerState blk)
-> Except
     (ApplyTxErr blk) (Ticked (LedgerState blk), Validated (GenTx blk))
applyTx LedgerConfig ByronSpecBlock
cfg WhetherToIntervene
DoNotIntervene SlotNo
slot (Validated (GenTx ByronSpecBlock) -> GenTx ByronSpecBlock
forgetValidatedByronSpecGenTx Validated (GenTx ByronSpecBlock)
vtx) Ticked (LedgerState ByronSpecBlock)
st

  -- Dummy values, as these are not used in practice.
  txsMaxBytes :: Ticked (LedgerState ByronSpecBlock) -> Word32
txsMaxBytes   = Word32 -> Ticked (LedgerState ByronSpecBlock) -> Word32
forall a b. a -> b -> a
const Word32
forall a. Bounded a => a
maxBound
  txInBlockSize :: GenTx ByronSpecBlock -> Word32
txInBlockSize = Word32 -> GenTx ByronSpecBlock -> Word32
forall a b. a -> b -> a
const Word32
0

  txForgetValidated :: Validated (GenTx ByronSpecBlock) -> GenTx ByronSpecBlock
txForgetValidated = Validated (GenTx ByronSpecBlock) -> GenTx ByronSpecBlock
forgetValidatedByronSpecGenTx