{-# LANGUAGE CPP #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE FunctionalDependencies #-}
{-# LANGUAGE GADTs #-}
{-# LANGUAGE KindSignatures #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE UndecidableInstances #-}
module GitHub.Request (
github,
github',
GitHubRW,
GitHubRO,
Request,
GenRequest (..),
CommandMethod(..),
toMethod,
Paths,
QueryString,
executeRequest,
executeRequestWithMgr,
executeRequestWithMgrAndRes,
executeRequest',
executeRequestWithMgr',
executeRequestMaybe,
unsafeDropAuthRequirements,
Accept (..),
ParseResponse (..),
makeHttpRequest,
parseStatus,
StatusMap,
getNextUrl,
performPagedRequest,
parseResponseJSON,
PreviewAccept (..),
PreviewParseResponse (..),
withOpenSSL,
tlsManagerSettings,
) where
import GitHub.Internal.Prelude
import Prelude ()
import Control.Monad.Error.Class (MonadError (..))
import Control.Monad (when)
import Control.Monad.Catch (MonadCatch (..), MonadThrow)
import Control.Monad.Trans.Class (lift)
import Control.Monad.Trans.Except (ExceptT (..), runExceptT)
import Data.Aeson (eitherDecode)
import Data.List (find, intercalate)
import Data.String (fromString)
import Data.Tagged (Tagged (..))
import Data.Version (showVersion)
import Network.HTTP.Client
(HttpException (..), Manager, RequestBody (..), Response (..), getUri,
httpLbs, method, newManager, redirectCount, requestBody, requestHeaders,
setQueryString, setRequestIgnoreStatus)
import Network.HTTP.Link.Parser (parseLinkHeaderBS)
import Network.HTTP.Link.Types (Link (..), LinkParam (..), href, linkParams)
import Network.HTTP.Types (Method, RequestHeaders, Status (..))
import Network.URI
(URI, escapeURIString, isUnescapedInURIComponent, parseURIReference,
relativeTo)
import qualified Data.ByteString as BS
import qualified Data.ByteString.Lazy as LBS
import qualified Data.Text as T
import qualified Data.Text.Encoding as TE
import qualified Data.Vector as V
import qualified Network.HTTP.Client as HTTP
import qualified Network.HTTP.Client.Internal as HTTP
#ifdef MIN_VERSION_http_client_tls
import Network.HTTP.Client.TLS (tlsManagerSettings)
#else
import Network.HTTP.Client.OpenSSL (opensslManagerSettings, withOpenSSL)
import qualified OpenSSL.Session as SSL
import qualified OpenSSL.X509.SystemStore as SSL
#endif
import GitHub.Auth (AuthMethod, endpoint, setAuthRequest)
import GitHub.Data (Error (..))
import GitHub.Data.PullRequests (MergeResult (..))
import GitHub.Data.Request
import Paths_github (version)
github :: (AuthMethod am, GitHubRW req res) => am -> req -> res
github :: am -> req -> res
github = am -> req -> res
forall req res am.
(GitHubRW req res, AuthMethod am) =>
am -> req -> res
githubImpl
github' :: GitHubRO req res => req -> res
github' :: req -> res
github' = req -> res
forall req res. GitHubRO req res => req -> res
githubImpl'
class GitHubRW req res | req -> res where
githubImpl :: AuthMethod am => am -> req -> res
class GitHubRO req res | req -> res where
githubImpl' :: req -> res
instance (ParseResponse mt req, res ~ Either Error req) => GitHubRW (GenRequest mt rw req) (IO res) where
githubImpl :: am -> GenRequest mt rw req -> IO res
githubImpl = am -> GenRequest mt rw req -> IO res
forall am (mt :: MediaType *) a (rw :: RW).
(AuthMethod am, ParseResponse mt a) =>
am -> GenRequest mt rw a -> IO (Either Error a)
executeRequest
instance (ParseResponse mt req, res ~ Either Error req, rw ~ 'RO) => GitHubRO (GenRequest mt rw req) (IO res) where
githubImpl' :: GenRequest mt rw req -> IO res
githubImpl' = GenRequest mt rw req -> IO res
forall (mt :: MediaType *) a.
ParseResponse mt a =>
GenRequest mt 'RO a -> IO (Either Error a)
executeRequest'
instance GitHubRW req res => GitHubRW (a -> req) (a -> res) where
githubImpl :: am -> (a -> req) -> a -> res
githubImpl am :: am
am req :: a -> req
req x :: a
x = am -> req -> res
forall req res am.
(GitHubRW req res, AuthMethod am) =>
am -> req -> res
githubImpl am
am (a -> req
req a
x)
instance GitHubRO req res => GitHubRO (a -> req) (a -> res) where
githubImpl' :: (a -> req) -> a -> res
githubImpl' req :: a -> req
req x :: a
x = req -> res
forall req res. GitHubRO req res => req -> res
githubImpl' (a -> req
req a
x)
#ifdef MIN_VERSION_http_client_tls
withOpenSSL :: IO a -> IO a
withOpenSSL :: IO a -> IO a
withOpenSSL = IO a -> IO a
forall a. a -> a
id
#else
tlsManagerSettings :: HTTP.ManagerSettings
tlsManagerSettings = opensslManagerSettings $ do
ctx <- SSL.context
SSL.contextAddOption ctx SSL.SSL_OP_NO_SSLv2
SSL.contextAddOption ctx SSL.SSL_OP_NO_SSLv3
SSL.contextAddOption ctx SSL.SSL_OP_NO_TLSv1
SSL.contextSetCiphers ctx "ECDHE-ECDSA-AES256-GCM-SHA384:ECDHE-RSA-AES256-GCM-SHA384:ECDHE-ECDSA-CHACHA20-POLY1305:ECDHE-RSA-CHACHA20-POLY1305:ECDHE-ECDSA-AES128-GCM-SHA256:ECDHE-RSA-AES128-GCM-SHA256:ECDHE-ECDSA-AES256-SHA384:ECDHE-RSA-AES256-SHA384:ECDHE-ECDSA-AES128-SHA256:ECDHE-RSA-AES128-SHA256"
SSL.contextLoadSystemCerts ctx
SSL.contextSetVerificationMode ctx $ SSL.VerifyPeer True True Nothing
return ctx
#endif
executeRequest
:: (AuthMethod am, ParseResponse mt a)
=> am
-> GenRequest mt rw a
-> IO (Either Error a)
executeRequest :: am -> GenRequest mt rw a -> IO (Either Error a)
executeRequest auth :: am
auth req :: GenRequest mt rw a
req = IO (Either Error a) -> IO (Either Error a)
forall a. IO a -> IO a
withOpenSSL (IO (Either Error a) -> IO (Either Error a))
-> IO (Either Error a) -> IO (Either Error a)
forall a b. (a -> b) -> a -> b
$ do
Manager
manager <- ManagerSettings -> IO Manager
newManager ManagerSettings
tlsManagerSettings
Manager -> am -> GenRequest mt rw a -> IO (Either Error a)
forall am (mt :: MediaType *) a (rw :: RW).
(AuthMethod am, ParseResponse mt a) =>
Manager -> am -> GenRequest mt rw a -> IO (Either Error a)
executeRequestWithMgr Manager
manager am
auth GenRequest mt rw a
req
lessFetchCount :: Int -> FetchCount -> Bool
lessFetchCount :: Int -> FetchCount -> Bool
lessFetchCount _ FetchAll = Bool
True
lessFetchCount i :: Int
i (FetchAtLeast j :: Word
j) = Int
i Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Word -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral Word
j
executeRequestWithMgr
:: (AuthMethod am, ParseResponse mt a)
=> Manager
-> am
-> GenRequest mt rw a
-> IO (Either Error a)
executeRequestWithMgr :: Manager -> am -> GenRequest mt rw a -> IO (Either Error a)
executeRequestWithMgr mgr :: Manager
mgr auth :: am
auth req :: GenRequest mt rw a
req =
(Either Error (Response a) -> Either Error a)
-> IO (Either Error (Response a)) -> IO (Either Error a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ((Response a -> a) -> Either Error (Response a) -> Either Error a
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Response a -> a
forall body. Response body -> body
responseBody) (Manager
-> am -> GenRequest mt rw a -> IO (Either Error (Response a))
forall am (mt :: MediaType *) a (rw :: RW).
(AuthMethod am, ParseResponse mt a) =>
Manager
-> am -> GenRequest mt rw a -> IO (Either Error (Response a))
executeRequestWithMgrAndRes Manager
mgr am
auth GenRequest mt rw a
req)
executeRequestWithMgrAndRes
:: (AuthMethod am, ParseResponse mt a)
=> Manager
-> am
-> GenRequest mt rw a
-> IO (Either Error (HTTP.Response a))
executeRequestWithMgrAndRes :: Manager
-> am -> GenRequest mt rw a -> IO (Either Error (Response a))
executeRequestWithMgrAndRes mgr :: Manager
mgr auth :: am
auth req :: GenRequest mt rw a
req = ExceptT Error IO (Response a) -> IO (Either Error (Response a))
forall e (m :: * -> *) a. ExceptT e m a -> m (Either e a)
runExceptT (ExceptT Error IO (Response a) -> IO (Either Error (Response a)))
-> ExceptT Error IO (Response a) -> IO (Either Error (Response a))
forall a b. (a -> b) -> a -> b
$ do
Request
httpReq <- Maybe am -> GenRequest mt rw a -> ExceptT Error IO Request
forall am (mt :: MediaType *) (rw :: RW) a (m :: * -> *).
(AuthMethod am, MonadThrow m, Accept mt) =>
Maybe am -> GenRequest mt rw a -> m Request
makeHttpRequest (am -> Maybe am
forall a. a -> Maybe a
Just am
auth) GenRequest mt rw a
req
Request -> GenRequest mt rw a -> ExceptT Error IO (Response a)
forall (rw :: RW) (mt :: MediaType *) b.
ParseResponse mt b =>
Request -> GenRequest mt rw b -> ExceptT Error IO (Response b)
performHttpReq Request
httpReq GenRequest mt rw a
req
where
httpLbs' :: HTTP.Request -> ExceptT Error IO (HTTP.Response LBS.ByteString)
httpLbs' :: Request -> ExceptT Error IO (Response ByteString)
httpLbs' req' :: Request
req' = IO (Response ByteString) -> ExceptT Error IO (Response ByteString)
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (Request -> Manager -> IO (Response ByteString)
httpLbs Request
req' Manager
mgr) ExceptT Error IO (Response ByteString)
-> (HttpException -> ExceptT Error IO (Response ByteString))
-> ExceptT Error IO (Response ByteString)
forall (m :: * -> *) e a.
(MonadCatch m, Exception e) =>
m a -> (e -> m a) -> m a
`catch` HttpException -> ExceptT Error IO (Response ByteString)
forall (m :: * -> *) a. MonadError Error m => HttpException -> m a
onHttpException
performHttpReq :: forall rw mt b. ParseResponse mt b => HTTP.Request -> GenRequest mt rw b -> ExceptT Error IO (HTTP.Response b)
performHttpReq :: Request -> GenRequest mt rw b -> ExceptT Error IO (Response b)
performHttpReq httpReq :: Request
httpReq Query {} = do
Response ByteString
res <- Request -> ExceptT Error IO (Response ByteString)
httpLbs' Request
httpReq
(b -> Response ByteString -> Response b
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ Response ByteString
res) (b -> Response b)
-> ExceptT Error IO b -> ExceptT Error IO (Response b)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Tagged mt (ExceptT Error IO b) -> ExceptT Error IO b
forall k (s :: k) b. Tagged s b -> b
unTagged (Request -> Response ByteString -> Tagged mt (ExceptT Error IO b)
forall (mt :: MediaType *) a (m :: * -> *).
(ParseResponse mt a, MonadError Error m) =>
Request -> Response ByteString -> Tagged mt (m a)
parseResponse Request
httpReq Response ByteString
res :: Tagged mt (ExceptT Error IO b))
performHttpReq httpReq :: Request
httpReq (PagedQuery _ _ l :: FetchCount
l) =
Tagged mt (ExceptT Error IO (Response b))
-> ExceptT Error IO (Response b)
forall k (s :: k) b. Tagged s b -> b
unTagged ((Request -> ExceptT Error IO (Response ByteString))
-> (Vector a -> Bool)
-> Request
-> Tagged mt (ExceptT Error IO (Response (Vector a)))
forall a (m :: * -> *) (mt :: MediaType *).
(ParseResponse mt a, Semigroup a, MonadCatch m,
MonadError Error m) =>
(Request -> m (Response ByteString))
-> (a -> Bool) -> Request -> Tagged mt (m (Response a))
performPagedRequest Request -> ExceptT Error IO (Response ByteString)
httpLbs' Vector a -> Bool
predicate Request
httpReq :: Tagged mt (ExceptT Error IO (HTTP.Response b)))
where
predicate :: Vector a -> Bool
predicate v :: Vector a
v = Int -> FetchCount -> Bool
lessFetchCount (Vector a -> Int
forall a. Vector a -> Int
V.length Vector a
v) FetchCount
l
performHttpReq httpReq :: Request
httpReq (Command _ _ _) = do
Response ByteString
res <- Request -> ExceptT Error IO (Response ByteString)
httpLbs' Request
httpReq
(b -> Response ByteString -> Response b
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ Response ByteString
res) (b -> Response b)
-> ExceptT Error IO b -> ExceptT Error IO (Response b)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Tagged mt (ExceptT Error IO b) -> ExceptT Error IO b
forall k (s :: k) b. Tagged s b -> b
unTagged (Request -> Response ByteString -> Tagged mt (ExceptT Error IO b)
forall (mt :: MediaType *) a (m :: * -> *).
(ParseResponse mt a, MonadError Error m) =>
Request -> Response ByteString -> Tagged mt (m a)
parseResponse Request
httpReq Response ByteString
res :: Tagged mt (ExceptT Error IO b))
executeRequest' :: ParseResponse mt a => GenRequest mt 'RO a -> IO (Either Error a)
executeRequest' :: GenRequest mt 'RO a -> IO (Either Error a)
executeRequest' req :: GenRequest mt 'RO a
req = IO (Either Error a) -> IO (Either Error a)
forall a. IO a -> IO a
withOpenSSL (IO (Either Error a) -> IO (Either Error a))
-> IO (Either Error a) -> IO (Either Error a)
forall a b. (a -> b) -> a -> b
$ do
Manager
manager <- ManagerSettings -> IO Manager
newManager ManagerSettings
tlsManagerSettings
Manager -> GenRequest mt 'RO a -> IO (Either Error a)
forall (mt :: MediaType *) a.
ParseResponse mt a =>
Manager -> GenRequest mt 'RO a -> IO (Either Error a)
executeRequestWithMgr' Manager
manager GenRequest mt 'RO a
req
executeRequestWithMgr'
:: ParseResponse mt a
=> Manager
-> GenRequest mt 'RO a
-> IO (Either Error a)
executeRequestWithMgr' :: Manager -> GenRequest mt 'RO a -> IO (Either Error a)
executeRequestWithMgr' mgr :: Manager
mgr = Manager -> () -> GenRequest mt 'RO a -> IO (Either Error a)
forall am (mt :: MediaType *) a (rw :: RW).
(AuthMethod am, ParseResponse mt a) =>
Manager -> am -> GenRequest mt rw a -> IO (Either Error a)
executeRequestWithMgr Manager
mgr ()
executeRequestMaybe
:: (AuthMethod am, ParseResponse mt a)
=> Maybe am
-> GenRequest mt 'RO a
-> IO (Either Error a)
executeRequestMaybe :: Maybe am -> GenRequest mt 'RO a -> IO (Either Error a)
executeRequestMaybe = (GenRequest mt 'RO a -> IO (Either Error a))
-> (am -> GenRequest mt 'RO a -> IO (Either Error a))
-> Maybe am
-> GenRequest mt 'RO a
-> IO (Either Error a)
forall b a. b -> (a -> b) -> Maybe a -> b
maybe GenRequest mt 'RO a -> IO (Either Error a)
forall (mt :: MediaType *) a.
ParseResponse mt a =>
GenRequest mt 'RO a -> IO (Either Error a)
executeRequest' am -> GenRequest mt 'RO a -> IO (Either Error a)
forall am (mt :: MediaType *) a (rw :: RW).
(AuthMethod am, ParseResponse mt a) =>
am -> GenRequest mt rw a -> IO (Either Error a)
executeRequest
unsafeDropAuthRequirements :: GenRequest mt rw' a -> GenRequest mt rw a
unsafeDropAuthRequirements :: GenRequest mt rw' a -> GenRequest mt rw a
unsafeDropAuthRequirements (Query ps :: Paths
ps qs :: QueryString
qs) = Paths -> QueryString -> GenRequest mt rw a
forall (mt :: MediaType *) (rw :: RW) a.
Paths -> QueryString -> GenRequest mt rw a
Query Paths
ps QueryString
qs
unsafeDropAuthRequirements r :: GenRequest mt rw' a
r =
[Char] -> GenRequest mt rw a
forall a. HasCallStack => [Char] -> a
error ([Char] -> GenRequest mt rw a) -> [Char] -> GenRequest mt rw a
forall a b. (a -> b) -> a -> b
$ "Trying to drop authenatication from" [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ GenRequest mt rw' a -> [Char]
forall a. Show a => a -> [Char]
show GenRequest mt rw' a
r
class Accept (mt :: MediaType *) where
contentType :: Tagged mt BS.ByteString
contentType = ByteString -> Tagged mt ByteString
forall k (s :: k) b. b -> Tagged s b
Tagged "application/json"
modifyRequest :: Tagged mt (HTTP.Request -> HTTP.Request)
modifyRequest = (Request -> Request) -> Tagged mt (Request -> Request)
forall k (s :: k) b. b -> Tagged s b
Tagged Request -> Request
forall a. a -> a
id
class Accept mt => ParseResponse (mt :: MediaType *) a where
parseResponse
:: MonadError Error m
=> HTTP.Request -> HTTP.Response LBS.ByteString
-> Tagged mt (m a)
parseResponseJSON :: (FromJSON a, MonadError Error m) => HTTP.Response LBS.ByteString -> m a
parseResponseJSON :: Response ByteString -> m a
parseResponseJSON res :: Response ByteString
res = case ByteString -> Either [Char] a
forall a. FromJSON a => ByteString -> Either [Char] a
eitherDecode (Response ByteString -> ByteString
forall body. Response body -> body
responseBody Response ByteString
res) of
Right x :: a
x -> a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return a
x
Left err :: [Char]
err -> Error -> m a
forall e (m :: * -> *) a. MonadError e m => e -> m a
throwError (Error -> m a) -> ([Char] -> Error) -> [Char] -> m a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Error
ParseError (Text -> Error) -> ([Char] -> Text) -> [Char] -> Error
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Char] -> Text
T.pack ([Char] -> m a) -> [Char] -> m a
forall a b. (a -> b) -> a -> b
$ [Char]
err
instance Accept 'MtJSON where
contentType :: Tagged 'MtJSON ByteString
contentType = ByteString -> Tagged 'MtJSON ByteString
forall k (s :: k) b. b -> Tagged s b
Tagged "application/vnd.github.v3+json"
instance FromJSON a => ParseResponse 'MtJSON a where
parseResponse :: Request -> Response ByteString -> Tagged 'MtJSON (m a)
parseResponse _ res :: Response ByteString
res = m a -> Tagged 'MtJSON (m a)
forall k (s :: k) b. b -> Tagged s b
Tagged (Response ByteString -> m a
forall a (m :: * -> *).
(FromJSON a, MonadError Error m) =>
Response ByteString -> m a
parseResponseJSON Response ByteString
res)
instance Accept 'MtStar where
contentType :: Tagged 'MtStar ByteString
contentType = ByteString -> Tagged 'MtStar ByteString
forall k (s :: k) b. b -> Tagged s b
Tagged "application/vnd.github.v3.star+json"
instance FromJSON a => ParseResponse 'MtStar a where
parseResponse :: Request -> Response ByteString -> Tagged 'MtStar (m a)
parseResponse _ res :: Response ByteString
res = m a -> Tagged 'MtStar (m a)
forall k (s :: k) b. b -> Tagged s b
Tagged (Response ByteString -> m a
forall a (m :: * -> *).
(FromJSON a, MonadError Error m) =>
Response ByteString -> m a
parseResponseJSON Response ByteString
res)
instance Accept 'MtRaw where contentType :: Tagged 'MtRaw ByteString
contentType = ByteString -> Tagged 'MtRaw ByteString
forall k (s :: k) b. b -> Tagged s b
Tagged "application/vnd.github.v3.raw"
instance Accept 'MtDiff where contentType :: Tagged 'MtDiff ByteString
contentType = ByteString -> Tagged 'MtDiff ByteString
forall k (s :: k) b. b -> Tagged s b
Tagged "application/vnd.github.v3.diff"
instance Accept 'MtPatch where contentType :: Tagged 'MtPatch ByteString
contentType = ByteString -> Tagged 'MtPatch ByteString
forall k (s :: k) b. b -> Tagged s b
Tagged "application/vnd.github.v3.patch"
instance Accept 'MtSha where contentType :: Tagged 'MtSha ByteString
contentType = ByteString -> Tagged 'MtSha ByteString
forall k (s :: k) b. b -> Tagged s b
Tagged "application/vnd.github.v3.sha"
instance a ~ LBS.ByteString => ParseResponse 'MtRaw a where parseResponse :: Request -> Response ByteString -> Tagged 'MtRaw (m a)
parseResponse _ = m a -> Tagged 'MtRaw (m a)
forall k (s :: k) b. b -> Tagged s b
Tagged (m a -> Tagged 'MtRaw (m a))
-> (Response a -> m a) -> Response a -> Tagged 'MtRaw (m a)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return (a -> m a) -> (Response a -> a) -> Response a -> m a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Response a -> a
forall body. Response body -> body
responseBody
instance a ~ LBS.ByteString => ParseResponse 'MtDiff a where parseResponse :: Request -> Response ByteString -> Tagged 'MtDiff (m a)
parseResponse _ = m a -> Tagged 'MtDiff (m a)
forall k (s :: k) b. b -> Tagged s b
Tagged (m a -> Tagged 'MtDiff (m a))
-> (Response a -> m a) -> Response a -> Tagged 'MtDiff (m a)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return (a -> m a) -> (Response a -> a) -> Response a -> m a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Response a -> a
forall body. Response body -> body
responseBody
instance a ~ LBS.ByteString => ParseResponse 'MtPatch a where parseResponse :: Request -> Response ByteString -> Tagged 'MtPatch (m a)
parseResponse _ = m a -> Tagged 'MtPatch (m a)
forall k (s :: k) b. b -> Tagged s b
Tagged (m a -> Tagged 'MtPatch (m a))
-> (Response a -> m a) -> Response a -> Tagged 'MtPatch (m a)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return (a -> m a) -> (Response a -> a) -> Response a -> m a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Response a -> a
forall body. Response body -> body
responseBody
instance a ~ LBS.ByteString => ParseResponse 'MtSha a where parseResponse :: Request -> Response ByteString -> Tagged 'MtSha (m a)
parseResponse _ = m a -> Tagged 'MtSha (m a)
forall k (s :: k) b. b -> Tagged s b
Tagged (m a -> Tagged 'MtSha (m a))
-> (Response a -> m a) -> Response a -> Tagged 'MtSha (m a)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return (a -> m a) -> (Response a -> a) -> Response a -> m a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Response a -> a
forall body. Response body -> body
responseBody
instance Accept 'MtRedirect where
modifyRequest :: Tagged 'MtRedirect (Request -> Request)
modifyRequest = (Request -> Request) -> Tagged 'MtRedirect (Request -> Request)
forall k (s :: k) b. b -> Tagged s b
Tagged ((Request -> Request) -> Tagged 'MtRedirect (Request -> Request))
-> (Request -> Request) -> Tagged 'MtRedirect (Request -> Request)
forall a b. (a -> b) -> a -> b
$ \req :: Request
req ->
Request -> Request
setRequestIgnoreStatus (Request -> Request) -> Request -> Request
forall a b. (a -> b) -> a -> b
$ Request
req { redirectCount :: Int
redirectCount = 0 }
instance b ~ URI => ParseResponse 'MtRedirect b where
parseResponse :: Request -> Response ByteString -> Tagged 'MtRedirect (m b)
parseResponse req :: Request
req = m URI -> Tagged 'MtRedirect (m URI)
forall k (s :: k) b. b -> Tagged s b
Tagged (m URI -> Tagged 'MtRedirect (m URI))
-> (Response ByteString -> m URI)
-> Response ByteString
-> Tagged 'MtRedirect (m URI)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. URI -> Response ByteString -> m URI
forall (m :: * -> *).
MonadError Error m =>
URI -> Response ByteString -> m URI
parseRedirect (Request -> URI
getUri Request
req)
parseRedirect :: MonadError Error m => URI -> HTTP.Response LBS.ByteString -> m URI
parseRedirect :: URI -> Response ByteString -> m URI
parseRedirect originalUri :: URI
originalUri rsp :: Response ByteString
rsp = do
let status :: Status
status = Response ByteString -> Status
forall body. Response body -> Status
responseStatus Response ByteString
rsp
Bool -> m () -> m ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Status -> Int
statusCode Status
status Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
/= 302) (m () -> m ()) -> m () -> m ()
forall a b. (a -> b) -> a -> b
$
Error -> m ()
forall e (m :: * -> *) a. MonadError e m => e -> m a
throwError (Error -> m ()) -> Error -> m ()
forall a b. (a -> b) -> a -> b
$ Text -> Error
ParseError (Text -> Error) -> Text -> Error
forall a b. (a -> b) -> a -> b
$ "invalid status: " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> [Char] -> Text
T.pack (Status -> [Char]
forall a. Show a => a -> [Char]
show Status
status)
ByteString
loc <- m ByteString
-> (ByteString -> m ByteString) -> Maybe ByteString -> m ByteString
forall b a. b -> (a -> b) -> Maybe a -> b
maybe m ByteString
forall a. m a
noLocation ByteString -> m ByteString
forall (m :: * -> *) a. Monad m => a -> m a
return (Maybe ByteString -> m ByteString)
-> Maybe ByteString -> m ByteString
forall a b. (a -> b) -> a -> b
$ HeaderName -> [(HeaderName, ByteString)] -> Maybe ByteString
forall a b. Eq a => a -> [(a, b)] -> Maybe b
lookup "Location" ([(HeaderName, ByteString)] -> Maybe ByteString)
-> [(HeaderName, ByteString)] -> Maybe ByteString
forall a b. (a -> b) -> a -> b
$ Response ByteString -> [(HeaderName, ByteString)]
forall body. Response body -> [(HeaderName, ByteString)]
responseHeaders Response ByteString
rsp
case [Char] -> Maybe URI
parseURIReference ([Char] -> Maybe URI) -> [Char] -> Maybe URI
forall a b. (a -> b) -> a -> b
$ Text -> [Char]
T.unpack (Text -> [Char]) -> Text -> [Char]
forall a b. (a -> b) -> a -> b
$ ByteString -> Text
TE.decodeUtf8 ByteString
loc of
Nothing -> Error -> m URI
forall e (m :: * -> *) a. MonadError e m => e -> m a
throwError (Error -> m URI) -> Error -> m URI
forall a b. (a -> b) -> a -> b
$ Text -> Error
ParseError (Text -> Error) -> Text -> Error
forall a b. (a -> b) -> a -> b
$
"location header does not contain a URI: " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> [Char] -> Text
T.pack (ByteString -> [Char]
forall a. Show a => a -> [Char]
show ByteString
loc)
Just uri :: URI
uri -> URI -> m URI
forall (m :: * -> *) a. Monad m => a -> m a
return (URI -> m URI) -> URI -> m URI
forall a b. (a -> b) -> a -> b
$ URI
uri URI -> URI -> URI
`relativeTo` URI
originalUri
where
noLocation :: m a
noLocation = Error -> m a
forall e (m :: * -> *) a. MonadError e m => e -> m a
throwError (Error -> m a) -> Error -> m a
forall a b. (a -> b) -> a -> b
$ Text -> Error
ParseError "no location header in response"
class PreviewAccept p where
previewContentType :: Tagged ('MtPreview p) BS.ByteString
previewModifyRequest :: Tagged ('MtPreview p) (HTTP.Request -> HTTP.Request)
previewModifyRequest = (Request -> Request) -> Tagged ('MtPreview p) (Request -> Request)
forall k (s :: k) b. b -> Tagged s b
Tagged Request -> Request
forall a. a -> a
id
class PreviewAccept p => PreviewParseResponse p a where
previewParseResponse
:: MonadError Error m
=> HTTP.Request -> HTTP.Response LBS.ByteString
-> Tagged ('MtPreview p) (m a)
instance PreviewAccept p => Accept ('MtPreview p) where
contentType :: Tagged ('MtPreview p) ByteString
contentType = Tagged ('MtPreview p) ByteString
forall p. PreviewAccept p => Tagged ('MtPreview p) ByteString
previewContentType
modifyRequest :: Tagged ('MtPreview p) (Request -> Request)
modifyRequest = Tagged ('MtPreview p) (Request -> Request)
forall p.
PreviewAccept p =>
Tagged ('MtPreview p) (Request -> Request)
previewModifyRequest
instance PreviewParseResponse p a => ParseResponse ('MtPreview p) a where
parseResponse :: Request -> Response ByteString -> Tagged ('MtPreview p) (m a)
parseResponse = Request -> Response ByteString -> Tagged ('MtPreview p) (m a)
forall p a (m :: * -> *).
(PreviewParseResponse p a, MonadError Error m) =>
Request -> Response ByteString -> Tagged ('MtPreview p) (m a)
previewParseResponse
instance Accept 'MtStatus where
modifyRequest :: Tagged 'MtStatus (Request -> Request)
modifyRequest = (Request -> Request) -> Tagged 'MtStatus (Request -> Request)
forall k (s :: k) b. b -> Tagged s b
Tagged Request -> Request
setRequestIgnoreStatus
instance HasStatusMap a => ParseResponse 'MtStatus a where
parseResponse :: Request -> Response ByteString -> Tagged 'MtStatus (m a)
parseResponse _ = m a -> Tagged 'MtStatus (m a)
forall k (s :: k) b. b -> Tagged s b
Tagged (m a -> Tagged 'MtStatus (m a))
-> (Response ByteString -> m a)
-> Response ByteString
-> Tagged 'MtStatus (m a)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. StatusMap a -> Status -> m a
forall (m :: * -> *) a.
MonadError Error m =>
StatusMap a -> Status -> m a
parseStatus StatusMap a
forall a. HasStatusMap a => StatusMap a
statusMap (Status -> m a)
-> (Response ByteString -> Status) -> Response ByteString -> m a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Response ByteString -> Status
forall body. Response body -> Status
responseStatus
type StatusMap a = [(Int, a)]
class HasStatusMap a where
statusMap :: StatusMap a
instance HasStatusMap Bool where
statusMap :: StatusMap Bool
statusMap =
[ (204, Bool
True)
, (404, Bool
False)
]
instance HasStatusMap MergeResult where
statusMap :: StatusMap MergeResult
statusMap =
[ (200, MergeResult
MergeSuccessful)
, (405, MergeResult
MergeCannotPerform)
, (409, MergeResult
MergeConflict)
]
parseStatus :: MonadError Error m => StatusMap a -> Status -> m a
parseStatus :: StatusMap a -> Status -> m a
parseStatus m :: StatusMap a
m (Status sci :: Int
sci _) =
m a -> (a -> m a) -> Maybe a -> m a
forall b a. b -> (a -> b) -> Maybe a -> b
maybe m a
err a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return (Maybe a -> m a) -> Maybe a -> m a
forall a b. (a -> b) -> a -> b
$ Int -> StatusMap a -> Maybe a
forall a b. Eq a => a -> [(a, b)] -> Maybe b
lookup Int
sci StatusMap a
m
where
err :: m a
err = Error -> m a
forall e (m :: * -> *) a. MonadError e m => e -> m a
throwError (Error -> m a) -> Error -> m a
forall a b. (a -> b) -> a -> b
$ Text -> Error
JsonError (Text -> Error) -> Text -> Error
forall a b. (a -> b) -> a -> b
$ "invalid status: " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> [Char] -> Text
T.pack (Int -> [Char]
forall a. Show a => a -> [Char]
show Int
sci)
instance Accept 'MtUnit where
instance a ~ () => ParseResponse 'MtUnit a where
parseResponse :: Request -> Response ByteString -> Tagged 'MtUnit (m a)
parseResponse _ _ = m () -> Tagged 'MtUnit (m ())
forall k (s :: k) b. b -> Tagged s b
Tagged (() -> m ()
forall (m :: * -> *) a. Monad m => a -> m a
return ())
makeHttpRequest
:: forall am mt rw a m. (AuthMethod am, MonadThrow m, Accept mt)
=> Maybe am
-> GenRequest mt rw a
-> m HTTP.Request
makeHttpRequest :: Maybe am -> GenRequest mt rw a -> m Request
makeHttpRequest auth :: Maybe am
auth r :: GenRequest mt rw a
r = case GenRequest mt rw a
r of
Query paths :: Paths
paths qs :: QueryString
qs -> do
Request
req <- [Char] -> m Request
MonadThrow m => [Char] -> m Request
parseUrl' ([Char] -> m Request) -> [Char] -> m Request
forall a b. (a -> b) -> a -> b
$ Paths -> [Char]
url Paths
paths
Request -> m Request
forall (m :: * -> *) a. Monad m => a -> m a
return
(Request -> m Request) -> Request -> m Request
forall a b. (a -> b) -> a -> b
$ Request -> Request
setReqHeaders
(Request -> Request) -> (Request -> Request) -> Request -> Request
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Tagged mt (Request -> Request) -> Request -> Request
forall k (s :: k) b. Tagged s b -> b
unTagged (Tagged mt (Request -> Request)
forall (mt :: MediaType *).
Accept mt =>
Tagged mt (Request -> Request)
modifyRequest :: Tagged mt (HTTP.Request -> HTTP.Request))
(Request -> Request) -> (Request -> Request) -> Request -> Request
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Request -> Request)
-> (am -> Request -> Request) -> Maybe am -> Request -> Request
forall b a. b -> (a -> b) -> Maybe a -> b
maybe Request -> Request
forall a. a -> a
id am -> Request -> Request
forall a. AuthMethod a => a -> Request -> Request
setAuthRequest Maybe am
auth
(Request -> Request) -> (Request -> Request) -> Request -> Request
forall b c a. (b -> c) -> (a -> b) -> a -> c
. QueryString -> Request -> Request
setQueryString QueryString
qs
(Request -> Request) -> Request -> Request
forall a b. (a -> b) -> a -> b
$ Request
req
PagedQuery paths :: Paths
paths qs :: QueryString
qs _ -> do
Request
req <- [Char] -> m Request
MonadThrow m => [Char] -> m Request
parseUrl' ([Char] -> m Request) -> [Char] -> m Request
forall a b. (a -> b) -> a -> b
$ Paths -> [Char]
url Paths
paths
Request -> m Request
forall (m :: * -> *) a. Monad m => a -> m a
return
(Request -> m Request) -> Request -> m Request
forall a b. (a -> b) -> a -> b
$ Request -> Request
setReqHeaders
(Request -> Request) -> (Request -> Request) -> Request -> Request
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Tagged mt (Request -> Request) -> Request -> Request
forall k (s :: k) b. Tagged s b -> b
unTagged (Tagged mt (Request -> Request)
forall (mt :: MediaType *).
Accept mt =>
Tagged mt (Request -> Request)
modifyRequest :: Tagged mt (HTTP.Request -> HTTP.Request))
(Request -> Request) -> (Request -> Request) -> Request -> Request
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Request -> Request)
-> (am -> Request -> Request) -> Maybe am -> Request -> Request
forall b a. b -> (a -> b) -> Maybe a -> b
maybe Request -> Request
forall a. a -> a
id am -> Request -> Request
forall a. AuthMethod a => a -> Request -> Request
setAuthRequest Maybe am
auth
(Request -> Request) -> (Request -> Request) -> Request -> Request
forall b c a. (b -> c) -> (a -> b) -> a -> c
. QueryString -> Request -> Request
setQueryString QueryString
qs
(Request -> Request) -> Request -> Request
forall a b. (a -> b) -> a -> b
$ Request
req
Command m :: CommandMethod
m paths :: Paths
paths body :: ByteString
body -> do
Request
req <- [Char] -> m Request
MonadThrow m => [Char] -> m Request
parseUrl' ([Char] -> m Request) -> [Char] -> m Request
forall a b. (a -> b) -> a -> b
$ Paths -> [Char]
url Paths
paths
Request -> m Request
forall (m :: * -> *) a. Monad m => a -> m a
return
(Request -> m Request) -> Request -> m Request
forall a b. (a -> b) -> a -> b
$ Request -> Request
setReqHeaders
(Request -> Request) -> (Request -> Request) -> Request -> Request
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Tagged mt (Request -> Request) -> Request -> Request
forall k (s :: k) b. Tagged s b -> b
unTagged (Tagged mt (Request -> Request)
forall (mt :: MediaType *).
Accept mt =>
Tagged mt (Request -> Request)
modifyRequest :: Tagged mt (HTTP.Request -> HTTP.Request))
(Request -> Request) -> (Request -> Request) -> Request -> Request
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Request -> Request)
-> (am -> Request -> Request) -> Maybe am -> Request -> Request
forall b a. b -> (a -> b) -> Maybe a -> b
maybe Request -> Request
forall a. a -> a
id am -> Request -> Request
forall a. AuthMethod a => a -> Request -> Request
setAuthRequest Maybe am
auth
(Request -> Request) -> (Request -> Request) -> Request -> Request
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> Request -> Request
setBody ByteString
body
(Request -> Request) -> (Request -> Request) -> Request -> Request
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> Request -> Request
setMethod (CommandMethod -> ByteString
toMethod CommandMethod
m)
(Request -> Request) -> Request -> Request
forall a b. (a -> b) -> a -> b
$ Request
req
where
parseUrl' :: MonadThrow m => String -> m HTTP.Request
parseUrl' :: [Char] -> m Request
parseUrl' = [Char] -> m Request
forall (m :: * -> *). MonadThrow m => [Char] -> m Request
HTTP.parseUrlThrow
url :: Paths -> String
url :: Paths -> [Char]
url paths :: Paths
paths = [Char] -> (Text -> [Char]) -> Maybe Text -> [Char]
forall b a. b -> (a -> b) -> Maybe a -> b
maybe "https://api.github.com" Text -> [Char]
T.unpack (am -> Maybe Text
forall a. AuthMethod a => a -> Maybe Text
endpoint (am -> Maybe Text) -> Maybe am -> Maybe Text
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< Maybe am
auth) [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ "/" [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char] -> [[Char]] -> [Char]
forall a. [a] -> [[a]] -> [a]
intercalate "/" [[Char]]
paths' where
paths' :: [[Char]]
paths' = (Text -> [Char]) -> Paths -> [[Char]]
forall a b. (a -> b) -> [a] -> [b]
map ((Char -> Bool) -> [Char] -> [Char]
escapeURIString Char -> Bool
isUnescapedInURIComponent ([Char] -> [Char]) -> (Text -> [Char]) -> Text -> [Char]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> [Char]
T.unpack) Paths
paths
setReqHeaders :: HTTP.Request -> HTTP.Request
setReqHeaders :: Request -> Request
setReqHeaders req :: Request
req = Request
req { requestHeaders :: [(HeaderName, ByteString)]
requestHeaders = [(HeaderName, ByteString)]
reqHeaders [(HeaderName, ByteString)]
-> [(HeaderName, ByteString)] -> [(HeaderName, ByteString)]
forall a. Semigroup a => a -> a -> a
<> Request -> [(HeaderName, ByteString)]
requestHeaders Request
req }
setMethod :: Method -> HTTP.Request -> HTTP.Request
setMethod :: ByteString -> Request -> Request
setMethod m :: ByteString
m req :: Request
req = Request
req { method :: ByteString
method = ByteString
m }
reqHeaders :: RequestHeaders
reqHeaders :: [(HeaderName, ByteString)]
reqHeaders = [("User-Agent", "github.hs/" ByteString -> ByteString -> ByteString
forall a. Semigroup a => a -> a -> a
<> [Char] -> ByteString
forall a. IsString a => [Char] -> a
fromString (Version -> [Char]
showVersion Version
version))]
[(HeaderName, ByteString)]
-> [(HeaderName, ByteString)] -> [(HeaderName, ByteString)]
forall a. Semigroup a => a -> a -> a
<> [("Accept", Tagged mt ByteString -> ByteString
forall k (s :: k) b. Tagged s b -> b
unTagged (Tagged mt ByteString
forall (mt :: MediaType *). Accept mt => Tagged mt ByteString
contentType :: Tagged mt BS.ByteString))]
setBody :: LBS.ByteString -> HTTP.Request -> HTTP.Request
setBody :: ByteString -> Request -> Request
setBody body :: ByteString
body req :: Request
req = Request
req { requestBody :: RequestBody
requestBody = ByteString -> RequestBody
RequestBodyLBS ByteString
body }
getNextUrl :: HTTP.Response a -> Maybe URI
getNextUrl :: Response a -> Maybe URI
getNextUrl req :: Response a
req = do
ByteString
linkHeader <- HeaderName -> [(HeaderName, ByteString)] -> Maybe ByteString
forall a b. Eq a => a -> [(a, b)] -> Maybe b
lookup "Link" (Response a -> [(HeaderName, ByteString)]
forall body. Response body -> [(HeaderName, ByteString)]
responseHeaders Response a
req)
[Link]
links <- ByteString -> Maybe [Link]
parseLinkHeaderBS ByteString
linkHeader
Link
nextURI <- (Link -> Bool) -> [Link] -> Maybe Link
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Maybe a
find Link -> Bool
isRelNext [Link]
links
URI -> Maybe URI
forall (m :: * -> *) a. Monad m => a -> m a
return (URI -> Maybe URI) -> URI -> Maybe URI
forall a b. (a -> b) -> a -> b
$ Link -> URI
href Link
nextURI
where
isRelNext :: Link -> Bool
isRelNext :: Link -> Bool
isRelNext = ((LinkParam, Text) -> Bool) -> [(LinkParam, Text)] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
any ((LinkParam, Text) -> (LinkParam, Text) -> Bool
forall a. Eq a => a -> a -> Bool
== (LinkParam, Text)
relNextLinkParam) ([(LinkParam, Text)] -> Bool)
-> (Link -> [(LinkParam, Text)]) -> Link -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Link -> [(LinkParam, Text)]
linkParams
relNextLinkParam :: (LinkParam, Text)
relNextLinkParam :: (LinkParam, Text)
relNextLinkParam = (LinkParam
Rel, "next")
performPagedRequest
:: forall a m mt. (ParseResponse mt a, Semigroup a, MonadCatch m, MonadError Error m)
=> (HTTP.Request -> m (HTTP.Response LBS.ByteString))
-> (a -> Bool)
-> HTTP.Request
-> Tagged mt (m (HTTP.Response a))
performPagedRequest :: (Request -> m (Response ByteString))
-> (a -> Bool) -> Request -> Tagged mt (m (Response a))
performPagedRequest httpLbs' :: Request -> m (Response ByteString)
httpLbs' predicate :: a -> Bool
predicate initReq :: Request
initReq = m (Response a) -> Tagged mt (m (Response a))
forall k (s :: k) b. b -> Tagged s b
Tagged (m (Response a) -> Tagged mt (m (Response a)))
-> m (Response a) -> Tagged mt (m (Response a))
forall a b. (a -> b) -> a -> b
$ do
Response ByteString
res <- Request -> m (Response ByteString)
httpLbs' Request
initReq
a
m <- Tagged mt (m a) -> m a
forall k (s :: k) b. Tagged s b -> b
unTagged (Request -> Response ByteString -> Tagged mt (m a)
forall (mt :: MediaType *) a (m :: * -> *).
(ParseResponse mt a, MonadError Error m) =>
Request -> Response ByteString -> Tagged mt (m a)
parseResponse Request
initReq Response ByteString
res :: Tagged mt (m a))
a -> Response ByteString -> Request -> m (Response a)
go a
m Response ByteString
res Request
initReq
where
go :: a -> HTTP.Response LBS.ByteString -> HTTP.Request -> m (HTTP.Response a)
go :: a -> Response ByteString -> Request -> m (Response a)
go acc :: a
acc res :: Response ByteString
res req :: Request
req =
case (a -> Bool
predicate a
acc, Response ByteString -> Maybe URI
forall a. Response a -> Maybe URI
getNextUrl Response ByteString
res) of
(True, Just uri :: URI
uri) -> do
Request
req' <- Request -> URI -> m Request
forall (m :: * -> *). MonadThrow m => Request -> URI -> m Request
HTTP.setUri Request
req URI
uri
Response ByteString
res' <- Request -> m (Response ByteString)
httpLbs' Request
req'
a
m <- Tagged mt (m a) -> m a
forall k (s :: k) b. Tagged s b -> b
unTagged (Request -> Response ByteString -> Tagged mt (m a)
forall (mt :: MediaType *) a (m :: * -> *).
(ParseResponse mt a, MonadError Error m) =>
Request -> Response ByteString -> Tagged mt (m a)
parseResponse Request
req' Response ByteString
res' :: Tagged mt (m a))
a -> Response ByteString -> Request -> m (Response a)
go (a
acc a -> a -> a
forall a. Semigroup a => a -> a -> a
<> a
m) Response ByteString
res' Request
req'
(_, _) -> Response a -> m (Response a)
forall (m :: * -> *) a. Monad m => a -> m a
return (a
acc a -> Response ByteString -> Response a
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ Response ByteString
res)
onHttpException :: MonadError Error m => HttpException -> m a
onHttpException :: HttpException -> m a
onHttpException = Error -> m a
forall e (m :: * -> *) a. MonadError e m => e -> m a
throwError (Error -> m a) -> (HttpException -> Error) -> HttpException -> m a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. HttpException -> Error
HTTPError