diff --git a/http-reverse-proxy.cabal b/http-reverse-proxy.cabal --- a/http-reverse-proxy.cabal +++ b/http-reverse-proxy.cabal @@ -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 diff --git a/test/main.hs b/test/main.hs --- a/test/main.hs +++ b/test/main.hs @@ -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