Copyright | (c) 2014 Bryan O'Sullivan |
---|---|
License | BSD-style |
Maintainer | bos@serpentine.com |
Stability | experimental |
Portability | GHC |
Safe Haskell | None |
Language | Haskell98 |
Network.Wreq.Lens
Description
HTTP client lens machinery.
When reading the examples in this module, you should assume the following environment:
-- Make it easy to write literalByteString
andText
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 (toJSON
) -- Easy traversal of JSON data. import Data.Aeson.Lens (key
,nth
)
- data Options
- manager :: Lens' Options (Either ManagerSettings Manager)
- proxy :: Lens' Options (Maybe Proxy)
- auth :: Lens' Options (Maybe Auth)
- header :: HeaderName -> Lens' Options [ByteString]
- param :: Text -> Lens' Options [Text]
- redirects :: Lens' Options Int
- headers :: Lens' Options [Header]
- params :: Lens' Options [(Text, Text)]
- cookie :: ByteString -> Traversal' Options Cookie
- cookies :: Lens' Options (Maybe CookieJar)
- type ResponseChecker = Request -> Response BodyReader -> IO ()
- checkResponse :: Lens' Options (Maybe ResponseChecker)
- data Proxy :: *
- proxyHost :: Lens' Proxy ByteString
- proxyPort :: Lens' Proxy Int
- data Cookie :: *
- cookieName :: Lens' Cookie ByteString
- cookieValue :: Lens' Cookie ByteString
- cookieExpiryTime :: Lens' Cookie UTCTime
- cookieDomain :: Lens' Cookie ByteString
- cookiePath :: Lens' Cookie ByteString
- cookieCreationTime :: Lens' Cookie UTCTime
- cookieLastAccessTime :: Lens' Cookie UTCTime
- cookiePersistent :: Lens' Cookie Bool
- cookieHostOnly :: Lens' Cookie Bool
- cookieSecureOnly :: Lens' Cookie Bool
- cookieHttpOnly :: Lens' Cookie Bool
- data Response body :: * -> *
- responseBody :: Lens (Response body0) (Response body1) body0 body1
- responseHeader :: HeaderName -> Traversal' (Response body) ByteString
- responseLink :: ByteString -> ByteString -> Fold (Response body) Link
- responseCookie :: ByteString -> Fold (Response body) Cookie
- responseHeaders :: Lens' (Response body) ResponseHeaders
- responseCookieJar :: Lens' (Response body) CookieJar
- responseStatus :: Lens' (Response body) Status
- responseVersion :: Lens' (Response body) HttpVersion
- data Status :: *
- statusCode :: Lens' Status Int
- statusMessage :: Lens' Status ByteString
- data Link
- linkURL :: Lens' Link ByteString
- linkParams :: Lens' Link [(ByteString, ByteString)]
- data Part :: *
- partName :: Lens' Part Text
- partFileName :: Lens' Part (Maybe String)
- partContentType :: Traversal' Part (Maybe MimeType)
- partGetBody :: Lens' Part (IO RequestBody)
- atto :: Parser a -> Fold ByteString a
- atto_ :: Parser a -> Fold ByteString a
Configuration
manager :: Lens' Options (Either ManagerSettings Manager) Source #
A lens onto configuration of the connection manager provided by the http-client package.
In this example, we enable the use of OpenSSL for (hopefully) secure connections:
import OpenSSL.Session (context
) import Network.HTTP.Client.OpenSSL let opts =defaults
&
manager
.~
Left (opensslManagerSettings
context
)withOpenSSL
$getWith
opts "https://httpbin.org/get"
In this example, we also set the response timeout to 10000 microseconds:
import OpenSSL.Session (context
) import Network.HTTP.Client.OpenSSL import Network.HTTP.Client (defaultManagerSettings
,managerResponseTimeout
) let opts =defaults
&
manager
.~
Left (opensslManagerSettings
context
)&
manager
.~
Left (defaultManagerSettings
{managerResponseTimeout
= Just 10000 } )withOpenSSL
$getWith
opts "https://httpbin.org/get"
redirects :: Lens' Options Int Source #
A lens onto the maximum number of redirects that will be followed before an exception is thrown.
In this example, a HttpException
will be
thrown with a TooManyRedirects
constructor,
because the maximum number of redirects allowed will be exceeded.
let opts =defaults
&
redirects
.~
3getWith
opts "http://httpbin.org/redirect/5"
cookie :: ByteString -> Traversal' Options Cookie Source #
A traversal onto the cookie with the given name, if one exists.
N.B. This is an "illegal" Traversal'
: we can change the
cookieName
of the associated Cookie
so that it differs from the
name provided to this function.
type ResponseChecker = Request -> Response BodyReader -> IO () Source #
A function that checks the result of a HTTP request and potentially returns an exception.
checkResponse :: Lens' Options (Maybe ResponseChecker) Source #
A lens to get the optional status check function
Proxy setup
proxyHost :: Lens' Proxy ByteString Source #
A lens onto the hostname portion of a proxy configuration.
Cookie
cookieName :: Lens' Cookie ByteString Source #
A lens onto the name of a cookie.
cookieValue :: Lens' Cookie ByteString Source #
A lens onto the value of a cookie.
cookieDomain :: Lens' Cookie ByteString Source #
A lens onto the domain of a cookie.
cookiePath :: Lens' Cookie ByteString Source #
A lens onto the path of a cookie.
cookiePersistent :: Lens' Cookie Bool Source #
A lens onto whether a cookie is persistent across sessions (also known as a "tracking cookie").
cookieSecureOnly :: Lens' Cookie Bool Source #
A lens onto whether a cookie is secure-only, such that it will only be used over TLS.
cookieHttpOnly :: Lens' Cookie Bool Source #
A lens onto whether a cookie is "HTTP-only".
Such cookies should be used only by browsers when transmitting HTTP requests. They must be unavailable in non-browser environments, such as when executing JavaScript scripts.
Response
responseBody :: Lens (Response body0) (Response body1) body0 body1 Source #
A lens onto the body of a response.
r <-get
"http://httpbin.org/get" print (r^.
responseBody
)
Arguments
:: HeaderName | Header name to match. |
-> Traversal' (Response body) ByteString |
A lens onto all matching named headers in an HTTP response.
To access exactly one header (the result will be the empty string if
there is no match), use the (^.
) operator.
r <-get
"http://httpbin.org/get" print (r^.
responseHeader
"Content-Type")
To access at most one header (the result will be Nothing
if there
is no match), use the (^?
) operator.
r <-get
"http://httpbin.org/get" print (r^?
responseHeader
"Content-Transfer-Encoding")
To access all (zero or more) matching headers, use the
(^..
) operator.
r <-get
"http://httpbin.org/get" print (r^..
responseHeader
"Set-Cookie")
Arguments
:: ByteString | Parameter name to match. |
-> ByteString | Parameter value to match. |
-> Fold (Response body) Link |
A fold over Link
headers, matching on both parameter name
and value.
For example, here is a Link
header returned by the GitHub search API.
Link: <https://api.github.com/search/code?q=addClass+user%3Amozilla&page=2>; rel="next", <https://api.github.com/search/code?q=addClass+user%3Amozilla&page=34>; rel="last"
And here is an example of how we can retrieve the URL for the next
link
programatically.
r <-get
"https://api.github.com/search/code?q=addClass+user:mozilla" print (r^?
responseLink
"rel" "next" .linkURL
)
Arguments
:: ByteString | Name of cookie to match. |
-> Fold (Response body) Cookie |
responseHeaders :: Lens' (Response body) ResponseHeaders Source #
A lens onto all headers in an HTTP response.
responseCookieJar :: Lens' (Response body) CookieJar Source #
A lens onto all cookies set in the response.
responseVersion :: Lens' (Response body) HttpVersion Source #
A lens onto the version of an HTTP response.
Status
statusMessage :: Lens' Status ByteString Source #
A lens onto the textual description of an HTTP status.
Link header
linkParams :: Lens' Link [(ByteString, ByteString)] Source #
A lens onto the parameters of a Link
element.
POST body part
partName :: Lens' Part Text Source #
A lens onto the name of the input
element associated with
part of a multipart form upload.
partFileName :: Lens' Part (Maybe String) Source #
A lens onto the filename associated with part of a multipart form upload.
partContentType :: Traversal' Part (Maybe MimeType) Source #
A lens onto the content-type associated with part of a multipart form upload.
partGetBody :: Lens' Part (IO RequestBody) Source #
A lens onto the code that fetches the data associated with part of a multipart form upload.
Parsing
atto :: Parser a -> Fold ByteString a Source #
Turn an attoparsec Parser
into a Fold
.
Both headers and bodies can contain complicated data that we may need to parse.
Example: when responding to an OPTIONS request, a server may return the list of verbs it supports in any order, up to and including changing the order on every request (which httpbin.org /actually does/!). To deal with this possibility, we parse the list, then sort it.
>>>
import Data.Attoparsec.ByteString.Char8 as A
>>>
import Data.List (sort)
>>>
>>>
let comma = skipSpace >> "," >> skipSpace
>>>
let verbs = A.takeWhile isAlpha_ascii `sepBy` comma
>>>
>>>
r <- options "http://httpbin.org/get"
>>>
r ^. responseHeader "Allow" . atto verbs . to sort
["GET","HEAD","OPTIONS"]