{-
   Ory Hydra API

   Documentation for all of Ory Hydra's APIs. 

   OpenAPI Version: 3.0.3
   Ory Hydra API API version: 
   Contact: hi@ory.sh
   Generated by OpenAPI Generator (https://openapi-generator.tech)
-}

{-|
Module : OryHydra.Client
-}

{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE RankNTypes #-}
{-# LANGUAGE RecordWildCards #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE DeriveFunctor #-}
{-# LANGUAGE DeriveFoldable #-}
{-# LANGUAGE DeriveTraversable #-}
{-# OPTIONS_GHC -fno-warn-unused-binds -fno-warn-unused-imports #-}

module OryHydra.Client where

import OryHydra.Core
import OryHydra.Logging
import OryHydra.MimeTypes

import qualified Control.Exception.Safe as E
import qualified Control.Monad.IO.Class as P
import qualified Control.Monad as P
import qualified Data.Aeson.Types as A
import qualified Data.ByteString as B
import qualified Data.ByteString.Char8 as BC
import qualified Data.ByteString.Lazy as BL
import qualified Data.ByteString.Lazy.Char8 as BCL
import qualified Data.Proxy as P (Proxy(..))
import qualified Data.Text as T
import qualified Data.Text.Encoding as T
import qualified Network.HTTP.Client as NH
import qualified Network.HTTP.Client.MultipartFormData as NH
import qualified Network.HTTP.Types as NH
import qualified Web.FormUrlEncoded as WH
import qualified Web.HttpApiData as WH

import Data.Function ((&))
import Data.Monoid ((<>))
import Data.Text (Text)
import GHC.Exts (IsString(..))

-- * Dispatch

-- ** Lbs

-- | send a request returning the raw http response
dispatchLbs
  :: (Produces req accept, MimeType contentType)
  => NH.Manager -- ^ http-client Connection manager
  -> OryHydraConfig -- ^ config
  -> OryHydraRequest req contentType res accept -- ^ request
  -> IO (NH.Response BCL.ByteString) -- ^ response
dispatchLbs :: forall req accept contentType res.
(Produces req accept, MimeType contentType) =>
Manager
-> OryHydraConfig
-> OryHydraRequest req contentType res accept
-> IO (Response ByteString)
dispatchLbs Manager
manager OryHydraConfig
config OryHydraRequest req contentType res accept
request  = do
  InitRequest req contentType res accept
initReq <- forall accept contentType req res.
(MimeType accept, MimeType contentType) =>
OryHydraConfig
-> OryHydraRequest req contentType res accept
-> IO (InitRequest req contentType res accept)
_toInitRequest OryHydraConfig
config OryHydraRequest req contentType res accept
request
  forall req contentType res accept.
Manager
-> OryHydraConfig
-> InitRequest req contentType res accept
-> IO (Response ByteString)
dispatchInitUnsafe Manager
manager OryHydraConfig
config InitRequest req contentType res accept
initReq

-- ** Mime

-- | pair of decoded http body and http response
data MimeResult res =
  MimeResult { forall res. MimeResult res -> Either MimeError res
mimeResult :: Either MimeError res -- ^ decoded http body
             , forall res. MimeResult res -> Response ByteString
mimeResultResponse :: NH.Response BCL.ByteString -- ^ http response
             }
  deriving (Int -> MimeResult res -> ShowS
forall res. Show res => Int -> MimeResult res -> ShowS
forall res. Show res => [MimeResult res] -> ShowS
forall res. Show res => MimeResult res -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [MimeResult res] -> ShowS
$cshowList :: forall res. Show res => [MimeResult res] -> ShowS
show :: MimeResult res -> String
$cshow :: forall res. Show res => MimeResult res -> String
showsPrec :: Int -> MimeResult res -> ShowS
$cshowsPrec :: forall res. Show res => Int -> MimeResult res -> ShowS
Show, forall a b. a -> MimeResult b -> MimeResult a
forall a b. (a -> b) -> MimeResult a -> MimeResult b
forall (f :: * -> *).
(forall a b. (a -> b) -> f a -> f b)
-> (forall a b. a -> f b -> f a) -> Functor f
<$ :: forall a b. a -> MimeResult b -> MimeResult a
$c<$ :: forall a b. a -> MimeResult b -> MimeResult a
fmap :: forall a b. (a -> b) -> MimeResult a -> MimeResult b
$cfmap :: forall a b. (a -> b) -> MimeResult a -> MimeResult b
Functor, forall a. Eq a => a -> MimeResult a -> Bool
forall a. Num a => MimeResult a -> a
forall a. Ord a => MimeResult a -> a
forall m. Monoid m => MimeResult m -> m
forall a. MimeResult a -> Bool
forall a. MimeResult a -> Int
forall a. MimeResult a -> [a]
forall a. (a -> a -> a) -> MimeResult a -> a
forall m a. Monoid m => (a -> m) -> MimeResult a -> m
forall b a. (b -> a -> b) -> b -> MimeResult a -> b
forall a b. (a -> b -> b) -> b -> MimeResult a -> b
forall (t :: * -> *).
(forall m. Monoid m => t m -> m)
-> (forall m a. Monoid m => (a -> m) -> t a -> m)
-> (forall m a. Monoid m => (a -> m) -> t a -> m)
-> (forall a b. (a -> b -> b) -> b -> t a -> b)
-> (forall a b. (a -> b -> b) -> b -> t a -> b)
-> (forall b a. (b -> a -> b) -> b -> t a -> b)
-> (forall b a. (b -> a -> b) -> b -> t a -> b)
-> (forall a. (a -> a -> a) -> t a -> a)
-> (forall a. (a -> a -> a) -> t a -> a)
-> (forall a. t a -> [a])
-> (forall a. t a -> Bool)
-> (forall a. t a -> Int)
-> (forall a. Eq a => a -> t a -> Bool)
-> (forall a. Ord a => t a -> a)
-> (forall a. Ord a => t a -> a)
-> (forall a. Num a => t a -> a)
-> (forall a. Num a => t a -> a)
-> Foldable t
product :: forall a. Num a => MimeResult a -> a
$cproduct :: forall a. Num a => MimeResult a -> a
sum :: forall a. Num a => MimeResult a -> a
$csum :: forall a. Num a => MimeResult a -> a
minimum :: forall a. Ord a => MimeResult a -> a
$cminimum :: forall a. Ord a => MimeResult a -> a
maximum :: forall a. Ord a => MimeResult a -> a
$cmaximum :: forall a. Ord a => MimeResult a -> a
elem :: forall a. Eq a => a -> MimeResult a -> Bool
$celem :: forall a. Eq a => a -> MimeResult a -> Bool
length :: forall a. MimeResult a -> Int
$clength :: forall a. MimeResult a -> Int
null :: forall a. MimeResult a -> Bool
$cnull :: forall a. MimeResult a -> Bool
toList :: forall a. MimeResult a -> [a]
$ctoList :: forall a. MimeResult a -> [a]
foldl1 :: forall a. (a -> a -> a) -> MimeResult a -> a
$cfoldl1 :: forall a. (a -> a -> a) -> MimeResult a -> a
foldr1 :: forall a. (a -> a -> a) -> MimeResult a -> a
$cfoldr1 :: forall a. (a -> a -> a) -> MimeResult a -> a
foldl' :: forall b a. (b -> a -> b) -> b -> MimeResult a -> b
$cfoldl' :: forall b a. (b -> a -> b) -> b -> MimeResult a -> b
foldl :: forall b a. (b -> a -> b) -> b -> MimeResult a -> b
$cfoldl :: forall b a. (b -> a -> b) -> b -> MimeResult a -> b
foldr' :: forall a b. (a -> b -> b) -> b -> MimeResult a -> b
$cfoldr' :: forall a b. (a -> b -> b) -> b -> MimeResult a -> b
foldr :: forall a b. (a -> b -> b) -> b -> MimeResult a -> b
$cfoldr :: forall a b. (a -> b -> b) -> b -> MimeResult a -> b
foldMap' :: forall m a. Monoid m => (a -> m) -> MimeResult a -> m
$cfoldMap' :: forall m a. Monoid m => (a -> m) -> MimeResult a -> m
foldMap :: forall m a. Monoid m => (a -> m) -> MimeResult a -> m
$cfoldMap :: forall m a. Monoid m => (a -> m) -> MimeResult a -> m
fold :: forall m. Monoid m => MimeResult m -> m
$cfold :: forall m. Monoid m => MimeResult m -> m
Foldable, Functor MimeResult
Foldable MimeResult
forall (t :: * -> *).
Functor t
-> Foldable t
-> (forall (f :: * -> *) a b.
    Applicative f =>
    (a -> f b) -> t a -> f (t b))
-> (forall (f :: * -> *) a. Applicative f => t (f a) -> f (t a))
-> (forall (m :: * -> *) a b.
    Monad m =>
    (a -> m b) -> t a -> m (t b))
-> (forall (m :: * -> *) a. Monad m => t (m a) -> m (t a))
-> Traversable t
forall (m :: * -> *) a.
Monad m =>
MimeResult (m a) -> m (MimeResult a)
forall (f :: * -> *) a.
Applicative f =>
MimeResult (f a) -> f (MimeResult a)
forall (m :: * -> *) a b.
Monad m =>
(a -> m b) -> MimeResult a -> m (MimeResult b)
forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> MimeResult a -> f (MimeResult b)
sequence :: forall (m :: * -> *) a.
Monad m =>
MimeResult (m a) -> m (MimeResult a)
$csequence :: forall (m :: * -> *) a.
Monad m =>
MimeResult (m a) -> m (MimeResult a)
mapM :: forall (m :: * -> *) a b.
Monad m =>
(a -> m b) -> MimeResult a -> m (MimeResult b)
$cmapM :: forall (m :: * -> *) a b.
Monad m =>
(a -> m b) -> MimeResult a -> m (MimeResult b)
sequenceA :: forall (f :: * -> *) a.
Applicative f =>
MimeResult (f a) -> f (MimeResult a)
$csequenceA :: forall (f :: * -> *) a.
Applicative f =>
MimeResult (f a) -> f (MimeResult a)
traverse :: forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> MimeResult a -> f (MimeResult b)
$ctraverse :: forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> MimeResult a -> f (MimeResult b)
Traversable)

-- | pair of unrender/parser error and http response
data MimeError =
  MimeError {
    MimeError -> String
mimeError :: String -- ^ unrender/parser error
  , MimeError -> Response ByteString
mimeErrorResponse :: NH.Response BCL.ByteString -- ^ http response
  } deriving (Int -> MimeError -> ShowS
[MimeError] -> ShowS
MimeError -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [MimeError] -> ShowS
$cshowList :: [MimeError] -> ShowS
show :: MimeError -> String
$cshow :: MimeError -> String
showsPrec :: Int -> MimeError -> ShowS
$cshowsPrec :: Int -> MimeError -> ShowS
Show)

-- | send a request returning the 'MimeResult'
dispatchMime
  :: forall req contentType res accept. (Produces req accept, MimeUnrender accept res, MimeType contentType)
  => NH.Manager -- ^ http-client Connection manager
  -> OryHydraConfig -- ^ config
  -> OryHydraRequest req contentType res accept -- ^ request
  -> IO (MimeResult res) -- ^ response
dispatchMime :: forall req contentType res accept.
(Produces req accept, MimeUnrender accept res,
 MimeType contentType) =>
Manager
-> OryHydraConfig
-> OryHydraRequest req contentType res accept
-> IO (MimeResult res)
dispatchMime Manager
manager OryHydraConfig
config OryHydraRequest req contentType res accept
request = do
  Response ByteString
httpResponse <- forall req accept contentType res.
(Produces req accept, MimeType contentType) =>
Manager
-> OryHydraConfig
-> OryHydraRequest req contentType res accept
-> IO (Response ByteString)
dispatchLbs Manager
manager OryHydraConfig
config OryHydraRequest req contentType res accept
request
  let statusCode :: Int
statusCode = Status -> Int
NH.statusCode forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall body. Response body -> Status
NH.responseStatus forall a b. (a -> b) -> a -> b
$ Response ByteString
httpResponse
  Either MimeError res
parsedResult <-
    forall (m :: * -> *) a.
(MonadCatch m, MonadIO m) =>
Text -> OryHydraConfig -> LogExec m a
runConfigLogWithExceptions Text
"Client" OryHydraConfig
config forall a b. (a -> b) -> a -> b
$
    do if (Int
statusCode forall a. Ord a => a -> a -> Bool
>= Int
400 Bool -> Bool -> Bool
&& Int
statusCode forall a. Ord a => a -> a -> Bool
< Int
600)
         then do
           let s :: String
s = String
"error statusCode: " forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> String
show Int
statusCode
           forall (m :: * -> *).
(Applicative m, Katip m) =>
Text -> LogLevel -> Text -> m ()
_log Text
"Client" LogLevel
levelError (String -> Text
T.pack String
s)
           forall (f :: * -> *) a. Applicative f => a -> f a
pure (forall a b. a -> Either a b
Left (String -> Response ByteString -> MimeError
MimeError String
s Response ByteString
httpResponse))
         else case forall mtype o.
MimeUnrender mtype o =>
Proxy mtype -> ByteString -> Either String o
mimeUnrender (forall {k} (t :: k). Proxy t
P.Proxy :: P.Proxy accept) (forall body. Response body -> body
NH.responseBody Response ByteString
httpResponse) of
           Left String
s -> do
             forall (m :: * -> *).
(Applicative m, Katip m) =>
Text -> LogLevel -> Text -> m ()
_log Text
"Client" LogLevel
levelError (String -> Text
T.pack String
s)
             forall (f :: * -> *) a. Applicative f => a -> f a
pure (forall a b. a -> Either a b
Left (String -> Response ByteString -> MimeError
MimeError String
s Response ByteString
httpResponse))
           Right res
r -> forall (f :: * -> *) a. Applicative f => a -> f a
pure (forall a b. b -> Either a b
Right res
r)
  forall (m :: * -> *) a. Monad m => a -> m a
return (forall res.
Either MimeError res -> Response ByteString -> MimeResult res
MimeResult Either MimeError res
parsedResult Response ByteString
httpResponse)

-- | like 'dispatchMime', but only returns the decoded http body
dispatchMime'
  :: (Produces req accept, MimeUnrender accept res, MimeType contentType)
  => NH.Manager -- ^ http-client Connection manager
  -> OryHydraConfig -- ^ config
  -> OryHydraRequest req contentType res accept -- ^ request
  -> IO (Either MimeError res) -- ^ response
dispatchMime' :: forall req accept res contentType.
(Produces req accept, MimeUnrender accept res,
 MimeType contentType) =>
Manager
-> OryHydraConfig
-> OryHydraRequest req contentType res accept
-> IO (Either MimeError res)
dispatchMime' Manager
manager OryHydraConfig
config OryHydraRequest req contentType res accept
request  = do
    MimeResult Either MimeError res
parsedResult Response ByteString
_ <- forall req contentType res accept.
(Produces req accept, MimeUnrender accept res,
 MimeType contentType) =>
Manager
-> OryHydraConfig
-> OryHydraRequest req contentType res accept
-> IO (MimeResult res)
dispatchMime Manager
manager OryHydraConfig
config OryHydraRequest req contentType res accept
request
    forall (m :: * -> *) a. Monad m => a -> m a
return Either MimeError res
parsedResult

-- ** Unsafe

-- | like 'dispatchReqLbs', but does not validate the operation is a 'Producer' of the "accept" 'MimeType'.  (Useful if the server's response is undocumented)
dispatchLbsUnsafe
  :: (MimeType accept, MimeType contentType)
  => NH.Manager -- ^ http-client Connection manager
  -> OryHydraConfig -- ^ config
  -> OryHydraRequest req contentType res accept -- ^ request
  -> IO (NH.Response BCL.ByteString) -- ^ response
dispatchLbsUnsafe :: forall accept contentType req res.
(MimeType accept, MimeType contentType) =>
Manager
-> OryHydraConfig
-> OryHydraRequest req contentType res accept
-> IO (Response ByteString)
dispatchLbsUnsafe Manager
manager OryHydraConfig
config OryHydraRequest req contentType res accept
request  = do
  InitRequest req contentType res accept
initReq <- forall accept contentType req res.
(MimeType accept, MimeType contentType) =>
OryHydraConfig
-> OryHydraRequest req contentType res accept
-> IO (InitRequest req contentType res accept)
_toInitRequest OryHydraConfig
config OryHydraRequest req contentType res accept
request
  forall req contentType res accept.
Manager
-> OryHydraConfig
-> InitRequest req contentType res accept
-> IO (Response ByteString)
dispatchInitUnsafe Manager
manager OryHydraConfig
config InitRequest req contentType res accept
initReq

-- | dispatch an InitRequest
dispatchInitUnsafe
  :: NH.Manager -- ^ http-client Connection manager
  -> OryHydraConfig -- ^ config
  -> InitRequest req contentType res accept -- ^ init request
  -> IO (NH.Response BCL.ByteString) -- ^ response
dispatchInitUnsafe :: forall req contentType res accept.
Manager
-> OryHydraConfig
-> InitRequest req contentType res accept
-> IO (Response ByteString)
dispatchInitUnsafe Manager
manager OryHydraConfig
config (InitRequest Request
req) = do
  forall (m :: * -> *) a.
(MonadCatch m, MonadIO m) =>
Text -> OryHydraConfig -> LogExec m a
runConfigLogWithExceptions Text
src OryHydraConfig
config forall a b. (a -> b) -> a -> b
$
    do forall (m :: * -> *).
(Applicative m, Katip m) =>
Text -> LogLevel -> Text -> m ()
_log Text
src LogLevel
levelInfo Text
requestLogMsg
       forall (m :: * -> *).
(Applicative m, Katip m) =>
Text -> LogLevel -> Text -> m ()
_log Text
src LogLevel
levelDebug Text
requestDbgLogMsg
       Response ByteString
res <- forall (m :: * -> *) a. MonadIO m => IO a -> m a
P.liftIO forall a b. (a -> b) -> a -> b
$ Request -> Manager -> IO (Response ByteString)
NH.httpLbs Request
req Manager
manager
       forall (m :: * -> *).
(Applicative m, Katip m) =>
Text -> LogLevel -> Text -> m ()
_log Text
src LogLevel
levelInfo (forall {body}. Response body -> Text
responseLogMsg Response ByteString
res)
       forall (m :: * -> *).
(Applicative m, Katip m) =>
Text -> LogLevel -> Text -> m ()
_log Text
src LogLevel
levelDebug ((String -> Text
T.pack forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Show a => a -> String
show) Response ByteString
res)
       forall (m :: * -> *) a. Monad m => a -> m a
return Response ByteString
res
  where
    src :: Text
src = Text
"Client"
    endpoint :: Text
endpoint =
      String -> Text
T.pack forall a b. (a -> b) -> a -> b
$
      ByteString -> String
BC.unpack forall a b. (a -> b) -> a -> b
$
      Request -> ByteString
NH.method Request
req forall a. Semigroup a => a -> a -> a
<> ByteString
" " forall a. Semigroup a => a -> a -> a
<> Request -> ByteString
NH.host Request
req forall a. Semigroup a => a -> a -> a
<> Request -> ByteString
NH.path Request
req forall a. Semigroup a => a -> a -> a
<> Request -> ByteString
NH.queryString Request
req
    requestLogMsg :: Text
requestLogMsg = Text
"REQ:" forall a. Semigroup a => a -> a -> a
<> Text
endpoint
    requestDbgLogMsg :: Text
requestDbgLogMsg =
      Text
"Headers=" forall a. Semigroup a => a -> a -> a
<> (String -> Text
T.pack forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Show a => a -> String
show) (Request -> RequestHeaders
NH.requestHeaders Request
req) forall a. Semigroup a => a -> a -> a
<> Text
" Body=" forall a. Semigroup a => a -> a -> a
<>
      (case Request -> RequestBody
NH.requestBody Request
req of
         NH.RequestBodyLBS ByteString
xs -> ByteString -> Text
T.decodeUtf8 (ByteString -> ByteString
BL.toStrict ByteString
xs)
         RequestBody
_ -> Text
"<RequestBody>")
    responseStatusCode :: Response body -> Text
responseStatusCode = (String -> Text
T.pack forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Show a => a -> String
show) forall b c a. (b -> c) -> (a -> b) -> a -> c
. Status -> Int
NH.statusCode forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall body. Response body -> Status
NH.responseStatus
    responseLogMsg :: Response body -> Text
responseLogMsg Response body
res =
      Text
"RES:statusCode=" forall a. Semigroup a => a -> a -> a
<> forall {body}. Response body -> Text
responseStatusCode Response body
res forall a. Semigroup a => a -> a -> a
<> Text
" (" forall a. Semigroup a => a -> a -> a
<> Text
endpoint forall a. Semigroup a => a -> a -> a
<> Text
")"

-- * InitRequest

-- | wraps an http-client 'Request' with request/response type parameters
newtype InitRequest req contentType res accept = InitRequest
  { forall req contentType res accept.
InitRequest req contentType res accept -> Request
unInitRequest :: NH.Request
  } deriving (Int -> InitRequest req contentType res accept -> ShowS
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
forall req contentType res accept.
Int -> InitRequest req contentType res accept -> ShowS
forall req contentType res accept.
[InitRequest req contentType res accept] -> ShowS
forall req contentType res accept.
InitRequest req contentType res accept -> String
showList :: [InitRequest req contentType res accept] -> ShowS
$cshowList :: forall req contentType res accept.
[InitRequest req contentType res accept] -> ShowS
show :: InitRequest req contentType res accept -> String
$cshow :: forall req contentType res accept.
InitRequest req contentType res accept -> String
showsPrec :: Int -> InitRequest req contentType res accept -> ShowS
$cshowsPrec :: forall req contentType res accept.
Int -> InitRequest req contentType res accept -> ShowS
Show)

-- |  Build an http-client 'Request' record from the supplied config and request
_toInitRequest
  :: (MimeType accept, MimeType contentType)
  => OryHydraConfig -- ^ config
  -> OryHydraRequest req contentType res accept -- ^ request
  -> IO (InitRequest req contentType res accept) -- ^ initialized request
_toInitRequest :: forall accept contentType req res.
(MimeType accept, MimeType contentType) =>
OryHydraConfig
-> OryHydraRequest req contentType res accept
-> IO (InitRequest req contentType res accept)
_toInitRequest OryHydraConfig
config OryHydraRequest req contentType res accept
req0  =
  forall (m :: * -> *) a.
(MonadCatch m, MonadIO m) =>
Text -> OryHydraConfig -> LogExec m a
runConfigLogWithExceptions Text
"Client" OryHydraConfig
config forall a b. (a -> b) -> a -> b
$ do
    Request
parsedReq <- forall (m :: * -> *) a. MonadIO m => IO a -> m a
P.liftIO forall a b. (a -> b) -> a -> b
$ forall (m :: * -> *). MonadThrow m => String -> m Request
NH.parseRequest forall a b. (a -> b) -> a -> b
$ ByteString -> String
BCL.unpack forall a b. (a -> b) -> a -> b
$ ByteString -> ByteString -> ByteString
BCL.append (OryHydraConfig -> ByteString
configHost OryHydraConfig
config) ([ByteString] -> ByteString
BCL.concat (forall req contentType res accept.
OryHydraRequest req contentType res accept -> [ByteString]
rUrlPath OryHydraRequest req contentType res accept
req0))
    OryHydraRequest req contentType res accept
req1 <- forall (m :: * -> *) a. MonadIO m => IO a -> m a
P.liftIO forall a b. (a -> b) -> a -> b
$ forall req contentType res accept.
OryHydraRequest req contentType res accept
-> OryHydraConfig
-> IO (OryHydraRequest req contentType res accept)
_applyAuthMethods OryHydraRequest req contentType res accept
req0 OryHydraConfig
config
    forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
P.when
        (OryHydraConfig -> Bool
configValidateAuthMethods OryHydraConfig
config Bool -> Bool -> Bool
&& (Bool -> Bool
not forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (t :: * -> *) a. Foldable t => t a -> Bool
null forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall req contentType res accept.
OryHydraRequest req contentType res accept -> [TypeRep]
rAuthTypes) OryHydraRequest req contentType res accept
req1)
        (forall (m :: * -> *) e a. (MonadThrow m, Exception e) => e -> m a
E.throw forall a b. (a -> b) -> a -> b
$ String -> AuthMethodException
AuthMethodException forall a b. (a -> b) -> a -> b
$ String
"AuthMethod not configured: " forall a. Semigroup a => a -> a -> a
<> (forall a. Show a => a -> String
show forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. [a] -> a
head forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall req contentType res accept.
OryHydraRequest req contentType res accept -> [TypeRep]
rAuthTypes) OryHydraRequest req contentType res accept
req1)
    let req2 :: OryHydraRequest req contentType res accept
req2 = OryHydraRequest req contentType res accept
req1 forall a b. a -> (a -> b) -> b
& forall req contentType res accept.
MimeType contentType =>
OryHydraRequest req contentType res accept
-> OryHydraRequest req contentType res accept
_setContentTypeHeader forall a b. a -> (a -> b) -> b
& forall req contentType res accept.
MimeType accept =>
OryHydraRequest req contentType res accept
-> OryHydraRequest req contentType res accept
_setAcceptHeader
        params :: Params
params = forall req contentType res accept.
OryHydraRequest req contentType res accept -> Params
rParams OryHydraRequest req contentType res accept
req2
        reqHeaders :: RequestHeaders
reqHeaders = (HeaderName
"User-Agent", forall a. ToHttpApiData a => a -> ByteString
WH.toHeader (OryHydraConfig -> Text
configUserAgent OryHydraConfig
config)) forall a. a -> [a] -> [a]
: Params -> RequestHeaders
paramsHeaders Params
params
        reqQuery :: ByteString
reqQuery = let query :: Query
query = Params -> Query
paramsQuery Params
params
                       queryExtraUnreserved :: ByteString
queryExtraUnreserved = OryHydraConfig -> ByteString
configQueryExtraUnreserved OryHydraConfig
config
                   in if ByteString -> Bool
B.null ByteString
queryExtraUnreserved
                        then Bool -> Query -> ByteString
NH.renderQuery Bool
True Query
query
                        else Bool -> PartialEscapeQuery -> ByteString
NH.renderQueryPartialEscape Bool
True (ByteString -> Query -> PartialEscapeQuery
toPartialEscapeQuery ByteString
queryExtraUnreserved Query
query)
        pReq :: Request
pReq = Request
parsedReq { method :: ByteString
NH.method = forall req contentType res accept.
OryHydraRequest req contentType res accept -> ByteString
rMethod OryHydraRequest req contentType res accept
req2
                        , requestHeaders :: RequestHeaders
NH.requestHeaders = RequestHeaders
reqHeaders
                        , queryString :: ByteString
NH.queryString = ByteString
reqQuery
                        }
    Request
outReq <- case Params -> ParamBody
paramsBody Params
params of
        ParamBody
ParamBodyNone -> forall (f :: * -> *) a. Applicative f => a -> f a
pure (Request
pReq { requestBody :: RequestBody
NH.requestBody = forall a. Monoid a => a
mempty })
        ParamBodyB ByteString
bs -> forall (f :: * -> *) a. Applicative f => a -> f a
pure (Request
pReq { requestBody :: RequestBody
NH.requestBody = ByteString -> RequestBody
NH.RequestBodyBS ByteString
bs })
        ParamBodyBL ByteString
bl -> forall (f :: * -> *) a. Applicative f => a -> f a
pure (Request
pReq { requestBody :: RequestBody
NH.requestBody = ByteString -> RequestBody
NH.RequestBodyLBS ByteString
bl })
        ParamBodyFormUrlEncoded Form
form -> forall (f :: * -> *) a. Applicative f => a -> f a
pure (Request
pReq { requestBody :: RequestBody
NH.requestBody = ByteString -> RequestBody
NH.RequestBodyLBS (Form -> ByteString
WH.urlEncodeForm Form
form) })
        ParamBodyMultipartFormData [Part]
parts -> forall (m :: * -> *). MonadIO m => [Part] -> Request -> m Request
NH.formDataBody [Part]
parts Request
pReq

    forall (f :: * -> *) a. Applicative f => a -> f a
pure (forall req contentType res accept.
Request -> InitRequest req contentType res accept
InitRequest Request
outReq)

-- | modify the underlying Request
modifyInitRequest :: InitRequest req contentType res accept -> (NH.Request -> NH.Request) -> InitRequest req contentType res accept
modifyInitRequest :: forall req contentType res accept.
InitRequest req contentType res accept
-> (Request -> Request) -> InitRequest req contentType res accept
modifyInitRequest (InitRequest Request
req) Request -> Request
f = forall req contentType res accept.
Request -> InitRequest req contentType res accept
InitRequest (Request -> Request
f Request
req)

-- | modify the underlying Request (monadic)
modifyInitRequestM :: Monad m => InitRequest req contentType res accept -> (NH.Request -> m NH.Request) -> m (InitRequest req contentType res accept)
modifyInitRequestM :: forall (m :: * -> *) req contentType res accept.
Monad m =>
InitRequest req contentType res accept
-> (Request -> m Request)
-> m (InitRequest req contentType res accept)
modifyInitRequestM (InitRequest Request
req) Request -> m Request
f = forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap forall req contentType res accept.
Request -> InitRequest req contentType res accept
InitRequest (Request -> m Request
f Request
req)

-- ** Logging

-- | Run a block using the configured logger instance
runConfigLog
  :: P.MonadIO m
  => OryHydraConfig -> LogExec m a
runConfigLog :: forall (m :: * -> *) a. MonadIO m => OryHydraConfig -> LogExec m a
runConfigLog OryHydraConfig
config = OryHydraConfig -> LogExecWithContext
configLogExecWithContext OryHydraConfig
config (OryHydraConfig -> LogContext
configLogContext OryHydraConfig
config)

-- | Run a block using the configured logger instance (logs exceptions)
runConfigLogWithExceptions
  :: (E.MonadCatch m, P.MonadIO m)
  => T.Text -> OryHydraConfig -> LogExec m a
runConfigLogWithExceptions :: forall (m :: * -> *) a.
(MonadCatch m, MonadIO m) =>
Text -> OryHydraConfig -> LogExec m a
runConfigLogWithExceptions Text
src OryHydraConfig
config = forall (m :: * -> *) a. MonadIO m => OryHydraConfig -> LogExec m a
runConfigLog OryHydraConfig
config forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (m :: * -> *) a.
(Katip m, MonadCatch m, Applicative m) =>
Text -> m a -> m a
logExceptions Text
src