diff --git a/CHANGES.txt b/CHANGES.txt
--- a/CHANGES.txt
+++ b/CHANGES.txt
@@ -1,5 +1,8 @@
 Changelog for Bake
 
+0.5
+    Allow extra-1.5.1
+    #19, support much bigger files
 0.4
     Remove the --author parameter from many operations
     Rewrite notifications
diff --git a/LICENSE b/LICENSE
--- a/LICENSE
+++ b/LICENSE
@@ -1,4 +1,4 @@
-Copyright Neil Mitchell 2014-2015.
+Copyright Neil Mitchell 2014-2016.
 All rights reserved.
 
 Redistribution and use in source and binary forms, with or without
diff --git a/README.md b/README.md
--- a/README.md
+++ b/README.md
@@ -36,16 +36,16 @@
 The test suite provides both [an example configuration](https://github.com/ndmitchell/bake/blob/master/src/Example.hs) and [commands to drive it](https://github.com/ndmitchell/bake/blob/master/src/Test.hs). Here we annotate a slightly simplified version of the example, for lists of imports see the original code.
 
 First we define an enumeration for where we want tests to run. Our server is going to require tests on both Windows and Linux before a `patch` is accepted.
-
+```haskell
     data Platform = Linux | Windows deriving (Show,Read)
     platforms = [Linux,Windows]
-
+```
 Next we define the `test` type. A `test` is something that must pass before a `patch` is accepted.
-
+```haskell
     data Action = Compile | Run Int deriving (Show,Read)
-
+```
 Our type is named `Action`. We have two distinct types of tests, compiling the code, and running the result with a particular argument. Now we need to supply some information about the tests:
-
+```haskell
     allTests = [(p,t) | p <- platforms, t <- Compile : map Run [1,10,0]]
     
     execute :: (Platform,Action) -> TestInfo (Platform,Action)
@@ -53,9 +53,9 @@
         cmd "ghc --make Main.hs"
     execute (p,Run i) = require [(p,Compile)] $ matchOS p $ run $ do
         cmd ("." </> "Main") (show i)
-
+```
 We have to declare `allTests`, then list of all tests that must pass, and `execute`, which gives information about a test. Note that the `test` type is `(Platform,Action)`, so a test is a platform (where to run the test) and an `Action` (what to run). The `run` function gives an `IO` action to run, and `require` specifies dependencies. We use an auxiliary `matchOS` to detect whether a test is running on the right platform:
-
+```haskell
     #if WINDOWS
     myPlatform = Windows
     #else
@@ -64,15 +64,15 @@
 
     matchOS :: Platform -> TestInfo t -> TestInfo t
     matchOS p = suitable (return . (==) myPlatform)
-
+```
 We use the `suitable` function to declare whether a test can run on a particular client. Finally, we define the `main` function:
-
+```haskell
     main :: IO ()
     main = bake $
         ovenGit "http://example.com/myrepo.git" "master" $
         ovenTest readShowStringy (return allTests) execute
         defaultOven{ovenServer=("127.0.0.1",5000)}
-
+```
 We define `main = bake`, then fill in some configuration. We first declare we are working with Git, and give a repo name and branch name. Next we declare what the tests are, passing the information about the tests. Finally we give a host/port for the server, which we can visit in a web browser or access via the HTTP API.
 
 
diff --git a/bake.cabal b/bake.cabal
--- a/bake.cabal
+++ b/bake.cabal
@@ -1,13 +1,13 @@
-cabal-version:      >= 1.10
+cabal-version:      >= 1.18
 build-type:         Simple
 name:               bake
-version:            0.4
+version:            0.5
 license:            BSD3
 license-file:       LICENSE
 category:           Development
 author:             Neil Mitchell <ndmitchell@gmail.com>
 maintainer:         Neil Mitchell <ndmitchell@gmail.com>
-copyright:          Neil Mitchell 2014-2015
+copyright:          Neil Mitchell 2014-2016
 synopsis:           Continuous integration system
 description:
     Bake is a continuous integration server, designed for large, productive, semi-trusted teams.
@@ -19,7 +19,7 @@
     * /Semi-trusted teams/ where code does not go through manual code review, but code does need to pass a test suite and perhaps some static analysis. People are assumed not to be malicious, but are fallible.
 homepage:           https://github.com/ndmitchell/bake#readme
 bug-reports:        https://github.com/ndmitchell/bake/issues
-tested-with:        GHC==7.10.1, GHC==7.8.4, GHC==7.6.3
+tested-with:        GHC==8.0.1, GHC==7.10.3, GHC==7.8.4, GHC==7.6.3
 
 extra-doc-files:
     CHANGES.txt
@@ -46,11 +46,14 @@
         time,
         random,
         hashable,
-        transformers,
+        transformers >= 0.4,
         HTTP,
         safe,
         old-locale,
+        http-conduit,
+        http-client,
         http-types,
+        wai-extra,
         deepseq,
         filepath,
         aeson,
@@ -59,7 +62,7 @@
         disk-free-space,
         unordered-containers,
         smtp-mail,
-        extra >= 1.1,
+        extra >= 1.5.1,
         wai >= 3.0.1,
         warp >= 3.0
 
@@ -87,6 +90,7 @@
         Development.Bake.Server.Stats
         Development.Bake.Server.Store
         Development.Bake.Server.Web
+        General.BigString
         General.Database
         General.Extra
         General.HTML
@@ -116,7 +120,10 @@
         hashable,
         HTTP,
         safe,
+        http-client,
+        http-conduit,
         http-types,
+        wai-extra,
         transformers,
         deepseq,
         aeson,
diff --git a/src/Development/Bake/Build.hs b/src/Development/Bake/Build.hs
--- a/src/Development/Bake/Build.hs
+++ b/src/Development/Bake/Build.hs
@@ -32,7 +32,7 @@
                 whenM (doesFileExist $ ".." </> src </> ".bake.incremental") $ do
                     putStrLn $ "Preparing by copying from " ++ src
                     timed "copying for ovenIncremental" $
-                        unit $ cmd "cp --preserve=timestamps --recursive --no-target-directory" ("../" ++ src) "."
+                        cmd "cp --preserve=timestamps --recursive --no-target-directory" ("../" ++ src) "."
 
 incrementalStart :: IO ()
 incrementalStart =
diff --git a/src/Development/Bake/Core/Args.hs b/src/Development/Bake/Core/Args.hs
--- a/src/Development/Bake/Core/Args.hs
+++ b/src/Development/Bake/Core/Args.hs
@@ -118,13 +118,9 @@
                         (stringyFrom state)
                         (map stringyFrom patch)
 
-                    -- check the patches all make sense
-                    let follow t = map stringyTo $ testDepend $ ovenTestInfo oven $ stringyFrom t
-                    whenJust (findCycle follow $ map stringyTo res) $ \xs ->
-                        error $ unlines $ "Tests form a cycle:" : xs
-                    let missing = transitiveClosure follow (map stringyTo res) \\ map stringyTo res
-                    when (missing /= []) $
-                        error $ unlines $ "Test is a dependency that cannot be reached:" : missing
+                    case validTests (ovenTestInfo oven) res of
+                        Left err -> fail err
+                        Right () -> return ()
 
                     writeFile ".bake.result" $ show $ map stringyTo res
                 Just test -> do
diff --git a/src/Development/Bake/Core/Client.hs b/src/Development/Bake/Core/Client.hs
--- a/src/Development/Bake/Core/Client.hs
+++ b/src/Development/Bake/Core/Client.hs
@@ -14,7 +14,6 @@
 import Data.IORef
 import Data.Tuple.Extra
 import System.Environment.Extra
-import qualified Data.Text.Lazy as TL
 
 
 -- given server, name, threads
@@ -50,7 +49,6 @@
                     ,"Id: " ++ show i
                     ,"Result: " ++ (if aSuccess then "Success" else "Failure")
                     ,"Duration: " ++ maybe "none" showDuration aDuration
-                    ,"Output: " ++ TL.unpack aStdout
                     ]
                 atomicModifyIORef nowThreads $ \now -> (now + qThreads, ())
                 sendMessage hp $ Finished q a
diff --git a/src/Development/Bake/Core/GC.hs b/src/Development/Bake/Core/GC.hs
--- a/src/Development/Bake/Core/GC.hs
+++ b/src/Development/Bake/Core/GC.hs
@@ -8,9 +8,9 @@
 import System.FilePath
 import Control.Monad.Extra
 import Control.Applicative
+import Data.Time.Clock
 import Data.Either.Extra
 import Data.List.Extra
-import System.Time.Extra
 import Data.Maybe
 import System.DiskSpace
 import Prelude
@@ -59,7 +59,7 @@
     now <- getCurrentTime
     let f gen file = fmap eitherToMaybe $ try_ $ do
             t <- getModificationTime file
-            return $ gen $ now `subtractTime` t
+            return $ gen $ fromRational $ toRational $ now `diffUTCTime` t
 
     fmap (concatMap catMaybes) $ forM dirs $ \dir -> do
         dirs <- listContents dir
diff --git a/src/Development/Bake/Core/Message.hs b/src/Development/Bake/Core/Message.hs
--- a/src/Development/Bake/Core/Message.hs
+++ b/src/Development/Bake/Core/Message.hs
@@ -7,13 +7,13 @@
 
 import Development.Bake.Core.Type
 import General.Web
+import General.BigString
 import Control.Applicative
 import Control.Monad
 import Control.DeepSeq
 import Data.Aeson hiding (Success)
 import System.Time.Extra
 import Safe
-import qualified Data.Text.Lazy as TL
 import qualified Data.ByteString.Lazy.Char8 as LBS
 import Prelude
 
@@ -31,7 +31,7 @@
     -- Sent by the client
     | Pinged Ping
     | Finished {question :: Question, answer :: Answer}
-    deriving (Show,Eq)
+    deriving Show
 
 instance NFData Message where
     rnf (AddPatch x y) = rnf x `seq` rnf y
@@ -57,12 +57,12 @@
     rnf (Question a b c d) = rnf (a,b,c,d)
 
 data Answer = Answer
-    {aStdout :: TL.Text
+    {aStdout :: BigString
     ,aDuration :: Maybe Seconds -- Nothing for a skip
     ,aTests :: [Test]
     ,aSuccess :: Bool
     }
-    deriving (Show,Eq)
+    deriving Show
 
 instance NFData Answer where
     rnf (Answer a b c d) = rnf a `seq` rnf b `seq` rnf c `seq` rnf d
@@ -79,16 +79,7 @@
 instance NFData Ping where
     rnf (Ping a b c d e) = rnf a `seq` rnf b `seq` rnf c `seq` rnf d `seq` rnf e
 
--- JSON instance is only true for Finished
-instance ToJSON Message where
-    toJSON (Finished q a) = object ["question" .= q, "answer" .= a]
-    toJSON _ = error "ToJSON Message is only supported for Finished"
 
-instance FromJSON Message where
-    parseJSON (Object v) = Finished <$>
-        (v .: "question") <*> (v .: "answer")
-    parseJSON _ = mzero
-
 instance ToJSON Question where
     toJSON Question{..} = object
         ["candidate" .= toJSONCandidate qCandidate
@@ -106,33 +97,30 @@
 fromJSONCandidate (Object v) = (,) <$> (v .: "state") <*> (v .: "patches")
 fromJSONCandidate _ = mzero
 
-instance ToJSON Answer where
-    toJSON Answer{..} = object
-        ["stdout" .= aStdout
-        ,"duration" .= aDuration
-        ,"tests" .= aTests
-        ,"success" .= aSuccess]
 
-instance FromJSON Answer where
-    parseJSON (Object v) = Answer <$>
-        (v .: "stdout") <*> (v .: "duration") <*> (v .: "tests") <*> (v .: "success")
-    parseJSON _ = mzero
-
-
 messageToInput :: Message -> Input
-messageToInput (AddPatch author patch) = Input ["api","add"] [("author",author),("patch",fromPatch patch)] ""
-messageToInput (DelPatch patch) = Input ["api","del"] [("patch",fromPatch patch)] ""
-messageToInput Requeue = Input ["api","requeue"] [] ""
-messageToInput (SetState author state) = Input ["api","set"] [("author",author),("state",fromState state)] ""
-messageToInput Pause = Input ["api","pause"] [] ""
-messageToInput Unpause = Input ["api","unpause"] [] ""
-messageToInput (AddSkip author test) = Input ["api","addskip"] [("author",author),("test",fromTest test)] ""
-messageToInput (DelSkip test) = Input ["api","delskip"] [("test",fromTest test)] ""
+messageToInput (AddPatch author patch) = Input ["api","add"] [("author",author),("patch",fromPatch patch)] []
+messageToInput (DelPatch patch) = Input ["api","del"] [("patch",fromPatch patch)] []
+messageToInput Requeue = Input ["api","requeue"] [] []
+messageToInput (SetState author state) = Input ["api","set"] [("author",author),("state",fromState state)] []
+messageToInput Pause = Input ["api","pause"] [] []
+messageToInput Unpause = Input ["api","unpause"] [] []
+messageToInput (AddSkip author test) = Input ["api","addskip"] [("author",author),("test",fromTest test)] []
+messageToInput (DelSkip test) = Input ["api","delskip"] [("test",fromTest test)] []
 messageToInput (Pinged Ping{..}) = Input ["api","ping"] 
     ([("client",fromClient pClient),("author",pAuthor)] ++
      [("provide",x) | x <- pProvide] ++
-     [("maxthreads",show pMaxThreads),("nowthreads",show pNowThreads)]) ""
-messageToInput x@Finished{} = Input ["api","finish"] [] $ encode x
+     [("maxthreads",show pMaxThreads),("nowthreads",show pNowThreads)]) []
+messageToInput (Finished Question{..} Answer{..}) = Input ["api","finish"] []
+    [("state", bigStringFromString $ fromState $ fst qCandidate)
+    ,("patch", bigStringFromString $ unlines $ map fromPatch $ snd qCandidate)
+    ,("test", bigStringFromString $ maybe "" fromTest qTest)
+    ,("threads", bigStringFromString $ show qThreads)
+    ,("client", bigStringFromString $ fromClient qClient)
+    ,("stdout", aStdout)
+    ,("duration", bigStringFromString $ maybe "" show aDuration)
+    ,("tests", bigStringFromString $ unlines $ map fromTest aTests)
+    ,("success", bigStringFromString $ show aSuccess)]
 
 
 -- return either an error message (not a valid message), or a message
@@ -148,11 +136,23 @@
     | msg == "unpause" = pure Unpause
     | msg == "ping" = Pinged <$> (Ping <$> (toClient <$> str "client") <*>
         str "author" <*> strs "provide" <*> int "maxthreads" <*> int "nowthreads")
-    | msg == "finish" = eitherDecode body
     where strs x = Right $ map snd $ filter ((==) x . fst) args
           str x | Just v <- lookup x args = Right v
                 | otherwise = Left $ "Missing field " ++ show x ++ " from " ++ show msg
           int x = readNote "messageFromInput, expecting Int" <$> str x
+messageFromInput (Input [msg] args body)
+    | msg == "finish" = do
+        let f x = case lookup x body of Nothing -> Left $ "Missing field " ++ show x ++ " from " ++ show (map fst body); Just x -> Right x
+        state <- toState . bigStringToString <$> f "state"
+        patch <- map toPatch . lines . filter (/= '\r') . bigStringToString <$> f "patch"
+        qTest <- (\x -> if null x then Nothing else Just $ toTest x) . bigStringToString <$> f "test"
+        qThreads <- read . bigStringToString <$> f "threads"
+        qClient <- toClient . bigStringToString <$> f "client"
+        aStdout <- f "stdout"
+        aDuration <- (\x -> if null x then Nothing else Just $ read x) . bigStringToString <$> f "duration"
+        aTests <- map toTest . lines . filter (/= '\r') . bigStringToString <$> f "tests"
+        aSuccess <- read . bigStringToString <$> f "success"
+        return $ Finished Question{qCandidate=(state,patch),..} Answer{..}
 messageFromInput (Input msg args body) = Left $ "Invalid API call, got " ++ show msg
 
 
diff --git a/src/Development/Bake/Core/Run.hs b/src/Development/Bake/Core/Run.hs
--- a/src/Development/Bake/Core/Run.hs
+++ b/src/Development/Bake/Core/Run.hs
@@ -8,9 +8,12 @@
 import Development.Bake.Core.Message
 import Development.Shake.Command
 import Control.Exception.Extra
+import General.BigString
 import General.Extra
 import System.Time.Extra
 import Control.DeepSeq
+import Control.Concurrent.Extra
+import System.IO.Unsafe
 import Data.Tuple.Extra
 import System.IO.Extra
 import System.Environment.Extra
@@ -22,6 +25,11 @@
 import qualified Data.Text.Lazy as TL
 
 
+{-# NOINLINE running #-}
+running :: Var Int
+running = unsafePerformIO $ newVar 0
+
+
 state x = "--state=" ++ fromState x
 patch x = "--patch=" ++ fromPatch x
 test  x = "--test="  ++ fromTest  x
@@ -48,14 +56,21 @@
 
     (time, res) <- duration $ try_ $ do
         exe <- getExecutablePath
-        (exit, Stdouterr out) <- cmd (Cwd dir) exe ("run" ++ name) args1 args2
+        (out, exit) <- bigStringFromFile $ \file -> do
+            res <- bracket_ (modifyVar_ running $ return . succ) (modifyVar_ running $ return . pred) $ do
+                v <- readVar running
+                print $ "RUNNING = " ++ show v
+                cmd [Cwd dir, FileStdout file, FileStderr file] exe ("run" ++ name) args1 args2
+            v <- readVar running
+            print $ "RUNNING = " ++ show v
+            return res
         ex <- if exit /= ExitSuccess then return Nothing else do
             ans <- fmap parse $ readFile' $ dir </> ".bake.result"
             evaluate $ rnf ans
             return $ Just ans
-        return (ex, Answer (TL.pack out) (Just 0) [] (exit == ExitSuccess))
+        return (ex, Answer out (Just 0) [] (exit == ExitSuccess))
     case res of
         Left e -> do
             e <- showException e
-            return (Nothing, Answer (TL.pack e) (Just time) [] False)
+            return (Nothing, Answer (bigStringFromString e) (Just time) [] False)
         Right (ex,ans) -> return (ex, ans{aDuration=Just time})
diff --git a/src/Development/Bake/Core/Type.hs b/src/Development/Bake/Core/Type.hs
--- a/src/Development/Bake/Core/Type.hs
+++ b/src/Development/Bake/Core/Type.hs
@@ -1,5 +1,5 @@
 {-# LANGUAGE RecordWildCards, GeneralizedNewtypeDeriving, ScopedTypeVariables, DeriveDataTypeable #-}
-{-# LANGUAGE TypeSynonymInstances, FlexibleInstances #-}
+{-# LANGUAGE TypeSynonymInstances, FlexibleInstances, ViewPatterns #-}
 
 -- | Define a continuous integration system.
 module Development.Bake.Core.Type(
@@ -14,6 +14,7 @@
     Client, toClient, fromClient,
     Point,
     concrete, Prettys(..),
+    validTests,
     Author
     ) where
 
@@ -219,3 +220,12 @@
         check s | null $ stringyTo s = error "Problem with stringyTo/stringyFrom, generated blank string"
                 | stringyTo s == stringyTo (stringyFrom (stringyTo s) :: o) = s
                 | otherwise = error $ "Problem with stringyTo/stringyFrom on " ++ stringyTo s
+
+
+-- | Check a set of tests is valid - no cycles and no dependencies that cannot be satisfied
+validTests :: Stringy test => (test -> TestInfo test) -> [test] -> Either String ()
+validTests info (map stringyTo -> res)
+    | Just xs <- findCycle follow res = Left $ unlines $ "Tests form a cycle:" : xs
+    | missing@(_:_) <- transitiveClosure follow res \\ res = Left $ unlines $ "Test is a dependency that cannot be reached:" : missing
+    | otherwise = Right ()
+    where follow t = map stringyTo $ testDepend $ info $ stringyFrom t
diff --git a/src/Development/Bake/Git.hs b/src/Development/Bake/Git.hs
--- a/src/Development/Bake/Git.hs
+++ b/src/Development/Bake/Git.hs
@@ -1,7 +1,7 @@
 {-# LANGUAGE ViewPatterns #-}
 
 module Development.Bake.Git(
-    SHA1(..), sha1, ovenGit,
+    SHA1, fromSHA1, toSHA1, ovenGit,
     gitPatchExtra, gitInit
     ) where
 
@@ -21,19 +21,29 @@
 import Prelude
 
 
-newtype SHA1 = SHA1 {fromSHA1 :: String} deriving (Show,Eq)
+data SHA1 = SHA1 Int String deriving (Show,Eq) -- a number of leading primes, followed by a valid SHA1
 
-sha1 :: String -> SHA1
-sha1 x | length x /= 40 = error $ "SHA1 for Git must be 40 characters long, got " ++ show x
-       | not $ all (`elem` "0123456789abcdef") x = error $ "SHA1 for Git must be all lower case hex, got " ++ show x 
-       | otherwise = SHA1 x
+-- | Convert a SHA1 obtained from Git into a SHA1. Only done by ovenInit or ovenUpdate
+toSHA1 :: String -> SHA1
+toSHA1 x = checkSHA1 x $ SHA1 0 x
 
+fromSHA1 :: SHA1 -> String
+fromSHA1 (SHA1 _ x) = x
+
 instance Stringy SHA1 where
-    stringyTo = fromSHA1
-    stringyPretty = take 7 . fromSHA1
-    stringyFrom = sha1
+    stringyFrom x = checkSHA1 b $ SHA1 (length a) b
+        where (a,b) = span (== '\'') x
+    stringyTo (SHA1 primes sha) = replicate primes '\'' ++ sha
+    stringyPretty (SHA1 primes sha) = replicate primes '\'' ++ take 7 sha
 
+-- either returns the second argument, or raises an error
+checkSHA1 :: String -> a -> a
+checkSHA1 x res
+    | length x /= 40 = error $ "SHA1 for Git must be 40 characters long, got " ++ show x
+    | not $ all (`elem` "0123456789abcdef") x = error $ "SHA1 for Git must be all lower case hex, got " ++ show x
+    | otherwise = res
 
+
 -- | Modify an 'Oven' to work with the Git version control system.
 --   Requires the name of the repo (e.g. @https:\/\/github.com\/ndmitchell\/bake.git@)
 --   and the name of a branch (e.g. @master@). You can optionally give a path fragment
@@ -69,7 +79,7 @@
             gitCheckout s ps
             Stdout x <- time $ cmd (Cwd path) "git rev-parse" [branch]
             time_ $ cmd (Cwd path) "git push" [repo] [branch ++ ":" ++ branch]
-            return $ sha1 $ trim x
+            return $ toSHA1 $ trim x
 
         gitCheckout s ps = traced "gitCheckout" $ do
             createDirectoryIfMissing True path
@@ -96,7 +106,7 @@
     Stdout hash <- time $ cmd "git ls-remote" [repo] [branch]
     case words $ concat $ takeEnd 1 $ lines hash of
         [] -> error "Couldn't find branch"
-        x:xs -> return $ sha1 $ trim x
+        x:xs -> return $ toSHA1 $ trim x
 
 
 traced :: String -> IO a -> IO a
@@ -118,13 +128,13 @@
     return (renderHTML $ do str_ $ count ++ " patches"; br_; str_ summary
            ,renderHTML $ pre_ $ str_ full)
 
-gitPatchExtra (SHA1 s) (Just (SHA1 p)) dir = do
+gitPatchExtra s (Just p) dir = do
     Stdout diff <- time $ cmd (Cwd dir)
-        "git diff" [s ++ "..." ++ p]
+        "git diff" [fromSHA1 s ++ "..." ++ fromSHA1 p]
     Stdout stat <- time $ cmd (Cwd dir)
-        "git diff --stat" [s ++ "..." ++ p]
+        "git diff --stat" [fromSHA1 s ++ "..." ++ fromSHA1 p]
     Stdout log <- time $ cmd (Cwd dir)
-        "git log --no-merges -n1 --pretty=format:%s" [p]
+        "git log --no-merges -n1 --pretty=format:%s" [fromSHA1 p]
     return (renderHTML $ do str_ $ reduceStat stat; br_; str_ $ take 120 $ takeWhile (/= '\n') log
            ,renderHTML $ pre_ $ do prettyStat stat; str_ "\n"; prettyDiff diff)
 
diff --git a/src/Development/Bake/Server/Brain.hs b/src/Development/Bake/Server/Brain.hs
--- a/src/Development/Bake/Server/Brain.hs
+++ b/src/Development/Bake/Server/Brain.hs
@@ -12,6 +12,7 @@
 import Development.Bake.Core.Type
 import Development.Bake.Core.Message
 import General.Extra
+import General.BigString
 import Data.Tuple.Extra
 import Data.Maybe
 import Data.Monoid
@@ -20,7 +21,6 @@
 import qualified Data.Map as Map
 import qualified Data.Set as Set
 import Development.Bake.Server.Store
-import qualified Data.Text.Lazy as TL
 import Control.Exception.Extra
 import General.HTML
 import Prelude
@@ -49,8 +49,8 @@
                 Pinged p | null $ fatal mem, Just q <- output (ovenTestInfo $ oven mem) mem p ->
                     case () of
                         -- we still test things on the skip list when testing on a state (to get some feedback)
-                        _ | Just t <- qTest q, snd (qCandidate q) /= [], Just reason <- Map.lookup t (storeSkip $ store mem) ->
-                            prod mem $ Finished q $ Answer (TL.pack $ "Skipped due to being on the skip list\n" ++ reason) Nothing [] True
+                        _ | Just t <- qTest q, snd (qCandidate q) /= [], Just reason <- Map.lookup t (storeSkip $ store mem) -> do
+                            prod mem $ Finished q $ Answer (bigStringFromString $ "Skipped due to being on the skip list\n" ++ reason) Nothing [] True
                         _ -> do
                             now <- getCurrentTime
                             return (mem{running = (now,q) : running mem}, Just $ Right q)
@@ -89,7 +89,7 @@
             Shower{..} <- shower mem False
             notify mem "Rejected"
                 [ (paAuthor,) $ do
-                    showPatch p <> str_ " submitted at " <> showTime paQueued
+                    showPatch p <> str_ " submitted by " <> str_ paAuthor <> str_ " at " <> showTime paQueued
                     str_ " rejected due to " <> showTestAt (point p) t
                     whenJust (failingTestOutput store (point p) t) $ \s ->
                         br_ <> br_ <> pre_ (summary s)
@@ -106,7 +106,7 @@
         -- don't notify people twice in quick succession
         bad <- if mergeable mem then return id else
             notify mem "Plausible"
-                [ (paAuthor, showPatch p <> str_ " submitted at " <> showTime paQueued <> str_ " is now plausible")
+                [ (paAuthor, showPatch p <> str_ " submitted by " <> str_ paAuthor <> str_ " at " <> showTime paQueued <> str_ " is now plausible")
                 | p <- xs, let PatchInfo{..} = storePatch store p]
         store <- storeUpdate store $ map IUPlausible xs
         return $ bad mem{store = store}
@@ -114,17 +114,17 @@
     | mergeable mem
     , not $ null $ snd active
     = Just $ do
-        (s, answer) <-
-            if not simulated then uncurry runUpdate active
-            else do s <- ovenUpdate oven (fst active) (snd active); return (Just s, Answer mempty (Just 0) mempty True)
+        (s, answer) <- if not simulated then uncurry runUpdate active else do
+            s <- ovenUpdate oven (fst active) (snd active)
+            return (Just s, Answer mempty (Just 0) mempty True)
 
         case s of
             Nothing -> do
-                return mem{fatal = ("Failed to update\n" ++ TL.unpack (aStdout answer)) : fatal}
+                return mem{fatal = ("Failed to update\n" ++ bigStringToString (aStdout answer)) : fatal}
             Just s -> do
                 Shower{..} <- shower mem False
                 bad <- notify mem "Merged"
-                    [ (paAuthor, showPatch p <> str_ " submitted at " <> showTime paQueued <> str_ " is now merged")
+                    [ (paAuthor, showPatch p <> str_ " submitted by " <> str_ paAuthor <> str_ " at " <> showTime paQueued <> str_ " is now merged")
                     | p <- snd active, let PatchInfo{..} = storePatch store p]
                 store <- storeUpdate store $ IUState s answer (Just active) : map IUMerge (snd active)
                 return $ bad mem{active = (s, []), store = store}
@@ -138,9 +138,10 @@
     , extendActive mem
     , add@(_:_) <- Set.toList $ storeAlive store `Set.difference` Set.fromList (snd active)
     = Just $ do
+        add <- return $ sortOn (paQueued . storePatch store) add
         store <- storeUpdate store $ map IUStart add
         return mem
-            {active = (fst active, snd active ++ sortOn (paQueued . storePatch store) add)
+            {active = (fst active, snd active ++ add)
             ,store = store}
 
     | otherwise = Nothing
@@ -169,14 +170,15 @@
     if fst active == s then
         return $ Left "state is already at that value"
     else do
-        store <- storeUpdate store [IUState s (Answer (TL.pack $ "From SetState by " ++ author) Nothing [] True) Nothing]
+        store <- storeUpdate store [IUState s (Answer (bigStringFromString $ "From SetState by " ++ author) Nothing [] True) Nothing]
         return $ Right mem{store = store, active = (s, snd active)}
 
 update mem@Memory{..} Requeue = do
     let add = Set.toList $ storeAlive store `Set.difference` Set.fromList (snd active)
+    add <- return $ sortOn (paQueued . storePatch store) add
     store <- storeUpdate store $ map IUStart add
     return $ Right mem
-        {active = (fst active, snd active ++ sortOn (paAuthor . storePatch store) add)
+        {active = (fst active, snd active ++ add)
         ,store = store}
 
 update mem@Memory{..} Pause
@@ -216,9 +218,15 @@
             notifyAdmins mem "State failure" $ do
                 str_ "State " <> showState (fst qCandidate)
                 str_ " failed due to " <> showTestAt qCandidate qTest <> br_ <> br_
-                pre_ $ summary $ TL.unpack aStdout
+                pre_ (bigStringWithString aStdout summary)
         _ -> return id
 
+    case () of
+        _ | qTest == Nothing
+          , Left bad <- validTests (ovenTestInfo oven) aTests
+          -> fail bad
+        _ -> return ()
+
     now <- getCurrentTime
     let (eq,neq) = partition ((==) q . snd) running
     let time = head $ map fst eq ++ [now]
@@ -238,9 +246,12 @@
 2) anyone not done in active or a superset
 3) anyone not done in active
 -}
-output info mem@Memory{..} Ping{..} = -- trace (show (length bad, length good)) $
-        fmap question $ enoughThreads $ listToMaybe $ filter suitable $ nubOrd $ concatMap dependencies $ bad ++ good
+output info mem@Memory{..} Ping{..}
+    | False, pNowThreads == pMaxThreads, isNothing res = error $ show (enoughThreads $ listToMaybe $ filter suitable $ nubOrd $ concatMap dependencies $ bad ++ good, filter suitable good, concatMap dependencies $ bad ++ good, bad, good)
+    | otherwise = res
     where
+        res = fmap question $ enoughThreads $ listToMaybe $ filter suitable $ nubOrd $ concatMap dependencies $ bad ++ good
+
         self = storePoint store active
         failedSelf = Set.toList $ poFail self
         failedPrefix = Map.fromListWith mappend $
diff --git a/src/Development/Bake/Server/Database.hs b/src/Development/Bake/Server/Database.hs
--- a/src/Development/Bake/Server/Database.hs
+++ b/src/Development/Bake/Server/Database.hs
@@ -25,7 +25,6 @@
 import Database.SQLite.Simple
 import Database.SQLite.Simple.FromField
 import Database.SQLite.Simple.ToField
-import System.Time.Extra
 import Data.Hashable
 import Data.List.Extra
 import Control.Monad
diff --git a/src/Development/Bake/Server/Memory.hs b/src/Development/Bake/Server/Memory.hs
--- a/src/Development/Bake/Server/Memory.hs
+++ b/src/Development/Bake/Server/Memory.hs
@@ -89,7 +89,7 @@
 notifyAdmins mem subject message = notify mem subject $ map (,message) $ admins mem
 
 summary :: String -> HTML
-summary x | length x < 10000 = str_ x
+summary x | null $ drop 10000 x {- space efficient version of: length x < 10000 -} = str_ x
           | otherwise = str_ (take 5000 x) <> br_ <> str_ "..." <> br_ <> str_ (takeEnd 5000 x)
 
 data Shower = Shower
@@ -124,7 +124,7 @@
         ,showTest = f Nothing Nothing []
         ,showTestAt = \(s,ps) -> f Nothing (Just s) ps
         ,showQuestion = \Question{..} -> f (Just qClient) (Just $ fst qCandidate) (snd qCandidate) qTest
-        ,showTime = \x -> span__ [class_ "nobr"] $ str_ $ showUTCTime "%H:%M" x ++ " (" ++ showRel x ++ ")"
+        ,showTime = \x -> span__ [class_ "nobr"] $ str_ $ showUTCTime "%H:%M" x ++ " UTC (" ++ showRel x ++ ")"
         ,showThreads = \i -> str_ $ show i ++ " thread" ++ ['s' | i /= 1]
         }
     where
diff --git a/src/Development/Bake/Server/Start.hs b/src/Development/Bake/Server/Start.hs
--- a/src/Development/Bake/Server/Start.hs
+++ b/src/Development/Bake/Server/Start.hs
@@ -11,6 +11,7 @@
 import Development.Bake.Core.Message
 import Development.Bake.Core.Run
 import General.Extra
+import General.BigString
 import Development.Bake.Server.Brain
 import Development.Bake.Server.Web
 import Development.Bake.Server.Stats
@@ -87,7 +88,7 @@
 
                 else if ["api"] `isPrefixOf` inputURL then
                     case messageFromInput i{inputURL = drop 1 inputURL} of
-                        Left e -> return $ OutputError e
+                        Left e -> return $ OutputError $ "Encoding error when turning input into message, " ++ e ++ "\n\n" ++ take 100 (show i)
                         Right v -> do
                             evaluate $ rnf v
                             res <- modifyCVar var $ \s -> do
@@ -96,7 +97,7 @@
                                         res <- patchExtra (fst $ active s) $ Just p
                                         storeExtraAdd (store s) (Right p) res
                                     _ -> return ()
-                                (s2,q) <- recordIO $ (["brain"],) <$> prod (prune s) v
+                                (s2,q) <- recordIO $ (["brain",lower $ fst $ word1 $ show v],) <$> prod (prune s) v
                                 when (fst (active s2) /= fst (active s)) $ extra $ do
                                     res <- patchExtra (fst $ active s2) Nothing
                                     storeExtraAdd (store s2) (Left $ fst $ active s2) res
@@ -115,8 +116,8 @@
 
 clientChange :: Memory -> Memory -> IO (Memory -> Memory)
 clientChange s1 s2 = do
-    let before = Map.keysSet $ clients s1
-    let after  = Map.keysSet $ clients s2
+    let before = Map.keysSet $ Map.filter ciAlive $ clients s1
+    let after  = Map.keysSet $ Map.filter ciAlive $ clients s2
     let f msg xs = sequence [notifyAdmins s2 (msg ++ ": " ++ fromClient x) $ str_ "" | x <- Set.toList xs]
     a <- f "Client added" $ after `Set.difference` before
     b <- f "Client timed out" $ before `Set.difference` after
@@ -126,7 +127,7 @@
 initialiseFake :: Oven State Patch Test -> Prettys -> IO Memory
 initialiseFake oven prettys = do
     store <- newStore False "bake-store"
-    mem <- newMemory oven prettys store (stateFailure, Answer (TL.pack "Initial state created by view mode") Nothing [] False)
+    mem <- newMemory oven prettys store (stateFailure, Answer (bigStringFromString "Initial state created by view mode") Nothing [] False)
     return mem{fatal = ["View mode, database is read-only"]}
 
 initialise :: Oven State Patch Test -> Prettys -> [Author] -> Worker -> IO Memory
@@ -140,11 +141,11 @@
     when (isJust res) $ do
         extra $ storeExtraAdd store (Left state0) =<< patchExtra state0 Nothing
     mem <- newMemory oven prettys store (state0, answer)
-    mem <- return mem{admins = admins ,fatal = ["Failed to initialise, " ++ TL.unpack (aStdout answer) | isNothing res]}
+    mem <- return mem{admins = admins ,fatal = ["Failed to initialise, " ++ bigStringToString (aStdout answer) | isNothing res]}
 
     bad <- if isJust res then notifyAdmins mem "Starting" $ str_ "Server starting" else
         notifyAdmins mem "Fatal error during initialise" $
-            str_ "Failed to initialise" <> br_ <> pre_ (summary $ TL.unpack $ aStdout answer)
+            str_ "Failed to initialise" <> br_ <> pre_ (bigStringWithString (aStdout answer) summary)
     return $ bad mem
 
 
@@ -152,6 +153,9 @@
 patchExtra :: State -> Maybe Patch -> IO (T.Text, TL.Text)
 patchExtra s p = do
     (ex,ans) <- runExtra s p
-    let failSummary = T.pack $ renderHTML $ i_ $ str_ "Error when computing patch information"
-    let failDetail = TL.pack $ renderHTML $ pre_ $ str_ $ TL.unpack $ aStdout ans
-    return $ fromMaybe (failSummary, failDetail) ex
+    case ex of
+        Just x -> return x
+        Nothing -> do
+            let failSummary = T.pack $ renderHTML $ i_ $ str_ "Error when computing patch information"
+            let failDetail = TL.pack $ renderHTML $ pre_ $ str_ (bigStringToString $ aStdout ans)
+            return (failSummary, failDetail)
diff --git a/src/Development/Bake/Server/Store.hs b/src/Development/Bake/Server/Store.hs
--- a/src/Development/Bake/Server/Store.hs
+++ b/src/Development/Bake/Server/Store.hs
@@ -20,7 +20,7 @@
 import qualified Data.Set as Set
 import qualified Data.Map as Map
 import General.Extra
-import System.Time.Extra
+import General.BigString
 import Data.Char
 import Data.List.Extra
 import System.IO.Unsafe
@@ -298,13 +298,26 @@
     | PURun UTCTime Question Answer
       deriving Show
 
+instance NFData Update where
+    rnf (IUState a b c) = rnf (a,b,c)
+    rnf (IUQueue a b) = rnf (a,b)
+    rnf (IUStart a) = rnf a
+    rnf (IUDelete a) = rnf a
+    rnf (IUReject a b c) = rnf (a,b,c)
+    rnf (IUPlausible a) = rnf a
+    rnf (IUSupersede a) = rnf a
+    rnf (IUMerge a) = rnf a
+    rnf (SUAdd a b) = rnf (a,b)
+    rnf (SUDel a) = rnf a
+    rnf (PURun a b c) = rnf (a,b,c)
+
 -- don't inline so GHC can't tell the store is returned unchanged
 {-# NOINLINE storeUpdate #-}
 storeUpdate :: Store -> [Update] -> IO Store
 storeUpdate store xs = do
     -- important so that if the updates depend on the current store they are forced first
     -- the perils of impurity!
-    evaluate $ rnf $ show xs
+    evaluate $ rnf xs
 
     now <- getCurrentTime
     (\f -> foldM f store xs) $ \store x -> do
@@ -323,7 +336,7 @@
                         sqlUpdate conn [saCreate := now, saPoint := pt, saDuration := aDuration] [saId %== x]
                         return x
                 createDirectoryIfMissing True (path </> show x)
-                TL.writeFile (path </> show x </> "update.txt") aStdout
+                bigStringToFile aStdout $ path </> show x </> "update.txt"
             IUQueue p a -> do
                 void $ sqlInsert conn pcTable (p,a,now,Nothing,Nothing,Nothing,Nothing,Nothing,Nothing)
             IUStart p -> do
@@ -340,7 +353,7 @@
                 pt2 <- fst <$> cachePoint cache pt
                 pa <- fst <$> cachePatch cache p
                 Only run:_ <- sqlSelect conn rnId [rnSuccess %== False, rnPoint %== pt2, rnTest %== t]
-                sqlUpdate conn [pcReject := Just now] [pcPatch %== p]
+                sqlUpdate conn [pcReject := Just now] [pcPatch %== p, pcReject %== Nothing]
                 void $ sqlInsert conn rjTable (pa, t, run)
             SUAdd t msg -> do
                 void $ sqlInsert conn skTable (t, msg)
@@ -358,7 +371,7 @@
                             putStrLn $ "Warning: Test disagreement at " ++ show pt ++ ", maybe a changed generator?"
                 x <- sqlInsert conn rnTable (pt,qTest,aSuccess,qClient,t,aDuration)
                 createDirectoryIfMissing True $ path </> show pt
-                TL.writeFile (path </> show pt </> show x ++ "-" ++ maybe "Prepare" (safely . fromTest) qTest <.> "txt") aStdout
+                bigStringToFile aStdout $ path </> show pt </> show x ++ "-" ++ maybe "Prepare" (safely . fromTest) qTest <.> "txt"
 
 safely :: String -> String
 safely = map f . take 100
diff --git a/src/Development/Bake/StepGit.hs b/src/Development/Bake/StepGit.hs
--- a/src/Development/Bake/StepGit.hs
+++ b/src/Development/Bake/StepGit.hs
@@ -50,12 +50,14 @@
             withFileLock (root </> ".bake-lock") $ do
                 ready <- doesFileExist $ git </> ".git/HEAD"
                 if ready then do
+                    -- if a branch goes away on the server this is required
+                    time_ $ cmd (Cwd git) "git remote prune origin"
                     -- for some reason git sometimes times out, not sure why
                     -- hopefully this will help track it down
                     time_ $ cmd (Cwd git) (Timeout $ 15*60) "git fetch"
                     -- stops us creating lots of garbage in the reflog, which slows everything down
                     -- time_ $ cmd (Cwd git) "git reflog expire --all --expire=all --expire-unreachable=all"
-                    time_ $ cmd (Cwd git) "git reset" -- to unwedge a previous merge conflict
+                    time_ $ cmd (Cwd git) "git reset --hard" -- to unwedge a previous merge conflict
                     time_ $ cmd (Cwd git) "git clean -dfx" ["-e" ++ x | x <- keep] -- to remove files left over from a previous merge conflict
                  else do
                     time_ $ cmd (Cwd git) "git clone" [repo] "."
@@ -87,7 +89,7 @@
                 -- since we support SetState
                 Exit _ <- time $ cmd (Cwd git) "git push" [repo] [":" ++ branch]
                 time_ $ cmd (Cwd git) "git push" [repo] [branch ++ ":" ++ branch]
-                return $ sha1 $ trim x
+                return $ toSHA1 $ trim x
 
         stepPrepare s ps = do
             root <- root
diff --git a/src/Example.hs b/src/Example.hs
--- a/src/Example.hs
+++ b/src/Example.hs
@@ -9,7 +9,7 @@
 import Data.List.Extra
 import Data.Tuple.Extra
 import System.Directory
-import Control.Monad.Extra
+import Control.Monad
 import Data.Maybe
 import System.Time.Extra
 
diff --git a/src/General/BigString.hs b/src/General/BigString.hs
new file mode 100644
--- /dev/null
+++ b/src/General/BigString.hs
@@ -0,0 +1,154 @@
+
+module General.BigString(
+    BigString,
+    bigStringFromFile, bigStringFromText, bigStringFromString, bigStringFromByteString,
+    bigStringToFile, bigStringToText, bigStringToString, bigStringWithString, bigStringToByteString,
+    bigStringBackEnd, withBigStringPart
+    ) where
+
+import System.IO.Extra
+import Control.DeepSeq
+import Foreign.Ptr
+import Foreign.ForeignPtr
+import Foreign.Concurrent
+import System.IO.Unsafe
+import Control.Exception
+import Data.Monoid
+import System.Directory
+import qualified Data.Text as T
+import qualified Data.Text.Encoding as T
+import qualified Data.Text.IO as T
+import qualified Data.ByteString.Char8 as BS
+import qualified Data.ByteString.Lazy.Char8 as LBS
+import Network.Wai.Parse
+import Data.Function
+import Control.Monad
+import Network.HTTP.Client.MultipartFormData
+import Prelude
+
+limit = 5000 -- above this level, save to disk
+
+
+---------------------------------------------------------------------
+-- DEFINITION
+
+data BigString = Memory T.Text
+               | File FilePath (ForeignPtr ())
+
+instance Monoid BigString where
+    mempty = bigStringFromText mempty
+    mappend (Memory a) (Memory b) | T.length a + T.length b <= limit = Memory $ a <> b
+    mappend x y = unsafeWriteHandle $ \out -> do
+        hSetBinaryMode out True
+        forM_ [x,y] $ \inp -> readHandle inp $ \inp -> do
+            hSetBinaryMode inp True
+            src <- LBS.hGetContents inp
+            LBS.hPut out src
+
+instance NFData BigString where
+    rnf (Memory x) = rnf x
+    rnf (File a b) = rnf a `seq` b `seq` ()
+
+instance Show BigString where
+    show _ = "<BigString>"
+
+---------------------------------------------------------------------
+-- PRIMITIVES
+
+bigStringFromFile :: (FilePath -> IO a) -> IO (BigString, a)
+bigStringFromFile op = do
+    (file, close) <- newTempFile
+    ptr <- newForeignPtr_ nullPtr
+    Foreign.Concurrent.addForeignPtrFinalizer ptr close
+    res <- withForeignPtr ptr $ const $ op file
+    return (File file ptr, res)
+
+-- Not exported, as it is a bit unsafe - two invariants:
+-- 1) must not use file after returning
+-- 2) must not write to the file
+bigStringWithFile :: BigString -> (FilePath -> IO a) -> IO a
+bigStringWithFile (Memory x) op = withTempFile $ \file -> do T.writeFile file x; op file
+bigStringWithFile (File file ptr) op = withForeignPtr ptr $ const $ op file
+
+
+writeHandle :: (Handle -> IO ()) -> IO BigString
+writeHandle op = fmap fst $ bigStringFromFile $ \file ->
+    withFile file WriteMode $ \h -> do
+        hSetNewlineMode h noNewlineTranslation
+        hSetEncoding h utf8
+        op h
+
+readHandle :: BigString -> (Handle -> IO a) -> IO a
+readHandle x op = bigStringWithFile x $ \file ->
+    withFile file ReadMode $ \h -> do
+        hSetNewlineMode h noNewlineTranslation
+        hSetEncoding h utf8
+        op h
+
+
+{-# NOINLINE unsafeWriteHandle #-}
+unsafeWriteHandle :: (Handle -> IO ()) -> BigString
+unsafeWriteHandle op = unsafePerformIO $ writeHandle op
+
+{-# NOINLINE unsafeReadHandle #-}
+unsafeReadHandle :: BigString -> (Handle -> IO a) -> a
+unsafeReadHandle x op = unsafePerformIO $ readHandle x op
+
+
+---------------------------------------------------------------------
+-- DERIVED
+
+bigStringFromText :: T.Text -> BigString
+bigStringFromText x | T.length x <= limit = Memory x
+                    | otherwise = unsafeWriteHandle (`T.hPutStr` x)
+
+bigStringFromString :: String -> BigString
+bigStringFromString x | null $ drop limit x = Memory $ T.pack x
+                      | otherwise = unsafeWriteHandle (`hPutStr` x)
+
+bigStringToFile :: BigString -> FilePath -> IO ()
+bigStringToFile (Memory x) out = withFile out WriteMode $ \h -> do
+    hSetNewlineMode h noNewlineTranslation
+    hSetEncoding h utf8
+    T.hPutStr h x
+bigStringToFile x out = bigStringWithFile x $ \file -> copyFile file out
+
+bigStringToText :: BigString -> T.Text
+bigStringToText (Memory x) = x
+bigStringToText x = unsafeReadHandle x T.hGetContents
+
+bigStringToString :: BigString -> String
+bigStringToString (Memory x) = T.unpack x
+bigStringToString x = unsafeReadHandle x $ fmap T.unpack . T.hGetContents
+
+bigStringWithString :: NFData a => BigString -> (String -> a) -> a
+bigStringWithString (Memory x) op = let res = op $ T.unpack x in rnf res `seq` res
+bigStringWithString x op = unsafeReadHandle x $ \h -> do
+    src <- hGetContents h
+    let res = op src
+    evaluate $ rnf res
+    return res
+
+bigStringFromByteString :: BS.ByteString -> BigString
+bigStringFromByteString x | BS.length x <= limit = Memory $ T.decodeUtf8 x
+                          | otherwise = unsafeWriteHandle $ \h -> do hSetBinaryMode h True; BS.hPutStr h x
+
+bigStringToByteString :: BigString -> BS.ByteString
+bigStringToByteString (Memory x) = T.encodeUtf8 x
+bigStringToByteString x = unsafeReadHandle x $ \h -> do hSetBinaryMode h True; BS.hGetContents h
+
+
+---------------------------------------------------------------------
+-- WEBBY
+
+bigStringBackEnd :: BackEnd BigString
+bigStringBackEnd _ _ ask = writeHandle $ \h -> do
+    fix $ \loop -> do
+        bs <- ask
+        unless (BS.null bs) $ do
+            BS.hPut h bs
+            loop
+
+withBigStringPart :: String -> BigString -> (Part -> IO a) -> IO a
+withBigStringPart name (Memory x) op = op $ partBS (T.pack name) (T.encodeUtf8 x)
+withBigStringPart name body op = bigStringWithFile body $ \file -> op $ partFileSourceChunked (T.pack name) file
diff --git a/src/General/Extra.hs b/src/General/Extra.hs
--- a/src/General/Extra.hs
+++ b/src/General/Extra.hs
@@ -3,7 +3,7 @@
 -- time changed incompatibly, use the functions that work everywhere
 
 module General.Extra(
-    UTCTime, getCurrentTime, addSeconds, showRelativeTime, relativeTime, showUTCTime,
+    Seconds, UTCTime, getCurrentTime, addSeconds, showRelativeTime, relativeTime, showUTCTime,
     readDate, showDate, timeToDate, dateToTime,
     createDir,
     withFileLock,
@@ -21,6 +21,8 @@
     transitiveClosure, findCycle,
     putBlock,
     maybe',
+    withs,
+    retrySleep,
     commas, commasLimit, unwordsLimit
     ) where
 
@@ -55,22 +57,23 @@
 addSeconds :: Seconds -> UTCTime -> UTCTime
 addSeconds x = addUTCTime (fromRational $ toRational x)
 
+-- | Calculate the difference between two times in seconds.
+diffTime :: UTCTime -> UTCTime -> Seconds
+diffTime end start = fromRational $ toRational $ end `diffUTCTime` start
+
 relativeTime :: IO (UTCTime -> Seconds)
 relativeTime = do
     now <- getCurrentTime
-    return $ \old -> subtractTime now old
+    return $ \old -> diffTime now old
 
 showRelativeTime :: IO (UTCTime -> String)
 showRelativeTime = do
     now <- getCurrentTime
     return $ \old ->
-        let secs = subtractTime now old
-            mins = secs / 60
-            hours = mins / 60
-        in if timeToDate now /= timeToDate old then showDate (timeToDate old)
-        else if hours > 5 then show (round hours) ++ " hours ago"
-        else if mins > 2 then show (round mins) ++ " mins ago"
-        else show (max 2 $ round secs) ++ " secs ago"
+        let secs = diffTime now old in
+        if timeToDate now /= timeToDate old then showDate (timeToDate old)
+        else if secs < 60 then show (max 1 $ floor secs) ++ "s ago" -- 4.32s is too precise, 0s feels wrong
+        else showDuration secs ++ " ago"
 
 showUTCTime :: String -> UTCTime -> String
 showUTCTime = formatTime defaultTimeLocale
@@ -112,9 +115,6 @@
     return name
 
 
-eitherToMaybe :: Either a b -> Maybe b
-eitherToMaybe = either (const Nothing) Just
-
 pick :: [a] -> IO a
 pick xs = randomRIO (0, (length xs - 1)) >>= return . (xs !!)
 
@@ -291,7 +291,12 @@
 whenRight :: Applicative m => Either a b -> (b -> m ()) -> m ()
 whenRight x f = either (const $ pure ()) f x
 
+retrySleep :: Exception e => Seconds -> Int -> (e -> Bool) -> IO a -> IO a
+retrySleep secs times test act
+     | times <= 0 = act
+     | otherwise = catchBool test act $ const $ sleep secs >> retrySleep secs (times-1) test act
 
+
 ---------------------------------------------------------------------
 -- FORMATTING
 
@@ -317,3 +322,7 @@
 
 maybe' :: Maybe a -> b -> (a -> b) -> b
 maybe' x nothing just = maybe nothing just x
+
+withs :: [(a -> r) -> r] -> ([a] -> r) -> r
+withs [] act = act []
+withs (f:fs) act = f $ \a -> withs fs $ \as -> act $ a:as
diff --git a/src/General/HTML.hs b/src/General/HTML.hs
--- a/src/General/HTML.hs
+++ b/src/General/HTML.hs
@@ -1,18 +1,26 @@
-{-# LANGUAGE ViewPatterns #-}
+{-# LANGUAGE ViewPatterns, GeneralizedNewtypeDeriving #-}
 
+-- | Library for defining HTML fragments.
+--   The tags will be properly nested, and all strings will be HTML escaped.
+--   As an example:
+--
+-- > renderHTML $ html_ $
+-- >    ol__ [style_ "color:darkgreen"] $
+-- >        forM_ [1..10] $ \i -> li_ $ str_ $ "item number: " & show i
 module General.HTML(
-    -- * Library
-    url_,
-    HTML, HTML_, renderHTML, valueHTML, str_, raw_,
-    Attribute, attribute_,
-    tag_, tag__,
-    (<>),
+    -- * HTML data type
+    HTML, HTML_, renderHTML, valueHTML,
+    -- * Constructing pieces
+    Attribute, attribute_, tag_, tag__, str_, raw_,
     -- * Tags
     br_, style__, link__, hr_,
-    pre_, b_, html_, head_, title_, body_, h1_, h2_, ul_, li_, p_, table_, thead_, tr_, td_, tbody_, i_,
-    a__, span__, p__, h2__, tr__,
+    pre_, b_, html_, head_, title_, body_, h1_, h2_, ul_, ol_, li_, p_, table_, thead_, tr_, td_, tbody_, i_,
+    a__, span__, p__, h2__, tr__, ol__,
+    -- * Attributes
     href_, class_, name_, rel_, type_, style_, id_,
     -- * Functions
+    (<>),
+    url_,
     unlines_, commas_, commasLimit_, header_
     ) where
 
@@ -20,6 +28,8 @@
 import Data.Monoid
 import Data.List
 import Control.Monad
+import Control.Monad.Trans.Writer
+import Control.DeepSeq
 import Data.Char
 import Numeric
 import Prelude
@@ -33,6 +43,10 @@
 instance Eq Rope where a == b = renderRope a == renderRope b
 instance Ord Rope where compare a b = compare (renderRope a) (renderRope b)
 
+instance NFData Rope where
+    rnf (Branch x) = rnf x
+    rnf (Leaf x) = rnf x
+
 renderRope :: Rope -> String
 renderRope x = f x ""
     where f (Branch []) k = k
@@ -49,47 +63,46 @@
     mconcat = Branch
 
 
+-- | Escape a URL using % encoding.
 url_ :: String -> String
 url_ = concatMap f
     where
         f x | (x >= 'A' && x <= 'Z') || (x >= 'a' && x <= 'z') || (x >= '0' && x <= '9') || x `elem` "-_.~" = [x]
         f (ord -> x) = "%" ++ ['0' | x < 16] ++ showHex x ""
 
-
-data HTML_ a = HTML_ Rope a deriving (Eq,Ord)
+-- | The type for constructing HTML. It is a 'Monad' and 'Monoid'.
+--   Typically the value paramter is '()', in which case use 'HTML'.
+newtype HTML_ a = HTML_ {fromHTML_ :: Writer Rope a}
+    deriving (Eq,Ord,Functor,Applicative,Monad)
 
+-- | An alias for 'HTML_' with no interesting type.
 type HTML = HTML_ ()
 
+-- | Get the value out of an 'HTML_'.
 valueHTML :: HTML_ a -> a
-valueHTML (HTML_ _ x) = x
+valueHTML = fst . runWriter . fromHTML_
 
+-- | Render some 'HTML'.
 renderHTML :: HTML -> String
-renderHTML (HTML_ x _) = renderRope x
+renderHTML = renderRope . execWriter . fromHTML_
 
 nullHTML :: HTML -> Bool
-nullHTML (HTML_ x _) = nullRope x
+nullHTML = nullRope . execWriter . fromHTML_
 
 instance Monoid a => Monoid (HTML_ a) where
-    mempty = HTML_ mempty mempty
-    mappend (HTML_ x1 x2) (HTML_ y1 y2) = HTML_ (x1 `mappend` y1) (x2 `mappend` y2)
-
-instance Functor HTML_ where
-    fmap f (HTML_ a b) = HTML_ a $ f b
-
-instance Applicative HTML_ where
-    pure = HTML_ mempty
-    HTML_ x1 x2 <*> HTML_ y1 y2 = HTML_ (x1 `mappend` y1) (x2 y2)
-
-instance Monad HTML_ where
-    return = pure
-    HTML_ x1 x2 >>= f = let HTML_ y1 y2 = f x2 in HTML_ (x1 `mappend` y1) y2
+    mempty = return mempty
+    mappend = liftM2 mappend
 
+instance NFData a => NFData (HTML_ a) where
+    rnf = rnf . runWriter . fromHTML_
 
+-- | Turn a string into a text fragment of HTML, escaping any characters which mean something in HTML.
 str_ :: String -> HTML
 str_ = raw_ . escapeHTML
 
+-- | Turn a string into an HTML fragment, applying no escaping. Use this function carefully.
 raw_ :: String -> HTML
-raw_ x = HTML_ (Leaf x) ()
+raw_ = HTML_ . tell . Leaf
 
 escapeHTML :: String -> String
 escapeHTML = concatMap $ \c -> case c of
@@ -101,16 +114,19 @@
     x    -> [x]
 
 
+-- | An attribute for a tag.
 data Attribute = Attribute {fromAttribute :: String}
 
 valid (x:xs) | isAlpha x && all isAlphaNum xs = True
 valid x = error $ "Not a valid HTML name, " ++ show x
 
+-- | Construct an Attribute from a key and value string. The value will be escaped.
 attribute_ :: String -> String -> Attribute
 attribute_ a b | valid a = Attribute $ a ++ "=\"" ++ escapeHTML b ++ "\""
                | otherwise = error $ "Invalid attribute name, " ++ a
 
 
+-- | Given a tag name, a list of attributes, and some content HTML, produce some new HTML.
 tag__ :: String -> [Attribute] -> HTML -> HTML
 tag__ name at inner | not $ valid name = error $ "Invalid tag name, " ++ name
                     | otherwise = do
@@ -125,6 +141,7 @@
         inner
         raw_ $ "</" ++ name ++ ">"
 
+-- | Like 'tag__' but with no attributes.
 tag_ :: String -> HTML -> HTML
 tag_ name = tag__ name []
 
@@ -147,6 +164,7 @@
 h1_ = tag_ "h1"
 h2_ = tag_ "h2"
 ul_ = tag_ "ul"
+ol_ = tag_ "ol"
 li_ = tag_ "li"
 p_ = tag_ "p"
 table_ = tag_ "table"
@@ -160,6 +178,7 @@
 p__ = tag__ "p"
 h2__ = tag__ "h2"
 tr__ = tag__ "tr"
+ol__ = tag__ "ol"
 
 href_ = attribute_ "href"
 class_ = attribute_ "class"
diff --git a/src/General/Web.hs b/src/General/Web.hs
--- a/src/General/Web.hs
+++ b/src/General/Web.hs
@@ -1,4 +1,5 @@
 {-# LANGUAGE ScopedTypeVariables, RecordWildCards, OverloadedStrings, CPP #-}
+{-# OPTIONS_GHC -fno-warn-warnings-deprecations #-} -- Use conduitManagerSettings to work with http-conduit-2.1.6 and below
 
 module General.Web(
     Input(..), Output(..), send, server
@@ -12,24 +13,32 @@
 import Network.Wai.Handler.Warp hiding (Port)
 #endif
 
+-- S for server, C for client
 import Development.Bake.Core.Type hiding (run)
-import Network.Wai
+import Network.Wai as S
+import Network.Wai.Parse as P
+import Data.Function
+import General.Extra
+import General.BigString
 import Control.DeepSeq
 import Control.Exception
+import Control.Applicative
 import Control.Monad
 import System.IO
+import Network.HTTP.Conduit as C
+import Network.HTTP.Client.MultipartFormData
 import Network.HTTP.Types.Status
-import Network.HTTP hiding (Request)
 import qualified Data.Text as Text
 import qualified Data.ByteString.Char8 as BS
 import qualified Data.ByteString.Lazy.Char8 as LBS
 import System.Console.CmdArgs.Verbosity
+import Prelude
 
 
 data Input = Input
     {inputURL :: [String]
     ,inputArgs :: [(String, String)]
-    ,inputBody :: LBS.ByteString
+    ,inputBody :: [(String, BigString)]
     } deriving Show
 
 data Output
@@ -47,20 +56,34 @@
     rnf (OutputError x) = rnf x
     rnf OutputMissing = ()
 
+{-
+-- | Number of time to retry sending messages
+maxRetryCount :: Int
+maxRetryCount = 3
 
+-- | Timeout between each message sending attempt
+retryTimeout :: Seconds
+retryTimeout = 10
+-}
+
+
 send :: (Host,Port) -> Input -> IO LBS.ByteString
 send (host,port) Input{..} = do
     let url = "http://" ++ host ++ ":" ++ show port ++ concatMap ('/':) inputURL ++
               concat (zipWith (++) ("?":repeat "&") [a ++ "=" ++ b | (a,b) <- inputArgs])
-    whenLoud $ print ("sending",inputBody,host,port)
-    res <- simpleHTTP (getRequest url)
-        {rqBody=inputBody
-        ,rqHeaders=[Header HdrContentType "application/x-www-form-urlencoded", Header HdrContentLength $ show $ LBS.length inputBody]}
-    case res of
-        Left err -> error $ show err
-        Right r | rspCode r /= (2,0,0) -> error $
-                    "Incorrect code: " ++ show (rspCode r,rspReason r,url) ++ "\n" ++ show (rspBody r)
-                | otherwise -> return $ rspBody r
+    whenLoud $ print ("sending",length inputBody,host,port)
+    req <- parseUrl url
+    m <- newManager conduitManagerSettings
+    withs (map (uncurry withBigStringPart) inputBody) $ \parts -> do
+        body <- formDataBody parts req
+        responseBody <$> httpLbs body m
+{-
+    -- http-client 0.5 completely changes this API, so give up retrying until it can be tested
+        responseBody <$> retrySleep retryTimeout maxRetryCount isConnFailure (httpLbs body m)
+    where
+        isConnFailure FailedConnectionException2{} = True
+        isConnFailure _ = False
+-}
 
 
 server :: Port -> (Input -> IO Output) -> IO ()
@@ -68,12 +91,13 @@
 server port act = return ()
 #else
 server port act = runSettings settings $ \req reply -> do
-    bod <- strictRequestBody req
-    whenLoud $ print ("receiving",bod,requestHeaders req,port)
+    whenLoud $ print ("receiving", map Text.unpack $ pathInfo req, S.requestHeaders req, port)
+    (params, files) <- parseRequestBody bigStringBackEnd req
+
     let pay = Input
             (map Text.unpack $ pathInfo req)
-            [(BS.unpack a, maybe "" BS.unpack b) | (a,b) <- queryString req]
-            bod
+            [(BS.unpack a, maybe "" BS.unpack b) | (a,b) <- S.queryString req] $
+            [(BS.unpack name, bigStringFromByteString x) | (name,x) <- params] ++ [(BS.unpack name, fileContent) | (name, P.FileInfo{..}) <- files]
     res <- act pay
     -- from http://stackoverflow.com/questions/49547/making-sure-a-web-page-is-not-cached-across-all-browsers
     let nocache = [("Cache-Control","no-cache, no-store, must-revalidate")
@@ -91,7 +115,8 @@
                    setPort port defaultSettings
 
 
-exception :: Maybe Request -> SomeException -> IO ()
+
+exception :: Maybe S.Request -> SomeException -> IO ()
 exception r e = when (defaultShouldDisplayException e) $
     hPutStrLn stderr $ "Error when processing " ++ maybe "Nothing" (show . rawPathInfo) r ++ "\n    " ++ show e
 #endif
diff --git a/src/Test.hs b/src/Test.hs
--- a/src/Test.hs
+++ b/src/Test.hs
@@ -1,3 +1,4 @@
+{-# LANGUAGE CPP #-}
 
 module Test(main) where
 
@@ -7,7 +8,7 @@
 import System.Time.Extra
 import System.Environment.Extra
 import System.FilePath
-import Control.Monad.Extra
+import Control.Monad
 import Control.Exception.Extra
 import Control.Concurrent
 import System.Process
@@ -37,6 +38,9 @@
         unit $ cmd "chmod -R 755 .bake-test"
         unit $ cmd "rm -rf .bake-test"
         return ()
+#if __GLASGOW_HASKELL__ >= 708
+    setEnv "http_proxy" ""
+#endif
 
     createDirectoryIfMissing True (dir </> "repo")
     withCurrentDirectory (dir </> "repo") $ do
@@ -71,7 +75,7 @@
     createDirectoryIfMissing True $ dir </> "server"
     curdir <- getCurrentDirectory
     environment <- (\env -> ("REPO",repo):("bake_datadir",curdir):env) <$> getEnvironment
-    p0 <- createProcessAlive (proc exe ["server"])
+    p0 <- createProcessAlive (proc exe ["server","--author=admin"])
         {cwd=Just $ dir </> "server", env=Just environment}
     sleep 5
     ps <- forM (zip [1..] Example.platforms) $ \(i,p) -> do