IntersectMBO · Jimbo4350 · Aug 13, 2026 · Aug 13, 2026
@@ -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 parser is replaced with a behaviourally identical local one; the command line interface is unchanged.
@@ -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
 

@@ -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

@@ -1,7 +1,9 @@
+{-# LANGUAGE LambdaCase #-}
 {-# LANGUAGE TypeApplications #-}
 
 module Cardano.CLI.EraIndependent.Ping.Option
   ( parsePingCmd
+  , pPing
   )
 where
 
@@ -10,8 +12,11 @@ import Cardano.CLI.EraIndependent.Ping.Command
 import Cardano.Network.Ping qualified as Ping
 
 import Control.Applicative
+import Data.IP (IP)
 import Options.Applicative qualified as Opt
+import Options.Applicative.Help.Pretty qualified as Pretty
 import Prettyprinter qualified as PP
+import Text.Read (readMaybe)
 
 parsePingCmd :: Opt.Mod Opt.CommandFields ClientCommand
 parsePingCmd =
@@ -24,5 +29,177 @@ parsePingCmd =
             , PP.pretty @String "It negotiates a handshake and keeps sending keep alive messages."
             ]
 
+-- | A local mirror of @Cardano.Network.Ping.cmdlineParser@ from
+-- @cardano-diffusion:ping@, which cardano-cli used directly before.  The
+-- library parser is built against vanilla @optparse-applicative@ by default,
+-- while cardano-cli uses @optparse-applicative-fork@; using it required
+-- building @cardano-diffusion@ with a non-default cabal flag set via
+-- @cabal.project@, which does not ship with the sdist.
+--
+-- This parser must behave exactly like @cmdlineParser@; it is a verbatim
+-- copy modulo qualification.  'Test.Cli.Ping' checks the equivalence of the
+-- two parsers, and the golden help tests pin the rendered help text.
 pPing :: Opt.Parser PingCmd
-pPing = uncurry PingCmd <$> Ping.cmdlineParser
+pPing = PingCmd <$> pPingOpts <*> pPingAddresses
+
+-- | A copy of @Cardano.Network.Ping.pingOptsParser@.
+pPingOpts :: Opt.Parser Ping.PingOpts
+pPingOpts =
+  Ping.PingOpts
+    <$> Opt.option
+      Opt.auto
+      ( Opt.long "count"
+          <> Opt.short 'c'
+          <> Opt.help
+            ( mconcat
+                [ "Stop after sending count requests and receiving count responses.  "
+                , "If this option is not specified, ping will operate until interrupted.  "
+                ]
+            )
+          <> Opt.metavar "COUNT"
+          <> Opt.value maxBound
+          <> Opt.showDefault
+      )
+    <*> Opt.option
+      (Ping.NetworkMagic <$> Opt.auto)
+      ( Opt.long "network-magic"
+          <> Opt.short 'm'
+          <> Opt.help "Network magic."
+          <> Opt.value Ping.mainnetMagic
+          <> Opt.metavar "MAGIC"
+          <> Opt.showDefaultWith (show . Ping.unNetworkMagic)
+      )
+    <*> Opt.flag
+      Ping.AsText
+      Ping.AsJSON
+      ( Opt.long "json"
+          <> Opt.short 'j'
+          <> Opt.help "JSON output flag."
+      )
+    <*> Opt.flag
+      False
+      True
+      ( Opt.long "quiet"
+          <> Opt.short 'q'
+          <> Opt.help "Quiet flag, CSV/JSON only output."
+      )
+    <*> Opt.option
+      pingMode
+      ( Opt.long "mode"
+          <> Opt.helpDoc
+            ( Just $
+                Pretty.hang 2 $
+                  "Mode, either ping, tip or query:"
+                    <> Pretty.softline
+                    <> "ping  - send pings via keep-alive protocol (node-to-node only),"
+                    <> Pretty.softline
+                    <> "tip   - query tip via chain-sync protocol (node-to-node / node-to-client),"
+                    <> Pretty.softline
+                    <> "query - query handshake parameters (node-to-node / node-to-client)."
+            )
+          <> Opt.value Ping.PingMode
+          <> Opt.metavar "MODE"
+      )
+    <*> Opt.option
+      Opt.str
+      ( Opt.long "srv-prefix"
+          <> Opt.help "Prefix that will be added to an SRV service name"
+          <> Opt.value "_cardano._tcp"
+          <> Opt.metavar "SRV_PREFIX"
+          <> Opt.showDefault
+      )
+    <*> Opt.option
+      colorMode
+      ( Opt.long "color"
+          <> Opt.help "Colorized output: auto, never or always."
+          <> Opt.value Ping.ColorAuto
+          <> Opt.metavar "COLOR"
+          <> Opt.showDefaultWith
+            ( \case
+                Ping.ColorAuto -> "auto"
+                Ping.ColorNever -> "never"
+                Ping.ColorAlways -> "always"
+            )
+      )
+    <*> Opt.flag
+      Ping.FullHash
+      Ping.ShortHash
+      ( Opt.long "short-hash"
+          <> Opt.help "show short tip's hash"
+      )
+ where
+  pingMode :: Opt.ReadM Ping.PingMode
+  pingMode =
+    Opt.eitherReader $ \case
+      "tip" -> Right Ping.TipMode
+      "ping" -> Right Ping.PingMode
+      "query" -> Right Ping.QueryMode
+      _ -> Left "unexpected string"
+
+  colorMode :: Opt.ReadM Ping.ColorMode
+  colorMode =
+    Opt.eitherReader $ \case
+      "auto" -> Right Ping.ColorAuto
+      "never" -> Right Ping.ColorNever
+      "always" -> Right Ping.ColorAlways
+      _ -> Left "expected auto, never or always"
+
+-- | A copy of @Cardano.Network.Ping.argParser@.
+pPingAddresses :: Opt.Parser [Ping.Address (Ping.Unresolved Ping.SRVOrFilePathUnresolved)]
+pPingAddresses =
+  some pAddress
+ where
+  pAddress :: Opt.Parser (Ping.Address (Ping.Unresolved Ping.SRVOrFilePathUnresolved))
+  pAddress =
+    Opt.argument
+      ( uncurry Ping.IP <$> readIPv4AndPort
+          <|> uncurry Ping.IP <$> readIPv6AndPort
+          <|> readDomainNameOrFilePath
+      )
+      ( Opt.help
+          "List of IP/DNS/SRV address and ports or UNIX socket paths, e.g. 127.0.0.1:3001 [::1]:3001 example.org:3001."
+          <> Opt.metavar "ADDRS"
+      )
+
+  -- note: `Read` instances for `IP`, `IPv4`, `IPv6` expect no trailing
+  -- characters after the address, thus we need to find the split position
+  -- first.
+
+  -- parse IPv4 address and port in a form `127.0.0.1:3001`
+  readIPv4AndPort :: Opt.ReadM (IP, Word)
+  readIPv4AndPort =
+    Opt.eitherReader $ \s ->
+      case splitWith ':' s of
+        Nothing -> Left s
+        Just (addrStr, portStr) ->
+          maybe (Left s) Right $
+            (,)
+              <$> readMaybe addrStr
+              <*> readMaybe portStr
+
+  -- parse IPv6 address and port in a form `[::1]:3001`
+  readIPv6AndPort :: Opt.ReadM (IP, Word)
+  readIPv6AndPort =
+    Opt.eitherReader $ \s ->
+      case s of
+        ('[' : s') ->
+          case splitWith ']' s' of
+            Just (addrStr, ':' : portStr) ->
+              maybe (Left s) Right $
+                (,)
+                  <$> readMaybe addrStr
+                  <*> readMaybe portStr
+            _ -> Left s
+        _ -> Left s
+
+  readDomainNameOrFilePath
+    :: Opt.ReadM (Ping.Address (Ping.Unresolved Ping.SRVOrFilePathUnresolved))
+  readDomainNameOrFilePath = Opt.eitherReader $ Right . Ping.mkAddress
+
+  splitWith :: Char -> String -> Maybe (String, String)
+  splitWith c = go ""
+   where
+    go _ [] = Nothing
+    go acc (a : as)
+      | a == c = Just (reverse acc, as)
+      | otherwise = go (a : acc) as
@@ -0,0 +1,148 @@
+-- | @cardano-cli ping@'s parser is a local mirror of
+-- @Cardano.Network.Ping.cmdlineParser@ from @cardano-diffusion:ping@, which
+-- it replaces (see 'Cardano.CLI.EraIndependent.Ping.Option.pPing').  These
+-- tests pin the library parser's behaviour: defaults, option readers,
+-- address parsing and rejected command lines.
+module Test.Cli.Ping
+  ( hprop_ping_parser_options
+  , hprop_ping_parser_addresses
+  , 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 Data.Word (Word32)
+import Options.Applicative qualified as Opt
+
+import Test.Cardano.CLI.Util (watchdogProp)
+
+import Hedgehog (Property, annotateShow, assert, (===))
+import Hedgehog.Extras (propertyOnce)
+
+-- | 'Ping.PingOpts' and 'Ping.HashType' have no 'Eq' or 'Show' instances,
+-- so parse results are compared (and reported) through this projection.
+data ProjectedOpts = ProjectedOpts
+  { count :: Word32
+  , magic :: Word32
+  , json :: Ping.LogFormat
+  , quiet :: Bool
+  , mode :: Ping.PingMode
+  , srvPrefix :: String
+  , color :: Ping.ColorMode
+  , shortHash :: Bool
+  }
+  deriving (Eq, Show)
+
+projectOpts :: Ping.PingOpts -> ProjectedOpts
+projectOpts opts =
+  ProjectedOpts
+    { count = Ping.pingOptsCount opts
+    , magic = Ping.unNetworkMagic (Ping.pingOptsMagic opts)
+    , json = Ping.pingOptsJson opts
+    , quiet = Ping.pingOptsQuiet opts
+    , mode = Ping.pingOptsMode opts
+    , srvPrefix = Ping.pingOptsSRVPrefix opts
+    , color = Ping.pingOptsColor opts
+    , shortHash =
+        case Ping.pingOptsHashType opts of
+          Ping.ShortHash -> True
+          Ping.FullHash -> False
+    }
+
+parsePing :: [String] -> Maybe (ProjectedOpts, [String])
+parsePing args = do
+  cmd <-
+    Opt.getParseResult $
+      Opt.execParserPure Opt.defaultPrefs (Opt.info pPing mempty) args
+  pure (projectOpts (pingOpts cmd), show <$> pingAddresses cmd)
+
+defaultOpts :: ProjectedOpts
+defaultOpts =
+  ProjectedOpts
+    { count = maxBound
+    , magic = 764824073 -- mainnet magic
+    , json = Ping.AsText
+    , quiet = False
+    , mode = Ping.PingMode
+    , srvPrefix = "_cardano._tcp"
+    , color = Ping.ColorAuto
+    , shortHash = False
+    }
+
+-- | 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
+  parseOpts [] === Just defaultOpts
+  parseOpts ["--count", "7"] === Just defaultOpts{count = 7}
+  parseOpts ["-c", "7"] === Just defaultOpts{count = 7}
+  parseOpts ["--network-magic", "2"] === Just defaultOpts{magic = 2}
+  parseOpts ["-m", "2"] === Just defaultOpts{magic = 2}
+  parseOpts ["--json"] === Just defaultOpts{json = Ping.AsJSON}
+  parseOpts ["-j"] === Just defaultOpts{json = Ping.AsJSON}
+  parseOpts ["--quiet"] === Just defaultOpts{quiet = True}
+  parseOpts ["-q"] === Just defaultOpts{quiet = True}
+  parseOpts ["--mode", "ping"] === Just defaultOpts{mode = Ping.PingMode}
+  parseOpts ["--mode", "tip"] === Just defaultOpts{mode = Ping.TipMode}
+  parseOpts ["--mode", "query"] === Just defaultOpts{mode = Ping.QueryMode}
+  parseOpts ["--srv-prefix", "_test._tcp"] === Just defaultOpts{srvPrefix = "_test._tcp"}
+  parseOpts ["--color", "auto"] === Just defaultOpts{color = Ping.ColorAuto}
+  parseOpts ["--color", "never"] === Just defaultOpts{color = Ping.ColorNever}
+  parseOpts ["--color", "always"] === Just defaultOpts{color = Ping.ColorAlways}
+  parseOpts ["--short-hash"] === Just defaultOpts{shortHash = True}
+ where
+  parseOpts args = fst <$> parsePing (args <> ["127.0.0.1:3001"])
+
+-- | 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
+  -- IP literals with a port parse to `IP` addresses
+  parseAddresses ["127.0.0.1:3001"] === Just ["IP 127.0.0.1 3001"]
+  parseAddresses ["[::1]:3001"] === Just ["IP ::1 3001"]
+  -- anything with a colon, slash or without a dot may be a domain with
+  -- a port or a file path, resolved at runtime
+  parseAddresses ["example.org:3001"] === Just ["FilePathOrDomain \"example.org:3001\""]
+  parseAddresses ["/tmp/node.socket"] === Just ["FilePathOrDomain \"/tmp/node.socket\""]
+  parseAddresses ["socket"] === Just ["FilePathOrDomain \"socket\""]
+  -- a dotted name without a port is looked up as an SRV record first
+  parseAddresses ["example.org"] === Just ["SRV \"example.org\""]
+  parseAddresses ["node.sock"] === Just ["SRV \"node.sock\""]
+  -- multiple addresses are accepted
+  parseAddresses ["127.0.0.1:3001", "example.org", "[::1]:3001"]
+    === Just ["IP 127.0.0.1 3001", "SRV \"example.org\"", "IP ::1 3001"]
+ where
+  parseAddresses args = snd <$> parsePing args
+
+-- | 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
+  mapM_
+    rejected
+    [ -- at least one address is required
+      []
+    , ["--count", "7"]
+    , -- invalid option values
+      ["--mode", "bogus", "127.0.0.1:3001"]
+    , ["--color", "bogus", "127.0.0.1:3001"]
+    , ["--count", "bogus", "127.0.0.1:3001"]
+    , -- the pre-11.2 interface is gone
+      ["--host", "relay.iohk.example"]
+    , ["--unixsock", "node.socket"]
+    , ["-u", "node.socket"]
+    , ["--port", "3001", "127.0.0.1:3001"]
+    , ["--magic", "42", "127.0.0.1:3001"]
+    , ["--tip", "127.0.0.1:3001"]
+    , ["-t", "127.0.0.1:3001"]
+    , ["--query-versions", "127.0.0.1:3001"]
+    , ["-Q", "127.0.0.1:3001"]
+    ]
+ where
+  rejected args = do
+    annotateShow args
+    assert $ isNothing (parsePing args)