Moved readIPAndPort parser to ouroboros-network

Author: coot

cardano-diffusion/lib/Cardano/Network/Diffusion.hs

@@ -14,6 +14,8 @@
 module Cardano.Network.Diffusion
   ( module Cardano.Network.Diffusion.Types
   , run
+    -- * Utils
+  , Diffusion.readIPAndPort
   ) where
 
 import Control.DeepSeq (NFData)

cardano-diffusion/ping/Cardano/Network/Ping.hs

@@ -108,6 +108,7 @@ import System.IO qualified as IO
 import System.Random (initStdGen)
 import Text.Read (readMaybe)
 
+import Cardano.Network.Diffusion (readIPAndPort)
 import Cardano.Network.Diffusion.Configuration (defaultChainSyncIdleTimeout)
 import Cardano.Network.NodeToClient qualified as NodeToClient
 import Cardano.Network.NodeToClient.Version
@@ -147,7 +148,7 @@ data PingMode =
     -- ^ query handshake parameters
   deriving (Eq, Show)
 
-type Port = Word
+type Port = Socket.PortNumber
 
 -- | There are three stages for resolving addresses.
 --
@@ -335,43 +336,13 @@ argParser =
     addrParser :: Parser (Address (Unresolved SRVOrFilePathUnresolved))
     addrParser =
         argument
-          (     uncurry IP <$> readIPv4AndPort
-            <|> uncurry IP <$> readIPv6AndPort
+          (     uncurry IP <$> readIPAndPort
             <|>                readDomainNameOrFilePath
           )
           (  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."
           <> metavar "ADDRS"
           )
       where
-        -- 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 :: ReadM (IP, Port)
-        readIPv4AndPort =
-          eitherReader $ \s -> do
-            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` or a UNIX file path
-        readIPv6AndPort :: ReadM (IP, Port)
-        readIPv6AndPort =
-          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 :: ReadM (Address (Unresolved SRVOrFilePathUnresolved))
         readDomainNameOrFilePath = eitherReader $ Right . mkAddress
 
@@ -418,7 +389,7 @@ instance Exception AddressResolutionError where
 -- | Log messages to stderr.
 --
 data PingWarning = AddressResolutionError AddressResolutionError
-                 | DNSResolution DNS.Domain [IP] Word
+                 | DNSResolution DNS.Domain [IP] Port
                  | Error SomeException
                  | ConnectError SockAddr SomeException
 

ouroboros-network/lib/Ouroboros/Network/Diffusion.hs

@@ -17,6 +17,8 @@ module Ouroboros.Network.Diffusion
   , mkInterfaces
   , socketAddressType
   , module Ouroboros.Network.Diffusion.Types
+  -- * Utils
+  , readIPAndPort
   ) where
 
 

ouroboros-network/lib/Ouroboros/Network/Diffusion/Utils.hs

@@ -9,20 +9,73 @@
 module Ouroboros.Network.Diffusion.Utils
   ( withSockets
   , withLocalSocket
+  , readIPAndPort
   ) where
 
 
+import Control.Applicative ((<|>))
 import Control.Monad.Class.MonadThrow
 import Control.Tracer (Tracer, traceWith)
+import Data.Bifunctor (first)
+import Data.IP (IP (..), IPv4, IPv6)
 import Data.List.NonEmpty (NonEmpty (..))
 import Data.List.NonEmpty qualified as NonEmpty
 import Data.Typeable (Typeable)
+import Network.Socket (PortNumber)
+import Options.Applicative (ReadM, eitherReader)
+import Text.Read (readMaybe)
 
 import Ouroboros.Network.Snocket (FileDescriptor, Snocket)
 import Ouroboros.Network.Snocket qualified as Snocket
 
 import Ouroboros.Network.Diffusion.Types
 
+
+-- | optparse-applictive parser for `IPv4:Port` or `IPv6:Port`.
+--
+-- note: `Read` instances for `IP`, `IPv4`, `IPv6` expect no trailing characters
+-- after the address, thus we need custom parser which finds the split position
+-- first.
+readIPAndPort :: ReadM (IP, PortNumber)
+readIPAndPort = (first IPv4 <$> readIPv4AndPort)
+            <|> (first IPv6 <$> readIPv6AndPort)
+  where
+    readIPv4AndPort :: ReadM (IPv4, PortNumber)
+    readIPv4AndPort =
+      eitherReader $ \s -> do
+        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` or a UNIX file path
+    readIPv6AndPort :: ReadM (IPv6, PortNumber)
+    readIPv6AndPort =
+      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
+
+    splitWith :: Char -> String -> Maybe (String, String)
+    splitWith c = go ""
+        where
+          go _ []
+            = Nothing
+          go !acc (a:as)
+            | a == c
+            = Just (reverse acc, as)
+          go !acc (a:as)
+            = go (a:acc) as
+
 --
 -- Socket utility functions
 --

ouroboros-network/ouroboros-network.cabal

@@ -31,6 +31,11 @@ flag nightly
   manual: False
   default: False
 
+flag optparse-applicative-fork
+  description: Use optparse-applicative-fork
+  manual: True
+  default: False
+
 source-repository head
   type: git
   location: https://github.com/intersectmbo/ouroboros-network
@@ -335,6 +340,15 @@ library
       directory,
       unix,
 
+  -- Until https://github.com/IntersectMBO/cardano-cli/pull/1390 is merged we
+  -- need to allow for `optparse-applicative-fork`
+  if flag(optparse-applicative-fork)
+    build-depends:
+      optparse-applicative-fork
+  else
+    build-depends:
+      optparse-applicative
+
 library framework
   import: ghc-options
   visibility: public