{-# 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.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.Maybe.Strict (StrictMaybe)
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
      forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall a. HasCallStack => [(Int, Gen a)] -> Gen a
frequency
        [ (Int
3, forall a. HasCallStack => [a] -> Gen a
elements forall s. IsString s => [s]
digitByteStrings)
        , (Int
7, Int -> Gen ShortByteString
genShortByteString forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< forall a. Random a => (a, a) -> Gen a
choose (Int
1, Int
32))
        ]

instance
  ( EraTxOut era
  , EraTxCert era
  , Era era
  , Arbitrary (TxOut era)
  , Arbitrary (PParamsHKD StrictMaybe era)
  , Arbitrary (TxCert era)
  ) =>
  Arbitrary (MaryTxBody era)
  where
  arbitrary :: Gen (MaryTxBody era)
arbitrary =
    forall era.
(EraTxOut era, EraTxCert era) =>
Set TxIn
-> StrictSeq (TxOut era)
-> StrictSeq (TxCert era)
-> Withdrawals
-> Coin
-> ValidityInterval
-> StrictMaybe (Update era)
-> StrictMaybe TxAuxDataHash
-> MultiAsset
-> MaryTxBody era
MaryTxBody
      forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall a. Arbitrary a => Gen a
arbitrary
      forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall a. Arbitrary a => Gen a
arbitrary
      forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall a. Arbitrary a => Gen a
arbitrary
      forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall a. Arbitrary a => Gen a
arbitrary
      forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall a. Arbitrary a => Gen a
arbitrary
      forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall a. Arbitrary a => Gen a
arbitrary
      forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall a. Arbitrary a => Gen a
arbitrary
      forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall a. Arbitrary a => Gen a
arbitrary
      forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> 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 =
  forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr
    (\(PolicyID
p, AssetName
n, 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)
    forall a. Monoid a => a
mempty
  where
    comb :: Integer -> Integer -> Integer
    comb :: Integer -> Integer -> Integer
comb Integer
a Integer
b =
      forall a. Ord a => a -> a -> a
max
        (forall a b. (Integral a, Num b) => a -> b
fromIntegral forall a b. (a -> b) -> a -> b
$ forall a. Bounded a => a
minBound @i)
        (forall a. Ord a => a -> a -> a
min (forall a b. (Integral a, Num b) => a -> b
fromIntegral forall a b. (a -> b) -> a -> b
$ forall a. Bounded a => a
maxBound @i) (Integer
a forall a. Num a => a -> a -> a
+ Integer
b))

instance Arbitrary PolicyID where
  arbitrary :: Gen PolicyID
arbitrary =
    ScriptHash -> PolicyID
PolicyID forall b c a. (b -> c) -> (a -> b) -> a -> c
. Hash ADDRHASH EraIndependentScript -> ScriptHash
ScriptHash
      forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall a. HasCallStack => [Gen a] -> Gen a
oneof
        [ forall a. Arbitrary a => Gen a
arbitrary
        , forall a. HasCallStack => [a] -> Gen a
elements 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 = (,,) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall a. Arbitrary a => Gen a
arbitrary forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall a. Arbitrary a => Gen a
arbitrary 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 <-
    forall a. HasCallStack => [Gen a] -> Gen a
oneof
      [ Map PolicyID (Map AssetName Integer) -> MultiAsset
MultiAsset forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall k v. Ord k => Gen k -> Gen v -> Gen (Map k v)
genNonEmptyMap forall a. Arbitrary a => Gen a
arbitrary (forall k v. Ord k => Gen k -> Gen v -> Gen (Map k v)
genNonEmptyMap forall a. Arbitrary a => Gen a
arbitrary Gen Integer
genAmount)
      , forall i.
(Bounded i, Integral i) =>
[(PolicyID, AssetName, i)] -> MultiAsset
multiAssetFromListBounded forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall a. Gen a -> Gen [a]
listOf1 (Gen Int64 -> Gen (PolicyID, AssetName, Int64)
genMultiAssetTriple forall a b. (a -> b) -> a -> b
$ forall a b. (Integral a, Num b) => a -> b
fromIntegral forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Gen Integer
genAmount)
      ]
  if MultiAsset -> Bool
isMultiAssetSmallEnough MultiAsset
ma
    then forall (f :: * -> *) a. Applicative f => a -> f a
pure MultiAsset
ma
    else forall a. (Int -> Int) -> Gen a -> Gen a
scale (forall a. Integral a => a -> a -> a
`div` Int
2) 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 forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall k v. Ord k => Gen k -> Gen v -> Gen (Map k v)
genNonEmptyMap forall a. Arbitrary a => Gen a
arbitrary (forall k v. Ord k => Gen k -> Gen v -> Gen (Map k v)
genNonEmptyMap forall a. Arbitrary a => Gen a
arbitrary (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 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 forall b c a. (b -> c) -> (a -> b) -> a -> c
. Hash ADDRHASH EraIndependentScript -> ScriptHash
ScriptHash forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall h a b. Hash h a -> Hash h b
castHash forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall h a. HashAlgorithm h => (a -> ByteString) -> a -> Hash h a
hashWith forall a. a -> a
id 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 = forall a. Ord a => a -> a -> a
max Int
0 ((Int
65535 forall a. Num a => a -> a -> a
- Int
44 forall a. Num a => a -> a -> a
* Int
numAssetNames) forall a. Integral a => a -> a -> a
`div` Int
28)
    Int
numPolicyIds <- (Int
minNumPolicyIds forall a. Num a => a -> a -> a
+) forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Positive a -> a
getPositive forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall a. Arbitrary a => Gen a
arbitrary
    -- Ensure we have at least as many asset names as there are policy ids
    forall (f :: * -> *) a. Applicative f => a -> f a
pure (Int
numPolicyIds, 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 <- forall a. Int -> Gen a -> Gen [a]
vectorOf Int
numP Gen PolicyID
genPolicyIDToFail
  [(AssetName, Int)]
as <-
    forall a. Int -> Gen a -> Gen [a]
vectorOf Int
numA forall a b. (a -> b) -> a -> b
$
      (,)
        forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Gen AssetName
genAssetNameToFail
        forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> if Bool
isForMaryValue then forall a. Positive a -> a
getPositive @Int forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall a. Arbitrary a => Gen a
arbitrary else forall a. NonZero a -> a
getNonZero @Int forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall a. Arbitrary a => Gen a
arbitrary
  let initialTriples :: [(PolicyID, AssetName, Int)]
initialTriples = 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 = forall a. Int -> [a] -> [a]
drop Int
numP [(AssetName, Int)]
as
  [(PolicyID, AssetName, Int)]
remainingTriples <-
    forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
traverse
      ( \(AssetName
a, Int
v) -> do
          PolicyID
policy <- forall a. HasCallStack => [a] -> Gen a
elements [PolicyID]
ps -- For every remaining asset, randomly assign a policy
          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 = forall i.
(Bounded i, Integral i) =>
[(PolicyID, AssetName, i)] -> MultiAsset
multiAssetFromListBounded forall a b. (a -> b) -> a -> b
$ [(PolicyID, AssetName, Int)]
initialTriples 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 forall (t :: * -> *) a. Foldable t => t a -> Int
length Map PolicyID (Map AssetName Integer)
ma forall a. Eq a => a -> a -> Bool
== Int
numP Bool -> Bool -> Bool
&& forall (t :: * -> *) a. (Foldable t, Num a) => t a -> a
sum (forall (t :: * -> *) a. Foldable t => t a -> Int
length forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Map PolicyID (Map AssetName Integer)
ma) forall a. Eq a => a -> a -> Bool
== Int
numA
    then forall (f :: * -> *) a. Applicative f => a -> f a
pure 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 forall a b. (a -> b) -> a -> b
$
      forall a. Integral a => a -> Integer
toInteger
        forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall a. HasCallStack => [Gen a] -> Gen a
oneof
          [ forall a. Random a => (a, a) -> Gen a
choose (Int
1 :: Int, forall a. Bounded a => a
maxBound)
          , forall a. Random a => (a, a) -> Gen a
choose (forall a. Bounded a => a
minBound :: Int, -Int
1)
          ]

genEmptyMultiAsset :: Gen MultiAsset
genEmptyMultiAsset :: Gen MultiAsset
genEmptyMultiAsset =
  Map PolicyID (Map AssetName Integer) -> MultiAsset
MultiAsset forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall k v. Ord k => Gen k -> Gen v -> Gen (Map k v)
genNonEmptyMap forall a. Arbitrary a => Gen a
arbitrary (forall (f :: * -> *) a. Applicative f => a -> f a
pure 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 =
  forall a. HasCallStack => [Gen a] -> Gen a
oneof
    [ forall a. Random a => (a, a) -> Gen a
choose (Int
0, forall a. Bounded a => a
maxBound)
    , forall a. NonNegative a -> a
getNonNegative forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall a. Arbitrary a => Gen a
arbitrary
    ]

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

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

genMaryValue :: Gen MultiAsset -> Gen MaryValue
genMaryValue :: Gen MultiAsset -> Gen MaryValue
genMaryValue Gen MultiAsset
genMA = do
  Integer
i <- forall a. Integral a => a -> Integer
toInteger forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Gen Int
genNonNegativeInt
  MultiAsset
ma <- Gen MultiAsset
genMA
  forall (f :: * -> *) a. Applicative f => a -> f a
pure 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 forall a b. (a -> b) -> a -> b
$ Gen Integer -> Gen MultiAsset
genMultiAsset forall a b. (a -> b) -> a -> b
$ forall a. Integral a => a -> Integer
toInteger 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 = forall {a}. (Compactible a, Show a) => a -> CompactForm a
toCompactMaryValue forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall a. Arbitrary a => Gen a
arbitrary
    where
      toCompactMaryValue :: a -> CompactForm a
toCompactMaryValue a
v =
        forall a. a -> Maybe a -> a
fromMaybe (forall a. HasCallStack => [Char] -> a
error forall a b. (a -> b) -> a -> b
$ [Char]
"Could not compact the value: " forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> [Char]
show a
v) forall a b. (a -> b) -> a -> b
$ forall a. Compactible a => a -> Maybe (CompactForm a)
toCompact a
v

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