diff --git a/.changes/20260812_101216_cardano-cli_jordan.millar_fix_ping_parser.yml b/.changes/20260812_101216_cardano-cli_jordan.millar_fix_ping_parser.yml new file mode 100644 index 0000000000..d08c83909c --- /dev/null +++ b/.changes/20260812_101216_cardano-cli_jordan.millar_fix_ping_parser.yml @@ -0,0 +1,9 @@ +project: cardano-cli + +pr: 1413 + +kind: + - bugfix + +description: | + Fixed `cardano-cli ping`'s dependency on the command line parser of `cardano-diffusion:ping`, which made the released package unbuildable with default cabal flags (it required a manual `optparse-applicative-fork` cabal flag set via `cabal.project`, which does not ship with the sdist). The command line interface is restored to exactly the pre-11.2 one — `--host`, `--unixsock`, `--port`, `--magic`, `--json`, `--quiet`, `--query-versions` and `--tip`, with `-h` again meaning `--host` — replacing the positional `ADDRS` argument and the `--mode`, `--srv-prefix`, `--color` and `--short-hash` options of the never-published 11.2.0.0 interface. diff --git a/cabal.project b/cabal.project index a55e6efbdb..86d9efe4ba 100644 --- a/cabal.project +++ b/cabal.project @@ -56,9 +56,6 @@ package text package formatting flags: +no-double-conversion -package cardano-diffusion - flags: +optparse-applicative-fork - tests: True test-show-details: direct diff --git a/cardano-cli/cardano-cli.cabal b/cardano-cli/cardano-cli.cabal index 3bce7f3755..8a5ab58f6b 100644 --- a/cardano-cli/cardano-cli.cabal +++ b/cardano-cli/cardano-cli.cabal @@ -363,6 +363,7 @@ test-suite cardano-cli-test cardano-api:{cardano-api, gen}, cardano-cli, cardano-cli:cardano-cli-test-lib, + cardano-diffusion:ping, cardano-slotting, containers, directory, @@ -374,6 +375,7 @@ test-suite cardano-cli-test microlens-aeson, mmorph, monad-control, + optparse-applicative-fork, regex-tdfa, resourcet, tasty, @@ -407,6 +409,7 @@ test-suite cardano-cli-test Test.Cli.Json Test.Cli.MonadWarning Test.Cli.Parser + Test.Cli.Ping Test.Cli.Pioneers.Exercise1 Test.Cli.Pioneers.Exercise2 Test.Cli.Pioneers.Exercise3 diff --git a/cardano-cli/src/Cardano/CLI/EraIndependent/Ping/Command.hs b/cardano-cli/src/Cardano/CLI/EraIndependent/Ping/Command.hs index db2eee6f39..747b8bfa13 100644 --- a/cardano-cli/src/Cardano/CLI/EraIndependent/Ping/Command.hs +++ b/cardano-cli/src/Cardano/CLI/EraIndependent/Ping/Command.hs @@ -1,12 +1,65 @@ +{-# LANGUAGE LambdaCase #-} +{-# LANGUAGE TypeApplications #-} + module Cardano.CLI.EraIndependent.Ping.Command - ( PingCmd (..) - , Address + ( EndPoint (..) + , PingCmd (..) + , endPointToAddress + , getConfigurationError ) where -import Cardano.Network.Ping +import Cardano.Network.Ping qualified as Ping + +import Data.IP (IP) +import Text.Read (readMaybe) + +-- | The endpoint to ping, as given on the command line. +data EndPoint + = HostEndPoint String + | UnixSockEndPoint String + deriving (Eq, Show) data PingCmd = PingCmd - { pingOpts :: PingOpts - , pingAddresses :: [Address (Unresolved SRVOrFilePathUnresolved)] + { pingOpts :: !Ping.PingOpts + , pingEndPoint :: !EndPoint + , pingPort :: !Word } + +-- | Same restriction as the pre-11.2 ping implementation: a unix socket +-- speaks node-to-client, over which the keep-alive protocol (the default +-- ping mode) does not run; 'Ping.pingClients' would silently do nothing. +getConfigurationError :: PingCmd -> Maybe String +getConfigurationError + PingCmd + { pingOpts = opts + , pingEndPoint = endPoint + } = + case endPoint of + UnixSockEndPoint{} + | Ping.pingOptsMode opts == Ping.PingMode -> + Just "Unix sockets only support queries for available versions or a tip." + _ -> Nothing + +-- | Convert the command line endpoint into a ping 'Ping.Address'. +-- +-- 'Ping.mkAddress' only distinguishes SRV records from domain names/file +-- paths, so IP literals are detected here and built with the 'Ping.IP' +-- constructor directly, which spares a futile DNS lookup at runtime. +endPointToAddress + :: Word + -- ^ port + -> EndPoint + -> Ping.Address (Ping.Unresolved Ping.SRVOrFilePathUnresolved) +endPointToAddress port = \case + HostEndPoint host + -- an IPv4/IPv6 literal, e.g. 127.0.0.1 or ::1 + | Just ip <- readMaybe @IP host -> Ping.IP ip port + -- a domain name: with the port attached, mkAddress classifies it as + -- a domain name (or file path) rather than an SRV record + | otherwise -> Ping.mkAddress (host <> ":" <> show port) + UnixSockEndPoint path + | '/' `elem` path -> Ping.mkAddress path + -- mkAddress would mistake a bare file name such as file.socket for + -- a domain name + | otherwise -> Ping.mkAddress ("./" <> path) diff --git a/cardano-cli/src/Cardano/CLI/EraIndependent/Ping/Option.hs b/cardano-cli/src/Cardano/CLI/EraIndependent/Ping/Option.hs index 021d821645..311880a970 100644 --- a/cardano-cli/src/Cardano/CLI/EraIndependent/Ping/Option.hs +++ b/cardano-cli/src/Cardano/CLI/EraIndependent/Ping/Option.hs @@ -2,16 +2,22 @@ module Cardano.CLI.EraIndependent.Ping.Option ( parsePingCmd + , pPing ) where import Cardano.CLI.Command (ClientCommand (CliPingCommand)) +import Cardano.CLI.EraBased.Common.Option (integralReader) import Cardano.CLI.EraIndependent.Ping.Command import Cardano.Network.Ping qualified as Ping import Control.Applicative +import Data.IP (IP) +import Data.Maybe (isJust) +import Data.Word (Word32) import Options.Applicative qualified as Opt import Prettyprinter qualified as PP +import Text.Read (readMaybe) parsePingCmd :: Opt.Mod Opt.CommandFields ClientCommand parsePingCmd = @@ -24,5 +30,141 @@ parsePingCmd = , PP.pretty @String "It negotiates a handshake and keeps sending keep alive messages." ] +pHost :: Opt.Parser String +pHost = + Opt.option readHost $ + mconcat + [ Opt.long "host" + , Opt.short 'h' + , Opt.metavar "HOST" + , Opt.help "Hostname/IP, e.g. relay.iohk.example." + ] + where + -- The port is given via --port. host:port forms never worked (they were + -- passed verbatim to getAddrInfo, which failed on them), so reject them + -- up front rather than let them fail confusingly at resolution time. + -- IPv6 literals such as ::1 legitimately contain colons. + readHost = + Opt.eitherReader $ \s -> + if ':' `notElem` s || isJust (readMaybe @IP s) + then Right s + else Left "HOST must not include a port, use --port instead" + +pUnixSocket :: Opt.Parser String +pUnixSocket = + Opt.strOption $ + mconcat + [ Opt.long "unixsock" + , Opt.short 'u' + , Opt.metavar "SOCKET" + , Opt.help "Unix socket, e.g. file.socket." + ] + +pEndPoint :: Opt.Parser EndPoint +pEndPoint = fmap HostEndPoint pHost <|> fmap UnixSockEndPoint pUnixSocket + pPing :: Opt.Parser PingCmd -pPing = uncurry PingCmd <$> Ping.cmdlineParser +pPing = + mkPingCmd + <$> ( Opt.option integralReader $ + mconcat + [ Opt.long "count" + , Opt.short 'c' + , Opt.metavar "COUNT" + , Opt.help $ + mconcat + [ "Stop after sending count requests and receiving count responses. " + , "If this option is not specified, ping will operate until interrupted. " + ] + , Opt.value maxBound + ] + ) + <*> pEndPoint + <*> ( Opt.option integralReader $ + mconcat + [ Opt.long "port" + , Opt.short 'p' + , Opt.metavar "PORT" + , Opt.help "Port number, e.g. 1234." + , Opt.value 3001 + ] + ) + <*> ( Opt.option (Ping.NetworkMagic <$> integralReader) $ + mconcat + [ Opt.long "magic" + , Opt.short 'm' + , Opt.metavar "MAGIC" + , Opt.help "Network magic." + , Opt.value Ping.mainnetMagic + ] + ) + <*> ( Opt.flag Ping.AsText Ping.AsJSON $ + mconcat + [ Opt.long "json" + , Opt.short 'j' + , Opt.help "JSON output flag." + ] + ) + <*> ( Opt.switch $ + mconcat + [ Opt.long "quiet" + , Opt.short 'q' + , Opt.help "Quiet flag, CSV/JSON only output" + ] + ) + <*> ( Opt.switch $ + mconcat + [ Opt.long "query-versions" + , Opt.short 'Q' + , Opt.help + "Query the supported protocol versions using the handshake protocol and terminate the connection." + ] + ) + <*> ( Opt.switch $ + mconcat + [ Opt.long "tip" + , Opt.short 't' + , Opt.help "Request tip then exit." + ] + ) + +mkPingCmd + :: Word32 + -- ^ count + -> EndPoint + -> Word + -- ^ port + -> Ping.NetworkMagic + -> Ping.LogFormat + -> Bool + -- ^ quiet + -> Bool + -- ^ query handshake versions + -> Bool + -- ^ request tip + -> PingCmd +mkPingCmd count endPoint port magic json quiet query tip = + PingCmd + { pingOpts = + Ping.PingOpts + { Ping.pingOptsCount = count + , Ping.pingOptsMagic = magic + , Ping.pingOptsJson = json + , Ping.pingOptsQuiet = quiet + , Ping.pingOptsMode = mode + , -- The remaining ping library options are not exposed on the + -- command line, which is kept identical to the pre-11.2 one. + Ping.pingOptsSRVPrefix = "_cardano._tcp" + , Ping.pingOptsColor = Ping.ColorNever + , Ping.pingOptsHashType = Ping.FullHash + } + , pingEndPoint = endPoint + , pingPort = port + } + where + -- --query-versions takes precedence over --tip, matching the behaviour of + -- the old cardano-ping implementation + mode + | query = Ping.QueryMode + | tip = Ping.TipMode + | otherwise = Ping.PingMode diff --git a/cardano-cli/src/Cardano/CLI/EraIndependent/Ping/Run.hs b/cardano-cli/src/Cardano/CLI/EraIndependent/Ping/Run.hs index a3220bfe58..9735aed8d9 100644 --- a/cardano-cli/src/Cardano/CLI/EraIndependent/Ping/Run.hs +++ b/cardano-cli/src/Cardano/CLI/EraIndependent/Ping/Run.hs @@ -2,16 +2,26 @@ {-# LANGUAGE RankNTypes #-} module Cardano.CLI.EraIndependent.Ping.Run - ( runPingCmd + ( PingClientCmdError (..) + , runPingCmd ) where import Cardano.Api -import Cardano.CLI.Compatible.Exception (CIO) +import Cardano.CLI.Compatible.Exception (CIO, throwCliError) import Cardano.CLI.EraIndependent.Ping.Command import Cardano.Network.Ping qualified as Ping +newtype PingClientCmdError = PingClientMisconfigurationError String + deriving Show + +instance Error PingClientCmdError where + prettyError (PingClientMisconfigurationError err) = pretty err + runPingCmd :: PingCmd -> CIO e () -runPingCmd PingCmd{pingOpts, pingAddresses} = - liftIO $ Ping.pingClients pingOpts pingAddresses +runPingCmd cmd@PingCmd{pingOpts, pingEndPoint, pingPort} = do + case getConfigurationError cmd of + Just err -> throwCliError $ PingClientMisconfigurationError err + Nothing -> pure () + liftIO $ Ping.pingClients pingOpts [endPointToAddress pingPort pingEndPoint] diff --git a/cardano-cli/test/cardano-cli-golden/files/golden/help.cli b/cardano-cli/test/cardano-cli-golden/files/golden/help.cli index 849c548490..e0cce6b05f 100644 --- a/cardano-cli/test/cardano-cli-golden/files/golden/help.cli +++ b/cardano-cli/test/cardano-cli-golden/files/golden/help.cli @@ -6145,14 +6145,13 @@ Usage: cardano-cli pretty-print-cbor --filepath FILEPATH Pretty print a CBOR file. Usage: cardano-cli ping [-c|--count COUNT] - [-m|--network-magic MAGIC] + ((-h|--host HOST) | (-u|--unixsock SOCKET)) + [-p|--port PORT] + [-m|--magic MAGIC] [-j|--json] [-q|--quiet] - [--mode MODE] - [--srv-prefix SRV_PREFIX] - [--color COLOR] - [--short-hash] - ADDRS + [-Q|--query-versions] + [-t|--tip] Ping a cardano node either using node-to-node or node-to-client protocol. It negotiates a handshake and keeps sending keep alive messages. diff --git a/cardano-cli/test/cardano-cli-golden/files/golden/help/ping.cli b/cardano-cli/test/cardano-cli-golden/files/golden/help/ping.cli index 9ba9133516..65d37ea50f 100644 --- a/cardano-cli/test/cardano-cli-golden/files/golden/help/ping.cli +++ b/cardano-cli/test/cardano-cli-golden/files/golden/help/ping.cli @@ -1,12 +1,11 @@ Usage: cardano-cli ping [-c|--count COUNT] - [-m|--network-magic MAGIC] + ((-h|--host HOST) | (-u|--unixsock SOCKET)) + [-p|--port PORT] + [-m|--magic MAGIC] [-j|--json] [-q|--quiet] - [--mode MODE] - [--srv-prefix SRV_PREFIX] - [--color COLOR] - [--short-hash] - ADDRS + [-Q|--query-versions] + [-t|--tip] Ping a cardano node either using node-to-node or node-to-client protocol. It negotiates a handshake and keeps sending keep alive messages. @@ -14,20 +13,14 @@ Usage: cardano-cli ping [-c|--count COUNT] Available options: -c,--count COUNT Stop after sending count requests and receiving count responses. If this option is not specified, ping will - operate until interrupted. (default: 4294967295) - -m,--network-magic MAGIC Network magic. (default: 764824073) + operate until interrupted. + -h,--host HOST Hostname/IP, e.g. relay.iohk.example. + -u,--unixsock SOCKET Unix socket, e.g. file.socket. + -p,--port PORT Port number, e.g. 1234. + -m,--magic MAGIC Network magic. -j,--json JSON output flag. - -q,--quiet Quiet flag, CSV/JSON only output. - --mode MODE Mode, either ping, tip or query: - ping - send pings via keep-alive protocol (node-to-node only), - tip - query tip via chain-sync protocol (node-to-node / node-to-client), - query - query handshake parameters (node-to-node / node-to-client). - --srv-prefix SRV_PREFIX Prefix that will be added to an SRV service name - (default: "_cardano._tcp") - --color COLOR Colorized output: auto, never or always. - (default: auto) - --short-hash show short tip's hash - ADDRS List of IP/DNS/SRV address and ports or UNIX socket - paths, e.g. 127.0.0.1:3001 [::1]:3001 - example.org:3001. + -q,--quiet Quiet flag, CSV/JSON only output + -Q,--query-versions Query the supported protocol versions using the + handshake protocol and terminate the connection. + -t,--tip Request tip then exit. -h,--help Show this help text diff --git a/cardano-cli/test/cardano-cli-test/Test/Cli/Ping.hs b/cardano-cli/test/cardano-cli-test/Test/Cli/Ping.hs new file mode 100644 index 0000000000..c1ee656a86 --- /dev/null +++ b/cardano-cli/test/cardano-cli-test/Test/Cli/Ping.hs @@ -0,0 +1,108 @@ +module Test.Cli.Ping + ( hprop_ping_parser_addresses + , hprop_ping_parser_options + , hprop_ping_parser_failures + , hprop_ping_configuration_error + ) +where + +import Cardano.CLI.EraIndependent.Ping.Command + ( PingCmd (..) + , endPointToAddress + , getConfigurationError + ) +import Cardano.CLI.EraIndependent.Ping.Option (pPing) +import Cardano.Network.Ping qualified as Ping + +import Data.Maybe (isJust, isNothing) +import Options.Applicative qualified as Opt + +import Test.Cardano.CLI.Util (watchdogProp) + +import Hedgehog (Property, assert, (===)) +import Hedgehog.Extras (propertyOnce) + +parsePingCmd :: [String] -> Maybe PingCmd +parsePingCmd = + Opt.getParseResult + . Opt.execParserPure Opt.defaultPrefs (Opt.info pPing mempty) + +-- | The `Address` GADT only has a `Show` instance for comparison purposes. +parseAddress :: [String] -> Maybe String +parseAddress args = do + cmd <- parsePingCmd args + pure . show $ endPointToAddress (pingPort cmd) (pingEndPoint cmd) + +-- | Execute me with: +-- @cabal test cardano-cli-test --test-options '-p "/ping parser addresses/"'@ +hprop_ping_parser_addresses :: Property +hprop_ping_parser_addresses = watchdogProp . propertyOnce $ do + -- domain names resolve via A/AAAA lookups with the default or given port + parseAddress ["--host", "relay.iohk.example"] + === Just "FilePathOrDomain \"relay.iohk.example:3001\"" + parseAddress ["-h", "relay.iohk.example", "--port", "4001"] + === Just "FilePathOrDomain \"relay.iohk.example:4001\"" + -- IP literals must parse to `IP` addresses, not domain names + parseAddress ["--host", "127.0.0.1"] + === Just "IP 127.0.0.1 3001" + parseAddress ["--host", "127.0.0.1", "-p", "6001"] + === Just "IP 127.0.0.1 6001" + parseAddress ["--host", "::1", "-p", "3002"] + === Just "IP ::1 3002" + -- unix sockets must not be mistaken for domain names + parseAddress ["--unixsock", "file.socket"] + === Just "FilePathOrDomain \"./file.socket\"" + parseAddress ["-u", "/tmp/node.socket"] + === Just "FilePathOrDomain \"/tmp/node.socket\"" + +-- | Execute me with: +-- @cabal test cardano-cli-test --test-options '-p "/ping parser options/"'@ +hprop_ping_parser_options :: Property +hprop_ping_parser_options = watchdogProp . propertyOnce $ do + -- defaults + (Ping.pingOptsCount <$> defOpts) === Just maxBound + (Ping.unNetworkMagic . Ping.pingOptsMagic <$> defOpts) === Just 764824073 + (Ping.pingOptsJson <$> defOpts) === Just Ping.AsText + (Ping.pingOptsQuiet <$> defOpts) === Just False + (Ping.pingOptsMode <$> defOpts) === Just Ping.PingMode + -- ping library options that are not exposed on the command line + (Ping.pingOptsSRVPrefix <$> defOpts) === Just "_cardano._tcp" + (Ping.pingOptsColor <$> defOpts) === Just Ping.ColorNever + -- --tip and --query-versions map onto the ping mode + (Ping.pingOptsMode <$> parseOpts ["--tip"]) === Just Ping.TipMode + (Ping.pingOptsMode <$> parseOpts ["-Q"]) === Just Ping.QueryMode + (Ping.pingOptsMode <$> parseOpts ["-Q", "-t"]) === Just Ping.QueryMode + -- remaining flags + (Ping.pingOptsCount <$> parseOpts ["--count", "7"]) === Just 7 + (Ping.unNetworkMagic . Ping.pingOptsMagic <$> parseOpts ["--magic", "2"]) === Just 2 + (Ping.pingOptsJson <$> parseOpts ["--json"]) === Just Ping.AsJSON + (Ping.pingOptsQuiet <$> parseOpts ["--quiet"]) === Just True + where + parseOpts args = pingOpts <$> parsePingCmd (args <> ["--host", "relay.iohk.example"]) + defOpts = parseOpts [] + +-- | Execute me with: +-- @cabal test cardano-cli-test --test-options '-p "/ping parser failures/"'@ +hprop_ping_parser_failures :: Property +hprop_ping_parser_failures = watchdogProp . propertyOnce $ do + -- exactly one endpoint is required + assert $ isNothing (parsePingCmd []) + assert $ isNothing (parsePingCmd ["--count", "7"]) + assert $ isNothing (parsePingCmd ["--host", "relay.iohk.example", "--unixsock", "/tmp/node.socket"]) + -- the port is given via --port, not inside the host + assert $ isNothing (parsePingCmd ["--host", "relay.iohk.example:3001"]) + assert $ isNothing (parsePingCmd ["--host", "[::1]:3001"]) + +-- | Execute me with: +-- @cabal test cardano-cli-test --test-options '-p "/ping configuration error/"'@ +hprop_ping_configuration_error :: Property +hprop_ping_configuration_error = watchdogProp . propertyOnce $ do + -- the keep-alive protocol (default mode) does not run over unix sockets + assert $ isJust (configurationError ["--unixsock", "/tmp/node.socket"]) + -- unix sockets support tip and version queries + assert $ isNothing (configurationError ["--unixsock", "/tmp/node.socket", "--tip"]) + assert $ isNothing (configurationError ["--unixsock", "/tmp/node.socket", "-Q"]) + -- hosts support all modes + assert $ isNothing (configurationError ["--host", "relay.iohk.example"]) + where + configurationError args = parsePingCmd args >>= getConfigurationError