{-# LANGUAGE CPP #-}

-- | Waiting for a socket to become ready, through STM.
--
-- This mirrors @select@\/@epoll@ and is __POSIX only__: Windows
-- completion ports report that an operation has finished, not that one
-- could be started, so there is no readiness to wait for.  All four
-- throw there.  What runs on Windows instead is
-- "Network.Socket.Win32.Cancel", through 'Network.Socket.withReadable'.
--
module Network.Socket.STM (
    -- * Waiting for readiness (POSIX only)
    waitReadSocketSTM,
    waitAndCancelReadSocketSTM,
    waitWriteSocketSTM,
    waitAndCancelWriteSocketSTM,
) where

import Control.Concurrent.STM (STM)
import Network.Socket.Types
#if !defined(mingw32_HOST_OS)
import Control.Concurrent (threadWaitReadSTM, threadWaitWriteSTM)
import System.Posix.Types (Fd (..))
#endif

-- | STM action to wait until the socket is ready for reading.
--
--   __POSIX only.__  On Windows this throws: completion ports have no
--   notion of readiness.  Use 'Network.Socket.recvBufWith', or one of
--   the other operations which give up, instead.
waitReadSocketSTM :: Socket -> IO (STM ())
waitReadSocketSTM :: Socket -> IO (STM ())
waitReadSocketSTM Socket
s = (STM (), IO ()) -> STM ()
forall a b. (a, b) -> a
fst ((STM (), IO ()) -> STM ()) -> IO (STM (), IO ()) -> IO (STM ())
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Socket -> IO (STM (), IO ())
waitAndCancelReadSocketSTM Socket
s

-- | STM action to wait until the socket is ready for reading and STM
--   action to cancel the waiting.
--
--   __POSIX only.__  See 'waitReadSocketSTM'.
waitAndCancelReadSocketSTM :: Socket -> IO (STM (), IO ())
#if defined(mingw32_HOST_OS)
waitAndCancelReadSocketSTM _ =
    ioError $
        userError $
            "waitAndCancelReadSocketSTM: Windows completion ports do not "
                ++ "provide readiness notification; use recvBufWith or "
                ++ "Network.Socket.ByteString.recvWith instead"
#else
waitAndCancelReadSocketSTM :: Socket -> IO (STM (), IO ())
waitAndCancelReadSocketSTM Socket
s = Socket -> (CInt -> IO (STM (), IO ())) -> IO (STM (), IO ())
forall r. Socket -> (CInt -> IO r) -> IO r
withFdSocket Socket
s ((CInt -> IO (STM (), IO ())) -> IO (STM (), IO ()))
-> (CInt -> IO (STM (), IO ())) -> IO (STM (), IO ())
forall a b. (a -> b) -> a -> b
$ Fd -> IO (STM (), IO ())
threadWaitReadSTM (Fd -> IO (STM (), IO ()))
-> (CInt -> Fd) -> CInt -> IO (STM (), IO ())
forall b c a. (b -> c) -> (a -> b) -> a -> c
. CInt -> Fd
Fd
#endif

-- | STM action to wait until the socket is ready for writing.
--
--   __POSIX only.__  On Windows this throws.  Completion ports give no
--   way to ask whether a send would block, and none is needed: issue
--   the send and let it complete asynchronously.
waitWriteSocketSTM :: Socket -> IO (STM ())
waitWriteSocketSTM :: Socket -> IO (STM ())
waitWriteSocketSTM Socket
s = (STM (), IO ()) -> STM ()
forall a b. (a, b) -> a
fst ((STM (), IO ()) -> STM ()) -> IO (STM (), IO ()) -> IO (STM ())
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Socket -> IO (STM (), IO ())
waitAndCancelWriteSocketSTM Socket
s

-- | STM action to wait until the socket is ready for writing and STM
--   action to cancel the waiting.
--
--   __POSIX only.__  See 'waitWriteSocketSTM'.
waitAndCancelWriteSocketSTM :: Socket -> IO (STM (), IO ())
#if defined(mingw32_HOST_OS)
waitAndCancelWriteSocketSTM _ =
    ioError $
        userError $
            "waitAndCancelWriteSocketSTM: Windows completion ports do not "
                ++ "provide readiness notification, and none is needed for "
                ++ "sending: issue the send instead"
#else
waitAndCancelWriteSocketSTM :: Socket -> IO (STM (), IO ())
waitAndCancelWriteSocketSTM Socket
s = Socket -> (CInt -> IO (STM (), IO ())) -> IO (STM (), IO ())
forall r. Socket -> (CInt -> IO r) -> IO r
withFdSocket Socket
s ((CInt -> IO (STM (), IO ())) -> IO (STM (), IO ()))
-> (CInt -> IO (STM (), IO ())) -> IO (STM (), IO ())
forall a b. (a -> b) -> a -> b
$ Fd -> IO (STM (), IO ())
threadWaitWriteSTM (Fd -> IO (STM (), IO ()))
-> (CInt -> Fd) -> CInt -> IO (STM (), IO ())
forall b c a. (b -> c) -> (a -> b) -> a -> c
. CInt -> Fd
Fd
#endif