{-# LANGUAGE DataKinds #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE ScopedTypeVariables #-}

module Test.Cardano.Ledger.Conway.GenesisSpec (spec) where

import Cardano.Ledger.Babbage (Babbage)
import Cardano.Ledger.Conway (Conway)
import Cardano.Ledger.Conway.Core
import Cardano.Ledger.Conway.PParams
import Cardano.Ledger.Plutus.CostModels (costModelsValid)
import Cardano.Ledger.Plutus.Language (Language (PlutusV3))
import Data.Aeson hiding (Encoding)
import Data.Functor.Identity (Identity)
import qualified Data.Map.Strict as Map
import Lens.Micro
import Paths_cardano_ledger_conway (getDataFileName)
import Test.Cardano.Ledger.Common
import Test.Cardano.Ledger.Conway.Genesis (expectedConwayGenesis)
import Test.Cardano.Slotting.Numeric ()

spec :: Spec
spec :: Spec
spec = do
  forall a. HasCallStack => [Char] -> SpecWith a -> SpecWith a
describe [Char]
"ConwayGenesis" forall a b. (a -> b) -> a -> b
$ do
    forall a. HasCallStack => [Char] -> SpecWith a -> SpecWith a
describe [Char]
"Golden Spec" Spec
goldenConwayGenesisJSON
    forall prop.
(HasCallStack, Testable prop) =>
[Char] -> prop -> Spec
prop [Char]
"Upgrades" UpgradeConwayPParams Identity -> PParams Babbage -> Property
propConwayPParamsUpgrade

fileName :: String
fileName :: [Char]
fileName = [Char]
"test/data/conway-genesis.json"

goldenConwayGenesisJSON :: Spec
goldenConwayGenesisJSON :: Spec
goldenConwayGenesisJSON =
  forall a.
(HasCallStack, Example a) =>
[Char] -> a -> SpecWith (Arg a)
it [Char]
"should deserialize to the default value" forall a b. (a -> b) -> a -> b
$ do
    [Char]
file <- [Char] -> IO [Char]
getDataFileName [Char]
fileName
    Either [Char] (ConwayGenesis StandardCrypto)
dec <- forall a. FromJSON a => [Char] -> IO (Either [Char] a)
eitherDecodeFileStrict' [Char]
file
    ConwayGenesis StandardCrypto
cg <- case Either [Char] (ConwayGenesis StandardCrypto)
dec of
      Left [Char]
err -> forall a. HasCallStack => [Char] -> a
error ([Char]
"Failed to deserialize JSON: " forall a. [a] -> [a] -> [a]
++ [Char]
err)
      Right ConwayGenesis StandardCrypto
x -> forall (f :: * -> *) a. Applicative f => a -> f a
pure ConwayGenesis StandardCrypto
x
    ConwayGenesis StandardCrypto
cg forall a. (HasCallStack, Show a, Eq a) => a -> a -> IO ()
`shouldBe` ConwayGenesis StandardCrypto
expectedConwayGenesis

propConwayPParamsUpgrade :: UpgradeConwayPParams Identity -> PParams Babbage -> Property
propConwayPParamsUpgrade :: UpgradeConwayPParams Identity -> PParams Babbage -> Property
propConwayPParamsUpgrade UpgradeConwayPParams Identity
ppu PParams Babbage
pp = forall prop. Testable prop => prop -> Property
property forall a b. (a -> b) -> a -> b
$ do
  let pp' :: PParams Conway
pp' = forall era.
(EraPParams era, EraPParams (PreviousEra era)) =>
UpgradePParams Identity era
-> PParams (PreviousEra era) -> PParams era
upgradePParams UpgradeConwayPParams Identity
ppu PParams Babbage
pp :: PParams Conway
  PParams Conway
pp' forall s a. s -> Getting a s a -> a
^. forall era.
ConwayEraPParams era =>
Lens' (PParams era) PoolVotingThresholds
ppPoolVotingThresholdsL forall a. (HasCallStack, Show a, Eq a) => a -> a -> IO ()
`shouldBe` forall (f :: * -> *).
UpgradeConwayPParams f -> HKD f PoolVotingThresholds
ucppPoolVotingThresholds UpgradeConwayPParams Identity
ppu
  PParams Conway
pp' forall s a. s -> Getting a s a -> a
^. forall era.
ConwayEraPParams era =>
Lens' (PParams era) DRepVotingThresholds
ppDRepVotingThresholdsL forall a. (HasCallStack, Show a, Eq a) => a -> a -> IO ()
`shouldBe` forall (f :: * -> *).
UpgradeConwayPParams f -> HKD f DRepVotingThresholds
ucppDRepVotingThresholds UpgradeConwayPParams Identity
ppu
  forall a b. (Integral a, Num b) => a -> b
fromIntegral (PParams Conway
pp' forall s a. s -> Getting a s a -> a
^. forall era. ConwayEraPParams era => Lens' (PParams era) Natural
ppCommitteeMinSizeL) forall a. (HasCallStack, Show a, Eq a) => a -> a -> IO ()
`shouldBe` forall (f :: * -> *). UpgradeConwayPParams f -> HKD f Word16
ucppCommitteeMinSize UpgradeConwayPParams Identity
ppu
  PParams Conway
pp' forall s a. s -> Getting a s a -> a
^. forall era.
ConwayEraPParams era =>
Lens' (PParams era) EpochInterval
ppCommitteeMaxTermLengthL forall a. (HasCallStack, Show a, Eq a) => a -> a -> IO ()
`shouldBe` forall (f :: * -> *). UpgradeConwayPParams f -> HKD f EpochInterval
ucppCommitteeMaxTermLength UpgradeConwayPParams Identity
ppu
  PParams Conway
pp' forall s a. s -> Getting a s a -> a
^. forall era.
ConwayEraPParams era =>
Lens' (PParams era) EpochInterval
ppGovActionLifetimeL forall a. (HasCallStack, Show a, Eq a) => a -> a -> IO ()
`shouldBe` forall (f :: * -> *). UpgradeConwayPParams f -> HKD f EpochInterval
ucppGovActionLifetime UpgradeConwayPParams Identity
ppu
  PParams Conway
pp' forall s a. s -> Getting a s a -> a
^. forall era. ConwayEraPParams era => Lens' (PParams era) Coin
ppGovActionDepositL forall a. (HasCallStack, Show a, Eq a) => a -> a -> IO ()
`shouldBe` forall (f :: * -> *). UpgradeConwayPParams f -> HKD f Coin
ucppGovActionDeposit UpgradeConwayPParams Identity
ppu
  PParams Conway
pp' forall s a. s -> Getting a s a -> a
^. forall era. ConwayEraPParams era => Lens' (PParams era) Coin
ppDRepDepositL forall a. (HasCallStack, Show a, Eq a) => a -> a -> IO ()
`shouldBe` forall (f :: * -> *). UpgradeConwayPParams f -> HKD f Coin
ucppDRepDeposit UpgradeConwayPParams Identity
ppu
  PParams Conway
pp' forall s a. s -> Getting a s a -> a
^. forall era.
ConwayEraPParams era =>
Lens' (PParams era) EpochInterval
ppDRepActivityL forall a. (HasCallStack, Show a, Eq a) => a -> a -> IO ()
`shouldBe` forall (f :: * -> *). UpgradeConwayPParams f -> HKD f EpochInterval
ucppDRepActivity UpgradeConwayPParams Identity
ppu
  PParams Conway
pp' forall s a. s -> Getting a s a -> a
^. forall era.
ConwayEraPParams era =>
Lens' (PParams era) NonNegativeInterval
ppMinFeeRefScriptCostPerByteL forall a. (HasCallStack, Show a, Eq a) => a -> a -> IO ()
`shouldBe` forall (f :: * -> *).
UpgradeConwayPParams f -> HKD f NonNegativeInterval
ucppMinFeeRefScriptCostPerByte UpgradeConwayPParams Identity
ppu
  forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup Language
PlutusV3 (CostModels -> Map Language CostModel
costModelsValid (PParams Conway
pp' forall s a. s -> Getting a s a -> a
^. forall era. AlonzoEraPParams era => Lens' (PParams era) CostModels
ppCostModelsL))
    forall a. (HasCallStack, Show a, Eq a) => a -> a -> IO ()
`shouldBe` forall a. a -> Maybe a
Just (forall (f :: * -> *). UpgradeConwayPParams f -> HKD f CostModel
ucppPlutusV3CostModel UpgradeConwayPParams Identity
ppu)