Hello community, here is the log from the commit of package ghc-http-conduit for openSUSE:Factory checked in at 2018-05-30 12:09:52 ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ Comparing /work/SRC/openSUSE:Factory/ghc-http-conduit (Old) and /work/SRC/openSUSE:Factory/.ghc-http-conduit.new (New) ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
Package is "ghc-http-conduit" Wed May 30 12:09:52 2018 rev:12 rq:607822 version:2.3.1 Changes: -------- --- /work/SRC/openSUSE:Factory/ghc-http-conduit/ghc-http-conduit.changes 2017-09-15 21:50:40.722955271 +0200 +++ /work/SRC/openSUSE:Factory/.ghc-http-conduit.new/ghc-http-conduit.changes 2018-05-30 12:26:06.260741017 +0200 @@ -1,0 +2,16 @@ +Mon May 14 17:02:11 UTC 2018 - [email protected] + +- Update http-conduit to version 2.3.1. + * Reexport Query from Network.HTTP.Types + * Rewrite a type signatures of getRequestQueryString and setRequestQueryString with Query + * conduit 1.3 support + * NOTE: Even for older versions of conduit, this includes dropping + support for finalizers + * `http` returns a `Source` instead of a `ResumableSource` (due to lack of + finalizers) + * Drop monad-control for unliftio + * Removed some deprecated functions: `withManager`, `withManagerSettings`, + `conduitManagerSettings` + * Add `httpBS` to `Network.HTTP.Simple` + +------------------------------------------------------------------- Old: ---- http-conduit-2.2.3.2.tar.gz New: ---- http-conduit-2.3.1.tar.gz ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ Other differences: ------------------ ++++++ ghc-http-conduit.spec ++++++ --- /var/tmp/diff_new_pack.dijwet/_old 2018-05-30 12:26:07.420702076 +0200 +++ /var/tmp/diff_new_pack.dijwet/_new 2018-05-30 12:26:07.424701943 +0200 @@ -1,7 +1,7 @@ # # spec file for package ghc-http-conduit # -# Copyright (c) 2017 SUSE LINUX GmbH, Nuernberg, Germany. +# Copyright (c) 2018 SUSE LINUX GmbH, Nuernberg, Germany. # # All modifications and additions to the file contributed by third parties # remain the property of their copyright owners, unless otherwise agreed @@ -19,7 +19,7 @@ %global pkg_name http-conduit %bcond_with tests Name: ghc-%{pkg_name} -Version: 2.2.3.2 +Version: 2.3.1 Release: 0 Summary: HTTP client package with conduit interface and HTTPS support License: BSD-2-Clause @@ -31,16 +31,14 @@ BuildRequires: ghc-bytestring-devel BuildRequires: ghc-conduit-devel BuildRequires: ghc-conduit-extra-devel -BuildRequires: ghc-exceptions-devel BuildRequires: ghc-http-client-devel BuildRequires: ghc-http-client-tls-devel BuildRequires: ghc-http-types-devel -BuildRequires: ghc-lifted-base-devel -BuildRequires: ghc-monad-control-devel BuildRequires: ghc-mtl-devel BuildRequires: ghc-resourcet-devel BuildRequires: ghc-rpm-macros BuildRequires: ghc-transformers-devel +BuildRequires: ghc-unliftio-core-devel %if %{with tests} BuildRequires: ghc-HUnit-devel BuildRequires: ghc-blaze-builder-devel @@ -54,6 +52,7 @@ BuildRequires: ghc-temporary-devel BuildRequires: ghc-text-devel BuildRequires: ghc-time-devel +BuildRequires: ghc-unliftio-devel BuildRequires: ghc-utf8-string-devel BuildRequires: ghc-wai-conduit-devel BuildRequires: ghc-wai-devel @@ -95,7 +94,7 @@ %ghc_pkg_recache %files -f %{name}.files -%doc LICENSE +%license LICENSE %files devel -f %{name}-devel.files %doc ChangeLog.md README.md ++++++ http-conduit-2.2.3.2.tar.gz -> http-conduit-2.3.1.tar.gz ++++++ diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn' '--exclude=.svnignore' old/http-conduit-2.2.3.2/ChangeLog.md new/http-conduit-2.3.1/ChangeLog.md --- old/http-conduit-2.2.3.2/ChangeLog.md 2017-07-07 11:45:59.000000000 +0200 +++ new/http-conduit-2.3.1/ChangeLog.md 2018-04-09 15:40:11.000000000 +0200 @@ -1,3 +1,23 @@ +## 2.3.1 + +* Reexport Query from Network.HTTP.Types +* Rewrite a type signatures of getRequestQueryString and setRequestQueryString with Query + +## 2.3.0 + +* conduit 1.3 support + * NOTE: Even for older versions of conduit, this includes dropping + support for finalizers +* `http` returns a `Source` instead of a `ResumableSource` (due to lack of + finalizers) +* Drop monad-control for unliftio +* Removed some deprecated functions: `withManager`, `withManagerSettings`, + `conduitManagerSettings` + +## 2.2.4 + +* Add `httpBS` to `Network.HTTP.Simple` + ## 2.2.3.2 * Add proper headers for `httpJSON` and `httpJSONEither` [#284](https://github.com/snoyberg/http-client/issues/284) diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn' '--exclude=.svnignore' old/http-conduit-2.2.3.2/Network/HTTP/Client/Conduit.hs new/http-conduit-2.3.1/Network/HTTP/Client/Conduit.hs --- old/http-conduit-2.2.3.2/Network/HTTP/Client/Conduit.hs 2016-12-19 16:29:45.000000000 +0100 +++ new/http-conduit-2.3.1/Network/HTTP/Client/Conduit.hs 2018-04-09 15:40:11.000000000 +0200 @@ -1,6 +1,5 @@ -{-# LANGUAGE FlexibleContexts #-} -{-# LANGUAGE MultiParamTypeClasses #-} -{-# LANGUAGE RankNTypes #-} +{-# LANGUAGE FlexibleContexts #-} +{-# LANGUAGE RankNTypes #-} -- | A new, experimental API to replace "Network.HTTP.Conduit". -- -- For most users, "Network.HTTP.Simple" is probably a better choice. For more @@ -19,8 +18,6 @@ -- * Manager helpers , defaultManagerSettings , newManager - , withManager - , withManagerSettings , newManagerSettings -- * General HTTP client interface , module Network.HTTP.Client @@ -33,21 +30,20 @@ ) where import Control.Monad (unless) -import Control.Monad.IO.Class (MonadIO, liftIO) -import Control.Monad.Reader (MonadReader (..), ReaderT (..)) -import Control.Monad.Trans.Control (MonadBaseControl) +import Control.Monad.IO.Unlift (MonadIO, liftIO, MonadUnliftIO, withRunInIO) +import Control.Monad.Reader (MonadReader (..)) import Data.Acquire (Acquire, mkAcquire, with) import Data.ByteString (ByteString) import qualified Data.ByteString as S import qualified Data.ByteString.Lazy as L -import Data.Conduit (ConduitM, Producer, Source, - await, yield, ($$+), ($$++)) +import Data.Conduit (ConduitM, ($$+), + await, yield, ($$++)) import Data.Int (Int64) import Data.IORef (newIORef, readIORef, writeIORef) import Network.HTTP.Client hiding (closeManager, defaultManagerSettings, httpLbs, newManager, responseClose, - responseOpen, withManager, + responseOpen, withResponse, BodyReader, brRead, brConsume, httpNoBody) import qualified Network.HTTP.Client as H import Network.HTTP.Client.TLS (tlsManagerSettings) @@ -56,18 +52,18 @@ -- -- * Response body is represented as a @Producer@. -- --- * Generalized to any instance of @MonadBaseControl@, not just @IO@. +-- * Generalized to any instance of @MonadUnliftIO@, not just @IO@. -- -- * The @Manager@ is contained by a @MonadReader@ context. -- -- Since 2.1.0 -withResponse :: (MonadBaseControl IO m, MonadIO n, MonadReader env m, HasHttpManager env) +withResponse :: (MonadUnliftIO m, MonadIO n, MonadReader env m, HasHttpManager env) => Request -> (Response (ConduitM i ByteString n ()) -> m a) -> m a withResponse req f = do env <- ask - with (acquireResponse req env) f + withRunInIO $ \run -> with (acquireResponse req env) (run . f) -- | An @Acquire@ for getting a @Response@. -- @@ -100,18 +96,6 @@ newManagerSettings :: MonadIO m => ManagerSettings -> m Manager newManagerSettings = liftIO . H.newManager --- | Get a new manager with 'defaultManagerSettings' and construct a @ReaderT@ containing it. --- --- Since 2.1.0 -withManager :: MonadIO m => (ReaderT Manager m a) -> m a -withManager = withManagerSettings defaultManagerSettings - --- | Get a new manager with the given settings and construct a @ReaderT@ containing it. --- --- Since 2.1.0 -withManagerSettings :: MonadIO m => ManagerSettings -> (ReaderT Manager m a) -> m a -withManagerSettings settings (ReaderT inner) = newManagerSettings settings >>= inner - -- | Conduit-powered version of 'H.responseOpen'. -- -- See 'withResponse' for the differences with 'H.responseOpen'. @@ -132,7 +116,7 @@ bodyReaderSource :: MonadIO m => H.BodyReader - -> Producer m ByteString + -> ConduitM i ByteString m () bodyReaderSource br = loop where @@ -142,13 +126,13 @@ yield bs loop -requestBodySource :: Int64 -> Source IO ByteString -> RequestBody +requestBodySource :: Int64 -> ConduitM () ByteString IO () -> RequestBody requestBodySource size = RequestBodyStream size . srcToPopperIO -requestBodySourceChunked :: Source IO ByteString -> RequestBody +requestBodySourceChunked :: ConduitM () ByteString IO () -> RequestBody requestBodySourceChunked = RequestBodyStreamChunked . srcToPopperIO -srcToPopperIO :: Source IO ByteString -> GivesPopper () +srcToPopperIO :: ConduitM () ByteString IO () -> GivesPopper () srcToPopperIO src f = do (rsrc0, ()) <- src $$+ return () irsrc <- newIORef rsrc0 diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn' '--exclude=.svnignore' old/http-conduit-2.2.3.2/Network/HTTP/Conduit.hs new/http-conduit-2.3.1/Network/HTTP/Conduit.hs --- old/http-conduit-2.2.3.2/Network/HTTP/Conduit.hs 2017-07-07 11:46:38.000000000 +0200 +++ new/http-conduit-2.3.1/Network/HTTP/Conduit.hs 2018-04-09 15:40:11.000000000 +0200 @@ -1,7 +1,5 @@ -{-# LANGUAGE CPP #-} -{-# LANGUAGE FlexibleContexts #-} -{-# LANGUAGE MultiParamTypeClasses #-} -{-# LANGUAGE OverloadedStrings #-} +{-# LANGUAGE FlexibleContexts #-} +{-# LANGUAGE OverloadedStrings #-} -- | -- -- = Simpler API @@ -31,7 +29,7 @@ -- -- > import Data.Conduit.Binary (sinkFile) -- Exported from the package conduit-extra -- > import Network.HTTP.Conduit --- > import qualified Data.Conduit as C +-- > import Conduit (runConduit, (.|)) -- > import Control.Monad.Trans.Resource (runResourceT) -- > -- > main :: IO () @@ -40,7 +38,7 @@ -- > manager <- newManager tlsManagerSettings -- > runResourceT $ do -- > response <- http request manager --- > responseBody response C.$$+- sinkFile "google.html" +-- > runConduit $ responseBody response .| sinkFile "google.html" -- -- The following headers are automatically set by this module, and should not -- be added to 'requestHeaders': @@ -181,11 +179,8 @@ , Manager , newManager , closeManager - , withManager - , withManagerSettings -- ** Settings , ManagerSettings - , conduitManagerSettings , tlsManagerSettings , mkManagerSettings , managerConnCount @@ -225,13 +220,12 @@ import qualified Data.ByteString as S import qualified Data.ByteString.Lazy as L -import Data.Conduit (ResumableSource, ($$+-), await, ($$++), ($$+), Source, addCleanup) -import qualified Data.Conduit.Internal as CI +import Data.Conduit import qualified Data.Conduit.List as CL import Data.IORef (readIORef, writeIORef, newIORef) import Data.Int (Int64) import Control.Applicative as A ((<$>)) -import Control.Monad.IO.Class (MonadIO (liftIO)) +import Control.Monad.IO.Unlift (MonadIO (liftIO)) import Control.Monad.Trans.Resource import qualified Network.HTTP.Client as Client (httpLbs, responseOpen, responseClose) @@ -301,31 +295,14 @@ req <- liftIO $ parseUrlThrow url responseBody A.<$> httpLbs (setConnectionClose req) man -conduitManagerSettings :: ManagerSettings -conduitManagerSettings = tlsManagerSettings -{-# DEPRECATED conduitManagerSettings "Use tlsManagerSettings" #-} - -withManager :: (MonadIO m, MonadBaseControl IO m) - => (Manager -> ResourceT m a) - -> m a -withManager = withManagerSettings tlsManagerSettings -{-# DEPRECATED withManager "Please use newManager tlsManagerSettings" #-} - -withManagerSettings :: (MonadIO m, MonadBaseControl IO m) - => ManagerSettings - -> (Manager -> ResourceT m a) - -> m a -withManagerSettings set f = liftIO (newManager set) >>= runResourceT . f -{-# DEPRECATED withManagerSettings "Please use newManager" #-} - setConnectionClose :: Request -> Request setConnectionClose req = req{requestHeaders = ("Connection", "close") : requestHeaders req} lbsResponse :: Monad m - => Response (ResumableSource m S.ByteString) + => Response (ConduitM () S.ByteString m ()) -> m (Response L.ByteString) lbsResponse res = do - bss <- responseBody res $$+- CL.consume + bss <- runConduit $ responseBody res .| CL.consume return res { responseBody = L.fromChunks bss } @@ -333,27 +310,21 @@ http :: MonadResource m => Request -> Manager - -> m (Response (ResumableSource m S.ByteString)) + -> m (Response (ConduitM i S.ByteString m ())) http req man = do (key, res) <- allocate (Client.responseOpen req man) Client.responseClose -#if MIN_VERSION_conduit(1, 2, 0) - let rsrc = CI.ResumableSource - (flip CI.unConduitM CI.Done $ addCleanup (const $ release key) $ HCC.bodyReaderSource $ responseBody res) - (release key) -#else - let rsrc = CI.ResumableSource - (addCleanup (const $ release key) $ HCC.bodyReaderSource $ responseBody res) - (release key) -#endif - return res { responseBody = rsrc } + return res { responseBody = do + HCC.bodyReaderSource $ responseBody res + release key + } -requestBodySource :: Int64 -> Source (ResourceT IO) S.ByteString -> RequestBody +requestBodySource :: Int64 -> ConduitM () S.ByteString (ResourceT IO) () -> RequestBody requestBodySource size = RequestBodyStream size . srcToPopper -requestBodySourceChunked :: Source (ResourceT IO) S.ByteString -> RequestBody +requestBodySourceChunked :: ConduitM () S.ByteString (ResourceT IO) () -> RequestBody requestBodySourceChunked = RequestBodyStreamChunked . srcToPopper -srcToPopper :: Source (ResourceT IO) S.ByteString -> HCC.GivesPopper () +srcToPopper :: ConduitM () S.ByteString (ResourceT IO) () -> HCC.GivesPopper () srcToPopper src f = runResourceT $ do (rsrc0, ()) <- src $$+ return () irsrc <- liftIO $ newIORef rsrc0 @@ -370,8 +341,8 @@ | otherwise -> return bs liftIO $ f popper -requestBodySourceIO :: Int64 -> Source IO S.ByteString -> RequestBody +requestBodySourceIO :: Int64 -> ConduitM () S.ByteString IO () -> RequestBody requestBodySourceIO = HCC.requestBodySource -requestBodySourceChunkedIO :: Source IO S.ByteString -> RequestBody +requestBodySourceChunkedIO :: ConduitM () S.ByteString IO () -> RequestBody requestBodySourceChunkedIO = HCC.requestBodySourceChunked diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn' '--exclude=.svnignore' old/http-conduit-2.2.3.2/Network/HTTP/Simple.hs new/http-conduit-2.3.1/Network/HTTP/Simple.hs --- old/http-conduit-2.2.3.2/Network/HTTP/Simple.hs 2017-07-07 11:45:59.000000000 +0200 +++ new/http-conduit-2.3.1/Network/HTTP/Simple.hs 2018-04-09 15:40:11.000000000 +0200 @@ -11,15 +11,16 @@ -- -- > {-# LANGUAGE OverloadedStrings #-} -- > import Network.HTTP.Simple --- > import qualified Data.ByteString.Lazy.Char8 as L8 +-- > import qualified Data.ByteString.Char8 as B8 -- > -- > main :: IO () --- > main = httpLBS "http://example.com"; >>= L8.putStrLn +-- > main = httpBS "http://example.com"; >>= B8.putStrLn . getResponseBody -- -- The `Data.String.IsString` instance uses `H.parseRequest` behind the scenes and inherits its behavior. module Network.HTTP.Simple ( -- * Perform requests - httpLBS + httpBS + , httpLBS , httpNoBody , httpJSON , httpJSONEither @@ -27,6 +28,7 @@ , httpSource , withResponse -- * Types + , H.Query , H.Request , H.Response , JSONException (..) @@ -78,7 +80,7 @@ import qualified Network.HTTP.Client.TLS as H import Network.HTTP.Client.Conduit (bodyReaderSource) import qualified Network.HTTP.Client.Conduit as HC -import Control.Monad.IO.Class (MonadIO, liftIO) +import Control.Monad.IO.Unlift (MonadIO, liftIO, MonadUnliftIO, withRunInIO) import Data.Aeson (FromJSON (..), Value) import Data.Aeson.Parser (json') import qualified Data.Aeson.Types as A @@ -87,15 +89,27 @@ import Control.Exception (throwIO, Exception) import Data.Typeable (Typeable) import qualified Data.Conduit as C +import Data.Conduit (runConduit, (.|), ConduitM) import qualified Data.Conduit.Attoparsec as C -import qualified Control.Monad.Catch as Catch import qualified Network.HTTP.Types as H import Data.Int (Int64) import Control.Monad.Trans.Resource (MonadResource) +import qualified Control.Exception as E (bracket) +import Data.Void (Void) --- | Perform an HTTP request and return the body as a lazy @ByteString@. Note --- that the entire value will be read into memory at once (no lazy I\/O will be --- performed). +-- | Perform an HTTP request and return the body as a @ByteString@. +-- +-- @since 2.2.4 +httpBS :: MonadIO m => H.Request -> m (H.Response S.ByteString) +httpBS req = liftIO $ do + man <- H.getGlobalManager + fmap L.toStrict `fmap` H.httpLbs req man + +-- | Perform an HTTP request and return the body as a lazy +-- @ByteString@. Note that the entire value will be read into memory +-- at once (no lazy I\/O will be performed). The advantage of a lazy +-- @ByteString@ here (versus using 'httpBS') is--if needed--a better +-- in-memory representation. -- -- @since 2.1.10 httpLBS :: MonadIO m => H.Request -> m (H.Response L.ByteString) @@ -150,17 +164,19 @@ -- | Perform an HTTP request and consume the body with the given 'C.Sink' -- -- @since 2.1.10 -httpSink :: (MonadIO m, Catch.MonadMask m) +httpSink :: MonadUnliftIO m => H.Request - -> (H.Response () -> C.Sink S.ByteString m a) + -> (H.Response () -> ConduitM S.ByteString Void m a) -> m a -httpSink req sink = do - man <- liftIO H.getGlobalManager - Catch.bracket - (liftIO $ H.responseOpen req man) - (liftIO . H.responseClose) - (\res -> bodyReaderSource (getResponseBody res) - C.$$ sink (fmap (const ()) res)) +httpSink req sink = withRunInIO $ \run -> do + man <- H.getGlobalManager + E.bracket + (H.responseOpen req man) + H.responseClose + $ \res -> run + $ runConduit + $ bodyReaderSource (getResponseBody res) + .| sink (fmap (const ()) res) -- | Perform an HTTP request, and get the response body as a Source. -- @@ -210,16 +226,16 @@ -- value. -- -- @since 2.2.3 -withResponse :: (MonadIO m, Catch.MonadMask m, MonadIO n) +withResponse :: (MonadUnliftIO m, MonadIO n) => H.Request -> (H.Response (C.ConduitM i S.ByteString n ()) -> m a) -> m a -withResponse req withRes = do - man <- liftIO H.getGlobalManager - Catch.bracket - (liftIO (H.responseOpen req man)) - (liftIO . H.responseClose) - (withRes . fmap bodyReaderSource) +withResponse req withRes = withRunInIO $ \run -> do + man <- H.getGlobalManager + E.bracket + (H.responseOpen req man) + H.responseClose + (run . withRes . fmap bodyReaderSource) -- | Alternate spelling of 'httpLBS' -- @@ -283,7 +299,11 @@ ++ (map (name, ) vals) } --- | Set the request headers, wiping out any previously set headers +-- | Set the request headers, wiping out __all__ previously set headers. This +-- means if you use 'setRequestHeaders' to set some headers and also use one of +-- the other setters that modifies the @content-type@ header (such as +-- 'setRequestBodyJSON'), be sure that 'setRequestHeaders' is evaluated +-- __first__. -- -- @since 2.1.10 setRequestHeaders :: [(H.HeaderName, S.ByteString)] -> H.Request -> H.Request @@ -292,13 +312,13 @@ -- | Get the query string parameters -- -- @since 2.1.10 -getRequestQueryString :: H.Request -> [(S.ByteString, Maybe S.ByteString)] +getRequestQueryString :: H.Request -> H.Query getRequestQueryString = H.parseQuery . H.queryString -- | Set the query string parameters -- -- @since 2.1.10 -setRequestQueryString :: [(S.ByteString, Maybe S.ByteString)] -> H.Request -> H.Request +setRequestQueryString :: H.Query -> H.Request -> H.Request setRequestQueryString = H.setQueryString -- | Set the request body to the given 'H.RequestBody'. You may want to @@ -317,7 +337,7 @@ -- /Note/: This will not modify the request method. For that, please use -- 'requestMethod'. You likely don't want the default of @GET@. -- --- This also sets the @content-type@ to @application/json; chatset=utf8@ +-- This also sets the @Content-Type@ to @application/json; charset=utf-8@ -- -- @since 2.1.10 setRequestBodyJSON :: A.ToJSON a => a -> H.Request -> H.Request @@ -344,7 +364,7 @@ -- -- @since 2.1.10 setRequestBodySource :: Int64 -- ^ length of source - -> C.Source IO S.ByteString + -> ConduitM () S.ByteString IO () -> H.Request -> H.Request setRequestBodySource len src req = req { H.requestBody = HC.requestBodySource len src } @@ -360,10 +380,8 @@ -- | Set the request body as URL encoded data -- --- /Note/: This will not modify the request method. For that, please use --- 'requestMethod'. You likely don't want the default of @GET@. --- --- This also sets the @content-type@ to @application/x-www-form-urlencoded@ +-- /Note/: This will change the request method to @POST@ and set the @content-type@ +-- to @application/x-www-form-urlencoded@ -- -- @since 2.1.10 setRequestBodyURLEncoded :: [(S.ByteString, S.ByteString)] -> H.Request -> H.Request diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn' '--exclude=.svnignore' old/http-conduit-2.2.3.2/http-conduit.cabal new/http-conduit-2.3.1/http-conduit.cabal --- old/http-conduit-2.2.3.2/http-conduit.cabal 2017-07-07 11:45:59.000000000 +0200 +++ new/http-conduit-2.3.1/http-conduit.cabal 2018-04-09 15:40:11.000000000 +0200 @@ -1,5 +1,5 @@ name: http-conduit -version: 2.2.3.2 +version: 2.3.1 license: BSD3 license-file: LICENSE author: Michael Snoyman <[email protected]> @@ -25,16 +25,17 @@ , aeson >= 0.8 , bytestring >= 0.9.1.4 , transformers >= 0.2 - , resourcet >= 1.1 && < 1.2 - , conduit >= 0.5.5 && < 1.3 - , conduit-extra >= 1.1.5 + , resourcet >= 1.1 + , conduit >= 1.2 + , conduit-extra >= 1.1 , http-types >= 0.7 - , lifted-base >= 0.1 , http-client >= 0.5 && < 0.6 , http-client-tls >= 0.3 && < 0.4 - , monad-control , mtl - , exceptions >= 0.6 + , unliftio-core + + if !impl(ghc>=7.9) + build-depends: void >= 0.5.5 exposed-modules: Network.HTTP.Conduit Network.HTTP.Client.Conduit Network.HTTP.Simple @@ -62,7 +63,7 @@ , conduit >= 1.1 , utf8-string , case-insensitive - , lifted-base + , unliftio , network , wai >= 3.0 && < 3.3 , warp >= 3.0.0.2 && < 3.3 diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn' '--exclude=.svnignore' old/http-conduit-2.2.3.2/test/main.hs new/http-conduit-2.3.1/test/main.hs --- old/http-conduit-2.2.3.2/test/main.hs 2017-07-07 11:46:38.000000000 +0200 +++ new/http-conduit-2.3.1/test/main.hs 2018-01-16 14:28:38.000000000 +0100 @@ -12,15 +12,15 @@ import System.IO.Temp (withSystemTempFile) import qualified Network.Wai as Wai import Network.Wai.Handler.Warp (runSettings, defaultSettings, setPort, setBeforeMainLoop, Settings, setTimeout) -import Network.HTTP.Conduit hiding (port, withManager, withManagerSettings) +import Network.HTTP.Conduit hiding (port) import qualified Network.HTTP.Conduit as NHC import Network.HTTP.Client.MultipartFormData import Control.Concurrent (forkIO, killThread, putMVar, takeMVar, newEmptyMVar, threadDelay) import Network.HTTP.Types -import Control.Exception.Lifted (try, SomeException, bracket, onException, IOException) +import UnliftIO.Exception (try, SomeException, bracket, onException, IOException) import qualified Data.IORef as I import qualified Control.Exception as E (catch) -import Network.Socket (sClose) +import qualified Network.Socket as NS import qualified Network.BSD import CookieTest (cookieTest) #if MIN_VERSION_conduit(1,1,0) @@ -32,7 +32,7 @@ #endif import qualified Data.Conduit.Network import System.IO.Unsafe (unsafePerformIO) -import Data.Conduit (($$), ($$+-), yield, Flush (Chunk, Flush), await) +import Data.Conduit ((.|), yield, Flush (Chunk, Flush), await, runConduit) import Control.Monad (void, forever) import Control.Monad.IO.Class (liftIO) import Data.ByteString.UTF8 (fromString) @@ -53,14 +53,7 @@ import qualified Data.Aeson as A import qualified Network.HTTP.Simple as Simple import Data.Monoid (mempty) -import Control.Monad.Trans.Resource (ResourceT, runResourceT) - --- I'm too lazy to rewrite code below -withManager :: (Manager -> ResourceT IO a) -> IO a -withManager = withManagerSettings tlsManagerSettings - -withManagerSettings :: ManagerSettings -> (Manager -> ResourceT IO a) -> IO a -withManagerSettings set f = newManager set >>= (runResourceT . f) +import Control.Monad.Trans.Resource (runResourceT) past :: UTCTime past = UTCTime (ModifiedJulianDay 56200) (secondsToDiffTime 0) @@ -122,7 +115,7 @@ case esocket of Left (_ :: IOException) -> getPort Right socket -> do - sClose socket + NS.close socket return port withApp :: (Wai.Request -> IO Wai.Response) -> (Int -> IO ()) -> IO () @@ -187,42 +180,42 @@ describe "httpLbs" $ do it "preserves 'set-cookie' headers" $ withApp app $ \port -> do request <- parseUrlThrow $ concat ["http://127.0.0.1:";, show port, "/cookies"] - withManager $ \manager -> do - response <- httpLbs request manager - let setCookie = mk (fromString "Set-Cookie") - (setCookieHeaders, _) = partition ((== setCookie) . fst) (NHC.responseHeaders response) - liftIO $ assertBool "response contains a 'set-cookie' header" $ length setCookieHeaders > 0 + manager <- newManager tlsManagerSettings + response <- httpLbs request manager + let setCookie = mk (fromString "Set-Cookie") + (setCookieHeaders, _) = partition ((== setCookie) . fst) (NHC.responseHeaders response) + assertBool "response contains a 'set-cookie' header" $ length setCookieHeaders > 0 it "redirects set cookies" $ withApp app $ \port -> do request <- parseUrlThrow $ concat ["http://127.0.0.1:";, show port, "/cookie_redir1"] - withManager $ \manager -> do - response <- httpLbs request manager - liftIO $ (responseBody response) @?= "nom-nom-nom" + manager <- newManager tlsManagerSettings + response <- httpLbs request manager + (responseBody response) @?= "nom-nom-nom" it "user-defined cookie jar works" $ withApp app $ \port -> do request <- parseUrlThrow $ concat ["http://127.0.0.1:";, show port, "/dump_cookies"] - withManager $ \manager -> do - response <- httpLbs (request {redirectCount = 1, cookieJar = Just cookie_jar}) manager - liftIO $ (responseBody response) @?= "key=value" + manager <- newManager tlsManagerSettings + response <- httpLbs (request {redirectCount = 1, cookieJar = Just cookie_jar}) manager + (responseBody response) @?= "key=value" it "user-defined cookie jar is not ignored when redirection is disabled" $ withApp app $ \port -> do request <- parseUrlThrow $ concat ["http://127.0.0.1:";, show port, "/dump_cookies"] - withManager $ \manager -> do - response <- httpLbs (request {redirectCount = 0, cookieJar = Just cookie_jar}) manager - liftIO $ (responseBody response) @?= "key=value" + manager <- newManager tlsManagerSettings + response <- httpLbs (request {redirectCount = 0, cookieJar = Just cookie_jar}) manager + (responseBody response) @?= "key=value" it "cookie jar is available in response" $ withApp app $ \port -> do request <- parseUrlThrow $ concat ["http://127.0.0.1:";, show port, "/cookies"] - withManager $ \manager -> do - response <- httpLbs (request {cookieJar = Just Data.Monoid.mempty}) manager - liftIO $ (length $ destroyCookieJar $ responseCookieJar response) @?= 1 + manager <- newManager tlsManagerSettings + response <- httpLbs (request {cookieJar = Just Data.Monoid.mempty}) manager + (length $ destroyCookieJar $ responseCookieJar response) @?= 1 it "Cookie header isn't touched when no cookie jar supplied" $ withApp app $ \port -> do request <- parseUrlThrow $ concat ["http://127.0.0.1:";, show port, "/dump_cookies"] - withManager $ \manager -> do - let request_headers = (mk "Cookie", "key2=value2") : filter ((/= mk "Cookie") . fst) (NHC.requestHeaders request) - response <- httpLbs (request {NHC.requestHeaders = request_headers, cookieJar = Nothing}) manager - liftIO $ (responseBody response) @?= "key2=value2" + manager <- newManager tlsManagerSettings + let request_headers = (mk "Cookie", "key2=value2") : filter ((/= mk "Cookie") . fst) (NHC.requestHeaders request) + response <- httpLbs (request {NHC.requestHeaders = request_headers, cookieJar = Nothing}) manager + (responseBody response) @?= "key2=value2" it "Response cookie jar is nothing when request cookie jar is nothing" $ withApp app $ \port -> do request <- parseUrlThrow $ concat ["http://127.0.0.1:";, show port, "/cookies"] - withManager $ \manager -> do - response <- httpLbs (request {cookieJar = Nothing}) manager - liftIO $ (responseCookieJar response) @?= mempty + manager <- newManager tlsManagerSettings + response <- httpLbs (request {cookieJar = Nothing}) manager + (responseCookieJar response) @?= mempty it "TLS" $ withAppTls app $ \port -> do request <- parseUrlThrow $ "https://127.0.0.1:"; ++ show port let set = mkManagerSettings @@ -230,14 +223,16 @@ { settingDisableCertificateValidation = True } Nothing - response <- withManagerSettings set $ httpLbs request + manager <- newManager set + response <- httpLbs request manager responseBody response @?= "homepage" describe "manager" $ do it "closes all connections" $ withApp app $ \port1 -> withApp app $ \port2 -> do --FIXME clearSocketsList - withManager $ \manager -> do - let Just req1 = parseUrlThrow $ "http://127.0.0.1:"; ++ show port1 - let Just req2 = parseUrlThrow $ "http://127.0.0.1:"; ++ show port2 + manager <- newManager tlsManagerSettings + let Just req1 = parseUrlThrow $ "http://127.0.0.1:"; ++ show port1 + let Just req2 = parseUrlThrow $ "http://127.0.0.1:"; ++ show port2 + runResourceT $ do _res1a <- http req1 manager _res1b <- http req1 manager _res2 <- http req2 manager @@ -245,120 +240,122 @@ --FIXME requireAllSocketsClosed describe "http" $ do it "response body" $ withApp app $ \port -> do - withManager $ \manager -> do - req <- liftIO $ parseUrlThrow $ "http://127.0.0.1:"; ++ show port + manager <- newManager tlsManagerSettings + req <- parseUrlThrow $ "http://127.0.0.1:"; ++ show port + runResourceT $ do res1 <- http req manager - bss <- responseBody res1 $$+- CL.consume + bss <- runConduit $ responseBody res1 .| CL.consume res2 <- httpLbs req manager liftIO $ L.fromChunks bss `shouldBe` responseBody res2 describe "DOS protection" $ do it "overlong headers" $ overLongHeaders $ \port -> do - withManager $ \manager -> do - let Just req1 = parseUrlThrow $ "http://127.0.0.1:"; ++ show port - res1 <- try $ http req1 manager - case res1 of - Left e -> liftIO $ show (e :: SomeException) @?= show (HttpExceptionRequest req1 OverlongHeaders) - _ -> error "Shouldn't have worked" + manager <- newManager tlsManagerSettings + let Just req1 = parseUrlThrow $ "http://127.0.0.1:"; ++ show port + res1 <- try $ runResourceT $ http req1 manager + case res1 of + Left e -> show (e :: SomeException) @?= show (HttpExceptionRequest req1 OverlongHeaders) + _ -> error "Shouldn't have worked" it "not overlong headers" $ notOverLongHeaders $ \port -> do - withManager $ \manager -> do - let Just req1 = parseUrlThrow $ "http://127.0.0.1:"; ++ show port - _ <- httpLbs req1 manager - return () + manager <- newManager tlsManagerSettings + let Just req1 = parseUrlThrow $ "http://127.0.0.1:"; ++ show port + _ <- httpLbs req1 manager + return () describe "redirects" $ do it "doesn't double escape" $ redir $ \port -> do - withManager $ \manager -> do - let go (encoded, final) = do - let Just req1 = parseUrlThrow $ concat ["http://127.0.0.1:";, show port, "/redir/", encoded] - res <- httpLbs req1 manager - liftIO $ Network.HTTP.Conduit.responseStatus res @?= status200 - liftIO $ responseBody res @?= L.fromChunks [TE.encodeUtf8 final] - mapM_ go - [ ("hello world%2F", "hello world/") - , ("%D7%A9%D7%9C%D7%95%D7%9D", "שלום") - , ("simple", "simple") - , ("hello%20world", "hello world") - , ("hello%20world%3f%23", "hello world?#") - ] + manager <- newManager tlsManagerSettings + let go (encoded, final) = do + let Just req1 = parseUrlThrow $ concat ["http://127.0.0.1:";, show port, "/redir/", encoded] + res <- httpLbs req1 manager + liftIO $ Network.HTTP.Conduit.responseStatus res @?= status200 + liftIO $ responseBody res @?= L.fromChunks [TE.encodeUtf8 final] + mapM_ go + [ ("hello world%2F", "hello world/") + , ("%D7%A9%D7%9C%D7%95%D7%9D", "שלום") + , ("simple", "simple") + , ("hello%20world", "hello world") + , ("hello%20world%3f%23", "hello world?#") + ] it "TooManyRedirects: redirect request body is preserved" $ withApp app $ \port -> do let Just req = parseUrlThrow $ concat ["http://127.0.0.1:";, show port, "/infredir/0"] let go (res, i) = liftIO $ responseBody res @?= (L8.pack $ show i) - E.catch (withManager $ \manager -> do - void $ http req{redirectCount=5} manager) $ \e -> + manager <- newManager tlsManagerSettings + E.catch (void $ runResourceT $ http req{redirectCount=5} manager) + $ \e -> case e of HttpExceptionRequest _ (TooManyRedirects redirs) -> mapM_ go (zip redirs [5,4..0 :: Int]) _ -> error $ show e describe "chunked request body" $ do it "works" $ echo $ \port -> do - withManager $ \manager -> do - let go bss = do - let Just req1 = parseUrlThrow $ "POST http://127.0.0.1:"; ++ show port - src = sourceList bss - lbs = L.fromChunks bss - res <- httpLbs req1 - { requestBody = requestBodySourceChunked src - } manager - liftIO $ Network.HTTP.Conduit.responseStatus res @?= status200 - let ts = S.concat . L.toChunks - liftIO $ ts (responseBody res) @?= ts lbs - mapM_ go - [ ["hello", "world"] - , replicate 500 "foo\003\n\r" - ] + manager <- newManager tlsManagerSettings + let go bss = do + let Just req1 = parseUrlThrow $ "POST http://127.0.0.1:"; ++ show port + src = sourceList bss + lbs = L.fromChunks bss + res <- httpLbs req1 + { requestBody = requestBodySourceChunked src + } manager + liftIO $ Network.HTTP.Conduit.responseStatus res @?= status200 + let ts = S.concat . L.toChunks + liftIO $ ts (responseBody res) @?= ts lbs + mapM_ go + [ ["hello", "world"] + , replicate 500 "foo\003\n\r" + ] describe "no status message" $ do it "works" $ noStatusMessage $ \port -> do req <- parseUrlThrow $ "http://127.0.0.1:"; ++ show port - withManager $ \manager -> do - res <- httpLbs req manager - liftIO $ do - Network.HTTP.Conduit.responseStatus res `shouldBe` status200 - responseBody res `shouldBe` "foo" + manager <- newManager tlsManagerSettings + res <- httpLbs req manager + liftIO $ do + Network.HTTP.Conduit.responseStatus res `shouldBe` status200 + responseBody res `shouldBe` "foo" describe "response body too short" $ do it "throws an exception" $ wrongLength $ \port -> do req <- parseUrlThrow $ "http://127.0.0.1:"; ++ show port - withManager $ \manager -> do - eres <- try $ httpLbs req manager - liftIO $ either (Left . (show :: HttpException -> String)) (Right . id) eres - `shouldBe` Left (show $ HttpExceptionRequest req $ ResponseBodyTooShort 50 18) + manager <- newManager tlsManagerSettings + eres <- try $ httpLbs req manager + liftIO $ either (Left . (show :: HttpException -> String)) (Right . id) eres + `shouldBe` Left (show $ HttpExceptionRequest req $ ResponseBodyTooShort 50 18) describe "chunked response body" $ do it "no chunk terminator" $ wrongLengthChunk1 $ \port -> do req <- parseUrlThrow $ "http://127.0.0.1:"; ++ show port - withManager $ \manager -> do - eres <- try $ httpLbs req manager - liftIO $ either (Left . (show :: HttpException -> String)) (Right . id) eres - `shouldBe` Left (show (HttpExceptionRequest req IncompleteHeaders)) + manager <- newManager tlsManagerSettings + eres <- try $ httpLbs req manager + liftIO $ either (Left . (show :: HttpException -> String)) (Right . id) eres + `shouldBe` Left (show (HttpExceptionRequest req IncompleteHeaders)) it "incomplete chunk" $ wrongLengthChunk2 $ \port -> do req <- parseUrlThrow $ "http://127.0.0.1:"; ++ show port - withManager $ \manager -> do - eres <- try $ httpLbs req manager - liftIO $ either (Left . (show :: HttpException -> String)) (Right . id) eres - `shouldBe` Left (show (HttpExceptionRequest req InvalidChunkHeaders)) + manager <- newManager tlsManagerSettings + eres <- try $ httpLbs req manager + liftIO $ either (Left . (show :: HttpException -> String)) (Right . id) eres + `shouldBe` Left (show (HttpExceptionRequest req InvalidChunkHeaders)) it "invalid chunk" $ invalidChunk $ \port -> do req <- parseUrlThrow $ "http://127.0.0.1:"; ++ show port - withManager $ \manager -> do - eres <- try $ httpLbs req manager - liftIO $ either (Left . (show :: HttpException -> String)) (Right . id) eres - `shouldBe` Left (show (HttpExceptionRequest req InvalidChunkHeaders)) + manager <- newManager tlsManagerSettings + eres <- try $ httpLbs req manager + liftIO $ either (Left . (show :: HttpException -> String)) (Right . id) eres + `shouldBe` Left (show (HttpExceptionRequest req InvalidChunkHeaders)) it "missing header" $ rawApp "HTTP/1.1 200 OK\r\nTransfer-Encoding: chunked\r\n\r\n4\r\nabcd\r\n\r\n\r\n" $ \port -> do req <- parseUrlThrow $ "http://127.0.0.1:"; ++ show port - withManager $ \manager -> do - eres <- try $ httpLbs req manager - liftIO $ either (Left . (show :: HttpException -> String)) (Right . id) eres - `shouldBe` Left (show (HttpExceptionRequest req InvalidChunkHeaders)) + manager <- newManager tlsManagerSettings + eres <- try $ httpLbs req manager + liftIO $ either (Left . (show :: HttpException -> String)) (Right . id) eres + `shouldBe` Left (show (HttpExceptionRequest req InvalidChunkHeaders)) it "junk header" $ rawApp "HTTP/1.1 200 OK\r\nTransfer-Encoding: chunked\r\n\r\n4\r\nabcd\r\njunk\r\n\r\n" $ \port -> do req <- parseUrlThrow $ "http://127.0.0.1:"; ++ show port - withManager $ \manager -> do - eres <- try $ httpLbs req manager - liftIO $ either (Left . (show :: HttpException -> String)) (Right . id) eres - `shouldBe` Left (show (HttpExceptionRequest req InvalidChunkHeaders)) + manager <- newManager tlsManagerSettings + eres <- try $ httpLbs req manager + liftIO $ either (Left . (show :: HttpException -> String)) (Right . id) eres + `shouldBe` Left (show (HttpExceptionRequest req InvalidChunkHeaders)) describe "redirect" $ do it "ignores large response bodies" $ do @@ -366,7 +363,8 @@ case pathInfo req of ["foo"] -> return $ responseLBS status200 [] "Hello World!" _ -> return $ responseSource status301 [("location", S8.pack $ "http://127.0.0.1:"; ++ show port ++ "/foo")] $ forever $ yield $ Chunk $ fromByteString "hello\n" - withApp' app' $ \port -> withManager $ \manager -> do + manager <- newManager tlsManagerSettings + withApp' app' $ \port -> do req <- liftIO $ parseUrlThrow $ "http://127.0.0.1:"; ++ show port res <- httpLbs req manager liftIO $ do @@ -397,9 +395,10 @@ describe "HTTP/1.0" $ do it "BaseHTTP" $ do let baseHTTP app' = do - _ <- appSource app' $$ await - yield "HTTP/1.0 200 OK\r\n\r\nThis is it!" $$ appSink app' - withCApp baseHTTP $ \port -> withManager $ \manager -> do + _ <- runConduit $ appSource app' .| await + runConduit $ yield "HTTP/1.0 200 OK\r\n\r\nThis is it!" .| appSink app' + manager <- newManager tlsManagerSettings + withCApp baseHTTP $ \port -> do req <- liftIO $ parseUrlThrow $ "http://127.0.0.1:"; ++ show port res1 <- httpLbs req manager res2 <- httpLbs req manager @@ -410,41 +409,42 @@ entry <- Network.BSD.getHostByName "127.0.0.1" req' <- parseUrlThrow $ "http://example.com:"; ++ show port let req = req' { hostAddress = Just $ Network.BSD.hostAddress entry } - res <- withManager $ httpLbs req + manager <- newManager tlsManagerSettings + res <- httpLbs req manager responseBody res @?= "homepage for example.com" describe "managerResponseTimeout" $ do it "works" $ withApp app $ \port -> do req1 <- parseUrlThrow $ "http://localhost:"; ++ show port let req2 = req1 { responseTimeout = responseTimeoutMicro 5000000 } - withManagerSettings tlsManagerSettings { managerResponseTimeout = responseTimeoutMicro 1 } $ \man -> do - eres1 <- try $ httpLbs req1 { NHC.path = "/delayed" } man - case eres1 of - Left (HttpExceptionRequest _ ConnectionTimeout{}) -> return () - _ -> error "Did not time out" - _ <- httpLbs req2 man - return () + man <- newManager tlsManagerSettings { managerResponseTimeout = responseTimeoutMicro 1 } + eres1 <- try $ httpLbs req1 { NHC.path = "/delayed" } man + case eres1 of + Left (HttpExceptionRequest _ ConnectionTimeout{}) -> return () + _ -> error "Did not time out" + _ <- httpLbs req2 man + return () describe "delayed body" $ do it "works" $ withApp app $ \port -> do req <- parseUrlThrow $ "http://localhost:"; ++ show port ++ "/delayed" - withManager $ \man -> do - _ <- http req man - return () + man <- newManager tlsManagerSettings + _ <- runResourceT $ http req man + return () it "reuse/connection close tries again" $ do withAppSettings (setTimeout 1) (const app) $ \port -> do req <- parseUrlThrow $ "http://localhost:"; ++ show port - withManager $ \man -> do - res1 <- httpLbs req man - liftIO $ threadDelay 3000000 - res2 <- httpLbs req man - let f res = res - { NHC.responseHeaders = filter (not . isDate) (NHC.responseHeaders res) - } - isDate ("date", _) = True - isDate _ = False - liftIO $ f res2 `shouldBe` f res1 + man <- newManager tlsManagerSettings + res1 <- httpLbs req man + threadDelay 3000000 + res2 <- httpLbs req man + let f res = res + { NHC.responseHeaders = filter (not . isDate) (NHC.responseHeaders res) + } + isDate ("date", _) = True + isDate _ = False + f res2 `shouldBe` f res1 it "setQueryString" $ do ref <- I.newIORef undefined @@ -457,10 +457,9 @@ , (TE.encodeUtf8 "שלום", Just "hola") , ("noval", Nothing) ] - withManager $ \man -> do - req <- parseUrlThrow $ "http://localhost:"; ++ show port - _ <- httpLbs (setQueryString qs req) man - return () + man <- newManager tlsManagerSettings + req <- parseUrlThrow $ "http://localhost:"; ++ show port + _ <- httpLbs (setQueryString qs req) man res <- I.readIORef ref res `shouldBe` qs @@ -471,24 +470,24 @@ responseBody value `shouldBe` jsonValue it "RequestBodyIO" $ echo $ \port -> do - withManager $ \manager -> do - let go bss = withSystemTempFile "request-body-io" $ \tmpfp tmph -> do - liftIO $ do - mapM_ (S.hPutStr tmph) bss - hClose tmph + manager <- newManager tlsManagerSettings + let go bss = withSystemTempFile "request-body-io" $ \tmpfp tmph -> do + liftIO $ do + mapM_ (S.hPutStr tmph) bss + hClose tmph - let Just req1 = parseUrlThrow $ "POST http://127.0.0.1:"; ++ show port - lbs = L.fromChunks bss - res <- httpLbs req1 - { requestBody = RequestBodyIO (streamFile tmpfp) - } manager - liftIO $ Network.HTTP.Conduit.responseStatus res @?= status200 - let ts = S.concat . L.toChunks - liftIO $ ts (responseBody res) @?= ts lbs - mapM_ go - [ ["hello", "world"] - , replicate 500 "foo\003\n\r" - ] + let Just req1 = parseUrlThrow $ "POST http://127.0.0.1:"; ++ show port + lbs = L.fromChunks bss + res <- httpLbs req1 + { requestBody = RequestBodyIO (streamFile tmpfp) + } manager + liftIO $ Network.HTTP.Conduit.responseStatus res @?= status200 + let ts = S.concat . L.toChunks + liftIO $ ts (responseBody res) @?= ts lbs + mapM_ go + [ ["hello", "world"] + , replicate 500 "foo\003\n\r" + ] withCApp :: (Data.Conduit.Network.AppData -> IO ()) -> (Int -> IO ()) -> IO () withCApp app' f = do @@ -509,14 +508,14 @@ overLongHeaders :: (Int -> IO ()) -> IO () overLongHeaders = - withCApp $ \app' -> src $$ appSink app' + withCApp $ \app' -> runConduit $ src .| appSink app' where src = sourceList $ "HTTP/1.0 200 OK\r\nfoo: " : repeat "bar" notOverLongHeaders :: (Int -> IO ()) -> IO () notOverLongHeaders = withCApp $ \app' -> do - appSource app' $$ CL.drop 1 - src $$ appSink app' + runConduit $ appSource app' .| CL.drop 1 + runConduit $ src .| appSink app' where src = sourceList $ [S.concat $ "HTTP/1.0 200 OK\r\nContent-Type: text/plain\r\nContent-Length: 16384\r\n\r\n" : ( take 16384 $ repeat "x")] @@ -556,20 +555,20 @@ echo :: (Int -> IO ()) -> IO () echo = withApp $ \req -> do - bss <- sourceRequestBody req $$ CL.consume + bss <- runConduit $ sourceRequestBody req .| CL.consume return $ responseLBS status200 [] $ L.fromChunks bss noStatusMessage :: (Int -> IO ()) -> IO () noStatusMessage = - withCApp $ \app' -> src $$ appSink app' + withCApp $ \app' -> runConduit $ src .| appSink app' where src = yield "HTTP/1.0 200\r\nContent-Length: 3\r\n\r\nfoo: barbazbin" wrongLength :: (Int -> IO ()) -> IO () wrongLength = withCApp $ \app' -> do - _ <- appSource app' $$ await - src $$ appSink app' + _ <- runConduit $ appSource app' .| await + runConduit $ src .| appSink app' where src = do yield "HTTP/1.0 200 OK\r\nContent-Length: 50\r\n\r\n" @@ -578,32 +577,32 @@ wrongLengthChunk1 :: (Int -> IO ()) -> IO () wrongLengthChunk1 = withCApp $ \app' -> do - _ <- appSource app' $$ await - src $$ appSink app' + _ <- runConduit $ appSource app' .| await + runConduit $ src .| appSink app' where src = yield "HTTP/1.1 200 OK\r\nTransfer-Encoding: chunked\r\n\r\n4\r\nWiki\r\n" wrongLengthChunk2 :: (Int -> IO ()) -> IO () wrongLengthChunk2 = withCApp $ \app' -> do - _ <- appSource app' $$ await - src $$ appSink app' + _ <- runConduit $ appSource app' .| await + runConduit $ src .| appSink app' where src = yield "HTTP/1.1 200 OK\r\nTransfer-Encoding: chunked\r\n\r\n4\r\nWiki\r\n5\r\npedia\r\nE\r\nin\r\n\r\nch\r\n" invalidChunk :: (Int -> IO ()) -> IO () invalidChunk = withCApp $ \app' -> do - _ <- appSource app' $$ await - src $$ appSink app' + _ <- runConduit $ appSource app' .| await + runConduit $ src .| appSink app' where src = yield "HTTP/1.1 200 OK\r\nTransfer-Encoding: chunked\r\n\r\n4\r\nabcd\r\ngarbage\r\nef\r\n0\r\n\r\n" rawApp :: S8.ByteString -> (Int -> IO ()) -> IO () rawApp bs = withCApp $ \app' -> do - _ <- appSource app' $$ await - src $$ appSink app' + _ <- runConduit $ appSource app' .| await + runConduit $ src .| appSink app' where src = yield bs
