5

Warpを使用して単純なリバースプロキシサーバーを構築しようとしています（他にも多くの既製のオプションがあるため、主に私自身の教育のためです）。

これまでのところ、私のコードはほとんどWarpドキュメントから削除されています（ファイルへの出力の書き込みは単なる暫定テストであり、ドキュメントからも削除されています）：

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

ResourceT Monad内でNetwork.HTTP操作を実行しようとすると、コンパイラーはそれがMonadThrowのインスタンスであることを正しく要求します。私の難しさは、これをモナドスタックに追加する方法、またはそのインスタンスをResourceTに追加する方法です。以下のコードでのコンパイラエラーは次のとおりです。

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 }

HTTP行を削除すると、MonadThrowインスタンスは不要になり、すべてが正常に機能します。

新しいカスタムモナドをMonadThrowのインスタンスとして定義した場合、それを使用してサーバーを実際に実行するにはどうすればよいですか？この例外処理をスタックに導入する（またはコンパイラーを満足させる）適切な方法を探しています。

ありがとう/O

4

2 に答える 2

2

これでうまくいくはずです（もしimport Control.Monad.Trans.ResourceそうならResourceT）：

instance (MonadThrow m) => MonadThrow (ResourceT m) where
    monadThrow = lift . monadThrow
于 2012-04-25T20:23:23.783 に答える
0

すべての回答をありがとう。ワープ-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)
于 2012-04-26T14:44:49.780 に答える