| Safe Haskell | None |
|---|---|
| Language | GHC2021 |
Effectful.Wreq
Contents
Synopsis
- data Wreq (a :: Type -> Type) b
- runWreq :: forall (es :: [Effect]) a. (HasCallStack, IOE :> es) => Eff (Wreq ': es) a -> Eff es a
- get :: forall (es :: [Effect]). Wreq :> es => String -> Eff es (Response ByteString)
- getWith :: forall (es :: [Effect]). Wreq :> es => Options -> String -> Eff es (Response ByteString)
- post :: forall (es :: [Effect]) a. (Wreq :> es, Postable a) => String -> a -> Eff es (Response ByteString)
- postWith :: forall (es :: [Effect]) a. (Wreq :> es, Postable a) => Options -> String -> a -> Eff es (Response ByteString)
- head_ :: forall (es :: [Effect]). Wreq :> es => String -> Eff es (Response ())
- headWith :: forall (es :: [Effect]). Wreq :> es => Options -> String -> Eff es (Response ())
- put :: forall (es :: [Effect]) a. (Wreq :> es, Putable a) => String -> a -> Eff es (Response ByteString)
- putWith :: forall (es :: [Effect]) a. (Wreq :> es, Putable a) => Options -> String -> a -> Eff es (Response ByteString)
- patch :: forall (es :: [Effect]) a. (Wreq :> es, Patchable a) => String -> a -> Eff es (Response ByteString)
- patchWith :: forall (es :: [Effect]) a. (Wreq :> es, Patchable a) => Options -> String -> a -> Eff es (Response ByteString)
- options :: forall (es :: [Effect]). Wreq :> es => String -> Eff es (Response ())
- optionsWith :: forall (es :: [Effect]). Wreq :> es => Options -> String -> Eff es (Response ())
- delete :: forall (es :: [Effect]). Wreq :> es => String -> Eff es (Response ByteString)
- deleteWith :: forall (es :: [Effect]). Wreq :> es => Options -> String -> Eff es (Response ByteString)
- customMethod :: forall (es :: [Effect]). Wreq :> es => String -> String -> Eff es (Response ByteString)
- customMethodWith :: forall (es :: [Effect]). Wreq :> es => String -> Options -> String -> Eff es (Response ByteString)
- customHistoriedMethod :: forall (es :: [Effect]). Wreq :> es => String -> String -> Eff es (HistoriedResponse ByteString)
- customHistoriedMethodWith :: forall (es :: [Effect]). Wreq :> es => String -> Options -> String -> Eff es (HistoriedResponse ByteString)
- customPayloadMethod :: forall (es :: [Effect]) a. (Wreq :> es, Postable a) => String -> String -> a -> Eff es (Response ByteString)
- customPayloadMethodWith :: forall (es :: [Effect]) a. (Wreq :> es, Postable a) => String -> Options -> String -> a -> Eff es (Response ByteString)
- customHistoriedPayloadMethod :: forall (es :: [Effect]) a. (Wreq :> es, Postable a) => String -> String -> a -> Eff es (HistoriedResponse ByteString)
- customHistoriedPayloadMethodWith :: forall (es :: [Effect]) a. (Wreq :> es, Postable a) => String -> Options -> String -> a -> Eff es (HistoriedResponse ByteString)
- data Options
- defaults :: Options
- manager :: Lens' Options (Either ManagerSettings Manager)
- 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)
- checkResponse :: Lens' Options (Maybe ResponseChecker)
- data Auth
- data AWSAuthVersion = AWSv4
- auth :: Lens' Options (Maybe Auth)
- basicAuth :: ByteString -> ByteString -> Auth
- oauth1Auth :: ByteString -> ByteString -> ByteString -> ByteString -> Auth
- oauth2Bearer :: ByteString -> Auth
- oauth2Token :: ByteString -> Auth
- awsAuth :: AWSAuthVersion -> ByteString -> ByteString -> Auth
- awsFullAuth :: AWSAuthVersion -> ByteString -> ByteString -> Maybe ByteString -> Maybe (ByteString, ByteString) -> Auth
- awsSessionTokenAuth :: AWSAuthVersion -> ByteString -> ByteString -> ByteString -> Auth
- data Proxy = Proxy ByteString Int
- proxy :: Lens' Options (Maybe Proxy)
- httpProxy :: ByteString -> Int -> Proxy
- withManager :: (Options -> IO a) -> IO a
- data Payload where
- Raw :: ContentType -> RequestBody -> Payload
- data FormParam where
- (:=) :: forall v. FormValue v => ByteString -> v -> FormParam
- class FormValue a
- type Part = PartM IO
- partName :: Lens' Part Text
- partFileName :: Lens' Part (Maybe String)
- partContentType :: Traversal' Part (Maybe MimeType)
- partGetBody :: Lens' Part (IO RequestBody)
- partBS :: forall (m :: Type -> Type). Applicative m => Text -> ByteString -> PartM m
- partLBS :: forall (m :: Type -> Type). Applicative m => Text -> ByteString -> PartM m
- partText :: Text -> Text -> Part
- partString :: Text -> String -> Part
- partFile :: Text -> FilePath -> Part
- partFileSource :: Text -> FilePath -> Part
- data Response body
- responseBody :: forall body0 body1 f. Functor f => (body0 -> f body1) -> Response body0 -> f (Response body1)
- responseHeader :: HeaderName -> Traversal' (Response body) ByteString
- responseLink :: ByteString -> ByteString -> Fold (Response body) Link
- responseCookie :: ByteString -> Fold (Response body) Cookie
- responseHeaders :: forall body f. Functor f => (ResponseHeaders -> f ResponseHeaders) -> Response body -> f (Response body)
- responseCookieJar :: forall body f. Functor f => (CookieJar -> f CookieJar) -> Response body -> f (Response body)
- responseStatus :: forall body f. Functor f => (Status -> f Status) -> Response body -> f (Response body)
- data Status
- statusCode :: Lens' Status Int
- statusMessage :: Lens' Status ByteString
- data HistoriedResponse body
- hrFinalRequest :: forall body f. Functor f => (Request -> f Request) -> HistoriedResponse body -> f (HistoriedResponse body)
- hrFinalResponse :: forall body f. Functor f => (Response body -> f (Response body)) -> HistoriedResponse body -> f (HistoriedResponse body)
- hrRedirects :: forall body f. Functor f => ([(Request, Response ByteString)] -> f [(Request, Response ByteString)]) -> HistoriedResponse body -> f (HistoriedResponse body)
- data Link
- linkURL :: Lens' Link ByteString
- linkParams :: Lens' Link [(ByteString, ByteString)]
- data JSONError = JSONError String
- asJSON :: (MonadThrow m, FromJSON a) => Response ByteString -> m (Response a)
- asValue :: MonadThrow m => Response ByteString -> m (Response Value)
- data Cookie
- cookieName :: Lens' Cookie ByteString
- cookieValue :: Lens' Cookie ByteString
- cookieExpiryTime :: Lens' Cookie UTCTime
- cookieDomain :: Lens' Cookie ByteString
- cookiePath :: Lens' Cookie ByteString
- atto :: Parser a -> Fold ByteString a
- atto_ :: Parser a -> Fold ByteString a
Effect
data Wreq (a :: Type -> Type) b Source #
Instances
| type DispatchOf Wreq Source # | |
Defined in Effectful.Wreq | |
| data StaticRep Wreq Source # | |
Defined in Effectful.Wreq | |
Handlers
runWreq :: forall (es :: [Effect]) a. (HasCallStack, IOE :> es) => Eff (Wreq ': es) a -> Eff es a Source #
Run the Wreq effect.
GET
get :: forall (es :: [Effect]). Wreq :> es => String -> Eff es (Response ByteString) Source #
Lifted get
getWith :: forall (es :: [Effect]). Wreq :> es => Options -> String -> Eff es (Response ByteString) Source #
Lifted getWith
POST
post :: forall (es :: [Effect]) a. (Wreq :> es, Postable a) => String -> a -> Eff es (Response ByteString) Source #
Lifted post
postWith :: forall (es :: [Effect]) a. (Wreq :> es, Postable a) => Options -> String -> a -> Eff es (Response ByteString) Source #
Lifted postWith
HEAD
headWith :: forall (es :: [Effect]). Wreq :> es => Options -> String -> Eff es (Response ()) Source #
Lifted headWith
PUT
put :: forall (es :: [Effect]) a. (Wreq :> es, Putable a) => String -> a -> Eff es (Response ByteString) Source #
Lifted put
putWith :: forall (es :: [Effect]) a. (Wreq :> es, Putable a) => Options -> String -> a -> Eff es (Response ByteString) Source #
Lifted putWith
PATCH
patch :: forall (es :: [Effect]) a. (Wreq :> es, Patchable a) => String -> a -> Eff es (Response ByteString) Source #
Lifted patch
patchWith :: forall (es :: [Effect]) a. (Wreq :> es, Patchable a) => Options -> String -> a -> Eff es (Response ByteString) Source #
Lifted patchWith
OPTIONS
options :: forall (es :: [Effect]). Wreq :> es => String -> Eff es (Response ()) Source #
Lifted options
optionsWith :: forall (es :: [Effect]). Wreq :> es => Options -> String -> Eff es (Response ()) Source #
Lifted optionsWith
DELETE
delete :: forall (es :: [Effect]). Wreq :> es => String -> Eff es (Response ByteString) Source #
Lifted delete
deleteWith :: forall (es :: [Effect]). Wreq :> es => Options -> String -> Eff es (Response ByteString) Source #
Lifted deleteWith
Custom Method
customMethod :: forall (es :: [Effect]). Wreq :> es => String -> String -> Eff es (Response ByteString) Source #
Lifted customMethod
customMethodWith :: forall (es :: [Effect]). Wreq :> es => String -> Options -> String -> Eff es (Response ByteString) Source #
Lifted customMethodWith
customHistoriedMethod :: forall (es :: [Effect]). Wreq :> es => String -> String -> Eff es (HistoriedResponse ByteString) Source #
Lifted customHistoriedMethod
customHistoriedMethodWith :: forall (es :: [Effect]). Wreq :> es => String -> Options -> String -> Eff es (HistoriedResponse ByteString) Source #
Lifted customHistoriedMethodWith
Custom Payload Method
customPayloadMethod :: forall (es :: [Effect]) a. (Wreq :> es, Postable a) => String -> String -> a -> Eff es (Response ByteString) Source #
Lifted customPayloadMethod
customPayloadMethodWith :: forall (es :: [Effect]) a. (Wreq :> es, Postable a) => String -> Options -> String -> a -> Eff es (Response ByteString) Source #
Lifted customPayloadMethodWith
customHistoriedPayloadMethod :: forall (es :: [Effect]) a. (Wreq :> es, Postable a) => String -> String -> a -> Eff es (HistoriedResponse ByteString) Source #
Lifted customHistoriedPayloadMethod
customHistoriedPayloadMethodWith :: forall (es :: [Effect]) a. (Wreq :> es, Postable a) => String -> Options -> String -> a -> Eff es (HistoriedResponse ByteString) Source #
Reexports
Options for configuring a client.
manager :: Lens' Options (Either ManagerSettings Manager) #
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 (opensslManagerSettingscontext)withOpenSSL$getWithopts "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 (opensslManagerSettingscontext)&manager.~Left (defaultManagerSettings{managerResponseTimeout= responseTimeoutMicro 10000 } )withOpenSSL$getWithopts "https://httpbin.org/get"
header :: HeaderName -> Lens' Options [ByteString] #
redirects :: Lens' Options Int #
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.~3getWithopts "http://httpbin.org/redirect/5"
cookie :: ByteString -> Traversal' Options Cookie #
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.
checkResponse :: Lens' Options (Maybe ResponseChecker) #
A lens to get the optional status check function
Authentication
Supported authentication types.
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.
data AWSAuthVersion #
Constructors
| AWSv4 | AWS request signing version 4 |
Instances
| Show AWSAuthVersion | |
Defined in Network.Wreq.Internal.Types Methods showsPrec :: Int -> AWSAuthVersion -> ShowS # show :: AWSAuthVersion -> String # showList :: [AWSAuthVersion] -> ShowS # | |
| Eq AWSAuthVersion | |
Defined in Network.Wreq.Internal.Types Methods (==) :: AWSAuthVersion -> AWSAuthVersion -> Bool # (/=) :: AWSAuthVersion -> AWSAuthVersion -> Bool # | |
Arguments
| :: ByteString | Username. |
| -> ByteString | Password. |
| -> Auth |
Basic authentication. This consists of a plain username and password.
Example (note the use of TLS):
let opts =defaults&auth?~basicAuth"user" "pass"getWithopts "https://httpbin.org/basic-auth/user/pass"
Note here the use of the ?~ setter to turn an Auth
into a Maybe Auth, to make the type of the RHS compatible with
the 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)
Arguments
| :: ByteString | Consumer token |
| -> ByteString | Consumer secret |
| -> ByteString | OAuth token |
| -> ByteString | OAuth token secret |
| -> Auth |
OAuth1 authentication. This consists of a consumer token, a consumer secret, a token and a token secret
oauth2Bearer :: ByteString -> Auth #
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&auth?~oauth2Bearer"1234abcd"getWithopts "https://public-api.wordpress.com/rest/v1/me/"
oauth2Token :: ByteString -> Auth #
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&auth?~oauth2Token"abcd1234"getWithopts "https://api.github.com/user"
awsAuth :: AWSAuthVersion -> ByteString -> ByteString -> Auth #
awsFullAuth :: AWSAuthVersion -> ByteString -> ByteString -> Maybe ByteString -> Maybe (ByteString, ByteString) -> Auth #
Arguments
| :: AWSAuthVersion | Signature version (V4) |
| -> ByteString | AWS AccessKeyId |
| -> ByteString | AWS SecretAccessKey |
| -> ByteString | AWS STS SessionToken |
| -> Auth |
Proxy settings
Define a HTTP proxy, consisting of a hostname and port number.
Constructors
| Proxy ByteString Int |
httpProxy :: ByteString -> Int -> Proxy #
Using a manager with defaults
withManager :: (Options -> IO a) -> IO a #
Payloads for POST and PUT
A product type for representing more complex payload types.
Constructors
| Raw :: ContentType -> RequestBody -> Payload |
URL-encoded form data
A key/value pair for an application/x-www-form-urlencoded
POST request body.
Constructors
| (:=) :: forall v. FormValue v => ByteString -> v -> FormParam infixr 3 |
A type that can be rendered as the value portion of a key/value
pair for use in an application/x-www-form-urlencoded POST
body. Intended for use with the FormParam type.
The instances for String, strict Text, and lazy
Text are all encoded using UTF-8 before being
URL-encoded.
The instance for Maybe gives an empty string on Nothing,
and otherwise uses the contained type's instance.
Minimal complete definition
Multipart form data
A lens onto the name of the input element associated with
part of a multipart form upload.
partFileName :: Lens' Part (Maybe String) #
A lens onto the filename associated with part of a multipart form upload.
partContentType :: Traversal' Part (Maybe MimeType) #
A lens onto the content-type associated with part of a multipart form upload.
partGetBody :: Lens' Part (IO RequestBody) #
A lens onto the code that fetches the data associated with part of a multipart form upload.
Smart constructors
Arguments
| :: forall (m :: Type -> Type). Applicative m | |
| => Text | Name of the corresponding <input>. |
| -> ByteString | The body for this |
| -> PartM m |
Make a Part whose content is a strict ByteString.
The Part does not have a file name or content type associated
with it.
Arguments
| :: forall (m :: Type -> Type). Applicative m | |
| => Text | Name of the corresponding <input>. |
| -> ByteString | The body for this |
| -> PartM m |
Make a Part whose content is a lazy ByteString.
The Part does not have a file name or content type associated
with it.
Make a Part whose content is a strict Text, encoded as
UTF-8.
The Part does not have a file name or content type associated
with it.
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.
Arguments
| :: Text | Name of the corresponding <input>. |
| -> FilePath | The name of the local file to upload. |
| -> Part |
Make a Part from a file.
The entire file will reside in memory at once. If you want
constant memory usage, use partFileSource.
The FilePath supplied will be used as the file name of the
Part. If you do not want to reveal this name to the server, you
must remove it prior to uploading.
The Part does not have a content type associated with it.
Responses
A simple representation of the HTTP response.
Since 0.1.0
Instances
| Foldable Response | |
Defined in Network.HTTP.Client.Types Methods fold :: Monoid m => Response m -> m # foldMap :: Monoid m => (a -> m) -> Response a -> 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 # elem :: Eq a => a -> Response a -> Bool # maximum :: Ord a => Response a -> a # minimum :: Ord a => Response a -> a # | |
| Traversable Response | |
Defined in Network.HTTP.Client.Types | |
| Functor Response | |
| Show body => Show (Response body) | |
responseBody :: forall body0 body1 f. Functor f => (body0 -> f body1) -> Response body0 -> f (Response body1) #
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 :: forall body f. Functor f => (ResponseHeaders -> f ResponseHeaders) -> Response body -> f (Response body) #
A lens onto all headers in an HTTP response.
responseCookieJar :: forall body f. Functor f => (CookieJar -> f CookieJar) -> Response body -> f (Response body) #
A lens onto all cookies set in the response.
responseStatus :: forall body f. Functor f => (Status -> f Status) -> Response body -> f (Response body) #
A lens onto the status of an HTTP response.
HTTP Status.
Only the statusCode is used for comparisons.
Please use mkStatus to create status codes from code and message, or the Enum instance or the
status code constants (like ok200). There might be additional record members in the future.
Note that the Show instance is only for debugging.
Instances
| Data Status | Since: http-types-0.12.4 | ||||
Defined in Network.HTTP.Types.Status Methods gfoldl :: (forall d b. Data d => c (d -> b) -> d -> c b) -> (forall g. g -> c g) -> Status -> c Status # gunfold :: (forall b r. Data b => c (b -> r) -> c r) -> (forall r. r -> c r) -> Constr -> c Status # toConstr :: Status -> Constr # dataTypeOf :: Status -> DataType # dataCast1 :: Typeable t => (forall d. Data d => c (t d)) -> Maybe (c Status) # dataCast2 :: Typeable t => (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c Status) # gmapT :: (forall b. Data b => b -> b) -> Status -> Status # gmapQl :: (r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> Status -> r # gmapQr :: forall r r'. (r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> Status -> r # gmapQ :: (forall d. Data d => d -> u) -> Status -> [u] # gmapQi :: Int -> (forall d. Data d => d -> u) -> Status -> u # gmapM :: Monad m => (forall d. Data d => d -> m d) -> Status -> m Status # gmapMp :: MonadPlus m => (forall d. Data d => d -> m d) -> Status -> m Status # gmapMo :: MonadPlus m => (forall d. Data d => d -> m d) -> Status -> m Status # | |||||
| Bounded Status | Since: http-types-0.11 | ||||
| Enum Status | Be advised, that when using the "enumFrom*" family of methods or ranges in lists, it will generate all possible status codes. E.g. The statuses not included in this library will have an empty message. Since: http-types-0.7.3 | ||||
Defined in Network.HTTP.Types.Status | |||||
| Generic Status | |||||
Defined in Network.HTTP.Types.Status Associated Types
| |||||
| Show Status | |||||
| Eq Status | A | ||||
| Ord Status |
| ||||
| type Rep Status | Since: http-types-0.12.4 | ||||
Defined in Network.HTTP.Types.Status type Rep Status = D1 ('MetaData "Status" "Network.HTTP.Types.Status" "http-types-0.12.4-DtPHYKkWy3CLc5cwGZx5co" 'False) (C1 ('MetaCons "Status" 'PrefixI 'True) (S1 ('MetaSel ('Just "statusCode") 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy) (Rec0 Int) :*: S1 ('MetaSel ('Just "statusMessage") 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy) (Rec0 ByteString))) | |||||
statusCode :: Lens' Status Int #
A lens onto the numeric identifier of an HTTP status.
statusMessage :: Lens' Status ByteString #
A lens onto the textual description of an HTTP status.
data HistoriedResponse body #
A datatype holding information on redirected requests and the final response.
Since 0.4.1
Instances
hrFinalRequest :: forall body f. Functor f => (Request -> f Request) -> HistoriedResponse body -> f (HistoriedResponse body) #
A lens onto the final request of a historied response.
hrFinalResponse :: forall body f. Functor f => (Response body -> f (Response body)) -> HistoriedResponse body -> f (HistoriedResponse body) #
A lens onto the final response of a historied response.
hrRedirects :: forall body f. Functor f => ([(Request, Response ByteString)] -> f [(Request, Response ByteString)]) -> HistoriedResponse body -> f (HistoriedResponse body) #
A lens onto the list of redirects of a historied response.
Link headers
An element of a Link header.
linkURL :: Lens' Link ByteString #
A lens onto the URL portion of a Link element.
linkParams :: Lens' Link [(ByteString, ByteString)] #
A lens onto the parameters of a Link element.
Decoding responses
Instances
| Exception JSONError | |
Defined in Network.Wreq.Internal.Types Methods toException :: JSONError -> SomeException # fromException :: SomeException -> Maybe JSONError # displayException :: JSONError -> String # | |
| Show JSONError | |
asJSON :: (MonadThrow m, FromJSON a) => Response ByteString -> m (Response a) #
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 (Generic)
{- This Haskell type corresponds to the structure of a
response body from httpbin.org. -}
data GetBody = GetBody {
headers :: Map Text Text
, args :: Map Text Text
, origin :: Text
, url :: Text
} deriving (Show, 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 ^. 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.
asValue :: MonadThrow m => Response ByteString -> m (Response Value) #
Cookies
cookieName :: Lens' Cookie ByteString #
A lens onto the name of a cookie.
cookieValue :: Lens' Cookie ByteString #
A lens onto the value of a cookie.
cookieExpiryTime :: Lens' Cookie UTCTime #
A lens onto the expiry time of a cookie.
cookieDomain :: Lens' Cookie ByteString #
A lens onto the domain of a cookie.
cookiePath :: Lens' Cookie ByteString #
A lens onto the path of a cookie.
Parsing responses
atto :: Parser a -> Fold ByteString a #
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 #
The same as atto, but ensures that the parser consumes the
entire input.
Equivalent to:
atto_myParser =atto(myParser<*endOfInput)