λm.me/blog

This is a port of my previous scotty tutorial for the twain web (micro) framework.

We are going to build a very simple bulletin board website using twain and friends. It'll be so simple that we won't even use a database, but hopefully it'll provide enough information on twain that you can continue it yourselves if you'd like.

But first, we are going to cover some of the basics of web programming, what are WAI and warp, and how to use twain.

• Web programming and twain
  • How to Run
  • Building a WAI Application with Twain
  • Routing
  • Responding
• Alright, enough chitchat - let's get to work
  • Some simple structure
  • Displaying posts
  • Managing mutable state
  • HTML and forms
• Styling
• Logging, Sessions, Cookies, Authentication, etc.
• Testing
• Deploying
• That's it

Web programming and twain

Twain is a (tiny) server-side web framework, which means it provides a high-level API for describing web apps.

Twain is built on top of WAI, which is a lower level Web Application Interface. Warp is a popular web server implementation that runs WAI apps (also called a WAI handler).

A web server is a network application that receives requests from clients, processes them, and returns responses. The communication between the web client and web server follows the HTTP protocol. The HTTP protocol defines what kind of requests a user can make, such as "I want to GET this file", and what kind of responses the server can return, such as "404 Not Found".

wai provides a slightly low level mechanism of talking about requests and responses, and twain provides a bit more convenient mechanism than WAI for defining WAI apps. Warp takes descriptions of web programs that are written using WAI and provides the actual networking functionality, including the concurrent processing.

If you are interested in working with wai directly, Michael Snoyman's video workshop Your First Web App with WAI and Warp is a good place to learn more about it.

How to Run

Twain (and more specifically WAI) apps have the type Application, which can be considered as a specification of a web application. Application is a type alias:

type Application
  = Request -> (Response -> IO ResponseReceived) -> IO ResponseReceived

This type means that a WAI application is a function that takes a user's HTTP Request, and is expected to produce an HTTP Response to the user which it will pass to the function it got as a second argument (which is responsible for actually delivering the response, continuation passing style).

In order to run this application, we need to pass this function to a WAI handler which will do all of the networking heavy lifting of actually:

• Opening sockets on a certain port
• Receiving messages from the socket
• Handling threading
• Sending responses through the socket

...and so on. This is where warp comes in.

Once we have a WAI app, we can run it using the on a certain port using the run function from the warp package. This function will handle the heavy lifting and will call our web app when a Request from a user comes in, and will ask for a Respone from us.

Building a WAI Application with Twain

To build an Application with wai, one needs to take a Request and produce a Response. While this is fairly straightforward in principle, parsing a request and composing a response can be a bit tedious and repetative. For responses we need to branch over the HTTP method type, parse the route, extract the variable parts and branch on it, and so on. For requests, we need to set the HTTP status, the HTTP headers, the response body, and so on.

Twain provides us with a slightly more convenient API to describe web apps. It provides us with API for declaring methods and routes, extract variable information, compose routes, and create responses with less boilerplate.

A twain app is generally constructed by listing several HTTP methods + routes to be tried in order, and a matching responders for each method+route.

Let's explore these steps one by one, starting with declaring methods and routes, then defining responders, and finally gluing them all together.

Routing

Two of the most important details that can be found in an HTTP request is which component does the user want to access and in what way. The first is described using a Path, and the second using a Method.

For example, if a user would like to view the bulletin board post number 13, they will send the HTTP request GET /post/13. The first part is the method, and the second is the path.

To construct a route in twain, we need to specify the method using one of the method functions (such as get), and apply it the route and an action to generate a response.

Twain provides a textual interface for describing routes using the GHC extension OverloadedStrings. For example, we can describe static paths such as /static/css/style.css by writing the string "/static/css/style.css".

When writing routes, we often want to describe more than just a static path, sometimes we want part of the path to vary. We can give a name to a variable part of the path by prefixing the name with a colon (:).

For example, "/post/:id" will match with /post/17, /post/123, /post/hello and so on, and later, when we construct a response, we will be able to extract to this variable part with the function param by passing it the name "id".

For our bulletin board we want to create several routes:

get "/" -- Our main page, which will display all of the bulletins
get "/post/:id" -- A page for a specific post
get "/new" -- A page for creating a new post
post "/new" -- A request to submit a new page
post "/post/:id/delete" -- A request to delete a specific post

Next, we'll define what to do if we match on each of these routes.

Responding

Once we match an HTTP method and route, we can decide what to do with it. This action is represented by the type ResponderM a.

ResponderM implements the monadic interface, so we can chain such action in the same way we are used to from types like IO, this will run one action after the other.

In ResponderM context, we can find out more details about the request, do IO, decide how to respond to the user, and more.

Querying the Request

The request the user sent often has more information than just the HTTP method and route. It can hold request headers such as which type of content the user is expecting to get or the "user-agent" it uses, in case of the HTTP methods such as POST and PUT it can include a body which includes additional content, and more.

Twain provides a few utility functions to query a few of the more common parts of a request, with functions such as body, header and files. Or the entire request if needed.

It also provides easy access to the varying parts of the route and body with param and params.

For our case this will come into play when we want to know which post to refer to (what is the :id in the /post/:id route), and what is the content of the post (in the /new route).

Responding to the user

There are several ways to respond to the user, the most common ones is to return some kind of data. This can be text, HTML, JSON, a file or more.

In HTTP, in addition to sending the data, we also need to describe what kind of data we are sending and even that the request was successful at all.

Twain handles all that for the common cases by providing utility functions such as text, html, and json.

These functions take the relevant data we want to send to the user and create a WAI Response, which we can then send to the user.

For example, if we want to send a simple html page on the route /hello, we'll write the following

get "/hello" $
  send $
    html "<html><head><link rel=\"stylesheet\" type=\"text/css\" href=\"/style.css\"></head><body>Hello!</body></html>"

The HTTP Reponse we created with html will automatically set the status code 200, and the Content-Type which is appropriate for HTML pages, This is also something that we can set ourselves without help if we like using the raw function by applying it with the status, headers and body directly, instead of calling html. For example:

get "/hello" $
  send $
    raw
      status200
      [("Content-Type", "text/html; charset=utf-8")]
      "<html><head><link rel=\"stylesheet\" type=\"text/css\" href=\"/style.css\"></head><body>Hello!</body></html>"

IO

It is possible to use IO operations in a ResponderM context using the function liftIO. For example:

get "/hello" $ do
  liftIO (putStrLn "They said hello!")
  send $ text "Hello back!"

This way we can write to console, change a song in our music player, or query a database in the middle of processing a request! Fair warning though: Warp runs request processing concurrently, so make sure you avoid race conditions in your code!

Gluing routes together

Each example we have seen above has the type Middleware, which is defined like this:

type Middleware = Application -> Application

As a reminder, Application is also a type alias:

type Application
  = Request -> (Response -> IO ResponseReceived) -> IO ResponseReceived

In essence, a Middleware is a function that takes a WAI Application and can add additional processing to it - it can process the user Request before passing it to the Application it received, and it can do extra processing to the Response the Application generates before calling the Response -> IO ResponseReceived it received.

To illustrate, here's a very simple Middleware that prints some data from a Request before passing it to the web app, And prints some data from the web app's Response before sending it to the user (assuming we import twain like this import qualified Web.Twain as Twain):

mylogger :: Twain.Middleware
mylogger app request respond = do
  print (Twain.requestMethod request)
  app request $ \response ->
    print (Twain.responseStatus response)
    respond response

Twain uses this mechanism to compose route handlers as well: a route handler is essentially a function that checks the request first and decides whether it wants to handle it (if the route matches) or pass it to the next route handler. So we can compose route handlers using regular function composition!

All that's missing is that final route handler of type Application that will definitely handle all requests that were not processed by previous handlers request. We can use twain's notFound function to send the user a failure message if no other route handler was able to handle their request.

Here's an example of a simple WAI Application with several route handlers:

{-# language OverloadedStrings #-}

import Web.Twain
import Network.Wai.Handler.Warp (run)

main :: IO ()
main = do
  putStrLn "Server running at http://localhost:3000 (ctrl-c to quit)"
  run 3000 app

app :: Application
app =
  ( get "/" (send (text "hello"))
  . get "/echo/hi" (send (text "hi there"))
  . get "/echo/:str" (param "str" >>= \str -> send (text str))
  )
  (notFound (send (text "Error: not found.")))

Note that the order of the routes matters - we try to match the /echo/hi route before the /echo/:str route and provide a custom handler to a specific case, all other cases will be caught by the more general route handler.

And as an aside, I personally don't like to use that many parenthesis and find using $ a bit more aesthetically pleasing, but . has presedence over $ so it's not going to work so well here. Fortunately we can place the routes in a list and then fold over the list to compose them instead:

app :: Application
app =
  foldr ($)
    (notFound $ send $ text "Error: not found.")
    [ get "/" $
      send $ text "hello"

    , get "/echo/hi" $
      send $ text "hi there"

    , get "/echo/:str" $ do
      str <- param "str"
      send $ text str
    ]

I like this style a bit more!

Alright, enough chitchat - let's get to work

We now have the basic building blocks with which we can build our bulletin board! There are a few more things we can cover that will make our lives easier, but we'll pick them up as we go.

At the time of writing the most recent version of twain is 2.1.0.0.

Some simple structure

Here's the simple initial structure which we will iterate on to build our bulletin board app:

{-# language OverloadedStrings #-}

-- | A bulletin board app built with twain.
module Bulletin where

import qualified Web.Twain as Twain
import Network.Wai.Handler.Warp (run, Port)

-- | Entry point. Starts a bulletin-board server at port 3000.
main :: IO ()
main = runServer 3000

-- | Run a bulletin-board server at at specific port.
runServer :: Port -> IO ()
runServer port = do
  putStrLn $ unwords
    [ "Running bulletin board app at"
    , "http://localhost:" <> show port
    , "(ctrl-c to quit)"
    ]
  run port mkApp

-- | Bulletin board application description.
mkApp :: Twain.Application
mkApp =
  foldr ($)
    (Twain.notFound $ Twain.send $ Twain.text "Error: not found.")
    routes

-- | Bulletin board routing.
routes :: [Twain.Middleware]
routes =
  -- Our main page, which will display all of the bulletins
  [ Twain.get "/" $
    Twain.send $ Twain.text "not yet implemented"

  -- A page for a specific post
  , Twain.get "/post/:id" $
    Twain.send $ Twain.text "not yet implemented"

  -- A page for creating a new post
  , Twain.get "/new" $
    Twain.send $ Twain.text "not yet implemented"

  -- A request to submit a new page
  , Twain.post "/new" $
    Twain.send $ Twain.text "not yet implemented"

  -- A request to delete a specific post
  , Twain.post "/post/:id/delete" $
    Twain.send $ Twain.text "not yet implemented"
  ]

We'll start with a very simple routing skeleton. For the sake of simplicity, I'm going to put this code in main.hs and run it using:

stack runghc --package twain-2.1.0.0 --package warp main.hs

Eventually the program will greet us with the following output:

Running bulletin board app at http://localhost:3000 (ctrl-c to quit)

Which means that we can now open firefox a go to http://localhost:3000 and be greeted by our twain application.

• I've also create a complete cabal project if you'd prefer to use that instead: see the commit

Displaying posts

Next, we are going to need figure out how to represent our bulletin data and how to keep state around.

We are going to add a few new packages to use for our data representation: text, time, and containers.

Add above:

import qualified Data.Text as T
import qualified Data.Time.Clock as C
import qualified Data.Map as M

And we'll represent a post in the following way:

-- | A description of a bulletin board post.
data Post
  = Post
    { pTime :: C.UTCTime
    , pAuthor :: T.Text
    , pTitle :: T.Text
    , pContent :: T.Text
    }

And we'll use a Map to represent all of the posts:

-- | A mapping from a post id to a post.
type Posts = M.Map Integer Post

Once we have these types, we can thread a value of type Posts to routes, so they will be available to all requests and response handlers. We'll change runServer and app a bit and add some dummy data.

-- | Run a bulletin-board server at at specific port.
runServer :: Port -> IO ()
runServer port = do
  app <- mkApp
  putStrLn $ unwords
    [ "Running bulletin board app at"
    , "http://localhost:" <> show port
    , "(ctrl-c to quit)"
    ]
  run port app

-- ** Application and routing

-- | Bulletin board application description.
mkApp :: IO Twain.Application
mkApp = do
  dummyPosts <- makeDummyPosts
  pure $ foldr ($)
    (Twain.notFound $ Twain.send $ Twain.text "Error: not found.")
    (routes dummyPosts)

-- | Bulletin board routing.
routes :: Posts -> [Twain.Middleware]
routes posts =
  -- Our main page, which will display all of the bulletins
  [ Twain.get "/" $
    Twain.send (displayAllPosts posts)

  -- A page for a specific post
  , Twain.get "/post/:id" $ do
    pid <- Twain.param "id"
    Twain.send (displayPost pid posts)

  -- A page for creating a new post
  , Twain.get "/new" $
    Twain.send $ Twain.text "not yet implemented"

  -- A request to submit a new page
  , Twain.post "/new" $
    Twain.send $ Twain.text "not yet implemented"

  -- A request to delete a specific post
  , Twain.post "/post/:id/delete" $
    Twain.send $ Twain.text "not yet implemented"
  ]

And add some additional business logic to display posts as simple text for now:

-- ** Business logic

-- | Respond with a list of all posts
displayAllPosts :: Posts -> Twain.Response
displayAllPosts =
  Twain.text . T.unlines . map ppPost . M.elems

-- | Respond with a specific post or return 404
displayPost :: Integer -> Posts -> Twain.Response
displayPost pid posts =
  case M.lookup pid posts of
    Just post ->
      Twain.text (ppPost post)

    Nothing ->
      Twain.raw
        Twain.status404
        [("Content-Type", "text/plain; charset=utf-8")]
        "404 Not found."

And add code that define the types, creates a dummy posts list, and implements ppPost which converts a Post to text:

-- ** Posts

-- | A mapping from a post id to a post.
type Posts = M.Map Integer Post

-- | A description of a bulletin board post.
data Post
  = Post
    { pTime :: C.UTCTime
    , pAuthor :: T.Text
    , pTitle :: T.Text
    , pContent :: T.Text
    }

-- | Create an initial posts Map with a dummy post
makeDummyPosts :: IO Posts
makeDummyPosts = do
  time <- C.getCurrentTime
  pure $
    M.singleton
      0
      ( Post
        { pTime = time
        , pTitle = "Dummy title"
        , pAuthor = "Dummy author"
        , pContent = "bla bla bla..."
        }
      )

-- | Prettyprint a post to text
ppPost :: Post -> T.Text
ppPost post =
  let
    header =
      T.unwords
        [ "[" <> T.pack (show (pTime post)) <> "]"
        , pTitle post
        , "by"
        , pAuthor post
        ]
    seperator =
      T.replicate (T.length header) "-"
  in
    T.unlines
      [ seperator
      , header
      , seperator
      , pContent post
      , seperator
      ]

Now, when running our program with:

stack runghc --package twain-2.1.0.0 --package warp --package text --package containers main.hs

We should be able to see a post when going to http://localhost:3000, see the same post when going to http://localhost:3000/post/0, and see a not found message when trying to go to a post with a different id such as http://localhost:3000/post/17

• The change we made can be viewed here.

We can also create HTTP requests and see the results from the command-line using curl:

To see all posts:

curl -X GET http://localhost:3000

To see the post with id 0:

curl -X GET http://localhost:3000/post/0

Managing mutable state

Now this is a good start but we are still missing a few important parts:

• Adding new posts
• Generating new distinct post ids on post creation
• Making sure all threads access the same state without stepping on each other's toes

While we could use a mutable variable like IORef or MVar, writing code that can run a sequence of commands that use mutable data can be tricky.

For example one thing we want to do is, when creating a new post:

1. Get the current id
2. Increment it, use that id to create a new post
3. update the mutable variable to point to the new Map

However, if, for example, two threads manage to get the same id before incrementing the id, we'll get two posts with the same id. Or if two threads create the new Map and ask the mutable variable to point at their new Map, one post will be not actually be added and will be lost forever.

To combat that, we'll use shared memory using Software Transactional Memory (in short, STM). The stm packages provides us with mutable variables that can be shared and updated concurrently in an atomic way. Meaning that we can describe a sequence of operations on shared memory that are guaranteed to run atomically as one transaction without other operations on the same mutable variables getting mixed in between.

I recommend reading the chapter of STM in PCPH to get a more in-depth overview of stm.

Now - we can create a state data type the with contain the posts currently existing in the system as well as a updating new id for the next post added to the system:

-- | Application state.
data AppState
  = AppState
    { asNextId :: Integer -- ^ The id for the next post
    , asPosts :: Posts -- ^ All posts
    }

And then wrap it up in a transaction mutable variable: STM.TVar AppState.

We can create a new TVar in an IO context and pass it to routes so that the twain web app is a closure containing the mutable variable, and that way any thread handling requests and responses will have access to it!

We'll add a new import:

import qualified Control.Concurrent.STM as STM

And we'll edit mkApp to create the TVar and pass it to routes:

mkApp :: IO Application
mkApp = do
  dummyPosts <- makeDummyPosts
  appstateVar <- STM.newTVarIO AppState{asNextId = 1, asPosts = dummyPosts}
  pure $ foldr ($)
    (Twain.notFound $ Twain.send $ Twain.text "Error: not found.")
    (routes appstateVar)

routes :: STM.TVar AppState -> [Middleware]
routes appstateVar = do
  ...

The three most interesting functions we have (for now) to operate on our mutable transactional variable appstateVar are:

readTVar   :: TVar a -> STM a
writeTVar  :: TVar a -> a -> STM ()

atomically :: STM a -> IO a

the STM type we see here is similar to IO, it is a description of a transactional program - a sequence of steps that must run atomically. And the atomically function is one that converts that program into something that the Haskell runtime system can run in IO context.

So now, creating a new post and adding it to the current state of the system looks like this:

-- | Add a new post to our store.
newPost :: Post -> STM.TVar AppState -> IO Integer
newPost post appstateVar =
  STM.atomically $ do
    appstate <- STM.readTVar appstateVar
    STM.writeTVar
      appstateVar
      ( appstate
        { asNextId = asNextId appstate + 1
        , asPosts = M.insert (asNextId appstate) post (asPosts appstate)
        }
      )
    pure (asNextId appstate)

And these operations are guaranteed to run atomically. (We can also use STM.modifyTVar :: TVar a -> (a -> a) -> STM () for a slightly more convenient code.)

Let's add another import so we can run IO actions inside ResponderM:

import Control.Monad.IO.Class (liftIO)

and change the code of routes to handle viewing posts from our store:

-- | Bulletin board routing.
routes :: STM.TVar AppState -> [Twain.Middleware]
routes appstateVar =
  -- Our main page, which will display all of the bulletins
  [ Twain.get "/" $ do
    posts <- liftIO $ asPosts <$> STM.readTVarIO appstateVar
    Twain.send (displayAllPosts posts)

  -- A page for a specific post
  , Twain.get "/post/:id" $ do
    pid <- Twain.param "id"
    posts <- liftIO $ asPosts <$> STM.readTVarIO appstateVar
    Twain.send (displayPost pid posts)

  -- A page for creating a new post
  , Twain.get "/new" $
    Twain.send $ Twain.text "not yet implemented"

  -- A request to submit a new page
  , Twain.post "/new" $
    Twain.send $ Twain.text "not yet implemented"

  -- A request to delete a specific post
  , Twain.post "/post/:id/delete" $
    Twain.send $ Twain.text "not yet implemented"
  ]

Note how we can run IO operations inside a ResponderM context using liftIO.

Let's also add the ability to delete posts:

routes :: STM.TVar AppState -> [Twain.Middleware]
routes appstateVar =
  [ ...

  -- A request to delete a specific post
  , Twain.post "/post/:id/delete" $ do
    pid <- Twain.param "id"
    response <- liftIO $ handleDeletePost pid appstateVar
    Twain.send response
  ]

-- | Delete a post and respond to the user.
handleDeletePost :: Integer -> STM.TVar AppState -> IO Twain.Response
handleDeletePost pid appstateVar = do
  found <- deletePost pid appstateVar
  pure $
    if found
      then
        Twain.redirect302 "/"

      else
        Twain.raw
          Twain.status404
          [("Content-Type", "text/html; charset=utf-8")]
          "404 Not Found."

-- | Delete a post from the store.
deletePost :: Integer -> STM.TVar AppState -> IO Bool
deletePost pid appstateVar =
  STM.atomically $ do
    appstate <- STM.readTVar appstateVar
    case M.lookup pid (asPosts appstate) of
      Just{} -> do
        STM.writeTVar
          appstateVar
          ( appstate
            { asPosts = M.delete pid (asPosts appstate)
            }
          )
        pure True

      Nothing ->
        pure False

We can also test POST requests from the command-line using curl:

To delete the post with id 0:

curl -X POST http://localhost:3000/post/0/delete

• The change we made can be viewed here.

HTML and forms

We're going to start writing some HTML to display our data and add a form for adding a new post.

We're going to use lucid. If you are interested in more possible choices for html libraries vrom911's article about html libraries is a good place to start.

Lucid provides a monadic EDSL for writing html pages. The functions are all suffixed with underscore (_) and represent the relevant html tags.

We'll add this import at the top:

import qualified Lucid as H

And the following type for convenience:

type Html = H.Html ()

And first, we'll create a template boilerplate which into we'll inject our content later:

-- | HTML boilerplate template
template :: T.Text -> Html -> Html
template title content =
  H.doctypehtml_ $ do
    H.head_ $ do
      H.meta_ [ H.charset_ "utf-8" ]
      H.title_ (H.toHtml title)
      H.link_ [ H.rel_ "stylesheet", H.type_ "text/css", H.href_ "/style.css"  ]
    H.body_ $ do
      H.div_ [ H.class_ "main" ] $ do
        H.h1_ [ H.class_ "logo" ] $
          H.a_ [H.href_ "/"] "Bulletin Board"
        content

Notice how the lists represent the attributes of a tag, how tags are sequenced using the monadic interface, and how tags are nested by passing them as input to other tags.

Let's create pages for posts:

-- | All posts page.
allPostsHtml :: Posts -> Html
allPostsHtml posts = do
  H.p_ [ H.class_ "new-button" ] $
    H.a_ [H.href_ "/new"] "New Post"
  mapM_ (uncurry postHtml) $ reverse $ M.toList posts

postHtml :: Integer -> Post -> Html
postHtml pid post = do
  H.div_ [ H.class_ "post" ] $ do
    H.div_ [ H.class_ "post-header" ] $ do
      H.h2_ [ H.class_ "post-title" ] $
        H.a_
          [H.href_ ("/post/" <> T.pack (show pid))]
          (H.toHtml $ pTitle post)

      H.span_ $ do
        H.p_ [ H.class_ "post-time" ] $ H.toHtml (T.pack (show (pTime post)))
        H.p_ [ H.class_ "post-author" ] $ H.toHtml (pAuthor post)

    H.div_ [H.class_ "post-content"] $ do
      H.toHtml (pContent post)

And change our web handlers to use html instead of text:

 -- | Respond with a list of all posts
 displayAllPosts :: Posts -> Twain.Response
 displayAllPosts =
-  Twain.text . T.unlines . map ppPost . M.elems
+  Twain.html . H.renderBS . template "Bulletin board - posts" . allPostsHtml

 -- | Respond with a specific post or return 404
 displayPost :: Integer -> Posts -> Twain.Response
 displayPost pid posts =
   case M.lookup pid posts of
     Just post ->
-      Twain.text (ppPost post)
+      Twain.html $
+        H.renderBS $
+          template "Bulletin board - posts" $
+            postHtml pid post

     Nothing ->
       Twain.raw
         Twain.status404
         [("Content-Type", "text/plain; charset=utf-8")]
         "404 Not found."

In order to delete a post, we need to make a POST command to the URL /post/<post-id>/delete. We can do that using HTML by creating a form, defining its URL and method, and create an input HTML element of type submit.

    -- delete button
    H.form_
      [ H.method_ "post"
      , H.action_ ("/post/" <> T.pack (show pid) <> "/delete")
      , H.onsubmit_ "return confirm('Are you sure?')"
      , H.class_ "delete-post"
      ]
      ( do
        H.input_ [H.type_ "submit", H.value_ "Delete", H.class_ "deletebtn"]
      )

You can stick this wherever you want in postHtml, I placed it at the end. Now, if you run the program using:

stack runghc --package twain --package text --package containers --package stm --package lucid main.hs

and go to the website (http://localhost:3000), you'll be greeted with beautiful (well, not beautiful, but functional) posts and a delete button for each post.

• The change we made can be viewed here.

Submitting data via forms and processing it

Next we are going to add a post. To do that we need to create a new HTML page which will contain another HTML form. This time we will want to capture some input which will then be part of the body of the POST request.

-- | A new post form.
newPostHtml :: Html
newPostHtml = do
  H.form_
    [ H.method_ "post"
    , H.action_ "/new"
    , H.class_ "new-post"
    ]
    ( do
      H.p_ $ H.input_ [H.type_ "text", H.name_ "title", H.placeholder_ "Title..."]
      H.p_ $ H.input_ [H.type_ "text", H.name_ "author", H.placeholder_ "Author..."]
      H.p_ $ H.textarea_ [H.name_ "content", H.placeholder_ "Content..."] ""
      H.p_ $ H.input_ [H.type_ "submit", H.value_ "Submit", H.class_ "submit-button"]
    )

And we need to be able to access the following from the request on the server. We can do that using param. So let's implement the relevant parts in routes:

  -- A page for creating a new post
  , Twain.get "/new" $
    Twain.send handleGetNewPost

  -- A request to submit a new page
  , Twain.post "/new" $ do
    title <- Twain.param "title"
    author <- Twain.param "author"
    content <- Twain.param "content"
    time <- liftIO C.getCurrentTime

    response <-
      liftIO $ handlePostNewPost
        ( Post
          { pTitle = title
          , pAuthor = author
          , pContent = content
          , pTime = time
          }
        )
        appstateVar

    Twain.send response

and the handlers:

-- | Respond with the new post page.
handleGetNewPost :: Twain.Response
handleGetNewPost =
  Twain.html $
    H.renderBS $
      template "Bulletin board - posts" $
        newPostHtml

-- | Respond with the new post page.
handlePostNewPost :: Post -> STM.TVar AppState -> IO Twain.Response
handlePostNewPost post appstateVar = do
  pid <- newPost post appstateVar
  pure $ Twain.redirect302 ("/post/" <> T.pack (show pid))

And now we have a fairly functional little bulletin board! Hooray!

• The change we made can be viewed here.

Styling

This post is already pretty long, so I will not cover styling in depth.

There are multiple way to use styling:

The first is using the EDSL approach like we did with lucid using a library like clay, the second is to write the css text inline in a Haskell module using something like the raw-strings-qq library, another is to write it in an external file and embed to context at compile time using template haskell and the file-embed library, another is to ship the css file along with the executable and use responseFile from the wai package to send it as a file.

For each of these - don't forget to set the content type header to "text/css; charset=utf-8"!

We can send a very rudimentary CSS as a string with the css function by adding this to the end of the routes list:

  -- css styling
  , Twain.get "/style.css" $
    Twain.send $ Twain.css ".main { width: 900px; margin: auto; }"

Logging, Sessions, Cookies, Authentication, etc.

The wai ecosystem has a wide variety of features that can be composed together. These features are usually encapsulated as "middlewares".

Remember, a middleware is a function that takes an Application and returns an Application. Middlewares can add functionality before the request passes to our twain app or after the response.

The wai-extra packages contains a bunch of middlewares we can use. Like logging, gzip compression of responses, forcing ssl usage, or simple http authentication.

For example, let's add some logging from wai-extra to our bulletin-app. We import a request logger from wai-extra:

import qualified Network.Wai.Middleware.RequestLogger as Logger

And then we can apply our twain app to a function such as logStdoutDev to add request logging to our twain app:

 -- | Run a bulletin-board server at at specific port.
 runServer :: Port -> IO ()
 runServer port = do
   app <- mkApp
   putStrLn $ unwords
     [ "Running bulletin board app at"
     , "http://localhost:" <> show port
     , "(ctrl-c to quit)"
     ]
-  run port app
+  run port (Logger.logStdoutDev app)

Testing

Testing WAI apps can be relatively straightforward with packages such as hspec-wai. Check out this twain test module for example usage.

Deploying

I usually create a static executable using ghc-musl and docker so I can deploy my executable on other linux servers.

In a stack project, add the following sections:

Add this to the stack.yaml:

docker:
  enable: true
  image: utdemir/ghc-musl:v24-ghc922

and this to the .cabal file under the executable section:

  ghc-options: -static -optl-static -optl-pthread -fPIC -threaded -rtsopts -with-rtsopts=-N

Check the ghc-musl repo for more instructions.

That's it

I hope you found this tutorial useful. If there's something you feel I did not explain well or you'd like me to cover, let me know via email, or mastodon.

The whole program including the stack and cabal files can be found on Github.

And if you want to use a database instead of STM, you can also find a version that uses SQLite3 using sqlite-easy on a different branch.