Skip to content

Commit 0b6b10b

Browse files
committed
Add roundtrip tests and fix SerialiseAsCBOR for PlutusScriptInEra
Fix serialiseToCBOR to extract raw script bytes from PlutusRunnable instead of using L.serialize' which adds CBOR framing that deserialiseFromCBOR does not expect. Add CBOR and TextEnvelope roundtrip tests for PlutusScriptInEra and AnyPlutusScript. Add haddocks for the text envelope functions.
1 parent aa48590 commit 0b6b10b

2 files changed

Lines changed: 41 additions & 2 deletions

File tree

  • cardano-api
    • src/Cardano/Api/Experimental/Plutus/Internal
    • test/cardano-api-test/Test/Cardano/Api/Transaction/Body/Plutus

cardano-api/src/Cardano/Api/Experimental/Plutus/Internal/Script.hs

Lines changed: 6 additions & 1 deletion
Original file line numberDiff line numberDiff line change
@@ -118,7 +118,7 @@ instance
118118
=> SerialiseAsCBOR (PlutusScriptInEra (lang :: L.Language) era)
119119
where
120120
serialiseToCBOR (PlutusScriptInEra s) =
121-
L.serialize' (L.eraProtVerHigh @era) s
121+
SBS.fromShort . L.unPlutusBinary . L.plutusBinary $ L.plutusFromRunnable s
122122

123123
deserialiseFromCBOR _ bs = do
124124
let v = L.eraProtVerHigh @era
@@ -204,12 +204,17 @@ data AnyPlutusScriptLanguage where
204204
:: L.PlutusLanguage lang
205205
=> L.SLanguage lang -> AnyPlutusScriptLanguage
206206

207+
-- | Serialise an 'AnyPlutusScript' to a 'TextEnvelope'. The text envelope type
208+
-- is determined by the Plutus language version of the script.
207209
serialiseAnyPlutusScriptToTextEnvelope
208210
:: Maybe TextEnvelopeDescr -> AnyPlutusScript era -> TextEnvelope
209211
serialiseAnyPlutusScriptToTextEnvelope mbDescr (AnyPlutusScript script) =
210212
obtainLangConstraints (plutusScriptInEraSLanguage script) $
211213
serialiseToTextEnvelope mbDescr script
212214

215+
-- | Deserialise an 'AnyPlutusScript' from a 'TextEnvelope'. The text envelope type
216+
-- is matched against all known Plutus language versions derived from
217+
-- 'Plutus.nonNativeLanguages', so new language versions are picked up automatically.
213218
deserialiseAnyPlutusScriptFromTextEnvelope
214219
:: forall era
215220
. L.Era era

cardano-api/test/cardano-api-test/Test/Cardano/Api/Transaction/Body/Plutus/Scripts.hs

Lines changed: 35 additions & 1 deletion
Original file line numberDiff line numberDiff line change
@@ -8,22 +8,26 @@ module Test.Cardano.Api.Transaction.Body.Plutus.Scripts
88
)
99
where
1010

11-
import Cardano.Api (AlonzoEraOnwards (..))
11+
import Cardano.Api (AlonzoEraOnwards (..), proxyToAsType)
1212
import Cardano.Api qualified as Api
1313
import Cardano.Api.Experimental
1414
import Cardano.Api.Experimental.AnyScriptWitness
1515
import Cardano.Api.Experimental.Plutus hiding (AnyPlutusScript (..))
16+
import Cardano.Api.Experimental.Plutus qualified as Plutus
1617
import Cardano.Api.Experimental.Tx qualified as Exp
1718
import Cardano.Api.Ledger qualified as L
19+
import Cardano.Api.Serialise.Cbor (SerialiseAsCBOR (..))
1820

1921
import Cardano.Ledger.Conway qualified as L
2022
import Cardano.Ledger.Core qualified as L
23+
import Cardano.Ledger.Plutus.Language qualified as L
2124

2225
import Prelude
2326

2427
import Data.Function
2528
import Data.List qualified as List
2629
import Data.Map.Strict qualified as Map
30+
import Data.Proxy (Proxy (..))
2731

2832
import Test.Gen.Cardano.Api.Experimental qualified as Exp
2933
import Test.Gen.Cardano.Api.Typed
@@ -55,6 +59,30 @@ prop_compare_plutus_script_hashes = property $ do
5559

5660
hash === anyScriptHash
5761

62+
prop_roundtrip_plutus_script_in_era_cbor :: Property
63+
prop_roundtrip_plutus_script_in_era_cbor = property $ do
64+
scriptInEra <- forAll genPlutusScriptInEra
65+
let cbor = serialiseToCBOR scriptInEra
66+
scriptInEra' <-
67+
evalEither $
68+
deserialiseFromCBOR
69+
(proxyToAsType (Proxy @(PlutusScriptInEra L.PlutusV3 (LedgerEra ConwayEra))))
70+
cbor
71+
serialiseToCBOR scriptInEra' === cbor
72+
73+
-- | Serialise an 'AnyPlutusScript' to a 'TextEnvelope' and deserialise it back.
74+
-- We compare the resulting 'TextEnvelope' values because 'AnyPlutusScript' is
75+
-- existentially quantified and does not have an 'Eq' instance.
76+
prop_roundtrip_any_plutus_script_text_envelope :: Property
77+
prop_roundtrip_any_plutus_script_text_envelope = property $ do
78+
scriptInEra <- forAll genPlutusScriptInEra
79+
let anyScript = Plutus.AnyPlutusScript scriptInEra
80+
envelope = serialiseAnyPlutusScriptToTextEnvelope Nothing anyScript
81+
anyScript' <-
82+
evalEither $ deserialiseAnyPlutusScriptFromTextEnvelope @(LedgerEra ConwayEra) envelope
83+
let envelope' = serialiseAnyPlutusScriptToTextEnvelope Nothing anyScript'
84+
envelope === envelope'
85+
5886
-- | This property checks that the redeemer pointer map is constructed correctly.
5987
-- Previously identical script purposes were being created and overwriting each other
6088
-- in the redeemer pointer map.
@@ -214,6 +242,12 @@ tests =
214242
testGroup
215243
"Test.Cardano.Api.Transaction.Body.Plutus.Scripts"
216244
[ testProperty "prop_compare_plutus_script_hashes" prop_compare_plutus_script_hashes
245+
, testProperty
246+
"prop_roundtrip_plutus_script_in_era_cbor"
247+
prop_roundtrip_plutus_script_in_era_cbor
248+
, testProperty
249+
"prop_roundtrip_any_plutus_script_text_envelope"
250+
prop_roundtrip_any_plutus_script_text_envelope
217251
, testProperty
218252
"prop_extractAllIndexedPlutusScriptWitnesses"
219253
prop_extractAllIndexedPlutusScriptWitnesses

0 commit comments

Comments
 (0)