3

我希望能够检查我的应用程序在通过Network.HTTP.Client.

该功能未内置Network.HTTP.Client，尽管文档中有一些对该想法的引用，包括（非工作）示例代码。似乎可以通过重用几乎完全现有的部分来完成，所以我决定尝试一下。

在进行一些谷歌搜索时，听起来Control.Monad.Trans.Control可能可以满足我在堆栈中累积请求的需要StateT [Request] IO，但是，在尝试了几天没有成功之后，我意识到如果我可以更轻松地做我想做的事我只是使用了一个IORef--- 但我仍然很好奇我是否错过了一些聪明的方法来做到这一点而不诉诸可变性。

我的工作，IORef基于 - 的例程看起来像：

responseOpenWithRedirects :: Request -> Manager -> IO (Response BodyReader, [Request])
responseOpenWithRedirects req man = do
  mWrapIOException man $ do
    requestHistory <- newIORef []
    let
      handleRedirects localReq = do
        res <- httpRaw localReq {redirectCount = 0} man
        modifyIORef' requestHistory (localReq :)
        return (res, getRedirectedRequest localReq (responseHeaders res) (responseCookieJar res) (statusCode (responseStatus res)))
    res <- httpRedirect (redirectCount req) handleRedirects req
    redirectRequests <- readIORef requestHistory
    maybe (return (res, redirectRequests)) throwIO =<< applyCheckStatus (checkStatus req) res

我的非工作（因为它不累积请求），Control.Monad.Trans.Control基于例程看起来像：

responseOpenWithRedirects :: Request -> Manager -> IO (Response BodyReader, [Request])
responseOpenWithRedirects req man =
  mWrapIOException man $ do
    let
       handleRedirects run localReq = do
         res <- httpRaw localReq {redirectCount = 0} man
         run (modify (\rs -> localReq : rs))
         return (res, getRedirectedRequest localReq (responseHeaders res) (responseCookieJar res) (statusCode (responseStatus res)))
    (res, redirectRequests) <- flip runStateT [] $ liftBaseWith $ \run -> httpRedirect (redirectCount req) (handleRedirects run) req
    maybe (return (res, redirectRequests)) throwIO =<< applyCheckStatus (checkStatus req) res

正如我所看到的，问题是我无法从handleRedirects函数返回更新的状态，因为这是从内部调用的httpRedirect——因此，我永远没有机会在更新的值上使用 restoreM 。我没有看到如何成功地结合这些东西，但我怀疑这只是我的想象力或理解力的失败。

为了使事情尽可能简单，这里有一个可以用于每个版本的测试工具：

#!/usr/bin/runghc

import Control.Exception
import Control.Monad.Trans.Control
import Control.Monad.Trans.State
import Data.IORef
import Data.ByteString.Lazy
import Network.HTTP.Client.Internal
import Network.HTTP.Types

main :: IO (Response ByteString, [Request])
main = do
  manager <- newManager defaultManagerSettings
  request <- parseUrl "http://feeds.feedburner.com/oreilly/newbooks"
  withResponseAndRedirects request manager $ \(res, reqs) -> do
    bss <- brConsume $ responseBody res
    return (res { responseBody = fromChunks bss }, reqs)

withResponseAndRedirects :: Request -> Manager -> ((Response BodyReader, [Request]) -> IO a) -> IO a
withResponseAndRedirects req man =
  bracket (responseOpenWithRedirects req man) (responseClose . fst)
4

0 回答 0