http-reverse-proxy-0.4.3.2/Network/0000755000000000000000000000000012623305664015313 5ustar0000000000000000http-reverse-proxy-0.4.3.2/Network/HTTP/0000755000000000000000000000000013000626731016061 5ustar0000000000000000http-reverse-proxy-0.4.3.2/test/0000755000000000000000000000000012623305664014641 5ustar0000000000000000http-reverse-proxy-0.4.3.2/Network/HTTP/ReverseProxy.hs0000644000000000000000000004706013000626731021101 0ustar0000000000000000{-# LANGUAGE FlexibleContexts #-} {-# LANGUAGE MultiParamTypeClasses #-} {-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE ScopedTypeVariables #-} {-# LANGUAGE LambdaCase #-} {-# LANGUAGE TupleSections #-} {-# LANGUAGE CPP #-} module Network.HTTP.ReverseProxy ( -- * Types ProxyDest (..) -- * Raw , rawProxyTo -- * WAI + http-conduit , waiProxyTo , defaultOnExc , waiProxyToSettings , WaiProxyResponse (..) -- ** Settings , WaiProxySettings , def , wpsOnExc , wpsTimeout , wpsSetIpHeader , wpsProcessBody , wpsUpgradeToRaw , wpsGetDest , SetIpHeader (..) -- *** Local settings , LocalWaiProxySettings , defaultLocalWaiProxySettings , setLpsTimeBound {- FIXME -- * WAI to Raw , waiToRaw -} ) where import Blaze.ByteString.Builder (Builder, fromByteString, toLazyByteString) import Control.Applicative ((<$>), (<|>)) import Control.Concurrent.Async (concurrently) import Control.Concurrent.Lifted (fork, killThread) import Control.Concurrent.MVar.Lifted (newEmptyMVar, putMVar, takeMVar) import Control.Exception (bracket) import Control.Exception.Lifted (SomeException, finally, try) import Control.Monad (unless, void) import Control.Monad.IO.Class (MonadIO, liftIO) import Control.Monad.Trans.Control (MonadBaseControl) import Data.ByteString (ByteString) import qualified Data.ByteString as S import qualified Data.ByteString.Char8 as S8 import qualified Data.ByteString.Lazy as L import qualified Data.CaseInsensitive as CI import Data.Conduit import qualified Data.Conduit.List as CL import qualified Data.Conduit.Network as DCN import Data.Default.Class (Default (..), def) import Data.Functor.Identity (Identity (..)) import Data.IORef import Data.Maybe (fromMaybe) import Data.Monoid (mappend, mconcat, (<>)) import Data.Set (Set) import qualified Data.Set as Set import Data.Streaming.Network (AppData, readLens) import qualified Data.Text.Lazy as TL import qualified Data.Text.Lazy.Encoding as TLE import Data.Word8 (isSpace, _colon, _cr) import Network.HTTP.Client (BodyReader, brRead) import qualified Network.HTTP.Client as HC import qualified Network.HTTP.Types as HT import qualified Network.Wai as WAI import Network.Wai.Logger (showSockAddr) import System.Timeout.Lifted (timeout) -- | Host\/port combination to which we want to proxy. data ProxyDest = ProxyDest { pdHost :: !ByteString , pdPort :: !Int } -- | Set up a reverse proxy server, which will have a minimal overhead. -- -- This function uses raw sockets, parsing as little of the request as -- possible. The workflow is: -- -- 1. Parse the first request headers. -- -- 2. Ask the supplied function to specify how to reverse proxy. -- -- 3. Open up a connection to the given host\/port. -- -- 4. Pass all bytes across the wire unchanged. -- -- If you need more control, such as modifying the request or response, use 'waiProxyTo'. rawProxyTo :: (MonadBaseControl IO m, MonadIO m) => (HT.RequestHeaders -> m (Either (DCN.AppData -> m ()) ProxyDest)) -- ^ How to reverse proxy. A @Left@ result will run the given -- 'DCN.Application', whereas a @Right@ will reverse proxy to the -- given host\/port. -> AppData -> m () rawProxyTo getDest appdata = do (rsrc, headers) <- liftIO $ fromClient $$+ getHeaders edest <- getDest headers case edest of Left app -> do -- We know that the socket will be closed by the toClient side, so -- we can throw away the finalizer here. irsrc <- liftIO $ newIORef rsrc let readData = do rsrc1 <- readIORef irsrc (rsrc2, mbs) <- rsrc1 $$++ await writeIORef irsrc rsrc2 return $ fromMaybe "" mbs app $ runIdentity (readLens (const (Identity readData)) appdata) Right (ProxyDest host port) -> liftIO $ DCN.runTCPClient (DCN.clientSettings port host) (withServer rsrc) where fromClient = DCN.appSource appdata toClient = DCN.appSink appdata withServer rsrc appdataServer = do x <- newEmptyMVar tid1 <- fork $ (rsrc $$+- toServer) `finally` putMVar x True tid2 <- fork $ (fromServer $$ toClient) `finally` putMVar x False y <- takeMVar x killThread $ if y then tid2 else tid1 where fromServer = DCN.appSource appdataServer toServer = DCN.appSink appdataServer -- | Sends a simple 502 bad gateway error message with the contents of the -- exception. defaultOnExc :: SomeException -> WAI.Application defaultOnExc exc _ sendResponse = sendResponse $ WAI.responseLBS HT.status502 [("content-type", "text/plain")] ("Error connecting to gateway:\n\n" <> TLE.encodeUtf8 (TL.pack $ show exc)) -- | The different responses that could be generated by a @waiProxyTo@ lookup -- function. -- -- Since 0.2.0 data WaiProxyResponse = WPRResponse WAI.Response -- ^ Respond with the given WAI Response. -- -- Since 0.2.0 | WPRProxyDest ProxyDest -- ^ Send to the given destination. -- -- Since 0.2.0 | WPRProxyDestSecure ProxyDest -- ^ Send to the given destination via HTTPS. | WPRModifiedRequest WAI.Request ProxyDest -- ^ Send to the given destination, but use the given -- modified Request for computing the reverse-proxied -- request. This can be useful for reverse proxying to -- a different path than the one specified. By the -- user. -- -- Since 0.2.0 | WPRModifiedRequestSecure WAI.Request ProxyDest -- ^ Same as WPRModifiedRequest but send to the -- given destination via HTTPS. | WPRApplication WAI.Application -- ^ Respond with the given WAI Application. -- -- Since 0.4.0 -- | Creates a WAI 'WAI.Application' which will handle reverse proxies. -- -- Connections to the proxied server will be provided via http-conduit. As -- such, all requests and responses will be fully processed in your reverse -- proxy. This allows you much more control over the data sent over the wire, -- but also incurs overhead. For a lower-overhead approach, consider -- 'rawProxyTo'. -- -- Most likely, the given application should be run with Warp, though in theory -- other WAI handlers will work as well. -- -- Note: This function will use chunked request bodies for communicating with -- the proxied server. Not all servers necessarily support chunked request -- bodies, so please confirm that yours does (Warp, Snap, and Happstack, for example, do). waiProxyTo :: (WAI.Request -> IO WaiProxyResponse) -- ^ How to reverse proxy. -> (SomeException -> WAI.Application) -- ^ How to handle exceptions when calling remote server. For a -- simple 502 error page, use 'defaultOnExc'. -> HC.Manager -- ^ connection manager to utilize -> WAI.Application waiProxyTo getDest onError = waiProxyToSettings getDest def { wpsOnExc = onError } data LocalWaiProxySettings = LocalWaiProxySettings { lpsTimeBound :: Maybe Int -- ^ Allows to specify the maximum time allowed for the conection on per request basis. -- -- Default: no timeouts -- -- Since 0.4.2 } instance Default LocalWaiProxySettings where def = LocalWaiProxySettings Nothing -- | Default value for 'LocalWaiProxySettings', same as 'def' but with a more explicit name. -- -- Since 0.4.2 defaultLocalWaiProxySettings :: LocalWaiProxySettings defaultLocalWaiProxySettings = def -- | Allows to specify the maximum time allowed for the conection on per request basis. -- -- Default: no timeouts -- -- Since 0.4.2 setLpsTimeBound :: Maybe Int -> LocalWaiProxySettings -> LocalWaiProxySettings setLpsTimeBound x s = s { lpsTimeBound = x } data WaiProxySettings = WaiProxySettings { wpsOnExc :: SomeException -> WAI.Application , wpsTimeout :: Maybe Int , wpsSetIpHeader :: SetIpHeader -- ^ Set the X-Real-IP request header with the client's IP address. -- -- Default: SIHFromSocket -- -- Since 0.2.0 , wpsProcessBody :: HC.Response () -> Maybe (Conduit ByteString IO (Flush Builder)) -- ^ Post-process the response body returned from the host. -- -- Since 0.2.1 , wpsUpgradeToRaw :: WAI.Request -> Bool -- ^ Determine if the request should be upgraded to a raw proxy connection, -- as is needed for WebSockets. Requires WAI 2.1 or higher and a WAI -- handler with raw response support (e.g., Warp) to work. -- -- Default: check if the upgrade header is websocket. -- -- Since 0.3.1 , wpsGetDest :: Maybe (WAI.Request -> IO (LocalWaiProxySettings, WaiProxyResponse)) -- ^ Allow to override proxy settings for each request. -- If you supply this field it will take precedence over -- getDest parameter in waiProxyToSettings -- -- Default: have one global setting -- -- Since 0.4.2 } -- | How to set the X-Real-IP request header. -- -- Since 0.2.0 data SetIpHeader = SIHNone -- ^ Do not set the header | SIHFromSocket -- ^ Set it from the socket's address. | SIHFromHeader -- ^ Set it from either X-Real-IP or X-Forwarded-For, if present instance Default WaiProxySettings where def = WaiProxySettings { wpsOnExc = defaultOnExc , wpsTimeout = Nothing , wpsSetIpHeader = SIHFromSocket , wpsProcessBody = const Nothing , wpsUpgradeToRaw = \req -> (CI.mk <$> lookup "upgrade" (WAI.requestHeaders req)) == Just "websocket" , wpsGetDest = Nothing } renderHeaders :: WAI.Request -> HT.RequestHeaders -> Builder renderHeaders req headers = fromByteString (WAI.requestMethod req) <> fromByteString " " <> fromByteString (WAI.rawPathInfo req) <> fromByteString (WAI.rawQueryString req) <> (if WAI.httpVersion req == HT.http11 then fromByteString " HTTP/1.1" else fromByteString " HTTP/1.0") <> mconcat (map goHeader headers) <> fromByteString "\r\n\r\n" where goHeader (x, y) = fromByteString "\r\n" <> fromByteString (CI.original x) <> fromByteString ": " <> fromByteString y tryWebSockets :: WaiProxySettings -> ByteString -> Int -> WAI.Request -> (WAI.Response -> IO b) -> IO b -> IO b tryWebSockets wps host port req sendResponse fallback | wpsUpgradeToRaw wps req = sendResponse $ flip WAI.responseRaw backup $ \fromClientBody toClient -> DCN.runTCPClient settings $ \server -> let toServer = DCN.appSink server fromServer = DCN.appSource server fromClient = do mapM_ yield $ L.toChunks $ toLazyByteString headers let loop = do bs <- liftIO fromClientBody unless (S.null bs) $ do yield bs loop loop toClient' = awaitForever $ liftIO . toClient headers = renderHeaders req $ fixReqHeaders wps req in void $ concurrently (fromClient $$ toServer) (fromServer $$ toClient') | otherwise = fallback where backup = WAI.responseLBS HT.status500 [("Content-Type", "text/plain")] "http-reverse-proxy detected WebSockets request, but server does not support responseRaw" settings = DCN.clientSettings port host strippedHeaders :: Set HT.HeaderName strippedHeaders = Set.fromList ["content-length", "transfer-encoding", "accept-encoding", "content-encoding"] fixReqHeaders :: WaiProxySettings -> WAI.Request -> HT.RequestHeaders fixReqHeaders wps req = addXRealIP $ filter (\(key, value) -> not $ key `Set.member` strippedHeaders || (key == "connection" && value == "close")) $ WAI.requestHeaders req where fromSocket = (("X-Real-IP", S8.pack $ showSockAddr $ WAI.remoteHost req):) addXRealIP = case wpsSetIpHeader wps of SIHFromSocket -> fromSocket SIHFromHeader -> case lookup "x-real-ip" (WAI.requestHeaders req) <|> lookup "X-Forwarded-For" (WAI.requestHeaders req) of Nothing -> fromSocket Just ip -> (("X-Real-IP", ip):) SIHNone -> id waiProxyToSettings :: (WAI.Request -> IO WaiProxyResponse) -> WaiProxySettings -> HC.Manager -> WAI.Application waiProxyToSettings getDest wps' manager req0 sendResponse = do let wps = wps'{wpsGetDest = wpsGetDest wps' <|> Just (fmap (LocalWaiProxySettings $ wpsTimeout wps',) . getDest)} (lps, edest') <- fromMaybe (const $ return (def, WPRResponse $ WAI.responseLBS HT.status500 [] "proxy not setup")) (wpsGetDest wps) req0 let edest = case edest' of WPRResponse res -> Left $ \_req -> ($ res) WPRProxyDest pd -> Right (pd, req0, False) WPRProxyDestSecure pd -> Right (pd, req0, True) WPRModifiedRequest req pd -> Right (pd, req, False) WPRModifiedRequestSecure req pd -> Right (pd, req, True) WPRApplication app -> Left app timeBound us f = timeout us f >>= \case Just res -> return res Nothing -> sendResponse $ WAI.responseLBS HT.status500 [] "timeBound" case edest of Left app -> maybe id timeBound (lpsTimeBound lps) $ app req0 sendResponse Right (ProxyDest host port, req, secure) -> tryWebSockets wps host port req sendResponse $ do let req' = #if MIN_VERSION_http_client(0, 5, 0) HC.defaultRequest { HC.checkResponse = \_ _ -> return () , HC.responseTimeout = maybe HC.responseTimeoutNone HC.responseTimeoutMicro $ lpsTimeBound lps #else def { HC.checkStatus = \_ _ _ -> Nothing , HC.responseTimeout = lpsTimeBound lps #endif , HC.method = WAI.requestMethod req , HC.secure = secure , HC.host = host , HC.port = port , HC.path = WAI.rawPathInfo req , HC.queryString = WAI.rawQueryString req , HC.requestHeaders = fixReqHeaders wps req , HC.requestBody = body , HC.redirectCount = 0 } body = case WAI.requestBodyLength req of WAI.KnownLength i -> HC.RequestBodyStream (fromIntegral i) ($ WAI.requestBody req) WAI.ChunkedBody -> HC.RequestBodyStreamChunked ($ WAI.requestBody req) bracket (try $ HC.responseOpen req' manager) (either (const $ return ()) HC.responseClose) $ \case Left e -> wpsOnExc wps e req sendResponse Right res -> do let conduit = fromMaybe (awaitForever (\bs -> yield (Chunk $ fromByteString bs) >> yield Flush)) (wpsProcessBody wps $ const () <$> res) src = bodyReaderSource $ HC.responseBody res sendResponse $ WAI.responseStream (HC.responseStatus res) (filter (\(key, _) -> not $ key `Set.member` strippedHeaders) $ HC.responseHeaders res) (\sendChunk flush -> src $= conduit $$ CL.mapM_ (\mb -> case mb of Flush -> flush Chunk b -> sendChunk b)) -- | Get the HTTP headers for the first request on the stream, returning on -- consumed bytes as leftovers. Has built-in limits on how many bytes it will -- consume (specifically, will not ask for another chunked after it receives -- 1000 bytes). getHeaders :: Monad m => Sink ByteString m HT.RequestHeaders getHeaders = toHeaders <$> go id where go front = await >>= maybe close push where close = leftover bs >> return bs where bs = front S8.empty push bs' | "\r\n\r\n" `S8.isInfixOf` bs || "\n\n" `S8.isInfixOf` bs || S8.length bs > 4096 = leftover bs >> return bs | otherwise = go $ mappend bs where bs = front bs' toHeaders = map toHeader . takeWhile (not . S8.null) . drop 1 . S8.lines toHeader bs = (CI.mk key, val) where (key, bs') = S.break (== _colon) bs val = S.takeWhile (/= _cr) $ S.dropWhile isSpace $ S.drop 1 bs' {- FIXME -- | Convert a WAI application into a raw application, using Warp. waiToRaw :: WAI.Application -> DCN.Application IO waiToRaw app appdata0 = loop fromClient0 where fromClient0 = DCN.appSource appdata0 toClient = DCN.appSink appdata0 loop fromClient = do mfromClient <- runResourceT $ withInternalState $ \internalState -> do ex <- try $ parseRequest conn internalState dummyAddr fromClient case ex of Left (_ :: SomeException) -> return Nothing Right (req, fromClient') -> do res <- app req keepAlive <- sendResponse defaultSettings req conn res (fromClient'', _) <- liftIO fromClient' >>= unwrapResumable return $ if keepAlive then Just fromClient'' else Nothing maybe (return ()) loop mfromClient dummyAddr = SockAddrInet (PortNum 0) 0 -- FIXME conn = Connection { connSendMany = \bss -> mapM_ yield bss $$ toClient , connSendAll = \bs -> yield bs $$ toClient , connSendFile = \fp offset len _th headers _cleaner -> let src1 = mapM_ yield headers src2 = sourceFileRange fp (Just offset) (Just len) in runResourceT $ (src1 >> src2) $$ transPipe lift toClient , connClose = return () , connRecv = error "connRecv should not be used" } -} bodyReaderSource :: MonadIO m => BodyReader -> Source m ByteString bodyReaderSource br = loop where loop = do bs <- liftIO $ brRead br unless (S.null bs) $ do yield bs loop http-reverse-proxy-0.4.3.2/test/main.hs0000644000000000000000000002136512623305664016130 0ustar0000000000000000{-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE ScopedTypeVariables #-} import Blaze.ByteString.Builder (fromByteString) import Control.Concurrent (forkIO, killThread, newEmptyMVar, putMVar, takeMVar, threadDelay) import Control.Exception (IOException, bracket, onException, try) import Control.Monad (forever, unless) import Control.Monad.IO.Class (liftIO) import Control.Monad.Trans.Resource (runResourceT) import qualified Data.ByteString as S import qualified Data.ByteString.Char8 as S8 import qualified Data.ByteString.Lazy.Char8 as L8 import Data.Char (toUpper) import Data.Conduit (await, yield, ($$), ($$+-), (=$), awaitForever) import qualified Data.Conduit.Binary as CB import qualified Data.Conduit.List as CL import Data.Conduit.Network (ServerSettings, appSink, appSource, clientSettings, runTCPClient, runTCPServer, serverSettings) import qualified Data.IORef as I import Data.Streaming.Network (AppData, bindPortTCP, setAfterBind) import qualified Network.HTTP.Conduit as HC import Network.HTTP.ReverseProxy (ProxyDest (..), WaiProxyResponse (..), defaultOnExc, rawProxyTo, waiProxyTo) import Network.HTTP.Types (status200, status500) import Network.Socket (sClose) import Network.Wai (rawPathInfo, responseLBS, responseStream) import qualified Network.Wai import Network.Wai.Handler.Warp (defaultSettings, runSettings, setBeforeMainLoop, setPort) import System.IO.Unsafe (unsafePerformIO) import System.Timeout.Lifted (timeout) import Test.Hspec (describe, hspec, it, shouldBe) nextPort :: I.IORef Int nextPort = unsafePerformIO $ I.newIORef 15452 {-# NOINLINE nextPort #-} getPort :: IO Int getPort = do port <- I.atomicModifyIORef nextPort $ \p -> (p + 1, p) esocket <- try $ bindPortTCP port "127.0.0.1" case esocket of Left (_ :: IOException) -> getPort Right socket -> do sClose socket return port withWApp :: Network.Wai.Application -> (Int -> IO ()) -> IO () withWApp app f = do port <- getPort baton <- newEmptyMVar bracket (forkIO $ runSettings (settings port baton) app `onException` putMVar baton ()) killThread (const $ takeMVar baton >> f port) where settings port baton = setPort port $ setBeforeMainLoop (putMVar baton ()) defaultSettings withCApp :: (AppData -> IO ()) -> (Int -> IO ()) -> IO () withCApp app f = do port <- getPort baton <- newEmptyMVar let start = putMVar baton () settings = setAfterBind (const start) (serverSettings port "*" :: ServerSettings) bracket (forkIO $ runTCPServer settings app `onException` start) killThread (const $ takeMVar baton >> f port) withMan :: (HC.Manager -> IO ()) -> IO () withMan = HC.withManager . (liftIO .) main :: IO () main = hspec $ do describe "http-reverse-proxy" $ do it "works" $ let content = "mainApp" in withMan $ \manager -> withWApp (\_ f -> f $ responseLBS status200 [] content) $ \port1 -> withWApp (waiProxyTo (const $ return $ WPRProxyDest $ ProxyDest "127.0.0.1" port1) defaultOnExc manager) $ \port2 -> withCApp (rawProxyTo (const $ return $ Right $ ProxyDest "127.0.0.1" port2)) $ \port3 -> do lbs <- HC.simpleHttp $ "http://127.0.0.1:" ++ show port3 lbs `shouldBe` content it "modified path" $ let content = "/somepath" app req f = f $ responseLBS status200 [] $ L8.fromChunks [rawPathInfo req] modReq pdest req = return $ WPRModifiedRequest (req { rawPathInfo = content }) pdest in withMan $ \manager -> withWApp app $ \port1 -> withWApp (waiProxyTo (modReq $ ProxyDest "127.0.0.1" port1) defaultOnExc manager) $ \port2 -> withCApp (rawProxyTo (const $ return $ Right $ ProxyDest "127.0.0.1" port2)) $ \port3 -> do lbs <- HC.simpleHttp $ "http://127.0.0.1:" ++ show port3 S8.concat (L8.toChunks lbs) `shouldBe` content it "deals with streaming data" $ let app _ f = f $ responseStream status200 [] $ \sendChunk flush -> forever $ do sendChunk $ fromByteString "hello" flush liftIO $ threadDelay 10000000 in withMan $ \manager -> withWApp app $ \port1 -> withWApp (waiProxyTo (const $ return $ WPRProxyDest $ ProxyDest "127.0.0.1" port1) defaultOnExc manager) $ \port2 -> do req <- HC.parseUrl $ "http://127.0.0.1:" ++ show port2 mbs <- runResourceT $ timeout 1000000 $ do res <- HC.http req manager HC.responseBody res $$+- await mbs `shouldBe` Just (Just "hello") it "passes on body length" $ let app req f = f $ responseLBS status200 [("uplength", show' $ Network.Wai.requestBodyLength req)] "" body = "some body" show' Network.Wai.ChunkedBody = "chunked" show' (Network.Wai.KnownLength i) = S8.pack $ show i in withMan $ \manager -> withWApp app $ \port1 -> withWApp (waiProxyTo (const $ return $ WPRProxyDest $ ProxyDest "127.0.0.1" port1) defaultOnExc manager) $ \port2 -> do req' <- HC.parseUrl $ "http://127.0.0.1:" ++ show port2 let req = req' { HC.requestBody = HC.RequestBodyBS body } mlen <- runResourceT $ do res <- HC.http req manager return $ lookup "uplength" $ HC.responseHeaders res mlen `shouldBe` Just (show' $ Network.Wai.KnownLength $ fromIntegral $ S.length body) it "upgrade to raw" $ let app _ f = f $ flip Network.Wai.responseRaw fallback $ \src sink -> do let src' = do bs <- liftIO src unless (S8.null bs) $ yield bs >> src' sink' = awaitForever $ liftIO . sink src' $$ CL.iterM print =$ CL.map (S8.map toUpper) =$ sink' fallback = responseLBS status500 [] "fallback used" in withMan $ \manager -> withWApp app $ \port1 -> withWApp (waiProxyTo (const $ return $ WPRProxyDest $ ProxyDest "127.0.0.1" port1) defaultOnExc manager) $ \port2 -> runTCPClient (clientSettings port2 "127.0.0.1") $ \ad -> do yield "GET / HTTP/1.1\r\nUpgrade: websockET\r\n\r\n" $$ appSink ad yield "hello" $$ appSink ad (appSource ad $$ CB.take 5) >>= (`shouldBe` "HELLO") {- FIXME describe "waiToRaw" $ do it "works" $ do let content = "waiToRaw" waiApp = const $ return $ responseLBS status200 [] content rawApp = waiToRaw waiApp withCApp (rawProxyTo (const $ return $ Left rawApp)) $ \port -> do lbs <- HC.simpleHttp $ "http://127.0.0.1:" ++ show port lbs `shouldBe` content it "sends files" $ do let content = "PONG" fp = "pong" waiApp = const $ return $ responseFile status200 [] fp Nothing rawApp = waiToRaw waiApp writeFile fp content withCApp (rawProxyTo (const $ return $ Left rawApp)) $ \port -> do lbs <- HC.simpleHttp $ "http://127.0.0.1:" ++ show port lbs `shouldBe` L8.pack content -} http-reverse-proxy-0.4.3.2/LICENSE0000644000000000000000000000277012623305664014675 0ustar0000000000000000Copyright (c) 2012, Michael Snoyman All rights reserved. Redistribution and use in source and binary forms, with or without modification, are permitted provided that the following conditions are met: * Redistributions of source code must retain the above copyright notice, this list of conditions and the following disclaimer. * Redistributions in binary form must reproduce the above copyright notice, this list of conditions and the following disclaimer in the documentation and/or other materials provided with the distribution. * Neither the name of Michael Snoyman nor the names of other contributors may be used to endorse or promote products derived from this software without specific prior written permission. THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. http-reverse-proxy-0.4.3.2/Setup.hs0000644000000000000000000000005612623305664015317 0ustar0000000000000000import Distribution.Simple main = defaultMain http-reverse-proxy-0.4.3.2/http-reverse-proxy.cabal0000644000000000000000000000474213004424144020451 0ustar0000000000000000name: http-reverse-proxy version: 0.4.3.2 synopsis: Reverse proxy HTTP requests, either over raw sockets or with WAI description: Provides a simple means of reverse-proxying HTTP requests. The raw approach uses the same technique as leveraged by keter, whereas the WAI approach performs full request/response parsing via WAI and http-conduit. homepage: https://github.com/fpco/http-reverse-proxy license: BSD3 license-file: LICENSE author: Michael Snoyman maintainer: michael@fpcomplete.com category: Web build-type: Simple cabal-version: >=1.8 extra-source-files: README.md ChangeLog.md library exposed-modules: Network.HTTP.ReverseProxy other-modules: Paths_http_reverse_proxy build-depends: base >= 4.6 && < 5 , monad-control >= 0.3 , lifted-base >= 0.1 , text >= 0.11 , bytestring >= 0.9 , case-insensitive >= 0.4 , http-types >= 0.6 , word8 >= 0.0 , blaze-builder >= 0.3 , http-client >= 0.3 , wai >= 3.0 , network , conduit >= 1.1 , conduit-extra , data-default-class , wai-logger , resourcet , containers , async , transformers , streaming-commons test-suite test type: exitcode-stdio-1.0 main-is: main.hs hs-source-dirs: test build-depends: base , http-reverse-proxy , wai , http-types , hspec >= 1.3 , warp >= 2.1 , bytestring , conduit >= 1.1 , conduit-extra , blaze-builder , transformers , lifted-base , network , http-conduit , resourcet , streaming-commons source-repository head type: git location: git://github.com/fpco/http-reverse-proxy.git http-reverse-proxy-0.4.3.2/README.md0000644000000000000000000000121312623305664015136 0ustar0000000000000000http-reverse-proxy ================== Provides a simple means of reverse-proxying HTTP requests. The raw approach uses the same technique as leveraged by keter, whereas the WAI approach performs full request/response parsing via WAI and http-conduit. ## Raw example The following sets up raw reverse proxying from local port 3000 to www.example.com, port 80. ```haskell {-# LANGUAGE OverloadedStrings #-} import Network.HTTP.ReverseProxy import Data.Conduit.Network main :: IO () main = runTCPServer (serverSettings 3000 "*") $ \appData -> rawProxyTo (\_headers -> return $ Right $ ProxyDest "www.example.com" 80) appData ``` http-reverse-proxy-0.4.3.2/ChangeLog.md0000644000000000000000000000063613004424154016026 0ustar0000000000000000## 0.4.3.2 * Minor doc cleanup ## 0.4.3.1 * Use CPP so we can work with `http-client` pre and post 0.5 [#17](https://github.com/fpco/http-reverse-proxy/pull/17) ## 0.4.3 * Allow proxying to HTTPS servers. [#15](https://github.com/fpco/http-reverse-proxy/pull/15) ## 0.4.2 * Add configurable timeouts [#8](https://github.com/fpco/http-reverse-proxy/pull/8) ## 0.4.1.3 * Include README.md and ChangeLog.md