module System.Socket.Family.Inet
(
Inet
, InetAddress
, InetPort
, SocketAddress (SocketAddressInet, inetAddress, inetPort)
, inetAddressFromTuple
, inetAddressToTuple
, inetAllHostsGroup
, inetAny
, inetBroadcast
, inetLoopback
, inetMaxLocalGroup
, inetNone
, inetUnspecificGroup
) where
import Data.Word
import Data.List
import Foreign.Ptr
import Foreign.Storable
import System.Socket.Internal.Socket
import System.Socket.Internal.Platform
data Inet
instance Family Inet where
familyNumber _ = (2)
data instance SocketAddress Inet
= SocketAddressInet
{ inetAddress :: InetAddress
, inetPort :: InetPort
} deriving (Eq, Show)
newtype InetAddress
= InetAddress Word32
deriving (Eq)
newtype InetPort = InetPort Word16
deriving (Eq, Ord, Show, Num)
inetAddressFromTuple :: (Word8, Word8, Word8, Word8) -> InetAddress
inetAddressFromTuple (w0, w1, w2, w3)
= InetAddress $ foldl1' (\x y->x*256+y) [f w0, f w1, f w2, f w3]
where
f = fromIntegral
inetAddressToTuple :: InetAddress -> (Word8, Word8, Word8, Word8)
inetAddressToTuple (InetAddress a)
= (w0, w1, w2, w3)
where
w0 = fromIntegral $ rem (quot a $ 256*256*256) 256
w1 = fromIntegral $ rem (quot a $ 256*256) 256
w2 = fromIntegral $ rem (quot a $ 256) 256
w3 = fromIntegral $ rem a $ 256
inetAny :: InetAddress
inetAny = InetAddress $ 0
inetBroadcast :: InetAddress
inetBroadcast = InetAddress $ foldl1' (\x y->x*256+y) [255,255,255,255]
inetNone :: InetAddress
inetNone = InetAddress $ foldl1' (\x y->x*256+y) [255,255,255,255]
inetLoopback :: InetAddress
inetLoopback = InetAddress $ foldl1' (\x y->x*256+y) [127, 0, 0, 1]
inetUnspecificGroup :: InetAddress
inetUnspecificGroup = InetAddress $ foldl1' (\x y->x*256+y) [224, 0, 0, 0]
inetAllHostsGroup :: InetAddress
inetAllHostsGroup = InetAddress $ foldl1' (\x y->x*256+y) [224, 0, 0, 1]
inetMaxLocalGroup :: InetAddress
inetMaxLocalGroup = InetAddress $ foldl1' (\x y->x*256+y) [224, 0, 0,255]
instance Show InetAddress where
show (InetAddress a) = ("InetAddress " ++)
$ concat
$ intersperse "."
$ map (\p-> show $ a `div` 256^p `mod` 256) [3,2,1,0 :: Word32]
instance Storable InetPort where
sizeOf _ = ((2))
alignment _ = (2)
peek ptr = do
p0 <- peekByteOff ptr 0 :: IO Word8
p1 <- peekByteOff ptr 1 :: IO Word8
return $ InetPort (fromIntegral p0 * 256 + fromIntegral p1)
poke ptr (InetPort w16) = do
pokeByteOff ptr 0 (w16_0 w16)
pokeByteOff ptr 1 (w16_1 w16)
where
w16_0, w16_1 :: Word16 -> Word8
w16_0 x = fromIntegral $ rem (quot x 256) 256
w16_1 x = fromIntegral $ rem x 256
instance Storable InetAddress where
sizeOf _ = ((4))
alignment _ = (4)
peek ptr = do
i0 <- peekByteOff ptr 0 :: IO Word8
i1 <- peekByteOff ptr 1 :: IO Word8
i2 <- peekByteOff ptr 2 :: IO Word8
i3 <- peekByteOff ptr 3 :: IO Word8
return $ InetAddress $ (((((f i0 * 256) + f i1) * 256) + f i2) * 256) + f i3
where
f = fromIntegral
poke ptr (InetAddress a) = do
pokeByteOff ptr 0 (fromIntegral $ rem (quot a $ 256*256*256) 256 :: Word8)
pokeByteOff ptr 1 (fromIntegral $ rem (quot a $ 256*256) 256 :: Word8)
pokeByteOff ptr 2 (fromIntegral $ rem (quot a $ 256) 256 :: Word8)
pokeByteOff ptr 3 (fromIntegral $ rem a $ 256 :: Word8)
instance Storable (SocketAddress Inet) where
sizeOf _ = ((16))
alignment _ = (4)
peek ptr = do
a <- peek (sin_addr ptr)
p <- peek (sin_port ptr)
return $ SocketAddressInet a p
where
sin_addr = ((\hsc_ptr -> hsc_ptr `plusPtr` 0)) . ((\hsc_ptr -> hsc_ptr `plusPtr` 4))
sin_port = ((\hsc_ptr -> hsc_ptr `plusPtr` 2))
poke ptr (SocketAddressInet a p) = do
c_memset ptr 0 (16)
poke (sin_family ptr) ((2) :: Word16)
poke (sin_addr ptr) a
poke (sin_port ptr) p
where
sin_family = ((\hsc_ptr -> hsc_ptr `plusPtr` 0))
sin_addr = ((\hsc_ptr -> hsc_ptr `plusPtr` 0)) . ((\hsc_ptr -> hsc_ptr `plusPtr` 4))
sin_port = ((\hsc_ptr -> hsc_ptr `plusPtr` 2))