Wednesday, April 8, 2009

Adding Authentication to the Blog App

In the last post, we developed a very basic blog application using Happstack. Now that we have a simple application without an authentication mechanism, let's see how much effort it takes to add authentication using the Happstack-Auth module mentioned here. First let's make an outline of what needs to be done. We need the following pieces of functionality:
  • Pages for login/registration
  • Routines to handle the POSTed form data from the above
  • A page to log the user out
  • Blog posts should contain the name of the author
  • Only authenticated users should be able to create new posts.
The first thing we have to do is import the auth module.
> import Happstack.Auth
Let's start by looking at the first three bullets of functionaliy mentioned above. I'll implement the login/registration pages in pretty much the same way they were implemented in my old posts. A single login.html file will have a form for both registration and login. This suggests the following code block:
>  , dir "newuser" $ methodSP POST $ newUserHandler exists noMatch regGood
>  , dir "login" $ withSession (\_ -> redir "/") $
>      msum [methodSP GET $ (fileServe ["login.html"] ".")
>           ,methodSP POST $ loginHandler loginGood loginBad]
>  , dir "logout" $ logoutHandler $ redir "/"
These server parts get added to the list we already started in the impl function. The newuser line introduces newUserHandler from our auth library. It returns the first parameter if the user already exists or the username is invalid, the second parameter if the two passwords did not match, and the third parameter if the registration was good and the user was created. In this case, the user is also automatically logged in. newUserHandler requires three form fields with the names "username", "password", and "password2". It even takes care of sanitizing the username field to make sure this doesn't happen to you. If you need more fine-grained control over your user registration process, the auth library provides other functions to facilitate this. I won't describe them in detail here. Read the code. The login lines introduce two functions provided by the auth library. They are withSession and loginHandler. Here is the type signature for withSession:
withSession :: (MonadIO m)
            => (SessionData -> ServerPartT m a)
            -> ServerPartT m a
            -> ServerPartT m a
The first parameter is a function that takes a SessionData and returns a ServerPartT. withSession takes care of the details involved in getting the session data, so all you have to do is supply a function that uses it. The second parameter is a ServerPartT that gets returned if the user is not currently logged in. This allows you to specify custom guest functionality. It could be a "401 unauthorized" response, or something else entirely. If the user is already logged in, we simply skip the login page and redircect to root. If the user is not logged in, then we have two server parts to handle GET and POST. On a GET we just return the contents of login.html. On a POST, we need to handle the form data. loginHandler is provided to take care of all these details. Its first two arguments are ServerPartTs that will be returned on good login and bad login respectively. loginHandler requires that your form contain fields named "username" and "password". The logout line calls upon the logoutHandler function to take care of the details of logging out. All you have to do is pass it something to return afterwards. In this case we just redirect the user to the root page. Now we need to define the functions we just used.
> loginGood = redir "/new"
> loginBad = ok $ toResponse $ "Invalid login"
> exists = anyRequest $ ok $ toResponse $ "Username was invalid or already exists."
> noMatch = anyRequest $ ok $ toResponse $ "Passwords did not match"
> regGood = redir "/new"
If the user successfully logged in, we assume that they are logging in so they can create a new blog post and redirect them to "/new". Otherwise we return an invalid login page. We define a couple generic error message pages for the previously mentioned registration errors, and if their registration is good, we redirect to "/new" just like on a good login. Everything we've done so far has been new functionality. We might have been able to have the auth framework abstract it a little more and require us to write less code, but for the most part the functionality we have written is unique to the layout and design choices made by our site. Now we need to go back and modify our existing functionality to give it an awareness of users. First, we add an item to our Post data type to store the author of the post. We want to use the Username type defined by the auth library since that's how it will be available to us.
>   postAuthor :: Username,
Since we're changing the Post data constructor, we will have to make a corresponding change in addPostHandler. But addPostHandler doesn't know what username to use. This is an ideal place to call upon the withSession function that we've already seen. We just add one parameter to addPostHandler representing the current session. Here is the new function (only the first and third lines changed):
> addPostHandler ses = do
>   (Just title) <- getDataFn $ look "title"
>   (Just body) <- getDataFn $ look "body"
>   update $ AddPost (Post title (sesUsername ses) body)
>   redir "/"
We need to modify the part of impl that handles new pages by adding withSession and an action to take when the user is not logged in. If you're going to "/new" and you're not logged in, we'll just assume you want to log in and redirect you to "/login". This is complemented by the code we already wrote which redirects you to "/new" after login. Since our website is simple, this will provide a seamless flow when the user goes to "/new" without them needing to know about "/login".
> dir "new" $ withSession newPostHandlers (redir "/login")
This means that newPostHandlers has to accept the session data as a parameter and pass it to addPostHandler according to our above modifications.
> newPostHandlers ses = msum [methodSP GET $ fileServe ["new_post.html"] "."
>                            ,methodSP POST $ addPostHandler ses])
Finally, we have to tell Happstack that our application's state includes the state Component defined in another Happstack.Auth. All we have to do is add "AuthState :+: " to the BlogState dependencies.
>   type Dependencies BlogState = AuthState :+: End
And that's all there is to it. You still have to integrate your login pages with the rest of your site just like you normally would, but all the details of session management are nicely hidden away. You don't have to know about browser cookies or worry about generating session IDs. You don't have to worry about storing your user database or keeping track of open sessions. You don't have to understand how to build a secure password storage scheme. The library's password storage hasn't been vetted enough for me to call it secure, but it's already more secure than reddit's database once was. All this at the bargain price of 13 additional lines of code with simple modifications to 6 others. This auth library is a work in progress. It still needs a mechanism for cleaning up expired sessions, and could probably benefit from improved defense against session hijacking. I'm sure there are many other problems I haven't thought of. If you find this library useful, or have suggestions or any other comments, I'd love to hear them. The full source for this modified app is in github.

Tuesday, April 7, 2009

Basic Happstack Blog App

Happstack is improving, and my old blog posts on HAppS are now out of date. So we're in need of a bare-bones app to demonstrate functionality. I also wanted a simple app without authentication capability to demonstrate how to integrate Happstack-Auth into a project. Blog apps seem to be one of the canonical beginner's examples in the web framework world, so I thought that would be a good choice to start with. As usual, this post is literate haskell and should compile as Main.lhs.
> {-# OPTIONS -fglasgow-exts #-}
> {-# LANGUAGE TemplateHaskell , FlexibleInstances,
>              FlexibleContexts, UndecidableInstances, OverlappingInstances,
>              MultiParamTypeClasses, GeneralizedNewtypeDeriving #-}
> 
> module Main where
> 
> import Control.Concurrent
> import Control.Monad
> import Control.Monad.Reader
> import Control.Monad.State (modify,put,get,gets,MonadState)
> import Data.Generics hiding ((:+:))
> import Happstack.Server
> import Happstack.State
First, we define a blog post. A post has a title and a body, both of type String. The deriving clause is required by the Happstack state mechanism. The Ord instance isn't actually required for this example, but it is required if you want to build an IxSet from this data type, so I'm in the habit of including it.
> data Post = Post {
>   postTitle :: String,
>   postBody :: String
> } deriving (Read,Show,Ord,Eq,Typeable,Data)
Our top level blog state will be a simple list of posts.
> data BlogState = BlogState {
>   postDB :: [Post]
> } deriving (Read,Show,Ord,Eq,Typeable,Data)
These are the standard Version and Serialize instances needed by Happstack's state mechanism. I won't go into detail about them here. Jeremy Shaw has a nice post describing them in much more detail.
> instance Version Post
> $(deriveSerialize ''Post)
> instance Version BlogState
> $(deriveSerialize ''BlogState)
Our state has to be an instance of component. We have no dependencies and our state's initial value is a simple empty list.
> instance Component BlogState where
>   type Dependencies BlogState = End
>   initialValue = BlogState []
Now we need some accessor functions. For now we'll keep it simple with a function to add a post, and one to get the list of all posts.
> addPost :: (MonadState BlogState m) => Post -> m ()
> addPost p = modify $ (\s -> BlogState $ p:(postDB s))
>
> getPosts :: (MonadReader BlogState m) => m [Post]
> getPosts = asks postDB
Now the required Template Haskell voodoo to build these methods for us.
   
> $(mkMethods ''BlogState ['addPost, 'getPosts])
Before we go further I want to add a little infrastructure code that will simplify things later. It's a simple function that redirects the client to the specified URL.
> redir url = seeOther url (toResponse "")
New we define the layout of our site. We have one URL at "http://site.com/new". A GET request to this url returns a static HTML file containing a new post form. The form POSTS the results to the same URL, so we have to define a function to handle this request. The last "methodSP GET" matches the root URL "http://site.com/" and will just display the list of posts.
> impl = msum
>   [ dir "new" newPostHandlers 
>   , methodSP GET viewPostsHandler
>   ]
>
> newPostHandlers = msum [methodSP GET $ fileServe ["new_post.html"] "."
>                        ,methodSP POST addPostHandler]
The msum in newPostHandlers is new as of Happstack 0.2. In prior versions, some functions required or returned data of type ServerPartT, and some used [ServerPartT]. Other functions required WebT data. In Happstack 0.2, everything was unified to work around a single ServerPartT. If you have an abstraction that needs several ServerPartTs, you usually want to collapse them using msum. Our new post handler gets POSTed values from the HTTP request, constructs a Post, passes that to AddPost, and redirects to the root.
> addPostHandler = do
>   (Just title) <- getDataFn $ look "title"
>   (Just body) <- getDataFn $ look "body"
>   update $ AddPost (Post title body)
>   redir "/"
The view posts handler queries the GetPosts action for the list of posts. If the list is empty, it returns a simple message, otherwise it returns the posts as a string. toResponse converts strings into responses with a content type of text/plain. Generating proper HTML pages is not hard, but is beyond the scope of this example.
> viewPostsHandler = do
>   posts <- query $ GetPosts
>   case posts of
>     [] -> ok $ toResponse "No posts yet"
>     otherwise -> ok $ toResponse $ unlines $ map show posts
The rest of the code is standard infrastructure for a Happstack application. The only thing we have to do is declare an entry point with our state Component and pass it to startSystemState. Then we pass our previously defined impl function to simpleHTTP and we're done. A clean, working Happstack application in 75 lines of code.
> entryPoint :: Proxy BlogState
> entryPoint = Proxy
> 
> main = do 
>   control <- startSystemState entryPoint
>   tid <- forkIO $ simpleHTTP nullConf impl
>   waitForTermination
>   putStrLn "Shutting down..."
>   killThread tid
>   shutdownSystem control
>   putStrLn "Shutdown complete"
The code for this app is available in the Happstack-Auth github repository in the demos/Blog-NoAuth directory. In the next post I will show how to add authentication to this app using the auth framework I mentioned in the last post.

Monday, April 6, 2009

A Standalone Auth Framework for Happstack

It's been awhile since my series of posts outlining some of the basic ideas behind the HAppS Haskell web framework (which is since been renamed Happstack). Ever since I started developing it I envisioned a standalone library, perhaps shipped as a part of happstack, that would make it trivial for anyone to add robust authentication to their application. After doing some more work on Happs(tack) applications I've finally gotten around to working on the auth framework. I have created a github repository for the auth framework. It still needs a lot more work, but hopefully it will demonstrate some of the potential of Haskell and Happstack as a web development framework, and motivate some more improvement in this area. Comments, suggestions, or code contributions would be greatly apprectiated.