Intro to HAppS Part 1

Update: A demo of the finished application is now available. See this post for more information.

This post is the first in a series outlining the process I am taking to get a basic stateful web application working with the Haskell web framework HAppS. There is very little documentation available for versions of HAppS after 0.8.8. While this is not documentation, it should aid in getting an idea of how HAppS manages state. The code in these posts should work with HAppS 0.9.2.

For this application, we'll focus on the basic capabilities needed for user creation, authentication, and session management. The first thing we need is a form for logging in or creating a new user, and two URLs to handle the submission of these forms. Well use /login for the form, and we'll have the login form POST to the same place. The registration form will POST to /newuser. All other pages will return an error. Here is the basic HAppS code to do that:

impl = [ dir "login" [methodSP GET $ (fileServe ["login.html"] ".")
                     ,methodSP POST $ withDataFn fromLoginRequest processLogin]
       , dir "newuser" [methodSP POST $ withData processNewUser]
       , anyRequest $ ok $ toResponse "Sorry, couldn't find a matching handler"]

main = do simpleHTTP nullConf impl

simpleHTTP is passed a configuration parameter and a list of ServerPartT that specify the behavior for URLs.

The first dir says that a GET to the /login URL will display the login.html file that we have stored in the current directory. It also specifies that a POST to the same URL will result in a call to processLogin. The second dir says that a POST to /newuser will be handled by the processNewUser function.

withDataFn is a HAppS function that takes two functions as parameters. In this example, fromLoginRequest reads from the request data in the reader monad and produces a data structure that is then passed to processLogin. processLogin then uses this data to generate a ServerPartT that produces a response.

withData is similar to withDataFn, but it doesn't require the first function to read the request. It requires that processNewUser accept one parameter of type FromData. FromData is just a type class that defines a fromData function that builds the appropriate data type from the Reader monad.

The astute reader might notice that after the appropriate definition of the FromData type class, withData can simply be defined as:

withData = withDataFn fromData

Here is the code for the functions used by withData and withDataFn:

data NewUserInfo = NewUserInfo String String String

instance FromData NewUserInfo where
    fromData = liftM3 NewUserInfo
      (look "username")
      (look "password" `mplus` return "nopassword")
      (look "password2" `mplus` return "nopassword2")

processNewUser (NewUserInfo user pass1 pass2)
  | pass1 == pass2 =
    [anyRequest $ ok $ toResponse $ "NewUserInfo: " ++ show (user,pass1,pass2)]
  | otherwise = [anyRequest $ ok $ toResponse $ "Passwords did not match"]

fromLoginRequest = do a <- look "username" `mplus` return "nouser"
                      b <- look "password" `mplus` return "nopassword"
                      return (a,b)

processLogin (u,p) =
  [anyRequest $ ok $ toResponse $ "User logged in with: " ++ show (u,p)]

The processNewUser and processLogin functions both create [ServerPartT] that defines the appropriate responses. processNewUser also does a check to make sure the two passwords match. This could easily be done on the client side, but it still can't hurt to verify it on the server as well.

The differences between these two functions is in the type of parameters they accept. processNewUser takes a NewUserInfo which knows how to build itself from the request reader. The fromData function for NewUserInfo uses look to get the form data from the request. fromLoginRequest does the same thing to retrieve its form data, but returns a tuple that can be passed to processLogin.

Here is the final code to our basic HAppS application. The HTML in login.html is left as an exercise to the reader.

module Main where

import Control.Monad
import HAppS.Server

data NewUserInfo = NewUserInfo String String String

instance FromData NewUserInfo where
    fromData = liftM3 NewUserInfo
      (look "username")
      (look "password" `mplus` return "nopassword")
      (look "password2" `mplus` return "nopassword2")

processNewUser (NewUserInfo user pass1 pass2)
  | pass1 == pass2 =
    [anyRequest $ ok $ toResponse $ "NewUserInfo: " ++ show (user,pass1,pass2)]
  | otherwise = [anyRequest $ ok $ toResponse $ "Passwords did not match"]

fromLoginRequest = do a <- look "username" `mplus` return "nouser"
                      b <- look "password" `mplus` return "nopassword"
                      return (a,b)

processLogin (u,p) =
  [anyRequest $ ok $ toResponse $ "User logged in with: " ++ show (u,p)]
  
impl = [ dir "login" [methodSP GET $ (fileServe ["login.html"] ".")
                     ,methodSP POST $ withDataFn fromLoginRequest processLogin]
       , dir "newuser" [methodSP POST $ withData processNewUser]
       , anyRequest $ ok $ toResponse "Sorry, couldn't find a matching handler"]

main = do simpleHTTP nullConf impl