{-# LINE 1 "src/System/Socket/Family/Inet6.hsc" #-}
{-# LANGUAGE TypeFamilies, FlexibleInstances, GeneralizedNewtypeDeriving #-}
module System.Socket.Family.Inet6
(
Inet6
, Inet6Address
, Inet6Port
, Inet6FlowInfo
, Inet6ScopeId
, SocketAddress (SocketAddressInet6, inet6Address, inet6Port,
inet6FlowInfo, inet6ScopeId)
, inet6AddressFromTuple
, inet6AddressToTuple
, inet6Any
, inet6Loopback
, V6Only (..)
) where
import Data.Bits ((.|.))
import Data.Word
import Control.Applicative as A
import Foreign.Ptr
import Foreign.C.Types
import Foreign.Storable
import System.Socket.Internal.Socket
import System.Socket.Internal.SocketOption
import System.Socket.Internal.Platform
{-# LINE 56 "src/System/Socket/Family/Inet6.hsc" #-}
data Inet6
instance Family Inet6 where
familyNumber _ = (10)
{-# LINE 62 "src/System/Socket/Family/Inet6.hsc" #-}
data SocketAddress Inet6
= SocketAddressInet6
{ inet6Address :: Inet6Address
, inet6Port :: Inet6Port
, inet6FlowInfo :: Inet6FlowInfo
, inet6ScopeId :: Inet6ScopeId
} deriving (Eq, Show)
data Inet6Address = Inet6Address {-# UNPACK #-} !Word64 {-# UNPACK #-} !Word64
deriving (Eq)
newtype Inet6Port = Inet6Port Word16
deriving (Eq, Ord, Show, Num, Real, Enum, Integral)
newtype Inet6FlowInfo = Inet6FlowInfo Word32
deriving (Eq, Ord, Show, Num, Real, Enum, Integral)
newtype Inet6ScopeId = Inet6ScopeId Word32
deriving (Eq, Ord, Show, Num, Real, Enum, Integral)
inet6AddressToTuple :: Inet6Address -> (Word16,Word16,Word16,Word16,Word16,Word16,Word16,Word16)
inet6AddressToTuple (Inet6Address hb lb) =
(w0 hb, w1 hb, w2 hb, w3 hb, w0 lb, w1 lb, w2 lb, w3 lb)
where
w0, w1, w2, w3 :: Word64 -> Word16
w0 x = fromIntegral $ rem (quot x $ 65536 * 65536 * 65536) 65536
w1 x = fromIntegral $ rem (quot x $ 65536 * 65536) 65536
w2 x = fromIntegral $ rem (quot x $ 65536) 65536
w3 x = fromIntegral $ rem x 65536
inet6AddressFromTuple :: (Word16,Word16,Word16,Word16,Word16,Word16,Word16,Word16) -> Inet6Address
inet6AddressFromTuple (w0, w1, w2, w3, w4, w5, w6, w7) =
Inet6Address hb lb
where
hb = fromIntegral w0 * 65536 * 65536 * 65536
.|. fromIntegral w1 * 65536 * 65536
.|. fromIntegral w2 * 65536
.|. fromIntegral w3
lb = fromIntegral w4 * 65536 * 65536 * 65536
.|. fromIntegral w5 * 65536 * 65536
.|. fromIntegral w6 * 65536
.|. fromIntegral w7
inet6Any :: Inet6Address
inet6Any = Inet6Address 0 0
inet6Loopback :: Inet6Address
inet6Loopback = Inet6Address 0 1
instance Show Inet6Address where
show (Inet6Address high low) = "Inet6Address " ++
[ hex $ hn $ w64_0 high
, hex $ ln $ w64_0 high
, hex $ hn $ w64_1 high
, hex $ ln $ w64_1 high
, ':'
, hex $ hn $ w64_2 high
, hex $ ln $ w64_2 high
, hex $ hn $ w64_3 high
, hex $ ln $ w64_3 high
, ':'
, hex $ hn $ w64_4 high
, hex $ ln $ w64_4 high
, hex $ hn $ w64_5 high
, hex $ ln $ w64_5 high
, ':'
, hex $ hn $ w64_6 high
, hex $ ln $ w64_6 high
, hex $ hn $ w64_7 high
, hex $ ln $ w64_7 high
, ':'
, hex $ hn $ w64_0 low
, hex $ ln $ w64_0 low
, hex $ hn $ w64_1 low
, hex $ ln $ w64_1 low
, ':'
, hex $ hn $ w64_2 low
, hex $ ln $ w64_2 low
, hex $ hn $ w64_3 low
, hex $ ln $ w64_3 low
, ':'
, hex $ hn $ w64_4 low
, hex $ ln $ w64_4 low
, hex $ hn $ w64_5 low
, hex $ ln $ w64_5 low
, ':'
, hex $ hn $ w64_6 low
, hex $ ln $ w64_6 low
, hex $ hn $ w64_7 low
, hex $ ln $ w64_7 low
]
where
hn, ln :: Word8 -> Word8
hn x = div x 16
ln x = mod x 16
hex :: Word8 -> Char
hex 0 = '0'
hex 1 = '1'
hex 2 = '2'
hex 3 = '3'
hex 4 = '4'
hex 5 = '5'
hex 6 = '6'
hex 7 = '7'
hex 8 = '8'
hex 9 = '9'
hex 10 = 'a'
hex 11 = 'b'
hex 12 = 'c'
hex 13 = 'd'
hex 14 = 'e'
hex 15 = 'f'
hex _ = '_'
instance Storable Inet6Address where
sizeOf _ = 16
alignment _ = 16
peek ptr = do
h0 <- peekByteOff ptr 0 :: IO Word8
h1 <- peekByteOff ptr 1 :: IO Word8
h2 <- peekByteOff ptr 2 :: IO Word8
h3 <- peekByteOff ptr 3 :: IO Word8
h4 <- peekByteOff ptr 4 :: IO Word8
h5 <- peekByteOff ptr 5 :: IO Word8
h6 <- peekByteOff ptr 6 :: IO Word8
h7 <- peekByteOff ptr 7 :: IO Word8
l0 <- peekByteOff ptr 8 :: IO Word8
l1 <- peekByteOff ptr 9 :: IO Word8
l2 <- peekByteOff ptr 10 :: IO Word8
l3 <- peekByteOff ptr 11 :: IO Word8
l4 <- peekByteOff ptr 12 :: IO Word8
l5 <- peekByteOff ptr 13 :: IO Word8
l6 <- peekByteOff ptr 14 :: IO Word8
l7 <- peekByteOff ptr 15 :: IO Word8
return $ Inet6Address (((((((((((((( fromIntegral h0
* 256) + fromIntegral h1 )
* 256) + fromIntegral h2 )
* 256) + fromIntegral h3 )
* 256) + fromIntegral h4 )
* 256) + fromIntegral h5 )
* 256) + fromIntegral h6 )
* 256) + fromIntegral h7 )
(((((((((((((( fromIntegral l0
* 256) + fromIntegral l1 )
* 256) + fromIntegral l2 )
* 256) + fromIntegral l3 )
* 256) + fromIntegral l4 )
* 256) + fromIntegral l5 )
* 256) + fromIntegral l6 )
* 256) + fromIntegral l7 )
poke ptr (Inet6Address high low) = do
pokeByteOff ptr 0 (w64_0 high)
pokeByteOff ptr 1 (w64_1 high)
pokeByteOff ptr 2 (w64_2 high)
pokeByteOff ptr 3 (w64_3 high)
pokeByteOff ptr 4 (w64_4 high)
pokeByteOff ptr 5 (w64_5 high)
pokeByteOff ptr 6 (w64_6 high)
pokeByteOff ptr 7 (w64_7 high)
pokeByteOff ptr 8 (w64_0 low)
pokeByteOff ptr 9 (w64_1 low)
pokeByteOff ptr 10 (w64_2 low)
pokeByteOff ptr 11 (w64_3 low)
pokeByteOff ptr 12 (w64_4 low)
pokeByteOff ptr 13 (w64_5 low)
pokeByteOff ptr 14 (w64_6 low)
pokeByteOff ptr 15 (w64_7 low)
instance Storable Inet6Port where
sizeOf _ = ((2))
{-# LINE 261 "src/System/Socket/Family/Inet6.hsc" #-}
alignment _ = (2)
{-# LINE 262 "src/System/Socket/Family/Inet6.hsc" #-}
peek ptr = do
p0 <- peekByteOff ptr 0 :: IO Word8
p1 <- peekByteOff ptr 1 :: IO Word8
return $ Inet6Port (fromIntegral p0 * 256 + fromIntegral p1)
poke ptr (Inet6Port w16) = do
pokeByteOff ptr 0 (w16_0 w16)
pokeByteOff ptr 1 (w16_1 w16)
instance Storable Inet6FlowInfo where
sizeOf _ = ((4))
{-# LINE 272 "src/System/Socket/Family/Inet6.hsc" #-}
alignment _ = (4)
{-# LINE 273 "src/System/Socket/Family/Inet6.hsc" #-}
peek ptr = do
p0 <- peekByteOff ptr 0 :: IO Word8
p1 <- peekByteOff ptr 1 :: IO Word8
p2 <- peekByteOff ptr 2 :: IO Word8
p3 <- peekByteOff ptr 3 :: IO Word8
return $ Inet6FlowInfo $ ((((( fromIntegral p0 * 256) + fromIntegral p1) * 256)
+ fromIntegral p2) * 256) + fromIntegral p3
poke ptr (Inet6FlowInfo w32) = do
pokeByteOff ptr 0 (w32_0 w32)
pokeByteOff ptr 1 (w32_1 w32)
pokeByteOff ptr 2 (w32_2 w32)
pokeByteOff ptr 3 (w32_3 w32)
instance Storable Inet6ScopeId where
sizeOf _ = ((4))
{-# LINE 288 "src/System/Socket/Family/Inet6.hsc" #-}
alignment _ = (4)
{-# LINE 289 "src/System/Socket/Family/Inet6.hsc" #-}
peek ptr = do
p0 <- peekByteOff ptr 0 :: IO Word8
p1 <- peekByteOff ptr 1 :: IO Word8
p2 <- peekByteOff ptr 2 :: IO Word8
p3 <- peekByteOff ptr 3 :: IO Word8
return $ Inet6ScopeId $ ((((( fromIntegral p0 * 256) + fromIntegral p1) * 256)
+ fromIntegral p2) * 256) + fromIntegral p3
poke ptr (Inet6ScopeId w32) = do
pokeByteOff ptr 0 (w32_0 w32)
pokeByteOff ptr 1 (w32_1 w32)
pokeByteOff ptr 2 (w32_2 w32)
pokeByteOff ptr 3 (w32_3 w32)
instance Storable (SocketAddress Inet6) where
sizeOf _ = ((28))
{-# LINE 304 "src/System/Socket/Family/Inet6.hsc" #-}
alignment _ = (4)
{-# LINE 305 "src/System/Socket/Family/Inet6.hsc" #-}
peek ptr = SocketAddressInet6 A.<$> peek (sin6_addr ptr)
<*> peek (sin6_port ptr)
<*> peek (sin6_flowinfo ptr)
<*> peek (sin6_scope_id ptr)
where
sin6_flowinfo = ((\hsc_ptr -> hsc_ptr `plusPtr` 4))
{-# LINE 311 "src/System/Socket/Family/Inet6.hsc" #-}
sin6_scope_id = ((\hsc_ptr -> hsc_ptr `plusPtr` 24))
{-# LINE 312 "src/System/Socket/Family/Inet6.hsc" #-}
sin6_port = ((\hsc_ptr -> hsc_ptr `plusPtr` 2))
{-# LINE 313 "src/System/Socket/Family/Inet6.hsc" #-}
sin6_addr = ((\hsc_ptr -> hsc_ptr `plusPtr` 0)) . ((\hsc_ptr -> hsc_ptr `plusPtr` 8))
{-# LINE 314 "src/System/Socket/Family/Inet6.hsc" #-}
poke ptr (SocketAddressInet6 a p f s) = do
c_memset ptr 0 (28)
{-# LINE 316 "src/System/Socket/Family/Inet6.hsc" #-}
poke (sin6_family ptr) ((10) :: Word16)
{-# LINE 317 "src/System/Socket/Family/Inet6.hsc" #-}
poke (sin6_addr ptr) a
poke (sin6_port ptr) p
poke (sin6_flowinfo ptr) f
poke (sin6_scope_id ptr) s
where
sin6_family = ((\hsc_ptr -> hsc_ptr `plusPtr` 0))
{-# LINE 323 "src/System/Socket/Family/Inet6.hsc" #-}
sin6_flowinfo = ((\hsc_ptr -> hsc_ptr `plusPtr` 4))
{-# LINE 324 "src/System/Socket/Family/Inet6.hsc" #-}
sin6_scope_id = ((\hsc_ptr -> hsc_ptr `plusPtr` 24))
{-# LINE 325 "src/System/Socket/Family/Inet6.hsc" #-}
sin6_port = ((\hsc_ptr -> hsc_ptr `plusPtr` 2))
{-# LINE 326 "src/System/Socket/Family/Inet6.hsc" #-}
sin6_addr = ((\hsc_ptr -> hsc_ptr `plusPtr` 0)) . ((\hsc_ptr -> hsc_ptr `plusPtr` 8))
{-# LINE 327 "src/System/Socket/Family/Inet6.hsc" #-}
data V6Only
= V6Only Bool
deriving (Eq, Ord, Show)
instance SocketOption V6Only where
getSocketOption s =
V6Only . ((/=0) :: CInt -> Bool) <$> unsafeGetSocketOption s (41) (26)
{-# LINE 340 "src/System/Socket/Family/Inet6.hsc" #-}
setSocketOption s (V6Only o) =
unsafeSetSocketOption s (41) (26) (if o then 1 else 0 :: CInt)
{-# LINE 342 "src/System/Socket/Family/Inet6.hsc" #-}
w64_0, w64_1, w64_2, w64_3, w64_4, w64_5, w64_6, w64_7 :: Word64 -> Word8
w64_0 x = fromIntegral $ rem (quot x $ 256*256*256*256*256*256*256) 256
w64_1 x = fromIntegral $ rem (quot x $ 256*256*256*256*256*256) 256
w64_2 x = fromIntegral $ rem (quot x $ 256*256*256*256*256) 256
w64_3 x = fromIntegral $ rem (quot x $ 256*256*256*256) 256
w64_4 x = fromIntegral $ rem (quot x $ 256*256*256) 256
w64_5 x = fromIntegral $ rem (quot x $ 256*256) 256
w64_6 x = fromIntegral $ rem (quot x $ 256) 256
w64_7 x = fromIntegral $ rem x 256
w32_0, w32_1, w32_2, w32_3 :: Word32 -> Word8
w32_0 x = fromIntegral $ rem (quot x $ 256*256*256) 256
w32_1 x = fromIntegral $ rem (quot x $ 256*256) 256
w32_2 x = fromIntegral $ rem (quot x $ 256) 256
w32_3 x = fromIntegral $ rem x 256
w16_0, w16_1 :: Word16 -> Word8
w16_0 x = fromIntegral $ rem (quot x $ 256) 256
w16_1 x = fromIntegral $ rem x 256