5

我正在尝试使用 Warp 构建一个简单的反向代理服务器（主要是为了我自己的启发，因为还有很多其他现成的选项）。

到目前为止，我的代码大部分是从 Warp 文档中提取的（将输出写入文件只是一个临时测试，再次从文档中提取）：

import Network.Wai as W
import Network.Wai.Handler.Warp
import Network.HTTP.Types
import Network.HTTP.Conduit as H
import qualified Data.Conduit as C
import Data.Conduit.Binary (sinkFile)
import Blaze.ByteString.Builder.ByteString
import Control.Monad.Trans.Resource
import Control.Monad.IO.Class

proxApp req = do
    let hd = headerAccept "Some header"
    {-liftIO $ logReq req-}
    pRequest <- parseUrl "http://some_website.com"
    H.withManager $ \manager -> do
        Response _ _ _ src <- http pRequest manager
        src C.$$ sinkFile "test.html"
    return $ ResponseBuilder status200 [hd] $ fromByteString "OK\n"

main = do
    putStrLn "Setting up reverse proxy on 8080"
    run 8080 proxApp

当我尝试在 ResourceT Monad 中运行 Network.HTTP 操作时，编译器正确地要求它是 MonadThrow 的一个实例。我的困难是如何将它添加到 monad 堆栈或将它的实例添加到 ResourceT。以下代码的编译器错误是：

No instance for (MonadThrow
                   (conduit-0.1.1.1:Control.Monad.Trans.Resource.ResourceT IO))
  arising from a use of `proxApp'
Possible fix:
  add an instance declaration for
  (MonadThrow
     (conduit-0.1.1.1:Control.Monad.Trans.Resource.ResourceT IO))
In the second argument of `run', namely `proxApp'
In a stmt of a 'do' block: run 8080 proxApp
In the expression:
  do { putStrLn "Setting up reverse proxy on 8080";
       run 8080 proxApp }

如果我删除 HTTP 行，则不再需要 MonadThrow 实例，并且一切正常。

如果我将一个新的自定义 monad 定义为 MonadThrow 的实例，我如何让服务器使用它实际运行？寻找在我的堆栈中引入这种异常处理的正确方法（甚至只是满足编译器）。

谢谢/O

4

2 回答 2

2

这应该这样做（如果你import Control.Monad.Trans.Resource这样的话ResourceT）：

instance (MonadThrow m) => MonadThrow (ResourceT m) where
    monadThrow = lift . monadThrow
于 2012-04-25T20:23:23.783 回答
0

感谢所有的回复。以下面的代码结束，它似乎与 warp-1.2.0.1 完美配合。

proxApp req = do
    liftIO $ logReq req
    pRequest <- parseUrl "http://some_website.com"
    H.withManager $ \manager -> do
        Response status version headers src <- http pRequest manager
        body <- src C.$$ responseSink
        liftIO $ putStrLn $ show status
        return $ ResponseBuilder status headers body

responseSink = C.sinkState
    (fromByteString "")
    (\acc a -> return $ C.StateProcessing $ mappend acc $ fromByteString a )
    (\acc -> return acc)
于 2012-04-26T14:44:49.780 回答