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

module Test.Cardano.Ledger.Mary.Arbitrary (
  genMultiAssetCompletelyEmpty,
  genMultiAssetNestedEmpty,
  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, Tx (..), TxBody (MaryTxBody))
import Cardano.Ledger.Mary.Transition
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 TopTx MaryEra) where
  arbitrary :: Gen (TxBody TopTx MaryEra)
arbitrary =
    Set TxIn
-> StrictSeq (TxOut MaryEra)
-> StrictSeq (TxCert MaryEra)
-> Withdrawals
-> Coin
-> ValidityInterval
-> StrictMaybe (Update MaryEra)
-> StrictMaybe TxAuxDataHash
-> MultiAsset
-> TxBody TopTx MaryEra
Set TxIn
-> StrictSeq (ShelleyTxOut MaryEra)
-> StrictSeq (ShelleyTxCert MaryEra)
-> Withdrawals
-> Coin
-> ValidityInterval
-> StrictMaybe (Update MaryEra)
-> StrictMaybe TxAuxDataHash
-> MultiAsset
-> TxBody TopTx MaryEra
(EraTxOut MaryEra, EraTxCert MaryEra) =>
Set TxIn
-> StrictSeq (TxOut MaryEra)
-> StrictSeq (TxCert MaryEra)
-> Withdrawals
-> Coin
-> ValidityInterval
-> StrictMaybe (Update MaryEra)
-> StrictMaybe TxAuxDataHash
-> MultiAsset
-> TxBody TopTx MaryEra
MaryTxBody
      (Set TxIn
 -> StrictSeq (ShelleyTxOut MaryEra)
 -> StrictSeq (ShelleyTxCert MaryEra)
 -> Withdrawals
 -> Coin
 -> ValidityInterval
 -> StrictMaybe (Update MaryEra)
 -> StrictMaybe TxAuxDataHash
 -> MultiAsset
 -> TxBody TopTx MaryEra)
-> Gen (Set TxIn)
-> Gen
     (StrictSeq (ShelleyTxOut MaryEra)
      -> StrictSeq (ShelleyTxCert MaryEra)
      -> Withdrawals
      -> Coin
      -> ValidityInterval
      -> StrictMaybe (Update MaryEra)
      -> StrictMaybe TxAuxDataHash
      -> MultiAsset
      -> TxBody TopTx 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 TopTx MaryEra)
-> Gen (StrictSeq (ShelleyTxOut MaryEra))
-> Gen
     (StrictSeq (ShelleyTxCert MaryEra)
      -> Withdrawals
      -> Coin
      -> ValidityInterval
      -> StrictMaybe (Update MaryEra)
      -> StrictMaybe TxAuxDataHash
      -> MultiAsset
      -> TxBody TopTx 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 TopTx MaryEra)
-> Gen (StrictSeq (ShelleyTxCert MaryEra))
-> Gen
     (Withdrawals
      -> Coin
      -> ValidityInterval
      -> StrictMaybe (Update MaryEra)
      -> StrictMaybe TxAuxDataHash
      -> MultiAsset
      -> TxBody TopTx 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 TopTx MaryEra)
-> Gen Withdrawals
-> Gen
     (Coin
      -> ValidityInterval
      -> StrictMaybe (Update MaryEra)
      -> StrictMaybe TxAuxDataHash
      -> MultiAsset
      -> TxBody TopTx 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 TopTx MaryEra)
-> Gen Coin
-> Gen
     (ValidityInterval
      -> StrictMaybe (Update MaryEra)
      -> StrictMaybe TxAuxDataHash
      -> MultiAsset
      -> TxBody TopTx 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 TopTx MaryEra)
-> Gen ValidityInterval
-> Gen
     (StrictMaybe (Update MaryEra)
      -> StrictMaybe TxAuxDataHash -> MultiAsset -> TxBody TopTx 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 TopTx MaryEra)
-> Gen (StrictMaybe (Update MaryEra))
-> Gen
     (StrictMaybe TxAuxDataHash -> MultiAsset -> TxBody TopTx 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 TopTx MaryEra)
-> Gen (StrictMaybe TxAuxDataHash)
-> Gen (MultiAsset -> TxBody TopTx 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 TopTx MaryEra)
-> Gen MultiAsset -> Gen (TxBody TopTx 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
  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 isMultiAssetSmallEnough ma
    then pure ma
    else scale (`div` 2) $ genMultiAsset 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
  (numP, numA) <- do
    -- When numAssetNames > 1489 it is enough to have at least 1 policy id
    numAssetNames <- (Int, Int) -> Gen Int
chooseInt (Int
1, Int
1500)
    -- Make at least 1 policy id
    let 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)
    numPolicyIds <- (minNumPolicyIds +) . getPositive <$> arbitrary
    -- Ensure we have at least as many asset names as there are policy ids
    pure (numPolicyIds, max numPolicyIds 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.
  ps <- vectorOf numP genPolicyIDToFail
  as <-
    vectorOf numA $
      (,)
        <$> genAssetNameToFail
        <*> if isForMaryValue then getPositive @Int <$> arbitrary else getNonZero @Int <$> arbitrary
  let 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 = Int -> [(AssetName, Int)] -> [(AssetName, Int)]
forall a. Int -> [a] -> [a]
drop Int
numP [(AssetName, Int)]
as
  remainingTriples <-
    traverse
      ( \(AssetName
a, Int
v) -> do
          policy <- [PolicyID] -> Gen PolicyID
forall a. HasCallStack => [a] -> Gen a
elements [PolicyID]
ps -- For every remaining asset, randomly assign a policy
          pure (policy, a, v)
      )
      remainingAs
  let MultiAsset ma = multiAssetFromListBounded $ initialTriples <> remainingTriples
  -- Ensure that the large numbers aren't reduced due to duplicates.
  -- This is impossible in practice, since PRNG produces uniform values.
  if length ma == numP && sum (length <$> ma) == numA
    then pure $ MultiAsset ma
    else genMultiAssetToFail 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)
          ]

-- | Generate completely empty MultiAsset (empty top-level map)
-- This should succeed in Conway but fail in Dijkstra
genMultiAssetCompletelyEmpty :: Gen MultiAsset
genMultiAssetCompletelyEmpty :: Gen MultiAsset
genMultiAssetCompletelyEmpty = 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)
forall k a. Map k a
Map.empty

-- | Generate MultiAsset with non-empty top-level map but empty nested asset maps
-- This should fail in both Conway and Dijkstra
genMultiAssetNestedEmpty :: Gen MultiAsset
genMultiAssetNestedEmpty :: Gen MultiAsset
genMultiAssetNestedEmpty =
  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
  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
  ma <- genMA
  pure $ MaryValue (Coin i) 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) => 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

deriving newtype instance Arbitrary (TransitionConfig MaryEra)

deriving newtype instance Arbitrary (Tx TopTx MaryEra)