{-# 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.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,
  natVersion,
  promoteRatio,
  textToDns,
  textToUrl,
 )
import qualified Cardano.Ledger.BaseTypes as NZ
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.HKD (NoUpdate (..))
import Cardano.Ledger.Hashes (GenDelegPair (..), GenDelegs (..), unsafeMakeSafeHash)
import Cardano.Ledger.Keys (BootstrapWitness (..), ChainCode (..), VKey (..), WitVKey (..))
import Cardano.Ledger.Plutus.CostModels (
  CostModel,
  CostModels,
  costModelParamsCount,
  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.PoolParams (
  PoolMetadata (..),
  PoolParams (..),
  SizeOfPoolOwners (..),
  SizeOfPoolRelays (..),
  StakePoolRelay (..),
 )
import Cardano.Ledger.State
import Cardano.Ledger.TxIn (TxId (..), TxIn (..))
import Cardano.Ledger.UMap (
  RDPair (..),
  UMElem (UMElem),
  UMap (UMap, umElems, umPtrs),
  UView (RewDepUView),
  unUnify,
  unify,
 )
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.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.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 = 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
  [Char]
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']
  Text -> Gen Text
forall a. a -> Gen a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Text -> Gen Text) -> Text -> Gen Text
forall a b. (a -> b) -> a -> b
$ [Char] -> Text
T.pack [Char]
str Text -> Text -> Text
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 -> [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
    Int
n <- (Int, Int) -> Gen Int
chooseInt (Int
5, Int
64)
    Text
txt <- Int -> Gen Text
genDnsName Int
n
    DnsName -> Gen DnsName
forall a. a -> Gen a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (DnsName -> Gen DnsName) -> DnsName -> Gen DnsName
forall a b. (a -> b) -> a -> b
$! Int -> Text -> Maybe DnsName -> DnsName
forall a. HasCallStack => Int -> Text -> Maybe a -> a
guardLength Int
n Text
txt (Maybe DnsName -> DnsName) -> Maybe DnsName -> DnsName
forall a b. (a -> b) -> a -> b
$ Int -> Text -> Maybe DnsName
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 Int -> Int -> Int
forall a. Num a => a -> a -> a
- Text -> Int
T.length Text
prefix)
    Text
txt <- Int -> Gen Text
genDnsName Int
n
    Url -> Gen Url
forall a. a -> Gen a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Url -> Gen Url) -> Url -> Gen Url
forall a b. (a -> b) -> a -> b
$! Int -> Text -> Maybe Url -> Url
forall a. HasCallStack => Int -> Text -> Maybe a -> a
guardLength Int
n Text
txt (Maybe Url -> Url) -> Maybe Url -> Url
forall a b. (a -> b) -> a -> b
$ Int -> Text -> Maybe Url
forall (m :: * -> *). MonadFail m => Int -> Text -> m Url
textToUrl Int
64 (Text
prefix Text -> Text -> Text
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 (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
    Int
p <- (Int, Int) -> Gen Int
chooseInt (Int
0, Int
maxDecimalsWord64)
    let y :: Word64
y = Word64
10 Word64 -> Int -> Word64
forall a b. (Num a, Integral b) => a -> b -> a
^ Int
p :: Word64
    Word64
x <- (Word64, Word64) -> Gen Word64
forall a. Random a => (a, a) -> Gen a
choose (Word64
0, Word64
y)
    UnitInterval -> Gen UnitInterval
forall a. a -> Gen a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (UnitInterval -> Gen UnitInterval)
-> UnitInterval -> Gen UnitInterval
forall a b. (a -> b) -> a -> b
$ Rational -> UnitInterval
forall r.
(HasCallStack, Typeable r, BoundedRational r) =>
Rational -> r
unsafeBoundRational (Rational -> UnitInterval) -> Rational -> UnitInterval
forall a b. (a -> b) -> a -> b
$ Ratio Word64 -> Rational
forall a. Integral a => Ratio a -> Rational
promoteRatio (Word64
x Word64 -> Word64 -> Ratio Word64
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 Word64 -> Int -> Word64
forall a b. (Num a, Integral b) => a -> b -> a
^ Int
p :: Word64
    Word64
x <- (Word64, Word64) -> Gen Word64
forall a. Random a => (a, a) -> Gen a
choose (Word64
1, Word64
y)
    PositiveUnitInterval -> Gen PositiveUnitInterval
forall a. a -> Gen a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (PositiveUnitInterval -> Gen PositiveUnitInterval)
-> PositiveUnitInterval -> Gen PositiveUnitInterval
forall a b. (a -> b) -> a -> b
$ Rational -> PositiveUnitInterval
forall r.
(HasCallStack, Typeable r, BoundedRational r) =>
Rational -> r
unsafeBoundRational (Rational -> PositiveUnitInterval)
-> Rational -> PositiveUnitInterval
forall a b. (a -> b) -> a -> b
$ Ratio Word64 -> Rational
forall a. Integral a => Ratio a -> Rational
promoteRatio (Word64
x Word64 -> Word64 -> Ratio Word64
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 Word64 -> Int -> Word64
forall a b. (Num a, Integral b) => a -> b -> a
^ Int
p :: Word64
    Word64
x <- (Word64, Word64) -> Gen Word64
forall a. Random a => (a, a) -> Gen a
choose (Word64
1, Word64
10 Word64 -> Int -> Word64
forall a b. (Num a, Integral b) => a -> b -> a
^ (Int
maxDecimalsWord64 :: Int))
    PositiveInterval -> Gen PositiveInterval
forall a. a -> Gen a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (PositiveInterval -> Gen PositiveInterval)
-> PositiveInterval -> Gen PositiveInterval
forall a b. (a -> b) -> a -> b
$ Rational -> PositiveInterval
forall r.
(HasCallStack, Typeable r, BoundedRational r) =>
Rational -> r
unsafeBoundRational (Rational -> PositiveInterval) -> Rational -> PositiveInterval
forall a b. (a -> b) -> a -> b
$ Ratio Word64 -> Rational
forall a. Integral a => Ratio a -> Rational
promoteRatio (Word64
x Word64 -> Word64 -> Ratio Word64
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 Word64 -> Int -> Word64
forall a b. (Num a, Integral b) => a -> b -> a
^ Int
p :: Word64
    Word64
x <- (Word64, Word64) -> Gen Word64
forall a. Random a => (a, a) -> Gen a
choose (Word64
0, Word64
10 Word64 -> Int -> Word64
forall a b. (Num a, Integral b) => a -> b -> a
^ (Int
maxDecimalsWord64 :: Int))
    NonNegativeInterval -> Gen NonNegativeInterval
forall a. a -> Gen a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (NonNegativeInterval -> Gen NonNegativeInterval)
-> NonNegativeInterval -> Gen NonNegativeInterval
forall a b. (a -> b) -> a -> b
$ Rational -> NonNegativeInterval
forall r.
(HasCallStack, Typeable r, BoundedRational r) =>
Rational -> r
unsafeBoundRational (Rational -> NonNegativeInterval)
-> Rational -> NonNegativeInterval
forall a b. (a -> b) -> a -> b
$ Ratio Word64 -> Rational
forall a. Integral a => Ratio a -> Rational
promoteRatio (Word64
x Word64 -> Word64 -> Ratio Word64
forall a. Integral a => a -> a -> Ratio a
% Word64
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
    Word64
x :: Word64 <- Gen Word64
forall a. GenValid a => Gen a
genValid
    Positive (Word64
y :: Word64) <- Gen (Positive Word64)
forall a. Arbitrary a => Gen a
arbitrary
    UnitInterval -> Gen UnitInterval
forall a. a -> Gen a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (UnitInterval -> Gen UnitInterval)
-> UnitInterval -> Gen UnitInterval
forall a b. (a -> b) -> a -> b
$ Rational -> UnitInterval
forall r.
(HasCallStack, Typeable r, BoundedRational r) =>
Rational -> r
unsafeBoundRational (Rational -> UnitInterval) -> Rational -> UnitInterval
forall a b. (a -> b) -> a -> b
$ Ratio Word64 -> Rational
forall a. Integral a => Ratio a -> Rational
promoteRatio (if Word64
x Word64 -> Word64 -> Bool
forall a. Ord a => a -> a -> Bool
> Word64
y then Word64
y Word64 -> Word64 -> Ratio Word64
forall a. Integral a => a -> a -> Ratio a
% Word64
x else Word64
x Word64 -> Word64 -> Ratio Word64
forall a. Integral a => a -> a -> Ratio a
% Word64
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 (Word64
x :: Word64) <- Gen (Positive Word64)
forall a. Arbitrary a => Gen a
arbitrary
    Positive (Word64
y :: Word64) <- Gen (Positive Word64)
forall a. Arbitrary a => Gen a
arbitrary
    PositiveUnitInterval -> Gen PositiveUnitInterval
forall a. a -> Gen a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (PositiveUnitInterval -> Gen PositiveUnitInterval)
-> PositiveUnitInterval -> Gen PositiveUnitInterval
forall a b. (a -> b) -> a -> b
$ Rational -> PositiveUnitInterval
forall r.
(HasCallStack, Typeable r, BoundedRational r) =>
Rational -> r
unsafeBoundRational (Rational -> PositiveUnitInterval)
-> Rational -> PositiveUnitInterval
forall a b. (a -> b) -> a -> b
$ Ratio Word64 -> Rational
forall a. Integral a => Ratio a -> Rational
promoteRatio (if Word64
x Word64 -> Word64 -> Bool
forall a. Ord a => a -> a -> Bool
> Word64
y then Word64
y Word64 -> Word64 -> Ratio Word64
forall a. Integral a => a -> a -> Ratio a
% Word64
x else Word64
x Word64 -> Word64 -> Ratio Word64
forall a. Integral a => a -> a -> Ratio a
% Word64
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 (Word64
x :: Word64) <- Gen (Positive Word64)
forall a. Arbitrary a => Gen a
arbitrary
    Positive (Word64
y :: Word64) <- Gen (Positive Word64)
forall a. Arbitrary a => Gen a
arbitrary
    PositiveInterval -> Gen PositiveInterval
forall a. a -> Gen a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (PositiveInterval -> Gen PositiveInterval)
-> PositiveInterval -> Gen PositiveInterval
forall a b. (a -> b) -> a -> b
$ Rational -> PositiveInterval
forall r.
(HasCallStack, Typeable r, BoundedRational r) =>
Rational -> r
unsafeBoundRational (Rational -> PositiveInterval) -> Rational -> PositiveInterval
forall a b. (a -> b) -> a -> b
$ Ratio Word64 -> Rational
forall a. Integral a => Ratio a -> Rational
promoteRatio (Word64
x Word64 -> Word64 -> Ratio Word64
forall a. Integral a => a -> a -> Ratio a
% Word64
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
    Word64
x :: Word64 <- Gen Word64
forall a. GenValid a => Gen a
genValid
    Positive (Word64
y :: Word64) <- Gen (Positive Word64)
forall a. Arbitrary a => Gen a
arbitrary
    NonNegativeInterval -> Gen NonNegativeInterval
forall a. a -> Gen a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (NonNegativeInterval -> Gen NonNegativeInterval)
-> NonNegativeInterval -> Gen NonNegativeInterval
forall a b. (a -> b) -> a -> b
$ Rational -> NonNegativeInterval
forall r.
(HasCallStack, Typeable r, BoundedRational r) =>
Rational -> r
unsafeBoundRational (Rational -> NonNegativeInterval)
-> Rational -> NonNegativeInterval
forall a b. (a -> b) -> a -> b
$ Ratio Word64 -> Rational
forall a. Integral a => Ratio a -> Rational
promoteRatio (Word64
x Word64 -> Word64 -> Ratio Word64
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 = 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

-- | Generate a Ptr with full 64bit range for values. Not allowed starting in Babbage
genBadPtr :: Gen Ptr
genBadPtr :: Gen Ptr
genBadPtr = 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
{-# DEPRECATED genBadPtr "Bad pointers are no longer possible" #-}

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
<$> Gen ByteString
forall a. Arbitrary a => Gen a
arbitrary

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

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 -------------------------------------------------------------------
------------------------------------------------------------------------------------------
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 (Integer -> Coin) -> Gen Integer -> Gen Coin
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
0, Integer
1000000)
  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 -> PaymentCredential -> StakeReference -> Addr
Addr (Network -> PaymentCredential -> StakeReference -> Addr)
-> Gen Network -> Gen (PaymentCredential -> StakeReference -> Addr)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Gen Network
forall a. Arbitrary a => Gen a
arbitrary Gen (PaymentCredential -> StakeReference -> Addr)
-> Gen PaymentCredential -> 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 PaymentCredential
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)
    ]

genAddrBadPtr :: Gen Addr
genAddrBadPtr :: Gen Addr
genAddrBadPtr = Gen Ptr -> Gen Addr
genAddrWith Gen Ptr
genBadPtr
{-# DEPRECATED genAddrBadPtr "Addresses with bad pointers are no longer possible" #-}

genCompactAddrBadPtr :: Gen CompactAddr
genCompactAddrBadPtr :: Gen CompactAddr
genCompactAddrBadPtr = Addr -> CompactAddr
compactAddr (Addr -> CompactAddr) -> Gen Addr -> Gen CompactAddr
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Gen Addr
genAddrBadPtr
{-# DEPRECATED genCompactAddrBadPtr "Addresses with bad pointers are no longer possible" #-}

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 PoolParams where
  arbitrary :: Gen PoolParams
arbitrary =
    KeyHash 'StakePool
-> VRFVerKeyHash 'StakePoolVRF
-> Coin
-> Coin
-> UnitInterval
-> RewardAccount
-> Set (KeyHash 'Staking)
-> StrictSeq StakePoolRelay
-> StrictMaybe PoolMetadata
-> PoolParams
PoolParams
      (KeyHash 'StakePool
 -> VRFVerKeyHash 'StakePoolVRF
 -> Coin
 -> Coin
 -> UnitInterval
 -> RewardAccount
 -> Set (KeyHash 'Staking)
 -> StrictSeq StakePoolRelay
 -> StrictMaybe PoolMetadata
 -> PoolParams)
-> Gen (KeyHash 'StakePool)
-> Gen
     (VRFVerKeyHash 'StakePoolVRF
      -> Coin
      -> Coin
      -> UnitInterval
      -> RewardAccount
      -> Set (KeyHash 'Staking)
      -> StrictSeq StakePoolRelay
      -> StrictMaybe PoolMetadata
      -> PoolParams)
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
   -> PoolParams)
-> Gen (VRFVerKeyHash 'StakePoolVRF)
-> Gen
     (Coin
      -> Coin
      -> UnitInterval
      -> RewardAccount
      -> Set (KeyHash 'Staking)
      -> StrictSeq StakePoolRelay
      -> StrictMaybe PoolMetadata
      -> PoolParams)
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
   -> PoolParams)
-> Gen Coin
-> Gen
     (Coin
      -> UnitInterval
      -> RewardAccount
      -> Set (KeyHash 'Staking)
      -> StrictSeq StakePoolRelay
      -> StrictMaybe PoolMetadata
      -> PoolParams)
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
   -> PoolParams)
-> Gen Coin
-> Gen
     (UnitInterval
      -> RewardAccount
      -> Set (KeyHash 'Staking)
      -> StrictSeq StakePoolRelay
      -> StrictMaybe PoolMetadata
      -> PoolParams)
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
   -> PoolParams)
-> Gen UnitInterval
-> Gen
     (RewardAccount
      -> Set (KeyHash 'Staking)
      -> StrictSeq StakePoolRelay
      -> StrictMaybe PoolMetadata
      -> PoolParams)
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
   -> PoolParams)
-> Gen RewardAccount
-> Gen
     (Set (KeyHash 'Staking)
      -> StrictSeq StakePoolRelay
      -> StrictMaybe PoolMetadata
      -> PoolParams)
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
   -> PoolParams)
-> Gen (Set (KeyHash 'Staking))
-> Gen
     (StrictSeq StakePoolRelay
      -> StrictMaybe PoolMetadata -> PoolParams)
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 -> PoolParams)
-> Gen (StrictSeq StakePoolRelay)
-> Gen (StrictMaybe PoolMetadata -> PoolParams)
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 -> PoolParams)
-> Gen (StrictMaybe PoolMetadata) -> Gen PoolParams
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 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 Word64
denominator <- Gen (Positive Word64)
forall a. Arbitrary a => Gen a
arbitrary
    Map (KeyHash 'StakePool) IndividualPoolStake
-> CompactForm Coin -> PoolDistr
PoolDistr (Map (KeyHash 'StakePool) IndividualPoolStake
 -> CompactForm Coin -> PoolDistr)
-> Gen (Map (KeyHash 'StakePool) IndividualPoolStake)
-> Gen (CompactForm Coin -> PoolDistr)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Gen (Map (KeyHash 'StakePool) IndividualPoolStake)
forall a. Arbitrary a => Gen a
arbitrary Gen (CompactForm Coin -> PoolDistr)
-> Gen (CompactForm Coin) -> Gen PoolDistr
forall a b. Gen (a -> b) -> Gen a -> Gen b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> CompactForm Coin -> Gen (CompactForm Coin)
forall a. a -> Gen a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Word64 -> CompactForm Coin
CompactCoin Word64
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
-> Coin
-> Set (Credential 'Staking)
-> DRepState
DRepState (EpochNo
 -> StrictMaybe Anchor
 -> Coin
 -> Set (Credential 'Staking)
 -> DRepState)
-> Gen EpochNo
-> Gen
     (StrictMaybe Anchor
      -> 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
   -> Coin -> Set (Credential 'Staking) -> DRepState)
-> Gen (StrictMaybe Anchor)
-> Gen (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 (Coin -> Set (Credential 'Staking) -> DRepState)
-> Gen 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 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.UMap -------------------------------------------------------------------
------------------------------------------------------------------------------------------

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

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

instance Arbitrary UMap where
  arbitrary :: Gen UMap
arbitrary = Map (Credential 'Staking) UMElem
-> Map Ptr (Credential 'Staking) -> UMap
UMap (Map (Credential 'Staking) UMElem
 -> Map Ptr (Credential 'Staking) -> UMap)
-> Gen (Map (Credential 'Staking) UMElem)
-> Gen (Map Ptr (Credential 'Staking) -> UMap)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Gen (Map (Credential 'Staking) UMElem)
forall a. Arbitrary a => Gen a
arbitrary Gen (Map Ptr (Credential 'Staking) -> UMap)
-> Gen (Map Ptr (Credential 'Staking)) -> Gen UMap
forall a b. Gen (a -> b) -> Gen a -> Gen b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Gen (Map Ptr (Credential 'Staking))
forall a. Arbitrary a => Gen a
arbitrary

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 (NZ.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)
NZ.nonZero

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

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

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

genValidUMapNonEmpty :: Gen UMap
genValidUMapNonEmpty :: Gen UMap
genValidUMapNonEmpty = do
  (Map (Credential 'Staking) RDPair
rdPairs, Map Ptr (Credential 'Staking)
ptrs, Map (Credential 'Staking) (KeyHash 'StakePool)
sPools, Map (Credential 'Staking) DRep
dReps) <- Gen
  (Map (Credential 'Staking) RDPair, Map Ptr (Credential 'Staking),
   Map (Credential 'Staking) (KeyHash 'StakePool),
   Map (Credential 'Staking) DRep)
genValidTuplesNonEmpty
  UMap -> Gen UMap
forall a. a -> Gen a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (UMap -> Gen UMap) -> UMap -> Gen UMap
forall a b. (a -> b) -> a -> b
$ Map (Credential 'Staking) RDPair
-> Map Ptr (Credential 'Staking)
-> Map (Credential 'Staking) (KeyHash 'StakePool)
-> Map (Credential 'Staking) DRep
-> UMap
unify Map (Credential 'Staking) RDPair
rdPairs Map Ptr (Credential 'Staking)
ptrs Map (Credential 'Staking) (KeyHash 'StakePool)
sPools Map (Credential 'Staking) DRep
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 -> (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
  Int
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 Int
subSetSize Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Set k -> Int
forall a. Set a -> Int
Set.size Set k
inputSet Int -> Int -> Int
forall a. Integral a => a -> a -> a
`div` Int
2
    then
      Set k -> Set k -> Int -> m (Set k)
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 Set k
forall a. Set a
Set.empty Int
subSetSize
    else
      Set k -> Int -> m (Set k)
forall {t} {f :: * -> *} {a}.
(Ord t, Num t, StatefulGen g f) =>
Set a -> t -> f (Set a)
goDelete Set k
inputSet (Set k -> Int
forall a. Set a -> Int
Set.size Set k
inputSet Int -> Int -> Int
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 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
          Int
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
          Set a -> Set a -> t -> f (Set a)
goAdd (Int -> Set a -> Set a
forall a. Int -> Set a -> Set a
Set.deleteAt Int
ix Set a
s) (a -> Set a -> Set a
forall a. Ord a => a -> Set a -> Set a
Set.insert (Int -> Set a -> a
forall a. Int -> Set a -> a
Set.elemAt Int
ix Set a
s) Set a
acc) (t
i t -> t -> t
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 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
          Int
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
          Set a -> t -> f (Set a)
goDelete (Int -> Set a -> Set a
forall a. Int -> Set a -> Set a
Set.deleteAt Int
ix Set a
acc) (t
i t -> t -> t
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 <- 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 Int
subMapSize Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Map k v -> Int
forall k a. Map k a -> Int
Map.size Map k v
inputMap Int -> Int -> Int
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
      (k -> v -> Map k v -> Map k v)
-> Maybe Int -> Map k v -> g -> m (Map k v)
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 -> Map k v -> Map k v
forall k a. Ord k => k -> a -> Map k a -> Map k a
Map.insert (Int -> Maybe Int
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
      Map k v -> Int -> m (Map k v)
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 (Map k v -> Int
forall k a. Map k a -> Int
Map.size Map k v
inputMap Int -> Int -> Int
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 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
          Int
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
          Map k a -> t -> f (Map k a)
goDelete (Int -> Map k a -> Map k a
forall k a. Int -> Map k a -> Map k a
Map.deleteAt Int
ix Map k a
acc) (t
i t -> t -> t
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 <- 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
  Map k v -> f -> Int -> m f
forall {t} {f :: * -> *}.
(Ord t, Num t, StatefulGen g f) =>
Map k v -> f -> t -> f f
go Map k v
inputMap f
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 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
          Int
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
k, v
v) = Int -> Map k v -> (k, 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 (Int -> Map k v -> Map k v
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 t -> t -> t
forall a. Num a => a -> a -> a
- t
1)

genValidUMapWithCreds :: Gen (UMap, Set (Credential 'Staking))
genValidUMapWithCreds :: Gen (UMap, Set (Credential 'Staking))
genValidUMapWithCreds = do
  UMap
umap <- Gen UMap
genValidUMap
  Set (Credential 'Staking)
creds <- Maybe Int
-> Set (Credential 'Staking)
-> QC
-> Gen (Set (Credential 'Staking))
forall g (m :: * -> *) k.
(StatefulGen g m, Ord k) =>
Maybe Int -> Set k -> g -> m (Set k)
uniformSubSet Maybe Int
forall a. Maybe a
Nothing (Map (Credential 'Staking) UMElem -> Set (Credential 'Staking)
forall k a. Map k a -> Set k
Map.keysSet (Map (Credential 'Staking) UMElem -> Set (Credential 'Staking))
-> Map (Credential 'Staking) UMElem -> Set (Credential 'Staking)
forall a b. (a -> b) -> a -> b
$ UMap -> Map (Credential 'Staking) UMElem
umElems UMap
umap) QC
QC
  (UMap, Set (Credential 'Staking))
-> Gen (UMap, Set (Credential 'Staking))
forall a. a -> Gen a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (UMap
umap, Set (Credential 'Staking)
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 <- Gen k
forall a. Arbitrary a => Gen a
arbitrary
  if k
k k -> Map k a -> Bool
forall k a. Ord k => k -> Map k a -> Bool
`Map.member` Map k a
ks
    then Map k a -> Gen k
forall k a. (Ord k, Arbitrary k) => Map k a -> Gen k
genExcludingKey Map k a
ks
    else k -> Gen k
forall a. a -> Gen a
forall (f :: * -> *) a. Applicative f => a -> f a
pure k
k

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

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

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

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

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

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

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

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

genConwayUMap :: Gen UMap
genConwayUMap :: Gen UMap
genConwayUMap = Map (Credential 'Staking) UMElem
-> Map Ptr (Credential 'Staking) -> UMap
UMap (Map (Credential 'Staking) UMElem
 -> Map Ptr (Credential 'Staking) -> UMap)
-> Gen (Map (Credential 'Staking) UMElem)
-> Gen (Map Ptr (Credential 'Staking) -> UMap)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Gen (Map (Credential 'Staking) UMElem)
genElems Gen (Map Ptr (Credential 'Staking) -> UMap)
-> Gen (Map Ptr (Credential 'Staking)) -> Gen UMap
forall a b. Gen (a -> b) -> Gen a -> Gen b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Map Ptr (Credential 'Staking)
-> Gen (Map Ptr (Credential 'Staking))
forall a. a -> Gen a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Map Ptr (Credential 'Staking)
forall a. Monoid a => a
mempty
  where
    genElems :: Gen (Map (Credential 'Staking) UMElem)
    genElems :: Gen (Map (Credential 'Staking) UMElem)
genElems = [(Credential 'Staking, UMElem)] -> Map (Credential 'Staking) UMElem
forall k a. Ord k => [(k, a)] -> Map k a
Map.fromList ([(Credential 'Staking, UMElem)]
 -> Map (Credential 'Staking) UMElem)
-> Gen [(Credential 'Staking, UMElem)]
-> Gen (Map (Credential 'Staking) UMElem)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Gen (Credential 'Staking, UMElem)
-> Gen [(Credential 'Staking, UMElem)]
forall a. Gen a -> Gen [a]
listOf ((,) (Credential 'Staking -> UMElem -> (Credential 'Staking, UMElem))
-> Gen (Credential 'Staking)
-> Gen (UMElem -> (Credential 'Staking, UMElem))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Gen (Credential 'Staking)
forall a. Arbitrary a => Gen a
arbitrary Gen (UMElem -> (Credential 'Staking, UMElem))
-> Gen UMElem -> Gen (Credential 'Staking, UMElem)
forall a b. Gen (a -> b) -> Gen a -> Gen b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Gen UMElem
genElem)
    genElem :: Gen UMElem
    genElem :: Gen UMElem
genElem = StrictMaybe RDPair
-> Set Ptr
-> StrictMaybe (KeyHash 'StakePool)
-> StrictMaybe DRep
-> UMElem
UMElem (StrictMaybe RDPair
 -> Set Ptr
 -> StrictMaybe (KeyHash 'StakePool)
 -> StrictMaybe DRep
 -> UMElem)
-> Gen (StrictMaybe RDPair)
-> Gen
     (Set Ptr
      -> StrictMaybe (KeyHash 'StakePool) -> StrictMaybe DRep -> UMElem)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Gen (StrictMaybe RDPair)
forall a. Arbitrary a => Gen a
arbitrary Gen
  (Set Ptr
   -> StrictMaybe (KeyHash 'StakePool) -> StrictMaybe DRep -> UMElem)
-> Gen (Set Ptr)
-> Gen
     (StrictMaybe (KeyHash 'StakePool) -> StrictMaybe DRep -> UMElem)
forall a b. Gen (a -> b) -> Gen a -> Gen b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Set Ptr -> Gen (Set Ptr)
forall a. a -> Gen a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Set Ptr
forall a. Monoid a => a
mempty Gen
  (StrictMaybe (KeyHash 'StakePool) -> StrictMaybe DRep -> UMElem)
-> Gen (StrictMaybe (KeyHash 'StakePool))
-> Gen (StrictMaybe DRep -> UMElem)
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 (KeyHash 'StakePool))
forall a. Arbitrary a => Gen a
arbitrary Gen (StrictMaybe DRep -> UMElem)
-> Gen (StrictMaybe DRep) -> Gen UMElem
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 DRep)
forall a. Arbitrary a => Gen a
arbitrary

instance Arbitrary (PState era) where
  arbitrary :: Gen (PState era)
arbitrary = Map (KeyHash 'StakePool) PoolParams
-> Map (KeyHash 'StakePool) PoolParams
-> Map (KeyHash 'StakePool) EpochNo
-> Map (KeyHash 'StakePool) Coin
-> PState era
forall era.
Map (KeyHash 'StakePool) PoolParams
-> Map (KeyHash 'StakePool) PoolParams
-> Map (KeyHash 'StakePool) EpochNo
-> Map (KeyHash 'StakePool) Coin
-> PState era
PState (Map (KeyHash 'StakePool) PoolParams
 -> Map (KeyHash 'StakePool) PoolParams
 -> Map (KeyHash 'StakePool) EpochNo
 -> Map (KeyHash 'StakePool) Coin
 -> PState era)
-> Gen (Map (KeyHash 'StakePool) PoolParams)
-> Gen
     (Map (KeyHash 'StakePool) PoolParams
      -> Map (KeyHash 'StakePool) EpochNo
      -> Map (KeyHash 'StakePool) Coin
      -> PState era)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Gen (Map (KeyHash 'StakePool) PoolParams)
forall a. Arbitrary a => Gen a
arbitrary Gen
  (Map (KeyHash 'StakePool) PoolParams
   -> Map (KeyHash 'StakePool) EpochNo
   -> Map (KeyHash 'StakePool) Coin
   -> PState era)
-> Gen (Map (KeyHash 'StakePool) PoolParams)
-> Gen
     (Map (KeyHash 'StakePool) EpochNo
      -> Map (KeyHash 'StakePool) Coin -> 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) PoolParams)
forall a. Arbitrary a => Gen a
arbitrary Gen
  (Map (KeyHash 'StakePool) EpochNo
   -> Map (KeyHash 'StakePool) Coin -> PState era)
-> Gen (Map (KeyHash 'StakePool) EpochNo)
-> Gen (Map (KeyHash 'StakePool) Coin -> 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 Gen (Map (KeyHash 'StakePool) Coin -> PState era)
-> Gen (Map (KeyHash 'StakePool) Coin) -> 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) Coin)
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 'Genesis -> FutureGenDeleg
FutureGenDeleg (SlotNo -> KeyHash 'Genesis -> FutureGenDeleg)
-> Gen SlotNo -> Gen (KeyHash 'Genesis -> FutureGenDeleg)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Gen SlotNo
forall a. Arbitrary a => Gen a
arbitrary Gen (KeyHash 'Genesis -> FutureGenDeleg)
-> Gen (KeyHash 'Genesis) -> 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 'Genesis)
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) PoolParams
-> SnapShot
SnapShot
      (Stake
 -> VMap VB VB (Credential 'Staking) (KeyHash 'StakePool)
 -> VMap VB VB (KeyHash 'StakePool) PoolParams
 -> SnapShot)
-> Gen Stake
-> Gen
     (VMap VB VB (Credential 'Staking) (KeyHash 'StakePool)
      -> VMap VB VB (KeyHash 'StakePool) PoolParams -> 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) PoolParams -> SnapShot)
-> Gen (VMap VB VB (Credential 'Staking) (KeyHash 'StakePool))
-> Gen (VMap VB VB (KeyHash 'StakePool) PoolParams -> 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) PoolParams -> SnapShot)
-> Gen (VMap VB VB (KeyHash 'StakePool) PoolParams) -> 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) PoolParams)
forall a. Arbitrary a => Gen a
arbitrary

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

-- | 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
        Int
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 :: Gen (Credential 'Staking, CompactForm Coin)
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)
        [(Credential 'Staking, CompactForm Coin)]
list <- [(Int, Gen [(Credential 'Staking, CompactForm Coin)])]
-> Gen [(Credential 'Staking, CompactForm Coin)]
forall a. HasCallStack => [(Int, Gen a)] -> Gen a
frequency [(Int
1, [(Credential 'Staking, CompactForm Coin)]
-> Gen [(Credential 'Staking, CompactForm Coin)]
forall a. a -> Gen a
forall (f :: * -> *) a. Applicative f => a -> f a
pure []), (Int
99, Int
-> Gen (Credential 'Staking, CompactForm Coin)
-> Gen [(Credential 'Staking, CompactForm Coin)]
forall a. Int -> Gen a -> Gen [a]
vectorOf Int
n Gen (Credential 'Staking, CompactForm Coin)
pair)]
        Map (Credential 'Staking) (CompactForm Coin)
-> Gen (Map (Credential 'Staking) (CompactForm Coin))
forall a. a -> Gen a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ([(Credential 'Staking, CompactForm Coin)]
-> Map (Credential 'Staking) (CompactForm Coin)
forall k a. Ord k => [(k, a)] -> Map k a
Map.fromList [(Credential 'Staking, CompactForm Coin)]
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
      [ PoolParams -> PoolCert
RegPool (PoolParams -> PoolCert) -> Gen PoolParams -> Gen PoolCert
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Gen PoolParams
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]

genValidCostModel :: Language -> Gen CostModel
genValidCostModel :: Language -> Gen CostModel
genValidCostModel Language
lang = do
  [Int64]
newParamValues <- Int -> Gen Int64 -> Gen [Int64]
forall a. Int -> Gen a -> Gen [a]
vectorOf (Language -> Int
costModelParamsCount Language
lang) Gen Int64
forall a. Arbitrary a => Gen a
arbitrary
  (CostModelApplyError -> Gen CostModel)
-> (CostModel -> Gen CostModel)
-> Either CostModelApplyError CostModel
-> Gen CostModel
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
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) CostModel -> Gen CostModel
forall a. a -> Gen a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Either CostModelApplyError CostModel -> Gen CostModel)
-> Either CostModelApplyError CostModel -> Gen CostModel
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 = (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
  [Language]
langs <- [Language] -> Gen [Language]
forall a. [a] -> Gen [a]
sublistOf [Language]
nonNativeLanguages
  CostModels
validCms <- Set Language -> Gen CostModels
genValidCostModels (Set Language -> Gen CostModels) -> Set Language -> Gen CostModels
forall a b. (a -> b) -> a -> b
$ [Language] -> Set Language
forall a. Ord a => [a] -> Set a
Set.fromList [Language]
langs
  CostModels
unknownCms <- Fail CostModels -> CostModels
forall a. HasCallStack => Fail a -> a
errorFail (Fail CostModels -> CostModels)
-> (Map Word8 [Int64] -> Fail CostModels)
-> Map Word8 [Int64]
-> CostModels
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Map Word8 [Int64] -> Fail CostModels
forall (m :: * -> *).
MonadFail m =>
Map Word8 [Int64] -> m CostModels
mkCostModelsLenient (Map Word8 [Int64] -> CostModels)
-> Gen (Map Word8 [Int64]) -> Gen CostModels
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Gen (Map Word8 [Int64])
genUnknownCostModels
  CostModels -> Gen CostModels
forall a. a -> Gen a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (CostModels -> Gen CostModels) -> CostModels -> Gen CostModels
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 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
    CostModels -> Gen CostModels
forall a. a -> Gen a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (CostModels -> Gen CostModels)
-> (Fail CostModels -> CostModels)
-> Fail CostModels
-> Gen CostModels
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Fail CostModels -> CostModels
forall a. HasCallStack => Fail a -> a
errorFail (Fail CostModels -> Gen CostModels)
-> Fail CostModels -> Gen CostModels
forall a b. (a -> b) -> a -> b
$ Map Word8 [Int64] -> Fail CostModels
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 = [(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
  [Language]
langs <- [Language] -> Gen [Language]
forall a. [a] -> Gen [a]
sublistOf [Language]
nonNativeLanguages
  [(Word8, [Int64])]
cms <- (Language -> Gen (Word8, [Int64]))
-> [Language] -> Gen [(Word8, [Int64])]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> [a] -> m [b]
mapM Language -> Gen (Word8, [Int64])
genCostModelValues [Language]
langs
  Map Word8 [Int64] -> Gen (Map Word8 [Int64])
forall a. a -> Gen a
forall (m :: * -> *) a. Monad m => a -> m a
return (Map Word8 [Int64] -> Gen (Map Word8 [Int64]))
-> Map Word8 [Int64] -> Gen (Map Word8 [Int64])
forall a b. (a -> b) -> a -> b
$ [(Word8, [Int64])] -> Map Word8 [Int64]
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, Word8 -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Word8
forall a. Bounded a => a
maxBound :: Word8))
  [Int64]
vs <- Gen [Int64]
forall a. Arbitrary a => Gen a
arbitrary
  (Word8, [Int64]) -> Gen (Word8, [Int64])
forall a. a -> Gen a
forall (m :: * -> *) a. Monad m => a -> m a
return (Int -> Word8
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int -> Word8) -> (Int -> Int) -> Int -> Word8
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> Int
forall a. Enum a => a -> Int
fromEnum (Int -> Word8) -> Int -> Word8
forall a b. (a -> b) -> a -> b
$ Int
lang, [Int64]
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 Int
sub <- Gen (Positive Int)
forall a. Arbitrary a => Gen a
arbitrary
  (,) Word8
lang'
    ([Int64] -> (Word8, [Int64]))
-> Gen [Int64] -> Gen (Word8, [Int64])
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [Gen [Int64]] -> Gen [Int64]
forall a. HasCallStack => [Gen a] -> Gen a
oneof
      [ Int -> Gen [Int64]
listAtLeast (Language -> Int
costModelParamsCount Language
lang) -- Valid Cost Model for known language
      , Int -> [Int64] -> [Int64]
forall a. Int -> [a] -> [a]
take (Int -> Int
tooFew Int
sub) ([Int64] -> [Int64]) -> Gen [Int64] -> Gen [Int64]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Gen [Int64]
forall a. Arbitrary a => Gen a
arbitrary -- Invalid Cost Model for known language
      ]
  where
    lang' :: Word8
lang' = 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
costModelParamsCount 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 Int
y <- Gen (NonNegative Int)
forall a. Arbitrary a => Gen a
arbitrary
      Int -> Gen Int64 -> Gen [Int64]
forall (m :: * -> *) a. Applicative m => Int -> m a -> m [a]
replicateM (Int
x Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
y) Gen Int64
forall a. Arbitrary a => Gen a
arbitrary