{-# 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.DocumentDB.Types.DBInstance
-- 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.DocumentDB.Types.DBInstance where

import qualified Amazonka.Core as Core
import qualified Amazonka.Core.Lens.Internal as Lens
import qualified Amazonka.Data as Data
import Amazonka.DocumentDB.Types.DBInstanceStatusInfo
import Amazonka.DocumentDB.Types.DBSubnetGroup
import Amazonka.DocumentDB.Types.Endpoint
import Amazonka.DocumentDB.Types.PendingModifiedValues
import Amazonka.DocumentDB.Types.VpcSecurityGroupMembership
import qualified Amazonka.Prelude as Prelude

-- | Detailed information about an instance.
--
-- /See:/ 'newDBInstance' smart constructor.
data DBInstance = DBInstance'
  { -- | Does not apply. This parameter does not apply to Amazon DocumentDB.
    -- Amazon DocumentDB does not perform minor version upgrades regardless of
    -- the value set.
    DBInstance -> Maybe Bool
autoMinorVersionUpgrade :: Prelude.Maybe Prelude.Bool,
    -- | Specifies the name of the Availability Zone that the instance is located
    -- in.
    DBInstance -> Maybe Text
availabilityZone :: Prelude.Maybe Prelude.Text,
    -- | Specifies the number of days for which automatic snapshots are retained.
    DBInstance -> Maybe Int
backupRetentionPeriod :: Prelude.Maybe Prelude.Int,
    -- | The identifier of the CA certificate for this DB instance.
    DBInstance -> Maybe Text
cACertificateIdentifier :: Prelude.Maybe Prelude.Text,
    -- | A value that indicates whether to copy tags from the DB instance to
    -- snapshots of the DB instance. By default, tags are not copied.
    DBInstance -> Maybe Bool
copyTagsToSnapshot :: Prelude.Maybe Prelude.Bool,
    -- | Contains the name of the cluster that the instance is a member of if the
    -- instance is a member of a cluster.
    DBInstance -> Maybe Text
dbClusterIdentifier :: Prelude.Maybe Prelude.Text,
    -- | The Amazon Resource Name (ARN) for the instance.
    DBInstance -> Maybe Text
dbInstanceArn :: Prelude.Maybe Prelude.Text,
    -- | Contains the name of the compute and memory capacity class of the
    -- instance.
    DBInstance -> Maybe Text
dbInstanceClass :: Prelude.Maybe Prelude.Text,
    -- | Contains a user-provided database identifier. This identifier is the
    -- unique key that identifies an instance.
    DBInstance -> Maybe Text
dbInstanceIdentifier :: Prelude.Maybe Prelude.Text,
    -- | Specifies the current state of this database.
    DBInstance -> Maybe Text
dbInstanceStatus :: Prelude.Maybe Prelude.Text,
    -- | Specifies information on the subnet group that is associated with the
    -- instance, including the name, description, and subnets in the subnet
    -- group.
    DBInstance -> Maybe DBSubnetGroup
dbSubnetGroup :: Prelude.Maybe DBSubnetGroup,
    -- | The Amazon Web Services Region-unique, immutable identifier for the
    -- instance. This identifier is found in CloudTrail log entries whenever
    -- the KMS key for the instance is accessed.
    DBInstance -> Maybe Text
dbiResourceId :: Prelude.Maybe Prelude.Text,
    -- | A list of log types that this instance is configured to export to
    -- CloudWatch Logs.
    DBInstance -> Maybe [Text]
enabledCloudwatchLogsExports :: Prelude.Maybe [Prelude.Text],
    -- | Specifies the connection endpoint.
    DBInstance -> Maybe Endpoint
endpoint :: Prelude.Maybe Endpoint,
    -- | Provides the name of the database engine to be used for this instance.
    DBInstance -> Maybe Text
engine :: Prelude.Maybe Prelude.Text,
    -- | Indicates the database engine version.
    DBInstance -> Maybe Text
engineVersion :: Prelude.Maybe Prelude.Text,
    -- | Provides the date and time that the instance was created.
    DBInstance -> Maybe ISO8601
instanceCreateTime :: Prelude.Maybe Data.ISO8601,
    -- | If @StorageEncrypted@ is @true@, the KMS key identifier for the
    -- encrypted instance.
    DBInstance -> Maybe Text
kmsKeyId :: Prelude.Maybe Prelude.Text,
    -- | Specifies the latest time to which a database can be restored with
    -- point-in-time restore.
    DBInstance -> Maybe ISO8601
latestRestorableTime :: Prelude.Maybe Data.ISO8601,
    -- | Specifies that changes to the instance are pending. This element is
    -- included only when changes are pending. Specific changes are identified
    -- by subelements.
    DBInstance -> Maybe PendingModifiedValues
pendingModifiedValues :: Prelude.Maybe PendingModifiedValues,
    -- | Specifies the daily time range during which automated backups are
    -- created if automated backups are enabled, as determined by the
    -- @BackupRetentionPeriod@.
    DBInstance -> Maybe Text
preferredBackupWindow :: Prelude.Maybe Prelude.Text,
    -- | Specifies the weekly time range during which system maintenance can
    -- occur, in Universal Coordinated Time (UTC).
    DBInstance -> Maybe Text
preferredMaintenanceWindow :: Prelude.Maybe Prelude.Text,
    -- | A value that specifies the order in which an Amazon DocumentDB replica
    -- is promoted to the primary instance after a failure of the existing
    -- primary instance.
    DBInstance -> Maybe Int
promotionTier :: Prelude.Maybe Prelude.Int,
    -- | Not supported. Amazon DocumentDB does not currently support public
    -- endpoints. The value of @PubliclyAccessible@ is always @false@.
    DBInstance -> Maybe Bool
publiclyAccessible :: Prelude.Maybe Prelude.Bool,
    -- | The status of a read replica. If the instance is not a read replica,
    -- this is blank.
    DBInstance -> Maybe [DBInstanceStatusInfo]
statusInfos :: Prelude.Maybe [DBInstanceStatusInfo],
    -- | Specifies whether or not the instance is encrypted.
    DBInstance -> Maybe Bool
storageEncrypted :: Prelude.Maybe Prelude.Bool,
    -- | Provides a list of VPC security group elements that the instance belongs
    -- to.
    DBInstance -> Maybe [VpcSecurityGroupMembership]
vpcSecurityGroups :: Prelude.Maybe [VpcSecurityGroupMembership]
  }
  deriving (DBInstance -> DBInstance -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: DBInstance -> DBInstance -> Bool
$c/= :: DBInstance -> DBInstance -> Bool
== :: DBInstance -> DBInstance -> Bool
$c== :: DBInstance -> DBInstance -> Bool
Prelude.Eq, ReadPrec [DBInstance]
ReadPrec DBInstance
Int -> ReadS DBInstance
ReadS [DBInstance]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [DBInstance]
$creadListPrec :: ReadPrec [DBInstance]
readPrec :: ReadPrec DBInstance
$creadPrec :: ReadPrec DBInstance
readList :: ReadS [DBInstance]
$creadList :: ReadS [DBInstance]
readsPrec :: Int -> ReadS DBInstance
$creadsPrec :: Int -> ReadS DBInstance
Prelude.Read, Int -> DBInstance -> ShowS
[DBInstance] -> ShowS
DBInstance -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [DBInstance] -> ShowS
$cshowList :: [DBInstance] -> ShowS
show :: DBInstance -> String
$cshow :: DBInstance -> String
showsPrec :: Int -> DBInstance -> ShowS
$cshowsPrec :: Int -> DBInstance -> ShowS
Prelude.Show, forall x. Rep DBInstance x -> DBInstance
forall x. DBInstance -> Rep DBInstance x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep DBInstance x -> DBInstance
$cfrom :: forall x. DBInstance -> Rep DBInstance x
Prelude.Generic)

-- |
-- Create a value of 'DBInstance' 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:
--
-- 'autoMinorVersionUpgrade', 'dbInstance_autoMinorVersionUpgrade' - Does not apply. This parameter does not apply to Amazon DocumentDB.
-- Amazon DocumentDB does not perform minor version upgrades regardless of
-- the value set.
--
-- 'availabilityZone', 'dbInstance_availabilityZone' - Specifies the name of the Availability Zone that the instance is located
-- in.
--
-- 'backupRetentionPeriod', 'dbInstance_backupRetentionPeriod' - Specifies the number of days for which automatic snapshots are retained.
--
-- 'cACertificateIdentifier', 'dbInstance_cACertificateIdentifier' - The identifier of the CA certificate for this DB instance.
--
-- 'copyTagsToSnapshot', 'dbInstance_copyTagsToSnapshot' - A value that indicates whether to copy tags from the DB instance to
-- snapshots of the DB instance. By default, tags are not copied.
--
-- 'dbClusterIdentifier', 'dbInstance_dbClusterIdentifier' - Contains the name of the cluster that the instance is a member of if the
-- instance is a member of a cluster.
--
-- 'dbInstanceArn', 'dbInstance_dbInstanceArn' - The Amazon Resource Name (ARN) for the instance.
--
-- 'dbInstanceClass', 'dbInstance_dbInstanceClass' - Contains the name of the compute and memory capacity class of the
-- instance.
--
-- 'dbInstanceIdentifier', 'dbInstance_dbInstanceIdentifier' - Contains a user-provided database identifier. This identifier is the
-- unique key that identifies an instance.
--
-- 'dbInstanceStatus', 'dbInstance_dbInstanceStatus' - Specifies the current state of this database.
--
-- 'dbSubnetGroup', 'dbInstance_dbSubnetGroup' - Specifies information on the subnet group that is associated with the
-- instance, including the name, description, and subnets in the subnet
-- group.
--
-- 'dbiResourceId', 'dbInstance_dbiResourceId' - The Amazon Web Services Region-unique, immutable identifier for the
-- instance. This identifier is found in CloudTrail log entries whenever
-- the KMS key for the instance is accessed.
--
-- 'enabledCloudwatchLogsExports', 'dbInstance_enabledCloudwatchLogsExports' - A list of log types that this instance is configured to export to
-- CloudWatch Logs.
--
-- 'endpoint', 'dbInstance_endpoint' - Specifies the connection endpoint.
--
-- 'engine', 'dbInstance_engine' - Provides the name of the database engine to be used for this instance.
--
-- 'engineVersion', 'dbInstance_engineVersion' - Indicates the database engine version.
--
-- 'instanceCreateTime', 'dbInstance_instanceCreateTime' - Provides the date and time that the instance was created.
--
-- 'kmsKeyId', 'dbInstance_kmsKeyId' - If @StorageEncrypted@ is @true@, the KMS key identifier for the
-- encrypted instance.
--
-- 'latestRestorableTime', 'dbInstance_latestRestorableTime' - Specifies the latest time to which a database can be restored with
-- point-in-time restore.
--
-- 'pendingModifiedValues', 'dbInstance_pendingModifiedValues' - Specifies that changes to the instance are pending. This element is
-- included only when changes are pending. Specific changes are identified
-- by subelements.
--
-- 'preferredBackupWindow', 'dbInstance_preferredBackupWindow' - Specifies the daily time range during which automated backups are
-- created if automated backups are enabled, as determined by the
-- @BackupRetentionPeriod@.
--
-- 'preferredMaintenanceWindow', 'dbInstance_preferredMaintenanceWindow' - Specifies the weekly time range during which system maintenance can
-- occur, in Universal Coordinated Time (UTC).
--
-- 'promotionTier', 'dbInstance_promotionTier' - A value that specifies the order in which an Amazon DocumentDB replica
-- is promoted to the primary instance after a failure of the existing
-- primary instance.
--
-- 'publiclyAccessible', 'dbInstance_publiclyAccessible' - Not supported. Amazon DocumentDB does not currently support public
-- endpoints. The value of @PubliclyAccessible@ is always @false@.
--
-- 'statusInfos', 'dbInstance_statusInfos' - The status of a read replica. If the instance is not a read replica,
-- this is blank.
--
-- 'storageEncrypted', 'dbInstance_storageEncrypted' - Specifies whether or not the instance is encrypted.
--
-- 'vpcSecurityGroups', 'dbInstance_vpcSecurityGroups' - Provides a list of VPC security group elements that the instance belongs
-- to.
newDBInstance ::
  DBInstance
newDBInstance :: DBInstance
newDBInstance =
  DBInstance'
    { $sel:autoMinorVersionUpgrade:DBInstance' :: Maybe Bool
autoMinorVersionUpgrade =
        forall a. Maybe a
Prelude.Nothing,
      $sel:availabilityZone:DBInstance' :: Maybe Text
availabilityZone = forall a. Maybe a
Prelude.Nothing,
      $sel:backupRetentionPeriod:DBInstance' :: Maybe Int
backupRetentionPeriod = forall a. Maybe a
Prelude.Nothing,
      $sel:cACertificateIdentifier:DBInstance' :: Maybe Text
cACertificateIdentifier = forall a. Maybe a
Prelude.Nothing,
      $sel:copyTagsToSnapshot:DBInstance' :: Maybe Bool
copyTagsToSnapshot = forall a. Maybe a
Prelude.Nothing,
      $sel:dbClusterIdentifier:DBInstance' :: Maybe Text
dbClusterIdentifier = forall a. Maybe a
Prelude.Nothing,
      $sel:dbInstanceArn:DBInstance' :: Maybe Text
dbInstanceArn = forall a. Maybe a
Prelude.Nothing,
      $sel:dbInstanceClass:DBInstance' :: Maybe Text
dbInstanceClass = forall a. Maybe a
Prelude.Nothing,
      $sel:dbInstanceIdentifier:DBInstance' :: Maybe Text
dbInstanceIdentifier = forall a. Maybe a
Prelude.Nothing,
      $sel:dbInstanceStatus:DBInstance' :: Maybe Text
dbInstanceStatus = forall a. Maybe a
Prelude.Nothing,
      $sel:dbSubnetGroup:DBInstance' :: Maybe DBSubnetGroup
dbSubnetGroup = forall a. Maybe a
Prelude.Nothing,
      $sel:dbiResourceId:DBInstance' :: Maybe Text
dbiResourceId = forall a. Maybe a
Prelude.Nothing,
      $sel:enabledCloudwatchLogsExports:DBInstance' :: Maybe [Text]
enabledCloudwatchLogsExports = forall a. Maybe a
Prelude.Nothing,
      $sel:endpoint:DBInstance' :: Maybe Endpoint
endpoint = forall a. Maybe a
Prelude.Nothing,
      $sel:engine:DBInstance' :: Maybe Text
engine = forall a. Maybe a
Prelude.Nothing,
      $sel:engineVersion:DBInstance' :: Maybe Text
engineVersion = forall a. Maybe a
Prelude.Nothing,
      $sel:instanceCreateTime:DBInstance' :: Maybe ISO8601
instanceCreateTime = forall a. Maybe a
Prelude.Nothing,
      $sel:kmsKeyId:DBInstance' :: Maybe Text
kmsKeyId = forall a. Maybe a
Prelude.Nothing,
      $sel:latestRestorableTime:DBInstance' :: Maybe ISO8601
latestRestorableTime = forall a. Maybe a
Prelude.Nothing,
      $sel:pendingModifiedValues:DBInstance' :: Maybe PendingModifiedValues
pendingModifiedValues = forall a. Maybe a
Prelude.Nothing,
      $sel:preferredBackupWindow:DBInstance' :: Maybe Text
preferredBackupWindow = forall a. Maybe a
Prelude.Nothing,
      $sel:preferredMaintenanceWindow:DBInstance' :: Maybe Text
preferredMaintenanceWindow = forall a. Maybe a
Prelude.Nothing,
      $sel:promotionTier:DBInstance' :: Maybe Int
promotionTier = forall a. Maybe a
Prelude.Nothing,
      $sel:publiclyAccessible:DBInstance' :: Maybe Bool
publiclyAccessible = forall a. Maybe a
Prelude.Nothing,
      $sel:statusInfos:DBInstance' :: Maybe [DBInstanceStatusInfo]
statusInfos = forall a. Maybe a
Prelude.Nothing,
      $sel:storageEncrypted:DBInstance' :: Maybe Bool
storageEncrypted = forall a. Maybe a
Prelude.Nothing,
      $sel:vpcSecurityGroups:DBInstance' :: Maybe [VpcSecurityGroupMembership]
vpcSecurityGroups = forall a. Maybe a
Prelude.Nothing
    }

-- | Does not apply. This parameter does not apply to Amazon DocumentDB.
-- Amazon DocumentDB does not perform minor version upgrades regardless of
-- the value set.
dbInstance_autoMinorVersionUpgrade :: Lens.Lens' DBInstance (Prelude.Maybe Prelude.Bool)
dbInstance_autoMinorVersionUpgrade :: Lens' DBInstance (Maybe Bool)
dbInstance_autoMinorVersionUpgrade = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\DBInstance' {Maybe Bool
autoMinorVersionUpgrade :: Maybe Bool
$sel:autoMinorVersionUpgrade:DBInstance' :: DBInstance -> Maybe Bool
autoMinorVersionUpgrade} -> Maybe Bool
autoMinorVersionUpgrade) (\s :: DBInstance
s@DBInstance' {} Maybe Bool
a -> DBInstance
s {$sel:autoMinorVersionUpgrade:DBInstance' :: Maybe Bool
autoMinorVersionUpgrade = Maybe Bool
a} :: DBInstance)

-- | Specifies the name of the Availability Zone that the instance is located
-- in.
dbInstance_availabilityZone :: Lens.Lens' DBInstance (Prelude.Maybe Prelude.Text)
dbInstance_availabilityZone :: Lens' DBInstance (Maybe Text)
dbInstance_availabilityZone = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\DBInstance' {Maybe Text
availabilityZone :: Maybe Text
$sel:availabilityZone:DBInstance' :: DBInstance -> Maybe Text
availabilityZone} -> Maybe Text
availabilityZone) (\s :: DBInstance
s@DBInstance' {} Maybe Text
a -> DBInstance
s {$sel:availabilityZone:DBInstance' :: Maybe Text
availabilityZone = Maybe Text
a} :: DBInstance)

-- | Specifies the number of days for which automatic snapshots are retained.
dbInstance_backupRetentionPeriod :: Lens.Lens' DBInstance (Prelude.Maybe Prelude.Int)
dbInstance_backupRetentionPeriod :: Lens' DBInstance (Maybe Int)
dbInstance_backupRetentionPeriod = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\DBInstance' {Maybe Int
backupRetentionPeriod :: Maybe Int
$sel:backupRetentionPeriod:DBInstance' :: DBInstance -> Maybe Int
backupRetentionPeriod} -> Maybe Int
backupRetentionPeriod) (\s :: DBInstance
s@DBInstance' {} Maybe Int
a -> DBInstance
s {$sel:backupRetentionPeriod:DBInstance' :: Maybe Int
backupRetentionPeriod = Maybe Int
a} :: DBInstance)

-- | The identifier of the CA certificate for this DB instance.
dbInstance_cACertificateIdentifier :: Lens.Lens' DBInstance (Prelude.Maybe Prelude.Text)
dbInstance_cACertificateIdentifier :: Lens' DBInstance (Maybe Text)
dbInstance_cACertificateIdentifier = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\DBInstance' {Maybe Text
cACertificateIdentifier :: Maybe Text
$sel:cACertificateIdentifier:DBInstance' :: DBInstance -> Maybe Text
cACertificateIdentifier} -> Maybe Text
cACertificateIdentifier) (\s :: DBInstance
s@DBInstance' {} Maybe Text
a -> DBInstance
s {$sel:cACertificateIdentifier:DBInstance' :: Maybe Text
cACertificateIdentifier = Maybe Text
a} :: DBInstance)

-- | A value that indicates whether to copy tags from the DB instance to
-- snapshots of the DB instance. By default, tags are not copied.
dbInstance_copyTagsToSnapshot :: Lens.Lens' DBInstance (Prelude.Maybe Prelude.Bool)
dbInstance_copyTagsToSnapshot :: Lens' DBInstance (Maybe Bool)
dbInstance_copyTagsToSnapshot = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\DBInstance' {Maybe Bool
copyTagsToSnapshot :: Maybe Bool
$sel:copyTagsToSnapshot:DBInstance' :: DBInstance -> Maybe Bool
copyTagsToSnapshot} -> Maybe Bool
copyTagsToSnapshot) (\s :: DBInstance
s@DBInstance' {} Maybe Bool
a -> DBInstance
s {$sel:copyTagsToSnapshot:DBInstance' :: Maybe Bool
copyTagsToSnapshot = Maybe Bool
a} :: DBInstance)

-- | Contains the name of the cluster that the instance is a member of if the
-- instance is a member of a cluster.
dbInstance_dbClusterIdentifier :: Lens.Lens' DBInstance (Prelude.Maybe Prelude.Text)
dbInstance_dbClusterIdentifier :: Lens' DBInstance (Maybe Text)
dbInstance_dbClusterIdentifier = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\DBInstance' {Maybe Text
dbClusterIdentifier :: Maybe Text
$sel:dbClusterIdentifier:DBInstance' :: DBInstance -> Maybe Text
dbClusterIdentifier} -> Maybe Text
dbClusterIdentifier) (\s :: DBInstance
s@DBInstance' {} Maybe Text
a -> DBInstance
s {$sel:dbClusterIdentifier:DBInstance' :: Maybe Text
dbClusterIdentifier = Maybe Text
a} :: DBInstance)

-- | The Amazon Resource Name (ARN) for the instance.
dbInstance_dbInstanceArn :: Lens.Lens' DBInstance (Prelude.Maybe Prelude.Text)
dbInstance_dbInstanceArn :: Lens' DBInstance (Maybe Text)
dbInstance_dbInstanceArn = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\DBInstance' {Maybe Text
dbInstanceArn :: Maybe Text
$sel:dbInstanceArn:DBInstance' :: DBInstance -> Maybe Text
dbInstanceArn} -> Maybe Text
dbInstanceArn) (\s :: DBInstance
s@DBInstance' {} Maybe Text
a -> DBInstance
s {$sel:dbInstanceArn:DBInstance' :: Maybe Text
dbInstanceArn = Maybe Text
a} :: DBInstance)

-- | Contains the name of the compute and memory capacity class of the
-- instance.
dbInstance_dbInstanceClass :: Lens.Lens' DBInstance (Prelude.Maybe Prelude.Text)
dbInstance_dbInstanceClass :: Lens' DBInstance (Maybe Text)
dbInstance_dbInstanceClass = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\DBInstance' {Maybe Text
dbInstanceClass :: Maybe Text
$sel:dbInstanceClass:DBInstance' :: DBInstance -> Maybe Text
dbInstanceClass} -> Maybe Text
dbInstanceClass) (\s :: DBInstance
s@DBInstance' {} Maybe Text
a -> DBInstance
s {$sel:dbInstanceClass:DBInstance' :: Maybe Text
dbInstanceClass = Maybe Text
a} :: DBInstance)

-- | Contains a user-provided database identifier. This identifier is the
-- unique key that identifies an instance.
dbInstance_dbInstanceIdentifier :: Lens.Lens' DBInstance (Prelude.Maybe Prelude.Text)
dbInstance_dbInstanceIdentifier :: Lens' DBInstance (Maybe Text)
dbInstance_dbInstanceIdentifier = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\DBInstance' {Maybe Text
dbInstanceIdentifier :: Maybe Text
$sel:dbInstanceIdentifier:DBInstance' :: DBInstance -> Maybe Text
dbInstanceIdentifier} -> Maybe Text
dbInstanceIdentifier) (\s :: DBInstance
s@DBInstance' {} Maybe Text
a -> DBInstance
s {$sel:dbInstanceIdentifier:DBInstance' :: Maybe Text
dbInstanceIdentifier = Maybe Text
a} :: DBInstance)

-- | Specifies the current state of this database.
dbInstance_dbInstanceStatus :: Lens.Lens' DBInstance (Prelude.Maybe Prelude.Text)
dbInstance_dbInstanceStatus :: Lens' DBInstance (Maybe Text)
dbInstance_dbInstanceStatus = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\DBInstance' {Maybe Text
dbInstanceStatus :: Maybe Text
$sel:dbInstanceStatus:DBInstance' :: DBInstance -> Maybe Text
dbInstanceStatus} -> Maybe Text
dbInstanceStatus) (\s :: DBInstance
s@DBInstance' {} Maybe Text
a -> DBInstance
s {$sel:dbInstanceStatus:DBInstance' :: Maybe Text
dbInstanceStatus = Maybe Text
a} :: DBInstance)

-- | Specifies information on the subnet group that is associated with the
-- instance, including the name, description, and subnets in the subnet
-- group.
dbInstance_dbSubnetGroup :: Lens.Lens' DBInstance (Prelude.Maybe DBSubnetGroup)
dbInstance_dbSubnetGroup :: Lens' DBInstance (Maybe DBSubnetGroup)
dbInstance_dbSubnetGroup = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\DBInstance' {Maybe DBSubnetGroup
dbSubnetGroup :: Maybe DBSubnetGroup
$sel:dbSubnetGroup:DBInstance' :: DBInstance -> Maybe DBSubnetGroup
dbSubnetGroup} -> Maybe DBSubnetGroup
dbSubnetGroup) (\s :: DBInstance
s@DBInstance' {} Maybe DBSubnetGroup
a -> DBInstance
s {$sel:dbSubnetGroup:DBInstance' :: Maybe DBSubnetGroup
dbSubnetGroup = Maybe DBSubnetGroup
a} :: DBInstance)

-- | The Amazon Web Services Region-unique, immutable identifier for the
-- instance. This identifier is found in CloudTrail log entries whenever
-- the KMS key for the instance is accessed.
dbInstance_dbiResourceId :: Lens.Lens' DBInstance (Prelude.Maybe Prelude.Text)
dbInstance_dbiResourceId :: Lens' DBInstance (Maybe Text)
dbInstance_dbiResourceId = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\DBInstance' {Maybe Text
dbiResourceId :: Maybe Text
$sel:dbiResourceId:DBInstance' :: DBInstance -> Maybe Text
dbiResourceId} -> Maybe Text
dbiResourceId) (\s :: DBInstance
s@DBInstance' {} Maybe Text
a -> DBInstance
s {$sel:dbiResourceId:DBInstance' :: Maybe Text
dbiResourceId = Maybe Text
a} :: DBInstance)

-- | A list of log types that this instance is configured to export to
-- CloudWatch Logs.
dbInstance_enabledCloudwatchLogsExports :: Lens.Lens' DBInstance (Prelude.Maybe [Prelude.Text])
dbInstance_enabledCloudwatchLogsExports :: Lens' DBInstance (Maybe [Text])
dbInstance_enabledCloudwatchLogsExports = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\DBInstance' {Maybe [Text]
enabledCloudwatchLogsExports :: Maybe [Text]
$sel:enabledCloudwatchLogsExports:DBInstance' :: DBInstance -> Maybe [Text]
enabledCloudwatchLogsExports} -> Maybe [Text]
enabledCloudwatchLogsExports) (\s :: DBInstance
s@DBInstance' {} Maybe [Text]
a -> DBInstance
s {$sel:enabledCloudwatchLogsExports:DBInstance' :: Maybe [Text]
enabledCloudwatchLogsExports = Maybe [Text]
a} :: DBInstance) 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

-- | Specifies the connection endpoint.
dbInstance_endpoint :: Lens.Lens' DBInstance (Prelude.Maybe Endpoint)
dbInstance_endpoint :: Lens' DBInstance (Maybe Endpoint)
dbInstance_endpoint = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\DBInstance' {Maybe Endpoint
endpoint :: Maybe Endpoint
$sel:endpoint:DBInstance' :: DBInstance -> Maybe Endpoint
endpoint} -> Maybe Endpoint
endpoint) (\s :: DBInstance
s@DBInstance' {} Maybe Endpoint
a -> DBInstance
s {$sel:endpoint:DBInstance' :: Maybe Endpoint
endpoint = Maybe Endpoint
a} :: DBInstance)

-- | Provides the name of the database engine to be used for this instance.
dbInstance_engine :: Lens.Lens' DBInstance (Prelude.Maybe Prelude.Text)
dbInstance_engine :: Lens' DBInstance (Maybe Text)
dbInstance_engine = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\DBInstance' {Maybe Text
engine :: Maybe Text
$sel:engine:DBInstance' :: DBInstance -> Maybe Text
engine} -> Maybe Text
engine) (\s :: DBInstance
s@DBInstance' {} Maybe Text
a -> DBInstance
s {$sel:engine:DBInstance' :: Maybe Text
engine = Maybe Text
a} :: DBInstance)

-- | Indicates the database engine version.
dbInstance_engineVersion :: Lens.Lens' DBInstance (Prelude.Maybe Prelude.Text)
dbInstance_engineVersion :: Lens' DBInstance (Maybe Text)
dbInstance_engineVersion = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\DBInstance' {Maybe Text
engineVersion :: Maybe Text
$sel:engineVersion:DBInstance' :: DBInstance -> Maybe Text
engineVersion} -> Maybe Text
engineVersion) (\s :: DBInstance
s@DBInstance' {} Maybe Text
a -> DBInstance
s {$sel:engineVersion:DBInstance' :: Maybe Text
engineVersion = Maybe Text
a} :: DBInstance)

-- | Provides the date and time that the instance was created.
dbInstance_instanceCreateTime :: Lens.Lens' DBInstance (Prelude.Maybe Prelude.UTCTime)
dbInstance_instanceCreateTime :: Lens' DBInstance (Maybe UTCTime)
dbInstance_instanceCreateTime = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\DBInstance' {Maybe ISO8601
instanceCreateTime :: Maybe ISO8601
$sel:instanceCreateTime:DBInstance' :: DBInstance -> Maybe ISO8601
instanceCreateTime} -> Maybe ISO8601
instanceCreateTime) (\s :: DBInstance
s@DBInstance' {} Maybe ISO8601
a -> DBInstance
s {$sel:instanceCreateTime:DBInstance' :: Maybe ISO8601
instanceCreateTime = Maybe ISO8601
a} :: DBInstance) 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

-- | If @StorageEncrypted@ is @true@, the KMS key identifier for the
-- encrypted instance.
dbInstance_kmsKeyId :: Lens.Lens' DBInstance (Prelude.Maybe Prelude.Text)
dbInstance_kmsKeyId :: Lens' DBInstance (Maybe Text)
dbInstance_kmsKeyId = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\DBInstance' {Maybe Text
kmsKeyId :: Maybe Text
$sel:kmsKeyId:DBInstance' :: DBInstance -> Maybe Text
kmsKeyId} -> Maybe Text
kmsKeyId) (\s :: DBInstance
s@DBInstance' {} Maybe Text
a -> DBInstance
s {$sel:kmsKeyId:DBInstance' :: Maybe Text
kmsKeyId = Maybe Text
a} :: DBInstance)

-- | Specifies the latest time to which a database can be restored with
-- point-in-time restore.
dbInstance_latestRestorableTime :: Lens.Lens' DBInstance (Prelude.Maybe Prelude.UTCTime)
dbInstance_latestRestorableTime :: Lens' DBInstance (Maybe UTCTime)
dbInstance_latestRestorableTime = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\DBInstance' {Maybe ISO8601
latestRestorableTime :: Maybe ISO8601
$sel:latestRestorableTime:DBInstance' :: DBInstance -> Maybe ISO8601
latestRestorableTime} -> Maybe ISO8601
latestRestorableTime) (\s :: DBInstance
s@DBInstance' {} Maybe ISO8601
a -> DBInstance
s {$sel:latestRestorableTime:DBInstance' :: Maybe ISO8601
latestRestorableTime = Maybe ISO8601
a} :: DBInstance) 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 that changes to the instance are pending. This element is
-- included only when changes are pending. Specific changes are identified
-- by subelements.
dbInstance_pendingModifiedValues :: Lens.Lens' DBInstance (Prelude.Maybe PendingModifiedValues)
dbInstance_pendingModifiedValues :: Lens' DBInstance (Maybe PendingModifiedValues)
dbInstance_pendingModifiedValues = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\DBInstance' {Maybe PendingModifiedValues
pendingModifiedValues :: Maybe PendingModifiedValues
$sel:pendingModifiedValues:DBInstance' :: DBInstance -> Maybe PendingModifiedValues
pendingModifiedValues} -> Maybe PendingModifiedValues
pendingModifiedValues) (\s :: DBInstance
s@DBInstance' {} Maybe PendingModifiedValues
a -> DBInstance
s {$sel:pendingModifiedValues:DBInstance' :: Maybe PendingModifiedValues
pendingModifiedValues = Maybe PendingModifiedValues
a} :: DBInstance)

-- | Specifies the daily time range during which automated backups are
-- created if automated backups are enabled, as determined by the
-- @BackupRetentionPeriod@.
dbInstance_preferredBackupWindow :: Lens.Lens' DBInstance (Prelude.Maybe Prelude.Text)
dbInstance_preferredBackupWindow :: Lens' DBInstance (Maybe Text)
dbInstance_preferredBackupWindow = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\DBInstance' {Maybe Text
preferredBackupWindow :: Maybe Text
$sel:preferredBackupWindow:DBInstance' :: DBInstance -> Maybe Text
preferredBackupWindow} -> Maybe Text
preferredBackupWindow) (\s :: DBInstance
s@DBInstance' {} Maybe Text
a -> DBInstance
s {$sel:preferredBackupWindow:DBInstance' :: Maybe Text
preferredBackupWindow = Maybe Text
a} :: DBInstance)

-- | Specifies the weekly time range during which system maintenance can
-- occur, in Universal Coordinated Time (UTC).
dbInstance_preferredMaintenanceWindow :: Lens.Lens' DBInstance (Prelude.Maybe Prelude.Text)
dbInstance_preferredMaintenanceWindow :: Lens' DBInstance (Maybe Text)
dbInstance_preferredMaintenanceWindow = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\DBInstance' {Maybe Text
preferredMaintenanceWindow :: Maybe Text
$sel:preferredMaintenanceWindow:DBInstance' :: DBInstance -> Maybe Text
preferredMaintenanceWindow} -> Maybe Text
preferredMaintenanceWindow) (\s :: DBInstance
s@DBInstance' {} Maybe Text
a -> DBInstance
s {$sel:preferredMaintenanceWindow:DBInstance' :: Maybe Text
preferredMaintenanceWindow = Maybe Text
a} :: DBInstance)

-- | A value that specifies the order in which an Amazon DocumentDB replica
-- is promoted to the primary instance after a failure of the existing
-- primary instance.
dbInstance_promotionTier :: Lens.Lens' DBInstance (Prelude.Maybe Prelude.Int)
dbInstance_promotionTier :: Lens' DBInstance (Maybe Int)
dbInstance_promotionTier = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\DBInstance' {Maybe Int
promotionTier :: Maybe Int
$sel:promotionTier:DBInstance' :: DBInstance -> Maybe Int
promotionTier} -> Maybe Int
promotionTier) (\s :: DBInstance
s@DBInstance' {} Maybe Int
a -> DBInstance
s {$sel:promotionTier:DBInstance' :: Maybe Int
promotionTier = Maybe Int
a} :: DBInstance)

-- | Not supported. Amazon DocumentDB does not currently support public
-- endpoints. The value of @PubliclyAccessible@ is always @false@.
dbInstance_publiclyAccessible :: Lens.Lens' DBInstance (Prelude.Maybe Prelude.Bool)
dbInstance_publiclyAccessible :: Lens' DBInstance (Maybe Bool)
dbInstance_publiclyAccessible = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\DBInstance' {Maybe Bool
publiclyAccessible :: Maybe Bool
$sel:publiclyAccessible:DBInstance' :: DBInstance -> Maybe Bool
publiclyAccessible} -> Maybe Bool
publiclyAccessible) (\s :: DBInstance
s@DBInstance' {} Maybe Bool
a -> DBInstance
s {$sel:publiclyAccessible:DBInstance' :: Maybe Bool
publiclyAccessible = Maybe Bool
a} :: DBInstance)

-- | The status of a read replica. If the instance is not a read replica,
-- this is blank.
dbInstance_statusInfos :: Lens.Lens' DBInstance (Prelude.Maybe [DBInstanceStatusInfo])
dbInstance_statusInfos :: Lens' DBInstance (Maybe [DBInstanceStatusInfo])
dbInstance_statusInfos = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\DBInstance' {Maybe [DBInstanceStatusInfo]
statusInfos :: Maybe [DBInstanceStatusInfo]
$sel:statusInfos:DBInstance' :: DBInstance -> Maybe [DBInstanceStatusInfo]
statusInfos} -> Maybe [DBInstanceStatusInfo]
statusInfos) (\s :: DBInstance
s@DBInstance' {} Maybe [DBInstanceStatusInfo]
a -> DBInstance
s {$sel:statusInfos:DBInstance' :: Maybe [DBInstanceStatusInfo]
statusInfos = Maybe [DBInstanceStatusInfo]
a} :: DBInstance) 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

-- | Specifies whether or not the instance is encrypted.
dbInstance_storageEncrypted :: Lens.Lens' DBInstance (Prelude.Maybe Prelude.Bool)
dbInstance_storageEncrypted :: Lens' DBInstance (Maybe Bool)
dbInstance_storageEncrypted = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\DBInstance' {Maybe Bool
storageEncrypted :: Maybe Bool
$sel:storageEncrypted:DBInstance' :: DBInstance -> Maybe Bool
storageEncrypted} -> Maybe Bool
storageEncrypted) (\s :: DBInstance
s@DBInstance' {} Maybe Bool
a -> DBInstance
s {$sel:storageEncrypted:DBInstance' :: Maybe Bool
storageEncrypted = Maybe Bool
a} :: DBInstance)

-- | Provides a list of VPC security group elements that the instance belongs
-- to.
dbInstance_vpcSecurityGroups :: Lens.Lens' DBInstance (Prelude.Maybe [VpcSecurityGroupMembership])
dbInstance_vpcSecurityGroups :: Lens' DBInstance (Maybe [VpcSecurityGroupMembership])
dbInstance_vpcSecurityGroups = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\DBInstance' {Maybe [VpcSecurityGroupMembership]
vpcSecurityGroups :: Maybe [VpcSecurityGroupMembership]
$sel:vpcSecurityGroups:DBInstance' :: DBInstance -> Maybe [VpcSecurityGroupMembership]
vpcSecurityGroups} -> Maybe [VpcSecurityGroupMembership]
vpcSecurityGroups) (\s :: DBInstance
s@DBInstance' {} Maybe [VpcSecurityGroupMembership]
a -> DBInstance
s {$sel:vpcSecurityGroups:DBInstance' :: Maybe [VpcSecurityGroupMembership]
vpcSecurityGroups = Maybe [VpcSecurityGroupMembership]
a} :: DBInstance) 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 DBInstance where
  parseXML :: [Node] -> Either String DBInstance
parseXML [Node]
x =
    Maybe Bool
-> Maybe Text
-> Maybe Int
-> Maybe Text
-> Maybe Bool
-> Maybe Text
-> Maybe Text
-> Maybe Text
-> Maybe Text
-> Maybe Text
-> Maybe DBSubnetGroup
-> Maybe Text
-> Maybe [Text]
-> Maybe Endpoint
-> Maybe Text
-> Maybe Text
-> Maybe ISO8601
-> Maybe Text
-> Maybe ISO8601
-> Maybe PendingModifiedValues
-> Maybe Text
-> Maybe Text
-> Maybe Int
-> Maybe Bool
-> Maybe [DBInstanceStatusInfo]
-> Maybe Bool
-> Maybe [VpcSecurityGroupMembership]
-> DBInstance
DBInstance'
      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
"AutoMinorVersionUpgrade")
      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
"AvailabilityZone")
      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
"BackupRetentionPeriod")
      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
"CACertificateIdentifier")
      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
"CopyTagsToSnapshot")
      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
"DBClusterIdentifier")
      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
"DBInstanceArn")
      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
"DBInstanceClass")
      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
"DBInstanceIdentifier")
      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
"DBInstanceStatus")
      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
"DBSubnetGroup")
      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
"DbiResourceId")
      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
"EnabledCloudwatchLogsExports"
                      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
"Endpoint")
      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
"Engine")
      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
"EngineVersion")
      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
"InstanceCreateTime")
      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
"KmsKeyId")
      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
"LatestRestorableTime")
      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
"PendingModifiedValues")
      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
"PreferredBackupWindow")
      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
"PreferredMaintenanceWindow")
      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
"PromotionTier")
      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
"PubliclyAccessible")
      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
"StatusInfos"
                      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
"DBInstanceStatusInfo")
                  )
      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
"StorageEncrypted")
      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
"VpcSecurityGroups"
                      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
"VpcSecurityGroupMembership")
                  )

instance Prelude.Hashable DBInstance where
  hashWithSalt :: Int -> DBInstance -> Int
hashWithSalt Int
_salt DBInstance' {Maybe Bool
Maybe Int
Maybe [Text]
Maybe [DBInstanceStatusInfo]
Maybe [VpcSecurityGroupMembership]
Maybe Text
Maybe ISO8601
Maybe Endpoint
Maybe PendingModifiedValues
Maybe DBSubnetGroup
vpcSecurityGroups :: Maybe [VpcSecurityGroupMembership]
storageEncrypted :: Maybe Bool
statusInfos :: Maybe [DBInstanceStatusInfo]
publiclyAccessible :: Maybe Bool
promotionTier :: Maybe Int
preferredMaintenanceWindow :: Maybe Text
preferredBackupWindow :: Maybe Text
pendingModifiedValues :: Maybe PendingModifiedValues
latestRestorableTime :: Maybe ISO8601
kmsKeyId :: Maybe Text
instanceCreateTime :: Maybe ISO8601
engineVersion :: Maybe Text
engine :: Maybe Text
endpoint :: Maybe Endpoint
enabledCloudwatchLogsExports :: Maybe [Text]
dbiResourceId :: Maybe Text
dbSubnetGroup :: Maybe DBSubnetGroup
dbInstanceStatus :: Maybe Text
dbInstanceIdentifier :: Maybe Text
dbInstanceClass :: Maybe Text
dbInstanceArn :: Maybe Text
dbClusterIdentifier :: Maybe Text
copyTagsToSnapshot :: Maybe Bool
cACertificateIdentifier :: Maybe Text
backupRetentionPeriod :: Maybe Int
availabilityZone :: Maybe Text
autoMinorVersionUpgrade :: Maybe Bool
$sel:vpcSecurityGroups:DBInstance' :: DBInstance -> Maybe [VpcSecurityGroupMembership]
$sel:storageEncrypted:DBInstance' :: DBInstance -> Maybe Bool
$sel:statusInfos:DBInstance' :: DBInstance -> Maybe [DBInstanceStatusInfo]
$sel:publiclyAccessible:DBInstance' :: DBInstance -> Maybe Bool
$sel:promotionTier:DBInstance' :: DBInstance -> Maybe Int
$sel:preferredMaintenanceWindow:DBInstance' :: DBInstance -> Maybe Text
$sel:preferredBackupWindow:DBInstance' :: DBInstance -> Maybe Text
$sel:pendingModifiedValues:DBInstance' :: DBInstance -> Maybe PendingModifiedValues
$sel:latestRestorableTime:DBInstance' :: DBInstance -> Maybe ISO8601
$sel:kmsKeyId:DBInstance' :: DBInstance -> Maybe Text
$sel:instanceCreateTime:DBInstance' :: DBInstance -> Maybe ISO8601
$sel:engineVersion:DBInstance' :: DBInstance -> Maybe Text
$sel:engine:DBInstance' :: DBInstance -> Maybe Text
$sel:endpoint:DBInstance' :: DBInstance -> Maybe Endpoint
$sel:enabledCloudwatchLogsExports:DBInstance' :: DBInstance -> Maybe [Text]
$sel:dbiResourceId:DBInstance' :: DBInstance -> Maybe Text
$sel:dbSubnetGroup:DBInstance' :: DBInstance -> Maybe DBSubnetGroup
$sel:dbInstanceStatus:DBInstance' :: DBInstance -> Maybe Text
$sel:dbInstanceIdentifier:DBInstance' :: DBInstance -> Maybe Text
$sel:dbInstanceClass:DBInstance' :: DBInstance -> Maybe Text
$sel:dbInstanceArn:DBInstance' :: DBInstance -> Maybe Text
$sel:dbClusterIdentifier:DBInstance' :: DBInstance -> Maybe Text
$sel:copyTagsToSnapshot:DBInstance' :: DBInstance -> Maybe Bool
$sel:cACertificateIdentifier:DBInstance' :: DBInstance -> Maybe Text
$sel:backupRetentionPeriod:DBInstance' :: DBInstance -> Maybe Int
$sel:availabilityZone:DBInstance' :: DBInstance -> Maybe Text
$sel:autoMinorVersionUpgrade:DBInstance' :: DBInstance -> Maybe Bool
..} =
    Int
_salt
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Bool
autoMinorVersionUpgrade
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Text
availabilityZone
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Int
backupRetentionPeriod
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Text
cACertificateIdentifier
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Bool
copyTagsToSnapshot
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Text
dbClusterIdentifier
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Text
dbInstanceArn
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Text
dbInstanceClass
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Text
dbInstanceIdentifier
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Text
dbInstanceStatus
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe DBSubnetGroup
dbSubnetGroup
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Text
dbiResourceId
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe [Text]
enabledCloudwatchLogsExports
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Endpoint
endpoint
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Text
engine
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Text
engineVersion
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe ISO8601
instanceCreateTime
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Text
kmsKeyId
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe ISO8601
latestRestorableTime
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe PendingModifiedValues
pendingModifiedValues
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Text
preferredBackupWindow
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Text
preferredMaintenanceWindow
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Int
promotionTier
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Bool
publiclyAccessible
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe [DBInstanceStatusInfo]
statusInfos
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Bool
storageEncrypted
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe [VpcSecurityGroupMembership]
vpcSecurityGroups

instance Prelude.NFData DBInstance where
  rnf :: DBInstance -> ()
rnf DBInstance' {Maybe Bool
Maybe Int
Maybe [Text]
Maybe [DBInstanceStatusInfo]
Maybe [VpcSecurityGroupMembership]
Maybe Text
Maybe ISO8601
Maybe Endpoint
Maybe PendingModifiedValues
Maybe DBSubnetGroup
vpcSecurityGroups :: Maybe [VpcSecurityGroupMembership]
storageEncrypted :: Maybe Bool
statusInfos :: Maybe [DBInstanceStatusInfo]
publiclyAccessible :: Maybe Bool
promotionTier :: Maybe Int
preferredMaintenanceWindow :: Maybe Text
preferredBackupWindow :: Maybe Text
pendingModifiedValues :: Maybe PendingModifiedValues
latestRestorableTime :: Maybe ISO8601
kmsKeyId :: Maybe Text
instanceCreateTime :: Maybe ISO8601
engineVersion :: Maybe Text
engine :: Maybe Text
endpoint :: Maybe Endpoint
enabledCloudwatchLogsExports :: Maybe [Text]
dbiResourceId :: Maybe Text
dbSubnetGroup :: Maybe DBSubnetGroup
dbInstanceStatus :: Maybe Text
dbInstanceIdentifier :: Maybe Text
dbInstanceClass :: Maybe Text
dbInstanceArn :: Maybe Text
dbClusterIdentifier :: Maybe Text
copyTagsToSnapshot :: Maybe Bool
cACertificateIdentifier :: Maybe Text
backupRetentionPeriod :: Maybe Int
availabilityZone :: Maybe Text
autoMinorVersionUpgrade :: Maybe Bool
$sel:vpcSecurityGroups:DBInstance' :: DBInstance -> Maybe [VpcSecurityGroupMembership]
$sel:storageEncrypted:DBInstance' :: DBInstance -> Maybe Bool
$sel:statusInfos:DBInstance' :: DBInstance -> Maybe [DBInstanceStatusInfo]
$sel:publiclyAccessible:DBInstance' :: DBInstance -> Maybe Bool
$sel:promotionTier:DBInstance' :: DBInstance -> Maybe Int
$sel:preferredMaintenanceWindow:DBInstance' :: DBInstance -> Maybe Text
$sel:preferredBackupWindow:DBInstance' :: DBInstance -> Maybe Text
$sel:pendingModifiedValues:DBInstance' :: DBInstance -> Maybe PendingModifiedValues
$sel:latestRestorableTime:DBInstance' :: DBInstance -> Maybe ISO8601
$sel:kmsKeyId:DBInstance' :: DBInstance -> Maybe Text
$sel:instanceCreateTime:DBInstance' :: DBInstance -> Maybe ISO8601
$sel:engineVersion:DBInstance' :: DBInstance -> Maybe Text
$sel:engine:DBInstance' :: DBInstance -> Maybe Text
$sel:endpoint:DBInstance' :: DBInstance -> Maybe Endpoint
$sel:enabledCloudwatchLogsExports:DBInstance' :: DBInstance -> Maybe [Text]
$sel:dbiResourceId:DBInstance' :: DBInstance -> Maybe Text
$sel:dbSubnetGroup:DBInstance' :: DBInstance -> Maybe DBSubnetGroup
$sel:dbInstanceStatus:DBInstance' :: DBInstance -> Maybe Text
$sel:dbInstanceIdentifier:DBInstance' :: DBInstance -> Maybe Text
$sel:dbInstanceClass:DBInstance' :: DBInstance -> Maybe Text
$sel:dbInstanceArn:DBInstance' :: DBInstance -> Maybe Text
$sel:dbClusterIdentifier:DBInstance' :: DBInstance -> Maybe Text
$sel:copyTagsToSnapshot:DBInstance' :: DBInstance -> Maybe Bool
$sel:cACertificateIdentifier:DBInstance' :: DBInstance -> Maybe Text
$sel:backupRetentionPeriod:DBInstance' :: DBInstance -> Maybe Int
$sel:availabilityZone:DBInstance' :: DBInstance -> Maybe Text
$sel:autoMinorVersionUpgrade:DBInstance' :: DBInstance -> Maybe Bool
..} =
    forall a. NFData a => a -> ()
Prelude.rnf Maybe Bool
autoMinorVersionUpgrade
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Text
availabilityZone
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Int
backupRetentionPeriod
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Text
cACertificateIdentifier
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Bool
copyTagsToSnapshot
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Text
dbClusterIdentifier
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Text
dbInstanceArn
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Text
dbInstanceClass
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Text
dbInstanceIdentifier
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Text
dbInstanceStatus
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe DBSubnetGroup
dbSubnetGroup
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Text
dbiResourceId
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe [Text]
enabledCloudwatchLogsExports
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Endpoint
endpoint
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Text
engine
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Text
engineVersion
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe ISO8601
instanceCreateTime
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Text
kmsKeyId
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe ISO8601
latestRestorableTime
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf
        Maybe PendingModifiedValues
pendingModifiedValues
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf
        Maybe Text
preferredBackupWindow
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf
        Maybe Text
preferredMaintenanceWindow
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf
        Maybe Int
promotionTier
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf
        Maybe Bool
publiclyAccessible
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf
        Maybe [DBInstanceStatusInfo]
statusInfos
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf
        Maybe Bool
storageEncrypted
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf
        Maybe [VpcSecurityGroupMembership]
vpcSecurityGroups