{-# LANGUAGE DataKinds #-}
{-# LANGUAGE DeriveAnyClass #-}
{-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE DerivingStrategies #-}
{-# LANGUAGE EmptyCase #-}
{-# LANGUAGE EmptyDataDeriving #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE GADTs #-}
{-# LANGUAGE GeneralizedNewtypeDeriving #-}
{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE NamedFieldPuns #-}
{-# LANGUAGE RankNTypes #-}
{-# LANGUAGE RecordWildCards #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE StandaloneDeriving #-}
{-# LANGUAGE TypeApplications #-}
{-# LANGUAGE TypeFamilies #-}
{-# LANGUAGE UndecidableInstances #-}

-- | Simple block to go with the mock ledger
--
-- None of the definitions in this module depend on, or even refer to, any
-- specific consensus protocols.
module Ouroboros.Consensus.Mock.Ledger.Block (
    BlockQuery (..)
  , Header (..)
  , SimpleBlock
  , SimpleBlock' (..)
  , SimpleBody (..)
  , SimpleHash
  , SimpleHeader
  , SimpleStdHeader (..)
    -- * Working with 'SimpleBlock'
  , countSimpleGenTxs
  , matchesSimpleHeader
  , mkSimpleHeader
    -- * Configuration
  , BlockConfig (..)
  , CodecConfig (..)
  , SimpleLedgerConfig (..)
  , StorageConfig (..)
    -- * Protocol-specific part
  , MockProtocolSpecific (..)
    -- * 'UpdateLedger'
  , LedgerState (..)
  , LedgerTables (..)
  , Ticked (..)
  , genesisSimpleLedgerState
  , updateSimpleLedgerState
    -- * 'ApplyTx' (mempool support)
  , GenTx (..)
  , TxId (..)
  , Validated (..)
  , genTxSize
  , mkSimpleGenTx
    -- * Crypto
  , SimpleCrypto
  , SimpleMockCrypto
  , SimpleStandardCrypto
    -- * Serialisation
  , decodeSimpleHeader
  , encodeSimpleHeader
  , simpleBlockBinaryBlockInfo
    -- * For tests
  , simpleBlockCapacity
  ) where

import           Cardano.Binary (ToCBOR (..))
import           Cardano.Crypto.Hash (Hash, HashAlgorithm, SHA256, ShortHash)
import qualified Cardano.Crypto.Hash as Hash
import qualified Codec.CBOR.Decoding as CBOR
import qualified Codec.CBOR.Encoding as CBOR
import           Codec.Serialise (Serialise (..), serialise)
import           Control.Monad.Except
import qualified Data.ByteString.Lazy as Lazy
import           Data.Kind (Type)
import           Data.Proxy
import           Data.Typeable
import           Data.Word
import           GHC.Generics (Generic)
import           GHC.TypeNats (KnownNat)
import           NoThunks.Class (NoThunks (..))
import           Ouroboros.Consensus.Block
import           Ouroboros.Consensus.Config
import           Ouroboros.Consensus.HardFork.Abstract
import           Ouroboros.Consensus.HardFork.Combinator.PartialConfig
import qualified Ouroboros.Consensus.HardFork.History as HardFork
import           Ouroboros.Consensus.HeaderValidation
import           Ouroboros.Consensus.Ledger.Abstract
import           Ouroboros.Consensus.Ledger.CommonProtocolParams
import           Ouroboros.Consensus.Ledger.Extended
import           Ouroboros.Consensus.Ledger.Inspect
import           Ouroboros.Consensus.Ledger.Query
import           Ouroboros.Consensus.Ledger.SupportsMempool
import           Ouroboros.Consensus.Ledger.SupportsPeerSelection
import           Ouroboros.Consensus.Ledger.Tables.Utils
import           Ouroboros.Consensus.Mock.Ledger.Address
import           Ouroboros.Consensus.Mock.Ledger.State
import qualified Ouroboros.Consensus.Mock.Ledger.UTxO as Mock
import           Ouroboros.Consensus.Node.Serialisation
import           Ouroboros.Consensus.Storage.Common (BinaryBlockInfo (..),
                     SizeInBytes)
import           Ouroboros.Consensus.Storage.LedgerDB
import           Ouroboros.Consensus.Util (ShowProxy (..), hashFromBytesShortE)
import           Ouroboros.Consensus.Util.Condense
import           Ouroboros.Consensus.Util.IndexedMemPack
import           Test.Util.Orphans.Serialise ()

{-------------------------------------------------------------------------------
  Definition of a block

  The primed versions allow to vary the @ext@ parameter independently of the
  previous block hash.
-------------------------------------------------------------------------------}

type SimpleBlock  c ext = SimpleBlock'  c ext ext
type SimpleHeader c ext = Header (SimpleBlock c ext)

data SimpleBlock' c ext ext' = SimpleBlock {
      forall c ext ext'.
SimpleBlock' c ext ext' -> Header (SimpleBlock' c ext ext')
simpleHeader :: Header (SimpleBlock' c ext ext')
    , forall c ext ext'. SimpleBlock' c ext ext' -> SimpleBody
simpleBody   :: SimpleBody
    }
  deriving ((forall x.
 SimpleBlock' c ext ext' -> Rep (SimpleBlock' c ext ext') x)
-> (forall x.
    Rep (SimpleBlock' c ext ext') x -> SimpleBlock' c ext ext')
-> Generic (SimpleBlock' c ext ext')
forall x.
Rep (SimpleBlock' c ext ext') x -> SimpleBlock' c ext ext'
forall x.
SimpleBlock' c ext ext' -> Rep (SimpleBlock' c ext ext') x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
forall c ext ext' x.
Rep (SimpleBlock' c ext ext') x -> SimpleBlock' c ext ext'
forall c ext ext' x.
SimpleBlock' c ext ext' -> Rep (SimpleBlock' c ext ext') x
$cfrom :: forall c ext ext' x.
SimpleBlock' c ext ext' -> Rep (SimpleBlock' c ext ext') x
from :: forall x.
SimpleBlock' c ext ext' -> Rep (SimpleBlock' c ext ext') x
$cto :: forall c ext ext' x.
Rep (SimpleBlock' c ext ext') x -> SimpleBlock' c ext ext'
to :: forall x.
Rep (SimpleBlock' c ext ext') x -> SimpleBlock' c ext ext'
Generic, Int -> SimpleBlock' c ext ext' -> ShowS
[SimpleBlock' c ext ext'] -> ShowS
SimpleBlock' c ext ext' -> String
(Int -> SimpleBlock' c ext ext' -> ShowS)
-> (SimpleBlock' c ext ext' -> String)
-> ([SimpleBlock' c ext ext'] -> ShowS)
-> Show (SimpleBlock' c ext ext')
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
forall c ext ext'.
(SimpleCrypto c, Show ext', Typeable ext) =>
Int -> SimpleBlock' c ext ext' -> ShowS
forall c ext ext'.
(SimpleCrypto c, Show ext', Typeable ext) =>
[SimpleBlock' c ext ext'] -> ShowS
forall c ext ext'.
(SimpleCrypto c, Show ext', Typeable ext) =>
SimpleBlock' c ext ext' -> String
$cshowsPrec :: forall c ext ext'.
(SimpleCrypto c, Show ext', Typeable ext) =>
Int -> SimpleBlock' c ext ext' -> ShowS
showsPrec :: Int -> SimpleBlock' c ext ext' -> ShowS
$cshow :: forall c ext ext'.
(SimpleCrypto c, Show ext', Typeable ext) =>
SimpleBlock' c ext ext' -> String
show :: SimpleBlock' c ext ext' -> String
$cshowList :: forall c ext ext'.
(SimpleCrypto c, Show ext', Typeable ext) =>
[SimpleBlock' c ext ext'] -> ShowS
showList :: [SimpleBlock' c ext ext'] -> ShowS
Show, SimpleBlock' c ext ext' -> SimpleBlock' c ext ext' -> Bool
(SimpleBlock' c ext ext' -> SimpleBlock' c ext ext' -> Bool)
-> (SimpleBlock' c ext ext' -> SimpleBlock' c ext ext' -> Bool)
-> Eq (SimpleBlock' c ext ext')
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
forall c ext ext'.
(SimpleCrypto c, Eq ext', Typeable ext) =>
SimpleBlock' c ext ext' -> SimpleBlock' c ext ext' -> Bool
$c== :: forall c ext ext'.
(SimpleCrypto c, Eq ext', Typeable ext) =>
SimpleBlock' c ext ext' -> SimpleBlock' c ext ext' -> Bool
== :: SimpleBlock' c ext ext' -> SimpleBlock' c ext ext' -> Bool
$c/= :: forall c ext ext'.
(SimpleCrypto c, Eq ext', Typeable ext) =>
SimpleBlock' c ext ext' -> SimpleBlock' c ext ext' -> Bool
/= :: SimpleBlock' c ext ext' -> SimpleBlock' c ext ext' -> Bool
Eq)

instance (SimpleCrypto c, Serialise ext') => Serialise (SimpleBlock' c ext ext') where
  encode :: SimpleBlock' c ext ext' -> Encoding
encode (SimpleBlock Header (SimpleBlock' c ext ext')
hdr SimpleBody
body) = [Encoding] -> Encoding
forall a. Monoid a => [a] -> a
mconcat [
        Word -> Encoding
CBOR.encodeListLen Word
2
      , Header (SimpleBlock' c ext ext') -> Encoding
forall a. Serialise a => a -> Encoding
encode Header (SimpleBlock' c ext ext')
hdr
      , SimpleBody -> Encoding
forall a. Serialise a => a -> Encoding
encode SimpleBody
body
      ]
  decode :: forall s. Decoder s (SimpleBlock' c ext ext')
decode = do
      Int -> Decoder s ()
forall s. Int -> Decoder s ()
CBOR.decodeListLenOf Int
2
      hdr  <- Decoder s (Header (SimpleBlock' c ext ext'))
forall s. Decoder s (Header (SimpleBlock' c ext ext'))
forall a s. Serialise a => Decoder s a
decode
      body <- decode
      return (SimpleBlock hdr body)

instance (Typeable c, Typeable ext, Typeable ext')
    => ShowProxy (SimpleBlock' c ext ext') where

data instance Header (SimpleBlock' c ext ext') = SimpleHeader {
      -- | The header hash
      --
      -- This is the hash of the header itself. This is a bit unpleasant,
      -- because it makes the hash look self-referential (when computing the
      -- hash we must ignore the 'simpleHeaderHash' field). However, the benefit
      -- is that we can give a 'HasHeader' instance that does not require
      -- a (static) 'Serialise' instance.
      forall c ext ext'.
Header (SimpleBlock' c ext ext')
-> HeaderHash (SimpleBlock' c ext ext')
simpleHeaderHash :: HeaderHash (SimpleBlock' c ext ext')

      -- | Fields required for the 'HasHeader' instance
    , forall c ext ext'.
Header (SimpleBlock' c ext ext') -> SimpleStdHeader c ext
simpleHeaderStd  :: SimpleStdHeader c ext

      -- | Header extension
      --
      -- This extension will be required when using 'SimpleBlock' for specific
      -- consensus protocols.
    , forall c ext ext'. Header (SimpleBlock' c ext ext') -> ext'
simpleHeaderExt  :: ext'
    }
  deriving ((forall x.
 Header (SimpleBlock' c ext ext')
 -> Rep (Header (SimpleBlock' c ext ext')) x)
-> (forall x.
    Rep (Header (SimpleBlock' c ext ext')) x
    -> Header (SimpleBlock' c ext ext'))
-> Generic (Header (SimpleBlock' c ext ext'))
forall x.
Rep (Header (SimpleBlock' c ext ext')) x
-> Header (SimpleBlock' c ext ext')
forall x.
Header (SimpleBlock' c ext ext')
-> Rep (Header (SimpleBlock' c ext ext')) x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
forall c ext ext' x.
Rep (Header (SimpleBlock' c ext ext')) x
-> Header (SimpleBlock' c ext ext')
forall c ext ext' x.
Header (SimpleBlock' c ext ext')
-> Rep (Header (SimpleBlock' c ext ext')) x
$cfrom :: forall c ext ext' x.
Header (SimpleBlock' c ext ext')
-> Rep (Header (SimpleBlock' c ext ext')) x
from :: forall x.
Header (SimpleBlock' c ext ext')
-> Rep (Header (SimpleBlock' c ext ext')) x
$cto :: forall c ext ext' x.
Rep (Header (SimpleBlock' c ext ext')) x
-> Header (SimpleBlock' c ext ext')
to :: forall x.
Rep (Header (SimpleBlock' c ext ext')) x
-> Header (SimpleBlock' c ext ext')
Generic, Int -> Header (SimpleBlock' c ext ext') -> ShowS
[Header (SimpleBlock' c ext ext')] -> ShowS
Header (SimpleBlock' c ext ext') -> String
(Int -> Header (SimpleBlock' c ext ext') -> ShowS)
-> (Header (SimpleBlock' c ext ext') -> String)
-> ([Header (SimpleBlock' c ext ext')] -> ShowS)
-> Show (Header (SimpleBlock' c ext ext'))
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
forall c ext ext'.
(SimpleCrypto c, Show ext', Typeable ext) =>
Int -> Header (SimpleBlock' c ext ext') -> ShowS
forall c ext ext'.
(SimpleCrypto c, Show ext', Typeable ext) =>
[Header (SimpleBlock' c ext ext')] -> ShowS
forall c ext ext'.
(SimpleCrypto c, Show ext', Typeable ext) =>
Header (SimpleBlock' c ext ext') -> String
$cshowsPrec :: forall c ext ext'.
(SimpleCrypto c, Show ext', Typeable ext) =>
Int -> Header (SimpleBlock' c ext ext') -> ShowS
showsPrec :: Int -> Header (SimpleBlock' c ext ext') -> ShowS
$cshow :: forall c ext ext'.
(SimpleCrypto c, Show ext', Typeable ext) =>
Header (SimpleBlock' c ext ext') -> String
show :: Header (SimpleBlock' c ext ext') -> String
$cshowList :: forall c ext ext'.
(SimpleCrypto c, Show ext', Typeable ext) =>
[Header (SimpleBlock' c ext ext')] -> ShowS
showList :: [Header (SimpleBlock' c ext ext')] -> ShowS
Show, Header (SimpleBlock' c ext ext')
-> Header (SimpleBlock' c ext ext') -> Bool
(Header (SimpleBlock' c ext ext')
 -> Header (SimpleBlock' c ext ext') -> Bool)
-> (Header (SimpleBlock' c ext ext')
    -> Header (SimpleBlock' c ext ext') -> Bool)
-> Eq (Header (SimpleBlock' c ext ext'))
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
forall c ext ext'.
(SimpleCrypto c, Eq ext', Typeable ext) =>
Header (SimpleBlock' c ext ext')
-> Header (SimpleBlock' c ext ext') -> Bool
$c== :: forall c ext ext'.
(SimpleCrypto c, Eq ext', Typeable ext) =>
Header (SimpleBlock' c ext ext')
-> Header (SimpleBlock' c ext ext') -> Bool
== :: Header (SimpleBlock' c ext ext')
-> Header (SimpleBlock' c ext ext') -> Bool
$c/= :: forall c ext ext'.
(SimpleCrypto c, Eq ext', Typeable ext) =>
Header (SimpleBlock' c ext ext')
-> Header (SimpleBlock' c ext ext') -> Bool
/= :: Header (SimpleBlock' c ext ext')
-> Header (SimpleBlock' c ext ext') -> Bool
Eq, Context -> Header (SimpleBlock' c ext ext') -> IO (Maybe ThunkInfo)
Proxy (Header (SimpleBlock' c ext ext')) -> String
(Context
 -> Header (SimpleBlock' c ext ext') -> IO (Maybe ThunkInfo))
-> (Context
    -> Header (SimpleBlock' c ext ext') -> IO (Maybe ThunkInfo))
-> (Proxy (Header (SimpleBlock' c ext ext')) -> String)
-> NoThunks (Header (SimpleBlock' c ext ext'))
forall a.
(Context -> a -> IO (Maybe ThunkInfo))
-> (Context -> a -> IO (Maybe ThunkInfo))
-> (Proxy a -> String)
-> NoThunks a
forall c ext ext'.
(SimpleCrypto c, NoThunks ext', Typeable ext) =>
Context -> Header (SimpleBlock' c ext ext') -> IO (Maybe ThunkInfo)
forall c ext ext'.
(SimpleCrypto c, NoThunks ext', Typeable ext) =>
Proxy (Header (SimpleBlock' c ext ext')) -> String
$cnoThunks :: forall c ext ext'.
(SimpleCrypto c, NoThunks ext', Typeable ext) =>
Context -> Header (SimpleBlock' c ext ext') -> IO (Maybe ThunkInfo)
noThunks :: Context -> Header (SimpleBlock' c ext ext') -> IO (Maybe ThunkInfo)
$cwNoThunks :: forall c ext ext'.
(SimpleCrypto c, NoThunks ext', Typeable ext) =>
Context -> Header (SimpleBlock' c ext ext') -> IO (Maybe ThunkInfo)
wNoThunks :: Context -> Header (SimpleBlock' c ext ext') -> IO (Maybe ThunkInfo)
$cshowTypeOf :: forall c ext ext'.
(SimpleCrypto c, NoThunks ext', Typeable ext) =>
Proxy (Header (SimpleBlock' c ext ext')) -> String
showTypeOf :: Proxy (Header (SimpleBlock' c ext ext')) -> String
NoThunks)

instance (Typeable c, Typeable ext, Typeable ext')
    => ShowProxy (Header (SimpleBlock' c ext ext')) where

instance (SimpleCrypto c, Typeable ext, Typeable ext')
      => GetHeader (SimpleBlock' c ext ext') where
  getHeader :: SimpleBlock' c ext ext' -> Header (SimpleBlock' c ext ext')
getHeader = SimpleBlock' c ext ext' -> Header (SimpleBlock' c ext ext')
forall c ext ext'.
SimpleBlock' c ext ext' -> Header (SimpleBlock' c ext ext')
simpleHeader

  blockMatchesHeader :: Header (SimpleBlock' c ext ext') -> SimpleBlock' c ext ext' -> Bool
blockMatchesHeader = Header (SimpleBlock' c ext ext') -> SimpleBlock' c ext ext' -> Bool
forall c ext ext' ext''.
SimpleCrypto c =>
Header (SimpleBlock' c ext ext')
-> SimpleBlock' c ext ext'' -> Bool
matchesSimpleHeader

  headerIsEBB :: Header (SimpleBlock' c ext ext') -> Maybe EpochNo
headerIsEBB = Maybe EpochNo -> Header (SimpleBlock' c ext ext') -> Maybe EpochNo
forall a b. a -> b -> a
const Maybe EpochNo
forall a. Maybe a
Nothing

data SimpleStdHeader c ext = SimpleStdHeader {
      forall c ext.
SimpleStdHeader c ext -> ChainHash (SimpleBlock c ext)
simplePrev     :: ChainHash (SimpleBlock c ext)
    , forall c ext. SimpleStdHeader c ext -> SlotNo
simpleSlotNo   :: SlotNo
    , forall c ext. SimpleStdHeader c ext -> BlockNo
simpleBlockNo  :: BlockNo
    , forall c ext.
SimpleStdHeader c ext -> Hash (SimpleHash c) SimpleBody
simpleBodyHash :: Hash (SimpleHash c) SimpleBody
    , forall c ext. SimpleStdHeader c ext -> SizeInBytes
simpleBodySize :: SizeInBytes
    }
  deriving stock    ((forall x. SimpleStdHeader c ext -> Rep (SimpleStdHeader c ext) x)
-> (forall x.
    Rep (SimpleStdHeader c ext) x -> SimpleStdHeader c ext)
-> Generic (SimpleStdHeader c ext)
forall x. Rep (SimpleStdHeader c ext) x -> SimpleStdHeader c ext
forall x. SimpleStdHeader c ext -> Rep (SimpleStdHeader c ext) x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
forall c ext x.
Rep (SimpleStdHeader c ext) x -> SimpleStdHeader c ext
forall c ext x.
SimpleStdHeader c ext -> Rep (SimpleStdHeader c ext) x
$cfrom :: forall c ext x.
SimpleStdHeader c ext -> Rep (SimpleStdHeader c ext) x
from :: forall x. SimpleStdHeader c ext -> Rep (SimpleStdHeader c ext) x
$cto :: forall c ext x.
Rep (SimpleStdHeader c ext) x -> SimpleStdHeader c ext
to :: forall x. Rep (SimpleStdHeader c ext) x -> SimpleStdHeader c ext
Generic, Int -> SimpleStdHeader c ext -> ShowS
[SimpleStdHeader c ext] -> ShowS
SimpleStdHeader c ext -> String
(Int -> SimpleStdHeader c ext -> ShowS)
-> (SimpleStdHeader c ext -> String)
-> ([SimpleStdHeader c ext] -> ShowS)
-> Show (SimpleStdHeader c ext)
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
forall c ext.
(SimpleCrypto c, Typeable ext) =>
Int -> SimpleStdHeader c ext -> ShowS
forall c ext.
(SimpleCrypto c, Typeable ext) =>
[SimpleStdHeader c ext] -> ShowS
forall c ext.
(SimpleCrypto c, Typeable ext) =>
SimpleStdHeader c ext -> String
$cshowsPrec :: forall c ext.
(SimpleCrypto c, Typeable ext) =>
Int -> SimpleStdHeader c ext -> ShowS
showsPrec :: Int -> SimpleStdHeader c ext -> ShowS
$cshow :: forall c ext.
(SimpleCrypto c, Typeable ext) =>
SimpleStdHeader c ext -> String
show :: SimpleStdHeader c ext -> String
$cshowList :: forall c ext.
(SimpleCrypto c, Typeable ext) =>
[SimpleStdHeader c ext] -> ShowS
showList :: [SimpleStdHeader c ext] -> ShowS
Show, SimpleStdHeader c ext -> SimpleStdHeader c ext -> Bool
(SimpleStdHeader c ext -> SimpleStdHeader c ext -> Bool)
-> (SimpleStdHeader c ext -> SimpleStdHeader c ext -> Bool)
-> Eq (SimpleStdHeader c ext)
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
forall c ext.
(SimpleCrypto c, Typeable ext) =>
SimpleStdHeader c ext -> SimpleStdHeader c ext -> Bool
$c== :: forall c ext.
(SimpleCrypto c, Typeable ext) =>
SimpleStdHeader c ext -> SimpleStdHeader c ext -> Bool
== :: SimpleStdHeader c ext -> SimpleStdHeader c ext -> Bool
$c/= :: forall c ext.
(SimpleCrypto c, Typeable ext) =>
SimpleStdHeader c ext -> SimpleStdHeader c ext -> Bool
/= :: SimpleStdHeader c ext -> SimpleStdHeader c ext -> Bool
Eq)
  deriving anyclass (Context -> SimpleStdHeader c ext -> IO (Maybe ThunkInfo)
Proxy (SimpleStdHeader c ext) -> String
(Context -> SimpleStdHeader c ext -> IO (Maybe ThunkInfo))
-> (Context -> SimpleStdHeader c ext -> IO (Maybe ThunkInfo))
-> (Proxy (SimpleStdHeader c ext) -> String)
-> NoThunks (SimpleStdHeader c ext)
forall a.
(Context -> a -> IO (Maybe ThunkInfo))
-> (Context -> a -> IO (Maybe ThunkInfo))
-> (Proxy a -> String)
-> NoThunks a
forall c ext.
(SimpleCrypto c, Typeable ext) =>
Context -> SimpleStdHeader c ext -> IO (Maybe ThunkInfo)
forall c ext.
(SimpleCrypto c, Typeable ext) =>
Proxy (SimpleStdHeader c ext) -> String
$cnoThunks :: forall c ext.
(SimpleCrypto c, Typeable ext) =>
Context -> SimpleStdHeader c ext -> IO (Maybe ThunkInfo)
noThunks :: Context -> SimpleStdHeader c ext -> IO (Maybe ThunkInfo)
$cwNoThunks :: forall c ext.
(SimpleCrypto c, Typeable ext) =>
Context -> SimpleStdHeader c ext -> IO (Maybe ThunkInfo)
wNoThunks :: Context -> SimpleStdHeader c ext -> IO (Maybe ThunkInfo)
$cshowTypeOf :: forall c ext.
(SimpleCrypto c, Typeable ext) =>
Proxy (SimpleStdHeader c ext) -> String
showTypeOf :: Proxy (SimpleStdHeader c ext) -> String
NoThunks)

deriving anyclass instance KnownNat (Hash.SizeHash (SimpleHash c)) =>
  Serialise (SimpleStdHeader c ext)

data SimpleBody = SimpleBody {
      SimpleBody -> [Tx]
simpleTxs :: [Mock.Tx]
    }
  deriving ((forall x. SimpleBody -> Rep SimpleBody x)
-> (forall x. Rep SimpleBody x -> SimpleBody) -> Generic SimpleBody
forall x. Rep SimpleBody x -> SimpleBody
forall x. SimpleBody -> Rep SimpleBody x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. SimpleBody -> Rep SimpleBody x
from :: forall x. SimpleBody -> Rep SimpleBody x
$cto :: forall x. Rep SimpleBody x -> SimpleBody
to :: forall x. Rep SimpleBody x -> SimpleBody
Generic, Int -> SimpleBody -> ShowS
[SimpleBody] -> ShowS
SimpleBody -> String
(Int -> SimpleBody -> ShowS)
-> (SimpleBody -> String)
-> ([SimpleBody] -> ShowS)
-> Show SimpleBody
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> SimpleBody -> ShowS
showsPrec :: Int -> SimpleBody -> ShowS
$cshow :: SimpleBody -> String
show :: SimpleBody -> String
$cshowList :: [SimpleBody] -> ShowS
showList :: [SimpleBody] -> ShowS
Show, SimpleBody -> SimpleBody -> Bool
(SimpleBody -> SimpleBody -> Bool)
-> (SimpleBody -> SimpleBody -> Bool) -> Eq SimpleBody
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: SimpleBody -> SimpleBody -> Bool
== :: SimpleBody -> SimpleBody -> Bool
$c/= :: SimpleBody -> SimpleBody -> Bool
/= :: SimpleBody -> SimpleBody -> Bool
Eq)

instance Serialise SimpleBody where
  encode :: SimpleBody -> Encoding
encode (SimpleBody [Tx]
txs) = [Tx] -> Encoding
forall a. Serialise a => a -> Encoding
encode [Tx]
txs
  decode :: forall s. Decoder s SimpleBody
decode = [Tx] -> SimpleBody
SimpleBody ([Tx] -> SimpleBody) -> Decoder s [Tx] -> Decoder s SimpleBody
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Decoder s [Tx]
forall s. Decoder s [Tx]
forall a s. Serialise a => Decoder s a
decode

{-------------------------------------------------------------------------------
  Working with 'SimpleBlock'
-------------------------------------------------------------------------------}

-- | Create a header by hashing the header without hash and adding to the
-- resulting value.
mkSimpleHeader :: SimpleCrypto c
               => (ext' -> CBOR.Encoding)
               -> SimpleStdHeader c ext
               -> ext'
               -> Header (SimpleBlock' c ext ext')
mkSimpleHeader :: forall c ext' ext.
SimpleCrypto c =>
(ext' -> Encoding)
-> SimpleStdHeader c ext
-> ext'
-> Header (SimpleBlock' c ext ext')
mkSimpleHeader ext' -> Encoding
encodeExt SimpleStdHeader c ext
std ext'
ext =
    Header (SimpleBlock' c ext ext')
headerWithoutHash {
        simpleHeaderHash = Hash.hashWithSerialiser
                             (encodeSimpleHeader encodeExt)
                             headerWithoutHash
      }
  where
    headerWithoutHash :: Header (SimpleBlock' c ext ext')
headerWithoutHash = SimpleHeader {
        simpleHeaderHash :: HeaderHash (SimpleBlock' c ext ext')
simpleHeaderHash = String -> Hash (SimpleHash c) (Header (SimpleBlock' c ext ext'))
forall a. HasCallStack => String -> a
error String
"Serialise instances should ignore hash"
      , simpleHeaderStd :: SimpleStdHeader c ext
simpleHeaderStd  = SimpleStdHeader c ext
std
      , simpleHeaderExt :: ext'
simpleHeaderExt  = ext'
ext
      }

-- | Check whether the block matches the header
matchesSimpleHeader :: SimpleCrypto c
                    => Header (SimpleBlock' c ext ext')
                    -> SimpleBlock'  c ext ext''
                    -> Bool
matchesSimpleHeader :: forall c ext ext' ext''.
SimpleCrypto c =>
Header (SimpleBlock' c ext ext')
-> SimpleBlock' c ext ext'' -> Bool
matchesSimpleHeader SimpleHeader{ext'
HeaderHash (SimpleBlock' c ext ext')
SimpleStdHeader c ext
simpleHeaderHash :: forall c ext ext'.
Header (SimpleBlock' c ext ext')
-> HeaderHash (SimpleBlock' c ext ext')
simpleHeaderStd :: forall c ext ext'.
Header (SimpleBlock' c ext ext') -> SimpleStdHeader c ext
simpleHeaderExt :: forall c ext ext'. Header (SimpleBlock' c ext ext') -> ext'
simpleHeaderHash :: HeaderHash (SimpleBlock' c ext ext')
simpleHeaderStd :: SimpleStdHeader c ext
simpleHeaderExt :: ext'
..} SimpleBlock {Header (SimpleBlock' c ext ext'')
SimpleBody
simpleHeader :: forall c ext ext'.
SimpleBlock' c ext ext' -> Header (SimpleBlock' c ext ext')
simpleBody :: forall c ext ext'. SimpleBlock' c ext ext' -> SimpleBody
simpleHeader :: Header (SimpleBlock' c ext ext'')
simpleBody :: SimpleBody
..} =
    Hash (SimpleHash c) SimpleBody
simpleBodyHash Hash (SimpleHash c) SimpleBody
-> Hash (SimpleHash c) SimpleBody -> Bool
forall a. Eq a => a -> a -> Bool
== (SimpleBody -> Encoding)
-> SimpleBody -> Hash (SimpleHash c) SimpleBody
forall h a. HashAlgorithm h => (a -> Encoding) -> a -> Hash h a
Hash.hashWithSerialiser SimpleBody -> Encoding
forall a. ToCBOR a => a -> Encoding
toCBOR SimpleBody
simpleBody
  where
    SimpleStdHeader{Hash (SimpleHash c) SimpleBody
BlockNo
SlotNo
SizeInBytes
ChainHash (SimpleBlock c ext)
simplePrev :: forall c ext.
SimpleStdHeader c ext -> ChainHash (SimpleBlock c ext)
simpleSlotNo :: forall c ext. SimpleStdHeader c ext -> SlotNo
simpleBlockNo :: forall c ext. SimpleStdHeader c ext -> BlockNo
simpleBodyHash :: forall c ext.
SimpleStdHeader c ext -> Hash (SimpleHash c) SimpleBody
simpleBodySize :: forall c ext. SimpleStdHeader c ext -> SizeInBytes
simpleBodyHash :: Hash (SimpleHash c) SimpleBody
simplePrev :: ChainHash (SimpleBlock c ext)
simpleSlotNo :: SlotNo
simpleBlockNo :: BlockNo
simpleBodySize :: SizeInBytes
..} = SimpleStdHeader c ext
simpleHeaderStd

countSimpleGenTxs :: SimpleBlock c ext -> Word64
countSimpleGenTxs :: forall c ext. SimpleBlock c ext -> Word64
countSimpleGenTxs = Int -> Word64
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int -> Word64)
-> (SimpleBlock c ext -> Int) -> SimpleBlock c ext -> Word64
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [GenTx (SimpleBlock c ext)] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length ([GenTx (SimpleBlock c ext)] -> Int)
-> (SimpleBlock c ext -> [GenTx (SimpleBlock c ext)])
-> SimpleBlock c ext
-> Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. SimpleBlock c ext -> [GenTx (SimpleBlock c ext)]
forall blk. HasTxs blk => blk -> [GenTx blk]
extractTxs

{-------------------------------------------------------------------------------
  HasHeader instance for SimpleHeader
-------------------------------------------------------------------------------}

instance (SimpleCrypto c, Typeable ext, Typeable ext')
      => HasHeader (Header (SimpleBlock' c ext ext')) where
  getHeaderFields :: Header (SimpleBlock' c ext ext')
-> HeaderFields (Header (SimpleBlock' c ext ext'))
getHeaderFields Header (SimpleBlock' c ext ext')
hdr = HeaderFields {
        headerFieldHash :: HeaderHash (Header (SimpleBlock' c ext ext'))
headerFieldHash    = Header (SimpleBlock' c ext ext')
-> HeaderHash (SimpleBlock' c ext ext')
forall c ext ext'.
Header (SimpleBlock' c ext ext')
-> HeaderHash (SimpleBlock' c ext ext')
simpleHeaderHash Header (SimpleBlock' c ext ext')
hdr
      , headerFieldSlot :: SlotNo
headerFieldSlot    = SimpleStdHeader c ext -> SlotNo
forall c ext. SimpleStdHeader c ext -> SlotNo
simpleSlotNo  (SimpleStdHeader c ext -> SlotNo)
-> (Header (SimpleBlock' c ext ext') -> SimpleStdHeader c ext)
-> Header (SimpleBlock' c ext ext')
-> SlotNo
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Header (SimpleBlock' c ext ext') -> SimpleStdHeader c ext
forall c ext ext'.
Header (SimpleBlock' c ext ext') -> SimpleStdHeader c ext
simpleHeaderStd (Header (SimpleBlock' c ext ext') -> SlotNo)
-> Header (SimpleBlock' c ext ext') -> SlotNo
forall a b. (a -> b) -> a -> b
$ Header (SimpleBlock' c ext ext')
hdr
      , headerFieldBlockNo :: BlockNo
headerFieldBlockNo = SimpleStdHeader c ext -> BlockNo
forall c ext. SimpleStdHeader c ext -> BlockNo
simpleBlockNo (SimpleStdHeader c ext -> BlockNo)
-> (Header (SimpleBlock' c ext ext') -> SimpleStdHeader c ext)
-> Header (SimpleBlock' c ext ext')
-> BlockNo
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Header (SimpleBlock' c ext ext') -> SimpleStdHeader c ext
forall c ext ext'.
Header (SimpleBlock' c ext ext') -> SimpleStdHeader c ext
simpleHeaderStd (Header (SimpleBlock' c ext ext') -> BlockNo)
-> Header (SimpleBlock' c ext ext') -> BlockNo
forall a b. (a -> b) -> a -> b
$ Header (SimpleBlock' c ext ext')
hdr
      }

{-------------------------------------------------------------------------------
  HasHeader instance for SimpleBlock
-------------------------------------------------------------------------------}

type instance HeaderHash (SimpleBlock' c ext ext') =
  Hash (SimpleHash c) (Header (SimpleBlock' c ext ext'))

instance (SimpleCrypto c, Typeable ext, Typeable ext')
      => HasHeader (SimpleBlock' c ext ext') where
  getHeaderFields :: SimpleBlock' c ext ext' -> HeaderFields (SimpleBlock' c ext ext')
getHeaderFields = SimpleBlock' c ext ext' -> HeaderFields (SimpleBlock' c ext ext')
forall blk. GetHeader blk => blk -> HeaderFields blk
getBlockHeaderFields

instance (SimpleCrypto c, Typeable ext) => GetPrevHash (SimpleBlock c ext) where
  headerPrevHash :: Header (SimpleBlock c ext) -> ChainHash (SimpleBlock c ext)
headerPrevHash = SimpleStdHeader c ext -> ChainHash (SimpleBlock c ext)
forall c ext.
SimpleStdHeader c ext -> ChainHash (SimpleBlock c ext)
simplePrev (SimpleStdHeader c ext -> ChainHash (SimpleBlock c ext))
-> (Header (SimpleBlock c ext) -> SimpleStdHeader c ext)
-> Header (SimpleBlock c ext)
-> ChainHash (SimpleBlock c ext)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Header (SimpleBlock c ext) -> SimpleStdHeader c ext
forall c ext ext'.
Header (SimpleBlock' c ext ext') -> SimpleStdHeader c ext
simpleHeaderStd

instance (SimpleCrypto c, Typeable ext, Typeable ext')
      => StandardHash (SimpleBlock' c ext ext')

instance SimpleCrypto c => ConvertRawHash (SimpleBlock' c ext ext') where
  toShortRawHash :: forall (proxy :: * -> *).
proxy (SimpleBlock' c ext ext')
-> HeaderHash (SimpleBlock' c ext ext') -> ShortByteString
toShortRawHash   proxy (SimpleBlock' c ext ext')
_ = Hash (SimpleHash c) (Header (SimpleBlock' c ext ext'))
-> ShortByteString
HeaderHash (SimpleBlock' c ext ext') -> ShortByteString
forall h a. Hash h a -> ShortByteString
Hash.hashToBytesShort
  fromShortRawHash :: forall (proxy :: * -> *).
proxy (SimpleBlock' c ext ext')
-> ShortByteString -> HeaderHash (SimpleBlock' c ext ext')
fromShortRawHash proxy (SimpleBlock' c ext ext')
_ = ShortByteString
-> Hash (SimpleHash c) (Header (SimpleBlock' c ext ext'))
ShortByteString -> HeaderHash (SimpleBlock' c ext ext')
forall h a.
(HashAlgorithm h, HasCallStack) =>
ShortByteString -> Hash h a
hashFromBytesShortE
  hashSize :: forall (proxy :: * -> *). proxy (SimpleBlock' c ext ext') -> Word32
hashSize         proxy (SimpleBlock' c ext ext')
_ = Word -> Word32
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Word -> Word32) -> Word -> Word32
forall a b. (a -> b) -> a -> b
$ Proxy (SimpleHash c) -> Word
forall h (proxy :: * -> *). HashAlgorithm h => proxy h -> Word
Hash.sizeHash (forall t. Proxy t
forall {k} (t :: k). Proxy t
Proxy @(SimpleHash c))

{-------------------------------------------------------------------------------
  HasMockTxs instance
-------------------------------------------------------------------------------}

instance Mock.HasMockTxs (SimpleBlock' c ext ext') where
  getMockTxs :: SimpleBlock' c ext ext' -> [Tx]
getMockTxs = SimpleBody -> [Tx]
forall a. HasMockTxs a => a -> [Tx]
Mock.getMockTxs (SimpleBody -> [Tx])
-> (SimpleBlock' c ext ext' -> SimpleBody)
-> SimpleBlock' c ext ext'
-> [Tx]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. SimpleBlock' c ext ext' -> SimpleBody
forall c ext ext'. SimpleBlock' c ext ext' -> SimpleBody
simpleBody

instance Mock.HasMockTxs SimpleBody where
  getMockTxs :: SimpleBody -> [Tx]
getMockTxs = SimpleBody -> [Tx]
simpleTxs

{-------------------------------------------------------------------------------
  Envelope validation
-------------------------------------------------------------------------------}

instance (SimpleCrypto c, Typeable ext) => HasAnnTip (SimpleBlock c ext)
  -- Use defaults

instance (SimpleCrypto c, Typeable ext) => BasicEnvelopeValidation (SimpleBlock c ext)
  -- Use defaults

instance (SimpleCrypto c, Typeable ext) => ValidateEnvelope (SimpleBlock c ext)
  -- Use defaults

{-------------------------------------------------------------------------------
  Block config
-------------------------------------------------------------------------------}

data instance BlockConfig (SimpleBlock c ext) = SimpleBlockConfig
  deriving stock   ((forall x.
 BlockConfig (SimpleBlock c ext)
 -> Rep (BlockConfig (SimpleBlock c ext)) x)
-> (forall x.
    Rep (BlockConfig (SimpleBlock c ext)) x
    -> BlockConfig (SimpleBlock c ext))
-> Generic (BlockConfig (SimpleBlock c ext))
forall x.
Rep (BlockConfig (SimpleBlock c ext)) x
-> BlockConfig (SimpleBlock c ext)
forall x.
BlockConfig (SimpleBlock c ext)
-> Rep (BlockConfig (SimpleBlock c ext)) x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
forall c ext x.
Rep (BlockConfig (SimpleBlock c ext)) x
-> BlockConfig (SimpleBlock c ext)
forall c ext x.
BlockConfig (SimpleBlock c ext)
-> Rep (BlockConfig (SimpleBlock c ext)) x
$cfrom :: forall c ext x.
BlockConfig (SimpleBlock c ext)
-> Rep (BlockConfig (SimpleBlock c ext)) x
from :: forall x.
BlockConfig (SimpleBlock c ext)
-> Rep (BlockConfig (SimpleBlock c ext)) x
$cto :: forall c ext x.
Rep (BlockConfig (SimpleBlock c ext)) x
-> BlockConfig (SimpleBlock c ext)
to :: forall x.
Rep (BlockConfig (SimpleBlock c ext)) x
-> BlockConfig (SimpleBlock c ext)
Generic)
  deriving anyclass (Context -> BlockConfig (SimpleBlock c ext) -> IO (Maybe ThunkInfo)
Proxy (BlockConfig (SimpleBlock c ext)) -> String
(Context
 -> BlockConfig (SimpleBlock c ext) -> IO (Maybe ThunkInfo))
-> (Context
    -> BlockConfig (SimpleBlock c ext) -> IO (Maybe ThunkInfo))
-> (Proxy (BlockConfig (SimpleBlock c ext)) -> String)
-> NoThunks (BlockConfig (SimpleBlock c ext))
forall a.
(Context -> a -> IO (Maybe ThunkInfo))
-> (Context -> a -> IO (Maybe ThunkInfo))
-> (Proxy a -> String)
-> NoThunks a
forall c ext.
Context -> BlockConfig (SimpleBlock c ext) -> IO (Maybe ThunkInfo)
forall c ext. Proxy (BlockConfig (SimpleBlock c ext)) -> String
$cnoThunks :: forall c ext.
Context -> BlockConfig (SimpleBlock c ext) -> IO (Maybe ThunkInfo)
noThunks :: Context -> BlockConfig (SimpleBlock c ext) -> IO (Maybe ThunkInfo)
$cwNoThunks :: forall c ext.
Context -> BlockConfig (SimpleBlock c ext) -> IO (Maybe ThunkInfo)
wNoThunks :: Context -> BlockConfig (SimpleBlock c ext) -> IO (Maybe ThunkInfo)
$cshowTypeOf :: forall c ext. Proxy (BlockConfig (SimpleBlock c ext)) -> String
showTypeOf :: Proxy (BlockConfig (SimpleBlock c ext)) -> String
NoThunks)

{-------------------------------------------------------------------------------
  Codec config
-------------------------------------------------------------------------------}

data instance CodecConfig (SimpleBlock c ext) = SimpleCodecConfig
  deriving stock    ((forall x.
 CodecConfig (SimpleBlock c ext)
 -> Rep (CodecConfig (SimpleBlock c ext)) x)
-> (forall x.
    Rep (CodecConfig (SimpleBlock c ext)) x
    -> CodecConfig (SimpleBlock c ext))
-> Generic (CodecConfig (SimpleBlock c ext))
forall x.
Rep (CodecConfig (SimpleBlock c ext)) x
-> CodecConfig (SimpleBlock c ext)
forall x.
CodecConfig (SimpleBlock c ext)
-> Rep (CodecConfig (SimpleBlock c ext)) x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
forall c ext x.
Rep (CodecConfig (SimpleBlock c ext)) x
-> CodecConfig (SimpleBlock c ext)
forall c ext x.
CodecConfig (SimpleBlock c ext)
-> Rep (CodecConfig (SimpleBlock c ext)) x
$cfrom :: forall c ext x.
CodecConfig (SimpleBlock c ext)
-> Rep (CodecConfig (SimpleBlock c ext)) x
from :: forall x.
CodecConfig (SimpleBlock c ext)
-> Rep (CodecConfig (SimpleBlock c ext)) x
$cto :: forall c ext x.
Rep (CodecConfig (SimpleBlock c ext)) x
-> CodecConfig (SimpleBlock c ext)
to :: forall x.
Rep (CodecConfig (SimpleBlock c ext)) x
-> CodecConfig (SimpleBlock c ext)
Generic)
  deriving anyclass (Context -> CodecConfig (SimpleBlock c ext) -> IO (Maybe ThunkInfo)
Proxy (CodecConfig (SimpleBlock c ext)) -> String
(Context
 -> CodecConfig (SimpleBlock c ext) -> IO (Maybe ThunkInfo))
-> (Context
    -> CodecConfig (SimpleBlock c ext) -> IO (Maybe ThunkInfo))
-> (Proxy (CodecConfig (SimpleBlock c ext)) -> String)
-> NoThunks (CodecConfig (SimpleBlock c ext))
forall a.
(Context -> a -> IO (Maybe ThunkInfo))
-> (Context -> a -> IO (Maybe ThunkInfo))
-> (Proxy a -> String)
-> NoThunks a
forall c ext.
Context -> CodecConfig (SimpleBlock c ext) -> IO (Maybe ThunkInfo)
forall c ext. Proxy (CodecConfig (SimpleBlock c ext)) -> String
$cnoThunks :: forall c ext.
Context -> CodecConfig (SimpleBlock c ext) -> IO (Maybe ThunkInfo)
noThunks :: Context -> CodecConfig (SimpleBlock c ext) -> IO (Maybe ThunkInfo)
$cwNoThunks :: forall c ext.
Context -> CodecConfig (SimpleBlock c ext) -> IO (Maybe ThunkInfo)
wNoThunks :: Context -> CodecConfig (SimpleBlock c ext) -> IO (Maybe ThunkInfo)
$cshowTypeOf :: forall c ext. Proxy (CodecConfig (SimpleBlock c ext)) -> String
showTypeOf :: Proxy (CodecConfig (SimpleBlock c ext)) -> String
NoThunks)

{-------------------------------------------------------------------------------
  Storage config
-------------------------------------------------------------------------------}

data instance StorageConfig (SimpleBlock c ext) = SimpleStorageConfig SecurityParam
  deriving stock    ((forall x.
 StorageConfig (SimpleBlock c ext)
 -> Rep (StorageConfig (SimpleBlock c ext)) x)
-> (forall x.
    Rep (StorageConfig (SimpleBlock c ext)) x
    -> StorageConfig (SimpleBlock c ext))
-> Generic (StorageConfig (SimpleBlock c ext))
forall x.
Rep (StorageConfig (SimpleBlock c ext)) x
-> StorageConfig (SimpleBlock c ext)
forall x.
StorageConfig (SimpleBlock c ext)
-> Rep (StorageConfig (SimpleBlock c ext)) x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
forall c ext x.
Rep (StorageConfig (SimpleBlock c ext)) x
-> StorageConfig (SimpleBlock c ext)
forall c ext x.
StorageConfig (SimpleBlock c ext)
-> Rep (StorageConfig (SimpleBlock c ext)) x
$cfrom :: forall c ext x.
StorageConfig (SimpleBlock c ext)
-> Rep (StorageConfig (SimpleBlock c ext)) x
from :: forall x.
StorageConfig (SimpleBlock c ext)
-> Rep (StorageConfig (SimpleBlock c ext)) x
$cto :: forall c ext x.
Rep (StorageConfig (SimpleBlock c ext)) x
-> StorageConfig (SimpleBlock c ext)
to :: forall x.
Rep (StorageConfig (SimpleBlock c ext)) x
-> StorageConfig (SimpleBlock c ext)
Generic)
  deriving anyclass (Context
-> StorageConfig (SimpleBlock c ext) -> IO (Maybe ThunkInfo)
Proxy (StorageConfig (SimpleBlock c ext)) -> String
(Context
 -> StorageConfig (SimpleBlock c ext) -> IO (Maybe ThunkInfo))
-> (Context
    -> StorageConfig (SimpleBlock c ext) -> IO (Maybe ThunkInfo))
-> (Proxy (StorageConfig (SimpleBlock c ext)) -> String)
-> NoThunks (StorageConfig (SimpleBlock c ext))
forall a.
(Context -> a -> IO (Maybe ThunkInfo))
-> (Context -> a -> IO (Maybe ThunkInfo))
-> (Proxy a -> String)
-> NoThunks a
forall c ext.
Context
-> StorageConfig (SimpleBlock c ext) -> IO (Maybe ThunkInfo)
forall c ext. Proxy (StorageConfig (SimpleBlock c ext)) -> String
$cnoThunks :: forall c ext.
Context
-> StorageConfig (SimpleBlock c ext) -> IO (Maybe ThunkInfo)
noThunks :: Context
-> StorageConfig (SimpleBlock c ext) -> IO (Maybe ThunkInfo)
$cwNoThunks :: forall c ext.
Context
-> StorageConfig (SimpleBlock c ext) -> IO (Maybe ThunkInfo)
wNoThunks :: Context
-> StorageConfig (SimpleBlock c ext) -> IO (Maybe ThunkInfo)
$cshowTypeOf :: forall c ext. Proxy (StorageConfig (SimpleBlock c ext)) -> String
showTypeOf :: Proxy (StorageConfig (SimpleBlock c ext)) -> String
NoThunks)

{-------------------------------------------------------------------------------
  Hard fork history
-------------------------------------------------------------------------------}

instance HasHardForkHistory (SimpleBlock c ext) where
  type HardForkIndices (SimpleBlock c ext) = '[SimpleBlock c ext]
  hardForkSummary :: forall (mk :: * -> * -> *).
LedgerConfig (SimpleBlock c ext)
-> LedgerState (SimpleBlock c ext) mk
-> Summary (HardForkIndices (SimpleBlock c ext))
hardForkSummary = (LedgerConfig (SimpleBlock c ext) -> EraParams)
-> LedgerConfig (SimpleBlock c ext)
-> LedgerState (SimpleBlock c ext) mk
-> Summary '[SimpleBlock c ext]
forall blk (mk :: * -> * -> *).
(LedgerConfig blk -> EraParams)
-> LedgerConfig blk -> LedgerState blk mk -> Summary '[blk]
neverForksHardForkSummary LedgerConfig (SimpleBlock c ext) -> EraParams
SimpleLedgerConfig c ext -> EraParams
forall c ext. SimpleLedgerConfig c ext -> EraParams
simpleLedgerEraParams

{-------------------------------------------------------------------------------
  Protocol specific constraints
-------------------------------------------------------------------------------}

class ( SimpleCrypto c
      , Typeable  ext
      , Show      (MockLedgerConfig c ext)
      , NoThunks  (MockLedgerConfig c ext)
      , Serialise (MockLedgerConfig c ext)
      ) => MockProtocolSpecific c ext where
  type family MockLedgerConfig c ext :: Type

{-------------------------------------------------------------------------------
  Update the ledger
-------------------------------------------------------------------------------}

data SimpleLedgerConfig c ext = SimpleLedgerConfig {
      -- | Config required by the various kinds of mock block (PFT, Praos, ..)
      forall c ext. SimpleLedgerConfig c ext -> MockLedgerConfig c ext
simpleMockLedgerConfig :: !(MockLedgerConfig c ext)

      -- | Era parameters
    , forall c ext. SimpleLedgerConfig c ext -> EraParams
simpleLedgerEraParams  :: !HardFork.EraParams

    , forall c ext. SimpleLedgerConfig c ext -> MockConfig
simpleLedgerMockConfig :: !MockConfig
    }
  deriving ((forall x.
 SimpleLedgerConfig c ext -> Rep (SimpleLedgerConfig c ext) x)
-> (forall x.
    Rep (SimpleLedgerConfig c ext) x -> SimpleLedgerConfig c ext)
-> Generic (SimpleLedgerConfig c ext)
forall x.
Rep (SimpleLedgerConfig c ext) x -> SimpleLedgerConfig c ext
forall x.
SimpleLedgerConfig c ext -> Rep (SimpleLedgerConfig c ext) x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
forall c ext x.
Rep (SimpleLedgerConfig c ext) x -> SimpleLedgerConfig c ext
forall c ext x.
SimpleLedgerConfig c ext -> Rep (SimpleLedgerConfig c ext) x
$cfrom :: forall c ext x.
SimpleLedgerConfig c ext -> Rep (SimpleLedgerConfig c ext) x
from :: forall x.
SimpleLedgerConfig c ext -> Rep (SimpleLedgerConfig c ext) x
$cto :: forall c ext x.
Rep (SimpleLedgerConfig c ext) x -> SimpleLedgerConfig c ext
to :: forall x.
Rep (SimpleLedgerConfig c ext) x -> SimpleLedgerConfig c ext
Generic)

deriving instance Show (MockLedgerConfig c ext) => Show (SimpleLedgerConfig c ext)
deriving instance Eq   (MockLedgerConfig c ext) => Eq   (SimpleLedgerConfig c ext)
deriving instance NoThunks (MockLedgerConfig   c ext)
               => NoThunks (SimpleLedgerConfig c ext)
deriving instance Serialise (MockLedgerConfig   c ext)
               => Serialise (SimpleLedgerConfig c ext)

type instance LedgerCfg (LedgerState (SimpleBlock c ext)) = SimpleLedgerConfig c ext

instance MockProtocolSpecific c ext => HasPartialLedgerConfig (SimpleBlock c ext)

instance (Serialise (MockLedgerConfig c ext))
  => SerialiseNodeToClient (SimpleBlock c ext) (SimpleLedgerConfig c ext)

instance GetTip (LedgerState (SimpleBlock c ext)) where
  getTip :: forall (mk :: * -> * -> *).
LedgerState (SimpleBlock c ext) mk
-> Point (LedgerState (SimpleBlock c ext))
getTip (SimpleLedgerState MockState (SimpleBlock c ext)
st LedgerTables (LedgerState (SimpleBlock c ext)) mk
_) = Point (SimpleBlock c ext)
-> Point (LedgerState (SimpleBlock c ext))
forall {k1} {k2} (b :: k1) (b' :: k2).
Coercible (HeaderHash b) (HeaderHash b') =>
Point b -> Point b'
castPoint (Point (SimpleBlock c ext)
 -> Point (LedgerState (SimpleBlock c ext)))
-> Point (SimpleBlock c ext)
-> Point (LedgerState (SimpleBlock c ext))
forall a b. (a -> b) -> a -> b
$ MockState (SimpleBlock c ext) -> Point (SimpleBlock c ext)
forall blk. MockState blk -> Point blk
mockTip MockState (SimpleBlock c ext)
st

instance GetTip (Ticked (LedgerState (SimpleBlock c ext))) where
  getTip :: forall (mk :: * -> * -> *).
Ticked (LedgerState (SimpleBlock c ext)) mk
-> Point (Ticked (LedgerState (SimpleBlock c ext)))
getTip = Point (LedgerState (SimpleBlock c ext))
-> Point (Ticked (LedgerState (SimpleBlock c ext)))
forall {k1} {k2} (b :: k1) (b' :: k2).
Coercible (HeaderHash b) (HeaderHash b') =>
Point b -> Point b'
castPoint (Point (LedgerState (SimpleBlock c ext))
 -> Point (Ticked (LedgerState (SimpleBlock c ext))))
-> (Ticked (LedgerState (SimpleBlock c ext)) mk
    -> Point (LedgerState (SimpleBlock c ext)))
-> Ticked (LedgerState (SimpleBlock c ext)) mk
-> Point (Ticked (LedgerState (SimpleBlock c ext)))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. LedgerState (SimpleBlock c ext) mk
-> Point (LedgerState (SimpleBlock c ext))
forall (mk :: * -> * -> *).
LedgerState (SimpleBlock c ext) mk
-> Point (LedgerState (SimpleBlock c ext))
forall (l :: LedgerStateKind) (mk :: * -> * -> *).
GetTip l =>
l mk -> Point l
getTip (LedgerState (SimpleBlock c ext) mk
 -> Point (LedgerState (SimpleBlock c ext)))
-> (Ticked (LedgerState (SimpleBlock c ext)) mk
    -> LedgerState (SimpleBlock c ext) mk)
-> Ticked (LedgerState (SimpleBlock c ext)) mk
-> Point (LedgerState (SimpleBlock c ext))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Ticked (LedgerState (SimpleBlock c ext)) mk
-> LedgerState (SimpleBlock c ext) mk
forall c ext (mk :: * -> * -> *).
Ticked (LedgerState (SimpleBlock c ext)) mk
-> LedgerState (SimpleBlock c ext) mk
getTickedSimpleLedgerState

instance MockProtocolSpecific c ext
      => IsLedger (LedgerState (SimpleBlock c ext)) where
  type LedgerErr (LedgerState (SimpleBlock c ext)) = MockError (SimpleBlock c ext)

  type AuxLedgerEvent (LedgerState (SimpleBlock c ext)) = VoidLedgerEvent (LedgerState (SimpleBlock c ext))

  applyChainTickLedgerResult :: ComputeLedgerEvents
-> LedgerCfg (LedgerState (SimpleBlock c ext))
-> SlotNo
-> LedgerState (SimpleBlock c ext) EmptyMK
-> LedgerResult
     (LedgerState (SimpleBlock c ext))
     (Ticked (LedgerState (SimpleBlock c ext)) DiffMK)
applyChainTickLedgerResult ComputeLedgerEvents
_ LedgerCfg (LedgerState (SimpleBlock c ext))
_ SlotNo
_ = Ticked (LedgerState (SimpleBlock c ext)) DiffMK
-> LedgerResult
     (LedgerState (SimpleBlock c ext))
     (Ticked (LedgerState (SimpleBlock c ext)) DiffMK)
forall a (l :: LedgerStateKind). a -> LedgerResult l a
pureLedgerResult
                                   (Ticked (LedgerState (SimpleBlock c ext)) DiffMK
 -> LedgerResult
      (LedgerState (SimpleBlock c ext))
      (Ticked (LedgerState (SimpleBlock c ext)) DiffMK))
-> (LedgerState (SimpleBlock c ext) EmptyMK
    -> Ticked (LedgerState (SimpleBlock c ext)) DiffMK)
-> LedgerState (SimpleBlock c ext) EmptyMK
-> LedgerResult
     (LedgerState (SimpleBlock c ext))
     (Ticked (LedgerState (SimpleBlock c ext)) DiffMK)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. LedgerState (SimpleBlock c ext) DiffMK
-> Ticked (LedgerState (SimpleBlock c ext)) DiffMK
forall c ext (mk :: * -> * -> *).
LedgerState (SimpleBlock c ext) mk
-> Ticked (LedgerState (SimpleBlock c ext)) mk
TickedSimpleLedgerState
                                   (LedgerState (SimpleBlock c ext) DiffMK
 -> Ticked (LedgerState (SimpleBlock c ext)) DiffMK)
-> (LedgerState (SimpleBlock c ext) EmptyMK
    -> LedgerState (SimpleBlock c ext) DiffMK)
-> LedgerState (SimpleBlock c ext) EmptyMK
-> Ticked (LedgerState (SimpleBlock c ext)) DiffMK
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (MockState (SimpleBlock c ext)
 -> LedgerTables (LedgerState (SimpleBlock c ext)) DiffMK
 -> LedgerState (SimpleBlock c ext) DiffMK)
-> LedgerTables (LedgerState (SimpleBlock c ext)) DiffMK
-> MockState (SimpleBlock c ext)
-> LedgerState (SimpleBlock c ext) DiffMK
forall a b c. (a -> b -> c) -> b -> a -> c
flip MockState (SimpleBlock c ext)
-> LedgerTables (LedgerState (SimpleBlock c ext)) DiffMK
-> LedgerState (SimpleBlock c ext) DiffMK
forall c ext (mk :: * -> * -> *).
MockState (SimpleBlock c ext)
-> LedgerTables (LedgerState (SimpleBlock c ext)) mk
-> LedgerState (SimpleBlock c ext) mk
SimpleLedgerState LedgerTables (LedgerState (SimpleBlock c ext)) DiffMK
forall (mk :: * -> * -> *) (l :: LedgerStateKind).
(ZeroableMK mk, LedgerTableConstraints l) =>
LedgerTables l mk
emptyLedgerTables
                                   (MockState (SimpleBlock c ext)
 -> LedgerState (SimpleBlock c ext) DiffMK)
-> (LedgerState (SimpleBlock c ext) EmptyMK
    -> MockState (SimpleBlock c ext))
-> LedgerState (SimpleBlock c ext) EmptyMK
-> LedgerState (SimpleBlock c ext) DiffMK
forall b c a. (b -> c) -> (a -> b) -> a -> c
. LedgerState (SimpleBlock c ext) EmptyMK
-> MockState (SimpleBlock c ext)
forall c ext (mk :: * -> * -> *).
LedgerState (SimpleBlock c ext) mk -> MockState (SimpleBlock c ext)
simpleLedgerState

instance MockProtocolSpecific c ext
      => ApplyBlock (LedgerState (SimpleBlock c ext)) (SimpleBlock c ext) where
  applyBlockLedgerResultWithValidation :: HasCallStack =>
ValidationPolicy
-> ComputeLedgerEvents
-> LedgerCfg (LedgerState (SimpleBlock c ext))
-> SimpleBlock c ext
-> Ticked (LedgerState (SimpleBlock c ext)) ValuesMK
-> Except
     (LedgerErr (LedgerState (SimpleBlock c ext)))
     (LedgerResult
        (LedgerState (SimpleBlock c ext))
        (LedgerState (SimpleBlock c ext) DiffMK))
applyBlockLedgerResultWithValidation ValidationPolicy
_validation ComputeLedgerEvents
_events LedgerCfg (LedgerState (SimpleBlock c ext))
a SimpleBlock c ext
blk Ticked (LedgerState (SimpleBlock c ext)) ValuesMK
st =
      (LedgerState (SimpleBlock c ext) EmptyMK
 -> LedgerResult
      (LedgerState (SimpleBlock c ext))
      (LedgerState (SimpleBlock c ext) DiffMK))
-> ExceptT
     (MockError (SimpleBlock c ext))
     Identity
     (LedgerState (SimpleBlock c ext) EmptyMK)
-> ExceptT
     (MockError (SimpleBlock c ext))
     Identity
     (LedgerResult
        (LedgerState (SimpleBlock c ext))
        (LedgerState (SimpleBlock c ext) DiffMK))
forall a b.
(a -> b)
-> ExceptT (MockError (SimpleBlock c ext)) Identity a
-> ExceptT (MockError (SimpleBlock c ext)) Identity b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ( LedgerState (SimpleBlock c ext) DiffMK
-> LedgerResult
     (LedgerState (SimpleBlock c ext))
     (LedgerState (SimpleBlock c ext) DiffMK)
forall a (l :: LedgerStateKind). a -> LedgerResult l a
pureLedgerResult
           (LedgerState (SimpleBlock c ext) DiffMK
 -> LedgerResult
      (LedgerState (SimpleBlock c ext))
      (LedgerState (SimpleBlock c ext) DiffMK))
-> (LedgerState (SimpleBlock c ext) EmptyMK
    -> LedgerState (SimpleBlock c ext) DiffMK)
-> LedgerState (SimpleBlock c ext) EmptyMK
-> LedgerResult
     (LedgerState (SimpleBlock c ext))
     (LedgerState (SimpleBlock c ext) DiffMK)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. LedgerState (SimpleBlock c ext) TrackingMK
-> LedgerState (SimpleBlock c ext) DiffMK
forall (l :: LedgerStateKind).
(HasLedgerTables l, LedgerTableConstraints l) =>
l TrackingMK -> l DiffMK
trackingToDiffs
           (LedgerState (SimpleBlock c ext) TrackingMK
 -> LedgerState (SimpleBlock c ext) DiffMK)
-> (LedgerState (SimpleBlock c ext) EmptyMK
    -> LedgerState (SimpleBlock c ext) TrackingMK)
-> LedgerState (SimpleBlock c ext) EmptyMK
-> LedgerState (SimpleBlock c ext) DiffMK
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Ticked (LedgerState (SimpleBlock c ext)) ValuesMK
-> LedgerState (SimpleBlock c ext) ValuesMK
-> LedgerState (SimpleBlock c ext) TrackingMK
forall (l :: LedgerStateKind) (l' :: LedgerStateKind).
(SameUtxoTypes l l', HasLedgerTables l, HasLedgerTables l') =>
l ValuesMK -> l' ValuesMK -> l' TrackingMK
calculateDifference Ticked (LedgerState (SimpleBlock c ext)) ValuesMK
st
           (LedgerState (SimpleBlock c ext) ValuesMK
 -> LedgerState (SimpleBlock c ext) TrackingMK)
-> (LedgerState (SimpleBlock c ext) EmptyMK
    -> LedgerState (SimpleBlock c ext) ValuesMK)
-> LedgerState (SimpleBlock c ext) EmptyMK
-> LedgerState (SimpleBlock c ext) TrackingMK
forall b c a. (b -> c) -> (a -> b) -> a -> c
. LedgerState (SimpleBlock c ext) EmptyMK
-> LedgerState (SimpleBlock c ext) ValuesMK
forall (l :: LedgerStateKind).
CanStowLedgerTables l =>
l EmptyMK -> l ValuesMK
unstowLedgerTables
           )
      (ExceptT
   (MockError (SimpleBlock c ext))
   Identity
   (LedgerState (SimpleBlock c ext) EmptyMK)
 -> Except
      (LedgerErr (LedgerState (SimpleBlock c ext)))
      (LedgerResult
         (LedgerState (SimpleBlock c ext))
         (LedgerState (SimpleBlock c ext) DiffMK)))
-> (LedgerState (SimpleBlock c ext) ValuesMK
    -> ExceptT
         (MockError (SimpleBlock c ext))
         Identity
         (LedgerState (SimpleBlock c ext) EmptyMK))
-> LedgerState (SimpleBlock c ext) ValuesMK
-> Except
     (LedgerErr (LedgerState (SimpleBlock c ext)))
     (LedgerResult
        (LedgerState (SimpleBlock c ext))
        (LedgerState (SimpleBlock c ext) DiffMK))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. LedgerCfg (LedgerState (SimpleBlock c ext))
-> SimpleBlock c ext
-> TickedLedgerState (SimpleBlock c ext) EmptyMK
-> ExceptT
     (MockError (SimpleBlock c ext))
     Identity
     (LedgerState (SimpleBlock c ext) EmptyMK)
forall c ext (mk1 :: * -> * -> *).
(SimpleCrypto c, Typeable ext) =>
LedgerConfig (SimpleBlock c ext)
-> SimpleBlock c ext
-> TickedLedgerState (SimpleBlock c ext) mk1
-> Except
     (MockError (SimpleBlock c ext))
     (LedgerState (SimpleBlock c ext) mk1)
updateSimpleLedgerState LedgerCfg (LedgerState (SimpleBlock c ext))
a SimpleBlock c ext
blk
      (TickedLedgerState (SimpleBlock c ext) EmptyMK
 -> ExceptT
      (MockError (SimpleBlock c ext))
      Identity
      (LedgerState (SimpleBlock c ext) EmptyMK))
-> (LedgerState (SimpleBlock c ext) ValuesMK
    -> TickedLedgerState (SimpleBlock c ext) EmptyMK)
-> LedgerState (SimpleBlock c ext) ValuesMK
-> ExceptT
     (MockError (SimpleBlock c ext))
     Identity
     (LedgerState (SimpleBlock c ext) EmptyMK)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. LedgerState (SimpleBlock c ext) EmptyMK
-> TickedLedgerState (SimpleBlock c ext) EmptyMK
forall c ext (mk :: * -> * -> *).
LedgerState (SimpleBlock c ext) mk
-> Ticked (LedgerState (SimpleBlock c ext)) mk
TickedSimpleLedgerState
      (LedgerState (SimpleBlock c ext) EmptyMK
 -> TickedLedgerState (SimpleBlock c ext) EmptyMK)
-> (LedgerState (SimpleBlock c ext) ValuesMK
    -> LedgerState (SimpleBlock c ext) EmptyMK)
-> LedgerState (SimpleBlock c ext) ValuesMK
-> TickedLedgerState (SimpleBlock c ext) EmptyMK
forall b c a. (b -> c) -> (a -> b) -> a -> c
. LedgerState (SimpleBlock c ext) ValuesMK
-> LedgerState (SimpleBlock c ext) EmptyMK
forall (l :: LedgerStateKind).
CanStowLedgerTables l =>
l ValuesMK -> l EmptyMK
stowLedgerTables
      (LedgerState (SimpleBlock c ext) ValuesMK
 -> Except
      (LedgerErr (LedgerState (SimpleBlock c ext)))
      (LedgerResult
         (LedgerState (SimpleBlock c ext))
         (LedgerState (SimpleBlock c ext) DiffMK)))
-> LedgerState (SimpleBlock c ext) ValuesMK
-> Except
     (LedgerErr (LedgerState (SimpleBlock c ext)))
     (LedgerResult
        (LedgerState (SimpleBlock c ext))
        (LedgerState (SimpleBlock c ext) DiffMK))
forall a b. (a -> b) -> a -> b
$ Ticked (LedgerState (SimpleBlock c ext)) ValuesMK
-> LedgerState (SimpleBlock c ext) ValuesMK
forall c ext (mk :: * -> * -> *).
Ticked (LedgerState (SimpleBlock c ext)) mk
-> LedgerState (SimpleBlock c ext) mk
getTickedSimpleLedgerState Ticked (LedgerState (SimpleBlock c ext)) ValuesMK
st

  applyBlockLedgerResult :: HasCallStack =>
ComputeLedgerEvents
-> LedgerCfg (LedgerState (SimpleBlock c ext))
-> SimpleBlock c ext
-> Ticked (LedgerState (SimpleBlock c ext)) ValuesMK
-> Except
     (LedgerErr (LedgerState (SimpleBlock c ext)))
     (LedgerResult
        (LedgerState (SimpleBlock c ext))
        (LedgerState (SimpleBlock c ext) DiffMK))
applyBlockLedgerResult = ComputeLedgerEvents
-> LedgerCfg (LedgerState (SimpleBlock c ext))
-> SimpleBlock c ext
-> Ticked (LedgerState (SimpleBlock c ext)) ValuesMK
-> Except
     (LedgerErr (LedgerState (SimpleBlock c ext)))
     (LedgerResult
        (LedgerState (SimpleBlock c ext))
        (LedgerState (SimpleBlock c ext) DiffMK))
forall (l :: LedgerStateKind) blk.
(HasCallStack, ApplyBlock l blk) =>
ComputeLedgerEvents
-> LedgerCfg l
-> blk
-> Ticked l ValuesMK
-> Except (LedgerErr l) (LedgerResult l (l DiffMK))
defaultApplyBlockLedgerResult
  reapplyBlockLedgerResult :: HasCallStack =>
ComputeLedgerEvents
-> LedgerCfg (LedgerState (SimpleBlock c ext))
-> SimpleBlock c ext
-> Ticked (LedgerState (SimpleBlock c ext)) ValuesMK
-> LedgerResult
     (LedgerState (SimpleBlock c ext))
     (LedgerState (SimpleBlock c ext) DiffMK)
reapplyBlockLedgerResult =
    (LedgerErr (LedgerState (SimpleBlock c ext))
 -> LedgerResult
      (LedgerState (SimpleBlock c ext))
      (LedgerState (SimpleBlock c ext) DiffMK))
-> ComputeLedgerEvents
-> LedgerCfg (LedgerState (SimpleBlock c ext))
-> SimpleBlock c ext
-> Ticked (LedgerState (SimpleBlock c ext)) ValuesMK
-> LedgerResult
     (LedgerState (SimpleBlock c ext))
     (LedgerState (SimpleBlock c ext) DiffMK)
forall (l :: LedgerStateKind) blk.
(HasCallStack, ApplyBlock l blk) =>
(LedgerErr l -> LedgerResult l (l DiffMK))
-> ComputeLedgerEvents
-> LedgerCfg l
-> blk
-> Ticked l ValuesMK
-> LedgerResult l (l DiffMK)
defaultReapplyBlockLedgerResult (String
-> LedgerResult
     (LedgerState (SimpleBlock c ext))
     (LedgerState (SimpleBlock c ext) DiffMK)
forall a. HasCallStack => String -> a
error (String
 -> LedgerResult
      (LedgerState (SimpleBlock c ext))
      (LedgerState (SimpleBlock c ext) DiffMK))
-> (MockError (SimpleBlock c ext) -> String)
-> MockError (SimpleBlock c ext)
-> LedgerResult
     (LedgerState (SimpleBlock c ext))
     (LedgerState (SimpleBlock c ext) DiffMK)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (String
"reapplyBlockLedgerResult: unexpected error: " String -> ShowS
forall a. Semigroup a => a -> a -> a
<>) ShowS
-> (MockError (SimpleBlock c ext) -> String)
-> MockError (SimpleBlock c ext)
-> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. MockError (SimpleBlock c ext) -> String
forall a. Show a => a -> String
show)

  getBlockKeySets :: SimpleBlock c ext
-> LedgerTables (LedgerState (SimpleBlock c ext)) KeysMK
getBlockKeySets SimpleBlock{simpleBody :: forall c ext ext'. SimpleBlock' c ext ext' -> SimpleBody
simpleBody = SimpleBody [Tx]
txs} =
    KeysMK
  (TxIn (LedgerState (SimpleBlock c ext)))
  (TxOut (LedgerState (SimpleBlock c ext)))
-> LedgerTables (LedgerState (SimpleBlock c ext)) KeysMK
forall (l :: LedgerStateKind) (mk :: * -> * -> *).
mk (TxIn l) (TxOut l) -> LedgerTables l mk
LedgerTables (KeysMK
   (TxIn (LedgerState (SimpleBlock c ext)))
   (TxOut (LedgerState (SimpleBlock c ext)))
 -> LedgerTables (LedgerState (SimpleBlock c ext)) KeysMK)
-> KeysMK
     (TxIn (LedgerState (SimpleBlock c ext)))
     (TxOut (LedgerState (SimpleBlock c ext)))
-> LedgerTables (LedgerState (SimpleBlock c ext)) KeysMK
forall a b. (a -> b) -> a -> b
$ Set TxIn -> KeysMK TxIn (TxOut (LedgerState (SimpleBlock c ext)))
forall k v. Set k -> KeysMK k v
KeysMK (Set TxIn -> KeysMK TxIn (TxOut (LedgerState (SimpleBlock c ext))))
-> Set TxIn
-> KeysMK TxIn (TxOut (LedgerState (SimpleBlock c ext)))
forall a b. (a -> b) -> a -> b
$ [Tx] -> Set TxIn
forall a. HasMockTxs a => a -> Set TxIn
Mock.txIns [Tx]
txs

data instance LedgerState (SimpleBlock c ext) mk  = SimpleLedgerState {
      forall c ext (mk :: * -> * -> *).
LedgerState (SimpleBlock c ext) mk -> MockState (SimpleBlock c ext)
simpleLedgerState :: MockState (SimpleBlock c ext)
    , forall c ext (mk :: * -> * -> *).
LedgerState (SimpleBlock c ext) mk
-> LedgerTables (LedgerState (SimpleBlock c ext)) mk
simpleLedgerTables :: LedgerTables (LedgerState (SimpleBlock c ext)) mk
    }
  deriving stock   ((forall x.
 LedgerState (SimpleBlock c ext) mk
 -> Rep (LedgerState (SimpleBlock c ext) mk) x)
-> (forall x.
    Rep (LedgerState (SimpleBlock c ext) mk) x
    -> LedgerState (SimpleBlock c ext) mk)
-> Generic (LedgerState (SimpleBlock c ext) mk)
forall x.
Rep (LedgerState (SimpleBlock c ext) mk) x
-> LedgerState (SimpleBlock c ext) mk
forall x.
LedgerState (SimpleBlock c ext) mk
-> Rep (LedgerState (SimpleBlock c ext) mk) x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
forall c ext (mk :: * -> * -> *) x.
Rep (LedgerState (SimpleBlock c ext) mk) x
-> LedgerState (SimpleBlock c ext) mk
forall c ext (mk :: * -> * -> *) x.
LedgerState (SimpleBlock c ext) mk
-> Rep (LedgerState (SimpleBlock c ext) mk) x
$cfrom :: forall c ext (mk :: * -> * -> *) x.
LedgerState (SimpleBlock c ext) mk
-> Rep (LedgerState (SimpleBlock c ext) mk) x
from :: forall x.
LedgerState (SimpleBlock c ext) mk
-> Rep (LedgerState (SimpleBlock c ext) mk) x
$cto :: forall c ext (mk :: * -> * -> *) x.
Rep (LedgerState (SimpleBlock c ext) mk) x
-> LedgerState (SimpleBlock c ext) mk
to :: forall x.
Rep (LedgerState (SimpleBlock c ext) mk) x
-> LedgerState (SimpleBlock c ext) mk
Generic)

deriving instance ( SimpleCrypto c
                  , Typeable ext
                  , Eq (mk Mock.TxIn Mock.TxOut)
                  )
                  => Eq (LedgerState (SimpleBlock c ext) mk)
deriving instance ( SimpleCrypto c
                  , Typeable ext
                  , NoThunks (mk Mock.TxIn Mock.TxOut)
                  )
                  => NoThunks (LedgerState (SimpleBlock c ext) mk)
deriving instance ( SimpleCrypto c
                  , Typeable ext
                  , Show (mk Mock.TxIn Mock.TxOut)
                  )
                  => Show (LedgerState (SimpleBlock c ext) mk)

-- Ticking has no effect on the simple ledger state
newtype instance Ticked (LedgerState (SimpleBlock c ext)) mk = TickedSimpleLedgerState {
      forall c ext (mk :: * -> * -> *).
Ticked (LedgerState (SimpleBlock c ext)) mk
-> LedgerState (SimpleBlock c ext) mk
getTickedSimpleLedgerState :: LedgerState (SimpleBlock c ext) mk
    }
  deriving ((forall x.
 Ticked (LedgerState (SimpleBlock c ext)) mk
 -> Rep (Ticked (LedgerState (SimpleBlock c ext)) mk) x)
-> (forall x.
    Rep (Ticked (LedgerState (SimpleBlock c ext)) mk) x
    -> Ticked (LedgerState (SimpleBlock c ext)) mk)
-> Generic (Ticked (LedgerState (SimpleBlock c ext)) mk)
forall x.
Rep (Ticked (LedgerState (SimpleBlock c ext)) mk) x
-> Ticked (LedgerState (SimpleBlock c ext)) mk
forall x.
Ticked (LedgerState (SimpleBlock c ext)) mk
-> Rep (Ticked (LedgerState (SimpleBlock c ext)) mk) x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
forall c ext (mk :: * -> * -> *) x.
Rep (Ticked (LedgerState (SimpleBlock c ext)) mk) x
-> Ticked (LedgerState (SimpleBlock c ext)) mk
forall c ext (mk :: * -> * -> *) x.
Ticked (LedgerState (SimpleBlock c ext)) mk
-> Rep (Ticked (LedgerState (SimpleBlock c ext)) mk) x
$cfrom :: forall c ext (mk :: * -> * -> *) x.
Ticked (LedgerState (SimpleBlock c ext)) mk
-> Rep (Ticked (LedgerState (SimpleBlock c ext)) mk) x
from :: forall x.
Ticked (LedgerState (SimpleBlock c ext)) mk
-> Rep (Ticked (LedgerState (SimpleBlock c ext)) mk) x
$cto :: forall c ext (mk :: * -> * -> *) x.
Rep (Ticked (LedgerState (SimpleBlock c ext)) mk) x
-> Ticked (LedgerState (SimpleBlock c ext)) mk
to :: forall x.
Rep (Ticked (LedgerState (SimpleBlock c ext)) mk) x
-> Ticked (LedgerState (SimpleBlock c ext)) mk
Generic)

deriving anyclass instance ( SimpleCrypto c
                           , Typeable ext
                           )
                           => NoThunks (Ticked (LedgerState (SimpleBlock c ext)) TrackingMK)
deriving instance ( SimpleCrypto c
                  , Typeable ext
                  , Show (LedgerState (SimpleBlock c ext) mk)
                  )
                  => Show (Ticked (LedgerState (SimpleBlock c ext)) mk)

instance MockProtocolSpecific c ext => UpdateLedger (SimpleBlock c ext)

updateSimpleLedgerState :: (SimpleCrypto c, Typeable ext)
                        => LedgerConfig (SimpleBlock c ext)
                        -> SimpleBlock c ext
                        -> TickedLedgerState (SimpleBlock c ext) mk1
                        -> Except (MockError (SimpleBlock c ext))
                                  (LedgerState (SimpleBlock c ext) mk1)
updateSimpleLedgerState :: forall c ext (mk1 :: * -> * -> *).
(SimpleCrypto c, Typeable ext) =>
LedgerConfig (SimpleBlock c ext)
-> SimpleBlock c ext
-> TickedLedgerState (SimpleBlock c ext) mk1
-> Except
     (MockError (SimpleBlock c ext))
     (LedgerState (SimpleBlock c ext) mk1)
updateSimpleLedgerState LedgerConfig (SimpleBlock c ext)
cfg SimpleBlock c ext
b (TickedSimpleLedgerState (SimpleLedgerState MockState (SimpleBlock c ext)
st LedgerTables (LedgerState (SimpleBlock c ext)) mk1
tbs)) =
    (MockState (SimpleBlock c ext)
 -> LedgerTables (LedgerState (SimpleBlock c ext)) mk1
 -> LedgerState (SimpleBlock c ext) mk1)
-> LedgerTables (LedgerState (SimpleBlock c ext)) mk1
-> MockState (SimpleBlock c ext)
-> LedgerState (SimpleBlock c ext) mk1
forall a b c. (a -> b -> c) -> b -> a -> c
flip MockState (SimpleBlock c ext)
-> LedgerTables (LedgerState (SimpleBlock c ext)) mk1
-> LedgerState (SimpleBlock c ext) mk1
forall c ext (mk :: * -> * -> *).
MockState (SimpleBlock c ext)
-> LedgerTables (LedgerState (SimpleBlock c ext)) mk
-> LedgerState (SimpleBlock c ext) mk
SimpleLedgerState LedgerTables (LedgerState (SimpleBlock c ext)) mk1
tbs (MockState (SimpleBlock c ext)
 -> LedgerState (SimpleBlock c ext) mk1)
-> ExceptT
     (MockError (SimpleBlock c ext))
     Identity
     (MockState (SimpleBlock c ext))
-> ExceptT
     (MockError (SimpleBlock c ext))
     Identity
     (LedgerState (SimpleBlock c ext) mk1)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> MockConfig
-> SimpleBlock c ext
-> MockState (SimpleBlock c ext)
-> ExceptT
     (MockError (SimpleBlock c ext))
     Identity
     (MockState (SimpleBlock c ext))
forall blk.
(GetPrevHash blk, HasMockTxs blk) =>
MockConfig
-> blk -> MockState blk -> Except (MockError blk) (MockState blk)
updateMockState (SimpleLedgerConfig c ext -> MockConfig
forall c ext. SimpleLedgerConfig c ext -> MockConfig
simpleLedgerMockConfig LedgerConfig (SimpleBlock c ext)
SimpleLedgerConfig c ext
cfg) SimpleBlock c ext
b MockState (SimpleBlock c ext)
st

updateSimpleUTxO :: Mock.HasMockTxs a
                 => LedgerConfig (SimpleBlock c ext)
                 -> SlotNo
                 -> a
                 -> TickedLedgerState (SimpleBlock c ext) EmptyMK
                 -> Except (MockError (SimpleBlock c ext))
                           (TickedLedgerState (SimpleBlock c ext) EmptyMK)
updateSimpleUTxO :: forall a c ext.
HasMockTxs a =>
LedgerConfig (SimpleBlock c ext)
-> SlotNo
-> a
-> TickedLedgerState (SimpleBlock c ext) EmptyMK
-> Except
     (MockError (SimpleBlock c ext))
     (TickedLedgerState (SimpleBlock c ext) EmptyMK)
updateSimpleUTxO LedgerConfig (SimpleBlock c ext)
cfg SlotNo
slot a
x (TickedSimpleLedgerState (SimpleLedgerState MockState (SimpleBlock c ext)
st LedgerTables (LedgerState (SimpleBlock c ext)) EmptyMK
tbs)) =
    LedgerState (SimpleBlock c ext) EmptyMK
-> TickedLedgerState (SimpleBlock c ext) EmptyMK
forall c ext (mk :: * -> * -> *).
LedgerState (SimpleBlock c ext) mk
-> Ticked (LedgerState (SimpleBlock c ext)) mk
TickedSimpleLedgerState (LedgerState (SimpleBlock c ext) EmptyMK
 -> TickedLedgerState (SimpleBlock c ext) EmptyMK)
-> (MockState (SimpleBlock c ext)
    -> LedgerState (SimpleBlock c ext) EmptyMK)
-> MockState (SimpleBlock c ext)
-> TickedLedgerState (SimpleBlock c ext) EmptyMK
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (MockState (SimpleBlock c ext)
 -> LedgerTables (LedgerState (SimpleBlock c ext)) EmptyMK
 -> LedgerState (SimpleBlock c ext) EmptyMK)
-> LedgerTables (LedgerState (SimpleBlock c ext)) EmptyMK
-> MockState (SimpleBlock c ext)
-> LedgerState (SimpleBlock c ext) EmptyMK
forall a b c. (a -> b -> c) -> b -> a -> c
flip MockState (SimpleBlock c ext)
-> LedgerTables (LedgerState (SimpleBlock c ext)) EmptyMK
-> LedgerState (SimpleBlock c ext) EmptyMK
forall c ext (mk :: * -> * -> *).
MockState (SimpleBlock c ext)
-> LedgerTables (LedgerState (SimpleBlock c ext)) mk
-> LedgerState (SimpleBlock c ext) mk
SimpleLedgerState LedgerTables (LedgerState (SimpleBlock c ext)) EmptyMK
tbs
      (MockState (SimpleBlock c ext)
 -> TickedLedgerState (SimpleBlock c ext) EmptyMK)
-> ExceptT
     (MockError (SimpleBlock c ext))
     Identity
     (MockState (SimpleBlock c ext))
-> ExceptT
     (MockError (SimpleBlock c ext))
     Identity
     (TickedLedgerState (SimpleBlock c ext) EmptyMK)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> MockConfig
-> SlotNo
-> a
-> MockState (SimpleBlock c ext)
-> ExceptT
     (MockError (SimpleBlock c ext))
     Identity
     (MockState (SimpleBlock c ext))
forall a blk.
HasMockTxs a =>
MockConfig
-> SlotNo
-> a
-> MockState blk
-> Except (MockError blk) (MockState blk)
updateMockUTxO (SimpleLedgerConfig c ext -> MockConfig
forall c ext. SimpleLedgerConfig c ext -> MockConfig
simpleLedgerMockConfig LedgerConfig (SimpleBlock c ext)
SimpleLedgerConfig c ext
cfg) SlotNo
slot a
x MockState (SimpleBlock c ext)
st

genesisSimpleLedgerState :: AddrDist -> LedgerState (SimpleBlock c ext) ValuesMK
genesisSimpleLedgerState :: forall c ext. AddrDist -> LedgerState (SimpleBlock c ext) ValuesMK
genesisSimpleLedgerState =
    LedgerState (SimpleBlock c ext) EmptyMK
-> LedgerState (SimpleBlock c ext) ValuesMK
forall (l :: LedgerStateKind).
CanStowLedgerTables l =>
l EmptyMK -> l ValuesMK
unstowLedgerTables
  (LedgerState (SimpleBlock c ext) EmptyMK
 -> LedgerState (SimpleBlock c ext) ValuesMK)
-> (AddrDist -> LedgerState (SimpleBlock c ext) EmptyMK)
-> AddrDist
-> LedgerState (SimpleBlock c ext) ValuesMK
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (MockState (SimpleBlock c ext)
 -> LedgerTables (LedgerState (SimpleBlock c ext)) EmptyMK
 -> LedgerState (SimpleBlock c ext) EmptyMK)
-> LedgerTables (LedgerState (SimpleBlock c ext)) EmptyMK
-> MockState (SimpleBlock c ext)
-> LedgerState (SimpleBlock c ext) EmptyMK
forall a b c. (a -> b -> c) -> b -> a -> c
flip MockState (SimpleBlock c ext)
-> LedgerTables (LedgerState (SimpleBlock c ext)) EmptyMK
-> LedgerState (SimpleBlock c ext) EmptyMK
forall c ext (mk :: * -> * -> *).
MockState (SimpleBlock c ext)
-> LedgerTables (LedgerState (SimpleBlock c ext)) mk
-> LedgerState (SimpleBlock c ext) mk
SimpleLedgerState LedgerTables (LedgerState (SimpleBlock c ext)) EmptyMK
forall (mk :: * -> * -> *) (l :: LedgerStateKind).
(ZeroableMK mk, LedgerTableConstraints l) =>
LedgerTables l mk
emptyLedgerTables
  (MockState (SimpleBlock c ext)
 -> LedgerState (SimpleBlock c ext) EmptyMK)
-> (AddrDist -> MockState (SimpleBlock c ext))
-> AddrDist
-> LedgerState (SimpleBlock c ext) EmptyMK
forall b c a. (b -> c) -> (a -> b) -> a -> c
. AddrDist -> MockState (SimpleBlock c ext)
forall blk. AddrDist -> MockState blk
genesisMockState

-- | Dummy values
instance MockProtocolSpecific c ext => CommonProtocolParams (SimpleBlock c ext) where
  maxHeaderSize :: forall (mk :: * -> * -> *).
LedgerState (SimpleBlock c ext) mk -> Word32
maxHeaderSize = Word32 -> LedgerState (SimpleBlock c ext) mk -> Word32
forall a b. a -> b -> a
const Word32
2000000
  maxTxSize :: forall (mk :: * -> * -> *).
LedgerState (SimpleBlock c ext) mk -> Word32
maxTxSize     = Word32 -> LedgerState (SimpleBlock c ext) mk -> Word32
forall a b. a -> b -> a
const Word32
2000000

instance LedgerSupportsPeerSelection (SimpleBlock c ext) where
  getPeers :: forall (mk :: * -> * -> *).
LedgerState (SimpleBlock c ext) mk
-> [(PoolStake, NonEmpty StakePoolRelay)]
getPeers = [(PoolStake, NonEmpty StakePoolRelay)]
-> LedgerState (SimpleBlock c ext) mk
-> [(PoolStake, NonEmpty StakePoolRelay)]
forall a b. a -> b -> a
const []

{-------------------------------------------------------------------------------
  LedgerTables
-------------------------------------------------------------------------------}

type instance TxIn  (LedgerState (SimpleBlock c ext)) = Mock.TxIn
type instance TxOut (LedgerState (SimpleBlock c ext)) = Mock.TxOut

instance CanUpgradeLedgerTables (LedgerState (SimpleBlock c ext)) where
  upgradeTables :: forall (mk1 :: * -> * -> *) (mk2 :: * -> * -> *).
LedgerState (SimpleBlock c ext) mk1
-> LedgerState (SimpleBlock c ext) mk2
-> LedgerTables (LedgerState (SimpleBlock c ext)) ValuesMK
-> LedgerTables (LedgerState (SimpleBlock c ext)) ValuesMK
upgradeTables LedgerState (SimpleBlock c ext) mk1
_ LedgerState (SimpleBlock c ext) mk2
_ = LedgerTables (LedgerState (SimpleBlock c ext)) ValuesMK
-> LedgerTables (LedgerState (SimpleBlock c ext)) ValuesMK
forall a. a -> a
id

instance IndexedMemPack (LedgerState (SimpleBlock c ext) EmptyMK) Mock.TxOut where
  indexedTypeName :: LedgerState (SimpleBlock c ext) EmptyMK -> String
indexedTypeName LedgerState (SimpleBlock c ext) EmptyMK
_ = forall a. MemPack a => String
typeName @Mock.TxOut
  indexedPackedByteCount :: LedgerState (SimpleBlock c ext) EmptyMK -> TxOut -> Int
indexedPackedByteCount LedgerState (SimpleBlock c ext) EmptyMK
_ = TxOut -> Int
forall a. MemPack a => a -> Int
packedByteCount
  indexedPackM :: forall s.
LedgerState (SimpleBlock c ext) EmptyMK -> TxOut -> Pack s ()
indexedPackM LedgerState (SimpleBlock c ext) EmptyMK
_ = TxOut -> Pack s ()
forall s. TxOut -> Pack s ()
forall a s. MemPack a => a -> Pack s ()
packM
  indexedUnpackM :: forall b.
Buffer b =>
LedgerState (SimpleBlock c ext) EmptyMK -> Unpack b TxOut
indexedUnpackM LedgerState (SimpleBlock c ext) EmptyMK
_ = Unpack b TxOut
forall b. Buffer b => Unpack b TxOut
forall a b. (MemPack a, Buffer b) => Unpack b a
unpackM

instance SerializeTablesWithHint (LedgerState (SimpleBlock c ext)) where
  encodeTablesWithHint :: SerializeTablesHint
  (LedgerTables (LedgerState (SimpleBlock c ext)) ValuesMK)
-> LedgerTables (LedgerState (SimpleBlock c ext)) ValuesMK
-> Encoding
encodeTablesWithHint = SerializeTablesHint
  (LedgerTables (LedgerState (SimpleBlock c ext)) ValuesMK)
-> LedgerTables (LedgerState (SimpleBlock c ext)) ValuesMK
-> Encoding
forall (l :: LedgerStateKind).
(MemPack (TxIn l), MemPack (TxOut l)) =>
SerializeTablesHint (LedgerTables l ValuesMK)
-> LedgerTables l ValuesMK -> Encoding
defaultEncodeTablesWithHint
  decodeTablesWithHint :: forall s.
SerializeTablesHint
  (LedgerTables (LedgerState (SimpleBlock c ext)) ValuesMK)
-> Decoder
     s (LedgerTables (LedgerState (SimpleBlock c ext)) ValuesMK)
decodeTablesWithHint = SerializeTablesHint
  (LedgerTables (LedgerState (SimpleBlock c ext)) ValuesMK)
-> Decoder
     s (LedgerTables (LedgerState (SimpleBlock c ext)) ValuesMK)
forall (l :: LedgerStateKind) s.
(Ord (TxIn l), MemPack (TxIn l), MemPack (TxOut l)) =>
SerializeTablesHint (LedgerTables l ValuesMK)
-> Decoder s (LedgerTables l ValuesMK)
defaultDecodeTablesWithHint

instance HasLedgerTables (LedgerState (SimpleBlock c ext)) where
  projectLedgerTables :: forall (mk :: * -> * -> *).
(CanMapMK mk, CanMapKeysMK mk, ZeroableMK mk) =>
LedgerState (SimpleBlock c ext) mk
-> LedgerTables (LedgerState (SimpleBlock c ext)) mk
projectLedgerTables = LedgerState (SimpleBlock c ext) mk
-> LedgerTables (LedgerState (SimpleBlock c ext)) mk
forall c ext (mk :: * -> * -> *).
LedgerState (SimpleBlock c ext) mk
-> LedgerTables (LedgerState (SimpleBlock c ext)) mk
simpleLedgerTables
  withLedgerTables :: forall (mk :: * -> * -> *) (any :: * -> * -> *).
(CanMapMK mk, CanMapKeysMK mk, ZeroableMK mk) =>
LedgerState (SimpleBlock c ext) any
-> LedgerTables (LedgerState (SimpleBlock c ext)) mk
-> LedgerState (SimpleBlock c ext) mk
withLedgerTables (SimpleLedgerState MockState (SimpleBlock c ext)
s LedgerTables (LedgerState (SimpleBlock c ext)) any
_) = MockState (SimpleBlock c ext)
-> LedgerTables (LedgerState (SimpleBlock c ext)) mk
-> LedgerState (SimpleBlock c ext) mk
forall c ext (mk :: * -> * -> *).
MockState (SimpleBlock c ext)
-> LedgerTables (LedgerState (SimpleBlock c ext)) mk
-> LedgerState (SimpleBlock c ext) mk
SimpleLedgerState MockState (SimpleBlock c ext)
s

instance HasLedgerTables (Ticked (LedgerState (SimpleBlock c ext))) where
  projectLedgerTables :: forall (mk :: * -> * -> *).
(CanMapMK mk, CanMapKeysMK mk, ZeroableMK mk) =>
Ticked (LedgerState (SimpleBlock c ext)) mk
-> LedgerTables (Ticked (LedgerState (SimpleBlock c ext))) mk
projectLedgerTables = LedgerTables (LedgerState (SimpleBlock c ext)) mk
-> LedgerTables (Ticked (LedgerState (SimpleBlock c ext))) mk
forall (l :: LedgerStateKind) (l' :: LedgerStateKind)
       (mk :: * -> * -> *).
SameUtxoTypes l l' =>
LedgerTables l mk -> LedgerTables l' mk
castLedgerTables
                      (LedgerTables (LedgerState (SimpleBlock c ext)) mk
 -> LedgerTables (Ticked (LedgerState (SimpleBlock c ext))) mk)
-> (Ticked (LedgerState (SimpleBlock c ext)) mk
    -> LedgerTables (LedgerState (SimpleBlock c ext)) mk)
-> Ticked (LedgerState (SimpleBlock c ext)) mk
-> LedgerTables (Ticked (LedgerState (SimpleBlock c ext))) mk
forall b c a. (b -> c) -> (a -> b) -> a -> c
. LedgerState (SimpleBlock c ext) mk
-> LedgerTables (LedgerState (SimpleBlock c ext)) mk
forall c ext (mk :: * -> * -> *).
LedgerState (SimpleBlock c ext) mk
-> LedgerTables (LedgerState (SimpleBlock c ext)) mk
simpleLedgerTables
                      (LedgerState (SimpleBlock c ext) mk
 -> LedgerTables (LedgerState (SimpleBlock c ext)) mk)
-> (Ticked (LedgerState (SimpleBlock c ext)) mk
    -> LedgerState (SimpleBlock c ext) mk)
-> Ticked (LedgerState (SimpleBlock c ext)) mk
-> LedgerTables (LedgerState (SimpleBlock c ext)) mk
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Ticked (LedgerState (SimpleBlock c ext)) mk
-> LedgerState (SimpleBlock c ext) mk
forall c ext (mk :: * -> * -> *).
Ticked (LedgerState (SimpleBlock c ext)) mk
-> LedgerState (SimpleBlock c ext) mk
getTickedSimpleLedgerState
  withLedgerTables :: forall (mk :: * -> * -> *) (any :: * -> * -> *).
(CanMapMK mk, CanMapKeysMK mk, ZeroableMK mk) =>
Ticked (LedgerState (SimpleBlock c ext)) any
-> LedgerTables (Ticked (LedgerState (SimpleBlock c ext))) mk
-> Ticked (LedgerState (SimpleBlock c ext)) mk
withLedgerTables   (TickedSimpleLedgerState LedgerState (SimpleBlock c ext) any
st) LedgerTables (Ticked (LedgerState (SimpleBlock c ext))) mk
tables =
      LedgerState (SimpleBlock c ext) mk
-> Ticked (LedgerState (SimpleBlock c ext)) mk
forall c ext (mk :: * -> * -> *).
LedgerState (SimpleBlock c ext) mk
-> Ticked (LedgerState (SimpleBlock c ext)) mk
TickedSimpleLedgerState (LedgerState (SimpleBlock c ext) mk
 -> Ticked (LedgerState (SimpleBlock c ext)) mk)
-> LedgerState (SimpleBlock c ext) mk
-> Ticked (LedgerState (SimpleBlock c ext)) mk
forall a b. (a -> b) -> a -> b
$ LedgerState (SimpleBlock c ext) any
-> LedgerTables (LedgerState (SimpleBlock c ext)) mk
-> LedgerState (SimpleBlock c ext) mk
forall (mk :: * -> * -> *) (any :: * -> * -> *).
(CanMapMK mk, CanMapKeysMK mk, ZeroableMK mk) =>
LedgerState (SimpleBlock c ext) any
-> LedgerTables (LedgerState (SimpleBlock c ext)) mk
-> LedgerState (SimpleBlock c ext) mk
forall (l :: LedgerStateKind) (mk :: * -> * -> *)
       (any :: * -> * -> *).
(HasLedgerTables l, CanMapMK mk, CanMapKeysMK mk, ZeroableMK mk) =>
l any -> LedgerTables l mk -> l mk
withLedgerTables LedgerState (SimpleBlock c ext) any
st (LedgerTables (LedgerState (SimpleBlock c ext)) mk
 -> LedgerState (SimpleBlock c ext) mk)
-> LedgerTables (LedgerState (SimpleBlock c ext)) mk
-> LedgerState (SimpleBlock c ext) mk
forall a b. (a -> b) -> a -> b
$ LedgerTables (Ticked (LedgerState (SimpleBlock c ext))) mk
-> LedgerTables (LedgerState (SimpleBlock c ext)) mk
forall (l :: LedgerStateKind) (l' :: LedgerStateKind)
       (mk :: * -> * -> *).
SameUtxoTypes l l' =>
LedgerTables l mk -> LedgerTables l' mk
castLedgerTables LedgerTables (Ticked (LedgerState (SimpleBlock c ext))) mk
tables

instance CanStowLedgerTables (LedgerState (SimpleBlock c ext)) where
  stowLedgerTables :: LedgerState (SimpleBlock c ext) ValuesMK
-> LedgerState (SimpleBlock c ext) EmptyMK
stowLedgerTables LedgerState (SimpleBlock c ext) ValuesMK
st =
      SimpleLedgerState {
        simpleLedgerState :: MockState (SimpleBlock c ext)
simpleLedgerState  = MockState (SimpleBlock c ext)
simpleLedgerState { mockUtxo = m }
      , simpleLedgerTables :: LedgerTables (LedgerState (SimpleBlock c ext)) EmptyMK
simpleLedgerTables = LedgerTables (LedgerState (SimpleBlock c ext)) EmptyMK
forall (mk :: * -> * -> *) (l :: LedgerStateKind).
(ZeroableMK mk, LedgerTableConstraints l) =>
LedgerTables l mk
emptyLedgerTables
      }
    where
      SimpleLedgerState {
          MockState (SimpleBlock c ext)
simpleLedgerState :: forall c ext (mk :: * -> * -> *).
LedgerState (SimpleBlock c ext) mk -> MockState (SimpleBlock c ext)
simpleLedgerState :: MockState (SimpleBlock c ext)
simpleLedgerState
        , simpleLedgerTables :: forall c ext (mk :: * -> * -> *).
LedgerState (SimpleBlock c ext) mk
-> LedgerTables (LedgerState (SimpleBlock c ext)) mk
simpleLedgerTables = LedgerTables (ValuesMK Map TxIn TxOut
m)
        } = LedgerState (SimpleBlock c ext) ValuesMK
st

  unstowLedgerTables :: LedgerState (SimpleBlock c ext) EmptyMK
-> LedgerState (SimpleBlock c ext) ValuesMK
unstowLedgerTables LedgerState (SimpleBlock c ext) EmptyMK
st =
    SimpleLedgerState {
        simpleLedgerState :: MockState (SimpleBlock c ext)
simpleLedgerState = MockState (SimpleBlock c ext)
simpleLedgerState { mockUtxo = mempty }
      , simpleLedgerTables :: LedgerTables (LedgerState (SimpleBlock c ext)) ValuesMK
simpleLedgerTables =
          ValuesMK
  (TxIn (LedgerState (SimpleBlock c ext)))
  (TxOut (LedgerState (SimpleBlock c ext)))
-> LedgerTables (LedgerState (SimpleBlock c ext)) ValuesMK
forall (l :: LedgerStateKind) (mk :: * -> * -> *).
mk (TxIn l) (TxOut l) -> LedgerTables l mk
LedgerTables (Map TxIn TxOut -> ValuesMK TxIn TxOut
forall k v. Map k v -> ValuesMK k v
ValuesMK (MockState (SimpleBlock c ext) -> Map TxIn TxOut
forall blk. MockState blk -> Map TxIn TxOut
mockUtxo MockState (SimpleBlock c ext)
simpleLedgerState))
      }
    where
      SimpleLedgerState {
          MockState (SimpleBlock c ext)
simpleLedgerState :: forall c ext (mk :: * -> * -> *).
LedgerState (SimpleBlock c ext) mk -> MockState (SimpleBlock c ext)
simpleLedgerState :: MockState (SimpleBlock c ext)
simpleLedgerState
        } = LedgerState (SimpleBlock c ext) EmptyMK
st

deriving newtype instance CanStowLedgerTables (Ticked (LedgerState (SimpleBlock c ext)))

{-------------------------------------------------------------------------------
  Support for the mempool
-------------------------------------------------------------------------------}

data instance GenTx (SimpleBlock c ext) = SimpleGenTx {
      forall c ext. GenTx (SimpleBlock c ext) -> Tx
simpleGenTx   :: !Mock.Tx
    , forall c ext. GenTx (SimpleBlock c ext) -> Hash SHA256 Tx
simpleGenTxId :: !Mock.TxId
    }
  deriving stock    ((forall x.
 GenTx (SimpleBlock c ext) -> Rep (GenTx (SimpleBlock c ext)) x)
-> (forall x.
    Rep (GenTx (SimpleBlock c ext)) x -> GenTx (SimpleBlock c ext))
-> Generic (GenTx (SimpleBlock c ext))
forall x.
Rep (GenTx (SimpleBlock c ext)) x -> GenTx (SimpleBlock c ext)
forall x.
GenTx (SimpleBlock c ext) -> Rep (GenTx (SimpleBlock c ext)) x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
forall c ext x.
Rep (GenTx (SimpleBlock c ext)) x -> GenTx (SimpleBlock c ext)
forall c ext x.
GenTx (SimpleBlock c ext) -> Rep (GenTx (SimpleBlock c ext)) x
$cfrom :: forall c ext x.
GenTx (SimpleBlock c ext) -> Rep (GenTx (SimpleBlock c ext)) x
from :: forall x.
GenTx (SimpleBlock c ext) -> Rep (GenTx (SimpleBlock c ext)) x
$cto :: forall c ext x.
Rep (GenTx (SimpleBlock c ext)) x -> GenTx (SimpleBlock c ext)
to :: forall x.
Rep (GenTx (SimpleBlock c ext)) x -> GenTx (SimpleBlock c ext)
Generic, GenTx (SimpleBlock c ext) -> GenTx (SimpleBlock c ext) -> Bool
(GenTx (SimpleBlock c ext) -> GenTx (SimpleBlock c ext) -> Bool)
-> (GenTx (SimpleBlock c ext) -> GenTx (SimpleBlock c ext) -> Bool)
-> Eq (GenTx (SimpleBlock c ext))
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
forall c ext.
GenTx (SimpleBlock c ext) -> GenTx (SimpleBlock c ext) -> Bool
$c== :: forall c ext.
GenTx (SimpleBlock c ext) -> GenTx (SimpleBlock c ext) -> Bool
== :: GenTx (SimpleBlock c ext) -> GenTx (SimpleBlock c ext) -> Bool
$c/= :: forall c ext.
GenTx (SimpleBlock c ext) -> GenTx (SimpleBlock c ext) -> Bool
/= :: GenTx (SimpleBlock c ext) -> GenTx (SimpleBlock c ext) -> Bool
Eq, Eq (GenTx (SimpleBlock c ext))
Eq (GenTx (SimpleBlock c ext)) =>
(GenTx (SimpleBlock c ext)
 -> GenTx (SimpleBlock c ext) -> Ordering)
-> (GenTx (SimpleBlock c ext) -> GenTx (SimpleBlock c ext) -> Bool)
-> (GenTx (SimpleBlock c ext) -> GenTx (SimpleBlock c ext) -> Bool)
-> (GenTx (SimpleBlock c ext) -> GenTx (SimpleBlock c ext) -> Bool)
-> (GenTx (SimpleBlock c ext) -> GenTx (SimpleBlock c ext) -> Bool)
-> (GenTx (SimpleBlock c ext)
    -> GenTx (SimpleBlock c ext) -> GenTx (SimpleBlock c ext))
-> (GenTx (SimpleBlock c ext)
    -> GenTx (SimpleBlock c ext) -> GenTx (SimpleBlock c ext))
-> Ord (GenTx (SimpleBlock c ext))
GenTx (SimpleBlock c ext) -> GenTx (SimpleBlock c ext) -> Bool
GenTx (SimpleBlock c ext) -> GenTx (SimpleBlock c ext) -> Ordering
GenTx (SimpleBlock c ext)
-> GenTx (SimpleBlock c ext) -> GenTx (SimpleBlock c ext)
forall a.
Eq a =>
(a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
forall c ext. Eq (GenTx (SimpleBlock c ext))
forall c ext.
GenTx (SimpleBlock c ext) -> GenTx (SimpleBlock c ext) -> Bool
forall c ext.
GenTx (SimpleBlock c ext) -> GenTx (SimpleBlock c ext) -> Ordering
forall c ext.
GenTx (SimpleBlock c ext)
-> GenTx (SimpleBlock c ext) -> GenTx (SimpleBlock c ext)
$ccompare :: forall c ext.
GenTx (SimpleBlock c ext) -> GenTx (SimpleBlock c ext) -> Ordering
compare :: GenTx (SimpleBlock c ext) -> GenTx (SimpleBlock c ext) -> Ordering
$c< :: forall c ext.
GenTx (SimpleBlock c ext) -> GenTx (SimpleBlock c ext) -> Bool
< :: GenTx (SimpleBlock c ext) -> GenTx (SimpleBlock c ext) -> Bool
$c<= :: forall c ext.
GenTx (SimpleBlock c ext) -> GenTx (SimpleBlock c ext) -> Bool
<= :: GenTx (SimpleBlock c ext) -> GenTx (SimpleBlock c ext) -> Bool
$c> :: forall c ext.
GenTx (SimpleBlock c ext) -> GenTx (SimpleBlock c ext) -> Bool
> :: GenTx (SimpleBlock c ext) -> GenTx (SimpleBlock c ext) -> Bool
$c>= :: forall c ext.
GenTx (SimpleBlock c ext) -> GenTx (SimpleBlock c ext) -> Bool
>= :: GenTx (SimpleBlock c ext) -> GenTx (SimpleBlock c ext) -> Bool
$cmax :: forall c ext.
GenTx (SimpleBlock c ext)
-> GenTx (SimpleBlock c ext) -> GenTx (SimpleBlock c ext)
max :: GenTx (SimpleBlock c ext)
-> GenTx (SimpleBlock c ext) -> GenTx (SimpleBlock c ext)
$cmin :: forall c ext.
GenTx (SimpleBlock c ext)
-> GenTx (SimpleBlock c ext) -> GenTx (SimpleBlock c ext)
min :: GenTx (SimpleBlock c ext)
-> GenTx (SimpleBlock c ext) -> GenTx (SimpleBlock c ext)
Ord)
  deriving anyclass ([GenTx (SimpleBlock c ext)] -> Encoding
GenTx (SimpleBlock c ext) -> Encoding
(GenTx (SimpleBlock c ext) -> Encoding)
-> (forall s. Decoder s (GenTx (SimpleBlock c ext)))
-> ([GenTx (SimpleBlock c ext)] -> Encoding)
-> (forall s. Decoder s [GenTx (SimpleBlock c ext)])
-> Serialise (GenTx (SimpleBlock c ext))
forall s. Decoder s [GenTx (SimpleBlock c ext)]
forall s. Decoder s (GenTx (SimpleBlock c ext))
forall a.
(a -> Encoding)
-> (forall s. Decoder s a)
-> ([a] -> Encoding)
-> (forall s. Decoder s [a])
-> Serialise a
forall c ext. [GenTx (SimpleBlock c ext)] -> Encoding
forall c ext. GenTx (SimpleBlock c ext) -> Encoding
forall c ext s. Decoder s [GenTx (SimpleBlock c ext)]
forall c ext s. Decoder s (GenTx (SimpleBlock c ext))
$cencode :: forall c ext. GenTx (SimpleBlock c ext) -> Encoding
encode :: GenTx (SimpleBlock c ext) -> Encoding
$cdecode :: forall c ext s. Decoder s (GenTx (SimpleBlock c ext))
decode :: forall s. Decoder s (GenTx (SimpleBlock c ext))
$cencodeList :: forall c ext. [GenTx (SimpleBlock c ext)] -> Encoding
encodeList :: [GenTx (SimpleBlock c ext)] -> Encoding
$cdecodeList :: forall c ext s. Decoder s [GenTx (SimpleBlock c ext)]
decodeList :: forall s. Decoder s [GenTx (SimpleBlock c ext)]
Serialise)

newtype instance Validated (GenTx (SimpleBlock c ext)) = ValidatedSimpleGenTx {
      forall c ext.
Validated (GenTx (SimpleBlock c ext)) -> GenTx (SimpleBlock c ext)
forgetValidatedSimpleGenTx :: GenTx (SimpleBlock c ext)
    }
  deriving newtype ((forall x.
 Validated (GenTx (SimpleBlock c ext))
 -> Rep (Validated (GenTx (SimpleBlock c ext))) x)
-> (forall x.
    Rep (Validated (GenTx (SimpleBlock c ext))) x
    -> Validated (GenTx (SimpleBlock c ext)))
-> Generic (Validated (GenTx (SimpleBlock c ext)))
forall x.
Rep (Validated (GenTx (SimpleBlock c ext))) x
-> Validated (GenTx (SimpleBlock c ext))
forall x.
Validated (GenTx (SimpleBlock c ext))
-> Rep (Validated (GenTx (SimpleBlock c ext))) x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
forall c ext x.
Rep (Validated (GenTx (SimpleBlock c ext))) x
-> Validated (GenTx (SimpleBlock c ext))
forall c ext x.
Validated (GenTx (SimpleBlock c ext))
-> Rep (Validated (GenTx (SimpleBlock c ext))) x
$cfrom :: forall c ext x.
Validated (GenTx (SimpleBlock c ext))
-> Rep (Validated (GenTx (SimpleBlock c ext))) x
from :: forall x.
Validated (GenTx (SimpleBlock c ext))
-> Rep (Validated (GenTx (SimpleBlock c ext))) x
$cto :: forall c ext x.
Rep (Validated (GenTx (SimpleBlock c ext))) x
-> Validated (GenTx (SimpleBlock c ext))
to :: forall x.
Rep (Validated (GenTx (SimpleBlock c ext))) x
-> Validated (GenTx (SimpleBlock c ext))
Generic, Validated (GenTx (SimpleBlock c ext))
-> Validated (GenTx (SimpleBlock c ext)) -> Bool
(Validated (GenTx (SimpleBlock c ext))
 -> Validated (GenTx (SimpleBlock c ext)) -> Bool)
-> (Validated (GenTx (SimpleBlock c ext))
    -> Validated (GenTx (SimpleBlock c ext)) -> Bool)
-> Eq (Validated (GenTx (SimpleBlock c ext)))
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
forall c ext.
Validated (GenTx (SimpleBlock c ext))
-> Validated (GenTx (SimpleBlock c ext)) -> Bool
$c== :: forall c ext.
Validated (GenTx (SimpleBlock c ext))
-> Validated (GenTx (SimpleBlock c ext)) -> Bool
== :: Validated (GenTx (SimpleBlock c ext))
-> Validated (GenTx (SimpleBlock c ext)) -> Bool
$c/= :: forall c ext.
Validated (GenTx (SimpleBlock c ext))
-> Validated (GenTx (SimpleBlock c ext)) -> Bool
/= :: Validated (GenTx (SimpleBlock c ext))
-> Validated (GenTx (SimpleBlock c ext)) -> Bool
Eq, Eq (Validated (GenTx (SimpleBlock c ext)))
Eq (Validated (GenTx (SimpleBlock c ext))) =>
(Validated (GenTx (SimpleBlock c ext))
 -> Validated (GenTx (SimpleBlock c ext)) -> Ordering)
-> (Validated (GenTx (SimpleBlock c ext))
    -> Validated (GenTx (SimpleBlock c ext)) -> Bool)
-> (Validated (GenTx (SimpleBlock c ext))
    -> Validated (GenTx (SimpleBlock c ext)) -> Bool)
-> (Validated (GenTx (SimpleBlock c ext))
    -> Validated (GenTx (SimpleBlock c ext)) -> Bool)
-> (Validated (GenTx (SimpleBlock c ext))
    -> Validated (GenTx (SimpleBlock c ext)) -> Bool)
-> (Validated (GenTx (SimpleBlock c ext))
    -> Validated (GenTx (SimpleBlock c ext))
    -> Validated (GenTx (SimpleBlock c ext)))
-> (Validated (GenTx (SimpleBlock c ext))
    -> Validated (GenTx (SimpleBlock c ext))
    -> Validated (GenTx (SimpleBlock c ext)))
-> Ord (Validated (GenTx (SimpleBlock c ext)))
Validated (GenTx (SimpleBlock c ext))
-> Validated (GenTx (SimpleBlock c ext)) -> Bool
Validated (GenTx (SimpleBlock c ext))
-> Validated (GenTx (SimpleBlock c ext)) -> Ordering
Validated (GenTx (SimpleBlock c ext))
-> Validated (GenTx (SimpleBlock c ext))
-> Validated (GenTx (SimpleBlock c ext))
forall a.
Eq a =>
(a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
forall c ext. Eq (Validated (GenTx (SimpleBlock c ext)))
forall c ext.
Validated (GenTx (SimpleBlock c ext))
-> Validated (GenTx (SimpleBlock c ext)) -> Bool
forall c ext.
Validated (GenTx (SimpleBlock c ext))
-> Validated (GenTx (SimpleBlock c ext)) -> Ordering
forall c ext.
Validated (GenTx (SimpleBlock c ext))
-> Validated (GenTx (SimpleBlock c ext))
-> Validated (GenTx (SimpleBlock c ext))
$ccompare :: forall c ext.
Validated (GenTx (SimpleBlock c ext))
-> Validated (GenTx (SimpleBlock c ext)) -> Ordering
compare :: Validated (GenTx (SimpleBlock c ext))
-> Validated (GenTx (SimpleBlock c ext)) -> Ordering
$c< :: forall c ext.
Validated (GenTx (SimpleBlock c ext))
-> Validated (GenTx (SimpleBlock c ext)) -> Bool
< :: Validated (GenTx (SimpleBlock c ext))
-> Validated (GenTx (SimpleBlock c ext)) -> Bool
$c<= :: forall c ext.
Validated (GenTx (SimpleBlock c ext))
-> Validated (GenTx (SimpleBlock c ext)) -> Bool
<= :: Validated (GenTx (SimpleBlock c ext))
-> Validated (GenTx (SimpleBlock c ext)) -> Bool
$c> :: forall c ext.
Validated (GenTx (SimpleBlock c ext))
-> Validated (GenTx (SimpleBlock c ext)) -> Bool
> :: Validated (GenTx (SimpleBlock c ext))
-> Validated (GenTx (SimpleBlock c ext)) -> Bool
$c>= :: forall c ext.
Validated (GenTx (SimpleBlock c ext))
-> Validated (GenTx (SimpleBlock c ext)) -> Bool
>= :: Validated (GenTx (SimpleBlock c ext))
-> Validated (GenTx (SimpleBlock c ext)) -> Bool
$cmax :: forall c ext.
Validated (GenTx (SimpleBlock c ext))
-> Validated (GenTx (SimpleBlock c ext))
-> Validated (GenTx (SimpleBlock c ext))
max :: Validated (GenTx (SimpleBlock c ext))
-> Validated (GenTx (SimpleBlock c ext))
-> Validated (GenTx (SimpleBlock c ext))
$cmin :: forall c ext.
Validated (GenTx (SimpleBlock c ext))
-> Validated (GenTx (SimpleBlock c ext))
-> Validated (GenTx (SimpleBlock c ext))
min :: Validated (GenTx (SimpleBlock c ext))
-> Validated (GenTx (SimpleBlock c ext))
-> Validated (GenTx (SimpleBlock c ext))
Ord)

instance (Typeable c, Typeable ext)
    => ShowProxy (GenTx (SimpleBlock c ext)) where

type instance ApplyTxErr (SimpleBlock c ext) = MockError (SimpleBlock c ext)

instance MockProtocolSpecific c ext
      => LedgerSupportsMempool (SimpleBlock c ext) where
  applyTx :: LedgerConfig (SimpleBlock c ext)
-> WhetherToIntervene
-> SlotNo
-> GenTx (SimpleBlock c ext)
-> TickedLedgerState (SimpleBlock c ext) ValuesMK
-> Except
     (ApplyTxErr (SimpleBlock c ext))
     (TickedLedgerState (SimpleBlock c ext) DiffMK,
      Validated (GenTx (SimpleBlock c ext)))
applyTx LedgerConfig (SimpleBlock c ext)
cfg WhetherToIntervene
_wti SlotNo
slot GenTx (SimpleBlock c ext)
tx TickedLedgerState (SimpleBlock c ext) ValuesMK
st = do
     let st' :: Ticked (LedgerState (SimpleBlock c ext)) EmptyMK
st' = TickedLedgerState (SimpleBlock c ext) ValuesMK
-> Ticked (LedgerState (SimpleBlock c ext)) EmptyMK
forall (l :: LedgerStateKind).
CanStowLedgerTables l =>
l ValuesMK -> l EmptyMK
stowLedgerTables TickedLedgerState (SimpleBlock c ext) ValuesMK
st
     st'' <- Ticked (LedgerState (SimpleBlock c ext)) EmptyMK
-> TickedLedgerState (SimpleBlock c ext) ValuesMK
forall (l :: LedgerStateKind).
CanStowLedgerTables l =>
l EmptyMK -> l ValuesMK
unstowLedgerTables
             (Ticked (LedgerState (SimpleBlock c ext)) EmptyMK
 -> TickedLedgerState (SimpleBlock c ext) ValuesMK)
-> ExceptT
     (MockError (SimpleBlock c ext))
     Identity
     (Ticked (LedgerState (SimpleBlock c ext)) EmptyMK)
-> ExceptT
     (MockError (SimpleBlock c ext))
     Identity
     (TickedLedgerState (SimpleBlock c ext) ValuesMK)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> LedgerConfig (SimpleBlock c ext)
-> SlotNo
-> GenTx (SimpleBlock c ext)
-> Ticked (LedgerState (SimpleBlock c ext)) EmptyMK
-> ExceptT
     (MockError (SimpleBlock c ext))
     Identity
     (Ticked (LedgerState (SimpleBlock c ext)) EmptyMK)
forall a c ext.
HasMockTxs a =>
LedgerConfig (SimpleBlock c ext)
-> SlotNo
-> a
-> TickedLedgerState (SimpleBlock c ext) EmptyMK
-> Except
     (MockError (SimpleBlock c ext))
     (TickedLedgerState (SimpleBlock c ext) EmptyMK)
updateSimpleUTxO LedgerConfig (SimpleBlock c ext)
cfg SlotNo
slot GenTx (SimpleBlock c ext)
tx Ticked (LedgerState (SimpleBlock c ext)) EmptyMK
st'
     return ( trackingToDiffs $ calculateDifference st st''
             , ValidatedSimpleGenTx tx )

  reapplyTx :: HasCallStack =>
ComputeDiffs
-> LedgerConfig (SimpleBlock c ext)
-> SlotNo
-> Validated (GenTx (SimpleBlock c ext))
-> TickedLedgerState (SimpleBlock c ext) ValuesMK
-> Except
     (ApplyTxErr (SimpleBlock c ext))
     (TickedLedgerState (SimpleBlock c ext) TrackingMK)
reapplyTx ComputeDiffs
_ LedgerConfig (SimpleBlock c ext)
cfg SlotNo
slot Validated (GenTx (SimpleBlock c ext))
vtx TickedLedgerState (SimpleBlock c ext) ValuesMK
st = TickedLedgerState (SimpleBlock c ext) ValuesMK
-> TickedLedgerState (SimpleBlock c ext) DiffMK
-> TickedLedgerState (SimpleBlock c ext) TrackingMK
forall (l :: LedgerStateKind) (l' :: LedgerStateKind).
(SameUtxoTypes l l', HasLedgerTables l, HasLedgerTables l') =>
l ValuesMK -> l' DiffMK -> l' TrackingMK
attachAndApplyDiffs TickedLedgerState (SimpleBlock c ext) ValuesMK
st (TickedLedgerState (SimpleBlock c ext) DiffMK
 -> TickedLedgerState (SimpleBlock c ext) TrackingMK)
-> ((TickedLedgerState (SimpleBlock c ext) DiffMK,
     Validated (GenTx (SimpleBlock c ext)))
    -> TickedLedgerState (SimpleBlock c ext) DiffMK)
-> (TickedLedgerState (SimpleBlock c ext) DiffMK,
    Validated (GenTx (SimpleBlock c ext)))
-> TickedLedgerState (SimpleBlock c ext) TrackingMK
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (TickedLedgerState (SimpleBlock c ext) DiffMK,
 Validated (GenTx (SimpleBlock c ext)))
-> TickedLedgerState (SimpleBlock c ext) DiffMK
forall a b. (a, b) -> a
fst
    ((TickedLedgerState (SimpleBlock c ext) DiffMK,
  Validated (GenTx (SimpleBlock c ext)))
 -> TickedLedgerState (SimpleBlock c ext) TrackingMK)
-> ExceptT
     (MockError (SimpleBlock c ext))
     Identity
     (TickedLedgerState (SimpleBlock c ext) DiffMK,
      Validated (GenTx (SimpleBlock c ext)))
-> ExceptT
     (MockError (SimpleBlock c ext))
     Identity
     (TickedLedgerState (SimpleBlock c ext) TrackingMK)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> LedgerConfig (SimpleBlock c ext)
-> WhetherToIntervene
-> SlotNo
-> GenTx (SimpleBlock c ext)
-> TickedLedgerState (SimpleBlock c ext) ValuesMK
-> Except
     (ApplyTxErr (SimpleBlock c ext))
     (TickedLedgerState (SimpleBlock c ext) DiffMK,
      Validated (GenTx (SimpleBlock c ext)))
forall blk.
LedgerSupportsMempool blk =>
LedgerConfig blk
-> WhetherToIntervene
-> SlotNo
-> GenTx blk
-> TickedLedgerState blk ValuesMK
-> Except
     (ApplyTxErr blk)
     (TickedLedgerState blk DiffMK, Validated (GenTx blk))
applyTx LedgerConfig (SimpleBlock c ext)
cfg WhetherToIntervene
DoNotIntervene SlotNo
slot (Validated (GenTx (SimpleBlock c ext)) -> GenTx (SimpleBlock c ext)
forall c ext.
Validated (GenTx (SimpleBlock c ext)) -> GenTx (SimpleBlock c ext)
forgetValidatedSimpleGenTx Validated (GenTx (SimpleBlock c ext))
vtx) TickedLedgerState (SimpleBlock c ext) ValuesMK
st

  txForgetValidated :: Validated (GenTx (SimpleBlock c ext)) -> GenTx (SimpleBlock c ext)
txForgetValidated = Validated (GenTx (SimpleBlock c ext)) -> GenTx (SimpleBlock c ext)
forall c ext.
Validated (GenTx (SimpleBlock c ext)) -> GenTx (SimpleBlock c ext)
forgetValidatedSimpleGenTx

  getTransactionKeySets :: GenTx (SimpleBlock c ext)
-> LedgerTables (LedgerState (SimpleBlock c ext)) KeysMK
getTransactionKeySets =
    KeysMK TxIn TxOut
-> LedgerTables (LedgerState (SimpleBlock c ext)) KeysMK
KeysMK
  (TxIn (LedgerState (SimpleBlock c ext)))
  (TxOut (LedgerState (SimpleBlock c ext)))
-> LedgerTables (LedgerState (SimpleBlock c ext)) KeysMK
forall (l :: LedgerStateKind) (mk :: * -> * -> *).
mk (TxIn l) (TxOut l) -> LedgerTables l mk
LedgerTables (KeysMK TxIn TxOut
 -> LedgerTables (LedgerState (SimpleBlock c ext)) KeysMK)
-> (GenTx (SimpleBlock c ext) -> KeysMK TxIn TxOut)
-> GenTx (SimpleBlock c ext)
-> LedgerTables (LedgerState (SimpleBlock c ext)) KeysMK
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Set TxIn -> KeysMK TxIn TxOut
forall k v. Set k -> KeysMK k v
KeysMK (Set TxIn -> KeysMK TxIn TxOut)
-> (GenTx (SimpleBlock c ext) -> Set TxIn)
-> GenTx (SimpleBlock c ext)
-> KeysMK TxIn TxOut
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Tx -> Set TxIn
forall a. HasMockTxs a => a -> Set TxIn
Mock.txIns (Tx -> Set TxIn)
-> (GenTx (SimpleBlock c ext) -> Tx)
-> GenTx (SimpleBlock c ext)
-> Set TxIn
forall b c a. (b -> c) -> (a -> b) -> a -> c
. GenTx (SimpleBlock c ext) -> Tx
forall c ext. GenTx (SimpleBlock c ext) -> Tx
simpleGenTx

instance TxLimits (SimpleBlock c ext) where
  type TxMeasure (SimpleBlock c ext) = IgnoringOverflow ByteSize32

  -- Large value so that the Mempool tests never run out of capacity when they
  -- don't override it.
  --
  -- But not 'maxbound'!, since the mempool sometimes holds multiple blocks worth.
  blockCapacityTxMeasure :: forall (mk :: * -> * -> *).
LedgerConfig (SimpleBlock c ext)
-> TickedLedgerState (SimpleBlock c ext) mk
-> TxMeasure (SimpleBlock c ext)
blockCapacityTxMeasure LedgerConfig (SimpleBlock c ext)
_cfg TickedLedgerState (SimpleBlock c ext) mk
_st = ByteSize32 -> IgnoringOverflow ByteSize32
forall a. a -> IgnoringOverflow a
IgnoringOverflow ByteSize32
simpleBlockCapacity

  txMeasure :: LedgerConfig (SimpleBlock c ext)
-> TickedLedgerState (SimpleBlock c ext) ValuesMK
-> GenTx (SimpleBlock c ext)
-> Except
     (ApplyTxErr (SimpleBlock c ext)) (TxMeasure (SimpleBlock c ext))
txMeasure LedgerConfig (SimpleBlock c ext)
cfg TickedLedgerState (SimpleBlock c ext) ValuesMK
_st =
        (ByteSize32 -> IgnoringOverflow ByteSize32)
-> ExceptT (MockError (SimpleBlock c ext)) Identity ByteSize32
-> ExceptT
     (MockError (SimpleBlock c ext))
     Identity
     (IgnoringOverflow ByteSize32)
forall a b.
(a -> b)
-> ExceptT (MockError (SimpleBlock c ext)) Identity a
-> ExceptT (MockError (SimpleBlock c ext)) Identity b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ByteSize32 -> IgnoringOverflow ByteSize32
forall a. a -> IgnoringOverflow a
IgnoringOverflow
      (ExceptT (MockError (SimpleBlock c ext)) Identity ByteSize32
 -> ExceptT
      (MockError (SimpleBlock c ext))
      Identity
      (IgnoringOverflow ByteSize32))
-> (GenTx (SimpleBlock c ext)
    -> ExceptT (MockError (SimpleBlock c ext)) Identity ByteSize32)
-> GenTx (SimpleBlock c ext)
-> ExceptT
     (MockError (SimpleBlock c ext))
     Identity
     (IgnoringOverflow ByteSize32)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. MockConfig
-> Tx
-> ExceptT (MockError (SimpleBlock c ext)) Identity ByteSize32
forall blk. MockConfig -> Tx -> Except (MockError blk) ByteSize32
checkTxSize (SimpleLedgerConfig c ext -> MockConfig
forall c ext. SimpleLedgerConfig c ext -> MockConfig
simpleLedgerMockConfig LedgerConfig (SimpleBlock c ext)
SimpleLedgerConfig c ext
cfg)
      (Tx -> ExceptT (MockError (SimpleBlock c ext)) Identity ByteSize32)
-> (GenTx (SimpleBlock c ext) -> Tx)
-> GenTx (SimpleBlock c ext)
-> ExceptT (MockError (SimpleBlock c ext)) Identity ByteSize32
forall b c a. (b -> c) -> (a -> b) -> a -> c
. GenTx (SimpleBlock c ext) -> Tx
forall c ext. GenTx (SimpleBlock c ext) -> Tx
simpleGenTx

simpleBlockCapacity :: ByteSize32
simpleBlockCapacity :: ByteSize32
simpleBlockCapacity = Word32 -> ByteSize32
ByteSize32 Word32
512

newtype instance TxId (GenTx (SimpleBlock c ext)) = SimpleGenTxId {
      forall c ext. TxId (GenTx (SimpleBlock c ext)) -> Hash SHA256 Tx
unSimpleGenTxId :: Mock.TxId
    }
  deriving stock   ((forall x.
 TxId (GenTx (SimpleBlock c ext))
 -> Rep (TxId (GenTx (SimpleBlock c ext))) x)
-> (forall x.
    Rep (TxId (GenTx (SimpleBlock c ext))) x
    -> TxId (GenTx (SimpleBlock c ext)))
-> Generic (TxId (GenTx (SimpleBlock c ext)))
forall x.
Rep (TxId (GenTx (SimpleBlock c ext))) x
-> TxId (GenTx (SimpleBlock c ext))
forall x.
TxId (GenTx (SimpleBlock c ext))
-> Rep (TxId (GenTx (SimpleBlock c ext))) x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
forall c ext x.
Rep (TxId (GenTx (SimpleBlock c ext))) x
-> TxId (GenTx (SimpleBlock c ext))
forall c ext x.
TxId (GenTx (SimpleBlock c ext))
-> Rep (TxId (GenTx (SimpleBlock c ext))) x
$cfrom :: forall c ext x.
TxId (GenTx (SimpleBlock c ext))
-> Rep (TxId (GenTx (SimpleBlock c ext))) x
from :: forall x.
TxId (GenTx (SimpleBlock c ext))
-> Rep (TxId (GenTx (SimpleBlock c ext))) x
$cto :: forall c ext x.
Rep (TxId (GenTx (SimpleBlock c ext))) x
-> TxId (GenTx (SimpleBlock c ext))
to :: forall x.
Rep (TxId (GenTx (SimpleBlock c ext))) x
-> TxId (GenTx (SimpleBlock c ext))
Generic)
  deriving newtype (Int -> TxId (GenTx (SimpleBlock c ext)) -> ShowS
[TxId (GenTx (SimpleBlock c ext))] -> ShowS
TxId (GenTx (SimpleBlock c ext)) -> String
(Int -> TxId (GenTx (SimpleBlock c ext)) -> ShowS)
-> (TxId (GenTx (SimpleBlock c ext)) -> String)
-> ([TxId (GenTx (SimpleBlock c ext))] -> ShowS)
-> Show (TxId (GenTx (SimpleBlock c ext)))
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
forall c ext. Int -> TxId (GenTx (SimpleBlock c ext)) -> ShowS
forall c ext. [TxId (GenTx (SimpleBlock c ext))] -> ShowS
forall c ext. TxId (GenTx (SimpleBlock c ext)) -> String
$cshowsPrec :: forall c ext. Int -> TxId (GenTx (SimpleBlock c ext)) -> ShowS
showsPrec :: Int -> TxId (GenTx (SimpleBlock c ext)) -> ShowS
$cshow :: forall c ext. TxId (GenTx (SimpleBlock c ext)) -> String
show :: TxId (GenTx (SimpleBlock c ext)) -> String
$cshowList :: forall c ext. [TxId (GenTx (SimpleBlock c ext))] -> ShowS
showList :: [TxId (GenTx (SimpleBlock c ext))] -> ShowS
Show, TxId (GenTx (SimpleBlock c ext))
-> TxId (GenTx (SimpleBlock c ext)) -> Bool
(TxId (GenTx (SimpleBlock c ext))
 -> TxId (GenTx (SimpleBlock c ext)) -> Bool)
-> (TxId (GenTx (SimpleBlock c ext))
    -> TxId (GenTx (SimpleBlock c ext)) -> Bool)
-> Eq (TxId (GenTx (SimpleBlock c ext)))
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
forall c ext.
TxId (GenTx (SimpleBlock c ext))
-> TxId (GenTx (SimpleBlock c ext)) -> Bool
$c== :: forall c ext.
TxId (GenTx (SimpleBlock c ext))
-> TxId (GenTx (SimpleBlock c ext)) -> Bool
== :: TxId (GenTx (SimpleBlock c ext))
-> TxId (GenTx (SimpleBlock c ext)) -> Bool
$c/= :: forall c ext.
TxId (GenTx (SimpleBlock c ext))
-> TxId (GenTx (SimpleBlock c ext)) -> Bool
/= :: TxId (GenTx (SimpleBlock c ext))
-> TxId (GenTx (SimpleBlock c ext)) -> Bool
Eq, Eq (TxId (GenTx (SimpleBlock c ext)))
Eq (TxId (GenTx (SimpleBlock c ext))) =>
(TxId (GenTx (SimpleBlock c ext))
 -> TxId (GenTx (SimpleBlock c ext)) -> Ordering)
-> (TxId (GenTx (SimpleBlock c ext))
    -> TxId (GenTx (SimpleBlock c ext)) -> Bool)
-> (TxId (GenTx (SimpleBlock c ext))
    -> TxId (GenTx (SimpleBlock c ext)) -> Bool)
-> (TxId (GenTx (SimpleBlock c ext))
    -> TxId (GenTx (SimpleBlock c ext)) -> Bool)
-> (TxId (GenTx (SimpleBlock c ext))
    -> TxId (GenTx (SimpleBlock c ext)) -> Bool)
-> (TxId (GenTx (SimpleBlock c ext))
    -> TxId (GenTx (SimpleBlock c ext))
    -> TxId (GenTx (SimpleBlock c ext)))
-> (TxId (GenTx (SimpleBlock c ext))
    -> TxId (GenTx (SimpleBlock c ext))
    -> TxId (GenTx (SimpleBlock c ext)))
-> Ord (TxId (GenTx (SimpleBlock c ext)))
TxId (GenTx (SimpleBlock c ext))
-> TxId (GenTx (SimpleBlock c ext)) -> Bool
TxId (GenTx (SimpleBlock c ext))
-> TxId (GenTx (SimpleBlock c ext)) -> Ordering
TxId (GenTx (SimpleBlock c ext))
-> TxId (GenTx (SimpleBlock c ext))
-> TxId (GenTx (SimpleBlock c ext))
forall a.
Eq a =>
(a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
forall c ext. Eq (TxId (GenTx (SimpleBlock c ext)))
forall c ext.
TxId (GenTx (SimpleBlock c ext))
-> TxId (GenTx (SimpleBlock c ext)) -> Bool
forall c ext.
TxId (GenTx (SimpleBlock c ext))
-> TxId (GenTx (SimpleBlock c ext)) -> Ordering
forall c ext.
TxId (GenTx (SimpleBlock c ext))
-> TxId (GenTx (SimpleBlock c ext))
-> TxId (GenTx (SimpleBlock c ext))
$ccompare :: forall c ext.
TxId (GenTx (SimpleBlock c ext))
-> TxId (GenTx (SimpleBlock c ext)) -> Ordering
compare :: TxId (GenTx (SimpleBlock c ext))
-> TxId (GenTx (SimpleBlock c ext)) -> Ordering
$c< :: forall c ext.
TxId (GenTx (SimpleBlock c ext))
-> TxId (GenTx (SimpleBlock c ext)) -> Bool
< :: TxId (GenTx (SimpleBlock c ext))
-> TxId (GenTx (SimpleBlock c ext)) -> Bool
$c<= :: forall c ext.
TxId (GenTx (SimpleBlock c ext))
-> TxId (GenTx (SimpleBlock c ext)) -> Bool
<= :: TxId (GenTx (SimpleBlock c ext))
-> TxId (GenTx (SimpleBlock c ext)) -> Bool
$c> :: forall c ext.
TxId (GenTx (SimpleBlock c ext))
-> TxId (GenTx (SimpleBlock c ext)) -> Bool
> :: TxId (GenTx (SimpleBlock c ext))
-> TxId (GenTx (SimpleBlock c ext)) -> Bool
$c>= :: forall c ext.
TxId (GenTx (SimpleBlock c ext))
-> TxId (GenTx (SimpleBlock c ext)) -> Bool
>= :: TxId (GenTx (SimpleBlock c ext))
-> TxId (GenTx (SimpleBlock c ext)) -> Bool
$cmax :: forall c ext.
TxId (GenTx (SimpleBlock c ext))
-> TxId (GenTx (SimpleBlock c ext))
-> TxId (GenTx (SimpleBlock c ext))
max :: TxId (GenTx (SimpleBlock c ext))
-> TxId (GenTx (SimpleBlock c ext))
-> TxId (GenTx (SimpleBlock c ext))
$cmin :: forall c ext.
TxId (GenTx (SimpleBlock c ext))
-> TxId (GenTx (SimpleBlock c ext))
-> TxId (GenTx (SimpleBlock c ext))
min :: TxId (GenTx (SimpleBlock c ext))
-> TxId (GenTx (SimpleBlock c ext))
-> TxId (GenTx (SimpleBlock c ext))
Ord, [TxId (GenTx (SimpleBlock c ext))] -> Encoding
TxId (GenTx (SimpleBlock c ext)) -> Encoding
(TxId (GenTx (SimpleBlock c ext)) -> Encoding)
-> (forall s. Decoder s (TxId (GenTx (SimpleBlock c ext))))
-> ([TxId (GenTx (SimpleBlock c ext))] -> Encoding)
-> (forall s. Decoder s [TxId (GenTx (SimpleBlock c ext))])
-> Serialise (TxId (GenTx (SimpleBlock c ext)))
forall s. Decoder s [TxId (GenTx (SimpleBlock c ext))]
forall s. Decoder s (TxId (GenTx (SimpleBlock c ext)))
forall a.
(a -> Encoding)
-> (forall s. Decoder s a)
-> ([a] -> Encoding)
-> (forall s. Decoder s [a])
-> Serialise a
forall c ext. [TxId (GenTx (SimpleBlock c ext))] -> Encoding
forall c ext. TxId (GenTx (SimpleBlock c ext)) -> Encoding
forall c ext s. Decoder s [TxId (GenTx (SimpleBlock c ext))]
forall c ext s. Decoder s (TxId (GenTx (SimpleBlock c ext)))
$cencode :: forall c ext. TxId (GenTx (SimpleBlock c ext)) -> Encoding
encode :: TxId (GenTx (SimpleBlock c ext)) -> Encoding
$cdecode :: forall c ext s. Decoder s (TxId (GenTx (SimpleBlock c ext)))
decode :: forall s. Decoder s (TxId (GenTx (SimpleBlock c ext)))
$cencodeList :: forall c ext. [TxId (GenTx (SimpleBlock c ext))] -> Encoding
encodeList :: [TxId (GenTx (SimpleBlock c ext))] -> Encoding
$cdecodeList :: forall c ext s. Decoder s [TxId (GenTx (SimpleBlock c ext))]
decodeList :: forall s. Decoder s [TxId (GenTx (SimpleBlock c ext))]
Serialise, Context -> TxId (GenTx (SimpleBlock c ext)) -> IO (Maybe ThunkInfo)
Proxy (TxId (GenTx (SimpleBlock c ext))) -> String
(Context
 -> TxId (GenTx (SimpleBlock c ext)) -> IO (Maybe ThunkInfo))
-> (Context
    -> TxId (GenTx (SimpleBlock c ext)) -> IO (Maybe ThunkInfo))
-> (Proxy (TxId (GenTx (SimpleBlock c ext))) -> String)
-> NoThunks (TxId (GenTx (SimpleBlock c ext)))
forall a.
(Context -> a -> IO (Maybe ThunkInfo))
-> (Context -> a -> IO (Maybe ThunkInfo))
-> (Proxy a -> String)
-> NoThunks a
forall c ext.
Context -> TxId (GenTx (SimpleBlock c ext)) -> IO (Maybe ThunkInfo)
forall c ext. Proxy (TxId (GenTx (SimpleBlock c ext))) -> String
$cnoThunks :: forall c ext.
Context -> TxId (GenTx (SimpleBlock c ext)) -> IO (Maybe ThunkInfo)
noThunks :: Context -> TxId (GenTx (SimpleBlock c ext)) -> IO (Maybe ThunkInfo)
$cwNoThunks :: forall c ext.
Context -> TxId (GenTx (SimpleBlock c ext)) -> IO (Maybe ThunkInfo)
wNoThunks :: Context -> TxId (GenTx (SimpleBlock c ext)) -> IO (Maybe ThunkInfo)
$cshowTypeOf :: forall c ext. Proxy (TxId (GenTx (SimpleBlock c ext))) -> String
showTypeOf :: Proxy (TxId (GenTx (SimpleBlock c ext))) -> String
NoThunks)

instance (Typeable c, Typeable ext)
    => ShowProxy (TxId (GenTx (SimpleBlock c ext))) where

instance HasTxId (GenTx (SimpleBlock c ext)) where
  txId :: GenTx (SimpleBlock c ext) -> TxId (GenTx (SimpleBlock c ext))
txId = Hash SHA256 Tx -> TxId (GenTx (SimpleBlock c ext))
forall c ext. Hash SHA256 Tx -> TxId (GenTx (SimpleBlock c ext))
SimpleGenTxId (Hash SHA256 Tx -> TxId (GenTx (SimpleBlock c ext)))
-> (GenTx (SimpleBlock c ext) -> Hash SHA256 Tx)
-> GenTx (SimpleBlock c ext)
-> TxId (GenTx (SimpleBlock c ext))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. GenTx (SimpleBlock c ext) -> Hash SHA256 Tx
forall c ext. GenTx (SimpleBlock c ext) -> Hash SHA256 Tx
simpleGenTxId

instance (Typeable p, Typeable c) => NoThunks (GenTx (SimpleBlock p c)) where
  showTypeOf :: Proxy (GenTx (SimpleBlock p c)) -> String
showTypeOf Proxy (GenTx (SimpleBlock p c))
_ = TypeRep -> String
forall a. Show a => a -> String
show (TypeRep -> String) -> TypeRep -> String
forall a b. (a -> b) -> a -> b
$ Proxy (GenTx (SimpleBlock p c)) -> TypeRep
forall {k} (proxy :: k -> *) (a :: k).
Typeable a =>
proxy a -> TypeRep
typeRep (forall t. Proxy t
forall {k} (t :: k). Proxy t
Proxy @(GenTx (SimpleBlock p c)))

instance (Typeable p, Typeable c) => NoThunks (Validated (GenTx (SimpleBlock p c))) where
  showTypeOf :: Proxy (Validated (GenTx (SimpleBlock p c))) -> String
showTypeOf Proxy (Validated (GenTx (SimpleBlock p c)))
_ = TypeRep -> String
forall a. Show a => a -> String
show (TypeRep -> String) -> TypeRep -> String
forall a b. (a -> b) -> a -> b
$ Proxy (Validated (GenTx (SimpleBlock p c))) -> TypeRep
forall {k} (proxy :: k -> *) (a :: k).
Typeable a =>
proxy a -> TypeRep
typeRep (forall t. Proxy t
forall {k} (t :: k). Proxy t
Proxy @(Validated (GenTx (SimpleBlock p c))))

instance HasTxs (SimpleBlock c ext) where
  extractTxs :: SimpleBlock c ext -> [GenTx (SimpleBlock c ext)]
extractTxs = (Tx -> GenTx (SimpleBlock c ext))
-> [Tx] -> [GenTx (SimpleBlock c ext)]
forall a b. (a -> b) -> [a] -> [b]
map Tx -> GenTx (SimpleBlock c ext)
forall c ext. Tx -> GenTx (SimpleBlock c ext)
mkSimpleGenTx ([Tx] -> [GenTx (SimpleBlock c ext)])
-> (SimpleBlock c ext -> [Tx])
-> SimpleBlock c ext
-> [GenTx (SimpleBlock c ext)]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. SimpleBody -> [Tx]
simpleTxs (SimpleBody -> [Tx])
-> (SimpleBlock c ext -> SimpleBody) -> SimpleBlock c ext -> [Tx]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. SimpleBlock c ext -> SimpleBody
forall c ext ext'. SimpleBlock' c ext ext' -> SimpleBody
simpleBody

instance Mock.HasMockTxs (GenTx (SimpleBlock p c)) where
  getMockTxs :: GenTx (SimpleBlock p c) -> [Tx]
getMockTxs = Tx -> [Tx]
forall a. HasMockTxs a => a -> [Tx]
Mock.getMockTxs (Tx -> [Tx])
-> (GenTx (SimpleBlock p c) -> Tx)
-> GenTx (SimpleBlock p c)
-> [Tx]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. GenTx (SimpleBlock p c) -> Tx
forall c ext. GenTx (SimpleBlock c ext) -> Tx
simpleGenTx

instance Condense (GenTx (SimpleBlock p c)) where
    condense :: GenTx (SimpleBlock p c) -> String
condense = Tx -> String
forall a. Condense a => a -> String
condense (Tx -> String)
-> (GenTx (SimpleBlock p c) -> Tx)
-> GenTx (SimpleBlock p c)
-> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. GenTx (SimpleBlock p c) -> Tx
forall c ext. GenTx (SimpleBlock c ext) -> Tx
simpleGenTx

instance Show (GenTx (SimpleBlock p c)) where
    show :: GenTx (SimpleBlock p c) -> String
show = Tx -> String
forall a. Show a => a -> String
show (Tx -> String)
-> (GenTx (SimpleBlock p c) -> Tx)
-> GenTx (SimpleBlock p c)
-> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. GenTx (SimpleBlock p c) -> Tx
forall c ext. GenTx (SimpleBlock c ext) -> Tx
simpleGenTx

instance Show (Validated (GenTx (SimpleBlock p c))) where
    show :: Validated (GenTx (SimpleBlock p c)) -> String
show = GenTx (SimpleBlock p c) -> String
forall a. Show a => a -> String
show (GenTx (SimpleBlock p c) -> String)
-> (Validated (GenTx (SimpleBlock p c)) -> GenTx (SimpleBlock p c))
-> Validated (GenTx (SimpleBlock p c))
-> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Validated (GenTx (SimpleBlock p c)) -> GenTx (SimpleBlock p c)
forall c ext.
Validated (GenTx (SimpleBlock c ext)) -> GenTx (SimpleBlock c ext)
forgetValidatedSimpleGenTx

instance Condense (GenTxId (SimpleBlock p c)) where
    condense :: GenTxId (SimpleBlock p c) -> String
condense = Hash SHA256 Tx -> String
forall a. Condense a => a -> String
condense (Hash SHA256 Tx -> String)
-> (GenTxId (SimpleBlock p c) -> Hash SHA256 Tx)
-> GenTxId (SimpleBlock p c)
-> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. GenTxId (SimpleBlock p c) -> Hash SHA256 Tx
forall c ext. TxId (GenTx (SimpleBlock c ext)) -> Hash SHA256 Tx
unSimpleGenTxId

mkSimpleGenTx :: Mock.Tx -> GenTx (SimpleBlock c ext)
mkSimpleGenTx :: forall c ext. Tx -> GenTx (SimpleBlock c ext)
mkSimpleGenTx Tx
tx = SimpleGenTx
    { simpleGenTx :: Tx
simpleGenTx   = Tx
tx
    , simpleGenTxId :: Hash SHA256 Tx
simpleGenTxId = (Tx -> Encoding) -> Tx -> Hash SHA256 Tx
forall h a. HashAlgorithm h => (a -> Encoding) -> a -> Hash h a
Hash.hashWithSerialiser Tx -> Encoding
forall a. ToCBOR a => a -> Encoding
toCBOR Tx
tx
    }

genTxSize :: GenTx (SimpleBlock c ext) -> ByteSize32
genTxSize :: forall c ext. GenTx (SimpleBlock c ext) -> ByteSize32
genTxSize = Tx -> ByteSize32
txSize (Tx -> ByteSize32)
-> (GenTx (SimpleBlock c ext) -> Tx)
-> GenTx (SimpleBlock c ext)
-> ByteSize32
forall b c a. (b -> c) -> (a -> b) -> a -> c
. GenTx (SimpleBlock c ext) -> Tx
forall c ext. GenTx (SimpleBlock c ext) -> Tx
simpleGenTx

{-------------------------------------------------------------------------------
  Support for BlockSupportsLedgerQuery
-------------------------------------------------------------------------------}

data instance BlockQuery (SimpleBlock c ext) fp result where
    QueryLedgerTip :: BlockQuery (SimpleBlock c ext) QFNoTables (Point (SimpleBlock c ext))

instance MockProtocolSpecific c ext => BlockSupportsLedgerQuery (SimpleBlock c ext) where
  answerPureBlockQuery :: forall result.
ExtLedgerCfg (SimpleBlock c ext)
-> BlockQuery (SimpleBlock c ext) 'QFNoTables result
-> ExtLedgerState (SimpleBlock c ext) EmptyMK
-> result
answerPureBlockQuery ExtLedgerCfg (SimpleBlock c ext)
_cfg BlockQuery (SimpleBlock c ext) 'QFNoTables result
R:BlockQuerySimpleBlock'fpresult c ext 'QFNoTables result
QueryLedgerTip =
        Point (SimpleBlock c ext) -> result
Point (SimpleBlock c ext) -> Point (SimpleBlock c ext)
forall {k1} {k2} (b :: k1) (b' :: k2).
Coercible (HeaderHash b) (HeaderHash b') =>
Point b -> Point b'
castPoint
      (Point (SimpleBlock c ext) -> result)
-> (ExtLedgerState (SimpleBlock c ext) EmptyMK
    -> Point (SimpleBlock c ext))
-> ExtLedgerState (SimpleBlock c ext) EmptyMK
-> result
forall b c a. (b -> c) -> (a -> b) -> a -> c
. LedgerState (SimpleBlock c ext) EmptyMK
-> Point (SimpleBlock c ext)
forall blk (mk :: * -> * -> *).
UpdateLedger blk =>
LedgerState blk mk -> Point blk
ledgerTipPoint
      (LedgerState (SimpleBlock c ext) EmptyMK
 -> Point (SimpleBlock c ext))
-> (ExtLedgerState (SimpleBlock c ext) EmptyMK
    -> LedgerState (SimpleBlock c ext) EmptyMK)
-> ExtLedgerState (SimpleBlock c ext) EmptyMK
-> Point (SimpleBlock c ext)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ExtLedgerState (SimpleBlock c ext) EmptyMK
-> LedgerState (SimpleBlock c ext) EmptyMK
forall blk (mk :: * -> * -> *).
ExtLedgerState blk mk -> LedgerState blk mk
ledgerState
  answerBlockQueryLookup :: forall (m :: * -> *) result.
MonadSTM m =>
ExtLedgerCfg (SimpleBlock c ext)
-> BlockQuery (SimpleBlock c ext) 'QFLookupTables result
-> ReadOnlyForker' m (SimpleBlock c ext)
-> m result
answerBlockQueryLookup ExtLedgerCfg (SimpleBlock c ext)
_cfg BlockQuery (SimpleBlock c ext) 'QFLookupTables result
q = case BlockQuery (SimpleBlock c ext) 'QFLookupTables result
q of {}
  answerBlockQueryTraverse :: forall (m :: * -> *) result.
MonadSTM m =>
ExtLedgerCfg (SimpleBlock c ext)
-> BlockQuery (SimpleBlock c ext) 'QFTraverseTables result
-> ReadOnlyForker' m (SimpleBlock c ext)
-> m result
answerBlockQueryTraverse ExtLedgerCfg (SimpleBlock c ext)
_cfg BlockQuery (SimpleBlock c ext) 'QFTraverseTables result
q = case BlockQuery (SimpleBlock c ext) 'QFTraverseTables result
q of {}
  blockQueryIsSupportedOnVersion :: forall (fp :: QueryFootprint) result.
BlockQuery (SimpleBlock c ext) fp result
-> BlockNodeToClientVersion (SimpleBlock c ext) -> Bool
blockQueryIsSupportedOnVersion BlockQuery (SimpleBlock c ext) fp result
R:BlockQuerySimpleBlock'fpresult c ext fp result
QueryLedgerTip = Bool -> BlockNodeToClientVersion (SimpleBlock c ext) -> Bool
forall a b. a -> b -> a
const Bool
True

instance SameDepIndex2 (BlockQuery (SimpleBlock c ext)) where
  sameDepIndex2 :: forall (x :: QueryFootprint) a (y :: QueryFootprint) b.
BlockQuery (SimpleBlock c ext) x a
-> BlockQuery (SimpleBlock c ext) y b
-> Maybe ('(x, a) :~: '(y, b))
sameDepIndex2 BlockQuery (SimpleBlock c ext) x a
R:BlockQuerySimpleBlock'fpresult c ext x a
QueryLedgerTip BlockQuery (SimpleBlock c ext) y b
R:BlockQuerySimpleBlock'fpresult c ext y b
QueryLedgerTip = ('(x, a) :~: '(y, b)) -> Maybe ('(x, a) :~: '(y, b))
forall a. a -> Maybe a
Just '(x, a) :~: '(x, a)
'(x, a) :~: '(y, b)
forall {k} (a :: k). a :~: a
Refl

deriving instance Show (BlockQuery (SimpleBlock c ext) fp result)

instance (Typeable c, Typeable ext)
    => ShowProxy (BlockQuery (SimpleBlock c ext)) where

instance (SimpleCrypto c, Typeable ext)
      => ShowQuery (BlockQuery (SimpleBlock c ext) fp) where
  showResult :: forall result.
BlockQuery (SimpleBlock c ext) fp result -> result -> String
showResult BlockQuery (SimpleBlock c ext) fp result
R:BlockQuerySimpleBlock'fpresult c ext fp result
QueryLedgerTip = result -> String
forall a. Show a => a -> String
show

{-------------------------------------------------------------------------------
  Inspection
-------------------------------------------------------------------------------}

instance InspectLedger (SimpleBlock c ext) where
  -- Use defaults

{-------------------------------------------------------------------------------
  Crypto needed for simple blocks
-------------------------------------------------------------------------------}

class (KnownNat (Hash.SizeHash (SimpleHash c)), HashAlgorithm (SimpleHash c), Typeable c) => SimpleCrypto c where
  type family SimpleHash c :: Type

data SimpleStandardCrypto
data SimpleMockCrypto

instance SimpleCrypto SimpleStandardCrypto where
  type SimpleHash SimpleStandardCrypto = SHA256

instance SimpleCrypto SimpleMockCrypto where
  type SimpleHash SimpleMockCrypto = ShortHash

{-------------------------------------------------------------------------------
  Condense instances
-------------------------------------------------------------------------------}

instance Condense ext' => Condense (Header (SimpleBlock' c ext ext')) where
  condense :: Header (SimpleBlock' c ext ext') -> String
condense SimpleHeader{ext'
HeaderHash (SimpleBlock' c ext ext')
SimpleStdHeader c ext
simpleHeaderHash :: forall c ext ext'.
Header (SimpleBlock' c ext ext')
-> HeaderHash (SimpleBlock' c ext ext')
simpleHeaderStd :: forall c ext ext'.
Header (SimpleBlock' c ext ext') -> SimpleStdHeader c ext
simpleHeaderExt :: forall c ext ext'. Header (SimpleBlock' c ext ext') -> ext'
simpleHeaderHash :: HeaderHash (SimpleBlock' c ext ext')
simpleHeaderStd :: SimpleStdHeader c ext
simpleHeaderExt :: ext'
..} = Context -> String
forall a. Monoid a => [a] -> a
mconcat [
        String
"("
      , ChainHash (SimpleBlock c ext) -> String
forall a. Condense a => a -> String
condense ChainHash (SimpleBlock c ext)
simplePrev
      , String
"->"
      , Hash (SimpleHash c) (Header (SimpleBlock' c ext ext')) -> String
forall a. Condense a => a -> String
condense Hash (SimpleHash c) (Header (SimpleBlock' c ext ext'))
HeaderHash (SimpleBlock' c ext ext')
simpleHeaderHash
      , String
","
      , SlotNo -> String
forall a. Condense a => a -> String
condense SlotNo
simpleSlotNo
      , String
","
      , ext' -> String
forall a. Condense a => a -> String
condense ext'
simpleHeaderExt
      , String
")"
      ]
    where
      SimpleStdHeader{Hash (SimpleHash c) SimpleBody
BlockNo
SlotNo
SizeInBytes
ChainHash (SimpleBlock c ext)
simplePrev :: forall c ext.
SimpleStdHeader c ext -> ChainHash (SimpleBlock c ext)
simpleSlotNo :: forall c ext. SimpleStdHeader c ext -> SlotNo
simpleBlockNo :: forall c ext. SimpleStdHeader c ext -> BlockNo
simpleBodyHash :: forall c ext.
SimpleStdHeader c ext -> Hash (SimpleHash c) SimpleBody
simpleBodySize :: forall c ext. SimpleStdHeader c ext -> SizeInBytes
simplePrev :: ChainHash (SimpleBlock c ext)
simpleSlotNo :: SlotNo
simpleBlockNo :: BlockNo
simpleBodyHash :: Hash (SimpleHash c) SimpleBody
simpleBodySize :: SizeInBytes
..} = SimpleStdHeader c ext
simpleHeaderStd

instance Condense ext' => Condense (SimpleBlock' c ext ext') where
  condense :: SimpleBlock' c ext ext' -> String
condense SimpleBlock{Header (SimpleBlock' c ext ext')
SimpleBody
simpleHeader :: forall c ext ext'.
SimpleBlock' c ext ext' -> Header (SimpleBlock' c ext ext')
simpleBody :: forall c ext ext'. SimpleBlock' c ext ext' -> SimpleBody
simpleHeader :: Header (SimpleBlock' c ext ext')
simpleBody :: SimpleBody
..} = Context -> String
forall a. Monoid a => [a] -> a
mconcat [
        String
"("
      , ChainHash (SimpleBlock c ext) -> String
forall a. Condense a => a -> String
condense ChainHash (SimpleBlock c ext)
simplePrev
      , String
"->"
      , Hash (SimpleHash c) (Header (SimpleBlock' c ext ext')) -> String
forall a. Condense a => a -> String
condense Hash (SimpleHash c) (Header (SimpleBlock' c ext ext'))
HeaderHash (SimpleBlock' c ext ext')
simpleHeaderHash
      , String
","
      , SlotNo -> String
forall a. Condense a => a -> String
condense SlotNo
simpleSlotNo
      , String
","
      , ext' -> String
forall a. Condense a => a -> String
condense ext'
simpleHeaderExt
      , String
","
      , [Tx] -> String
forall a. Condense a => a -> String
condense [Tx]
simpleTxs
      , String
")"
      ]
    where
      SimpleHeader{ext'
HeaderHash (SimpleBlock' c ext ext')
SimpleStdHeader c ext
simpleHeaderHash :: forall c ext ext'.
Header (SimpleBlock' c ext ext')
-> HeaderHash (SimpleBlock' c ext ext')
simpleHeaderStd :: forall c ext ext'.
Header (SimpleBlock' c ext ext') -> SimpleStdHeader c ext
simpleHeaderExt :: forall c ext ext'. Header (SimpleBlock' c ext ext') -> ext'
simpleHeaderHash :: HeaderHash (SimpleBlock' c ext ext')
simpleHeaderExt :: ext'
simpleHeaderStd :: SimpleStdHeader c ext
..}    = Header (SimpleBlock' c ext ext')
simpleHeader
      SimpleStdHeader{Hash (SimpleHash c) SimpleBody
BlockNo
SlotNo
SizeInBytes
ChainHash (SimpleBlock c ext)
simplePrev :: forall c ext.
SimpleStdHeader c ext -> ChainHash (SimpleBlock c ext)
simpleSlotNo :: forall c ext. SimpleStdHeader c ext -> SlotNo
simpleBlockNo :: forall c ext. SimpleStdHeader c ext -> BlockNo
simpleBodyHash :: forall c ext.
SimpleStdHeader c ext -> Hash (SimpleHash c) SimpleBody
simpleBodySize :: forall c ext. SimpleStdHeader c ext -> SizeInBytes
simplePrev :: ChainHash (SimpleBlock c ext)
simpleSlotNo :: SlotNo
simpleBlockNo :: BlockNo
simpleBodyHash :: Hash (SimpleHash c) SimpleBody
simpleBodySize :: SizeInBytes
..} = SimpleStdHeader c ext
simpleHeaderStd
      SimpleBody{[Tx]
simpleTxs :: SimpleBody -> [Tx]
simpleTxs :: [Tx]
..}      = SimpleBody
simpleBody

{-------------------------------------------------------------------------------
  Serialisation
-------------------------------------------------------------------------------}

instance ToCBOR SimpleBody where
  toCBOR :: SimpleBody -> Encoding
toCBOR = SimpleBody -> Encoding
forall a. Serialise a => a -> Encoding
encode

encodeSimpleHeader :: KnownNat (Hash.SizeHash (SimpleHash c))
                   => (ext' -> CBOR.Encoding)
                   -> Header (SimpleBlock' c ext ext')
                   -> CBOR.Encoding
encodeSimpleHeader :: forall c ext' ext.
KnownNat (SizeHash (SimpleHash c)) =>
(ext' -> Encoding) -> Header (SimpleBlock' c ext ext') -> Encoding
encodeSimpleHeader ext' -> Encoding
encodeExt SimpleHeader{ext'
HeaderHash (SimpleBlock' c ext ext')
SimpleStdHeader c ext
simpleHeaderHash :: forall c ext ext'.
Header (SimpleBlock' c ext ext')
-> HeaderHash (SimpleBlock' c ext ext')
simpleHeaderStd :: forall c ext ext'.
Header (SimpleBlock' c ext ext') -> SimpleStdHeader c ext
simpleHeaderExt :: forall c ext ext'. Header (SimpleBlock' c ext ext') -> ext'
simpleHeaderHash :: HeaderHash (SimpleBlock' c ext ext')
simpleHeaderStd :: SimpleStdHeader c ext
simpleHeaderExt :: ext'
..} =  [Encoding] -> Encoding
forall a. Monoid a => [a] -> a
mconcat [
      Word -> Encoding
CBOR.encodeListLen Word
2
    , SimpleStdHeader c ext -> Encoding
forall a. Serialise a => a -> Encoding
encode SimpleStdHeader c ext
simpleHeaderStd
    , ext' -> Encoding
encodeExt ext'
simpleHeaderExt
    ]

decodeSimpleHeader :: SimpleCrypto c
                   => (ext' -> CBOR.Encoding)
                   -> (forall s. CBOR.Decoder s ext')
                   -> forall s. CBOR.Decoder s (Header (SimpleBlock' c ext ext'))
decodeSimpleHeader :: forall c ext' ext.
SimpleCrypto c =>
(ext' -> Encoding)
-> (forall s. Decoder s ext')
-> forall s. Decoder s (Header (SimpleBlock' c ext ext'))
decodeSimpleHeader ext' -> Encoding
encodeExt forall s. Decoder s ext'
decodeExt = do
    Int -> Decoder s ()
forall s. Int -> Decoder s ()
CBOR.decodeListLenOf Int
2
    (ext' -> Encoding)
-> SimpleStdHeader c ext
-> ext'
-> Header (SimpleBlock' c ext ext')
forall c ext' ext.
SimpleCrypto c =>
(ext' -> Encoding)
-> SimpleStdHeader c ext
-> ext'
-> Header (SimpleBlock' c ext ext')
mkSimpleHeader ext' -> Encoding
encodeExt (SimpleStdHeader c ext -> ext' -> Header (SimpleBlock' c ext ext'))
-> Decoder s (SimpleStdHeader c ext)
-> Decoder s (ext' -> Header (SimpleBlock' c ext ext'))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Decoder s (SimpleStdHeader c ext)
forall s. Decoder s (SimpleStdHeader c ext)
forall a s. Serialise a => Decoder s a
decode Decoder s (ext' -> Header (SimpleBlock' c ext ext'))
-> Decoder s ext' -> Decoder s (Header (SimpleBlock' c ext ext'))
forall a b. Decoder s (a -> b) -> Decoder s a -> Decoder s b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Decoder s ext'
forall s. Decoder s ext'
decodeExt

-- | Custom 'Serialise' instance that doesn't serialise the hash
instance (SimpleCrypto c, Serialise ext')
      => Serialise (Header (SimpleBlock' c ext ext')) where
  encode :: Header (SimpleBlock' c ext ext') -> Encoding
encode = (ext' -> Encoding) -> Header (SimpleBlock' c ext ext') -> Encoding
forall c ext' ext.
KnownNat (SizeHash (SimpleHash c)) =>
(ext' -> Encoding) -> Header (SimpleBlock' c ext ext') -> Encoding
encodeSimpleHeader ext' -> Encoding
forall a. Serialise a => a -> Encoding
encode
  decode :: forall s. Decoder s (Header (SimpleBlock' c ext ext'))
decode = (ext' -> Encoding)
-> (forall s. Decoder s ext')
-> forall s. Decoder s (Header (SimpleBlock' c ext ext'))
forall c ext' ext.
SimpleCrypto c =>
(ext' -> Encoding)
-> (forall s. Decoder s ext')
-> forall s. Decoder s (Header (SimpleBlock' c ext ext'))
decodeSimpleHeader ext' -> Encoding
forall a. Serialise a => a -> Encoding
encode Decoder s ext'
forall s. Decoder s ext'
forall a s. Serialise a => Decoder s a
decode

simpleBlockBinaryBlockInfo ::
     (SimpleCrypto c, Serialise ext', Typeable ext, Typeable ext')
  => SimpleBlock' c ext ext' -> BinaryBlockInfo
simpleBlockBinaryBlockInfo :: forall c ext' ext.
(SimpleCrypto c, Serialise ext', Typeable ext, Typeable ext') =>
SimpleBlock' c ext ext' -> BinaryBlockInfo
simpleBlockBinaryBlockInfo SimpleBlock' c ext ext'
b = BinaryBlockInfo
    { headerOffset :: Word16
headerOffset = Word16
1 -- For the 'encodeListLen'
    , headerSize :: Word16
headerSize   = Int64 -> Word16
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int64 -> Word16) -> Int64 -> Word16
forall a b. (a -> b) -> a -> b
$ ByteString -> Int64
Lazy.length (ByteString -> Int64) -> ByteString -> Int64
forall a b. (a -> b) -> a -> b
$ Header (SimpleBlock' c ext ext') -> ByteString
forall a. Serialise a => a -> ByteString
serialise (SimpleBlock' c ext ext' -> Header (SimpleBlock' c ext ext')
forall blk. GetHeader blk => blk -> Header blk
getHeader SimpleBlock' c ext ext'
b)
    }