packages feed

wai-middleware-delegate 0.1.3.1 → 0.1.4.0

raw patch · 9 files changed

+712/−377 lines, 9 filesdep +crypton-connectiondep +hspec-tmp-procdep +tmp-procdep −connectiondep −http-conduitdep ~bytestringdep ~warp-tlssetup-changedPVP ok

version bump matches the API change (PVP)

Dependencies added: crypton-connection, hspec-tmp-proc, tmp-proc

Dependencies removed: connection, http-conduit

Dependency ranges changed: bytestring, warp-tls

API changes (from Hackage documentation)

Files

ChangeLog.md view
@@ -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
Setup.hs view
@@ -1,2 +1,4 @@ import Distribution.Simple++ main = defaultMain
src/Network/Wai/Middleware/Delegate.hs view
@@ -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 <tim.emiola@gmail.com>@@ -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
test/IntegrationTest.hs view
@@ -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
test/Test/Fetch.hs view
@@ -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
test/Test/HttpReply.hs view
@@ -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
test/Test/TestRequests.hs view
@@ -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+      }
test/Test/WithExtras.hs view
@@ -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
wai-middleware-delegate.cabal view
@@ -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