{-# LANGUAGE DataKinds #-}
{-# LANGUAGE DeriveAnyClass #-}
{-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE DerivingVia #-}
{-# LANGUAGE EmptyCase #-}
{-# LANGUAGE EmptyDataDeriving #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE GADTs #-}
{-# LANGUAGE GeneralizedNewtypeDeriving #-}
{-# LANGUAGE LambdaCase #-}
{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE NamedFieldPuns #-}
{-# LANGUAGE RecordWildCards #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE StandaloneDeriving #-}
{-# LANGUAGE TypeApplications #-}
{-# LANGUAGE TypeFamilies #-}
{-# LANGUAGE UndecidableInstances #-}
{-# LANGUAGE ViewPatterns #-}
{-# OPTIONS_GHC -Wno-orphans #-}

-- | A test block whose headers can carry Leios announcements.
--
-- Its protocol enforces no leader schedule and checks no crypto, so a test is
-- free to mint any chain shape and any announcement. A header can be marked
-- invalid, which its protocol then rejects, both in ordinary header validation
-- and in the out-of-context validation an announcement gets. Its ledger view is
-- forecastable only within a configured range, just like the Cardano ledger's,
-- so a test can reach the forecast horizon on demand.
--
-- No chain may exceed 'maxLeiosTestChainLength' blocks, since the block hash is
-- a path from genesis and must fit a fixed size.
module Test.Consensus.Leios.TestBlock
  ( -- * Block
    Header (..)
  , LeiosTestBlock (..)
  , maxLeiosTestChainLength

    -- * Building chains
  , firstLeiosBlock
  , forkLeiosBlock
  , setAnnouncement
  , setCounterBelowImmTips
  , setInvalid
  , setIssuer
  , setSlot
  , successorLeiosBlock

    -- * Ledger
  , LedgerState (..)
  , LeiosTestBlockError (..)
  , LeiosTestLedgerConfig (..)
  , leiosTestInitExtLedger

    -- * Protocol
  , LeiosTestInvalidHeader (..)
  , LeiosTestProtocol

    -- * Node configuration
  , BlockConfig (..)
  , singleNodeLeiosTestConfig
  ) where

import Cardano.Binary (DecoderError, decodeMaybe, encodeMaybe, enforceSize, fromCBOR, toCBOR)
import qualified Cardano.Crypto.Hash as Hash
import Cardano.Ledger.BaseTypes (BoundedRational (..), Milliseconds32 (..))
import Cardano.Ledger.Binary
  ( DecCBOR (..)
  , EncCBOR (..)
  , Version
  , natVersion
  , toPlainDecoder
  , toPlainEncoding
  )
import Cardano.Ledger.Keys (KeyHash (..), KeyRole (BlockIssuer))
import Codec.CBOR.Decoding (Decoder)
import qualified Codec.CBOR.Decoding as CBOR.Dec
import Codec.CBOR.Encoding (Encoding)
import qualified Codec.CBOR.Encoding as CBOR
import Codec.Serialise (Serialise (..), serialise)
import Control.Monad (guard, replicateM, replicateM_)
import Control.Monad.Except (Except, throwError)
import qualified Data.Binary.Get as Get
import qualified Data.Binary.Put as Put
import qualified Data.ByteString.Lazy as BL
import qualified Data.ByteString.Short as SBS
import Data.Foldable (for_)
import Data.List.NonEmpty (NonEmpty (..))
import qualified Data.List.NonEmpty as NE
import qualified Data.Map.Strict as Map
import qualified Data.Measure as Measure
import Data.String (fromString)
import Data.Time.Clock (UTCTime (..))
import Data.Time.Clock.System (systemEpochDay)
import Data.Void (Void)
import Data.Word (Word64)
import GHC.Generics (Generic)
import NoThunks.Class (NoThunks)
import Ouroboros.Consensus.Block
import Ouroboros.Consensus.BlockchainTime
import Ouroboros.Consensus.Config
import Ouroboros.Consensus.Config.SupportsNode
import Ouroboros.Consensus.Forecast
import Ouroboros.Consensus.HardFork.Abstract
import Ouroboros.Consensus.HardFork.Combinator.Abstract
  ( ImmutableEraParams (immutableEraParams)
  )
import Ouroboros.Consensus.HardFork.History (EpochToPerasRoundInfo, forgetEraIndex)
import qualified Ouroboros.Consensus.HardFork.History as HardFork
import Ouroboros.Consensus.HeaderValidation
import Ouroboros.Consensus.Ledger.Abstract
import Ouroboros.Consensus.Ledger.CommonProtocolParams
  ( CommonProtocolParams (..)
  )
import Ouroboros.Consensus.Ledger.Extended
import Ouroboros.Consensus.Ledger.Inspect
import Ouroboros.Consensus.Ledger.Peras (initPerasState)
import Ouroboros.Consensus.Ledger.Query
import Ouroboros.Consensus.Ledger.SupportsMempool
import Ouroboros.Consensus.Ledger.SupportsPeerSelection
  ( LedgerSupportsPeerSelection (..)
  )
import Ouroboros.Consensus.Ledger.SupportsPeras (LedgerStateSupportsPeras)
import Ouroboros.Consensus.Ledger.SupportsProtocol
import Ouroboros.Consensus.Ledger.Tables.Utils
import Ouroboros.Consensus.Leios.Protocol
import Ouroboros.Consensus.Leios.Types (BytesSize, EbHash, decodeEbHash, encodeEbHash)
import Ouroboros.Consensus.Node.InitStorage (NodeInitStorage (..))
import Ouroboros.Consensus.Node.NetworkProtocolVersion
import Ouroboros.Consensus.Node.Run
  ( RunNode
  , SerialiseNodeToClientConstraints
  , SerialiseNodeToNodeConstraints (..)
  )
import Ouroboros.Consensus.Node.Serialisation
import Ouroboros.Consensus.Peras.Cert.Mock (MockPerasCert (..))
import Ouroboros.Consensus.Peras.Context
  ( StateSupportsPerasEpochContext (..)
  , mkBoundedPerasEpochContextWith
  )
import Ouroboros.Consensus.Peras.Crypto.Mock
  ( MockPerasCrypto
  , MockPerasVotingCommitteeScheme
  )
import Ouroboros.Consensus.Peras.Error.Mock (MockPerasError)
import Ouroboros.Consensus.Peras.Vote.Mock (MockPerasVote (..))
import Ouroboros.Consensus.Peras.Voting.Mock (mkMockPerasVotingCommitteeInput)
import Ouroboros.Consensus.Protocol.Abstract
import Ouroboros.Consensus.Storage.ChainDB (SerialiseDiskConstraints)
import Ouroboros.Consensus.Storage.ImmutableDB (simpleChunkInfo)
import Ouroboros.Consensus.Storage.Serialisation
import Ouroboros.Consensus.Util (ShowProxy (..))
import Ouroboros.Consensus.Util.Condense
import Ouroboros.Consensus.Util.IndexedMemPack
import Ouroboros.Consensus.Util.Orphans ()
import Ouroboros.Network.Block (Serialised)
import Ouroboros.Network.Magic (NetworkMagic (..))
import Ouroboros.Network.Tx (HasRawTxId (..))
import Test.Util.Orphans.ToExpr ()
import Test.Util.TestBlock (TestHash (..), Validity (..), unTestHash)

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

-- | A block is just its header: nothing here fetches or applies a body.
newtype LeiosTestBlock = LeiosTestBlock
  { LeiosTestBlock -> Header LeiosTestBlock
ltbHeader :: Header LeiosTestBlock
  }
  deriving stock (LeiosTestBlock -> LeiosTestBlock -> Bool
(LeiosTestBlock -> LeiosTestBlock -> Bool)
-> (LeiosTestBlock -> LeiosTestBlock -> Bool) -> Eq LeiosTestBlock
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: LeiosTestBlock -> LeiosTestBlock -> Bool
== :: LeiosTestBlock -> LeiosTestBlock -> Bool
$c/= :: LeiosTestBlock -> LeiosTestBlock -> Bool
/= :: LeiosTestBlock -> LeiosTestBlock -> Bool
Eq, Int -> LeiosTestBlock -> ShowS
[LeiosTestBlock] -> ShowS
LeiosTestBlock -> String
(Int -> LeiosTestBlock -> ShowS)
-> (LeiosTestBlock -> String)
-> ([LeiosTestBlock] -> ShowS)
-> Show LeiosTestBlock
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> LeiosTestBlock -> ShowS
showsPrec :: Int -> LeiosTestBlock -> ShowS
$cshow :: LeiosTestBlock -> String
show :: LeiosTestBlock -> String
$cshowList :: [LeiosTestBlock] -> ShowS
showList :: [LeiosTestBlock] -> ShowS
Show, (forall x. LeiosTestBlock -> Rep LeiosTestBlock x)
-> (forall x. Rep LeiosTestBlock x -> LeiosTestBlock)
-> Generic LeiosTestBlock
forall x. Rep LeiosTestBlock x -> LeiosTestBlock
forall x. LeiosTestBlock -> Rep LeiosTestBlock x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. LeiosTestBlock -> Rep LeiosTestBlock x
from :: forall x. LeiosTestBlock -> Rep LeiosTestBlock x
$cto :: forall x. Rep LeiosTestBlock x -> LeiosTestBlock
to :: forall x. Rep LeiosTestBlock x -> LeiosTestBlock
Generic)
  deriving anyclass Context -> LeiosTestBlock -> IO (Maybe ThunkInfo)
Proxy LeiosTestBlock -> String
(Context -> LeiosTestBlock -> IO (Maybe ThunkInfo))
-> (Context -> LeiosTestBlock -> IO (Maybe ThunkInfo))
-> (Proxy LeiosTestBlock -> String)
-> NoThunks LeiosTestBlock
forall a.
(Context -> a -> IO (Maybe ThunkInfo))
-> (Context -> a -> IO (Maybe ThunkInfo))
-> (Proxy a -> String)
-> NoThunks a
$cnoThunks :: Context -> LeiosTestBlock -> IO (Maybe ThunkInfo)
noThunks :: Context -> LeiosTestBlock -> IO (Maybe ThunkInfo)
$cwNoThunks :: Context -> LeiosTestBlock -> IO (Maybe ThunkInfo)
wNoThunks :: Context -> LeiosTestBlock -> IO (Maybe ThunkInfo)
$cshowTypeOf :: Proxy LeiosTestBlock -> String
showTypeOf :: Proxy LeiosTestBlock -> String
NoThunks

-- | The hash is a path through the tree of forks, exactly as
-- 'Test.Util.TestBlock.TestHash': an identity assigned by the test rather than
-- a digest of the contents. So two headers a test needs to be distinct must sit
-- at different positions in the tree.
--
-- LIMIT: no chain may exceed 'maxLeiosTestChainLength' blocks. The path is as
-- long as the chain, and 'ConvertRawHash' requires a fixed-size hash, so
-- 'toRawHash' throws beyond that.
data instance Header LeiosTestBlock = LeiosTestHeader
  { Header LeiosTestBlock -> TestHash
lthHash :: !TestHash
  , Header LeiosTestBlock -> SlotNo
lthSlot :: !SlotNo
  , Header LeiosTestBlock -> Word64
lthIssuer :: !Word64
  -- ^ Stands in for the block issuer, so that the election is a real identity.
  , Header LeiosTestBlock -> Maybe (EbHash, Word32)
lthAnnouncement :: !(Maybe (EbHash, BytesSize))
  , Header LeiosTestBlock -> Validity
lthValidity :: !Validity
  -- ^ Whether the protocol accepts this header; see 'setInvalid'.
  , Header LeiosTestBlock -> CounterVsImmTip
lthCounter :: !CounterVsImmTip
  -- ^ Whether this header's operational certificate counter is below the one
  -- the immutable tip records for its issuer; see 'setCounterBelowImmTips'.
  }
  deriving stock (Header LeiosTestBlock -> Header LeiosTestBlock -> Bool
(Header LeiosTestBlock -> Header LeiosTestBlock -> Bool)
-> (Header LeiosTestBlock -> Header LeiosTestBlock -> Bool)
-> Eq (Header LeiosTestBlock)
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: Header LeiosTestBlock -> Header LeiosTestBlock -> Bool
== :: Header LeiosTestBlock -> Header LeiosTestBlock -> Bool
$c/= :: Header LeiosTestBlock -> Header LeiosTestBlock -> Bool
/= :: Header LeiosTestBlock -> Header LeiosTestBlock -> Bool
Eq, Int -> Header LeiosTestBlock -> ShowS
[Header LeiosTestBlock] -> ShowS
Header LeiosTestBlock -> String
(Int -> Header LeiosTestBlock -> ShowS)
-> (Header LeiosTestBlock -> String)
-> ([Header LeiosTestBlock] -> ShowS)
-> Show (Header LeiosTestBlock)
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> Header LeiosTestBlock -> ShowS
showsPrec :: Int -> Header LeiosTestBlock -> ShowS
$cshow :: Header LeiosTestBlock -> String
show :: Header LeiosTestBlock -> String
$cshowList :: [Header LeiosTestBlock] -> ShowS
showList :: [Header LeiosTestBlock] -> ShowS
Show, (forall x. Header LeiosTestBlock -> Rep (Header LeiosTestBlock) x)
-> (forall x.
    Rep (Header LeiosTestBlock) x -> Header LeiosTestBlock)
-> Generic (Header LeiosTestBlock)
forall x. Rep (Header LeiosTestBlock) x -> Header LeiosTestBlock
forall x. Header LeiosTestBlock -> Rep (Header LeiosTestBlock) x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. Header LeiosTestBlock -> Rep (Header LeiosTestBlock) x
from :: forall x. Header LeiosTestBlock -> Rep (Header LeiosTestBlock) x
$cto :: forall x. Rep (Header LeiosTestBlock) x -> Header LeiosTestBlock
to :: forall x. Rep (Header LeiosTestBlock) x -> Header LeiosTestBlock
Generic)
  deriving anyclass Context -> Header LeiosTestBlock -> IO (Maybe ThunkInfo)
Proxy (Header LeiosTestBlock) -> String
(Context -> Header LeiosTestBlock -> IO (Maybe ThunkInfo))
-> (Context -> Header LeiosTestBlock -> IO (Maybe ThunkInfo))
-> (Proxy (Header LeiosTestBlock) -> String)
-> NoThunks (Header LeiosTestBlock)
forall a.
(Context -> a -> IO (Maybe ThunkInfo))
-> (Context -> a -> IO (Maybe ThunkInfo))
-> (Proxy a -> String)
-> NoThunks a
$cnoThunks :: Context -> Header LeiosTestBlock -> IO (Maybe ThunkInfo)
noThunks :: Context -> Header LeiosTestBlock -> IO (Maybe ThunkInfo)
$cwNoThunks :: Context -> Header LeiosTestBlock -> IO (Maybe ThunkInfo)
wNoThunks :: Context -> Header LeiosTestBlock -> IO (Maybe ThunkInfo)
$cshowTypeOf :: Proxy (Header LeiosTestBlock) -> String
showTypeOf :: Proxy (Header LeiosTestBlock) -> String
NoThunks

data CounterVsImmTip = HeaderCounterNotBelowImmTips | HeaderCounterBelowImmTips
  deriving stock (CounterVsImmTip -> CounterVsImmTip -> Bool
(CounterVsImmTip -> CounterVsImmTip -> Bool)
-> (CounterVsImmTip -> CounterVsImmTip -> Bool)
-> Eq CounterVsImmTip
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: CounterVsImmTip -> CounterVsImmTip -> Bool
== :: CounterVsImmTip -> CounterVsImmTip -> Bool
$c/= :: CounterVsImmTip -> CounterVsImmTip -> Bool
/= :: CounterVsImmTip -> CounterVsImmTip -> Bool
Eq, Int -> CounterVsImmTip -> ShowS
[CounterVsImmTip] -> ShowS
CounterVsImmTip -> String
(Int -> CounterVsImmTip -> ShowS)
-> (CounterVsImmTip -> String)
-> ([CounterVsImmTip] -> ShowS)
-> Show CounterVsImmTip
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> CounterVsImmTip -> ShowS
showsPrec :: Int -> CounterVsImmTip -> ShowS
$cshow :: CounterVsImmTip -> String
show :: CounterVsImmTip -> String
$cshowList :: [CounterVsImmTip] -> ShowS
showList :: [CounterVsImmTip] -> ShowS
Show, (forall x. CounterVsImmTip -> Rep CounterVsImmTip x)
-> (forall x. Rep CounterVsImmTip x -> CounterVsImmTip)
-> Generic CounterVsImmTip
forall x. Rep CounterVsImmTip x -> CounterVsImmTip
forall x. CounterVsImmTip -> Rep CounterVsImmTip x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. CounterVsImmTip -> Rep CounterVsImmTip x
from :: forall x. CounterVsImmTip -> Rep CounterVsImmTip x
$cto :: forall x. Rep CounterVsImmTip x -> CounterVsImmTip
to :: forall x. Rep CounterVsImmTip x -> CounterVsImmTip
Generic)
  deriving anyclass (Context -> CounterVsImmTip -> IO (Maybe ThunkInfo)
Proxy CounterVsImmTip -> String
(Context -> CounterVsImmTip -> IO (Maybe ThunkInfo))
-> (Context -> CounterVsImmTip -> IO (Maybe ThunkInfo))
-> (Proxy CounterVsImmTip -> String)
-> NoThunks CounterVsImmTip
forall a.
(Context -> a -> IO (Maybe ThunkInfo))
-> (Context -> a -> IO (Maybe ThunkInfo))
-> (Proxy a -> String)
-> NoThunks a
$cnoThunks :: Context -> CounterVsImmTip -> IO (Maybe ThunkInfo)
noThunks :: Context -> CounterVsImmTip -> IO (Maybe ThunkInfo)
$cwNoThunks :: Context -> CounterVsImmTip -> IO (Maybe ThunkInfo)
wNoThunks :: Context -> CounterVsImmTip -> IO (Maybe ThunkInfo)
$cshowTypeOf :: Proxy CounterVsImmTip -> String
showTypeOf :: Proxy CounterVsImmTip -> String
NoThunks, [CounterVsImmTip] -> Encoding
CounterVsImmTip -> Encoding
(CounterVsImmTip -> Encoding)
-> (forall s. Decoder s CounterVsImmTip)
-> ([CounterVsImmTip] -> Encoding)
-> (forall s. Decoder s [CounterVsImmTip])
-> Serialise CounterVsImmTip
forall s. Decoder s [CounterVsImmTip]
forall s. Decoder s CounterVsImmTip
forall a.
(a -> Encoding)
-> (forall s. Decoder s a)
-> ([a] -> Encoding)
-> (forall s. Decoder s [a])
-> Serialise a
$cencode :: CounterVsImmTip -> Encoding
encode :: CounterVsImmTip -> Encoding
$cdecode :: forall s. Decoder s CounterVsImmTip
decode :: forall s. Decoder s CounterVsImmTip
$cencodeList :: [CounterVsImmTip] -> Encoding
encodeList :: [CounterVsImmTip] -> Encoding
$cdecodeList :: forall s. Decoder s [CounterVsImmTip]
decodeList :: forall s. Decoder s [CounterVsImmTip]
Serialise)

type instance HeaderHash LeiosTestBlock = TestHash

instance StandardHash LeiosTestBlock

instance ShowProxy LeiosTestBlock
instance ShowProxy (Header LeiosTestBlock)

instance HasHeader (Header LeiosTestBlock) where
  getHeaderFields :: Header LeiosTestBlock -> HeaderFields (Header LeiosTestBlock)
getHeaderFields Header LeiosTestBlock
hdr =
    HeaderFields
      { headerFieldHash :: HeaderHash (Header LeiosTestBlock)
headerFieldHash = Header LeiosTestBlock -> TestHash
lthHash Header LeiosTestBlock
hdr
      , headerFieldSlot :: SlotNo
headerFieldSlot = Header LeiosTestBlock -> SlotNo
lthSlot Header LeiosTestBlock
hdr
      , -- One less than the path length, so the first block after genesis is
        -- 'BlockNo' 0, as 'expectedFirstBlockNo' defaults to.
        headerFieldBlockNo :: BlockNo
headerFieldBlockNo =
          Int -> BlockNo
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int -> BlockNo) -> (TestHash -> Int) -> TestHash -> BlockNo
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> Int -> Int
forall a. Num a => a -> a -> a
subtract Int
1 (Int -> Int) -> (TestHash -> Int) -> TestHash -> Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. NonEmpty Word64 -> Int
forall a. NonEmpty a -> Int
NE.length (NonEmpty Word64 -> Int)
-> (TestHash -> NonEmpty Word64) -> TestHash -> Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. TestHash -> NonEmpty Word64
unTestHash (TestHash -> BlockNo) -> TestHash -> BlockNo
forall a b. (a -> b) -> a -> b
$ Header LeiosTestBlock -> TestHash
lthHash Header LeiosTestBlock
hdr
      }

instance HasHeader LeiosTestBlock where
  getHeaderFields :: LeiosTestBlock -> HeaderFields LeiosTestBlock
getHeaderFields = LeiosTestBlock -> HeaderFields LeiosTestBlock
forall blk. GetHeader blk => blk -> HeaderFields blk
getBlockHeaderFields

instance GetHeader LeiosTestBlock where
  getHeader :: LeiosTestBlock -> Header LeiosTestBlock
getHeader = LeiosTestBlock -> Header LeiosTestBlock
ltbHeader
  blockMatchesHeader :: Header LeiosTestBlock -> LeiosTestBlock -> Bool
blockMatchesHeader Header LeiosTestBlock
hdr LeiosTestBlock
blk = Header LeiosTestBlock
hdr Header LeiosTestBlock -> Header LeiosTestBlock -> Bool
forall a. Eq a => a -> a -> Bool
== LeiosTestBlock -> Header LeiosTestBlock
ltbHeader LeiosTestBlock
blk
  headerIsEBB :: Header LeiosTestBlock -> Maybe EpochNo
headerIsEBB = Maybe EpochNo -> Header LeiosTestBlock -> Maybe EpochNo
forall a b. a -> b -> a
const Maybe EpochNo
forall a. Maybe a
Nothing

instance GetPrevHash LeiosTestBlock where
  headerPrevHash :: Header LeiosTestBlock -> ChainHash LeiosTestBlock
headerPrevHash Header LeiosTestBlock
hdr =
    case [Word64] -> Maybe (NonEmpty Word64)
forall a. [a] -> Maybe (NonEmpty a)
NE.nonEmpty ([Word64] -> Maybe (NonEmpty Word64))
-> (Header LeiosTestBlock -> [Word64])
-> Header LeiosTestBlock
-> Maybe (NonEmpty Word64)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. NonEmpty Word64 -> [Word64]
forall a. NonEmpty a -> [a]
NE.tail (NonEmpty Word64 -> [Word64])
-> (Header LeiosTestBlock -> NonEmpty Word64)
-> Header LeiosTestBlock
-> [Word64]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. TestHash -> NonEmpty Word64
unTestHash (TestHash -> NonEmpty Word64)
-> (Header LeiosTestBlock -> TestHash)
-> Header LeiosTestBlock
-> NonEmpty Word64
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Header LeiosTestBlock -> TestHash
lthHash (Header LeiosTestBlock -> Maybe (NonEmpty Word64))
-> Header LeiosTestBlock -> Maybe (NonEmpty Word64)
forall a b. (a -> b) -> a -> b
$ Header LeiosTestBlock
hdr of
      Maybe (NonEmpty Word64)
Nothing -> ChainHash LeiosTestBlock
forall {k} (b :: k). ChainHash b
GenesisHash
      Just NonEmpty Word64
prevHash -> HeaderHash LeiosTestBlock -> ChainHash LeiosTestBlock
forall {k} (b :: k). HeaderHash b -> ChainHash b
BlockHash (NonEmpty Word64 -> TestHash
TestHash NonEmpty Word64
prevHash)

instance Condense LeiosTestBlock where
  condense :: LeiosTestBlock -> String
condense LeiosTestBlock
blk =
    Context -> String
forall a. Monoid a => [a] -> a
mconcat
      [ String
"(H:"
      , TestHash -> String
forall a. Condense a => a -> String
condense (LeiosTestBlock -> HeaderHash LeiosTestBlock
forall b. HasHeader b => b -> HeaderHash b
blockHash LeiosTestBlock
blk)
      , String
",S:"
      , SlotNo -> String
forall a. Condense a => a -> String
condense (LeiosTestBlock -> SlotNo
forall b. HasHeader b => b -> SlotNo
blockSlot LeiosTestBlock
blk)
      , String
",B:"
      , Word64 -> String
forall a. Condense a => a -> String
condense (BlockNo -> Word64
unBlockNo (LeiosTestBlock -> BlockNo
forall b. HasHeader b => b -> BlockNo
blockNo LeiosTestBlock
blk))
      , String
")"
      ]

instance Condense (Header LeiosTestBlock) where
  condense :: Header LeiosTestBlock -> String
condense = LeiosTestBlock -> String
forall a. Condense a => a -> String
condense (LeiosTestBlock -> String)
-> (Header LeiosTestBlock -> LeiosTestBlock)
-> Header LeiosTestBlock
-> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Header LeiosTestBlock -> LeiosTestBlock
LeiosTestBlock

{-------------------------------------------------------------------------------
  Building chains
-------------------------------------------------------------------------------}

-- | The first block of the given fork, in slot 1.
firstLeiosBlock :: Word64 -> LeiosTestBlock
firstLeiosBlock :: Word64 -> LeiosTestBlock
firstLeiosBlock Word64
forkNo = TestHash -> SlotNo -> LeiosTestBlock
mkLeiosTestBlock (NonEmpty Word64 -> TestHash
TestHash (Word64
forkNo Word64 -> [Word64] -> NonEmpty Word64
forall a. a -> [a] -> NonEmpty a
:| [])) SlotNo
1

-- | The successor of the given block: @b -> b ++ [0]@, one slot later.
successorLeiosBlock :: LeiosTestBlock -> LeiosTestBlock
successorLeiosBlock :: LeiosTestBlock -> LeiosTestBlock
successorLeiosBlock LeiosTestBlock
blk =
  TestHash -> SlotNo -> LeiosTestBlock
mkLeiosTestBlock
    (NonEmpty Word64 -> TestHash
TestHash (Word64 -> NonEmpty Word64 -> NonEmpty Word64
forall a. a -> NonEmpty a -> NonEmpty a
NE.cons Word64
0 (TestHash -> NonEmpty Word64
unTestHash (LeiosTestBlock -> HeaderHash LeiosTestBlock
forall b. HasHeader b => b -> HeaderHash b
blockHash LeiosTestBlock
blk))))
    (SlotNo -> SlotNo
forall a. Enum a => a -> a
succ (LeiosTestBlock -> SlotNo
forall b. HasHeader b => b -> SlotNo
blockSlot LeiosTestBlock
blk))

-- | A sibling of the given block: same slot and same predecessor, different
-- hash.
forkLeiosBlock :: LeiosTestBlock -> LeiosTestBlock
forkLeiosBlock :: LeiosTestBlock -> LeiosTestBlock
forkLeiosBlock LeiosTestBlock
blk =
  TestHash -> SlotNo -> LeiosTestBlock
mkLeiosTestBlock
    (NonEmpty Word64 -> TestHash
TestHash (Word64 -> Word64
forall a. Enum a => a -> a
succ Word64
h Word64 -> [Word64] -> NonEmpty Word64
forall a. a -> [a] -> NonEmpty a
:| [Word64]
hs))
    (LeiosTestBlock -> SlotNo
forall b. HasHeader b => b -> SlotNo
blockSlot LeiosTestBlock
blk)
 where
  Word64
h :| [Word64]
hs = TestHash -> NonEmpty Word64
unTestHash (LeiosTestBlock -> HeaderHash LeiosTestBlock
forall b. HasHeader b => b -> HeaderHash b
blockHash LeiosTestBlock
blk)

mkLeiosTestBlock :: TestHash -> SlotNo -> LeiosTestBlock
mkLeiosTestBlock :: TestHash -> SlotNo -> LeiosTestBlock
mkLeiosTestBlock TestHash
hash SlotNo
slot =
  Header LeiosTestBlock -> LeiosTestBlock
LeiosTestBlock
    LeiosTestHeader
      { lthHash :: TestHash
lthHash = TestHash
hash
      , lthSlot :: SlotNo
lthSlot = SlotNo
slot
      , lthIssuer :: Word64
lthIssuer = Word64
0
      , lthAnnouncement :: Maybe (EbHash, Word32)
lthAnnouncement = Maybe (EbHash, Word32)
forall a. Maybe a
Nothing
      , lthValidity :: Validity
lthValidity = Validity
Valid
      , lthCounter :: CounterVsImmTip
lthCounter = CounterVsImmTip
HeaderCounterNotBelowImmTips
      }

onHeader :: (Header LeiosTestBlock -> Header LeiosTestBlock) -> LeiosTestBlock -> LeiosTestBlock
onHeader :: (Header LeiosTestBlock -> Header LeiosTestBlock)
-> LeiosTestBlock -> LeiosTestBlock
onHeader Header LeiosTestBlock -> Header LeiosTestBlock
f = Header LeiosTestBlock -> LeiosTestBlock
LeiosTestBlock (Header LeiosTestBlock -> LeiosTestBlock)
-> (LeiosTestBlock -> Header LeiosTestBlock)
-> LeiosTestBlock
-> LeiosTestBlock
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Header LeiosTestBlock -> Header LeiosTestBlock
f (Header LeiosTestBlock -> Header LeiosTestBlock)
-> (LeiosTestBlock -> Header LeiosTestBlock)
-> LeiosTestBlock
-> Header LeiosTestBlock
forall b c a. (b -> c) -> (a -> b) -> a -> c
. LeiosTestBlock -> Header LeiosTestBlock
ltbHeader

-- | Announce the endorser block with this hash, claiming this size.
setAnnouncement :: EbHash -> BytesSize -> LeiosTestBlock -> LeiosTestBlock
setAnnouncement :: EbHash -> Word32 -> LeiosTestBlock -> LeiosTestBlock
setAnnouncement EbHash
ebHash Word32
size = (Header LeiosTestBlock -> Header LeiosTestBlock)
-> LeiosTestBlock -> LeiosTestBlock
onHeader ((Header LeiosTestBlock -> Header LeiosTestBlock)
 -> LeiosTestBlock -> LeiosTestBlock)
-> (Header LeiosTestBlock -> Header LeiosTestBlock)
-> LeiosTestBlock
-> LeiosTestBlock
forall a b. (a -> b) -> a -> b
$ \Header LeiosTestBlock
hdr -> Header LeiosTestBlock
hdr{lthAnnouncement = Just (ebHash, size)}

-- | Move this block to another slot.
setSlot :: SlotNo -> LeiosTestBlock -> LeiosTestBlock
setSlot :: SlotNo -> LeiosTestBlock -> LeiosTestBlock
setSlot SlotNo
slot = (Header LeiosTestBlock -> Header LeiosTestBlock)
-> LeiosTestBlock -> LeiosTestBlock
onHeader ((Header LeiosTestBlock -> Header LeiosTestBlock)
 -> LeiosTestBlock -> LeiosTestBlock)
-> (Header LeiosTestBlock -> Header LeiosTestBlock)
-> LeiosTestBlock
-> LeiosTestBlock
forall a b. (a -> b) -> a -> b
$ \Header LeiosTestBlock
hdr -> Header LeiosTestBlock
hdr{lthSlot = slot}

setIssuer :: Word64 -> LeiosTestBlock -> LeiosTestBlock
setIssuer :: Word64 -> LeiosTestBlock -> LeiosTestBlock
setIssuer Word64
issuer = (Header LeiosTestBlock -> Header LeiosTestBlock)
-> LeiosTestBlock -> LeiosTestBlock
onHeader ((Header LeiosTestBlock -> Header LeiosTestBlock)
 -> LeiosTestBlock -> LeiosTestBlock)
-> (Header LeiosTestBlock -> Header LeiosTestBlock)
-> LeiosTestBlock
-> LeiosTestBlock
forall a b. (a -> b) -> a -> b
$ \Header LeiosTestBlock
hdr -> Header LeiosTestBlock
hdr{lthIssuer = issuer}

-- | Make the protocol reject this header.
setInvalid :: LeiosTestBlock -> LeiosTestBlock
setInvalid :: LeiosTestBlock -> LeiosTestBlock
setInvalid = (Header LeiosTestBlock -> Header LeiosTestBlock)
-> LeiosTestBlock -> LeiosTestBlock
onHeader ((Header LeiosTestBlock -> Header LeiosTestBlock)
 -> LeiosTestBlock -> LeiosTestBlock)
-> (Header LeiosTestBlock -> Header LeiosTestBlock)
-> LeiosTestBlock
-> LeiosTestBlock
forall a b. (a -> b) -> a -> b
$ \Header LeiosTestBlock
hdr -> Header LeiosTestBlock
hdr{lthValidity = Invalid}

-- | Put this header's operational certificate counter below the one the
-- immutable tip records for its issuer, so that its announcement is accepted
-- but not processed.
setCounterBelowImmTips :: LeiosTestBlock -> LeiosTestBlock
setCounterBelowImmTips :: LeiosTestBlock -> LeiosTestBlock
setCounterBelowImmTips = (Header LeiosTestBlock -> Header LeiosTestBlock)
-> LeiosTestBlock -> LeiosTestBlock
onHeader ((Header LeiosTestBlock -> Header LeiosTestBlock)
 -> LeiosTestBlock -> LeiosTestBlock)
-> (Header LeiosTestBlock -> Header LeiosTestBlock)
-> LeiosTestBlock
-> LeiosTestBlock
forall a b. (a -> b) -> a -> b
$ \Header LeiosTestBlock
hdr -> Header LeiosTestBlock
hdr{lthCounter = HeaderCounterBelowImmTips}

{-------------------------------------------------------------------------------
  Protocol
-------------------------------------------------------------------------------}

-- | No leader schedule and no header crypto: a header is valid exactly when the
-- test has not marked it invalid.
data LeiosTestProtocol

data LeiosTestInvalidHeader = LeiosTestInvalidHeader
  deriving stock (LeiosTestInvalidHeader -> LeiosTestInvalidHeader -> Bool
(LeiosTestInvalidHeader -> LeiosTestInvalidHeader -> Bool)
-> (LeiosTestInvalidHeader -> LeiosTestInvalidHeader -> Bool)
-> Eq LeiosTestInvalidHeader
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: LeiosTestInvalidHeader -> LeiosTestInvalidHeader -> Bool
== :: LeiosTestInvalidHeader -> LeiosTestInvalidHeader -> Bool
$c/= :: LeiosTestInvalidHeader -> LeiosTestInvalidHeader -> Bool
/= :: LeiosTestInvalidHeader -> LeiosTestInvalidHeader -> Bool
Eq, Int -> LeiosTestInvalidHeader -> ShowS
[LeiosTestInvalidHeader] -> ShowS
LeiosTestInvalidHeader -> String
(Int -> LeiosTestInvalidHeader -> ShowS)
-> (LeiosTestInvalidHeader -> String)
-> ([LeiosTestInvalidHeader] -> ShowS)
-> Show LeiosTestInvalidHeader
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> LeiosTestInvalidHeader -> ShowS
showsPrec :: Int -> LeiosTestInvalidHeader -> ShowS
$cshow :: LeiosTestInvalidHeader -> String
show :: LeiosTestInvalidHeader -> String
$cshowList :: [LeiosTestInvalidHeader] -> ShowS
showList :: [LeiosTestInvalidHeader] -> ShowS
Show, (forall x. LeiosTestInvalidHeader -> Rep LeiosTestInvalidHeader x)
-> (forall x.
    Rep LeiosTestInvalidHeader x -> LeiosTestInvalidHeader)
-> Generic LeiosTestInvalidHeader
forall x. Rep LeiosTestInvalidHeader x -> LeiosTestInvalidHeader
forall x. LeiosTestInvalidHeader -> Rep LeiosTestInvalidHeader x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. LeiosTestInvalidHeader -> Rep LeiosTestInvalidHeader x
from :: forall x. LeiosTestInvalidHeader -> Rep LeiosTestInvalidHeader x
$cto :: forall x. Rep LeiosTestInvalidHeader x -> LeiosTestInvalidHeader
to :: forall x. Rep LeiosTestInvalidHeader x -> LeiosTestInvalidHeader
Generic)
  deriving anyclass Context -> LeiosTestInvalidHeader -> IO (Maybe ThunkInfo)
Proxy LeiosTestInvalidHeader -> String
(Context -> LeiosTestInvalidHeader -> IO (Maybe ThunkInfo))
-> (Context -> LeiosTestInvalidHeader -> IO (Maybe ThunkInfo))
-> (Proxy LeiosTestInvalidHeader -> String)
-> NoThunks LeiosTestInvalidHeader
forall a.
(Context -> a -> IO (Maybe ThunkInfo))
-> (Context -> a -> IO (Maybe ThunkInfo))
-> (Proxy a -> String)
-> NoThunks a
$cnoThunks :: Context -> LeiosTestInvalidHeader -> IO (Maybe ThunkInfo)
noThunks :: Context -> LeiosTestInvalidHeader -> IO (Maybe ThunkInfo)
$cwNoThunks :: Context -> LeiosTestInvalidHeader -> IO (Maybe ThunkInfo)
wNoThunks :: Context -> LeiosTestInvalidHeader -> IO (Maybe ThunkInfo)
$cshowTypeOf :: Proxy LeiosTestInvalidHeader -> String
showTypeOf :: Proxy LeiosTestInvalidHeader -> String
NoThunks

data instance ConsensusConfig LeiosTestProtocol = LeiosTestProtocolConfig
  { ConsensusConfig LeiosTestProtocol -> SecurityParam
ltpcSecurityParam :: !SecurityParam
  }
  deriving stock (forall x.
 ConsensusConfig LeiosTestProtocol
 -> Rep (ConsensusConfig LeiosTestProtocol) x)
-> (forall x.
    Rep (ConsensusConfig LeiosTestProtocol) x
    -> ConsensusConfig LeiosTestProtocol)
-> Generic (ConsensusConfig LeiosTestProtocol)
forall x.
Rep (ConsensusConfig LeiosTestProtocol) x
-> ConsensusConfig LeiosTestProtocol
forall x.
ConsensusConfig LeiosTestProtocol
-> Rep (ConsensusConfig LeiosTestProtocol) x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x.
ConsensusConfig LeiosTestProtocol
-> Rep (ConsensusConfig LeiosTestProtocol) x
from :: forall x.
ConsensusConfig LeiosTestProtocol
-> Rep (ConsensusConfig LeiosTestProtocol) x
$cto :: forall x.
Rep (ConsensusConfig LeiosTestProtocol) x
-> ConsensusConfig LeiosTestProtocol
to :: forall x.
Rep (ConsensusConfig LeiosTestProtocol) x
-> ConsensusConfig LeiosTestProtocol
Generic
  deriving anyclass Context
-> ConsensusConfig LeiosTestProtocol -> IO (Maybe ThunkInfo)
Proxy (ConsensusConfig LeiosTestProtocol) -> String
(Context
 -> ConsensusConfig LeiosTestProtocol -> IO (Maybe ThunkInfo))
-> (Context
    -> ConsensusConfig LeiosTestProtocol -> IO (Maybe ThunkInfo))
-> (Proxy (ConsensusConfig LeiosTestProtocol) -> String)
-> NoThunks (ConsensusConfig LeiosTestProtocol)
forall a.
(Context -> a -> IO (Maybe ThunkInfo))
-> (Context -> a -> IO (Maybe ThunkInfo))
-> (Proxy a -> String)
-> NoThunks a
$cnoThunks :: Context
-> ConsensusConfig LeiosTestProtocol -> IO (Maybe ThunkInfo)
noThunks :: Context
-> ConsensusConfig LeiosTestProtocol -> IO (Maybe ThunkInfo)
$cwNoThunks :: Context
-> ConsensusConfig LeiosTestProtocol -> IO (Maybe ThunkInfo)
wNoThunks :: Context
-> ConsensusConfig LeiosTestProtocol -> IO (Maybe ThunkInfo)
$cshowTypeOf :: Proxy (ConsensusConfig LeiosTestProtocol) -> String
showTypeOf :: Proxy (ConsensusConfig LeiosTestProtocol) -> String
NoThunks

instance ConsensusProtocol LeiosTestProtocol where
  type ChainDepState LeiosTestProtocol = ()
  type IsLeader LeiosTestProtocol = ()
  type CanBeLeader LeiosTestProtocol = ()
  type LedgerView LeiosTestProtocol = LeiosLedgerView
  type ValidationErr LeiosTestProtocol = LeiosTestInvalidHeader
  type ValidateView LeiosTestProtocol = Header LeiosTestBlock

  protocolSecurityParam :: ConsensusConfig LeiosTestProtocol -> SecurityParam
protocolSecurityParam = ConsensusConfig LeiosTestProtocol -> SecurityParam
ltpcSecurityParam

  -- Every node leads in every slot; the test itself decides what gets minted.
  checkIsLeader :: HasCallStack =>
ConsensusConfig LeiosTestProtocol
-> CanBeLeader LeiosTestProtocol
-> SlotNo
-> Ticked (ChainDepState LeiosTestProtocol)
-> Maybe (IsLeader LeiosTestProtocol)
checkIsLeader ConsensusConfig LeiosTestProtocol
_ CanBeLeader LeiosTestProtocol
_ SlotNo
_ Ticked (ChainDepState LeiosTestProtocol)
_ = () -> Maybe ()
forall a. a -> Maybe a
Just ()

  tickChainDepState :: ConsensusConfig LeiosTestProtocol
-> LedgerView LeiosTestProtocol
-> SlotNo
-> ChainDepState LeiosTestProtocol
-> Ticked (ChainDepState LeiosTestProtocol)
tickChainDepState ConsensusConfig LeiosTestProtocol
_ LedgerView LeiosTestProtocol
_ SlotNo
_ () = Ticked ()
Ticked (ChainDepState LeiosTestProtocol)
TickedTrivial
  updateChainDepState :: HasCallStack =>
ConsensusConfig LeiosTestProtocol
-> ValidateView LeiosTestProtocol
-> SlotNo
-> Ticked (ChainDepState LeiosTestProtocol)
-> Except
     (ValidationErr LeiosTestProtocol) (ChainDepState LeiosTestProtocol)
updateChainDepState ConsensusConfig LeiosTestProtocol
_ ValidateView LeiosTestProtocol
hdr SlotNo
_ Ticked (ChainDepState LeiosTestProtocol)
_ = Header LeiosTestBlock -> Except LeiosTestInvalidHeader ()
checkValidity Header LeiosTestBlock
ValidateView LeiosTestProtocol
hdr
  reupdateChainDepState :: HasCallStack =>
ConsensusConfig LeiosTestProtocol
-> ValidateView LeiosTestProtocol
-> SlotNo
-> Ticked (ChainDepState LeiosTestProtocol)
-> ChainDepState LeiosTestProtocol
reupdateChainDepState ConsensusConfig LeiosTestProtocol
_ ValidateView LeiosTestProtocol
_ SlotNo
_ Ticked (ChainDepState LeiosTestProtocol)
_ = ()

instance LeiosProtocol LeiosTestProtocol where
  getLeiosAnnouncement :: forall (proxy :: * -> *).
proxy LeiosTestProtocol
-> ValidateView LeiosTestProtocol -> Maybe LeiosAnnouncement
getLeiosAnnouncement proxy LeiosTestProtocol
_proxy ValidateView LeiosTestProtocol
hdr =
    Header LeiosTestBlock -> Maybe (EbHash, Word32)
lthAnnouncement Header LeiosTestBlock
ValidateView LeiosTestProtocol
hdr Maybe (EbHash, Word32)
-> ((EbHash, Word32) -> Maybe LeiosAnnouncement)
-> Maybe LeiosAnnouncement
forall a b. Maybe a -> (a -> Maybe b) -> Maybe b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \(EbHash
ebHash, Word32
size) ->
      LeiosAnnouncement -> Maybe LeiosAnnouncement
forall a. a -> Maybe a
forall (f :: * -> *) a. Applicative f => a -> f a
pure
        MkLeiosAnnouncement
          { announcementElectee :: KeyHash BlockIssuer
announcementElectee = Word64 -> KeyHash BlockIssuer
issuerKeyHash (Header LeiosTestBlock -> Word64
lthIssuer Header LeiosTestBlock
ValidateView LeiosTestProtocol
hdr)
          , announcementEbHash :: EbHash
announcementEbHash = EbHash
ebHash
          , announcementEbSize :: Word32
announcementEbSize = Word32
size
          }
  validateLeiosAnnouncement :: ConsensusConfig LeiosTestProtocol
-> ValidateView LeiosTestProtocol
-> SlotNo
-> Ticked (ChainDepState LeiosTestProtocol)
-> Except (ValidationErr LeiosTestProtocol) OCINStaleness
validateLeiosAnnouncement ConsensusConfig LeiosTestProtocol
_cfg ValidateView LeiosTestProtocol
hdr SlotNo
_slot Ticked (ChainDepState LeiosTestProtocol)
_st = do
    Header LeiosTestBlock -> Except LeiosTestInvalidHeader ()
checkValidity Header LeiosTestBlock
ValidateView LeiosTestProtocol
hdr
    OCINStaleness
-> ExceptT LeiosTestInvalidHeader Identity OCINStaleness
forall a. a -> ExceptT LeiosTestInvalidHeader Identity a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (OCINStaleness
 -> ExceptT LeiosTestInvalidHeader Identity OCINStaleness)
-> OCINStaleness
-> ExceptT LeiosTestInvalidHeader Identity OCINStaleness
forall a b. (a -> b) -> a -> b
$ case Header LeiosTestBlock -> CounterVsImmTip
lthCounter Header LeiosTestBlock
ValidateView LeiosTestProtocol
hdr of
      CounterVsImmTip
HeaderCounterNotBelowImmTips -> OCINStaleness
FreshOCIN
      CounterVsImmTip
HeaderCounterBelowImmTips -> OCINStaleness
StaleOCIN
  getLeiosLedgerView :: forall (proxy :: * -> *).
proxy LeiosTestProtocol
-> LedgerView LeiosTestProtocol -> Maybe LeiosLedgerView
getLeiosLedgerView proxy LeiosTestProtocol
_proxy = LedgerView LeiosTestProtocol -> Maybe LeiosLedgerView
LeiosLedgerView -> Maybe LeiosLedgerView
forall a. a -> Maybe a
Just

-- | A test issuer's stand-in for the hash of a pool's cold verification key.
issuerKeyHash :: Word64 -> KeyHash BlockIssuer
issuerKeyHash :: Word64 -> KeyHash BlockIssuer
issuerKeyHash = Hash ADDRHASH (VerKeyDSIGN DSIGN) -> KeyHash BlockIssuer
forall (r :: KeyRole).
Hash ADDRHASH (VerKeyDSIGN DSIGN) -> KeyHash r
KeyHash (Hash ADDRHASH (VerKeyDSIGN DSIGN) -> KeyHash BlockIssuer)
-> (Word64 -> Hash ADDRHASH (VerKeyDSIGN DSIGN))
-> Word64
-> KeyHash BlockIssuer
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Hash ADDRHASH Word64 -> Hash ADDRHASH (VerKeyDSIGN DSIGN)
forall h a b. Hash h a -> Hash h b
Hash.castHash (Hash ADDRHASH Word64 -> Hash ADDRHASH (VerKeyDSIGN DSIGN))
-> (Word64 -> Hash ADDRHASH Word64)
-> Word64
-> Hash ADDRHASH (VerKeyDSIGN DSIGN)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Word64 -> ByteString) -> Word64 -> Hash ADDRHASH Word64
forall h a. HashAlgorithm h => (a -> ByteString) -> a -> Hash h a
Hash.hashWith (LazyByteString -> ByteString
BL.toStrict (LazyByteString -> ByteString)
-> (Word64 -> LazyByteString) -> Word64 -> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Word64 -> LazyByteString
forall a. Serialise a => a -> LazyByteString
serialise)

checkValidity :: Header LeiosTestBlock -> Except LeiosTestInvalidHeader ()
checkValidity :: Header LeiosTestBlock -> Except LeiosTestInvalidHeader ()
checkValidity Header LeiosTestBlock
hdr = case Header LeiosTestBlock -> Validity
lthValidity Header LeiosTestBlock
hdr of
  Validity
Valid -> () -> Except LeiosTestInvalidHeader ()
forall a. a -> ExceptT LeiosTestInvalidHeader Identity a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ()
  Validity
Invalid -> LeiosTestInvalidHeader -> Except LeiosTestInvalidHeader ()
forall a.
LeiosTestInvalidHeader -> ExceptT LeiosTestInvalidHeader Identity a
forall e (m :: * -> *) a. MonadError e m => e -> m a
throwError LeiosTestInvalidHeader
LeiosTestInvalidHeader

type instance BlockProtocol LeiosTestBlock = LeiosTestProtocol

instance BlockSupportsProtocol LeiosTestBlock where
  validateView :: BlockConfig LeiosTestBlock
-> Header LeiosTestBlock
-> ValidateView (BlockProtocol LeiosTestBlock)
validateView BlockConfig LeiosTestBlock
_ Header LeiosTestBlock
hdr = Header LeiosTestBlock
ValidateView (BlockProtocol LeiosTestBlock)
hdr

{-------------------------------------------------------------------------------
  Ledger
-------------------------------------------------------------------------------}

newtype instance LedgerState LeiosTestBlock mk = LeiosTestLedger
  { forall (mk :: MapKind).
LedgerState LeiosTestBlock mk -> Point LeiosTestBlock
ltlsTip :: Point LeiosTestBlock
  }
  deriving stock (LedgerState LeiosTestBlock mk
-> LedgerState LeiosTestBlock mk -> Bool
(LedgerState LeiosTestBlock mk
 -> LedgerState LeiosTestBlock mk -> Bool)
-> (LedgerState LeiosTestBlock mk
    -> LedgerState LeiosTestBlock mk -> Bool)
-> Eq (LedgerState LeiosTestBlock mk)
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
forall (mk :: MapKind).
LedgerState LeiosTestBlock mk
-> LedgerState LeiosTestBlock mk -> Bool
$c== :: forall (mk :: MapKind).
LedgerState LeiosTestBlock mk
-> LedgerState LeiosTestBlock mk -> Bool
== :: LedgerState LeiosTestBlock mk
-> LedgerState LeiosTestBlock mk -> Bool
$c/= :: forall (mk :: MapKind).
LedgerState LeiosTestBlock mk
-> LedgerState LeiosTestBlock mk -> Bool
/= :: LedgerState LeiosTestBlock mk
-> LedgerState LeiosTestBlock mk -> Bool
Eq, Int -> LedgerState LeiosTestBlock mk -> ShowS
[LedgerState LeiosTestBlock mk] -> ShowS
LedgerState LeiosTestBlock mk -> String
(Int -> LedgerState LeiosTestBlock mk -> ShowS)
-> (LedgerState LeiosTestBlock mk -> String)
-> ([LedgerState LeiosTestBlock mk] -> ShowS)
-> Show (LedgerState LeiosTestBlock mk)
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
forall (mk :: MapKind).
Int -> LedgerState LeiosTestBlock mk -> ShowS
forall (mk :: MapKind). [LedgerState LeiosTestBlock mk] -> ShowS
forall (mk :: MapKind). LedgerState LeiosTestBlock mk -> String
$cshowsPrec :: forall (mk :: MapKind).
Int -> LedgerState LeiosTestBlock mk -> ShowS
showsPrec :: Int -> LedgerState LeiosTestBlock mk -> ShowS
$cshow :: forall (mk :: MapKind). LedgerState LeiosTestBlock mk -> String
show :: LedgerState LeiosTestBlock mk -> String
$cshowList :: forall (mk :: MapKind). [LedgerState LeiosTestBlock mk] -> ShowS
showList :: [LedgerState LeiosTestBlock mk] -> ShowS
Show, (forall x.
 LedgerState LeiosTestBlock mk
 -> Rep (LedgerState LeiosTestBlock mk) x)
-> (forall x.
    Rep (LedgerState LeiosTestBlock mk) x
    -> LedgerState LeiosTestBlock mk)
-> Generic (LedgerState LeiosTestBlock mk)
forall x.
Rep (LedgerState LeiosTestBlock mk) x
-> LedgerState LeiosTestBlock mk
forall x.
LedgerState LeiosTestBlock mk
-> Rep (LedgerState LeiosTestBlock mk) x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
forall (mk :: MapKind) x.
Rep (LedgerState LeiosTestBlock mk) x
-> LedgerState LeiosTestBlock mk
forall (mk :: MapKind) x.
LedgerState LeiosTestBlock mk
-> Rep (LedgerState LeiosTestBlock mk) x
$cfrom :: forall (mk :: MapKind) x.
LedgerState LeiosTestBlock mk
-> Rep (LedgerState LeiosTestBlock mk) x
from :: forall x.
LedgerState LeiosTestBlock mk
-> Rep (LedgerState LeiosTestBlock mk) x
$cto :: forall (mk :: MapKind) x.
Rep (LedgerState LeiosTestBlock mk) x
-> LedgerState LeiosTestBlock mk
to :: forall x.
Rep (LedgerState LeiosTestBlock mk) x
-> LedgerState LeiosTestBlock mk
Generic)
  deriving anyclass (Context -> LedgerState LeiosTestBlock mk -> IO (Maybe ThunkInfo)
Proxy (LedgerState LeiosTestBlock mk) -> String
(Context -> LedgerState LeiosTestBlock mk -> IO (Maybe ThunkInfo))
-> (Context
    -> LedgerState LeiosTestBlock mk -> IO (Maybe ThunkInfo))
-> (Proxy (LedgerState LeiosTestBlock mk) -> String)
-> NoThunks (LedgerState LeiosTestBlock mk)
forall a.
(Context -> a -> IO (Maybe ThunkInfo))
-> (Context -> a -> IO (Maybe ThunkInfo))
-> (Proxy a -> String)
-> NoThunks a
forall (mk :: MapKind).
Context -> LedgerState LeiosTestBlock mk -> IO (Maybe ThunkInfo)
forall (mk :: MapKind).
Proxy (LedgerState LeiosTestBlock mk) -> String
$cnoThunks :: forall (mk :: MapKind).
Context -> LedgerState LeiosTestBlock mk -> IO (Maybe ThunkInfo)
noThunks :: Context -> LedgerState LeiosTestBlock mk -> IO (Maybe ThunkInfo)
$cwNoThunks :: forall (mk :: MapKind).
Context -> LedgerState LeiosTestBlock mk -> IO (Maybe ThunkInfo)
wNoThunks :: Context -> LedgerState LeiosTestBlock mk -> IO (Maybe ThunkInfo)
$cshowTypeOf :: forall (mk :: MapKind).
Proxy (LedgerState LeiosTestBlock mk) -> String
showTypeOf :: Proxy (LedgerState LeiosTestBlock mk) -> String
NoThunks, [LedgerState LeiosTestBlock mk] -> Encoding
LedgerState LeiosTestBlock mk -> Encoding
(LedgerState LeiosTestBlock mk -> Encoding)
-> (forall s. Decoder s (LedgerState LeiosTestBlock mk))
-> ([LedgerState LeiosTestBlock mk] -> Encoding)
-> (forall s. Decoder s [LedgerState LeiosTestBlock mk])
-> Serialise (LedgerState LeiosTestBlock mk)
forall s. Decoder s [LedgerState LeiosTestBlock mk]
forall s. Decoder s (LedgerState LeiosTestBlock mk)
forall a.
(a -> Encoding)
-> (forall s. Decoder s a)
-> ([a] -> Encoding)
-> (forall s. Decoder s [a])
-> Serialise a
forall (mk :: MapKind). [LedgerState LeiosTestBlock mk] -> Encoding
forall (mk :: MapKind). LedgerState LeiosTestBlock mk -> Encoding
forall (mk :: MapKind) s. Decoder s [LedgerState LeiosTestBlock mk]
forall (mk :: MapKind) s. Decoder s (LedgerState LeiosTestBlock mk)
$cencode :: forall (mk :: MapKind). LedgerState LeiosTestBlock mk -> Encoding
encode :: LedgerState LeiosTestBlock mk -> Encoding
$cdecode :: forall (mk :: MapKind) s. Decoder s (LedgerState LeiosTestBlock mk)
decode :: forall s. Decoder s (LedgerState LeiosTestBlock mk)
$cencodeList :: forall (mk :: MapKind). [LedgerState LeiosTestBlock mk] -> Encoding
encodeList :: [LedgerState LeiosTestBlock mk] -> Encoding
$cdecodeList :: forall (mk :: MapKind) s. Decoder s [LedgerState LeiosTestBlock mk]
decodeList :: forall s. Decoder s [LedgerState LeiosTestBlock mk]
Serialise)

newtype instance Ticked LedgerState LeiosTestBlock mk = TickedLeiosTestLedger
  { forall (mk :: MapKind).
Ticked LedgerState LeiosTestBlock mk
-> LedgerState LeiosTestBlock mk
getTickedLeiosTestLedger :: LedgerState LeiosTestBlock mk
  }
  deriving stock (forall x.
 Ticked LedgerState LeiosTestBlock mk
 -> Rep (Ticked LedgerState LeiosTestBlock mk) x)
-> (forall x.
    Rep (Ticked LedgerState LeiosTestBlock mk) x
    -> Ticked LedgerState LeiosTestBlock mk)
-> Generic (Ticked LedgerState LeiosTestBlock mk)
forall x.
Rep (Ticked LedgerState LeiosTestBlock mk) x
-> Ticked LedgerState LeiosTestBlock mk
forall x.
Ticked LedgerState LeiosTestBlock mk
-> Rep (Ticked LedgerState LeiosTestBlock mk) x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
forall (mk :: MapKind) x.
Rep (Ticked LedgerState LeiosTestBlock mk) x
-> Ticked LedgerState LeiosTestBlock mk
forall (mk :: MapKind) x.
Ticked LedgerState LeiosTestBlock mk
-> Rep (Ticked LedgerState LeiosTestBlock mk) x
$cfrom :: forall (mk :: MapKind) x.
Ticked LedgerState LeiosTestBlock mk
-> Rep (Ticked LedgerState LeiosTestBlock mk) x
from :: forall x.
Ticked LedgerState LeiosTestBlock mk
-> Rep (Ticked LedgerState LeiosTestBlock mk) x
$cto :: forall (mk :: MapKind) x.
Rep (Ticked LedgerState LeiosTestBlock mk) x
-> Ticked LedgerState LeiosTestBlock mk
to :: forall x.
Rep (Ticked LedgerState LeiosTestBlock mk) x
-> Ticked LedgerState LeiosTestBlock mk
Generic
  deriving anyclass Context
-> Ticked LedgerState LeiosTestBlock mk -> IO (Maybe ThunkInfo)
Proxy (Ticked LedgerState LeiosTestBlock mk) -> String
(Context
 -> Ticked LedgerState LeiosTestBlock mk -> IO (Maybe ThunkInfo))
-> (Context
    -> Ticked LedgerState LeiosTestBlock mk -> IO (Maybe ThunkInfo))
-> (Proxy (Ticked LedgerState LeiosTestBlock mk) -> String)
-> NoThunks (Ticked LedgerState LeiosTestBlock mk)
forall a.
(Context -> a -> IO (Maybe ThunkInfo))
-> (Context -> a -> IO (Maybe ThunkInfo))
-> (Proxy a -> String)
-> NoThunks a
forall (mk :: MapKind).
Context
-> Ticked LedgerState LeiosTestBlock mk -> IO (Maybe ThunkInfo)
forall (mk :: MapKind).
Proxy (Ticked LedgerState LeiosTestBlock mk) -> String
$cnoThunks :: forall (mk :: MapKind).
Context
-> Ticked LedgerState LeiosTestBlock mk -> IO (Maybe ThunkInfo)
noThunks :: Context
-> Ticked LedgerState LeiosTestBlock mk -> IO (Maybe ThunkInfo)
$cwNoThunks :: forall (mk :: MapKind).
Context
-> Ticked LedgerState LeiosTestBlock mk -> IO (Maybe ThunkInfo)
wNoThunks :: Context
-> Ticked LedgerState LeiosTestBlock mk -> IO (Maybe ThunkInfo)
$cshowTypeOf :: forall (mk :: MapKind).
Proxy (Ticked LedgerState LeiosTestBlock mk) -> String
showTypeOf :: Proxy (Ticked LedgerState LeiosTestBlock mk) -> String
NoThunks

-- | The block does not fit onto the ledger's tip.
data LeiosTestBlockError
  = LeiosTestInvalidHash
      (ChainHash LeiosTestBlock)
      (ChainHash LeiosTestBlock)
  deriving stock (LeiosTestBlockError -> LeiosTestBlockError -> Bool
(LeiosTestBlockError -> LeiosTestBlockError -> Bool)
-> (LeiosTestBlockError -> LeiosTestBlockError -> Bool)
-> Eq LeiosTestBlockError
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: LeiosTestBlockError -> LeiosTestBlockError -> Bool
== :: LeiosTestBlockError -> LeiosTestBlockError -> Bool
$c/= :: LeiosTestBlockError -> LeiosTestBlockError -> Bool
/= :: LeiosTestBlockError -> LeiosTestBlockError -> Bool
Eq, Int -> LeiosTestBlockError -> ShowS
[LeiosTestBlockError] -> ShowS
LeiosTestBlockError -> String
(Int -> LeiosTestBlockError -> ShowS)
-> (LeiosTestBlockError -> String)
-> ([LeiosTestBlockError] -> ShowS)
-> Show LeiosTestBlockError
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> LeiosTestBlockError -> ShowS
showsPrec :: Int -> LeiosTestBlockError -> ShowS
$cshow :: LeiosTestBlockError -> String
show :: LeiosTestBlockError -> String
$cshowList :: [LeiosTestBlockError] -> ShowS
showList :: [LeiosTestBlockError] -> ShowS
Show, (forall x. LeiosTestBlockError -> Rep LeiosTestBlockError x)
-> (forall x. Rep LeiosTestBlockError x -> LeiosTestBlockError)
-> Generic LeiosTestBlockError
forall x. Rep LeiosTestBlockError x -> LeiosTestBlockError
forall x. LeiosTestBlockError -> Rep LeiosTestBlockError x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. LeiosTestBlockError -> Rep LeiosTestBlockError x
from :: forall x. LeiosTestBlockError -> Rep LeiosTestBlockError x
$cto :: forall x. Rep LeiosTestBlockError x -> LeiosTestBlockError
to :: forall x. Rep LeiosTestBlockError x -> LeiosTestBlockError
Generic)
  deriving anyclass Context -> LeiosTestBlockError -> IO (Maybe ThunkInfo)
Proxy LeiosTestBlockError -> String
(Context -> LeiosTestBlockError -> IO (Maybe ThunkInfo))
-> (Context -> LeiosTestBlockError -> IO (Maybe ThunkInfo))
-> (Proxy LeiosTestBlockError -> String)
-> NoThunks LeiosTestBlockError
forall a.
(Context -> a -> IO (Maybe ThunkInfo))
-> (Context -> a -> IO (Maybe ThunkInfo))
-> (Proxy a -> String)
-> NoThunks a
$cnoThunks :: Context -> LeiosTestBlockError -> IO (Maybe ThunkInfo)
noThunks :: Context -> LeiosTestBlockError -> IO (Maybe ThunkInfo)
$cwNoThunks :: Context -> LeiosTestBlockError -> IO (Maybe ThunkInfo)
wNoThunks :: Context -> LeiosTestBlockError -> IO (Maybe ThunkInfo)
$cshowTypeOf :: Proxy LeiosTestBlockError -> String
showTypeOf :: Proxy LeiosTestBlockError -> String
NoThunks

-- | The forecast range is finite, so a test can reach 'OutsideForecastRange'
-- on demand.
data LeiosTestLedgerConfig = LeiosTestLedgerConfig
  { LeiosTestLedgerConfig -> EraParams
ltlcHardForkParams :: !HardFork.EraParams
  , LeiosTestLedgerConfig -> SlotNo
ltlcForecastRange :: !SlotNo
  , LeiosTestLedgerConfig -> LeiosLedgerView
ltlcLeios :: !LeiosLedgerView
  -- ^ the ledger view, the same in every slot
  }
  deriving stock (Int -> LeiosTestLedgerConfig -> ShowS
[LeiosTestLedgerConfig] -> ShowS
LeiosTestLedgerConfig -> String
(Int -> LeiosTestLedgerConfig -> ShowS)
-> (LeiosTestLedgerConfig -> String)
-> ([LeiosTestLedgerConfig] -> ShowS)
-> Show LeiosTestLedgerConfig
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> LeiosTestLedgerConfig -> ShowS
showsPrec :: Int -> LeiosTestLedgerConfig -> ShowS
$cshow :: LeiosTestLedgerConfig -> String
show :: LeiosTestLedgerConfig -> String
$cshowList :: [LeiosTestLedgerConfig] -> ShowS
showList :: [LeiosTestLedgerConfig] -> ShowS
Show, (forall x. LeiosTestLedgerConfig -> Rep LeiosTestLedgerConfig x)
-> (forall x. Rep LeiosTestLedgerConfig x -> LeiosTestLedgerConfig)
-> Generic LeiosTestLedgerConfig
forall x. Rep LeiosTestLedgerConfig x -> LeiosTestLedgerConfig
forall x. LeiosTestLedgerConfig -> Rep LeiosTestLedgerConfig x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. LeiosTestLedgerConfig -> Rep LeiosTestLedgerConfig x
from :: forall x. LeiosTestLedgerConfig -> Rep LeiosTestLedgerConfig x
$cto :: forall x. Rep LeiosTestLedgerConfig x -> LeiosTestLedgerConfig
to :: forall x. Rep LeiosTestLedgerConfig x -> LeiosTestLedgerConfig
Generic)
  deriving anyclass Context -> LeiosTestLedgerConfig -> IO (Maybe ThunkInfo)
Proxy LeiosTestLedgerConfig -> String
(Context -> LeiosTestLedgerConfig -> IO (Maybe ThunkInfo))
-> (Context -> LeiosTestLedgerConfig -> IO (Maybe ThunkInfo))
-> (Proxy LeiosTestLedgerConfig -> String)
-> NoThunks LeiosTestLedgerConfig
forall a.
(Context -> a -> IO (Maybe ThunkInfo))
-> (Context -> a -> IO (Maybe ThunkInfo))
-> (Proxy a -> String)
-> NoThunks a
$cnoThunks :: Context -> LeiosTestLedgerConfig -> IO (Maybe ThunkInfo)
noThunks :: Context -> LeiosTestLedgerConfig -> IO (Maybe ThunkInfo)
$cwNoThunks :: Context -> LeiosTestLedgerConfig -> IO (Maybe ThunkInfo)
wNoThunks :: Context -> LeiosTestLedgerConfig -> IO (Maybe ThunkInfo)
$cshowTypeOf :: Proxy LeiosTestLedgerConfig -> String
showTypeOf :: Proxy LeiosTestLedgerConfig -> String
NoThunks

instance Serialise LeiosTestLedgerConfig where
  encode :: LeiosTestLedgerConfig -> Encoding
encode LeiosTestLedgerConfig
cfg =
    Word -> Encoding
CBOR.encodeListLen Word
2
      Encoding -> Encoding -> Encoding
forall a. Semigroup a => a -> a -> a
<> (EraParams, SlotNo, Ratio Integer, (Word32, Word32, Word32),
 (Word32, Word32))
-> Encoding
forall a. Serialise a => a -> Encoding
encode
        ( LeiosTestLedgerConfig -> EraParams
ltlcHardForkParams LeiosTestLedgerConfig
cfg
        , LeiosTestLedgerConfig -> SlotNo
ltlcForecastRange LeiosTestLedgerConfig
cfg
        , UnitInterval -> Ratio Integer
forall r. BoundedRational r => r -> Ratio Integer
unboundRational (LeiosLedgerView -> UnitInterval
llvQuorumStakeThreshold LeiosLedgerView
llv)
        ,
          ( Milliseconds32 -> Word32
unMilliseconds32 (LeiosLedgerView -> Milliseconds32
llvAnnouncementPeriod LeiosLedgerView
llv)
          , Milliseconds32 -> Word32
unMilliseconds32 (LeiosLedgerView -> Milliseconds32
llvVotePeriod LeiosLedgerView
llv)
          , Milliseconds32 -> Word32
unMilliseconds32 (LeiosLedgerView -> Milliseconds32
llvDiffusionPeriod LeiosLedgerView
llv)
          )
        , (LeiosLedgerView -> Word32
llvMaxEbBodySize LeiosLedgerView
llv, LeiosLedgerView -> Word32
llvMaxEbTxsSize LeiosLedgerView
llv)
        )
      Encoding -> Encoding -> Encoding
forall a. Semigroup a => a -> a -> a
<> Version -> Encoding -> Encoding
toPlainEncoding Version
leiosCodecVersion (LeiosCommittee -> Encoding
forall a. EncCBOR a => a -> Encoding
encCBOR (LeiosLedgerView -> LeiosCommittee
llvCommittee LeiosLedgerView
llv))
   where
    llv :: LeiosLedgerView
llv = LeiosTestLedgerConfig -> LeiosLedgerView
ltlcLeios LeiosTestLedgerConfig
cfg
  decode :: forall s. Decoder s LeiosTestLedgerConfig
decode = do
    Int -> Decoder s ()
forall s. Int -> Decoder s ()
CBOR.Dec.decodeListLenOf Int
2
    ( hardForkParams
      , forecastRange
      , quorum
      , (announcementPeriod, votePeriod, diffusionPeriod)
      , (maxEbBodySize, maxEbTxsSize)
      ) <-
      Decoder
  s
  (EraParams, SlotNo, Ratio Integer, (Word32, Word32, Word32),
   (Word32, Word32))
forall s.
Decoder
  s
  (EraParams, SlotNo, Ratio Integer, (Word32, Word32, Word32),
   (Word32, Word32))
forall a s. Serialise a => Decoder s a
decode
    committee <- toPlainDecoder Nothing leiosCodecVersion decCBOR
    quorumStakeThreshold <-
      maybe (fail "LeiosTestLedgerConfig: quorum out of range") pure $ boundRational quorum
    pure
      LeiosTestLedgerConfig
        { ltlcHardForkParams = hardForkParams
        , ltlcForecastRange = forecastRange
        , ltlcLeios =
            MkLeiosLedgerView
              { llvCommittee = committee
              , llvQuorumStakeThreshold = quorumStakeThreshold
              , llvAnnouncementPeriod = Milliseconds32 announcementPeriod
              , llvVotePeriod = Milliseconds32 votePeriod
              , llvDiffusionPeriod = Milliseconds32 diffusionPeriod
              , llvMaxEbBodySize = maxEbBodySize
              , llvMaxEbTxsSize = maxEbTxsSize
              }
        }

-- | Dijkstra's protocol version, since Leios arrives in Dijkstra.
--
-- The test ledger config uses it to encode the committee, which has only a
-- versioned codec.
leiosCodecVersion :: Version
leiosCodecVersion :: Version
leiosCodecVersion = forall (v :: Natural).
(KnownNat v, MinVersion <= v, v <= MaxVersion) =>
Version
natVersion @12

type instance LedgerCfg LedgerState LeiosTestBlock = LeiosTestLedgerConfig

leiosTestInitExtLedger :: LeiosTestLedgerConfig -> ExtLedgerState LeiosTestBlock ValuesMK
leiosTestInitExtLedger :: LeiosTestLedgerConfig -> ExtLedgerState LeiosTestBlock ValuesMK
leiosTestInitExtLedger LeiosTestLedgerConfig
cfg =
  ExtLedgerState
    { LedgerState LeiosTestBlock ValuesMK
forall {mk :: MapKind}. LedgerState LeiosTestBlock mk
ledgerState :: forall {mk :: MapKind}. LedgerState LeiosTestBlock mk
ledgerState :: LedgerState LeiosTestBlock ValuesMK
ledgerState
    , HeaderState LeiosTestBlock
headerState :: HeaderState LeiosTestBlock
headerState :: HeaderState LeiosTestBlock
headerState
    , perasState :: PerasState LeiosTestBlock
perasState = LedgerCfg LedgerState LeiosTestBlock
-> LedgerState LeiosTestBlock (ZonkAny MinVersion)
-> HeaderState LeiosTestBlock
-> PerasState LeiosTestBlock
forall blk (mk :: MapKind).
(All Top (HardForkIndices blk), StateSupportsPerasEpochContext blk,
 HasLedgerTables LedgerState blk) =>
LedgerCfg LedgerState blk
-> LedgerState blk mk -> HeaderState blk -> PerasState blk
initPerasState LedgerCfg LedgerState LeiosTestBlock
LeiosTestLedgerConfig
cfg LedgerState LeiosTestBlock (ZonkAny MinVersion)
forall {mk :: MapKind}. LedgerState LeiosTestBlock mk
ledgerState HeaderState LeiosTestBlock
headerState
    }
 where
  ledgerState :: LedgerState LeiosTestBlock mk
ledgerState = Point LeiosTestBlock -> LedgerState LeiosTestBlock mk
forall (mk :: MapKind).
Point LeiosTestBlock -> LedgerState LeiosTestBlock mk
LeiosTestLedger Point LeiosTestBlock
forall {k} (block :: k). Point block
GenesisPoint
  headerState :: HeaderState LeiosTestBlock
headerState = ChainDepState (BlockProtocol LeiosTestBlock)
-> HeaderState LeiosTestBlock
forall blk. ChainDepState (BlockProtocol blk) -> HeaderState blk
genesisHeaderState ()

type instance TxIn LeiosTestBlock = Void
type instance TxOut LeiosTestBlock = Void

instance LedgerTablesAreTrivial LedgerState LeiosTestBlock where
  convertMapKind :: forall (mk :: MapKind) (mk' :: MapKind).
LedgerState LeiosTestBlock mk -> LedgerState LeiosTestBlock mk'
convertMapKind (LeiosTestLedger Point LeiosTestBlock
tip) = Point LeiosTestBlock -> LedgerState LeiosTestBlock mk'
forall (mk :: MapKind).
Point LeiosTestBlock -> LedgerState LeiosTestBlock mk
LeiosTestLedger Point LeiosTestBlock
tip
instance LedgerTablesAreTrivial (Ticked LedgerState) LeiosTestBlock where
  convertMapKind :: forall (mk :: MapKind) (mk' :: MapKind).
Ticked LedgerState LeiosTestBlock mk
-> Ticked LedgerState LeiosTestBlock mk'
convertMapKind (TickedLeiosTestLedger LedgerState LeiosTestBlock mk
x) = LedgerState LeiosTestBlock mk'
-> Ticked LedgerState LeiosTestBlock mk'
forall (mk :: MapKind).
LedgerState LeiosTestBlock mk
-> Ticked LedgerState LeiosTestBlock mk
TickedLeiosTestLedger (LedgerState LeiosTestBlock mk'
 -> Ticked LedgerState LeiosTestBlock mk')
-> LedgerState LeiosTestBlock mk'
-> Ticked LedgerState LeiosTestBlock mk'
forall a b. (a -> b) -> a -> b
$ LedgerState LeiosTestBlock mk -> LedgerState LeiosTestBlock mk'
forall (mk :: MapKind) (mk' :: MapKind).
LedgerState LeiosTestBlock mk -> LedgerState LeiosTestBlock mk'
forall (l :: * -> MapKind -> *) blk (mk :: MapKind)
       (mk' :: MapKind).
LedgerTablesAreTrivial l blk =>
l blk mk -> l blk mk'
convertMapKind LedgerState LeiosTestBlock mk
x
deriving via
  Void
  instance
    IndexedMemPack LedgerState LeiosTestBlock Void
instance HasLedgerTables LedgerState LeiosTestBlock where
  projectLedgerTables :: forall (mk :: MapKind).
(CanMapMK mk, CanMapKeysMK mk, ZeroableMK mk) =>
LedgerState LeiosTestBlock mk -> LedgerTables LeiosTestBlock mk
projectLedgerTables LedgerState LeiosTestBlock mk
_ = LedgerTables LeiosTestBlock mk
forall (mk :: MapKind) blk.
(ZeroableMK mk, LedgerTableConstraints blk) =>
LedgerTables blk mk
emptyLedgerTables
  withLedgerTables :: forall (mk :: MapKind) (any :: MapKind).
(CanMapMK mk, CanMapKeysMK mk, ZeroableMK mk) =>
LedgerState LeiosTestBlock any
-> LedgerTables LeiosTestBlock mk -> LedgerState LeiosTestBlock mk
withLedgerTables LedgerState LeiosTestBlock any
st LedgerTables LeiosTestBlock mk
_ = LedgerState LeiosTestBlock any -> LedgerState LeiosTestBlock mk
forall (mk :: MapKind) (mk' :: MapKind).
LedgerState LeiosTestBlock mk -> LedgerState LeiosTestBlock mk'
forall (l :: * -> MapKind -> *) blk (mk :: MapKind)
       (mk' :: MapKind).
LedgerTablesAreTrivial l blk =>
l blk mk -> l blk mk'
convertMapKind LedgerState LeiosTestBlock any
st
instance HasLedgerTables (Ticked LedgerState) LeiosTestBlock where
  projectLedgerTables :: forall (mk :: MapKind).
(CanMapMK mk, CanMapKeysMK mk, ZeroableMK mk) =>
Ticked LedgerState LeiosTestBlock mk
-> LedgerTables LeiosTestBlock mk
projectLedgerTables Ticked LedgerState LeiosTestBlock mk
_ = LedgerTables LeiosTestBlock mk
forall (mk :: MapKind) blk.
(ZeroableMK mk, LedgerTableConstraints blk) =>
LedgerTables blk mk
emptyLedgerTables
  withLedgerTables :: forall (mk :: MapKind) (any :: MapKind).
(CanMapMK mk, CanMapKeysMK mk, ZeroableMK mk) =>
Ticked LedgerState LeiosTestBlock any
-> LedgerTables LeiosTestBlock mk
-> Ticked LedgerState LeiosTestBlock mk
withLedgerTables Ticked LedgerState LeiosTestBlock any
st LedgerTables LeiosTestBlock mk
_ = Ticked LedgerState LeiosTestBlock any
-> Ticked LedgerState LeiosTestBlock mk
forall (mk :: MapKind) (mk' :: MapKind).
Ticked LedgerState LeiosTestBlock mk
-> Ticked LedgerState LeiosTestBlock mk'
forall (l :: * -> MapKind -> *) blk (mk :: MapKind)
       (mk' :: MapKind).
LedgerTablesAreTrivial l blk =>
l blk mk -> l blk mk'
convertMapKind Ticked LedgerState LeiosTestBlock any
st
instance CanStowLedgerTables (LedgerState LeiosTestBlock) where
  stowLedgerTables :: LedgerState LeiosTestBlock ValuesMK
-> LedgerState LeiosTestBlock EmptyMK
stowLedgerTables = LedgerState LeiosTestBlock ValuesMK
-> LedgerState LeiosTestBlock EmptyMK
forall (mk :: MapKind) (mk' :: MapKind).
LedgerState LeiosTestBlock mk -> LedgerState LeiosTestBlock mk'
forall (l :: * -> MapKind -> *) blk (mk :: MapKind)
       (mk' :: MapKind).
LedgerTablesAreTrivial l blk =>
l blk mk -> l blk mk'
convertMapKind
  unstowLedgerTables :: LedgerState LeiosTestBlock EmptyMK
-> LedgerState LeiosTestBlock ValuesMK
unstowLedgerTables = LedgerState LeiosTestBlock EmptyMK
-> LedgerState LeiosTestBlock ValuesMK
forall (mk :: MapKind) (mk' :: MapKind).
LedgerState LeiosTestBlock mk -> LedgerState LeiosTestBlock mk'
forall (l :: * -> MapKind -> *) blk (mk :: MapKind)
       (mk' :: MapKind).
LedgerTablesAreTrivial l blk =>
l blk mk -> l blk mk'
convertMapKind
instance CanUpgradeLedgerTables LedgerState LeiosTestBlock where
  upgradeTables :: forall (mk1 :: MapKind) (mk2 :: MapKind).
LedgerState LeiosTestBlock mk1
-> LedgerState LeiosTestBlock mk2
-> LedgerTables LeiosTestBlock ValuesMK
-> LedgerTables LeiosTestBlock ValuesMK
upgradeTables LedgerState LeiosTestBlock mk1
_ LedgerState LeiosTestBlock mk2
_ = LedgerTables LeiosTestBlock ValuesMK
-> LedgerTables LeiosTestBlock ValuesMK
forall a. a -> a
id
instance SerializeTablesWithHint LedgerState LeiosTestBlock where
  decodeTablesWithHint :: forall s.
LedgerState LeiosTestBlock EmptyMK
-> Decoder s (LedgerTables LeiosTestBlock ValuesMK)
decodeTablesWithHint LedgerState LeiosTestBlock EmptyMK
_ = do
    _ <- Decoder s Int
forall s. Decoder s Int
CBOR.Dec.decodeMapLen
    pure (LedgerTables $ ValuesMK Map.empty)
  encodeTablesWithHint :: LedgerState LeiosTestBlock EmptyMK
-> LedgerTables LeiosTestBlock ValuesMK -> Encoding
encodeTablesWithHint LedgerState LeiosTestBlock EmptyMK
_ LedgerTables LeiosTestBlock ValuesMK
_ = Word -> Encoding
CBOR.encodeMapLen Word
0

instance GetTip (LedgerState LeiosTestBlock) where
  getTip :: forall (mk :: MapKind).
LedgerState LeiosTestBlock mk -> Point (LedgerState LeiosTestBlock)
getTip = Point LeiosTestBlock -> Point (LedgerState LeiosTestBlock)
forall {k1} {k2} (b :: k1) (b' :: k2).
Coercible (HeaderHash b) (HeaderHash b') =>
Point b -> Point b'
castPoint (Point LeiosTestBlock -> Point (LedgerState LeiosTestBlock))
-> (LedgerState LeiosTestBlock mk -> Point LeiosTestBlock)
-> LedgerState LeiosTestBlock mk
-> Point (LedgerState LeiosTestBlock)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. LedgerState LeiosTestBlock mk -> Point LeiosTestBlock
forall (mk :: MapKind).
LedgerState LeiosTestBlock mk -> Point LeiosTestBlock
ltlsTip

instance GetTip (Ticked LedgerState LeiosTestBlock) where
  getTip :: forall (mk :: MapKind).
Ticked LedgerState LeiosTestBlock mk
-> Point (Ticked LedgerState LeiosTestBlock)
getTip = Point LeiosTestBlock -> Point (Ticked LedgerState LeiosTestBlock)
forall {k1} {k2} (b :: k1) (b' :: k2).
Coercible (HeaderHash b) (HeaderHash b') =>
Point b -> Point b'
castPoint (Point LeiosTestBlock -> Point (Ticked LedgerState LeiosTestBlock))
-> (Ticked LedgerState LeiosTestBlock mk -> Point LeiosTestBlock)
-> Ticked LedgerState LeiosTestBlock mk
-> Point (Ticked LedgerState LeiosTestBlock)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. LedgerState LeiosTestBlock mk -> Point LeiosTestBlock
forall (mk :: MapKind).
LedgerState LeiosTestBlock mk -> Point LeiosTestBlock
ltlsTip (LedgerState LeiosTestBlock mk -> Point LeiosTestBlock)
-> (Ticked LedgerState LeiosTestBlock mk
    -> LedgerState LeiosTestBlock mk)
-> Ticked LedgerState LeiosTestBlock mk
-> Point LeiosTestBlock
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Ticked LedgerState LeiosTestBlock mk
-> LedgerState LeiosTestBlock mk
forall (mk :: MapKind).
Ticked LedgerState LeiosTestBlock mk
-> LedgerState LeiosTestBlock mk
getTickedLeiosTestLedger

type instance AuxLedgerEvent LeiosTestBlock = VoidLedgerEvent

instance IsLedger LedgerState LeiosTestBlock where
  type LedgerErr LedgerState LeiosTestBlock = LeiosTestBlockError

  applyChainTickLedgerResult :: ComputeLedgerEvents
-> LedgerCfg LedgerState LeiosTestBlock
-> SlotNo
-> LedgerState LeiosTestBlock EmptyMK
-> LedgerResult
     LeiosTestBlock (Ticked LedgerState LeiosTestBlock DiffMK)
applyChainTickLedgerResult ComputeLedgerEvents
_events LedgerCfg LedgerState LeiosTestBlock
_cfg SlotNo
_slot =
    Ticked LedgerState LeiosTestBlock DiffMK
-> LedgerResult
     LeiosTestBlock (Ticked LedgerState LeiosTestBlock DiffMK)
forall a l. a -> LedgerResult l a
pureLedgerResult (Ticked LedgerState LeiosTestBlock DiffMK
 -> LedgerResult
      LeiosTestBlock (Ticked LedgerState LeiosTestBlock DiffMK))
-> (LedgerState LeiosTestBlock EmptyMK
    -> Ticked LedgerState LeiosTestBlock DiffMK)
-> LedgerState LeiosTestBlock EmptyMK
-> LedgerResult
     LeiosTestBlock (Ticked LedgerState LeiosTestBlock DiffMK)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. LedgerState LeiosTestBlock DiffMK
-> Ticked LedgerState LeiosTestBlock DiffMK
forall (mk :: MapKind).
LedgerState LeiosTestBlock mk
-> Ticked LedgerState LeiosTestBlock mk
TickedLeiosTestLedger (LedgerState LeiosTestBlock DiffMK
 -> Ticked LedgerState LeiosTestBlock DiffMK)
-> (LedgerState LeiosTestBlock EmptyMK
    -> LedgerState LeiosTestBlock DiffMK)
-> LedgerState LeiosTestBlock EmptyMK
-> Ticked LedgerState LeiosTestBlock DiffMK
forall b c a. (b -> c) -> (a -> b) -> a -> c
. LedgerState LeiosTestBlock EmptyMK
-> LedgerState LeiosTestBlock DiffMK
forall (l :: * -> MapKind -> *) blk (any :: MapKind).
HasLedgerTables l blk =>
l blk any -> l blk DiffMK
noNewTickingDiffs

instance ApplyBlock LedgerState LeiosTestBlock where
  applyBlockLedgerResultWithValidation :: HasCallStack =>
ValidationPolicy
-> ComputeLedgerEvents
-> LedgerCfg LedgerState LeiosTestBlock
-> LeiosTestBlock
-> Ticked LedgerState LeiosTestBlock ValuesMK
-> Except
     (LedgerErr LedgerState LeiosTestBlock)
     (LedgerResult LeiosTestBlock (LedgerState LeiosTestBlock DiffMK))
applyBlockLedgerResultWithValidation
    ValidationPolicy
_validation
    ComputeLedgerEvents
_events
    LedgerCfg LedgerState LeiosTestBlock
_cfg
    LeiosTestBlock
blk
    (TickedLeiosTestLedger LeiosTestLedger{Point LeiosTestBlock
ltlsTip :: forall (mk :: MapKind).
LedgerState LeiosTestBlock mk -> Point LeiosTestBlock
ltlsTip :: Point LeiosTestBlock
ltlsTip})
      | LeiosTestBlock -> ChainHash LeiosTestBlock
forall blk. GetPrevHash blk => blk -> ChainHash blk
blockPrevHash LeiosTestBlock
blk ChainHash LeiosTestBlock -> ChainHash LeiosTestBlock -> Bool
forall a. Eq a => a -> a -> Bool
/= Point LeiosTestBlock -> ChainHash LeiosTestBlock
forall {k} (block :: k). Point block -> ChainHash block
pointHash Point LeiosTestBlock
ltlsTip =
          LeiosTestBlockError
-> Except
     (LedgerErr LedgerState LeiosTestBlock)
     (LedgerResult LeiosTestBlock (LedgerState LeiosTestBlock DiffMK))
forall a.
LeiosTestBlockError
-> ExceptT (LedgerErr LedgerState LeiosTestBlock) Identity a
forall e (m :: * -> *) a. MonadError e m => e -> m a
throwError (LeiosTestBlockError
 -> Except
      (LedgerErr LedgerState LeiosTestBlock)
      (LedgerResult LeiosTestBlock (LedgerState LeiosTestBlock DiffMK)))
-> LeiosTestBlockError
-> Except
     (LedgerErr LedgerState LeiosTestBlock)
     (LedgerResult LeiosTestBlock (LedgerState LeiosTestBlock DiffMK))
forall a b. (a -> b) -> a -> b
$ ChainHash LeiosTestBlock
-> ChainHash LeiosTestBlock -> LeiosTestBlockError
LeiosTestInvalidHash (Point LeiosTestBlock -> ChainHash LeiosTestBlock
forall {k} (block :: k). Point block -> ChainHash block
pointHash Point LeiosTestBlock
ltlsTip) (LeiosTestBlock -> ChainHash LeiosTestBlock
forall blk. GetPrevHash blk => blk -> ChainHash blk
blockPrevHash LeiosTestBlock
blk)
      | Bool
otherwise =
          LedgerResult LeiosTestBlock (LedgerState LeiosTestBlock DiffMK)
-> Except
     (LedgerErr LedgerState LeiosTestBlock)
     (LedgerResult LeiosTestBlock (LedgerState LeiosTestBlock DiffMK))
forall a.
a -> ExceptT (LedgerErr LedgerState LeiosTestBlock) Identity a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (LedgerResult LeiosTestBlock (LedgerState LeiosTestBlock DiffMK)
 -> Except
      (LedgerErr LedgerState LeiosTestBlock)
      (LedgerResult LeiosTestBlock (LedgerState LeiosTestBlock DiffMK)))
-> LedgerResult LeiosTestBlock (LedgerState LeiosTestBlock DiffMK)
-> Except
     (LedgerErr LedgerState LeiosTestBlock)
     (LedgerResult LeiosTestBlock (LedgerState LeiosTestBlock DiffMK))
forall a b. (a -> b) -> a -> b
$ LedgerState LeiosTestBlock DiffMK
-> LedgerResult LeiosTestBlock (LedgerState LeiosTestBlock DiffMK)
forall a l. a -> LedgerResult l a
pureLedgerResult (LedgerState LeiosTestBlock DiffMK
 -> LedgerResult LeiosTestBlock (LedgerState LeiosTestBlock DiffMK))
-> LedgerState LeiosTestBlock DiffMK
-> LedgerResult LeiosTestBlock (LedgerState LeiosTestBlock DiffMK)
forall a b. (a -> b) -> a -> b
$ LedgerState LeiosTestBlock TrackingMK
-> LedgerState LeiosTestBlock DiffMK
forall (l :: * -> MapKind -> *) blk.
HasLedgerTables l blk =>
l blk TrackingMK -> l blk DiffMK
trackingToDiffs (LedgerState LeiosTestBlock TrackingMK
 -> LedgerState LeiosTestBlock DiffMK)
-> LedgerState LeiosTestBlock TrackingMK
-> LedgerState LeiosTestBlock DiffMK
forall a b. (a -> b) -> a -> b
$ Point LeiosTestBlock -> LedgerState LeiosTestBlock TrackingMK
forall (mk :: MapKind).
Point LeiosTestBlock -> LedgerState LeiosTestBlock mk
LeiosTestLedger (LeiosTestBlock -> Point LeiosTestBlock
forall block. HasHeader block => block -> Point block
blockPoint LeiosTestBlock
blk)

  applyBlockLedgerResult :: HasCallStack =>
ComputeLedgerEvents
-> LedgerCfg LedgerState LeiosTestBlock
-> LeiosTestBlock
-> Ticked LedgerState LeiosTestBlock ValuesMK
-> Except
     (LedgerErr LedgerState LeiosTestBlock)
     (LedgerResult LeiosTestBlock (LedgerState LeiosTestBlock DiffMK))
applyBlockLedgerResult = ComputeLedgerEvents
-> LedgerCfg LedgerState LeiosTestBlock
-> LeiosTestBlock
-> Ticked LedgerState LeiosTestBlock ValuesMK
-> Except
     (LedgerErr LedgerState LeiosTestBlock)
     (LedgerResult LeiosTestBlock (LedgerState LeiosTestBlock DiffMK))
forall (l :: * -> MapKind -> *) blk.
(HasCallStack, ApplyBlock l blk) =>
ComputeLedgerEvents
-> LedgerCfg l blk
-> blk
-> Ticked l blk ValuesMK
-> Except (LedgerErr l blk) (LedgerResult blk (l blk DiffMK))
defaultApplyBlockLedgerResult
  reapplyBlockLedgerResult :: HasCallStack =>
ComputeLedgerEvents
-> LedgerCfg LedgerState LeiosTestBlock
-> LeiosTestBlock
-> Ticked LedgerState LeiosTestBlock ValuesMK
-> LedgerResult LeiosTestBlock (LedgerState LeiosTestBlock DiffMK)
reapplyBlockLedgerResult =
    (LedgerErr LedgerState LeiosTestBlock
 -> LedgerResult LeiosTestBlock (LedgerState LeiosTestBlock DiffMK))
-> ComputeLedgerEvents
-> LedgerCfg LedgerState LeiosTestBlock
-> LeiosTestBlock
-> Ticked LedgerState LeiosTestBlock ValuesMK
-> LedgerResult LeiosTestBlock (LedgerState LeiosTestBlock DiffMK)
forall (l :: * -> MapKind -> *) blk.
(HasCallStack, ApplyBlock l blk) =>
(LedgerErr l blk -> LedgerResult blk (l blk DiffMK))
-> ComputeLedgerEvents
-> LedgerCfg l blk
-> blk
-> Ticked l blk ValuesMK
-> LedgerResult blk (l blk DiffMK)
defaultReapplyBlockLedgerResult
      (String
-> LedgerResult LeiosTestBlock (LedgerState LeiosTestBlock DiffMK)
forall a. HasCallStack => String -> a
error (String
 -> LedgerResult LeiosTestBlock (LedgerState LeiosTestBlock DiffMK))
-> (LeiosTestBlockError -> String)
-> LeiosTestBlockError
-> LedgerResult LeiosTestBlock (LedgerState LeiosTestBlock DiffMK)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (String
"reapplying a block failed: " String -> ShowS
forall a. [a] -> [a] -> [a]
++) ShowS
-> (LeiosTestBlockError -> String) -> LeiosTestBlockError -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. LeiosTestBlockError -> String
forall a. Show a => a -> String
show)

instance GetBlockKeySets LeiosTestBlock where
  getBlockKeySets :: LeiosTestBlock -> LedgerTables LeiosTestBlock KeysMK
getBlockKeySets = LedgerTables LeiosTestBlock KeysMK
-> LeiosTestBlock -> LedgerTables LeiosTestBlock KeysMK
forall a b. a -> b -> a
const LedgerTables LeiosTestBlock KeysMK
forall (mk :: MapKind) blk.
(ZeroableMK mk, LedgerTableConstraints blk) =>
LedgerTables blk mk
emptyLedgerTables

instance UpdateLedger LeiosTestBlock

instance InspectLedger LeiosTestBlock

instance HasAnnTip LeiosTestBlock

instance BasicEnvelopeValidation LeiosTestBlock

instance ValidateEnvelope LeiosTestBlock

instance LedgerSupportsProtocol LeiosTestBlock where
  protocolLedgerView :: forall (mk :: MapKind).
LedgerCfg LedgerState LeiosTestBlock
-> Ticked LedgerState LeiosTestBlock mk
-> LedgerView (BlockProtocol LeiosTestBlock)
protocolLedgerView LedgerCfg LedgerState LeiosTestBlock
cfg Ticked LedgerState LeiosTestBlock mk
_st = LeiosTestLedgerConfig -> LeiosLedgerView
ltlcLeios LedgerCfg LedgerState LeiosTestBlock
LeiosTestLedgerConfig
cfg
  ledgerViewForecastAt :: forall (mk :: MapKind).
HasCallStack =>
LedgerCfg LedgerState LeiosTestBlock
-> LedgerState LeiosTestBlock mk
-> Forecast (LedgerView (BlockProtocol LeiosTestBlock))
ledgerViewForecastAt LedgerCfg LedgerState LeiosTestBlock
cfg LedgerState LeiosTestBlock mk
st =
    Maybe SlotNo
-> LeiosLedgerView -> WithOrigin SlotNo -> Forecast LeiosLedgerView
forall a. Maybe SlotNo -> a -> WithOrigin SlotNo -> Forecast a
constantForecastInRange (SlotNo -> Maybe SlotNo
forall a. a -> Maybe a
Just (LeiosTestLedgerConfig -> SlotNo
ltlcForecastRange LedgerCfg LedgerState LeiosTestBlock
LeiosTestLedgerConfig
cfg)) (LeiosTestLedgerConfig -> LeiosLedgerView
ltlcLeios LedgerCfg LedgerState LeiosTestBlock
LeiosTestLedgerConfig
cfg) (LedgerState LeiosTestBlock mk -> WithOrigin SlotNo
forall (l :: MapKind -> *) (mk :: MapKind).
GetTip l =>
l mk -> WithOrigin SlotNo
getTipSlot LedgerState LeiosTestBlock mk
st)

instance LedgerStateSupportsPeras (LedgerState LeiosTestBlock)

instance LedgerStateSupportsPeras (Ticked LedgerState LeiosTestBlock)

instance StateSupportsPerasEpochContext LeiosTestBlock where
  type MaybeEraIndexedEpochToPerasRoundInfo LeiosTestBlock = EpochToPerasRoundInfo
  toMaybeEraIndexedEpochToPerasRoundInfo :: forall (proxy :: * -> *).
All Top (HardForkIndices LeiosTestBlock) =>
proxy LeiosTestBlock
-> EraIndexed
     (HardForkIndices LeiosTestBlock) EpochToPerasRoundInfo
-> MaybeEraIndexedEpochToPerasRoundInfo LeiosTestBlock
toMaybeEraIndexedEpochToPerasRoundInfo proxy LeiosTestBlock
_ = EraIndexed '[LeiosTestBlock] EpochToPerasRoundInfo
-> EpochToPerasRoundInfo
EraIndexed (HardForkIndices LeiosTestBlock) EpochToPerasRoundInfo
-> MaybeEraIndexedEpochToPerasRoundInfo LeiosTestBlock
forall (xs :: [*]) a. EraIndexed xs a -> a
forgetEraIndex
  fromMaybeEraIndexedEpochToPerasRoundInfo :: forall (proxy :: * -> *).
proxy LeiosTestBlock
-> MaybeEraIndexedEpochToPerasRoundInfo LeiosTestBlock
-> EpochToPerasRoundInfo
fromMaybeEraIndexedEpochToPerasRoundInfo proxy LeiosTestBlock
_ = EpochToPerasRoundInfo -> EpochToPerasRoundInfo
MaybeEraIndexedEpochToPerasRoundInfo LeiosTestBlock
-> EpochToPerasRoundInfo
forall a. a -> a
id
  mkBoundedPerasEpochContext :: forall (ledgerState :: MapKind -> *) chainDepState.
(LedgerStateSupportsPeras ledgerState,
 ChainDepStateSupportsPeras chainDepState) =>
MaybeEraIndexedEpochToPerasRoundInfo LeiosTestBlock
-> ledgerState EmptyMK
-> chainDepState
-> Either
     (PerasError LeiosTestBlock)
     (BoundedPerasEpochContext LeiosTestBlock)
mkBoundedPerasEpochContext = ((LedgerStateSupportsPeras ledgerState,
  ChainDepStateSupportsPeras chainDepState) =>
 ledgerState EmptyMK
 -> chainDepState
 -> Either
      (PerasError LeiosTestBlock)
      (PerasVotingCommitteeInput LeiosTestBlock))
-> MaybeEraIndexedEpochToPerasRoundInfo LeiosTestBlock
-> ledgerState EmptyMK
-> chainDepState
-> Either
     (PerasError LeiosTestBlock)
     (BoundedPerasEpochContext LeiosTestBlock)
forall (ledgerState :: MapKind -> *) chainDepState blk.
(LedgerStateSupportsPeras ledgerState,
 ChainDepStateSupportsPeras chainDepState,
 CryptoSupportsVotingCommittee
   (PerasCrypto blk) (PerasVotingCommitteeScheme blk),
 MaybeEraIndexedEpochToPerasRoundInfo blk ~ EpochToPerasRoundInfo,
 IsPerasError (PerasError blk) blk) =>
((LedgerStateSupportsPeras ledgerState,
  ChainDepStateSupportsPeras chainDepState) =>
 ledgerState EmptyMK
 -> chainDepState
 -> Either (PerasError blk) (PerasVotingCommitteeInput blk))
-> MaybeEraIndexedEpochToPerasRoundInfo blk
-> ledgerState EmptyMK
-> chainDepState
-> Either (PerasError blk) (BoundedPerasEpochContext blk)
mkBoundedPerasEpochContextWith ledgerState EmptyMK
-> chainDepState
-> Either
     (PerasError LeiosTestBlock)
     (PerasVotingCommitteeInput LeiosTestBlock)
ledgerState EmptyMK
-> chainDepState
-> Either
     (MockPerasError LeiosTestBlock)
     (VotingCommitteeInput
        (PerasCrypto LeiosTestBlock)
        (MockPerasVotingCommitteeScheme LeiosTestBlock))
(LedgerStateSupportsPeras ledgerState,
 ChainDepStateSupportsPeras chainDepState) =>
ledgerState EmptyMK
-> chainDepState
-> Either
     (PerasError LeiosTestBlock)
     (PerasVotingCommitteeInput LeiosTestBlock)
forall blk (ledgerState :: MapKind -> *) chainDepState.
(PerasCrypto blk ~ MockPerasCrypto blk,
 LedgerStateSupportsPeras ledgerState) =>
ledgerState EmptyMK
-> chainDepState
-> Either
     (MockPerasError blk)
     (VotingCommitteeInput
        (PerasCrypto blk) (MockPerasVotingCommitteeScheme blk))
mkMockPerasVotingCommitteeInput

-- | A mock, as for 'Test.Util.TestBlock.TestBlock'.
instance BlockSupportsPeras LeiosTestBlock where
  type PerasCrypto LeiosTestBlock = MockPerasCrypto LeiosTestBlock
  type PerasVotingCommitteeScheme LeiosTestBlock = MockPerasVotingCommitteeScheme LeiosTestBlock
  type PerasVote LeiosTestBlock = MockPerasVote LeiosTestBlock
  type PerasCert LeiosTestBlock = MockPerasCert LeiosTestBlock
  type PerasError LeiosTestBlock = MockPerasError LeiosTestBlock
  forgePerasVoteIfEligible :: PerasEpochContext LeiosTestBlock
-> PoolId
-> PrivateKey (PerasCrypto LeiosTestBlock)
-> PerasRoundNo
-> Point LeiosTestBlock
-> Either
     (PerasError LeiosTestBlock)
     (Maybe (ValidatedPerasVote LeiosTestBlock))
forgePerasVoteIfEligible = PerasEpochContext LeiosTestBlock
-> PoolId
-> PrivateKey (PerasCrypto LeiosTestBlock)
-> PerasRoundNo
-> Point LeiosTestBlock
-> Either
     (PerasError LeiosTestBlock)
     (Maybe (ValidatedPerasVote LeiosTestBlock))
forall blk.
(BlockSupportsPeras blk,
 CryptoSupportsVotingCommittee
   (PerasCrypto blk) (PerasVotingCommitteeScheme blk),
 PerasVoteCompatibleWithVotingCommittee
   (PerasVote blk)
   (PerasCrypto blk)
   (PerasVotingCommitteeScheme blk)) =>
PerasEpochContext blk
-> PoolId
-> PrivateKey (PerasCrypto blk)
-> PerasRoundNo
-> Point blk
-> Either (PerasError blk) (Maybe (ValidatedPerasVote blk))
defaultForgePerasVoteIfEligible
  verifyPerasVote :: PerasEpochContext LeiosTestBlock
-> PerasVote LeiosTestBlock
-> Either
     (PerasError LeiosTestBlock) (ValidatedPerasVote LeiosTestBlock)
verifyPerasVote = PerasEpochContext LeiosTestBlock
-> PerasVote LeiosTestBlock
-> Either
     (PerasError LeiosTestBlock) (ValidatedPerasVote LeiosTestBlock)
forall blk.
(BlockSupportsPeras blk,
 CryptoSupportsVotingCommittee
   (PerasCrypto blk) (PerasVotingCommitteeScheme blk),
 PerasVoteCompatibleWithVotingCommittee
   (PerasVote blk)
   (PerasCrypto blk)
   (PerasVotingCommitteeScheme blk)) =>
PerasEpochContext blk
-> PerasVote blk
-> Either (PerasError blk) (ValidatedPerasVote blk)
defaultVerifyPerasVote
  forgePerasCert :: PerasEpochContext LeiosTestBlock
-> PerasVoteCollectionWithQuorum LeiosTestBlock
-> Either
     (PerasError LeiosTestBlock) (ValidatedPerasCert LeiosTestBlock)
forgePerasCert = PerasEpochContext LeiosTestBlock
-> PerasVoteCollectionWithQuorum LeiosTestBlock
-> Either
     (PerasError LeiosTestBlock) (ValidatedPerasCert LeiosTestBlock)
forall blk.
(BlockSupportsPeras blk,
 CryptoSupportsVotingCommittee
   (PerasCrypto blk) (PerasVotingCommitteeScheme blk),
 PerasVoteCompatibleWithVotingCommittee
   (PerasVote blk) (PerasCrypto blk) (PerasVotingCommitteeScheme blk),
 PerasCertCompatibleWithVotingCommittee
   (PerasCert blk)
   (PerasCrypto blk)
   (PerasVotingCommitteeScheme blk)) =>
PerasEpochContext blk
-> PerasVoteCollectionWithQuorum blk
-> Either (PerasError blk) (ValidatedPerasCert blk)
defaultForgePerasCert
  verifyPerasCert :: PerasEpochContext LeiosTestBlock
-> PerasCert LeiosTestBlock
-> Either
     (PerasError LeiosTestBlock) (ValidatedPerasCert LeiosTestBlock)
verifyPerasCert = PerasEpochContext LeiosTestBlock
-> PerasCert LeiosTestBlock
-> Either
     (PerasError LeiosTestBlock) (ValidatedPerasCert LeiosTestBlock)
forall blk.
(BlockSupportsPeras blk,
 CryptoSupportsVotingCommittee
   (PerasCrypto blk) (PerasVotingCommitteeScheme blk),
 PerasCertCompatibleWithVotingCommittee
   (PerasCert blk)
   (PerasCrypto blk)
   (PerasVotingCommitteeScheme blk)) =>
PerasEpochContext blk
-> PerasCert blk
-> Either (PerasError blk) (ValidatedPerasCert blk)
defaultVerifyPerasCert
  getPerasCertInBlock :: LeiosTestBlock
-> Either
     (PerasError LeiosTestBlock) (Maybe (PerasCert LeiosTestBlock))
getPerasCertInBlock LeiosTestBlock
_ = Maybe (MockPerasCert LeiosTestBlock)
-> Either
     (MockPerasError LeiosTestBlock)
     (Maybe (MockPerasCert LeiosTestBlock))
forall a b. b -> Either a b
Right Maybe (MockPerasCert LeiosTestBlock)
forall a. Maybe a
Nothing

instance HasHardForkHistory LeiosTestBlock where
  type HardForkIndices LeiosTestBlock = '[LeiosTestBlock]
  hardForkSummary :: forall (mk :: MapKind).
LedgerCfg LedgerState LeiosTestBlock
-> LedgerState LeiosTestBlock mk
-> Summary (HardForkIndices LeiosTestBlock)
hardForkSummary = (LedgerCfg LedgerState LeiosTestBlock -> EraParams)
-> LedgerCfg LedgerState LeiosTestBlock
-> LedgerState LeiosTestBlock mk
-> Summary '[LeiosTestBlock]
forall blk (mk :: MapKind).
(LedgerConfig blk -> EraParams)
-> LedgerConfig blk -> LedgerState blk mk -> Summary '[blk]
neverForksHardForkSummary LedgerCfg LedgerState LeiosTestBlock -> EraParams
LeiosTestLedgerConfig -> EraParams
ltlcHardForkParams

instance ImmutableEraParams LeiosTestBlock where
  immutableEraParams :: TopLevelConfig LeiosTestBlock -> EraParams
immutableEraParams = LeiosTestLedgerConfig -> EraParams
ltlcHardForkParams (LeiosTestLedgerConfig -> EraParams)
-> (TopLevelConfig LeiosTestBlock -> LeiosTestLedgerConfig)
-> TopLevelConfig LeiosTestBlock
-> EraParams
forall b c a. (b -> c) -> (a -> b) -> a -> c
. TopLevelConfig LeiosTestBlock
-> LedgerCfg LedgerState LeiosTestBlock
TopLevelConfig LeiosTestBlock -> LeiosTestLedgerConfig
forall blk. TopLevelConfig blk -> LedgerConfig blk
topLevelConfigLedger

{-------------------------------------------------------------------------------
  Configuration
-------------------------------------------------------------------------------}

data instance BlockConfig LeiosTestBlock = LeiosTestBlockConfig
  deriving stock (Int -> BlockConfig LeiosTestBlock -> ShowS
[BlockConfig LeiosTestBlock] -> ShowS
BlockConfig LeiosTestBlock -> String
(Int -> BlockConfig LeiosTestBlock -> ShowS)
-> (BlockConfig LeiosTestBlock -> String)
-> ([BlockConfig LeiosTestBlock] -> ShowS)
-> Show (BlockConfig LeiosTestBlock)
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> BlockConfig LeiosTestBlock -> ShowS
showsPrec :: Int -> BlockConfig LeiosTestBlock -> ShowS
$cshow :: BlockConfig LeiosTestBlock -> String
show :: BlockConfig LeiosTestBlock -> String
$cshowList :: [BlockConfig LeiosTestBlock] -> ShowS
showList :: [BlockConfig LeiosTestBlock] -> ShowS
Show, (forall x.
 BlockConfig LeiosTestBlock -> Rep (BlockConfig LeiosTestBlock) x)
-> (forall x.
    Rep (BlockConfig LeiosTestBlock) x -> BlockConfig LeiosTestBlock)
-> Generic (BlockConfig LeiosTestBlock)
forall x.
Rep (BlockConfig LeiosTestBlock) x -> BlockConfig LeiosTestBlock
forall x.
BlockConfig LeiosTestBlock -> Rep (BlockConfig LeiosTestBlock) x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x.
BlockConfig LeiosTestBlock -> Rep (BlockConfig LeiosTestBlock) x
from :: forall x.
BlockConfig LeiosTestBlock -> Rep (BlockConfig LeiosTestBlock) x
$cto :: forall x.
Rep (BlockConfig LeiosTestBlock) x -> BlockConfig LeiosTestBlock
to :: forall x.
Rep (BlockConfig LeiosTestBlock) x -> BlockConfig LeiosTestBlock
Generic)
  deriving anyclass Context -> BlockConfig LeiosTestBlock -> IO (Maybe ThunkInfo)
Proxy (BlockConfig LeiosTestBlock) -> String
(Context -> BlockConfig LeiosTestBlock -> IO (Maybe ThunkInfo))
-> (Context -> BlockConfig LeiosTestBlock -> IO (Maybe ThunkInfo))
-> (Proxy (BlockConfig LeiosTestBlock) -> String)
-> NoThunks (BlockConfig LeiosTestBlock)
forall a.
(Context -> a -> IO (Maybe ThunkInfo))
-> (Context -> a -> IO (Maybe ThunkInfo))
-> (Proxy a -> String)
-> NoThunks a
$cnoThunks :: Context -> BlockConfig LeiosTestBlock -> IO (Maybe ThunkInfo)
noThunks :: Context -> BlockConfig LeiosTestBlock -> IO (Maybe ThunkInfo)
$cwNoThunks :: Context -> BlockConfig LeiosTestBlock -> IO (Maybe ThunkInfo)
wNoThunks :: Context -> BlockConfig LeiosTestBlock -> IO (Maybe ThunkInfo)
$cshowTypeOf :: Proxy (BlockConfig LeiosTestBlock) -> String
showTypeOf :: Proxy (BlockConfig LeiosTestBlock) -> String
NoThunks

data instance CodecConfig LeiosTestBlock = LeiosTestCodecConfig
  deriving stock (Int -> CodecConfig LeiosTestBlock -> ShowS
[CodecConfig LeiosTestBlock] -> ShowS
CodecConfig LeiosTestBlock -> String
(Int -> CodecConfig LeiosTestBlock -> ShowS)
-> (CodecConfig LeiosTestBlock -> String)
-> ([CodecConfig LeiosTestBlock] -> ShowS)
-> Show (CodecConfig LeiosTestBlock)
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> CodecConfig LeiosTestBlock -> ShowS
showsPrec :: Int -> CodecConfig LeiosTestBlock -> ShowS
$cshow :: CodecConfig LeiosTestBlock -> String
show :: CodecConfig LeiosTestBlock -> String
$cshowList :: [CodecConfig LeiosTestBlock] -> ShowS
showList :: [CodecConfig LeiosTestBlock] -> ShowS
Show, (forall x.
 CodecConfig LeiosTestBlock -> Rep (CodecConfig LeiosTestBlock) x)
-> (forall x.
    Rep (CodecConfig LeiosTestBlock) x -> CodecConfig LeiosTestBlock)
-> Generic (CodecConfig LeiosTestBlock)
forall x.
Rep (CodecConfig LeiosTestBlock) x -> CodecConfig LeiosTestBlock
forall x.
CodecConfig LeiosTestBlock -> Rep (CodecConfig LeiosTestBlock) x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x.
CodecConfig LeiosTestBlock -> Rep (CodecConfig LeiosTestBlock) x
from :: forall x.
CodecConfig LeiosTestBlock -> Rep (CodecConfig LeiosTestBlock) x
$cto :: forall x.
Rep (CodecConfig LeiosTestBlock) x -> CodecConfig LeiosTestBlock
to :: forall x.
Rep (CodecConfig LeiosTestBlock) x -> CodecConfig LeiosTestBlock
Generic)
  deriving anyclass Context -> CodecConfig LeiosTestBlock -> IO (Maybe ThunkInfo)
Proxy (CodecConfig LeiosTestBlock) -> String
(Context -> CodecConfig LeiosTestBlock -> IO (Maybe ThunkInfo))
-> (Context -> CodecConfig LeiosTestBlock -> IO (Maybe ThunkInfo))
-> (Proxy (CodecConfig LeiosTestBlock) -> String)
-> NoThunks (CodecConfig LeiosTestBlock)
forall a.
(Context -> a -> IO (Maybe ThunkInfo))
-> (Context -> a -> IO (Maybe ThunkInfo))
-> (Proxy a -> String)
-> NoThunks a
$cnoThunks :: Context -> CodecConfig LeiosTestBlock -> IO (Maybe ThunkInfo)
noThunks :: Context -> CodecConfig LeiosTestBlock -> IO (Maybe ThunkInfo)
$cwNoThunks :: Context -> CodecConfig LeiosTestBlock -> IO (Maybe ThunkInfo)
wNoThunks :: Context -> CodecConfig LeiosTestBlock -> IO (Maybe ThunkInfo)
$cshowTypeOf :: Proxy (CodecConfig LeiosTestBlock) -> String
showTypeOf :: Proxy (CodecConfig LeiosTestBlock) -> String
NoThunks

data instance StorageConfig LeiosTestBlock = LeiosTestStorageConfig
  deriving stock (Int -> StorageConfig LeiosTestBlock -> ShowS
[StorageConfig LeiosTestBlock] -> ShowS
StorageConfig LeiosTestBlock -> String
(Int -> StorageConfig LeiosTestBlock -> ShowS)
-> (StorageConfig LeiosTestBlock -> String)
-> ([StorageConfig LeiosTestBlock] -> ShowS)
-> Show (StorageConfig LeiosTestBlock)
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> StorageConfig LeiosTestBlock -> ShowS
showsPrec :: Int -> StorageConfig LeiosTestBlock -> ShowS
$cshow :: StorageConfig LeiosTestBlock -> String
show :: StorageConfig LeiosTestBlock -> String
$cshowList :: [StorageConfig LeiosTestBlock] -> ShowS
showList :: [StorageConfig LeiosTestBlock] -> ShowS
Show, (forall x.
 StorageConfig LeiosTestBlock
 -> Rep (StorageConfig LeiosTestBlock) x)
-> (forall x.
    Rep (StorageConfig LeiosTestBlock) x
    -> StorageConfig LeiosTestBlock)
-> Generic (StorageConfig LeiosTestBlock)
forall x.
Rep (StorageConfig LeiosTestBlock) x
-> StorageConfig LeiosTestBlock
forall x.
StorageConfig LeiosTestBlock
-> Rep (StorageConfig LeiosTestBlock) x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x.
StorageConfig LeiosTestBlock
-> Rep (StorageConfig LeiosTestBlock) x
from :: forall x.
StorageConfig LeiosTestBlock
-> Rep (StorageConfig LeiosTestBlock) x
$cto :: forall x.
Rep (StorageConfig LeiosTestBlock) x
-> StorageConfig LeiosTestBlock
to :: forall x.
Rep (StorageConfig LeiosTestBlock) x
-> StorageConfig LeiosTestBlock
Generic)
  deriving anyclass Context -> StorageConfig LeiosTestBlock -> IO (Maybe ThunkInfo)
Proxy (StorageConfig LeiosTestBlock) -> String
(Context -> StorageConfig LeiosTestBlock -> IO (Maybe ThunkInfo))
-> (Context
    -> StorageConfig LeiosTestBlock -> IO (Maybe ThunkInfo))
-> (Proxy (StorageConfig LeiosTestBlock) -> String)
-> NoThunks (StorageConfig LeiosTestBlock)
forall a.
(Context -> a -> IO (Maybe ThunkInfo))
-> (Context -> a -> IO (Maybe ThunkInfo))
-> (Proxy a -> String)
-> NoThunks a
$cnoThunks :: Context -> StorageConfig LeiosTestBlock -> IO (Maybe ThunkInfo)
noThunks :: Context -> StorageConfig LeiosTestBlock -> IO (Maybe ThunkInfo)
$cwNoThunks :: Context -> StorageConfig LeiosTestBlock -> IO (Maybe ThunkInfo)
wNoThunks :: Context -> StorageConfig LeiosTestBlock -> IO (Maybe ThunkInfo)
$cshowTypeOf :: Proxy (StorageConfig LeiosTestBlock) -> String
showTypeOf :: Proxy (StorageConfig LeiosTestBlock) -> String
NoThunks

instance HasNetworkProtocolVersion LeiosTestBlock

instance ConfigSupportsNode LeiosTestBlock where
  -- Where io-sim starts its clock, so that slot 0 begins as a test does. An
  -- earlier date would put the node many slots past its empty chain at the
  -- outset, and a later one would leave its clock not yet started.
  getSystemStart :: BlockConfig LeiosTestBlock -> SystemStart
getSystemStart = SystemStart -> BlockConfig LeiosTestBlock -> SystemStart
forall a b. a -> b -> a
const (UTCTime -> SystemStart
SystemStart (Day -> DiffTime -> UTCTime
UTCTime Day
systemEpochDay DiffTime
0))

  getNetworkMagic :: BlockConfig LeiosTestBlock -> NetworkMagic
getNetworkMagic = NetworkMagic -> BlockConfig LeiosTestBlock -> NetworkMagic
forall a b. a -> b -> a
const (Word32 -> NetworkMagic
NetworkMagic Word32
42)

singleNodeLeiosTestConfig ::
  LeiosTestLedgerConfig ->
  SecurityParam ->
  TopLevelConfig LeiosTestBlock
singleNodeLeiosTestConfig :: LeiosTestLedgerConfig
-> SecurityParam -> TopLevelConfig LeiosTestBlock
singleNodeLeiosTestConfig LeiosTestLedgerConfig
ledgerConfig SecurityParam
k =
  TopLevelConfig
    { topLevelConfigProtocol :: ConsensusConfig (BlockProtocol LeiosTestBlock)
topLevelConfigProtocol = SecurityParam -> ConsensusConfig LeiosTestProtocol
LeiosTestProtocolConfig SecurityParam
k
    , topLevelConfigLedger :: LedgerCfg LedgerState LeiosTestBlock
topLevelConfigLedger = LedgerCfg LedgerState LeiosTestBlock
LeiosTestLedgerConfig
ledgerConfig
    , topLevelConfigBlock :: BlockConfig LeiosTestBlock
topLevelConfigBlock = BlockConfig LeiosTestBlock
LeiosTestBlockConfig
    , topLevelConfigCodec :: CodecConfig LeiosTestBlock
topLevelConfigCodec = CodecConfig LeiosTestBlock
LeiosTestCodecConfig
    , topLevelConfigStorage :: StorageConfig LeiosTestBlock
topLevelConfigStorage = StorageConfig LeiosTestBlock
LeiosTestStorageConfig
    , topLevelConfigCheckpoints :: CheckpointsMap LeiosTestBlock
topLevelConfigCheckpoints = CheckpointsMap LeiosTestBlock
forall blk. CheckpointsMap blk
emptyCheckpointsMap
    }

{-------------------------------------------------------------------------------
  NestedCtxt
-------------------------------------------------------------------------------}

data instance NestedCtxt_ LeiosTestBlock f a where
  CtxtLeiosTestBlock :: NestedCtxt_ LeiosTestBlock f (f LeiosTestBlock)

deriving instance Show (NestedCtxt_ LeiosTestBlock f a)

instance TrivialDependency (NestedCtxt_ LeiosTestBlock f) where
  type TrivialIndex (NestedCtxt_ LeiosTestBlock f) = f LeiosTestBlock
  hasSingleIndex :: forall a b.
NestedCtxt_ LeiosTestBlock f a
-> NestedCtxt_ LeiosTestBlock f b -> a :~: b
hasSingleIndex NestedCtxt_ LeiosTestBlock f a
R:NestedCtxt_LeiosTestBlockfa f a
CtxtLeiosTestBlock NestedCtxt_ LeiosTestBlock f b
R:NestedCtxt_LeiosTestBlockfa f b
CtxtLeiosTestBlock = a :~: a
a :~: b
forall {k} (a :: k). a :~: a
Refl
  indexIsTrivial :: NestedCtxt_
  LeiosTestBlock f (TrivialIndex (NestedCtxt_ LeiosTestBlock f))
indexIsTrivial = NestedCtxt_ LeiosTestBlock f (f LeiosTestBlock)
NestedCtxt_
  LeiosTestBlock f (TrivialIndex (NestedCtxt_ LeiosTestBlock f))
forall (f :: * -> *).
NestedCtxt_ LeiosTestBlock f (f LeiosTestBlock)
CtxtLeiosTestBlock

instance SameDepIndex (NestedCtxt_ LeiosTestBlock f)
instance HasNestedContent f LeiosTestBlock

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

instance Serialise LeiosTestBlock where
  encode :: LeiosTestBlock -> Encoding
encode (LeiosTestBlock Header LeiosTestBlock
hdr) = Header LeiosTestBlock -> Encoding
forall a. Serialise a => a -> Encoding
encode Header LeiosTestBlock
hdr
  decode :: forall s. Decoder s LeiosTestBlock
decode = Header LeiosTestBlock -> LeiosTestBlock
LeiosTestBlock (Header LeiosTestBlock -> LeiosTestBlock)
-> Decoder s (Header LeiosTestBlock) -> Decoder s LeiosTestBlock
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Decoder s (Header LeiosTestBlock)
forall s. Decoder s (Header LeiosTestBlock)
forall a s. Serialise a => Decoder s a
decode

instance Serialise (Header LeiosTestBlock) where
  encode :: Header LeiosTestBlock -> Encoding
encode LeiosTestHeader{Maybe (EbHash, Word32)
Word64
SlotNo
TestHash
Validity
CounterVsImmTip
lthHash :: Header LeiosTestBlock -> TestHash
lthSlot :: Header LeiosTestBlock -> SlotNo
lthIssuer :: Header LeiosTestBlock -> Word64
lthAnnouncement :: Header LeiosTestBlock -> Maybe (EbHash, Word32)
lthValidity :: Header LeiosTestBlock -> Validity
lthCounter :: Header LeiosTestBlock -> CounterVsImmTip
lthHash :: TestHash
lthSlot :: SlotNo
lthIssuer :: Word64
lthAnnouncement :: Maybe (EbHash, Word32)
lthValidity :: Validity
lthCounter :: CounterVsImmTip
..} =
    TestHash -> Encoding
forall a. Serialise a => a -> Encoding
encode TestHash
lthHash
      Encoding -> Encoding -> Encoding
forall a. Semigroup a => a -> a -> a
<> SlotNo -> Encoding
forall a. Serialise a => a -> Encoding
encode SlotNo
lthSlot
      Encoding -> Encoding -> Encoding
forall a. Semigroup a => a -> a -> a
<> Word64 -> Encoding
forall a. Serialise a => a -> Encoding
encode Word64
lthIssuer
      Encoding -> Encoding -> Encoding
forall a. Semigroup a => a -> a -> a
<> ((EbHash, Word32) -> Encoding)
-> Maybe (EbHash, Word32) -> Encoding
forall a. (a -> Encoding) -> Maybe a -> Encoding
encodeMaybe (EbHash, Word32) -> Encoding
encodeAnnouncement Maybe (EbHash, Word32)
lthAnnouncement
      Encoding -> Encoding -> Encoding
forall a. Semigroup a => a -> a -> a
<> Validity -> Encoding
forall a. Serialise a => a -> Encoding
encode Validity
lthValidity
      Encoding -> Encoding -> Encoding
forall a. Semigroup a => a -> a -> a
<> CounterVsImmTip -> Encoding
forall a. Serialise a => a -> Encoding
encode CounterVsImmTip
lthCounter
  decode :: forall s. Decoder s (Header LeiosTestBlock)
decode = do
    lthHash <- Decoder s TestHash
forall s. Decoder s TestHash
forall a s. Serialise a => Decoder s a
decode
    lthSlot <- decode
    lthIssuer <- decode
    lthAnnouncement <- decodeMaybe decodeAnnouncement
    lthValidity <- decode
    lthCounter <- decode
    pure LeiosTestHeader{..}

encodeAnnouncement :: (EbHash, BytesSize) -> Encoding
encodeAnnouncement :: (EbHash, Word32) -> Encoding
encodeAnnouncement (EbHash
ebHash, Word32
size) =
  Word -> Encoding
CBOR.encodeListLen Word
2 Encoding -> Encoding -> Encoding
forall a. Semigroup a => a -> a -> a
<> EbHash -> Encoding
encodeEbHash EbHash
ebHash Encoding -> Encoding -> Encoding
forall a. Semigroup a => a -> a -> a
<> Word32 -> Encoding
forall a. Serialise a => a -> Encoding
encode Word32
size

decodeAnnouncement :: Decoder s (EbHash, BytesSize)
decodeAnnouncement :: forall s. Decoder s (EbHash, Word32)
decodeAnnouncement = do
  Text -> Int -> Decoder s ()
forall s. Text -> Int -> Decoder s ()
enforceSize (String -> Text
forall a. IsString a => String -> a
fromString String
"Announcement") Int
2
  (,) (EbHash -> Word32 -> (EbHash, Word32))
-> Decoder s EbHash -> Decoder s (Word32 -> (EbHash, Word32))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Decoder s EbHash
forall s. Decoder s EbHash
decodeEbHash Decoder s (Word32 -> (EbHash, Word32))
-> Decoder s Word32 -> Decoder s (EbHash, Word32)
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 Word32
forall s. Decoder s Word32
forall a s. Serialise a => Decoder s a
decode

instance HasBinaryBlockInfo LeiosTestBlock where
  getBinaryBlockInfo :: LeiosTestBlock -> BinaryBlockInfo
getBinaryBlockInfo LeiosTestBlock
blk =
    BinaryBlockInfo
      { headerOffset :: Word16
headerOffset = Word16
0
      , headerSize :: Word16
headerSize = Int64 -> Word16
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int64 -> Word16)
-> (LeiosTestBlock -> Int64) -> LeiosTestBlock -> Word16
forall b c a. (b -> c) -> (a -> b) -> a -> c
. LazyByteString -> Int64
BL.length (LazyByteString -> Int64)
-> (LeiosTestBlock -> LazyByteString) -> LeiosTestBlock -> Int64
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Header LeiosTestBlock -> LazyByteString
forall a. Serialise a => a -> LazyByteString
serialise (Header LeiosTestBlock -> LazyByteString)
-> (LeiosTestBlock -> Header LeiosTestBlock)
-> LeiosTestBlock
-> LazyByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. LeiosTestBlock -> Header LeiosTestBlock
ltbHeader (LeiosTestBlock -> Word16) -> LeiosTestBlock -> Word16
forall a b. (a -> b) -> a -> b
$ LeiosTestBlock
blk
      }

-- | The cap this block's hash imposes on chain length: its 32 bytes hold the
-- path's length and 31 path components. See the LIMIT on 'Header'
-- 'LeiosTestBlock'.
maxLeiosTestChainLength :: Int
maxLeiosTestChainLength :: Int
maxLeiosTestChainLength = Int
31

-- | The raw hash is 32 bytes, as a real header hash is, so that a message that
-- carries one has its real size. It holds the path's length and then one byte
-- per path component, so a path component, a fork number, must be below 256.
instance ConvertRawHash LeiosTestBlock where
  type HashSize LeiosTestBlock = 32
  toRawHash :: forall (proxy :: * -> *).
proxy LeiosTestBlock -> HeaderHash LeiosTestBlock -> ByteString
toRawHash proxy LeiosTestBlock
_ (TestHash NonEmpty Word64
h)
    | Int
len Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
maxLeiosTestChainLength =
        String -> ByteString
forall a. HasCallStack => String -> a
error (String -> ByteString) -> String -> ByteString
forall a b. (a -> b) -> a -> b
$
          String
"LeiosTestBlock: chain longer than "
            String -> ShowS
forall a. Semigroup a => a -> a -> a
<> Int -> String
forall a. Show a => a -> String
show Int
maxLeiosTestChainLength
            String -> ShowS
forall a. Semigroup a => a -> a -> a
<> String
" blocks"
    | (Word64 -> Bool) -> NonEmpty Word64 -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
any (Word64 -> Word64 -> Bool
forall a. Ord a => a -> a -> Bool
> Word64
255) NonEmpty Word64
h = String -> ByteString
forall a. HasCallStack => String -> a
error String
"LeiosTestBlock: fork number above 255"
    | Bool
otherwise = LazyByteString -> ByteString
BL.toStrict (LazyByteString -> ByteString)
-> (PutM () -> LazyByteString) -> PutM () -> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. PutM () -> LazyByteString
Put.runPut (PutM () -> ByteString) -> PutM () -> ByteString
forall a b. (a -> b) -> a -> b
$ do
        Word8 -> PutM ()
Put.putWord8 (Int -> Word8
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
len)
        NonEmpty Word64 -> (Word64 -> PutM ()) -> PutM ()
forall (t :: * -> *) (f :: * -> *) a b.
(Foldable t, Applicative f) =>
t a -> (a -> f b) -> f ()
for_ NonEmpty Word64
h (Word8 -> PutM ()
Put.putWord8 (Word8 -> PutM ()) -> (Word64 -> Word8) -> Word64 -> PutM ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Word64 -> Word8
forall a b. (Integral a, Num b) => a -> b
fromIntegral)
        Int -> PutM () -> PutM ()
forall (m :: * -> *) a. Applicative m => Int -> m a -> m ()
replicateM_ (Int
maxLeiosTestChainLength Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
len) (PutM () -> PutM ()) -> PutM () -> PutM ()
forall a b. (a -> b) -> a -> b
$ Word8 -> PutM ()
Put.putWord8 Word8
0
   where
    len :: Int
len = NonEmpty Word64 -> Int
forall a. NonEmpty a -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length NonEmpty Word64
h
  unsafeFromRawHash :: forall (proxy :: * -> *).
proxy LeiosTestBlock -> ByteString -> HeaderHash LeiosTestBlock
unsafeFromRawHash proxy LeiosTestBlock
_ ByteString
bs = (Get TestHash -> LazyByteString -> HeaderHash LeiosTestBlock)
-> LazyByteString -> Get TestHash -> HeaderHash LeiosTestBlock
forall a b c. (a -> b -> c) -> b -> a -> c
flip Get TestHash -> LazyByteString -> HeaderHash LeiosTestBlock
Get TestHash -> LazyByteString -> TestHash
forall a. Get a -> LazyByteString -> a
Get.runGet (ByteString -> LazyByteString
BL.fromStrict ByteString
bs) (Get TestHash -> HeaderHash LeiosTestBlock)
-> Get TestHash -> HeaderHash LeiosTestBlock
forall a b. (a -> b) -> a -> b
$ do
    len <- Word8 -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Word8 -> Int) -> Get Word8 -> Get Int
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Get Word8
Get.getWord8
    (NE.nonEmpty -> Just h, rs) <-
      splitAt len <$> replicateM maxLeiosTestChainLength Get.getWord8
    guard $ all (0 ==) rs
    pure $ TestHash (fromIntegral <$> h)

instance Serialise (AnnTip LeiosTestBlock) where
  encode :: AnnTip LeiosTestBlock -> Encoding
encode = (HeaderHash LeiosTestBlock -> Encoding)
-> AnnTip LeiosTestBlock -> Encoding
forall blk.
(TipInfo blk ~ HeaderHash blk) =>
(HeaderHash blk -> Encoding) -> AnnTip blk -> Encoding
defaultEncodeAnnTip HeaderHash LeiosTestBlock -> Encoding
TestHash -> Encoding
forall a. Serialise a => a -> Encoding
encode
  decode :: forall s. Decoder s (AnnTip LeiosTestBlock)
decode = (forall s. Decoder s (HeaderHash LeiosTestBlock))
-> forall s. Decoder s (AnnTip LeiosTestBlock)
forall blk.
(TipInfo blk ~ HeaderHash blk) =>
(forall s. Decoder s (HeaderHash blk))
-> forall s. Decoder s (AnnTip blk)
defaultDecodeAnnTip Decoder s (HeaderHash LeiosTestBlock)
Decoder s TestHash
forall s. Decoder s (HeaderHash LeiosTestBlock)
forall s. Decoder s TestHash
forall a s. Serialise a => Decoder s a
decode

instance Serialise (ExtLedgerState LeiosTestBlock EmptyMK) where
  encode :: ExtLedgerState LeiosTestBlock EmptyMK -> Encoding
encode = (LedgerState LeiosTestBlock EmptyMK -> Encoding)
-> (ChainDepState (BlockProtocol LeiosTestBlock) -> Encoding)
-> (AnnTip LeiosTestBlock -> Encoding)
-> (PerasState LeiosTestBlock -> Encoding)
-> ExtLedgerState LeiosTestBlock EmptyMK
-> Encoding
forall blk (mk :: MapKind).
(LedgerState blk mk -> Encoding)
-> (ChainDepState (BlockProtocol blk) -> Encoding)
-> (AnnTip blk -> Encoding)
-> (PerasState blk -> Encoding)
-> ExtLedgerState blk mk
-> Encoding
encodeExtLedgerState LedgerState LeiosTestBlock EmptyMK -> Encoding
forall a. Serialise a => a -> Encoding
encode () -> Encoding
ChainDepState (BlockProtocol LeiosTestBlock) -> Encoding
forall a. Serialise a => a -> Encoding
encode AnnTip LeiosTestBlock -> Encoding
forall a. Serialise a => a -> Encoding
encode PerasState LeiosTestBlock -> Encoding
forall a. ToCBOR a => a -> Encoding
toCBOR
  decode :: forall s. Decoder s (ExtLedgerState LeiosTestBlock EmptyMK)
decode = (forall s. Decoder s (LedgerState LeiosTestBlock EmptyMK))
-> (forall s.
    Decoder s (ChainDepState (BlockProtocol LeiosTestBlock)))
-> (forall s. Decoder s (AnnTip LeiosTestBlock))
-> (forall s. Decoder s (PerasState LeiosTestBlock))
-> forall s. Decoder s (ExtLedgerState LeiosTestBlock EmptyMK)
forall blk.
(forall s. Decoder s (LedgerState blk EmptyMK))
-> (forall s. Decoder s (ChainDepState (BlockProtocol blk)))
-> (forall s. Decoder s (AnnTip blk))
-> (forall s. Decoder s (PerasState blk))
-> forall s. Decoder s (ExtLedgerState blk EmptyMK)
decodeExtLedgerState Decoder s (LedgerState LeiosTestBlock EmptyMK)
forall s. Decoder s (LedgerState LeiosTestBlock EmptyMK)
forall a s. Serialise a => Decoder s a
decode Decoder s ()
Decoder s (ChainDepState (BlockProtocol LeiosTestBlock))
forall s. Decoder s ()
forall s. Decoder s (ChainDepState (BlockProtocol LeiosTestBlock))
forall a s. Serialise a => Decoder s a
decode Decoder s (AnnTip LeiosTestBlock)
forall s. Decoder s (AnnTip LeiosTestBlock)
forall a s. Serialise a => Decoder s a
decode Decoder s (PerasState LeiosTestBlock)
forall s. Decoder s (PerasState LeiosTestBlock)
forall a s. FromCBOR a => Decoder s a
fromCBOR

instance Serialise (RealPoint LeiosTestBlock) where
  encode :: RealPoint LeiosTestBlock -> Encoding
encode = (HeaderHash LeiosTestBlock -> Encoding)
-> RealPoint LeiosTestBlock -> Encoding
forall blk.
(HeaderHash blk -> Encoding) -> RealPoint blk -> Encoding
encodeRealPoint HeaderHash LeiosTestBlock -> Encoding
TestHash -> Encoding
forall a. Serialise a => a -> Encoding
encode
  decode :: forall s. Decoder s (RealPoint LeiosTestBlock)
decode = (forall s. Decoder s (HeaderHash LeiosTestBlock))
-> forall s. Decoder s (RealPoint LeiosTestBlock)
forall blk.
(forall s. Decoder s (HeaderHash blk))
-> forall s. Decoder s (RealPoint blk)
decodeRealPoint Decoder s (HeaderHash LeiosTestBlock)
Decoder s TestHash
forall s. Decoder s (HeaderHash LeiosTestBlock)
forall s. Decoder s TestHash
forall a s. Serialise a => Decoder s a
decode

instance EncodeDisk LeiosTestBlock LeiosTestBlock
instance DecodeDisk LeiosTestBlock (BL.ByteString -> Either DecoderError LeiosTestBlock) where
  decodeDisk :: CodecConfig LeiosTestBlock
-> forall s.
   Decoder s (LazyByteString -> Either DecoderError LeiosTestBlock)
decodeDisk CodecConfig LeiosTestBlock
_ = Either DecoderError LeiosTestBlock
-> LazyByteString -> Either DecoderError LeiosTestBlock
forall a b. a -> b -> a
const (Either DecoderError LeiosTestBlock
 -> LazyByteString -> Either DecoderError LeiosTestBlock)
-> (LeiosTestBlock -> Either DecoderError LeiosTestBlock)
-> LeiosTestBlock
-> LazyByteString
-> Either DecoderError LeiosTestBlock
forall b c a. (b -> c) -> (a -> b) -> a -> c
. LeiosTestBlock -> Either DecoderError LeiosTestBlock
forall a b. b -> Either a b
Right (LeiosTestBlock
 -> LazyByteString -> Either DecoderError LeiosTestBlock)
-> Decoder s LeiosTestBlock
-> Decoder s (LazyByteString -> Either DecoderError LeiosTestBlock)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Decoder s LeiosTestBlock
forall s. Decoder s LeiosTestBlock
forall a s. Serialise a => Decoder s a
decode

instance EncodeDisk LeiosTestBlock (Header LeiosTestBlock)
instance DecodeDisk LeiosTestBlock (BL.ByteString -> Header LeiosTestBlock) where
  decodeDisk :: CodecConfig LeiosTestBlock
-> forall s. Decoder s (LazyByteString -> Header LeiosTestBlock)
decodeDisk CodecConfig LeiosTestBlock
_ = Header LeiosTestBlock -> LazyByteString -> Header LeiosTestBlock
forall a b. a -> b -> a
const (Header LeiosTestBlock -> LazyByteString -> Header LeiosTestBlock)
-> Decoder s (Header LeiosTestBlock)
-> Decoder s (LazyByteString -> Header LeiosTestBlock)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Decoder s (Header LeiosTestBlock)
forall s. Decoder s (Header LeiosTestBlock)
forall a s. Serialise a => Decoder s a
decode

instance EncodeDisk LeiosTestBlock (AnnTip LeiosTestBlock)
instance DecodeDisk LeiosTestBlock (AnnTip LeiosTestBlock)

instance ReconstructNestedCtxt Header LeiosTestBlock

instance EncodeDisk LeiosTestBlock (LedgerState LeiosTestBlock EmptyMK)
instance DecodeDisk LeiosTestBlock (LedgerState LeiosTestBlock EmptyMK)

instance EncodeDiskDep (NestedCtxt Header) LeiosTestBlock
instance DecodeDiskDep (NestedCtxt Header) LeiosTestBlock

instance EncodeDisk LeiosTestBlock ()
instance DecodeDisk LeiosTestBlock ()

instance SerialiseDiskConstraints LeiosTestBlock

deriving via
  SelectViewDiffusionPipelining LeiosTestBlock
  instance
    BlockSupportsDiffusionPipelining LeiosTestBlock

{-------------------------------------------------------------------------------
  Mempool

  'RunNode' demands a mempool even of a node that never forges. This one
  rejects every transaction.
-------------------------------------------------------------------------------}

data instance GenTx LeiosTestBlock = LeiosTestGenTx
  deriving stock (GenTx LeiosTestBlock -> GenTx LeiosTestBlock -> Bool
(GenTx LeiosTestBlock -> GenTx LeiosTestBlock -> Bool)
-> (GenTx LeiosTestBlock -> GenTx LeiosTestBlock -> Bool)
-> Eq (GenTx LeiosTestBlock)
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: GenTx LeiosTestBlock -> GenTx LeiosTestBlock -> Bool
== :: GenTx LeiosTestBlock -> GenTx LeiosTestBlock -> Bool
$c/= :: GenTx LeiosTestBlock -> GenTx LeiosTestBlock -> Bool
/= :: GenTx LeiosTestBlock -> GenTx LeiosTestBlock -> Bool
Eq, Int -> GenTx LeiosTestBlock -> ShowS
[GenTx LeiosTestBlock] -> ShowS
GenTx LeiosTestBlock -> String
(Int -> GenTx LeiosTestBlock -> ShowS)
-> (GenTx LeiosTestBlock -> String)
-> ([GenTx LeiosTestBlock] -> ShowS)
-> Show (GenTx LeiosTestBlock)
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> GenTx LeiosTestBlock -> ShowS
showsPrec :: Int -> GenTx LeiosTestBlock -> ShowS
$cshow :: GenTx LeiosTestBlock -> String
show :: GenTx LeiosTestBlock -> String
$cshowList :: [GenTx LeiosTestBlock] -> ShowS
showList :: [GenTx LeiosTestBlock] -> ShowS
Show, (forall x. GenTx LeiosTestBlock -> Rep (GenTx LeiosTestBlock) x)
-> (forall x. Rep (GenTx LeiosTestBlock) x -> GenTx LeiosTestBlock)
-> Generic (GenTx LeiosTestBlock)
forall x. Rep (GenTx LeiosTestBlock) x -> GenTx LeiosTestBlock
forall x. GenTx LeiosTestBlock -> Rep (GenTx LeiosTestBlock) x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. GenTx LeiosTestBlock -> Rep (GenTx LeiosTestBlock) x
from :: forall x. GenTx LeiosTestBlock -> Rep (GenTx LeiosTestBlock) x
$cto :: forall x. Rep (GenTx LeiosTestBlock) x -> GenTx LeiosTestBlock
to :: forall x. Rep (GenTx LeiosTestBlock) x -> GenTx LeiosTestBlock
Generic)
  deriving anyclass ([GenTx LeiosTestBlock] -> Encoding
GenTx LeiosTestBlock -> Encoding
(GenTx LeiosTestBlock -> Encoding)
-> (forall s. Decoder s (GenTx LeiosTestBlock))
-> ([GenTx LeiosTestBlock] -> Encoding)
-> (forall s. Decoder s [GenTx LeiosTestBlock])
-> Serialise (GenTx LeiosTestBlock)
forall s. Decoder s [GenTx LeiosTestBlock]
forall s. Decoder s (GenTx LeiosTestBlock)
forall a.
(a -> Encoding)
-> (forall s. Decoder s a)
-> ([a] -> Encoding)
-> (forall s. Decoder s [a])
-> Serialise a
$cencode :: GenTx LeiosTestBlock -> Encoding
encode :: GenTx LeiosTestBlock -> Encoding
$cdecode :: forall s. Decoder s (GenTx LeiosTestBlock)
decode :: forall s. Decoder s (GenTx LeiosTestBlock)
$cencodeList :: [GenTx LeiosTestBlock] -> Encoding
encodeList :: [GenTx LeiosTestBlock] -> Encoding
$cdecodeList :: forall s. Decoder s [GenTx LeiosTestBlock]
decodeList :: forall s. Decoder s [GenTx LeiosTestBlock]
Serialise, Context -> GenTx LeiosTestBlock -> IO (Maybe ThunkInfo)
Proxy (GenTx LeiosTestBlock) -> String
(Context -> GenTx LeiosTestBlock -> IO (Maybe ThunkInfo))
-> (Context -> GenTx LeiosTestBlock -> IO (Maybe ThunkInfo))
-> (Proxy (GenTx LeiosTestBlock) -> String)
-> NoThunks (GenTx LeiosTestBlock)
forall a.
(Context -> a -> IO (Maybe ThunkInfo))
-> (Context -> a -> IO (Maybe ThunkInfo))
-> (Proxy a -> String)
-> NoThunks a
$cnoThunks :: Context -> GenTx LeiosTestBlock -> IO (Maybe ThunkInfo)
noThunks :: Context -> GenTx LeiosTestBlock -> IO (Maybe ThunkInfo)
$cwNoThunks :: Context -> GenTx LeiosTestBlock -> IO (Maybe ThunkInfo)
wNoThunks :: Context -> GenTx LeiosTestBlock -> IO (Maybe ThunkInfo)
$cshowTypeOf :: Proxy (GenTx LeiosTestBlock) -> String
showTypeOf :: Proxy (GenTx LeiosTestBlock) -> String
NoThunks)

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

data LeiosTestTxRejected = LeiosTestTxRejected
  deriving stock (LeiosTestTxRejected -> LeiosTestTxRejected -> Bool
(LeiosTestTxRejected -> LeiosTestTxRejected -> Bool)
-> (LeiosTestTxRejected -> LeiosTestTxRejected -> Bool)
-> Eq LeiosTestTxRejected
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: LeiosTestTxRejected -> LeiosTestTxRejected -> Bool
== :: LeiosTestTxRejected -> LeiosTestTxRejected -> Bool
$c/= :: LeiosTestTxRejected -> LeiosTestTxRejected -> Bool
/= :: LeiosTestTxRejected -> LeiosTestTxRejected -> Bool
Eq, Int -> LeiosTestTxRejected -> ShowS
[LeiosTestTxRejected] -> ShowS
LeiosTestTxRejected -> String
(Int -> LeiosTestTxRejected -> ShowS)
-> (LeiosTestTxRejected -> String)
-> ([LeiosTestTxRejected] -> ShowS)
-> Show LeiosTestTxRejected
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> LeiosTestTxRejected -> ShowS
showsPrec :: Int -> LeiosTestTxRejected -> ShowS
$cshow :: LeiosTestTxRejected -> String
show :: LeiosTestTxRejected -> String
$cshowList :: [LeiosTestTxRejected] -> ShowS
showList :: [LeiosTestTxRejected] -> ShowS
Show, (forall x. LeiosTestTxRejected -> Rep LeiosTestTxRejected x)
-> (forall x. Rep LeiosTestTxRejected x -> LeiosTestTxRejected)
-> Generic LeiosTestTxRejected
forall x. Rep LeiosTestTxRejected x -> LeiosTestTxRejected
forall x. LeiosTestTxRejected -> Rep LeiosTestTxRejected x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. LeiosTestTxRejected -> Rep LeiosTestTxRejected x
from :: forall x. LeiosTestTxRejected -> Rep LeiosTestTxRejected x
$cto :: forall x. Rep LeiosTestTxRejected x -> LeiosTestTxRejected
to :: forall x. Rep LeiosTestTxRejected x -> LeiosTestTxRejected
Generic)
  deriving anyclass ([LeiosTestTxRejected] -> Encoding
LeiosTestTxRejected -> Encoding
(LeiosTestTxRejected -> Encoding)
-> (forall s. Decoder s LeiosTestTxRejected)
-> ([LeiosTestTxRejected] -> Encoding)
-> (forall s. Decoder s [LeiosTestTxRejected])
-> Serialise LeiosTestTxRejected
forall s. Decoder s [LeiosTestTxRejected]
forall s. Decoder s LeiosTestTxRejected
forall a.
(a -> Encoding)
-> (forall s. Decoder s a)
-> ([a] -> Encoding)
-> (forall s. Decoder s [a])
-> Serialise a
$cencode :: LeiosTestTxRejected -> Encoding
encode :: LeiosTestTxRejected -> Encoding
$cdecode :: forall s. Decoder s LeiosTestTxRejected
decode :: forall s. Decoder s LeiosTestTxRejected
$cencodeList :: [LeiosTestTxRejected] -> Encoding
encodeList :: [LeiosTestTxRejected] -> Encoding
$cdecodeList :: forall s. Decoder s [LeiosTestTxRejected]
decodeList :: forall s. Decoder s [LeiosTestTxRejected]
Serialise, Context -> LeiosTestTxRejected -> IO (Maybe ThunkInfo)
Proxy LeiosTestTxRejected -> String
(Context -> LeiosTestTxRejected -> IO (Maybe ThunkInfo))
-> (Context -> LeiosTestTxRejected -> IO (Maybe ThunkInfo))
-> (Proxy LeiosTestTxRejected -> String)
-> NoThunks LeiosTestTxRejected
forall a.
(Context -> a -> IO (Maybe ThunkInfo))
-> (Context -> a -> IO (Maybe ThunkInfo))
-> (Proxy a -> String)
-> NoThunks a
$cnoThunks :: Context -> LeiosTestTxRejected -> IO (Maybe ThunkInfo)
noThunks :: Context -> LeiosTestTxRejected -> IO (Maybe ThunkInfo)
$cwNoThunks :: Context -> LeiosTestTxRejected -> IO (Maybe ThunkInfo)
wNoThunks :: Context -> LeiosTestTxRejected -> IO (Maybe ThunkInfo)
$cshowTypeOf :: Proxy LeiosTestTxRejected -> String
showTypeOf :: Proxy LeiosTestTxRejected -> String
NoThunks)

type instance ApplyTxErr LeiosTestBlock = LeiosTestTxRejected

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

instance ShowProxy (GenTx LeiosTestBlock)
instance ShowProxy (TxId (GenTx LeiosTestBlock))
instance ShowProxy LeiosTestTxRejected

instance HasTxId (GenTx LeiosTestBlock) where
  txId :: GenTx LeiosTestBlock -> TxId (GenTx LeiosTestBlock)
txId GenTx LeiosTestBlock
R:GenTxLeiosTestBlock
LeiosTestGenTx = Word64 -> TxId (GenTx LeiosTestBlock)
LeiosTestTxId Word64
0

instance ConvertRawTxId (GenTx LeiosTestBlock) where
  toRawTxIdHash :: TxId (GenTx LeiosTestBlock) -> ShortByteString
toRawTxIdHash = ByteString -> ShortByteString
SBS.toShort (ByteString -> ShortByteString)
-> (TxId (GenTx LeiosTestBlock) -> ByteString)
-> TxId (GenTx LeiosTestBlock)
-> ShortByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. LazyByteString -> ByteString
BL.toStrict (LazyByteString -> ByteString)
-> (TxId (GenTx LeiosTestBlock) -> LazyByteString)
-> TxId (GenTx LeiosTestBlock)
-> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. TxId (GenTx LeiosTestBlock) -> LazyByteString
forall a. Serialise a => a -> LazyByteString
serialise

instance LedgerSupportsMempool LeiosTestBlock where
  applyTx :: LedgerCfg LedgerState LeiosTestBlock
-> WhetherToIntervene
-> SlotNo
-> GenTx LeiosTestBlock
-> Ticked LedgerState LeiosTestBlock ValuesMK
-> Except
     (ApplyTxErr LeiosTestBlock)
     (Ticked LedgerState LeiosTestBlock DiffMK,
      Validated (GenTx LeiosTestBlock))
applyTx LedgerCfg LedgerState LeiosTestBlock
_cfg WhetherToIntervene
_wti SlotNo
_slot GenTx LeiosTestBlock
_tx Ticked LedgerState LeiosTestBlock ValuesMK
_st = LeiosTestTxRejected
-> ExceptT
     LeiosTestTxRejected
     Identity
     (Ticked LedgerState LeiosTestBlock DiffMK,
      Validated (GenTx LeiosTestBlock))
forall a.
LeiosTestTxRejected -> ExceptT LeiosTestTxRejected Identity a
forall e (m :: * -> *) a. MonadError e m => e -> m a
throwError LeiosTestTxRejected
LeiosTestTxRejected
  reapplyTx :: HasCallStack =>
LedgerCfg LedgerState LeiosTestBlock
-> SlotNo
-> Validated (GenTx LeiosTestBlock)
-> Ticked LedgerState LeiosTestBlock ValuesMK
-> Except
     (ApplyTxErr LeiosTestBlock)
     (Ticked LedgerState LeiosTestBlock ValuesMK)
reapplyTx LedgerCfg LedgerState LeiosTestBlock
_cfg SlotNo
_slot Validated (GenTx LeiosTestBlock)
_tx Ticked LedgerState LeiosTestBlock ValuesMK
_st = LeiosTestTxRejected
-> ExceptT
     LeiosTestTxRejected
     Identity
     (Ticked LedgerState LeiosTestBlock ValuesMK)
forall a.
LeiosTestTxRejected -> ExceptT LeiosTestTxRejected Identity a
forall e (m :: * -> *) a. MonadError e m => e -> m a
throwError LeiosTestTxRejected
LeiosTestTxRejected
  txForgetValidated :: Validated (GenTx LeiosTestBlock) -> GenTx LeiosTestBlock
txForgetValidated = Validated (GenTx LeiosTestBlock) -> GenTx LeiosTestBlock
forgetValidatedLeiosTestGenTx
  getTransactionKeySets :: GenTx LeiosTestBlock -> LedgerTables LeiosTestBlock KeysMK
getTransactionKeySets GenTx LeiosTestBlock
_tx = LedgerTables LeiosTestBlock KeysMK
forall (mk :: MapKind) blk.
(ZeroableMK mk, LedgerTableConstraints blk) =>
LedgerTables blk mk
emptyLedgerTables
  mkMempoolApplyTxError :: forall (mk :: MapKind).
TickedLedgerState LeiosTestBlock mk
-> Text -> Maybe (ApplyTxErr LeiosTestBlock)
mkMempoolApplyTxError = TickedLedgerState LeiosTestBlock mk
-> Text -> Maybe (ApplyTxErr LeiosTestBlock)
forall blk (mk :: MapKind).
TickedLedgerState blk mk -> Text -> Maybe (ApplyTxErr blk)
nothingMkMempoolApplyTxError

instance TxLimits LeiosTestBlock where
  type TxMeasurePhase1 LeiosTestBlock = IgnoringOverflow ByteSize32
  type TxMeasurePhase2 LeiosTestBlock = TrivialTxMeasurePhase2
  txWireSize :: GenTx LeiosTestBlock -> SizeInBytes
txWireSize = SizeInBytes -> GenTx LeiosTestBlock -> SizeInBytes
forall a b. a -> b -> a
const SizeInBytes
0
  blockCapacityTxMeasure :: forall (mk :: MapKind).
LedgerCfg LedgerState LeiosTestBlock
-> TickedLedgerState LeiosTestBlock mk -> TxMeasure LeiosTestBlock
blockCapacityTxMeasure LedgerCfg LedgerState LeiosTestBlock
_cfg TickedLedgerState LeiosTestBlock mk
_st =
    TxMeasurePhase1 LeiosTestBlock
-> TxMeasurePhase2 LeiosTestBlock -> TxMeasure LeiosTestBlock
forall blk.
TxMeasurePhase1 blk -> TxMeasurePhase2 blk -> TxMeasure blk
TxMeasure (ByteSize32 -> IgnoringOverflow ByteSize32
forall a. a -> IgnoringOverflow a
IgnoringOverflow (Word32 -> ByteSize32
ByteSize32 (Word32
100 Word32 -> Word32 -> Word32
forall a. Num a => a -> a -> a
* Word32
1024))) TrivialTxMeasurePhase2
TxMeasurePhase2 LeiosTestBlock
TrivialTxMeasurePhase2
  txMeasurePhase1 :: LedgerCfg LedgerState LeiosTestBlock
-> Ticked LedgerState LeiosTestBlock EmptyMK
-> GenTx LeiosTestBlock
-> Except
     (ApplyTxErr LeiosTestBlock) (TxMeasurePhase1 LeiosTestBlock)
txMeasurePhase1 LedgerCfg LedgerState LeiosTestBlock
_cfg Ticked LedgerState LeiosTestBlock EmptyMK
_st GenTx LeiosTestBlock
_tx = IgnoringOverflow ByteSize32
-> ExceptT
     (ApplyTxErr LeiosTestBlock) Identity (IgnoringOverflow ByteSize32)
forall a. a -> ExceptT (ApplyTxErr LeiosTestBlock) Identity a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (IgnoringOverflow ByteSize32
 -> ExceptT
      (ApplyTxErr LeiosTestBlock) Identity (IgnoringOverflow ByteSize32))
-> IgnoringOverflow ByteSize32
-> ExceptT
     (ApplyTxErr LeiosTestBlock) Identity (IgnoringOverflow ByteSize32)
forall a b. (a -> b) -> a -> b
$ ByteSize32 -> IgnoringOverflow ByteSize32
forall a. a -> IgnoringOverflow a
IgnoringOverflow (ByteSize32 -> IgnoringOverflow ByteSize32)
-> ByteSize32 -> IgnoringOverflow ByteSize32
forall a b. (a -> b) -> a -> b
$ Word32 -> ByteSize32
ByteSize32 Word32
0
  txMeasurePhase2 :: LedgerCfg LedgerState LeiosTestBlock
-> Ticked LedgerState LeiosTestBlock ValuesMK
-> GenTx LeiosTestBlock
-> Except
     (ApplyTxErr LeiosTestBlock) (TxMeasurePhase2 LeiosTestBlock)
txMeasurePhase2 LedgerCfg LedgerState LeiosTestBlock
_cfg Ticked LedgerState LeiosTestBlock ValuesMK
_st GenTx LeiosTestBlock
_tx = TrivialTxMeasurePhase2
-> ExceptT LeiosTestTxRejected Identity TrivialTxMeasurePhase2
forall a. a -> ExceptT LeiosTestTxRejected Identity a
forall (f :: * -> *) a. Applicative f => a -> f a
pure TrivialTxMeasurePhase2
TrivialTxMeasurePhase2
  type TxEbMeasure LeiosTestBlock = TxMeasure LeiosTestBlock
  txEbMeasure :: forall (proxy :: * -> *).
proxy LeiosTestBlock
-> TxMeasure LeiosTestBlock -> TxEbMeasure LeiosTestBlock
txEbMeasure proxy LeiosTestBlock
_ = TxMeasure LeiosTestBlock -> TxEbMeasure LeiosTestBlock
TxMeasure LeiosTestBlock -> TxMeasure LeiosTestBlock
forall a. a -> a
id
  ebCapacityTxMeasure :: forall (mk :: MapKind).
LedgerCfg LedgerState LeiosTestBlock
-> TickedLedgerState LeiosTestBlock mk
-> TxEbMeasure LeiosTestBlock
ebCapacityTxMeasure LedgerCfg LedgerState LeiosTestBlock
_cfg TickedLedgerState LeiosTestBlock mk
_st = TxEbMeasure LeiosTestBlock
TxMeasure LeiosTestBlock
forall a. Measure a => a
Measure.zero
  mempoolEbReservation :: forall (proxy :: * -> *).
proxy LeiosTestBlock
-> TxEbMeasure LeiosTestBlock -> TxMeasure LeiosTestBlock
mempoolEbReservation proxy LeiosTestBlock
_ = TxEbMeasure LeiosTestBlock -> TxMeasure LeiosTestBlock
TxMeasure LeiosTestBlock -> TxMeasure LeiosTestBlock
forall a. a -> a
id

{-------------------------------------------------------------------------------
  Queries

  No test asks the node anything, so there are no queries.
-------------------------------------------------------------------------------}

data instance BlockQuery LeiosTestBlock fp result
  deriving stock Int -> BlockQuery LeiosTestBlock fp result -> ShowS
[BlockQuery LeiosTestBlock fp result] -> ShowS
BlockQuery LeiosTestBlock fp result -> String
(Int -> BlockQuery LeiosTestBlock fp result -> ShowS)
-> (BlockQuery LeiosTestBlock fp result -> String)
-> ([BlockQuery LeiosTestBlock fp result] -> ShowS)
-> Show (BlockQuery LeiosTestBlock fp result)
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
forall (fp :: QueryFootprint) result.
Int -> BlockQuery LeiosTestBlock fp result -> ShowS
forall (fp :: QueryFootprint) result.
[BlockQuery LeiosTestBlock fp result] -> ShowS
forall (fp :: QueryFootprint) result.
BlockQuery LeiosTestBlock fp result -> String
$cshowsPrec :: forall (fp :: QueryFootprint) result.
Int -> BlockQuery LeiosTestBlock fp result -> ShowS
showsPrec :: Int -> BlockQuery LeiosTestBlock fp result -> ShowS
$cshow :: forall (fp :: QueryFootprint) result.
BlockQuery LeiosTestBlock fp result -> String
show :: BlockQuery LeiosTestBlock fp result -> String
$cshowList :: forall (fp :: QueryFootprint) result.
[BlockQuery LeiosTestBlock fp result] -> ShowS
showList :: [BlockQuery LeiosTestBlock fp result] -> ShowS
Show

instance ShowProxy (BlockQuery LeiosTestBlock)

instance ShowQuery (BlockQuery LeiosTestBlock fp) where
  showResult :: forall result.
BlockQuery LeiosTestBlock fp result -> result -> String
showResult = \case {}

instance BlockSupportsLedgerQuery LeiosTestBlock where
  answerPureBlockQuery :: forall result.
ExtLedgerCfg LeiosTestBlock
-> BlockQuery LeiosTestBlock 'QFNoTables result
-> ExtLedgerState LeiosTestBlock EmptyMK
-> result
answerPureBlockQuery ExtLedgerCfg LeiosTestBlock
_ = \case {}
  answerBlockQueryLookup :: forall (m :: * -> *) result.
MonadSTM m =>
ExtLedgerCfg LeiosTestBlock
-> BlockQuery LeiosTestBlock 'QFLookupTables result
-> ReadOnlyForker' m LeiosTestBlock
-> m result
answerBlockQueryLookup ExtLedgerCfg LeiosTestBlock
_ = \case {}
  answerBlockQueryTraverse :: forall (m :: * -> *) result.
MonadSTM m =>
ExtLedgerCfg LeiosTestBlock
-> BlockQuery LeiosTestBlock 'QFTraverseTables result
-> ReadOnlyForker' m LeiosTestBlock
-> m result
answerBlockQueryTraverse ExtLedgerCfg LeiosTestBlock
_ = \case {}
  blockQueryIsSupportedOnVersion :: forall (fp :: QueryFootprint) result.
BlockQuery LeiosTestBlock fp result
-> BlockNodeToClientVersion LeiosTestBlock -> Bool
blockQueryIsSupportedOnVersion = \case {}

instance SameDepIndex2 (BlockQuery LeiosTestBlock) where
  sameDepIndex2 :: forall (x :: QueryFootprint) a (y :: QueryFootprint) b.
BlockQuery LeiosTestBlock x a
-> BlockQuery LeiosTestBlock y b -> Maybe ('(x, a) :~: '(y, b))
sameDepIndex2 = \case {}

{-------------------------------------------------------------------------------
  The rest of what a node insists on
-------------------------------------------------------------------------------}

instance CommonProtocolParams LeiosTestBlock where
  maxHeaderSize :: forall (mk :: MapKind). LedgerState LeiosTestBlock mk -> Word32
maxHeaderSize LedgerState LeiosTestBlock mk
_ = Word32
forall a. Bounded a => a
maxBound
  maxTxSize :: forall (mk :: MapKind). LedgerState LeiosTestBlock mk -> Word32
maxTxSize LedgerState LeiosTestBlock mk
_ = Word32
forall a. Bounded a => a
maxBound

instance LedgerSupportsPeerSelection LeiosTestBlock where
  getPeers :: forall (mk :: MapKind).
LedgerState LeiosTestBlock mk
-> [(PoolStake, NonEmpty StakePoolRelay)]
getPeers = [(PoolStake, NonEmpty StakePoolRelay)]
-> LedgerState LeiosTestBlock mk
-> [(PoolStake, NonEmpty StakePoolRelay)]
forall a b. a -> b -> a
const []

instance NodeInitStorage LeiosTestBlock where
  nodeCheckIntegrity :: StorageConfig LeiosTestBlock -> LeiosTestBlock -> Bool
nodeCheckIntegrity StorageConfig LeiosTestBlock
_ LeiosTestBlock
_ = Bool
True

  -- Only how the ImmutableDB splits its blocks into files depends on this, so
  -- any positive size works. Cardano's is 10k slots, Byron's epoch size, never
  -- changed since; this one is small, so that a short test chain still spans
  -- several chunks.
  nodeImmutableDbChunkInfo :: StorageConfig LeiosTestBlock -> ChunkInfo
nodeImmutableDbChunkInfo StorageConfig LeiosTestBlock
_ = EpochSize -> ChunkInfo
simpleChunkInfo (Word64 -> EpochSize
EpochSize Word64
10)

instance BlockSupportsMetrics LeiosTestBlock where
  isSelfIssued :: BlockConfig LeiosTestBlock
-> Header LeiosTestBlock -> WhetherSelfIssued
isSelfIssued = BlockConfig LeiosTestBlock
-> Header LeiosTestBlock -> WhetherSelfIssued
forall blk. BlockConfig blk -> Header blk -> WhetherSelfIssued
isSelfIssuedConstUnknown

instance BlockSupportsSanityCheck LeiosTestBlock where
  configAllSecurityParams :: TopLevelConfig LeiosTestBlock -> NonEmpty SecurityParam
configAllSecurityParams = SecurityParam -> NonEmpty SecurityParam
forall a. a -> NonEmpty a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (SecurityParam -> NonEmpty SecurityParam)
-> (TopLevelConfig LeiosTestBlock -> SecurityParam)
-> TopLevelConfig LeiosTestBlock
-> NonEmpty SecurityParam
forall b c a. (b -> c) -> (a -> b) -> a -> c
. TopLevelConfig LeiosTestBlock -> SecurityParam
forall blk.
ConsensusProtocol (BlockProtocol blk) =>
TopLevelConfig blk -> SecurityParam
configSecurityParam

instance SupportedNetworkProtocolVersion LeiosTestBlock where
  supportedNodeToNodeVersions :: Proxy LeiosTestBlock
-> Map NodeToNodeVersion (BlockNodeToNodeVersion LeiosTestBlock)
supportedNodeToNodeVersions Proxy LeiosTestBlock
_ =
    NodeToNodeVersion -> () -> Map NodeToNodeVersion ()
forall k a. k -> a -> Map k a
Map.singleton NodeToNodeVersion
forall a. Bounded a => a
maxBound ()
  supportedNodeToClientVersions :: Proxy LeiosTestBlock
-> Map
     NodeToClientVersion (BlockNodeToClientVersion LeiosTestBlock)
supportedNodeToClientVersions Proxy LeiosTestBlock
_ =
    NodeToClientVersion -> () -> Map NodeToClientVersion ()
forall k a. k -> a -> Map k a
Map.singleton NodeToClientVersion
forall a. Bounded a => a
maxBound ()
  latestReleasedNodeVersion :: Proxy LeiosTestBlock
-> (Maybe NodeToNodeVersion, Maybe NodeToClientVersion)
latestReleasedNodeVersion = Proxy LeiosTestBlock
-> (Maybe NodeToNodeVersion, Maybe NodeToClientVersion)
forall blk.
SupportedNetworkProtocolVersion blk =>
Proxy blk -> (Maybe NodeToNodeVersion, Maybe NodeToClientVersion)
latestReleasedNodeVersionDefault

{-------------------------------------------------------------------------------
  Node-to-node and node-to-client serialisation

  Everything rides on the same 'Serialise' instances the on-disk format uses.
-------------------------------------------------------------------------------}

instance SerialiseNodeToNode LeiosTestBlock LeiosTestBlock
instance SerialiseNodeToNode LeiosTestBlock (Header LeiosTestBlock)
instance SerialiseNodeToNode LeiosTestBlock (Serialised LeiosTestBlock)
instance SerialiseNodeToNode LeiosTestBlock (SerialisedHeader LeiosTestBlock) where
  encodeNodeToNode :: CodecConfig LeiosTestBlock
-> BlockNodeToNodeVersion LeiosTestBlock
-> SerialisedHeader LeiosTestBlock
-> Encoding
encodeNodeToNode CodecConfig LeiosTestBlock
_ BlockNodeToNodeVersion LeiosTestBlock
_ = SerialisedHeader LeiosTestBlock -> Encoding
forall blk.
TrivialDependency (NestedCtxt_ blk Header) =>
SerialisedHeader blk -> Encoding
encodeTrivialSerialisedHeader
  decodeNodeToNode :: CodecConfig LeiosTestBlock
-> BlockNodeToNodeVersion LeiosTestBlock
-> forall s. Decoder s (SerialisedHeader LeiosTestBlock)
decodeNodeToNode CodecConfig LeiosTestBlock
_ BlockNodeToNodeVersion LeiosTestBlock
_ = Decoder s (SerialisedHeader LeiosTestBlock)
forall s. Decoder s (SerialisedHeader LeiosTestBlock)
forall blk s.
TrivialDependency (NestedCtxt_ blk Header) =>
Decoder s (SerialisedHeader blk)
decodeTrivialSerialisedHeader
instance SerialiseNodeToNode LeiosTestBlock (GenTx LeiosTestBlock)
instance SerialiseNodeToNode LeiosTestBlock (GenTxId LeiosTestBlock)

instance SerialiseNodeToNodeConstraints LeiosTestBlock where
  -- A block is just its header.
  estimateBlockSize :: Header LeiosTestBlock -> SizeInBytes
estimateBlockSize = Int64 -> SizeInBytes
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int64 -> SizeInBytes)
-> (Header LeiosTestBlock -> Int64)
-> Header LeiosTestBlock
-> SizeInBytes
forall b c a. (b -> c) -> (a -> b) -> a -> c
. LazyByteString -> Int64
BL.length (LazyByteString -> Int64)
-> (Header LeiosTestBlock -> LazyByteString)
-> Header LeiosTestBlock
-> Int64
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Header LeiosTestBlock -> LazyByteString
forall a. Serialise a => a -> LazyByteString
serialise

instance SerialiseNodeToClient LeiosTestBlock LeiosTestBlock
instance SerialiseNodeToClient LeiosTestBlock (Serialised LeiosTestBlock)
instance SerialiseNodeToClient LeiosTestBlock (GenTx LeiosTestBlock)
instance SerialiseNodeToClient LeiosTestBlock (GenTxId LeiosTestBlock)
instance SerialiseNodeToClient LeiosTestBlock SlotNo
instance SerialiseNodeToClient LeiosTestBlock LeiosTestTxRejected
instance SerialiseNodeToClient LeiosTestBlock LeiosTestLedgerConfig

instance SerialiseNodeToClient LeiosTestBlock (SomeBlockQuery (BlockQuery LeiosTestBlock)) where
  encodeNodeToClient :: CodecConfig LeiosTestBlock
-> BlockNodeToClientVersion LeiosTestBlock
-> SomeBlockQuery (BlockQuery LeiosTestBlock)
-> Encoding
encodeNodeToClient CodecConfig LeiosTestBlock
_ BlockNodeToClientVersion LeiosTestBlock
_ = \case {}
  decodeNodeToClient :: CodecConfig LeiosTestBlock
-> BlockNodeToClientVersion LeiosTestBlock
-> forall s. Decoder s (SomeBlockQuery (BlockQuery LeiosTestBlock))
decodeNodeToClient CodecConfig LeiosTestBlock
_ BlockNodeToClientVersion LeiosTestBlock
_ = String -> Decoder s (SomeBlockQuery (BlockQuery LeiosTestBlock))
forall a. HasCallStack => String -> Decoder s a
forall (m :: * -> *) a.
(MonadFail m, HasCallStack) =>
String -> m a
fail String
"LeiosTestBlock: no queries"

instance SerialiseBlockQueryResult LeiosTestBlock BlockQuery where
  encodeBlockQueryResult :: forall (fp :: QueryFootprint) result.
CodecConfig LeiosTestBlock
-> BlockNodeToClientVersion LeiosTestBlock
-> BlockQuery LeiosTestBlock fp result
-> result
-> Encoding
encodeBlockQueryResult CodecConfig LeiosTestBlock
_ BlockNodeToClientVersion LeiosTestBlock
_ = \case {}
  decodeBlockQueryResult :: forall (fp :: QueryFootprint) result.
CodecConfig LeiosTestBlock
-> BlockNodeToClientVersion LeiosTestBlock
-> BlockQuery LeiosTestBlock fp result
-> forall s. Decoder s result
decodeBlockQueryResult CodecConfig LeiosTestBlock
_ BlockNodeToClientVersion LeiosTestBlock
_ = \case {}

instance SerialiseNodeToClientConstraints LeiosTestBlock

instance RunNode LeiosTestBlock

-- | The node under test has no credentials, so it never forges; these exist
-- only because 'RunNode' asks for them.
type instance CannotForge LeiosTestBlock = Void

type instance ForgeStateInfo LeiosTestBlock = ()
type instance ForgeStateUpdateError LeiosTestBlock = Void

instance HasRawTxId (TxId (GenTx LeiosTestBlock)) where
  type RawTxId (TxId (GenTx LeiosTestBlock)) = Word64
  getRawTxId :: TxId (GenTx LeiosTestBlock)
-> RawTxId (TxId (GenTx LeiosTestBlock))
getRawTxId (LeiosTestTxId Word64
w) = Word64
RawTxId (TxId (GenTx LeiosTestBlock))
w