Skip to content

Commit

Permalink
Extend the API ProtocolParameters with Alonzo era ones
Browse files Browse the repository at this point in the history 
Both ProtocolParameters and ProtocolParametersUpdate.

We use AnyPlutusScriptVersion as the map key for the per-language cost
models and prices.

Conversion functions not yet extended.

Co-authored-by: Jordan Millar <jordan.millar@iohk.io>
  • Loading branch information
@dcoutts @Jimbo4350
dcoutts and Jimbo4350 committed May 18, 2021
1 parent 9fb2ded commit fe13a75
Show file tree
Hide file tree
Showing 4 changed files with 124 additions and 5 deletions.
114 changes: 109 additions & 5 deletions cardano-api/src/Cardano/Api/ProtocolParameters.hs
View file
Original file line number Diff line number Diff line change
Expand Up @@ -57,8 +57,6 @@ module Cardano.Api.ProtocolParameters (

import Prelude

import Data.Aeson (FromJSON (..), ToJSON (..), object, withObject, withText, (.:), (.=))
import qualified Data.Aeson as Aeson
import Data.ByteString (ByteString)
import qualified Data.ByteString.Lazy.Char8 as LBS
import Data.Map.Strict (Map)
Expand All @@ -72,6 +70,10 @@ import Numeric.Natural

import Control.Monad

import Data.Aeson (FromJSON (..), ToJSON (..), object, withObject,
withText, (.!=), (.:), (.:?), (.=))
import qualified Data.Aeson as Aeson

import qualified Cardano.Binary as CBOR
import qualified Cardano.Crypto.Hash.Class as Crypto
import Cardano.Slotting.Slot (EpochNo, EpochSize (..))
Expand Down Expand Up @@ -228,7 +230,37 @@ data ProtocolParameters =
--
-- This is the \"tau\" incentives parameter from the design document.
--
protocolParamTreasuryCut :: Rational
protocolParamTreasuryCut :: Rational,

-- | Cost in ada per word of UTxO storage.
--
-- /Introduced in Alonzo/
protocolParamUTxOCostPerWord :: Maybe Lovelace,

-- | Cost models for script languages that use them.
--
-- /Introduced in Alonzo/
protocolParamCostModels :: Map AnyPlutusScriptVersion CostModel,

-- | Price of execution units for script languages that use them.
--
-- /Introduced in Alonzo/
protocolParamPrices :: Map AnyPlutusScriptVersion ExecutionUnitPrices,

-- | Max total script execution resources units allowed per tx
--
-- /Introduced in Alonzo/
protocolParamMaxTxExUnits :: Maybe ExecutionUnits,

-- | Max total script execution resources units allowed per block
--
-- /Introduced in Alonzo/
protocolParamMaxBlockExUnits :: Maybe ExecutionUnits,

-- | Max size of a Value in a tx ouput.
--
-- /Introduced in Alonzo/
protocolParamMaxValueSize :: Maybe Natural
}
deriving (Eq, Generic, Show)

Expand All @@ -253,10 +285,17 @@ instance FromJSON ProtocolParameters where
<*> o .: "poolPledgeInfluence"
<*> o .: "monetaryExpansion"
<*> o .: "treasuryCut"
<*> o .:? "utxoCostPerWord"
<*> o .:? "costModel" .!= Map.empty
<*> o .:? "executionUnitPrices" .!= Map.empty
<*> o .:? "maxTxExecUnits"
<*> o .:? "maxBlockExecUnits"
<*> o .:? "maxValueSize"

instance ToJSON ProtocolParameters where
toJSON pp = object [ "extraPraosEntropy" .= protocolParamExtraPraosEntropy pp
, "stakePoolTargetNum" .= protocolParamStakePoolTargetNum pp
, "minUTxOValue" .= protocolParamMinUTxOValue pp
, "poolRetireMaxEpoch" .= protocolParamPoolRetireMaxEpoch pp
, "decentralization" .= (fromRational $ protocolParamDecentralization pp :: Scientific)
, "stakePoolDeposit" .= protocolParamStakePoolDeposit pp
Expand All @@ -272,7 +311,12 @@ instance ToJSON ProtocolParameters where
in object ["major" .= major, "minor" .= minor]
, "txFeeFixed" .= protocolParamTxFeeFixed pp
, "txFeePerByte" .= protocolParamTxFeePerByte pp
, "minUTxOValue" .= protocolParamMinUTxOValue pp
-- Alonzo era:
, "costModels" .= protocolParamCostModels pp
, "executionUnitPrices" .= protocolParamPrices pp
, "maxTxExecutionUnits" .= protocolParamMaxTxExUnits pp
, "maxBlockExecutionUnits" .= protocolParamMaxBlockExUnits pp
, "maxValSize" .= protocolParamMaxValueSize pp
]

-- ----------------------------------------------------------------------------
Expand Down Expand Up @@ -392,7 +436,38 @@ data ProtocolParametersUpdate =
--
-- This is the \"tau\" incentives parameter from the design document.
--
protocolUpdateTreasuryCut :: Maybe Rational
protocolUpdateTreasuryCut :: Maybe Rational,
-- Introduced in Alonzo

-- | Cost in ada per word of UTxO storage.
--
-- /Introduced in Alonzo/
protocolUpdateUTxOCostPerWord :: Maybe Lovelace,

-- | Cost models for script languages that use them.
--
-- /Introduced in Alonzo/
protocolUpdateCostModels :: Map AnyPlutusScriptVersion CostModel,

-- | Price of execution units for script languages that use them.
--
-- /Introduced in Alonzo/
protocolUpdatePrices :: Map AnyPlutusScriptVersion ExecutionUnitPrices,

-- | Max total script execution resources units allowed per tx
--
-- /Introduced in Alonzo/
protocolUpdateMaxTxExUnits :: Maybe ExecutionUnits,

-- | Max total script execution resources units allowed per block
--
-- /Introduced in Alonzo/
protocolUpdateMaxBlockExUnits :: Maybe ExecutionUnits,

-- | Max size of a 'Value' in a tx output.
--
-- /Introduced in Alonzo/
protocolUpdateParamMaxValueSize :: Maybe Natural
}
deriving (Eq, Show)

Expand All @@ -416,12 +491,23 @@ instance Semigroup ProtocolParametersUpdate where
, protocolUpdatePoolPledgeInfluence = merge protocolUpdatePoolPledgeInfluence
, protocolUpdateMonetaryExpansion = merge protocolUpdateMonetaryExpansion
, protocolUpdateTreasuryCut = merge protocolUpdateTreasuryCut
-- Intoduced in Alonzo below.
, protocolUpdateUTxOCostPerWord = merge protocolUpdateUTxOCostPerWord
, protocolUpdateCostModels = mergeMap protocolUpdateCostModels
, protocolUpdatePrices = mergeMap protocolUpdatePrices
, protocolUpdateMaxTxExUnits = merge protocolUpdateMaxTxExUnits
, protocolUpdateMaxBlockExUnits = merge protocolUpdateMaxBlockExUnits
, protocolUpdateParamMaxValueSize = merge protocolUpdateParamMaxValueSize
}
where
-- prefer the right hand side:
merge :: (ProtocolParametersUpdate -> Maybe a) -> Maybe a
merge f = f ppu2 `mplus` f ppu1

-- prefer the right hand side:
mergeMap :: Ord k => (ProtocolParametersUpdate -> Map k a) -> Map k a
mergeMap f = f ppu2 `Map.union` f ppu1

instance Monoid ProtocolParametersUpdate where
mempty =
ProtocolParametersUpdate {
Expand All @@ -442,6 +528,12 @@ instance Monoid ProtocolParametersUpdate where
, protocolUpdatePoolPledgeInfluence = Nothing
, protocolUpdateMonetaryExpansion = Nothing
, protocolUpdateTreasuryCut = Nothing
, protocolUpdateUTxOCostPerWord = Nothing
, protocolUpdateCostModels = mempty
, protocolUpdatePrices = mempty
, protocolUpdateMaxTxExUnits = Nothing
, protocolUpdateMaxBlockExUnits = Nothing
, protocolUpdateParamMaxValueSize = Nothing
}


Expand Down Expand Up @@ -791,6 +883,12 @@ fromShelleyPParamsUpdate
strictMaybeToMaybe _rho
, protocolUpdateTreasuryCut = Shelley.unitIntervalToRational <$>
strictMaybeToMaybe _tau
, protocolUpdateUTxOCostPerWord = Nothing
, protocolUpdateCostModels = mempty
, protocolUpdatePrices = mempty
, protocolUpdateMaxTxExUnits = Nothing
, protocolUpdateMaxBlockExUnits = Nothing
, protocolUpdateParamMaxValueSize = Nothing
}


Expand Down Expand Up @@ -835,6 +933,12 @@ fromShelleyPParams
, protocolParamPoolPledgeInfluence = _a0
, protocolParamMonetaryExpansion = Shelley.unitIntervalToRational _rho
, protocolParamTreasuryCut = Shelley.unitIntervalToRational _tau
, protocolParamUTxOCostPerWord = Nothing
, protocolParamCostModels = Map.empty
, protocolParamPrices = Map.empty
, protocolParamMaxTxExUnits = Nothing
, protocolParamMaxBlockExUnits = Nothing
, protocolParamMaxValueSize = Nothing
}


Expand Down
1 change: 1 addition & 0 deletions cardano-api/src/Cardano/Api/Script.hs
View file
Original file line number Diff line number Diff line change
Expand Up @@ -14,6 +14,7 @@ module Cardano.Api.Script (
SimpleScriptVersion(..),
PlutusScriptVersion(..),
AnyScriptLanguage(..),
AnyPlutusScriptVersion(..),
IsScriptLanguage(..),
IsSimpleScriptLanguage(..),

Expand Down
7 changes: 7 additions & 0 deletions cardano-api/test/Test/Cardano/Api/Typed/Gen.hs
View file
Original file line number Diff line number Diff line change
Expand Up @@ -662,4 +662,11 @@ genProtocolParameters =
<*> genRational
<*> genRational
<*> genRational
-- TODO: Add proper support for these generators.
<*> return Nothing
<*> return mempty
<*> return mempty
<*> return Nothing
<*> return Nothing
<*> return Nothing

7 changes: 7 additions & 0 deletions cardano-cli/src/Cardano/CLI/Shelley/Parsers.hs
View file
Original file line number Diff line number Diff line change
Expand Up @@ -2236,6 +2236,13 @@ pShelleyProtocolParametersUpdate =
<*> optional pPoolInfluence
<*> optional pMonetaryExpansion
<*> optional pTreasuryExpansion
-- TODO: Add proper support for these params
<*> pure Nothing
<*> pure mempty
<*> pure mempty
<*> pure Nothing
<*> pure Nothing
<*> pure Nothing

pMinFeeLinearFactor :: Parser Natural
pMinFeeLinearFactor =
Expand Down

0 comments on commit fe13a75

Please sign in to comment.