Skip to content

Commit

Permalink
Merge pull request #893 from IntersectMBO/coot/cardano-ping-misconfig…
Browse files Browse the repository at this point in the history
…uration

cardano-ping: report user friendly error on misconfiguration
  • Loading branch information
coot authored Sep 13, 2024
2 parents 39af17e + 6ebdc97 commit 294c3b9
Show file tree
Hide file tree
Showing 2 changed files with 22 additions and 1 deletion.
14 changes: 14 additions & 0 deletions cardano-cli/src/Cardano/CLI/Commands/Ping.hs
Original file line number Diff line number Diff line change
@@ -1,6 +1,7 @@
module Cardano.CLI.Commands.Ping
( EndPoint (..)
, PingCmd (..)
, getConfigurationError
)
where

Expand All @@ -22,3 +23,16 @@ data PingCmd = PingCmd
, pingOptsGetTip :: !Bool
}
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
9 changes: 8 additions & 1 deletion cardano-cli/src/Cardano/CLI/Run/Ping.hs
Original file line number Diff line number Diff line change
Expand Up @@ -18,6 +18,7 @@ import qualified Control.Concurrent.Class.MonadSTM.Strict as STM
import Control.Exception (SomeException)
import Control.Monad (forM, unless)
import Control.Monad.Class.MonadAsync (MonadAsync (async, wait, waitCatch))
import Control.Monad.Except (throwError)
import Control.Monad.Trans.Except (ExceptT)
import Control.Monad.Trans.Except.Extra (left)
import Control.Tracer (Tracer (..))
Expand All @@ -28,7 +29,9 @@ import qualified Network.Socket as Socket
import qualified System.Exit as IO
import qualified System.IO as IO

newtype PingClientCmdError = PingClientCmdError [(AddrInfo, SomeException)]
data PingClientCmdError
= PingClientCmdError [(AddrInfo, SomeException)]
| PingClientMisconfigurationError String

maybeHostEndPoint :: EndPoint -> Maybe String
maybeHostEndPoint = \case
Expand Down Expand Up @@ -58,6 +61,9 @@ pingClient stdout stderr cmd = CNP.pingClient stdout stderr opts
}

runPingCmd :: PingCmd -> ExceptT PingClientCmdError IO ()
runPingCmd options
| Just err <- getConfigurationError options =
throwError $ PingClientMisconfigurationError err
runPingCmd options = do
let hints = Socket.defaultHints{Socket.addrSocketType = Socket.Stream}

Expand Down Expand Up @@ -120,3 +126,4 @@ runPingCmd options = do
renderPingClientCmdError :: PingClientCmdError -> Doc ann
renderPingClientCmdError = \case
PingClientCmdError es -> mconcat $ List.intersperse "\n" $ pshow <$> es
PingClientMisconfigurationError err -> pretty err

0 comments on commit 294c3b9

Please sign in to comment.