{-# LANGUAGE DeriveAnyClass #-}
{-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE DerivingVia #-}
{-# 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.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 ()
import           Ouroboros.Consensus.Ledger.SupportsMempool

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
$cshowsPrec :: Int -> GenTx ByronSpecBlock -> ShowS
showsPrec :: Int -> GenTx ByronSpecBlock -> ShowS
$cshow :: GenTx ByronSpecBlock -> String
show :: GenTx ByronSpecBlock -> String
$cshowList :: [GenTx ByronSpecBlock] -> ShowS
showList :: [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
$cfrom :: forall x. GenTx ByronSpecBlock -> Rep (GenTx ByronSpecBlock) x
from :: forall x. GenTx ByronSpecBlock -> Rep (GenTx ByronSpecBlock) x
$cto :: forall x. Rep (GenTx ByronSpecBlock) x -> GenTx ByronSpecBlock
to :: forall x. Rep (GenTx ByronSpecBlock) x -> GenTx ByronSpecBlock
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
$cencode :: GenTx ByronSpecBlock -> Encoding
encode :: GenTx ByronSpecBlock -> Encoding
$cdecode :: forall s. Decoder s (GenTx ByronSpecBlock)
decode :: forall s. Decoder s (GenTx ByronSpecBlock)
$cencodeList :: [GenTx ByronSpecBlock] -> Encoding
encodeList :: [GenTx ByronSpecBlock] -> Encoding
$cdecodeList :: forall s. Decoder s [GenTx ByronSpecBlock]
decodeList :: forall s. Decoder s [GenTx ByronSpecBlock]
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
$cnoThunks :: Context -> GenTx ByronSpecBlock -> IO (Maybe ThunkInfo)
noThunks :: Context -> GenTx ByronSpecBlock -> IO (Maybe ThunkInfo)
$cwNoThunks :: Context -> GenTx ByronSpecBlock -> IO (Maybe ThunkInfo)
wNoThunks :: Context -> GenTx ByronSpecBlock -> IO (Maybe ThunkInfo)
$cshowTypeOf :: Proxy (GenTx ByronSpecBlock) -> String
showTypeOf :: Proxy (GenTx ByronSpecBlock) -> String
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
$cshowsPrec :: Int -> Validated (GenTx ByronSpecBlock) -> ShowS
showsPrec :: Int -> Validated (GenTx ByronSpecBlock) -> ShowS
$cshow :: Validated (GenTx ByronSpecBlock) -> String
show :: Validated (GenTx ByronSpecBlock) -> String
$cshowList :: [Validated (GenTx ByronSpecBlock)] -> ShowS
showList :: [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
$cfrom :: forall x.
Validated (GenTx ByronSpecBlock)
-> Rep (Validated (GenTx ByronSpecBlock)) x
from :: forall x.
Validated (GenTx ByronSpecBlock)
-> Rep (Validated (GenTx ByronSpecBlock)) x
$cto :: forall x.
Rep (Validated (GenTx ByronSpecBlock)) x
-> Validated (GenTx ByronSpecBlock)
to :: forall x.
Rep (Validated (GenTx ByronSpecBlock)) x
-> Validated (GenTx ByronSpecBlock)
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
$cnoThunks :: Context -> Validated (GenTx ByronSpecBlock) -> IO (Maybe ThunkInfo)
noThunks :: Context -> Validated (GenTx ByronSpecBlock) -> IO (Maybe ThunkInfo)
$cwNoThunks :: Context -> Validated (GenTx ByronSpecBlock) -> IO (Maybe ThunkInfo)
wNoThunks :: Context -> Validated (GenTx ByronSpecBlock) -> IO (Maybe ThunkInfo)
$cshowTypeOf :: Proxy (Validated (GenTx ByronSpecBlock)) -> String
showTypeOf :: Proxy (Validated (GenTx ByronSpecBlock)) -> String
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 Maybe SlotNo
tip State CHAIN
st) =
        (State CHAIN
 -> (Ticked (LedgerState ByronSpecBlock),
     Validated (GenTx ByronSpecBlock)))
-> ExceptT ByronSpecGenTxErr Identity (State CHAIN)
-> ExceptT
     ByronSpecGenTxErr
     Identity
     (Ticked (LedgerState ByronSpecBlock),
      Validated (GenTx ByronSpecBlock))
forall a b.
(a -> b)
-> ExceptT ByronSpecGenTxErr Identity a
-> ExceptT ByronSpecGenTxErr Identity b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (\State CHAIN
st' ->
               ( Maybe SlotNo -> State CHAIN -> Ticked (LedgerState ByronSpecBlock)
TickedByronSpecLedgerState Maybe SlotNo
tip State CHAIN
st'
               , GenTx ByronSpecBlock -> Validated (GenTx ByronSpecBlock)
ValidatedByronSpecGenTx GenTx ByronSpecBlock
tx
               )
             )
      (ExceptT ByronSpecGenTxErr Identity (State CHAIN)
 -> ExceptT
      ByronSpecGenTxErr
      Identity
      (Ticked (LedgerState ByronSpecBlock),
       Validated (GenTx ByronSpecBlock)))
-> ExceptT ByronSpecGenTxErr Identity (State CHAIN)
-> ExceptT
     ByronSpecGenTxErr
     Identity
     (Ticked (LedgerState ByronSpecBlock),
      Validated (GenTx ByronSpecBlock))
forall a b. (a -> b) -> a -> b
$ ByronSpecGenesis
-> ByronSpecGenTx
-> State CHAIN
-> ExceptT ByronSpecGenTxErr Identity (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 :: HasCallStack =>
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))
-> Except
     (ApplyTxErr ByronSpecBlock)
     (Ticked (LedgerState ByronSpecBlock),
      Validated (GenTx ByronSpecBlock))
-> Except
     (ApplyTxErr ByronSpecBlock) (Ticked (LedgerState ByronSpecBlock))
forall a b.
(a -> b)
-> ExceptT (ApplyTxErr ByronSpecBlock) Identity a
-> ExceptT (ApplyTxErr ByronSpecBlock) Identity b
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
      (Except
   (ApplyTxErr ByronSpecBlock)
   (Ticked (LedgerState ByronSpecBlock),
    Validated (GenTx ByronSpecBlock))
 -> Except
      (ApplyTxErr ByronSpecBlock) (Ticked (LedgerState ByronSpecBlock)))
-> Except
     (ApplyTxErr ByronSpecBlock)
     (Ticked (LedgerState ByronSpecBlock),
      Validated (GenTx ByronSpecBlock))
-> Except
     (ApplyTxErr ByronSpecBlock) (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

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

instance TxLimits ByronSpecBlock where
  type TxMeasure ByronSpecBlock = IgnoringOverflow ByteSize32

  -- Dummy values, as these are not used in practice.
  blockCapacityTxMeasure :: LedgerConfig ByronSpecBlock
-> Ticked (LedgerState ByronSpecBlock) -> TxMeasure ByronSpecBlock
blockCapacityTxMeasure LedgerConfig ByronSpecBlock
_cfg Ticked (LedgerState ByronSpecBlock)
_st = ByteSize32 -> IgnoringOverflow ByteSize32
forall a. a -> IgnoringOverflow a
IgnoringOverflow (ByteSize32 -> IgnoringOverflow ByteSize32)
-> ByteSize32 -> IgnoringOverflow ByteSize32
forall a b. (a -> b) -> a -> b
$ Word32 -> ByteSize32
ByteSize32 Word32
1

  txMeasure :: LedgerConfig ByronSpecBlock
-> Ticked (LedgerState ByronSpecBlock)
-> GenTx ByronSpecBlock
-> Except (ApplyTxErr ByronSpecBlock) (TxMeasure ByronSpecBlock)
txMeasure LedgerConfig ByronSpecBlock
_cfg Ticked (LedgerState ByronSpecBlock)
_st GenTx ByronSpecBlock
_tx = TxMeasure ByronSpecBlock
-> Except (ApplyTxErr ByronSpecBlock) (TxMeasure ByronSpecBlock)
forall a. a -> ExceptT (ApplyTxErr ByronSpecBlock) Identity a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (TxMeasure ByronSpecBlock
 -> Except (ApplyTxErr ByronSpecBlock) (TxMeasure ByronSpecBlock))
-> TxMeasure ByronSpecBlock
-> Except (ApplyTxErr ByronSpecBlock) (TxMeasure ByronSpecBlock)
forall a b. (a -> b) -> a -> b
$ ByteSize32 -> IgnoringOverflow ByteSize32
forall a. a -> IgnoringOverflow a
IgnoringOverflow (ByteSize32 -> IgnoringOverflow ByteSize32)
-> ByteSize32 -> IgnoringOverflow ByteSize32
forall a b. (a -> b) -> a -> b
$ Word32 -> ByteSize32
ByteSize32 Word32
0