{-# LANGUAGE AllowAmbiguousTypes #-}
{-# LANGUAGE ConstraintKinds #-}
{-# LANGUAGE DataKinds #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE PatternSynonyms #-}
{-# LANGUAGE RankNTypes #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE TypeApplications #-}
{-# LANGUAGE TypeFamilies #-}
{-# LANGUAGE TypeOperators #-}
{-# LANGUAGE UndecidableInstances #-}
{-# OPTIONS_GHC -fno-warn-orphans #-}

module Test.Cardano.Ledger.Shelley.Utils (
  mkSeedFromWords,
  mkCertifiedVRF,
  epochFromSlotNo,
  evolveKESUntil,
  slotFromEpoch,
  epochSize,
  mkHash,
  mkKeyPair,
  mkKeyPair',
  mkGenKey,
  mkKESKeyPair,
  mkVRFKeyPair,
  runShelleyBase,
  maxKESIterations,
  slotsPerKESIteration,
  runSTS,
  testSTS,
  maxLLSupply,
  applySTSTest,
  GenesisKeyPair,
  getBlockNonce,
  ChainProperty,
  RawSeed (..),
  Split (..),
  module CoreUtils,
) where

import Cardano.Crypto.DSIGN.Class (DSIGNAlgorithm (..))
import Cardano.Crypto.Hash (hashToBytes)
import Cardano.Crypto.KES (
  UnsoundPureKESAlgorithm (..),
  unsoundPureDeriveVerKeyKES,
  unsoundPureGenKeyKES,
 )
import Cardano.Crypto.Seed (Seed, mkSeedFromBytes)
import Cardano.Crypto.VRF (
  CertifiedVRF,
  SignKeyVRF,
  VRFAlgorithm (..),
  certifiedOutput,
  deriveVerKeyVRF,
  evalCertified,
  genKeyVRF,
 )
import qualified Cardano.Crypto.VRF as VRF
import Cardano.Ledger.BaseTypes (
  Globals (..),
  Nonce,
  ShelleyBase,
  epochInfoPure,
  mkNonceFromOutputVRF,
 )
import Cardano.Ledger.Binary (EncCBOR (..), hashWithEncoder, shelleyProtVer)
import Cardano.Ledger.Block (Block, bheader)
import Cardano.Ledger.Coin (Coin (..))
import Cardano.Ledger.Keys (DSIGN, VKey (..))
import Cardano.Ledger.Shelley.API (ApplyBlock)
import Cardano.Ledger.Shelley.Core
import Cardano.Ledger.Slot (EpochNo, EpochSize (..), SlotNo)
import Cardano.Protocol.Crypto (Crypto)
import Cardano.Protocol.TPraos.API (GetLedgerView)
import Cardano.Protocol.TPraos.BHeader (BHBody (..), BHeader, bhbody)
import Cardano.Slotting.EpochInfo (
  epochInfoEpoch,
  epochInfoFirst,
  epochInfoSize,
 )
import Control.Monad.Reader.Class (asks)
import Control.Monad.Trans.Reader (runReader, runReaderT)
import Control.State.Transition.Extended hiding (Assertion)
import Data.Coerce (Coercible, coerce)
import Data.Functor.Identity (runIdentity)
import Data.List.NonEmpty (NonEmpty)
import Data.Typeable (Proxy (Proxy))
import Data.Word (Word64)
import Test.Cardano.Ledger.Core.KeyPair (KeyPair, pattern KeyPair)
import Test.Cardano.Ledger.Core.Utils as CoreUtils
import Test.Cardano.Ledger.Shelley.Arbitrary (RawSeed (..))
import Test.Cardano.Ledger.Shelley.ConcreteCryptoTypes (MockCrypto)
import Test.Cardano.Ledger.TreeDiff (ToExpr)
import Test.Cardano.Protocol.TPraos.Create (KESKeyPair (..), VRFKeyPair (..), evolveKESUntil)
import Test.Control.State.Transition.Trace (
  applySTSTest,
  checkTrace,
  (.-),
  (.->>),
 )
import Test.Tasty.HUnit (
  Assertion,
  (@?=),
 )

type ChainProperty era =
  ( ApplyBlock era
  , GetLedgerView era
  , EraTx era
  )

-- ================================================

class Split v where
  vsplit :: v -> Integer -> ([v], Coin)

-- ===============================================================================
-- Generating random transactions requires splitting Values into multiple Values
-- with the same underlying amount of Coin. This property is crucial to generating
-- transactions which have the preservation of ADA property. (vsplit n v) breaks
-- v into n different values, and one remainder Coin, where the sum of the Coin
-- in the original value, and the sum of the underlying Coin in the list plus the
-- remainder coin are equal.
-- Given:    let (vs,coin) = split n value
-- Then:     (coin value) == sum(map coin vs) <+> coin

-- We introduce a new class Split which supplies this operation.
-- As new kinds of values become instances of the Val class, and we want to generate
-- transactions over these values, we will have to add additional instances here.

instance Split Coin where
  vsplit :: Coin -> Integer -> ([Coin], Coin)
vsplit (Coin Integer
n) Integer
0 = ([], Integer -> Coin
Coin Integer
n)
  vsplit (Coin Integer
n) Integer
m
    | Integer
m Integer -> Integer -> Bool
forall a. Ord a => a -> a -> Bool
<= Integer
0 = [Char] -> ([Coin], Coin)
forall a. HasCallStack => [Char] -> a
error [Char]
"must split coins into positive parts"
    | Bool
otherwise = (Int -> [Coin] -> [Coin]
forall a. Int -> [a] -> [a]
take (Integer -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral Integer
m) (Coin -> [Coin]
forall a. a -> [a]
repeat (Integer -> Coin
Coin (Integer
n Integer -> Integer -> Integer
forall a. Integral a => a -> a -> a
`div` Integer
m))), Integer -> Coin
Coin (Integer
n Integer -> Integer -> Integer
forall a. Integral a => a -> a -> a
`rem` Integer
m))

type GenesisKeyPair c = KeyPair 'Genesis

instance EncCBOR RawSeed where
  encCBOR :: RawSeed -> Encoding
encCBOR (RawSeed Word64
w1 Word64
w2 Word64
w3 Word64
w4 Word64
w5) = (Word64, Word64, Word64, Word64, Word64) -> Encoding
forall a. EncCBOR a => a -> Encoding
encCBOR (Word64
w1, Word64
w2, Word64
w3, Word64
w4, Word64
w5)
  encodedSizeExpr :: (forall t. EncCBOR t => Proxy t -> Size) -> Proxy RawSeed -> Size
encodedSizeExpr forall t. EncCBOR t => Proxy t -> Size
size Proxy RawSeed
_ = Size
1 Size -> Size -> Size
forall a. Num a => a -> a -> a
+ Proxy Word64 -> Size
forall t. EncCBOR t => Proxy t -> Size
size (Proxy Word64
forall {k} (t :: k). Proxy t
Proxy :: Proxy Word64) Size -> Size -> Size
forall a. Num a => a -> a -> a
* Size
5

-- | Construct a seed from a bunch of Word64s
--
--   We multiply these words by some extra stuff to make sure they contain
--   enough bits for our seed.
mkSeedFromWords ::
  RawSeed ->
  Seed
mkSeedFromWords :: RawSeed -> Seed
mkSeedFromWords RawSeed
stuff =
  ByteString -> Seed
mkSeedFromBytes (ByteString -> Seed)
-> (Hash HASH RawSeed -> ByteString) -> Hash HASH RawSeed -> Seed
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Hash HASH RawSeed -> ByteString
forall h a. Hash h a -> ByteString
hashToBytes (Hash HASH RawSeed -> Seed) -> Hash HASH RawSeed -> Seed
forall a b. (a -> b) -> a -> b
$ forall h a.
HashAlgorithm h =>
Version -> (a -> Encoding) -> a -> Hash h a
hashWithEncoder @HASH Version
shelleyProtVer RawSeed -> Encoding
forall a. EncCBOR a => a -> Encoding
encCBOR RawSeed
stuff

-- | For testing purposes, generate a deterministic genesis key pair given a seed.
mkGenKey ::
  RawSeed ->
  (SignKeyDSIGN DSIGN, VKey kd)
mkGenKey :: forall (kd :: KeyRole). RawSeed -> (SignKeyDSIGN DSIGN, VKey kd)
mkGenKey RawSeed
seed =
  let sk :: SignKeyDSIGN DSIGN
sk = Seed -> SignKeyDSIGN DSIGN
forall v. DSIGNAlgorithm v => Seed -> SignKeyDSIGN v
genKeyDSIGN (Seed -> SignKeyDSIGN DSIGN) -> Seed -> SignKeyDSIGN DSIGN
forall a b. (a -> b) -> a -> b
$ RawSeed -> Seed
mkSeedFromWords RawSeed
seed
   in (SignKeyDSIGN DSIGN
sk, VerKeyDSIGN DSIGN -> VKey kd
forall (kd :: KeyRole). VerKeyDSIGN DSIGN -> VKey kd
VKey (VerKeyDSIGN DSIGN -> VKey kd) -> VerKeyDSIGN DSIGN -> VKey kd
forall a b. (a -> b) -> a -> b
$ SignKeyDSIGN DSIGN -> VerKeyDSIGN DSIGN
forall v. DSIGNAlgorithm v => SignKeyDSIGN v -> VerKeyDSIGN v
deriveVerKeyDSIGN SignKeyDSIGN DSIGN
sk)

-- | For testing purposes, generate a deterministic key pair given a seed.
mkKeyPair ::
  forall kd.
  RawSeed ->
  (SignKeyDSIGN DSIGN, VKey kd)
mkKeyPair :: forall (kd :: KeyRole). RawSeed -> (SignKeyDSIGN DSIGN, VKey kd)
mkKeyPair RawSeed
seed =
  let sk :: SignKeyDSIGN DSIGN
sk = Seed -> SignKeyDSIGN DSIGN
forall v. DSIGNAlgorithm v => Seed -> SignKeyDSIGN v
genKeyDSIGN (Seed -> SignKeyDSIGN DSIGN) -> Seed -> SignKeyDSIGN DSIGN
forall a b. (a -> b) -> a -> b
$ RawSeed -> Seed
mkSeedFromWords RawSeed
seed
   in (SignKeyDSIGN DSIGN
sk, VerKeyDSIGN DSIGN -> VKey kd
forall (kd :: KeyRole). VerKeyDSIGN DSIGN -> VKey kd
VKey (VerKeyDSIGN DSIGN -> VKey kd) -> VerKeyDSIGN DSIGN -> VKey kd
forall a b. (a -> b) -> a -> b
$ SignKeyDSIGN DSIGN -> VerKeyDSIGN DSIGN
forall v. DSIGNAlgorithm v => SignKeyDSIGN v -> VerKeyDSIGN v
deriveVerKeyDSIGN SignKeyDSIGN DSIGN
sk)

-- | For testing purposes, generate a deterministic key pair given a seed.
mkKeyPair' ::
  RawSeed ->
  KeyPair kd
mkKeyPair' :: forall (kd :: KeyRole). RawSeed -> KeyPair kd
mkKeyPair' RawSeed
seed = VKey kd -> SignKeyDSIGN DSIGN -> KeyPair kd
forall (kd :: KeyRole). VKey kd -> SignKeyDSIGN DSIGN -> KeyPair kd
KeyPair VKey kd
vk SignKeyDSIGN DSIGN
sk
  where
    (SignKeyDSIGN DSIGN
sk, VKey kd
vk) = RawSeed -> (SignKeyDSIGN DSIGN, VKey kd)
forall (kd :: KeyRole). RawSeed -> (SignKeyDSIGN DSIGN, VKey kd)
mkKeyPair RawSeed
seed

-- | For testing purposes, generate a deterministic VRF key pair given a seed.
mkVRFKeyPair :: Crypto c => RawSeed -> VRFKeyPair c
mkVRFKeyPair :: forall c. Crypto c => RawSeed -> VRFKeyPair c
mkVRFKeyPair RawSeed
seed =
  let sk :: SignKeyVRF (VRF c)
sk = Seed -> SignKeyVRF (VRF c)
forall v. VRFAlgorithm v => Seed -> SignKeyVRF v
genKeyVRF (Seed -> SignKeyVRF (VRF c)) -> Seed -> SignKeyVRF (VRF c)
forall a b. (a -> b) -> a -> b
$ RawSeed -> Seed
mkSeedFromWords RawSeed
seed
   in VRFKeyPair
        { vrfSignKey :: SignKeyVRF (VRF c)
vrfSignKey = SignKeyVRF (VRF c)
sk
        , vrfVerKey :: VerKeyVRF (VRF c)
vrfVerKey = SignKeyVRF (VRF c) -> VerKeyVRF (VRF c)
forall v. VRFAlgorithm v => SignKeyVRF v -> VerKeyVRF v
deriveVerKeyVRF SignKeyVRF (VRF c)
sk
        }

-- | For testing purposes, create a VRF value
mkCertifiedVRF ::
  ( VRF.Signable v a
  , VRFAlgorithm v
  , ContextVRF v ~ ()
  , Coercible b (CertifiedVRF v a)
  ) =>
  a ->
  SignKeyVRF v ->
  b
mkCertifiedVRF :: forall v a b.
(Signable v a, VRFAlgorithm v, ContextVRF v ~ (),
 Coercible b (CertifiedVRF v a)) =>
a -> SignKeyVRF v -> b
mkCertifiedVRF a
a SignKeyVRF v
sk =
  CertifiedVRF v a -> b
forall a b. Coercible a b => a -> b
coerce (CertifiedVRF v a -> b) -> CertifiedVRF v a -> b
forall a b. (a -> b) -> a -> b
$ ContextVRF v -> a -> SignKeyVRF v -> CertifiedVRF v a
forall v a.
(VRFAlgorithm v, Signable v a) =>
ContextVRF v -> a -> SignKeyVRF v -> CertifiedVRF v a
evalCertified () a
a SignKeyVRF v
sk

-- | For testing purposes, generate a deterministic KES key pair given a seed.
mkKESKeyPair :: Crypto c => RawSeed -> KESKeyPair c
mkKESKeyPair :: forall c. Crypto c => RawSeed -> KESKeyPair c
mkKESKeyPair RawSeed
seed =
  let sk :: UnsoundPureSignKeyKES (KES c)
sk = Seed -> UnsoundPureSignKeyKES (KES c)
forall v.
UnsoundPureKESAlgorithm v =>
Seed -> UnsoundPureSignKeyKES v
unsoundPureGenKeyKES (RawSeed -> Seed
mkSeedFromWords RawSeed
seed)
      vk :: VerKeyKES (KES c)
vk = UnsoundPureSignKeyKES (KES c) -> VerKeyKES (KES c)
forall v.
UnsoundPureKESAlgorithm v =>
UnsoundPureSignKeyKES v -> VerKeyKES v
unsoundPureDeriveVerKeyKES UnsoundPureSignKeyKES (KES c)
sk
   in KESKeyPair
        { kesSignKey :: UnsoundPureSignKeyKES (KES c)
kesSignKey = UnsoundPureSignKeyKES (KES c)
sk
        , kesVerKey :: VerKeyKES (KES c)
kesVerKey = VerKeyKES (KES c)
vk
        }

runShelleyBase :: ShelleyBase a -> a
runShelleyBase :: forall a. ShelleyBase a -> a
runShelleyBase ShelleyBase a
act = Identity a -> a
forall a. Identity a -> a
runIdentity (Identity a -> a) -> Identity a -> a
forall a b. (a -> b) -> a -> b
$ ShelleyBase a -> Globals -> Identity a
forall r (m :: * -> *) a. ReaderT r m a -> r -> m a
runReaderT ShelleyBase a
act Globals
testGlobals

epochFromSlotNo :: SlotNo -> EpochNo
epochFromSlotNo :: SlotNo -> EpochNo
epochFromSlotNo = Identity EpochNo -> EpochNo
forall a. Identity a -> a
runIdentity (Identity EpochNo -> EpochNo)
-> (SlotNo -> Identity EpochNo) -> SlotNo -> EpochNo
forall b c a. (b -> c) -> (a -> b) -> a -> c
. EpochInfo Identity -> SlotNo -> Identity EpochNo
forall (m :: * -> *).
HasCallStack =>
EpochInfo m -> SlotNo -> m EpochNo
epochInfoEpoch (Globals -> EpochInfo Identity
epochInfoPure Globals
testGlobals)

slotFromEpoch :: EpochNo -> SlotNo
slotFromEpoch :: EpochNo -> SlotNo
slotFromEpoch = Identity SlotNo -> SlotNo
forall a. Identity a -> a
runIdentity (Identity SlotNo -> SlotNo)
-> (EpochNo -> Identity SlotNo) -> EpochNo -> SlotNo
forall b c a. (b -> c) -> (a -> b) -> a -> c
. EpochInfo Identity -> EpochNo -> Identity SlotNo
forall (m :: * -> *).
HasCallStack =>
EpochInfo m -> EpochNo -> m SlotNo
epochInfoFirst (Globals -> EpochInfo Identity
epochInfoPure Globals
testGlobals)

epochSize :: EpochNo -> EpochSize
epochSize :: EpochNo -> EpochSize
epochSize = Identity EpochSize -> EpochSize
forall a. Identity a -> a
runIdentity (Identity EpochSize -> EpochSize)
-> (EpochNo -> Identity EpochSize) -> EpochNo -> EpochSize
forall b c a. (b -> c) -> (a -> b) -> a -> c
. EpochInfo Identity -> EpochNo -> Identity EpochSize
forall (m :: * -> *).
HasCallStack =>
EpochInfo m -> EpochNo -> m EpochSize
epochInfoSize (Globals -> EpochInfo Identity
epochInfoPure Globals
testGlobals)

maxKESIterations :: Word64
maxKESIterations :: Word64
maxKESIterations = ShelleyBase Word64 -> Word64
forall a. ShelleyBase a -> a
runShelleyBase ((Globals -> Word64) -> ShelleyBase Word64
forall r (m :: * -> *) a. MonadReader r m => (r -> a) -> m a
asks Globals -> Word64
maxKESEvo)

slotsPerKESIteration :: Word64
slotsPerKESIteration :: Word64
slotsPerKESIteration = ShelleyBase Word64 -> Word64
forall a. ShelleyBase a -> a
runShelleyBase ((Globals -> Word64) -> ShelleyBase Word64
forall r (m :: * -> *) a. MonadReader r m => (r -> a) -> m a
asks Globals -> Word64
slotsPerKESPeriod)

maxLLSupply :: Coin
maxLLSupply :: Coin
maxLLSupply = Integer -> Coin
Coin (Integer -> Coin) -> Integer -> Coin
forall a b. (a -> b) -> a -> b
$ Word64 -> Integer
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Word64 -> Integer) -> Word64 -> Integer
forall a b. (a -> b) -> a -> b
$ ShelleyBase Word64 -> Word64
forall a. ShelleyBase a -> a
runShelleyBase ((Globals -> Word64) -> ShelleyBase Word64
forall r (m :: * -> *) a. MonadReader r m => (r -> a) -> m a
asks Globals -> Word64
maxLovelaceSupply)

runSTS ::
  forall rule era.
  ( BaseM (EraRule rule era) ~ ShelleyBase
  , STS (EraRule rule era)
  ) =>
  Globals ->
  Environment (EraRule rule era) ->
  State (EraRule rule era) ->
  Signal (EraRule rule era) ->
  Either
    (NonEmpty (PredicateFailure (EraRule rule era)))
    (State (EraRule rule era), [Event (EraRule rule era)])
runSTS :: forall (rule :: Symbol) era.
(BaseM (EraRule rule era) ~ ReaderT Globals Identity,
 STS (EraRule rule era)) =>
Globals
-> Environment (EraRule rule era)
-> State (EraRule rule era)
-> Signal (EraRule rule era)
-> Either
     (NonEmpty (PredicateFailure (EraRule rule era)))
     (State (EraRule rule era), [Event (EraRule rule era)])
runSTS Globals
globals Environment (EraRule rule era)
env State (EraRule rule era)
st Signal (EraRule rule era)
sig =
  let
    stsOpts :: ApplySTSOpts 'EventPolicyReturn
stsOpts =
      ApplySTSOpts
        { asoValidation :: ValidationPolicy
asoValidation = ValidationPolicy
ValidateAll
        , asoEvents :: SingEP 'EventPolicyReturn
asoEvents = SingEP 'EventPolicyReturn
EPReturn
        , asoAssertions :: AssertionPolicy
asoAssertions = AssertionPolicy
AssertionsAll
        }
   in
    (Reader
  Globals
  (Either
     (NonEmpty (PredicateFailure (EraRule rule era)))
     (State (EraRule rule era), [Event (EraRule rule era)]))
-> Globals
-> Either
     (NonEmpty (PredicateFailure (EraRule rule era)))
     (State (EraRule rule era), [Event (EraRule rule era)])
forall r a. Reader r a -> r -> a
`runReader` Globals
globals) (forall s (m :: * -> *) (rtype :: RuleType) (ep :: EventPolicy).
(STS s, RuleTypeRep rtype, m ~ BaseM s) =>
ApplySTSOpts ep
-> RuleContext rtype s
-> m (Either
        (NonEmpty (PredicateFailure s)) (EventReturnType ep s (State s)))
applySTSOptsEither @(EraRule rule era) ApplySTSOpts 'EventPolicyReturn
stsOpts ((Environment (EraRule rule era), State (EraRule rule era),
 Signal (EraRule rule era))
-> TRC (EraRule rule era)
forall sts. (Environment sts, State sts, Signal sts) -> TRC sts
TRC (Environment (EraRule rule era)
env, State (EraRule rule era)
st, Signal (EraRule rule era)
sig)))

testSTS ::
  forall s.
  (BaseM s ~ ShelleyBase, STS s, Eq (State s), Show (State s), ToExpr (State s)) =>
  Environment s ->
  State s ->
  Signal s ->
  Either (NonEmpty (PredicateFailure s)) (State s) ->
  Assertion
testSTS :: forall s.
(BaseM s ~ ReaderT Globals Identity, STS s, Eq (State s),
 Show (State s), ToExpr (State s)) =>
Environment s
-> State s
-> Signal s
-> Either (NonEmpty (PredicateFailure s)) (State s)
-> Assertion
testSTS Environment s
env State s
initSt Signal s
signal (Right State s
expectedSt) = do
  forall s (m :: * -> *).
(STS s, BaseM s ~ m) =>
(forall a. m a -> a)
-> Environment s
-> ReaderT
     (State s
      -> Signal s -> Either (NonEmpty (PredicateFailure s)) (State s))
     IO
     (State s)
-> Assertion
checkTrace @s ShelleyBase a -> a
forall a. ShelleyBase a -> a
runShelleyBase Environment s
env (ReaderT
   (State s
    -> Signal s -> Either (NonEmpty (PredicateFailure s)) (State s))
   IO
   (State s)
 -> Assertion)
-> ReaderT
     (State s
      -> Signal s -> Either (NonEmpty (PredicateFailure s)) (State s))
     IO
     (State s)
-> Assertion
forall a b. (a -> b) -> a -> b
$ State s
-> ReaderT
     (State s
      -> Signal s -> Either (NonEmpty (PredicateFailure s)) (State s))
     IO
     (State s)
forall a.
a
-> ReaderT
     (State s
      -> Signal s -> Either (NonEmpty (PredicateFailure s)) (State s))
     IO
     a
forall (f :: * -> *) a. Applicative f => a -> f a
pure State s
initSt ReaderT
  (State s
   -> Signal s -> Either (NonEmpty (PredicateFailure s)) (State s))
  IO
  (State s)
-> Signal s
-> ReaderT
     (State s
      -> Signal s -> Either (NonEmpty (PredicateFailure s)) (State s))
     IO
     (State s)
forall (m :: * -> *) st sig err.
(MonadIO m, MonadReader (st -> sig -> Either err st) m, Show err,
 HasCallStack) =>
m st -> sig -> m st
.- Signal s
signal ReaderT
  (State s
   -> Signal s -> Either (NonEmpty (PredicateFailure s)) (State s))
  IO
  (State s)
-> State s
-> ReaderT
     (State s
      -> Signal s -> Either (NonEmpty (PredicateFailure s)) (State s))
     IO
     (State s)
forall (m :: * -> *) st.
(MonadIO m, Eq st, ToExpr st, HasCallStack) =>
m st -> st -> m st
.->> State s
expectedSt
testSTS Environment s
env State s
initSt Signal s
sig predicateFailure :: Either (NonEmpty (PredicateFailure s)) (State s)
predicateFailure@(Left NonEmpty (PredicateFailure s)
_) = do
  let st :: Either (NonEmpty (PredicateFailure s)) (State s)
st = ShelleyBase (Either (NonEmpty (PredicateFailure s)) (State s))
-> Either (NonEmpty (PredicateFailure s)) (State s)
forall a. ShelleyBase a -> a
runShelleyBase (ShelleyBase (Either (NonEmpty (PredicateFailure s)) (State s))
 -> Either (NonEmpty (PredicateFailure s)) (State s))
-> ShelleyBase (Either (NonEmpty (PredicateFailure s)) (State s))
-> Either (NonEmpty (PredicateFailure s)) (State s)
forall a b. (a -> b) -> a -> b
$ forall s (m :: * -> *) (rtype :: RuleType).
(STS s, RuleTypeRep rtype, m ~ BaseM s) =>
RuleContext rtype s
-> m (Either (NonEmpty (PredicateFailure s)) (State s))
applySTSTest @s ((Environment s, State s, Signal s) -> TRC s
forall sts. (Environment sts, State sts, Signal sts) -> TRC sts
TRC (Environment s
env, State s
initSt, Signal s
sig))
  Either (NonEmpty (PredicateFailure s)) (State s)
st Either (NonEmpty (PredicateFailure s)) (State s)
-> Either (NonEmpty (PredicateFailure s)) (State s) -> Assertion
forall a. (Eq a, Show a, HasCallStack) => a -> a -> Assertion
@?= Either (NonEmpty (PredicateFailure s)) (State s)
predicateFailure

mkHash :: forall a h. HashAlgorithm h => Int -> Hash h a
mkHash :: forall a h. HashAlgorithm h => Int -> Hash h a
mkHash Int
i = Hash h Int -> Hash h a
forall a b. Coercible a b => a -> b
coerce (forall h a.
HashAlgorithm h =>
Version -> (a -> Encoding) -> a -> Hash h a
hashWithEncoder @h Version
shelleyProtVer Int -> Encoding
forall a. EncCBOR a => a -> Encoding
encCBOR Int
i)

getBlockNonce :: forall era. Block (BHeader MockCrypto) era -> Nonce
getBlockNonce :: forall era. Block (BHeader MockCrypto) era -> Nonce
getBlockNonce =
  OutputVRF FakeVRF -> Nonce
forall v. OutputVRF v -> Nonce
mkNonceFromOutputVRF (OutputVRF FakeVRF -> Nonce)
-> (Block (BHeader MockCrypto) era -> OutputVRF FakeVRF)
-> Block (BHeader MockCrypto) era
-> Nonce
forall b c a. (b -> c) -> (a -> b) -> a -> c
. CertifiedVRF FakeVRF Nonce -> OutputVRF FakeVRF
forall v a. CertifiedVRF v a -> OutputVRF v
certifiedOutput (CertifiedVRF FakeVRF Nonce -> OutputVRF FakeVRF)
-> (Block (BHeader MockCrypto) era -> CertifiedVRF FakeVRF Nonce)
-> Block (BHeader MockCrypto) era
-> OutputVRF FakeVRF
forall b c a. (b -> c) -> (a -> b) -> a -> c
. BHBody MockCrypto -> CertifiedVRF (VRF MockCrypto) Nonce
BHBody MockCrypto -> CertifiedVRF FakeVRF Nonce
forall c. BHBody c -> CertifiedVRF (VRF c) Nonce
bheaderEta (BHBody MockCrypto -> CertifiedVRF FakeVRF Nonce)
-> (Block (BHeader MockCrypto) era -> BHBody MockCrypto)
-> Block (BHeader MockCrypto) era
-> CertifiedVRF FakeVRF Nonce
forall b c a. (b -> c) -> (a -> b) -> a -> c
. BHeader MockCrypto -> BHBody MockCrypto
forall c. Crypto c => BHeader c -> BHBody c
bhbody (BHeader MockCrypto -> BHBody MockCrypto)
-> (Block (BHeader MockCrypto) era -> BHeader MockCrypto)
-> Block (BHeader MockCrypto) era
-> BHBody MockCrypto
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Block (BHeader MockCrypto) era -> BHeader MockCrypto
forall h era. Block h era -> h
bheader