{-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE DuplicateRecordFields #-}
{-# LANGUAGE NamedFieldPuns #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE RecordWildCards #-}
{-# LANGUAGE StrictData #-}
{-# LANGUAGE NoImplicitPrelude #-}
{-# OPTIONS_GHC -fno-warn-unused-imports #-}
{-# OPTIONS_GHC -fno-warn-unused-matches #-}

-- Derived from AWS service descriptions, licensed under Apache 2.0.

-- |
-- Module      : Amazonka.CodeDeploy.Types.DeploymentConfigInfo
-- Copyright   : (c) 2013-2023 Brendan Hay
-- License     : Mozilla Public License, v. 2.0.
-- Maintainer  : Brendan Hay
-- Stability   : auto-generated
-- Portability : non-portable (GHC extensions)
module Amazonka.CodeDeploy.Types.DeploymentConfigInfo where

import Amazonka.CodeDeploy.Types.ComputePlatform
import Amazonka.CodeDeploy.Types.MinimumHealthyHosts
import Amazonka.CodeDeploy.Types.TrafficRoutingConfig
import qualified Amazonka.Core as Core
import qualified Amazonka.Core.Lens.Internal as Lens
import qualified Amazonka.Data as Data
import qualified Amazonka.Prelude as Prelude

-- | Information about a deployment configuration.
--
-- /See:/ 'newDeploymentConfigInfo' smart constructor.
data DeploymentConfigInfo = DeploymentConfigInfo'
  { -- | The destination platform type for the deployment (@Lambda@, @Server@, or
    -- @ECS@).
    DeploymentConfigInfo -> Maybe ComputePlatform
computePlatform :: Prelude.Maybe ComputePlatform,
    -- | The time at which the deployment configuration was created.
    DeploymentConfigInfo -> Maybe POSIX
createTime :: Prelude.Maybe Data.POSIX,
    -- | The deployment configuration ID.
    DeploymentConfigInfo -> Maybe Text
deploymentConfigId :: Prelude.Maybe Prelude.Text,
    -- | The deployment configuration name.
    DeploymentConfigInfo -> Maybe Text
deploymentConfigName :: Prelude.Maybe Prelude.Text,
    -- | Information about the number or percentage of minimum healthy instance.
    DeploymentConfigInfo -> Maybe MinimumHealthyHosts
minimumHealthyHosts :: Prelude.Maybe MinimumHealthyHosts,
    -- | The configuration that specifies how the deployment traffic is routed.
    -- Used for deployments with a Lambda or Amazon ECS compute platform only.
    DeploymentConfigInfo -> Maybe TrafficRoutingConfig
trafficRoutingConfig :: Prelude.Maybe TrafficRoutingConfig
  }
  deriving (DeploymentConfigInfo -> DeploymentConfigInfo -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: DeploymentConfigInfo -> DeploymentConfigInfo -> Bool
$c/= :: DeploymentConfigInfo -> DeploymentConfigInfo -> Bool
== :: DeploymentConfigInfo -> DeploymentConfigInfo -> Bool
$c== :: DeploymentConfigInfo -> DeploymentConfigInfo -> Bool
Prelude.Eq, ReadPrec [DeploymentConfigInfo]
ReadPrec DeploymentConfigInfo
Int -> ReadS DeploymentConfigInfo
ReadS [DeploymentConfigInfo]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [DeploymentConfigInfo]
$creadListPrec :: ReadPrec [DeploymentConfigInfo]
readPrec :: ReadPrec DeploymentConfigInfo
$creadPrec :: ReadPrec DeploymentConfigInfo
readList :: ReadS [DeploymentConfigInfo]
$creadList :: ReadS [DeploymentConfigInfo]
readsPrec :: Int -> ReadS DeploymentConfigInfo
$creadsPrec :: Int -> ReadS DeploymentConfigInfo
Prelude.Read, Int -> DeploymentConfigInfo -> ShowS
[DeploymentConfigInfo] -> ShowS
DeploymentConfigInfo -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [DeploymentConfigInfo] -> ShowS
$cshowList :: [DeploymentConfigInfo] -> ShowS
show :: DeploymentConfigInfo -> String
$cshow :: DeploymentConfigInfo -> String
showsPrec :: Int -> DeploymentConfigInfo -> ShowS
$cshowsPrec :: Int -> DeploymentConfigInfo -> ShowS
Prelude.Show, forall x. Rep DeploymentConfigInfo x -> DeploymentConfigInfo
forall x. DeploymentConfigInfo -> Rep DeploymentConfigInfo x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep DeploymentConfigInfo x -> DeploymentConfigInfo
$cfrom :: forall x. DeploymentConfigInfo -> Rep DeploymentConfigInfo x
Prelude.Generic)

-- |
-- Create a value of 'DeploymentConfigInfo' with all optional fields omitted.
--
-- Use <https://hackage.haskell.org/package/generic-lens generic-lens> or <https://hackage.haskell.org/package/optics optics> to modify other optional fields.
--
-- The following record fields are available, with the corresponding lenses provided
-- for backwards compatibility:
--
-- 'computePlatform', 'deploymentConfigInfo_computePlatform' - The destination platform type for the deployment (@Lambda@, @Server@, or
-- @ECS@).
--
-- 'createTime', 'deploymentConfigInfo_createTime' - The time at which the deployment configuration was created.
--
-- 'deploymentConfigId', 'deploymentConfigInfo_deploymentConfigId' - The deployment configuration ID.
--
-- 'deploymentConfigName', 'deploymentConfigInfo_deploymentConfigName' - The deployment configuration name.
--
-- 'minimumHealthyHosts', 'deploymentConfigInfo_minimumHealthyHosts' - Information about the number or percentage of minimum healthy instance.
--
-- 'trafficRoutingConfig', 'deploymentConfigInfo_trafficRoutingConfig' - The configuration that specifies how the deployment traffic is routed.
-- Used for deployments with a Lambda or Amazon ECS compute platform only.
newDeploymentConfigInfo ::
  DeploymentConfigInfo
newDeploymentConfigInfo :: DeploymentConfigInfo
newDeploymentConfigInfo =
  DeploymentConfigInfo'
    { $sel:computePlatform:DeploymentConfigInfo' :: Maybe ComputePlatform
computePlatform =
        forall a. Maybe a
Prelude.Nothing,
      $sel:createTime:DeploymentConfigInfo' :: Maybe POSIX
createTime = forall a. Maybe a
Prelude.Nothing,
      $sel:deploymentConfigId:DeploymentConfigInfo' :: Maybe Text
deploymentConfigId = forall a. Maybe a
Prelude.Nothing,
      $sel:deploymentConfigName:DeploymentConfigInfo' :: Maybe Text
deploymentConfigName = forall a. Maybe a
Prelude.Nothing,
      $sel:minimumHealthyHosts:DeploymentConfigInfo' :: Maybe MinimumHealthyHosts
minimumHealthyHosts = forall a. Maybe a
Prelude.Nothing,
      $sel:trafficRoutingConfig:DeploymentConfigInfo' :: Maybe TrafficRoutingConfig
trafficRoutingConfig = forall a. Maybe a
Prelude.Nothing
    }

-- | The destination platform type for the deployment (@Lambda@, @Server@, or
-- @ECS@).
deploymentConfigInfo_computePlatform :: Lens.Lens' DeploymentConfigInfo (Prelude.Maybe ComputePlatform)
deploymentConfigInfo_computePlatform :: Lens' DeploymentConfigInfo (Maybe ComputePlatform)
deploymentConfigInfo_computePlatform = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\DeploymentConfigInfo' {Maybe ComputePlatform
computePlatform :: Maybe ComputePlatform
$sel:computePlatform:DeploymentConfigInfo' :: DeploymentConfigInfo -> Maybe ComputePlatform
computePlatform} -> Maybe ComputePlatform
computePlatform) (\s :: DeploymentConfigInfo
s@DeploymentConfigInfo' {} Maybe ComputePlatform
a -> DeploymentConfigInfo
s {$sel:computePlatform:DeploymentConfigInfo' :: Maybe ComputePlatform
computePlatform = Maybe ComputePlatform
a} :: DeploymentConfigInfo)

-- | The time at which the deployment configuration was created.
deploymentConfigInfo_createTime :: Lens.Lens' DeploymentConfigInfo (Prelude.Maybe Prelude.UTCTime)
deploymentConfigInfo_createTime :: Lens' DeploymentConfigInfo (Maybe UTCTime)
deploymentConfigInfo_createTime = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\DeploymentConfigInfo' {Maybe POSIX
createTime :: Maybe POSIX
$sel:createTime:DeploymentConfigInfo' :: DeploymentConfigInfo -> Maybe POSIX
createTime} -> Maybe POSIX
createTime) (\s :: DeploymentConfigInfo
s@DeploymentConfigInfo' {} Maybe POSIX
a -> DeploymentConfigInfo
s {$sel:createTime:DeploymentConfigInfo' :: Maybe POSIX
createTime = Maybe POSIX
a} :: DeploymentConfigInfo) forall b c a. (b -> c) -> (a -> b) -> a -> c
Prelude.. forall (f :: * -> *) (g :: * -> *) s t a b.
(Functor f, Functor g) =>
AnIso s t a b -> Iso (f s) (g t) (f a) (g b)
Lens.mapping forall (a :: Format). Iso' (Time a) UTCTime
Data._Time

-- | The deployment configuration ID.
deploymentConfigInfo_deploymentConfigId :: Lens.Lens' DeploymentConfigInfo (Prelude.Maybe Prelude.Text)
deploymentConfigInfo_deploymentConfigId :: Lens' DeploymentConfigInfo (Maybe Text)
deploymentConfigInfo_deploymentConfigId = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\DeploymentConfigInfo' {Maybe Text
deploymentConfigId :: Maybe Text
$sel:deploymentConfigId:DeploymentConfigInfo' :: DeploymentConfigInfo -> Maybe Text
deploymentConfigId} -> Maybe Text
deploymentConfigId) (\s :: DeploymentConfigInfo
s@DeploymentConfigInfo' {} Maybe Text
a -> DeploymentConfigInfo
s {$sel:deploymentConfigId:DeploymentConfigInfo' :: Maybe Text
deploymentConfigId = Maybe Text
a} :: DeploymentConfigInfo)

-- | The deployment configuration name.
deploymentConfigInfo_deploymentConfigName :: Lens.Lens' DeploymentConfigInfo (Prelude.Maybe Prelude.Text)
deploymentConfigInfo_deploymentConfigName :: Lens' DeploymentConfigInfo (Maybe Text)
deploymentConfigInfo_deploymentConfigName = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\DeploymentConfigInfo' {Maybe Text
deploymentConfigName :: Maybe Text
$sel:deploymentConfigName:DeploymentConfigInfo' :: DeploymentConfigInfo -> Maybe Text
deploymentConfigName} -> Maybe Text
deploymentConfigName) (\s :: DeploymentConfigInfo
s@DeploymentConfigInfo' {} Maybe Text
a -> DeploymentConfigInfo
s {$sel:deploymentConfigName:DeploymentConfigInfo' :: Maybe Text
deploymentConfigName = Maybe Text
a} :: DeploymentConfigInfo)

-- | Information about the number or percentage of minimum healthy instance.
deploymentConfigInfo_minimumHealthyHosts :: Lens.Lens' DeploymentConfigInfo (Prelude.Maybe MinimumHealthyHosts)
deploymentConfigInfo_minimumHealthyHosts :: Lens' DeploymentConfigInfo (Maybe MinimumHealthyHosts)
deploymentConfigInfo_minimumHealthyHosts = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\DeploymentConfigInfo' {Maybe MinimumHealthyHosts
minimumHealthyHosts :: Maybe MinimumHealthyHosts
$sel:minimumHealthyHosts:DeploymentConfigInfo' :: DeploymentConfigInfo -> Maybe MinimumHealthyHosts
minimumHealthyHosts} -> Maybe MinimumHealthyHosts
minimumHealthyHosts) (\s :: DeploymentConfigInfo
s@DeploymentConfigInfo' {} Maybe MinimumHealthyHosts
a -> DeploymentConfigInfo
s {$sel:minimumHealthyHosts:DeploymentConfigInfo' :: Maybe MinimumHealthyHosts
minimumHealthyHosts = Maybe MinimumHealthyHosts
a} :: DeploymentConfigInfo)

-- | The configuration that specifies how the deployment traffic is routed.
-- Used for deployments with a Lambda or Amazon ECS compute platform only.
deploymentConfigInfo_trafficRoutingConfig :: Lens.Lens' DeploymentConfigInfo (Prelude.Maybe TrafficRoutingConfig)
deploymentConfigInfo_trafficRoutingConfig :: Lens' DeploymentConfigInfo (Maybe TrafficRoutingConfig)
deploymentConfigInfo_trafficRoutingConfig = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\DeploymentConfigInfo' {Maybe TrafficRoutingConfig
trafficRoutingConfig :: Maybe TrafficRoutingConfig
$sel:trafficRoutingConfig:DeploymentConfigInfo' :: DeploymentConfigInfo -> Maybe TrafficRoutingConfig
trafficRoutingConfig} -> Maybe TrafficRoutingConfig
trafficRoutingConfig) (\s :: DeploymentConfigInfo
s@DeploymentConfigInfo' {} Maybe TrafficRoutingConfig
a -> DeploymentConfigInfo
s {$sel:trafficRoutingConfig:DeploymentConfigInfo' :: Maybe TrafficRoutingConfig
trafficRoutingConfig = Maybe TrafficRoutingConfig
a} :: DeploymentConfigInfo)

instance Data.FromJSON DeploymentConfigInfo where
  parseJSON :: Value -> Parser DeploymentConfigInfo
parseJSON =
    forall a. String -> (Object -> Parser a) -> Value -> Parser a
Data.withObject
      String
"DeploymentConfigInfo"
      ( \Object
x ->
          Maybe ComputePlatform
-> Maybe POSIX
-> Maybe Text
-> Maybe Text
-> Maybe MinimumHealthyHosts
-> Maybe TrafficRoutingConfig
-> DeploymentConfigInfo
DeploymentConfigInfo'
            forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
Prelude.<$> (Object
x forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
Data..:? Key
"computePlatform")
            forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
Prelude.<*> (Object
x forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
Data..:? Key
"createTime")
            forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
Prelude.<*> (Object
x forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
Data..:? Key
"deploymentConfigId")
            forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
Prelude.<*> (Object
x forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
Data..:? Key
"deploymentConfigName")
            forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
Prelude.<*> (Object
x forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
Data..:? Key
"minimumHealthyHosts")
            forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
Prelude.<*> (Object
x forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
Data..:? Key
"trafficRoutingConfig")
      )

instance Prelude.Hashable DeploymentConfigInfo where
  hashWithSalt :: Int -> DeploymentConfigInfo -> Int
hashWithSalt Int
_salt DeploymentConfigInfo' {Maybe Text
Maybe POSIX
Maybe ComputePlatform
Maybe MinimumHealthyHosts
Maybe TrafficRoutingConfig
trafficRoutingConfig :: Maybe TrafficRoutingConfig
minimumHealthyHosts :: Maybe MinimumHealthyHosts
deploymentConfigName :: Maybe Text
deploymentConfigId :: Maybe Text
createTime :: Maybe POSIX
computePlatform :: Maybe ComputePlatform
$sel:trafficRoutingConfig:DeploymentConfigInfo' :: DeploymentConfigInfo -> Maybe TrafficRoutingConfig
$sel:minimumHealthyHosts:DeploymentConfigInfo' :: DeploymentConfigInfo -> Maybe MinimumHealthyHosts
$sel:deploymentConfigName:DeploymentConfigInfo' :: DeploymentConfigInfo -> Maybe Text
$sel:deploymentConfigId:DeploymentConfigInfo' :: DeploymentConfigInfo -> Maybe Text
$sel:createTime:DeploymentConfigInfo' :: DeploymentConfigInfo -> Maybe POSIX
$sel:computePlatform:DeploymentConfigInfo' :: DeploymentConfigInfo -> Maybe ComputePlatform
..} =
    Int
_salt
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe ComputePlatform
computePlatform
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe POSIX
createTime
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Text
deploymentConfigId
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Text
deploymentConfigName
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe MinimumHealthyHosts
minimumHealthyHosts
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe TrafficRoutingConfig
trafficRoutingConfig

instance Prelude.NFData DeploymentConfigInfo where
  rnf :: DeploymentConfigInfo -> ()
rnf DeploymentConfigInfo' {Maybe Text
Maybe POSIX
Maybe ComputePlatform
Maybe MinimumHealthyHosts
Maybe TrafficRoutingConfig
trafficRoutingConfig :: Maybe TrafficRoutingConfig
minimumHealthyHosts :: Maybe MinimumHealthyHosts
deploymentConfigName :: Maybe Text
deploymentConfigId :: Maybe Text
createTime :: Maybe POSIX
computePlatform :: Maybe ComputePlatform
$sel:trafficRoutingConfig:DeploymentConfigInfo' :: DeploymentConfigInfo -> Maybe TrafficRoutingConfig
$sel:minimumHealthyHosts:DeploymentConfigInfo' :: DeploymentConfigInfo -> Maybe MinimumHealthyHosts
$sel:deploymentConfigName:DeploymentConfigInfo' :: DeploymentConfigInfo -> Maybe Text
$sel:deploymentConfigId:DeploymentConfigInfo' :: DeploymentConfigInfo -> Maybe Text
$sel:createTime:DeploymentConfigInfo' :: DeploymentConfigInfo -> Maybe POSIX
$sel:computePlatform:DeploymentConfigInfo' :: DeploymentConfigInfo -> Maybe ComputePlatform
..} =
    forall a. NFData a => a -> ()
Prelude.rnf Maybe ComputePlatform
computePlatform
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe POSIX
createTime
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Text
deploymentConfigId
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Text
deploymentConfigName
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe MinimumHealthyHosts
minimumHealthyHosts
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe TrafficRoutingConfig
trafficRoutingConfig