req-conduit (empty) → 0.1.0
raw patch · 9 files changed
+542/−0 lines, 9 filesdep +basedep +bytestringdep +conduitsetup-changed
Dependencies added: base, bytestring, conduit, conduit-extra, hspec, http-client, req, req-conduit, resourcet, temporary, transformers, weigh
Files
- CHANGELOG.md +3/−0
- LICENSE.md +28/−0
- Network/HTTP/Req/Conduit.hs +165/−0
- README.md +34/−0
- Setup.hs +6/−0
- httpbin-tests/Network/HTTP/Req/ConduitSpec.hs +100/−0
- httpbin-tests/Spec.hs +1/−0
- req-conduit.cabal +111/−0
- weigh-bench/Main.hs +94/−0
+ CHANGELOG.md view
@@ -0,0 +1,3 @@+## Req Conduit 0.1.0++* Initial release.
+ LICENSE.md view
@@ -0,0 +1,28 @@+Copyright © 2016 Mark Karpov++All rights reserved.++Redistribution and use in source and binary forms, with or without+modification, are permitted provided that the following conditions are met:++* Redistributions of source code must retain the above copyright notice,+ this list of conditions and the following disclaimer.++* Redistributions in binary form must reproduce the above copyright+ notice, this list of conditions and the following disclaimer in the+ documentation and/or other materials provided with the distribution.++* Neither the name Mark Karpov nor the names of contributors may be used to+ endorse or promote products derived from this software without specific+ prior written permission.++THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS “AS IS” AND ANY EXPRESS+OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES+OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE DISCLAIMED. IN+NO EVENT SHALL THE COPYRIGHT HOLDERS BE LIABLE FOR ANY DIRECT, INDIRECT,+INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT+LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA,+OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF+LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING+NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE,+EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
+ Network/HTTP/Req/Conduit.hs view
@@ -0,0 +1,165 @@+-- |+-- Module : Network.HTTP.Req.Conduit+-- Copyright : © 2016 Mark Karpov, Michael Snoyman+-- License : BSD 3 clause+--+-- Maintainer : Mark Karpov <markkarpov@openmailbox.org>+-- Stability : experimental+-- Portability : portable+--+-- The module extends functionality available in "Network.HTTP.Req" with+-- Conduit helpers for streaming big request bodies.+--+-- The package re-uses some pieces of code from the @http-conduit@ package,+-- but not to the extent that depending on that package is reasonable.++{-# LANGUAGE CPP #-}+{-# LANGUAGE RankNTypes #-}+{-# LANGUAGE TypeFamilies #-}++#if __GLASGOW_HASKELL__ < 710+{-# LANGUAGE ConstraintKinds #-}+#endif++module Network.HTTP.Req.Conduit+ ( -- * Streaming request bodies+ ReqBodySource (..)+ -- * Streaming response bodies+ -- $streaming-response+ , req'+ , httpSource )+where++import Control.Monad+import Control.Monad.IO.Class (MonadIO (..))+import Control.Monad.Trans.Resource (MonadResource (..))+import Data.ByteString (ByteString)+import Data.Conduit (Source, ($$+), ($$++), await, yield)+import Data.IORef+import Data.Int (Int64)+import Network.HTTP.Req+import qualified Data.ByteString as B+import qualified Data.Conduit as C+import qualified Network.HTTP.Client as L++----------------------------------------------------------------------------+-- Request bodies++-- | This body option streams contents of request body from given+-- 'C.Source'. The 'Int64' value is size of the data in bytes.+--+-- Using of this body option does not set the @Content-Type@ header.++data ReqBodySource = ReqBodySource Int64 (C.Source IO ByteString)++instance HttpBody ReqBodySource where+ getRequestBody (ReqBodySource size src) =+ L.RequestBodyStream size (srcToPopperIO src)++----------------------------------------------------------------------------+-- Response interpretations++-- $streaming-response+--+-- Streaming response is a bit tricky as acquiring and releasing a resource+-- (initiating a connection and then closing it in our case) in context of+-- @conduit@ streaming requires working with+-- 'Control.Monad.Trans.Resource.ResourceT' monad transformer. This does not+-- play well with the framework @req@ builds.+--+-- Essentially there are only two ways to make it work:+--+-- * Require that every 'MonadHttp' must be an instance of+-- 'MonadResource'. This obviously makes the @req@ package harder to+-- work with and less user-friendly. Not to mention that most of the+-- time the instance won't be necessary.+-- * Use the 'withReqManager' in combination with 'ReturnRequest'+-- response interpretation to get both 'L.Manager' and 'L.Request' and+-- then delegate the work to to a custom callback.+--+-- We go with the second option. Here is an example of how to stream 100000+-- bytes and save them to a file:+--+-- > {-# LANGUAGE FlexibleInstances #-}+-- > {-# LANGUAGE OverloadedStrings #-}+-- >+-- > module Main (main) where+-- >+-- > import Control.Exception (throwIO)+-- > import Control.Monad.IO.Class (MonadIO (..))+-- > import Control.Monad.Trans.Resource (ResourceT)+-- > import Data.Conduit ((=$=), runConduitRes, ConduitM)+-- > import Network.HTTP.Req+-- > import Network.HTTP.Req.Conduit+-- > import qualified Data.Conduit.Binary as CB+-- >+-- > instance MonadHttp (ConduitM i o (ResourceT IO)) where+-- > handleHttpException = liftIO . throwIO+-- >+-- > main :: IO ()+-- > main = runConduitRes $ do+-- > let size = 100000 :: Int+-- > req' GET (https "httpbin.org" /: "bytes" /~ size) NoReqBody httpSource mempty+-- > =$= CB.sinkFile "my-favorite-file.bin"++-- | Mostly like 'req' with respect to its arguments, but instead of a hint+-- how to interpret response it takes a callback that allows to perform a+-- request using arbitrary code.++req'+ :: ( MonadHttp m+ , HttpMethod method+ , HttpBody body+ , HttpBodyAllowed (AllowsBody method) (ProvidesBody body) )+ => method -- ^ HTTP method+ -> Url scheme -- ^ 'Url' — location of resource+ -> body -- ^ Body of the request+ -> (L.Request -> L.Manager -> m a) -- ^ How to perform actual request+ -> Option scheme -- ^ Collection of optional parameters+ -> m a -- ^ Result+req' method url body m options = do+ request <- responseRequest `liftM` req method url body returnRequest options+ withReqManager (m request)++-- | Perform an HTTP request and get the response as a 'C.Producer'.++httpSource+ :: MonadResource m+ => L.Request -- ^ Pre-formed 'L.Request'+ -> L.Manager -- ^ Manger to use+ -> C.Producer m ByteString -- ^ Response body as a 'C.Producer'+httpSource request manager =+ C.bracketP (L.responseOpen request manager) L.responseClose+ (bodyReaderSource . L.responseBody)++----------------------------------------------------------------------------+-- Helpers++-- | This is taken from "Network.HTTP.Client.Conduit" without modifications.++srcToPopperIO :: Source IO ByteString -> L.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 B.empty+ Just bs+ | B.null bs -> popper+ | otherwise -> return bs+ f popper++-- | This is taken from "Network.HTTP.Client.Conduit" without modifications.++bodyReaderSource :: MonadIO m => L.BodyReader -> C.Producer m ByteString+bodyReaderSource br = go+ where+ go = do+ bs <- liftIO (L.brRead br)+ unless (B.null bs) $ do+ yield bs+ go
+ README.md view
@@ -0,0 +1,34 @@+# Req Conduit++[](http://opensource.org/licenses/BSD-3-Clause)+[](https://hackage.haskell.org/package/req-conduit)+[](http://stackage.org/nightly/package/req-conduit)+[](http://stackage.org/lts/package/req-conduit)+[](https://travis-ci.org/mrkkrp/req-conduit)+[](https://coveralls.io/github/mrkkrp/req-conduit?branch=master)++This library extends functionality of+the [`req`](https://hackage.haskell.org/package/req) package+with [`conduit`](https://hackage.haskell.org/package/conduit) helpers for+streaming big request bodies in constant space.++## Potential issues++Streaming of request body does not happen in constant memory. But it does+not work with `http-conduit` either, see:+https://github.com/snoyberg/http-client/issues/240. Streaming of response+body does happen in constant memory as expected. See the benchmarks coming+with the library for hands-on experiences.++## Contribution++Issues, bugs, and questions may be reported in [the GitHub issue tracker for+this project](https://github.com/mrkkrp/req-conduit/issues).++Pull requests are also welcome and will be reviewed quickly.++## License++Copyright © 2016 Mark Karpov, Micheal Snoyman++Distributed under BSD 3 clause license.
+ Setup.hs view
@@ -0,0 +1,6 @@+module Main (main) where++import Distribution.Simple++main :: IO ()+main = defaultMain
+ httpbin-tests/Network/HTTP/Req/ConduitSpec.hs view
@@ -0,0 +1,100 @@+--+-- Tests for ‘req-conduit’ package. This test suite tests streaming large+-- request and response bodies.+--+-- Copyright © 2016 Mark Karpov <markkarpov@openmailbox.org>+--+-- Redistribution and use in source and binary forms, with or without+-- modification, are permitted provided that the following conditions are+-- met:+--+-- * Redistributions of source code must retain the above copyright notice,+-- this list of conditions and the following disclaimer.+--+-- * Redistributions in binary form must reproduce the above copyright+-- notice, this list of conditions and the following disclaimer in the+-- documentation and/or other materials provided with the distribution.+--+-- * Neither the name Mark Karpov nor the names of contributors may be used+-- to endorse or promote products derived from this software without+-- specific prior written permission.+--+-- THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS “AS IS” AND ANY+-- EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED+-- WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE+-- DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT HOLDERS BE LIABLE FOR ANY+-- DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL+-- DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS+-- OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION)+-- HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT,+-- STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN+-- ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE+-- POSSIBILITY OF SUCH DAMAGE.++{-# LANGUAGE CPP #-}+{-# LANGUAGE DataKinds #-}+{-# LANGUAGE FlexibleInstances #-}+{-# LANGUAGE OverloadedStrings #-}+{-# OPTIONS_GHC -fno-warn-orphans #-}++module Network.HTTP.Req.ConduitSpec+ ( spec )+where++import Control.Exception (throwIO)+import Control.Monad+import Control.Monad.IO.Class (MonadIO (..))+import Control.Monad.Trans.Resource (ResourceT)+import Data.Conduit ((=$=), runConduitRes, ConduitM)+import Data.Int (Int64)+import Network.HTTP.Req+import Network.HTTP.Req.Conduit+import System.IO (Handle)+import System.IO.Temp+import Test.Hspec+import qualified Data.ByteString as B+import qualified Data.Conduit.Binary as CB+import qualified Data.Conduit.List as CL++#if !MIN_VERSION_base(4,8,0)+import Data.Monoid+#endif++spec :: Spec+spec = do++ describe "streaming 100 M request" $+ it "works" $ do+ let size :: Int64+ size = 100 * 1024 * 1024+ src = CL.replicate (100 * 1024) (B.replicate 1024 0)+ void (req POST (httpbin /: "post")+ (ReqBodySource size src) ignoreResponse mempty) :: IO ()++ describe "streaming 100 M response" $+ it "works" $ do+ let tempi :: (Handle -> IO ()) -> IO ()+ tempi f = withSystemTempFile "req-conduit" (const f)+ tempi $ \h ->+ runConduitRes $ do+ let size :: Int+ size = 100 * 1024 * 1024+ req' GET (httpbin /: "stream-bytes" /~ size) NoReqBody+ httpSource mempty =$= CB.sinkHandle h++----------------------------------------------------------------------------+-- Instances++instance MonadHttp IO where+ handleHttpException = throwIO++instance MonadHttp (ConduitM i o (ResourceT IO)) where+ handleHttpException = liftIO . throwIO++----------------------------------------------------------------------------+-- Helpers++-- | 'Url' representing <https://httpbin.org>.++httpbin :: Url 'Https+httpbin = https "httpbin.org"
+ httpbin-tests/Spec.hs view
@@ -0,0 +1,1 @@+{-# OPTIONS_GHC -F -pgmF hspec-discover #-}
+ req-conduit.cabal view
@@ -0,0 +1,111 @@+--+-- Cabal configuration for ‘req-conduit’ package.+--+-- Copyright © 2016 Mark Karpov <markkarpov@openmailbox.org>+--+-- Redistribution and use in source and binary forms, with or without+-- modification, are permitted provided that the following conditions are+-- met:+--+-- * Redistributions of source code must retain the above copyright notice,+-- this list of conditions and the following disclaimer.+--+-- * Redistributions in binary form must reproduce the above copyright+-- notice, this list of conditions and the following disclaimer in the+-- documentation and/or other materials provided with the distribution.+--+-- * Neither the name Mark Karpov nor the names of contributors may be used+-- to endorse or promote products derived from this software without+-- specific prior written permission.+--+-- THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS “AS IS” AND ANY+-- EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED+-- WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE+-- DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT HOLDERS BE LIABLE FOR ANY+-- DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL+-- DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS+-- OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION)+-- HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT,+-- STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN+-- ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE+-- POSSIBILITY OF SUCH DAMAGE.++name: req-conduit+version: 0.1.0+cabal-version: >= 1.10+license: BSD3+license-file: LICENSE.md+author: Mark Karpov <markkarpov@openmailbox.org>, Michael Snoyman <michael@snoyman.com>+maintainer: Mark Karpov <markkarpov@openmailbox.org>+homepage: https://github.com/mrkkrp/req-conduit+bug-reports: https://github.com/mrkkrp/req-conduit/issues+category: Network, Web, Conduit+synopsis: Conduit helpers for the req HTTP client library+build-type: Simple+description: Conduit helpers for the req HTTP client library.+extra-doc-files: CHANGELOG.md+ , README.md++source-repository head+ type: git+ location: https://github.com/mrkkrp/req-conduit.git++flag dev+ description: Turn on development settings.+ manual: True+ default: False++library+ build-depends: base >= 4.7 && < 5.0+ , bytestring >= 0.2 && < 0.11+ , conduit >= 0.5.5 && < 1.3+ , http-client >= 0.5 && < 0.6+ , req >= 0.1 && < 0.2+ , resourcet >= 1.1 && < 1.2+ , transformers >= 0.4 && < 0.6+ exposed-modules: Network.HTTP.Req.Conduit+ if flag(dev)+ ghc-options: -Wall -Werror+ else+ ghc-options: -O2 -Wall+ default-language: Haskell2010++test-suite httpbin-tests+ main-is: Spec.hs+ other-modules: Network.HTTP.Req.ConduitSpec+ hs-source-dirs: httpbin-tests+ type: exitcode-stdio-1.0+ build-depends: base >= 4.7 && < 5.0+ , bytestring >= 0.2 && < 0.11+ , conduit >= 0.5.5 && < 1.3+ , conduit-extra >= 1.1.10 && < 1.2+ , hspec >= 2.0 && < 3.0+ , req >= 0.1 && < 0.2+ , req-conduit >= 0.1.0+ , resourcet >= 1.1 && < 1.2+ , temporary >= 1.1 && < 1.3+ , transformers >= 0.4 && < 0.6+ if flag(dev)+ ghc-options: -Wall -Werror+ else+ ghc-options: -O2 -Wall+ default-language: Haskell2010++benchmark weigh-bench+ main-is: Main.hs+ hs-source-dirs: weigh-bench+ type: exitcode-stdio-1.0+ build-depends: base >= 4.7 && < 5.0+ , bytestring >= 0.2 && < 0.11+ , conduit >= 0.5.5 && < 1.3+ , conduit-extra >= 1.1.10 && < 1.2+ , req >= 0.1 && < 0.2+ , req-conduit >= 0.1.0+ , resourcet >= 1.1 && < 1.2+ , temporary >= 1.1 && < 1.3+ , weigh >= 0.0.3+ if flag(dev)+ ghc-options: -O2 -Wall -Werror+ else+ ghc-options: -O2 -Wall+ default-language: Haskell2010
+ weigh-bench/Main.hs view
@@ -0,0 +1,94 @@+--+-- Space-consumption benchmark for ‘req-conduit’.+--+-- Copyright © 2016 Mark Karpov <markkarpov@openmailbox.org>+--+-- Redistribution and use in source and binary forms, with or without+-- modification, are permitted provided that the following conditions are+-- met:+--+-- * Redistributions of source code must retain the above copyright notice,+-- this list of conditions and the following disclaimer.+--+-- * Redistributions in binary form must reproduce the above copyright+-- notice, this list of conditions and the following disclaimer in the+-- documentation and/or other materials provided with the distribution.+--+-- * Neither the name Mark Karpov nor the names of contributors may be used+-- to endorse or promote products derived from this software without+-- specific prior written permission.+--+-- THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS “AS IS” AND ANY+-- EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED+-- WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE+-- DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT HOLDERS BE LIABLE FOR ANY+-- DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL+-- DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS+-- OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION)+-- HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT,+-- STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN+-- ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE+-- POSSIBILITY OF SUCH DAMAGE.++{-# LANGUAGE DataKinds #-}+{-# LANGUAGE FlexibleInstances #-}+{-# LANGUAGE OverloadedStrings #-}+{-# OPTIONS_GHC -fno-warn-orphans #-}++module Main (main) where++import Control.Exception (throwIO)+import Control.Monad+import Control.Monad.IO.Class (MonadIO (..))+import Control.Monad.Trans.Resource (ResourceT)+import Data.Conduit ((=$=), runConduitRes, ConduitM)+import Data.Int (Int64)+import Network.HTTP.Req+import Network.HTTP.Req.Conduit+import System.IO.Temp+import Weigh+import qualified Data.ByteString as B+import qualified Data.Conduit.Binary as CB+import qualified Data.Conduit.List as CL++main :: IO ()+main = mainWith $ do+ io "streaming 5 M request body" bigRequest (5 * 1024 * 1024)+ io "streaming 25 M request body" bigRequest (25 * 1024 * 1024)+ io "streaming 50 M request body" bigRequest (50 * 1024 * 1024)+ io "streaming 100 M request body" bigRequest (100 * 1024 * 1024)+ io "streaming 5 M response body" bigResponse (5 * 1024 * 1024)+ io "streaming 25 M response body" bigResponse (25 * 1024 * 1024)+ io "streaming 50 M response body" bigResponse (50 * 1024 * 1024)+ io "streaming 100 M response body" bigResponse (100 * 1024 * 1024)++bigRequest :: Int64 -> IO ()+bigRequest size' = do+ let size = (size' `quot` 1024) * 1024+ chunk = B.replicate 1024 0+ let src = CL.replicate (fromIntegral size `quot` 1024) chunk+ void $ req POST (httpbin /: "post")+ (ReqBodySource size src) ignoreResponse mempty++bigResponse :: Int -> IO ()+bigResponse size = withSystemTempFile "req-conduit" $ \_ h ->+ runConduitRes $+ req' GET (httpbin /: "stream-bytes" /~ size) NoReqBody+ httpSource mempty =$= CB.sinkHandle h++----------------------------------------------------------------------------+-- Instances++instance MonadHttp IO where+ handleHttpException = throwIO++instance MonadHttp (ConduitM i o (ResourceT IO)) where+ handleHttpException = liftIO . throwIO++----------------------------------------------------------------------------+-- Helpers++-- | 'Url' representing <https://httpbin.org>.++httpbin :: Url 'Https+httpbin = https "httpbin.org"