Daniel Patterson

Building on HAppS – Part 1 – More User Functionality

In Uncategorized on September 8, 2009 at 7:24 pm

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!)

Deleting Users

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!)

Logging Out

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."
        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

Updated mkMethods:

$(mkMethods ''State ['addUser, 'delUser, 'authUser, 'isUser, 'listUsers, 'numUsers,
                     'setSession, 'getSession, 'newSession, 'delSession, 

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 :P)

  1. It seems that your hpasted code isn’t there any more?

    • Hmm… you seem to be right. even messing with the url (hpaste doesnt seem to do url re-writing anymore, which is silly in my opinion, so it now is at http://hpaste.org/fastcgi/hpaste.fcgi/view?id=NNNN) and trying to find the old pastes doesnt go anywhere.

      I’ll try to find the old code, but I have a feeling it might not even work anymore (as this was written a while ago, with HAppS, which is the precursor to happstack, what is currently being developed).

  2. Oh, don’t worry about it, it was just an FYI while I was reading around whether or not hapstack can do good blog sites.

    If your code is old, does that mean that you gave up on the idea?

Leave a Reply

Fill in your details below or click an icon to log in:

WordPress.com Logo

You are commenting using your WordPress.com account. Log Out / Change )

Twitter picture

You are commenting using your Twitter account. Log Out / Change )

Facebook photo

You are commenting using your Facebook account. Log Out / Change )

Google+ photo

You are commenting using your Google+ account. Log Out / Change )

Connecting to %s

%d bloggers like this: