packages feed

network-simple 0.4.1 → 0.4.2

raw patch · 3 files changed

+137/−95 lines, 3 filesdep +safe-exceptions

Dependencies added: safe-exceptions

Files

changelog.md view
@@ -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.
network-simple.cabal view
@@ -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
src/Network/Simple/TCP.hs view
@@ -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 ())