{-# LANGUAGE AllowAmbiguousTypes #-}
{-# LANGUAGE BangPatterns #-}
{-# LANGUAGE DataKinds #-}
{-# LANGUAGE DerivingStrategies #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE GeneralizedNewtypeDeriving #-}
{-# LANGUAGE LambdaCase #-}
{-# LANGUAGE NamedFieldPuns #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE RecordWildCards #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE StandaloneDeriving #-}
{-# LANGUAGE TypeApplications #-}
{-# LANGUAGE UndecidableInstances #-}
{-# OPTIONS_GHC -Wno-orphans #-}

module Test.Cardano.Ledger.Core.Arbitrary (
  module Test.Cardano.Ledger.Binary.Arbitrary,
  genericShrinkMemo,

  -- * Plutus
  genValidAndUnknownCostModels,
  genValidCostModel,
  genValidCostModels,

  -- * Utils

  -- | Will need to find a better home in the future
  uniformSubSet,
  uniformSubMap,
  uniformSubMapElems,
) where

import qualified Cardano.Chain.Common as Byron
import Cardano.Crypto.Hash.Class
import Cardano.Ledger.Address
import Cardano.Ledger.BaseTypes (
  ActiveSlotCoeff,
  BlocksMade (..),
  CertIx (..),
  DnsName,
  EpochInterval (..),
  HasZero,
  Mismatch (..),
  Network (..),
  NonNegativeInterval,
  Nonce (..),
  Port (..),
  PositiveInterval,
  PositiveUnitInterval,
  ProtVer (..),
  StrictMaybe,
  TxIx (..),
  UnitInterval,
  Url,
  mkActiveSlotCoeff,
  mkNonceFromNumber,
  promoteRatio,
  textToDns,
  textToUrl,
 )
import qualified Cardano.Ledger.BaseTypes as BaseTypes
import Cardano.Ledger.Binary (EncCBOR, Sized, mkSized)
import Cardano.Ledger.Coin (Coin (..), CompactForm (..), DeltaCoin (..))
import Cardano.Ledger.Core
import Cardano.Ledger.Credential (Credential (..), Ptr (..), SlotNo32 (..), StakeReference (..))
import Cardano.Ledger.Genesis (NoGenesis (..))
import Cardano.Ledger.HKD (NoUpdate (..))
import Cardano.Ledger.Hashes (GenDelegPair (..), GenDelegs (..), unsafeMakeSafeHash)
import Cardano.Ledger.Keys (BootstrapWitness (..), ChainCode (..), VKey (..), WitVKey (..))
import Cardano.Ledger.MemoBytes (Memoized (..), getMemoRawType, mkMemoizedEra)
import Cardano.Ledger.Plutus.CostModels (
  CostModel,
  CostModels,
  costModelInitParamCount,
  mkCostModel,
  mkCostModels,
  mkCostModelsLenient,
  updateCostModels,
 )
import Cardano.Ledger.Plutus.Data (BinaryData, Data (..), Datum (..), dataToBinaryData)
import Cardano.Ledger.Plutus.ExUnits (ExUnits (..), Prices (..))
import Cardano.Ledger.Plutus.Language (Language (..), nonNativeLanguages)
import Cardano.Ledger.State
import Cardano.Ledger.TxIn (TxId (..), TxIn (..))
import Control.Monad (replicateM)
import Control.Monad.Identity (Identity)
import Control.Monad.Trans.Fail.String (errorFail)
import Data.GenValidity
import Data.Int (Int64)
import Data.Map.Strict (Map)
import qualified Data.Map.Strict as Map
import Data.Ratio ((%))
import Data.Set (Set)
import qualified Data.Set as Set
import qualified Data.Text as T
import Data.Typeable
import qualified Data.VMap as VMap
import Data.Word (Word16, Word64, Word8)
import GHC.Generics (Generic (..))
import GHC.Stack
import Generic.Random (genericArbitraryU)
import Numeric.Natural (Natural)
import qualified PlutusLedgerApi.V1 as PV1
import System.Random.Stateful (StatefulGen, uniformRM)
import qualified Test.Cardano.Chain.Common.Gen as Byron
import Test.Cardano.Ledger.Binary.Arbitrary
import Test.Cardano.Ledger.Core.Utils (unsafeBoundRational)
import Test.QuickCheck
import Test.QuickCheck.Arbitrary (GSubterms, RecursivelyShrink)
import Test.QuickCheck.Hedgehog (hedgehog)

maxDecimalsWord64 :: Int
maxDecimalsWord64 :: Int
maxDecimalsWord64 = Int
19

instance (Era era, EncCBOR (f era), Arbitrary (f era)) => Arbitrary (Sized (f era)) where
  arbitrary :: Gen (Sized (f era))
arbitrary = Version -> f era -> Sized (f era)
forall a. EncCBOR a => Version -> a -> Sized a
mkSized (forall era. Era era => Version
eraProtVerHigh @era) (f era -> Sized (f era)) -> Gen (f era) -> Gen (Sized (f era))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Gen (f era)
forall a. Arbitrary a => Gen a
arbitrary

------------------------------------------------------------------------------------------
-- Cardano.Ledger.BaseTypes --------------------------------------------------------------
------------------------------------------------------------------------------------------

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

instance Validity ActiveSlotCoeff where
  validate :: ActiveSlotCoeff -> Validation
validate ActiveSlotCoeff
_ = Validation
forall a. Monoid a => a
mempty

instance GenValid ActiveSlotCoeff where
  genValid :: Gen ActiveSlotCoeff
genValid = PositiveUnitInterval -> ActiveSlotCoeff
mkActiveSlotCoeff (PositiveUnitInterval -> ActiveSlotCoeff)
-> Gen PositiveUnitInterval -> Gen ActiveSlotCoeff
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Gen PositiveUnitInterval
forall a. GenValid a => Gen a
genValid

instance Arbitrary BlocksMade where
  arbitrary :: Gen BlocksMade
arbitrary = Map (KeyHash StakePool) Natural -> BlocksMade
BlocksMade (Map (KeyHash StakePool) Natural -> BlocksMade)
-> Gen (Map (KeyHash StakePool) Natural) -> Gen BlocksMade
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Gen (Map (KeyHash StakePool) Natural)
forall a. Arbitrary a => Gen a
arbitrary

instance Arbitrary Network where
  arbitrary :: Gen Network
arbitrary = Gen Network
forall a. (Bounded a, Enum a) => Gen a
arbitraryBoundedEnum

genDnsName :: Int -> Gen T.Text
genDnsName :: Int -> Gen Text
genDnsName Int
n = do
  str <- Int -> Gen Char -> Gen [Char]
forall a. Int -> Gen a -> Gen [a]
vectorOf (Int
n Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
4) (Gen Char -> Gen [Char]) -> Gen Char -> Gen [Char]
forall a b. (a -> b) -> a -> b
$ [Char] -> Gen Char
forall a. HasCallStack => [a] -> Gen a
elements ([Char] -> Gen Char) -> [Char] -> Gen Char
forall a b. (a -> b) -> a -> b
$ Char
'.' Char -> [Char] -> [Char]
forall a. a -> [a] -> [a]
: Char
'-' Char -> [Char] -> [Char]
forall a. a -> [a] -> [a]
: [Char
'A' .. Char
'Z'] [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char
'a' .. Char
'z'] [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char
'0' .. Char
'9']
  pure $ T.pack str <> ".com"

guardLength :: HasCallStack => Int -> T.Text -> Maybe a -> a
guardLength :: forall a. HasCallStack => Int -> Text -> Maybe a -> a
guardLength Int
n Text
txt = \case
  Maybe a
Nothing -> [Char] -> a
forall a. HasCallStack => [Char] -> a
error ([Char] -> a) -> [Char] -> a
forall a b. (a -> b) -> a -> b
$ [Char]
"Unexpected! Generated length: (" [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ Int -> [Char]
forall a. Show a => a -> [Char]
show Int
n [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
") " [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ Text -> [Char]
forall a. Show a => a -> [Char]
show Text
txt
  Just a
t -> a
t

instance Arbitrary DnsName where
  arbitrary :: Gen DnsName
arbitrary = do
    n <- (Int, Int) -> Gen Int
chooseInt (Int
5, Int
64)
    txt <- genDnsName n
    pure $! guardLength n txt $ textToDns 64 txt

instance Arbitrary Url where
  arbitrary :: Gen Url
arbitrary = do
    let prefix :: Text
prefix = Text
"https://"
    n <- (Int, Int) -> Gen Int
chooseInt (Int
5, Int
64 Int -> Int -> Int
forall a. Num a => a -> a -> a
- Text -> Int
T.length Text
prefix)
    txt <- genDnsName n
    pure $! guardLength n txt $ textToUrl 64 (prefix <> txt)

instance Arbitrary Port where
  arbitrary :: Gen Port
arbitrary = forall a b. (Integral a, Num b) => a -> b
fromIntegral @Word16 @Port (Word16 -> Port) -> Gen Word16 -> Gen Port
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Gen Word16
forall a. Arbitrary a => Gen a
arbitrary

-- JSON instances can't roundtrip, unless these are decimal.

-- | Decimal numbers only
instance Arbitrary UnitInterval where
  arbitrary :: Gen UnitInterval
arbitrary = do
    p <- (Int, Int) -> Gen Int
chooseInt (Int
0, Int
maxDecimalsWord64)
    let y = Word64
10 Word64 -> Int -> Word64
forall a b. (Num a, Integral b) => a -> b -> a
^ Int
p :: Word64
    x <- choose (0, y)
    pure $ unsafeBoundRational $ promoteRatio (x % y)

-- | Decimal numbers only
instance Arbitrary PositiveUnitInterval where
  arbitrary :: Gen PositiveUnitInterval
arbitrary = do
    p <- (Int, Int) -> Gen Int
chooseInt (Int
0, Int
maxDecimalsWord64)
    let y = Word64
10 Word64 -> Int -> Word64
forall a b. (Num a, Integral b) => a -> b -> a
^ Int
p :: Word64
    x <- choose (1, y)
    pure $ unsafeBoundRational $ promoteRatio (x % y)

-- | Decimal numbers only
instance Arbitrary PositiveInterval where
  arbitrary :: Gen PositiveInterval
arbitrary = do
    p <- (Int, Int) -> Gen Int
chooseInt (Int
0, Int
maxDecimalsWord64)
    let y = Word64
10 Word64 -> Int -> Word64
forall a b. (Num a, Integral b) => a -> b -> a
^ Int
p :: Word64
    x <- choose (1, 10 ^ (maxDecimalsWord64 :: Int))
    pure $ unsafeBoundRational $ promoteRatio (x % y)

-- | Decimal numbers only
instance Arbitrary NonNegativeInterval where
  arbitrary :: Gen NonNegativeInterval
arbitrary = do
    p <- (Int, Int) -> Gen Int
chooseInt (Int
0, Int
maxDecimalsWord64)
    let y = Word64
10 Word64 -> Int -> Word64
forall a b. (Num a, Integral b) => a -> b -> a
^ Int
p :: Word64
    x <- choose (0, 10 ^ (maxDecimalsWord64 :: Int))
    pure $ unsafeBoundRational $ promoteRatio (x % y)

instance Arbitrary (NoUpdate a) where
  arbitrary :: Gen (NoUpdate a)
arbitrary = NoUpdate a -> Gen (NoUpdate a)
forall a. a -> Gen a
forall (f :: * -> *) a. Applicative f => a -> f a
pure NoUpdate a
forall a. NoUpdate a
NoUpdate

instance Validity UnitInterval where
  validate :: UnitInterval -> Validation
validate UnitInterval
_ = Validation
forall a. Monoid a => a
mempty

instance GenValid UnitInterval where
  genValid :: Gen UnitInterval
genValid = do
    x :: Word64 <- Gen Word64
forall a. GenValid a => Gen a
genValid
    Positive (y :: Word64) <- arbitrary
    pure $ unsafeBoundRational $ promoteRatio (if x > y then y % x else x % y)
  shrinkValid :: UnitInterval -> [UnitInterval]
shrinkValid UnitInterval
_ = []

instance Validity PositiveUnitInterval where
  validate :: PositiveUnitInterval -> Validation
validate PositiveUnitInterval
_ = Validation
forall a. Monoid a => a
mempty

instance GenValid PositiveUnitInterval where
  genValid :: Gen PositiveUnitInterval
genValid = do
    Positive (x :: Word64) <- Gen (Positive Word64)
forall a. Arbitrary a => Gen a
arbitrary
    Positive (y :: Word64) <- arbitrary
    pure $ unsafeBoundRational $ promoteRatio (if x > y then y % x else x % y)
  shrinkValid :: PositiveUnitInterval -> [PositiveUnitInterval]
shrinkValid PositiveUnitInterval
_ = []

instance Validity PositiveInterval where
  validate :: PositiveInterval -> Validation
validate PositiveInterval
_ = Validation
forall a. Monoid a => a
mempty

instance GenValid PositiveInterval where
  genValid :: Gen PositiveInterval
genValid = do
    Positive (x :: Word64) <- Gen (Positive Word64)
forall a. Arbitrary a => Gen a
arbitrary
    Positive (y :: Word64) <- arbitrary
    pure $ unsafeBoundRational $ promoteRatio (x % y)
  shrinkValid :: PositiveInterval -> [PositiveInterval]
shrinkValid PositiveInterval
_ = []

instance Validity NonNegativeInterval where
  validate :: NonNegativeInterval -> Validation
validate NonNegativeInterval
_ = Validation
forall a. Monoid a => a
mempty

instance GenValid NonNegativeInterval where
  genValid :: Gen NonNegativeInterval
genValid = do
    x :: Word64 <- Gen Word64
forall a. GenValid a => Gen a
genValid
    Positive (y :: Word64) <- arbitrary
    pure $ unsafeBoundRational $ promoteRatio (x % y)
  shrinkValid :: NonNegativeInterval -> [NonNegativeInterval]
shrinkValid NonNegativeInterval
_ = []

instance Arbitrary TxIx where
  -- starting with Conway, we only deserialize TxIx within Word16 range
  arbitrary :: Gen TxIx
arbitrary = Word16 -> TxIx
TxIx (Word16 -> TxIx) -> (Word16 -> Word16) -> Word16 -> TxIx
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Word16 -> Word16
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Word16 -> TxIx) -> Gen Word16 -> Gen TxIx
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall a. Arbitrary a => Gen a
arbitrary @Word16

instance Arbitrary CertIx where
  -- starting with Conway, we only deserialize CertIx within Word16 range
  arbitrary :: Gen CertIx
arbitrary = Word16 -> CertIx
CertIx (Word16 -> CertIx) -> (Word16 -> Word16) -> Word16 -> CertIx
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Word16 -> Word16
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Word16 -> CertIx) -> Gen Word16 -> Gen CertIx
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall a. Arbitrary a => Gen a
arbitrary @Word16

instance Arbitrary ProtVer where
  arbitrary :: Gen ProtVer
arbitrary = Version -> Natural -> ProtVer
ProtVer (Version -> Natural -> ProtVer)
-> Gen Version -> Gen (Natural -> ProtVer)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Gen Version
forall a. Arbitrary a => Gen a
arbitrary Gen (Natural -> ProtVer) -> Gen Natural -> Gen ProtVer
forall a b. Gen (a -> b) -> Gen a -> Gen b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Gen Natural
forall a. Arbitrary a => Gen a
arbitrary

instance Arbitrary Nonce where
  arbitrary :: Gen Nonce
arbitrary =
    [Gen Nonce] -> Gen Nonce
forall a. HasCallStack => [Gen a] -> Gen a
oneof
      [ Nonce -> Gen Nonce
forall a. a -> Gen a
forall (m :: * -> *) a. Monad m => a -> m a
return Nonce
NeutralNonce
      , Word64 -> Nonce
mkNonceFromNumber (Word64 -> Nonce) -> Gen Word64 -> Gen Nonce
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Gen Word64
forall a. Arbitrary a => Gen a
arbitrary
      ]

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

------------------------------------------------------------------------------------------
-- Cardano.Ledger.TxIn -------------------------------------------------------------------
------------------------------------------------------------------------------------------

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

instance Arbitrary TxIn where
  arbitrary :: Gen TxIn
arbitrary = TxId -> TxIx -> TxIn
TxIn (TxId -> TxIx -> TxIn) -> Gen TxId -> Gen (TxIx -> TxIn)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Gen TxId
forall a. Arbitrary a => Gen a
arbitrary Gen (TxIx -> TxIn) -> Gen TxIx -> Gen TxIn
forall a b. Gen (a -> b) -> Gen a -> Gen b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Gen TxIx
forall a. Arbitrary a => Gen a
arbitrary

------------------------------------------------------------------------------------------
-- Cardano.Ledger.Credential --------------------------------------------------------------
------------------------------------------------------------------------------------------

deriving instance Arbitrary SlotNo32

instance Arbitrary Ptr where
  arbitrary :: Gen Ptr
arbitrary = SlotNo32 -> TxIx -> CertIx -> Ptr
Ptr (SlotNo32 -> TxIx -> CertIx -> Ptr)
-> Gen SlotNo32 -> Gen (TxIx -> CertIx -> Ptr)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Gen SlotNo32
forall a. Arbitrary a => Gen a
arbitrary Gen (TxIx -> CertIx -> Ptr) -> Gen TxIx -> Gen (CertIx -> Ptr)
forall a b. Gen (a -> b) -> Gen a -> Gen b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Gen TxIx
forall a. Arbitrary a => Gen a
arbitrary Gen (CertIx -> Ptr) -> Gen CertIx -> Gen Ptr
forall a b. Gen (a -> b) -> Gen a -> Gen b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Gen CertIx
forall a. Arbitrary a => Gen a
arbitrary

instance Arbitrary (Credential r) where
  arbitrary :: Gen (Credential r)
arbitrary =
    [Gen (Credential r)] -> Gen (Credential r)
forall a. HasCallStack => [Gen a] -> Gen a
oneof
      [ ScriptHash -> Credential r
forall (kr :: KeyRole). ScriptHash -> Credential kr
ScriptHashObj (ScriptHash -> Credential r)
-> Gen ScriptHash -> Gen (Credential r)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Gen ScriptHash
forall a. Arbitrary a => Gen a
arbitrary
      , KeyHash r -> Credential r
forall (kr :: KeyRole). KeyHash kr -> Credential kr
KeyHashObj (KeyHash r -> Credential r)
-> Gen (KeyHash r) -> Gen (Credential r)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Gen (KeyHash r)
forall a. Arbitrary a => Gen a
arbitrary
      ]

------------------------------------------------------------------------------------------
-- Cardano.Ledger.Hashes -----------------------------------------------------------------
------------------------------------------------------------------------------------------

genHash :: forall h a. HashAlgorithm h => Gen (Hash h a)
genHash :: forall h a. HashAlgorithm h => Gen (Hash h a)
genHash = ShortByteString -> Hash h a
forall h a. HashAlgorithm h => ShortByteString -> Hash h a
UnsafeHash (ShortByteString -> Hash h a)
-> Gen ShortByteString -> Gen (Hash h a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Int -> Gen ShortByteString
genShortByteString (Word -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Proxy h -> Word
forall h (proxy :: * -> *). HashAlgorithm h => proxy h -> Word
sizeHash (forall t. Proxy t
forall {k} (t :: k). Proxy t
Proxy @h)))

instance Arbitrary (SafeHash i) where
  arbitrary :: Gen (SafeHash i)
arbitrary = Hash HASH i -> SafeHash i
forall i. Hash HASH i -> SafeHash i
unsafeMakeSafeHash (Hash HASH i -> SafeHash i)
-> Gen (Hash HASH i) -> Gen (SafeHash i)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Gen (Hash HASH i)
forall h a. HashAlgorithm h => Gen (Hash h a)
genHash

instance Arbitrary ScriptHash where
  arbitrary :: Gen ScriptHash
arbitrary = Hash ADDRHASH EraIndependentScript -> ScriptHash
ScriptHash (Hash ADDRHASH EraIndependentScript -> ScriptHash)
-> Gen (Hash ADDRHASH EraIndependentScript) -> Gen ScriptHash
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Gen (Hash ADDRHASH EraIndependentScript)
forall h a. HashAlgorithm h => Gen (Hash h a)
genHash

------------------------------------------------------------------------------------------
-- Cardano.Ledger.AuxiliaryDataHash ------------------------------------------------------
------------------------------------------------------------------------------------------

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

------------------------------------------------------------------------------------------
-- Cardano.Ledger.Keys -------------------------------------------------------------------
------------------------------------------------------------------------------------------

instance Arbitrary (KeyHash r) where
  arbitrary :: Gen (KeyHash r)
arbitrary = Hash ADDRHASH (VerKeyDSIGN DSIGN) -> KeyHash r
forall (r :: KeyRole).
Hash ADDRHASH (VerKeyDSIGN DSIGN) -> KeyHash r
KeyHash (Hash ADDRHASH (VerKeyDSIGN DSIGN) -> KeyHash r)
-> Gen (Hash ADDRHASH (VerKeyDSIGN DSIGN)) -> Gen (KeyHash r)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Gen (Hash ADDRHASH (VerKeyDSIGN DSIGN))
forall h a. HashAlgorithm h => Gen (Hash h a)
genHash

instance Arbitrary (VRFVerKeyHash r) where
  arbitrary :: Gen (VRFVerKeyHash r)
arbitrary = Hash HASH KeyRoleVRF -> VRFVerKeyHash r
forall (r :: KeyRoleVRF). Hash HASH KeyRoleVRF -> VRFVerKeyHash r
VRFVerKeyHash (Hash HASH KeyRoleVRF -> VRFVerKeyHash r)
-> Gen (Hash HASH KeyRoleVRF) -> Gen (VRFVerKeyHash r)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Gen (Hash HASH KeyRoleVRF)
forall h a. HashAlgorithm h => Gen (Hash h a)
genHash

instance Arbitrary (VKey kd) where
  arbitrary :: Gen (VKey kd)
arbitrary = VerKeyDSIGN DSIGN -> VKey kd
forall (kd :: KeyRole). VerKeyDSIGN DSIGN -> VKey kd
VKey (VerKeyDSIGN DSIGN -> VKey kd)
-> Gen (VerKeyDSIGN DSIGN) -> Gen (VKey kd)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Gen (VerKeyDSIGN DSIGN)
forall a. Arbitrary a => Gen a
arbitrary

instance Typeable kr => Arbitrary (WitVKey kr) where
  arbitrary :: Gen (WitVKey kr)
arbitrary = VKey kr
-> SignedDSIGN DSIGN (Hash HASH EraIndependentTxBody) -> WitVKey kr
forall (kr :: KeyRole).
VKey kr
-> SignedDSIGN DSIGN (Hash HASH EraIndependentTxBody) -> WitVKey kr
WitVKey (VKey kr
 -> SignedDSIGN DSIGN (Hash HASH EraIndependentTxBody)
 -> WitVKey kr)
-> Gen (VKey kr)
-> Gen
     (SignedDSIGN DSIGN (Hash HASH EraIndependentTxBody) -> WitVKey kr)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Gen (VKey kr)
forall a. Arbitrary a => Gen a
arbitrary Gen
  (SignedDSIGN DSIGN (Hash HASH EraIndependentTxBody) -> WitVKey kr)
-> Gen (SignedDSIGN DSIGN (Hash HASH EraIndependentTxBody))
-> Gen (WitVKey kr)
forall a b. Gen (a -> b) -> Gen a -> Gen b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Gen (SignedDSIGN DSIGN (Hash HASH EraIndependentTxBody))
forall a. Arbitrary a => Gen a
arbitrary

instance Arbitrary ChainCode where
  arbitrary :: Gen ChainCode
arbitrary = ByteString -> ChainCode
ChainCode (ByteString -> ChainCode) -> Gen ByteString -> Gen ChainCode
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Int -> Gen ByteString
genByteString Int
32

instance Arbitrary BootstrapWitness where
  arbitrary :: Gen BootstrapWitness
arbitrary = do
    bwKey <- Gen (VKey Witness)
forall a. Arbitrary a => Gen a
arbitrary
    bwSignature <- arbitrary
    bwChainCode <- arbitrary
    bwAttributes <- arbitrary
    pure $ BootstrapWitness {bwKey, bwSignature, bwChainCode, bwAttributes}
  shrink :: BootstrapWitness -> [BootstrapWitness]
shrink = BootstrapWitness -> [BootstrapWitness]
forall a.
(Generic a, RecursivelyShrink (Rep a), GSubterms (Rep a) a) =>
a -> [a]
genericShrink

instance Arbitrary GenDelegPair where
  arbitrary :: Gen GenDelegPair
arbitrary = KeyHash GenesisDelegate
-> VRFVerKeyHash GenDelegVRF -> GenDelegPair
GenDelegPair (KeyHash GenesisDelegate
 -> VRFVerKeyHash GenDelegVRF -> GenDelegPair)
-> Gen (KeyHash GenesisDelegate)
-> Gen (VRFVerKeyHash GenDelegVRF -> GenDelegPair)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Gen (KeyHash GenesisDelegate)
forall a. Arbitrary a => Gen a
arbitrary Gen (VRFVerKeyHash GenDelegVRF -> GenDelegPair)
-> Gen (VRFVerKeyHash GenDelegVRF) -> Gen GenDelegPair
forall a b. Gen (a -> b) -> Gen a -> Gen b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Gen (VRFVerKeyHash GenDelegVRF)
forall a. Arbitrary a => Gen a
arbitrary

deriving instance Arbitrary GenDelegs

------------------------------------------------------------------------------------------
-- Cardano.Ledger.Coin -------------------------------------------------------------------
------------------------------------------------------------------------------------------
instance Arbitrary (CompactForm Coin) where
  arbitrary :: Gen (CompactForm Coin)
arbitrary = Word64 -> CompactForm Coin
CompactCoin (Word64 -> CompactForm Coin)
-> Gen Word64 -> Gen (CompactForm Coin)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [Gen Word64] -> Gen Word64
forall a. HasCallStack => [Gen a] -> Gen a
oneof [(Word64, Word64) -> Gen Word64
forall a. Random a => (a, a) -> Gen a
choose (Word64
0, Word64
1000000), Word -> Word64
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Word -> Word64) -> Gen Word -> Gen Word64
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Gen Word
forall a. Arbitrary a => Gen a
arbitrary :: Gen Word), Gen Word64
forall a. Arbitrary a => Gen a
arbitrary]
  shrink :: CompactForm Coin -> [CompactForm Coin]
shrink (CompactCoin Word64
i) = Word64 -> CompactForm Coin
CompactCoin (Word64 -> CompactForm Coin) -> [Word64] -> [CompactForm Coin]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Word64 -> [Word64]
forall a. Arbitrary a => a -> [a]
shrink Word64
i

instance Arbitrary Coin where
  -- Cannot be negative even though it is an 'Integer'
  arbitrary :: Gen Coin
arbitrary = Integer -> Coin
Coin (Integer -> Coin) -> Gen Integer -> Gen Coin
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [Gen Integer] -> Gen Integer
forall a. HasCallStack => [Gen a] -> Gen a
oneof [(Integer, Integer) -> Gen Integer
forall a. Random a => (a, a) -> Gen a
choose (Integer
0, Integer
1000000), NonNegative Integer -> Integer
forall a. NonNegative a -> a
getNonNegative (NonNegative Integer -> Integer)
-> Gen (NonNegative Integer) -> Gen Integer
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Gen (NonNegative Integer)
forall a. Arbitrary a => Gen a
arbitrary]
  shrink :: Coin -> [Coin]
shrink (Coin Integer
i) = Integer -> Coin
Coin (Integer -> Coin) -> [Integer] -> [Coin]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Integer -> [Integer]
forall a. Arbitrary a => a -> [a]
shrink Integer
i

instance Arbitrary DeltaCoin where
  arbitrary :: Gen DeltaCoin
arbitrary = Integer -> DeltaCoin
DeltaCoin (Integer -> DeltaCoin) -> Gen Integer -> Gen DeltaCoin
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Integer, Integer) -> Gen Integer
forall a. Random a => (a, a) -> Gen a
choose (-Integer
1000000, Integer
1000000)
  shrink :: DeltaCoin -> [DeltaCoin]
shrink (DeltaCoin Integer
i) = Integer -> DeltaCoin
DeltaCoin (Integer -> DeltaCoin) -> [Integer] -> [DeltaCoin]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Integer -> [Integer]
forall a. Arbitrary a => a -> [a]
shrink Integer
i

------------------------------------------------------------------------------------------
-- Cardano.Ledger.Address ----------------------------------------------------------------
------------------------------------------------------------------------------------------

instance Arbitrary BootstrapAddress where
  arbitrary :: Gen BootstrapAddress
arbitrary = Address -> BootstrapAddress
BootstrapAddress (Address -> BootstrapAddress)
-> Gen Address -> Gen BootstrapAddress
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Gen Address -> Gen Address
forall a. Gen a -> Gen a
hedgehog Gen Address
Byron.genAddress

instance Arbitrary Byron.Address where
  arbitrary :: Gen Address
arbitrary = Gen Address -> Gen Address
forall a. Gen a -> Gen a
hedgehog Gen Address
Byron.genAddress

instance Arbitrary Byron.AddrAttributes where
  arbitrary :: Gen AddrAttributes
arbitrary = Gen AddrAttributes -> Gen AddrAttributes
forall a. Gen a -> Gen a
hedgehog Gen AddrAttributes
Byron.genAddrAttributes

instance Arbitrary (Byron.Attributes Byron.AddrAttributes) where
  arbitrary :: Gen (Attributes AddrAttributes)
arbitrary = Gen (Attributes AddrAttributes) -> Gen (Attributes AddrAttributes)
forall a. Gen a -> Gen a
hedgehog (Gen (Attributes AddrAttributes)
 -> Gen (Attributes AddrAttributes))
-> Gen (Attributes AddrAttributes)
-> Gen (Attributes AddrAttributes)
forall a b. (a -> b) -> a -> b
$ Gen AddrAttributes -> Gen (Attributes AddrAttributes)
forall a. Gen a -> Gen (Attributes a)
Byron.genAttributes Gen AddrAttributes
Byron.genAddrAttributes

instance Arbitrary Addr where
  arbitrary :: Gen Addr
arbitrary = Gen Ptr -> Gen Addr
genAddrWith Gen Ptr
forall a. Arbitrary a => Gen a
arbitrary
  shrink :: Addr -> [Addr]
shrink = Addr -> [Addr]
forall a.
(Generic a, RecursivelyShrink (Rep a), GSubterms (Rep a) a) =>
a -> [a]
genericShrink

genAddrWith :: Gen Ptr -> Gen Addr
genAddrWith :: Gen Ptr -> Gen Addr
genAddrWith Gen Ptr
genPtr =
  [(Int, Gen Addr)] -> Gen Addr
forall a. HasCallStack => [(Int, Gen a)] -> Gen a
frequency
    [ (Int
8, Network -> Credential Payment -> StakeReference -> Addr
Addr (Network -> Credential Payment -> StakeReference -> Addr)
-> Gen Network
-> Gen (Credential Payment -> StakeReference -> Addr)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Gen Network
forall a. Arbitrary a => Gen a
arbitrary Gen (Credential Payment -> StakeReference -> Addr)
-> Gen (Credential Payment) -> Gen (StakeReference -> Addr)
forall a b. Gen (a -> b) -> Gen a -> Gen b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Gen (Credential Payment)
forall a. Arbitrary a => Gen a
arbitrary Gen (StakeReference -> Addr) -> Gen StakeReference -> Gen Addr
forall a b. Gen (a -> b) -> Gen a -> Gen b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Gen Ptr -> Gen StakeReference
genStakeRefWith Gen Ptr
genPtr)
    , (Int
2, BootstrapAddress -> Addr
AddrBootstrap (BootstrapAddress -> Addr) -> Gen BootstrapAddress -> Gen Addr
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Gen BootstrapAddress
forall a. Arbitrary a => Gen a
arbitrary)
    ]

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

instance Arbitrary StakeReference where
  arbitrary :: Gen StakeReference
arbitrary = Gen Ptr -> Gen StakeReference
genStakeRefWith Gen Ptr
forall a. Arbitrary a => Gen a
arbitrary
  shrink :: StakeReference -> [StakeReference]
shrink = StakeReference -> [StakeReference]
forall a.
(Generic a, RecursivelyShrink (Rep a), GSubterms (Rep a) a) =>
a -> [a]
genericShrink

genStakeRefWith :: Gen Ptr -> Gen StakeReference
genStakeRefWith :: Gen Ptr -> Gen StakeReference
genStakeRefWith Gen Ptr
genPtr =
  [(Int, Gen StakeReference)] -> Gen StakeReference
forall a. HasCallStack => [(Int, Gen a)] -> Gen a
frequency
    [ (Int
80, Credential Staking -> StakeReference
StakeRefBase (Credential Staking -> StakeReference)
-> Gen (Credential Staking) -> Gen StakeReference
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Gen (Credential Staking)
forall a. Arbitrary a => Gen a
arbitrary)
    , (Int
5, Ptr -> StakeReference
StakeRefPtr (Ptr -> StakeReference) -> Gen Ptr -> Gen StakeReference
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Gen Ptr
genPtr)
    , (Int
15, StakeReference -> Gen StakeReference
forall a. a -> Gen a
forall (f :: * -> *) a. Applicative f => a -> f a
pure StakeReference
StakeRefNull)
    ]

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

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

------------------------------------------------------------------------------------------
-- Cardano.Ledger.Reward -----------------------------------------------------------------
------------------------------------------------------------------------------------------

instance Arbitrary RewardType where
  arbitrary :: Gen RewardType
arbitrary = Gen RewardType
forall a. (Bounded a, Enum a) => Gen a
arbitraryBoundedEnum
  shrink :: RewardType -> [RewardType]
shrink = RewardType -> [RewardType]
forall a.
(Generic a, RecursivelyShrink (Rep a), GSubterms (Rep a) a) =>
a -> [a]
genericShrink

instance Arbitrary Reward where
  arbitrary :: Gen Reward
arbitrary = RewardType -> KeyHash StakePool -> Coin -> Reward
Reward (RewardType -> KeyHash StakePool -> Coin -> Reward)
-> Gen RewardType -> Gen (KeyHash StakePool -> Coin -> Reward)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Gen RewardType
forall a. Arbitrary a => Gen a
arbitrary Gen (KeyHash StakePool -> Coin -> Reward)
-> Gen (KeyHash StakePool) -> Gen (Coin -> Reward)
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 Gen (Coin -> Reward) -> Gen Coin -> Gen Reward
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 :: Reward -> [Reward]
shrink = Reward -> [Reward]
forall a.
(Generic a, RecursivelyShrink (Rep a), GSubterms (Rep a) a) =>
a -> [a]
genericShrink

------------------------------------------------------------------------------------------
-- Cardano.Ledger.PoolParams -------------------------------------------------------------
------------------------------------------------------------------------------------------

instance Arbitrary StakePoolParams where
  arbitrary :: Gen StakePoolParams
arbitrary =
    KeyHash StakePool
-> VRFVerKeyHash StakePoolVRF
-> Coin
-> Coin
-> UnitInterval
-> RewardAccount
-> Set (KeyHash Staking)
-> StrictSeq StakePoolRelay
-> StrictMaybe PoolMetadata
-> StakePoolParams
StakePoolParams
      (KeyHash StakePool
 -> VRFVerKeyHash StakePoolVRF
 -> Coin
 -> Coin
 -> UnitInterval
 -> RewardAccount
 -> Set (KeyHash Staking)
 -> StrictSeq StakePoolRelay
 -> StrictMaybe PoolMetadata
 -> StakePoolParams)
-> Gen (KeyHash StakePool)
-> Gen
     (VRFVerKeyHash StakePoolVRF
      -> Coin
      -> Coin
      -> UnitInterval
      -> RewardAccount
      -> Set (KeyHash Staking)
      -> StrictSeq StakePoolRelay
      -> StrictMaybe PoolMetadata
      -> StakePoolParams)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Gen (KeyHash StakePool)
forall a. Arbitrary a => Gen a
arbitrary
      Gen
  (VRFVerKeyHash StakePoolVRF
   -> Coin
   -> Coin
   -> UnitInterval
   -> RewardAccount
   -> Set (KeyHash Staking)
   -> StrictSeq StakePoolRelay
   -> StrictMaybe PoolMetadata
   -> StakePoolParams)
-> Gen (VRFVerKeyHash StakePoolVRF)
-> Gen
     (Coin
      -> Coin
      -> UnitInterval
      -> RewardAccount
      -> Set (KeyHash Staking)
      -> StrictSeq StakePoolRelay
      -> StrictMaybe PoolMetadata
      -> StakePoolParams)
forall a b. Gen (a -> b) -> Gen a -> Gen b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Gen (VRFVerKeyHash StakePoolVRF)
forall a. Arbitrary a => Gen a
arbitrary
      Gen
  (Coin
   -> Coin
   -> UnitInterval
   -> RewardAccount
   -> Set (KeyHash Staking)
   -> StrictSeq StakePoolRelay
   -> StrictMaybe PoolMetadata
   -> StakePoolParams)
-> Gen Coin
-> Gen
     (Coin
      -> UnitInterval
      -> RewardAccount
      -> Set (KeyHash Staking)
      -> StrictSeq StakePoolRelay
      -> StrictMaybe PoolMetadata
      -> StakePoolParams)
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
   -> UnitInterval
   -> RewardAccount
   -> Set (KeyHash Staking)
   -> StrictSeq StakePoolRelay
   -> StrictMaybe PoolMetadata
   -> StakePoolParams)
-> Gen Coin
-> Gen
     (UnitInterval
      -> RewardAccount
      -> Set (KeyHash Staking)
      -> StrictSeq StakePoolRelay
      -> StrictMaybe PoolMetadata
      -> StakePoolParams)
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
  (UnitInterval
   -> RewardAccount
   -> Set (KeyHash Staking)
   -> StrictSeq StakePoolRelay
   -> StrictMaybe PoolMetadata
   -> StakePoolParams)
-> Gen UnitInterval
-> Gen
     (RewardAccount
      -> Set (KeyHash Staking)
      -> StrictSeq StakePoolRelay
      -> StrictMaybe PoolMetadata
      -> StakePoolParams)
forall a b. Gen (a -> b) -> Gen a -> Gen b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Gen UnitInterval
forall a. Arbitrary a => Gen a
arbitrary
      Gen
  (RewardAccount
   -> Set (KeyHash Staking)
   -> StrictSeq StakePoolRelay
   -> StrictMaybe PoolMetadata
   -> StakePoolParams)
-> Gen RewardAccount
-> Gen
     (Set (KeyHash Staking)
      -> StrictSeq StakePoolRelay
      -> StrictMaybe PoolMetadata
      -> StakePoolParams)
forall a b. Gen (a -> b) -> Gen a -> Gen b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Gen RewardAccount
forall a. Arbitrary a => Gen a
arbitrary
      Gen
  (Set (KeyHash Staking)
   -> StrictSeq StakePoolRelay
   -> StrictMaybe PoolMetadata
   -> StakePoolParams)
-> Gen (Set (KeyHash Staking))
-> Gen
     (StrictSeq StakePoolRelay
      -> StrictMaybe PoolMetadata -> StakePoolParams)
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 (KeyHash Staking))
forall a. Arbitrary a => Gen a
arbitrary
      Gen
  (StrictSeq StakePoolRelay
   -> StrictMaybe PoolMetadata -> StakePoolParams)
-> Gen (StrictSeq StakePoolRelay)
-> Gen (StrictMaybe PoolMetadata -> StakePoolParams)
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 StakePoolRelay)
forall a. Arbitrary a => Gen a
arbitrary
      Gen (StrictMaybe PoolMetadata -> StakePoolParams)
-> Gen (StrictMaybe PoolMetadata) -> Gen StakePoolParams
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 PoolMetadata)
forall a. Arbitrary a => Gen a
arbitrary

instance Arbitrary StakePoolState where
  arbitrary :: Gen StakePoolState
arbitrary =
    VRFVerKeyHash StakePoolVRF
-> Coin
-> Coin
-> UnitInterval
-> Credential Staking
-> Set (KeyHash Staking)
-> StrictSeq StakePoolRelay
-> StrictMaybe PoolMetadata
-> CompactForm Coin
-> Set (Credential Staking)
-> StakePoolState
StakePoolState
      (VRFVerKeyHash StakePoolVRF
 -> Coin
 -> Coin
 -> UnitInterval
 -> Credential Staking
 -> Set (KeyHash Staking)
 -> StrictSeq StakePoolRelay
 -> StrictMaybe PoolMetadata
 -> CompactForm Coin
 -> Set (Credential Staking)
 -> StakePoolState)
-> Gen (VRFVerKeyHash StakePoolVRF)
-> Gen
     (Coin
      -> Coin
      -> UnitInterval
      -> Credential Staking
      -> Set (KeyHash Staking)
      -> StrictSeq StakePoolRelay
      -> StrictMaybe PoolMetadata
      -> CompactForm Coin
      -> Set (Credential Staking)
      -> StakePoolState)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Gen (VRFVerKeyHash StakePoolVRF)
forall a. Arbitrary a => Gen a
arbitrary
      Gen
  (Coin
   -> Coin
   -> UnitInterval
   -> Credential Staking
   -> Set (KeyHash Staking)
   -> StrictSeq StakePoolRelay
   -> StrictMaybe PoolMetadata
   -> CompactForm Coin
   -> Set (Credential Staking)
   -> StakePoolState)
-> Gen Coin
-> Gen
     (Coin
      -> UnitInterval
      -> Credential Staking
      -> Set (KeyHash Staking)
      -> StrictSeq StakePoolRelay
      -> StrictMaybe PoolMetadata
      -> CompactForm Coin
      -> Set (Credential Staking)
      -> StakePoolState)
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
   -> UnitInterval
   -> Credential Staking
   -> Set (KeyHash Staking)
   -> StrictSeq StakePoolRelay
   -> StrictMaybe PoolMetadata
   -> CompactForm Coin
   -> Set (Credential Staking)
   -> StakePoolState)
-> Gen Coin
-> Gen
     (UnitInterval
      -> Credential Staking
      -> Set (KeyHash Staking)
      -> StrictSeq StakePoolRelay
      -> StrictMaybe PoolMetadata
      -> CompactForm Coin
      -> Set (Credential Staking)
      -> StakePoolState)
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
  (UnitInterval
   -> Credential Staking
   -> Set (KeyHash Staking)
   -> StrictSeq StakePoolRelay
   -> StrictMaybe PoolMetadata
   -> CompactForm Coin
   -> Set (Credential Staking)
   -> StakePoolState)
-> Gen UnitInterval
-> Gen
     (Credential Staking
      -> Set (KeyHash Staking)
      -> StrictSeq StakePoolRelay
      -> StrictMaybe PoolMetadata
      -> CompactForm Coin
      -> Set (Credential Staking)
      -> StakePoolState)
forall a b. Gen (a -> b) -> Gen a -> Gen b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Gen UnitInterval
forall a. Arbitrary a => Gen a
arbitrary
      Gen
  (Credential Staking
   -> Set (KeyHash Staking)
   -> StrictSeq StakePoolRelay
   -> StrictMaybe PoolMetadata
   -> CompactForm Coin
   -> Set (Credential Staking)
   -> StakePoolState)
-> Gen (Credential Staking)
-> Gen
     (Set (KeyHash Staking)
      -> StrictSeq StakePoolRelay
      -> StrictMaybe PoolMetadata
      -> CompactForm Coin
      -> Set (Credential Staking)
      -> StakePoolState)
forall a b. Gen (a -> b) -> Gen a -> Gen b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Gen (Credential Staking)
forall a. Arbitrary a => Gen a
arbitrary
      Gen
  (Set (KeyHash Staking)
   -> StrictSeq StakePoolRelay
   -> StrictMaybe PoolMetadata
   -> CompactForm Coin
   -> Set (Credential Staking)
   -> StakePoolState)
-> Gen (Set (KeyHash Staking))
-> Gen
     (StrictSeq StakePoolRelay
      -> StrictMaybe PoolMetadata
      -> CompactForm Coin
      -> Set (Credential Staking)
      -> StakePoolState)
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 (KeyHash Staking))
forall a. Arbitrary a => Gen a
arbitrary
      Gen
  (StrictSeq StakePoolRelay
   -> StrictMaybe PoolMetadata
   -> CompactForm Coin
   -> Set (Credential Staking)
   -> StakePoolState)
-> Gen (StrictSeq StakePoolRelay)
-> Gen
     (StrictMaybe PoolMetadata
      -> CompactForm Coin -> Set (Credential Staking) -> StakePoolState)
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 StakePoolRelay)
forall a. Arbitrary a => Gen a
arbitrary
      Gen
  (StrictMaybe PoolMetadata
   -> CompactForm Coin -> Set (Credential Staking) -> StakePoolState)
-> Gen (StrictMaybe PoolMetadata)
-> Gen
     (CompactForm Coin -> Set (Credential Staking) -> StakePoolState)
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 PoolMetadata)
forall a. Arbitrary a => Gen a
arbitrary
      Gen
  (CompactForm Coin -> Set (Credential Staking) -> StakePoolState)
-> Gen (CompactForm Coin)
-> Gen (Set (Credential Staking) -> StakePoolState)
forall a b. Gen (a -> b) -> Gen a -> Gen b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Gen (CompactForm Coin)
forall a. Arbitrary a => Gen a
arbitrary
      Gen (Set (Credential Staking) -> StakePoolState)
-> Gen (Set (Credential Staking)) -> Gen StakePoolState
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

instance Arbitrary PoolMetadata where
  arbitrary :: Gen PoolMetadata
arbitrary = Url -> ByteString -> PoolMetadata
PoolMetadata (Url -> ByteString -> PoolMetadata)
-> Gen Url -> Gen (ByteString -> PoolMetadata)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Gen Url
forall a. Arbitrary a => Gen a
arbitrary Gen (ByteString -> PoolMetadata)
-> Gen ByteString -> Gen PoolMetadata
forall a b. Gen (a -> b) -> Gen a -> Gen b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Gen ByteString
forall a. Arbitrary a => Gen a
arbitrary

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

instance Arbitrary SizeOfPoolRelays where
  arbitrary :: Gen SizeOfPoolRelays
arbitrary = SizeOfPoolRelays -> Gen SizeOfPoolRelays
forall a. a -> Gen a
forall (f :: * -> *) a. Applicative f => a -> f a
pure SizeOfPoolRelays
SizeOfPoolRelays

instance Arbitrary SizeOfPoolOwners where
  arbitrary :: Gen SizeOfPoolOwners
arbitrary = SizeOfPoolOwners -> Gen SizeOfPoolOwners
forall a. a -> Gen a
forall (f :: * -> *) a. Applicative f => a -> f a
pure SizeOfPoolOwners
SizeOfPoolOwners

------------------------------------------------------------------------------------------
-- Cardano.Ledger.State ------------------------------------------------------------------
------------------------------------------------------------------------------------------

instance Arbitrary ChainAccountState where
  arbitrary :: Gen ChainAccountState
arbitrary = Coin -> Coin -> ChainAccountState
ChainAccountState (Coin -> Coin -> ChainAccountState)
-> Gen Coin -> Gen (Coin -> ChainAccountState)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Gen Coin
forall a. Arbitrary a => Gen a
arbitrary Gen (Coin -> ChainAccountState)
-> Gen Coin -> Gen ChainAccountState
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 :: ChainAccountState -> [ChainAccountState]
shrink = ChainAccountState -> [ChainAccountState]
forall a.
(Generic a, RecursivelyShrink (Rep a), GSubterms (Rep a) a) =>
a -> [a]
genericShrink

------------------------------------------------------------------------------------------
-- Cardano.Ledger.State.PoolDistr --------------------------------------------------------
------------------------------------------------------------------------------------------

instance Arbitrary PoolDistr where
  arbitrary :: Gen PoolDistr
arbitrary = do
    Positive denominator <- Gen (Positive Word64)
forall a. Arbitrary a => Gen a
arbitrary
    PoolDistr <$> arbitrary <*> pure (CompactCoin denominator)

instance Arbitrary IndividualPoolStake where
  arbitrary :: Gen IndividualPoolStake
arbitrary = Rational
-> CompactForm Coin
-> VRFVerKeyHash StakePoolVRF
-> IndividualPoolStake
IndividualPoolStake (Rational
 -> CompactForm Coin
 -> VRFVerKeyHash StakePoolVRF
 -> IndividualPoolStake)
-> Gen Rational
-> Gen
     (CompactForm Coin
      -> VRFVerKeyHash StakePoolVRF -> IndividualPoolStake)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Gen Rational
forall a. Arbitrary a => Gen a
arbitrary Gen
  (CompactForm Coin
   -> VRFVerKeyHash StakePoolVRF -> IndividualPoolStake)
-> Gen (CompactForm Coin)
-> Gen (VRFVerKeyHash StakePoolVRF -> IndividualPoolStake)
forall a b. Gen (a -> b) -> Gen a -> Gen b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Gen (CompactForm Coin)
forall a. Arbitrary a => Gen a
arbitrary Gen (VRFVerKeyHash StakePoolVRF -> IndividualPoolStake)
-> Gen (VRFVerKeyHash StakePoolVRF) -> Gen IndividualPoolStake
forall a b. Gen (a -> b) -> Gen a -> Gen b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Gen (VRFVerKeyHash StakePoolVRF)
forall a. Arbitrary a => Gen a
arbitrary

------------------------------------------------------------------------------------------
-- Cardano.Ledger.DRepState --------------------------------------------------------------
------------------------------------------------------------------------------------------

instance Arbitrary DRepState where
  arbitrary :: Gen DRepState
arbitrary = EpochNo
-> StrictMaybe Anchor
-> CompactForm Coin
-> Set (Credential Staking)
-> DRepState
DRepState (EpochNo
 -> StrictMaybe Anchor
 -> CompactForm Coin
 -> Set (Credential Staking)
 -> DRepState)
-> Gen EpochNo
-> Gen
     (StrictMaybe Anchor
      -> CompactForm Coin -> Set (Credential Staking) -> DRepState)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Gen EpochNo
forall a. Arbitrary a => Gen a
arbitrary Gen
  (StrictMaybe Anchor
   -> CompactForm Coin -> Set (Credential Staking) -> DRepState)
-> Gen (StrictMaybe Anchor)
-> Gen (CompactForm Coin -> Set (Credential Staking) -> DRepState)
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 Anchor)
forall a. Arbitrary a => Gen a
arbitrary Gen (CompactForm Coin -> Set (Credential Staking) -> DRepState)
-> Gen (CompactForm Coin)
-> Gen (Set (Credential Staking) -> DRepState)
forall a b. Gen (a -> b) -> Gen a -> Gen b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Gen (CompactForm Coin)
forall a. Arbitrary a => Gen a
arbitrary Gen (Set (Credential Staking) -> DRepState)
-> Gen (Set (Credential Staking)) -> Gen DRepState
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

------------------------------------------------------------------------------------------
-- Cardano.Ledger.State.UTxO -------------------------------------------------------------
------------------------------------------------------------------------------------------

deriving instance (EraTxOut era, Arbitrary (TxOut era)) => Arbitrary (UTxO era)

------------------------------------------------------------------------------------------
-- Cardano.Ledger.Core.PParams -----------------------------------------------------------
------------------------------------------------------------------------------------------

deriving instance (Era era, Arbitrary (PParamsHKD Identity era)) => Arbitrary (PParams era)

deriving instance (Era era, Arbitrary (PParamsHKD StrictMaybe era)) => Arbitrary (PParamsUpdate era)

------------------------------------------------------------------------------------------
-- Cardano.Ledger.DRep -------------------------------------------------------------------
------------------------------------------------------------------------------------------

instance Arbitrary DRep where
  arbitrary :: Gen DRep
arbitrary =
    [Gen DRep] -> Gen DRep
forall a. HasCallStack => [Gen a] -> Gen a
oneof
      [ Credential DRepRole -> DRep
DRepCredential (Credential DRepRole -> DRep)
-> Gen (Credential DRepRole) -> Gen DRep
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Gen (Credential DRepRole)
forall a. Arbitrary a => Gen a
arbitrary
      , DRep -> Gen DRep
forall a. a -> Gen a
forall (f :: * -> *) a. Applicative f => a -> f a
pure DRep
DRepAlwaysAbstain
      , DRep -> Gen DRep
forall a. a -> Gen a
forall (f :: * -> *) a. Applicative f => a -> f a
pure DRep
DRepAlwaysNoConfidence
      ]

instance (Arbitrary a, HasZero a) => Arbitrary (BaseTypes.NonZero a) where
  arbitrary :: Gen (NonZero a)
arbitrary = Gen a
forall a. Arbitrary a => Gen a
arbitrary Gen a -> (a -> Maybe (NonZero a)) -> Gen (NonZero a)
forall a b. Gen a -> (a -> Maybe b) -> Gen b
`suchThatMap` a -> Maybe (NonZero a)
forall a. HasZero a => a -> Maybe (NonZero a)
BaseTypes.nonZero

-- | Either clamp requested size to the range of @[0, actualSize]@ or generate at random
-- in the same range when requested size is not supplied.
uniformSubSize ::
  StatefulGen g m =>
  -- | Requested size
  Maybe Int ->
  -- | Actual size
  Int ->
  g ->
  m Int
uniformSubSize :: forall g (m :: * -> *).
StatefulGen g m =>
Maybe Int -> Int -> g -> m Int
uniformSubSize Maybe Int
mReqSize Int
actualSize g
gen =
  case Maybe Int
mReqSize of
    Maybe Int
Nothing -> (Int, Int) -> g -> m Int
forall a g (m :: * -> *).
(UniformRange a, StatefulGen g m) =>
(a, a) -> g -> m a
forall g (m :: * -> *). StatefulGen g m => (Int, Int) -> g -> m Int
uniformRM (Int
0, Int
actualSize) g
gen
    Just Int
reqSize -> Int -> m Int
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Int -> m Int) -> Int -> m Int
forall a b. (a -> b) -> a -> b
$ Int -> Int -> Int
forall a. Ord a => a -> a -> a
max Int
0 (Int -> Int) -> Int -> Int
forall a b. (a -> b) -> a -> b
$ Int -> Int -> Int
forall a. Ord a => a -> a -> a
min Int
actualSize Int
reqSize

uniformSubSet ::
  (StatefulGen g m, Ord k) =>
  -- | Size of the subset. If supplied will be clamped to @[0, Set.size s]@ interval,
  -- otherwise will be generated randomly.
  Maybe Int ->
  Set k ->
  g ->
  m (Set k)
uniformSubSet :: forall g (m :: * -> *) k.
(StatefulGen g m, Ord k) =>
Maybe Int -> Set k -> g -> m (Set k)
uniformSubSet Maybe Int
mSubSetSize Set k
inputSet g
gen = do
  subSetSize <- Maybe Int -> Int -> g -> m Int
forall g (m :: * -> *).
StatefulGen g m =>
Maybe Int -> Int -> g -> m Int
uniformSubSize Maybe Int
mSubSetSize (Set k -> Int
forall a. Set a -> Int
Set.size Set k
inputSet) g
gen
  if subSetSize < Set.size inputSet `div` 2
    then
      goAdd inputSet Set.empty subSetSize
    else
      goDelete inputSet (Set.size inputSet - subSetSize)
  where
    -- Constructing a new Set is faster when less then a half of original Set will be used
    goAdd :: Set a -> Set a -> t -> f (Set a)
goAdd !Set a
s !Set a
acc !t
i
      | t
i t -> t -> Bool
forall a. Ord a => a -> a -> Bool
<= t
0 = Set a -> f (Set a)
forall a. a -> f a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Set a
acc
      | Bool
otherwise = do
          ix <- (Int, Int) -> g -> f Int
forall a g (m :: * -> *).
(UniformRange a, StatefulGen g m) =>
(a, a) -> g -> m a
forall g (m :: * -> *). StatefulGen g m => (Int, Int) -> g -> m Int
uniformRM (Int
0, Set a -> Int
forall a. Set a -> Int
Set.size Set a
s Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1) g
gen
          goAdd (Set.deleteAt ix s) (Set.insert (Set.elemAt ix s) acc) (i - 1)
    -- Deleting is faster when more items need to be retained in the Set
    goDelete :: Set a -> t -> f (Set a)
goDelete !Set a
acc !t
i
      | t
i t -> t -> Bool
forall a. Ord a => a -> a -> Bool
<= t
0 = Set a -> f (Set a)
forall a. a -> f a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Set a
acc
      | Bool
otherwise = do
          ix <- (Int, Int) -> g -> f Int
forall a g (m :: * -> *).
(UniformRange a, StatefulGen g m) =>
(a, a) -> g -> m a
forall g (m :: * -> *). StatefulGen g m => (Int, Int) -> g -> m Int
uniformRM (Int
0, Set a -> Int
forall a. Set a -> Int
Set.size Set a
acc Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1) g
gen
          goDelete (Set.deleteAt ix acc) (i - 1)

uniformSubMap ::
  (StatefulGen g m, Ord k) =>
  -- | Size of the subMap. If supplied will be clamped to @[0, Map.size s]@ interval,
  -- otherwise will be generated randomly.
  Maybe Int ->
  Map k v ->
  g ->
  m (Map k v)
uniformSubMap :: forall g (m :: * -> *) k v.
(StatefulGen g m, Ord k) =>
Maybe Int -> Map k v -> g -> m (Map k v)
uniformSubMap Maybe Int
mSubMapSize Map k v
inputMap g
gen = do
  subMapSize <- Maybe Int -> Int -> g -> m Int
forall g (m :: * -> *).
StatefulGen g m =>
Maybe Int -> Int -> g -> m Int
uniformSubSize Maybe Int
mSubMapSize (Map k v -> Int
forall k a. Map k a -> Int
Map.size Map k v
inputMap) g
gen
  if subMapSize < Map.size inputMap `div` 2
    then
      -- Constructing a new Map is faster when less then a half of original Map will be used
      uniformSubMapElems Map.insert (Just subMapSize) inputMap gen
    else
      -- Deleting is faster when more items need to be retained in the Map
      goDelete inputMap (Map.size inputMap - subMapSize)
  where
    goDelete :: Map k a -> t -> f (Map k a)
goDelete !Map k a
acc !t
i
      | t
i t -> t -> Bool
forall a. Ord a => a -> a -> Bool
<= t
0 = Map k a -> f (Map k a)
forall a. a -> f a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Map k a
acc
      | Bool
otherwise = do
          ix <- (Int, Int) -> g -> f Int
forall a g (m :: * -> *).
(UniformRange a, StatefulGen g m) =>
(a, a) -> g -> m a
forall g (m :: * -> *). StatefulGen g m => (Int, Int) -> g -> m Int
uniformRM (Int
0, Map k a -> Int
forall k a. Map k a -> Int
Map.size Map k a
acc Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1) g
gen
          goDelete (Map.deleteAt ix acc) (i - 1)

uniformSubMapElems ::
  (StatefulGen g m, Monoid f) =>
  (k -> v -> f -> f) ->
  -- | Size of the subMap. If supplied will be clamped to @[0, Map.size s]@ interval,
  -- otherwise will be generated randomly.
  Maybe Int ->
  Map k v ->
  g ->
  m f
uniformSubMapElems :: forall g (m :: * -> *) f k v.
(StatefulGen g m, Monoid f) =>
(k -> v -> f -> f) -> Maybe Int -> Map k v -> g -> m f
uniformSubMapElems k -> v -> f -> f
insert Maybe Int
mSubMapSize Map k v
inputMap g
gen = do
  subMapSize <- Maybe Int -> Int -> g -> m Int
forall g (m :: * -> *).
StatefulGen g m =>
Maybe Int -> Int -> g -> m Int
uniformSubSize Maybe Int
mSubMapSize (Map k v -> Int
forall k a. Map k a -> Int
Map.size Map k v
inputMap) g
gen
  go inputMap mempty subMapSize
  where
    go :: Map k v -> f -> t -> f f
go !Map k v
s !f
acc !t
i
      | t
i t -> t -> Bool
forall a. Ord a => a -> a -> Bool
<= t
0 = f -> f f
forall a. a -> f a
forall (f :: * -> *) a. Applicative f => a -> f a
pure f
acc
      | Bool
otherwise = do
          ix <- (Int, Int) -> g -> f Int
forall a g (m :: * -> *).
(UniformRange a, StatefulGen g m) =>
(a, a) -> g -> m a
forall g (m :: * -> *). StatefulGen g m => (Int, Int) -> g -> m Int
uniformRM (Int
0, Map k v -> Int
forall k a. Map k a -> Int
Map.size Map k v
s Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1) g
gen
          let (k, v) = Map.elemAt ix s
          go (Map.deleteAt ix s) (insert k v acc) (i - 1)

------------------------------------------------------------------------------------------
-- Cardano.Ledger.CertState -------------------------------------------------------------------
------------------------------------------------------------------------------------------

instance (Era era, Arbitrary (Accounts era)) => Arbitrary (DState era) where
  arbitrary :: Gen (DState era)
arbitrary = Accounts era
-> Map FutureGenDeleg GenDelegPair
-> GenDelegs
-> InstantaneousRewards
-> DState era
forall era.
Accounts era
-> Map FutureGenDeleg GenDelegPair
-> GenDelegs
-> InstantaneousRewards
-> DState era
DState (Accounts era
 -> Map FutureGenDeleg GenDelegPair
 -> GenDelegs
 -> InstantaneousRewards
 -> DState era)
-> Gen (Accounts era)
-> Gen
     (Map FutureGenDeleg GenDelegPair
      -> GenDelegs -> InstantaneousRewards -> DState era)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Gen (Accounts era)
forall a. Arbitrary a => Gen a
arbitrary Gen
  (Map FutureGenDeleg GenDelegPair
   -> GenDelegs -> InstantaneousRewards -> DState era)
-> Gen (Map FutureGenDeleg GenDelegPair)
-> Gen (GenDelegs -> InstantaneousRewards -> DState 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 FutureGenDeleg GenDelegPair)
forall a. Arbitrary a => Gen a
arbitrary Gen (GenDelegs -> InstantaneousRewards -> DState era)
-> Gen GenDelegs -> Gen (InstantaneousRewards -> DState 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 GenDelegs
forall a. Arbitrary a => Gen a
arbitrary Gen (InstantaneousRewards -> DState era)
-> Gen InstantaneousRewards -> Gen (DState 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 InstantaneousRewards
forall a. Arbitrary a => Gen a
arbitrary

instance Arbitrary (PState era) where
  arbitrary :: Gen (PState era)
arbitrary = Map (VRFVerKeyHash StakePoolVRF) (NonZero Word64)
-> Map (KeyHash StakePool) StakePoolState
-> Map (KeyHash StakePool) StakePoolParams
-> Map (KeyHash StakePool) EpochNo
-> PState era
forall era.
Map (VRFVerKeyHash StakePoolVRF) (NonZero Word64)
-> Map (KeyHash StakePool) StakePoolState
-> Map (KeyHash StakePool) StakePoolParams
-> Map (KeyHash StakePool) EpochNo
-> PState era
PState (Map (VRFVerKeyHash StakePoolVRF) (NonZero Word64)
 -> Map (KeyHash StakePool) StakePoolState
 -> Map (KeyHash StakePool) StakePoolParams
 -> Map (KeyHash StakePool) EpochNo
 -> PState era)
-> Gen (Map (VRFVerKeyHash StakePoolVRF) (NonZero Word64))
-> Gen
     (Map (KeyHash StakePool) StakePoolState
      -> Map (KeyHash StakePool) StakePoolParams
      -> Map (KeyHash StakePool) EpochNo
      -> PState era)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Gen (Map (VRFVerKeyHash StakePoolVRF) (NonZero Word64))
forall a. Arbitrary a => Gen a
arbitrary Gen
  (Map (KeyHash StakePool) StakePoolState
   -> Map (KeyHash StakePool) StakePoolParams
   -> Map (KeyHash StakePool) EpochNo
   -> PState era)
-> Gen (Map (KeyHash StakePool) StakePoolState)
-> Gen
     (Map (KeyHash StakePool) StakePoolParams
      -> Map (KeyHash StakePool) EpochNo -> PState 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 (KeyHash StakePool) StakePoolState)
forall a. Arbitrary a => Gen a
arbitrary Gen
  (Map (KeyHash StakePool) StakePoolParams
   -> Map (KeyHash StakePool) EpochNo -> PState era)
-> Gen (Map (KeyHash StakePool) StakePoolParams)
-> Gen (Map (KeyHash StakePool) EpochNo -> PState 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 (KeyHash StakePool) StakePoolParams)
forall a. Arbitrary a => Gen a
arbitrary Gen (Map (KeyHash StakePool) EpochNo -> PState era)
-> Gen (Map (KeyHash StakePool) EpochNo) -> Gen (PState 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 (KeyHash StakePool) EpochNo)
forall a. Arbitrary a => Gen a
arbitrary

instance Arbitrary Anchor where
  arbitrary :: Gen Anchor
arbitrary = Url -> SafeHash AnchorData -> Anchor
Anchor (Url -> SafeHash AnchorData -> Anchor)
-> Gen Url -> Gen (SafeHash AnchorData -> Anchor)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Gen Url
forall a. Arbitrary a => Gen a
arbitrary Gen (SafeHash AnchorData -> Anchor)
-> Gen (SafeHash AnchorData) -> Gen Anchor
forall a b. Gen (a -> b) -> Gen a -> Gen b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Gen (SafeHash AnchorData)
forall a. Arbitrary a => Gen a
arbitrary

instance Arbitrary a => Arbitrary (Mismatch r a) where
  arbitrary :: Gen (Mismatch r a)
arbitrary = a -> a -> Mismatch r a
forall (r :: Relation) a. a -> a -> Mismatch r a
Mismatch (a -> a -> Mismatch r a) -> Gen a -> Gen (a -> Mismatch r a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Gen a
forall a. Arbitrary a => Gen a
arbitrary Gen (a -> Mismatch r a) -> Gen a -> Gen (Mismatch r a)
forall a b. Gen (a -> b) -> Gen a -> Gen b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Gen a
forall a. Arbitrary a => Gen a
arbitrary

instance Arbitrary CommitteeAuthorization where
  arbitrary :: Gen CommitteeAuthorization
arbitrary =
    [Gen CommitteeAuthorization] -> Gen CommitteeAuthorization
forall a. HasCallStack => [Gen a] -> Gen a
oneof
      [ Credential HotCommitteeRole -> CommitteeAuthorization
CommitteeHotCredential (Credential HotCommitteeRole -> CommitteeAuthorization)
-> Gen (Credential HotCommitteeRole) -> Gen CommitteeAuthorization
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Gen (Credential HotCommitteeRole)
forall a. Arbitrary a => Gen a
arbitrary
      , StrictMaybe Anchor -> CommitteeAuthorization
CommitteeMemberResigned (StrictMaybe Anchor -> CommitteeAuthorization)
-> Gen (StrictMaybe Anchor) -> Gen CommitteeAuthorization
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Gen (StrictMaybe Anchor)
forall a. Arbitrary a => Gen a
arbitrary
      ]

deriving instance Arbitrary (CommitteeState era)

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

instance Arbitrary FutureGenDeleg where
  arbitrary :: Gen FutureGenDeleg
arbitrary = SlotNo -> KeyHash GenesisRole -> FutureGenDeleg
FutureGenDeleg (SlotNo -> KeyHash GenesisRole -> FutureGenDeleg)
-> Gen SlotNo -> Gen (KeyHash GenesisRole -> FutureGenDeleg)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Gen SlotNo
forall a. Arbitrary a => Gen a
arbitrary Gen (KeyHash GenesisRole -> FutureGenDeleg)
-> Gen (KeyHash GenesisRole) -> Gen FutureGenDeleg
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 GenesisRole)
forall a. Arbitrary a => Gen a
arbitrary
  shrink :: FutureGenDeleg -> [FutureGenDeleg]
shrink = FutureGenDeleg -> [FutureGenDeleg]
forall a.
(Generic a, RecursivelyShrink (Rep a), GSubterms (Rep a) a) =>
a -> [a]
genericShrink

------------------------------------------------------------------------------------------
-- Cardano.Ledger.EpochBoundary ----------------------------------------------------------
------------------------------------------------------------------------------------------

instance Arbitrary SnapShot where
  arbitrary :: Gen SnapShot
arbitrary =
    Stake
-> VMap VB VB (Credential Staking) (KeyHash StakePool)
-> VMap VB VB (KeyHash StakePool) StakePoolParams
-> SnapShot
SnapShot
      (Stake
 -> VMap VB VB (Credential Staking) (KeyHash StakePool)
 -> VMap VB VB (KeyHash StakePool) StakePoolParams
 -> SnapShot)
-> Gen Stake
-> Gen
     (VMap VB VB (Credential Staking) (KeyHash StakePool)
      -> VMap VB VB (KeyHash StakePool) StakePoolParams -> SnapShot)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Gen Stake
forall a. Arbitrary a => Gen a
arbitrary
      Gen
  (VMap VB VB (Credential Staking) (KeyHash StakePool)
   -> VMap VB VB (KeyHash StakePool) StakePoolParams -> SnapShot)
-> Gen (VMap VB VB (Credential Staking) (KeyHash StakePool))
-> Gen (VMap VB VB (KeyHash StakePool) StakePoolParams -> SnapShot)
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 VB (Credential Staking) (KeyHash StakePool))
forall a. Arbitrary a => Gen a
arbitrary
      Gen (VMap VB VB (KeyHash StakePool) StakePoolParams -> SnapShot)
-> Gen (VMap VB VB (KeyHash StakePool) StakePoolParams)
-> Gen SnapShot
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 VB (KeyHash StakePool) StakePoolParams)
forall a. Arbitrary a => Gen a
arbitrary

instance Arbitrary SnapShots where
  arbitrary :: Gen SnapShots
arbitrary = do
    ssStakeMark <- Gen SnapShot
forall a. Arbitrary a => Gen a
arbitrary
    ssStakeSet <- arbitrary
    ssStakeGo <- arbitrary
    ssFee <- arbitrary
    let ssStakeMarkPoolDistr = SnapShot -> PoolDistr
calculatePoolDistr SnapShot
ssStakeMark
    pure $ SnapShots {..}

-- | In the system, Stake never contains more than the sum of all Ada (which is constant).
-- This makes it safe to store individual Coins (in CompactForm) as Word64. But we must
-- be careful that we never generate Stake where the sum of all the coins exceeds (maxBound :: Word64)
-- There will never be a real Stake in the system with that many Ada, because total Ada is constant.
-- So using a restricted Arbitrary Generator is OK.
instance Arbitrary Stake where
  arbitrary :: Gen Stake
arbitrary = VMap VB VP (Credential Staking) (CompactForm Coin) -> Stake
Stake (VMap VB VP (Credential Staking) (CompactForm Coin) -> Stake)
-> Gen (VMap VB VP (Credential Staking) (CompactForm Coin))
-> Gen Stake
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Map (Credential Staking) (CompactForm Coin)
-> VMap VB VP (Credential Staking) (CompactForm Coin)
forall (kv :: * -> *) k (vv :: * -> *) v.
(Vector kv k, Vector vv v) =>
Map k v -> VMap kv vv k v
VMap.fromMap (Map (Credential Staking) (CompactForm Coin)
 -> VMap VB VP (Credential Staking) (CompactForm Coin))
-> Gen (Map (Credential Staking) (CompactForm Coin))
-> Gen (VMap VB VP (Credential Staking) (CompactForm Coin))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Gen (Map (Credential Staking) (CompactForm Coin))
theMap)
    where
      genWord64 :: Int -> Gen Word64
      genWord64 :: Int -> Gen Word64
genWord64 Int
n =
        [(Int, Gen Word64)] -> Gen Word64
forall a. HasCallStack => [(Int, Gen a)] -> Gen a
frequency
          [ (Int
3, (Word64, Word64) -> Gen Word64
forall a. Random a => (a, a) -> Gen a
choose (Word64
1, Word64
100))
          , (Int
2, (Word64, Word64) -> Gen Word64
forall a. Random a => (a, a) -> Gen a
choose (Word64
101, Word64
10000))
          , (Int
1, (Word64, Word64) -> Gen Word64
forall a. Random a => (a, a) -> Gen a
choose (Word64
1, Word64
forall a. Bounded a => a
maxBound Word64 -> Word64 -> Word64
forall a. Integral a => a -> a -> a
`div` Int -> Word64
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
n))
          ]
      theMap :: Gen (Map (Credential Staking) (CompactForm Coin))
theMap = do
        n <- [(Int, Gen Int)] -> Gen Int
forall a. HasCallStack => [(Int, Gen a)] -> Gen a
frequency [(Int
3, (Int, Int) -> Gen Int
chooseInt (Int
1, Int
20)), (Int
2, (Int, Int) -> Gen Int
chooseInt (Int
21, Int
150)), (Int
1, (Int, Int) -> Gen Int
chooseInt (Int
151, Int
1000))]
        let pair = (,) (Credential Staking
 -> CompactForm Coin -> (Credential Staking, CompactForm Coin))
-> Gen (Credential Staking)
-> Gen (CompactForm Coin -> (Credential Staking, CompactForm Coin))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Gen (Credential Staking)
forall a. Arbitrary a => Gen a
arbitrary Gen (CompactForm Coin -> (Credential Staking, CompactForm Coin))
-> Gen (CompactForm Coin)
-> Gen (Credential Staking, CompactForm Coin)
forall a b. Gen (a -> b) -> Gen a -> Gen b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Word64 -> CompactForm Coin
CompactCoin (Word64 -> CompactForm Coin)
-> Gen Word64 -> Gen (CompactForm Coin)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Int -> Gen Word64
genWord64 Int
n)
        list <- frequency [(1, pure []), (99, vectorOf n pair)]
        pure (Map.fromList list)

------------------------------------------------------------------------------------------
-- Cardano.Ledger.Core.TxCert ----------------------------------------------------------
------------------------------------------------------------------------------------------

instance Arbitrary PoolCert where
  arbitrary :: Gen PoolCert
arbitrary =
    [Gen PoolCert] -> Gen PoolCert
forall a. HasCallStack => [Gen a] -> Gen a
oneof
      [ StakePoolParams -> PoolCert
RegPool (StakePoolParams -> PoolCert)
-> Gen StakePoolParams -> Gen PoolCert
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Gen StakePoolParams
forall a. Arbitrary a => Gen a
arbitrary
      , KeyHash StakePool -> EpochNo -> PoolCert
RetirePool (KeyHash StakePool -> EpochNo -> PoolCert)
-> Gen (KeyHash StakePool) -> Gen (EpochNo -> PoolCert)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Gen (KeyHash StakePool)
forall a. Arbitrary a => Gen a
arbitrary Gen (EpochNo -> PoolCert) -> Gen EpochNo -> Gen PoolCert
forall a b. Gen (a -> b) -> Gen a -> Gen b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Gen EpochNo
forall a. Arbitrary a => Gen a
arbitrary
      ]
  shrink :: PoolCert -> [PoolCert]
shrink = PoolCert -> [PoolCert]
forall a.
(Generic a, RecursivelyShrink (Rep a), GSubterms (Rep a) a) =>
a -> [a]
genericShrink

------------------------------------------------------------------------------------------
-- Cardano.Ledger.Plutus ----------------------------------------------------------
------------------------------------------------------------------------------------------

instance Arbitrary Language where
  arbitrary :: Gen Language
arbitrary = [Language] -> Gen Language
forall a. HasCallStack => [a] -> Gen a
elements [Language]
nonNativeLanguages

instance Arbitrary ExUnits where
  arbitrary :: Gen ExUnits
arbitrary = Natural -> Natural -> ExUnits
ExUnits (Natural -> Natural -> ExUnits)
-> Gen Natural -> Gen (Natural -> ExUnits)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Gen Natural
genUnit Gen (Natural -> ExUnits) -> Gen Natural -> Gen ExUnits
forall a b. Gen (a -> b) -> Gen a -> Gen b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Gen Natural
genUnit
    where
      genUnit :: Gen Natural
genUnit = Int64 -> Natural
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int64 -> Natural) -> Gen Int64 -> Gen Natural
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Int64, Int64) -> Gen Int64
forall a. Random a => (a, a) -> Gen a
choose (Int64
0, Int64
forall a. Bounded a => a
maxBound :: Int64)

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

instance Arbitrary CostModel where
  arbitrary :: Gen CostModel
arbitrary = [Language] -> Gen Language
forall a. HasCallStack => [a] -> Gen a
elements [Language]
nonNativeLanguages Gen Language -> (Language -> Gen CostModel) -> Gen CostModel
forall a b. Gen a -> (a -> Gen b) -> Gen b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Language -> Gen CostModel
genValidCostModel

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

instance Era era => Arbitrary (BinaryData era) where
  arbitrary :: Gen (BinaryData era)
arbitrary = Data era -> BinaryData era
forall era. Data era -> BinaryData era
dataToBinaryData (Data era -> BinaryData era)
-> Gen (Data era) -> Gen (BinaryData era)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Gen (Data era)
forall a. Arbitrary a => Gen a
arbitrary

instance Era era => Arbitrary (Datum era) where
  arbitrary :: Gen (Datum era)
arbitrary =
    [Gen (Datum era)] -> Gen (Datum era)
forall a. HasCallStack => [Gen a] -> Gen a
oneof
      [ Datum era -> Gen (Datum era)
forall a. a -> Gen a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Datum era
forall era. Datum era
NoDatum
      , DataHash -> Datum era
forall era. DataHash -> Datum era
DatumHash (DataHash -> Datum era) -> Gen DataHash -> Gen (Datum era)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Gen DataHash
forall a. Arbitrary a => Gen a
arbitrary
      , BinaryData era -> Datum era
forall era. BinaryData era -> Datum era
Datum (BinaryData era -> Datum era)
-> (Data era -> BinaryData era) -> Data era -> Datum era
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Data era -> BinaryData era
forall era. Data era -> BinaryData era
dataToBinaryData (Data era -> Datum era) -> Gen (Data era) -> Gen (Datum era)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Gen (Data era)
forall a. Arbitrary a => Gen a
arbitrary
      ]

instance Arbitrary PV1.Data where
  arbitrary :: Gen Data
arbitrary = Int -> Gen Data -> Gen Data
forall a. HasCallStack => Int -> Gen a -> Gen a
resize Int
5 ((Int -> Gen Data) -> Gen Data
forall a. (Int -> Gen a) -> Gen a
sized Int -> Gen Data
forall {t}. Integral t => t -> Gen Data
genData)
    where
      genData :: t -> Gen Data
genData t
n
        | t
n t -> t -> Bool
forall a. Ord a => a -> a -> Bool
> t
0 =
            [Gen Data] -> Gen Data
forall a. HasCallStack => [Gen a] -> Gen a
oneof
              [ Integer -> Data
PV1.I (Integer -> Data) -> Gen Integer -> Gen Data
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Gen Integer
forall a. Arbitrary a => Gen a
arbitrary
              , ByteString -> Data
PV1.B (ByteString -> Data) -> Gen ByteString -> Gen Data
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Gen ByteString
forall a. Arbitrary a => Gen a
arbitrary
              , [(Data, Data)] -> Data
PV1.Map ([(Data, Data)] -> Data) -> Gen [(Data, Data)] -> Gen Data
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Gen (Data, Data) -> Gen [(Data, Data)]
forall a. Gen a -> Gen [a]
listOf ((,) (Data -> Data -> (Data, Data))
-> Gen Data -> Gen (Data -> (Data, Data))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> t -> Gen Data
genData (t
n t -> t -> t
forall a. Integral a => a -> a -> a
`div` t
2) Gen (Data -> (Data, Data)) -> Gen Data -> Gen (Data, Data)
forall a b. Gen (a -> b) -> Gen a -> Gen b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> t -> Gen Data
genData (t
n t -> t -> t
forall a. Integral a => a -> a -> a
`div` t
2))
              , Integer -> [Data] -> Data
PV1.Constr
                  (Integer -> [Data] -> Data) -> Gen Integer -> Gen ([Data] -> Data)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Natural -> Integer) -> Gen Natural -> Gen Integer
forall a b. (a -> b) -> Gen a -> Gen b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Natural -> Integer
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Gen Natural
forall a. Arbitrary a => Gen a
arbitrary :: Gen Natural)
                  Gen ([Data] -> Data) -> Gen [Data] -> Gen Data
forall a b. Gen (a -> b) -> Gen a -> Gen b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Gen Data -> Gen [Data]
forall a. Gen a -> Gen [a]
listOf (t -> Gen Data
genData (t
n t -> t -> t
forall a. Integral a => a -> a -> a
`div` t
2))
              , [Data] -> Data
PV1.List ([Data] -> Data) -> Gen [Data] -> Gen Data
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Gen Data -> Gen [Data]
forall a. Gen a -> Gen [a]
listOf (t -> Gen Data
genData (t
n t -> t -> t
forall a. Integral a => a -> a -> a
`div` t
2))
              ]
        | Bool
otherwise = [Gen Data] -> Gen Data
forall a. HasCallStack => [Gen a] -> Gen a
oneof [Integer -> Data
PV1.I (Integer -> Data) -> Gen Integer -> Gen Data
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Gen Integer
forall a. Arbitrary a => Gen a
arbitrary, ByteString -> Data
PV1.B (ByteString -> Data) -> Gen ByteString -> Gen Data
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Gen ByteString
forall a. Arbitrary a => Gen a
arbitrary]

instance Arbitrary PV1.ExBudget where
  arbitrary :: Gen ExBudget
arbitrary = ExCPU -> ExMemory -> ExBudget
PV1.ExBudget (ExCPU -> ExMemory -> ExBudget)
-> Gen ExCPU -> Gen (ExMemory -> ExBudget)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Gen ExCPU
forall a. Arbitrary a => Gen a
arbitrary Gen (ExMemory -> ExBudget) -> Gen ExMemory -> Gen ExBudget
forall a b. Gen (a -> b) -> Gen a -> Gen b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Gen ExMemory
forall a. Arbitrary a => Gen a
arbitrary

instance Arbitrary PV1.ExCPU where
  arbitrary :: Gen ExCPU
arbitrary = Integer -> ExCPU
forall a. Num a => Integer -> a
fromInteger (Integer -> ExCPU)
-> (NonNegative Integer -> Integer) -> NonNegative Integer -> ExCPU
forall b c a. (b -> c) -> (a -> b) -> a -> c
. NonNegative Integer -> Integer
forall a. NonNegative a -> a
getNonNegative (NonNegative Integer -> ExCPU)
-> Gen (NonNegative Integer) -> Gen ExCPU
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Gen (NonNegative Integer)
forall a. Arbitrary a => Gen a
arbitrary

instance Arbitrary PV1.ExMemory where
  arbitrary :: Gen ExMemory
arbitrary = Integer -> ExMemory
forall a. Num a => Integer -> a
fromInteger (Integer -> ExMemory)
-> (NonNegative Integer -> Integer)
-> NonNegative Integer
-> ExMemory
forall b c a. (b -> c) -> (a -> b) -> a -> c
. NonNegative Integer -> Integer
forall a. NonNegative a -> a
getNonNegative (NonNegative Integer -> ExMemory)
-> Gen (NonNegative Integer) -> Gen ExMemory
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Gen (NonNegative Integer)
forall a. Arbitrary a => Gen a
arbitrary

genValidCostModel :: Language -> Gen CostModel
genValidCostModel :: Language -> Gen CostModel
genValidCostModel Language
lang = do
  newParamValues <- Int -> Gen Int64 -> Gen [Int64]
forall a. Int -> Gen a -> Gen [a]
vectorOf (Language -> Int
costModelInitParamCount Language
lang) Gen Int64
forall a. Arbitrary a => Gen a
arbitrary
  either (\CostModelApplyError
err -> [Char] -> Gen CostModel
forall a. HasCallStack => [Char] -> a
error ([Char] -> Gen CostModel) -> [Char] -> Gen CostModel
forall a b. (a -> b) -> a -> b
$ [Char]
"Corrupt cost model: " [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ CostModelApplyError -> [Char]
forall a. Show a => a -> [Char]
show CostModelApplyError
err) pure $
    mkCostModel lang newParamValues

genValidCostModels :: Set.Set Language -> Gen CostModels
genValidCostModels :: Set Language -> Gen CostModels
genValidCostModels = (Map Language CostModel -> CostModels)
-> Gen (Map Language CostModel) -> Gen CostModels
forall a b. (a -> b) -> Gen a -> Gen b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Map Language CostModel -> CostModels
mkCostModels (Gen (Map Language CostModel) -> Gen CostModels)
-> (Set Language -> Gen (Map Language CostModel))
-> Set Language
-> Gen CostModels
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Map Language (Gen CostModel) -> Gen (Map Language CostModel)
forall (t :: * -> *) (m :: * -> *) a.
(Traversable t, Monad m) =>
t (m a) -> m (t a)
forall (m :: * -> *) a.
Monad m =>
Map Language (m a) -> m (Map Language a)
sequence (Map Language (Gen CostModel) -> Gen (Map Language CostModel))
-> (Set Language -> Map Language (Gen CostModel))
-> Set Language
-> Gen (Map Language CostModel)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Language -> Gen CostModel)
-> Set Language -> Map Language (Gen CostModel)
forall k a. (k -> a) -> Set k -> Map k a
Map.fromSet Language -> Gen CostModel
genValidCostModel

genValidAndUnknownCostModels :: Gen CostModels
genValidAndUnknownCostModels :: Gen CostModels
genValidAndUnknownCostModels = do
  langs <- [Language] -> Gen [Language]
forall a. [a] -> Gen [a]
sublistOf [Language]
nonNativeLanguages
  validCms <- genValidCostModels $ Set.fromList langs
  unknownCms <- errorFail . mkCostModelsLenient <$> genUnknownCostModels
  pure $ updateCostModels validCms unknownCms

-- | This Arbitrary instance assumes the inflexible deserialization
-- scheme prior to version 9.
instance Arbitrary CostModels where
  arbitrary :: Gen CostModels
arbitrary = do
    known <- Gen (Map Word8 [Int64])
genKnownCostModels
    unknown <- genUnknownCostModels
    let cms = Map Word8 [Int64]
known Map Word8 [Int64] -> Map Word8 [Int64] -> Map Word8 [Int64]
forall k a. Ord k => Map k a -> Map k a -> Map k a
`Map.union` Map Word8 [Int64]
unknown
    pure . errorFail $ mkCostModelsLenient cms

genUnknownCostModels :: Gen (Map Word8 [Int64])
genUnknownCostModels :: Gen (Map Word8 [Int64])
genUnknownCostModels = [(Word8, [Int64])] -> Map Word8 [Int64]
forall k a. Ord k => [(k, a)] -> Map k a
Map.fromList ([(Word8, [Int64])] -> Map Word8 [Int64])
-> Gen [(Word8, [Int64])] -> Gen (Map Word8 [Int64])
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Gen (Word8, [Int64]) -> Gen [(Word8, [Int64])]
forall a. Gen a -> Gen [a]
listOf Gen (Word8, [Int64])
genUnknownCostModelValues

genKnownCostModels :: Gen (Map Word8 [Int64])
genKnownCostModels :: Gen (Map Word8 [Int64])
genKnownCostModels = do
  langs <- [Language] -> Gen [Language]
forall a. [a] -> Gen [a]
sublistOf [Language]
nonNativeLanguages
  cms <- mapM genCostModelValues langs
  return $ Map.fromList cms

genUnknownCostModelValues :: Gen (Word8, [Int64])
genUnknownCostModelValues :: Gen (Word8, [Int64])
genUnknownCostModelValues = do
  lang <- (Int, Int) -> Gen Int
chooseInt (Int
firstInvalid, Word8 -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Word8
forall a. Bounded a => a
maxBound :: Word8))
  vs <- arbitrary
  return (fromIntegral . fromEnum $ lang, vs)
  where
    firstInvalid :: Int
firstInvalid = Language -> Int
forall a. Enum a => a -> Int
fromEnum (Language
forall a. Bounded a => a
maxBound :: Language) Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1

genCostModelValues :: Language -> Gen (Word8, [Int64])
genCostModelValues :: Language -> Gen (Word8, [Int64])
genCostModelValues Language
lang = do
  Positive sub <- Gen (Positive Int)
forall a. Arbitrary a => Gen a
arbitrary
  (,) langWord8
    <$> oneof
      [ listAtLeast (costModelInitParamCount lang) -- Valid Cost Model for known language
      , take (tooFew sub) <$> arbitrary -- Invalid Cost Model for known language
      ]
  where
    langWord8 :: Word8
langWord8 = Int -> Word8
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Language -> Int
forall a. Enum a => a -> Int
fromEnum Language
lang)
    tooFew :: Int -> Int
tooFew Int
sub = Language -> Int
costModelInitParamCount Language
lang Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
sub
    listAtLeast :: Int -> Gen [Int64]
    listAtLeast :: Int -> Gen [Int64]
listAtLeast Int
x = do
      NonNegative y <- Gen (NonNegative Int)
forall a. Arbitrary a => Gen a
arbitrary
      replicateM (x + y) arbitrary

instance Arbitrary (NoGenesis era) where
  arbitrary :: Gen (NoGenesis era)
arbitrary = NoGenesis era -> Gen (NoGenesis era)
forall a. a -> Gen a
forall (f :: * -> *) a. Applicative f => a -> f a
pure NoGenesis era
forall era. NoGenesis era
NoGenesis

genericShrinkMemo ::
  forall era a.
  ( Era era
  , EncCBOR (RawType (a era))
  , Memoized (a era)
  , Generic (RawType (a era))
  , RecursivelyShrink (Rep (RawType (a era)))
  , GSubterms (Rep (RawType (a era))) (RawType (a era))
  ) =>
  a era -> [a era]
genericShrinkMemo :: forall era (a :: * -> *).
(Era era, EncCBOR (RawType (a era)), Memoized (a era),
 Generic (RawType (a era)),
 RecursivelyShrink (Rep (RawType (a era))),
 GSubterms (Rep (RawType (a era))) (RawType (a era))) =>
a era -> [a era]
genericShrinkMemo = (RawType (a era) -> a era) -> [RawType (a era)] -> [a era]
forall a b. (a -> b) -> [a] -> [b]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (forall era t.
(Era era, EncCBOR (RawType t), Memoized t) =>
RawType t -> t
mkMemoizedEra @era) ([RawType (a era)] -> [a era])
-> (a era -> [RawType (a era)]) -> a era -> [a era]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. RawType (a era) -> [RawType (a era)]
forall a.
(Generic a, RecursivelyShrink (Rep a), GSubterms (Rep a) a) =>
a -> [a]
genericShrink (RawType (a era) -> [RawType (a era)])
-> (a era -> RawType (a era)) -> a era -> [RawType (a era)]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a era -> RawType (a era)
forall t. Memoized t => t -> RawType t
getMemoRawType