{-# 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
  Int
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 :: [Word64]
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]
  [Metadatum]
mData <- Range Int -> GenT Identity Metadatum -> GenT Identity [Metadatum]
forall (m :: * -> *) a. MonadGen m => Range Int -> m a -> m [a]
Gen.list (Int -> Range Int
forall a. a -> Range a
Range.singleton Int
numberOfIndices) GenT Identity Metadatum
genMetadatum
  ShelleyTxAuxData era -> Gen (ShelleyTxAuxData era)
forall a. a -> GenT Identity a
forall (m :: * -> *) a. Monad m => a -> m a
return (ShelleyTxAuxData era -> Gen (ShelleyTxAuxData era))
-> ([(Word64, Metadatum)] -> ShelleyTxAuxData era)
-> [(Word64, Metadatum)]
-> Gen (ShelleyTxAuxData era)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Map Word64 Metadatum -> ShelleyTxAuxData era
forall era. Era era => Map Word64 Metadatum -> ShelleyTxAuxData era
ShelleyTxAuxData (Map Word64 Metadatum -> ShelleyTxAuxData era)
-> ([(Word64, Metadatum)] -> Map Word64 Metadatum)
-> [(Word64, Metadatum)]
-> ShelleyTxAuxData era
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [(Word64, Metadatum)] -> Map Word64 Metadatum
[Item (Map Word64 Metadatum)] -> Map Word64 Metadatum
forall l. IsList l => [Item l] -> l
fromList ([(Word64, Metadatum)] -> Gen (ShelleyTxAuxData era))
-> [(Word64, Metadatum)] -> Gen (ShelleyTxAuxData era)
forall a b. (a -> b) -> a -> b
$ [Word64] -> [Metadatum] -> [(Word64, Metadatum)]
forall a b. [a] -> [b] -> [(a, b)]
zip [Word64]
indices [Metadatum]
mData

genMetadatum :: Gen Metadatum
genMetadatum :: GenT Identity Metadatum
genMetadatum = do
  [Metadatum]
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))
  [Metadatum]
bytes <- 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) (ByteString -> Metadatum
B (ByteString -> Metadatum)
-> GenT Identity ByteString -> GenT Identity Metadatum
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Range Int -> GenT Identity ByteString
forall (m :: * -> *). MonadGen m => Range Int -> m ByteString
Gen.bytes (Int -> Int -> Range Int
forall a. Integral a => a -> a -> Range a
Range.linear Int
1 Int
20))
  [Metadatum]
str <- 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) (Text -> Metadatum
S (Text -> Metadatum)
-> GenT Identity Text -> GenT Identity Metadatum
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Range Int -> GenT Identity Char -> GenT Identity Text
forall (m :: * -> *). MonadGen m => Range Int -> m Char -> m Text
Gen.text (Int -> Int -> Range Int
forall a. Integral a => a -> a -> Range a
Range.linear Int
1 Int
20) GenT Identity Char
forall (m :: * -> *). MonadGen m => m Char
Gen.alphaNum)
  let mDatumList :: [Metadatum]
mDatumList = [Metadatum]
int [Metadatum] -> [Metadatum] -> [Metadatum]
forall a. [a] -> [a] -> [a]
++ [Metadatum]
bytes [Metadatum] -> [Metadatum] -> [Metadatum]
forall a. [a] -> [a] -> [a]
++ [Metadatum]
str

  Metadatum
singleMetadatum <- [Metadatum] -> GenT Identity Metadatum
forall (f :: * -> *) (m :: * -> *) a.
(Foldable f, MonadGen m) =>
f a -> m a
Gen.element [Metadatum]
mDatumList

  [Metadatum] -> GenT Identity Metadatum
forall (f :: * -> *) (m :: * -> *) a.
(Foldable f, MonadGen m) =>
f a -> m a
Gen.element
    [ [Metadatum] -> Metadatum
List [Metadatum]
mDatumList
    , [(Metadatum, Metadatum)] -> Metadatum
Map [(Metadatum
singleMetadatum, Metadatum
singleMetadatum)]
    , [(Metadatum, Metadatum)] -> Metadatum
Map [([Metadatum] -> Metadatum
List [Metadatum]
mDatumList, Metadatum
singleMetadatum)]
    , [(Metadatum, Metadatum)] -> Metadatum
Map [(Metadatum
singleMetadatum, [Metadatum] -> Metadatum
List [Metadatum]
mDatumList)]
    ]

genCoin :: Range Integer -> Gen Ledger.Coin
genCoin :: Range Integer -> Gen Coin
genCoin Range Integer
r = do
  Integer
unCoin' <- Range Integer -> GenT Identity Integer
forall (m :: * -> *) a. (MonadGen m, Integral a) => Range a -> m a
Gen.integral Range Integer
r
  Coin -> Gen Coin
forall a. a -> GenT Identity a
forall (m :: * -> *) a. Monad m => a -> m a
return (Coin -> Gen Coin) -> Coin -> Gen Coin
forall a b. (a -> b) -> a -> b
$ Integer -> Coin
Ledger.Coin Integer
unCoin'

genPrice :: Gen Ledger.NonNegativeInterval
genPrice :: Gen NonNegativeInterval
genPrice = do
  Rational
unPrice <- Gen Rational
genRational
  case Rational -> Maybe NonNegativeInterval
forall r. BoundedRational r => Rational -> Maybe r
Ledger.boundRational Rational
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
  NonNegativeInterval
prMem' <- Gen NonNegativeInterval
genPrice
  NonNegativeInterval
prSteps' <- Gen NonNegativeInterval
genPrice

  Prices -> Gen Prices
forall a. a -> GenT Identity a
forall (m :: * -> *) a. Monad m => a -> m a
return
    Alonzo.Prices
      { prMem :: NonNegativeInterval
Alonzo.prMem = NonNegativeInterval
prMem'
      , prSteps :: NonNegativeInterval
Alonzo.prSteps = NonNegativeInterval
prSteps'
      }

genExUnits :: Gen Alonzo.ExUnits
genExUnits :: Gen ExUnits
genExUnits = do
  Natural
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)
  Natural
exUnitsSteps' <- 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)
  ExUnits -> Gen ExUnits
forall a. a -> GenT Identity a
forall (m :: * -> *) a. Monad m => a -> m a
return
    Alonzo.ExUnits
      { exUnitsMem :: Natural
Alonzo.exUnitsMem = Natural
exUnitsMem'
      , exUnitsSteps :: Natural
Alonzo.exUnitsSteps = Natural
exUnitsSteps'
      }

genCostModels :: Gen Alonzo.CostModels
genCostModels :: Gen CostModels
genCostModels = do
  CostModel
alonzoCostModel <- GenT Identity CostModel
forall (m :: * -> *). MonadGen m => m CostModel
genCostModel
  Map Language CostModel -> CostModels
Plutus.mkCostModels (Map Language CostModel -> CostModels)
-> ([CostModel] -> Map Language CostModel)
-> [CostModel]
-> CostModels
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [CostModel] -> Map Language CostModel
conv ([CostModel] -> CostModels)
-> GenT Identity [CostModel] -> Gen CostModels
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Range Int -> GenT Identity CostModel -> GenT Identity [CostModel]
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
3) (CostModel -> GenT Identity CostModel
forall a. a -> GenT Identity a
forall (m :: * -> *) a. Monad m => a -> m a
return CostModel
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
  Coin
coinsPerUTxOWord <- Range Integer -> Gen Coin
genCoin (Integer -> Integer -> Range Integer
forall a. Integral a => a -> a -> Range a
Range.linear Integer
0 Integer
5)
  -- TODO: Babbage: Figure out how to deal with the asymmetric cost model JSON
  CostModels
_costmdls' <- Gen CostModels
genCostModels
  Prices
prices' <- Gen Prices
genPrices
  ExUnits
maxTxExUnits' <- Gen ExUnits
genExUnits
  ExUnits
maxBlockExUnits' <- Gen ExUnits
genExUnits
  Natural
maxValSize' <- 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)
  Natural
collateralPercentage' <- 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)
  Natural
maxCollateralInputs' <- 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)

  AlonzoGenesis -> Gen AlonzoGenesis
forall a. a -> GenT Identity a
forall (m :: * -> *) a. Monad m => a -> m a
return
    Alonzo.AlonzoGenesis
      { agCoinsPerUTxOWord :: CoinPerWord
Alonzo.agCoinsPerUTxOWord = Coin -> CoinPerWord
Ledger.CoinPerWord Coin
coinsPerUTxOWord
      , agCostModels :: CostModels
Alonzo.agCostModels = CostModels
forall a. Monoid a => a
mempty
      , agPrices :: Prices
Alonzo.agPrices = Prices
prices'
      , agMaxTxExUnits :: ExUnits
Alonzo.agMaxTxExUnits = ExUnits
maxTxExUnits'
      , agMaxBlockExUnits :: ExUnits
Alonzo.agMaxBlockExUnits = ExUnits
maxBlockExUnits'
      , agMaxValSize :: Natural
Alonzo.agMaxValSize = Natural
maxValSize'
      , agCollateralPercentage :: Natural
Alonzo.agCollateralPercentage = Natural
collateralPercentage'
      , agMaxCollateralInputs :: Natural
Alonzo.agMaxCollateralInputs = Natural
maxCollateralInputs'
      }