This post will explore a little bit of the creation of this site/blog on the Haskell Application Server (HAppS). You can check out their website, or the website for the language it is written in, Haskell, if you are curious why I might have chosen to use it, but the purpose of this post is more how than why. There is still little enough documentation on HAppS that it seems valuable to document part of this process.
First, to begin with, I didn’t start this from scratch, so if you are interested in following along, I would head over to a tutorial written by another person just starting out with HAppS, as most of what I’m going to be writing about builds upon that work. If you are impatient, and dont feel like working through the posts describing the process, you can get the complete working code for his tutorial (these links are on the last page of it) at http://hpaste.org/5957, http://hpaste.org/5958, and http://hpaste.org/5959 respectively. Once you have those, and have built and installed HAppS, you have a pretty significant system. You can add users, list all the users you have, log in as a user, and see a demo page to confirm that you are logged in. However, there are still a few things missing. First, you really need to be able to not only add users, but delete them as well. Secondly, we can log in, but we can’t yet log out. Finally, as a sort of minor point, I thought it would be helpful to limit the total number of users that could exist. If you are writing an application with a small number of users (say, for example, a blog), this is a sort of weak security, and is something that makes me a little more confident about using it. So for starters, let’s implement deleting users. We can do the other two tasks after. (for the astute readers, you’ll notice this code I pasted to hpaste at the links above. but reading it here, not only do you get the code, but hopefully an explanation too!)
Perhaps other people think differently, but I always make the changes to the data, and then gradually work back up to the interface. This means we will start with the file Session.hs, which has all the good information about the State of our application. Adding a function to delete a user is pretty straightforward, because most everything has been figured out for us. It should look like this:
delUser :: MonadState State m => String -> m () delUser name = modUsers $ M.delete name
This should look pretty straightforward – the users are stored in a map, and Data.Map was imported as M – modUsers is our helper function to modify the state. MonadState State is the monad we are using, because we are changing the state (as apposed to MonadReader when we are just pulling information out). The only last thing we need to do is at it to the TemplateHaskell function mkMethods that creates the data types that are used in the query and update functions.
$(mkMethods ''State['addUser,'delUser,'authUser,'isUser,'listUsers, 'isSession, 'setSession, 'getSession, 'newSession, 'delSession, 'numSessions])
Next, we (obviously) want to be able to actually use this, so we will both add a url and some code to actually delete the user. You could make a more complicated system (indeed, you should, but it would be a good exercise to get more comfortable with this stuff), but I chose to make it simple, and just create a url /deleteuser that deletes the user who accesses it when logged in. It would be pretty trivial to capture the username from a form and use that, but I didnt really feel like I needed it (and offered unneeded potential security holes). To add the url, we go into Main.hs, and in the list of ServerPartTs (if this doesnt make sense, that’s okay, just look for where it would fit in best), and add this in:
, dir "deleteuser" [withDataFn (liftM Just (readCookieValue "sid") `mplus` return Nothing) deleteUserPage]
What this does is register a url at “deleteuser” that pulls the cookie value stored in “sid” out and then calls deleteUserPage with it. WithDataFn is a variant on WithData that instead of taking a function that takes a structure that can be parsed out because it implements the FromData class, withDataFn takes that function (fromData) as one of its paramaters. This is just a convenience thing, functionally it accomplishes the same as if we created a data structure “cookieSid” that implemented the FromData class and had the following code:
fromData = (liftM Just (readCookieValue "sid") `mplus` return Nothing)
Now we have a url that grabs the cookie, we need to use that in the function we called with it, deleteUserPage. It looks something like:
deleteUserPage (Just sid) = [anyRequest $ do ses <- query $ (GetSession $ sid) msg <- deleteUser ses ok $ toResponse msg] deleteUserPage Nothing = [anyRequest $ ok $ toResponse "not logged in"]
You probably noticed above, the if the cookie value wasn’t found, Nothing was returned, if it was found, Just the value was passed. So we have two versions of deleteUserPage to handle those two cases – the second obviously represents the case when the person is not logged in, so we sent that as a response. In the former case, we have an sid, so we look it up in the sessions that are stored in state, and call a function to delete the user with that username (what is stored in the session data). That function then returns the message we will pass back to the user, in the last line of the first function’s do block. The function looks like:
deleteUser (Just (SessionData s)) = do update $ DelUser s return "deleted" deleteUser Nothing = do return "nothing deleted"
Again, we are dealing with code that takes a Maybe value – this is because the query to look up the session id might not return a user name. If, for example, the person had a value in the cookie value sid (maliciously or not) that didnt correspond to a session that was currently valid, the query would have returned Nothing. The one thing that you might think is a little funny (but if you followed the other tutorial you might have already noticed). I call query not with a function, but a data type – this may seem a little odd, but it has to do with how state is kept in HAppS, and if you are wondering where it came from, remember the TemplateHaskell function mkMethods that we called on it (and all the other state accessing/changing functions) – that creates the data types. For a regular person just using HAppS, the distinction is not important – just know that you need to use the capitalized version, not the lowercase function. So that’s it for deleting users. Now let’s move on to logging out (because you might have noticed using the code developed in the previous section, you can delete yourself and continue using the parts of the sites you need to be logged in as. Oops!)
There are two aspects of this task. First, deleting the session from state. And second, deleting the cookie on the browser. To accomplish the former, a function very similar to the one developed in the last section, to delete users, will work:
delSession :: (MonadState State m) => SessionKey -> m () delSession key = do modSessions $ Sessions . (M.delete key) . unsession return ()
We use MonadState again, because again we are modifying the state. One thing you might notice is ‘unsession’ – this is the field accessor for the Sessions datatype. You can read this (right to left) as pull the map out of Sessions (unsession), delete the key (M.delete key), and construct the type again (Sessions), to create the proper function that modSessions takes: Sessions -> Sessions. Now we want to add this to mkMethods, making it now look like this:
$(mkMethods ''State ['addUser, 'delUser, 'authUser, 'isUser, 'listUsers, 'setSession, 'getSession, 'newSession, 'delSession, 'numSessions])
To actually log out, we will create a function that corresponds to the performLogin function in the other tutorial:
performLogout sid = do addCookie 0 (mkCookie "sid" "0") -- delete cookie update $ DelSession sid
There isn’t a delCookie function (yet, there are stubs for one in the code), but deleting the cookie is as simple as replacing it with a blank one that times out immediately (thanks #happs for this idea). Other than that, the function should look very straightforward. Now the last steps are creating the url and the page that will allow these functions to be accessed. The url looks like:
, dir "logout" [withDataFn (liftM Just (readCookieValue "sid") `mplus` return Nothing) logoutPage]
The astute reader (or just any old haskeller) will say, wait, you are using the very same code as you used for the deleteuser page, why dont you factor it out? And indeed you could, here is a non-point free version:
cookieR handler = withDataFn (liftM Just (readCookieValue "sid") `mplus` return Nothing) handler
Which would make our previous two url entries look like this:
, dir "logout" [cookieR logoutPage] , dir "deleteuser" [cookieR deleteUserPage] Now, we just need our logoutPage function and we will be finished with this section! Let’s make it quick:
logoutPage (Just sid) = [anyRequest $ do loggedin <- query $ (IsSession $ sid) if loggedin then do processLogout sid ok $ toResponse $ "logged out." else ok $ toResponse $ "not logged in"] logoutPage Nothing = [anyRequest $ ok $ toResponse $ "Not logged in"]
And that’s it! Not the prettiest of functions, and one that could probably be reduced to a one-liner, but working. So now if we look back at what we’ve accomplished – we now have a system that can add and delete users, can log in and log out, can see all the users, and can see if we are logged in. The one last thing I promised for this post (which is getting quite long) is a way to limit the total number of users. Since by this time you are probably seeing the pattern of adding code, I’ll make it super abrieviated. First, code in Sessions.hs:
numUsers :: MonadReader State m => m Int numUsers = liftM length listUsers
$(mkMethods ''State ['addUser, 'delUser, 'authUser, 'isUser, 'listUsers, 'numUsers, 'setSession, 'getSession, 'newSession, 'delSession, 'numSessions])
And now, in Main.hs, we want to modify the checkAndAdd function to check the total number of users.
checkAndAdd user pass = do numusers <- query NumUsers if numusers > 0 -- ie, only allow one user to exist then ok $ toResponse $ "Unable to create new user" else do update $ AddUser user $ User user pass ok $ toResponse $ usersP "User created."
You may notice that we are now not checking if the user exists, but as mightybyte pointed out in a later blog post, there was a potential problem in the current design – that the check and the add were in different transactions, and thus there would be no guarantee if two people tried to create the same username at the same time that one would be rejected. The solution that he came up with (on the blog, but not on the hpaste files) is to move that functionality into the function in Session.hs, to make it part of the same transaction. It looks like this now:
addUser name u = do exists <- isUser name unless exists $ modUsers $ M.insert name u return exists
And that should be it. We now have a hard limit on the total number of users (it might be slightly more full featured if you put the limit higher than 1 user, but that should be easy to do. More to come in subsequent posts (we havent yet gotten to a full blog yet, and the fact that you’re reading this proves that one exists )