{-# LANGUAGE TypeApplications #-}

-- | A forged Dijkstra block announces the endorser block that 'forgeBlock'
-- returns.
module Test.Consensus.Shelley.Forge (tests) where

import qualified Cardano.Crypto.Hash as Hash
import Cardano.Ledger.BaseTypes (StrictMaybe (..))
import qualified Cardano.Ledger.BaseTypes as SL (Globals (..), ProtVer (..))
import Cardano.Ledger.Binary (serialize')
import Cardano.Ledger.Block (EbReferencesAnnouncement (..))
import Cardano.Ledger.Coin (Coin (..))
import Cardano.Ledger.Core (bodyTxL, eraProtVerLow, feeTxBodyL, ppProtocolVersionL)
import Cardano.Ledger.Dijkstra (DijkstraEra)
import Cardano.Ledger.Dijkstra.PParams (ppMaxEndorserBlockReferencesSizeL)
import Cardano.Ledger.Hashes (HASH, unsafeMakeSafeHash)
import Cardano.Ledger.MemoBytes (getMemoRawType)
import qualified Cardano.Ledger.Shelley.API as SL
  ( mkMempoolEnv
  , mkMempoolState
  , unsafeMakeValidatedTx
  )
import Cardano.Ledger.Shelley.LedgerState (curPParamsEpochStateL, nesEsL)
import qualified Cardano.Protocol.Leios.BlockHeader as Leios
import qualified Cardano.Protocol.TPraos.OCert as SL (KESPeriod (..))
import Cardano.Slotting.EpochInfo (fixedEpochInfo)
import Control.Tracer (nullTracer)
import qualified Data.ByteString as BS
import Data.Maybe (isJust)
import Lens.Micro ((&), (.~), (^.))
import Ouroboros.Consensus.Block
import Ouroboros.Consensus.BlockchainTime (slotLengthFromSec)
import Ouroboros.Consensus.Config
  ( SecurityParam (..)
  , TopLevelConfig (..)
  , emptyCheckpointsMap
  )
import Ouroboros.Consensus.Leios.Types
  ( BytesSize
  , TxHash
  , encodeEndorserBlockSize
  , endorserBlockHash
  , endorserBlockReferences
  )
import Ouroboros.Consensus.Protocol.Praos
  ( ConsensusConfig (..)
  , PraosIsLeader (..)
  , PraosParams (..)
  )
import Ouroboros.Consensus.Protocol.Praos.Common
  ( MaxMajorProtVer (..)
  , PraosCanBeLeader (..)
  , instantiatePraosCredentials
  )
import Ouroboros.Consensus.Protocol.Praos2 (ConsensusConfig (..))
import Ouroboros.Consensus.Shelley.Eras (StandardCrypto)
import Ouroboros.Consensus.Shelley.HFEras (StandardDijkstraBlock)
import Ouroboros.Consensus.Shelley.Ledger
  ( GenTx (..)
  , LedgerState (..)
  , ShelleyLedgerConfig (..)
  , Ticked (..)
  , Validated (..)
  , mkShelleyBlockConfig
  , mkShelleyTx
  , shelleyHeaderRaw
  )
import Ouroboros.Consensus.Shelley.Ledger.Config
  ( CodecConfig (..)
  , StorageConfig (..)
  )
import Ouroboros.Consensus.Shelley.Ledger.SupportsProtocol ()
import Ouroboros.Consensus.Shelley.Node.Common (ShelleyLeaderCredentials (..))
import Ouroboros.Consensus.Shelley.Node.Praos (praos2SharedBlockForging)
import Test.Consensus.Shelley.Examples (examplesDijkstra, testShelleyGenesis)
import Test.Tasty (TestTree, testGroup)
import Test.Tasty.QuickCheck
import Test.ThreadNet.Infra.Shelley (CoreNode, genCoreNode, mkLeaderCredentials)
import Test.Util.Serialisation.Examples (Examples, Labelled)
import qualified Test.Util.Serialisation.Examples as Examples

tests :: TestTree
tests :: TestTree
tests =
  TestName -> [TestTree] -> TestTree
testGroup
    TestName
"Forge"
    [ TestName -> Property -> TestTree
forall a. Testable a => TestName -> a -> TestTree
testProperty TestName
"a block announces the endorser block it comes with" Property
prop_announcesEb
    , TestName -> Property -> TestTree
forall a. Testable a => TestName -> a -> TestTree
testProperty TestName
"a block without endorser-block transactions announces nothing" Property
prop_noEb
    ]

prop_announcesEb :: Property
prop_announcesEb :: Property
prop_announcesEb =
  Gen (CoreNode StandardCrypto)
-> (CoreNode StandardCrypto -> Property) -> Property
forall prop a. Testable prop => Gen a -> (a -> prop) -> Property
forAllBlind (KESPeriod -> Gen (CoreNode StandardCrypto)
forall c. Crypto c => KESPeriod -> Gen (CoreNode c)
genCoreNode (Word -> KESPeriod
SL.KESPeriod Word
0)) ((CoreNode StandardCrypto -> Property) -> Property)
-> (CoreNode StandardCrypto -> Property) -> Property
forall a b. (a -> b) -> a -> b
$ \CoreNode StandardCrypto
coreNode ->
    Gen Int -> (Int -> Property) -> Property
forall a prop.
(Show a, Testable prop) =>
Gen a -> (a -> prop) -> Property
forAll Gen Int
genNumEbTxs ((Int -> Property) -> Property) -> (Int -> Property) -> Property
forall a b. (a -> b) -> a -> b
$ \Int
numEbTxs -> IO Property -> Property
forall prop. Testable prop => IO prop -> Property
ioProperty (IO Property -> Property) -> IO Property -> Property
forall a b. (a -> b) -> a -> b
$ do
      let ebTxs :: [GenTx (ShelleyBlock (Praos2 StandardCrypto) DijkstraEra)]
ebTxs = Int
-> [GenTx (ShelleyBlock (Praos2 StandardCrypto) DijkstraEra)]
-> [GenTx (ShelleyBlock (Praos2 StandardCrypto) DijkstraEra)]
forall a. Int -> [a] -> [a]
take Int
numEbTxs [GenTx (ShelleyBlock (Praos2 StandardCrypto) DijkstraEra)]
distinctTxs
      ForgeBlockResult blk forgedEb <- CoreNode StandardCrypto
-> [GenTx (ShelleyBlock (Praos2 StandardCrypto) DijkstraEra)]
-> IO
     (ForgeBlockResult
        (ShelleyBlock (Praos2 StandardCrypto) DijkstraEra))
forgeWith CoreNode StandardCrypto
coreNode [GenTx (ShelleyBlock (Praos2 StandardCrypto) DijkstraEra)]
ebTxs
      pure $ case forgedEb of
        Maybe EndorserBlock
Nothing -> TestName -> Bool -> Property
forall prop. Testable prop => TestName -> prop -> Property
counterexample TestName
"no endorser block" Bool
False
        Just EndorserBlock
eb ->
          [Property] -> Property
forall prop. Testable prop => [prop] -> Property
conjoin
            [ TestName -> Property -> Property
forall prop. Testable prop => TestName -> prop -> Property
counterexample TestName
"the endorser block does not reference the transactions in order" (Property -> Property) -> Property -> Property
forall a b. (a -> b) -> a -> b
$
                EndorserBlock -> [(TxHash, Word32)]
endorserBlockReferences EndorserBlock
eb [(TxHash, Word32)] -> [(TxHash, Word32)] -> Property
forall a. (Eq a, Show a) => a -> a -> Property
=== (GenTx (ShelleyBlock (Praos2 StandardCrypto) DijkstraEra)
 -> (TxHash, Word32))
-> [GenTx (ShelleyBlock (Praos2 StandardCrypto) DijkstraEra)]
-> [(TxHash, Word32)]
forall a b. (a -> b) -> [a] -> [b]
map GenTx (ShelleyBlock (Praos2 StandardCrypto) DijkstraEra)
-> (TxHash, Word32)
reference [GenTx (ShelleyBlock (Praos2 StandardCrypto) DijkstraEra)]
ebTxs
            , ShelleyBlock (Praos2 StandardCrypto) DijkstraEra
-> StrictMaybe EbReferencesAnnouncement
announcement ShelleyBlock (Praos2 StandardCrypto) DijkstraEra
blk
                StrictMaybe EbReferencesAnnouncement
-> StrictMaybe EbReferencesAnnouncement -> Property
forall a. (Eq a, Show a) => a -> a -> Property
=== EbReferencesAnnouncement -> StrictMaybe EbReferencesAnnouncement
forall a. a -> StrictMaybe a
SJust
                  EbReferencesAnnouncement
                    { ebReferencesAnnouncementHash :: SafeHash EraIndependentEbReferences
ebReferencesAnnouncementHash = Hash HASH EraIndependentEbReferences
-> SafeHash EraIndependentEbReferences
forall i. Hash HASH i -> SafeHash i
unsafeMakeSafeHash (EndorserBlock -> Hash HASH EraIndependentEbReferences
endorserBlockHash EndorserBlock
eb)
                    , ebReferencesAnnouncementSize :: Word32
ebReferencesAnnouncementSize = EndorserBlock -> Word32
encodeEndorserBlockSize EndorserBlock
eb
                    }
            , TestName -> Bool -> Property
forall prop. Testable prop => TestName -> prop -> Property
counterexample TestName
"the block does not match its header" (Bool -> Property) -> Bool -> Property
forall a b. (a -> b) -> a -> b
$
                Header (ShelleyBlock (Praos2 StandardCrypto) DijkstraEra)
-> ShelleyBlock (Praos2 StandardCrypto) DijkstraEra -> Bool
forall blk. GetHeader blk => Header blk -> blk -> Bool
blockMatchesHeader (ShelleyBlock (Praos2 StandardCrypto) DijkstraEra
-> Header (ShelleyBlock (Praos2 StandardCrypto) DijkstraEra)
forall blk. GetHeader blk => blk -> Header blk
getHeader ShelleyBlock (Praos2 StandardCrypto) DijkstraEra
blk) ShelleyBlock (Praos2 StandardCrypto) DijkstraEra
blk
            ]

prop_noEb :: Property
prop_noEb :: Property
prop_noEb =
  Gen (CoreNode StandardCrypto)
-> (CoreNode StandardCrypto -> Property) -> Property
forall prop a. Testable prop => Gen a -> (a -> prop) -> Property
forAllBlind (KESPeriod -> Gen (CoreNode StandardCrypto)
forall c. Crypto c => KESPeriod -> Gen (CoreNode c)
genCoreNode (Word -> KESPeriod
SL.KESPeriod Word
0)) ((CoreNode StandardCrypto -> Property) -> Property)
-> (CoreNode StandardCrypto -> Property) -> Property
forall a b. (a -> b) -> a -> b
$ \CoreNode StandardCrypto
coreNode -> IO Property -> Property
forall prop. Testable prop => IO prop -> Property
ioProperty (IO Property -> Property) -> IO Property -> Property
forall a b. (a -> b) -> a -> b
$ do
    ForgeBlockResult blk forgedEb <- CoreNode StandardCrypto
-> [GenTx (ShelleyBlock (Praos2 StandardCrypto) DijkstraEra)]
-> IO
     (ForgeBlockResult
        (ShelleyBlock (Praos2 StandardCrypto) DijkstraEra))
forgeWith CoreNode StandardCrypto
coreNode []
    pure $ (announcement blk, isJust forgedEb) === (SNothing, False)

-- | A number of endorser-block transactions.
-- 'Ouroboros.Consensus.Leios.Types.encodeEndorserBlock' writes a
-- longer map header from 24 and from 256 references.
genNumEbTxs :: Gen Int
genNumEbTxs :: Gen Int
genNumEbTxs =
  [(Int, Gen Int)] -> Gen Int
forall a. HasCallStack => [(Int, Gen a)] -> Gen a
frequency
    [ (Int
1, [Int] -> Gen Int
forall a. HasCallStack => [a] -> Gen a
elements [Int
1, Int
23, Int
24, Int
255, Int
256])
    , (Int
3, (Int, Int) -> Gen Int
chooseInt (Int
1, Int
300))
    ]

-- | Forge the block after the example ledger state, with the given endorser
-- block transactions and no ranking block transactions.
forgeWith ::
  CoreNode StandardCrypto ->
  [GenTx StandardDijkstraBlock] ->
  IO (ForgeBlockResult StandardDijkstraBlock)
forgeWith :: CoreNode StandardCrypto
-> [GenTx (ShelleyBlock (Praos2 StandardCrypto) DijkstraEra)]
-> IO
     (ForgeBlockResult
        (ShelleyBlock (Praos2 StandardCrypto) DijkstraEra))
forgeWith CoreNode StandardCrypto
coreNode [GenTx (ShelleyBlock (Praos2 StandardCrypto) DijkstraEra)]
ebTxs = do
  hotKey <-
    Word64
-> Tracer IO KESAgentClientTrace
-> PraosCredentialsSource StandardCrypto
-> IO (HotKey StandardCrypto IO)
forall (m :: * -> *) c.
KESAgentContext c m =>
Word64
-> Tracer m KESAgentClientTrace
-> PraosCredentialsSource c
-> m (HotKey c m)
instantiatePraosCredentials
      (Globals -> Word64
SL.maxKESEvo Globals
globals)
      Tracer IO KESAgentClientTrace
forall (m :: * -> *) a. Monad m => Tracer m a
nullTracer
      (PraosCanBeLeader StandardCrypto
-> PraosCredentialsSource StandardCrypto
forall c. PraosCanBeLeader c -> PraosCredentialsSource c
praosCanBeLeaderCredentialsSource PraosCanBeLeader StandardCrypto
praosCanBeLeader)
  forgeBlock
    (praos2SharedBlockForging hotKey slotToPeriod credentials)
    ForgeBlockArgs
      { fbConfig = topLevelConfig
      , fbCurrentBlockNo = BlockNo 4
      , fbCurrentSlotNo = slot
      , fbPerasCert = Nothing
      , fbCurrentTickedLedgerState = tickedDijkstraLedgerState
      , fbTxs = []
      , fbEbTxs =
          [ ShelleyValidatedTx txid $
              SL.unsafeMakeValidatedTx
                globals
                (SL.mkMempoolEnv newEpochState slot)
                (SL.mkMempoolState newEpochState)
                tx
          | ShelleyTx txid tx <- ebTxs
          ]
      , fbIsLeader = PraosIsLeader $ Leios.hbrVrfRes (rawHeaderBody (getHeader exampleDijkstraBlock))
      }
 where
  slot :: SlotNo
slot = Word64 -> SlotNo
SlotNo Word64
10
  credentials :: ShelleyLeaderCredentials StandardCrypto
credentials = CoreNode StandardCrypto -> ShelleyLeaderCredentials StandardCrypto
forall c. CoreNode c -> ShelleyLeaderCredentials c
mkLeaderCredentials CoreNode StandardCrypto
coreNode
  praosCanBeLeader :: PraosCanBeLeader StandardCrypto
praosCanBeLeader = ShelleyLeaderCredentials StandardCrypto
-> PraosCanBeLeader StandardCrypto
forall c. ShelleyLeaderCredentials c -> PraosCanBeLeader c
shelleyLeaderCredentialsCanBeLeader ShelleyLeaderCredentials StandardCrypto
credentials

  slotToPeriod :: SlotNo -> KESPeriod
slotToPeriod (SlotNo Word64
slotNo) =
    Word -> KESPeriod
SL.KESPeriod (Word -> KESPeriod) -> Word -> KESPeriod
forall a b. (a -> b) -> a -> b
$ Word64 -> Word
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Word64 -> Word) -> Word64 -> Word
forall a b. (a -> b) -> a -> b
$ Word64
slotNo Word64 -> Word64 -> Word64
forall a. Integral a => a -> a -> a
`div` Globals -> Word64
SL.slotsPerKESPeriod Globals
globals

  topLevelConfig :: TopLevelConfig (ShelleyBlock (Praos2 c) DijkstraEra)
topLevelConfig =
    TopLevelConfig
      { topLevelConfigProtocol :: ConsensusConfig
  (BlockProtocol (ShelleyBlock (Praos2 c) DijkstraEra))
topLevelConfigProtocol =
          ConsensusConfig (Praos c) -> ConsensusConfig (Praos2 c)
forall c. ConsensusConfig (Praos c) -> ConsensusConfig (Praos2 c)
LeiosConfig (ConsensusConfig (Praos c) -> ConsensusConfig (Praos2 c))
-> ConsensusConfig (Praos c) -> ConsensusConfig (Praos2 c)
forall a b. (a -> b) -> a -> b
$
            PraosConfig
              { praosParams :: PraosParams
praosParams =
                  PraosParams
                    { praosSlotsPerKESPeriod :: Word64
praosSlotsPerKESPeriod = Globals -> Word64
SL.slotsPerKESPeriod Globals
globals
                    , praosLeaderF :: ActiveSlotCoeff
praosLeaderF = Globals -> ActiveSlotCoeff
SL.activeSlotCoeff Globals
globals
                    , praosSecurityParam :: SecurityParam
praosSecurityParam = NonZero Word64 -> SecurityParam
SecurityParam (NonZero Word64 -> SecurityParam)
-> NonZero Word64 -> SecurityParam
forall a b. (a -> b) -> a -> b
$ Globals -> NonZero Word64
SL.securityParameter Globals
globals
                    , praosMaxKESEvo :: Word64
praosMaxKESEvo = Globals -> Word64
SL.maxKESEvo Globals
globals
                    , praosMaxMajorPV :: MaxMajorProtVer
praosMaxMajorPV = Version -> MaxMajorProtVer
MaxMajorProtVer (Version -> MaxMajorProtVer) -> Version -> MaxMajorProtVer
forall a b. (a -> b) -> a -> b
$ ProtVer -> Version
SL.pvMajor ProtVer
protVer
                    , praosRandomnessStabilisationWindow :: Word64
praosRandomnessStabilisationWindow = Globals -> Word64
SL.randomnessStabilisationWindow Globals
globals
                    }
              , praosEpochInfo :: EpochInfo (Except PastHorizonException)
praosEpochInfo = EpochSize -> SlotLength -> EpochInfo (Except PastHorizonException)
forall (m :: * -> *).
Monad m =>
EpochSize -> SlotLength -> EpochInfo m
fixedEpochInfo (Word64 -> EpochSize
EpochSize Word64
4) (Integer -> SlotLength
slotLengthFromSec Integer
7)
              }
      , topLevelConfigLedger :: LedgerConfig (ShelleyBlock (Praos2 c) DijkstraEra)
topLevelConfigLedger = LedgerConfig (ShelleyBlock (Praos2 c) DijkstraEra)
ShelleyLedgerConfig DijkstraEra
ledgerConfig
      , topLevelConfigBlock :: BlockConfig (ShelleyBlock (Praos2 c) DijkstraEra)
topLevelConfigBlock =
          ProtVer
-> ShelleyGenesis
-> [VKey BlockIssuer]
-> BlockConfig (ShelleyBlock (Praos2 c) DijkstraEra)
forall proto era.
ShelleyBasedEra era =>
ProtVer
-> ShelleyGenesis
-> [VKey BlockIssuer]
-> BlockConfig (ShelleyBlock proto era)
mkShelleyBlockConfig
            ProtVer
protVer
            ShelleyGenesis
testShelleyGenesis
            [PraosCanBeLeader StandardCrypto -> VKey BlockIssuer
forall c. PraosCanBeLeader c -> VKey BlockIssuer
praosCanBeLeaderColdVerKey PraosCanBeLeader StandardCrypto
praosCanBeLeader]
      , topLevelConfigCodec :: CodecConfig (ShelleyBlock (Praos2 c) DijkstraEra)
topLevelConfigCodec = CodecConfig (ShelleyBlock (Praos2 c) DijkstraEra)
forall proto era. CodecConfig (ShelleyBlock proto era)
ShelleyCodecConfig
      , topLevelConfigStorage :: StorageConfig (ShelleyBlock (Praos2 c) DijkstraEra)
topLevelConfigStorage =
          Word64
-> SecurityParam
-> StorageConfig (ShelleyBlock (Praos2 c) DijkstraEra)
forall proto era.
Word64 -> SecurityParam -> StorageConfig (ShelleyBlock proto era)
ShelleyStorageConfig
            (Globals -> Word64
SL.slotsPerKESPeriod Globals
globals)
            (NonZero Word64 -> SecurityParam
SecurityParam (NonZero Word64 -> SecurityParam)
-> NonZero Word64 -> SecurityParam
forall a b. (a -> b) -> a -> b
$ Globals -> NonZero Word64
SL.securityParameter Globals
globals)
      , topLevelConfigCheckpoints :: CheckpointsMap (ShelleyBlock (Praos2 c) DijkstraEra)
topLevelConfigCheckpoints = CheckpointsMap (ShelleyBlock (Praos2 c) DijkstraEra)
forall blk. CheckpointsMap blk
emptyCheckpointsMap
      }

  protVer :: ProtVer
protVer = NewEpochState DijkstraEra
newEpochState NewEpochState DijkstraEra
-> Getting ProtVer (NewEpochState DijkstraEra) ProtVer -> ProtVer
forall s a. s -> Getting a s a -> a
^. (EpochState DijkstraEra -> Const ProtVer (EpochState DijkstraEra))
-> NewEpochState DijkstraEra
-> Const ProtVer (NewEpochState DijkstraEra)
forall era (f :: * -> *).
Functor f =>
(EpochState era -> f (EpochState era))
-> NewEpochState era -> f (NewEpochState era)
nesEsL ((EpochState DijkstraEra -> Const ProtVer (EpochState DijkstraEra))
 -> NewEpochState DijkstraEra
 -> Const ProtVer (NewEpochState DijkstraEra))
-> ((ProtVer -> Const ProtVer ProtVer)
    -> EpochState DijkstraEra
    -> Const ProtVer (EpochState DijkstraEra))
-> Getting ProtVer (NewEpochState DijkstraEra) ProtVer
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (PParams DijkstraEra -> Const ProtVer (PParams DijkstraEra))
-> EpochState DijkstraEra -> Const ProtVer (EpochState DijkstraEra)
forall era. EraGov era => Lens' (EpochState era) (PParams era)
Lens' (EpochState DijkstraEra) (PParams DijkstraEra)
curPParamsEpochStateL ((PParams DijkstraEra -> Const ProtVer (PParams DijkstraEra))
 -> EpochState DijkstraEra
 -> Const ProtVer (EpochState DijkstraEra))
-> ((ProtVer -> Const ProtVer ProtVer)
    -> PParams DijkstraEra -> Const ProtVer (PParams DijkstraEra))
-> (ProtVer -> Const ProtVer ProtVer)
-> EpochState DijkstraEra
-> Const ProtVer (EpochState DijkstraEra)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (ProtVer -> Const ProtVer ProtVer)
-> PParams DijkstraEra -> Const ProtVer (PParams DijkstraEra)
forall era. EraPParams era => Lens' (PParams era) ProtVer
Lens' (PParams DijkstraEra) ProtVer
ppProtocolVersionL
  ledgerConfig :: ShelleyLedgerConfig DijkstraEra
ledgerConfig = (Examples (ShelleyBlock (Praos2 StandardCrypto) DijkstraEra)
 -> Labelled (ShelleyLedgerConfig DijkstraEra))
-> ShelleyLedgerConfig DijkstraEra
forall b.
(Examples (ShelleyBlock (Praos2 StandardCrypto) DijkstraEra)
 -> Labelled b)
-> b
example Examples (ShelleyBlock (Praos2 StandardCrypto) DijkstraEra)
-> Labelled
     (LedgerConfig (ShelleyBlock (Praos2 StandardCrypto) DijkstraEra))
Examples (ShelleyBlock (Praos2 StandardCrypto) DijkstraEra)
-> Labelled (ShelleyLedgerConfig DijkstraEra)
forall blk. Examples blk -> Labelled (LedgerConfig blk)
Examples.exampleLedgerConfig
  globals :: Globals
globals = ShelleyLedgerConfig DijkstraEra -> Globals
forall era. ShelleyLedgerConfig era -> Globals
shelleyLedgerGlobals ShelleyLedgerConfig DijkstraEra
ledgerConfig

  tickedDijkstraLedgerState :: TickedLedgerState
  (ShelleyBlock (Praos2 StandardCrypto) DijkstraEra) EmptyMK
tickedDijkstraLedgerState =
    TickedShelleyLedgerState
      { untickedShelleyLedgerTip :: WithOrigin (ShelleyTip (Praos2 StandardCrypto) DijkstraEra)
untickedShelleyLedgerTip = LedgerState
  (ShelleyBlock (Praos2 StandardCrypto) DijkstraEra) EmptyMK
-> WithOrigin (ShelleyTip (Praos2 StandardCrypto) DijkstraEra)
forall proto era (mk :: * -> * -> *).
LedgerState (ShelleyBlock proto era) mk
-> WithOrigin (ShelleyTip proto era)
shelleyLedgerTip LedgerState
  (ShelleyBlock (Praos2 StandardCrypto) DijkstraEra) EmptyMK
ledgerState
      , tickedShelleyLedgerTransition :: ShelleyTransition
tickedShelleyLedgerTransition = LedgerState
  (ShelleyBlock (Praos2 StandardCrypto) DijkstraEra) EmptyMK
-> ShelleyTransition
forall proto era (mk :: * -> * -> *).
LedgerState (ShelleyBlock proto era) mk -> ShelleyTransition
shelleyLedgerTransition LedgerState
  (ShelleyBlock (Praos2 StandardCrypto) DijkstraEra) EmptyMK
ledgerState
      , tickedShelleyLedgerState :: NewEpochState DijkstraEra
tickedShelleyLedgerState = NewEpochState DijkstraEra
newEpochState
      , tickedShelleyLedgerTables :: LedgerTables
  (ShelleyBlock (Praos2 StandardCrypto) DijkstraEra) EmptyMK
tickedShelleyLedgerTables = LedgerState
  (ShelleyBlock (Praos2 StandardCrypto) DijkstraEra) EmptyMK
-> LedgerTables
     (ShelleyBlock (Praos2 StandardCrypto) DijkstraEra) EmptyMK
forall proto era (mk :: * -> * -> *).
LedgerState (ShelleyBlock proto era) mk
-> LedgerTables (ShelleyBlock proto era) mk
shelleyLedgerTables LedgerState
  (ShelleyBlock (Praos2 StandardCrypto) DijkstraEra) EmptyMK
ledgerState
      }

  -- The 'maxEndorserBlockReferencesSize' of the example parameters is smaller
  -- than the endorser block of the example transaction.
  newEpochState :: NewEpochState DijkstraEra
newEpochState =
    LedgerState
  (ShelleyBlock (Praos2 StandardCrypto) DijkstraEra) EmptyMK
-> NewEpochState DijkstraEra
forall proto era (mk :: * -> * -> *).
LedgerState (ShelleyBlock proto era) mk -> NewEpochState era
shelleyLedgerState LedgerState
  (ShelleyBlock (Praos2 StandardCrypto) DijkstraEra) EmptyMK
ledgerState
      NewEpochState DijkstraEra
-> (NewEpochState DijkstraEra -> NewEpochState DijkstraEra)
-> NewEpochState DijkstraEra
forall a b. a -> (a -> b) -> b
& (EpochState DijkstraEra -> Identity (EpochState DijkstraEra))
-> NewEpochState DijkstraEra
-> Identity (NewEpochState DijkstraEra)
forall era (f :: * -> *).
Functor f =>
(EpochState era -> f (EpochState era))
-> NewEpochState era -> f (NewEpochState era)
nesEsL ((EpochState DijkstraEra -> Identity (EpochState DijkstraEra))
 -> NewEpochState DijkstraEra
 -> Identity (NewEpochState DijkstraEra))
-> ((Word32 -> Identity Word32)
    -> EpochState DijkstraEra -> Identity (EpochState DijkstraEra))
-> (Word32 -> Identity Word32)
-> NewEpochState DijkstraEra
-> Identity (NewEpochState DijkstraEra)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (PParams DijkstraEra -> Identity (PParams DijkstraEra))
-> EpochState DijkstraEra -> Identity (EpochState DijkstraEra)
forall era. EraGov era => Lens' (EpochState era) (PParams era)
Lens' (EpochState DijkstraEra) (PParams DijkstraEra)
curPParamsEpochStateL ((PParams DijkstraEra -> Identity (PParams DijkstraEra))
 -> EpochState DijkstraEra -> Identity (EpochState DijkstraEra))
-> ((Word32 -> Identity Word32)
    -> PParams DijkstraEra -> Identity (PParams DijkstraEra))
-> (Word32 -> Identity Word32)
-> EpochState DijkstraEra
-> Identity (EpochState DijkstraEra)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Word32 -> Identity Word32)
-> PParams DijkstraEra -> Identity (PParams DijkstraEra)
forall era. DijkstraEraPParams era => Lens' (PParams era) Word32
Lens' (PParams DijkstraEra) Word32
ppMaxEndorserBlockReferencesSizeL ((Word32 -> Identity Word32)
 -> NewEpochState DijkstraEra
 -> Identity (NewEpochState DijkstraEra))
-> Word32 -> NewEpochState DijkstraEra -> NewEpochState DijkstraEra
forall s t a b. ASetter s t a b -> b -> s -> t
.~ Word32
512 Word32 -> Word32 -> Word32
forall a. Num a => a -> a -> a
* Word32
1024

  ledgerState :: LedgerState
  (ShelleyBlock (Praos2 StandardCrypto) DijkstraEra) EmptyMK
ledgerState = (Examples (ShelleyBlock (Praos2 StandardCrypto) DijkstraEra)
 -> Labelled
      (LedgerState
         (ShelleyBlock (Praos2 StandardCrypto) DijkstraEra) EmptyMK))
-> LedgerState
     (ShelleyBlock (Praos2 StandardCrypto) DijkstraEra) EmptyMK
forall b.
(Examples (ShelleyBlock (Praos2 StandardCrypto) DijkstraEra)
 -> Labelled b)
-> b
example Examples (ShelleyBlock (Praos2 StandardCrypto) DijkstraEra)
-> Labelled
     (LedgerState
        (ShelleyBlock (Praos2 StandardCrypto) DijkstraEra) EmptyMK)
forall blk. Examples blk -> Labelled (LedgerState blk EmptyMK)
Examples.exampleLedgerState

announcement :: StandardDijkstraBlock -> StrictMaybe EbReferencesAnnouncement
announcement :: ShelleyBlock (Praos2 StandardCrypto) DijkstraEra
-> StrictMaybe EbReferencesAnnouncement
announcement = HeaderBodyRaw StandardCrypto
-> StrictMaybe EbReferencesAnnouncement
forall crypto.
HeaderBodyRaw crypto -> StrictMaybe EbReferencesAnnouncement
Leios.hbrEbReferencesAnnouncement (HeaderBodyRaw StandardCrypto
 -> StrictMaybe EbReferencesAnnouncement)
-> (ShelleyBlock (Praos2 StandardCrypto) DijkstraEra
    -> HeaderBodyRaw StandardCrypto)
-> ShelleyBlock (Praos2 StandardCrypto) DijkstraEra
-> StrictMaybe EbReferencesAnnouncement
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Header (ShelleyBlock (Praos2 StandardCrypto) DijkstraEra)
-> HeaderBodyRaw StandardCrypto
rawHeaderBody (Header (ShelleyBlock (Praos2 StandardCrypto) DijkstraEra)
 -> HeaderBodyRaw StandardCrypto)
-> (ShelleyBlock (Praos2 StandardCrypto) DijkstraEra
    -> Header (ShelleyBlock (Praos2 StandardCrypto) DijkstraEra))
-> ShelleyBlock (Praos2 StandardCrypto) DijkstraEra
-> HeaderBodyRaw StandardCrypto
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ShelleyBlock (Praos2 StandardCrypto) DijkstraEra
-> Header (ShelleyBlock (Praos2 StandardCrypto) DijkstraEra)
forall blk. GetHeader blk => blk -> Header blk
getHeader

rawHeaderBody :: Header StandardDijkstraBlock -> Leios.HeaderBodyRaw StandardCrypto
rawHeaderBody :: Header (ShelleyBlock (Praos2 StandardCrypto) DijkstraEra)
-> HeaderBodyRaw StandardCrypto
rawHeaderBody = HeaderBody StandardCrypto -> RawType (HeaderBody StandardCrypto)
HeaderBody StandardCrypto -> HeaderBodyRaw StandardCrypto
forall t. Memoized t => t -> RawType t
getMemoRawType (HeaderBody StandardCrypto -> HeaderBodyRaw StandardCrypto)
-> (Header (ShelleyBlock (Praos2 StandardCrypto) DijkstraEra)
    -> HeaderBody StandardCrypto)
-> Header (ShelleyBlock (Praos2 StandardCrypto) DijkstraEra)
-> HeaderBodyRaw StandardCrypto
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Header StandardCrypto -> HeaderBody StandardCrypto
forall crypto. Header crypto -> HeaderBody crypto
Leios.headerBody (Header StandardCrypto -> HeaderBody StandardCrypto)
-> (Header (ShelleyBlock (Praos2 StandardCrypto) DijkstraEra)
    -> Header StandardCrypto)
-> Header (ShelleyBlock (Praos2 StandardCrypto) DijkstraEra)
-> HeaderBody StandardCrypto
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Header (ShelleyBlock (Praos2 StandardCrypto) DijkstraEra)
-> Header StandardCrypto
Header (ShelleyBlock (Praos2 StandardCrypto) DijkstraEra)
-> ShelleyProtocolHeader (Praos2 StandardCrypto)
forall proto era.
Header (ShelleyBlock proto era) -> ShelleyProtocolHeader proto
shelleyHeaderRaw

exampleTx :: GenTx StandardDijkstraBlock
exampleTx :: GenTx (ShelleyBlock (Praos2 StandardCrypto) DijkstraEra)
exampleTx = (Examples (ShelleyBlock (Praos2 StandardCrypto) DijkstraEra)
 -> Labelled
      (GenTx (ShelleyBlock (Praos2 StandardCrypto) DijkstraEra)))
-> GenTx (ShelleyBlock (Praos2 StandardCrypto) DijkstraEra)
forall b.
(Examples (ShelleyBlock (Praos2 StandardCrypto) DijkstraEra)
 -> Labelled b)
-> b
example Examples (ShelleyBlock (Praos2 StandardCrypto) DijkstraEra)
-> Labelled
     (GenTx (ShelleyBlock (Praos2 StandardCrypto) DijkstraEra))
forall blk. Examples blk -> Labelled (GenTx blk)
Examples.exampleGenTx

-- | Copies of 'exampleTx' with different fees, so that each copy has
-- different bytes and a reordered endorser block has a different hash.
distinctTxs :: [GenTx StandardDijkstraBlock]
distinctTxs :: [GenTx (ShelleyBlock (Praos2 StandardCrypto) DijkstraEra)]
distinctTxs =
  [ Tx TopTx DijkstraEra
-> GenTx (ShelleyBlock (Praos2 StandardCrypto) DijkstraEra)
forall era proto.
ShelleyBasedEra era =>
Tx TopTx era -> GenTx (ShelleyBlock proto era)
mkShelleyTx (Tx TopTx DijkstraEra
tx Tx TopTx DijkstraEra
-> (Tx TopTx DijkstraEra -> Tx TopTx DijkstraEra)
-> Tx TopTx DijkstraEra
forall a b. a -> (a -> b) -> b
& (TxBody TopTx DijkstraEra -> Identity (TxBody TopTx DijkstraEra))
-> Tx TopTx DijkstraEra -> Identity (Tx TopTx DijkstraEra)
forall era (l :: TxLevel).
EraTx era =>
Lens' (Tx l era) (TxBody l era)
forall (l :: TxLevel).
Lens' (Tx l DijkstraEra) (TxBody l DijkstraEra)
bodyTxL ((TxBody TopTx DijkstraEra -> Identity (TxBody TopTx DijkstraEra))
 -> Tx TopTx DijkstraEra -> Identity (Tx TopTx DijkstraEra))
-> ((Coin -> Identity Coin)
    -> TxBody TopTx DijkstraEra -> Identity (TxBody TopTx DijkstraEra))
-> (Coin -> Identity Coin)
-> Tx TopTx DijkstraEra
-> Identity (Tx TopTx DijkstraEra)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Coin -> Identity Coin)
-> TxBody TopTx DijkstraEra -> Identity (TxBody TopTx DijkstraEra)
forall era. EraTxBody era => Lens' (TxBody TopTx era) Coin
Lens' (TxBody TopTx DijkstraEra) Coin
feeTxBodyL ((Coin -> Identity Coin)
 -> Tx TopTx DijkstraEra -> Identity (Tx TopTx DijkstraEra))
-> Coin -> Tx TopTx DijkstraEra -> Tx TopTx DijkstraEra
forall s t a b. ASetter s t a b -> b -> s -> t
.~ Integer -> Coin
Coin Integer
fee)
  | let ShelleyTx TxId
_ Tx TopTx DijkstraEra
tx = GenTx (ShelleyBlock (Praos2 StandardCrypto) DijkstraEra)
exampleTx
  , Integer
fee <- [Integer
1 ..]
  ]

-- | The reference that an endorser block holds for a transaction: the
-- Blake2b-256 hash and the length of the transaction bytes.
reference :: GenTx StandardDijkstraBlock -> (TxHash, BytesSize)
reference :: GenTx (ShelleyBlock (Praos2 StandardCrypto) DijkstraEra)
-> (TxHash, Word32)
reference (ShelleyTx TxId
_ Tx TopTx DijkstraEra
tx) =
  ( Hash HASH ByteString -> TxHash
forall h a b. Hash h a -> Hash h b
Hash.castHash (forall h a. HashAlgorithm h => (a -> ByteString) -> a -> Hash h a
Hash.hashWith @HASH ByteString -> ByteString
forall a. a -> a
id ByteString
bytes)
  , Int -> Word32
forall a b. (Integral a, Num b) => a -> b
fromIntegral (ByteString -> Int
BS.length ByteString
bytes)
  )
 where
  bytes :: ByteString
bytes = Version -> Tx TopTx DijkstraEra -> ByteString
forall a. EncCBOR a => Version -> a -> ByteString
serialize' (forall era. Era era => Version
eraProtVerLow @DijkstraEra) Tx TopTx DijkstraEra
tx

exampleDijkstraBlock :: StandardDijkstraBlock
exampleDijkstraBlock :: ShelleyBlock (Praos2 StandardCrypto) DijkstraEra
exampleDijkstraBlock = (Examples (ShelleyBlock (Praos2 StandardCrypto) DijkstraEra)
 -> Labelled (ShelleyBlock (Praos2 StandardCrypto) DijkstraEra))
-> ShelleyBlock (Praos2 StandardCrypto) DijkstraEra
forall b.
(Examples (ShelleyBlock (Praos2 StandardCrypto) DijkstraEra)
 -> Labelled b)
-> b
example Examples (ShelleyBlock (Praos2 StandardCrypto) DijkstraEra)
-> Labelled (ShelleyBlock (Praos2 StandardCrypto) DijkstraEra)
forall blk. Examples blk -> Labelled blk
Examples.exampleBlock

example :: (Examples StandardDijkstraBlock -> Labelled b) -> b
example :: forall b.
(Examples (ShelleyBlock (Praos2 StandardCrypto) DijkstraEra)
 -> Labelled b)
-> b
example Examples (ShelleyBlock (Praos2 StandardCrypto) DijkstraEra)
-> Labelled b
field = case Examples (ShelleyBlock (Praos2 StandardCrypto) DijkstraEra)
-> Labelled b
field Examples (ShelleyBlock (Praos2 StandardCrypto) DijkstraEra)
examplesDijkstra of
  (Maybe TestName
_, b
x) : Labelled b
_ -> b
x
  [] -> TestName -> b
forall a. HasCallStack => TestName -> a
error TestName
"no example"