making getAddrInfo polymorphic

haskell · Aug 31, 2024 · 152aea0 · 152aea0
1 parent 8c18f94
commit 152aea0
Show file tree

Hide file tree

Showing 6 changed files with 23 additions and 11 deletions.
diff --git a/Network/Socket.hs b/Network/Socket.hs
@@ -57,7 +57,7 @@
 -- >                 addrFlags = [AI_PASSIVE]
 -- >               , addrSocketType = Stream
 -- >               }
--- >         NE.head <$> getAddrInfoNE (Just hints) mhost (Just port)
+-- >         NE.head <$> getAddrInfo (Just hints) mhost (Just port)
 -- >     open addr = E.bracketOnError (openSocket addr) close $ \sock -> do
 -- >         setSocketOption sock ReuseAddr 1
 -- >         withFdSocket sock setCloseOnExecIfNeeded
@@ -97,7 +97,7 @@
 -- >   where
 -- >     resolve = do
 -- >         let hints = defaultHints { addrSocketType = Stream }
--- >         NE.head <$> getAddrInfoNE (Just hints) (Just host) (Just port)
+-- >         NE.head <$> getAddrInfo (Just hints) (Just host) (Just port)
 -- >     open addr = E.bracketOnError (openSocket addr) close $ \sock -> do
 -- >         connect sock $ addrAddress addr
 -- >         return sock
@@ -112,8 +112,7 @@ module Network.Socket (
     withSocketsDo,
 
     -- * Address information
-    getAddrInfo,
-    getAddrInfoNE,
+    GetAddrInfo (..),
 
     -- ** Types
     HostName,

diff --git a/Network/Socket/Info.hsc b/Network/Socket/Info.hsc
@@ -201,6 +201,19 @@ defaultHints = AddrInfo {
   , addrCanonName  = Nothing
   }
 
+class GetAddrInfo t where
+    getAddrInfo
+        :: Maybe AddrInfo -- ^ preferred socket type or protocol
+        -> Maybe HostName -- ^ host name to look up
+        -> Maybe ServiceName -- ^ service name to look up
+        -> IO (t AddrInfo) -- ^ resolved addresses, with "best" first
+
+instance GetAddrInfo [] where
+    getAddrInfo = getAddrInfoList
+
+instance GetAddrInfo NE.NonEmpty where
+    getAddrInfo = getAddrInfoNE
+
 -----------------------------------------------------------------------------
 -- | Resolve a host or service name to one or more addresses.
 -- The 'AddrInfo' values that this function returns contain 'SockAddr'
@@ -242,12 +255,12 @@ defaultHints = AddrInfo {
 -- >>> addrAddress addr
 -- 127.0.0.1:80
 
-getAddrInfo
+getAddrInfoList
     :: Maybe AddrInfo -- ^ preferred socket type or protocol
     -> Maybe HostName -- ^ host name to look up
     -> Maybe ServiceName -- ^ service name to look up
     -> IO [AddrInfo] -- ^ resolved addresses, with "best" first
-getAddrInfo hints node service = alloc getaddrinfo
+getAddrInfoList hints node service = alloc getaddrinfo
   where
     alloc body = withSocketsDo $ maybeWith withCString node $ \c_node ->
         maybeWith withCString service                       $ \c_service ->

diff --git a/examples/EchoClient.hs b/examples/EchoClient.hs
@@ -24,7 +24,7 @@ runTCPClient host port client = withSocketsDo $ do
   where
     resolve = do
         let hints = defaultHints{addrSocketType = Stream}
-        NE.head <$> getAddrInfoNE (Just hints) (Just host) (Just port)
+        NE.head <$> getAddrInfo (Just hints) (Just host) (Just port)
     open addr = E.bracketOnError (openSocket addr) close $ \sock -> do
         connect sock $ addrAddress addr
         return sock
diff --git a/examples/EchoServer.hs b/examples/EchoServer.hs
@@ -30,7 +30,7 @@ runTCPServer mhost port server = withSocketsDo $ do
                     { addrFlags = [AI_PASSIVE]
                     , addrSocketType = Stream
                     }
-        NE.head <$> getAddrInfoNE (Just hints) mhost (Just port)
+        NE.head <$> getAddrInfo (Just hints) mhost (Just port)
     open addr = E.bracketOnError (openSocket addr) close $ \sock -> do
         setSocketOption sock ReuseAddr 1
         withFdSocket sock setCloseOnExecIfNeeded

diff --git a/tests/Network/SocketSpec.hs b/tests/Network/SocketSpec.hs
@@ -118,7 +118,7 @@ spec = do
 
         it "does not cause segfault on macOS 10.8.2 due to AI_NUMERICSERV" $ do
             let hints = defaultHints { addrFlags = [AI_NUMERICSERV] }
-            void $ getAddrInfo (Just hints) (Just "localhost") Nothing
+            void (getAddrInfo (Just hints) (Just "localhost") Nothing :: IO [AddrInfo])
 
 #if defined(mingw32_HOST_OS)
     let lpdevname = "loopback_0"

diff --git a/tests/Network/Test/Common.hs b/tests/Network/Test/Common.hs
@@ -245,7 +245,7 @@ bracketWithReraise tid setup teardown thing =
 
 resolveClient :: SocketType -> HostName -> PortNumber -> IO AddrInfo
 resolveClient socketType host port =
-    NE.head <$> getAddrInfoNE (Just hints) (Just host) (Just $ show port)
+    NE.head <$> getAddrInfo (Just hints) (Just host) (Just $ show port)
   where
     hints = defaultHints {
         addrSocketType = socketType
@@ -254,7 +254,7 @@ resolveClient socketType host port =
 
 resolveServer :: SocketType -> HostName -> IO AddrInfo
 resolveServer socketType host =
-    NE.head <$> getAddrInfoNE (Just hints) (Just host) Nothing
+    NE.head <$> getAddrInfo (Just hints) (Just host) Nothing
   where
     hints = defaultHints {
         addrSocketType = socketType