@@ -8,6 +8,7 @@ module Test.Cardano.Api.Genesis
88 )
99where
1010
11+ import qualified Cardano.Api as Api (CostModels (.. ))
1112import Cardano.Api.Eon.ShelleyBasedEra
1213import Cardano.Api.Eras
1314import Cardano.Api.Genesis
@@ -23,6 +24,7 @@ import qualified PlutusLedgerApi.V2 as V2
2324import qualified Codec.CBOR.Decoding as CBOR
2425import qualified Codec.CBOR.Encoding as CBOR
2526import qualified Codec.CBOR.Write as CBOR
27+ import qualified Data.Aeson as Aeson
2628import qualified Data.ByteString.Lazy as LBS
2729import Data.Either
2830import Data.Int (Int64 )
@@ -177,8 +179,61 @@ encodeCborInEraCostModels aeo = CBOR.toLazyByteString . toEraCbor'
177179 toEraCbor' :: L. CostModels -> CBOR. Encoding
178180 toEraCbor' = alonzoEraOnwardsConstraints aeo $ L. toEraCBOR @ (ShelleyLedgerEra era )
179181
182+ prop_plutus_costmodel_sizes :: Property
183+ prop_plutus_costmodel_sizes = H. propertyOnce $ do
184+ -- PV1 tests
185+ -- Exact expected number of parameters
186+ testWorks " ./test/cardano-api-test/files/input/genesis/pv1-array-166.json" PlutusScriptV1 166
187+ testWorks " ./test/cardano-api-test/files/input/genesis/pv1-map-166.json" PlutusScriptV1 166
188+ -- TODO This file loads fine, whereas it shouldn't
189+ -- _testFails "./test/cardano-api-test/files/input/genesis/pv1-array-165.json"
190+ _testFails " ./test/cardano-api-test/files/input/genesis/pv1-map-165.json"
191+
192+ -- PV2 tests
193+ -- Babbage has 175 PV2 parameters:
194+ testWorks " ./test/cardano-api-test/files/input/genesis/pv2-array-175.json" PlutusScriptV2 175
195+ -- Conway has 185 PV2 parameters:
196+ testWorks " ./test/cardano-api-test/files/input/genesis/pv2-array-185.json" PlutusScriptV2 185
197+ -- TODO This file loads fine, whereas it shouldn't
198+ -- _testFails "./test/cardano-api-test/files/input/genesis/pv2-array-174.json"
199+ _testFails " ./test/cardano-api-test/files/input/genesis/pv2-map-174.json"
200+
201+ -- PV3 tests
202+ testWorks " ./test/cardano-api-test/files/input/genesis/pv3-array-297.json" PlutusScriptV3 297
203+ -- TODO This file loads fine, whereas it shouldn't
204+ -- _testFails "./test/cardano-api-test/files/input/genesis/pv3-array-296.json"
205+ testWorks " ./test/cardano-api-test/files/input/genesis/pv3-map-297.json" PlutusScriptV3 297
206+ _testFails " ./test/cardano-api-test/files/input/genesis/pv3-map-296.json"
207+ where
208+ testWorks filepath whichPlutusVersion expectedSize = do
209+ genesisBs <- H. lbsReadFile filepath
210+ let decoded :: Either String Api. CostModels = Aeson. eitherDecode genesisBs
211+ case decoded of
212+ Left err -> do
213+ H. annotateShow err
214+ H. assert False
215+ Right (Api. CostModels cms) -> do
216+ case M. lookup (AnyPlutusScriptVersion whichPlutusVersion) cms of
217+ Nothing -> do
218+ H. note_ $ show whichPlutusVersion <> " cost model not found in " <> filepath
219+ H. assert False
220+ Just (CostModel model) -> do
221+ length model H. === expectedSize
222+ pure ()
223+ _testFails filepath = do
224+ genesisBs <- H. lbsReadFile filepath
225+ let decoded :: Either String Api. CostModels = Aeson. eitherDecode genesisBs
226+ case decoded of
227+ Left _err -> do
228+ pure ()
229+ Right _ -> do
230+ H. note_ $ " Decoding of " <> filepath <> " succeeded, whereas it was expected to fail!"
231+ H. assert False
232+
180233-- * List all test cases
181234
235+ -- Execute me with:
236+ -- @cabal test cardano-api-test --test-options '-p "/Test.Cardano.Api.Genesis/"'@
182237tests :: TestTree
183238tests =
184239 testGroup
@@ -210,4 +265,7 @@ tests =
210265 , testProperty
211266 " Make sure that last 10 PlutusV2 cost model parameters are the ones we expect"
212267 prop_verify_plutus_v2_costmodel
268+ , testProperty
269+ " Make sure that Plutus cost model sizes are validated correctly"
270+ prop_plutus_costmodel_sizes
213271 ]
0 commit comments