{-# LANGUAGE ScopedTypeVariables #-}
{-# OPTIONS_GHC -Wno-orphans #-}
module Test.Consensus.Protocol.Serialisation.Generators () where
import Cardano.Crypto.KES (signedKES)
import Cardano.Crypto.VRF (evalCertified)
import Cardano.Protocol.TPraos.BHeader (HashHeader, PrevHash (..))
import Cardano.Protocol.TPraos.OCert (KESPeriod (KESPeriod),
OCert (OCert))
import Cardano.Slotting.Block (BlockNo (BlockNo))
import Cardano.Slotting.Slot (SlotNo (SlotNo),
WithOrigin (At, Origin))
import Ouroboros.Consensus.Protocol.Praos (PraosState (PraosState))
import qualified Ouroboros.Consensus.Protocol.Praos as Praos
import Ouroboros.Consensus.Protocol.Praos.Header (Header (Header),
HeaderBody (HeaderBody))
import Ouroboros.Consensus.Protocol.Praos.VRF (InputVRF, mkInputVRF)
import Test.Cardano.Ledger.Shelley.Serialisation.EraIndepGenerators ()
import Test.Crypto.KES ()
import Test.Crypto.VRF ()
import Test.QuickCheck (Arbitrary (..), Gen, choose, oneof)
instance Arbitrary InputVRF where
arbitrary :: Gen InputVRF
arbitrary = SlotNo -> Nonce -> InputVRF
mkInputVRF (SlotNo -> Nonce -> InputVRF)
-> Gen SlotNo -> Gen (Nonce -> InputVRF)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Gen SlotNo
forall a. Arbitrary a => Gen a
arbitrary Gen (Nonce -> InputVRF) -> Gen Nonce -> Gen InputVRF
forall a b. Gen (a -> b) -> Gen a -> Gen b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Gen Nonce
forall a. Arbitrary a => Gen a
arbitrary
instance Praos.PraosCrypto c => Arbitrary (HeaderBody c) where
arbitrary :: Gen (HeaderBody c)
arbitrary =
let ocert :: Gen (OCert c)
ocert =
VerKeyKES (KES c)
-> Word64
-> KESPeriod
-> SignedDSIGN (DSIGN c) (OCertSignable c)
-> OCert c
forall c.
VerKeyKES c
-> Word64
-> KESPeriod
-> SignedDSIGN c (OCertSignable c)
-> OCert c
OCert
(VerKeyKES (KES c)
-> Word64
-> KESPeriod
-> SignedDSIGN (DSIGN c) (OCertSignable c)
-> OCert c)
-> Gen (VerKeyKES (KES c))
-> Gen
(Word64
-> KESPeriod -> SignedDSIGN (DSIGN c) (OCertSignable c) -> OCert c)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Gen (VerKeyKES (KES c))
forall a. Arbitrary a => Gen a
arbitrary
Gen
(Word64
-> KESPeriod -> SignedDSIGN (DSIGN c) (OCertSignable c) -> OCert c)
-> Gen Word64
-> Gen
(KESPeriod -> SignedDSIGN (DSIGN c) (OCertSignable c) -> OCert c)
forall a b. Gen (a -> b) -> Gen a -> Gen b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Gen Word64
forall a. Arbitrary a => Gen a
arbitrary
Gen
(KESPeriod -> SignedDSIGN (DSIGN c) (OCertSignable c) -> OCert c)
-> Gen KESPeriod
-> Gen (SignedDSIGN (DSIGN c) (OCertSignable c) -> OCert c)
forall a b. Gen (a -> b) -> Gen a -> Gen b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Word -> KESPeriod
KESPeriod (Word -> KESPeriod) -> Gen Word -> Gen KESPeriod
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Gen Word
forall a. Arbitrary a => Gen a
arbitrary)
Gen (SignedDSIGN (DSIGN c) (OCertSignable c) -> OCert c)
-> Gen (SignedDSIGN (DSIGN c) (OCertSignable c)) -> Gen (OCert c)
forall a b. Gen (a -> b) -> Gen a -> Gen b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Gen (SignedDSIGN (DSIGN c) (OCertSignable c))
forall a. Arbitrary a => Gen a
arbitrary
certVrf :: Gen (CertifiedVRF (VRF c) InputVRF)
certVrf =
ContextVRF (VRF c)
-> InputVRF -> SignKeyVRF (VRF c) -> CertifiedVRF (VRF c) InputVRF
forall v a.
(VRFAlgorithm v, Signable v a) =>
ContextVRF v -> a -> SignKeyVRF v -> CertifiedVRF v a
evalCertified ()
(InputVRF -> SignKeyVRF (VRF c) -> CertifiedVRF (VRF c) InputVRF)
-> Gen InputVRF
-> Gen (SignKeyVRF (VRF c) -> CertifiedVRF (VRF c) InputVRF)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Gen InputVRF
forall a. Arbitrary a => Gen a
arbitrary :: Gen InputVRF)
Gen (SignKeyVRF (VRF c) -> CertifiedVRF (VRF c) InputVRF)
-> Gen (SignKeyVRF (VRF c)) -> Gen (CertifiedVRF (VRF c) InputVRF)
forall a b. Gen (a -> b) -> Gen a -> Gen b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Gen (SignKeyVRF (VRF c))
forall a. Arbitrary a => Gen a
arbitrary
in BlockNo
-> SlotNo
-> PrevHash c
-> VKey 'BlockIssuer c
-> VerKeyVRF (VRF c)
-> CertifiedVRF (VRF c) InputVRF
-> Word32
-> Hash (HASH c) EraIndependentBlockBody
-> OCert c
-> ProtVer
-> HeaderBody c
forall crypto.
BlockNo
-> SlotNo
-> PrevHash crypto
-> VKey 'BlockIssuer crypto
-> VerKeyVRF crypto
-> CertifiedVRF crypto InputVRF
-> Word32
-> Hash crypto EraIndependentBlockBody
-> OCert crypto
-> ProtVer
-> HeaderBody crypto
HeaderBody
(BlockNo
-> SlotNo
-> PrevHash c
-> VKey 'BlockIssuer c
-> VerKeyVRF (VRF c)
-> CertifiedVRF (VRF c) InputVRF
-> Word32
-> Hash (HASH c) EraIndependentBlockBody
-> OCert c
-> ProtVer
-> HeaderBody c)
-> Gen BlockNo
-> Gen
(SlotNo
-> PrevHash c
-> VKey 'BlockIssuer c
-> VerKeyVRF (VRF c)
-> CertifiedVRF (VRF c) InputVRF
-> Word32
-> Hash (HASH c) EraIndependentBlockBody
-> OCert c
-> ProtVer
-> HeaderBody c)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Word64 -> BlockNo
BlockNo (Word64 -> BlockNo) -> Gen Word64 -> Gen BlockNo
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Word64, Word64) -> Gen Word64
forall a. Random a => (a, a) -> Gen a
choose (Word64
1, Word64
10))
Gen
(SlotNo
-> PrevHash c
-> VKey 'BlockIssuer c
-> VerKeyVRF (VRF c)
-> CertifiedVRF (VRF c) InputVRF
-> Word32
-> Hash (HASH c) EraIndependentBlockBody
-> OCert c
-> ProtVer
-> HeaderBody c)
-> Gen SlotNo
-> Gen
(PrevHash c
-> VKey 'BlockIssuer c
-> VerKeyVRF (VRF c)
-> CertifiedVRF (VRF c) InputVRF
-> Word32
-> Hash (HASH c) EraIndependentBlockBody
-> OCert c
-> ProtVer
-> HeaderBody c)
forall a b. Gen (a -> b) -> Gen a -> Gen b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Word64 -> SlotNo
SlotNo (Word64 -> SlotNo) -> Gen Word64 -> Gen SlotNo
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Word64, Word64) -> Gen Word64
forall a. Random a => (a, a) -> Gen a
choose (Word64
1, Word64
10))
Gen
(PrevHash c
-> VKey 'BlockIssuer c
-> VerKeyVRF (VRF c)
-> CertifiedVRF (VRF c) InputVRF
-> Word32
-> Hash (HASH c) EraIndependentBlockBody
-> OCert c
-> ProtVer
-> HeaderBody c)
-> Gen (PrevHash c)
-> Gen
(VKey 'BlockIssuer c
-> VerKeyVRF (VRF c)
-> CertifiedVRF (VRF c) InputVRF
-> Word32
-> Hash (HASH c) EraIndependentBlockBody
-> OCert c
-> ProtVer
-> HeaderBody c)
forall a b. Gen (a -> b) -> Gen a -> Gen b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> [Gen (PrevHash c)] -> Gen (PrevHash c)
forall a. [Gen a] -> Gen a
oneof
[ PrevHash c -> Gen (PrevHash c)
forall a. a -> Gen a
forall (f :: * -> *) a. Applicative f => a -> f a
pure PrevHash c
forall c. PrevHash c
GenesisHash,
HashHeader c -> PrevHash c
forall c. HashHeader c -> PrevHash c
BlockHash (HashHeader c -> PrevHash c)
-> Gen (HashHeader c) -> Gen (PrevHash c)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Gen (HashHeader c)
forall a. Arbitrary a => Gen a
arbitrary :: Gen (HashHeader c))
]
Gen
(VKey 'BlockIssuer c
-> VerKeyVRF (VRF c)
-> CertifiedVRF (VRF c) InputVRF
-> Word32
-> Hash (HASH c) EraIndependentBlockBody
-> OCert c
-> ProtVer
-> HeaderBody c)
-> Gen (VKey 'BlockIssuer c)
-> Gen
(VerKeyVRF (VRF c)
-> CertifiedVRF (VRF c) InputVRF
-> Word32
-> Hash (HASH c) EraIndependentBlockBody
-> OCert c
-> ProtVer
-> HeaderBody c)
forall a b. Gen (a -> b) -> Gen a -> Gen b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Gen (VKey 'BlockIssuer c)
forall a. Arbitrary a => Gen a
arbitrary
Gen
(VerKeyVRF (VRF c)
-> CertifiedVRF (VRF c) InputVRF
-> Word32
-> Hash (HASH c) EraIndependentBlockBody
-> OCert c
-> ProtVer
-> HeaderBody c)
-> Gen (VerKeyVRF (VRF c))
-> Gen
(CertifiedVRF (VRF c) InputVRF
-> Word32
-> Hash (HASH c) EraIndependentBlockBody
-> OCert c
-> ProtVer
-> HeaderBody c)
forall a b. Gen (a -> b) -> Gen a -> Gen b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Gen (VerKeyVRF (VRF c))
forall a. Arbitrary a => Gen a
arbitrary
Gen
(CertifiedVRF (VRF c) InputVRF
-> Word32
-> Hash (HASH c) EraIndependentBlockBody
-> OCert c
-> ProtVer
-> HeaderBody c)
-> Gen (CertifiedVRF (VRF c) InputVRF)
-> Gen
(Word32
-> Hash (HASH c) EraIndependentBlockBody
-> OCert c
-> ProtVer
-> HeaderBody c)
forall a b. Gen (a -> b) -> Gen a -> Gen b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Gen (CertifiedVRF (VRF c) InputVRF)
certVrf
Gen
(Word32
-> Hash (HASH c) EraIndependentBlockBody
-> OCert c
-> ProtVer
-> HeaderBody c)
-> Gen Word32
-> Gen
(Hash (HASH c) EraIndependentBlockBody
-> OCert c -> ProtVer -> HeaderBody c)
forall a b. Gen (a -> b) -> Gen a -> Gen b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Gen Word32
forall a. Arbitrary a => Gen a
arbitrary
Gen
(Hash (HASH c) EraIndependentBlockBody
-> OCert c -> ProtVer -> HeaderBody c)
-> Gen (Hash (HASH c) EraIndependentBlockBody)
-> Gen (OCert c -> ProtVer -> HeaderBody c)
forall a b. Gen (a -> b) -> Gen a -> Gen b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Gen (Hash (HASH c) EraIndependentBlockBody)
forall a. Arbitrary a => Gen a
arbitrary
Gen (OCert c -> ProtVer -> HeaderBody c)
-> Gen (OCert c) -> Gen (ProtVer -> HeaderBody c)
forall a b. Gen (a -> b) -> Gen a -> Gen b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Gen (OCert c)
ocert
Gen (ProtVer -> HeaderBody c) -> Gen ProtVer -> Gen (HeaderBody c)
forall a b. Gen (a -> b) -> Gen a -> Gen b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Gen ProtVer
forall a. Arbitrary a => Gen a
arbitrary
instance Praos.PraosCrypto c => Arbitrary (Header c) where
arbitrary :: Gen (Header c)
arbitrary = do
HeaderBody c
hBody <- Gen (HeaderBody c)
forall a. Arbitrary a => Gen a
arbitrary
Word
period <- Gen Word
forall a. Arbitrary a => Gen a
arbitrary
SignKeyKES (KES c)
sKey <- Gen (SignKeyKES (KES c))
forall a. Arbitrary a => Gen a
arbitrary
let hSig :: SignedKES (KES c) (HeaderBody c)
hSig = ContextKES (KES c)
-> Word
-> HeaderBody c
-> SignKeyKES (KES c)
-> SignedKES (KES c) (HeaderBody c)
forall v a.
(KESAlgorithm v, Signable v a) =>
ContextKES v -> Word -> a -> SignKeyKES v -> SignedKES v a
signedKES () Word
period HeaderBody c
hBody SignKeyKES (KES c)
sKey
Header c -> Gen (Header c)
forall a. a -> Gen a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Header c -> Gen (Header c)) -> Header c -> Gen (Header c)
forall a b. (a -> b) -> a -> b
$ HeaderBody c -> SignedKES (KES c) (HeaderBody c) -> Header c
forall crypto.
Crypto crypto =>
HeaderBody crypto
-> SignedKES crypto (HeaderBody crypto) -> Header crypto
Header HeaderBody c
hBody SignedKES (KES c) (HeaderBody c)
hSig
instance Praos.PraosCrypto c => Arbitrary (PraosState c) where
arbitrary :: Gen (PraosState c)
arbitrary = WithOrigin SlotNo
-> Map (KeyHash 'BlockIssuer c) Word64
-> Nonce
-> Nonce
-> Nonce
-> Nonce
-> Nonce
-> PraosState c
forall c.
WithOrigin SlotNo
-> Map (KeyHash 'BlockIssuer c) Word64
-> Nonce
-> Nonce
-> Nonce
-> Nonce
-> Nonce
-> PraosState c
PraosState
(WithOrigin SlotNo
-> Map (KeyHash 'BlockIssuer c) Word64
-> Nonce
-> Nonce
-> Nonce
-> Nonce
-> Nonce
-> PraosState c)
-> Gen (WithOrigin SlotNo)
-> Gen
(Map (KeyHash 'BlockIssuer c) Word64
-> Nonce -> Nonce -> Nonce -> Nonce -> Nonce -> PraosState c)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [Gen (WithOrigin SlotNo)] -> Gen (WithOrigin SlotNo)
forall a. [Gen a] -> Gen a
oneof [
WithOrigin SlotNo -> Gen (WithOrigin SlotNo)
forall a. a -> Gen a
forall (f :: * -> *) a. Applicative f => a -> f a
pure WithOrigin SlotNo
forall t. WithOrigin t
Origin,
SlotNo -> WithOrigin SlotNo
forall t. t -> WithOrigin t
At (SlotNo -> WithOrigin SlotNo)
-> Gen SlotNo -> Gen (WithOrigin SlotNo)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Word64 -> SlotNo
SlotNo (Word64 -> SlotNo) -> Gen Word64 -> Gen SlotNo
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Word64, Word64) -> Gen Word64
forall a. Random a => (a, a) -> Gen a
choose (Word64
1, Word64
10))
]
Gen
(Map (KeyHash 'BlockIssuer c) Word64
-> Nonce -> Nonce -> Nonce -> Nonce -> Nonce -> PraosState c)
-> Gen (Map (KeyHash 'BlockIssuer c) Word64)
-> Gen (Nonce -> Nonce -> Nonce -> Nonce -> Nonce -> PraosState c)
forall a b. Gen (a -> b) -> Gen a -> Gen b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Gen (Map (KeyHash 'BlockIssuer c) Word64)
forall a. Arbitrary a => Gen a
arbitrary
Gen (Nonce -> Nonce -> Nonce -> Nonce -> Nonce -> PraosState c)
-> Gen Nonce
-> Gen (Nonce -> Nonce -> Nonce -> Nonce -> PraosState c)
forall a b. Gen (a -> b) -> Gen a -> Gen b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Gen Nonce
forall a. Arbitrary a => Gen a
arbitrary
Gen (Nonce -> Nonce -> Nonce -> Nonce -> PraosState c)
-> Gen Nonce -> Gen (Nonce -> Nonce -> Nonce -> PraosState c)
forall a b. Gen (a -> b) -> Gen a -> Gen b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Gen Nonce
forall a. Arbitrary a => Gen a
arbitrary
Gen (Nonce -> Nonce -> Nonce -> PraosState c)
-> Gen Nonce -> Gen (Nonce -> Nonce -> PraosState c)
forall a b. Gen (a -> b) -> Gen a -> Gen b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Gen Nonce
forall a. Arbitrary a => Gen a
arbitrary
Gen (Nonce -> Nonce -> PraosState c)
-> Gen Nonce -> Gen (Nonce -> PraosState c)
forall a b. Gen (a -> b) -> Gen a -> Gen b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Gen Nonce
forall a. Arbitrary a => Gen a
arbitrary
Gen (Nonce -> PraosState c) -> Gen Nonce -> Gen (PraosState c)
forall a b. Gen (a -> b) -> Gen a -> Gen b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Gen Nonce
forall a. Arbitrary a => Gen a
arbitrary