{-# LANGUAGE LambdaCase #-}
{-# LANGUAGE TypeApplications #-}

module Cardano.CLI.EraIndependent.Ping.Option
  ( parsePingCmd
  , pPing
  )
where

import Cardano.CLI.Command (ClientCommand (CliPingCommand))
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 :: Mod CommandFields ClientCommand
parsePingCmd =
  [Char]
-> ParserInfo ClientCommand -> Mod CommandFields ClientCommand
forall a. [Char] -> ParserInfo a -> Mod CommandFields a
Opt.command [Char]
"ping" (ParserInfo ClientCommand -> Mod CommandFields ClientCommand)
-> ParserInfo ClientCommand -> Mod CommandFields ClientCommand
forall a b. (a -> b) -> a -> b
$
    Parser ClientCommand
-> InfoMod ClientCommand -> ParserInfo ClientCommand
forall a. Parser a -> InfoMod a -> ParserInfo a
Opt.info (PingCmd -> ClientCommand
CliPingCommand (PingCmd -> ClientCommand)
-> Parser PingCmd -> Parser ClientCommand
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser PingCmd
pPing Parser ClientCommand
-> Parser (ClientCommand -> ClientCommand) -> Parser ClientCommand
forall (f :: * -> *) a b. Applicative f => f a -> f (a -> b) -> f b
<**> Parser (ClientCommand -> ClientCommand)
forall a. Parser (a -> a)
Opt.helper) (InfoMod ClientCommand -> ParserInfo ClientCommand)
-> InfoMod ClientCommand -> ParserInfo ClientCommand
forall a b. (a -> b) -> a -> b
$
      Maybe Doc -> InfoMod ClientCommand
forall a. Maybe Doc -> InfoMod a
Opt.progDescDoc (Maybe Doc -> InfoMod ClientCommand)
-> Maybe Doc -> InfoMod ClientCommand
forall a b. (a -> b) -> a -> b
$
        Doc -> Maybe Doc
forall a. a -> Maybe a
Just (Doc -> Maybe Doc) -> Doc -> Maybe Doc
forall a b. (a -> b) -> a -> b
$
          [Doc] -> Doc
forall a. Monoid a => [a] -> a
mconcat
            [ forall a ann. Pretty a => a -> Doc ann
PP.pretty @String [Char]
"Ping a cardano node either using node-to-node or node-to-client protocol. "
            , forall a ann. Pretty a => a -> Doc ann
PP.pretty @String [Char]
"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 :: Parser PingCmd
pPing = PingOpts
-> [Address (Unresolved SRVOrFilePathUnresolved)] -> PingCmd
PingCmd (PingOpts
 -> [Address (Unresolved SRVOrFilePathUnresolved)] -> PingCmd)
-> Parser PingOpts
-> Parser
     ([Address (Unresolved SRVOrFilePathUnresolved)] -> PingCmd)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser PingOpts
pPingOpts Parser ([Address (Unresolved SRVOrFilePathUnresolved)] -> PingCmd)
-> Parser [Address (Unresolved SRVOrFilePathUnresolved)]
-> Parser PingCmd
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Parser [Address (Unresolved SRVOrFilePathUnresolved)]
pPingAddresses

-- | A copy of @Cardano.Network.Ping.pingOptsParser@.
pPingOpts :: Opt.Parser Ping.PingOpts
pPingOpts :: Parser PingOpts
pPingOpts =
  Word32
-> NetworkMagic
-> LogFormat
-> Bool
-> PingMode
-> [Char]
-> ColorMode
-> HashType
-> PingOpts
Ping.PingOpts
    (Word32
 -> NetworkMagic
 -> LogFormat
 -> Bool
 -> PingMode
 -> [Char]
 -> ColorMode
 -> HashType
 -> PingOpts)
-> Parser Word32
-> Parser
     (NetworkMagic
      -> LogFormat
      -> Bool
      -> PingMode
      -> [Char]
      -> ColorMode
      -> HashType
      -> PingOpts)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ReadM Word32 -> Mod OptionFields Word32 -> Parser Word32
forall a. ReadM a -> Mod OptionFields a -> Parser a
Opt.option
      ReadM Word32
forall a. Read a => ReadM a
Opt.auto
      ( [Char] -> Mod OptionFields Word32
forall (f :: * -> *) a. HasName f => [Char] -> Mod f a
Opt.long [Char]
"count"
          Mod OptionFields Word32
-> Mod OptionFields Word32 -> Mod OptionFields Word32
forall a. Semigroup a => a -> a -> a
<> Char -> Mod OptionFields Word32
forall (f :: * -> *) a. HasName f => Char -> Mod f a
Opt.short Char
'c'
          Mod OptionFields Word32
-> Mod OptionFields Word32 -> Mod OptionFields Word32
forall a. Semigroup a => a -> a -> a
<> [Char] -> Mod OptionFields Word32
forall (f :: * -> *) a. [Char] -> Mod f a
Opt.help
            ( [[Char]] -> [Char]
forall a. Monoid a => [a] -> a
mconcat
                [ [Char]
"Stop after sending count requests and receiving count responses.  "
                , [Char]
"If this option is not specified, ping will operate until interrupted.  "
                ]
            )
          Mod OptionFields Word32
-> Mod OptionFields Word32 -> Mod OptionFields Word32
forall a. Semigroup a => a -> a -> a
<> [Char] -> Mod OptionFields Word32
forall (f :: * -> *) a. HasMetavar f => [Char] -> Mod f a
Opt.metavar [Char]
"COUNT"
          Mod OptionFields Word32
-> Mod OptionFields Word32 -> Mod OptionFields Word32
forall a. Semigroup a => a -> a -> a
<> Word32 -> Mod OptionFields Word32
forall (f :: * -> *) a. HasValue f => a -> Mod f a
Opt.value Word32
forall a. Bounded a => a
maxBound
          Mod OptionFields Word32
-> Mod OptionFields Word32 -> Mod OptionFields Word32
forall a. Semigroup a => a -> a -> a
<> Mod OptionFields Word32
forall a (f :: * -> *). Show a => Mod f a
Opt.showDefault
      )
    Parser
  (NetworkMagic
   -> LogFormat
   -> Bool
   -> PingMode
   -> [Char]
   -> ColorMode
   -> HashType
   -> PingOpts)
-> Parser NetworkMagic
-> Parser
     (LogFormat
      -> Bool -> PingMode -> [Char] -> ColorMode -> HashType -> PingOpts)
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> ReadM NetworkMagic
-> Mod OptionFields NetworkMagic -> Parser NetworkMagic
forall a. ReadM a -> Mod OptionFields a -> Parser a
Opt.option
      (Word32 -> NetworkMagic
Ping.NetworkMagic (Word32 -> NetworkMagic) -> ReadM Word32 -> ReadM NetworkMagic
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ReadM Word32
forall a. Read a => ReadM a
Opt.auto)
      ( [Char] -> Mod OptionFields NetworkMagic
forall (f :: * -> *) a. HasName f => [Char] -> Mod f a
Opt.long [Char]
"network-magic"
          Mod OptionFields NetworkMagic
-> Mod OptionFields NetworkMagic -> Mod OptionFields NetworkMagic
forall a. Semigroup a => a -> a -> a
<> Char -> Mod OptionFields NetworkMagic
forall (f :: * -> *) a. HasName f => Char -> Mod f a
Opt.short Char
'm'
          Mod OptionFields NetworkMagic
-> Mod OptionFields NetworkMagic -> Mod OptionFields NetworkMagic
forall a. Semigroup a => a -> a -> a
<> [Char] -> Mod OptionFields NetworkMagic
forall (f :: * -> *) a. [Char] -> Mod f a
Opt.help [Char]
"Network magic."
          Mod OptionFields NetworkMagic
-> Mod OptionFields NetworkMagic -> Mod OptionFields NetworkMagic
forall a. Semigroup a => a -> a -> a
<> NetworkMagic -> Mod OptionFields NetworkMagic
forall (f :: * -> *) a. HasValue f => a -> Mod f a
Opt.value NetworkMagic
Ping.mainnetMagic
          Mod OptionFields NetworkMagic
-> Mod OptionFields NetworkMagic -> Mod OptionFields NetworkMagic
forall a. Semigroup a => a -> a -> a
<> [Char] -> Mod OptionFields NetworkMagic
forall (f :: * -> *) a. HasMetavar f => [Char] -> Mod f a
Opt.metavar [Char]
"MAGIC"
          Mod OptionFields NetworkMagic
-> Mod OptionFields NetworkMagic -> Mod OptionFields NetworkMagic
forall a. Semigroup a => a -> a -> a
<> (NetworkMagic -> [Char]) -> Mod OptionFields NetworkMagic
forall a (f :: * -> *). (a -> [Char]) -> Mod f a
Opt.showDefaultWith (Word32 -> [Char]
forall a. Show a => a -> [Char]
show (Word32 -> [Char])
-> (NetworkMagic -> Word32) -> NetworkMagic -> [Char]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. NetworkMagic -> Word32
Ping.unNetworkMagic)
      )
    Parser
  (LogFormat
   -> Bool -> PingMode -> [Char] -> ColorMode -> HashType -> PingOpts)
-> Parser LogFormat
-> Parser
     (Bool -> PingMode -> [Char] -> ColorMode -> HashType -> PingOpts)
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> LogFormat
-> LogFormat -> Mod FlagFields LogFormat -> Parser LogFormat
forall a. a -> a -> Mod FlagFields a -> Parser a
Opt.flag
      LogFormat
Ping.AsText
      LogFormat
Ping.AsJSON
      ( [Char] -> Mod FlagFields LogFormat
forall (f :: * -> *) a. HasName f => [Char] -> Mod f a
Opt.long [Char]
"json"
          Mod FlagFields LogFormat
-> Mod FlagFields LogFormat -> Mod FlagFields LogFormat
forall a. Semigroup a => a -> a -> a
<> Char -> Mod FlagFields LogFormat
forall (f :: * -> *) a. HasName f => Char -> Mod f a
Opt.short Char
'j'
          Mod FlagFields LogFormat
-> Mod FlagFields LogFormat -> Mod FlagFields LogFormat
forall a. Semigroup a => a -> a -> a
<> [Char] -> Mod FlagFields LogFormat
forall (f :: * -> *) a. [Char] -> Mod f a
Opt.help [Char]
"JSON output flag."
      )
    Parser
  (Bool -> PingMode -> [Char] -> ColorMode -> HashType -> PingOpts)
-> Parser Bool
-> Parser (PingMode -> [Char] -> ColorMode -> HashType -> PingOpts)
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Bool -> Bool -> Mod FlagFields Bool -> Parser Bool
forall a. a -> a -> Mod FlagFields a -> Parser a
Opt.flag
      Bool
False
      Bool
True
      ( [Char] -> Mod FlagFields Bool
forall (f :: * -> *) a. HasName f => [Char] -> Mod f a
Opt.long [Char]
"quiet"
          Mod FlagFields Bool -> Mod FlagFields Bool -> Mod FlagFields Bool
forall a. Semigroup a => a -> a -> a
<> Char -> Mod FlagFields Bool
forall (f :: * -> *) a. HasName f => Char -> Mod f a
Opt.short Char
'q'
          Mod FlagFields Bool -> Mod FlagFields Bool -> Mod FlagFields Bool
forall a. Semigroup a => a -> a -> a
<> [Char] -> Mod FlagFields Bool
forall (f :: * -> *) a. [Char] -> Mod f a
Opt.help [Char]
"Quiet flag, CSV/JSON only output."
      )
    Parser (PingMode -> [Char] -> ColorMode -> HashType -> PingOpts)
-> Parser PingMode
-> Parser ([Char] -> ColorMode -> HashType -> PingOpts)
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> ReadM PingMode -> Mod OptionFields PingMode -> Parser PingMode
forall a. ReadM a -> Mod OptionFields a -> Parser a
Opt.option
      ReadM PingMode
pingMode
      ( [Char] -> Mod OptionFields PingMode
forall (f :: * -> *) a. HasName f => [Char] -> Mod f a
Opt.long [Char]
"mode"
          Mod OptionFields PingMode
-> Mod OptionFields PingMode -> Mod OptionFields PingMode
forall a. Semigroup a => a -> a -> a
<> Maybe Doc -> Mod OptionFields PingMode
forall (f :: * -> *) a. Maybe Doc -> Mod f a
Opt.helpDoc
            ( Doc -> Maybe Doc
forall a. a -> Maybe a
Just (Doc -> Maybe Doc) -> Doc -> Maybe Doc
forall a b. (a -> b) -> a -> b
$
                Int -> Doc -> Doc
Pretty.hang Int
2 (Doc -> Doc) -> Doc -> Doc
forall a b. (a -> b) -> a -> b
$
                  Doc
"Mode, either ping, tip or query:"
                    Doc -> Doc -> Doc
forall a. Semigroup a => a -> a -> a
<> Doc
forall ann. Doc ann
Pretty.softline
                    Doc -> Doc -> Doc
forall a. Semigroup a => a -> a -> a
<> Doc
"ping  - send pings via keep-alive protocol (node-to-node only),"
                    Doc -> Doc -> Doc
forall a. Semigroup a => a -> a -> a
<> Doc
forall ann. Doc ann
Pretty.softline
                    Doc -> Doc -> Doc
forall a. Semigroup a => a -> a -> a
<> Doc
"tip   - query tip via chain-sync protocol (node-to-node / node-to-client),"
                    Doc -> Doc -> Doc
forall a. Semigroup a => a -> a -> a
<> Doc
forall ann. Doc ann
Pretty.softline
                    Doc -> Doc -> Doc
forall a. Semigroup a => a -> a -> a
<> Doc
"query - query handshake parameters (node-to-node / node-to-client)."
            )
          Mod OptionFields PingMode
-> Mod OptionFields PingMode -> Mod OptionFields PingMode
forall a. Semigroup a => a -> a -> a
<> PingMode -> Mod OptionFields PingMode
forall (f :: * -> *) a. HasValue f => a -> Mod f a
Opt.value PingMode
Ping.PingMode
          Mod OptionFields PingMode
-> Mod OptionFields PingMode -> Mod OptionFields PingMode
forall a. Semigroup a => a -> a -> a
<> [Char] -> Mod OptionFields PingMode
forall (f :: * -> *) a. HasMetavar f => [Char] -> Mod f a
Opt.metavar [Char]
"MODE"
      )
    Parser ([Char] -> ColorMode -> HashType -> PingOpts)
-> Parser [Char] -> Parser (ColorMode -> HashType -> PingOpts)
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> ReadM [Char] -> Mod OptionFields [Char] -> Parser [Char]
forall a. ReadM a -> Mod OptionFields a -> Parser a
Opt.option
      ReadM [Char]
forall s. IsString s => ReadM s
Opt.str
      ( [Char] -> Mod OptionFields [Char]
forall (f :: * -> *) a. HasName f => [Char] -> Mod f a
Opt.long [Char]
"srv-prefix"
          Mod OptionFields [Char]
-> Mod OptionFields [Char] -> Mod OptionFields [Char]
forall a. Semigroup a => a -> a -> a
<> [Char] -> Mod OptionFields [Char]
forall (f :: * -> *) a. [Char] -> Mod f a
Opt.help [Char]
"Prefix that will be added to an SRV service name"
          Mod OptionFields [Char]
-> Mod OptionFields [Char] -> Mod OptionFields [Char]
forall a. Semigroup a => a -> a -> a
<> [Char] -> Mod OptionFields [Char]
forall (f :: * -> *) a. HasValue f => a -> Mod f a
Opt.value [Char]
"_cardano._tcp"
          Mod OptionFields [Char]
-> Mod OptionFields [Char] -> Mod OptionFields [Char]
forall a. Semigroup a => a -> a -> a
<> [Char] -> Mod OptionFields [Char]
forall (f :: * -> *) a. HasMetavar f => [Char] -> Mod f a
Opt.metavar [Char]
"SRV_PREFIX"
          Mod OptionFields [Char]
-> Mod OptionFields [Char] -> Mod OptionFields [Char]
forall a. Semigroup a => a -> a -> a
<> Mod OptionFields [Char]
forall a (f :: * -> *). Show a => Mod f a
Opt.showDefault
      )
    Parser (ColorMode -> HashType -> PingOpts)
-> Parser ColorMode -> Parser (HashType -> PingOpts)
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> ReadM ColorMode -> Mod OptionFields ColorMode -> Parser ColorMode
forall a. ReadM a -> Mod OptionFields a -> Parser a
Opt.option
      ReadM ColorMode
colorMode
      ( [Char] -> Mod OptionFields ColorMode
forall (f :: * -> *) a. HasName f => [Char] -> Mod f a
Opt.long [Char]
"color"
          Mod OptionFields ColorMode
-> Mod OptionFields ColorMode -> Mod OptionFields ColorMode
forall a. Semigroup a => a -> a -> a
<> [Char] -> Mod OptionFields ColorMode
forall (f :: * -> *) a. [Char] -> Mod f a
Opt.help [Char]
"Colorized output: auto, never or always."
          Mod OptionFields ColorMode
-> Mod OptionFields ColorMode -> Mod OptionFields ColorMode
forall a. Semigroup a => a -> a -> a
<> ColorMode -> Mod OptionFields ColorMode
forall (f :: * -> *) a. HasValue f => a -> Mod f a
Opt.value ColorMode
Ping.ColorAuto
          Mod OptionFields ColorMode
-> Mod OptionFields ColorMode -> Mod OptionFields ColorMode
forall a. Semigroup a => a -> a -> a
<> [Char] -> Mod OptionFields ColorMode
forall (f :: * -> *) a. HasMetavar f => [Char] -> Mod f a
Opt.metavar [Char]
"COLOR"
          Mod OptionFields ColorMode
-> Mod OptionFields ColorMode -> Mod OptionFields ColorMode
forall a. Semigroup a => a -> a -> a
<> (ColorMode -> [Char]) -> Mod OptionFields ColorMode
forall a (f :: * -> *). (a -> [Char]) -> Mod f a
Opt.showDefaultWith
            ( \case
                ColorMode
Ping.ColorAuto -> [Char]
"auto"
                ColorMode
Ping.ColorNever -> [Char]
"never"
                ColorMode
Ping.ColorAlways -> [Char]
"always"
            )
      )
    Parser (HashType -> PingOpts) -> Parser HashType -> Parser PingOpts
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> HashType -> HashType -> Mod FlagFields HashType -> Parser HashType
forall a. a -> a -> Mod FlagFields a -> Parser a
Opt.flag
      HashType
Ping.FullHash
      HashType
Ping.ShortHash
      ( [Char] -> Mod FlagFields HashType
forall (f :: * -> *) a. HasName f => [Char] -> Mod f a
Opt.long [Char]
"short-hash"
          Mod FlagFields HashType
-> Mod FlagFields HashType -> Mod FlagFields HashType
forall a. Semigroup a => a -> a -> a
<> [Char] -> Mod FlagFields HashType
forall (f :: * -> *) a. [Char] -> Mod f a
Opt.help [Char]
"show short tip's hash"
      )
 where
  pingMode :: Opt.ReadM Ping.PingMode
  pingMode :: ReadM PingMode
pingMode =
    ([Char] -> Either [Char] PingMode) -> ReadM PingMode
forall a. ([Char] -> Either [Char] a) -> ReadM a
Opt.eitherReader (([Char] -> Either [Char] PingMode) -> ReadM PingMode)
-> ([Char] -> Either [Char] PingMode) -> ReadM PingMode
forall a b. (a -> b) -> a -> b
$ \case
      [Char]
"tip" -> PingMode -> Either [Char] PingMode
forall a b. b -> Either a b
Right PingMode
Ping.TipMode
      [Char]
"ping" -> PingMode -> Either [Char] PingMode
forall a b. b -> Either a b
Right PingMode
Ping.PingMode
      [Char]
"query" -> PingMode -> Either [Char] PingMode
forall a b. b -> Either a b
Right PingMode
Ping.QueryMode
      [Char]
_ -> [Char] -> Either [Char] PingMode
forall a b. a -> Either a b
Left [Char]
"unexpected string"

  colorMode :: Opt.ReadM Ping.ColorMode
  colorMode :: ReadM ColorMode
colorMode =
    ([Char] -> Either [Char] ColorMode) -> ReadM ColorMode
forall a. ([Char] -> Either [Char] a) -> ReadM a
Opt.eitherReader (([Char] -> Either [Char] ColorMode) -> ReadM ColorMode)
-> ([Char] -> Either [Char] ColorMode) -> ReadM ColorMode
forall a b. (a -> b) -> a -> b
$ \case
      [Char]
"auto" -> ColorMode -> Either [Char] ColorMode
forall a b. b -> Either a b
Right ColorMode
Ping.ColorAuto
      [Char]
"never" -> ColorMode -> Either [Char] ColorMode
forall a b. b -> Either a b
Right ColorMode
Ping.ColorNever
      [Char]
"always" -> ColorMode -> Either [Char] ColorMode
forall a b. b -> Either a b
Right ColorMode
Ping.ColorAlways
      [Char]
_ -> [Char] -> Either [Char] ColorMode
forall a b. a -> Either a b
Left [Char]
"expected auto, never or always"

-- | A copy of @Cardano.Network.Ping.argParser@.
pPingAddresses :: Opt.Parser [Ping.Address (Ping.Unresolved Ping.SRVOrFilePathUnresolved)]
pPingAddresses :: Parser [Address (Unresolved SRVOrFilePathUnresolved)]
pPingAddresses =
  Parser (Address (Unresolved SRVOrFilePathUnresolved))
-> Parser [Address (Unresolved SRVOrFilePathUnresolved)]
forall a. Parser a -> Parser [a]
forall (f :: * -> *) a. Alternative f => f a -> f [a]
some Parser (Address (Unresolved SRVOrFilePathUnresolved))
pAddress
 where
  pAddress :: Opt.Parser (Ping.Address (Ping.Unresolved Ping.SRVOrFilePathUnresolved))
  pAddress :: Parser (Address (Unresolved SRVOrFilePathUnresolved))
pAddress =
    ReadM (Address (Unresolved SRVOrFilePathUnresolved))
-> Mod
     ArgumentFields (Address (Unresolved SRVOrFilePathUnresolved))
-> Parser (Address (Unresolved SRVOrFilePathUnresolved))
forall a. ReadM a -> Mod ArgumentFields a -> Parser a
Opt.argument
      ( (IP -> Word -> Address (Unresolved SRVOrFilePathUnresolved))
-> (IP, Word) -> Address (Unresolved SRVOrFilePathUnresolved)
forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry IP -> Word -> Address (Unresolved SRVOrFilePathUnresolved)
forall (stage :: Stage). IP -> Word -> Address stage
Ping.IP ((IP, Word) -> Address (Unresolved SRVOrFilePathUnresolved))
-> ReadM (IP, Word)
-> ReadM (Address (Unresolved SRVOrFilePathUnresolved))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ReadM (IP, Word)
readIPv4AndPort
          ReadM (Address (Unresolved SRVOrFilePathUnresolved))
-> ReadM (Address (Unresolved SRVOrFilePathUnresolved))
-> ReadM (Address (Unresolved SRVOrFilePathUnresolved))
forall a. ReadM a -> ReadM a -> ReadM a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> (IP -> Word -> Address (Unresolved SRVOrFilePathUnresolved))
-> (IP, Word) -> Address (Unresolved SRVOrFilePathUnresolved)
forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry IP -> Word -> Address (Unresolved SRVOrFilePathUnresolved)
forall (stage :: Stage). IP -> Word -> Address stage
Ping.IP ((IP, Word) -> Address (Unresolved SRVOrFilePathUnresolved))
-> ReadM (IP, Word)
-> ReadM (Address (Unresolved SRVOrFilePathUnresolved))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ReadM (IP, Word)
readIPv6AndPort
          ReadM (Address (Unresolved SRVOrFilePathUnresolved))
-> ReadM (Address (Unresolved SRVOrFilePathUnresolved))
-> ReadM (Address (Unresolved SRVOrFilePathUnresolved))
forall a. ReadM a -> ReadM a -> ReadM a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> ReadM (Address (Unresolved SRVOrFilePathUnresolved))
readDomainNameOrFilePath
      )
      ( [Char]
-> Mod
     ArgumentFields (Address (Unresolved SRVOrFilePathUnresolved))
forall (f :: * -> *) a. [Char] -> Mod f a
Opt.help
          [Char]
"List of IP/DNS/SRV address and ports or UNIX socket paths, e.g. 127.0.0.1:3001 [::1]:3001 example.org:3001."
          Mod ArgumentFields (Address (Unresolved SRVOrFilePathUnresolved))
-> Mod
     ArgumentFields (Address (Unresolved SRVOrFilePathUnresolved))
-> Mod
     ArgumentFields (Address (Unresolved SRVOrFilePathUnresolved))
forall a. Semigroup a => a -> a -> a
<> [Char]
-> Mod
     ArgumentFields (Address (Unresolved SRVOrFilePathUnresolved))
forall (f :: * -> *) a. HasMetavar f => [Char] -> Mod f a
Opt.metavar [Char]
"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 :: ReadM (IP, Word)
readIPv4AndPort =
    ([Char] -> Either [Char] (IP, Word)) -> ReadM (IP, Word)
forall a. ([Char] -> Either [Char] a) -> ReadM a
Opt.eitherReader (([Char] -> Either [Char] (IP, Word)) -> ReadM (IP, Word))
-> ([Char] -> Either [Char] (IP, Word)) -> ReadM (IP, Word)
forall a b. (a -> b) -> a -> b
$ \[Char]
s ->
      case Char -> [Char] -> Maybe ([Char], [Char])
splitWith Char
':' [Char]
s of
        Maybe ([Char], [Char])
Nothing -> [Char] -> Either [Char] (IP, Word)
forall a b. a -> Either a b
Left [Char]
s
        Just ([Char]
addrStr, [Char]
portStr) ->
          Either [Char] (IP, Word)
-> ((IP, Word) -> Either [Char] (IP, Word))
-> Maybe (IP, Word)
-> Either [Char] (IP, Word)
forall b a. b -> (a -> b) -> Maybe a -> b
maybe ([Char] -> Either [Char] (IP, Word)
forall a b. a -> Either a b
Left [Char]
s) (IP, Word) -> Either [Char] (IP, Word)
forall a b. b -> Either a b
Right (Maybe (IP, Word) -> Either [Char] (IP, Word))
-> Maybe (IP, Word) -> Either [Char] (IP, Word)
forall a b. (a -> b) -> a -> b
$
            (,)
              (IP -> Word -> (IP, Word))
-> Maybe IP -> Maybe (Word -> (IP, Word))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [Char] -> Maybe IP
forall a. Read a => [Char] -> Maybe a
readMaybe [Char]
addrStr
              Maybe (Word -> (IP, Word)) -> Maybe Word -> Maybe (IP, Word)
forall a b. Maybe (a -> b) -> Maybe a -> Maybe b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> [Char] -> Maybe Word
forall a. Read a => [Char] -> Maybe a
readMaybe [Char]
portStr

  -- parse IPv6 address and port in a form `[::1]:3001`
  readIPv6AndPort :: Opt.ReadM (IP, Word)
  readIPv6AndPort :: ReadM (IP, Word)
readIPv6AndPort =
    ([Char] -> Either [Char] (IP, Word)) -> ReadM (IP, Word)
forall a. ([Char] -> Either [Char] a) -> ReadM a
Opt.eitherReader (([Char] -> Either [Char] (IP, Word)) -> ReadM (IP, Word))
-> ([Char] -> Either [Char] (IP, Word)) -> ReadM (IP, Word)
forall a b. (a -> b) -> a -> b
$ \[Char]
s ->
      case [Char]
s of
        (Char
'[' : [Char]
s') ->
          case Char -> [Char] -> Maybe ([Char], [Char])
splitWith Char
']' [Char]
s' of
            Just ([Char]
addrStr, Char
':' : [Char]
portStr) ->
              Either [Char] (IP, Word)
-> ((IP, Word) -> Either [Char] (IP, Word))
-> Maybe (IP, Word)
-> Either [Char] (IP, Word)
forall b a. b -> (a -> b) -> Maybe a -> b
maybe ([Char] -> Either [Char] (IP, Word)
forall a b. a -> Either a b
Left [Char]
s) (IP, Word) -> Either [Char] (IP, Word)
forall a b. b -> Either a b
Right (Maybe (IP, Word) -> Either [Char] (IP, Word))
-> Maybe (IP, Word) -> Either [Char] (IP, Word)
forall a b. (a -> b) -> a -> b
$
                (,)
                  (IP -> Word -> (IP, Word))
-> Maybe IP -> Maybe (Word -> (IP, Word))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [Char] -> Maybe IP
forall a. Read a => [Char] -> Maybe a
readMaybe [Char]
addrStr
                  Maybe (Word -> (IP, Word)) -> Maybe Word -> Maybe (IP, Word)
forall a b. Maybe (a -> b) -> Maybe a -> Maybe b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> [Char] -> Maybe Word
forall a. Read a => [Char] -> Maybe a
readMaybe [Char]
portStr
            Maybe ([Char], [Char])
_ -> [Char] -> Either [Char] (IP, Word)
forall a b. a -> Either a b
Left [Char]
s
        [Char]
_ -> [Char] -> Either [Char] (IP, Word)
forall a b. a -> Either a b
Left [Char]
s

  readDomainNameOrFilePath
    :: Opt.ReadM (Ping.Address (Ping.Unresolved Ping.SRVOrFilePathUnresolved))
  readDomainNameOrFilePath :: ReadM (Address (Unresolved SRVOrFilePathUnresolved))
readDomainNameOrFilePath = ([Char]
 -> Either [Char] (Address (Unresolved SRVOrFilePathUnresolved)))
-> ReadM (Address (Unresolved SRVOrFilePathUnresolved))
forall a. ([Char] -> Either [Char] a) -> ReadM a
Opt.eitherReader (([Char]
  -> Either [Char] (Address (Unresolved SRVOrFilePathUnresolved)))
 -> ReadM (Address (Unresolved SRVOrFilePathUnresolved)))
-> ([Char]
    -> Either [Char] (Address (Unresolved SRVOrFilePathUnresolved)))
-> ReadM (Address (Unresolved SRVOrFilePathUnresolved))
forall a b. (a -> b) -> a -> b
$ Address (Unresolved SRVOrFilePathUnresolved)
-> Either [Char] (Address (Unresolved SRVOrFilePathUnresolved))
forall a b. b -> Either a b
Right (Address (Unresolved SRVOrFilePathUnresolved)
 -> Either [Char] (Address (Unresolved SRVOrFilePathUnresolved)))
-> ([Char] -> Address (Unresolved SRVOrFilePathUnresolved))
-> [Char]
-> Either [Char] (Address (Unresolved SRVOrFilePathUnresolved))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Char] -> Address (Unresolved SRVOrFilePathUnresolved)
Ping.mkAddress

  splitWith :: Char -> String -> Maybe (String, String)
  splitWith :: Char -> [Char] -> Maybe ([Char], [Char])
splitWith Char
c = [Char] -> [Char] -> Maybe ([Char], [Char])
go [Char]
""
   where
    go :: [Char] -> [Char] -> Maybe ([Char], [Char])
go [Char]
_ [] = Maybe ([Char], [Char])
forall a. Maybe a
Nothing
    go [Char]
acc (Char
a : [Char]
as)
      | Char
a Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
c = ([Char], [Char]) -> Maybe ([Char], [Char])
forall a. a -> Maybe a
Just ([Char] -> [Char]
forall a. [a] -> [a]
reverse [Char]
acc, [Char]
as)
      | Bool
otherwise = [Char] -> [Char] -> Maybe ([Char], [Char])
go (Char
a Char -> [Char] -> [Char]
forall a. a -> [a] -> [a]
: [Char]
acc) [Char]
as