2012-04-25 12 views
5

Sto provando a creare un semplice server proxy inverso usando Warp (principalmente per la mia edificazione, poiché ci sono molte altre opzioni disponibili in commercio).Come aggiungere un'istanza MonadThrow a ResourceT Monad Transformer in un server Warp

Finora, il mio codice è in gran parte sollevato dalla documentazione ordito (Scrittura output del file è solo un test intermedio, ancora una volta sollevato dalla documentazione):

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 

Quando si tenta di eseguire operazioni all'interno Network.HTTP il ResourceT Monad, il compilatore giustamente richiede che sia un'istanza di MonadThrow. La mia difficoltà è come aggiungere questo allo stack monad o aggiungere un'istanza di esso a ResourceT. L'errore del compilatore con il codice qui sotto è:

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 } 

Se rimuovo le linee HTTP, un'istanza MonadThrow non è più necessario, e tutto funziona bene.

Se definisco una nuova monade personalizzata come istanza di MonadThrow, come faccio a far funzionare realmente il server? Cerchi il modo corretto per introdurre questa gestione delle eccezioni nel mio stack (o anche solo per soddisfare il compilatore).

Grazie/O

+2

Avete un esempio di cosa non funziona? Questo compila bene qui ... usando ghc-7.4.1, http-conduit-1.4.1.2, conduit-0.4.1.1 e warp-1.2.0.1 –

+0

Sembra che sia a causa della mia versione di warp. Il codice sopra dà errore con warp-1.0.0.1 Ho aggiornato a warp-1.2.0.1 e ora funziona bene. Guardando Haddock, ResourceT non ha definito un caso di MonadThrow a 1.0.0.1 ma _does_ in 1.2.0.1 Anche se questo certamente risolve il problema immediato, come si potrebbe aggiungere l'istanza, se non è stato già incluso (ad esempio in 1.0.0.1)? Grazie !!!! – jdo

risposta

2

Questo dovrebbe farlo (se si import Control.Monad.Trans.Resource in modo da ottenere ResourceT):

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

'ResourceT' viene riesportato da' Data.Conduit' –

+0

Penso che dovrò contrassegnarlo come una risposta accettata, ma dovrò prenderlo sulla fede dato che non riesco a reinstallare il vecchio warp-1.0.0.1 (inferenza della dipendenza della cabala, anche con una directory .cabal pulita) - anche dopo aver annullato la registrazione di warp-1.2.0.1 (prima di rimuovere tutti i moduli locali), utilizza ancora l'esportazione Conduit originale e dà l'errore atteso ' Dichiarazioni di istanze duplicate'. In altre parole, il mio problema originale non è più facilmente riproducibile. Prenderò felicemente l'errore "Duplicate instance" come prova della validità della soluzione :) Grazie ancora!/O – jdo

0

Grazie per tutte le risposte. Finito con il codice sottostante che sembra funzionare perfettamente con 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) 
Problemi correlati