{-# LANGUAGE CPP #-}{-# OPTIONS_GHC -fno-warn-orphans #-}#include "HsNetDef.h"
------------------------------------------------------------------------------- |-- 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.-------------------------------------------------------------------------------moduleNetwork.Socket.Internal(-- * Socket error functionsthrowSocketError ,throwSocketErrorCode #if defined(mingw32_HOST_OS)
,c_getLastError#endif
-- * Guards for socket operations that may fail,throwSocketErrorIfMinus1_ ,throwSocketErrorIfMinus1Retry ,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 )whereimportGHC.Conc(threadWaitRead,threadWaitWrite)#if defined(mingw32_HOST_OS)
importControl.Exception(evaluate)importSystem.IO.Unsafe(unsafePerformIO)# if __GLASGOW_HASKELL__ >= 707
importGHC.IO.Exception(IOErrorType(..))# else
importGHC.IOBase(IOErrorType(..))# endif
importSystem.IO.Error(ioeSetErrorString,mkIOError)#else
importForeign.C.Error(throwErrno,throwErrnoIfMinus1Retry,throwErrnoIfMinus1RetryMayBlock,throwErrnoIfMinus1_,Errno(..),errnoToIOError)#endif
#if defined(mingw32_HOST_OS)
importNetwork.Socket.Cbits#endif
importNetwork.Socket.Imports importNetwork.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->IOa -- | 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->IOa -- | 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_::(Eqa ,Numa )=>String-- ^ textual description of the location->IOa -- ^ the 'IO' operation to be executed->IO(){-# SPECIALIZEthrowSocketErrorIfMinus1_::String->IOCInt->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::(Eqa ,Numa )=>String-- ^ textual description of the location->IOa -- ^ the 'IO' operation to be executed->IOa {-# SPECIALIZEthrowSocketErrorIfMinus1Retry::String->IOCInt->IOCInt#-}-- | 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. Discards the result of the IO action after-- error handling.throwSocketErrorIfMinus1Retry_::(Eqa ,Numa )=>String-- ^ textual description of the location->IOa -- ^ the 'IO' operation to be executed->IO()throwSocketErrorIfMinus1Retry_ loc m =void$throwSocketErrorIfMinus1Retry loc m {-# SPECIALIZEthrowSocketErrorIfMinus1Retry_::String->IOCInt->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. Checks for operations that would block and-- executes an alternative action before retrying in that case.throwSocketErrorIfMinus1RetryMayBlock::(Eqa ,Numa )=>String-- ^ textual description of the location->IOb -- ^ action to execute before retrying if an-- immediate retry would block->IOa -- ^ the 'IO' operation to be executed->IOa {-# SPECIALIZEthrowSocketErrorIfMinus1RetryMayBlock::String->IOb->IOCInt->IOCInt#-}#if defined(mingw32_HOST_OS)
throwSocketErrorIfMinus1RetryMayBlockname_act=throwSocketErrorIfMinus1RetrynameactthrowSocketErrorIfMinus1_nameact=do_<-throwSocketErrorIfMinus1Retrynameactreturn()throwSocketErrorIfMinus1Retrynameact=dor<-actif(r==-1)thendorc<-c_getLastErrorifrc==wsaNotInitializedthendowithSocketsDo(return())r'<-actif(r'==-1)thenthrowSocketErrornameelsereturnr'elsethrowSocketErrornameelsereturnrthrowSocketErrorCodenamerc=dopstr<-c_getWSErrorrcstr<-peekCStringpstrioError(ioeSetErrorString(mkIOErrorOtherErrornameNothingNothing)str)throwSocketErrorname=c_getLastError>>=throwSocketErrorCodenameforeignimportCALLCONVunsafe"WSAGetLastError"c_getLastError::IOCIntforeignimportccallunsafe"getWSErrorDescr"c_getWSError::CInt->IO(PtrCChar)#else
throwSocketErrorIfMinus1RetryMayBlock name on_block act =throwErrnoIfMinus1RetryMayBlockname act on_block throwSocketErrorIfMinus1Retry =throwErrnoIfMinus1RetrythrowSocketErrorIfMinus1_ =throwErrnoIfMinus1_throwSocketError =throwErrnothrowSocketErrorCode loc errno =ioError(errnoToIOErrorloc (Errnoerrno )NothingNothing)#endif
-- | Like 'throwSocketErrorIfMinus1Retry', but if the action fails with-- @EWOULDBLOCK@ or similar, wait for the socket to be read-ready,-- and try again.throwSocketErrorWaitRead::(Eqa ,Numa )=>Socket ->String->IOa ->IOa throwSocketErrorWaitRead s name io =dofd <-fromIntegral<$>fdSocket s throwSocketErrorIfMinus1RetryMayBlock name (threadWaitReadfd )io -- | Like 'throwSocketErrorIfMinus1Retry', but if the action fails with-- @EWOULDBLOCK@ or similar, wait for the socket to be write-ready,-- and try again.throwSocketErrorWaitWrite::(Eqa ,Numa )=>Socket ->String->IOa ->IOa throwSocketErrorWaitWrite s name io =dofd <-fromIntegral<$>fdSocket s throwSocketErrorIfMinus1RetryMayBlock name (threadWaitWritefd )io -- ----------------------------------------------------------------------------- WinSock support{-| With older versions of the @network@ library (version 2.6.0.2 or earlier)
on Windows operating systems,
the networking subsystem must be initialised using 'withSocketsDo' before
any networking operations can be used. eg.
> main = withSocketsDo $ do {...}
It is fine to nest calls to 'withSocketsDo', and to perform networking operations
after 'withSocketsDo' has returned.
'withSocketsDo' is not necessary for the current network library.
However, for compatibility with older versions on Windows, it is good practice
to always call 'withSocketsDo' (it's very cheap).
-}{-# INLINEwithSocketsDo#-}withSocketsDo::IOa ->IOa #if defined(mingw32_HOST_OS)
withSocketsDoact=evaluatewithSocketsInit>>act{-# NOINLINEwithSocketsInit#-}withSocketsInit::()-- Use a CAF to make forcing it do initialisation once, but subsequent forces will be cheapwithSocketsInit=unsafePerformIO$dox<-initWinSockwhen(x/=0)$ioError$userError"Network.Socket.Internal.withSocketsDo: Failed to initialise WinSock"foreignimportccallunsafe"initWinSock"initWinSock::IOInt#else
withSocketsDo x =x #endif