CODEWITHSUNDEEP
haskellmiddlewarehaskell-wai
yogsototh
yogsototh

Reputation: 15141

Wai Request Copying

I would like to be able to use the content of the body of a request to be used as part of a cache key.

My current code looks like:

caching app req respond =
    -- Request Body is consumed here
    cacheKey <- strictRequestBody req
    -- the req object is no more usable as body was consumed
    maybe (app req (addToCacheAndRespond cacheKey))
        (sendResponse . responseFromCachedValue)
        (lookup cacheKey cacheContainer)

I don't see any solution here. How could I either copy the request or generate another request from the cacheKey and the req object?

Or event better is there another better solution?

As bonus point, could someone point me the rationale from changing the type of Wai Application from Request -> IO Response to Request -> (Response -> IO ResponseReceived) -> IO ResponseReceived.

Upvotes: 2

Views: 210

Answers (1)

yogsototh
yogsototh

Reputation: 15141

I finally found how to do it using the requestLogger as example:

http://haddock.stackage.org/lts-3.15/wai-extra-3.0.13/src/Network.Wai.Middleware.RequestLogger.html#logStdout

Mainly you need to copy back the request body...

getRequestBody :: Request -> IO (Request, [S8.ByteString])
getRequestBody req = do
  let loop front = do
         bs <- requestBody req
         if S8.null bs
             then return $ front []
             else loop $ front . (bs:)
  body <- loop id
  -- logging the body here consumes it, so fill it back up
  -- obviously not efficient, but this is the development logger
  --
  -- Note: previously, we simply used CL.sourceList. However,
  -- that meant that you could read the request body in twice.
  -- While that in itself is not a problem, the issue is that,
  -- in production, you wouldn't be able to do this, and
  -- therefore some bugs wouldn't show up during testing. This
  -- implementation ensures that each chunk is only returned
  -- once.
  ichunks <- newIORef body
  let rbody = atomicModifyIORef ichunks $ \chunks ->
         case chunks of
             [] -> ([], S8.empty)
             x:y -> (y, x)
  let req' = req { requestBody = rbody }
  return (req', body)

Upvotes: 2

Related Questions