{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE MonoLocalBinds #-}
{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE OverloadedStrings #-}
{-# OPTIONS_GHC -fno-warn-name-shadowing -fno-warn-unused-binds -fno-warn-unused-imports #-}
module Kubernetes.OpenAPI.API.AuthenticationV1beta1 where
import Kubernetes.OpenAPI.Core
import Kubernetes.OpenAPI.MimeTypes
import Kubernetes.OpenAPI.Model as M
import qualified Data.Aeson as A
import qualified Data.ByteString as B
import qualified Data.ByteString.Lazy as BL
import qualified Data.Data as P (Typeable, TypeRep, typeOf, typeRep)
import qualified Data.Foldable as P
import qualified Data.Map as Map
import qualified Data.Maybe as P
import qualified Data.Proxy as P (Proxy(..))
import qualified Data.Set as Set
import qualified Data.String as P
import qualified Data.Text as T
import qualified Data.Text.Encoding as T
import qualified Data.Text.Lazy as TL
import qualified Data.Text.Lazy.Encoding as TL
import qualified Data.Time as TI
import qualified Network.HTTP.Client.MultipartFormData as NH
import qualified Network.HTTP.Media as ME
import qualified Network.HTTP.Types as NH
import qualified Web.FormUrlEncoded as WH
import qualified Web.HttpApiData as WH
import Data.Text (Text)
import GHC.Base ((<|>))
import Prelude ((==),(/=),($), (.),(<$>),(<*>),(>>=),Maybe(..),Bool(..),Char,Double,FilePath,Float,Int,Integer,String,fmap,undefined,mempty,maybe,pure,Monad,Applicative,Functor)
import qualified Prelude as P
createSelfSubjectReview
:: (Consumes CreateSelfSubjectReview contentType, MimeRender contentType V1beta1SelfSubjectReview)
=> ContentType contentType
-> Accept accept
-> V1beta1SelfSubjectReview
-> KubernetesRequest CreateSelfSubjectReview contentType V1beta1SelfSubjectReview accept
createSelfSubjectReview :: forall contentType accept.
(Consumes CreateSelfSubjectReview contentType,
MimeRender contentType V1beta1SelfSubjectReview) =>
ContentType contentType
-> Accept accept
-> V1beta1SelfSubjectReview
-> KubernetesRequest
CreateSelfSubjectReview contentType V1beta1SelfSubjectReview accept
createSelfSubjectReview ContentType contentType
_ Accept accept
_ V1beta1SelfSubjectReview
body =
Method
-> [ByteString]
-> KubernetesRequest
CreateSelfSubjectReview contentType V1beta1SelfSubjectReview accept
forall req contentType res accept.
Method
-> [ByteString] -> KubernetesRequest req contentType res accept
_mkRequest Method
"POST" [ByteString
"/apis/authentication.k8s.io/v1beta1/selfsubjectreviews"]
KubernetesRequest
CreateSelfSubjectReview contentType V1beta1SelfSubjectReview accept
-> Proxy AuthApiKeyBearerToken
-> KubernetesRequest
CreateSelfSubjectReview contentType V1beta1SelfSubjectReview accept
forall authMethod req contentType res accept.
AuthMethod authMethod =>
KubernetesRequest req contentType res accept
-> Proxy authMethod -> KubernetesRequest req contentType res accept
`_hasAuthType` (Proxy AuthApiKeyBearerToken
forall {k} (t :: k). Proxy t
P.Proxy :: P.Proxy AuthApiKeyBearerToken)
KubernetesRequest
CreateSelfSubjectReview contentType V1beta1SelfSubjectReview accept
-> V1beta1SelfSubjectReview
-> KubernetesRequest
CreateSelfSubjectReview contentType V1beta1SelfSubjectReview accept
forall req param contentType res accept.
(HasBodyParam req param, Consumes req contentType,
MimeRender contentType param) =>
KubernetesRequest req contentType res accept
-> param -> KubernetesRequest req contentType res accept
forall contentType res accept.
(Consumes CreateSelfSubjectReview contentType,
MimeRender contentType V1beta1SelfSubjectReview) =>
KubernetesRequest CreateSelfSubjectReview contentType res accept
-> V1beta1SelfSubjectReview
-> KubernetesRequest CreateSelfSubjectReview contentType res accept
`setBodyParam` V1beta1SelfSubjectReview
body
data CreateSelfSubjectReview
instance HasBodyParam CreateSelfSubjectReview V1beta1SelfSubjectReview
instance HasOptionalParam CreateSelfSubjectReview DryRun where
applyOptionalParam :: forall contentType res accept.
KubernetesRequest CreateSelfSubjectReview contentType res accept
-> DryRun
-> KubernetesRequest CreateSelfSubjectReview contentType res accept
applyOptionalParam KubernetesRequest CreateSelfSubjectReview contentType res accept
req (DryRun Text
xs) =
KubernetesRequest CreateSelfSubjectReview contentType res accept
req KubernetesRequest CreateSelfSubjectReview contentType res accept
-> [QueryItem]
-> KubernetesRequest CreateSelfSubjectReview contentType res accept
forall req contentType res accept.
KubernetesRequest req contentType res accept
-> [QueryItem] -> KubernetesRequest req contentType res accept
`addQuery` (Method, Maybe Text) -> [QueryItem]
forall a. ToHttpApiData a => (Method, Maybe a) -> [QueryItem]
toQuery (Method
"dryRun", Text -> Maybe Text
forall a. a -> Maybe a
Just Text
xs)
instance HasOptionalParam CreateSelfSubjectReview FieldManager where
applyOptionalParam :: forall contentType res accept.
KubernetesRequest CreateSelfSubjectReview contentType res accept
-> FieldManager
-> KubernetesRequest CreateSelfSubjectReview contentType res accept
applyOptionalParam KubernetesRequest CreateSelfSubjectReview contentType res accept
req (FieldManager Text
xs) =
KubernetesRequest CreateSelfSubjectReview contentType res accept
req KubernetesRequest CreateSelfSubjectReview contentType res accept
-> [QueryItem]
-> KubernetesRequest CreateSelfSubjectReview contentType res accept
forall req contentType res accept.
KubernetesRequest req contentType res accept
-> [QueryItem] -> KubernetesRequest req contentType res accept
`addQuery` (Method, Maybe Text) -> [QueryItem]
forall a. ToHttpApiData a => (Method, Maybe a) -> [QueryItem]
toQuery (Method
"fieldManager", Text -> Maybe Text
forall a. a -> Maybe a
Just Text
xs)
instance HasOptionalParam CreateSelfSubjectReview FieldValidation where
applyOptionalParam :: forall contentType res accept.
KubernetesRequest CreateSelfSubjectReview contentType res accept
-> FieldValidation
-> KubernetesRequest CreateSelfSubjectReview contentType res accept
applyOptionalParam KubernetesRequest CreateSelfSubjectReview contentType res accept
req (FieldValidation Text
xs) =
KubernetesRequest CreateSelfSubjectReview contentType res accept
req KubernetesRequest CreateSelfSubjectReview contentType res accept
-> [QueryItem]
-> KubernetesRequest CreateSelfSubjectReview contentType res accept
forall req contentType res accept.
KubernetesRequest req contentType res accept
-> [QueryItem] -> KubernetesRequest req contentType res accept
`addQuery` (Method, Maybe Text) -> [QueryItem]
forall a. ToHttpApiData a => (Method, Maybe a) -> [QueryItem]
toQuery (Method
"fieldValidation", Text -> Maybe Text
forall a. a -> Maybe a
Just Text
xs)
instance HasOptionalParam CreateSelfSubjectReview Pretty where
applyOptionalParam :: forall contentType res accept.
KubernetesRequest CreateSelfSubjectReview contentType res accept
-> Pretty
-> KubernetesRequest CreateSelfSubjectReview contentType res accept
applyOptionalParam KubernetesRequest CreateSelfSubjectReview contentType res accept
req (Pretty Text
xs) =
KubernetesRequest CreateSelfSubjectReview contentType res accept
req KubernetesRequest CreateSelfSubjectReview contentType res accept
-> [QueryItem]
-> KubernetesRequest CreateSelfSubjectReview contentType res accept
forall req contentType res accept.
KubernetesRequest req contentType res accept
-> [QueryItem] -> KubernetesRequest req contentType res accept
`addQuery` (Method, Maybe Text) -> [QueryItem]
forall a. ToHttpApiData a => (Method, Maybe a) -> [QueryItem]
toQuery (Method
"pretty", Text -> Maybe Text
forall a. a -> Maybe a
Just Text
xs)
instance MimeType mtype => Consumes CreateSelfSubjectReview mtype
instance Produces CreateSelfSubjectReview MimeJSON
instance Produces CreateSelfSubjectReview MimeVndKubernetesProtobuf
instance Produces CreateSelfSubjectReview MimeCbor
instance Produces CreateSelfSubjectReview MimeYaml
getAPIResources
:: Accept accept
-> KubernetesRequest GetAPIResources MimeNoContent V1APIResourceList accept
getAPIResources :: forall accept.
Accept accept
-> KubernetesRequest
GetAPIResources MimeNoContent V1APIResourceList accept
getAPIResources Accept accept
_ =
Method
-> [ByteString]
-> KubernetesRequest
GetAPIResources MimeNoContent V1APIResourceList accept
forall req contentType res accept.
Method
-> [ByteString] -> KubernetesRequest req contentType res accept
_mkRequest Method
"GET" [ByteString
"/apis/authentication.k8s.io/v1beta1/"]
KubernetesRequest
GetAPIResources MimeNoContent V1APIResourceList accept
-> Proxy AuthApiKeyBearerToken
-> KubernetesRequest
GetAPIResources MimeNoContent V1APIResourceList accept
forall authMethod req contentType res accept.
AuthMethod authMethod =>
KubernetesRequest req contentType res accept
-> Proxy authMethod -> KubernetesRequest req contentType res accept
`_hasAuthType` (Proxy AuthApiKeyBearerToken
forall {k} (t :: k). Proxy t
P.Proxy :: P.Proxy AuthApiKeyBearerToken)
data GetAPIResources
instance Produces GetAPIResources MimeJSON
instance Produces GetAPIResources MimeVndKubernetesProtobuf
instance Produces GetAPIResources MimeCbor
instance Produces GetAPIResources MimeYaml