Logo Questions Linux Laravel Mysql Ubuntu Git Menu
 

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

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

like image 378
jdo Avatar asked Nov 04 '22 01:11

jdo


1 Answers

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
like image 145
Venge Avatar answered Nov 15 '22 07:11

Venge