{-# 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.Binary (EncCBOR)
import Cardano.Ledger.Shelley (ShelleyEra)
import Cardano.Ledger.Shelley.API (
  ApplyTxError (ApplyTxError),
  MultiSig,
  NominalDiffTimeMicro (..),
  ShelleyDelegCert,
  ShelleyGenesis (..),
  ShelleyGenesisStaking (ShelleyGenesisStaking),
  ShelleyTx (ShelleyTx),
  ShelleyTxBody (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.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 = forall a. (GArbitrary UnsizedOpts a, GUniformWeight a) => Gen a
genericArbitraryU
  shrink :: ShelleyPParams Identity era -> [ShelleyPParams Identity era]
shrink = 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 = forall a. (GArbitrary UnsizedOpts a, GUniformWeight a) => Gen a
genericArbitraryU
  shrink :: ShelleyPParams StrictMaybe era -> [ShelleyPParams StrictMaybe era]
shrink = 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 = forall era.
Map (KeyHash 'Genesis) (PParamsUpdate era) -> ProposedPPUpdates era
ProposedPPUpdates forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall a. (Int -> Int) -> Gen a -> Gen a
scale (forall a. Integral a => a -> a -> a
`div` Int
15) 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 = forall era.
(HasCallStack, Era era, Val (Value era)) =>
Addr -> Value era -> ShelleyTxOut era
ShelleyTxOut forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall a. Arbitrary a => Gen a
arbitrary forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall a. (Int -> Int) -> Gen a -> Gen a
scale (forall a. Integral a => a -> a -> a
`div` Int
15) 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 (NewEpochState era)
  where
  arbitrary :: Gen (NewEpochState era)
arbitrary =
    forall era.
EpochNo
-> BlocksMade
-> BlocksMade
-> EpochState era
-> StrictMaybe PulsingRewUpdate
-> PoolDistr
-> StashedAVVMAddresses era
-> NewEpochState era
NewEpochState
      forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall a. Arbitrary a => Gen a
arbitrary
      forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall a. Arbitrary a => Gen a
arbitrary
      forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall a. Arbitrary a => Gen a
arbitrary
      forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall a. Arbitrary a => Gen a
arbitrary
      forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall a. Arbitrary a => Gen a
arbitrary
      forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall a. Arbitrary a => Gen a
arbitrary
      forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall a. Arbitrary a => Gen a
arbitrary

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

instance
  ( EraTxOut era
  , Arbitrary (TxOut era)
  , Arbitrary (GovState era)
  ) =>
  Arbitrary (LedgerState era)
  where
  arbitrary :: Gen (LedgerState era)
arbitrary =
    forall era. UTxOState era -> CertState era -> LedgerState era
LedgerState
      forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall a. Arbitrary a => Gen a
arbitrary
      forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall a. Arbitrary a => Gen a
arbitrary
  shrink :: LedgerState era -> [LedgerState era]
shrink LedgerState {CertState era
UTxOState era
lsUTxOState :: forall era. LedgerState era -> UTxOState era
lsCertState :: forall era. LedgerState era -> CertState era
lsCertState :: CertState era
lsUTxOState :: UTxOState 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.
    forall a. Int -> [a] -> [a]
drop Int
1 forall a b. (a -> b) -> a -> b
$
      forall era. UTxOState era -> CertState era -> LedgerState era
LedgerState
        forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (UTxOState era
lsUTxOState forall a. a -> [a] -> [a]
: forall a. Arbitrary a => a -> [a]
shrink UTxOState era
lsUTxOState)
        forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (CertState era
lsCertState forall a. a -> [a] -> [a]
: forall a. Arbitrary a => a -> [a]
shrink CertState era
lsCertState)

instance
  ( EraTxOut era
  , Arbitrary (TxOut era)
  , Arbitrary (GovState era)
  ) =>
  Arbitrary (UTxOState era)
  where
  arbitrary :: Gen (UTxOState era)
arbitrary =
    forall era.
UTxO era
-> Coin
-> Coin
-> GovState era
-> IncrementalStake
-> Coin
-> UTxOState era
UTxOState
      forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall a. Arbitrary a => Gen a
arbitrary
      forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall a. Arbitrary a => Gen a
arbitrary
      forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall a. Arbitrary a => Gen a
arbitrary
      forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall a. Arbitrary a => Gen a
arbitrary
      forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall a. Arbitrary a => Gen a
arbitrary
      forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> 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 = forall a. (Generic a, RecursivelyShrink (Rep a)) => a -> [a]
recursivelyShrink

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

instance Arbitrary IncrementalStake where
  arbitrary :: Gen IncrementalStake
arbitrary = Map (Credential 'Staking) (CompactForm Coin)
-> Map Ptr (CompactForm Coin) -> IncrementalStake
IStake forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall a. Arbitrary a => Gen a
arbitrary forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a. Monoid a => a
mempty -- Once in Conway Ptrs Map will be removed
  shrink :: IncrementalStake -> [IncrementalStake]
shrink = 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 forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall a. Arbitrary a => Gen a
arbitrary

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

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

instance Arbitrary NonMyopic where
  arbitrary :: Gen NonMyopic
arbitrary = Map (KeyHash 'StakePool) Likelihood -> Coin -> NonMyopic
NonMyopic forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall a. Arbitrary a => Gen a
arbitrary forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall a. Arbitrary a => Gen a
arbitrary
  shrink :: NonMyopic -> [NonMyopic]
shrink = 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 forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall a. Arbitrary a => Gen a
arbitrary forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall a. Arbitrary a => Gen a
arbitrary
  shrink :: LeaderOnlyReward -> [LeaderOnlyReward]
shrink = 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
      forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall a. Arbitrary a => Gen a
arbitrary
      forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall a. Arbitrary a => Gen a
arbitrary
      forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall a. Arbitrary a => Gen a
arbitrary
      forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall a. Arbitrary a => Gen a
arbitrary
      forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall a. Arbitrary a => Gen a
arbitrary
  shrink :: PoolRewardInfo -> [PoolRewardInfo]
shrink = 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
      forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall a. Arbitrary a => Gen a
arbitrary
      forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall a. Arbitrary a => Gen a
arbitrary
      forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall a. Arbitrary a => Gen a
arbitrary
      forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall a. Arbitrary a => Gen a
arbitrary
      forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall a. Arbitrary a => Gen a
arbitrary
  shrink :: RewardUpdate -> [RewardUpdate]
shrink = 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 forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall a. Arbitrary a => Gen a
arbitrary forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall a. Arbitrary a => Gen a
arbitrary
  shrink :: RewardAns -> [RewardAns]
shrink = 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 = forall ans (m :: * -> *).
(ans ~ RewardAns, m ~ ShelleyBase) =>
Int
-> FreeVars
-> VMap VB VP (Credential 'Staking) (CompactForm Coin)
-> ans
-> RewardPulser m ans
RSLP forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall a. Arbitrary a => Gen a
arbitrary forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall a. Arbitrary a => Gen a
arbitrary forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall a. Arbitrary a => Gen a
arbitrary forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall a. Arbitrary a => Gen a
arbitrary

instance Arbitrary PulsingRewUpdate where
  arbitrary :: Gen PulsingRewUpdate
arbitrary =
    forall a. HasCallStack => [Gen a] -> Gen a
oneof
      [ RewardSnapShot
-> RewardPulser ShelleyBase RewardAns -> PulsingRewUpdate
Pulsing forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall a. Arbitrary a => Gen a
arbitrary forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall a. Arbitrary a => Gen a
arbitrary
      , RewardUpdate -> PulsingRewUpdate
Complete forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall a. Arbitrary a => Gen a
arbitrary
      ]
  shrink :: PulsingRewUpdate -> [PulsingRewUpdate]
shrink = 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
      forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall a. Arbitrary a => Gen a
arbitrary
      forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall a. Arbitrary a => Gen a
arbitrary
      forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall a. Arbitrary a => Gen a
arbitrary
      forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall a. Arbitrary a => Gen a
arbitrary
      forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall a. Arbitrary a => Gen a
arbitrary
      forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall a. Arbitrary a => Gen a
arbitrary
      forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall a. Arbitrary a => Gen a
arbitrary
      forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall a. Arbitrary a => Gen a
arbitrary
  shrink :: RewardSnapShot -> [RewardSnapShot]
shrink = 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
      forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall a. Arbitrary a => Gen a
arbitrary
      forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall a. Arbitrary a => Gen a
arbitrary
      forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall a. Arbitrary a => Gen a
arbitrary
      forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall a. Arbitrary a => Gen a
arbitrary
      forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall a. Arbitrary a => Gen a
arbitrary
  shrink :: FreeVars -> [FreeVars]
shrink = 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 = forall a. (Int -> Int) -> Gen a -> Gen a
scale (forall a. Integral a => a -> a -> a
`div` Int
10) 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 = forall era.
ProposedPPUpdates era
-> ProposedPPUpdates era
-> PParams era
-> PParams era
-> FuturePParams era
-> ShelleyGovState era
ShelleyGovState forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall a. Arbitrary a => Gen a
arbitrary forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall a. Arbitrary a => Gen a
arbitrary forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall a. Arbitrary a => Gen a
arbitrary forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall a. Arbitrary a => Gen a
arbitrary forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall a. Arbitrary a => Gen a
arbitrary
  shrink :: ShelleyGovState era -> [ShelleyGovState era]
shrink = 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 =
  forall a. HasCallStack => [(Int, Gen a)] -> Gen a
frequency
    [ (Int
metadataFrequency, forall a. a -> StrictMaybe a
SJust forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall era. Era era => Gen (ShelleyTxAuxData era)
genMetadata')
    , (Int
100 forall a. Num a => a -> a -> a
- Int
metadataFrequency, forall (f :: * -> *) a. Applicative f => a -> f a
pure 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 <- forall a. Random a => (a, a) -> Gen a
choose (Int
1, Int
metadataMaxSize)
  forall era. Era era => Map Word64 Metadatum -> ShelleyTxAuxData era
ShelleyTxAuxData forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall k a. Ord k => [(k, a)] -> Map k a
Map.fromList
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> 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
  (,)
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall a. Arbitrary a => Gen a
arbitrary
    forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> 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
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall a. HasCallStack => [(Int, Gen a)] -> Gen a
frequency
      [ (Int
8, forall a. Random a => (a, a) -> Gen a
choose (Integer
minVal, Integer
maxVal))
      , (Int
1, forall (f :: * -> *) a. Applicative f => a -> f a
pure Integer
minVal)
      , (Int
1, forall (f :: * -> *) a. Applicative f => a -> f a
pure Integer
maxVal)
      ]
  where
    minVal, maxVal :: Integer
    minVal :: Integer
minVal = -Integer
maxVal
    maxVal :: Integer
maxVal = forall a b. (Integral a, Num b) => a -> b
fromIntegral (forall a. Bounded a => a
maxBound :: Word64)

genDatumString :: Gen Metadatum
genDatumString :: Gen Metadatum
genDatumString =
  forall a. (Int -> Gen a) -> Gen a
sized forall a b. (a -> b) -> a -> b
$ \Int
sz -> do
    Int
n <- forall a. Random a => (a, a) -> Gen a
choose (Int
0, 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
    forall a. HasCallStack => Bool -> a -> a
assert (ByteString -> Int
BS.length (Text -> ByteString
T.encodeUtf8 Text
s) forall a. Eq a => a -> a -> Bool
== Int
n) forall a b. (a -> b) -> a -> b
$
      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 = forall (m :: * -> *) a. Monad m => a -> m a
return []
genUtf8StringOfSize Int
n = do
  Int
cz <- forall a. Random a => (a, a) -> Gen a
choose (Int
1, forall a. Ord a => a -> a -> a
min Int
n Int
4)
  Char
c <- case Int
cz of
    Int
1 -> forall a. Random a => (a, a) -> Gen a
choose (Char
'\x00000', Char
'\x00007f')
    Int
2 -> forall a. Random a => (a, a) -> Gen a
choose (Char
'\x00080', Char
'\x0007ff')
    Int
3 ->
      forall a. HasCallStack => [Gen a] -> Gen a
oneof
        [ forall a. Random a => (a, a) -> Gen a
choose (Char
'\x00800', Char
'\x00d7ff')
        , -- skipping UTF-16 surrogates d800--dfff
          forall a. Random a => (a, a) -> Gen a
choose (Char
'\x0e000', Char
'\x00ffff')
        ]
    Int
_ -> forall a. Random a => (a, a) -> Gen a
choose (Char
'\x10000', Char
'\x10ffff')
  String
cs <- Int -> Gen String
genUtf8StringOfSize (Int
n forall a. Num a => a -> a -> a
- Int
cz)
  forall (m :: * -> *) a. Monad m => a -> m a
return (Char
c forall a. a -> [a] -> [a]
: String
cs)

genDatumBytestring :: Gen Metadatum
genDatumBytestring :: Gen Metadatum
genDatumBytestring =
  forall a. (Int -> Gen a) -> Gen a
sized forall a b. (a -> b) -> a -> b
$ \Int
sz -> do
    Int
n <- forall a. Random a => (a, a) -> Gen a
choose (Int
0, forall a. Ord a => a -> a -> a
min Int
sz Int
64)
    ByteString -> Metadatum
B forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> ByteString
BS.pack forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall a. Int -> Gen a -> Gen [a]
vectorOf Int
n 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 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 forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (forall a b. [a] -> [b] -> [(a, b)]
zip forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Gen [Metadatum]
vectorOfMetadatumSimple 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 <- forall a. Random a => (a, a) -> Gen a
choose (Int
1, Int
collectionDatumMaxSize)
  forall a. Int -> Gen a -> Gen [a]
vectorOf
    Int
n
    ( 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 = forall a. (GArbitrary UnsizedOpts a, GUniformWeight a) => Gen a
genericArbitraryU
  shrink :: ShelleyTxCert era -> [ShelleyTxCert era]
shrink = forall a.
(Generic a, RecursivelyShrink (Rep a), GSubterms (Rep a) a) =>
a -> [a]
genericShrink

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

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

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

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

instance Arbitrary MIRPot where
  arbitrary :: Gen MIRPot
arbitrary = 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 = forall a. (GArbitrary UnsizedOpts a, GUniformWeight a) => Gen a
genericArbitraryU
  shrink :: Update era -> [Update era]
shrink = forall a.
(Generic a, RecursivelyShrink (Rep a), GSubterms (Rep a) a) =>
a -> [a]
genericShrink

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

instance Arbitrary ASC where
  arbitrary :: Gen ASC
arbitrary =
    ActiveSlotCoeff -> ASC
ASC
      forall b c a. (b -> c) -> (a -> b) -> a -> c
. PositiveUnitInterval -> ActiveSlotCoeff
mkActiveSlotCoeff
      forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall r.
(HasCallStack, Typeable r, BoundedRational r) =>
Rational -> r
unsafeBoundRational
      forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Fractional a => Rational -> a
fromRational
      forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Real a => a -> Rational
toRational
      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 -> ShowS
[ASC] -> ShowS
ASC -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [ASC] -> ShowS
$cshowList :: [ASC] -> ShowS
show :: ASC -> String
$cshow :: ASC -> String
showsPrec :: Int -> ASC -> ShowS
$cshowsPrec :: Int -> ASC -> ShowS
Show)

instance Arbitrary StakeProportion where
  arbitrary :: Gen StakeProportion
arbitrary = Rational -> StakeProportion
StakeProportion forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Real a => a -> Rational
toRational 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 forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall a. RealFrac a => a -> [a]
shrinkRealFrac Rational
r

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

instance
  ( EraTxOut era
  , ShelleyEraScript era
  , Arbitrary (PParamsUpdate era)
  , Arbitrary (TxOut era)
  , Arbitrary (TxCert era)
  , EncCBOR (TxCert era)
  ) =>
  Arbitrary (ShelleyTxBody era)
  where
  arbitrary :: Gen (ShelleyTxBody era)
arbitrary =
    forall era.
(EraTxOut era, EncCBOR (TxCert era)) =>
Set TxIn
-> StrictSeq (TxOut era)
-> StrictSeq (TxCert era)
-> Withdrawals
-> Coin
-> SlotNo
-> StrictMaybe (Update era)
-> StrictMaybe TxAuxDataHash
-> ShelleyTxBody era
ShelleyTxBody
      forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall a. Arbitrary a => Gen a
arbitrary
      forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall a. Arbitrary a => Gen a
arbitrary
      forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall a. Arbitrary a => Gen a
arbitrary
      forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall a. Arbitrary a => Gen a
arbitrary
      forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall a. Arbitrary a => Gen a
arbitrary
      forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall a. Arbitrary a => Gen a
arbitrary
      forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall a. (Int -> Int) -> Gen a -> Gen a
scale (forall a. Integral a => a -> a -> a
`div` Int
15) forall a. Arbitrary a => Gen a
arbitrary
      forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> 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 =
  forall era.
EraTx era =>
TxBody era
-> TxWits era -> StrictMaybe (TxAuxData era) -> ShelleyTx era
ShelleyTx
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall a. Arbitrary a => Gen a
arbitrary
    forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall a. HasCallStack => Int -> Gen a -> Gen a
resize Int
maxTxWits forall a. Arbitrary a => Gen a
arbitrary
    forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> 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 = forall era. Era era => Map Word64 Metadatum -> ShelleyTxAuxData era
ShelleyTxAuxData forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> 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 =
  forall a. HasCallStack => [Gen a] -> Gen a
oneof
    [ Integer -> Metadatum
I forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall a. Arbitrary a => Gen a
arbitrary
    , ByteString -> Metadatum
B forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall a. Arbitrary a => Gen a
arbitrary
    , Text -> Metadatum
S forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (String -> Text
T.pack forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall a. Arbitrary a => Gen a
arbitrary)
    ]
sizedMetadatum Int
n =
  let xsGen :: Gen [Metadatum]
xsGen = forall a. Gen a -> Gen [a]
listOf (Int -> Gen Metadatum
sizedMetadatum (Int
n forall a. Num a => a -> a -> a
- Int
1))
   in forall a. HasCallStack => [Gen a] -> Gen a
oneof
        [ [(Metadatum, Metadatum)] -> Metadatum
Map forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (forall a b. [a] -> [b] -> [(a, b)]
zip forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall a. HasCallStack => Int -> Gen a -> Gen a
resize Int
maxMetadatumListLens Gen [Metadatum]
xsGen forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Gen [Metadatum]
xsGen)
        , [Metadatum] -> Metadatum
List forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall a. HasCallStack => Int -> Gen a -> Gen a
resize Int
maxMetadatumListLens Gen [Metadatum]
xsGen
        , Integer -> Metadatum
I forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall a. Arbitrary a => Gen a
arbitrary
        , ByteString -> Metadatum
B forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall a. Arbitrary a => Gen a
arbitrary
        , Text -> Metadatum
S forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (String -> Text
T.pack forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall a. Arbitrary a => Gen a
arbitrary)
        ]

instance Arbitrary VotingPeriod where
  arbitrary :: Gen VotingPeriod
arbitrary = forall a. (GArbitrary UnsizedOpts a, GUniformWeight a) => Gen a
genericArbitraryU
  shrink :: VotingPeriod -> [VotingPeriod]
shrink = 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 = forall a. (GArbitrary UnsizedOpts a, GUniformWeight a) => Gen a
genericArbitraryU
  shrink :: ListMap k v -> [ListMap k v]
shrink = 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 = 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 = forall era.
ShelleyEraScript era =>
KeyHash 'Witness -> NativeScript era
RequireSignature forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall a. Arbitrary a => Gen a
arbitrary
sizedMultiSig Int
n = forall a. HasCallStack => [Gen a] -> Gen a
oneof forall a b. (a -> b) -> a -> b
$ 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 =
  [ forall era.
ShelleyEraScript era =>
KeyHash 'Witness -> NativeScript era
RequireSignature forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall a. Arbitrary a => Gen a
arbitrary
  , forall era.
ShelleyEraScript era =>
StrictSeq (NativeScript era) -> NativeScript era
RequireAllOf forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (forall a. [a] -> StrictSeq a
fromList forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall a. HasCallStack => Int -> Gen a -> Gen a
resize Int
maxMultiSigListLens (forall a. Gen a -> Gen [a]
listOf (forall era. ShelleyEraScript era => Int -> Gen (NativeScript era)
sizedMultiSig (Int
n forall a. Num a => a -> a -> a
- Int
1))))
  , forall era.
ShelleyEraScript era =>
StrictSeq (NativeScript era) -> NativeScript era
RequireAnyOf forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (forall a. [a] -> StrictSeq a
fromList forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall a. HasCallStack => Int -> Gen a -> Gen a
resize Int
maxMultiSigListLens (forall a. Gen a -> Gen [a]
listOf (forall era. ShelleyEraScript era => Int -> Gen (NativeScript era)
sizedMultiSig (Int
n forall a. Num a => a -> a -> a
- Int
1))))
  , do
      [NativeScript era]
subs <- forall a. HasCallStack => Int -> Gen a -> Gen a
resize Int
maxMultiSigListLens (forall a. Gen a -> Gen [a]
listOf (forall era. ShelleyEraScript era => Int -> Gen (NativeScript era)
sizedMultiSig (Int
n forall a. Num a => a -> a -> a
- Int
1)))
      let i :: Int
i = forall (t :: * -> *) a. Foldable t => t a -> Int
length [NativeScript era]
subs
      forall era.
ShelleyEraScript era =>
Int -> StrictSeq (NativeScript era) -> NativeScript era
RequireMOf forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall a. Random a => (a, a) -> Gen a
choose (Int
0, Int
i) forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall (f :: * -> *) a. Applicative f => a -> f a
pure (forall a. [a] -> StrictSeq a
fromList [NativeScript era]
subs)
  ]

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

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

instance
  ( Era era
  , EraScript era
  , Arbitrary (Script era)
  ) =>
  Arbitrary (ShelleyTxWits era)
  where
  arbitrary :: Gen (ShelleyTxWits era)
arbitrary =
    forall era.
EraScript era =>
Set (WitVKey 'Witness)
-> Map ScriptHash (Script era)
-> Set BootstrapWitness
-> ShelleyTxWits era
ShelleyTxWits
      forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall a. Arbitrary a => Gen a
arbitrary
      forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> ([Script era] -> Map ScriptHash (Script era)
mscriptsToWits forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall a. Arbitrary a => Gen a
arbitrary)
      forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall a. Arbitrary a => Gen a
arbitrary
    where
      mscriptsToWits :: [Script era] -> Map ScriptHash (Script era)
mscriptsToWits = forall k a. Ord k => [(k, a)] -> Map k a
Map.fromList forall b c a. (b -> c) -> (a -> b) -> a -> c
. 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 = forall a. (GArbitrary UnsizedOpts a, GUniformWeight a) => Gen a
genericArbitraryU
  shrink :: ShelleyPpupPredFailure era -> [ShelleyPpupPredFailure era]
shrink = 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 =
    forall a. HasCallStack => [Gen a] -> Gen a
oneof
      [ forall era. KeyHash 'StakePool -> ShelleyPoolPredFailure era
StakePoolNotRegisteredOnKeyPOOL forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall a. Arbitrary a => Gen a
arbitrary
      , do
          EpochNo
a <- forall a. Arbitrary a => Gen a
arbitrary
          EpochNo
b <- forall a. Arbitrary a => Gen a
arbitrary
          forall era.
Mismatch 'RelGT EpochNo
-> Mismatch 'RelLTEQ EpochNo -> ShelleyPoolPredFailure era
StakePoolRetirementWrongEpochPOOL (forall (r :: Relation) a. a -> a -> Mismatch r a
Mismatch EpochNo
a EpochNo
b) forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (r :: Relation) a. a -> a -> Mismatch r a
Mismatch EpochNo
a forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall a. Arbitrary a => Gen a
arbitrary
      , forall era. Mismatch 'RelGTEQ Coin -> ShelleyPoolPredFailure era
StakePoolCostTooLowPOOL forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall a. Arbitrary a => Gen a
arbitrary
      , forall era.
Mismatch 'RelEQ Network
-> KeyHash 'StakePool -> ShelleyPoolPredFailure era
WrongNetworkPOOL forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall a. Arbitrary a => Gen a
arbitrary forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall a. Arbitrary a => Gen a
arbitrary
      , forall era. KeyHash 'StakePool -> Int -> ShelleyPoolPredFailure era
PoolMedataHashTooBig forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall a. Arbitrary a => Gen a
arbitrary forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall a. Arbitrary a => Gen a
arbitrary
      ]
  shrink :: ShelleyPoolPredFailure era -> [ShelleyPoolPredFailure era]
shrink = 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 = forall a. (GArbitrary UnsizedOpts a, GUniformWeight a) => Gen a
genericArbitraryU
  shrink :: ShelleyDelplPredFailure era -> [ShelleyDelplPredFailure era]
shrink = forall a. (Generic a, RecursivelyShrink (Rep a)) => a -> [a]
recursivelyShrink

instance
  Era era =>
  Arbitrary (ShelleyDelegPredFailure era)
  where
  arbitrary :: Gen (ShelleyDelegPredFailure era)
arbitrary = forall a. (GArbitrary UnsizedOpts a, GUniformWeight a) => Gen a
genericArbitraryU
  shrink :: ShelleyDelegPredFailure era -> [ShelleyDelegPredFailure era]
shrink = 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 = forall a. (GArbitrary UnsizedOpts a, GUniformWeight a) => Gen a
genericArbitraryU
  shrink :: ShelleyDelegsPredFailure era -> [ShelleyDelegsPredFailure era]
shrink = 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 = forall a. (GArbitrary UnsizedOpts a, GUniformWeight a) => Gen a
genericArbitraryU
  shrink :: ShelleyLedgersPredFailure era -> [ShelleyLedgersPredFailure era]
shrink = 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 = 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 = 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 = 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 = forall era.
NonEmpty (PredicateFailure (EraRule "LEDGER" era))
-> ApplyTxError era
ApplyTxError forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall a. Arbitrary a => Gen a
arbitrary
  shrink :: ApplyTxError era -> [ApplyTxError era]
shrink (ApplyTxError NonEmpty (PredicateFailure (EraRule "LEDGER" era))
xs) = [forall era.
NonEmpty (PredicateFailure (EraRule "LEDGER" era))
-> ApplyTxError era
ApplyTxError NonEmpty (PredicateFailure (EraRule "LEDGER" era))
xs' | NonEmpty (PredicateFailure (EraRule "LEDGER" era))
xs' <- 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 = 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
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: RawSeed -> RawSeed -> Bool
$c/= :: RawSeed -> RawSeed -> Bool
== :: RawSeed -> RawSeed -> Bool
$c== :: RawSeed -> RawSeed -> Bool
Eq, Int -> RawSeed -> ShowS
[RawSeed] -> ShowS
RawSeed -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [RawSeed] -> ShowS
$cshowList :: [RawSeed] -> ShowS
show :: RawSeed -> String
$cshow :: RawSeed -> String
showsPrec :: Int -> RawSeed -> ShowS
$cshowsPrec :: Int -> RawSeed -> ShowS
Show)

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