{-# 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 Kubernetes.OpenAPI.Client where
import Kubernetes.OpenAPI.Core
import Kubernetes.OpenAPI.Logging
import Kubernetes.OpenAPI.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.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(..))
dispatchLbs
:: (Produces req accept, MimeType contentType)
=> NH.Manager
-> KubernetesClientConfig
-> KubernetesRequest req contentType res accept
-> IO (NH.Response BCL.ByteString)
dispatchLbs :: Manager
-> KubernetesClientConfig
-> KubernetesRequest req contentType res accept
-> IO (Response ByteString)
dispatchLbs Manager
manager KubernetesClientConfig
config KubernetesRequest req contentType res accept
request = do
InitRequest req contentType res accept
initReq <- KubernetesClientConfig
-> KubernetesRequest req contentType res accept
-> IO (InitRequest req contentType res accept)
forall accept contentType req res.
(MimeType accept, MimeType contentType) =>
KubernetesClientConfig
-> KubernetesRequest req contentType res accept
-> IO (InitRequest req contentType res accept)
_toInitRequest KubernetesClientConfig
config KubernetesRequest req contentType res accept
request
Manager
-> KubernetesClientConfig
-> InitRequest req contentType res accept
-> IO (Response ByteString)
forall req contentType res accept.
Manager
-> KubernetesClientConfig
-> InitRequest req contentType res accept
-> IO (Response ByteString)
dispatchInitUnsafe Manager
manager KubernetesClientConfig
config InitRequest req contentType res accept
initReq
data MimeResult res =
MimeResult { MimeResult res -> Either MimeError res
mimeResult :: Either MimeError res
, MimeResult res -> Response ByteString
mimeResultResponse :: NH.Response BCL.ByteString
}
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
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, a -> MimeResult b -> MimeResult a
(a -> b) -> MimeResult a -> MimeResult b
(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
<$ :: a -> MimeResult b -> MimeResult a
$c<$ :: forall a b. a -> MimeResult b -> MimeResult a
fmap :: (a -> b) -> MimeResult a -> MimeResult b
$cfmap :: forall a b. (a -> b) -> MimeResult a -> MimeResult b
Functor, MimeResult a -> Bool
(a -> m) -> MimeResult a -> m
(a -> b -> b) -> b -> MimeResult a -> b
(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
product :: MimeResult a -> a
$cproduct :: forall a. Num a => MimeResult a -> a
sum :: MimeResult a -> a
$csum :: forall a. Num a => MimeResult a -> a
minimum :: MimeResult a -> a
$cminimum :: forall a. Ord a => MimeResult a -> a
maximum :: MimeResult a -> a
$cmaximum :: forall a. Ord a => MimeResult a -> a
elem :: a -> MimeResult a -> Bool
$celem :: forall a. Eq a => a -> MimeResult a -> Bool
length :: MimeResult a -> Int
$clength :: forall a. MimeResult a -> Int
null :: MimeResult a -> Bool
$cnull :: forall a. MimeResult a -> Bool
toList :: MimeResult a -> [a]
$ctoList :: forall a. MimeResult a -> [a]
foldl1 :: (a -> a -> a) -> MimeResult a -> a
$cfoldl1 :: forall a. (a -> a -> a) -> MimeResult a -> a
foldr1 :: (a -> a -> a) -> MimeResult a -> a
$cfoldr1 :: forall a. (a -> a -> a) -> MimeResult a -> a
foldl' :: (b -> a -> b) -> b -> MimeResult a -> b
$cfoldl' :: forall b a. (b -> a -> b) -> b -> MimeResult a -> b
foldl :: (b -> a -> b) -> b -> MimeResult a -> b
$cfoldl :: forall b a. (b -> a -> b) -> b -> MimeResult a -> b
foldr' :: (a -> b -> b) -> b -> MimeResult a -> b
$cfoldr' :: forall a b. (a -> b -> b) -> b -> MimeResult a -> b
foldr :: (a -> b -> b) -> b -> MimeResult a -> b
$cfoldr :: forall a b. (a -> b -> b) -> b -> MimeResult a -> b
foldMap' :: (a -> m) -> MimeResult a -> m
$cfoldMap' :: forall m a. Monoid m => (a -> m) -> MimeResult a -> m
foldMap :: (a -> m) -> MimeResult a -> m
$cfoldMap :: forall m a. Monoid m => (a -> m) -> MimeResult a -> m
fold :: MimeResult m -> m
$cfold :: forall m. Monoid m => MimeResult m -> m
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
(a -> f b) -> MimeResult a -> f (MimeResult b)
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 :: MimeResult (m a) -> m (MimeResult a)
$csequence :: forall (m :: * -> *) a.
Monad m =>
MimeResult (m a) -> m (MimeResult a)
mapM :: (a -> m b) -> MimeResult a -> m (MimeResult b)
$cmapM :: forall (m :: * -> *) a b.
Monad m =>
(a -> m b) -> MimeResult a -> m (MimeResult b)
sequenceA :: MimeResult (f a) -> f (MimeResult a)
$csequenceA :: forall (f :: * -> *) a.
Applicative f =>
MimeResult (f a) -> f (MimeResult a)
traverse :: (a -> f b) -> MimeResult a -> f (MimeResult b)
$ctraverse :: forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> MimeResult a -> f (MimeResult b)
$cp2Traversable :: Foldable MimeResult
$cp1Traversable :: Functor MimeResult
Traversable)
data MimeError =
MimeError {
MimeError -> String
mimeError :: String
, MimeError -> Response ByteString
mimeErrorResponse :: NH.Response BCL.ByteString
} deriving (MimeError -> MimeError -> Bool
(MimeError -> MimeError -> Bool)
-> (MimeError -> MimeError -> Bool) -> Eq MimeError
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: MimeError -> MimeError -> Bool
$c/= :: MimeError -> MimeError -> Bool
== :: MimeError -> MimeError -> Bool
$c== :: MimeError -> MimeError -> Bool
Eq, 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
showList :: [MimeError] -> ShowS
$cshowList :: [MimeError] -> ShowS
show :: MimeError -> String
$cshow :: MimeError -> String
showsPrec :: Int -> MimeError -> ShowS
$cshowsPrec :: Int -> MimeError -> ShowS
Show)
dispatchMime
:: forall req contentType res accept. (Produces req accept, MimeUnrender accept res, MimeType contentType)
=> NH.Manager
-> KubernetesClientConfig
-> KubernetesRequest req contentType res accept
-> IO (MimeResult res)
dispatchMime :: Manager
-> KubernetesClientConfig
-> KubernetesRequest req contentType res accept
-> IO (MimeResult res)
dispatchMime Manager
manager KubernetesClientConfig
config KubernetesRequest req contentType res accept
request = do
Response ByteString
httpResponse <- Manager
-> KubernetesClientConfig
-> KubernetesRequest req contentType res accept
-> IO (Response ByteString)
forall req accept contentType res.
(Produces req accept, MimeType contentType) =>
Manager
-> KubernetesClientConfig
-> KubernetesRequest req contentType res accept
-> IO (Response ByteString)
dispatchLbs Manager
manager KubernetesClientConfig
config KubernetesRequest req contentType res accept
request
let statusCode :: Int
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
Either MimeError res
parsedResult <-
Text -> KubernetesClientConfig -> LogExec IO
forall (m :: * -> *).
(MonadCatch m, MonadIO m) =>
Text -> KubernetesClientConfig -> LogExec m
runConfigLogWithExceptions Text
"Client" KubernetesClientConfig
config (KatipT IO (Either MimeError res) -> IO (Either MimeError res))
-> KatipT IO (Either MimeError res) -> IO (Either MimeError res)
forall a b. (a -> b) -> a -> b
$
do if (Int
statusCode Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= Int
400 Bool -> Bool -> Bool
&& Int
statusCode Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
600)
then do
let s :: String
s = String
"error statusCode: " String -> ShowS
forall a. [a] -> [a] -> [a]
++ Int -> String
forall a. Show a => a -> String
show Int
statusCode
Text -> LogLevel -> Text -> KatipT IO ()
forall (m :: * -> *).
(Applicative m, Katip m) =>
Text -> LogLevel -> Text -> m ()
_log Text
"Client" LogLevel
levelError (String -> Text
T.pack String
s)
Either MimeError res -> KatipT IO (Either MimeError res)
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))
else case Proxy accept -> ByteString -> Either String res
forall mtype o.
MimeUnrender mtype o =>
Proxy mtype -> ByteString -> Either String o
mimeUnrender (Proxy accept
forall k (t :: k). Proxy t
P.Proxy :: P.Proxy accept) (Response ByteString -> ByteString
forall body. Response body -> body
NH.responseBody Response ByteString
httpResponse) of
Left String
s -> do
Text -> LogLevel -> Text -> KatipT IO ()
forall (m :: * -> *).
(Applicative m, Katip m) =>
Text -> LogLevel -> Text -> m ()
_log Text
"Client" LogLevel
levelError (String -> Text
T.pack String
s)
Either MimeError res -> KatipT IO (Either MimeError res)
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 -> KatipT IO (Either MimeError res)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (res -> Either MimeError res
forall a b. b -> Either a b
Right res
r)
MimeResult res -> IO (MimeResult res)
forall (m :: * -> *) a. Monad m => a -> m a
return (Either MimeError res -> Response ByteString -> MimeResult res
forall res.
Either MimeError res -> Response ByteString -> MimeResult res
MimeResult Either MimeError res
parsedResult Response ByteString
httpResponse)
dispatchMime'
:: (Produces req accept, MimeUnrender accept res, MimeType contentType)
=> NH.Manager
-> KubernetesClientConfig
-> KubernetesRequest req contentType res accept
-> IO (Either MimeError res)
dispatchMime' :: Manager
-> KubernetesClientConfig
-> KubernetesRequest req contentType res accept
-> IO (Either MimeError res)
dispatchMime' Manager
manager KubernetesClientConfig
config KubernetesRequest req contentType res accept
request = do
MimeResult Either MimeError res
parsedResult Response ByteString
_ <- Manager
-> KubernetesClientConfig
-> KubernetesRequest req contentType res accept
-> IO (MimeResult res)
forall req contentType res accept.
(Produces req accept, MimeUnrender accept res,
MimeType contentType) =>
Manager
-> KubernetesClientConfig
-> KubernetesRequest req contentType res accept
-> IO (MimeResult res)
dispatchMime Manager
manager KubernetesClientConfig
config KubernetesRequest req contentType res accept
request
Either MimeError res -> IO (Either MimeError res)
forall (m :: * -> *) a. Monad m => a -> m a
return Either MimeError res
parsedResult
dispatchLbsUnsafe
:: (MimeType accept, MimeType contentType)
=> NH.Manager
-> KubernetesClientConfig
-> KubernetesRequest req contentType res accept
-> IO (NH.Response BCL.ByteString)
dispatchLbsUnsafe :: Manager
-> KubernetesClientConfig
-> KubernetesRequest req contentType res accept
-> IO (Response ByteString)
dispatchLbsUnsafe Manager
manager KubernetesClientConfig
config KubernetesRequest req contentType res accept
request = do
InitRequest req contentType res accept
initReq <- KubernetesClientConfig
-> KubernetesRequest req contentType res accept
-> IO (InitRequest req contentType res accept)
forall accept contentType req res.
(MimeType accept, MimeType contentType) =>
KubernetesClientConfig
-> KubernetesRequest req contentType res accept
-> IO (InitRequest req contentType res accept)
_toInitRequest KubernetesClientConfig
config KubernetesRequest req contentType res accept
request
Manager
-> KubernetesClientConfig
-> InitRequest req contentType res accept
-> IO (Response ByteString)
forall req contentType res accept.
Manager
-> KubernetesClientConfig
-> InitRequest req contentType res accept
-> IO (Response ByteString)
dispatchInitUnsafe Manager
manager KubernetesClientConfig
config InitRequest req contentType res accept
initReq
dispatchInitUnsafe
:: NH.Manager
-> KubernetesClientConfig
-> InitRequest req contentType res accept
-> IO (NH.Response BCL.ByteString)
dispatchInitUnsafe :: Manager
-> KubernetesClientConfig
-> InitRequest req contentType res accept
-> IO (Response ByteString)
dispatchInitUnsafe Manager
manager KubernetesClientConfig
config (InitRequest Request
req) = do
Text -> KubernetesClientConfig -> LogExec IO
forall (m :: * -> *).
(MonadCatch m, MonadIO m) =>
Text -> KubernetesClientConfig -> LogExec m
runConfigLogWithExceptions Text
src KubernetesClientConfig
config (KatipT IO (Response ByteString) -> IO (Response ByteString))
-> KatipT IO (Response ByteString) -> IO (Response ByteString)
forall a b. (a -> b) -> a -> b
$
do Text -> LogLevel -> Text -> KatipT IO ()
forall (m :: * -> *).
(Applicative m, Katip m) =>
Text -> LogLevel -> Text -> m ()
_log Text
src LogLevel
levelInfo Text
requestLogMsg
Text -> LogLevel -> Text -> KatipT IO ()
forall (m :: * -> *).
(Applicative m, Katip m) =>
Text -> LogLevel -> Text -> m ()
_log Text
src LogLevel
levelDebug Text
requestDbgLogMsg
Response ByteString
res <- IO (Response ByteString) -> KatipT IO (Response ByteString)
forall (m :: * -> *) a. MonadIO m => IO a -> m a
P.liftIO (IO (Response ByteString) -> KatipT IO (Response ByteString))
-> IO (Response ByteString) -> KatipT IO (Response ByteString)
forall a b. (a -> b) -> a -> b
$ Request -> Manager -> IO (Response ByteString)
NH.httpLbs Request
req Manager
manager
Text -> LogLevel -> Text -> KatipT IO ()
forall (m :: * -> *).
(Applicative m, Katip m) =>
Text -> LogLevel -> Text -> m ()
_log Text
src LogLevel
levelInfo (Response ByteString -> Text
forall body. Response body -> Text
responseLogMsg Response ByteString
res)
Text -> LogLevel -> Text -> KatipT IO ()
forall (m :: * -> *).
(Applicative m, Katip m) =>
Text -> LogLevel -> Text -> m ()
_log Text
src LogLevel
levelDebug ((String -> Text
T.pack (String -> Text)
-> (Response ByteString -> String) -> Response ByteString -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Response ByteString -> String
forall a. Show a => a -> String
show) Response ByteString
res)
Response ByteString -> KatipT IO (Response ByteString)
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 (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
")"
newtype InitRequest req contentType res accept = InitRequest
{ 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
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)
_toInitRequest
:: (MimeType accept, MimeType contentType)
=> KubernetesClientConfig
-> KubernetesRequest req contentType res accept
-> IO (InitRequest req contentType res accept)
_toInitRequest :: KubernetesClientConfig
-> KubernetesRequest req contentType res accept
-> IO (InitRequest req contentType res accept)
_toInitRequest KubernetesClientConfig
config KubernetesRequest req contentType res accept
req0 =
Text -> KubernetesClientConfig -> LogExec IO
forall (m :: * -> *).
(MonadCatch m, MonadIO m) =>
Text -> KubernetesClientConfig -> LogExec m
runConfigLogWithExceptions Text
"Client" KubernetesClientConfig
config (KatipT IO (InitRequest req contentType res accept)
-> IO (InitRequest req contentType res accept))
-> KatipT IO (InitRequest req contentType res accept)
-> IO (InitRequest req contentType res accept)
forall a b. (a -> b) -> a -> b
$ do
Request
parsedReq <- IO Request -> KatipT IO Request
forall (m :: * -> *) a. MonadIO m => IO a -> m a
P.liftIO (IO Request -> KatipT IO Request)
-> IO Request -> KatipT 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 (KubernetesClientConfig -> ByteString
configHost KubernetesClientConfig
config) ([ByteString] -> ByteString
BCL.concat (KubernetesRequest req contentType res accept -> [ByteString]
forall req contentType res accept.
KubernetesRequest req contentType res accept -> [ByteString]
rUrlPath KubernetesRequest req contentType res accept
req0))
KubernetesRequest req contentType res accept
req1 <- IO (KubernetesRequest req contentType res accept)
-> KatipT IO (KubernetesRequest req contentType res accept)
forall (m :: * -> *) a. MonadIO m => IO a -> m a
P.liftIO (IO (KubernetesRequest req contentType res accept)
-> KatipT IO (KubernetesRequest req contentType res accept))
-> IO (KubernetesRequest req contentType res accept)
-> KatipT IO (KubernetesRequest req contentType res accept)
forall a b. (a -> b) -> a -> b
$ KubernetesRequest req contentType res accept
-> KubernetesClientConfig
-> IO (KubernetesRequest req contentType res accept)
forall req contentType res accept.
KubernetesRequest req contentType res accept
-> KubernetesClientConfig
-> IO (KubernetesRequest req contentType res accept)
_applyAuthMethods KubernetesRequest req contentType res accept
req0 KubernetesClientConfig
config
Bool -> KatipT IO () -> KatipT IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
P.when
(KubernetesClientConfig -> Bool
configValidateAuthMethods KubernetesClientConfig
config Bool -> Bool -> Bool
&& (Bool -> Bool
not (Bool -> Bool)
-> (KubernetesRequest req contentType res accept -> Bool)
-> KubernetesRequest req contentType res accept
-> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [TypeRep] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null ([TypeRep] -> Bool)
-> (KubernetesRequest req contentType res accept -> [TypeRep])
-> KubernetesRequest req contentType res accept
-> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. KubernetesRequest req contentType res accept -> [TypeRep]
forall req contentType res accept.
KubernetesRequest req contentType res accept -> [TypeRep]
rAuthTypes) KubernetesRequest req contentType res accept
req1)
(AuthMethodException -> KatipT IO ()
forall (m :: * -> *) e a. (MonadThrow m, Exception e) => e -> m a
E.throw (AuthMethodException -> KatipT IO ())
-> AuthMethodException -> KatipT IO ()
forall a b. (a -> b) -> a -> b
$ String -> AuthMethodException
AuthMethodException (String -> AuthMethodException) -> String -> AuthMethodException
forall a b. (a -> b) -> a -> b
$ String
"AuthMethod not configured: " String -> ShowS
forall a. Semigroup a => a -> a -> a
<> (TypeRep -> String
forall a. Show a => a -> String
show (TypeRep -> String)
-> (KubernetesRequest req contentType res accept -> TypeRep)
-> KubernetesRequest req contentType res accept
-> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [TypeRep] -> TypeRep
forall a. [a] -> a
head ([TypeRep] -> TypeRep)
-> (KubernetesRequest req contentType res accept -> [TypeRep])
-> KubernetesRequest req contentType res accept
-> TypeRep
forall b c a. (b -> c) -> (a -> b) -> a -> c
. KubernetesRequest req contentType res accept -> [TypeRep]
forall req contentType res accept.
KubernetesRequest req contentType res accept -> [TypeRep]
rAuthTypes) KubernetesRequest req contentType res accept
req1)
let req2 :: KubernetesRequest req contentType res accept
req2 = KubernetesRequest req contentType res accept
req1 KubernetesRequest req contentType res accept
-> (KubernetesRequest req contentType res accept
-> KubernetesRequest req contentType res accept)
-> KubernetesRequest req contentType res accept
forall a b. a -> (a -> b) -> b
& KubernetesRequest req contentType res accept
-> KubernetesRequest req contentType res accept
forall req contentType res accept.
MimeType contentType =>
KubernetesRequest req contentType res accept
-> KubernetesRequest req contentType res accept
_setContentTypeHeader KubernetesRequest req contentType res accept
-> (KubernetesRequest req contentType res accept
-> KubernetesRequest req contentType res accept)
-> KubernetesRequest req contentType res accept
forall a b. a -> (a -> b) -> b
& KubernetesRequest req contentType res accept
-> KubernetesRequest req contentType res accept
forall req contentType res accept.
MimeType accept =>
KubernetesRequest req contentType res accept
-> KubernetesRequest req contentType res accept
_setAcceptHeader
reqHeaders :: RequestHeaders
reqHeaders = (HeaderName
"User-Agent", Text -> ByteString
forall a. ToHttpApiData a => a -> ByteString
WH.toHeader (KubernetesClientConfig -> Text
configUserAgent KubernetesClientConfig
config)) (HeaderName, ByteString) -> RequestHeaders -> RequestHeaders
forall a. a -> [a] -> [a]
: Params -> RequestHeaders
paramsHeaders (KubernetesRequest req contentType res accept -> Params
forall req contentType res accept.
KubernetesRequest req contentType res accept -> Params
rParams KubernetesRequest req contentType res accept
req2)
reqQuery :: ByteString
reqQuery = Bool -> Query -> ByteString
NH.renderQuery Bool
True (Params -> Query
paramsQuery (KubernetesRequest req contentType res accept -> Params
forall req contentType res accept.
KubernetesRequest req contentType res accept -> Params
rParams KubernetesRequest req contentType res accept
req2))
pReq :: Request
pReq = Request
parsedReq { method :: ByteString
NH.method = (KubernetesRequest req contentType res accept -> ByteString
forall req contentType res accept.
KubernetesRequest req contentType res accept -> ByteString
rMethod KubernetesRequest req contentType res accept
req2)
, requestHeaders :: RequestHeaders
NH.requestHeaders = RequestHeaders
reqHeaders
, queryString :: ByteString
NH.queryString = ByteString
reqQuery
}
Request
outReq <- case Params -> ParamBody
paramsBody (KubernetesRequest req contentType res accept -> Params
forall req contentType res accept.
KubernetesRequest req contentType res accept -> Params
rParams KubernetesRequest req contentType res accept
req2) of
ParamBody
ParamBodyNone -> Request -> KatipT IO Request
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Request
pReq { requestBody :: RequestBody
NH.requestBody = RequestBody
forall a. Monoid a => a
mempty })
ParamBodyB ByteString
bs -> Request -> KatipT IO Request
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Request
pReq { requestBody :: RequestBody
NH.requestBody = ByteString -> RequestBody
NH.RequestBodyBS ByteString
bs })
ParamBodyBL ByteString
bl -> Request -> KatipT IO Request
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Request
pReq { requestBody :: RequestBody
NH.requestBody = ByteString -> RequestBody
NH.RequestBodyLBS ByteString
bl })
ParamBodyFormUrlEncoded Form
form -> Request -> KatipT IO Request
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 -> [Part] -> Request -> KatipT IO Request
forall (m :: * -> *). MonadIO m => [Part] -> Request -> m Request
NH.formDataBody [Part]
parts Request
pReq
InitRequest req contentType res accept
-> KatipT IO (InitRequest req contentType res accept)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Request -> InitRequest req contentType res accept
forall req contentType res accept.
Request -> InitRequest req contentType res accept
InitRequest Request
outReq)
modifyInitRequest :: InitRequest req contentType res accept -> (NH.Request -> NH.Request) -> InitRequest req contentType res accept
modifyInitRequest :: 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)
modifyInitRequestM :: Monad m => InitRequest req contentType res accept -> (NH.Request -> m NH.Request) -> m (InitRequest req contentType res accept)
modifyInitRequestM :: 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 (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)
runConfigLog
:: P.MonadIO m
=> KubernetesClientConfig -> LogExec m
runConfigLog :: KubernetesClientConfig -> LogExec m
runConfigLog KubernetesClientConfig
config = KubernetesClientConfig -> LogContext -> LogExec m
KubernetesClientConfig
-> forall (m :: * -> *). MonadIO m => LogContext -> LogExec m
configLogExecWithContext KubernetesClientConfig
config (KubernetesClientConfig -> LogContext
configLogContext KubernetesClientConfig
config)
runConfigLogWithExceptions
:: (E.MonadCatch m, P.MonadIO m)
=> T.Text -> KubernetesClientConfig -> LogExec m
runConfigLogWithExceptions :: Text -> KubernetesClientConfig -> LogExec m
runConfigLogWithExceptions Text
src KubernetesClientConfig
config = KubernetesClientConfig -> LogExec m
forall (m :: * -> *).
MonadIO m =>
KubernetesClientConfig -> LogExec m
runConfigLog KubernetesClientConfig
config (KatipT m a -> m a)
-> (KatipT m a -> KatipT m a) -> KatipT m a -> m a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> KatipT m a -> KatipT m a
forall (m :: * -> *) a.
(Katip m, MonadCatch m, Applicative m) =>
Text -> m a -> m a
logExceptions Text
src