happstack-server中重复读取请求体的问题求助

我之前在使用happstack-authenticate时也碰到过一模一样的问题——Happstack的请求体是基于流的，takeRequestBody调用一次就会把流消费掉，后续再读就拿不到内容了。针对你这种既要让认证库用请求体，自己后续流程也要用的场景，分享几个实用的解决办法：

1. 用中间件缓存请求体，全局复用 #

最通用的方案是提前把请求体完整读取并缓存，然后重新构造一个可重复读取的请求对象，传给后续所有处理逻辑（包括认证库）。这样不管是认证库调用takeRequestBody，还是你自己的代码读取，都能拿到相同的内容。

示例代码：

import Happstack.Server
import qualified Data.ByteString.Lazy as LBS
import Control.Monad.Trans.State (putState, getState)

-- 定义一个中间件，缓存请求体并替换请求对象
cacheRequestBodyMiddleware :: ServerPartT IO a -> ServerPartT IO a
cacheRequestBodyMiddleware next = do
    currentReq <- askRq
    case rqBody currentReq of
        Just originalBody -> do
            -- 读取完整的请求体内容
            bodyBytes <- liftIO $ takeRequestBody originalBody
            case bodyBytes of
                Just lbs -> do
                    -- 构造一个新的RequestBody，每次调用takeRequestBody都会返回缓存的内容
                    let reusableBody = RequestBody $ return $ Just lbs
                        updatedReq = currentReq { rqBody = Just reusableBody }
                    -- 把缓存的内容存入State，方便后续自己的代码直接获取
                    putState lbs
                    -- 在更新后的请求上下文中执行后续逻辑
                    localRq (const updatedReq) next
                Nothing -> next
        Nothing -> next

使用的时候，把这个中间件套在你的路由外层（包括认证库的JSON API路由）：

main :: IO ()
main = simpleHTTP nullConf $ cacheRequestBodyMiddleware $ do
    -- 先挂载happstack-authenticate的JSON API
    authJsonApi
    -- 你的其他业务路由，后续可以直接用getState获取缓存的请求体
    path "my-endpoint" $ do
        cachedBody <- getState
        -- 用cachedBody做后续处理
        ok $ toResponse ("Received body: " ++ show cachedBody)

2. 封装认证库API，返回请求体内容 #

如果你不想用全局中间件，也可以封装happstack-authenticate的API调用，让它在处理完后把读取到的请求体返回给你，这样后续流程直接用这个返回的内容就行，不用再去读请求体。

示例代码：

import Happstack.Server
import Happstack.Authenticate
import qualified Data.ByteString.Lazy as LBS

-- 封装认证API，同时返回请求体和认证响应
wrappedAuthApi :: ServerPartT IO (Maybe LBS.ByteString, AuthResponse)
wrappedAuthApi = do
    req <- askRq
    -- 先读取请求体
    requestBody <- liftIO $ traverse takeRequestBody (rqBody req)
    -- 重新构造请求体，传给原始的认证API
    let updatedReq = req { rqBody = fmap (\b -> RequestBody $ return $ Just b) requestBody }
    authResp <- localRq (const updatedReq) authJsonApi
    return (requestBody, authResp)

然后在你的路由里调用这个封装后的API：

path "auth" $ do
    (body, resp) <- wrappedAuthApi
    -- 用body做后续业务处理
    ok $ toResponse (resp, body)

注意事项 #

• 如果你的请求体是超大文件（比如几百MB的上传），缓存整个请求体到内存可能会导致内存占用过高，这种情况可以考虑把请求体写入临时文件，后续从文件读取内容。
• 确保缓存请求体的逻辑在所有需要读取请求体的处理之前执行，否则还是会出现请求体被消费的问题。

内容的提问来源于stack exchange，提问作者alex.b