Skip to content

Commit 13d964b

Browse files
carbolymercarbolymer
committed
Add cardano-rpc tests in cardano-testnet
1 parent 00f2452 commit 13d964b

File tree

3 files changed

+355
-0
lines changed

3 files changed

+355
-0
lines changed

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

Lines changed: 192 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -0,0 +1,192 @@
1+
{-# LANGUAGE DataKinds #-}
2+
{-# LANGUAGE NamedFieldPuns #-}
3+
{-# LANGUAGE OverloadedLists #-}
4+
{-# LANGUAGE OverloadedStrings #-}
5+
{-# LANGUAGE ScopedTypeVariables #-}
6+
{-# LANGUAGE TypeApplications #-}
7+
8+
module Cardano.Testnet.Test.Rpc.Query
9+
( hprop_rpc_query_pparams
10+
)
11+
where
12+
13+
import Cardano.Api
14+
import qualified Cardano.Api.Ledger as L
15+
16+
import Cardano.CLI.Type.Output (QueryTipLocalStateOutput (..))
17+
import qualified Cardano.Ledger.Api as L
18+
import qualified Cardano.Ledger.Binary.Version as L
19+
import qualified Cardano.Ledger.Conway.Core as L
20+
import qualified Cardano.Ledger.Conway.PParams as L
21+
import qualified Cardano.Ledger.Plutus as L
22+
import qualified Cardano.Rpc.Client as Rpc
23+
import qualified Cardano.Rpc.Proto.Api.UtxoRpc.Query as U5c
24+
import Cardano.Rpc.Server.Internal.UtxoRpc.Query ()
25+
import Cardano.Rpc.Server.Internal.UtxoRpc.Type (anyUtxoDataUtxoRpcToUtxo,
26+
utxoRpcBigIntToInteger)
27+
import Cardano.Testnet
28+
29+
import Prelude
30+
31+
import Control.Exception
32+
import qualified Data.ByteString.Short as SBS
33+
import Data.Default.Class
34+
import qualified Data.Map.Strict as M
35+
import Lens.Micro
36+
37+
import Testnet.Components.Query
38+
import Testnet.Process.Run
39+
import Testnet.Property.Util (integrationRetryWorkspace)
40+
import Testnet.Start.Types
41+
42+
import Hedgehog
43+
import qualified Hedgehog as H
44+
import qualified Hedgehog.Extras.Test.Base as H
45+
import qualified Hedgehog.Extras.Test.TestWatchdog as H
46+
47+
hprop_rpc_query_pparams :: Property
48+
hprop_rpc_query_pparams = integrationRetryWorkspace 2 "rpc-query-pparams" $ \tempAbsBasePath' -> H.runWithDefaultWatchdog_ $ do
49+
conf@Conf{tempAbsPath} <- mkConf tempAbsBasePath'
50+
let tempAbsPath' = unTmpAbsPath tempAbsPath
51+
52+
let ceo = ConwayEraOnwardsConway
53+
sbe = convert ceo
54+
eraName = eraToString sbe
55+
options = def{cardanoNodeEra = AnyShelleyBasedEra sbe, cardanoEnableRpc = True}
56+
57+
TestnetRuntime
58+
{ testnetMagic
59+
, configurationFile
60+
, testnetNodes = node0@TestnetNode{nodeSprocket} : _
61+
} <-
62+
createAndRunTestnet options def conf
63+
64+
execConfig <- mkExecConfig tempAbsPath' nodeSprocket testnetMagic
65+
epochStateView <- getEpochStateView configurationFile (nodeSocketPath node0)
66+
pparams <- unLedgerProtocolParameters <$> getProtocolParams epochStateView ceo
67+
-- H.noteShowPretty_ pparams
68+
utxos <- findAllUtxos epochStateView sbe
69+
H.noteShowPretty_ utxos
70+
rpcSocket <- H.note . unFile $ nodeRpcSocketPath node0
71+
72+
----------
73+
-- Get tip
74+
----------
75+
QueryTipLocalStateOutput{localStateChainTip} <-
76+
H.noteShowM $ execCliStdoutToJson execConfig [eraName, "query", "tip"]
77+
(slot, blockHash, blockNo) <- case localStateChainTip of
78+
ChainTipAtGenesis -> H.failure
79+
ChainTip (SlotNo slot) (HeaderHash hash) (BlockNo blockNo) -> pure (slot, SBS.fromShort hash, blockNo)
80+
81+
--------------
82+
-- RPC queries
83+
--------------
84+
let rpcServer = Rpc.ServerUnix rpcSocket
85+
(pparamsResponse, utxosResponse) <- H.noteShowM . H.evalIO . Rpc.withConnection def rpcServer $ \conn -> do
86+
pparams' <- do
87+
let req = Rpc.defMessage
88+
Rpc.nonStreaming conn (Rpc.rpc @(Rpc.Protobuf U5c.QueryService "readParams")) req
89+
90+
utxos' <- do
91+
let req = Rpc.defMessage
92+
Rpc.nonStreaming conn (Rpc.rpc @(Rpc.Protobuf U5c.QueryService "readUtxos")) req
93+
pure (pparams', utxos')
94+
95+
---------------------------
96+
-- Test readParams response
97+
---------------------------
98+
pparamsResponse ^. U5c.ledgerTip . U5c.slot === slot
99+
pparamsResponse ^. U5c.ledgerTip . U5c.hash === blockHash
100+
pparamsResponse ^. U5c.ledgerTip . U5c.height === blockNo
101+
pparamsResponse ^. U5c.ledgerTip . U5c.timestamp === 0 -- not possible to implement at this moment
102+
103+
-- https://docs.cardano.org/about-cardano/explore-more/parameter-guide
104+
let chainParams = pparamsResponse ^. U5c.values . U5c.cardano
105+
babbageEraOnwardsConstraints (convert ceo) $ do
106+
pparams ^. L.ppCoinsPerUTxOByteL . to L.unCoinPerByte . to L.unCoin
107+
===^ chainParams ^. U5c.coinsPerUtxoByte . to utxoRpcBigIntToInteger
108+
pparams ^. L.ppMaxTxSizeL === chainParams ^. U5c.maxTxSize . to fromIntegral
109+
pparams ^. L.ppMinFeeBL ===^ chainParams ^. U5c.minFeeCoefficient . to (fmap L.Coin . utxoRpcBigIntToInteger)
110+
pparams ^. L.ppMinFeeAL ===^ chainParams ^. U5c.minFeeConstant . to (fmap L.Coin . utxoRpcBigIntToInteger)
111+
pparams ^. L.ppMaxBBSizeL === chainParams ^. U5c.maxBlockBodySize . to fromIntegral
112+
pparams ^. L.ppMaxBHSizeL === chainParams ^. U5c.maxBlockHeaderSize . to fromIntegral
113+
pparams ^. L.ppKeyDepositL ===^ chainParams ^. U5c.stakeKeyDeposit . to (fmap L.Coin . utxoRpcBigIntToInteger)
114+
pparams ^. L.ppPoolDepositL ===^ chainParams ^. U5c.poolDeposit . to (fmap L.Coin . utxoRpcBigIntToInteger)
115+
pparams ^. L.ppEMaxL . to L.unEpochInterval === chainParams ^. U5c.poolRetirementEpochBound . to fromIntegral
116+
pparams ^. L.ppNOptL === chainParams ^. U5c.desiredNumberOfPools . to fromIntegral
117+
pparams ^. L.ppA0L . to L.unboundRational === chainParams ^. U5c.poolInfluence . to inject
118+
pparams ^. L.ppNOptL === chainParams ^. U5c.desiredNumberOfPools . to fromIntegral
119+
pparams ^. L.ppRhoL . to L.unboundRational === chainParams ^. U5c.monetaryExpansion . to inject
120+
pparams ^. L.ppMinPoolCostL ===^ chainParams ^. U5c.minPoolCost . to (fmap L.Coin . utxoRpcBigIntToInteger)
121+
( pparams ^. L.ppProtocolVersionL . to L.pvMajor . to L.getVersion
122+
, pparams ^. L.ppProtocolVersionL . to L.pvMinor
123+
)
124+
=== ( chainParams ^. U5c.protocolVersion . U5c.major
125+
, chainParams ^. U5c.protocolVersion . U5c.minor . to fromIntegral
126+
)
127+
pparams ^. L.ppMaxValSizeL === chainParams ^. U5c.maxValueSize . to fromIntegral
128+
pparams ^. L.ppCollateralPercentageL === chainParams ^. U5c.collateralPercentage . to fromIntegral
129+
pparams ^. L.ppMaxCollateralInputsL === chainParams ^. U5c.maxCollateralInputs . to fromIntegral
130+
let pparamsCostModels = L.getCostModelParams <$> pparams ^. L.ppCostModelsL . to L.costModelsValid
131+
wrapInMaybe v = if v == mempty then Nothing else Just v
132+
M.lookup L.PlutusV1 pparamsCostModels === chainParams ^. U5c.costModels . U5c.plutusV1 . U5c.values . to wrapInMaybe
133+
M.lookup L.PlutusV2 pparamsCostModels === chainParams ^. U5c.costModels . U5c.plutusV2 . U5c.values . to wrapInMaybe
134+
M.lookup L.PlutusV3 pparamsCostModels === chainParams ^. U5c.costModels . U5c.plutusV3 . U5c.values . to wrapInMaybe
135+
M.lookup L.PlutusV4 pparamsCostModels === chainParams ^. U5c.costModels . U5c.plutusV4 . U5c.values . to wrapInMaybe
136+
pparams ^. L.ppPricesL . to L.prSteps . to L.unboundRational === chainParams ^. U5c.prices . U5c.steps . to inject
137+
pparams ^. L.ppPricesL . to L.prMem . to L.unboundRational === chainParams ^. U5c.prices . U5c.memory . to inject
138+
pparams ^. L.ppMaxTxExUnitsL === chainParams ^. U5c.maxExecutionUnitsPerTransaction . to inject
139+
pparams ^. L.ppMaxBlockExUnitsL === chainParams ^. U5c.maxExecutionUnitsPerBlock . to inject
140+
pparams ^. L.ppMinFeeRefScriptCostPerByteL . to L.unboundRational
141+
=== chainParams ^. U5c.minFeeScriptRefCostPerByte . to inject
142+
let poolVotingThresholds :: L.PoolVotingThresholds =
143+
conwayEraOnwardsConstraints ceo $
144+
pparams ^. L.ppPoolVotingThresholdsL
145+
( L.unboundRational
146+
<$> [ poolVotingThresholds ^. L.pvtMotionNoConfidenceL
147+
, poolVotingThresholds ^. L.pvtCommitteeNormalL
148+
, poolVotingThresholds ^. L.pvtCommitteeNoConfidenceL
149+
, poolVotingThresholds ^. L.pvtHardForkInitiationL
150+
, poolVotingThresholds ^. L.pvtPPSecurityGroupL
151+
]
152+
)
153+
=== chainParams ^. U5c.poolVotingThresholds . U5c.thresholds . to (map inject)
154+
let drepVotingThresholds :: L.DRepVotingThresholds =
155+
conwayEraOnwardsConstraints ceo $
156+
pparams ^. L.ppDRepVotingThresholdsL
157+
( L.unboundRational
158+
<$> [ drepVotingThresholds ^. L.dvtMotionNoConfidenceL
159+
, drepVotingThresholds ^. L.dvtCommitteeNormalL
160+
, drepVotingThresholds ^. L.dvtCommitteeNoConfidenceL
161+
, drepVotingThresholds ^. L.dvtUpdateToConstitutionL
162+
, drepVotingThresholds ^. L.dvtHardForkInitiationL
163+
, drepVotingThresholds ^. L.dvtPPNetworkGroupL
164+
, drepVotingThresholds ^. L.dvtPPEconomicGroupL
165+
, drepVotingThresholds ^. L.dvtPPTechnicalGroupL
166+
, drepVotingThresholds ^. L.dvtPPGovGroupL
167+
, drepVotingThresholds ^. L.dvtTreasuryWithdrawalL
168+
]
169+
)
170+
=== chainParams ^. U5c.drepVotingThresholds . U5c.thresholds . to (map inject)
171+
pparams ^. L.ppCommitteeMinSizeL === chainParams ^. U5c.minCommitteeSize . to fromIntegral
172+
pparams ^. L.ppCommitteeMaxTermLengthL . to L.unEpochInterval
173+
=== chainParams ^. U5c.committeeTermLimit . to fromIntegral
174+
pparams ^. L.ppGovActionLifetimeL . to L.unEpochInterval
175+
=== chainParams ^. U5c.governanceActionValidityPeriod . to fromIntegral
176+
pparams ^. L.ppGovActionDepositL ===^ chainParams ^. U5c.governanceActionDeposit . to (fmap L.Coin . utxoRpcBigIntToInteger)
177+
pparams ^. L.ppDRepDepositL ===^ chainParams ^. U5c.drepDeposit . to (fmap L.Coin . utxoRpcBigIntToInteger)
178+
pparams ^. L.ppDRepActivityL . to L.unEpochInterval === chainParams ^. U5c.drepInactivityPeriod . to fromIntegral
179+
180+
--------------------------
181+
-- Test readUtxos response
182+
--------------------------
183+
184+
utxoFromUtxoRpc <- H.leftFail $ utxosResponse ^. U5c.items . to (anyUtxoDataUtxoRpcToUtxo $ convert ceo)
185+
utxos === utxoFromUtxoRpc
186+
187+
(===^) :: (Eq a, Show a, H.MonadTest m) => a -> Either SomeException a -> m ()
188+
expected ===^ actual = do
189+
v <- H.leftFail actual
190+
expected === v
191+
192+
infix 4 ===^

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

Lines changed: 157 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -0,0 +1,157 @@
1+
{-# LANGUAGE DataKinds #-}
2+
{-# LANGUAGE NumericUnderscores #-}
3+
{-# LANGUAGE OverloadedLists #-}
4+
{-# LANGUAGE OverloadedStrings #-}
5+
{-# LANGUAGE ScopedTypeVariables #-}
6+
{-# LANGUAGE TypeApplications #-}
7+
{-# LANGUAGE TypeOperators #-}
8+
9+
module Cardano.Testnet.Test.Rpc.Transaction
10+
( hprop_rpc_transaction
11+
)
12+
where
13+
14+
import Cardano.Api
15+
import qualified Cardano.Api.Ledger as L
16+
17+
import Cardano.Rpc.Client (Proto)
18+
import qualified Cardano.Rpc.Client as Rpc
19+
import qualified Cardano.Rpc.Proto.Api.UtxoRpc.Query as U5c hiding (cardano, items, tx)
20+
import qualified Cardano.Rpc.Proto.Api.UtxoRpc.Query as UtxoRpc
21+
import qualified Cardano.Rpc.Proto.Api.UtxoRpc.Submit as U5c
22+
import qualified Cardano.Rpc.Proto.Api.UtxoRpc.Submit as UtxoRpc
23+
import Cardano.Rpc.Server.Internal.UtxoRpc.Type
24+
import Cardano.Testnet
25+
26+
import Prelude
27+
28+
import Control.Monad
29+
import Control.Monad.Fix
30+
import Data.Default.Class
31+
import qualified Data.Text.Encoding as T
32+
import GHC.Stack
33+
import Lens.Micro
34+
35+
import Testnet.Property.Util (integrationRetryWorkspace)
36+
import Testnet.Types
37+
38+
import Hedgehog
39+
import qualified Hedgehog as H
40+
import qualified Hedgehog.Extras.Test.Base as H
41+
import qualified Hedgehog.Extras.Test.TestWatchdog as H
42+
43+
import RIO (ByteString, threadDelay)
44+
45+
hprop_rpc_transaction :: Property
46+
hprop_rpc_transaction = integrationRetryWorkspace 2 "rpc-tx" $ \tempAbsBasePath' -> H.runWithDefaultWatchdog_ $ do
47+
conf <- mkConf tempAbsBasePath'
48+
let (ceo, eraProxy) =
49+
(conwayBasedEra, asType) :: era ~ ConwayEra => (ConwayEraOnwards era, AsType era)
50+
sbe = convert ceo
51+
options = def{cardanoNodeEra = AnyShelleyBasedEra sbe, cardanoEnableRpc = True}
52+
addrInEra = AsAddressInEra eraProxy
53+
54+
TestnetRuntime
55+
{ testnetNodes = node0 : _
56+
, wallets = wallet0@(PaymentKeyInfo _ addrTxt0) : (PaymentKeyInfo _ addrTxt1) : _
57+
} <-
58+
createAndRunTestnet options def conf
59+
60+
rpcSocket <- H.note . unFile $ nodeRpcSocketPath node0
61+
62+
-- prepare tx inputs and output address
63+
H.noteShow_ addrTxt0
64+
addr0 <- H.nothingFail $ deserialiseAddress addrInEra addrTxt0
65+
66+
H.noteShow_ addrTxt1
67+
addr1 <- H.nothingFail $ deserialiseAddress addrInEra addrTxt1
68+
69+
-- read key witnesses
70+
wit0 :: ShelleyWitnessSigningKey <-
71+
H.leftFailM . H.evalIO $
72+
readFileTextEnvelopeAnyOf
73+
[FromSomeType asType WitnessGenesisUTxOKey]
74+
(signingKey $ paymentKeyInfoPair wallet0)
75+
76+
--------------
77+
-- RPC queries
78+
--------------
79+
let rpcServer = Rpc.ServerUnix rpcSocket
80+
(pparamsResponse, utxosResponse) <- H.noteShowM . H.evalIO . Rpc.withConnection def rpcServer $ \conn -> do
81+
pparams' <- do
82+
let req = def
83+
Rpc.nonStreaming conn (Rpc.rpc @(Rpc.Protobuf UtxoRpc.QueryService "readParams")) req
84+
85+
utxos' <- do
86+
let req = def -- & # U5c.keys .~ [T.encodeUtf8 addrTxt0]
87+
Rpc.nonStreaming conn (Rpc.rpc @(Rpc.Protobuf UtxoRpc.QueryService "readUtxos")) req
88+
pure (pparams', utxos')
89+
90+
pparams <- H.leftFail $ utxoRpcPParamsToProtocolParams (convert ceo) $ pparamsResponse ^. U5c.values . U5c.cardano
91+
92+
txOut0 : _ <- H.noteShowM . flip filterM (utxosResponse ^. U5c.items) $ \utxo -> do
93+
utxoAddress <- deserialiseAddressBs addrInEra $ utxo ^. U5c.cardano . U5c.address
94+
pure $ addr0 == utxoAddress
95+
txIn0 <- txoRefToTxIn $ txOut0 ^. U5c.txoRef
96+
97+
outputCoin <- H.leftFail $ txOut0 ^. U5c.cardano . U5c.coin . to utxoRpcBigIntToInteger
98+
let amount = 200_000_000
99+
fee = 500
100+
change = outputCoin - amount - fee
101+
txOut = TxOut addr1 (lovelaceToTxOutValue sbe $ L.Coin amount) TxOutDatumNone ReferenceScriptNone
102+
changeTxOut = TxOut addr0 (lovelaceToTxOutValue sbe $ L.Coin change) TxOutDatumNone ReferenceScriptNone
103+
content =
104+
defaultTxBodyContent sbe
105+
& setTxIns [(txIn0, pure $ KeyWitness KeyWitnessForSpending)]
106+
& setTxFee (TxFeeExplicit sbe 500)
107+
& setTxOuts [txOut, changeTxOut]
108+
& setTxProtocolParams (pure . pure $ LedgerProtocolParameters pparams)
109+
110+
txBody <- H.leftFail $ createTransactionBody sbe content
111+
112+
let signedTx = signShelleyTransaction sbe txBody [wit0]
113+
txId' <- H.noteShow . getTxId $ getTxBody signedTx
114+
115+
H.noteShowPretty_ utxosResponse
116+
117+
(utxos, submitResponse) <- H.noteShowM . H.evalIO . Rpc.withConnection def rpcServer $ \conn -> do
118+
submitResponse <-
119+
Rpc.nonStreaming conn (Rpc.rpc @(Rpc.Protobuf UtxoRpc.SubmitService "submitTx")) $
120+
def & U5c.tx .~ (def & U5c.raw .~ serialiseToCBOR signedTx)
121+
122+
fix $ \loop -> do
123+
resp <- Rpc.nonStreaming conn (Rpc.rpc @(Rpc.Protobuf UtxoRpc.QueryService "readParams")) def
124+
125+
let previousBlockNo = pparamsResponse ^. U5c.ledgerTip . U5c.height
126+
currentBlockNo = resp ^. U5c.ledgerTip . U5c.height
127+
-- wait for 2 blocks
128+
when (previousBlockNo + 1 >= currentBlockNo) $ do
129+
threadDelay 500_000
130+
loop
131+
132+
utxos <-
133+
Rpc.nonStreaming conn (Rpc.rpc @(Rpc.Protobuf UtxoRpc.QueryService "readUtxos")) def -- & # U5c.keys .~ [T.encodeUtf8 addrTxt1]
134+
pure (utxos, submitResponse)
135+
136+
submittedTxId <- H.leftFail . deserialiseFromRawBytes AsTxId $ submitResponse ^. U5c.ref
137+
138+
H.note_ "Ensure that submitted transaction ID is in the submitted transactions list"
139+
txId' === submittedTxId
140+
141+
H.note_ $ "Enxure that there are 2 UTXOs in the address " <> show addrTxt1
142+
utxosForAddress <- H.noteShowM . flip filterM (utxos ^. U5c.items) $ \utxo -> do
143+
utxoAddress <- deserialiseAddressBs addrInEra $ utxo ^. U5c.cardano . U5c.address
144+
pure $ addr1 == utxoAddress
145+
2 === length utxosForAddress
146+
147+
let outputsAmounts = map (^. U5c.cardano . U5c.coin) $ utxos ^. U5c.items
148+
H.note_ $ "Ensure that the output sent is one of the utxos for the address " <> show addrTxt1
149+
H.assertWith outputsAmounts $ elem (inject amount)
150+
151+
txoRefToTxIn :: (HasCallStack, MonadTest m) => Proto UtxoRpc.TxoRef -> m TxIn
152+
txoRefToTxIn r = withFrozenCallStack $ do
153+
txId' <- H.leftFail $ deserialiseFromRawBytes AsTxId $ r ^. U5c.hash
154+
pure $ TxIn txId' (TxIx . fromIntegral $ r ^. U5c.index)
155+
156+
deserialiseAddressBs :: (MonadTest m, SerialiseAddress c) => AsType c -> ByteString -> m c
157+
deserialiseAddressBs addrInEra = H.nothingFail . deserialiseAddress addrInEra <=< H.leftFail . T.decodeUtf8'

‎cardano-testnet/test/cardano-testnet-test/cardano-testnet-test.hs‎

Lines changed: 6 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -29,6 +29,8 @@ import qualified Cardano.Testnet.Test.Gov.TreasuryDonation as Gov
2929
import qualified Cardano.Testnet.Test.Gov.TreasuryWithdrawal as Gov
3030
import qualified Cardano.Testnet.Test.MainnetParams
3131
import qualified Cardano.Testnet.Test.Node.Shutdown
32+
import qualified Cardano.Testnet.Test.Rpc.Query
33+
import qualified Cardano.Testnet.Test.Rpc.Transaction
3234
import qualified Cardano.Testnet.Test.RunTestnet
3335
import qualified Cardano.Testnet.Test.SanityCheck
3436
import qualified Cardano.Testnet.Test.SanityCheck as LedgerEvents
@@ -135,6 +137,10 @@ tests = do
135137
, T.testGroup "SubmitApi"
136138
[ ignoreOnMacAndWindows "transaction" Cardano.Testnet.Test.SubmitApi.Transaction.hprop_transaction
137139
]
140+
, T.testGroup "RPC"
141+
[ ignoreOnWindows "RPC Query Protocol Params" Cardano.Testnet.Test.Rpc.Query.hprop_rpc_query_pparams
142+
, ignoreOnWindows "RPC Transaction Submit" Cardano.Testnet.Test.Rpc.Transaction.hprop_rpc_transaction
143+
]
138144
]
139145

140146
main :: IO ()

0 commit comments

Comments
 (0)