Implement total Show functions for SockAddr

The previous implementation of show used unsafePerformIO and
getNameInfo. getNameInfo depends on show SockAddr incase of a failure.

The showHostAddress and showHostAddress6 are based on showIPv4 and
showIPv6 in the iproute package.

Author: karknu

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..]