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.


kristofer said…
I can't cabal build your package..

Could not find module `Data.Generics':
it is a member of package base-, which is hidden

I imagine it's a problem with my haskell installation? Lemme know what you think. I can import Data.Generics in ghci, but it won't compile for some reason.
mightybyte said…
What OS and version of ghc are you using? You might try to catch me or someone else on the #happs IRC channel. A more interactive discussion will probably be easier.

Popular posts from this blog

Ember.js is driving me crazy

Dependent Types are a Runtime Maybe

Setting Up A Private Nix Cache