From 3a3aeabfa6940c993ba71d8ec890d0280816c9b0 Mon Sep 17 00:00:00 2001 From: Johannes Lund Date: Tue, 14 Mar 2023 16:24:52 +0100 Subject: [PATCH] Fixes to Write.TxSpec --- lib/wallet/src/Cardano/Api/Gen.hs | 1 + lib/wallet/src/Cardano/Wallet/Write/Tx.hs | 58 ++++++++++++------- lib/wallet/src/Cardano/Wallet/Write/Tx/Gen.hs | 2 +- .../test/unit/Cardano/Wallet/Write/TxSpec.hs | 24 ++++---- 4 files changed, 51 insertions(+), 34 deletions(-) diff --git a/lib/wallet/src/Cardano/Api/Gen.hs b/lib/wallet/src/Cardano/Api/Gen.hs index e95832af641..5e8f477305d 100644 --- a/lib/wallet/src/Cardano/Api/Gen.hs +++ b/lib/wallet/src/Cardano/Api/Gen.hs @@ -42,6 +42,7 @@ module Cardano.Api.Gen , genRationalInt64 , genScript , genScriptData + , genHashableScriptData , shrinkScriptData , genScriptHash , genScriptInAnyLang diff --git a/lib/wallet/src/Cardano/Wallet/Write/Tx.hs b/lib/wallet/src/Cardano/Wallet/Write/Tx.hs index 255637faa53..440aad44d46 100644 --- a/lib/wallet/src/Cardano/Wallet/Write/Tx.hs +++ b/lib/wallet/src/Cardano/Wallet/Write/Tx.hs @@ -415,14 +415,15 @@ unsafeAddressFromBytes bytes = case Ledger.deserialiseAddr bytes of Nothing -> error "unsafeAddressFromBytes: failed to deserialise" scriptFromCardanoScriptInAnyLang - :: Cardano.ScriptInAnyLang - -> Script LatestLedgerEra -scriptFromCardanoScriptInAnyLang - = Cardano.toShelleyScript + :: forall era. IsRecentEra era + => Cardano.ScriptInAnyLang + -> Script (Cardano.ShelleyLedgerEra era) +scriptFromCardanoScriptInAnyLang = withAlonzoScriptConstraint (recentEra @era) + Cardano.toShelleyScript . fromMaybe (error "all valid scripts should be valid in latest era") - . Cardano.toScriptInEra latestEra + . Cardano.toScriptInEra era where - latestEra = Cardano.ConwayEra + era = cardanoEraFromRecentEra $ recentEra @era -- | NOTE: The roundtrip -- @ @@ -432,14 +433,15 @@ scriptFromCardanoScriptInAnyLang -- is 'ShelleyEra'-specific, and 'ShelleyEra' is not a 'RecentEra', this should -- not be a problem. scriptToCardanoScriptInAnyLang - :: Script LatestLedgerEra + :: forall era. IsRecentEra era + => Script (Cardano.ShelleyLedgerEra era) -> Cardano.ScriptInAnyLang -scriptToCardanoScriptInAnyLang = - rewrap - . Cardano.fromShelleyBasedScript latestEra +scriptToCardanoScriptInAnyLang = withAlonzoScriptConstraint (recentEra @era) + $ rewrap + . Cardano.fromShelleyBasedScript shelleyEra where rewrap (Cardano.ScriptInEra _ s) = Cardano.toScriptInAnyLang s - latestEra = Cardano.ShelleyBasedEraConway + shelleyEra = shelleyBasedEraFromRecentEra $ recentEra @era -- | NOTE: The roundtrip -- @ @@ -449,7 +451,8 @@ scriptToCardanoScriptInAnyLang = -- is 'ShelleyEra'-specific, and 'ShelleyEra' is not a 'RecentEra', this should -- not be a problem. scriptToCardanoEnvelopeJSON :: AlonzoScript LatestLedgerEra -> Aeson.Value -scriptToCardanoEnvelopeJSON = scriptToJSON . scriptToCardanoScriptInAnyLang +scriptToCardanoEnvelopeJSON = + scriptToJSON . scriptToCardanoScriptInAnyLang @LatestEra where scriptToJSON :: Cardano.ScriptInAnyLang @@ -470,13 +473,14 @@ scriptToCardanoEnvelopeJSON = scriptToJSON . scriptToCardanoScriptInAnyLang scriptFromCardanoEnvelopeJSON :: Aeson.Value -> Aeson.Parser (AlonzoScript LatestLedgerEra) -scriptFromCardanoEnvelopeJSON v = fmap scriptFromCardanoScriptInAnyLang $ do - envelope <- Aeson.parseJSON v - case textEnvelopeToScript envelope of - Left textEnvErr - -> fail $ Cardano.displayError textEnvErr - Right (Cardano.ScriptInAnyLang l s) - -> pure $ Cardano.ScriptInAnyLang l s +scriptFromCardanoEnvelopeJSON v = + fmap (scriptFromCardanoScriptInAnyLang @LatestEra) $ do + envelope <- Aeson.parseJSON v + case textEnvelopeToScript envelope of + Left textEnvErr + -> fail $ Cardano.displayError textEnvErr + Right (Cardano.ScriptInAnyLang l s) + -> pure $ Cardano.ScriptInAnyLang l s where textEnvelopeToScript :: Cardano.TextEnvelope @@ -527,13 +531,13 @@ binaryDataToBytes = datumFromCardanoScriptData :: Cardano.HashableScriptData - -> BinaryData LatestLedgerEra + -> BinaryData era datumFromCardanoScriptData = Alonzo.dataToBinaryData . Cardano.toAlonzoData datumToCardanoScriptData - :: BinaryData LatestLedgerEra + :: BinaryData era -> Cardano.HashableScriptData datumToCardanoScriptData = Cardano.fromAlonzoData @@ -929,3 +933,15 @@ withCLIConstraint era a = case era of RecentEraAlonzo -> a RecentEraBabbage -> a RecentEraConway -> a + +withAlonzoScriptConstraint + :: RecentEra era + -> ( Core.Script (Cardano.ShelleyLedgerEra era) + ~ Alonzo.Script (Cardano.ShelleyLedgerEra era + ) + => a) + -> a +withAlonzoScriptConstraint era a = case era of + RecentEraAlonzo -> a + RecentEraBabbage -> a + RecentEraConway -> a diff --git a/lib/wallet/src/Cardano/Wallet/Write/Tx/Gen.hs b/lib/wallet/src/Cardano/Wallet/Write/Tx/Gen.hs index d7107872a36..6573679290f 100644 --- a/lib/wallet/src/Cardano/Wallet/Write/Tx/Gen.hs +++ b/lib/wallet/src/Cardano/Wallet/Write/Tx/Gen.hs @@ -85,7 +85,7 @@ shrinkDatum (Datum x) = NoDatum : map Datum (shrinkBinaryData x) shrinkDatum (DatumHash _) = [NoDatum] shrinkDatum NoDatum = [] -shrinkBinaryData :: BinaryData LatestLedgerEra -> [BinaryData LatestLedgerEra] +shrinkBinaryData :: BinaryData era -> [BinaryData era] shrinkBinaryData = shrinkMapBy datumFromCardanoScriptData datumToCardanoScriptData $ diff --git a/lib/wallet/test/unit/Cardano/Wallet/Write/TxSpec.hs b/lib/wallet/test/unit/Cardano/Wallet/Write/TxSpec.hs index 61698efda84..f4142ee9839 100644 --- a/lib/wallet/test/unit/Cardano/Wallet/Write/TxSpec.hs +++ b/lib/wallet/test/unit/Cardano/Wallet/Write/TxSpec.hs @@ -10,7 +10,7 @@ module Cardano.Wallet.Write.TxSpec where import Prelude import Cardano.Api.Gen - ( genScriptData, genScriptInAnyLang, genTxIn, shrinkScriptData ) + ( genScriptInAnyLang, genTxIn, genHashableScriptData ) import Cardano.Ledger.Alonzo.PParams ( _coinsPerUTxOWord ) import Cardano.Ledger.Babbage.PParams @@ -19,7 +19,6 @@ import Cardano.Wallet.Unsafe ( unsafeFromHex ) import Cardano.Wallet.Write.Tx ( BinaryData - , LatestEra , LatestLedgerEra , RecentEra (..) , Script @@ -39,7 +38,7 @@ import Cardano.Wallet.Write.Tx , scriptFromCardanoScriptInAnyLang , scriptToCardanoEnvelopeJSON , scriptToCardanoScriptInAnyLang - , toCardanoUTxO + , toCardanoUTxO, StandardBabbage ) import Cardano.Wallet.Write.Tx.Gen ( genBinaryData, genTxOut, shrinkBinaryData ) @@ -134,10 +133,10 @@ spec = do it "is isomorphic to Cardano.ScriptInAnyLang (modulo SimpleScriptV1/2)" $ testIsomorphism (NamedFun - scriptToCardanoScriptInAnyLang + (scriptToCardanoScriptInAnyLang @Cardano.BabbageEra) "scriptToCardanoScriptInAnyLang") (NamedFun - scriptFromCardanoScriptInAnyLang + (scriptFromCardanoScriptInAnyLang @Cardano.BabbageEra) "scriptFromCardanoScriptInAnyLang") id @@ -186,23 +185,24 @@ spec = do "fromCardanoUTxO") id -instance Arbitrary Cardano.ScriptData where - arbitrary = genScriptData - shrink = shrinkScriptData +instance Arbitrary Cardano.HashableScriptData where + arbitrary = genHashableScriptData + shrink = const [] -- | The OVERLAPS can be removed when we remove import of -- "Test.Cardano.Ledger.Alonzo.Serialisation.Generators" -instance {-# OVERLAPS #-} Arbitrary (BinaryData LatestLedgerEra) where +instance {-# INCOHERENT #-} Arbitrary (BinaryData StandardBabbage) where arbitrary = genBinaryData shrink = shrinkBinaryData instance Arbitrary Cardano.ScriptInAnyLang where arbitrary = genScriptInAnyLang -instance {-# OVERLAPPING #-} Arbitrary (Script LatestLedgerEra) where - arbitrary = scriptFromCardanoScriptInAnyLang <$> arbitrary +instance {-# OVERLAPPING #-} Arbitrary (Script StandardBabbage) where + arbitrary = scriptFromCardanoScriptInAnyLang @Cardano.BabbageEra + <$> arbitrary -instance Arbitrary (Cardano.UTxO LatestEra) where +instance Arbitrary (Cardano.UTxO Cardano.BabbageEra) where arbitrary = Cardano.UTxO . Map.fromList <$> liftArbitrary genTxInOutEntry where genTxInOutEntry = (,)