¿Cómo añadir una instancia MonadThrow a ResourceT Mónada transformador en un servidor Warp

Question

Estoy tratando de construir un simple servidor proxy inverso utilizando la deformación (sobre todo para mi propia edificación, ya que hay muchas otras opciones off-the-shelf)

Hasta ahora, mi código es levantado en su mayoría de la documentación de la deformación (Escrito salida al archivo es sólo una provisional de pruebas, de nuevo levantado de la documentación):

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 

Cuando trato de ejecutar operaciones en el interior Network.HTTP el ResourceT Monad, el compilador correctamente requiere que sea una instancia de MonadThrow. Mi dificultad es cómo agregar esto a la pila de mónadas o agregar una instancia de ella a ResourceT. El error del compilador con el código de abajo es:

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 } 

Si quito las líneas HTTP, ya no se requiere una instancia MonadThrow, y todo funciona bien.

Si defino una nueva mónada personalizado como una instancia de MonadThrow, ¿Cómo consigo el servidor para ejecutar de utilizarlo? Estoy buscando la forma adecuada de introducir este manejo de excepciones en mi stack (o simplemente satisfacer al compilador).

Gracias/S

Answer 1

Esto debe hacerlo (si import Control.Monad.Trans.Resource para que pueda obtener ResourceT):

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

Answer 2

Gracias por todas las respuestas. Terminó con el siguiente código que parece funcionar perfectamente con 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)