Skip to content

Commit

Permalink
Enforce PlutusV3 cost model key order
Browse files Browse the repository at this point in the history
(cherry picked from commit 5aa8e07)
  • Loading branch information
errfrom committed Sep 5, 2024
1 parent 85ecbbb commit 4d1136d
Show file tree
Hide file tree
Showing 4 changed files with 513 additions and 12 deletions.
Empty file.
1 change: 1 addition & 0 deletions spago.dhall
Original file line number Diff line number Diff line change
Expand Up @@ -44,6 +44,7 @@ You can edit this file as you like.
, "foreign-object"
, "formatters"
, "functions"
, "heterogeneous"
, "http-methods"
, "identity"
, "integers"
Expand Down
29 changes: 18 additions & 11 deletions src/Internal/Service/Blockfrost.purs
Original file line number Diff line number Diff line change
Expand Up @@ -87,7 +87,6 @@ import Cardano.Serialization.Lib (toBytes)
import Cardano.Types
( AssetClass(AssetClass)
, AuxiliaryData
, CostModel
, DataHash
, GeneralTransactionMetadata(GeneralTransactionMetadata)
, Language(PlutusV3, PlutusV2, PlutusV1)
Expand Down Expand Up @@ -195,7 +194,13 @@ import Ctl.Internal.Types.EraSummaries
, EraSummaryParameters
)
import Ctl.Internal.Types.ProtocolParameters
( ProtocolParameters(ProtocolParameters)
( CostModelV1
, CostModelV2
, ProtocolParameters(ProtocolParameters)
, convertPlutusV1CostModel
, convertPlutusV2CostModel
, convertPlutusV3CostModel
, convertUnnamedPlutusCostModel
)
import Ctl.Internal.Types.Rational (Rational, reduce)
import Ctl.Internal.Types.StakeValidatorHash (StakeValidatorHash)
Expand Down Expand Up @@ -234,7 +239,6 @@ import Effect.Aff.Class (liftAff)
import Effect.Class (liftEffect)
import Effect.Exception (error)
import Foreign.Object (Object)
import Foreign.Object (values) as Object
import Foreign.Object as ForeignObject
import JS.BigInt (fromString, toNumber) as BigInt
import Prim.TypeError (class Warn, Text)
Expand Down Expand Up @@ -1516,8 +1520,8 @@ type BlockfrostProtocolParametersRaw =
, "protocol_minor_ver" :: UInt
, "min_pool_cost" :: Stringed BigNum
, "cost_models" ::
{ "PlutusV1" :: Object Cardano.Int
, "PlutusV2" :: Object Cardano.Int
{ "PlutusV1" :: { | CostModelV1 }
, "PlutusV2" :: { | CostModelV2 }
, "PlutusV3" :: Object Cardano.Int
}
, "price_mem" :: FiniteBigNumber
Expand Down Expand Up @@ -1585,6 +1589,12 @@ instance DecodeAeson BlockfrostProtocolParameters where
maybe (Left $ AtKey "coins_per_utxo_size" $ MissingValue)
pure $ (Coin <<< unwrap <$> raw.coins_per_utxo_size)

let plutusV3CostModelRaw = raw.cost_models."PlutusV3"
plutusV3CostModel <-
note (AtKey "cost_models" $ AtKey "PlutusV3" $ TypeMismatch "CostModel")
( convertPlutusV3CostModel plutusV3CostModelRaw
<|> convertUnnamedPlutusCostModel plutusV3CostModelRaw
)
pure $ BlockfrostProtocolParameters $ ProtocolParameters
{ protocolVersion: raw.protocol_major_ver /\ raw.protocol_minor_ver
-- The following two parameters were removed from Babbage
Expand All @@ -1604,9 +1614,9 @@ instance DecodeAeson BlockfrostProtocolParameters where
, treasuryCut
, coinsPerUtxoByte: coinsPerUtxoByte
, costModels: Map.fromFoldable
[ PlutusV1 /\ convertPlutusCostModel raw.cost_models."PlutusV1"
, PlutusV2 /\ convertPlutusCostModel raw.cost_models."PlutusV2"
, PlutusV3 /\ convertPlutusCostModel raw.cost_models."PlutusV3"
[ PlutusV1 /\ convertPlutusV1CostModel raw.cost_models."PlutusV1"
, PlutusV2 /\ convertPlutusV2CostModel raw.cost_models."PlutusV2"
, PlutusV3 /\ plutusV3CostModel
]
, prices
, maxTxExUnits:
Expand All @@ -1625,9 +1635,6 @@ instance DecodeAeson BlockfrostProtocolParameters where
, govActionDeposit: Coin $ unwrap raw.gov_action_deposit
, drepDeposit: Coin $ unwrap raw.drep_deposit
}
where
convertPlutusCostModel :: Object Cardano.Int -> CostModel
convertPlutusCostModel = wrap <<< Object.values

--------------------------------------------------------------------------------
-- BlockfrostRewards
Expand Down
Loading

0 comments on commit 4d1136d

Please sign in to comment.