freckle-app-1.15.2.0: Haskell application toolkit used at Freckle
Safe HaskellSafe-Inferred
LanguageHaskell2010

Freckle.App.Http

Description

Centralized module for making HTTP requests

These functions:

Synopsis

Documentation

class Monad m => MonadHttp m where Source #

Type-class for making HTTP requests

Functions of this module require the MonadHttp constraint. This type class allows us to instantiate differently in different contexts, most usefully with stubbed responses in test. (See Freckle.App.Test.Http.)

The IO instance does what you would expect, and can be used to either build your own instances:

instance MonadIO m => MonadHttp (AppT m) where
  httpLbs = liftIO . httpLbs

instance MonadHttp (HandlerFor App) where
  httpLbs = liftIO . httpLbs

Or directly,

resp <- liftIO $ httpLbs ...

Instances

Instances details
MonadHttp IO Source # 
Instance details

Defined in Freckle.App.Http

Monad m => MonadHttp (HttpStubsT m) Source # 
Instance details

Defined in Freckle.App.Test.Http

(MonadReader env m, HasHttpStubs env) => MonadHttp (ReaderHttpStubs m) Source # 
Instance details

Defined in Freckle.App.Test.Http

MonadHttp m => MonadHttp (MaybeT m) Source # 
Instance details

Defined in Freckle.App.Http

MonadIO m => MonadHttp (AppT app m) Source # 
Instance details

Defined in Freckle.App

MonadHttp m => MonadHttp (ValidateT e m) Source # 
Instance details

Defined in Freckle.App.Http

MonadHttp m => MonadHttp (ExceptT e m) Source # 
Instance details

Defined in Freckle.App.Http

MonadHttp m => MonadHttp (ReaderT r m) Source # 
Instance details

Defined in Freckle.App.Http

MonadHttp m => MonadHttp (StateT s m) Source # 
Instance details

Defined in Freckle.App.Http

(Monoid w, MonadHttp m) => MonadHttp (WriterT w m) Source # 
Instance details

Defined in Freckle.App.Http

Decoding responses

httpJson :: (MonadHttp m, FromJSON a) => Request -> m (Response (Either HttpDecodeError a)) Source #

Make a request and parse the body as JSON

-- Throws, but only on a complete failure to perform the request
resp <- httpJson $ parseRequest_ "https://example.com"

-- Safe access
getResponseBody resp :: Either HttpDecodeError a

-- Unsafe access (throws on Left)
getResponseBodyUnsafe resp :: m a

httpDecode :: MonadHttp m => (ByteString -> Either (NonEmpty String) a) -> Request -> m (Response (Either HttpDecodeError a)) Source #

Make a request and decode the body using the given function

This be used to request other formats, e.g. CSV.

Pagination

httpPaginated :: (MonadHttp m, Monoid b) => (Request -> m (Response a)) -> (Response a -> m b) -> Request -> m b Source #

Request all pages of a paginated endpoint into some Monoid

For example,

Interact with a paginated endpoint where each page is a JSON list, combining all the pages into one list (i.e. concat) and throw on any decoding errors:

httpPaginated httpJson getResponseBodyUnsafe $ parseRequest_ "https://..."

This uses sourcePaginated, and so reads a Link header. To do otherwise, drop down to sourcePaginatedBy directly.

The second argument is used to extract the data to combine out of the response. This is particularly useful for Either values, like you may get from httpJson. It lives in m to support functions such as getResponseBodyUnsafe.

Decoding errors can be handled differently by adjusting what Monoid you convert each page's response into:

httpPaginated httpJson fromResponseLenient $ parseRequest_ "https://..."

fromResponseLenient
  :: MonadLogger m
  => Response (Either e [MyJsonThing])
  -> m [MyJsonThing]
fromResponseLenient r = case getResponseBody r of
     Left _ -> [] <$ logWarn "..."
     Right a -> pure a

See Freckle.Http.App.Paginate to process requested pages in a streaming fashion, or perform pagination based on somethign other than Link.

sourcePaginated Source #

Arguments

:: Monad m 
=> (Request -> m (Response body))

Run one request

-> Request

Initial request

-> ConduitT i (Response body) m () 

Stream pages of a paginated response, using Link to find next pages

Request builders

data Request #

All information on how to connect to a host and what should be sent in the HTTP request.

If you simply wish to download from a URL, see parseRequest.

The constructor for this data type is not exposed. Instead, you should use either the defaultRequest value, or parseRequest to construct from a URL, and then use the records below to make modifications. This approach allows http-client to add configuration options without breaking backwards compatibility.

For example, to construct a POST request, you could do something like:

initReq <- parseRequest "http://www.example.com/path"
let req = initReq
            { method = "POST"
            }

For more information, please see http://www.yesodweb.com/book/settings-types.

Since 0.1.0

Instances

Instances details
Show Request 
Instance details

Defined in Network.HTTP.Client.Types

HasHeaders Request Source # 
Instance details

Defined in Freckle.App.Http.Header

parseRequest :: MonadThrow m => String -> m Request #

Convert a URL into a Request.

This function defaults some of the values in Request, such as setting method to GET and requestHeaders to [].

Since this function uses MonadThrow, the return monad can be anything that is an instance of MonadThrow, such as IO or Maybe.

You can place the request method at the beginning of the URL separated by a space, e.g.:

parseRequest "POST http://httpbin.org/post"

Note that the request method must be provided as all capital letters.

A Request created by this function won't cause exceptions on non-2XX response status codes.

To create a request which throws on non-2XX status codes, see parseUrlThrow

Since: http-client-0.4.30

parseRequest_ :: String -> Request #

Same as parseRequest, but parse errors cause an impure exception. Mostly useful for static strings which are known to be correctly formatted.

Request modifiers

addRequestHeader :: HeaderName -> ByteString -> Request -> Request #

Add a request header name/value combination

Since: http-conduit-2.1.10

addToRequestQueryString :: Query -> Request -> Request #

Add to the existing query string parameters.

Since: http-conduit-2.3.5

setRequestBasicAuth #

Arguments

:: ByteString

username

-> ByteString

password

-> Request 
-> Request 

Set basic auth with the given username and password

Since: http-conduit-2.1.10

setRequestBodyJSON :: ToJSON a => a -> Request -> Request #

Set the request body as a JSON value

Note: This will not modify the request method. For that, please use requestMethod. You likely don't want the default of GET.

This also sets the Content-Type to application/json; charset=utf-8

NOTE: Depends on the aeson cabal flag being enabled

Since: http-conduit-2.1.10

setRequestBodyURLEncoded :: [(ByteString, ByteString)] -> Request -> Request #

Set the request body as URL encoded data

Note: This will change the request method to POST and set the content-type to application/x-www-form-urlencoded

Since: http-conduit-2.1.10

setRequestCheckStatus :: Request -> Request #

Modify the request so that non-2XX status codes generate a runtime StatusCodeException, by using throwErrorStatusCodes

Since: http-client-0.5.13

setRequestPath :: ByteString -> Request -> Request #

Lens for the requested path info of the request

Since: http-conduit-2.1.10

Response accessors

data Response body #

A simple representation of the HTTP response.

Since 0.1.0

Instances

Instances details
Foldable Response 
Instance details

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 #

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 
Instance details

Defined in Network.HTTP.Client.Types

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

Functor Response 
Instance details

Defined in Network.HTTP.Client.Types

Methods

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

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

Show body => Show (Response body) 
Instance details

Defined in Network.HTTP.Client.Types

Methods

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

show :: Response body -> String #

showList :: [Response body] -> ShowS #

HasHeaders (Response body) Source # 
Instance details

Defined in Freckle.App.Http.Header

getResponseStatus :: Response a -> Status #

Get the status of the response

Since: http-conduit-2.1.10

getResponseBody :: Response a -> a #

Get the response body

Since: http-conduit-2.1.10

Unsafe access

getResponseBodyUnsafe :: (MonadIO m, Exception e, HasCallStack) => Response (Either e a) -> m a Source #

Read an Either response body, throwing any Left as an exception

If you plan to use this function, and haven't built your decoding to handle error response bodies too, you'll want to use setRequestCheckStatus so that you see status-code exceptions before HttpDecodeErrors.

Exceptions

data HttpException #

An exception which may be generated by this library

Since: http-client-0.5.0

Constructors

HttpExceptionRequest Request HttpExceptionContent

Most exceptions are specific to a Request. Inspect the HttpExceptionContent value for details on what occurred.

Since: http-client-0.5.0

InvalidUrlException String String

A URL (first field) is invalid for a given reason (second argument).

Since: http-client-0.5.0

Predicates useful for handling HttpExceptions

For example, given a function guarded, which returns Just a given value when a predicate holds for it (otherwise Nothing), you can add error-handling specific to exceptions caused by 4XX responses:

flip catchJust (guard httpExceptionIsClientError *> handle4XXError) $ do
  resp <- httpJson $ setRequestCheckStatus $ parseRequest_ "http://..."
  body <- getResponseBodyUnsafe resp

  -- ...

Network.HTTP.Types re-exports

data Status #

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

Instances details
Data Status

Since: http-types-0.12.4

Instance details

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

Instance details

Defined in Network.HTTP.Types.Status

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. [status100 .. status200] generates Statuses of 100, 101, 102 .. 198, 199, 200

The statuses not included in this library will have an empty message.

Since: http-types-0.7.3

Instance details

Defined in Network.HTTP.Types.Status

Generic Status 
Instance details

Defined in Network.HTTP.Types.Status

Associated Types

type Rep Status :: Type -> Type #

Methods

from :: Status -> Rep Status x #

to :: Rep Status x -> Status #

Show Status 
Instance details

Defined in Network.HTTP.Types.Status

Eq Status

A Status is equal to another Status if the status codes are equal.

Instance details

Defined in Network.HTTP.Types.Status

Methods

(==) :: Status -> Status -> Bool #

(/=) :: Status -> Status -> Bool #

Ord Status

Statuses are ordered according to their status codes only.

Instance details

Defined in Network.HTTP.Types.Status

Serialise Status Source # 
Instance details

Defined in Freckle.App.Http.Cache.Memcached

type Rep Status

Since: http-types-0.12.4

Instance details

Defined in Network.HTTP.Types.Status

type Rep Status = D1 ('MetaData "Status" "Network.HTTP.Types.Status" "http-types-0.12.4-ANCAYszdM2i8kwZCo4KFzU" 'False) (C1 ('MetaCons "Status" 'PrefixI 'True) (S1 ('MetaSel ('Just "statusCode") 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy) (Rec0 Int) :*: S1 ('MetaSel ('Just "statusMessage") 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy) (Rec0 ByteString)))

statusIsInformational :: Status -> Bool #

Informational class

Checks if the status is in the 1XX range.

Since: http-types-0.8.0

statusIsSuccessful :: Status -> Bool #

Successful class

Checks if the status is in the 2XX range.

Since: http-types-0.8.0

statusIsRedirection :: Status -> Bool #

Redirection class

Checks if the status is in the 3XX range.

Since: http-types-0.8.0

statusIsClientError :: Status -> Bool #

Client Error class

Checks if the status is in the 4XX range.

Since: http-types-0.8.0

statusIsServerError :: Status -> Bool #

Server Error class

Checks if the status is in the 5XX range.

Since: http-types-0.8.0