Question

我正在尝试使用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

Answer 1

这应该这样做（如果你import Control.Monad.Trans.Resource，那么你得到ResourceT）：

instance (MonadThrow m) => MonadThrow (ResourceT m) where
    monadThrow = lift . monadThrow

Answer 2

感谢所有回复。结束下面的代码，似乎与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)

如何将MonadThrow实例添加到Warp服务器中的ResourceT Monad Transformer

2 个答案: