diff --git a/.serena/.gitignore b/.serena/.gitignore new file mode 100644 index 00000000000..2e510aff585 --- /dev/null +++ b/.serena/.gitignore @@ -0,0 +1,2 @@ +/cache +/project.local.yml diff --git a/.serena/project.yml b/.serena/project.yml new file mode 100644 index 00000000000..7a39e475749 --- /dev/null +++ b/.serena/project.yml @@ -0,0 +1,159 @@ +# the name by which the project can be referenced within Serena/when chatting with the LLM. +project_name: "cardano-node" + +# list of languages for which language servers are started (LSP backend only); choose from: +# ada al angular ansible bash +# bsl clojure cpp cpp_ccls crystal +# csharp csharp_omnisharp cue dart elixir +# elm erlang fortran fsharp gdscript +# go groovy haskell haxe hlsl +# html java json julia kotlin +# latex lean4 lua luau markdown +# matlab msl nix ocaml pascal +# perl php php_phpactor php_phpantom powershell +# python python_jedi python_pyrefly python_ty r +# rego ruby ruby_solargraph rust scala +# scss solidity svelte swift systemverilog +# terraform toml typescript typescript_vts vue +# yaml zig +# (This list may be outdated; generated with scripts/print_language_list.py; +# For the current list, see values of Language enum here: +# https://github.com/oraios/serena/blob/main/src/solidlsp/ls_config.py) +# For some languages, there are alternative language servers, e.g. csharp_omnisharp, ruby_solargraph.) +# Note: +# - For C, use cpp +# - For JavaScript, use typescript +# - For Angular projects, use angular (subsumes typescript+html; requires `npm install` in the project root) +# - For Svelte projects, use svelte (subsumes typescript/javascript for .svelte projects; requires npm) +# - For SCSS / Sass / plain CSS, use scss (some-sass-language-server handles all three) +# - For Free Pascal/Lazarus, use pascal +# Special requirements: +# Some languages require additional setup/installations. +# See here for details: https://oraios.github.io/serena/01-about/020_programming-languages.html#language-servers +# When using multiple languages, the first language server that supports a given file will be used for that file. +# The first language is the default language and the respective language server will be used as a fallback. +# Note that when using the JetBrains backend, language servers are not used and this list is correspondingly ignored. +languages: +- haskell + +# the encoding used by text files in the project +# For a list of possible encodings, see https://docs.python.org/3.11/library/codecs.html#standard-encodings +encoding: "utf-8" + +# optional shell command to run before the language backend (LSP or JetBrains) is initialised. +# the command runs in the project root directory and is only executed if the project is trusted +# (see trusted_project_path_patterns in the global configuration). +# serena waits for the command to exit: a non-zero exit code is logged as an error but does not +# abort activation. a per-project timeout (activation_command_timeout, default 180s) is the safety +# backstop for non-terminating commands; on expiry the process is killed and activation continues. +# example: activation_command: "npx nx run-many -t build" +activation_command: + +# maximum time in seconds to wait for activation_command to complete before killing it (default 180s). +# must be a positive number. +activation_command_timeout: 180 + +# line ending convention to use when writing source files. +# Possible values: unset (use global setting), "lf", "crlf", or "native" (platform default) +# This does not affect Serena's own files (e.g. memories and configuration files), which always use native line endings. +line_ending: + +# The language backend to use for this project. +# If not set, the global setting from serena_config.yml is used. +# Valid values: LSP, JetBrains +# Note: the backend is fixed at startup. If a project with a different backend +# is activated post-init, an error will be returned. +language_backend: + +# whether to use project's .gitignore files to ignore files +ignore_all_files_in_gitignore: true + +# advanced configuration option allowing to configure language server-specific options. +# Maps the language key to the options. +# The settings are considered only if the project is trusted (see global configuration to define trusted projects). +# See https://oraios.github.io/serena/02-usage/050_configuration.html#language-server-specific-settings +ls_specific_settings: {} + +# list of workspace folder paths (LSP backend only). +# These folders will be used to build up Serena's symbol index. +# Paths must be within the project root and should thus be relative to the project root. +# Furthermore, the paths should not be filtered by ignore settings. +# Default setting: The entire project root folder (".") is considered. +# In (large) monorepos, this can be used to index only subfolders of the project root, e.g. +# ls_workspace_folders: +# - "./subproject1" +# - "./subproject2" +ls_workspace_folders: ["."] + +# list of additional workspace folder paths for cross-package reference support. +# Paths can be absolute or relative to the project root. +# Each folder is registered as an LSP workspace folder, enabling language servers to discover +# symbols and references across package boundaries, but these folders are not indexed by Serena, +# i.e. the respective symbols will not be found using Serena's symbol search tools. +# Example: +# additional_workspace_folders: +# - ../sibling-package +# - ../shared-lib +ls_additional_workspace_folders: [] + +# list of additional paths to ignore in this project. +# Same syntax as gitignore, so you can use * and **. +# Note: global ignored_paths from serena_config.yml are also applied additively. +ignored_paths: [] + +# whether the project is in read-only mode +# If set to true, all editing tools will be disabled and attempts to use them will result in an error +# Added on 2025-04-18 +read_only: false + +# list of tool names to exclude. +# This extends the existing exclusions (e.g. from the global configuration) +# Find the list of tools here: https://oraios.github.io/serena/01-about/035_tools.html +excluded_tools: [] + +# list of tools to include that would otherwise be disabled (particularly optional tools that are disabled by default). +# This extends the existing inclusions (e.g. from the global configuration). +# Find the list of tools here: https://oraios.github.io/serena/01-about/035_tools.html +included_optional_tools: [] + +# fixed set of tools to use as the base tool set (if non-empty), replacing Serena's default set of tools. +# This cannot be combined with non-empty excluded_tools or included_optional_tools. +# Find the list of tools here: https://oraios.github.io/serena/01-about/035_tools.html +fixed_tools: [] + +# list of mode names that are to be activated by default, overriding the setting in the global configuration. +# The full set of modes to be activated is base_modes (from global config) + default_modes + added_modes. +# If the setting is undefined/empty, the default_modes from the global configuration (serena_config.yml) apply. +# Otherwise, this overrides the setting from the global configuration (serena_config.yml). +# Therefore, you can set this to [] if you do not want the default modes defined in the global config to apply +# for this project. +# This setting can, in turn, be overridden by CLI parameters (--mode). +# See https://oraios.github.io/serena/02-usage/050_configuration.html#modes +default_modes: + +# list of mode names to be activated additionally for this project, e.g. ["query-projects"] +# The full set of modes to be activated is base_modes (from global config) + default_modes + added_modes. +# See https://oraios.github.io/serena/02-usage/050_configuration.html#modes +added_modes: + +# initial prompt for the project. It will always be given to the LLM upon activating the project +# (contrary to the memories, which are loaded on demand). +initial_prompt: "" + +# time budget (seconds) per tool call for the retrieval of additional symbol information +# such as docstrings or parameter information. +# This overrides the corresponding setting in the global configuration; see the documentation there. +# If null or missing, use the setting from the global configuration. +symbol_info_budget: + +# list of regex patterns which, when matched, mark a memory entry as read‑only. +# Extends the list from the global configuration, merging the two lists. +read_only_memory_patterns: [] + +# list of regex patterns for memories to completely ignore. +# Matching memories will not appear in list_memories or activate_project output +# and cannot be accessed via read_memory or write_memory. +# To access ignored memory files, use the read_file tool on the raw file path. +# Extends the list from the global configuration, merging the two lists. +# Example: ["_archive/.*", "_episodes/.*"] +ignored_memory_patterns: [] diff --git a/cardano-node/src/Cardano/Node/Protocol/Checkpoints.hs b/cardano-node/src/Cardano/Node/Protocol/Checkpoints.hs index 029d1decb04..e8d68378532 100644 --- a/cardano-node/src/Cardano/Node/Protocol/Checkpoints.hs +++ b/cardano-node/src/Cardano/Node/Protocol/Checkpoints.hs @@ -11,10 +11,10 @@ module Cardano.Node.Protocol.Checkpoints import Cardano.Api import qualified Cardano.Crypto.Hash.Class as Crypto -import Cardano.Protocol.Crypto (StandardCrypto) import Cardano.Node.Types +import Cardano.Protocol.Crypto () import Ouroboros.Consensus.Block -import Ouroboros.Consensus.Cardano +import Ouroboros.Consensus.Cardano () import Ouroboros.Consensus.Config (CheckpointsMap (..), emptyCheckpointsMap) import Control.Exception (IOException) diff --git a/cardano-node/src/Cardano/Node/Protocol/Shelley.hs b/cardano-node/src/Cardano/Node/Protocol/Shelley.hs index a816b8e91ed..551bc9aa754 100644 --- a/cardano-node/src/Cardano/Node/Protocol/Shelley.hs +++ b/cardano-node/src/Cardano/Node/Protocol/Shelley.hs @@ -39,7 +39,7 @@ import Cardano.Node.Tracing.Era.Shelley () import Cardano.Node.Tracing.Formatting () import Cardano.Node.Tracing.Tracers.ChainDB () import Cardano.Node.Types -import Cardano.Protocol.Crypto (StandardCrypto) +import Cardano.Protocol.Crypto () import qualified Ouroboros.Consensus.Cardano as Consensus import Ouroboros.Consensus.HardFork.Combinator.AcrossEras () import Ouroboros.Consensus.Protocol.Praos.Common (PraosCanBeLeader (..), diff --git a/cardano-node/src/Cardano/Node/Run.hs b/cardano-node/src/Cardano/Node/Run.hs index f6fe4e745d9..fa7177c886b 100644 --- a/cardano-node/src/Cardano/Node/Run.hs +++ b/cardano-node/src/Cardano/Node/Run.hs @@ -50,6 +50,7 @@ import Cardano.Node.Protocol.Types import Cardano.Node.Queries import Cardano.Rpc.Server import Cardano.Rpc.Server.Config +import Data.IORef import Cardano.Node.Startup import Cardano.Node.TraceConstraints (TraceConstraints) import Cardano.Node.Tracing (Tracers (..)) @@ -449,6 +450,7 @@ handleSimpleNode blockType runP tracers nc cmdPc networkMagic onKernel = do #endif nForkPolicy <- getForkPolicy $ ncResponderCoreAffinityPolicy nc cForkPolicy <- getForkPolicy $ ncResponderCoreAffinityPolicy nc + nodeKernelAccessRef <- newIORef Nothing void $ let diffusionNodeArguments :: Cardano.Diffusion.CardanoNodeArguments IO diffusionNodeArguments = Cardano.Diffusion.CardanoNodeArguments { @@ -481,7 +483,7 @@ handleSimpleNode blockType runP tracers nc cmdPc networkMagic onKernel = do (readTVar ledgerPeerSnapshotVar) nc in - withAsync (rpcServerLoop (startupTracer tracers) (rpcTracer tracers) rpcConfigVar networkMagic) $ \_ -> + withAsync (rpcServerLoop (startupTracer tracers) (rpcTracer tracers) rpcConfigVar networkMagic nodeKernelAccessRef) $ \_ -> Node.run nodeArgs { rnNodeKernelHook = \registry nodeKernel -> do @@ -491,6 +493,8 @@ handleSimpleNode blockType runP tracers nc cmdPc networkMagic onKernel = do useBootstrapVar ledgerPeerSnapshotPathVar ledgerPeerSnapshotVar rpcConfigVar rnNodeKernelHook nodeArgs registry nodeKernel + mkNodeKernelAccess (contramap RpcUnsupportedBlockType (startupTracer tracers)) blockType (pInfoConfig pInfo) nodeKernel + >>= writeIORef nodeKernelAccessRef } StdRunNodeArgs { srnBfcMaxConcurrencyBulkSync = unMaxConcurrencyBulkSync <$> ncMaxConcurrencyBulkSync nc @@ -767,8 +771,9 @@ rpcServerLoop :: Tracer IO (StartupTrace blk) -> Tracer IO TraceRpc -> StrictTVar IO RpcConfig -> NetworkMagic + -> IORef (Maybe NodeKernelAccess) -> IO () -rpcServerLoop startupTracer rpcTracer rpcConfigVar networkMagic = go +rpcServerLoop startupTracer rpcTracer rpcConfigVar networkMagic nodeKernelAccessRef = go where go = do config@RpcConfig{isEnabled = Identity enabled} <- readTVarIO rpcConfigVar @@ -776,7 +781,7 @@ rpcServerLoop startupTracer rpcTracer rpcConfigVar networkMagic = go then race_ (do - runRpcServer rpcTracer (config, networkMagic) + runRpcServer rpcTracer config networkMagic nodeKernelAccessRef traceWith startupTracer RpcForceDisabled disableRpcServer) (waitForRpcConfigChange config) diff --git a/cardano-node/src/Cardano/Node/Startup.hs b/cardano-node/src/Cardano/Node/Startup.hs index af9b9edee9f..e666321571e 100644 --- a/cardano-node/src/Cardano/Node/Startup.hs +++ b/cardano-node/src/Cardano/Node/Startup.hs @@ -145,6 +145,8 @@ data StartupTrace blk = | RpcConfigUpdate Text -- | Log RPC configuration update error | RpcConfigUpdateError Text + -- | Log that node kernel access is not supported for the running block type. + | RpcUnsupportedBlockType Text -- | Log RPC is forcefully disabled after a RPC server crash. | RpcForceDisabled diff --git a/cardano-node/src/Cardano/Node/Tracing/Tracers/Rpc.hs b/cardano-node/src/Cardano/Node/Tracing/Tracers/Rpc.hs index f9781f5efe6..7c0bc7c010d 100644 --- a/cardano-node/src/Cardano/Node/Tracing/Tracers/Rpc.hs +++ b/cardano-node/src/Cardano/Node/Tracing/Tracers/Rpc.hs @@ -13,7 +13,7 @@ import Cardano.Api.Pretty import Cardano.Logging hiding (nsInner) import Cardano.Rpc.Server (TraceRpc (..), TraceRpcQuery (..), TraceRpcSubmit (..), - TraceSpanEvent (..)) + TraceRpcSync (..), TraceSpanEvent (..)) import Data.Aeson (Object, Value (..), (.=)) @@ -48,6 +48,13 @@ instance LogFormatting TraceRpc where TraceRpcSubmitSpan s -> [spanToObject s] TraceRpcEvalTxDecodingError _ -> [] TraceRpcEvalTxSpan s -> [spanToObject s] + TraceRpcSync syncTrace -> + ["kind" .= String "SyncService"] + <> case syncTrace of + TraceRpcFetchBlockSpan s -> [spanToObject s] + TraceRpcFetchBlockNotFound _ -> [] + TraceRpcNodeKernelAccessUnavailable -> [] + TraceRpcForkerError _ -> [] forHuman = docToText . pretty @@ -59,6 +66,7 @@ instance LogFormatting TraceRpc where TraceRpcQuery (TraceRpcQuerySearchUtxosSpan (SpanBegin _)) -> [CounterM "rpc.request.QueryService.SearchUtxos" Nothing] TraceRpcSubmit (TraceRpcSubmitSpan (SpanBegin _)) -> [CounterM "rpc.request.SubmitService.SubmitTx" Nothing] TraceRpcSubmit (TraceRpcEvalTxSpan (SpanBegin _)) -> [CounterM "rpc.request.SubmitService.EvalTx" Nothing] + TraceRpcSync (TraceRpcFetchBlockSpan (SpanBegin _)) -> [CounterM "rpc.request.SyncService.FetchBlock" Nothing] _ -> [] instance MetaTrace TraceRpc where @@ -81,6 +89,13 @@ instance MetaTrace TraceRpc where TraceRpcSubmitSpan _ -> ["SubmitTx", "Span"] TraceRpcEvalTxDecodingError _ -> ["EvalTxDecodingError"] TraceRpcEvalTxSpan _ -> ["EvalTx", "Span"] + TraceRpcSync syncTrace -> + "SyncService" + : case syncTrace of + TraceRpcFetchBlockSpan _ -> ["FetchBlock", "Span"] + TraceRpcFetchBlockNotFound _ -> ["FetchBlockNotFound"] + TraceRpcNodeKernelAccessUnavailable -> ["NodeKernelAccessUnavailable"] + TraceRpcForkerError _ -> ["ForkerError"] severityFor (Namespace _ nsInner) _ = case nsInner of ["FatalError"] -> Just Error -- RPC server startup errors @@ -94,6 +109,10 @@ instance MetaTrace TraceRpc where ["SubmitService", "TxDecodingError"] -> Just Debug -- request error ["SubmitService", "TxValidationError"] -> Just Debug -- request error ["SubmitService", "EvalTxDecodingError"] -> Just Debug -- request error + ["SyncService", "FetchBlock", "Span"] -> Just Debug + ["SyncService", "FetchBlockNotFound"] -> Just Debug -- normal: block may have been pruned + ["SyncService", "NodeKernelAccessUnavailable"] -> Just Warning -- kernel not yet ready + ["SyncService", "ForkerError"] -> Just Warning -- unexpected ledger forker error _ -> Nothing documentFor (Namespace _ nsInner) = case nsInner of @@ -110,6 +129,10 @@ instance MetaTrace TraceRpc where ["SubmitService", "TxDecodingError"] -> Just "A regular request error, when submitted transaction decoding fails." ["SubmitService", "TxValidationError"] -> Just "A regular request error, when submitted transaction is invalid." ["SubmitService", "EvalTxDecodingError"] -> Just "A regular request error, when evalTx transaction decoding fails." + ["SyncService", "FetchBlock", "Span"] -> Just "Span for the FetchBlock SyncService method." + ["SyncService", "FetchBlockNotFound"] -> Just "Requested block was not found in ChainDB." + ["SyncService", "NodeKernelAccessUnavailable"] -> Just "Node kernel access not yet initialised. The node is still starting up." + ["SyncService", "ForkerError"] -> Just "Unexpected error from ledger forker." _ -> Nothing metricsDocFor (Namespace _ nsInner) = case nsInner of @@ -123,6 +146,8 @@ instance MetaTrace TraceRpc where [("rpc.request.SubmitService.SubmitTx", "Span for the SubmitTx UTXORPC method.")] ["SubmitService", "EvalTx", "Span"] -> [("rpc.request.SubmitService.EvalTx", "Span for the EvalTx UTXORPC method.")] + ["SyncService", "FetchBlock", "Span"] -> + [("rpc.request.SyncService.FetchBlock", "Span for the FetchBlock SyncService method.")] _ -> [] allNamespaces = @@ -138,6 +163,10 @@ instance MetaTrace TraceRpc where , ["SubmitService", "TxDecodingError"] , ["SubmitService", "TxValidationError"] , ["SubmitService", "EvalTxDecodingError"] + , ["SyncService", "FetchBlock", "Span"] + , ["SyncService", "FetchBlockNotFound"] + , ["SyncService", "NodeKernelAccessUnavailable"] + , ["SyncService", "ForkerError"] ] -- helper functions diff --git a/cardano-node/src/Cardano/Node/Tracing/Tracers/Startup.hs b/cardano-node/src/Cardano/Node/Tracing/Tracers/Startup.hs index c8eefaef1cf..44bc25173e0 100644 --- a/cardano-node/src/Cardano/Node/Tracing/Tracers/Startup.hs +++ b/cardano-node/src/Cardano/Node/Tracing/Tracers/Startup.hs @@ -17,7 +17,6 @@ module Cardano.Node.Tracing.Tracers.Startup import Cardano.Api (NetworkMagic (..), SlotNo (..)) import qualified Cardano.Api as Api -import Cardano.Network.OrphanInstances () import qualified Cardano.Chain.Genesis as Gen import Cardano.Git.Rev (gitRev) @@ -25,6 +24,7 @@ import Cardano.Ledger.Shelley.API as SL import Cardano.Logging import Cardano.Network.NodeToClient (LocalAddress (..)) import Cardano.Network.NodeToNode (DiffusionMode (..)) +import Cardano.Network.OrphanInstances () import Cardano.Node.Configuration.POM (NodeConfiguration, ncProtocol) import Cardano.Node.Configuration.Socket import Cardano.Node.Protocol (SomeConsensusProtocol (..)) @@ -288,6 +288,9 @@ instance ( Show (BlockNodeToNodeVersion blk) forMachine _dtal (RpcConfigUpdateError err) = mconcat [ "kind" .= String "RpcConfigUpdateError" , "error" .= String ("Error while updating RPC configuration: " <> err) ] + forMachine _dtal (RpcUnsupportedBlockType blockType) = + mconcat [ "kind" .= String "RpcUnsupportedBlockType" + , "blockType" .= String blockType ] forMachine _dtal RpcForceDisabled = mconcat [ "kind" .= String "RpcForceDisabled" , "error" .= String (ppStartupInfoTrace RpcForceDisabled)] @@ -360,6 +363,8 @@ instance MetaTrace (StartupTrace blk) where Namespace [] ["RpcConfigUpdate"] namespaceFor RpcConfigUpdateError {} = Namespace [] ["RpcConfigUpdateError"] + namespaceFor RpcUnsupportedBlockType {} = + Namespace [] ["RpcUnsupportedBlockType"] namespaceFor RpcForceDisabled = Namespace [] ["RpcForceDisabled"] namespaceFor MovedTopLevelOption {} = @@ -376,6 +381,7 @@ instance MetaTrace (StartupTrace blk) where severityFor (Namespace _ ["WarningDevelopmentNodeToClientVersions"]) _ = Just Warning severityFor (Namespace _ ["RpcConfigUpdate"]) _ = Just Notice severityFor (Namespace _ ["RpcConfigUpdateError"]) _ = Just Error + severityFor (Namespace _ ["RpcUnsupportedBlockType"]) _ = Just Warning severityFor (Namespace _ ["RpcForceDisabled"]) _ = Just Error severityFor (Namespace _ ["BlockForgingUpdateError"]) _ = Just Error severityFor (Namespace _ ["BlockForgingBlockTypeMismatch"]) _ = Just Error @@ -407,6 +413,8 @@ instance MetaTrace (StartupTrace blk) where "" documentFor (Namespace [] ["RpcConfigUpdateError"]) = Just "" + documentFor (Namespace [] ["RpcUnsupportedBlockType"]) = Just + "" documentFor (Namespace [] ["RpcForceDisabled"]) = Just "" documentFor (Namespace [] ["NetworkConfigUpdate"]) = Just @@ -480,6 +488,7 @@ instance MetaTrace (StartupTrace blk) where , Namespace [] ["BlockForgingBlockTypeMismatch"] , Namespace [] ["RpcConfigUpdate"] , Namespace [] ["RpcConfigUpdateError"] + , Namespace [] ["RpcUnsupportedBlockType"] , Namespace [] ["RpcForceDisabled"] , Namespace [] ["NetworkConfigUpdate"] , Namespace [] ["NetworkConfigUpdateUnsupported"] @@ -605,6 +614,7 @@ ppStartupInfoTrace (LedgerPeerSnapshotLoaded slotNo) = ppStartupInfoTrace (RpcConfigUpdate config) = "Performing RPC configuration update: " <> config ppStartupInfoTrace (RpcConfigUpdateError err) = "Error while updating RPC configuration: " <> err +ppStartupInfoTrace (RpcUnsupportedBlockType blockType) = "RPC node kernel access is not supported for block type: " <> blockType ppStartupInfoTrace RpcForceDisabled = "RPC endpoint has crashed and because of that it got disabled. Enable gRPC endpoint and send SIGHUP to the node to reenable." ppStartupInfoTrace NonP2PWarning = nonP2PWarningMessage diff --git a/cardano-testnet/cardano-testnet.cabal b/cardano-testnet/cardano-testnet.cabal index f939a8be8d1..bf9c77c0280 100644 --- a/cardano-testnet/cardano-testnet.cabal +++ b/cardano-testnet/cardano-testnet.cabal @@ -239,6 +239,7 @@ 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.Query Cardano.Testnet.Test.Rpc.SearchUtxos Cardano.Testnet.Test.Rpc.Transaction diff --git a/cardano-testnet/src/Testnet/Runtime.hs b/cardano-testnet/src/Testnet/Runtime.hs index e271f264d42..526a823225e 100644 --- a/cardano-testnet/src/Testnet/Runtime.hs +++ b/cardano-testnet/src/Testnet/Runtime.hs @@ -27,6 +27,7 @@ import qualified Cardano.Api as Api import qualified Cardano.Ledger.Api as L import qualified Cardano.Ledger.Shelley.LedgerState as L import qualified Cardano.Ledger.Shelley.State as L +import Cardano.Node.Testnet.Paths (defaultSocketName) import Prelude @@ -53,11 +54,10 @@ import qualified System.Process as IO import System.Process (waitForProcess) import Testnet.Filepath -import Cardano.Node.Testnet.Paths (defaultSocketName) import qualified Testnet.Ping as Ping import Testnet.Process.Run (ProcessError (..), initiateProcess) -import Testnet.Process.RunIO (execCli_, execKesAgentControl_, liftIOAnnotated, - procCustom, procKesAgent, procNode) +import Testnet.Process.RunIO (execCli_, execKesAgentControl_, liftIOAnnotated, procCustom, + procKesAgent, procNode) import Testnet.Types (TestnetKesAgent (..), TestnetNode (..), TestnetRuntime (configurationFile), showIpv4Address, testnetSprockets) @@ -506,9 +506,9 @@ startLedgerNewEpochStateLogging testnetRuntime tmpWorkspace = withFrozenCallStac -> SlotNo -> BlockNo -> StateT (Maybe AnyNewEpochState) IO ConditionResult - handler outputFp diffFp anes@(AnyNewEpochState !sbe !nes _) _ (BlockNo blockNo) = handleException $ do + handler outputFp diffFp anes@(AnyNewEpochState !sbe !nes _) _ (BlockNo currentBlockNo) = handleException $ do let prettyNes = shelleyBasedEraConstraints sbe (encodePretty nes) - blockLabel = "#### BLOCK " <> show blockNo <> " ####" + blockLabel = "#### BLOCK " <> show currentBlockNo <> " ####" liftIOAnnotated . BSC.appendFile outputFp $ BSC.unlines [BSC.pack blockLabel, prettyNes, ""] -- store epoch state for logging of differences diff --git a/cardano-testnet/src/Testnet/Start/Cardano.hs b/cardano-testnet/src/Testnet/Start/Cardano.hs index c4df60856cb..250cd845779 100644 --- a/cardano-testnet/src/Testnet/Start/Cardano.hs +++ b/cardano-testnet/src/Testnet/Start/Cardano.hs @@ -42,42 +42,42 @@ import qualified Cardano.Api.Byron as Byron import Cardano.Network.Diffusion.Topology (CardanoNetworkTopology) import Cardano.Node.Configuration.NodeAddress (PortNumber) import Cardano.Node.Configuration.TopologyP2P () +import Cardano.Node.Testnet.Paths (defaultConfigFile, defaultNodeEnvFile, defaultPortFile, + defaultUtxoAddrPath) import Cardano.Prelude (NonEmpty ((:|)), canonicalEncodePretty, readMaybe) import Ouroboros.Network.PeerSelection.RelayAccessPoint (RelayAccessPoint (..)) import Prelude hiding (lines) import Control.Concurrent (threadDelay) -import Control.Monad (forM, forM_, guard, unless, when) -import Control.Monad.Trans.Maybe (runMaybeT) import Control.Exception (IOException) +import Control.Monad (forM, forM_, guard, unless, when) import Control.Monad.Catch +import Control.Monad.Trans.Maybe (runMaybeT) import Control.Monad.Trans.Resource (MonadResource, getInternalState) import Data.Aeson import qualified Data.Aeson.Encode.Pretty as A -import qualified Data.Yaml as Yaml import qualified Data.ByteString.Lazy as LBS import Data.Default.Class () import Data.Either -import Data.Maybe (mapMaybe) import Data.Functor import Data.List (sort, stripPrefix, uncons) import qualified Data.List.NonEmpty as NEL import qualified Data.Map as Map +import Data.Maybe (mapMaybe) import Data.MonoTraversable (Element, MonoFunctor, omap) import qualified Data.Text as Text import Data.Time (diffUTCTime) import Data.Time.Clock (NominalDiffTime) import qualified Data.Time.Clock as DTC +import qualified Data.Yaml as Yaml import GHC.Stack import qualified System.Directory as IO -import qualified System.Process as Process import System.FilePath (()) +import qualified System.Process as Process import Testnet.Components.Configuration import qualified Testnet.Defaults as Defaults -import Cardano.Node.Testnet.Paths (defaultConfigFile, defaultNodeEnvFile, - defaultPortFile, defaultUtxoAddrPath) import Testnet.Filepath import Testnet.Handlers (interruptNodesOnSigINT) import Testnet.Orphans () @@ -440,9 +440,9 @@ cardanoTestnet QuickValidation (EpochNo maxBound) minBound - $ \_ slotNo blockNo -> do + $ \_ slotNo currentBlockNo -> do put slotNo - pure $ if blockNo >= 1 + pure $ if currentBlockNo >= 1 then ConditionMet -- we got one block else ConditionNotMet 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..20645996f2e --- /dev/null +++ b/cardano-testnet/test/cardano-testnet-test/Cardano/Testnet/Test/Rpc/FetchBlock.hs @@ -0,0 +1,393 @@ +{-# 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.Monad ((<=<)) +import qualified Data.ByteString as BS +import qualified Data.ByteString.Short as SBS +import Data.Default.Class +import Data.Maybe (isJust) +import qualified Data.Text.Encoding as Text +import Data.Time.Clock.POSIX (utcTimeToPOSIXSeconds) +import Data.Word (Word64) +import GHC.Exts (fromList) +import GHC.Stack (callStack) +import Lens.Micro + +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, blockHash, 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 blockHash) <> " bytes" + + -- Call FetchBlock via gRPC + let blockRef = def & U5c.slot .~ slot & U5c.hash .~ blockHash + 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.=== blockHash + + -- 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 + + (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" + + mTxBlock <- + H.timeout 60_000_000 . runExceptT $ + foldBlocks 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.=== [ (Text.encodeUtf8 (serialiseAddress address1), inject amount) + , (Text.encodeUtf8 (serialiseAddress 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" + + mMintBlock <- + H.timeout 60_000_000 . runExceptT $ + foldBlocks 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.=== Text.encodeUtf8 (serialiseAddress 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/SearchUtxos.hs b/cardano-testnet/test/cardano-testnet-test/Cardano/Testnet/Test/Rpc/SearchUtxos.hs index 35491b40d95..615f7fe24ae 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 @@ -33,9 +33,8 @@ import Control.Exception (try) import Control.Monad.Trans.Control (liftBaseOp) import Data.ByteString (ByteString) import Data.Default.Class -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) @@ -96,13 +95,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 @@ -133,7 +132,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) @@ -200,23 +199,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 a447f7c4a16..8c363296450 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 @@ -29,7 +29,6 @@ import Prelude import Control.Monad.Trans.Control (liftBaseOp) import Data.Default.Class -import GHC.Stack import Lens.Micro import Testnet.Components.Query (TestnetWaitPeriod (..), getEpochStateView, retryUntilM) @@ -86,13 +85,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 @@ -128,7 +127,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) @@ -139,17 +138,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..e760ed94e21 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,7 @@ 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.Query import qualified Cardano.Testnet.Test.Rpc.SearchUtxos import qualified Cardano.Testnet.Test.Rpc.Transaction @@ -148,7 +149,8 @@ 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 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