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

StackOverflow https://stackoverflow.com/questions/10319629

  •  03-06-2021
  •  | 
  •  

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

Était-ce utile?

La solution

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

Autres conseils

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)
Licencié sous: CC-BY-SA avec attribution
Non affilié à StackOverflow
scroll top