{-# LANGUAGE DeriveDataTypeable #-}
{-# LANGUAGE DeriveFoldable #-}
{-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE DeriveTraversable #-}
{-# LANGUAGE GeneralizedNewtypeDeriving #-}
{-# LANGUAGE LambdaCase #-}
{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE NamedFieldPuns #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE RecordWildCards #-}
{-# LANGUAGE TupleSections #-}
{-# LANGUAGE TypeFamilies #-}
{-# OPTIONS_GHC -fno-warn-unused-matches -fno-warn-unused-binds -fno-warn-unused-imports #-}
module Kubernetes.OpenAPI.Model (module Kubernetes.OpenAPI.Model, module Kubernetes.OpenAPI.ImportMappings) where
import Kubernetes.OpenAPI.Core
import Kubernetes.OpenAPI.MimeTypes
import Kubernetes.OpenAPI.ImportMappings
import Data.Aeson ((.:),(.:!),(.:?),(.=))
import qualified Control.Arrow as P (left)
import qualified Data.Aeson as A
import qualified Data.ByteString as B
import qualified Data.ByteString.Base64 as B64
import qualified Data.ByteString.Char8 as BC
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.HashMap.Lazy as HM
import qualified Data.Map as Map
import qualified Data.Maybe as P
import qualified Data.Set as Set
import qualified Data.Text as T
import qualified Data.Text.Encoding as T
import qualified Data.Time as TI
import qualified Lens.Micro as L
import qualified Web.FormUrlEncoded as WH
import qualified Web.HttpApiData as WH
import Control.Applicative ((<|>))
import Control.Applicative (Alternative)
import Data.Function ((&))
import Data.Monoid ((<>))
import Data.Text (Text)
import Prelude (($),(/=),(.),(<$>),(<*>),(>>=),(=<<),Maybe(..),Bool(..),Char,Double,FilePath,Float,Int,Integer,String,fmap,undefined,mempty,maybe,pure,Monad,Applicative,Functor)
import qualified Prelude as P
newtype AllowWatchBookmarks = AllowWatchBookmarks { unAllowWatchBookmarks :: Bool } deriving (P.Eq, P.Show)
newtype Body = Body { unBody :: A.Value } deriving (P.Eq, P.Show, A.ToJSON)
newtype Command = Command { unCommand :: Text } deriving (P.Eq, P.Show)
newtype Container = Container { unContainer :: Text } deriving (P.Eq, P.Show)
newtype Continue = Continue { unContinue :: Text } deriving (P.Eq, P.Show)
newtype DryRun = DryRun { unDryRun :: Text } deriving (P.Eq, P.Show)
newtype Exact = Exact { unExact :: Bool } deriving (P.Eq, P.Show)
newtype Export = Export { unExport :: Bool } deriving (P.Eq, P.Show)
newtype FieldManager = FieldManager { unFieldManager :: Text } deriving (P.Eq, P.Show)
newtype FieldSelector = FieldSelector { unFieldSelector :: Text } deriving (P.Eq, P.Show)
newtype Follow = Follow { unFollow :: Bool } deriving (P.Eq, P.Show)
newtype Force = Force { unForce :: Bool } deriving (P.Eq, P.Show)
newtype GracePeriodSeconds = GracePeriodSeconds { unGracePeriodSeconds :: Int } deriving (P.Eq, P.Show)
newtype Group = Group { unGroup :: Text } deriving (P.Eq, P.Show)
newtype LabelSelector = LabelSelector { unLabelSelector :: Text } deriving (P.Eq, P.Show)
newtype Limit = Limit { unLimit :: Int } deriving (P.Eq, P.Show)
newtype LimitBytes = LimitBytes { unLimitBytes :: Int } deriving (P.Eq, P.Show)
newtype Logpath = Logpath { unLogpath :: Text } deriving (P.Eq, P.Show)
newtype Name = Name { unName :: Text } deriving (P.Eq, P.Show)
newtype Namespace = Namespace { unNamespace :: Text } deriving (P.Eq, P.Show)
newtype OrphanDependents = OrphanDependents { unOrphanDependents :: Bool } deriving (P.Eq, P.Show)
newtype Path = Path { unPath :: Text } deriving (P.Eq, P.Show)
newtype Path2 = Path2 { unPath2 :: Text } deriving (P.Eq, P.Show)
newtype Plural = Plural { unPlural :: Text } deriving (P.Eq, P.Show)
newtype Ports = Ports { unPorts :: Int } deriving (P.Eq, P.Show)
newtype Pretty = Pretty { unPretty :: Text } deriving (P.Eq, P.Show)
newtype Previous = Previous { unPrevious :: Bool } deriving (P.Eq, P.Show)
newtype PropagationPolicy = PropagationPolicy { unPropagationPolicy :: Text } deriving (P.Eq, P.Show)
newtype ResourceVersion = ResourceVersion { unResourceVersion :: Text } deriving (P.Eq, P.Show)
newtype SinceSeconds = SinceSeconds { unSinceSeconds :: Int } deriving (P.Eq, P.Show)
newtype Stderr = Stderr { unStderr :: Bool } deriving (P.Eq, P.Show)
newtype Stdin = Stdin { unStdin :: Bool } deriving (P.Eq, P.Show)
newtype Stdout = Stdout { unStdout :: Bool } deriving (P.Eq, P.Show)
newtype TailLines = TailLines { unTailLines :: Int } deriving (P.Eq, P.Show)
newtype TimeoutSeconds = TimeoutSeconds { unTimeoutSeconds :: Int } deriving (P.Eq, P.Show)
newtype Timestamps = Timestamps { unTimestamps :: Bool } deriving (P.Eq, P.Show)
newtype Tty = Tty { unTty :: Bool } deriving (P.Eq, P.Show)
newtype Version = Version { unVersion :: Text } deriving (P.Eq, P.Show)
newtype Watch = Watch { unWatch :: Bool } deriving (P.Eq, P.Show)
data AdmissionregistrationV1ServiceReference = AdmissionregistrationV1ServiceReference
{ admissionregistrationV1ServiceReferenceName :: !(Text)
, admissionregistrationV1ServiceReferenceNamespace :: !(Text)
, admissionregistrationV1ServiceReferencePath :: !(Maybe Text)
, admissionregistrationV1ServiceReferencePort :: !(Maybe Int)
} deriving (P.Show, P.Eq, P.Typeable)
instance A.FromJSON AdmissionregistrationV1ServiceReference where
parseJSON = A.withObject "AdmissionregistrationV1ServiceReference" $ \o ->
AdmissionregistrationV1ServiceReference
<$> (o .: "name")
<*> (o .: "namespace")
<*> (o .:? "path")
<*> (o .:? "port")
instance A.ToJSON AdmissionregistrationV1ServiceReference where
toJSON AdmissionregistrationV1ServiceReference {..} =
_omitNulls
[ "name" .= admissionregistrationV1ServiceReferenceName
, "namespace" .= admissionregistrationV1ServiceReferenceNamespace
, "path" .= admissionregistrationV1ServiceReferencePath
, "port" .= admissionregistrationV1ServiceReferencePort
]
mkAdmissionregistrationV1ServiceReference
:: Text
-> Text
-> AdmissionregistrationV1ServiceReference
mkAdmissionregistrationV1ServiceReference admissionregistrationV1ServiceReferenceName admissionregistrationV1ServiceReferenceNamespace =
AdmissionregistrationV1ServiceReference
{ admissionregistrationV1ServiceReferenceName
, admissionregistrationV1ServiceReferenceNamespace
, admissionregistrationV1ServiceReferencePath = Nothing
, admissionregistrationV1ServiceReferencePort = Nothing
}
data AdmissionregistrationV1WebhookClientConfig = AdmissionregistrationV1WebhookClientConfig
{ admissionregistrationV1WebhookClientConfigCaBundle :: !(Maybe ByteArray)
, admissionregistrationV1WebhookClientConfigService :: !(Maybe AdmissionregistrationV1ServiceReference)
, admissionregistrationV1WebhookClientConfigUrl :: !(Maybe Text)
} deriving (P.Show, P.Eq, P.Typeable)
instance A.FromJSON AdmissionregistrationV1WebhookClientConfig where
parseJSON = A.withObject "AdmissionregistrationV1WebhookClientConfig" $ \o ->
AdmissionregistrationV1WebhookClientConfig
<$> (o .:? "caBundle")
<*> (o .:? "service")
<*> (o .:? "url")
instance A.ToJSON AdmissionregistrationV1WebhookClientConfig where
toJSON AdmissionregistrationV1WebhookClientConfig {..} =
_omitNulls
[ "caBundle" .= admissionregistrationV1WebhookClientConfigCaBundle
, "service" .= admissionregistrationV1WebhookClientConfigService
, "url" .= admissionregistrationV1WebhookClientConfigUrl
]
mkAdmissionregistrationV1WebhookClientConfig
:: AdmissionregistrationV1WebhookClientConfig
mkAdmissionregistrationV1WebhookClientConfig =
AdmissionregistrationV1WebhookClientConfig
{ admissionregistrationV1WebhookClientConfigCaBundle = Nothing
, admissionregistrationV1WebhookClientConfigService = Nothing
, admissionregistrationV1WebhookClientConfigUrl = Nothing
}
data AdmissionregistrationV1beta1ServiceReference = AdmissionregistrationV1beta1ServiceReference
{ admissionregistrationV1beta1ServiceReferenceName :: !(Text)
, admissionregistrationV1beta1ServiceReferenceNamespace :: !(Text)
, admissionregistrationV1beta1ServiceReferencePath :: !(Maybe Text)
, admissionregistrationV1beta1ServiceReferencePort :: !(Maybe Int)
} deriving (P.Show, P.Eq, P.Typeable)
instance A.FromJSON AdmissionregistrationV1beta1ServiceReference where
parseJSON = A.withObject "AdmissionregistrationV1beta1ServiceReference" $ \o ->
AdmissionregistrationV1beta1ServiceReference
<$> (o .: "name")
<*> (o .: "namespace")
<*> (o .:? "path")
<*> (o .:? "port")
instance A.ToJSON AdmissionregistrationV1beta1ServiceReference where
toJSON AdmissionregistrationV1beta1ServiceReference {..} =
_omitNulls
[ "name" .= admissionregistrationV1beta1ServiceReferenceName
, "namespace" .= admissionregistrationV1beta1ServiceReferenceNamespace
, "path" .= admissionregistrationV1beta1ServiceReferencePath
, "port" .= admissionregistrationV1beta1ServiceReferencePort
]
mkAdmissionregistrationV1beta1ServiceReference
:: Text
-> Text
-> AdmissionregistrationV1beta1ServiceReference
mkAdmissionregistrationV1beta1ServiceReference admissionregistrationV1beta1ServiceReferenceName admissionregistrationV1beta1ServiceReferenceNamespace =
AdmissionregistrationV1beta1ServiceReference
{ admissionregistrationV1beta1ServiceReferenceName
, admissionregistrationV1beta1ServiceReferenceNamespace
, admissionregistrationV1beta1ServiceReferencePath = Nothing
, admissionregistrationV1beta1ServiceReferencePort = Nothing
}
data AdmissionregistrationV1beta1WebhookClientConfig = AdmissionregistrationV1beta1WebhookClientConfig
{ admissionregistrationV1beta1WebhookClientConfigCaBundle :: !(Maybe ByteArray)
, admissionregistrationV1beta1WebhookClientConfigService :: !(Maybe AdmissionregistrationV1beta1ServiceReference)
, admissionregistrationV1beta1WebhookClientConfigUrl :: !(Maybe Text)
} deriving (P.Show, P.Eq, P.Typeable)
instance A.FromJSON AdmissionregistrationV1beta1WebhookClientConfig where
parseJSON = A.withObject "AdmissionregistrationV1beta1WebhookClientConfig" $ \o ->
AdmissionregistrationV1beta1WebhookClientConfig
<$> (o .:? "caBundle")
<*> (o .:? "service")
<*> (o .:? "url")
instance A.ToJSON AdmissionregistrationV1beta1WebhookClientConfig where
toJSON AdmissionregistrationV1beta1WebhookClientConfig {..} =
_omitNulls
[ "caBundle" .= admissionregistrationV1beta1WebhookClientConfigCaBundle
, "service" .= admissionregistrationV1beta1WebhookClientConfigService
, "url" .= admissionregistrationV1beta1WebhookClientConfigUrl
]
mkAdmissionregistrationV1beta1WebhookClientConfig
:: AdmissionregistrationV1beta1WebhookClientConfig
mkAdmissionregistrationV1beta1WebhookClientConfig =
AdmissionregistrationV1beta1WebhookClientConfig
{ admissionregistrationV1beta1WebhookClientConfigCaBundle = Nothing
, admissionregistrationV1beta1WebhookClientConfigService = Nothing
, admissionregistrationV1beta1WebhookClientConfigUrl = Nothing
}
data ApiextensionsV1ServiceReference = ApiextensionsV1ServiceReference
{ apiextensionsV1ServiceReferenceName :: !(Text)
, apiextensionsV1ServiceReferenceNamespace :: !(Text)
, apiextensionsV1ServiceReferencePath :: !(Maybe Text)
, apiextensionsV1ServiceReferencePort :: !(Maybe Int)
} deriving (P.Show, P.Eq, P.Typeable)
instance A.FromJSON ApiextensionsV1ServiceReference where
parseJSON = A.withObject "ApiextensionsV1ServiceReference" $ \o ->
ApiextensionsV1ServiceReference
<$> (o .: "name")
<*> (o .: "namespace")
<*> (o .:? "path")
<*> (o .:? "port")
instance A.ToJSON ApiextensionsV1ServiceReference where
toJSON ApiextensionsV1ServiceReference {..} =
_omitNulls
[ "name" .= apiextensionsV1ServiceReferenceName
, "namespace" .= apiextensionsV1ServiceReferenceNamespace
, "path" .= apiextensionsV1ServiceReferencePath
, "port" .= apiextensionsV1ServiceReferencePort
]
mkApiextensionsV1ServiceReference
:: Text
-> Text
-> ApiextensionsV1ServiceReference
mkApiextensionsV1ServiceReference apiextensionsV1ServiceReferenceName apiextensionsV1ServiceReferenceNamespace =
ApiextensionsV1ServiceReference
{ apiextensionsV1ServiceReferenceName
, apiextensionsV1ServiceReferenceNamespace
, apiextensionsV1ServiceReferencePath = Nothing
, apiextensionsV1ServiceReferencePort = Nothing
}
data ApiextensionsV1WebhookClientConfig = ApiextensionsV1WebhookClientConfig
{ apiextensionsV1WebhookClientConfigCaBundle :: !(Maybe ByteArray)
, apiextensionsV1WebhookClientConfigService :: !(Maybe ApiextensionsV1ServiceReference)
, apiextensionsV1WebhookClientConfigUrl :: !(Maybe Text)
} deriving (P.Show, P.Eq, P.Typeable)
instance A.FromJSON ApiextensionsV1WebhookClientConfig where
parseJSON = A.withObject "ApiextensionsV1WebhookClientConfig" $ \o ->
ApiextensionsV1WebhookClientConfig
<$> (o .:? "caBundle")
<*> (o .:? "service")
<*> (o .:? "url")
instance A.ToJSON ApiextensionsV1WebhookClientConfig where
toJSON ApiextensionsV1WebhookClientConfig {..} =
_omitNulls
[ "caBundle" .= apiextensionsV1WebhookClientConfigCaBundle
, "service" .= apiextensionsV1WebhookClientConfigService
, "url" .= apiextensionsV1WebhookClientConfigUrl
]
mkApiextensionsV1WebhookClientConfig
:: ApiextensionsV1WebhookClientConfig
mkApiextensionsV1WebhookClientConfig =
ApiextensionsV1WebhookClientConfig
{ apiextensionsV1WebhookClientConfigCaBundle = Nothing
, apiextensionsV1WebhookClientConfigService = Nothing
, apiextensionsV1WebhookClientConfigUrl = Nothing
}
data ApiextensionsV1beta1ServiceReference = ApiextensionsV1beta1ServiceReference
{ apiextensionsV1beta1ServiceReferenceName :: !(Text)
, apiextensionsV1beta1ServiceReferenceNamespace :: !(Text)
, apiextensionsV1beta1ServiceReferencePath :: !(Maybe Text)
, apiextensionsV1beta1ServiceReferencePort :: !(Maybe Int)
} deriving (P.Show, P.Eq, P.Typeable)
instance A.FromJSON ApiextensionsV1beta1ServiceReference where
parseJSON = A.withObject "ApiextensionsV1beta1ServiceReference" $ \o ->
ApiextensionsV1beta1ServiceReference
<$> (o .: "name")
<*> (o .: "namespace")
<*> (o .:? "path")
<*> (o .:? "port")
instance A.ToJSON ApiextensionsV1beta1ServiceReference where
toJSON ApiextensionsV1beta1ServiceReference {..} =
_omitNulls
[ "name" .= apiextensionsV1beta1ServiceReferenceName
, "namespace" .= apiextensionsV1beta1ServiceReferenceNamespace
, "path" .= apiextensionsV1beta1ServiceReferencePath
, "port" .= apiextensionsV1beta1ServiceReferencePort
]
mkApiextensionsV1beta1ServiceReference
:: Text
-> Text
-> ApiextensionsV1beta1ServiceReference
mkApiextensionsV1beta1ServiceReference apiextensionsV1beta1ServiceReferenceName apiextensionsV1beta1ServiceReferenceNamespace =
ApiextensionsV1beta1ServiceReference
{ apiextensionsV1beta1ServiceReferenceName
, apiextensionsV1beta1ServiceReferenceNamespace
, apiextensionsV1beta1ServiceReferencePath = Nothing
, apiextensionsV1beta1ServiceReferencePort = Nothing
}
data ApiextensionsV1beta1WebhookClientConfig = ApiextensionsV1beta1WebhookClientConfig
{ apiextensionsV1beta1WebhookClientConfigCaBundle :: !(Maybe ByteArray)
, apiextensionsV1beta1WebhookClientConfigService :: !(Maybe ApiextensionsV1beta1ServiceReference)
, apiextensionsV1beta1WebhookClientConfigUrl :: !(Maybe Text)
} deriving (P.Show, P.Eq, P.Typeable)
instance A.FromJSON ApiextensionsV1beta1WebhookClientConfig where
parseJSON = A.withObject "ApiextensionsV1beta1WebhookClientConfig" $ \o ->
ApiextensionsV1beta1WebhookClientConfig
<$> (o .:? "caBundle")
<*> (o .:? "service")
<*> (o .:? "url")
instance A.ToJSON ApiextensionsV1beta1WebhookClientConfig where
toJSON ApiextensionsV1beta1WebhookClientConfig {..} =
_omitNulls
[ "caBundle" .= apiextensionsV1beta1WebhookClientConfigCaBundle
, "service" .= apiextensionsV1beta1WebhookClientConfigService
, "url" .= apiextensionsV1beta1WebhookClientConfigUrl
]
mkApiextensionsV1beta1WebhookClientConfig
:: ApiextensionsV1beta1WebhookClientConfig
mkApiextensionsV1beta1WebhookClientConfig =
ApiextensionsV1beta1WebhookClientConfig
{ apiextensionsV1beta1WebhookClientConfigCaBundle = Nothing
, apiextensionsV1beta1WebhookClientConfigService = Nothing
, apiextensionsV1beta1WebhookClientConfigUrl = Nothing
}
data ApiregistrationV1ServiceReference = ApiregistrationV1ServiceReference
{ apiregistrationV1ServiceReferenceName :: !(Maybe Text)
, apiregistrationV1ServiceReferenceNamespace :: !(Maybe Text)
, apiregistrationV1ServiceReferencePort :: !(Maybe Int)
} deriving (P.Show, P.Eq, P.Typeable)
instance A.FromJSON ApiregistrationV1ServiceReference where
parseJSON = A.withObject "ApiregistrationV1ServiceReference" $ \o ->
ApiregistrationV1ServiceReference
<$> (o .:? "name")
<*> (o .:? "namespace")
<*> (o .:? "port")
instance A.ToJSON ApiregistrationV1ServiceReference where
toJSON ApiregistrationV1ServiceReference {..} =
_omitNulls
[ "name" .= apiregistrationV1ServiceReferenceName
, "namespace" .= apiregistrationV1ServiceReferenceNamespace
, "port" .= apiregistrationV1ServiceReferencePort
]
mkApiregistrationV1ServiceReference
:: ApiregistrationV1ServiceReference
mkApiregistrationV1ServiceReference =
ApiregistrationV1ServiceReference
{ apiregistrationV1ServiceReferenceName = Nothing
, apiregistrationV1ServiceReferenceNamespace = Nothing
, apiregistrationV1ServiceReferencePort = Nothing
}
data ApiregistrationV1beta1ServiceReference = ApiregistrationV1beta1ServiceReference
{ apiregistrationV1beta1ServiceReferenceName :: !(Maybe Text)
, apiregistrationV1beta1ServiceReferenceNamespace :: !(Maybe Text)
, apiregistrationV1beta1ServiceReferencePort :: !(Maybe Int)
} deriving (P.Show, P.Eq, P.Typeable)
instance A.FromJSON ApiregistrationV1beta1ServiceReference where
parseJSON = A.withObject "ApiregistrationV1beta1ServiceReference" $ \o ->
ApiregistrationV1beta1ServiceReference
<$> (o .:? "name")
<*> (o .:? "namespace")
<*> (o .:? "port")
instance A.ToJSON ApiregistrationV1beta1ServiceReference where
toJSON ApiregistrationV1beta1ServiceReference {..} =
_omitNulls
[ "name" .= apiregistrationV1beta1ServiceReferenceName
, "namespace" .= apiregistrationV1beta1ServiceReferenceNamespace
, "port" .= apiregistrationV1beta1ServiceReferencePort
]
mkApiregistrationV1beta1ServiceReference
:: ApiregistrationV1beta1ServiceReference
mkApiregistrationV1beta1ServiceReference =
ApiregistrationV1beta1ServiceReference
{ apiregistrationV1beta1ServiceReferenceName = Nothing
, apiregistrationV1beta1ServiceReferenceNamespace = Nothing
, apiregistrationV1beta1ServiceReferencePort = Nothing
}
data AppsV1beta1Deployment = AppsV1beta1Deployment
{ appsV1beta1DeploymentApiVersion :: !(Maybe Text)
, appsV1beta1DeploymentKind :: !(Maybe Text)
, appsV1beta1DeploymentMetadata :: !(Maybe V1ObjectMeta)
, appsV1beta1DeploymentSpec :: !(Maybe AppsV1beta1DeploymentSpec)
, appsV1beta1DeploymentStatus :: !(Maybe AppsV1beta1DeploymentStatus)
} deriving (P.Show, P.Eq, P.Typeable)
instance A.FromJSON AppsV1beta1Deployment where
parseJSON = A.withObject "AppsV1beta1Deployment" $ \o ->
AppsV1beta1Deployment
<$> (o .:? "apiVersion")
<*> (o .:? "kind")
<*> (o .:? "metadata")
<*> (o .:? "spec")
<*> (o .:? "status")
instance A.ToJSON AppsV1beta1Deployment where
toJSON AppsV1beta1Deployment {..} =
_omitNulls
[ "apiVersion" .= appsV1beta1DeploymentApiVersion
, "kind" .= appsV1beta1DeploymentKind
, "metadata" .= appsV1beta1DeploymentMetadata
, "spec" .= appsV1beta1DeploymentSpec
, "status" .= appsV1beta1DeploymentStatus
]
mkAppsV1beta1Deployment
:: AppsV1beta1Deployment
mkAppsV1beta1Deployment =
AppsV1beta1Deployment
{ appsV1beta1DeploymentApiVersion = Nothing
, appsV1beta1DeploymentKind = Nothing
, appsV1beta1DeploymentMetadata = Nothing
, appsV1beta1DeploymentSpec = Nothing
, appsV1beta1DeploymentStatus = Nothing
}
data AppsV1beta1DeploymentCondition = AppsV1beta1DeploymentCondition
{ appsV1beta1DeploymentConditionLastTransitionTime :: !(Maybe DateTime)
, appsV1beta1DeploymentConditionLastUpdateTime :: !(Maybe DateTime)
, appsV1beta1DeploymentConditionMessage :: !(Maybe Text)
, appsV1beta1DeploymentConditionReason :: !(Maybe Text)
, appsV1beta1DeploymentConditionStatus :: !(Text)
, appsV1beta1DeploymentConditionType :: !(Text)
} deriving (P.Show, P.Eq, P.Typeable)
instance A.FromJSON AppsV1beta1DeploymentCondition where
parseJSON = A.withObject "AppsV1beta1DeploymentCondition" $ \o ->
AppsV1beta1DeploymentCondition
<$> (o .:? "lastTransitionTime")
<*> (o .:? "lastUpdateTime")
<*> (o .:? "message")
<*> (o .:? "reason")
<*> (o .: "status")
<*> (o .: "type")
instance A.ToJSON AppsV1beta1DeploymentCondition where
toJSON AppsV1beta1DeploymentCondition {..} =
_omitNulls
[ "lastTransitionTime" .= appsV1beta1DeploymentConditionLastTransitionTime
, "lastUpdateTime" .= appsV1beta1DeploymentConditionLastUpdateTime
, "message" .= appsV1beta1DeploymentConditionMessage
, "reason" .= appsV1beta1DeploymentConditionReason
, "status" .= appsV1beta1DeploymentConditionStatus
, "type" .= appsV1beta1DeploymentConditionType
]
mkAppsV1beta1DeploymentCondition
:: Text
-> Text
-> AppsV1beta1DeploymentCondition
mkAppsV1beta1DeploymentCondition appsV1beta1DeploymentConditionStatus appsV1beta1DeploymentConditionType =
AppsV1beta1DeploymentCondition
{ appsV1beta1DeploymentConditionLastTransitionTime = Nothing
, appsV1beta1DeploymentConditionLastUpdateTime = Nothing
, appsV1beta1DeploymentConditionMessage = Nothing
, appsV1beta1DeploymentConditionReason = Nothing
, appsV1beta1DeploymentConditionStatus
, appsV1beta1DeploymentConditionType
}
data AppsV1beta1DeploymentList = AppsV1beta1DeploymentList
{ appsV1beta1DeploymentListApiVersion :: !(Maybe Text)
, appsV1beta1DeploymentListItems :: !([AppsV1beta1Deployment])
, appsV1beta1DeploymentListKind :: !(Maybe Text)
, appsV1beta1DeploymentListMetadata :: !(Maybe V1ListMeta)
} deriving (P.Show, P.Eq, P.Typeable)
instance A.FromJSON AppsV1beta1DeploymentList where
parseJSON = A.withObject "AppsV1beta1DeploymentList" $ \o ->
AppsV1beta1DeploymentList
<$> (o .:? "apiVersion")
<*> (o .: "items")
<*> (o .:? "kind")
<*> (o .:? "metadata")
instance A.ToJSON AppsV1beta1DeploymentList where
toJSON AppsV1beta1DeploymentList {..} =
_omitNulls
[ "apiVersion" .= appsV1beta1DeploymentListApiVersion
, "items" .= appsV1beta1DeploymentListItems
, "kind" .= appsV1beta1DeploymentListKind
, "metadata" .= appsV1beta1DeploymentListMetadata
]
mkAppsV1beta1DeploymentList
:: [AppsV1beta1Deployment]
-> AppsV1beta1DeploymentList
mkAppsV1beta1DeploymentList appsV1beta1DeploymentListItems =
AppsV1beta1DeploymentList
{ appsV1beta1DeploymentListApiVersion = Nothing
, appsV1beta1DeploymentListItems
, appsV1beta1DeploymentListKind = Nothing
, appsV1beta1DeploymentListMetadata = Nothing
}
data AppsV1beta1DeploymentRollback = AppsV1beta1DeploymentRollback
{ appsV1beta1DeploymentRollbackApiVersion :: !(Maybe Text)
, appsV1beta1DeploymentRollbackKind :: !(Maybe Text)
, appsV1beta1DeploymentRollbackName :: !(Text)
, appsV1beta1DeploymentRollbackRollbackTo :: !(AppsV1beta1RollbackConfig)
, appsV1beta1DeploymentRollbackUpdatedAnnotations :: !(Maybe (Map.Map String Text))
} deriving (P.Show, P.Eq, P.Typeable)
instance A.FromJSON AppsV1beta1DeploymentRollback where
parseJSON = A.withObject "AppsV1beta1DeploymentRollback" $ \o ->
AppsV1beta1DeploymentRollback
<$> (o .:? "apiVersion")
<*> (o .:? "kind")
<*> (o .: "name")
<*> (o .: "rollbackTo")
<*> (o .:? "updatedAnnotations")
instance A.ToJSON AppsV1beta1DeploymentRollback where
toJSON AppsV1beta1DeploymentRollback {..} =
_omitNulls
[ "apiVersion" .= appsV1beta1DeploymentRollbackApiVersion
, "kind" .= appsV1beta1DeploymentRollbackKind
, "name" .= appsV1beta1DeploymentRollbackName
, "rollbackTo" .= appsV1beta1DeploymentRollbackRollbackTo
, "updatedAnnotations" .= appsV1beta1DeploymentRollbackUpdatedAnnotations
]
mkAppsV1beta1DeploymentRollback
:: Text
-> AppsV1beta1RollbackConfig
-> AppsV1beta1DeploymentRollback
mkAppsV1beta1DeploymentRollback appsV1beta1DeploymentRollbackName appsV1beta1DeploymentRollbackRollbackTo =
AppsV1beta1DeploymentRollback
{ appsV1beta1DeploymentRollbackApiVersion = Nothing
, appsV1beta1DeploymentRollbackKind = Nothing
, appsV1beta1DeploymentRollbackName
, appsV1beta1DeploymentRollbackRollbackTo
, appsV1beta1DeploymentRollbackUpdatedAnnotations = Nothing
}
data AppsV1beta1DeploymentSpec = AppsV1beta1DeploymentSpec
{ appsV1beta1DeploymentSpecMinReadySeconds :: !(Maybe Int)
, appsV1beta1DeploymentSpecPaused :: !(Maybe Bool)
, appsV1beta1DeploymentSpecProgressDeadlineSeconds :: !(Maybe Int)
, appsV1beta1DeploymentSpecReplicas :: !(Maybe Int)
, appsV1beta1DeploymentSpecRevisionHistoryLimit :: !(Maybe Int)
, appsV1beta1DeploymentSpecRollbackTo :: !(Maybe AppsV1beta1RollbackConfig)
, appsV1beta1DeploymentSpecSelector :: !(Maybe V1LabelSelector)
, appsV1beta1DeploymentSpecStrategy :: !(Maybe AppsV1beta1DeploymentStrategy)
, appsV1beta1DeploymentSpecTemplate :: !(V1PodTemplateSpec)
} deriving (P.Show, P.Eq, P.Typeable)
instance A.FromJSON AppsV1beta1DeploymentSpec where
parseJSON = A.withObject "AppsV1beta1DeploymentSpec" $ \o ->
AppsV1beta1DeploymentSpec
<$> (o .:? "minReadySeconds")
<*> (o .:? "paused")
<*> (o .:? "progressDeadlineSeconds")
<*> (o .:? "replicas")
<*> (o .:? "revisionHistoryLimit")
<*> (o .:? "rollbackTo")
<*> (o .:? "selector")
<*> (o .:? "strategy")
<*> (o .: "template")
instance A.ToJSON AppsV1beta1DeploymentSpec where
toJSON AppsV1beta1DeploymentSpec {..} =
_omitNulls
[ "minReadySeconds" .= appsV1beta1DeploymentSpecMinReadySeconds
, "paused" .= appsV1beta1DeploymentSpecPaused
, "progressDeadlineSeconds" .= appsV1beta1DeploymentSpecProgressDeadlineSeconds
, "replicas" .= appsV1beta1DeploymentSpecReplicas
, "revisionHistoryLimit" .= appsV1beta1DeploymentSpecRevisionHistoryLimit
, "rollbackTo" .= appsV1beta1DeploymentSpecRollbackTo
, "selector" .= appsV1beta1DeploymentSpecSelector
, "strategy" .= appsV1beta1DeploymentSpecStrategy
, "template" .= appsV1beta1DeploymentSpecTemplate
]
mkAppsV1beta1DeploymentSpec
:: V1PodTemplateSpec
-> AppsV1beta1DeploymentSpec
mkAppsV1beta1DeploymentSpec appsV1beta1DeploymentSpecTemplate =
AppsV1beta1DeploymentSpec
{ appsV1beta1DeploymentSpecMinReadySeconds = Nothing
, appsV1beta1DeploymentSpecPaused = Nothing
, appsV1beta1DeploymentSpecProgressDeadlineSeconds = Nothing
, appsV1beta1DeploymentSpecReplicas = Nothing
, appsV1beta1DeploymentSpecRevisionHistoryLimit = Nothing
, appsV1beta1DeploymentSpecRollbackTo = Nothing
, appsV1beta1DeploymentSpecSelector = Nothing
, appsV1beta1DeploymentSpecStrategy = Nothing
, appsV1beta1DeploymentSpecTemplate
}
data AppsV1beta1DeploymentStatus = AppsV1beta1DeploymentStatus
{ appsV1beta1DeploymentStatusAvailableReplicas :: !(Maybe Int)
, appsV1beta1DeploymentStatusCollisionCount :: !(Maybe Int)
, appsV1beta1DeploymentStatusConditions :: !(Maybe [AppsV1beta1DeploymentCondition])
, appsV1beta1DeploymentStatusObservedGeneration :: !(Maybe Integer)
, appsV1beta1DeploymentStatusReadyReplicas :: !(Maybe Int)
, appsV1beta1DeploymentStatusReplicas :: !(Maybe Int)
, appsV1beta1DeploymentStatusUnavailableReplicas :: !(Maybe Int)
, appsV1beta1DeploymentStatusUpdatedReplicas :: !(Maybe Int)
} deriving (P.Show, P.Eq, P.Typeable)
instance A.FromJSON AppsV1beta1DeploymentStatus where
parseJSON = A.withObject "AppsV1beta1DeploymentStatus" $ \o ->
AppsV1beta1DeploymentStatus
<$> (o .:? "availableReplicas")
<*> (o .:? "collisionCount")
<*> (o .:? "conditions")
<*> (o .:? "observedGeneration")
<*> (o .:? "readyReplicas")
<*> (o .:? "replicas")
<*> (o .:? "unavailableReplicas")
<*> (o .:? "updatedReplicas")
instance A.ToJSON AppsV1beta1DeploymentStatus where
toJSON AppsV1beta1DeploymentStatus {..} =
_omitNulls
[ "availableReplicas" .= appsV1beta1DeploymentStatusAvailableReplicas
, "collisionCount" .= appsV1beta1DeploymentStatusCollisionCount
, "conditions" .= appsV1beta1DeploymentStatusConditions
, "observedGeneration" .= appsV1beta1DeploymentStatusObservedGeneration
, "readyReplicas" .= appsV1beta1DeploymentStatusReadyReplicas
, "replicas" .= appsV1beta1DeploymentStatusReplicas
, "unavailableReplicas" .= appsV1beta1DeploymentStatusUnavailableReplicas
, "updatedReplicas" .= appsV1beta1DeploymentStatusUpdatedReplicas
]
mkAppsV1beta1DeploymentStatus
:: AppsV1beta1DeploymentStatus
mkAppsV1beta1DeploymentStatus =
AppsV1beta1DeploymentStatus
{ appsV1beta1DeploymentStatusAvailableReplicas = Nothing
, appsV1beta1DeploymentStatusCollisionCount = Nothing
, appsV1beta1DeploymentStatusConditions = Nothing
, appsV1beta1DeploymentStatusObservedGeneration = Nothing
, appsV1beta1DeploymentStatusReadyReplicas = Nothing
, appsV1beta1DeploymentStatusReplicas = Nothing
, appsV1beta1DeploymentStatusUnavailableReplicas = Nothing
, appsV1beta1DeploymentStatusUpdatedReplicas = Nothing
}
data AppsV1beta1DeploymentStrategy = AppsV1beta1DeploymentStrategy
{ appsV1beta1DeploymentStrategyRollingUpdate :: !(Maybe AppsV1beta1RollingUpdateDeployment)
, appsV1beta1DeploymentStrategyType :: !(Maybe Text)
} deriving (P.Show, P.Eq, P.Typeable)
instance A.FromJSON AppsV1beta1DeploymentStrategy where
parseJSON = A.withObject "AppsV1beta1DeploymentStrategy" $ \o ->
AppsV1beta1DeploymentStrategy
<$> (o .:? "rollingUpdate")
<*> (o .:? "type")
instance A.ToJSON AppsV1beta1DeploymentStrategy where
toJSON AppsV1beta1DeploymentStrategy {..} =
_omitNulls
[ "rollingUpdate" .= appsV1beta1DeploymentStrategyRollingUpdate
, "type" .= appsV1beta1DeploymentStrategyType
]
mkAppsV1beta1DeploymentStrategy
:: AppsV1beta1DeploymentStrategy
mkAppsV1beta1DeploymentStrategy =
AppsV1beta1DeploymentStrategy
{ appsV1beta1DeploymentStrategyRollingUpdate = Nothing
, appsV1beta1DeploymentStrategyType = Nothing
}
data AppsV1beta1RollbackConfig = AppsV1beta1RollbackConfig
{ appsV1beta1RollbackConfigRevision :: !(Maybe Integer)
} deriving (P.Show, P.Eq, P.Typeable)
instance A.FromJSON AppsV1beta1RollbackConfig where
parseJSON = A.withObject "AppsV1beta1RollbackConfig" $ \o ->
AppsV1beta1RollbackConfig
<$> (o .:? "revision")
instance A.ToJSON AppsV1beta1RollbackConfig where
toJSON AppsV1beta1RollbackConfig {..} =
_omitNulls
[ "revision" .= appsV1beta1RollbackConfigRevision
]
mkAppsV1beta1RollbackConfig
:: AppsV1beta1RollbackConfig
mkAppsV1beta1RollbackConfig =
AppsV1beta1RollbackConfig
{ appsV1beta1RollbackConfigRevision = Nothing
}
data AppsV1beta1RollingUpdateDeployment = AppsV1beta1RollingUpdateDeployment
{ appsV1beta1RollingUpdateDeploymentMaxSurge :: !(Maybe IntOrString)
, appsV1beta1RollingUpdateDeploymentMaxUnavailable :: !(Maybe IntOrString)
} deriving (P.Show, P.Eq, P.Typeable)
instance A.FromJSON AppsV1beta1RollingUpdateDeployment where
parseJSON = A.withObject "AppsV1beta1RollingUpdateDeployment" $ \o ->
AppsV1beta1RollingUpdateDeployment
<$> (o .:? "maxSurge")
<*> (o .:? "maxUnavailable")
instance A.ToJSON AppsV1beta1RollingUpdateDeployment where
toJSON AppsV1beta1RollingUpdateDeployment {..} =
_omitNulls
[ "maxSurge" .= appsV1beta1RollingUpdateDeploymentMaxSurge
, "maxUnavailable" .= appsV1beta1RollingUpdateDeploymentMaxUnavailable
]
mkAppsV1beta1RollingUpdateDeployment
:: AppsV1beta1RollingUpdateDeployment
mkAppsV1beta1RollingUpdateDeployment =
AppsV1beta1RollingUpdateDeployment
{ appsV1beta1RollingUpdateDeploymentMaxSurge = Nothing
, appsV1beta1RollingUpdateDeploymentMaxUnavailable = Nothing
}
data AppsV1beta1Scale = AppsV1beta1Scale
{ appsV1beta1ScaleApiVersion :: !(Maybe Text)
, appsV1beta1ScaleKind :: !(Maybe Text)
, appsV1beta1ScaleMetadata :: !(Maybe V1ObjectMeta)
, appsV1beta1ScaleSpec :: !(Maybe AppsV1beta1ScaleSpec)
, appsV1beta1ScaleStatus :: !(Maybe AppsV1beta1ScaleStatus)
} deriving (P.Show, P.Eq, P.Typeable)
instance A.FromJSON AppsV1beta1Scale where
parseJSON = A.withObject "AppsV1beta1Scale" $ \o ->
AppsV1beta1Scale
<$> (o .:? "apiVersion")
<*> (o .:? "kind")
<*> (o .:? "metadata")
<*> (o .:? "spec")
<*> (o .:? "status")
instance A.ToJSON AppsV1beta1Scale where
toJSON AppsV1beta1Scale {..} =
_omitNulls
[ "apiVersion" .= appsV1beta1ScaleApiVersion
, "kind" .= appsV1beta1ScaleKind
, "metadata" .= appsV1beta1ScaleMetadata
, "spec" .= appsV1beta1ScaleSpec
, "status" .= appsV1beta1ScaleStatus
]
mkAppsV1beta1Scale
:: AppsV1beta1Scale
mkAppsV1beta1Scale =
AppsV1beta1Scale
{ appsV1beta1ScaleApiVersion = Nothing
, appsV1beta1ScaleKind = Nothing
, appsV1beta1ScaleMetadata = Nothing
, appsV1beta1ScaleSpec = Nothing
, appsV1beta1ScaleStatus = Nothing
}
data AppsV1beta1ScaleSpec = AppsV1beta1ScaleSpec
{ appsV1beta1ScaleSpecReplicas :: !(Maybe Int)
} deriving (P.Show, P.Eq, P.Typeable)
instance A.FromJSON AppsV1beta1ScaleSpec where
parseJSON = A.withObject "AppsV1beta1ScaleSpec" $ \o ->
AppsV1beta1ScaleSpec
<$> (o .:? "replicas")
instance A.ToJSON AppsV1beta1ScaleSpec where
toJSON AppsV1beta1ScaleSpec {..} =
_omitNulls
[ "replicas" .= appsV1beta1ScaleSpecReplicas
]
mkAppsV1beta1ScaleSpec
:: AppsV1beta1ScaleSpec
mkAppsV1beta1ScaleSpec =
AppsV1beta1ScaleSpec
{ appsV1beta1ScaleSpecReplicas = Nothing
}
data AppsV1beta1ScaleStatus = AppsV1beta1ScaleStatus
{ appsV1beta1ScaleStatusReplicas :: !(Int)
, appsV1beta1ScaleStatusSelector :: !(Maybe (Map.Map String Text))
, appsV1beta1ScaleStatusTargetSelector :: !(Maybe Text)
} deriving (P.Show, P.Eq, P.Typeable)
instance A.FromJSON AppsV1beta1ScaleStatus where
parseJSON = A.withObject "AppsV1beta1ScaleStatus" $ \o ->
AppsV1beta1ScaleStatus
<$> (o .: "replicas")
<*> (o .:? "selector")
<*> (o .:? "targetSelector")
instance A.ToJSON AppsV1beta1ScaleStatus where
toJSON AppsV1beta1ScaleStatus {..} =
_omitNulls
[ "replicas" .= appsV1beta1ScaleStatusReplicas
, "selector" .= appsV1beta1ScaleStatusSelector
, "targetSelector" .= appsV1beta1ScaleStatusTargetSelector
]
mkAppsV1beta1ScaleStatus
:: Int
-> AppsV1beta1ScaleStatus
mkAppsV1beta1ScaleStatus appsV1beta1ScaleStatusReplicas =
AppsV1beta1ScaleStatus
{ appsV1beta1ScaleStatusReplicas
, appsV1beta1ScaleStatusSelector = Nothing
, appsV1beta1ScaleStatusTargetSelector = Nothing
}
data ExtensionsV1beta1AllowedCSIDriver = ExtensionsV1beta1AllowedCSIDriver
{ extensionsV1beta1AllowedCSIDriverName :: !(Text)
} deriving (P.Show, P.Eq, P.Typeable)
instance A.FromJSON ExtensionsV1beta1AllowedCSIDriver where
parseJSON = A.withObject "ExtensionsV1beta1AllowedCSIDriver" $ \o ->
ExtensionsV1beta1AllowedCSIDriver
<$> (o .: "name")
instance A.ToJSON ExtensionsV1beta1AllowedCSIDriver where
toJSON ExtensionsV1beta1AllowedCSIDriver {..} =
_omitNulls
[ "name" .= extensionsV1beta1AllowedCSIDriverName
]
mkExtensionsV1beta1AllowedCSIDriver
:: Text
-> ExtensionsV1beta1AllowedCSIDriver
mkExtensionsV1beta1AllowedCSIDriver extensionsV1beta1AllowedCSIDriverName =
ExtensionsV1beta1AllowedCSIDriver
{ extensionsV1beta1AllowedCSIDriverName
}
data ExtensionsV1beta1AllowedFlexVolume = ExtensionsV1beta1AllowedFlexVolume
{ extensionsV1beta1AllowedFlexVolumeDriver :: !(Text)
} deriving (P.Show, P.Eq, P.Typeable)
instance A.FromJSON ExtensionsV1beta1AllowedFlexVolume where
parseJSON = A.withObject "ExtensionsV1beta1AllowedFlexVolume" $ \o ->
ExtensionsV1beta1AllowedFlexVolume
<$> (o .: "driver")
instance A.ToJSON ExtensionsV1beta1AllowedFlexVolume where
toJSON ExtensionsV1beta1AllowedFlexVolume {..} =
_omitNulls
[ "driver" .= extensionsV1beta1AllowedFlexVolumeDriver
]
mkExtensionsV1beta1AllowedFlexVolume
:: Text
-> ExtensionsV1beta1AllowedFlexVolume
mkExtensionsV1beta1AllowedFlexVolume extensionsV1beta1AllowedFlexVolumeDriver =
ExtensionsV1beta1AllowedFlexVolume
{ extensionsV1beta1AllowedFlexVolumeDriver
}
data ExtensionsV1beta1AllowedHostPath = ExtensionsV1beta1AllowedHostPath
{ extensionsV1beta1AllowedHostPathPathPrefix :: !(Maybe Text)
, extensionsV1beta1AllowedHostPathReadOnly :: !(Maybe Bool)
} deriving (P.Show, P.Eq, P.Typeable)
instance A.FromJSON ExtensionsV1beta1AllowedHostPath where
parseJSON = A.withObject "ExtensionsV1beta1AllowedHostPath" $ \o ->
ExtensionsV1beta1AllowedHostPath
<$> (o .:? "pathPrefix")
<*> (o .:? "readOnly")
instance A.ToJSON ExtensionsV1beta1AllowedHostPath where
toJSON ExtensionsV1beta1AllowedHostPath {..} =
_omitNulls
[ "pathPrefix" .= extensionsV1beta1AllowedHostPathPathPrefix
, "readOnly" .= extensionsV1beta1AllowedHostPathReadOnly
]
mkExtensionsV1beta1AllowedHostPath
:: ExtensionsV1beta1AllowedHostPath
mkExtensionsV1beta1AllowedHostPath =
ExtensionsV1beta1AllowedHostPath
{ extensionsV1beta1AllowedHostPathPathPrefix = Nothing
, extensionsV1beta1AllowedHostPathReadOnly = Nothing
}
data ExtensionsV1beta1Deployment = ExtensionsV1beta1Deployment
{ extensionsV1beta1DeploymentApiVersion :: !(Maybe Text)
, extensionsV1beta1DeploymentKind :: !(Maybe Text)
, extensionsV1beta1DeploymentMetadata :: !(Maybe V1ObjectMeta)
, extensionsV1beta1DeploymentSpec :: !(Maybe ExtensionsV1beta1DeploymentSpec)
, extensionsV1beta1DeploymentStatus :: !(Maybe ExtensionsV1beta1DeploymentStatus)
} deriving (P.Show, P.Eq, P.Typeable)
instance A.FromJSON ExtensionsV1beta1Deployment where
parseJSON = A.withObject "ExtensionsV1beta1Deployment" $ \o ->
ExtensionsV1beta1Deployment
<$> (o .:? "apiVersion")
<*> (o .:? "kind")
<*> (o .:? "metadata")
<*> (o .:? "spec")
<*> (o .:? "status")
instance A.ToJSON ExtensionsV1beta1Deployment where
toJSON ExtensionsV1beta1Deployment {..} =
_omitNulls
[ "apiVersion" .= extensionsV1beta1DeploymentApiVersion
, "kind" .= extensionsV1beta1DeploymentKind
, "metadata" .= extensionsV1beta1DeploymentMetadata
, "spec" .= extensionsV1beta1DeploymentSpec
, "status" .= extensionsV1beta1DeploymentStatus
]
mkExtensionsV1beta1Deployment
:: ExtensionsV1beta1Deployment
mkExtensionsV1beta1Deployment =
ExtensionsV1beta1Deployment
{ extensionsV1beta1DeploymentApiVersion = Nothing
, extensionsV1beta1DeploymentKind = Nothing
, extensionsV1beta1DeploymentMetadata = Nothing
, extensionsV1beta1DeploymentSpec = Nothing
, extensionsV1beta1DeploymentStatus = Nothing
}
data ExtensionsV1beta1DeploymentCondition = ExtensionsV1beta1DeploymentCondition
{ extensionsV1beta1DeploymentConditionLastTransitionTime :: !(Maybe DateTime)
, extensionsV1beta1DeploymentConditionLastUpdateTime :: !(Maybe DateTime)
, extensionsV1beta1DeploymentConditionMessage :: !(Maybe Text)
, extensionsV1beta1DeploymentConditionReason :: !(Maybe Text)
, extensionsV1beta1DeploymentConditionStatus :: !(Text)
, extensionsV1beta1DeploymentConditionType :: !(Text)
} deriving (P.Show, P.Eq, P.Typeable)
instance A.FromJSON ExtensionsV1beta1DeploymentCondition where
parseJSON = A.withObject "ExtensionsV1beta1DeploymentCondition" $ \o ->
ExtensionsV1beta1DeploymentCondition
<$> (o .:? "lastTransitionTime")
<*> (o .:? "lastUpdateTime")
<*> (o .:? "message")
<*> (o .:? "reason")
<*> (o .: "status")
<*> (o .: "type")
instance A.ToJSON ExtensionsV1beta1DeploymentCondition where
toJSON ExtensionsV1beta1DeploymentCondition {..} =
_omitNulls
[ "lastTransitionTime" .= extensionsV1beta1DeploymentConditionLastTransitionTime
, "lastUpdateTime" .= extensionsV1beta1DeploymentConditionLastUpdateTime
, "message" .= extensionsV1beta1DeploymentConditionMessage
, "reason" .= extensionsV1beta1DeploymentConditionReason
, "status" .= extensionsV1beta1DeploymentConditionStatus
, "type" .= extensionsV1beta1DeploymentConditionType
]
mkExtensionsV1beta1DeploymentCondition
:: Text
-> Text
-> ExtensionsV1beta1DeploymentCondition
mkExtensionsV1beta1DeploymentCondition extensionsV1beta1DeploymentConditionStatus extensionsV1beta1DeploymentConditionType =
ExtensionsV1beta1DeploymentCondition
{ extensionsV1beta1DeploymentConditionLastTransitionTime = Nothing
, extensionsV1beta1DeploymentConditionLastUpdateTime = Nothing
, extensionsV1beta1DeploymentConditionMessage = Nothing
, extensionsV1beta1DeploymentConditionReason = Nothing
, extensionsV1beta1DeploymentConditionStatus
, extensionsV1beta1DeploymentConditionType
}
data ExtensionsV1beta1DeploymentList = ExtensionsV1beta1DeploymentList
{ extensionsV1beta1DeploymentListApiVersion :: !(Maybe Text)
, extensionsV1beta1DeploymentListItems :: !([ExtensionsV1beta1Deployment])
, extensionsV1beta1DeploymentListKind :: !(Maybe Text)
, extensionsV1beta1DeploymentListMetadata :: !(Maybe V1ListMeta)
} deriving (P.Show, P.Eq, P.Typeable)
instance A.FromJSON ExtensionsV1beta1DeploymentList where
parseJSON = A.withObject "ExtensionsV1beta1DeploymentList" $ \o ->
ExtensionsV1beta1DeploymentList
<$> (o .:? "apiVersion")
<*> (o .: "items")
<*> (o .:? "kind")
<*> (o .:? "metadata")
instance A.ToJSON ExtensionsV1beta1DeploymentList where
toJSON ExtensionsV1beta1DeploymentList {..} =
_omitNulls
[ "apiVersion" .= extensionsV1beta1DeploymentListApiVersion
, "items" .= extensionsV1beta1DeploymentListItems
, "kind" .= extensionsV1beta1DeploymentListKind
, "metadata" .= extensionsV1beta1DeploymentListMetadata
]
mkExtensionsV1beta1DeploymentList
:: [ExtensionsV1beta1Deployment]
-> ExtensionsV1beta1DeploymentList
mkExtensionsV1beta1DeploymentList extensionsV1beta1DeploymentListItems =
ExtensionsV1beta1DeploymentList
{ extensionsV1beta1DeploymentListApiVersion = Nothing
, extensionsV1beta1DeploymentListItems
, extensionsV1beta1DeploymentListKind = Nothing
, extensionsV1beta1DeploymentListMetadata = Nothing
}
data ExtensionsV1beta1DeploymentRollback = ExtensionsV1beta1DeploymentRollback
{ extensionsV1beta1DeploymentRollbackApiVersion :: !(Maybe Text)
, extensionsV1beta1DeploymentRollbackKind :: !(Maybe Text)
, extensionsV1beta1DeploymentRollbackName :: !(Text)
, extensionsV1beta1DeploymentRollbackRollbackTo :: !(ExtensionsV1beta1RollbackConfig)
, extensionsV1beta1DeploymentRollbackUpdatedAnnotations :: !(Maybe (Map.Map String Text))
} deriving (P.Show, P.Eq, P.Typeable)
instance A.FromJSON ExtensionsV1beta1DeploymentRollback where
parseJSON = A.withObject "ExtensionsV1beta1DeploymentRollback" $ \o ->
ExtensionsV1beta1DeploymentRollback
<$> (o .:? "apiVersion")
<*> (o .:? "kind")
<*> (o .: "name")
<*> (o .: "rollbackTo")
<*> (o .:? "updatedAnnotations")
instance A.ToJSON ExtensionsV1beta1DeploymentRollback where
toJSON ExtensionsV1beta1DeploymentRollback {..} =
_omitNulls
[ "apiVersion" .= extensionsV1beta1DeploymentRollbackApiVersion
, "kind" .= extensionsV1beta1DeploymentRollbackKind
, "name" .= extensionsV1beta1DeploymentRollbackName
, "rollbackTo" .= extensionsV1beta1DeploymentRollbackRollbackTo
, "updatedAnnotations" .= extensionsV1beta1DeploymentRollbackUpdatedAnnotations
]
mkExtensionsV1beta1DeploymentRollback
:: Text
-> ExtensionsV1beta1RollbackConfig
-> ExtensionsV1beta1DeploymentRollback
mkExtensionsV1beta1DeploymentRollback extensionsV1beta1DeploymentRollbackName extensionsV1beta1DeploymentRollbackRollbackTo =
ExtensionsV1beta1DeploymentRollback
{ extensionsV1beta1DeploymentRollbackApiVersion = Nothing
, extensionsV1beta1DeploymentRollbackKind = Nothing
, extensionsV1beta1DeploymentRollbackName
, extensionsV1beta1DeploymentRollbackRollbackTo
, extensionsV1beta1DeploymentRollbackUpdatedAnnotations = Nothing
}
data ExtensionsV1beta1DeploymentSpec = ExtensionsV1beta1DeploymentSpec
{ extensionsV1beta1DeploymentSpecMinReadySeconds :: !(Maybe Int)
, extensionsV1beta1DeploymentSpecPaused :: !(Maybe Bool)
, extensionsV1beta1DeploymentSpecProgressDeadlineSeconds :: !(Maybe Int)
, extensionsV1beta1DeploymentSpecReplicas :: !(Maybe Int)
, extensionsV1beta1DeploymentSpecRevisionHistoryLimit :: !(Maybe Int)
, extensionsV1beta1DeploymentSpecRollbackTo :: !(Maybe ExtensionsV1beta1RollbackConfig)
, extensionsV1beta1DeploymentSpecSelector :: !(Maybe V1LabelSelector)
, extensionsV1beta1DeploymentSpecStrategy :: !(Maybe ExtensionsV1beta1DeploymentStrategy)
, extensionsV1beta1DeploymentSpecTemplate :: !(V1PodTemplateSpec)
} deriving (P.Show, P.Eq, P.Typeable)
instance A.FromJSON ExtensionsV1beta1DeploymentSpec where
parseJSON = A.withObject "ExtensionsV1beta1DeploymentSpec" $ \o ->
ExtensionsV1beta1DeploymentSpec
<$> (o .:? "minReadySeconds")
<*> (o .:? "paused")
<*> (o .:? "progressDeadlineSeconds")
<*> (o .:? "replicas")
<*> (o .:? "revisionHistoryLimit")
<*> (o .:? "rollbackTo")
<*> (o .:? "selector")
<*> (o .:? "strategy")
<*> (o .: "template")
instance A.ToJSON ExtensionsV1beta1DeploymentSpec where
toJSON ExtensionsV1beta1DeploymentSpec {..} =
_omitNulls
[ "minReadySeconds" .= extensionsV1beta1DeploymentSpecMinReadySeconds
, "paused" .= extensionsV1beta1DeploymentSpecPaused
, "progressDeadlineSeconds" .= extensionsV1beta1DeploymentSpecProgressDeadlineSeconds
, "replicas" .= extensionsV1beta1DeploymentSpecReplicas
, "revisionHistoryLimit" .= extensionsV1beta1DeploymentSpecRevisionHistoryLimit
, "rollbackTo" .= extensionsV1beta1DeploymentSpecRollbackTo
, "selector" .= extensionsV1beta1DeploymentSpecSelector
, "strategy" .= extensionsV1beta1DeploymentSpecStrategy
, "template" .= extensionsV1beta1DeploymentSpecTemplate
]
mkExtensionsV1beta1DeploymentSpec
:: V1PodTemplateSpec
-> ExtensionsV1beta1DeploymentSpec
mkExtensionsV1beta1DeploymentSpec extensionsV1beta1DeploymentSpecTemplate =
ExtensionsV1beta1DeploymentSpec
{ extensionsV1beta1DeploymentSpecMinReadySeconds = Nothing
, extensionsV1beta1DeploymentSpecPaused = Nothing
, extensionsV1beta1DeploymentSpecProgressDeadlineSeconds = Nothing
, extensionsV1beta1DeploymentSpecReplicas = Nothing
, extensionsV1beta1DeploymentSpecRevisionHistoryLimit = Nothing
, extensionsV1beta1DeploymentSpecRollbackTo = Nothing
, extensionsV1beta1DeploymentSpecSelector = Nothing
, extensionsV1beta1DeploymentSpecStrategy = Nothing
, extensionsV1beta1DeploymentSpecTemplate
}
data ExtensionsV1beta1DeploymentStatus = ExtensionsV1beta1DeploymentStatus
{ extensionsV1beta1DeploymentStatusAvailableReplicas :: !(Maybe Int)
, extensionsV1beta1DeploymentStatusCollisionCount :: !(Maybe Int)
, extensionsV1beta1DeploymentStatusConditions :: !(Maybe [ExtensionsV1beta1DeploymentCondition])
, extensionsV1beta1DeploymentStatusObservedGeneration :: !(Maybe Integer)
, extensionsV1beta1DeploymentStatusReadyReplicas :: !(Maybe Int)
, extensionsV1beta1DeploymentStatusReplicas :: !(Maybe Int)
, extensionsV1beta1DeploymentStatusUnavailableReplicas :: !(Maybe Int)
, extensionsV1beta1DeploymentStatusUpdatedReplicas :: !(Maybe Int)
} deriving (P.Show, P.Eq, P.Typeable)
instance A.FromJSON ExtensionsV1beta1DeploymentStatus where
parseJSON = A.withObject "ExtensionsV1beta1DeploymentStatus" $ \o ->
ExtensionsV1beta1DeploymentStatus
<$> (o .:? "availableReplicas")
<*> (o .:? "collisionCount")
<*> (o .:? "conditions")
<*> (o .:? "observedGeneration")
<*> (o .:? "readyReplicas")
<*> (o .:? "replicas")
<*> (o .:? "unavailableReplicas")
<*> (o .:? "updatedReplicas")
instance A.ToJSON ExtensionsV1beta1DeploymentStatus where
toJSON ExtensionsV1beta1DeploymentStatus {..} =
_omitNulls
[ "availableReplicas" .= extensionsV1beta1DeploymentStatusAvailableReplicas
, "collisionCount" .= extensionsV1beta1DeploymentStatusCollisionCount
, "conditions" .= extensionsV1beta1DeploymentStatusConditions
, "observedGeneration" .= extensionsV1beta1DeploymentStatusObservedGeneration
, "readyReplicas" .= extensionsV1beta1DeploymentStatusReadyReplicas
, "replicas" .= extensionsV1beta1DeploymentStatusReplicas
, "unavailableReplicas" .= extensionsV1beta1DeploymentStatusUnavailableReplicas
, "updatedReplicas" .= extensionsV1beta1DeploymentStatusUpdatedReplicas
]
mkExtensionsV1beta1DeploymentStatus
:: ExtensionsV1beta1DeploymentStatus
mkExtensionsV1beta1DeploymentStatus =
ExtensionsV1beta1DeploymentStatus
{ extensionsV1beta1DeploymentStatusAvailableReplicas = Nothing
, extensionsV1beta1DeploymentStatusCollisionCount = Nothing
, extensionsV1beta1DeploymentStatusConditions = Nothing
, extensionsV1beta1DeploymentStatusObservedGeneration = Nothing
, extensionsV1beta1DeploymentStatusReadyReplicas = Nothing
, extensionsV1beta1DeploymentStatusReplicas = Nothing
, extensionsV1beta1DeploymentStatusUnavailableReplicas = Nothing
, extensionsV1beta1DeploymentStatusUpdatedReplicas = Nothing
}
data ExtensionsV1beta1DeploymentStrategy = ExtensionsV1beta1DeploymentStrategy
{ extensionsV1beta1DeploymentStrategyRollingUpdate :: !(Maybe ExtensionsV1beta1RollingUpdateDeployment)
, extensionsV1beta1DeploymentStrategyType :: !(Maybe Text)
} deriving (P.Show, P.Eq, P.Typeable)
instance A.FromJSON ExtensionsV1beta1DeploymentStrategy where
parseJSON = A.withObject "ExtensionsV1beta1DeploymentStrategy" $ \o ->
ExtensionsV1beta1DeploymentStrategy
<$> (o .:? "rollingUpdate")
<*> (o .:? "type")
instance A.ToJSON ExtensionsV1beta1DeploymentStrategy where
toJSON ExtensionsV1beta1DeploymentStrategy {..} =
_omitNulls
[ "rollingUpdate" .= extensionsV1beta1DeploymentStrategyRollingUpdate
, "type" .= extensionsV1beta1DeploymentStrategyType
]
mkExtensionsV1beta1DeploymentStrategy
:: ExtensionsV1beta1DeploymentStrategy
mkExtensionsV1beta1DeploymentStrategy =
ExtensionsV1beta1DeploymentStrategy
{ extensionsV1beta1DeploymentStrategyRollingUpdate = Nothing
, extensionsV1beta1DeploymentStrategyType = Nothing
}
data ExtensionsV1beta1FSGroupStrategyOptions = ExtensionsV1beta1FSGroupStrategyOptions
{ extensionsV1beta1FSGroupStrategyOptionsRanges :: !(Maybe [ExtensionsV1beta1IDRange])
, extensionsV1beta1FSGroupStrategyOptionsRule :: !(Maybe Text)
} deriving (P.Show, P.Eq, P.Typeable)
instance A.FromJSON ExtensionsV1beta1FSGroupStrategyOptions where
parseJSON = A.withObject "ExtensionsV1beta1FSGroupStrategyOptions" $ \o ->
ExtensionsV1beta1FSGroupStrategyOptions
<$> (o .:? "ranges")
<*> (o .:? "rule")
instance A.ToJSON ExtensionsV1beta1FSGroupStrategyOptions where
toJSON ExtensionsV1beta1FSGroupStrategyOptions {..} =
_omitNulls
[ "ranges" .= extensionsV1beta1FSGroupStrategyOptionsRanges
, "rule" .= extensionsV1beta1FSGroupStrategyOptionsRule
]
mkExtensionsV1beta1FSGroupStrategyOptions
:: ExtensionsV1beta1FSGroupStrategyOptions
mkExtensionsV1beta1FSGroupStrategyOptions =
ExtensionsV1beta1FSGroupStrategyOptions
{ extensionsV1beta1FSGroupStrategyOptionsRanges = Nothing
, extensionsV1beta1FSGroupStrategyOptionsRule = Nothing
}
data ExtensionsV1beta1HTTPIngressPath = ExtensionsV1beta1HTTPIngressPath
{ extensionsV1beta1HTTPIngressPathBackend :: !(ExtensionsV1beta1IngressBackend)
, extensionsV1beta1HTTPIngressPathPath :: !(Maybe Text)
} deriving (P.Show, P.Eq, P.Typeable)
instance A.FromJSON ExtensionsV1beta1HTTPIngressPath where
parseJSON = A.withObject "ExtensionsV1beta1HTTPIngressPath" $ \o ->
ExtensionsV1beta1HTTPIngressPath
<$> (o .: "backend")
<*> (o .:? "path")
instance A.ToJSON ExtensionsV1beta1HTTPIngressPath where
toJSON ExtensionsV1beta1HTTPIngressPath {..} =
_omitNulls
[ "backend" .= extensionsV1beta1HTTPIngressPathBackend
, "path" .= extensionsV1beta1HTTPIngressPathPath
]
mkExtensionsV1beta1HTTPIngressPath
:: ExtensionsV1beta1IngressBackend
-> ExtensionsV1beta1HTTPIngressPath
mkExtensionsV1beta1HTTPIngressPath extensionsV1beta1HTTPIngressPathBackend =
ExtensionsV1beta1HTTPIngressPath
{ extensionsV1beta1HTTPIngressPathBackend
, extensionsV1beta1HTTPIngressPathPath = Nothing
}
data ExtensionsV1beta1HTTPIngressRuleValue = ExtensionsV1beta1HTTPIngressRuleValue
{ extensionsV1beta1HTTPIngressRuleValuePaths :: !([ExtensionsV1beta1HTTPIngressPath])
} deriving (P.Show, P.Eq, P.Typeable)
instance A.FromJSON ExtensionsV1beta1HTTPIngressRuleValue where
parseJSON = A.withObject "ExtensionsV1beta1HTTPIngressRuleValue" $ \o ->
ExtensionsV1beta1HTTPIngressRuleValue
<$> (o .: "paths")
instance A.ToJSON ExtensionsV1beta1HTTPIngressRuleValue where
toJSON ExtensionsV1beta1HTTPIngressRuleValue {..} =
_omitNulls
[ "paths" .= extensionsV1beta1HTTPIngressRuleValuePaths
]
mkExtensionsV1beta1HTTPIngressRuleValue
:: [ExtensionsV1beta1HTTPIngressPath]
-> ExtensionsV1beta1HTTPIngressRuleValue
mkExtensionsV1beta1HTTPIngressRuleValue extensionsV1beta1HTTPIngressRuleValuePaths =
ExtensionsV1beta1HTTPIngressRuleValue
{ extensionsV1beta1HTTPIngressRuleValuePaths
}
data ExtensionsV1beta1HostPortRange = ExtensionsV1beta1HostPortRange
{ extensionsV1beta1HostPortRangeMax :: !(Int)
, extensionsV1beta1HostPortRangeMin :: !(Int)
} deriving (P.Show, P.Eq, P.Typeable)
instance A.FromJSON ExtensionsV1beta1HostPortRange where
parseJSON = A.withObject "ExtensionsV1beta1HostPortRange" $ \o ->
ExtensionsV1beta1HostPortRange
<$> (o .: "max")
<*> (o .: "min")
instance A.ToJSON ExtensionsV1beta1HostPortRange where
toJSON ExtensionsV1beta1HostPortRange {..} =
_omitNulls
[ "max" .= extensionsV1beta1HostPortRangeMax
, "min" .= extensionsV1beta1HostPortRangeMin
]
mkExtensionsV1beta1HostPortRange
:: Int
-> Int
-> ExtensionsV1beta1HostPortRange
mkExtensionsV1beta1HostPortRange extensionsV1beta1HostPortRangeMax extensionsV1beta1HostPortRangeMin =
ExtensionsV1beta1HostPortRange
{ extensionsV1beta1HostPortRangeMax
, extensionsV1beta1HostPortRangeMin
}
data ExtensionsV1beta1IDRange = ExtensionsV1beta1IDRange
{ extensionsV1beta1IDRangeMax :: !(Integer)
, extensionsV1beta1IDRangeMin :: !(Integer)
} deriving (P.Show, P.Eq, P.Typeable)
instance A.FromJSON ExtensionsV1beta1IDRange where
parseJSON = A.withObject "ExtensionsV1beta1IDRange" $ \o ->
ExtensionsV1beta1IDRange
<$> (o .: "max")
<*> (o .: "min")
instance A.ToJSON ExtensionsV1beta1IDRange where
toJSON ExtensionsV1beta1IDRange {..} =
_omitNulls
[ "max" .= extensionsV1beta1IDRangeMax
, "min" .= extensionsV1beta1IDRangeMin
]
mkExtensionsV1beta1IDRange
:: Integer
-> Integer
-> ExtensionsV1beta1IDRange
mkExtensionsV1beta1IDRange extensionsV1beta1IDRangeMax extensionsV1beta1IDRangeMin =
ExtensionsV1beta1IDRange
{ extensionsV1beta1IDRangeMax
, extensionsV1beta1IDRangeMin
}
data ExtensionsV1beta1Ingress = ExtensionsV1beta1Ingress
{ extensionsV1beta1IngressApiVersion :: !(Maybe Text)
, extensionsV1beta1IngressKind :: !(Maybe Text)
, extensionsV1beta1IngressMetadata :: !(Maybe V1ObjectMeta)
, extensionsV1beta1IngressSpec :: !(Maybe ExtensionsV1beta1IngressSpec)
, extensionsV1beta1IngressStatus :: !(Maybe ExtensionsV1beta1IngressStatus)
} deriving (P.Show, P.Eq, P.Typeable)
instance A.FromJSON ExtensionsV1beta1Ingress where
parseJSON = A.withObject "ExtensionsV1beta1Ingress" $ \o ->
ExtensionsV1beta1Ingress
<$> (o .:? "apiVersion")
<*> (o .:? "kind")
<*> (o .:? "metadata")
<*> (o .:? "spec")
<*> (o .:? "status")
instance A.ToJSON ExtensionsV1beta1Ingress where
toJSON ExtensionsV1beta1Ingress {..} =
_omitNulls
[ "apiVersion" .= extensionsV1beta1IngressApiVersion
, "kind" .= extensionsV1beta1IngressKind
, "metadata" .= extensionsV1beta1IngressMetadata
, "spec" .= extensionsV1beta1IngressSpec
, "status" .= extensionsV1beta1IngressStatus
]
mkExtensionsV1beta1Ingress
:: ExtensionsV1beta1Ingress
mkExtensionsV1beta1Ingress =
ExtensionsV1beta1Ingress
{ extensionsV1beta1IngressApiVersion = Nothing
, extensionsV1beta1IngressKind = Nothing
, extensionsV1beta1IngressMetadata = Nothing
, extensionsV1beta1IngressSpec = Nothing
, extensionsV1beta1IngressStatus = Nothing
}
data ExtensionsV1beta1IngressBackend = ExtensionsV1beta1IngressBackend
{ extensionsV1beta1IngressBackendServiceName :: !(Text)
, extensionsV1beta1IngressBackendServicePort :: !(IntOrString)
} deriving (P.Show, P.Eq, P.Typeable)
instance A.FromJSON ExtensionsV1beta1IngressBackend where
parseJSON = A.withObject "ExtensionsV1beta1IngressBackend" $ \o ->
ExtensionsV1beta1IngressBackend
<$> (o .: "serviceName")
<*> (o .: "servicePort")
instance A.ToJSON ExtensionsV1beta1IngressBackend where
toJSON ExtensionsV1beta1IngressBackend {..} =
_omitNulls
[ "serviceName" .= extensionsV1beta1IngressBackendServiceName
, "servicePort" .= extensionsV1beta1IngressBackendServicePort
]
mkExtensionsV1beta1IngressBackend
:: Text
-> IntOrString
-> ExtensionsV1beta1IngressBackend
mkExtensionsV1beta1IngressBackend extensionsV1beta1IngressBackendServiceName extensionsV1beta1IngressBackendServicePort =
ExtensionsV1beta1IngressBackend
{ extensionsV1beta1IngressBackendServiceName
, extensionsV1beta1IngressBackendServicePort
}
data ExtensionsV1beta1IngressList = ExtensionsV1beta1IngressList
{ extensionsV1beta1IngressListApiVersion :: !(Maybe Text)
, extensionsV1beta1IngressListItems :: !([ExtensionsV1beta1Ingress])
, extensionsV1beta1IngressListKind :: !(Maybe Text)
, extensionsV1beta1IngressListMetadata :: !(Maybe V1ListMeta)
} deriving (P.Show, P.Eq, P.Typeable)
instance A.FromJSON ExtensionsV1beta1IngressList where
parseJSON = A.withObject "ExtensionsV1beta1IngressList" $ \o ->
ExtensionsV1beta1IngressList
<$> (o .:? "apiVersion")
<*> (o .: "items")
<*> (o .:? "kind")
<*> (o .:? "metadata")
instance A.ToJSON ExtensionsV1beta1IngressList where
toJSON ExtensionsV1beta1IngressList {..} =
_omitNulls
[ "apiVersion" .= extensionsV1beta1IngressListApiVersion
, "items" .= extensionsV1beta1IngressListItems
, "kind" .= extensionsV1beta1IngressListKind
, "metadata" .= extensionsV1beta1IngressListMetadata
]
mkExtensionsV1beta1IngressList
:: [ExtensionsV1beta1Ingress]
-> ExtensionsV1beta1IngressList
mkExtensionsV1beta1IngressList extensionsV1beta1IngressListItems =
ExtensionsV1beta1IngressList
{ extensionsV1beta1IngressListApiVersion = Nothing
, extensionsV1beta1IngressListItems
, extensionsV1beta1IngressListKind = Nothing
, extensionsV1beta1IngressListMetadata = Nothing
}
data ExtensionsV1beta1IngressRule = ExtensionsV1beta1IngressRule
{ extensionsV1beta1IngressRuleHost :: !(Maybe Text)
, extensionsV1beta1IngressRuleHttp :: !(Maybe ExtensionsV1beta1HTTPIngressRuleValue)
} deriving (P.Show, P.Eq, P.Typeable)
instance A.FromJSON ExtensionsV1beta1IngressRule where
parseJSON = A.withObject "ExtensionsV1beta1IngressRule" $ \o ->
ExtensionsV1beta1IngressRule
<$> (o .:? "host")
<*> (o .:? "http")
instance A.ToJSON ExtensionsV1beta1IngressRule where
toJSON ExtensionsV1beta1IngressRule {..} =
_omitNulls
[ "host" .= extensionsV1beta1IngressRuleHost
, "http" .= extensionsV1beta1IngressRuleHttp
]
mkExtensionsV1beta1IngressRule
:: ExtensionsV1beta1IngressRule
mkExtensionsV1beta1IngressRule =
ExtensionsV1beta1IngressRule
{ extensionsV1beta1IngressRuleHost = Nothing
, extensionsV1beta1IngressRuleHttp = Nothing
}
data ExtensionsV1beta1IngressSpec = ExtensionsV1beta1IngressSpec
{ extensionsV1beta1IngressSpecBackend :: !(Maybe ExtensionsV1beta1IngressBackend)
, extensionsV1beta1IngressSpecRules :: !(Maybe [ExtensionsV1beta1IngressRule])
, extensionsV1beta1IngressSpecTls :: !(Maybe [ExtensionsV1beta1IngressTLS])
} deriving (P.Show, P.Eq, P.Typeable)
instance A.FromJSON ExtensionsV1beta1IngressSpec where
parseJSON = A.withObject "ExtensionsV1beta1IngressSpec" $ \o ->
ExtensionsV1beta1IngressSpec
<$> (o .:? "backend")
<*> (o .:? "rules")
<*> (o .:? "tls")
instance A.ToJSON ExtensionsV1beta1IngressSpec where
toJSON ExtensionsV1beta1IngressSpec {..} =
_omitNulls
[ "backend" .= extensionsV1beta1IngressSpecBackend
, "rules" .= extensionsV1beta1IngressSpecRules
, "tls" .= extensionsV1beta1IngressSpecTls
]
mkExtensionsV1beta1IngressSpec
:: ExtensionsV1beta1IngressSpec
mkExtensionsV1beta1IngressSpec =
ExtensionsV1beta1IngressSpec
{ extensionsV1beta1IngressSpecBackend = Nothing
, extensionsV1beta1IngressSpecRules = Nothing
, extensionsV1beta1IngressSpecTls = Nothing
}
data ExtensionsV1beta1IngressStatus = ExtensionsV1beta1IngressStatus
{ extensionsV1beta1IngressStatusLoadBalancer :: !(Maybe V1LoadBalancerStatus)
} deriving (P.Show, P.Eq, P.Typeable)
instance A.FromJSON ExtensionsV1beta1IngressStatus where
parseJSON = A.withObject "ExtensionsV1beta1IngressStatus" $ \o ->
ExtensionsV1beta1IngressStatus
<$> (o .:? "loadBalancer")
instance A.ToJSON ExtensionsV1beta1IngressStatus where
toJSON ExtensionsV1beta1IngressStatus {..} =
_omitNulls
[ "loadBalancer" .= extensionsV1beta1IngressStatusLoadBalancer
]
mkExtensionsV1beta1IngressStatus
:: ExtensionsV1beta1IngressStatus
mkExtensionsV1beta1IngressStatus =
ExtensionsV1beta1IngressStatus
{ extensionsV1beta1IngressStatusLoadBalancer = Nothing
}
data ExtensionsV1beta1IngressTLS = ExtensionsV1beta1IngressTLS
{ extensionsV1beta1IngressTLSHosts :: !(Maybe [Text])
, extensionsV1beta1IngressTLSSecretName :: !(Maybe Text)
} deriving (P.Show, P.Eq, P.Typeable)
instance A.FromJSON ExtensionsV1beta1IngressTLS where
parseJSON = A.withObject "ExtensionsV1beta1IngressTLS" $ \o ->
ExtensionsV1beta1IngressTLS
<$> (o .:? "hosts")
<*> (o .:? "secretName")
instance A.ToJSON ExtensionsV1beta1IngressTLS where
toJSON ExtensionsV1beta1IngressTLS {..} =
_omitNulls
[ "hosts" .= extensionsV1beta1IngressTLSHosts
, "secretName" .= extensionsV1beta1IngressTLSSecretName
]
mkExtensionsV1beta1IngressTLS
:: ExtensionsV1beta1IngressTLS
mkExtensionsV1beta1IngressTLS =
ExtensionsV1beta1IngressTLS
{ extensionsV1beta1IngressTLSHosts = Nothing
, extensionsV1beta1IngressTLSSecretName = Nothing
}
data ExtensionsV1beta1PodSecurityPolicy = ExtensionsV1beta1PodSecurityPolicy
{ extensionsV1beta1PodSecurityPolicyApiVersion :: !(Maybe Text)
, extensionsV1beta1PodSecurityPolicyKind :: !(Maybe Text)
, extensionsV1beta1PodSecurityPolicyMetadata :: !(Maybe V1ObjectMeta)
, extensionsV1beta1PodSecurityPolicySpec :: !(Maybe ExtensionsV1beta1PodSecurityPolicySpec)
} deriving (P.Show, P.Eq, P.Typeable)
instance A.FromJSON ExtensionsV1beta1PodSecurityPolicy where
parseJSON = A.withObject "ExtensionsV1beta1PodSecurityPolicy" $ \o ->
ExtensionsV1beta1PodSecurityPolicy
<$> (o .:? "apiVersion")
<*> (o .:? "kind")
<*> (o .:? "metadata")
<*> (o .:? "spec")
instance A.ToJSON ExtensionsV1beta1PodSecurityPolicy where
toJSON ExtensionsV1beta1PodSecurityPolicy {..} =
_omitNulls
[ "apiVersion" .= extensionsV1beta1PodSecurityPolicyApiVersion
, "kind" .= extensionsV1beta1PodSecurityPolicyKind
, "metadata" .= extensionsV1beta1PodSecurityPolicyMetadata
, "spec" .= extensionsV1beta1PodSecurityPolicySpec
]
mkExtensionsV1beta1PodSecurityPolicy
:: ExtensionsV1beta1PodSecurityPolicy
mkExtensionsV1beta1PodSecurityPolicy =
ExtensionsV1beta1PodSecurityPolicy
{ extensionsV1beta1PodSecurityPolicyApiVersion = Nothing
, extensionsV1beta1PodSecurityPolicyKind = Nothing
, extensionsV1beta1PodSecurityPolicyMetadata = Nothing
, extensionsV1beta1PodSecurityPolicySpec = Nothing
}
data ExtensionsV1beta1PodSecurityPolicyList = ExtensionsV1beta1PodSecurityPolicyList
{ extensionsV1beta1PodSecurityPolicyListApiVersion :: !(Maybe Text)
, extensionsV1beta1PodSecurityPolicyListItems :: !([ExtensionsV1beta1PodSecurityPolicy])
, extensionsV1beta1PodSecurityPolicyListKind :: !(Maybe Text)
, extensionsV1beta1PodSecurityPolicyListMetadata :: !(Maybe V1ListMeta)
} deriving (P.Show, P.Eq, P.Typeable)
instance A.FromJSON ExtensionsV1beta1PodSecurityPolicyList where
parseJSON = A.withObject "ExtensionsV1beta1PodSecurityPolicyList" $ \o ->
ExtensionsV1beta1PodSecurityPolicyList
<$> (o .:? "apiVersion")
<*> (o .: "items")
<*> (o .:? "kind")
<*> (o .:? "metadata")
instance A.ToJSON ExtensionsV1beta1PodSecurityPolicyList where
toJSON ExtensionsV1beta1PodSecurityPolicyList {..} =
_omitNulls
[ "apiVersion" .= extensionsV1beta1PodSecurityPolicyListApiVersion
, "items" .= extensionsV1beta1PodSecurityPolicyListItems
, "kind" .= extensionsV1beta1PodSecurityPolicyListKind
, "metadata" .= extensionsV1beta1PodSecurityPolicyListMetadata
]
mkExtensionsV1beta1PodSecurityPolicyList
:: [ExtensionsV1beta1PodSecurityPolicy]
-> ExtensionsV1beta1PodSecurityPolicyList
mkExtensionsV1beta1PodSecurityPolicyList extensionsV1beta1PodSecurityPolicyListItems =
ExtensionsV1beta1PodSecurityPolicyList
{ extensionsV1beta1PodSecurityPolicyListApiVersion = Nothing
, extensionsV1beta1PodSecurityPolicyListItems
, extensionsV1beta1PodSecurityPolicyListKind = Nothing
, extensionsV1beta1PodSecurityPolicyListMetadata = Nothing
}
data ExtensionsV1beta1PodSecurityPolicySpec = ExtensionsV1beta1PodSecurityPolicySpec
{ extensionsV1beta1PodSecurityPolicySpecAllowPrivilegeEscalation :: !(Maybe Bool)
, extensionsV1beta1PodSecurityPolicySpecAllowedCsiDrivers :: !(Maybe [ExtensionsV1beta1AllowedCSIDriver])
, extensionsV1beta1PodSecurityPolicySpecAllowedCapabilities :: !(Maybe [Text])
, extensionsV1beta1PodSecurityPolicySpecAllowedFlexVolumes :: !(Maybe [ExtensionsV1beta1AllowedFlexVolume])
, extensionsV1beta1PodSecurityPolicySpecAllowedHostPaths :: !(Maybe [ExtensionsV1beta1AllowedHostPath])
, extensionsV1beta1PodSecurityPolicySpecAllowedProcMountTypes :: !(Maybe [Text])
, extensionsV1beta1PodSecurityPolicySpecAllowedUnsafeSysctls :: !(Maybe [Text])
, extensionsV1beta1PodSecurityPolicySpecDefaultAddCapabilities :: !(Maybe [Text])
, extensionsV1beta1PodSecurityPolicySpecDefaultAllowPrivilegeEscalation :: !(Maybe Bool)
, extensionsV1beta1PodSecurityPolicySpecForbiddenSysctls :: !(Maybe [Text])
, extensionsV1beta1PodSecurityPolicySpecFsGroup :: !(ExtensionsV1beta1FSGroupStrategyOptions)
, extensionsV1beta1PodSecurityPolicySpecHostIpc :: !(Maybe Bool)
, extensionsV1beta1PodSecurityPolicySpecHostNetwork :: !(Maybe Bool)
, extensionsV1beta1PodSecurityPolicySpecHostPid :: !(Maybe Bool)
, extensionsV1beta1PodSecurityPolicySpecHostPorts :: !(Maybe [ExtensionsV1beta1HostPortRange])
, extensionsV1beta1PodSecurityPolicySpecPrivileged :: !(Maybe Bool)
, extensionsV1beta1PodSecurityPolicySpecReadOnlyRootFilesystem :: !(Maybe Bool)
, extensionsV1beta1PodSecurityPolicySpecRequiredDropCapabilities :: !(Maybe [Text])
, extensionsV1beta1PodSecurityPolicySpecRunAsGroup :: !(Maybe ExtensionsV1beta1RunAsGroupStrategyOptions)
, extensionsV1beta1PodSecurityPolicySpecRunAsUser :: !(ExtensionsV1beta1RunAsUserStrategyOptions)
, extensionsV1beta1PodSecurityPolicySpecRuntimeClass :: !(Maybe ExtensionsV1beta1RuntimeClassStrategyOptions)
, extensionsV1beta1PodSecurityPolicySpecSeLinux :: !(ExtensionsV1beta1SELinuxStrategyOptions)
, extensionsV1beta1PodSecurityPolicySpecSupplementalGroups :: !(ExtensionsV1beta1SupplementalGroupsStrategyOptions)
, extensionsV1beta1PodSecurityPolicySpecVolumes :: !(Maybe [Text])
} deriving (P.Show, P.Eq, P.Typeable)
instance A.FromJSON ExtensionsV1beta1PodSecurityPolicySpec where
parseJSON = A.withObject "ExtensionsV1beta1PodSecurityPolicySpec" $ \o ->
ExtensionsV1beta1PodSecurityPolicySpec
<$> (o .:? "allowPrivilegeEscalation")
<*> (o .:? "allowedCSIDrivers")
<*> (o .:? "allowedCapabilities")
<*> (o .:? "allowedFlexVolumes")
<*> (o .:? "allowedHostPaths")
<*> (o .:? "allowedProcMountTypes")
<*> (o .:? "allowedUnsafeSysctls")
<*> (o .:? "defaultAddCapabilities")
<*> (o .:? "defaultAllowPrivilegeEscalation")
<*> (o .:? "forbiddenSysctls")
<*> (o .: "fsGroup")
<*> (o .:? "hostIPC")
<*> (o .:? "hostNetwork")
<*> (o .:? "hostPID")
<*> (o .:? "hostPorts")
<*> (o .:? "privileged")
<*> (o .:? "readOnlyRootFilesystem")
<*> (o .:? "requiredDropCapabilities")
<*> (o .:? "runAsGroup")
<*> (o .: "runAsUser")
<*> (o .:? "runtimeClass")
<*> (o .: "seLinux")
<*> (o .: "supplementalGroups")
<*> (o .:? "volumes")
instance A.ToJSON ExtensionsV1beta1PodSecurityPolicySpec where
toJSON ExtensionsV1beta1PodSecurityPolicySpec {..} =
_omitNulls
[ "allowPrivilegeEscalation" .= extensionsV1beta1PodSecurityPolicySpecAllowPrivilegeEscalation
, "allowedCSIDrivers" .= extensionsV1beta1PodSecurityPolicySpecAllowedCsiDrivers
, "allowedCapabilities" .= extensionsV1beta1PodSecurityPolicySpecAllowedCapabilities
, "allowedFlexVolumes" .= extensionsV1beta1PodSecurityPolicySpecAllowedFlexVolumes
, "allowedHostPaths" .= extensionsV1beta1PodSecurityPolicySpecAllowedHostPaths
, "allowedProcMountTypes" .= extensionsV1beta1PodSecurityPolicySpecAllowedProcMountTypes
, "allowedUnsafeSysctls" .= extensionsV1beta1PodSecurityPolicySpecAllowedUnsafeSysctls
, "defaultAddCapabilities" .= extensionsV1beta1PodSecurityPolicySpecDefaultAddCapabilities
, "defaultAllowPrivilegeEscalation" .= extensionsV1beta1PodSecurityPolicySpecDefaultAllowPrivilegeEscalation
, "forbiddenSysctls" .= extensionsV1beta1PodSecurityPolicySpecForbiddenSysctls
, "fsGroup" .= extensionsV1beta1PodSecurityPolicySpecFsGroup
, "hostIPC" .= extensionsV1beta1PodSecurityPolicySpecHostIpc
, "hostNetwork" .= extensionsV1beta1PodSecurityPolicySpecHostNetwork
, "hostPID" .= extensionsV1beta1PodSecurityPolicySpecHostPid
, "hostPorts" .= extensionsV1beta1PodSecurityPolicySpecHostPorts
, "privileged" .= extensionsV1beta1PodSecurityPolicySpecPrivileged
, "readOnlyRootFilesystem" .= extensionsV1beta1PodSecurityPolicySpecReadOnlyRootFilesystem
, "requiredDropCapabilities" .= extensionsV1beta1PodSecurityPolicySpecRequiredDropCapabilities
, "runAsGroup" .= extensionsV1beta1PodSecurityPolicySpecRunAsGroup
, "runAsUser" .= extensionsV1beta1PodSecurityPolicySpecRunAsUser
, "runtimeClass" .= extensionsV1beta1PodSecurityPolicySpecRuntimeClass
, "seLinux" .= extensionsV1beta1PodSecurityPolicySpecSeLinux
, "supplementalGroups" .= extensionsV1beta1PodSecurityPolicySpecSupplementalGroups
, "volumes" .= extensionsV1beta1PodSecurityPolicySpecVolumes
]
mkExtensionsV1beta1PodSecurityPolicySpec
:: ExtensionsV1beta1FSGroupStrategyOptions
-> ExtensionsV1beta1RunAsUserStrategyOptions
-> ExtensionsV1beta1SELinuxStrategyOptions
-> ExtensionsV1beta1SupplementalGroupsStrategyOptions
-> ExtensionsV1beta1PodSecurityPolicySpec
mkExtensionsV1beta1PodSecurityPolicySpec extensionsV1beta1PodSecurityPolicySpecFsGroup extensionsV1beta1PodSecurityPolicySpecRunAsUser extensionsV1beta1PodSecurityPolicySpecSeLinux extensionsV1beta1PodSecurityPolicySpecSupplementalGroups =
ExtensionsV1beta1PodSecurityPolicySpec
{ extensionsV1beta1PodSecurityPolicySpecAllowPrivilegeEscalation = Nothing
, extensionsV1beta1PodSecurityPolicySpecAllowedCsiDrivers = Nothing
, extensionsV1beta1PodSecurityPolicySpecAllowedCapabilities = Nothing
, extensionsV1beta1PodSecurityPolicySpecAllowedFlexVolumes = Nothing
, extensionsV1beta1PodSecurityPolicySpecAllowedHostPaths = Nothing
, extensionsV1beta1PodSecurityPolicySpecAllowedProcMountTypes = Nothing
, extensionsV1beta1PodSecurityPolicySpecAllowedUnsafeSysctls = Nothing
, extensionsV1beta1PodSecurityPolicySpecDefaultAddCapabilities = Nothing
, extensionsV1beta1PodSecurityPolicySpecDefaultAllowPrivilegeEscalation = Nothing
, extensionsV1beta1PodSecurityPolicySpecForbiddenSysctls = Nothing
, extensionsV1beta1PodSecurityPolicySpecFsGroup
, extensionsV1beta1PodSecurityPolicySpecHostIpc = Nothing
, extensionsV1beta1PodSecurityPolicySpecHostNetwork = Nothing
, extensionsV1beta1PodSecurityPolicySpecHostPid = Nothing
, extensionsV1beta1PodSecurityPolicySpecHostPorts = Nothing
, extensionsV1beta1PodSecurityPolicySpecPrivileged = Nothing
, extensionsV1beta1PodSecurityPolicySpecReadOnlyRootFilesystem = Nothing
, extensionsV1beta1PodSecurityPolicySpecRequiredDropCapabilities = Nothing
, extensionsV1beta1PodSecurityPolicySpecRunAsGroup = Nothing
, extensionsV1beta1PodSecurityPolicySpecRunAsUser
, extensionsV1beta1PodSecurityPolicySpecRuntimeClass = Nothing
, extensionsV1beta1PodSecurityPolicySpecSeLinux
, extensionsV1beta1PodSecurityPolicySpecSupplementalGroups
, extensionsV1beta1PodSecurityPolicySpecVolumes = Nothing
}
data ExtensionsV1beta1RollbackConfig = ExtensionsV1beta1RollbackConfig
{ extensionsV1beta1RollbackConfigRevision :: !(Maybe Integer)
} deriving (P.Show, P.Eq, P.Typeable)
instance A.FromJSON ExtensionsV1beta1RollbackConfig where
parseJSON = A.withObject "ExtensionsV1beta1RollbackConfig" $ \o ->
ExtensionsV1beta1RollbackConfig
<$> (o .:? "revision")
instance A.ToJSON ExtensionsV1beta1RollbackConfig where
toJSON ExtensionsV1beta1RollbackConfig {..} =
_omitNulls
[ "revision" .= extensionsV1beta1RollbackConfigRevision
]
mkExtensionsV1beta1RollbackConfig
:: ExtensionsV1beta1RollbackConfig
mkExtensionsV1beta1RollbackConfig =
ExtensionsV1beta1RollbackConfig
{ extensionsV1beta1RollbackConfigRevision = Nothing
}
data ExtensionsV1beta1RollingUpdateDeployment = ExtensionsV1beta1RollingUpdateDeployment
{ extensionsV1beta1RollingUpdateDeploymentMaxSurge :: !(Maybe IntOrString)
, extensionsV1beta1RollingUpdateDeploymentMaxUnavailable :: !(Maybe IntOrString)
} deriving (P.Show, P.Eq, P.Typeable)
instance A.FromJSON ExtensionsV1beta1RollingUpdateDeployment where
parseJSON = A.withObject "ExtensionsV1beta1RollingUpdateDeployment" $ \o ->
ExtensionsV1beta1RollingUpdateDeployment
<$> (o .:? "maxSurge")
<*> (o .:? "maxUnavailable")
instance A.ToJSON ExtensionsV1beta1RollingUpdateDeployment where
toJSON ExtensionsV1beta1RollingUpdateDeployment {..} =
_omitNulls
[ "maxSurge" .= extensionsV1beta1RollingUpdateDeploymentMaxSurge
, "maxUnavailable" .= extensionsV1beta1RollingUpdateDeploymentMaxUnavailable
]
mkExtensionsV1beta1RollingUpdateDeployment
:: ExtensionsV1beta1RollingUpdateDeployment
mkExtensionsV1beta1RollingUpdateDeployment =
ExtensionsV1beta1RollingUpdateDeployment
{ extensionsV1beta1RollingUpdateDeploymentMaxSurge = Nothing
, extensionsV1beta1RollingUpdateDeploymentMaxUnavailable = Nothing
}
data ExtensionsV1beta1RunAsGroupStrategyOptions = ExtensionsV1beta1RunAsGroupStrategyOptions
{ extensionsV1beta1RunAsGroupStrategyOptionsRanges :: !(Maybe [ExtensionsV1beta1IDRange])
, extensionsV1beta1RunAsGroupStrategyOptionsRule :: !(Text)
} deriving (P.Show, P.Eq, P.Typeable)
instance A.FromJSON ExtensionsV1beta1RunAsGroupStrategyOptions where
parseJSON = A.withObject "ExtensionsV1beta1RunAsGroupStrategyOptions" $ \o ->
ExtensionsV1beta1RunAsGroupStrategyOptions
<$> (o .:? "ranges")
<*> (o .: "rule")
instance A.ToJSON ExtensionsV1beta1RunAsGroupStrategyOptions where
toJSON ExtensionsV1beta1RunAsGroupStrategyOptions {..} =
_omitNulls
[ "ranges" .= extensionsV1beta1RunAsGroupStrategyOptionsRanges
, "rule" .= extensionsV1beta1RunAsGroupStrategyOptionsRule
]
mkExtensionsV1beta1RunAsGroupStrategyOptions
:: Text
-> ExtensionsV1beta1RunAsGroupStrategyOptions
mkExtensionsV1beta1RunAsGroupStrategyOptions extensionsV1beta1RunAsGroupStrategyOptionsRule =
ExtensionsV1beta1RunAsGroupStrategyOptions
{ extensionsV1beta1RunAsGroupStrategyOptionsRanges = Nothing
, extensionsV1beta1RunAsGroupStrategyOptionsRule
}
data ExtensionsV1beta1RunAsUserStrategyOptions = ExtensionsV1beta1RunAsUserStrategyOptions
{ extensionsV1beta1RunAsUserStrategyOptionsRanges :: !(Maybe [ExtensionsV1beta1IDRange])
, extensionsV1beta1RunAsUserStrategyOptionsRule :: !(Text)
} deriving (P.Show, P.Eq, P.Typeable)
instance A.FromJSON ExtensionsV1beta1RunAsUserStrategyOptions where
parseJSON = A.withObject "ExtensionsV1beta1RunAsUserStrategyOptions" $ \o ->
ExtensionsV1beta1RunAsUserStrategyOptions
<$> (o .:? "ranges")
<*> (o .: "rule")
instance A.ToJSON ExtensionsV1beta1RunAsUserStrategyOptions where
toJSON ExtensionsV1beta1RunAsUserStrategyOptions {..} =
_omitNulls
[ "ranges" .= extensionsV1beta1RunAsUserStrategyOptionsRanges
, "rule" .= extensionsV1beta1RunAsUserStrategyOptionsRule
]
mkExtensionsV1beta1RunAsUserStrategyOptions
:: Text
-> ExtensionsV1beta1RunAsUserStrategyOptions
mkExtensionsV1beta1RunAsUserStrategyOptions extensionsV1beta1RunAsUserStrategyOptionsRule =
ExtensionsV1beta1RunAsUserStrategyOptions
{ extensionsV1beta1RunAsUserStrategyOptionsRanges = Nothing
, extensionsV1beta1RunAsUserStrategyOptionsRule
}
data ExtensionsV1beta1RuntimeClassStrategyOptions = ExtensionsV1beta1RuntimeClassStrategyOptions
{ extensionsV1beta1RuntimeClassStrategyOptionsAllowedRuntimeClassNames :: !([Text])
, extensionsV1beta1RuntimeClassStrategyOptionsDefaultRuntimeClassName :: !(Maybe Text)
} deriving (P.Show, P.Eq, P.Typeable)
instance A.FromJSON ExtensionsV1beta1RuntimeClassStrategyOptions where
parseJSON = A.withObject "ExtensionsV1beta1RuntimeClassStrategyOptions" $ \o ->
ExtensionsV1beta1RuntimeClassStrategyOptions
<$> (o .: "allowedRuntimeClassNames")
<*> (o .:? "defaultRuntimeClassName")
instance A.ToJSON ExtensionsV1beta1RuntimeClassStrategyOptions where
toJSON ExtensionsV1beta1RuntimeClassStrategyOptions {..} =
_omitNulls
[ "allowedRuntimeClassNames" .= extensionsV1beta1RuntimeClassStrategyOptionsAllowedRuntimeClassNames
, "defaultRuntimeClassName" .= extensionsV1beta1RuntimeClassStrategyOptionsDefaultRuntimeClassName
]
mkExtensionsV1beta1RuntimeClassStrategyOptions
:: [Text]
-> ExtensionsV1beta1RuntimeClassStrategyOptions
mkExtensionsV1beta1RuntimeClassStrategyOptions extensionsV1beta1RuntimeClassStrategyOptionsAllowedRuntimeClassNames =
ExtensionsV1beta1RuntimeClassStrategyOptions
{ extensionsV1beta1RuntimeClassStrategyOptionsAllowedRuntimeClassNames
, extensionsV1beta1RuntimeClassStrategyOptionsDefaultRuntimeClassName = Nothing
}
data ExtensionsV1beta1SELinuxStrategyOptions = ExtensionsV1beta1SELinuxStrategyOptions
{ extensionsV1beta1SELinuxStrategyOptionsRule :: !(Text)
, extensionsV1beta1SELinuxStrategyOptionsSeLinuxOptions :: !(Maybe V1SELinuxOptions)
} deriving (P.Show, P.Eq, P.Typeable)
instance A.FromJSON ExtensionsV1beta1SELinuxStrategyOptions where
parseJSON = A.withObject "ExtensionsV1beta1SELinuxStrategyOptions" $ \o ->
ExtensionsV1beta1SELinuxStrategyOptions
<$> (o .: "rule")
<*> (o .:? "seLinuxOptions")
instance A.ToJSON ExtensionsV1beta1SELinuxStrategyOptions where
toJSON ExtensionsV1beta1SELinuxStrategyOptions {..} =
_omitNulls
[ "rule" .= extensionsV1beta1SELinuxStrategyOptionsRule
, "seLinuxOptions" .= extensionsV1beta1SELinuxStrategyOptionsSeLinuxOptions
]
mkExtensionsV1beta1SELinuxStrategyOptions
:: Text
-> ExtensionsV1beta1SELinuxStrategyOptions
mkExtensionsV1beta1SELinuxStrategyOptions extensionsV1beta1SELinuxStrategyOptionsRule =
ExtensionsV1beta1SELinuxStrategyOptions
{ extensionsV1beta1SELinuxStrategyOptionsRule
, extensionsV1beta1SELinuxStrategyOptionsSeLinuxOptions = Nothing
}
data ExtensionsV1beta1Scale = ExtensionsV1beta1Scale
{ extensionsV1beta1ScaleApiVersion :: !(Maybe Text)
, extensionsV1beta1ScaleKind :: !(Maybe Text)
, extensionsV1beta1ScaleMetadata :: !(Maybe V1ObjectMeta)
, extensionsV1beta1ScaleSpec :: !(Maybe ExtensionsV1beta1ScaleSpec)
, extensionsV1beta1ScaleStatus :: !(Maybe ExtensionsV1beta1ScaleStatus)
} deriving (P.Show, P.Eq, P.Typeable)
instance A.FromJSON ExtensionsV1beta1Scale where
parseJSON = A.withObject "ExtensionsV1beta1Scale" $ \o ->
ExtensionsV1beta1Scale
<$> (o .:? "apiVersion")
<*> (o .:? "kind")
<*> (o .:? "metadata")
<*> (o .:? "spec")
<*> (o .:? "status")
instance A.ToJSON ExtensionsV1beta1Scale where
toJSON ExtensionsV1beta1Scale {..} =
_omitNulls
[ "apiVersion" .= extensionsV1beta1ScaleApiVersion
, "kind" .= extensionsV1beta1ScaleKind
, "metadata" .= extensionsV1beta1ScaleMetadata
, "spec" .= extensionsV1beta1ScaleSpec
, "status" .= extensionsV1beta1ScaleStatus
]
mkExtensionsV1beta1Scale
:: ExtensionsV1beta1Scale
mkExtensionsV1beta1Scale =
ExtensionsV1beta1Scale
{ extensionsV1beta1ScaleApiVersion = Nothing
, extensionsV1beta1ScaleKind = Nothing
, extensionsV1beta1ScaleMetadata = Nothing
, extensionsV1beta1ScaleSpec = Nothing
, extensionsV1beta1ScaleStatus = Nothing
}
data ExtensionsV1beta1ScaleSpec = ExtensionsV1beta1ScaleSpec
{ extensionsV1beta1ScaleSpecReplicas :: !(Maybe Int)
} deriving (P.Show, P.Eq, P.Typeable)
instance A.FromJSON ExtensionsV1beta1ScaleSpec where
parseJSON = A.withObject "ExtensionsV1beta1ScaleSpec" $ \o ->
ExtensionsV1beta1ScaleSpec
<$> (o .:? "replicas")
instance A.ToJSON ExtensionsV1beta1ScaleSpec where
toJSON ExtensionsV1beta1ScaleSpec {..} =
_omitNulls
[ "replicas" .= extensionsV1beta1ScaleSpecReplicas
]
mkExtensionsV1beta1ScaleSpec
:: ExtensionsV1beta1ScaleSpec
mkExtensionsV1beta1ScaleSpec =
ExtensionsV1beta1ScaleSpec
{ extensionsV1beta1ScaleSpecReplicas = Nothing
}
data ExtensionsV1beta1ScaleStatus = ExtensionsV1beta1ScaleStatus
{ extensionsV1beta1ScaleStatusReplicas :: !(Int)
, extensionsV1beta1ScaleStatusSelector :: !(Maybe (Map.Map String Text))
, extensionsV1beta1ScaleStatusTargetSelector :: !(Maybe Text)
} deriving (P.Show, P.Eq, P.Typeable)
instance A.FromJSON ExtensionsV1beta1ScaleStatus where
parseJSON = A.withObject "ExtensionsV1beta1ScaleStatus" $ \o ->
ExtensionsV1beta1ScaleStatus
<$> (o .: "replicas")
<*> (o .:? "selector")
<*> (o .:? "targetSelector")
instance A.ToJSON ExtensionsV1beta1ScaleStatus where
toJSON ExtensionsV1beta1ScaleStatus {..} =
_omitNulls
[ "replicas" .= extensionsV1beta1ScaleStatusReplicas
, "selector" .= extensionsV1beta1ScaleStatusSelector
, "targetSelector" .= extensionsV1beta1ScaleStatusTargetSelector
]
mkExtensionsV1beta1ScaleStatus
:: Int
-> ExtensionsV1beta1ScaleStatus
mkExtensionsV1beta1ScaleStatus extensionsV1beta1ScaleStatusReplicas =
ExtensionsV1beta1ScaleStatus
{ extensionsV1beta1ScaleStatusReplicas
, extensionsV1beta1ScaleStatusSelector = Nothing
, extensionsV1beta1ScaleStatusTargetSelector = Nothing
}
data ExtensionsV1beta1SupplementalGroupsStrategyOptions = ExtensionsV1beta1SupplementalGroupsStrategyOptions
{ extensionsV1beta1SupplementalGroupsStrategyOptionsRanges :: !(Maybe [ExtensionsV1beta1IDRange])
, extensionsV1beta1SupplementalGroupsStrategyOptionsRule :: !(Maybe Text)
} deriving (P.Show, P.Eq, P.Typeable)
instance A.FromJSON ExtensionsV1beta1SupplementalGroupsStrategyOptions where
parseJSON = A.withObject "ExtensionsV1beta1SupplementalGroupsStrategyOptions" $ \o ->
ExtensionsV1beta1SupplementalGroupsStrategyOptions
<$> (o .:? "ranges")
<*> (o .:? "rule")
instance A.ToJSON ExtensionsV1beta1SupplementalGroupsStrategyOptions where
toJSON ExtensionsV1beta1SupplementalGroupsStrategyOptions {..} =
_omitNulls
[ "ranges" .= extensionsV1beta1SupplementalGroupsStrategyOptionsRanges
, "rule" .= extensionsV1beta1SupplementalGroupsStrategyOptionsRule
]
mkExtensionsV1beta1SupplementalGroupsStrategyOptions
:: ExtensionsV1beta1SupplementalGroupsStrategyOptions
mkExtensionsV1beta1SupplementalGroupsStrategyOptions =
ExtensionsV1beta1SupplementalGroupsStrategyOptions
{ extensionsV1beta1SupplementalGroupsStrategyOptionsRanges = Nothing
, extensionsV1beta1SupplementalGroupsStrategyOptionsRule = Nothing
}
data NetworkingV1beta1HTTPIngressPath = NetworkingV1beta1HTTPIngressPath
{ networkingV1beta1HTTPIngressPathBackend :: !(NetworkingV1beta1IngressBackend)
, networkingV1beta1HTTPIngressPathPath :: !(Maybe Text)
} deriving (P.Show, P.Eq, P.Typeable)
instance A.FromJSON NetworkingV1beta1HTTPIngressPath where
parseJSON = A.withObject "NetworkingV1beta1HTTPIngressPath" $ \o ->
NetworkingV1beta1HTTPIngressPath
<$> (o .: "backend")
<*> (o .:? "path")
instance A.ToJSON NetworkingV1beta1HTTPIngressPath where
toJSON NetworkingV1beta1HTTPIngressPath {..} =
_omitNulls
[ "backend" .= networkingV1beta1HTTPIngressPathBackend
, "path" .= networkingV1beta1HTTPIngressPathPath
]
mkNetworkingV1beta1HTTPIngressPath
:: NetworkingV1beta1IngressBackend
-> NetworkingV1beta1HTTPIngressPath
mkNetworkingV1beta1HTTPIngressPath networkingV1beta1HTTPIngressPathBackend =
NetworkingV1beta1HTTPIngressPath
{ networkingV1beta1HTTPIngressPathBackend
, networkingV1beta1HTTPIngressPathPath = Nothing
}
data NetworkingV1beta1HTTPIngressRuleValue = NetworkingV1beta1HTTPIngressRuleValue
{ networkingV1beta1HTTPIngressRuleValuePaths :: !([NetworkingV1beta1HTTPIngressPath])
} deriving (P.Show, P.Eq, P.Typeable)
instance A.FromJSON NetworkingV1beta1HTTPIngressRuleValue where
parseJSON = A.withObject "NetworkingV1beta1HTTPIngressRuleValue" $ \o ->
NetworkingV1beta1HTTPIngressRuleValue
<$> (o .: "paths")
instance A.ToJSON NetworkingV1beta1HTTPIngressRuleValue where
toJSON NetworkingV1beta1HTTPIngressRuleValue {..} =
_omitNulls
[ "paths" .= networkingV1beta1HTTPIngressRuleValuePaths
]
mkNetworkingV1beta1HTTPIngressRuleValue
:: [NetworkingV1beta1HTTPIngressPath]
-> NetworkingV1beta1HTTPIngressRuleValue
mkNetworkingV1beta1HTTPIngressRuleValue networkingV1beta1HTTPIngressRuleValuePaths =
NetworkingV1beta1HTTPIngressRuleValue
{ networkingV1beta1HTTPIngressRuleValuePaths
}
data NetworkingV1beta1Ingress = NetworkingV1beta1Ingress
{ networkingV1beta1IngressApiVersion :: !(Maybe Text)
, networkingV1beta1IngressKind :: !(Maybe Text)
, networkingV1beta1IngressMetadata :: !(Maybe V1ObjectMeta)
, networkingV1beta1IngressSpec :: !(Maybe NetworkingV1beta1IngressSpec)
, networkingV1beta1IngressStatus :: !(Maybe NetworkingV1beta1IngressStatus)
} deriving (P.Show, P.Eq, P.Typeable)
instance A.FromJSON NetworkingV1beta1Ingress where
parseJSON = A.withObject "NetworkingV1beta1Ingress" $ \o ->
NetworkingV1beta1Ingress
<$> (o .:? "apiVersion")
<*> (o .:? "kind")
<*> (o .:? "metadata")
<*> (o .:? "spec")
<*> (o .:? "status")
instance A.ToJSON NetworkingV1beta1Ingress where
toJSON NetworkingV1beta1Ingress {..} =
_omitNulls
[ "apiVersion" .= networkingV1beta1IngressApiVersion
, "kind" .= networkingV1beta1IngressKind
, "metadata" .= networkingV1beta1IngressMetadata
, "spec" .= networkingV1beta1IngressSpec
, "status" .= networkingV1beta1IngressStatus
]
mkNetworkingV1beta1Ingress
:: NetworkingV1beta1Ingress
mkNetworkingV1beta1Ingress =
NetworkingV1beta1Ingress
{ networkingV1beta1IngressApiVersion = Nothing
, networkingV1beta1IngressKind = Nothing
, networkingV1beta1IngressMetadata = Nothing
, networkingV1beta1IngressSpec = Nothing
, networkingV1beta1IngressStatus = Nothing
}
data NetworkingV1beta1IngressBackend = NetworkingV1beta1IngressBackend
{ networkingV1beta1IngressBackendServiceName :: !(Text)
, networkingV1beta1IngressBackendServicePort :: !(IntOrString)
} deriving (P.Show, P.Eq, P.Typeable)
instance A.FromJSON NetworkingV1beta1IngressBackend where
parseJSON = A.withObject "NetworkingV1beta1IngressBackend" $ \o ->
NetworkingV1beta1IngressBackend
<$> (o .: "serviceName")
<*> (o .: "servicePort")
instance A.ToJSON NetworkingV1beta1IngressBackend where
toJSON NetworkingV1beta1IngressBackend {..} =
_omitNulls
[ "serviceName" .= networkingV1beta1IngressBackendServiceName
, "servicePort" .= networkingV1beta1IngressBackendServicePort
]
mkNetworkingV1beta1IngressBackend
:: Text
-> IntOrString
-> NetworkingV1beta1IngressBackend
mkNetworkingV1beta1IngressBackend networkingV1beta1IngressBackendServiceName networkingV1beta1IngressBackendServicePort =
NetworkingV1beta1IngressBackend
{ networkingV1beta1IngressBackendServiceName
, networkingV1beta1IngressBackendServicePort
}
data NetworkingV1beta1IngressList = NetworkingV1beta1IngressList
{ networkingV1beta1IngressListApiVersion :: !(Maybe Text)
, networkingV1beta1IngressListItems :: !([NetworkingV1beta1Ingress])
, networkingV1beta1IngressListKind :: !(Maybe Text)
, networkingV1beta1IngressListMetadata :: !(Maybe V1ListMeta)
} deriving (P.Show, P.Eq, P.Typeable)
instance A.FromJSON NetworkingV1beta1IngressList where
parseJSON = A.withObject "NetworkingV1beta1IngressList" $ \o ->
NetworkingV1beta1IngressList
<$> (o .:? "apiVersion")
<*> (o .: "items")
<*> (o .:? "kind")
<*> (o .:? "metadata")
instance A.ToJSON NetworkingV1beta1IngressList where
toJSON NetworkingV1beta1IngressList {..} =
_omitNulls
[ "apiVersion" .= networkingV1beta1IngressListApiVersion
, "items" .= networkingV1beta1IngressListItems
, "kind" .= networkingV1beta1IngressListKind
, "metadata" .= networkingV1beta1IngressListMetadata
]
mkNetworkingV1beta1IngressList
:: [NetworkingV1beta1Ingress]
-> NetworkingV1beta1IngressList
mkNetworkingV1beta1IngressList networkingV1beta1IngressListItems =
NetworkingV1beta1IngressList
{ networkingV1beta1IngressListApiVersion = Nothing
, networkingV1beta1IngressListItems
, networkingV1beta1IngressListKind = Nothing
, networkingV1beta1IngressListMetadata = Nothing
}
data NetworkingV1beta1IngressRule = NetworkingV1beta1IngressRule
{ networkingV1beta1IngressRuleHost :: !(Maybe Text)
, networkingV1beta1IngressRuleHttp :: !(Maybe NetworkingV1beta1HTTPIngressRuleValue)
} deriving (P.Show, P.Eq, P.Typeable)
instance A.FromJSON NetworkingV1beta1IngressRule where
parseJSON = A.withObject "NetworkingV1beta1IngressRule" $ \o ->
NetworkingV1beta1IngressRule
<$> (o .:? "host")
<*> (o .:? "http")
instance A.ToJSON NetworkingV1beta1IngressRule where
toJSON NetworkingV1beta1IngressRule {..} =
_omitNulls
[ "host" .= networkingV1beta1IngressRuleHost
, "http" .= networkingV1beta1IngressRuleHttp
]
mkNetworkingV1beta1IngressRule
:: NetworkingV1beta1IngressRule
mkNetworkingV1beta1IngressRule =
NetworkingV1beta1IngressRule
{ networkingV1beta1IngressRuleHost = Nothing
, networkingV1beta1IngressRuleHttp = Nothing
}
data NetworkingV1beta1IngressSpec = NetworkingV1beta1IngressSpec
{ networkingV1beta1IngressSpecBackend :: !(Maybe NetworkingV1beta1IngressBackend)
, networkingV1beta1IngressSpecRules :: !(Maybe [NetworkingV1beta1IngressRule])
, networkingV1beta1IngressSpecTls :: !(Maybe [NetworkingV1beta1IngressTLS])
} deriving (P.Show, P.Eq, P.Typeable)
instance A.FromJSON NetworkingV1beta1IngressSpec where
parseJSON = A.withObject "NetworkingV1beta1IngressSpec" $ \o ->
NetworkingV1beta1IngressSpec
<$> (o .:? "backend")
<*> (o .:? "rules")
<*> (o .:? "tls")
instance A.ToJSON NetworkingV1beta1IngressSpec where
toJSON NetworkingV1beta1IngressSpec {..} =
_omitNulls
[ "backend" .= networkingV1beta1IngressSpecBackend
, "rules" .= networkingV1beta1IngressSpecRules
, "tls" .= networkingV1beta1IngressSpecTls
]
mkNetworkingV1beta1IngressSpec
:: NetworkingV1beta1IngressSpec
mkNetworkingV1beta1IngressSpec =
NetworkingV1beta1IngressSpec
{ networkingV1beta1IngressSpecBackend = Nothing
, networkingV1beta1IngressSpecRules = Nothing
, networkingV1beta1IngressSpecTls = Nothing
}
data NetworkingV1beta1IngressStatus = NetworkingV1beta1IngressStatus
{ networkingV1beta1IngressStatusLoadBalancer :: !(Maybe V1LoadBalancerStatus)
} deriving (P.Show, P.Eq, P.Typeable)
instance A.FromJSON NetworkingV1beta1IngressStatus where
parseJSON = A.withObject "NetworkingV1beta1IngressStatus" $ \o ->
NetworkingV1beta1IngressStatus
<$> (o .:? "loadBalancer")
instance A.ToJSON NetworkingV1beta1IngressStatus where
toJSON NetworkingV1beta1IngressStatus {..} =
_omitNulls
[ "loadBalancer" .= networkingV1beta1IngressStatusLoadBalancer
]
mkNetworkingV1beta1IngressStatus
:: NetworkingV1beta1IngressStatus
mkNetworkingV1beta1IngressStatus =
NetworkingV1beta1IngressStatus
{ networkingV1beta1IngressStatusLoadBalancer = Nothing
}
data NetworkingV1beta1IngressTLS = NetworkingV1beta1IngressTLS
{ networkingV1beta1IngressTLSHosts :: !(Maybe [Text])
, networkingV1beta1IngressTLSSecretName :: !(Maybe Text)
} deriving (P.Show, P.Eq, P.Typeable)
instance A.FromJSON NetworkingV1beta1IngressTLS where
parseJSON = A.withObject "NetworkingV1beta1IngressTLS" $ \o ->
NetworkingV1beta1IngressTLS
<$> (o .:? "hosts")
<*> (o .:? "secretName")
instance A.ToJSON NetworkingV1beta1IngressTLS where
toJSON NetworkingV1beta1IngressTLS {..} =
_omitNulls
[ "hosts" .= networkingV1beta1IngressTLSHosts
, "secretName" .= networkingV1beta1IngressTLSSecretName
]
mkNetworkingV1beta1IngressTLS
:: NetworkingV1beta1IngressTLS
mkNetworkingV1beta1IngressTLS =
NetworkingV1beta1IngressTLS
{ networkingV1beta1IngressTLSHosts = Nothing
, networkingV1beta1IngressTLSSecretName = Nothing
}
data PolicyV1beta1AllowedCSIDriver = PolicyV1beta1AllowedCSIDriver
{ policyV1beta1AllowedCSIDriverName :: !(Text)
} deriving (P.Show, P.Eq, P.Typeable)
instance A.FromJSON PolicyV1beta1AllowedCSIDriver where
parseJSON = A.withObject "PolicyV1beta1AllowedCSIDriver" $ \o ->
PolicyV1beta1AllowedCSIDriver
<$> (o .: "name")
instance A.ToJSON PolicyV1beta1AllowedCSIDriver where
toJSON PolicyV1beta1AllowedCSIDriver {..} =
_omitNulls
[ "name" .= policyV1beta1AllowedCSIDriverName
]
mkPolicyV1beta1AllowedCSIDriver
:: Text
-> PolicyV1beta1AllowedCSIDriver
mkPolicyV1beta1AllowedCSIDriver policyV1beta1AllowedCSIDriverName =
PolicyV1beta1AllowedCSIDriver
{ policyV1beta1AllowedCSIDriverName
}
data PolicyV1beta1AllowedFlexVolume = PolicyV1beta1AllowedFlexVolume
{ policyV1beta1AllowedFlexVolumeDriver :: !(Text)
} deriving (P.Show, P.Eq, P.Typeable)
instance A.FromJSON PolicyV1beta1AllowedFlexVolume where
parseJSON = A.withObject "PolicyV1beta1AllowedFlexVolume" $ \o ->
PolicyV1beta1AllowedFlexVolume
<$> (o .: "driver")
instance A.ToJSON PolicyV1beta1AllowedFlexVolume where
toJSON PolicyV1beta1AllowedFlexVolume {..} =
_omitNulls
[ "driver" .= policyV1beta1AllowedFlexVolumeDriver
]
mkPolicyV1beta1AllowedFlexVolume
:: Text
-> PolicyV1beta1AllowedFlexVolume
mkPolicyV1beta1AllowedFlexVolume policyV1beta1AllowedFlexVolumeDriver =
PolicyV1beta1AllowedFlexVolume
{ policyV1beta1AllowedFlexVolumeDriver
}
data PolicyV1beta1AllowedHostPath = PolicyV1beta1AllowedHostPath
{ policyV1beta1AllowedHostPathPathPrefix :: !(Maybe Text)
, policyV1beta1AllowedHostPathReadOnly :: !(Maybe Bool)
} deriving (P.Show, P.Eq, P.Typeable)
instance A.FromJSON PolicyV1beta1AllowedHostPath where
parseJSON = A.withObject "PolicyV1beta1AllowedHostPath" $ \o ->
PolicyV1beta1AllowedHostPath
<$> (o .:? "pathPrefix")
<*> (o .:? "readOnly")
instance A.ToJSON PolicyV1beta1AllowedHostPath where
toJSON PolicyV1beta1AllowedHostPath {..} =
_omitNulls
[ "pathPrefix" .= policyV1beta1AllowedHostPathPathPrefix
, "readOnly" .= policyV1beta1AllowedHostPathReadOnly
]
mkPolicyV1beta1AllowedHostPath
:: PolicyV1beta1AllowedHostPath
mkPolicyV1beta1AllowedHostPath =
PolicyV1beta1AllowedHostPath
{ policyV1beta1AllowedHostPathPathPrefix = Nothing
, policyV1beta1AllowedHostPathReadOnly = Nothing
}
data PolicyV1beta1FSGroupStrategyOptions = PolicyV1beta1FSGroupStrategyOptions
{ policyV1beta1FSGroupStrategyOptionsRanges :: !(Maybe [PolicyV1beta1IDRange])
, policyV1beta1FSGroupStrategyOptionsRule :: !(Maybe Text)
} deriving (P.Show, P.Eq, P.Typeable)
instance A.FromJSON PolicyV1beta1FSGroupStrategyOptions where
parseJSON = A.withObject "PolicyV1beta1FSGroupStrategyOptions" $ \o ->
PolicyV1beta1FSGroupStrategyOptions
<$> (o .:? "ranges")
<*> (o .:? "rule")
instance A.ToJSON PolicyV1beta1FSGroupStrategyOptions where
toJSON PolicyV1beta1FSGroupStrategyOptions {..} =
_omitNulls
[ "ranges" .= policyV1beta1FSGroupStrategyOptionsRanges
, "rule" .= policyV1beta1FSGroupStrategyOptionsRule
]
mkPolicyV1beta1FSGroupStrategyOptions
:: PolicyV1beta1FSGroupStrategyOptions
mkPolicyV1beta1FSGroupStrategyOptions =
PolicyV1beta1FSGroupStrategyOptions
{ policyV1beta1FSGroupStrategyOptionsRanges = Nothing
, policyV1beta1FSGroupStrategyOptionsRule = Nothing
}
data PolicyV1beta1HostPortRange = PolicyV1beta1HostPortRange
{ policyV1beta1HostPortRangeMax :: !(Int)
, policyV1beta1HostPortRangeMin :: !(Int)
} deriving (P.Show, P.Eq, P.Typeable)
instance A.FromJSON PolicyV1beta1HostPortRange where
parseJSON = A.withObject "PolicyV1beta1HostPortRange" $ \o ->
PolicyV1beta1HostPortRange
<$> (o .: "max")
<*> (o .: "min")
instance A.ToJSON PolicyV1beta1HostPortRange where
toJSON PolicyV1beta1HostPortRange {..} =
_omitNulls
[ "max" .= policyV1beta1HostPortRangeMax
, "min" .= policyV1beta1HostPortRangeMin
]
mkPolicyV1beta1HostPortRange
:: Int
-> Int
-> PolicyV1beta1HostPortRange
mkPolicyV1beta1HostPortRange policyV1beta1HostPortRangeMax policyV1beta1HostPortRangeMin =
PolicyV1beta1HostPortRange
{ policyV1beta1HostPortRangeMax
, policyV1beta1HostPortRangeMin
}
data PolicyV1beta1IDRange = PolicyV1beta1IDRange
{ policyV1beta1IDRangeMax :: !(Integer)
, policyV1beta1IDRangeMin :: !(Integer)
} deriving (P.Show, P.Eq, P.Typeable)
instance A.FromJSON PolicyV1beta1IDRange where
parseJSON = A.withObject "PolicyV1beta1IDRange" $ \o ->
PolicyV1beta1IDRange
<$> (o .: "max")
<*> (o .: "min")
instance A.ToJSON PolicyV1beta1IDRange where
toJSON PolicyV1beta1IDRange {..} =
_omitNulls
[ "max" .= policyV1beta1IDRangeMax
, "min" .= policyV1beta1IDRangeMin
]
mkPolicyV1beta1IDRange
:: Integer
-> Integer
-> PolicyV1beta1IDRange
mkPolicyV1beta1IDRange policyV1beta1IDRangeMax policyV1beta1IDRangeMin =
PolicyV1beta1IDRange
{ policyV1beta1IDRangeMax
, policyV1beta1IDRangeMin
}
data PolicyV1beta1PodSecurityPolicy = PolicyV1beta1PodSecurityPolicy
{ policyV1beta1PodSecurityPolicyApiVersion :: !(Maybe Text)
, policyV1beta1PodSecurityPolicyKind :: !(Maybe Text)
, policyV1beta1PodSecurityPolicyMetadata :: !(Maybe V1ObjectMeta)
, policyV1beta1PodSecurityPolicySpec :: !(Maybe PolicyV1beta1PodSecurityPolicySpec)
} deriving (P.Show, P.Eq, P.Typeable)
instance A.FromJSON PolicyV1beta1PodSecurityPolicy where
parseJSON = A.withObject "PolicyV1beta1PodSecurityPolicy" $ \o ->
PolicyV1beta1PodSecurityPolicy
<$> (o .:? "apiVersion")
<*> (o .:? "kind")
<*> (o .:? "metadata")
<*> (o .:? "spec")
instance A.ToJSON PolicyV1beta1PodSecurityPolicy where
toJSON PolicyV1beta1PodSecurityPolicy {..} =
_omitNulls
[ "apiVersion" .= policyV1beta1PodSecurityPolicyApiVersion
, "kind" .= policyV1beta1PodSecurityPolicyKind
, "metadata" .= policyV1beta1PodSecurityPolicyMetadata
, "spec" .= policyV1beta1PodSecurityPolicySpec
]
mkPolicyV1beta1PodSecurityPolicy
:: PolicyV1beta1PodSecurityPolicy
mkPolicyV1beta1PodSecurityPolicy =
PolicyV1beta1PodSecurityPolicy
{ policyV1beta1PodSecurityPolicyApiVersion = Nothing
, policyV1beta1PodSecurityPolicyKind = Nothing
, policyV1beta1PodSecurityPolicyMetadata = Nothing
, policyV1beta1PodSecurityPolicySpec = Nothing
}
data PolicyV1beta1PodSecurityPolicyList = PolicyV1beta1PodSecurityPolicyList
{ policyV1beta1PodSecurityPolicyListApiVersion :: !(Maybe Text)
, policyV1beta1PodSecurityPolicyListItems :: !([PolicyV1beta1PodSecurityPolicy])
, policyV1beta1PodSecurityPolicyListKind :: !(Maybe Text)
, policyV1beta1PodSecurityPolicyListMetadata :: !(Maybe V1ListMeta)
} deriving (P.Show, P.Eq, P.Typeable)
instance A.FromJSON PolicyV1beta1PodSecurityPolicyList where
parseJSON = A.withObject "PolicyV1beta1PodSecurityPolicyList" $ \o ->
PolicyV1beta1PodSecurityPolicyList
<$> (o .:? "apiVersion")
<*> (o .: "items")
<*> (o .:? "kind")
<*> (o .:? "metadata")
instance A.ToJSON PolicyV1beta1PodSecurityPolicyList where
toJSON PolicyV1beta1PodSecurityPolicyList {..} =
_omitNulls
[ "apiVersion" .= policyV1beta1PodSecurityPolicyListApiVersion
, "items" .= policyV1beta1PodSecurityPolicyListItems
, "kind" .= policyV1beta1PodSecurityPolicyListKind
, "metadata" .= policyV1beta1PodSecurityPolicyListMetadata
]
mkPolicyV1beta1PodSecurityPolicyList
:: [PolicyV1beta1PodSecurityPolicy]
-> PolicyV1beta1PodSecurityPolicyList
mkPolicyV1beta1PodSecurityPolicyList policyV1beta1PodSecurityPolicyListItems =
PolicyV1beta1PodSecurityPolicyList
{ policyV1beta1PodSecurityPolicyListApiVersion = Nothing
, policyV1beta1PodSecurityPolicyListItems
, policyV1beta1PodSecurityPolicyListKind = Nothing
, policyV1beta1PodSecurityPolicyListMetadata = Nothing
}
data PolicyV1beta1PodSecurityPolicySpec = PolicyV1beta1PodSecurityPolicySpec
{ policyV1beta1PodSecurityPolicySpecAllowPrivilegeEscalation :: !(Maybe Bool)
, policyV1beta1PodSecurityPolicySpecAllowedCsiDrivers :: !(Maybe [PolicyV1beta1AllowedCSIDriver])
, policyV1beta1PodSecurityPolicySpecAllowedCapabilities :: !(Maybe [Text])
, policyV1beta1PodSecurityPolicySpecAllowedFlexVolumes :: !(Maybe [PolicyV1beta1AllowedFlexVolume])
, policyV1beta1PodSecurityPolicySpecAllowedHostPaths :: !(Maybe [PolicyV1beta1AllowedHostPath])
, policyV1beta1PodSecurityPolicySpecAllowedProcMountTypes :: !(Maybe [Text])
, policyV1beta1PodSecurityPolicySpecAllowedUnsafeSysctls :: !(Maybe [Text])
, policyV1beta1PodSecurityPolicySpecDefaultAddCapabilities :: !(Maybe [Text])
, policyV1beta1PodSecurityPolicySpecDefaultAllowPrivilegeEscalation :: !(Maybe Bool)
, policyV1beta1PodSecurityPolicySpecForbiddenSysctls :: !(Maybe [Text])
, policyV1beta1PodSecurityPolicySpecFsGroup :: !(PolicyV1beta1FSGroupStrategyOptions)
, policyV1beta1PodSecurityPolicySpecHostIpc :: !(Maybe Bool)
, policyV1beta1PodSecurityPolicySpecHostNetwork :: !(Maybe Bool)
, policyV1beta1PodSecurityPolicySpecHostPid :: !(Maybe Bool)
, policyV1beta1PodSecurityPolicySpecHostPorts :: !(Maybe [PolicyV1beta1HostPortRange])
, policyV1beta1PodSecurityPolicySpecPrivileged :: !(Maybe Bool)
, policyV1beta1PodSecurityPolicySpecReadOnlyRootFilesystem :: !(Maybe Bool)
, policyV1beta1PodSecurityPolicySpecRequiredDropCapabilities :: !(Maybe [Text])
, policyV1beta1PodSecurityPolicySpecRunAsGroup :: !(Maybe PolicyV1beta1RunAsGroupStrategyOptions)
, policyV1beta1PodSecurityPolicySpecRunAsUser :: !(PolicyV1beta1RunAsUserStrategyOptions)
, policyV1beta1PodSecurityPolicySpecRuntimeClass :: !(Maybe PolicyV1beta1RuntimeClassStrategyOptions)
, policyV1beta1PodSecurityPolicySpecSeLinux :: !(PolicyV1beta1SELinuxStrategyOptions)
, policyV1beta1PodSecurityPolicySpecSupplementalGroups :: !(PolicyV1beta1SupplementalGroupsStrategyOptions)
, policyV1beta1PodSecurityPolicySpecVolumes :: !(Maybe [Text])
} deriving (P.Show, P.Eq, P.Typeable)
instance A.FromJSON PolicyV1beta1PodSecurityPolicySpec where
parseJSON = A.withObject "PolicyV1beta1PodSecurityPolicySpec" $ \o ->
PolicyV1beta1PodSecurityPolicySpec
<$> (o .:? "allowPrivilegeEscalation")
<*> (o .:? "allowedCSIDrivers")
<*> (o .:? "allowedCapabilities")
<*> (o .:? "allowedFlexVolumes")
<*> (o .:? "allowedHostPaths")
<*> (o .:? "allowedProcMountTypes")
<*> (o .:? "allowedUnsafeSysctls")
<*> (o .:? "defaultAddCapabilities")
<*> (o .:? "defaultAllowPrivilegeEscalation")
<*> (o .:? "forbiddenSysctls")
<*> (o .: "fsGroup")
<*> (o .:? "hostIPC")
<*> (o .:? "hostNetwork")
<*> (o .:? "hostPID")
<*> (o .:? "hostPorts")
<*> (o .:? "privileged")
<*> (o .:? "readOnlyRootFilesystem")
<*> (o .:? "requiredDropCapabilities")
<*> (o .:? "runAsGroup")
<*> (o .: "runAsUser")
<*> (o .:? "runtimeClass")
<*> (o .: "seLinux")
<*> (o .: "supplementalGroups")
<*> (o .:? "volumes")
instance A.ToJSON PolicyV1beta1PodSecurityPolicySpec where
toJSON PolicyV1beta1PodSecurityPolicySpec {..} =
_omitNulls
[ "allowPrivilegeEscalation" .= policyV1beta1PodSecurityPolicySpecAllowPrivilegeEscalation
, "allowedCSIDrivers" .= policyV1beta1PodSecurityPolicySpecAllowedCsiDrivers
, "allowedCapabilities" .= policyV1beta1PodSecurityPolicySpecAllowedCapabilities
, "allowedFlexVolumes" .= policyV1beta1PodSecurityPolicySpecAllowedFlexVolumes
, "allowedHostPaths" .= policyV1beta1PodSecurityPolicySpecAllowedHostPaths
, "allowedProcMountTypes" .= policyV1beta1PodSecurityPolicySpecAllowedProcMountTypes
, "allowedUnsafeSysctls" .= policyV1beta1PodSecurityPolicySpecAllowedUnsafeSysctls
, "defaultAddCapabilities" .= policyV1beta1PodSecurityPolicySpecDefaultAddCapabilities
, "defaultAllowPrivilegeEscalation" .= policyV1beta1PodSecurityPolicySpecDefaultAllowPrivilegeEscalation
, "forbiddenSysctls" .= policyV1beta1PodSecurityPolicySpecForbiddenSysctls
, "fsGroup" .= policyV1beta1PodSecurityPolicySpecFsGroup
, "hostIPC" .= policyV1beta1PodSecurityPolicySpecHostIpc
, "hostNetwork" .= policyV1beta1PodSecurityPolicySpecHostNetwork
, "hostPID" .= policyV1beta1PodSecurityPolicySpecHostPid
, "hostPorts" .= policyV1beta1PodSecurityPolicySpecHostPorts
, "privileged" .= policyV1beta1PodSecurityPolicySpecPrivileged
, "readOnlyRootFilesystem" .= policyV1beta1PodSecurityPolicySpecReadOnlyRootFilesystem
, "requiredDropCapabilities" .= policyV1beta1PodSecurityPolicySpecRequiredDropCapabilities
, "runAsGroup" .= policyV1beta1PodSecurityPolicySpecRunAsGroup
, "runAsUser" .= policyV1beta1PodSecurityPolicySpecRunAsUser
, "runtimeClass" .= policyV1beta1PodSecurityPolicySpecRuntimeClass
, "seLinux" .= policyV1beta1PodSecurityPolicySpecSeLinux
, "supplementalGroups" .= policyV1beta1PodSecurityPolicySpecSupplementalGroups
, "volumes" .= policyV1beta1PodSecurityPolicySpecVolumes
]
mkPolicyV1beta1PodSecurityPolicySpec
:: PolicyV1beta1FSGroupStrategyOptions
-> PolicyV1beta1RunAsUserStrategyOptions
-> PolicyV1beta1SELinuxStrategyOptions
-> PolicyV1beta1SupplementalGroupsStrategyOptions
-> PolicyV1beta1PodSecurityPolicySpec
mkPolicyV1beta1PodSecurityPolicySpec policyV1beta1PodSecurityPolicySpecFsGroup policyV1beta1PodSecurityPolicySpecRunAsUser policyV1beta1PodSecurityPolicySpecSeLinux policyV1beta1PodSecurityPolicySpecSupplementalGroups =
PolicyV1beta1PodSecurityPolicySpec
{ policyV1beta1PodSecurityPolicySpecAllowPrivilegeEscalation = Nothing
, policyV1beta1PodSecurityPolicySpecAllowedCsiDrivers = Nothing
, policyV1beta1PodSecurityPolicySpecAllowedCapabilities = Nothing
, policyV1beta1PodSecurityPolicySpecAllowedFlexVolumes = Nothing
, policyV1beta1PodSecurityPolicySpecAllowedHostPaths = Nothing
, policyV1beta1PodSecurityPolicySpecAllowedProcMountTypes = Nothing
, policyV1beta1PodSecurityPolicySpecAllowedUnsafeSysctls = Nothing
, policyV1beta1PodSecurityPolicySpecDefaultAddCapabilities = Nothing
, policyV1beta1PodSecurityPolicySpecDefaultAllowPrivilegeEscalation = Nothing
, policyV1beta1PodSecurityPolicySpecForbiddenSysctls = Nothing
, policyV1beta1PodSecurityPolicySpecFsGroup
, policyV1beta1PodSecurityPolicySpecHostIpc = Nothing
, policyV1beta1PodSecurityPolicySpecHostNetwork = Nothing
, policyV1beta1PodSecurityPolicySpecHostPid = Nothing
, policyV1beta1PodSecurityPolicySpecHostPorts = Nothing
, policyV1beta1PodSecurityPolicySpecPrivileged = Nothing
, policyV1beta1PodSecurityPolicySpecReadOnlyRootFilesystem = Nothing
, policyV1beta1PodSecurityPolicySpecRequiredDropCapabilities = Nothing
, policyV1beta1PodSecurityPolicySpecRunAsGroup = Nothing
, policyV1beta1PodSecurityPolicySpecRunAsUser
, policyV1beta1PodSecurityPolicySpecRuntimeClass = Nothing
, policyV1beta1PodSecurityPolicySpecSeLinux
, policyV1beta1PodSecurityPolicySpecSupplementalGroups
, policyV1beta1PodSecurityPolicySpecVolumes = Nothing
}
data PolicyV1beta1RunAsGroupStrategyOptions = PolicyV1beta1RunAsGroupStrategyOptions
{ policyV1beta1RunAsGroupStrategyOptionsRanges :: !(Maybe [PolicyV1beta1IDRange])
, policyV1beta1RunAsGroupStrategyOptionsRule :: !(Text)
} deriving (P.Show, P.Eq, P.Typeable)
instance A.FromJSON PolicyV1beta1RunAsGroupStrategyOptions where
parseJSON = A.withObject "PolicyV1beta1RunAsGroupStrategyOptions" $ \o ->
PolicyV1beta1RunAsGroupStrategyOptions
<$> (o .:? "ranges")
<*> (o .: "rule")
instance A.ToJSON PolicyV1beta1RunAsGroupStrategyOptions where
toJSON PolicyV1beta1RunAsGroupStrategyOptions {..} =
_omitNulls
[ "ranges" .= policyV1beta1RunAsGroupStrategyOptionsRanges
, "rule" .= policyV1beta1RunAsGroupStrategyOptionsRule
]
mkPolicyV1beta1RunAsGroupStrategyOptions
:: Text
-> PolicyV1beta1RunAsGroupStrategyOptions
mkPolicyV1beta1RunAsGroupStrategyOptions policyV1beta1RunAsGroupStrategyOptionsRule =
PolicyV1beta1RunAsGroupStrategyOptions
{ policyV1beta1RunAsGroupStrategyOptionsRanges = Nothing
, policyV1beta1RunAsGroupStrategyOptionsRule
}
data PolicyV1beta1RunAsUserStrategyOptions = PolicyV1beta1RunAsUserStrategyOptions
{ policyV1beta1RunAsUserStrategyOptionsRanges :: !(Maybe [PolicyV1beta1IDRange])
, policyV1beta1RunAsUserStrategyOptionsRule :: !(Text)
} deriving (P.Show, P.Eq, P.Typeable)
instance A.FromJSON PolicyV1beta1RunAsUserStrategyOptions where
parseJSON = A.withObject "PolicyV1beta1RunAsUserStrategyOptions" $ \o ->
PolicyV1beta1RunAsUserStrategyOptions
<$> (o .:? "ranges")
<*> (o .: "rule")
instance A.ToJSON PolicyV1beta1RunAsUserStrategyOptions where
toJSON PolicyV1beta1RunAsUserStrategyOptions {..} =
_omitNulls
[ "ranges" .= policyV1beta1RunAsUserStrategyOptionsRanges
, "rule" .= policyV1beta1RunAsUserStrategyOptionsRule
]
mkPolicyV1beta1RunAsUserStrategyOptions
:: Text
-> PolicyV1beta1RunAsUserStrategyOptions
mkPolicyV1beta1RunAsUserStrategyOptions policyV1beta1RunAsUserStrategyOptionsRule =
PolicyV1beta1RunAsUserStrategyOptions
{ policyV1beta1RunAsUserStrategyOptionsRanges = Nothing
, policyV1beta1RunAsUserStrategyOptionsRule
}
data PolicyV1beta1RuntimeClassStrategyOptions = PolicyV1beta1RuntimeClassStrategyOptions
{ policyV1beta1RuntimeClassStrategyOptionsAllowedRuntimeClassNames :: !([Text])
, policyV1beta1RuntimeClassStrategyOptionsDefaultRuntimeClassName :: !(Maybe Text)
} deriving (P.Show, P.Eq, P.Typeable)
instance A.FromJSON PolicyV1beta1RuntimeClassStrategyOptions where
parseJSON = A.withObject "PolicyV1beta1RuntimeClassStrategyOptions" $ \o ->
PolicyV1beta1RuntimeClassStrategyOptions
<$> (o .: "allowedRuntimeClassNames")
<*> (o .:? "defaultRuntimeClassName")
instance A.ToJSON PolicyV1beta1RuntimeClassStrategyOptions where
toJSON PolicyV1beta1RuntimeClassStrategyOptions {..} =
_omitNulls
[ "allowedRuntimeClassNames" .= policyV1beta1RuntimeClassStrategyOptionsAllowedRuntimeClassNames
, "defaultRuntimeClassName" .= policyV1beta1RuntimeClassStrategyOptionsDefaultRuntimeClassName
]
mkPolicyV1beta1RuntimeClassStrategyOptions
:: [Text]
-> PolicyV1beta1RuntimeClassStrategyOptions
mkPolicyV1beta1RuntimeClassStrategyOptions policyV1beta1RuntimeClassStrategyOptionsAllowedRuntimeClassNames =
PolicyV1beta1RuntimeClassStrategyOptions
{ policyV1beta1RuntimeClassStrategyOptionsAllowedRuntimeClassNames
, policyV1beta1RuntimeClassStrategyOptionsDefaultRuntimeClassName = Nothing
}
data PolicyV1beta1SELinuxStrategyOptions = PolicyV1beta1SELinuxStrategyOptions
{ policyV1beta1SELinuxStrategyOptionsRule :: !(Text)
, policyV1beta1SELinuxStrategyOptionsSeLinuxOptions :: !(Maybe V1SELinuxOptions)
} deriving (P.Show, P.Eq, P.Typeable)
instance A.FromJSON PolicyV1beta1SELinuxStrategyOptions where
parseJSON = A.withObject "PolicyV1beta1SELinuxStrategyOptions" $ \o ->
PolicyV1beta1SELinuxStrategyOptions
<$> (o .: "rule")
<*> (o .:? "seLinuxOptions")
instance A.ToJSON PolicyV1beta1SELinuxStrategyOptions where
toJSON PolicyV1beta1SELinuxStrategyOptions {..} =
_omitNulls
[ "rule" .= policyV1beta1SELinuxStrategyOptionsRule
, "seLinuxOptions" .= policyV1beta1SELinuxStrategyOptionsSeLinuxOptions
]
mkPolicyV1beta1SELinuxStrategyOptions
:: Text
-> PolicyV1beta1SELinuxStrategyOptions
mkPolicyV1beta1SELinuxStrategyOptions policyV1beta1SELinuxStrategyOptionsRule =
PolicyV1beta1SELinuxStrategyOptions
{ policyV1beta1SELinuxStrategyOptionsRule
, policyV1beta1SELinuxStrategyOptionsSeLinuxOptions = Nothing
}
data PolicyV1beta1SupplementalGroupsStrategyOptions = PolicyV1beta1SupplementalGroupsStrategyOptions
{ policyV1beta1SupplementalGroupsStrategyOptionsRanges :: !(Maybe [PolicyV1beta1IDRange])
, policyV1beta1SupplementalGroupsStrategyOptionsRule :: !(Maybe Text)
} deriving (P.Show, P.Eq, P.Typeable)
instance A.FromJSON PolicyV1beta1SupplementalGroupsStrategyOptions where
parseJSON = A.withObject "PolicyV1beta1SupplementalGroupsStrategyOptions" $ \o ->
PolicyV1beta1SupplementalGroupsStrategyOptions
<$> (o .:? "ranges")
<*> (o .:? "rule")
instance A.ToJSON PolicyV1beta1SupplementalGroupsStrategyOptions where
toJSON PolicyV1beta1SupplementalGroupsStrategyOptions {..} =
_omitNulls
[ "ranges" .= policyV1beta1SupplementalGroupsStrategyOptionsRanges
, "rule" .= policyV1beta1SupplementalGroupsStrategyOptionsRule
]
mkPolicyV1beta1SupplementalGroupsStrategyOptions
:: PolicyV1beta1SupplementalGroupsStrategyOptions
mkPolicyV1beta1SupplementalGroupsStrategyOptions =
PolicyV1beta1SupplementalGroupsStrategyOptions
{ policyV1beta1SupplementalGroupsStrategyOptionsRanges = Nothing
, policyV1beta1SupplementalGroupsStrategyOptionsRule = Nothing
}
data V1APIGroup = V1APIGroup
{ v1APIGroupApiVersion :: !(Maybe Text)
, v1APIGroupKind :: !(Maybe Text)
, v1APIGroupName :: !(Text)
, v1APIGroupPreferredVersion :: !(Maybe V1GroupVersionForDiscovery)
, v1APIGroupServerAddressByClientCidRs :: !(Maybe [V1ServerAddressByClientCIDR])
, v1APIGroupVersions :: !([V1GroupVersionForDiscovery])
} deriving (P.Show, P.Eq, P.Typeable)
instance A.FromJSON V1APIGroup where
parseJSON = A.withObject "V1APIGroup" $ \o ->
V1APIGroup
<$> (o .:? "apiVersion")
<*> (o .:? "kind")
<*> (o .: "name")
<*> (o .:? "preferredVersion")
<*> (o .:? "serverAddressByClientCIDRs")
<*> (o .: "versions")
instance A.ToJSON V1APIGroup where
toJSON V1APIGroup {..} =
_omitNulls
[ "apiVersion" .= v1APIGroupApiVersion
, "kind" .= v1APIGroupKind
, "name" .= v1APIGroupName
, "preferredVersion" .= v1APIGroupPreferredVersion
, "serverAddressByClientCIDRs" .= v1APIGroupServerAddressByClientCidRs
, "versions" .= v1APIGroupVersions
]
mkV1APIGroup
:: Text
-> [V1GroupVersionForDiscovery]
-> V1APIGroup
mkV1APIGroup v1APIGroupName v1APIGroupVersions =
V1APIGroup
{ v1APIGroupApiVersion = Nothing
, v1APIGroupKind = Nothing
, v1APIGroupName
, v1APIGroupPreferredVersion = Nothing
, v1APIGroupServerAddressByClientCidRs = Nothing
, v1APIGroupVersions
}
data V1APIGroupList = V1APIGroupList
{ v1APIGroupListApiVersion :: !(Maybe Text)
, v1APIGroupListGroups :: !([V1APIGroup])
, v1APIGroupListKind :: !