{-# 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 (unsoundPureSignedKES)
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 (OCertSignable c)
-> OCert c
forall c.
VerKeyKES (KES c)
-> Word64
-> KESPeriod
-> SignedDSIGN DSIGN (OCertSignable c)
-> OCert c
OCert
            (VerKeyKES (KES c)
 -> Word64
 -> KESPeriod
 -> SignedDSIGN DSIGN (OCertSignable c)
 -> OCert c)
-> Gen (VerKeyKES (KES c))
-> Gen
     (Word64
      -> KESPeriod -> SignedDSIGN DSIGN (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 (OCertSignable c) -> OCert c)
-> Gen Word64
-> Gen
     (KESPeriod -> SignedDSIGN DSIGN (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 (OCertSignable c) -> OCert c)
-> Gen KESPeriod
-> Gen (SignedDSIGN DSIGN (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 (OCertSignable c) -> OCert c)
-> Gen (SignedDSIGN DSIGN (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 (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
-> VKey 'BlockIssuer
-> VerKeyVRF (VRF c)
-> CertifiedVRF (VRF c) InputVRF
-> Word32
-> Hash HASH EraIndependentBlockBody
-> OCert c
-> ProtVer
-> HeaderBody c
forall crypto.
BlockNo
-> SlotNo
-> PrevHash
-> VKey 'BlockIssuer
-> VerKeyVRF (VRF crypto)
-> CertifiedVRF (VRF crypto) InputVRF
-> Word32
-> Hash HASH EraIndependentBlockBody
-> OCert crypto
-> ProtVer
-> HeaderBody crypto
HeaderBody
          (BlockNo
 -> SlotNo
 -> PrevHash
 -> VKey 'BlockIssuer
 -> VerKeyVRF (VRF c)
 -> CertifiedVRF (VRF c) InputVRF
 -> Word32
 -> Hash HASH EraIndependentBlockBody
 -> OCert c
 -> ProtVer
 -> HeaderBody c)
-> Gen BlockNo
-> Gen
     (SlotNo
      -> PrevHash
      -> VKey 'BlockIssuer
      -> VerKeyVRF (VRF c)
      -> CertifiedVRF (VRF c) InputVRF
      -> Word32
      -> Hash HASH 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
   -> VKey 'BlockIssuer
   -> VerKeyVRF (VRF c)
   -> CertifiedVRF (VRF c) InputVRF
   -> Word32
   -> Hash HASH EraIndependentBlockBody
   -> OCert c
   -> ProtVer
   -> HeaderBody c)
-> Gen SlotNo
-> Gen
     (PrevHash
      -> VKey 'BlockIssuer
      -> VerKeyVRF (VRF c)
      -> CertifiedVRF (VRF c) InputVRF
      -> Word32
      -> Hash HASH 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
   -> VKey 'BlockIssuer
   -> VerKeyVRF (VRF c)
   -> CertifiedVRF (VRF c) InputVRF
   -> Word32
   -> Hash HASH EraIndependentBlockBody
   -> OCert c
   -> ProtVer
   -> HeaderBody c)
-> Gen PrevHash
-> Gen
     (VKey 'BlockIssuer
      -> VerKeyVRF (VRF c)
      -> CertifiedVRF (VRF c) InputVRF
      -> Word32
      -> Hash HASH 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] -> Gen PrevHash
forall a. HasCallStack => [Gen a] -> Gen a
oneof
            [ PrevHash -> Gen PrevHash
forall a. a -> Gen a
forall (f :: * -> *) a. Applicative f => a -> f a
pure PrevHash
GenesisHash,
              HashHeader -> PrevHash
BlockHash (HashHeader -> PrevHash) -> Gen HashHeader -> Gen PrevHash
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Gen HashHeader
forall a. Arbitrary a => Gen a
arbitrary :: Gen HashHeader)
            ]
          Gen
  (VKey 'BlockIssuer
   -> VerKeyVRF (VRF c)
   -> CertifiedVRF (VRF c) InputVRF
   -> Word32
   -> Hash HASH EraIndependentBlockBody
   -> OCert c
   -> ProtVer
   -> HeaderBody c)
-> Gen (VKey 'BlockIssuer)
-> Gen
     (VerKeyVRF (VRF c)
      -> CertifiedVRF (VRF c) InputVRF
      -> Word32
      -> Hash HASH 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)
forall a. Arbitrary a => Gen a
arbitrary
          Gen
  (VerKeyVRF (VRF c)
   -> CertifiedVRF (VRF c) InputVRF
   -> Word32
   -> Hash HASH EraIndependentBlockBody
   -> OCert c
   -> ProtVer
   -> HeaderBody c)
-> Gen (VerKeyVRF (VRF c))
-> Gen
     (CertifiedVRF (VRF c) InputVRF
      -> Word32
      -> Hash HASH 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 EraIndependentBlockBody
   -> OCert c
   -> ProtVer
   -> HeaderBody c)
-> Gen (CertifiedVRF (VRF c) InputVRF)
-> Gen
     (Word32
      -> Hash HASH 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 EraIndependentBlockBody
   -> OCert c
   -> ProtVer
   -> HeaderBody c)
-> Gen Word32
-> Gen
     (Hash HASH 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 EraIndependentBlockBody
   -> OCert c -> ProtVer -> HeaderBody c)
-> Gen (Hash HASH 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 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
    UnsoundPureSignKeyKES (KES c)
sKey <- Gen (UnsoundPureSignKeyKES (KES c))
forall a. Arbitrary a => Gen a
arbitrary
    let hSig :: SignedKES (KES c) (HeaderBody c)
hSig = ContextKES (KES c)
-> Word
-> HeaderBody c
-> UnsoundPureSignKeyKES (KES c)
-> SignedKES (KES c) (HeaderBody c)
forall v a.
(UnsoundPureKESAlgorithm v, Signable v a) =>
ContextKES v
-> Word -> a -> UnsoundPureSignKeyKES v -> SignedKES v a
unsoundPureSignedKES () Word
period HeaderBody c
hBody UnsoundPureSignKeyKES (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 (KES crypto) (HeaderBody crypto) -> Header crypto
Header HeaderBody c
hBody SignedKES (KES c) (HeaderBody c)
hSig

instance Arbitrary PraosState where
  arbitrary :: Gen PraosState
arbitrary = WithOrigin SlotNo
-> Map (KeyHash 'BlockIssuer) Word64
-> Nonce
-> Nonce
-> Nonce
-> Nonce
-> Nonce
-> PraosState
PraosState
    (WithOrigin SlotNo
 -> Map (KeyHash 'BlockIssuer) Word64
 -> Nonce
 -> Nonce
 -> Nonce
 -> Nonce
 -> Nonce
 -> PraosState)
-> Gen (WithOrigin SlotNo)
-> Gen
     (Map (KeyHash 'BlockIssuer) Word64
      -> Nonce -> Nonce -> Nonce -> Nonce -> Nonce -> PraosState)
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) Word64
   -> Nonce -> Nonce -> Nonce -> Nonce -> Nonce -> PraosState)
-> Gen (Map (KeyHash 'BlockIssuer) Word64)
-> Gen (Nonce -> Nonce -> Nonce -> Nonce -> Nonce -> PraosState)
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) Word64)
forall a. Arbitrary a => Gen a
arbitrary
    Gen (Nonce -> Nonce -> Nonce -> Nonce -> Nonce -> PraosState)
-> Gen Nonce
-> Gen (Nonce -> Nonce -> Nonce -> Nonce -> PraosState)
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)
-> Gen Nonce -> Gen (Nonce -> Nonce -> Nonce -> PraosState)
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)
-> Gen Nonce -> Gen (Nonce -> Nonce -> PraosState)
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)
-> Gen Nonce -> Gen (Nonce -> PraosState)
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) -> Gen Nonce -> Gen PraosState
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