{-# LANGUAGE NumericUnderscores #-}
{- HLINT ignore "Use camelCase" -}

-- |
-- Copyright: © 2022 IOHK
-- License: Apache-2.0
--
-- Defines generators and shrinkers for the 'MinimumUTxO' data type.
--
module Cardano.Wallet.Primitive.Types.MinimumUTxO.Gen
    (
    -- * Generators and shrinkers
      genMinimumUTxO
    , genMinimumUTxOForShelleyBasedEra
    , shrinkMinimumUTxO
    , shrinkMinimumUTxOForShelleyBasedEra

    -- * Test protocol parameter values
    , testParameter_minUTxOValue_Shelley
    , testParameter_minUTxOValue_Allegra
    , testParameter_minUTxOValue_Mary
    , testParameter_coinsPerUTxOWord_Alonzo
    , testParameter_coinsPerUTxOByte_Babbage
    )
    where

import Prelude

import Cardano.Api
    ( ShelleyBasedEra (..) )
import Cardano.Wallet.Primitive.Types.Coin
    ( Coin (..) )
import Cardano.Wallet.Primitive.Types.Coin.Gen
    ( chooseCoin )
import Cardano.Wallet.Primitive.Types.MinimumUTxO
    ( MinimumUTxO (..), MinimumUTxOForShelleyBasedEra (..) )
import Data.Default
    ( Default (..) )
import Data.Semigroup
    ( stimes )
import Test.QuickCheck
    ( Gen, chooseInteger, frequency, oneof )

import qualified Cardano.Ledger.Alonzo.PParams as Alonzo
import qualified Cardano.Ledger.Babbage.PParams as Babbage
import qualified Cardano.Ledger.Coin as Ledger
import qualified Cardano.Ledger.Shelley.PParams as Shelley

--------------------------------------------------------------------------------
-- Generating 'MinimumUTxO' values
--------------------------------------------------------------------------------

genMinimumUTxO :: Gen MinimumUTxO
genMinimumUTxO :: Gen MinimumUTxO
genMinimumUTxO = [(Int, Gen MinimumUTxO)] -> Gen MinimumUTxO
forall a. [(Int, Gen a)] -> Gen a
frequency
    [ (Int
1, Gen MinimumUTxO
genMinimumUTxONone)
    , (Int
1, Gen MinimumUTxO
genMinimumUTxOConstant)
    , (Int
8, MinimumUTxOForShelleyBasedEra -> MinimumUTxO
MinimumUTxOForShelleyBasedEraOf (MinimumUTxOForShelleyBasedEra -> MinimumUTxO)
-> Gen MinimumUTxOForShelleyBasedEra -> Gen MinimumUTxO
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Gen MinimumUTxOForShelleyBasedEra
genMinimumUTxOForShelleyBasedEra)
    ]
  where
    genMinimumUTxONone :: Gen MinimumUTxO
    genMinimumUTxONone :: Gen MinimumUTxO
genMinimumUTxONone = MinimumUTxO -> Gen MinimumUTxO
forall (f :: * -> *) a. Applicative f => a -> f a
pure MinimumUTxO
MinimumUTxONone

    genMinimumUTxOConstant :: Gen MinimumUTxO
    genMinimumUTxOConstant :: Gen MinimumUTxO
genMinimumUTxOConstant = Coin -> MinimumUTxO
MinimumUTxOConstant (Coin -> MinimumUTxO) -> Gen Coin -> Gen MinimumUTxO
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$>
        -- The 'MinimumUTxOConstant' constructor is only used for testing.
        Coin -> Gen Coin
genCoinOfSimilarMagnitude (Natural -> Coin
Coin Natural
1_000_000)

shrinkMinimumUTxO :: MinimumUTxO -> [MinimumUTxO]
shrinkMinimumUTxO :: MinimumUTxO -> [MinimumUTxO]
shrinkMinimumUTxO = [MinimumUTxO] -> MinimumUTxO -> [MinimumUTxO]
forall a b. a -> b -> a
const []

--------------------------------------------------------------------------------
-- Generating 'MinimumUTxOForShelleyBasedEra' values
--------------------------------------------------------------------------------

genMinimumUTxOForShelleyBasedEra
    :: Gen MinimumUTxOForShelleyBasedEra
genMinimumUTxOForShelleyBasedEra :: Gen MinimumUTxOForShelleyBasedEra
genMinimumUTxOForShelleyBasedEra = [Gen MinimumUTxOForShelleyBasedEra]
-> Gen MinimumUTxOForShelleyBasedEra
forall a. [Gen a] -> Gen a
oneof
    [ Gen MinimumUTxOForShelleyBasedEra
genShelley
    , Gen MinimumUTxOForShelleyBasedEra
genAllegra
    , Gen MinimumUTxOForShelleyBasedEra
genMary
    , Gen MinimumUTxOForShelleyBasedEra
genAlonzo
    , Gen MinimumUTxOForShelleyBasedEra
genBabbage
    ]
  where
    genShelley :: Gen MinimumUTxOForShelleyBasedEra
    genShelley :: Gen MinimumUTxOForShelleyBasedEra
genShelley = do
        Coin
minUTxOValue <- Coin -> Gen Coin
genLedgerCoinOfSimilarMagnitude
            Coin
testParameter_minUTxOValue_Shelley
        MinimumUTxOForShelleyBasedEra -> Gen MinimumUTxOForShelleyBasedEra
forall (f :: * -> *) a. Applicative f => a -> f a
pure (MinimumUTxOForShelleyBasedEra
 -> Gen MinimumUTxOForShelleyBasedEra)
-> MinimumUTxOForShelleyBasedEra
-> Gen MinimumUTxOForShelleyBasedEra
forall a b. (a -> b) -> a -> b
$ ShelleyBasedEra ShelleyEra
-> PParams (ShelleyLedgerEra ShelleyEra)
-> MinimumUTxOForShelleyBasedEra
forall era.
ShelleyBasedEra era
-> PParams (ShelleyLedgerEra era) -> MinimumUTxOForShelleyBasedEra
MinimumUTxOForShelleyBasedEra ShelleyBasedEra ShelleyEra
ShelleyBasedEraShelley
            PParams' Identity Any
forall a. Default a => a
def {_minUTxOValue :: HKD Identity Coin
Shelley._minUTxOValue = Coin
HKD Identity Coin
minUTxOValue}

    genAllegra :: Gen MinimumUTxOForShelleyBasedEra
    genAllegra :: Gen MinimumUTxOForShelleyBasedEra
genAllegra = do
        Coin
minUTxOValue <- Coin -> Gen Coin
genLedgerCoinOfSimilarMagnitude
            Coin
testParameter_minUTxOValue_Allegra
        MinimumUTxOForShelleyBasedEra -> Gen MinimumUTxOForShelleyBasedEra
forall (f :: * -> *) a. Applicative f => a -> f a
pure (MinimumUTxOForShelleyBasedEra
 -> Gen MinimumUTxOForShelleyBasedEra)
-> MinimumUTxOForShelleyBasedEra
-> Gen MinimumUTxOForShelleyBasedEra
forall a b. (a -> b) -> a -> b
$ ShelleyBasedEra AllegraEra
-> PParams (ShelleyLedgerEra AllegraEra)
-> MinimumUTxOForShelleyBasedEra
forall era.
ShelleyBasedEra era
-> PParams (ShelleyLedgerEra era) -> MinimumUTxOForShelleyBasedEra
MinimumUTxOForShelleyBasedEra ShelleyBasedEra AllegraEra
ShelleyBasedEraAllegra
            PParams' Identity Any
forall a. Default a => a
def {_minUTxOValue :: HKD Identity Coin
Shelley._minUTxOValue = Coin
HKD Identity Coin
minUTxOValue}

    genMary :: Gen MinimumUTxOForShelleyBasedEra
    genMary :: Gen MinimumUTxOForShelleyBasedEra
genMary = do
        Coin
minUTxOValue <- Coin -> Gen Coin
genLedgerCoinOfSimilarMagnitude
            Coin
testParameter_minUTxOValue_Mary
        MinimumUTxOForShelleyBasedEra -> Gen MinimumUTxOForShelleyBasedEra
forall (f :: * -> *) a. Applicative f => a -> f a
pure (MinimumUTxOForShelleyBasedEra
 -> Gen MinimumUTxOForShelleyBasedEra)
-> MinimumUTxOForShelleyBasedEra
-> Gen MinimumUTxOForShelleyBasedEra
forall a b. (a -> b) -> a -> b
$ ShelleyBasedEra MaryEra
-> PParams (ShelleyLedgerEra MaryEra)
-> MinimumUTxOForShelleyBasedEra
forall era.
ShelleyBasedEra era
-> PParams (ShelleyLedgerEra era) -> MinimumUTxOForShelleyBasedEra
MinimumUTxOForShelleyBasedEra ShelleyBasedEra MaryEra
ShelleyBasedEraMary
            PParams' Identity Any
forall a. Default a => a
def {_minUTxOValue :: HKD Identity Coin
Shelley._minUTxOValue = Coin
HKD Identity Coin
minUTxOValue}

    genAlonzo :: Gen MinimumUTxOForShelleyBasedEra
    genAlonzo :: Gen MinimumUTxOForShelleyBasedEra
genAlonzo = do
        Coin
coinsPerUTxOWord <- Coin -> Gen Coin
genLedgerCoinOfSimilarMagnitude
            Coin
testParameter_coinsPerUTxOWord_Alonzo
        MinimumUTxOForShelleyBasedEra -> Gen MinimumUTxOForShelleyBasedEra
forall (f :: * -> *) a. Applicative f => a -> f a
pure (MinimumUTxOForShelleyBasedEra
 -> Gen MinimumUTxOForShelleyBasedEra)
-> MinimumUTxOForShelleyBasedEra
-> Gen MinimumUTxOForShelleyBasedEra
forall a b. (a -> b) -> a -> b
$ ShelleyBasedEra AlonzoEra
-> PParams (ShelleyLedgerEra AlonzoEra)
-> MinimumUTxOForShelleyBasedEra
forall era.
ShelleyBasedEra era
-> PParams (ShelleyLedgerEra era) -> MinimumUTxOForShelleyBasedEra
MinimumUTxOForShelleyBasedEra ShelleyBasedEra AlonzoEra
ShelleyBasedEraAlonzo
            PParams' Identity Any
forall a. Default a => a
def {_coinsPerUTxOWord :: HKD Identity Coin
Alonzo._coinsPerUTxOWord = Coin
HKD Identity Coin
coinsPerUTxOWord}

    genBabbage :: Gen MinimumUTxOForShelleyBasedEra
    genBabbage :: Gen MinimumUTxOForShelleyBasedEra
genBabbage = do
        Coin
coinsPerUTxOByte <- Coin -> Gen Coin
genLedgerCoinOfSimilarMagnitude
            Coin
testParameter_coinsPerUTxOByte_Babbage
        MinimumUTxOForShelleyBasedEra -> Gen MinimumUTxOForShelleyBasedEra
forall (f :: * -> *) a. Applicative f => a -> f a
pure (MinimumUTxOForShelleyBasedEra
 -> Gen MinimumUTxOForShelleyBasedEra)
-> MinimumUTxOForShelleyBasedEra
-> Gen MinimumUTxOForShelleyBasedEra
forall a b. (a -> b) -> a -> b
$ ShelleyBasedEra BabbageEra
-> PParams (ShelleyLedgerEra BabbageEra)
-> MinimumUTxOForShelleyBasedEra
forall era.
ShelleyBasedEra era
-> PParams (ShelleyLedgerEra era) -> MinimumUTxOForShelleyBasedEra
MinimumUTxOForShelleyBasedEra ShelleyBasedEra BabbageEra
ShelleyBasedEraBabbage
            PParams' Identity Any
forall a. Default a => a
def {_coinsPerUTxOByte :: HKD Identity Coin
Babbage._coinsPerUTxOByte = Coin
HKD Identity Coin
coinsPerUTxOByte}

shrinkMinimumUTxOForShelleyBasedEra
    :: MinimumUTxOForShelleyBasedEra -> [MinimumUTxOForShelleyBasedEra]
shrinkMinimumUTxOForShelleyBasedEra :: MinimumUTxOForShelleyBasedEra -> [MinimumUTxOForShelleyBasedEra]
shrinkMinimumUTxOForShelleyBasedEra = [MinimumUTxOForShelleyBasedEra]
-> MinimumUTxOForShelleyBasedEra -> [MinimumUTxOForShelleyBasedEra]
forall a b. a -> b -> a
const []

--------------------------------------------------------------------------------
-- Test protocol parameter values
--------------------------------------------------------------------------------

-- | A test value of the Shelley-era 'minUTxOValue' parameter.
--
-- Value derived from 'mainnet-shelley-genesis.json'.
--
testParameter_minUTxOValue_Shelley :: Ledger.Coin
testParameter_minUTxOValue_Shelley :: Coin
testParameter_minUTxOValue_Shelley = Integer -> Coin
Ledger.Coin Integer
1_000_000

-- | A test value of the Allegra-era 'minUTxOValue' parameter.
--
-- Value derived from 'mainnet-shelley-genesis.json'.
--
testParameter_minUTxOValue_Allegra :: Ledger.Coin
testParameter_minUTxOValue_Allegra :: Coin
testParameter_minUTxOValue_Allegra = Integer -> Coin
Ledger.Coin Integer
1_000_000

-- | A test value of the Mary-era 'minUTxOValue' parameter.
--
-- Value derived from 'mainnet-shelley-genesis.json'.
--
testParameter_minUTxOValue_Mary :: Ledger.Coin
testParameter_minUTxOValue_Mary :: Coin
testParameter_minUTxOValue_Mary = Integer -> Coin
Ledger.Coin Integer
1_000_000

-- | A test value of the Alonzo-era 'coinsPerUTxOWord' parameter.
--
-- Value derived from 'mainnet-alonzo-genesis.json'.
--
testParameter_coinsPerUTxOWord_Alonzo :: Ledger.Coin
testParameter_coinsPerUTxOWord_Alonzo :: Coin
testParameter_coinsPerUTxOWord_Alonzo = Integer -> Coin
Ledger.Coin Integer
34_482

-- | A test value of the Babbage-era 'coinsPerUTxOByte' parameter.
--
-- Value derived from 'mainnet-alonzo-genesis.json':
-- >>> 34_482 `div` 8 == 4_310
--
testParameter_coinsPerUTxOByte_Babbage :: Ledger.Coin
testParameter_coinsPerUTxOByte_Babbage :: Coin
testParameter_coinsPerUTxOByte_Babbage = Integer -> Coin
Ledger.Coin Integer
4_310

--------------------------------------------------------------------------------
-- Internal functions
--------------------------------------------------------------------------------

-- | Chooses a 'Ledger.Coin' value from within the given range.
--
chooseLedgerCoin :: (Ledger.Coin, Ledger.Coin) -> Gen Ledger.Coin
chooseLedgerCoin :: (Coin, Coin) -> Gen Coin
chooseLedgerCoin (Ledger.Coin Integer
lo, Ledger.Coin Integer
hi) =
    Integer -> Coin
Ledger.Coin (Integer -> Coin) -> Gen Integer -> Gen Coin
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Integer, Integer) -> Gen Integer
chooseInteger (Integer
lo, Integer
hi)

-- | Generates a wallet 'Coin' value that has a similar magnitude to the given
--   value.
--
genCoinOfSimilarMagnitude :: Coin -> Gen Coin
genCoinOfSimilarMagnitude :: Coin -> Gen Coin
genCoinOfSimilarMagnitude Coin
coin =
    (Coin, Coin) -> Gen Coin
chooseCoin (Coin
forall a. Monoid a => a
mempty, Int -> Coin -> Coin
forall a b. (Semigroup a, Integral b) => b -> a -> a
stimes (Int
2 :: Int) Coin
coin)

-- | Generates a 'Ledger.Coin' value that has a similar magnitude to the given
--   value.
--
genLedgerCoinOfSimilarMagnitude :: Ledger.Coin -> Gen Ledger.Coin
genLedgerCoinOfSimilarMagnitude :: Coin -> Gen Coin
genLedgerCoinOfSimilarMagnitude Coin
coin =
    (Coin, Coin) -> Gen Coin
chooseLedgerCoin (Coin
forall a. Monoid a => a
mempty, Int -> Coin -> Coin
forall a b. (Semigroup a, Integral b) => b -> a -> a
stimes (Int
2 :: Int) Coin
coin)