blob: 77b88cecbbbf044f7490d535211e911efb12eb1b (
plain)
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
|
{-# 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
import System.IO.Error (catchIOError)
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 =
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)
|
