diff --git a/ChangeLog.md b/ChangeLog.md --- a/ChangeLog.md +++ b/ChangeLog.md @@ -2,6 +2,12 @@ `wai-middleware-delegate` uses [PVP Versioning][1]. +## 0.1.4.0 -- 2023-17-11 + +* Relax the upper bounds on bytestring to allow bytestring 0.12.1 +* Remove dependencies on http-conduit and connection +* Switch to running the integration tests using http-bin in docker + ## 0.1.3.1 -- 2022-08-09 * Relax the version bounds so that pre 2.0 versions of text are still supported diff --git a/Setup.hs b/Setup.hs --- a/Setup.hs +++ b/Setup.hs @@ -1,2 +1,4 @@ import Distribution.Simple + + main = defaultMain diff --git a/src/Network/Wai/Middleware/Delegate.hs b/src/Network/Wai/Middleware/Delegate.hs --- a/src/Network/Wai/Middleware/Delegate.hs +++ b/src/Network/Wai/Middleware/Delegate.hs @@ -1,5 +1,9 @@ +{-# LANGUAGE FlexibleContexts #-} +{-# LANGUAGE MultiParamTypeClasses #-} {-# LANGUAGE OverloadedStrings #-} -{-| +{-# LANGUAGE RankNTypes #-} + +{- | Copyright : (c) 2018-2021 Tim Emiola SPDX-License-Identifier: BSD3 Maintainer : Tim Emiola @@ -17,9 +21,7 @@ * 'simpleProxy': is a simple reverse proxy, based on proxyApp of http-proxy by Erik de Castro Lopo/Michael Snoyman - -} - module Network.Wai.Middleware.Delegate ( -- * Middleware delegateTo @@ -27,169 +29,257 @@ , simpleProxy -- * Configuration - , ProxySettings(..) + , ProxySettings (..) -- * Aliases , RequestPredicate ) - where -import Control.Exception (SomeException, handle, - toException) -import Control.Monad.IO.Class (MonadIO, liftIO) -import qualified Data.ByteString as BS -import qualified Data.ByteString.Char8 as C8 -import qualified Data.ByteString.Lazy.Char8 as LC8 -import Data.Monoid ((<>)) -import Data.String (IsString) +import Blaze.ByteString.Builder (fromByteString) +import Control.Concurrent.Async (race_) +import Control.Exception + ( SomeException + , handle + , toException + ) +import Control.Monad (unless) +import Control.Monad.IO.Class (MonadIO, liftIO) +import Data.ByteString (ByteString) +import qualified Data.ByteString as BS +import qualified Data.ByteString.Char8 as C8 +import qualified Data.ByteString.Lazy.Char8 as LC8 +import Data.CaseInsensitive (mk) +import Data.Conduit + ( ConduitM + , ConduitT + , Flush (..) + , Void + , await + , mapOutput + , runConduit + , yield + , ($$+) + , ($$++) + , (.|) + ) +import Data.Conduit.Network (appSink, appSource) +import Data.Default (Default (..)) +import Data.IORef (newIORef, readIORef, writeIORef) +import Data.Int (Int64) +import Data.Monoid ((<>)) +import Data.Streaming.Network + ( ClientSettings + , clientSettingsTCP + , runTCPClient + ) +import Data.String (IsString) +import Network.HTTP.Client + ( BodyReader + , GivesPopper + , Manager + , Request (..) + , RequestBody (..) + , Response (..) + , brRead + , parseRequest + , withResponse + ) +import Network.HTTP.Types + ( Header + , HeaderName + , hContentType + , internalServerError500 + , status304 + , status500 + ) +import Network.HTTP.Types.Header (hHost) +import qualified Network.Wai as Wai +import Network.Wai.Conduit + ( responseRawSource + , responseSource + , sourceRequestBody + ) -import Blaze.ByteString.Builder (fromByteString) -import Control.Concurrent.Async (race_) -import Data.CaseInsensitive (mk) -import Data.Conduit (ConduitT, Flush (..), Void, - mapOutput, runConduit, yield, - (.|)) -import Data.Conduit.Network (appSink, appSource) -import Data.Default (Default (..)) -import Data.Streaming.Network (ClientSettings, clientSettingsTCP, - runTCPClient) -import Network.HTTP.Client (Manager, Request (..), - Response (..), parseRequest, - withResponse) -import Network.HTTP.Client.Conduit (bodyReaderSource) -import Network.HTTP.Conduit (requestBodySourceChunkedIO, - requestBodySourceIO) -import Network.HTTP.Types (hContentType, - internalServerError500, status304, - status500) -import Network.HTTP.Types.Header (hHost) -import qualified Network.Wai as Wai -import Network.Wai.Conduit (responseRawSource, responseSource, - sourceRequestBody) --- | Type alias for a function that determines if a request should be handled by --- a delegate. +{- | Type alias for a function that determines if a request should be handled by + a delegate. +-} type RequestPredicate = Wai.Request -> Bool --- | Create a middleware that handles all requests matching a predicate by --- delegating to an alternate Application. + +{- | Create a middleware that handles all requests matching a predicate by + delegating to an alternate Application. +-} delegateTo :: Wai.Application -> RequestPredicate -> Wai.Middleware delegateTo alt f actual req | f req = alt req | otherwise = actual req --- | Creates a middleware that handles all requests matching a predicate by --- proxing them to a host specified by ProxySettings. + +{- | Creates a middleware that handles all requests matching a predicate by + proxing them to a host specified by ProxySettings. +-} delegateToProxy :: ProxySettings -> Manager -> RequestPredicate -> Wai.Middleware delegateToProxy settings mgr = delegateTo (simpleProxy settings mgr) + -- | Settings that configure the proxy endpoint. -data ProxySettings = - ProxySettings - { -- | What to do with exceptions thrown by either the application or server. - proxyOnException :: SomeException -> Wai.Response - -- | Timeout value in seconds. Default value: 30 - , proxyTimeout :: Int - -- | The host being proxied - , proxyHost :: BS.ByteString - -- | The number of redirects to follow. 0 means none, which is the default. +data ProxySettings = ProxySettings + { proxyOnException :: SomeException -> Wai.Response + -- ^ What to do with exceptions thrown by either the application or server. + , proxyTimeout :: Int + -- ^ Timeout value in seconds. Default value: 30 + , proxyHost :: BS.ByteString + -- ^ The host being proxied , proxyRedirectCount :: Int + -- ^ The number of redirects to follow. 0 means none, which is the default. } + instance Default ProxySettings where - -- | The default settings for the Proxy server. See the individual settings for - -- the default value. - def = ProxySettings - { -- defaults to returning internal server error showing the error in the body - proxyOnException = onException - -- default to 15 seconds - , proxyTimeout = 15 - , proxyHost = "localhost" - , proxyRedirectCount = 0 - } + def = + ProxySettings + { -- defaults to returning internal server error showing the error in the body + proxyOnException = onException + , -- default to 15 seconds + proxyTimeout = 15 + , proxyHost = "localhost" + , proxyRedirectCount = 0 + } where onException :: SomeException -> Wai.Response onException e = - Wai.responseLBS internalServerError500 - [ (hContentType, "text/plain; charset=utf-8") ] $ - LC8.fromChunks [C8.pack $ show e] + Wai.responseLBS + internalServerError500 + [(hContentType, "text/plain; charset=utf-8")] + $ LC8.fromChunks [C8.pack $ show e] + -- | A Wai Application that acts as a http/https proxy. -simpleProxy - :: ProxySettings - -> Manager - -> Wai.Application +simpleProxy :: + ProxySettings -> + Manager -> + Wai.Application simpleProxy settings manager req respond - -- we may connect requests to secure sites, when we do, we will not have - -- seen their URI properly - | Wai.requestMethod req == "CONNECT" = do - respond $ responseRawSource (handleConnect req) - (Wai.responseLBS status500 [("Content-Type", "text/plain")] "method CONNECT is not supported") - | otherwise = do - let scheme - | Wai.isSecure req = "https" - | otherwise = "http" - rawUrl = Wai.rawPathInfo req <> Wai.rawQueryString req - effectiveUrl = scheme ++ "://" ++ (C8.unpack $ proxyHost settings) ++ C8.unpack (rawUrl) - newHost = proxyHost settings - addHostHeader = (:) (hHost, newHost) + -- we may connect requests to secure sites, when we do, we will not have + -- seen their URI properly + | Wai.requestMethod req == "CONNECT" = + respond $ + responseRawSource + (handleConnect req) + (Wai.responseLBS status500 [("Content-Type", "text/plain")] "method CONNECT is not supported") + | otherwise = do + let scheme + | Wai.isSecure req = "https" + | otherwise = "http" + rawUrl = Wai.rawPathInfo req <> Wai.rawQueryString req + effectiveUrl = scheme ++ "://" ++ C8.unpack (proxyHost settings) ++ C8.unpack rawUrl + newHost = proxyHost settings + addHostHeader = (:) (hHost, newHost) - proxyReq' <- parseRequest effectiveUrl - let onException :: SomeException -> Wai.Response - onException = proxyOnException settings . toException + proxyReq' <- parseRequest effectiveUrl + let onException :: SomeException -> Wai.Response + onException = proxyOnException settings . toException - proxyReq = proxyReq' + proxyReq = + proxyReq' { method = Wai.requestMethod req , requestHeaders = addHostHeader $ filter dropUpstreamHeaders $ Wai.requestHeaders req - -- always pass redirects back to the client. - , redirectCount = proxyRedirectCount settings + , -- always pass redirects back to the client. + redirectCount = proxyRedirectCount settings , requestBody = case Wai.requestBodyLength req of Wai.ChunkedBody -> - requestBodySourceChunkedIO (sourceRequestBody req) + requestBodySourceChunked (sourceRequestBody req) Wai.KnownLength l -> - requestBodySourceIO (fromIntegral l) (sourceRequestBody req) - -- don't modify the response to ensure consistency with the response headers - , decompress = const False + requestBodySource (fromIntegral l) (sourceRequestBody req) + , -- don't modify the response to ensure consistency with the response headers + decompress = const False , host = newHost } - respondUpstream = withResponse proxyReq manager $ \res -> do - let body = mapOutput (Chunk . fromByteString) . bodyReaderSource $ responseBody res - headers = (mk "X-Via-Proxy", "yes") : (responseHeaders res) - respond $ responseSource (responseStatus res) headers body + respondUpstream = withResponse proxyReq manager $ \res -> do + let body = mapOutput (Chunk . fromByteString) . bodyReaderSource $ responseBody res + headers = (mk "X-Via-Proxy", "yes") : responseHeaders res + respond $ responseSource (responseStatus res) headers body - handle (respond . onException) respondUpstream + handle (respond . onException) respondUpstream -handleConnect - :: Wai.Request - -> ConduitT () C8.ByteString IO () - -> ConduitT C8.ByteString Void IO () - -> IO () + +handleConnect :: + Wai.Request -> + ConduitT () C8.ByteString IO () -> + ConduitT C8.ByteString Void IO () -> + IO () handleConnect req fromClient toClient = runTCPClient (toClientSettings req) $ \ad -> do - runConduit $ yield "HTTP/1.1 200 OK\r\n\r\n" .| toClient - race_ - (runConduit $ fromClient .| appSink ad) - (runConduit $ appSource ad .| toClient) + runConduit $ yield "HTTP/1.1 200 OK\r\n\r\n" .| toClient + race_ + (runConduit $ fromClient .| appSink ad) + (runConduit $ appSource ad .| toClient) + defaultClientPort :: Wai.Request -> Int defaultClientPort req | Wai.isSecure req = 443 | otherwise = 90 + toClientSettings :: Wai.Request -> ClientSettings toClientSettings req = case C8.break (== ':') $ Wai.rawPathInfo req of (host, "") -> clientSettingsTCP (defaultClientPort req) host (host, port') -> case C8.readInt $ C8.drop 1 port' of Just (port, _) -> clientSettingsTCP port host - Nothing -> clientSettingsTCP (defaultClientPort req) host + Nothing -> clientSettingsTCP (defaultClientPort req) host -dropUpstreamHeaders :: (Eq a, IsString a) => (a, b) -> Bool -dropUpstreamHeaders (k, _) = k `notElem` - [ "content-encoding" - , "content-length" - , "host" - ] + +dropUpstreamHeaders :: (HeaderName, b) -> Bool +dropUpstreamHeaders (k, _) = k `notElem` preservedHeaders + + +preservedHeaders :: [HeaderName] +preservedHeaders = ["content-encoding", "content-length", "host"] + + +type Source' = ConduitT () ByteString IO () + + +srcToPopperIO :: Source' -> GivesPopper () +srcToPopperIO 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 BS.empty + Just bs + | BS.null bs -> popper + | otherwise -> return bs + f popper + + +requestBodySource :: Int64 -> Source' -> RequestBody +requestBodySource size = RequestBodyStream size . srcToPopperIO + + +requestBodySourceChunked :: Source' -> RequestBody +requestBodySourceChunked = RequestBodyStreamChunked . srcToPopperIO + + +bodyReaderSource :: + (MonadIO m) => + BodyReader -> + ConduitT i ByteString m () +bodyReaderSource br = + loop + where + loop = do + bs <- liftIO $ brRead br + unless (BS.null bs) $ do + yield bs + loop diff --git a/test/IntegrationTest.hs b/test/IntegrationTest.hs --- a/test/IntegrationTest.hs +++ b/test/IntegrationTest.hs @@ -1,76 +1,148 @@ -{-# LANGUAGE NamedFieldPuns #-} +{-# LANGUAGE DataKinds #-} +{-# LANGUAGE NamedFieldPuns #-} {-# LANGUAGE OverloadedStrings #-} +{-# LANGUAGE ScopedTypeVariables #-} +{-# LANGUAGE TypeApplications #-} +{-# LANGUAGE TypeFamilies #-} module Main where -import System.IO -import Control.Monad (when) -import Data.Default (Default (..)) -import Data.Foldable (for_) -import Network.HTTP.Client.TLS (newTlsManager) -import Network.HTTP.Types (status500) -import Network.Wai (Application, rawPathInfo, - responseLBS) -import Network.Wai.Handler.Warp (Port, testWithApplication) -import System.Environment (lookupEnv) +import Control.Monad (when) +import Data.ByteString (ByteString) +import qualified Data.ByteString.Char8 as C8 +import Data.Default (Default (..)) +import Data.Foldable (for_) +import Data.Proxy (Proxy (..)) +import Data.Text (Text) +import qualified Data.Text as Text +import Data.Text.Encoding (encodeUtf8) +import qualified Network.HTTP.Client as HC +import Network.HTTP.Client.TLS (newTlsManager) +import Network.HTTP.Types (status500, statusCode) +import Network.Wai + ( Application + , rawPathInfo + , responseLBS + ) +import Network.Wai.Handler.Warp (Port, testWithApplication) +import Network.Wai.Middleware.Delegate + ( ProxySettings (..) + , delegateToProxy + ) +import System.Environment (lookupEnv) +import System.IO +import Test.Fetch (fetch) +import Test.Hspec +import Test.Hspec.TmpProc + ( HList (..) + , HostIpAddress + , Pinged (..) + , Proc (..) + , ProcHandle + , SvcURI + , hAddr + , handleOf + , startupAll + , tdescribe + , terminateAll + , toPinged + , (&:) + ) +import qualified Test.Hspec.TmpProc as TmpProc +import Test.HttpReply +import Test.TestRequests + ( RequestBuilder (..) + , buildRequest + , testNotProxiedRequests + , testOverRedirectedRequests + , testRequests + ) +import Test.WithExtras + ( defaultTlsSettings + , testWithTLSApplication + ) -import Network.Wai.Middleware.Delegate (ProxySettings (..), - delegateToProxy) -import Test.Fetch (fetch) -import Test.Hspec -import Test.HttpReply -import Test.TestRequests (RequestBuilder (..), - buildRequest, - testNotProxiedRequests, - testOverRedirectedRequests, - testRequests) -import Test.WithExtras (defaultTlsSettings, - testWithTLSApplication) - defaultTestSettings :: ProxySettings -defaultTestSettings = def { proxyHost = "httpbin.org", proxyTimeout = 2 } +defaultTestSettings = def {proxyHost = "httpbin.org", proxyTimeout = 2} + redirectTestSettings :: ProxySettings -redirectTestSettings = defaultTestSettings { proxyRedirectCount = 2 } +redirectTestSettings = defaultTestSettings {proxyRedirectCount = 2} + +tmpHostSettings :: ByteString -> ProxySettings -> ProxySettings +tmpHostSettings tmpHost settings = settings {proxyHost = tmpHost} + + main :: IO () main = do hSetBuffering stdin NoBuffering hSetBuffering stdout NoBuffering dumpDebug' <- lookupEnv "DEBUG" let dumpDebug = maybe False (const True) dumpDebug' - hspec $ do - -- TOOD: reenable when the public /redirect link on http-bin is working ok - -- insecureRedirectTest dumpDebug - insecureProxyTest dumpDebug + hspec $ tdescribe "when accessing http-bin in docker" $ do + -- TODO: reenable when a secure proxy is added to the docker tests + -- secureProxyTest dumpDebug + -- secureNotProxiedTest dumpDebug + insecureRedirectTest dumpDebug insecureNotProxiedTest dumpDebug - secureProxyTest dumpDebug - secureNotProxiedTest dumpDebug + insecureProxyTest dumpDebug + defaultTestDelegate :: ProxySettings -> IO Application defaultTestDelegate s = do -- delegate everything but /status/418 - let handleFunnyStatus = \req -> rawPathInfo req /= "/status/418" + let handleFunnyStatus req = rawPathInfo req /= "/status/418" dummyApp _ respond = respond $ responseLBS status500 [] "I should have been proxied" manager <- newTlsManager - return $ delegateToProxy s manager (handleFunnyStatus) dummyApp + return $ delegateToProxy s manager handleFunnyStatus dummyApp + +toHost :: HttpBinFixture -> ByteString +toHost fixture = encodeUtf8 $ hAddr $ handleOf @"tmp-http-bin" Proxy fixture + + +fixtureApp :: HttpBinFixture -> IO Application +fixtureApp fixture = defaultTestDelegate $ tmpHostSettings (toHost fixture) defaultTestSettings + + +redirectApp :: HttpBinFixture -> IO Application +redirectApp fixture = defaultTestDelegate $ tmpHostSettings (toHost fixture) redirectTestSettings + + +testWithInsecureProxy' :: ((HttpBinFixture, Port) -> IO a) -> IO a +testWithInsecureProxy' = TmpProc.testWithApplication onlyHttpBin fixtureApp + + +testWithSecureProxy' :: ((HttpBinFixture, Port) -> IO a) -> IO a +testWithSecureProxy' action = do + tls <- defaultTlsSettings + TmpProc.testWithTLSApplication tls onlyHttpBin fixtureApp action + + testWithInsecureProxy :: (Port -> IO ()) -> IO () testWithInsecureProxy = testWithApplication (defaultTestDelegate defaultTestSettings) -testWithInsecureRedirects :: (Port -> IO ()) -> IO () -testWithInsecureRedirects = testWithApplication (defaultTestDelegate redirectTestSettings) testWithSecureProxy :: (Port -> IO ()) -> IO () testWithSecureProxy withPort = do tls <- defaultTlsSettings testWithTLSApplication tls (defaultTestDelegate defaultTestSettings) withPort + +testWithInsecureRedirects' :: ((HttpBinFixture, Port) -> IO ()) -> IO () +testWithInsecureRedirects' = TmpProc.testWithApplication onlyHttpBin redirectApp + + +tmpHostBuilder :: HttpBinFixture -> RequestBuilder -> RequestBuilder +tmpHostBuilder fixture builder = builder {rbHost = toHost fixture} + + onDirectAndProxy :: (HttpReply -> HttpReply -> IO ()) -> Bool -> Int -> RequestBuilder -> IO () onDirectAndProxy f debug testProxyPort builder = do - let proxiedBuilder = builder { rbHost = "localhost", rbPort = Just testProxyPort } + let proxiedBuilder = builder {rbHost = "localhost", rbPort = Just testProxyPort} directReq <- buildRequest builder proxiedReq <- buildRequest proxiedBuilder @@ -94,56 +166,110 @@ print proxied f direct proxied + insecureNotProxiedTest :: Bool -> Spec insecureNotProxiedTest debug = let scheme = "HTTP" desc = "Proxy on " ++ scheme ++ " should fail" assertNeq = onDirectAndProxy assertHttpRepliesDiffer debug - in - around testWithInsecureProxy $ describe desc $ do - for_ testNotProxiedRequests $ \(title, modifier) -> - it (scheme ++ " " ++ title) $ \port -> assertNeq port $ modifier def + in aroundAll testWithInsecureProxy' $ describe desc $ do + for_ testNotProxiedRequests $ \(title, modifier) -> do + let shouldNotMatch (f, p) = assertNeq p $ modifier $ tmpHostBuilder f def + it (scheme ++ " " ++ title) shouldNotMatch + insecureRedirectTest :: Bool -> Spec insecureRedirectTest debug = let scheme = "HTTP" desc = "Proxy over " ++ scheme ++ " with too many redirects differs" assertNeq = onDirectAndProxy assertHttpRepliesDiffer debug - in - around testWithInsecureRedirects $ describe desc $ do - for_ testOverRedirectedRequests $ \(title, modifier) -> - it (scheme ++ " " ++ title) $ \port -> assertNeq port $ modifier def + in aroundAll testWithInsecureRedirects' $ describe desc $ do + for_ testOverRedirectedRequests $ \(title, modifier) -> do + let shouldNotMatch (f, p) = assertNeq p $ modifier $ tmpHostBuilder f def + it (scheme ++ " " ++ title) shouldNotMatch + insecureProxyTest :: Bool -> Spec insecureProxyTest debug = let scheme = "HTTP" desc = "Simple " ++ scheme ++ " proxying:" assertEq = onDirectAndProxy assertHttpRepliesAreEq debug - in - around testWithInsecureProxy $ describe desc $ do - for_ testRequests $ \(title, modifier) -> - it (scheme ++ " " ++ title) $ \port -> assertEq port $ modifier def + in aroundAll testWithInsecureProxy' $ describe desc $ do + for_ testRequests $ \(title, modifier) -> do + let shouldMatch (f, p) = assertEq p $ modifier $ tmpHostBuilder f def + it (scheme ++ " " ++ title) shouldMatch + secureNotProxiedTest :: Bool -> Spec secureNotProxiedTest debug = - let - scheme = "HTTPS" - desc = "Proxy on " ++ scheme ++ " should fail" - assertNeq = onDirectAndProxy assertHttpRepliesDiffer debug - def' = def { rbSecure = True } - in - around testWithSecureProxy $ describe desc $ do - for_ testNotProxiedRequests $ \(title, modifier) -> - it (scheme ++ " " ++ title) $ \port -> assertNeq port $ modifier def' + let scheme = "HTTPS" + desc = "Proxy on " ++ scheme ++ " should fail" + assertNeq = onDirectAndProxy assertHttpRepliesDiffer debug + def' = def {rbSecure = True} + in aroundAll testWithSecureProxy' $ describe desc $ do + for_ testNotProxiedRequests $ \(title, modifier) -> do + let shouldNotMatch (f, p) = assertNeq p $ modifier $ tmpHostBuilder f def' + it (scheme ++ " " ++ title) shouldNotMatch + secureProxyTest :: Bool -> Spec secureProxyTest debug = - let - scheme = "HTTPS" - desc = "Simple " ++ scheme ++ " proxying:" - assertEq = onDirectAndProxy assertHttpRepliesAreEq debug - def' = def { rbSecure = True } - in - around testWithSecureProxy $ describe desc $ do - for_ testRequests $ \(title, modifier) -> - it (scheme ++ " " ++ title) $ \port -> assertEq port $ modifier def' + let scheme = "HTTPS" + desc = "Simple " ++ scheme ++ " proxying:" + assertEq = onDirectAndProxy assertHttpRepliesAreEq debug + def' = def {rbSecure = True} + in aroundAll testWithSecureProxy' $ describe desc $ do + for_ testRequests $ \(title, modifier) -> do + let shouldMatch (f, p) = assertEq p $ modifier $ tmpHostBuilder f def' + it (scheme ++ " " ++ title) shouldMatch + + +-- | A data type representing a connection to a HttpBin server. +data HttpBin = HttpBin + + +type HttpBinFixture = HList '[ProcHandle HttpBin] + + +onlyHttpBin :: HList '[HttpBin] +onlyHttpBin = HttpBin &: HNil + + +setupHttpBin :: IO HttpBinFixture +setupHttpBin = startupAll onlyHttpBin + + +withHttpBin :: SpecWith HttpBinFixture -> Spec +withHttpBin = beforeAll setupHttpBin . afterAll terminateAll + + +-- | Run HttpBin using tmp-proc. +instance Proc HttpBin where + type Image HttpBin = "kennethreitz/httpbin" + type Name HttpBin = "tmp-http-bin" + + + uriOf = mkUri' + runArgs = [] + reset _ = pure () + ping = ping' + + +-- | Make a uri access the http-bin server. +mkUri' :: HostIpAddress -> SvcURI +mkUri' ip = "http://" <> C8.pack (Text.unpack ip) <> "/" + + +ping' :: ProcHandle a -> IO Pinged +ping' handle = toPinged @HC.HttpException Proxy $ do + gotStatus <- handleGet handle "/status/200" + if gotStatus == 200 then pure OK else pure NotOK + + +-- | Determine the status from a Get on localhost. +handleGet :: ProcHandle a -> Text -> IO Int +handleGet handle urlPath = do + let theUri = "http://" <> hAddr handle <> "/" <> Text.dropWhile (== '/') urlPath + manager <- HC.newManager HC.defaultManagerSettings + getReq <- HC.parseRequest $ Text.unpack theUri + statusCode . HC.responseStatus <$> HC.httpLbs getReq manager diff --git a/test/Test/Fetch.hs b/test/Test/Fetch.hs --- a/test/Test/Fetch.hs +++ b/test/Test/Fetch.hs @@ -1,5 +1,4 @@ -{-# LANGUAGE BangPatterns #-} -{-# LANGUAGE NamedFieldPuns #-} +{-# LANGUAGE BangPatterns #-} {-# LANGUAGE OverloadedStrings #-} module Test.Fetch @@ -7,62 +6,103 @@ ) where -import qualified Data.ByteString as BS -import qualified Data.ByteString.Char8 as C8 -import qualified Data.ByteString.Lazy as LBS - -import Control.Monad.Trans.Resource (runResourceT) -import Data.Conduit (ConduitT, SealedConduitT, Void, - await, sealConduitT, ($$+-)) -import qualified Data.Conduit.Binary as CB -import Data.Int (Int64) -import Data.Maybe (fromMaybe) -import Network.Connection (TLSSettings (..)) -import Network.HTTP.Client (Request, newManager, - responseBody, responseHeaders, - responseStatus, secure, managerSetProxy, proxyFromRequest) -import Network.HTTP.Client.TLS (mkManagerSettings) -import Network.HTTP.Simple (setRequestManager, withResponse) -import Network.HTTP.Types (hContentLength, statusCode) - -import Test.HttpReply +import Control.Monad (unless) +import Control.Monad.IO.Class (MonadIO, liftIO) +import Data.ByteString (ByteString) +import qualified Data.ByteString as BS +import qualified Data.ByteString.Char8 as C8 +import qualified Data.ByteString.Lazy as LBS +import Data.Conduit + ( ConduitT + , SealedConduitT + , Void + , await + , sealConduitT + , yield + , ($$+-) + ) +import qualified Data.Conduit.Binary as CB +import Data.Int (Int64) +import Data.Maybe (fromMaybe) +import Network.Connection (TLSSettings (..)) +import Network.HTTP.Client + ( BodyReader + , Request + , brRead + , managerSetProxy + , newManager + , proxyFromRequest + , responseBody + , responseHeaders + , responseStatus + , secure + , withResponse + ) +import Network.HTTP.Client.TLS (mkManagerSettings) +-- import Network.HTTP.Simple (setRequestManager, withResponse) +import Network.HTTP.Types (hContentLength, statusCode) +import Test.HttpReply fetch :: Request -> IO HttpReply fetch req = do - let mSettings = mkManagerSettings (TLSSettingsSimple True False False) Nothing - mSettings' = managerSetProxy proxyFromRequest mSettings - m <- newManager mSettings' - runResourceT $ withResponse (setRequestManager m req) getSrc + let mSettings = mkManagerSettings (TLSSettingsSimple True False False) Nothing + mSettings' = managerSetProxy proxyFromRequest mSettings + m <- newManager mSettings' + withResponse req m getSrc where getSrc resp = do let mbBodyLength = readInt64 <$> lookup hContentLength (responseHeaders resp) - bodyText <- checkBodySize (sealConduitT $ responseBody resp) mbBodyLength + bodyText <- checkBodySize (sealConduitT $ bodyReaderSource $ responseBody resp) mbBodyLength return $ HttpReply (secure req) (statusCode $ responseStatus resp) (responseHeaders resp) bodyText + bodyCheckBlock :: Int64 bodyCheckBlock = 1000 + checkBodySize :: (Monad m) => SealedConduitT () BS.ByteString m () -> Maybe Int64 -> m BS.ByteString checkBodySize bodySrc Nothing = fmap (BS.concat . LBS.toChunks) $ bodySrc $$+- CB.take $ fromIntegral bodyCheckBlock checkBodySize bodySrc (Just len) | len <= bodyCheckBlock = checkBodySize bodySrc Nothing | otherwise = fromMaybe "Success" <$> (bodySrc $$+- sizeCheckSink len) + -- A pipe that counts the size of each incoming C8.Bytestring, when the last is -- received, the result is Nothing if the size matches the expected value or an -- error message if it does not. -sizeCheckSink :: Monad m => Int64 -> ConduitT C8.ByteString Void m (Maybe C8.ByteString) +sizeCheckSink :: (Monad m) => Int64 -> ConduitT C8.ByteString Void m (Maybe C8.ByteString) sizeCheckSink expectedSize = sink 0 where sink !count = await >>= maybe (closeSink count) (sinkBlock count) sinkBlock !count bs = sink (count + fromIntegral (BS.length bs)) - -- | no more bytes: return Nothing if the count so far matches the expected value + -- \| no more bytes: return Nothing if the count so far matches the expected value closeSink !count | count == expectedSize = return Nothing - | otherwise = return $ Just . C8.pack $ "Error : Body length " ++ show count - ++ " should have been " ++ show expectedSize ++ "." + | otherwise = + return $ + Just . C8.pack $ + "Error : Body length " + ++ show count + ++ " should have been " + ++ show expectedSize + ++ "." + readInt64 :: C8.ByteString -> Int64 readInt64 = read . C8.unpack + + +bodyReaderSource :: + (MonadIO m) => + BodyReader -> + ConduitT i ByteString m () +bodyReaderSource br = + loop + where + loop = do + bs <- liftIO $ brRead br + unless (BS.null bs) $ do + yield bs + loop diff --git a/test/Test/HttpReply.hs b/test/Test/HttpReply.hs --- a/test/Test/HttpReply.hs +++ b/test/Test/HttpReply.hs @@ -1,68 +1,78 @@ -{-# LANGUAGE NamedFieldPuns #-} +{-# LANGUAGE NamedFieldPuns #-} {-# LANGUAGE OverloadedStrings #-} module Test.HttpReply - ( HttpReply(..) - , HttpReplyMismatch(..) + ( HttpReply (..) + , HttpReplyMismatch (..) , compareHttpReplies , assertHttpRepliesAreEq , assertHttpRepliesDiffer ) - where -import Data.ByteString (ByteString) -import qualified Data.ByteString as BS +import Data.ByteString (ByteString) +import qualified Data.ByteString as BS import qualified Data.ByteString.Char8 as C8 -import Data.List (intercalate) -import Data.Maybe (catMaybes, isJust, isNothing) -import Network.HTTP.Types (Header, HeaderName) +import Data.CaseInsensitive (original) +import Data.List (intercalate) +import Data.Maybe (catMaybes, isJust, isNothing) +import Network.HTTP.Types (Header, HeaderName) -import Data.CaseInsensitive (original) data HttpReply = HttpReply - { hrSecure :: !Bool - , hrStatus :: !Int - , hrHeaders :: ![Header] - , hrBytes :: !BS.ByteString - } + { hrSecure :: !Bool + , hrStatus :: !Int + , hrHeaders :: ![Header] + , hrBytes :: !BS.ByteString + } + instance Show HttpReply where - show r = intercalate "\n" $ - [ "Status: " ++ (show . hrStatus) r - , "Body:" - , C8.unpack $ hrBytes r - ] <> (map (show . concatHeader) $ hrHeaders r) + show r = + intercalate "\n" $ + [ "Status: " ++ (show . hrStatus) r + , "Body:" + , C8.unpack $ hrBytes r + ] + <> (map (show . concatHeader) $ hrHeaders r) where - concatHeader (f, v) = BS.concat [ " ", original f , ": " , v] + concatHeader (f, v) = BS.concat [" ", original f, ": ", v] -data HttpReplyMismatch = StatusMismatch Int Int - | HeaderMismatch HeaderName (Maybe C8.ByteString) - (Maybe C8.ByteString) - | BodyMismatch BS.ByteString BS.ByteString - | MissingViaHeader - | UnexpectedViaHeader - deriving (Eq) +data HttpReplyMismatch + = StatusMismatch Int Int + | HeaderMismatch + HeaderName + (Maybe C8.ByteString) + (Maybe C8.ByteString) + | BodyMismatch BS.ByteString BS.ByteString + | MissingViaHeader + | UnexpectedViaHeader + deriving (Eq) + + instance Show HttpReplyMismatch where - show (StatusMismatch x y)= "HTTP status codes don't match : " ++ show x ++ " /= " ++ show y + show (StatusMismatch x y) = "HTTP status codes don't match : " ++ show x ++ " /= " ++ show y show (HeaderMismatch name x y) = "Header field '" ++ show name ++ "' doesn't match : '" ++ show x ++ "' /= '" ++ show y show (BodyMismatch x y) = "HTTP response bodies are different :\n" ++ C8.unpack x ++ "\n-----------\n" ++ C8.unpack y show MissingViaHeader = "Error: Proxy connection should contain 'X-Via-Proxy' header." show UnexpectedViaHeader = "Error: Direct connection should not contain 'X-Via-Proxy' header." + assertHttpRepliesAreEq :: HttpReply -> HttpReply -> IO () assertHttpRepliesAreEq direct proxied = do let assertNoMismatches [] = return () assertNoMismatches xs = error $ intercalate "\n" $ map show xs assertNoMismatches $ compareHttpReplies direct proxied + assertHttpRepliesDiffer :: HttpReply -> HttpReply -> IO () assertHttpRepliesDiffer direct proxied = do let assertHasMismatches [] = error "Responses should be different!" assertHasMismatches _ = return () assertHasMismatches $ compareHttpReplies direct proxied + compareHttpReplies :: HttpReply -> HttpReply -> [HttpReplyMismatch] compareHttpReplies direct proxied = catMaybes mbMismatches where @@ -89,19 +99,19 @@ mismatchedHeader name | x' /= y' = Just $ HeaderMismatch name x' y' | otherwise = Nothing - where x' = maybeHeader name direct - y' = maybeHeader name proxied + where + x' = maybeHeader name direct + y' = maybeHeader name proxied compareBodys :: ByteString -> ByteString -> Maybe HttpReplyMismatch compareBodys direct proxied = - let direct' = replaceAmznTraceId direct + let direct' = replaceAmznTraceId direct proxied' = replaceAmznTraceId proxied compare' a b | a == b = Nothing | otherwise = Just $ BodyMismatch a b - in - compare' direct' proxied' + in compare' direct' proxied' replaceAmznTraceId :: ByteString -> ByteString @@ -109,4 +119,4 @@ let asLines = C8.lines x checkTrace y = "X-Amzn-Trace-Id" `C8.isInfixOf` y dropTrace y = if checkTrace y then Nothing else Just y - in C8.unlines $ catMaybes $ dropTrace <$> asLines + in C8.unlines $ catMaybes $ dropTrace <$> asLines diff --git a/test/Test/TestRequests.hs b/test/Test/TestRequests.hs --- a/test/Test/TestRequests.hs +++ b/test/Test/TestRequests.hs @@ -1,109 +1,155 @@ -{-# LANGUAGE NamedFieldPuns #-} +{-# LANGUAGE NamedFieldPuns #-} {-# LANGUAGE OverloadedStrings #-} module Test.TestRequests - ( RequestBuilder(..) - , buildRequest - , testRequests - , testGetRequests - , testPostRequests - , testNotProxiedRequests - , testOverRedirectedRequests - ) where + ( RequestBuilder (..) + , buildRequest + , testRequests + , testGetRequests + , testPostRequests + , testNotProxiedRequests + , testOverRedirectedRequests + ) +where -import qualified Data.ByteString as BS +import qualified Data.ByteString as BS import qualified Data.ByteString.Char8 as C8 -import Data.Default (Default (..)) -import Data.Maybe (fromMaybe) -import Network.HTTP.Client (Request, RequestBody (..), host, method, - parseRequest, redirectCount, - requestBody) -import Network.HTTP.Types (Method, methodGet, methodPost) +import Data.Default (Default (..)) +import Data.Maybe (fromMaybe) +import Network.HTTP.Client + ( Request + , RequestBody (..) + , host + , method + , parseRequest + , redirectCount + , requestBody + ) +import Network.HTTP.Types (Method, methodGet, methodPost) -data RequestBuilder - = RequestBuilder + +data RequestBuilder = RequestBuilder { rbMethod :: !Method , rbSecure :: !Bool - , rbPath :: !String - , rbBody :: !(Maybe RequestBody) - , rbHost :: !BS.ByteString - , rbPort :: !(Maybe Int) + , rbPath :: !String + , rbBody :: !(Maybe RequestBody) + , rbHost :: !BS.ByteString + , rbPort :: !(Maybe Int) } + instance Default RequestBuilder where - def = RequestBuilder - { rbMethod = methodGet - , rbSecure = False - , rbPath = "/" - , rbBody = Nothing - , rbHost = "httpbin.org" - , rbPort = Nothing - } + def = + RequestBuilder + { rbMethod = methodGet + , rbSecure = False + , rbPath = "/" + , rbBody = Nothing + , rbHost = "httpbin.org" + , rbPort = Nothing + } + testRequests :: [(String, RequestBuilder -> RequestBuilder)] testRequests = testGetRequests <> testPostRequests + testGetRequests :: [(String, RequestBuilder -> RequestBuilder)] testGetRequests = - [ ("GET" - , (\builder -> builder {rbPath = "/get"})) - , ("GET (with a query)" - , (\builder -> builder {rbPath = "/get?a=10&b=whatever"})) - , ("GET (multiple redirects)" - , (\builder -> builder {rbPath = "/redirect/3"})) - , ("GET (with a body)" - , (\builder -> builder - { rbPath = "/get" - , rbBody = Just $ RequestBodyBS "Hello httpbin!" - })) - , ("GET (forbidden resource)" - , (\builder -> builder {rbPath = "/status/403"})) - , ("GET (missing resource)" - , (\builder -> builder {rbPath = "/status/404"})) + [ + ( "GET" + , (\builder -> builder {rbPath = "/get"}) + ) + , + ( "GET (with a query)" + , (\builder -> builder {rbPath = "/get?a=10&b=whatever"}) + ) + , + ( "GET (multiple redirects)" + , (\builder -> builder {rbPath = "/redirect/3"}) + ) + , + ( "GET (with a body)" + , ( \builder -> + builder + { rbPath = "/get" + , rbBody = Just $ RequestBodyBS "Hello httpbin!" + } + ) + ) + , + ( "GET (forbidden resource)" + , (\builder -> builder {rbPath = "/status/403"}) + ) + , + ( "GET (missing resource)" + , (\builder -> builder {rbPath = "/status/404"}) + ) ] + testNotProxiedRequests :: [(String, RequestBuilder -> RequestBuilder)] testNotProxiedRequests = - [ ("GET (funny resource - differs on proxy)" - , (\builder -> builder {rbPath = "/status/418"})) + [ + ( "GET (funny resource - differs on proxy)" + , (\builder -> builder {rbPath = "/status/418"}) + ) ] + testOverRedirectedRequests :: [(String, RequestBuilder -> RequestBuilder)] testOverRedirectedRequests = - [ ("GET (multiple redirects)" - , (\builder -> builder {rbPath = "/redirect/3"})) + [ + ( "GET (multiple redirects)" + , (\builder -> builder {rbPath = "/redirect/3"}) + ) ] + testPostRequests :: [(String, RequestBuilder -> RequestBuilder)] testPostRequests = - [ ("POST" - , (\builder -> builder {rbMethod = methodPost, rbPath = "/post"})) - , ("POST (with a query)" - , (\builder -> builder {rbMethod = methodPost, rbPath = "/post?a=10&b=whatever"})) - , ("POST (with a body)" - , (\builder -> builder - { rbPath = "/post" - , rbBody = Just $ RequestBodyBS "Hello httpbin!" - , rbMethod = methodPost - })) - , ("POST (forbidden resource)" - , (\builder -> builder {rbMethod = methodPost, rbPath = "/status/403"})) - , ("POST (missing resource)" - , (\builder -> builder {rbMethod = methodPost, rbPath = "/status/404"})) + [ + ( "POST" + , (\builder -> builder {rbMethod = methodPost, rbPath = "/post"}) + ) + , + ( "POST (with a query)" + , (\builder -> builder {rbMethod = methodPost, rbPath = "/post?a=10&b=whatever"}) + ) + , + ( "POST (with a body)" + , ( \builder -> + builder + { rbPath = "/post" + , rbBody = Just $ RequestBodyBS "Hello httpbin!" + , rbMethod = methodPost + } + ) + ) + , + ( "POST (forbidden resource)" + , (\builder -> builder {rbMethod = methodPost, rbPath = "/status/403"}) + ) + , + ( "POST (missing resource)" + , (\builder -> builder {rbMethod = methodPost, rbPath = "/status/404"}) + ) ] + -- | Simplifies creation of the requests used in testing buildRequest :: RequestBuilder -> IO Request -buildRequest RequestBuilder { rbMethod, rbSecure, rbPath , rbBody, rbHost, rbPort } = do - let scheme - | rbSecure = "https" - | otherwise = "http" - portStr = maybe "" (\x -> ":" ++ show x) rbPort - url = scheme ++ "://" ++ (C8.unpack rbHost) ++ portStr ++ rbPath - req <- parseRequest url - return $ req - { method = rbMethod - , requestBody = fromMaybe (requestBody req) rbBody - , host = rbHost - , redirectCount = 0 - } +buildRequest RequestBuilder {rbMethod, rbSecure, rbPath, rbBody, rbHost, rbPort} = do + let scheme + | rbSecure = "https" + | otherwise = "http" + portStr = maybe "" (\x -> ":" ++ show x) rbPort + url = scheme ++ "://" ++ (C8.unpack rbHost) ++ portStr ++ rbPath + req <- parseRequest url + return $ + req + { method = rbMethod + , requestBody = fromMaybe (requestBody req) rbBody + , host = rbHost + , redirectCount = 0 + } diff --git a/test/Test/WithExtras.hs b/test/Test/WithExtras.hs --- a/test/Test/WithExtras.hs +++ b/test/Test/WithExtras.hs @@ -4,86 +4,101 @@ , testWithTLSApplicationSettings , withTLSApplication , withTLSApplicationSettings - ) where + ) +where -import Control.Concurrent -import Control.Concurrent.Async -import Control.Exception -import Control.Monad (when) +import Control.Concurrent +import Control.Concurrent.Async +import Control.Exception +import Control.Monad (when) +import Network.Socket (Socket, close) +import Network.Wai (Application) +import Network.Wai.Handler.Warp + ( Port + , Settings + , defaultSettings + , defaultShouldDisplayException + , openFreePort + ) +import Network.Wai.Handler.Warp.Internal (settingsBeforeMainLoop) +import Network.Wai.Handler.WarpTLS + ( TLSSettings + , runTLSSocket + , tlsSettings + ) +import Paths_wai_middleware_delegate (getDataFileName) -import Network.Socket (Socket, close) -import Network.Wai (Application) -import Network.Wai.Handler.Warp.Internal (settingsBeforeMainLoop) -import Network.Wai.Handler.Warp (Port, Settings, - defaultSettings, - defaultShouldDisplayException, - openFreePort) -import Network.Wai.Handler.WarpTLS (TLSSettings, runTLSSocket, - tlsSettings) -import Paths_wai_middleware_delegate (getDataFileName) - -- | The settings used in the integration tests defaultTlsSettings :: IO TLSSettings defaultTlsSettings = tlsSettings - <$> (getDataFileName "test/certificate.pem") - <*> (getDataFileName "test/key.pem") + <$> (getDataFileName "test/certificate.pem") + <*> (getDataFileName "test/key.pem") --- | Runs the given 'Application' on a free port. Passes the port to the given --- operation and executes it, while the 'Application' is running. Shuts down the --- server before returning. +{- | Runs the given 'Application' on a free port. Passes the port to the given + operation and executes it, while the 'Application' is running. Shuts down the + server before returning. +-} withTLSApplication :: TLSSettings -> IO Application -> (Port -> IO a) -> IO a withTLSApplication = withTLSApplicationSettings defaultSettings --- | 'withTLSApplication' with given 'Settings'. This will ignore the port value --- set by 'setPort' in 'Settings'. + +{- | 'withTLSApplication' with given 'Settings'. This will ignore the port value + set by 'setPort' in 'Settings'. +-} withTLSApplicationSettings :: Settings -> TLSSettings -> IO Application -> (Port -> IO a) -> IO a withTLSApplicationSettings settings' tlsSettings' mkApp action = do app <- mkApp - withFreePort $ \ (port, sock) -> do + withFreePort $ \(port, sock) -> do started <- mkWaiter let settings = - settings' { - settingsBeforeMainLoop - = notify started () >> settingsBeforeMainLoop settings' - } - result <- race - (runTLSSocket tlsSettings' settings sock app) - (waitFor started >> action port) + settings' + { settingsBeforeMainLoop = + notify started () >> settingsBeforeMainLoop settings' + } + result <- + race + (runTLSSocket tlsSettings' settings sock app) + (waitFor started >> action port) case result of Left () -> throwIO $ ErrorCall "Unexpected: runSettingsSocket exited" Right x -> return x + testWithTLSApplication :: TLSSettings -> IO Application -> (Port -> IO a) -> IO a testWithTLSApplication = testWithTLSApplicationSettings defaultSettings + testWithTLSApplicationSettings :: Settings -> TLSSettings -> IO Application -> (Port -> IO a) -> IO a testWithTLSApplicationSettings settings tlsSettings' mkApp action = do callingThread <- myThreadId app <- mkApp let wrappedApp request respond = - app request respond `catch` \ e -> do + app request respond `catch` \e -> do when (defaultShouldDisplayException e) (throwTo callingThread e) throwIO e withTLSApplicationSettings settings tlsSettings' (return wrappedApp) action -data Waiter a - = Waiter { - notify :: a -> IO (), - waitFor :: IO a + +data Waiter a = Waiter + { notify :: a -> IO () + , waitFor :: IO a } + mkWaiter :: IO (Waiter a) mkWaiter = do mvar <- newEmptyMVar - return Waiter { - notify = putMVar mvar, - waitFor = readMVar mvar - } + return + Waiter + { notify = putMVar mvar + , waitFor = readMVar mvar + } + -- | Like 'openFreePort' but closes the socket before exiting. withFreePort :: ((Port, Socket) -> IO a) -> IO a diff --git a/wai-middleware-delegate.cabal b/wai-middleware-delegate.cabal --- a/wai-middleware-delegate.cabal +++ b/wai-middleware-delegate.cabal @@ -1,12 +1,11 @@ cabal-version: 3.0 name: wai-middleware-delegate -version: 0.1.3.1 +version: 0.1.4.0 synopsis: WAI middleware that delegates handling of requests. description: [WAI](http://hackage.haskell.org/package/wai) middleware that intercepts requests that match a predicate and responds to them using alternate @WAI@ Applications or proxied hosts. - Read this [short example](https://github.com/adetokunbo/wai-middleware-delegate#readme) for an introduction to its usage. @@ -15,13 +14,14 @@ author: Tim Emiola maintainer: tim.emiola@gmail.com category: Web -homepage: https://github.com/adetokunbo/wai-middleware-delegate#readme +homepage: + https://github.com/adetokunbo/wai-middleware-delegate#readme + bug-reports: https://github.com/adetokunbo/wai-middleware-delegate/issues build-type: Simple -extra-source-files: - ChangeLog.md +extra-source-files: ChangeLog.md data-files: test/*.csr test/*.pem @@ -34,19 +34,18 @@ exposed-modules: Network.Wai.Middleware.Delegate hs-source-dirs: src build-depends: - async ^>=2.2.1 - , base >=4.10 && <5 + , async ^>=2.2.1 + , base >=4.10 && <5 , blaze-builder ^>=0.4.1.0 - , bytestring >=0.10.8.2 && <0.12.0.0 + , bytestring >=0.10.8.2 && <0.11 || >=0.11.3.1 && <0.12.1 , case-insensitive ^>=1.2.0.11 , conduit ^>=1.3.0.3 , conduit-extra ^>=1.3.0 , data-default ^>=0.7.1.1 , http-client >=0.5.13.1 && <0.8.0.0 - , http-conduit ^>=2.3.2 - , http-types >=0.12.1 && <0.13.0 - , streaming-commons >=0.2.1.0 && <0.3.0.0 - , text >=1.2.3 && <2.2 + , http-types >=0.12.1 && <0.13.0 + , streaming-commons >=0.2.1.0 && <0.3.0.0 + , text >=1.2.3 && <2.2 , wai ^>=3.2 , wai-conduit ^>=3.0.0.4 @@ -57,15 +56,15 @@ main-is: IntegrationTest.hs autogen-modules: Paths_wai_middleware_delegate other-modules: + Paths_wai_middleware_delegate Test.Fetch Test.HttpReply Test.TestRequests Test.WithExtras - Paths_wai_middleware_delegate hs-source-dirs: test build-depends: - async + , async , base , blaze-builder , bytestring @@ -73,23 +72,24 @@ , case-insensitive , conduit , conduit-extra - , connection >=0.2 + , crypton-connection >=0.3.1 , data-default , hspec >=2.1 + , hspec-tmp-proc , http-client , http-client-tls - , http-conduit , http-types , network , random >=1.1 , resourcet , text + , tmp-proc >=0.5.2 , vault , wai , wai-conduit , wai-middleware-delegate , warp - , warp-tls + , warp-tls >=3.4 default-language: Haskell2010 ghc-options: -Wall -fwarn-tabs -threaded