{-# LANGUAGE DataKinds #-}
{-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE DerivingStrategies #-}
{-# LANGUAGE GeneralizedNewtypeDeriving #-}
{-# LANGUAGE LambdaCase #-}
{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE TypeOperators #-}

{- |
  Description: Access the Kubernetes API from within the cluster.

  This module provides functions that access and operate on the
  Kubernetes API.  It is designed to be used from pods running within
  the K8s cluster itself and it won't work otherwise.
-}
module OM.Kubernetes (
  -- * Creating a handle
  newK8s,
  K8s,

  -- * Operations
  listPods,
  postPod,
  deletePod,
  getPodSpec,
  patchService,
  getServiceSpec,
  postService,
  postRoleBinding,
  postRole,
  postServiceAccount,
  postNamespace,
  getPodTemplate,
  queryPods,

  -- * Types
  JsonPatch(..),
  PodName(..),
  PodSpec(..),
  ServiceName(..),
  ServiceSpec(..),
  RoleBindingSpec(..),
  RoleSpec(..),
  ServiceAccountSpec(..),
  NamespaceSpec(..),
  Namespace(..),
  PodTemplateName(..),
  PodTemplateSpec(..),
  Pod(..),
) where


import Control.Exception.Safe (throw)
import Control.Monad ((>=>))
import Control.Monad.IO.Class (MonadIO, liftIO)
import Data.Aeson ((.:), FromJSON, FromJSONKey, ToJSON, ToJSONKey, Value,
  encode, parseJSON, withObject)
import Data.Default.Class (def)
import Data.String (IsString)
import Data.Text (Text)
import Data.Text.Encoding (decodeUtf8, encodeUtf8)
import Data.X509.CertificateStore (CertificateStore, readCertificateStore)
import Network.Connection (TLSSettings(TLSSettings))
import Network.HTTP.Client (Manager, newManager)
import Network.HTTP.Client.TLS (mkManagerSettings)
import Network.HTTP.Types (urlEncode)
import Network.TLS (clientShared, clientSupported,
  clientUseServerNameIndication, defaultParamsClient, sharedCAStore,
  supportedCiphers)
import Network.TLS.Extra.Cipher (ciphersuite_default)
import OM.HTTP (BearerToken(BearerToken))
import Servant.API (Accept(contentType), MimeRender(mimeRender),
  NoContent(NoContent), ToHttpApiData(toQueryParam), (:>), Capture,
  DeleteNoContent, Description, FromHttpApiData, Get, Header', JSON,
  Optional, PatchNoContent, PostNoContent, QueryParam', ReqBody,
  Required, Strict)
import Servant.API.Generic (GenericMode((:-)), Generic)
import Servant.Client (BaseUrl(BaseUrl), Scheme(Https), ClientEnv,
  ClientM, mkClientEnv, runClientM)
import Servant.Client.Generic (genericClient)
import qualified Data.ByteString as BS
import qualified Data.Text.IO as TIO


{- | A subset of the kubernetes api spec. -}
data KubernetesApi mode = KubernetesApi
  { forall mode.
KubernetesApi mode
-> mode
   :- (Header' '[Required, Strict] "Authorization" BearerToken
       :> ("api"
           :> ("v1"
               :> ("namespaces"
                   :> (ReqBody '[JSON] NamespaceSpec :> PostNoContent)))))
kPostNamespaceR :: mode
      :- Header' [Required, Strict] "Authorization" BearerToken
      :> "api"
      :> "v1"
      :> "namespaces"
      :> ReqBody '[JSON] NamespaceSpec
      :> PostNoContent
  , forall mode.
KubernetesApi mode
-> mode
   :- (Header' '[Required, Strict] "Authorization" BearerToken
       :> ("api"
           :> ("v1"
               :> ("namespaces"
                   :> (Capture "namespace" Namespace
                       :> ("pods"
                           :> (Description "List pods" :> Get '[JSON] PodNameList)))))))
kListPodsR :: mode
      :- Header' [Required, Strict] "Authorization" BearerToken
      :> "api"
      :> "v1"
      :> "namespaces"
      :> Capture "namespace" Namespace
      :> "pods"
      :> Description "List pods"
      :> Get '[JSON] PodNameList
  , forall mode.
KubernetesApi mode
-> mode
   :- (Header' '[Required, Strict] "Authorization" BearerToken
       :> ("api"
           :> ("v1"
               :> ("namespaces"
                   :> (Capture "namespace" Namespace
                       :> ("pods"
                           :> (QueryParam'
                                 '[Optional, Required] "labelSelectors" LabelSelectors
                               :> (Description "List pods" :> Get '[JSON] PodList))))))))
kQueryPodsR :: mode
      :- Header' [Required, Strict] "Authorization" BearerToken
      :> "api"
      :> "v1"
      :> "namespaces"
      :> Capture "namespace" Namespace
      :> "pods"
      :> QueryParam' '[Optional, Required] "labelSelectors" LabelSelectors
      :> Description "List pods"
      :> Get '[JSON] PodList
  , forall mode.
KubernetesApi mode
-> mode
   :- (Header' '[Required, Strict] "Authorization" BearerToken
       :> ("api"
           :> ("v1"
               :> ("namespaces"
                   :> (Capture "namespace" Namespace
                       :> ("pods"
                           :> (Description "Post a pod definition"
                               :> (ReqBody '[JSON] PodSpec :> PostNoContent))))))))
kPostPodR :: mode
      :- Header' [Required, Strict] "Authorization" BearerToken
      :> "api"
      :> "v1"
      :> "namespaces"
      :> Capture "namespace" Namespace
      :> "pods"
      :> Description "Post a pod definition"
      :> ReqBody '[JSON] PodSpec
      :> PostNoContent
  , forall mode.
KubernetesApi mode
-> mode
   :- (Header' '[Required, Strict] "Authorization" BearerToken
       :> ("api"
           :> ("v1"
               :> ("namespaces"
                   :> (Capture "namespace" Namespace
                       :> ("pods"
                           :> (Description "Delete a pod"
                               :> (Capture "pod-name" PodName :> DeleteNoContent))))))))
kDeletePodR :: mode
      :- Header' [Required, Strict] "Authorization" BearerToken
      :> "api"
      :> "v1"
      :> "namespaces"
      :> Capture "namespace" Namespace
      :> "pods"
      :> Description "Delete a pod"
      :> Capture "pod-name" PodName
      :> DeleteNoContent
  , forall mode.
KubernetesApi mode
-> mode
   :- (Header' '[Required, Strict] "Authorization" BearerToken
       :> ("api"
           :> ("v1"
               :> ("namespaces"
                   :> (Capture "namespace" Namespace
                       :> ("pods"
                           :> (Description "Get a pod spec"
                               :> (Capture "pod-name" PodName :> Get '[JSON] PodSpec))))))))
kGetPodSpecR :: mode
      :- Header' [Required, Strict] "Authorization" BearerToken
      :> "api"
      :> "v1"
      :> "namespaces"
      :> Capture "namespace" Namespace
      :> "pods"
      :> Description "Get a pod spec"
      :> Capture "pod-name" PodName
      :> Get '[JSON] PodSpec
  , forall mode.
KubernetesApi mode
-> mode
   :- (Header' '[Required, Strict] "Authorization" BearerToken
       :> ("api"
           :> ("v1"
               :> ("namespaces"
                   :> (Capture "namespace" Namespace
                       :> ("services"
                           :> (Description "Get the cluster service."
                               :> (Capture "service-name" ServiceName
                                   :> Get '[JSON] ServiceSpec))))))))
kGetServiceSpecR :: mode
      :- Header' [Required, Strict] "Authorization" BearerToken
      :> "api"
      :> "v1"
      :> "namespaces"
      :> Capture "namespace" Namespace
      :> "services"
      :> Description "Get the cluster service."
      :> Capture "service-name" ServiceName
      :> Get '[JSON] ServiceSpec
  , forall mode.
KubernetesApi mode
-> mode
   :- (Header' '[Required, Strict] "Authorization" BearerToken
       :> ("api"
           :> ("v1"
               :> ("namespaces"
                   :> (Capture "namespace" Namespace
                       :> ("services"
                           :> (Description "Post a new serivce."
                               :> (ReqBody '[JSON] ServiceSpec :> PostNoContent))))))))
kPostServiceR :: mode
      :- Header' [Required, Strict] "Authorization" BearerToken
      :> "api"
      :> "v1"
      :> "namespaces"
      :> Capture "namespace" Namespace
      :> "services"
      :> Description "Post a new serivce."
      :> ReqBody '[JSON] ServiceSpec
      :> PostNoContent
  , forall mode.
KubernetesApi mode
-> mode
   :- (Header' '[Required, Strict] "Authorization" BearerToken
       :> ("api"
           :> ("v1"
               :> ("namespaces"
                   :> (Capture "namespace" Namespace
                       :> ("services"
                           :> (Description "Update the cluster spec annotation."
                               :> (Capture "service-name" ServiceName
                                   :> (ReqBody '[JsonPatch] JsonPatch :> PatchNoContent)))))))))
kPatchServiceR :: mode
      :- Header' [Required, Strict] "Authorization" BearerToken
      :> "api"
      :> "v1"
      :> "namespaces"
      :> Capture "namespace" Namespace
      :> "services"
      :> Description "Update the cluster spec annotation."
      :> Capture "service-name" ServiceName
      :> ReqBody '[JsonPatch] JsonPatch
      :> PatchNoContent
  , forall mode.
KubernetesApi mode
-> mode
   :- (Header' '[Required, Strict] "Authorization" BearerToken
       :> ("api"
           :> ("v1"
               :> ("namespaces"
                   :> (Capture "namespace" Namespace
                       :> (Description "Roll API"
                           :> ("roles" :> (ReqBody '[JSON] RoleSpec :> PostNoContent))))))))
kPostRoleR :: mode
      :- Header' [Required, Strict] "Authorization" BearerToken
      :> "api"
      :> "v1"
      :> "namespaces"
      :> Capture "namespace" Namespace
      :> Description "Roll API"
      :> "roles"
      :> ReqBody '[JSON] RoleSpec
      :> PostNoContent
  , forall mode.
KubernetesApi mode
-> mode
   :- (Header' '[Required, Strict] "Authorization" BearerToken
       :> ("api"
           :> ("v1"
               :> ("namespaces"
                   :> (Capture "namespace" Namespace
                       :> (Description "Service Account API"
                           :> ("serviceaccounts"
                               :> (ReqBody '[JSON] ServiceAccountSpec :> PostNoContent))))))))
kPostServiceAccountR :: mode
      :- Header' [Required, Strict] "Authorization" BearerToken
      :> "api"
      :> "v1"
      :> "namespaces"
      :> Capture "namespace" Namespace
      :> Description "Service Account API"
      :> "serviceaccounts"
      :> ReqBody '[JSON] ServiceAccountSpec
      :> PostNoContent
  , forall mode.
KubernetesApi mode
-> mode
   :- (Header' '[Required, Strict] "Authorization" BearerToken
       :> ("api"
           :> ("v1"
               :> ("namespaces"
                   :> (Capture "namespace" Namespace
                       :> (Description "Pod Templates API"
                           :> ("podtemplates"
                               :> (Capture "template-name" PodTemplateName
                                   :> Get '[JSON] PodTemplateSpec))))))))
kGetPodTemplateR :: mode
      :- Header' [Required, Strict] "Authorization" BearerToken
      :> "api"
      :> "v1"
      :> "namespaces"
      :> Capture "namespace" Namespace
      :> Description "Pod Templates API"
      :> "podtemplates"
      :> Capture "template-name" PodTemplateName
      :> Get '[JSON] PodTemplateSpec
  , forall mode.
KubernetesApi mode
-> mode
   :- (Header' '[Required, Strict] "Authorization" BearerToken
       :> (Description "Role Binding API"
           :> ("apis"
               :> ("rbac.authorization.k8s.io"
                   :> ("v1"
                       :> ("namespaces"
                           :> (Capture "namespace" Namespace
                               :> ("rolebindings"
                                   :> (ReqBody '[JSON] RoleBindingSpec :> PostNoContent)))))))))
kPostRoleBindingR :: mode
      :- Header' [Required, Strict] "Authorization" BearerToken
      :> Description "Role Binding API"
      :> "apis"
      :> "rbac.authorization.k8s.io"
      :> "v1"
      :> "namespaces"
      :> Capture "namespace" Namespace
      :> "rolebindings"
      :> ReqBody '[JSON] RoleBindingSpec
      :> PostNoContent
  }
  deriving stock ((forall x. KubernetesApi mode -> Rep (KubernetesApi mode) x)
-> (forall x. Rep (KubernetesApi mode) x -> KubernetesApi mode)
-> Generic (KubernetesApi mode)
forall x. Rep (KubernetesApi mode) x -> KubernetesApi mode
forall x. KubernetesApi mode -> Rep (KubernetesApi mode) x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
forall mode x. Rep (KubernetesApi mode) x -> KubernetesApi mode
forall mode x. KubernetesApi mode -> Rep (KubernetesApi mode) x
$cfrom :: forall mode x. KubernetesApi mode -> Rep (KubernetesApi mode) x
from :: forall x. KubernetesApi mode -> Rep (KubernetesApi mode) x
$cto :: forall mode x. Rep (KubernetesApi mode) x -> KubernetesApi mode
to :: forall x. Rep (KubernetesApi mode) x -> KubernetesApi mode
Generic)


{- | A handle on the kubernetes service. -}
newtype K8s = K8s {
    K8s -> Manager
kManager :: Manager
                {- ^
                  An http client manager configured to work against the
                  kubernetes api.
                -}
  }


{- | Create a new 'K8s'. -}
newK8s
  :: ( MonadIO m
     )
  => m K8s
newK8s :: forall (m :: * -> *). MonadIO m => m K8s
newK8s = IO K8s -> m K8s
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO K8s -> m K8s) -> IO K8s -> m K8s
forall a b. (a -> b) -> a -> b
$
    HostName -> IO (Maybe CertificateStore)
readCertificateStore HostName
crtLocation IO (Maybe CertificateStore)
-> (Maybe CertificateStore -> IO K8s) -> IO K8s
forall a b. IO a -> (a -> IO b) -> IO b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
      Maybe CertificateStore
Nothing -> HostName -> IO K8s
forall a. HostName -> IO a
forall (m :: * -> *) a. MonadFail m => HostName -> m a
fail HostName
"Can't load K8S CA certificate."
      Just CertificateStore
store -> do
        Manager
manager <-
          ManagerSettings -> IO Manager
newManager
               (
                 TLSSettings -> Maybe SockSettings -> ManagerSettings
mkManagerSettings
                   (CertificateStore -> TLSSettings
k8sTLSSettings CertificateStore
store)
                   Maybe SockSettings
forall a. Maybe a
Nothing
               )
        K8s -> IO K8s
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure K8s {
            kManager :: Manager
kManager = Manager
manager
          }
  where
    k8sTLSSettings :: CertificateStore -> TLSSettings
    k8sTLSSettings :: CertificateStore -> TLSSettings
k8sTLSSettings CertificateStore
store =
      ClientParams -> TLSSettings
TLSSettings (ClientParams -> TLSSettings) -> ClientParams -> TLSSettings
forall a b. (a -> b) -> a -> b
$
        (HostName -> ByteString -> ClientParams
defaultParamsClient HostName
forall a. Monoid a => a
mempty ByteString
forall a. Monoid a => a
mempty) {
          clientShared = def {
            sharedCAStore = store
          },
          clientSupported = def {
            supportedCiphers = ciphersuite_default
          },
          clientUseServerNameIndication = True
        }
    crtLocation :: FilePath
    crtLocation :: HostName
crtLocation = HostName
"/var/run/secrets/kubernetes.io/serviceaccount/ca.crt"


{- | Specify how to patch the pod template spec. -}
newtype JsonPatch = JsonPatch {
    JsonPatch -> Value
unJsonPatch :: Value
  }
  deriving newtype ([JsonPatch] -> Value
[JsonPatch] -> Encoding
JsonPatch -> Bool
JsonPatch -> Value
JsonPatch -> Encoding
(JsonPatch -> Value)
-> (JsonPatch -> Encoding)
-> ([JsonPatch] -> Value)
-> ([JsonPatch] -> Encoding)
-> (JsonPatch -> Bool)
-> ToJSON JsonPatch
forall a.
(a -> Value)
-> (a -> Encoding)
-> ([a] -> Value)
-> ([a] -> Encoding)
-> (a -> Bool)
-> ToJSON a
$ctoJSON :: JsonPatch -> Value
toJSON :: JsonPatch -> Value
$ctoEncoding :: JsonPatch -> Encoding
toEncoding :: JsonPatch -> Encoding
$ctoJSONList :: [JsonPatch] -> Value
toJSONList :: [JsonPatch] -> Value
$ctoEncodingList :: [JsonPatch] -> Encoding
toEncodingList :: [JsonPatch] -> Encoding
$comitField :: JsonPatch -> Bool
omitField :: JsonPatch -> Bool
ToJSON)
instance Accept JsonPatch where
  contentType :: Proxy JsonPatch -> MediaType
contentType Proxy JsonPatch
_proxy = MediaType
"application/json-patch+json"
instance MimeRender JsonPatch JsonPatch where
 mimeRender :: Proxy JsonPatch -> JsonPatch -> ByteString
mimeRender Proxy JsonPatch
_ = JsonPatch -> ByteString
forall a. ToJSON a => a -> ByteString
encode


{- | A list of pods. -}
newtype PodNameList = PodNameList {
    PodNameList -> [PodName]
unPodNameList :: [PodName]
  }
instance FromJSON PodNameList where
  parseJSON :: Value -> Parser PodNameList
parseJSON = HostName
-> (Object -> Parser PodNameList) -> Value -> Parser PodNameList
forall a. HostName -> (Object -> Parser a) -> Value -> Parser a
withObject HostName
"Pod List (Names)" ((Object -> Parser PodNameList) -> Value -> Parser PodNameList)
-> (Object -> Parser PodNameList) -> Value -> Parser PodNameList
forall a b. (a -> b) -> a -> b
$ \Object
o -> do
    [Object]
list <- Object
o Object -> Key -> Parser [Object]
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"items"
    [PodName] -> PodNameList
PodNameList ([PodName] -> PodNameList)
-> Parser [PodName] -> Parser PodNameList
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Object -> Parser PodName) -> [Object] -> Parser [PodName]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> [a] -> m [b]
mapM ((Object -> Key -> Parser Object
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"metadata") (Object -> Parser Object)
-> (Object -> Parser PodName) -> Object -> Parser PodName
forall (m :: * -> *) a b c.
Monad m =>
(a -> m b) -> (b -> m c) -> a -> m c
>=> (Object -> Key -> Parser PodName
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"name")) [Object]
list


{- ==================================== List all pods ======================= -}
{- | Get the list of pods. -}
kListPods :: BearerToken -> Namespace -> ClientM PodNameList

{- | List the pods, returning a list of names. -}
listPods :: (MonadIO m) => K8s -> Namespace -> m [PodName]
listPods :: forall (m :: * -> *). MonadIO m => K8s -> Namespace -> m [PodName]
listPods K8s
k Namespace
namespace = do
  BearerToken
token <- m BearerToken
forall (m :: * -> *). MonadIO m => m BearerToken
getServiceAccountToken
  let req :: ClientM PodNameList
req = BearerToken -> Namespace -> ClientM PodNameList
kListPods BearerToken
token Namespace
namespace
  IO [PodName] -> m [PodName]
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO [PodName] -> m [PodName]) -> IO [PodName] -> m [PodName]
forall a b. (a -> b) -> a -> b
$ ClientM PodNameList
-> ClientEnv -> IO (Either ClientError PodNameList)
forall a. ClientM a -> ClientEnv -> IO (Either ClientError a)
runClientM ClientM PodNameList
req (K8s -> ClientEnv
mkEnv K8s
k) IO (Either ClientError PodNameList)
-> (Either ClientError PodNameList -> IO [PodName]) -> IO [PodName]
forall a b. IO a -> (a -> IO b) -> IO b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
    Left ClientError
err -> IO [PodName] -> IO [PodName]
forall a. IO a -> IO a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (ClientError -> IO [PodName]
forall (m :: * -> *) e a.
(HasCallStack, MonadThrow m, Exception e) =>
e -> m a
throw ClientError
err)
    Right PodNameList
list -> [PodName] -> IO [PodName]
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (PodNameList -> [PodName]
unPodNameList PodNameList
list)


{- | Query the pods, returning the full JSON for each. -}
queryPods :: (MonadIO m) => K8s -> Namespace -> [(Text, Text)] -> m [Pod]
queryPods :: forall (m :: * -> *).
MonadIO m =>
K8s -> Namespace -> [(Text, Text)] -> m [Pod]
queryPods K8s
k Namespace
namespace [(Text, Text)]
selectors = do
  BearerToken
token <- m BearerToken
forall (m :: * -> *). MonadIO m => m BearerToken
getServiceAccountToken
  let req :: ClientM PodList
req = KubernetesApi (AsClientT ClientM)
-> AsClientT ClientM
   :- (Header' '[Required, Strict] "Authorization" BearerToken
       :> ("api"
           :> ("v1"
               :> ("namespaces"
                   :> (Capture "namespace" Namespace
                       :> ("pods"
                           :> (QueryParam'
                                 '[Optional, Required] "labelSelectors" LabelSelectors
                               :> (Description "List pods" :> Get '[JSON] PodList))))))))
forall mode.
KubernetesApi mode
-> mode
   :- (Header' '[Required, Strict] "Authorization" BearerToken
       :> ("api"
           :> ("v1"
               :> ("namespaces"
                   :> (Capture "namespace" Namespace
                       :> ("pods"
                           :> (QueryParam'
                                 '[Optional, Required] "labelSelectors" LabelSelectors
                               :> (Description "List pods" :> Get '[JSON] PodList))))))))
kQueryPodsR KubernetesApi (AsClientT ClientM)
forall (routes :: * -> *) (m :: * -> *).
(HasClient m (ToServantApi routes),
 GenericServant routes (AsClientT m),
 Client m (ToServantApi routes) ~ ToServant routes (AsClientT m)) =>
routes (AsClientT m)
genericClient BearerToken
token Namespace
namespace ([(Text, Text)] -> LabelSelectors
LabelSelectors [(Text, Text)]
selectors)
  IO [Pod] -> m [Pod]
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO [Pod] -> m [Pod]) -> IO [Pod] -> m [Pod]
forall a b. (a -> b) -> a -> b
$ ClientM PodList -> ClientEnv -> IO (Either ClientError PodList)
forall a. ClientM a -> ClientEnv -> IO (Either ClientError a)
runClientM ClientM PodList
req (K8s -> ClientEnv
mkEnv K8s
k) IO (Either ClientError PodList)
-> (Either ClientError PodList -> IO [Pod]) -> IO [Pod]
forall a b. IO a -> (a -> IO b) -> IO b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
    Left ClientError
err -> IO [Pod] -> IO [Pod]
forall a. IO a -> IO a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (ClientError -> IO [Pod]
forall (m :: * -> *) e a.
(HasCallStack, MonadThrow m, Exception e) =>
e -> m a
throw ClientError
err)
    Right (PodList [Pod]
list) -> [Pod] -> IO [Pod]
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure [Pod]
list


newtype LabelSelectors = LabelSelectors
  { LabelSelectors -> [(Text, Text)]
_unLabelSelectors :: [(Text, Text)]
  }
instance ToHttpApiData LabelSelectors where
  toQueryParam :: LabelSelectors -> Text
toQueryParam (LabelSelectors [(Text, Text)]
selectors) =
    ByteString -> Text
decodeUtf8 (ByteString -> Text) -> ByteString -> Text
forall a b. (a -> b) -> a -> b
$
      ByteString -> [ByteString] -> ByteString
BS.intercalate
        ByteString
","
        [ Bool -> ByteString -> ByteString
urlEncode Bool
False (Text -> ByteString
encodeUtf8 (Text
name Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"=" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
value))
        | (Text
name, Text
value) <- [(Text, Text)]
selectors
        ]


newtype PodList = PodList
  { PodList -> [Pod]
_unPodList :: [Pod]
  }
instance FromJSON PodList where
  parseJSON :: Value -> Parser PodList
parseJSON =
    HostName -> (Object -> Parser PodList) -> Value -> Parser PodList
forall a. HostName -> (Object -> Parser a) -> Value -> Parser a
withObject HostName
"Pod List" ((Object -> Parser PodList) -> Value -> Parser PodList)
-> (Object -> Parser PodList) -> Value -> Parser PodList
forall a b. (a -> b) -> a -> b
$ \Object
o ->
      [Pod] -> PodList
PodList ([Pod] -> PodList) -> ([Value] -> [Pod]) -> [Value] -> PodList
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Value -> Pod) -> [Value] -> [Pod]
forall a b. (a -> b) -> [a] -> [b]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Value -> Pod
Pod ([Value] -> PodList) -> Parser [Value] -> Parser PodList
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$>
        (Object
o Object -> Key -> Parser [Value]
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"items")


newtype Pod = Pod
  { Pod -> Value
unPod :: Value
  }
  deriving newtype (Maybe Pod
Value -> Parser [Pod]
Value -> Parser Pod
(Value -> Parser Pod)
-> (Value -> Parser [Pod]) -> Maybe Pod -> FromJSON Pod
forall a.
(Value -> Parser a)
-> (Value -> Parser [a]) -> Maybe a -> FromJSON a
$cparseJSON :: Value -> Parser Pod
parseJSON :: Value -> Parser Pod
$cparseJSONList :: Value -> Parser [Pod]
parseJSONList :: Value -> Parser [Pod]
$comittedField :: Maybe Pod
omittedField :: Maybe Pod
FromJSON, [Pod] -> Value
[Pod] -> Encoding
Pod -> Bool
Pod -> Value
Pod -> Encoding
(Pod -> Value)
-> (Pod -> Encoding)
-> ([Pod] -> Value)
-> ([Pod] -> Encoding)
-> (Pod -> Bool)
-> ToJSON Pod
forall a.
(a -> Value)
-> (a -> Encoding)
-> ([a] -> Value)
-> ([a] -> Encoding)
-> (a -> Bool)
-> ToJSON a
$ctoJSON :: Pod -> Value
toJSON :: Pod -> Value
$ctoEncoding :: Pod -> Encoding
toEncoding :: Pod -> Encoding
$ctoJSONList :: [Pod] -> Value
toJSONList :: [Pod] -> Value
$ctoEncodingList :: [Pod] -> Encoding
toEncodingList :: [Pod] -> Encoding
$comitField :: Pod -> Bool
omitField :: Pod -> Bool
ToJSON)
  deriving stock (Int -> Pod -> ShowS
[Pod] -> ShowS
Pod -> HostName
(Int -> Pod -> ShowS)
-> (Pod -> HostName) -> ([Pod] -> ShowS) -> Show Pod
forall a.
(Int -> a -> ShowS) -> (a -> HostName) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> Pod -> ShowS
showsPrec :: Int -> Pod -> ShowS
$cshow :: Pod -> HostName
show :: Pod -> HostName
$cshowList :: [Pod] -> ShowS
showList :: [Pod] -> ShowS
Show)


{- ==================================== Post a new pod ====================== -}
{- | Create a new pod. -}
kPostPod :: BearerToken -> Namespace -> PodSpec -> ClientM NoContent

{- | Create a new pod. -}
postPod :: (MonadIO m) => K8s -> Namespace -> PodSpec -> m ()
postPod :: forall (m :: * -> *).
MonadIO m =>
K8s -> Namespace -> PodSpec -> m ()
postPod K8s
k Namespace
namespace PodSpec
spec = do
  BearerToken
token <- m BearerToken
forall (m :: * -> *). MonadIO m => m BearerToken
getServiceAccountToken
  let req :: ClientM NoContent
req = BearerToken -> Namespace -> PodSpec -> ClientM NoContent
kPostPod BearerToken
token Namespace
namespace PodSpec
spec
  IO () -> m ()
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ ClientM NoContent -> ClientEnv -> IO (Either ClientError NoContent)
forall a. ClientM a -> ClientEnv -> IO (Either ClientError a)
runClientM ClientM NoContent
req (K8s -> ClientEnv
mkEnv K8s
k) IO (Either ClientError NoContent)
-> (Either ClientError NoContent -> IO ()) -> IO ()
forall a b. IO a -> (a -> IO b) -> IO b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
    Left ClientError
err -> IO () -> IO ()
forall a. IO a -> IO a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (ClientError -> IO ()
forall (m :: * -> *) e a.
(HasCallStack, MonadThrow m, Exception e) =>
e -> m a
throw ClientError
err)
    Right NoContent
NoContent -> () -> IO ()
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ()


{- ==================================== Delete a pod ======================== -}
{- | Delete a pod. -}
kDeletePod :: BearerToken -> Namespace -> PodName -> ClientM NoContent

{- | Delete a pod. -}
deletePod :: (MonadIO m) => K8s -> Namespace -> PodName -> m ()
deletePod :: forall (m :: * -> *).
MonadIO m =>
K8s -> Namespace -> PodName -> m ()
deletePod K8s
k Namespace
namespace PodName
podName = do
  BearerToken
token <- m BearerToken
forall (m :: * -> *). MonadIO m => m BearerToken
getServiceAccountToken
  let req :: ClientM NoContent
req = BearerToken -> Namespace -> PodName -> ClientM NoContent
kDeletePod BearerToken
token Namespace
namespace PodName
podName
  IO () -> m ()
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ ClientM NoContent -> ClientEnv -> IO (Either ClientError NoContent)
forall a. ClientM a -> ClientEnv -> IO (Either ClientError a)
runClientM ClientM NoContent
req (K8s -> ClientEnv
mkEnv K8s
k) IO (Either ClientError NoContent)
-> (Either ClientError NoContent -> IO ()) -> IO ()
forall a b. IO a -> (a -> IO b) -> IO b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
    Left ClientError
err -> IO () -> IO ()
forall a. IO a -> IO a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (ClientError -> IO ()
forall (m :: * -> *) e a.
(HasCallStack, MonadThrow m, Exception e) =>
e -> m a
throw ClientError
err)
    Right NoContent
NoContent -> () -> IO ()
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ()
  

{- ==================================== Delete a pod ======================== -}
{- | Get the spec of a specific pod. -}
kGetPodSpec :: BearerToken -> Namespace -> PodName -> ClientM PodSpec

{- | Get the spec of a specific pod. -}
getPodSpec :: (MonadIO m) => K8s -> Namespace -> PodName -> m PodSpec
getPodSpec :: forall (m :: * -> *).
MonadIO m =>
K8s -> Namespace -> PodName -> m PodSpec
getPodSpec K8s
k Namespace
namespace PodName
podName = do
  BearerToken
token <- m BearerToken
forall (m :: * -> *). MonadIO m => m BearerToken
getServiceAccountToken
  let req :: ClientM PodSpec
req = BearerToken -> Namespace -> PodName -> ClientM PodSpec
kGetPodSpec BearerToken
token Namespace
namespace PodName
podName
  IO PodSpec -> m PodSpec
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO PodSpec -> m PodSpec) -> IO PodSpec -> m PodSpec
forall a b. (a -> b) -> a -> b
$ ClientM PodSpec -> ClientEnv -> IO (Either ClientError PodSpec)
forall a. ClientM a -> ClientEnv -> IO (Either ClientError a)
runClientM ClientM PodSpec
req (K8s -> ClientEnv
mkEnv K8s
k) IO (Either ClientError PodSpec)
-> (Either ClientError PodSpec -> IO PodSpec) -> IO PodSpec
forall a b. IO a -> (a -> IO b) -> IO b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
    Left ClientError
err -> IO PodSpec -> IO PodSpec
forall a. IO a -> IO a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (ClientError -> IO PodSpec
forall (m :: * -> *) e a.
(HasCallStack, MonadThrow m, Exception e) =>
e -> m a
throw ClientError
err)
    Right PodSpec
spec -> PodSpec -> IO PodSpec
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure PodSpec
spec
  

{- ==================================== Patch a service ===================== -}
{- | Patch a service. -}
kPatchService
  :: BearerToken
  -> Namespace
  -> ServiceName
  -> JsonPatch
  -> ClientM NoContent

{- | Patch a service. -}
patchService :: (MonadIO m) => K8s -> Namespace -> ServiceName -> JsonPatch -> m ()
patchService :: forall (m :: * -> *).
MonadIO m =>
K8s -> Namespace -> ServiceName -> JsonPatch -> m ()
patchService K8s
k Namespace
namespace ServiceName
service JsonPatch
patch = do
  BearerToken
token <- m BearerToken
forall (m :: * -> *). MonadIO m => m BearerToken
getServiceAccountToken
  let req :: ClientM NoContent
req = BearerToken
-> Namespace -> ServiceName -> JsonPatch -> ClientM NoContent
kPatchService BearerToken
token Namespace
namespace ServiceName
service JsonPatch
patch
  IO () -> m ()
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ ClientM NoContent -> ClientEnv -> IO (Either ClientError NoContent)
forall a. ClientM a -> ClientEnv -> IO (Either ClientError a)
runClientM ClientM NoContent
req (K8s -> ClientEnv
mkEnv K8s
k) IO (Either ClientError NoContent)
-> (Either ClientError NoContent -> IO ()) -> IO ()
forall a b. IO a -> (a -> IO b) -> IO b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
    Left ClientError
err -> IO () -> IO ()
forall a. IO a -> IO a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (ClientError -> IO ()
forall (m :: * -> *) e a.
(HasCallStack, MonadThrow m, Exception e) =>
e -> m a
throw ClientError
err)
    Right NoContent
NoContent -> () -> IO ()
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ()


{- ==================================== Get a service Spec ================== -}
{- | Get the service spec. -}
kGetServiceSpec
  :: BearerToken
  -> Namespace
  -> ServiceName
  -> ClientM ServiceSpec

{- | Get the service spec. -}
getServiceSpec
  :: (MonadIO m)
  => K8s
  -> Namespace
  -> ServiceName
  -> m ServiceSpec
getServiceSpec :: forall (m :: * -> *).
MonadIO m =>
K8s -> Namespace -> ServiceName -> m ServiceSpec
getServiceSpec K8s
k Namespace
namespace ServiceName
service = do
  BearerToken
token <- m BearerToken
forall (m :: * -> *). MonadIO m => m BearerToken
getServiceAccountToken
  let req :: ClientM ServiceSpec
req = BearerToken -> Namespace -> ServiceName -> ClientM ServiceSpec
kGetServiceSpec BearerToken
token Namespace
namespace ServiceName
service
  IO ServiceSpec -> m ServiceSpec
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO ServiceSpec -> m ServiceSpec)
-> IO ServiceSpec -> m ServiceSpec
forall a b. (a -> b) -> a -> b
$ ClientM ServiceSpec
-> ClientEnv -> IO (Either ClientError ServiceSpec)
forall a. ClientM a -> ClientEnv -> IO (Either ClientError a)
runClientM ClientM ServiceSpec
req (K8s -> ClientEnv
mkEnv K8s
k) IO (Either ClientError ServiceSpec)
-> (Either ClientError ServiceSpec -> IO ServiceSpec)
-> IO ServiceSpec
forall a b. IO a -> (a -> IO b) -> IO b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
    Left ClientError
err -> IO ServiceSpec -> IO ServiceSpec
forall a. IO a -> IO a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (ClientError -> IO ServiceSpec
forall (m :: * -> *) e a.
(HasCallStack, MonadThrow m, Exception e) =>
e -> m a
throw ClientError
err)
    Right ServiceSpec
spec -> ServiceSpec -> IO ServiceSpec
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ServiceSpec
spec


{- ==================================== Get a Pod Template Spec ============= -}
{- | Get the pod template. -}
kGetPodTemplate
  :: BearerToken
  -> Namespace
  -> PodTemplateName
  -> ClientM PodTemplateSpec

{- | Get the pod template. -}
getPodTemplate
  :: (MonadIO m)
  => K8s
  -> Namespace
  -> PodTemplateName
  -> m PodTemplateSpec
getPodTemplate :: forall (m :: * -> *).
MonadIO m =>
K8s -> Namespace -> PodTemplateName -> m PodTemplateSpec
getPodTemplate K8s
k Namespace
namespace PodTemplateName
templateName = do
  BearerToken
token <- m BearerToken
forall (m :: * -> *). MonadIO m => m BearerToken
getServiceAccountToken
  let req :: ClientM PodTemplateSpec
req = BearerToken
-> Namespace -> PodTemplateName -> ClientM PodTemplateSpec
kGetPodTemplate BearerToken
token Namespace
namespace PodTemplateName
templateName
  IO PodTemplateSpec -> m PodTemplateSpec
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO PodTemplateSpec -> m PodTemplateSpec)
-> IO PodTemplateSpec -> m PodTemplateSpec
forall a b. (a -> b) -> a -> b
$ ClientM PodTemplateSpec
-> ClientEnv -> IO (Either ClientError PodTemplateSpec)
forall a. ClientM a -> ClientEnv -> IO (Either ClientError a)
runClientM ClientM PodTemplateSpec
req (K8s -> ClientEnv
mkEnv K8s
k) IO (Either ClientError PodTemplateSpec)
-> (Either ClientError PodTemplateSpec -> IO PodTemplateSpec)
-> IO PodTemplateSpec
forall a b. IO a -> (a -> IO b) -> IO b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
    Left ClientError
err -> IO PodTemplateSpec -> IO PodTemplateSpec
forall a. IO a -> IO a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (ClientError -> IO PodTemplateSpec
forall (m :: * -> *) e a.
(HasCallStack, MonadThrow m, Exception e) =>
e -> m a
throw ClientError
err)
    Right PodTemplateSpec
spec -> PodTemplateSpec -> IO PodTemplateSpec
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure PodTemplateSpec
spec


{- ==================================== Post a service ====================== -}
{- | Post a new service. -}
kPostService
  :: BearerToken
  -> Namespace
  -> ServiceSpec
  -> ClientM NoContent

{- | Post a new service. -}
postService :: (MonadIO m) => K8s -> Namespace -> ServiceSpec -> m ()
postService :: forall (m :: * -> *).
MonadIO m =>
K8s -> Namespace -> ServiceSpec -> m ()
postService K8s
k Namespace
namespace ServiceSpec
service = do
  BearerToken
token <- m BearerToken
forall (m :: * -> *). MonadIO m => m BearerToken
getServiceAccountToken
  let req :: ClientM NoContent
req = BearerToken -> Namespace -> ServiceSpec -> ClientM NoContent
kPostService BearerToken
token Namespace
namespace ServiceSpec
service
  IO () -> m ()
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ ClientM NoContent -> ClientEnv -> IO (Either ClientError NoContent)
forall a. ClientM a -> ClientEnv -> IO (Either ClientError a)
runClientM ClientM NoContent
req (K8s -> ClientEnv
mkEnv K8s
k) IO (Either ClientError NoContent)
-> (Either ClientError NoContent -> IO ()) -> IO ()
forall a b. IO a -> (a -> IO b) -> IO b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
    Left ClientError
err -> IO () -> IO ()
forall a. IO a -> IO a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (ClientError -> IO ()
forall (m :: * -> *) e a.
(HasCallStack, MonadThrow m, Exception e) =>
e -> m a
throw ClientError
err)
    Right NoContent
NoContent -> () -> IO ()
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ()


{- ==================================== Post Role Binding =================== -}
{- | Post a role binding. -}
kPostRoleBinding
  :: BearerToken
  -> Namespace
  -> RoleBindingSpec
  -> ClientM NoContent

{- | Post a role binding. -}
postRoleBinding :: (MonadIO m) => K8s -> Namespace -> RoleBindingSpec -> m ()
postRoleBinding :: forall (m :: * -> *).
MonadIO m =>
K8s -> Namespace -> RoleBindingSpec -> m ()
postRoleBinding K8s
k Namespace
namespace RoleBindingSpec
roleBinding = do
  BearerToken
token <- m BearerToken
forall (m :: * -> *). MonadIO m => m BearerToken
getServiceAccountToken
  let req :: ClientM NoContent
req = BearerToken -> Namespace -> RoleBindingSpec -> ClientM NoContent
kPostRoleBinding BearerToken
token Namespace
namespace RoleBindingSpec
roleBinding
  IO () -> m ()
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ ClientM NoContent -> ClientEnv -> IO (Either ClientError NoContent)
forall a. ClientM a -> ClientEnv -> IO (Either ClientError a)
runClientM ClientM NoContent
req (K8s -> ClientEnv
mkEnv K8s
k) IO (Either ClientError NoContent)
-> (Either ClientError NoContent -> IO ()) -> IO ()
forall a b. IO a -> (a -> IO b) -> IO b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
    Left ClientError
err -> IO () -> IO ()
forall a. IO a -> IO a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (ClientError -> IO ()
forall (m :: * -> *) e a.
(HasCallStack, MonadThrow m, Exception e) =>
e -> m a
throw ClientError
err)
    Right NoContent
NoContent -> () -> IO ()
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ()


{- ==================================== Post Role =========================== -}
{- | Post a Role. -}
kPostRole :: BearerToken -> Namespace -> RoleSpec -> ClientM NoContent

{- | Post a Role. -}
postRole :: (MonadIO m) => K8s -> Namespace -> RoleSpec -> m ()
postRole :: forall (m :: * -> *).
MonadIO m =>
K8s -> Namespace -> RoleSpec -> m ()
postRole K8s
k Namespace
namespace RoleSpec
role = do
  BearerToken
token <- m BearerToken
forall (m :: * -> *). MonadIO m => m BearerToken
getServiceAccountToken
  let req :: ClientM NoContent
req = BearerToken -> Namespace -> RoleSpec -> ClientM NoContent
kPostRole BearerToken
token Namespace
namespace RoleSpec
role
  IO () -> m ()
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ ClientM NoContent -> ClientEnv -> IO (Either ClientError NoContent)
forall a. ClientM a -> ClientEnv -> IO (Either ClientError a)
runClientM ClientM NoContent
req (K8s -> ClientEnv
mkEnv K8s
k) IO (Either ClientError NoContent)
-> (Either ClientError NoContent -> IO ()) -> IO ()
forall a b. IO a -> (a -> IO b) -> IO b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
    Left ClientError
err -> IO () -> IO ()
forall a. IO a -> IO a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (ClientError -> IO ()
forall (m :: * -> *) e a.
(HasCallStack, MonadThrow m, Exception e) =>
e -> m a
throw ClientError
err)
    Right NoContent
NoContent -> () -> IO ()
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ()


{- ==================================== Post Service Account ================ -}
{- | Post a service account. -}
kPostServiceAccount
  :: BearerToken
  -> Namespace
  -> ServiceAccountSpec
  -> ClientM NoContent

{- | Post a service account. -}
postServiceAccount :: (MonadIO m) => K8s -> Namespace -> ServiceAccountSpec -> m ()
postServiceAccount :: forall (m :: * -> *).
MonadIO m =>
K8s -> Namespace -> ServiceAccountSpec -> m ()
postServiceAccount K8s
k Namespace
namespace ServiceAccountSpec
serviceAccount = do
  BearerToken
token <- m BearerToken
forall (m :: * -> *). MonadIO m => m BearerToken
getServiceAccountToken
  let req :: ClientM NoContent
req = BearerToken -> Namespace -> ServiceAccountSpec -> ClientM NoContent
kPostServiceAccount BearerToken
token Namespace
namespace ServiceAccountSpec
serviceAccount
  IO () -> m ()
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ ClientM NoContent -> ClientEnv -> IO (Either ClientError NoContent)
forall a. ClientM a -> ClientEnv -> IO (Either ClientError a)
runClientM ClientM NoContent
req (K8s -> ClientEnv
mkEnv K8s
k) IO (Either ClientError NoContent)
-> (Either ClientError NoContent -> IO ()) -> IO ()
forall a b. IO a -> (a -> IO b) -> IO b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
    Left ClientError
err -> IO () -> IO ()
forall a. IO a -> IO a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (ClientError -> IO ()
forall (m :: * -> *) e a.
(HasCallStack, MonadThrow m, Exception e) =>
e -> m a
throw ClientError
err)
    Right NoContent
NoContent -> () -> IO ()
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ()


{- ==================================== Post a Namspace ===================== -}
{- | Post a Namespace. -}
kPostNamespace :: BearerToken -> NamespaceSpec -> ClientM NoContent

{- | Post a Namespace. -}
postNamespace :: (MonadIO m) => K8s -> NamespaceSpec -> m ()
postNamespace :: forall (m :: * -> *). MonadIO m => K8s -> NamespaceSpec -> m ()
postNamespace K8s
k NamespaceSpec
namespace = do
  BearerToken
token <- m BearerToken
forall (m :: * -> *). MonadIO m => m BearerToken
getServiceAccountToken
  let req :: ClientM NoContent
req = BearerToken -> NamespaceSpec -> ClientM NoContent
kPostNamespace BearerToken
token NamespaceSpec
namespace
  IO () -> m ()
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ ClientM NoContent -> ClientEnv -> IO (Either ClientError NoContent)
forall a. ClientM a -> ClientEnv -> IO (Either ClientError a)
runClientM ClientM NoContent
req (K8s -> ClientEnv
mkEnv K8s
k) IO (Either ClientError NoContent)
-> (Either ClientError NoContent -> IO ()) -> IO ()
forall a b. IO a -> (a -> IO b) -> IO b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
    Left ClientError
err -> IO () -> IO ()
forall a. IO a -> IO a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (ClientError -> IO ()
forall (m :: * -> *) e a.
(HasCallStack, MonadThrow m, Exception e) =>
e -> m a
throw ClientError
err)
    Right NoContent
NoContent -> () -> IO ()
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ()


{- ==================================== Other stuff ========================= -}

KubernetesApi
    { kPostNamespaceR :: forall mode.
KubernetesApi mode
-> mode
   :- (Header' '[Required, Strict] "Authorization" BearerToken
       :> ("api"
           :> ("v1"
               :> ("namespaces"
                   :> (ReqBody '[JSON] NamespaceSpec :> PostNoContent)))))
kPostNamespaceR = AsClientT ClientM
:- (Header' '[Required, Strict] "Authorization" BearerToken
    :> ("api"
        :> ("v1"
            :> ("namespaces"
                :> (ReqBody '[JSON] NamespaceSpec :> PostNoContent)))))
BearerToken -> NamespaceSpec -> ClientM NoContent
kPostNamespace
    , kListPodsR :: forall mode.
KubernetesApi mode
-> mode
   :- (Header' '[Required, Strict] "Authorization" BearerToken
       :> ("api"
           :> ("v1"
               :> ("namespaces"
                   :> (Capture "namespace" Namespace
                       :> ("pods"
                           :> (Description "List pods" :> Get '[JSON] PodNameList)))))))
kListPodsR = AsClientT ClientM
:- (Header' '[Required, Strict] "Authorization" BearerToken
    :> ("api"
        :> ("v1"
            :> ("namespaces"
                :> (Capture "namespace" Namespace
                    :> ("pods"
                        :> (Description "List pods" :> Get '[JSON] PodNameList)))))))
BearerToken -> Namespace -> ClientM PodNameList
kListPods
    , kPostPodR :: forall mode.
KubernetesApi mode
-> mode
   :- (Header' '[Required, Strict] "Authorization" BearerToken
       :> ("api"
           :> ("v1"
               :> ("namespaces"
                   :> (Capture "namespace" Namespace
                       :> ("pods"
                           :> (Description "Post a pod definition"
                               :> (ReqBody '[JSON] PodSpec :> PostNoContent))))))))
kPostPodR = AsClientT ClientM
:- (Header' '[Required, Strict] "Authorization" BearerToken
    :> ("api"
        :> ("v1"
            :> ("namespaces"
                :> (Capture "namespace" Namespace
                    :> ("pods"
                        :> (Description "Post a pod definition"
                            :> (ReqBody '[JSON] PodSpec :> PostNoContent))))))))
BearerToken -> Namespace -> PodSpec -> ClientM NoContent
kPostPod
    , kDeletePodR :: forall mode.
KubernetesApi mode
-> mode
   :- (Header' '[Required, Strict] "Authorization" BearerToken
       :> ("api"
           :> ("v1"
               :> ("namespaces"
                   :> (Capture "namespace" Namespace
                       :> ("pods"
                           :> (Description "Delete a pod"
                               :> (Capture "pod-name" PodName :> DeleteNoContent))))))))
kDeletePodR = AsClientT ClientM
:- (Header' '[Required, Strict] "Authorization" BearerToken
    :> ("api"
        :> ("v1"
            :> ("namespaces"
                :> (Capture "namespace" Namespace
                    :> ("pods"
                        :> (Description "Delete a pod"
                            :> (Capture "pod-name" PodName :> DeleteNoContent))))))))
BearerToken -> Namespace -> PodName -> ClientM NoContent
kDeletePod
    , kGetPodSpecR :: forall mode.
KubernetesApi mode
-> mode
   :- (Header' '[Required, Strict] "Authorization" BearerToken
       :> ("api"
           :> ("v1"
               :> ("namespaces"
                   :> (Capture "namespace" Namespace
                       :> ("pods"
                           :> (Description "Get a pod spec"
                               :> (Capture "pod-name" PodName :> Get '[JSON] PodSpec))))))))
kGetPodSpecR = AsClientT ClientM
:- (Header' '[Required, Strict] "Authorization" BearerToken
    :> ("api"
        :> ("v1"
            :> ("namespaces"
                :> (Capture "namespace" Namespace
                    :> ("pods"
                        :> (Description "Get a pod spec"
                            :> (Capture "pod-name" PodName :> Get '[JSON] PodSpec))))))))
BearerToken -> Namespace -> PodName -> ClientM PodSpec
kGetPodSpec
    , kGetServiceSpecR :: forall mode.
KubernetesApi mode
-> mode
   :- (Header' '[Required, Strict] "Authorization" BearerToken
       :> ("api"
           :> ("v1"
               :> ("namespaces"
                   :> (Capture "namespace" Namespace
                       :> ("services"
                           :> (Description "Get the cluster service."
                               :> (Capture "service-name" ServiceName
                                   :> Get '[JSON] ServiceSpec))))))))
kGetServiceSpecR = AsClientT ClientM
:- (Header' '[Required, Strict] "Authorization" BearerToken
    :> ("api"
        :> ("v1"
            :> ("namespaces"
                :> (Capture "namespace" Namespace
                    :> ("services"
                        :> (Description "Get the cluster service."
                            :> (Capture "service-name" ServiceName
                                :> Get '[JSON] ServiceSpec))))))))
BearerToken -> Namespace -> ServiceName -> ClientM ServiceSpec
kGetServiceSpec
    , kPostServiceR :: forall mode.
KubernetesApi mode
-> mode
   :- (Header' '[Required, Strict] "Authorization" BearerToken
       :> ("api"
           :> ("v1"
               :> ("namespaces"
                   :> (Capture "namespace" Namespace
                       :> ("services"
                           :> (Description "Post a new serivce."
                               :> (ReqBody '[JSON] ServiceSpec :> PostNoContent))))))))
kPostServiceR = AsClientT ClientM
:- (Header' '[Required, Strict] "Authorization" BearerToken
    :> ("api"
        :> ("v1"
            :> ("namespaces"
                :> (Capture "namespace" Namespace
                    :> ("services"
                        :> (Description "Post a new serivce."
                            :> (ReqBody '[JSON] ServiceSpec :> PostNoContent))))))))
BearerToken -> Namespace -> ServiceSpec -> ClientM NoContent
kPostService
    , kPatchServiceR :: forall mode.
KubernetesApi mode
-> mode
   :- (Header' '[Required, Strict] "Authorization" BearerToken
       :> ("api"
           :> ("v1"
               :> ("namespaces"
                   :> (Capture "namespace" Namespace
                       :> ("services"
                           :> (Description "Update the cluster spec annotation."
                               :> (Capture "service-name" ServiceName
                                   :> (ReqBody '[JsonPatch] JsonPatch :> PatchNoContent)))))))))
kPatchServiceR = AsClientT ClientM
:- (Header' '[Required, Strict] "Authorization" BearerToken
    :> ("api"
        :> ("v1"
            :> ("namespaces"
                :> (Capture "namespace" Namespace
                    :> ("services"
                        :> (Description "Update the cluster spec annotation."
                            :> (Capture "service-name" ServiceName
                                :> (ReqBody '[JsonPatch] JsonPatch :> PatchNoContent)))))))))
BearerToken
-> Namespace -> ServiceName -> JsonPatch -> ClientM NoContent
kPatchService
    , kPostRoleR :: forall mode.
KubernetesApi mode
-> mode
   :- (Header' '[Required, Strict] "Authorization" BearerToken
       :> ("api"
           :> ("v1"
               :> ("namespaces"
                   :> (Capture "namespace" Namespace
                       :> (Description "Roll API"
                           :> ("roles" :> (ReqBody '[JSON] RoleSpec :> PostNoContent))))))))
kPostRoleR = AsClientT ClientM
:- (Header' '[Required, Strict] "Authorization" BearerToken
    :> ("api"
        :> ("v1"
            :> ("namespaces"
                :> (Capture "namespace" Namespace
                    :> (Description "Roll API"
                        :> ("roles" :> (ReqBody '[JSON] RoleSpec :> PostNoContent))))))))
BearerToken -> Namespace -> RoleSpec -> ClientM NoContent
kPostRole
    , kPostServiceAccountR :: forall mode.
KubernetesApi mode
-> mode
   :- (Header' '[Required, Strict] "Authorization" BearerToken
       :> ("api"
           :> ("v1"
               :> ("namespaces"
                   :> (Capture "namespace" Namespace
                       :> (Description "Service Account API"
                           :> ("serviceaccounts"
                               :> (ReqBody '[JSON] ServiceAccountSpec :> PostNoContent))))))))
kPostServiceAccountR = AsClientT ClientM
:- (Header' '[Required, Strict] "Authorization" BearerToken
    :> ("api"
        :> ("v1"
            :> ("namespaces"
                :> (Capture "namespace" Namespace
                    :> (Description "Service Account API"
                        :> ("serviceaccounts"
                            :> (ReqBody '[JSON] ServiceAccountSpec :> PostNoContent))))))))
BearerToken -> Namespace -> ServiceAccountSpec -> ClientM NoContent
kPostServiceAccount
    , kGetPodTemplateR :: forall mode.
KubernetesApi mode
-> mode
   :- (Header' '[Required, Strict] "Authorization" BearerToken
       :> ("api"
           :> ("v1"
               :> ("namespaces"
                   :> (Capture "namespace" Namespace
                       :> (Description "Pod Templates API"
                           :> ("podtemplates"
                               :> (Capture "template-name" PodTemplateName
                                   :> Get '[JSON] PodTemplateSpec))))))))
kGetPodTemplateR = AsClientT ClientM
:- (Header' '[Required, Strict] "Authorization" BearerToken
    :> ("api"
        :> ("v1"
            :> ("namespaces"
                :> (Capture "namespace" Namespace
                    :> (Description "Pod Templates API"
                        :> ("podtemplates"
                            :> (Capture "template-name" PodTemplateName
                                :> Get '[JSON] PodTemplateSpec))))))))
BearerToken
-> Namespace -> PodTemplateName -> ClientM PodTemplateSpec
kGetPodTemplate
    , kPostRoleBindingR :: forall mode.
KubernetesApi mode
-> mode
   :- (Header' '[Required, Strict] "Authorization" BearerToken
       :> (Description "Role Binding API"
           :> ("apis"
               :> ("rbac.authorization.k8s.io"
                   :> ("v1"
                       :> ("namespaces"
                           :> (Capture "namespace" Namespace
                               :> ("rolebindings"
                                   :> (ReqBody '[JSON] RoleBindingSpec :> PostNoContent)))))))))
kPostRoleBindingR = AsClientT ClientM
:- (Header' '[Required, Strict] "Authorization" BearerToken
    :> (Description "Role Binding API"
        :> ("apis"
            :> ("rbac.authorization.k8s.io"
                :> ("v1"
                    :> ("namespaces"
                        :> (Capture "namespace" Namespace
                            :> ("rolebindings"
                                :> (ReqBody '[JSON] RoleBindingSpec :> PostNoContent)))))))))
BearerToken -> Namespace -> RoleBindingSpec -> ClientM NoContent
kPostRoleBinding
    }
  =
    KubernetesApi (AsClientT ClientM)
forall (routes :: * -> *) (m :: * -> *).
(HasClient m (ToServantApi routes),
 GenericServant routes (AsClientT m),
 Client m (ToServantApi routes) ~ ToServant routes (AsClientT m)) =>
routes (AsClientT m)
genericClient


{- | The name of a service. -}
newtype ServiceName = ServiceName {
    ServiceName -> Text
unServiceName :: Text
  }
  deriving newtype (ServiceName -> Text
ServiceName -> ByteString
ServiceName -> Builder
(ServiceName -> Text)
-> (ServiceName -> Builder)
-> (ServiceName -> ByteString)
-> (ServiceName -> Text)
-> (ServiceName -> Builder)
-> ToHttpApiData ServiceName
forall a.
(a -> Text)
-> (a -> Builder)
-> (a -> ByteString)
-> (a -> Text)
-> (a -> Builder)
-> ToHttpApiData a
$ctoUrlPiece :: ServiceName -> Text
toUrlPiece :: ServiceName -> Text
$ctoEncodedUrlPiece :: ServiceName -> Builder
toEncodedUrlPiece :: ServiceName -> Builder
$ctoHeader :: ServiceName -> ByteString
toHeader :: ServiceName -> ByteString
$ctoQueryParam :: ServiceName -> Text
toQueryParam :: ServiceName -> Text
$ctoEncodedQueryParam :: ServiceName -> Builder
toEncodedQueryParam :: ServiceName -> Builder
ToHttpApiData)


{- | The specification of a service. -}
newtype ServiceSpec = ServiceSpec {
    ServiceSpec -> Value
unServiceSpec :: Value
  }
  deriving newtype (Maybe ServiceSpec
Value -> Parser [ServiceSpec]
Value -> Parser ServiceSpec
(Value -> Parser ServiceSpec)
-> (Value -> Parser [ServiceSpec])
-> Maybe ServiceSpec
-> FromJSON ServiceSpec
forall a.
(Value -> Parser a)
-> (Value -> Parser [a]) -> Maybe a -> FromJSON a
$cparseJSON :: Value -> Parser ServiceSpec
parseJSON :: Value -> Parser ServiceSpec
$cparseJSONList :: Value -> Parser [ServiceSpec]
parseJSONList :: Value -> Parser [ServiceSpec]
$comittedField :: Maybe ServiceSpec
omittedField :: Maybe ServiceSpec
FromJSON, [ServiceSpec] -> Value
[ServiceSpec] -> Encoding
ServiceSpec -> Bool
ServiceSpec -> Value
ServiceSpec -> Encoding
(ServiceSpec -> Value)
-> (ServiceSpec -> Encoding)
-> ([ServiceSpec] -> Value)
-> ([ServiceSpec] -> Encoding)
-> (ServiceSpec -> Bool)
-> ToJSON ServiceSpec
forall a.
(a -> Value)
-> (a -> Encoding)
-> ([a] -> Value)
-> ([a] -> Encoding)
-> (a -> Bool)
-> ToJSON a
$ctoJSON :: ServiceSpec -> Value
toJSON :: ServiceSpec -> Value
$ctoEncoding :: ServiceSpec -> Encoding
toEncoding :: ServiceSpec -> Encoding
$ctoJSONList :: [ServiceSpec] -> Value
toJSONList :: [ServiceSpec] -> Value
$ctoEncodingList :: [ServiceSpec] -> Encoding
toEncodingList :: [ServiceSpec] -> Encoding
$comitField :: ServiceSpec -> Bool
omitField :: ServiceSpec -> Bool
ToJSON)


{- | The name of a pod template. -}
newtype PodTemplateName =  PodTemplateName
  { PodTemplateName -> Text
unPodTemplateName :: Text
  }
  deriving newtype (
    PodTemplateName -> PodTemplateName -> Bool
(PodTemplateName -> PodTemplateName -> Bool)
-> (PodTemplateName -> PodTemplateName -> Bool)
-> Eq PodTemplateName
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: PodTemplateName -> PodTemplateName -> Bool
== :: PodTemplateName -> PodTemplateName -> Bool
$c/= :: PodTemplateName -> PodTemplateName -> Bool
/= :: PodTemplateName -> PodTemplateName -> Bool
Eq, Eq PodTemplateName
Eq PodTemplateName =>
(PodTemplateName -> PodTemplateName -> Ordering)
-> (PodTemplateName -> PodTemplateName -> Bool)
-> (PodTemplateName -> PodTemplateName -> Bool)
-> (PodTemplateName -> PodTemplateName -> Bool)
-> (PodTemplateName -> PodTemplateName -> Bool)
-> (PodTemplateName -> PodTemplateName -> PodTemplateName)
-> (PodTemplateName -> PodTemplateName -> PodTemplateName)
-> Ord PodTemplateName
PodTemplateName -> PodTemplateName -> Bool
PodTemplateName -> PodTemplateName -> Ordering
PodTemplateName -> PodTemplateName -> PodTemplateName
forall a.
Eq a =>
(a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
$ccompare :: PodTemplateName -> PodTemplateName -> Ordering
compare :: PodTemplateName -> PodTemplateName -> Ordering
$c< :: PodTemplateName -> PodTemplateName -> Bool
< :: PodTemplateName -> PodTemplateName -> Bool
$c<= :: PodTemplateName -> PodTemplateName -> Bool
<= :: PodTemplateName -> PodTemplateName -> Bool
$c> :: PodTemplateName -> PodTemplateName -> Bool
> :: PodTemplateName -> PodTemplateName -> Bool
$c>= :: PodTemplateName -> PodTemplateName -> Bool
>= :: PodTemplateName -> PodTemplateName -> Bool
$cmax :: PodTemplateName -> PodTemplateName -> PodTemplateName
max :: PodTemplateName -> PodTemplateName -> PodTemplateName
$cmin :: PodTemplateName -> PodTemplateName -> PodTemplateName
min :: PodTemplateName -> PodTemplateName -> PodTemplateName
Ord, Int -> PodTemplateName -> ShowS
[PodTemplateName] -> ShowS
PodTemplateName -> HostName
(Int -> PodTemplateName -> ShowS)
-> (PodTemplateName -> HostName)
-> ([PodTemplateName] -> ShowS)
-> Show PodTemplateName
forall a.
(Int -> a -> ShowS) -> (a -> HostName) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> PodTemplateName -> ShowS
showsPrec :: Int -> PodTemplateName -> ShowS
$cshow :: PodTemplateName -> HostName
show :: PodTemplateName -> HostName
$cshowList :: [PodTemplateName] -> ShowS
showList :: [PodTemplateName] -> ShowS
Show, HostName -> PodTemplateName
(HostName -> PodTemplateName) -> IsString PodTemplateName
forall a. (HostName -> a) -> IsString a
$cfromString :: HostName -> PodTemplateName
fromString :: HostName -> PodTemplateName
IsString, PodTemplateName -> Text
PodTemplateName -> ByteString
PodTemplateName -> Builder
(PodTemplateName -> Text)
-> (PodTemplateName -> Builder)
-> (PodTemplateName -> ByteString)
-> (PodTemplateName -> Text)
-> (PodTemplateName -> Builder)
-> ToHttpApiData PodTemplateName
forall a.
(a -> Text)
-> (a -> Builder)
-> (a -> ByteString)
-> (a -> Text)
-> (a -> Builder)
-> ToHttpApiData a
$ctoUrlPiece :: PodTemplateName -> Text
toUrlPiece :: PodTemplateName -> Text
$ctoEncodedUrlPiece :: PodTemplateName -> Builder
toEncodedUrlPiece :: PodTemplateName -> Builder
$ctoHeader :: PodTemplateName -> ByteString
toHeader :: PodTemplateName -> ByteString
$ctoQueryParam :: PodTemplateName -> Text
toQueryParam :: PodTemplateName -> Text
$ctoEncodedQueryParam :: PodTemplateName -> Builder
toEncodedQueryParam :: PodTemplateName -> Builder
ToHttpApiData, Text -> Either Text PodTemplateName
ByteString -> Either Text PodTemplateName
(Text -> Either Text PodTemplateName)
-> (ByteString -> Either Text PodTemplateName)
-> (Text -> Either Text PodTemplateName)
-> FromHttpApiData PodTemplateName
forall a.
(Text -> Either Text a)
-> (ByteString -> Either Text a)
-> (Text -> Either Text a)
-> FromHttpApiData a
$cparseUrlPiece :: Text -> Either Text PodTemplateName
parseUrlPiece :: Text -> Either Text PodTemplateName
$cparseHeader :: ByteString -> Either Text PodTemplateName
parseHeader :: ByteString -> Either Text PodTemplateName
$cparseQueryParam :: Text -> Either Text PodTemplateName
parseQueryParam :: Text -> Either Text PodTemplateName
FromHttpApiData, [PodTemplateName] -> Value
[PodTemplateName] -> Encoding
PodTemplateName -> Bool
PodTemplateName -> Value
PodTemplateName -> Encoding
(PodTemplateName -> Value)
-> (PodTemplateName -> Encoding)
-> ([PodTemplateName] -> Value)
-> ([PodTemplateName] -> Encoding)
-> (PodTemplateName -> Bool)
-> ToJSON PodTemplateName
forall a.
(a -> Value)
-> (a -> Encoding)
-> ([a] -> Value)
-> ([a] -> Encoding)
-> (a -> Bool)
-> ToJSON a
$ctoJSON :: PodTemplateName -> Value
toJSON :: PodTemplateName -> Value
$ctoEncoding :: PodTemplateName -> Encoding
toEncoding :: PodTemplateName -> Encoding
$ctoJSONList :: [PodTemplateName] -> Value
toJSONList :: [PodTemplateName] -> Value
$ctoEncodingList :: [PodTemplateName] -> Encoding
toEncodingList :: [PodTemplateName] -> Encoding
$comitField :: PodTemplateName -> Bool
omitField :: PodTemplateName -> Bool
ToJSON,
    Maybe PodTemplateName
Value -> Parser [PodTemplateName]
Value -> Parser PodTemplateName
(Value -> Parser PodTemplateName)
-> (Value -> Parser [PodTemplateName])
-> Maybe PodTemplateName
-> FromJSON PodTemplateName
forall a.
(Value -> Parser a)
-> (Value -> Parser [a]) -> Maybe a -> FromJSON a
$cparseJSON :: Value -> Parser PodTemplateName
parseJSON :: Value -> Parser PodTemplateName
$cparseJSONList :: Value -> Parser [PodTemplateName]
parseJSONList :: Value -> Parser [PodTemplateName]
$comittedField :: Maybe PodTemplateName
omittedField :: Maybe PodTemplateName
FromJSON, ToJSONKeyFunction [PodTemplateName]
ToJSONKeyFunction PodTemplateName
ToJSONKeyFunction PodTemplateName
-> ToJSONKeyFunction [PodTemplateName] -> ToJSONKey PodTemplateName
forall a.
ToJSONKeyFunction a -> ToJSONKeyFunction [a] -> ToJSONKey a
$ctoJSONKey :: ToJSONKeyFunction PodTemplateName
toJSONKey :: ToJSONKeyFunction PodTemplateName
$ctoJSONKeyList :: ToJSONKeyFunction [PodTemplateName]
toJSONKeyList :: ToJSONKeyFunction [PodTemplateName]
ToJSONKey, FromJSONKeyFunction [PodTemplateName]
FromJSONKeyFunction PodTemplateName
FromJSONKeyFunction PodTemplateName
-> FromJSONKeyFunction [PodTemplateName]
-> FromJSONKey PodTemplateName
forall a.
FromJSONKeyFunction a -> FromJSONKeyFunction [a] -> FromJSONKey a
$cfromJSONKey :: FromJSONKeyFunction PodTemplateName
fromJSONKey :: FromJSONKeyFunction PodTemplateName
$cfromJSONKeyList :: FromJSONKeyFunction [PodTemplateName]
fromJSONKeyList :: FromJSONKeyFunction [PodTemplateName]
FromJSONKey
  )


{- | The specification of a pod template.  -}
newtype PodTemplateSpec = PodTempalteSpec
  { PodTemplateSpec -> Value
unPodTemplateSpec :: Value
  }
  deriving newtype (Maybe PodTemplateSpec
Value -> Parser [PodTemplateSpec]
Value -> Parser PodTemplateSpec
(Value -> Parser PodTemplateSpec)
-> (Value -> Parser [PodTemplateSpec])
-> Maybe PodTemplateSpec
-> FromJSON PodTemplateSpec
forall a.
(Value -> Parser a)
-> (Value -> Parser [a]) -> Maybe a -> FromJSON a
$cparseJSON :: Value -> Parser PodTemplateSpec
parseJSON :: Value -> Parser PodTemplateSpec
$cparseJSONList :: Value -> Parser [PodTemplateSpec]
parseJSONList :: Value -> Parser [PodTemplateSpec]
$comittedField :: Maybe PodTemplateSpec
omittedField :: Maybe PodTemplateSpec
FromJSON, [PodTemplateSpec] -> Value
[PodTemplateSpec] -> Encoding
PodTemplateSpec -> Bool
PodTemplateSpec -> Value
PodTemplateSpec -> Encoding
(PodTemplateSpec -> Value)
-> (PodTemplateSpec -> Encoding)
-> ([PodTemplateSpec] -> Value)
-> ([PodTemplateSpec] -> Encoding)
-> (PodTemplateSpec -> Bool)
-> ToJSON PodTemplateSpec
forall a.
(a -> Value)
-> (a -> Encoding)
-> ([a] -> Value)
-> ([a] -> Encoding)
-> (a -> Bool)
-> ToJSON a
$ctoJSON :: PodTemplateSpec -> Value
toJSON :: PodTemplateSpec -> Value
$ctoEncoding :: PodTemplateSpec -> Encoding
toEncoding :: PodTemplateSpec -> Encoding
$ctoJSONList :: [PodTemplateSpec] -> Value
toJSONList :: [PodTemplateSpec] -> Value
$ctoEncodingList :: [PodTemplateSpec] -> Encoding
toEncodingList :: [PodTemplateSpec] -> Encoding
$comitField :: PodTemplateSpec -> Bool
omitField :: PodTemplateSpec -> Bool
ToJSON)


{- | A pod specification. -}
newtype PodSpec = PodSpec {
    PodSpec -> Value
unPodSpec :: Value
  }
  deriving newtype (Maybe PodSpec
Value -> Parser [PodSpec]
Value -> Parser PodSpec
(Value -> Parser PodSpec)
-> (Value -> Parser [PodSpec]) -> Maybe PodSpec -> FromJSON PodSpec
forall a.
(Value -> Parser a)
-> (Value -> Parser [a]) -> Maybe a -> FromJSON a
$cparseJSON :: Value -> Parser PodSpec
parseJSON :: Value -> Parser PodSpec
$cparseJSONList :: Value -> Parser [PodSpec]
parseJSONList :: Value -> Parser [PodSpec]
$comittedField :: Maybe PodSpec
omittedField :: Maybe PodSpec
FromJSON, [PodSpec] -> Value
[PodSpec] -> Encoding
PodSpec -> Bool
PodSpec -> Value
PodSpec -> Encoding
(PodSpec -> Value)
-> (PodSpec -> Encoding)
-> ([PodSpec] -> Value)
-> ([PodSpec] -> Encoding)
-> (PodSpec -> Bool)
-> ToJSON PodSpec
forall a.
(a -> Value)
-> (a -> Encoding)
-> ([a] -> Value)
-> ([a] -> Encoding)
-> (a -> Bool)
-> ToJSON a
$ctoJSON :: PodSpec -> Value
toJSON :: PodSpec -> Value
$ctoEncoding :: PodSpec -> Encoding
toEncoding :: PodSpec -> Encoding
$ctoJSONList :: [PodSpec] -> Value
toJSONList :: [PodSpec] -> Value
$ctoEncodingList :: [PodSpec] -> Encoding
toEncodingList :: [PodSpec] -> Encoding
$comitField :: PodSpec -> Bool
omitField :: PodSpec -> Bool
ToJSON)


{- | A Kubernetes namespace. -}
newtype Namespace = Namespace
  { Namespace -> Text
unNamespace :: Text
  }
  deriving newtype (
    Namespace -> Namespace -> Bool
(Namespace -> Namespace -> Bool)
-> (Namespace -> Namespace -> Bool) -> Eq Namespace
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: Namespace -> Namespace -> Bool
== :: Namespace -> Namespace -> Bool
$c/= :: Namespace -> Namespace -> Bool
/= :: Namespace -> Namespace -> Bool
Eq, Eq Namespace
Eq Namespace =>
(Namespace -> Namespace -> Ordering)
-> (Namespace -> Namespace -> Bool)
-> (Namespace -> Namespace -> Bool)
-> (Namespace -> Namespace -> Bool)
-> (Namespace -> Namespace -> Bool)
-> (Namespace -> Namespace -> Namespace)
-> (Namespace -> Namespace -> Namespace)
-> Ord Namespace
Namespace -> Namespace -> Bool
Namespace -> Namespace -> Ordering
Namespace -> Namespace -> Namespace
forall a.
Eq a =>
(a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
$ccompare :: Namespace -> Namespace -> Ordering
compare :: Namespace -> Namespace -> Ordering
$c< :: Namespace -> Namespace -> Bool
< :: Namespace -> Namespace -> Bool
$c<= :: Namespace -> Namespace -> Bool
<= :: Namespace -> Namespace -> Bool
$c> :: Namespace -> Namespace -> Bool
> :: Namespace -> Namespace -> Bool
$c>= :: Namespace -> Namespace -> Bool
>= :: Namespace -> Namespace -> Bool
$cmax :: Namespace -> Namespace -> Namespace
max :: Namespace -> Namespace -> Namespace
$cmin :: Namespace -> Namespace -> Namespace
min :: Namespace -> Namespace -> Namespace
Ord, Int -> Namespace -> ShowS
[Namespace] -> ShowS
Namespace -> HostName
(Int -> Namespace -> ShowS)
-> (Namespace -> HostName)
-> ([Namespace] -> ShowS)
-> Show Namespace
forall a.
(Int -> a -> ShowS) -> (a -> HostName) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> Namespace -> ShowS
showsPrec :: Int -> Namespace -> ShowS
$cshow :: Namespace -> HostName
show :: Namespace -> HostName
$cshowList :: [Namespace] -> ShowS
showList :: [Namespace] -> ShowS
Show, HostName -> Namespace
(HostName -> Namespace) -> IsString Namespace
forall a. (HostName -> a) -> IsString a
$cfromString :: HostName -> Namespace
fromString :: HostName -> Namespace
IsString, Namespace -> Text
Namespace -> ByteString
Namespace -> Builder
(Namespace -> Text)
-> (Namespace -> Builder)
-> (Namespace -> ByteString)
-> (Namespace -> Text)
-> (Namespace -> Builder)
-> ToHttpApiData Namespace
forall a.
(a -> Text)
-> (a -> Builder)
-> (a -> ByteString)
-> (a -> Text)
-> (a -> Builder)
-> ToHttpApiData a
$ctoUrlPiece :: Namespace -> Text
toUrlPiece :: Namespace -> Text
$ctoEncodedUrlPiece :: Namespace -> Builder
toEncodedUrlPiece :: Namespace -> Builder
$ctoHeader :: Namespace -> ByteString
toHeader :: Namespace -> ByteString
$ctoQueryParam :: Namespace -> Text
toQueryParam :: Namespace -> Text
$ctoEncodedQueryParam :: Namespace -> Builder
toEncodedQueryParam :: Namespace -> Builder
ToHttpApiData, Text -> Either Text Namespace
ByteString -> Either Text Namespace
(Text -> Either Text Namespace)
-> (ByteString -> Either Text Namespace)
-> (Text -> Either Text Namespace)
-> FromHttpApiData Namespace
forall a.
(Text -> Either Text a)
-> (ByteString -> Either Text a)
-> (Text -> Either Text a)
-> FromHttpApiData a
$cparseUrlPiece :: Text -> Either Text Namespace
parseUrlPiece :: Text -> Either Text Namespace
$cparseHeader :: ByteString -> Either Text Namespace
parseHeader :: ByteString -> Either Text Namespace
$cparseQueryParam :: Text -> Either Text Namespace
parseQueryParam :: Text -> Either Text Namespace
FromHttpApiData, [Namespace] -> Value
[Namespace] -> Encoding
Namespace -> Bool
Namespace -> Value
Namespace -> Encoding
(Namespace -> Value)
-> (Namespace -> Encoding)
-> ([Namespace] -> Value)
-> ([Namespace] -> Encoding)
-> (Namespace -> Bool)
-> ToJSON Namespace
forall a.
(a -> Value)
-> (a -> Encoding)
-> ([a] -> Value)
-> ([a] -> Encoding)
-> (a -> Bool)
-> ToJSON a
$ctoJSON :: Namespace -> Value
toJSON :: Namespace -> Value
$ctoEncoding :: Namespace -> Encoding
toEncoding :: Namespace -> Encoding
$ctoJSONList :: [Namespace] -> Value
toJSONList :: [Namespace] -> Value
$ctoEncodingList :: [Namespace] -> Encoding
toEncodingList :: [Namespace] -> Encoding
$comitField :: Namespace -> Bool
omitField :: Namespace -> Bool
ToJSON,
    Maybe Namespace
Value -> Parser [Namespace]
Value -> Parser Namespace
(Value -> Parser Namespace)
-> (Value -> Parser [Namespace])
-> Maybe Namespace
-> FromJSON Namespace
forall a.
(Value -> Parser a)
-> (Value -> Parser [a]) -> Maybe a -> FromJSON a
$cparseJSON :: Value -> Parser Namespace
parseJSON :: Value -> Parser Namespace
$cparseJSONList :: Value -> Parser [Namespace]
parseJSONList :: Value -> Parser [Namespace]
$comittedField :: Maybe Namespace
omittedField :: Maybe Namespace
FromJSON, ToJSONKeyFunction [Namespace]
ToJSONKeyFunction Namespace
ToJSONKeyFunction Namespace
-> ToJSONKeyFunction [Namespace] -> ToJSONKey Namespace
forall a.
ToJSONKeyFunction a -> ToJSONKeyFunction [a] -> ToJSONKey a
$ctoJSONKey :: ToJSONKeyFunction Namespace
toJSONKey :: ToJSONKeyFunction Namespace
$ctoJSONKeyList :: ToJSONKeyFunction [Namespace]
toJSONKeyList :: ToJSONKeyFunction [Namespace]
ToJSONKey, FromJSONKeyFunction [Namespace]
FromJSONKeyFunction Namespace
FromJSONKeyFunction Namespace
-> FromJSONKeyFunction [Namespace] -> FromJSONKey Namespace
forall a.
FromJSONKeyFunction a -> FromJSONKeyFunction [a] -> FromJSONKey a
$cfromJSONKey :: FromJSONKeyFunction Namespace
fromJSONKey :: FromJSONKeyFunction Namespace
$cfromJSONKeyList :: FromJSONKeyFunction [Namespace]
fromJSONKeyList :: FromJSONKeyFunction [Namespace]
FromJSONKey
  )


{- | The name of a pod. -}
newtype PodName = PodName {
    PodName -> Text
unPodName :: Text
  }
  deriving newtype (
    PodName -> PodName -> Bool
(PodName -> PodName -> Bool)
-> (PodName -> PodName -> Bool) -> Eq PodName
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: PodName -> PodName -> Bool
== :: PodName -> PodName -> Bool
$c/= :: PodName -> PodName -> Bool
/= :: PodName -> PodName -> Bool
Eq, Eq PodName
Eq PodName =>
(PodName -> PodName -> Ordering)
-> (PodName -> PodName -> Bool)
-> (PodName -> PodName -> Bool)
-> (PodName -> PodName -> Bool)
-> (PodName -> PodName -> Bool)
-> (PodName -> PodName -> PodName)
-> (PodName -> PodName -> PodName)
-> Ord PodName
PodName -> PodName -> Bool
PodName -> PodName -> Ordering
PodName -> PodName -> PodName
forall a.
Eq a =>
(a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
$ccompare :: PodName -> PodName -> Ordering
compare :: PodName -> PodName -> Ordering
$c< :: PodName -> PodName -> Bool
< :: PodName -> PodName -> Bool
$c<= :: PodName -> PodName -> Bool
<= :: PodName -> PodName -> Bool
$c> :: PodName -> PodName -> Bool
> :: PodName -> PodName -> Bool
$c>= :: PodName -> PodName -> Bool
>= :: PodName -> PodName -> Bool
$cmax :: PodName -> PodName -> PodName
max :: PodName -> PodName -> PodName
$cmin :: PodName -> PodName -> PodName
min :: PodName -> PodName -> PodName
Ord, Int -> PodName -> ShowS
[PodName] -> ShowS
PodName -> HostName
(Int -> PodName -> ShowS)
-> (PodName -> HostName) -> ([PodName] -> ShowS) -> Show PodName
forall a.
(Int -> a -> ShowS) -> (a -> HostName) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> PodName -> ShowS
showsPrec :: Int -> PodName -> ShowS
$cshow :: PodName -> HostName
show :: PodName -> HostName
$cshowList :: [PodName] -> ShowS
showList :: [PodName] -> ShowS
Show, HostName -> PodName
(HostName -> PodName) -> IsString PodName
forall a. (HostName -> a) -> IsString a
$cfromString :: HostName -> PodName
fromString :: HostName -> PodName
IsString, PodName -> Text
PodName -> ByteString
PodName -> Builder
(PodName -> Text)
-> (PodName -> Builder)
-> (PodName -> ByteString)
-> (PodName -> Text)
-> (PodName -> Builder)
-> ToHttpApiData PodName
forall a.
(a -> Text)
-> (a -> Builder)
-> (a -> ByteString)
-> (a -> Text)
-> (a -> Builder)
-> ToHttpApiData a
$ctoUrlPiece :: PodName -> Text
toUrlPiece :: PodName -> Text
$ctoEncodedUrlPiece :: PodName -> Builder
toEncodedUrlPiece :: PodName -> Builder
$ctoHeader :: PodName -> ByteString
toHeader :: PodName -> ByteString
$ctoQueryParam :: PodName -> Text
toQueryParam :: PodName -> Text
$ctoEncodedQueryParam :: PodName -> Builder
toEncodedQueryParam :: PodName -> Builder
ToHttpApiData, Text -> Either Text PodName
ByteString -> Either Text PodName
(Text -> Either Text PodName)
-> (ByteString -> Either Text PodName)
-> (Text -> Either Text PodName)
-> FromHttpApiData PodName
forall a.
(Text -> Either Text a)
-> (ByteString -> Either Text a)
-> (Text -> Either Text a)
-> FromHttpApiData a
$cparseUrlPiece :: Text -> Either Text PodName
parseUrlPiece :: Text -> Either Text PodName
$cparseHeader :: ByteString -> Either Text PodName
parseHeader :: ByteString -> Either Text PodName
$cparseQueryParam :: Text -> Either Text PodName
parseQueryParam :: Text -> Either Text PodName
FromHttpApiData, [PodName] -> Value
[PodName] -> Encoding
PodName -> Bool
PodName -> Value
PodName -> Encoding
(PodName -> Value)
-> (PodName -> Encoding)
-> ([PodName] -> Value)
-> ([PodName] -> Encoding)
-> (PodName -> Bool)
-> ToJSON PodName
forall a.
(a -> Value)
-> (a -> Encoding)
-> ([a] -> Value)
-> ([a] -> Encoding)
-> (a -> Bool)
-> ToJSON a
$ctoJSON :: PodName -> Value
toJSON :: PodName -> Value
$ctoEncoding :: PodName -> Encoding
toEncoding :: PodName -> Encoding
$ctoJSONList :: [PodName] -> Value
toJSONList :: [PodName] -> Value
$ctoEncodingList :: [PodName] -> Encoding
toEncodingList :: [PodName] -> Encoding
$comitField :: PodName -> Bool
omitField :: PodName -> Bool
ToJSON,
    Maybe PodName
Value -> Parser [PodName]
Value -> Parser PodName
(Value -> Parser PodName)
-> (Value -> Parser [PodName]) -> Maybe PodName -> FromJSON PodName
forall a.
(Value -> Parser a)
-> (Value -> Parser [a]) -> Maybe a -> FromJSON a
$cparseJSON :: Value -> Parser PodName
parseJSON :: Value -> Parser PodName
$cparseJSONList :: Value -> Parser [PodName]
parseJSONList :: Value -> Parser [PodName]
$comittedField :: Maybe PodName
omittedField :: Maybe PodName
FromJSON, ToJSONKeyFunction [PodName]
ToJSONKeyFunction PodName
ToJSONKeyFunction PodName
-> ToJSONKeyFunction [PodName] -> ToJSONKey PodName
forall a.
ToJSONKeyFunction a -> ToJSONKeyFunction [a] -> ToJSONKey a
$ctoJSONKey :: ToJSONKeyFunction PodName
toJSONKey :: ToJSONKeyFunction PodName
$ctoJSONKeyList :: ToJSONKeyFunction [PodName]
toJSONKeyList :: ToJSONKeyFunction [PodName]
ToJSONKey, FromJSONKeyFunction [PodName]
FromJSONKeyFunction PodName
FromJSONKeyFunction PodName
-> FromJSONKeyFunction [PodName] -> FromJSONKey PodName
forall a.
FromJSONKeyFunction a -> FromJSONKeyFunction [a] -> FromJSONKey a
$cfromJSONKey :: FromJSONKeyFunction PodName
fromJSONKey :: FromJSONKeyFunction PodName
$cfromJSONKeyList :: FromJSONKeyFunction [PodName]
fromJSONKeyList :: FromJSONKeyFunction [PodName]
FromJSONKey
  )


{- | The representation of Role Binding. -}
newtype RoleBindingSpec = RoleBindingSpec {
    RoleBindingSpec -> Value
unRoleBindingSpec :: Value
  }
  deriving newtype ([RoleBindingSpec] -> Value
[RoleBindingSpec] -> Encoding
RoleBindingSpec -> Bool
RoleBindingSpec -> Value
RoleBindingSpec -> Encoding
(RoleBindingSpec -> Value)
-> (RoleBindingSpec -> Encoding)
-> ([RoleBindingSpec] -> Value)
-> ([RoleBindingSpec] -> Encoding)
-> (RoleBindingSpec -> Bool)
-> ToJSON RoleBindingSpec
forall a.
(a -> Value)
-> (a -> Encoding)
-> ([a] -> Value)
-> ([a] -> Encoding)
-> (a -> Bool)
-> ToJSON a
$ctoJSON :: RoleBindingSpec -> Value
toJSON :: RoleBindingSpec -> Value
$ctoEncoding :: RoleBindingSpec -> Encoding
toEncoding :: RoleBindingSpec -> Encoding
$ctoJSONList :: [RoleBindingSpec] -> Value
toJSONList :: [RoleBindingSpec] -> Value
$ctoEncodingList :: [RoleBindingSpec] -> Encoding
toEncodingList :: [RoleBindingSpec] -> Encoding
$comitField :: RoleBindingSpec -> Bool
omitField :: RoleBindingSpec -> Bool
ToJSON, Maybe RoleBindingSpec
Value -> Parser [RoleBindingSpec]
Value -> Parser RoleBindingSpec
(Value -> Parser RoleBindingSpec)
-> (Value -> Parser [RoleBindingSpec])
-> Maybe RoleBindingSpec
-> FromJSON RoleBindingSpec
forall a.
(Value -> Parser a)
-> (Value -> Parser [a]) -> Maybe a -> FromJSON a
$cparseJSON :: Value -> Parser RoleBindingSpec
parseJSON :: Value -> Parser RoleBindingSpec
$cparseJSONList :: Value -> Parser [RoleBindingSpec]
parseJSONList :: Value -> Parser [RoleBindingSpec]
$comittedField :: Maybe RoleBindingSpec
omittedField :: Maybe RoleBindingSpec
FromJSON)


{- | Get the k8s service account token. -}
getServiceAccountToken :: (MonadIO m) => m BearerToken
getServiceAccountToken :: forall (m :: * -> *). MonadIO m => m BearerToken
getServiceAccountToken =
  (Text -> BearerToken) -> m Text -> m BearerToken
forall a b. (a -> b) -> m a -> m b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Text -> BearerToken
BearerToken
  (m Text -> m BearerToken)
-> (HostName -> m Text) -> HostName -> m BearerToken
forall b c a. (b -> c) -> (a -> b) -> a -> c
. IO Text -> m Text
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO
  (IO Text -> m Text) -> (HostName -> IO Text) -> HostName -> m Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. HostName -> IO Text
TIO.readFile
  (HostName -> m BearerToken) -> HostName -> m BearerToken
forall a b. (a -> b) -> a -> b
$ HostName
"/var/run/secrets/kubernetes.io/serviceaccount/token"


mkEnv :: K8s -> ClientEnv
mkEnv :: K8s -> ClientEnv
mkEnv =
    Manager -> ClientEnv
mkEnv_ (Manager -> ClientEnv) -> (K8s -> Manager) -> K8s -> ClientEnv
forall b c a. (b -> c) -> (a -> b) -> a -> c
. K8s -> Manager
kManager 
  where
    mkEnv_ :: Manager -> ClientEnv
    mkEnv_ :: Manager -> ClientEnv
mkEnv_ Manager
manager =
      Manager -> BaseUrl -> ClientEnv
mkClientEnv
        Manager
manager
        (Scheme -> HostName -> Int -> HostName -> BaseUrl
BaseUrl Scheme
Https HostName
"kubernetes.default.svc" Int
443 HostName
"")


{- | The representation of a Role. -}
newtype RoleSpec = RoleSpec {
    RoleSpec -> Value
unRoleSpec :: Value
  }
  deriving newtype ([RoleSpec] -> Value
[RoleSpec] -> Encoding
RoleSpec -> Bool
RoleSpec -> Value
RoleSpec -> Encoding
(RoleSpec -> Value)
-> (RoleSpec -> Encoding)
-> ([RoleSpec] -> Value)
-> ([RoleSpec] -> Encoding)
-> (RoleSpec -> Bool)
-> ToJSON RoleSpec
forall a.
(a -> Value)
-> (a -> Encoding)
-> ([a] -> Value)
-> ([a] -> Encoding)
-> (a -> Bool)
-> ToJSON a
$ctoJSON :: RoleSpec -> Value
toJSON :: RoleSpec -> Value
$ctoEncoding :: RoleSpec -> Encoding
toEncoding :: RoleSpec -> Encoding
$ctoJSONList :: [RoleSpec] -> Value
toJSONList :: [RoleSpec] -> Value
$ctoEncodingList :: [RoleSpec] -> Encoding
toEncodingList :: [RoleSpec] -> Encoding
$comitField :: RoleSpec -> Bool
omitField :: RoleSpec -> Bool
ToJSON, Maybe RoleSpec
Value -> Parser [RoleSpec]
Value -> Parser RoleSpec
(Value -> Parser RoleSpec)
-> (Value -> Parser [RoleSpec])
-> Maybe RoleSpec
-> FromJSON RoleSpec
forall a.
(Value -> Parser a)
-> (Value -> Parser [a]) -> Maybe a -> FromJSON a
$cparseJSON :: Value -> Parser RoleSpec
parseJSON :: Value -> Parser RoleSpec
$cparseJSONList :: Value -> Parser [RoleSpec]
parseJSONList :: Value -> Parser [RoleSpec]
$comittedField :: Maybe RoleSpec
omittedField :: Maybe RoleSpec
FromJSON)


{- | The representation of a service account. -}
newtype ServiceAccountSpec = ServiceAccountSpec {
    ServiceAccountSpec -> Value
unServiceAccountSpec :: Value
  }
  deriving newtype ([ServiceAccountSpec] -> Value
[ServiceAccountSpec] -> Encoding
ServiceAccountSpec -> Bool
ServiceAccountSpec -> Value
ServiceAccountSpec -> Encoding
(ServiceAccountSpec -> Value)
-> (ServiceAccountSpec -> Encoding)
-> ([ServiceAccountSpec] -> Value)
-> ([ServiceAccountSpec] -> Encoding)
-> (ServiceAccountSpec -> Bool)
-> ToJSON ServiceAccountSpec
forall a.
(a -> Value)
-> (a -> Encoding)
-> ([a] -> Value)
-> ([a] -> Encoding)
-> (a -> Bool)
-> ToJSON a
$ctoJSON :: ServiceAccountSpec -> Value
toJSON :: ServiceAccountSpec -> Value
$ctoEncoding :: ServiceAccountSpec -> Encoding
toEncoding :: ServiceAccountSpec -> Encoding
$ctoJSONList :: [ServiceAccountSpec] -> Value
toJSONList :: [ServiceAccountSpec] -> Value
$ctoEncodingList :: [ServiceAccountSpec] -> Encoding
toEncodingList :: [ServiceAccountSpec] -> Encoding
$comitField :: ServiceAccountSpec -> Bool
omitField :: ServiceAccountSpec -> Bool
ToJSON, Maybe ServiceAccountSpec
Value -> Parser [ServiceAccountSpec]
Value -> Parser ServiceAccountSpec
(Value -> Parser ServiceAccountSpec)
-> (Value -> Parser [ServiceAccountSpec])
-> Maybe ServiceAccountSpec
-> FromJSON ServiceAccountSpec
forall a.
(Value -> Parser a)
-> (Value -> Parser [a]) -> Maybe a -> FromJSON a
$cparseJSON :: Value -> Parser ServiceAccountSpec
parseJSON :: Value -> Parser ServiceAccountSpec
$cparseJSONList :: Value -> Parser [ServiceAccountSpec]
parseJSONList :: Value -> Parser [ServiceAccountSpec]
$comittedField :: Maybe ServiceAccountSpec
omittedField :: Maybe ServiceAccountSpec
FromJSON)


{- | The representation of a Namespace specification. -}
newtype NamespaceSpec = NamespaceSpec {
    NamespaceSpec -> Value
unNamespaceSpec :: Value
  }
  deriving newtype ([NamespaceSpec] -> Value
[NamespaceSpec] -> Encoding
NamespaceSpec -> Bool
NamespaceSpec -> Value
NamespaceSpec -> Encoding
(NamespaceSpec -> Value)
-> (NamespaceSpec -> Encoding)
-> ([NamespaceSpec] -> Value)
-> ([NamespaceSpec] -> Encoding)
-> (NamespaceSpec -> Bool)
-> ToJSON NamespaceSpec
forall a.
(a -> Value)
-> (a -> Encoding)
-> ([a] -> Value)
-> ([a] -> Encoding)
-> (a -> Bool)
-> ToJSON a
$ctoJSON :: NamespaceSpec -> Value
toJSON :: NamespaceSpec -> Value
$ctoEncoding :: NamespaceSpec -> Encoding
toEncoding :: NamespaceSpec -> Encoding
$ctoJSONList :: [NamespaceSpec] -> Value
toJSONList :: [NamespaceSpec] -> Value
$ctoEncodingList :: [NamespaceSpec] -> Encoding
toEncodingList :: [NamespaceSpec] -> Encoding
$comitField :: NamespaceSpec -> Bool
omitField :: NamespaceSpec -> Bool
ToJSON, Maybe NamespaceSpec
Value -> Parser [NamespaceSpec]
Value -> Parser NamespaceSpec
(Value -> Parser NamespaceSpec)
-> (Value -> Parser [NamespaceSpec])
-> Maybe NamespaceSpec
-> FromJSON NamespaceSpec
forall a.
(Value -> Parser a)
-> (Value -> Parser [a]) -> Maybe a -> FromJSON a
$cparseJSON :: Value -> Parser NamespaceSpec
parseJSON :: Value -> Parser NamespaceSpec
$cparseJSONList :: Value -> Parser [NamespaceSpec]
parseJSONList :: Value -> Parser [NamespaceSpec]
$comittedField :: Maybe NamespaceSpec
omittedField :: Maybe NamespaceSpec
FromJSON)