{-# LANGUAGE ScopedTypeVariables #-}

{-# OPTIONS_GHC -Wno-orphans #-}

-- | Generators suitable for serialisation. Note that these are not guaranteed
-- to be semantically correct at all, only structurally correct.
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. HasCallStack => [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. HasCallStack => [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