{-# LINE 1 "src/System/Socket/Family/Inet6.hsc" #-}
{-# LANGUAGE TypeFamilies, GeneralizedNewtypeDeriving #-}
{-# LINE 2 "src/System/Socket/Family/Inet6.hsc" #-}
module System.Socket.Family.Inet6
  ( Inet6
    -- * Addresses
  , SocketAddressInet6 (..)
  , Address ()
  , Port (..)
  , FlowInfo (..)
  , ScopeId (..)
  -- ** Special Address Constants
  -- *** any
  , System.Socket.Family.Inet6.any
  -- *** loopback
  , loopback
  -- * Socket Options
  -- ** V6Only
  , V6Only (..)
  ) where

import Data.Bits
import Data.Monoid
import Data.Word
import qualified Data.ByteString as BS
import qualified Data.ByteString.Unsafe as BS

import Control.Applicative

import Foreign.Ptr
import Foreign.Storable
import Foreign.Marshal.Utils

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


{-# LINE 37 "src/System/Socket/Family/Inet6.hsc" #-}

{-# LINE 38 "src/System/Socket/Family/Inet6.hsc" #-}

data Inet6

instance Family Inet6 where
  type SocketAddress Inet6 = SocketAddressInet6
  familyNumber _ = (10)
{-# LINE 44 "src/System/Socket/Family/Inet6.hsc" #-}

-- | Example:
--
--  > SocketAddressInet6 loopback 8080 mempty 0
data SocketAddressInet6
   = SocketAddressInet6
     { address   :: Address
     , port      :: Port
     , flowInfo  :: FlowInfo
     , scopeId   :: ScopeId
     } deriving (Eq, Show)

newtype Port
      = Port Word16
      deriving (Eq, Ord, Num)

instance Show Port where
  show (Port p) = show p

-- | To avoid errors with endianess it was decided to keep this type abstract.
--
--   Hint: Use the `Foreign.Storable.Storable` instance if you really need to access. 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 "::1") Nothing aiNumericHost :: IO [AddressInfo SocketAddressInet6 Stream TCP]
--   > [AddressInfo {
--   >    addressInfoFlags = AddressInfoFlags 4, 
--   >    socketAddress    = SocketAddressInet6 {address = 0000:0000:0000:0000:0000:0000:0000:0001, port = 0, flowInfo = mempty, scopeId = 0},
--   >    canonicalName    = Nothing }]
newtype Address
      = Address BS.ByteString
      deriving (Eq)

newtype FlowInfo
      = FlowInfo Word32
      deriving (Eq, Ord, Bits)

instance Show FlowInfo where
  show (FlowInfo i) = show i

instance Monoid FlowInfo where
  mempty  = FlowInfo 0
  mappend = (.|.)

newtype ScopeId
      = ScopeId Word32
      deriving (Eq, Ord, Num)

instance Show ScopeId where
  show (ScopeId i) = show i

-- | @::@
any      :: Address
any       = Address (BS.pack [0,0,0,0, 0,0,0,0, 0,0,0,0, 0,0,0,0])

-- | @::1@
loopback :: Address
loopback  = Address (BS.pack [0,0,0,0, 0,0,0,0, 0,0,0,0, 0,0,0,1])

instance Show Address where
  show (Address addr) = tail $ t $ BS.unpack addr
    where
      t []       = []
      t [x]      = g x 0 []
      t (x:y:xs) = g x y (t xs)
      g x y s    = let (a,b) = quotRem x 16
                       (c,d) = quotRem y 16
                   in  ':':(h a):(h b):(h c):(h d):s
      h :: Word8 -> Char
      h 0  = '0'
      h 1  = '1'
      h 2  = '2'
      h 3  = '3'
      h 4  = '4'
      h 5  = '5'
      h 6  = '6'
      h 7  = '7'
      h 8  = '8'
      h 9  = '9'
      h 10 = 'a'
      h 11 = 'b'
      h 12 = 'c'
      h 13 = 'd'
      h 14 = 'e'
      h 15 = 'f'
      h  _ = '_'

instance Storable Address where
  sizeOf   _  = 16
  alignment _ = 16
  peek ptr    =
    Address <$> BS.packCStringLen (castPtr ptr, 16)
  poke ptr (Address a) =
    BS.unsafeUseAsCString a $ \aPtr-> do
      copyBytes ptr (castPtr aPtr) (min 16 $ BS.length a)

instance Storable SocketAddressInet6 where
  sizeOf    _ = ((28))
{-# LINE 146 "src/System/Socket/Family/Inet6.hsc" #-}
  alignment _ = (4)
{-# LINE 147 "src/System/Socket/Family/Inet6.hsc" #-}
  peek ptr    = do
    f   <- peek              (sin6_flowinfo ptr)     :: IO Word32
    ph  <- peekByteOff       (sin6_port     ptr)  0  :: IO Word8
    pl  <- peekByteOff       (sin6_port     ptr)  1  :: IO Word8
    a   <- peek              (sin6_addr     ptr)     :: IO Address
    s   <- peek              (sin6_scope_id ptr)     :: IO Word32
    return (SocketAddressInet6 a (Port $ fromIntegral ph * 256 + fromIntegral pl) (FlowInfo f) (ScopeId s))
    where
      sin6_flowinfo = ((\hsc_ptr -> hsc_ptr `plusPtr` 4))
{-# LINE 156 "src/System/Socket/Family/Inet6.hsc" #-}
      sin6_scope_id = ((\hsc_ptr -> hsc_ptr `plusPtr` 24))
{-# LINE 157 "src/System/Socket/Family/Inet6.hsc" #-}
      sin6_port     = ((\hsc_ptr -> hsc_ptr `plusPtr` 2))
{-# LINE 158 "src/System/Socket/Family/Inet6.hsc" #-}
      sin6_addr     = ((\hsc_ptr -> hsc_ptr `plusPtr` 0)) . ((\hsc_ptr -> hsc_ptr `plusPtr` 8))
{-# LINE 159 "src/System/Socket/Family/Inet6.hsc" #-}
  poke ptr (SocketAddressInet6 a (Port p) (FlowInfo f) (ScopeId s)) = do
    c_memset ptr 0 (28)
{-# LINE 161 "src/System/Socket/Family/Inet6.hsc" #-}
    poke        (sin6_family   ptr) ((10) :: Word16)
{-# LINE 162 "src/System/Socket/Family/Inet6.hsc" #-}
    poke        (sin6_flowinfo ptr) f
    poke        (sin6_scope_id ptr) s
    pokeByteOff (sin6_port     ptr)  0 (fromIntegral $ rem (quot p 256) 256 :: Word8)
    pokeByteOff (sin6_port     ptr)  1 (fromIntegral $ rem       p      256 :: Word8)
    poke        (sin6_addr     ptr) a
    where
      sin6_family   = ((\hsc_ptr -> hsc_ptr `plusPtr` 0))
{-# LINE 169 "src/System/Socket/Family/Inet6.hsc" #-}
      sin6_flowinfo = ((\hsc_ptr -> hsc_ptr `plusPtr` 4))
{-# LINE 170 "src/System/Socket/Family/Inet6.hsc" #-}
      sin6_scope_id = ((\hsc_ptr -> hsc_ptr `plusPtr` 24))
{-# LINE 171 "src/System/Socket/Family/Inet6.hsc" #-}
      sin6_port     = ((\hsc_ptr -> hsc_ptr `plusPtr` 2))
{-# LINE 172 "src/System/Socket/Family/Inet6.hsc" #-}
      sin6_addr     = ((\hsc_ptr -> hsc_ptr `plusPtr` 0)) . ((\hsc_ptr -> hsc_ptr `plusPtr` 8))
{-# LINE 173 "src/System/Socket/Family/Inet6.hsc" #-}

-------------------------------------------------------------------------------
-- Address family specific socket options
-------------------------------------------------------------------------------

-- | @IPV6_V6ONLY@
data V6Only
   = V6Only Bool
   deriving (Eq, Ord, Show)

instance GetSocketOption V6Only where
  getSocketOption s =
    V6Only <$> getSocketOptionBool s (41) (26)
{-# LINE 186 "src/System/Socket/Family/Inet6.hsc" #-}

instance SetSocketOption V6Only where
  setSocketOption s (V6Only o) =
    setSocketOptionBool s (41) (26) o