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
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:
mylogger :: Twain.Middleware
mylogger app request respond = do
print (Twain.requestMethod request)
app request $ \response ->
print (Twain.responseStatus response)
respond response
Twain uses this to 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 in 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.
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
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:
- Get the current id
- Increment it, use that id to create a new post
- 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
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.
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!
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,
twitter.
The whole program including the stack and cabal files can be found
on Github.
