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)