How to force yesod/warp to close open file handles before handling next request?

Question

I've written a small server which accepts registrations as POST requests and persists them by appending them to a file. As soon as I put this server under load (I use Apache JMeter with 50 concurrent threads and a repeat count of 10, and the post consists of one field with ~7k of text data), I get lots of "resource busy, file is locked" errors:

02/Nov/2013:18:07:11 +0100 [Error#yesod-core] registrations.txt: openFile: resource busy (file is locked) @(yesod-core-1.2.4.2:Yesod.Core.Class.Yesod ./Yesod/Core/Class/Yesod.hs:485:5)

Here is a stripped-down version of the code:

{-# LANGUAGE QuasiQuotes, TemplateHaskell, MultiParamTypeClasses, OverloadedStrings, TypeFamilies #-}

import           Yesod
import           Text.Hamlet
import           Control.Applicative ((<$>), (<*>))
import           Control.Monad.IO.Class (liftIO)
import           Data.Text (Text, pack, unpack)
import           Data.String
import           System.IO (withFile, IOMode(..), hPutStrLn)

data Server = Server

data Registration = Registration
        { text      :: Text
        }
    deriving (Show, Read)

mkYesod "Server" [parseRoutes|
/reg    RegR    POST
|]

instance Yesod Server

instance RenderMessage Server FormMessage where
    renderMessage _ _ = defaultFormMessage

postRegR :: Handler Html
postRegR = do
    result <- runInputPost $ Registration
        <$> ireq textField "text"
    liftIO $ saveRegistration result
    defaultLayout [whamlet|<p>#{show result}|]

saveRegistration :: Registration -> IO ()
saveRegistration r = withFile "registrations.txt" AppendMode (\h -> hPutStrLn h $ "+" ++ show r)

main :: IO ()
main = warp 8080 Server

I compiled the code on purpose without -threaded, and the OS shows only a single thread running. Nonetheless it looks to me like the requests are not completely serialised, and a new request is already handled before the old one has been written to disk.

Could you tell me how I can avoid the error message and ensure that all requests are handled successfully? Performance is not an issue yet.

Answer 1

Even without -threaded the Haskell runtime will have several "green threads" running cooperatively. You need to use Control.Concurrent to limit access to the file because you cannot have several threads writing to it at once.

The easiest way is to have an MVar () in your Server and have each request "take" the unit from the MVar before opening the file and then put it back after the file operation has been completed. You can use bracket to ensure that the lock is released even if writing the file fails. E.g. something like

import Control.Concurrent
import Control.Exception (bracket_)

type Lock = MVar ()
data Server = Server { fileLock :: Lock }

saveRegistration :: Registration -> Lock -> IO ()
saveRegistration r lock = bracket_ acquire release updateFile where
    acquire = takeMVar lock
    release = putMVar lock ()
    updateFile =
        withFile "registrations.txt" AppendMode (\h -> hPutStrLn h $ "+" ++ show r)

Answer 2

It's perfectly OK to write to a Handle from several threads. In fact, Handles have MVars inside them to prevent weird concurrent behaviour. What you probably want is not to handle [sic] MVars by hand (which can lead to deadlock if, for instance, a handler throws an exception) but lift the withFile call outside the individual handler threads. The file stays open all the time - opening it on each request would be slow anyway.

I don't know much about Yesod, but I'd recommend something like this (probably doesn't compile):

data Server = Server { handle :: Handle }

postRegR :: Handler Html
postRegR = do
    h <- handle `fmap` getYesod
    result <- runInputPost $ Registration
        <$> ireq textField "text"
    liftIO $ saveRegistration h result
    defaultLayout [whamlet|<p>#{show result}|]

saveRegistration :: Handle -> Registration -> IO ()
saveRegistration h r = hPutStrLn h $ "+" ++ show r

main :: IO ()
main = withFile "registrations.txt" AppendMode $ \h -> warp 8080 (Server h) 
-- maybe there's a better way?

Aside: if you wanted to file to be written asynchronously you could write to a queue (if it were a log file or something), but in your use case you probably want to let the user know if their registration failed, so I'd recommend staying with this form.