{-# 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.RDS.Types.BlueGreenDeployment
-- 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.RDS.Types.BlueGreenDeployment where

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
import Amazonka.RDS.Types.BlueGreenDeploymentTask
import Amazonka.RDS.Types.SwitchoverDetail
import Amazonka.RDS.Types.Tag

-- | Contains the details about a blue\/green deployment.
--
-- For more information, see
-- <https://docs.aws.amazon.com/AmazonRDS/latest/UserGuide/blue-green-deployments.html Using Amazon RDS Blue\/Green Deployments for database updates>
-- in the /Amazon RDS User Guide/ and
-- <https://docs.aws.amazon.com/AmazonRDS/latest/AuroraUserGuide/blue-green-deployments.html Using Amazon RDS Blue\/Green Deployments for database updates>
-- in the /Amazon Aurora User Guide/.
--
-- /See:/ 'newBlueGreenDeployment' smart constructor.
data BlueGreenDeployment = BlueGreenDeployment'
  { -- | The system-generated identifier of the blue\/green deployment.
    BlueGreenDeployment -> Maybe Text
blueGreenDeploymentIdentifier :: Prelude.Maybe Prelude.Text,
    -- | The user-supplied name of the blue\/green deployment.
    BlueGreenDeployment -> Maybe Text
blueGreenDeploymentName :: Prelude.Maybe Prelude.Text,
    -- | Specifies the time when the blue\/green deployment was created, in
    -- Universal Coordinated Time (UTC).
    BlueGreenDeployment -> Maybe ISO8601
createTime :: Prelude.Maybe Data.ISO8601,
    -- | Specifies the time when the blue\/green deployment was deleted, in
    -- Universal Coordinated Time (UTC).
    BlueGreenDeployment -> Maybe ISO8601
deleteTime :: Prelude.Maybe Data.ISO8601,
    -- | The source database for the blue\/green deployment.
    --
    -- Before switchover, the source database is the production database in the
    -- blue environment.
    BlueGreenDeployment -> Maybe Text
source :: Prelude.Maybe Prelude.Text,
    -- | The status of the blue\/green deployment.
    --
    -- Values:
    --
    -- -   @PROVISIONING@ - Resources are being created in the green
    --     environment.
    --
    -- -   @AVAILABLE@ - Resources are available in the green environment.
    --
    -- -   @SWITCHOVER_IN_PROGRESS@ - The deployment is being switched from the
    --     blue environment to the green environment.
    --
    -- -   @SWITCHOVER_COMPLETED@ - Switchover from the blue environment to the
    --     green environment is complete.
    --
    -- -   @INVALID_CONFIGURATION@ - Resources in the green environment are
    --     invalid, so switchover isn\'t possible.
    --
    -- -   @SWITCHOVER_FAILED@ - Switchover was attempted but failed.
    --
    -- -   @DELETING@ - The blue\/green deployment is being deleted.
    BlueGreenDeployment -> Maybe Text
status :: Prelude.Maybe Prelude.Text,
    -- | Additional information about the status of the blue\/green deployment.
    BlueGreenDeployment -> Maybe Text
statusDetails :: Prelude.Maybe Prelude.Text,
    -- | The details about each source and target resource in the blue\/green
    -- deployment.
    BlueGreenDeployment -> Maybe [SwitchoverDetail]
switchoverDetails :: Prelude.Maybe [SwitchoverDetail],
    BlueGreenDeployment -> Maybe [Tag]
tagList :: Prelude.Maybe [Tag],
    -- | The target database for the blue\/green deployment.
    --
    -- Before switchover, the target database is the clone database in the
    -- green environment.
    BlueGreenDeployment -> Maybe Text
target :: Prelude.Maybe Prelude.Text,
    -- | Either tasks to be performed or tasks that have been completed on the
    -- target database before switchover.
    BlueGreenDeployment -> Maybe [BlueGreenDeploymentTask]
tasks :: Prelude.Maybe [BlueGreenDeploymentTask]
  }
  deriving (BlueGreenDeployment -> BlueGreenDeployment -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: BlueGreenDeployment -> BlueGreenDeployment -> Bool
$c/= :: BlueGreenDeployment -> BlueGreenDeployment -> Bool
== :: BlueGreenDeployment -> BlueGreenDeployment -> Bool
$c== :: BlueGreenDeployment -> BlueGreenDeployment -> Bool
Prelude.Eq, ReadPrec [BlueGreenDeployment]
ReadPrec BlueGreenDeployment
Int -> ReadS BlueGreenDeployment
ReadS [BlueGreenDeployment]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [BlueGreenDeployment]
$creadListPrec :: ReadPrec [BlueGreenDeployment]
readPrec :: ReadPrec BlueGreenDeployment
$creadPrec :: ReadPrec BlueGreenDeployment
readList :: ReadS [BlueGreenDeployment]
$creadList :: ReadS [BlueGreenDeployment]
readsPrec :: Int -> ReadS BlueGreenDeployment
$creadsPrec :: Int -> ReadS BlueGreenDeployment
Prelude.Read, Int -> BlueGreenDeployment -> ShowS
[BlueGreenDeployment] -> ShowS
BlueGreenDeployment -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [BlueGreenDeployment] -> ShowS
$cshowList :: [BlueGreenDeployment] -> ShowS
show :: BlueGreenDeployment -> String
$cshow :: BlueGreenDeployment -> String
showsPrec :: Int -> BlueGreenDeployment -> ShowS
$cshowsPrec :: Int -> BlueGreenDeployment -> ShowS
Prelude.Show, forall x. Rep BlueGreenDeployment x -> BlueGreenDeployment
forall x. BlueGreenDeployment -> Rep BlueGreenDeployment x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep BlueGreenDeployment x -> BlueGreenDeployment
$cfrom :: forall x. BlueGreenDeployment -> Rep BlueGreenDeployment x
Prelude.Generic)

-- |
-- Create a value of 'BlueGreenDeployment' 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:
--
-- 'blueGreenDeploymentIdentifier', 'blueGreenDeployment_blueGreenDeploymentIdentifier' - The system-generated identifier of the blue\/green deployment.
--
-- 'blueGreenDeploymentName', 'blueGreenDeployment_blueGreenDeploymentName' - The user-supplied name of the blue\/green deployment.
--
-- 'createTime', 'blueGreenDeployment_createTime' - Specifies the time when the blue\/green deployment was created, in
-- Universal Coordinated Time (UTC).
--
-- 'deleteTime', 'blueGreenDeployment_deleteTime' - Specifies the time when the blue\/green deployment was deleted, in
-- Universal Coordinated Time (UTC).
--
-- 'source', 'blueGreenDeployment_source' - The source database for the blue\/green deployment.
--
-- Before switchover, the source database is the production database in the
-- blue environment.
--
-- 'status', 'blueGreenDeployment_status' - The status of the blue\/green deployment.
--
-- Values:
--
-- -   @PROVISIONING@ - Resources are being created in the green
--     environment.
--
-- -   @AVAILABLE@ - Resources are available in the green environment.
--
-- -   @SWITCHOVER_IN_PROGRESS@ - The deployment is being switched from the
--     blue environment to the green environment.
--
-- -   @SWITCHOVER_COMPLETED@ - Switchover from the blue environment to the
--     green environment is complete.
--
-- -   @INVALID_CONFIGURATION@ - Resources in the green environment are
--     invalid, so switchover isn\'t possible.
--
-- -   @SWITCHOVER_FAILED@ - Switchover was attempted but failed.
--
-- -   @DELETING@ - The blue\/green deployment is being deleted.
--
-- 'statusDetails', 'blueGreenDeployment_statusDetails' - Additional information about the status of the blue\/green deployment.
--
-- 'switchoverDetails', 'blueGreenDeployment_switchoverDetails' - The details about each source and target resource in the blue\/green
-- deployment.
--
-- 'tagList', 'blueGreenDeployment_tagList' - Undocumented member.
--
-- 'target', 'blueGreenDeployment_target' - The target database for the blue\/green deployment.
--
-- Before switchover, the target database is the clone database in the
-- green environment.
--
-- 'tasks', 'blueGreenDeployment_tasks' - Either tasks to be performed or tasks that have been completed on the
-- target database before switchover.
newBlueGreenDeployment ::
  BlueGreenDeployment
newBlueGreenDeployment :: BlueGreenDeployment
newBlueGreenDeployment =
  BlueGreenDeployment'
    { $sel:blueGreenDeploymentIdentifier:BlueGreenDeployment' :: Maybe Text
blueGreenDeploymentIdentifier =
        forall a. Maybe a
Prelude.Nothing,
      $sel:blueGreenDeploymentName:BlueGreenDeployment' :: Maybe Text
blueGreenDeploymentName = forall a. Maybe a
Prelude.Nothing,
      $sel:createTime:BlueGreenDeployment' :: Maybe ISO8601
createTime = forall a. Maybe a
Prelude.Nothing,
      $sel:deleteTime:BlueGreenDeployment' :: Maybe ISO8601
deleteTime = forall a. Maybe a
Prelude.Nothing,
      $sel:source:BlueGreenDeployment' :: Maybe Text
source = forall a. Maybe a
Prelude.Nothing,
      $sel:status:BlueGreenDeployment' :: Maybe Text
status = forall a. Maybe a
Prelude.Nothing,
      $sel:statusDetails:BlueGreenDeployment' :: Maybe Text
statusDetails = forall a. Maybe a
Prelude.Nothing,
      $sel:switchoverDetails:BlueGreenDeployment' :: Maybe [SwitchoverDetail]
switchoverDetails = forall a. Maybe a
Prelude.Nothing,
      $sel:tagList:BlueGreenDeployment' :: Maybe [Tag]
tagList = forall a. Maybe a
Prelude.Nothing,
      $sel:target:BlueGreenDeployment' :: Maybe Text
target = forall a. Maybe a
Prelude.Nothing,
      $sel:tasks:BlueGreenDeployment' :: Maybe [BlueGreenDeploymentTask]
tasks = forall a. Maybe a
Prelude.Nothing
    }

-- | The system-generated identifier of the blue\/green deployment.
blueGreenDeployment_blueGreenDeploymentIdentifier :: Lens.Lens' BlueGreenDeployment (Prelude.Maybe Prelude.Text)
blueGreenDeployment_blueGreenDeploymentIdentifier :: Lens' BlueGreenDeployment (Maybe Text)
blueGreenDeployment_blueGreenDeploymentIdentifier = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\BlueGreenDeployment' {Maybe Text
blueGreenDeploymentIdentifier :: Maybe Text
$sel:blueGreenDeploymentIdentifier:BlueGreenDeployment' :: BlueGreenDeployment -> Maybe Text
blueGreenDeploymentIdentifier} -> Maybe Text
blueGreenDeploymentIdentifier) (\s :: BlueGreenDeployment
s@BlueGreenDeployment' {} Maybe Text
a -> BlueGreenDeployment
s {$sel:blueGreenDeploymentIdentifier:BlueGreenDeployment' :: Maybe Text
blueGreenDeploymentIdentifier = Maybe Text
a} :: BlueGreenDeployment)

-- | The user-supplied name of the blue\/green deployment.
blueGreenDeployment_blueGreenDeploymentName :: Lens.Lens' BlueGreenDeployment (Prelude.Maybe Prelude.Text)
blueGreenDeployment_blueGreenDeploymentName :: Lens' BlueGreenDeployment (Maybe Text)
blueGreenDeployment_blueGreenDeploymentName = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\BlueGreenDeployment' {Maybe Text
blueGreenDeploymentName :: Maybe Text
$sel:blueGreenDeploymentName:BlueGreenDeployment' :: BlueGreenDeployment -> Maybe Text
blueGreenDeploymentName} -> Maybe Text
blueGreenDeploymentName) (\s :: BlueGreenDeployment
s@BlueGreenDeployment' {} Maybe Text
a -> BlueGreenDeployment
s {$sel:blueGreenDeploymentName:BlueGreenDeployment' :: Maybe Text
blueGreenDeploymentName = Maybe Text
a} :: BlueGreenDeployment)

-- | Specifies the time when the blue\/green deployment was created, in
-- Universal Coordinated Time (UTC).
blueGreenDeployment_createTime :: Lens.Lens' BlueGreenDeployment (Prelude.Maybe Prelude.UTCTime)
blueGreenDeployment_createTime :: Lens' BlueGreenDeployment (Maybe UTCTime)
blueGreenDeployment_createTime = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\BlueGreenDeployment' {Maybe ISO8601
createTime :: Maybe ISO8601
$sel:createTime:BlueGreenDeployment' :: BlueGreenDeployment -> Maybe ISO8601
createTime} -> Maybe ISO8601
createTime) (\s :: BlueGreenDeployment
s@BlueGreenDeployment' {} Maybe ISO8601
a -> BlueGreenDeployment
s {$sel:createTime:BlueGreenDeployment' :: Maybe ISO8601
createTime = Maybe ISO8601
a} :: BlueGreenDeployment) 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

-- | Specifies the time when the blue\/green deployment was deleted, in
-- Universal Coordinated Time (UTC).
blueGreenDeployment_deleteTime :: Lens.Lens' BlueGreenDeployment (Prelude.Maybe Prelude.UTCTime)
blueGreenDeployment_deleteTime :: Lens' BlueGreenDeployment (Maybe UTCTime)
blueGreenDeployment_deleteTime = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\BlueGreenDeployment' {Maybe ISO8601
deleteTime :: Maybe ISO8601
$sel:deleteTime:BlueGreenDeployment' :: BlueGreenDeployment -> Maybe ISO8601
deleteTime} -> Maybe ISO8601
deleteTime) (\s :: BlueGreenDeployment
s@BlueGreenDeployment' {} Maybe ISO8601
a -> BlueGreenDeployment
s {$sel:deleteTime:BlueGreenDeployment' :: Maybe ISO8601
deleteTime = Maybe ISO8601
a} :: BlueGreenDeployment) 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 source database for the blue\/green deployment.
--
-- Before switchover, the source database is the production database in the
-- blue environment.
blueGreenDeployment_source :: Lens.Lens' BlueGreenDeployment (Prelude.Maybe Prelude.Text)
blueGreenDeployment_source :: Lens' BlueGreenDeployment (Maybe Text)
blueGreenDeployment_source = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\BlueGreenDeployment' {Maybe Text
source :: Maybe Text
$sel:source:BlueGreenDeployment' :: BlueGreenDeployment -> Maybe Text
source} -> Maybe Text
source) (\s :: BlueGreenDeployment
s@BlueGreenDeployment' {} Maybe Text
a -> BlueGreenDeployment
s {$sel:source:BlueGreenDeployment' :: Maybe Text
source = Maybe Text
a} :: BlueGreenDeployment)

-- | The status of the blue\/green deployment.
--
-- Values:
--
-- -   @PROVISIONING@ - Resources are being created in the green
--     environment.
--
-- -   @AVAILABLE@ - Resources are available in the green environment.
--
-- -   @SWITCHOVER_IN_PROGRESS@ - The deployment is being switched from the
--     blue environment to the green environment.
--
-- -   @SWITCHOVER_COMPLETED@ - Switchover from the blue environment to the
--     green environment is complete.
--
-- -   @INVALID_CONFIGURATION@ - Resources in the green environment are
--     invalid, so switchover isn\'t possible.
--
-- -   @SWITCHOVER_FAILED@ - Switchover was attempted but failed.
--
-- -   @DELETING@ - The blue\/green deployment is being deleted.
blueGreenDeployment_status :: Lens.Lens' BlueGreenDeployment (Prelude.Maybe Prelude.Text)
blueGreenDeployment_status :: Lens' BlueGreenDeployment (Maybe Text)
blueGreenDeployment_status = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\BlueGreenDeployment' {Maybe Text
status :: Maybe Text
$sel:status:BlueGreenDeployment' :: BlueGreenDeployment -> Maybe Text
status} -> Maybe Text
status) (\s :: BlueGreenDeployment
s@BlueGreenDeployment' {} Maybe Text
a -> BlueGreenDeployment
s {$sel:status:BlueGreenDeployment' :: Maybe Text
status = Maybe Text
a} :: BlueGreenDeployment)

-- | Additional information about the status of the blue\/green deployment.
blueGreenDeployment_statusDetails :: Lens.Lens' BlueGreenDeployment (Prelude.Maybe Prelude.Text)
blueGreenDeployment_statusDetails :: Lens' BlueGreenDeployment (Maybe Text)
blueGreenDeployment_statusDetails = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\BlueGreenDeployment' {Maybe Text
statusDetails :: Maybe Text
$sel:statusDetails:BlueGreenDeployment' :: BlueGreenDeployment -> Maybe Text
statusDetails} -> Maybe Text
statusDetails) (\s :: BlueGreenDeployment
s@BlueGreenDeployment' {} Maybe Text
a -> BlueGreenDeployment
s {$sel:statusDetails:BlueGreenDeployment' :: Maybe Text
statusDetails = Maybe Text
a} :: BlueGreenDeployment)

-- | The details about each source and target resource in the blue\/green
-- deployment.
blueGreenDeployment_switchoverDetails :: Lens.Lens' BlueGreenDeployment (Prelude.Maybe [SwitchoverDetail])
blueGreenDeployment_switchoverDetails :: Lens' BlueGreenDeployment (Maybe [SwitchoverDetail])
blueGreenDeployment_switchoverDetails = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\BlueGreenDeployment' {Maybe [SwitchoverDetail]
switchoverDetails :: Maybe [SwitchoverDetail]
$sel:switchoverDetails:BlueGreenDeployment' :: BlueGreenDeployment -> Maybe [SwitchoverDetail]
switchoverDetails} -> Maybe [SwitchoverDetail]
switchoverDetails) (\s :: BlueGreenDeployment
s@BlueGreenDeployment' {} Maybe [SwitchoverDetail]
a -> BlueGreenDeployment
s {$sel:switchoverDetails:BlueGreenDeployment' :: Maybe [SwitchoverDetail]
switchoverDetails = Maybe [SwitchoverDetail]
a} :: BlueGreenDeployment) 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 s t a b. (Coercible s a, Coercible t b) => Iso s t a b
Lens.coerced

-- | Undocumented member.
blueGreenDeployment_tagList :: Lens.Lens' BlueGreenDeployment (Prelude.Maybe [Tag])
blueGreenDeployment_tagList :: Lens' BlueGreenDeployment (Maybe [Tag])
blueGreenDeployment_tagList = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\BlueGreenDeployment' {Maybe [Tag]
tagList :: Maybe [Tag]
$sel:tagList:BlueGreenDeployment' :: BlueGreenDeployment -> Maybe [Tag]
tagList} -> Maybe [Tag]
tagList) (\s :: BlueGreenDeployment
s@BlueGreenDeployment' {} Maybe [Tag]
a -> BlueGreenDeployment
s {$sel:tagList:BlueGreenDeployment' :: Maybe [Tag]
tagList = Maybe [Tag]
a} :: BlueGreenDeployment) 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 s t a b. (Coercible s a, Coercible t b) => Iso s t a b
Lens.coerced

-- | The target database for the blue\/green deployment.
--
-- Before switchover, the target database is the clone database in the
-- green environment.
blueGreenDeployment_target :: Lens.Lens' BlueGreenDeployment (Prelude.Maybe Prelude.Text)
blueGreenDeployment_target :: Lens' BlueGreenDeployment (Maybe Text)
blueGreenDeployment_target = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\BlueGreenDeployment' {Maybe Text
target :: Maybe Text
$sel:target:BlueGreenDeployment' :: BlueGreenDeployment -> Maybe Text
target} -> Maybe Text
target) (\s :: BlueGreenDeployment
s@BlueGreenDeployment' {} Maybe Text
a -> BlueGreenDeployment
s {$sel:target:BlueGreenDeployment' :: Maybe Text
target = Maybe Text
a} :: BlueGreenDeployment)

-- | Either tasks to be performed or tasks that have been completed on the
-- target database before switchover.
blueGreenDeployment_tasks :: Lens.Lens' BlueGreenDeployment (Prelude.Maybe [BlueGreenDeploymentTask])
blueGreenDeployment_tasks :: Lens' BlueGreenDeployment (Maybe [BlueGreenDeploymentTask])
blueGreenDeployment_tasks = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\BlueGreenDeployment' {Maybe [BlueGreenDeploymentTask]
tasks :: Maybe [BlueGreenDeploymentTask]
$sel:tasks:BlueGreenDeployment' :: BlueGreenDeployment -> Maybe [BlueGreenDeploymentTask]
tasks} -> Maybe [BlueGreenDeploymentTask]
tasks) (\s :: BlueGreenDeployment
s@BlueGreenDeployment' {} Maybe [BlueGreenDeploymentTask]
a -> BlueGreenDeployment
s {$sel:tasks:BlueGreenDeployment' :: Maybe [BlueGreenDeploymentTask]
tasks = Maybe [BlueGreenDeploymentTask]
a} :: BlueGreenDeployment) 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 s t a b. (Coercible s a, Coercible t b) => Iso s t a b
Lens.coerced

instance Data.FromXML BlueGreenDeployment where
  parseXML :: [Node] -> Either String BlueGreenDeployment
parseXML [Node]
x =
    Maybe Text
-> Maybe Text
-> Maybe ISO8601
-> Maybe ISO8601
-> Maybe Text
-> Maybe Text
-> Maybe Text
-> Maybe [SwitchoverDetail]
-> Maybe [Tag]
-> Maybe Text
-> Maybe [BlueGreenDeploymentTask]
-> BlueGreenDeployment
BlueGreenDeployment'
      forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
Prelude.<$> ([Node]
x forall a. FromXML a => [Node] -> Text -> Either String (Maybe a)
Data..@? Text
"BlueGreenDeploymentIdentifier")
      forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
Prelude.<*> ([Node]
x forall a. FromXML a => [Node] -> Text -> Either String (Maybe a)
Data..@? Text
"BlueGreenDeploymentName")
      forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
Prelude.<*> ([Node]
x forall a. FromXML a => [Node] -> Text -> Either String (Maybe a)
Data..@? Text
"CreateTime")
      forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
Prelude.<*> ([Node]
x forall a. FromXML a => [Node] -> Text -> Either String (Maybe a)
Data..@? Text
"DeleteTime")
      forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
Prelude.<*> ([Node]
x forall a. FromXML a => [Node] -> Text -> Either String (Maybe a)
Data..@? Text
"Source")
      forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
Prelude.<*> ([Node]
x forall a. FromXML a => [Node] -> Text -> Either String (Maybe a)
Data..@? Text
"Status")
      forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
Prelude.<*> ([Node]
x forall a. FromXML a => [Node] -> Text -> Either String (Maybe a)
Data..@? Text
"StatusDetails")
      forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
Prelude.<*> ( [Node]
x
                      forall a. FromXML a => [Node] -> Text -> Either String (Maybe a)
Data..@? Text
"SwitchoverDetails"
                      forall (f :: * -> *) a. Functor f => f (Maybe a) -> a -> f a
Core..!@ forall a. Monoid a => a
Prelude.mempty
                      forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
Prelude.>>= forall (f :: * -> *) a b.
Applicative f =>
([a] -> f b) -> [a] -> f (Maybe b)
Core.may (forall a. FromXML a => Text -> [Node] -> Either String [a]
Data.parseXMLList Text
"member")
                  )
      forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
Prelude.<*> ( [Node]
x
                      forall a. FromXML a => [Node] -> Text -> Either String (Maybe a)
Data..@? Text
"TagList"
                      forall (f :: * -> *) a. Functor f => f (Maybe a) -> a -> f a
Core..!@ forall a. Monoid a => a
Prelude.mempty
                      forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
Prelude.>>= forall (f :: * -> *) a b.
Applicative f =>
([a] -> f b) -> [a] -> f (Maybe b)
Core.may (forall a. FromXML a => Text -> [Node] -> Either String [a]
Data.parseXMLList Text
"Tag")
                  )
      forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
Prelude.<*> ([Node]
x forall a. FromXML a => [Node] -> Text -> Either String (Maybe a)
Data..@? Text
"Target")
      forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
Prelude.<*> ( [Node]
x
                      forall a. FromXML a => [Node] -> Text -> Either String (Maybe a)
Data..@? Text
"Tasks"
                      forall (f :: * -> *) a. Functor f => f (Maybe a) -> a -> f a
Core..!@ forall a. Monoid a => a
Prelude.mempty
                      forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
Prelude.>>= forall (f :: * -> *) a b.
Applicative f =>
([a] -> f b) -> [a] -> f (Maybe b)
Core.may (forall a. FromXML a => Text -> [Node] -> Either String [a]
Data.parseXMLList Text
"member")
                  )

instance Prelude.Hashable BlueGreenDeployment where
  hashWithSalt :: Int -> BlueGreenDeployment -> Int
hashWithSalt Int
_salt BlueGreenDeployment' {Maybe [BlueGreenDeploymentTask]
Maybe [SwitchoverDetail]
Maybe [Tag]
Maybe Text
Maybe ISO8601
tasks :: Maybe [BlueGreenDeploymentTask]
target :: Maybe Text
tagList :: Maybe [Tag]
switchoverDetails :: Maybe [SwitchoverDetail]
statusDetails :: Maybe Text
status :: Maybe Text
source :: Maybe Text
deleteTime :: Maybe ISO8601
createTime :: Maybe ISO8601
blueGreenDeploymentName :: Maybe Text
blueGreenDeploymentIdentifier :: Maybe Text
$sel:tasks:BlueGreenDeployment' :: BlueGreenDeployment -> Maybe [BlueGreenDeploymentTask]
$sel:target:BlueGreenDeployment' :: BlueGreenDeployment -> Maybe Text
$sel:tagList:BlueGreenDeployment' :: BlueGreenDeployment -> Maybe [Tag]
$sel:switchoverDetails:BlueGreenDeployment' :: BlueGreenDeployment -> Maybe [SwitchoverDetail]
$sel:statusDetails:BlueGreenDeployment' :: BlueGreenDeployment -> Maybe Text
$sel:status:BlueGreenDeployment' :: BlueGreenDeployment -> Maybe Text
$sel:source:BlueGreenDeployment' :: BlueGreenDeployment -> Maybe Text
$sel:deleteTime:BlueGreenDeployment' :: BlueGreenDeployment -> Maybe ISO8601
$sel:createTime:BlueGreenDeployment' :: BlueGreenDeployment -> Maybe ISO8601
$sel:blueGreenDeploymentName:BlueGreenDeployment' :: BlueGreenDeployment -> Maybe Text
$sel:blueGreenDeploymentIdentifier:BlueGreenDeployment' :: BlueGreenDeployment -> Maybe Text
..} =
    Int
_salt
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Text
blueGreenDeploymentIdentifier
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Text
blueGreenDeploymentName
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe ISO8601
createTime
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe ISO8601
deleteTime
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Text
source
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Text
status
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Text
statusDetails
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe [SwitchoverDetail]
switchoverDetails
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe [Tag]
tagList
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Text
target
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe [BlueGreenDeploymentTask]
tasks

instance Prelude.NFData BlueGreenDeployment where
  rnf :: BlueGreenDeployment -> ()
rnf BlueGreenDeployment' {Maybe [BlueGreenDeploymentTask]
Maybe [SwitchoverDetail]
Maybe [Tag]
Maybe Text
Maybe ISO8601
tasks :: Maybe [BlueGreenDeploymentTask]
target :: Maybe Text
tagList :: Maybe [Tag]
switchoverDetails :: Maybe [SwitchoverDetail]
statusDetails :: Maybe Text
status :: Maybe Text
source :: Maybe Text
deleteTime :: Maybe ISO8601
createTime :: Maybe ISO8601
blueGreenDeploymentName :: Maybe Text
blueGreenDeploymentIdentifier :: Maybe Text
$sel:tasks:BlueGreenDeployment' :: BlueGreenDeployment -> Maybe [BlueGreenDeploymentTask]
$sel:target:BlueGreenDeployment' :: BlueGreenDeployment -> Maybe Text
$sel:tagList:BlueGreenDeployment' :: BlueGreenDeployment -> Maybe [Tag]
$sel:switchoverDetails:BlueGreenDeployment' :: BlueGreenDeployment -> Maybe [SwitchoverDetail]
$sel:statusDetails:BlueGreenDeployment' :: BlueGreenDeployment -> Maybe Text
$sel:status:BlueGreenDeployment' :: BlueGreenDeployment -> Maybe Text
$sel:source:BlueGreenDeployment' :: BlueGreenDeployment -> Maybe Text
$sel:deleteTime:BlueGreenDeployment' :: BlueGreenDeployment -> Maybe ISO8601
$sel:createTime:BlueGreenDeployment' :: BlueGreenDeployment -> Maybe ISO8601
$sel:blueGreenDeploymentName:BlueGreenDeployment' :: BlueGreenDeployment -> Maybe Text
$sel:blueGreenDeploymentIdentifier:BlueGreenDeployment' :: BlueGreenDeployment -> Maybe Text
..} =
    forall a. NFData a => a -> ()
Prelude.rnf Maybe Text
blueGreenDeploymentIdentifier
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Text
blueGreenDeploymentName
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe ISO8601
createTime
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe ISO8601
deleteTime
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Text
source
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Text
status
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Text
statusDetails
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe [SwitchoverDetail]
switchoverDetails
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe [Tag]
tagList
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Text
target
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe [BlueGreenDeploymentTask]
tasks