{-
   Gitea API

   This documentation describes the Gitea API.

   OpenAPI Version: 3.0.1
   Gitea API API version: 1.23.1
   Generated by OpenAPI Generator (https://openapi-generator.tech)
-}

{-|
Module : Gitea.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 Gitea.Client where

import Gitea.Core
import Gitea.Logging
import Gitea.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
  -> GiteaConfig -- ^ config
  -> GiteaRequest req contentType res accept -- ^ request
  -> IO (NH.Response BCL.ByteString) -- ^ response
dispatchLbs :: forall req accept contentType res.
(Produces req accept, MimeType contentType) =>
Manager
-> GiteaConfig
-> GiteaRequest req contentType res accept
-> IO (Response ByteString)
dispatchLbs Manager
manager GiteaConfig
config GiteaRequest req contentType res accept
request  = do
  initReq <- GiteaConfig
-> GiteaRequest req contentType res accept
-> IO (InitRequest req contentType res accept)
forall accept contentType req res.
(MimeType accept, MimeType contentType) =>
GiteaConfig
-> GiteaRequest req contentType res accept
-> IO (InitRequest req contentType res accept)
_toInitRequest GiteaConfig
config GiteaRequest req contentType res accept
request
  dispatchInitUnsafe manager config 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
[MimeResult res] -> ShowS
MimeResult res -> String
(Int -> MimeResult res -> ShowS)
-> (MimeResult res -> String)
-> ([MimeResult res] -> ShowS)
-> Show (MimeResult res)
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
$cshowsPrec :: forall res. Show res => Int -> MimeResult res -> ShowS
showsPrec :: Int -> MimeResult res -> ShowS
$cshow :: forall res. Show res => MimeResult res -> String
show :: MimeResult res -> String
$cshowList :: forall res. Show res => [MimeResult res] -> ShowS
showList :: [MimeResult res] -> ShowS
Show, (forall a b. (a -> b) -> MimeResult a -> MimeResult b)
-> (forall a b. a -> MimeResult b -> MimeResult a)
-> Functor MimeResult
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
$cfmap :: forall a b. (a -> b) -> MimeResult a -> MimeResult b
fmap :: forall a b. (a -> b) -> MimeResult a -> MimeResult b
$c<$ :: forall a b. a -> MimeResult b -> MimeResult a
<$ :: forall a b. a -> MimeResult b -> MimeResult a
Functor, (forall m. Monoid m => MimeResult m -> m)
-> (forall m a. Monoid m => (a -> m) -> MimeResult a -> m)
-> (forall m a. Monoid m => (a -> m) -> MimeResult a -> m)
-> (forall a b. (a -> b -> b) -> b -> MimeResult a -> b)
-> (forall a b. (a -> b -> b) -> b -> MimeResult a -> b)
-> (forall b a. (b -> a -> b) -> b -> MimeResult a -> b)
-> (forall b a. (b -> a -> b) -> b -> MimeResult a -> b)
-> (forall a. (a -> a -> a) -> MimeResult a -> a)
-> (forall a. (a -> a -> a) -> MimeResult a -> a)
-> (forall a. MimeResult a -> [a])
-> (forall a. MimeResult a -> Bool)
-> (forall a. MimeResult a -> Int)
-> (forall a. Eq a => a -> MimeResult a -> Bool)
-> (forall a. Ord a => MimeResult a -> a)
-> (forall a. Ord a => MimeResult a -> a)
-> (forall a. Num a => MimeResult a -> a)
-> (forall a. Num a => MimeResult a -> a)
-> Foldable MimeResult
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
$cfold :: forall m. Monoid m => MimeResult m -> m
fold :: forall m. Monoid m => MimeResult m -> 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
foldMap' :: forall m a. Monoid m => (a -> m) -> MimeResult a -> m
$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
foldr' :: forall a b. (a -> b -> 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
foldl' :: forall b a. (b -> a -> b) -> b -> MimeResult a -> b
$cfoldr1 :: forall a. (a -> a -> a) -> MimeResult a -> a
foldr1 :: forall a. (a -> a -> a) -> MimeResult a -> a
$cfoldl1 :: forall a. (a -> a -> a) -> MimeResult a -> a
foldl1 :: forall a. (a -> a -> a) -> MimeResult a -> a
$ctoList :: forall a. MimeResult a -> [a]
toList :: forall a. MimeResult a -> [a]
$cnull :: forall a. MimeResult a -> Bool
null :: forall a. MimeResult a -> Bool
$clength :: forall a. MimeResult a -> Int
length :: forall a. MimeResult a -> Int
$celem :: forall a. Eq a => a -> MimeResult a -> Bool
elem :: forall a. Eq a => a -> MimeResult a -> Bool
$cmaximum :: forall a. Ord a => MimeResult a -> a
maximum :: forall a. Ord a => MimeResult a -> a
$cminimum :: forall a. Ord a => MimeResult a -> a
minimum :: forall a. Ord a => MimeResult a -> a
$csum :: forall a. Num a => MimeResult a -> a
sum :: forall a. Num a => MimeResult a -> a
$cproduct :: forall a. Num a => MimeResult a -> a
product :: forall a. Num a => MimeResult a -> a
Foldable, Functor MimeResult
Foldable MimeResult
(Functor MimeResult, Foldable MimeResult) =>
(forall (f :: * -> *) a b.
 Applicative f =>
 (a -> f b) -> MimeResult a -> f (MimeResult b))
-> (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 (m :: * -> *) a.
    Monad m =>
    MimeResult (m a) -> m (MimeResult a))
-> Traversable 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)
$ctraverse :: forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> MimeResult a -> f (MimeResult b)
traverse :: forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> MimeResult a -> f (MimeResult b)
$csequenceA :: forall (f :: * -> *) a.
Applicative f =>
MimeResult (f a) -> f (MimeResult a)
sequenceA :: forall (f :: * -> *) a.
Applicative f =>
MimeResult (f a) -> f (MimeResult a)
$cmapM :: forall (m :: * -> *) a b.
Monad m =>
(a -> m b) -> MimeResult a -> m (MimeResult b)
mapM :: forall (m :: * -> *) a b.
Monad m =>
(a -> m b) -> MimeResult a -> m (MimeResult b)
$csequence :: forall (m :: * -> *) a.
Monad m =>
MimeResult (m a) -> m (MimeResult a)
sequence :: forall (m :: * -> *) a.
Monad m =>
MimeResult (m a) -> m (MimeResult a)
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
(Int -> MimeError -> ShowS)
-> (MimeError -> String)
-> ([MimeError] -> ShowS)
-> Show MimeError
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> MimeError -> ShowS
showsPrec :: Int -> MimeError -> ShowS
$cshow :: MimeError -> String
show :: MimeError -> String
$cshowList :: [MimeError] -> ShowS
showList :: [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
  -> GiteaConfig -- ^ config
  -> GiteaRequest req contentType res accept -- ^ request
  -> IO (MimeResult res) -- ^ response
dispatchMime :: forall req contentType res accept.
(Produces req accept, MimeUnrender accept res,
 MimeType contentType) =>
Manager
-> GiteaConfig
-> GiteaRequest req contentType res accept
-> IO (MimeResult res)
dispatchMime Manager
manager GiteaConfig
config GiteaRequest req contentType res accept
request = do
  httpResponse <- Manager
-> GiteaConfig
-> GiteaRequest req contentType res accept
-> IO (Response ByteString)
forall req accept contentType res.
(Produces req accept, MimeType contentType) =>
Manager
-> GiteaConfig
-> GiteaRequest req contentType res accept
-> IO (Response ByteString)
dispatchLbs Manager
manager GiteaConfig
config GiteaRequest req contentType res accept
request
  let statusCode = Status -> Int
NH.statusCode (Status -> Int)
-> (Response ByteString -> Status) -> Response ByteString -> Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Response ByteString -> Status
forall body. Response body -> Status
NH.responseStatus (Response ByteString -> Int) -> Response ByteString -> Int
forall a b. (a -> b) -> a -> b
$ Response ByteString
httpResponse
  parsedResult <-
    runConfigLogWithExceptions "Client" config $
    do if (statusCode >= 400 && statusCode < 600)
         then do
           let s = String
"error statusCode: " String -> ShowS
forall a. [a] -> [a] -> [a]
++ Int -> String
forall a. Show a => a -> String
show Int
statusCode
           _log "Client" levelError (T.pack s)
           pure (Left (MimeError s httpResponse))
         else case mimeUnrender (P.Proxy :: P.Proxy accept) (NH.responseBody httpResponse) of
           Left String
s -> do
             Text -> LogLevel -> Text -> LoggingT IO ()
forall (m :: * -> *).
(MonadIO m, MonadLogger m) =>
Text -> LogLevel -> Text -> m ()
_log Text
"Client" LogLevel
levelError (String -> Text
T.pack String
s)
             Either MimeError res -> LoggingT IO (Either MimeError res)
forall a. a -> LoggingT IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (MimeError -> Either MimeError res
forall a b. a -> Either a b
Left (String -> Response ByteString -> MimeError
MimeError String
s Response ByteString
httpResponse))
           Right res
r -> Either MimeError res -> LoggingT IO (Either MimeError res)
forall a. a -> LoggingT IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (res -> Either MimeError res
forall a b. b -> Either a b
Right res
r)
  return (MimeResult parsedResult 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
  -> GiteaConfig -- ^ config
  -> GiteaRequest 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
-> GiteaConfig
-> GiteaRequest req contentType res accept
-> IO (Either MimeError res)
dispatchMime' Manager
manager GiteaConfig
config GiteaRequest req contentType res accept
request  = do
    MimeResult parsedResult _ <- Manager
-> GiteaConfig
-> GiteaRequest req contentType res accept
-> IO (MimeResult res)
forall req contentType res accept.
(Produces req accept, MimeUnrender accept res,
 MimeType contentType) =>
Manager
-> GiteaConfig
-> GiteaRequest req contentType res accept
-> IO (MimeResult res)
dispatchMime Manager
manager GiteaConfig
config GiteaRequest req contentType res accept
request
    return 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
  -> GiteaConfig -- ^ config
  -> GiteaRequest req contentType res accept -- ^ request
  -> IO (NH.Response BCL.ByteString) -- ^ response
dispatchLbsUnsafe :: forall accept contentType req res.
(MimeType accept, MimeType contentType) =>
Manager
-> GiteaConfig
-> GiteaRequest req contentType res accept
-> IO (Response ByteString)
dispatchLbsUnsafe Manager
manager GiteaConfig
config GiteaRequest req contentType res accept
request  = do
  initReq <- GiteaConfig
-> GiteaRequest req contentType res accept
-> IO (InitRequest req contentType res accept)
forall accept contentType req res.
(MimeType accept, MimeType contentType) =>
GiteaConfig
-> GiteaRequest req contentType res accept
-> IO (InitRequest req contentType res accept)
_toInitRequest GiteaConfig
config GiteaRequest req contentType res accept
request
  dispatchInitUnsafe manager config initReq

-- | dispatch an InitRequest
dispatchInitUnsafe
  :: NH.Manager -- ^ http-client Connection manager
  -> GiteaConfig -- ^ config
  -> InitRequest req contentType res accept -- ^ init request
  -> IO (NH.Response BCL.ByteString) -- ^ response
dispatchInitUnsafe :: forall req contentType res accept.
Manager
-> GiteaConfig
-> InitRequest req contentType res accept
-> IO (Response ByteString)
dispatchInitUnsafe Manager
manager GiteaConfig
config (InitRequest Request
req) = do
  Text -> GiteaConfig -> LogExec IO (Response ByteString)
forall (m :: * -> *) a.
(MonadCatch m, MonadIO m) =>
Text -> GiteaConfig -> LogExec m a
runConfigLogWithExceptions Text
src GiteaConfig
config LogExec IO (Response ByteString)
-> LogExec IO (Response ByteString)
forall a b. (a -> b) -> a -> b
$
    do Text -> LogLevel -> Text -> LoggingT IO ()
forall (m :: * -> *).
(MonadIO m, MonadLogger m) =>
Text -> LogLevel -> Text -> m ()
_log Text
src LogLevel
levelInfo Text
requestLogMsg
       Text -> LogLevel -> Text -> LoggingT IO ()
forall (m :: * -> *).
(MonadIO m, MonadLogger m) =>
Text -> LogLevel -> Text -> m ()
_log Text
src LogLevel
levelDebug Text
requestDbgLogMsg
       res <- IO (Response ByteString) -> LoggingT IO (Response ByteString)
forall a. IO a -> LoggingT IO a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
P.liftIO (IO (Response ByteString) -> LoggingT IO (Response ByteString))
-> IO (Response ByteString) -> LoggingT IO (Response ByteString)
forall a b. (a -> b) -> a -> b
$ Request -> Manager -> IO (Response ByteString)
NH.httpLbs Request
req Manager
manager
       _log src levelInfo (responseLogMsg res)
       _log src levelDebug ((T.pack . show) res)
       return res
  where
    src :: Text
src = Text
"Client"
    endpoint :: Text
endpoint =
      String -> Text
T.pack (String -> Text) -> String -> Text
forall a b. (a -> b) -> a -> b
$
      ByteString -> String
BC.unpack (ByteString -> String) -> ByteString -> String
forall a b. (a -> b) -> a -> b
$
      Request -> ByteString
NH.method Request
req ByteString -> ByteString -> ByteString
forall a. Semigroup a => a -> a -> a
<> ByteString
" " ByteString -> ByteString -> ByteString
forall a. Semigroup a => a -> a -> a
<> Request -> ByteString
NH.host Request
req ByteString -> ByteString -> ByteString
forall a. Semigroup a => a -> a -> a
<> Request -> ByteString
NH.path Request
req ByteString -> ByteString -> ByteString
forall a. Semigroup a => a -> a -> a
<> Request -> ByteString
NH.queryString Request
req
    requestLogMsg :: Text
requestLogMsg = Text
"REQ:" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
endpoint
    requestDbgLogMsg :: Text
requestDbgLogMsg =
      Text
"Headers=" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> (String -> Text
T.pack (String -> Text)
-> (RequestHeaders -> String) -> RequestHeaders -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. RequestHeaders -> String
forall a. Show a => a -> String
show) (Request -> RequestHeaders
NH.requestHeaders Request
req) Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
" Body=" Text -> Text -> Text
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 (String -> Text) -> (Int -> String) -> Int -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> String
forall a. Show a => a -> String
show) (Int -> Text) -> (Response body -> Int) -> Response body -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Status -> Int
NH.statusCode (Status -> Int)
-> (Response body -> Status) -> Response body -> Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Response body -> Status
forall body. Response body -> Status
NH.responseStatus
    responseLogMsg :: Response body -> Text
responseLogMsg Response body
res =
      Text
"RES:statusCode=" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Response body -> Text
forall {body}. Response body -> Text
responseStatusCode Response body
res Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
" (" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
endpoint Text -> Text -> Text
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
[InitRequest req contentType res accept] -> ShowS
InitRequest req contentType res accept -> String
(Int -> InitRequest req contentType res accept -> ShowS)
-> (InitRequest req contentType res accept -> String)
-> ([InitRequest req contentType res accept] -> ShowS)
-> Show (InitRequest req contentType res accept)
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
$cshowsPrec :: forall req contentType res accept.
Int -> InitRequest req contentType res accept -> ShowS
showsPrec :: Int -> InitRequest req contentType res accept -> ShowS
$cshow :: forall req contentType res accept.
InitRequest req contentType res accept -> String
show :: InitRequest req contentType res accept -> String
$cshowList :: forall req contentType res accept.
[InitRequest req contentType res accept] -> ShowS
showList :: [InitRequest req contentType res accept] -> ShowS
Show)

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

    pure (InitRequest 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 = Request -> InitRequest req contentType res accept
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 = (Request -> InitRequest req contentType res accept)
-> m Request -> m (InitRequest req contentType res accept)
forall a b. (a -> b) -> m a -> m b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Request -> InitRequest req contentType res accept
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
  => GiteaConfig -> LogExec m a
runConfigLog :: forall (m :: * -> *) a. MonadIO m => GiteaConfig -> LogExec m a
runConfigLog GiteaConfig
config = GiteaConfig -> LogExecWithContext
configLogExecWithContext GiteaConfig
config (GiteaConfig -> LogContext
configLogContext GiteaConfig
config)

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