Conversions between HostAddress(6) and endianness-independent tuples

Network/Socket.hsc

@@ -36,11 +36,17 @@ module Network.Socket
  , isSupportedSockAddr
  , SocketStatus(..)
  , HostAddress
+ , hostAddressToTuple
+ , tupleToHostAddress
 #if defined(IPV6_SOCKET_SUPPORT)
  , HostAddress6
+ , hostAddress6ToTuple
+ , tupleToHostAddress6
  , FlowInfo
  , ScopeID
 #endif
+ , htonl
+ , ntohl
  , ShutdownCmd(..)
  , ProtocolNumber
  , defaultProtocol
@@ -1021,7 +1027,10 @@ aNY_PORT = 0
 iNADDR_ANY :: HostAddress
 iNADDR_ANY = htonl (#const INADDR_ANY)
 
+-- | Converts the from host byte order to network byte order.
 foreign import CALLCONV unsafe "htonl" htonl :: Word32 -> Word32
+-- | Converts the from network byte order to host byte order.
+foreign import CALLCONV unsafe "ntohl" ntohl :: Word32 -> Word32
 
 #if defined(IPV6_SOCKET_SUPPORT)
 -- | The IPv6 wild card address.

Network/Socket/Types.hsc

@@ -34,8 +34,12 @@ module Network.Socket.Types
  , SockAddr(..)
  , isSupportedSockAddr
  , HostAddress
+ , hostAddressToTuple
+ , tupleToHostAddress
 #if defined(IPV6_SOCKET_SUPPORT)
  , HostAddress6
+ , hostAddress6ToTuple
+ , tupleToHostAddress6
  , FlowInfo
  , ScopeID
 #endif
@@ -756,7 +760,8 @@ portNumberToInt (PortNum po) = fromIntegral (ntohs po)
 
 foreign import CALLCONV unsafe "ntohs" ntohs :: Word16 -> Word16
 foreign import CALLCONV unsafe "htons" htons :: Word16 -> Word16
---foreign import CALLCONV unsafe "ntohl" ntohl :: Word32 -> Word32
+foreign import CALLCONV unsafe "ntohl" ntohl :: Word32 -> Word32
+foreign import CALLCONV unsafe "htonl" htonl :: Word32 -> Word32
 
 instance Enum PortNumber where
  toEnum = intToPortNumber
@@ -989,13 +994,52 @@ peekSockAddr p = do
 
 ------------------------------------------------------------------------
 
--- | Network byte order.
+-- | The raw network byte order number is read using host byte order.
+-- Therefore on little-endian architectures the byte order is swapped. For
+-- example @127.0.0.1@ is represented as @0x0100007f@ on little-endian hosts
+-- and as @0x7f000001@ on big-endian hosts.
+--
+-- For direct manipulation prefer 'hostAddressToTuple' and
+-- 'tupleToHostAddress'.
 type HostAddress = Word32
 
+-- | Converts 'HostAddress' to representation-independent IPv4 quadruple.
+-- For example for @127.0.0.1@ the function will return @(0x7f, 0, 0, 1)@
+-- regardless of host endianness.
+hostAddressToTuple :: HostAddress -> (Word8, Word8, Word8, Word8)
+hostAddressToTuple ha' =
+ let ha = htonl ha'
+ byte i = fromIntegral (ha `shiftR` i) :: Word8
+ in (byte 24, byte 16, byte 8, byte 0)
+
+-- | Converts IPv4 quadruple to 'HostAddress'.
+tupleToHostAddress :: (Word8, Word8, Word8, Word8) -> HostAddress
+tupleToHostAddress (b3, b2, b1, b0) =
+ let x `sl` i = fromIntegral x `shiftL` i :: Word32
+ in ntohl $ (b3 `sl` 24) .|. (b2 `sl` 16) .|. (b1 `sl` 8) .|. (b0 `sl` 0)
+
 #if defined(IPV6_SOCKET_SUPPORT)
--- | Host byte order.
+-- | Independent of endianness. For example @::1@ is stored as @(0, 0, 0, 1)@.
+--
+-- For direct manipulation prefer 'hostAddress6ToTuple' and
+-- 'tupleToHostAddress6'.
 type HostAddress6 = (Word32, Word32, Word32, Word32)
 
+hostAddress6ToTuple :: HostAddress6 -> (Word16, Word16, Word16, Word16,
+ Word16, Word16, Word16, Word16)
+hostAddress6ToTuple (w3, w2, w1, w0) =
+ let high, low :: Word32 -> Word16
+ high w = fromIntegral (w `shiftR` 16)
+ low w = fromIntegral w
+ in (high w3, low w3, high w2, low w2, high w1, low w1, high w0, low w0)
+
+tupleToHostAddress6 :: (Word16, Word16, Word16, Word16,
+ Word16, Word16, Word16, Word16) -> HostAddress6
+tupleToHostAddress6 (w7, w6, w5, w4, w3, w2, w1, w0) =
+ let add :: Word16 -> Word16 -> Word32
+ high `add` low = (fromIntegral high `shiftL` 16) .|. (fromIntegral low)
+ in (w7 `add` w6, w5 `add` w4, w3 `add` w2, w1 `add` w0)
+
 -- The peek32 and poke32 functions work around the fact that the RFCs
 -- don't require 32-bit-wide address fields to be present. We can
 -- only portably rely on an 8-bit field, s6_addr.

tests/Simple.hs

@@ -229,6 +229,41 @@ canTest ifname clientAct serverAct = do
  serverSetup = clientSetup
 #endif
 
+------------------------------------------------------------------------
+-- Conversions of IP addresses
+
+testHostAddressToTuple :: Assertion
+testHostAddressToTuple = do
+ -- Look up a numeric IPv4 host
+ let hints = defaultHints { addrFlags = [AI_NUMERICHOST, AI_ADDRCONFIG] }
+ (AddrInfo{addrAddress = (SockAddrInet _ hostAddr)} : _) <-
+ getAddrInfo (Just hints) (Just "127.128.129.130") Nothing
+ -- and check that the decoded address matches the expected representation
+ (0x7f, 0x80, 0x81, 0x82) @=? hostAddressToTuple hostAddr
+
+testHostAddressToTupleInv :: Assertion
+testHostAddressToTupleInv = do
+ let addr = (0x7f, 0x80, 0x81, 0x82)
+ addr @=? (hostAddressToTuple . tupleToHostAddress) addr
+
+#if defined(IPV6_SOCKET_SUPPORT)
+testHostAddress6ToTuple :: Assertion
+testHostAddress6ToTuple = do
+ -- Look up a numeric IPv6 host
+ let hints = defaultHints { addrFlags = [AI_NUMERICHOST, AI_ADDRCONFIG] }
+ host = "2001:0db8:85a3:0000:0000:8a2e:0370:7334"
+ (AddrInfo{addrAddress = (SockAddrInet6 _ _ hostAddr _)} : _) <-
+ getAddrInfo (Just hints) (Just host) Nothing
+ -- and check that the decoded address matches the expected representation
+ (0x2001, 0x0db8, 0x85a3, 0x0000, 0x0000, 0x8a2e, 0x0370, 0x7334)
+ @=? hostAddress6ToTuple hostAddr
+
+testHostAddress6ToTupleInv :: Assertion
+testHostAddress6ToTupleInv = do
+ let addr = (0x2001, 0x0db8, 0x85a3, 0x0000, 0x0000, 0x8a2e, 0x0370, 0x7334)
+ addr @=? (hostAddress6ToTuple . tupleToHostAddress6) addr
+#endif
+
 ------------------------------------------------------------------------
 -- Other
 
@@ -255,6 +290,14 @@ basicTests = testGroup "Basic socket operations"
 #if defined(HAVE_LINUX_CAN_H)
  , testCase "testCanSend" testCanSend
 #endif
+ -- conversions of IP addresses
+ , testCase "testHostAddressToTuple" testHostAddressToTuple
+ , testCase "testHostAddressToTupleInv" testHostAddressToTupleInv
+#if defined(IPV6_SOCKET_SUPPORT)
+ , testCase "testHostAddress6ToTuple" testHostAddress6ToTuple
+ , testCase "testHostAddress6ToTupleInv" testHostAddress6ToTupleInv
+#endif
+ -- other
  ]
 
 tests :: [Test]