http-reverse-proxy 0.3.1.8 → 0.4.0
raw patch · 3 files changed
+13/−156 lines, 3 filesdep ~conduitdep ~http-clientdep ~network-conduitPVP ok
version bump matches the API change (PVP)
Dependency ranges changed: conduit, http-client, network-conduit
API changes (from Hackage documentation)
+ Network.HTTP.ReverseProxy: WPRApplication :: Application -> WaiProxyResponse
Files
- Network/HTTP/ReverseProxy.hs +7/−148
- http-reverse-proxy.cabal +3/−4
- test/main.hs +3/−4
Network/HTTP/ReverseProxy.hs view
@@ -1,5 +1,4 @@ {-# LANGUAGE OverloadedStrings, FlexibleContexts, ScopedTypeVariables #-}-{-# LANGUAGE CPP #-} module Network.HTTP.ReverseProxy ( -- * Types ProxyDest (..)@@ -26,23 +25,15 @@ ) where import Data.Conduit-#if MIN_VERSION_conduit(1,1,0) import Data.Streaming.Network (readLens, AppData) import Data.Functor.Identity (Identity (..)) import Data.Maybe (fromMaybe)-#else-import Data.Conduit.Network (AppData)-#endif import Control.Monad.Trans.Control (MonadBaseControl) import Data.Default.Class (def) import qualified Network.Wai as WAI import qualified Network.HTTP.Client as HC import Network.HTTP.Client (BodyReader, brRead)-#if MIN_VERSION_wai(3,0,0) import Control.Exception (bracket)-#else-import Control.Exception (bracketOnError)-#endif import Blaze.ByteString.Builder (fromByteString) import Data.Word8 (isSpace, _colon, _cr) import qualified Data.ByteString as S@@ -58,17 +49,12 @@ import Network.Wai.Logger (showSockAddr) import qualified Data.Set as Set import Data.IORef-#if MIN_VERSION_wai(2, 1, 0) import qualified Data.ByteString.Lazy as L import Control.Concurrent.Async (concurrently) import Blaze.ByteString.Builder (Builder, toLazyByteString)-#else-import Blaze.ByteString.Builder (Builder)-#endif import Data.ByteString (ByteString) import Control.Monad.IO.Class (MonadIO, liftIO) import Control.Monad (unless, void)-import Data.Int (Int64) import Data.Monoid (mappend, (<>), mconcat) import Control.Exception.Lifted (try, SomeException, finally) import Control.Applicative ((<$>), (<|>))@@ -95,33 +81,19 @@ -- 4. Pass all bytes across the wire unchanged. -- -- If you need more control, such as modifying the request or response, use 'waiProxyTo'.-#if MIN_VERSION_conduit(1,1,0) 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 ()-#else-rawProxyTo :: (MonadBaseControl IO m, MonadIO m)- => (HT.RequestHeaders -> m (Either (DCN.AppData m -> 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 -> m ()-#endif rawProxyTo getDest appdata = do-#if MIN_VERSION_conduit(1,1,0) (rsrc, headers) <- liftIO $ fromClient $$+ getHeaders-#else- (rsrc, headers) <- fromClient $$+ getHeaders-#endif 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.-#if MIN_VERSION_conduit(1,1,0) irsrc <- liftIO $ newIORef rsrc let readData = do rsrc1 <- readIORef irsrc@@ -129,17 +101,9 @@ writeIORef irsrc rsrc2 return $ fromMaybe "" mbs app $ runIdentity (readLens (const (Identity readData)) appdata)-#else- (fromClient', _) <- unwrapResumable rsrc- app appdata { DCN.appSource = fromClient' }-#endif -#if MIN_VERSION_conduit(1,1,0) Right (ProxyDest host port) -> liftIO $ DCN.runTCPClient (DCN.clientSettings port host) (withServer rsrc)-#else- Right (ProxyDest host port) -> DCN.runTCPClient (DCN.clientSettings port host) (withServer rsrc)-#endif where fromClient = DCN.appSource appdata toClient = DCN.appSink appdata@@ -156,11 +120,7 @@ -- | Sends a simple 502 bad gateway error message with the contents of the -- exception. defaultOnExc :: SomeException -> WAI.Application-#if MIN_VERSION_wai(3,0,0) defaultOnExc exc _ sendResponse = sendResponse $ WAI.responseLBS-#else-defaultOnExc exc _ = return $ WAI.responseLBS-#endif HT.status502 [("content-type", "text/plain")] ("Error connecting to gateway:\n\n" <> TLE.encodeUtf8 (TL.pack $ show exc))@@ -185,6 +145,10 @@ -- user. -- -- Since 0.2.0+ | WPRApplication WAI.Application+ -- ^ Respond with the given WAI Application.+ --+ -- Since 0.4.0 -- | Creates a WAI 'WAI.Application' which will handle reverse proxies. --@@ -250,7 +214,6 @@ (CI.mk <$> lookup "upgrade" (WAI.requestHeaders req)) == Just "websocket" } -#if MIN_VERSION_wai(2, 1, 0) renderHeaders :: WAI.Request -> HT.RequestHeaders -> Builder renderHeaders req headers = fromByteString (WAI.requestMethod req)@@ -268,9 +231,7 @@ <> fromByteString (CI.original x) <> fromByteString ": " <> fromByteString y-#endif -#if MIN_VERSION_wai(3, 0, 0) tryWebSockets :: WaiProxySettings -> ByteString -> Int -> WAI.Request -> (WAI.Response -> IO b) -> IO b -> IO b tryWebSockets wps host port req sendResponse fallback | wpsUpgradeToRaw wps req =@@ -297,34 +258,6 @@ "http-reverse-proxy detected WebSockets request, but server does not support responseRaw" settings = DCN.clientSettings port host -#else--tryWebSockets :: WaiProxySettings -> ByteString -> Int -> WAI.Request -> IO WAI.Response -> IO WAI.Response-#if MIN_VERSION_wai(2, 1, 0)-tryWebSockets wps host port req fallback- | wpsUpgradeToRaw wps req =- return $ 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- fromClientBody- 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-#else-tryWebSockets _ _ _ _ = id-#endif--#endif- strippedHeaders :: Set HT.HeaderName strippedHeaders = Set.fromList ["content-length", "transfer-encoding", "accept-encoding", "content-encoding"]@@ -348,16 +281,16 @@ -> WaiProxySettings -> HC.Manager -> WAI.Application-#if MIN_VERSION_wai(3,0,0) waiProxyToSettings getDest wps manager req0 sendResponse = do edest' <- getDest req0 let edest = case edest' of- WPRResponse res -> Left res+ WPRResponse res -> Left $ \_req -> ($ res) WPRProxyDest pd -> Right (pd, req0) WPRModifiedRequest req pd -> Right (pd, req)+ WPRApplication app -> Left app case edest of- Left response -> sendResponse response+ Left app -> app req0 sendResponse Right (ProxyDest host port, req) -> tryWebSockets wps host port req sendResponse $ do let req' = def { HC.method = WAI.requestMethod req@@ -396,58 +329,6 @@ case mb of Flush -> flush Chunk b -> sendChunk b))-#else-waiProxyToSettings getDest wps manager req0 = do- edest' <- getDest req0- let edest =- case edest' of- WPRResponse res -> Left res- WPRProxyDest pd -> Right (pd, req0)- WPRModifiedRequest req pd -> Right (pd, req)- case edest of- Left response -> return response- Right (ProxyDest host port, req) -> tryWebSockets wps host port req $ do- let req' = def- { HC.method = WAI.requestMethod req- , 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- , HC.checkStatus = \_ _ _ -> Nothing- , HC.responseTimeout = wpsTimeout wps- }- bodyChunked = requestBodySourceChunked $ WAI.requestBody req- body =- case WAI.requestBodyLength req of- WAI.KnownLength i -> requestBodySource- (fromIntegral i)- (WAI.requestBody req)- WAI.ChunkedBody -> bodyChunked- bracketOnError- (try $ HC.responseOpen req' manager)- (either (const $ return ()) HC.responseClose)- $ \ex -> do- case ex of- Left e -> wpsOnExc wps e req- Right res -> do- let conduit =- case wpsProcessBody wps $ fmap (const ()) res of- Nothing -> awaitForever (\bs -> yield (Chunk $ fromByteString bs) >> yield Flush)- Just conduit' -> conduit'- WAI.responseSourceBracket- (return ())- (\() -> HC.responseClose res)- $ \() -> do- let src = bodyReaderSource $ HC.responseBody res- return- ( HC.responseStatus res- , filter (\(key, _) -> not $ key `Set.member` strippedHeaders) $ HC.responseHeaders res- , src $= conduit- )-#endif -- | 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@@ -513,28 +394,6 @@ , connRecv = error "connRecv should not be used" } -}--requestBodySource :: Int64 -> Source IO ByteString -> HC.RequestBody-requestBodySource size = HC.RequestBodyStream size . srcToPopper--requestBodySourceChunked :: Source IO ByteString -> HC.RequestBody-requestBodySourceChunked = HC.RequestBodyStreamChunked . srcToPopper--srcToPopper :: Source IO ByteString -> HC.GivesPopper ()-srcToPopper src f = do- (rsrc0, ()) <- src $$+ return ()- irsrc <- newIORef rsrc0- let popper :: IO ByteString- popper = do- rsrc <- readIORef irsrc- (rsrc', mres) <- rsrc $$++ await- writeIORef irsrc rsrc'- case mres of- Nothing -> return S.empty- Just bs- | S.null bs -> popper- | otherwise -> return bs- f popper bodyReaderSource :: MonadIO m => BodyReader -> Source m ByteString bodyReaderSource br =
http-reverse-proxy.cabal view
@@ -1,5 +1,5 @@ name: http-reverse-proxy-version: 0.3.1.8+version: 0.4.0 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@@ -17,17 +17,16 @@ build-depends: base >= 4 && < 5 , monad-control >= 0.3 , lifted-base >= 0.1- , network-conduit >= 0.6 , text >= 0.11 , bytestring >= 0.9 , case-insensitive >= 0.4 , http-types >= 0.6 , word8 >= 0.0 , blaze-builder >= 0.3- , http-client >= 0.1+ , http-client >= 0.3 , wai >= 3.0 , network- , conduit >= 0.5+ , conduit >= 1.1 , conduit-extra , data-default-class , wai-logger
test/main.hs view
@@ -12,17 +12,16 @@ import qualified Data.ByteString.Char8 as S8 import qualified Data.ByteString.Lazy.Char8 as L8 import Data.Char (toUpper)-import Data.Conduit (Flush (..), await, yield, ($$),+import Data.Conduit (await, yield, ($$), ($$+-), (=$), awaitForever) import qualified Data.Conduit.Binary as CB import qualified Data.Conduit.List as CL-import Data.Conduit.Network (HostPreference, ServerSettings,+import Data.Conduit.Network (ServerSettings, appSink, appSource, clientSettings, runTCPClient, runTCPServer, serverSettings)-import qualified Data.Conduit.Network import qualified Data.IORef as I-import Data.Streaming.Network (AppData, HostPreference,+import Data.Streaming.Network (AppData, bindPortTCP, setAfterBind) import qualified Network.HTTP.Conduit as HC import Network.HTTP.ReverseProxy (ProxyDest (..),