module Test.Cardano.Chain.Update.Gen (
  genCanonicalProtocolParameters,
  genApplicationName,
  genError,
  genProtocolVersion,
  genProtocolParameters,
  genProtocolParametersUpdate,
  genSoftforkRule,
  genSoftwareVersion,
  genSystemTag,
  genInstallerHash,
  genPayload,
  genProof,
  genProposal,
  genProposalBody,
  genUpId,
  genUpsData,
  genVote,
) where

import Cardano.Chain.Slotting (SlotNumber (..))
import Cardano.Chain.Update (
  ApplicationName (..),
  ApplicationNameError (..),
  InstallerHash (..),
  Payload,
  Proof,
  Proposal,
  ProposalBody (..),
  ProtocolParameters (..),
  ProtocolParametersUpdate (..),
  ProtocolVersion (..),
  SoftforkRule (..),
  SoftwareVersion (..),
  SoftwareVersionError (..),
  SystemTag (..),
  SystemTagError (..),
  UpId,
  Vote,
  applicationNameMaxLength,
  mkVote,
  payload,
  systemTagMaxLength,
  unsafeProposal,
 )
import qualified Cardano.Chain.Update.Validation.Endorsement as Endorsement
import Cardano.Chain.Update.Validation.Interface (Error (..))
import qualified Cardano.Chain.Update.Validation.Registration as Registration
import qualified Cardano.Chain.Update.Validation.Voting as Voting
import Cardano.Crypto (ProtocolMagicId)
import Cardano.Prelude
import Hedgehog
import qualified Hedgehog.Gen as Gen
import qualified Hedgehog.Range as Range
import Test.Cardano.Chain.Common.Gen (
  genCanonicalTxFeePolicy,
  genKeyHash,
  genLovelacePortion,
  genScriptVersion,
  genTxFeePolicy,
 )
import Test.Cardano.Chain.Slotting.Gen (
  genEpochNumber,
  genSlotNumber,
 )
import Test.Cardano.Crypto.Gen (
  genAbstractHash,
  genHashRaw,
  genSignature,
  genSigningKey,
  genVerificationKey,
 )
import Test.Cardano.Prelude

genApplicationName :: Gen ApplicationName
genApplicationName :: Gen ApplicationName
genApplicationName =
  Text -> ApplicationName
ApplicationName
    (Text -> ApplicationName)
-> GenT Identity Text -> Gen ApplicationName
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Range Int -> GenT Identity Char -> GenT Identity Text
forall (m :: * -> *). MonadGen m => Range Int -> m Char -> m Text
Gen.text (Int -> Int -> Range Int
forall a. a -> a -> Range a
Range.constant Int
0 Int
forall i. Integral i => i
applicationNameMaxLength) GenT Identity Char
forall (m :: * -> *). MonadGen m => m Char
Gen.alphaNum

genCanonicalProtocolParameters :: Gen ProtocolParameters
genCanonicalProtocolParameters :: Gen ProtocolParameters
genCanonicalProtocolParameters =
  Word16
-> Natural
-> Natural
-> Natural
-> Natural
-> Natural
-> LovelacePortion
-> LovelacePortion
-> LovelacePortion
-> LovelacePortion
-> SlotNumber
-> SoftforkRule
-> TxFeePolicy
-> EpochNumber
-> ProtocolParameters
ProtocolParameters
    (Word16
 -> Natural
 -> Natural
 -> Natural
 -> Natural
 -> Natural
 -> LovelacePortion
 -> LovelacePortion
 -> LovelacePortion
 -> LovelacePortion
 -> SlotNumber
 -> SoftforkRule
 -> TxFeePolicy
 -> EpochNumber
 -> ProtocolParameters)
-> GenT Identity Word16
-> GenT
     Identity
     (Natural
      -> Natural
      -> Natural
      -> Natural
      -> Natural
      -> LovelacePortion
      -> LovelacePortion
      -> LovelacePortion
      -> LovelacePortion
      -> SlotNumber
      -> SoftforkRule
      -> TxFeePolicy
      -> EpochNumber
      -> ProtocolParameters)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> GenT Identity Word16
genScriptVersion
    GenT
  Identity
  (Natural
   -> Natural
   -> Natural
   -> Natural
   -> Natural
   -> LovelacePortion
   -> LovelacePortion
   -> LovelacePortion
   -> LovelacePortion
   -> SlotNumber
   -> SoftforkRule
   -> TxFeePolicy
   -> EpochNumber
   -> ProtocolParameters)
-> GenT Identity Natural
-> GenT
     Identity
     (Natural
      -> Natural
      -> Natural
      -> Natural
      -> LovelacePortion
      -> LovelacePortion
      -> LovelacePortion
      -> LovelacePortion
      -> SlotNumber
      -> SoftforkRule
      -> TxFeePolicy
      -> EpochNumber
      -> ProtocolParameters)
forall a b.
GenT Identity (a -> b) -> GenT Identity a -> GenT Identity b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> GenT Identity Natural
genNatural
    GenT
  Identity
  (Natural
   -> Natural
   -> Natural
   -> Natural
   -> LovelacePortion
   -> LovelacePortion
   -> LovelacePortion
   -> LovelacePortion
   -> SlotNumber
   -> SoftforkRule
   -> TxFeePolicy
   -> EpochNumber
   -> ProtocolParameters)
-> GenT Identity Natural
-> GenT
     Identity
     (Natural
      -> Natural
      -> Natural
      -> LovelacePortion
      -> LovelacePortion
      -> LovelacePortion
      -> LovelacePortion
      -> SlotNumber
      -> SoftforkRule
      -> TxFeePolicy
      -> EpochNumber
      -> ProtocolParameters)
forall a b.
GenT Identity (a -> b) -> GenT Identity a -> GenT Identity b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> GenT Identity Natural
genNatural
    GenT
  Identity
  (Natural
   -> Natural
   -> Natural
   -> LovelacePortion
   -> LovelacePortion
   -> LovelacePortion
   -> LovelacePortion
   -> SlotNumber
   -> SoftforkRule
   -> TxFeePolicy
   -> EpochNumber
   -> ProtocolParameters)
-> GenT Identity Natural
-> GenT
     Identity
     (Natural
      -> Natural
      -> LovelacePortion
      -> LovelacePortion
      -> LovelacePortion
      -> LovelacePortion
      -> SlotNumber
      -> SoftforkRule
      -> TxFeePolicy
      -> EpochNumber
      -> ProtocolParameters)
forall a b.
GenT Identity (a -> b) -> GenT Identity a -> GenT Identity b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> GenT Identity Natural
genNatural
    GenT
  Identity
  (Natural
   -> Natural
   -> LovelacePortion
   -> LovelacePortion
   -> LovelacePortion
   -> LovelacePortion
   -> SlotNumber
   -> SoftforkRule
   -> TxFeePolicy
   -> EpochNumber
   -> ProtocolParameters)
-> GenT Identity Natural
-> GenT
     Identity
     (Natural
      -> LovelacePortion
      -> LovelacePortion
      -> LovelacePortion
      -> LovelacePortion
      -> SlotNumber
      -> SoftforkRule
      -> TxFeePolicy
      -> EpochNumber
      -> ProtocolParameters)
forall a b.
GenT Identity (a -> b) -> GenT Identity a -> GenT Identity b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> GenT Identity Natural
genNatural
    GenT
  Identity
  (Natural
   -> LovelacePortion
   -> LovelacePortion
   -> LovelacePortion
   -> LovelacePortion
   -> SlotNumber
   -> SoftforkRule
   -> TxFeePolicy
   -> EpochNumber
   -> ProtocolParameters)
-> GenT Identity Natural
-> GenT
     Identity
     (LovelacePortion
      -> LovelacePortion
      -> LovelacePortion
      -> LovelacePortion
      -> SlotNumber
      -> SoftforkRule
      -> TxFeePolicy
      -> EpochNumber
      -> ProtocolParameters)
forall a b.
GenT Identity (a -> b) -> GenT Identity a -> GenT Identity b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> GenT Identity Natural
genNatural
    GenT
  Identity
  (LovelacePortion
   -> LovelacePortion
   -> LovelacePortion
   -> LovelacePortion
   -> SlotNumber
   -> SoftforkRule
   -> TxFeePolicy
   -> EpochNumber
   -> ProtocolParameters)
-> GenT Identity LovelacePortion
-> GenT
     Identity
     (LovelacePortion
      -> LovelacePortion
      -> LovelacePortion
      -> SlotNumber
      -> SoftforkRule
      -> TxFeePolicy
      -> EpochNumber
      -> ProtocolParameters)
forall a b.
GenT Identity (a -> b) -> GenT Identity a -> GenT Identity b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> GenT Identity LovelacePortion
genLovelacePortion
    GenT
  Identity
  (LovelacePortion
   -> LovelacePortion
   -> LovelacePortion
   -> SlotNumber
   -> SoftforkRule
   -> TxFeePolicy
   -> EpochNumber
   -> ProtocolParameters)
-> GenT Identity LovelacePortion
-> GenT
     Identity
     (LovelacePortion
      -> LovelacePortion
      -> SlotNumber
      -> SoftforkRule
      -> TxFeePolicy
      -> EpochNumber
      -> ProtocolParameters)
forall a b.
GenT Identity (a -> b) -> GenT Identity a -> GenT Identity b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> GenT Identity LovelacePortion
genLovelacePortion
    GenT
  Identity
  (LovelacePortion
   -> LovelacePortion
   -> SlotNumber
   -> SoftforkRule
   -> TxFeePolicy
   -> EpochNumber
   -> ProtocolParameters)
-> GenT Identity LovelacePortion
-> GenT
     Identity
     (LovelacePortion
      -> SlotNumber
      -> SoftforkRule
      -> TxFeePolicy
      -> EpochNumber
      -> ProtocolParameters)
forall a b.
GenT Identity (a -> b) -> GenT Identity a -> GenT Identity b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> GenT Identity LovelacePortion
genLovelacePortion
    GenT
  Identity
  (LovelacePortion
   -> SlotNumber
   -> SoftforkRule
   -> TxFeePolicy
   -> EpochNumber
   -> ProtocolParameters)
-> GenT Identity LovelacePortion
-> GenT
     Identity
     (SlotNumber
      -> SoftforkRule
      -> TxFeePolicy
      -> EpochNumber
      -> ProtocolParameters)
forall a b.
GenT Identity (a -> b) -> GenT Identity a -> GenT Identity b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> GenT Identity LovelacePortion
genLovelacePortion
    GenT
  Identity
  (SlotNumber
   -> SoftforkRule
   -> TxFeePolicy
   -> EpochNumber
   -> ProtocolParameters)
-> GenT Identity SlotNumber
-> GenT
     Identity
     (SoftforkRule -> TxFeePolicy -> EpochNumber -> ProtocolParameters)
forall a b.
GenT Identity (a -> b) -> GenT Identity a -> GenT Identity b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> GenT Identity SlotNumber
genSlotNumber
    GenT
  Identity
  (SoftforkRule -> TxFeePolicy -> EpochNumber -> ProtocolParameters)
-> GenT Identity SoftforkRule
-> GenT Identity (TxFeePolicy -> EpochNumber -> ProtocolParameters)
forall a b.
GenT Identity (a -> b) -> GenT Identity a -> GenT Identity b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> GenT Identity SoftforkRule
genSoftforkRule
    GenT Identity (TxFeePolicy -> EpochNumber -> ProtocolParameters)
-> GenT Identity TxFeePolicy
-> GenT Identity (EpochNumber -> ProtocolParameters)
forall a b.
GenT Identity (a -> b) -> GenT Identity a -> GenT Identity b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> GenT Identity TxFeePolicy
genCanonicalTxFeePolicy
    GenT Identity (EpochNumber -> ProtocolParameters)
-> GenT Identity EpochNumber -> Gen ProtocolParameters
forall a b.
GenT Identity (a -> b) -> GenT Identity a -> GenT Identity b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> GenT Identity EpochNumber
genEpochNumber

genProtocolVersion :: Gen ProtocolVersion
genProtocolVersion :: Gen ProtocolVersion
genProtocolVersion =
  Word16 -> Word16 -> Word8 -> ProtocolVersion
ProtocolVersion
    (Word16 -> Word16 -> Word8 -> ProtocolVersion)
-> GenT Identity Word16
-> GenT Identity (Word16 -> Word8 -> ProtocolVersion)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Range Word16 -> GenT Identity Word16
forall (m :: * -> *). MonadGen m => Range Word16 -> m Word16
Gen.word16 Range Word16
forall a. (Bounded a, Num a) => Range a
Range.constantBounded
    GenT Identity (Word16 -> Word8 -> ProtocolVersion)
-> GenT Identity Word16 -> GenT Identity (Word8 -> ProtocolVersion)
forall a b.
GenT Identity (a -> b) -> GenT Identity a -> GenT Identity b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Range Word16 -> GenT Identity Word16
forall (m :: * -> *). MonadGen m => Range Word16 -> m Word16
Gen.word16 Range Word16
forall a. (Bounded a, Num a) => Range a
Range.constantBounded
    GenT Identity (Word8 -> ProtocolVersion)
-> GenT Identity Word8 -> Gen ProtocolVersion
forall a b.
GenT Identity (a -> b) -> GenT Identity a -> GenT Identity b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Range Word8 -> GenT Identity Word8
forall (m :: * -> *). MonadGen m => Range Word8 -> m Word8
Gen.word8 Range Word8
forall a. (Bounded a, Num a) => Range a
Range.constantBounded

genProtocolParameters :: Gen ProtocolParameters
genProtocolParameters :: Gen ProtocolParameters
genProtocolParameters =
  Word16
-> Natural
-> Natural
-> Natural
-> Natural
-> Natural
-> LovelacePortion
-> LovelacePortion
-> LovelacePortion
-> LovelacePortion
-> SlotNumber
-> SoftforkRule
-> TxFeePolicy
-> EpochNumber
-> ProtocolParameters
ProtocolParameters
    (Word16
 -> Natural
 -> Natural
 -> Natural
 -> Natural
 -> Natural
 -> LovelacePortion
 -> LovelacePortion
 -> LovelacePortion
 -> LovelacePortion
 -> SlotNumber
 -> SoftforkRule
 -> TxFeePolicy
 -> EpochNumber
 -> ProtocolParameters)
-> GenT Identity Word16
-> GenT
     Identity
     (Natural
      -> Natural
      -> Natural
      -> Natural
      -> Natural
      -> LovelacePortion
      -> LovelacePortion
      -> LovelacePortion
      -> LovelacePortion
      -> SlotNumber
      -> SoftforkRule
      -> TxFeePolicy
      -> EpochNumber
      -> ProtocolParameters)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> GenT Identity Word16
genScriptVersion
    GenT
  Identity
  (Natural
   -> Natural
   -> Natural
   -> Natural
   -> Natural
   -> LovelacePortion
   -> LovelacePortion
   -> LovelacePortion
   -> LovelacePortion
   -> SlotNumber
   -> SoftforkRule
   -> TxFeePolicy
   -> EpochNumber
   -> ProtocolParameters)
-> GenT Identity Natural
-> GenT
     Identity
     (Natural
      -> Natural
      -> Natural
      -> Natural
      -> LovelacePortion
      -> LovelacePortion
      -> LovelacePortion
      -> LovelacePortion
      -> SlotNumber
      -> SoftforkRule
      -> TxFeePolicy
      -> EpochNumber
      -> ProtocolParameters)
forall a b.
GenT Identity (a -> b) -> GenT Identity a -> GenT Identity b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> GenT Identity Natural
genNatural
    GenT
  Identity
  (Natural
   -> Natural
   -> Natural
   -> Natural
   -> LovelacePortion
   -> LovelacePortion
   -> LovelacePortion
   -> LovelacePortion
   -> SlotNumber
   -> SoftforkRule
   -> TxFeePolicy
   -> EpochNumber
   -> ProtocolParameters)
-> GenT Identity Natural
-> GenT
     Identity
     (Natural
      -> Natural
      -> Natural
      -> LovelacePortion
      -> LovelacePortion
      -> LovelacePortion
      -> LovelacePortion
      -> SlotNumber
      -> SoftforkRule
      -> TxFeePolicy
      -> EpochNumber
      -> ProtocolParameters)
forall a b.
GenT Identity (a -> b) -> GenT Identity a -> GenT Identity b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> GenT Identity Natural
genNatural
    GenT
  Identity
  (Natural
   -> Natural
   -> Natural
   -> LovelacePortion
   -> LovelacePortion
   -> LovelacePortion
   -> LovelacePortion
   -> SlotNumber
   -> SoftforkRule
   -> TxFeePolicy
   -> EpochNumber
   -> ProtocolParameters)
-> GenT Identity Natural
-> GenT
     Identity
     (Natural
      -> Natural
      -> LovelacePortion
      -> LovelacePortion
      -> LovelacePortion
      -> LovelacePortion
      -> SlotNumber
      -> SoftforkRule
      -> TxFeePolicy
      -> EpochNumber
      -> ProtocolParameters)
forall a b.
GenT Identity (a -> b) -> GenT Identity a -> GenT Identity b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> GenT Identity Natural
genNatural
    GenT
  Identity
  (Natural
   -> Natural
   -> LovelacePortion
   -> LovelacePortion
   -> LovelacePortion
   -> LovelacePortion
   -> SlotNumber
   -> SoftforkRule
   -> TxFeePolicy
   -> EpochNumber
   -> ProtocolParameters)
-> GenT Identity Natural
-> GenT
     Identity
     (Natural
      -> LovelacePortion
      -> LovelacePortion
      -> LovelacePortion
      -> LovelacePortion
      -> SlotNumber
      -> SoftforkRule
      -> TxFeePolicy
      -> EpochNumber
      -> ProtocolParameters)
forall a b.
GenT Identity (a -> b) -> GenT Identity a -> GenT Identity b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> GenT Identity Natural
genNatural
    GenT
  Identity
  (Natural
   -> LovelacePortion
   -> LovelacePortion
   -> LovelacePortion
   -> LovelacePortion
   -> SlotNumber
   -> SoftforkRule
   -> TxFeePolicy
   -> EpochNumber
   -> ProtocolParameters)
-> GenT Identity Natural
-> GenT
     Identity
     (LovelacePortion
      -> LovelacePortion
      -> LovelacePortion
      -> LovelacePortion
      -> SlotNumber
      -> SoftforkRule
      -> TxFeePolicy
      -> EpochNumber
      -> ProtocolParameters)
forall a b.
GenT Identity (a -> b) -> GenT Identity a -> GenT Identity b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> GenT Identity Natural
genNatural
    GenT
  Identity
  (LovelacePortion
   -> LovelacePortion
   -> LovelacePortion
   -> LovelacePortion
   -> SlotNumber
   -> SoftforkRule
   -> TxFeePolicy
   -> EpochNumber
   -> ProtocolParameters)
-> GenT Identity LovelacePortion
-> GenT
     Identity
     (LovelacePortion
      -> LovelacePortion
      -> LovelacePortion
      -> SlotNumber
      -> SoftforkRule
      -> TxFeePolicy
      -> EpochNumber
      -> ProtocolParameters)
forall a b.
GenT Identity (a -> b) -> GenT Identity a -> GenT Identity b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> GenT Identity LovelacePortion
genLovelacePortion
    GenT
  Identity
  (LovelacePortion
   -> LovelacePortion
   -> LovelacePortion
   -> SlotNumber
   -> SoftforkRule
   -> TxFeePolicy
   -> EpochNumber
   -> ProtocolParameters)
-> GenT Identity LovelacePortion
-> GenT
     Identity
     (LovelacePortion
      -> LovelacePortion
      -> SlotNumber
      -> SoftforkRule
      -> TxFeePolicy
      -> EpochNumber
      -> ProtocolParameters)
forall a b.
GenT Identity (a -> b) -> GenT Identity a -> GenT Identity b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> GenT Identity LovelacePortion
genLovelacePortion
    GenT
  Identity
  (LovelacePortion
   -> LovelacePortion
   -> SlotNumber
   -> SoftforkRule
   -> TxFeePolicy
   -> EpochNumber
   -> ProtocolParameters)
-> GenT Identity LovelacePortion
-> GenT
     Identity
     (LovelacePortion
      -> SlotNumber
      -> SoftforkRule
      -> TxFeePolicy
      -> EpochNumber
      -> ProtocolParameters)
forall a b.
GenT Identity (a -> b) -> GenT Identity a -> GenT Identity b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> GenT Identity LovelacePortion
genLovelacePortion
    GenT
  Identity
  (LovelacePortion
   -> SlotNumber
   -> SoftforkRule
   -> TxFeePolicy
   -> EpochNumber
   -> ProtocolParameters)
-> GenT Identity LovelacePortion
-> GenT
     Identity
     (SlotNumber
      -> SoftforkRule
      -> TxFeePolicy
      -> EpochNumber
      -> ProtocolParameters)
forall a b.
GenT Identity (a -> b) -> GenT Identity a -> GenT Identity b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> GenT Identity LovelacePortion
genLovelacePortion
    GenT
  Identity
  (SlotNumber
   -> SoftforkRule
   -> TxFeePolicy
   -> EpochNumber
   -> ProtocolParameters)
-> GenT Identity SlotNumber
-> GenT
     Identity
     (SoftforkRule -> TxFeePolicy -> EpochNumber -> ProtocolParameters)
forall a b.
GenT Identity (a -> b) -> GenT Identity a -> GenT Identity b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> GenT Identity SlotNumber
genSlotNumber
    GenT
  Identity
  (SoftforkRule -> TxFeePolicy -> EpochNumber -> ProtocolParameters)
-> GenT Identity SoftforkRule
-> GenT Identity (TxFeePolicy -> EpochNumber -> ProtocolParameters)
forall a b.
GenT Identity (a -> b) -> GenT Identity a -> GenT Identity b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> GenT Identity SoftforkRule
genSoftforkRule
    GenT Identity (TxFeePolicy -> EpochNumber -> ProtocolParameters)
-> GenT Identity TxFeePolicy
-> GenT Identity (EpochNumber -> ProtocolParameters)
forall a b.
GenT Identity (a -> b) -> GenT Identity a -> GenT Identity b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> GenT Identity TxFeePolicy
genTxFeePolicy
    GenT Identity (EpochNumber -> ProtocolParameters)
-> GenT Identity EpochNumber -> Gen ProtocolParameters
forall a b.
GenT Identity (a -> b) -> GenT Identity a -> GenT Identity b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> GenT Identity EpochNumber
genEpochNumber

genProtocolParametersUpdate :: Gen ProtocolParametersUpdate
genProtocolParametersUpdate :: Gen ProtocolParametersUpdate
genProtocolParametersUpdate =
  Maybe Word16
-> Maybe Natural
-> Maybe Natural
-> Maybe Natural
-> Maybe Natural
-> Maybe Natural
-> Maybe LovelacePortion
-> Maybe LovelacePortion
-> Maybe LovelacePortion
-> Maybe LovelacePortion
-> Maybe SlotNumber
-> Maybe SoftforkRule
-> Maybe TxFeePolicy
-> Maybe EpochNumber
-> ProtocolParametersUpdate
ProtocolParametersUpdate
    (Maybe Word16
 -> Maybe Natural
 -> Maybe Natural
 -> Maybe Natural
 -> Maybe Natural
 -> Maybe Natural
 -> Maybe LovelacePortion
 -> Maybe LovelacePortion
 -> Maybe LovelacePortion
 -> Maybe LovelacePortion
 -> Maybe SlotNumber
 -> Maybe SoftforkRule
 -> Maybe TxFeePolicy
 -> Maybe EpochNumber
 -> ProtocolParametersUpdate)
-> GenT Identity (Maybe Word16)
-> GenT
     Identity
     (Maybe Natural
      -> Maybe Natural
      -> Maybe Natural
      -> Maybe Natural
      -> Maybe Natural
      -> Maybe LovelacePortion
      -> Maybe LovelacePortion
      -> Maybe LovelacePortion
      -> Maybe LovelacePortion
      -> Maybe SlotNumber
      -> Maybe SoftforkRule
      -> Maybe TxFeePolicy
      -> Maybe EpochNumber
      -> ProtocolParametersUpdate)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> GenT Identity Word16 -> GenT Identity (Maybe Word16)
forall (m :: * -> *) a. MonadGen m => m a -> m (Maybe a)
Gen.maybe GenT Identity Word16
genScriptVersion
    GenT
  Identity
  (Maybe Natural
   -> Maybe Natural
   -> Maybe Natural
   -> Maybe Natural
   -> Maybe Natural
   -> Maybe LovelacePortion
   -> Maybe LovelacePortion
   -> Maybe LovelacePortion
   -> Maybe LovelacePortion
   -> Maybe SlotNumber
   -> Maybe SoftforkRule
   -> Maybe TxFeePolicy
   -> Maybe EpochNumber
   -> ProtocolParametersUpdate)
-> GenT Identity (Maybe Natural)
-> GenT
     Identity
     (Maybe Natural
      -> Maybe Natural
      -> Maybe Natural
      -> Maybe Natural
      -> Maybe LovelacePortion
      -> Maybe LovelacePortion
      -> Maybe LovelacePortion
      -> Maybe LovelacePortion
      -> Maybe SlotNumber
      -> Maybe SoftforkRule
      -> Maybe TxFeePolicy
      -> Maybe EpochNumber
      -> ProtocolParametersUpdate)
forall a b.
GenT Identity (a -> b) -> GenT Identity a -> GenT Identity b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> GenT Identity Natural -> GenT Identity (Maybe Natural)
forall (m :: * -> *) a. MonadGen m => m a -> m (Maybe a)
Gen.maybe GenT Identity Natural
genNatural
    GenT
  Identity
  (Maybe Natural
   -> Maybe Natural
   -> Maybe Natural
   -> Maybe Natural
   -> Maybe LovelacePortion
   -> Maybe LovelacePortion
   -> Maybe LovelacePortion
   -> Maybe LovelacePortion
   -> Maybe SlotNumber
   -> Maybe SoftforkRule
   -> Maybe TxFeePolicy
   -> Maybe EpochNumber
   -> ProtocolParametersUpdate)
-> GenT Identity (Maybe Natural)
-> GenT
     Identity
     (Maybe Natural
      -> Maybe Natural
      -> Maybe Natural
      -> Maybe LovelacePortion
      -> Maybe LovelacePortion
      -> Maybe LovelacePortion
      -> Maybe LovelacePortion
      -> Maybe SlotNumber
      -> Maybe SoftforkRule
      -> Maybe TxFeePolicy
      -> Maybe EpochNumber
      -> ProtocolParametersUpdate)
forall a b.
GenT Identity (a -> b) -> GenT Identity a -> GenT Identity b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> GenT Identity Natural -> GenT Identity (Maybe Natural)
forall (m :: * -> *) a. MonadGen m => m a -> m (Maybe a)
Gen.maybe GenT Identity Natural
genNatural
    GenT
  Identity
  (Maybe Natural
   -> Maybe Natural
   -> Maybe Natural
   -> Maybe LovelacePortion
   -> Maybe LovelacePortion
   -> Maybe LovelacePortion
   -> Maybe LovelacePortion
   -> Maybe SlotNumber
   -> Maybe SoftforkRule
   -> Maybe TxFeePolicy
   -> Maybe EpochNumber
   -> ProtocolParametersUpdate)
-> GenT Identity (Maybe Natural)
-> GenT
     Identity
     (Maybe Natural
      -> Maybe Natural
      -> Maybe LovelacePortion
      -> Maybe LovelacePortion
      -> Maybe LovelacePortion
      -> Maybe LovelacePortion
      -> Maybe SlotNumber
      -> Maybe SoftforkRule
      -> Maybe TxFeePolicy
      -> Maybe EpochNumber
      -> ProtocolParametersUpdate)
forall a b.
GenT Identity (a -> b) -> GenT Identity a -> GenT Identity b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> GenT Identity Natural -> GenT Identity (Maybe Natural)
forall (m :: * -> *) a. MonadGen m => m a -> m (Maybe a)
Gen.maybe GenT Identity Natural
genNatural
    GenT
  Identity
  (Maybe Natural
   -> Maybe Natural
   -> Maybe LovelacePortion
   -> Maybe LovelacePortion
   -> Maybe LovelacePortion
   -> Maybe LovelacePortion
   -> Maybe SlotNumber
   -> Maybe SoftforkRule
   -> Maybe TxFeePolicy
   -> Maybe EpochNumber
   -> ProtocolParametersUpdate)
-> GenT Identity (Maybe Natural)
-> GenT
     Identity
     (Maybe Natural
      -> Maybe LovelacePortion
      -> Maybe LovelacePortion
      -> Maybe LovelacePortion
      -> Maybe LovelacePortion
      -> Maybe SlotNumber
      -> Maybe SoftforkRule
      -> Maybe TxFeePolicy
      -> Maybe EpochNumber
      -> ProtocolParametersUpdate)
forall a b.
GenT Identity (a -> b) -> GenT Identity a -> GenT Identity b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> GenT Identity Natural -> GenT Identity (Maybe Natural)
forall (m :: * -> *) a. MonadGen m => m a -> m (Maybe a)
Gen.maybe GenT Identity Natural
genNatural
    GenT
  Identity
  (Maybe Natural
   -> Maybe LovelacePortion
   -> Maybe LovelacePortion
   -> Maybe LovelacePortion
   -> Maybe LovelacePortion
   -> Maybe SlotNumber
   -> Maybe SoftforkRule
   -> Maybe TxFeePolicy
   -> Maybe EpochNumber
   -> ProtocolParametersUpdate)
-> GenT Identity (Maybe Natural)
-> GenT
     Identity
     (Maybe LovelacePortion
      -> Maybe LovelacePortion
      -> Maybe LovelacePortion
      -> Maybe LovelacePortion
      -> Maybe SlotNumber
      -> Maybe SoftforkRule
      -> Maybe TxFeePolicy
      -> Maybe EpochNumber
      -> ProtocolParametersUpdate)
forall a b.
GenT Identity (a -> b) -> GenT Identity a -> GenT Identity b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> GenT Identity Natural -> GenT Identity (Maybe Natural)
forall (m :: * -> *) a. MonadGen m => m a -> m (Maybe a)
Gen.maybe GenT Identity Natural
genNatural
    GenT
  Identity
  (Maybe LovelacePortion
   -> Maybe LovelacePortion
   -> Maybe LovelacePortion
   -> Maybe LovelacePortion
   -> Maybe SlotNumber
   -> Maybe SoftforkRule
   -> Maybe TxFeePolicy
   -> Maybe EpochNumber
   -> ProtocolParametersUpdate)
-> GenT Identity (Maybe LovelacePortion)
-> GenT
     Identity
     (Maybe LovelacePortion
      -> Maybe LovelacePortion
      -> Maybe LovelacePortion
      -> Maybe SlotNumber
      -> Maybe SoftforkRule
      -> Maybe TxFeePolicy
      -> Maybe EpochNumber
      -> ProtocolParametersUpdate)
forall a b.
GenT Identity (a -> b) -> GenT Identity a -> GenT Identity b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> GenT Identity LovelacePortion
-> GenT Identity (Maybe LovelacePortion)
forall (m :: * -> *) a. MonadGen m => m a -> m (Maybe a)
Gen.maybe GenT Identity LovelacePortion
genLovelacePortion
    GenT
  Identity
  (Maybe LovelacePortion
   -> Maybe LovelacePortion
   -> Maybe LovelacePortion
   -> Maybe SlotNumber
   -> Maybe SoftforkRule
   -> Maybe TxFeePolicy
   -> Maybe EpochNumber
   -> ProtocolParametersUpdate)
-> GenT Identity (Maybe LovelacePortion)
-> GenT
     Identity
     (Maybe LovelacePortion
      -> Maybe LovelacePortion
      -> Maybe SlotNumber
      -> Maybe SoftforkRule
      -> Maybe TxFeePolicy
      -> Maybe EpochNumber
      -> ProtocolParametersUpdate)
forall a b.
GenT Identity (a -> b) -> GenT Identity a -> GenT Identity b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> GenT Identity LovelacePortion
-> GenT Identity (Maybe LovelacePortion)
forall (m :: * -> *) a. MonadGen m => m a -> m (Maybe a)
Gen.maybe GenT Identity LovelacePortion
genLovelacePortion
    GenT
  Identity
  (Maybe LovelacePortion
   -> Maybe LovelacePortion
   -> Maybe SlotNumber
   -> Maybe SoftforkRule
   -> Maybe TxFeePolicy
   -> Maybe EpochNumber
   -> ProtocolParametersUpdate)
-> GenT Identity (Maybe LovelacePortion)
-> GenT
     Identity
     (Maybe LovelacePortion
      -> Maybe SlotNumber
      -> Maybe SoftforkRule
      -> Maybe TxFeePolicy
      -> Maybe EpochNumber
      -> ProtocolParametersUpdate)
forall a b.
GenT Identity (a -> b) -> GenT Identity a -> GenT Identity b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> GenT Identity LovelacePortion
-> GenT Identity (Maybe LovelacePortion)
forall (m :: * -> *) a. MonadGen m => m a -> m (Maybe a)
Gen.maybe GenT Identity LovelacePortion
genLovelacePortion
    GenT
  Identity
  (Maybe LovelacePortion
   -> Maybe SlotNumber
   -> Maybe SoftforkRule
   -> Maybe TxFeePolicy
   -> Maybe EpochNumber
   -> ProtocolParametersUpdate)
-> GenT Identity (Maybe LovelacePortion)
-> GenT
     Identity
     (Maybe SlotNumber
      -> Maybe SoftforkRule
      -> Maybe TxFeePolicy
      -> Maybe EpochNumber
      -> ProtocolParametersUpdate)
forall a b.
GenT Identity (a -> b) -> GenT Identity a -> GenT Identity b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> GenT Identity LovelacePortion
-> GenT Identity (Maybe LovelacePortion)
forall (m :: * -> *) a. MonadGen m => m a -> m (Maybe a)
Gen.maybe GenT Identity LovelacePortion
genLovelacePortion
    GenT
  Identity
  (Maybe SlotNumber
   -> Maybe SoftforkRule
   -> Maybe TxFeePolicy
   -> Maybe EpochNumber
   -> ProtocolParametersUpdate)
-> GenT Identity (Maybe SlotNumber)
-> GenT
     Identity
     (Maybe SoftforkRule
      -> Maybe TxFeePolicy
      -> Maybe EpochNumber
      -> ProtocolParametersUpdate)
forall a b.
GenT Identity (a -> b) -> GenT Identity a -> GenT Identity b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> GenT Identity SlotNumber -> GenT Identity (Maybe SlotNumber)
forall (m :: * -> *) a. MonadGen m => m a -> m (Maybe a)
Gen.maybe GenT Identity SlotNumber
genSlotNumber
    GenT
  Identity
  (Maybe SoftforkRule
   -> Maybe TxFeePolicy
   -> Maybe EpochNumber
   -> ProtocolParametersUpdate)
-> GenT Identity (Maybe SoftforkRule)
-> GenT
     Identity
     (Maybe TxFeePolicy
      -> Maybe EpochNumber -> ProtocolParametersUpdate)
forall a b.
GenT Identity (a -> b) -> GenT Identity a -> GenT Identity b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> GenT Identity SoftforkRule -> GenT Identity (Maybe SoftforkRule)
forall (m :: * -> *) a. MonadGen m => m a -> m (Maybe a)
Gen.maybe GenT Identity SoftforkRule
genSoftforkRule
    GenT
  Identity
  (Maybe TxFeePolicy
   -> Maybe EpochNumber -> ProtocolParametersUpdate)
-> GenT Identity (Maybe TxFeePolicy)
-> GenT Identity (Maybe EpochNumber -> ProtocolParametersUpdate)
forall a b.
GenT Identity (a -> b) -> GenT Identity a -> GenT Identity b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> GenT Identity TxFeePolicy -> GenT Identity (Maybe TxFeePolicy)
forall (m :: * -> *) a. MonadGen m => m a -> m (Maybe a)
Gen.maybe GenT Identity TxFeePolicy
genTxFeePolicy
    GenT Identity (Maybe EpochNumber -> ProtocolParametersUpdate)
-> GenT Identity (Maybe EpochNumber)
-> Gen ProtocolParametersUpdate
forall a b.
GenT Identity (a -> b) -> GenT Identity a -> GenT Identity b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> GenT Identity EpochNumber -> GenT Identity (Maybe EpochNumber)
forall (m :: * -> *) a. MonadGen m => m a -> m (Maybe a)
Gen.maybe GenT Identity EpochNumber
genEpochNumber

genSoftforkRule :: Gen SoftforkRule
genSoftforkRule :: GenT Identity SoftforkRule
genSoftforkRule =
  LovelacePortion
-> LovelacePortion -> LovelacePortion -> SoftforkRule
SoftforkRule
    (LovelacePortion
 -> LovelacePortion -> LovelacePortion -> SoftforkRule)
-> GenT Identity LovelacePortion
-> GenT
     Identity (LovelacePortion -> LovelacePortion -> SoftforkRule)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> GenT Identity LovelacePortion
genLovelacePortion
    GenT Identity (LovelacePortion -> LovelacePortion -> SoftforkRule)
-> GenT Identity LovelacePortion
-> GenT Identity (LovelacePortion -> SoftforkRule)
forall a b.
GenT Identity (a -> b) -> GenT Identity a -> GenT Identity b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> GenT Identity LovelacePortion
genLovelacePortion
    GenT Identity (LovelacePortion -> SoftforkRule)
-> GenT Identity LovelacePortion -> GenT Identity SoftforkRule
forall a b.
GenT Identity (a -> b) -> GenT Identity a -> GenT Identity b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> GenT Identity LovelacePortion
genLovelacePortion

genSoftwareVersion :: Gen SoftwareVersion
genSoftwareVersion :: Gen SoftwareVersion
genSoftwareVersion =
  ApplicationName -> Word32 -> SoftwareVersion
SoftwareVersion (ApplicationName -> Word32 -> SoftwareVersion)
-> Gen ApplicationName -> GenT Identity (Word32 -> SoftwareVersion)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Gen ApplicationName
genApplicationName GenT Identity (Word32 -> SoftwareVersion)
-> GenT Identity Word32 -> Gen SoftwareVersion
forall a b.
GenT Identity (a -> b) -> GenT Identity a -> GenT Identity b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Range Word32 -> GenT Identity Word32
forall (m :: * -> *). MonadGen m => Range Word32 -> m Word32
Gen.word32 Range Word32
forall a. (Bounded a, Num a) => Range a
Range.constantBounded

genSystemTag :: Gen SystemTag
genSystemTag :: Gen SystemTag
genSystemTag =
  Text -> SystemTag
SystemTag (Text -> SystemTag) -> GenT Identity Text -> Gen SystemTag
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Range Int -> GenT Identity Char -> GenT Identity Text
forall (m :: * -> *). MonadGen m => Range Int -> m Char -> m Text
Gen.text (Int -> Int -> Range Int
forall a. a -> a -> Range a
Range.constant Int
0 Int
forall i. Integral i => i
systemTagMaxLength) GenT Identity Char
forall (m :: * -> *). MonadGen m => m Char
Gen.alphaNum

genInstallerHash :: Gen InstallerHash
genInstallerHash :: Gen InstallerHash
genInstallerHash = Hash Raw -> InstallerHash
InstallerHash (Hash Raw -> InstallerHash)
-> GenT Identity (Hash Raw) -> Gen InstallerHash
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> GenT Identity (Hash Raw)
genHashRaw

genPayload :: ProtocolMagicId -> Gen Payload
genPayload :: ProtocolMagicId -> Gen Payload
genPayload ProtocolMagicId
pm =
  Maybe Proposal -> [Vote] -> Payload
payload
    (Maybe Proposal -> [Vote] -> Payload)
-> GenT Identity (Maybe Proposal)
-> GenT Identity ([Vote] -> Payload)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> GenT Identity Proposal -> GenT Identity (Maybe Proposal)
forall (m :: * -> *) a. MonadGen m => m a -> m (Maybe a)
Gen.maybe (ProtocolMagicId -> GenT Identity Proposal
genProposal ProtocolMagicId
pm)
    GenT Identity ([Vote] -> Payload)
-> GenT Identity [Vote] -> Gen Payload
forall a b.
GenT Identity (a -> b) -> GenT Identity a -> GenT Identity b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Range Int -> GenT Identity Vote -> GenT Identity [Vote]
forall (m :: * -> *) a. MonadGen m => Range Int -> m a -> m [a]
Gen.list
      (Int -> Int -> Range Int
forall a. Integral a => a -> a -> Range a
Range.linear Int
0 Int
10)
      (ProtocolMagicId -> GenT Identity Vote
genVote ProtocolMagicId
pm)

genProof :: ProtocolMagicId -> Gen Proof
genProof :: ProtocolMagicId -> Gen Proof
genProof ProtocolMagicId
pm = Gen Payload -> Gen Proof
forall a algo.
(EncCBOR a, HashAlgorithm algo) =>
Gen a -> Gen (AbstractHash algo a)
genAbstractHash (ProtocolMagicId -> Gen Payload
genPayload ProtocolMagicId
pm)

genProposal :: ProtocolMagicId -> Gen Proposal
genProposal :: ProtocolMagicId -> GenT Identity Proposal
genProposal ProtocolMagicId
pm =
  ProposalBody
-> VerificationKey -> Signature ProposalBody -> Proposal
unsafeProposal
    (ProposalBody
 -> VerificationKey -> Signature ProposalBody -> Proposal)
-> GenT Identity ProposalBody
-> GenT
     Identity (VerificationKey -> Signature ProposalBody -> Proposal)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> GenT Identity ProposalBody
genProposalBody
    GenT
  Identity (VerificationKey -> Signature ProposalBody -> Proposal)
-> GenT Identity VerificationKey
-> GenT Identity (Signature ProposalBody -> Proposal)
forall a b.
GenT Identity (a -> b) -> GenT Identity a -> GenT Identity b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> GenT Identity VerificationKey
genVerificationKey
    GenT Identity (Signature ProposalBody -> Proposal)
-> GenT Identity (Signature ProposalBody) -> GenT Identity Proposal
forall a b.
GenT Identity (a -> b) -> GenT Identity a -> GenT Identity b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> ProtocolMagicId
-> GenT Identity ProposalBody
-> GenT Identity (Signature ProposalBody)
forall a.
EncCBOR a =>
ProtocolMagicId -> Gen a -> Gen (Signature a)
genSignature ProtocolMagicId
pm GenT Identity ProposalBody
genProposalBody

genProposalBody :: Gen ProposalBody
genProposalBody :: GenT Identity ProposalBody
genProposalBody =
  ProtocolVersion
-> ProtocolParametersUpdate
-> SoftwareVersion
-> Map SystemTag InstallerHash
-> ProposalBody
ProposalBody
    (ProtocolVersion
 -> ProtocolParametersUpdate
 -> SoftwareVersion
 -> Map SystemTag InstallerHash
 -> ProposalBody)
-> Gen ProtocolVersion
-> GenT
     Identity
     (ProtocolParametersUpdate
      -> SoftwareVersion -> Map SystemTag InstallerHash -> ProposalBody)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Gen ProtocolVersion
genProtocolVersion
    GenT
  Identity
  (ProtocolParametersUpdate
   -> SoftwareVersion -> Map SystemTag InstallerHash -> ProposalBody)
-> Gen ProtocolParametersUpdate
-> GenT
     Identity
     (SoftwareVersion -> Map SystemTag InstallerHash -> ProposalBody)
forall a b.
GenT Identity (a -> b) -> GenT Identity a -> GenT Identity b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Gen ProtocolParametersUpdate
genProtocolParametersUpdate
    GenT
  Identity
  (SoftwareVersion -> Map SystemTag InstallerHash -> ProposalBody)
-> Gen SoftwareVersion
-> GenT Identity (Map SystemTag InstallerHash -> ProposalBody)
forall a b.
GenT Identity (a -> b) -> GenT Identity a -> GenT Identity b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Gen SoftwareVersion
genSoftwareVersion
    GenT Identity (Map SystemTag InstallerHash -> ProposalBody)
-> GenT Identity (Map SystemTag InstallerHash)
-> GenT Identity ProposalBody
forall a b.
GenT Identity (a -> b) -> GenT Identity a -> GenT Identity b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> GenT Identity (Map SystemTag InstallerHash)
genUpsData

genUpId :: ProtocolMagicId -> Gen UpId
genUpId :: ProtocolMagicId -> Gen UpId
genUpId ProtocolMagicId
pm = GenT Identity Proposal -> Gen UpId
forall a algo.
(EncCBOR a, HashAlgorithm algo) =>
Gen a -> Gen (AbstractHash algo a)
genAbstractHash (ProtocolMagicId -> GenT Identity Proposal
genProposal ProtocolMagicId
pm)

genUpsData :: Gen (Map SystemTag InstallerHash)
genUpsData :: GenT Identity (Map SystemTag InstallerHash)
genUpsData =
  Range Int
-> GenT Identity (SystemTag, InstallerHash)
-> GenT Identity (Map SystemTag InstallerHash)
forall (m :: * -> *) k v.
(MonadGen m, Ord k) =>
Range Int -> m (k, v) -> m (Map k v)
Gen.map (Int -> Int -> Range Int
forall a. Integral a => a -> a -> Range a
Range.linear Int
0 Int
20) ((,) (SystemTag -> InstallerHash -> (SystemTag, InstallerHash))
-> Gen SystemTag
-> GenT Identity (InstallerHash -> (SystemTag, InstallerHash))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Gen SystemTag
genSystemTag GenT Identity (InstallerHash -> (SystemTag, InstallerHash))
-> Gen InstallerHash -> GenT Identity (SystemTag, InstallerHash)
forall a b.
GenT Identity (a -> b) -> GenT Identity a -> GenT Identity b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Gen InstallerHash
genInstallerHash)

genVote :: ProtocolMagicId -> Gen Vote
genVote :: ProtocolMagicId -> GenT Identity Vote
genVote ProtocolMagicId
pm = ProtocolMagicId -> SigningKey -> UpId -> Bool -> Vote
mkVote ProtocolMagicId
pm (SigningKey -> UpId -> Bool -> Vote)
-> GenT Identity SigningKey -> GenT Identity (UpId -> Bool -> Vote)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> GenT Identity SigningKey
genSigningKey GenT Identity (UpId -> Bool -> Vote)
-> Gen UpId -> GenT Identity (Bool -> Vote)
forall a b.
GenT Identity (a -> b) -> GenT Identity a -> GenT Identity b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> ProtocolMagicId -> Gen UpId
genUpId ProtocolMagicId
pm GenT Identity (Bool -> Vote)
-> GenT Identity Bool -> GenT Identity Vote
forall a b.
GenT Identity (a -> b) -> GenT Identity a -> GenT Identity b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> GenT Identity Bool
forall (m :: * -> *). MonadGen m => m Bool
Gen.bool

genError :: ProtocolMagicId -> Gen Error
genError :: ProtocolMagicId -> Gen Error
genError ProtocolMagicId
pm =
  [Gen Error] -> Gen Error
forall (m :: * -> *) a. MonadGen m => [m a] -> m a
Gen.choice
    [ Error -> Error
Registration (Error -> Error) -> GenT Identity Error -> Gen Error
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> GenT Identity Error
genRegistrationError
    , Error -> Error
Voting (Error -> Error) -> GenT Identity Error -> Gen Error
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ProtocolMagicId -> GenT Identity Error
genVotingError ProtocolMagicId
pm
    , Error -> Error
Endorsement (Error -> Error) -> GenT Identity Error -> Gen Error
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> GenT Identity Error
genEndorsementError
    , TooLarge Int -> Error
NumberOfGenesisKeysTooLarge (TooLarge Int -> Error)
-> GenT Identity (TooLarge Int) -> Gen Error
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> GenT Identity (TooLarge Int)
genRegistrationTooLarge
    ]

genRegistrationError :: Gen Registration.Error
genRegistrationError :: GenT Identity Error
genRegistrationError =
  [GenT Identity Error] -> GenT Identity Error
forall (m :: * -> *) a. MonadGen m => [m a] -> m a
Gen.choice
    [ ProtocolVersion -> Error
Registration.DuplicateProtocolVersion (ProtocolVersion -> Error)
-> Gen ProtocolVersion -> GenT Identity Error
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Gen ProtocolVersion
genProtocolVersion
    , SoftwareVersion -> Error
Registration.DuplicateSoftwareVersion (SoftwareVersion -> Error)
-> Gen SoftwareVersion -> GenT Identity Error
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Gen SoftwareVersion
genSoftwareVersion
    , KeyHash -> Error
Registration.InvalidProposer (KeyHash -> Error) -> GenT Identity KeyHash -> GenT Identity Error
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> GenT Identity KeyHash
genKeyHash
    , ProtocolVersion -> Adopted -> Error
Registration.InvalidProtocolVersion
        (ProtocolVersion -> Adopted -> Error)
-> Gen ProtocolVersion -> GenT Identity (Adopted -> Error)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Gen ProtocolVersion
genProtocolVersion
        GenT Identity (Adopted -> Error)
-> GenT Identity Adopted -> GenT Identity Error
forall a b.
GenT Identity (a -> b) -> GenT Identity a -> GenT Identity b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (ProtocolVersion -> Adopted
Registration.Adopted (ProtocolVersion -> Adopted)
-> Gen ProtocolVersion -> GenT Identity Adopted
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Gen ProtocolVersion
genProtocolVersion)
    , Word16 -> Word16 -> Error
Registration.InvalidScriptVersion (Word16 -> Word16 -> Error)
-> GenT Identity Word16 -> GenT Identity (Word16 -> Error)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> GenT Identity Word16
genWord16 GenT Identity (Word16 -> Error)
-> GenT Identity Word16 -> GenT Identity Error
forall a b.
GenT Identity (a -> b) -> GenT Identity a -> GenT Identity b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> GenT Identity Word16
genWord16
    , Error -> GenT Identity Error
forall a. a -> GenT Identity a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Error
Registration.InvalidSignature
    , ApplicationVersions -> SoftwareVersion -> Error
Registration.InvalidSoftwareVersion
        (ApplicationVersions -> SoftwareVersion -> Error)
-> GenT Identity ApplicationVersions
-> GenT Identity (SoftwareVersion -> Error)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ( Range Int
-> GenT Identity (ApplicationName, ApplicationVersion)
-> GenT Identity ApplicationVersions
forall (m :: * -> *) k v.
(MonadGen m, Ord k) =>
Range Int -> m (k, v) -> m (Map k v)
Gen.map (Int -> Int -> Range Int
forall a. Integral a => a -> a -> Range a
Range.linear Int
1 Int
20) (GenT Identity (ApplicationName, ApplicationVersion)
 -> GenT Identity ApplicationVersions)
-> GenT Identity (ApplicationName, ApplicationVersion)
-> GenT Identity ApplicationVersions
forall a b. (a -> b) -> a -> b
$ do
                ApplicationName
name <- Gen ApplicationName
genApplicationName
                Word32
version <- GenT Identity Word32
genWord32
                SlotNumber
slotNo <- Word64 -> SlotNumber
SlotNumber (Word64 -> SlotNumber)
-> GenT Identity Word64 -> GenT Identity SlotNumber
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Range Word64 -> GenT Identity Word64
forall (m :: * -> *). MonadGen m => Range Word64 -> m Word64
Gen.word64 Range Word64
forall a. (Bounded a, Num a) => Range a
Range.constantBounded
                Map SystemTag InstallerHash
meta <-
                  Range Int
-> GenT Identity (SystemTag, InstallerHash)
-> GenT Identity (Map SystemTag InstallerHash)
forall (m :: * -> *) k v.
(MonadGen m, Ord k) =>
Range Int -> m (k, v) -> m (Map k v)
Gen.map (Int -> Int -> Range Int
forall a. Integral a => a -> a -> Range a
Range.linear Int
1 Int
10)
                    (GenT Identity (SystemTag, InstallerHash)
 -> GenT Identity (Map SystemTag InstallerHash))
-> GenT Identity (SystemTag, InstallerHash)
-> GenT Identity (Map SystemTag InstallerHash)
forall a b. (a -> b) -> a -> b
$ (,)
                    (SystemTag -> InstallerHash -> (SystemTag, InstallerHash))
-> Gen SystemTag
-> GenT Identity (InstallerHash -> (SystemTag, InstallerHash))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Gen SystemTag
genSystemTag
                    GenT Identity (InstallerHash -> (SystemTag, InstallerHash))
-> Gen InstallerHash -> GenT Identity (SystemTag, InstallerHash)
forall a b.
GenT Identity (a -> b) -> GenT Identity a -> GenT Identity b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Gen InstallerHash
genInstallerHash
                (ApplicationName, ApplicationVersion)
-> GenT Identity (ApplicationName, ApplicationVersion)
forall a. a -> GenT Identity a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (ApplicationName
name, (Word32
-> SlotNumber -> Map SystemTag InstallerHash -> ApplicationVersion
Registration.ApplicationVersion Word32
version SlotNumber
slotNo Map SystemTag InstallerHash
meta))
            )
        GenT Identity (SoftwareVersion -> Error)
-> Gen SoftwareVersion -> GenT Identity Error
forall a b.
GenT Identity (a -> b) -> GenT Identity a -> GenT Identity b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Gen SoftwareVersion
genSoftwareVersion
    , TooLarge Natural -> Error
Registration.MaxBlockSizeTooLarge (TooLarge Natural -> Error)
-> GenT Identity (TooLarge Natural) -> GenT Identity Error
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Natural -> Natural -> TooLarge Natural
forall n. n -> n -> TooLarge n
Registration.TooLarge (Natural -> Natural -> TooLarge Natural)
-> GenT Identity Natural
-> GenT Identity (Natural -> TooLarge Natural)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> GenT Identity Natural
genNatural GenT Identity (Natural -> TooLarge Natural)
-> GenT Identity Natural -> GenT Identity (TooLarge Natural)
forall a b.
GenT Identity (a -> b) -> GenT Identity a -> GenT Identity b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> GenT Identity Natural
genNatural)
    , TooLarge Natural -> Error
Registration.MaxTxSizeTooLarge (TooLarge Natural -> Error)
-> GenT Identity (TooLarge Natural) -> GenT Identity Error
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Natural -> Natural -> TooLarge Natural
forall n. n -> n -> TooLarge n
Registration.TooLarge (Natural -> Natural -> TooLarge Natural)
-> GenT Identity Natural
-> GenT Identity (Natural -> TooLarge Natural)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> GenT Identity Natural
genNatural GenT Identity (Natural -> TooLarge Natural)
-> GenT Identity Natural -> GenT Identity (TooLarge Natural)
forall a b.
GenT Identity (a -> b) -> GenT Identity a -> GenT Identity b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> GenT Identity Natural
genNatural)
    , Error -> GenT Identity Error
forall a. a -> GenT Identity a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Error
Registration.ProposalAttributesUnknown
    , TooLarge Natural -> Error
Registration.ProposalTooLarge (TooLarge Natural -> Error)
-> GenT Identity (TooLarge Natural) -> GenT Identity Error
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Natural -> Natural -> TooLarge Natural
forall n. n -> n -> TooLarge n
Registration.TooLarge (Natural -> Natural -> TooLarge Natural)
-> GenT Identity Natural
-> GenT Identity (Natural -> TooLarge Natural)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> GenT Identity Natural
genNatural GenT Identity (Natural -> TooLarge Natural)
-> GenT Identity Natural -> GenT Identity (TooLarge Natural)
forall a b.
GenT Identity (a -> b) -> GenT Identity a -> GenT Identity b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> GenT Identity Natural
genNatural)
    , (SoftwareVersionError -> Error
Registration.SoftwareVersionError (SoftwareVersionError -> Error)
-> (ApplicationNameError -> SoftwareVersionError)
-> ApplicationNameError
-> Error
forall b c a. (b -> c) -> (a -> b) -> a -> c
forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. ApplicationNameError -> SoftwareVersionError
SoftwareVersionApplicationNameError)
        (ApplicationNameError -> Error)
-> GenT Identity ApplicationNameError -> GenT Identity Error
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [GenT Identity ApplicationNameError]
-> GenT Identity ApplicationNameError
forall (m :: * -> *) a. MonadGen m => [m a] -> m a
Gen.choice
          [ Text -> ApplicationNameError
ApplicationNameTooLong (Text -> ApplicationNameError)
-> GenT Identity Text -> GenT Identity ApplicationNameError
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Range Int -> GenT Identity Char -> GenT Identity Text
forall (m :: * -> *). MonadGen m => Range Int -> m Char -> m Text
Gen.text (Int -> Int -> Range Int
forall a. Integral a => a -> a -> Range a
Range.linear Int
0 Int
20) GenT Identity Char
forall (m :: * -> *). MonadGen m => m Char
Gen.alphaNum
          , Text -> ApplicationNameError
ApplicationNameNotAscii (Text -> ApplicationNameError)
-> GenT Identity Text -> GenT Identity ApplicationNameError
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Range Int -> GenT Identity Char -> GenT Identity Text
forall (m :: * -> *). MonadGen m => Range Int -> m Char -> m Text
Gen.text (Int -> Int -> Range Int
forall a. Integral a => a -> a -> Range a
Range.linear Int
0 Int
20) GenT Identity Char
forall (m :: * -> *). MonadGen m => m Char
Gen.alphaNum
          ]
    , SystemTagError -> Error
Registration.SystemTagError
        (SystemTagError -> Error)
-> GenT Identity SystemTagError -> GenT Identity Error
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [GenT Identity SystemTagError] -> GenT Identity SystemTagError
forall (m :: * -> *) a. MonadGen m => [m a] -> m a
Gen.choice
          [ Text -> SystemTagError
SystemTagNotAscii (Text -> SystemTagError)
-> GenT Identity Text -> GenT Identity SystemTagError
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Range Int -> GenT Identity Char -> GenT Identity Text
forall (m :: * -> *). MonadGen m => Range Int -> m Char -> m Text
Gen.text (Int -> Int -> Range Int
forall a. Integral a => a -> a -> Range a
Range.linear Int
0 Int
20) GenT Identity Char
forall (m :: * -> *). MonadGen m => m Char
Gen.alphaNum
          , Text -> SystemTagError
SystemTagTooLong (Text -> SystemTagError)
-> GenT Identity Text -> GenT Identity SystemTagError
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Range Int -> GenT Identity Char -> GenT Identity Text
forall (m :: * -> *). MonadGen m => Range Int -> m Char -> m Text
Gen.text (Int -> Int -> Range Int
forall a. Integral a => a -> a -> Range a
Range.linear Int
0 Int
20) GenT Identity Char
forall (m :: * -> *). MonadGen m => m Char
Gen.alphaNum
          ]
    ]

genVotingError :: ProtocolMagicId -> Gen Voting.Error
genVotingError :: ProtocolMagicId -> GenT Identity Error
genVotingError ProtocolMagicId
pm =
  [GenT Identity Error] -> GenT Identity Error
forall (m :: * -> *) a. MonadGen m => [m a] -> m a
Gen.choice
    [ Error -> GenT Identity Error
forall a. a -> GenT Identity a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Error
Voting.VotingInvalidSignature
    , UpId -> Error
Voting.VotingProposalNotRegistered (UpId -> Error) -> Gen UpId -> GenT Identity Error
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ProtocolMagicId -> Gen UpId
genUpId ProtocolMagicId
pm
    , KeyHash -> Error
Voting.VotingVoterNotDelegate (KeyHash -> Error) -> GenT Identity KeyHash -> GenT Identity Error
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> GenT Identity KeyHash
genKeyHash
    ]

genEndorsementError :: Gen Endorsement.Error
genEndorsementError :: GenT Identity Error
genEndorsementError =
  ProtocolVersion -> Error
Endorsement.MultipleProposalsForProtocolVersion
    (ProtocolVersion -> Error)
-> Gen ProtocolVersion -> GenT Identity Error
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Gen ProtocolVersion
genProtocolVersion

genRegistrationTooLarge :: Gen (Registration.TooLarge Int)
genRegistrationTooLarge :: GenT Identity (TooLarge Int)
genRegistrationTooLarge =
  Int -> Int -> TooLarge Int
forall n. n -> n -> TooLarge n
Registration.TooLarge
    (Int -> Int -> TooLarge Int)
-> GenT Identity Int -> GenT Identity (Int -> TooLarge Int)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Range Int -> GenT Identity Int
forall (m :: * -> *). MonadGen m => Range Int -> m Int
Gen.int Range Int
forall a. (Bounded a, Num a) => Range a
Range.constantBounded
    GenT Identity (Int -> TooLarge Int)
-> GenT Identity Int -> GenT Identity (TooLarge Int)
forall a b.
GenT Identity (a -> b) -> GenT Identity a -> GenT Identity b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Range Int -> GenT Identity Int
forall (m :: * -> *). MonadGen m => Range Int -> m Int
Gen.int Range Int
forall a. (Bounded a, Num a) => Range a
Range.constantBounded