req 0.1.0 → 0.2.0
raw patch · 7 files changed
+170/−45 lines, 7 filesdep +authenticate-oauthdep ~aesondep ~reqdep ~time
Dependencies added: authenticate-oauth
Dependency ranges changed: aeson, req, time, unordered-containers
Files
- CHANGELOG.md +11/−0
- LICENSE.md +1/−1
- Network/HTTP/Req.hs +82/−27
- README.md +36/−6
- httpbin-tests/Network/HTTP/ReqSpec.hs +29/−1
- pure-tests/Network/HTTP/ReqSpec.hs +1/−1
- req.cabal +10/−9
CHANGELOG.md view
@@ -1,3 +1,14 @@+## Req 0.2.0++* Added support for multipart form data in form of `ReqBodyMultipart` body+ option and `reqBodyMultipart` helper function. This also required a change+ in type signature of `getRequestContentType`, which now takes `body`, not+ `Proxy body` because we need to extract boundary from `body` and put it+ into `Content-Type` header. This change, however, shouldn't be too+ dangerous for end-users.++* Added support for OAuth 1.0 authentication via `oAuth1` option.+ ## Req 0.1.0 * Initial release.
LICENSE.md view
@@ -1,4 +1,4 @@-Copyright © 2016 Mark Karpov+Copyright © 2016–2017 Mark Karpov All rights reserved.
Network/HTTP/Req.hs view
@@ -1,6 +1,6 @@ -- | -- Module : Network.HTTP.Req--- Copyright : © 2016 Mark Karpov+-- Copyright : © 2016–2017 Mark Karpov -- License : BSD 3 clause -- -- Maintainer : Mark Karpov <markkarpov@openmailbox.org>@@ -149,6 +149,8 @@ , ReqBodyLbs (..) , ReqBodyUrlEnc (..) , FormUrlEncodedParam+ , ReqBodyMultipart+ , reqBodyMultipart , HttpBody (..) , ProvidesBody , HttpBodyAllowed@@ -168,6 +170,7 @@ -- *** Authentication -- $authentication , basicAuth+ , oAuth1 , oAuth2Bearer , oAuth2Token -- *** Other@@ -216,6 +219,7 @@ import Data.IORef import Data.List (nubBy) import Data.List.NonEmpty (NonEmpty (..))+import Data.Maybe (fromMaybe) import Data.Proxy import Data.Semigroup hiding (Option, option) import Data.Typeable (Typeable)@@ -234,8 +238,10 @@ import qualified Network.Connection as NC import qualified Network.HTTP.Client as L import qualified Network.HTTP.Client.Internal as LI+import qualified Network.HTTP.Client.MultipartFormData as LM import qualified Network.HTTP.Client.TLS as L import qualified Network.HTTP.Types as Y+import qualified Web.Authenticate.OAuth as OAuth #if MIN_VERSION_base(4,9,0) import Data.Kind (Constraint)@@ -260,12 +266,11 @@ -- @method@ is an HTTP method such as 'GET' or 'POST'. The documentation has -- a dedicated section about HTTP methods below. ----- @url@ is a URL that describes location of resource you want to interact--- with. It's of type 'Url' (if you click the link it will tell everything--- about construction of 'Url' things).+-- @url@ is a 'Url' that describes location of resource you want to interact+-- with. -- -- @body@ is a body option such as 'NoReqBody' or 'ReqBodyJson'. The--- tutorial has a section about HTTP bodies, but usage in very+-- 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@@ -393,7 +398,7 @@ -- “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 $+ 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,@@ -406,6 +411,7 @@ 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 @@ -778,7 +784,7 @@ instance ToJSON a => HttpBody (ReqBodyJson a) where getRequestBody (ReqBodyJson a) = L.RequestBodyLBS (A.encode a)- getRequestContentType Proxy = pure "application/json; charset=utf-8"+ getRequestContentType _ = pure "application/json; charset=utf-8" -- | This body option streams request body from a file. It is expected that -- the file size does not change during the streaming.@@ -824,7 +830,7 @@ instance HttpBody ReqBodyUrlEnc where getRequestBody (ReqBodyUrlEnc (FormUrlEncodedParam params)) = (L.RequestBodyLBS . BB.toLazyByteString) (Y.renderQueryText False params)- getRequestContentType Proxy = pure "application/x-www-form-urlencoded"+ getRequestContentType _ = pure "application/x-www-form-urlencoded" -- | An opaque monoidal value that allows to collect URL-encoded parameters -- to be wrapped in 'ReqBodyUrlEnc'.@@ -836,6 +842,31 @@ queryParam name mvalue = FormUrlEncodedParam [(name, toQueryParam <$> mvalue)] +-- | Multipart form data. Please consult the+-- "Network.HTTP.Client.MultipartFormData" module for how to construct+-- parts, then use 'reqBodyMultipart' to create actual request body from the+-- parts. 'reqBodyMultipart' is the only way to get a value of type+-- 'ReqBodyMultipart', as its constructor is not exported on purpose.+--+-- @since 0.2.0++data ReqBodyMultipart = ReqBodyMultipart ByteString LI.RequestBody++instance HttpBody ReqBodyMultipart where+ getRequestBody (ReqBodyMultipart _ body) = body+ getRequestContentType (ReqBodyMultipart boundary _) =+ pure ("multipart/form-data; boundary=" <> boundary)++-- | Create 'ReqBodyMultipart' request body from a collection of 'LM.Part's.+--+-- @since 0.2.0++reqBodyMultipart :: MonadIO m => [LM.Part] -> m ReqBodyMultipart+reqBodyMultipart parts = liftIO $ do+ boundary <- LM.webkitBoundary+ body <- LM.renderParts boundary parts+ return (ReqBodyMultipart boundary body)+ -- | A type class for things that can be interpreted as HTTP -- 'L.RequestBody'. @@ -851,8 +882,8 @@ -- header that should be used with particular body option. By default it -- returns 'Nothing' and so @Content-Type@ is not set. - getRequestContentType :: Proxy body -> Maybe ByteString- getRequestContentType Proxy = Nothing+ getRequestContentType :: body -> Maybe ByteString+ getRequestContentType = const Nothing -- | The type function recognizes 'NoReqBody' as having 'NoBody', while any -- other body option 'CanHaveBody'. This forces user to use 'NoReqBody' with@@ -884,7 +915,7 @@ x { L.requestBody = getRequestBody body , L.requestHeaders = let old = L.requestHeaders x in- case getRequestContentType (Proxy :: Proxy body) of+ case getRequestContentType body of Nothing -> old Just contentType -> (Y.hContentType, contentType) : old }@@ -905,12 +936,12 @@ -- to learn which 'Option' primitives are available. data Option (scheme :: Scheme) =- Option (Endo (Y.QueryText, L.Request)) (Maybe (Endo L.Request))+ 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 over options. This is for- -- authentication methods that sign requests based on data in Request.+ -- 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@@ -935,15 +966,21 @@ -- | A helper to create an 'Option' that adds a finalizer (request -- endomorphism that is run after all other modifications). -asFinalizer :: (L.Request -> L.Request) -> Option scheme-asFinalizer f = Option mempty (Just (Endo f))+asFinalizer :: (L.Request -> IO L.Request) -> Option scheme+asFinalizer = Option mempty . pure instance RequestComponent (Option scheme) where- getRequestMod (Option f finalizer) = Endo $ \x ->+ getRequestMod (Option f _) = Endo $ \x -> let (qparams, x') = appEndo f ([], x) query = Y.renderQuery True (Y.queryTextToQuery qparams)- in maybe id appEndo finalizer x' { L.queryString = query }+ in x' { L.queryString = query } +-- | Finalize given 'L.Request' by applying a finalizer from 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 @@ -1053,8 +1090,26 @@ -> ByteString -- ^ Password -> Option 'Https -- ^ Auth 'Option' basicAuth username password = asFinalizer- (L.applyBasicAuth username password)+ (pure . L.applyBasicAuth username password) +-- | The 'Option' adds OAuth1 authentication.+--+-- @since 0.2.0++oAuth1+ :: ByteString -- ^ Consumer token+ -> ByteString -- ^ Consumer secret+ -> ByteString -- ^ OAuth token+ -> ByteString -- ^ OAuth token secret+ -> Option scheme -- ^ Auth 'Option'+oAuth1 consumerToken consumerSecret token tokenSecret =+ asFinalizer (OAuth.signOAuth app creds)+ where+ app = OAuth.newOAuth+ { OAuth.oauthConsumerKey = consumerToken+ , OAuth.oauthConsumerSecret = consumerSecret }+ creds = OAuth.newCredential token tokenSecret+ -- | The 'Option' adds an OAuth2 bearer token. This is treated by many -- services as the equivalent of a username and password. --@@ -1068,7 +1123,7 @@ :: ByteString -- ^ Token -> Option 'Https -- ^ Auth 'Option' oAuth2Bearer token = asFinalizer- (attachHeader "Authorization" ("Bearer " <> token))+ (pure . attachHeader "Authorization" ("Bearer " <> token)) -- | The 'Option' adds a not-quite-standard OAuth2 bearer token (that seems -- to be used only by GitHub). This will be treated by whatever services@@ -1084,7 +1139,7 @@ :: ByteString -- ^ Token -> Option 'Https -- ^ Auth 'Option' oAuth2Token token = asFinalizer- (attachHeader "Authorization" ("token " <> token))+ (pure . attachHeader "Authorization" ("token " <> token)) ---------------------------------------------------------------------------- -- Request — Optional parameters — Other@@ -1294,7 +1349,7 @@ class HttpResponse response where - -- | The associated type is type of body that can be extracted from a+ -- | The associated type is the type of body that can be extracted from a -- instance of 'HttpResponse'. type HttpResponseBody response :: *@@ -1313,9 +1368,9 @@ -- | The main class for things that are “parts” of 'L.Request' in the sense -- that if we have a 'L.Request', then we know how to apply an instance of--- 'RequestComponent' changing\/overwriting something in it. 'Endo' is--- endomorphism of functions under composition, it's used to chain different--- request component easier using @('<>')@.+-- 'RequestComponent' changing\/overwriting something in it. 'Endo' is a+-- monoid of endomorphisms under composition, it's used to chain different+-- request components easier using @('<>')@. class RequestComponent a where @@ -1329,8 +1384,8 @@ -- | This wrapper is only used to attach a type-level tag to given type. -- This is necessary to define instances of 'RequestComponent' for any thing--- that implements 'HttpMethod' or 'HttpBody'. Without the tag, GHC is not--- able to see difference between @'HttpMethod' method => 'RequestComponent'+-- 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, -- when instance is already chosen).
README.md view
@@ -13,6 +13,36 @@ * [Contribution](#contribution) * [License](#license) +```haskell+{-# LANGUAGE OverloadedStrings #-}+{-# OPTIONS_GHC -fno-warn-orphans #-}++module Main (main) where++import Control.Exception (throwIO)+import Network.HTTP.Req+import Data.Aeson++-- Just make your monad stack an instance of MonadHttp in your application+-- and start making requests, enjoy automatic connection sharing.++instance MonadHttp IO where+ handleHttpException = throwIO++main :: IO ()+main = do+ let payload = object+ [ "foo" .= (10 :: Int)+ , "bar" .= (20 :: Int) ]+ -- One function, full power and flexibility.+ r <- req POST -- method+ (https "httpbin.org" /: "post") -- safe by construction URL+ (ReqBodyJson payload) -- use built-in options or add your own+ jsonResponse -- specify how to interpret response+ mempty -- query params, headers, explicit port number, etc.+ print (responseBody r :: Value)+```+ This is an easy-to-use, type-safe, expandable, high-level HTTP library that just works without any fooling around. @@ -115,7 +145,7 @@ is not all though, because you cannot really use `get` you see in the main module, because you want to have connection sharing. Wreq's author does not take the gift of automatic connection re-use `Manager` from `http-client`-provides, it invents the whole new thing of “sessions”. Only inside a+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@@ -129,10 +159,10 @@ 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-`http-client` and friends were too low-level. The previous paragraph-extracted from a talk with a Haskell developer who works for that client.-Then I thought to myself “something is wrong with HTTP client libraries in-Haskell if they had to make a wrapper”.+`http-client` and friends were too low-level. The previous paragraph is+extracted from a talk with a Haskell developer who works for that client. I+thought to myself “something is wrong with HTTP client libraries in Haskell+if they had to make a wrapper”. What else? I used `servant-client` a couple of times but amount of boilerplate is too high. If you have several query parameters, and you use@@ -174,6 +204,6 @@ ## License -Copyright © 2016 Mark Karpov+Copyright © 2016–2017 Mark Karpov Distributed under BSD 3 clause license.
httpbin-tests/Network/HTTP/ReqSpec.hs view
@@ -2,7 +2,7 @@ -- Tests for ‘req’ package. This test suite tests sending actual requests -- using the <https://httpbin.org> service. ----- Copyright © 2016 Mark Karpov <markkarpov@openmailbox.org>+-- Copyright © 2016–2017 Mark Karpov <markkarpov@openmailbox.org> -- -- Redistribution and use in source and binary forms, with or without -- modification, are permitted provided that the following conditions are@@ -60,6 +60,7 @@ import qualified Data.Text.Encoding as T import qualified Data.Text.IO as TIO import qualified Network.HTTP.Client as L+import qualified Network.HTTP.Client.MultipartFormData as LM import qualified Network.HTTP.Types as Y #if !MIN_VERSION_base(4,8,0)@@ -139,6 +140,33 @@ , "Content-Length" .= show (T.length reflected) ] , "files" .= emptyObject , "form" .= emptyObject ]+ responseHeader r "Content-Type" `shouldBe` return "application/json"+ responseStatusCode r `shouldBe` 200+ responseStatusMessage r `shouldBe` "OK"++ describe "receiving POST data back (multipart form data)" $+ it "works" $ do+ body <- reqBodyMultipart+ [ LM.partBS "foo" "foo data!"+ , LM.partBS "bar" "bar data!" ]+ r <- req POST (httpbin /: "post") body jsonResponse mempty+ let Just contentType = getRequestContentType body+ stripOrigin (responseBody r) `shouldBe` object+ [ "args" .= emptyObject+ , "json" .= Null+ , "data" .= ("" :: Text)+ , "url" .= ("https://httpbin.org/post" :: Text)+ , "headers" .= object+ [ "Content-Type" .= T.decodeUtf8 contentType+ , "Accept-Encoding" .= ("gzip" :: Text)+ , "Host" .= ("httpbin.org" :: Text)+ , "Content-Length" .= ("242" :: Text)+ ]+ , "files" .= emptyObject+ , "form" .= object+ [ "foo" .= ("foo data!" :: Text)+ , "bar" .= ("bar data!" :: Text) ]+ ] responseHeader r "Content-Type" `shouldBe` return "application/json" responseStatusCode r `shouldBe` 200 responseStatusMessage r `shouldBe` "OK"
pure-tests/Network/HTTP/ReqSpec.hs view
@@ -2,7 +2,7 @@ -- Tests for ‘req’ package. This test suite tests correctness of constructed -- requests. ----- Copyright © 2016 Mark Karpov <markkarpov@openmailbox.org>+-- Copyright © 2016–2017 Mark Karpov <markkarpov@openmailbox.org> -- -- Redistribution and use in source and binary forms, with or without -- modification, are permitted provided that the following conditions are
req.cabal view
@@ -1,7 +1,7 @@ -- -- Cabal configuration for ‘req’ package. ----- Copyright © 2016 Mark Karpov <markkarpov@openmailbox.org>+-- Copyright © 2016–2017 Mark Karpov <markkarpov@openmailbox.org> -- -- Redistribution and use in source and binary forms, with or without -- modification, are permitted provided that the following conditions are@@ -31,7 +31,7 @@ -- POSSIBILITY OF SUCH DAMAGE. name: req-version: 0.1.0+version: 0.2.0 cabal-version: >= 1.10 license: BSD3 license-file: LICENSE.md@@ -58,7 +58,8 @@ default: False library- build-depends: aeson >= 0.11 && < 1.1+ build-depends: aeson >= 0.9 && < 1.2+ , authenticate-oauth >= 1.5 && < 1.7 , base >= 4.7 && < 5.0 , blaze-builder >= 0.3 && < 0.5 , bytestring >= 0.10.8 && < 0.11@@ -71,7 +72,7 @@ , http-types >= 0.8 && < 10.0 , mtl >= 2.0 && < 3.0 , text >= 0.2 && < 1.3- , time >= 1.2 && < 1.7+ , time >= 1.2 && < 1.8 , transformers >= 0.4 && < 0.6 if !impl(ghc >= 8.0) build-depends: semigroups == 0.18.*@@ -88,7 +89,7 @@ hs-source-dirs: pure-tests type: exitcode-stdio-1.0 build-depends: QuickCheck >= 2.7 && < 3.0- , aeson >= 0.11 && < 1.1+ , aeson >= 0.9 && < 1.2 , base >= 4.7 && < 5.0 , blaze-builder >= 0.3 && < 0.5 , bytestring >= 0.10.8 && < 0.11@@ -98,9 +99,9 @@ , http-client >= 0.5 && < 0.6 , http-types >= 0.8 && < 10.0 , mtl >= 2.0 && < 3.0- , req >= 0.1.0+ , req >= 0.2.0 , text >= 0.2 && < 1.3- , time >= 1.2 && < 1.7+ , time >= 1.2 && < 1.8 if flag(dev) ghc-options: -Wall -Werror else@@ -113,7 +114,7 @@ hs-source-dirs: httpbin-tests type: exitcode-stdio-1.0 build-depends: QuickCheck >= 2.7 && < 3.0- , aeson >= 0.11 && < 1.1+ , aeson >= 0.9 && < 1.2 , base >= 4.7 && < 5.0 , bytestring >= 0.10.8 && < 0.11 , data-default-class@@ -121,7 +122,7 @@ , http-client >= 0.5 && < 0.6 , http-types >= 0.8 && < 10.0 , mtl >= 2.0 && < 3.0- , req >= 0.1.0+ , req >= 0.2.0 , text >= 0.2 && < 1.3 , unordered-containers >= 0.2.5 && < 0.2.8 if flag(dev)