http-reverse-proxy 0.1.0.6 → 0.1.0.7
raw patch · 2 files changed
+98/−46 lines, 2 filesdep ~warpPVP ok
version bump matches the API change (PVP)
Dependency ranges changed: warp
API changes (from Hackage documentation)
Files
- http-reverse-proxy.cabal +3/−2
- test/main.hs +95/−44
http-reverse-proxy.cabal view
@@ -1,5 +1,5 @@ name: http-reverse-proxy-version: 0.1.0.6+version: 0.1.0.7 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@@ -41,12 +41,13 @@ , wai , http-types , hspec >= 1.3- , warp >= 1.3+ , warp >= 1.3.6 , bytestring , conduit , blaze-builder , transformers , lifted-base+ , network source-repository head type: git
test/main.hs view
@@ -1,63 +1,114 @@-{-# LANGUAGE OverloadedStrings #-}-import Control.Concurrent (forkIO, threadDelay)+{-# 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.Lazy.Char8 as L8-import Data.Conduit (yield, Flush (..), ($$+-), await, runResourceT)-import Data.Conduit.Network (serverSettings, runTCPServer)+import Data.Conduit (Flush (..), await, runResourceT,+ yield, ($$+-))+import Data.Conduit.Network (HostPreference (HostIPv4, HostAny),+ ServerSettings, bindPort,+ runTCPServer, serverAfterBind,+ serverSettings)+import qualified Data.Conduit.Network+import qualified Data.IORef as I import qualified Network.HTTP.Conduit as HC import Network.HTTP.ReverseProxy (ProxyDest (..), defaultOnExc, rawProxyTo, waiProxyTo, waiToRaw) import Network.HTTP.Types (status200)-import Network.Wai (responseLBS, Response (ResponseFile, ResponseSource))-import Network.Wai.Handler.Warp (run)-import Test.Hspec (describe, hspec, it, shouldBe)-import Blaze.ByteString.Builder (fromByteString)-import Control.Monad (forever)-import Control.Monad.IO.Class (liftIO)+import Network.Socket (sClose)+import Network.Wai (Response (ResponseFile, ResponseSource),+ responseLBS)+import qualified Network.Wai+import Network.Wai.Handler.Warp (defaultSettings, run, runSettings,+ settingsBeforeMainLoop,+ settingsPort)+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++getPort :: IO Int+getPort = do+ port <- I.atomicModifyIORef nextPort $ \p -> (p + 1, p)+ esocket <- try $ bindPort port HostIPv4+ 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 defaultSettings+ { settingsPort = port+ , settingsBeforeMainLoop = putMVar baton ()+ } app `onException` putMVar baton ())+ killThread+ (const $ takeMVar baton >> f port)++withCApp :: Data.Conduit.Network.Application 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 }+ 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" $ do+ it "works" $ let content = "mainApp"- manager <- HC.newManager HC.def- forkIO $ run 15000 $ const $ return $ responseLBS status200 [] content- forkIO $ run 15001 $ waiProxyTo (const $ return $ Right $ ProxyDest "localhost" 15000) defaultOnExc manager- forkIO $ runTCPServer (serverSettings 15002 "*") (rawProxyTo (const $ return $ Right $ ProxyDest "localhost" 15001))- threadDelay 100000- lbs <- HC.simpleHttp "http://localhost:15002"- lbs `shouldBe` content- it "deals with streaming data" $ do- manager <- HC.newManager HC.def- forkIO $ run 15003 $ const $ return $ ResponseSource status200 [] $ forever $ do- yield $ Chunk $ fromByteString "hello"- yield Flush- liftIO $ threadDelay 10000000- forkIO $ run 15004 $ waiProxyTo (const $ return $ Right $ ProxyDest "localhost" 15003) defaultOnExc manager- threadDelay 100000- req <- HC.parseUrl "http://localhost:15004"- mbs <- runResourceT $ timeout 1000000 $ do- res <- HC.http req manager- HC.responseBody res $$+- await- mbs `shouldBe` Just (Just "hello")+ in withMan $ \manager ->+ withWApp (const $ return $ responseLBS status200 [] content) $ \port1 ->+ withWApp (waiProxyTo (const $ return $ Right $ ProxyDest "localhost" port1) defaultOnExc manager) $ \port2 ->+ withCApp (rawProxyTo (const $ return $ Right $ ProxyDest "localhost" port2)) $ \port3 -> do+ lbs <- HC.simpleHttp $ "http://localhost:" ++ show port3+ lbs `shouldBe` content+ it "deals with streaming data" $+ let app _ = return $ ResponseSource status200 [] $ forever $ do+ yield $ Chunk $ fromByteString "hello"+ yield Flush+ liftIO $ threadDelay 10000000+ in withMan $ \manager ->+ withWApp app $ \port1 ->+ withWApp (waiProxyTo (const $ return $ Right $ ProxyDest "localhost" port1) defaultOnExc manager) $ \port2 -> do+ req <- HC.parseUrl $ "http://localhost:" ++ show port2+ mbs <- runResourceT $ timeout 1000000 $ do+ res <- HC.http req manager+ HC.responseBody res $$+- await+ mbs `shouldBe` Just (Just "hello") describe "waiToRaw" $ do it "works" $ do let content = "waiToRaw"- manager <- HC.newManager HC.def- let waiApp = const $ return $ responseLBS status200 [] content+ waiApp = const $ return $ responseLBS status200 [] content rawApp = waiToRaw waiApp- forkIO $ runTCPServer (serverSettings 16000 "*") (rawProxyTo (const $ return $ Left rawApp))- threadDelay 100000- lbs <- HC.simpleHttp "http://localhost:16000"- lbs `shouldBe` content+ withCApp (rawProxyTo (const $ return $ Left rawApp)) $ \port -> do+ lbs <- HC.simpleHttp $ "http://localhost:" ++ show port+ lbs `shouldBe` content it "sends files" $ do let content = "PONG" fp = "pong"- writeFile fp content- manager <- HC.newManager HC.def- let waiApp = const $ return $ ResponseFile status200 [] fp Nothing+ waiApp = const $ return $ ResponseFile status200 [] fp Nothing rawApp = waiToRaw waiApp- forkIO $ runTCPServer (serverSettings 16001 "*") (rawProxyTo (const $ return $ Left rawApp))- threadDelay 100000- lbs <- HC.simpleHttp "http://localhost:16001"- lbs `shouldBe` L8.pack content+ writeFile fp content+ withCApp (rawProxyTo (const $ return $ Left rawApp)) $ \port -> do+ lbs <- HC.simpleHttp $ "http://localhost:" ++ show port+ lbs `shouldBe` L8.pack content