{-# LANGUAGE OverloadedStrings #-} import Control.Concurrent (forkIO, threadDelay) import qualified Data.ByteString.Lazy.Char8 as L8 import Data.Conduit (yield, Flush (..), ($$+-), await, runResourceT) import Data.Conduit.Network (serverSettings, runTCPServer) 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 System.Timeout.Lifted (timeout) main :: IO () main = hspec $ do describe "http-reverse-proxy" $ do it "works" $ do 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") describe "waiToRaw" $ do it "works" $ do let content = "waiToRaw" manager <- HC.newManager HC.def let 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 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 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