{-# LANGUAGE BangPatterns #-}
{-# LANGUAGE DuplicateRecordFields #-}
{-# LANGUAGE LambdaCase #-}
{-# LANGUAGE NamedFieldPuns #-}
{-# LANGUAGE PatternSynonyms #-}
{-# LANGUAGE ScopedTypeVariables #-}

{- | Note: The functions that are designated as being intended for stream
sockets convert a reception length of zero to an non-standard @EOI@ error
code. Datagram reception functions do not do this.
-}
module Network.Unexceptional.MutableBytes
  ( -- * Stream Sockets
    receive
  , receiveInterruptible
  , receiveExactly
  , receiveExactlyInterruptible

    -- * Datagram Sockets
  , receiveFromInterruptible
  ) where

import Control.Applicative ((<|>))
import Control.Concurrent.STM (STM, TVar)
import Control.Exception (throwIO)
import Control.Monad ((<=<))
import Data.Bytes.Types (MutableBytes (MutableBytes))
import Data.Functor (($>))
import Data.Primitive (MutableByteArray)
import Foreign.C.Error (Errno)
import Foreign.C.Error.Pattern
  ( pattern EAGAIN
  , pattern EEOI
  , pattern EWOULDBLOCK
  )
import Foreign.C.Types (CSize)
import Foreign.Ptr (castPtr)
import GHC.Conc (threadWaitRead, threadWaitReadSTM)
import GHC.Exts (Ptr, RealWorld)
import Network.Socket (SockAddr, Socket)
import Network.Socket.Address (peekSocketAddress)
import System.Posix.Types (Fd (Fd))

import qualified Control.Concurrent.STM as STM
import qualified Data.Bytes.Types
import qualified Data.Primitive as PM
import qualified Linux.Socket as X
import qualified Network.Socket as S
import qualified Network.Unexceptional.Types as Types
import qualified Posix.Socket as X

{- | Receive bytes from a socket. Receives at most N bytes, where N
is the size of the buffer. Returns the number of bytes that were
actually received.
-}
receive ::
  Socket ->
  -- | Slice of a buffer
  MutableBytes RealWorld ->
  IO (Either Errno Int)
receive :: Socket -> MutableBytes RealWorld -> IO (Either Errno Int)
receive Socket
s MutableBytes {MutableByteArray RealWorld
array :: MutableByteArray RealWorld
$sel:array:MutableBytes :: forall s. MutableBytes s -> MutableByteArray s
array, Int
offset :: Int
$sel:offset:MutableBytes :: forall s. MutableBytes s -> Int
offset, $sel:length:MutableBytes :: forall s. MutableBytes s -> Int
length = Int
len} =
  if Int
len Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
0
    then Socket -> (CInt -> IO (Either Errno Int)) -> IO (Either Errno Int)
forall r. Socket -> (CInt -> IO r) -> IO r
S.withFdSocket Socket
s ((CInt -> IO (Either Errno Int)) -> IO (Either Errno Int))
-> (CInt -> IO (Either Errno Int)) -> IO (Either Errno Int)
forall a b. (a -> b) -> a -> b
$ \CInt
fd ->
      -- We attempt the first receive without testing if the socket is
      -- ready for reads.
      Fd
-> MutableByteArray RealWorld
-> Int
-> Int
-> IO (Either Errno Int)
receiveLoop (CInt -> Fd
Fd CInt
fd) MutableByteArray RealWorld
array Int
offset Int
len
    else NonpositiveReceptionSize -> IO (Either Errno Int)
forall e a. Exception e => e -> IO a
throwIO NonpositiveReceptionSize
Types.NonpositiveReceptionSize

{- | Receive bytes from a socket. Receives at most N bytes, where N
is the size of the buffer. Returns the number of bytes that were
actually received.
-}
receiveFromInterruptible ::
  TVar Bool ->
  Socket ->
  -- | Slice of a buffer
  MutableBytes RealWorld ->
  IO (Either Errno (Int, SockAddr))
receiveFromInterruptible :: TVar Bool
-> Socket
-> MutableBytes RealWorld
-> IO (Either Errno (Int, SockAddr))
receiveFromInterruptible !TVar Bool
interrupt Socket
s MutableBytes {MutableByteArray RealWorld
$sel:array:MutableBytes :: forall s. MutableBytes s -> MutableByteArray s
array :: MutableByteArray RealWorld
array, Int
$sel:offset:MutableBytes :: forall s. MutableBytes s -> Int
offset :: Int
offset, $sel:length:MutableBytes :: forall s. MutableBytes s -> Int
length = Int
len} =
  if Int
len Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
0
    then Socket
-> (CInt -> IO (Either Errno (Int, SockAddr)))
-> IO (Either Errno (Int, SockAddr))
forall r. Socket -> (CInt -> IO r) -> IO r
S.withFdSocket Socket
s ((CInt -> IO (Either Errno (Int, SockAddr)))
 -> IO (Either Errno (Int, SockAddr)))
-> (CInt -> IO (Either Errno (Int, SockAddr)))
-> IO (Either Errno (Int, SockAddr))
forall a b. (a -> b) -> a -> b
$ \CInt
fd -> do
      -- We attempt the first receive without testing if the socket is
      -- ready for reads.
      TVar Bool
-> Fd
-> MutableByteArray RealWorld
-> Int
-> Int
-> IO (Either Errno (Int, SockAddr))
receiveFromInterruptibleLoop TVar Bool
interrupt (CInt -> Fd
Fd CInt
fd) MutableByteArray RealWorld
array Int
offset Int
len
    else NonpositiveReceptionSize -> IO (Either Errno (Int, SockAddr))
forall e a. Exception e => e -> IO a
throwIO NonpositiveReceptionSize
Types.NonpositiveReceptionSize

receiveFromInterruptibleLoop ::
  TVar Bool ->
  Fd ->
  MutableByteArray RealWorld ->
  Int ->
  Int ->
  IO (Either Errno (Int, SockAddr))
receiveFromInterruptibleLoop :: TVar Bool
-> Fd
-> MutableByteArray RealWorld
-> Int
-> Int
-> IO (Either Errno (Int, SockAddr))
receiveFromInterruptibleLoop !TVar Bool
intr !Fd
fd !MutableByteArray RealWorld
dst !Int
doff !Int
dlen =
  Fd
-> MutableByteArray RealWorld
-> Int
-> CSize
-> MessageFlags 'Receive
-> CInt
-> IO (Either Errno (CInt, SocketAddress, CSize))
X.uninterruptibleReceiveFromMutableByteArray Fd
fd MutableByteArray RealWorld
dst Int
doff (Int -> CSize
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
dlen :: CSize) MessageFlags 'Receive
forall a. Monoid a => a
mempty CInt
128 IO (Either Errno (CInt, SocketAddress, CSize))
-> (Either Errno (CInt, SocketAddress, CSize)
    -> IO (Either Errno (Int, SockAddr)))
-> IO (Either Errno (Int, SockAddr))
forall a b. IO a -> (a -> IO b) -> IO b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
    Left Errno
e ->
      if Errno
e Errno -> Errno -> Bool
forall a. Eq a => a -> a -> Bool
== Errno
EAGAIN Bool -> Bool -> Bool
|| Errno
e Errno -> Errno -> Bool
forall a. Eq a => a -> a -> Bool
== Errno
EWOULDBLOCK
        then
          TVar Bool -> Fd -> IO Outcome
waitUntilReadable TVar Bool
intr Fd
fd IO Outcome
-> (Outcome -> IO (Either Errno (Int, SockAddr)))
-> IO (Either Errno (Int, SockAddr))
forall a b. IO a -> (a -> IO b) -> IO b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
            Outcome
Ready -> TVar Bool
-> Fd
-> MutableByteArray RealWorld
-> Int
-> Int
-> IO (Either Errno (Int, SockAddr))
receiveFromInterruptibleLoop TVar Bool
intr Fd
fd MutableByteArray RealWorld
dst Int
doff Int
dlen
            Outcome
Interrupted -> Either Errno (Int, SockAddr) -> IO (Either Errno (Int, SockAddr))
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Errno -> Either Errno (Int, SockAddr)
forall a b. a -> Either a b
Left Errno
EAGAIN)
        else Either Errno (Int, SockAddr) -> IO (Either Errno (Int, SockAddr))
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Errno -> Either Errno (Int, SockAddr)
forall a b. a -> Either a b
Left Errno
e)
    Right (CInt
sockAddrSz, X.SocketAddress ByteArray
sockAddr, CSize
recvSzC) -> do
      let sockAddrSzI :: Int
sockAddrSzI = CInt -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral CInt
sockAddrSz :: Int
      MutableByteArray RealWorld
pinned <- Int -> IO (MutableByteArray (PrimState IO))
forall (m :: * -> *).
PrimMonad m =>
Int -> m (MutableByteArray (PrimState m))
PM.newPinnedByteArray Int
sockAddrSzI
      MutableByteArray (PrimState IO)
-> Int -> ByteArray -> Int -> Int -> IO ()
forall (m :: * -> *).
PrimMonad m =>
MutableByteArray (PrimState m)
-> Int -> ByteArray -> Int -> Int -> m ()
PM.copyByteArray MutableByteArray RealWorld
MutableByteArray (PrimState IO)
pinned Int
0 ByteArray
sockAddr Int
0 Int
sockAddrSzI
      ByteArray
pinned' <- MutableByteArray (PrimState IO) -> IO ByteArray
forall (m :: * -> *).
PrimMonad m =>
MutableByteArray (PrimState m) -> m ByteArray
PM.unsafeFreezeByteArray MutableByteArray RealWorld
MutableByteArray (PrimState IO)
pinned
      SockAddr
sockAddrNetwork <- ByteArray -> (Ptr Word8 -> IO SockAddr) -> IO SockAddr
forall (m :: * -> *) a.
PrimBase m =>
ByteArray -> (Ptr Word8 -> m a) -> m a
PM.withByteArrayContents ByteArray
pinned' ((Ptr Word8 -> IO SockAddr) -> IO SockAddr)
-> (Ptr Word8 -> IO SockAddr) -> IO SockAddr
forall a b. (a -> b) -> a -> b
$ \Ptr Word8
ptr -> do
        Ptr SockAddr -> IO SockAddr
forall sa. SocketAddress sa => Ptr sa -> IO sa
peekSocketAddress (Ptr Word8 -> Ptr sa
forall a b. Ptr a -> Ptr b
castPtr Ptr Word8
ptr :: Ptr sa)
      let recvSz :: Int
recvSz = CSize -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral CSize
recvSzC :: Int
       in case Int -> Int -> Ordering
forall a. Ord a => a -> a -> Ordering
compare Int
recvSz Int
dlen of
            Ordering
GT -> ReceivedTooManyBytes -> IO (Either Errno (Int, SockAddr))
forall e a. Exception e => e -> IO a
throwIO ReceivedTooManyBytes
Types.ReceivedTooManyBytes
            Ordering
_ -> Either Errno (Int, SockAddr) -> IO (Either Errno (Int, SockAddr))
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ((Int, SockAddr) -> Either Errno (Int, SockAddr)
forall a b. b -> Either a b
Right (Int
recvSz, SockAddr
sockAddrNetwork))

receiveInterruptible ::
  -- | Interrupt
  TVar Bool ->
  Socket ->
  -- | Slice of a buffer
  MutableBytes RealWorld ->
  IO (Either Errno Int)
receiveInterruptible :: TVar Bool
-> Socket -> MutableBytes RealWorld -> IO (Either Errno Int)
receiveInterruptible !TVar Bool
interrupt Socket
s MutableBytes {MutableByteArray RealWorld
$sel:array:MutableBytes :: forall s. MutableBytes s -> MutableByteArray s
array :: MutableByteArray RealWorld
array, Int
$sel:offset:MutableBytes :: forall s. MutableBytes s -> Int
offset :: Int
offset, $sel:length:MutableBytes :: forall s. MutableBytes s -> Int
length = Int
len} =
  if Int
len Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
0
    then Socket -> (CInt -> IO (Either Errno Int)) -> IO (Either Errno Int)
forall r. Socket -> (CInt -> IO r) -> IO r
S.withFdSocket Socket
s ((CInt -> IO (Either Errno Int)) -> IO (Either Errno Int))
-> (CInt -> IO (Either Errno Int)) -> IO (Either Errno Int)
forall a b. (a -> b) -> a -> b
$ \CInt
fd ->
      -- We attempt the first receive without testing if the socket is
      -- ready for reads.
      TVar Bool
-> Fd
-> MutableByteArray RealWorld
-> Int
-> Int
-> IO (Either Errno Int)
receiveInterruptibleLoop TVar Bool
interrupt (CInt -> Fd
Fd CInt
fd) MutableByteArray RealWorld
array Int
offset Int
len
    else NonpositiveReceptionSize -> IO (Either Errno Int)
forall e a. Exception e => e -> IO a
throwIO NonpositiveReceptionSize
Types.NonpositiveReceptionSize

-- Does not wait for file descriptor to be ready. Only performs
-- a single successful recv syscall
receiveLoop :: Fd -> MutableByteArray RealWorld -> Int -> Int -> IO (Either Errno Int)
receiveLoop :: Fd
-> MutableByteArray RealWorld
-> Int
-> Int
-> IO (Either Errno Int)
receiveLoop !Fd
fd !MutableByteArray RealWorld
arr !Int
off !Int
len =
  Fd
-> MutableByteArray RealWorld
-> Int
-> CSize
-> MessageFlags 'Receive
-> IO (Either Errno CSize)
X.uninterruptibleReceiveMutableByteArray Fd
fd MutableByteArray RealWorld
arr Int
off (Int -> CSize
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
len) MessageFlags 'Receive
forall (m :: Message). MessageFlags m
X.dontWait IO (Either Errno CSize)
-> (Either Errno CSize -> IO (Either Errno Int))
-> IO (Either Errno Int)
forall a b. IO a -> (a -> IO b) -> IO b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
    Left Errno
e ->
      if Errno
e Errno -> Errno -> Bool
forall a. Eq a => a -> a -> Bool
== Errno
EAGAIN Bool -> Bool -> Bool
|| Errno
e Errno -> Errno -> Bool
forall a. Eq a => a -> a -> Bool
== Errno
EWOULDBLOCK
        then do
          Fd -> IO ()
threadWaitRead Fd
fd
          Fd
-> MutableByteArray RealWorld
-> Int
-> Int
-> IO (Either Errno Int)
receiveLoop Fd
fd MutableByteArray RealWorld
arr Int
off Int
len
        else Either Errno Int -> IO (Either Errno Int)
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Errno -> Either Errno Int
forall a b. a -> Either a b
Left Errno
e)
    Right CSize
recvSzC ->
      let recvSz :: Int
recvSz = CSize -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral CSize
recvSzC :: Int
       in case Int
recvSz of
            Int
0 -> Either Errno Int -> IO (Either Errno Int)
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Errno -> Either Errno Int
forall a b. a -> Either a b
Left Errno
EEOI)
            Int
_ -> case Int -> Int -> Ordering
forall a. Ord a => a -> a -> Ordering
compare Int
recvSz Int
len of
              Ordering
GT -> ReceivedTooManyBytes -> IO (Either Errno Int)
forall e a. Exception e => e -> IO a
throwIO ReceivedTooManyBytes
Types.ReceivedTooManyBytes
              Ordering
_ -> Either Errno Int -> IO (Either Errno Int)
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Int -> Either Errno Int
forall a b. b -> Either a b
Right Int
recvSz)

-- Does not wait for file descriptor to be ready. Only performs
-- a single successful recv syscall
receiveInterruptibleLoop :: TVar Bool -> Fd -> MutableByteArray RealWorld -> Int -> Int -> IO (Either Errno Int)
receiveInterruptibleLoop :: TVar Bool
-> Fd
-> MutableByteArray RealWorld
-> Int
-> Int
-> IO (Either Errno Int)
receiveInterruptibleLoop !TVar Bool
interrupt !Fd
fd !MutableByteArray RealWorld
arr !Int
off !Int
len =
  Fd
-> MutableByteArray RealWorld
-> Int
-> CSize
-> MessageFlags 'Receive
-> IO (Either Errno CSize)
X.uninterruptibleReceiveMutableByteArray Fd
fd MutableByteArray RealWorld
arr Int
off (Int -> CSize
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
len) MessageFlags 'Receive
forall (m :: Message). MessageFlags m
X.dontWait IO (Either Errno CSize)
-> (Either Errno CSize -> IO (Either Errno Int))
-> IO (Either Errno Int)
forall a b. IO a -> (a -> IO b) -> IO b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
    Left Errno
e ->
      if Errno
e Errno -> Errno -> Bool
forall a. Eq a => a -> a -> Bool
== Errno
EAGAIN Bool -> Bool -> Bool
|| Errno
e Errno -> Errno -> Bool
forall a. Eq a => a -> a -> Bool
== Errno
EWOULDBLOCK
        then
          TVar Bool -> Fd -> IO Outcome
waitUntilReadable TVar Bool
interrupt Fd
fd IO Outcome
-> (Outcome -> IO (Either Errno Int)) -> IO (Either Errno Int)
forall a b. IO a -> (a -> IO b) -> IO b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
            Outcome
Ready -> TVar Bool
-> Fd
-> MutableByteArray RealWorld
-> Int
-> Int
-> IO (Either Errno Int)
receiveInterruptibleLoop TVar Bool
interrupt Fd
fd MutableByteArray RealWorld
arr Int
off Int
len
            Outcome
Interrupted -> Either Errno Int -> IO (Either Errno Int)
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Errno -> Either Errno Int
forall a b. a -> Either a b
Left Errno
EAGAIN)
        else Either Errno Int -> IO (Either Errno Int)
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Errno -> Either Errno Int
forall a b. a -> Either a b
Left Errno
e)
    Right CSize
recvSzC ->
      let recvSz :: Int
recvSz = CSize -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral CSize
recvSzC :: Int
       in case Int
recvSz of
            Int
0 -> Either Errno Int -> IO (Either Errno Int)
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Errno -> Either Errno Int
forall a b. a -> Either a b
Left Errno
EEOI)
            Int
_ -> case Int -> Int -> Ordering
forall a. Ord a => a -> a -> Ordering
compare Int
recvSz Int
len of
              Ordering
GT -> ReceivedTooManyBytes -> IO (Either Errno Int)
forall e a. Exception e => e -> IO a
throwIO ReceivedTooManyBytes
Types.ReceivedTooManyBytes
              Ordering
_ -> Either Errno Int -> IO (Either Errno Int)
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Int -> Either Errno Int
forall a b. b -> Either a b
Right Int
recvSz)

checkFinished :: TVar Bool -> STM ()
checkFinished :: TVar Bool -> STM ()
checkFinished = Bool -> STM ()
STM.check (Bool -> STM ()) -> (TVar Bool -> STM Bool) -> TVar Bool -> STM ()
forall (m :: * -> *) b c a.
Monad m =>
(b -> m c) -> (a -> m b) -> a -> m c
<=< TVar Bool -> STM Bool
forall a. TVar a -> STM a
STM.readTVar

data Outcome = Ready | Interrupted

waitUntilReadable :: TVar Bool -> Fd -> IO Outcome
waitUntilReadable :: TVar Bool -> Fd -> IO Outcome
waitUntilReadable !TVar Bool
interrupt !Fd
fd = do
  (STM ()
isReadyAction, IO ()
deregister) <- Fd -> IO (STM (), IO ())
threadWaitReadSTM Fd
fd
  Outcome
outcome <- STM Outcome -> IO Outcome
forall a. STM a -> IO a
STM.atomically (STM Outcome -> IO Outcome) -> STM Outcome -> IO Outcome
forall a b. (a -> b) -> a -> b
$ (TVar Bool -> STM ()
checkFinished TVar Bool
interrupt STM () -> Outcome -> STM Outcome
forall (f :: * -> *) a b. Functor f => f a -> b -> f b
$> Outcome
Interrupted) STM Outcome -> STM Outcome -> STM Outcome
forall a. STM a -> STM a -> STM a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> (STM ()
isReadyAction STM () -> Outcome -> STM Outcome
forall (f :: * -> *) a b. Functor f => f a -> b -> f b
$> Outcome
Ready)
  IO ()
deregister
  Outcome -> IO Outcome
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Outcome
outcome

-- | Blocks until an exact number of bytes has been received.
receiveExactly ::
  Socket ->
  -- | Length is the exact number of bytes to receive,
  -- must be greater than zero.
  MutableBytes RealWorld ->
  IO (Either Errno ())
receiveExactly :: Socket -> MutableBytes RealWorld -> IO (Either Errno ())
receiveExactly Socket
s (MutableBytes MutableByteArray RealWorld
dst Int
off0 Int
n) =
  if Int
n Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
0
    then do
      let loop :: Int -> Int -> IO (Either Errno ())
loop !Int
ix !Int
remaining = case Int
remaining of
            Int
0 -> Either Errno () -> IO (Either Errno ())
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (() -> Either Errno ()
forall a b. b -> Either a b
Right ())
            Int
_ ->
              Socket -> MutableBytes RealWorld -> IO (Either Errno Int)
receive Socket
s (MutableByteArray RealWorld -> Int -> Int -> MutableBytes RealWorld
forall s. MutableByteArray s -> Int -> Int -> MutableBytes s
MutableBytes MutableByteArray RealWorld
dst Int
ix Int
remaining) IO (Either Errno Int)
-> (Either Errno Int -> IO (Either Errno ()))
-> IO (Either Errno ())
forall a b. IO a -> (a -> IO b) -> IO b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
                Left Errno
e -> Either Errno () -> IO (Either Errno ())
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Errno -> Either Errno ()
forall a b. a -> Either a b
Left Errno
e)
                Right Int
k -> Int -> Int -> IO (Either Errno ())
loop (Int
ix Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
k) (Int
remaining Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
k)
      Int -> Int -> IO (Either Errno ())
loop Int
off0 Int
n
    else NonpositiveReceptionSize -> IO (Either Errno ())
forall e a. Exception e => e -> IO a
throwIO NonpositiveReceptionSize
Types.NonpositiveReceptionSize

receiveExactlyInterruptible ::
  TVar Bool ->
  Socket ->
  -- | Length is the exact number of bytes to receive,
  -- must be greater than zero.
  MutableBytes RealWorld ->
  IO (Either Errno ())
receiveExactlyInterruptible :: TVar Bool
-> Socket -> MutableBytes RealWorld -> IO (Either Errno ())
receiveExactlyInterruptible !TVar Bool
intr !Socket
s (MutableBytes MutableByteArray RealWorld
dst Int
off0 Int
n) =
  if Int
n Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
0
    then do
      let loop :: Int -> Int -> IO (Either Errno ())
loop !Int
ix !Int
remaining = case Int
remaining of
            Int
0 -> Either Errno () -> IO (Either Errno ())
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (() -> Either Errno ()
forall a b. b -> Either a b
Right ())
            Int
_ ->
              TVar Bool
-> Socket -> MutableBytes RealWorld -> IO (Either Errno Int)
receiveInterruptible TVar Bool
intr Socket
s (MutableByteArray RealWorld -> Int -> Int -> MutableBytes RealWorld
forall s. MutableByteArray s -> Int -> Int -> MutableBytes s
MutableBytes MutableByteArray RealWorld
dst Int
ix Int
remaining) IO (Either Errno Int)
-> (Either Errno Int -> IO (Either Errno ()))
-> IO (Either Errno ())
forall a b. IO a -> (a -> IO b) -> IO b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
                Left Errno
e -> Either Errno () -> IO (Either Errno ())
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Errno -> Either Errno ()
forall a b. a -> Either a b
Left Errno
e)
                Right Int
k -> Int -> Int -> IO (Either Errno ())
loop (Int
ix Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
k) (Int
remaining Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
k)
      Int -> Int -> IO (Either Errno ())
loop Int
off0 Int
n
    else NonpositiveReceptionSize -> IO (Either Errno ())
forall e a. Exception e => e -> IO a
throwIO NonpositiveReceptionSize
Types.NonpositiveReceptionSize