on master help sign in
.github/dependabot.ymlnew file+6
since splitsnapshots
unifiedsplit
@@ -0,0 +1,6 @@
1+version: 2
2+updates:
3+ - package-ecosystem: "github-actions"
4+ directory: "/"
5+ schedule:
6+ interval: "weekly"
.github/workflows/ci.yaml+16−15
@@ -11,27 +11,25 @@ jobs:
11 ormolu:
11 ormolu:
12 runs-on: ubuntu-latest
12 runs-on: ubuntu-latest
13 steps:
13 steps:
14− - uses: actions/checkout@v2.3.4
14+ - uses: actions/checkout@v4
15− - uses: mrkkrp/ormolu-action@v2
15+ - uses: haskell-actions/run-ormolu@v17
16 build:
16 build:
17 runs-on: ubuntu-latest
17 runs-on: ubuntu-latest
18 needs: ormolu
18 needs: ormolu
19 strategy:
19 strategy:
20 matrix:
20 matrix:
21− cabal: ["3.4"]
21+ cabal: ["3.12"]
22− ghc: ["8.8.4", "8.10.5", "9.0.1"]
22+ ghc: ["9.6.3", "9.8.2", "9.10.1"]
23− env:
24− CONFIG: "--enable-tests --enable-benchmarks --flags=dev"
25 steps:
23 steps:
26− - uses: actions/checkout@v2.3.4
24+ - uses: actions/checkout@v4
27− - uses: haskell/actions/setup@v1.2
25+ - uses: haskell-actions/setup@v2
28 id: setup-haskell-cabal
26 id: setup-haskell-cabal
29 with:
27 with:
30 ghc-version: ${{ matrix.ghc }}
28 ghc-version: ${{ matrix.ghc }}
31 cabal-version: ${{ matrix.cabal }}
29 cabal-version: ${{ matrix.cabal }}
32− - run: cabal v2-update
30+ - run: cabal update
33− - run: cabal v2-freeze $CONFIG
31+ - run: cabal freeze
34− - uses: actions/cache@v2.1.3
32+ - uses: actions/cache@v4.2.3
35 with:
33 with:
36 path: |
34 path: |
37 ${{ steps.setup-haskell-cabal.outputs.cabal-store }}
35 ${{ steps.setup-haskell-cabal.outputs.cabal-store }}
@@ -40,7 +38,10 @@ jobs:
40 restore-keys: |
38 restore-keys: |
41 ${{ runner.os }}-${{ matrix.ghc }}-
39 ${{ runner.os }}-${{ matrix.ghc }}-
42 - run: cabal format && git diff --exit-code --color=always
40 - run: cabal format && git diff --exit-code --color=always
43− - run: cabal v2-build $CONFIG
41+ - run: cabal build
44− - run: cabal v2-test $CONFIG
42+ - run: |
43+ docker pull kennethreitz/httpbin
44+ docker run -p 1234:80 kennethreitz/httpbin &
45+ cabal test
45− - run: cabal v2-haddock $CONFIG
46+ - run: cabal haddock
46− - run: cabal v2-sdist
47+ - run: cabal sdist
.gitignore+1
@@ -25,5 +25,6 @@ cabal.project.local
25cabal.sandbox.config
25cabal.sandbox.config
26dist-*/
26dist-*/
27dist/
27dist/
28+hie.yaml
28stack.yaml
29stack.yaml
29stack.yaml.lock
30stack.yaml.lock
CHANGELOG.md+47
@@ -1,3 +1,50 @@
1+## Req 3.13.4
2+
3+* Fixed empty ciphersuite list when compiling against `tls < 2.0.6`
4+ (see [PR 175](https://github.com/mrkkrp/req/pull/175)). As a side effect, now
5+ compatible with older versions of `crypton-connection` (>= 0.3).
6+
7+## Req 3.13.3
8+
9+* Works with `crypton-connection-0.4` and newer.
10+
11+## Req 3.13.2
12+
13+* Disable the problematic `httpbin-tests` test suite by default. Only enable
14+ it when the `dev` flag is enabled. In that case it is expected that an
15+ httpbin server is run locally at `localhost:1234`.
16+
17+## Req 3.13.1
18+
19+* Switched the non-pure test suite to use https://httpbun.org instead of
20+ https://httpbin.org since the latter proved to be highly unreliable
21+ lately.
22+
23+* Switched from `connection` to `crypton-connection`.
24+
25+* Builds with GHC 9.6.1.
26+
27+## Req 3.13.0
28+
29+* Add `headerRedacted` function to add header fields, which will be with
30+ redacted values on print.
31+
32+## Req 3.12.0
33+
34+* Add `isStatusCodeException` function.
35+* Add `instance HttpResponse (Network.HTTP.Client.Response ())`.
36+
37+## Req 3.11.0
38+
39+* Add the `queryParamToList` method to the `QueryParam` type class.
40+* Add the `formToQuery` function. [Issue 126](https://github.com/mrkkrp/req/issues/126).
41+* Add `FromForm` instances (in the `Web.FormUrlEncoded` module) to the
42+ `Option` and `FormUrlEncodedParam` types.
43+
44+## Req 3.10.0
45+
46+* Add `MonadHttp` instances for `transformers` types.
47+
1## Req 3.9.2
48## Req 3.9.2
2
49
3* The test suite works with `aeson-2.x.x.x`.
50* The test suite works with `aeson-2.x.x.x`.
Network/HTTP/Req.hs+216−67
@@ -1,20 +1,9 @@
1−{-# LANGUAGE BangPatterns #-}
2−{-# LANGUAGE CPP #-}
3{-# LANGUAGE DataKinds #-}
1{-# LANGUAGE DataKinds #-}
4−{-# LANGUAGE DeriveDataTypeable #-}
5−{-# LANGUAGE DeriveGeneric #-}
6−{-# LANGUAGE DeriveLift #-}
7−{-# LANGUAGE FlexibleInstances #-}
8−{-# LANGUAGE GeneralizedNewtypeDeriving #-}
9{-# LANGUAGE LambdaCase #-}
2{-# LANGUAGE LambdaCase #-}
10−{-# LANGUAGE MultiParamTypeClasses #-}
11{-# LANGUAGE OverloadedStrings #-}
3{-# LANGUAGE OverloadedStrings #-}
12{-# LANGUAGE QuasiQuotes #-}
4{-# LANGUAGE QuasiQuotes #-}
13−{-# LANGUAGE RankNTypes #-}
14{-# LANGUAGE RecordWildCards #-}
5{-# LANGUAGE RecordWildCards #-}
15{-# LANGUAGE RoleAnnotations #-}
6{-# LANGUAGE RoleAnnotations #-}
16−{-# LANGUAGE ScopedTypeVariables #-}
17−{-# LANGUAGE StandaloneDeriving #-}
18{-# LANGUAGE TemplateHaskellQuotes #-}
7{-# LANGUAGE TemplateHaskellQuotes #-}
19{-# LANGUAGE TypeFamilies #-}
8{-# LANGUAGE TypeFamilies #-}
20{-# LANGUAGE UndecidableInstances #-}
9{-# LANGUAGE UndecidableInstances #-}
@@ -155,11 +144,13 @@ module Network.HTTP.Req
155 -- $query-parameters
144 -- $query-parameters
156 (=:),
145 (=:),
157 queryFlag,
146 queryFlag,
147+ formToQuery,
158 QueryParam (..),
148 QueryParam (..),
159
149
160 -- *** Headers
150 -- *** Headers
161 header,
151 header,
162 attachHeader,
152 attachHeader,
153+ headerRedacted,
163
154
164 -- *** Cookies
155 -- *** Cookies
165 -- $cookies
156 -- $cookies
@@ -206,58 +197,78 @@ module Network.HTTP.Req
206
197
207 -- * Other
198 -- * Other
208 HttpException (..),
199 HttpException (..),
200+ isStatusCodeException,
209 CanHaveBody (..),
201 CanHaveBody (..),
210 Scheme (..),
202 Scheme (..),
211 )
203 )
212where
204where
213
205
214−import qualified Blaze.ByteString.Builder as BB
206+import Blaze.ByteString.Builder qualified as BB
215import Control.Applicative
207import Control.Applicative
216import Control.Arrow (first, second)
208import Control.Arrow (first, second)
217import Control.Exception hiding (Handler (..), TypeError)
209import Control.Exception hiding (Handler (..), TypeError)
210+import Control.Monad (guard, void, (>=>))
218import Control.Monad.Base
211import Control.Monad.Base
219import Control.Monad.Catch (Handler (..), MonadCatch, MonadMask, MonadThrow)
212import Control.Monad.Catch (Handler (..), MonadCatch, MonadMask, MonadThrow)
220import Control.Monad.IO.Class
213import Control.Monad.IO.Class
221import Control.Monad.IO.Unlift
214import Control.Monad.IO.Unlift
222−import Control.Monad.Reader
215+import Control.Monad.Reader (ReaderT (ReaderT), ask, lift, runReaderT)
216+import Control.Monad.Trans.Accum (AccumT)
217+import Control.Monad.Trans.Cont (ContT)
223import Control.Monad.Trans.Control
218import Control.Monad.Trans.Control
219+import Control.Monad.Trans.Except (ExceptT)
220+import Control.Monad.Trans.Identity (IdentityT)
221+import Control.Monad.Trans.Maybe (MaybeT)
222+import Control.Monad.Trans.RWS.CPS qualified as RWS.CPS
223+import Control.Monad.Trans.RWS.Lazy qualified as RWS.Lazy
224+import Control.Monad.Trans.RWS.Strict qualified as RWS.Strict
225+import Control.Monad.Trans.Select (SelectT)
226+import Control.Monad.Trans.State.Lazy qualified as State.Lazy
227+import Control.Monad.Trans.State.Strict qualified as State.Strict
228+import Control.Monad.Trans.Writer.CPS qualified as Writer.CPS
229+import Control.Monad.Trans.Writer.Lazy qualified as Writer.Lazy
230+import Control.Monad.Trans.Writer.Strict qualified as Writer.Strict
224import Control.Retry
231import Control.Retry
225import Data.Aeson (FromJSON (..), ToJSON (..))
232import Data.Aeson (FromJSON (..), ToJSON (..))
226−import qualified Data.Aeson as A
233+import Data.Aeson qualified as A
227import Data.ByteString (ByteString)
234import Data.ByteString (ByteString)
228−import qualified Data.ByteString as B
235+import Data.ByteString qualified as B
229−import qualified Data.ByteString.Lazy as BL
236+import Data.ByteString.Lazy qualified as BL
230−import qualified Data.CaseInsensitive as CI
237+import Data.CaseInsensitive qualified as CI
231import Data.Data (Data)
238import Data.Data (Data)
239+import Data.Default.Class (def)
232import Data.Function (on)
240import Data.Function (on)
233import Data.IORef
241import Data.IORef
234import Data.Kind (Constraint, Type)
242import Data.Kind (Constraint, Type)
235import Data.List (foldl', nubBy)
243import Data.List (foldl', nubBy)
236import Data.List.NonEmpty (NonEmpty (..))
244import Data.List.NonEmpty (NonEmpty (..))
237−import qualified Data.List.NonEmpty as NE
245+import Data.List.NonEmpty qualified as NE
238import Data.Maybe (fromMaybe)
246import Data.Maybe (fromMaybe)
239import Data.Proxy
247import Data.Proxy
240−import Data.Semigroup hiding (Option, option)
248+import Data.Semigroup (Endo (..))
249+import Data.Set qualified as S
241import Data.Text (Text)
250import Data.Text (Text)
242−import qualified Data.Text as T
251+import Data.Text qualified as T
243−import qualified Data.Text.Encoding as T
252+import Data.Text.Encoding qualified as T
244import Data.Typeable (Typeable, cast)
253import Data.Typeable (Typeable, cast)
245import GHC.Generics
254import GHC.Generics
246import GHC.TypeLits
255import GHC.TypeLits
247−import qualified Language.Haskell.TH as TH
256+import Language.Haskell.TH qualified as TH
248−import qualified Language.Haskell.TH.Quote as TH
257+import Language.Haskell.TH.Quote qualified as TH
249−import qualified Language.Haskell.TH.Syntax as TH
258+import Language.Haskell.TH.Syntax qualified as TH
250−import qualified Network.Connection as NC
259+import Network.Connection qualified as NC
251−import qualified Network.HTTP.Client as L
260+import Network.HTTP.Client qualified as L
252−import qualified Network.HTTP.Client.Internal as LI
261+import Network.HTTP.Client.Internal qualified as LI
253−import qualified Network.HTTP.Client.MultipartFormData as LM
262+import Network.HTTP.Client.MultipartFormData qualified as LM
254−import qualified Network.HTTP.Client.TLS as L
263+import Network.HTTP.Client.TLS qualified as L
255−import qualified Network.HTTP.Types as Y
264+import Network.HTTP.Types qualified as Y
256import System.IO.Unsafe (unsafePerformIO)
265import System.IO.Unsafe (unsafePerformIO)
257import Text.URI (URI)
266import Text.URI (URI)
258−import qualified Text.URI as URI
267+import Text.URI qualified as URI
259−import qualified Text.URI.QQ as QQ
268+import Text.URI.QQ qualified as QQ
260−import qualified Web.Authenticate.OAuth as OAuth
269+import Web.Authenticate.OAuth qualified as OAuth
270+import Web.FormUrlEncoded (FromForm (..), ToForm (..))
271+import Web.FormUrlEncoded qualified as Form
261import Web.HttpApiData (ToHttpApiData (..))
272import Web.HttpApiData (ToHttpApiData (..))
262
273
263----------------------------------------------------------------------------
274----------------------------------------------------------------------------
@@ -478,7 +489,7 @@ reqCb method url body responseProxy options adjustRequest =
478--
489--
479-- @since 3.7.0
490-- @since 3.7.0
480reqHandler ::
491reqHandler ::
481− MonadHttp m =>
492+ (MonadHttp m) =>
482 -- | How to get final result from a 'L.Response'
493 -- | How to get final result from a 'L.Response'
483 (L.Response L.BodyReader -> IO b) ->
494 (L.Response L.BodyReader -> IO b) ->
484 -- | 'L.Request' to perform
495 -- | 'L.Request' to perform
@@ -574,10 +585,10 @@ req' method url body options m = do
574 withReqManager (m request)
585 withReqManager (m request)
575
586
576-- | Perform an action using the global implicit 'L.Manager' that the rest
587-- | Perform an action using the global implicit 'L.Manager' that the rest
577−-- of the library uses. This allows to reuse connections that the
588+-- of the library uses. This allows us to reuse connections that the
578-- 'L.Manager' controls.
589-- 'L.Manager' controls.
579−withReqManager :: MonadIO m => (L.Manager -> m a) -> m a
590+withReqManager :: (MonadIO m) => (L.Manager -> m a) -> m a
580−withReqManager m = liftIO (readIORef globalManager) >>= m
591+withReqManager m = m globalManager
581
592
582-- | The global 'L.Manager' that 'req' uses. Here we just go with the
593-- | The global 'L.Manager' that 'req' uses. Here we just go with the
583-- default settings, so users don't need to deal with this manager stuff at
594-- default settings, so users don't need to deal with this manager stuff at
@@ -590,16 +601,16 @@ withReqManager m = liftIO (readIORef globalManager) >>= m
590-- manager. From that moment on the 'IORef' will be just reused—exactly the
601-- manager. From that moment on the 'IORef' will be just reused—exactly the
591-- behavior we want here in order to maximize connection sharing. GHC could
602-- behavior we want here in order to maximize connection sharing. GHC could
592-- spoil the plan by inlining the definition, hence the @NOINLINE@ pragma.
603-- spoil the plan by inlining the definition, hence the @NOINLINE@ pragma.
593−globalManager :: IORef L.Manager
604+globalManager :: L.Manager
594globalManager = unsafePerformIO $ do
605globalManager = unsafePerformIO $ do
595 context <- NC.initConnectionContext
606 context <- NC.initConnectionContext
596 let settings =
607 let settings =
597 L.mkManagerSettingsContext
608 L.mkManagerSettingsContext
598 (Just context)
609 (Just context)
599− (NC.TLSSettingsSimple False False False)
610+ def
600 Nothing
611 Nothing
601 manager <- L.newManager settings
612 manager <- L.newManager settings
602− newIORef manager
613+ return manager
603{-# NOINLINE globalManager #-}
614{-# NOINLINE globalManager #-}
604
615
605----------------------------------------------------------------------------
616----------------------------------------------------------------------------
@@ -619,7 +630,7 @@ globalManager = unsafePerformIO $ do
619-- | A type class for monads that support performing HTTP requests.
630-- | A type class for monads that support performing HTTP requests.
620-- Typically, you only need to define the 'handleHttpException' method
631-- Typically, you only need to define the 'handleHttpException' method
621-- unless you want to tweak 'HttpConfig'.
632-- unless you want to tweak 'HttpConfig'.
622−class MonadIO m => MonadHttp m where
633+class (MonadIO m) => MonadHttp m where
623 -- | This method describes how to deal with 'HttpException' that was
634 -- | This method describes how to deal with 'HttpException' that was
624 -- caught by the library. One option is to re-throw it if you are OK with
635 -- caught by the library. One option is to re-throw it if you are OK with
625 -- exceptions, but if you prefer working with something like
636 -- exceptions, but if you prefer working with something like
@@ -703,9 +714,8 @@ data HttpConfig = HttpConfig
703 -- | Max length of preview fragment of response body.
714 -- | Max length of preview fragment of response body.
704 --
715 --
705 -- @since 3.6.0
716 -- @since 3.6.0
706− httpConfigBodyPreviewLength :: forall a. Num a => a
717+ httpConfigBodyPreviewLength :: forall a. (Num a) => a
707 }
718 }
708− deriving (Typeable)
709
719
710-- | The default value of 'HttpConfig'.
720-- | The default value of 'HttpConfig'.
711--
721--
@@ -787,12 +797,87 @@ instance MonadHttp Req where
787 handleHttpException = Req . lift . throwIO
797 handleHttpException = Req . lift . throwIO
788 getHttpConfig = Req ask
798 getHttpConfig = Req ask
789
799
800+-- | @since 3.10.0
801+instance (MonadHttp m, Monoid w) => MonadHttp (AccumT w m) where
802+ handleHttpException = lift . handleHttpException
803+ getHttpConfig = lift getHttpConfig
804+
805+-- | @since 3.10.0
806+instance (MonadHttp m) => MonadHttp (ContT r m) where
807+ handleHttpException = lift . handleHttpException
808+ getHttpConfig = lift getHttpConfig
809+
810+-- | @since 3.10.0
811+instance (MonadHttp m) => MonadHttp (ExceptT e m) where
812+ handleHttpException = lift . handleHttpException
813+ getHttpConfig = lift getHttpConfig
814+
815+-- | @since 3.10.0
816+instance (MonadHttp m) => MonadHttp (IdentityT m) where
817+ handleHttpException = lift . handleHttpException
818+ getHttpConfig = lift getHttpConfig
819+
820+-- | @since 3.10.0
821+instance (MonadHttp m) => MonadHttp (MaybeT m) where
822+ handleHttpException = lift . handleHttpException
823+ getHttpConfig = lift getHttpConfig
824+
825+-- | @since 3.10.0
826+instance (MonadHttp m) => MonadHttp (ReaderT r m) where
827+ handleHttpException = lift . handleHttpException
828+ getHttpConfig = lift getHttpConfig
829+
830+-- | @since 3.10.0
831+instance (MonadHttp m, Monoid w) => MonadHttp (RWS.CPS.RWST r w s m) where
832+ handleHttpException = lift . handleHttpException
833+ getHttpConfig = lift getHttpConfig
834+
835+-- | @since 3.10.0
836+instance (MonadHttp m, Monoid w) => MonadHttp (RWS.Lazy.RWST r w s m) where
837+ handleHttpException = lift . handleHttpException
838+ getHttpConfig = lift getHttpConfig
839+
840+-- | @since 3.10.0
841+instance (MonadHttp m, Monoid w) => MonadHttp (RWS.Strict.RWST r w s m) where
842+ handleHttpException = lift . handleHttpException
843+ getHttpConfig = lift getHttpConfig
844+
845+-- | @since 3.10.0
846+instance (MonadHttp m) => MonadHttp (SelectT r m) where
847+ handleHttpException = lift . handleHttpException
848+ getHttpConfig = lift getHttpConfig
849+
850+-- | @since 3.10.0
851+instance (MonadHttp m) => MonadHttp (State.Lazy.StateT s m) where
852+ handleHttpException = lift . handleHttpException
853+ getHttpConfig = lift getHttpConfig
854+
855+-- | @since 3.10.0
856+instance (MonadHttp m) => MonadHttp (State.Strict.StateT s m) where
857+ handleHttpException = lift . handleHttpException
858+ getHttpConfig = lift getHttpConfig
859+
860+-- | @since 3.10.0
861+instance (MonadHttp m, Monoid w) => MonadHttp (Writer.CPS.WriterT w m) where
862+ handleHttpException = lift . handleHttpException
863+ getHttpConfig = lift getHttpConfig
864+
865+-- | @since 3.10.0
866+instance (MonadHttp m, Monoid w) => MonadHttp (Writer.Lazy.WriterT w m) where
867+ handleHttpException = lift . handleHttpException
868+ getHttpConfig = lift getHttpConfig
869+
870+-- | @since 3.10.0
871+instance (MonadHttp m, Monoid w) => MonadHttp (Writer.Strict.WriterT w m) where
872+ handleHttpException = lift . handleHttpException
873+ getHttpConfig = lift getHttpConfig
874+
790-- | Run a computation in the 'Req' monad with the given 'HttpConfig'. In
875-- | Run a computation in the 'Req' monad with the given 'HttpConfig'. In
791-- the case of an exceptional situation an 'HttpException' will be thrown.
876-- the case of an exceptional situation an 'HttpException' will be thrown.
792--
877--
793-- @since 0.4.0
878-- @since 0.4.0
794runReq ::
879runReq ::
795− MonadIO m =>
880+ (MonadIO m) =>
796 -- | 'HttpConfig' to use
881 -- | 'HttpConfig' to use
797 HttpConfig ->
882 HttpConfig ->
798 -- | Computation to run
883 -- | Computation to run
@@ -897,7 +982,7 @@ class HttpMethod a where
897 -- | Return name of the method as a 'ByteString'.
982 -- | Return name of the method as a 'ByteString'.
898 httpMethodName :: Proxy a -> ByteString
983 httpMethodName :: Proxy a -> ByteString
899
984
900−instance HttpMethod method => RequestComponent (Tagged "method" method) where
985+instance (HttpMethod method) => RequestComponent (Tagged "method" method) where
901 getRequestMod _ = Endo $ \x ->
986 getRequestMod _ = Endo $ \x ->
902 x {L.method = httpMethodName (Proxy :: Proxy method)}
987 x {L.method = httpMethodName (Proxy :: Proxy method)}
903
988
@@ -939,25 +1024,20 @@ instance HttpMethod method => RequestComponent (Tagged "method" method) where
939-- > -- https://%D1%8E%D0%BD%D0%B8%D0%BA%D0%BE%D0%B4.%D1%80%D1%84
1024-- > -- https://%D1%8E%D0%BD%D0%B8%D0%BA%D0%BE%D0%B4.%D1%80%D1%84
940data Url (scheme :: Scheme) = Url Scheme (NonEmpty Text)
1025data Url (scheme :: Scheme) = Url Scheme (NonEmpty Text)
941 -- NOTE The second value is the path segments in reversed order.
1026 -- NOTE The second value is the path segments in reversed order.
942− deriving (Eq, Ord, Show, Data, Typeable, Generic)
1027+ deriving (Eq, Ord, Show, Data, Generic)
943
1028
944type role Url nominal
1029type role Url nominal
945
1030
946-- With template-haskell >=2.15 and text >=1.2.4 Lift can be derived, however
1031-- With template-haskell >=2.15 and text >=1.2.4 Lift can be derived, however
947-- the derived lift forgets the type of the scheme.
1032-- the derived lift forgets the type of the scheme.
948−instance Typeable scheme => TH.Lift (Url scheme) where
1033+instance (Typeable scheme) => TH.Lift (Url scheme) where
949 lift url =
1034 lift url =
950 TH.dataToExpQ (fmap liftText . cast) url `TH.sigE` case url of
1035 TH.dataToExpQ (fmap liftText . cast) url `TH.sigE` case url of
951 Url Http _ -> [t|Url 'Http|]
1036 Url Http _ -> [t|Url 'Http|]
952 Url Https _ -> [t|Url 'Https|]
1037 Url Https _ -> [t|Url 'Https|]
953 where
1038 where
954 liftText t = TH.AppE (TH.VarE 'T.pack) <$> TH.lift (T.unpack t)
1039 liftText t = TH.AppE (TH.VarE 'T.pack) <$> TH.lift (T.unpack t)
955−
956−#if MIN_VERSION_template_haskell(2,17,0)
957 liftTyped = TH.Code . TH.unsafeTExpCoerce . TH.lift
1040 liftTyped = TH.Code . TH.unsafeTExpCoerce . TH.lift
958−#elif MIN_VERSION_template_haskell(2,16,0)
959− liftTyped = TH.unsafeTExpCoerce . TH.lift
960−#endif
961
1041
962-- | Given host name, produce a 'Url' which has “http” as its scheme and
1042-- | Given host name, produce a 'Url' which has “http” as its scheme and
963-- empty path. This also sets port to @80@.
1043-- empty path. This also sets port to @80@.
@@ -973,7 +1053,7 @@ https = Url Https . pure
973-- path segment can be of any type that is an instance of 'ToHttpApiData'.
1053-- path segment can be of any type that is an instance of 'ToHttpApiData'.
974infixl 5 /~
1054infixl 5 /~
975
1055
976−(/~) :: ToHttpApiData a => Url scheme -> a -> Url scheme
1056+(/~) :: (ToHttpApiData a) => Url scheme -> a -> Url scheme
977Url secure path /~ segment = Url secure (NE.cons (toUrlPiece segment) path)
1057Url secure path /~ segment = Url secure (NE.cons (toUrlPiece segment) path)
978
1058
979-- | A type-constrained version of @('/~')@ to remove ambiguity in the cases
1059-- | A type-constrained version of @('/~')@ to remove ambiguity in the cases
@@ -1161,7 +1241,7 @@ instance HttpBody NoReqBody where
1161-- charset=utf-8\"@ value.
1241-- charset=utf-8\"@ value.
1162newtype ReqBodyJson a = ReqBodyJson a
1242newtype ReqBodyJson a = ReqBodyJson a
1163
1243
1164−instance ToJSON a => HttpBody (ReqBodyJson a) where
1244+instance (ToJSON a) => HttpBody (ReqBodyJson a) where
1165 getRequestBody (ReqBodyJson a) = L.RequestBodyLBS (A.encode a)
1245 getRequestBody (ReqBodyJson a) = L.RequestBodyLBS (A.encode a)
1166 getRequestContentType _ = pure "application/json; charset=utf-8"
1246 getRequestContentType _ = pure "application/json; charset=utf-8"
1167
1247
@@ -1214,6 +1294,13 @@ newtype FormUrlEncodedParam = FormUrlEncodedParam [(Text, Maybe Text)]
1214instance QueryParam FormUrlEncodedParam where
1294instance QueryParam FormUrlEncodedParam where
1215 queryParam name mvalue =
1295 queryParam name mvalue =
1216 FormUrlEncodedParam [(name, toQueryParam <$> mvalue)]
1296 FormUrlEncodedParam [(name, toQueryParam <$> mvalue)]
1297+ queryParamToList (FormUrlEncodedParam p) = p
1298+
1299+-- | Use 'formToQuery'.
1300+--
1301+-- @since 3.11.0
1302+instance FromForm FormUrlEncodedParam where
1303+ fromForm = Right . formToQuery
1217
1304
1218-- | Multipart form data. Please consult the
1305-- | Multipart form data. Please consult the
1219-- "Network.HTTP.Client.MultipartFormData" module for how to construct
1306-- "Network.HTTP.Client.MultipartFormData" module for how to construct
@@ -1253,7 +1340,7 @@ instance HttpBody ReqBodyMultipart where
1253-- | Create 'ReqBodyMultipart' request body from a collection of 'LM.Part's.
1340-- | Create 'ReqBodyMultipart' request body from a collection of 'LM.Part's.
1254--
1341--
1255-- @since 0.2.0
1342-- @since 0.2.0
1256−reqBodyMultipart :: MonadIO m => [LM.Part] -> m ReqBodyMultipart
1343+reqBodyMultipart :: (MonadIO m) => [LM.Part] -> m ReqBodyMultipart
1257reqBodyMultipart parts = liftIO $ do
1344reqBodyMultipart parts = liftIO $ do
1258 boundary <- LM.webkitBoundary
1345 boundary <- LM.webkitBoundary
1259 body <- LM.renderParts boundary parts
1346 body <- LM.renderParts boundary parts
@@ -1293,7 +1380,7 @@ type family
1293 TypeError
1380 TypeError
1294 ('Text "This HTTP method does not allow attaching a request body.")
1381 ('Text "This HTTP method does not allow attaching a request body.")
1295
1382
1296−instance HttpBody body => RequestComponent (Tagged "body" body) where
1383+instance (HttpBody body) => RequestComponent (Tagged "body" body) where
1297 getRequestMod (Tagged body) = Endo $ \x ->
1384 getRequestMod (Tagged body) = Endo $ \x ->
1298 x
1385 x
1299 { L.requestBody = getRequestBody body,
1386 { L.requestBody = getRequestBody body,
@@ -1339,6 +1426,12 @@ instance Monoid (Option scheme) where
1339 mempty = Option mempty Nothing
1426 mempty = Option mempty Nothing
1340 mappend = (<>)
1427 mappend = (<>)
1341
1428
1429+-- | Use 'formToQuery'.
1430+--
1431+-- @since 3.11.0
1432+instance FromForm (Option scheme) where
1433+ fromForm = Right . formToQuery
1434+
1342-- | A helper to create an 'Option' that modifies only collection of query
1435-- | A helper to create an 'Option' that modifies only collection of query
1343-- parameters. This helper is not a part of the public API.
1436-- parameters. This helper is not a part of the public API.
1344withQueryParams :: (Y.QueryText -> Y.QueryText) -> Option scheme
1437withQueryParams :: (Y.QueryText -> Y.QueryText) -> Option scheme
@@ -1357,7 +1450,7 @@ instance RequestComponent (Option scheme) where
1357
1450
1358-- | Finalize given 'L.Request' by applying a finalizer from the given
1451-- | Finalize given 'L.Request' by applying a finalizer from the given
1359-- 'Option' (if it has any).
1452-- 'Option' (if it has any).
1360−finalizeRequest :: MonadIO m => Option scheme -> L.Request -> m L.Request
1453+finalizeRequest :: (MonadIO m) => Option scheme -> L.Request -> m L.Request
1361finalizeRequest (Option _ mfinalizer) = liftIO . fromMaybe pure mfinalizer
1454finalizeRequest (Option _ mfinalizer) = liftIO . fromMaybe pure mfinalizer
1362
1455
1363----------------------------------------------------------------------------
1456----------------------------------------------------------------------------
@@ -1390,9 +1483,27 @@ name =: value = queryParam name (pure value)
1390-- This operator is defined in terms of 'queryParam':
1483-- This operator is defined in terms of 'queryParam':
1391--
1484--
1392-- > queryFlag name = queryParam name (Nothing :: Maybe ())
1485-- > queryFlag name = queryParam name (Nothing :: Maybe ())
1393−queryFlag :: QueryParam param => Text -> param
1486+queryFlag :: (QueryParam param) => Text -> param
1394queryFlag name = queryParam name (Nothing :: Maybe ())
1487queryFlag name = queryParam name (Nothing :: Maybe ())
1395
1488
1489+-- | Construct query parameters from a 'ToForm' instance. This function
1490+-- produces the same query params as 'Form.urlEncodeAsFormStable'.
1491+--
1492+-- Note that 'Form.Form' doesn't have the concept of parameters with the
1493+-- empty value (i.e. what you can get by @key =: ""@). If the value is
1494+-- empty, it will be encoded as a valueless parameter (i.e. what you can get
1495+-- by @queryFlag key@).
1496+--
1497+-- @since 3.11.0
1498+formToQuery :: (QueryParam param, Monoid param, ToForm f) => f -> param
1499+formToQuery f = mconcat . fmap toParam . Form.toListStable $ toForm f
1500+ where
1501+ toParam (key, val) =
1502+ queryParam key $
1503+ if val == ""
1504+ then Nothing
1505+ else Just val
1506+
1396-- | A type class for query-parameter-like things. The reason to have an
1507-- | A type class for query-parameter-like things. The reason to have an
1397-- overloaded 'queryParam' is to be able to use it as an 'Option' and as a
1508-- overloaded 'queryParam' is to be able to use it as an 'Option' and as a
1398-- 'FormUrlEncodedParam' when constructing form URL encoded request bodies.
1509-- 'FormUrlEncodedParam' when constructing form URL encoded request bodies.
@@ -1402,11 +1513,17 @@ class QueryParam param where
1402 -- 'Nothing', it won't be included at all (i.e. you create a flag this
1513 -- 'Nothing', it won't be included at all (i.e. you create a flag this
1403 -- way). It's recommended to use @('=:')@ and 'queryFlag' instead of this
1514 -- way). It's recommended to use @('=:')@ and 'queryFlag' instead of this
1404 -- method, because they are easier to read.
1515 -- method, because they are easier to read.
1405− queryParam :: ToHttpApiData a => Text -> Maybe a -> param
1516+ queryParam :: (ToHttpApiData a) => Text -> Maybe a -> param
1517+
1518+ -- | Get the query parameter names and values set by 'queryParam'.
1519+ --
1520+ -- @since 3.11.0
1521+ queryParamToList :: param -> [(Text, Maybe Text)]
1406
1522
1407instance QueryParam (Option scheme) where
1523instance QueryParam (Option scheme) where
1408 queryParam name mvalue =
1524 queryParam name mvalue =
1409 withQueryParams ((:) (name, toQueryParam <$> mvalue))
1525 withQueryParams ((:) (name, toQueryParam <$> mvalue))
1526+ queryParamToList (Option f _) = fst $ appEndo f ([], L.defaultRequest)
1410
1527
1411----------------------------------------------------------------------------
1528----------------------------------------------------------------------------
1412-- Request—Optional parameters—Headers
1529-- Request—Optional parameters—Headers
@@ -1430,6 +1547,14 @@ attachHeader :: ByteString -> ByteString -> L.Request -> L.Request
1430attachHeader name value x =
1547attachHeader name value x =
1431 x {L.requestHeaders = (CI.mk name, value) : L.requestHeaders x}
1548 x {L.requestHeaders = (CI.mk name, value) : L.requestHeaders x}
1432
1549
1550+-- | Same as 'header', but with redacted values on print.
1551+--
1552+-- @since 3.13.0
1553+headerRedacted :: ByteString -> ByteString -> Option scheme
1554+headerRedacted name value = withRequest $ \x ->
1555+ let y = attachHeader name value x
1556+ in y {L.redactHeaders = CI.mk name `S.insert` L.redactHeaders y}
1557+
1433----------------------------------------------------------------------------
1558----------------------------------------------------------------------------
1434-- Request—Optional parameters—Cookies
1559-- Request—Optional parameters—Cookies
1435
1560
@@ -1637,7 +1762,7 @@ ignoreResponse = Proxy
1637newtype JsonResponse a = JsonResponse (L.Response a)
1762newtype JsonResponse a = JsonResponse (L.Response a)
1638 deriving (Show)
1763 deriving (Show)
1639
1764
1640−instance FromJSON a => HttpResponse (JsonResponse a) where
1765+instance (FromJSON a) => HttpResponse (JsonResponse a) where
1641 type HttpResponseBody (JsonResponse a) = a
1766 type HttpResponseBody (JsonResponse a) = a
1642 toVanillaResponse (JsonResponse r) = r
1767 toVanillaResponse (JsonResponse r) = r
1643 getHttpResponse r = do
1768 getHttpResponse r = do
@@ -1753,14 +1878,14 @@ brReadN br n = go 0 id id
1753
1878
1754-- | Get the response body.
1879-- | Get the response body.
1755responseBody ::
1880responseBody ::
1756− HttpResponse response =>
1881+ (HttpResponse response) =>
1757 response ->
1882 response ->
1758 HttpResponseBody response
1883 HttpResponseBody response
1759responseBody = L.responseBody . toVanillaResponse
1884responseBody = L.responseBody . toVanillaResponse
1760
1885
1761-- | Get the response status code.
1886-- | Get the response status code.
1762responseStatusCode ::
1887responseStatusCode ::
1763− HttpResponse response =>
1888+ (HttpResponse response) =>
1764 response ->
1889 response ->
1765 Int
1890 Int
1766responseStatusCode =
1891responseStatusCode =
@@ -1768,7 +1893,7 @@ responseStatusCode =
1768
1893
1769-- | Get the response status message.
1894-- | Get the response status message.
1770responseStatusMessage ::
1895responseStatusMessage ::
1771− HttpResponse response =>
1896+ (HttpResponse response) =>
1772 response ->
1897 response ->
1773 ByteString
1898 ByteString
1774responseStatusMessage =
1899responseStatusMessage =
@@ -1776,7 +1901,7 @@ responseStatusMessage =
1776
1901
1777-- | Lookup a particular header from a response.
1902-- | Lookup a particular header from a response.
1778responseHeader ::
1903responseHeader ::
1779− HttpResponse response =>
1904+ (HttpResponse response) =>
1780 -- | Response interpretation
1905 -- | Response interpretation
1781 response ->
1906 response ->
1782 -- | Header to lookup
1907 -- | Header to lookup
@@ -1788,7 +1913,7 @@ responseHeader r h =
1788
1913
1789-- | Get the response 'L.CookieJar'.
1914-- | Get the response 'L.CookieJar'.
1790responseCookieJar ::
1915responseCookieJar ::
1791− HttpResponse response =>
1916+ (HttpResponse response) =>
1792 response ->
1917 response ->
1793 L.CookieJar
1918 L.CookieJar
1794responseCookieJar = L.responseCookieJar . toVanillaResponse
1919responseCookieJar = L.responseCookieJar . toVanillaResponse
@@ -1842,6 +1967,16 @@ class HttpResponse response where
1842 acceptHeader :: Proxy response -> Maybe ByteString
1967 acceptHeader :: Proxy response -> Maybe ByteString
1843 acceptHeader Proxy = Nothing
1968 acceptHeader Proxy = Nothing
1844
1969
1970+-- | This instance has been added to make it easier to inspect 'L.Response'
1971+-- using Req's functions like 'responseStatusCode', 'responseStatusMessage',
1972+-- etc.
1973+--
1974+-- @since 3.12.0
1975+instance HttpResponse (L.Response ()) where
1976+ type HttpResponseBody (L.Response ()) = ()
1977+ toVanillaResponse = id
1978+ getHttpResponse = return . void
1979+
1845----------------------------------------------------------------------------
1980----------------------------------------------------------------------------
1846-- Other
1981-- Other
1847
1982
@@ -1876,10 +2011,24 @@ data HttpException
1876 | -- | A wrapper with Aeson-produced 'String' describing why decoding
2011 | -- | A wrapper with Aeson-produced 'String' describing why decoding
1877 -- failed
2012 -- failed
1878 JsonHttpException String
2013 JsonHttpException String
1879− deriving (Show, Typeable, Generic)
2014+ deriving (Show, Generic)
1880
2015
1881instance Exception HttpException
2016instance Exception HttpException
1882
2017
2018+-- | Return 'Just' if the given 'HttpException' is wrapping a http-client's
2019+-- 'L.StatusCodeException'. Otherwise, return 'Nothing'.
2020+--
2021+-- @since 3.12.0
2022+isStatusCodeException :: HttpException -> Maybe (L.Response ())
2023+isStatusCodeException
2024+ ( VanillaHttpException
2025+ ( L.HttpExceptionRequest
2026+ _
2027+ (L.StatusCodeException r _)
2028+ )
2029+ ) = Just r
2030+isStatusCodeException _ = Nothing
2031+
1883-- | A simple type isomorphic to 'Bool' that we only have for better error
2032-- | A simple type isomorphic to 'Bool' that we only have for better error
1884-- messages. We use it as a kind and its data constructors as type-level
2033-- messages. We use it as a kind and its data constructors as type-level
1885-- tags.
2034-- tags.
@@ -1899,4 +2048,4 @@ data Scheme
1899 Http
2048 Http
1900 | -- | HTTPS
2049 | -- | HTTPS
1901 Https
2050 Https
1902− deriving (Eq, Ord, Show, Data, Typeable, Generic, TH.Lift)
2051+ deriving (Eq, Ord, Show, Data, Generic, TH.Lift)
README.md+1−1
@@ -4,7 +4,7 @@
4[![Hackage](https://img.shields.io/hackage/v/req.svg?style=flat)](https://hackage.haskell.org/package/req)
4[![Hackage](https://img.shields.io/hackage/v/req.svg?style=flat)](https://hackage.haskell.org/package/req)
5[![Stackage Nightly](http://stackage.org/package/req/badge/nightly)](http://stackage.org/nightly/package/req)
5[![Stackage Nightly](http://stackage.org/package/req/badge/nightly)](http://stackage.org/nightly/package/req)
6[![Stackage LTS](http://stackage.org/package/req/badge/lts)](http://stackage.org/lts/package/req)
6[![Stackage LTS](http://stackage.org/package/req/badge/lts)](http://stackage.org/lts/package/req)
7−![CI](https://github.com/mrkkrp/req/workflows/CI/badge.svg?branch=master)
7+[![CI](https://github.com/mrkkrp/req/actions/workflows/ci.yaml/badge.svg)](https://github.com/mrkkrp/req/actions/workflows/ci.yaml)
8
8
9* [Related packages](#related-packages)
9* [Related packages](#related-packages)
10* [Blog posts](#blog-posts)
10* [Blog posts](#blog-posts)
Setup.hsdeleted−6
@@ -1,6 +0,0 @@
1−module Main (main) where
2−
3−import Distribution.Simple
4−
5−main :: IO ()
6−main = defaultMain
cabal.projectnew file+4
@@ -0,0 +1,4 @@
1+packages: .
2+tests: True
3+benchmarks: True
4+constraints: req +dev
httpbin-tests/Network/HTTP/ReqSpec.hs+99−58
@@ -8,23 +8,25 @@
8module Network.HTTP.ReqSpec (spec) where
8module Network.HTTP.ReqSpec (spec) where
9
9
10import Control.Exception
10import Control.Exception
11−import Control.Monad.Reader
11+import Control.Monad (forM_)
12import Control.Monad.Trans.Control
12import Control.Monad.Trans.Control
13import Data.Aeson (ToJSON (..), Value (..), object, (.=))
13import Data.Aeson (ToJSON (..), Value (..), object, (.=))
14−import qualified Data.Aeson as A
14+import Data.Aeson qualified as A
15−import qualified Data.Aeson.KeyMap as Aeson.KeyMap
15+import Data.Aeson.KeyMap qualified as Aeson.KeyMap
16−import qualified Data.ByteString as B
16+import Data.ByteString qualified as B
17−import qualified Data.ByteString.Lazy as BL
17+import Data.ByteString.Lazy qualified as BL
18import Data.Functor.Identity (runIdentity)
18import Data.Functor.Identity (runIdentity)
19+import Data.Maybe (fromJust)
19import Data.Proxy
20import Data.Proxy
20import Data.Text (Text)
21import Data.Text (Text)
21−import qualified Data.Text as T
22+import Data.Text qualified as T
22−import qualified Data.Text.Encoding as T
23+import Data.Text.Encoding qualified as T
23−import qualified Data.Text.IO as TIO
24+import Data.Text.IO qualified as TIO
24−import qualified Network.HTTP.Client as L
25+import Network.HTTP.Client qualified as L
25−import qualified Network.HTTP.Client.MultipartFormData as LM
26+import Network.HTTP.Client.MultipartFormData qualified as LM
26−import Network.HTTP.Req
27+import Network.HTTP.Req hiding (req)
28+import Network.HTTP.Req qualified as Req
27−import qualified Network.HTTP.Types as Y
29+import Network.HTTP.Types qualified as Y
28import Test.Hspec
30import Test.Hspec
29import Test.QuickCheck
31import Test.QuickCheck
30
32
@@ -48,6 +50,11 @@ spec = do
48 blindlyThrowing (req GET httpbin NoReqBody ignoreResponse mempty)
50 blindlyThrowing (req GET httpbin NoReqBody ignoreResponse mempty)
49 `shouldThrow` anyException
51 `shouldThrow` anyException
50
52
53+ describe "isStatusCodeException" $
54+ it "extracts non-2xx response" $
55+ req GET (httpbin /: "foo") NoReqBody ignoreResponse mempty
56+ `shouldThrow` selector404ByStatusCodeException
57+
51 describe "receiving user-agent header back" $
58 describe "receiving user-agent header back" $
52 it "works" $ do
59 it "works" $ do
53 r <-
60 r <-
@@ -78,8 +85,7 @@ spec = do
78 .= object
85 .= object
79 [ "Accept-Encoding" .= ("gzip" :: Text),
86 [ "Accept-Encoding" .= ("gzip" :: Text),
80 "Foo" .= ("bar" :: Text),
87 "Foo" .= ("bar" :: Text),
81− "Baz" .= ("quux" :: Text),
88+ "Baz" .= ("quux" :: Text)
82− "Host" .= ("httpbin.org" :: Text)
83 ]
89 ]
84 ]
90 ]
85 responseStatusCode r `shouldBe` 200
91 responseStatusCode r `shouldBe` 200
@@ -91,11 +97,10 @@ spec = do
91 (stripFunnyHeaders . stripOrigin) (responseBody r)
97 (stripFunnyHeaders . stripOrigin) (responseBody r)
92 `shouldBe` object
98 `shouldBe` object
93 [ "args" .= emptyObject,
99 [ "args" .= emptyObject,
94− "url" .= ("https://httpbin.org/get" :: Text),
100+ "url" .= ("http://localhost:1234/get" :: Text),
95 "headers"
101 "headers"
96 .= object
102 .= object
97− [ "Accept-Encoding" .= ("gzip" :: Text),
103+ [ "Accept-Encoding" .= ("gzip" :: Text)
98− "Host" .= ("httpbin.org" :: Text)
99 ]
104 ]
100 ]
105 ]
101 responseHeader r "Content-Type" `shouldBe` return "application/json"
106 responseHeader r "Content-Type" `shouldBe` return "application/json"
@@ -112,12 +117,11 @@ spec = do
112 [ "args" .= emptyObject,
117 [ "args" .= emptyObject,
113 "json" .= text,
118 "json" .= text,
114 "data" .= reflected,
119 "data" .= reflected,
115− "url" .= ("https://httpbin.org/post" :: Text),
120+ "url" .= ("http://localhost:1234/post" :: Text),
116 "headers"
121 "headers"
117 .= object
122 .= object
118 [ "Content-Type" .= ("application/json; charset=utf-8" :: Text),
123 [ "Content-Type" .= ("application/json; charset=utf-8" :: Text),
119 "Accept-Encoding" .= ("gzip" :: Text),
124 "Accept-Encoding" .= ("gzip" :: Text),
120− "Host" .= ("httpbin.org" :: Text),
121 "Content-Length" .= show (T.length reflected)
125 "Content-Length" .= show (T.length reflected)
122 ],
126 ],
123 "files" .= emptyObject,
127 "files" .= emptyObject,
@@ -135,18 +139,17 @@ spec = do
135 LM.partBS "bar" "bar data!"
139 LM.partBS "bar" "bar data!"
136 ]
140 ]
137 r <- req POST (httpbin /: "post") body jsonResponse mempty
141 r <- req POST (httpbin /: "post") body jsonResponse mempty
138− let Just contentType = getRequestContentType body
142+ let contentType = fromJust (getRequestContentType body)
139 (stripFunnyHeaders . stripOrigin) (responseBody r)
143 (stripFunnyHeaders . stripOrigin) (responseBody r)
140 `shouldBe` object
144 `shouldBe` object
141 [ "args" .= emptyObject,
145 [ "args" .= emptyObject,
142 "json" .= Null,
146 "json" .= Null,
143 "data" .= ("" :: Text),
147 "data" .= ("" :: Text),
144− "url" .= ("https://httpbin.org/post" :: Text),
148+ "url" .= ("http://localhost:1234/post" :: Text),
145 "headers"
149 "headers"
146 .= object
150 .= object
147 [ "Content-Type" .= T.decodeUtf8 contentType,
151 [ "Content-Type" .= T.decodeUtf8 contentType,
148 "Accept-Encoding" .= ("gzip" :: Text),
152 "Accept-Encoding" .= ("gzip" :: Text),
149− "Host" .= ("httpbin.org" :: Text),
150 "Content-Length" .= ("242" :: Text)
153 "Content-Length" .= ("242" :: Text)
151 ],
154 ],
152 "files" .= emptyObject,
155 "files" .= emptyObject,
@@ -171,11 +174,10 @@ spec = do
171 [ "args" .= emptyObject,
174 [ "args" .= emptyObject,
172 "json" .= Null,
175 "json" .= Null,
173 "data" .= contents,
176 "data" .= contents,
174− "url" .= ("https://httpbin.org/patch" :: Text),
177+ "url" .= ("http://localhost:1234/patch" :: Text),
175 "headers"
178 "headers"
176 .= object
179 .= object
177 [ "Accept-Encoding" .= ("gzip" :: Text),
180 [ "Accept-Encoding" .= ("gzip" :: Text),
178− "Host" .= ("httpbin.org" :: Text),
179 "Content-Length" .= show (T.length contents)
181 "Content-Length" .= show (T.length contents)
180 ],
182 ],
181 "files" .= emptyObject,
183 "files" .= emptyObject,
@@ -197,12 +199,11 @@ spec = do
197 [ "args" .= emptyObject,
199 [ "args" .= emptyObject,
198 "json" .= Null,
200 "json" .= Null,
199 "data" .= ("" :: Text),
201 "data" .= ("" :: Text),
200− "url" .= ("https://httpbin.org/put" :: Text),
202+ "url" .= ("http://localhost:1234/put" :: Text),
201 "headers"
203 "headers"
202 .= object
204 .= object
203 [ "Content-Type" .= ("application/x-www-form-urlencoded" :: Text),
205 [ "Content-Type" .= ("application/x-www-form-urlencoded" :: Text),
204 "Accept-Encoding" .= ("gzip" :: Text),
206 "Accept-Encoding" .= ("gzip" :: Text),
205− "Host" .= ("httpbin.org" :: Text),
206 "Content-Length" .= ("18" :: Text)
207 "Content-Length" .= ("18" :: Text)
207 ],
208 ],
208 "files" .= emptyObject,
209 "files" .= emptyObject,
@@ -260,21 +261,17 @@ spec = do
260 -- TODO /response-headers
261 -- TODO /response-headers
261 -- TODO /redirect
262 -- TODO /redirect
262
263
263− -- FIXME Redirects test is temporarily disabled due to
264− --
265− -- https://github.com/postmanlabs/httpbin/issues/617
266−
267− -- describe "redirects" $
264+ describe "redirects" $
268− -- it "follows redirects" $ do
265+ it "follows redirects" $ do
269− -- r <-
266+ r <-
270− -- req
267+ req
271− -- GET
268+ GET
272− -- (httpbin /: "redirect-to")
269+ (httpbin /: "redirect-to")
273− -- NoReqBody
270+ NoReqBody
274− -- ignoreResponse
271+ ignoreResponse
275− -- ("url" =: ("https://httpbin.org" :: Text))
272+ ("url" =: ("https://httpbin.org" :: Text))
276− -- responseStatusCode r `shouldBe` 200
273+ responseStatusCode r `shouldBe` 200
277− -- responseStatusMessage r `shouldBe` "OK"
274+ responseStatusMessage r `shouldBe` "OK"
278
275
279 -- TODO /relative-redicet
276 -- TODO /relative-redicet
280 -- TODO /absolute-redirect
277 -- TODO /absolute-redirect
@@ -304,7 +301,7 @@ spec = do
304 (httpbin /: "basic-auth" /~ user /~ password)
301 (httpbin /: "basic-auth" /~ user /~ password)
305 NoReqBody
302 NoReqBody
306 ignoreResponse
303 ignoreResponse
307− (basicAuth (T.encodeUtf8 user) (T.encodeUtf8 password))
304+ (basicAuthUnsafe (T.encodeUtf8 user) (T.encodeUtf8 password))
308 responseStatusCode r `shouldBe` 200
305 responseStatusCode r `shouldBe` 200
309 responseStatusMessage r `shouldBe` "OK"
306 responseStatusMessage r `shouldBe` "OK"
310
307
@@ -404,8 +401,28 @@ blindlyThrowing = runReq defaultHttpConfig {httpConfigCheckResponse = doit}
404 doit _ _ = error "Oops!"
401 doit _ _ = error "Oops!"
405
402
406-- | 'Url' representing <https://httpbin.org>.
403-- | 'Url' representing <https://httpbin.org>.
407−httpbin :: Url 'Https
404+httpbin :: Url 'Http
408−httpbin = https "httpbin.org"
405+httpbin = http "localhost"
406+
407+req ::
408+ ( MonadHttp m,
409+ HttpMethod method,
410+ HttpBody body,
411+ HttpResponse response,
412+ HttpBodyAllowed (AllowsBody method) (ProvidesBody body)
413+ ) =>
414+ method ->
415+ Url scheme ->
416+ body ->
417+ Proxy response ->
418+ Option scheme ->
419+ m response
420+req method url body responseProxy options =
421+ Req.req method url body responseProxy (options <> defaultOptions)
422+
423+-- | Options to apply by default.
424+defaultOptions :: Option scheme
425+defaultOptions = port 1234
409
426
410-- | Remove “origin” field from JSON value. Origin may change, we don't want
427-- | Remove “origin” field from JSON value. Origin may change, we don't want
411-- to depend on that.
428-- to depend on that.
@@ -415,19 +432,36 @@ stripOrigin value = value
415
432
416-- | Remove funny headers that might break the tests.
433-- | Remove funny headers that might break the tests.
417stripFunnyHeaders :: Value -> Value
434stripFunnyHeaders :: Value -> Value
418−stripFunnyHeaders (Object m) =
435+stripFunnyHeaders = \case
436+ Object m ->
437+ Object
438+ ( runIdentity
439+ ( Aeson.KeyMap.alterF
440+ (pure . fmap stripFunnyHeaders')
441+ "headers"
442+ m
443+ )
444+ )
445+ value -> value
446+
447+-- | Similar to 'stripFunnyHeaders', but acts directly on the argument
448+-- without trying to access its "headers" field.
449+stripFunnyHeaders' :: Value -> Value
450+stripFunnyHeaders' = \case
451+ Object p ->
452+ Object $
419− let f (Object p) = Object $ Aeson.KeyMap.filterWithKey (\k _ -> k `elem` hs) p
453+ Aeson.KeyMap.filterWithKey
454+ (\k _ -> k `elem` whitelistedHeaders)
455+ p
420− f value = value
456+ value -> value
421− hs =
457+ where
458+ whitelistedHeaders =
422− [ "Content-Type",
459+ [ "Content-Type",
423− "Accept-Encoding",
460+ "Accept-Encoding",
424− "Host",
425− "Content-Length",
461+ "Content-Length",
426− "Foo",
462+ "Foo",
427− "Baz"
463+ "Baz"
428− ]
464+ ]
429− in Object (runIdentity (Aeson.KeyMap.alterF (pure . fmap f) "headers" m))
430−stripFunnyHeaders value = value
431
465
432-- | This is a complete test case that makes use of <https://httpbin.org> to
466-- | This is a complete test case that makes use of <https://httpbin.org> to
433-- get various response status codes.
467-- get various response status codes.
@@ -457,12 +491,19 @@ selector404
457 L.responseStatus response == Y.status404 && not (B.null chunk)
491 L.responseStatus response == Y.status404 && not (B.null chunk)
458selector404 _ = False
492selector404 _ = False
459
493
494+-- | Same as 'selector404' except that it uses 'isStatusCodeException'.
495+selector404ByStatusCodeException :: HttpException -> Bool
496+selector404ByStatusCodeException e =
497+ case isStatusCodeException e of
498+ Nothing -> False
499+ Just r -> responseStatusCode r == 404
500+
460-- | The empty JSON 'Object'.
501-- | The empty JSON 'Object'.
461emptyObject :: Value
502emptyObject :: Value
462emptyObject = Object Aeson.KeyMap.empty
503emptyObject = Object Aeson.KeyMap.empty
463
504
464-- | Get a rendered JSON value as 'Text'.
505-- | Get a rendered JSON value as 'Text'.
465−reflectJSON :: ToJSON a => a -> Text
506+reflectJSON :: (ToJSON a) => a -> Text
466reflectJSON = T.decodeUtf8 . BL.toStrict . A.encode
507reflectJSON = T.decodeUtf8 . BL.toStrict . A.encode
467
508
468-- | Clarify to the type checker that the inner computation is in the 'IO'
509-- | Clarify to the type checker that the inner computation is in the 'IO'
pure-tests/Network/HTTP/ReqSpec.hs+53−21
@@ -13,39 +13,41 @@
13
13
14module Network.HTTP.ReqSpec (spec) where
14module Network.HTTP.ReqSpec (spec) where
15
15
16−import qualified Blaze.ByteString.Builder as BB
16+import Blaze.ByteString.Builder qualified as BB
17import Control.Exception (throwIO)
17import Control.Exception (throwIO)
18import Control.Monad
18import Control.Monad
19import Control.Retry
19import Control.Retry
20import Data.Aeson (ToJSON (..))
20import Data.Aeson (ToJSON (..))
21−import qualified Data.Aeson as A
21+import Data.Aeson qualified as A
22import Data.ByteString (ByteString)
22import Data.ByteString (ByteString)
23−import qualified Data.ByteString as B
23+import Data.ByteString qualified as B
24−import qualified Data.ByteString.Char8 as B8
24+import Data.ByteString.Char8 qualified as B8
25−import qualified Data.ByteString.Lazy as BL
25+import Data.ByteString.Lazy qualified as BL
26−import qualified Data.CaseInsensitive as CI
26+import Data.CaseInsensitive qualified as CI
27import Data.Either (isRight)
27import Data.Either (isRight)
28−import qualified Data.List.NonEmpty as NE
28+import Data.List.NonEmpty qualified as NE
29import Data.Maybe (fromJust, fromMaybe, isJust, isNothing)
29import Data.Maybe (fromJust, fromMaybe, isJust, isNothing)
30import Data.Proxy
30import Data.Proxy
31import Data.Text (Text)
31import Data.Text (Text)
32−import qualified Data.Text as T
32+import Data.Text qualified as T
33−import qualified Data.Text.Encoding as T
33+import Data.Text.Encoding qualified as T
34import Data.Time
34import Data.Time
35import Data.Typeable (Typeable, eqT)
35import Data.Typeable (Typeable, eqT)
36+import GHC.Exts (IsList (..))
36import GHC.Generics
37import GHC.Generics
37−import qualified Language.Haskell.TH as TH
38+import Language.Haskell.TH qualified as TH
38−import qualified Language.Haskell.TH.Quote as TH
39+import Language.Haskell.TH.Quote qualified as TH
39−import qualified Network.HTTP.Client as L
40+import Network.HTTP.Client qualified as L
40import Network.HTTP.Req
41import Network.HTTP.Req
41−import qualified Network.HTTP.Types as Y
42+import Network.HTTP.Types qualified as Y
42−import qualified Network.HTTP.Types.Header as Y
43+import Network.HTTP.Types.Header qualified as Y
43import Test.Hspec
44import Test.Hspec
44import Test.Hspec.Core.Spec (SpecM)
45import Test.Hspec.Core.Spec (SpecM)
45import Test.QuickCheck
46import Test.QuickCheck
46import Text.URI (URI)
47import Text.URI (URI)
47−import qualified Text.URI as URI
48+import Text.URI qualified as URI
48−import qualified Text.URI.QQ as QQ
49+import Text.URI.QQ qualified as QQ
50+import Web.FormUrlEncoded qualified as F
49
51
50spec :: Spec
52spec :: Spec
51spec = do
53spec = do
@@ -159,11 +161,13 @@ spec = do
159 let uriHttp = uri' {URI.uriScheme = Just [QQ.scheme|http|]}
161 let uriHttp = uri' {URI.uriScheme = Just [QQ.scheme|http|]}
160 uriHttps = uri' {URI.uriScheme = Just [QQ.scheme|https|]}
162 uriHttps = uri' {URI.uriScheme = Just [QQ.scheme|https|]}
161 requestHttp <-
163 requestHttp <-
162− let Left (url', options) = fromJust (useURI uriHttp)
164+ case fromJust (useURI uriHttp) of
163− in req_ GET url' NoReqBody options
165+ Left (url', options) -> req_ GET url' NoReqBody options
166+ _ -> error "(useURI uriHttp) should have returned Left"
164 requestHttps <-
167 requestHttps <-
165− let Right (url', options) = fromJust (useURI uriHttps)
168+ case fromJust (useURI uriHttps) of
166− in req_ GET url' NoReqBody options
169+ Right (url', options) -> req_ GET url' NoReqBody options
170+ _ -> error "(useURI uriHttps) should have returned Right"
167 L.host requestHttp `shouldBe` uriHost uriHttp
171 L.host requestHttp `shouldBe` uriHost uriHttp
168 L.host requestHttps `shouldBe` uriHost uriHttps
172 L.host requestHttps `shouldBe` uriHost uriHttps
169 L.port requestHttp `shouldBe` uriPort 80 uriHttp
173 L.port requestHttp `shouldBe` uriPort 80 uriHttp
@@ -233,6 +237,19 @@ spec = do
233 L.RequestBodyLBS x -> x `shouldBe` renderQuery params
237 L.RequestBodyLBS x -> x `shouldBe` renderQuery params
234 _ -> expectationFailure "Wrong request body constructor."
238 _ -> expectationFailure "Wrong request body constructor."
235
239
240+ describe "query params" $ do
241+ describe "FormUrlEncodedParam" $ do
242+ describe "formToQuery" $ do
243+ it "should produce the same parameters as F.urlEncodeFormStable" $
244+ property $ \form -> do
245+ request <- req_ POST url (ReqBodyUrlEnc $ formToQuery form) mempty
246+ case L.requestBody request of
247+ L.RequestBodyLBS x -> x `shouldBe` F.urlEncodeFormStable form
248+ _ -> expectationFailure "Wrong request body constructor"
249+ specParamToList (Proxy :: Proxy FormUrlEncodedParam)
250+ describe "Option" $ do
251+ specParamToList (Proxy :: Proxy (Option 'Http))
252+
236 describe "optional parameters" $ do
253 describe "optional parameters" $ do
237 describe "header" $ do
254 describe "header" $ do
238 it "sets specified header value" $
255 it "sets specified header value" $
@@ -396,7 +413,7 @@ spec = do
396 -- 'Https, Option _) type checks, so we can catch if the type of scheme
413 -- 'Https, Option _) type checks, so we can catch if the type of scheme
397 -- is unspecified.
414 -- is unspecified.
398 let testTypeOfQuoterResult ::
415 let testTypeOfQuoterResult ::
399− forall a s. Typeable a => (a, Option s) -> Bool
416+ forall a s. (Typeable a) => (a, Option s) -> Bool
400 testTypeOfQuoterResult _ = isJust $ eqT @a @(Url 'Https)
417 testTypeOfQuoterResult _ = isJust $ eqT @a @(Url 'Https)
401 in property $ testTypeOfQuoterResult [urlQ|https://example.org/|]
418 in property $ testTypeOfQuoterResult [urlQ|https://example.org/|]
402 it "doesn't work for invalid urls" $
419 it "doesn't work for invalid urls" $
@@ -486,6 +503,9 @@ instance Arbitrary Day where
486instance Arbitrary DiffTime where
503instance Arbitrary DiffTime where
487 arbitrary = secondsToDiffTime <$> arbitrary
504 arbitrary = secondsToDiffTime <$> arbitrary
488
505
506+instance Arbitrary F.Form where
507+ arbitrary = (F.Form . fromList) <$> arbitrary
508+
489----------------------------------------------------------------------------
509----------------------------------------------------------------------------
490-- Helper types
510-- Helper types
491
511
@@ -598,3 +618,15 @@ basicProxyAuthHeader :: ByteString -> ByteString -> ByteString
598basicProxyAuthHeader username password =
618basicProxyAuthHeader username password =
599 fromJust . lookup Y.hProxyAuthorization . L.requestHeaders $
619 fromJust . lookup Y.hProxyAuthorization . L.requestHeaders $
600 L.applyBasicProxyAuth username password L.defaultRequest
620 L.applyBasicProxyAuth username password L.defaultRequest
621+
622+-- | Spec about 'paramToList' for the type @p@.
623+specParamToList :: (QueryParam p, Monoid p) => Proxy p -> Spec
624+specParamToList typeProxy = do
625+ describe "paramToList" $ do
626+ it "should reproduce the parameters given by queryParam" $
627+ property $ \(QueryParams params) -> do
628+ let queryParam0 =
629+ (mconcat $ fmap (uncurry queryParam) params)
630+ `asProxyTypeOf` typeProxy
631+ got = queryParamToList queryParam0
632+ got `shouldBe` params
req.cabal+53−52
@@ -1,11 +1,11 @@
1−cabal-version: 1.18
1+cabal-version: 2.4
2name: req
2name: req
3−version: 3.9.2
3+version: 3.13.4
4−license: BSD3
4+license: BSD-3-Clause
5license-file: LICENSE.md
5license-file: LICENSE.md
6maintainer: Mark Karpov <markkarpov92@gmail.com>
6maintainer: Mark Karpov <markkarpov92@gmail.com>
7author: Mark Karpov <markkarpov92@gmail.com>
7author: Mark Karpov <markkarpov92@gmail.com>
8−tested-with: ghc ==8.8.4 ghc ==8.10.5 ghc ==9.0.1
8+tested-with: ghc ==9.6.3 ghc ==9.8.2 ghc ==9.10.1
9homepage: https://github.com/mrkkrp/req
9homepage: https://github.com/mrkkrp/req
10bug-reports: https://github.com/mrkkrp/req/issues
10bug-reports: https://github.com/mrkkrp/req/issues
11synopsis: HTTP client library
11synopsis: HTTP client library
@@ -31,96 +31,97 @@ flag dev
31
31
32library
32library
33 exposed-modules: Network.HTTP.Req
33 exposed-modules: Network.HTTP.Req
34− default-language: Haskell2010
34+ default-language: GHC2021
35 build-depends:
35 build-depends:
36 aeson >=0.9 && <3,
36 aeson >=0.9 && <3,
37 authenticate-oauth >=1.5 && <1.8,
37 authenticate-oauth >=1.5 && <1.8,
38− base >=4.13 && <5.0,
38+ base >=4.15 && <5,
39 blaze-builder >=0.3 && <0.5,
39 blaze-builder >=0.3 && <0.5,
40− bytestring >=0.10.8 && <0.12,
40+ bytestring >=0.10.8 && <0.13,
41 case-insensitive >=0.2 && <1.3,
41 case-insensitive >=0.2 && <1.3,
42+ containers >=0.5 && <0.8,
42− connection >=0.2.2 && <0.4,
43+ crypton-connection >=0.4.2 && <0.5,
44+ data-default-class >=0.2.0.0,
43 exceptions >=0.6 && <0.11,
45 exceptions >=0.6 && <0.11,
44− http-api-data >=0.2 && <0.5,
46+ http-api-data >=0.2 && <0.7,
45− http-client >=0.7 && <0.8,
47+ http-client >=0.7.13.1 && <0.8,
46 http-client-tls >=0.3.2 && <0.4,
48 http-client-tls >=0.3.2 && <0.4,
47− http-types >=0.8 && <10.0,
49+ http-types >=0.8 && <10,
48 modern-uri >=0.3 && <0.4,
50 modern-uri >=0.3 && <0.4,
49 monad-control >=1.0 && <1.1,
51 monad-control >=1.0 && <1.1,
50 mtl >=2.0 && <3.0,
52 mtl >=2.0 && <3.0,
51 retry >=0.8 && <0.10,
53 retry >=0.8 && <0.10,
52− template-haskell >=2.14 && <2.18,
54+ template-haskell >=2.19 && <2.23,
53− text >=0.2 && <1.3,
55+ text >=0.2 && <2.2,
54− time >=1.2 && <1.13,
56+ transformers >=0.5.3.0 && <0.7,
55− transformers >=0.4 && <0.6,
56 transformers-base,
57 transformers-base,
57 unliftio-core >=0.1.1 && <0.3
58 unliftio-core >=0.1.1 && <0.3
58
59
59 if flag(dev)
60 if flag(dev)
60− ghc-options: -O0 -Wall -Werror
61+ ghc-options:
62+ -Wall -Werror -Wpartial-fields -Wunused-packages
63+ -Wno-unused-imports
61
64
62 else
65 else
63 ghc-options: -O2 -Wall
66 ghc-options: -O2 -Wall
64
67
65− if flag(dev)
66− ghc-options:
67− -Wcompat -Wincomplete-record-updates -Wincomplete-uni-patterns
68− -Wnoncanonical-monad-instances
69−
70test-suite pure-tests
68test-suite pure-tests
71− type: exitcode-stdio-1.0
69+ type: exitcode-stdio-1.0
72− main-is: Spec.hs
70+ main-is: Spec.hs
73− build-tools: hspec-discover >=2.0 && <3.0
71+ build-tool-depends: hspec-discover:hspec-discover >=2 && <3
74− hs-source-dirs: pure-tests
72+ hs-source-dirs: pure-tests
75− other-modules: Network.HTTP.ReqSpec
73+ other-modules: Network.HTTP.ReqSpec
76− default-language: Haskell2010
74+ default-language: GHC2021
77 build-depends:
75 build-depends:
78− QuickCheck >=2.7 && <3.0,
76+ QuickCheck >=2.7 && <3,
79 aeson >=0.9 && <3,
77 aeson >=0.9 && <3,
80− base >=4.13 && <5.0,
78+ base >=4.15 && <5.0,
81 blaze-builder >=0.3 && <0.5,
79 blaze-builder >=0.3 && <0.5,
82− bytestring >=0.10.8 && <0.12,
80+ bytestring >=0.10.8 && <0.13,
83 case-insensitive >=0.2 && <1.3,
81 case-insensitive >=0.2 && <1.3,
84− hspec >=2.0 && <3.0,
82+ hspec >=2.0 && <3,
85− hspec-core >=2.0 && <3.0,
83+ hspec-core >=2.0 && <3,
84+ http-api-data >=0.2 && <0.7,
86 http-client >=0.7 && <0.8,
85 http-client >=0.7 && <0.8,
87− http-types >=0.8 && <10.0,
86+ http-types >=0.8 && <10,
88 modern-uri >=0.3 && <0.4,
87 modern-uri >=0.3 && <0.4,
89− mtl >=2.0 && <3.0,
90 req,
88 req,
91 retry >=0.8 && <0.10,
89 retry >=0.8 && <0.10,
92− template-haskell >=2.14 && <2.18,
90+ template-haskell >=2.19 && <2.23,
93− text >=0.2 && <1.3,
91+ text >=0.2 && <2.2,
94− time >=1.2 && <1.13
92+ time >=1.2 && <1.15
95
93
96 if flag(dev)
94 if flag(dev)
97− ghc-options: -O0 -Wall -Werror
95+ ghc-options:
96+ -Wall -Werror -Wredundant-constraints -Wpartial-fields
97+ -Wunused-packages
98
98
99 else
99 else
100 ghc-options: -O2 -Wall
100 ghc-options: -O2 -Wall
101
101
102test-suite httpbin-tests
102test-suite httpbin-tests
103− type: exitcode-stdio-1.0
103+ type: exitcode-stdio-1.0
104− main-is: Spec.hs
104+ main-is: Spec.hs
105− build-tools: hspec-discover >=2.0 && <3.0
105+ build-tool-depends: hspec-discover:hspec-discover >=2 && <3
106− hs-source-dirs: httpbin-tests
106+ hs-source-dirs: httpbin-tests
107− other-modules: Network.HTTP.ReqSpec
107+ other-modules: Network.HTTP.ReqSpec
108− default-language: Haskell2010
108+ default-language: GHC2021
109 build-depends:
109 build-depends:
110− QuickCheck >=2.7 && <3.0,
110+ QuickCheck >=2.7 && <3,
111 aeson >=2 && <3,
111 aeson >=2 && <3,
112− base >=4.13 && <5.0,
112+ base >=4.15 && <5,
113− bytestring >=0.10.8 && <0.12,
113+ bytestring >=0.10.8 && <0.13,
114 hspec >=2.0 && <3.0,
114 hspec >=2.0 && <3.0,
115 http-client >=0.7 && <0.8,
115 http-client >=0.7 && <0.8,
116− http-types >=0.8 && <10.0,
116+ http-types >=0.8 && <10,
117 monad-control >=1.0 && <1.1,
117 monad-control >=1.0 && <1.1,
118− mtl >=2.0 && <3.0,
119 req,
118 req,
120− text >=0.2 && <1.3
119+ text >=0.2 && <2.2
121
120
122 if flag(dev)
121 if flag(dev)
123− ghc-options: -O0 -Wall -Werror
122+ ghc-options:
123+ -Wall -Werror -Wredundant-constraints -Wpartial-fields
124+ -Wunused-packages
124
125
125 else
126 else
126− ghc-options: -O2 -Wall
127+ buildable: False