diff --git a/CHANGELOG.md b/CHANGELOG.md --- a/CHANGELOG.md +++ b/CHANGELOG.md @@ -1,3 +1,28 @@ +## Req 0.3.0 + +* Made URL parsing functions `parseUrlHttp` and `parseUrlHttps` recognize + port numbers. + +* Added `req'` function that allows to perform requests via a callback that + receives pre-constructed request and manager. + +* Removed the `ReturnRequest` HTTP response implementation as it was not + quite safe and was not going to work with retrying. Use `req'` instead for + “pure” testing. + +* Changed the type of `httpConfigCheckResponse`, so the second argument can + be any instance of `HttpResponse`. + +* Added built-in automatic retrying. See `httpConfigRetryPolicy` and + `httpConfigRetryJudge` in `HttpConfig`. The default configuration retries + 5 times on request timeouts. + +* Added the `makeResponseBodyPreview` method to the `HttpResponse` type + class that allows to specify how to build a “preview” of response body for + inclusion into exceptions. + +* Improved wording in the documentation and `README.md`. + ## Req 0.2.0 * Added support for multipart form data in form of `ReqBodyMultipart` body diff --git a/Network/HTTP/Req.hs b/Network/HTTP/Req.hs --- a/Network/HTTP/Req.hs +++ b/Network/HTTP/Req.hs @@ -3,87 +3,90 @@ -- Copyright : © 2016–2017 Mark Karpov -- License : BSD 3 clause -- --- Maintainer : Mark Karpov +-- Maintainer : Mark Karpov -- Stability : experimental -- Portability : portable -- --- The documentation below is structured in such a way that most important --- information goes first: you learn how to do HTTP requests, then how to --- embed them in any monad you have, then it goes on giving you details --- about less-common things you may want to know about. The documentation is --- written with sufficient coverage of details and examples, it's designed --- to be a complete tutorial on its own. +-- The documentation below is structured in such a way that the most +-- important information is presented first: you learn how to do HTTP +-- requests, how to embed them in any monad you have, and then it gives you +-- details about less-common things you may want to know about. The +-- documentation is written with sufficient coverage of details and +-- examples, and it's designed to be a complete tutorial on its own. -- -- /(A modest intro goes here, click on 'req' to start making requests.)/ -- -- === About the library -- --- This is an easy-to-use, type-safe, expandable, high-level HTTP library +-- Req is an easy-to-use, type-safe, expandable, high-level HTTP library -- that just works without any fooling around. -- --- What does the “easy-to-use” phrase mean? It means that the library is --- designed to be beginner-friendly, so it's simple to add it to your monad +-- What does the phrase “easy-to-use” mean? It means that the library is +-- designed to be beginner-friendly so it's simple to add to your monad -- stack, intuitive to work with, well-documented, and does not get in your --- way. Doing HTTP requests is a common task and Haskell library for this +-- way. Doing HTTP requests is a common task and a Haskell library for this -- should be very approachable and clear to beginners, thus certain -- compromises were made. For example, one cannot currently modify --- 'L.ManagerSettings' of default manager because the library always uses --- the same implicit global manager for simplicity and maximal connection --- sharing. There is a way to use your own manager with different settings, --- but it requires a bit more typing. +-- 'L.ManagerSettings' of the default manager because the library always +-- uses the same implicit global manager for simplicity and maximal +-- connection sharing. There is a way to use your own manager with different +-- settings, but it requires a bit more typing. -- -- “Type-safe” means that the library is protective and eliminates certain --- class of errors. For example, we have correct-by-construction 'Url's, --- it's guaranteed that user does not send request body when using methods --- like 'GET' or 'OPTIONS', amount of implicit assumptions is minimized by --- making user specify his\/her intentions in explicit form (for example, --- it's not possible to avoid specifying body or method of a request). --- Authentication methods that assume TLS force user to use TLS on type --- level. The library carefully hides underlying types from lower-level --- @http-client@ package because it's not safe enough (for example --- 'L.Request' is an instance of 'Data.String.IsString' and if it's --- malformed, it will blow up at run-time). +-- classes of errors. For example, we have correct-by-construction 'Url's, +-- it's guaranteed that the user does not send the request body when using +-- methods like 'GET' or 'OPTIONS', and the amount of implicit assumptions +-- is minimized by making the user specify his\/her intentions in an +-- explicit form (for example, it's not possible to avoid specifying the +-- body or method of a request). Authentication methods that assume HTTPS +-- force the user to use HTTPS at the type level. The library also carefully +-- hides underlying types from the lower-level @http-client@ package because +-- those types are not safe enough (for example 'L.Request' is an instance +-- of 'Data.String.IsString' and, if it's malformed, it will blow up at +-- run-time). -- -- “Expandable” refers to the ability of the library to be expanded without --- ugly hacking. For example, it's possible to define your own HTTP methods, --- new ways to construct body of request, new authorization options, new --- ways to actually perform request and how to represent\/parse response. As --- user extends the library to satisfy his\/her special needs, the new --- solutions work just like built-ins. That said, all common cases are --- covered by the library out-of-the-box. +-- having to resort to ugly hacking. For example, it's possible to define +-- your own HTTP methods, create new ways to construct the body of a +-- request, create new authorization options, perform a request in a +-- different way, and create your own methods to parse and represent a +-- response. As a user extends the library to satisfy his\/her special +-- needs, the new solutions will work just like the built-ins. However, all +-- of the common cases are also covered by the library out-of-the-box. -- -- “High-level” means that there are less details to worry about. The --- library is a result of my experiences as a Haskell consultant, working --- for several clients who have very different projects and so the library --- adapts easily to any particular style of writing Haskell applications. --- For example, some people prefer throwing exceptions, while others are --- concerned with purity: just define 'handleHttpException' accordingly when --- making your monad instance of 'MonadHttp' and it will play seamlessly. --- Finally, the library cuts boilerplate considerably and helps write --- concise, easy to read and maintain code. +-- library is a result of my experiences as a Haskell consultant. Working +-- for several clients, who had very different projects, showed me that the +-- library should adapt easily to any particular style of writing Haskell +-- applications. For example, some people prefer throwing exceptions, while +-- others are concerned with purity. Just define 'handleHttpException' +-- accordingly when making your monad instance of 'MonadHttp' and it will +-- play together seamlessly. Finally, the library cuts boilerplate down +-- considerably, and helps you write concise, easy to read, and maintainable +-- code. -- -- === Using with other libraries -- --- * You won't need low-level interface of @http-client@ most of the --- time, but when you do, it's better import it qualified because it --- has naming conflicts with @req@. --- * For streaming of large request bodies see companion package +-- * You won't need the low-level interface of @http-client@ most of the +-- time, but when you do, it's better to do a qualified import, +-- because @http-client@ has naming conflicts with @req@. +-- * For streaming of large request bodies see the companion package -- @req-conduit@: . -- -- === Lightweight, no risk solution -- -- The library uses the following mature packages under the hood to --- guarantee you best experience without bugs or other funny business: +-- guarantee you the best experience: -- --- * — low level HTTP +-- * —low level HTTP -- client used everywhere in Haskell. --- * — TLS (HTTPS) +-- * —TLS (HTTPS) -- support for @http-client@. -- -- It's important to note that since we leverage well-known libraries that --- the whole Haskell ecosystem uses, there is no risk in using @req@, as the +-- the whole Haskell ecosystem uses, there is no risk in using @req@. The -- machinery for performing requests is the same as with @http-conduit@ and --- @wreq@, it's just the API is different. +-- @wreq@. The only difference is the API. {-# LANGUAGE CPP #-} {-# LANGUAGE DataKinds #-} @@ -93,6 +96,7 @@ {-# LANGUAGE GeneralizedNewtypeDeriving #-} {-# LANGUAGE KindSignatures #-} {-# LANGUAGE OverloadedStrings #-} +{-# LANGUAGE RankNTypes #-} {-# LANGUAGE RecordWildCards #-} {-# LANGUAGE ScopedTypeVariables #-} {-# LANGUAGE TypeFamilies #-} @@ -113,6 +117,7 @@ ( -- * Making a request -- $making-a-request req + , req' , withReqManager -- * Embedding requests into your monad -- $embedding-requests @@ -188,15 +193,12 @@ , bsResponse , LbsResponse , lbsResponse - , ReturnRequest - , returnRequest -- ** Inspecting a response , responseBody , responseStatusCode , responseStatusMessage , responseHeader , responseCookieJar - , responseRequest -- ** Defining your own interpretation -- $new-response-interpretation , HttpResponse (..) @@ -208,9 +210,10 @@ import Control.Applicative import Control.Arrow (first, second) -import Control.Exception (Exception, try, catch, throwIO) +import Control.Exception (Exception, try, handle, throwIO) import Control.Monad import Control.Monad.IO.Class +import Control.Retry import Data.Aeson (ToJSON (..), FromJSON (..)) import Data.ByteString (ByteString) import Data.Data (Data) @@ -222,6 +225,7 @@ import Data.Maybe (fromMaybe) import Data.Proxy import Data.Semigroup hiding (Option, option) +import Data.Text (Text) import Data.Typeable (Typeable) import GHC.Generics import GHC.TypeLits @@ -235,6 +239,7 @@ import qualified Data.List.NonEmpty as NE import qualified Data.Text as T import qualified Data.Text.Encoding as T +import qualified Data.Text.Read as TR import qualified Network.Connection as NC import qualified Network.HTTP.Client as L import qualified Network.HTTP.Client.Internal as LI @@ -273,22 +278,24 @@ -- tutorial has a section about HTTP bodies, but usage is very -- straightforward and should be clear from the examples below. -- --- @response@ is a type hint how to make and interpret response of HTTP --- request, out-of-the-box it can be the following: 'ignoreResponse', --- 'jsonResponse', 'bsResponse' (to get strict 'ByteString'), 'lbsResponse' --- (to get lazy 'BL.ByteString'), and 'returnRequest' (makes no request, --- just returns response, used for testing). +-- @response@ is a type hint how to make and interpret response of an HTTP +-- request. Out-of-the-box it can be the following: -- --- Finally @options@ is a 'Monoid' that holds a composite 'Option' for all --- other optional things like query parameters, headers, non-standard port --- number, etc. There are quite a few things you can put there, see +-- * 'ignoreResponse' +-- * 'jsonResponse' +-- * 'bsResponse' (to get a strict 'ByteString') +-- * 'lbsResponse' (to get a lazy 'BL.ByteString') +-- +-- Finally, @options@ is a 'Monoid' that holds a composite 'Option' for all +-- other optional settings like query parameters, headers, non-standard port +-- number, etc. There are quite a few things you can put there, see the -- corresponding section in the documentation. If you don't need anything at -- all, pass 'mempty'. -- -- __Note__ that if you use 'req' to do all your requests, connection -- sharing and reuse is done for you automatically. -- --- See the examples below to get on the speed very quickly. +-- See the examples below to get on the speed quickly. -- -- ==== __Examples__ -- @@ -379,41 +386,70 @@ -- > print (responseBody response :: Value) req - :: forall m method body response scheme. - ( MonadHttp m + :: ( MonadHttp m , HttpMethod method , HttpBody body , HttpResponse response , HttpBodyAllowed (AllowsBody method) (ProvidesBody body) ) => method -- ^ HTTP method - -> Url scheme -- ^ 'Url' — location of resource + -> Url scheme -- ^ 'Url'—location of resource -> body -- ^ Body of the request -> Proxy response -- ^ A hint how to interpret response -> Option scheme -- ^ Collection of optional parameters -> m response -- ^ Response -req method url body Proxy options = do - config <- getHttpConfig +req method url body Proxy options = req' method url body options $ \request manager -> do + HttpConfig {..} <- getHttpConfig + let wrappingVanilla = handle (throwIO . VanillaHttpException) + wrapExc = handle (throwIO . LI.toHttpException request) + (liftIO . try . wrappingVanilla . wrapExc) (do + response <- retrying httpConfigRetryPolicy httpConfigRetryJudge + (const $ getHttpResponse request manager) + httpConfigCheckResponse request response + return response) + >>= either handleHttpException return + +-- | Mostly like 'req' with respect to its arguments, but accepts a callback +-- that allows to perform a request in arbitrary fashion. +-- +-- This function /does not/ perform handling\/wrapping exceptions, checking +-- response, and retrying. It only prepares 'L.Request' and allows you to +-- use it. +-- +-- @since 0.3.0 + +req' + :: forall m method body scheme a. + ( 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 + -> Option scheme -- ^ Collection of optional parameters + -> (L.Request -> L.Manager -> m a) -- ^ How to perform request + -> m a +req' method url body options m = do + config@HttpConfig {..} <- getHttpConfig manager <- liftIO (readIORef globalManager) let -- NOTE First appearance of any given header wins. This allows to -- “overwrite” headers when we construct a request by cons-ing. nubHeaders = Endo $ \x -> x { L.requestHeaders = nubBy ((==) `on` fst) (L.requestHeaders x) } request' = flip appEndo L.defaultRequest $ - -- NOTE Order of 'mappend's matters, here method is overwritten first - -- and 'options' take effect last. In particular, this means that - -- 'options' can overwrite things set by other request components, - -- which is useful for setting port number, "Content-Type" header, - -- etc. + -- NOTE The order of 'mappend's matters, here method is overwritten + -- first and 'options' take effect last. In particular, this means + -- that 'options' can overwrite things set by other request + -- components, which is useful for setting port number, + -- "Content-Type" header, etc. nubHeaders <> getRequestMod options <> getRequestMod config <> getRequestMod (Womb body :: Womb "body" body) <> getRequestMod url <> getRequestMod (Womb method :: Womb "method" method) - wrappingVanilla m = catch m (throwIO . VanillaHttpException) request <- finalizeRequest options request' - (liftIO . try . wrappingVanilla) (getHttpResponse request manager) - >>= either handleHttpException return + m request manager -- | Global 'L.Manager' that 'req' uses. Here we just go with the default -- settings, so users don't need to deal with this manager stuff at all, but @@ -422,10 +458,10 @@ -- -- A note about safety, in case 'unsafePerformIO' looks suspicious to you. -- The value of 'globalManager' is named and lives on top level. This means --- it will be shared, i.e. computed only once on first use of manager. From --- that moment on the 'IORef' will be just reused — exactly the behaviour we --- want here in order to maximize connection sharing. GHC could spoil the --- plan by inlining the definition, hence the @NOINLINE@ pragma. +-- it will be shared, i.e. computed only once on the first use of the +-- manager. From that moment on the 'IORef' will be just reused—exactly the +-- behavior we want here in order to maximize connection sharing. GHC could +-- spoil the plan by inlining the definition, hence the @NOINLINE@ pragma. globalManager :: IORef L.Manager globalManager = unsafePerformIO $ do @@ -452,6 +488,8 @@ -- -- When writing a library, keep your API polymorphic in terms of -- 'MonadHttp', only define instance of 'MonadHttp' in final application. +-- Another option is to use @newtype@ wrapped monad stack and define +-- 'MonadHttp' for it. -- | A type class for monads that support performing HTTP requests. -- Typically, you only need to define the 'handleHttpException' method @@ -459,13 +497,11 @@ class MonadIO m => MonadHttp m where - {-# MINIMAL handleHttpException #-} - -- | This method describes how to deal with 'HttpException' that was -- caught by the library. One option is to re-throw it if you are OK with -- exceptions, but if you prefer working with something like - -- 'Control.Monad.Error.MonadError', this is the right place to pass it to - -- 'Control.Monad.Error.throwError'. + -- 'Control.Monad.Except.MonadError', this is the right place to pass it to + -- 'Control.Monad.Except.throwError'. handleHttpException :: HttpException -> m a @@ -494,7 +530,7 @@ -- ^ Alternative 'L.Manager' to use. 'Nothing' (default value) means -- that default implicit manager will be used (that's what you want in -- 99% of cases). - , httpConfigCheckResponse :: L.Request -> L.Response L.BodyReader -> IO () + , httpConfigCheckResponse :: forall r. HttpResponse r => L.Request -> r -> IO () -- ^ Function to check the response immediately after receiving the -- status and headers. This is used for throwing exceptions on -- non-success status codes by default (set to @\\_ _ -> return ()@ if @@ -503,6 +539,18 @@ -- something is wrong and we need a way to short-cut execution. The -- thrown exception is caught by the library though and is available in -- 'handleHttpException'. + -- + -- @since 0.3.0 + , httpConfigRetryPolicy :: RetryPolicyM IO + -- ^ The retry policy to use for request retrying. By default 'def' is + -- used (see 'RetryPolicyM'). + -- + -- @since 0.3.0 + , httpConfigRetryJudge :: forall r. HttpResponse r => RetryStatus -> r -> IO Bool + -- ^ The function is used to decide whether to retry a request. 'True' + -- means that the request should be retried. + -- + -- @since 0.3.0 } deriving Typeable instance Default HttpConfig where @@ -511,25 +559,35 @@ , httpConfigRedirectCount = 10 , httpConfigAltManager = Nothing , httpConfigCheckResponse = \_ response -> - let Y.Status statusCode _ = L.responseStatus response in + let statusCode = responseStatusCode response in unless (200 <= statusCode && statusCode < 300) $ do - chunk <- BL.toStrict <$> L.brReadSome (L.responseBody response) 1024 - LI.throwHttp (L.StatusCodeException (void response) chunk) } + chunk <- makeResponseBodyPreview response + let vresponse = toVanillaResponse response + LI.throwHttp (L.StatusCodeException (void vresponse) chunk) + , httpConfigRetryPolicy = def + , httpConfigRetryJudge = \_ r -> return $ + responseStatusCode r `elem` + [ 408 -- Request timeout + , 504 -- Gateway timeout + , 524 -- A timeout occurred + , 598 -- (Informal convention) Network read timeout error + , 599 -- (Informal convention) Network connect timeout error + ] + } instance RequestComponent HttpConfig where getRequestMod HttpConfig {..} = Endo $ \x -> x { L.proxy = httpConfigProxy , L.redirectCount = httpConfigRedirectCount - , LI.requestManagerOverride = httpConfigAltManager - , LI.checkResponse = httpConfigCheckResponse } + , LI.requestManagerOverride = httpConfigAltManager } ---------------------------------------------------------------------------- --- Request — Method +-- Request—Method -- $method -- -- The package supports all methods as defined by RFC 2616, and 'PATCH' --- which is defined by RFC 5789 — that should be enough to talk to RESTful +-- which is defined by RFC 5789—that should be enough to talk to RESTful -- APIs. In some cases, however, you may want to add more methods (e.g. you -- work with WebDAV ); no need to -- compromise on type safety and hack, it only takes a couple of seconds to @@ -568,7 +626,7 @@ httpMethodName Proxy = Y.methodPut -- | 'DELETE' method. This data type does not allow having request body with --- 'DELETE' requests, as it should be, however some APIs may expect 'DELETE' +-- 'DELETE' requests, as it should be. However some APIs may expect 'DELETE' -- requests to have bodies, in that case define your own variation of -- 'DELETE' method and allow it to have a body. @@ -621,10 +679,10 @@ class HttpMethod a where - -- | Type function 'AllowsBody' returns type of kind 'CanHaveBody' which + -- | Type function 'AllowsBody' returns a type of kind 'CanHaveBody' which -- tells the rest of the library whether the method can have a body or - -- not. We use the special type 'CanHaveBody' “lifted” into kind instead - -- of 'Bool' to get more user-friendly compiler messages. + -- not. We use the special type 'CanHaveBody' “lifted” to kind level + -- instead of 'Bool' to get more user-friendly compiler messages. type AllowsBody a :: CanHaveBody @@ -637,7 +695,7 @@ x { L.method = httpMethodName (Proxy :: Proxy method) } ---------------------------------------------------------------------------- --- Request — URL +-- Request—URL -- $url -- @@ -646,7 +704,7 @@ -- | Request's 'Url'. Start constructing your 'Url' with 'http' or 'https' -- specifying the scheme and host at the same time. Then use the @('/~')@ --- and @('/:')@ operators to grow path one piece at a time. Every single +-- and @('/:')@ operators to grow the path one piece at a time. Every single -- piece of path will be url(percent)-encoded, so using @('/~')@ and -- @('/:')@ is the only way to have forward slashes between path segments. -- This approach makes working with dynamic path segments easy and safe. See @@ -673,20 +731,20 @@ -- > https "юникод.рф" -- > -- https://%D1%8E%D0%BD%D0%B8%D0%BA%D0%BE%D0%B4.%D1%80%D1%84 -data Url (scheme :: Scheme) = Url Scheme (NonEmpty T.Text) - -- NOTE The second value is path segments in reversed order. +data Url (scheme :: Scheme) = Url Scheme (NonEmpty Text) + -- NOTE The second value is the path segments in reversed order. deriving (Eq, Ord, Show, Data, Typeable, Generic) -- | Given host name, produce a 'Url' which have “http” as its scheme and -- empty path. This also sets port to @80@. -http :: T.Text -> Url 'Http +http :: Text -> Url 'Http http = Url Http . pure -- | Given host name, produce a 'Url' which have “https” as its scheme and -- empty path. This also sets port to @443@. -https :: T.Text -> Url 'Https +https :: Text -> Url 'Https https = Url Https . pure -- | Grow given 'Url' appending a single path segment to it. Note that the @@ -696,11 +754,11 @@ (/~) :: ToHttpApiData a => Url scheme -> a -> Url scheme Url secure path /~ segment = Url secure (NE.cons (toUrlPiece segment) path) --- | Type-constrained version of @('/~')@ to remove ambiguity in cases when --- next URL piece is a 'Text' literal. +-- | Type-constrained version of @('/~')@ to remove ambiguity in the cases +-- when next URL piece is a 'Text' literal. infixl 5 /: -(/:) :: Url scheme -> T.Text -> Url scheme +(/:) :: Url scheme -> Text -> Url scheme (/:) = (/~) -- | The 'parseUrlHttp' function provides an alternative method to get 'Url' @@ -731,12 +789,19 @@ -- | Get host\/collection of path pieces and possibly query parameters -- already converted to 'Option'. This function is not public. -parseUrlHelper :: ByteString -> Maybe (NonEmpty T.Text, Option scheme) +parseUrlHelper :: ByteString -> Maybe (NonEmpty Text, Option scheme) parseUrlHelper url = do let (path', query') = B.break (== 0x3f) url query = mconcat (uncurry queryParam <$> Y.parseQueryText query') - path <- NE.nonEmpty (Y.decodePathSegments path') - return (path, query) + p' :| ps <- NE.nonEmpty (Y.decodePathSegments path') + (p, port') <- + case T.break (== ':') p' of + (x, "") -> return (x, mempty) + (x, prt) -> + case TR.decimal (T.drop 1 prt) of + Right (prt',"") -> return (x, port prt') + _ -> Nothing + return (p :| ps, query <> port') instance RequestComponent (Url scheme) where getRequestMod (Url scheme segments) = Endo $ \x -> @@ -752,13 +817,13 @@ (BL.toStrict . BB.toLazyByteString . Y.encodePathSegments) path } ---------------------------------------------------------------------------- --- Request — Body +-- Request—Body -- $body -- -- A number of options for request bodies are available. The @Content-Type@ --- header is set for you automatically according to body option you use --- (it's always specified in documentation for given body option). To add +-- header is set for you automatically according to the body option you use +-- (it's always specified in documentation for a given body option). To add -- your own way to represent request body, see 'HttpBody'. -- | This data type represents empty body of an HTTP request. This is the @@ -772,7 +837,7 @@ instance HttpBody NoReqBody where getRequestBody NoReqBody = L.RequestBodyBS B.empty --- | This body option allows to use a JSON object as request body — probably +-- | This body option allows to use a JSON object as request body—probably -- the most popular format right now. Just wrap a data type that is an -- instance of 'ToJSON' type class and you are done: it will be converted to -- JSON and inserted as request body. @@ -835,7 +900,7 @@ -- | An opaque monoidal value that allows to collect URL-encoded parameters -- to be wrapped in 'ReqBodyUrlEnc'. -newtype FormUrlEncodedParam = FormUrlEncodedParam [(T.Text, Maybe T.Text)] +newtype FormUrlEncodedParam = FormUrlEncodedParam [(Text, Maybe Text)] deriving (Semigroup, Monoid) instance QueryParam FormUrlEncodedParam where @@ -849,6 +914,29 @@ -- 'ReqBodyMultipart', as its constructor is not exported on purpose. -- -- @since 0.2.0 +-- +-- ==== __Example__ +-- +-- > import Control.Exception (throwIO) +-- > import qualified Network.HTTP.Client.MultipartFormData as LM +-- > import Network.HTTP.Req +-- > +-- > instance MonadHttp IO where +-- > handleHttpException = throwIO +-- > +-- > main :: IO () +-- > main = do +-- > body <- +-- > reqBodyMultipart +-- > [ LM.partBS "title" "My Image" +-- > , LM.partFileSource "file1" "/tmp/image.jpg" +-- > ] +-- > response <- +-- > req POST (http "example.com" /: "post") +-- > body +-- > bsResponse +-- > mempty +-- > print $ responseBody response data ReqBodyMultipart = ReqBodyMultipart ByteString LI.RequestBody @@ -867,7 +955,7 @@ body <- LM.renderParts boundary parts return (ReqBodyMultipart boundary body) --- | A type class for things that can be interpreted as HTTP +-- | A type class for things that can be interpreted as an HTTP -- 'L.RequestBody'. class HttpBody body where @@ -894,11 +982,11 @@ ProvidesBody body = 'CanHaveBody -- | This type function allows any HTTP body if method says it --- 'CanHaveBody'. When method says it should have 'NoBody', the only body --- option to use is 'NoReqBody'. +-- 'CanHaveBody'. When the method says it should have 'NoBody', the only +-- body option to use is 'NoReqBody'. -- --- __Note__: users of GHC 8.0.1 will see slightly more friendly error --- messages when method does not allow a body and body is provided. +-- __Note__: users of GHC 8.0.1 and later will see a slightly more friendly +-- error message when method does not allow a body and body is provided. type family HttpBodyAllowed (allowsBody :: CanHaveBody) @@ -921,7 +1009,7 @@ (Y.hContentType, contentType) : old } ---------------------------------------------------------------------------- --- Request — Optional parameters +-- Request—Optional parameters -- $optional-parameters -- @@ -939,9 +1027,10 @@ Option (Endo (Y.QueryText, L.Request)) (Maybe (L.Request -> IO L.Request)) -- NOTE 'QueryText' is just [(Text, Maybe Text)], we keep it along with -- Request to avoid appending to existing query string in request every - -- time new parameter is added. Additional Maybe (Endo Request) is a - -- finalizer that will be applied after all other transformations. This is - -- for authentication methods that sign requests based on data in Request. + -- time new parameter is added. Additional Maybe (L.Request -> IO + -- L.Request) is a finalizer that will be applied after all other + -- transformations. This is for authentication methods that sign requests + -- based on data in Request. instance Semigroup (Option scheme) where Option er0 mr0 <> Option er1 mr1 = Option @@ -952,7 +1041,7 @@ mappend = (<>) -- | A helper to create an 'Option' that modifies only collection of query --- parameters. This helper is not a part of public API. +-- parameters. This helper is not a part of the public API. withQueryParams :: (Y.QueryText -> Y.QueryText) -> Option scheme withQueryParams f = Option (Endo (first f)) Nothing @@ -964,7 +1053,7 @@ withRequest f = Option (Endo (second f)) Nothing -- | A helper to create an 'Option' that adds a finalizer (request --- endomorphism that is run after all other modifications). +-- transformation that is applied after all other modifications). asFinalizer :: (L.Request -> IO L.Request) -> Option scheme asFinalizer = Option mempty . pure @@ -975,20 +1064,20 @@ query = Y.renderQuery True (Y.queryTextToQuery qparams) in x' { L.queryString = query } --- | Finalize given 'L.Request' by applying a finalizer from given 'Option' --- (if it has any). +-- | Finalize given 'L.Request' by applying a finalizer from the given +-- 'Option' (if it has any). finalizeRequest :: MonadIO m => Option scheme -> L.Request -> m L.Request finalizeRequest (Option _ mfinalizer) = liftIO . fromMaybe pure mfinalizer ---------------------------------------------------------------------------- --- Request — Optional parameters — Query Parameters +-- Request—Optional parameters—Query Parameters -- $query-parameters -- -- This section describes a polymorphic interface that can be used to --- construct query parameters (of type 'Option') and form URL-encoded bodies --- (of type 'FormUrlEncodedParam'). +-- construct query parameters (of the type 'Option') and form URL-encoded +-- bodies (of the type 'FormUrlEncodedParam'). -- | This operator builds a query parameter that will be included in URL of -- your request after question sign @?@. This is the same syntax you use @@ -999,22 +1088,23 @@ -- > name =: value = queryParam name (pure value) infix 7 =: -(=:) :: (QueryParam param, ToHttpApiData a) => T.Text -> a -> param +(=:) :: (QueryParam param, ToHttpApiData a) => Text -> a -> param name =: value = queryParam name (pure value) -- | Construct a flag, that is, valueless query parameter. For example, in --- the following URL @a@ is a flag, @b@ is a query parameter with a value: +-- the following URL @a@ is a flag, while @b@ is a query parameter with a +-- value: -- -- > https://httpbin.org/foo/bar?a&b=10 -- -- This operator is defined in terms of 'queryParam': -- --- > queryFlag name = queryParam name Nothing +-- > queryFlag name = queryParam name (Nothing :: Maybe ()) -queryFlag :: QueryParam param => T.Text -> param +queryFlag :: QueryParam param => Text -> param queryFlag name = queryParam name (Nothing :: Maybe ()) --- | A type class for query-parameter-like things. The reason to have +-- | A type class for query-parameter-like things. The reason to have an -- overloaded 'queryParam' is to be able to use it as an 'Option' and as a -- 'FormUrlEncodedParam' when constructing form URL encoded request bodies. -- Having the same syntax for these cases seems natural and user-friendly. @@ -1026,14 +1116,14 @@ -- way). It's recommended to use @('=:')@ and 'queryFlag' instead of this -- method, because they are easier to read. - queryParam :: ToHttpApiData a => T.Text -> Maybe a -> param + queryParam :: ToHttpApiData a => Text -> Maybe a -> param instance QueryParam (Option scheme) where queryParam name mvalue = withQueryParams ((:) (name, toQueryParam <$> mvalue)) ---------------------------------------------------------------------------- --- Request — Optional parameters — Headers +-- Request—Optional parameters—Headers -- | Create an 'Option' that adds a header. Note that if you 'mappend' two -- headers with the same names the leftmost header will win. This means, in @@ -1054,11 +1144,11 @@ x { L.requestHeaders = (CI.mk name, value) : L.requestHeaders x } ---------------------------------------------------------------------------- --- Request — Optional parameters — Cookies +-- Request—Optional parameters—Cookies -- $cookies -- --- Support for cookies is quite minimalistic at the moment, its' possible to +-- Support for cookies is quite minimalistic at the moment. It's possible to -- specify which cookies to send using 'cookieJar' and inspect 'L.Response' -- to extract 'L.CookieJar' from it (see 'responseCookieJar'). @@ -1070,16 +1160,17 @@ x { L.cookieJar = Just jar } ---------------------------------------------------------------------------- --- Request — Optional parameters — Authentication +-- Request—Optional parameters—Authentication -- $authentication -- --- This section provides common authentication helpers in form of 'Option's. --- You should always prefer the provided authentication 'Option's to manual --- construction of headers because it ensures that you only use one --- authentication method at a time (they overwrite each other) and provides --- additional type safety that prevents leaking of credentials in cases when --- authentication relies on TLS for encrypting sensitive data. +-- This section provides the common authentication helpers in the form of +-- 'Option's. You should always prefer the provided authentication 'Option's +-- to manual construction of headers because it ensures that you only use +-- one authentication method at a time (they overwrite each other) and +-- provides additional type safety that prevents leaking of credentials in +-- the cases when authentication relies on HTTPS for encrypting sensitive +-- data. -- | The 'Option' adds basic authentication. -- @@ -1142,11 +1233,11 @@ (pure . attachHeader "Authorization" ("token " <> token)) ---------------------------------------------------------------------------- --- Request — Optional parameters — Other +-- Request—Optional parameters—Other -- | Specify the port to connect to explicitly. Normally, 'Url' you use --- determines default port, @80@ for HTTP and @443@ for HTTPS, this 'Option' --- allows to choose arbitrary port overwriting the defaults. +-- determines the default port: @80@ for HTTP and @443@ for HTTPS. This +-- 'Option' allows to choose arbitrary port overwriting the defaults. port :: Int -> Option scheme port n = withRequest $ \x -> @@ -1169,8 +1260,8 @@ decompress f = withRequest $ \x -> x { L.decompress = f } --- | Specify number of microseconds to wait for response. Default is 30 --- seconds. +-- | Specify the number of microseconds to wait for response. The default +-- value is 30 seconds. responseTimeout :: Int -- ^ Number of microseconds to wait @@ -1178,7 +1269,7 @@ responseTimeout n = withRequest $ \x -> x { L.responseTimeout = LI.ResponseTimeoutMicro n } --- | HTTP version to send to server, default is HTTP 1.1. +-- | HTTP version to send to the server, the default is HTTP 1.1. httpVersion :: Int -- ^ Major version number @@ -1199,6 +1290,7 @@ toVanillaResponse (IgnoreResponse response) = response getHttpResponse request manager = IgnoreResponse <$> liftIO (L.httpNoBody request manager) + makeResponseBodyPreview _ = return "" -- | Use this as the fourth argument of 'req' to specify that you want it to -- return the 'IgnoreResponse' interpretation. @@ -1209,18 +1301,25 @@ -- | Make a request and interpret body of response as JSON. The -- 'handleHttpException' method of 'MonadHttp' instance corresponding to -- monad in which you use 'req' will determine what to do in the case when --- parsing fails ('JsonHttpException' constructor will be used). +-- parsing fails (the 'JsonHttpException' constructor will be used). -newtype JsonResponse a = JsonResponse (L.Response a) +data JsonResponse a = JsonResponse (L.Response a) ByteString instance FromJSON a => HttpResponse (JsonResponse a) where type HttpResponseBody (JsonResponse a) = a - toVanillaResponse (JsonResponse response) = response + toVanillaResponse (JsonResponse response _) = response getHttpResponse request manager = do response <- L.httpLbs request manager case A.eitherDecode (L.responseBody response) of Left e -> throwIO (JsonHttpException e) - Right x -> return $ JsonResponse response { L.responseBody = x } + Right x -> do + let preview + = BL.toStrict + . BL.take bodyPreviewLength + . L.responseBody + $ response + return $ JsonResponse response { L.responseBody = x } preview + makeResponseBodyPreview (JsonResponse _ preview) = return preview -- | Use this as the forth argument of 'req' to specify that you want it to -- return the 'JsonResponse' interpretation. @@ -1239,6 +1338,7 @@ L.withResponse request manager $ \response -> do chunks <- L.brConsume (L.responseBody response) return $ BsResponse response { L.responseBody = B.concat chunks } + makeResponseBodyPreview = return . B.take bodyPreviewLength . responseBody -- | Use this as the forth argument of 'req' to specify that you want to -- interpret response body as a strict 'ByteString'. @@ -1256,6 +1356,7 @@ toVanillaResponse (LbsResponse response) = response getHttpResponse request manager = LbsResponse <$> L.httpLbs request manager + makeResponseBodyPreview = return . BL.toStrict . BL.take 1027 . responseBody -- | Use this as the forth argument of 'req' to specify that you want to -- interpret response body as a lazy 'BL.ByteString'. @@ -1263,31 +1364,10 @@ lbsResponse :: Proxy LbsResponse lbsResponse = Proxy --- | This interpretation does not result in any call at all, but you can use --- the 'responseRequest' function to extract 'L.Request' that 'req' has --- prepared. This is useful primarily for testing. --- --- Note that when you use this interpretation inspecting response will --- diverge (i.e. it'll blow up with an error, don't do that). - -newtype ReturnRequest = ReturnRequest L.Request - -instance HttpResponse ReturnRequest where - type HttpResponseBody ReturnRequest = () - toVanillaResponse (ReturnRequest _) = error - "Network.HTTP.Req.ReturnRequest interpretation does not make requests" - getHttpResponse request _ = return (ReturnRequest request) - --- | Use this as the forth argument of 'req' to specify that you want it to --- just return the request it consturcted without making any requests. - -returnRequest :: Proxy ReturnRequest -returnRequest = Proxy - ---------------------------------------------------------------------------- -- Inspecting a response --- | Get response body. +-- | Get the response body. responseBody :: HttpResponse response @@ -1295,7 +1375,7 @@ -> HttpResponseBody response responseBody = L.responseBody . toVanillaResponse --- | Get response status code. +-- | Get the response status code. responseStatusCode :: HttpResponse response @@ -1304,7 +1384,7 @@ responseStatusCode = Y.statusCode . L.responseStatus . toVanillaResponse --- | Get response status message. +-- | Get the response status message. responseStatusMessage :: HttpResponse response @@ -1313,7 +1393,7 @@ responseStatusMessage = Y.statusMessage . L.responseStatus . toVanillaResponse --- | Look a particular header from a response. +-- | Lookup a particular header from a response. responseHeader :: HttpResponse response @@ -1323,7 +1403,7 @@ responseHeader r h = (lookup (CI.mk h) . L.responseHeaders . toVanillaResponse) r --- | Get response 'L.CookieJar'. +-- | Get the response 'L.CookieJar'. responseCookieJar :: HttpResponse response @@ -1331,13 +1411,8 @@ -> L.CookieJar responseCookieJar = L.responseCookieJar . toVanillaResponse --- | Get the original request from 'ReturnRequest' response interpretation. - -responseRequest :: ReturnRequest -> L.Request -responseRequest (ReturnRequest request) = request - ---------------------------------------------------------------------------- --- Response — defining your own interpretation +-- Response—Defining your own interpretation -- $new-response-interpretation -- @@ -1349,20 +1424,28 @@ class HttpResponse response where - -- | The associated type is the type of body that can be extracted from a + -- | The associated type is the type of body that can be extracted from an -- instance of 'HttpResponse'. type HttpResponseBody response :: * - -- | The method describes how to get underlying 'L.Response' record. + -- | The method describes how to get the underlying 'L.Response' record. toVanillaResponse :: response -> L.Response (HttpResponseBody response) -- | This method describes how to make an HTTP request given 'L.Request' - -- (prepared by the rest of the library) and 'L.Manager'. + -- (prepared by the library) and 'L.Manager'. getHttpResponse :: L.Request -> L.Manager -> IO response + -- | Construct a “preview” of response body. It is recommend to limit the + -- length to 1024 bytes. This is mainly useful for inclusion of response + -- body fragments in exceptions. + -- + -- @since 0.3.0 + + makeResponseBodyPreview :: response -> IO ByteString + ---------------------------------------------------------------------------- -- Other @@ -1382,12 +1465,12 @@ getRequestMod :: a -> Endo L.Request --- | This wrapper is only used to attach a type-level tag to given type. +-- | This wrapper is only used to attach a type-level tag to a given type. -- This is necessary to define instances of 'RequestComponent' for any thing -- that implements 'HttpMethod' or 'HttpBody'. Without the tag, GHC can't -- see the difference between @'HttpMethod' method => 'RequestComponent' -- method@ and @'HttpBody' body => 'RequestComponent' body@ when it decides --- which instance to use (i.e. constraints are taken into account later, +-- which instance to use (i.e. the constraints are taken into account later, -- when instance is already chosen). newtype Womb (tag :: Symbol) a = Womb a @@ -1412,11 +1495,19 @@ = CanHaveBody -- ^ Indeed can have a body | NoBody -- ^ Should not have a body --- | A type-level tag that specifies URL scheme used (and thus if TLS is +-- | A type-level tag that specifies URL scheme used (and thus if HTTPS is -- enabled). This is used to force TLS requirement for some authentication -- 'Option's. data Scheme - = Http -- ^ HTTP, no TLS + = Http -- ^ HTTP | Https -- ^ HTTPS deriving (Eq, Ord, Show, Data, Typeable, Generic) + +---------------------------------------------------------------------------- +-- Constants + +-- | Max length of preview fragment of response body. + +bodyPreviewLength :: Num a => a +bodyPreviewLength = 1024 diff --git a/README.md b/README.md --- a/README.md +++ b/README.md @@ -43,61 +43,63 @@ print (responseBody r :: Value) ``` -This is an easy-to-use, type-safe, expandable, high-level HTTP library that +Req is an easy-to-use, type-safe, expandable, high-level HTTP library that just works without any fooling around. -What does the “easy-to-use” phrase mean? It means that the library is -designed to be beginner-friendly, so it's simple to add it to your monad -stack, intuitive to work with, well-documented, and does not get in your -way. Doing HTTP requests is a common task and Haskell library for this -should be very approachable and clear to beginners, thus certain compromises -were made. For example, one cannot currently modify `ManagerSettings` of -default manager because the library always uses the same implicit global -manager for simplicity and maximal connection sharing. There is a way to use -your own manager with different settings, but it requires a bit more typing. +What does the phrase “easy-to-use” mean? It means that the library is +designed to be beginner-friendly so it's simple to add to your monad stack, +intuitive to work with, well-documented, and does not get in your way. Doing +HTTP requests is a common task and a Haskell library for this should be very +approachable and clear to beginners, thus certain compromises were made. For +example, one cannot currently modify `ManagerSettings` of the default +manager because the library always uses the same implicit global manager for +simplicity and maximal connection sharing. There is a way to use your own +manager with different settings, but it requires a bit more typing. “Type-safe” means that the library is protective and eliminates certain -class of errors. For example, we have correct-by-construction URLs, it's -guaranteed that user does not send request body when using methods like GET -or OPTIONS, amount of implicit assumptions is minimized by making user -specify his/her intentions in explicit form (for example, it's not possible -to avoid specifying body or method of a request). Authentication methods -that assume TLS force user to use TLS on type level. The library carefully -hides underlying types from lower-level `http-client` package because it's -not safe enough (for example `Request` is an instance of `IsString` and if -it's malformed, it will blow up at run-time). +classes of errors. For example, we have correct-by-construction URLs, it's +guaranteed that the user does not send the request body when using methods +like GET or OPTIONS, and the amount of implicit assumptions is minimized by +making the user specify his/her intentions in an explicit form (for example, +it's not possible to avoid specifying the body or method of a request). +Authentication methods that assume HTTPS force the user to use HTTPS at the +type level. The library also carefully hides underlying types from the +lower-level `http-client` package because those types are not safe enough +(for example `Request` is an instance of `IsString` and, if it's malformed, +it will blow up at run-time). -“Expandable” refers to the ability of the library to be expanded without -ugly hacking. For example, it's possible to define your own HTTP methods, -new ways to construct body of request, new authorization options, new ways -to actually perform request and how to represent/parse response. As user -extends the library to satisfy his/her special needs, the new solutions work -just like built-ins. That said, all common cases are covered by the library -out-of-the-box. +“Expandable” refers to the ability to create new components for dealing with +HTTP without having to resort to ugly hacking. For example, it's possible to +define your own HTTP methods, create new ways to construct the body of a +request, create new authorization options, perform a request in a different +way, and create your own methods to parse and represent a response. As a +user extends the library to satisfy his/her special needs, the new solutions +will work just like the built-ins. However, all of the common cases are also +covered by the library out-of-the-box. “High-level” means that there are less details to worry about. The library -is a result of my experiences as a Haskell consultant, working for several -clients who have very different projects and so the library adapts easily to -any particular style of writing Haskell applications. For example, some -people prefer throwing exceptions, while others are concerned with purity: -just define `handleHttpException` accordingly when making your monad -instance of `MonadHttp` and it will play seamlessly. Finally, the library -cuts boilerplate considerably and helps write concise, easy to read and -maintain code. +is a result of my experiences as a Haskell consultant. Working for several +clients, who had very different projects, showed me that the library should +adapt easily to any particular style of writing Haskell applications. For +example, some people prefer throwing exceptions, while others are concerned +with purity. Just define `handleHttpException` accordingly when making your +monad instance of `MonadHttp` and it will play together seamlessly. Finally, +the library cuts boilerplate down considerably, and helps you write concise, +easy to read, and maintainable code. The library uses the following mature packages under the hood to guarantee -you best experience without bugs or other funny business: +you the best experience: -* [`http-client`](https://hackage.haskell.org/package/http-client) — low - level HTTP client used everywhere in Haskell. +* [`http-client`](https://hackage.haskell.org/package/http-client)—low level + HTTP client used everywhere in Haskell. -* [`http-client-tls`](https://hackage.haskell.org/package/http-client-tls) — - TLS (HTTPS) support for `http-client`. +* [`http-client-tls`](https://hackage.haskell.org/package/http-client-tls)—TLS + (HTTPS) support for `http-client`. It's important to note that since we leverage well-known libraries that the -whole Haskell ecosystem uses, there is no risk in using Req, as the -machinery for performing requests is the same as with `http-conduit` and -Wreq, it's just the API is different. +whole Haskell ecosystem uses, there is no risk in using Req. The machinery +for performing requests is the same as with `http-conduit` and Wreq. The +only difference is the API. ## Motivation and Req vs other libraries @@ -115,7 +117,7 @@ taste. Indeed, even the docs say that they are low-level and “intended as a base layer for more user-friendly packages”. This is exactly how I use them in Req, as base level. Req is nothing but a different API to `http-client`, -so it only works because of hard work put into `http-client`. +so it only works because of the hard work put into `http-client`. `http-conduit` definitely has its place. For one thing it allows you to stream request and response bodies in constant memory, what other library @@ -123,19 +125,19 @@ `Network.HTTP.Simple`, then although it's said that it's a “higher level API”, it's mostly the same as vanilla `http-client` in spirit/approach and just adds `conduit`-powered functions to perform requests and allows to use -global implicit `Manager` (super-cool idea, BTW, Req does the same). If I -tried to frame what exactly I don't like about `http-conduit` in words, then -it would be “the way requests are constructed”. You set, set, set instead of -*being forced* to declare necessary bits and *being allowed* to declare -optional bits in a way that their combination is certainly valid. And you -parse request from a string without the protection of TH that otherwise -saves the day as in Yesod. +global implicit `Manager` (Req does the same). If I tried to frame what +exactly I don't like about `http-conduit` in words, then it would be “the +way requests are constructed”. You set, set, set instead of *being forced* +to declare necessary bits and *being allowed* to declare optional bits in a +way that their combination is certainly valid. And you parse request from a +string without the protection of TH that otherwise saves the day as in +Yesod. Then there is Wreq. `wreq` [doesn't see much development lately](https://github.com/bos/wreq/issues/93). -`wreq` is by itself a weird library, IMO. You have functions per method — -not very good, as there may be new methods, like PATCH which is not new but +`wreq` is by itself a weird library, IMO. You have functions per method—not +very good, as there may be new methods, like PATCH which is not new but still missing (well you have `customMethod`, but what is the point of having per-method functions if you have a more general way to use any method? you should be able to just insert methods in the “argument slot” of @@ -148,14 +150,12 @@ provides, he invents the whole new thing of “sessions”. Only inside a session your connections will be shared and re-used. However with the session stuff you have yet another set of per-method functions like `get` -and `getWith` — these are different ones, to be used with sessions! Now if -you have multi-threaded app, here is a surprise for you: you can't share +and `getWith`—these are different ones, to be used with sessions! Now if you +have a multi-threaded app, here is a surprise for you: you can't share connections between threads as connections are shared only inside `withSession` friend and “session will no longer be valid after that -function returns”. Disclaimer: I don't use Wreq, see below. If something in -this paragraph is not correct, please let me know and I'll remove it. Also -there are valid uses for sessions, but the point is that they are too -inconvenient for common tasks. +function returns”. There are valid uses for sessions, but the point is that +they are just too inconvenient for common tasks. It's funny that one client I worked for had to have his own little wrapper around `http-client` just because he could not possibly use `wreq` and @@ -170,26 +170,27 @@ ## Unsolved problems -AWS request signing is problematic because request body can be in form of -action to execute (and all that “popper” stuff for streaming), not just -`ByteString` and so getting its digest (hash) is not trivial without running -the action and consuming body in its entirety before the request in made. In -Wreq the author chose to just use `error` when body is not a (strict or -lazy) `ByteString`. Maybe it's OK for Wreq, but I don't consider this proper -solution for Req as we support full variety of body options. For example -what if I want to upload 1 Gb file to S3? I want to stream it in constant -memory but at the same time I need to calculate its hash before I start -streaming. One solution to the problem seems to be in taking the hash -explicitly (as an argument of hypothetical `awsAuth`) and making it -responsibility of library user to calculate the hash correctly. I don't like +AWS request signing is problematic because request body can be in the form +of an action to execute (and all that “popper” stuff for streaming), not +just a `ByteString` and so getting its digest (hash) is not trivial without +running the action and consuming body in its entirety before the request in +made. In Wreq the author chose to just use `error` when body is not a +(strict or lazy) `ByteString`. Maybe it's OK for Wreq, but I don't consider +this a proper solution for Req as we support full variety of body options. +For example what if I want to upload 1 Gb file to S3? I want to stream it in +constant memory but at the same time I need to calculate its hash before I +start streaming. One solution to the problem seems to be in taking the hash +explicitly (as an argument of the hypothetical `awsAuth`) and making it a +responsibility of the user to calculate the hash correctly. I don't like this because it's not user-friendly. So the question stays open, for now -there is no AWS signing functionality provided out-of-the-box. +there is no AWS signing functionality provided out-of-the-box. The best +solution for talking to AWS is the `amazonka` package so far. ## Related packages The following packages are designed to be used with Req: -* [`req-conduit`](https://hackage.haskell.org/package/req-conduit) — support +* [`req-conduit`](https://hackage.haskell.org/package/req-conduit)—support for streaming request and response bodies in constant memory. If you happen to have written a package that adds new features to Req, diff --git a/httpbin-tests/Network/HTTP/ReqSpec.hs b/httpbin-tests/Network/HTTP/ReqSpec.hs --- a/httpbin-tests/Network/HTTP/ReqSpec.hs +++ b/httpbin-tests/Network/HTTP/ReqSpec.hs @@ -1,36 +1,3 @@ --- --- Tests for ‘req’ package. This test suite tests sending actual requests --- using the service. --- --- Copyright © 2016–2017 Mark Karpov --- --- 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 #-} @@ -46,12 +13,14 @@ import Control.Monad.Reader import Data.Aeson (Value (..), ToJSON (..), object, (.=)) import Data.Default.Class +import Data.IORef import Data.Monoid ((<>)) import Data.Proxy import Data.Text (Text) import Network.HTTP.Req import Test.Hspec import Test.QuickCheck +import qualified Control.Retry as R import qualified Data.Aeson as A import qualified Data.ByteString as B import qualified Data.ByteString.Lazy as BL @@ -64,6 +33,7 @@ import qualified Network.HTTP.Types as Y #if !MIN_VERSION_base(4,8,0) +import Control.Applicative import Data.Monoid (mempty) import Data.Word (Word) #endif @@ -101,9 +71,10 @@ it "works" $ do r <- req GET (httpbin /: "headers") NoReqBody jsonResponse (header "Foo" "bar" <> header "Baz" "quux") - responseBody r `shouldBe` object + stripFunnyHeaders (responseBody r) `shouldBe` object [ "headers" .= object [ "Accept-Encoding" .= ("gzip" :: Text) + , "Connection" .= ("close" :: Text) , "Foo" .= ("bar" :: Text) , "Baz" .= ("quux" :: Text) , "Host" .= ("httpbin.org" :: Text) ] ] @@ -113,11 +84,12 @@ describe "receiving GET data back" $ it "works" $ do r <- req GET (httpbin /: "get") NoReqBody jsonResponse mempty - stripOrigin (responseBody r) `shouldBe` object + (stripFunnyHeaders . stripOrigin) (responseBody r) `shouldBe` object [ "args" .= emptyObject , "url" .= ("https://httpbin.org/get" :: Text) , "headers" .= object [ "Accept-Encoding" .= ("gzip" :: Text) + , "Connection" .= ("close" :: Text) , "Host" .= ("httpbin.org" :: Text) ] ] responseHeader r "Content-Type" `shouldBe` return "application/json" responseStatusCode r `shouldBe` 200 @@ -128,7 +100,7 @@ let text = "foo" :: Text reflected = reflectJSON text r <- req POST (httpbin /: "post") (ReqBodyJson text) jsonResponse mempty - stripOrigin (responseBody r) `shouldBe` object + (stripFunnyHeaders . stripOrigin) (responseBody r) `shouldBe` object [ "args" .= emptyObject , "json" .= text , "data" .= reflected @@ -136,6 +108,7 @@ , "headers" .= object [ "Content-Type" .= ("application/json; charset=utf-8" :: Text) , "Accept-Encoding" .= ("gzip" :: Text) + , "Connection" .= ("close" :: Text) , "Host" .= ("httpbin.org" :: Text) , "Content-Length" .= show (T.length reflected) ] , "files" .= emptyObject @@ -151,7 +124,7 @@ , LM.partBS "bar" "bar data!" ] r <- req POST (httpbin /: "post") body jsonResponse mempty let Just contentType = getRequestContentType body - stripOrigin (responseBody r) `shouldBe` object + (stripFunnyHeaders . stripOrigin) (responseBody r) `shouldBe` object [ "args" .= emptyObject , "json" .= Null , "data" .= ("" :: Text) @@ -159,6 +132,7 @@ , "headers" .= object [ "Content-Type" .= T.decodeUtf8 contentType , "Accept-Encoding" .= ("gzip" :: Text) + , "Connection" .= ("close" :: Text) , "Host" .= ("httpbin.org" :: Text) , "Content-Length" .= ("242" :: Text) ] @@ -177,13 +151,14 @@ file = "httpbin-data/robots.txt" contents <- TIO.readFile file r <- req PATCH (httpbin /: "patch") (ReqBodyFile file) jsonResponse mempty - stripOrigin (responseBody r) `shouldBe` object + (stripFunnyHeaders . stripOrigin) (responseBody r) `shouldBe` object [ "args" .= emptyObject , "json" .= Null , "data" .= contents , "url" .= ("https://httpbin.org/patch" :: Text) , "headers" .= object [ "Accept-Encoding" .= ("gzip" :: Text) + , "Connection" .= ("close" :: Text) , "Host" .= ("httpbin.org" :: Text) , "Content-Length" .= show (T.length contents) ] , "files" .= emptyObject @@ -198,7 +173,7 @@ "baz" =: (5 :: Int) <> queryFlag "quux" r <- req PUT (httpbin /: "put") (ReqBodyUrlEnc params) jsonResponse mempty - stripOrigin (responseBody r) `shouldBe` object + (stripFunnyHeaders . stripOrigin) (responseBody r) `shouldBe` object [ "args" .= emptyObject , "json" .= Null , "data" .= ("" :: Text) @@ -206,6 +181,7 @@ , "headers" .= object [ "Content-Type" .= ("application/x-www-form-urlencoded" :: Text) , "Accept-Encoding" .= ("gzip" :: Text) + , "Connection" .= ("close" :: Text) , "Host" .= ("httpbin.org" :: Text) , "Content-Length" .= ("18" :: Text) ] , "files" .= emptyObject @@ -231,6 +207,15 @@ -- TODO /gzip -- TODO /deflate + describe "retrying" $ + it "retries as many times as specified" $ do + let status = 408 :: Int + nref <- newIORef (0 :: Int) + r <- countingRetries nref $ req GET (httpbin /: "status" /~ status) + NoReqBody ignoreResponse mempty + responseStatusCode r `shouldBe` status + readIORef nref `shouldReturn` 6 -- number of retries plus 1 + forM_ [101..102] checkStatusCode forM_ [200..208] checkStatusCode -- forM_ [300..308] checkStatusCode @@ -347,19 +332,36 @@ -- response status codes. prepareForShit - :: (forall m. MonadHttp m => m a) + :: ReaderT HttpConfig IO a -> IO a prepareForShit m = runReaderT m def { httpConfigCheckResponse = noNoise } - where noNoise _ _ = return () + where + noNoise _ _ = return () -- | Run request with such settings that it throws on any response. blindlyThrowing - :: (forall m. MonadHttp m => m a) + :: ReaderT HttpConfig IO a -> IO a blindlyThrowing m = runReaderT m def { httpConfigCheckResponse = doit } - where doit _ _ = error "Oops!" + where + doit _ _ = error "Oops!" +-- | Run request with such settings that every retry increments the given +-- @'IORef' 'Int'@. + +countingRetries + :: IORef Int + -> ReaderT HttpConfig IO a + -> IO a +countingRetries nref m = runReaderT m def + { httpConfigCheckResponse = noNoise + , httpConfigRetryPolicy = R.constantDelay 50000 <> R.limitRetries 5 + , httpConfigRetryJudge = judge } + where + noNoise _ _ = return () + judge _ _ = True <$ modifyIORef nref (+ 1) + -- | 'Url' representing . httpbin :: Url 'Https @@ -371,6 +373,22 @@ stripOrigin :: Value -> Value stripOrigin (Object m) = Object (HM.delete "origin" m) stripOrigin value = value + +-- | Remove funny headers that might break the tests. + +stripFunnyHeaders :: Value -> Value +stripFunnyHeaders (Object m) = + let f (Object p) = Object $ HM.filterWithKey (\k _ -> k `elem` hs) p + f value = value + hs = [ "Content-Type" + , "Accept-Encoding" + , "Connection" + , "Host" + , "Content-Length" + , "Foo" + , "Baz" ] + in Object (HM.adjust f "headers" m) +stripFunnyHeaders value = value -- | This is a complete test case that makes use of to -- get various response status codes. diff --git a/pure-tests/Network/HTTP/ReqSpec.hs b/pure-tests/Network/HTTP/ReqSpec.hs --- a/pure-tests/Network/HTTP/ReqSpec.hs +++ b/pure-tests/Network/HTTP/ReqSpec.hs @@ -1,36 +1,3 @@ --- --- Tests for ‘req’ package. This test suite tests correctness of constructed --- requests. --- --- Copyright © 2016–2017 Mark Karpov --- --- 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 DeriveGeneric #-} @@ -53,6 +20,7 @@ import Control.Monad.Reader import Data.Aeson (ToJSON (..)) import Data.ByteString (ByteString) +import Data.Default.Class import Data.Maybe (isNothing, fromJust) import Data.Monoid ((<>)) import Data.Proxy @@ -146,28 +114,36 @@ it "does not recognize non-http schemes" $ parseUrlHttp "https://httpbin.org" `shouldSatisfy` isNothing it "parses correct URLs" $ - property $ \host pieces queryParams -> - not (T.null host) && wellFormed queryParams ==> do + property $ \host mport' pieces queryParams -> do let (url', path, queryString) = - assembleUrl Http host pieces queryParams + assembleUrl Http host mport' pieces queryParams (url'', options) = fromJust (parseUrlHttp url') request <- req_ GET url'' NoReqBody options - L.host request `shouldBe` urlEncode host + L.host request `shouldBe` urlEncode (unHost host) + L.port request `shouldBe` maybe 80 getNonNegative mport' L.path request `shouldBe` path L.queryString request `shouldBe` queryString + it "rejects gibberish in port component" $ do + parseUrlHttp "http://my-site.com:bob/far" `shouldSatisfy` isNothing + parseUrlHttp "http://my-site.com:7001uh/api" `shouldSatisfy` isNothing + parseUrlHttp "http://my-site.com:/bar" `shouldSatisfy` isNothing describe "parseUrlHttps" $ do it "does not recognize non-https schemes" $ parseUrlHttps "http://httpbin.org" `shouldSatisfy` isNothing it "parses correct URLs" $ - property $ \host pieces queryParams -> - not (T.null host) && wellFormed queryParams ==> do + property $ \host mport' pieces queryParams -> do let (url', path, queryString) = - assembleUrl Https host pieces queryParams + assembleUrl Https host mport' pieces queryParams (url'', options) = fromJust (parseUrlHttps url') request <- req_ GET url'' NoReqBody options - L.host request `shouldBe` urlEncode host + L.host request `shouldBe` urlEncode (unHost host) + L.port request `shouldBe` maybe 443 getNonNegative mport' L.path request `shouldBe` path L.queryString request `shouldBe` queryString + it "rejects gibberish in port component" $ do + parseUrlHttp "https://my-site.com:bob/far" `shouldSatisfy` isNothing + parseUrlHttp "https://my-site.com:7001uh/api" `shouldSatisfy` isNothing + parseUrlHttp "https://my-site.com:/bar" `shouldSatisfy` isNothing describe "bodies" $ do describe "NoReqBody" $ @@ -330,6 +306,8 @@ httpConfigRedirectCount <- arbitrary let httpConfigAltManager = Nothing httpConfigCheckResponse _ _ = return () + httpConfigRetryPolicy = def + httpConfigRetryJudge _ _ = return False return HttpConfig {..} instance Show HttpConfig where @@ -393,6 +371,27 @@ arbitrary = secondsToDiffTime <$> arbitrary ---------------------------------------------------------------------------- +-- Helper types + +-- | A wrapper to generate correct hosts. + +newtype Host = Host { unHost :: Text } + deriving (Eq, Show) + +instance Arbitrary Host where + arbitrary = Host . T.pack <$> listOf1 (arbitrary `suchThat` (/= ':')) + +-- | A wrapper to generate correct query parameters. + +newtype QueryParams = QueryParams [(Text, Maybe Text)] + deriving (Eq, Show) + +instance Arbitrary QueryParams where + arbitrary = QueryParams <$> (arbitrary `suchThat` wellFormed) + where + wellFormed = all (not . T.null . fst) + +---------------------------------------------------------------------------- -- Helpers -- | 'req' that just returns the prepared 'L.Request'. @@ -407,8 +406,8 @@ -> body -- ^ Body of the request -> Option scheme -- ^ Collection of optional parameters -> m L.Request -- ^ Vanilla request -req_ method url' body options = - responseRequest `liftM` req method url' body returnRequest options +req_ method url' body options = req' method url' body options $ + \request _ -> return request -- | A dummy 'Url'. @@ -425,31 +424,31 @@ encodePathPieces :: [Text] -> ByteString encodePathPieces = BL.toStrict . BB.toLazyByteString . Y.encodePathSegments --- | Assemble entire URL. +-- | Assemble a URL. assembleUrl :: Scheme -- ^ Scheme - -> Text -- ^ Host + -> Host -- ^ Host + -> Maybe (NonNegative Int) -- ^ Port -> [Text] -- ^ Path pieces - -> [(Text, Maybe Text)] -- ^ Query parameters + -> QueryParams -- ^ Query parameters -> (ByteString, ByteString, ByteString) -- ^ URL, path, query string -assembleUrl scheme' host' pathPieces queryParams = - (scheme <> host <> path <> queryString, path, queryString) +assembleUrl scheme' (Host host') mport' pathPieces (QueryParams queryParams) = + (scheme <> host <> port' <> path <> queryString, path, queryString) where scheme = case scheme' of Http -> "http://" Https -> "https://" host = urlEncode host' + port' = + case mport' of + Nothing -> "" + Just (NonNegative x) -> ":" <> B8.pack (show x) path = encodePathPieces pathPieces queryString = Y.renderQuery True (Y.queryTextToQuery queryParams) renderQuery :: [(Text, Maybe Text)] -> BL.ByteString renderQuery = BL.fromStrict . Y.renderQuery False . Y.queryTextToQuery - --- | Check if collection of query params is well-formed. - -wellFormed :: [(Text, Maybe Text)] -> Bool -wellFormed = all (not . T.null . fst) -- | Convert collection of query parameters to 'FormUrlEncodedParam' thing. diff --git a/req.cabal b/req.cabal --- a/req.cabal +++ b/req.cabal @@ -1,42 +1,11 @@ --- --- Cabal configuration for ‘req’ package. --- --- Copyright © 2016–2017 Mark Karpov --- --- 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 -version: 0.2.0 +version: 0.3.0 cabal-version: >= 1.10 +tested-with: GHC==7.8.4, GHC==7.10.3, GHC==8.0.2 license: BSD3 license-file: LICENSE.md -author: Mark Karpov -maintainer: Mark Karpov +author: Mark Karpov +maintainer: Mark Karpov homepage: https://github.com/mrkkrp/req bug-reports: https://github.com/mrkkrp/req/issues category: Network, Web @@ -58,7 +27,7 @@ default: False library - build-depends: aeson >= 0.9 && < 1.2 + build-depends: aeson >= 0.9 && < 1.3 , authenticate-oauth >= 1.5 && < 1.7 , base >= 4.7 && < 5.0 , blaze-builder >= 0.3 && < 0.5 @@ -71,8 +40,9 @@ , http-client-tls >= 0.3.2 && < 0.4 , http-types >= 0.8 && < 10.0 , mtl >= 2.0 && < 3.0 + , retry >= 0.7 && < 0.8 , text >= 0.2 && < 1.3 - , time >= 1.2 && < 1.8 + , time >= 1.2 && < 1.9 , transformers >= 0.4 && < 0.6 if !impl(ghc >= 8.0) build-depends: semigroups == 0.18.* @@ -89,19 +59,20 @@ hs-source-dirs: pure-tests type: exitcode-stdio-1.0 build-depends: QuickCheck >= 2.7 && < 3.0 - , aeson >= 0.9 && < 1.2 + , aeson >= 0.9 && < 1.3 , base >= 4.7 && < 5.0 , blaze-builder >= 0.3 && < 0.5 , bytestring >= 0.10.8 && < 0.11 , case-insensitive >= 0.2 && < 1.3 + , data-default-class , hspec >= 2.0 && < 3.0 , hspec-core >= 2.0 && < 3.0 , http-client >= 0.5 && < 0.6 , http-types >= 0.8 && < 10.0 , mtl >= 2.0 && < 3.0 - , req >= 0.2.0 + , req , text >= 0.2 && < 1.3 - , time >= 1.2 && < 1.8 + , time >= 1.2 && < 1.9 if flag(dev) ghc-options: -Wall -Werror else @@ -114,7 +85,7 @@ hs-source-dirs: httpbin-tests type: exitcode-stdio-1.0 build-depends: QuickCheck >= 2.7 && < 3.0 - , aeson >= 0.9 && < 1.2 + , aeson >= 0.9 && < 1.3 , base >= 4.7 && < 5.0 , bytestring >= 0.10.8 && < 0.11 , data-default-class @@ -122,9 +93,10 @@ , http-client >= 0.5 && < 0.6 , http-types >= 0.8 && < 10.0 , mtl >= 2.0 && < 3.0 - , req >= 0.2.0 + , req + , retry >= 0.7 && < 0.8 , text >= 0.2 && < 1.3 - , unordered-containers >= 0.2.5 && < 0.2.8 + , unordered-containers >= 0.2.5 && < 0.2.9 if flag(dev) ghc-options: -Wall -Werror else