如何在Warp服务器中为ResourceT Monad Transformer添加一个MonadThrow实例

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

- jdo

---

你有一个不起作用的例子吗？这段代码在我的环境下编译正常...我使用的是ghc-7.4.1、http-conduit-1.4.1.2、conduit-0.4.1.1和warp-1.2.0.1。 - Nathan Howell

看起来是因为我的warp版本问题。 上面的代码在warp-1.0.0.1下会出错。 我升级到了warp-1.2.0.1，现在可以正常工作了。查看Haddock文档，ResourceT在1.0.0.1中没有定义MonadThrow的实例，但在1.2.0.1中有。虽然这当然解决了当前的问题，但如果它没有被包含在内（例如在1.0.0.1中），该怎么添加实例呢？谢谢！！！ - jdo

Answer 1

这应该可以解决问题（如果你import Control.Monad.Trans.Resource，这样你就会得到ResourceT）：

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

- Venge

---

ResourceT 是从 Data.Conduit 中重新导出的。 - Nathan Howell

我想我得把这个回答标记为已接受，但我必须信任它，因为我无法重新安装旧的warp-1.0.0.1（即使使用干净的.cabal目录也会遇到cabal依赖问题）-- 即使在注销warp-1.2.0.1之后（在删除所有本地模块之前），它仍然使用原始的Conduit导出并给出了预期的错误“重复实例声明”。换句话说，我的原始问题不再容易重现。我很高兴将“重复实例”错误作为解决方案有效性的证据 :) 再次感谢！/O - jdo

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)

- jdo