{-# 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 forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< Gen NetworkMagic
genNetworkMagic

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

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

genAddress :: Gen Address
genAddress :: Gen Address
genAddress = AddrSpendingData -> AddrAttributes -> Address
makeAddress forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Gen AddrSpendingData
genAddrSpendingData 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
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Gen AddrSpendingData
genAddrSpendingData
    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 = forall (m :: * -> *) a. MonadGen m => [m a] -> m a
Gen.choice [forall (f :: * -> *) a. Applicative f => a -> f a
pure AddrType
ATVerKey, forall (f :: * -> *) a. Applicative f => a -> f a
pure AddrType
ATRedeem]

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

genAttributes :: Gen a -> Gen (Attributes a)
genAttributes :: forall a. Gen a -> Gen (Attributes a)
genAttributes Gen a
genA = forall h. h -> Attributes h
mkAttributes 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 forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (m :: * -> *). MonadGen m => Range Word64 -> m Word64
Gen.word64 forall a. (Bounded a, Num a) => Range a
Range.constantBounded

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

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

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

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

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

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

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

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

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

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

genLovelacePortion :: Gen LovelacePortion
genLovelacePortion :: Gen LovelacePortion
genLovelacePortion =
  Rational -> LovelacePortion
rationalToLovelacePortion forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. forall a b. (Real a, Fractional b) => a -> b
realToFrac forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (m :: * -> *). MonadGen m => Range Double -> m Double
Gen.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 = forall a. EncCBOR a => [a] -> MerkleTree a
mkMerkleTree forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (m :: * -> *) a. MonadGen m => Range Int -> m a -> m [a]
Gen.list (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 = forall a. MerkleTree a -> MerkleRoot a
mtRoot forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall a. EncCBOR a => Gen a -> Gen (MerkleTree a)
genMerkleTree Gen a
genA

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

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

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

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

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

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