diff --git a/changelog.md b/changelog.md --- a/changelog.md +++ b/changelog.md @@ -1,3 +1,20 @@ +# Version 0.4.2 + +* Deprecate `sendMany` in favor of `sendLazy`. + +* Generalize return type of `serve`. + +* Silence all synchronous exceptions on socket shutdown and close. + +* Better exception handling everywhere. + +* Added dependency on `safe-exceptions`. + +* Added `listenSock`. + +* Improved documentation. + + # Version 0.4.1 * Fix `HostAny` so that IPv6 addresses are correctly included as well. See #22. diff --git a/network-simple.cabal b/network-simple.cabal --- a/network-simple.cabal +++ b/network-simple.cabal @@ -1,5 +1,5 @@ name: network-simple -version: 0.4.1 +version: 0.4.2 homepage: https://github.com/k0001/network-simple bug-reports: https://github.com/k0001/network-simple/issues license: BSD3 @@ -38,3 +38,4 @@ , bytestring (>=0.9.2.1) , transformers (>=0.2) , exceptions (>=0.6) + , safe-exceptions diff --git a/src/Network/Simple/TCP.hs b/src/Network/Simple/TCP.hs --- a/src/Network/Simple/TCP.hs +++ b/src/Network/Simple/TCP.hs @@ -5,7 +5,7 @@ -- | This module exports functions that abstract simple TCP 'NS.Socket' -- usage patterns. -- --- This module uses 'MonadIO' and 'C.MonadMask' extensively so that you can +-- This module uses 'MonadIO' and 'Ex.MonadMask' extensively so that you can -- reuse these functions in monads other than 'IO'. However, if you don't care -- about any of that, just pretend you are using the 'IO' monad all the time -- and everything will work as expected. @@ -43,6 +43,7 @@ -- * Low level support , bindSock + , listenSock , connectSock , closeSock @@ -58,9 +59,9 @@ , NS.SockAddr ) where -import Control.Concurrent (ThreadId, forkIO, forkFinally) -import qualified Control.Exception as E -import qualified Control.Monad.Catch as C +import Control.Concurrent (ThreadId, forkIO) +import qualified Control.Exception as Ex (getMaskingState) +import qualified Control.Exception.Safe as Ex import Control.Monad import Control.Monad.IO.Class (MonadIO(liftIO)) import qualified Data.ByteString as BS @@ -69,6 +70,7 @@ import qualified Network.Socket as NS import qualified Network.Socket.ByteString as NSB import qualified Network.Socket.ByteString.Lazy as NSBL +import qualified System.IO as IO import System.Timeout (timeout) import Network.Simple.Internal @@ -121,20 +123,19 @@ -- | Connect to a TCP server and use the connection. -- --- The connection socket is closed when done or in case of exceptions. +-- The connection socket is shut down and closed when done or in case of +-- exceptions. -- -- If you prefer to acquire and close the socket yourself, then use -- 'connectSock' and 'closeSock'. connect - :: (MonadIO m, C.MonadMask m) - => NS.HostName -- ^Server hostname. - -> NS.ServiceName -- ^Server service port. + :: (MonadIO m, Ex.MonadMask m) + => NS.HostName -- ^ Server hostname or IP address. + -> NS.ServiceName -- ^ Server service port name or number. -> ((NS.Socket, NS.SockAddr) -> m r) - -- ^Computation taking the communication socket - -- and the server address. + -- ^ Computation taking the communication socket and the server address. -> m r -connect host port = C.bracket (connectSock host port) - (silentCloseSock . fst) +connect host port = Ex.bracket (connectSock host port) (closeSock . fst) -------------------------------------------------------------------------------- @@ -158,23 +159,28 @@ -- | Start a TCP server that accepts incoming connections and handles them -- concurrently in different threads. -- --- Any acquired network resources are properly closed and discarded when done or --- in case of exceptions. +-- Any acquired sockets are properly shut down and closed when done or in case +-- of exceptions. Exceptions from the threads handling the individual +-- connections won't cause 'serve' to die. -- --- Note: This function performs 'listen' and 'acceptFork', so you don't need to --- perform those manually. +-- Note: This function performs 'listen', 'acceptFork', so don't perform +-- those manually. serve :: MonadIO m - => HostPreference -- ^Preferred host to bind. - -> NS.ServiceName -- ^Service port to bind. + => HostPreference -- ^ Host to bind. + -> NS.ServiceName -- ^ Server service port name or number to bind. -> ((NS.Socket, NS.SockAddr) -> IO ()) - -- ^Computation to run in a different thread - -- once an incoming connection is accepted. Takes the - -- connection socket and remote end address. - -> m () + -- ^ Computation to run in a different thread once an incoming connection is + -- accepted. Takes the connection socket and remote end address. + -> m a -- ^ This function never returns. serve hp port k = liftIO $ do - listen hp port $ \(lsock,_) -> do - forever $ acceptFork lsock k + listen hp port $ \(lsock, _) -> do + forever $ Ex.catch + (void (acceptFork lsock k)) + (\se -> IO.hPutStrLn IO.stderr (x ++ show (se :: Ex.SomeException))) + where + x :: String + x = "Network.Simple.TCP.serve: Synchronous exception accepting connection: " -------------------------------------------------------------------------------- @@ -182,63 +188,71 @@ -- -- The listening socket is closed when done or in case of exceptions. -- --- If you prefer to acquire and close the socket yourself, then use 'bindSock', --- 'closeSock' and the 'NS.listen' function from "Network.Socket" instead. +-- If you prefer to acquire and close the socket yourself, then use 'bindSock' +-- and 'closeSock', as well as 'listenSock' function. -- --- Note: 'N.maxListenQueue' is typically 128, which is too small for high --- performance servers. So, we use the maximum between 'N.maxListenQueue' and --- 2048 as the default size of the listening queue. The 'NS.NoDelay' and --- 'NS.ReuseAddr' options are set on the socket. +-- Note: The 'NS.NoDelay' and 'NS.ReuseAddr' options are set on the socket. The +-- maximum number of incoming queued connections is 2048. listen - :: (MonadIO m, C.MonadMask m) - => HostPreference -- ^Preferred host to bind. - -> NS.ServiceName -- ^Service port to bind. + :: (MonadIO m, Ex.MonadMask m) + => HostPreference -- ^ Host to bind. + -> NS.ServiceName -- ^ Server service port name or number to bind. -> ((NS.Socket, NS.SockAddr) -> m r) - -- ^Computation taking the listening socket and - -- the address it's bound to. + -- ^ Computation taking the listening socket and the address it's bound to. -> m r -listen hp port = C.bracket listen' (silentCloseSock . fst) - where - listen' = do x@(bsock,_) <- bindSock hp port - liftIO $ NS.listen bsock $ max 2048 NS.maxListenQueue - return x +listen hp port = Ex.bracket + (do x@(bsock,_) <- bindSock hp port + listenSock bsock (max 2048 NS.maxListenQueue) + pure x) + (closeSock . fst) +-- | Listen for new connections of the given bound socket. +listenSock + :: MonadIO m + => NS.Socket -- ^ Bound socket. + -> Int + -- ^ Maximum number of incoming queued connections (we suggest @2048@ if you + -- don't have an opinion). + -> m () +listenSock bsock qs = liftIO (NS.listen bsock qs) + -------------------------------------------------------------------------------- -- | Accept a single incoming connection and use it. -- --- The connection socket is closed when done or in case of exceptions. +-- The connection socket is shut down and closed when done or in case of +-- exceptions. accept - :: (MonadIO m, C.MonadMask m) - => NS.Socket -- ^Listening and bound socket. + :: (MonadIO m, Ex.MonadMask m) + => NS.Socket -- ^ Listening and bound socket. -> ((NS.Socket, NS.SockAddr) -> m r) - -- ^Computation to run once an incoming - -- connection is accepted. Takes the connection socket - -- and remote end address. + -- ^ Computation to run once an incoming connection is accepted. Takes the + -- connection socket and remote end address. -> m r -accept lsock k = do - (csock, addr) <- liftIO (NS.accept lsock) - let conn = (csock, ipv4mapped_to_ipv4 addr) - C.finally (k conn) (silentCloseSock csock) +accept lsock k = Ex.mask $ \restore -> do + (csock, addr) <- restore (liftIO (NS.accept lsock)) + Ex.onException + (restore (k (csock, ipv4mapped_to_ipv4 addr))) + (closeSock csock) {-# INLINABLE accept #-} -- | Accept a single incoming connection and use it in a different thread. -- --- The connection socket is closed when done or in case of exceptions. +-- The connection socket is shut down and closed when done or in case of +-- exceptions. acceptFork :: MonadIO m - => NS.Socket -- ^Listening and bound socket. + => NS.Socket -- ^ Listening and bound socket. -> ((NS.Socket, NS.SockAddr) -> IO ()) - -- ^Computation to run in a different thread - -- once an incoming connection is accepted. Takes the - -- connection socket and remote end address. + -- ^ Computation to run in a different thread once an incoming connection is + -- accepted. Takes the connection socket and remote end address. -> m ThreadId -acceptFork lsock k = liftIO $ do - (csock,addr) <- NS.accept lsock - let conn = (csock, ipv4mapped_to_ipv4 addr) - forkFinally (k conn) - (\ea -> do silentCloseSock csock - either E.throwIO return ea) +acceptFork lsock k = liftIO $ Ex.mask $ \restore -> do + (csock, addr) <- restore (NS.accept lsock) + Ex.onException + (forkIO (Ex.finally (restore (k (csock, ipv4mapped_to_ipv4 addr))) + (closeSock csock))) + (closeSock csock) {-# INLINABLE acceptFork #-} -------------------------------------------------------------------------------- @@ -246,14 +260,17 @@ -- | Obtain a 'NS.Socket' connected to the given host and TCP service port. -- -- The obtained 'NS.Socket' should be closed manually using 'closeSock' when --- it's not needed anymore, otherwise you risk having the socket open for much --- longer than needed. +-- it's not needed anymore, otherwise you risk having the connection and socket +-- open for much longer than needed. -- -- Prefer to use 'connect' if you will be using the socket within a limited -- scope and would like it to be closed immediately after its usage or in case -- of exceptions. connectSock - :: MonadIO m => NS.HostName -> NS.ServiceName -> m (NS.Socket, NS.SockAddr) + :: MonadIO m + => NS.HostName -- ^ Server hostname or IP address. + -> NS.ServiceName -- ^ Server service port name or number. + -> m (NS.Socket, NS.SockAddr) -- ^ Connected socket and server address. connectSock host port = liftIO $ do addrs <- NS.getAddrInfo (Just hints) (Just host) (Just port) tryAddrs (happyEyeballSort addrs) @@ -264,20 +281,19 @@ , NS.addrSocketType = NS.Stream } tryAddrs :: [NS.AddrInfo] -> IO (NS.Socket, NS.SockAddr) tryAddrs = \case - [] -> fail "connectSock: No addresses available" + [] -> fail "Network.Simple.TCP.connectSock: No addresses available" [x] -> useAddr x - (x:xs) -> E.catch (useAddr x) (\(_ :: IOError) -> tryAddrs xs) + (x:xs) -> Ex.catch (useAddr x) (\(_ :: IOError) -> tryAddrs xs) useAddr :: NS.AddrInfo -> IO (NS.Socket, NS.SockAddr) useAddr addr = do yx <- timeout 1000000 $ do -- 1 second - E.bracketOnError (newSocket addr) closeSock $ \sock -> do + Ex.bracketOnError (newSocket addr) closeSock $ \sock -> do let sockAddr = NS.addrAddress addr NS.connect sock sockAddr pure (sock, sockAddr) case yx of - Nothing -> fail "connectSock: Timeout on connect" - Just x -> pure x - + Nothing -> fail "Network.Simple.TCP.connectSock: Timeout on connect" + Just x -> pure x -- | Obtain a 'NS.Socket' bound to the given host name and TCP service port. -- @@ -287,8 +303,13 @@ -- Prefer to use 'listen' if you will be listening on this socket and using it -- within a limited scope, and would like it to be closed immediately after its -- usage or in case of exceptions. +-- +-- Note: The 'NS.NoDelay' and 'NS.ReuseAddr' options are set on the socket. bindSock - :: MonadIO m => HostPreference -> NS.ServiceName -> m (NS.Socket, NS.SockAddr) + :: MonadIO m + => HostPreference -- ^ Host to bind. + -> NS.ServiceName -- ^ Server service port name or number to bind. + -> m (NS.Socket, NS.SockAddr) -- ^ Bound socket and address. bindSock hp port = liftIO $ do addrs <- NS.getAddrInfo (Just hints) (hpHostName hp) (Just port) tryAddrs $ case hp of @@ -305,21 +326,24 @@ tryAddrs = \case [] -> fail "bindSock: No addresses available" [x] -> useAddr x - (x:xs) -> E.catch (useAddr x) (\(_ :: IOError) -> tryAddrs xs) + (x:xs) -> Ex.catch (useAddr x) (\(_ :: IOError) -> tryAddrs xs) useAddr :: NS.AddrInfo -> IO (NS.Socket, NS.SockAddr) - useAddr addr = E.bracketOnError (newSocket addr) closeSock $ \sock -> do + useAddr addr = Ex.bracketOnError (newSocket addr) closeSock $ \sock -> do let sockAddr = NS.addrAddress addr NS.setSocketOption sock NS.NoDelay 1 NS.setSocketOption sock NS.ReuseAddr 1 when (isIPv6addr addr) $ do NS.setSocketOption sock NS.IPv6Only (if hp == HostIPv6 then 1 else 0) NS.bind sock sockAddr - return (sock, sockAddr) + pure (sock, sockAddr) --- | Close the 'NS.Socket'. +-- | Shuts down and closes the 'NS.Socket', silently ignoring any synchronous +-- exception that might happen. closeSock :: MonadIO m => NS.Socket -> m () -closeSock s = liftIO (E.finally (NS.shutdown s NS.ShutdownBoth) (NS.close s)) -{-# INLINABLE closeSock #-} +closeSock s = liftIO $ do + Ex.catch (Ex.finally (NS.shutdown s NS.ShutdownBoth) + (NS.close s)) + (\(_ :: Ex.SomeException) -> pure ()) -------------------------------------------------------------------------------- -- Utils @@ -327,34 +351,38 @@ -- | Read up to a limited number of bytes from a socket. -- -- Returns `Nothing` if the remote end closed the connection or end-of-input was --- reached. The number of returned bytes might be less than the specified limit. +-- reached. The number of returned bytes might be less than the specified limit, +-- but it will never 'BS.null'. recv :: MonadIO m => NS.Socket -> Int -> m (Maybe BS.ByteString) -recv sock nbytes = do - bs <- liftIO (NSB.recv sock nbytes) - if BS.null bs - then return Nothing - else return (Just bs) +recv sock nbytes = liftIO $ do + bs <- liftIO (NSB.recv sock nbytes) + if BS.null bs + then pure Nothing + else pure (Just bs) {-# INLINABLE recv #-} -- | Writes a 'BS.ByteString' to the socket. +-- +-- Note: On POSIX, calling 'sendLazy' once is much more efficient than +-- repeatedly calling 'send' on strict 'BS.ByteString's. Use @'sendLazy' sock . +-- 'BSL.fromChunks'@ if you have more than one strict 'BS.ByteString' to send. send :: MonadIO m => NS.Socket -> BS.ByteString -> m () send sock = \bs -> liftIO (NSB.sendAll sock bs) {-# INLINABLE send #-} -- | Writes a lazy 'BSL.ByteString' to the socket. +-- +-- Note: This uses @writev(2)@ on POSIX. sendLazy :: MonadIO m => NS.Socket -> BSL.ByteString -> m () {-# INLINABLE sendLazy #-} -#if !MIN_VERSION_network(2,7,0) && defined(mingw32_HOST_OS) -sendLazy sock = \lbs -> sendMany sock (BSL.toChunks lbs) -- see #13. -#else sendLazy sock = \lbs -> liftIO (NSBL.sendAll sock lbs) -#endif -- | Writes the given list of 'BS.ByteString's to the socket. --- This is faster than sending them individually. +-- +-- Note: This uses @writev(2)@ on POSIX. sendMany :: MonadIO m => NS.Socket -> [BS.ByteString] -> m () -sendMany sock = \bs -> liftIO (NSB.sendMany sock bs) -{-# INLINABLE sendMany #-} +sendMany sock = sendLazy sock . BSL.fromChunks +{-# DEPRECATED sendMany "Use @'sendLazy' sock . 'BSL.fromChunks'@" #-} -------------------------------------------------------------------------------- -- Misc @@ -364,7 +392,3 @@ (NS.addrSocketType addr) (NS.addrProtocol addr) --- | Like 'closeSock', except it swallows all 'IOError' exceptions. -silentCloseSock :: MonadIO m => NS.Socket -> m () -silentCloseSock sock = liftIO $ do - E.catch (closeSock sock) (\(_ :: IOError) -> return ())