From 92a9e5663540e47d1f4563aca4365ecce781205f Mon Sep 17 00:00:00 2001 From: Tom Smeding Date: Fri, 8 May 2026 20:58:08 +0100 Subject: Catch error in sendMany and don't throw --- .../Network/HTTP/Server/Mini/Printer.hs | 35 +++++++++++++--------- 1 file changed, 21 insertions(+), 14 deletions(-) diff --git a/mini-http-server/Network/HTTP/Server/Mini/Printer.hs b/mini-http-server/Network/HTTP/Server/Mini/Printer.hs index ab6c1f6..77b88ce 100644 --- a/mini-http-server/Network/HTTP/Server/Mini/Printer.hs +++ b/mini-http-server/Network/HTTP/Server/Mini/Printer.hs @@ -9,6 +9,7 @@ import Network.Socket import Network.Socket.ByteString import Network.HTTP.Server.Mini.Types +import System.IO.Error (catchIOError) sendResponse :: Socket -> Response -> IO () @@ -20,20 +21,26 @@ sendResponse conn (Response status hdrs (BodyFile path)) = sendResponseChunks :: Socket -> Status -> [(Header, ByteString)] -> BSL.ByteString -> IO () sendResponseChunks conn (Status code reason) hdrs body = - sendMany conn $ - BSL.toStrict (BSB.toLazyByteString - (BSB.shortByteString "HTTP/1.1 " - <> BSB.intDec code - <> BSB.char8 ' ' - <> BSB.shortByteString reason - <> BSB.shortByteString "\r\n" - <> foldMap (\(key, val) -> - BSB.shortByteString key <> BSB.shortByteString ": " - <> BSB.byteString (wrapHdrVal val) <> BSB.shortByteString "\r\n") - hdrs - <> BSB.shortByteString "Content-Length: " <> BSB.int64Dec (BSL.length body) - <> BSB.shortByteString "\r\nConnection: close\r\n\r\n")) - : BSL.toChunks body + catchIOError + (sendMany conn $ + BSL.toStrict (BSB.toLazyByteString + (BSB.shortByteString "HTTP/1.1 " + <> BSB.intDec code + <> BSB.char8 ' ' + <> BSB.shortByteString reason + <> BSB.shortByteString "\r\n" + <> foldMap (\(key, val) -> + BSB.shortByteString key <> BSB.shortByteString ": " + <> BSB.byteString (wrapHdrVal val) <> BSB.shortByteString "\r\n") + hdrs + <> BSB.shortByteString "Content-Length: " <> BSB.int64Dec (BSL.length body) + <> BSB.shortByteString "\r\nConnection: close\r\n\r\n")) + : BSL.toChunks body) + (\_ -> + -- If an IO error occurs during sending, that ought to be sendMany, in + -- which case we just exit: if we can't write, we won't be able to write + -- in the future, and we might as well give up on this connection. + return ()) wrapHdrVal :: ByteString -> ByteString wrapHdrVal bs = BS.intercalate (BS.singleton 32) (BS.split 10 bs) -- cgit v1.3.1