wreq-0.5.0.1: An easy-to-use HTTP client library.

Copyright(c) 2014 Bryan O'Sullivan
LicenseBSD-style
Maintainerbos@serpentine.com
Stabilityexperimental
PortabilityGHC
Safe HaskellNone
LanguageHaskell98

Network.Wreq.Lens

Contents

Description

HTTP client lens machinery.

When reading the examples in this module, you should assume the following environment:

-- Make it easy to write literal 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 (toJSON)

-- Easy traversal of JSON data.
import Data.Aeson.Lens (key, nth)

Synopsis

Configuration

data Options Source #

Options for configuring a client.

Instances

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"
 

proxy :: Lens' Options (Maybe Proxy) Source #

A lens onto proxy configuration.

Example:

let opts = defaults & proxy ?~ httpProxy "localhost" 8000
getWith opts "http://httpbin.org/get"
 

Note here the use of the ?~ setter to turn a Proxy into a Maybe Proxy, to make the type of the RHS compatible with the proxy lens.

auth :: Lens' Options (Maybe Auth) Source #

A lens onto request authentication.

Example (note the use of TLS):

let opts = defaults & auth ?~ basicAuth "user" "pass"
getWith opts "https://httpbin.org/basic-auth/user/pass"
 

header :: HeaderName -> Lens' Options [ByteString] Source #

A lens onto all headers with the given name (there can legitimately be zero or more).

Example:

let opts = defaults & header "Accept" .~ ["*/*"]
getWith opts "http://httpbin.org/get"
 

param :: Text -> Lens' Options [Text] Source #

A lens onto all query parameters with the given name (there can legitimately be zero or more).

In this example, we construct the query URL "http://httpbin.org/get?foo=bar&foo=quux".

let opts = defaults & param "foo" .~ ["bar", "quux"]
getWith opts "http://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 .~ 3
getWith opts "http://httpbin.org/redirect/5"
 

headers :: Lens' Options [Header] Source #

A lens onto all headers (there can legitimately be zero or more).

In this example, we print all the headers sent by default with every request.

print (defaults ^. headers)
 

params :: Lens' Options [(Text, Text)] Source #

A lens onto all query parameters.

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.

cookies :: Lens' Options (Maybe CookieJar) Source #

A lens onto all cookies.

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

data Proxy :: * #

proxyHost :: Lens' Proxy ByteString Source #

A lens onto the hostname portion of a proxy configuration.

proxyPort :: Lens' Proxy Int Source #

A lens onto the TCP port number 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.

cookieExpiryTime :: Lens' Cookie UTCTime Source #

A lens onto the expiry time 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.

cookieCreationTime :: Lens' Cookie UTCTime Source #

A lens onto the creation time of a cookie.

cookieLastAccessTime :: Lens' Cookie UTCTime Source #

A lens onto the last access time of a cookie.

cookiePersistent :: Lens' Cookie Bool Source #

A lens onto whether a cookie is persistent across sessions (also known as a "tracking cookie").

cookieHostOnly :: Lens' Cookie Bool Source #

A lens onto whether a cookie is host-only.

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

data Response body :: * -> * #

Instances

Functor Response 

Methods

fmap :: (a -> b) -> Response a -> Response b #

(<$) :: a -> Response b -> Response a #

Foldable Response 

Methods

fold :: Monoid m => Response m -> m #

foldMap :: Monoid m => (a -> m) -> Response a -> m #

foldr :: (a -> b -> b) -> b -> Response a -> b #

foldr' :: (a -> b -> b) -> b -> Response a -> b #

foldl :: (b -> a -> b) -> b -> Response a -> b #

foldl' :: (b -> a -> b) -> b -> Response a -> b #

foldr1 :: (a -> a -> a) -> Response a -> a #

foldl1 :: (a -> a -> a) -> Response a -> a #

toList :: Response a -> [a] #

null :: Response a -> Bool #

length :: Response a -> Int #

elem :: Eq a => a -> Response a -> Bool #

maximum :: Ord a => Response a -> a #

minimum :: Ord a => Response a -> a #

sum :: Num a => Response a -> a #

product :: Num a => Response a -> a #

Traversable Response 

Methods

traverse :: Applicative f => (a -> f b) -> Response a -> f (Response b) #

sequenceA :: Applicative f => Response (f a) -> f (Response a) #

mapM :: Monad m => (a -> m b) -> Response a -> m (Response b) #

sequence :: Monad m => Response (m a) -> m (Response a) #

Eq body => Eq (Response body) 

Methods

(==) :: Response body -> Response body -> Bool #

(/=) :: Response body -> Response body -> Bool #

Show body => Show (Response body) 

Methods

showsPrec :: Int -> Response body -> ShowS #

show :: Response body -> String #

showList :: [Response body] -> ShowS #

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)
 

responseHeader Source #

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")
 

responseLink Source #

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)
 

responseCookie Source #

Arguments

:: ByteString

Name of cookie to match.

-> Fold (Response body) Cookie 

A fold over any cookies that match the given name.

r <- get "http://www.nytimes.com/"
print (r ^? responseCookie "RMID")
 

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.

responseStatus :: Lens' (Response body) Status Source #

A lens onto the status of an HTTP response.

responseVersion :: Lens' (Response body) HttpVersion Source #

A lens onto the version of an HTTP response.

Status

statusCode :: Lens' Status Int Source #

A lens onto the numeric identifier of an HTTP status.

statusMessage :: Lens' Status ByteString Source #

A lens onto the textual description of an HTTP status.

Link header

data Link Source #

An element of a Link header.

linkURL :: Lens' Link ByteString Source #

A lens onto the URL portion of a Link element.

linkParams :: Lens' Link [(ByteString, ByteString)] Source #

A lens onto the parameters of a Link element.

POST body part

data Part :: * #

Instances

Show Part 

Methods

showsPrec :: Int -> Part -> ShowS #

show :: Part -> String #

showList :: [Part] -> ShowS #

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"]

atto_ :: Parser a -> Fold ByteString a Source #

The same as atto, but ensures that the parser consumes the entire input.

Equivalent to:

atto_ myParser = atto (myParser <* endOfInput)