How to add a MonadThrow instance to ResourceT Monad Transformer in a Warp Server

Question

I'm trying to build a simple reverse-proxy server using Warp (mostly for my own edification, since there are lots of other off-the-shelf options).

So far, my code is mostly lifted from the Warp documentation (Writing output to file is just an interim test, again lifted from documentation):

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

When I try to run Network.HTTP operations inside the ResourceT Monad, the compiler rightly requires it to be an instance of MonadThrow. My difficulty is how to either add this to the monad stack or add an instance of it to ResourceT. The compiler error with the code below is:

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 }

If I remove the HTTP lines, a MonadThrow instance is no longer required, and everything works fine.

If I define a new custom monad as an instance of MonadThrow, how do I get the server to actually run using it? Looking for the proper way to introduce this exception handling in my stack (or even just satisfying the compiler).

Thanks/O

Do you have an example of what doesn't work? This compiles fine over here... using ghc-7.4.1, http-conduit-1.4.1.2, conduit-0.4.1.1 and warp-1.2.0.1 — Nathan Howell, Apr 25 '12 at 17:22
Looks like it is because of my version of warp. Code above gives error with warp-1.0.0.1 I upgraded to warp-1.2.0.1 and works fine now. Looking at Haddock, ResourceT did not define an instance of MonadThrow in 1.0.0.1 but _does_ in 1.2.0.1 While this certainly solves the immediate problem, how would one add the instance if it wasn't already included (e.g. in 1.0.0.1)? Thanks!!!! — jdo, Apr 25 '12 at 17:39

score 2 · Accepted Answer · answered Apr 25 '12 at 20:23

2

This should do it (if you import Control.Monad.Trans.Resource so you get ResourceT):

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

answered Apr 25 '12 at 20:23

Venge

2,417
16
21

`ResourceT` is re-exported from `Data.Conduit` – Nathan Howell Apr 25 '12 at 21:35
I think I'm going to have to mark this as an accepted answer, but I'll to have to take it on faith since I can't reinstall the old warp-1.0.0.1 (cabal dependency hell, even with a clean .cabal directory) -- even after unregistering warp-1.2.0.1 (prior to removing all local modules), it still uses the original Conduit export and gives the expected error `Duplicate instance declarations`. In other words, my original problem is no longer easily reproduced. I'll happily take the `Duplicate instances` error as evidence of the solution's validity :) Thanks again! /O – jdo Apr 25 '12 at 23:23

score 0 · Answer 2 · answered Apr 26 '12 at 14:44

Thanks for all the responses. Ended up with the code below which seems to work perfectly with 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)

How to add a MonadThrow instance to ResourceT Monad Transformer in a Warp Server

2 Answers2