{-# LANGUAGE DataKinds #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE RankNTypes #-}
{-# LANGUAGE ScopedTypeVariables #-}
module Test.Gen.Cardano.Api
( genMetadata
, genAlonzoGenesis
)
where
import Cardano.Ledger.Alonzo.Core qualified as Ledger
import Cardano.Ledger.Alonzo.Genesis qualified as Alonzo
import Cardano.Ledger.Alonzo.Scripts qualified as Alonzo
import Cardano.Ledger.BaseTypes qualified as Ledger
import Cardano.Ledger.Coin qualified as Ledger
import Cardano.Ledger.Plutus.CostModels qualified as Plutus
import Cardano.Ledger.Plutus.Language qualified as Alonzo
import Cardano.Ledger.Shelley.TxAuxData (Metadatum (..), ShelleyTxAuxData (..))
import Data.Map.Strict qualified as Map
import Data.Word (Word64)
import GHC.Exts (IsList (..))
import Test.Gen.Cardano.Api.Typed (genCostModel, genRational)
import Hedgehog (Gen, Range)
import Hedgehog.Gen qualified as Gen
import Hedgehog.Internal.Range qualified as Range
genMetadata :: Ledger.Era era => Gen (ShelleyTxAuxData era)
genMetadata :: forall era. Era era => Gen (ShelleyTxAuxData era)
genMetadata = do
numberOfIndices <- Range Int -> GenT Identity Int
forall (m :: * -> *) a. (MonadGen m, Integral a) => Range a -> m a
Gen.integral (Int -> Int -> Range Int
forall a. Integral a => a -> a -> Range a
Range.linear Int
1 Int
15)
let indices = (Int -> Word64) -> [Int] -> [Word64]
forall a b. (a -> b) -> [a] -> [b]
map (\Int
i -> Int -> Word64
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
i :: Word64) [Int
1 .. Int
numberOfIndices]
mData <- Gen.list (Range.singleton numberOfIndices) genMetadatum
return . ShelleyTxAuxData . fromList $ zip indices mData
genMetadatum :: Gen Metadatum
genMetadatum :: GenT Identity Metadatum
genMetadatum = do
int <- Range Int -> GenT Identity Metadatum -> GenT Identity [Metadatum]
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
1 Int
5) (Integer -> Metadatum
I (Integer -> Metadatum)
-> GenT Identity Integer -> GenT Identity Metadatum
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 (Integer -> Integer -> Range Integer
forall a. Integral a => a -> a -> Range a
Range.linear Integer
1 Integer
100))
bytes <- Gen.list (Range.linear 1 5) (B <$> Gen.bytes (Range.linear 1 20))
str <- Gen.list (Range.linear 1 5) (S <$> Gen.text (Range.linear 1 20) Gen.alphaNum)
let mDatumList = [Metadatum]
int [Metadatum] -> [Metadatum] -> [Metadatum]
forall a. [a] -> [a] -> [a]
++ [Metadatum]
bytes [Metadatum] -> [Metadatum] -> [Metadatum]
forall a. [a] -> [a] -> [a]
++ [Metadatum]
str
singleMetadatum <- Gen.element mDatumList
Gen.element
[ List mDatumList
, Map [(singleMetadatum, singleMetadatum)]
, Map [(List mDatumList, singleMetadatum)]
, Map [(singleMetadatum, List mDatumList)]
]
genCoin :: Range Integer -> Gen Ledger.Coin
genCoin :: Range Integer -> Gen Coin
genCoin Range Integer
r = do
unCoin' <- Range Integer -> GenT Identity Integer
forall (m :: * -> *) a. (MonadGen m, Integral a) => Range a -> m a
Gen.integral Range Integer
r
return $ Ledger.Coin unCoin'
genPrice :: Gen Ledger.NonNegativeInterval
genPrice :: Gen NonNegativeInterval
genPrice = do
unPrice <- Gen Rational
genRational
case Ledger.boundRational unPrice of
Maybe NonNegativeInterval
Nothing -> String -> Gen NonNegativeInterval
forall a. String -> GenT Identity a
forall (m :: * -> *) a. MonadFail m => String -> m a
fail String
"genPrice: genRational should give us a bounded rational"
Just NonNegativeInterval
p -> NonNegativeInterval -> Gen NonNegativeInterval
forall a. a -> GenT Identity a
forall (f :: * -> *) a. Applicative f => a -> f a
pure NonNegativeInterval
p
genPrices :: Gen Alonzo.Prices
genPrices :: Gen Prices
genPrices = do
prMem' <- Gen NonNegativeInterval
genPrice
prSteps' <- genPrice
return
Alonzo.Prices
{ Alonzo.prMem = prMem'
, Alonzo.prSteps = prSteps'
}
genExUnits :: Gen Alonzo.ExUnits
genExUnits :: Gen ExUnits
genExUnits = do
exUnitsMem' <- Range Natural -> GenT Identity Natural
forall (m :: * -> *) a. (MonadGen m, Integral a) => Range a -> m a
Gen.integral (Natural -> Natural -> Range Natural
forall a. Integral a => a -> a -> Range a
Range.linear Natural
0 Natural
10)
exUnitsSteps' <- Gen.integral (Range.linear 0 10)
return
Alonzo.ExUnits
{ Alonzo.exUnitsMem = exUnitsMem'
, Alonzo.exUnitsSteps = exUnitsSteps'
}
genCostModels :: Gen Alonzo.CostModels
genCostModels :: Gen CostModels
genCostModels = do
alonzoCostModel <- GenT Identity CostModel
forall (m :: * -> *). MonadGen m => m CostModel
genCostModel
Plutus.mkCostModels . conv <$> Gen.list (Range.linear 1 3) (return alonzoCostModel)
where
conv :: [Alonzo.CostModel] -> Map.Map Alonzo.Language Alonzo.CostModel
conv :: [CostModel] -> Map Language CostModel
conv [] = Map Language CostModel
forall a. Monoid a => a
mempty
conv (CostModel
c : [CostModel]
rest) = Language -> CostModel -> Map Language CostModel
forall k a. k -> a -> Map k a
Map.singleton (CostModel -> Language
Alonzo.getCostModelLanguage CostModel
c) CostModel
c Map Language CostModel
-> Map Language CostModel -> Map Language CostModel
forall a. Semigroup a => a -> a -> a
<> [CostModel] -> Map Language CostModel
conv [CostModel]
rest
genAlonzoGenesis :: Gen Alonzo.AlonzoGenesis
genAlonzoGenesis :: Gen AlonzoGenesis
genAlonzoGenesis = do
coinsPerUTxOWord <- Range Integer -> Gen Coin
genCoin (Integer -> Integer -> Range Integer
forall a. Integral a => a -> a -> Range a
Range.linear Integer
0 Integer
5)
_costmdls' <- genCostModels
prices' <- genPrices
maxTxExUnits' <- genExUnits
maxBlockExUnits' <- genExUnits
maxValSize' <- Gen.integral (Range.linear 0 10)
collateralPercentage' <- Gen.integral (Range.linear 0 10)
maxCollateralInputs' <- Gen.integral (Range.linear 0 10)
return
Alonzo.AlonzoGenesis
{ Alonzo.agCoinsPerUTxOWord = Ledger.CoinPerWord coinsPerUTxOWord
, Alonzo.agCostModels = mempty
, Alonzo.agPrices = prices'
, Alonzo.agMaxTxExUnits = maxTxExUnits'
, Alonzo.agMaxBlockExUnits = maxBlockExUnits'
, Alonzo.agMaxValSize = maxValSize'
, Alonzo.agCollateralPercentage = collateralPercentage'
, Alonzo.agMaxCollateralInputs = maxCollateralInputs'
}