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

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

import Cardano.Ledger.Babbage (BabbageEra)
import Cardano.Ledger.Conway (ConwayEra)
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 BabbageEra -> 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
dec <- forall a. FromJSON a => [Char] -> IO (Either [Char] a)
eitherDecodeFileStrict' [Char]
file
    ConwayGenesis
cg <- case Either [Char] ConwayGenesis
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
x -> forall (f :: * -> *) a. Applicative f => a -> f a
pure ConwayGenesis
x
    ConwayGenesis
cg forall a. (HasCallStack, Show a, Eq a) => a -> a -> IO ()
`shouldBe` ConwayGenesis
expectedConwayGenesis

propConwayPParamsUpgrade :: UpgradeConwayPParams Identity -> PParams BabbageEra -> Property
propConwayPParamsUpgrade :: UpgradeConwayPParams Identity -> PParams BabbageEra -> Property
propConwayPParamsUpgrade UpgradeConwayPParams Identity
ppu PParams BabbageEra
pp = forall prop. Testable prop => prop -> Property
property forall a b. (a -> b) -> a -> b
$ do
  let pp' :: PParams ConwayEra
pp' = forall era.
(EraPParams era, EraPParams (PreviousEra era)) =>
UpgradePParams Identity era
-> PParams (PreviousEra era) -> PParams era
upgradePParams UpgradeConwayPParams Identity
ppu PParams BabbageEra
pp :: PParams ConwayEra
  PParams ConwayEra
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 ConwayEra
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 ConwayEra
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 ConwayEra
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 ConwayEra
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 ConwayEra
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 ConwayEra
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 ConwayEra
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 ConwayEra
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 ConwayEra
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)