{-# LANGUAGE DisambiguateRecordFields #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE StrictData #-}
{-# LANGUAGE NoImplicitPrelude #-}
{-# OPTIONS_GHC -fno-warn-unused-matches #-}
module Amazonka.Neptune.Types
(
defaultService,
_AuthorizationNotFoundFault,
_CertificateNotFoundFault,
_DBClusterAlreadyExistsFault,
_DBClusterEndpointAlreadyExistsFault,
_DBClusterEndpointNotFoundFault,
_DBClusterEndpointQuotaExceededFault,
_DBClusterNotFoundFault,
_DBClusterParameterGroupNotFoundFault,
_DBClusterQuotaExceededFault,
_DBClusterRoleAlreadyExistsFault,
_DBClusterRoleNotFoundFault,
_DBClusterRoleQuotaExceededFault,
_DBClusterSnapshotAlreadyExistsFault,
_DBClusterSnapshotNotFoundFault,
_DBInstanceAlreadyExistsFault,
_DBInstanceNotFoundFault,
_DBParameterGroupAlreadyExistsFault,
_DBParameterGroupNotFoundFault,
_DBParameterGroupQuotaExceededFault,
_DBSecurityGroupNotFoundFault,
_DBSnapshotAlreadyExistsFault,
_DBSnapshotNotFoundFault,
_DBSubnetGroupAlreadyExistsFault,
_DBSubnetGroupDoesNotCoverEnoughAZs,
_DBSubnetGroupNotFoundFault,
_DBSubnetGroupQuotaExceededFault,
_DBSubnetQuotaExceededFault,
_DBUpgradeDependencyFailureFault,
_DomainNotFoundFault,
_EventSubscriptionQuotaExceededFault,
_GlobalClusterAlreadyExistsFault,
_GlobalClusterNotFoundFault,
_GlobalClusterQuotaExceededFault,
_InstanceQuotaExceededFault,
_InsufficientDBClusterCapacityFault,
_InsufficientDBInstanceCapacityFault,
_InsufficientStorageClusterCapacityFault,
_InvalidDBClusterEndpointStateFault,
_InvalidDBClusterSnapshotStateFault,
_InvalidDBClusterStateFault,
_InvalidDBInstanceStateFault,
_InvalidDBParameterGroupStateFault,
_InvalidDBSecurityGroupStateFault,
_InvalidDBSnapshotStateFault,
_InvalidDBSubnetGroupStateFault,
_InvalidDBSubnetStateFault,
_InvalidEventSubscriptionStateFault,
_InvalidGlobalClusterStateFault,
_InvalidRestoreFault,
_InvalidSubnet,
_InvalidVPCNetworkStateFault,
_KMSKeyNotAccessibleFault,
_OptionGroupNotFoundFault,
_ProvisionedIopsNotAvailableInAZFault,
_ResourceNotFoundFault,
_SNSInvalidTopicFault,
_SNSNoAuthorizationFault,
_SNSTopicArnNotFoundFault,
_SharedSnapshotQuotaExceededFault,
_SnapshotQuotaExceededFault,
_SourceNotFoundFault,
_StorageQuotaExceededFault,
_StorageTypeNotSupportedFault,
_SubnetAlreadyInUse,
_SubscriptionAlreadyExistFault,
_SubscriptionCategoryNotFoundFault,
_SubscriptionNotFoundFault,
ApplyMethod (..),
SourceType (..),
AvailabilityZone (..),
newAvailabilityZone,
availabilityZone_name,
CharacterSet (..),
newCharacterSet,
characterSet_characterSetDescription,
characterSet_characterSetName,
CloudwatchLogsExportConfiguration (..),
newCloudwatchLogsExportConfiguration,
cloudwatchLogsExportConfiguration_disableLogTypes,
cloudwatchLogsExportConfiguration_enableLogTypes,
DBCluster (..),
newDBCluster,
dbCluster_allocatedStorage,
dbCluster_associatedRoles,
dbCluster_automaticRestartTime,
dbCluster_availabilityZones,
dbCluster_backupRetentionPeriod,
dbCluster_characterSetName,
dbCluster_cloneGroupId,
dbCluster_clusterCreateTime,
dbCluster_copyTagsToSnapshot,
dbCluster_crossAccountClone,
dbCluster_dbClusterArn,
dbCluster_dbClusterIdentifier,
dbCluster_dbClusterMembers,
dbCluster_dbClusterOptionGroupMemberships,
dbCluster_dbClusterParameterGroup,
dbCluster_dbSubnetGroup,
dbCluster_databaseName,
dbCluster_dbClusterResourceId,
dbCluster_deletionProtection,
dbCluster_earliestRestorableTime,
dbCluster_enabledCloudwatchLogsExports,
dbCluster_endpoint,
dbCluster_engine,
dbCluster_engineVersion,
dbCluster_hostedZoneId,
dbCluster_iAMDatabaseAuthenticationEnabled,
dbCluster_kmsKeyId,
dbCluster_latestRestorableTime,
dbCluster_masterUsername,
dbCluster_multiAZ,
dbCluster_percentProgress,
dbCluster_port,
dbCluster_preferredBackupWindow,
dbCluster_preferredMaintenanceWindow,
dbCluster_readReplicaIdentifiers,
dbCluster_readerEndpoint,
dbCluster_replicationSourceIdentifier,
dbCluster_serverlessV2ScalingConfiguration,
dbCluster_status,
dbCluster_storageEncrypted,
dbCluster_vpcSecurityGroups,
DBClusterEndpoint (..),
newDBClusterEndpoint,
dbClusterEndpoint_customEndpointType,
dbClusterEndpoint_dbClusterEndpointArn,
dbClusterEndpoint_dbClusterEndpointIdentifier,
dbClusterEndpoint_dbClusterEndpointResourceIdentifier,
dbClusterEndpoint_dbClusterIdentifier,
dbClusterEndpoint_endpoint,
dbClusterEndpoint_endpointType,
dbClusterEndpoint_excludedMembers,
dbClusterEndpoint_staticMembers,
dbClusterEndpoint_status,
DBClusterMember (..),
newDBClusterMember,
dbClusterMember_dbClusterParameterGroupStatus,
dbClusterMember_dbInstanceIdentifier,
dbClusterMember_isClusterWriter,
dbClusterMember_promotionTier,
DBClusterOptionGroupStatus (..),
newDBClusterOptionGroupStatus,
dbClusterOptionGroupStatus_dbClusterOptionGroupName,
dbClusterOptionGroupStatus_status,
DBClusterParameterGroup (..),
newDBClusterParameterGroup,
dbClusterParameterGroup_dbClusterParameterGroupArn,
dbClusterParameterGroup_dbClusterParameterGroupName,
dbClusterParameterGroup_dbParameterGroupFamily,
dbClusterParameterGroup_description,
DBClusterParameterGroupNameMessage (..),
newDBClusterParameterGroupNameMessage,
dbClusterParameterGroupNameMessage_dbClusterParameterGroupName,
DBClusterRole (..),
newDBClusterRole,
dbClusterRole_featureName,
dbClusterRole_roleArn,
dbClusterRole_status,
DBClusterSnapshot (..),
newDBClusterSnapshot,
dbClusterSnapshot_allocatedStorage,
dbClusterSnapshot_availabilityZones,
dbClusterSnapshot_clusterCreateTime,
dbClusterSnapshot_dbClusterIdentifier,
dbClusterSnapshot_dbClusterSnapshotArn,
dbClusterSnapshot_dbClusterSnapshotIdentifier,
dbClusterSnapshot_engine,
dbClusterSnapshot_engineVersion,
dbClusterSnapshot_iAMDatabaseAuthenticationEnabled,
dbClusterSnapshot_kmsKeyId,
dbClusterSnapshot_licenseModel,
dbClusterSnapshot_masterUsername,
dbClusterSnapshot_percentProgress,
dbClusterSnapshot_port,
dbClusterSnapshot_snapshotCreateTime,
dbClusterSnapshot_snapshotType,
dbClusterSnapshot_sourceDBClusterSnapshotArn,
dbClusterSnapshot_status,
dbClusterSnapshot_storageEncrypted,
dbClusterSnapshot_vpcId,
DBClusterSnapshotAttribute (..),
newDBClusterSnapshotAttribute,
dbClusterSnapshotAttribute_attributeName,
dbClusterSnapshotAttribute_attributeValues,
DBClusterSnapshotAttributesResult (..),
newDBClusterSnapshotAttributesResult,
dbClusterSnapshotAttributesResult_dbClusterSnapshotAttributes,
dbClusterSnapshotAttributesResult_dbClusterSnapshotIdentifier,
DBEngineVersion (..),
newDBEngineVersion,
dbEngineVersion_dbEngineDescription,
dbEngineVersion_dbEngineVersionDescription,
dbEngineVersion_dbParameterGroupFamily,
dbEngineVersion_defaultCharacterSet,
dbEngineVersion_engine,
dbEngineVersion_engineVersion,
dbEngineVersion_exportableLogTypes,
dbEngineVersion_supportedCharacterSets,
dbEngineVersion_supportedTimezones,
dbEngineVersion_supportsGlobalDatabases,
dbEngineVersion_supportsLogExportsToCloudwatchLogs,
dbEngineVersion_supportsReadReplica,
dbEngineVersion_validUpgradeTarget,
DBInstance (..),
newDBInstance,
dbInstance_allocatedStorage,
dbInstance_autoMinorVersionUpgrade,
dbInstance_availabilityZone,
dbInstance_backupRetentionPeriod,
dbInstance_cACertificateIdentifier,
dbInstance_characterSetName,
dbInstance_copyTagsToSnapshot,
dbInstance_dbClusterIdentifier,
dbInstance_dbInstanceArn,
dbInstance_dbInstanceClass,
dbInstance_dbInstanceIdentifier,
dbInstance_dbInstanceStatus,
dbInstance_dbName,
dbInstance_dbParameterGroups,
dbInstance_dbSecurityGroups,
dbInstance_dbSubnetGroup,
dbInstance_dbInstancePort,
dbInstance_dbiResourceId,
dbInstance_deletionProtection,
dbInstance_domainMemberships,
dbInstance_enabledCloudwatchLogsExports,
dbInstance_endpoint,
dbInstance_engine,
dbInstance_engineVersion,
dbInstance_enhancedMonitoringResourceArn,
dbInstance_iAMDatabaseAuthenticationEnabled,
dbInstance_instanceCreateTime,
dbInstance_iops,
dbInstance_kmsKeyId,
dbInstance_latestRestorableTime,
dbInstance_licenseModel,
dbInstance_masterUsername,
dbInstance_monitoringInterval,
dbInstance_monitoringRoleArn,
dbInstance_multiAZ,
dbInstance_optionGroupMemberships,
dbInstance_pendingModifiedValues,
dbInstance_performanceInsightsEnabled,
dbInstance_performanceInsightsKMSKeyId,
dbInstance_preferredBackupWindow,
dbInstance_preferredMaintenanceWindow,
dbInstance_promotionTier,
dbInstance_publiclyAccessible,
dbInstance_readReplicaDBClusterIdentifiers,
dbInstance_readReplicaDBInstanceIdentifiers,
dbInstance_readReplicaSourceDBInstanceIdentifier,
dbInstance_secondaryAvailabilityZone,
dbInstance_statusInfos,
dbInstance_storageEncrypted,
dbInstance_storageType,
dbInstance_tdeCredentialArn,
dbInstance_timezone,
dbInstance_vpcSecurityGroups,
DBInstanceStatusInfo (..),
newDBInstanceStatusInfo,
dbInstanceStatusInfo_message,
dbInstanceStatusInfo_normal,
dbInstanceStatusInfo_status,
dbInstanceStatusInfo_statusType,
DBParameterGroup (..),
newDBParameterGroup,
dbParameterGroup_dbParameterGroupArn,
dbParameterGroup_dbParameterGroupFamily,
dbParameterGroup_dbParameterGroupName,
dbParameterGroup_description,
DBParameterGroupNameMessage (..),
newDBParameterGroupNameMessage,
dbParameterGroupNameMessage_dbParameterGroupName,
DBParameterGroupStatus (..),
newDBParameterGroupStatus,
dbParameterGroupStatus_dbParameterGroupName,
dbParameterGroupStatus_parameterApplyStatus,
DBSecurityGroupMembership (..),
newDBSecurityGroupMembership,
dbSecurityGroupMembership_dbSecurityGroupName,
dbSecurityGroupMembership_status,
DBSubnetGroup (..),
newDBSubnetGroup,
dbSubnetGroup_dbSubnetGroupArn,
dbSubnetGroup_dbSubnetGroupDescription,
dbSubnetGroup_dbSubnetGroupName,
dbSubnetGroup_subnetGroupStatus,
dbSubnetGroup_subnets,
dbSubnetGroup_vpcId,
DomainMembership (..),
newDomainMembership,
domainMembership_domain,
domainMembership_fqdn,
domainMembership_iAMRoleName,
domainMembership_status,
DoubleRange (..),
newDoubleRange,
doubleRange_from,
doubleRange_to,
Endpoint (..),
newEndpoint,
endpoint_address,
endpoint_hostedZoneId,
endpoint_port,
EngineDefaults (..),
newEngineDefaults,
engineDefaults_dbParameterGroupFamily,
engineDefaults_marker,
engineDefaults_parameters,
Event (..),
newEvent,
event_date,
event_eventCategories,
event_message,
event_sourceArn,
event_sourceIdentifier,
event_sourceType,
EventCategoriesMap (..),
newEventCategoriesMap,
eventCategoriesMap_eventCategories,
eventCategoriesMap_sourceType,
EventSubscription (..),
newEventSubscription,
eventSubscription_custSubscriptionId,
eventSubscription_customerAwsId,
eventSubscription_enabled,
eventSubscription_eventCategoriesList,
eventSubscription_eventSubscriptionArn,
eventSubscription_snsTopicArn,
eventSubscription_sourceIdsList,
eventSubscription_sourceType,
eventSubscription_status,
eventSubscription_subscriptionCreationTime,
Filter (..),
newFilter,
filter_name,
filter_values,
GlobalCluster (..),
newGlobalCluster,
globalCluster_deletionProtection,
globalCluster_engine,
globalCluster_engineVersion,
globalCluster_globalClusterArn,
globalCluster_globalClusterIdentifier,
globalCluster_globalClusterMembers,
globalCluster_globalClusterResourceId,
globalCluster_status,
globalCluster_storageEncrypted,
GlobalClusterMember (..),
newGlobalClusterMember,
globalClusterMember_dbClusterArn,
globalClusterMember_isWriter,
globalClusterMember_readers,
OptionGroupMembership (..),
newOptionGroupMembership,
optionGroupMembership_optionGroupName,
optionGroupMembership_status,
OrderableDBInstanceOption (..),
newOrderableDBInstanceOption,
orderableDBInstanceOption_availabilityZones,
orderableDBInstanceOption_dbInstanceClass,
orderableDBInstanceOption_engine,
orderableDBInstanceOption_engineVersion,
orderableDBInstanceOption_licenseModel,
orderableDBInstanceOption_maxIopsPerDbInstance,
orderableDBInstanceOption_maxIopsPerGib,
orderableDBInstanceOption_maxStorageSize,
orderableDBInstanceOption_minIopsPerDbInstance,
orderableDBInstanceOption_minIopsPerGib,
orderableDBInstanceOption_minStorageSize,
orderableDBInstanceOption_multiAZCapable,
orderableDBInstanceOption_readReplicaCapable,
orderableDBInstanceOption_storageType,
orderableDBInstanceOption_supportsEnhancedMonitoring,
orderableDBInstanceOption_supportsGlobalDatabases,
orderableDBInstanceOption_supportsIAMDatabaseAuthentication,
orderableDBInstanceOption_supportsIops,
orderableDBInstanceOption_supportsPerformanceInsights,
orderableDBInstanceOption_supportsStorageEncryption,
orderableDBInstanceOption_vpc,
Parameter (..),
newParameter,
parameter_allowedValues,
parameter_applyMethod,
parameter_applyType,
parameter_dataType,
parameter_description,
parameter_isModifiable,
parameter_minimumEngineVersion,
parameter_parameterName,
parameter_parameterValue,
parameter_source,
PendingCloudwatchLogsExports (..),
newPendingCloudwatchLogsExports,
pendingCloudwatchLogsExports_logTypesToDisable,
pendingCloudwatchLogsExports_logTypesToEnable,
PendingMaintenanceAction (..),
newPendingMaintenanceAction,
pendingMaintenanceAction_action,
pendingMaintenanceAction_autoAppliedAfterDate,
pendingMaintenanceAction_currentApplyDate,
pendingMaintenanceAction_description,
pendingMaintenanceAction_forcedApplyDate,
pendingMaintenanceAction_optInStatus,
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,
Range (..),
newRange,
range_from,
range_step,
range_to,
ResourcePendingMaintenanceActions (..),
newResourcePendingMaintenanceActions,
resourcePendingMaintenanceActions_pendingMaintenanceActionDetails,
resourcePendingMaintenanceActions_resourceIdentifier,
ServerlessV2ScalingConfiguration (..),
newServerlessV2ScalingConfiguration,
serverlessV2ScalingConfiguration_maxCapacity,
serverlessV2ScalingConfiguration_minCapacity,
ServerlessV2ScalingConfigurationInfo (..),
newServerlessV2ScalingConfigurationInfo,
serverlessV2ScalingConfigurationInfo_maxCapacity,
serverlessV2ScalingConfigurationInfo_minCapacity,
Subnet (..),
newSubnet,
subnet_subnetAvailabilityZone,
subnet_subnetIdentifier,
subnet_subnetStatus,
Tag (..),
newTag,
tag_key,
tag_value,
Timezone (..),
newTimezone,
timezone_timezoneName,
UpgradeTarget (..),
newUpgradeTarget,
upgradeTarget_autoUpgrade,
upgradeTarget_description,
upgradeTarget_engine,
upgradeTarget_engineVersion,
upgradeTarget_isMajorVersionUpgrade,
upgradeTarget_supportsGlobalDatabases,
ValidDBInstanceModificationsMessage (..),
newValidDBInstanceModificationsMessage,
validDBInstanceModificationsMessage_storage,
ValidStorageOptions (..),
newValidStorageOptions,
validStorageOptions_iopsToStorageRatio,
validStorageOptions_provisionedIops,
validStorageOptions_storageSize,
validStorageOptions_storageType,
VpcSecurityGroupMembership (..),
newVpcSecurityGroupMembership,
vpcSecurityGroupMembership_status,
vpcSecurityGroupMembership_vpcSecurityGroupId,
)
where
import qualified Amazonka.Core as Core
import qualified Amazonka.Core.Lens.Internal as Lens
import Amazonka.Neptune.Types.ApplyMethod
import Amazonka.Neptune.Types.AvailabilityZone
import Amazonka.Neptune.Types.CharacterSet
import Amazonka.Neptune.Types.CloudwatchLogsExportConfiguration
import Amazonka.Neptune.Types.DBCluster
import Amazonka.Neptune.Types.DBClusterEndpoint
import Amazonka.Neptune.Types.DBClusterMember
import Amazonka.Neptune.Types.DBClusterOptionGroupStatus
import Amazonka.Neptune.Types.DBClusterParameterGroup
import Amazonka.Neptune.Types.DBClusterParameterGroupNameMessage
import Amazonka.Neptune.Types.DBClusterRole
import Amazonka.Neptune.Types.DBClusterSnapshot
import Amazonka.Neptune.Types.DBClusterSnapshotAttribute
import Amazonka.Neptune.Types.DBClusterSnapshotAttributesResult
import Amazonka.Neptune.Types.DBEngineVersion
import Amazonka.Neptune.Types.DBInstance
import Amazonka.Neptune.Types.DBInstanceStatusInfo
import Amazonka.Neptune.Types.DBParameterGroup
import Amazonka.Neptune.Types.DBParameterGroupNameMessage
import Amazonka.Neptune.Types.DBParameterGroupStatus
import Amazonka.Neptune.Types.DBSecurityGroupMembership
import Amazonka.Neptune.Types.DBSubnetGroup
import Amazonka.Neptune.Types.DomainMembership
import Amazonka.Neptune.Types.DoubleRange
import Amazonka.Neptune.Types.Endpoint
import Amazonka.Neptune.Types.EngineDefaults
import Amazonka.Neptune.Types.Event
import Amazonka.Neptune.Types.EventCategoriesMap
import Amazonka.Neptune.Types.EventSubscription
import Amazonka.Neptune.Types.Filter
import Amazonka.Neptune.Types.GlobalCluster
import Amazonka.Neptune.Types.GlobalClusterMember
import Amazonka.Neptune.Types.OptionGroupMembership
import Amazonka.Neptune.Types.OrderableDBInstanceOption
import Amazonka.Neptune.Types.Parameter
import Amazonka.Neptune.Types.PendingCloudwatchLogsExports
import Amazonka.Neptune.Types.PendingMaintenanceAction
import Amazonka.Neptune.Types.PendingModifiedValues
import Amazonka.Neptune.Types.Range
import Amazonka.Neptune.Types.ResourcePendingMaintenanceActions
import Amazonka.Neptune.Types.ServerlessV2ScalingConfiguration
import Amazonka.Neptune.Types.ServerlessV2ScalingConfigurationInfo
import Amazonka.Neptune.Types.SourceType
import Amazonka.Neptune.Types.Subnet
import Amazonka.Neptune.Types.Tag
import Amazonka.Neptune.Types.Timezone
import Amazonka.Neptune.Types.UpgradeTarget
import Amazonka.Neptune.Types.ValidDBInstanceModificationsMessage
import Amazonka.Neptune.Types.ValidStorageOptions
import Amazonka.Neptune.Types.VpcSecurityGroupMembership
import qualified Amazonka.Prelude as Prelude
import qualified Amazonka.Sign.V4 as Sign
defaultService :: Core.Service
defaultService :: Service
defaultService =
Core.Service
{ $sel:abbrev:Service :: Abbrev
Core.abbrev = Abbrev
"Neptune",
$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
"Neptune",
$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
_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
_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
_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
_DBClusterEndpointAlreadyExistsFault :: (Core.AsError a) => Lens.Fold a Core.ServiceError
_DBClusterEndpointAlreadyExistsFault :: forall a. AsError a => Fold a ServiceError
_DBClusterEndpointAlreadyExistsFault =
forall a. AsError a => Service -> ErrorCode -> Fold a ServiceError
Core._MatchServiceError
Service
defaultService
ErrorCode
"DBClusterEndpointAlreadyExistsFault"
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
_DBClusterEndpointNotFoundFault :: (Core.AsError a) => Lens.Fold a Core.ServiceError
_DBClusterEndpointNotFoundFault :: forall a. AsError a => Fold a ServiceError
_DBClusterEndpointNotFoundFault =
forall a. AsError a => Service -> ErrorCode -> Fold a ServiceError
Core._MatchServiceError
Service
defaultService
ErrorCode
"DBClusterEndpointNotFoundFault"
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
_DBClusterEndpointQuotaExceededFault :: (Core.AsError a) => Lens.Fold a Core.ServiceError
_DBClusterEndpointQuotaExceededFault :: forall a. AsError a => Fold a ServiceError
_DBClusterEndpointQuotaExceededFault =
forall a. AsError a => Service -> ErrorCode -> Fold a ServiceError
Core._MatchServiceError
Service
defaultService
ErrorCode
"DBClusterEndpointQuotaExceededFault"
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
_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
_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
_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
_DBClusterRoleAlreadyExistsFault :: (Core.AsError a) => Lens.Fold a Core.ServiceError
_DBClusterRoleAlreadyExistsFault :: forall a. AsError a => Fold a ServiceError
_DBClusterRoleAlreadyExistsFault =
forall a. AsError a => Service -> ErrorCode -> Fold a ServiceError
Core._MatchServiceError
Service
defaultService
ErrorCode
"DBClusterRoleAlreadyExists"
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
_DBClusterRoleNotFoundFault :: (Core.AsError a) => Lens.Fold a Core.ServiceError
_DBClusterRoleNotFoundFault :: forall a. AsError a => Fold a ServiceError
_DBClusterRoleNotFoundFault =
forall a. AsError a => Service -> ErrorCode -> Fold a ServiceError
Core._MatchServiceError
Service
defaultService
ErrorCode
"DBClusterRoleNotFound"
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
_DBClusterRoleQuotaExceededFault :: (Core.AsError a) => Lens.Fold a Core.ServiceError
_DBClusterRoleQuotaExceededFault :: forall a. AsError a => Fold a ServiceError
_DBClusterRoleQuotaExceededFault =
forall a. AsError a => Service -> ErrorCode -> Fold a ServiceError
Core._MatchServiceError
Service
defaultService
ErrorCode
"DBClusterRoleQuotaExceeded"
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
_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
_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
_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
_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
_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
_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
_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
_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
_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
_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
_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
_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
_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
_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
_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
_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
_DomainNotFoundFault :: (Core.AsError a) => Lens.Fold a Core.ServiceError
_DomainNotFoundFault :: forall a. AsError a => Fold a ServiceError
_DomainNotFoundFault =
forall a. AsError a => Service -> ErrorCode -> Fold a ServiceError
Core._MatchServiceError
Service
defaultService
ErrorCode
"DomainNotFoundFault"
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
_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
_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
_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
_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
_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
_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
_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
_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
_InvalidDBClusterEndpointStateFault :: (Core.AsError a) => Lens.Fold a Core.ServiceError
_InvalidDBClusterEndpointStateFault :: forall a. AsError a => Fold a ServiceError
_InvalidDBClusterEndpointStateFault =
forall a. AsError a => Service -> ErrorCode -> Fold a ServiceError
Core._MatchServiceError
Service
defaultService
ErrorCode
"InvalidDBClusterEndpointStateFault"
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
_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
_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
_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
_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
_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
_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
_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
_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
_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
_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
_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
_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
_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
_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
_OptionGroupNotFoundFault :: (Core.AsError a) => Lens.Fold a Core.ServiceError
_OptionGroupNotFoundFault :: forall a. AsError a => Fold a ServiceError
_OptionGroupNotFoundFault =
forall a. AsError a => Service -> ErrorCode -> Fold a ServiceError
Core._MatchServiceError
Service
defaultService
ErrorCode
"OptionGroupNotFoundFault"
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
_ProvisionedIopsNotAvailableInAZFault :: (Core.AsError a) => Lens.Fold a Core.ServiceError
_ProvisionedIopsNotAvailableInAZFault :: forall a. AsError a => Fold a ServiceError
_ProvisionedIopsNotAvailableInAZFault =
forall a. AsError a => Service -> ErrorCode -> Fold a ServiceError
Core._MatchServiceError
Service
defaultService
ErrorCode
"ProvisionedIopsNotAvailableInAZFault"
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
_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
_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
_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
_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
_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
_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
_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
_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
_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
_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
_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
_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
_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