From 9eebd5a790572f47cb491265999827aac29266ea Mon Sep 17 00:00:00 2001 From: Jordan Millar Date: Wed, 12 Aug 2026 10:09:02 -0400 Subject: [PATCH 1/3] Replace cardano-diffusion's ping parser with a local flag-based parser The released cardano-cli cannot be built with default cabal flags: Ping.cmdlineParser returns a Parser from plain optparse-applicative unless cardano-diffusion's manual optparse-applicative-fork flag is set, and the cabal.project stanza setting that flag does not ship with the sdist. Parse the ping options locally with optparse-applicative-fork so that no optparse type crosses the package boundary, and drop the flag stanza from cabal.project. This restores the old flag-based ping interface (--host, --unixsock, --port, --magic, --json, --quiet, --query-versions, --tip), allows repeating the endpoint flags to ping multiple endpoints, and exposes the new ping library features via --srv, --srv-prefix, --color and --short-hash. --- cabal.project | 3 - cardano-cli/cardano-cli.cabal | 3 + .../Cardano/CLI/EraIndependent/Ping/Option.hs | 254 +++++++++++++++++- .../cardano-cli-golden/files/golden/help.cli | 11 +- .../files/golden/help/ping.cli | 43 +-- .../test/cardano-cli-test/Test/Cli/Ping.hs | 110 ++++++++ 6 files changed, 402 insertions(+), 22 deletions(-) create mode 100644 cardano-cli/test/cardano-cli-test/Test/Cli/Ping.hs 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/Option.hs b/cardano-cli/src/Cardano/CLI/EraIndependent/Ping/Option.hs index 021d821645..46af74eb26 100644 --- a/cardano-cli/src/Cardano/CLI/EraIndependent/Ping/Option.hs +++ b/cardano-cli/src/Cardano/CLI/EraIndependent/Ping/Option.hs @@ -1,17 +1,27 @@ +{-# LANGUAGE LambdaCase #-} {-# LANGUAGE TypeApplications #-} module Cardano.CLI.EraIndependent.Ping.Option ( parsePingCmd + , pPing + + -- * Exported for testing + , PingEndPoint (..) + , endPointToAddress ) 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.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 +34,247 @@ parsePingCmd = , PP.pretty @String "It negotiates a handshake and keeps sending keep alive messages." ] +-- | An endpoint to ping, as given on the command line. +data PingEndPoint + = HostEndPoint String + | UnixSockEndPoint FilePath + | SrvEndPoint String + deriving (Eq, Show) + +pHost :: Opt.Parser PingEndPoint +pHost = + fmap HostEndPoint $ + Opt.strOption $ + mconcat + [ Opt.long "host" + , Opt.short 'h' + , Opt.metavar "HOST" + , Opt.help $ + mconcat + [ "Hostname/IP with an optional port, e.g. relay.iohk.example, " + , "relay.iohk.example:3001, 127.0.0.1:3001 or [::1]:3001. " + , "Hosts given without a port use the --port option. " + , "May be repeated to ping multiple hosts." + ] + ] + +pUnixSocket :: Opt.Parser PingEndPoint +pUnixSocket = + fmap UnixSockEndPoint $ + Opt.strOption $ + mconcat + [ Opt.long "unixsock" + , Opt.short 'u' + , Opt.metavar "SOCKET" + , Opt.help "Unix socket, e.g. file.socket. May be repeated to ping multiple sockets." + ] + +pSrv :: Opt.Parser PingEndPoint +pSrv = + fmap SrvEndPoint $ + Opt.option readSrvDomain $ + mconcat + [ Opt.long "srv" + , Opt.metavar "DOMAIN" + , Opt.help $ + mconcat + [ "SRV record domain name, e.g. relay.iohk.example. " + , "The service prefix given by --srv-prefix is prepended to it. " + , "May be repeated to ping multiple SRV records." + ] + ] + where + readSrvDomain = + Opt.eitherReader $ \s -> + if ':' `notElem` s && '/' `notElem` s && '.' `elem` s + then Right s + else Left "SRV domain must contain a '.' and must not contain ':' or '/'" + +pEndPoint :: Opt.Parser PingEndPoint +pEndPoint = pHost <|> pUnixSocket <|> pSrv + 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 + ] + ) + <*> some pEndPoint + <*> ( Opt.option integralReader $ + mconcat + [ Opt.long "port" + , Opt.short 'p' + , Opt.metavar "PORT" + , Opt.help "Port number, e.g. 1234. Used for hosts given without a port." + , 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." + ] + ) + <*> ( Opt.strOption $ + mconcat + [ Opt.long "srv-prefix" + , Opt.metavar "SRV_PREFIX" + , Opt.help "Prefix that will be added to an SRV service name." + , Opt.value "_cardano._tcp" + , Opt.showDefault + ] + ) + <*> ( Opt.option readColorMode $ + mconcat + [ Opt.long "color" + , Opt.metavar "COLOR" + , Opt.help "Colorized output: auto, never or always." + , Opt.value Ping.ColorAuto + , Opt.showDefaultWith + ( \case + Ping.ColorAuto -> "auto" + Ping.ColorNever -> "never" + Ping.ColorAlways -> "always" + ) + ] + ) + <*> ( Opt.flag Ping.FullHash Ping.ShortHash $ + mconcat + [ Opt.long "short-hash" + , Opt.help "Show short tip's hash." + ] + ) + where + readColorMode = + Opt.eitherReader $ \case + "auto" -> Right Ping.ColorAuto + "never" -> Right Ping.ColorNever + "always" -> Right Ping.ColorAlways + _ -> Left "expected auto, never or always" + +mkPingCmd + :: Word32 + -- ^ count + -> [PingEndPoint] + -> Word + -- ^ default port + -> Ping.NetworkMagic + -> Ping.LogFormat + -> Bool + -- ^ quiet + -> Bool + -- ^ query handshake versions + -> Bool + -- ^ request tip + -> String + -- ^ SRV service name prefix + -> Ping.ColorMode + -> Ping.HashType + -> PingCmd +mkPingCmd count endPoints port magic json quiet query tip srvPrefix color hashType = + PingCmd + { pingOpts = + Ping.PingOpts + { Ping.pingOptsCount = count + , Ping.pingOptsMagic = magic + , Ping.pingOptsJson = json + , Ping.pingOptsQuiet = quiet + , Ping.pingOptsMode = mode + , Ping.pingOptsSRVPrefix = srvPrefix + , Ping.pingOptsColor = color + , Ping.pingOptsHashType = hashType + } + , pingAddresses = map (endPointToAddress port) endPoints + } + 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 + +-- | Convert a 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 + -- ^ default port, for hosts given without one + -> PingEndPoint + -> Ping.Address (Ping.Unresolved Ping.SRVOrFilePathUnresolved) +endPointToAddress defaultPort = \case + -- pSrv guarantees the domain contains a '.' and no ':' or '/', so + -- mkAddress always yields an SRV address here + SrvEndPoint domain -> Ping.mkAddress domain + UnixSockEndPoint path + | '/' `elem` path -> Ping.mkAddress path + -- mkAddress would mistake a bare file name such as file.socket for an + -- SRV record + | otherwise -> Ping.mkAddress ("./" <> path) + HostEndPoint host + -- bare IPv4/IPv6 literal, e.g. 127.0.0.1 or ::1 + | Just ip <- readMaybe @IP host -> Ping.IP ip defaultPort + -- IPv4 literal with a port, e.g. 127.0.0.1:3001 + | Just (ipStr, portStr) <- splitOnFirst ':' host + , Just ip <- readMaybe @IP ipStr + , Just port <- readMaybe portStr -> + Ping.IP ip port + -- IPv6 literal with a port, e.g. [::1]:3001 + | '[' : rest <- host + , Just (ipStr, ':' : portStr) <- splitOnFirst ']' rest + , Just ip <- readMaybe @IP ipStr + , Just port <- readMaybe portStr -> + Ping.IP ip port + -- domain name with a port, e.g. relay.iohk.example:3001 + | ':' `elem` host -> Ping.mkAddress host + -- domain name without a port: attach the default port + | otherwise -> Ping.mkAddress (host <> ":" <> show defaultPort) + where + splitOnFirst c s = + case break (== c) s of + (before, _ : after) -> Just (before, after) + _ -> Nothing 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..46831a8804 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,19 @@ 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) + | --srv DOMAIN + ) + [-p|--port PORT] + [-m|--magic MAGIC] [-j|--json] [-q|--quiet] - [--mode MODE] + [-Q|--query-versions] + [-t|--tip] [--srv-prefix SRV_PREFIX] [--color COLOR] [--short-hash] - ADDRS 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..2025177214 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,17 @@ Usage: cardano-cli ping [-c|--count COUNT] - [-m|--network-magic MAGIC] + ( (-h|--host HOST) + | (-u|--unixsock SOCKET) + | --srv DOMAIN + ) + [-p|--port PORT] + [-m|--magic MAGIC] [-j|--json] [-q|--quiet] - [--mode MODE] + [-Q|--query-versions] + [-t|--tip] [--srv-prefix SRV_PREFIX] [--color COLOR] [--short-hash] - ADDRS 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 +19,28 @@ 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 with an optional port, e.g. + relay.iohk.example, relay.iohk.example:3001, + 127.0.0.1:3001 or [::1]:3001. Hosts given without a + port use the --port option. May be repeated to ping + multiple hosts. + -u,--unixsock SOCKET Unix socket, e.g. file.socket. May be repeated to + ping multiple sockets. + --srv DOMAIN SRV record domain name, e.g. relay.iohk.example. The + service prefix given by --srv-prefix is prepended to + it. May be repeated to ping multiple SRV records. + -p,--port PORT Port number, e.g. 1234. Used for hosts given without + a port. + -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 + -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. + --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. + --short-hash Show short tip's hash. -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..43fa10b252 --- /dev/null +++ b/cardano-cli/test/cardano-cli-test/Test/Cli/Ping.hs @@ -0,0 +1,110 @@ +module Test.Cli.Ping + ( hprop_ping_parser_addresses + , hprop_ping_parser_options + , hprop_ping_parser_failures + ) +where + +import Cardano.CLI.EraIndependent.Ping.Command (PingCmd (..)) +import Cardano.CLI.EraIndependent.Ping.Option (pPing) +import Cardano.Network.Ping qualified as Ping + +import Data.Maybe (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. +parseAddresses :: [String] -> Maybe [String] +parseAddresses args = map show . pingAddresses <$> parsePingCmd args + +-- | 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 + parseAddresses ["--host", "relay.iohk.example"] + === Just ["FilePathOrDomain \"relay.iohk.example:3001\""] + parseAddresses ["-h", "relay.iohk.example", "--port", "4001"] + === Just ["FilePathOrDomain \"relay.iohk.example:4001\""] + parseAddresses ["--host", "relay.iohk.example:5001", "--port", "4001"] + === Just ["FilePathOrDomain \"relay.iohk.example:5001\""] + -- IP literals must parse to `IP` addresses, not domain names + parseAddresses ["--host", "127.0.0.1"] + === Just ["IP 127.0.0.1 3001"] + parseAddresses ["--host", "127.0.0.1:6001"] + === Just ["IP 127.0.0.1 6001"] + parseAddresses ["--host", "::1", "-p", "3002"] + === Just ["IP ::1 3002"] + parseAddresses ["--host", "[::1]:6001"] + === Just ["IP ::1 6001"] + -- unix sockets must not be mistaken for domain names + parseAddresses ["--unixsock", "file.socket"] + === Just ["FilePathOrDomain \"./file.socket\""] + parseAddresses ["-u", "/tmp/node.socket"] + === Just ["FilePathOrDomain \"/tmp/node.socket\""] + -- SRV records are explicit + parseAddresses ["--srv", "relay.iohk.example"] + === Just ["SRV \"relay.iohk.example\""] + -- endpoints may be repeated and mixed, order is preserved + parseAddresses + [ "-h" + , "relay.iohk.example" + , "-u" + , "/tmp/node.socket" + , "--srv" + , "srv.iohk.example" + , "-h" + , "10.0.0.1:7001" + ] + === Just + [ "FilePathOrDomain \"relay.iohk.example:3001\"" + , "FilePathOrDomain \"/tmp/node.socket\"" + , "SRV \"srv.iohk.example\"" + , "IP 10.0.0.1 7001" + ] + +-- | 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.pingOptsSRVPrefix <$> defOpts) === Just "_cardano._tcp" + (Ping.pingOptsColor <$> defOpts) === Just Ping.ColorAuto + -- --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 old-style 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 + -- at least one endpoint is required + assert $ isNothing (parsePingCmd []) + assert $ isNothing (parsePingCmd ["--count", "7"]) + -- SRV records take neither ports nor paths + assert $ isNothing (parsePingCmd ["--srv", "relay.iohk.example:3001"]) + assert $ isNothing (parsePingCmd ["--srv", "/tmp/node.socket"]) + assert $ isNothing (parsePingCmd ["--srv", "localhost"]) From 5048da98beae34007c0747c8571044e74eed8c42 Mon Sep 17 00:00:00 2001 From: Jordan Millar Date: Wed, 12 Aug 2026 10:12:55 -0400 Subject: [PATCH 2/3] Add changelog fragment --- ...01216_cardano-cli_jordan.millar_fix_ping_parser.yml | 10 ++++++++++ 1 file changed, 10 insertions(+) create mode 100644 .changes/20260812_101216_cardano-cli_jordan.millar_fix_ping_parser.yml 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..85ea6c6db7 --- /dev/null +++ b/.changes/20260812_101216_cardano-cli_jordan.millar_fix_ping_parser.yml @@ -0,0 +1,10 @@ +project: cardano-cli + +pr: 1413 + +kind: + - bugfix + - feature + +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 flag-based interface removed in #1384 is restored — `--host`, `--unixsock`, `--port`, `--magic`, `--json`, `--quiet`, `--query-versions` and `--tip`, with `-h` again meaning `--host` — replacing the positional `ADDRS` argument and `--mode` of the never-published 11.2.0.0 interface. The new ping capabilities are exposed on top: `--host`/`--unixsock` may be repeated to ping multiple endpoints, hosts accept an optional inline port (e.g. `relay.iohk.example:3001`, `[::1]:3001`), and `--srv DOMAIN` (SRV record lookup), `--srv-prefix`, `--color` and `--short-hash` were added. From 0d8dfa33182309c76d2e5ef9670c5e9ec4805f21 Mon Sep 17 00:00:00 2001 From: Jordan Millar Date: Wed, 12 Aug 2026 14:30:11 -0400 Subject: [PATCH 3/3] Trim ping back to strict pre-11.2 interface parity Per review: drop --srv, --srv-prefix, --color and --short-hash, and the repeatable/inline-port endpoint extensions. The interface is now exactly the pre-11.2 one; the generated help output is byte-identical to 11.1.0.0's apart from a trailing-whitespace line from the newer optparse renderer. The unexposed ping library options are pinned to their old-behaviour values (ColorNever, FullHash). Also restore the pre-11.2 misconfiguration guard: --unixsock without --tip/--query-versions fails again with "Unix sockets only support queries for available versions or a tip." instead of the ping library's silent no-op, and --host values containing a port are rejected at parse time with a pointer to --port. --- ...dano-cli_jordan.millar_fix_ping_parser.yml | 3 +- .../CLI/EraIndependent/Ping/Command.hs | 63 +++++- .../Cardano/CLI/EraIndependent/Ping/Option.hs | 190 ++++-------------- .../Cardano/CLI/EraIndependent/Ping/Run.hs | 18 +- .../cardano-cli-golden/files/golden/help.cli | 8 +- .../files/golden/help/ping.cli | 28 +-- .../test/cardano-cli-test/Test/Cli/Ping.hs | 96 +++++---- 7 files changed, 165 insertions(+), 241 deletions(-) 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 index 85ea6c6db7..d08c83909c 100644 --- a/.changes/20260812_101216_cardano-cli_jordan.millar_fix_ping_parser.yml +++ b/.changes/20260812_101216_cardano-cli_jordan.millar_fix_ping_parser.yml @@ -4,7 +4,6 @@ pr: 1413 kind: - bugfix - - feature 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 flag-based interface removed in #1384 is restored — `--host`, `--unixsock`, `--port`, `--magic`, `--json`, `--quiet`, `--query-versions` and `--tip`, with `-h` again meaning `--host` — replacing the positional `ADDRS` argument and `--mode` of the never-published 11.2.0.0 interface. The new ping capabilities are exposed on top: `--host`/`--unixsock` may be repeated to ping multiple endpoints, hosts accept an optional inline port (e.g. `relay.iohk.example:3001`, `[::1]:3001`), and `--srv DOMAIN` (SRV record lookup), `--srv-prefix`, `--color` and `--short-hash` were added. + 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/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 46af74eb26..311880a970 100644 --- a/cardano-cli/src/Cardano/CLI/EraIndependent/Ping/Option.hs +++ b/cardano-cli/src/Cardano/CLI/EraIndependent/Ping/Option.hs @@ -1,13 +1,8 @@ -{-# LANGUAGE LambdaCase #-} {-# LANGUAGE TypeApplications #-} module Cardano.CLI.EraIndependent.Ping.Option ( parsePingCmd , pPing - - -- * Exported for testing - , PingEndPoint (..) - , endPointToAddress ) where @@ -18,6 +13,7 @@ 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 @@ -34,64 +30,38 @@ parsePingCmd = , PP.pretty @String "It negotiates a handshake and keeps sending keep alive messages." ] --- | An endpoint to ping, as given on the command line. -data PingEndPoint - = HostEndPoint String - | UnixSockEndPoint FilePath - | SrvEndPoint String - deriving (Eq, Show) - -pHost :: Opt.Parser PingEndPoint +pHost :: Opt.Parser String pHost = - fmap HostEndPoint $ - Opt.strOption $ - mconcat - [ Opt.long "host" - , Opt.short 'h' - , Opt.metavar "HOST" - , Opt.help $ - mconcat - [ "Hostname/IP with an optional port, e.g. relay.iohk.example, " - , "relay.iohk.example:3001, 127.0.0.1:3001 or [::1]:3001. " - , "Hosts given without a port use the --port option. " - , "May be repeated to ping multiple hosts." - ] - ] - -pUnixSocket :: Opt.Parser PingEndPoint -pUnixSocket = - fmap UnixSockEndPoint $ - Opt.strOption $ - mconcat - [ Opt.long "unixsock" - , Opt.short 'u' - , Opt.metavar "SOCKET" - , Opt.help "Unix socket, e.g. file.socket. May be repeated to ping multiple sockets." - ] - -pSrv :: Opt.Parser PingEndPoint -pSrv = - fmap SrvEndPoint $ - Opt.option readSrvDomain $ - mconcat - [ Opt.long "srv" - , Opt.metavar "DOMAIN" - , Opt.help $ - mconcat - [ "SRV record domain name, e.g. relay.iohk.example. " - , "The service prefix given by --srv-prefix is prepended to it. " - , "May be repeated to ping multiple SRV records." - ] - ] + Opt.option readHost $ + mconcat + [ Opt.long "host" + , Opt.short 'h' + , Opt.metavar "HOST" + , Opt.help "Hostname/IP, e.g. relay.iohk.example." + ] where - readSrvDomain = + -- 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 && '/' `notElem` s && '.' `elem` s + if ':' `notElem` s || isJust (readMaybe @IP s) then Right s - else Left "SRV domain must contain a '.' and must not contain ':' or '/'" + else Left "HOST must not include a port, use --port instead" -pEndPoint :: Opt.Parser PingEndPoint -pEndPoint = pHost <|> pUnixSocket <|> pSrv +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 = @@ -109,13 +79,13 @@ pPing = , Opt.value maxBound ] ) - <*> some pEndPoint + <*> pEndPoint <*> ( Opt.option integralReader $ mconcat [ Opt.long "port" , Opt.short 'p' , Opt.metavar "PORT" - , Opt.help "Port number, e.g. 1234. Used for hosts given without a port." + , Opt.help "Port number, e.g. 1234." , Opt.value 3001 ] ) @@ -157,49 +127,13 @@ pPing = , Opt.help "Request tip then exit." ] ) - <*> ( Opt.strOption $ - mconcat - [ Opt.long "srv-prefix" - , Opt.metavar "SRV_PREFIX" - , Opt.help "Prefix that will be added to an SRV service name." - , Opt.value "_cardano._tcp" - , Opt.showDefault - ] - ) - <*> ( Opt.option readColorMode $ - mconcat - [ Opt.long "color" - , Opt.metavar "COLOR" - , Opt.help "Colorized output: auto, never or always." - , Opt.value Ping.ColorAuto - , Opt.showDefaultWith - ( \case - Ping.ColorAuto -> "auto" - Ping.ColorNever -> "never" - Ping.ColorAlways -> "always" - ) - ] - ) - <*> ( Opt.flag Ping.FullHash Ping.ShortHash $ - mconcat - [ Opt.long "short-hash" - , Opt.help "Show short tip's hash." - ] - ) - where - readColorMode = - Opt.eitherReader $ \case - "auto" -> Right Ping.ColorAuto - "never" -> Right Ping.ColorNever - "always" -> Right Ping.ColorAlways - _ -> Left "expected auto, never or always" mkPingCmd :: Word32 -- ^ count - -> [PingEndPoint] + -> EndPoint -> Word - -- ^ default port + -- ^ port -> Ping.NetworkMagic -> Ping.LogFormat -> Bool @@ -208,12 +142,8 @@ mkPingCmd -- ^ query handshake versions -> Bool -- ^ request tip - -> String - -- ^ SRV service name prefix - -> Ping.ColorMode - -> Ping.HashType -> PingCmd -mkPingCmd count endPoints port magic json quiet query tip srvPrefix color hashType = +mkPingCmd count endPoint port magic json quiet query tip = PingCmd { pingOpts = Ping.PingOpts @@ -222,11 +152,14 @@ mkPingCmd count endPoints port magic json quiet query tip srvPrefix color hashTy , Ping.pingOptsJson = json , Ping.pingOptsQuiet = quiet , Ping.pingOptsMode = mode - , Ping.pingOptsSRVPrefix = srvPrefix - , Ping.pingOptsColor = color - , Ping.pingOptsHashType = hashType + , -- 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 } - , pingAddresses = map (endPointToAddress port) endPoints + , pingEndPoint = endPoint + , pingPort = port } where -- --query-versions takes precedence over --tip, matching the behaviour of @@ -235,46 +168,3 @@ mkPingCmd count endPoints port magic json quiet query tip srvPrefix color hashTy | query = Ping.QueryMode | tip = Ping.TipMode | otherwise = Ping.PingMode - --- | Convert a 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 - -- ^ default port, for hosts given without one - -> PingEndPoint - -> Ping.Address (Ping.Unresolved Ping.SRVOrFilePathUnresolved) -endPointToAddress defaultPort = \case - -- pSrv guarantees the domain contains a '.' and no ':' or '/', so - -- mkAddress always yields an SRV address here - SrvEndPoint domain -> Ping.mkAddress domain - UnixSockEndPoint path - | '/' `elem` path -> Ping.mkAddress path - -- mkAddress would mistake a bare file name such as file.socket for an - -- SRV record - | otherwise -> Ping.mkAddress ("./" <> path) - HostEndPoint host - -- bare IPv4/IPv6 literal, e.g. 127.0.0.1 or ::1 - | Just ip <- readMaybe @IP host -> Ping.IP ip defaultPort - -- IPv4 literal with a port, e.g. 127.0.0.1:3001 - | Just (ipStr, portStr) <- splitOnFirst ':' host - , Just ip <- readMaybe @IP ipStr - , Just port <- readMaybe portStr -> - Ping.IP ip port - -- IPv6 literal with a port, e.g. [::1]:3001 - | '[' : rest <- host - , Just (ipStr, ':' : portStr) <- splitOnFirst ']' rest - , Just ip <- readMaybe @IP ipStr - , Just port <- readMaybe portStr -> - Ping.IP ip port - -- domain name with a port, e.g. relay.iohk.example:3001 - | ':' `elem` host -> Ping.mkAddress host - -- domain name without a port: attach the default port - | otherwise -> Ping.mkAddress (host <> ":" <> show defaultPort) - where - splitOnFirst c s = - case break (== c) s of - (before, _ : after) -> Just (before, after) - _ -> Nothing 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 46831a8804..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,19 +6145,13 @@ Usage: cardano-cli pretty-print-cbor --filepath FILEPATH Pretty print a CBOR file. Usage: cardano-cli ping [-c|--count COUNT] - ( (-h|--host HOST) - | (-u|--unixsock SOCKET) - | --srv DOMAIN - ) + ((-h|--host HOST) | (-u|--unixsock SOCKET)) [-p|--port PORT] [-m|--magic MAGIC] [-j|--json] [-q|--quiet] [-Q|--query-versions] [-t|--tip] - [--srv-prefix SRV_PREFIX] - [--color COLOR] - [--short-hash] 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 2025177214..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,17 +1,11 @@ Usage: cardano-cli ping [-c|--count COUNT] - ( (-h|--host HOST) - | (-u|--unixsock SOCKET) - | --srv DOMAIN - ) + ((-h|--host HOST) | (-u|--unixsock SOCKET)) [-p|--port PORT] [-m|--magic MAGIC] [-j|--json] [-q|--quiet] [-Q|--query-versions] [-t|--tip] - [--srv-prefix SRV_PREFIX] - [--color COLOR] - [--short-hash] Ping a cardano node either using node-to-node or node-to-client protocol. It negotiates a handshake and keeps sending keep alive messages. @@ -20,27 +14,13 @@ 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. - -h,--host HOST Hostname/IP with an optional port, e.g. - relay.iohk.example, relay.iohk.example:3001, - 127.0.0.1:3001 or [::1]:3001. Hosts given without a - port use the --port option. May be repeated to ping - multiple hosts. - -u,--unixsock SOCKET Unix socket, e.g. file.socket. May be repeated to - ping multiple sockets. - --srv DOMAIN SRV record domain name, e.g. relay.iohk.example. The - service prefix given by --srv-prefix is prepended to - it. May be repeated to ping multiple SRV records. - -p,--port PORT Port number, e.g. 1234. Used for hosts given without - a port. + -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 -Q,--query-versions Query the supported protocol versions using the handshake protocol and terminate the connection. -t,--tip Request tip then exit. - --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. -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 index 43fa10b252..c1ee656a86 100644 --- a/cardano-cli/test/cardano-cli-test/Test/Cli/Ping.hs +++ b/cardano-cli/test/cardano-cli-test/Test/Cli/Ping.hs @@ -2,14 +2,19 @@ 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 (..)) +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 (isNothing) +import Data.Maybe (isJust, isNothing) import Options.Applicative qualified as Opt import Test.Cardano.CLI.Util (watchdogProp) @@ -23,54 +28,32 @@ parsePingCmd = . Opt.execParserPure Opt.defaultPrefs (Opt.info pPing mempty) -- | The `Address` GADT only has a `Show` instance for comparison purposes. -parseAddresses :: [String] -> Maybe [String] -parseAddresses args = map show . pingAddresses <$> parsePingCmd args +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 - parseAddresses ["--host", "relay.iohk.example"] - === Just ["FilePathOrDomain \"relay.iohk.example:3001\""] - parseAddresses ["-h", "relay.iohk.example", "--port", "4001"] - === Just ["FilePathOrDomain \"relay.iohk.example:4001\""] - parseAddresses ["--host", "relay.iohk.example:5001", "--port", "4001"] - === Just ["FilePathOrDomain \"relay.iohk.example:5001\""] + 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 - parseAddresses ["--host", "127.0.0.1"] - === Just ["IP 127.0.0.1 3001"] - parseAddresses ["--host", "127.0.0.1:6001"] - === Just ["IP 127.0.0.1 6001"] - parseAddresses ["--host", "::1", "-p", "3002"] - === Just ["IP ::1 3002"] - parseAddresses ["--host", "[::1]:6001"] - === Just ["IP ::1 6001"] + 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 - parseAddresses ["--unixsock", "file.socket"] - === Just ["FilePathOrDomain \"./file.socket\""] - parseAddresses ["-u", "/tmp/node.socket"] - === Just ["FilePathOrDomain \"/tmp/node.socket\""] - -- SRV records are explicit - parseAddresses ["--srv", "relay.iohk.example"] - === Just ["SRV \"relay.iohk.example\""] - -- endpoints may be repeated and mixed, order is preserved - parseAddresses - [ "-h" - , "relay.iohk.example" - , "-u" - , "/tmp/node.socket" - , "--srv" - , "srv.iohk.example" - , "-h" - , "10.0.0.1:7001" - ] - === Just - [ "FilePathOrDomain \"relay.iohk.example:3001\"" - , "FilePathOrDomain \"/tmp/node.socket\"" - , "SRV \"srv.iohk.example\"" - , "IP 10.0.0.1 7001" - ] + 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/"'@ @@ -82,13 +65,14 @@ hprop_ping_parser_options = watchdogProp . propertyOnce $ do (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.ColorAuto + (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 old-style flags + -- 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 @@ -101,10 +85,24 @@ hprop_ping_parser_options = watchdogProp . propertyOnce $ do -- @cabal test cardano-cli-test --test-options '-p "/ping parser failures/"'@ hprop_ping_parser_failures :: Property hprop_ping_parser_failures = watchdogProp . propertyOnce $ do - -- at least one endpoint is required + -- exactly one endpoint is required assert $ isNothing (parsePingCmd []) assert $ isNothing (parsePingCmd ["--count", "7"]) - -- SRV records take neither ports nor paths - assert $ isNothing (parsePingCmd ["--srv", "relay.iohk.example:3001"]) - assert $ isNothing (parsePingCmd ["--srv", "/tmp/node.socket"]) - assert $ isNothing (parsePingCmd ["--srv", "localhost"]) + 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