Merge PR #441

Author: kazu-yamamoto

Network/Socket/Info.hsc

@@ -10,7 +10,6 @@ module Network.Socket.Info where
 
 import Foreign.Marshal.Alloc (alloca, allocaBytes)
 import Foreign.Marshal.Utils (maybeWith, with)
-import GHC.IO (unsafePerformIO)
 import GHC.IO.Exception (IOErrorType(NoSuchThing))
 import System.IO.Error (ioeSetErrorString, mkIOError)
 
@@ -441,16 +440,50 @@ instance Show SockAddr where
 #else
   showsPrec _ SockAddrUnix{} = error "showsPrec: not supported"
 #endif
-  showsPrec _ addr@(SockAddrInet port _)
-   = showString (unsafePerformIO $
-                 fst <$> getNameInfo [NI_NUMERICHOST] True False addr >>=
-                 maybe (fail "showsPrec: impossible internal error") return)
+  showsPrec _ (SockAddrInet port ha)
+   = showHostAddress ha
    . showString ":"
    . shows port
-  showsPrec _ addr@(SockAddrInet6 port _ _ _)
+  showsPrec _ (SockAddrInet6 port _ ha6 _)
    = showChar '['
-   . showString (unsafePerformIO $
-                 fst <$> getNameInfo [NI_NUMERICHOST] True False addr >>=
-                 maybe (fail "showsPrec: impossible internal error") return)
+   . showHostAddress6 ha6
    . showString "]:"
    . shows port
+
+
+-- Taken from on the implementation of showIPv4 in Data.IP.Addr
+showHostAddress :: HostAddress -> ShowS
+showHostAddress ip =
+  let (u3, u2, u1, u0) = hostAddressToTuple ip in
+  foldr1 (.) . intersperse (showChar '.') $ map showInt [u3, u2, u1, u0]
+
+-- Taken from showIPv6 in Data.IP.Addr.
+
+-- | Show an IPv6 address in the most appropriate notation, based on recommended
+-- representation proposed by <http://tools.ietf.org/html/rfc5952 RFC 5952>.
+--
+-- /The implementation is completely compatible with the current implementation
+-- of the `inet_ntop` function in glibc./
+showHostAddress6 :: HostAddress6 -> ShowS
+showHostAddress6 ha6@(a1, a2, a3, a4)
+    -- IPv4-Mapped IPv6 Address
+    | a1 == 0 && a2 == 0 && a3 == 0xffff =
+      showString "::ffff:" . showHostAddress a4
+    -- IPv4-Compatible IPv6 Address (exclude IPRange ::/112)
+    | a1 == 0 && a2 == 0 && a3 == 0 && a4 >= 0x10000 =
+        showString "::" . showHostAddress a4
+    -- length of longest run > 1, replace it with "::"
+    | end - begin > 1 =
+        showFields prefix . showString "::" . showFields suffix
+    | otherwise =
+        showFields fields
+  where
+    fields =
+        let (u7, u6, u5, u4, u3, u2, u1, u0) = hostAddress6ToTuple ha6 in
+        [u7, u6, u5, u4, u3, u2, u1, u0]
+    showFields = foldr (.) id . intersperse (showChar ':') . map showHex
+    prefix = take begin fields  -- fields before "::"
+    suffix = drop end fields    -- fields after "::"
+    begin = end + diff          -- the longest run of zeros
+    (diff, end) = minimum $
+        scanl (\c i -> if i == 0 then c - 1 else 0) 0 fields `zip` [0..]

tests/Network/SocketSpec.hs

@@ -219,3 +219,53 @@ spec = do
                     s <- mkSocket fd
                     sendAll s "HELLO WORLD"
             tcpTest client server
+
+    describe "getNameInfo" $ do
+        it "works for IPv4 address" $ do
+            let addr = SockAddrInet 80 (tupleToHostAddress (127, 0, 0, 1))
+            (hn_m, sn_m) <- getNameInfo [NI_NUMERICHOST, NI_NUMERICSERV] True True addr
+
+            hn_m `shouldBe` (Just "127.0.0.1")
+            sn_m `shouldBe` (Just "80")
+
+        it "works for IPv6 address" $ do
+            let addr = SockAddrInet6 80 0
+                           (tupleToHostAddress6 (0x2001, 0x0db8, 0x2, 0x3, 0x4, 0x5, 0x6, 0x7)) 0
+            (hn_m, sn_m) <- getNameInfo [NI_NUMERICHOST, NI_NUMERICSERV] True True addr
+            hn_m `shouldBe`(Just "2001:db8:2:3:4:5:6:7")
+            sn_m `shouldBe` (Just "80")
+
+        it "works for IPv6 address" $ do
+            let addr = SockAddrInet6 80 0
+                           (tupleToHostAddress6 (0x2001, 0x0db8, 0x2, 0x3, 0x4, 0x5, 0x6, 0x7)) 0
+            (hn_m, sn_m) <- getNameInfo [NI_NUMERICHOST, NI_NUMERICSERV] True True addr
+            hn_m `shouldBe`(Just "2001:db8:2:3:4:5:6:7")
+            sn_m `shouldBe` (Just "80")
+
+        it "works for global multicast IPv6 address" $ do
+            let addr = SockAddrInet6 80 0
+                           (tupleToHostAddress6 (0xfe01, 0x0db8, 0x2, 0x3, 0x4, 0x5, 0x6, 0x7)) 0
+            (hn_m, sn_m) <- getNameInfo [NI_NUMERICHOST, NI_NUMERICSERV] True True addr
+            hn_m `shouldBe`(Just "fe01:db8:2:3:4:5:6:7")
+            sn_m `shouldBe` (Just "80")
+
+    describe "show SocketAddr" $ do
+        it "works for IPv4 address" $
+            let addr = SockAddrInet 80 (tupleToHostAddress (127, 0, 0, 1)) in
+            show addr `shouldBe` "127.0.0.1:80"
+
+        it "works for IPv6 address" $
+            let addr = SockAddrInet6 80 0
+                           (tupleToHostAddress6 (0x2001, 0x0db8, 0x2, 0x3, 0x4, 0x5, 0x6, 0x7)) 0 in
+            show addr `shouldBe` "[2001:db8:2:3:4:5:6:7]:80"
+
+        it "works for IPv6 address with zeros" $
+            let addr = SockAddrInet6 80 0
+                           (tupleToHostAddress6 (0x2001, 0x0db8, 0x2, 0x3, 0x0, 0x0, 0x0, 0x7)) 0 in
+            show addr `shouldBe` "[2001:db8:2:3::7]:80"
+
+        it "works for multicast IPv6 address with reserved scope" $ do
+            let addr = SockAddrInet6 80 0
+                           (tupleToHostAddress6 (0xff01, 0x1234, 0x2, 0x3, 0x4, 0x5, 0x6, 0x7)) 0
+            show addr `shouldBe` "[ff01:1234:2:3:4:5:6:7]:80"
+