Fixes to Write.TxSpec

cardano-foundation · Mar 16, 2023 · 3a3aeab · 3a3aeab
1 parent 376107f
commit 3a3aeab
Show file tree

Hide file tree

Showing 4 changed files with 51 additions and 34 deletions.
diff --git 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
@@ -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
@@ -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
@@ -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 = (,)