Serializing an HTTP Response & Running the Server

Written By James Bowen

Welcome to the third and final part of our simple HTTP Server series. In Part 1, we defined our request and response types, showing how we can use documentation to understand these. In Part 2, we wrote a parser for the HTTP Request type, which will allow our server to understand the inputs we receive from clients. In this final part, we’ll define a function to produce a response, serialize that response, and wrap all this in an actual server.

If you want a more in depth tutorial on some of the aspects of this series, you can take a look at some of our Haskell courses! Solve.hs will teach you about parsing so that you can use Megaparsec effectively. And Practical Haskell will show you how to write a more advanced server with special Haskell type features!

Creating a Response

Before we get started, let’s recall what our main types look like:

newtype HttpHeaders = HttpHeaders
    (HM.HashMap ByteString ByteString)
    deriving (Show, Eq)

data HttpRequest = HttpRequest
    { requestMethod :: HttpMethod
    , requestUri :: ByteString
    , requestHttpVersion :: (Word8, Word8)
    , requestHeaders :: HttpHeaders
    , requestBody :: Maybe ByteString
    }
    deriving (Show, Eq)

data HttpResponse = HttpResponse
    { responseHttpVersion :: (Word8, Word8)
    , responseStatusCode :: Int
    , responseReason :: ByteString
    , responseHeaders :: HttpHeaders
    , responseBody :: Maybe ByteString
    }
    deriving (Show, Eq)

Last time, we parsed a request. Since we’re writing a very simple server, we won’t actually use much of anything in that request. We’ll just return a basic “200 OK” response if we parsed the request successfully, and a “400 Bad Request” response if we could not parse the request.

When we run a Megaparsec parser, we get an Either result thanks to this function:

runParserT :: ParsecT e s m a -> m (Either (ParseErrorBundle) a)

We don’t need to know much about ParseErrorBundle, except that it is Show-able. So we’ll write our server function to have this outline:

server :: (Show a) => Either a HttpRequest -> IO HttpResponse
server (Left e) = undefined
server (Right (HttpRequest m u v (HttpHeaders h) b)) = undefined

In the Left case, we want to build a response that has a 400 exit code, a “Bad Request” reason, and have it show the parse error for our response body. Here’s our first pass:

{-# LANGUAGE OverloadedStrings #-}

import qualified Data.HashMap.Lazy as HM
import qualified Data.ByteString.Lazy.Char8 as BSC

server :: (Show a) => Either a HttpRequest -> IO HttpResponse
server (Left e) =
    let body = BSC.pack (show e)
    in  return $ HttpResponse (1,1) 400 "Bad Request" (HttpHeaders HM.empty) (Just body)

There’s something missing though! When we return a response, we always want to include a Content-Length header so that the recipient knows how many bytes to parse for the body. It’s easy enough to add this though:

server :: (Show a) => Either a HttpRequest -> IO HttpResponse
server (Left e) =
    let body = BSC.pack (show e)
        headerMap = HM.singleton "Content-Length" (BSC.pack $ show (BS.length body))
    in  return $ HttpResponse (1,1) 400 "Bad Request" (HttpHeaders headerMap) (Just body)
server (Right (HttpRequest m u v (HttpHeaders h) b)) = undefined

The Right branch will have a similar look. We’ll just use a dummy body instead of reporting an error. The other difference here is that we’ll use the input’s HTTP version as our version.

server :: (Show a) => Either a HttpRequest -> IO HttpResponse
server (Left e) =
    let body = BSC.pack (show e)
        headerMap = HM.singleton "Content-Length" (BSC.pack $ show (BS.length body))
    in  return $ HttpResponse (1,1) 400 "Bad Request" (HttpHeaders headerMap) (Just body)
server (Right (HttpRequest m u v (HttpHeaders h) b)) = do
    let body = "This is the response body!"
    let headerMap = HM.singleton "Content-Length" (BSC.pack $ show (BS.length body))
    return $ HttpResponse v 200 "OK" (HttpHeaders headerMap) (Just body)

Serializing the Response

Now that we’ve got our response, we need to convert it to a ByteString! This is the opposite of parsing, but a lot of the same principles apply. We want to consider the specification of the response in our documentation, outline the structure of our response, write applicable helpers, and then fill everything in.

Here’s what a general outline might look like:

serializeHttpVersion :: (Word8, Word8) -> ByteString

serializeStatusCode :: Int -> ByteString

serializeHttpHeaders :: HttpHeaders -> ByteString

serializeBody :: Maybe ByteString -> ByteString

-- Not final!
serializeHttpResponse :: HttpResponse -> ByteString
serializeHttpResponse (HttpResponse v c r h b) =
    serializeHttpVersion v <> serializeStatusCode c <> r <>
    serializeHttpHeaders h <> serializeBody b

Obviously, we don’t need a special function to serialize the “reason” field since it’s already a ByteString! Additionally, it is easy enough to serialize the body with fromMaybe:

serializeHttpVersion :: (Word8, Word8) -> ByteString

serializeStatusCode :: Int -> ByteString

serializeHttpHeaders :: HttpHeaders -> ByteString

-- Not final!
serializeHttpResponse :: HttpResponse -> ByteString
serializeHttpResponse (HttpResponse v c r h b) =
    serializeHttpVersion v <> serializeStatusCode c <> r <>
    serializeHttpHeaders h <> end
    where
        end = fromMaybe “” b

However, we should consider as well the format of the “response line” and the headers in the documentation.

Here’s the full response format:

Response = Status-Line
           *(( general-header
            | response-header
            | entity-header ) CRLF)
           CRLF
           [ message-body ]

Here’s the response line:

Status-Line = HTTP-Version SP Status-Code SP Reason-Phrase CRLF

And here’s the header structure:

message-header = field-name ":" [ field-value ]
 field-name     = token
 field-value    = *( field-content | LWS )
 field-content  = <the OCTETs making up the field-value
                  and consisting of either *TEXT or combinations
                  of token, separators, and quoted-string>

Just as with parsing, we’ll want helpers to incorporate the SP character and CRLF sequence into our serialized bytestring using helpers.

Adding Helpers

Since prepending is generally more efficient with Haskell’s string manipulation that appending, we’ll write these helpers like so:

addSp :: ByteString -> ByteString
addSp = BS.cons (o ' ')

addCrlf :: ByteString -> ByteString
addCrlf = (<>) "\r\n"

Factoring these in, we can put spaces in front of the status code and reason, and a CLRF in front of the headers section. (We’ll handle the final CRLF before the body in serializeHttpHeaders).

serializeHttpResponse :: HttpResponse -> ByteString
serializeHttpResponse (HttpResponse v c r h b) =
    serializeHttpVersion v <> addSp (serializeStatusCode c) <> addSp r <>
    (addCrlf $ serializeHttpHeaders h) <> end
    where
        end = fromMaybe "" b

Version and Code

Now we just have to fill in the functions we outlined earlier. We can start with the HTTP version and the status code. These are straightforward, since we are mostly just using show and pack to convert these values into bytestrings. With the version, we also include the HTTP/ prefix and the . separator.

serializeHttpVersion :: (Word8, Word8) -> ByteString
serializeHttpVersion (d1, d2) = "HTTP/" <>
    (BSC.pack $ (show d1 <> ('.' : show d2)))

serializeStatusCode :: Int -> ByteString
serializeStatusCode = BSC.pack . show

Serializing Headers

Serializing headers is a little trickier, just like parsing them was. The crux of this is HashMap’s foldrWithKey function:

foldrWithKey :: (k -> v -> a -> a) -> a -> HashMap k v -> a

In this setup, k, v and a are all ByteStrings. We get k and v from the keys and values in our map. Then a is the resulting bytestring we construct by appending. Our “folding function” will take one key and value and prepend the line with these to the prior string. Here’s what that folding function looks like:

serializeHttpHeaders :: HttpHeaders -> ByteString
serializeHttpHeaders (HttpHeaders mp) = ...
    where
        f k v bs = k <> (o ':' `BS.cons` v) <> (addCrlf bs)

Starting from the right of this line, we prepend the CRLF for this line to the prior bytestring. Then we prepend a colon : to the value of this header. Finally we prepend the key, the name of the header to this. We invoke the fold like so:

serializeHttpHeaders :: HttpHeaders -> ByteString
serializeHttpHeaders (HttpHeaders mp) = HM.foldrWithKey f "\r\n" mp
    where
        f k v bs = k <> (o ':' `BS.cons` v) <> (addCrlf bs)

The “initial” bytestring is a CLRF, since the headers section must contain this sequence even without any headers. As an alternative though, we could have prepended it to our “body” portion as well and used an empty string here.

And believe it or not, we’ve tied up all the loose ends with serializing our response! That function should be working now. We just have to pull everything together at the server level.

Writing the Networking Layer

When writing a utility “from scratch”, you’ll have many choices of which details you’ll implement at the lowest possible level. So far, we’ve gone into a lot of depth on parsing and serializing the message. We could also go into a lot of depth on the network aspects of running a server - binding to a port, listening on that port, and accepting connections. You’ll find this sort of functionality in Network.Socket.

Instead though, we’ll shortcut a lot of those details by relying on the runTCPServer function from Network.Run.TCP.

runTCPServer :: Maybe HostName -> ServiceName -> (Socket -> IO a) -> IO a

All we have to provide to use this is our hostname (Just “127.0.0.1” to run locally), a port (e.g. 3000) and a server loop function to communicate with the socket:

import Network.Run.TCP (runTCPServer)

serverLoop :: Socket -> IO ()
serverLoop sock = ...

main :: IO ()
main = runTCPServer (Just “127.0.0.1”) “3000” serverLoop

Our final remaining task is to implement serverLoop. This function handles a single connection with a single client, communicating back and forth until the client ends the connection. It runs as a separate process, forked off our main process. There are three primary functions we would use to run this communication. Since we’re using bytestrings, we’ll get them from Network.Socket.ByteString.

recv :: Socket -> Int -> IO ByteString

send :: Socket -> ByteString -> IO Int

sendAll :: Socket -> ByteString -> IO ()

When we call recv, our function blocks until it receives data from the client, up to a maximum number of bytes we specify. (A single large request could require multiple recv calls). We can then use send to communicate our response, which will return the number of bytes the client accepted. Again, large requests could require multiple send calls, but sendAll automatically ensures the whole response gets sent.

Hopefully the structure of serverLoop is clear. We want to “receive” the data, parse it as a request, pass the parser result to our server function to get a response, and send this response. We’ll also recurse to listen for more data from this client, unless we receive a null input (this indicates the client closed the connection).

server :: (Show a) => Either a HttpRequest -> IO HttpResponse
server = ... (as above)

serverLoop :: Socket -> IO ()
serverLoop sock = do
    msg <- recv sock 1024
    unless (BS.null msg) $ do
        req <- runParserT parseHttpRequest "" msg
        response <- server req
        let resp = serializeHttpResponse response
        sendAll sock resp
        serverLoop sock

Our server is now complete! The next section has all the code we wrote this week so you can put it all together:

Final Code

{-# LANGUAGE OverloadedStrings #-}

import qualified Data.ByteString.Lazy.Char8 as BSC
import Data.ByteString.Lazy (ByteString)
import Network.Run.TCP
import Network.Socket
import Network.Socket.ByteString.Lazy
import Text.Megaparsec

addSp :: ByteString -> ByteString
addSp = BS.cons (o ' ')

addCrlf :: ByteString -> ByteString
addCrlf = (<>) "\r\n"

serializeHttpVersion :: (Word8, Word8) -> ByteString
serializeHttpVersion (d1, d2) = "HTTP/" <>
    (BSC.pack $ (show d1 <> ('.' : show d2)))

serializeStatusCode :: Int -> ByteString
serializeStatusCode = BSC.pack . show

serializeHttpHeaders :: HttpHeaders -> ByteString
serializeHttpHeaders (HttpHeaders mp) = HM.foldrWithKey f "\r\n" mp
    where
        f k v bs = k <> (o ':' `BS.cons` v) <> (addCrlf bs)

serializeHttpResponse :: HttpResponse -> ByteString
serializeHttpResponse (HttpResponse v c r h b) =
    serializeHttpVersion v <> addSp (serializeStatusCode c) <> addSp r <>
    (addCrlf $ serializeHttpHeaders h) <> end
    where
        end = fromMaybe "" b

server :: (Show a) => Either a HttpRequest -> IO HttpResponse
server (Left e) =
    let body = BSC.pack (show e)
        headerMap = HM.singleton "Content-Length" (BSC.pack $ show (BS.length body))
    in  return $ HttpResponse (1,1) 400 "Bad Request" (HttpHeaders headerMap) (Just body)
server (Right (HttpRequest m u v (HttpHeaders h) b)) = do
    let body = "This is the response body!"
    let headerMap = HM.singleton "Content-Length" (BSC.pack $ show (BS.length body))
    return $ HttpResponse v 200 "OK" (HttpHeaders headerMap) (Just body)

serverLoop :: Socket -> IO ()
serverLoop sock = do
    putStrLn "Running Server Loop"
    msg <- recv sock 1024
    unless (BS.null msg) $ do
        req <- runParserT parseHttpRequest "" msg
        response <- server req
        let resp = serializeHttpResponse response
        sendAll sock resp
        serverLoop sock

main :: IO ()
main = runTCPServer (Just "127.0.0.1") "3000" serverLoop

If you put all the code from the three parts of this series together, you’ll have an executable program you can run. While running this, you can point your browser or an application like Postman to this program and it should return a “200 OK” response with a body!

Obviously there’s more work to do to make this server useful, but you can now work entirely off of the HttpRequest and HttpResponse types without having to worry about the network layer, parsing or serialization!

Conclusion

If you want to go even further with writing a server, you can take our course Practical Haskell. In this course you’ll learn about Servant, which uses Haskell’s type mechanics to abstract away even more HTTP details. Instead of worrying about requests and responses, you can define all your functions in terms of your “business” types.

You can also learn more about parsing by taking our other course, Solve.hs, and focusing on Module 4. You’ll learn how to build a parser from scratch, as well as how to use Megaparsec.

Starting next week, we’ll follow a similar trajectory of “building from scratch” with a more complicated project!

James Bowen
Next

Parsing an HTTP Request