http-reverse-proxy 0.3.1.4 → 0.3.1.5
raw patch · 2 files changed
+46/−59 lines, 2 filesdep ~conduitdep ~warp
Dependency ranges changed: conduit, warp
Files
- http-reverse-proxy.cabal +6/−3
- test/main.hs +40/−56
http-reverse-proxy.cabal view
@@ -1,5 +1,5 @@ name: http-reverse-proxy-version: 0.3.1.4+version: 0.3.1.5 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@@ -47,14 +47,17 @@ , wai , http-types , hspec >= 1.3- , warp >= 1.3.6+ , warp >= 2.1 , bytestring- , conduit+ , conduit >= 1.1+ , conduit-extra , blaze-builder , transformers , lifted-base , network , http-conduit+ , resourcet+ , streaming-commons source-repository head type: git
test/main.hs view
@@ -1,48 +1,44 @@-{-# LANGUAGE CPP #-} {-# 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)-import Control.Monad.IO.Class (liftIO)-import qualified Data.ByteString as S-import qualified Data.ByteString.Char8 as S8-import qualified Data.ByteString.Lazy.Char8 as L8-import Data.Conduit (Flush (..), await, runResourceT,- yield, ($$+-), (=$), ($$))-import Data.Conduit.Network (HostPreference (HostIPv4, HostAny),- ServerSettings, bindPort,- runTCPServer, serverAfterBind,- serverSettings, runTCPClient, clientSettings, appSource, appSink)-import qualified Data.Conduit.Binary as CB-import Data.Char (toUpper)-import qualified Data.Conduit.List as CL+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)+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 (Flush (..), await, yield, ($$),+ ($$+-), (=$))+import qualified Data.Conduit.Binary as CB+import qualified Data.Conduit.List as CL+import Data.Conduit.Network (HostPreference, ServerSettings,+ appSink, appSource,+ clientSettings, runTCPClient,+ runTCPServer, serverSettings) import qualified Data.Conduit.Network-import qualified Data.IORef as I-import qualified Network.HTTP.Conduit as HC-import Network.HTTP.ReverseProxy (ProxyDest (..),- WaiProxyResponse (..),- defaultOnExc, rawProxyTo,- waiProxyTo{- FIXME, waiToRaw-})-import Network.HTTP.Types (status200, status500)-import Network.Socket (sClose)-import Network.Wai (responseSource,- rawPathInfo, responseLBS)+import qualified Data.IORef as I+import Data.Streaming.Network (AppData, HostPreference,+ 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,+ responseSource) import qualified Network.Wai-import Network.Wai.Handler.Warp (defaultSettings, runSettings,-#if MIN_VERSION_warp(2, 1, 0)- setBeforeMainLoop,- setPort)-#else- settingsBeforeMainLoop,- settingsPort)-#endif-import System.IO.Unsafe (unsafePerformIO)-import System.Timeout.Lifted (timeout)-import Test.Hspec (describe, hspec, it, shouldBe)+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@@ -50,7 +46,7 @@ getPort :: IO Int getPort = do port <- I.atomicModifyIORef nextPort $ \p -> (p + 1, p)- esocket <- try $ bindPort port HostIPv4+ esocket <- try $ bindPortTCP port "*4" case esocket of Left (_ :: IOException) -> getPort Right socket -> do@@ -67,25 +63,17 @@ killThread (const $ takeMVar baton >> f port) where-#if MIN_VERSION_warp(2, 1, 0) settings port baton = setPort port $ setBeforeMainLoop (putMVar baton ()) defaultSettings-#else- settings port baton = defaultSettings- { settingsPort = port- , settingsBeforeMainLoop = putMVar baton ()- }-#endif -withCApp :: Data.Conduit.Network.Application IO -> (Int -> IO ()) -> IO ()+withCApp :: (AppData -> IO ()) -> (Int -> IO ()) -> IO () withCApp app f = do port <- getPort baton <- newEmptyMVar let start = putMVar baton ()- settings :: ServerSettings IO- settings = (serverSettings port HostAny :: ServerSettings IO) { serverAfterBind = const start }+ settings = setAfterBind (const start) (serverSettings port "*" :: ServerSettings) bracket (forkIO $ runTCPServer settings app `onException` start) killThread@@ -130,7 +118,6 @@ res <- HC.http req manager HC.responseBody res $$+- await mbs `shouldBe` Just (Just "hello")-#if MIN_VERSION_wai(1, 4, 0) it "passes on body length" $ let app req = return $ responseLBS status200@@ -153,8 +140,6 @@ $ Network.Wai.KnownLength $ fromIntegral $ S.length body)-#endif-#if MIN_VERSION_warp(2, 1, 0) it "upgrade to raw" $ let app _ = return $ flip Network.Wai.responseRaw fallback $ \src sink -> src $$ CL.iterM print =$ CL.map (S8.map toUpper) =$ sink@@ -166,7 +151,6 @@ 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")-#endif {- FIXME describe "waiToRaw" $ do it "works" $ do