Чтение тела запроса дважды в happstack-сервере - PullRequest
0 голосов
/ 27 апреля 2018

У меня проблема с чтением тела дважды в приложении happstack-server.

Я добавил библиотеку для аутентификации пользователя (happstack-authenticate). happstack-authenticate имеет JSON-Api для управления пользователями, и я пытаюсь получить доступ к тому же телу запроса после вызова JSON-Api. К сожалению, этот libray использует метод takeRequestBody , который уничтожает тело, поэтому я не могу получить доступ к телу запроса после этого. Попытка получить доступ к телу до вызова библиотеки смещает только проблему, потому что я также использую takeRequestBody.

Причина, по которой takeRequestBody удаляет контент, заключается в том, что он основан на tryTakeMVAR .

Есть ли решение для моей проблемы? Нужно ли дважды получить доступ к телу или есть другое решение? Или, может быть, есть другой метод чтения тела, который не разрушает тело?

Простой код для демонстрации проблемы:

module Test where

import Data.Data                     ( Data, Typeable )
import Happstack.Server 
import Happstack.Authenticate.Core
import Data.Acid                     ( AcidState )
import Web.Routes                    ( RouteT(..) )
import Control.Monad.IO.Class        ( liftIO )
import qualified Data.ByteString.Lazy.Char8 as L


getBody :: RouteT AuthenticateURL (ServerPartT IO) L.ByteString
getBody = do
    req  <- askRq
    body <- liftIO $ takeRequestBody req
    case body of
        Just rqbody -> return . unBody $ rqbody
        Nothing     -> return (L.pack "")


route :: AcidState AuthenticateState -> (AuthenticateURL -> RouteT AuthenticateURL (ServerPartT IO) Response)
        -> AuthenticateURL -> RouteT AuthenticateURL (ServerPartT IO) Response
route authenticateState routeAuthenticate authenticateURL =
    do
        --routeAuthenticate is a routing function from Happstack.Authenticate
        routeAuthenticate authenticateURL
        body <- getBody
        ok $ toResponse body

1 Ответ

0 голосов
/ 04 мая 2018

Я реализовал обходной путь, который использует функцию tryReadMVar вместо tryTakeMVAR . С помощью этой функции я могу читать тело, не уничтожая его для продолжения процесса

peekRequestBody :: (MonadIO m) => Request -> m (Maybe RqBody)
peekRequestBody rq = liftIO $ tryReadMVar (rqBody rq)

getBody :: RouteT AuthenticateURL (ServerPartT IO) L.ByteString
getBody = do
    req  <- askRq
    body <- liftIO $ peekRequestBody req
    case body of
        Just rqbody -> return . unBody $ rqbody
        Nothing     -> return (L.pack "")
...