{-# LANGUAGE DataKinds #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE RankNTypes #-}
{-# LANGUAGE ScopedTypeVariables #-}

module Gen.Bcc.Api
  ( genMetadata
  , genAurumGenesis
  ) where

import           Bcc.Prelude
import           Control.Monad (MonadFail(fail))
import qualified Data.Map.Strict as Map

--TODO: why do we have this odd split? We can get rid of the old name "typed"
import           Gen.Bcc.Api.Typed (genRational)

import           Sophie.Spec.Ledger.Metadata (Metadata (..), Metadatum (..))
import qualified Bcc.Ledger.Aurum.Genesis as Aurum
import qualified Bcc.Ledger.Aurum.Language as Aurum
import qualified Bcc.Ledger.Aurum.Scripts as Aurum
import qualified Bcc.Ledger.BaseTypes as Ledger
import qualified Bcc.Ledger.Coin as Ledger

import           Hedgehog (Gen, Range)
import qualified Hedgehog.Gen as Gen
import qualified Hedgehog.Range as Range

genMetadata :: Gen (Metadata era)
genMetadata :: Gen (Metadata era)
genMetadata = do
  Int
numberOfIndicies <- 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 indexes :: [Word64]
indexes = (Int -> Word64) -> [Int] -> [Word64]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
map (\Int
i -> Int -> Word64
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
i :: Word64) [Int
1..Int
numberOfIndicies]
  [Metadatum]
mDatums <- 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
numberOfIndicies) GenT Identity Metadatum
genMetadatum
  Metadata era -> Gen (Metadata era)
forall (m :: * -> *) a. Monad m => a -> m a
return (Metadata era -> Gen (Metadata era))
-> ([(Word64, Metadatum)] -> Metadata era)
-> [(Word64, Metadatum)]
-> Gen (Metadata era)
forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. Map Word64 Metadatum -> Metadata era
forall era. Map Word64 Metadatum -> Metadata era
Metadata (Map Word64 Metadatum -> Metadata era)
-> ([(Word64, Metadatum)] -> Map Word64 Metadatum)
-> [(Word64, Metadatum)]
-> Metadata era
forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. [(Word64, Metadatum)] -> Map Word64 Metadatum
forall k a. Ord k => [(k, a)] -> Map k a
Map.fromList ([(Word64, Metadatum)] -> Gen (Metadata era))
-> [(Word64, Metadatum)] -> Gen (Metadata era)
forall a b. (a -> b) -> a -> b
$ [Word64] -> [Metadatum] -> [(Word64, Metadatum)]
forall a b. [a] -> [b] -> [(a, b)]
zip [Word64]
indexes [Metadatum]
mDatums

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 (m :: * -> *) a. MonadGen m => [a] -> m a
Gen.element [Metadatum]
mDatumList

  [Metadatum] -> GenT Identity Metadatum
forall (m :: * -> *) a. MonadGen m => [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 (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 (m :: * -> *) a. MonadFail m => String -> m a
fail String
"genPrice: genRational should give us a bounded rational"
    Just NonNegativeInterval
p -> NonNegativeInterval -> Gen NonNegativeInterval
forall (f :: * -> *) a. Applicative f => a -> f a
pure NonNegativeInterval
p

genLanguage :: Gen Aurum.Language
genLanguage :: Gen Language
genLanguage = Language -> Gen Language
forall (m :: * -> *) a. Monad m => a -> m a
return Language
Aurum.ZerepochV1

genPrices :: Gen Aurum.Prices
genPrices :: Gen Prices
genPrices = do
  NonNegativeInterval
prMem'   <- Gen NonNegativeInterval
genPrice
  NonNegativeInterval
prSteps' <- Gen NonNegativeInterval
genPrice

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

genExUnits :: Gen Aurum.ExUnits
genExUnits :: Gen ExUnits
genExUnits = do
  Word64
exUnitsMem' <- Range Word64 -> GenT Identity Word64
forall (m :: * -> *). MonadGen m => Range Word64 -> m Word64
Gen.word64 (Word64 -> Word64 -> Range Word64
forall a. Integral a => a -> a -> Range a
Range.linear Word64
0 Word64
10)
  Word64
exUnitsSteps' <- Range Word64 -> GenT Identity Word64
forall (m :: * -> *). MonadGen m => Range Word64 -> m Word64
Gen.word64 (Word64 -> Word64 -> Range Word64
forall a. Integral a => a -> a -> Range a
Range.linear Word64
0 Word64
10)
  ExUnits -> Gen ExUnits
forall (m :: * -> *) a. Monad m => a -> m a
return ExUnits :: Word64 -> Word64 -> ExUnits
Aurum.ExUnits
    { exUnitsMem :: Word64
Aurum.exUnitsMem = Word64
exUnitsMem'
    , exUnitsSteps :: Word64
Aurum.exUnitsSteps = Word64
exUnitsSteps'
    }

genCostModel :: Range Int -> Gen Text -> Gen Integer -> Gen Aurum.CostModel
genCostModel :: Range Int
-> GenT Identity Text -> GenT Identity Integer -> Gen CostModel
genCostModel Range Int
r GenT Identity Text
gt GenT Identity Integer
gi = do
  Map Text Integer
map' <- Range Int
-> GenT Identity (Text, Integer)
-> GenT Identity (Map Text Integer)
forall (m :: * -> *) k v.
(MonadGen m, Ord k) =>
Range Int -> m (k, v) -> m (Map k v)
Gen.map Range Int
r ((,) (Text -> Integer -> (Text, Integer))
-> GenT Identity Text -> GenT Identity (Integer -> (Text, Integer))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> GenT Identity Text
gt GenT Identity (Integer -> (Text, Integer))
-> GenT Identity Integer -> GenT Identity (Text, Integer)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> GenT Identity Integer
gi)
  CostModel -> Gen CostModel
forall (m :: * -> *) a. Monad m => a -> m a
return (CostModel -> Gen CostModel) -> CostModel -> Gen CostModel
forall a b. (a -> b) -> a -> b
$ Map Text Integer -> CostModel
Aurum.CostModel Map Text Integer
map'

genAurumGenesis :: Gen Aurum.AurumGenesis
genAurumGenesis :: Gen AurumGenesis
genAurumGenesis = 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)
  Map Language CostModel
costmdls' <- Range Int
-> GenT Identity (Language, CostModel)
-> GenT Identity (Map Language CostModel)
forall (m :: * -> *) k v.
(MonadGen m, Ord k) =>
Range Int -> m (k, v) -> m (Map k v)
Gen.map (Int -> Int -> Range Int
forall a. Integral a => a -> a -> Range a
Range.linear Int
0 Int
5) (GenT Identity (Language, CostModel)
 -> GenT Identity (Map Language CostModel))
-> GenT Identity (Language, CostModel)
-> GenT Identity (Map Language CostModel)
forall a b. (a -> b) -> a -> b
$ (,)
    (Language -> CostModel -> (Language, CostModel))
-> Gen Language
-> GenT Identity (CostModel -> (Language, CostModel))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Gen Language
genLanguage
    GenT Identity (CostModel -> (Language, CostModel))
-> Gen CostModel -> GenT Identity (Language, CostModel)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Range Int
-> GenT Identity Text -> GenT Identity Integer -> Gen CostModel
genCostModel (Int -> Int -> Range Int
forall a. Integral a => a -> a -> Range a
Range.linear Int
0 Int
5)
          (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
0 Int
10) GenT Identity Char
forall (m :: * -> *). MonadGen m => m Char
Gen.alphaNum)
          (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
0 Integer
100))
  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)

  AurumGenesis -> Gen AurumGenesis
forall (m :: * -> *) a. Monad m => a -> m a
return AurumGenesis :: Coin
-> Map Language CostModel
-> Prices
-> ExUnits
-> ExUnits
-> Natural
-> Natural
-> Natural
-> AurumGenesis
Aurum.AurumGenesis
    { coinsPerUTxOWord :: Coin
Aurum.coinsPerUTxOWord = Coin
coinsPerUTxOWord
    , costmdls :: Map Language CostModel
Aurum.costmdls = Map Language CostModel
costmdls'
    , prices :: Prices
Aurum.prices = Prices
prices'
    , maxTxExUnits :: ExUnits
Aurum.maxTxExUnits = ExUnits
maxTxExUnits'
    , maxBlockExUnits :: ExUnits
Aurum.maxBlockExUnits = ExUnits
maxBlockExUnits'
    , maxValSize :: Natural
Aurum.maxValSize = Natural
maxValSize'
    , collateralPercentage :: Natural
Aurum.collateralPercentage = Natural
collateralPercentage'
    , maxCollateralInputs :: Natural
Aurum.maxCollateralInputs = Natural
maxCollateralInputs'
    }