{-# language BangPatterns #-} {-# language LambdaCase #-} {-# language MultiWayIf #-} module Datagram.Receive.Indefinite ( receive , receiveLoop , receiveAttempt ) where import Control.Concurrent.STM (TVar) import Foreign.C.Error (Errno(..), eAGAIN, eWOULDBLOCK, eCONNREFUSED) import Foreign.C.Types (CSize) import Socket.Error (die) import Socket.EventManager (Token) import Socket.Datagram (ReceiveException(..)) import Socket.Buffer (Buffer) import Socket.Interrupt (Interrupt,Intr,wait,tokenToDatagramReceiveException) import System.Posix.Types (Fd) import qualified Foreign.C.Error.Describe as D import qualified Socket.EventManager as EM import qualified Socket.Buffer as Buffer import qualified Datagram.Receive as Receive import qualified Linux.Socket as L -- Send the entirely of the buffer, making a single call to -- POSIX @send@. This is used for datagram sockets. We cannot use a -- Socket newtype here since connected and unconnected sockets -- apply Socket to different types. receive :: Interrupt -> Fd -> Buffer -> Receive.AddressBufferOffset -> IO (Either (ReceiveException Intr) Int) receive !intr !sock !buf !addrBuf = do let !mngr = EM.manager tv <- EM.reader mngr sock token0 <- wait intr tv case tokenToDatagramReceiveException token0 of Left err -> pure (Left err) Right _ -> receiveLoop intr tv token0 sock buf addrBuf receiveAttempt :: Fd -- ^ Socket -> Buffer -- ^ Buffer -> Receive.AddressBufferOffset -- ^ Buffer for the address -> IO (Either (ReceiveException Intr) (Maybe Int)) {-# inline receiveAttempt #-} receiveAttempt !fd !buf !addrBuf = do -- We use MSG_TRUNC so that we are able to figure out -- whether or not bytes were discarded. If bytes were -- discarded (meaning that the buffer was too small), -- we return an exception. e <- Receive.receiveFromOnce fd buf L.truncate addrBuf case e of Left err -> if | err == eWOULDBLOCK || err == eAGAIN -> pure (Right Nothing) | err == eCONNREFUSED -> pure (Left ReceiveConnectionRefused) | otherwise -> die $ concat [ "Socket.Datagram.receive: " , describeErrorCode err ] Right recvSz -> do let !recvSzInt = csizeToInt recvSz if recvSzInt <= Buffer.length buf then pure (Right (Just recvSzInt)) else pure (Left (ReceiveTruncated recvSzInt)) receiveLoop :: Interrupt -> TVar Token -> Token -> Fd -- ^ Socket -> Buffer -- ^ Buffer -> Receive.AddressBufferOffset -> IO (Either (ReceiveException Intr) Int) receiveLoop !intr !tv !token0 !fd !buf !addrBuf = receiveAttempt fd buf addrBuf >>= \case Left err -> pure (Left err) Right m -> case m of Nothing -> do EM.unready token0 tv token1 <- wait intr tv case tokenToDatagramReceiveException token1 of Left err -> pure (Left err) Right _ -> receiveLoop intr tv token1 fd buf addrBuf Just !r -> pure (Right r) csizeToInt :: CSize -> Int csizeToInt = fromIntegral describeErrorCode :: Errno -> String describeErrorCode err@(Errno e) = "error code " ++ D.string err ++ " (" ++ show e ++ ")"