module Freckle.App.Http
( httpJson
, HttpDecodeError(..)
, httpDecode
, httpLbs
, httpNoBody
, httpPaginated
, sourcePaginated
, Request
, parseRequest
, parseRequest_
, addRequestHeader
, addAcceptHeader
, addBearerAuthorizationHeader
, addToRequestQueryString
, setRequestBasicAuth
, setRequestBodyJSON
, setRequestBodyURLEncoded
, setRequestCheckStatus
, setRequestPath
, Response
, getResponseStatus
, getResponseBody
, getResponseBodyUnsafe
, HttpException(..)
, httpExceptionIsInformational
, httpExceptionIsRedirection
, httpExceptionIsClientError
, httpExceptionIsServerError
, Status
, statusCode
, statusIsInformational
, statusIsSuccessful
, statusIsRedirection
, statusIsClientError
, statusIsServerError
) where
import Freckle.App.Prelude
import Conduit (foldC, mapMC, runConduit, (.|))
import Data.Aeson (FromJSON)
import qualified Data.Aeson as Aeson
import qualified Data.ByteString as BS
import Data.ByteString.Lazy (ByteString)
import qualified Data.ByteString.Lazy.Char8 as BSL8
import qualified Data.List.NonEmpty as NE
import Freckle.App.Http.Paginate
import Freckle.App.Http.Retry
import Network.HTTP.Conduit (HttpExceptionContent(..))
import Network.HTTP.Simple hiding (httpLbs, httpNoBody)
import qualified Network.HTTP.Simple as HTTP
import Network.HTTP.Types.Header (hAccept, hAuthorization)
import Network.HTTP.Types.Status
( Status
, statusCode
, statusIsClientError
, statusIsInformational
, statusIsRedirection
, statusIsServerError
, statusIsSuccessful
)
import UnliftIO.Exception (Exception(..), throwIO)
data HttpDecodeError = HttpDecodeError
{ HttpDecodeError -> ByteString
hdeBody :: ByteString
, HttpDecodeError -> NonEmpty String
hdeErrors :: NonEmpty String
}
deriving stock (HttpDecodeError -> HttpDecodeError -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: HttpDecodeError -> HttpDecodeError -> Bool
$c/= :: HttpDecodeError -> HttpDecodeError -> Bool
== :: HttpDecodeError -> HttpDecodeError -> Bool
$c== :: HttpDecodeError -> HttpDecodeError -> Bool
Eq, Int -> HttpDecodeError -> ShowS
[HttpDecodeError] -> ShowS
HttpDecodeError -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [HttpDecodeError] -> ShowS
$cshowList :: [HttpDecodeError] -> ShowS
show :: HttpDecodeError -> String
$cshow :: HttpDecodeError -> String
showsPrec :: Int -> HttpDecodeError -> ShowS
$cshowsPrec :: Int -> HttpDecodeError -> ShowS
Show)
instance Exception HttpDecodeError where
displayException :: HttpDecodeError -> String
displayException HttpDecodeError {NonEmpty String
ByteString
hdeErrors :: NonEmpty String
hdeBody :: ByteString
hdeErrors :: HttpDecodeError -> NonEmpty String
hdeBody :: HttpDecodeError -> ByteString
..} =
[String] -> String
unlines
forall a b. (a -> b) -> a -> b
$ [String
"Error decoding HTTP Response:", String
"Raw body:", ByteString -> String
BSL8.unpack ByteString
hdeBody]
forall a. Semigroup a => a -> a -> a
<> forall {a}. (IsString a, Semigroup a) => NonEmpty a -> [a]
fromErrors NonEmpty String
hdeErrors
where
fromErrors :: NonEmpty a -> [a]
fromErrors = \case
a
err NE.:| [] -> [a
"Error:", a
err]
NonEmpty a
errs -> a
"Errors:" forall a. a -> [a] -> [a]
: forall a b. (a -> b) -> [a] -> [b]
map forall {a}. (Semigroup a, IsString a) => a -> a
bullet (forall a. NonEmpty a -> [a]
NE.toList NonEmpty a
errs)
bullet :: a -> a
bullet = (a
" • " forall a. Semigroup a => a -> a -> a
<>)
httpJson
:: (MonadIO m, FromJSON a)
=> Request
-> m (Response (Either HttpDecodeError a))
httpJson :: forall (m :: * -> *) a.
(MonadIO m, FromJSON a) =>
Request -> m (Response (Either HttpDecodeError a))
httpJson = forall (m :: * -> *) a.
MonadIO m =>
(ByteString -> Either (NonEmpty String) a)
-> Request -> m (Response (Either HttpDecodeError a))
httpDecode (forall (p :: * -> * -> *) a b c.
Bifunctor p =>
(a -> b) -> p a c -> p b c
first forall (f :: * -> *) a. Applicative f => a -> f a
pure forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. FromJSON a => ByteString -> Either String a
Aeson.eitherDecode)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> Request -> Request
addAcceptHeader ByteString
"application/json"
httpDecode
:: MonadIO m
=> (ByteString -> Either (NonEmpty String) a)
-> Request
-> m (Response (Either HttpDecodeError a))
httpDecode :: forall (m :: * -> *) a.
MonadIO m =>
(ByteString -> Either (NonEmpty String) a)
-> Request -> m (Response (Either HttpDecodeError a))
httpDecode ByteString -> Either (NonEmpty String) a
decode Request
req = do
Response ByteString
resp <- forall (m :: * -> *).
MonadIO m =>
Request -> m (Response ByteString)
httpLbs Request
req
let body :: ByteString
body = forall a. Response a -> a
getResponseBody Response ByteString
resp
forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ forall (p :: * -> * -> *) a b c.
Bifunctor p =>
(a -> b) -> p a c -> p b c
first (ByteString -> NonEmpty String -> HttpDecodeError
HttpDecodeError ByteString
body) forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> Either (NonEmpty String) a
decode forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Response ByteString
resp
httpLbs :: MonadIO m => Request -> m (Response ByteString)
httpLbs :: forall (m :: * -> *).
MonadIO m =>
Request -> m (Response ByteString)
httpLbs = forall (m :: * -> *) body.
MonadIO m =>
(Request -> m (Response body)) -> Request -> m (Response body)
rateLimited forall (m :: * -> *).
MonadIO m =>
Request -> m (Response ByteString)
httpLBS
httpNoBody :: MonadIO m => Request -> m (Response ())
httpNoBody :: forall (m :: * -> *). MonadIO m => Request -> m (Response ())
httpNoBody = forall (m :: * -> *) body.
MonadIO m =>
(Request -> m (Response body)) -> Request -> m (Response body)
rateLimited forall (m :: * -> *). MonadIO m => Request -> m (Response ())
HTTP.httpNoBody
httpPaginated
:: (MonadIO m, Monoid b)
=> (Request -> m (Response a))
-> (Response a -> m b)
-> Request
-> m b
httpPaginated :: forall (m :: * -> *) b a.
(MonadIO m, Monoid b) =>
(Request -> m (Response a))
-> (Response a -> m b) -> Request -> m b
httpPaginated Request -> m (Response a)
runRequest Response a -> m b
getBody Request
req =
forall (m :: * -> *) r. Monad m => ConduitT () Void m r -> m r
runConduit forall a b. (a -> b) -> a -> b
$ forall (m :: * -> *) body i.
MonadIO m =>
(Request -> m (Response body))
-> Request -> ConduitT i (Response body) m ()
sourcePaginated Request -> m (Response a)
runRequest Request
req forall (m :: * -> *) a b c r.
Monad m =>
ConduitM a b m () -> ConduitM b c m r -> ConduitM a c m r
.| forall (m :: * -> *) a b.
Monad m =>
(a -> m b) -> ConduitT a b m ()
mapMC Response a -> m b
getBody forall (m :: * -> *) a b c r.
Monad m =>
ConduitM a b m () -> ConduitM b c m r -> ConduitM a c m r
.| forall (m :: * -> *) a o. (Monad m, Monoid a) => ConduitT a o m a
foldC
addAcceptHeader :: BS.ByteString -> Request -> Request
= HeaderName -> ByteString -> Request -> Request
addRequestHeader HeaderName
hAccept
addBearerAuthorizationHeader :: BS.ByteString -> Request -> Request
= HeaderName -> ByteString -> Request -> Request
addRequestHeader HeaderName
hAuthorization forall b c a. (b -> c) -> (a -> b) -> a -> c
. (ByteString
"Bearer " forall a. Semigroup a => a -> a -> a
<>)
getResponseBodyUnsafe
:: (MonadIO m, Exception e) => Response (Either e a) -> m a
getResponseBodyUnsafe :: forall (m :: * -> *) e a.
(MonadIO m, Exception e) =>
Response (Either e a) -> m a
getResponseBodyUnsafe = forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either forall (m :: * -> *) e a. (MonadIO m, Exception e) => e -> m a
throwIO forall (f :: * -> *) a. Applicative f => a -> f a
pure forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Response a -> a
getResponseBody
httpExceptionIsInformational :: HttpException -> Bool
httpExceptionIsInformational :: HttpException -> Bool
httpExceptionIsInformational = (Status -> Bool) -> HttpException -> Bool
filterStatusException Status -> Bool
statusIsInformational
httpExceptionIsRedirection :: HttpException -> Bool
httpExceptionIsRedirection :: HttpException -> Bool
httpExceptionIsRedirection = (Status -> Bool) -> HttpException -> Bool
filterStatusException Status -> Bool
statusIsRedirection
httpExceptionIsClientError :: HttpException -> Bool
httpExceptionIsClientError :: HttpException -> Bool
httpExceptionIsClientError = (Status -> Bool) -> HttpException -> Bool
filterStatusException Status -> Bool
statusIsClientError
httpExceptionIsServerError :: HttpException -> Bool
httpExceptionIsServerError :: HttpException -> Bool
httpExceptionIsServerError = (Status -> Bool) -> HttpException -> Bool
filterStatusException Status -> Bool
statusIsServerError
filterStatusException :: (Status -> Bool) -> HttpException -> Bool
filterStatusException :: (Status -> Bool) -> HttpException -> Bool
filterStatusException Status -> Bool
predicate = \case
HttpExceptionRequest Request
_ (StatusCodeException Response ()
resp ByteString
_) ->
Status -> Bool
predicate forall a b. (a -> b) -> a -> b
$ forall a. Response a -> Status
getResponseStatus Response ()
resp
HttpException
_ -> Bool
False