diff --git a/.changes/20260625_145525_cardano-cli_work_prepare_11_1.yml b/.changes/20260625_145525_cardano-cli_work_prepare_11_1.yml new file mode 100644 index 0000000000..b5ba6a6527 --- /dev/null +++ b/.changes/20260625_145525_cardano-cli_work_prepare_11_1.yml @@ -0,0 +1,41 @@ +description: |- + new `cardano-cli ping` api + + `cardano-cli ping` allows now to ping multiple servers, does domain name + resolution and supports SRV records (as specified in + https://cips.cardano.org/cip/CIP-0155) + + Some examples: + + Run a ping against two ip addresses, ipv4 & ipv6 + ```bash + cardano-cli ping 127.0.0.1:3001 [::1]:3001 + ``` + + Run a ping against a domain name: + ```bash + cardano-cli ping my.domain.com:3001 + ``` + + Run a ping against an SRV domain. + According to CIP#0155 the SRV record needs to be registered at + `_cardano._tcp.srv.domain.com` + ```bash + cardano-cli ping srv.domain.com + ``` + + Run a ping against unix socket + ```bash + cardano-cli ping /var/run/cardano-node.socket + ``` + + `cardano-cli` ping has three modes of operation: + + * ping mode: `--mode ping` (the default) + * tip mode `--mode tip` + * query handshake parameters: `--mode query` +kind: +- breaking +- feature +pr: 1391 +project: cardano-cli diff --git a/cabal.project b/cabal.project index ac267481c3..eb6b2fd25f 100644 --- a/cabal.project +++ b/cabal.project @@ -56,6 +56,9 @@ package text package formatting flags: +no-double-conversion +package cardano-diffusion + flags: +optparse-applicative-fork + tests: True test-show-details: direct @@ -158,8 +161,8 @@ source-repository-package source-repository-package type: git location: https://github.com/IntersectMBO/ouroboros-network.git - tag: 8b4dcb898b64615f574a7fbdcf119f77c7fbc598 - --sha256: sha256-t1tGV5uZwyKnSSCbaJJAteMYKnQYeO39hUUycMRuC2M= + tag: 613f8a13cc1c11b2568a627d6eb900058e355d30 + --sha256: sha256-G5oVYskwZTc0EeFlQHE41xIjmFhMYV7VmX48kNGuc/c= subdir: ./cardano-diffusion ./monoidal-synchronisation diff --git a/cardano-cli/cardano-cli.cabal b/cardano-cli/cardano-cli.cabal index 18e5339748..2cbc6c325e 100644 --- a/cardano-cli/cardano-cli.cabal +++ b/cardano-cli/cardano-cli.cabal @@ -273,7 +273,6 @@ library http-client, http-client-tls, http-types, - io-classes, iproute, microlens, mmorph, diff --git a/cardano-cli/src/Cardano/CLI/EraIndependent/Ping/Command.hs b/cardano-cli/src/Cardano/CLI/EraIndependent/Ping/Command.hs index 4d8732f365..0b7cb0d154 100644 --- a/cardano-cli/src/Cardano/CLI/EraIndependent/Ping/Command.hs +++ b/cardano-cli/src/Cardano/CLI/EraIndependent/Ping/Command.hs @@ -1,38 +1,12 @@ module Cardano.CLI.EraIndependent.Ping.Command - ( EndPoint (..) - , PingCmd (..) - , getConfigurationError + ( PingCmd (..) + , Address ) where -import Data.Word +import Cardano.Network.Ping -data EndPoint - = HostEndPoint String - | UnixSockEndPoint String - deriving (Eq, Show) - -data PingCmd = PingCmd - { pingCmdCount :: !Word32 - , pingCmdEndPoint :: !EndPoint - , pingCmdPort :: !String - , pingCmdMagic :: !Word32 - , pingCmdJson :: !Bool - , pingCmdQuiet :: !Bool - , pingOptsHandshakeQuery :: !Bool - , pingOptsGetTip :: !Bool +data PingCmd = PingCmd { + pingOpts :: PingOpts, + pingAddresses :: [Address (Unresolved SRVOrFilePathUnresolved)] } - deriving (Eq, Show) - -getConfigurationError :: PingCmd -> Maybe String -getConfigurationError - PingCmd - { pingCmdEndPoint = endPoint - , pingOptsGetTip = getTip - , pingOptsHandshakeQuery = query - } = - case endPoint of - UnixSockEndPoint{} - | query || getTip -> Nothing - | otherwise -> Just "Unix sockets only support queries for available versions or a tip." - HostEndPoint{} -> Nothing diff --git a/cardano-cli/src/Cardano/CLI/EraIndependent/Ping/Option.hs b/cardano-cli/src/Cardano/CLI/EraIndependent/Ping/Option.hs index 6743ebaddf..021d821645 100644 --- a/cardano-cli/src/Cardano/CLI/EraIndependent/Ping/Option.hs +++ b/cardano-cli/src/Cardano/CLI/EraIndependent/Ping/Option.hs @@ -6,9 +6,8 @@ module Cardano.CLI.EraIndependent.Ping.Option 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 CNP +import Cardano.Network.Ping qualified as Ping import Control.Applicative import Options.Applicative qualified as Opt @@ -25,90 +24,5 @@ parsePingCmd = , PP.pretty @String "It negotiates a handshake and keeps sending keep alive messages." ] -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 EndPoint -pEndPoint = fmap HostEndPoint pHost <|> fmap UnixSockEndPoint pUnixSocket - pPing :: Opt.Parser PingCmd -pPing = - PingCmd - <$> ( 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.strOption $ - mconcat - [ Opt.long "port" - , Opt.short 'p' - , Opt.metavar "PORT" - , Opt.help "Port number, e.g. 1234." - , Opt.value "3001" - ] - ) - <*> ( Opt.option integralReader $ - mconcat - [ Opt.long "magic" - , Opt.short 'm' - , Opt.metavar "MAGIC" - , Opt.help "Network magic." - , Opt.value (CNP.unNetworkMagic 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 "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." - ] - ) +pPing = uncurry PingCmd <$> Ping.cmdlineParser diff --git a/cardano-cli/src/Cardano/CLI/EraIndependent/Ping/Run.hs b/cardano-cli/src/Cardano/CLI/EraIndependent/Ping/Run.hs index 8c0e8127ab..27dabfa1d8 100644 --- a/cardano-cli/src/Cardano/CLI/EraIndependent/Ping/Run.hs +++ b/cardano-cli/src/Cardano/CLI/EraIndependent/Ping/Run.hs @@ -1,133 +1,18 @@ -{-# LANGUAGE LambdaCase #-} -{-# LANGUAGE RankNTypes #-} +{-# LANGUAGE NamedFieldPuns #-} +{-# LANGUAGE RankNTypes #-} module Cardano.CLI.EraIndependent.Ping.Run - ( PingClientCmdError (..) - , renderPingClientCmdError - , runPingCmd + ( runPingCmd ) where import Cardano.Api -import Cardano.CLI.Compatible.Exception +import Cardano.CLI.Compatible.Exception (CIO) import Cardano.CLI.EraIndependent.Ping.Command -import Cardano.Network.Ping qualified as CNP +import Cardano.Network.Ping qualified as Ping -import Control.Exception (SomeException, toException) -import Control.Monad (unless) -import Control.Monad.Class.MonadAsync (mapConcurrently) -import Control.Tracer (mkTracer) -import Data.Aeson qualified as Aeson -import Data.Aeson.Text (encodeToLazyText) -import Data.List qualified as L -import Data.List qualified as List -import Data.Text qualified as T -import Data.Text.Lazy qualified as TL -import Data.Text.Lazy.IO qualified as TLIO -import Network.Socket (AddrInfo) -import Network.Socket qualified as Socket -import System.IO qualified as IO -import Text.Printf (printf) - -data PingClientCmdError - = PingClientCmdError [(AddrInfo, SomeException)] - | PingClientMisconfigurationError String - deriving Show - -instance Error PingClientCmdError where - prettyError = renderPingClientCmdError runPingCmd :: PingCmd -> CIO e () -runPingCmd options - | Just err <- getConfigurationError options = - throwCliError $ PingClientMisconfigurationError err -runPingCmd options = do - let hints = Socket.defaultHints{Socket.addrSocketType = Socket.Stream} - - addresses <- case pingCmdEndPoint options of - HostEndPoint host -> - liftIO $ Socket.getAddrInfo (Just hints) (Just host) (Just (pingCmdPort options)) - UnixSockEndPoint fname -> - pure - [ Socket.AddrInfo - [] - Socket.AF_UNIX - Socket.Stream - Socket.defaultProtocol - (Socket.SockAddrUnix fname) - Nothing - ] - - let stdout = mkTracer (TLIO.putStrLn . renderLogMsg (pingCmdJson options)) - stderr = mkTracer (IO.hPutStrLn IO.stderr . renderPingWarning) - - res <- - liftIO $ - mapConcurrently - (\addr -> (,) addr <$> CNP.pingClient stdout stderr (toPingOpts options) addr) - addresses - - case L.foldl' partition ([], []) res of - ([], _) -> pure () - (es, []) -> throwCliError $ PingClientCmdError es - (es, _) -> unless (pingCmdQuiet options) $ mapM_ (liftIO . IO.hPrint IO.stderr) es - where - partition - :: ([(AddrInfo, SomeException)], [AddrInfo]) - -> (AddrInfo, Either CNP.PingClientException ()) - -> ([(AddrInfo, SomeException)], [AddrInfo]) - partition (es, as) (a, Left e) = ((a, toException e) : es, as) - partition (es, as) (a, Right _) = (es, a : as) - -toPingOpts :: PingCmd -> CNP.PingOpts -toPingOpts cmd = - CNP.PingOpts - { CNP.pingOptsCount = pingCmdCount cmd - , CNP.pingOptsMagic = CNP.NetworkMagic (pingCmdMagic cmd) - , CNP.pingOptsJson = if pingCmdJson cmd then CNP.AsJSON else CNP.AsText - , CNP.pingOptsQuiet = pingCmdQuiet cmd - , CNP.pingOptsMode = - if pingOptsGetTip cmd - then CNP.TipMode - else - if pingOptsHandshakeQuery cmd - then CNP.QueryMode - else CNP.PingMode - , -- cardano-cli has no flags for these yet, so use network's own defaults. - CNP.pingOptsSRVPrefix = "_cardano._tcp" - , CNP.pingOptsColor = CNP.ColorAuto - } - --- | Format a ping log message. Mirrors the network library's internal --- @format@/@ToText@ helpers, which are not exported. -renderLogMsg :: Bool -> CNP.WithHost CNP.LogMsg -> TL.Text -renderLogMsg True msg = encodeToLazyText (Aeson.toJSON msg) -renderLogMsg False (CNP.WithHost host logMsg) = - TL.pack (printf "%-47s" (show host <> ", ")) <> renderLogMsgText logMsg - -renderLogMsgText :: CNP.LogMsg -> TL.Text -renderLogMsgText = \case - CNP.LogChainSyncTip tip -> TL.pack (show tip) - CNP.LogStatPoint point -> TL.pack (show point) - CNP.LogNodeToClientVersionData version versionData -> - TL.pack (unwords [show version, either T.unpack show versionData]) - CNP.LogNodeToNodeVersionData version versionData -> - TL.pack (unwords [show version, either T.unpack show versionData]) - --- | Format a ping warning. Mirrors the network library's internal --- @formatPingWarning@, which is not exported. -renderPingWarning :: CNP.PingWarning -> String -renderPingWarning = \case - CNP.FilePathDoesNotExist path -> "WARNING: file path " <> show path <> " does not exist" - CNP.DNSError domain err -> "WARNING: dns: " <> show domain <> " " <> show err - CNP.DNSResolution domain ips port -> - show domain <> ": " <> List.intercalate ", " [show ip <> ":" <> show port | ip <- ips] - CNP.MissingPort ip -> "WARNING: missing port for " <> show ip - CNP.Error err -> "WARNING: " <> show err - CNP.ConnectError sockAddr err -> "WARNING: " <> show sockAddr <> " " <> show err - -renderPingClientCmdError :: PingClientCmdError -> Doc ann -renderPingClientCmdError = \case - PingClientCmdError es -> mconcat $ List.intersperse "\n" $ pshow <$> es - PingClientMisconfigurationError err -> pretty err +runPingCmd PingCmd { pingOpts, pingAddresses } = + liftIO $ Ping.pingClients pingOpts pingAddresses