Merge pull request #613 from IntersectMBO/koslambrou/fix-fromShelleyT…

…xOut Fix datum conversion in 'fromShelleyTxOut' when using 'ShelleyBasedEraAlonzo' as input
IntersectMBO · Aug 20, 2024 · fe2ae13 · fe2ae13
2 parents b20f3be + 37d66d1
commit fe2ae13
Show file tree

Hide file tree

Showing 2 changed files with 23 additions and 2 deletions.
diff --git a/cardano-api/internal/Cardano/Api/Tx/Body.hs b/cardano-api/internal/Cardano/Api/Tx/Body.hs
@@ -748,7 +748,13 @@ fromShelleyTxOut sbe ledgerTxOut = shelleyBasedEraConstraints sbe $ do
     ShelleyBasedEraMary ->
       TxOut addressInEra txOutValue TxOutDatumNone ReferenceScriptNone
     ShelleyBasedEraAlonzo ->
-      TxOut addressInEra txOutValue TxOutDatumNone ReferenceScriptNone
+      TxOut
+        addressInEra
+        txOutValue
+        (fromAlonzoTxOutDatumHash AlonzoEraOnwardsAlonzo mDatumHash)
+        ReferenceScriptNone
+     where
+      mDatumHash = ledgerTxOut ^. L.dataHashTxOutL
     ShelleyBasedEraBabbage ->
       TxOut
         addressInEra
@@ -791,6 +797,13 @@ toAlonzoTxOutDatumHash (TxOutDatumHash _ (ScriptDataHash dh)) = SJust dh
 toAlonzoTxOutDatumHash (TxOutDatumInline{}) = SNothing
 toAlonzoTxOutDatumHash (TxOutDatumInTx' _ (ScriptDataHash dh) _) = SJust dh
 
+fromAlonzoTxOutDatumHash
+  :: AlonzoEraOnwards era
+  -> StrictMaybe (Plutus.DataHash StandardCrypto)
+  -> TxOutDatum ctx era
+fromAlonzoTxOutDatumHash _ SNothing = TxOutDatumNone
+fromAlonzoTxOutDatumHash w (SJust hash) = TxOutDatumHash w $ ScriptDataHash hash
+
 toBabbageTxOutDatum
   :: (L.Era (ShelleyLedgerEra era), Ledger.EraCrypto (ShelleyLedgerEra era) ~ StandardCrypto)
   => TxOutDatum ctx era
@@ -2009,7 +2022,7 @@ fromAlonzoTxOut w txOut =
     TxOut
       (fromShelleyAddr shelleyBasedEra (txOut ^. L.addrTxOutL))
       (TxOutValueShelleyBased sbe (txOut ^. L.valueTxOutL))
-      TxOutDatumNone
+      (fromAlonzoTxOutDatumHash w (txOut ^. L.dataHashTxOutL))
       ReferenceScriptNone
  where
   sbe = alonzoEraOnwardsToShelleyBasedEra w

diff --git a/cardano-api/test/cardano-api-test/Test/Cardano/Api/Ledger.hs b/cardano-api/test/cardano-api-test/Test/Cardano/Api/Ledger.hs
@@ -14,6 +14,7 @@ import           Cardano.Ledger.Api.Tx.Address
 import           Cardano.Ledger.Crypto
 import           Cardano.Ledger.SafeHash
 
+import           Control.Monad
 import           Control.Monad.Identity
 
 import           Test.Gen.Cardano.Api.Typed
@@ -63,6 +64,12 @@ prop_roundtrip_scriptdata_plutusdata = H.property $ do
   sd <- getScriptData <$> forAll genHashableScriptData
   H.tripping sd toPlutusData (Identity . fromPlutusData)
 
+prop_roundtrip_ledger_txout :: Property
+prop_roundtrip_ledger_txout = H.property $ do
+  forM_ [minBound .. maxBound] $ \(AnyShelleyBasedEra era) -> do
+    txOut <- forAll $ genTxOutUTxOContext era
+    txOut H.=== fromShelleyTxOut era (toShelleyTxOut era txOut)
+
 -- -----------------------------------------------------------------------------
 
 tests :: TestTree
@@ -72,4 +79,5 @@ tests =
     [ testProperty "roundtrip Address CBOR" prop_roundtrip_Address_CBOR
     , testProperty "roundtrip ScriptData" prop_roundtrip_scriptdata_plutusdata
     , testProperty "script data bytes preserved" prop_original_scriptdata_bytes_preserved
+    , testProperty "roundtrip Ledger TxOut" prop_roundtrip_ledger_txout
     ]