Làm thế nào để thêm một thể hiện MonadThrow vào bộ biến đổi ResourceT Monad trong một máy chủ Warp

Question

Tôi đang cố gắng xây dựng một máy chủ proxy ngược đơn giản bằng cách sử dụng Warp (chủ yếu là do sự chỉnh sửa của riêng tôi, vì có rất nhiều tùy chọn khác)).

Cho đến nay, mã của tôi chủ yếu được dỡ bỏ từ tài liệu Warp (Viết ra để tập tin được chỉ là một thử nghiệm lâm thời, một lần nữa nâng lên từ tài liệu):

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 

Khi tôi cố gắng chạy hoạt động Network.HTTP bên trong ResourceT Monad, trình biên dịch yêu cầu nó phải là một thể hiện của MonadThrow. Khó khăn của tôi là làm thế nào để thêm nó vào ngăn xếp đơn hoặc thêm một thể hiện của nó vào ResourceT. Lỗi trình biên dịch với mã bên dưới là:

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 } 

Nếu tôi xóa các dòng HTTP, một cá thể MonadThrow không còn cần thiết và mọi thứ hoạt động tốt.

Nếu tôi xác định một đơn đặt hàng tùy chỉnh mới làm trường hợp của MonadThrow, làm cách nào để máy chủ thực sự chạy bằng cách sử dụng nó? Tìm kiếm cách thích hợp để giới thiệu xử lý ngoại lệ này trong ngăn xếp của tôi (hoặc thậm chí chỉ thỏa mãn trình biên dịch).

Thanks/O

Answer 1

này nên làm điều đó (nếu bạn import Control.Monad.Trans.Resource để bạn có được ResourceT):

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

Answer 2

Cảm ơn tất cả các câu trả lời. Đã kết thúc với mã bên dưới có vẻ hoạt động hoàn hảo với 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)