Skip to content

Commit e419167

Browse files
LucsanszkyLucsanszky
committed
Add code review suggestions
* Override cost models when injecting into test state (if extra config cost models are provided) * Preserve `AlonzoGenesis` JSON and binary representations but change the Haskell side representation
1 parent 44a3808 commit e419167

File tree

9 files changed

+242
-419
lines changed

9 files changed

+242
-419
lines changed

‎eras/alonzo/impl/CHANGELOG.md‎

Lines changed: 2 additions & 4 deletions
Original file line numberDiff line numberDiff line change
@@ -2,10 +2,8 @@
22

33
## 1.15.0.0
44

5-
* Renamed `uappCostModels` to `uappPlutusV1CostModel`
6-
and changed its type from `CostModels` to `CostModel`
7-
* Renamed `agCostModels` to `agPlutusV1CostModel`
8-
and changed its type from `CostModels` to `CostModel`
5+
* Changed `uappCostModels` type from `CostModels` to `CostModel`
6+
* Changed `agCostModels` type from `CostModels` to `CostModel`
97
* Updated `AlonzoGenesis` with `extraConfig` field
108
* Added `AlonzoExtraConfig` and its instances
119
* Remove deprecated functions `nullRedeemers`, `lookupRedeemers`, `nullDats`

‎eras/alonzo/impl/src/Cardano/Ledger/Alonzo/Genesis.hs‎

Lines changed: 19 additions & 15 deletions
Original file line numberDiff line numberDiff line change
@@ -4,14 +4,12 @@
44
{-# LANGUAGE FlexibleInstances #-}
55
{-# LANGUAGE GeneralizedNewtypeDeriving #-}
66
{-# LANGUAGE LambdaCase #-}
7-
{-# LANGUAGE NamedFieldPuns #-}
87
{-# LANGUAGE OverloadedStrings #-}
98
{-# LANGUAGE PatternSynonyms #-}
109
{-# LANGUAGE RecordWildCards #-}
1110
{-# LANGUAGE TypeApplications #-}
1211
{-# LANGUAGE TypeFamilies #-}
1312
{-# LANGUAGE UndecidableInstances #-}
14-
{-# LANGUAGE ViewPatterns #-}
1513
{-# OPTIONS_GHC -Wno-orphans #-}
1614

1715
module Cardano.Ledger.Alonzo.Genesis (
@@ -21,7 +19,7 @@ module Cardano.Ledger.Alonzo.Genesis (
2119
extraConfig,
2220
AlonzoGenesis,
2321
agCoinsPerUTxOWord,
24-
agPlutusV1CostModel,
22+
agCostModels,
2523
agPrices,
2624
agMaxTxExUnits,
2725
agMaxBlockExUnits,
@@ -43,9 +41,11 @@ import Cardano.Ledger.Alonzo.Scripts (
4341
CostModels,
4442
ExUnits (..),
4543
Prices (..),
44+
costModelsValid,
4645
decodeCostModel,
4746
decodeCostModelsLenient,
4847
encodeCostModel,
48+
mkCostModels,
4949
)
5050
import Cardano.Ledger.BaseTypes (KeyValuePairs (..), ToKeyValuePairs (..))
5151
import Cardano.Ledger.Binary (
@@ -59,20 +59,23 @@ import Cardano.Ledger.Binary (
5959
import Cardano.Ledger.Binary.Coders
6060
import Cardano.Ledger.Core
6161
import Cardano.Ledger.Genesis (EraGenesis (..))
62-
import Cardano.Ledger.Plutus.CostModels (parseCostModelAsArray, parseCostModels)
63-
import Cardano.Ledger.Plutus.Language (Language (..))
62+
import Cardano.Ledger.Plutus (Language (PlutusV1))
63+
import Cardano.Ledger.Plutus.CostModels (parseCostModels)
6464
import Control.DeepSeq (NFData)
6565
import Data.Aeson (FromJSON (..), ToJSON (..), (.:), (.:?), (.=))
6666
import qualified Data.Aeson as Aeson
6767
import Data.Functor.Identity (Identity)
68+
import Data.Map.Strict ((!))
69+
import qualified Data.Map.Strict as Map
70+
import Data.Maybe (isJust)
6871
import GHC.Generics (Generic)
6972
import NoThunks.Class (NoThunks)
7073
import Numeric.Natural (Natural)
7174

7275
-- | All configuration that is necessary to bootstrap AlonzoEra from ShelleyGenesis
7376
data AlonzoGenesis = AlonzoGenesisWrapper
7477
{ unAlonzoGenesisWrapper :: UpgradeAlonzoPParams Identity
75-
, extraConfig :: AlonzoExtraConfig
78+
, extraConfig :: Maybe AlonzoExtraConfig
7679
}
7780
deriving stock (Eq, Show, Generic)
7881
deriving (ToJSON) via KeyValuePairs AlonzoGenesis
@@ -123,11 +126,11 @@ pattern AlonzoGenesis ::
123126
Natural ->
124127
Natural ->
125128
Natural ->
126-
AlonzoExtraConfig ->
129+
Maybe AlonzoExtraConfig ->
127130
AlonzoGenesis
128131
pattern AlonzoGenesis
129132
{ agCoinsPerUTxOWord
130-
, agPlutusV1CostModel
133+
, agCostModels
131134
, agPrices
132135
, agMaxTxExUnits
133136
, agMaxBlockExUnits
@@ -140,7 +143,7 @@ pattern AlonzoGenesis
140143
{ unAlonzoGenesisWrapper =
141144
UpgradeAlonzoPParams
142145
{ uappCoinsPerUTxOWord = agCoinsPerUTxOWord
143-
, uappPlutusV1CostModel = agPlutusV1CostModel
146+
, uappCostModels = agCostModels
144147
, uappPrices = agPrices
145148
, uappMaxTxExUnits = agMaxTxExUnits
146149
, uappMaxBlockExUnits = agMaxBlockExUnits
@@ -164,7 +167,7 @@ pattern AlonzoGenesis
164167
AlonzoGenesisWrapper
165168
( UpgradeAlonzoPParams
166169
{ uappCoinsPerUTxOWord = coinsPerUTxOWord_
167-
, uappPlutusV1CostModel = costModels_
170+
, uappCostModels = costModels_
168171
, uappPrices = prices_
169172
, uappMaxTxExUnits = maxTxExUnits_
170173
, uappMaxBlockExUnits = maxBlockExUnits_
@@ -206,7 +209,7 @@ instance ToCBOR AlonzoGenesis where
206209
in toEraCBOR @AlonzoEra . encode $
207210
Rec AlonzoGenesis
208211
!> To agCoinsPerUTxOWord
209-
!> E encodeCostModel agPlutusV1CostModel
212+
!> E encodeCostModel agCostModels
210213
!> To agPrices
211214
!> To agMaxTxExUnits
212215
!> To agMaxBlockExUnits
@@ -218,25 +221,26 @@ instance ToCBOR AlonzoGenesis where
218221
instance FromJSON AlonzoGenesis where
219222
parseJSON = Aeson.withObject "Alonzo Genesis" $ \o -> do
220223
agCoinsPerUTxOWord <- o .: "lovelacePerUTxOWord"
221-
agPlutusV1CostModel <- parseCostModelAsArray False PlutusV1 =<< o .: "plutusV1CostModel"
224+
cms <- parseCostModels False =<< o .: "costModels"
222225
agPrices <- o .: "executionPrices"
223226
agMaxTxExUnits <- o .: "maxTxExUnits"
224227
agMaxBlockExUnits <- o .: "maxBlockExUnits"
225228
agMaxValSize <- o .: "maxValueSize"
226229
agCollateralPercentage <- o .: "collateralPercentage"
227230
agMaxCollateralInputs <- o .: "maxCollateralInputs"
228-
agExtraConfig <- o .: "extraConfig"
231+
agExtraConfig <- o .:? "extraConfig"
232+
let agCostModels = costModelsValid cms ! PlutusV1
229233
return AlonzoGenesis {..}
230234

231235
instance ToKeyValuePairs AlonzoGenesis where
232236
toKeyValuePairs ag =
233237
[ "lovelacePerUTxOWord" .= agCoinsPerUTxOWord ag
234-
, "plutusV1CostModel" .= agPlutusV1CostModel ag
238+
, "costModels" .= mkCostModels (Map.singleton PlutusV1 $ agCostModels ag)
235239
, "executionPrices" .= agPrices ag
236240
, "maxTxExUnits" .= agMaxTxExUnits ag
237241
, "maxBlockExUnits" .= agMaxBlockExUnits ag
238242
, "maxValueSize" .= agMaxValSize ag
239243
, "collateralPercentage" .= agCollateralPercentage ag
240244
, "maxCollateralInputs" .= agMaxCollateralInputs ag
241-
, "extraConfig" .= agExtraConfig ag
242245
]
246+
++ ["extraConfig" .= agExtraConfig ag | isJust (agExtraConfig ag)]

‎eras/alonzo/impl/src/Cardano/Ledger/Alonzo/PParams.hs‎

Lines changed: 3 additions & 3 deletions
Original file line numberDiff line numberDiff line change
@@ -409,7 +409,7 @@ instance Ord OrdExUnits where
409409
-- | Parameters that were added in Alonzo
410410
data UpgradeAlonzoPParams f = UpgradeAlonzoPParams
411411
{ uappCoinsPerUTxOWord :: !(HKD f CoinPerWord)
412-
, uappPlutusV1CostModel :: !(HKD f CostModel)
412+
, uappCostModels :: !(HKD f CostModel)
413413
, uappPrices :: !(HKD f Prices)
414414
, uappMaxTxExUnits :: !(HKD f ExUnits)
415415
, uappMaxBlockExUnits :: !(HKD f ExUnits)
@@ -443,7 +443,7 @@ instance Default (UpgradeAlonzoPParams StrictMaybe) where
443443
def =
444444
UpgradeAlonzoPParams
445445
{ uappCoinsPerUTxOWord = SNothing
446-
, uappPlutusV1CostModel = SNothing
446+
, uappCostModels = SNothing
447447
, uappPrices = SNothing
448448
, uappMaxTxExUnits = SNothing
449449
, uappMaxBlockExUnits = SNothing
@@ -612,7 +612,7 @@ upgradeAlonzoPParams UpgradeAlonzoPParams {..} ShelleyPParams {..} =
612612
, appMinPoolCost = sppMinPoolCost
613613
, -- new in alonzo
614614
appCoinsPerUTxOWord = uappCoinsPerUTxOWord
615-
, appCostModels = hkdMap (Proxy @f) (mkCostModels . Map.singleton PlutusV1) uappPlutusV1CostModel
615+
, appCostModels = hkdMap (Proxy @f) (mkCostModels . Map.singleton PlutusV1) uappCostModels
616616
, appPrices = uappPrices
617617
, appMaxTxExUnits = hkdMap (Proxy @f) OrdExUnits uappMaxTxExUnits
618618
, appMaxBlockExUnits = hkdMap (Proxy @f) OrdExUnits uappMaxBlockExUnits

‎eras/alonzo/impl/src/Cardano/Ledger/Alonzo/Transition.hs‎

Lines changed: 15 additions & 2 deletions
Original file line numberDiff line numberDiff line change
@@ -8,11 +8,14 @@ module Cardano.Ledger.Alonzo.Transition (
88
TransitionConfig (..),
99
) where
1010

11+
import Cardano.Ledger.Alonzo.Core (AlonzoEraPParams, ppCostModelsL)
1112
import Cardano.Ledger.Alonzo.Era
12-
import Cardano.Ledger.Alonzo.Genesis (AlonzoGenesis)
13+
import Cardano.Ledger.Alonzo.Genesis
1314
import Cardano.Ledger.Alonzo.Translation ()
1415
import Cardano.Ledger.Mary
1516
import Cardano.Ledger.Mary.Transition (TransitionConfig (MaryTransitionConfig))
17+
import Cardano.Ledger.Plutus.CostModels (CostModels)
18+
import Cardano.Ledger.Shelley.LedgerState
1619
import Cardano.Ledger.Shelley.Transition
1720
import GHC.Generics
1821
import Lens.Micro
@@ -27,7 +30,9 @@ instance EraTransition AlonzoEra where
2730

2831
mkTransitionConfig = AlonzoTransitionConfig
2932

30-
injectIntoTestState = shelleyRegisterInitialFundsThenStaking
33+
injectIntoTestState cfg = case agExtraConfig $ cfg ^. tcTranslationContextL of
34+
Nothing -> shelleyRegisterInitialFundsThenStaking cfg
35+
Just aec -> shelleyRegisterInitialFundsThenStaking cfg . overrideCostModels (aecCostModels aec)
3136

3237
tcPreviousEraConfigL =
3338
lens atcMaryTransitionConfig (\atc pc -> atc {atcMaryTransitionConfig = pc})
@@ -36,3 +41,11 @@ instance EraTransition AlonzoEra where
3641
lens atcAlonzoGenesis (\atc ag -> atc {atcAlonzoGenesis = ag})
3742

3843
instance NoThunks (TransitionConfig AlonzoEra)
44+
45+
overrideCostModels ::
46+
(EraTransition era, AlonzoEraPParams era) =>
47+
Maybe CostModels ->
48+
NewEpochState era ->
49+
NewEpochState era
50+
overrideCostModels Nothing nes = nes
51+
overrideCostModels (Just cms) nes = nes & nesEsL . curPParamsEpochStateL . ppCostModelsL %~ (<> cms)

‎eras/alonzo/impl/testlib/Test/Cardano/Ledger/Alonzo/Examples.hs‎

Lines changed: 3 additions & 3 deletions
Original file line numberDiff line numberDiff line change
@@ -15,7 +15,7 @@ module Test.Cardano.Ledger.Alonzo.Examples (
1515

1616
import Cardano.Ledger.Alonzo (AlonzoEra)
1717
import Cardano.Ledger.Alonzo.Core
18-
import Cardano.Ledger.Alonzo.Genesis (AlonzoExtraConfig (..), AlonzoGenesis (..))
18+
import Cardano.Ledger.Alonzo.Genesis (AlonzoGenesis (..))
1919
import Cardano.Ledger.Alonzo.Plutus.Context (EraPlutusTxInfo)
2020
import Cardano.Ledger.Alonzo.Scripts (
2121
AlonzoPlutusPurpose (..),
@@ -210,12 +210,12 @@ exampleAlonzoGenesis :: AlonzoGenesis
210210
exampleAlonzoGenesis =
211211
AlonzoGenesis
212212
{ agCoinsPerUTxOWord = CoinPerWord $ Coin 1
213-
, agPlutusV1CostModel = zeroTestingCostModelV1
213+
, agCostModels = zeroTestingCostModelV1
214214
, agPrices = Prices (unsafeBoundRational 90) (unsafeBoundRational 91)
215215
, agMaxTxExUnits = ExUnits 123 123
216216
, agMaxBlockExUnits = ExUnits 223 223
217217
, agMaxValSize = 1234
218218
, agCollateralPercentage = 20
219219
, agMaxCollateralInputs = 30
220-
, agExtraConfig = AlonzoExtraConfig Nothing
220+
, agExtraConfig = Nothing
221221
}

‎eras/alonzo/impl/testlib/Test/Cardano/Ledger/Alonzo/ImpTest.hs‎

Lines changed: 3 additions & 3 deletions
Original file line numberDiff line numberDiff line change
@@ -47,7 +47,7 @@ module Test.Cardano.Ledger.Alonzo.ImpTest (
4747
import Cardano.Ledger.Address (Addr (..))
4848
import Cardano.Ledger.Alonzo (AlonzoEra)
4949
import Cardano.Ledger.Alonzo.Core
50-
import Cardano.Ledger.Alonzo.Genesis (AlonzoExtraConfig (..), AlonzoGenesis (..))
50+
import Cardano.Ledger.Alonzo.Genesis (AlonzoGenesis (..))
5151
import Cardano.Ledger.Alonzo.Plutus.Context (ContextError)
5252
import Cardano.Ledger.Alonzo.Plutus.Evaluate (
5353
collectPlutusScriptsWithContext,
@@ -413,7 +413,7 @@ instance ShelleyEraImp AlonzoEra where
413413
pure
414414
AlonzoGenesis
415415
{ agCoinsPerUTxOWord = CoinPerWord (Coin 34_482)
416-
, agPlutusV1CostModel = testingCostModel PlutusV1
416+
, agCostModels = testingCostModel PlutusV1
417417
, agPrices =
418418
Prices
419419
{ prMem = 577 %! 10_000
@@ -432,7 +432,7 @@ instance ShelleyEraImp AlonzoEra where
432432
, agMaxValSize = 5000
433433
, agCollateralPercentage = 150
434434
, agMaxCollateralInputs = 3
435-
, agExtraConfig = AlonzoExtraConfig Nothing
435+
, agExtraConfig = Nothing
436436
}
437437

438438
impSatisfyNativeScript = impAllegraSatisfyNativeScript

0 commit comments

Comments
 (0)