{-# LINE 1 "Std/IO/SockAddr.hsc" #-}
{-# LANGUAGE DeriveDataTypeable #-}
{-# LANGUAGE PatternSynonyms #-}
module Std.IO.SockAddr
(
SockAddr(..)
, sockAddrFamily
, peekSockAddr
, withSockAddr
, withSockAddrStorage
, InetAddr
, inetAny
, inetBroadcast
, inetNone
, inetLoopback
, inetUnspecificGroup
, inetAllHostsGroup
, inetMaxLocalGroup
, inetAddrToTuple
, tupleToInetAddr
, Inet6Addr
, inet6Any
, inet6Loopback
, inet6AddrToTuple
, tupleToInet6Addr
, FlowInfo
, ScopeID
, PortNumber
, aNY_PORT
, htons
, ntohs
, ntohl
, htonl
, SocketFamily(..)
, pattern AF_UNSPEC
, pattern AF_INET
, pattern AF_INET6
, SocketType(..)
, pattern SOCK_DGRAM
, pattern SOCK_STREAM
, pattern SOCK_SEQPACKET
, pattern SOCK_RAW
, pattern SOCK_RDM
, SocketProtocol(..)
, pattern IPPROTO_TCP
, pattern IPPROTO_UDP
) where
import Control.Monad.IO.Class
import Control.Monad.Primitive
import Data.Bits
import qualified Data.List as List
import Data.Primitive.PrimArray
import Data.Ratio
import Data.Typeable
import Foreign
import Foreign.C
import GHC.ForeignPtr (mallocPlainForeignPtrAlignedBytes)
import Numeric (showHex)
import Std.Data.CBytes
import qualified Std.Data.Vector as V
import Std.Foreign.PrimArray
import Std.IO.Exception
import Std.IO.Resource
import Std.IO.UV.Errno
import System.IO.Unsafe (unsafeDupablePerformIO)
{-# LINE 90 "Std/IO/SockAddr.hsc" #-}
{-# LINE 94 "Std/IO/SockAddr.hsc" #-}
{-# LINE 96 "Std/IO/SockAddr.hsc" #-}
{-# LINE 102 "Std/IO/SockAddr.hsc" #-}
type CSaFamily = (Word8)
{-# LINE 103 "Std/IO/SockAddr.hsc" #-}
{-# LINE 106 "Std/IO/SockAddr.hsc" #-}
data SockAddr
= SockAddrInet
{-# UNPACK #-} !PortNumber
{-# UNPACK #-} !InetAddr
| SockAddrInet6
{-# UNPACK #-} !PortNumber
{-# UNPACK #-} !FlowInfo
{-# UNPACK #-} !Inet6Addr
{-# UNPACK #-} !ScopeID
deriving (Show, Eq, Ord)
sockAddrFamily :: SockAddr -> SocketFamily
sockAddrFamily (SockAddrInet _ _) = AF_INET
sockAddrFamily (SockAddrInet6 _ _ _ _) = AF_INET6
type FlowInfo = Word32
type ScopeID = Word32
newtype InetAddr = InetAddr Word32 deriving (Eq, Ord)
instance Show InetAddr where
showsPrec _ ia =
let (a,b,c,d) = inetAddrToTuple ia
in ("InetAddr " ++) . shows a . ('.':)
. shows b . ('.':)
. shows c . ('.':)
. shows d
inetAny :: InetAddr
inetAny = InetAddr 0
inetBroadcast :: InetAddr
inetBroadcast = tupleToInetAddr (255,255,255,255)
inetNone :: InetAddr
inetNone = tupleToInetAddr (255,255,255,255)
inetLoopback :: InetAddr
inetLoopback = tupleToInetAddr (127, 0, 0, 1)
inetUnspecificGroup :: InetAddr
inetUnspecificGroup = tupleToInetAddr (224, 0, 0, 0)
inetAllHostsGroup :: InetAddr
inetAllHostsGroup = tupleToInetAddr (224, 0, 0, 1)
inetMaxLocalGroup :: InetAddr
inetMaxLocalGroup = tupleToInetAddr (224, 0, 0,255)
instance Storable InetAddr where
sizeOf _ = sizeOf (undefined :: Word32)
alignment _ = alignment (undefined :: Word32)
peek p = (InetAddr . ntohl) `fmap` peekByteOff p 0
poke p (InetAddr ia) = pokeByteOff p 0 (htonl ia)
inetAddrToTuple :: InetAddr -> (Word8, Word8, Word8, Word8)
inetAddrToTuple (InetAddr ia) =
let byte i = fromIntegral (ia `shiftR` i) :: Word8
in (byte 24, byte 16, byte 8, byte 0)
tupleToInetAddr :: (Word8, Word8, Word8, Word8) -> InetAddr
tupleToInetAddr (b3, b2, b1, b0) =
let x `sl` i = fromIntegral x `shiftL` i :: Word32
in InetAddr $ (b3 `sl` 24) .|. (b2 `sl` 16) .|. (b1 `sl` 8) .|. (b0 `sl` 0)
data Inet6Addr = Inet6Addr {-# UNPACK #-}!Word32
{-# UNPACK #-}!Word32
{-# UNPACK #-}!Word32
{-# UNPACK #-}!Word32 deriving (Eq, Ord)
instance Show Inet6Addr where
showsPrec _ i6a =
let (a,b,c,d,e,f,g,h) = inet6AddrToTuple i6a
in ("Inet6Addr " ++) . showHex a . (':':)
. showHex b . (':':)
. showHex c . (':':)
. showHex d . (':':)
. showHex e . (':':)
. showHex f . (':':)
. showHex g . (':':)
. showHex h
inet6Any :: Inet6Addr
inet6Any = Inet6Addr 0 0 0 0
inet6Loopback :: Inet6Addr
inet6Loopback = Inet6Addr 0 0 0 1
inet6AddrToTuple :: Inet6Addr -> (Word16, Word16, Word16, Word16,
Word16, Word16, Word16, Word16)
inet6AddrToTuple (Inet6Addr w3 w2 w1 w0) =
let high, low :: Word32 -> Word16
high w = fromIntegral (w `shiftR` 16)
low w = fromIntegral w
in (high w3, low w3, high w2, low w2, high w1, low w1, high w0, low w0)
tupleToInet6Addr :: (Word16, Word16, Word16, Word16,
Word16, Word16, Word16, Word16) -> Inet6Addr
tupleToInet6Addr (w7, w6, w5, w4, w3, w2, w1, w0) =
let add :: Word16 -> Word16 -> Word32
high `add` low = (fromIntegral high `shiftL` 16) .|. (fromIntegral low)
in Inet6Addr (w7 `add` w6) (w5 `add` w4) (w3 `add` w2) (w1 `add` w0)
instance Storable Inet6Addr where
sizeOf _ = (16)
{-# LINE 238 "Std/IO/SockAddr.hsc" #-}
alignment _ = 4
{-# LINE 239 "Std/IO/SockAddr.hsc" #-}
peek p = do
a <- peek32 p 0
b <- peek32 p 1
c <- peek32 p 2
d <- peek32 p 3
return $ Inet6Addr a b c d
poke p (Inet6Addr a b c d) = do
poke32 p 0 a
poke32 p 1 b
poke32 p 2 c
poke32 p 3 d
peekSockAddr :: HasCallStack => Ptr SockAddr -> IO SockAddr
peekSockAddr p = do
family <- ((\hsc_ptr -> peekByteOff hsc_ptr 1)) p
{-# LINE 258 "Std/IO/SockAddr.hsc" #-}
case family :: CSaFamily of
(2) -> do
{-# LINE 260 "Std/IO/SockAddr.hsc" #-}
addr <- ((\hsc_ptr -> peekByteOff hsc_ptr 4)) p
{-# LINE 261 "Std/IO/SockAddr.hsc" #-}
port <- ((\hsc_ptr -> peekByteOff hsc_ptr 2)) p
{-# LINE 262 "Std/IO/SockAddr.hsc" #-}
return (SockAddrInet (PortNum port) addr)
(30) -> do
{-# LINE 264 "Std/IO/SockAddr.hsc" #-}
port <- ((\hsc_ptr -> peekByteOff hsc_ptr 2)) p
{-# LINE 265 "Std/IO/SockAddr.hsc" #-}
flow <- ((\hsc_ptr -> peekByteOff hsc_ptr 4)) p
{-# LINE 266 "Std/IO/SockAddr.hsc" #-}
addr <- ((\hsc_ptr -> peekByteOff hsc_ptr 8)) p
{-# LINE 267 "Std/IO/SockAddr.hsc" #-}
scope <- ((\hsc_ptr -> peekByteOff hsc_ptr 24)) p
{-# LINE 268 "Std/IO/SockAddr.hsc" #-}
return (SockAddrInet6 (PortNum port) flow addr scope)
_ -> do let errno = UV_EAI_ADDRFAMILY
name <- uvErrName errno
desc <- uvStdError errno
throwUVError errno (IOEInfo name desc callStack)
pokeSockAddr :: HasCallStack => Ptr SockAddr -> SockAddr -> IO ()
pokeSockAddr p (SockAddrInet (PortNum port) addr) = do
{-# LINE 278 "Std/IO/SockAddr.hsc" #-}
clearPtr p (16)
{-# LINE 279 "Std/IO/SockAddr.hsc" #-}
{-# LINE 280 "Std/IO/SockAddr.hsc" #-}
{-# LINE 283 "Std/IO/SockAddr.hsc" #-}
((\hsc_ptr -> pokeByteOff hsc_ptr 1)) p ((2) :: CSaFamily)
{-# LINE 284 "Std/IO/SockAddr.hsc" #-}
((\hsc_ptr -> pokeByteOff hsc_ptr 2)) p port
{-# LINE 285 "Std/IO/SockAddr.hsc" #-}
((\hsc_ptr -> pokeByteOff hsc_ptr 4)) p addr
{-# LINE 286 "Std/IO/SockAddr.hsc" #-}
pokeSockAddr p (SockAddrInet6 (PortNum port) flow addr scope) = do
{-# LINE 288 "Std/IO/SockAddr.hsc" #-}
clearPtr p (28)
{-# LINE 289 "Std/IO/SockAddr.hsc" #-}
{-# LINE 290 "Std/IO/SockAddr.hsc" #-}
{-# LINE 293 "Std/IO/SockAddr.hsc" #-}
((\hsc_ptr -> pokeByteOff hsc_ptr 1)) p ((30) :: CSaFamily)
{-# LINE 294 "Std/IO/SockAddr.hsc" #-}
((\hsc_ptr -> pokeByteOff hsc_ptr 2)) p port
{-# LINE 295 "Std/IO/SockAddr.hsc" #-}
((\hsc_ptr -> pokeByteOff hsc_ptr 4)) p flow
{-# LINE 296 "Std/IO/SockAddr.hsc" #-}
((\hsc_ptr -> pokeByteOff hsc_ptr 8)) p (addr)
{-# LINE 297 "Std/IO/SockAddr.hsc" #-}
((\hsc_ptr -> pokeByteOff hsc_ptr 24)) p scope
{-# LINE 298 "Std/IO/SockAddr.hsc" #-}
withSockAddr :: SockAddr -> (Ptr SockAddr -> IO a) -> IO a
withSockAddr sa@(SockAddrInet _ _) f = do
allocaBytesAligned
((16))
{-# LINE 303 "Std/IO/SockAddr.hsc" #-}
(4) $ \ p -> pokeSockAddr p sa >> f p
{-# LINE 304 "Std/IO/SockAddr.hsc" #-}
withSockAddr sa@(SockAddrInet6 _ _ _ _) f = do
allocaBytesAligned
((28))
{-# LINE 307 "Std/IO/SockAddr.hsc" #-}
(4) $ \ p -> pokeSockAddr p sa >> f p
{-# LINE 308 "Std/IO/SockAddr.hsc" #-}
withSockAddrStorage :: (Ptr SockAddr -> Ptr CInt -> IO ()) -> IO SockAddr
withSockAddrStorage f = do
allocaBytesAligned
((128))
{-# LINE 313 "Std/IO/SockAddr.hsc" #-}
(8) $ \ p ->
{-# LINE 314 "Std/IO/SockAddr.hsc" #-}
alloca $ \ p' -> do
poke p' ((128))
{-# LINE 316 "Std/IO/SockAddr.hsc" #-}
f p p'
peekSockAddr p
s6_addr_offset :: Int
s6_addr_offset = ((0))
{-# LINE 325 "Std/IO/SockAddr.hsc" #-}
peek32 :: Ptr a -> Int -> IO Word32
peek32 p i0 = do
let i' = i0 * 4
peekByte n = peekByteOff p (s6_addr_offset + i' + n) :: IO Word8
a `sl` i = fromIntegral a `shiftL` i
a0 <- peekByte 0
a1 <- peekByte 1
a2 <- peekByte 2
a3 <- peekByte 3
return ((a0 `sl` 24) .|. (a1 `sl` 16) .|. (a2 `sl` 8) .|. (a3 `sl` 0))
poke32 :: Ptr a -> Int -> Word32 -> IO ()
poke32 p i0 a = do
let i' = i0 * 4
pokeByte n = pokeByteOff p (s6_addr_offset + i' + n)
x `sr` i = fromIntegral (x `shiftR` i) :: Word8
pokeByte 0 (a `sr` 24)
pokeByte 1 (a `sr` 16)
pokeByte 2 (a `sr` 8)
pokeByte 3 (a `sr` 0)
newtype PortNumber = PortNum Word16 deriving (Eq, Ord, Typeable)
aNY_PORT :: PortNumber
aNY_PORT = 0
instance Show PortNumber where
showsPrec p pn = showsPrec p (portNumberToInt pn)
instance Read PortNumber where
readsPrec n = map (\(x,y) -> (intToPortNumber x, y)) . readsPrec n
intToPortNumber :: Int -> PortNumber
intToPortNumber v = PortNum (htons (fromIntegral v))
portNumberToInt :: PortNumber -> Int
portNumberToInt (PortNum po) = fromIntegral (ntohs po)
foreign import ccall unsafe "ntohs" ntohs :: Word16 -> Word16
{-# LINE 379 "Std/IO/SockAddr.hsc" #-}
foreign import ccall unsafe "htons" htons :: Word16 -> Word16
{-# LINE 380 "Std/IO/SockAddr.hsc" #-}
foreign import ccall unsafe "ntohl" ntohl :: Word32 -> Word32
{-# LINE 381 "Std/IO/SockAddr.hsc" #-}
foreign import ccall unsafe "htonl" htonl :: Word32 -> Word32
{-# LINE 382 "Std/IO/SockAddr.hsc" #-}
instance Enum PortNumber where
toEnum = intToPortNumber
fromEnum = portNumberToInt
instance Num PortNumber where
fromInteger i = intToPortNumber (fromInteger i)
(+) x y = intToPortNumber (portNumberToInt x + portNumberToInt y)
(-) x y = intToPortNumber (portNumberToInt x - portNumberToInt y)
negate x = intToPortNumber (-portNumberToInt x)
(*) x y = intToPortNumber (portNumberToInt x * portNumberToInt y)
abs n = intToPortNumber (abs (portNumberToInt n))
signum n = intToPortNumber (signum (portNumberToInt n))
instance Real PortNumber where
toRational x = toInteger x % 1
instance Integral PortNumber where
quotRem a b = let (c,d) = quotRem (portNumberToInt a) (portNumberToInt b) in
(intToPortNumber c, intToPortNumber d)
toInteger a = toInteger (portNumberToInt a)
instance Storable PortNumber where
sizeOf _ = sizeOf (undefined :: Word16)
alignment _ = alignment (undefined :: Word16)
poke p (PortNum po) = poke (castPtr p) po
peek p = PortNum `fmap` peek (castPtr p)
newtype SocketFamily = SocketFamily CInt deriving (Show, Read, Eq, Ord, Typeable)
newtype SocketType = SocketType CInt deriving (Show, Read, Eq, Ord, Typeable)
newtype SocketProtocol = SocketProtocol CInt deriving (Show, Read, Eq, Ord, Typeable)
instance Storable SocketFamily where
sizeOf _ = sizeOf (undefined :: CInt)
alignment _ = alignment (undefined :: CInt)
peek ptr = SocketFamily `fmap` peek (castPtr ptr)
poke ptr (SocketFamily v) = poke (castPtr ptr) v
instance Storable SocketType where
sizeOf _ = sizeOf (undefined :: CInt)
alignment _ = alignment (undefined :: CInt)
peek ptr = SocketType `fmap` peek (castPtr ptr)
poke ptr (SocketType v) = poke (castPtr ptr) v
instance Storable SocketProtocol where
sizeOf _ = sizeOf (undefined :: CInt)
alignment _ = alignment (undefined :: CInt)
peek ptr = SocketProtocol `fmap` peek (castPtr ptr)
poke ptr (SocketProtocol v) = poke (castPtr ptr) v
pattern AF_UNSPEC :: SocketFamily
pattern AF_UNSPEC = SocketFamily (0)
{-# LINE 438 "Std/IO/SockAddr.hsc" #-}
pattern AF_INET :: SocketFamily
pattern AF_INET = SocketFamily (2)
{-# LINE 441 "Std/IO/SockAddr.hsc" #-}
pattern AF_INET6 :: SocketFamily
pattern AF_INET6 = SocketFamily (30)
{-# LINE 444 "Std/IO/SockAddr.hsc" #-}
pattern SOCK_STREAM :: SocketType
pattern SOCK_STREAM = SocketType (1)
{-# LINE 447 "Std/IO/SockAddr.hsc" #-}
pattern SOCK_DGRAM :: SocketType
pattern SOCK_DGRAM = SocketType (2)
{-# LINE 449 "Std/IO/SockAddr.hsc" #-}
pattern SOCK_RAW :: SocketType
pattern SOCK_RAW = SocketType (3)
{-# LINE 451 "Std/IO/SockAddr.hsc" #-}
pattern SOCK_RDM :: SocketType
pattern SOCK_RDM = SocketType (4)
{-# LINE 453 "Std/IO/SockAddr.hsc" #-}
pattern SOCK_SEQPACKET :: SocketType
pattern SOCK_SEQPACKET = SocketType (5)
{-# LINE 455 "Std/IO/SockAddr.hsc" #-}
pattern IPPROTO_DEF :: SocketProtocol
pattern IPPROTO_DEF = SocketProtocol 0
pattern IPPROTO_IP :: SocketProtocol
pattern IPPROTO_IP = SocketProtocol (0)
{-# LINE 460 "Std/IO/SockAddr.hsc" #-}
pattern IPPROTO_TCP :: SocketProtocol
pattern IPPROTO_TCP = SocketProtocol (6)
{-# LINE 462 "Std/IO/SockAddr.hsc" #-}
pattern IPPROTO_UDP :: SocketProtocol
pattern IPPROTO_UDP = SocketProtocol (17)
{-# LINE 464 "Std/IO/SockAddr.hsc" #-}