/Network/Wreq.hs
Haskell | 623 lines | 189 code | 50 blank | 384 comment | 0 complexity | 64ac78e42f48229a3dfe16ebaf87327a MD5 | raw file
- {-# LANGUAGE FlexibleContexts, OverloadedStrings #-}
- -- |
- -- Module : Network.Wreq
- -- Copyright : (c) 2014 Bryan O'Sullivan
- --
- -- License : BSD-style
- -- Maintainer : bos@serpentine.com
- -- Stability : experimental
- -- Portability : GHC
- --
- -- A library for client-side HTTP requests, focused on ease of use.
- --
- -- When reading the examples in this module, you should assume the
- -- following environment:
- --
- -- @
- -- \-\- Make it easy to write literal 'S.ByteString' and 'Text' values.
- -- \{\-\# LANGUAGE OverloadedStrings \#\-\}
- --
- -- \-\- Our handy module.
- -- import "Network.Wreq"
- --
- -- \-\- Operators such as ('&') and ('.~').
- -- import "Control.Lens"
- --
- -- \-\- Conversion of Haskell values to JSON.
- -- import "Data.Aeson" ('Data.Aeson.toJSON')
- --
- -- \-\- Easy traversal of JSON data.
- -- import "Data.Aeson.Lens" ('Data.Aeson.Lens.key', 'Data.Aeson.Lens.nth')
- -- @
- --
- -- There exist some less frequently used lenses that are not exported
- -- from this module; these can be found in "Network.Wreq.Lens".
- module Network.Wreq
- (
- -- * HTTP verbs
- -- ** Sessions
- -- $session
- -- ** GET
- get
- , getWith
- -- ** POST
- -- $postable
- , post
- , postWith
- -- ** HEAD
- , head_
- , headWith
- -- ** OPTIONS
- , options
- , optionsWith
- -- ** PUT
- , put
- , putWith
- -- ** DELETE
- , delete
- , deleteWith
- -- ** Custom Method
- , customMethod
- , customMethodWith
- -- ** Custom Payload Method
- , customPayloadMethod
- , customPayloadMethodWith
- -- * Incremental consumption of responses
- -- ** GET
- , foldGet
- , foldGetWith
- -- * Configuration
- , Options
- , defaults
- , Lens.manager
- , Lens.header
- , Lens.param
- , Lens.redirects
- , Lens.headers
- , Lens.params
- , Lens.cookie
- , Lens.cookies
- , Lens.checkStatus
- -- ** Authentication
- -- $auth
- , Auth
- , AWSAuthVersion(..)
- , Lens.auth
- , basicAuth
- , oauth1Auth
- , oauth2Bearer
- , oauth2Token
- , awsAuth
- -- ** Proxy settings
- , Proxy(Proxy)
- , Lens.proxy
- , httpProxy
- -- ** Using a manager with defaults
- , withManager
- -- * Payloads for POST and PUT
- , Payload(..)
- -- ** URL-encoded form data
- , FormParam(..)
- , FormValue
- -- ** Multipart form data
- , Form.Part
- , Lens.partName
- , Lens.partFileName
- , Lens.partContentType
- , Lens.partGetBody
- -- *** Smart constructors
- , Form.partBS
- , Form.partLBS
- , partText
- , partString
- , Form.partFile
- , Form.partFileSource
- -- * Responses
- , Response
- , Lens.responseBody
- , Lens.responseHeader
- , Lens.responseLink
- , Lens.responseCookie
- , Lens.responseHeaders
- , Lens.responseCookieJar
- , Lens.responseStatus
- , Lens.Status
- , Lens.statusCode
- , Lens.statusMessage
- -- ** Link headers
- , Lens.Link
- , Lens.linkURL
- , Lens.linkParams
- -- ** Decoding responses
- , JSONError(..)
- , asJSON
- , asValue
- -- * Cookies
- -- $cookielenses
- , Lens.Cookie
- , Lens.cookieName
- , Lens.cookieValue
- , Lens.cookieExpiryTime
- , Lens.cookieDomain
- , Lens.cookiePath
- -- * Parsing responses
- , Lens.atto
- , Lens.atto_
- ) where
- import Control.Lens ((.~), (&))
- import Control.Monad (unless)
- import Control.Monad.Catch (MonadThrow(throwM))
- import Data.Aeson (FromJSON)
- import Data.Maybe (fromMaybe)
- import Data.Text (Text)
- import Data.Text.Encoding (encodeUtf8)
- import Network.HTTP.Client.Internal (Proxy(..), Response)
- import Network.Wreq.Internal
- import Network.Wreq.Types (Options)
- import Network.Wreq.Types hiding (Options(..))
- import Prelude hiding (head)
- import qualified Data.Aeson as Aeson
- import qualified Data.ByteString as S
- import qualified Data.ByteString.Lazy as L
- import qualified Data.Text as T
- import qualified Network.HTTP.Client as HTTP
- import qualified Network.HTTP.Client.MultipartFormData as Form
- import qualified Network.Wreq.Lens as Lens
- import qualified Network.Wreq.Types as Wreq
- import qualified Data.ByteString.Char8 as BC8
- -- | Issue a GET request.
- --
- -- Example:
- --
- -- @
- --'get' \"http:\/\/httpbin.org\/get\"
- -- @
- --
- -- >>> r <- get "http://httpbin.org/get"
- -- >>> r ^. responseStatus . statusCode
- -- 200
- get :: String -> IO (Response L.ByteString)
- get url = getWith defaults url
- withManager :: (Options -> IO a) -> IO a
- withManager act = HTTP.withManager defaultManagerSettings $ \mgr ->
- act defaults { Wreq.manager = Right mgr }
- -- | Issue a GET request, using the supplied 'Options'.
- --
- -- Example:
- --
- -- @
- --let opts = 'defaults' '&' 'Lens.param' \"foo\" '.~' [\"bar\"]
- --'getWith' opts \"http:\/\/httpbin.org\/get\"
- -- @
- --
- -- >>> let opts = defaults & param "foo" .~ ["bar"]
- -- >>> r <- getWith opts "http://httpbin.org/get"
- -- >>> r ^? responseBody . key "url"
- -- Just (String "http://httpbin.org/get?foo=bar")
- getWith :: Options -> String -> IO (Response L.ByteString)
- getWith opts url = runRead =<< prepareGet opts url
- -- | Issue a POST request.
- --
- -- Example:
- --
- -- @
- --'post' \"http:\/\/httpbin.org\/post\" ('Aeson.toJSON' [1,2,3])
- -- @
- --
- -- >>> r <- post "http://httpbin.org/post" (toJSON [1,2,3])
- -- >>> r ^? responseBody . key "json" . nth 2
- -- Just (Number 3.0)
- post :: Postable a => String -> a -> IO (Response L.ByteString)
- post url payload = postWith defaults url payload
- -- | Issue a POST request, using the supplied 'Options'.
- --
- -- Example:
- --
- -- @
- --let opts = 'defaults' '&' 'Lens.param' \"foo\" '.~' [\"bar\"]
- --'postWith' opts \"http:\/\/httpbin.org\/post\" ('Aeson.toJSON' [1,2,3])
- -- @
- --
- -- >>> let opts = defaults & param "foo" .~ ["bar"]
- -- >>> r <- postWith opts "http://httpbin.org/post" (toJSON [1,2,3])
- -- >>> r ^? responseBody . key "url"
- -- Just (String "http://httpbin.org/post?foo=bar")
- postWith :: Postable a => Options -> String -> a -> IO (Response L.ByteString)
- postWith opts url payload = runRead =<< preparePost opts url payload
- -- | Issue a HEAD request.
- --
- -- Example:
- --
- -- @
- --'head_' \"http:\/\/httpbin.org\/get\"
- -- @
- --
- -- >>> r <- head_ "http://httpbin.org/get"
- -- >>> r ^? responseHeader "Content-Type"
- -- Just "application/json"
- head_ :: String -> IO (Response ())
- head_ = headWith (defaults & Lens.redirects .~ 0)
- -- | Issue a HEAD request, using the supplied 'Options'.
- --
- -- Example:
- --
- -- @
- --let opts = 'defaults' '&' 'Lens.param' \"foo\" '.~' [\"bar\"]
- --'headWith' opts \"http:\/\/httpbin.org\/get\"
- -- @
- --
- -- >>> let opts = defaults & param "foo" .~ ["bar"]
- -- >>> r <- headWith opts "http://httpbin.org/get"
- -- >>> r ^? responseHeader "Connection"
- -- Just "keep-alive"
- headWith :: Options -> String -> IO (Response ())
- headWith opts url = runIgnore =<< prepareHead opts url
- -- | Issue a PUT request.
- put :: Putable a => String -> a -> IO (Response L.ByteString)
- put url payload = putWith defaults url payload
- -- | Issue a PUT request, using the supplied 'Options'.
- putWith :: Putable a => Options -> String -> a -> IO (Response L.ByteString)
- putWith opts url payload = runRead =<< preparePut opts url payload
- -- | Issue an OPTIONS request.
- --
- -- Example:
- --
- -- @
- --'options' \"http:\/\/httpbin.org\/get\"
- -- @
- --
- -- See 'Lens.atto' for a more complex worked example.
- options :: String -> IO (Response ())
- options = optionsWith defaults
- -- | Issue an OPTIONS request, using the supplied 'Options'.
- --
- -- Example:
- --
- -- @
- --let opts = 'defaults' '&' 'Lens.param' \"foo\" '.~' [\"bar\"]
- --'optionsWith' opts \"http:\/\/httpbin.org\/get\"
- -- @
- optionsWith :: Options -> String -> IO (Response ())
- optionsWith opts url = runIgnore =<< prepareOptions opts url
- -- | Issue a DELETE request.
- --
- -- Example:
- --
- -- @
- --'delete' \"http:\/\/httpbin.org\/delete\"
- -- @
- --
- -- >>> r <- delete "http://httpbin.org/delete"
- -- >>> r ^. responseStatus . statusCode
- -- 200
- delete :: String -> IO (Response L.ByteString)
- delete = deleteWith defaults
- -- | Issue a DELETE request, using the supplied 'Options'.
- --
- -- Example:
- --
- -- @
- --let opts = 'defaults' '&' 'Lens.redirects' '.~' 0
- --'deleteWith' opts \"http:\/\/httpbin.org\/delete\"
- -- @
- --
- -- >>> let opts = defaults & redirects .~ 0
- -- >>> r <- deleteWith opts "http://httpbin.org/delete"
- -- >>> r ^. responseStatus . statusCode
- -- 200
- deleteWith :: Options -> String -> IO (Response L.ByteString)
- deleteWith opts url = runRead =<< prepareDelete opts url
- -- | Issue a custom-method request
- --
- -- Example:
- -- @
- -- 'customMethod' \"PATCH\" \"http:\/\/httpbin.org\/patch\"
- -- @
- --
- -- >>> r <- customMethod "PATCH" "http://httpbin.org/patch"
- -- >>> r ^. responseStatus . statusCode
- -- 200
- customMethod :: String -> String -> IO (Response L.ByteString)
- customMethod method url = customMethodWith method defaults url
- -- | Issue a custom request method request, using the supplied 'Options'.
- --
- -- Example:
- --
- -- @
- --let opts = 'defaults' '&' 'Lens.redirects' '.~' 0
- --'customMethodWith' \"PATCH\" opts \"http:\/\/httpbin.org\/patch\"
- -- @
- --
- -- >>> let opts = defaults & redirects .~ 0
- -- >>> r <- customMethodWith "PATCH" opts "http://httpbin.org/patch"
- -- >>> r ^. responseStatus . statusCode
- -- 200
- customMethodWith :: String -> Options -> String -> IO (Response L.ByteString)
- customMethodWith method opts url = runRead =<< prepareMethod methodBS opts url
- where
- methodBS = BC8.pack method
- -- | Issue a custom-method request with a payload
- customPayloadMethod :: Postable a => String -> String -> a
- -> IO (Response L.ByteString)
- customPayloadMethod method url payload =
- customPayloadMethodWith method defaults url payload
- -- | Issue a custom-method request with a payload, using the supplied 'Options'.
- customPayloadMethodWith :: Postable a => String -> Options -> String -> a
- -> IO (Response L.ByteString)
-
- customPayloadMethodWith method opts url payload =
- runRead =<< preparePayloadMethod methodBS opts url payload
- where
- methodBS = BC8.pack method
- foldGet :: (a -> S.ByteString -> IO a) -> a -> String -> IO a
- foldGet f z url = foldGetWith defaults f z url
- foldGetWith :: Options -> (a -> S.ByteString -> IO a) -> a -> String -> IO a
- foldGetWith opts f z0 url = request return opts url (foldResponseBody f z0)
- -- | Convert the body of an HTTP response from JSON to a suitable
- -- Haskell type.
- --
- -- In this example, we use 'asJSON' in the @IO@ monad, where it will
- -- throw a 'JSONError' exception if conversion to the desired type
- -- fails.
- --
- -- @
- -- \{-\# LANGUAGE DeriveGeneric \#-\}
- --import "GHC.Generics" ('GHC.Generics.Generic')
- --
- -- \{- This Haskell type corresponds to the structure of a
- -- response body from httpbin.org. -\}
- --
- --data GetBody = GetBody {
- -- headers :: 'Data.Map.Map' 'Data.Text.Text' 'Data.Text.Text'
- -- , args :: 'Data.Map.Map' 'Data.Text.Text' 'Data.Text.Text'
- -- , origin :: 'Data.Text.Text'
- -- , url :: 'Data.Text.Text'
- -- } deriving (Show, 'GHC.Generics.Generic')
- --
- -- \-\- Get GHC to derive a 'FromJSON' instance for us.
- --instance 'FromJSON' GetBody
- --
- -- \{- The fact that we want a GetBody below will be inferred by our
- -- use of the \"headers\" accessor function. -\}
- --
- --foo = do
- -- r <- 'asJSON' =<< 'get' \"http:\/\/httpbin.org\/get\"
- -- print (headers (r 'Control.Lens.^.' 'responseBody'))
- -- @
- --
- -- If we use 'asJSON' in the 'Either' monad, it will return 'Left'
- -- with a 'JSONError' payload if conversion fails, and 'Right' with a
- -- 'Response' whose 'responseBody' is the converted value on success.
- asJSON :: (MonadThrow m, FromJSON a) =>
- Response L.ByteString -> m (Response a)
- {-# SPECIALIZE asJSON :: (FromJSON a) =>
- Response L.ByteString -> IO (Response a) #-}
- {-# SPECIALIZE asJSON :: Response L.ByteString -> IO (Response Aeson.Value) #-}
- asJSON resp = do
- let contentType = fst . S.break (==59) . fromMaybe "unknown" .
- lookup "Content-Type" . HTTP.responseHeaders $ resp
- unless ("application/json" `S.isPrefixOf` contentType) $
- throwM . JSONError $ "content type of response is " ++ show contentType
- case Aeson.eitherDecode' (HTTP.responseBody resp) of
- Left err -> throwM (JSONError err)
- Right val -> return (fmap (const val) resp)
- -- | Convert the body of an HTTP response from JSON to a 'Value'.
- --
- -- In this example, we use 'asValue' in the @IO@ monad, where it will
- -- throw a 'JSONError' exception if the conversion to 'Value' fails.
- --
- -- @
- --foo = do
- -- r <- 'asValue' =<< 'get' \"http:\/\/httpbin.org\/get\"
- -- print (r 'Control.Lens.^?' 'responseBody' . key \"headers\" . key \"User-Agent\")
- -- @
- asValue :: (MonadThrow m) => Response L.ByteString -> m (Response Aeson.Value)
- {-# SPECIALIZE asValue :: Response L.ByteString
- -> IO (Response Aeson.Value) #-}
- asValue = asJSON
- -- $auth
- --
- -- Do not use HTTP authentication unless you are using TLS encryption.
- -- These authentication tokens can easily be captured and reused by an
- -- attacker if transmitted in the clear.
- -- | Basic authentication. This consists of a plain username and
- -- password.
- --
- -- Example (note the use of TLS):
- --
- -- @
- --let opts = 'defaults' '&' 'Lens.auth' '?~' 'basicAuth' \"user\" \"pass\"
- --'getWith' opts \"https:\/\/httpbin.org\/basic-auth\/user\/pass\"
- -- @
- --
- -- Note here the use of the 'Control.Lens.?~' setter to turn an 'Auth'
- -- into a 'Maybe' 'Auth', to make the type of the RHS compatible with
- -- the 'Lens.auth' lens.
- --
- -- >>> let opts = defaults & auth ?~ basicAuth "user" "pass"
- -- >>> r <- getWith opts "https://httpbin.org/basic-auth/user/pass"
- -- >>> r ^? responseBody . key "authenticated"
- -- Just (Bool True)
- basicAuth :: S.ByteString -- ^ Username.
- -> S.ByteString -- ^ Password.
- -> Auth
- basicAuth = BasicAuth
- -- | OAuth1 authentication. This consists of a consumer token,
- -- a consumer secret, a token and a token secret
- oauth1Auth :: S.ByteString -- ^ Consumer token
- -> S.ByteString -- ^ Consumer secret
- -> S.ByteString -- ^ OAuth token
- -> S.ByteString -- ^ OAuth token secret
- -> Auth
- oauth1Auth = OAuth1
- -- | An OAuth2 bearer token. This is treated by many services as the
- -- equivalent of a username and password.
- --
- -- Example (note the use of TLS):
- --
- -- @
- --let opts = 'defaults' '&' 'Lens.auth' '?~' 'oauth2Bearer' \"1234abcd\"
- --'getWith' opts \"https:\/\/public-api.wordpress.com\/rest\/v1\/me\/\"
- -- @
- oauth2Bearer :: S.ByteString -> Auth
- oauth2Bearer = OAuth2Bearer
- -- | A not-quite-standard OAuth2 bearer token (that seems to be used
- -- only by GitHub). This will be treated by whatever services accept
- -- it as the equivalent of a username and password.
- --
- -- Example (note the use of TLS):
- --
- -- @
- --let opts = 'defaults' '&' 'Lens.auth' '?~' 'oauth2Token' \"abcd1234\"
- --'getWith' opts \"https:\/\/api.github.com\/user\"
- -- @
- oauth2Token :: S.ByteString -> Auth
- oauth2Token = OAuth2Token
- -- | AWS v4 request signature.
- --
- -- Example (note the use of TLS):
- --
- -- @
- --let opts = 'defaults' '&' 'Lens.auth' '?~' 'awsAuth AWSv4' \"key\" \"secret\"
- --'getWith' opts \"https:\/\/dynamodb.us-west-2.amazonaws.com\"
- -- @
- awsAuth :: AWSAuthVersion -> S.ByteString -> S.ByteString -> Auth
- awsAuth = AWSAuth
- -- | Proxy configuration.
- --
- -- Example:
- --
- -- @
- --let opts = 'defaults' '&' 'Lens.proxy' '?~' 'httpProxy' \"localhost\" 8000
- --'getWith' opts \"http:\/\/httpbin.org\/get\"
- -- @
- --
- -- Note here the use of the 'Control.Lens.?~' setter to turn a 'Proxy'
- -- into a 'Maybe' 'Proxy', to make the type of the RHS compatible with
- -- the 'Lens.proxy' lens.
- httpProxy :: S.ByteString -> Int -> Proxy
- httpProxy = Proxy
- -- | Make a 'Part' whose content is a strict 'T.Text', encoded as
- -- UTF-8.
- --
- -- The 'Part' does not have a file name or content type associated
- -- with it.
- partText :: Text -- ^ Name of the corresponding \<input\>.
- -> Text -- ^ The body for this 'Form.Part'.
- -> Form.Part
- partText name value = Form.partBS name (encodeUtf8 value)
- -- | Make a 'Part' whose content is a 'String', encoded as UTF-8.
- --
- -- The 'Part' does not have a file name or content type associated
- -- with it.
- partString :: Text -- ^ Name of the corresponding \<input\>.
- -> String -- ^ The body for this 'Form.Part'.
- -> Form.Part
- partString name value = Form.partBS name (encodeUtf8 (T.pack value))
- -- $session
- --
- -- The basic HTTP functions ('get', 'post', and so on) in this module
- -- have a few key drawbacks:
- --
- -- * If several requests go to the same server, there is no reuse of
- -- TCP connections.
- --
- -- * There is no management of cookies across multiple requests.
- --
- -- This makes these functions inefficient and verbose for many common
- -- uses. For greater efficiency, use the "Network.Wreq.Session"
- -- module.
- -- $cookielenses
- --
- -- These are only the most frequently-used cookie-related lenses. See
- -- "Network.Wreq.Lens" for the full accounting of them all.
- -- $postable
- --
- -- The 'Postable' class determines which Haskell types can be used as
- -- POST payloads.
- --
- -- 'Form.Part' and ['Form.Part'] give a request body with a
- -- @Content-Type@ of @multipart/form-data@. Constructor functions
- -- include 'partText' and 'Form.partFile'.
- --
- -- >>> r <- post "http://httpbin.org/post" (partText "hello" "world")
- -- >>> r ^? responseBody . key "form" . key "hello"
- -- Just (String "world")
- --
- -- ('S.ByteString', 'S.ByteString') and 'FormParam' (and lists of
- -- each) give a request body with a @Content-Type@ of
- -- @application/x-www-form-urlencoded@. The easiest way to use this is
- -- via the (':=') constructor.
- --
- -- >>> r <- post "http://httpbin.org/post" ["num" := 31337, "str" := "foo"]
- -- >>> r ^? responseBody . key "form" . key "num"
- -- Just (String "31337")
- --
- -- The \"magical\" type conversion on the right-hand side of ':='
- -- above is due to the 'FormValue' class. This package provides
- -- sensible instances for the standard string and number types.
- --
- -- The 'Aeson.Value' type gives a JSON request body with a
- -- @Content-Type@ of @application/json@. Any instance of
- -- 'Aeson.ToJSON' can of course be converted to a 'Aeson.Value' using
- -- 'Aeson.toJSON'.
- --
- -- >>> r <- post "http://httpbin.org/post" (toJSON [1,2,3])
- -- >>> r ^? responseBody . key "json" . nth 0
- -- Just (Number 1.0)
- -- $setup
- --
- -- >>> :set -XOverloadedStrings
- -- >>> import Control.Lens
- -- >>> import Data.Aeson (toJSON)
- -- >>> import Data.Aeson.Lens (key, nth)
- -- >>> import Network.Wreq