Mig by example

Mig is a lightweight and easy to use library to build HTTP servers and clients in Haskell. It is kind of servant for Simple/Boring Haskell. This book is an example driven guide to the library. The name mig (pronounced as meeg) is a russian word for "instant moment".

The main features of the mig library are:

• lightweight library
• easy to use. It has simple design on purpose
• expressive DSL to compose servers
• type-safe route handlers, URLs and conversions
• handlers are encoded with generic Haskell functions
• built on top of WAI and warp server libraries.
• provides Swagger to your server with one-line of code
• relies on standard classes to compose servers. The server is a monoid
• we can build HTTP-clients from the server definition

Example of hello world server:

{-# Language OverloadedStrings #-}

import Mig.Json.IO

-- | Starts server on port 8085.
main :: IO ()
main = runServer 8085 server

-- | The server definition
server :: Server IO
server = 
  "api/v1" /. 
    [ "hello" /. hello
    , "bye" /. bye
    ]

-- | The handler definition as a function
hello :: Get (Resp Text)
hello = pure $ ok "Hello World"

-- | The handler with a query parameter to ask for the user name
bye :: Query "user" Text -> Get (Resp Text)
bye (Query name) = pure $ ok ("Goodbye " <> name)

How to start a new project

If you are a Haskell beginner and interested to try out building servers with mig the easiest way to start is to install stack. See the main page of the stack docs in the link on how to do it. After the stack is installed we can generate a new mig project that contains hello world server with command:

> stack new my-project-name anton-k/hello-mig

It generates my-project-name directory that contains a code for our server. Let's navigate to it, build server code and start the server:

> cd my-project-name
> make build
> make run

After that we can query the server on port 8085 either by curl or by swagger-ui. The project contains a basic JSON API server with two routes. The code will be explained in detail in the next chapter of this tutorial.

How to use mig library in your project

We can install it from hackage. We need to use the library mig-server

With cabal we can install it from Hackage:

cabal install mig-server --lib

With stack we can link to the repo in extra-deps (put it in your stack.yaml):

extra-deps:
  - git: https://github.com/anton-k/mig
    commit: <some-commit-of-the-mig-libray>
    subdirs:
      - mig
      - mig-extra
      - mig-client
      - mig-wai
      - mig-swagger-ui
      - mig-server

Structure of the library

There are several libraries:

• mig - core library which defines DSL to build servers with API-schemas and functions to render it to low-level representation.
• mig-extra - extra add-ons to the core library
• mig-server - mig core with batteries and functions to run servers on top of warp.
• mig-client - HTTP-clients from the server code
• mig-wai - convert mig servers to WAI-applications
• mig-swagger-ui - serve swagger for you app.

Source code for examples

We are going to learn how the mig works by examples. You can run the examples from the tutorial. Here is the code that we are going to study. Look at the Makefile for commands on how to build and run the examples.

Let's dive in to the first example.

Comparing to other libraries

Why to use mig if there are other cool libraries? To me mig lies in the middle ground between servant and scotty. It's as simple as scotty and does not go to fancy type road as servant. But it is akin to servant in usage of type-safe conversions and type-level safety.

servant

The mig uses the same ideas of type-safe handlers which are based on generic Haskell functions. The main difference is that in servant the whole server is described as type. Which leads to type-safety and ability to derive API schema from the type.

But downside of it is fancy big types and very advanced concepts that user needs to know in order to use the library. Also one drawback to me is when things go wrong and you get several pages long error messages. If your server is really big it can be very hard to spot the origin of the error as type mismatch is going to be with the whole type which describes the full server.

The mig borrows idea of type-safe functions to represent route handlers. But types represent only individual handlers. It does not describe the full server. But we have type safety on the level of the single route. And error messages are going to be localised and dedicated to a single route.

Using type-level description of the routes provide the same benefits as in servant case:

• safe type check of the conversions of low level request and response elements
• usage of generic Haskell functions as handlers
• declarative design of the servers
• composition of servers from small sub-servers

In the mig API is a value that is derived from the server at run-time. It allows us to build clients and OpenApi swagger too.

To me servant is more demanding and complicated solution. I'd like to use something more simple.

scotty

The scotty is also in domain of simple, easy to use solutions. So why did I wrote mig and haven't used the scotty instead? Scotty features more imperative approach where you write handlers as expression for Scotty library monad. But it does not looks so well as in servant's case to me. It is harder to assemble servers from parts. And I really like the idea of type-safe conversions of various parts of request and response.

So the scotty is simple enough but for me it lacks some servant features such as composability of the servers (nice tree structure of the API) and type-safe conversions of various parts of request and response.

Hello world

Let's build hello world application. We are going to build simple JSON API server with single route which replies with constant text to request.

We have installed the library mig-server. Let's import the main module. It brings into the scope all main functions of the library:

module Main where

import Mig

Let's define a server with single route:

server :: Server IO
server = "api/v1/hello" /. hello

hello :: Get IO (Resp Json Text)
hello = undefined

So we serve single route with path "api/v1/hello". This example relies on extension OverloadedStrings to convert string literals to values of Path type. Usually I add it in the cabal file of the project. Let's cover the types first.

The server type

The server is a description of both OpenAPI schema for our server and low-level function to run it. In the library it is a newtype wrapper:

newtype Server m = Server (Api (Route m))

The Api type is a value to describe the API schema and Route contains useful info on the type of the route (method, description of the inputs and outputs) and how to run the handler function. The server is parametrized by some monad type. For this example we use IO-monad. It means that all our handlers are going to return IO-values.

How to link paths to handlers

To bind path "api/v1/hello" to handler hello we use function (/.). Let's look at it's type signature:

(/.) :: ToServer a => Path -> a -> Server (MonadOf a)

It expects the Path which has instance of class IsString that is why we can use plain strings for it. The second argument is something that is convertible to Server. Here we use trick to be able to use arbitrary Haskell functions as handlers. We have special class called ToServer which can convert many different types to Server.

The output type is a bit tricky: Server (MonadOf a). The MonadOf is a type function which can extract m from (Server m). Or for example it can extract m from the function request -> m response. So the MonadOf is a way to get underlying server monad from any type.

Let's be more specific and study our example. The type of the handler is Get IO (Resp Text) In our case we get:

(/.) :: Path -> Get IO (Resp Text) -> Server IO

The type-level function MonadOf knows how to extract IO from Get IO (Resp Text).

The type of response

Let's study the signature of the hello handler:

hello :: Get IO (Resp Json Text)
          |  |    |     |    |
          |  |    |     |    +-- response body converted to byte string
          |  |    |     |
          |  |    |     +---- codec to convert result to response body 
          |  |    |           (the media-type which the route uses for response body)
          |  |    |
          |  |    +---- type of response which holds HTTP-response info with result
          |  |
          |  +----- the server monad. Our handler returns values in this monad
          |
          +----- http method encoded as a type

The type Get is a synonym for more generic Send type:

type Get m a = Send GET m a

The type Send is just a wrapper on top of monadic value:

newtype Send method m a = Send (m a)

It encodes HTTP-method on type level as so called phantom type. This is useful to aggregate value for API-schema of our server. We have type synonyms for all HTTP-methods (Get, Post, Put etc).

It's interesting to know that library mig does not use any custom monads for operation. Instead it runs on top of monad provided by the user. Usually it would be IO or Reader over IO. Also for convenience Send is also Monad, MonadTrans and MonadIO. So we can omit Send constructor in many cases.

HTTP-response type

Let's study the Resp type. It is a type for HTTP response. It contains the value and additional HTTP information:

-- | Response with info on the media-type encoded as type.
data Resp media a = Resp
  { status :: Status
  -- ^ response status
  , headers :: ResponseHeaders
  -- ^ response headers
  , body :: Maybe a
  -- ^ response body. Nothing means "no content" in the body
  }
  deriving (Show, Functor)

The type argument media is interesting. It gives a hint to the compiler on how to convert the body to low-level byte string representation. In our example we use type-level tag Json to show that we are going to convert the result to JSON value in the response. So in our case of Resp Json Text we are going to return Text which will be converted to JSON value.

To return successful response there is a handy function:

ok :: a -> Resp media a

It returns response with 200 ok-status and sets Content-Type header to proper media-type.

Define a handler

Let's complete the example and define a handler which returns static text:

hello :: Get IO (Resp Json)
hello = Send $ pure $ ok "Hello World!"

We have several wrappers here:

• ok - converts text value to http-response Resp Json Text
• pure - converts pure value to IO-based value
• Send - send converts monadic value to server. It adds information on HTTP-method of the return type.

As Send is also monad if m is a monad we can write this definition a bit shorter and omit the Send constructor:

hello :: Get IO (Resp Json)
hello = pure $ ok "Hello World!"

Run a server

Let's run the server with warp. For that we define the main function for our application:

main :: IO ()
main = do
  putStrLn $ "Server starts on port: " <> show port
  runServer port server
  where
    port = 8085

That's it! We can compile the code and run it to query our server. We use the function runServer:

runServer :: Int -> Server IO -> IO ()

It renders our server to WAI-application and runs it with warp.

Complete code for the example

module Main (main) where

import Mig

main :: IO ()
main = do
  putStrLn $ "Server starts on port: " <> show port
  runServer port server
  where
    port = 8085

server :: Server IO
server = "api/v1/hello" /. hello

hello :: Get IO (Resp Json Text)
hello = pure $ ok "Hello World!"

If we run the code we can test it with curl in command line:

> curl http://localhost:8085/api/v1/hello

"Hello World!"

Add more routes

Let's define another handler to say bye:

bye :: Get IO (Resp Json)
bye = pure $ ok "Goodbye"

We can add it to the server with monoid method as Server m is a Monoid:

server :: Server IO
server = 
  "api/v1" /.
    mconcat
      [ "hello" /. hello
      , "bye" /. bye
      ]

The meaning of the monoid methods for Server:

• mempty - server that always fails on any request
• a <> b - try to serve the request with server a if it succeeds return the result. If it fails try to serve with server b.

So we have just two functions to build nested trees of servers:

• path /. server - to serve the server on specific path
• mconcat [a, b, c, d] - to combine several servers into one

Note that we can have several handlers on the same path if they have different methods or media-types for output or input:

server = 
  "api/v1" /.
    mconcat
      [ "hello" /. helloGet
      , "hello" /. helloPost
      ]

helloGet :: Get IO (Resp Json Text)
helloPost :: Post IO (Resp Json Text)

Servers on the same path are also distinguished by:

• http-method
• media-type of the result (value of "Accept" header)
• media-type of the request (value of "Content-Type" header)

Subtle nuance on Monoid instance for Server

You may ask: why not to write the previous example like this:

server = 
  "api/v1/hello" /.
    mconcat
      [ helloGet
      , helloPost
      ]

There is a subtle nuance here. The Server m is a Monoid. But the value Send method m a is not. So we use the function (/.) which converts the second argument to Server. If we want to convert we can use the method of the class ToServer:

toServer :: ToServer a => a -> Server (MonadOf a)

So the right way to avoid duplication in path is:

server = 
  "api/v1/hello" /.
    mconcat
      [ toServer helloGet
      , toServer helloPost
      ]

Regarding the previous example we could not use mconcat even if we wanted to. Because handelGet and handlePost have different types. They can not be even put in the same list. But here lies the beauty of the library. We can use arbitrary types as handlers but in the end they all get converted to the value Server m. So we have the flexibility on DSL level but on the level of implementation to build the tree of handlers we use the same type. Which makes type very simple.

List instance for Servers

Because of the ToServer a => ToServer [a] instance we can omit the mconcat most of the time. Meaning we can write the previous examples as:

server = 
  "api/v1/hello" /.
      [ toServer helloGet
      , toServer helloPost
      ]

Also for example with paths for alternatives in the list we can omit toServer too:

server = 
  "api/v1" /.
      [ "hello" /. hello
      , "bye" /. bye
      ]

The path type

Let's discuss the Path type. It is a list of atomic path items:

newtype Path = Path [PathItem]
  deriving (Show, Eq, Semigroup, Monoid)

The path item can be of two types:

data PathItem 
  = StaticPath Text
  | CapturePath Text

The static path item is a rigid entity with exact match to string. We have used it in all our examples so far. But capture is wild-card which is going to be used as input to the handler.

To construct only rigid paths we can use strings:

"ap1/v1/get/blog/post"
"foo/bar"

To specify captures we use *-wildcard:

api/v2/*/get

In the star mark the request captures any text. There might be as many stars in the path as you wish. But they should be supported by the handler. We will touch upon that later.

It's good to know that path is a special type which can be constructed from strings (use OverloadedStrings extension). And we can two types of atomic path elements. Static items and capture parameters. We will deal with captures in the next example.

Anatomy of the request

For the next example we are going to try all sorts of inputs which are possible for the handler.

Useful presets for servers

Before we dive into various parts of the handler I'd like to introduce couple of useful modules that make servers more specific. Often we don't need the most generic types. If we know that all our servers will serve JSON and use only IO monad we can use a special version of the Mig module:

import Mig.Json.IO

It will provide several wrappers to simplify type signatures for handlers:

type Get a = Send GET IO a
type Post a = Send POST IO a

Also it provides more specific response type:

newtype Resp a = Resp (Core.Resp Json a)

For the next example we are going to build JSON-application again. So instead of more general Mig we will use Mig.Json.IO.

Also there are similar modules for:

• IO-based servers
• Html servers with generic monad
• Json servers with generic monad
• Json+IO servers
• Html+IO servers

Servers for HTML take one step further and remove Resp from the equation:

type Get a = Send GET IO (Resp Html a)
type Post a = Send POST IO (Resp Html a)

There is one reason why we do not do that for JSON. But we will study it later.

Http request

In previous example we could query by static path. Let's do something more fancy and provide the input for the handler.

We have several types of inputs in HTTP:

• query parameters. We can see them in the path "api/get/route?queryName=queryValue"

• capture parameters. We can see them also in the path, but they are inlined right into it: api/get/route/someCaptureValueA/someCaptureValueB

• header parameters. They are in HTTP-request headers. For example header that reports media-type of the request body: "Content-Type: application/json"

• request body. It is a value packed into HTTP-request. It can be JSON or text or raw string or XML. All sorts of things can be used as request bodies.

To use any of HTTP inputs in the handler we use special newtype wrappers as arguments to the handler functions.

Query parameter example

For example let's alter hello handler to greet not the "World" but someone by the name:

hello :: Query "who" Text -> Get (Resp Text)
hello (Query name) =
  pure $ ok $ "Hello " <> name 

Note that we have imported Mig.IO.Json and our types are more specific and have fewer arguments. All types are dedicated to IO and Json. So we can write Get (Resp Text) instead of Get IO (Resp Json Text).

Interesting part of the handler is that argument: Query "who" Text. On the API level it creates expectation for a required query parameter in the path. The Query is a simple newtype wrapper:

newtype Query name value = Query value

The cool part of it is that code for the server does not change:

server :: Server IO
server = "api/v1/hello" /. hello

There is no change because function (/.) is overloaded by second argument. And it accepts all sorts of inputs. One of them states:

if value a is convertible to server then Query name value -> a is also convertible to server

And by this magic as all Haskell functions are curried we can use any number of queries in the handler. For example if we want to greet two persons we can write:

hello :: Query "personA" Text -> Query "personB" Text -> Get (Resp Text)
hello (Query nameA) (Query nameB) = 
  pure $ ok $ "Hello " <> nameA <> " and " <> nameB   

Also we can input any type if it has instance of the classes FromHttpApiData and ToParamSchema. For example let's add two numbers:

add :: Query "a" Int -> Query "b" Int -> Get (Resp Int)
add (Query a) (Query b) = 
  pure $ ok (a + b)

The rest of the inputs

All other input parameters work in the same way as a Query. We have a newtype wrapper for the value and type denotes all useful info for API description of the handler.

Let's for example query numbers for addition as capture parameters:

add :: Capture "a" Int -> Capture "b" Int -> Get (Resp Int)
add (Query a) (Query b) = 
  pure $ ok (a + b)

It will expect the path to be "api/v1/add/2/4". Other wrappers look very similar:

• Header name value - for required headers
• OptionalHeader name value - for optional headers
• Capture name value - for path captures
• Optional name value - for optional queries
• QueryFlag - for boolean query that can be missing in the path (and then it is false)
• Body media value - for request body
• Cookie - for cookie (set in the header)

Using custom types as query parameters

The value of query parameter should have two instances of classes. We need:

• FromHttpApiData from the library http-api-data to convert to value from piece of the URL.

• ToParamSchema from the library openapi3 to describe parameter type in the OpenApi schema.

Let's create a custom type and provide those instances:

newtype AuthToken = AuthToken Text
  deriving newtype (FromHttpApiData, Eq, Ord, ToParamSchema)

We can derive them for newtype wrappers. After that we can use AuthToken as value to get from query parameter. For more info on how to derive those instances see the docs for the libraries. It's easy to do. We can derive Generic for the data type and derive ToParamSchema with it.

The same instances we need for all parameters-like inputs: queries, headers, captures.

Nuances for Capture

The capture is interesting because it can be anywhere in the path. For the example we haven't altered the server and our example:

add :: Query "a" Int -> Query "b" Int -> Get (Resp Int)
add (Query a) (Query b) =
  pure $ ok (a + b)

server = "api/v1/add" /. add

The server expects strings with template:

api/v1/add/{int}/{int}

So for missing captures it inserts them. It is the same as to write:

server = "api/v1/add/*/*" /. add

We denote capture with *-wildcard. If we want the capture to be in another place in the path just put a star there:

server = "api/v1/*/*/add-me" /. add

The server expects strings with template as path:

api/v1/{int}/{int}/add-me

Json request body

I guess that JSON body as request is going to be the most popular case among all inputs. So let's take a closer look at it as it often requires the custom type.

Let's add two numbers and provide input with request body:

data AddInput = AddInput
  { a :: Int
  , b :: Int
  }
  deriving (Generic, FromJSON, ToSchema)

-- | Using JSON as body request
handleAddJson :: Body AddInput -> Post (Resp Int)
handleAddJson (Body (AddInput a b)) =  
  pure $ ok $ a + b

In the core mig library the type Body has two type arguments. But as we use Json specification the first argument for Mig.Json.IO as for Mig.Json is always Json-tag. So those modules provide special case alternative for type Body. But in the mig library it uses the same idea as we saw in the query parameter. It is just a newtype wrapper for the value.

To be able to use it as input for the handler we have to provide instances for several types:

• FromJSON from aeson library to parse value as JSON from byte string
• ToSchema from openapi3 library to describe it in the API-schema

Both of the types can be easily derived with Generic instance (from the module GHC.Generics). First we derive instance of the Generic and then we can derive both FromJSON and ToSchema:

data AddInput = AddInput
  { a :: Int
  , b :: Int
  }
  deriving (Generic, FromJSON, ToSchema)

Also there are many libraries on Hackage to create custom drivings for those classes: deriving-aeson, aeson-deriving and many others.

So to use JSON request body we can define our own type, derive proper classes and we are done.

Let's build a server

Let's recap on what we have learned and build server with various request inputs:

module Main (main) where

import Mig.Json.IO

main :: IO ()
main = runServer 8085 server

-- | Let's define a server
server :: Server IO
server = 
  "api" /.
    -- no args, constnat output
    [ "hello/world" /. helloWorld
    , -- required query param and custom header
      "succ" /. handleSucc
    , -- optional query param
      "succ-opt" /. handleSuccOpt
    , -- several query params
      "add" /. handleAdd
    , -- query flag
      "add-if" /. handleAddIf
    , -- capture
      "mul" /. handleMul
    , -- json body as input
      "add-json" /. handleAddJson
    ]

-- | Simple getter
helloWorld :: Get (Resp Text)
helloWorld = do
  pure $ ok "Hello world!"

newtype TraceId = TraceId Text
  deriving newtype (FromHttpApiData, ToHttpApiData, ToText, ToParamSchema)

{-| Using several inputs: header argument and required query
and using conditional output status
-}
handleSucc :: Header "Trace-Id" TraceId -> Query "value" Int -> Get (Resp Int)
handleSucc (Header _traceId) (Query n) = 
  pure $ ok (succ n)

-- | Using optional query parameters.
handleSuccOpt :: Optional "value" Int -> Get (Resp Int)
handleSuccOpt (Optional n) =
  pure $ case n of
    Just val -> ok (succ val)
    Nothing -> ok 0 

{-| Using several query parameters
-}
handleAdd :: Query "a" Int -> Query "b" Int -> Get (Resp Int)
handleAdd (Query a) (Query b) = 
  pure $ ok $ a + b

-- | Using query flag if flag is false returns 0
handleAddIf :: Query "a" Int -> Query "b" Int -> QueryFlag "perform" -> Get (Resp Int)
handleAddIf (Query a) (Query b) (QueryFlag addFlag) = do
  pure $
    ok $
      if addFlag
        then (a + b)
        else 0

{-| Using capture as arguments. This route expects two arguments
captured in URL. For example:

> http://localhost:8085/hello/api/mul/3/100
-}
handleMul :: Capture "a" Int -> Capture "b" Int -> Get (Resp Int)
handleMul (Capture a) (Capture b) = do
  pure $ ok (a * b)

data AddInput = AddInput
  { a :: Int
  , b :: Int
  }
  deriving (Generic, ToJSON, FromJSON, ToSchema)

-- | Using JSON as input
handleAddJson :: Body AddInput -> Post (Resp Int)
handleAddJson (Body (AddInput a b)) = 
  pure $ ok $ a + b

Curls to test the routes:

curl http://localhost:8085/api/hello/world

curl -X 'GET' \
  'http://localhost:8085/api/succ?value=2' \
  -H 'accept: application/json' \
  -H 'Trace-Id: xyz-trace'

curl -X 'GET' \
  'http://localhost:8085/api/add-if?a=2&b=4&perform=true' \
  -H 'accept: application/json'

curl -X 'GET' \
  'http://localhost:8085/api/mul/100/23' \
  -H 'accept: application/json'

Adding some goodies to the servers

There are some useful add-ons that make development of the servers much more pleasant. Let's discuss couple of them.

Add swagger

Making curl request can quickly become hard to manage as our servers become more complicated. There is OpenAPI standard that defines how to describe HTTP-server API. Also it provides Swagger. It is a tool to make it easy to check how server behaves. It provides an HTTP-client for the server usable from the browser as plain web-page which allows us to query server routes.

Let's add a swagger to our server. Just add this line:

server :: IO
server = 
  withSwagger def $ 
    "api" /. [ {- the rest of the code -} ]

Let's add this line to our example and restart the server. By default it creates a route for the server that serves Swagger UI client at the path: http://localhost:8085/swagger-ui/. It is easy to query the routes with swagger ui.

We can add swagger to any server with function:

withSwagger :: SwaggerConfig m -> Server m -> Server m

We will study the SwaggerConfig in details in one of the next chapters but for now the default value which is set with def from library data-default is fine.

Add simple logs to the server

We can look at the request and response data with tracing functions which come from library mig-extra from the module Mig.Extra.Plugin.Trace:

data Verbosity = V0 | V1 | V2 | V3

-- log http requests and responses
logHttp :: Verbosity -> Plugin m

-- | log requests
logReq :: Verbosity -> Plugin m

-- | Log responses
logResp :: Verbosity -> Plugin m

The Plugin m is a function that can be applied to all routes of the server and modify their behavior. To apply plugin to server we can use functions:

applyPlugin :: Plugin m -> Server m -> Server m

($:) :: Plugin m -> Server m -> Server m

We show simplified signatures here. The real ones are overloaded by the first argument. But we will discuss plugins in depth in the separate chapter. For now it's ok to assume that those functions are defined in that simplified way.

So let's look at the data that goes through our server:

import Mig.Extra.Plugin.Trace qualified as Trace

...

server = 
  withSwagger def $ 
    withTrace $ {-# the rest of the server code #-}
  where
    withTrace = applyPlugin (Trace.logHttp Trace.V2)

Let's restart the server and see what it logs:

log:
  body: ''
  headers:
    accept: application/json
  method: GET
  path: api/add?a=12&b=45
  time: 2023-10-05T16:29:16.262934Z
  type: http-request

log:
  body: 57
  duration: 9.750000000000001e-4
  headers:
    content-type: application/json
  method: GET
  path: api/add?a=12&b=45
  status: 200
  time: 2023-10-05T16:29:16.263903Z
  type: http-response

This is an easy way to add add hock logs to the application. Note that those logs are not aware of concurrency and will report intermingled messages on concurrent queries.

We can add real logs with more generic versions of the functions which accept callback and we can pass the logger function defined in terms of one of the standard Haskell logging libraries, say katip or fast-logger:

import Data.Aeson as Json

logHttpBy :: (Json.Value -> m ()) -> Verbosity -> Plugin m

Summary

We have learned how various parts of the requests can be queries with newtype wrappers. There are only handful of them. We can query

• Query name value - for required queries
• Body media value - for request body
• Optional name value - for optional queries
• Header name value - for required headers
• OptionalHeader name value - for optional headers
• Cookie value - for cookies (set in the header)
• Capture name value - for path captures
• QueryFlag - for boolean query that can be missing in the path (and then it is false)

We have learned to use specialized versions for servers which operate only in terms of IO or Json. We can import the module Mig.Json.IO and our signatures would become more simple and specific.

We have learned how by one-liners we can add to the server some useful features:

• swagger: (withSwagger def server) For calls to the server in the UI

• trace logs: (applyPlugin (logHttp V2)) To see the data that flows through the server

Both expressions transform servers and have signatures:

Server m -> Server m

Anatomy of the response

For the next example we are going to study which outputs can handler produce. Let's study the HTTP-response.

Http response

We already have seen the Resp data type in the first chapter:

-- | Response with info on the media-type encoded as type.
data Resp media a = Resp
  { status :: Status
  -- ^ response status
  , headers :: ResponseHeaders
  -- ^ response headers
  , body :: Maybe a
  -- ^ response body. Nothing means "no content" in the body
  }
  deriving (Show, Functor)

It is the main type to return values and additional HTTP-information from response.

An HTTP-response contains:

• integer status. It's 200 when everything is alright
• list of headers which provide useful info on response type
• the byte string body which contains result of handler operation. It can hold JSON, HTML, plain text, raw byte string and other types of outputs.

In the Resp type the media type argument specifies which type the body has. By this type handler knows how to convert value to low-level byte string representation.

When things go bad

Sometimes things go bad and we would like to send errors and state in the status the type of the error. To report errors we have special type RespOr:

-- | Response that can contain an error. The error is represented 
-- with left case of an Either-type.

newtype RespOr ty err a = RespOr {unRespOr :: Either (Resp ty err) (Resp ty a)}

So this value has two possible responses which share the same media type. We need two different responses to be able to report errors with different type than the type of the result.

Response type class IsResp

To unify the output for both cases of Resp and RespOr we have special type class called IsResp for all types which can be converted to low-level HTTP-response type Response.

Let's study this type class. It has two associated types for the type of the body (RespBody) and type of the error (RespError):

class IsResp a where
  type RespBody a :: Type
  type RespError a :: Type
  type RespMedia a :: Type

We can return successful result with method ok:

  -- | Returns valid repsonse with 200 status
  ok :: RespBody a -> a

When things go bad we can report error with method bad:

  -- | Returns an error with given status
  bad :: Status -> RespError a -> a

Sometimes we do not want to return any content from response. We can just report error status and leave the body empty:

  -- | response with no content
  noContent :: Status -> a

We can add custom headers to the response by method addHeaders:

  -- | Add some header to the response
  addHeaders :: ResponseHeaders -> a -> a

Note that header Content-Type is set automatically. Although sometimes we would like set it explicitly. For that we have the method:

  -- | Set the media type of the response
  setMedia :: MediaType -> a -> a

Also we can set response status with function:

  -- | Set the response status
  setStatus :: Status -> a -> a

Also the core of the class is the method to convert value to low-level response:

  -- | Converts value to low-level response
  toResponse :: a -> Response

Both Resp and RespOr are instances of IsResp class and we can Send as HTTP-response anything which has instance of IsResp. For now there are only three types. The third one instance is the low-level Response type.

Examples

So we use Resp if we are sure that handler always produce a value and we use RespOr if handler can produce and error.

How to return error

We already have seen many usages of Resp type. Let's define something that can produce an error. Let's define server that calculates square root of the value. For negative numbers it is not defined in the domain of real numbers. So let's define the handler that use RespOr type:

import Mig.Json.IO

server :: Server IO
server = 
  "square-root" /. squareRoot

squareRoot :: Body Float -> Post (RespOr Text Float)
squareRoot (Body arg) = pure $
  if arg >= 0 
    then ok (sqrt arg)
    else bad badRequest400 "Argument for square root should be non-negative"

So we return error message and bad request status 400 when negative argument is passed to the handler.

Also note this function looks like pure GET-type function but by the HTTP rules we can not have body request in the GET-method. So we use POST instead.

Also we have special case function for bad requests called badReq. The values for status come from the library http-types. See the module dedicated to HTTP-statuses. It is reexported by the mig library.

How to set headers

For example in the Header we expect trace id with which we can find the request and response in the logs. And we want to pass the trace id from request to the response. Let's do it with addHeaders:

passTrace :: Header "trace-id" Text -> Post (Resp ())
passTrace (Header traceId) =  
  pure $ addHeaders [("trace-id", toHeader traceId)] $ ok ()

The function toHeader is re-exported from the library http-api-data. It converts various values to header byte string.

Also there is a function if we want to add only one header and not a list of them:

setHeader :: (IsResp a, ToHttpApiData h) => HeaderName -> h -> a -> a

It has toHeader built into it.

Just like we set headers we also can set HTTP-status of the response. We just apply it to Resp-like value. It works both for Resp and RespOr:

setStatus :: IsResp a => Status -> a -> a

Although we rarely need this function as ok sets the right status for successful response and all functions that need the status take it as argument.

Also we have functions to set cookies that are form url-encoded:

setCookie :: (ToForm val, IsResp a) => SetCookie val -> a -> a

-- sets cookie params
data SetCookie 

-- | Cookie setter with default params (only value)
defCookie :: val -> SetCookie val
defCookie = ...

For great explanation on how cookies work in HTTP you can read an article. Under the hood it is just a http-header with name SetCookie. To read the cookie value use input request newtype-wrapper Cookie.

How it works with server definition

How can we use both of the types as responses: Resp and RespOr? Recall that /. function is overloaded by the second argument and we have a rule for ToServer class that:

if a has IsResp instance then Send method m a is convertible to server

As for both Resp and RespOr the instance for IsResp is defined we can use both types as a result of the HTTP-handler.

Summary

We have learned that there are only tow types to return from server handler:

• Resp for handlers that always produce a value
• RespOr for handlers that can fail

The need for the second type is to have different type of the error and different for the result. If both error and result have the same type then we can use Resp. This is common case for HTML servers when we return HTML-page as a result. In the case of error we would like to show the page too as in the case of success. The difference would be in the HTTP-status of the response.

And this goes well with IsResp class as for Resp media a error type RespError equals to a as the value for RespBody too. Also we have learned various methods of the IsResp class and how they can be useful in server definitions.

See the source code RouteArgs for examples on the topic that we have just studied.

With this chapter we have covered both requests and responses and which types the can have. It covers all basics of the mig library. You are now well equipped to build HTTP-servers in Haskell. The rest of the tutorial covers more advanced features of the library:

• how to use custom monads. So far we used only plain IO-monad
• how to use plugins/middlewares to add common procedures to all handlers of the server
• how to create HTTP-clients from servers
• description of two more substantial examples
  • JSON API application for weather forecast
  • HTML example for blogpost site

Using other monads with Server

So far we have seen only IO monad to be used with Server. But we can use other monads with it. Although so far only three types of monads are supported for Servers:

• IO-monad
• ReaderT env IO and newtype wrappers on top of it
• ReaderT env (EitherT IO) and new type wrappers on top of it

So the library is limited in monad choice but all of the cases can cover everything you need from the server.

Also we can use any monad which is convertible to IO with function:

hoistServer :: forall a . (m a -> n a) -> Server m -> Server n

The reason why we would like to convert to IO because warp server convertion function runServer works only for the type Server IO. So we can use any monad but we would like to convert to IO at the very and to be able to run our server with warp.

I personally prefer to just use IO and pass environment around to handlers. This process can be automated with ReaderT monad. Let's study how to use ReaderT with the server.

As example we will build a server that contains mutable state. It has internal counter which we can query and increment. To store the internal state as shared environment for all handlers we are going to Reader-pattern or server with ReaderT over IO monad.

Reader-pattern

Our server is Json-based but we want custom monad. So we can import the preset module for Json:

import Mig.Json

Also we import ReaderT from mtl library and IORef to store mutable shared state:

import Control.Monad.Reader
import Data.IORef

Let's define a type for our application:

newtype App a = App (ReaderT Env IO a)
  deriving newtype (Functor, Applicative, Monad, MonadReader Env, MonadIO, HasServer)

{-| Common shared state
We can put more shared state if we need. Like logger state or some interfaces.
-}
data Env = Env
  { current :: IORef Int
  }

-- | Init shared state
initEnv :: IO Env
initEnv = Env <$> newIORef 0

HasServer class

We declare it as newtype-wrapper with ReaderT under the hood. We can derive all the classes that we need to use it as Reader. All classes but last are common repertoire of the Haskell. The last class HasServer is special to mig library. It can be also auto-derived as the instance for ReaderT+IO is already defined.

The HasServer class defines how to convert our special monad m server to Server IO. For a reader it defines a method:

  renderServer :: Server (ReaderT env m) -> env -> IO (Server IO)

So if we pass the common shared environment env to server we can use it as Server IO. We need to convert to Server IO because for WAI and warp we can run only Server IO based servers. As in library mig-wai:

toApplication :: Server IO -> Wai.Application

How to run Reader based server

So to run the ReaderT server we need to convert it to IO-based server and we can run it with usual runServer function:

main :: IO ()
main = do
  env <- initEnv 
  putStrLn ("The counter server listens on port: " <> show port)
  runServer port $ withSwagger def $ renderServer server env
  where
    port = 8085

server :: Server App

Here we also add the swagger to the server for easy testing and trying things out with swagger.

Server with Reader monad

Our server has two routes:

• get - to query current state
• put - to add some integer to the state

server :: Server App
server =
  "counter"
    /. [ "get" /. handleGet
       , "put" /. handlePut
       ]

Let's define the get route:

-- | Get handler. It logs the call and returns current state
handleGet :: Get App (Resp Int)
handleGet = Send $ do
  logInfo "Call get"
  ref <- asks (.current)
  liftIO $ ok <$> readIORef ref

-- | Helper to do simple logging
logInfo :: String -> App ()
logInfo message = liftIO $ putStrLn $ "[INFO] " <> message

So we ask for the common mutable state and read it with readIORef function. Also we use liftIO to lift IO result to App monad. We just use App monad inside Send-wrapper to create a handler.

Let's define the put handler:

-- | Put handler. It logs the call and updates 
-- the state with integer which is read from URL
handlePut :: Capture "arg" Int -> Post App (Resp ())
handlePut (Capture val) = Send $ do
  logInfo $ "Call put with: " <> show val
  ref <- asks (.current)
  liftIO $ ok <$> atomicModifyIORef' ref (\cur -> (cur + val, ()))

We use atomicModifyIORef' to be safe in presence of concurrent requests. So we have completed the definition and we can run the app and try it out. You can find the complete code of the example in the mig repo.

Using custom monad

We have studied how to use ReaderT IO and newtype-wrappers on top of it as monads for our server. To use any other monad we need to have the function:

runAsIO :: MyMonad a -> IO a

For custom monad MyMonad. If there is such a function we can use function:

hoistServer :: forall a . (m a -> n a) -> Server m -> Server n

Prior to call to runServer and run the server which is based on our custom monad:

main :: IO ()
main = runServer 8085 (hoistServer runAsIO server)

server :: Server MyMonad
server = ...

Summary

In this chapter we have learned how to use Reader-monad with mig library. We can define our custom wrapper for ReaderT+IO and derive instance of HasServer and we are ready to go.

Plugins

A plugin is a transformation which is applied to all routes in the server. Also often it is called a middleware. But here we use a bit shorter name for it and call it a Plugin. It is a pair of functions which transform API-description and server function:

data Plugin m = Plugin
  { info :: RouteInfo -> RouteInfo
  -- ^ update api schema
  , run :: PluginFun m
  -- ^ update server function
  }

-- | Low-level plugin function.
type PluginFun m = ServerFun m -> ServerFun m

To apply plugin to server we ca use function applyPlugin:

-- | Applies plugin to all routes of the server.
applyPlugin :: forall f. (ToPlugin f) => 
  f -> Server (MonadOf f) -> Server (MonadOf f)

There is also infix operator for application ($:).

The class ToPlugin contains all types that can be converted to plugin. Here we use the same trick as with ToServer class to be able to read type-safe parts of the request and update the API-schema. The type-level function MonadOf knows how to find underlying monad m in various types.

We have recursive set of rules for types that can be converted to Plugin:

The identity rule:

PluginFun has instance of ToPlugin with obvious identity instance

Recursive steps for inputs

if f is ToPlugin then (Query name queryType -> f) is ToPlugin too

And so on for other types of request input (query parameters, headers, captures, request bodies). See the full list of instances in the module Mig.Core.Class.Plugin.

Examples

So the plugin allows us to apply some behavior to all routes in the server. Let's discuss some examples

Add logging

Let's add the logging to all methods which are called. We will log which route was called and we will include the time stamp and the full path in the log:

Let's imagine that we have a function

logInfo :: Text -> IO ()

We can query the path with FullPathInfo newtype:

newtype FullPathInfo = FullPathInfo Text

And we have a rule for ToPlugin class:

if f is ToPlugin then (FullPathInfo -> ToPlugin f) is ToPlugin

So we can create a plugin function:

logRoutes :: Plugin IO
logRoutes = toPlugin $ \(FullPathInfo path) -> prependServerAction $ do
  now <- getCurrentTime 
  logInfo $ mconcat
    [ "Call route: ", path 
    , " at ", Text.pack (show now)
    ]

We use function prependServerAction that creates a Plugin from action which is performed prior to call to server function:

prependServerAction :: MonadIO m => m () -> Plugin m

Also there are similar functions in the module: appendServerAction and processResponse.

Allow only secure routes

Another great example of plugin at work is to block routes on some conditions. For example if we want certain routes to be used only under secure SSL connection. We have a standard function for that whenSecure. But let's dive into it's definition to see how plugins can be used:

-- | Execute request only if it is secure (made with SSL connection)
whenSecure :: forall m. (MonadIO m) => Plugin m
whenSecure = toPlugin $ \(IsSecure isSecure) -> 
  processResponse (if isSecure then id else const (pure Nothing))

Here we use standard plugin processResponse which allows us to alter the result of the HTTP-response:

processResponse :: MonadIO m => 
  (m (Maybe Response) -> m (Maybe Response)) -> Plugin m

Also we use query input IsSecure which is true if connection is made over SSL:

newtype IsSecure = IsSecure Bool

So we pass through the response with identity if connection is secure and we block the execution by returning Nothing if connection is secure. The cool part of it is that due to laziness there is no performance overhead and underlying route is not going to be performed if connection is insecure.

Authorization with plugin

Let's use this schema for authorization to site. There is a route that provides authorized users with session tokens. A user can pass credentials as request body over secure connection and get session token in response which is valid for some time.

With that token the user can access the rest of the application. The user can pass token as a special header. And we check in the application that token is valid.

Imagine that we have a type for a session token:

newtype AuthToken = AuthToken Text
    deriving newtype 
      (ToJSON, FromJSON, FromHttpApiData, Eq, Ord, Show, ToParamSchema, ToSchema)

And we can get it from some route:

getToken :: Body UserCreds -> Post (Resp AuthToken)

We would like to block invalid sessions for all routes of our site. We can create it in similar way as whenSecure:

isValid :: AuthToken -> IO Bool
isValid = ...

headerAuth :: Header "auth" AuthToken -> Plugin IO
headerAuth (Header token) = processResponse $ \getResp -> do
  isOk <- isValid token
  if isOk
    then getResp
    else pure $ Just $ bad badRequest400 "Auth token is invalid"

whenAuth :: Server IO -> Server IO
whenAuth = applyPlugin headerAuth

In this example we use IsResp instance for low-level http Response to report authorization error. The header with name "auth" is required for all routes which are part of the server to which we apply the plugin.

Summary

In this chapter we have learned on plugins. They provide a tool to apply transformation to all routes in the server. Which can be useful for logging, authorization and adding common behavior to all routes.

How to use Swagger

The Swagger is a powerful tool to try out your servers. It provides easy to use Web UI to call routes in the server. We already have seen how to augment server with swagger. It is just a line of code:

withSwagger def server

The function withSwagger is defined in the package mig-swagger-ui which is re-exported by mig-server.

In this chapter we are going to learn how to tweak and fine-tune the swagger.

Swagger config

We have used default swagger config with constant def. Let's look at what can be configured:

data SwaggerConfig m = SwaggerConfig
  { staticDir :: Path
  -- ^ path to server swagger (default is "/swagger-ui")
  , swaggerFile :: Path
  -- ^ swagger file name (default is "swaggger.json")
  , mapSchema :: OpenApi -> m OpenApi
  -- ^ apply transformation to OpenApi schema on serving OpenApi schema.
  -- it is useful to add additional info or set current date in the examples
  -- or apply any real-time transformation.
  }

instance (Applicative m) => Default (SwaggerConfig m) where
  def =
    SwaggerConfig
      { staticDir = "swagger-ui"
      , swaggerFile = "swagger.json"
      , mapSchema = pure
      }

We can set in staticDir at what path to serve the swagger, how to name the swagger file with swaggerFile and which run-time transformation we apply to the OpenApi schema. We can use this mapping to add useful description to the app or keep examples up to date if they use for example timestamps that should be in the future to be valid.

Add description to application

Often we would like to provide short description of the application, which version it has. We can use the package openapi3 to update OpenApi directly. But also there is a helper type for most often used fields:

-- | Default info that is often added to OpenApi schema
data DefaultInfo = DefaultInfo
  { title :: Text
  , description :: Text
  , version :: Text
  }

addDefaultInfo :: DefaultInfo -> OpenApi -> OpenApi

We can set title, description and version for the application. Here is an example:

setSwagger :: Server IO -> Server IO
setSwagger = withSwagger config
  where
    config =
      (def :: SwaggerConfig IO)
        { mapSchema = pure . addDefaultInfo info
        }

    info =
      def
        { title = "Weather forecast"
        , description =
            "JSON API example for mig library which shows how to forecast weather to authorized users"
        , version = "0.1.0"
        }

Describe the routes

Often we would like to add some useful documentation on the routes. We can do it with the functions:

-- | Sets description of the route
setDescription :: Text -> Server m -> Server m

-- | Sets summary of the route
setSummary :: Text -> Server m -> Server m

-- | Adds OpenApi tag to the route
addTag :: Text -> Server m -> Server m

We can apply those functions at definition of the route. Also we can describe the inputs for the route:

{-| Appends descriptiton for the inputs. It passes pairs for
@(input-name, input-description)@. Special name request-body 
is dedicated to request body input nd raw-input is dedicated 
to raw input
-}
describeInputs :: [(Text, Text)] -> Server m -> Server m

It takes a map from input parameter name to description. There is special name "request-body" for the request body input.

An example:

server = "calculator" /.
  mconcat
    [ describeAdd $ "add" /. add
    , describeMul $ "mul" /. mull
    ]
  where
    describeAdd = setDescription "Performs addition" . describeArgs
    describeMul = setDescription "Performs multiplication" . describeArgs

    describeArgs = describeInputs [("a", "first argument"), ("b", "second argument")]

add, mul :: Capture "a" Int -> Capture "b" Int -> Get (Resp Int)

Summary

In this chapter we have learned how to tweak our swagger servers and make them more user-friendly.

JSON example: weather forecast

We have learned all we need to know about mig to be able to build something cool with it. Let's build a weather forecast application. The app has registered users which can request authorization tokens. With that token users can request for weather in specific city and on specific time and also they can update the weather data. For simplicity we omit user registration and defining roles for the users.

Domain for our application

Let's define main types for our application in the module Types.hs. We will import Mig.Json.IO to bring in the scope some classes and types common for HTTP-servers:

module Types where

import Data.Time (Day)
import Mig.Json.IO

Domain of users

There are users in the application that can register and get session tokens:

data User = User
  { name :: Text
  , pass :: Text
  }
  deriving (Generic, ToJSON, FromJSON, ToSchema)

newtype AuthToken = AuthToken Text
  deriving newtype 
    (ToJSON, FromJSON, FromHttpApiData, Eq, Ord, Show, ToParamSchema, ToSchema)

We need the instances to pass the data over HTTP wires.

Domain of weather

We are going to query weather info by location and date:

newtype DayInterval = DayInterval Int
  deriving newtype (ToJSON, FromJSON, FromHttpApiData, ToParamSchema)

data Timed a = Timed
  { from :: Day
  , content :: [a]
  }
  deriving (Generic, ToJSON, FromJSON)

deriving instance (ToSchema a) => ToSchema (Timed a)

newtype Location = Location Text
  deriving newtype 
    (ToJSON, FromJSON, FromHttpApiData, Eq, Ord, Show, ToParamSchema, ToSchema)

The weather has information on temperature, speed of the wind, sun/rain ratio and pressure:

data WeatherData = WeatherData
  { temperature :: Int
  , windSpeed :: Int
  , sunRainRatio :: Int
  , pressure :: Int
  }
  deriving (Generic, ToJSON, FromJSON, ToSchema)

Also some users can update DB of weather:

-- | Update weather data
data UpdateData = UpdateData
  { day :: Day
  , location :: Location
  , content :: WeatherData
  }
  deriving (Generic, ToJSON, FromJSON, ToSchema)

That is our domain for the weather application.

Lets define a server

We are going to build JSON HTTP application. For that we will use the module Mig.Json.IO which provides handy types specified to our domain. We expect our application to have shared context Env which we pass to all handlers.

import Mig.Json.IO
import Types

server :: Env -> Server IO
server env =
  withSwagger def $
    "api/v1/weather"
      /. [ auth
         , withAuth env $: app
         ]
  where
    auth = "get/auth-token" /. requestAuthToken env

    app =
      mconcat
        [ "get/weather" /. getWeather env
        , "update" /. updateWeather env
        ]

-- | Site internal shared context
data Env = Env

-- weather

getWeather ::
  Env ->
  Capture "location" Location ->
  Capture "day" Day ->
  Capture "day-interval" DayInterval ->
  Get (RespOr Text (Timed WeatherData))
getWeather = undefined

updateWeather ::
  Env ->
  Body UpdateData ->
  Post (RespOr Text ())
updateWeather = undefined

-- users

requestAuthToken :: Env -> Body User -> Post (RespOr Text AuthToken)
requestAuthToken = undefined

withAuth :: Env -> Header "auth" AuthToken -> Plugin IO
withAuth = undefined

We have one route to query for token:

requestAuthToken :: Env -> Body User -> Post (RespOr Text AuthToken)

And two routes that query info on weather and update it:

getWeather ::
  Env ->
  Capture "location" Location ->
  Capture "day" Day ->
  Capture "day-interval" DayInterval ->
  Get (RespOr Text (Timed WeatherData))

updateWeather ::
  Env ->
  Body UpdateData ->
  Post (RespOr Text ())

Also we have a plugin that filters out non authorized calls:

withAuth :: Env -> Header "auth" AuthToken -> Plugin IO

From its type-signature we can assume that authorization token is passed in the header of the request.

The structure of the server

We define server as a collection of actions that can be performed. The server is defined in terms of interfaces. We can initialize those interfaces and pass them to handlers.

Our app has several domains:

• users and sessions

• weather DB interface

• process life cycle: logging, startup, cleanup, etc

So the server environment has three parts:

data Env = Env
  { auth :: Auth
  , weather :: Weather
  , proc :: Proc
  }

Let's define operations for those domains. We define them in the module Interface.hs.

User domain

For the user we can do

• check that user is valid and can use the app

• allocate new authorization token

• check that token is valid

• expire the token (make it invalid)

-- authorization interface
data Auth = Auth
  { newToken :: User -> IO AuthToken
  , validUser :: User -> IO Bool
  , validToken :: AuthToken -> IO Bool
  , expireToken :: AuthToken -> IO ()
  }

Weather domain

For the weather we can query info and update it:

-- weather forecast interface
data Weather = Weather
  { get :: Location -> Day -> DayInterval -> IO (Maybe (Timed WeatherData))
  , update :: UpdateData -> IO ()
  }

Process domain

For the application process we keep all server life cycle tools which are not related to business logic domain. It can be logging, metrics, startup and cleanup actions:

-- | Process interface
data Proc = Proc
  { startup :: IO ()
  , cleanup :: IO ()
  , Logger :: Logger
  }

-- logger interface
data Logger = Logger
  { info :: LogFun
  , debug :: LogFun
  , error :: LogFun
  }

type LogFun = Value -> IO ()

We log JSON-values. As a helper functions we create functions that can log anything which is convertible to JSON:

logInfo :: (ToJSON a) => Env -> a -> IO ()
logInfo env = env.proc.logger.info . toJSON

logDebug :: (ToJSON a) => Env -> a -> IO ()
logDebug env = env.proc.logger.debug . toJSON

logError :: (ToJSON a) => Env -> a -> IO ()
logError env = env.proc.logger.error . toJSON

Using interfaces

It's interesting to note how all actions on shared state can be expressed as interfaces. We will declare the concrete mutable representation later but for now it is ok to hide them with not implemented yet functions. This also allows us to create mock applications for testing and substitute implementations without changing the code for the server.

Define server in terms of interfaces

As we have defined the main operations of the application we can complete the definition of the server. Let's define the routes for weather domain first as they are more simple.

Weather domain

We can query the weather forecast with function:

getWeather ::
  Env ->
  Capture "location" Location ->
  Capture "day" Day ->
  Capture "day-interval" DayInterval ->
  Get (RespOr Text (Timed WeatherData))
getWeather env (Capture location) (Capture fromDay) (Capture interval) = Send $ do
  logInfo @Text env "get the weather forecast"
  mResult <- env.weather.get location fromDay interval
  pure $ case mResult of
    Just result -> ok result
    Nothing -> bad status400 "No data"

We log that call to get weather is in the progress. Then we try to fetch weather data and if it has the data we return it to the user otherwise we report error.

Let's update the weather data:

updateWeather ::
  Env ->
  Body UpdateData ->
  Post (Resp ())
updateWeather env (Body updateData) = Send $ do
  logInfo @Text env "update the weather data"
  ok <$> env.weather.update updateData

We log the report and update the weather data.

The user domain

Let's give the user access token and check that token is valid. Let's allocate a new token in the handler requestAuthToken:

requestAuthToken :: Env -> Body User -> Post (RespOr Text AuthToken)
requestAuthToken env (Body user) = Send $ do
  logInfo env ("get new auth token for: " <> user.name)
  isValid <- env.auth.validUser user
  if isValid
    then do
      token <- env.auth.newToken user
      void $ forkIO $ setExpireTimer token
      pure $ ok token
    else do
      logError env $ Text.unwords ["User", user.name, "does not have access to the service"]
      pure $ bad unauthorized401 "User is not valid"
  where
    setExpireTimer :: AuthToken -> IO ()
    setExpireTimer token = do
      threadDelay (1_000_000 * 60 * 10) -- 10 minutes
      env.auth.expireToken token

We check that user is valid and if the user is valid we give user a token and also set the expiration for it. We will expire it 10 minutes after registration. The expiration is concurrent process that is forked from the thread that handles the request. If user has no rights to use our service we report error.

Let's check for authorization tokens. Ideally we would like to add this action to all handlers of our application. We would like to keep the business logic handlers for the weather domain the same. And we can do it with plugin. Let's define such a plugin that expects authorization tokens with required header:

withAuth :: Env -> Header "auth" AuthToken -> Plugin IO
withAuth env (Header token) = processResponse $ \getResp -> do
  isOk <- env.auth.validToken token
  if isOk
    then getResp
    else do
      logError env errMessage
      pure $ Just (bad status500 $ Text.encodeUtf8 errMessage)
  where
    errMessage = "Token is invalid"

We have covered in depth how to implement it in the chapter on Plugins so this code should look familiar to us.

Run application

That completes the definition of the server. Let's run it. We define the main function in the module Main.hs:

main :: IO ()
main = do
  env <- initEnv port
  env.proc.startup
  runServer port (server env)
    `finally` env.proc.cleanup
  where
    port = 8085

initEnv :: Port -> IO Env
initEnv = undefined

The initialization of interfaces is yet to be defined. So this is all we need to start the server.

Implementation of the interfaces

For the purpose of the example we will create a mock application. A bit more detailed implementation is in the source code of the mig library. See example JsonApi.

Mock application

We can create a mock application with one user.

import Data.ByteString.Char8 qualified as B
import Data.Yaml qualified as Yaml
import Data.Aeson qualified as Json

initEnv :: Port -> IO Env
initEnv port = pure $ Env initAuth initWeather (initProc proc)

-- | Application with single user john with token that never expires
initAuth :: Auth
initAuth = 
  Auth
  { newToken = const $ pure AuthToken "john-token"
  , validUser = \(User name pass) = pure $ name == "john" && pass == "123"
  , validToken = (\AuthToken token) -> pure (token == "john-token")
  , expireToken = const $ pure ()
  }

initWeather = Weather
  { get = \location day dayInterval -> pure Nothing
  , update = \updateData -> pure ()
  }

initProc :: Port -> Proc
initProc = 
  pure Proc 
    { logger = logger
    , startup = logger.info $ "App started on port: " <> Text.pack (show port)
    , cleanup = logger.info "App shutdown"
    }
  where
    logger = initLogger

initLogger :: Logger
initLogger = Logger
  { info = logBy "info" 
  , debug = logBy "debug"
  , error = logBy "error"
  }
  where
    logBy :: Text -> Json.Value msg -> IO ()
    logBy level msg = B.putStrLn . Yaml.encode . addLogPrefix $
        Json.object [ "level" .= level, "message" .= msg ]

addLogPrefix :: Json.Value -> Json.Value
addLogPrefix val = Json.object ["log" .= val]

We can start the application and try it out with swagger.

Exercises

You can find the complete code of the example in the mig repo.

• implement routes for user registration. Only registered users can receive the authorization token.

• implement roles for the users:

  • admin: can manage users
  • db-writer: can update weather forecast
  • visitor: can only view forecasts

• implement in-memory storage of the weather DB. Use maps to store weather data and info on valid users and tokens.

• implement real logger with fast-logger library

• implement interface that connects application to some real DB. The code for the server should stay the same and only initialization of interface should change. Use one of the DB libraries for Haskell: hasql, postgresql-simple

Summary

In this chapter we have defined a more substantial example of JSON HTTP application and applied various concepts in practice.

HTML example: Blog site

We have seen many examples of JSON applications. But we can send data in other formats too. Most common format for human-readable information for HTTP applications is HTML. Any site that we visit sends HTML pages to us. Let's create a simple site that shows blog posts and quotes and we can add new blog posts to it. Complete code for example is in the mig repo We will cover the most interesting parts of the application.

As in previous example we are going to use IO-based server. The common actions that change internal state of the site or query useful data are expressed as collection of interfaces. All handlers accept interfaces as first argument.

The structure of the application is similar to the weather forecast example. The modules with their purpose:

• Types - types that cover domain of our application
• Server - defines server API and handlers
• Main - runs the server
• View - renders types as HTML-pages
• Interface - actions that can be performed on shared internal state of the app
• Init - initialization of the interfaces
• Content - some mock data to show on page
• Internal - internal state of the site

Using preset module for HTLM servers

As we define server based on IO and HTML we will use the module Mig.Html.IO. Note that there is a difference in types from JSON brother of that module. We will not see the Resp type in the signatures of the handlers.

Because for HTML the type synonyms to Send fix the output of Send-type so that it always has value wrapped in Resp:

type Get a = Send GET IO (Resp a)

The Resp-type is built in the type because for HTML we almost never need the RespOr with different type of errors. Our errors are going to be HTML-pages to as the result. So we report errors to user in HTML-pages.

Run a server

Let's define a function that will start an empty server:

module Main (
  main,
) where

import Mig.Html.IO (runServer)

main :: IO ()
main = do
  site <- initSite
  runServer port (server site)
  where
    port = 8085

-- | Placeholder for collection of interfaces
data Site = Site

-- | Initialize site's interfaces
initSite :: IO Site
initSite = pure Site

-- | Create a server that works in terms of interfaces
server :: Site -> Server IO
server _ = mempty

Define server routes

Let's define the server and its routes. For our blog post site we are going to show the pages:

• main page with list of blog posts and greeting

• show random blog post

• show random quote

• save new blog post

• list all blog posts

Also our site serves static files which contain CSS-style file and images We keep them in separate directory called resources.

Here is the definition of the server:

-- | Server definition. Note how we assemble it from parts with monoid method mconcat.
server :: Site -> Server IO
server site =
  logRoutes $
    mconcat
      [ "blog"
          /. [ readServer
             , writeServer
             ]
      , defaultPage
      , addFavicon $ "static" /. staticFiles resourceFiles
      ]

The site serves several sub-servers:

• readServer - pages that fetch content for us
• writeServer - pages to update the content. To save new blog post
• defaultPage - main page of the app
• staticFiles with addFavicon - serves static files and adds icon for our site that is shown in the tab of the browser

default page server

Let's define the simplest server, the default page:

-- default main page
defaultPage =
  mconcat
    [ "/" /. handleGreeting site
    , "index.html" /. handleGreeting site
    ]

handleGreeting :: Site -> Get (Page Greeting)

It links two routes to the handleGreeting handler. We serve two routs: the route of the site and default route for main page "/index.html".

For now we can think of Page as main template of our site which contains some value that is renderable to HTML. Renderer converts the value to HTML and injects it to the site's template.

Read server

Let's define read-only pages for our site.

-- server to read info.
-- We can read blog posts and quotes.
readServer =
  mconcat
    [ "read"
        /. [ "post" /. handleBlogPost site
           , "quote" /. handleQuote site
           ]
    , "list" /. handleListPosts site
    ]

handleBlogPost :: Site -> Optional "id" BlogPostId -> Get (Page BlogPost)

handleQuote :: Site -> Get (Page Quote)

handleListPosts :: Site -> Get (Page ListPosts)

We have three pages to read in our site:

• handleBlogPost - shows random blog post
• handleQuote - shows random quote
• handleListPosts - shows a list of all posts

Write server

Let's define a route to add new blog posts to the site:

    -- server to write new blog posts
    writeServer =
      "write"
        /. [ toServer $ handleWriteForm site
           , toServer $ handleWriteSubmit site
           ]

handleWriteForm :: Site -> Get (Page WritePost)

handleWriteSubmit :: Site -> Body FormUrlEncoded SubmitBlogPost -> Post (Page BlogPost)

We have two different routes which are served on the same path. The first route shows the page with form to fill the post data. The second route is triggered when we hit the submit button. The data in the form is send to the site as request body with Content-Type set to corresponding FormUrlEncoded type.

We can serve several route handlers on the same path if they differ by HTTP-method, input type or output type. In this example we use toServer function to convert route handler function to Server IO.

As we can see all handlers expect the value Site as first argument. This value contains interfaces for all actions that can be performed with our site.

Static files

We serve static files with the line:

  , addFavicon $ "static" /. staticFiles resourceFiles

Let's explain what happens here. The standard function staticFiles takes a collection of files and turns them into server:

staticFiels :: MonadIO m => [(FilePath, ByteString)] -> Server m

The list of pairs contains pair of (path-to-file, byte-string-content-of-the-file). It is convenient to use it with function embedRecursiveDir which embeds all files from directory to Haskell executable. It comes with library file-embed-lzma. We use it like this:

server = "static" /. staticFiles resourceFiles

resourceFiles :: [(FilePath, ByteString)]
resourceFiles = $(embedRecursiveDir "Html/resources")

For our site we use milligram.css framework for styling and couple of pictures.

Also let's discuss addFavicon function:

addFavicon = addPathLink "favicon.ico" "static/lambda-logo.png"

It shows interesting concept of linking to the parts of the server. The standard function addPathLink serves all calls to favicon.ico with handler on path "static/lambda-logo.png". This way we can create additional links to the server.

Also we can reuse the sub-parts of another server in our server with function atPath:

{-| Sub-server for a server on given path
it might be usefule to emulate links from one route to another within the server
or reuse part of the server inside another server.
-}
atPath :: forall m. Api.Path -> Server m -> Server m

It creates sub-server for all routes that match given path-prefix. So it can be not only single route but the whole sub-server. The function addPathLink rides on top of that useful function.

Overview of the site

So for our site we have 5 handlers. Let's recall them:

handleBlogPost :: Site -> Optional "id" BlogPostId -> Get (Page BlogPost)

handleQuote :: Site -> Get (Page Quote)

handleListPosts :: Site -> Get (Page ListPosts)

handleWriteForm :: Site -> Get (Page WritePost)

handleWriteSubmit :: Site -> Body FormUrlEncoded SubmitBlogPost -> Post (Page BlogPost)

We can see from type signatures all the types for our domain. Let's define the types.

Domain model of the blog site

We are going to show Blog posts. And we have a form to input a new content to the site. We can define the types for domain as follows:

-- | Web-page for our site
newtype Page a = Page a

-- | Greeting page
data Greeting = Greeting [BlogPost]

-- | Form to submit new post
data WritePost = WritePost

-- | List all posts
newtype ListPosts = ListPosts [BlogPost]

-- | Blog post id
newtype BlogPostId = BlogPostId {unBlogPostId :: UUID}
  deriving newtype (FromHttpApiData, ToHttpApiData, Eq, Show, FromJSON, ToParamSchema)

data BlogPostView
  = ViewBlogPost BlogPost
    -- | error: post not found by id
  | PostNotFound BlogPostId

-- | Blog post
data BlogPost = BlogPost
  { id :: BlogPostId
  , title :: Text
  , createdAt :: UTCTime
  , content :: Text
  }

-- | A quote
data Quote = Quote
  { content :: Text
  }

-- | Data to submit new blog post
data SubmitBlogPost = SubmitBlogPost
  { title :: Text
  , content :: Text
  }
  deriving (Generic, FromForm, ToSchema)

We need to define certain instances to be able to send the data over HTTP wires. The types come from standard libraries for web development in Haskell: openapi3, http-api-data, aeson.

Interfaces for the site

Our web site is going to support the following actions:

{-| Web site actions. It defines interfaces that connect logic of our site
with outside world: DBs, logger.
-}
data Site = Site
  { readBlogPost :: BlogPostId -> IO (Maybe BlogPost)
  , writeBlogPost :: SubmitBlogPost -> IO BlogPostId
  , listBlogPosts :: IO [BlogPost]
  , readQuote :: IO Quote
  , logInfo :: Text -> IO ()
  , cleanup :: IO ()
  }

The actions are natural and follow the design of domain and server.

Implement handlers

Let's implement the handlers in terms of interfaces.

Default page

Let's greet the user:

-- | Greet the user on main page
handleGreeting :: Site -> Get (Page Greeting)
handleGreeting site =
  Send $ ok . Page . Greeting <$> site.listBlogPosts

We get the list of all blog posts and wrap them in Greeting page.

Read site

Let's read the blog post:

-- | Read blog post by id
handleBlogPost :: Site -> Optional "id" BlogPostId -> Get (Page BlogPostView)
handleBlogPost site (Optional mBlogId) = Send $
  case mBlogId of
    Nothing -> ok . Page . ViewBlogPost <$> randomBlogPost site
    Just blogId ->
      maybe
        (bad notFound404 $ Page $ PostNotFound blogId)
        (ok . Page . ViewBlogPost)
      <$> site.readBlogPost blogId

We have an optional query parameter that contains id of the blog post. If id is missing we return some random blog post. If there is no blog post that corresponds to id we return error with page not found status.

Let's read the random quote:

handleQuote :: Site -> Get (Page Quote)
handleQuote site = Send $ ok . Page <$> site.readQuote

Let's show all blog posts as a menu to the user:

handleListPosts :: Site -> Get (Page ListPosts)
handleListPosts site = Send $ do
  ok . Page . ListPosts <$> site.listBlogPosts

Write site

Let's show the form to the user to fill new post data:

handleWriteForm :: Site -> Get (Page WritePost)
handleWriteForm _site =
  Send $ pure $ ok $ Page WritePost

As we can see we just return the tag of the page that encodes the content with form. We will define the HTML-form in the rendering module View.hs.

Let's define the logic to save the submitted data to application:

-- | Submit form with data provided by the user
handleWriteSubmit :: Site -> Body FormUrlEncoded SubmitBlogPost -> Post (Page BlogPostView)
handleWriteSubmit site (Body submitData) = Send $ do
  pid <- site.writeBlogPost submitData
  maybe
    (bad notFound404 $ Page $ PostNotFound pid)
    (ok . Page . ViewBlogPost)
    <$> site.readBlogPost pid

In this example we save the new blog post and read that post after saving to show it to the user.

As we can see the handlers follow the interfaces of the site. We just wrap data in the content.

View HTML pages

To render HTML pages we use blaze-html library. All we need to do is to define instances for all types that show up in the result of handlers.

The type Page is a container for our web site main template:

-- writes the template for main page
instance (ToMarkup a) => ToMarkup (Page a) where
  toMarkup (Page page) = siteTemplate (H.toMarkup page)

siteTemplate :: Html -> Html

Also we define ToMarkup instances for all elements in the site:

instance ToMarkup Greeting where
instance ToMarkup WritePost where
instance ToMarkup BlogPostView where
...

You can find the full code in the sources.

Internal state implementation

Our website server is ready to be launched. We only need to define the interfaces. You can find the implementation in the source code for the example. See the modules:

• Init - initializes the interface
• Content - contains run-time mock data
• Internal.State - mutable state to save blog posts in memory

Summary

We have learned how to build HTML-based servers. It goes almost the same as with JSON applications only we have some twists regarding static files.

HTML goodies

In this chapter we will explore several techniques that make development of the servers that serve HTML a bit more pleasant.

We will study how to:

• use cookies
• create type-safe stable URLs
• use templates to render HTML-code

Cookies

A cookie is a special HTTP-header that asks the browser to save some information in local store so that it can be accessed in the sequence of requests. Often cookies are used to identify the logged in users and keep their sessions without the need to re-login. For great in-depth explanation of the cookies you can read this article.

How to save a cookie in the local storage

We can ask the browser to set the cookie with a function:

setCookie :: (ToForm cookie, IsResp resp) => SetCookie cookie -> resp -> resp

We have a function to initialise basic cookies:

-- | Create a cookie from content with default settings
defCookie :: a -> SetCookie a

The auxiliary parameters let us specify expiration time and other useful parameters that control cookie life-cycle (see the type SetCookie for details). Note that the cookie should be an instance of ToForm class. It's easy to derive the instance with generics:

data MyCookie = MyCookie
  { token        :: Text
  , secretNumber :: Int
  } deriving (Generic, ToForm, FromForm)

We need FromForm instance to read the cookie.

How to read the cookies

The cookie is just an HTTP-Header with special name. To fetch the cookie on request we have a special input newtype-wrapper:

newtype Cookie = Cookie (Maybe a)

And we can use it just as any other input (like query parameter or capture) in the argument list of a handler function:

import Data.Text qualified as Text
...

showCookieHandler :: Cookie MyCookie -> Get IO (Resp Html Text)
showCookieHandler (Cookie mValue) = 
  pure $ ok $ case mValue of
    Just value -> cookieToText value
    Nothing -> "No cookie is set"
  where
    cookieToText = 
      Text.unwords 
        [ "The cookie is:"
        , fromString $ show (value.token, value.secretNumber)
        ]

Note that value of cookie is optional (wrapped in Maybe) as often on the first visit to page no cookie is set.

Type-safe stable URLs

In the previous chapter we have discussed HTML-example of prototype for a blog-post site. And while rendering page data to HTML we typed links to pages as text constants. For example:

    menu = do
      H.div $ do
        H.img H.! HA.src "/static/haskell-logo.png" H.! HA.alt "blog logo" H.! HA.width "100pt" H.! HA.style "margin-bottom: 15pt"
        H.ul H.! HA.style "list-style: none" $ do
          item "/index.html" "main page"
          item "/blog/read/post" "next post"
          item "/blog/read/quote" "next quote"
          item "/blog/write" "write new post"
          item "/blog/list" "list all posts"

    item ref name =
      H.li $ H.a H.! HA.href ref $ H.text name

This code is fragile because we can change the name of some path in the server definition and forget to update it in the View-functions.

To make it a bit more stable the safe URLs are introduced. Let's start explanation with most basic type Url:

-- | Url-template type.
data Url = Url
  { path :: Path
  -- ^ relative path
  , queries :: [(Text, Text)]
  -- ^ queries in the URL
  , captures :: Map Text Text
  -- ^ map of captures
  }

It encodes the typical URL. It has static part and two containers for query and capture parameters.

There is a class ToUrl that let us derive proper URL correspondence for a give server definition.

Let's explain it on hello-world server. It has two routes:

-- | The server definition
server :: Server IO
server = 
  "api/v1" /. 
    [ "hello" /. hello
    , "bye" /. bye
    ]

-- | The handler definition as a function
hello :: Get (Resp Text)

-- | The handler with a query parameter to ask for the user name
bye :: Query "user" Text -> Get (Resp Text)

This example is for JSON server but let's pretend that it is an HTML-server and we would like to generate URL's from server definition for our handlers. To do it first we will rewrite the definition a bit. We will place the handlers to a record and create similar record for URLs. This is not strictly necessary but it will make our code more structured. Also we will create type synonyms for handler's type-signatures:

type HelloRoute = Get (Resp Text)
type ByeRoute = Query "user" Text -> Get (Resp Text)

data Routes = Routes
  { hello :: HelloRoute
  , bye :: ByeRoute
  }

-- | The server definition
server :: Server IO
server routes = 
  "api/v1" /. 
    [ "hello" /. routes.hello
    , "bye" /. routes.bye
    ]

Let's define the URLs:

data Urls = Urls
  { hello :: UrlOf HelloRoute
  , bye :: UrlOf ByeRoute
  }

It resembles the handlers code only we use prefix UrlOf. This is a type-level function that knows which URL-creation function corresponds to handler.

For a static route with no arguments it will produce just constant Url. But for a route with arguments the result URL also is going to depend on those arguments in case that input is either Query, Optional, QueryFlag or Capture. All those inputs affect the look of the resulting URL.

For example for ByeRoute we get the type:

Query "user" Text -> Url

Let's link URLs to the server definition:

urls :: Urls
urls = Urls{..}
  where
    hello
      :| bye = toUrl (server undefined)

Here we use extension RecordWildCards to automatically assign proper fields by name from the where expression. Also one new thing is :|-operator. It is a suffix synonym for ordinary pair type:

data (:|) a b = a :| b

It let us bind to as many outputs as we like without the need for parens:

  where
    a :| b :| c :| d = toUrl (server undefined)

But we should be cautious to use so many routes as there are in the server definition. URL's are matched against the server definition in the same order as they appear in the server definition. In this way we get stable names for URL handles.

To use URL in the HTML we can use the function:

renderUrl :: (IsString a) => Url -> a

Which can convert it to any string-like type. It's compatible with blaze-html and we can use it as an argument for href attribute in the html link constructor.

We have to be careful on the order of URL's in the definition and make sure that they match with the order in the server. If inputs are incompatible a run-time error is produced on the call to the link.

The great part of it is that query or capture arguments are preserved in the URL constructors. And the proper corresponding URL text will be generated from arguments.

How to use HTML-templates

In the previous examples we wrote HTML view code with blaze-html DSL. The HTML construction is a Haskell function in this style. But often it is desirable to write HTML with the holes in it. So that holes can be substituted with values at run-time. Those files are called templates. Often templates are written by Web-designers.

In this section we will study how to use mustache templates with mig library. The mustache is a very simple and popular templating engine. For Haskell we have a great library stache that makes it easy to use mustache templates in the Haskell.

I recommend to read the tutorial on how to use the library.

Overview of the mustache

The main idea of the templates is very simple. The arguments are marked with double curly braces:

Hello {{name}}!
Nice to meet you in the {{place}}.

This template expects a JSON input to be completed with two fields:

{
  "name": "John",
  "place": "Garden"
}

Also we can render lists of things with special syntax:

Items:

{{#items}}
  * [name](ref) 
{{/items}}

It expects a JSON object:

{
  "items":
     [ { "name": "foo", "ref": "http://foo.com" }
     , { "name": "bar", "ref": "http://bar.com" }
     ]
}

As we can see it's format-agnostic and can work for any text. For HTML there are special marks that let us prevent escaping of HTML special symbols:

{{{content}}}

Triple curly braces mean that we do not need escaping of special symbols and HTML code is trusted and inlined directly. This type of input is often useful for the template for the main page where we define header, footer, menus and we have a single place for the main content of the page which is inlined as plain HTML. Without tripling of the braces w the HTML code will be rendered as text.

How to load templates

To load templates we can use the normal functions from the stache library. For this example we will inline them at compile-time in the code:

import Text.Mustache
import Text.Mustache.Compile.TH qualified as TH

mainTemplate :: Template
mainTemplate = $(TH.compileMustacheFile "HtmlTemplate/templates/main.html")

We need TemplateHaskell language extension activated for that. Also we include the directory with templates in our cabal file as extra-source-files:

extra-source-files:
    HtmlTemplate/templates/main.html
    HtmlTemplate/templates/post.html
    HtmlTemplate/templates/postNotFound.html

By the way all the code is taken from example in the mig repo called HtmlTemplate.

After we have loaded the templates we can apply them with JSON values. We get the data from the handler and convert it to HTML with templates. We will make a helper function for that:

import Text.Mustache
import Text.Blaze.Html.Renderer.Text qualified as H
import Text.Blaze.Html5 qualified as H
...

renderMustacheHtml :: (ToJSON a) => Template -> a -> Html
renderMustacheHtml template value =
  H.preEscapedLazyText $ renderMustache template (toJSON value)

It applies templates to JSON-like values. Let's look at the simple example:

-- Rendering of a single quote
instance ToMarkup Quote where
  toMarkup quote = renderMustacheHtml templates.quote quote

The template templates.quote is applied to value quote of the type:

-- | A quote
data Quote = Quote
  { content :: Text
  }
  deriving (Generic, ToJSON)

Note the deriving of ToJSON to make it convertible to JSON. Let's look at the template.quote. It is defined in the file HtmlTemplate/templates/quote.html:

<div> <h2> Quote of the day: </h2> </div>
<div> <p> {{content}} </p> </div>

So it has one argument content and exactly that is produced from Quote value as JSON.

Rendering links

Often we would like to render links in the HTML and they have the same structure with two arguments href and name. Also we can use stable URl's as links which we have just studied. For that the helper type was created:

data Link = Link
  { href :: Url
  , name :: Text
  }
  deriving (Generic, ToJSON)

It's convenient to use it with mustache templates. We can define template:

<a href="{{href}}">{{name}}</a> 

And apply the value of the Link type to it.

For example let's look at the template that lists all available blog-posts:

<div> 
  <h2> Posts: </h2>
  <ul>
    {{#posts}}
    <li>
      <a href="{{href}}"> {{name}} </a>
    </li>
    {{/posts}}
  </ul>
</div>

It expects a JSON object:

{
  "posts":
     [ { "href": "foo", "name": "foo" }
     , { "href": "bar", "name": "bar" }
     ]
}

And for that we have a Haskell type that matches this definition:

-- | List all posts
newtype ListPosts = ListPosts [BlogPostLink]

To render it we only need to add top level object with "post"-field.

-- | Rendering of all submited posts
instance ToMarkup ListPosts where
  toMarkup (ListPosts posts) = 
    renderMustacheHtml templates.listPosts $ toPostLinks posts

toPostLinks :: [BlogPostLink] -> Json.Value
toPostLinks posts =
  Json.object ["posts" Json..= fmap toLink posts]
  where
    toLink :: BlogPostLink -> Link
    toLink post =
      Link
        { href = urls.blogPost (Optional $ Just post.blogPostId)
        , name = post.title
        }

Note how we use the URL constructor as a function.

Other template engines

We are not limited with mustache for templates. The Haskell has many great templating libraries which also can be used like shakespeare or heist and many others.

I've chosen stache as it ports very widespread and simple solution mustache to Haskell. But other template engines can be used in the same way. The mig library is not tied to any of those libraries. Although I've tried stache and highly recommend it. It's easy to use and versatile.

Summary

We have studied several features that can make HTML-servers more easy to build.

• We have discussed how to work with cookies
• How to create stable type-safe URLs
• How to use template engine stache (aka mustache) for our sites and make HTML-pages friendly for WEB-designers.

You can study the source code of the example HtmlTemplate in the mig repo to see how those concepts are used in action.

Clients

We can define HTTP-clients from the same definition as servers. Let's start with hello world example.

The server code is:

module Main (main) where

import Mig

main :: IO ()
main = do
  putStrLn $ "Server starts on port: " <> show port
  runServer port server
  where
    port = 8085

server :: Server IO
server = "api/v1/hello" /. hello

hello :: Get IO (Resp Json Text)
hello = Send $ pure $ ok "Hello World!"

To turn that into server we use the class ToClient:

class ToClient a where
   -- | converts to client function
   toClient :: Server m -> a

   -- | how many routes client has
   clientArity :: Int

It can convert the Server definition to a client. The client relies on special monad Client, which we can run with function:

runClient :: ClientConfig -> Client a -> IO (RespOr AnyMedia BL.ByteString a)

-- | Config to run the clients
data ClientConfig = ClientConfig
  { port :: Int
  -- ^ port to connect to
  , manager :: Http.Manager
  -- ^ HTTP-manager
  }

To share code between server and client we should slightly modify our server code and introduce a type synonym for the type of the route:

type Hello m = Get m (Resp Json Text)

server :: Hello m -> Server m
server handler = "api/v1/hello" /. handler

hello :: Hello IO
hello = Send $ pure $ ok "Hello World!"

Our server also becomes generic in it's monad type. If we want to create a server we can apply the handler function to server:

helloServer :: Server IO
helloServer = (server hello)

To define a client we use monad Client as parameter and get server definition with toClient method:

helloClient :: Hello Client
helloClient = server helloClient

We need to provide some argument to the server function and here we use recursive definition we pass the result back to the argument. This code is ok because we do not need the implementation of the server in the toClient function. We rely solely on the type signature and path to the handler. Which is specified in the server function the route handler is never touched by the execution path. So it is ok to use recursive definition. We can also pass undefined.

After that we can call a client function:

import Data.ByteString.Lazy qualified as BL
import Mig
import Mig.Client
import Network.HTTP.Client qualified as Http -- from http-client library

main :: IO ()
main = do
  config <- ClientConfig port <$> Http.newManager Http.defaultManagerSettings
  print =<< runHello config
  where
    port = 8085

-- | Make it convenient to use
runHello :: ClientConfig -> IO (Either BL.ByteString Text)
runHello config = getRespOrValue <$> runClient config hello

We use function to get result:

getRespOrValue :: RespOr media BL.ByteString a -> Either BL.ByteString a

Several routes

If we have several routes we can use tuples in the result or special combinator :|. Let's create a client for Counter example. Let's recall how server is defined:

{-| Server has two routes:

* get - to querry current state
* put - to add some integer to the state
-}
server :: Server App
server =
  "counter"
    /. [ "get" /. handleGet
       , "put" /. handlePut
       ]


handleGet :: Get App (Resp Int)
handlePut :: Capture "arg" Int -> Get App (Resp ())

Let's parametrize by the monad type to share the code:

-- | Routes for the server
data Routes m = Routes
  { get :: Get m (Resp Int)
  , put :: Capture "args" Int -> Post m (Resp ())
  }

server :: Routes m -> Server m
server routes =
  "counter"
    /. [ "get" /. routes.get
       , "put" /. routes.put
       ]

We can define a server by applying routes:

counterServer :: Server IO
counterServer = server (Routes handleGet handlePut)

To create client we use ToClient class again:

counterClient :: Routes Client
counterClient = Routes getClient putClient
  where
    getClient :| putClient = toClient (server counterClient)

We use recursive definition to tie the knot and provide dummy functions to get the server.

The :| combinator is just a convenient synonym for pair (,). It can be handy if we have arbitrary number of the routes:

routeA
:| routeB
:| routeC
:| routeD
... = toClient

Here we rely on the Haskell ability to pattern match on the constructors. In Haskell we can use not only single variables on the left side but also we can use a constructor. So this is a valid Haskell expression:

ints :: [Int]
strings :: [String]

(ints, strings) = unzip [(1,"a"), (2, "b")]

The same trick is used to specify several routes at once:

  where
    getClient :| putClient = toClient (server counterClient)

The method toClient by the output type knows how many routes to fetch from server definition with the help of clientArity method. Also we can write this definition with just a tuple:

  where
    (getClient, putClient) = toClient (server counterClient)

FromClient class

Often we do not need the request input wrappers on the level of Http-client. We would like to get the function:

putClient :: Int -> IO (Either ByteString ())

Instead of

putClient :: Capture "arg" Int -> IO (Either ByteString ())

For that we have a class which can strip away all newtype wrappers:

class FromClient a where
  type ClientResult a :: Type
  fromClient :: a -> ClientResult a

Associated class ClientResult can map from wrapped version to unwrapped one. We can use it simplify client functions after transformation:

-- defined in the library
newtype Client' a = Client' (ReaderT ClientConfig IO a)

type ClientOr a = Client' (Either BL.ByteString a)

-- our client functions:

runGet :: ClientOr Int
runGet = getRespOrValue <$> fromClient getClient

runPut :: Int -> ClientOr ()
runPut = getRespOrValue <$> fromClient putClient

We use special variant of client monad which encapsulates ClientConfig in the reader. We can run the client' with function:

runClient' :: ClientConfig -> Client' a -> IO a

So with FromClass we can unwrap all newtype arguments from wrappers and get ClientConfig encapsulated in the reader monad.

The structure of the client

So let's recap. To define a client we make server definition generic in the underlying monad and usually introduce a data structure for the routes:

data Routes m = Routes
  { auth :: Auth m
  , getBlogPost :: GetBlogPost m
  , writeBlogPost :: WriteBlogPost m
  }

server :: Routes m -> Server m
server routes = ...

Also it's good to create the type synonyms for routes so that we do not need to retype them twice for servers and clients.

After that we can use ToClient class to convert server to client:

appClient :: Routes Client
appClient = Routes {..}
  auth :| getBlogPost :| writeBlogPost = toClient $ toClient appClient

When we got the client we can simplify definition by stripping away all newtype-wrappers:

runAuth :: Arg1 -> Arg2 -> ClientOr AuthId
runAuth arg1 arg2 = getRespOrValue <$> fromClient appClient.auth arg1 arg2

runGetBlogPost :: Arg1 -> ClientOr BlogPost
runGetBlogPost arg1 = getRespOrValue <$> fromClient appClient.getBlogPost arg1

...

Examples of the clients

You can find examples of the clients in the examples directory of the mig repo. There are several examples:

• HelloClient - basic hello world client
• RouteArgsClient - client with many routes and all sorts of inputs
• CounterClient - how to build client and server from the same code

Reference

Here is the list of main functions, types and classes

How to build server

-- server on path
(/.) :: ToServer a => Path -> a -> Server (MonadOf m)

-- alternative cases for server:
mconcat, (<>)

-- | take sub-server at path
atPath :: Path -> Server m -> Server m

toServer :: ToServer a => a -> Server (MonadOf m)

How to run server

runServer :: Int -> Server IO -> IO ()

runServer' :: ServerConfig -> Int -> Server IO -> IO ()

Server presets

• Mig - generic types
• Mig.IO - IO-based servers with generic return types
• Mig.Json - JSON-based servers
• Mig.Html - HTML-based servers
• Mig.Json.IO - JSON and IO-based servers
• Mig.Html.IO - HTML and IO-based servers

Media types

* Json
* Text
* Html
* FormUrlEncoded
* AnyMedia
* OctetStream

Request inputs

-- required query parameter
newtype Body media value = Body value

-- required query parameter
newtype Query name value = Query value

-- optional query parameter
newtype Optional name value = Optional (Maybe value)

-- required header parameter
newtype Header name value = Header value

-- optional header parameter
newtype OptionalHeader name value = OptionalHeader (Maybe value)

-- capture in path parameter
newtype Capture name value = Capture value

-- boolean query flag parameter
newtype QueryFlag name = QueryFlag Bool

-- optional cookies (set in the header)
newtype Cookie value = Cookie (Maybe value)

-- Is connection made over SSL
newtype IsSecure = IsSecure Bool

-- full path with query parameters
newtype PathInfo = Path [Text]

-- | low-level request
newtype RawRequest = RawRequest Request

Request outputs

-- | generic route handler
newtype Send method m a = Send (m a)

-- Sepcific methos
type Get m a = Send GET m a
type Post m a = Send POST m a
...

-- Response where type of the value and error are the same
-- or only succesful result is expected
data Resp media a = Resp ...

-- Response where error and result have different types but media type is the same
data RespOr media err a = RespOr ...

The response type class:

class IsResp a where
  -- | the type of response body value
  type RespBody a :: Type

  -- | the type of an error
  type RespError a :: Type

  -- | Returns valid repsonse with 200 status
  ok :: RespBody a -> a

  -- | Returns an error with given status
  bad :: Status -> RespError a -> a

  -- | response with no content
  noContent :: Status -> a

  -- | Add some header to the response
  addHeaders :: ResponseHeaders -> a -> a

  -- | Sets repsonse status
  setStatus :: Status -> a -> a

  -- | Set the media type of the response
  setMedia :: MediaType -> a -> a

  -- | Reads the media type by response type
  getMedia :: MediaType

  -- | Converts value to low-level response
  toResponse :: a -> Response

setHeader :: (IsResp a, ToHttpApiData h) => HeaderName -> h -> a -> a

-- | Set cookie as http header from form url encoded value
setCookie :: (ToForm cookie, IsResp resp) => SetCookie cookie -> resp -> resp

data SetCookie a = SetCookie
  { cookie :: a
  , expires :: Maybe UTCTime
  , domain :: Maybe Text
  , path :: Maybe Text
  , secure :: Bool
  , httpOnly :: Bool
  }

-- | Default cookie which sets only the cookie itself.
defCookie :: a -> SetCookie a

-- | Bad request. The @bad@ response with 400 status.
badReq :: (IsResp a) => RespError a -> a

-- | Internal server error. The @bad@ response with 500 status.
internalServerError :: (IsResp a) => RespError a -> a

-- | Not implemented route. The @bad@ response with 501 status.
notImplemented :: (IsResp a) => RespError a -> a

-- | Redirect to url. It is @bad@ response with 302 status 
-- and set header of "Location" to a given URL.
redirect :: (IsResp a) => Text -> a

Plugins

applyPlugin, ($:) :: ToPlugin a => 
  a -> Server (MonadOf a) -> Server (MonadOf a)

-- composition of plugins:
Monoid(..): mconcat, (<>), mempty

specific servers

-- | add wagger to server
withSwagger :: SwaggerConfig m -> Server m -> Server m

-- | add link from one route to another
addPathLink :: Path -> Path -> Server m

-- static files
staticFiles :: [(FilePath, ByteString)] -> Server m

specific plugins

-- prepend or append some acction to all routes
prependServerAction, appendServerAction :: MonadIO m => m () -> Plugin m

-- change the response
processResponse :: (m (Maybe Response) -> m (Maybe Response)) -> Plugin m

-- only secure routes are allowed
whenSecure :: forall m. (MonadIO m) => Plugin m

-- logging with putStrLn for debug traces
logHttp :: Verbosity -> Plugin m

-- logging with custom logger
logHttpBy :: (Json.Value -> m ()) -> Verbosity -> Plugin m

-- | simple authorization
withHeaderAuth :: WithHeaderAuth -> Plugin m

How to use Reader

-- Derive instance of HasServer class for your Reader-IO based application:
newtype App a = App (ReaderT Env IO a)
  deriving newtype (Functor, Applicative, Monad, MonadReader Env, MonadIO, HasServer)

renderServer :: Server App -> Env -> IO (Server IO)

OpenApi and Swagger

-- | Get OpenApi
toOpenApi :: Server m -> OpenApi

-- add swagger to server
withSwagger :: SwaggerConfig m -> Server m -> Server m

-- create swagger server
swagger :: SwaggerConfig m -> m OpenApi -> Server m

-- | Print OpenApi schema
printOpenApi :: Server m -> IO ()

-- | Writes openapi schema to file
writeOpenApi :: FilePath -> Server m -> IO ()

The Swagger config:

-- | Swagger config
data SwaggerConfig m = SwaggerConfig
  { staticDir :: Path
  -- ^ path to server swagger (default is "/swagger-ui")
  , swaggerFile :: Path
  -- ^ swagger file name (default is "swaggger.json")
  , mapSchema :: OpenApi -> m OpenApi
  -- ^ apply transformation to OpenApi schema on serving OpenApi schema.
  -- it is useful to add additional info or set current date in the examples
  -- or apply any real-time transformation.
  }

instance (Applicative m) => Default (SwaggerConfig m) where
  def =
    SwaggerConfig
      { staticDir = "swagger-ui"
      , swaggerFile = "swagger.json"
      , mapSchema = pure
      }

Set swagger title and description:

-- | Default info that is often added to OpenApi schema
data DefaultInfo = DefaultInfo
  { title :: Text
  , description :: Text
  , version :: Text
  }

-- adds default info, use it in the mapSwagger field of SwaggerConfig record
addDefaultInfo :: DefaultInfo -> OpenApi -> OpenApi

Describe routes with swagger:

-- | Sets description of the route
setDescription :: Text -> Server m -> Server m

-- | Sets summary of the route
setSummary :: Text -> Server m -> Server m

-- | Adds OpenApi tag to the route
addTag :: Text -> Server m -> Server m

{-| Appends descriptiton for the inputs. It passes pairs for @(input-name, input-description)@.
special name request-body is dedicated to request body input
nd raw-input is dedicated to raw input
-}
describeInputs :: [(Text, Text)] -> Server m -> Server m

Clients

The class to convert server definitions to clients:

class (MapRequest a) => ToClient a where
  -- | converts to client function
  toClient :: Server m -> a

  -- | how many routes client has
  clientArity :: Int

An example:

helloWorld :: Get Client (Resp Text)
handleSucc :: Header "Trace-Id" TraceId -> Query "value" Int -> Get Client (Resp Int)
handleSuccOpt :: Optional "value" Int -> Get Client (RespOr Text Int)

helloWorld
  :| handleSucc
  :| handleSuccOpt = toClient server

We use synonym for pair :| to avoid redundant parens.

The Client-monad:

newtype Client a = ...

runClient :: ClientConfig -> Client a -> IO (RespOr AnyMedia BL.ByteString a)

-- | Config to run the clients
data ClientConfig = ClientConfig
  { port :: Int
  -- ^ port to connect to
  , manager :: Http.Manager
  -- ^ HTTP-manager
  }

The class to strip away request input newtype wrappers:

class FromClient a where
  type ClientResult a :: Type
  fromClient :: a -> ClientResult a

It turns types like:

Query "a" Int -> Capture "b" Text -> Get Client (Resp Json Text)

To types:

Int -> Text -> Client' (RespOr Json BL.ByteString Text)

Where Client' is a monad which encapsulates the ClientConfig as reader:

newtype Client' a = Client' (ReaderT ClientConfig IO a)

Also we can use the function:

getRespOrValue :: RespOr media BL.ByteString a -> Either BL.ByteString a

To unwrap Resp from response.

Other utilities

Type-safe URLs

The type-level function UrlOf creates a type-safe Url for a given route handler type. With class ToUrl we can generate the URLs for a collection of handlers.

class ToUrl a where
  toUrl :: Server m -> a
  mapUrl :: (Url -> Url) -> a -> a
  urlArity :: Int

An example of usage. URL's should be listed in the same order as they appear in the server

urls :: Urls
urls = Urls{..}
   where
     greeting
       :| blogPost
       :| listPosts
         toUrl (server undefined)

We can render Url to String-like type with function:

renderUrl :: IsString a => Url -> a

deriving helpers

Sometimes we need to derive too many types at once to use the type in the library. There are helpers to reduce deriving boiler-plate:

deriveParam ''FooType          -- derives parameter instances for a FooType
deriveNewtypeParam ''FooType   -- derives parameter instances for a newtype FooType

deriveBody ''FooType          -- derives request body instances for a FooType
deriveNewtypeBody ''FooType   -- derives request body instances for a newtype FooType

deriveHttp ''FooType          -- derives both parameter and request body instances for a FooType
deriveNewtypeHttp ''FooType   -- derives both parameterrequest body instances for a newtype FooType

mapDerive fun [''Foo, ''Bar]  -- maps deriving over several types

We need to activate TemplateHaskell, StandaloneDeriving, DerivingStrategies, DeriveGeneric extensions to use it.

Also note that for this to work all types should be in scope. So it better to define drivings at the bottom of the module which is dedicated to types.

Also type should not have generic arguments for deriving to work. If it does we have to declare the types manually. For example:

data Timed a = Timed
  { from :: Day
  , content :: [a]
  }
  deriving (Generic, ToJSON, FromJSON)

deriving instance (ToSchema a) => ToSchema (Timed a)

The data type Timed has an argument and we have to define the instance explicitly.

HTML Links

For usage with template engines that expect JSON as argument for template there is the type Link in the module Mig.Extra.Html (also re-exported by all Html-related modules):

data Link = Link
  { href :: Url
  , name :: Text
  }
  deriving (Generic, ToJSON)

Also it has ToMarkup instance and rendered as a-element link.

How to contribute

If you are interested in contribution to library that's great. We have a list of upcoming features in the list of Issues.

Also there is a CI which checks for:

• build and test of all libraries with stack
• build and test of all examples in the directory examples with stack
• fourmolu formatting
• deploy of docs/tutorial to github pages (on push to main branch)

how to automate formatter check

To check for formatting I recommend to use this pre-commit hook:

#!/bin/bash
 
if command -v fourmolu &> /dev/null
then
  files=$(git diff --staged --name-only -- '*.hs')
  for file in $files
  do
    fourmolu -i $file
    git add $file
  done
else
  echo "fourmolu cannot be found"
  echo "install fourmolu via cabal install"
fi

Save this as file .git/hooks/pre-commit in your repo and make it executable:

chmod +x .git/hooks/pre-commit

The script requires fourmolu executable which both can be installed from Hackage.

After that all files that you modify will be formatted properly. Formatting settings are in the file fourmolu.yaml.