{-# LINE 1 "Network/Socket/Internal.hsc" #-} {-# LANGUAGE CPP #-} {-# LINE 2 "Network/Socket/Internal.hsc" #-} {-# LANGUAGE ForeignFunctionInterface #-} {-# OPTIONS_GHC -fno-warn-orphans #-} ----------------------------------------------------------------------------- -- | -- Module : Network.Socket.Internal -- Copyright : (c) The University of Glasgow 2001 -- License : BSD-style (see the file libraries/network/LICENSE) -- -- Maintainer : libraries@haskell.org -- Stability : provisional -- Portability : portable -- -- A module containing semi-public 'Network.Socket' internals. -- Modules which extend the 'Network.Socket' module will need to use -- this module while ideally most users will be able to make do with -- the public interface. -- ----------------------------------------------------------------------------- {-# LINE 22 "Network/Socket/Internal.hsc" #-} module Network.Socket.Internal ( -- * Socket addresses HostAddress {-# LINE 28 "Network/Socket/Internal.hsc" #-} , HostAddress6 , FlowInfo , ScopeID {-# LINE 32 "Network/Socket/Internal.hsc" #-} , PortNumber(..) , SockAddr(..) , peekSockAddr , pokeSockAddr , sizeOfSockAddr , sizeOfSockAddrByFamily , withSockAddr , withNewSockAddr -- * Protocol families , Family(..) -- * Socket error functions {-# LINE 49 "Network/Socket/Internal.hsc" #-} , throwSocketError , throwSocketErrorCode -- * Guards for socket operations that may fail , throwSocketErrorIfMinus1_ , throwSocketErrorIfMinus1Retry , throwSocketErrorIfMinus1RetryMayBlock -- ** Guards that wait and retry if the operation would block -- | These guards are based on 'throwSocketErrorIfMinus1RetryMayBlock'. -- They wait for socket readiness if the action fails with @EWOULDBLOCK@ -- or similar. , throwSocketErrorWaitRead , throwSocketErrorWaitWrite -- * Initialization , withSocketsDo -- * Low-level helpers , zeroMemory ) where import Data.Bits ( (.|.), shiftL, shiftR ) import Data.Word ( Word8, Word16, Word32 ) import Data.Typeable (Typeable) import Foreign.C.Error (throwErrno, throwErrnoIfMinus1Retry, throwErrnoIfMinus1RetryMayBlock, throwErrnoIfMinus1_, Errno(..), errnoToIOError) import Foreign.C.String ( castCharToCChar, peekCString ) {-# LINE 79 "Network/Socket/Internal.hsc" #-} import Foreign.C.Types ( CInt(..), CSize(..) ) {-# LINE 83 "Network/Socket/Internal.hsc" #-} import Foreign.Marshal.Alloc ( allocaBytes ) import Foreign.Marshal.Array ( pokeArray, pokeArray0 ) import Foreign.Ptr ( Ptr, castPtr, plusPtr ) import Foreign.Storable ( Storable(..) ) import GHC.Conc (threadWaitRead, threadWaitWrite) {-# LINE 99 "Network/Socket/Internal.hsc" #-} import Network.Socket.Types -- --------------------------------------------------------------------- -- Guards for socket operations that may fail -- | Throw an 'IOError' corresponding to the current socket error. throwSocketError :: String -- ^ textual description of the error location -> IO a -- | Like 'throwSocketError', but the error code is supplied as an argument. -- -- On Windows, do not use errno. Use a system error code instead. throwSocketErrorCode :: String -> CInt -> IO a -- | Throw an 'IOError' corresponding to the current socket error if -- the IO action returns a result of @-1@. Discards the result of the -- IO action after error handling. throwSocketErrorIfMinus1_ :: (Eq a, Num a) => String -- ^ textual description of the location -> IO a -- ^ the 'IO' operation to be executed -> IO () {-# SPECIALIZE throwSocketErrorIfMinus1_ :: String -> IO CInt -> IO () #-} -- | Throw an 'IOError' corresponding to the current socket error if -- the IO action returns a result of @-1@, but retries in case of an -- interrupted operation. throwSocketErrorIfMinus1Retry :: (Eq a, Num a) => String -- ^ textual description of the location -> IO a -- ^ the 'IO' operation to be executed -> IO a {-# SPECIALIZE throwSocketErrorIfMinus1Retry :: String -> IO CInt -> IO CInt #-} -- | Throw an 'IOError' corresponding to the current socket error if -- the IO action returns a result of @-1@, but retries in case of an -- interrupted operation. Checks for operations that would block and -- executes an alternative action before retrying in that case. throwSocketErrorIfMinus1RetryMayBlock :: (Eq a, Num a) => String -- ^ textual description of the location -> IO b -- ^ action to execute before retrying if an -- immediate retry would block -> IO a -- ^ the 'IO' operation to be executed -> IO a {-# SPECIALIZE throwSocketErrorIfMinus1RetryMayBlock :: String -> IO b -> IO CInt -> IO CInt #-} {-# LINE 152 "Network/Socket/Internal.hsc" #-} throwSocketErrorIfMinus1RetryMayBlock name on_block act = throwErrnoIfMinus1RetryMayBlock name act on_block throwSocketErrorIfMinus1Retry = throwErrnoIfMinus1Retry throwSocketErrorIfMinus1_ = throwErrnoIfMinus1_ throwSocketError = throwErrno throwSocketErrorCode loc errno = ioError (errnoToIOError loc (Errno errno) Nothing Nothing) {-# LINE 212 "Network/Socket/Internal.hsc" #-} -- | Like 'throwSocketErrorIfMinus1Retry', but if the action fails with -- @EWOULDBLOCK@ or similar, wait for the socket to be read-ready, -- and try again. throwSocketErrorWaitRead :: (Eq a, Num a) => Socket -> String -> IO a -> IO a throwSocketErrorWaitRead sock name io = throwSocketErrorIfMinus1RetryMayBlock name (threadWaitRead $ fromIntegral $ sockFd sock) io -- | Like 'throwSocketErrorIfMinus1Retry', but if the action fails with -- @EWOULDBLOCK@ or similar, wait for the socket to be write-ready, -- and try again. throwSocketErrorWaitWrite :: (Eq a, Num a) => Socket -> String -> IO a -> IO a throwSocketErrorWaitWrite sock name io = throwSocketErrorIfMinus1RetryMayBlock name (threadWaitWrite $ fromIntegral $ sockFd sock) io -- --------------------------------------------------------------------------- -- WinSock support {-| On Windows operating systems, the networking subsystem has to be initialised using 'withSocketsDo' before any networking operations can be used. eg. > main = withSocketsDo $ do {...} Although this is only strictly necessary on Windows platforms, it is harmless on other platforms, so for portability it is good practice to use it all the time. -} withSocketsDo :: IO a -> IO a {-# LINE 246 "Network/Socket/Internal.hsc" #-} withSocketsDo x = x {-# LINE 258 "Network/Socket/Internal.hsc" #-}