hreq-conduit (empty) → 0.1.0.0
raw patch · 12 files changed
+577/−0 lines, 12 filesdep +aesondep +basedep +bytestringbuild-type:Customsetup-changed
Dependencies added: aeson, base, bytestring, conduit, doctest, exceptions, hreq-client, hreq-conduit, hreq-core, hspec, http-client, http-types, mtl, retry, string-conversions, text, unliftio-core
Files
- CHANGELOG.md +3/−0
- LICENSE.md +21/−0
- README.lhs +73/−0
- README.md +73/−0
- Setup.hs +33/−0
- hreq-conduit.cabal +114/−0
- src/Hreq/Conduit.hs +30/−0
- src/Hreq/Conduit/Internal/HTTP.hs +120/−0
- src/Hreq/Conduit/Internal/StreamBody.hs +48/−0
- test/DocTests.hs +14/−0
- test/Hreq/HttpBin/SuccessSpec.hs +47/−0
- test/Spec.hs +1/−0
+ CHANGELOG.md view
@@ -0,0 +1,3 @@+## Hreq-Conduit 0.1.0.0++* Initial public release
+ LICENSE.md view
@@ -0,0 +1,21 @@+MIT License++Copyright (c) 2019 Lukwago Allan++Permission is hereby granted, free of charge, to any person obtaining a copy+of this software and associated documentation files (the "Software"), to deal+in the Software without restriction, including without limitation the rights+to use, copy, modify, merge, publish, distribute, sublicense, and/or sell+copies of the Software, and to permit persons to whom the Software is+furnished to do so, subject to the following conditions:++The above copyright notice and this permission notice shall be included in all+copies or substantial portions of the Software.++THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR+IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY,+FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE+AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER+LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM,+OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE+SOFTWARE.
+ README.lhs view
@@ -0,0 +1,73 @@+# Hreq++[](https://hackage.haskell.org/package/hreq)+[](LICENSE)+[](https://travis-ci.org/epicallan/hreq)++Implementation of Hreq client as an HTTP Conduit streaming client basing on hreq-core.+More streaming backends can be added in the future depending on community interest.++Please look at the repository [README.md](https://github.com/epicallan/hreq/blob/master/README.md) file for more information.++## Streaming Example++```haskell+{-# LANGUAGE DataKinds #-}+{-# LANGUAGE FlexibleContexts #-}+{-# LANGUAGE OverloadedStrings #-}+{-# LANGUAGE RankNTypes #-}+{-# LANGUAGE TypeApplications #-}+{-# LANGUAGE TypeOperators #-}++import Conduit+import Data.Functor (void)+import qualified Data.Text as T++import Hreq.Conduit++main' :: IO ()+main' = void $ do+ runHttpBin streamResponse+ streamFile "README.md"++runHttpBin :: Hreq IO a -> IO a+runHttpBin action = runHreq baseUrl action+ where+ baseUrl = HttpsDomain "httpbin.org"++-- | Stream data from an endpoint and write it into a temporary file+streamResponse :: RunConduitClient m => m ()+streamResponse =+ hreqWithConduit+ @("stream-bytes" :> Capture Int :> StreamGet)+ (size :. Empty)+ $ \ src -> void $ runConduitRes $ src .| sinkSystemTempFile "hreq.json"+ where+ size = 3 * 1024 * 1024 -- amount of data to stream in MBs++-- | stream data from a file and send it as a Request body stream over the network.+streamFile :: String -> IO Response+streamFile fp =+ withSourceFile fp $+ \srcFile -> do+ let src :: ReqBodySource+ src = ReqBodySource+ $ srcFile+ .| decodeUtf8C+ .| mapC T.toUpper+ .| encodeUtf8C++ runHttpBin $ streamReq src+ where+ streamReq :: RunClient m => ReqBodySource -> m Response+ streamReq src = hreq @("post" :> ConduitReqBody :> RawResponse POST) (src :. Empty)+```++### Documentation++This README is tested by `markdown-unlit` to make sure the code builds. To keep _that_ happy, we do need a `main` in this file, so ignore the following :)++```haskell+main :: IO ()+main = pure ()+```
+ README.md view
@@ -0,0 +1,73 @@+# Hreq++[](https://hackage.haskell.org/package/hreq)+[](LICENSE)+[](https://travis-ci.org/epicallan/hreq)++Implementation of Hreq client as an HTTP Conduit streaming client basing on hreq-core.+More streaming backends can be added in the future depending on community interest.++Please look at the repository [README.md](https://github.com/epicallan/hreq/blob/master/README.md) file for more information.++## Streaming Example++```haskell+{-# LANGUAGE DataKinds #-}+{-# LANGUAGE FlexibleContexts #-}+{-# LANGUAGE OverloadedStrings #-}+{-# LANGUAGE RankNTypes #-}+{-# LANGUAGE TypeApplications #-}+{-# LANGUAGE TypeOperators #-}++import Conduit+import Data.Functor (void)+import qualified Data.Text as T++import Hreq.Conduit++main' :: IO ()+main' = void $ do+ runHttpBin streamResponse+ streamFile "README.md"++runHttpBin :: Hreq IO a -> IO a+runHttpBin action = runHreq baseUrl action+ where+ baseUrl = HttpsDomain "httpbin.org"++-- | Stream data from an endpoint and write it into a temporary file+streamResponse :: RunConduitClient m => m ()+streamResponse =+ hreqWithConduit+ @("stream-bytes" :> Capture Int :> StreamGet)+ (size :. Empty)+ $ \ src -> void $ runConduitRes $ src .| sinkSystemTempFile "hreq.json"+ where+ size = 3 * 1024 * 1024 -- amount of data to stream in MBs++-- | stream data from a file and send it as a Request body stream over the network.+streamFile :: String -> IO Response+streamFile fp =+ withSourceFile fp $+ \srcFile -> do+ let src :: ReqBodySource+ src = ReqBodySource+ $ srcFile+ .| decodeUtf8C+ .| mapC T.toUpper+ .| encodeUtf8C++ runHttpBin $ streamReq src+ where+ streamReq :: RunClient m => ReqBodySource -> m Response+ streamReq src = hreq @("post" :> ConduitReqBody :> RawResponse POST) (src :. Empty)+```++### Documentation++This README is tested by `markdown-unlit` to make sure the code builds. To keep _that_ happy, we do need a `main` in this file, so ignore the following :)++```haskell+main :: IO ()+main = pure ()+```
+ Setup.hs view
@@ -0,0 +1,33 @@+{-# LANGUAGE CPP #-}+{-# OPTIONS_GHC -Wall #-}+module Main (main) where++#ifndef MIN_VERSION_cabal_doctest+#define MIN_VERSION_cabal_doctest(x,y,z) 0+#endif++#if MIN_VERSION_cabal_doctest(1,0,0)++import Distribution.Extra.Doctest ( defaultMainWithDoctests )+main :: IO ()+main = defaultMainWithDoctests "doctests"++#else++#ifdef MIN_VERSION_Cabal+-- If the macro is defined, we have new cabal-install,+-- but for some reason we don't have cabal-doctest in package-db+--+-- Probably we are running cabal sdist, when otherwise using new-build+-- workflow+#warning You are configuring this package without cabal-doctest installed. \+ The doctests test-suite will not work as a result. \+ To fix this, install cabal-doctest before configuring.+#endif++import Distribution.Simple++main :: IO ()+main = defaultMain++#endif
+ hreq-conduit.cabal view
@@ -0,0 +1,114 @@+cabal-version: >= 2.0+name: hreq-conduit+version: 0.1.0.0+synopsis: Conduit streaming support for Hreq.+description: Conduit streaming support for Hreq an HTTP client library.+category: Network, Web, Conduit+homepage: https://github.com/epicallan/hreq/blob/master/hreq-conduit/README.md+bug-reports: https://github.com/epicallan/hreq.git/issues+author: Lukwago Allan <epicallan.al@gmail>+maintainer: Lukwago Allan <epicallan.al@gmail>+copyright: 2019 Lukwago Allan+license: MIT+license-file: LICENSE.md+extra-doc-files: CHANGELOG.md, README.md+tested-with:+ GHC ==8.2.2+ || ==8.4.4+ || ==8.6.5+ || ==8.8.1+build-type: Custom++custom-setup+ setup-depends:+ base >= 4 && <5,+ Cabal,+ cabal-doctest >= 1 && <1.1++source-repository head+ type: git+ location: https://github.com/epicallan/hreq.git++library+ exposed-modules:+ Hreq.Conduit+ , Hreq.Conduit.Internal.HTTP+ , Hreq.Conduit.Internal.StreamBody+++ default-extensions: LambdaCase DeriveGeneric FlexibleInstances FlexibleContexts ScopedTypeVariables TypeApplications TypeOperators MultiParamTypeClasses RecordWildCards TypeApplications TypeFamilies OverloadedStrings GADTs GeneralizedNewtypeDeriving FunctionalDependencies ConstraintKinds RankNTypes PolyKinds DataKinds KindSignatures ViewPatterns UndecidableInstances StrictData++ build-depends:+ base >= 4.10.1 && < 5,+ bytestring >= 0.10.8 && < 0.11,+ exceptions >= 0.10.0 && < 0.11,+ http-client >= 0.6.4 && < 0.7,+ http-types >= 0.12.3 && < 0.13,+ hreq-client >= 0.1.0,+ hreq-core >= 0.1.0,+ conduit >=1.3.1 && <1.4,+ mtl >= 2.2.2 && < 3.0,+ retry >= 0.8 && < 0.9,+ unliftio-core >= 0.1.2 && < 0.2.0++ ghc-options:+ -Wall+ -Wincomplete-uni-patterns+ -Wincomplete-record-updates+ -Wcompat+ -Widentities+ -Wredundant-constraints+ -fhide-source-paths+ -freverse-errors+ -Wpartial-fields++ hs-source-dirs: src+ default-language: Haskell2010++test-suite spec++ build-depends:+ base >= 4.10.1 && < 5+ , conduit >=1.3.1 && <1.4+ , http-types >= 0.12.3 && < 0.13+ , hspec >= 2.6.0 && < 2.8+ , hreq-conduit+ , string-conversions >= 0.4.0 && < 0.5+ , text >= 1.2.4 && < 1.3+ main-is: Spec.hs+ other-modules: Hreq.HttpBin.SuccessSpec+ hs-source-dirs: test+ type: exitcode-stdio-1.0+ ghc-options: -Wall -threaded+ default-language: Haskell2010+ default-extensions: LambdaCase DeriveGeneric FlexibleInstances FlexibleContexts ScopedTypeVariables TypeApplications TypeOperators MultiParamTypeClasses RecordWildCards TypeApplications TypeFamilies OverloadedStrings GADTs GeneralizedNewtypeDeriving FunctionalDependencies ConstraintKinds RankNTypes PolyKinds DataKinds KindSignatures ViewPatterns+ build-tool-depends:+ hspec-discover:hspec-discover >= 2.6.0 && <2.8++test-suite readme+ build-depends:+ base >= 4.10.1 && < 5+ , conduit >=1.3.1 && <1.4+ , bytestring >= 0.10.8 && < 0.11+ , hreq-conduit+ , string-conversions >= 0.4.0 && < 0.5+ , text >= 1.2.4 && < 1.3++ main-is: README.lhs+ type: exitcode-stdio-1.0+ ghc-options: -pgmL markdown-unlit -threaded+ build-tool-depends: markdown-unlit:markdown-unlit+ default-language: Haskell2010++test-suite doctests+ type: exitcode-stdio-1.0+ main-is: DocTests.hs+ build-depends:+ base >= 4.10.1 && < 5+ , aeson >= 1.4.5 && < 1.5+ , doctest >=0.15 && < 0.17+ , hreq-conduit++ ghc-options: -Wall -threaded+ hs-source-dirs: test+ default-language: Haskell2010
+ src/Hreq/Conduit.hs view
@@ -0,0 +1,30 @@+-- | Conduit streaming support for 'Hreq'+--+module Hreq.Conduit+ ( module Hreq.Conduit.Internal.HTTP+ , module Hreq.Conduit.Internal.StreamBody+ , module Hreq.Core.API+ , module Hreq.Core.Client+ , module Hreq.Client.Internal.Config+ ) where++import Hreq.Client.Internal.Config (HttpConfig (..), StatusRange (..), createDefConfig)+import Hreq.Conduit.Internal.HTTP (Hreq (..), ResBodyStream (..), RunClient, RunConduitClient,+ hreqWithConduit, runHreq, runHreqWithConfig)+import Hreq.Conduit.Internal.StreamBody+import Hreq.Core.API+import Hreq.Core.Client++-- import Hreq.Client.Internal.Config (HttpConfig (..), StatusRange (..), createDefConfig)+-- import Hreq.Client.Internal.HTTP (Hreq (..), RunClient (..), runHreq, runHreqWithConfig)++ -- ( Hreq (..)+ -- , ResBodyStream (..)+ -- , RunConduitClient+ -- -- * Run Hreq client+ -- , runHreq+ -- , runHreqWithConfig+ -- , createDefConfig+ -- -- * creates Hreq Client+ -- , hreq+ -- , hreqWithConduit
+ src/Hreq/Conduit/Internal/HTTP.hs view
@@ -0,0 +1,120 @@+-- | This module provides functionality for running the 'Hreq' monad as a Streaming HTTP client and necessary+-- class instances.+--+{-# LANGUAGE AllowAmbiguousTypes #-}+module Hreq.Conduit.Internal.HTTP+ ( Hreq (..)+ , ResBodyStream (..)+ , RunConduitClient+ , RunClient+ -- * Run Hreq client+ , runHreq+ , runHreqWithConfig+ , createDefConfig+ -- * Create Streaming Hreq Client+ , hreqWithConduit+ ) where+import Control.Monad (unless)+import Control.Monad.Catch (throwM)+import Control.Monad.IO.Class (MonadIO (..))+import Control.Monad.IO.Unlift (MonadUnliftIO (..), wrappedWithRunInIO)+import Control.Monad.Reader (MonadReader, MonadTrans, ReaderT (..), ask)+import Control.Retry (retrying)+import Data.ByteString (ByteString)+import qualified Data.ByteString as B+import qualified Data.ByteString.Lazy as LBS+import Data.Conduit+import Data.Either (isLeft)+import Data.Proxy (Proxy (..))+import qualified Network.HTTP.Client as HTTP+import Network.HTTP.Types (statusCode)++import Hreq.Client.Internal.Config (HttpConfig (..), StatusRange (..), createDefConfig)+import Hreq.Client.Internal.HTTP (catchConnectionError, checkHttpResponse, httpResponsetoResponse,+ requestToHTTPRequest, runHttpClient)+import Hreq.Core.Client (BaseUrl (..), ClientError (..), HasRequest (..), HasStreamingClient,+ Request, RunClient (..), RunStreamingClient (..), hreqStream)+++newtype Hreq m a = Hreq { runHreq' :: ReaderT HttpConfig m a }+ deriving (Functor, Applicative, Monad, MonadReader HttpConfig, MonadTrans, MonadIO)++type StreamConduit = forall m. MonadIO m => ConduitT () ByteString m ()++newtype ResBodyStream = ResBodyStream StreamConduit++type RunConduitClient m = RunStreamingClient m ResBodyStream++instance MonadUnliftIO m => MonadUnliftIO (Hreq m) where+ withRunInIO = wrappedWithRunInIO Hreq runHreq'++instance RunClient (Hreq IO) where+ runClient = runHttpClient++ throwHttpError = Hreq . throwM++ checkResponse = checkHttpResponse++instance RunStreamingClient (Hreq IO) ResBodyStream where+ withStreamingClient = runStreamingHttp++runHreq :: MonadIO m => BaseUrl -> Hreq m a -> m a+runHreq baseUrl action = do+ config <- liftIO $ createDefConfig baseUrl++ runHreqWithConfig config action++runHreqWithConfig :: HttpConfig -> Hreq m a -> m a+runHreqWithConfig config action = runReaderT (runHreq' action) config++runStreamingHttp+ :: forall m r. (MonadReader HttpConfig m, MonadIO m, RunClient m)+ => Request+ -> (ResBodyStream -> IO r)+ -> m r+runStreamingHttp req f = do+ config <- ask+ let manager = httpManager config+ let baseUrl = httpBaseUrl config+ let statusRange = httpStatuses config++ let httpRequest = requestToHTTPRequest baseUrl req++ let action = liftIO $ catchConnectionError $ HTTP.withResponse httpRequest manager $ \res -> do+ checkStreamResponse res statusRange+ f (ResBodyStream $ bodyReaderSource (HTTP.responseBody res))++ eRes <- retrying (httpRetryPolicy config) (const (return . isLeft)) (const action)+ either throwHttpError pure eRes+ where+ -- | Throws a failure error on in-correct HTTP status code.+ checkStreamResponse :: HTTP.Response HTTP.BodyReader -> StatusRange -> IO ()+ checkStreamResponse res statusRange = do+ let status = HTTP.responseStatus res+ code = statusCode status+ if code >= statusLower statusRange && code <= statusUpper statusRange+ then do+ bs <- LBS.fromChunks <$> HTTP.brConsume (HTTP.responseBody res)+ throwM $ FailureResponse req (httpResponsetoResponse (const bs) res)+ else pure ()++-- | Streaming HTTP response with Conduit.+--+-- The required constraints are represented by the 'Hreq.Core.Client.Internal.HasStreamingClient' constraint.+--+hreqWithConduit+ :: forall api ts v m. (HasStreamingClient api ResBodyStream ts v m )+ => HttpInput ts+ -> (StreamConduit -> IO ())+ -> m ()+hreqWithConduit input f =+ hreqStream (Proxy @api) input $ \ (ResBodyStream conduit) -> f conduit++bodyReaderSource :: MonadIO m => HTTP.BodyReader -> ConduitT i ByteString m ()+bodyReaderSource br = go+ where+ go = do+ bs <- liftIO (HTTP.brRead br)+ unless (B.null bs) $ do+ yield bs+ go
+ src/Hreq/Conduit/Internal/StreamBody.hs view
@@ -0,0 +1,48 @@+-- | This module provides functionality for working with a streaming request body.+--+module Hreq.Conduit.Internal.StreamBody where++import Data.ByteString+import qualified Data.ByteString as B+import Data.Conduit (ConduitT, await, ($$+), ($$++))+import Data.IORef+import Hreq.Core.API+import qualified Network.HTTP.Client as HTTP++-- | The conduit type representing a streaming request body.+type BodyConduit = ConduitT () ByteString IO ()++-- | The Request body Stream is treated as a chucked body stream 'HTTP.RequestBodyStreamChunked'.+-- Ensure your server supports chucked body stream.+newtype ReqBodySource = ReqBodySource BodyConduit++-- | For use in API endpoint type definition+-- >>> type ExampleQuery = "post" :> ConduitReqBody :> RawResponse POST+--+type ConduitReqBody = StreamBody OctetStream ReqBodySource++instance HasStreamBody ReqBodySource where+ givePopper (ReqBodySource src)= GivesPooper $ srcToPopperIO src++-- * Helpers++-- | This is taken from "Network.HTTP.Client.Conduit" without modifications.+srcToPopperIO :: BodyConduit -> HTTP.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++-- $setup+-- >>> import Hreq.Core.API+-- >>> import Hreq.Conduit.Internal.StreamBody
+ test/DocTests.hs view
@@ -0,0 +1,14 @@+module Main where++import Build_doctests (flags, module_sources, pkgs)+import Data.Foldable (traverse_)+import System.Environment (unsetEnv)+import Test.DocTest (doctest)++main :: IO ()+main = do+ traverse_ putStrLn args -- optionally print arguments+ unsetEnv "GHC_ENVIRONMENT" -- see 'Notes'; you may not need this+ doctest args+ where+ args = flags ++ pkgs ++ module_sources
+ test/Hreq/HttpBin/SuccessSpec.hs view
@@ -0,0 +1,47 @@+module Hreq.HttpBin.SuccessSpec (spec) where++import Conduit+import Data.String.Conversions (cs)+import qualified Data.Text as T+import Hreq.Conduit+import Test.Hspec++spec :: Spec+spec = describe "Hreq.HttpBin.SuccessSpec" successSpec++runHttpBin :: Hreq IO a -> IO a+runHttpBin action = runHreq baseUrl action+ where+ baseUrl = HttpsDomain "httpbin.org"++successSpec :: Spec+successSpec = do+ describe "Streaming" $ do+ describe "works with responses" $ do+ it "receiving a stream of data" $ do+ let size = 3 * 1024 * 1024 -- amount of data to stream in MBs+ let streamBytes = hreqWithConduit @("stream-bytes" :> Capture Int :> StreamGet) (size :. Empty)++ runHttpBin+ $ streamBytes+ $ \ src -> do+ tempFile <- runConduitRes $ src .| sinkSystemTempFile "hreq.json"+ tempFile `shouldContain` "hreq"+++ describe "works with request bodies" $ do+ it "streaming a file " $ do+ let streamReq src = hreq @("post" :> ConduitReqBody :> RawResponse POST) $ src :. Empty++ withSourceFile "README.md" $+ \srcFile -> do+ let src :: ReqBodySource+ src = ReqBodySource+ $ srcFile+ .| decodeUtf8C+ .| mapC T.toUpper+ .| encodeUtf8C++ res <- runHttpBin $ streamReq src++ cs (resBody res) `shouldContain` "HREQ"
+ test/Spec.hs view
@@ -0,0 +1,1 @@+{-# OPTIONS_GHC -F -pgmF hspec-discover #-}