Как заставить yesod/warp закрыть дескрипторы открытых файлов перед обработкой следующего запроса?

Question

Я написал небольшой сервер, который принимает регистрации как POST-запросы и сохраняет их, добавляя их в файл. Как только я помещаю этот сервер под нагрузку (я использую Apache JMeter с 50 одновременными потоками и счетчиком повторов 10, а пост состоит из одного поля с ~7k текстовых данных), я получаю много "ресурсов занятых, файл заблокированные "ошибки:

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)

Вот урезанная версия кода:

{-# 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

Я специально скомпилировал код без -threaded, а ОС показывает только один работающий поток. Тем не менее, мне кажется, что запросы не полностью сериализованы, и новый запрос уже обработан до того, как старый будет записан на диск.

Не могли бы вы сказать мне, как я могу избежать сообщения об ошибке и обеспечить успешную обработку всех запросов? Производительность пока не проблема.

Answer 1

Даже без -threaded среда выполнения Haskell будет иметь несколько "зеленых потоков", работающих совместно. Вам нужно использовать Control.Concurrent ограничить доступ к файлу, потому что вы не можете одновременно записывать в него несколько потоков.

Самый простой способ - это иметь MVar () в вашем Server и каждый запрос "взять" блок из MVar перед открытием файла, а затем положить его обратно после завершения операции с файлом. Ты можешь использовать bracket чтобы убедиться, что блокировка снята, даже если запись файла не удалась. Например, что-то вроде

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

Это нормально, чтобы написать Handle из нескольких потоков. По факту, Handleс MVars внутри них, чтобы предотвратить странное параллельное поведение. То, что вы, вероятно, хотите, не справиться [так] MVars вручную (что может привести к тупику, если, например, обработчик выдает исключение), но снимите withFile вызов за пределами отдельных потоков обработчика. Файл остается открытым все время - открывать его при каждом запросе все равно будет медленно.

Я не знаю много о Yesod, но я бы порекомендовал что-то вроде этого (вероятно, не компилируется):

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?

Кроме того: если вы хотите, чтобы файл был записан асинхронно, вы можете записать в очередь (если это был файл журнала или что-то в этом роде), но в вашем случае вы, вероятно, захотите сообщить пользователю, если его регистрация не удалась, поэтому я бы рекомендую остановиться с этой формой.