From b2985363256e8d79a23fc389a2c4371a08e6ba47 Mon Sep 17 00:00:00 2001 From: Mateusz Galazyn Date: Thu, 4 Jul 2024 20:21:27 +0200 Subject: [PATCH] test cost model decoder round trip --- cardano-api/cardano-api.cabal | 1 + cardano-api/internal/Cardano/Api/Genesis.hs | 43 +++--- .../Test/Cardano/Api/Genesis.hs | 125 +++++++++++------- 3 files changed, 107 insertions(+), 62 deletions(-) diff --git a/cardano-api/cardano-api.cabal b/cardano-api/cardano-api.cabal index f99efe57f6..1f54811f45 100644 --- a/cardano-api/cardano-api.cabal +++ b/cardano-api/cardano-api.cabal @@ -320,6 +320,7 @@ test-suite cardano-api-test cardano-ledger-core:{cardano-ledger-core, testlib} >=1.8, cardano-protocol-tpraos, cardano-slotting, + cborg, containers, directory, hedgehog >=1.1, diff --git a/cardano-api/internal/Cardano/Api/Genesis.hs b/cardano-api/internal/Cardano/Api/Genesis.hs index 1d2df89b00..582269d2d2 100644 --- a/cardano-api/internal/Cardano/Api/Genesis.hs +++ b/cardano-api/internal/Cardano/Api/Genesis.hs @@ -61,9 +61,9 @@ import Cardano.Ledger.Shelley.Genesis (NominalDiffTimeMicro, ShelleyGe emptyGenesisStaking) import qualified Cardano.Ledger.Shelley.Genesis as Ledger import qualified Ouroboros.Consensus.Shelley.Eras as Shelley -import qualified PlutusLedgerApi.Common as V2 import qualified PlutusLedgerApi.V2 as V2 +import Control.Monad import Control.Monad.Trans.Fail.String (errorFail) import qualified Data.Aeson as A import Data.ByteString (ByteString) @@ -77,6 +77,7 @@ import Data.Map (Map) import qualified Data.Map.Strict as M import Data.Maybe import Data.Ratio +import qualified Data.Set as S import Data.Text (Text) import qualified Data.Time as Time import Data.Typeable @@ -239,36 +240,46 @@ decodeAlonzoGenesis (Just aeo) genesisBs = modifyError ("Cannot decode era-sensi obj@(A.Object _) -> do -- decode cost model into a map first costModel :: Map V2.ParamName Int64 <- modifyError ("Decoding cost model object: " <> ) $ fromJsonE obj - setCostModelDefaultValues - . A.toJSON -- convert to an array representation of Int64 values - . fmap snd - . sortOn fst -- ensure proper order of params in the list - . toList - . (`M.union` costModelDefaultValues) -- add default values of missing params - $ costModel + + let costModelWithDefaults = + sortOn fst + . toList + $ M.union costModel (M.fromList optionalCostModelDefaultValues) + + -- check that we have all required params + unless (allCostModelParams == (fst <$> costModelWithDefaults)) $ do + let allCostModelParamsSet = fromList allCostModelParams + providedCostModelParamsSet = fromList $ fst <$> costModelWithDefaults + throwError $ "Missing V2 Plutus cost model parameters: " + <> show (toList $ S.difference allCostModelParamsSet providedCostModelParamsSet) + + -- We have already have required params, we already added optional ones (which are trimmed later + -- if required). Continue processing further in array representation. + setCostModelDefaultValues . A.toJSON $ map snd costModelWithDefaults A.Array vec - | V.length vec < costModelExpectedLength -> pure . A.Array . V.take costModelExpectedLength $ vec <> (A.toJSON <$> optionalCostModelDefaultValues) + -- here we rely on an assumption that params are in correct order, so that we can take only the + -- required ones for an era + | V.length vec < costModelExpectedLength -> pure . A.Array . V.take costModelExpectedLength $ vec <> (A.toJSON . snd <$> optionalCostModelDefaultValues) | V.length vec > costModelExpectedLength -> pure . A.Array $ V.take costModelExpectedLength vec other -> pure other costModelExpectedLength :: Int costModelExpectedLength + -- use all available parameters >= conway | isConwayOnwards = length allCostModelParams + -- use only required params in < conway | otherwise = L.costModelParamsCount L.PlutusV2 -- Babbage - optionalCostModelDefaultValues :: (Item l ~ Int64, IsList l) => l - optionalCostModelDefaultValues = fromList $ replicate (length optionalV2costModelParams) maxBound - - costModelDefaultValues :: Map V2.ParamName Int64 - costModelDefaultValues = fromList $ map (, maxBound) allCostModelParams + optionalCostModelDefaultValues :: (Item l ~ (V2.ParamName, Int64), IsList l) => l + optionalCostModelDefaultValues = fromList $ map (, maxBound) optionalV2costModelParams allCostModelParams :: [V2.ParamName] allCostModelParams = [minBound..maxBound] - optionalV2costModelParams :: [Text] - optionalV2costModelParams = map V2.showParamName + optionalV2costModelParams :: [V2.ParamName] + optionalV2costModelParams = [ V2.IntegerToByteString'cpu'arguments'c0 , V2.IntegerToByteString'cpu'arguments'c1 , V2.IntegerToByteString'cpu'arguments'c2 diff --git a/cardano-api/test/cardano-api-test/Test/Cardano/Api/Genesis.hs b/cardano-api/test/cardano-api-test/Test/Cardano/Api/Genesis.hs index a90592876f..07cf1884b1 100644 --- a/cardano-api/test/cardano-api-test/Test/Cardano/Api/Genesis.hs +++ b/cardano-api/test/cardano-api-test/Test/Cardano/Api/Genesis.hs @@ -13,13 +13,17 @@ import Cardano.Api.Genesis import qualified Cardano.Api.Ledger as L import Cardano.Api.Shelley -import qualified Cardano.Binary as CBOR +import qualified Cardano.Binary as CB import qualified Cardano.Ledger.Alonzo.Genesis as L import qualified Cardano.Ledger.Binary as L import qualified Cardano.Ledger.Plutus as L import qualified PlutusLedgerApi.V2 as V2 +import qualified Codec.CBOR.Decoding as CBOR +import qualified Codec.CBOR.Encoding as CBOR +import qualified Codec.CBOR.Write as CBOR import qualified Data.ByteString.Lazy as LBS +import Data.Either import Data.Int (Int64) import qualified Data.Map.Strict as M import Data.Maybe @@ -40,51 +44,49 @@ prop_reading_plutus_v2_era_sensitive_costmodel prop_reading_plutus_v2_era_sensitive_costmodel aeo cmf = H.propertyOnce $ do H.noteShow_ $ "Era: " <> pshow aeo H.noteShow_ $ "Cost model type: " <> show cmf - (genesis, costModelValues) <- loadPlutusV2CostModelFromGenesis aeo (getGenesisFile cmf) + (allCostModels, v2costModelValues) <- H.leftFailM $ loadPlutusV2CostModelFromGenesis (Just aeo) (getGenesisFile cmf) - H.noteShow_ costModelValues + H.noteShow_ v2costModelValues let isConwayOnwards = isJust $ maybeEon @ConwayEraOnwards @era - last10CostModelValues = reverse . take 10 $ reverse costModelValues + last10CostModelValues = reverse . take 10 $ reverse v2costModelValues if isConwayOnwards then do - length costModelValues === 185 + length v2costModelValues === 185 if getCostModelFileParamCount cmf < 185 then last10CostModelValues === replicate 10 maxBound else last10CostModelValues === replicate 10 1 else - length costModelValues === 175 - - let genesisBs = CBOR.serialize genesis - genesis' <- H.leftFail $ decodeCborInEraAlonzoGenesis aeo genesisBs - genesis' === genesis - -decodeCborInEraAlonzoGenesis - :: forall era. AlonzoEraOnwards era - -> LBS.ByteString - -> Either L.DecoderError L.AlonzoGenesis -decodeCborInEraAlonzoGenesis aeo = CBOR.decodeFullDecoder "AlonzoGenesis" fromEraCbor' - where - fromEraCbor' :: CBOR.Decoder s L.AlonzoGenesis - fromEraCbor' = alonzoEraOnwardsConstraints aeo $ do - -- error $ show $ eraProtVerLow (alonzoEraOnwardsToShelleyBasedEra aeo) - L.fromEraCBOR @(ShelleyLedgerEra era) + length v2costModelValues === 175 + let allCostModelsBs = encodeCborInEraCostModels aeo allCostModels + allCostModels' <- H.leftFail $ decodeCborInEraCostModels aeo allCostModelsBs + allCostModels' === allCostModels prop_reading_plutus_v2_costmodel :: PlutusV2CostModelFormat -> Property prop_reading_plutus_v2_costmodel cmf = H.propertyOnce $ do - -- TODO - True === True + H.noteShow_ $ "Cost model type: " <> show cmf + mCostModelValues <- fmap snd <$> loadPlutusV2CostModelFromGenesis Nothing (getGenesisFile cmf) + + H.noteShow_ mCostModelValues + + if cmf == Map175 + then do + H.assertWith mCostModelValues isLeft + else do + costModelValues <- H.leftFail mCostModelValues + length costModelValues === getCostModelFileParamCount cmf prop_verify_plutus_v2_costmodel :: Property prop_verify_plutus_v2_costmodel = H.propertyOnce $ do let lastParamName = maxBound last10Params = (toEnum . subtract 9 $ fromEnum lastParamName) `enumFromTo` lastParamName :: [V2.ParamName] H.note_ "Check that last 10 params of PlutusV2 cost models are exactly the ones we expect" - -- TODO add comment why we need this + -- The conditional logic of trimming conway parameters in babbage relies on the fact that last 10 V2 params + -- are those below last10Params === [ V2.IntegerToByteString'cpu'arguments'c0 , V2.IntegerToByteString'cpu'arguments'c1 @@ -106,7 +108,7 @@ data PlutusV2CostModelFormat | Map185 | Array175 | Array185 - deriving Show + deriving (Eq, Show) getGenesisFile :: PlutusV2CostModelFormat -> FilePath getGenesisFile = ("./test/cardano-api-test/files/input/genesis/spec.alonzo-v2-cost-model-" <>) . \case @@ -126,34 +128,65 @@ loadPlutusV2CostModelFromGenesis :: HasCallStack => MonadIO m => MonadTest m - => AlonzoEraOnwards era + => Maybe (AlonzoEraOnwards era) -> FilePath - -> m (L.AlonzoGenesis, [Int64]) -loadPlutusV2CostModelFromGenesis aeo filePath = withFrozenCallStack $ do + -> m (Either String (L.CostModels, [Int64])) +loadPlutusV2CostModelFromGenesis mAeo filePath = withFrozenCallStack . runExceptT $ do genesisBs <- H.lbsReadFile filePath - genesis <- H.leftFailM . runExceptT $ decodeAlonzoGenesis (Just aeo) genesisBs - fmap ((genesis,) . L.getCostModelParams) - . H.nothingFail + costModels <- modifyError show $ L.agCostModels <$> decodeAlonzoGenesis mAeo genesisBs + liftEither + . fmap ((costModels,) . L.getCostModelParams) + . maybe (Left "No PlutusV2 model found") Right . M.lookup L.PlutusV2 - . L.costModelsValid - $ L.agCostModels genesis + $ L.costModelsValid costModels + +decodeCborInEraCostModels + :: forall era. AlonzoEraOnwards era + -> LBS.ByteString + -> Either L.DecoderError L.CostModels +decodeCborInEraCostModels aeo = CB.decodeFullDecoder "AlonzoGenesis" fromEraCbor' + where + fromEraCbor' :: CBOR.Decoder s L.CostModels + fromEraCbor' = alonzoEraOnwardsConstraints aeo $ L.fromEraCBOR @(ShelleyLedgerEra era) + +encodeCborInEraCostModels + :: forall era. AlonzoEraOnwards era + -> L.CostModels + -> LBS.ByteString +encodeCborInEraCostModels aeo = CBOR.toLazyByteString . toEraCbor' + where + toEraCbor' :: L.CostModels -> CBOR.Encoding + toEraCbor' = alonzoEraOnwardsConstraints aeo $ L.toEraCBOR @(ShelleyLedgerEra era) -- * List all test cases tests :: TestTree tests = testGroup "Test.Cardano.Api.Genesis" - [ testProperty "Read Alonzo genesis with PlutusV2 cost model map with 175 params - Babbage" $ prop_reading_plutus_v2_era_sensitive_costmodel AlonzoEraOnwardsBabbage Map175 - , testProperty "Read Alonzo genesis with PlutusV2 cost model map with 175 params - Conway" $ prop_reading_plutus_v2_era_sensitive_costmodel AlonzoEraOnwardsConway Map175 - , testProperty "Read Alonzo genesis with PlutusV2 cost model map with 175 params - era insensitive" $ prop_reading_plutus_v2_costmodel Map175 - , testProperty "Read Alonzo genesis with PlutusV2 cost model map with 185 params - Babbage" $ prop_reading_plutus_v2_era_sensitive_costmodel AlonzoEraOnwardsBabbage Map185 - , testProperty "Read Alonzo genesis with PlutusV2 cost model map with 185 params - Conway" $ prop_reading_plutus_v2_era_sensitive_costmodel AlonzoEraOnwardsConway Map185 - , testProperty "Read Alonzo genesis with PlutusV2 cost model map with 185 params - era insensitive" $ prop_reading_plutus_v2_costmodel Map185 - , testProperty "Read Alonzo genesis with PlutusV2 cost model array with 175 params - Babbage" $ prop_reading_plutus_v2_era_sensitive_costmodel AlonzoEraOnwardsBabbage Array175 - , testProperty "Read Alonzo genesis with PlutusV2 cost model array with 175 params - Conway" $ prop_reading_plutus_v2_era_sensitive_costmodel AlonzoEraOnwardsConway Array175 - , testProperty "Read Alonzo genesis with PlutusV2 cost model array with 175 params - era insensitive" $ prop_reading_plutus_v2_costmodel Array175 - , testProperty "Read Alonzo genesis with PlutusV2 cost model array with 185 params - Babbage" $ prop_reading_plutus_v2_era_sensitive_costmodel AlonzoEraOnwardsBabbage Array185 - , testProperty "Read Alonzo genesis with PlutusV2 cost model array with 185 params - Conway" $ prop_reading_plutus_v2_era_sensitive_costmodel AlonzoEraOnwardsConway Array185 - , testProperty "Read Alonzo genesis with PlutusV2 cost model array with 185 params - era insensitive" $ prop_reading_plutus_v2_costmodel Array185 - , testProperty "Make sure that last 10 PlutusV2 cost model parameters are the ones we expect" prop_verify_plutus_v2_costmodel + [ testProperty "Read Alonzo genesis with PlutusV2 cost model map with 175 params - Babbage" $ + prop_reading_plutus_v2_era_sensitive_costmodel AlonzoEraOnwardsBabbage Map175 + , testProperty "Read Alonzo genesis with PlutusV2 cost model map with 175 params - Conway" $ + prop_reading_plutus_v2_era_sensitive_costmodel AlonzoEraOnwardsConway Map175 + , testProperty "Read Alonzo genesis with PlutusV2 cost model map with 175 params - era insensitive" $ + prop_reading_plutus_v2_costmodel Map175 + , testProperty "Read Alonzo genesis with PlutusV2 cost model map with 185 params - Babbage" $ + prop_reading_plutus_v2_era_sensitive_costmodel AlonzoEraOnwardsBabbage Map185 + , testProperty "Read Alonzo genesis with PlutusV2 cost model map with 185 params - Conway" $ + prop_reading_plutus_v2_era_sensitive_costmodel AlonzoEraOnwardsConway Map185 + , testProperty "Read Alonzo genesis with PlutusV2 cost model map with 185 params - era insensitive" $ + prop_reading_plutus_v2_costmodel Map185 + , testProperty "Read Alonzo genesis with PlutusV2 cost model array with 175 params - Babbage" $ + prop_reading_plutus_v2_era_sensitive_costmodel AlonzoEraOnwardsBabbage Array175 + , testProperty "Read Alonzo genesis with PlutusV2 cost model array with 175 params - Conway" $ + prop_reading_plutus_v2_era_sensitive_costmodel AlonzoEraOnwardsConway Array175 + , testProperty "Read Alonzo genesis with PlutusV2 cost model array with 175 params - era insensitive" $ + prop_reading_plutus_v2_costmodel Array175 + , testProperty "Read Alonzo genesis with PlutusV2 cost model array with 185 params - Babbage" $ + prop_reading_plutus_v2_era_sensitive_costmodel AlonzoEraOnwardsBabbage Array185 + , testProperty "Read Alonzo genesis with PlutusV2 cost model array with 185 params - Conway" $ + prop_reading_plutus_v2_era_sensitive_costmodel AlonzoEraOnwardsConway Array185 + , testProperty "Read Alonzo genesis with PlutusV2 cost model array with 185 params - era insensitive" $ + prop_reading_plutus_v2_costmodel Array185 + , testProperty "Make sure that last 10 PlutusV2 cost model parameters are the ones we expect" + prop_verify_plutus_v2_costmodel ]