{-# LANGUAGE DataKinds #-}
{-# LANGUAGE DerivingStrategies #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE GeneralizedNewtypeDeriving #-}
{-# LANGUAGE PatternSynonyms #-}
{-# LANGUAGE RankNTypes #-}
{-# LANGUAGE RecordWildCards #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE StandaloneDeriving #-}
{-# LANGUAGE TypeApplications #-}
{-# LANGUAGE TypeFamilies #-}
{-# LANGUAGE TypeOperators #-}
{-# LANGUAGE UndecidableInstances #-}
-- Due to Delegation usage
{-# OPTIONS_GHC -Wno-orphans -Wno-deprecations #-}

module Test.Cardano.Ledger.Shelley.Arbitrary (
  collectionDatumMaxSize,
  metadataMaxSize,
  genMetadata,
  genMetadata',
  genUtf8StringOfSize,
  RawSeed (..),
  ASC (..),
  StakeProportion (..),
  sizedNativeScriptGens,
) where

import qualified Cardano.Chain.UTxO as Byron
import Cardano.Ledger.BaseTypes
import Cardano.Ledger.Shelley (ShelleyEra)
import Cardano.Ledger.Shelley.API (
  ApplyTxError (ApplyTxError),
  MultiSig,
  NominalDiffTimeMicro (..),
  ShelleyDelegCert,
  ShelleyGenesis (..),
  ShelleyGenesisStaking (ShelleyGenesisStaking),
  ShelleyTx (ShelleyTx),
  TxBody (ShelleyTxBody),
 )
import Cardano.Ledger.Shelley.Core
import Cardano.Ledger.Shelley.LedgerState
import Cardano.Ledger.Shelley.PParams
import Cardano.Ledger.Shelley.PoolRank
import Cardano.Ledger.Shelley.RewardUpdate
import Cardano.Ledger.Shelley.Rewards (
  LeaderOnlyReward (..),
  PoolRewardInfo (..),
  StakeShare (..),
 )
import Cardano.Ledger.Shelley.Rules (
  PredicateFailure,
  ShelleyDelegPredFailure,
  ShelleyDelegsPredFailure,
  ShelleyDelplPredFailure,
  ShelleyLedgerPredFailure,
  ShelleyLedgersPredFailure,
  ShelleyPoolPredFailure (..),
  ShelleyPpupPredFailure,
  ShelleyUtxoPredFailure,
  ShelleyUtxowPredFailure,
  VotingPeriod,
 )
import Cardano.Ledger.Shelley.Scripts (
  ShelleyEraScript (..),
  pattern RequireAllOf,
  pattern RequireAnyOf,
  pattern RequireMOf,
  pattern RequireSignature,
 )
import Cardano.Ledger.Shelley.State
import Cardano.Ledger.Shelley.TxAuxData
import Cardano.Ledger.Shelley.TxCert (
  GenesisDelegCert (..),
  ShelleyTxCert,
 )
import Cardano.Ledger.Shelley.TxOut
import Cardano.Ledger.Shelley.TxWits (ShelleyTxWits (ShelleyTxWits))
import Control.Exception (assert)
import Control.Monad.Identity (Identity)
import qualified Data.ByteString.Char8 as BS (length, pack)
import qualified Data.ListMap as LM
import qualified Data.Map.Strict as Map (fromList)
import Data.Sequence.Strict (fromList)
import qualified Data.Text as T (pack)
import qualified Data.Text.Encoding as T (encodeUtf8)
import Data.Word (Word64)
import Generic.Random (genericArbitraryU)
import Test.Cardano.Chain.UTxO.Gen (genCompactTxOut)
import Test.Cardano.Ledger.Common
import Test.Cardano.Ledger.Core.Arbitrary ()
import Test.Cardano.Ledger.Core.Utils (unsafeBoundRational)
import Test.QuickCheck.Hedgehog (hedgehog)

------------------------------------------------------------------------------------------
-- Cardano.Ledger.Shelley.PParams --------------------------------------------------------
------------------------------------------------------------------------------------------

instance Era era => Arbitrary (ShelleyPParams Identity era) where
  arbitrary :: Gen (ShelleyPParams Identity era)
arbitrary = Gen (ShelleyPParams Identity era)
forall a. (GArbitrary UnsizedOpts a, GUniformWeight a) => Gen a
genericArbitraryU
  shrink :: ShelleyPParams Identity era -> [ShelleyPParams Identity era]
shrink = ShelleyPParams Identity era -> [ShelleyPParams Identity era]
forall a.
(Generic a, RecursivelyShrink (Rep a), GSubterms (Rep a) a) =>
a -> [a]
genericShrink

instance Era era => Arbitrary (ShelleyPParams StrictMaybe era) where
  arbitrary :: Gen (ShelleyPParams StrictMaybe era)
arbitrary = Gen (ShelleyPParams StrictMaybe era)
forall a. (GArbitrary UnsizedOpts a, GUniformWeight a) => Gen a
genericArbitraryU
  shrink :: ShelleyPParams StrictMaybe era -> [ShelleyPParams StrictMaybe era]
shrink = ShelleyPParams StrictMaybe era -> [ShelleyPParams StrictMaybe era]
forall a.
(Generic a, RecursivelyShrink (Rep a), GSubterms (Rep a) a) =>
a -> [a]
genericShrink

instance (Era era, Arbitrary (PParamsUpdate era)) => Arbitrary (ProposedPPUpdates era) where
  arbitrary :: Gen (ProposedPPUpdates era)
arbitrary = Map (KeyHash 'Genesis) (PParamsUpdate era) -> ProposedPPUpdates era
forall era.
Map (KeyHash 'Genesis) (PParamsUpdate era) -> ProposedPPUpdates era
ProposedPPUpdates (Map (KeyHash 'Genesis) (PParamsUpdate era)
 -> ProposedPPUpdates era)
-> Gen (Map (KeyHash 'Genesis) (PParamsUpdate era))
-> Gen (ProposedPPUpdates era)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Int -> Int)
-> Gen (Map (KeyHash 'Genesis) (PParamsUpdate era))
-> Gen (Map (KeyHash 'Genesis) (PParamsUpdate era))
forall a. (Int -> Int) -> Gen a -> Gen a
scale (Int -> Int -> Int
forall a. Integral a => a -> a -> a
`div` Int
15) Gen (Map (KeyHash 'Genesis) (PParamsUpdate era))
forall a. Arbitrary a => Gen a
arbitrary

------------------------------------------------------------------------------------------
-- Cardano.Ledger.Shelley.TxOut ----------------------------------------------------------
------------------------------------------------------------------------------------------

instance (EraTxOut era, Arbitrary (Value era)) => Arbitrary (ShelleyTxOut era) where
  arbitrary :: Gen (ShelleyTxOut era)
arbitrary = Addr -> Value era -> ShelleyTxOut era
forall era.
(HasCallStack, Era era, Val (Value era)) =>
Addr -> Value era -> ShelleyTxOut era
ShelleyTxOut (Addr -> Value era -> ShelleyTxOut era)
-> Gen Addr -> Gen (Value era -> ShelleyTxOut era)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Gen Addr
forall a. Arbitrary a => Gen a
arbitrary Gen (Value era -> ShelleyTxOut era)
-> Gen (Value era) -> Gen (ShelleyTxOut era)
forall a b. Gen (a -> b) -> Gen a -> Gen b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Int -> Int) -> Gen (Value era) -> Gen (Value era)
forall a. (Int -> Int) -> Gen a -> Gen a
scale (Int -> Int -> Int
forall a. Integral a => a -> a -> a
`div` Int
15) Gen (Value era)
forall a. Arbitrary a => Gen a
arbitrary

------------------------------------------------------------------------------------------
-- Cardano.Ledger.Shelley.LedgerState ----------------------------------------------------
------------------------------------------------------------------------------------------

instance
  ( EraTxOut era
  , Arbitrary (TxOut era)
  , Arbitrary (Value era)
  , Arbitrary (PParams era)
  , Arbitrary (StashedAVVMAddresses era)
  , Arbitrary (GovState era)
  , Arbitrary (CertState era)
  , Arbitrary (InstantStake era)
  ) =>
  Arbitrary (NewEpochState era)
  where
  arbitrary :: Gen (NewEpochState era)
arbitrary =
    EpochNo
-> BlocksMade
-> BlocksMade
-> EpochState era
-> StrictMaybe PulsingRewUpdate
-> PoolDistr
-> StashedAVVMAddresses era
-> NewEpochState era
forall era.
EpochNo
-> BlocksMade
-> BlocksMade
-> EpochState era
-> StrictMaybe PulsingRewUpdate
-> PoolDistr
-> StashedAVVMAddresses era
-> NewEpochState era
NewEpochState
      (EpochNo
 -> BlocksMade
 -> BlocksMade
 -> EpochState era
 -> StrictMaybe PulsingRewUpdate
 -> PoolDistr
 -> StashedAVVMAddresses era
 -> NewEpochState era)
-> Gen EpochNo
-> Gen
     (BlocksMade
      -> BlocksMade
      -> EpochState era
      -> StrictMaybe PulsingRewUpdate
      -> PoolDistr
      -> StashedAVVMAddresses era
      -> NewEpochState era)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Gen EpochNo
forall a. Arbitrary a => Gen a
arbitrary
      Gen
  (BlocksMade
   -> BlocksMade
   -> EpochState era
   -> StrictMaybe PulsingRewUpdate
   -> PoolDistr
   -> StashedAVVMAddresses era
   -> NewEpochState era)
-> Gen BlocksMade
-> Gen
     (BlocksMade
      -> EpochState era
      -> StrictMaybe PulsingRewUpdate
      -> PoolDistr
      -> StashedAVVMAddresses era
      -> NewEpochState era)
forall a b. Gen (a -> b) -> Gen a -> Gen b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Gen BlocksMade
forall a. Arbitrary a => Gen a
arbitrary
      Gen
  (BlocksMade
   -> EpochState era
   -> StrictMaybe PulsingRewUpdate
   -> PoolDistr
   -> StashedAVVMAddresses era
   -> NewEpochState era)
-> Gen BlocksMade
-> Gen
     (EpochState era
      -> StrictMaybe PulsingRewUpdate
      -> PoolDistr
      -> StashedAVVMAddresses era
      -> NewEpochState era)
forall a b. Gen (a -> b) -> Gen a -> Gen b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Gen BlocksMade
forall a. Arbitrary a => Gen a
arbitrary
      Gen
  (EpochState era
   -> StrictMaybe PulsingRewUpdate
   -> PoolDistr
   -> StashedAVVMAddresses era
   -> NewEpochState era)
-> Gen (EpochState era)
-> Gen
     (StrictMaybe PulsingRewUpdate
      -> PoolDistr -> StashedAVVMAddresses era -> NewEpochState era)
forall a b. Gen (a -> b) -> Gen a -> Gen b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Gen (EpochState era)
forall a. Arbitrary a => Gen a
arbitrary
      Gen
  (StrictMaybe PulsingRewUpdate
   -> PoolDistr -> StashedAVVMAddresses era -> NewEpochState era)
-> Gen (StrictMaybe PulsingRewUpdate)
-> Gen (PoolDistr -> StashedAVVMAddresses era -> NewEpochState era)
forall a b. Gen (a -> b) -> Gen a -> Gen b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Gen (StrictMaybe PulsingRewUpdate)
forall a. Arbitrary a => Gen a
arbitrary
      Gen (PoolDistr -> StashedAVVMAddresses era -> NewEpochState era)
-> Gen PoolDistr
-> Gen (StashedAVVMAddresses era -> NewEpochState era)
forall a b. Gen (a -> b) -> Gen a -> Gen b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Gen PoolDistr
forall a. Arbitrary a => Gen a
arbitrary
      Gen (StashedAVVMAddresses era -> NewEpochState era)
-> Gen (StashedAVVMAddresses era) -> Gen (NewEpochState era)
forall a b. Gen (a -> b) -> Gen a -> Gen b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Gen (StashedAVVMAddresses era)
forall a. Arbitrary a => Gen a
arbitrary

instance
  ( EraTxOut era
  , Arbitrary (TxOut era)
  , Arbitrary (GovState era)
  , Arbitrary (CertState era)
  , Arbitrary (InstantStake era)
  ) =>
  Arbitrary (EpochState era)
  where
  arbitrary :: Gen (EpochState era)
arbitrary =
    ChainAccountState
-> LedgerState era -> SnapShots -> NonMyopic -> EpochState era
forall era.
ChainAccountState
-> LedgerState era -> SnapShots -> NonMyopic -> EpochState era
EpochState
      (ChainAccountState
 -> LedgerState era -> SnapShots -> NonMyopic -> EpochState era)
-> Gen ChainAccountState
-> Gen
     (LedgerState era -> SnapShots -> NonMyopic -> EpochState era)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Gen ChainAccountState
forall a. Arbitrary a => Gen a
arbitrary
      Gen (LedgerState era -> SnapShots -> NonMyopic -> EpochState era)
-> Gen (LedgerState era)
-> Gen (SnapShots -> NonMyopic -> EpochState era)
forall a b. Gen (a -> b) -> Gen a -> Gen b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Gen (LedgerState era)
forall a. Arbitrary a => Gen a
arbitrary
      Gen (SnapShots -> NonMyopic -> EpochState era)
-> Gen SnapShots -> Gen (NonMyopic -> EpochState era)
forall a b. Gen (a -> b) -> Gen a -> Gen b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Gen SnapShots
forall a. Arbitrary a => Gen a
arbitrary
      Gen (NonMyopic -> EpochState era)
-> Gen NonMyopic -> Gen (EpochState era)
forall a b. Gen (a -> b) -> Gen a -> Gen b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Gen NonMyopic
forall a. Arbitrary a => Gen a
arbitrary
  shrink :: EpochState era -> [EpochState era]
shrink = EpochState era -> [EpochState era]
forall a.
(Generic a, RecursivelyShrink (Rep a), GSubterms (Rep a) a) =>
a -> [a]
genericShrink

instance
  ( EraTxOut era
  , Arbitrary (TxOut era)
  , Arbitrary (GovState era)
  , Arbitrary (CertState era)
  , Arbitrary (InstantStake era)
  ) =>
  Arbitrary (LedgerState era)
  where
  arbitrary :: Gen (LedgerState era)
arbitrary =
    UTxOState era -> CertState era -> LedgerState era
forall era. UTxOState era -> CertState era -> LedgerState era
LedgerState
      (UTxOState era -> CertState era -> LedgerState era)
-> Gen (UTxOState era) -> Gen (CertState era -> LedgerState era)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Gen (UTxOState era)
forall a. Arbitrary a => Gen a
arbitrary
      Gen (CertState era -> LedgerState era)
-> Gen (CertState era) -> Gen (LedgerState era)
forall a b. Gen (a -> b) -> Gen a -> Gen b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Gen (CertState era)
forall a. Arbitrary a => Gen a
arbitrary
  shrink :: LedgerState era -> [LedgerState era]
shrink LedgerState {CertState era
UTxOState era
lsUTxOState :: UTxOState era
lsCertState :: CertState era
lsUTxOState :: forall era. LedgerState era -> UTxOState era
lsCertState :: forall era. LedgerState era -> CertState era
..} =
    -- We drop the first element in the list so the list does not contain the
    -- original LedgerState which would cause `shrink` to loop indefinitely.
    Int -> [LedgerState era] -> [LedgerState era]
forall a. Int -> [a] -> [a]
drop Int
1 ([LedgerState era] -> [LedgerState era])
-> [LedgerState era] -> [LedgerState era]
forall a b. (a -> b) -> a -> b
$
      UTxOState era -> CertState era -> LedgerState era
forall era. UTxOState era -> CertState era -> LedgerState era
LedgerState
        (UTxOState era -> CertState era -> LedgerState era)
-> [UTxOState era] -> [CertState era -> LedgerState era]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (UTxOState era
lsUTxOState UTxOState era -> [UTxOState era] -> [UTxOState era]
forall a. a -> [a] -> [a]
: UTxOState era -> [UTxOState era]
forall a. Arbitrary a => a -> [a]
shrink UTxOState era
lsUTxOState)
        [CertState era -> LedgerState era]
-> [CertState era] -> [LedgerState era]
forall a b. [a -> b] -> [a] -> [b]
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (CertState era
lsCertState CertState era -> [CertState era] -> [CertState era]
forall a. a -> [a] -> [a]
: CertState era -> [CertState era]
forall a. Arbitrary a => a -> [a]
shrink CertState era
lsCertState)

instance
  ( EraTxOut era
  , Arbitrary (TxOut era)
  , Arbitrary (GovState era)
  , Arbitrary (InstantStake era)
  ) =>
  Arbitrary (UTxOState era)
  where
  arbitrary :: Gen (UTxOState era)
arbitrary =
    UTxO era
-> Coin
-> Coin
-> GovState era
-> InstantStake era
-> Coin
-> UTxOState era
forall era.
UTxO era
-> Coin
-> Coin
-> GovState era
-> InstantStake era
-> Coin
-> UTxOState era
UTxOState
      (UTxO era
 -> Coin
 -> Coin
 -> GovState era
 -> InstantStake era
 -> Coin
 -> UTxOState era)
-> Gen (UTxO era)
-> Gen
     (Coin
      -> Coin
      -> GovState era
      -> InstantStake era
      -> Coin
      -> UTxOState era)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Gen (UTxO era)
forall a. Arbitrary a => Gen a
arbitrary
      Gen
  (Coin
   -> Coin
   -> GovState era
   -> InstantStake era
   -> Coin
   -> UTxOState era)
-> Gen Coin
-> Gen
     (Coin -> GovState era -> InstantStake era -> Coin -> UTxOState era)
forall a b. Gen (a -> b) -> Gen a -> Gen b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Gen Coin
forall a. Arbitrary a => Gen a
arbitrary
      Gen
  (Coin -> GovState era -> InstantStake era -> Coin -> UTxOState era)
-> Gen Coin
-> Gen (GovState era -> InstantStake era -> Coin -> UTxOState era)
forall a b. Gen (a -> b) -> Gen a -> Gen b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Gen Coin
forall a. Arbitrary a => Gen a
arbitrary
      Gen (GovState era -> InstantStake era -> Coin -> UTxOState era)
-> Gen (GovState era)
-> Gen (InstantStake era -> Coin -> UTxOState era)
forall a b. Gen (a -> b) -> Gen a -> Gen b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Gen (GovState era)
forall a. Arbitrary a => Gen a
arbitrary
      Gen (InstantStake era -> Coin -> UTxOState era)
-> Gen (InstantStake era) -> Gen (Coin -> UTxOState era)
forall a b. Gen (a -> b) -> Gen a -> Gen b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Gen (InstantStake era)
forall a. Arbitrary a => Gen a
arbitrary
      Gen (Coin -> UTxOState era) -> Gen Coin -> Gen (UTxOState era)
forall a b. Gen (a -> b) -> Gen a -> Gen b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Gen Coin
forall a. Arbitrary a => Gen a
arbitrary

  -- The 'genericShrink' function returns first the immediate subterms of a
  -- value (in case it is a recursive data-type), and then shrinks the value
  -- itself. Since 'UTxOState' is not a recursive data-type, there are no
  -- subterms, and we can use `recursivelyShrink` directly. This is particularly
  -- important when abstracting away the different fields of the ledger state,
  -- since the generic subterms instances will overlap due to GHC not having
  -- enough context to infer if 'a' and 'b' are the same types (since in this
  -- case this will depend on the definition of 'era').
  --
  -- > instance OVERLAPPING_ GSubtermsIncl (K1 i a) a where
  -- > instance OVERLAPPING_ GSubtermsIncl (K1 i a) b where
  shrink :: UTxOState era -> [UTxOState era]
shrink = UTxOState era -> [UTxOState era]
forall a. (Generic a, RecursivelyShrink (Rep a)) => a -> [a]
recursivelyShrink

instance Arbitrary (ShelleyInstantStake era) where
  arbitrary :: Gen (ShelleyInstantStake era)
arbitrary = Map (Credential 'Staking) (CompactForm Coin)
-> Map Ptr (CompactForm Coin) -> ShelleyInstantStake era
forall era.
Map (Credential 'Staking) (CompactForm Coin)
-> Map Ptr (CompactForm Coin) -> ShelleyInstantStake era
ShelleyInstantStake (Map (Credential 'Staking) (CompactForm Coin)
 -> Map Ptr (CompactForm Coin) -> ShelleyInstantStake era)
-> Gen (Map (Credential 'Staking) (CompactForm Coin))
-> Gen (Map Ptr (CompactForm Coin) -> ShelleyInstantStake era)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Gen (Map (Credential 'Staking) (CompactForm Coin))
forall a. Arbitrary a => Gen a
arbitrary Gen (Map Ptr (CompactForm Coin) -> ShelleyInstantStake era)
-> Gen (Map Ptr (CompactForm Coin))
-> Gen (ShelleyInstantStake era)
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 Ptr (CompactForm Coin))
forall a. Arbitrary a => Gen a
arbitrary
  shrink :: ShelleyInstantStake era -> [ShelleyInstantStake era]
shrink = ShelleyInstantStake era -> [ShelleyInstantStake era]
forall a.
(Generic a, RecursivelyShrink (Rep a), GSubterms (Rep a) a) =>
a -> [a]
genericShrink

------------------------------------------------------------------------------------------
-- Cardano.Ledger.Shelley.PoolRank -------------------------------------------------------
------------------------------------------------------------------------------------------

instance Arbitrary Likelihood where
  arbitrary :: Gen Likelihood
arbitrary = StrictSeq LogWeight -> Likelihood
Likelihood (StrictSeq LogWeight -> Likelihood)
-> Gen (StrictSeq LogWeight) -> Gen Likelihood
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Gen (StrictSeq LogWeight)
forall a. Arbitrary a => Gen a
arbitrary

instance Arbitrary LogWeight where
  arbitrary :: Gen LogWeight
arbitrary = Float -> LogWeight
LogWeight (Float -> LogWeight) -> Gen Float -> Gen LogWeight
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Gen Float
forall a. Arbitrary a => Gen a
arbitrary

instance Arbitrary PerformanceEstimate where
  arbitrary :: Gen PerformanceEstimate
arbitrary = Double -> PerformanceEstimate
PerformanceEstimate (Double -> PerformanceEstimate)
-> Gen Double -> Gen PerformanceEstimate
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Gen Double
forall a. Arbitrary a => Gen a
arbitrary

instance Arbitrary NonMyopic where
  arbitrary :: Gen NonMyopic
arbitrary = Map (KeyHash 'StakePool) Likelihood -> Coin -> NonMyopic
NonMyopic (Map (KeyHash 'StakePool) Likelihood -> Coin -> NonMyopic)
-> Gen (Map (KeyHash 'StakePool) Likelihood)
-> Gen (Coin -> NonMyopic)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Gen (Map (KeyHash 'StakePool) Likelihood)
forall a. Arbitrary a => Gen a
arbitrary Gen (Coin -> NonMyopic) -> Gen Coin -> Gen NonMyopic
forall a b. Gen (a -> b) -> Gen a -> Gen b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Gen Coin
forall a. Arbitrary a => Gen a
arbitrary
  shrink :: NonMyopic -> [NonMyopic]
shrink = NonMyopic -> [NonMyopic]
forall a.
(Generic a, RecursivelyShrink (Rep a), GSubterms (Rep a) a) =>
a -> [a]
genericShrink

------------------------------------------------------------------------------------------
-- Cardano.Ledger.Shelley.Rewards --------------------------------------------------------
------------------------------------------------------------------------------------------
deriving newtype instance Arbitrary StakeShare

instance Arbitrary LeaderOnlyReward where
  arbitrary :: Gen LeaderOnlyReward
arbitrary = KeyHash 'StakePool -> Coin -> LeaderOnlyReward
LeaderOnlyReward (KeyHash 'StakePool -> Coin -> LeaderOnlyReward)
-> Gen (KeyHash 'StakePool) -> Gen (Coin -> LeaderOnlyReward)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Gen (KeyHash 'StakePool)
forall a. Arbitrary a => Gen a
arbitrary Gen (Coin -> LeaderOnlyReward) -> Gen Coin -> Gen LeaderOnlyReward
forall a b. Gen (a -> b) -> Gen a -> Gen b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Gen Coin
forall a. Arbitrary a => Gen a
arbitrary
  shrink :: LeaderOnlyReward -> [LeaderOnlyReward]
shrink = LeaderOnlyReward -> [LeaderOnlyReward]
forall a.
(Generic a, RecursivelyShrink (Rep a), GSubterms (Rep a) a) =>
a -> [a]
genericShrink

instance Arbitrary PoolRewardInfo where
  arbitrary :: Gen PoolRewardInfo
arbitrary =
    StakeShare
-> Coin -> PoolParams -> Nat -> LeaderOnlyReward -> PoolRewardInfo
PoolRewardInfo
      (StakeShare
 -> Coin -> PoolParams -> Nat -> LeaderOnlyReward -> PoolRewardInfo)
-> Gen StakeShare
-> Gen
     (Coin -> PoolParams -> Nat -> LeaderOnlyReward -> PoolRewardInfo)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Gen StakeShare
forall a. Arbitrary a => Gen a
arbitrary
      Gen
  (Coin -> PoolParams -> Nat -> LeaderOnlyReward -> PoolRewardInfo)
-> Gen Coin
-> Gen (PoolParams -> Nat -> LeaderOnlyReward -> PoolRewardInfo)
forall a b. Gen (a -> b) -> Gen a -> Gen b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Gen Coin
forall a. Arbitrary a => Gen a
arbitrary
      Gen (PoolParams -> Nat -> LeaderOnlyReward -> PoolRewardInfo)
-> Gen PoolParams
-> Gen (Nat -> LeaderOnlyReward -> PoolRewardInfo)
forall a b. Gen (a -> b) -> Gen a -> Gen b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Gen PoolParams
forall a. Arbitrary a => Gen a
arbitrary
      Gen (Nat -> LeaderOnlyReward -> PoolRewardInfo)
-> Gen Nat -> Gen (LeaderOnlyReward -> PoolRewardInfo)
forall a b. Gen (a -> b) -> Gen a -> Gen b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Gen Nat
forall a. Arbitrary a => Gen a
arbitrary
      Gen (LeaderOnlyReward -> PoolRewardInfo)
-> Gen LeaderOnlyReward -> Gen PoolRewardInfo
forall a b. Gen (a -> b) -> Gen a -> Gen b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Gen LeaderOnlyReward
forall a. Arbitrary a => Gen a
arbitrary
  shrink :: PoolRewardInfo -> [PoolRewardInfo]
shrink = PoolRewardInfo -> [PoolRewardInfo]
forall a.
(Generic a, RecursivelyShrink (Rep a), GSubterms (Rep a) a) =>
a -> [a]
genericShrink

------------------------------------------------------------------------------------------
-- Cardano.Ledger.Shelley.RewardUpdate ---------------------------------------------------
------------------------------------------------------------------------------------------

instance Arbitrary RewardUpdate where
  arbitrary :: Gen RewardUpdate
arbitrary =
    DeltaCoin
-> DeltaCoin
-> Map (Credential 'Staking) (Set Reward)
-> DeltaCoin
-> NonMyopic
-> RewardUpdate
RewardUpdate
      (DeltaCoin
 -> DeltaCoin
 -> Map (Credential 'Staking) (Set Reward)
 -> DeltaCoin
 -> NonMyopic
 -> RewardUpdate)
-> Gen DeltaCoin
-> Gen
     (DeltaCoin
      -> Map (Credential 'Staking) (Set Reward)
      -> DeltaCoin
      -> NonMyopic
      -> RewardUpdate)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Gen DeltaCoin
forall a. Arbitrary a => Gen a
arbitrary
      Gen
  (DeltaCoin
   -> Map (Credential 'Staking) (Set Reward)
   -> DeltaCoin
   -> NonMyopic
   -> RewardUpdate)
-> Gen DeltaCoin
-> Gen
     (Map (Credential 'Staking) (Set Reward)
      -> DeltaCoin -> NonMyopic -> RewardUpdate)
forall a b. Gen (a -> b) -> Gen a -> Gen b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Gen DeltaCoin
forall a. Arbitrary a => Gen a
arbitrary
      Gen
  (Map (Credential 'Staking) (Set Reward)
   -> DeltaCoin -> NonMyopic -> RewardUpdate)
-> Gen (Map (Credential 'Staking) (Set Reward))
-> Gen (DeltaCoin -> NonMyopic -> RewardUpdate)
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 (Credential 'Staking) (Set Reward))
forall a. Arbitrary a => Gen a
arbitrary
      Gen (DeltaCoin -> NonMyopic -> RewardUpdate)
-> Gen DeltaCoin -> Gen (NonMyopic -> RewardUpdate)
forall a b. Gen (a -> b) -> Gen a -> Gen b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Gen DeltaCoin
forall a. Arbitrary a => Gen a
arbitrary
      Gen (NonMyopic -> RewardUpdate)
-> Gen NonMyopic -> Gen RewardUpdate
forall a b. Gen (a -> b) -> Gen a -> Gen b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Gen NonMyopic
forall a. Arbitrary a => Gen a
arbitrary
  shrink :: RewardUpdate -> [RewardUpdate]
shrink = RewardUpdate -> [RewardUpdate]
forall a.
(Generic a, RecursivelyShrink (Rep a), GSubterms (Rep a) a) =>
a -> [a]
genericShrink

instance Arbitrary RewardAns where
  arbitrary :: Gen RewardAns
arbitrary = Map (Credential 'Staking) Reward
-> Map (Credential 'Staking) (Set Reward) -> RewardAns
RewardAns (Map (Credential 'Staking) Reward
 -> Map (Credential 'Staking) (Set Reward) -> RewardAns)
-> Gen (Map (Credential 'Staking) Reward)
-> Gen (Map (Credential 'Staking) (Set Reward) -> RewardAns)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Gen (Map (Credential 'Staking) Reward)
forall a. Arbitrary a => Gen a
arbitrary Gen (Map (Credential 'Staking) (Set Reward) -> RewardAns)
-> Gen (Map (Credential 'Staking) (Set Reward)) -> Gen RewardAns
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 (Credential 'Staking) (Set Reward))
forall a. Arbitrary a => Gen a
arbitrary
  shrink :: RewardAns -> [RewardAns]
shrink = RewardAns -> [RewardAns]
forall a.
(Generic a, RecursivelyShrink (Rep a), GSubterms (Rep a) a) =>
a -> [a]
genericShrink

instance Arbitrary (RewardPulser ShelleyBase RewardAns) where
  arbitrary :: Gen (RewardPulser ShelleyBase RewardAns)
arbitrary = Int
-> FreeVars
-> VMap VB VP (Credential 'Staking) (CompactForm Coin)
-> RewardAns
-> RewardPulser ShelleyBase RewardAns
forall ans (m :: * -> *).
(ans ~ RewardAns, m ~ ShelleyBase) =>
Int
-> FreeVars
-> VMap VB VP (Credential 'Staking) (CompactForm Coin)
-> ans
-> RewardPulser m ans
RSLP (Int
 -> FreeVars
 -> VMap VB VP (Credential 'Staking) (CompactForm Coin)
 -> RewardAns
 -> RewardPulser ShelleyBase RewardAns)
-> Gen Int
-> Gen
     (FreeVars
      -> VMap VB VP (Credential 'Staking) (CompactForm Coin)
      -> RewardAns
      -> RewardPulser ShelleyBase RewardAns)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Gen Int
forall a. Arbitrary a => Gen a
arbitrary Gen
  (FreeVars
   -> VMap VB VP (Credential 'Staking) (CompactForm Coin)
   -> RewardAns
   -> RewardPulser ShelleyBase RewardAns)
-> Gen FreeVars
-> Gen
     (VMap VB VP (Credential 'Staking) (CompactForm Coin)
      -> RewardAns -> RewardPulser ShelleyBase RewardAns)
forall a b. Gen (a -> b) -> Gen a -> Gen b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Gen FreeVars
forall a. Arbitrary a => Gen a
arbitrary Gen
  (VMap VB VP (Credential 'Staking) (CompactForm Coin)
   -> RewardAns -> RewardPulser ShelleyBase RewardAns)
-> Gen (VMap VB VP (Credential 'Staking) (CompactForm Coin))
-> Gen (RewardAns -> RewardPulser ShelleyBase RewardAns)
forall a b. Gen (a -> b) -> Gen a -> Gen b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Gen (VMap VB VP (Credential 'Staking) (CompactForm Coin))
forall a. Arbitrary a => Gen a
arbitrary Gen (RewardAns -> RewardPulser ShelleyBase RewardAns)
-> Gen RewardAns -> Gen (RewardPulser ShelleyBase RewardAns)
forall a b. Gen (a -> b) -> Gen a -> Gen b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Gen RewardAns
forall a. Arbitrary a => Gen a
arbitrary

instance Arbitrary PulsingRewUpdate where
  arbitrary :: Gen PulsingRewUpdate
arbitrary =
    [Gen PulsingRewUpdate] -> Gen PulsingRewUpdate
forall a. HasCallStack => [Gen a] -> Gen a
oneof
      [ RewardSnapShot
-> RewardPulser ShelleyBase RewardAns -> PulsingRewUpdate
Pulsing (RewardSnapShot
 -> RewardPulser ShelleyBase RewardAns -> PulsingRewUpdate)
-> Gen RewardSnapShot
-> Gen (RewardPulser ShelleyBase RewardAns -> PulsingRewUpdate)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Gen RewardSnapShot
forall a. Arbitrary a => Gen a
arbitrary Gen (RewardPulser ShelleyBase RewardAns -> PulsingRewUpdate)
-> Gen (RewardPulser ShelleyBase RewardAns) -> Gen PulsingRewUpdate
forall a b. Gen (a -> b) -> Gen a -> Gen b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Gen (RewardPulser ShelleyBase RewardAns)
forall a. Arbitrary a => Gen a
arbitrary
      , RewardUpdate -> PulsingRewUpdate
Complete (RewardUpdate -> PulsingRewUpdate)
-> Gen RewardUpdate -> Gen PulsingRewUpdate
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Gen RewardUpdate
forall a. Arbitrary a => Gen a
arbitrary
      ]
  shrink :: PulsingRewUpdate -> [PulsingRewUpdate]
shrink = PulsingRewUpdate -> [PulsingRewUpdate]
forall a.
(Generic a, RecursivelyShrink (Rep a), GSubterms (Rep a) a) =>
a -> [a]
genericShrink

instance Arbitrary RewardSnapShot where
  arbitrary :: Gen RewardSnapShot
arbitrary =
    Coin
-> ProtVer
-> NonMyopic
-> Coin
-> Coin
-> Coin
-> Map (KeyHash 'StakePool) Likelihood
-> Map (Credential 'Staking) (Set Reward)
-> RewardSnapShot
RewardSnapShot
      (Coin
 -> ProtVer
 -> NonMyopic
 -> Coin
 -> Coin
 -> Coin
 -> Map (KeyHash 'StakePool) Likelihood
 -> Map (Credential 'Staking) (Set Reward)
 -> RewardSnapShot)
-> Gen Coin
-> Gen
     (ProtVer
      -> NonMyopic
      -> Coin
      -> Coin
      -> Coin
      -> Map (KeyHash 'StakePool) Likelihood
      -> Map (Credential 'Staking) (Set Reward)
      -> RewardSnapShot)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Gen Coin
forall a. Arbitrary a => Gen a
arbitrary
      Gen
  (ProtVer
   -> NonMyopic
   -> Coin
   -> Coin
   -> Coin
   -> Map (KeyHash 'StakePool) Likelihood
   -> Map (Credential 'Staking) (Set Reward)
   -> RewardSnapShot)
-> Gen ProtVer
-> Gen
     (NonMyopic
      -> Coin
      -> Coin
      -> Coin
      -> Map (KeyHash 'StakePool) Likelihood
      -> Map (Credential 'Staking) (Set Reward)
      -> RewardSnapShot)
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
      Gen
  (NonMyopic
   -> Coin
   -> Coin
   -> Coin
   -> Map (KeyHash 'StakePool) Likelihood
   -> Map (Credential 'Staking) (Set Reward)
   -> RewardSnapShot)
-> Gen NonMyopic
-> Gen
     (Coin
      -> Coin
      -> Coin
      -> Map (KeyHash 'StakePool) Likelihood
      -> Map (Credential 'Staking) (Set Reward)
      -> RewardSnapShot)
forall a b. Gen (a -> b) -> Gen a -> Gen b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Gen NonMyopic
forall a. Arbitrary a => Gen a
arbitrary
      Gen
  (Coin
   -> Coin
   -> Coin
   -> Map (KeyHash 'StakePool) Likelihood
   -> Map (Credential 'Staking) (Set Reward)
   -> RewardSnapShot)
-> Gen Coin
-> Gen
     (Coin
      -> Coin
      -> Map (KeyHash 'StakePool) Likelihood
      -> Map (Credential 'Staking) (Set Reward)
      -> RewardSnapShot)
forall a b. Gen (a -> b) -> Gen a -> Gen b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Gen Coin
forall a. Arbitrary a => Gen a
arbitrary
      Gen
  (Coin
   -> Coin
   -> Map (KeyHash 'StakePool) Likelihood
   -> Map (Credential 'Staking) (Set Reward)
   -> RewardSnapShot)
-> Gen Coin
-> Gen
     (Coin
      -> Map (KeyHash 'StakePool) Likelihood
      -> Map (Credential 'Staking) (Set Reward)
      -> RewardSnapShot)
forall a b. Gen (a -> b) -> Gen a -> Gen b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Gen Coin
forall a. Arbitrary a => Gen a
arbitrary
      Gen
  (Coin
   -> Map (KeyHash 'StakePool) Likelihood
   -> Map (Credential 'Staking) (Set Reward)
   -> RewardSnapShot)
-> Gen Coin
-> Gen
     (Map (KeyHash 'StakePool) Likelihood
      -> Map (Credential 'Staking) (Set Reward) -> RewardSnapShot)
forall a b. Gen (a -> b) -> Gen a -> Gen b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Gen Coin
forall a. Arbitrary a => Gen a
arbitrary
      Gen
  (Map (KeyHash 'StakePool) Likelihood
   -> Map (Credential 'Staking) (Set Reward) -> RewardSnapShot)
-> Gen (Map (KeyHash 'StakePool) Likelihood)
-> Gen (Map (Credential 'Staking) (Set Reward) -> RewardSnapShot)
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 'StakePool) Likelihood)
forall a. Arbitrary a => Gen a
arbitrary
      Gen (Map (Credential 'Staking) (Set Reward) -> RewardSnapShot)
-> Gen (Map (Credential 'Staking) (Set Reward))
-> Gen RewardSnapShot
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 (Credential 'Staking) (Set Reward))
forall a. Arbitrary a => Gen a
arbitrary
  shrink :: RewardSnapShot -> [RewardSnapShot]
shrink = RewardSnapShot -> [RewardSnapShot]
forall a.
(Generic a, RecursivelyShrink (Rep a), GSubterms (Rep a) a) =>
a -> [a]
genericShrink

instance Arbitrary FreeVars where
  arbitrary :: Gen FreeVars
arbitrary =
    VMap VB VB (Credential 'Staking) (KeyHash 'StakePool)
-> Set (Credential 'Staking)
-> Coin
-> ProtVer
-> Map (KeyHash 'StakePool) PoolRewardInfo
-> FreeVars
FreeVars
      (VMap VB VB (Credential 'Staking) (KeyHash 'StakePool)
 -> Set (Credential 'Staking)
 -> Coin
 -> ProtVer
 -> Map (KeyHash 'StakePool) PoolRewardInfo
 -> FreeVars)
-> Gen (VMap VB VB (Credential 'Staking) (KeyHash 'StakePool))
-> Gen
     (Set (Credential 'Staking)
      -> Coin
      -> ProtVer
      -> Map (KeyHash 'StakePool) PoolRewardInfo
      -> FreeVars)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Gen (VMap VB VB (Credential 'Staking) (KeyHash 'StakePool))
forall a. Arbitrary a => Gen a
arbitrary
      Gen
  (Set (Credential 'Staking)
   -> Coin
   -> ProtVer
   -> Map (KeyHash 'StakePool) PoolRewardInfo
   -> FreeVars)
-> Gen (Set (Credential 'Staking))
-> Gen
     (Coin
      -> ProtVer -> Map (KeyHash 'StakePool) PoolRewardInfo -> FreeVars)
forall a b. Gen (a -> b) -> Gen a -> Gen b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Gen (Set (Credential 'Staking))
forall a. Arbitrary a => Gen a
arbitrary
      Gen
  (Coin
   -> ProtVer -> Map (KeyHash 'StakePool) PoolRewardInfo -> FreeVars)
-> Gen Coin
-> Gen
     (ProtVer -> Map (KeyHash 'StakePool) PoolRewardInfo -> FreeVars)
forall a b. Gen (a -> b) -> Gen a -> Gen b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Gen Coin
forall a. Arbitrary a => Gen a
arbitrary
      Gen
  (ProtVer -> Map (KeyHash 'StakePool) PoolRewardInfo -> FreeVars)
-> Gen ProtVer
-> Gen (Map (KeyHash 'StakePool) PoolRewardInfo -> FreeVars)
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
      Gen (Map (KeyHash 'StakePool) PoolRewardInfo -> FreeVars)
-> Gen (Map (KeyHash 'StakePool) PoolRewardInfo) -> Gen FreeVars
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 'StakePool) PoolRewardInfo)
forall a. Arbitrary a => Gen a
arbitrary
  shrink :: FreeVars -> [FreeVars]
shrink = FreeVars -> [FreeVars]
forall a.
(Generic a, RecursivelyShrink (Rep a), GSubterms (Rep a) a) =>
a -> [a]
genericShrink

------------------------------------------------------------------------------------------
-- Cardano.Ledger.Shelley.Governance -----------------------------------------------------
------------------------------------------------------------------------------------------

instance Arbitrary (PParams era) => Arbitrary (FuturePParams era) where
  arbitrary :: Gen (FuturePParams era)
arbitrary = (Int -> Int) -> Gen (FuturePParams era) -> Gen (FuturePParams era)
forall a. (Int -> Int) -> Gen a -> Gen a
scale (Int -> Int -> Int
forall a. Integral a => a -> a -> a
`div` Int
10) Gen (FuturePParams era)
forall a. (GArbitrary UnsizedOpts a, GUniformWeight a) => Gen a
genericArbitraryU

instance
  ( Era era
  , Arbitrary (PParamsUpdate era)
  , Arbitrary (PParams era)
  ) =>
  Arbitrary (ShelleyGovState era)
  where
  arbitrary :: Gen (ShelleyGovState era)
arbitrary = ProposedPPUpdates era
-> ProposedPPUpdates era
-> PParams era
-> PParams era
-> FuturePParams era
-> ShelleyGovState era
forall era.
ProposedPPUpdates era
-> ProposedPPUpdates era
-> PParams era
-> PParams era
-> FuturePParams era
-> ShelleyGovState era
ShelleyGovState (ProposedPPUpdates era
 -> ProposedPPUpdates era
 -> PParams era
 -> PParams era
 -> FuturePParams era
 -> ShelleyGovState era)
-> Gen (ProposedPPUpdates era)
-> Gen
     (ProposedPPUpdates era
      -> PParams era
      -> PParams era
      -> FuturePParams era
      -> ShelleyGovState era)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Gen (ProposedPPUpdates era)
forall a. Arbitrary a => Gen a
arbitrary Gen
  (ProposedPPUpdates era
   -> PParams era
   -> PParams era
   -> FuturePParams era
   -> ShelleyGovState era)
-> Gen (ProposedPPUpdates era)
-> Gen
     (PParams era
      -> PParams era -> FuturePParams era -> ShelleyGovState era)
forall a b. Gen (a -> b) -> Gen a -> Gen b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Gen (ProposedPPUpdates era)
forall a. Arbitrary a => Gen a
arbitrary Gen
  (PParams era
   -> PParams era -> FuturePParams era -> ShelleyGovState era)
-> Gen (PParams era)
-> Gen (PParams era -> FuturePParams era -> ShelleyGovState era)
forall a b. Gen (a -> b) -> Gen a -> Gen b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Gen (PParams era)
forall a. Arbitrary a => Gen a
arbitrary Gen (PParams era -> FuturePParams era -> ShelleyGovState era)
-> Gen (PParams era)
-> Gen (FuturePParams era -> ShelleyGovState era)
forall a b. Gen (a -> b) -> Gen a -> Gen b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Gen (PParams era)
forall a. Arbitrary a => Gen a
arbitrary Gen (FuturePParams era -> ShelleyGovState era)
-> Gen (FuturePParams era) -> Gen (ShelleyGovState era)
forall a b. Gen (a -> b) -> Gen a -> Gen b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Gen (FuturePParams era)
forall a. Arbitrary a => Gen a
arbitrary
  shrink :: ShelleyGovState era -> [ShelleyGovState era]
shrink = ShelleyGovState era -> [ShelleyGovState era]
forall a.
(Generic a, RecursivelyShrink (Rep a), GSubterms (Rep a) a) =>
a -> [a]
genericShrink

------------------------------------------------------------------------------------------
-- Cardano.Ledger.Shelley.TxAuxData ------------------------------------------------------
------------------------------------------------------------------------------------------

-- | Max size of generated Metadatum List and Map
collectionDatumMaxSize :: Int
collectionDatumMaxSize :: Int
collectionDatumMaxSize = Int
5

-- | Max size of generated Metadata map
metadataMaxSize :: Int
metadataMaxSize :: Int
metadataMaxSize = Int
3

-- | Generate ShelleyTxAuxData (and compute hash) with given frequency
genMetadata :: Era era => Int -> Gen (StrictMaybe (ShelleyTxAuxData era))
genMetadata :: forall era.
Era era =>
Int -> Gen (StrictMaybe (ShelleyTxAuxData era))
genMetadata Int
metadataFrequency =
  [(Int, Gen (StrictMaybe (ShelleyTxAuxData era)))]
-> Gen (StrictMaybe (ShelleyTxAuxData era))
forall a. HasCallStack => [(Int, Gen a)] -> Gen a
frequency
    [ (Int
metadataFrequency, ShelleyTxAuxData era -> StrictMaybe (ShelleyTxAuxData era)
forall a. a -> StrictMaybe a
SJust (ShelleyTxAuxData era -> StrictMaybe (ShelleyTxAuxData era))
-> Gen (ShelleyTxAuxData era)
-> Gen (StrictMaybe (ShelleyTxAuxData era))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Gen (ShelleyTxAuxData era)
forall era. Era era => Gen (ShelleyTxAuxData era)
genMetadata')
    , (Int
100 Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
metadataFrequency, StrictMaybe (ShelleyTxAuxData era)
-> Gen (StrictMaybe (ShelleyTxAuxData era))
forall a. a -> Gen a
forall (f :: * -> *) a. Applicative f => a -> f a
pure StrictMaybe (ShelleyTxAuxData era)
forall a. StrictMaybe a
SNothing)
    ]

-- | Generate Metadata (and compute hash) of size up to 'metadataMaxSize'
genMetadata' :: Era era => Gen (ShelleyTxAuxData era)
genMetadata' :: forall era. Era era => Gen (ShelleyTxAuxData era)
genMetadata' = do
  Int
n <- (Int, Int) -> Gen Int
forall a. Random a => (a, a) -> Gen a
choose (Int
1, Int
metadataMaxSize)
  Map Word64 Metadatum -> ShelleyTxAuxData era
forall era. Era era => Map Word64 Metadatum -> ShelleyTxAuxData era
ShelleyTxAuxData (Map Word64 Metadatum -> ShelleyTxAuxData era)
-> ([(Word64, Metadatum)] -> Map Word64 Metadatum)
-> [(Word64, Metadatum)]
-> ShelleyTxAuxData era
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [(Word64, Metadatum)] -> Map Word64 Metadatum
forall k a. Ord k => [(k, a)] -> Map k a
Map.fromList
    ([(Word64, Metadatum)] -> ShelleyTxAuxData era)
-> Gen [(Word64, Metadatum)] -> Gen (ShelleyTxAuxData era)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Int -> Gen (Word64, Metadatum) -> Gen [(Word64, Metadatum)]
forall a. Int -> Gen a -> Gen [a]
vectorOf Int
n Gen (Word64, Metadatum)
genMetadatum

-- | Generate one of the Metadatum
genMetadatum :: Gen (Word64, Metadatum)
genMetadatum :: Gen (Word64, Metadatum)
genMetadatum = do
  (,)
    (Word64 -> Metadatum -> (Word64, Metadatum))
-> Gen Word64 -> Gen (Metadatum -> (Word64, Metadatum))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Gen Word64
forall a. Arbitrary a => Gen a
arbitrary
    Gen (Metadatum -> (Word64, Metadatum))
-> Gen Metadatum -> Gen (Word64, Metadatum)
forall a b. Gen (a -> b) -> Gen a -> Gen b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> [Gen Metadatum] -> Gen Metadatum
forall a. HasCallStack => [Gen a] -> Gen a
oneof
      [ Gen Metadatum
genDatumInt
      , Gen Metadatum
genDatumString
      , Gen Metadatum
genDatumBytestring
      , Gen Metadatum
genMetadatumList
      , Gen Metadatum
genMetadatumMap
      ]

genDatumInt :: Gen Metadatum
genDatumInt :: Gen Metadatum
genDatumInt =
  Integer -> Metadatum
I
    (Integer -> Metadatum) -> Gen Integer -> Gen Metadatum
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [(Int, Gen Integer)] -> Gen Integer
forall a. HasCallStack => [(Int, Gen a)] -> Gen a
frequency
      [ (Int
8, (Integer, Integer) -> Gen Integer
forall a. Random a => (a, a) -> Gen a
choose (Integer
minVal, Integer
maxVal))
      , (Int
1, Integer -> Gen Integer
forall a. a -> Gen a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Integer
minVal)
      , (Int
1, Integer -> Gen Integer
forall a. a -> Gen a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Integer
maxVal)
      ]
  where
    minVal, maxVal :: Integer
    minVal :: Integer
minVal = -Integer
maxVal
    maxVal :: Integer
maxVal = Word64 -> Integer
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Word64
forall a. Bounded a => a
maxBound :: Word64)

genDatumString :: Gen Metadatum
genDatumString :: Gen Metadatum
genDatumString =
  (Int -> Gen Metadatum) -> Gen Metadatum
forall a. (Int -> Gen a) -> Gen a
sized ((Int -> Gen Metadatum) -> Gen Metadatum)
-> (Int -> Gen Metadatum) -> Gen Metadatum
forall a b. (a -> b) -> a -> b
$ \Int
sz -> do
    Int
n <- (Int, Int) -> Gen Int
forall a. Random a => (a, a) -> Gen a
choose (Int
0, Int -> Int -> Int
forall a. Ord a => a -> a -> a
min Int
sz Int
64)
    String
cs <- Int -> Gen String
genUtf8StringOfSize Int
n
    let s :: Text
s = String -> Text
T.pack String
cs
    Bool -> Gen Metadatum -> Gen Metadatum
forall a. HasCallStack => Bool -> a -> a
assert (ByteString -> Int
BS.length (Text -> ByteString
T.encodeUtf8 Text
s) Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
n) (Gen Metadatum -> Gen Metadatum) -> Gen Metadatum -> Gen Metadatum
forall a b. (a -> b) -> a -> b
$
      Metadatum -> Gen Metadatum
forall a. a -> Gen a
forall (m :: * -> *) a. Monad m => a -> m a
return (Text -> Metadatum
S Text
s)

-- | Produce an arbitrary Unicode string such that it's UTF8 encoding size in
-- bytes is exactly the given length.
genUtf8StringOfSize :: Int -> Gen [Char]
genUtf8StringOfSize :: Int -> Gen String
genUtf8StringOfSize Int
0 = String -> Gen String
forall a. a -> Gen a
forall (m :: * -> *) a. Monad m => a -> m a
return []
genUtf8StringOfSize Int
n = do
  Int
cz <- (Int, Int) -> Gen Int
forall a. Random a => (a, a) -> Gen a
choose (Int
1, Int -> Int -> Int
forall a. Ord a => a -> a -> a
min Int
n Int
4)
  Char
c <- case Int
cz of
    Int
1 -> (Char, Char) -> Gen Char
forall a. Random a => (a, a) -> Gen a
choose (Char
'\x00000', Char
'\x00007f')
    Int
2 -> (Char, Char) -> Gen Char
forall a. Random a => (a, a) -> Gen a
choose (Char
'\x00080', Char
'\x0007ff')
    Int
3 ->
      [Gen Char] -> Gen Char
forall a. HasCallStack => [Gen a] -> Gen a
oneof
        [ (Char, Char) -> Gen Char
forall a. Random a => (a, a) -> Gen a
choose (Char
'\x00800', Char
'\x00d7ff')
        , -- skipping UTF-16 surrogates d800--dfff
          (Char, Char) -> Gen Char
forall a. Random a => (a, a) -> Gen a
choose (Char
'\x0e000', Char
'\x00ffff')
        ]
    Int
_ -> (Char, Char) -> Gen Char
forall a. Random a => (a, a) -> Gen a
choose (Char
'\x10000', Char
'\x10ffff')
  String
cs <- Int -> Gen String
genUtf8StringOfSize (Int
n Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
cz)
  String -> Gen String
forall a. a -> Gen a
forall (m :: * -> *) a. Monad m => a -> m a
return (Char
c Char -> String -> String
forall a. a -> [a] -> [a]
: String
cs)

genDatumBytestring :: Gen Metadatum
genDatumBytestring :: Gen Metadatum
genDatumBytestring =
  (Int -> Gen Metadatum) -> Gen Metadatum
forall a. (Int -> Gen a) -> Gen a
sized ((Int -> Gen Metadatum) -> Gen Metadatum)
-> (Int -> Gen Metadatum) -> Gen Metadatum
forall a b. (a -> b) -> a -> b
$ \Int
sz -> do
    Int
n <- (Int, Int) -> Gen Int
forall a. Random a => (a, a) -> Gen a
choose (Int
0, Int -> Int -> Int
forall a. Ord a => a -> a -> a
min Int
sz Int
64)
    ByteString -> Metadatum
B (ByteString -> Metadatum)
-> (String -> ByteString) -> String -> Metadatum
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> ByteString
BS.pack (String -> Metadatum) -> Gen String -> Gen Metadatum
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Int -> Gen Char -> Gen String
forall a. Int -> Gen a -> Gen [a]
vectorOf Int
n Gen Char
forall a. Arbitrary a => Gen a
arbitrary

-- | Generate a 'MD.List [Metadatum]'
--
-- Note: to limit generated metadata size, impact on transaction fees and
-- cost of hashing, we generate only lists of "simple" Datums, not lists
-- of list or map Datum.
genMetadatumList :: Gen Metadatum
genMetadatumList :: Gen Metadatum
genMetadatumList = [Metadatum] -> Metadatum
List ([Metadatum] -> Metadatum) -> Gen [Metadatum] -> Gen Metadatum
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Gen [Metadatum]
vectorOfMetadatumSimple

-- | Generate a 'MD.Map ('[(Metadatum, Metadatum)]')
genMetadatumMap :: Gen Metadatum
genMetadatumMap :: Gen Metadatum
genMetadatumMap =
  [(Metadatum, Metadatum)] -> Metadatum
Map ([(Metadatum, Metadatum)] -> Metadatum)
-> Gen [(Metadatum, Metadatum)] -> Gen Metadatum
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ([Metadatum] -> [Metadatum] -> [(Metadatum, Metadatum)]
forall a b. [a] -> [b] -> [(a, b)]
zip ([Metadatum] -> [Metadatum] -> [(Metadatum, Metadatum)])
-> Gen [Metadatum] -> Gen ([Metadatum] -> [(Metadatum, Metadatum)])
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Gen [Metadatum]
vectorOfMetadatumSimple Gen ([Metadatum] -> [(Metadatum, Metadatum)])
-> Gen [Metadatum] -> Gen [(Metadatum, Metadatum)]
forall a b. Gen (a -> b) -> Gen a -> Gen b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Gen [Metadatum]
vectorOfMetadatumSimple)

vectorOfMetadatumSimple :: Gen [Metadatum]
vectorOfMetadatumSimple :: Gen [Metadatum]
vectorOfMetadatumSimple = do
  Int
n <- (Int, Int) -> Gen Int
forall a. Random a => (a, a) -> Gen a
choose (Int
1, Int
collectionDatumMaxSize)
  Int -> Gen Metadatum -> Gen [Metadatum]
forall a. Int -> Gen a -> Gen [a]
vectorOf
    Int
n
    ( [Gen Metadatum] -> Gen Metadatum
forall a. HasCallStack => [Gen a] -> Gen a
oneof
        [ Gen Metadatum
genDatumInt
        , Gen Metadatum
genDatumString
        , Gen Metadatum
genDatumBytestring
        ]
    )

------------------------------------------------------------------------------------------
-- Era-independent generators ------------------------------------------------------------
------------------------------------------------------------------------------------------

instance Era era => Arbitrary (ShelleyTxCert era) where
  arbitrary :: Gen (ShelleyTxCert era)
arbitrary = Gen (ShelleyTxCert era)
forall a. (GArbitrary UnsizedOpts a, GUniformWeight a) => Gen a
genericArbitraryU
  shrink :: ShelleyTxCert era -> [ShelleyTxCert era]
shrink = ShelleyTxCert era -> [ShelleyTxCert era]
forall a.
(Generic a, RecursivelyShrink (Rep a), GSubterms (Rep a) a) =>
a -> [a]
genericShrink

instance Arbitrary ShelleyDelegCert where
  arbitrary :: Gen ShelleyDelegCert
arbitrary = Gen ShelleyDelegCert
forall a. (GArbitrary UnsizedOpts a, GUniformWeight a) => Gen a
genericArbitraryU
  shrink :: ShelleyDelegCert -> [ShelleyDelegCert]
shrink = ShelleyDelegCert -> [ShelleyDelegCert]
forall a.
(Generic a, RecursivelyShrink (Rep a), GSubterms (Rep a) a) =>
a -> [a]
genericShrink

instance Arbitrary GenesisDelegCert where
  arbitrary :: Gen GenesisDelegCert
arbitrary = Gen GenesisDelegCert
forall a. (GArbitrary UnsizedOpts a, GUniformWeight a) => Gen a
genericArbitraryU
  shrink :: GenesisDelegCert -> [GenesisDelegCert]
shrink = GenesisDelegCert -> [GenesisDelegCert]
forall a.
(Generic a, RecursivelyShrink (Rep a), GSubterms (Rep a) a) =>
a -> [a]
genericShrink

instance Arbitrary MIRCert where
  arbitrary :: Gen MIRCert
arbitrary = Gen MIRCert
forall a. (GArbitrary UnsizedOpts a, GUniformWeight a) => Gen a
genericArbitraryU
  shrink :: MIRCert -> [MIRCert]
shrink = MIRCert -> [MIRCert]
forall a.
(Generic a, RecursivelyShrink (Rep a), GSubterms (Rep a) a) =>
a -> [a]
genericShrink

instance Arbitrary MIRTarget where
  arbitrary :: Gen MIRTarget
arbitrary =
    [Gen MIRTarget] -> Gen MIRTarget
forall a. HasCallStack => [Gen a] -> Gen a
oneof
      [ Map (Credential 'Staking) DeltaCoin -> MIRTarget
StakeAddressesMIR (Map (Credential 'Staking) DeltaCoin -> MIRTarget)
-> Gen (Map (Credential 'Staking) DeltaCoin) -> Gen MIRTarget
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Gen (Map (Credential 'Staking) DeltaCoin)
forall a. Arbitrary a => Gen a
arbitrary
      , Coin -> MIRTarget
SendToOppositePotMIR (Coin -> MIRTarget) -> Gen Coin -> Gen MIRTarget
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Gen Coin
forall a. Arbitrary a => Gen a
arbitrary
      ]

instance Arbitrary MIRPot where
  arbitrary :: Gen MIRPot
arbitrary = Gen MIRPot
forall a. (GArbitrary UnsizedOpts a, GUniformWeight a) => Gen a
genericArbitraryU

instance (Era era, Arbitrary (PParamsUpdate era)) => Arbitrary (Update era) where
  arbitrary :: Gen (Update era)
arbitrary = Gen (Update era)
forall a. (GArbitrary UnsizedOpts a, GUniformWeight a) => Gen a
genericArbitraryU
  shrink :: Update era -> [Update era]
shrink = Update era -> [Update era]
forall a.
(Generic a, RecursivelyShrink (Rep a), GSubterms (Rep a) a) =>
a -> [a]
genericShrink

instance Arbitrary Byron.CompactTxOut where
  arbitrary :: Gen CompactTxOut
arbitrary = Gen CompactTxOut -> Gen CompactTxOut
forall a. Gen a -> Gen a
hedgehog Gen CompactTxOut
genCompactTxOut

instance Arbitrary ASC where
  arbitrary :: Gen ASC
arbitrary =
    ActiveSlotCoeff -> ASC
ASC
      (ActiveSlotCoeff -> ASC)
-> (Double -> ActiveSlotCoeff) -> Double -> ASC
forall b c a. (b -> c) -> (a -> b) -> a -> c
. PositiveUnitInterval -> ActiveSlotCoeff
mkActiveSlotCoeff
      (PositiveUnitInterval -> ActiveSlotCoeff)
-> (Double -> PositiveUnitInterval) -> Double -> ActiveSlotCoeff
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Rational -> PositiveUnitInterval
forall r.
(HasCallStack, Typeable r, BoundedRational r) =>
Rational -> r
unsafeBoundRational
      (Rational -> PositiveUnitInterval)
-> (Double -> Rational) -> Double -> PositiveUnitInterval
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Rational -> Rational
forall a. Fractional a => Rational -> a
fromRational
      (Rational -> Rational)
-> (Double -> Rational) -> Double -> Rational
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Double -> Rational
forall a. Real a => a -> Rational
toRational
      (Double -> ASC) -> Gen Double -> Gen ASC
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall a. Random a => (a, a) -> Gen a
choose @Double (Double
0.01, Double
0.5)

newtype ASC = ASC ActiveSlotCoeff
  deriving (Int -> ASC -> String -> String
[ASC] -> String -> String
ASC -> String
(Int -> ASC -> String -> String)
-> (ASC -> String) -> ([ASC] -> String -> String) -> Show ASC
forall a.
(Int -> a -> String -> String)
-> (a -> String) -> ([a] -> String -> String) -> Show a
$cshowsPrec :: Int -> ASC -> String -> String
showsPrec :: Int -> ASC -> String -> String
$cshow :: ASC -> String
show :: ASC -> String
$cshowList :: [ASC] -> String -> String
showList :: [ASC] -> String -> String
Show)

instance Arbitrary StakeProportion where
  arbitrary :: Gen StakeProportion
arbitrary = Rational -> StakeProportion
StakeProportion (Rational -> StakeProportion)
-> (Double -> Rational) -> Double -> StakeProportion
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Double -> Rational
forall a. Real a => a -> Rational
toRational (Double -> StakeProportion) -> Gen Double -> Gen StakeProportion
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall a. Random a => (a, a) -> Gen a
choose @Double (Double
0, Double
1)
  shrink :: StakeProportion -> [StakeProportion]
shrink (StakeProportion Rational
r) = Rational -> StakeProportion
StakeProportion (Rational -> StakeProportion) -> [Rational] -> [StakeProportion]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Rational -> [Rational]
forall a. RealFrac a => a -> [a]
shrinkRealFrac Rational
r

newtype StakeProportion = StakeProportion Rational
  deriving (Int -> StakeProportion -> String -> String
[StakeProportion] -> String -> String
StakeProportion -> String
(Int -> StakeProportion -> String -> String)
-> (StakeProportion -> String)
-> ([StakeProportion] -> String -> String)
-> Show StakeProportion
forall a.
(Int -> a -> String -> String)
-> (a -> String) -> ([a] -> String -> String) -> Show a
$cshowsPrec :: Int -> StakeProportion -> String -> String
showsPrec :: Int -> StakeProportion -> String -> String
$cshow :: StakeProportion -> String
show :: StakeProportion -> String
$cshowList :: [StakeProportion] -> String -> String
showList :: [StakeProportion] -> String -> String
Show)

instance Arbitrary (TxBody ShelleyEra) where
  arbitrary :: Gen (TxBody ShelleyEra)
arbitrary =
    Set TxIn
-> StrictSeq (TxOut ShelleyEra)
-> StrictSeq (TxCert ShelleyEra)
-> Withdrawals
-> Coin
-> SlotNo
-> StrictMaybe (Update ShelleyEra)
-> StrictMaybe TxAuxDataHash
-> TxBody ShelleyEra
Set TxIn
-> StrictSeq (ShelleyTxOut ShelleyEra)
-> StrictSeq (ShelleyTxCert ShelleyEra)
-> Withdrawals
-> Coin
-> SlotNo
-> StrictMaybe (Update ShelleyEra)
-> StrictMaybe TxAuxDataHash
-> TxBody ShelleyEra
ShelleyTxBody
      (Set TxIn
 -> StrictSeq (ShelleyTxOut ShelleyEra)
 -> StrictSeq (ShelleyTxCert ShelleyEra)
 -> Withdrawals
 -> Coin
 -> SlotNo
 -> StrictMaybe (Update ShelleyEra)
 -> StrictMaybe TxAuxDataHash
 -> TxBody ShelleyEra)
-> Gen (Set TxIn)
-> Gen
     (StrictSeq (ShelleyTxOut ShelleyEra)
      -> StrictSeq (ShelleyTxCert ShelleyEra)
      -> Withdrawals
      -> Coin
      -> SlotNo
      -> StrictMaybe (Update ShelleyEra)
      -> StrictMaybe TxAuxDataHash
      -> TxBody ShelleyEra)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Gen (Set TxIn)
forall a. Arbitrary a => Gen a
arbitrary
      Gen
  (StrictSeq (ShelleyTxOut ShelleyEra)
   -> StrictSeq (ShelleyTxCert ShelleyEra)
   -> Withdrawals
   -> Coin
   -> SlotNo
   -> StrictMaybe (Update ShelleyEra)
   -> StrictMaybe TxAuxDataHash
   -> TxBody ShelleyEra)
-> Gen (StrictSeq (ShelleyTxOut ShelleyEra))
-> Gen
     (StrictSeq (ShelleyTxCert ShelleyEra)
      -> Withdrawals
      -> Coin
      -> SlotNo
      -> StrictMaybe (Update ShelleyEra)
      -> StrictMaybe TxAuxDataHash
      -> TxBody ShelleyEra)
forall a b. Gen (a -> b) -> Gen a -> Gen b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Gen (StrictSeq (ShelleyTxOut ShelleyEra))
forall a. Arbitrary a => Gen a
arbitrary
      Gen
  (StrictSeq (ShelleyTxCert ShelleyEra)
   -> Withdrawals
   -> Coin
   -> SlotNo
   -> StrictMaybe (Update ShelleyEra)
   -> StrictMaybe TxAuxDataHash
   -> TxBody ShelleyEra)
-> Gen (StrictSeq (ShelleyTxCert ShelleyEra))
-> Gen
     (Withdrawals
      -> Coin
      -> SlotNo
      -> StrictMaybe (Update ShelleyEra)
      -> StrictMaybe TxAuxDataHash
      -> TxBody ShelleyEra)
forall a b. Gen (a -> b) -> Gen a -> Gen b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Gen (StrictSeq (ShelleyTxCert ShelleyEra))
forall a. Arbitrary a => Gen a
arbitrary
      Gen
  (Withdrawals
   -> Coin
   -> SlotNo
   -> StrictMaybe (Update ShelleyEra)
   -> StrictMaybe TxAuxDataHash
   -> TxBody ShelleyEra)
-> Gen Withdrawals
-> Gen
     (Coin
      -> SlotNo
      -> StrictMaybe (Update ShelleyEra)
      -> StrictMaybe TxAuxDataHash
      -> TxBody ShelleyEra)
forall a b. Gen (a -> b) -> Gen a -> Gen b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Gen Withdrawals
forall a. Arbitrary a => Gen a
arbitrary
      Gen
  (Coin
   -> SlotNo
   -> StrictMaybe (Update ShelleyEra)
   -> StrictMaybe TxAuxDataHash
   -> TxBody ShelleyEra)
-> Gen Coin
-> Gen
     (SlotNo
      -> StrictMaybe (Update ShelleyEra)
      -> StrictMaybe TxAuxDataHash
      -> TxBody ShelleyEra)
forall a b. Gen (a -> b) -> Gen a -> Gen b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Gen Coin
forall a. Arbitrary a => Gen a
arbitrary
      Gen
  (SlotNo
   -> StrictMaybe (Update ShelleyEra)
   -> StrictMaybe TxAuxDataHash
   -> TxBody ShelleyEra)
-> Gen SlotNo
-> Gen
     (StrictMaybe (Update ShelleyEra)
      -> StrictMaybe TxAuxDataHash -> TxBody ShelleyEra)
forall a b. Gen (a -> b) -> Gen a -> Gen b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Gen SlotNo
forall a. Arbitrary a => Gen a
arbitrary
      Gen
  (StrictMaybe (Update ShelleyEra)
   -> StrictMaybe TxAuxDataHash -> TxBody ShelleyEra)
-> Gen (StrictMaybe (Update ShelleyEra))
-> Gen (StrictMaybe TxAuxDataHash -> TxBody ShelleyEra)
forall a b. Gen (a -> b) -> Gen a -> Gen b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Int -> Int)
-> Gen (StrictMaybe (Update ShelleyEra))
-> Gen (StrictMaybe (Update ShelleyEra))
forall a. (Int -> Int) -> Gen a -> Gen a
scale (Int -> Int -> Int
forall a. Integral a => a -> a -> a
`div` Int
15) Gen (StrictMaybe (Update ShelleyEra))
forall a. Arbitrary a => Gen a
arbitrary
      Gen (StrictMaybe TxAuxDataHash -> TxBody ShelleyEra)
-> Gen (StrictMaybe TxAuxDataHash) -> Gen (TxBody ShelleyEra)
forall a b. Gen (a -> b) -> Gen a -> Gen b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Gen (StrictMaybe TxAuxDataHash)
forall a. Arbitrary a => Gen a
arbitrary

genTx ::
  ( EraTx era
  , Arbitrary (TxBody era)
  , Arbitrary (TxAuxData era)
  , Arbitrary (TxWits era)
  ) =>
  Gen (ShelleyTx era)
genTx :: forall era.
(EraTx era, Arbitrary (TxBody era), Arbitrary (TxAuxData era),
 Arbitrary (TxWits era)) =>
Gen (ShelleyTx era)
genTx =
  TxBody era
-> TxWits era -> StrictMaybe (TxAuxData era) -> ShelleyTx era
forall era.
EraTx era =>
TxBody era
-> TxWits era -> StrictMaybe (TxAuxData era) -> ShelleyTx era
ShelleyTx
    (TxBody era
 -> TxWits era -> StrictMaybe (TxAuxData era) -> ShelleyTx era)
-> Gen (TxBody era)
-> Gen (TxWits era -> StrictMaybe (TxAuxData era) -> ShelleyTx era)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Gen (TxBody era)
forall a. Arbitrary a => Gen a
arbitrary
    Gen (TxWits era -> StrictMaybe (TxAuxData era) -> ShelleyTx era)
-> Gen (TxWits era)
-> Gen (StrictMaybe (TxAuxData era) -> ShelleyTx era)
forall a b. Gen (a -> b) -> Gen a -> Gen b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Int -> Gen (TxWits era) -> Gen (TxWits era)
forall a. HasCallStack => Int -> Gen a -> Gen a
resize Int
maxTxWits Gen (TxWits era)
forall a. Arbitrary a => Gen a
arbitrary
    Gen (StrictMaybe (TxAuxData era) -> ShelleyTx era)
-> Gen (StrictMaybe (TxAuxData era)) -> Gen (ShelleyTx era)
forall a b. Gen (a -> b) -> Gen a -> Gen b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Gen (StrictMaybe (TxAuxData era))
forall a. Arbitrary a => Gen a
arbitrary

maxTxWits :: Int
maxTxWits :: Int
maxTxWits = Int
5

instance Arbitrary Metadatum where
  arbitrary :: Gen Metadatum
arbitrary = Int -> Gen Metadatum
sizedMetadatum Int
maxMetadatumDepth

instance Era era => Arbitrary (ShelleyTxAuxData era) where
  arbitrary :: Gen (ShelleyTxAuxData era)
arbitrary = Map Word64 Metadatum -> ShelleyTxAuxData era
forall era. Era era => Map Word64 Metadatum -> ShelleyTxAuxData era
ShelleyTxAuxData (Map Word64 Metadatum -> ShelleyTxAuxData era)
-> Gen (Map Word64 Metadatum) -> Gen (ShelleyTxAuxData era)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Gen (Map Word64 Metadatum)
forall a. Arbitrary a => Gen a
arbitrary

deriving newtype instance Arbitrary NominalDiffTimeMicro

maxMetadatumDepth :: Int
maxMetadatumDepth :: Int
maxMetadatumDepth = Int
2

maxMetadatumListLens :: Int
maxMetadatumListLens :: Int
maxMetadatumListLens = Int
5

sizedMetadatum :: Int -> Gen Metadatum
sizedMetadatum :: Int -> Gen Metadatum
sizedMetadatum Int
0 =
  [Gen Metadatum] -> Gen Metadatum
forall a. HasCallStack => [Gen a] -> Gen a
oneof
    [ Integer -> Metadatum
I (Integer -> Metadatum) -> Gen Integer -> Gen Metadatum
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Gen Integer
forall a. Arbitrary a => Gen a
arbitrary
    , ByteString -> Metadatum
B (ByteString -> Metadatum) -> Gen ByteString -> Gen Metadatum
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Gen ByteString
forall a. Arbitrary a => Gen a
arbitrary
    , Text -> Metadatum
S (Text -> Metadatum) -> Gen Text -> Gen Metadatum
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (String -> Text
T.pack (String -> Text) -> Gen String -> Gen Text
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Gen String
forall a. Arbitrary a => Gen a
arbitrary)
    ]
sizedMetadatum Int
n =
  let xsGen :: Gen [Metadatum]
xsGen = Gen Metadatum -> Gen [Metadatum]
forall a. Gen a -> Gen [a]
listOf (Int -> Gen Metadatum
sizedMetadatum (Int
n Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1))
   in [Gen Metadatum] -> Gen Metadatum
forall a. HasCallStack => [Gen a] -> Gen a
oneof
        [ [(Metadatum, Metadatum)] -> Metadatum
Map ([(Metadatum, Metadatum)] -> Metadatum)
-> Gen [(Metadatum, Metadatum)] -> Gen Metadatum
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ([Metadatum] -> [Metadatum] -> [(Metadatum, Metadatum)]
forall a b. [a] -> [b] -> [(a, b)]
zip ([Metadatum] -> [Metadatum] -> [(Metadatum, Metadatum)])
-> Gen [Metadatum] -> Gen ([Metadatum] -> [(Metadatum, Metadatum)])
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Int -> Gen [Metadatum] -> Gen [Metadatum]
forall a. HasCallStack => Int -> Gen a -> Gen a
resize Int
maxMetadatumListLens Gen [Metadatum]
xsGen Gen ([Metadatum] -> [(Metadatum, Metadatum)])
-> Gen [Metadatum] -> Gen [(Metadatum, Metadatum)]
forall a b. Gen (a -> b) -> Gen a -> Gen b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Gen [Metadatum]
xsGen)
        , [Metadatum] -> Metadatum
List ([Metadatum] -> Metadatum) -> Gen [Metadatum] -> Gen Metadatum
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Int -> Gen [Metadatum] -> Gen [Metadatum]
forall a. HasCallStack => Int -> Gen a -> Gen a
resize Int
maxMetadatumListLens Gen [Metadatum]
xsGen
        , Integer -> Metadatum
I (Integer -> Metadatum) -> Gen Integer -> Gen Metadatum
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Gen Integer
forall a. Arbitrary a => Gen a
arbitrary
        , ByteString -> Metadatum
B (ByteString -> Metadatum) -> Gen ByteString -> Gen Metadatum
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Gen ByteString
forall a. Arbitrary a => Gen a
arbitrary
        , Text -> Metadatum
S (Text -> Metadatum) -> Gen Text -> Gen Metadatum
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (String -> Text
T.pack (String -> Text) -> Gen String -> Gen Text
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Gen String
forall a. Arbitrary a => Gen a
arbitrary)
        ]

instance Arbitrary VotingPeriod where
  arbitrary :: Gen VotingPeriod
arbitrary = Gen VotingPeriod
forall a. (GArbitrary UnsizedOpts a, GUniformWeight a) => Gen a
genericArbitraryU
  shrink :: VotingPeriod -> [VotingPeriod]
shrink = VotingPeriod -> [VotingPeriod]
forall a.
(Generic a, RecursivelyShrink (Rep a), GSubterms (Rep a) a) =>
a -> [a]
genericShrink

instance (Arbitrary k, Arbitrary v) => Arbitrary (LM.ListMap k v) where
  arbitrary :: Gen (ListMap k v)
arbitrary = Gen (ListMap k v)
forall a. (GArbitrary UnsizedOpts a, GUniformWeight a) => Gen a
genericArbitraryU
  shrink :: ListMap k v -> [ListMap k v]
shrink = ListMap k v -> [ListMap k v]
forall a.
(Generic a, RecursivelyShrink (Rep a), GSubterms (Rep a) a) =>
a -> [a]
genericShrink

instance
  ( ShelleyEraScript era
  , NativeScript era ~ MultiSig era
  ) =>
  Arbitrary (MultiSig era)
  where
  arbitrary :: Gen (MultiSig era)
arbitrary = Int -> Gen (NativeScript era)
forall era. ShelleyEraScript era => Int -> Gen (NativeScript era)
sizedMultiSig Int
maxMultiSigDepth

maxMultiSigDepth :: Int
maxMultiSigDepth :: Int
maxMultiSigDepth = Int
3

maxMultiSigListLens :: Int
maxMultiSigListLens :: Int
maxMultiSigListLens = Int
4

sizedMultiSig :: ShelleyEraScript era => Int -> Gen (NativeScript era)
sizedMultiSig :: forall era. ShelleyEraScript era => Int -> Gen (NativeScript era)
sizedMultiSig Int
0 = KeyHash 'Witness -> NativeScript era
forall era.
ShelleyEraScript era =>
KeyHash 'Witness -> NativeScript era
RequireSignature (KeyHash 'Witness -> NativeScript era)
-> Gen (KeyHash 'Witness) -> Gen (NativeScript era)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Gen (KeyHash 'Witness)
forall a. Arbitrary a => Gen a
arbitrary
sizedMultiSig Int
n = [Gen (NativeScript era)] -> Gen (NativeScript era)
forall a. HasCallStack => [Gen a] -> Gen a
oneof ([Gen (NativeScript era)] -> Gen (NativeScript era))
-> [Gen (NativeScript era)] -> Gen (NativeScript era)
forall a b. (a -> b) -> a -> b
$ Int -> [Gen (NativeScript era)]
forall era. ShelleyEraScript era => Int -> [Gen (NativeScript era)]
sizedNativeScriptGens Int
n

sizedNativeScriptGens :: ShelleyEraScript era => Int -> [Gen (NativeScript era)]
sizedNativeScriptGens :: forall era. ShelleyEraScript era => Int -> [Gen (NativeScript era)]
sizedNativeScriptGens Int
n =
  [ KeyHash 'Witness -> NativeScript era
forall era.
ShelleyEraScript era =>
KeyHash 'Witness -> NativeScript era
RequireSignature (KeyHash 'Witness -> NativeScript era)
-> Gen (KeyHash 'Witness) -> Gen (NativeScript era)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Gen (KeyHash 'Witness)
forall a. Arbitrary a => Gen a
arbitrary
  , StrictSeq (NativeScript era) -> NativeScript era
forall era.
ShelleyEraScript era =>
StrictSeq (NativeScript era) -> NativeScript era
RequireAllOf (StrictSeq (NativeScript era) -> NativeScript era)
-> Gen (StrictSeq (NativeScript era)) -> Gen (NativeScript era)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ([NativeScript era] -> StrictSeq (NativeScript era)
forall a. [a] -> StrictSeq a
fromList ([NativeScript era] -> StrictSeq (NativeScript era))
-> Gen [NativeScript era] -> Gen (StrictSeq (NativeScript era))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Int -> Gen [NativeScript era] -> Gen [NativeScript era]
forall a. HasCallStack => Int -> Gen a -> Gen a
resize Int
maxMultiSigListLens (Gen (NativeScript era) -> Gen [NativeScript era]
forall a. Gen a -> Gen [a]
listOf (Int -> Gen (NativeScript era)
forall era. ShelleyEraScript era => Int -> Gen (NativeScript era)
sizedMultiSig (Int
n Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1))))
  , StrictSeq (NativeScript era) -> NativeScript era
forall era.
ShelleyEraScript era =>
StrictSeq (NativeScript era) -> NativeScript era
RequireAnyOf (StrictSeq (NativeScript era) -> NativeScript era)
-> Gen (StrictSeq (NativeScript era)) -> Gen (NativeScript era)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ([NativeScript era] -> StrictSeq (NativeScript era)
forall a. [a] -> StrictSeq a
fromList ([NativeScript era] -> StrictSeq (NativeScript era))
-> Gen [NativeScript era] -> Gen (StrictSeq (NativeScript era))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Int -> Gen [NativeScript era] -> Gen [NativeScript era]
forall a. HasCallStack => Int -> Gen a -> Gen a
resize Int
maxMultiSigListLens (Gen (NativeScript era) -> Gen [NativeScript era]
forall a. Gen a -> Gen [a]
listOf (Int -> Gen (NativeScript era)
forall era. ShelleyEraScript era => Int -> Gen (NativeScript era)
sizedMultiSig (Int
n Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1))))
  , do
      [NativeScript era]
subs <- Int -> Gen [NativeScript era] -> Gen [NativeScript era]
forall a. HasCallStack => Int -> Gen a -> Gen a
resize Int
maxMultiSigListLens (Gen (NativeScript era) -> Gen [NativeScript era]
forall a. Gen a -> Gen [a]
listOf (Int -> Gen (NativeScript era)
forall era. ShelleyEraScript era => Int -> Gen (NativeScript era)
sizedMultiSig (Int
n Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1)))
      let i :: Int
i = [NativeScript era] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [NativeScript era]
subs
      Int -> StrictSeq (NativeScript era) -> NativeScript era
forall era.
ShelleyEraScript era =>
Int -> StrictSeq (NativeScript era) -> NativeScript era
RequireMOf (Int -> StrictSeq (NativeScript era) -> NativeScript era)
-> Gen Int
-> Gen (StrictSeq (NativeScript era) -> NativeScript era)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Int, Int) -> Gen Int
forall a. Random a => (a, a) -> Gen a
choose (Int
0, Int
i) Gen (StrictSeq (NativeScript era) -> NativeScript era)
-> Gen (StrictSeq (NativeScript era)) -> Gen (NativeScript era)
forall a b. Gen (a -> b) -> Gen a -> Gen b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> StrictSeq (NativeScript era) -> Gen (StrictSeq (NativeScript era))
forall a. a -> Gen a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ([NativeScript era] -> StrictSeq (NativeScript era)
forall a. [a] -> StrictSeq a
fromList [NativeScript era]
subs)
  ]

instance
  Arbitrary (PParams ShelleyEra) =>
  Arbitrary ShelleyGenesis
  where
  arbitrary :: Gen ShelleyGenesis
arbitrary = do
    UTCTime
sgSystemStart <- Gen UTCTime
forall a. Arbitrary a => Gen a
arbitrary
    Word32
sgNetworkMagic <- Gen Word32
forall a. Arbitrary a => Gen a
arbitrary
    Network
sgNetworkId <- Gen Network
forall a. Arbitrary a => Gen a
arbitrary
    PositiveUnitInterval
sgActiveSlotsCoeff <- Gen PositiveUnitInterval
forall a. Arbitrary a => Gen a
arbitrary
    NonZero Word64
sgSecurityParam <- Gen (NonZero Word64)
forall a. Arbitrary a => Gen a
arbitrary
    EpochSize
sgEpochLength <- Gen EpochSize
forall a. Arbitrary a => Gen a
arbitrary
    Word64
sgSlotsPerKESPeriod <- Gen Word64
forall a. Arbitrary a => Gen a
arbitrary
    Word64
sgMaxKESEvolutions <- Gen Word64
forall a. Arbitrary a => Gen a
arbitrary
    NominalDiffTimeMicro
sgSlotLength <- (NominalDiffTimeMicro
-> NominalDiffTimeMicro -> NominalDiffTimeMicro
forall a. Num a => a -> a -> a
* NominalDiffTimeMicro
1000000) (NominalDiffTimeMicro -> NominalDiffTimeMicro)
-> Gen NominalDiffTimeMicro -> Gen NominalDiffTimeMicro
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Gen NominalDiffTimeMicro
forall a. Arbitrary a => Gen a
arbitrary
    Word64
sgUpdateQuorum <- Gen Word64
forall a. Arbitrary a => Gen a
arbitrary
    Word64
sgMaxLovelaceSupply <- Gen Word64
forall a. Arbitrary a => Gen a
arbitrary
    PParams ShelleyEra
sgProtocolParams <- Gen (PParams ShelleyEra)
forall a. Arbitrary a => Gen a
arbitrary
    Map (KeyHash 'Genesis) GenDelegPair
sgGenDelegs <- Gen (Map (KeyHash 'Genesis) GenDelegPair)
forall a. Arbitrary a => Gen a
arbitrary
    ListMap Addr Coin
sgInitialFunds <- Gen (ListMap Addr Coin)
forall a. Arbitrary a => Gen a
arbitrary
    ShelleyGenesisStaking
sgStaking <- Gen ShelleyGenesisStaking
forall a. Arbitrary a => Gen a
arbitrary
    ShelleyGenesis -> Gen ShelleyGenesis
forall a. a -> Gen a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ShelleyGenesis {Word32
Word64
Map (KeyHash 'Genesis) GenDelegPair
UTCTime
ListMap Addr Coin
EpochSize
NonZero Word64
Network
PositiveUnitInterval
PParams ShelleyEra
NominalDiffTimeMicro
ShelleyGenesisStaking
sgSystemStart :: UTCTime
sgNetworkMagic :: Word32
sgNetworkId :: Network
sgActiveSlotsCoeff :: PositiveUnitInterval
sgSecurityParam :: NonZero Word64
sgEpochLength :: EpochSize
sgSlotsPerKESPeriod :: Word64
sgMaxKESEvolutions :: Word64
sgSlotLength :: NominalDiffTimeMicro
sgUpdateQuorum :: Word64
sgMaxLovelaceSupply :: Word64
sgProtocolParams :: PParams ShelleyEra
sgGenDelegs :: Map (KeyHash 'Genesis) GenDelegPair
sgInitialFunds :: ListMap Addr Coin
sgStaking :: ShelleyGenesisStaking
sgSystemStart :: UTCTime
sgNetworkMagic :: Word32
sgNetworkId :: Network
sgActiveSlotsCoeff :: PositiveUnitInterval
sgSecurityParam :: NonZero Word64
sgEpochLength :: EpochSize
sgSlotsPerKESPeriod :: Word64
sgMaxKESEvolutions :: Word64
sgSlotLength :: NominalDiffTimeMicro
sgUpdateQuorum :: Word64
sgMaxLovelaceSupply :: Word64
sgProtocolParams :: PParams ShelleyEra
sgGenDelegs :: Map (KeyHash 'Genesis) GenDelegPair
sgInitialFunds :: ListMap Addr Coin
sgStaking :: ShelleyGenesisStaking
..}

instance Arbitrary ShelleyGenesisStaking where
  arbitrary :: Gen ShelleyGenesisStaking
arbitrary = ListMap (KeyHash 'StakePool) PoolParams
-> ListMap (KeyHash 'Staking) (KeyHash 'StakePool)
-> ShelleyGenesisStaking
ShelleyGenesisStaking (ListMap (KeyHash 'StakePool) PoolParams
 -> ListMap (KeyHash 'Staking) (KeyHash 'StakePool)
 -> ShelleyGenesisStaking)
-> Gen (ListMap (KeyHash 'StakePool) PoolParams)
-> Gen
     (ListMap (KeyHash 'Staking) (KeyHash 'StakePool)
      -> ShelleyGenesisStaking)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Gen (ListMap (KeyHash 'StakePool) PoolParams)
forall a. Arbitrary a => Gen a
arbitrary Gen
  (ListMap (KeyHash 'Staking) (KeyHash 'StakePool)
   -> ShelleyGenesisStaking)
-> Gen (ListMap (KeyHash 'Staking) (KeyHash 'StakePool))
-> Gen ShelleyGenesisStaking
forall a b. Gen (a -> b) -> Gen a -> Gen b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Gen (ListMap (KeyHash 'Staking) (KeyHash 'StakePool))
forall a. Arbitrary a => Gen a
arbitrary

instance
  ( Era era
  , EraScript era
  , Arbitrary (Script era)
  ) =>
  Arbitrary (ShelleyTxWits era)
  where
  arbitrary :: Gen (ShelleyTxWits era)
arbitrary =
    Set (WitVKey 'Witness)
-> Map ScriptHash (Script era)
-> Set BootstrapWitness
-> ShelleyTxWits era
forall era.
EraScript era =>
Set (WitVKey 'Witness)
-> Map ScriptHash (Script era)
-> Set BootstrapWitness
-> ShelleyTxWits era
ShelleyTxWits
      (Set (WitVKey 'Witness)
 -> Map ScriptHash (Script era)
 -> Set BootstrapWitness
 -> ShelleyTxWits era)
-> Gen (Set (WitVKey 'Witness))
-> Gen
     (Map ScriptHash (Script era)
      -> Set BootstrapWitness -> ShelleyTxWits era)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Gen (Set (WitVKey 'Witness))
forall a. Arbitrary a => Gen a
arbitrary
      Gen
  (Map ScriptHash (Script era)
   -> Set BootstrapWitness -> ShelleyTxWits era)
-> Gen (Map ScriptHash (Script era))
-> Gen (Set BootstrapWitness -> ShelleyTxWits era)
forall a b. Gen (a -> b) -> Gen a -> Gen b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> ([Script era] -> Map ScriptHash (Script era)
mscriptsToWits ([Script era] -> Map ScriptHash (Script era))
-> Gen [Script era] -> Gen (Map ScriptHash (Script era))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Gen [Script era]
forall a. Arbitrary a => Gen a
arbitrary)
      Gen (Set BootstrapWitness -> ShelleyTxWits era)
-> Gen (Set BootstrapWitness) -> Gen (ShelleyTxWits era)
forall a b. Gen (a -> b) -> Gen a -> Gen b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Gen (Set BootstrapWitness)
forall a. Arbitrary a => Gen a
arbitrary
    where
      mscriptsToWits :: [Script era] -> Map ScriptHash (Script era)
mscriptsToWits = [(ScriptHash, Script era)] -> Map ScriptHash (Script era)
forall k a. Ord k => [(k, a)] -> Map k a
Map.fromList ([(ScriptHash, Script era)] -> Map ScriptHash (Script era))
-> ([Script era] -> [(ScriptHash, Script era)])
-> [Script era]
-> Map ScriptHash (Script era)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Script era -> (ScriptHash, Script era))
-> [Script era] -> [(ScriptHash, Script era)]
forall a b. (a -> b) -> [a] -> [b]
map (\Script era
s -> (forall era. EraScript era => Script era -> ScriptHash
hashScript @era Script era
s, Script era
s))

instance Era era => Arbitrary (ShelleyPpupPredFailure era) where
  arbitrary :: Gen (ShelleyPpupPredFailure era)
arbitrary = Gen (ShelleyPpupPredFailure era)
forall a. (GArbitrary UnsizedOpts a, GUniformWeight a) => Gen a
genericArbitraryU
  shrink :: ShelleyPpupPredFailure era -> [ShelleyPpupPredFailure era]
shrink = ShelleyPpupPredFailure era -> [ShelleyPpupPredFailure era]
forall a.
(Generic a, RecursivelyShrink (Rep a), GSubterms (Rep a) a) =>
a -> [a]
genericShrink

instance Era era => Arbitrary (ShelleyPoolPredFailure era) where
  arbitrary :: Gen (ShelleyPoolPredFailure era)
arbitrary =
    [Gen (ShelleyPoolPredFailure era)]
-> Gen (ShelleyPoolPredFailure era)
forall a. HasCallStack => [Gen a] -> Gen a
oneof
      [ KeyHash 'StakePool -> ShelleyPoolPredFailure era
forall era. KeyHash 'StakePool -> ShelleyPoolPredFailure era
StakePoolNotRegisteredOnKeyPOOL (KeyHash 'StakePool -> ShelleyPoolPredFailure era)
-> Gen (KeyHash 'StakePool) -> Gen (ShelleyPoolPredFailure era)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Gen (KeyHash 'StakePool)
forall a. Arbitrary a => Gen a
arbitrary
      , do
          EpochNo
a <- Gen EpochNo
forall a. Arbitrary a => Gen a
arbitrary
          EpochNo
b <- Gen EpochNo
forall a. Arbitrary a => Gen a
arbitrary
          Mismatch 'RelGT EpochNo
-> Mismatch 'RelLTEQ EpochNo -> ShelleyPoolPredFailure era
forall era.
Mismatch 'RelGT EpochNo
-> Mismatch 'RelLTEQ EpochNo -> ShelleyPoolPredFailure era
StakePoolRetirementWrongEpochPOOL (EpochNo -> EpochNo -> Mismatch 'RelGT EpochNo
forall (r :: Relation) a. a -> a -> Mismatch r a
Mismatch EpochNo
a EpochNo
b) (Mismatch 'RelLTEQ EpochNo -> ShelleyPoolPredFailure era)
-> (EpochNo -> Mismatch 'RelLTEQ EpochNo)
-> EpochNo
-> ShelleyPoolPredFailure era
forall b c a. (b -> c) -> (a -> b) -> a -> c
. EpochNo -> EpochNo -> Mismatch 'RelLTEQ EpochNo
forall (r :: Relation) a. a -> a -> Mismatch r a
Mismatch EpochNo
a (EpochNo -> ShelleyPoolPredFailure era)
-> Gen EpochNo -> Gen (ShelleyPoolPredFailure era)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Gen EpochNo
forall a. Arbitrary a => Gen a
arbitrary
      , Mismatch 'RelGTEQ Coin -> ShelleyPoolPredFailure era
forall era. Mismatch 'RelGTEQ Coin -> ShelleyPoolPredFailure era
StakePoolCostTooLowPOOL (Mismatch 'RelGTEQ Coin -> ShelleyPoolPredFailure era)
-> Gen (Mismatch 'RelGTEQ Coin) -> Gen (ShelleyPoolPredFailure era)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Gen (Mismatch 'RelGTEQ Coin)
forall a. Arbitrary a => Gen a
arbitrary
      , Mismatch 'RelEQ Network
-> KeyHash 'StakePool -> ShelleyPoolPredFailure era
forall era.
Mismatch 'RelEQ Network
-> KeyHash 'StakePool -> ShelleyPoolPredFailure era
WrongNetworkPOOL (Mismatch 'RelEQ Network
 -> KeyHash 'StakePool -> ShelleyPoolPredFailure era)
-> Gen (Mismatch 'RelEQ Network)
-> Gen (KeyHash 'StakePool -> ShelleyPoolPredFailure era)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Gen (Mismatch 'RelEQ Network)
forall a. Arbitrary a => Gen a
arbitrary Gen (KeyHash 'StakePool -> ShelleyPoolPredFailure era)
-> Gen (KeyHash 'StakePool) -> Gen (ShelleyPoolPredFailure era)
forall a b. Gen (a -> b) -> Gen a -> Gen b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Gen (KeyHash 'StakePool)
forall a. Arbitrary a => Gen a
arbitrary
      , KeyHash 'StakePool -> Int -> ShelleyPoolPredFailure era
forall era. KeyHash 'StakePool -> Int -> ShelleyPoolPredFailure era
PoolMedataHashTooBig (KeyHash 'StakePool -> Int -> ShelleyPoolPredFailure era)
-> Gen (KeyHash 'StakePool)
-> Gen (Int -> ShelleyPoolPredFailure era)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Gen (KeyHash 'StakePool)
forall a. Arbitrary a => Gen a
arbitrary Gen (Int -> ShelleyPoolPredFailure era)
-> Gen Int -> Gen (ShelleyPoolPredFailure era)
forall a b. Gen (a -> b) -> Gen a -> Gen b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Gen Int
forall a. Arbitrary a => Gen a
arbitrary
      ]
  shrink :: ShelleyPoolPredFailure era -> [ShelleyPoolPredFailure era]
shrink = ShelleyPoolPredFailure era -> [ShelleyPoolPredFailure era]
forall a.
(Generic a, RecursivelyShrink (Rep a), GSubterms (Rep a) a) =>
a -> [a]
genericShrink

instance
  ( Era era
  , Arbitrary (PredicateFailure (EraRule "POOL" era))
  , Arbitrary (PredicateFailure (EraRule "DELEG" era))
  ) =>
  Arbitrary (ShelleyDelplPredFailure era)
  where
  arbitrary :: Gen (ShelleyDelplPredFailure era)
arbitrary = Gen (ShelleyDelplPredFailure era)
forall a. (GArbitrary UnsizedOpts a, GUniformWeight a) => Gen a
genericArbitraryU
  shrink :: ShelleyDelplPredFailure era -> [ShelleyDelplPredFailure era]
shrink = ShelleyDelplPredFailure era -> [ShelleyDelplPredFailure era]
forall a. (Generic a, RecursivelyShrink (Rep a)) => a -> [a]
recursivelyShrink

instance
  Era era =>
  Arbitrary (ShelleyDelegPredFailure era)
  where
  arbitrary :: Gen (ShelleyDelegPredFailure era)
arbitrary = Gen (ShelleyDelegPredFailure era)
forall a. (GArbitrary UnsizedOpts a, GUniformWeight a) => Gen a
genericArbitraryU
  shrink :: ShelleyDelegPredFailure era -> [ShelleyDelegPredFailure era]
shrink = ShelleyDelegPredFailure era -> [ShelleyDelegPredFailure era]
forall a.
(Generic a, RecursivelyShrink (Rep a), GSubterms (Rep a) a) =>
a -> [a]
genericShrink

instance
  ( Era era
  , Arbitrary (PredicateFailure (EraRule "DELPL" era))
  ) =>
  Arbitrary (ShelleyDelegsPredFailure era)
  where
  arbitrary :: Gen (ShelleyDelegsPredFailure era)
arbitrary = Gen (ShelleyDelegsPredFailure era)
forall a. (GArbitrary UnsizedOpts a, GUniformWeight a) => Gen a
genericArbitraryU
  shrink :: ShelleyDelegsPredFailure era -> [ShelleyDelegsPredFailure era]
shrink = ShelleyDelegsPredFailure era -> [ShelleyDelegsPredFailure era]
forall a. (Generic a, RecursivelyShrink (Rep a)) => a -> [a]
recursivelyShrink

instance
  ( Era era
  , Arbitrary (PredicateFailure (EraRule "LEDGER" era))
  ) =>
  Arbitrary (ShelleyLedgersPredFailure era)
  where
  arbitrary :: Gen (ShelleyLedgersPredFailure era)
arbitrary = Gen (ShelleyLedgersPredFailure era)
forall a. (GArbitrary UnsizedOpts a, GUniformWeight a) => Gen a
genericArbitraryU
  shrink :: ShelleyLedgersPredFailure era -> [ShelleyLedgersPredFailure era]
shrink = ShelleyLedgersPredFailure era -> [ShelleyLedgersPredFailure era]
forall a.
(Generic a, RecursivelyShrink (Rep a), GSubterms (Rep a) a) =>
a -> [a]
genericShrink

instance
  ( Era era
  , Arbitrary (PredicateFailure (EraRule "DELEGS" era))
  , Arbitrary (PredicateFailure (EraRule "UTXOW" era))
  ) =>
  Arbitrary (ShelleyLedgerPredFailure era)
  where
  arbitrary :: Gen (ShelleyLedgerPredFailure era)
arbitrary = Gen (ShelleyLedgerPredFailure era)
forall a. (GArbitrary UnsizedOpts a, GUniformWeight a) => Gen a
genericArbitraryU
  shrink :: ShelleyLedgerPredFailure era -> [ShelleyLedgerPredFailure era]
shrink ShelleyLedgerPredFailure era
_ = []

instance
  ( Era era
  , Arbitrary (PredicateFailure (EraRule "UTXO" era))
  ) =>
  Arbitrary (ShelleyUtxowPredFailure era)
  where
  arbitrary :: Gen (ShelleyUtxowPredFailure era)
arbitrary = Gen (ShelleyUtxowPredFailure era)
forall a. (GArbitrary UnsizedOpts a, GUniformWeight a) => Gen a
genericArbitraryU
  shrink :: ShelleyUtxowPredFailure era -> [ShelleyUtxowPredFailure era]
shrink ShelleyUtxowPredFailure era
_ = []

instance
  ( EraTx era
  , Arbitrary (TxBody era)
  , Arbitrary (Value era)
  , Arbitrary (TxAuxData era)
  , Arbitrary (Script era)
  , Arbitrary (TxWits era)
  ) =>
  Arbitrary (ShelleyTx era)
  where
  arbitrary :: Gen (ShelleyTx era)
arbitrary = Gen (ShelleyTx era)
forall era.
(EraTx era, Arbitrary (TxBody era), Arbitrary (TxAuxData era),
 Arbitrary (TxWits era)) =>
Gen (ShelleyTx era)
genTx

instance
  ( Era era
  , Arbitrary (PredicateFailure (EraRule "LEDGER" era))
  ) =>
  Arbitrary (ApplyTxError era)
  where
  arbitrary :: Gen (ApplyTxError era)
arbitrary = NonEmpty (PredicateFailure (EraRule "LEDGER" era))
-> ApplyTxError era
forall era.
NonEmpty (PredicateFailure (EraRule "LEDGER" era))
-> ApplyTxError era
ApplyTxError (NonEmpty (PredicateFailure (EraRule "LEDGER" era))
 -> ApplyTxError era)
-> Gen (NonEmpty (PredicateFailure (EraRule "LEDGER" era)))
-> Gen (ApplyTxError era)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Gen (NonEmpty (PredicateFailure (EraRule "LEDGER" era)))
forall a. Arbitrary a => Gen a
arbitrary
  shrink :: ApplyTxError era -> [ApplyTxError era]
shrink (ApplyTxError NonEmpty (PredicateFailure (EraRule "LEDGER" era))
xs) = [NonEmpty (PredicateFailure (EraRule "LEDGER" era))
-> ApplyTxError era
forall era.
NonEmpty (PredicateFailure (EraRule "LEDGER" era))
-> ApplyTxError era
ApplyTxError NonEmpty (PredicateFailure (EraRule "LEDGER" era))
xs' | NonEmpty (PredicateFailure (EraRule "LEDGER" era))
xs' <- NonEmpty (PredicateFailure (EraRule "LEDGER" era))
-> [NonEmpty (PredicateFailure (EraRule "LEDGER" era))]
forall a. Arbitrary a => a -> [a]
shrink NonEmpty (PredicateFailure (EraRule "LEDGER" era))
xs]

instance
  ( Era era
  , Arbitrary (Value era)
  , Arbitrary (TxOut era)
  , Arbitrary (EraRuleFailure "PPUP" era)
  ) =>
  Arbitrary (ShelleyUtxoPredFailure era)
  where
  arbitrary :: Gen (ShelleyUtxoPredFailure era)
arbitrary = Gen (ShelleyUtxoPredFailure era)
forall a. (GArbitrary UnsizedOpts a, GUniformWeight a) => Gen a
genericArbitraryU
  shrink :: ShelleyUtxoPredFailure era -> [ShelleyUtxoPredFailure era]
shrink ShelleyUtxoPredFailure era
_ = []

data RawSeed = RawSeed !Word64 !Word64 !Word64 !Word64 !Word64
  deriving (RawSeed -> RawSeed -> Bool
(RawSeed -> RawSeed -> Bool)
-> (RawSeed -> RawSeed -> Bool) -> Eq RawSeed
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: RawSeed -> RawSeed -> Bool
== :: RawSeed -> RawSeed -> Bool
$c/= :: RawSeed -> RawSeed -> Bool
/= :: RawSeed -> RawSeed -> Bool
Eq, Int -> RawSeed -> String -> String
[RawSeed] -> String -> String
RawSeed -> String
(Int -> RawSeed -> String -> String)
-> (RawSeed -> String)
-> ([RawSeed] -> String -> String)
-> Show RawSeed
forall a.
(Int -> a -> String -> String)
-> (a -> String) -> ([a] -> String -> String) -> Show a
$cshowsPrec :: Int -> RawSeed -> String -> String
showsPrec :: Int -> RawSeed -> String -> String
$cshow :: RawSeed -> String
show :: RawSeed -> String
$cshowList :: [RawSeed] -> String -> String
showList :: [RawSeed] -> String -> String
Show)

instance Arbitrary RawSeed where
  arbitrary :: Gen RawSeed
arbitrary =
    Word64 -> Word64 -> Word64 -> Word64 -> Word64 -> RawSeed
RawSeed
      (Word64 -> Word64 -> Word64 -> Word64 -> Word64 -> RawSeed)
-> Gen Word64
-> Gen (Word64 -> Word64 -> Word64 -> Word64 -> RawSeed)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Gen Word64
forall a. Random a => Gen a
chooseAny
      Gen (Word64 -> Word64 -> Word64 -> Word64 -> RawSeed)
-> Gen Word64 -> Gen (Word64 -> Word64 -> Word64 -> RawSeed)
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. Random a => Gen a
chooseAny
      Gen (Word64 -> Word64 -> Word64 -> RawSeed)
-> Gen Word64 -> Gen (Word64 -> Word64 -> RawSeed)
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. Random a => Gen a
chooseAny
      Gen (Word64 -> Word64 -> RawSeed)
-> Gen Word64 -> Gen (Word64 -> RawSeed)
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. Random a => Gen a
chooseAny
      Gen (Word64 -> RawSeed) -> Gen Word64 -> Gen RawSeed
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. Random a => Gen a
chooseAny

instance Era era => Arbitrary (ShelleyCertState era) where
  arbitrary :: Gen (ShelleyCertState era)
arbitrary = PState era -> DState era -> ShelleyCertState era
forall era. PState era -> DState era -> ShelleyCertState era
ShelleyCertState (PState era -> DState era -> ShelleyCertState era)
-> Gen (PState era) -> Gen (DState era -> ShelleyCertState era)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Gen (PState era)
forall a. Arbitrary a => Gen a
arbitrary Gen (DState era -> ShelleyCertState era)
-> Gen (DState era) -> Gen (ShelleyCertState era)
forall a b. Gen (a -> b) -> Gen a -> Gen b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Gen (DState era)
forall a. Arbitrary a => Gen a
arbitrary
  shrink :: ShelleyCertState era -> [ShelleyCertState era]
shrink = ShelleyCertState era -> [ShelleyCertState era]
forall a.
(Generic a, RecursivelyShrink (Rep a), GSubterms (Rep a) a) =>
a -> [a]
genericShrink