WarpサーバーのMonadThrowインスタンスをResourceT Monad Transformerに追加する方法

Question

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 

私は内部のNetwork.HTTP操作を実行しようと

ResourceT Monadの場合、コンパイラはMonadThrowのインスタンスであることを正しく要求します。私の難しさは、これをモナド・スタックに追加するか、またはそのインスタンスをResourceTに追加する方法です。私は、HTTPの行を削除した場合

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 } 

は、MonadThrowインスタンスが不要になった、とすべてが正常に動作します：以下のコードでコンパイルエラーではありません。

新しいカスタムモナドをMonadThrowのインスタンスとして定義した場合、実際にそれを使用してサーバーを実行するにはどうすればよいですか？私のスタックでこの例外処理を導入する適切な方法を探しています（あるいはコンパイラだけでも満足しています）。 （あなたimport Control.Monad.Trans.ResourceはそうあなたがResourceTを取得する場合）

感謝/ O

Answer 1

これはそれを行う必要があります：すべての応答のための

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)