阅读请求 body 两次 happstack-server

Question

我在 happstack-server 应用程序中读取 body 两次时遇到问题。

我已经嵌入了一个用于用户身份验证的库 (happstack-authenticate)。 happstack-authenticate 有一个 JSON-Api 来管理用户，我在调用 JSON-Api 后尝试访问相同的请求 body。不幸的是，这个库使用了破坏body的方法takeRequestBody，所以我无法在这之后访问请求body。尝试在库被调用之前访问 body shift 只是问题，因为我也使用 takeRequestBody.

takeRequestBody之所以删除内容是因为它是基于tryTakeMVAR。

我的问题有解决方法吗？我需要访问 body 两次还是有其他解决方案？或者也许还有另一种方法可以读取 body 而不会破坏 body?

演示问题的简单代码：

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

Answer 1

我已经实施了一个解决方法，它使用函数 tryReadMVar instead tryTakeMVAR。有了这个功能，我可以读取 body 而不会为后续过程破坏它

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 "")

阅读请求 body 两次 happstack-server

Reading request body twice in happstack-server

haskell

httprequest

happstack