{-# 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,
  genAddrBadPtr,
  genCompactAddrBadPtr,
  genBadPtr,
  genValidUMap,
  genValidUMapNonEmpty,
  genValidUMapWithCreds,
  genValidTuples,
  genValidTuplesNonEmpty,
  genInvariantNonEmpty,
  genRightPreferenceUMap,
  genInsertDeleteRoundtripRDPair,
  genInsertDeleteRoundtripPtr,
  genInsertDeleteRoundtripSPool,
  genInsertDeleteRoundtripDRep,

  -- * 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.DSIGN.Class (DSIGNAlgorithm)
import Cardano.Crypto.Hash.Class
import Cardano.Ledger.Address
import Cardano.Ledger.AuxiliaryData (AuxiliaryDataHash (..))
import Cardano.Ledger.BaseTypes (
  ActiveSlotCoeff,
  BlocksMade (..),
  CertIx (..),
  DnsName,
  EpochInterval (..),
  Mismatch (..),
  Network (..),
  NonNegativeInterval,
  Nonce (..),
  Port (..),
  PositiveInterval,
  PositiveUnitInterval,
  ProtVer (..),
  SlotNo (..),
  StrictMaybe,
  TxIx (..),
  UnitInterval,
  Url,
  mkActiveSlotCoeff,
  mkCertIxPartial,
  mkNonceFromNumber,
  mkTxIxPartial,
  natVersion,
  promoteRatio,
  textToDns,
  textToUrl,
 )
import Cardano.Ledger.Binary (EncCBOR, Sized, mkSized)
import Cardano.Ledger.CertState (
  Anchor (..),
  CertState (..),
  CommitteeAuthorization (..),
  CommitteeState (..),
  DState (..),
  FutureGenDeleg (..),
  InstantaneousRewards (..),
  PState (..),
  VState (..),
 )
import Cardano.Ledger.Coin (Coin (..), CompactForm (..), DeltaCoin (..))
import Cardano.Ledger.Core
import Cardano.Ledger.Credential (Credential (..), Ptr (..), StakeReference (..))
import Cardano.Ledger.Crypto (Crypto (DSIGN), StandardCrypto)
import Cardano.Ledger.DRep (DRep (..), DRepState (..))
import Cardano.Ledger.EpochBoundary
import Cardano.Ledger.HKD (NoUpdate (..))
import Cardano.Ledger.Keys (
  GenDelegPair (..),
  GenDelegs (..),
  KeyHash (..),
  KeyRole (StakePool, Staking),
  VKey (..),
 )
import Cardano.Ledger.Keys.Bootstrap (BootstrapWitness (..), ChainCode (..))
import Cardano.Ledger.Keys.WitVKey (WitVKey (..))
import Cardano.Ledger.Plutus.CostModels (
  CostModel,
  CostModels,
  costModelParamsCount,
  mkCostModel,
  mkCostModels,
  mkCostModelsLenient,
  updateCostModels,
 )
import Cardano.Ledger.Plutus.ExUnits (ExUnits (..), Prices (..))
import Cardano.Ledger.Plutus.Language (
  Language (..),
  nonNativeLanguages,
 )
import Cardano.Ledger.PoolDistr (IndividualPoolStake (..), PoolDistr (..))
import Cardano.Ledger.PoolParams (
  PoolMetadata (..),
  PoolParams (..),
  SizeOfPoolOwners (..),
  SizeOfPoolRelays (..),
  StakePoolRelay (..),
 )
import Cardano.Ledger.SafeHash (SafeHash, unsafeMakeSafeHash)
import Cardano.Ledger.TxIn (TxId (..), TxIn (..))
import Cardano.Ledger.UMap (
  RDPair (..),
  UMElem (UMElem),
  UMap (UMap, umElems, umPtrs),
  UView (RewDepUView),
  unUnify,
  unify,
 )
import Cardano.Ledger.UTxO (UTxO (..))
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, Word32, Word64, Word8)
import GHC.Stack
import Generic.Random (genericArbitraryU)
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.Binary.Random (QC (..))
import Test.Cardano.Ledger.Core.Utils (unsafeBoundRational)
import Test.QuickCheck
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 = forall a. EncCBOR a => Version -> a -> Sized a
mkSized (forall era. Era era => Version
eraProtVerHigh @era) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall a. Arbitrary a => Gen a
arbitrary

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

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

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

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

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

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

genDnsName :: Int -> Gen T.Text
genDnsName :: Int -> Gen Text
genDnsName Int
n = do
  [Char]
str <- forall a. Int -> Gen a -> Gen [a]
vectorOf (Int
n forall a. Num a => a -> a -> a
- Int
4) forall a b. (a -> b) -> a -> b
$ forall a. HasCallStack => [a] -> Gen a
elements forall a b. (a -> b) -> a -> b
$ Char
'.' forall a. a -> [a] -> [a]
: Char
'-' forall a. a -> [a] -> [a]
: [Char
'A' .. Char
'Z'] forall a. [a] -> [a] -> [a]
++ [Char
'a' .. Char
'z'] forall a. [a] -> [a] -> [a]
++ [Char
'0' .. Char
'9']
  forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ [Char] -> Text
T.pack [Char]
str forall a. Semigroup a => a -> a -> a
<> Text
".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 -> forall a. HasCallStack => [Char] -> a
error forall a b. (a -> b) -> a -> b
$ [Char]
"Unexpected! Generated length: (" forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> [Char]
show Int
n forall a. [a] -> [a] -> [a]
++ [Char]
") " forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> [Char]
show Text
txt
  Just a
t -> a
t

instance Arbitrary DnsName where
  arbitrary :: Gen DnsName
arbitrary = do
    Int
n <- (Int, Int) -> Gen Int
chooseInt (Int
5, Int
64)
    Text
txt <- Int -> Gen Text
genDnsName Int
n
    forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$! forall a. HasCallStack => Int -> Text -> Maybe a -> a
guardLength Int
n Text
txt forall a b. (a -> b) -> a -> b
$ forall (m :: * -> *). MonadFail m => Int -> Text -> m DnsName
textToDns Int
64 Text
txt

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

instance Arbitrary Port where
  arbitrary :: Gen Port
arbitrary = forall a b. (Integral a, Num b) => a -> b
fromIntegral @Word16 @Port forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> 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
    Int
p <- (Int, Int) -> Gen Int
chooseInt (Int
0, Int
maxDecimalsWord64)
    let y :: Word64
y = Word64
10 forall a b. (Num a, Integral b) => a -> b -> a
^ Int
p :: Word64
    Word64
x <- forall a. Random a => (a, a) -> Gen a
choose (Word64
0, Word64
y)
    forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ forall r.
(HasCallStack, Typeable r, BoundedRational r) =>
Rational -> r
unsafeBoundRational forall a b. (a -> b) -> a -> b
$ forall a. Integral a => Ratio a -> Rational
promoteRatio (Word64
x forall a. Integral a => a -> a -> Ratio a
% Word64
y)

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

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

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

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

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

instance GenValid UnitInterval where
  genValid :: Gen UnitInterval
genValid = do
    Word64
x :: Word64 <- forall a. GenValid a => Gen a
genValid
    Positive (Word64
y :: Word64) <- forall a. Arbitrary a => Gen a
arbitrary
    forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ forall r.
(HasCallStack, Typeable r, BoundedRational r) =>
Rational -> r
unsafeBoundRational forall a b. (a -> b) -> a -> b
$ forall a. Integral a => Ratio a -> Rational
promoteRatio (if Word64
x forall a. Ord a => a -> a -> Bool
> Word64
y then Word64
y forall a. Integral a => a -> a -> Ratio a
% Word64
x else Word64
x forall a. Integral a => a -> a -> Ratio a
% Word64
y)
  shrinkValid :: UnitInterval -> [UnitInterval]
shrinkValid UnitInterval
_ = []

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

instance GenValid PositiveUnitInterval where
  genValid :: Gen PositiveUnitInterval
genValid = do
    Positive (Word64
x :: Word64) <- forall a. Arbitrary a => Gen a
arbitrary
    Positive (Word64
y :: Word64) <- forall a. Arbitrary a => Gen a
arbitrary
    forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ forall r.
(HasCallStack, Typeable r, BoundedRational r) =>
Rational -> r
unsafeBoundRational forall a b. (a -> b) -> a -> b
$ forall a. Integral a => Ratio a -> Rational
promoteRatio (if Word64
x forall a. Ord a => a -> a -> Bool
> Word64
y then Word64
y forall a. Integral a => a -> a -> Ratio a
% Word64
x else Word64
x forall a. Integral a => a -> a -> Ratio a
% Word64
y)
  shrinkValid :: PositiveUnitInterval -> [PositiveUnitInterval]
shrinkValid PositiveUnitInterval
_ = []

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

instance GenValid PositiveInterval where
  genValid :: Gen PositiveInterval
genValid = do
    Positive (Word64
x :: Word64) <- forall a. Arbitrary a => Gen a
arbitrary
    Positive (Word64
y :: Word64) <- forall a. Arbitrary a => Gen a
arbitrary
    forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ forall r.
(HasCallStack, Typeable r, BoundedRational r) =>
Rational -> r
unsafeBoundRational forall a b. (a -> b) -> a -> b
$ forall a. Integral a => Ratio a -> Rational
promoteRatio (Word64
x forall a. Integral a => a -> a -> Ratio a
% Word64
y)
  shrinkValid :: PositiveInterval -> [PositiveInterval]
shrinkValid PositiveInterval
_ = []

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

instance GenValid NonNegativeInterval where
  genValid :: Gen NonNegativeInterval
genValid = do
    Word64
x :: Word64 <- forall a. GenValid a => Gen a
genValid
    Positive (Word64
y :: Word64) <- forall a. Arbitrary a => Gen a
arbitrary
    forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ forall r.
(HasCallStack, Typeable r, BoundedRational r) =>
Rational -> r
unsafeBoundRational forall a b. (a -> b) -> a -> b
$ forall a. Integral a => Ratio a -> Rational
promoteRatio (Word64
x forall a. Integral a => a -> a -> Ratio a
% Word64
y)
  shrinkValid :: NonNegativeInterval -> [NonNegativeInterval]
shrinkValid NonNegativeInterval
_ = []

instance Arbitrary TxIx where
  -- starting with Conway, we only deserialize TxIx within Word16 range
  arbitrary :: Gen TxIx
arbitrary = Word64 -> TxIx
TxIx forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (Integral a, Num b) => a -> b
fromIntegral 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 = Word64 -> CertIx
CertIx forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (Integral a, Num b) => a -> b
fromIntegral 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 -> Nat -> ProtVer
ProtVer 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 Arbitrary Nonce where
  arbitrary :: Gen Nonce
arbitrary =
    forall a. HasCallStack => [Gen a] -> Gen a
oneof
      [ forall (m :: * -> *) a. Monad m => a -> m a
return Nonce
NeutralNonce
      , Word64 -> Nonce
mkNonceFromNumber forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall a. Arbitrary a => Gen a
arbitrary
      ]

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

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

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

instance Crypto c => Arbitrary (TxIn c) where
  arbitrary :: Gen (TxIn c)
arbitrary = forall c. TxId c -> TxIx -> TxIn c
TxIn 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

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

instance Arbitrary Ptr where
  arbitrary :: Gen Ptr
arbitrary = Gen Ptr
genValidPtr

-- | Generate a Ptr that contains values that are allowed on the wire
genValidPtr :: Gen Ptr
genValidPtr :: Gen Ptr
genValidPtr =
  SlotNo -> TxIx -> CertIx -> Ptr
Ptr
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Word64 -> SlotNo
SlotNo forall b c a. (b -> c) -> (a -> b) -> a -> c
. (forall a b. (Integral a, Num b) => a -> b
fromIntegral :: Word32 -> Word64) 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
<*> (HasCallStack => Integer -> TxIx
mkTxIxPartial forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Integral a => a -> Integer
toInteger forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (forall a. Arbitrary a => Gen a
arbitrary :: Gen Word16))
    forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (HasCallStack => Integer -> CertIx
mkCertIxPartial forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Integral a => a -> Integer
toInteger forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (forall a. Arbitrary a => Gen a
arbitrary :: Gen Word16))

-- | Generate a Ptr with full 64bit range for values. Not allowed starting in Babbage
genBadPtr :: Gen Ptr
genBadPtr :: Gen Ptr
genBadPtr = SlotNo -> TxIx -> CertIx -> Ptr
Ptr 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

instance Crypto c => Arbitrary (Credential r c) where
  arbitrary :: Gen (Credential r c)
arbitrary =
    forall a. HasCallStack => [Gen a] -> Gen a
oneof
      [ forall (kr :: KeyRole) c. ScriptHash c -> Credential kr c
ScriptHashObj forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall c. Hash (ADDRHASH c) EraIndependentScript -> ScriptHash c
ScriptHash forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall a. Arbitrary a => Gen a
arbitrary
      , forall (kr :: KeyRole) c. KeyHash kr c -> Credential kr c
KeyHashObj forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> 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 = forall h a. HashAlgorithm h => ShortByteString -> Hash h a
UnsafeHash forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Int -> Gen ShortByteString
genShortByteString (forall a b. (Integral a, Num b) => a -> b
fromIntegral (forall h (proxy :: * -> *). HashAlgorithm h => proxy h -> Word
sizeHash (forall {k} (t :: k). Proxy t
Proxy @h)))

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

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

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

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

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

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

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

instance (Typeable kr, Crypto c) => Arbitrary (WitVKey kr c) where
  arbitrary :: Gen (WitVKey kr c)
arbitrary = forall (kr :: KeyRole) c.
(Typeable kr, Crypto c) =>
VKey kr c
-> SignedDSIGN c (Hash c EraIndependentTxBody) -> WitVKey kr c
WitVKey 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 Arbitrary ChainCode where
  arbitrary :: Gen ChainCode
arbitrary = ByteString -> ChainCode
ChainCode forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall a. Arbitrary a => Gen a
arbitrary

instance Crypto c => Arbitrary (BootstrapWitness c) where
  arbitrary :: Gen (BootstrapWitness c)
arbitrary = do
    VKey 'Witness c
bwKey <- forall a. Arbitrary a => Gen a
arbitrary
    SignedDSIGN (DSIGN c) (Hash (HASH c) EraIndependentTxBody)
bwSig <- forall a. Arbitrary a => Gen a
arbitrary
    ChainCode
bwChainCode <- forall a. Arbitrary a => Gen a
arbitrary
    ByteString
bwAttributes <- forall a. Arbitrary a => Gen a
arbitrary
    forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ BootstrapWitness {VKey 'Witness c
bwKey :: VKey 'Witness c
bwKey :: VKey 'Witness c
bwKey, SignedDSIGN (DSIGN c) (Hash (HASH c) EraIndependentTxBody)
bwSig :: SignedDSIGN (DSIGN c) (Hash (HASH c) EraIndependentTxBody)
bwSig :: SignedDSIGN (DSIGN c) (Hash (HASH c) EraIndependentTxBody)
bwSig, ChainCode
bwChainCode :: ChainCode
bwChainCode :: ChainCode
bwChainCode, ByteString
bwAttributes :: ByteString
bwAttributes :: ByteString
bwAttributes}

instance Crypto c => Arbitrary (GenDelegPair c) where
  arbitrary :: Gen (GenDelegPair c)
arbitrary = forall c.
KeyHash 'GenesisDelegate c
-> Hash c (VerKeyVRF c) -> GenDelegPair c
GenDelegPair 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

deriving instance Crypto c => Arbitrary (GenDelegs c)

------------------------------------------------------------------------------------------
-- Cardano.Ledger.Coin -------------------------------------------------------------------
------------------------------------------------------------------------------------------
deriving instance Arbitrary (CompactForm Coin)

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

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

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

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

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

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

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

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

genAddrWith :: Crypto c => Gen Ptr -> Gen (Addr c)
genAddrWith :: forall c. Crypto c => Gen Ptr -> Gen (Addr c)
genAddrWith Gen Ptr
genPtr =
  forall a. HasCallStack => [(Int, Gen a)] -> Gen a
frequency
    [ (Int
8, forall c.
Network -> PaymentCredential c -> StakeReference c -> Addr c
Addr 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 c. Crypto c => Gen Ptr -> Gen (StakeReference c)
genStakeRefWith Gen Ptr
genPtr)
    , (Int
2, forall c. BootstrapAddress c -> Addr c
AddrBootstrap forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall a. Arbitrary a => Gen a
arbitrary)
    ]

genAddrBadPtr :: Crypto c => Gen (Addr c)
genAddrBadPtr :: forall c. Crypto c => Gen (Addr c)
genAddrBadPtr = forall c. Crypto c => Gen Ptr -> Gen (Addr c)
genAddrWith Gen Ptr
genBadPtr

genCompactAddrBadPtr :: Crypto c => Gen (CompactAddr c)
genCompactAddrBadPtr :: forall c. Crypto c => Gen (CompactAddr c)
genCompactAddrBadPtr = forall c. Addr c -> CompactAddr c
compactAddr forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall c. Crypto c => Gen (Addr c)
genAddrBadPtr

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

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

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

instance Crypto c => Arbitrary (RewardAccount c) where
  arbitrary :: Gen (RewardAccount c)
arbitrary = forall c. Network -> Credential 'Staking c -> RewardAccount c
RewardAccount 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 :: RewardAccount c -> [RewardAccount c]
shrink = forall a.
(Generic a, RecursivelyShrink (Rep a), GSubterms (Rep a) a) =>
a -> [a]
genericShrink

instance Crypto c => Arbitrary (Withdrawals c) where
  arbitrary :: Gen (Withdrawals c)
arbitrary = forall a. (GArbitrary UnsizedOpts a, GUniformWeight a) => Gen a
genericArbitraryU
  shrink :: Withdrawals c -> [Withdrawals c]
shrink = 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 = forall a. (Bounded a, Enum a) => Gen a
arbitraryBoundedEnum
  shrink :: RewardType -> [RewardType]
shrink = forall a.
(Generic a, RecursivelyShrink (Rep a), GSubterms (Rep a) a) =>
a -> [a]
genericShrink

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

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

instance Crypto c => Arbitrary (PoolParams c) where
  arbitrary :: Gen (PoolParams c)
arbitrary =
    forall c.
KeyHash 'StakePool c
-> Hash c (VerKeyVRF c)
-> Coin
-> Coin
-> UnitInterval
-> RewardAccount c
-> Set (KeyHash 'Staking c)
-> StrictSeq StakePoolRelay
-> StrictMaybe PoolMetadata
-> PoolParams c
PoolParams
      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
      forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall a. Arbitrary a => Gen a
arbitrary

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

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

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

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

instance Crypto c => Arbitrary (PoolDistr c) where
  arbitrary :: Gen (PoolDistr c)
arbitrary = do
    Positive Word64
denominator <- forall a. Arbitrary a => Gen a
arbitrary
    forall c.
Map (KeyHash 'StakePool c) (IndividualPoolStake c)
-> CompactForm Coin -> PoolDistr c
PoolDistr 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 (Word64 -> CompactForm Coin
CompactCoin Word64
denominator)

instance Crypto c => Arbitrary (IndividualPoolStake c) where
  arbitrary :: Gen (IndividualPoolStake c)
arbitrary = forall c.
Rational
-> CompactForm Coin
-> Hash c (VerKeyVRF c)
-> IndividualPoolStake c
IndividualPoolStake 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

------------------------------------------------------------------------------------------
-- Cardano.Ledger.DRepDistr --------------------------------------------------------------
------------------------------------------------------------------------------------------

instance Crypto c => Arbitrary (DRepState c) where
  arbitrary :: Gen (DRepState c)
arbitrary = forall c.
EpochNo
-> StrictMaybe (Anchor c)
-> Coin
-> Set (Credential 'Staking c)
-> DRepState c
DRepState 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

------------------------------------------------------------------------------------------
-- Cardano.Ledger.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.UMap -------------------------------------------------------------------
------------------------------------------------------------------------------------------

instance Arbitrary RDPair where
  arbitrary :: Gen RDPair
arbitrary = CompactForm Coin -> CompactForm Coin -> RDPair
RDPair 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 :: RDPair -> [RDPair]
shrink = forall a.
(Generic a, RecursivelyShrink (Rep a), GSubterms (Rep a) a) =>
a -> [a]
genericShrink

instance Crypto c => Arbitrary (UMElem c) where
  arbitrary :: Gen (UMElem c)
arbitrary = forall c.
StrictMaybe RDPair
-> Set Ptr
-> StrictMaybe (KeyHash 'StakePool c)
-> StrictMaybe (DRep c)
-> UMElem c
UMElem 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 :: UMElem c -> [UMElem c]
shrink = forall a.
(Generic a, RecursivelyShrink (Rep a), GSubterms (Rep a) a) =>
a -> [a]
genericShrink

instance Crypto c => Arbitrary (UMap c) where
  arbitrary :: Gen (UMap c)
arbitrary = forall c.
Map (Credential 'Staking c) (UMElem c)
-> Map Ptr (Credential 'Staking c) -> UMap c
UMap 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 Crypto c => Arbitrary (DRep c) where
  arbitrary :: Gen (DRep c)
arbitrary =
    forall a. HasCallStack => [Gen a] -> Gen a
oneof
      [ forall c. Credential 'DRepRole c -> DRep c
DRepCredential forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall a. Arbitrary a => Gen a
arbitrary
      , forall (f :: * -> *) a. Applicative f => a -> f a
pure forall c. DRep c
DRepAlwaysAbstain
      , forall (f :: * -> *) a. Applicative f => a -> f a
pure forall c. DRep c
DRepAlwaysNoConfidence
      ]

-- | Used for testing UMap operations
genValidTuples ::
  Gen
    ( Map (Credential 'Staking StandardCrypto) RDPair
    , Map Ptr (Credential 'Staking StandardCrypto)
    , Map (Credential 'Staking StandardCrypto) (KeyHash 'StakePool StandardCrypto)
    , Map (Credential 'Staking StandardCrypto) (DRep StandardCrypto)
    )
genValidTuples :: Gen
  (Map (Credential 'Staking StandardCrypto) RDPair,
   Map Ptr (Credential 'Staking StandardCrypto),
   Map
     (Credential 'Staking StandardCrypto)
     (KeyHash 'StakePool StandardCrypto),
   Map (Credential 'Staking StandardCrypto) (DRep StandardCrypto))
genValidTuples = forall a. (Int -> Int) -> Gen a -> Gen a
scale (forall a. Num a => a -> a -> a
* Int
2) forall a b. (a -> b) -> a -> b
$ do
  [Credential 'Staking StandardCrypto]
creds :: [Credential 'Staking StandardCrypto] <- forall a. Arbitrary a => Gen a
arbitrary
  let nCreds :: Int
nCreds = forall (t :: * -> *) a. Foldable t => t a -> Int
length [Credential 'Staking StandardCrypto]
creds
  [RDPair]
rdPairs :: [RDPair] <- forall a. Int -> Gen a -> Gen [a]
vectorOf Int
nCreds forall a. Arbitrary a => Gen a
arbitrary
  [Ptr]
ptrs :: [Ptr] <- forall a. Arbitrary a => Gen a
arbitrary
  [KeyHash 'StakePool StandardCrypto]
sPools :: [KeyHash 'StakePool StandardCrypto] <- forall a. Int -> Gen a -> Gen [a]
vectorOf Int
nCreds forall a. Arbitrary a => Gen a
arbitrary
  [DRep StandardCrypto]
dReps :: [DRep StandardCrypto] <- forall a. Int -> Gen a -> Gen [a]
vectorOf Int
nCreds forall a. Arbitrary a => Gen a
arbitrary
  forall (f :: * -> *) a. Applicative f => a -> f a
pure
    ( forall k a. Ord k => [(k, a)] -> Map k a
Map.fromList forall a b. (a -> b) -> a -> b
$ forall a b. [a] -> [b] -> [(a, b)]
zip [Credential 'Staking StandardCrypto]
creds [RDPair]
rdPairs
    , forall k a. Ord k => [(k, a)] -> Map k a
Map.fromList forall a b. (a -> b) -> a -> b
$ forall a b. [a] -> [b] -> [(a, b)]
zip [Ptr]
ptrs [Credential 'Staking StandardCrypto]
creds
    , forall k a. Ord k => [(k, a)] -> Map k a
Map.fromList forall a b. (a -> b) -> a -> b
$ forall a b. [a] -> [b] -> [(a, b)]
zip [Credential 'Staking StandardCrypto]
creds [KeyHash 'StakePool StandardCrypto]
sPools
    , forall k a. Ord k => [(k, a)] -> Map k a
Map.fromList forall a b. (a -> b) -> a -> b
$ forall a b. [a] -> [b] -> [(a, b)]
zip [Credential 'Staking StandardCrypto]
creds [DRep StandardCrypto]
dReps
    )

genValidTuplesNonEmpty ::
  Gen
    ( Map (Credential 'Staking StandardCrypto) RDPair
    , Map Ptr (Credential 'Staking StandardCrypto)
    , Map (Credential 'Staking StandardCrypto) (KeyHash 'StakePool StandardCrypto)
    , Map (Credential 'Staking StandardCrypto) (DRep StandardCrypto)
    )
genValidTuplesNonEmpty :: Gen
  (Map (Credential 'Staking StandardCrypto) RDPair,
   Map Ptr (Credential 'Staking StandardCrypto),
   Map
     (Credential 'Staking StandardCrypto)
     (KeyHash 'StakePool StandardCrypto),
   Map (Credential 'Staking StandardCrypto) (DRep StandardCrypto))
genValidTuplesNonEmpty = forall a. (Int -> Int) -> Gen a -> Gen a
scale (forall a. Num a => a -> a -> a
* Int
2) forall a b. (a -> b) -> a -> b
$ do
  Positive Int
nCreds <- forall a. Arbitrary a => Gen a
arbitrary
  Int
nPtrs <- (Int, Int) -> Gen Int
chooseInt (Int
1, Int
nCreds)
  [Credential 'Staking StandardCrypto]
creds :: [Credential 'Staking StandardCrypto] <- forall a. Int -> Gen a -> Gen [a]
vectorOf Int
nCreds forall a. Arbitrary a => Gen a
arbitrary
  [RDPair]
rdPairs :: [RDPair] <- forall a. Int -> Gen a -> Gen [a]
vectorOf Int
nCreds forall a. Arbitrary a => Gen a
arbitrary
  [Ptr]
ptrs :: [Ptr] <- forall a. Int -> Gen a -> Gen [a]
vectorOf Int
nPtrs forall a. Arbitrary a => Gen a
arbitrary
  [KeyHash 'StakePool StandardCrypto]
sPools :: [KeyHash 'StakePool StandardCrypto] <- forall a. Int -> Gen a -> Gen [a]
vectorOf Int
nCreds forall a. Arbitrary a => Gen a
arbitrary
  [DRep StandardCrypto]
dReps :: [DRep StandardCrypto] <- forall a. Int -> Gen a -> Gen [a]
vectorOf Int
nCreds forall a. Arbitrary a => Gen a
arbitrary
  forall (f :: * -> *) a. Applicative f => a -> f a
pure
    ( forall k a. Ord k => [(k, a)] -> Map k a
Map.fromList forall a b. (a -> b) -> a -> b
$ forall a b. [a] -> [b] -> [(a, b)]
zip [Credential 'Staking StandardCrypto]
creds [RDPair]
rdPairs
    , forall k a. Ord k => [(k, a)] -> Map k a
Map.fromList forall a b. (a -> b) -> a -> b
$ forall a b. [a] -> [b] -> [(a, b)]
zip [Ptr]
ptrs [Credential 'Staking StandardCrypto]
creds
    , forall k a. Ord k => [(k, a)] -> Map k a
Map.fromList forall a b. (a -> b) -> a -> b
$ forall a b. [a] -> [b] -> [(a, b)]
zip [Credential 'Staking StandardCrypto]
creds [KeyHash 'StakePool StandardCrypto]
sPools
    , forall k a. Ord k => [(k, a)] -> Map k a
Map.fromList forall a b. (a -> b) -> a -> b
$ forall a b. [a] -> [b] -> [(a, b)]
zip [Credential 'Staking StandardCrypto]
creds [DRep StandardCrypto]
dReps
    )

genValidUMap :: Gen (UMap StandardCrypto)
genValidUMap :: Gen (UMap StandardCrypto)
genValidUMap = do
  (Map (Credential 'Staking StandardCrypto) RDPair
rdPairs, Map Ptr (Credential 'Staking StandardCrypto)
ptrs, Map
  (Credential 'Staking StandardCrypto)
  (KeyHash 'StakePool StandardCrypto)
sPools, Map (Credential 'Staking StandardCrypto) (DRep StandardCrypto)
dReps) <- Gen
  (Map (Credential 'Staking StandardCrypto) RDPair,
   Map Ptr (Credential 'Staking StandardCrypto),
   Map
     (Credential 'Staking StandardCrypto)
     (KeyHash 'StakePool StandardCrypto),
   Map (Credential 'Staking StandardCrypto) (DRep StandardCrypto))
genValidTuples
  forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ forall c.
Map (Credential 'Staking c) RDPair
-> Map Ptr (Credential 'Staking c)
-> Map (Credential 'Staking c) (KeyHash 'StakePool c)
-> Map (Credential 'Staking c) (DRep c)
-> UMap c
unify Map (Credential 'Staking StandardCrypto) RDPair
rdPairs Map Ptr (Credential 'Staking StandardCrypto)
ptrs Map
  (Credential 'Staking StandardCrypto)
  (KeyHash 'StakePool StandardCrypto)
sPools Map (Credential 'Staking StandardCrypto) (DRep StandardCrypto)
dReps

genValidUMapNonEmpty :: Gen (UMap StandardCrypto)
genValidUMapNonEmpty :: Gen (UMap StandardCrypto)
genValidUMapNonEmpty = do
  (Map (Credential 'Staking StandardCrypto) RDPair
rdPairs, Map Ptr (Credential 'Staking StandardCrypto)
ptrs, Map
  (Credential 'Staking StandardCrypto)
  (KeyHash 'StakePool StandardCrypto)
sPools, Map (Credential 'Staking StandardCrypto) (DRep StandardCrypto)
dReps) <- Gen
  (Map (Credential 'Staking StandardCrypto) RDPair,
   Map Ptr (Credential 'Staking StandardCrypto),
   Map
     (Credential 'Staking StandardCrypto)
     (KeyHash 'StakePool StandardCrypto),
   Map (Credential 'Staking StandardCrypto) (DRep StandardCrypto))
genValidTuplesNonEmpty
  forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ forall c.
Map (Credential 'Staking c) RDPair
-> Map Ptr (Credential 'Staking c)
-> Map (Credential 'Staking c) (KeyHash 'StakePool c)
-> Map (Credential 'Staking c) (DRep c)
-> UMap c
unify Map (Credential 'Staking StandardCrypto) RDPair
rdPairs Map Ptr (Credential 'Staking StandardCrypto)
ptrs Map
  (Credential 'Staking StandardCrypto)
  (KeyHash 'StakePool StandardCrypto)
sPools Map (Credential 'Staking StandardCrypto) (DRep StandardCrypto)
dReps

-- | 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 -> forall a g (m :: * -> *).
(UniformRange a, StatefulGen g m) =>
(a, a) -> g -> m a
uniformRM (Int
0, Int
actualSize) g
gen
    Just Int
reqSize -> forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ forall a. Ord a => a -> a -> a
max Int
0 forall a b. (a -> b) -> a -> b
$ 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
  Int
subSetSize <- forall g (m :: * -> *).
StatefulGen g m =>
Maybe Int -> Int -> g -> m Int
uniformSubSize Maybe Int
mSubSetSize (forall a. Set a -> Int
Set.size Set k
inputSet) g
gen
  if Int
subSetSize forall a. Ord a => a -> a -> Bool
< forall a. Set a -> Int
Set.size Set k
inputSet forall a. Integral a => a -> a -> a
`div` Int
2
    then
      forall {t} {f :: * -> *} {a}.
(Num t, StatefulGen g f, Ord t, Ord a) =>
Set a -> Set a -> t -> f (Set a)
goAdd Set k
inputSet forall a. Set a
Set.empty Int
subSetSize
    else
      forall {t} {f :: * -> *} {a}.
(Ord t, Num t, StatefulGen g f) =>
Set a -> t -> f (Set a)
goDelete Set k
inputSet (forall a. Set a -> Int
Set.size Set k
inputSet forall a. Num a => a -> a -> a
- Int
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 forall a. Ord a => a -> a -> Bool
<= t
0 = forall (f :: * -> *) a. Applicative f => a -> f a
pure Set a
acc
      | Bool
otherwise = do
          Int
ix <- forall a g (m :: * -> *).
(UniformRange a, StatefulGen g m) =>
(a, a) -> g -> m a
uniformRM (Int
0, forall a. Set a -> Int
Set.size Set a
s forall a. Num a => a -> a -> a
- Int
1) g
gen
          Set a -> Set a -> t -> f (Set a)
goAdd (forall a. Int -> Set a -> Set a
Set.deleteAt Int
ix Set a
s) (forall a. Ord a => a -> Set a -> Set a
Set.insert (forall a. Int -> Set a -> a
Set.elemAt Int
ix Set a
s) Set a
acc) (t
i forall a. Num a => a -> a -> a
- t
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 forall a. Ord a => a -> a -> Bool
<= t
0 = forall (f :: * -> *) a. Applicative f => a -> f a
pure Set a
acc
      | Bool
otherwise = do
          Int
ix <- forall a g (m :: * -> *).
(UniformRange a, StatefulGen g m) =>
(a, a) -> g -> m a
uniformRM (Int
0, forall a. Set a -> Int
Set.size Set a
acc forall a. Num a => a -> a -> a
- Int
1) g
gen
          Set a -> t -> f (Set a)
goDelete (forall a. Int -> Set a -> Set a
Set.deleteAt Int
ix Set a
acc) (t
i forall a. Num a => a -> a -> a
- t
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
  Int
subMapSize <- forall g (m :: * -> *).
StatefulGen g m =>
Maybe Int -> Int -> g -> m Int
uniformSubSize Maybe Int
mSubMapSize (forall k a. Map k a -> Int
Map.size Map k v
inputMap) g
gen
  if Int
subMapSize forall a. Ord a => a -> a -> Bool
< forall k a. Map k a -> Int
Map.size Map k v
inputMap forall a. Integral a => a -> a -> a
`div` Int
2
    then
      -- Constructing a new Map is faster when less then a half of original Map will be used
      forall g (m :: * -> *) f k v.
(StatefulGen g m, Monoid f) =>
(k -> v -> f -> f) -> Maybe Int -> Map k v -> g -> m f
uniformSubMapElems forall k a. Ord k => k -> a -> Map k a -> Map k a
Map.insert (forall a. a -> Maybe a
Just Int
subMapSize) Map k v
inputMap g
gen
    else
      -- Deleting is faster when more items need to be retained in the Map
      forall {t} {f :: * -> *} {k} {a}.
(Ord t, Num t, StatefulGen g f) =>
Map k a -> t -> f (Map k a)
goDelete Map k v
inputMap (forall k a. Map k a -> Int
Map.size Map k v
inputMap forall a. Num a => a -> a -> a
- Int
subMapSize)
  where
    goDelete :: Map k a -> t -> f (Map k a)
goDelete !Map k a
acc !t
i
      | t
i forall a. Ord a => a -> a -> Bool
<= t
0 = forall (f :: * -> *) a. Applicative f => a -> f a
pure Map k a
acc
      | Bool
otherwise = do
          Int
ix <- forall a g (m :: * -> *).
(UniformRange a, StatefulGen g m) =>
(a, a) -> g -> m a
uniformRM (Int
0, forall k a. Map k a -> Int
Map.size Map k a
acc forall a. Num a => a -> a -> a
- Int
1) g
gen
          Map k a -> t -> f (Map k a)
goDelete (forall k a. Int -> Map k a -> Map k a
Map.deleteAt Int
ix Map k a
acc) (t
i forall a. Num a => a -> a -> a
- t
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
  Int
subMapSize <- forall g (m :: * -> *).
StatefulGen g m =>
Maybe Int -> Int -> g -> m Int
uniformSubSize Maybe Int
mSubMapSize (forall k a. Map k a -> Int
Map.size Map k v
inputMap) g
gen
  forall {t} {f :: * -> *}.
(Ord t, Num t, StatefulGen g f) =>
Map k v -> f -> t -> f f
go Map k v
inputMap forall a. Monoid a => a
mempty Int
subMapSize
  where
    go :: Map k v -> f -> t -> f f
go !Map k v
s !f
acc !t
i
      | t
i forall a. Ord a => a -> a -> Bool
<= t
0 = forall (f :: * -> *) a. Applicative f => a -> f a
pure f
acc
      | Bool
otherwise = do
          Int
ix <- forall a g (m :: * -> *).
(UniformRange a, StatefulGen g m) =>
(a, a) -> g -> m a
uniformRM (Int
0, forall k a. Map k a -> Int
Map.size Map k v
s forall a. Num a => a -> a -> a
- Int
1) g
gen
          let (k
k, v
v) = forall k a. Int -> Map k a -> (k, a)
Map.elemAt Int
ix Map k v
s
          Map k v -> f -> t -> f f
go (forall k a. Int -> Map k a -> Map k a
Map.deleteAt Int
ix Map k v
s) (k -> v -> f -> f
insert k
k v
v f
acc) (t
i forall a. Num a => a -> a -> a
- t
1)

genValidUMapWithCreds :: Gen (UMap StandardCrypto, Set (Credential 'Staking StandardCrypto))
genValidUMapWithCreds :: Gen (UMap StandardCrypto, Set (Credential 'Staking StandardCrypto))
genValidUMapWithCreds = do
  UMap StandardCrypto
umap <- Gen (UMap StandardCrypto)
genValidUMap
  Set (Credential 'Staking StandardCrypto)
creds <- forall g (m :: * -> *) k.
(StatefulGen g m, Ord k) =>
Maybe Int -> Set k -> g -> m (Set k)
uniformSubSet forall a. Maybe a
Nothing (forall k a. Map k a -> Set k
Map.keysSet forall a b. (a -> b) -> a -> b
$ forall c. UMap c -> Map (Credential 'Staking c) (UMElem c)
umElems UMap StandardCrypto
umap) QC
QC
  forall (f :: * -> *) a. Applicative f => a -> f a
pure (UMap StandardCrypto
umap, Set (Credential 'Staking StandardCrypto)
creds)

genExcludingKey :: (Ord k, Arbitrary k) => Map k a -> Gen k
genExcludingKey :: forall k a. (Ord k, Arbitrary k) => Map k a -> Gen k
genExcludingKey Map k a
ks = do
  k
k <- forall a. Arbitrary a => Gen a
arbitrary
  if k
k forall k a. Ord k => k -> Map k a -> Bool
`Map.member` Map k a
ks
    then forall k a. (Ord k, Arbitrary k) => Map k a -> Gen k
genExcludingKey Map k a
ks
    else forall (f :: * -> *) a. Applicative f => a -> f a
pure k
k

genInsertDeleteRoundtripRDPair ::
  Gen (UMap StandardCrypto, Credential 'Staking StandardCrypto, RDPair)
genInsertDeleteRoundtripRDPair :: Gen
  (UMap StandardCrypto, Credential 'Staking StandardCrypto, RDPair)
genInsertDeleteRoundtripRDPair = do
  umap :: UMap StandardCrypto
umap@UMap {Map (Credential 'Staking StandardCrypto) (UMElem StandardCrypto)
umElems :: Map (Credential 'Staking StandardCrypto) (UMElem StandardCrypto)
umElems :: forall c. UMap c -> Map (Credential 'Staking c) (UMElem c)
umElems} <- Gen (UMap StandardCrypto)
genValidUMap
  Credential 'Staking StandardCrypto
k <- forall k a. (Ord k, Arbitrary k) => Map k a -> Gen k
genExcludingKey Map (Credential 'Staking StandardCrypto) (UMElem StandardCrypto)
umElems
  RDPair
v <- forall a. Arbitrary a => Gen a
arbitrary
  forall (f :: * -> *) a. Applicative f => a -> f a
pure (UMap StandardCrypto
umap, Credential 'Staking StandardCrypto
k, RDPair
v)

genInsertDeleteRoundtripPtr :: Gen (UMap StandardCrypto, Ptr, Credential 'Staking StandardCrypto)
genInsertDeleteRoundtripPtr :: Gen (UMap StandardCrypto, Ptr, Credential 'Staking StandardCrypto)
genInsertDeleteRoundtripPtr = do
  umap :: UMap StandardCrypto
umap@UMap {Map Ptr (Credential 'Staking StandardCrypto)
umPtrs :: Map Ptr (Credential 'Staking StandardCrypto)
umPtrs :: forall c. UMap c -> Map Ptr (Credential 'Staking c)
umPtrs} <- Gen (UMap StandardCrypto)
genValidUMap
  Ptr
k <- forall k a. (Ord k, Arbitrary k) => Map k a -> Gen k
genExcludingKey Map Ptr (Credential 'Staking StandardCrypto)
umPtrs
  Credential 'Staking StandardCrypto
v <- forall a. Arbitrary a => Gen a
arbitrary
  forall (f :: * -> *) a. Applicative f => a -> f a
pure (UMap StandardCrypto
umap, Ptr
k, Credential 'Staking StandardCrypto
v)

genInsertDeleteRoundtripSPool ::
  Gen
    ( UMap StandardCrypto
    , Credential 'Staking StandardCrypto
    , KeyHash 'StakePool StandardCrypto
    )
genInsertDeleteRoundtripSPool :: Gen
  (UMap StandardCrypto, Credential 'Staking StandardCrypto,
   KeyHash 'StakePool StandardCrypto)
genInsertDeleteRoundtripSPool = do
  umap :: UMap StandardCrypto
umap@UMap {Map (Credential 'Staking StandardCrypto) (UMElem StandardCrypto)
umElems :: Map (Credential 'Staking StandardCrypto) (UMElem StandardCrypto)
umElems :: forall c. UMap c -> Map (Credential 'Staking c) (UMElem c)
umElems} <- Gen (UMap StandardCrypto)
genValidUMap
  Credential 'Staking StandardCrypto
k <- forall k a. (Ord k, Arbitrary k) => Map k a -> Gen k
genExcludingKey Map (Credential 'Staking StandardCrypto) (UMElem StandardCrypto)
umElems
  KeyHash 'StakePool StandardCrypto
v <- forall a. Arbitrary a => Gen a
arbitrary
  forall (f :: * -> *) a. Applicative f => a -> f a
pure (UMap StandardCrypto
umap, Credential 'Staking StandardCrypto
k, KeyHash 'StakePool StandardCrypto
v)

genInsertDeleteRoundtripDRep ::
  Gen
    ( UMap StandardCrypto
    , Credential 'Staking StandardCrypto
    , DRep StandardCrypto
    )
genInsertDeleteRoundtripDRep :: Gen
  (UMap StandardCrypto, Credential 'Staking StandardCrypto,
   DRep StandardCrypto)
genInsertDeleteRoundtripDRep = do
  umap :: UMap StandardCrypto
umap@UMap {Map (Credential 'Staking StandardCrypto) (UMElem StandardCrypto)
umElems :: Map (Credential 'Staking StandardCrypto) (UMElem StandardCrypto)
umElems :: forall c. UMap c -> Map (Credential 'Staking c) (UMElem c)
umElems} <- Gen (UMap StandardCrypto)
genValidUMap
  Credential 'Staking StandardCrypto
k <- forall k a. (Ord k, Arbitrary k) => Map k a -> Gen k
genExcludingKey Map (Credential 'Staking StandardCrypto) (UMElem StandardCrypto)
umElems
  DRep StandardCrypto
v <- forall a. Arbitrary a => Gen a
arbitrary
  forall (f :: * -> *) a. Applicative f => a -> f a
pure (UMap StandardCrypto
umap, Credential 'Staking StandardCrypto
k, DRep StandardCrypto
v)

genInvariantNonEmpty :: Gen (Credential 'Staking StandardCrypto, Ptr, UMap StandardCrypto)
genInvariantNonEmpty :: Gen (Credential 'Staking StandardCrypto, Ptr, UMap StandardCrypto)
genInvariantNonEmpty = do
  umap :: UMap StandardCrypto
umap@(UMap Map (Credential 'Staking StandardCrypto) (UMElem StandardCrypto)
tripmap Map Ptr (Credential 'Staking StandardCrypto)
ptrmap) <- Gen (UMap StandardCrypto)
genValidUMapNonEmpty
  Credential 'Staking StandardCrypto
cred <-
    forall a. HasCallStack => [Gen a] -> Gen a
oneof
      [ forall a. HasCallStack => [a] -> Gen a
elements forall a b. (a -> b) -> a -> b
$ forall k a. Map k a -> [k]
Map.keys Map (Credential 'Staking StandardCrypto) (UMElem StandardCrypto)
tripmap
      , forall k a. (Ord k, Arbitrary k) => Map k a -> Gen k
genExcludingKey Map (Credential 'Staking StandardCrypto) (UMElem StandardCrypto)
tripmap
      ]
  Ptr
ptr <-
    forall a. HasCallStack => [Gen a] -> Gen a
oneof
      [ forall a. HasCallStack => [a] -> Gen a
elements forall a b. (a -> b) -> a -> b
$ forall k a. Map k a -> [k]
Map.keys Map Ptr (Credential 'Staking StandardCrypto)
ptrmap
      , forall k a. (Ord k, Arbitrary k) => Map k a -> Gen k
genExcludingKey Map Ptr (Credential 'Staking StandardCrypto)
ptrmap
      ]
  forall (f :: * -> *) a. Applicative f => a -> f a
pure (Credential 'Staking StandardCrypto
cred, Ptr
ptr, UMap StandardCrypto
umap)

genRightPreferenceUMap :: Gen (UMap StandardCrypto, Map (Credential 'Staking StandardCrypto) RDPair)
genRightPreferenceUMap :: Gen
  (UMap StandardCrypto,
   Map (Credential 'Staking StandardCrypto) RDPair)
genRightPreferenceUMap = do
  UMap StandardCrypto
umap <- Gen (UMap StandardCrypto)
genValidUMap
  let rdMap :: Map (Credential 'Staking StandardCrypto) RDPair
rdMap = forall c k v. UView c k v -> Map k v
unUnify forall a b. (a -> b) -> a -> b
$ forall c. UMap c -> UView c (Credential 'Staking c) RDPair
RewDepUView UMap StandardCrypto
umap
  [Credential 'Staking StandardCrypto]
subdomain <- forall a. [a] -> Gen [a]
sublistOf forall a b. (a -> b) -> a -> b
$ forall k a. Map k a -> [k]
Map.keys Map (Credential 'Staking StandardCrypto) RDPair
rdMap
  [RDPair]
coins <- forall a. Int -> Gen a -> Gen [a]
vectorOf (forall (t :: * -> *) a. Foldable t => t a -> Int
length [Credential 'Staking StandardCrypto]
subdomain) forall a. Arbitrary a => Gen a
arbitrary
  forall (f :: * -> *) a. Applicative f => a -> f a
pure (UMap StandardCrypto
umap, forall k a. Ord k => [(k, a)] -> Map k a
Map.fromList forall a b. (a -> b) -> a -> b
$ forall a b. [a] -> [b] -> [(a, b)]
zip [Credential 'Staking StandardCrypto]
subdomain [RDPair]
coins)

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

instance Era era => Arbitrary (CertState era) where
  arbitrary :: Gen (CertState era)
arbitrary = forall era. VState era -> PState era -> DState era -> CertState era
CertState 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
  shrink :: CertState era -> [CertState era]
shrink = forall a.
(Generic a, RecursivelyShrink (Rep a), GSubterms (Rep a) a) =>
a -> [a]
genericShrink

instance Era era => Arbitrary (DState era) where
  arbitrary :: Gen (DState era)
arbitrary =
    if forall era. Era era => Version
eraProtVerLow @era forall a. Ord a => a -> a -> Bool
>= forall (v :: Nat). (KnownNat v, 0 <= v, v <= MaxVersion) => Version
natVersion @9
      then forall era.
UMap (EraCrypto era)
-> Map
     (FutureGenDeleg (EraCrypto era)) (GenDelegPair (EraCrypto era))
-> GenDelegs (EraCrypto era)
-> InstantaneousRewards (EraCrypto era)
-> DState era
DState forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall c. Crypto c => Gen (UMap c)
genConwayUMap 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
      else forall era.
UMap (EraCrypto era)
-> Map
     (FutureGenDeleg (EraCrypto era)) (GenDelegPair (EraCrypto era))
-> GenDelegs (EraCrypto era)
-> InstantaneousRewards (EraCrypto era)
-> DState era
DState 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

genConwayUMap :: forall c. Crypto c => Gen (UMap c)
genConwayUMap :: forall c. Crypto c => Gen (UMap c)
genConwayUMap = forall c.
Map (Credential 'Staking c) (UMElem c)
-> Map Ptr (Credential 'Staking c) -> UMap c
UMap forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Gen (Map (Credential 'Staking c) (UMElem c))
genElems 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
  where
    genElems :: Gen (Map (Credential 'Staking c) (UMElem c))
    genElems :: Gen (Map (Credential 'Staking c) (UMElem c))
genElems = 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. Gen a -> Gen [a]
listOf ((,) 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
<*> Gen (UMElem c)
genElem)
    genElem :: Gen (UMElem c)
    genElem :: Gen (UMElem c)
genElem = forall c.
StrictMaybe RDPair
-> Set Ptr
-> StrictMaybe (KeyHash 'StakePool c)
-> StrictMaybe (DRep c)
-> UMElem c
UMElem 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 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 Era era => Arbitrary (PState era) where
  arbitrary :: Gen (PState era)
arbitrary = forall era.
Map
  (KeyHash 'StakePool (EraCrypto era)) (PoolParams (EraCrypto era))
-> Map
     (KeyHash 'StakePool (EraCrypto era)) (PoolParams (EraCrypto era))
-> Map (KeyHash 'StakePool (EraCrypto era)) EpochNo
-> Map (KeyHash 'StakePool (EraCrypto era)) Coin
-> PState era
PState 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 Crypto c => Arbitrary (Anchor c) where
  arbitrary :: Gen (Anchor c)
arbitrary = forall c. Url -> SafeHash c AnchorData -> Anchor c
Anchor 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 Arbitrary a => Arbitrary (Mismatch r a) where
  arbitrary :: Gen (Mismatch r a)
arbitrary = forall (r :: Relation) a. a -> a -> Mismatch r a
Mismatch 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 Crypto c => Arbitrary (CommitteeAuthorization c) where
  arbitrary :: Gen (CommitteeAuthorization c)
arbitrary =
    forall a. HasCallStack => [Gen a] -> Gen a
oneof
      [ forall c.
Credential 'HotCommitteeRole c -> CommitteeAuthorization c
CommitteeHotCredential forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall a. Arbitrary a => Gen a
arbitrary
      , forall c. StrictMaybe (Anchor c) -> CommitteeAuthorization c
CommitteeMemberResigned forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall a. Arbitrary a => Gen a
arbitrary
      ]

deriving instance Era era => Arbitrary (CommitteeState era)

instance Era era => Arbitrary (VState era) where
  arbitrary :: Gen (VState era)
arbitrary = forall era.
Map
  (Credential 'DRepRole (EraCrypto era)) (DRepState (EraCrypto era))
-> CommitteeState era -> EpochNo -> VState era
VState 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

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

instance Crypto c => Arbitrary (FutureGenDeleg c) where
  arbitrary :: Gen (FutureGenDeleg c)
arbitrary = forall c. SlotNo -> KeyHash 'Genesis c -> FutureGenDeleg c
FutureGenDeleg 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 :: FutureGenDeleg c -> [FutureGenDeleg c]
shrink = forall a.
(Generic a, RecursivelyShrink (Rep a), GSubterms (Rep a) a) =>
a -> [a]
genericShrink

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

instance Crypto c => Arbitrary (SnapShot c) where
  arbitrary :: Gen (SnapShot c)
arbitrary =
    forall c.
Stake c
-> VMap VB VB (Credential 'Staking c) (KeyHash 'StakePool c)
-> VMap VB VB (KeyHash 'StakePool c) (PoolParams c)
-> SnapShot c
SnapShot
      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

instance Crypto c => Arbitrary (SnapShots c) where
  arbitrary :: Gen (SnapShots c)
arbitrary = do
    SnapShot c
ssStakeMark <- forall a. Arbitrary a => Gen a
arbitrary
    SnapShot c
ssStakeSet <- forall a. Arbitrary a => Gen a
arbitrary
    SnapShot c
ssStakeGo <- forall a. Arbitrary a => Gen a
arbitrary
    Coin
ssFee <- forall a. Arbitrary a => Gen a
arbitrary
    let ssStakeMarkPoolDistr :: PoolDistr c
ssStakeMarkPoolDistr = forall c. SnapShot c -> PoolDistr c
calculatePoolDistr SnapShot c
ssStakeMark
    forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ SnapShots {SnapShot c
PoolDistr c
Coin
$sel:ssStakeMark:SnapShots :: SnapShot c
$sel:ssStakeMarkPoolDistr:SnapShots :: PoolDistr c
$sel:ssStakeSet:SnapShots :: SnapShot c
$sel:ssStakeGo:SnapShots :: SnapShot c
$sel:ssFee:SnapShots :: Coin
ssStakeMarkPoolDistr :: PoolDistr c
ssFee :: Coin
ssStakeGo :: SnapShot c
ssStakeSet :: SnapShot c
ssStakeMark :: SnapShot c
..}

-- | 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 Crypto c => Arbitrary (Stake c) where
  arbitrary :: Gen (Stake c)
arbitrary = forall c.
VMap VB VP (Credential 'Staking c) (CompactForm Coin) -> Stake c
Stake forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (forall (kv :: * -> *) k (vv :: * -> *) v.
(Vector kv k, Vector vv v) =>
Map k v -> VMap kv vv k v
VMap.fromMap forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Gen (Map (Credential 'Staking c) (CompactForm Coin))
theMap)
    where
      genWord64 :: Int -> Gen Word64
      genWord64 :: Int -> Gen Word64
genWord64 Int
n =
        forall a. HasCallStack => [(Int, Gen a)] -> Gen a
frequency
          [ (Int
3, forall a. Random a => (a, a) -> Gen a
choose (Word64
1, Word64
100))
          , (Int
2, forall a. Random a => (a, a) -> Gen a
choose (Word64
101, Word64
10000))
          , (Int
1, forall a. Random a => (a, a) -> Gen a
choose (Word64
1, forall a. Bounded a => a
maxBound forall a. Integral a => a -> a -> a
`div` forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
n))
          ]
      theMap :: Gen (Map (Credential 'Staking c) (CompactForm Coin))
theMap = do
        Int
n <- 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 :: Gen (Credential 'Staking c, CompactForm Coin)
pair = (,) 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
<*> (Word64 -> CompactForm Coin
CompactCoin forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Int -> Gen Word64
genWord64 Int
n)
        [(Credential 'Staking c, CompactForm Coin)]
list <- forall a. HasCallStack => [(Int, Gen a)] -> Gen a
frequency [(Int
1, forall (f :: * -> *) a. Applicative f => a -> f a
pure []), (Int
99, forall a. Int -> Gen a -> Gen [a]
vectorOf Int
n Gen (Credential 'Staking c, CompactForm Coin)
pair)]
        forall (f :: * -> *) a. Applicative f => a -> f a
pure (forall k a. Ord k => [(k, a)] -> Map k a
Map.fromList [(Credential 'Staking c, CompactForm Coin)]
list)

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

instance Crypto c => Arbitrary (PoolCert c) where
  arbitrary :: Gen (PoolCert c)
arbitrary =
    forall a. HasCallStack => [Gen a] -> Gen a
oneof
      [ forall c. PoolParams c -> PoolCert c
RegPool forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall a. Arbitrary a => Gen a
arbitrary
      , forall c. KeyHash 'StakePool c -> EpochNo -> PoolCert c
RetirePool 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 :: PoolCert c -> [PoolCert c]
shrink = 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 = forall a. HasCallStack => [a] -> Gen a
elements [Language]
nonNativeLanguages

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

instance Arbitrary Prices where
  arbitrary :: Gen Prices
arbitrary = NonNegativeInterval -> NonNegativeInterval -> Prices
Prices 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 Arbitrary CostModel where
  arbitrary :: Gen CostModel
arbitrary = forall a. HasCallStack => [a] -> Gen a
elements [Language]
nonNativeLanguages forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Language -> Gen CostModel
genValidCostModel

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

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

genValidAndUnknownCostModels :: Gen CostModels
genValidAndUnknownCostModels :: Gen CostModels
genValidAndUnknownCostModels = do
  [Language]
langs <- forall a. [a] -> Gen [a]
sublistOf [Language]
nonNativeLanguages
  CostModels
validCms <- Set Language -> Gen CostModels
genValidCostModels forall a b. (a -> b) -> a -> b
$ forall a. Ord a => [a] -> Set a
Set.fromList [Language]
langs
  CostModels
unknownCms <- forall a. HasCallStack => Fail a -> a
errorFail forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (m :: * -> *).
MonadFail m =>
Map Word8 [Int64] -> m CostModels
mkCostModelsLenient forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Gen (Map Word8 [Int64])
genUnknownCostModels
  forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ CostModels -> CostModels -> CostModels
updateCostModels CostModels
validCms CostModels
unknownCms

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

genUnknownCostModels :: Gen (Map Word8 [Int64])
genUnknownCostModels :: Gen (Map Word8 [Int64])
genUnknownCostModels = 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. Gen a -> Gen [a]
listOf Gen (Word8, [Int64])
genUnknownCostModelValues

genKnownCostModels :: Gen (Map Word8 [Int64])
genKnownCostModels :: Gen (Map Word8 [Int64])
genKnownCostModels = do
  [Language]
langs <- forall a. [a] -> Gen [a]
sublistOf [Language]
nonNativeLanguages
  [(Word8, [Int64])]
cms <- forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM Language -> Gen (Word8, [Int64])
genCostModelValues [Language]
langs
  forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ forall k a. Ord k => [(k, a)] -> Map k a
Map.fromList [(Word8, [Int64])]
cms

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

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