diff --git a/cardano-testnet/.changes/20260819_155310_mgalazyn_add_rpc_fetchblock_followtip_genesis_tests.yml b/cardano-testnet/.changes/20260819_155310_mgalazyn_add_rpc_fetchblock_followtip_genesis_tests.yml new file mode 100644 index 00000000000..7b7404b73fb --- /dev/null +++ b/cardano-testnet/.changes/20260819_155310_mgalazyn_add_rpc_fetchblock_followtip_genesis_tests.yml @@ -0,0 +1,9 @@ +pr: 6655 +kind: + - test +description: | + - Added `hprop_rpc_fetch_block` integration test for the UTxO RPC `SyncService.FetchBlock` method, comparing blocks fetched by slot and hash against blocks observed independently via `foldBlocks`, including transactions with minted assets and Plutus scripts. + - Added `hprop_rpc_follow_tip` integration test for the UTxO RPC `SyncService.FollowTip` streaming method, verifying tip updates are streamed as new blocks are produced. + - Added `hprop_rpc_read_genesis` integration test for the UTxO RPC `QueryService.ReadGenesis` method, verifying the returned genesis parameters match the testnet's configuration. + - Updated the `SearchUtxos` and `Transaction` RPC tests to use the shared `exactAddressPredicate` and `txoRefUtxoRpcToTxIn` helpers instead of local copies of the equivalent code. + - Adapted `foldBlocks` call sites to `cardano-api` 11.5, which now requires an explicit `SomeHasFS IO` argument (built via `mkNodeConfigFs`). diff --git a/cardano-testnet/cardano-testnet.cabal b/cardano-testnet/cardano-testnet.cabal index 38c84fa1fb1..4d38435b11b 100644 --- a/cardano-testnet/cardano-testnet.cabal +++ b/cardano-testnet/cardano-testnet.cabal @@ -239,6 +239,9 @@ test-suite cardano-testnet-test Cardano.Testnet.Test.Gov.TreasuryGrowth Cardano.Testnet.Test.Gov.TreasuryWithdrawal Cardano.Testnet.Test.Rpc.Eval + Cardano.Testnet.Test.Rpc.FetchBlock + Cardano.Testnet.Test.Rpc.FollowTip + Cardano.Testnet.Test.Rpc.Genesis Cardano.Testnet.Test.Rpc.Query Cardano.Testnet.Test.Rpc.SearchUtxos Cardano.Testnet.Test.Rpc.Transaction diff --git a/cardano-testnet/test/cardano-testnet-test/Cardano/Testnet/Test/Rpc/FetchBlock.hs b/cardano-testnet/test/cardano-testnet-test/Cardano/Testnet/Test/Rpc/FetchBlock.hs new file mode 100644 index 00000000000..ca8d385c8ba --- /dev/null +++ b/cardano-testnet/test/cardano-testnet-test/Cardano/Testnet/Test/Rpc/FetchBlock.hs @@ -0,0 +1,437 @@ +{-# LANGUAGE DataKinds #-} +{-# LANGUAGE GADTs #-} +{-# LANGUAGE LambdaCase #-} +{-# LANGUAGE NamedFieldPuns #-} +{-# LANGUAGE NumericUnderscores #-} +{-# LANGUAGE OverloadedStrings #-} +{-# LANGUAGE ScopedTypeVariables #-} +{-# LANGUAGE TypeApplications #-} + +module Cardano.Testnet.Test.Rpc.FetchBlock + ( hprop_rpc_fetch_block + ) +where + +import Cardano.Api +import qualified Cardano.Api.Experimental as Exp +import qualified Cardano.Api.Experimental.AnyScriptWitness as Exp +import qualified Cardano.Api.Experimental.Tx as Exp +import qualified Cardano.Api.Ledger as L + +import Cardano.CLI.Type.Output (QueryTipLocalStateOutput (..)) +import qualified Cardano.Ledger.Shelley.Scripts as Shelley +import qualified Cardano.Rpc.Client as Rpc +import qualified Cardano.Rpc.Proto.Api.UtxoRpc.Query as Query +import qualified Cardano.Rpc.Proto.Api.UtxoRpc.Submit as Submit +import qualified Cardano.Rpc.Proto.Api.UtxoRpc.Sync as U5c +import Cardano.Rpc.Server.Internal.UtxoRpc.Predicate (exactAddressPredicate) +import Cardano.Rpc.Server.Internal.UtxoRpc.Type (txoRefUtxoRpcToTxIn, + utxoRpcBigIntToInteger, utxoRpcPParamsToProtocolParams) +import Cardano.Testnet + +import Prelude + +import Control.Exception (try) +import Control.Monad ((<=<)) +import qualified Data.ByteString as BS +import qualified Data.ByteString.Short as SBS +import Data.Default.Class +import Data.List.NonEmpty (NonEmpty ((:|))) +import Data.Maybe (isJust) +import Data.Time.Clock.POSIX (utcTimeToPOSIXSeconds) +import Data.Word (Word64) +import GHC.Exts (fromList) +import GHC.Stack (callStack) +import Lens.Micro +import Network.GRPC.Spec (GrpcError (..), GrpcException (..)) + +import Testnet.Filepath (mkNodeConfigFs) +import Testnet.Process.Run +import Testnet.Property.Util (integrationRetryWorkspace) +import Testnet.Start.Types +import Testnet.Types + +import qualified Hedgehog as H +import qualified Hedgehog.Extras as H + +-- | Run with: +-- @TASTY_PATTERN='/RPC FetchBlock/' cabal test cardano-testnet-test@ +hprop_rpc_fetch_block :: H.Property +hprop_rpc_fetch_block = integrationRetryWorkspace 2 "rpc-fetch-block" $ \tempAbsBasePath' -> H.runWithDefaultWatchdog_ $ do + conf@Conf{tempAbsPath} <- mkConf tempAbsBasePath' + let tempAbsPath' = unTmpAbsPath tempAbsPath + + let era = Exp.ConwayEra + sbe = convert era + eraName = eraToString sbe + creationOptions = def{creationEra = AnyShelleyBasedEra sbe} + runtimeOptions = def{runtimeEnableRpc = RpcEnabled} + + tr@TestnetRuntime + { configurationFile + , testnetMagic + , testnetNodes = node0@TestnetNode{nodeSprocket} :| _ + , wallets = wallet0@(PaymentKeyInfo _ addressText0) : PaymentKeyInfo _ addressText1 : _ + } <- + createAndRunTestnet creationOptions runtimeOptions conf + + execConfig <- mkExecConfig tempAbsPath' nodeSprocket testnetMagic + rpcSocket <- H.note . unFile $ nodeRpcSocketPath node0 + let rpcServer = Rpc.ServerUnix rpcSocket + fee = 500 + amount = 200_000_000 + validityUpperBound = 100_000_000 + + do + H.note_ "Fetch the tip block and verify its header and timestamp" + + -- Get chain tip via CLI + QueryTipLocalStateOutput{localStateChainTip} <- + H.noteShowM $ execCliStdoutToJson execConfig [eraName, "query", "tip"] + (slot, tipHash, tipBlockNumber) <- case localStateChainTip of + ChainTipAtGenesis -> H.failure + ChainTip (SlotNo tipSlot) (HeaderHash hash) (BlockNo bn) -> pure (tipSlot, SBS.fromShort hash, bn) + + H.note_ $ "Tip slot: " <> show slot + H.note_ $ "Tip block number: " <> show tipBlockNumber + H.note_ $ "Tip hash: " <> show (BS.length tipHash) <> " bytes" + + -- Call FetchBlock via gRPC + let blockRef = def & U5c.slot .~ slot & U5c.hash .~ tipHash + request = def & U5c.ref .~ blockRef + + response <- H.evalIO . Rpc.withConnection def rpcServer $ \conn -> + Rpc.nonStreaming conn (Rpc.rpc @(Rpc.Protobuf U5c.SyncService "fetchBlock")) request + + let block = response ^. U5c.block + + -- Verify nativeBytes is non-empty + let rawBytes = block ^. U5c.nativeBytes + H.note_ $ "Block CBOR: " <> show (BS.length rawBytes) <> " bytes" + H.assertWith rawBytes $ not . BS.null + + -- Verify cardano block header matches the requested tip + block ^. U5c.cardano . U5c.header . U5c.slot H.=== slot + block ^. U5c.cardano . U5c.header . U5c.hash H.=== tipHash + + -- height is the block number from ChainDB + block ^. U5c.cardano . U5c.header . U5c.height H.=== tipBlockNumber + + -- Verify timestamp matches the slot time derived from EraHistory + connectionInfo <- nodeConnectionInfo tr 0 + (systemStart, eraHistory) <- + (H.leftFail <=< H.leftFailM) . H.evalIO $ + executeLocalStateQueryExpr connectionInfo VolatileTip $ do + ss <- querySystemStart + eh <- queryEraHistory + pure $ (,) <$> ss <*> eh + expectedTimestampMs :: Word64 <- H.leftFail $ do + utcTime <- slotToUTCTime systemStart eraHistory (SlotNo slot) + pure . round $ utcTimeToPOSIXSeconds utcTime * 1000 + H.assertWithinTolerance (block ^. U5c.cardano . U5c.timestamp) expectedTimestampMs 1000 + + let fetchBlockExpectingError expectedError ref = do + result <- + H.evalIO . try . Rpc.withConnection def rpcServer $ \conn -> + Rpc.nonStreaming conn (Rpc.rpc @(Rpc.Protobuf U5c.SyncService "fetchBlock")) $ + def & U5c.ref .~ ref + case result of + Left GrpcException{grpcError} + | grpcError == expectedError -> pure () + | otherwise -> do + H.note_ $ "expected " <> show expectedError <> ", got: " <> show grpcError + H.failure + Right (_ :: Rpc.Proto U5c.FetchBlockResponse) -> do + H.note_ $ "expected " <> show expectedError <> ", but the call succeeded" + H.failure + + H.note_ "FetchBlock with an unknown block hash fails with NOT_FOUND" + fetchBlockExpectingError GrpcNotFound $ + def & U5c.slot .~ slot & U5c.hash .~ BS.replicate 32 0xab + + H.note_ "FetchBlock with an invalid hash length fails with INVALID_ARGUMENT" + fetchBlockExpectingError GrpcInvalidArgument $ + def & U5c.slot .~ slot & U5c.hash .~ "abc" + + H.note_ "ReadTip returns the current tip" + readTipResponse <- H.evalIO . Rpc.withConnection def rpcServer $ \conn -> + Rpc.nonStreaming conn (Rpc.rpc @(Rpc.Protobuf U5c.SyncService "readTip")) def + -- the chain may have advanced since the CLI tip query above, so slot and + -- height are only bounded from below + let tipRef = readTipResponse ^. U5c.tip + H.assertWith (tipRef ^. U5c.slot) (>= slot) + H.assertWith (tipRef ^. U5c.height) (>= tipBlockNumber) + H.assertWith (tipRef ^. U5c.hash) ((== 32) . BS.length) + + -- the timestamp must agree with the slot time of the returned tip slot + expectedTipTimestampMs :: Word64 <- H.leftFail $ do + utcTime <- slotToUTCTime systemStart eraHistory (SlotNo (tipRef ^. U5c.slot)) + pure . round $ utcTimeToPOSIXSeconds utcTime * 1000 + H.assertWithinTolerance (tipRef ^. U5c.timestamp) expectedTipTimestampMs 1000 + + (txId', txIn0, change, address0, address1, vkeyBytes0) <- do + H.note_ "Build and submit a payment transaction via RPC" + + address0 <- H.nothingFail $ deserialiseAddress (asAddressInEra sbe) addressText0 + address1 <- H.nothingFail $ deserialiseAddress (asAddressInEra sbe) addressText1 + + wit0 :: ShelleyWitnessSigningKey <- + H.leftFailM . H.evalIO $ + readFileTextEnvelopeAnyOf + [FromSomeType asType WitnessGenesisUTxOKey] + (signingKey $ paymentKeyInfoPair wallet0) + + -- raw Ed25519 bytes of wallet0's verification key, as reported by the + -- server in the witness set + vkeyBytes0 <- case wit0 of + WitnessGenesisUTxOKey signingKey0 -> + pure . serialiseToRawBytes $ getVerificationKey signingKey0 + _ -> H.failure + + (pparamsResponse, searchResponse) <- H.evalIO . Rpc.withConnection def rpcServer $ \conn -> do + pparams' <- + Rpc.nonStreaming conn (Rpc.rpc @(Rpc.Protobuf Query.QueryService "readParams")) def + search' <- + Rpc.nonStreaming conn (Rpc.rpc @(Rpc.Protobuf Query.QueryService "searchUtxos")) $ + def & Query.predicate .~ exactAddressPredicate address0 + pure (pparams', search') + + pparams <- H.leftFail $ utxoRpcPParamsToProtocolParams era $ pparamsResponse ^. Query.values . Query.cardano + txOut0 : _ <- H.noteShow $ searchResponse ^. Query.items + txIn0 <- H.leftFail . txoRefUtxoRpcToTxIn $ txOut0 ^. Query.txoRef + outputCoin <- H.leftFail $ txOut0 ^. Query.cardano . Query.coin . to utxoRpcBigIntToInteger + + let change = outputCoin - amount - fee + mkOut ledgerAddress coin = + Exp.obtainCommonConstraints era $ + Exp.TxOut $ + L.mkBasicTxOut ledgerAddress $ + L.inject $ + L.Coin coin + content = + Exp.defaultTxBodyContent + & Exp.setTxIns [(txIn0, Exp.AnyKeyWitnessPlaceholder)] + & Exp.setTxFee (L.Coin fee) + & Exp.setTxOuts [mkOut (toShelleyAddr address1) amount, mkOut (toShelleyAddr address0) change] + & Exp.setTxValidityUpperBound (SlotNo validityUpperBound) + & Exp.setTxProtocolParams pparams + + unsignedTx <- H.leftFail $ Exp.makeUnsignedTx era content + let keyWit = Exp.makeKeyWitness era unsignedTx wit0 + Exp.SignedTx signedLedgerTx = Exp.signTx era [] [keyWit] unsignedTx + txId' <- H.noteShow . Exp.obtainCommonConstraints era . TxId $ Exp.hashTxBody (signedLedgerTx ^. L.bodyTxL) + + submitResponse <- H.noteShowM . H.evalIO . Rpc.withConnection def rpcServer $ \conn -> + Rpc.nonStreaming conn (Rpc.rpc @(Rpc.Protobuf Submit.SubmitService "submitTx")) $ + def & Submit.tx .~ (def & Submit.raw .~ serialiseToRawBytes (Exp.SignedTx signedLedgerTx)) + submittedTxId <- H.leftFail . deserialiseFromRawBytes AsTxId $ submitResponse ^. Submit.ref + txId' H.=== submittedTxId + pure (txId', txIn0, change, address0, address1, vkeyBytes0) + + (txBlockSlot, txBlockHash, txBlockTxCount) <- do + H.note_ "Follow the chain until the block containing the submitted transaction appears" + + fs <- H.evalIO $ mkNodeConfigFs configurationFile + mTxBlock <- + H.timeout 60_000_000 . runExceptT $ + foldBlocks fs configurationFile (nodeSocketPath node0) QuickValidation Nothing $ + \_env _ledgerState _events blockInMode acc -> do + let BlockHeader (SlotNo foundSlot) (HeaderHash foundHash) _ = getBlockInModeHeader blockInMode + txIds = blockTxIds blockInMode + pure $ + if txId' `elem` txIds + then (Just (foundSlot, SBS.fromShort foundHash, length txIds), StopFold) + else (acc, ContinueFold) + + H.nothingFail mTxBlock >>= \case + Left e -> H.failMessage callStack $ "foldBlocks failed with: " <> displayError e + Right Nothing -> H.failMessage callStack "block containing the submitted transaction not found" + Right (Just found) -> pure found + + do + H.note_ "Fetch the block containing the submitted transaction and verify its transactions" + + let txBlockRef = def & U5c.slot .~ txBlockSlot & U5c.hash .~ txBlockHash + txBlockRequest = def & U5c.ref .~ txBlockRef + txBlockResponse <- H.evalIO . Rpc.withConnection def rpcServer $ \conn -> + Rpc.nonStreaming conn (Rpc.rpc @(Rpc.Protobuf U5c.SyncService "fetchBlock")) txBlockRequest + + let fetchedTxs = txBlockResponse ^. U5c.block . U5c.cardano . U5c.body . U5c.tx + H.note_ "Ensure the fetched block contains all transactions of the block" + length fetchedTxs H.=== txBlockTxCount + + H.note_ "Ensure the fetched block contains the submitted transaction" + protoTx : _ <- H.noteShow $ filter (\t -> t ^. U5c.hash == serialiseToRawBytes txId') fetchedTxs + feeCoin <- H.leftFail $ protoTx ^. U5c.fee . to utxoRpcBigIntToInteger + feeCoin H.=== fee + H.assertWith protoTx (^. U5c.successful) + + H.note_ "Verify the transaction inputs" + let TxIn inputTxId (TxIx inputIx) = txIn0 + map (\i -> (i ^. U5c.txHash, i ^. U5c.outputIndex)) (protoTx ^. U5c.inputs) + H.=== [(serialiseToRawBytes inputTxId, fromIntegral inputIx)] + + H.note_ "Verify the transaction outputs" + map (\o -> (o ^. U5c.address, o ^. U5c.coin)) (protoTx ^. U5c.outputs) + H.=== [ (serialiseToRawBytes address1, inject amount) + , (serialiseToRawBytes address0, inject change) + ] + + H.note_ "The transaction has no reference inputs and no certificates" + protoTx ^. U5c.referenceInputs H.=== [] + protoTx ^. U5c.certificates H.=== [] + + H.note_ "The transaction has no auxiliary data and no proposals" + protoTx ^. U5c.maybe'auxiliary H.=== Nothing + protoTx ^. U5c.proposals H.=== [] + + H.note_ "Verify the transaction validity interval" + protoTx ^. U5c.validity . U5c.start H.=== 0 + protoTx ^. U5c.validity . U5c.ttl H.=== validityUpperBound + + H.note_ "The transaction mints nothing and has no withdrawals or collateral" + protoTx ^. U5c.mint H.=== [] + protoTx ^. U5c.withdrawals H.=== [] + protoTx ^. U5c.maybe'collateral H.=== Nothing + + H.note_ "Verify the witness set contains only the wallet key witness" + let witnessSet = protoTx ^. U5c.witnesses + [vkeyWitness] <- H.noteShow $ witnessSet ^. U5c.vkeywitness + vkeyWitness ^. U5c.vkey H.=== vkeyBytes0 + BS.length (vkeyWitness ^. U5c.signature) H.=== 64 + witnessSet ^. U5c.script H.=== [] + witnessSet ^. U5c.bootstrapWitnesses H.=== [] + witnessSet ^. U5c.plutusDatums H.=== [] + witnessSet ^. U5c.redeemers H.=== [] + + -- An "anyone can mint" policy: a native script requiring an empty set of conditions + let mintScript :: Exp.SimpleScript (Exp.LedgerEra Exp.ConwayEra) + mintScript = Exp.SimpleScript $ Shelley.RequireAllOf mempty + mintPolicyId = PolicyId . fromShelleyScriptHash $ Exp.hashSimpleScript @Exp.ConwayEra mintScript + mintAssetName = UnsafeAssetName "RpcTestToken" + mintQuantity = 1000 + + mintTxId <- do + H.note_ "Build and submit a transaction minting a native-script token via RPC" + + -- Spend the change output of the previous transaction, which sits at index 1 + let changeTxIn = TxIn txId' (TxIx 1) + + wit0 :: ShelleyWitnessSigningKey <- + H.leftFailM . H.evalIO $ + readFileTextEnvelopeAnyOf + [FromSomeType asType WitnessGenesisUTxOKey] + (signingKey $ paymentKeyInfoPair wallet0) + + -- The minted assets have to appear in an output to conserve value. + -- No protocol parameters are needed: a transaction witnessed only by + -- native scripts has no script integrity hash. + let mintWitness = Exp.AnyScriptWitnessSimple $ Exp.SScript mintScript + mintValue = + Exp.TxMintValue $ + fromList [(mintPolicyId, (fromList [(mintAssetName, Quantity mintQuantity)], mintWitness))] + mintTxOut = + Exp.obtainCommonConstraints era $ + Exp.TxOut $ + L.mkBasicTxOut (toShelleyAddr address0) $ + toMaryValue $ + fromList + [ (AdaAssetId, Quantity (change - fee)) + , (AssetId mintPolicyId mintAssetName, Quantity mintQuantity) + ] + mintContent = + Exp.defaultTxBodyContent + & Exp.setTxIns [(changeTxIn, Exp.AnyKeyWitnessPlaceholder)] + & Exp.setTxFee (L.Coin fee) + & Exp.setTxOuts [mintTxOut] + & Exp.setTxMintValue mintValue + & Exp.setTxValidityUpperBound (SlotNo validityUpperBound) + + mintUnsignedTx <- H.leftFail $ Exp.makeUnsignedTx era mintContent + let mintKeyWit = Exp.makeKeyWitness era mintUnsignedTx wit0 + Exp.SignedTx mintSignedLedgerTx = Exp.signTx era [] [mintKeyWit] mintUnsignedTx + mintTxId <- H.noteShow . Exp.obtainCommonConstraints era . TxId $ Exp.hashTxBody (mintSignedLedgerTx ^. L.bodyTxL) + + mintSubmitResponse <- H.noteShowM . H.evalIO . Rpc.withConnection def rpcServer $ \conn -> + Rpc.nonStreaming conn (Rpc.rpc @(Rpc.Protobuf Submit.SubmitService "submitTx")) $ + def & Submit.tx .~ (def & Submit.raw .~ serialiseToRawBytes (Exp.SignedTx mintSignedLedgerTx)) + mintSubmittedTxId <- H.leftFail . deserialiseFromRawBytes AsTxId $ mintSubmitResponse ^. Submit.ref + mintTxId H.=== mintSubmittedTxId + pure mintTxId + + (mintBlockSlot, mintBlockHash, mintBlockTxCount) <- do + H.note_ "Follow the chain until the block containing the minting transaction appears" + + fs <- H.evalIO $ mkNodeConfigFs configurationFile + mMintBlock <- + H.timeout 60_000_000 . runExceptT $ + foldBlocks fs configurationFile (nodeSocketPath node0) QuickValidation Nothing $ + \_env _ledgerState _events blockInMode acc -> do + let BlockHeader (SlotNo foundSlot) (HeaderHash foundHash) _ = getBlockInModeHeader blockInMode + txIds = blockTxIds blockInMode + pure $ + if mintTxId `elem` txIds + then (Just (foundSlot, SBS.fromShort foundHash, length txIds), StopFold) + else (acc, ContinueFold) + + H.nothingFail mMintBlock >>= \case + Left e -> H.failMessage callStack $ "foldBlocks failed with: " <> displayError e + Right Nothing -> H.failMessage callStack "block containing the minting transaction not found" + Right (Just found) -> pure found + + do + H.note_ "Fetch the block containing the minting transaction and verify the minted assets" + + let mintBlockRef = def & U5c.slot .~ mintBlockSlot & U5c.hash .~ mintBlockHash + mintBlockRequest = def & U5c.ref .~ mintBlockRef + mintBlockResponse <- H.evalIO . Rpc.withConnection def rpcServer $ \conn -> + Rpc.nonStreaming conn (Rpc.rpc @(Rpc.Protobuf U5c.SyncService "fetchBlock")) mintBlockRequest + + let mintFetchedTxs = mintBlockResponse ^. U5c.block . U5c.cardano . U5c.body . U5c.tx + H.note_ "Ensure the fetched block contains all transactions of the block" + length mintFetchedTxs H.=== mintBlockTxCount + + H.note_ "Ensure the fetched block contains the minting transaction" + mintProtoTx : _ <- H.noteShow $ filter (\t -> t ^. U5c.hash == serialiseToRawBytes mintTxId) mintFetchedTxs + mintFeeCoin <- H.leftFail $ mintProtoTx ^. U5c.fee . to utxoRpcBigIntToInteger + mintFeeCoin H.=== fee + H.assertWith mintProtoTx (^. U5c.successful) + + let assetsOf :: Rpc.Proto U5c.Multiasset -> [(BS.ByteString, Rpc.Proto U5c.BigInt)] + assetsOf multiasset = + map (\a -> (a ^. U5c.name, a ^. U5c.quantity)) (multiasset ^. U5c.assets) + + H.note_ "Verify the minted assets" + [mintedPolicy] <- H.noteShow $ mintProtoTx ^. U5c.mint + mintedPolicy ^. U5c.policyId H.=== serialiseToRawBytes mintPolicyId + assetsOf mintedPolicy H.=== [(serialiseToRawBytes mintAssetName, inject mintQuantity)] + + H.note_ "Verify the output carries the minted asset" + [mintOutput] <- H.noteShow $ mintProtoTx ^. U5c.outputs + mintOutput ^. U5c.address H.=== serialiseToRawBytes address0 + mintOutput ^. U5c.coin H.=== inject (change - fee) + map (\ma -> (ma ^. U5c.policyId, assetsOf ma)) (mintOutput ^. U5c.assets) + H.=== [(serialiseToRawBytes mintPolicyId, [(serialiseToRawBytes mintAssetName, inject mintQuantity)])] + + H.note_ "Verify the witness set contains the native mint script and the wallet key witness" + let mintWitnessSet = mintProtoTx ^. U5c.witnesses + [mintVkeyWitness] <- H.noteShow $ mintWitnessSet ^. U5c.vkeywitness + mintVkeyWitness ^. U5c.vkey H.=== vkeyBytes0 + [mintScriptWitness] <- H.noteShow $ mintWitnessSet ^. U5c.script + H.assertWith mintScriptWitness $ isJust . (^. U5c.maybe'native) + +asAddressInEra :: ShelleyBasedEra era -> AsType (AddressInEra era) +asAddressInEra s = shelleyBasedEraConstraints s $ AsAddressInEra asType + +getBlockInModeHeader :: BlockInMode -> BlockHeader +getBlockInModeHeader (BlockInMode _ block) = getBlockHeader block + +-- | Transaction ids of all transactions in a block. +blockTxIds :: BlockInMode -> [TxId] +blockTxIds (BlockInMode era block) = + forEraInEon era [] $ \sbe -> + shelleyBasedEraConstraints + sbe + [ TxId $ Exp.hashTxBody (ledgerTx ^. L.bodyTxL) + | ShelleyTx _ ledgerTx <- getBlockTxs block + ] diff --git a/cardano-testnet/test/cardano-testnet-test/Cardano/Testnet/Test/Rpc/FollowTip.hs b/cardano-testnet/test/cardano-testnet-test/Cardano/Testnet/Test/Rpc/FollowTip.hs new file mode 100644 index 00000000000..995c09e1133 --- /dev/null +++ b/cardano-testnet/test/cardano-testnet-test/Cardano/Testnet/Test/Rpc/FollowTip.hs @@ -0,0 +1,276 @@ +{-# LANGUAGE DataKinds #-} +{-# LANGUAGE NamedFieldPuns #-} +{-# LANGUAGE NumericUnderscores #-} +{-# LANGUAGE ScopedTypeVariables #-} +{-# LANGUAGE TypeApplications #-} + +module Cardano.Testnet.Test.Rpc.FollowTip + ( hprop_rpc_follow_tip + ) +where + +import Cardano.Api +import qualified Cardano.Api.Experimental as Exp +import qualified Cardano.Api.Experimental.Tx as Exp +import qualified Cardano.Api.Ledger as L + +import qualified Cardano.Rpc.Client as Rpc +import qualified Cardano.Rpc.Proto.Api.UtxoRpc.Query as Query +import qualified Cardano.Rpc.Proto.Api.UtxoRpc.Submit as Submit +import qualified Cardano.Rpc.Proto.Api.UtxoRpc.Sync as U5c +import Cardano.Rpc.Server.Internal.UtxoRpc.Predicate (exactAddressPredicate) +import Cardano.Rpc.Server.Internal.UtxoRpc.Type (txoRefUtxoRpcToTxIn, + utxoRpcBigIntToInteger, utxoRpcPParamsToProtocolParams) +import Cardano.Testnet + +import Prelude + +import Control.Exception (try) +import Control.Monad (replicateM, void) +import qualified Data.ByteString as BS +import Data.Default.Class +import Data.List.NonEmpty (NonEmpty ((:|))) +import GHC.Stack (HasCallStack, callStack) +import Lens.Micro +import Network.GRPC.Spec (GrpcError (..), GrpcException (..), NextElem (..)) + +import Testnet.Property.Util (integrationRetryWorkspace) +import Testnet.Types + +import qualified Hedgehog as H +import qualified Hedgehog.Extras as H + +-- | Run with: +-- @TASTY_PATTERN='/RPC FollowTip/' cabal test cardano-testnet-test@ +hprop_rpc_follow_tip :: H.Property +hprop_rpc_follow_tip = integrationRetryWorkspace 2 "rpc-follow-tip" $ \tempAbsBasePath' -> H.runWithDefaultWatchdog_ $ do + conf <- mkConf tempAbsBasePath' + + let era = Exp.ConwayEra + sbe = convert era + creationOptions = def{creationEra = AnyShelleyBasedEra sbe} + runtimeOptions = def{runtimeEnableRpc = RpcEnabled} + + TestnetRuntime + { testnetNodes = node0 :| _ + , wallets = wallet0@(PaymentKeyInfo _ addressText0) : PaymentKeyInfo _ addressText1 : _ + } <- + createAndRunTestnet creationOptions runtimeOptions conf + + rpcSocket <- H.note . unFile $ nodeRpcSocketPath node0 + let rpcServer = Rpc.ServerUnix rpcSocket + + -- Open a fresh FollowTip stream intersecting at the given references, + -- read exactly the requested number of messages, then let the + -- connection close: the stream is never consumed beyond what the + -- caller asked for. + followTipN :: Int -> [Rpc.Proto U5c.BlockRef] -> H.Integration [NextElem (Rpc.Proto U5c.FollowTipResponse)] + followTipN messageCount intersectRefs = + H.evalIO . Rpc.withConnection def rpcServer $ \conn -> + Rpc.serverStreaming conn (Rpc.rpc @(Rpc.Protobuf U5c.SyncService "followTip")) (def & U5c.intersect .~ intersectRefs) $ + \recv -> replicateM messageCount recv + + -- Open a stream expecting it to fail before any message is delivered, + -- mirroring FetchBlock's @fetchBlockExpectingError@ pattern. + -- + -- This deliberately bypasses 'Rpc.serverStreaming': its @recv@ action + -- is grapesy's 'Rpc.recvNextOutputElem', which reports both a clean + -- end of stream and an error end of stream as the same 'NoNextElem' + -- value, swallowing the gRPC status. 'Rpc.recvOutput' checks the + -- trailers and raises 'GrpcException' when the stream ended with a + -- non-OK status, so the low-level 'Rpc.withRPC' call is used instead. + followTipExpectingError :: GrpcError -> [Rpc.Proto U5c.BlockRef] -> H.Integration () + followTipExpectingError expectedError intersectRefs = do + result <- + H.evalIO . try . Rpc.withConnection def rpcServer $ \conn -> + Rpc.withRPC conn def (Proxy @(Rpc.Protobuf U5c.SyncService "followTip")) $ \call -> do + Rpc.sendFinalInput call (def & U5c.intersect .~ intersectRefs) + void $ Rpc.recvOutput call + case result of + Left GrpcException{grpcError} + | grpcError == expectedError -> pure () + | otherwise -> do + H.note_ $ "expected " <> show expectedError <> ", got: " <> show grpcError + H.failure + Right () -> do + H.note_ $ "expected " <> show expectedError <> ", but the call succeeded" + H.failure + + -- Tail a FollowTip stream from the given intersection point, scanning + -- apply messages for one whose parsed body contains a transaction + -- with the given hash. Bounded by 'maxApplyMessages' apply messages + -- (resets don't count against the bound) so a missing transaction + -- fails promptly with a clear cause instead of hanging until the + -- watchdog kills the whole property. + followTipUntilTx + :: [Rpc.Proto U5c.BlockRef] + -> BS.ByteString + -> Int + -> H.Integration (Maybe (Rpc.Proto U5c.Tx)) + followTipUntilTx intersectRefs txHash maxApplyMessages = + H.evalIO . Rpc.withConnection def rpcServer $ \conn -> + Rpc.serverStreaming conn (Rpc.rpc @(Rpc.Protobuf U5c.SyncService "followTip")) (def & U5c.intersect .~ intersectRefs) $ \recv -> + let scanApplies remaining + | remaining <= 0 = pure Nothing + | otherwise = do + next <- recv + case next of + NoNextElem -> pure Nothing + NextElem message -> + case message ^. U5c.maybe'apply of + Nothing -> scanApplies remaining + Just block -> + case filter (\t -> t ^. U5c.hash == txHash) (block ^. U5c.cardano . U5c.body . U5c.tx) of + (tx : _) -> pure (Just tx) + [] -> scanApplies (remaining - 1) + in scanApplies maxApplyMessages + + -- Origin is a BlockRef with an empty hash: clients append it as an + -- infallible catch-all requesting full-history sync. + originRef = def & U5c.slot .~ 0 & U5c.hash .~ BS.empty + + (seenSlot, seenHash, observedTipSlot) <- do + H.note_ "Open a FollowTip stream from origin: the first message must be a reset to slot 0 with an empty hash" + [resetElem, applyElem1, applyElem2, applyElem3] <- followTipN 4 [originRef] + resetMsg <- nextElemFail resetElem + apply1 <- nextElemFail applyElem1 + apply2 <- nextElemFail applyElem2 + apply3 <- nextElemFail applyElem3 + + resetRef <- H.nothingFail (resetMsg ^. U5c.maybe'reset) + resetRef ^. U5c.slot H.=== 0 + H.assertWith (resetRef ^. U5c.hash) BS.null + + tipAfterReset <- H.nothingFail (resetMsg ^. U5c.maybe'tip) + H.assertWith (tipAfterReset ^. U5c.hash) $ (== 32) . BS.length + + H.note_ "Subsequent messages are apply actions carrying non-empty native bytes and a populated header" + _block1 <- assertAppliedBlock apply1 + _block2 <- assertAppliedBlock apply2 + block3 <- assertAppliedBlock apply3 + + let seenSlot = block3 ^. U5c.cardano . U5c.header . U5c.slot + seenHash = block3 ^. U5c.cardano . U5c.header . U5c.hash + tipAfterApply3 <- H.nothingFail (apply3 ^. U5c.maybe'tip) + let observedTipSlot = tipAfterApply3 ^. U5c.slot + + H.note_ $ + "Remembering the block at slot " + <> show seenSlot + <> " for the resume test, and tip slot " + <> show observedTipSlot + <> " for the empty-intersect test" + pure (seenSlot, seenHash, observedTipSlot) + + do + H.note_ "Re-opening a stream intersecting at the previously seen block resumes exactly there, without replaying from origin" + [resumeElem] <- followTipN 1 [def & U5c.slot .~ seenSlot & U5c.hash .~ seenHash] + resumeMsg <- nextElemFail resumeElem + resumeResetRef <- H.nothingFail (resumeMsg ^. U5c.maybe'reset) + resumeResetRef ^. U5c.slot H.=== seenSlot + resumeResetRef ^. U5c.hash H.=== seenHash + + do + H.note_ "An empty intersect list follows from the current tip: the reset lands at or after the previously observed tip" + [emptyIntersectElem] <- followTipN 1 [] + emptyIntersectMsg <- nextElemFail emptyIntersectElem + emptyIntersectResetRef <- H.nothingFail (emptyIntersectMsg ^. U5c.maybe'reset) + H.assertWith (emptyIntersectResetRef ^. U5c.slot) (>= observedTipSlot) + + H.note_ "An intersect list containing only an unknown block reference fails the stream with NOT_FOUND before any message" + followTipExpectingError GrpcNotFound [def & U5c.slot .~ seenSlot & U5c.hash .~ BS.replicate 32 0xab] + + do + H.note_ "Submit a transaction over gRPC and confirm it arrives via FollowTip as an apply action" + + preSubmissionTipResponse <- + H.evalIO . Rpc.withConnection def rpcServer $ \conn -> + Rpc.nonStreaming conn (Rpc.rpc @(Rpc.Protobuf U5c.SyncService "readTip")) def + preSubmissionTip <- H.nothingFail (preSubmissionTipResponse ^. U5c.maybe'tip) + H.note_ $ "Pre-submission tip slot: " <> show (preSubmissionTip ^. U5c.slot) + + address0 <- H.nothingFail $ deserialiseAddress (asAddressInEra sbe) addressText0 + address1 <- H.nothingFail $ deserialiseAddress (asAddressInEra sbe) addressText1 + + wit0 :: ShelleyWitnessSigningKey <- + H.leftFailM . H.evalIO $ + readFileTextEnvelopeAnyOf + [FromSomeType asType WitnessGenesisUTxOKey] + (signingKey $ paymentKeyInfoPair wallet0) + + (pparamsResponse, searchResponse) <- H.evalIO . Rpc.withConnection def rpcServer $ \conn -> do + pparams' <- + Rpc.nonStreaming conn (Rpc.rpc @(Rpc.Protobuf Query.QueryService "readParams")) def + search' <- + Rpc.nonStreaming conn (Rpc.rpc @(Rpc.Protobuf Query.QueryService "searchUtxos")) $ + def & Query.predicate .~ exactAddressPredicate address0 + pure (pparams', search') + + pparams <- H.leftFail $ utxoRpcPParamsToProtocolParams era $ pparamsResponse ^. Query.values . Query.cardano + txOut0 : _ <- H.noteShow $ searchResponse ^. Query.items + txIn0 <- H.leftFail . txoRefUtxoRpcToTxIn $ txOut0 ^. Query.txoRef + outputCoin <- H.leftFail $ txOut0 ^. Query.cardano . Query.coin . to utxoRpcBigIntToInteger + + let fee = 500 + amount = 100_000_000 + validityUpperBound = 100_000_000 + change = outputCoin - amount - fee + mkOut ledgerAddress coin = + Exp.obtainCommonConstraints era $ + Exp.TxOut $ + L.mkBasicTxOut ledgerAddress $ + L.inject $ + L.Coin coin + content = + Exp.defaultTxBodyContent + & Exp.setTxIns [(txIn0, Exp.AnyKeyWitnessPlaceholder)] + & Exp.setTxFee (L.Coin fee) + & Exp.setTxOuts [mkOut (toShelleyAddr address1) amount, mkOut (toShelleyAddr address0) change] + & Exp.setTxValidityUpperBound (SlotNo validityUpperBound) + & Exp.setTxProtocolParams pparams + + unsignedTx <- H.leftFail $ Exp.makeUnsignedTx era content + let keyWit = Exp.makeKeyWitness era unsignedTx wit0 + Exp.SignedTx signedLedgerTx = Exp.signTx era [] [keyWit] unsignedTx + txId' <- H.noteShow . Exp.obtainCommonConstraints era . TxId $ Exp.hashTxBody (signedLedgerTx ^. L.bodyTxL) + let txHash = serialiseToRawBytes txId' + + H.note_ "Submitting the transaction" + submitResponse <- H.noteShowM . H.evalIO . Rpc.withConnection def rpcServer $ \conn -> + Rpc.nonStreaming conn (Rpc.rpc @(Rpc.Protobuf Submit.SubmitService "submitTx")) $ + def & Submit.tx .~ (def & Submit.raw .~ serialiseToRawBytes (Exp.SignedTx signedLedgerTx)) + submittedTxId <- H.leftFail . deserialiseFromRawBytes AsTxId $ submitResponse ^. Submit.ref + txId' H.=== submittedTxId + + H.note_ "Tailing FollowTip from the pre-submission tip until the submitted transaction appears in an apply message" + foundTx <- followTipUntilTx [preSubmissionTip] txHash 30 + tx <- case foundTx of + Just found -> pure found + Nothing -> + H.failMessage callStack "submitted transaction did not appear in a FollowTip apply message within 30 apply messages" + + H.note_ "The found transaction's hash, fee and parsed inputs/outputs match what was submitted" + tx ^. U5c.hash H.=== txHash + txFee <- H.leftFail $ tx ^. U5c.fee . to utxoRpcBigIntToInteger + txFee H.=== fee + H.assertWith (tx ^. U5c.inputs) $ not . null + H.assertWith (tx ^. U5c.outputs) $ not . null + +-- | Unwrap a streamed element, failing with a descriptive message if the +-- stream ended before the expected message arrived. +nextElemFail :: (HasCallStack, H.MonadTest m) => NextElem a -> m a +nextElemFail (NextElem value) = pure value +nextElemFail NoNextElem = H.failMessage callStack "stream ended before the expected message arrived" + +-- | Assert that a FollowTip response is an @apply@ action carrying non-empty +-- native bytes and a populated Cardano header. +assertAppliedBlock :: H.MonadTest m => Rpc.Proto U5c.FollowTipResponse -> m (Rpc.Proto U5c.AnyChainBlock) +assertAppliedBlock message = do + block <- H.nothingFail (message ^. U5c.maybe'apply) + H.assertWith (block ^. U5c.nativeBytes) $ not . BS.null + H.assertWith (block ^. U5c.cardano . U5c.header . U5c.hash) $ (== 32) . BS.length + H.assertWith (block ^. U5c.cardano . U5c.header . U5c.slot) (> 0) + pure block + +asAddressInEra :: ShelleyBasedEra era -> AsType (AddressInEra era) +asAddressInEra s = shelleyBasedEraConstraints s $ AsAddressInEra asType diff --git a/cardano-testnet/test/cardano-testnet-test/Cardano/Testnet/Test/Rpc/Genesis.hs b/cardano-testnet/test/cardano-testnet-test/Cardano/Testnet/Test/Rpc/Genesis.hs new file mode 100644 index 00000000000..65150830d1e --- /dev/null +++ b/cardano-testnet/test/cardano-testnet-test/Cardano/Testnet/Test/Rpc/Genesis.hs @@ -0,0 +1,105 @@ +{-# LANGUAGE DataKinds #-} +{-# LANGUAGE LambdaCase #-} +{-# LANGUAGE NamedFieldPuns #-} +{-# LANGUAGE OverloadedStrings #-} +{-# LANGUAGE TypeApplications #-} + +module Cardano.Testnet.Test.Rpc.Genesis + ( hprop_rpc_read_genesis + ) +where + +import Cardano.Api +import qualified Cardano.Api.Experimental as Exp + +import qualified Cardano.Rpc.Client as Rpc +import qualified Cardano.Rpc.Proto.Api.UtxoRpc.Query as U5c +import Cardano.Testnet + +import Prelude + +import Control.Monad (void) +import qualified Data.ByteString as BS +import Data.Default.Class +import Data.List.NonEmpty (NonEmpty ((:|))) +import qualified Data.Map.Strict as Map +import qualified Data.Text as Text +import Data.Word (Word32) +import Lens.Micro + +import Testnet.Property.Util (integrationRetryWorkspace) + +import qualified Hedgehog as H +import qualified Hedgehog.Extras as H + +-- | Run with: +-- @TASTY_PATTERN='/RPC ReadGenesis/' cabal test cardano-testnet-test@ +hprop_rpc_read_genesis :: H.Property +hprop_rpc_read_genesis = integrationRetryWorkspace 2 "rpc-read-genesis" $ \tempAbsBasePath' -> H.runWithDefaultWatchdog_ $ do + conf <- mkConf tempAbsBasePath' + + let era = Exp.ConwayEra + sbe = convert era + creationOptions = def{creationEra = AnyShelleyBasedEra sbe} + runtimeOptions = def{runtimeEnableRpc = RpcEnabled} + + TestnetRuntime + { testnetMagic + , testnetNodes = node0 :| _ + } <- + createAndRunTestnet creationOptions runtimeOptions conf + + rpcSocket <- H.note . unFile $ nodeRpcSocketPath node0 + let rpcServer = Rpc.ServerUnix rpcSocket + + response <- + H.evalIO . Rpc.withConnection def rpcServer $ \conn -> + Rpc.nonStreaming conn (Rpc.rpc @(Rpc.Protobuf U5c.QueryService "readGenesis")) def + + H.note_ "genesis is the 32-byte Shelley genesis hash" + H.assertWith (response ^. U5c.genesis) $ (== 32) . BS.length + + H.note_ "caip2 is derived from the testnet's own network magic" + response ^. U5c.caip2 H.=== networkMagicToCaip2 (fromIntegral testnetMagic) + + H.note_ "The cardano config oneof is set" + cardanoGenesis <- H.nothingFail (response ^. U5c.maybe'cardano) + + H.note_ "Shelley: epochLength, networkMagic, systemStart, protocolParams" + H.assertWith (cardanoGenesis ^. U5c.epochLength) (> 0) + cardanoGenesis ^. U5c.networkMagic H.=== fromIntegral testnetMagic + H.assertWith (cardanoGenesis ^. U5c.systemStart) $ not . Text.null + void $ H.nothingFail (cardanoGenesis ^. U5c.maybe'protocolParams) + + H.note_ "initialFunds is non-empty: only the uncompacted boot-time genesis carries it, and cardano-testnet funds its wallets there" + H.assertWith (cardanoGenesis ^. U5c.initialFunds) $ not . Map.null + + H.note_ "Byron: protocolConsts, startTime, bootStakeholders" + protocolConsts <- H.nothingFail (cardanoGenesis ^. U5c.maybe'protocolConsts) + H.assertWith (protocolConsts ^. U5c.k) (> 0) + H.assertWith (cardanoGenesis ^. U5c.startTime) (> 0) + let bootStakeholderWeights = cardanoGenesis ^. U5c.bootStakeholders + H.assertWith bootStakeholderWeights $ not . Map.null + H.assertWith (Map.elems bootStakeholderWeights) $ all (== 1) + + H.note_ "Alonzo: executionPrices, maxTxExUnits, PlutusV1 cost model" + void $ H.nothingFail (cardanoGenesis ^. U5c.maybe'executionPrices) + maxTxExUnits <- H.nothingFail (cardanoGenesis ^. U5c.maybe'maxTxExUnits) + H.assertWith (maxTxExUnits ^. U5c.steps, maxTxExUnits ^. U5c.memory) (/= (0, 0)) + plutusV1CostModel <- H.nothingFail (cardanoGenesis ^. U5c.costModels . U5c.maybe'plutusV1) + H.assertWith (plutusV1CostModel ^. U5c.values) $ not . null + + H.note_ "Conway: PlutusV3 cost model, committee" + plutusV3CostModel <- H.nothingFail (cardanoGenesis ^. U5c.costModels . U5c.maybe'plutusV3) + H.assertWith (plutusV3CostModel ^. U5c.values) $ not . null + void $ H.nothingFail (cardanoGenesis ^. U5c.maybe'committee) + +-- | The CAIP-2 chain identifier for a Cardano network, keyed on the Shelley +-- network magic. Mirrors 'Cardano.Rpc.Server.Internal.UtxoRpc.Query.networkMagicToCaip2' +-- so the test derives its expectation independently of the handler's own logic. +networkMagicToCaip2 :: Word32 -> Text.Text +networkMagicToCaip2 = \case + 764824073 -> "cardano:mainnet" + 1 -> "cardano:preprod" + 2 -> "cardano:preview" + magic -> "cardano:" <> Text.pack (show magic) diff --git a/cardano-testnet/test/cardano-testnet-test/Cardano/Testnet/Test/Rpc/SearchUtxos.hs b/cardano-testnet/test/cardano-testnet-test/Cardano/Testnet/Test/Rpc/SearchUtxos.hs index 949999a6eac..e242865cf3e 100644 --- a/cardano-testnet/test/cardano-testnet-test/Cardano/Testnet/Test/Rpc/SearchUtxos.hs +++ b/cardano-testnet/test/cardano-testnet-test/Cardano/Testnet/Test/Rpc/SearchUtxos.hs @@ -17,13 +17,13 @@ import qualified Cardano.Api.Experimental as Exp import qualified Cardano.Api.Experimental.Tx as Exp import qualified Cardano.Api.Ledger as L -import Cardano.Rpc.Client (Proto) import qualified Cardano.Rpc.Client as Rpc import qualified Cardano.Rpc.Proto.Api.UtxoRpc.Query as U5c hiding (cardano) import qualified Cardano.Rpc.Proto.Api.UtxoRpc.Query as UtxoRpc import qualified Cardano.Rpc.Proto.Api.UtxoRpc.Submit as U5c import qualified Cardano.Rpc.Proto.Api.UtxoRpc.Submit as UtxoRpc -import Cardano.Rpc.Server.Internal.UtxoRpc.Predicate (serialisePaymentCredential) +import Cardano.Rpc.Server.Internal.UtxoRpc.Predicate (exactAddressPredicate, + serialisePaymentCredential) import Cardano.Rpc.Server.Internal.UtxoRpc.Type import Cardano.Testnet @@ -34,9 +34,8 @@ import Control.Monad.Trans.Control (liftBaseOp) import Data.ByteString (ByteString) import Data.Default.Class import Data.List.NonEmpty (NonEmpty ((:|))) -import GHC.Stack import Lens.Micro -import Network.GRPC.Spec (GrpcError (..), GrpcException (..)) +import Network.GRPC.Spec (GrpcError (..), GrpcException (..), Proto) import Testnet.Components.Query (TestnetWaitPeriod (..), getEpochStateView, retryUntilM) import Testnet.Property.Util (integrationRetryWorkspace) @@ -97,13 +96,13 @@ hprop_rpc_search_utxos = integrationRetryWorkspace 2 "rpc-search-utxos" $ \tempA search' <- Rpc.nonStreaming conn (Rpc.rpc @(Rpc.Protobuf UtxoRpc.QueryService "searchUtxos")) $ - def & U5c.predicate .~ addressPredicate address0 + def & U5c.predicate .~ exactAddressPredicate address0 pure (pparams', search') pparams <- H.leftFail $ utxoRpcPParamsToProtocolParams era $ pparamsResponse ^. U5c.values . U5c.cardano txOut0 : _ <- H.noteShow $ initialSearch ^. U5c.items - txIn0 <- txoRefToTxIn $ txOut0 ^. U5c.txoRef + txIn0 <- H.leftFail . txoRefUtxoRpcToTxIn $ txOut0 ^. U5c.txoRef outputCoin <- H.leftFail $ txOut0 ^. U5c.cardano . U5c.coin . to utxoRpcBigIntToInteger let amount = 200_000_000 @@ -134,7 +133,7 @@ hprop_rpc_search_utxos = integrationRetryWorkspace 2 "rpc-search-utxos" $ \tempA utxosAtAddress1 <- retryUntilM epochStateView (WaitForBlocks 10) (do searchResult <- H.evalIO $ Rpc.nonStreaming conn (Rpc.rpc @(Rpc.Protobuf UtxoRpc.QueryService "searchUtxos")) $ - def & U5c.predicate .~ addressPredicate address1 + def & U5c.predicate .~ exactAddressPredicate address1 pure $ searchResult ^. U5c.items ) (\xs -> length xs == 2) @@ -201,23 +200,9 @@ hprop_rpc_search_utxos = integrationRetryWorkspace 2 "rpc-search-utxos" $ \tempA H.note_ "Test 4: Verify anyOf predicate with both addresses returns all UTxOs" allUtxosSearch <- H.noteShowM . H.evalIO $ Rpc.nonStreaming conn (Rpc.rpc @(Rpc.Protobuf UtxoRpc.QueryService "searchUtxos")) $ - def & U5c.predicate .~ (def & U5c.anyOf .~ [addressPredicate address0, addressPredicate address1]) + def & U5c.predicate .~ (def & U5c.anyOf .~ [exactAddressPredicate address0, exactAddressPredicate address1]) H.assertWith (allUtxosSearch ^. U5c.items) $ \xs -> length xs > 2 asAddressInEra :: ShelleyBasedEra era -> AsType (AddressInEra era) asAddressInEra s = shelleyBasedEraConstraints s $ AsAddressInEra asType - -txoRefToTxIn :: (HasCallStack, MonadTest m) => Proto UtxoRpc.TxoRef -> m TxIn -txoRefToTxIn r = withFrozenCallStack $ do - txId' <- H.leftFail $ deserialiseFromRawBytes AsTxId $ r ^. U5c.hash - pure $ TxIn txId' (TxIx . fromIntegral $ r ^. U5c.index) - -addressPredicate :: IsCardanoEra era => AddressInEra era -> Proto UtxoRpc.UtxoPredicate -addressPredicate address = - def - & U5c.match - .~ ( def - & U5c.cardano - .~ (def & U5c.address .~ (def & U5c.exactAddress .~ serialiseToRawBytes address)) - ) diff --git a/cardano-testnet/test/cardano-testnet-test/Cardano/Testnet/Test/Rpc/Transaction.hs b/cardano-testnet/test/cardano-testnet-test/Cardano/Testnet/Test/Rpc/Transaction.hs index bd2f27f0fad..5d3323a0eba 100644 --- a/cardano-testnet/test/cardano-testnet-test/Cardano/Testnet/Test/Rpc/Transaction.hs +++ b/cardano-testnet/test/cardano-testnet-test/Cardano/Testnet/Test/Rpc/Transaction.hs @@ -16,12 +16,12 @@ import qualified Cardano.Api.Experimental as Exp import qualified Cardano.Api.Experimental.Tx as Exp import qualified Cardano.Api.Ledger as L -import Cardano.Rpc.Client (Proto) import qualified Cardano.Rpc.Client as Rpc import qualified Cardano.Rpc.Proto.Api.UtxoRpc.Query as U5c hiding (cardano) import qualified Cardano.Rpc.Proto.Api.UtxoRpc.Query as UtxoRpc import qualified Cardano.Rpc.Proto.Api.UtxoRpc.Submit as U5c import qualified Cardano.Rpc.Proto.Api.UtxoRpc.Submit as UtxoRpc +import Cardano.Rpc.Server.Internal.UtxoRpc.Predicate (exactAddressPredicate) import Cardano.Rpc.Server.Internal.UtxoRpc.Type import Cardano.Testnet @@ -30,7 +30,6 @@ import Prelude import Control.Monad.Trans.Control (liftBaseOp) import Data.Default.Class import Data.List.NonEmpty (NonEmpty ((:|))) -import GHC.Stack import Lens.Micro import Testnet.Components.Query (TestnetWaitPeriod (..), getEpochStateView, retryUntilM) @@ -87,13 +86,13 @@ hprop_rpc_transaction = integrationRetryWorkspace 2 "rpc-tx" $ \tempAbsBasePath' search' <- Rpc.nonStreaming conn (Rpc.rpc @(Rpc.Protobuf UtxoRpc.QueryService "searchUtxos")) $ - def & U5c.predicate .~ addressPredicate address0 + def & U5c.predicate .~ exactAddressPredicate address0 pure (pparams', search') pparams <- H.leftFail $ utxoRpcPParamsToProtocolParams era $ pparamsResponse ^. U5c.values . U5c.cardano txOut0 : _ <- H.noteShow $ searchResponse ^. U5c.items - txIn0 <- txoRefToTxIn $ txOut0 ^. U5c.txoRef + txIn0 <- H.leftFail . txoRefUtxoRpcToTxIn $ txOut0 ^. U5c.txoRef outputCoin <- H.leftFail $ txOut0 ^. U5c.cardano . U5c.coin . to utxoRpcBigIntToInteger let amount = 200_000_000 @@ -129,7 +128,7 @@ hprop_rpc_transaction = integrationRetryWorkspace 2 "rpc-tx" $ \tempAbsBasePath' utxosForAddress <- retryUntilM epochStateView (WaitForBlocks 10) (do searchResult <- H.evalIO $ Rpc.nonStreaming conn (Rpc.rpc @(Rpc.Protobuf UtxoRpc.QueryService "searchUtxos")) $ - def & U5c.predicate .~ addressPredicate address1 + def & U5c.predicate .~ exactAddressPredicate address1 pure $ searchResult ^. U5c.items ) (\xs -> length xs == 2) @@ -140,17 +139,3 @@ hprop_rpc_transaction = integrationRetryWorkspace 2 "rpc-tx" $ \tempAbsBasePath' asAddressInEra :: ShelleyBasedEra era -> AsType (AddressInEra era) asAddressInEra s = shelleyBasedEraConstraints s $ AsAddressInEra asType - -txoRefToTxIn :: (HasCallStack, MonadTest m) => Proto UtxoRpc.TxoRef -> m TxIn -txoRefToTxIn r = withFrozenCallStack $ do - txId' <- H.leftFail $ deserialiseFromRawBytes AsTxId $ r ^. U5c.hash - pure $ TxIn txId' (TxIx . fromIntegral $ r ^. U5c.index) - -addressPredicate :: IsCardanoEra era => AddressInEra era -> Proto UtxoRpc.UtxoPredicate -addressPredicate address = - def - & U5c.match - .~ ( def - & U5c.cardano - .~ (def & U5c.address .~ (def & U5c.exactAddress .~ serialiseToRawBytes address)) - ) diff --git a/cardano-testnet/test/cardano-testnet-test/cardano-testnet-test.hs b/cardano-testnet/test/cardano-testnet-test/cardano-testnet-test.hs index c1d7ab52310..a697897280a 100644 --- a/cardano-testnet/test/cardano-testnet-test/cardano-testnet-test.hs +++ b/cardano-testnet/test/cardano-testnet-test/cardano-testnet-test.hs @@ -36,6 +36,9 @@ import qualified Cardano.Testnet.Test.MainnetParams import qualified Cardano.Testnet.Test.Node.Shutdown import qualified Cardano.Testnet.Test.Parser import qualified Cardano.Testnet.Test.Rpc.Eval +import qualified Cardano.Testnet.Test.Rpc.FetchBlock +import qualified Cardano.Testnet.Test.Rpc.FollowTip +import qualified Cardano.Testnet.Test.Rpc.Genesis import qualified Cardano.Testnet.Test.Rpc.Query import qualified Cardano.Testnet.Test.Rpc.SearchUtxos import qualified Cardano.Testnet.Test.Rpc.Transaction @@ -148,7 +151,10 @@ tests = do [ ignoreOnMacAndWindows "transaction" Cardano.Testnet.Test.SubmitApi.Transaction.hprop_transaction ] , T.testGroup "RPC" - [ ignoreOnWindows "RPC Query Protocol Params" Cardano.Testnet.Test.Rpc.Query.hprop_rpc_query_pparams + [ ignoreOnWindows "RPC FetchBlock" Cardano.Testnet.Test.Rpc.FetchBlock.hprop_rpc_fetch_block + , ignoreOnWindows "RPC FollowTip" Cardano.Testnet.Test.Rpc.FollowTip.hprop_rpc_follow_tip + , ignoreOnWindows "RPC ReadGenesis" Cardano.Testnet.Test.Rpc.Genesis.hprop_rpc_read_genesis + , ignoreOnWindows "RPC Query Protocol Params" Cardano.Testnet.Test.Rpc.Query.hprop_rpc_query_pparams , ignoreOnWindows "RPC SearchUtxos" Cardano.Testnet.Test.Rpc.SearchUtxos.hprop_rpc_search_utxos , ignoreOnWindows "RPC Transaction Submit" Cardano.Testnet.Test.Rpc.Transaction.hprop_rpc_transaction , ignoreOnWindows "RPC Eval Tx" Cardano.Testnet.Test.Rpc.Eval.hprop_rpc_eval_tx