{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE RankNTypes #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE TypeApplications #-}
{-# LANGUAGE UndecidableInstances #-}
{-# LANGUAGE ViewPatterns #-}
{-# OPTIONS_GHC -Wno-orphans #-}

module Test.Cardano.Ledger.Mary.Arbitrary (
  genEmptyMultiAsset,
  genMaryValue,
  genMultiAsset,
  genMultiAssetToFail,
  genMultiAssetZero,
  genPositiveInt,
  genNegativeInt,
  genNonNegativeInt,
) where

import Cardano.Crypto.Hash.Class (castHash, hashWith)
import Cardano.Ledger.Coin
import Cardano.Ledger.Compactible
import Cardano.Ledger.Core
import Cardano.Ledger.Mary (MaryEra, TxBody (MaryTxBody))
import Cardano.Ledger.Mary.Value (
  AssetName (..),
  MaryValue (..),
  MultiAsset (..),
  PolicyID (..),
  isMultiAssetSmallEnough,
 )
import qualified Cardano.Ledger.Mary.Value as ConcreteValue
import Data.Int (Int64)
import qualified Data.Map.Strict as Map (empty)
import Data.Maybe (fromMaybe)
import Data.String (IsString (fromString))
import Test.Cardano.Data (genNonEmptyMap)
import Test.Cardano.Ledger.Allegra.Arbitrary ()
import Test.Cardano.Ledger.Binary.Arbitrary (genByteString, genShortByteString)
import Test.Cardano.Ledger.Common

instance Arbitrary AssetName where
  arbitrary :: Gen AssetName
arbitrary =
    ShortByteString -> AssetName
AssetName
      (ShortByteString -> AssetName)
-> Gen ShortByteString -> Gen AssetName
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [(Int, Gen ShortByteString)] -> Gen ShortByteString
forall a. HasCallStack => [(Int, Gen a)] -> Gen a
frequency
        [ (Int
3, [ShortByteString] -> Gen ShortByteString
forall a. HasCallStack => [a] -> Gen a
elements [ShortByteString]
forall s. IsString s => [s]
digitByteStrings)
        , (Int
7, Int -> Gen ShortByteString
genShortByteString (Int -> Gen ShortByteString) -> Gen Int -> Gen ShortByteString
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< (Int, Int) -> Gen Int
forall a. Random a => (a, a) -> Gen a
choose (Int
1, Int
32))
        ]

instance Arbitrary (TxBody MaryEra) where
  arbitrary :: Gen (TxBody MaryEra)
arbitrary =
    Set TxIn
-> StrictSeq (TxOut MaryEra)
-> StrictSeq (TxCert MaryEra)
-> Withdrawals
-> Coin
-> ValidityInterval
-> StrictMaybe (Update MaryEra)
-> StrictMaybe TxAuxDataHash
-> MultiAsset
-> TxBody MaryEra
Set TxIn
-> StrictSeq (ShelleyTxOut MaryEra)
-> StrictSeq (ShelleyTxCert MaryEra)
-> Withdrawals
-> Coin
-> ValidityInterval
-> StrictMaybe (Update MaryEra)
-> StrictMaybe TxAuxDataHash
-> MultiAsset
-> TxBody MaryEra
(EraTxOut MaryEra, EraTxCert MaryEra) =>
Set TxIn
-> StrictSeq (TxOut MaryEra)
-> StrictSeq (TxCert MaryEra)
-> Withdrawals
-> Coin
-> ValidityInterval
-> StrictMaybe (Update MaryEra)
-> StrictMaybe TxAuxDataHash
-> MultiAsset
-> TxBody MaryEra
MaryTxBody
      (Set TxIn
 -> StrictSeq (ShelleyTxOut MaryEra)
 -> StrictSeq (ShelleyTxCert MaryEra)
 -> Withdrawals
 -> Coin
 -> ValidityInterval
 -> StrictMaybe (Update MaryEra)
 -> StrictMaybe TxAuxDataHash
 -> MultiAsset
 -> TxBody MaryEra)
-> Gen (Set TxIn)
-> Gen
     (StrictSeq (ShelleyTxOut MaryEra)
      -> StrictSeq (ShelleyTxCert MaryEra)
      -> Withdrawals
      -> Coin
      -> ValidityInterval
      -> StrictMaybe (Update MaryEra)
      -> StrictMaybe TxAuxDataHash
      -> MultiAsset
      -> TxBody MaryEra)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Gen (Set TxIn)
forall a. Arbitrary a => Gen a
arbitrary
      Gen
  (StrictSeq (ShelleyTxOut MaryEra)
   -> StrictSeq (ShelleyTxCert MaryEra)
   -> Withdrawals
   -> Coin
   -> ValidityInterval
   -> StrictMaybe (Update MaryEra)
   -> StrictMaybe TxAuxDataHash
   -> MultiAsset
   -> TxBody MaryEra)
-> Gen (StrictSeq (ShelleyTxOut MaryEra))
-> Gen
     (StrictSeq (ShelleyTxCert MaryEra)
      -> Withdrawals
      -> Coin
      -> ValidityInterval
      -> StrictMaybe (Update MaryEra)
      -> StrictMaybe TxAuxDataHash
      -> MultiAsset
      -> TxBody MaryEra)
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 (ShelleyTxOut MaryEra))
forall a. Arbitrary a => Gen a
arbitrary
      Gen
  (StrictSeq (ShelleyTxCert MaryEra)
   -> Withdrawals
   -> Coin
   -> ValidityInterval
   -> StrictMaybe (Update MaryEra)
   -> StrictMaybe TxAuxDataHash
   -> MultiAsset
   -> TxBody MaryEra)
-> Gen (StrictSeq (ShelleyTxCert MaryEra))
-> Gen
     (Withdrawals
      -> Coin
      -> ValidityInterval
      -> StrictMaybe (Update MaryEra)
      -> StrictMaybe TxAuxDataHash
      -> MultiAsset
      -> TxBody MaryEra)
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 (ShelleyTxCert MaryEra))
forall a. Arbitrary a => Gen a
arbitrary
      Gen
  (Withdrawals
   -> Coin
   -> ValidityInterval
   -> StrictMaybe (Update MaryEra)
   -> StrictMaybe TxAuxDataHash
   -> MultiAsset
   -> TxBody MaryEra)
-> Gen Withdrawals
-> Gen
     (Coin
      -> ValidityInterval
      -> StrictMaybe (Update MaryEra)
      -> StrictMaybe TxAuxDataHash
      -> MultiAsset
      -> TxBody MaryEra)
forall a b. Gen (a -> b) -> Gen a -> Gen b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Gen Withdrawals
forall a. Arbitrary a => Gen a
arbitrary
      Gen
  (Coin
   -> ValidityInterval
   -> StrictMaybe (Update MaryEra)
   -> StrictMaybe TxAuxDataHash
   -> MultiAsset
   -> TxBody MaryEra)
-> Gen Coin
-> Gen
     (ValidityInterval
      -> StrictMaybe (Update MaryEra)
      -> StrictMaybe TxAuxDataHash
      -> MultiAsset
      -> TxBody MaryEra)
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
  (ValidityInterval
   -> StrictMaybe (Update MaryEra)
   -> StrictMaybe TxAuxDataHash
   -> MultiAsset
   -> TxBody MaryEra)
-> Gen ValidityInterval
-> Gen
     (StrictMaybe (Update MaryEra)
      -> StrictMaybe TxAuxDataHash -> MultiAsset -> TxBody MaryEra)
forall a b. Gen (a -> b) -> Gen a -> Gen b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Gen ValidityInterval
forall a. Arbitrary a => Gen a
arbitrary
      Gen
  (StrictMaybe (Update MaryEra)
   -> StrictMaybe TxAuxDataHash -> MultiAsset -> TxBody MaryEra)
-> Gen (StrictMaybe (Update MaryEra))
-> Gen (StrictMaybe TxAuxDataHash -> MultiAsset -> TxBody MaryEra)
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 (Update MaryEra))
forall a. Arbitrary a => Gen a
arbitrary
      Gen (StrictMaybe TxAuxDataHash -> MultiAsset -> TxBody MaryEra)
-> Gen (StrictMaybe TxAuxDataHash)
-> Gen (MultiAsset -> TxBody MaryEra)
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 TxAuxDataHash)
forall a. Arbitrary a => Gen a
arbitrary
      Gen (MultiAsset -> TxBody MaryEra)
-> Gen MultiAsset -> Gen (TxBody MaryEra)
forall a b. Gen (a -> b) -> Gen a -> Gen b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Gen MultiAsset
forall a. Arbitrary a => Gen a
arbitrary

-- | Variant on @multiAssetFromList@ that makes sure that generated values stay
-- bounded within the range of a given integral type.
multiAssetFromListBounded ::
  forall i.
  (Bounded i, Integral i) =>
  [(PolicyID, AssetName, i)] ->
  MultiAsset
multiAssetFromListBounded :: forall i.
(Bounded i, Integral i) =>
[(PolicyID, AssetName, i)] -> MultiAsset
multiAssetFromListBounded =
  ((PolicyID, AssetName, i) -> MultiAsset -> MultiAsset)
-> MultiAsset -> [(PolicyID, AssetName, i)] -> MultiAsset
forall a b. (a -> b -> b) -> b -> [a] -> b
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr
    (\(PolicyID
p, AssetName
n, i -> Integer
forall a b. (Integral a, Num b) => a -> b
fromIntegral -> Integer
i) MultiAsset
ans -> (Integer -> Integer -> Integer)
-> PolicyID -> AssetName -> Integer -> MultiAsset -> MultiAsset
ConcreteValue.insertMultiAsset Integer -> Integer -> Integer
comb PolicyID
p AssetName
n Integer
i MultiAsset
ans)
    MultiAsset
forall a. Monoid a => a
mempty
  where
    comb :: Integer -> Integer -> Integer
    comb :: Integer -> Integer -> Integer
comb Integer
a Integer
b =
      Integer -> Integer -> Integer
forall a. Ord a => a -> a -> a
max
        (i -> Integer
forall a b. (Integral a, Num b) => a -> b
fromIntegral (i -> Integer) -> i -> Integer
forall a b. (a -> b) -> a -> b
$ forall a. Bounded a => a
minBound @i)
        (Integer -> Integer -> Integer
forall a. Ord a => a -> a -> a
min (i -> Integer
forall a b. (Integral a, Num b) => a -> b
fromIntegral (i -> Integer) -> i -> Integer
forall a b. (a -> b) -> a -> b
$ forall a. Bounded a => a
maxBound @i) (Integer
a Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
+ Integer
b))

instance Arbitrary PolicyID where
  arbitrary :: Gen PolicyID
arbitrary =
    ScriptHash -> PolicyID
PolicyID (ScriptHash -> PolicyID)
-> (Hash ADDRHASH EraIndependentScript -> ScriptHash)
-> Hash ADDRHASH EraIndependentScript
-> PolicyID
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Hash ADDRHASH EraIndependentScript -> ScriptHash
ScriptHash
      (Hash ADDRHASH EraIndependentScript -> PolicyID)
-> Gen (Hash ADDRHASH EraIndependentScript) -> Gen PolicyID
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [Gen (Hash ADDRHASH EraIndependentScript)]
-> Gen (Hash ADDRHASH EraIndependentScript)
forall a. HasCallStack => [Gen a] -> Gen a
oneof
        [ Gen (Hash ADDRHASH EraIndependentScript)
forall a. Arbitrary a => Gen a
arbitrary
        , [Hash ADDRHASH EraIndependentScript]
-> Gen (Hash ADDRHASH EraIndependentScript)
forall a. HasCallStack => [a] -> Gen a
elements [Hash ADDRHASH EraIndependentScript]
forall h a. HashAlgorithm h => [Hash h a]
hashOfDigitByteStrings
        ]

genMultiAssetTriple :: Gen Int64 -> Gen (PolicyID, AssetName, Int64)
genMultiAssetTriple :: Gen Int64 -> Gen (PolicyID, AssetName, Int64)
genMultiAssetTriple Gen Int64
genAmount = (,,) (PolicyID -> AssetName -> Int64 -> (PolicyID, AssetName, Int64))
-> Gen PolicyID
-> Gen (AssetName -> Int64 -> (PolicyID, AssetName, Int64))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Gen PolicyID
forall a. Arbitrary a => Gen a
arbitrary Gen (AssetName -> Int64 -> (PolicyID, AssetName, Int64))
-> Gen AssetName -> Gen (Int64 -> (PolicyID, AssetName, Int64))
forall a b. Gen (a -> b) -> Gen a -> Gen b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Gen AssetName
forall a. Arbitrary a => Gen a
arbitrary Gen (Int64 -> (PolicyID, AssetName, Int64))
-> Gen Int64 -> Gen (PolicyID, AssetName, Int64)
forall a b. Gen (a -> b) -> Gen a -> Gen b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Gen Int64
genAmount

-- When we generate a number of MultiAssets all at once, that number happens to have
-- an implicit upper limit due to the Cardano.Ledger.Mary.Value.{to,from}-based
-- compacting operation. This operation is also performed when we serialise to and from CBOR.
--
-- Refering to the haddock for 'Cardano.Ledger.Mary.Value.to' we surmise that
--   1. The offsets for AssetName and PolicyID are stored as Word16 (maxBound = 65535).
--   2. All offsets (including those for AssetName and PolicyID) are relative to the whole
--      of the representation (binary blob) rather than the start of their respective regions.
--   3. If the offsets exceed their maxBounds, they will overflow.
--   4. So, we need to ensure that at least the last of the offsets (AssetName offsets) do
--      not exceed 65535.
--   5. With `n` as the total number of assets, `p` the number of policy ids, the inequality to be satisfied is thus:
--           8n -- Word64 asset quantities
--        +  2n -- Word16 policy id offsets
--        +  2n -- Word16 asset name offsets
--        + 28p -- 28-byte policy ids
--        + 32n -- 32-byte asset names (a maximum of 32 bytes)
--        should be <= 65535, assuming the numer of policies to be maximal (i.e. equal to number of assets)
--        65535 / 72 ~ 910.2 is the maximum number of triples to be safely generated.
--        Or, in other words, 44n + 28p <= 65535
--
-- NOTE: There are some conditions due to which exceeding this number may not
-- result in a guaranteed failure to compact without overflow, because, during compacting
--   1. The asset names and policy ids are deduplicated
--   2. Not all generated asset names are 32-bytes long
-- But, exceeding this number does make the probability of causing overflow > 0.
genMultiAsset :: Gen Integer -> Gen MultiAsset
genMultiAsset :: Gen Integer -> Gen MultiAsset
genMultiAsset Gen Integer
genAmount = do
  MultiAsset
ma <-
    [Gen MultiAsset] -> Gen MultiAsset
forall a. HasCallStack => [Gen a] -> Gen a
oneof
      [ Map PolicyID (Map AssetName Integer) -> MultiAsset
MultiAsset (Map PolicyID (Map AssetName Integer) -> MultiAsset)
-> Gen (Map PolicyID (Map AssetName Integer)) -> Gen MultiAsset
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Gen PolicyID
-> Gen (Map AssetName Integer)
-> Gen (Map PolicyID (Map AssetName Integer))
forall k v. Ord k => Gen k -> Gen v -> Gen (Map k v)
genNonEmptyMap Gen PolicyID
forall a. Arbitrary a => Gen a
arbitrary (Gen AssetName -> Gen Integer -> Gen (Map AssetName Integer)
forall k v. Ord k => Gen k -> Gen v -> Gen (Map k v)
genNonEmptyMap Gen AssetName
forall a. Arbitrary a => Gen a
arbitrary Gen Integer
genAmount)
      , [(PolicyID, AssetName, Int64)] -> MultiAsset
forall i.
(Bounded i, Integral i) =>
[(PolicyID, AssetName, i)] -> MultiAsset
multiAssetFromListBounded ([(PolicyID, AssetName, Int64)] -> MultiAsset)
-> Gen [(PolicyID, AssetName, Int64)] -> Gen MultiAsset
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Gen (PolicyID, AssetName, Int64)
-> Gen [(PolicyID, AssetName, Int64)]
forall a. Gen a -> Gen [a]
listOf1 (Gen Int64 -> Gen (PolicyID, AssetName, Int64)
genMultiAssetTriple (Gen Int64 -> Gen (PolicyID, AssetName, Int64))
-> Gen Int64 -> Gen (PolicyID, AssetName, Int64)
forall a b. (a -> b) -> a -> b
$ Integer -> Int64
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Integer -> Int64) -> Gen Integer -> Gen Int64
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Gen Integer
genAmount)
      ]
  if MultiAsset -> Bool
isMultiAssetSmallEnough MultiAsset
ma
    then MultiAsset -> Gen MultiAsset
forall a. a -> Gen a
forall (f :: * -> *) a. Applicative f => a -> f a
pure MultiAsset
ma
    else (Int -> Int) -> Gen MultiAsset -> Gen MultiAsset
forall a. (Int -> Int) -> Gen a -> Gen a
scale (Int -> Int -> Int
forall a. Integral a => a -> a -> a
`div` Int
2) (Gen MultiAsset -> Gen MultiAsset)
-> Gen MultiAsset -> Gen MultiAsset
forall a b. (a -> b) -> a -> b
$ Gen Integer -> Gen MultiAsset
genMultiAsset Gen Integer
genAmount

-- | For tests, because `insertMultiAsset` called through `genMultiAsset` filters out zero values
genMultiAssetZero :: Gen MultiAsset
genMultiAssetZero :: Gen MultiAsset
genMultiAssetZero = Map PolicyID (Map AssetName Integer) -> MultiAsset
MultiAsset (Map PolicyID (Map AssetName Integer) -> MultiAsset)
-> Gen (Map PolicyID (Map AssetName Integer)) -> Gen MultiAsset
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Gen PolicyID
-> Gen (Map AssetName Integer)
-> Gen (Map PolicyID (Map AssetName Integer))
forall k v. Ord k => Gen k -> Gen v -> Gen (Map k v)
genNonEmptyMap Gen PolicyID
forall a. Arbitrary a => Gen a
arbitrary (Gen AssetName -> Gen Integer -> Gen (Map AssetName Integer)
forall k v. Ord k => Gen k -> Gen v -> Gen (Map k v)
genNonEmptyMap Gen AssetName
forall a. Arbitrary a => Gen a
arbitrary (Integer -> Gen Integer
forall a. a -> Gen a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Integer
0))

-- For negative tests, we need a definite generator that will produce just large-enough MultiAssets
-- that will fail decoding, but not large-enough to consume too much resource.
-- The first Bool argument indicates whether the generation is for use in a MaryValue (MaryValue MultiAssets have Positive values)
genMultiAssetToFail :: Bool -> Gen MultiAsset
genMultiAssetToFail :: Bool -> Gen MultiAsset
genMultiAssetToFail Bool
isForMaryValue = do
  let genAssetNameToFail :: Gen AssetName
genAssetNameToFail = ShortByteString -> AssetName
AssetName (ShortByteString -> AssetName)
-> Gen ShortByteString -> Gen AssetName
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Int -> Gen ShortByteString
genShortByteString Int
32
      genPolicyIDToFail :: Gen PolicyID
genPolicyIDToFail = ScriptHash -> PolicyID
PolicyID (ScriptHash -> PolicyID)
-> (ByteString -> ScriptHash) -> ByteString -> PolicyID
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Hash ADDRHASH EraIndependentScript -> ScriptHash
ScriptHash (Hash ADDRHASH EraIndependentScript -> ScriptHash)
-> (ByteString -> Hash ADDRHASH EraIndependentScript)
-> ByteString
-> ScriptHash
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Hash ADDRHASH ByteString -> Hash ADDRHASH EraIndependentScript
forall h a b. Hash h a -> Hash h b
castHash (Hash ADDRHASH ByteString -> Hash ADDRHASH EraIndependentScript)
-> (ByteString -> Hash ADDRHASH ByteString)
-> ByteString
-> Hash ADDRHASH EraIndependentScript
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (ByteString -> ByteString)
-> ByteString -> Hash ADDRHASH ByteString
forall h a. HashAlgorithm h => (a -> ByteString) -> a -> Hash h a
hashWith ByteString -> ByteString
forall a. a -> a
id (ByteString -> PolicyID) -> Gen ByteString -> Gen PolicyID
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Int -> Gen ByteString
genByteString Int
28
  (Int
numP, Int
numA) <- do
    -- When numAssetNames > 1489 it is enough to have at least 1 policy id
    Int
numAssetNames <- (Int, Int) -> Gen Int
chooseInt (Int
1, Int
1500)
    -- Make at least 1 policy id
    let minNumPolicyIds :: Int
minNumPolicyIds = Int -> Int -> Int
forall a. Ord a => a -> a -> a
max Int
0 ((Int
65535 Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
44 Int -> Int -> Int
forall a. Num a => a -> a -> a
* Int
numAssetNames) Int -> Int -> Int
forall a. Integral a => a -> a -> a
`div` Int
28)
    Int
numPolicyIds <- (Int
minNumPolicyIds Int -> Int -> Int
forall a. Num a => a -> a -> a
+) (Int -> Int) -> (Positive Int -> Int) -> Positive Int -> Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Positive Int -> Int
forall a. Positive a -> a
getPositive (Positive Int -> Int) -> Gen (Positive Int) -> Gen Int
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Gen (Positive Int)
forall a. Arbitrary a => Gen a
arbitrary
    -- Ensure we have at least as many asset names as there are policy ids
    (Int, Int) -> Gen (Int, Int)
forall a. a -> Gen a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Int
numPolicyIds, Int -> Int -> Int
forall a. Ord a => a -> a -> a
max Int
numPolicyIds Int
numAssetNames)

  -- Here we generate separately a list of asset names and a list of policy ids and
  -- randomly shuffle them into a MultiAsset, ensuring that each policy has at least one asset.
  [PolicyID]
ps <- Int -> Gen PolicyID -> Gen [PolicyID]
forall a. Int -> Gen a -> Gen [a]
vectorOf Int
numP Gen PolicyID
genPolicyIDToFail
  [(AssetName, Int)]
as <-
    Int -> Gen (AssetName, Int) -> Gen [(AssetName, Int)]
forall a. Int -> Gen a -> Gen [a]
vectorOf Int
numA (Gen (AssetName, Int) -> Gen [(AssetName, Int)])
-> Gen (AssetName, Int) -> Gen [(AssetName, Int)]
forall a b. (a -> b) -> a -> b
$
      (,)
        (AssetName -> Int -> (AssetName, Int))
-> Gen AssetName -> Gen (Int -> (AssetName, Int))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Gen AssetName
genAssetNameToFail
        Gen (Int -> (AssetName, Int)) -> Gen Int -> Gen (AssetName, Int)
forall a b. Gen (a -> b) -> Gen a -> Gen b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> if Bool
isForMaryValue then forall a. Positive a -> a
getPositive @Int (Positive Int -> Int) -> Gen (Positive Int) -> Gen Int
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Gen (Positive Int)
forall a. Arbitrary a => Gen a
arbitrary else forall a. NonZero a -> a
getNonZero @Int (NonZero Int -> Int) -> Gen (NonZero Int) -> Gen Int
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Gen (NonZero Int)
forall a. Arbitrary a => Gen a
arbitrary
  let initialTriples :: [(PolicyID, AssetName, Int)]
initialTriples = (PolicyID -> (AssetName, Int) -> (PolicyID, AssetName, Int))
-> [PolicyID] -> [(AssetName, Int)] -> [(PolicyID, AssetName, Int)]
forall a b c. (a -> b -> c) -> [a] -> [b] -> [c]
zipWith (\PolicyID
p (AssetName
a, Int
v) -> (PolicyID
p, AssetName
a, Int
v)) [PolicyID]
ps [(AssetName, Int)]
as -- All policies should have at least one asset
      remainingAs :: [(AssetName, Int)]
remainingAs = Int -> [(AssetName, Int)] -> [(AssetName, Int)]
forall a. Int -> [a] -> [a]
drop Int
numP [(AssetName, Int)]
as
  [(PolicyID, AssetName, Int)]
remainingTriples <-
    ((AssetName, Int) -> Gen (PolicyID, AssetName, Int))
-> [(AssetName, Int)] -> Gen [(PolicyID, AssetName, Int)]
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> [a] -> f [b]
traverse
      ( \(AssetName
a, Int
v) -> do
          PolicyID
policy <- [PolicyID] -> Gen PolicyID
forall a. HasCallStack => [a] -> Gen a
elements [PolicyID]
ps -- For every remaining asset, randomly assign a policy
          (PolicyID, AssetName, Int) -> Gen (PolicyID, AssetName, Int)
forall a. a -> Gen a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (PolicyID
policy, AssetName
a, Int
v)
      )
      [(AssetName, Int)]
remainingAs
  let MultiAsset Map PolicyID (Map AssetName Integer)
ma = [(PolicyID, AssetName, Int)] -> MultiAsset
forall i.
(Bounded i, Integral i) =>
[(PolicyID, AssetName, i)] -> MultiAsset
multiAssetFromListBounded ([(PolicyID, AssetName, Int)] -> MultiAsset)
-> [(PolicyID, AssetName, Int)] -> MultiAsset
forall a b. (a -> b) -> a -> b
$ [(PolicyID, AssetName, Int)]
initialTriples [(PolicyID, AssetName, Int)]
-> [(PolicyID, AssetName, Int)] -> [(PolicyID, AssetName, Int)]
forall a. Semigroup a => a -> a -> a
<> [(PolicyID, AssetName, Int)]
remainingTriples
  -- Ensure that the large numbers aren't reduced due to duplicates.
  -- This is impossible in practice, since PRNG produces uniform values.
  if Map PolicyID (Map AssetName Integer) -> Int
forall a. Map PolicyID a -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length Map PolicyID (Map AssetName Integer)
ma Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
numP Bool -> Bool -> Bool
&& Map PolicyID Int -> Int
forall a. Num a => Map PolicyID a -> a
forall (t :: * -> *) a. (Foldable t, Num a) => t a -> a
sum (Map AssetName Integer -> Int
forall a. Map AssetName a -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length (Map AssetName Integer -> Int)
-> Map PolicyID (Map AssetName Integer) -> Map PolicyID Int
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Map PolicyID (Map AssetName Integer)
ma) Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
numA
    then MultiAsset -> Gen MultiAsset
forall a. a -> Gen a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (MultiAsset -> Gen MultiAsset) -> MultiAsset -> Gen MultiAsset
forall a b. (a -> b) -> a -> b
$ Map PolicyID (Map AssetName Integer) -> MultiAsset
MultiAsset Map PolicyID (Map AssetName Integer)
ma
    else Bool -> Gen MultiAsset
genMultiAssetToFail Bool
isForMaryValue

instance Arbitrary MultiAsset where
  arbitrary :: Gen MultiAsset
arbitrary =
    Gen Integer -> Gen MultiAsset
genMultiAsset (Gen Integer -> Gen MultiAsset) -> Gen Integer -> Gen MultiAsset
forall a b. (a -> b) -> a -> b
$
      Int -> Integer
forall a. Integral a => a -> Integer
toInteger
        (Int -> Integer) -> Gen Int -> Gen Integer
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [Gen Int] -> Gen Int
forall a. HasCallStack => [Gen a] -> Gen a
oneof
          [ (Int, Int) -> Gen Int
forall a. Random a => (a, a) -> Gen a
choose (Int
1 :: Int, Int
forall a. Bounded a => a
maxBound)
          , (Int, Int) -> Gen Int
forall a. Random a => (a, a) -> Gen a
choose (Int
forall a. Bounded a => a
minBound :: Int, -Int
1)
          ]

genEmptyMultiAsset :: Gen MultiAsset
genEmptyMultiAsset :: Gen MultiAsset
genEmptyMultiAsset =
  Map PolicyID (Map AssetName Integer) -> MultiAsset
MultiAsset (Map PolicyID (Map AssetName Integer) -> MultiAsset)
-> Gen (Map PolicyID (Map AssetName Integer)) -> Gen MultiAsset
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Gen PolicyID
-> Gen (Map AssetName Integer)
-> Gen (Map PolicyID (Map AssetName Integer))
forall k v. Ord k => Gen k -> Gen v -> Gen (Map k v)
genNonEmptyMap Gen PolicyID
forall a. Arbitrary a => Gen a
arbitrary (Map AssetName Integer -> Gen (Map AssetName Integer)
forall a. a -> Gen a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Map AssetName Integer
forall k a. Map k a
Map.empty)

-- | Better generator for a Non-Negative Int that explores more values
genNonNegativeInt :: Gen Int
genNonNegativeInt :: Gen Int
genNonNegativeInt =
  [Gen Int] -> Gen Int
forall a. HasCallStack => [Gen a] -> Gen a
oneof
    [ (Int, Int) -> Gen Int
forall a. Random a => (a, a) -> Gen a
choose (Int
0, Int
forall a. Bounded a => a
maxBound)
    , NonNegative Int -> Int
forall a. NonNegative a -> a
getNonNegative (NonNegative Int -> Int) -> Gen (NonNegative Int) -> Gen Int
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Gen (NonNegative Int)
forall a. Arbitrary a => Gen a
arbitrary
    ]

-- | Better generator for a positive Int that explores more values
genPositiveInt :: Gen Int
genPositiveInt :: Gen Int
genPositiveInt =
  [Gen Int] -> Gen Int
forall a. HasCallStack => [Gen a] -> Gen a
oneof
    [ (Int, Int) -> Gen Int
forall a. Random a => (a, a) -> Gen a
choose (Int
1, Int
forall a. Bounded a => a
maxBound)
    , Positive Int -> Int
forall a. Positive a -> a
getPositive (Positive Int -> Int) -> Gen (Positive Int) -> Gen Int
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Gen (Positive Int)
forall a. Arbitrary a => Gen a
arbitrary
    ]

-- | Better generator for a Negative Int that explores more values
genNegativeInt :: Gen Int
genNegativeInt :: Gen Int
genNegativeInt =
  [Gen Int] -> Gen Int
forall a. HasCallStack => [Gen a] -> Gen a
oneof
    [ (Int, Int) -> Gen Int
forall a. Random a => (a, a) -> Gen a
choose (Int
forall a. Bounded a => a
minBound, -Int
1)
    , Int -> Int
forall a. Num a => a -> a
negate (Int -> Int) -> (Positive Int -> Int) -> Positive Int -> Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Positive Int -> Int
forall a. Positive a -> a
getPositive (Positive Int -> Int) -> Gen (Positive Int) -> Gen Int
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Gen (Positive Int)
forall a. Arbitrary a => Gen a
arbitrary
    ]

genMaryValue :: Gen MultiAsset -> Gen MaryValue
genMaryValue :: Gen MultiAsset -> Gen MaryValue
genMaryValue Gen MultiAsset
genMA = do
  Integer
i <- Int -> Integer
forall a. Integral a => a -> Integer
toInteger (Int -> Integer) -> Gen Int -> Gen Integer
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Gen Int
genNonNegativeInt
  MultiAsset
ma <- Gen MultiAsset
genMA
  MaryValue -> Gen MaryValue
forall a. a -> Gen a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (MaryValue -> Gen MaryValue) -> MaryValue -> Gen MaryValue
forall a b. (a -> b) -> a -> b
$ Coin -> MultiAsset -> MaryValue
MaryValue (Integer -> Coin
Coin Integer
i) MultiAsset
ma

instance Arbitrary MaryValue where
  arbitrary :: Gen MaryValue
arbitrary =
    Gen MultiAsset -> Gen MaryValue
genMaryValue (Gen MultiAsset -> Gen MaryValue)
-> Gen MultiAsset -> Gen MaryValue
forall a b. (a -> b) -> a -> b
$ Gen Integer -> Gen MultiAsset
genMultiAsset (Gen Integer -> Gen MultiAsset) -> Gen Integer -> Gen MultiAsset
forall a b. (a -> b) -> a -> b
$ Int -> Integer
forall a. Integral a => a -> Integer
toInteger (Int -> Integer) -> Gen Int -> Gen Integer
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Gen Int
genPositiveInt

instance Arbitrary (CompactForm MaryValue) where
  arbitrary :: Gen (CompactForm MaryValue)
arbitrary = MaryValue -> CompactForm MaryValue
forall {a}.
(Compactible a, Show a, Typeable a) =>
a -> CompactForm a
toCompactMaryValue (MaryValue -> CompactForm MaryValue)
-> Gen MaryValue -> Gen (CompactForm MaryValue)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Gen MaryValue
forall a. Arbitrary a => Gen a
arbitrary
    where
      toCompactMaryValue :: a -> CompactForm a
toCompactMaryValue a
v =
        CompactForm a -> Maybe (CompactForm a) -> CompactForm a
forall a. a -> Maybe a -> a
fromMaybe ([Char] -> CompactForm a
forall a. HasCallStack => [Char] -> a
error ([Char] -> CompactForm a) -> [Char] -> CompactForm a
forall a b. (a -> b) -> a -> b
$ [Char]
"Could not compact the value: " [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ a -> [Char]
forall a. Show a => a -> [Char]
show a
v) (Maybe (CompactForm a) -> CompactForm a)
-> Maybe (CompactForm a) -> CompactForm a
forall a b. (a -> b) -> a -> b
$ a -> Maybe (CompactForm a)
forall a. Compactible a => a -> Maybe (CompactForm a)
toCompact a
v

digitByteStrings :: IsString s => [s]
digitByteStrings :: forall s. IsString s => [s]
digitByteStrings = [[Char] -> s
forall a. IsString a => [Char] -> a
fromString [Char
x] | Char
x <- [Char
'0' .. Char
'9']]

hashOfDigitByteStrings :: HashAlgorithm h => [Hash h a]
hashOfDigitByteStrings :: forall h a. HashAlgorithm h => [Hash h a]
hashOfDigitByteStrings = Hash h ByteString -> Hash h a
forall h a b. Hash h a -> Hash h b
castHash (Hash h ByteString -> Hash h a)
-> (ByteString -> Hash h ByteString) -> ByteString -> Hash h a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (ByteString -> ByteString) -> ByteString -> Hash h ByteString
forall h a. HashAlgorithm h => (a -> ByteString) -> a -> Hash h a
hashWith ByteString -> ByteString
forall a. a -> a
id (ByteString -> Hash h a) -> [ByteString] -> [Hash h a]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [ByteString]
forall s. IsString s => [s]
digitByteStrings