在Happstack-Server中阅读两次请求body

Question

我在Happstack-Server应用程序中两次阅读身体有问题。

我已经嵌入了一个用于用户身份验证的库(HappStack-authenticate(。HappStack-authenticate拥有一个用于管理用户的JSON-API，我在调用JSON-API之后尝试访问相同的请求主体。不幸的是，此库使用takerequestbody的方法，使身体陷入困境，因此在此之后我无法访问请求主体。试图在库之前访问尸体仅被称为Shift Charty问题，因为我也使用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

Answer 1

我已经实现了解决方法，该解决方案使用函数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 "")