Paul Kuliniewicz » happstack http://www.kuliniewicz.org/blog After all, it could only cost you your life, and you got that for free. Mon, 28 Jan 2013 03:25:49 +0000 en-US hourly 1 http://wordpress.org/?v=3.8.5 http://creativecommons.org/licenses/by-nc-nd/3.0/us/ Happstack and Streaming: Part 5: Modifying Happstack http://www.kuliniewicz.org/blog/archives/2010/01/29/happstack-and-streaming-part-5-modifying-happstack/ http://www.kuliniewicz.org/blog/archives/2010/01/29/happstack-and-streaming-part-5-modifying-happstack/#comments Fri, 29 Jan 2010 15:00:25 +0000 http://www.kuliniewicz.org/blog/?p=1745 Modifying Happstack

So now that we’ve established that changes to Happstack are needed to support streaming, what should those changes look like? Abstractly, there needs to be a way to give it a series of chunks that it can send to the browser individually via chunked transfer encoding, flushing the network buffer after each one to make sure they’re sent promptly.

The most obvious way to do this is to add a third data constructor to the Response data type, for use with streams. The main difference would be that, instead of accepting a single ByteString as the response to the browser, it would somehow get ahold of several.

What would that “somehow” be, though? Looking back to our original motivation (the real-time multiplayer game being played in a web browser), the entire contents of the stream aren’t known at the time it starts, and its contents will be determined by the actions of the various players — i.e., things happening in the IO monad. This means a simple list of ByteStrings isn’t the way to go. Although we did demonstrate such a list could be built anyway using some trickery, ideally we’d want something a bit more elegant, or at least one that doesn’t require actively subverting the type system via unsafeInterleaveIO.

Therefore we’d want to put an IO action in the response that could be used to generate new ByteStrings on demand for each chunk. The simplest way would be to use an IO ByteString:

data Response = {- Response and SendFile data constructors... -}
              | Chunked { rsCode      :: Int,
                          rsHeaders   :: Headers,
                          rsFlags     :: RsFlags,
                          rsValidator :: Maybe (Response -> IO Response),
                          chGenerator :: IO L.ByteString
                        }

Happstack could execute that action repeatedly to generate successive chunks, and we could even denote end-of-stream by having it produce an empty ByteString, which neatly parallels how chunked transfer encoding works.

An alternative would be something that includes an explicit state parameter that gets chained from one call to the IO action to the next. Without something like that, it would be awkward (albeit not impossible) for the action to keep track of where it’s at in the stream and what it should generate next.

data Response a = {- Response and SendFile data constructors... -}
                | Chunked { rsCode         :: Int,
                            rsHeaders      :: Headers,
                            rsFlags        :: RsFlags,
                            rsValidator    :: Maybe (Response a -> IO (Response a)),
                            chGenerator    :: a -> (a, IO L.ByteString),
                            chInitialState :: a
                          }

Unfortunately, that changes the kind of Response from * to * -> * in order to account for the new type parameter a representing whatever state the stream wants to keep track of. Since Response is used throughout Happstack and programs built on it, breaking API compatibility like that really ought to be avoided if we can help it, especially when it’s just for the sake of what would be an infrequently used feature.

Instead, what if we turn things around and put the generator in the driver’s seat: pass it an IO action to call whenever it has a new chunk ready to be sent:

data Response = {- Response and SendFile data constructors... -}
              | Chunked { rsCode         :: Int,
                          rsHeaders      :: Headers,
                          rsFlags        :: RsFlags,
                          rsValidator    :: Maybe (Response -> IO Response),
                          chGenerator    :: (L.ByteString -> IO ()) -> IO ()
                        }

Happstack would invoke chGenerator with a function that handles writing a chunk to the network and doing whatever it needs to do when the stream is over. The last thing chGenerator would do is call that function with an empty ByteString to signal end-of-stream. chGenerator would be responsible for chaining any state information from one step to the next. It would actually look rather like the pipe example from earlier; the function provided by Happstack would be used in place of hPrint and hClose, but other than that it’s the same basic idea.

There’s still the issue of signaling to the generator when it should stop because the network connection closed. But hey, we’ve got a perfectly good return value from the Happstack-provided function that we’re not using. Let’s use it:

data Response = {- Response and SendFile data constructors... -}
              | Chunked { rsCode         :: Int,
                          rsHeaders      :: Headers,
                          rsFlags        :: RsFlags,
                          rsValidator    :: Maybe (Response -> IO Response),
                          chGenerator    :: (L.ByteString -> IO Bool) -> IO ()
                        }

The Happstack-provided function returns True if more data should be generated, or False if it should be aborted.

That ought to work pretty well. It addresses all the problems identified with our attempts to stream without changing Happstack. The use of Chunked as the data constructor for the Response object will tell Happstack to suppress the Content-Length header, use chunked transfer encoding, and flush the network buffer after each chunk. New data to stream is only generated as needed, without using additional threads or large buffers. API compatibility with existing code is preserved; we’re adding a new interface and leaving existing ones untouched. Even better, there’s no need to use any trickery to achieve lazy IO; with Happstack’s cooperation, the usual kind of IO works just fine.

Mind you, I haven’t written a patch that implements this proposal. It’s just an idea. At the very least, I’d want to have one realistic application (i.e., not a simple proof-of-concept like from earlier) that demonstrates how it can be used and to verify that it does indeed work correctly before actually submitting a patch. After all, as any good programmer can tell you, sometimes flaws in a design don’t become apparent until you actually try to implement them. But it seems like this ought to work.

Now I just have to get around to writing the application whose idea motivated me to investigate the feasibility of streaming data from Happstack to begin with.

]]>
http://www.kuliniewicz.org/blog/archives/2010/01/29/happstack-and-streaming-part-5-modifying-happstack/feed/ 2
Happstack and Streaming: Part 4: The Flaw http://www.kuliniewicz.org/blog/archives/2010/01/27/happstack-and-streaming-part-4-the-flaw/ http://www.kuliniewicz.org/blog/archives/2010/01/27/happstack-and-streaming-part-4-the-flaw/#comments Wed, 27 Jan 2010 15:00:47 +0000 http://www.kuliniewicz.org/blog/?p=1741 The Fatal Flaw

All three approaches to generating a lazy ByteString from the IO monad actually do work, as you can verify by loading the source code into ghci and invoking them manually. However, if you go through the web server and visit one of the finite stream paths, no output will appear until the stream has finished being generated, at which point the entire set of output from the server will arrive all at once, like so:

paul@queeg:~/tmp$ GET -es http://localhost:8000/pipe/limited

(nothing happens for a while, and then…)
200 OK
Connection: close
Date: Mon, 18 Jan 2010 13:30:55 GMT
Server: Happstack/0.4.1
Content-Type: text/html; charset=utf-8
Client-Date: Mon, 18 Jan 2010 13:30:58 GMT
Client-Peer: 127.0.0.1:8000
Client-Response-Num: 1
 
2010-01-18 13:30:55.342444 UTC
2010-01-18 13:30:55.443235 UTC
2010-01-18 13:30:55.544115 UTC
2010-01-18 13:30:55.644934 UTC
2010-01-18 13:30:55.745514 UTC
2010-01-18 13:30:55.846283 UTC
2010-01-18 13:30:55.947581 UTC
2010-01-18 13:30:56.048834 UTC
2010-01-18 13:30:56.150068 UTC
2010-01-18 13:30:56.251281 UTC
2010-01-18 13:30:56.352521 UTC
2010-01-18 13:30:56.454423 UTC
2010-01-18 13:30:56.555816 UTC
2010-01-18 13:30:56.657179 UTC
2010-01-18 13:30:56.758547 UTC
2010-01-18 13:30:56.859939 UTC
2010-01-18 13:30:56.961296 UTC
2010-01-18 13:30:57.062581 UTC
2010-01-18 13:30:57.163847 UTC
2010-01-18 13:30:57.265212 UTC
2010-01-18 13:30:57.366438 UTC
2010-01-18 13:30:57.4677 UTC
2010-01-18 13:30:57.569059 UTC
2010-01-18 13:30:57.670414 UTC
2010-01-18 13:30:57.772045 UTC
2010-01-18 13:30:57.873404 UTC
2010-01-18 13:30:57.974761 UTC
2010-01-18 13:30:58.076117 UTC
2010-01-18 13:30:58.177485 UTC
2010-01-18 13:30:58.278847 UTC

The point where the delay occurs reveals what’s going on — not even the headers are getting sent out until the entire response has been generated. That’s not Happstack’s doing; it’s the buffering happening inside the networking library. In the absence of any command to send data out immediately, it’s going to wait until it has a large chunk it can send out immediately. Sending one large packet instead of lots of small packets makes more efficient use of network bandwidth, since each packet carries its own overhead. And since Happstack wasn’t written with streaming in mind, it doesn’t flush the buffer until it’s written out the complete response.

As further evidence, the infinite streams do stream, kind of. Once the buffer fills up, the networking library will push it out to make room for more data. As a result, nothing will arrive for a while, then all of a sudden lots of data will arrive, then another long pause as the buffer fills back up, then another big chunk of data, and so on.

This alone shows why, despite our best efforts at cleverly creating the response, it’s all for nothing unless we can control the buffering behavior down in the network library, which Happstack doesn’t provide any access to. The only exception would be if we’re trying to stream data quickly enough to rapidly fill up the buffer, but since there’s also no way to control the size of the buffer, that “solution” isn’t reliable, and certainly not applicable if we’re only trying to stream a relative trickle of information.

Buffering Strikes Back

Buffering introduces additional problems that, while they don’t kill the solution outright, adds some significant inefficiencies. These are easiest to see with the infinite streams, which continue until the browser closes the connection. (They’d also arise any time the browser closes a finite stream before receiving all the data.)

First, Happstack only detects that the connection to the browser has been closed once the network library tries to send out data and returns an error. Between the time when the connection actually closes (i.e. when the browser sends a TCP FIN packet) and the time when Happstack notices, the program continues generating new data to send. All this effort is wasted, since the data will never get sent out and will be thrown away. The app server winds up doing a lot of useless work as a result.

Being able to control network-level buffering would largely deal with this problem too: since a closed connection is detected when trying to send data, sending each chunk out immediately would allow the app server to stop generating the stream much more promptly. If that were the case, the approach of manually using unsafeInterleaveIO, despite being the most difficult of the three, would work fairly well. The other two, however, have their own buffering problems, independent of what’s happening at the network level.

For example, what is a pipe but a buffer being managed by the operating system? Since a separate thread is writing data to the pipe independently of the thread reading from it, the generation thread will keep on going even if the network connection closes, until the pipe fills up. In theory the OS should cause writes to fail as soon as the read end of the pipe is closed, but using lazy IO to read from it seems to keep this from happening promptly. The generation thread will keep writing more data to the pipe until it too gets a write error and stops.

Using channels is even worse. The network buffer and the pipe at least have the benefit of being of finite size; once they fill up, further attempts to write will block until something reads the data back out or an error is detected and the buffer is destroyed. Channels, however, are unbounded. They never fill up; they just keep growing to make room for new data as it’s written. As a result, in the event of the browser closing the connection prematurely, the size of the channel will grow and grow until the thread writing data to it decides to stop. This is a problem for the infinite streams, since they never stop; eventually the channel will grow to consume all available memory on the system until the OS kills the app server entirely. This is also a problem for finite streams, of course, since those channels won’t get thrown away until they grow to the size of the unconsumed portion of the stream, which would be a big problem if the app server is generating lots of streams.

Playing Nice

But even if all the buffering problems can be dealt with, our solution still is far less than ideal. While the idea of slowly trickling out the stream’s data as it becomes available is legal according to the definition of HTTP, it’s really not the proper way to go about it.

Remember how we had to suppress the Content-Length header? Browsers use that header to know when they can stop reading the response from the server. Without it, the only way they can tell they’ve received all the data is when the server closes the connection. Leaving the connection open has the advantage that the browser can re-use it for the next request it sends to the server, instead of creating a new connection. Establishing a new connection requires doing the TCP three-way handshake again, which involves a round trip to the server that doesn’t carry any data. Being able to reuse the connection is faster since this extra round trip is eliminated. It might not seem like much, but consider a web page that has lots of small graphics on it; without being able to reuse a connection, a new round trip is needed every time the browser tries to download another image. All those little delays add up.

It turns out HTTP does have a way to stream data while still telling the browser how much data to expect: chunked transfer encoding. Basically, the server’s response gets split up into separate chunks, and each chunks carries its own length information. The end of the stream is indicated by a zero-length chunk. With chunked transfer encoding, the browser knows when it’s finished receiving the data, even though the server doesn’t necessarily know how much data will be sent beforehand.

Chunked transfer encoding is what we’d want the server to be able to do. Of course, Happstack would need to be modified to support it, since it too needs to know when the stream has ended so it can reuse the connection for the next request from the browser.

In Part 5, we’ll look at just what sort of modifications we might try to make.

]]>
http://www.kuliniewicz.org/blog/archives/2010/01/27/happstack-and-streaming-part-4-the-flaw/feed/ 0
Happstack and Streaming: Part 3: Implementation (Sort Of) http://www.kuliniewicz.org/blog/archives/2010/01/25/happstack-and-streaming-part-3-implementation-sort-of/ http://www.kuliniewicz.org/blog/archives/2010/01/25/happstack-and-streaming-part-3-implementation-sort-of/#comments Mon, 25 Jan 2010 15:00:27 +0000 http://www.kuliniewicz.org/blog/?p=1732 Implementation

For our proof-of-concept for trying to do streaming with Happstack, here’s a simple web application that implements each of the three possible approaches discussed earlier. To keep things simple, the data we’ll be streaming is a series of timestamps taken from the system clock at regular intervals. Not a particularly useful application, but it is something simple that uses IO, which is all we’re looking for here. To make things a bit more interesting, the web app will support each approach two different ways: first, streaming a finite number of timestamp values before ending the stream, and second, streaming an endless series of timestamp values until the browser closes the connection.

Specifically, the web app will support the following six paths:

/pipe/limited
A finite number of timestamps, using a OS-level pipe.
/pipe/infinite
An infinite number of timestamps, using an OS-level pipe.
/chan/limited
A finite number of timestamps, using a Chan.
/chan/infinite
An infinite number of timestamps, using a Chan.
/manual/limited
A finite number of timestamps, using unsafeInterleaveIO manually.
/manual/infinite
An infinite number of timestamps, using unsafeInterleaveIO manually.

First, let’s get all the module imports out of the way. There’s nothing particularly interesting about any of them, so I won’t comment on them further.

{-# LANGUAGE FlexibleContexts #-}
 
module Main (main) where
 
import Control.Concurrent (forkIO, threadDelay)
import Control.Concurrent.Chan (Chan, getChanContents, newChan, writeChan)
import Control.Monad (liftM, MonadPlus, msum, when)
import Control.Monad.Trans (liftIO, MonadIO)
import Data.Time.Clock (diffUTCTime, getCurrentTime)
import Happstack.Server.HTTP.Types (Method (..), noContentLength, nullConf, Response, resultBS)
import Happstack.Server.SimpleHTTP (dir, FilterMonad, internalServerError, methodSP, nullDir,
                                    ServerMonad, simpleHTTP, toResponse)
import System.IO (Handle, hClose, hFlush, hPrint, hPutStrLn, stderr)
import System.IO.Unsafe (unsafeInterleaveIO)
import System.Posix.IO (createPipe, fdToHandle)
 
import qualified Data.ByteString.Char8 as S
import qualified Data.ByteString.Lazy.Char8 as L

Next is the code that sets up the Happstack server with the six paths mentioned above.

main :: IO ()
main = simpleHTTP nullConf root
 
root :: (ServerMonad m, MonadPlus m, MonadIO m, FilterMonad Response m) => m Response
root = msum [ dir "pipe"   $ subdir outputPipe
            , dir "chan"   $ subdir outputChan
            , dir "manual" $ subdir outputManual
            ]
 
subdir :: (ServerMonad m, MonadPlus m, MonadIO m) => ((Int -> Int) -> IO Response) -> m Response
subdir output = msum [ dir "limited"  $ nullDir >> methodSP GET (liftIO $ output decr)
                     , dir "infinite" $ nullDir >> methodSP GET (liftIO $ output id)
                     ]
    where decr n = n - 1

To support both finite and infinite streams, each stream generator takes an initial counter and a decrement function. After generating each timestamp value, it applies the decrement function to the counter, and stops if the counter reaches zero. For finite streams, the decrement function subtracts one from the counter. For infinite streams, it does nothing, so that the counter never reaches zero.

Yeah, it’s kind of an ugly hack, but it’s good enough for this.

Here’s the code for generating a stream using OS-level pipes:

outputPipe :: (Int -> Int) -> IO Response
outputPipe decr = do h <- pipeClock decr limitedCount
                     bs <- L.hGetContents h
                     return $ streamBS bs
 
pipeClock :: (Int -> Int) -> Int -> IO Handle
pipeClock decr n = do (readFd, writeFd) <- createPipe
                      writeH <- fdToHandle writeFd
                      forkIO $ output writeH n `catch` abort writeH
                      fdToHandle readFd
    where output h 0 = do hPutStrLn stderr "closing pipe"
                          hClose h
          output h n = do now <- getCurrentTime
                          hPrint h now
                          hFlush h
                          tick now
                          threadDelay interval
                          output h (decr n)
          abort h e = do hPutStrLn stderr $ "caught error: " ++ show e
                         hClose h

The above code creates a pipe. A new thread is forked off to repeatedly write timestamps into the pipe. For a finite stream, the new thread closes its end of the pipe when it’s done writing. Meanwhile, the original thread uses lazy IO to read the entire contents of the pipe into a lazy ByteString, which gets passed back down to Happstack for sending to the browser.

Here’s the code for generating a stream using an IO channel:

outputChan :: (Int -> Int) -> IO Response
outputChan decr = do ch <- chanClock decr limitedCount
                     chunks <- getChanContents ch
                     let bs = L.fromChunks $ takeWhile (not . S.null) chunks
                     return $ streamBS bs
 
chanClock :: (Int -> Int) -> Int -> IO (Chan S.ByteString)
chanClock decr n = do ch <- newChan
                      forkIO $ output ch n
                      return ch
    where output ch 0 = do hPutStrLn stderr "done writing to channel"
                           writeChan ch S.empty
          output ch n = do now <- getCurrentTime
                           writeChan ch $ chunkify now
                           tick now
                           threadDelay interval
                           output ch (decr n)

The above code does the same basic thing, just with a channel of strict ByteStrings instead of a pipe. A new thread is forked off to write timestamp values to the channel. For a finite stream, the new thread writes an empty ByteString to indicate that it’s done. Meanwhile, the orginal thread uses lazy IO to read the entire contents of the channel into a (lazy) list, up until an empty ByteString. It then lazily combines the individual strict ByteStrings into a single lazy ByteString that it then passes down to Happstack.

The two above approaches each use a new thread that writes a timestamp, waits for the specified interval, writes another timestamp, and so on. Thus, the two code snippets look pretty similar in basic structure. Not so for using unsafeInterleaveIO directly:

outputManual :: (Int -> Int) -> IO Response
outputManual decr = do bs <- manualClock decr limitedCount
                       return $ streamBS bs
 
manualClock :: (Int -> Int) -> Int -> IO L.ByteString
manualClock decr n = do now <- getCurrentTime
                        tick now
                        allFutureChunks <- unsafeInterleaveIO $ ticksAfter now
                        let futureChunks = map fst $ zip allFutureChunks countdown
                        return . L.fromChunks $ chunkify now : futureChunks
    where ticksAfter since = do now <- getCurrentTime
                                let delta = diffUTCTime now since
                                when (delta < interval / 1000000) $
                                        threadDelay (round (interval - delta * 1000000))
                                now' <- getCurrentTime
                                tick now'
                                futureChunks <- unsafeInterleaveIO $ ticksAfter now'
                                return $ chunkify now' : futureChunks
          countdown = takeWhile (> 0) $ iterate decr (decr n)

Here, all the action takes place in a single thread. Again, it takes the strategy of combining a bunch of strict ByteStrings, one per timestamp, into a lazy ByteString with everything. It generates the first timestamp immediately, but defers building the rest of the list until it’s needed. When it is needed, it again generates the first timestamp of the rest of the list immediately, and defers building the rest.

It’s worth noting that this approach is the most difficult to write, since putting unsafeInterleaveIO in the right place is critical to making it work. Also, since everything is happening in a single thread, strictly speaking it’s no longer good enough to just delay for the desired interval between timestamps, since there’s no telling how much time has been spent in other parts of the code. Instead, it needs to check the clock twice each time around: first to figure out how long to delay, if any, and second to actually get the timestamp. Not surprisingly, the code is also the hardest to read of the three.

Finally, there are some odds and ends that bear mentioning. Here’s a simple function that converts a time value into a strict ByteString:

chunkify :: Show a => a -> S.ByteString
chunkify = S.pack . (++ "\n") . show

Here’s a helper function that prints out a message whenever a new timestamp is generated, so we can watch the app server’s progress:

tick :: Show a => a -> IO ()
tick x = hPutStrLn stderr $ "tick " ++ show x

As you can see from the type signatures of those two utility functions, there’s nothing that makes them unique to time values; any value that can be converted to a string (i.e., anything belonging to the Show class), works. We just happen to only use them with UTCTimes.

Anyway, here’s a simple function for converting a lazy ByteString into the Response object that Happstack ultimately wants:

streamBS :: L.ByteString -> Response
streamBS = noContentLength . resultBS 200

We explicitly tell Happstack not to add the Content-Length header, since to do that it would need to measure the length of the entire response, which would mean it can’t send anything until it sees the entire response, which defeats the entire point of what we’re trying to accomplish.

Last, and also least, here are the constants specifying the time interval between timestamps, and how many timestamps to generate in a finite stream before stopping:

interval :: Num a => a
interval = 100000        -- microseconds
 
limitedCount :: Num a => a
limitedCount = 30

That’s the entirety of the code. If you have GHC installed, you can go ahead and compile the program and play around with it to find out whether or not any of the approaches we’ve tried actually work. Since we didn’t pass any configuration parameters to Happstack, it will start a web server on port 8000 that you can point your favorite browser to, at any of the six paths we defined.

Stay tuned for Part 4, where we’ll see why (spoiler alert!) none of the three approaches actually work.

]]>
http://www.kuliniewicz.org/blog/archives/2010/01/25/happstack-and-streaming-part-3-implementation-sort-of/feed/ 2
Happstack and Streaming: Part 2: Lazy IO http://www.kuliniewicz.org/blog/archives/2010/01/22/happstack-and-streaming-part-2-lazy-io/ http://www.kuliniewicz.org/blog/archives/2010/01/22/happstack-and-streaming-part-2-lazy-io/#comments Fri, 22 Jan 2010 15:00:31 +0000 http://www.kuliniewicz.org/blog/?p=1728 Two Haskell features complicate our attempt at streaming data from Happstack: lazy evaluation, and its handling of IO.

Laziness

Unlike more mainstream languages, Haskell evaluates expressions lazily; it doesn’t actually compute the value until it’s actually used. This has some interesting benefits. For example, it’s quite easy to create infinitely long lists without requiring infinite amounts of memory. For example, the expression [1 ..] is a list of all positive integers. Haskell code can pass that infinite list around like any other value, and as long as we don’t do something that requires actually trying to evaluate the entire list (such as trying to compute its length), we’re perfectly safe.

We can even do computations where we create multiple infinitely long lists and do operations on the entire thing, as long as we never try to use the entire result. For example, here we take the aforementioned infinitely long list, split it up into evens and odds, add the two infinitely long lists pairwise, and look for the first element greater than 5,000:

foo :: Integer
foo = head greaterThan5000
    where greaterThan5000 = filter (> 5000) sums
          sums            = zipWith (+) odds evens
          odds            = filter odd positives
          evens           = filter even positives
          positives       = [1 ..]

The five lists defined in the where clause above are all infinitely long, but that’s OK because the program never needs to evaluate more than a finite part of any of them to compute the value of foo. (For the record, it’s 5003.)

So, problem solved, right? The application server just needs to give Happstack a ByteString, which after all is just a compacted list of Word8s or Chars, and that list can evaluate to the data we eventually want to send to the browser, once we figure out in the future what it needs to be.

Sadly, it’s not that easy; you’re forgetting another key property of Haskell that lets lazy evaluation work.

Pure Functional IO

Lazy evaluation works because Haskell is a purely functional language: expressions do not have side effects. As a result, functions in Haskell are much like functions in mathematics: their output is entirely determined by their input parameters, and their only result is producing a new value. Haskell functions can’t reference any values whose value might change, since values in a Haskell program never change. This is why lazy evaluation works: it doesn’t matter when the program gets around to evaluating an expression, if ever, since its result will always be exactly the same.

However, this seems to prevent a Haskell program from interacting with the outside world, since the system running a Haskell program, much like the rest of the universe, is not purely functional. Any operation that interacts with the world outside the Haskell program could be affected by whatever happens to be going on at the time the operation is run.

As a simple example, consider the time() function in C programming on Linux. time() returns the current time on the system, and will obviously return a different result depending on what time it is when it gets called. Reading from a file is similar; the result returned will depend on what’s stored in the file at the time it’s read, which could change if something else writes to the file.

Interaction with the outside world is needed for a program to do anything useful, so how does Haskell get around this? Via a bit of trickery known as the IO monad. Monads can be a bit tricky to get your head around initially, but basically they’re just a way to sequence operations, with the monad doing something to take the output on one operation and give it as input to the next. The particular monad being used gets to decide what “sequencing operations” means, as though you could redefine what the semicolon means in C. Although most monads have a way to both put values into and take values out of a monad, the IO monad only lets you put values in. Although you can also run a function on the value inside the IO monad, the result will itself also be in the IO monad. There is no escape from the IO monad.

What’s the point? Conceptually, the IO monad is just another type of state monad, which carries another value (the state) from one operation to the next. In the IO monad’s case, that state is merely the state of the entire universe outside the Haskell program. Anything needing to interact with the outside world runs inside the IO monad, which as a result orders those operations into a particular sequence.

What does this have to do with anything? Recall from earlier that our use case is streaming the current state of an interactive game as it changes over time in response to input from the players over a network. That input-over-a-network is IO and thus runs inside the IO monad, and thus too must anything that uses the result. So really, our hypothetical function that creates the data to stream back to the browser doesn’t — can’t — just return a result of type ByteString. No, it has to return a result of type IO ByteString.

The good news is, the function the application server implements for Happstack to create a Response runs in the IO monad, so this is legal. The bad news is that the IO monad truly sequences operations: the entirety of our hypothetical result-creating function has to execute before the result can be given to Happstack to send it to the browser. Either the result-creating function returns right away, and thus can never see the result of other players’ actions later, or it waits until those are handled, and can’t return anything until the game is over.

It seems that the rules of the IO monad prevent us from making this work.

Screw the rules, I have money lazy IO!

Lazy IO

Lazy IO lets a program bend the rules of lazy evaluation and IO sequencing a bit. For example, consider the readFile function in the Haskell standard library, whose type is the following:

readFile :: FilePath -> IO String

Superficially, this seems to read the entire file in memory before returning, per the rules of the IO monad. Which would make the following program extremely ill-advised:

import Data.Char (ord)
 
main :: IO ()
main = do zeroes <- readFile "/dev/zero"
          print . take 20 $ map ord zeroes

It reads in the contents of the file /dev/zero, converts the characters to their Unicode code point values, and prints the first 20 of them. However, on any Unix-ish system, /dev/zero is a file that contains an infinite number of zero bytes. A program can read from it as long as it wants, and never reach the end.

The Haskell program, of course, doesn’t know about this property of /dev/zero, yet readFile doesn’t try to read an endless series of bytes into memory. Why not? Because readFile is a bit special; it does its IO lazily.

readFile isn’t alone. The getChanContents function is similar:

getChanContents :: Chan a -> IO [a]

It takes an object of type Chan a — a thread-safe unbounded queue of objects of an arbitrary type — and returns an infinite list of all items that are currently in the channel, as well as all items which will ever be written to the channel in the future. It, too, does lazy IO.

How can this be? If you dig into the source code of how these and similar functions are implemented (thanks to the Glasgow Haskell Compiler’s open-source license, you can easily do this), and trace through the calls they make, you ultimately come to this interesting little function:

unsafeInterleaveIO :: IO a -> IO a

The unsafeInterleaveIO function converts any normal IO computation into a lazy one: one that executes not when the IO action would normally run, but instead when its value is actually used. It is implemented using the deeply magic function named unsafePerformIO, which takes that “nothing ever escapes the IO monad” rule and punches it in the face:

unsafePerformIO :: IO a -> a

As you might guess from the fact that their names both start with the word “unsafe”, and that they’re in the module named System.IO.Unsafe, these functions are dangerous, since they let you bypass Haskell’s usual efforts to make lazy evaluation and IO not stab each other in the back. In certain cases, lazy IO can be mostly safe. For example, with readFile, you’re usually in trouble anyway if program A is reading a file while program B is writing it. As long as nothing is actively writing to a file, it doesn’t matter whether it gets read eagerly or lazily, since the data will be the same either way.

Of course, you’re better off using the functions that use unsafeInterleaveIO and friends rather than using them directly. As a general rule, you’re taking matter into your own hands when you use functions prefixed by the word “unsafe”. As the saying goes, if it breaks, you get to keep the pieces.

However, the existence of lazy IO offers a few possibilities for how we might try to make streaming work without modifying Happstack, thanks to lazy IO.

  1. Use an OS-level pipe. Pipes have two ends: one for writing data into it, and one for reading data out of it. Once they’re created, each end of a pipe can be treated like any other file. Fork a thread to write data to the pipe, which the original thread lazily reads back out as a ByteString.
  2. Use a Chan. Fork a thread to write data to the channel, which the original thread lazily reads and builds a ByteString from.
  3. Use unsafeInterleaveIO directly to lazily generate the ByteString as needed.

You know, this is starting to look like it might actually work. I won’t mention the crippling flaw shared by each of these options, however, at least not just yet. (They also each share a second, non-crippling but still significant flaw; a careful reading of RFC 2616 might give you a clue what it is, if you can’t bear the suspense.) It’s better if we try implementing them and experience how and why they each fail, as will any approach that doesn’t involve modifying Happstack somehow.

We’ll start doing precisely that in Part 3.

]]>
http://www.kuliniewicz.org/blog/archives/2010/01/22/happstack-and-streaming-part-2-lazy-io/feed/ 2
Happstack and Streaming: Part 1: Introduction http://www.kuliniewicz.org/blog/archives/2010/01/20/happstack-and-streaming-part-1-introduction/ http://www.kuliniewicz.org/blog/archives/2010/01/20/happstack-and-streaming-part-1-introduction/#comments Thu, 21 Jan 2010 03:16:24 +0000 http://www.kuliniewicz.org/blog/?p=1721 Introduction

The question: is it possible to use Happstack to serve streaming data?

Spoiler alert: the answer is “no”. At least, not with the current version of Happstack (0.4.1). However, exploring the reasons why it isn’t possible sheds some light on what changes you’d need to make to Happstack to make it work. This five-part series will explore that topic in some detail, including code that almost-but-not-quite does what we want.

What is streaming, anyway?

For this discussion, I’m talking about generating a series of bytes in real time from a web application server and sending those bytes to a web browser as part of a single HTTP response message.

This is different from simply sending a large file to the browser. In that case, file already exists on the disk, and can simply be read from and sent across the network as quickly as the client can keep up. TCP automatically takes care of all the ugly details of how you do that reliably; from the application server’s perspective, you send the whole thing in one giant chunk and let the network worry about the rest.

Here, however, the bytes we want to send aren’t known ahead of time. The use case I have in mind is a browser-based game where the current game state changes continuously. It’d be nice to have the server send all those updates as part of a single response, with the browser acting on updates as they are received. The alternative is to have the browser repeatedly poll for updates, sending a brand new request each time it wants the latest information. Polling is more complicated to implement because the browser now needs to worry about timing its update requests, instead of just letting the server send them when an update is ready. (Recall that HTTP uses a client/server, request/response model, preventing the server from sending data to the browser without the browser first asking for it.)

The game scenario is what prevents the server from knowing what bytes will be sent to the browser beforehand, since the game state depend on what moves the players make as the game progresses. To stream updates, the server needs to start sending the response before it knows what all the data that will be included in it are.

Thus the question: if we use Happstack to write the web application server implementing the game, is streaming updates over a single response even possible?

Happstack model

The core part of any application written for Happstack is a function that takes the request from the browser and returns a Response object that gets sent back to the browser. (Granted, that’s a very simplified version of what you pass to simpleHTTP, but it’s good enough for our discussion here.) Happstack takes care of all the details of actually sending and receiving data over the network, converting things into Haskell objects, and the like.

In Happstack 0.4.1, there are two kinds of Responses, only the first of which is of concern to us. (The second kind is optimized for sending existing a preexisting file to the browser, which precisely not what we want.) A Response is really just a (lazy) ByteString, along with HTTP metadata like a status code and a set of headers. Happstack provides a lot of tools to help set it all up, but ultimately the application is responsible for providing the ByteString to be sent to the browser. Once we give Happstack that ByteString, it’s out of the application’s hands.

At first glance, this seems to preclude us from returning any kind of real-time stream. After all, how can the application possibly return a value that it can’t compute until some point in the future? That doesn’t just sound difficult; it sounds physically impossible.

Actually, it turns out that’s the easy part, as we’ll see in Part 2.

]]>
http://www.kuliniewicz.org/blog/archives/2010/01/20/happstack-and-streaming-part-1-introduction/feed/ 0
Error monads for fun and profit http://www.kuliniewicz.org/blog/archives/2009/04/21/error-monads-for-fun-and-profit/ http://www.kuliniewicz.org/blog/archives/2009/04/21/error-monads-for-fun-and-profit/#comments Wed, 22 Apr 2009 03:18:04 +0000 http://www.kuliniewicz.org/blog/?p=1324 Last time, we corrected the security flaws in our simple Happstack.State demo program, but were left with some stinky error propagation logic. In particular:

  1. Using Maybe to carry error information, instead of using it to carry the result of a successful computation, violating the usual convention with its use.
  2. Unwieldy tangles of conditionals to check for each possible error, obfuscating the normal path of execution.

Neither of these is insurmountable. For the first, Haskell already provides a type for results that may contain detailed error information: Either a b. As you might guess, a value of that type is either something of type a or something of type b. By convention, a is the error type and b is the result type. The mnemonic is that the right type is what you get if everything goes right.

In fact, our previous code used Either to return either an error message or a meaningful result from hashPasswordFor:

hashPasswordFor :: MonadReader UserDirectory m => String -> String -> m (Either UserError PasswordHash)
hashPasswordFor name pass = do
    UserDirectory dir <- ask
    return $ case M.lookup name dir of
                Nothing   -> Left NoSuchUser
                Just user -> Right $ hashPassword (pwSalt $ usPassword user) pass

If successful, this function returns a PasswordHash via Either‘s Right type constructor. If the user couldn’t be found, it returns a UserError via Either‘s Left type constructor.

You might think that we could use Either UserError as a monad in much the same way we could use Maybe as a monad: executing a series of computations until the first error. Sadly, Either a isn’t defined to be a monad, so this doesn’t work.

Fortunately, the Monad Transformer Library has the next best thing: the ErrorT monadic transform. In a nutshell, ErrorT lets us transform any monad into something that adds error propagation. Specifically, any computation within the transformed monad can throw an error, skipping the remaining computations; the code using the transformed monad can then get an Either a b out of it with either the result of successful computation (of type b), or an error (of type a).

If this sounds a lot like try/catch-style exception handling, that’s sort of the idea. And in case you cleverly scrolled down to the Haskell section of that Wikipedia page to see that Haskell has some support for this via the IO monad, that’s true, but ErrorT is a lot more powerful, not the least of which because there’s no need to use the IO monad at all.

This might be clearer in an example. To use ErrorT, we merely have to declare whatever error type we wish to use as an instance of the typeclass Error, like so:

instance Error UserError

Looking up a user in the user directory is something our code does all the time, and each time we run the risk of failure if the user we’re looking for doesn’t exist. Let’s make a lookupUser function that tries to get the UserInfo for a user, or throws a UserError if it failed:

lookupUser :: Monad m => String -> UserDirectory -> ErrorT UserError m UserInfo
lookupUser name (UserDirectory dir) = maybe (throwError NoSuchUser) return $ M.lookup name dir

Let’s unpack that a bit. The return type is Monad m => ErrorT UserError m UserInfo. UserError is the type of errors that could get thrown, and UserInfo is the type of a successful result. m is a type variable for the monad that ErrorT is transforming; here, we don’t care what kind of monad m is, as long as it’s a monad. The function just does a lookup in the Map. If the result of the lookup is Just something, that something is returned (i.e., wrapped in) the monad. Otherwise, if the result of the lookup is Nothing, we throw NoSuchUser, which is of type UserError.

Now let’s rewrite hashPasswordFor to make use of lookupUser:

hashPasswordFor :: MonadReader UserDirectory m => String -> String -> m (Either UserError PasswordHash)
hashPasswordFor name pass = runErrorT $ do
    dir <- ask
    user <- lookupUser name dir
    return $ hashPassword (pwSalt $ usPassword user) pass

The main body of the function is free to ignore errors — there’s no more conditional check to see if the user lookup failed. Note, though, that the do block that specifies the monadic computation is now an argument to runErrorT. runErrorT has a type signature of:

runErrorT :: ErrorT e m a -> m (Either e a)

As you can see from the type signature, it takes a computation in an ErrorT-produced monad and converts it back into the original monad of type m, with the result inside m an Either e a. In other words, it converts a computation where we can throw errors into one that returns Either an error or the computation result.

You might wonder why we don’t just propagate errors out of hashPasswordFor using ErrorT like we did for lookupUser, like this:

-- This doesn't work!
hashPasswordFor :: MonadReader UserDirectory m => String -> String -> ErrorT UserError m PasswordHash
hashPasswordFor name pass = do
    dir <- ask
    user <- lookupUser name dir
    return $ hashPassword (pwSalt $ usPassword user) pass

There’s a very pragmatic reason why not: it doesn’t work. Recall that hashPasswordFor is used to generate the HashPasswordFor query operation in our MACID store. Happstack.State’s template magic crashes and burns if we try to return a computation involving ErrorT:

Users.hs:1:0:
    Exception when trying to run compile-time code:
      Unexpected method type: Control.Monad.Error.ErrorT Users.UserError m_0 Users.PasswordHash
      Code: mkMethods
              'UserDirectory
              ['addUser, 'hashPasswordFor, 'authenticateUser, 'listUsers]

This is unfortunate, since we’re ultimately trying to use HashPasswordFor and AuthenticateUser — each of which can fail — in our implementation of loginUser, and our whole goal is to wait until the very end to convert the result of the computation into an Either. The workaround is to do the opposite of runErrorT after we invoke HashPasswordFor, converting the m (Either UserError PasswordHash) back into a ErrorT UserError m PasswordHash. Luckily, it’s pretty straightforward:

rethrowError :: (Error e, Monad m) => Either e a -> ErrorT e m a
rethrowError (Left error)   = throwError error
rethrowError (Right result) = return result

Now we just need to feed the result of HashPasswordFor and AuthenticateUser into rethrowError inside loginUser:

loginUser :: MonadIO m => String -> String -> m (Either UserError ())
loginUser name pass = runErrorT $ do
    passHash <- rethrowError =<< (query $ HashPasswordFor name pass)
    now <- liftIO getClockTime
    rethrowError =<< (update $ AuthenticateUser name passHash now)

Aside from the minor hassle of needing to use rethrowError, this works quite nicely. Any UserError that gets thrown, regardless of where it happens, get caught by runErrorT and converted into Either UserError () for the result of the monadic computation. The code inside the do block doesn’t have to worry about error checking; ErrorT handles that for us.

hashPasswordFor was a trivial example, but remember this ugly nastiness from the previous post?

authenticateUser :: MonadState UserDirectory m => String -> PasswordHash -> ClockTime -> m (Maybe UserError)
authenticateUser name passHash when = do
    UserDirectory dir <- get
    case M.lookup name dir of
        Nothing -> return $ Just NoSuchUser
        Just user -> if isLocked when user
                        then return $ fmap AccountLocked $ usLocked user
                        else if passHash == usPassword user
                                then do put $ UserDirectory $ M.insert name (unlockUser user) dir
                                        return Nothing
                                else do put $ UserDirectory $ M.insert name (failUser when user) dir
                                        return $ Just PasswordMismatch

Here’s what a ErrorT magic lets us replace that with:

authenticateUser :: MonadState UserDirectory m =>
                    String -> PasswordHash -> ClockTime -> m (Either UserError ())
authenticateUser name passHash when = runErrorT $ do
    dir <- get
    user <- lookupUser name dir
    checkUnlocked when user
    if passHash == usPassword user
       then do insertUser name (unlockUser user)
               return ()
       else do insertUser name (failUser when user)
               throwError PasswordMismatch

Suddenly it’s much easier to see what the code’s supposed to do! Goodbye deep nesting of conditionals; if not for the fact that we need to update the data store differently based on whether we see a password mismatch, we wouldn’t even need the one still there.

Just for completeness’s sake, here’s checkUnlocked, which replaces isLocked from the previous code:

checkUnlocked :: Monad m => ClockTime -> UserInfo -> ErrorT UserError m ()
checkUnlocked asOf user = case usLocked user of
                            Just until -> when (asOf < until) (throwError $ AccountLocked until)
                            Nothing    -> return ()

Technically we could’ve used maybe instead of pattern-matching to turn checkUnlocked into a one-liner like isLocked was, but I think the code becomes too difficult to read in that case, which defeats the whole rationale behind using ErrorT throughout our code in the first place.

As always, here’s the complete program with these changes. The code behaves the exact same way as the previous version, but the implementation is now much easier on the eyes.

Let this be a lesson to you: it’s often said that most programming problems can be simplified by adding another level of indirection. In Haskell, I suspect the equivalent is adding another monad. Monads are a little tricky to get your head around at first, but you can do some neat things with them.

]]>
http://www.kuliniewicz.org/blog/archives/2009/04/21/error-monads-for-fun-and-profit/feed/ 0
Data migration in Happstack.State http://www.kuliniewicz.org/blog/archives/2009/04/18/data-migration-in-happstackstate/ http://www.kuliniewicz.org/blog/archives/2009/04/18/data-migration-in-happstackstate/#comments Sat, 18 Apr 2009 23:13:25 +0000 http://www.kuliniewicz.org/blog/?p=1310 Last time (modulo a distracting interlude), we looked at fixing a password disclosure vulnerability in our simple Happstack.State demo program. However, there are still some security flaws that leave passwords open to attack:

  • There are no checks for password strength — users are free to pick trivially weak passwords.
  • There is nothing preventing an online brute force attack against an account, where an attacker repeatedly guesses passwords and tries to log in until he finds the right one.

These two vulnerabilities are hardly theoretical. As I mentioned in an earlier post, not too long ago an administrator’s account on Twitter was broken into by someone running a dictionary attack. The number of login attempts per second in such an attack is only bounded by the network bandwidth between the attacker and the server, since any halfway competent attacker is going to use a script to do the work for him — it’s not like he’s sitting there trying in passwords as quickly as he can. And people being lazy, they’re liable to pick simple, easily guessed passwords unless we do something to stop them.

So let’s modify our program from last time to add some countermeasures to these attacks:

  • When creating an account, check whether the password is sufficiently strong, and refuse to create the account if it isn’t.
  • If we see repeated failed logins for an account, temporarily lock the account, limiting how quickly an attacker can guess passwords.

First, since we’re introducing even more ways operations can fail, it’d be nice if our program provided more feedback to the user about why an operation failed. A simple algebraic sum type will suffice:

data UserError = UserExists
               | NoSuchUser
               | PasswordMismatch
               | AccountLocked ClockTime
               | PasswordTooShort Int
    deriving (Eq, Ord, Typeable, Data)
 
instance Version UserError
$(deriveSerialize ''UserError)
 
instance Show UserError where
    show UserExists             = "A user by that name already exists."
    show NoSuchUser             = "No user by that name exists."
    show PasswordMismatch       = "Incorrect password."
    show (AccountLocked until)  = "Account is locked until " ++ show until ++ "."
    show (PasswordTooShort min) = "Password must be at least " ++ show min ++ " characters long."

Even if you don’t know Haskell, it should be fairly self-evident what’s going on. I’ll just note two things. First, we still need to implement the Version class and derive a serialization function via deriveSerialize even though we don’t plan to save a UserError in our MACID store, because it’s a requirement for anything we pass in or out of a query or update. Second, we implement Show ourselves instead of letting the compiler do it for us, so we can provide human-readable versions of each error.

The core of checking password strength is almost trivial: a function that takes a proposed password and returns a UserError if it doesn’t meet our exacting standards. Our code that actually creates the account will then call this function to check the strength of the user’s proposed password:

checkPasswordStrength :: String -> Maybe UserError
checkPasswordStrength pass = if length pass < 8
                                then Just $ PasswordTooShort 8
                                else Nothing

Admittedly, this isn’t much of a strength check, since it’s only looking at the length of the password. Heck, even the classic bad password “password” passes with flying colors. But this is good enough for demonstration purposes here; it’s trivial to modify the function to check more things, and presumably add new constructors to UserError accordingly.

The more interesting issue is that of temporarily locking accounts after some number of consecutive login failures. Clearly, for each account we need to keep track of how many failures there have been since the last successful login, whether the account is locked, and if so, when the lock will expire. Adding that information to UserInfo looks easy enough:

data UserInfo = UserInfo { usPassword :: PasswordHash
                         , usJoined   :: ClockTime
                         , usFailures :: Int                -- new
                         , usLocked   :: Maybe ClockTime    -- new
                         }
    deriving (Typeable, Data)

There’s a problem, though. Our MACID store contains records using the original definition of UserInfo, which lacks the last two fields. If that’s all we do, suddenly we’ll be unable to load our old data. That’s bad.

Fortunately, Happstack.State is one step ahead of us. Remember that Version typeclass that UserInfo, and all the other types we use with the MACID store, has to implement? That’s what provides our data migration path. First, we’ll need to keep the definition of the old version of UserInfo around, but with a different name. Ordinarily, we’d create a separate module to contain the old definitions, but here let’s just stick _0 to the names of everything, to denote “version 0″ to ourselves:

data UserInfo_0 = UserInfo_0 { usPassword_0 :: PasswordHash
                             , usJoined_0   :: ClockTime
                             }
    deriving (Typeable, Data)
 
instance Version UserInfo_0
$(deriveSerialize ''UserInfo_0)

The penultimate line there declares that UserInfo_0 is an instance of Version. The default implementation of Version, which we’ve used up until now, says the type is the first version (version 0). Our new and improved UserInfo is version 1 of this type, so its implementation of Version needs to state this explicitly:

instance Version UserInfo where
    mode = extension 1 (Proxy :: Proxy UserInfo_0)

This just says that UserInfo is version 1 of the type, and the previous version is what we’re now calling UserInfo_0. (The Proxy object is essentially no different than unit, but we can associate a particular type with it. Happstack.State uses it to pass type information to a function without needing to pass an instance of that type.)

OK, so UserInfo is the successor to UserInfo_0, but we still need to say how to migrate from the old version to the new version. That’s what the Migrate typeclass is for:

instance Migrate UserInfo_0 UserInfo where
    migrate (UserInfo_0 password joined) = UserInfo password joined 0 Nothing

In other words, to migrate from UserInfo_0 to UserInfo, copy the existing data over, set the login failure count to 0, and note that the account is not locked.

Now our new program will be able to read the data saved from the old one. When it tries to read a UserInfo object (version 1) but sees a UserInfo_0 object (version 0) instead, Happstack.State can automatically figure out how to perform the conversion via the migrate function we defined between the two types. For the curious, this page describes what happens behind the scenes to make this work.

Our data migration worries solved, we can turn our attention to implementing our account locking and unlocking. The easiest way forward is to define a bunch of simple helper functions for doing the basic steps, and then using those when implementing the login operation.

Checking if an account is locked is just a matter of seeing if the locked-until time, if it exists, is on or after than the current time:

isLocked :: ClockTime -> UserInfo -> Bool
isLocked asOf user = maybe False (>= asOf) $ usLocked user

Unlocking an account just means resetting the failure counter and clearing the locked-until time. Just note that, this being Haskell, we return a new UserInfo object instead of trying to modify the existing one (since we couldn’t modify it even if we tried):

unlockUser :: UserInfo -> UserInfo
unlockUser user = user { usFailures = 0, usLocked = Nothing }

Incrementing the failure count is slightly complicated by needing to lock the account if the failure count exceeds the limit. Here, if there’s been three or more consecutive failures, we lock the account for one minute:

failUser :: ClockTime -> UserInfo -> UserInfo
failUser when user = let newFailures = usFailures user + 1
                         lockedUntil = if newFailures >= failureThreshold
                                            then Just $ addToClockTime lockPeriod when
                                            else Nothing
                     in  user { usFailures = newFailures, usLocked = lockedUntil }
    where failureThreshold = 3
          lockPeriod = noTimeDiff { tdMin = 1 }

Finally, we can turn our attention to the actual login process. Login is now an update, since a login attempt, successful or unsuccessful, needs to update the failure count in the UserInfo. This means we need to beware of the no-plaintext-passwords-as-update-parameters rule we discovered previously. The workaround is the same as last time. First, an update operation that does the work:

authenticateUser :: MonadState UserDirectory m => String -> PasswordHash -> ClockTime -> m (Maybe UserError)
authenticateUser name passHash when = do
    UserDirectory dir <- get
    case M.lookup name dir of
        Nothing -> return $ Just NoSuchUser
        Just user -> if isLocked when user
                        then return $ fmap AccountLocked $ usLocked user
                        else if passHash == usPassword user
                                then do put $ UserDirectory $ M.insert name (unlockUser user) dir
                                        return Nothing
                                else do put $ UserDirectory $ M.insert name (failUser when user) dir
                                        return $ Just PasswordMismatch

AuthenticateUser needs a PasswordHash, so here’s a query that takes a plaintext password and hashes it using the salt for a particular user account:

hashPasswordFor :: MonadReader UserDirectory m => String -> String -> m (Either UserError PasswordHash)
hashPasswordFor name pass = do
    UserDirectory dir <- ask
    return $ case M.lookup name dir of
                Nothing   -> Left NoSuchUser
                Just user -> Right $ hashPassword (pwSalt $ usPassword user) pass

Finally, the loginUser function hashes the password using the HashPasswordFor query, and if it succeeds (meaning the user does indeed exist), runs an AuthenticateUser update using the result:

loginUser :: MonadIO m => String -> String -> m (Maybe UserError)
loginUser name pass = do
    hashResult <- query $ HashPasswordFor name pass
    case hashResult of
        Left error     -> return $ Just error
        Right passHash -> do now <- liftIO getClockTime
                             update $ AuthenticateUser name passHash now

And let’s not forget to update createUser to check the strength of a password:

createUser :: MonadIO m => String -> String -> m (Maybe UserError)
createUser name pass =
    case checkPasswordStrength pass of
        Nothing -> do salt <- liftIO newSalt
                      now <- liftIO getClockTime
                      update $ AddUser name (hashPassword salt pass) now
        excuse  -> return excuse

All that’s left is to adjust the command loop to expect to maybe get a UserError (or rather, definitely get a Maybe UserError), and print the error message if the command failed:

-- in commandLoop:
          processCommand state ["add", user, pass] = do
                    result <- createUser user pass
                    putStrLn $ maybe "Success" show result
                    commandLoop state
          processCommand state ["login", user, pass] = do
                    result <- loginUser user pass
                    putStrLn $ maybe "Success" show result
                    commandLoop state

Here’s the complete program. Let’s try it out, starting with the result of the run with the old version, to demonstrate that the migration worked:

> list
bobby (joined Sat Apr 11 15:31:54 EDT 2009)
cowboy (joined Sat Apr 11 14:57:28 EDT 2009)
pmk (joined Sat Apr 11 14:57:12 EDT 2009)
> login pmk notthepassword
Incorrect password.
> login pmk alsonotthepassword
Incorrect password.
> login pmk maybethisisit
Incorrect password.
> login pmk keeptryinganyway
Account is locked until Sat Apr 18 18:29:57 EDT 2009.
> time              
Sat Apr 18 18:29:08 EDT 2009
> login pmk swordfish
Account is locked until Sat Apr 18 18:29:57 EDT 2009.
> time
Sat Apr 18 18:30:10 EDT 2009
> login pmk swordfish
Success
> add bobby letstryagain
A user by that name already exists.
> login alice xyzzy
No user by that name exists.
> add alice xyzzy
Password must be at least 8 characters long.
> add alice aaaaaaaa
Success
> list
alice (joined Sat Apr 18 18:31:05 EDT 2009)
bobby (joined Sat Apr 11 15:31:54 EDT 2009)
cowboy (joined Sat Apr 11 14:57:28 EDT 2009)
pmk (joined Sat Apr 11 14:57:12 EDT 2009)
> checkpoint
> quit

Everything works as expected. Trying to brute-force a password temporarily locks the account, preventing even legitimate logins until the lock times out. New accounts are forced to have a sufficiently long password. Meaningful error messages are displayed. And we didn’t lose any of the data from the old version of the program.

Are we done? Everything does indeed work like we want it to, but it’s still not ideal. Let’s take another look at the definition of authenticateUser:

authenticateUser :: MonadState UserDirectory m => String -> PasswordHash -> ClockTime -> m (Maybe UserError)
authenticateUser name passHash when = do
    UserDirectory dir <- get
    case M.lookup name dir of
        Nothing -> return $ Just NoSuchUser
        Just user -> if isLocked when user
                        then return $ fmap AccountLocked $ usLocked user
                        else if passHash == usPassword user
                                then do put $ UserDirectory $ M.insert name (unlockUser user) dir
                                        return Nothing
                                else do put $ UserDirectory $ M.insert name (failUser when user) dir
                                        return $ Just PasswordMismatch

It works, but even if you don’t know Haskell, it still smells bad. There’s a lot of nesting going on, as seen by the ever-increasing level of indentation. In fact, every time there’s a way to fail (no such user exists, the account is locked, etc.), we need another conditional to handle the error case, forcing the rest of the computation another level deeper.

Less obvious is the bad-smelling use of Maybe UserError. Typically, the Maybe monad is used to carry the result of a successful computation — in fact, when Maybe is used as a monad, that’s precisely what it does. This is the opposite of how we’re using it: to carry the result of an unsuccessful computation. This code is violating the principle of least astonishment and is liable to confuse anyone expecting Maybe to be used the way it normally is.

Still, we want to carry detailed information about errors so the user can be informed. Is there a better way to handle errors?

Of course there is. That’s the subject of the next post.

]]>
http://www.kuliniewicz.org/blog/archives/2009/04/18/data-migration-in-happstackstate/feed/ 0
Protecting passwords for fun and profit http://www.kuliniewicz.org/blog/archives/2009/04/11/protecting-passwords-for-fun-and-profit/ http://www.kuliniewicz.org/blog/archives/2009/04/11/protecting-passwords-for-fun-and-profit/#comments Sat, 11 Apr 2009 20:04:44 +0000 http://www.kuliniewicz.org/blog/?p=1287 Last time, we looked at a simple way to use Happstack to store a bunch of user names and passwords. In fact, it was a bit too simple — an attacker with access to the disk we’re storing the data on can trivially recover each user’s password! How can this be, when we were so careful to only store hashes of passwords in our user directory, instead of the passwords themselves?

Before I get to that, let’s spend a modicum of time refactoring the code we’re working with into two modules: one that implements our user directory and one that uses our user directory. The Users module will only expose the interface for the operations we’re providing, hiding the implementation details:

module Users ( UserDirectory
             , AddUser (..)
             , CheckPassword (..)
             , ListUsers (..)
             ) where

Here, the interface only consists of the queries and updates that clients can make, as well as the top-level type of the data being saved in the MACID store. The Main module implements our command loop and imports Users to do the actual work:

module Main ( main
            ) where
 
import Users

One last change: to make it easier for successive versions of the program to share the same files backing our MACID store, we’ll explicitly set the name of the program — Happstack.State names the directory where it stores the data according to this name:

main :: IO ()
main = withProgName "state-demo" $ do
    state <- startSystemState macidProxy
    commandLoop state

For convenience, here’s a tarball containing the complete program. Let’s give it a try:

> list
> add pmk swordfish
User added
> list
pmk (joined Sat Apr 11 14:57:12 EDT 2009)
> add cowboy sourMilk7
User added
> list
cowboy (joined Sat Apr 11 14:57:28 EDT 2009)
pmk (joined Sat Apr 11 14:57:12 EDT 2009)
> login cowboy swordfish
Bad account or password
> login pmk whatever
Bad account or password
> login pmk swordfish
Success
> checkpoint
> quit

Since we named our program state-demo, Happstack.State stores its files in the directory _local/state-demo_state/ under the current directory. If we look at the checkpoint we made, which will contain the contents of the UserDirectory we created, we can see there aren’t any passwords in it, just as we expected:

0000000: 0000 0000 0000 0001 0000 0000 0000 0013  ................
0000010: 5573 6572 732e 5573 6572 4469 7265 6374  Users.UserDirect
0000020: 6f72 7900 0000 0000 0001 8100 0000 0000  ory.............
0000030: 0000 0000 0000 0000 0000 0004 a57b 6cd0  .............{l.
0000040: 6cbc 5d4d 0000 0120 968a e2ad 0000 0000  l.]M... ........
0000050: 0000 0000 0000 0000 0000 0014 3139 3238  ............1928
0000060: 3338 3631 3537 2035 3739 3432 3634 3530  386157 579426450
0000070: 0000 0000 0000 0000 0000 0000 0000 0000  ................
0000080: 0200 0000 0000 0000 0663 6f77 626f 7900  .........cowboy.
0000090: 0000 0000 0000 0000 0000 0000 0000 0000  ................
00000a0: 0000 0000 0000 0000 402f 2709 fa39 c1a1  ........@/'..9..
00000b0: 7f91 1c05 4ae1 f1b3 3260 e5ee 28b8 1963  ....J...2`..(..c
00000c0: a455 122d f04a 8235 1147 fe5c 92a3 0b4f  .U.-.J.5.G.\...O
00000d0: 7540 0754 3be1 939f 2d66 272f 0f09 ffdf  u@.T;...-f'/....
00000e0: 8c9d 05e2 3b8e b5b4 db00 0000 0000 0000  ....;...........
00000f0: 0a23 cde5 ac26 17c4 6019 a700 0000 0000  .#...&..`.......
0000100: 0000 0000 0049 e0e8 1801 0100 0000 0000  .....I..........
0000110: 0000 0500 3cb8 192e 0000 0000 0000 0003  ....<...........
0000120: 706d 6b00 0000 0000 0000 0000 0000 0000  pmk.............
0000130: 0000 0000 0000 0000 0000 0000 4035 6924  ............@5i$
0000140: cb51 f37b f7ae af8d 1953 6d44 e90b 5d4a  .Q.{.....SmD..]J
0000150: 200d 2925 8e2d 4ed7 9aa4 7b59 9d47 ed5d   .)%.-N...{Y.G.]
0000160: 8626 bef6 1e8d 6e9b 1bf7 7689 daeb facb  .&....n...v.....
0000170: a9c0 ab09 ae76 272c 3b26 ce22 de00 0000  .....v',;&."....
0000180: 0000 0000 0af1 4a1c a2dd ef72 1ea8 8e00  ......J....r....
0000190: 0000 0000 0000 0000 0049 e0e8 0801 0100  .........I......
00001a0: 0000 0000 0000 0500 9c69 30dd            .........i0.

However, when we look at the transaction log from before we made the checkpoint, we’re in for a nasty surprise:

0000000: 0000 0000 0000 0000 0000 0000 0000 0000  ................
0000010: 0000 0000 0000 0000 023f cf48 bc4d aa07  .........?.H.M..
0000020: 1400 0001 2096 8a62 f600 0000 0000 0000  .... ..b........
0000030: 0000 0000 0000 0000 1531 3438 3835 3032  .........1488502
0000040: 3432 3820 3138 3234 3336 3735 3531 0000  428 1824367551..
0000050: 0000 0000 0000 0000 0000 0000 000d 5573  ..............Us
0000060: 6572 732e 4164 6455 7365 7200 0000 0000  ers.AddUser.....
0000070: 0000 2400 0000 0000 0000 0000 0000 0000  ..$.............
0000080: 0000 0370 6d6b 0000 0000 0000 0009 7377  ...pmk........sw
0000090: 6f72 6466 6973 6800 0000 0000 0000 0000  ordfish.........
00000a0: 0000 0000 0000 0000 0000 0000 0000 0004  ................
00000b0: a57b 6cd0 6cbc 5d4d 0000 0120 968a 9e86  .{l.l.]M... ....
00000c0: 0000 0000 0000 0000 0000 0000 0000 0014  ................
00000d0: 3139 3238 3338 3631 3537 2035 3739 3432  1928386157 57942
00000e0: 3634 3530 0000 0000 0000 0000 0000 0000  6450............
00000f0: 0000 000d 5573 6572 732e 4164 6455 7365  ....Users.AddUse
0000100: 7200 0000 0000 0000 2700 0000 0000 0000  r.......'.......
0000110: 0000 0000 0000 0000 0663 6f77 626f 7900  .........cowboy.
0000120: 0000 0000 0000 0973 6f75 724d 696c 6b37  .......sourMilk7

The passwords, in the clear where anyone can see them! What happened?

In retrospect, it’s obvious. Between checkpoints, Happstack.State saves a transaction log of all updates, so that if the program quits prematurely it can recover and not lose any data. While we were careful to hash the passwords in the MACID store itself, the AddUser update operation didn’t, so when those are saved to the transaction log, so are the passwords.

The moral is this: Never pass any arguments to an update that you don’t mind being written to disk.

Now that we’ve learned our lesson, let’s rewrite addUser so that it takes a PasswordHash as an argument, instead of the password itself:

addUser :: MonadState UserDirectory m => String -> PasswordHash -> ClockTime -> m Bool
addUser name passHash when = do
    UserDirectory dir <- get
    if M.member name dir
        then return False
        else do put $ UserDirectory $ M.insert name (UserInfo passHash when) dir
                return True

That’ll work, but we’d rather not force our client to know how passwords get hashed — PasswordHash should be an implementation detail, not part of the interface. So let’s make a function that hashes the password, and then calls the update:

createUser :: MonadIO m => String -> String -> m Bool
createUser name pass = do
    salt <- liftIO newSalt
    now <- liftIO getClockTime
    update $ AddUser name (hashPassword salt pass) now

But wait, since createUser is taking the password as an argument, doesn’t it have the same saving-passwords-to-the-transaction-log flaw that we just tried to fix in AddUser? No, because createUser isn’t an update operation — it’s just a function that calls the update operation. More specifically, it sets up the arguments needed for AddUser (hashing the password and getting the current time), and then invokes AddUser with those arguments. Those are the arguments that get saved to the transaction log, not the ones that createUser gets.

If you aren’t convinced, look at the type signature for createUser again, as compared to the one for addUser:

createUser :: MonadIO m => String -> String -> m Bool
 
addUser :: MonadState UserDirectory m => String -> PasswordHash -> ClockTime -> m Bool

addUser operates in a monad that implements MonadState UserDirectory, which is what makes it an update operation. Our original code used Update UserDirectory as the monad, which is the concrete type of the monad that Happstack.State uses. Really, though, our code doesn’t care what the specific monad is, as long as it lets us read and write a state value of type UserDirectory, which is what MonadState UserDirectory guarantees.

createUser, on the other hand, operates in a monad that implements MonadIO, a generalization of the IO monad that lets Haskell programs interact with the outside world. This is why createUser can call IO operations like getClockTime, which would be illegal inside a query or update, since the Update UserDirectory monad doesn’t implement MonadIO.

And if you still don’t believe me, observe that we aren’t creating any query or update operations using the template deep magic:

$(mkMethods ''UserDirectory ['addUser, 'checkPassword, 'listUsers])

See? createUser doesn’t appear anywhere in there; it’s just an ordinary function.

Since we want clients to call createUser instead of using AddUser, let’s change the list of exports from our module:

module Users ( UserDirectory
             , createUser
             , CheckPassword (..)
             , ListUsers (..)
             ) where

And, since we changed the interface, we’ll need to update part of the Main module that uses it:

-- inside commandLoop:
      processCommand state ["add", user, pass] = do
                success <- createUser user pass
                putStrLn $ if success then "User added" else "User already exists"
                commandLoop state

Clients can be blissfully unaware of the hashing that’s going on behind the scenes inside createUser.

Here’s a tarball of version 2 of our program, with all the changes above (and a few others) applied to it. Starting with the same state from version 1, let’s try creating a new user and prove once and for all we’ve abolished plaintext passwords:

> list
cowboy (joined Sat Apr 11 14:57:28 EDT 2009)
pmk (joined Sat Apr 11 14:57:12 EDT 2009)
> add bobby nowsecure
User added
> list
bobby (joined Sat Apr 11 15:31:54 EDT 2009)
cowboy (joined Sat Apr 11 14:57:28 EDT 2009)
pmk (joined Sat Apr 11 14:57:12 EDT 2009)
> login bobby nowsecure
Success
> checkpoint
> quit

And the transaction log from this session:

0000000: 0000 0000 0000 0000 0000 0000 0000 0000  ................
0000010: 0000 0000 0000 0000 0656 a5f9 68e9 e949  .........V..h..I
0000020: 8300 0001 2096 aa27 f300 0000 0000 0000  .... ..'........
0000030: 0000 0000 0000 0000 1531 3839 3231 3631  .........1892161
0000040: 3433 3820 3230 3531 3836 3033 3930 0000  438 2051860390..
0000050: 0000 0000 0000 0000 0000 0000 000d 5573  ..............Us
0000060: 6572 732e 4164 6455 7365 7200 0000 0000  ers.AddUser.....
0000070: 0000 9500 0000 0000 0000 0000 0000 0000  ................
0000080: 0000 0562 6f62 6279 0000 0000 0000 0000  ...bobby........
0000090: 0000 0000 0000 0000 40c4 a004 6a7d 0468  ........@...j}.h
00000a0: dd6a aef6 f047 b48d fe4d 03b9 6d42 daf2  .j...G...M..mB..
00000b0: d647 fe57 ba4a c04a c67d a008 5abc 44fe  .G.W.J.J.}..Z.D.
00000c0: 1ee0 d21e 7140 e619 7a13 db8c 0060 4ee2  ....q@..z....`N.
00000d0: 6d05 dd16 7f0f 4493 0000 0000 0000 0000  m.....D.........
00000e0: 0a36 b95d 8dd4 1919 9fcf c200 0000 0000  .6.]............
00000f0: 0000 0000 0049 e0f0 2a01 0100 0000 0000  .....I..*.......
0000100: 0000 0540 e032 c9e7                      ...@.2..

Success! We can clearly see the AddUser for bobby, but can’t see his password. Even the transaction log only stores a hash of the password.

By the way, if you’re wondering why we never had to make any changes to checkPassword, which also takes a plaintext password as an argument, that’s because checkPassword is a query, and queries don’t get saved to the transaction log. That’s because queries are guaranteed not to change the contents of the MACID store, and thus can be ignored for recovery purposes. It’s safe to pass sensitive information as the arguments to a query, but not to an update.

Unfortunately, the no-sensitive-information-in-updates rule is something I only learned after writing The Button, so if you signed up for an account, the password you chose was exposed in the transaction log. I’ve taken the liberty of wiping those files, but in the unlikely event that you specified a password you use for other accounts too, I highly suggest you change those passwords, unless for some reason you trust me not to do anything nefarious with the passwords I at one time had access to.

Of course, there are still ways we could improve our program’s security, namely by enforcing that users pick strong passwords and preventing online brute force attacks. That will lead us into exploring the data migration features of Happstack.State. Stay tuned.

]]>
http://www.kuliniewicz.org/blog/archives/2009/04/11/protecting-passwords-for-fun-and-profit/feed/ 2
Happstack.State – the basics http://www.kuliniewicz.org/blog/archives/2009/04/05/happstackstate-the-basics/ http://www.kuliniewicz.org/blog/archives/2009/04/05/happstackstate-the-basics/#comments Mon, 06 Apr 2009 01:04:32 +0000 http://www.kuliniewicz.org/blog/?p=1271 One of the surprising things about using Happstack for developing web apps is that, unlike most other frameworks out there, it doesn’t use a conventional database to save information. Instead, it implements something it calls a MACID store: an in-memory user-defined data store that provides ACID guarantees (atomicity, consistency, isolation, and durability).

There are several advantages to using MACID instead of a relational database with perhaps an object-relational mapper on top of it. The biggest is that the program can use whatever data structures and data types are most convenient, instead of being forced to stick with things that map nicely to database tables. It also simplifies setup of the application: there’s no need to configure a separate database server to let the application talk to it.

As an example of using Happstack’s MACID store, implemented in the Happstack.State module, the following is a simplified version of the user account directory that I wrote as part of The Button.

Before we get to that, though, let’s take a moment to consider how the program is going to store passwords. Being security-conscious, we aren’t going to store the passwords themselves — if an attacker were to get access to the files backing the MACID store, he would learn the passwords for all users in the system. Instead, we’ll store a one-way hash of each user’s password. Given a password, it’s easy to compute the corresponding hash, but extremely difficult to take a hash and compute the password it was derived from. That way, the program can check if a user’s password matches the one for the account, without ever having to remember what the password actually is.

Actually, it’s not quite that simple. Just using a hash still lets an attacker perform a dictionary attack, perhaps using a rainbow table, if he gets a copy of the hashed passwords. The basic idea is that the attacker would guess a password, hash it, and see if the hash matches the password hash for any users. To foil this, we salt passwords before hashing them, appending some random data before running the hash function. The salt values don’t need to be secret; they just need to be different for each user, to guarantee that even if two users have the same password, the hashes will be different.

And just to ruin the attacker’s day even more, we do key strengthening by running the hash function over and over instead of just once, to increase the amount of work an attacker needs to do to brute-force a password. Since a hash can be computed fairly quickly, the user doesn’t notice if we run the function one time or 100 times. The extra work only becomes noticeable if you’re trying to guess lots of passwords, which slows down an attacker.

OK, enough about password security. Here’s how we’ll represent a hashed password in our program:

data PasswordHash = PasswordHash { pwHash :: [Word8]
                                 , pwSalt :: [Word8]
                                 }
    deriving (Typeable, Data)
 
instance Version PasswordHash
$(deriveSerialize ''PasswordHash)

A PasswordHash is the hash itself, along with the salt used when computing it. The deriving (Typeable, Data) and the rest is part of Happstack.State’s deep magic, which we don’t need to worry about for this example.

The actual hashing of a password is performed by this function, which takes a salt value and the password, and computes its hash:

hashPassword :: [Word8] -> String -> [Word8]
hashPassword salt password =
        let passBytes = listToOctets $ map ord password
        in  (iterate step passBytes) !! iterationCount
    where iterationCount = 100
          step chain = SHA512.hash (chain ++ salt)

That function converts the password into a series of bytes and repeatedly appends the salt and runs it through the SHA-512 hash function, returning the result after doing that 100 times.

That’s enough about passwords for now. Next, let’s consider what information we want to store about each user. For this example, we’ll only care about the user’s password (hashed, of course), along with the time they first registered an account:

data UserInfo = UserInfo { usPassword :: PasswordHash
                         , usJoined   :: ClockTime
                         }
    deriving (Typeable, Data)
 
instance Version UserInfo
$(deriveSerialize ''UserInfo)

The user directory itself will just be a map from user names to the information for each user:

newtype UserDirectory = UserDirectory (M.Map String UserInfo)
    deriving (Typeable, Data)
 
instance Version UserDirectory
$(deriveSerialize ''UserDirectory)
 
instance Component UserDirectory where
    type Dependencies UserDirectory = End
    initialValue = UserDirectory M.empty

Since the user directory is the thing we’re actually going to put into the MACID store, there’s a few extra lines of boilerplate at the bottom to say what other MACID stores it depends on (none) and what the contents of a brand-new store is (empty).

That’s about all there is to defining what goes into the MACID store itself. Next, we need to define the operations that either query the store without changing it, or update the store to a new value.

Let’s start with an easy one: a query that returns a list of users, paired with the date their account was created:

listUsers :: Query UserDirectory [(String, ClockTime)]
listUsers = do
    UserDirectory dir <- ask
    return $ M.toList $ M.map usJoined dir

The type signature is perhaps the most interesting part: Query UserDirectory [(String, ClockTime)]. This is a read-only query (Query) that operates on a UserDirectory and returns a list of (String, ClockTime) pairs. The implementation of the function is simple: get the current value of the store using ask, then iterate over the map to get the user names and dates.

Here’s a more sophisticated query, one that takes a user name and password and sees if the password is correct:

checkPassword :: String -> String -> Query UserDirectory Bool
checkPassword name pass = do
    UserDirectory dir <- ask
    case M.lookup name dir of
        Nothing       -> return False
        Just userInfo -> let PasswordHash hash salt = usPassword userInfo
                         in  return $ hash == hashPassword salt pass

Again, the type signature (String -> String -> Query UserDirectory Bool) shows this is a query on our UserDirectory, this time taking two strings (user name and password) as arguments and returning a boolean value. The code looks up the UserInfo, if any, associated with the user, gets the salt, hashes the password provided as an argument to the query, and returns whether the two match.

Of course, it would help if we had a way to add users to the store. That’s what this update operation does:

addUser :: String -> String -> Update UserDirectory Bool
addUser name pass = do
    UserDirectory dir <- get
    if M.member name dir
        then return False
        else do salt <- newSalt
                now <- liftM fixEventClockTime getEventClockTime
                let passwordHash = PasswordHash (hashPassword salt pass) salt
                let userInfo = UserInfo passwordHash now
                put $ UserDirectory $ M.insert name userInfo dir
                return True

Since this is an update, the type signature has Update in it instead of Query. This means instead of using ask to get the current state, we use get to get the current state and put to set it to a new value. The code itself first checks if a user by the name already exists, and if not, creates a new UserInfo structure with the user’s hashed password and the time that the update was made.

A couple things are worth pointing out. First, inside a Query or Update, we can use the MACID store as a random number generator, which is how a new salt is generated for the user:

instance Random Word8 where
    randomR (lo, hi) rng = let (val, rng') = randomR (fromIntegral lo, fromIntegral hi) rng
                               val :: Int
                           in  (fromIntegral val, rng')
    random rng = randomR (minBound, maxBound) rng
 
newSalt :: AnyEv [Word8]
newSalt = sequence $ take saltLength $ repeat getRandom
    where saltLength = 10

AnyEv is a monad that both Query and Update work with. The newSalt function generates 10 random bytes by first generating an infinite list of monadic computations that return random numbers (repeat getRandom), throwing away all but the first ten of them (take saltLength), and finally combining them into a single monadic computation that returns a list of random bytes (sequence) (instead of a list of monadic computations that each returns one random byte).

Annoyingly, Haskell doesn’t provide a direct way to generate random bytes (of type Word8), so we have to manually specify how Word8 implements the Random typeclass. The implementation is straightforward: to generate a random byte, first generate a random integer, and then convert it to a byte.

Returning to the update function, it’s also worth noting that getEventClockTime returns the time at which the update was logged, not the time the update is executing! This is because the MACID store doesn’t save a new copy of the state to disk every time it changes. Instead, it saves a log of what updates were made. If the program terminates abnormally before the state can be checkpointed, the MACID store recovers by loading the most recent checkpoint and re-executing all the updates since then. This is how the MACID store provides durability without completely thrashing the disk.

The astute reader will note that, if we ever do need to replay the addUser update, newSalt will be executed again! Does this mean that an update that uses the RNG could get different values during recovery? As it turns out, the MACID store also saves the state of the RNG, so replaying the update during recovery will generate the same random numbers that were obtained from the original execution of the update. The particularly astute reader will conclude that the MACID store’s RNG is unsuitable for generating cryptographic keys, since an attacker with access to the MACID store’s backing files can predict what the RNG will return. Fortunately, we don’t care if the salt is predictable, just that it’s different for each user.

OK, enough of that. There’s just one little piece of deep magic we need to convert those functions into honest-to-goodness transaction handlers for the MACID store:

$(mkMethods ''UserDirectory ['addUser, 'checkPassword, 'listUsers])

That bit of magic generates a type constructor for each transaction function. When invoking a transaction, instead of calling the functions themselves, we create an object to represent the request, and then pass it to query or update as appropriate.

Here’s an example of using our new MACID store. The following implements a simple command interpreter that lets us manipulate our user directory:

commandLoop :: MVar TxControl -> IO ()
commandLoop state = do
        putStr "> "
        hFlush stdout
        command <- liftM words getLine
        processCommand state command
    where processCommand state ["list"] = do
                    people <- query ListUsers
                    mapM_ (putStrLn . showUser) people
                    commandLoop state
          processCommand state ["add", user, pass] = do
                    success <- update $ AddUser user pass
                    putStrLn $ if success then "User added" else "User already exists"
                    commandLoop state
          processCommand state ["login", user, pass] = do
                    success <- query $ CheckPassword user pass
                    putStrLn $ if success then "Success" else "Bad account or password"
                    commandLoop state
          processCommand state ["checkpoint"] = do
                    createCheckpoint state
                    commandLoop state
          processCommand _     ["quit"] = return ()
          processCommand state _        = do
                    putStrLn "Unrecognized command"
                    commandLoop state
          showUser (name, joined) = name ++ " (joined " ++ show joined ++ ")"
 
macidProxy :: Proxy UserDirectory
macidProxy = Proxy
 
main :: IO ()
main = startSystemState macidProxy >>= commandLoop

Note how, for example, instead of calling addUser user pass, we do update $ AddUser user pass, where the AddUser type constructor was generated automatically and takes the same arguments as addUser. The update function does all the work of invoking addUser and making sure the result gets saved to the MACID store which enforcing all the ACID guarantees.

Instead of walking through how the command interpreter works, here’s a sample session, which should give you the idea:

> list
> add paul swordfish
User added
> list
paul (joined Sun Apr  5 20:00:01 EDT 2009)
> add cowboy sourMilk7
User added
> list
cowboy (joined Sun Apr  5 20:00:13 EDT 2009)
paul (joined Sun Apr  5 20:00:01 EDT 2009)
> login paul notHisPassword
Bad account or password
> login nobody foobar
Bad account or password
> login paul swordfish
Success
> quit

The files backing the MACID store are, by default, in the _local directory under where you ran the program from: current-0000000000, the initial checkpoint of the (empty) user directory we started with; and events-0000000000, the log of all the updates that were applied. If we had created a checkpoint, it would be in the directory too.

Now, quiz time. Not counting all the security problems I already mentioned in The Button that apply equally well to this example, there is an additional security flaw in the above code that could let an attacker steal passwords with little effort on his part. Your quiz has two questions:

  1. How can the attacker steal passwords from the MACID store?
  2. How can we change the program to prevent him from doing so?

For your convenience, here is Vulnerable.hs, the complete example described in the above post. Assuming you’ve installed GHC 6.10 and Happstack on your computer, just do “runghc Vulnerable.hs” to try the program out yourself.

Next time: the answers to the quiz.

]]>
http://www.kuliniewicz.org/blog/archives/2009/04/05/happstackstate-the-basics/feed/ 0
The Button is down http://www.kuliniewicz.org/blog/archives/2009/04/03/the-button-is-down/ http://www.kuliniewicz.org/blog/archives/2009/04/03/the-button-is-down/#comments Sat, 04 Apr 2009 02:42:30 +0000 http://www.kuliniewicz.org/blog/?p=1267 As some of you have already noticed, The Button is down and not coming back anytime soon, for several reasons.

First, and most obviously, it was in part an April Fools’ Day prank making fun of Twitter: a microblogging platform with a zero-character limit. I was hoping that “femtoblogging” would be a unique name, but as it turns out for each of the sub-micro SI prefixes, there are plenty of hits for prefixblog, from nanoblog down to yoctoblog.

Second, and primarily, I wrote it to get a feel for developing web apps in Happstack, a Haskell-based application server development framework. The Button was trivial enough to be implemented over a weekend (plus a little polishing the following Monday evening), but nontrivial enough to let me play around with several features and get a better understanding of why the examples are organized the way they are. I definitely learned some things in writing The Button, which I’ll regale you with in the next few posts.

Third, and most pragmatically, the actual hosting of The Button was an ugly ugly hack. Happstack requires GHC 6.10 (the Haskell compiler), and although my web host does indeed have GHC pre-installed, it only had version 6.6. I tried compiling the latest version of GHC from source, but that failed once it exhausted the remaining 200 MB of my disk quota. Downloading precompiled binaries was also impossible since the unpacked tarballs for those also required more than 200 MB of disk. While I don’t foresee any issues in getting my quota increased, since I was trying to do this the evening of March 31, I couldn’t count on the turnaround time of the request being quick enough.

In short, The Button was running off queeg, my laptop. The domain button.kuliniewicz.org was pointing to my home connection. (It doesn’t anymore; it’s currently acting as a synonym for www.kuliniewicz.org, which I need to fix.) In case you were wondering why it was running on a high-numbered port, that’s why — there’s no way I was going to run a largely untested server as root on my home machine and open it to the world! Naturally, using my laptop as a web server was hardly a long-term solution, so once April 1 passed I took it down.

Fourth, and most security-consciously, The Button’s password security was a joke. Other than storing them with strong, randomly salted, strengthened hashes, it was bad. Passwords were transmitted to the server in the clear. There were no checks whatsoever for strong passwords. Nor was there any protection against online brute force attacks (which, incidentally, Twitter fell victim to earlier this year, with little “happiness” to be had by that compromised admin account).

So, I hope those of you who did actually register accounts with The Button didn’t use the same password you use for anything important.

If I had had more than a weekend to work on The Button, I would’ve addressed those issues, but I simply ran out of time. I couldn’t in good conscience continue running a server with that many security vulnerabilities once the joke had passed. That’s also why I’m reluctant to post the code that implemented The Button unless someone really wants to see it. It’s not of good enough quality for someone to use as the basis of something real.

If for some reason you actually think The Button, or femtoblogging in general, actually has potential (I can actually think of one or two legitimate use cases for it, though I can also come up with better solutions for those use cases), I’ve demonstrated you can implement the core functionality over a weekend, even if you aren’t particularly well-versed in the framework or the language you’re using.

]]>
http://www.kuliniewicz.org/blog/archives/2009/04/03/the-button-is-down/feed/ 2