module Network.Socket.Internal(
HostAddress
, HostAddress6
, FlowInfo
, ScopeID
, PortNumber(..)
, SockAddr(..)
, peekSockAddr
, pokeSockAddr
, sizeOfSockAddr
, sizeOfSockAddrByFamily
, withSockAddr
, withNewSockAddr
, Family(..)
, throwSocketError
, throwSocketErrorCode
, throwSocketErrorIfMinus1_
, throwSocketErrorIfMinus1Retry
, throwSocketErrorIfMinus1Retry_
, throwSocketErrorIfMinus1RetryMayBlock
, throwSocketErrorWaitRead
, throwSocketErrorWaitWrite
, withSocketsDo
, zeroMemory
)
where
import Control.Exception(throwIO)
import Control.Monad(unless)
import Data.Typeable(Typeable)
import Data.Word(Word32, Word16)
import Foreign.C.Error(Errno(..), throwErrno, errnoToIOError,
throwErrnoIfMinus1_, throwErrnoIfMinus1Retry,
throwErrnoIfMinus1RetryMayBlock)
import Foreign.C.Types(CInt(..), CSize(..))
import Foreign.Marshal.Alloc(allocaBytes)
import Foreign.Ptr(Ptr, castPtr)
import Foreign.Storable(Storable(..))
import Network.Socket.Types(Socket)
type HostAddress = Word32
type HostAddress6 = (Word32, Word32, Word32, Word32)
type FlowInfo = Word32
type ScopeID = Word32
newtype PortNumber = PortNum Word16
deriving (Enum, Eq, Integral, Num, Ord, Real, Show, Typeable, Storable)
data SockAddr = SockAddrInet PortNumber HostAddress
deriving (Eq, Ord, Show, Typeable)
peekSockAddr :: Ptr SockAddr -> IO SockAddr
peekSockAddr ptr =
do family <- peek (castPtr ptr) :: IO Word16
unless (family == 2) $
throwIO (userError ("peekSockAddr: " ++ show family ++
"not supported on this platform."))
addr <- peekByteOff (castPtr ptr) 4
port <- peekByteOff (castPtr ptr) 2
return (SockAddrInet (PortNum port) addr)
pokeSockAddr :: Ptr a -> SockAddr -> IO ()
pokeSockAddr ptr (SockAddrInet (PortNum port) addr) =
do pokeByteOff (castPtr ptr) 0 (2 :: Word16)
pokeByteOff (castPtr ptr) 2 port
pokeByteOff (castPtr ptr) 4 addr
sizeOfSockAddr :: SockAddr -> Int
sizeOfSockAddr _ = 8
sizeOfSockAddrByFamily :: Family -> Int
sizeOfSockAddrByFamily f =
case f of
AF_INET -> 8
_ -> error ("sizeOfSockAddrByFamily: " ++ show f ++
" not supported.")
withSockAddr :: SockAddr -> (Ptr SockAddr -> Int -> IO a) -> IO a
withSockAddr saddr action =
allocaBytes (sizeOfSockAddr saddr) $ \ ptr ->
do pokeSockAddr ptr saddr
action (castPtr ptr) (sizeOfSockAddr saddr)
withNewSockAddr :: Family -> (Ptr SockAddr -> Int -> IO a) -> IO a
withNewSockAddr family action =
allocaBytes (sizeOfSockAddrByFamily family) $ \ ptr ->
action ptr (sizeOfSockAddrByFamily family)
data Family
= AF_UNSPEC
| AF_UNIX
| AF_INET
| AF_INET6
| AF_IMPLINK
| AF_PUP
| AF_CHAOS
| AF_NS
| AF_NBS
| AF_ECMA
| AF_DATAKIT
| AF_CCITT
| AF_SNA
| AF_DECnet
| AF_DLI
| AF_LAT
| AF_HYLINK
| AF_APPLETALK
| AF_ROUTE
| AF_NETBIOS
| AF_NIT
| AF_802
| AF_ISO
| AF_OSI
| AF_NETMAN
| AF_X25
| AF_AX25
| AF_OSINET
| AF_GOSSIP
| AF_IPX
| Pseudo_AF_XTP
| AF_CTF
| AF_WAN
| AF_SDL
| AF_NETWARE
| AF_NDD
| AF_INTF
| AF_COIP
| AF_CNT
| Pseudo_AF_RTIP
| Pseudo_AF_PIP
| AF_SIP
| AF_ISDN
| Pseudo_AF_KEY
| AF_NATM
| AF_ARP
| Pseudo_AF_HDRCMPLT
| AF_ENCAP
| AF_LINK
| AF_RAW
| AF_RIF
| AF_NETROM
| AF_BRIDGE
| AF_ATMPVC
| AF_ROSE
| AF_NETBEUI
| AF_SECURITY
| AF_PACKET
| AF_ASH
| AF_ECONET
| AF_ATMSVC
| AF_IRDA
| AF_PPPOX
| AF_WANPIPE
| AF_BLUETOOTH
deriving (Eq, Ord, Read, Show)
throwSocketError :: String -> IO a
throwSocketError = throwErrno
throwSocketErrorCode :: String -> CInt ->IO a
throwSocketErrorCode loc errno =
ioError (errnoToIOError loc (Errno errno) Nothing Nothing)
throwSocketErrorIfMinus1_
:: (Eq a, Num a)
=> String
-> IO a
-> IO ()
throwSocketErrorIfMinus1_ = throwErrnoIfMinus1_
throwSocketErrorIfMinus1Retry
:: (Eq a, Num a)
=> String
-> IO a
-> IO a
throwSocketErrorIfMinus1Retry = throwErrnoIfMinus1Retry
throwSocketErrorIfMinus1Retry_
:: (Eq a, Num a)
=> String
-> IO a
-> IO ()
throwSocketErrorIfMinus1Retry_ loc m =
throwSocketErrorIfMinus1Retry loc m >> return ()
throwSocketErrorIfMinus1RetryMayBlock
:: (Eq a, Num a)
=> String
-> IO b
-> IO a
-> IO a
throwSocketErrorIfMinus1RetryMayBlock name on_block act =
throwErrnoIfMinus1RetryMayBlock name act on_block
throwSocketErrorWaitRead :: (Eq a, Num a) => Socket -> String -> IO a -> IO a
throwSocketErrorWaitRead _ _ _ =
fail "FIXME: throwSocketErrorWaitRead is not supported in network-hans"
throwSocketErrorWaitWrite :: (Eq a, Num a) => Socket -> String -> IO a -> IO a
throwSocketErrorWaitWrite _ _ _ =
fail "FIXME: throwSocketErrorWaitWrite is not supported in network-hans"
withSocketsDo :: IO a -> IO a
withSocketsDo action = action
zeroMemory :: Ptr a -> CSize -> IO ()
zeroMemory p s = memset p 0 s
foreign import ccall unsafe "string.h"
memset :: Ptr a -> CInt -> CSize -> IO ()