From 4e8ce090d4dc973573540dca5423fc02edd9071b Mon Sep 17 00:00:00 2001
From: Simon Kohlmeyer <simon.kohlmeyer@gmail.com>
Date: Wed, 5 Apr 2023 22:43:01 +0200
Subject: [PATCH] Add docs for shutting down sockets in a threaded scenario

---
 Network/Socket.hs          | 38 ++++++++++++++++++++++++++++++++++++++
 Network/Socket/Shutdown.hs |  6 ++++++
 2 files changed, 44 insertions(+)

diff --git a/Network/Socket.hs b/Network/Socket.hs
index 72559564..6165346d 100644
--- a/Network/Socket.hs
+++ b/Network/Socket.hs
@@ -100,6 +100,44 @@
 -- unexpected things would happen. There is one exception for multiple
 -- threads vs a single 'Socket': one thread reads data from a 'Socket'
 -- only and the other thread writes data to the 'Socket' only.
+--
+-- The preferred way to terminate a thread that is blocked on a call to
+-- 'Network.Socket.ByteString.recv' is to use 'shutdown'
+--
+-- > import Control.Concurrent (forkFinally, threadDelay)
+-- > import qualified Control.Exception as E
+-- > import Control.Monad (forever, guard, void)
+-- > import Control.Monad.IO.Class (liftIO)
+-- > import Control.Monad.Trans.Maybe (runMaybeT)
+-- > import qualified Data.ByteString as BS
+-- > import Network.Socket
+-- > import Network.Socket.ByteString
+-- >
+-- > main =
+-- >   let maxQueuedConnections = 3
+-- >       gracefulCloseTimeout = 5000
+-- >    in do
+-- >         sock <- socket AF_UNIX Stream defaultProtocol
+-- >         bind sock (SockAddrUnix "./socket")
+-- >         listen sock maxQueuedConnections
+-- >
+-- >         E.bracketOnError (accept sock) (\(connectedSock, _) -> close connectedSock) $
+-- >           \(connectedSock, _) -> void $ do
+-- >             forkFinally
+-- >               (printer connectedSock)
+-- >               (const $ gracefulClose connectedSock gracefulCloseTimeout >> print "closed")
+-- >
+-- >             threadDelay (5_000_000)
+-- >             putStrLn "Time's up"
+-- >             shutdown connectedSock ShutdownBoth
+-- >
+-- > printer :: Socket -> IO ()
+-- > printer connectedSock =
+-- >   -- https://www.haskellforall.com/2012/07/breaking-from-loop.html
+-- >   void $ runMaybeT $ forever $ do
+-- >     bytes <- liftIO $ recv connectedSock 4096
+-- >     guard $ not (BS.null bytes)
+-- >     liftIO $ print $ "Got bytes: " <> show bytes
 -----------------------------------------------------------------------------
 
 -- In order to process this file, you need to have CALLCONV defined.
diff --git a/Network/Socket/Shutdown.hs b/Network/Socket/Shutdown.hs
index b29f6406..2b215b0c 100644
--- a/Network/Socket/Shutdown.hs
+++ b/Network/Socket/Shutdown.hs
@@ -32,6 +32,12 @@ sdownCmdToInt ShutdownBoth    = 2
 -- 'ShutdownReceive', further receives are disallowed.  If it is
 -- 'ShutdownSend', further sends are disallowed.  If it is
 -- 'ShutdownBoth', further sends and receives are disallowed.
+--
+-- This will wake up all threads that are blocked on a
+-- 'Network.Socket.ByteString.recv' call on this socket, regardless
+-- of which 'ShutdownCmd' is given.
+-- Calling shutdown on a socket is the preferred way to abort a
+-- connection from another thread.
 shutdown :: Socket -> ShutdownCmd -> IO ()
 shutdown s stype = void $ withFdSocket s $ \fd ->
   throwSocketErrorIfMinus1Retry_ "Network.Socket.shutdown" $