module System.Socket.Family.Inet6
( Inet6
, SocketAddressInet6 (..)
, Address ()
, Port (..)
, FlowInfo (..)
, ScopeId (..)
, System.Socket.Family.Inet6.any
, loopback
, 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.C.Types
import Foreign.Storable
import Foreign.Marshal.Utils
import System.Socket.Family
import System.Socket.Internal.Socket
import System.Socket.Internal.Platform
data Inet6
instance Family Inet6 where
type SocketAddress Inet6 = SocketAddressInet6
familyNumber _ = (10)
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
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])
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))
alignment _ = (4)
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))
sin6_scope_id = ((\hsc_ptr -> hsc_ptr `plusPtr` 24))
sin6_port = ((\hsc_ptr -> hsc_ptr `plusPtr` 2))
sin6_addr = ((\hsc_ptr -> hsc_ptr `plusPtr` 0)) . ((\hsc_ptr -> hsc_ptr `plusPtr` 8))
poke ptr (SocketAddressInet6 a (Port p) (FlowInfo f) (ScopeId s)) = do
c_memset ptr 0 (28)
poke (sin6_family ptr) ((10) :: Word16)
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))
sin6_flowinfo = ((\hsc_ptr -> hsc_ptr `plusPtr` 4))
sin6_scope_id = ((\hsc_ptr -> hsc_ptr `plusPtr` 24))
sin6_port = ((\hsc_ptr -> hsc_ptr `plusPtr` 2))
sin6_addr = ((\hsc_ptr -> hsc_ptr `plusPtr` 0)) . ((\hsc_ptr -> hsc_ptr `plusPtr` 8))
data V6Only
= V6Only Bool
deriving (Eq, Ord, Show)
instance GetSocketOption V6Only where
getSocketOption s =
V6Only . ((/=0) :: CInt -> Bool) <$> unsafeGetSocketOption s (41) (26)
instance SetSocketOption V6Only where
setSocketOption s (V6Only o) =
unsafeSetSocketOption s (41) (26) (if o then 1 else 0 :: CInt)