{-# LANGUAGE DisambiguateRecordFields #-}
{-# LANGUAGE OverloadedStrings #-}
{-# OPTIONS_GHC -Wno-incomplete-uni-patterns #-}
module Test.Consensus.Byron.Examples (
cfg
, codecConfig
, leaderCredentials
, ledgerConfig
, secParam
, windowSize
, exampleApplyTxErr
, exampleChainDepState
, exampleExtLedgerState
, exampleGenTx
, exampleGenTxId
, exampleHeaderHash
, exampleHeaderState
, exampleLedgerState
, examples
) where
import qualified Cardano.Chain.Block as CC.Block
import qualified Cardano.Chain.Byron.API as CC
import qualified Cardano.Chain.Common as CC
import qualified Cardano.Chain.Update.Validation.Interface as CC.UPI
import qualified Cardano.Chain.UTxO as CC
import Control.Monad.Except (runExcept)
import qualified Data.Map.Strict as Map
import Ouroboros.Consensus.Block
import Ouroboros.Consensus.Byron.Crypto.DSIGN (SignKeyDSIGN (..))
import Ouroboros.Consensus.Byron.Ledger
import Ouroboros.Consensus.Byron.Node (ByronLeaderCredentials (..))
import Ouroboros.Consensus.Config
import Ouroboros.Consensus.HeaderValidation
import Ouroboros.Consensus.Ledger.Abstract
import Ouroboros.Consensus.Ledger.Extended
import Ouroboros.Consensus.NodeId
import Ouroboros.Consensus.Protocol.Abstract
import Ouroboros.Consensus.Protocol.PBFT
import qualified Ouroboros.Consensus.Protocol.PBFT.State as S
import Ouroboros.Consensus.Storage.Serialisation
import Ouroboros.Network.Block (Serialised (..))
import qualified Test.Cardano.Chain.Common.Example as CC
import qualified Test.Cardano.Chain.Genesis.Dummy as CC
import qualified Test.Cardano.Chain.Update.Example as CC
import qualified Test.Cardano.Chain.UTxO.Example as CC
import Test.ThreadNet.Infra.Byron.ProtocolInfo (mkLeaderCredentials)
import qualified Test.Util.Serialisation.Examples as Examples
import Test.Util.Serialisation.Examples (Examples (Examples),
Labelled, labelled, unlabelled)
import Test.Util.Serialisation.SomeResult (SomeResult (..))
secParam :: SecurityParam
secParam :: SecurityParam
secParam = Word64 -> SecurityParam
SecurityParam Word64
2
windowSize :: S.WindowSize
windowSize :: WindowSize
windowSize = Word64 -> WindowSize
S.WindowSize Word64
2
cfg :: BlockConfig ByronBlock
cfg :: BlockConfig ByronBlock
cfg = ByronConfig {
byronGenesisConfig :: Config
byronGenesisConfig = Config
CC.dummyConfig
, byronProtocolVersion :: ProtocolVersion
byronProtocolVersion = ProtocolVersion
CC.exampleProtocolVersion
, byronSoftwareVersion :: SoftwareVersion
byronSoftwareVersion = SoftwareVersion
CC.exampleSoftwareVersion
}
codecConfig :: CodecConfig ByronBlock
codecConfig :: CodecConfig ByronBlock
codecConfig = Config -> CodecConfig ByronBlock
mkByronCodecConfig Config
CC.dummyConfig
ledgerConfig :: LedgerConfig ByronBlock
ledgerConfig :: LedgerConfig ByronBlock
ledgerConfig = Config
LedgerConfig ByronBlock
CC.dummyConfig
leaderCredentials :: ByronLeaderCredentials
leaderCredentials :: ByronLeaderCredentials
leaderCredentials =
HasCallStack =>
Config -> GeneratedSecrets -> CoreNodeId -> ByronLeaderCredentials
Config -> GeneratedSecrets -> CoreNodeId -> ByronLeaderCredentials
mkLeaderCredentials
Config
CC.dummyConfig
GeneratedSecrets
CC.dummyGeneratedSecrets
(Word64 -> CoreNodeId
CoreNodeId Word64
0)
examples :: Examples ByronBlock
examples :: Examples ByronBlock
examples = Examples {
exampleBlock :: Labelled ByronBlock
exampleBlock = ByronBlock -> ByronBlock -> Labelled ByronBlock
forall a. a -> a -> Labelled a
regularAndEBB ByronBlock
exampleBlock ByronBlock
exampleEBB
, exampleSerialisedBlock :: Labelled (Serialised ByronBlock)
exampleSerialisedBlock = Serialised ByronBlock
-> Serialised ByronBlock -> Labelled (Serialised ByronBlock)
forall a. a -> a -> Labelled a
regularAndEBB Serialised ByronBlock
exampleSerialisedBlock Serialised ByronBlock
exampleSerialisedEBB
, exampleHeader :: Labelled (Header ByronBlock)
exampleHeader = Header ByronBlock
-> Header ByronBlock -> Labelled (Header ByronBlock)
forall a. a -> a -> Labelled a
regularAndEBB Header ByronBlock
exampleHeader Header ByronBlock
exampleEBBHeader
, exampleSerialisedHeader :: Labelled (SerialisedHeader ByronBlock)
exampleSerialisedHeader = SerialisedHeader ByronBlock
-> SerialisedHeader ByronBlock
-> Labelled (SerialisedHeader ByronBlock)
forall a. a -> a -> Labelled a
regularAndEBB SerialisedHeader ByronBlock
exampleSerialisedHeader SerialisedHeader ByronBlock
exampleSerialisedEBBHeader
, exampleHeaderHash :: Labelled (HeaderHash ByronBlock)
exampleHeaderHash = ByronHash -> Labelled ByronHash
forall a. a -> Labelled a
unlabelled ByronHash
exampleHeaderHash
, exampleGenTx :: Labelled (GenTx ByronBlock)
exampleGenTx = GenTx ByronBlock -> Labelled (GenTx ByronBlock)
forall a. a -> Labelled a
unlabelled GenTx ByronBlock
exampleGenTx
, exampleGenTxId :: Labelled (GenTxId ByronBlock)
exampleGenTxId = GenTxId ByronBlock -> Labelled (GenTxId ByronBlock)
forall a. a -> Labelled a
unlabelled GenTxId ByronBlock
exampleGenTxId
, exampleApplyTxErr :: Labelled (ApplyTxErr ByronBlock)
exampleApplyTxErr = ApplyMempoolPayloadErr -> Labelled ApplyMempoolPayloadErr
forall a. a -> Labelled a
unlabelled ApplyMempoolPayloadErr
exampleApplyTxErr
, exampleQuery :: Labelled (SomeSecond BlockQuery ByronBlock)
exampleQuery = SomeSecond BlockQuery ByronBlock
-> Labelled (SomeSecond BlockQuery ByronBlock)
forall a. a -> Labelled a
unlabelled SomeSecond BlockQuery ByronBlock
exampleQuery
, exampleResult :: Labelled (SomeResult ByronBlock)
exampleResult = SomeResult ByronBlock -> Labelled (SomeResult ByronBlock)
forall a. a -> Labelled a
unlabelled SomeResult ByronBlock
exampleResult
, exampleAnnTip :: Labelled (AnnTip ByronBlock)
exampleAnnTip = AnnTip ByronBlock -> Labelled (AnnTip ByronBlock)
forall a. a -> Labelled a
unlabelled AnnTip ByronBlock
exampleAnnTip
, exampleLedgerState :: Labelled (LedgerState ByronBlock)
exampleLedgerState = LedgerState ByronBlock -> Labelled (LedgerState ByronBlock)
forall a. a -> Labelled a
unlabelled LedgerState ByronBlock
exampleLedgerState
, exampleChainDepState :: Labelled (ChainDepState (BlockProtocol ByronBlock))
exampleChainDepState = PBftState PBftByronCrypto -> Labelled (PBftState PBftByronCrypto)
forall a. a -> Labelled a
unlabelled ChainDepState (BlockProtocol ByronBlock)
PBftState PBftByronCrypto
exampleChainDepState
, exampleExtLedgerState :: Labelled (ExtLedgerState ByronBlock)
exampleExtLedgerState = ExtLedgerState ByronBlock -> Labelled (ExtLedgerState ByronBlock)
forall a. a -> Labelled a
unlabelled ExtLedgerState ByronBlock
exampleExtLedgerState
, exampleSlotNo :: Labelled SlotNo
exampleSlotNo = SlotNo -> Labelled SlotNo
forall a. a -> Labelled a
unlabelled SlotNo
exampleSlotNo
}
where
regularAndEBB :: a -> a -> Labelled a
regularAndEBB :: forall a. a -> a -> Labelled a
regularAndEBB a
regular a
ebb = [(String, a)] -> Labelled a
forall a. [(String, a)] -> Labelled a
labelled [(String
"regular", a
regular), (String
"EBB", a
ebb)]
exampleQuery :: SomeSecond BlockQuery ByronBlock
exampleQuery = BlockQuery ByronBlock State -> SomeSecond BlockQuery ByronBlock
forall {k1} {k2} (f :: k1 -> k2 -> *) (a :: k1) (b :: k2).
f a b -> SomeSecond f a
SomeSecond BlockQuery ByronBlock State
GetUpdateInterfaceState
exampleResult :: SomeResult ByronBlock
exampleResult = BlockQuery ByronBlock State -> State -> SomeResult ByronBlock
forall result blk.
(Eq result, Show result, Typeable result) =>
BlockQuery blk result -> result -> SomeResult blk
SomeResult BlockQuery ByronBlock State
GetUpdateInterfaceState State
exampleUPIState
exampleBlock :: ByronBlock
exampleBlock :: ByronBlock
exampleBlock =
HasCallStack =>
BlockConfig ByronBlock
-> BlockNo
-> SlotNo
-> TickedLedgerState ByronBlock
-> [Validated (GenTx ByronBlock)]
-> PBftIsLeader PBftByronCrypto
-> ByronBlock
BlockConfig ByronBlock
-> BlockNo
-> SlotNo
-> TickedLedgerState ByronBlock
-> [Validated (GenTx ByronBlock)]
-> PBftIsLeader PBftByronCrypto
-> ByronBlock
forgeRegularBlock
BlockConfig ByronBlock
cfg
(Word64 -> BlockNo
BlockNo Word64
1)
(Word64 -> SlotNo
SlotNo Word64
1)
(LedgerConfig ByronBlock
-> SlotNo -> LedgerState ByronBlock -> TickedLedgerState ByronBlock
forall l. IsLedger l => LedgerCfg l -> SlotNo -> l -> Ticked l
applyChainTick LedgerConfig ByronBlock
ledgerConfig (Word64 -> SlotNo
SlotNo Word64
1) LedgerState ByronBlock
ledgerStateAfterEBB)
[GenTx ByronBlock -> Validated (GenTx ByronBlock)
ValidatedByronTx GenTx ByronBlock
exampleGenTx]
(ByronLeaderCredentials -> PBftIsLeader PBftByronCrypto
fakeMkIsLeader ByronLeaderCredentials
leaderCredentials)
where
fakeMkIsLeader :: ByronLeaderCredentials -> PBftIsLeader PBftByronCrypto
fakeMkIsLeader (ByronLeaderCredentials SigningKey
signKey Certificate
dlgCert CoreNodeId
_ Text
_) = PBftIsLeader {
pbftIsLeaderSignKey :: SignKeyDSIGN (PBftDSIGN PBftByronCrypto)
pbftIsLeaderSignKey = SigningKey -> SignKeyDSIGN ByronDSIGN
SignKeyByronDSIGN SigningKey
signKey
, pbftIsLeaderDlgCert :: PBftDelegationCert PBftByronCrypto
pbftIsLeaderDlgCert = Certificate
PBftDelegationCert PBftByronCrypto
dlgCert
}
exampleEBB :: ByronBlock
exampleEBB :: ByronBlock
exampleEBB = BlockConfig ByronBlock
-> SlotNo -> BlockNo -> ChainHash ByronBlock -> ByronBlock
forgeEBB BlockConfig ByronBlock
cfg (Word64 -> SlotNo
SlotNo Word64
0) (Word64 -> BlockNo
BlockNo Word64
0) ChainHash ByronBlock
forall {k} (b :: k). ChainHash b
GenesisHash
exampleSerialisedBlock :: Serialised ByronBlock
exampleSerialisedBlock :: Serialised ByronBlock
exampleSerialisedBlock = ByteString -> Serialised ByronBlock
forall {k} (a :: k). ByteString -> Serialised a
Serialised ByteString
"<BLOCK>"
exampleSerialisedEBB :: Serialised ByronBlock
exampleSerialisedEBB :: Serialised ByronBlock
exampleSerialisedEBB = ByteString -> Serialised ByronBlock
forall {k} (a :: k). ByteString -> Serialised a
Serialised ByteString
"<EBB>"
exampleHeader :: Header ByronBlock
= ByronBlock -> Header ByronBlock
forall blk. GetHeader blk => blk -> Header blk
getHeader ByronBlock
exampleBlock
exampleEBBHeader :: Header ByronBlock
= ByronBlock -> Header ByronBlock
forall blk. GetHeader blk => blk -> Header blk
getHeader ByronBlock
exampleEBB
exampleSerialisedHeader :: SerialisedHeader ByronBlock
= GenDepPair Serialised (NestedCtxt Header ByronBlock)
-> SerialisedHeader ByronBlock
forall blk.
GenDepPair Serialised (NestedCtxt Header blk)
-> SerialisedHeader blk
SerialisedHeaderFromDepPair (GenDepPair Serialised (NestedCtxt Header ByronBlock)
-> SerialisedHeader ByronBlock)
-> GenDepPair Serialised (NestedCtxt Header ByronBlock)
-> SerialisedHeader ByronBlock
forall a b. (a -> b) -> a -> b
$
NestedCtxt Header ByronBlock (AHeader ByteString)
-> Serialised (AHeader ByteString)
-> GenDepPair Serialised (NestedCtxt Header ByronBlock)
forall (f :: * -> *) a (g :: * -> *). f a -> g a -> GenDepPair g f
GenDepPair (NestedCtxt_ ByronBlock Header (AHeader ByteString)
-> NestedCtxt Header ByronBlock (AHeader ByteString)
forall (f :: * -> *) blk a.
NestedCtxt_ blk f a -> NestedCtxt f blk a
NestedCtxt (SizeInBytes -> NestedCtxt_ ByronBlock Header (AHeader ByteString)
CtxtByronRegular SizeInBytes
100)) (ByteString -> Serialised (AHeader ByteString)
forall {k} (a :: k). ByteString -> Serialised a
Serialised ByteString
"<HEADER>")
exampleSerialisedEBBHeader :: SerialisedHeader ByronBlock
= GenDepPair Serialised (NestedCtxt Header ByronBlock)
-> SerialisedHeader ByronBlock
forall blk.
GenDepPair Serialised (NestedCtxt Header blk)
-> SerialisedHeader blk
SerialisedHeaderFromDepPair (GenDepPair Serialised (NestedCtxt Header ByronBlock)
-> SerialisedHeader ByronBlock)
-> GenDepPair Serialised (NestedCtxt Header ByronBlock)
-> SerialisedHeader ByronBlock
forall a b. (a -> b) -> a -> b
$
NestedCtxt Header ByronBlock (SlotNo, RawBoundaryHeader)
-> Serialised (SlotNo, RawBoundaryHeader)
-> GenDepPair Serialised (NestedCtxt Header ByronBlock)
forall (f :: * -> *) a (g :: * -> *). f a -> g a -> GenDepPair g f
GenDepPair (NestedCtxt_ ByronBlock Header (SlotNo, RawBoundaryHeader)
-> NestedCtxt Header ByronBlock (SlotNo, RawBoundaryHeader)
forall (f :: * -> *) blk a.
NestedCtxt_ blk f a -> NestedCtxt f blk a
NestedCtxt (SizeInBytes
-> NestedCtxt_ ByronBlock Header (SlotNo, RawBoundaryHeader)
CtxtByronBoundary SizeInBytes
100)) (ByteString -> Serialised (SlotNo, RawBoundaryHeader)
forall {k} (a :: k). ByteString -> Serialised a
Serialised ByteString
"<EBB_HEADER>")
exampleAnnTip :: AnnTip ByronBlock
exampleAnnTip :: AnnTip ByronBlock
exampleAnnTip = AnnTip {
annTipSlotNo :: SlotNo
annTipSlotNo = Word64 -> SlotNo
SlotNo Word64
37
, annTipBlockNo :: BlockNo
annTipBlockNo = Word64 -> BlockNo
BlockNo Word64
23
, annTipInfo :: TipInfo ByronBlock
annTipInfo = HeaderHash ByronBlock -> IsEBB -> TipInfoIsEBB ByronBlock
forall blk. HeaderHash blk -> IsEBB -> TipInfoIsEBB blk
TipInfoIsEBB HeaderHash ByronBlock
ByronHash
exampleHeaderHash IsEBB
IsNotEBB
}
exampleChainDepState :: ChainDepState (BlockProtocol ByronBlock)
exampleChainDepState :: ChainDepState (BlockProtocol ByronBlock)
exampleChainDepState = [PBftSigner PBftByronCrypto] -> PBftState PBftByronCrypto
forall c. PBftCrypto c => [PBftSigner c] -> PBftState c
S.fromList [PBftSigner PBftByronCrypto]
signers
where
signers :: [PBftSigner PBftByronCrypto]
signers = (SlotNo -> PBftSigner PBftByronCrypto)
-> [SlotNo] -> [PBftSigner PBftByronCrypto]
forall a b. (a -> b) -> [a] -> [b]
map (SlotNo
-> PBftVerKeyHash PBftByronCrypto -> PBftSigner PBftByronCrypto
forall c. SlotNo -> PBftVerKeyHash c -> PBftSigner c
`S.PBftSigner` KeyHash
PBftVerKeyHash PBftByronCrypto
CC.exampleKeyHash) [SlotNo
1..SlotNo
4]
emptyLedgerState :: LedgerState ByronBlock
emptyLedgerState :: LedgerState ByronBlock
emptyLedgerState = ByronLedgerState {
byronLedgerTipBlockNo :: WithOrigin BlockNo
byronLedgerTipBlockNo = WithOrigin BlockNo
forall t. WithOrigin t
Origin
, byronLedgerState :: ChainValidationState
byronLedgerState = ChainValidationState
initState
, byronLedgerTransition :: ByronTransition
byronLedgerTransition = Map ProtocolVersion BlockNo -> ByronTransition
ByronTransitionInfo Map ProtocolVersion BlockNo
forall k a. Map k a
Map.empty
}
where
initState :: CC.Block.ChainValidationState
Right ChainValidationState
initState = Except Error ChainValidationState
-> Either Error ChainValidationState
forall e a. Except e a -> Either e a
runExcept (Except Error ChainValidationState
-> Either Error ChainValidationState)
-> Except Error ChainValidationState
-> Either Error ChainValidationState
forall a b. (a -> b) -> a -> b
$
Config -> Except Error ChainValidationState
forall (m :: * -> *).
MonadError Error m =>
Config -> m ChainValidationState
CC.Block.initialChainValidationState Config
LedgerConfig ByronBlock
ledgerConfig
ledgerStateAfterEBB :: LedgerState ByronBlock
ledgerStateAfterEBB :: LedgerState ByronBlock
ledgerStateAfterEBB =
LedgerConfig ByronBlock
-> ByronBlock
-> TickedLedgerState ByronBlock
-> LedgerState ByronBlock
forall l blk.
(ApplyBlock l blk, HasCallStack) =>
LedgerCfg l -> blk -> Ticked l -> l
reapplyLedgerBlock LedgerConfig ByronBlock
ledgerConfig ByronBlock
exampleEBB
(TickedLedgerState ByronBlock -> LedgerState ByronBlock)
-> (LedgerState ByronBlock -> TickedLedgerState ByronBlock)
-> LedgerState ByronBlock
-> LedgerState ByronBlock
forall b c a. (b -> c) -> (a -> b) -> a -> c
. LedgerConfig ByronBlock
-> SlotNo -> LedgerState ByronBlock -> TickedLedgerState ByronBlock
forall l. IsLedger l => LedgerCfg l -> SlotNo -> l -> Ticked l
applyChainTick LedgerConfig ByronBlock
ledgerConfig (Word64 -> SlotNo
SlotNo Word64
0)
(LedgerState ByronBlock -> LedgerState ByronBlock)
-> LedgerState ByronBlock -> LedgerState ByronBlock
forall a b. (a -> b) -> a -> b
$ LedgerState ByronBlock
emptyLedgerState
exampleLedgerState :: LedgerState ByronBlock
exampleLedgerState :: LedgerState ByronBlock
exampleLedgerState =
LedgerConfig ByronBlock
-> ByronBlock
-> TickedLedgerState ByronBlock
-> LedgerState ByronBlock
forall l blk.
(ApplyBlock l blk, HasCallStack) =>
LedgerCfg l -> blk -> Ticked l -> l
reapplyLedgerBlock LedgerConfig ByronBlock
ledgerConfig ByronBlock
exampleBlock
(TickedLedgerState ByronBlock -> LedgerState ByronBlock)
-> (LedgerState ByronBlock -> TickedLedgerState ByronBlock)
-> LedgerState ByronBlock
-> LedgerState ByronBlock
forall b c a. (b -> c) -> (a -> b) -> a -> c
. LedgerConfig ByronBlock
-> SlotNo -> LedgerState ByronBlock -> TickedLedgerState ByronBlock
forall l. IsLedger l => LedgerCfg l -> SlotNo -> l -> Ticked l
applyChainTick LedgerConfig ByronBlock
ledgerConfig (Word64 -> SlotNo
SlotNo Word64
1)
(LedgerState ByronBlock -> LedgerState ByronBlock)
-> LedgerState ByronBlock -> LedgerState ByronBlock
forall a b. (a -> b) -> a -> b
$ LedgerState ByronBlock
ledgerStateAfterEBB
exampleHeaderState :: HeaderState ByronBlock
= WithOrigin (AnnTip ByronBlock)
-> ChainDepState (BlockProtocol ByronBlock)
-> HeaderState ByronBlock
forall blk.
WithOrigin (AnnTip blk)
-> ChainDepState (BlockProtocol blk) -> HeaderState blk
HeaderState (AnnTip ByronBlock -> WithOrigin (AnnTip ByronBlock)
forall t. t -> WithOrigin t
NotOrigin AnnTip ByronBlock
exampleAnnTip) ChainDepState (BlockProtocol ByronBlock)
exampleChainDepState
exampleExtLedgerState :: ExtLedgerState ByronBlock
exampleExtLedgerState :: ExtLedgerState ByronBlock
exampleExtLedgerState = ExtLedgerState {
ledgerState :: LedgerState ByronBlock
ledgerState = LedgerState ByronBlock
exampleLedgerState
, headerState :: HeaderState ByronBlock
headerState = HeaderState ByronBlock
exampleHeaderState
}
exampleHeaderHash :: ByronHash
= ByronBlock -> HeaderHash ByronBlock
forall b. HasHeader b => b -> HeaderHash b
blockHash ByronBlock
exampleBlock
exampleGenTx :: GenTx ByronBlock
exampleGenTx :: GenTx ByronBlock
exampleGenTx = TxId -> ATxAux ByteString -> GenTx ByronBlock
ByronTx TxId
CC.exampleTxId (TxAux -> ATxAux ByteString
CC.annotateTxAux TxAux
CC.exampleTxAux)
exampleGenTxId :: TxId (GenTx ByronBlock)
exampleGenTxId :: GenTxId ByronBlock
exampleGenTxId = TxId -> GenTxId ByronBlock
ByronTxId TxId
CC.exampleTxId
exampleUPIState :: CC.UPI.State
exampleUPIState :: State
exampleUPIState = Config -> State
CC.UPI.initialState Config
LedgerConfig ByronBlock
ledgerConfig
exampleApplyTxErr :: CC.ApplyMempoolPayloadErr
exampleApplyTxErr :: ApplyMempoolPayloadErr
exampleApplyTxErr =
UTxOValidationError -> ApplyMempoolPayloadErr
CC.MempoolTxErr
(UTxOValidationError -> ApplyMempoolPayloadErr)
-> UTxOValidationError -> ApplyMempoolPayloadErr
forall a b. (a -> b) -> a -> b
$ TxValidationError -> UTxOValidationError
CC.UTxOValidationTxValidationError
(TxValidationError -> UTxOValidationError)
-> TxValidationError -> UTxOValidationError
forall a b. (a -> b) -> a -> b
$ Text -> LovelaceError -> TxValidationError
CC.TxValidationLovelaceError Text
"a"
(LovelaceError -> TxValidationError)
-> LovelaceError -> TxValidationError
forall a b. (a -> b) -> a -> b
$ Word64 -> LovelaceError
CC.LovelaceOverflow Word64
0
exampleSlotNo :: SlotNo
exampleSlotNo :: SlotNo
exampleSlotNo = Word64 -> SlotNo
SlotNo Word64
42