Skip to content

Commit 73e0705

Browse files
carbolymercarbolymer
committed
submitTx test
1 parent 724d4b4 commit 73e0705

File tree

2 files changed

+105
-31
lines changed

2 files changed

+105
-31
lines changed

‎cardano-testnet/test/cardano-testnet-test/Cardano/Testnet/Test/Rpc/Query.hs‎

Lines changed: 2 additions & 2 deletions
Original file line numberDiff line numberDiff line change
@@ -177,6 +177,6 @@ hprop_rpc_query_pparams = integrationRetryWorkspace 2 "rpc-query-pparams" $ \tem
177177
-- Test readUtxos response
178178
--------------------------
179179

180-
H.noteShowPretty $ utxos
181-
H.noteShowPretty $ utxosResponse
180+
_ <- H.noteShowPretty $ utxos
181+
_ <- H.noteShowPretty $ utxosResponse
182182
H.failure

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

Lines changed: 103 additions & 29 deletions
Original file line numberDiff line numberDiff line change
@@ -1,10 +1,11 @@
11
{-# LANGUAGE DataKinds #-}
2-
{-# LANGUAGE NamedFieldPuns #-}
2+
{-# LANGUAGE NumericUnderscores #-}
33
{-# LANGUAGE OverloadedLabels #-}
44
{-# LANGUAGE OverloadedLists #-}
55
{-# LANGUAGE OverloadedStrings #-}
66
{-# LANGUAGE ScopedTypeVariables #-}
77
{-# LANGUAGE TypeApplications #-}
8+
{-# LANGUAGE TypeOperators #-}
89

910
module Cardano.Testnet.Test.Rpc.Transaction
1011
( hprop_rpc_transaction
@@ -14,71 +15,144 @@ where
1415
import Cardano.Api
1516
import qualified Cardano.Api.Ledger as L
1617

17-
import Cardano.CLI.Type.Output (QueryTipLocalStateOutput (..))
18-
import qualified Cardano.Ledger.Api as L
19-
import qualified Cardano.Ledger.Binary.Version as L
20-
import qualified Cardano.Ledger.Conway.Core as L
21-
import qualified Cardano.Ledger.Conway.PParams as L
22-
import qualified Cardano.Ledger.Plutus as L
18+
import Cardano.Rpc.Client (Proto)
2319
import qualified Cardano.Rpc.Client as Rpc
2420
import qualified Cardano.Rpc.Proto.Api.UtxoRpc.Query as UtxoRpc
21+
import qualified Cardano.Rpc.Proto.Api.UtxoRpc.Submit as UtxoRpc
2522
import Cardano.Rpc.Server.Internal.UtxoRpc.Query ()
23+
import Cardano.Rpc.Server.Internal.UtxoRpc.Type
2624
import Cardano.Testnet
2725

2826
import Prelude
2927

30-
import qualified Data.ByteString.Short as SBS
28+
import Control.Monad
29+
import Control.Monad.Fix
3130
import Data.Default.Class
32-
import qualified Data.Map.Strict as M
31+
import qualified Data.Text.Encoding as T
32+
import GHC.Stack
3333
import Lens.Micro
3434

35-
import Testnet.Components.Query
36-
import Testnet.Process.Run
3735
import Testnet.Property.Util (integrationRetryWorkspace)
38-
import Testnet.Start.Types
36+
import Testnet.Types
3937

4038
import Hedgehog
4139
import qualified Hedgehog as H
4240
import qualified Hedgehog.Extras.Test.Base as H
4341
import qualified Hedgehog.Extras.Test.TestWatchdog as H
4442

43+
import RIO (threadDelay)
44+
4545
hprop_rpc_transaction :: Property
4646
hprop_rpc_transaction = integrationRetryWorkspace 2 "rpc-tx" $ \tempAbsBasePath' -> H.runWithDefaultWatchdog_ $ do
47-
conf@Conf{tempAbsPath} <- mkConf tempAbsBasePath'
48-
let tempAbsPath' = unTmpAbsPath tempAbsPath
49-
50-
let ceo = ConwayEraOnwardsConway
47+
conf <- mkConf tempAbsBasePath'
48+
let (ceo, eraProxy) =
49+
(conwayBasedEra, asType) :: era ~ ConwayEra => (ConwayEraOnwards era, AsType era)
5150
sbe = convert ceo
52-
eraName = eraToString sbe
5351
options = def{cardanoNodeEra = AnyShelleyBasedEra sbe, cardanoEnableRpc = True}
5452

5553
TestnetRuntime
56-
{ testnetMagic
57-
, configurationFile
58-
, testnetNodes = node0@TestnetNode{nodeSprocket} : _
54+
{ testnetNodes = node0 : _
55+
, wallets = wallet0@(PaymentKeyInfo _ addrTxt0) : (PaymentKeyInfo _ addrTxt1) : _
5956
} <-
6057
createAndRunTestnet options def conf
6158

62-
execConfig <- mkExecConfig tempAbsPath' nodeSprocket testnetMagic
63-
epochStateView <- getEpochStateView configurationFile (nodeSocketPath node0)
64-
pparams <- unLedgerProtocolParameters <$> getProtocolParams epochStateView ceo
65-
-- H.noteShowPretty_ pparams
66-
utxos <- findAllUtxos epochStateView sbe
67-
H.noteShowPretty_ utxos
6859
rpcSocket <- H.note . unFile $ nodeRpcSocketPath node0
6960

61+
-- prepare tx inputs and output address
62+
H.noteShow_ addrTxt0
63+
addr0 <- H.nothingFail $ deserialiseAddress (AsAddressInEra eraProxy) addrTxt0
64+
65+
H.noteShow_ addrTxt1
66+
addr1 <- H.nothingFail $ deserialiseAddress (AsAddressInEra eraProxy) addrTxt1
67+
68+
-- read key witnesses
69+
wit0 :: ShelleyWitnessSigningKey <-
70+
H.leftFailM . H.evalIO $
71+
readFileTextEnvelopeAnyOf
72+
[FromSomeType asType WitnessGenesisUTxOKey]
73+
(signingKey $ paymentKeyInfoPair wallet0)
74+
7075
--------------
7176
-- RPC queries
7277
--------------
7378
let rpcServer = Rpc.ServerUnix rpcSocket
7479
(pparamsResponse, utxosResponse) <- H.noteShowM . H.evalIO . Rpc.withConnection def rpcServer $ \conn -> do
7580
pparams' <- do
76-
let req = Rpc.defMessage
81+
let req = def
7782
Rpc.nonStreaming conn (Rpc.rpc @(Rpc.Protobuf UtxoRpc.QueryService "readParams")) req
7883

7984
utxos' <- do
80-
let req = Rpc.defMessage
85+
let req = def & #addresses . #items .~ [T.encodeUtf8 addrTxt0]
8186
Rpc.nonStreaming conn (Rpc.rpc @(Rpc.Protobuf UtxoRpc.QueryService "readUtxos")) req
8287
pure (pparams', utxos')
8388

84-
H.failure
89+
pparams <- H.leftFail $ utxoRpcPParamsToProtocolParams (convert ceo) $ pparamsResponse ^. #values . #cardano
90+
91+
txOut0 : _ <- H.noteShow $ utxosResponse ^. #items
92+
txIn0 <- txoRefToTxIn $ txOut0 ^. #txoRef
93+
94+
let outputCoin = txOut0 ^. #cardano . #coin . to fromIntegral
95+
amount = 200_000_000
96+
fee = 500
97+
change = outputCoin - amount - fee
98+
txOut = TxOut addr1 (lovelaceToTxOutValue sbe $ L.Coin amount) TxOutDatumNone ReferenceScriptNone
99+
changeTxOut = TxOut addr0 (lovelaceToTxOutValue sbe $ L.Coin change) TxOutDatumNone ReferenceScriptNone
100+
content =
101+
defaultTxBodyContent sbe
102+
& setTxIns [(txIn0, pure $ KeyWitness KeyWitnessForSpending)]
103+
& setTxFee (TxFeeExplicit sbe 500)
104+
& setTxOuts [txOut, changeTxOut]
105+
& setTxProtocolParams (pure . pure $ LedgerProtocolParameters pparams)
106+
107+
txBody <- H.leftFail $ createTransactionBody sbe content
108+
109+
let signedTx = signShelleyTransaction sbe txBody [wit0]
110+
txId' <- H.noteShow . getTxId $ getTxBody signedTx
111+
112+
H.noteShowPretty_ utxosResponse
113+
114+
(utxos, submitResponse) <- H.noteShowM . H.evalIO . Rpc.withConnection def rpcServer $ \conn -> do
115+
submitResponse <-
116+
Rpc.nonStreaming conn (Rpc.rpc @(Rpc.Protobuf UtxoRpc.SubmitService "submitTx")) $
117+
def & #tx .~ [def & #raw .~ serialiseToCBOR signedTx]
118+
119+
fix $ \loop -> do
120+
resp <- Rpc.nonStreaming conn (Rpc.rpc @(Rpc.Protobuf UtxoRpc.QueryService "readParams")) def
121+
122+
let previousBlockNo = pparamsResponse ^. #ledgerTip . #height
123+
currentBlockNo = resp ^. #ledgerTip . #height
124+
-- wait for 2 blocks
125+
when (previousBlockNo + 1 >= currentBlockNo) $ do
126+
threadDelay 500_000
127+
loop
128+
129+
utxos <-
130+
Rpc.nonStreaming conn (Rpc.rpc @(Rpc.Protobuf UtxoRpc.QueryService "readUtxos")) $
131+
def & #addresses . #items .~ [T.encodeUtf8 addrTxt1]
132+
pure (utxos, submitResponse)
133+
134+
submittedTxIds <- forM (submitResponse ^. #results) $ \res -> do
135+
let mErr = res ^. #maybe'errorMessage
136+
mTxId = res ^. #maybe'ref
137+
case (mErr, mTxId) of
138+
(Just err, Nothing) -> H.noteShow_ err >> H.failure
139+
(Nothing, Just txId'') ->
140+
H.leftFail $ deserialiseFromRawBytes AsTxId txId''
141+
_ -> do
142+
H.note_ $ "Protocol error: " <> show res
143+
H.failure
144+
145+
H.note_ "Ensure that submitted transaction ID is in the submitted transactions list"
146+
[txId'] === submittedTxIds
147+
148+
H.note_ $ "Enxure that there are 2 UTXOs in the address " <> show addrTxt1
149+
2 === length (utxos ^. #items)
150+
151+
let outputsAmounts = map (^. #cardano . #coin) $ utxos ^. #items
152+
H.note_ $ "Ensure that the output sent is one of the utxos for the address " <> show addrTxt1
153+
H.assertWith outputsAmounts $ elem (fromIntegral amount)
154+
155+
txoRefToTxIn :: (HasCallStack, MonadTest m) => Proto UtxoRpc.TxoRef -> m TxIn
156+
txoRefToTxIn r = withFrozenCallStack $ do
157+
txId' <- H.leftFail $ deserialiseFromRawBytes AsTxId $ r ^. #hash
158+
pure $ TxIn txId' (TxIx . fromIntegral $ r ^. #index)

0 commit comments

Comments
 (0)