{-# LANGUAGE DisambiguateRecordFields #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE StrictData #-}
{-# LANGUAGE NoImplicitPrelude #-}
{-# OPTIONS_GHC -fno-warn-unused-matches #-}

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

-- |
-- Module      : Amazonka.DocumentDB.Types
-- 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
  ( -- * Service Configuration
    defaultService,

    -- * Errors
    _AuthorizationNotFoundFault,
    _CertificateNotFoundFault,
    _DBClusterAlreadyExistsFault,
    _DBClusterNotFoundFault,
    _DBClusterParameterGroupNotFoundFault,
    _DBClusterQuotaExceededFault,
    _DBClusterSnapshotAlreadyExistsFault,
    _DBClusterSnapshotNotFoundFault,
    _DBInstanceAlreadyExistsFault,
    _DBInstanceNotFoundFault,
    _DBParameterGroupAlreadyExistsFault,
    _DBParameterGroupNotFoundFault,
    _DBParameterGroupQuotaExceededFault,
    _DBSecurityGroupNotFoundFault,
    _DBSnapshotAlreadyExistsFault,
    _DBSnapshotNotFoundFault,
    _DBSubnetGroupAlreadyExistsFault,
    _DBSubnetGroupDoesNotCoverEnoughAZs,
    _DBSubnetGroupNotFoundFault,
    _DBSubnetGroupQuotaExceededFault,
    _DBSubnetQuotaExceededFault,
    _DBUpgradeDependencyFailureFault,
    _EventSubscriptionQuotaExceededFault,
    _GlobalClusterAlreadyExistsFault,
    _GlobalClusterNotFoundFault,
    _GlobalClusterQuotaExceededFault,
    _InstanceQuotaExceededFault,
    _InsufficientDBClusterCapacityFault,
    _InsufficientDBInstanceCapacityFault,
    _InsufficientStorageClusterCapacityFault,
    _InvalidDBClusterSnapshotStateFault,
    _InvalidDBClusterStateFault,
    _InvalidDBInstanceStateFault,
    _InvalidDBParameterGroupStateFault,
    _InvalidDBSecurityGroupStateFault,
    _InvalidDBSnapshotStateFault,
    _InvalidDBSubnetGroupStateFault,
    _InvalidDBSubnetStateFault,
    _InvalidEventSubscriptionStateFault,
    _InvalidGlobalClusterStateFault,
    _InvalidRestoreFault,
    _InvalidSubnet,
    _InvalidVPCNetworkStateFault,
    _KMSKeyNotAccessibleFault,
    _ResourceNotFoundFault,
    _SNSInvalidTopicFault,
    _SNSNoAuthorizationFault,
    _SNSTopicArnNotFoundFault,
    _SharedSnapshotQuotaExceededFault,
    _SnapshotQuotaExceededFault,
    _SourceNotFoundFault,
    _StorageQuotaExceededFault,
    _StorageTypeNotSupportedFault,
    _SubnetAlreadyInUse,
    _SubscriptionAlreadyExistFault,
    _SubscriptionCategoryNotFoundFault,
    _SubscriptionNotFoundFault,

    -- * ApplyMethod
    ApplyMethod (..),

    -- * SourceType
    SourceType (..),

    -- * AvailabilityZone
    AvailabilityZone (..),
    newAvailabilityZone,
    availabilityZone_name,

    -- * Certificate
    Certificate (..),
    newCertificate,
    certificate_certificateArn,
    certificate_certificateIdentifier,
    certificate_certificateType,
    certificate_thumbprint,
    certificate_validFrom,
    certificate_validTill,

    -- * CloudwatchLogsExportConfiguration
    CloudwatchLogsExportConfiguration (..),
    newCloudwatchLogsExportConfiguration,
    cloudwatchLogsExportConfiguration_disableLogTypes,
    cloudwatchLogsExportConfiguration_enableLogTypes,

    -- * DBCluster
    DBCluster (..),
    newDBCluster,
    dbCluster_associatedRoles,
    dbCluster_availabilityZones,
    dbCluster_backupRetentionPeriod,
    dbCluster_cloneGroupId,
    dbCluster_clusterCreateTime,
    dbCluster_dbClusterArn,
    dbCluster_dbClusterIdentifier,
    dbCluster_dbClusterMembers,
    dbCluster_dbClusterParameterGroup,
    dbCluster_dbSubnetGroup,
    dbCluster_dbClusterResourceId,
    dbCluster_deletionProtection,
    dbCluster_earliestRestorableTime,
    dbCluster_enabledCloudwatchLogsExports,
    dbCluster_endpoint,
    dbCluster_engine,
    dbCluster_engineVersion,
    dbCluster_hostedZoneId,
    dbCluster_kmsKeyId,
    dbCluster_latestRestorableTime,
    dbCluster_masterUsername,
    dbCluster_multiAZ,
    dbCluster_percentProgress,
    dbCluster_port,
    dbCluster_preferredBackupWindow,
    dbCluster_preferredMaintenanceWindow,
    dbCluster_readReplicaIdentifiers,
    dbCluster_readerEndpoint,
    dbCluster_replicationSourceIdentifier,
    dbCluster_status,
    dbCluster_storageEncrypted,
    dbCluster_vpcSecurityGroups,

    -- * DBClusterMember
    DBClusterMember (..),
    newDBClusterMember,
    dbClusterMember_dbClusterParameterGroupStatus,
    dbClusterMember_dbInstanceIdentifier,
    dbClusterMember_isClusterWriter,
    dbClusterMember_promotionTier,

    -- * DBClusterParameterGroup
    DBClusterParameterGroup (..),
    newDBClusterParameterGroup,
    dbClusterParameterGroup_dbClusterParameterGroupArn,
    dbClusterParameterGroup_dbClusterParameterGroupName,
    dbClusterParameterGroup_dbParameterGroupFamily,
    dbClusterParameterGroup_description,

    -- * DBClusterParameterGroupNameMessage
    DBClusterParameterGroupNameMessage (..),
    newDBClusterParameterGroupNameMessage,
    dbClusterParameterGroupNameMessage_dbClusterParameterGroupName,

    -- * DBClusterRole
    DBClusterRole (..),
    newDBClusterRole,
    dbClusterRole_roleArn,
    dbClusterRole_status,

    -- * DBClusterSnapshot
    DBClusterSnapshot (..),
    newDBClusterSnapshot,
    dbClusterSnapshot_availabilityZones,
    dbClusterSnapshot_clusterCreateTime,
    dbClusterSnapshot_dbClusterIdentifier,
    dbClusterSnapshot_dbClusterSnapshotArn,
    dbClusterSnapshot_dbClusterSnapshotIdentifier,
    dbClusterSnapshot_engine,
    dbClusterSnapshot_engineVersion,
    dbClusterSnapshot_kmsKeyId,
    dbClusterSnapshot_masterUsername,
    dbClusterSnapshot_percentProgress,
    dbClusterSnapshot_port,
    dbClusterSnapshot_snapshotCreateTime,
    dbClusterSnapshot_snapshotType,
    dbClusterSnapshot_sourceDBClusterSnapshotArn,
    dbClusterSnapshot_status,
    dbClusterSnapshot_storageEncrypted,
    dbClusterSnapshot_vpcId,

    -- * DBClusterSnapshotAttribute
    DBClusterSnapshotAttribute (..),
    newDBClusterSnapshotAttribute,
    dbClusterSnapshotAttribute_attributeName,
    dbClusterSnapshotAttribute_attributeValues,

    -- * DBClusterSnapshotAttributesResult
    DBClusterSnapshotAttributesResult (..),
    newDBClusterSnapshotAttributesResult,
    dbClusterSnapshotAttributesResult_dbClusterSnapshotAttributes,
    dbClusterSnapshotAttributesResult_dbClusterSnapshotIdentifier,

    -- * DBEngineVersion
    DBEngineVersion (..),
    newDBEngineVersion,
    dbEngineVersion_dbEngineDescription,
    dbEngineVersion_dbEngineVersionDescription,
    dbEngineVersion_dbParameterGroupFamily,
    dbEngineVersion_engine,
    dbEngineVersion_engineVersion,
    dbEngineVersion_exportableLogTypes,
    dbEngineVersion_supportsLogExportsToCloudwatchLogs,
    dbEngineVersion_validUpgradeTarget,

    -- * DBInstance
    DBInstance (..),
    newDBInstance,
    dbInstance_autoMinorVersionUpgrade,
    dbInstance_availabilityZone,
    dbInstance_backupRetentionPeriod,
    dbInstance_cACertificateIdentifier,
    dbInstance_copyTagsToSnapshot,
    dbInstance_dbClusterIdentifier,
    dbInstance_dbInstanceArn,
    dbInstance_dbInstanceClass,
    dbInstance_dbInstanceIdentifier,
    dbInstance_dbInstanceStatus,
    dbInstance_dbSubnetGroup,
    dbInstance_dbiResourceId,
    dbInstance_enabledCloudwatchLogsExports,
    dbInstance_endpoint,
    dbInstance_engine,
    dbInstance_engineVersion,
    dbInstance_instanceCreateTime,
    dbInstance_kmsKeyId,
    dbInstance_latestRestorableTime,
    dbInstance_pendingModifiedValues,
    dbInstance_preferredBackupWindow,
    dbInstance_preferredMaintenanceWindow,
    dbInstance_promotionTier,
    dbInstance_publiclyAccessible,
    dbInstance_statusInfos,
    dbInstance_storageEncrypted,
    dbInstance_vpcSecurityGroups,

    -- * DBInstanceStatusInfo
    DBInstanceStatusInfo (..),
    newDBInstanceStatusInfo,
    dbInstanceStatusInfo_message,
    dbInstanceStatusInfo_normal,
    dbInstanceStatusInfo_status,
    dbInstanceStatusInfo_statusType,

    -- * DBSubnetGroup
    DBSubnetGroup (..),
    newDBSubnetGroup,
    dbSubnetGroup_dbSubnetGroupArn,
    dbSubnetGroup_dbSubnetGroupDescription,
    dbSubnetGroup_dbSubnetGroupName,
    dbSubnetGroup_subnetGroupStatus,
    dbSubnetGroup_subnets,
    dbSubnetGroup_vpcId,

    -- * Endpoint
    Endpoint (..),
    newEndpoint,
    endpoint_address,
    endpoint_hostedZoneId,
    endpoint_port,

    -- * EngineDefaults
    EngineDefaults (..),
    newEngineDefaults,
    engineDefaults_dbParameterGroupFamily,
    engineDefaults_marker,
    engineDefaults_parameters,

    -- * Event
    Event (..),
    newEvent,
    event_date,
    event_eventCategories,
    event_message,
    event_sourceArn,
    event_sourceIdentifier,
    event_sourceType,

    -- * EventCategoriesMap
    EventCategoriesMap (..),
    newEventCategoriesMap,
    eventCategoriesMap_eventCategories,
    eventCategoriesMap_sourceType,

    -- * EventSubscription
    EventSubscription (..),
    newEventSubscription,
    eventSubscription_custSubscriptionId,
    eventSubscription_customerAwsId,
    eventSubscription_enabled,
    eventSubscription_eventCategoriesList,
    eventSubscription_eventSubscriptionArn,
    eventSubscription_snsTopicArn,
    eventSubscription_sourceIdsList,
    eventSubscription_sourceType,
    eventSubscription_status,
    eventSubscription_subscriptionCreationTime,

    -- * Filter
    Filter (..),
    newFilter,
    filter_name,
    filter_values,

    -- * GlobalCluster
    GlobalCluster (..),
    newGlobalCluster,
    globalCluster_databaseName,
    globalCluster_deletionProtection,
    globalCluster_engine,
    globalCluster_engineVersion,
    globalCluster_globalClusterArn,
    globalCluster_globalClusterIdentifier,
    globalCluster_globalClusterMembers,
    globalCluster_globalClusterResourceId,
    globalCluster_status,
    globalCluster_storageEncrypted,

    -- * GlobalClusterMember
    GlobalClusterMember (..),
    newGlobalClusterMember,
    globalClusterMember_dbClusterArn,
    globalClusterMember_isWriter,
    globalClusterMember_readers,

    -- * OrderableDBInstanceOption
    OrderableDBInstanceOption (..),
    newOrderableDBInstanceOption,
    orderableDBInstanceOption_availabilityZones,
    orderableDBInstanceOption_dbInstanceClass,
    orderableDBInstanceOption_engine,
    orderableDBInstanceOption_engineVersion,
    orderableDBInstanceOption_licenseModel,
    orderableDBInstanceOption_vpc,

    -- * Parameter
    Parameter (..),
    newParameter,
    parameter_allowedValues,
    parameter_applyMethod,
    parameter_applyType,
    parameter_dataType,
    parameter_description,
    parameter_isModifiable,
    parameter_minimumEngineVersion,
    parameter_parameterName,
    parameter_parameterValue,
    parameter_source,

    -- * PendingCloudwatchLogsExports
    PendingCloudwatchLogsExports (..),
    newPendingCloudwatchLogsExports,
    pendingCloudwatchLogsExports_logTypesToDisable,
    pendingCloudwatchLogsExports_logTypesToEnable,

    -- * PendingMaintenanceAction
    PendingMaintenanceAction (..),
    newPendingMaintenanceAction,
    pendingMaintenanceAction_action,
    pendingMaintenanceAction_autoAppliedAfterDate,
    pendingMaintenanceAction_currentApplyDate,
    pendingMaintenanceAction_description,
    pendingMaintenanceAction_forcedApplyDate,
    pendingMaintenanceAction_optInStatus,

    -- * PendingModifiedValues
    PendingModifiedValues (..),
    newPendingModifiedValues,
    pendingModifiedValues_allocatedStorage,
    pendingModifiedValues_backupRetentionPeriod,
    pendingModifiedValues_cACertificateIdentifier,
    pendingModifiedValues_dbInstanceClass,
    pendingModifiedValues_dbInstanceIdentifier,
    pendingModifiedValues_dbSubnetGroupName,
    pendingModifiedValues_engineVersion,
    pendingModifiedValues_iops,
    pendingModifiedValues_licenseModel,
    pendingModifiedValues_masterUserPassword,
    pendingModifiedValues_multiAZ,
    pendingModifiedValues_pendingCloudwatchLogsExports,
    pendingModifiedValues_port,
    pendingModifiedValues_storageType,

    -- * ResourcePendingMaintenanceActions
    ResourcePendingMaintenanceActions (..),
    newResourcePendingMaintenanceActions,
    resourcePendingMaintenanceActions_pendingMaintenanceActionDetails,
    resourcePendingMaintenanceActions_resourceIdentifier,

    -- * Subnet
    Subnet (..),
    newSubnet,
    subnet_subnetAvailabilityZone,
    subnet_subnetIdentifier,
    subnet_subnetStatus,

    -- * Tag
    Tag (..),
    newTag,
    tag_key,
    tag_value,

    -- * UpgradeTarget
    UpgradeTarget (..),
    newUpgradeTarget,
    upgradeTarget_autoUpgrade,
    upgradeTarget_description,
    upgradeTarget_engine,
    upgradeTarget_engineVersion,
    upgradeTarget_isMajorVersionUpgrade,

    -- * VpcSecurityGroupMembership
    VpcSecurityGroupMembership (..),
    newVpcSecurityGroupMembership,
    vpcSecurityGroupMembership_status,
    vpcSecurityGroupMembership_vpcSecurityGroupId,
  )
where

import qualified Amazonka.Core as Core
import qualified Amazonka.Core.Lens.Internal as Lens
import Amazonka.DocumentDB.Types.ApplyMethod
import Amazonka.DocumentDB.Types.AvailabilityZone
import Amazonka.DocumentDB.Types.Certificate
import Amazonka.DocumentDB.Types.CloudwatchLogsExportConfiguration
import Amazonka.DocumentDB.Types.DBCluster
import Amazonka.DocumentDB.Types.DBClusterMember
import Amazonka.DocumentDB.Types.DBClusterParameterGroup
import Amazonka.DocumentDB.Types.DBClusterParameterGroupNameMessage
import Amazonka.DocumentDB.Types.DBClusterRole
import Amazonka.DocumentDB.Types.DBClusterSnapshot
import Amazonka.DocumentDB.Types.DBClusterSnapshotAttribute
import Amazonka.DocumentDB.Types.DBClusterSnapshotAttributesResult
import Amazonka.DocumentDB.Types.DBEngineVersion
import Amazonka.DocumentDB.Types.DBInstance
import Amazonka.DocumentDB.Types.DBInstanceStatusInfo
import Amazonka.DocumentDB.Types.DBSubnetGroup
import Amazonka.DocumentDB.Types.Endpoint
import Amazonka.DocumentDB.Types.EngineDefaults
import Amazonka.DocumentDB.Types.Event
import Amazonka.DocumentDB.Types.EventCategoriesMap
import Amazonka.DocumentDB.Types.EventSubscription
import Amazonka.DocumentDB.Types.Filter
import Amazonka.DocumentDB.Types.GlobalCluster
import Amazonka.DocumentDB.Types.GlobalClusterMember
import Amazonka.DocumentDB.Types.OrderableDBInstanceOption
import Amazonka.DocumentDB.Types.Parameter
import Amazonka.DocumentDB.Types.PendingCloudwatchLogsExports
import Amazonka.DocumentDB.Types.PendingMaintenanceAction
import Amazonka.DocumentDB.Types.PendingModifiedValues
import Amazonka.DocumentDB.Types.ResourcePendingMaintenanceActions
import Amazonka.DocumentDB.Types.SourceType
import Amazonka.DocumentDB.Types.Subnet
import Amazonka.DocumentDB.Types.Tag
import Amazonka.DocumentDB.Types.UpgradeTarget
import Amazonka.DocumentDB.Types.VpcSecurityGroupMembership
import qualified Amazonka.Prelude as Prelude
import qualified Amazonka.Sign.V4 as Sign

-- | API version @2014-10-31@ of the Amazon DocumentDB with MongoDB compatibility SDK configuration.
defaultService :: Core.Service
defaultService :: Service
defaultService =
  Core.Service
    { $sel:abbrev:Service :: Abbrev
Core.abbrev = Abbrev
"DocumentDB",
      $sel:signer:Service :: Signer
Core.signer = Signer
Sign.v4,
      $sel:endpointPrefix:Service :: ByteString
Core.endpointPrefix = ByteString
"rds",
      $sel:signingName:Service :: ByteString
Core.signingName = ByteString
"rds",
      $sel:version:Service :: ByteString
Core.version = ByteString
"2014-10-31",
      $sel:s3AddressingStyle:Service :: S3AddressingStyle
Core.s3AddressingStyle = S3AddressingStyle
Core.S3AddressingStyleAuto,
      $sel:endpoint:Service :: Region -> Endpoint
Core.endpoint = Service -> Region -> Endpoint
Core.defaultEndpoint Service
defaultService,
      $sel:timeout:Service :: Maybe Seconds
Core.timeout = forall a. a -> Maybe a
Prelude.Just Seconds
70,
      $sel:check:Service :: Status -> Bool
Core.check = Status -> Bool
Core.statusSuccess,
      $sel:error:Service :: Status -> [Header] -> ByteStringLazy -> Error
Core.error = Abbrev -> Status -> [Header] -> ByteStringLazy -> Error
Core.parseXMLError Abbrev
"DocumentDB",
      $sel:retry:Service :: Retry
Core.retry = Retry
retry
    }
  where
    retry :: Retry
retry =
      Core.Exponential
        { $sel:base:Exponential :: Double
Core.base = Double
5.0e-2,
          $sel:growth:Exponential :: Int
Core.growth = Int
2,
          $sel:attempts:Exponential :: Int
Core.attempts = Int
5,
          $sel:check:Exponential :: ServiceError -> Maybe Text
Core.check = forall {a}. IsString a => ServiceError -> Maybe a
check
        }
    check :: ServiceError -> Maybe a
check ServiceError
e
      | forall s a. Getting Any s a -> s -> Bool
Lens.has (forall (f :: * -> *) (p :: * -> * -> *).
(Applicative f, Choice p) =>
Int -> Optic' p f ServiceError ServiceError
Core.hasStatus Int
502) ServiceError
e =
          forall a. a -> Maybe a
Prelude.Just a
"bad_gateway"
      | forall s a. Getting Any s a -> s -> Bool
Lens.has (forall (f :: * -> *) (p :: * -> * -> *).
(Applicative f, Choice p) =>
Int -> Optic' p f ServiceError ServiceError
Core.hasStatus Int
504) ServiceError
e =
          forall a. a -> Maybe a
Prelude.Just a
"gateway_timeout"
      | forall s a. Getting Any s a -> s -> Bool
Lens.has (forall (f :: * -> *) (p :: * -> * -> *).
(Applicative f, Choice p) =>
Int -> Optic' p f ServiceError ServiceError
Core.hasStatus Int
500) ServiceError
e =
          forall a. a -> Maybe a
Prelude.Just a
"general_server_error"
      | forall s a. Getting Any s a -> s -> Bool
Lens.has (forall (f :: * -> *) (p :: * -> * -> *).
(Applicative f, Choice p) =>
Int -> Optic' p f ServiceError ServiceError
Core.hasStatus Int
509) ServiceError
e =
          forall a. a -> Maybe a
Prelude.Just a
"limit_exceeded"
      | forall s a. Getting Any s a -> s -> Bool
Lens.has
          ( forall (f :: * -> *) (p :: * -> * -> *).
(Applicative f, Choice p) =>
ErrorCode -> Optic' p f ServiceError ServiceError
Core.hasCode ErrorCode
"RequestThrottledException"
              forall b c a. (b -> c) -> (a -> b) -> a -> c
Prelude.. forall (f :: * -> *) (p :: * -> * -> *).
(Applicative f, Choice p) =>
Int -> Optic' p f ServiceError ServiceError
Core.hasStatus Int
400
          )
          ServiceError
e =
          forall a. a -> Maybe a
Prelude.Just a
"request_throttled_exception"
      | forall s a. Getting Any s a -> s -> Bool
Lens.has (forall (f :: * -> *) (p :: * -> * -> *).
(Applicative f, Choice p) =>
Int -> Optic' p f ServiceError ServiceError
Core.hasStatus Int
503) ServiceError
e =
          forall a. a -> Maybe a
Prelude.Just a
"service_unavailable"
      | forall s a. Getting Any s a -> s -> Bool
Lens.has
          ( forall (f :: * -> *) (p :: * -> * -> *).
(Applicative f, Choice p) =>
ErrorCode -> Optic' p f ServiceError ServiceError
Core.hasCode ErrorCode
"ThrottledException"
              forall b c a. (b -> c) -> (a -> b) -> a -> c
Prelude.. forall (f :: * -> *) (p :: * -> * -> *).
(Applicative f, Choice p) =>
Int -> Optic' p f ServiceError ServiceError
Core.hasStatus Int
400
          )
          ServiceError
e =
          forall a. a -> Maybe a
Prelude.Just a
"throttled_exception"
      | forall s a. Getting Any s a -> s -> Bool
Lens.has
          ( forall (f :: * -> *) (p :: * -> * -> *).
(Applicative f, Choice p) =>
ErrorCode -> Optic' p f ServiceError ServiceError
Core.hasCode ErrorCode
"Throttling"
              forall b c a. (b -> c) -> (a -> b) -> a -> c
Prelude.. forall (f :: * -> *) (p :: * -> * -> *).
(Applicative f, Choice p) =>
Int -> Optic' p f ServiceError ServiceError
Core.hasStatus Int
400
          )
          ServiceError
e =
          forall a. a -> Maybe a
Prelude.Just a
"throttling"
      | forall s a. Getting Any s a -> s -> Bool
Lens.has
          ( forall (f :: * -> *) (p :: * -> * -> *).
(Applicative f, Choice p) =>
ErrorCode -> Optic' p f ServiceError ServiceError
Core.hasCode ErrorCode
"ThrottlingException"
              forall b c a. (b -> c) -> (a -> b) -> a -> c
Prelude.. forall (f :: * -> *) (p :: * -> * -> *).
(Applicative f, Choice p) =>
Int -> Optic' p f ServiceError ServiceError
Core.hasStatus Int
400
          )
          ServiceError
e =
          forall a. a -> Maybe a
Prelude.Just a
"throttling_exception"
      | forall s a. Getting Any s a -> s -> Bool
Lens.has
          ( forall (f :: * -> *) (p :: * -> * -> *).
(Applicative f, Choice p) =>
ErrorCode -> Optic' p f ServiceError ServiceError
Core.hasCode
              ErrorCode
"ProvisionedThroughputExceededException"
              forall b c a. (b -> c) -> (a -> b) -> a -> c
Prelude.. forall (f :: * -> *) (p :: * -> * -> *).
(Applicative f, Choice p) =>
Int -> Optic' p f ServiceError ServiceError
Core.hasStatus Int
400
          )
          ServiceError
e =
          forall a. a -> Maybe a
Prelude.Just a
"throughput_exceeded"
      | forall s a. Getting Any s a -> s -> Bool
Lens.has (forall (f :: * -> *) (p :: * -> * -> *).
(Applicative f, Choice p) =>
Int -> Optic' p f ServiceError ServiceError
Core.hasStatus Int
429) ServiceError
e =
          forall a. a -> Maybe a
Prelude.Just a
"too_many_requests"
      | Bool
Prelude.otherwise = forall a. Maybe a
Prelude.Nothing

-- | The specified CIDR IP or Amazon EC2 security group isn\'t authorized for
-- the specified security group.
--
-- Amazon DocumentDB also might not be authorized to perform necessary
-- actions on your behalf using IAM.
_AuthorizationNotFoundFault :: (Core.AsError a) => Lens.Fold a Core.ServiceError
_AuthorizationNotFoundFault :: forall a. AsError a => Fold a ServiceError
_AuthorizationNotFoundFault =
  forall a. AsError a => Service -> ErrorCode -> Fold a ServiceError
Core._MatchServiceError
    Service
defaultService
    ErrorCode
"AuthorizationNotFound"
    forall b c a. (b -> c) -> (a -> b) -> a -> c
Prelude.. forall (f :: * -> *) (p :: * -> * -> *).
(Applicative f, Choice p) =>
Int -> Optic' p f ServiceError ServiceError
Core.hasStatus Int
404

-- | @CertificateIdentifier@ doesn\'t refer to an existing certificate.
_CertificateNotFoundFault :: (Core.AsError a) => Lens.Fold a Core.ServiceError
_CertificateNotFoundFault :: forall a. AsError a => Fold a ServiceError
_CertificateNotFoundFault =
  forall a. AsError a => Service -> ErrorCode -> Fold a ServiceError
Core._MatchServiceError
    Service
defaultService
    ErrorCode
"CertificateNotFound"
    forall b c a. (b -> c) -> (a -> b) -> a -> c
Prelude.. forall (f :: * -> *) (p :: * -> * -> *).
(Applicative f, Choice p) =>
Int -> Optic' p f ServiceError ServiceError
Core.hasStatus Int
404

-- | You already have a cluster with the given identifier.
_DBClusterAlreadyExistsFault :: (Core.AsError a) => Lens.Fold a Core.ServiceError
_DBClusterAlreadyExistsFault :: forall a. AsError a => Fold a ServiceError
_DBClusterAlreadyExistsFault =
  forall a. AsError a => Service -> ErrorCode -> Fold a ServiceError
Core._MatchServiceError
    Service
defaultService
    ErrorCode
"DBClusterAlreadyExistsFault"
    forall b c a. (b -> c) -> (a -> b) -> a -> c
Prelude.. forall (f :: * -> *) (p :: * -> * -> *).
(Applicative f, Choice p) =>
Int -> Optic' p f ServiceError ServiceError
Core.hasStatus Int
400

-- | @DBClusterIdentifier@ doesn\'t refer to an existing cluster.
_DBClusterNotFoundFault :: (Core.AsError a) => Lens.Fold a Core.ServiceError
_DBClusterNotFoundFault :: forall a. AsError a => Fold a ServiceError
_DBClusterNotFoundFault =
  forall a. AsError a => Service -> ErrorCode -> Fold a ServiceError
Core._MatchServiceError
    Service
defaultService
    ErrorCode
"DBClusterNotFoundFault"
    forall b c a. (b -> c) -> (a -> b) -> a -> c
Prelude.. forall (f :: * -> *) (p :: * -> * -> *).
(Applicative f, Choice p) =>
Int -> Optic' p f ServiceError ServiceError
Core.hasStatus Int
404

-- | @DBClusterParameterGroupName@ doesn\'t refer to an existing cluster
-- parameter group.
_DBClusterParameterGroupNotFoundFault :: (Core.AsError a) => Lens.Fold a Core.ServiceError
_DBClusterParameterGroupNotFoundFault :: forall a. AsError a => Fold a ServiceError
_DBClusterParameterGroupNotFoundFault =
  forall a. AsError a => Service -> ErrorCode -> Fold a ServiceError
Core._MatchServiceError
    Service
defaultService
    ErrorCode
"DBClusterParameterGroupNotFound"
    forall b c a. (b -> c) -> (a -> b) -> a -> c
Prelude.. forall (f :: * -> *) (p :: * -> * -> *).
(Applicative f, Choice p) =>
Int -> Optic' p f ServiceError ServiceError
Core.hasStatus Int
404

-- | The cluster can\'t be created because you have reached the maximum
-- allowed quota of clusters.
_DBClusterQuotaExceededFault :: (Core.AsError a) => Lens.Fold a Core.ServiceError
_DBClusterQuotaExceededFault :: forall a. AsError a => Fold a ServiceError
_DBClusterQuotaExceededFault =
  forall a. AsError a => Service -> ErrorCode -> Fold a ServiceError
Core._MatchServiceError
    Service
defaultService
    ErrorCode
"DBClusterQuotaExceededFault"
    forall b c a. (b -> c) -> (a -> b) -> a -> c
Prelude.. forall (f :: * -> *) (p :: * -> * -> *).
(Applicative f, Choice p) =>
Int -> Optic' p f ServiceError ServiceError
Core.hasStatus Int
403

-- | You already have a cluster snapshot with the given identifier.
_DBClusterSnapshotAlreadyExistsFault :: (Core.AsError a) => Lens.Fold a Core.ServiceError
_DBClusterSnapshotAlreadyExistsFault :: forall a. AsError a => Fold a ServiceError
_DBClusterSnapshotAlreadyExistsFault =
  forall a. AsError a => Service -> ErrorCode -> Fold a ServiceError
Core._MatchServiceError
    Service
defaultService
    ErrorCode
"DBClusterSnapshotAlreadyExistsFault"
    forall b c a. (b -> c) -> (a -> b) -> a -> c
Prelude.. forall (f :: * -> *) (p :: * -> * -> *).
(Applicative f, Choice p) =>
Int -> Optic' p f ServiceError ServiceError
Core.hasStatus Int
400

-- | @DBClusterSnapshotIdentifier@ doesn\'t refer to an existing cluster
-- snapshot.
_DBClusterSnapshotNotFoundFault :: (Core.AsError a) => Lens.Fold a Core.ServiceError
_DBClusterSnapshotNotFoundFault :: forall a. AsError a => Fold a ServiceError
_DBClusterSnapshotNotFoundFault =
  forall a. AsError a => Service -> ErrorCode -> Fold a ServiceError
Core._MatchServiceError
    Service
defaultService
    ErrorCode
"DBClusterSnapshotNotFoundFault"
    forall b c a. (b -> c) -> (a -> b) -> a -> c
Prelude.. forall (f :: * -> *) (p :: * -> * -> *).
(Applicative f, Choice p) =>
Int -> Optic' p f ServiceError ServiceError
Core.hasStatus Int
404

-- | You already have a instance with the given identifier.
_DBInstanceAlreadyExistsFault :: (Core.AsError a) => Lens.Fold a Core.ServiceError
_DBInstanceAlreadyExistsFault :: forall a. AsError a => Fold a ServiceError
_DBInstanceAlreadyExistsFault =
  forall a. AsError a => Service -> ErrorCode -> Fold a ServiceError
Core._MatchServiceError
    Service
defaultService
    ErrorCode
"DBInstanceAlreadyExists"
    forall b c a. (b -> c) -> (a -> b) -> a -> c
Prelude.. forall (f :: * -> *) (p :: * -> * -> *).
(Applicative f, Choice p) =>
Int -> Optic' p f ServiceError ServiceError
Core.hasStatus Int
400

-- | @DBInstanceIdentifier@ doesn\'t refer to an existing instance.
_DBInstanceNotFoundFault :: (Core.AsError a) => Lens.Fold a Core.ServiceError
_DBInstanceNotFoundFault :: forall a. AsError a => Fold a ServiceError
_DBInstanceNotFoundFault =
  forall a. AsError a => Service -> ErrorCode -> Fold a ServiceError
Core._MatchServiceError
    Service
defaultService
    ErrorCode
"DBInstanceNotFound"
    forall b c a. (b -> c) -> (a -> b) -> a -> c
Prelude.. forall (f :: * -> *) (p :: * -> * -> *).
(Applicative f, Choice p) =>
Int -> Optic' p f ServiceError ServiceError
Core.hasStatus Int
404

-- | A parameter group with the same name already exists.
_DBParameterGroupAlreadyExistsFault :: (Core.AsError a) => Lens.Fold a Core.ServiceError
_DBParameterGroupAlreadyExistsFault :: forall a. AsError a => Fold a ServiceError
_DBParameterGroupAlreadyExistsFault =
  forall a. AsError a => Service -> ErrorCode -> Fold a ServiceError
Core._MatchServiceError
    Service
defaultService
    ErrorCode
"DBParameterGroupAlreadyExists"
    forall b c a. (b -> c) -> (a -> b) -> a -> c
Prelude.. forall (f :: * -> *) (p :: * -> * -> *).
(Applicative f, Choice p) =>
Int -> Optic' p f ServiceError ServiceError
Core.hasStatus Int
400

-- | @DBParameterGroupName@ doesn\'t refer to an existing parameter group.
_DBParameterGroupNotFoundFault :: (Core.AsError a) => Lens.Fold a Core.ServiceError
_DBParameterGroupNotFoundFault :: forall a. AsError a => Fold a ServiceError
_DBParameterGroupNotFoundFault =
  forall a. AsError a => Service -> ErrorCode -> Fold a ServiceError
Core._MatchServiceError
    Service
defaultService
    ErrorCode
"DBParameterGroupNotFound"
    forall b c a. (b -> c) -> (a -> b) -> a -> c
Prelude.. forall (f :: * -> *) (p :: * -> * -> *).
(Applicative f, Choice p) =>
Int -> Optic' p f ServiceError ServiceError
Core.hasStatus Int
404

-- | This request would cause you to exceed the allowed number of parameter
-- groups.
_DBParameterGroupQuotaExceededFault :: (Core.AsError a) => Lens.Fold a Core.ServiceError
_DBParameterGroupQuotaExceededFault :: forall a. AsError a => Fold a ServiceError
_DBParameterGroupQuotaExceededFault =
  forall a. AsError a => Service -> ErrorCode -> Fold a ServiceError
Core._MatchServiceError
    Service
defaultService
    ErrorCode
"DBParameterGroupQuotaExceeded"
    forall b c a. (b -> c) -> (a -> b) -> a -> c
Prelude.. forall (f :: * -> *) (p :: * -> * -> *).
(Applicative f, Choice p) =>
Int -> Optic' p f ServiceError ServiceError
Core.hasStatus Int
400

-- | @DBSecurityGroupName@ doesn\'t refer to an existing security group.
_DBSecurityGroupNotFoundFault :: (Core.AsError a) => Lens.Fold a Core.ServiceError
_DBSecurityGroupNotFoundFault :: forall a. AsError a => Fold a ServiceError
_DBSecurityGroupNotFoundFault =
  forall a. AsError a => Service -> ErrorCode -> Fold a ServiceError
Core._MatchServiceError
    Service
defaultService
    ErrorCode
"DBSecurityGroupNotFound"
    forall b c a. (b -> c) -> (a -> b) -> a -> c
Prelude.. forall (f :: * -> *) (p :: * -> * -> *).
(Applicative f, Choice p) =>
Int -> Optic' p f ServiceError ServiceError
Core.hasStatus Int
404

-- | @DBSnapshotIdentifier@ is already being used by an existing snapshot.
_DBSnapshotAlreadyExistsFault :: (Core.AsError a) => Lens.Fold a Core.ServiceError
_DBSnapshotAlreadyExistsFault :: forall a. AsError a => Fold a ServiceError
_DBSnapshotAlreadyExistsFault =
  forall a. AsError a => Service -> ErrorCode -> Fold a ServiceError
Core._MatchServiceError
    Service
defaultService
    ErrorCode
"DBSnapshotAlreadyExists"
    forall b c a. (b -> c) -> (a -> b) -> a -> c
Prelude.. forall (f :: * -> *) (p :: * -> * -> *).
(Applicative f, Choice p) =>
Int -> Optic' p f ServiceError ServiceError
Core.hasStatus Int
400

-- | @DBSnapshotIdentifier@ doesn\'t refer to an existing snapshot.
_DBSnapshotNotFoundFault :: (Core.AsError a) => Lens.Fold a Core.ServiceError
_DBSnapshotNotFoundFault :: forall a. AsError a => Fold a ServiceError
_DBSnapshotNotFoundFault =
  forall a. AsError a => Service -> ErrorCode -> Fold a ServiceError
Core._MatchServiceError
    Service
defaultService
    ErrorCode
"DBSnapshotNotFound"
    forall b c a. (b -> c) -> (a -> b) -> a -> c
Prelude.. forall (f :: * -> *) (p :: * -> * -> *).
(Applicative f, Choice p) =>
Int -> Optic' p f ServiceError ServiceError
Core.hasStatus Int
404

-- | @DBSubnetGroupName@ is already being used by an existing subnet group.
_DBSubnetGroupAlreadyExistsFault :: (Core.AsError a) => Lens.Fold a Core.ServiceError
_DBSubnetGroupAlreadyExistsFault :: forall a. AsError a => Fold a ServiceError
_DBSubnetGroupAlreadyExistsFault =
  forall a. AsError a => Service -> ErrorCode -> Fold a ServiceError
Core._MatchServiceError
    Service
defaultService
    ErrorCode
"DBSubnetGroupAlreadyExists"
    forall b c a. (b -> c) -> (a -> b) -> a -> c
Prelude.. forall (f :: * -> *) (p :: * -> * -> *).
(Applicative f, Choice p) =>
Int -> Optic' p f ServiceError ServiceError
Core.hasStatus Int
400

-- | Subnets in the subnet group should cover at least two Availability Zones
-- unless there is only one Availability Zone.
_DBSubnetGroupDoesNotCoverEnoughAZs :: (Core.AsError a) => Lens.Fold a Core.ServiceError
_DBSubnetGroupDoesNotCoverEnoughAZs :: forall a. AsError a => Fold a ServiceError
_DBSubnetGroupDoesNotCoverEnoughAZs =
  forall a. AsError a => Service -> ErrorCode -> Fold a ServiceError
Core._MatchServiceError
    Service
defaultService
    ErrorCode
"DBSubnetGroupDoesNotCoverEnoughAZs"
    forall b c a. (b -> c) -> (a -> b) -> a -> c
Prelude.. forall (f :: * -> *) (p :: * -> * -> *).
(Applicative f, Choice p) =>
Int -> Optic' p f ServiceError ServiceError
Core.hasStatus Int
400

-- | @DBSubnetGroupName@ doesn\'t refer to an existing subnet group.
_DBSubnetGroupNotFoundFault :: (Core.AsError a) => Lens.Fold a Core.ServiceError
_DBSubnetGroupNotFoundFault :: forall a. AsError a => Fold a ServiceError
_DBSubnetGroupNotFoundFault =
  forall a. AsError a => Service -> ErrorCode -> Fold a ServiceError
Core._MatchServiceError
    Service
defaultService
    ErrorCode
"DBSubnetGroupNotFoundFault"
    forall b c a. (b -> c) -> (a -> b) -> a -> c
Prelude.. forall (f :: * -> *) (p :: * -> * -> *).
(Applicative f, Choice p) =>
Int -> Optic' p f ServiceError ServiceError
Core.hasStatus Int
404

-- | The request would cause you to exceed the allowed number of subnet
-- groups.
_DBSubnetGroupQuotaExceededFault :: (Core.AsError a) => Lens.Fold a Core.ServiceError
_DBSubnetGroupQuotaExceededFault :: forall a. AsError a => Fold a ServiceError
_DBSubnetGroupQuotaExceededFault =
  forall a. AsError a => Service -> ErrorCode -> Fold a ServiceError
Core._MatchServiceError
    Service
defaultService
    ErrorCode
"DBSubnetGroupQuotaExceeded"
    forall b c a. (b -> c) -> (a -> b) -> a -> c
Prelude.. forall (f :: * -> *) (p :: * -> * -> *).
(Applicative f, Choice p) =>
Int -> Optic' p f ServiceError ServiceError
Core.hasStatus Int
400

-- | The request would cause you to exceed the allowed number of subnets in a
-- subnet group.
_DBSubnetQuotaExceededFault :: (Core.AsError a) => Lens.Fold a Core.ServiceError
_DBSubnetQuotaExceededFault :: forall a. AsError a => Fold a ServiceError
_DBSubnetQuotaExceededFault =
  forall a. AsError a => Service -> ErrorCode -> Fold a ServiceError
Core._MatchServiceError
    Service
defaultService
    ErrorCode
"DBSubnetQuotaExceededFault"
    forall b c a. (b -> c) -> (a -> b) -> a -> c
Prelude.. forall (f :: * -> *) (p :: * -> * -> *).
(Applicative f, Choice p) =>
Int -> Optic' p f ServiceError ServiceError
Core.hasStatus Int
400

-- | The upgrade failed because a resource that the depends on can\'t be
-- modified.
_DBUpgradeDependencyFailureFault :: (Core.AsError a) => Lens.Fold a Core.ServiceError
_DBUpgradeDependencyFailureFault :: forall a. AsError a => Fold a ServiceError
_DBUpgradeDependencyFailureFault =
  forall a. AsError a => Service -> ErrorCode -> Fold a ServiceError
Core._MatchServiceError
    Service
defaultService
    ErrorCode
"DBUpgradeDependencyFailure"
    forall b c a. (b -> c) -> (a -> b) -> a -> c
Prelude.. forall (f :: * -> *) (p :: * -> * -> *).
(Applicative f, Choice p) =>
Int -> Optic' p f ServiceError ServiceError
Core.hasStatus Int
400

-- | You have reached the maximum number of event subscriptions.
_EventSubscriptionQuotaExceededFault :: (Core.AsError a) => Lens.Fold a Core.ServiceError
_EventSubscriptionQuotaExceededFault :: forall a. AsError a => Fold a ServiceError
_EventSubscriptionQuotaExceededFault =
  forall a. AsError a => Service -> ErrorCode -> Fold a ServiceError
Core._MatchServiceError
    Service
defaultService
    ErrorCode
"EventSubscriptionQuotaExceeded"
    forall b c a. (b -> c) -> (a -> b) -> a -> c
Prelude.. forall (f :: * -> *) (p :: * -> * -> *).
(Applicative f, Choice p) =>
Int -> Optic' p f ServiceError ServiceError
Core.hasStatus Int
400

-- | The @GlobalClusterIdentifier@ already exists. Choose a new global
-- cluster identifier (unique name) to create a new global cluster.
_GlobalClusterAlreadyExistsFault :: (Core.AsError a) => Lens.Fold a Core.ServiceError
_GlobalClusterAlreadyExistsFault :: forall a. AsError a => Fold a ServiceError
_GlobalClusterAlreadyExistsFault =
  forall a. AsError a => Service -> ErrorCode -> Fold a ServiceError
Core._MatchServiceError
    Service
defaultService
    ErrorCode
"GlobalClusterAlreadyExistsFault"
    forall b c a. (b -> c) -> (a -> b) -> a -> c
Prelude.. forall (f :: * -> *) (p :: * -> * -> *).
(Applicative f, Choice p) =>
Int -> Optic' p f ServiceError ServiceError
Core.hasStatus Int
400

-- | The @GlobalClusterIdentifier@ doesn\'t refer to an existing global
-- cluster.
_GlobalClusterNotFoundFault :: (Core.AsError a) => Lens.Fold a Core.ServiceError
_GlobalClusterNotFoundFault :: forall a. AsError a => Fold a ServiceError
_GlobalClusterNotFoundFault =
  forall a. AsError a => Service -> ErrorCode -> Fold a ServiceError
Core._MatchServiceError
    Service
defaultService
    ErrorCode
"GlobalClusterNotFoundFault"
    forall b c a. (b -> c) -> (a -> b) -> a -> c
Prelude.. forall (f :: * -> *) (p :: * -> * -> *).
(Applicative f, Choice p) =>
Int -> Optic' p f ServiceError ServiceError
Core.hasStatus Int
404

-- | The number of global clusters for this account is already at the maximum
-- allowed.
_GlobalClusterQuotaExceededFault :: (Core.AsError a) => Lens.Fold a Core.ServiceError
_GlobalClusterQuotaExceededFault :: forall a. AsError a => Fold a ServiceError
_GlobalClusterQuotaExceededFault =
  forall a. AsError a => Service -> ErrorCode -> Fold a ServiceError
Core._MatchServiceError
    Service
defaultService
    ErrorCode
"GlobalClusterQuotaExceededFault"
    forall b c a. (b -> c) -> (a -> b) -> a -> c
Prelude.. forall (f :: * -> *) (p :: * -> * -> *).
(Applicative f, Choice p) =>
Int -> Optic' p f ServiceError ServiceError
Core.hasStatus Int
400

-- | The request would cause you to exceed the allowed number of instances.
_InstanceQuotaExceededFault :: (Core.AsError a) => Lens.Fold a Core.ServiceError
_InstanceQuotaExceededFault :: forall a. AsError a => Fold a ServiceError
_InstanceQuotaExceededFault =
  forall a. AsError a => Service -> ErrorCode -> Fold a ServiceError
Core._MatchServiceError
    Service
defaultService
    ErrorCode
"InstanceQuotaExceeded"
    forall b c a. (b -> c) -> (a -> b) -> a -> c
Prelude.. forall (f :: * -> *) (p :: * -> * -> *).
(Applicative f, Choice p) =>
Int -> Optic' p f ServiceError ServiceError
Core.hasStatus Int
400

-- | The cluster doesn\'t have enough capacity for the current operation.
_InsufficientDBClusterCapacityFault :: (Core.AsError a) => Lens.Fold a Core.ServiceError
_InsufficientDBClusterCapacityFault :: forall a. AsError a => Fold a ServiceError
_InsufficientDBClusterCapacityFault =
  forall a. AsError a => Service -> ErrorCode -> Fold a ServiceError
Core._MatchServiceError
    Service
defaultService
    ErrorCode
"InsufficientDBClusterCapacityFault"
    forall b c a. (b -> c) -> (a -> b) -> a -> c
Prelude.. forall (f :: * -> *) (p :: * -> * -> *).
(Applicative f, Choice p) =>
Int -> Optic' p f ServiceError ServiceError
Core.hasStatus Int
403

-- | The specified instance class isn\'t available in the specified
-- Availability Zone.
_InsufficientDBInstanceCapacityFault :: (Core.AsError a) => Lens.Fold a Core.ServiceError
_InsufficientDBInstanceCapacityFault :: forall a. AsError a => Fold a ServiceError
_InsufficientDBInstanceCapacityFault =
  forall a. AsError a => Service -> ErrorCode -> Fold a ServiceError
Core._MatchServiceError
    Service
defaultService
    ErrorCode
"InsufficientDBInstanceCapacity"
    forall b c a. (b -> c) -> (a -> b) -> a -> c
Prelude.. forall (f :: * -> *) (p :: * -> * -> *).
(Applicative f, Choice p) =>
Int -> Optic' p f ServiceError ServiceError
Core.hasStatus Int
400

-- | There is not enough storage available for the current action. You might
-- be able to resolve this error by updating your subnet group to use
-- different Availability Zones that have more storage available.
_InsufficientStorageClusterCapacityFault :: (Core.AsError a) => Lens.Fold a Core.ServiceError
_InsufficientStorageClusterCapacityFault :: forall a. AsError a => Fold a ServiceError
_InsufficientStorageClusterCapacityFault =
  forall a. AsError a => Service -> ErrorCode -> Fold a ServiceError
Core._MatchServiceError
    Service
defaultService
    ErrorCode
"InsufficientStorageClusterCapacity"
    forall b c a. (b -> c) -> (a -> b) -> a -> c
Prelude.. forall (f :: * -> *) (p :: * -> * -> *).
(Applicative f, Choice p) =>
Int -> Optic' p f ServiceError ServiceError
Core.hasStatus Int
400

-- | The provided value isn\'t a valid cluster snapshot state.
_InvalidDBClusterSnapshotStateFault :: (Core.AsError a) => Lens.Fold a Core.ServiceError
_InvalidDBClusterSnapshotStateFault :: forall a. AsError a => Fold a ServiceError
_InvalidDBClusterSnapshotStateFault =
  forall a. AsError a => Service -> ErrorCode -> Fold a ServiceError
Core._MatchServiceError
    Service
defaultService
    ErrorCode
"InvalidDBClusterSnapshotStateFault"
    forall b c a. (b -> c) -> (a -> b) -> a -> c
Prelude.. forall (f :: * -> *) (p :: * -> * -> *).
(Applicative f, Choice p) =>
Int -> Optic' p f ServiceError ServiceError
Core.hasStatus Int
400

-- | The cluster isn\'t in a valid state.
_InvalidDBClusterStateFault :: (Core.AsError a) => Lens.Fold a Core.ServiceError
_InvalidDBClusterStateFault :: forall a. AsError a => Fold a ServiceError
_InvalidDBClusterStateFault =
  forall a. AsError a => Service -> ErrorCode -> Fold a ServiceError
Core._MatchServiceError
    Service
defaultService
    ErrorCode
"InvalidDBClusterStateFault"
    forall b c a. (b -> c) -> (a -> b) -> a -> c
Prelude.. forall (f :: * -> *) (p :: * -> * -> *).
(Applicative f, Choice p) =>
Int -> Optic' p f ServiceError ServiceError
Core.hasStatus Int
400

-- | The specified instance isn\'t in the /available/ state.
_InvalidDBInstanceStateFault :: (Core.AsError a) => Lens.Fold a Core.ServiceError
_InvalidDBInstanceStateFault :: forall a. AsError a => Fold a ServiceError
_InvalidDBInstanceStateFault =
  forall a. AsError a => Service -> ErrorCode -> Fold a ServiceError
Core._MatchServiceError
    Service
defaultService
    ErrorCode
"InvalidDBInstanceState"
    forall b c a. (b -> c) -> (a -> b) -> a -> c
Prelude.. forall (f :: * -> *) (p :: * -> * -> *).
(Applicative f, Choice p) =>
Int -> Optic' p f ServiceError ServiceError
Core.hasStatus Int
400

-- | The parameter group is in use, or it is in a state that is not valid. If
-- you are trying to delete the parameter group, you can\'t delete it when
-- the parameter group is in this state.
_InvalidDBParameterGroupStateFault :: (Core.AsError a) => Lens.Fold a Core.ServiceError
_InvalidDBParameterGroupStateFault :: forall a. AsError a => Fold a ServiceError
_InvalidDBParameterGroupStateFault =
  forall a. AsError a => Service -> ErrorCode -> Fold a ServiceError
Core._MatchServiceError
    Service
defaultService
    ErrorCode
"InvalidDBParameterGroupState"
    forall b c a. (b -> c) -> (a -> b) -> a -> c
Prelude.. forall (f :: * -> *) (p :: * -> * -> *).
(Applicative f, Choice p) =>
Int -> Optic' p f ServiceError ServiceError
Core.hasStatus Int
400

-- | The state of the security group doesn\'t allow deletion.
_InvalidDBSecurityGroupStateFault :: (Core.AsError a) => Lens.Fold a Core.ServiceError
_InvalidDBSecurityGroupStateFault :: forall a. AsError a => Fold a ServiceError
_InvalidDBSecurityGroupStateFault =
  forall a. AsError a => Service -> ErrorCode -> Fold a ServiceError
Core._MatchServiceError
    Service
defaultService
    ErrorCode
"InvalidDBSecurityGroupState"
    forall b c a. (b -> c) -> (a -> b) -> a -> c
Prelude.. forall (f :: * -> *) (p :: * -> * -> *).
(Applicative f, Choice p) =>
Int -> Optic' p f ServiceError ServiceError
Core.hasStatus Int
400

-- | The state of the snapshot doesn\'t allow deletion.
_InvalidDBSnapshotStateFault :: (Core.AsError a) => Lens.Fold a Core.ServiceError
_InvalidDBSnapshotStateFault :: forall a. AsError a => Fold a ServiceError
_InvalidDBSnapshotStateFault =
  forall a. AsError a => Service -> ErrorCode -> Fold a ServiceError
Core._MatchServiceError
    Service
defaultService
    ErrorCode
"InvalidDBSnapshotState"
    forall b c a. (b -> c) -> (a -> b) -> a -> c
Prelude.. forall (f :: * -> *) (p :: * -> * -> *).
(Applicative f, Choice p) =>
Int -> Optic' p f ServiceError ServiceError
Core.hasStatus Int
400

-- | The subnet group can\'t be deleted because it\'s in use.
_InvalidDBSubnetGroupStateFault :: (Core.AsError a) => Lens.Fold a Core.ServiceError
_InvalidDBSubnetGroupStateFault :: forall a. AsError a => Fold a ServiceError
_InvalidDBSubnetGroupStateFault =
  forall a. AsError a => Service -> ErrorCode -> Fold a ServiceError
Core._MatchServiceError
    Service
defaultService
    ErrorCode
"InvalidDBSubnetGroupStateFault"
    forall b c a. (b -> c) -> (a -> b) -> a -> c
Prelude.. forall (f :: * -> *) (p :: * -> * -> *).
(Applicative f, Choice p) =>
Int -> Optic' p f ServiceError ServiceError
Core.hasStatus Int
400

-- | The subnet isn\'t in the /available/ state.
_InvalidDBSubnetStateFault :: (Core.AsError a) => Lens.Fold a Core.ServiceError
_InvalidDBSubnetStateFault :: forall a. AsError a => Fold a ServiceError
_InvalidDBSubnetStateFault =
  forall a. AsError a => Service -> ErrorCode -> Fold a ServiceError
Core._MatchServiceError
    Service
defaultService
    ErrorCode
"InvalidDBSubnetStateFault"
    forall b c a. (b -> c) -> (a -> b) -> a -> c
Prelude.. forall (f :: * -> *) (p :: * -> * -> *).
(Applicative f, Choice p) =>
Int -> Optic' p f ServiceError ServiceError
Core.hasStatus Int
400

-- | Someone else might be modifying a subscription. Wait a few seconds, and
-- try again.
_InvalidEventSubscriptionStateFault :: (Core.AsError a) => Lens.Fold a Core.ServiceError
_InvalidEventSubscriptionStateFault :: forall a. AsError a => Fold a ServiceError
_InvalidEventSubscriptionStateFault =
  forall a. AsError a => Service -> ErrorCode -> Fold a ServiceError
Core._MatchServiceError
    Service
defaultService
    ErrorCode
"InvalidEventSubscriptionState"
    forall b c a. (b -> c) -> (a -> b) -> a -> c
Prelude.. forall (f :: * -> *) (p :: * -> * -> *).
(Applicative f, Choice p) =>
Int -> Optic' p f ServiceError ServiceError
Core.hasStatus Int
400

-- | The requested operation can\'t be performed while the cluster is in this
-- state.
_InvalidGlobalClusterStateFault :: (Core.AsError a) => Lens.Fold a Core.ServiceError
_InvalidGlobalClusterStateFault :: forall a. AsError a => Fold a ServiceError
_InvalidGlobalClusterStateFault =
  forall a. AsError a => Service -> ErrorCode -> Fold a ServiceError
Core._MatchServiceError
    Service
defaultService
    ErrorCode
"InvalidGlobalClusterStateFault"
    forall b c a. (b -> c) -> (a -> b) -> a -> c
Prelude.. forall (f :: * -> *) (p :: * -> * -> *).
(Applicative f, Choice p) =>
Int -> Optic' p f ServiceError ServiceError
Core.hasStatus Int
400

-- | You cannot restore from a virtual private cloud (VPC) backup to a
-- non-VPC DB instance.
_InvalidRestoreFault :: (Core.AsError a) => Lens.Fold a Core.ServiceError
_InvalidRestoreFault :: forall a. AsError a => Fold a ServiceError
_InvalidRestoreFault =
  forall a. AsError a => Service -> ErrorCode -> Fold a ServiceError
Core._MatchServiceError
    Service
defaultService
    ErrorCode
"InvalidRestoreFault"
    forall b c a. (b -> c) -> (a -> b) -> a -> c
Prelude.. forall (f :: * -> *) (p :: * -> * -> *).
(Applicative f, Choice p) =>
Int -> Optic' p f ServiceError ServiceError
Core.hasStatus Int
400

-- | The requested subnet is not valid, or multiple subnets were requested
-- that are not all in a common virtual private cloud (VPC).
_InvalidSubnet :: (Core.AsError a) => Lens.Fold a Core.ServiceError
_InvalidSubnet :: forall a. AsError a => Fold a ServiceError
_InvalidSubnet =
  forall a. AsError a => Service -> ErrorCode -> Fold a ServiceError
Core._MatchServiceError
    Service
defaultService
    ErrorCode
"InvalidSubnet"
    forall b c a. (b -> c) -> (a -> b) -> a -> c
Prelude.. forall (f :: * -> *) (p :: * -> * -> *).
(Applicative f, Choice p) =>
Int -> Optic' p f ServiceError ServiceError
Core.hasStatus Int
400

-- | The subnet group doesn\'t cover all Availability Zones after it is
-- created because of changes that were made.
_InvalidVPCNetworkStateFault :: (Core.AsError a) => Lens.Fold a Core.ServiceError
_InvalidVPCNetworkStateFault :: forall a. AsError a => Fold a ServiceError
_InvalidVPCNetworkStateFault =
  forall a. AsError a => Service -> ErrorCode -> Fold a ServiceError
Core._MatchServiceError
    Service
defaultService
    ErrorCode
"InvalidVPCNetworkStateFault"
    forall b c a. (b -> c) -> (a -> b) -> a -> c
Prelude.. forall (f :: * -> *) (p :: * -> * -> *).
(Applicative f, Choice p) =>
Int -> Optic' p f ServiceError ServiceError
Core.hasStatus Int
400

-- | An error occurred when accessing an KMS key.
_KMSKeyNotAccessibleFault :: (Core.AsError a) => Lens.Fold a Core.ServiceError
_KMSKeyNotAccessibleFault :: forall a. AsError a => Fold a ServiceError
_KMSKeyNotAccessibleFault =
  forall a. AsError a => Service -> ErrorCode -> Fold a ServiceError
Core._MatchServiceError
    Service
defaultService
    ErrorCode
"KMSKeyNotAccessibleFault"
    forall b c a. (b -> c) -> (a -> b) -> a -> c
Prelude.. forall (f :: * -> *) (p :: * -> * -> *).
(Applicative f, Choice p) =>
Int -> Optic' p f ServiceError ServiceError
Core.hasStatus Int
400

-- | The specified resource ID was not found.
_ResourceNotFoundFault :: (Core.AsError a) => Lens.Fold a Core.ServiceError
_ResourceNotFoundFault :: forall a. AsError a => Fold a ServiceError
_ResourceNotFoundFault =
  forall a. AsError a => Service -> ErrorCode -> Fold a ServiceError
Core._MatchServiceError
    Service
defaultService
    ErrorCode
"ResourceNotFoundFault"
    forall b c a. (b -> c) -> (a -> b) -> a -> c
Prelude.. forall (f :: * -> *) (p :: * -> * -> *).
(Applicative f, Choice p) =>
Int -> Optic' p f ServiceError ServiceError
Core.hasStatus Int
404

-- | Amazon SNS has responded that there is a problem with the specified
-- topic.
_SNSInvalidTopicFault :: (Core.AsError a) => Lens.Fold a Core.ServiceError
_SNSInvalidTopicFault :: forall a. AsError a => Fold a ServiceError
_SNSInvalidTopicFault =
  forall a. AsError a => Service -> ErrorCode -> Fold a ServiceError
Core._MatchServiceError
    Service
defaultService
    ErrorCode
"SNSInvalidTopic"
    forall b c a. (b -> c) -> (a -> b) -> a -> c
Prelude.. forall (f :: * -> *) (p :: * -> * -> *).
(Applicative f, Choice p) =>
Int -> Optic' p f ServiceError ServiceError
Core.hasStatus Int
400

-- | You do not have permission to publish to the SNS topic Amazon Resource
-- Name (ARN).
_SNSNoAuthorizationFault :: (Core.AsError a) => Lens.Fold a Core.ServiceError
_SNSNoAuthorizationFault :: forall a. AsError a => Fold a ServiceError
_SNSNoAuthorizationFault =
  forall a. AsError a => Service -> ErrorCode -> Fold a ServiceError
Core._MatchServiceError
    Service
defaultService
    ErrorCode
"SNSNoAuthorization"
    forall b c a. (b -> c) -> (a -> b) -> a -> c
Prelude.. forall (f :: * -> *) (p :: * -> * -> *).
(Applicative f, Choice p) =>
Int -> Optic' p f ServiceError ServiceError
Core.hasStatus Int
400

-- | The SNS topic Amazon Resource Name (ARN) does not exist.
_SNSTopicArnNotFoundFault :: (Core.AsError a) => Lens.Fold a Core.ServiceError
_SNSTopicArnNotFoundFault :: forall a. AsError a => Fold a ServiceError
_SNSTopicArnNotFoundFault =
  forall a. AsError a => Service -> ErrorCode -> Fold a ServiceError
Core._MatchServiceError
    Service
defaultService
    ErrorCode
"SNSTopicArnNotFound"
    forall b c a. (b -> c) -> (a -> b) -> a -> c
Prelude.. forall (f :: * -> *) (p :: * -> * -> *).
(Applicative f, Choice p) =>
Int -> Optic' p f ServiceError ServiceError
Core.hasStatus Int
404

-- | You have exceeded the maximum number of accounts that you can share a
-- manual DB snapshot with.
_SharedSnapshotQuotaExceededFault :: (Core.AsError a) => Lens.Fold a Core.ServiceError
_SharedSnapshotQuotaExceededFault :: forall a. AsError a => Fold a ServiceError
_SharedSnapshotQuotaExceededFault =
  forall a. AsError a => Service -> ErrorCode -> Fold a ServiceError
Core._MatchServiceError
    Service
defaultService
    ErrorCode
"SharedSnapshotQuotaExceeded"
    forall b c a. (b -> c) -> (a -> b) -> a -> c
Prelude.. forall (f :: * -> *) (p :: * -> * -> *).
(Applicative f, Choice p) =>
Int -> Optic' p f ServiceError ServiceError
Core.hasStatus Int
400

-- | The request would cause you to exceed the allowed number of snapshots.
_SnapshotQuotaExceededFault :: (Core.AsError a) => Lens.Fold a Core.ServiceError
_SnapshotQuotaExceededFault :: forall a. AsError a => Fold a ServiceError
_SnapshotQuotaExceededFault =
  forall a. AsError a => Service -> ErrorCode -> Fold a ServiceError
Core._MatchServiceError
    Service
defaultService
    ErrorCode
"SnapshotQuotaExceeded"
    forall b c a. (b -> c) -> (a -> b) -> a -> c
Prelude.. forall (f :: * -> *) (p :: * -> * -> *).
(Applicative f, Choice p) =>
Int -> Optic' p f ServiceError ServiceError
Core.hasStatus Int
400

-- | The requested source could not be found.
_SourceNotFoundFault :: (Core.AsError a) => Lens.Fold a Core.ServiceError
_SourceNotFoundFault :: forall a. AsError a => Fold a ServiceError
_SourceNotFoundFault =
  forall a. AsError a => Service -> ErrorCode -> Fold a ServiceError
Core._MatchServiceError
    Service
defaultService
    ErrorCode
"SourceNotFound"
    forall b c a. (b -> c) -> (a -> b) -> a -> c
Prelude.. forall (f :: * -> *) (p :: * -> * -> *).
(Applicative f, Choice p) =>
Int -> Optic' p f ServiceError ServiceError
Core.hasStatus Int
404

-- | The request would cause you to exceed the allowed amount of storage
-- available across all instances.
_StorageQuotaExceededFault :: (Core.AsError a) => Lens.Fold a Core.ServiceError
_StorageQuotaExceededFault :: forall a. AsError a => Fold a ServiceError
_StorageQuotaExceededFault =
  forall a. AsError a => Service -> ErrorCode -> Fold a ServiceError
Core._MatchServiceError
    Service
defaultService
    ErrorCode
"StorageQuotaExceeded"
    forall b c a. (b -> c) -> (a -> b) -> a -> c
Prelude.. forall (f :: * -> *) (p :: * -> * -> *).
(Applicative f, Choice p) =>
Int -> Optic' p f ServiceError ServiceError
Core.hasStatus Int
400

-- | Storage of the specified @StorageType@ can\'t be associated with the DB
-- instance.
_StorageTypeNotSupportedFault :: (Core.AsError a) => Lens.Fold a Core.ServiceError
_StorageTypeNotSupportedFault :: forall a. AsError a => Fold a ServiceError
_StorageTypeNotSupportedFault =
  forall a. AsError a => Service -> ErrorCode -> Fold a ServiceError
Core._MatchServiceError
    Service
defaultService
    ErrorCode
"StorageTypeNotSupported"
    forall b c a. (b -> c) -> (a -> b) -> a -> c
Prelude.. forall (f :: * -> *) (p :: * -> * -> *).
(Applicative f, Choice p) =>
Int -> Optic' p f ServiceError ServiceError
Core.hasStatus Int
400

-- | The subnet is already in use in the Availability Zone.
_SubnetAlreadyInUse :: (Core.AsError a) => Lens.Fold a Core.ServiceError
_SubnetAlreadyInUse :: forall a. AsError a => Fold a ServiceError
_SubnetAlreadyInUse =
  forall a. AsError a => Service -> ErrorCode -> Fold a ServiceError
Core._MatchServiceError
    Service
defaultService
    ErrorCode
"SubnetAlreadyInUse"
    forall b c a. (b -> c) -> (a -> b) -> a -> c
Prelude.. forall (f :: * -> *) (p :: * -> * -> *).
(Applicative f, Choice p) =>
Int -> Optic' p f ServiceError ServiceError
Core.hasStatus Int
400

-- | The provided subscription name already exists.
_SubscriptionAlreadyExistFault :: (Core.AsError a) => Lens.Fold a Core.ServiceError
_SubscriptionAlreadyExistFault :: forall a. AsError a => Fold a ServiceError
_SubscriptionAlreadyExistFault =
  forall a. AsError a => Service -> ErrorCode -> Fold a ServiceError
Core._MatchServiceError
    Service
defaultService
    ErrorCode
"SubscriptionAlreadyExist"
    forall b c a. (b -> c) -> (a -> b) -> a -> c
Prelude.. forall (f :: * -> *) (p :: * -> * -> *).
(Applicative f, Choice p) =>
Int -> Optic' p f ServiceError ServiceError
Core.hasStatus Int
400

-- | The provided category does not exist.
_SubscriptionCategoryNotFoundFault :: (Core.AsError a) => Lens.Fold a Core.ServiceError
_SubscriptionCategoryNotFoundFault :: forall a. AsError a => Fold a ServiceError
_SubscriptionCategoryNotFoundFault =
  forall a. AsError a => Service -> ErrorCode -> Fold a ServiceError
Core._MatchServiceError
    Service
defaultService
    ErrorCode
"SubscriptionCategoryNotFound"
    forall b c a. (b -> c) -> (a -> b) -> a -> c
Prelude.. forall (f :: * -> *) (p :: * -> * -> *).
(Applicative f, Choice p) =>
Int -> Optic' p f ServiceError ServiceError
Core.hasStatus Int
404

-- | The subscription name does not exist.
_SubscriptionNotFoundFault :: (Core.AsError a) => Lens.Fold a Core.ServiceError
_SubscriptionNotFoundFault :: forall a. AsError a => Fold a ServiceError
_SubscriptionNotFoundFault =
  forall a. AsError a => Service -> ErrorCode -> Fold a ServiceError
Core._MatchServiceError
    Service
defaultService
    ErrorCode
"SubscriptionNotFound"
    forall b c a. (b -> c) -> (a -> b) -> a -> c
Prelude.. forall (f :: * -> *) (p :: * -> * -> *).
(Applicative f, Choice p) =>
Int -> Optic' p f ServiceError ServiceError
Core.hasStatus Int
404