{-# LINE 1 "src/System/Socket/Family/Inet.hsc" #-}
{-# LANGUAGE TypeFamilies, FlexibleInstances, GeneralizedNewtypeDeriving #-}
--------------------------------------------------------------------------------
-- |
-- Module      :  System.Socket.Family.Inet
-- Copyright   :  (c) Lars Petersen 2015
-- License     :  MIT
--
-- Maintainer  :  info@lars-petersen.net
-- Stability   :  experimental
--------------------------------------------------------------------------------
module System.Socket.Family.Inet
  ( -- * Inet
    Inet
    -- ** InetAddress
  , InetAddress
    -- ** InetPort
  , InetPort
  , SocketAddress (SocketAddressInet, inetAddress, inetPort)
  -- * Custom addresses
  -- ** inetAddressFromTuple
  , inetAddressFromTuple
  -- ** inetAddressToTuple
  , inetAddressToTuple
  -- * Special addresses
  -- ** inetAllHostsGroup
  , inetAllHostsGroup
  -- ** inetAny
  , inetAny
  -- ** inetBroadcast
  , inetBroadcast
  -- ** inetLoopback
  , inetLoopback
  -- ** inetMaxLocalGroup
  , inetMaxLocalGroup
  -- ** inetNone
  , inetNone
  -- ** inetUnspecificGroup
  , inetUnspecificGroup
  ) where

import Data.Word
import Data.List

import Foreign.Ptr
import Foreign.Storable

import System.Socket.Internal.Socket
import System.Socket.Internal.Platform




{-# LINE 55 "src/System/Socket/Family/Inet.hsc" #-}

-- | The [Internet Protocol version 4](https://en.wikipedia.org/wiki/IPv4).
data Inet

instance Family Inet where
  familyNumber _ = (2)
{-# LINE 61 "src/System/Socket/Family/Inet.hsc" #-}
  -- | An [IPv4](https://en.wikipedia.org/wiki/IPv4) socket address.
  --
  --   The socket address contains a port number that may be used by transport
  --   protocols like [TCP](https://en.wikipedia.org/wiki/Transmission_Control_Protocol).
  --
  -- > SocketAddressInet inetLoopback 8080
  data SocketAddress Inet
     = SocketAddressInet
       { inetAddress   :: InetAddress
       , inetPort      :: InetPort
       } deriving (Eq, Show)

-- | To avoid errors with endianess it was decided to keep this type abstract.
--
--   Use `inetAddressFromTuple` and `inetAddressToTuple` for constructing and
--   deconstructing custom addresses.
--
--   Hint: Use the `Foreign.Storable.Storable` instance.
--   It exposes it exactly as found within an IP packet (big endian if you insist
--   on interpreting it as a number).
--
--   Another hint: Use `System.Socket.getAddressInfo` for parsing and suppress
--   nameserver lookups:
--
--   > > getAddressInfo (Just "127.0.0.1") Nothing aiNumericHost :: IO [AddressInfo Inet Stream TCP]
--   > [AddressInfo {addressInfoFlags = AddressInfoFlags 4, socketAddress = SocketAddressInet {inetAddress = InetAddress 127.0.0.1, inetPort = InetPort 0}, canonicalName = Nothing}]
newtype InetAddress
      = InetAddress Word32
      deriving (Eq)

newtype InetPort = InetPort Word16
      deriving (Eq, Ord, Show, Num, Real, Enum, Integral)

-- | Constructs a custom `InetAddress`.
--
--   > inetAddressFromTuple (127,0,0,1) == inetLoopback
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

-- | Deconstructs an `InetAddress`.
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

-- | @0.0.0.0@
inetAny             :: InetAddress
inetAny              = InetAddress $ 0

-- | @255.255.255.255@
inetBroadcast       :: InetAddress
inetBroadcast        = InetAddress $ foldl1' (\x y->x*256+y) [255,255,255,255]

-- | @255.255.255.255@
inetNone            :: InetAddress
inetNone             = InetAddress $ foldl1' (\x y->x*256+y) [255,255,255,255]

-- | @127.0.0.1@
inetLoopback        :: InetAddress
inetLoopback         = InetAddress $ foldl1' (\x y->x*256+y) [127,  0,  0,  1]

-- | @224.0.0.0@
inetUnspecificGroup :: InetAddress
inetUnspecificGroup  = InetAddress $ foldl1' (\x y->x*256+y) [224,  0,  0,  0]

-- | @224.0.0.1@
inetAllHostsGroup   :: InetAddress
inetAllHostsGroup    = InetAddress $ foldl1' (\x y->x*256+y) [224,  0,  0,  1]

-- | @224.0.0.255@
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))
{-# LINE 149 "src/System/Socket/Family/Inet.hsc" #-}
  alignment _ = (2)
{-# LINE 150 "src/System/Socket/Family/Inet.hsc" #-}
  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))
{-# LINE 164 "src/System/Socket/Family/Inet.hsc" #-}
  alignment _ = (4)
{-# LINE 165 "src/System/Socket/Family/Inet.hsc" #-}
  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))
{-# LINE 181 "src/System/Socket/Family/Inet.hsc" #-}
  alignment _ = (4)
{-# LINE 182 "src/System/Socket/Family/Inet.hsc" #-}
  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))
{-# LINE 188 "src/System/Socket/Family/Inet.hsc" #-}
      sin_port     = ((\hsc_ptr -> hsc_ptr `plusPtr` 2))
{-# LINE 189 "src/System/Socket/Family/Inet.hsc" #-}
  poke ptr (SocketAddressInet a p) = do
    c_memset ptr 0 (16)
{-# LINE 191 "src/System/Socket/Family/Inet.hsc" #-}
    poke        (sin_family   ptr) ((2) :: Word16)
{-# LINE 192 "src/System/Socket/Family/Inet.hsc" #-}
    poke        (sin_addr     ptr) a
    poke        (sin_port     ptr) p
    where
      sin_family   = ((\hsc_ptr -> hsc_ptr `plusPtr` 0))
{-# LINE 196 "src/System/Socket/Family/Inet.hsc" #-}
      sin_addr     = ((\hsc_ptr -> hsc_ptr `plusPtr` 0)) . ((\hsc_ptr -> hsc_ptr `plusPtr` 4))
{-# LINE 197 "src/System/Socket/Family/Inet.hsc" #-}
      sin_port     = ((\hsc_ptr -> hsc_ptr `plusPtr` 2))
{-# LINE 198 "src/System/Socket/Family/Inet.hsc" #-}