Introduce handshake command + tighter ping UI

cardano-cli/cardano-cli.cabal

@@ -155,6 +155,7 @@ library
                         Cardano.CLI.Read
                         Cardano.CLI.Render
                         Cardano.CLI.Run
+                        Cardano.CLI.Run.HandShake
                         Cardano.CLI.Run.Ping
                         Cardano.CLI.TopHandler
                         Cardano.CLI.Types.Common

cardano-cli/src/Cardano/CLI/Options.hs

@@ -23,6 +23,7 @@ import           Data.Foldable
 import           Options.Applicative
 import qualified Options.Applicative as Opt
 import qualified Prettyprinter as PP
+import Cardano.CLI.Run.HandShake (parseHandShakeCmd)
 
 opts :: EnvCli -> ParserInfo ClientCommand
 opts envCli =
@@ -54,6 +55,7 @@ parseClientCommand envCli =
     -- , parseTopLevelLatest envCli -- TODO restore this when the governance command group is fully operational
     , parseTopLevelLegacy envCli
     , parseByron envCli
+    , parseHandShake
     , parsePing
     , backwardsCompatibilityCommands envCli
     , parseDisplayVersion (opts envCli)
@@ -68,6 +70,9 @@ parseByron mNetworkId =
     , command' "byron" "Byron specific commands" $ parseByronCommands mNetworkId
     ]
 
+parseHandShake :: Parser ClientCommand
+parseHandShake = CliHandShakeCommand <$> parseHandShakeCmd
+
 parsePing :: Parser ClientCommand
 parsePing = CliPingCommand <$> parsePingCmd
 

cardano-cli/src/Cardano/CLI/Run.hs

@@ -18,6 +18,8 @@ import           Cardano.CLI.IO.GitRev (gitRev)
 import           Cardano.CLI.Legacy.Commands
 import           Cardano.CLI.Legacy.Run (runLegacyCmds)
 import           Cardano.CLI.Render (customRenderHelp)
+import           Cardano.CLI.Run.HandShake (HandShakeCmd (..))
+import qualified Cardano.CLI.Run.HandShake as HandShake
 import           Cardano.CLI.Run.Ping (PingClientCmdError (..), PingCmd (..),
                    renderPingClientCmdError, runPingCmd)
 import           Cardano.CLI.Types.Errors.CmdError
@@ -50,6 +52,8 @@ data ClientCommand =
     -- | Legacy shelley-based Commands
   | LegacyCmds LegacyCmds
 
+  | CliHandShakeCommand HandShakeCmd
+
   | CliPingCommand PingCmd
 
   | forall a. Help ParserPrefs (ParserInfo a)
@@ -68,6 +72,8 @@ runClientCommand = \case
     firstExceptT ByronClientError $ runByronClientCommand cmds
   LegacyCmds cmds ->
     firstExceptT (CmdError (renderLegacyCommand cmds)) $ runLegacyCmds cmds
+  CliHandShakeCommand cmds ->
+    firstExceptT PingClientError $ runPingCmd $ HandShake.toPingCmd cmds
   CliPingCommand cmds ->
     firstExceptT PingClientError $ runPingCmd cmds
   Help pprefs allParserInfo ->

cardano-cli/src/Cardano/CLI/Run/HandShake.hs

@@ -0,0 +1,109 @@
+
+{-# LANGUAGE NamedFieldPuns #-}
+{-# LANGUAGE TypeApplications #-}
+
+{- HLINT ignore "Move brackets to avoid $" -}
+
+module Cardano.CLI.Run.HandShake
+  ( HandShakeCmd(..)
+  , parseHandShakeCmd
+  , toPingCmd
+  ) where
+
+
+import           Cardano.CLI.Run.Ping (PingCmd (..))
+import qualified Cardano.CLI.Run.Ping as Ping
+import qualified Cardano.Network.Ping as CNP
+
+import           Control.Applicative ((<|>))
+import           Data.Word (Word32)
+import qualified Options.Applicative as Opt
+import qualified Prettyprinter as PP
+
+data HandShakeCmd = HandShakeCmd
+  { endPoint        :: !Ping.EndPoint
+  , port            :: !String
+  , magic           :: !Word32
+  , json            :: !Bool
+  , quiet           :: !Bool
+  , query           :: !Bool
+  } deriving (Eq, Show)
+
+toPingCmd :: HandShakeCmd -> PingCmd
+toPingCmd (HandShakeCmd {endPoint, port, magic, json, quiet, query}) =
+  PingCmd {
+      pingCmdCount = 0
+    , pingCmdEndPoint = endPoint
+    , pingCmdPort = port
+    , pingCmdMagic = magic
+    , pingCmdJson = json
+    , pingCmdQuiet = quiet
+    , pingOptsHandshakeQuery = query
+  }
+
+parseHandShakeCmd :: Opt.Parser HandShakeCmd
+parseHandShakeCmd = Opt.hsubparser $ mconcat
+  [ Opt.metavar "handshake"
+  , Opt.command "handshake"
+      $ Opt.info pHandShake $ Opt.progDescDoc
+      $ Just $ PP.pretty @String "Negotiates a handshake and prints the negotiated version"
+  ]
+
+pHost :: Opt.Parser String
+pHost =
+  Opt.strOption $ mconcat
+    [ Opt.long "host"
+    , Opt.short 'h'
+    , Opt.metavar "HOST"
+    , Opt.help "Hostname/IP, e.g. relay.iohk.example."
+    ]
+
+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 Ping.EndPoint
+pEndPoint = fmap Ping.HostEndPoint pHost <|> fmap Ping.UnixSockEndPoint pUnixSocket
+
+pHandShake :: Opt.Parser HandShakeCmd
+pHandShake = HandShakeCmd
+  <$> pEndPoint
+  <*> ( Opt.strOption $ mconcat
+        [ Opt.long "port"
+        , Opt.short 'p'
+        , Opt.metavar "PORT"
+        , Opt.help "Port number, e.g. 1234."
+        , Opt.value "3001"
+        ]
+      )
+  <*> ( Opt.option Opt.auto $ mconcat
+        [ Opt.long "magic"
+        , Opt.short 'm'
+        , Opt.metavar "MAGIC"
+        , Opt.help "Network magic."
+        , Opt.value CNP.mainnetMagic
+        ]
+      )
+  <*> ( Opt.switch $ mconcat
+        [ Opt.long "json"
+        , Opt.short 'j'
+        , Opt.help "JSON output flag."
+        ]
+      )
+  <*> ( Opt.switch $ mconcat
+        [ Opt.long "quiet"
+        , Opt.short 'q'
+        , Opt.help "Don't print network statistics, only print negotiated version (default) or supported versions (-Q)."
+        ]
+      )
+  <*> ( Opt.switch $ mconcat
+        [ Opt.long "query-versions"
+        , Opt.short 'Q'
+        , Opt.help "Instead of printing the negotiated version, print all queried versions."
+        ]
+      )

cardano-cli/src/Cardano/CLI/Run/Ping.hs

@@ -4,7 +4,8 @@
 {- HLINT ignore "Move brackets to avoid $" -}
 
 module Cardano.CLI.Run.Ping
-  ( PingCmd(..)
+  ( EndPoint(..),
+    PingCmd(..)
   , PingClientCmdError(..)
   , renderPingClientCmdError
   , runPingCmd
@@ -15,7 +16,6 @@ import           Cardano.Api.Pretty
 
 import qualified Cardano.Network.Ping as CNP
 
-import           Control.Applicative ((<|>))
 import           Control.Concurrent.Class.MonadSTM.Strict (StrictTMVar)
 import qualified Control.Concurrent.Class.MonadSTM.Strict as STM
 import           Control.Exception (SomeException)
@@ -38,6 +38,8 @@ import qualified System.IO as IO
 
 newtype PingClientCmdError = PingClientCmdError [(AddrInfo, SomeException)]
 
+-- | Note that the @ping@ command only supports @HostEndPoint@. It's 'HandShake'
+-- that support both @HostEndPoint@ and @UnixSockEndPoint@
 data EndPoint = HostEndPoint String | UnixSockEndPoint String deriving (Eq, Show)
 
 maybeHostEndPoint :: EndPoint -> Maybe String
@@ -130,10 +132,9 @@ renderPingClientCmdError = \case
 parsePingCmd :: Opt.Parser PingCmd
 parsePingCmd = Opt.hsubparser $ mconcat
   [ Opt.metavar "ping"
-  , Opt.command "ping" $ Opt.info pPing $ Opt.progDescDoc $ Just $ mconcat
-    [ PP.pretty @String "Ping a cardano node either using node-to-node or node-to-client protocol. "
-    , PP.pretty @String "It negotiates a handshake and keeps sending keep alive messages."
-    ]
+  , Opt.command "ping" $ Opt.info pPing $ Opt.progDescDoc $ Just $
+    PP.pretty @String "Ping a cardano node. It negotiates a handshake and keeps sending keep alive messages."
+
   ]
 
 pHost :: Opt.Parser String
@@ -145,18 +146,6 @@ pHost =
     , Opt.help "Hostname/IP, e.g. relay.iohk.example."
     ]
 
-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 = PingCmd
   <$> ( Opt.option Opt.auto $ mconcat
@@ -170,7 +159,7 @@ pPing = PingCmd
         , Opt.value maxBound
         ]
       )
-  <*> pEndPoint
+  <*> fmap HostEndPoint pHost
   <*> ( Opt.strOption $ mconcat
         [ Opt.long "port"
         , Opt.short 'p'
@@ -196,12 +185,14 @@ pPing = PingCmd
   <*> ( Opt.switch $ mconcat
         [ Opt.long "quiet"
         , Opt.short 'q'
-        , Opt.help "Quiet flag, CSV/JSON only output"
+        , Opt.help "Quiet flag: don't print network statistics."
         ]
       )
+  -- TODO remove this option at some point (TODO introduced in 8.15)
   <*> ( Opt.switch $ mconcat
         [ Opt.long "query-versions"
+        , Opt.hidden
         , Opt.short 'Q'
-        , Opt.help "Query the supported protocol versions using the handshake protocol and terminate the connection."
+        , Opt.help "Query the supported protocol versions using the handshake protocol and terminate the connection (deprecated, use the \"cardano-cli handshake\" command instead)."
         ]
       )

cardano-cli/test/cardano-cli-golden/files/golden/help.cli

@@ -9,6 +9,7 @@ Usage: cardano-cli
                      | legacy
                      | Legacy commands
                      | byron
+                     | handshake
                      | ping
                      | version
                      )
@@ -10961,15 +10962,23 @@ Usage: cardano-cli byron create-update-proposal
 
   Create an update proposal.
 
+Usage: cardano-cli handshake ((-h|--host HOST) | (-u|--unixsock SOCKET))
+                               [-p|--port PORT]
+                               [-m|--magic MAGIC]
+                               [-j|--json]
+                               [-q|--quiet]
+                               [-Q|--query-versions]
+
+  Negotiates a handshake and prints the negotiated version
+
 Usage: cardano-cli ping [-c|--count COUNT]
-                          ((-h|--host HOST) | (-u|--unixsock SOCKET))
+                          (-h|--host HOST)
                           [-p|--port PORT]
                           [-m|--magic MAGIC]
                           [-j|--json]
                           [-q|--quiet]
-                          [-Q|--query-versions]
 
-  Ping a cardano node either using node-to-node or node-to-client protocol. It negotiates a handshake and keeps sending keep alive messages.
+  Ping a cardano node. It negotiates a handshake and keeps sending keep alive messages.
 
 Usage: cardano-cli genesis --genesis-output-dir FILEPATH
                              --start-time POSIXSECONDS

cardano-cli/test/cardano-cli-golden/files/golden/help/handshake.cli

@@ -0,0 +1,20 @@
+Usage: cardano-cli handshake ((-h|--host HOST) | (-u|--unixsock SOCKET))
+                               [-p|--port PORT]
+                               [-m|--magic MAGIC]
+                               [-j|--json]
+                               [-q|--quiet]
+                               [-Q|--query-versions]
+
+  Negotiates a handshake and prints the negotiated version
+
+Available options:
+  -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               Don't print network statistics, only print negotiated
+                           version (default) or supported versions (-Q).
+  -Q,--query-versions      Instead of printing the negotiated version, print all
+                           queried versions.
+  -h,--help                Show this help text

cardano-cli/test/cardano-cli-golden/files/golden/help/ping.cli

@@ -1,23 +1,23 @@
 Usage: cardano-cli ping [-c|--count COUNT]
-                          ((-h|--host HOST) | (-u|--unixsock SOCKET))
+                          (-h|--host HOST)
                           [-p|--port PORT]
                           [-m|--magic MAGIC]
                           [-j|--json]
                           [-q|--quiet]
-                          [-Q|--query-versions]
 
-  Ping a cardano node either using node-to-node or node-to-client protocol. It negotiates a handshake and keeps sending keep alive messages.
+  Ping a cardano node. It negotiates a handshake and keeps sending keep alive messages.
 
 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, 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,--quiet               Quiet flag: don't print network statistics.
   -Q,--query-versions      Query the supported protocol versions using the
-                           handshake protocol and terminate the connection.
+                           handshake protocol and terminate the connection
+                           (deprecated, use the "cardano-cli handshake" command
+                           instead).
   -h,--help                Show this help text