{-# LANGUAGE LambdaCase #-}
{-# LANGUAGE NumDecimals #-}
{-# LANGUAGE OverloadedStrings #-}

module Test.Cardano.Chain.Common.Gen (
  genAddrAttributes,
  genAddrAttributesWithNM,
  genAddress,
  genAddressWithNM,
  genAddrType,
  genAddrSpendingData,
  genAttributes,
  genBlockCount,
  genCanonicalTxFeePolicy,
  genChainDifficulty,
  genCompactAddress,
  genCustomLovelace,
  genLovelace,
  genLovelaceError,
  genLovelaceWithRange,
  genLovelacePortion,
  genMerkleRoot,
  genMerkleTree,
  genNetworkMagic,
  genScriptVersion,
  genKeyHash,
  genTxFeePolicy,
  genTxSizeLinear,
) where

import Cardano.Chain.Common (
  AddrAttributes (..),
  AddrSpendingData (..),
  AddrType (..),
  Address (..),
  Attributes,
  BlockCount (..),
  ChainDifficulty (..),
  CompactAddress,
  HDAddressPayload (..),
  KeyHash,
  Lovelace,
  LovelaceError (..),
  LovelacePortion,
  MerkleRoot (..),
  MerkleTree,
  NetworkMagic (..),
  TxFeePolicy (..),
  TxSizeLinear (..),
  hashKey,
  makeAddress,
  maxLovelaceVal,
  mkAttributes,
  mkLovelace,
  mkMerkleTree,
  mtRoot,
  rationalToLovelacePortion,
  toCompactAddress,
 )
import Cardano.Ledger.Binary (EncCBOR)
import Cardano.Prelude
import Formatting (build, sformat)
import Hedgehog
import qualified Hedgehog.Gen as Gen
import qualified Hedgehog.Range as Range
import Test.Cardano.Crypto.Gen (genRedeemVerificationKey, genVerificationKey)
import Test.Cardano.Prelude (gen32Bytes)

genAddrAttributes :: Gen AddrAttributes
genAddrAttributes :: Gen AddrAttributes
genAddrAttributes = NetworkMagic -> Gen AddrAttributes
genAddrAttributesWithNM (NetworkMagic -> Gen AddrAttributes)
-> GenT Identity NetworkMagic -> Gen AddrAttributes
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< GenT Identity NetworkMagic
genNetworkMagic

genAddrAttributesWithNM :: NetworkMagic -> Gen AddrAttributes
genAddrAttributesWithNM :: NetworkMagic -> Gen AddrAttributes
genAddrAttributesWithNM NetworkMagic
nm = Maybe HDAddressPayload -> NetworkMagic -> AddrAttributes
AddrAttributes (Maybe HDAddressPayload -> NetworkMagic -> AddrAttributes)
-> GenT Identity (Maybe HDAddressPayload)
-> GenT Identity (NetworkMagic -> AddrAttributes)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> GenT Identity (Maybe HDAddressPayload)
hap GenT Identity (NetworkMagic -> AddrAttributes)
-> GenT Identity NetworkMagic -> Gen AddrAttributes
forall a b.
GenT Identity (a -> b) -> GenT Identity a -> GenT Identity b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> NetworkMagic -> GenT Identity NetworkMagic
forall a. a -> GenT Identity a
forall (f :: * -> *) a. Applicative f => a -> f a
pure NetworkMagic
nm
  where
    hap :: GenT Identity (Maybe HDAddressPayload)
hap = GenT Identity HDAddressPayload
-> GenT Identity (Maybe HDAddressPayload)
forall (m :: * -> *) a. MonadGen m => m a -> m (Maybe a)
Gen.maybe GenT Identity HDAddressPayload
genHDAddressPayload

genHDAddressPayload :: Gen HDAddressPayload
genHDAddressPayload :: GenT Identity HDAddressPayload
genHDAddressPayload = ByteString -> HDAddressPayload
HDAddressPayload (ByteString -> HDAddressPayload)
-> GenT Identity ByteString -> GenT Identity HDAddressPayload
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> GenT Identity ByteString
gen32Bytes

genAddress :: Gen Address
genAddress :: Gen Address
genAddress = AddrSpendingData -> AddrAttributes -> Address
makeAddress (AddrSpendingData -> AddrAttributes -> Address)
-> GenT Identity AddrSpendingData
-> GenT Identity (AddrAttributes -> Address)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> GenT Identity AddrSpendingData
genAddrSpendingData GenT Identity (AddrAttributes -> Address)
-> Gen AddrAttributes -> Gen Address
forall a b.
GenT Identity (a -> b) -> GenT Identity a -> GenT Identity b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Gen AddrAttributes
genAddrAttributes

genAddressWithNM :: NetworkMagic -> Gen Address
genAddressWithNM :: NetworkMagic -> Gen Address
genAddressWithNM NetworkMagic
nm =
  AddrSpendingData -> AddrAttributes -> Address
makeAddress
    (AddrSpendingData -> AddrAttributes -> Address)
-> GenT Identity AddrSpendingData
-> GenT Identity (AddrAttributes -> Address)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> GenT Identity AddrSpendingData
genAddrSpendingData
    GenT Identity (AddrAttributes -> Address)
-> Gen AddrAttributes -> Gen Address
forall a b.
GenT Identity (a -> b) -> GenT Identity a -> GenT Identity b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> NetworkMagic -> Gen AddrAttributes
genAddrAttributesWithNM NetworkMagic
nm

genAddrType :: Gen AddrType
genAddrType :: Gen AddrType
genAddrType = [Gen AddrType] -> Gen AddrType
forall (m :: * -> *) a. MonadGen m => [m a] -> m a
Gen.choice [AddrType -> Gen AddrType
forall a. a -> GenT Identity a
forall (f :: * -> *) a. Applicative f => a -> f a
pure AddrType
ATVerKey, AddrType -> Gen AddrType
forall a. a -> GenT Identity a
forall (f :: * -> *) a. Applicative f => a -> f a
pure AddrType
ATRedeem]

genAddrSpendingData :: Gen AddrSpendingData
genAddrSpendingData :: GenT Identity AddrSpendingData
genAddrSpendingData =
  [GenT Identity AddrSpendingData] -> GenT Identity AddrSpendingData
forall (m :: * -> *) a. MonadGen m => [m a] -> m a
Gen.choice [VerificationKey -> AddrSpendingData
VerKeyASD (VerificationKey -> AddrSpendingData)
-> GenT Identity VerificationKey -> GenT Identity AddrSpendingData
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> GenT Identity VerificationKey
genVerificationKey, RedeemVerificationKey -> AddrSpendingData
RedeemASD (RedeemVerificationKey -> AddrSpendingData)
-> GenT Identity RedeemVerificationKey
-> GenT Identity AddrSpendingData
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> GenT Identity RedeemVerificationKey
genRedeemVerificationKey]

genAttributes :: Gen a -> Gen (Attributes a)
genAttributes :: forall a. Gen a -> Gen (Attributes a)
genAttributes Gen a
genA = a -> Attributes a
forall h. h -> Attributes h
mkAttributes (a -> Attributes a) -> Gen a -> GenT Identity (Attributes a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Gen a
genA

genBlockCount :: Gen BlockCount
genBlockCount :: Gen BlockCount
genBlockCount = Word64 -> BlockCount
BlockCount (Word64 -> BlockCount) -> GenT Identity Word64 -> Gen BlockCount
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Range Word64 -> GenT Identity Word64
forall (m :: * -> *). MonadGen m => Range Word64 -> m Word64
Gen.word64 Range Word64
forall a. (Bounded a, Num a) => Range a
Range.constantBounded

genCanonicalTxFeePolicy :: Gen TxFeePolicy
genCanonicalTxFeePolicy :: Gen TxFeePolicy
genCanonicalTxFeePolicy = TxSizeLinear -> TxFeePolicy
TxFeePolicyTxSizeLinear (TxSizeLinear -> TxFeePolicy)
-> GenT Identity TxSizeLinear -> Gen TxFeePolicy
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> GenT Identity TxSizeLinear
genCanonicalTxSizeLinear

genCanonicalTxSizeLinear :: Gen TxSizeLinear
genCanonicalTxSizeLinear :: GenT Identity TxSizeLinear
genCanonicalTxSizeLinear = Lovelace -> Rational -> TxSizeLinear
TxSizeLinear (Lovelace -> Rational -> TxSizeLinear)
-> GenT Identity Lovelace
-> GenT Identity (Rational -> TxSizeLinear)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> GenT Identity Lovelace
genLovelace' GenT Identity (Rational -> TxSizeLinear)
-> GenT Identity Rational -> GenT Identity TxSizeLinear
forall a b.
GenT Identity (a -> b) -> GenT Identity a -> GenT Identity b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> GenT Identity Rational
genMultiplier
  where
    genLovelace' :: Gen Lovelace
    genLovelace' :: GenT Identity Lovelace
genLovelace' =
      Word64 -> Either LovelaceError Lovelace
mkLovelace
        (Word64 -> Either LovelaceError Lovelace)
-> GenT Identity Word64
-> GenT Identity (Either LovelaceError Lovelace)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Range Word64 -> GenT Identity Word64
forall (m :: * -> *). MonadGen m => Range Word64 -> m Word64
Gen.word64 (Word64 -> Word64 -> Range Word64
forall a. a -> a -> Range a
Range.constant Word64
0 Word64
maxCanonicalLovelaceVal)
        GenT Identity (Either LovelaceError Lovelace)
-> (Either LovelaceError Lovelace -> GenT Identity Lovelace)
-> GenT Identity Lovelace
forall a b.
GenT Identity a -> (a -> GenT Identity b) -> GenT Identity b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
          Right Lovelace
lovelace -> Lovelace -> GenT Identity Lovelace
forall a. a -> GenT Identity a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Lovelace
lovelace
          Left LovelaceError
err ->
            Text -> GenT Identity Lovelace
forall a. HasCallStack => Text -> a
panic
              (Text -> GenT Identity Lovelace) -> Text -> GenT Identity Lovelace
forall a b. (a -> b) -> a -> b
$ Format Text (LovelaceError -> Text) -> LovelaceError -> Text
forall a. Format Text a -> a
sformat
                (Format (LovelaceError -> Text) (LovelaceError -> Text)
"The impossible happened in genLovelace: " Format (LovelaceError -> Text) (LovelaceError -> Text)
-> Format Text (LovelaceError -> Text)
-> Format Text (LovelaceError -> Text)
forall b c a. Format b c -> Format a b -> Format a c
forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. Format Text (LovelaceError -> Text)
forall a r. Buildable a => Format r (a -> r)
build)
                LovelaceError
err

    maxCanonicalLovelaceVal :: Word64
    maxCanonicalLovelaceVal :: Word64
maxCanonicalLovelaceVal = Word64
9e6

genChainDifficulty :: Gen ChainDifficulty
genChainDifficulty :: Gen ChainDifficulty
genChainDifficulty = Word64 -> ChainDifficulty
ChainDifficulty (Word64 -> ChainDifficulty)
-> GenT Identity Word64 -> Gen ChainDifficulty
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Range Word64 -> GenT Identity Word64
forall (m :: * -> *). MonadGen m => Range Word64 -> m Word64
Gen.word64 Range Word64
forall a. (Bounded a, Num a) => Range a
Range.constantBounded

genCompactAddress :: Gen CompactAddress
genCompactAddress :: Gen CompactAddress
genCompactAddress = Address -> CompactAddress
toCompactAddress (Address -> CompactAddress) -> Gen Address -> Gen CompactAddress
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Gen Address
genAddress

genCustomLovelace :: Word64 -> Gen Lovelace
genCustomLovelace :: Word64 -> GenT Identity Lovelace
genCustomLovelace Word64
size = Range Word64 -> GenT Identity Lovelace
genLovelaceWithRange (Word64 -> Word64 -> Range Word64
forall a. Integral a => a -> a -> Range a
Range.linear Word64
0 Word64
size)

genLovelace :: Gen Lovelace
genLovelace :: GenT Identity Lovelace
genLovelace = Range Word64 -> GenT Identity Lovelace
genLovelaceWithRange (Word64 -> Word64 -> Range Word64
forall a. a -> a -> Range a
Range.constant Word64
0 Word64
maxLovelaceVal)

genLovelaceError :: Gen LovelaceError
genLovelaceError :: Gen LovelaceError
genLovelaceError =
  [Gen LovelaceError] -> Gen LovelaceError
forall (m :: * -> *) a. MonadGen m => [m a] -> m a
Gen.choice
    [ Word64 -> LovelaceError
LovelaceOverflow (Word64 -> LovelaceError)
-> GenT Identity Word64 -> Gen LovelaceError
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Range Word64 -> GenT Identity Word64
forall (m :: * -> *). MonadGen m => Range Word64 -> m Word64
Gen.word64 Range Word64
overflowRange
    , Integer -> LovelaceError
LovelaceTooLarge (Integer -> LovelaceError)
-> GenT Identity Integer -> Gen LovelaceError
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Range Integer -> GenT Identity Integer
forall (m :: * -> *) a. (MonadGen m, Integral a) => Range a -> m a
Gen.integral Range Integer
tooLargeRange
    , Integer -> LovelaceError
LovelaceTooSmall (Integer -> LovelaceError)
-> GenT Identity Integer -> Gen LovelaceError
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Range Integer -> GenT Identity Integer
forall (m :: * -> *) a. (MonadGen m, Integral a) => Range a -> m a
Gen.integral Range Integer
tooSmallRange
    , (Word64 -> Word64 -> LovelaceError)
-> (Word64, Word64) -> LovelaceError
forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry Word64 -> Word64 -> LovelaceError
LovelaceUnderflow ((Word64, Word64) -> LovelaceError)
-> GenT Identity (Word64, Word64) -> Gen LovelaceError
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> GenT Identity (Word64, Word64)
genUnderflowErrorValues
    ]
  where
    overflowRange :: Range Word64
    overflowRange :: Range Word64
overflowRange = Word64 -> Word64 -> Range Word64
forall a. a -> a -> Range a
Range.constant (Word64
maxLovelaceVal Word64 -> Word64 -> Word64
forall a. Num a => a -> a -> a
+ Word64
1) (Word64
forall a. Bounded a => a
maxBound :: Word64)

    tooLargeRange :: Range Integer
    tooLargeRange :: Range Integer
tooLargeRange =
      Integer -> Integer -> Range Integer
forall a. a -> a -> Range a
Range.constant
        (Word64 -> Integer
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Word64
maxLovelaceVal Word64 -> Word64 -> Word64
forall a. Num a => a -> a -> a
+ Word64
1))
        (Word64 -> Integer
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Word64
forall a. Bounded a => a
maxBound :: Word64))

    tooSmallRange :: Range Integer
    tooSmallRange :: Range Integer
tooSmallRange = Integer -> Integer -> Range Integer
forall a. a -> a -> Range a
Range.constant (Int -> Integer
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int
forall a. Bounded a => a
minBound :: Int)) (-Integer
1)

    genUnderflowErrorValues :: Gen (Word64, Word64)
    genUnderflowErrorValues :: GenT Identity (Word64, Word64)
genUnderflowErrorValues = do
      Word64
a <- Range Word64 -> GenT Identity Word64
forall (m :: * -> *). MonadGen m => Range Word64 -> m Word64
Gen.word64 (Word64 -> Word64 -> Range Word64
forall a. a -> a -> Range a
Range.constant Word64
0 (Word64
forall a. Bounded a => a
maxBound Word64 -> Word64 -> Word64
forall a. Num a => a -> a -> a
- Word64
1))
      Word64
b <- Range Word64 -> GenT Identity Word64
forall (m :: * -> *). MonadGen m => Range Word64 -> m Word64
Gen.word64 (Word64 -> Word64 -> Range Word64
forall a. a -> a -> Range a
Range.constant Word64
a Word64
forall a. Bounded a => a
maxBound)
      (Word64, Word64) -> GenT Identity (Word64, Word64)
forall a. a -> GenT Identity a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Word64
a, Word64
b)

genLovelaceWithRange :: Range Word64 -> Gen Lovelace
genLovelaceWithRange :: Range Word64 -> GenT Identity Lovelace
genLovelaceWithRange Range Word64
r =
  Word64 -> Either LovelaceError Lovelace
mkLovelace (Word64 -> Either LovelaceError Lovelace)
-> GenT Identity Word64
-> GenT Identity (Either LovelaceError Lovelace)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Range Word64 -> GenT Identity Word64
forall (m :: * -> *). MonadGen m => Range Word64 -> m Word64
Gen.word64 Range Word64
r GenT Identity (Either LovelaceError Lovelace)
-> (Either LovelaceError Lovelace -> GenT Identity Lovelace)
-> GenT Identity Lovelace
forall a b.
GenT Identity a -> (a -> GenT Identity b) -> GenT Identity b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
    Right Lovelace
lovelace -> Lovelace -> GenT Identity Lovelace
forall a. a -> GenT Identity a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Lovelace
lovelace
    Left LovelaceError
err ->
      Text -> GenT Identity Lovelace
forall a. HasCallStack => Text -> a
panic (Text -> GenT Identity Lovelace) -> Text -> GenT Identity Lovelace
forall a b. (a -> b) -> a -> b
$ Format Text (LovelaceError -> Text) -> LovelaceError -> Text
forall a. Format Text a -> a
sformat (Format (LovelaceError -> Text) (LovelaceError -> Text)
"The impossible happened in genLovelace: " Format (LovelaceError -> Text) (LovelaceError -> Text)
-> Format Text (LovelaceError -> Text)
-> Format Text (LovelaceError -> Text)
forall b c a. Format b c -> Format a b -> Format a c
forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. Format Text (LovelaceError -> Text)
forall a r. Buildable a => Format r (a -> r)
build) LovelaceError
err

genLovelacePortion :: Gen LovelacePortion
genLovelacePortion :: Gen LovelacePortion
genLovelacePortion =
  Rational -> LovelacePortion
rationalToLovelacePortion (Rational -> LovelacePortion)
-> (Double -> Rational) -> Double -> LovelacePortion
forall b c a. (b -> c) -> (a -> b) -> a -> c
forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. Double -> Rational
forall a b. (Real a, Fractional b) => a -> b
realToFrac (Double -> LovelacePortion)
-> GenT Identity Double -> Gen LovelacePortion
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Range Double -> GenT Identity Double
forall (m :: * -> *). MonadGen m => Range Double -> m Double
Gen.double (Double -> Double -> Range Double
forall a. a -> a -> Range a
Range.constant Double
0 Double
1)

-- slow
genMerkleTree :: EncCBOR a => Gen a -> Gen (MerkleTree a)
genMerkleTree :: forall a. EncCBOR a => Gen a -> Gen (MerkleTree a)
genMerkleTree Gen a
genA = [a] -> MerkleTree a
forall a. EncCBOR a => [a] -> MerkleTree a
mkMerkleTree ([a] -> MerkleTree a)
-> GenT Identity [a] -> GenT Identity (MerkleTree a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Range Int -> Gen a -> GenT Identity [a]
forall (m :: * -> *) a. MonadGen m => Range Int -> m a -> m [a]
Gen.list (Int -> Int -> Range Int
forall a. Integral a => a -> a -> Range a
Range.linear Int
0 Int
10) Gen a
genA

-- slow
genMerkleRoot :: EncCBOR a => Gen a -> Gen (MerkleRoot a)
genMerkleRoot :: forall a. EncCBOR a => Gen a -> Gen (MerkleRoot a)
genMerkleRoot Gen a
genA = MerkleTree a -> MerkleRoot a
forall a. MerkleTree a -> MerkleRoot a
mtRoot (MerkleTree a -> MerkleRoot a)
-> GenT Identity (MerkleTree a) -> GenT Identity (MerkleRoot a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Gen a -> GenT Identity (MerkleTree a)
forall a. EncCBOR a => Gen a -> Gen (MerkleTree a)
genMerkleTree Gen a
genA

genNetworkMagic :: Gen NetworkMagic
genNetworkMagic :: GenT Identity NetworkMagic
genNetworkMagic =
  [GenT Identity NetworkMagic] -> GenT Identity NetworkMagic
forall (m :: * -> *) a. MonadGen m => [m a] -> m a
Gen.choice
    [ NetworkMagic -> GenT Identity NetworkMagic
forall a. a -> GenT Identity a
forall (f :: * -> *) a. Applicative f => a -> f a
pure NetworkMagic
NetworkMainOrStage
    , Word32 -> NetworkMagic
NetworkTestnet (Word32 -> NetworkMagic)
-> GenT Identity Word32 -> GenT Identity NetworkMagic
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Range Word32 -> GenT Identity Word32
forall (m :: * -> *). MonadGen m => Range Word32 -> m Word32
Gen.word32 Range Word32
forall a. (Bounded a, Num a) => Range a
Range.constantBounded
    ]

genScriptVersion :: Gen Word16
genScriptVersion :: Gen Word16
genScriptVersion = Range Word16 -> Gen Word16
forall (m :: * -> *). MonadGen m => Range Word16 -> m Word16
Gen.word16 Range Word16
forall a. (Bounded a, Num a) => Range a
Range.constantBounded

genKeyHash :: Gen KeyHash
genKeyHash :: Gen KeyHash
genKeyHash = VerificationKey -> KeyHash
hashKey (VerificationKey -> KeyHash)
-> GenT Identity VerificationKey -> Gen KeyHash
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> GenT Identity VerificationKey
genVerificationKey

genTxFeePolicy :: Gen TxFeePolicy
genTxFeePolicy :: Gen TxFeePolicy
genTxFeePolicy = TxSizeLinear -> TxFeePolicy
TxFeePolicyTxSizeLinear (TxSizeLinear -> TxFeePolicy)
-> GenT Identity TxSizeLinear -> Gen TxFeePolicy
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> GenT Identity TxSizeLinear
genTxSizeLinear

genTxSizeLinear :: Gen TxSizeLinear
genTxSizeLinear :: GenT Identity TxSizeLinear
genTxSizeLinear = Lovelace -> Rational -> TxSizeLinear
TxSizeLinear (Lovelace -> Rational -> TxSizeLinear)
-> GenT Identity Lovelace
-> GenT Identity (Rational -> TxSizeLinear)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> GenT Identity Lovelace
genLovelace GenT Identity (Rational -> TxSizeLinear)
-> GenT Identity Rational -> GenT Identity TxSizeLinear
forall a b.
GenT Identity (a -> b) -> GenT Identity a -> GenT Identity b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> GenT Identity Rational
genMultiplier

-- | Generate multipliers for the TxSizeLinear.
genMultiplier :: Gen Rational
genMultiplier :: GenT Identity Rational
genMultiplier = Word16 -> Rational
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Word16 -> Rational) -> Gen Word16 -> GenT Identity Rational
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Range Word16 -> Gen Word16
forall (m :: * -> *). MonadGen m => Range Word16 -> m Word16
Gen.word16 (Word16 -> Word16 -> Range Word16
forall a. a -> a -> Range a
Range.constant Word16
0 Word16
1000)