Skip to content

Commit 9643429

Browse files
carbolymercarbolymer
committed
sadf
1 parent fcf481c commit 9643429

File tree

3 files changed

+76
-28
lines changed

3 files changed

+76
-28
lines changed

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

Lines changed: 67 additions & 27 deletions
Original file line numberDiff line numberDiff line change
@@ -26,13 +26,14 @@ import qualified Data.Map.Strict as M
2626
import Data.Proxy
2727
import Data.Set (Set)
2828
import GHC.Exts (IsList (..))
29+
import GHC.Stack
2930
import Lens.Micro
3031

3132
import Testnet.Components.Query
3233
import Testnet.Property.Util (integrationRetryWorkspace)
3334
import Testnet.Types
3435

35-
import Hedgehog (Property, (===))
36+
import Hedgehog
3637
import qualified Hedgehog as H
3738
import qualified Hedgehog.Extras.Test.Base as H
3839
import qualified Hedgehog.Extras.Test.TestWatchdog as H
@@ -82,15 +83,22 @@ hprop_tx_supp_datum = integrationRetryWorkspace 2 "api-tx-supp-dat" $ \tempAbsBa
8283
executeLocalStateQueryExpr connectionInfo Net.VolatileTip $
8384
fmap toLedgerEpochInfo <$> queryEraHistory
8485

85-
let scriptData1 = unsafeHashableScriptData $ ScriptDataBytes "CAFEBABE"
86-
scriptData2 = unsafeHashableScriptData $ ScriptDataBytes "DEADBEEF"
87-
txDatum1 =
86+
let scriptData1 = unsafeHashableScriptData $ ScriptDataBytes "HASH_1" -- hash
87+
scriptData2 = unsafeHashableScriptData $ ScriptDataBytes "INLINE_1" -- inline
88+
scriptData3 = unsafeHashableScriptData $ ScriptDataBytes "SUPPLEMENTAL_1" -- supplemental
89+
-- 4e62677c3b9f3b247502efe39a85aadcc2f2d3a32aec544d62175ed86c57fe9b
90+
H.noteShow_ $ hashScriptDataBytes scriptData1
91+
-- c93bae5c7cb737e16eb224d1884e7fbe14dc038caf1b511e34a43e67d3eb9f63
92+
H.noteShow_ $ hashScriptDataBytes scriptData2
93+
-- 74ea77567269646d49e072bd83e701ff7e43574522ad90833bcfa554658c65bb
94+
H.noteShow_ $ hashScriptDataBytes scriptData3
95+
let txDatum1 =
8896
TxOutDatumHash
8997
(convert beo)
9098
(hashScriptDataBytes scriptData1)
91-
txDatum2 = TxOutDatumInline (convert ceo) scriptData2
99+
txDatum2 = TxOutDatumInline beo scriptData2
100+
txDatum3 = TxOutSupplementalDatum (convert beo) scriptData3
92101

93-
-- Build a first transaction with txout supplemental data
94102
tx1Utxo <- do
95103
txIn <- findLargestUtxoForPaymentKey epochStateView sbe wallet0
96104

@@ -99,6 +107,7 @@ hprop_tx_supp_datum = integrationRetryWorkspace 2 "api-tx-supp-dat" $ \tempAbsBa
99107
txOuts =
100108
[ TxOut addr1 txOutValue txDatum1 ReferenceScriptNone
101109
, TxOut addr1 txOutValue txDatum2 ReferenceScriptNone
110+
, TxOut addr1 txOutValue txDatum3 ReferenceScriptNone
102111
]
103112

104113
-- build a transaction
@@ -110,7 +119,8 @@ hprop_tx_supp_datum = integrationRetryWorkspace 2 "api-tx-supp-dat" $ \tempAbsBa
110119

111120
utxo <- UTxO <$> findAllUtxos epochStateView sbe
112121

113-
BalancedTxBody _ txBody _ fee <-
122+
123+
BalancedTxBody _ txBody@(ShelleyTxBody _ lbody _ (TxBodyScriptData _ (L.TxDats' datums) _) _ _) _ fee <-
114124
H.leftFail $
115125
makeTransactionBodyAutoBalance
116126
sbe
@@ -126,69 +136,99 @@ hprop_tx_supp_datum = integrationRetryWorkspace 2 "api-tx-supp-dat" $ \tempAbsBa
126136
Nothing -- keys override
127137
H.noteShow_ fee
128138

139+
H.noteShowPretty_ lbody
140+
141+
lbody ^. L.scriptIntegrityHashTxBodyL /== L.SNothing
142+
143+
let bodyScriptData = fromList . map fromAlonzoData $ M.elems datums :: Set HashableScriptData
144+
145+
-- Only supplemental datum are included here
146+
[ scriptData3 ] === bodyScriptData
147+
129148
let tx = signShelleyTransaction sbe txBody [wit0]
130149
txId <- H.noteShow . getTxId $ getTxBody tx
131150

132-
H.evalIO (submitTxToNodeLocal connectionInfo (TxInMode sbe tx)) >>= \case
133-
Net.Tx.SubmitFail reason -> H.noteShow_ reason >> H.failure
134-
Net.Tx.SubmitSuccess -> H.success
151+
H.noteShowPretty_ tx
152+
153+
submitTx sbe connectionInfo tx
135154

136155
-- wait till transaction gets included in the block
137156
_ <- waitForBlocks epochStateView 1
138157

139158
-- test if it's in UTxO set
140159
utxo1 <- findAllUtxos epochStateView sbe
141160
let txUtxo = M.filterWithKey (\(TxIn txId' _) _ -> txId == txId') utxo1
142-
3 === length txUtxo
161+
-- H.noteShowPretty_ txUtxo
162+
(length txOuts + 1) === length txUtxo
143163

144164
let chainTxOuts =
145165
reverse
146166
. drop 1
147167
. reverse
148-
. map (fromCtxUTxOTxOut . snd)
168+
. map snd
149169
. toList
150170
$ M.filterWithKey (\(TxIn txId' _) _ -> txId == txId') utxo1
151171

152-
txOuts === chainTxOuts
172+
(toCtxUTxOTxOut <$> txOuts) === chainTxOuts
153173

154174
pure txUtxo
155175

156176
do
157-
[(txIn1, _)] <- pure $ filter (\(_, TxOut _ _ datum _) -> datum == txDatum1) $ toList tx1Utxo
158-
[(txIn2, _)] <- pure $ filter (\(_, TxOut _ _ datum _) -> datum == txDatum2) $ toList tx1Utxo
177+
let txDatum3' = TxOutDatumHash (convert beo) (hashScriptDataBytes scriptData3)
178+
[(txIn1, _)] <- H.noteShowPretty $ filter (\(_, TxOut _ _ datum _) -> datum == txDatum1) $ toList tx1Utxo
179+
[(txIn2, _)] <- H.noteShowPretty $ filter (\(_, TxOut _ _ datum _) -> datum == txDatum2) $ toList tx1Utxo
180+
[(txIn3, _)] <- H.noteShowPretty $ filter (\(_, TxOut _ _ datum _) -> datum == txDatum3') $ toList tx1Utxo
159181

160-
let scriptData3 = unsafeHashableScriptData $ ScriptDataBytes "C0FFEE"
161-
txDatum = TxOutDatumInline (convert ceo) scriptData3
182+
let scriptData4 = unsafeHashableScriptData $ ScriptDataBytes "SUPPLEMENTAL_2"
183+
txDatum = TxOutSupplementalDatum (convert beo) scriptData4
162184
txOutValue = lovelaceToTxOutValue sbe 99_999_500
163185
txOut = TxOut addr0 txOutValue txDatum ReferenceScriptNone
186+
txInsReference = TxInsReference beo [txIn1, txIn3] $ pure [scriptData1, scriptData3, scriptData4]
164187

165188
let content =
166189
defaultTxBodyContent sbe
167-
& setTxIns [(txIn1, pure $ KeyWitness KeyWitnessForSpending)]
168-
& setTxInsReference (TxInsReference beo [txIn2])
190+
& setTxIns [(txIn2, pure $ KeyWitness KeyWitnessForSpending)]
191+
& setTxInsReference txInsReference
169192
& setTxFee (TxFeeExplicit sbe 500)
170193
& setTxOuts [txOut]
194+
& setTxProtocolParams (pure $ pure pparams)
171195

172-
txBody@(ShelleyTxBody _ _ _ (TxBodyScriptData _ (L.TxDats' datums) _) _ _) <-
196+
txBody@(ShelleyTxBody _ lbody _ (TxBodyScriptData _ (L.TxDats' datums) _) _ _) <-
173197
H.leftFail $ createTransactionBody sbe content
198+
174199
let bodyScriptData = fromList . map fromAlonzoData $ M.elems datums :: Set HashableScriptData
175-
-- TODO why bodyScriptData is empty here?
176-
[scriptData1, scriptData2, scriptData3] === bodyScriptData
200+
[scriptData1, scriptData3, scriptData4] === bodyScriptData
201+
202+
H.noteShowPretty_ txBody
203+
204+
lbody ^. L.scriptIntegrityHashTxBodyL /== L.SNothing
177205

178206
let tx = signShelleyTransaction sbe txBody [wit1]
179-
-- H.noteShowPretty_ tx
207+
H.noteShowPretty_ tx
180208
txId <- H.noteShow . getTxId $ getTxBody tx
181209

182-
H.evalIO (submitTxToNodeLocal connectionInfo (TxInMode sbe tx)) >>= \case
183-
Net.Tx.SubmitFail reason -> H.noteShow_ reason >> H.failure
184-
Net.Tx.SubmitSuccess -> H.success
210+
submitTx sbe connectionInfo tx
185211

186212
-- wait till transaction gets included in the block
187213
_ <- waitForBlocks epochStateView 1
188214

189215
-- test if it's in UTxO set
190216
utxo1 <- findAllUtxos epochStateView sbe
191217
let txUtxo = M.filterWithKey (\(TxIn txId' _) _ -> txId == txId') utxo1
192-
[txOut] === M.elems txUtxo
218+
[toCtxUTxOTxOut txOut] === M.elems txUtxo
193219

194220
H.failure
221+
222+
submitTx
223+
:: MonadTest m
224+
=> MonadIO m
225+
=> HasCallStack
226+
=> ShelleyBasedEra era
227+
-> LocalNodeConnectInfo
228+
-> Tx era
229+
-> m ()
230+
submitTx sbe connectionInfo tx =
231+
withFrozenCallStack $
232+
H.evalIO (submitTxToNodeLocal connectionInfo (TxInMode sbe tx)) >>= \case
233+
Net.Tx.SubmitFail reason -> H.noteShowPretty_ reason >> H.failure
234+
Net.Tx.SubmitSuccess -> H.success

‎cardano-testnet/test/cardano-testnet-test/Cardano/Testnet/Test/Cli/Transaction.hs

Lines changed: 8 additions & 1 deletion
Original file line numberDiff line numberDiff line change
@@ -83,12 +83,19 @@ hprop_transaction = integrationRetryWorkspace 2 "simple transaction build" $ \te
8383
(txin1, TxOut _addr outValue _datum _refScript) <- H.nothingFailM $ findLargestUtxoWithAddress epochStateView sbe (paymentKeyInfoAddr wallet0)
8484
let (L.Coin initialAmount) = txOutValueToLovelace outValue
8585

86+
-- TODO those three datums are going into the TX - do we need three different flags?
87+
8688
let transferAmount = 5_000_001
8789
void $ execCli' execConfig
8890
[ anyEraToString cEra, "transaction", "build"
8991
, "--change-address", Text.unpack $ paymentKeyInfoAddr wallet0
9092
, "--tx-in", Text.unpack $ renderTxIn txin1
9193
, "--tx-out", Text.unpack (paymentKeyInfoAddr wallet0) <> "+" <> show transferAmount
94+
, "--tx-out-datum-hash" ,"4e548d257ab5309e4d029426a502e5609f7b0dbd1ac61f696f8373bd2b147e23"
95+
, "--tx-out", Text.unpack (paymentKeyInfoAddr wallet0) <> "+" <> show transferAmount
96+
, "--tx-out-datum-embed-value" ,"\"EMBEDVALUE\""
97+
, "--tx-out", Text.unpack (paymentKeyInfoAddr wallet0) <> "+" <> show transferAmount
98+
, "--tx-out-inline-datum-value" ,"\"INLINEVALUE\""
9299
, "--out-file", txbodyFp
93100
]
94101
cddlUnwitnessedTx <- H.readJsonFileOk txbodyFp
@@ -100,7 +107,7 @@ hprop_transaction = integrationRetryWorkspace 2 "simple transaction build" $ \te
100107
-- changed regarding fee calculation.
101108
-- 8.10 changed fee from 228 -> 330
102109
-- 9.2 changed fee from 330 -> 336
103-
336 === txFee
110+
-- 336 === txFee
104111

105112
void $ execCli' execConfig
106113
[ anyEraToString cEra, "transaction", "sign"

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

Lines changed: 1 addition & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -1,4 +1,5 @@
11
{-# LANGUAGE DisambiguateRecordFields #-}
2+
{-# LANGUAGE GADTs #-}
23
{-# LANGUAGE LambdaCase #-}
34
{-# LANGUAGE NamedFieldPuns #-}
45
{-# LANGUAGE NumericUnderscores #-}

0 commit comments

Comments
 (0)