{-# LANGUAGE CPP #-}

#include "HsNetDef.h"

-- | Blocking socket operations which a caller can give up on.
--
--   Each takes an 'STM' action beside the operation.  Whichever
--   settles first decides the result: 'Left' when the caller gave up,
--   'Right' when the operation completed.  Nothing has to be closed or
--   interrupted to make the thread return, so neither the delivery of
--   @evtClose@ by @closeFdWith@ nor an asynchronous exception reaching
--   a blocking call is relied upon.
--
--   __On Windows these need the threaded runtime.__  There is no
--   readiness to wait for there, so the operation is started and then
--   cancelled, and the thread it runs in blocks in a foreign call.
--   Without @-threaded@ that blocks every other thread too, including
--   the one which would have given up, and nothing returns at all.
module Network.Socket.Wait (
    withReadable,
    withWritable,
    withReadableOv,
    withWritableOv,
    acceptWith,
    recvBufWith,
    recvBufFromWith,
    sendBufWith,
    sendBufToWith,
    recvBufMsgWith,
    sendBufMsgWith,
    connectWith,
    isClosedSocketError,
    isTransientAcceptError,
    isPortUnreachableError,
) where

import Control.Concurrent.STM
import qualified Control.Exception as E
import Foreign.C.Error (
    Errno (..),
    eCONNABORTED,
#if !defined(mingw32_HOST_OS)
    eCONNREFUSED,
#endif
    eHOSTDOWN,
    eHOSTUNREACH,
    eNETDOWN,
    eNETUNREACH,
    eNONET,
    eNOPROTOOPT,
    ePROTO,
 )
import GHC.IO.Exception (IOErrorType (..), ioe_errno)
import System.IO.Error (ioeGetErrorType)

import Network.Socket.Buffer
#if defined(mingw32_HOST_OS)
import Network.Socket.Cbits
import Network.Socket.Win32.Cancel
#else
import Network.Socket.STM
#endif
import Network.Socket.Flag
import Network.Socket.Imports
import Network.Socket.Syscall
import Network.Socket.Types
#if !defined(mingw32_HOST_OS)
import Network.Socket.Posix.Cmsg
#else
import Network.Socket.Win32.Cmsg
#endif

-- | Running an action once the socket is readable, unless the 'STM'
--   action fires first.  The 'STM' action is also looked at before
--   anything else, so a caller which has already given up never waits.
--   An operation which has completed wins a tie, so nothing it has
--   already received is thrown away.
--
--   __The action must be an operation on this socket which returns
--   without blocking once the socket is readable.__  The type does not
--   say so and nothing checks it.  On POSIX the action runs on the
--   calling thread after readiness and nothing interrupts it there: the
--   give-up ends the wait, not the action.  On Windows there is no
--   readiness to wait for, so the action is started at once on a thread
--   of its own and the give-up cancels it with @CancelIoEx@ on this
--   socket, which reaches nothing else -- an action blocked on anything
--   else would never end.  The cancel cannot tell the action from other
--   operations pending on the socket, so it ends those too, whichever
--   thread issued them.  The give-ups for particular operations, such as
--   'recvBufWith' and 'Network.Socket.ByteString.sendAllWith', cancel
--   their own and leave the rest alone.
--
--   __One reader at a time__ is what keeps that condition.  A second
--   thread taking the data between the readiness and the action leaves
--   the action blocking on the socket, with the give-up no longer in
--   play.
--
--   __The 'STM' action is run more than once__, so it has to be a test
--   and not something which takes what it reads: it is looked at before
--   the wait and again as part of it, and 'Network.Socket.ByteString.recvWith'
--   looks at it once more before a read which would not block.  Reading
--   a 'TVar' is what it is for.
withReadable :: Socket -> STM a -> IO b -> IO (Either a b)
withReadable :: forall a b. Socket -> STM a -> IO b -> IO (Either a b)
withReadable Socket
s STM a
giveUp IO b
act = Ready
-> Bool -> Socket -> STM a -> (Ptr () -> IO b) -> IO (Either a b)
forall a b.
Ready
-> Bool -> Socket -> STM a -> (Ptr () -> IO b) -> IO (Either a b)
withReady Ready
Read Bool
False Socket
s STM a
giveUp ((Ptr () -> IO b) -> IO (Either a b))
-> (Ptr () -> IO b) -> IO (Either a b)
forall a b. (a -> b) -> a -> b
$ IO b -> Ptr () -> IO b
forall a b. a -> b -> a
const IO b
act

-- | 'withReadable' for writing: running an action once the socket is
--   writable, unless the 'STM' action fires first.  The same conditions
--   hold, with one writer at a time in place of one reader.
--
--   A send which is given up on may have sent part of its data on
--   Windows, where it is cancelled rather than never started, and the
--   socket cannot be sent on after that.  So a stream given up on in
--   the middle of a send is to be closed.
--
--   @since 3.2.12.0
withWritable :: Socket -> STM a -> IO b -> IO (Either a b)
withWritable :: forall a b. Socket -> STM a -> IO b -> IO (Either a b)
withWritable Socket
s STM a
giveUp IO b
act = Ready
-> Bool -> Socket -> STM a -> (Ptr () -> IO b) -> IO (Either a b)
forall a b.
Ready
-> Bool -> Socket -> STM a -> (Ptr () -> IO b) -> IO (Either a b)
withReady Ready
Write Bool
False Socket
s STM a
giveUp ((Ptr () -> IO b) -> IO (Either a b))
-> (Ptr () -> IO b) -> IO (Either a b)
forall a b. (a -> b) -> a -> b
$ IO b -> Ptr () -> IO b
forall a b. a -> b -> a
const IO b
act

-- | 'withReadable' for an operation which takes an OVERLAPPED: on
--   Windows it is issued with one of its own and the give-up cancels it
--   alone.  'nullPtr' is passed elsewhere.
withReadableOv :: Socket -> STM a -> (Ptr () -> IO b) -> IO (Either a b)
withReadableOv :: forall a b. Socket -> STM a -> (Ptr () -> IO b) -> IO (Either a b)
withReadableOv = Ready
-> Bool -> Socket -> STM a -> (Ptr () -> IO b) -> IO (Either a b)
forall a b.
Ready
-> Bool -> Socket -> STM a -> (Ptr () -> IO b) -> IO (Either a b)
withReady Ready
Read Bool
True

-- | 'withWritable' for an operation which takes an OVERLAPPED.
withWritableOv :: Socket -> STM a -> (Ptr () -> IO b) -> IO (Either a b)
withWritableOv :: forall a b. Socket -> STM a -> (Ptr () -> IO b) -> IO (Either a b)
withWritableOv = Ready
-> Bool -> Socket -> STM a -> (Ptr () -> IO b) -> IO (Either a b)
forall a b.
Ready
-> Bool -> Socket -> STM a -> (Ptr () -> IO b) -> IO (Either a b)
withReady Ready
Write Bool
True

data Ready = Read | Write

withReady :: Ready -> Bool -> Socket -> STM a -> (Ptr () -> IO b) -> IO (Either a b)
withReady :: forall a b.
Ready
-> Bool -> Socket -> STM a -> (Ptr () -> IO b) -> IO (Either a b)
withReady Ready
_ready Bool
_own Socket
s STM a
giveUp Ptr () -> IO b
act = do
    -- Looking at the give-up first: on Windows 'wait' starts the
    -- operation before it looks at any STM, and on POSIX this keeps a
    -- caller which has given up off a descriptor close may have freed.
    gaveUp <- STM (Maybe a) -> IO (Maybe a)
forall a. STM a -> IO a
atomically (STM (Maybe a) -> IO (Maybe a)) -> STM (Maybe a) -> IO (Maybe a)
forall a b. (a -> b) -> a -> b
$ (a -> Maybe a
forall a. a -> Maybe a
Just (a -> Maybe a) -> STM a -> STM (Maybe a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> STM a
giveUp) STM (Maybe a) -> STM (Maybe a) -> STM (Maybe a)
forall a. STM a -> STM a -> STM a
`orElse` Maybe a -> STM (Maybe a)
forall a. a -> STM a
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe a
forall a. Maybe a
Nothing
    case gaveUp of
        Just a
a -> Either a b -> IO (Either a b)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (Either a b -> IO (Either a b)) -> Either a b -> IO (Either a b)
forall a b. (a -> b) -> a -> b
$ a -> Either a b
forall a b. a -> Either a b
Left a
a
        Maybe a
Nothing -> IO (Either a b)
wait
  where
#if !defined(mingw32_HOST_OS)
    -- A socket which is ready already skips the IO manager, whose round
    -- trip costs several times the operation: a send usually finds room.
    wait :: IO (Either a b)
wait = do
        now <- Socket -> (CInt -> IO CInt) -> IO CInt
forall r. Socket -> (CInt -> IO r) -> IO r
withFdSocket Socket
s ((CInt -> IO CInt) -> IO CInt) -> (CInt -> IO CInt) -> IO CInt
forall a b. (a -> b) -> a -> b
$ \CInt
fd ->
            CInt -> CInt -> IO CInt
c_ready_now CInt
fd (CInt -> IO CInt) -> CInt -> IO CInt
forall a b. (a -> b) -> a -> b
$ case Ready
_ready of
                Ready
Read -> CInt
0
                Ready
Write -> CInt
1
        if now /= 0 then Right <$> act nullPtr else waitIO

    waitIO :: IO (Either a b)
waitIO = do
        (ready, cancelWait) <- case Ready
_ready of
            Ready
Read -> Socket -> IO (STM (), IO ())
waitAndCancelReadSocketSTM Socket
s
            Ready
Write -> Socket -> IO (STM (), IO ())
waitAndCancelWriteSocketSTM Socket
s
        ev <-
            atomically ((Left <$> giveUp) `orElse` (Right <$> ready))
                `E.finally` (cancelWait `E.catch` gone)
        either (return . Left) (const $ Right <$> act nullPtr) ev

    -- The cancel can throw, and from a finally that would replace the
    -- exception which ended the wait -- the timeout the caller is waiting
    -- to see, say.  What it reports is a registration which has already
    -- gone, and there is nothing to do about that.
    gone :: E.IOException -> IO ()
    gone :: IOException -> IO ()
gone IOException
_ = () -> IO ()
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ()
#else
    -- Only an operation issued with an OVERLAPPED of its own can be
    -- cancelled alone; any other cancel reaches the whole socket.
    wait
        | _own = withOverlapped waitOn
        | otherwise = waitOn nullPtr
    waitOn ov = do
        (completed, cancelAct) <- windowsViaSTM s ov (act ov)
        -- The operation wins a tie.  It has already read into the
        -- caller's buffer by then, and answering Left would throw those
        -- bytes away -- which for a stream loses them for good.
        --
        -- onException because the call runs in a thread of its own here:
        -- an asynchronous exception arriving during the wait would
        -- otherwise leave it blocked in a foreign call, holding the
        -- socket and writing into a buffer the caller has let go of.
        ev <-
            atomically ((Right <$> completed) `orElse` (Left <$> giveUp))
                `E.onException` cancelAct
        case ev of
            Right b -> return $ Right b
            Left a -> do
                cancelAct
                return $ Left a
#endif

#if !defined(mingw32_HOST_OS)
foreign import ccall unsafe "hsnet_ready_now"
    c_ready_now :: CInt -> CInt -> IO CInt
#endif

-- | 'accept' which the caller can give up on.
--
--   @since 3.2.10.0
acceptWith :: SocketAddress sa => Socket -> STM a -> IO (Either a (Socket, sa))
acceptWith :: forall sa a.
SocketAddress sa =>
Socket -> STM a -> IO (Either a (Socket, sa))
acceptWith Socket
s STM a
giveUp = Socket -> STM a -> IO (Socket, sa) -> IO (Either a (Socket, sa))
forall a b. Socket -> STM a -> IO b -> IO (Either a b)
withReadable Socket
s STM a
giveUp (IO (Socket, sa) -> IO (Either a (Socket, sa)))
-> IO (Socket, sa) -> IO (Either a (Socket, sa))
forall a b. (a -> b) -> a -> b
$ Socket -> IO (Socket, sa)
forall sa. SocketAddress sa => Socket -> IO (Socket, sa)
accept Socket
s

-- | 'recvBuf' which the caller can give up on.
--
--   @since 3.2.10.0
recvBufWith :: Socket -> Ptr Word8 -> Int -> STM a -> IO (Either a Int)
recvBufWith :: forall a. Socket -> Ptr Word8 -> Int -> STM a -> IO (Either a Int)
recvBufWith Socket
s Ptr Word8
ptr Int
nbytes STM a
giveUp =
    Socket -> STM a -> (Ptr () -> IO Int) -> IO (Either a Int)
forall a b. Socket -> STM a -> (Ptr () -> IO b) -> IO (Either a b)
withReadableOv Socket
s STM a
giveUp ((Ptr () -> IO Int) -> IO (Either a Int))
-> (Ptr () -> IO Int) -> IO (Either a Int)
forall a b. (a -> b) -> a -> b
$ \Ptr ()
ov -> Ptr () -> Socket -> Ptr Word8 -> Int -> IO Int
recvBufOv Ptr ()
ov Socket
s Ptr Word8
ptr Int
nbytes

-- | 'recvBufFrom' which the caller can give up on.
--
--   @since 3.2.10.0
recvBufFromWith
    :: SocketAddress sa
    => Socket -> Ptr a -> Int -> STM b -> IO (Either b (Int, sa))
recvBufFromWith :: forall sa a b.
SocketAddress sa =>
Socket -> Ptr a -> Int -> STM b -> IO (Either b (Int, sa))
recvBufFromWith Socket
s Ptr a
ptr Int
nbytes STM b
giveUp =
    Socket
-> STM b -> (Ptr () -> IO (Int, sa)) -> IO (Either b (Int, sa))
forall a b. Socket -> STM a -> (Ptr () -> IO b) -> IO (Either a b)
withReadableOv Socket
s STM b
giveUp ((Ptr () -> IO (Int, sa)) -> IO (Either b (Int, sa)))
-> (Ptr () -> IO (Int, sa)) -> IO (Either b (Int, sa))
forall a b. (a -> b) -> a -> b
$ \Ptr ()
ov -> Ptr () -> Socket -> Ptr a -> Int -> IO (Int, sa)
forall sa a.
SocketAddress sa =>
Ptr () -> Socket -> Ptr a -> Int -> IO (Int, sa)
recvBufFromOv Ptr ()
ov Socket
s Ptr a
ptr Int
nbytes

-- | 'sendBuf' which the caller can give up on.  See 'withWritable' for
--   what is left of the stream after giving up.
--
--   @since 3.2.12.0
sendBufWith :: Socket -> Ptr Word8 -> Int -> STM a -> IO (Either a Int)
sendBufWith :: forall a. Socket -> Ptr Word8 -> Int -> STM a -> IO (Either a Int)
sendBufWith Socket
s Ptr Word8
ptr Int
nbytes STM a
giveUp =
    Socket -> STM a -> (Ptr () -> IO Int) -> IO (Either a Int)
forall a b. Socket -> STM a -> (Ptr () -> IO b) -> IO (Either a b)
withWritableOv Socket
s STM a
giveUp ((Ptr () -> IO Int) -> IO (Either a Int))
-> (Ptr () -> IO Int) -> IO (Either a Int)
forall a b. (a -> b) -> a -> b
$ \Ptr ()
ov -> Ptr () -> Socket -> Ptr Word8 -> Int -> IO Int
sendBufOv Ptr ()
ov Socket
s Ptr Word8
ptr Int
nbytes

-- | 'sendBufTo' which the caller can give up on.
--
--   @since 3.2.12.0
sendBufToWith
    :: SocketAddress sa
    => Socket -> Ptr a -> Int -> sa -> STM b -> IO (Either b Int)
sendBufToWith :: forall sa a b.
SocketAddress sa =>
Socket -> Ptr a -> Int -> sa -> STM b -> IO (Either b Int)
sendBufToWith Socket
s Ptr a
ptr Int
nbytes sa
sa STM b
giveUp =
    Socket -> STM b -> (Ptr () -> IO Int) -> IO (Either b Int)
forall a b. Socket -> STM a -> (Ptr () -> IO b) -> IO (Either a b)
withWritableOv Socket
s STM b
giveUp ((Ptr () -> IO Int) -> IO (Either b Int))
-> (Ptr () -> IO Int) -> IO (Either b Int)
forall a b. (a -> b) -> a -> b
$ \Ptr ()
ov -> Ptr () -> Socket -> Ptr a -> Int -> sa -> IO Int
forall sa a.
SocketAddress sa =>
Ptr () -> Socket -> Ptr a -> Int -> sa -> IO Int
sendBufToOv Ptr ()
ov Socket
s Ptr a
ptr Int
nbytes sa
sa

-- | 'recvBufMsg' which the caller can give up on.
--
--   @since 3.2.12.0
recvBufMsgWith
    :: SocketAddress sa
    => Socket
    -> [(Ptr Word8, Int)]
    -> Int
    -> MsgFlag
    -> STM a
    -> IO (Either a (sa, Int, [Cmsg], MsgFlag))
recvBufMsgWith :: forall sa a.
SocketAddress sa =>
Socket
-> [(Ptr Word8, Int)]
-> Int
-> MsgFlag
-> STM a
-> IO (Either a (sa, Int, [Cmsg], MsgFlag))
recvBufMsgWith Socket
s [(Ptr Word8, Int)]
bufsizs Int
clen MsgFlag
flags STM a
giveUp =
    Socket
-> STM a
-> (Ptr () -> IO (sa, Int, [Cmsg], MsgFlag))
-> IO (Either a (sa, Int, [Cmsg], MsgFlag))
forall a b. Socket -> STM a -> (Ptr () -> IO b) -> IO (Either a b)
withReadableOv Socket
s STM a
giveUp ((Ptr () -> IO (sa, Int, [Cmsg], MsgFlag))
 -> IO (Either a (sa, Int, [Cmsg], MsgFlag)))
-> (Ptr () -> IO (sa, Int, [Cmsg], MsgFlag))
-> IO (Either a (sa, Int, [Cmsg], MsgFlag))
forall a b. (a -> b) -> a -> b
$ \Ptr ()
ov -> Ptr ()
-> Socket
-> [(Ptr Word8, Int)]
-> Int
-> MsgFlag
-> IO (sa, Int, [Cmsg], MsgFlag)
forall sa.
SocketAddress sa =>
Ptr ()
-> Socket
-> [(Ptr Word8, Int)]
-> Int
-> MsgFlag
-> IO (sa, Int, [Cmsg], MsgFlag)
recvBufMsgOv Ptr ()
ov Socket
s [(Ptr Word8, Int)]
bufsizs Int
clen MsgFlag
flags

-- | 'sendBufMsg' which the caller can give up on.
--
--   @since 3.2.12.0
sendBufMsgWith
    :: SocketAddress sa
    => Socket
    -> sa
    -> [(Ptr Word8, Int)]
    -> [Cmsg]
    -> MsgFlag
    -> STM a
    -> IO (Either a Int)
sendBufMsgWith :: forall sa a.
SocketAddress sa =>
Socket
-> sa
-> [(Ptr Word8, Int)]
-> [Cmsg]
-> MsgFlag
-> STM a
-> IO (Either a Int)
sendBufMsgWith Socket
s sa
sa [(Ptr Word8, Int)]
bufsizs [Cmsg]
cmsgs MsgFlag
flags STM a
giveUp =
    Socket -> STM a -> (Ptr () -> IO Int) -> IO (Either a Int)
forall a b. Socket -> STM a -> (Ptr () -> IO b) -> IO (Either a b)
withWritableOv Socket
s STM a
giveUp ((Ptr () -> IO Int) -> IO (Either a Int))
-> (Ptr () -> IO Int) -> IO (Either a Int)
forall a b. (a -> b) -> a -> b
$ \Ptr ()
ov -> Ptr ()
-> Socket
-> sa
-> [(Ptr Word8, Int)]
-> [Cmsg]
-> MsgFlag
-> IO Int
forall sa.
SocketAddress sa =>
Ptr ()
-> Socket
-> sa
-> [(Ptr Word8, Int)]
-> [Cmsg]
-> MsgFlag
-> IO Int
sendBufMsgOv Ptr ()
ov Socket
s sa
sa [(Ptr Word8, Int)]
bufsizs [Cmsg]
cmsgs MsgFlag
flags

-- | 'connect' which the caller can give up on.  A socket given up on
--   may still be connecting, so it is to be closed.
--
--   @since 3.2.12.0
connectWith :: SocketAddress sa => Socket -> sa -> STM a -> IO (Either a ())
#if !defined(mingw32_HOST_OS)
connectWith :: forall sa a.
SocketAddress sa =>
Socket -> sa -> STM a -> IO (Either a ())
connectWith Socket
s sa
sa STM a
giveUp = do
    gaveUp <- STM (Maybe a) -> IO (Maybe a)
forall a. STM a -> IO a
atomically (STM (Maybe a) -> IO (Maybe a)) -> STM (Maybe a) -> IO (Maybe a)
forall a b. (a -> b) -> a -> b
$ (a -> Maybe a
forall a. a -> Maybe a
Just (a -> Maybe a) -> STM a -> STM (Maybe a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> STM a
giveUp) STM (Maybe a) -> STM (Maybe a) -> STM (Maybe a)
forall a. STM a -> STM a -> STM a
`orElse` Maybe a -> STM (Maybe a)
forall a. a -> STM a
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe a
forall a. Maybe a
Nothing
    case gaveUp of
        Just a
a -> Either a () -> IO (Either a ())
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (Either a () -> IO (Either a ()))
-> Either a () -> IO (Either a ())
forall a b. (a -> b) -> a -> b
$ a -> Either a ()
forall a b. a -> Either a b
Left a
a
        Maybe a
Nothing -> Socket -> sa -> (IO () -> IO (Either a ())) -> IO (Either a ())
forall sa a.
SocketAddress sa =>
Socket -> sa -> (IO () -> IO (Either a ())) -> IO (Either a ())
connectWhenWritable Socket
s sa
sa ((IO () -> IO (Either a ())) -> IO (Either a ()))
-> (IO () -> IO (Either a ())) -> IO (Either a ())
forall a b. (a -> b) -> a -> b
$ Socket -> STM a -> IO () -> IO (Either a ())
forall a b. Socket -> STM a -> IO b -> IO (Either a b)
withWritable Socket
s STM a
giveUp
#else
connectWith s sa giveUp = withWritable s giveUp $ connect s sa
#endif

-- | Whether this is the error a socket operation gives once the socket has
--   been closed under it.
--
--   A caller which stops when it is told also stops when the socket it was
--   waiting on goes away, and this is how that arrives.  It is not an
--   error to report: closing the socket is how a server was stopped
--   before there was anything to tell it, and callers which do that are
--   still out there.
--
--   @since 3.2.10.0
isClosedSocketError :: E.IOException -> Bool
isClosedSocketError :: IOException -> Bool
isClosedSocketError IOException
e = IOException -> IOErrorType
ioeGetErrorType IOException
e IOErrorType -> IOErrorType -> Bool
forall a. Eq a => a -> a -> Bool
== IOErrorType
InvalidArgument Bool -> Bool -> Bool
|| IOException -> Bool
forall {p}. p -> Bool
isWinsock IOException
e
  where
#if defined(mingw32_HOST_OS)
    -- closesocket gives WSAEINTR to a call already blocked on the socket
    -- and WSAENOTSOCK to one which starts afterwards.
    isWinsock x = ioe_errno x `elem` map Just [wsaEINTR, wsaENOTSOCK]
#else
    isWinsock :: p -> Bool
isWinsock p
_ = Bool
False
#endif

-- | Whether an exception from 'accept' is about the connection it was
--   accepting rather than about the listening socket.
--
--   The peer may reset the connection before it is accepted
--   (@ECONNABORTED@), and Linux reports a new socket's already-pending
--   network errors through @accept()@ as well; accept(2) asks for all of
--   these to be retried, like @EAGAIN@.  The connection has left the queue
--   by then, so a retry blocks for a new one rather than spinning on the
--   same failure.
--
--   Two which are not here:
--
--   * Running out of descriptors (@EMFILE@, @ENFILE@) is about the process,
--     not about one connection, and retrying at once spins: the listening
--     socket stays readable.  'System.IO.Error.isFullError' names it, and a
--     caller which retries it should wait first.
--
--   * @EOPNOTSUPP@ is on accept(2)'s list and is left off this one on
--     purpose: it is also what a listening socket which is not
--     'Network.Socket.Stream' answers, which is permanent, and a retry
--     would spin on it forever.
--
--   Winsock numbers its errors apart from @errno@, so on Windows a list
--   of its own is read as well.  @WSAEINTR@ is not on it: there it is
--   what @closesocket@ gives a blocked call, which 'isClosedSocketError'
--   takes.  @WSAENOBUFS@ is left off for the reason @EMFILE@ is.
--
--   @since 3.2.10.0
isTransientAcceptError :: E.IOException -> Bool
isTransientAcceptError :: IOException -> Bool
isTransientAcceptError IOException
e =
    IOException -> IOErrorType
ioeGetErrorType IOException
e IOErrorType -> IOErrorType -> Bool
forall a. Eq a => a -> a -> Bool
== IOErrorType
Interrupted Bool -> Bool -> Bool
|| (Errno -> Bool) -> [Errno] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
any Errno -> Bool
is [Errno]
errnos Bool -> Bool -> Bool
|| IOException -> Bool
forall {p}. p -> Bool
isWinsock IOException
e
  where
    -- An errno the platform does not have is Errno (-1), which would
    -- otherwise match every error carrying that.
    is :: Errno -> Bool
is (Errno CInt
n) = CInt
n CInt -> CInt -> Bool
forall a. Eq a => a -> a -> Bool
/= -CInt
1 Bool -> Bool -> Bool
&& IOException -> Maybe CInt
ioe_errno IOException
e Maybe CInt -> Maybe CInt -> Bool
forall a. Eq a => a -> a -> Bool
== CInt -> Maybe CInt
forall a. a -> Maybe a
Just CInt
n
    errnos :: [Errno]
errnos =
        [ Errno
eCONNABORTED
        , Errno
eHOSTDOWN
        , Errno
eHOSTUNREACH
        , Errno
eNETDOWN
        , Errno
eNETUNREACH
        , Errno
eNONET
        , Errno
eNOPROTOOPT
        , Errno
ePROTO
        ]
#if defined(mingw32_HOST_OS)
    isWinsock x = ioe_errno x `elem` map Just codes
    codes =
        [ wsaECONNABORTED
        , wsaECONNRESET
        , wsaEHOSTDOWN
        , wsaEHOSTUNREACH
        , wsaENETDOWN
        , wsaENETRESET
        , wsaENETUNREACH
        , wsaENOPROTOOPT
        ]
#else
    isWinsock :: p -> Bool
isWinsock p
_ = Bool
False
#endif

-- | Whether a receive on a connected datagram socket failed because an
--   earlier send of its own came back as an ICMP port unreachable.
--
--   POSIX gives it as @ECONNREFUSED@ and Winsock as @WSAECONNRESET@, so
--   the error type differs (@NoSuchThing@ and @OtherError@); this reads
--   the code instead.  Only a connected socket hears it on any platform.
--
--   @since 3.2.12.0
isPortUnreachableError :: E.IOException -> Bool
isPortUnreachableError :: IOException -> Bool
isPortUnreachableError IOException
e = IOException -> Maybe CInt
ioe_errno IOException
e Maybe CInt -> Maybe CInt -> Bool
forall a. Eq a => a -> a -> Bool
== CInt -> Maybe CInt
forall a. a -> Maybe a
Just CInt
code
  where
#if defined(mingw32_HOST_OS)
    code = wsaECONNRESET
#else
    Errno CInt
code = Errno
eCONNREFUSED
#endif