sadf

Author: carbolymer

cardano-testnet/test/cardano-testnet-test/Cardano/Testnet/Test/Api/TxSupplementalDatum.hs

@@ -21,6 +21,7 @@ import           Cardano.Testnet
 import           Prelude
 
 import           Control.Monad
+import           Data.Bifunctor (second)
 import           Data.Default.Class
 import qualified Data.Map.Strict as M
 import           Data.Proxy
@@ -84,11 +85,16 @@ hprop_tx_supp_datum = integrationRetryWorkspace 2 "api-tx-supp-dat" $ \tempAbsBa
 
   let scriptData1 = unsafeHashableScriptData $ ScriptDataBytes "CAFEBABE"
       scriptData2 = unsafeHashableScriptData $ ScriptDataBytes "DEADBEEF"
-      txDatum1 =
+      scriptData3 = unsafeHashableScriptData $ ScriptDataBytes "FEEDCOFFEE"
+  H.noteShow_ $ hashScriptDataBytes scriptData1
+  H.noteShow_ $ hashScriptDataBytes scriptData2
+  H.noteShow_ $ hashScriptDataBytes scriptData3
+  let txDatum1 =
         TxOutDatumHash
           (convert beo)
           (hashScriptDataBytes scriptData1)
-      txDatum2 = TxOutDatumInline (convert ceo) scriptData2
+      txDatum2 = TxOutDatumInline beo scriptData2
+      txDatum3 = TxOutSupplementalDatum (convert beo) scriptData2
 
   -- Build a first transaction with txout supplemental data
   tx1Utxo <- do
@@ -99,6 +105,7 @@ hprop_tx_supp_datum = integrationRetryWorkspace 2 "api-tx-supp-dat" $ \tempAbsBa
         txOuts =
           [ TxOut addr1 txOutValue txDatum1 ReferenceScriptNone
           , TxOut addr1 txOutValue txDatum2 ReferenceScriptNone
+          , TxOut addr1 txOutValue txDatum3 ReferenceScriptNone
           ]
 
         -- build a transaction
@@ -110,7 +117,7 @@ hprop_tx_supp_datum = integrationRetryWorkspace 2 "api-tx-supp-dat" $ \tempAbsBa
 
     utxo <- UTxO <$> findAllUtxos epochStateView sbe
 
-    BalancedTxBody _ txBody _ fee <-
+    BalancedTxBody _ txBody@(ShelleyTxBody _ lbody _ (TxBodyScriptData _ (L.TxDats' datums) _) _ _) _ fee <-
       H.leftFail $
         makeTransactionBodyAutoBalance
           sbe
@@ -126,9 +133,21 @@ hprop_tx_supp_datum = integrationRetryWorkspace 2 "api-tx-supp-dat" $ \tempAbsBa
           Nothing -- keys override
     H.noteShow_ fee
 
+    H.noteShowPretty_ lbody
+
+    let bodyScriptData = fromList . map fromAlonzoData $ M.elems datums :: Set HashableScriptData
+    -- TODO: only inline datum gets included here, but should be all of them
+    -- TODO what's the actual purpose of TxSupplementalDatum - can we remove it?
+    -- TODO adding all datums breaks script integrity hash, might have to manually compute it?
+    -- https://github.com/tweag/cooked-validators/blob/9cb80810d982c9eccd3f7710a996d20f944a95ec/src/Cooked/MockChain/GenerateTx/Body.hs#L127
+    [scriptData1, scriptData2, scriptData3] === bodyScriptData
+
+
     let tx = signShelleyTransaction sbe txBody [wit0]
     txId <- H.noteShow . getTxId $ getTxBody tx
 
+    H.noteShowPretty_ tx
+
     H.evalIO (submitTxToNodeLocal connectionInfo (TxInMode sbe tx)) >>= \case
       Net.Tx.SubmitFail reason -> H.noteShow_ reason >> H.failure
       Net.Tx.SubmitSuccess -> H.success
@@ -139,26 +158,27 @@ hprop_tx_supp_datum = integrationRetryWorkspace 2 "api-tx-supp-dat" $ \tempAbsBa
     -- test if it's in UTxO set
     utxo1 <- findAllUtxos epochStateView sbe
     let txUtxo = M.filterWithKey (\(TxIn txId' _) _ -> txId == txId') utxo1
-    3 === length txUtxo
+    4 === length txUtxo
 
     let chainTxOuts =
           reverse
             . drop 1
             . reverse
-            . map (fromCtxUTxOTxOut . snd)
+            . map snd
             . toList
             $ M.filterWithKey (\(TxIn txId' _) _ -> txId == txId') utxo1
 
-    txOuts === chainTxOuts
+    (toCtxUTxOTxOut <$> txOuts) === chainTxOuts
 
     pure txUtxo
 
   do
     [(txIn1, _)] <- pure $ filter (\(_, TxOut _ _ datum _) -> datum == txDatum1) $ toList tx1Utxo
+    -- H.noteShowPretty_ tx1Utxo
     [(txIn2, _)] <- pure $ filter (\(_, TxOut _ _ datum _) -> datum == txDatum2) $ toList tx1Utxo
 
-    let scriptData3 = unsafeHashableScriptData $ ScriptDataBytes "C0FFEE"
-        txDatum = TxOutDatumInline (convert ceo) scriptData3
+    let scriptData4 = unsafeHashableScriptData $ ScriptDataBytes "C0FFEE"
+        txDatum = TxOutDatumInline beo scriptData4
         txOutValue = lovelaceToTxOutValue sbe 99_999_500
         txOut = TxOut addr0 txOutValue txDatum ReferenceScriptNone
 
@@ -172,7 +192,6 @@ hprop_tx_supp_datum = integrationRetryWorkspace 2 "api-tx-supp-dat" $ \tempAbsBa
     txBody@(ShelleyTxBody _ _ _ (TxBodyScriptData _ (L.TxDats' datums) _) _ _) <-
       H.leftFail $ createTransactionBody sbe content
     let bodyScriptData = fromList . map fromAlonzoData $ M.elems datums :: Set HashableScriptData
-    -- TODO why bodyScriptData is empty here?
     [scriptData1, scriptData2, scriptData3] === bodyScriptData
 
     let tx = signShelleyTransaction sbe txBody [wit1]
@@ -189,6 +208,6 @@ hprop_tx_supp_datum = integrationRetryWorkspace 2 "api-tx-supp-dat" $ \tempAbsBa
     -- test if it's in UTxO set
     utxo1 <- findAllUtxos epochStateView sbe
     let txUtxo = M.filterWithKey (\(TxIn txId' _) _ -> txId == txId') utxo1
-    [txOut] === M.elems txUtxo
+    [toCtxUTxOTxOut txOut] === M.elems txUtxo
 
   H.failure

cardano-testnet/test/cardano-testnet-test/Cardano/Testnet/Test/SubmitApi/Transaction.hs

@@ -1,4 +1,5 @@
 {-# LANGUAGE DisambiguateRecordFields #-}
+{-# LANGUAGE GADTs #-}
 {-# LANGUAGE LambdaCase #-}
 {-# LANGUAGE NamedFieldPuns #-}
 {-# LANGUAGE NumericUnderscores #-}