Как добавить экземпляр MonadThrow в ResourceT Monad Transformer на сервере Warp

Я пытаюсь создать простой обратный прокси-сервер с помощью 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

Когда я пытаюсь запустить операции Network.HTTP внутри монады ResourceT, компилятор справедливо требует, чтобы она была экземпляром 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, как заставить сервер работать с ее использованием? Ищу правильный способ ввести эту обработку исключений в свой стек (или даже просто удовлетворить компилятор).

Спасибо/О


haskell haskell-warp
person jdo    schedule 25.04.2012    source источник
comment
У вас есть пример того, что не работает? Здесь все отлично компилируется... с использованием ghc-7.4.1, http-conduit-1.4.1.2, conduit-0.4.1.1 и warp-1.2.0.1   -  person Nathan Howell    schedule 25.04.2012
comment
Похоже, это из-за моей версии варпа. Код выше дает ошибку с warp-1.0.0.1 Я обновился до warp-1.2.0.1 и теперь работает нормально. Глядя на Haddock, ResourceT не определял экземпляр MonadThrow в 1.0.0.1, но определяет в 1.2.0.1 Хотя это, безусловно, решает насущную проблему, как добавить экземпляр, если он еще не включен? (например, в 1.0.0.1)? Спасибо!!!!   -  person jdo    schedule 25.04.2012

Ответы (2)


arrow_upward
2
arrow_downward

Это должно сделать это (если вы import Control.Monad.Trans.Resource, чтобы получить ResourceT):

instance (MonadThrow m) => MonadThrow (ResourceT m) where
    monadThrow = lift . monadThrow
person Venge    schedule 25.04.2012
comment
ResourceT реэкспортируется из Data.Conduit - person Nathan Howell; 26.04.2012
comment
Я думаю, что мне придется пометить это как принятый ответ, но мне придется принять его на веру, поскольку я не могу переустановить старый warp-1.0.0.1 (ад зависимостей клики, даже с чистым файлом . cabal) -- даже после отмены регистрации warp-1.2.0.1 (до удаления всех локальных модулей) он по-прежнему использует исходный экспорт Conduit и выдает ожидаемую ошибку Duplicate instance declarations. Другими словами, мою первоначальную проблему уже нелегко воспроизвести. Я с радостью приму ошибку Duplicate instances как доказательство правильности решения :) Еще раз спасибо! /О - person jdo; 26.04.2012

arrow_upward
0
arrow_downward

Спасибо за все ответы. В итоге получился приведенный ниже код, который отлично работает с 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)
person jdo    schedule 26.04.2012