summaryrefslogtreecommitdiff
path: root/mini-http-server/Network/HTTP/Server/Mini/Printer.hs
diff options
context:
space:
mode:
Diffstat (limited to 'mini-http-server/Network/HTTP/Server/Mini/Printer.hs')
-rw-r--r--mini-http-server/Network/HTTP/Server/Mini/Printer.hs39
1 files changed, 39 insertions, 0 deletions
diff --git a/mini-http-server/Network/HTTP/Server/Mini/Printer.hs b/mini-http-server/Network/HTTP/Server/Mini/Printer.hs
new file mode 100644
index 0000000..ab6c1f6
--- /dev/null
+++ b/mini-http-server/Network/HTTP/Server/Mini/Printer.hs
@@ -0,0 +1,39 @@
+{-# LANGUAGE OverloadedStrings #-}
+module Network.HTTP.Server.Mini.Printer where
+
+import Data.ByteString (ByteString)
+import Data.ByteString qualified as BS
+import Data.ByteString.Lazy qualified as BSL
+import Data.ByteString.Builder qualified as BSB
+import Network.Socket
+import Network.Socket.ByteString
+
+import Network.HTTP.Server.Mini.Types
+
+
+sendResponse :: Socket -> Response -> IO ()
+sendResponse conn (Response status hdrs (BodyLBS body)) =
+ sendResponseChunks conn status hdrs body
+sendResponse conn (Response status hdrs (BodyFile path)) =
+ -- lazy IO is fine here because the whole thing is traversed before the end of this function in sendMany
+ sendResponseChunks conn status hdrs =<< BSL.readFile 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
+
+wrapHdrVal :: ByteString -> ByteString
+wrapHdrVal bs = BS.intercalate (BS.singleton 32) (BS.split 10 bs)