{-# 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.Scheduler.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.Scheduler.Types
  ( -- * Service Configuration
    defaultService,

    -- * Errors
    _ConflictException,
    _InternalServerException,
    _ResourceNotFoundException,
    _ServiceQuotaExceededException,
    _ThrottlingException,
    _ValidationException,

    -- * AssignPublicIp
    AssignPublicIp (..),

    -- * FlexibleTimeWindowMode
    FlexibleTimeWindowMode (..),

    -- * LaunchType
    LaunchType (..),

    -- * PlacementConstraintType
    PlacementConstraintType (..),

    -- * PlacementStrategyType
    PlacementStrategyType (..),

    -- * PropagateTags
    PropagateTags (..),

    -- * ScheduleGroupState
    ScheduleGroupState (..),

    -- * ScheduleState
    ScheduleState (..),

    -- * AwsVpcConfiguration
    AwsVpcConfiguration (..),
    newAwsVpcConfiguration,
    awsVpcConfiguration_assignPublicIp,
    awsVpcConfiguration_securityGroups,
    awsVpcConfiguration_subnets,

    -- * CapacityProviderStrategyItem
    CapacityProviderStrategyItem (..),
    newCapacityProviderStrategyItem,
    capacityProviderStrategyItem_base,
    capacityProviderStrategyItem_weight,
    capacityProviderStrategyItem_capacityProvider,

    -- * DeadLetterConfig
    DeadLetterConfig (..),
    newDeadLetterConfig,
    deadLetterConfig_arn,

    -- * EcsParameters
    EcsParameters (..),
    newEcsParameters,
    ecsParameters_capacityProviderStrategy,
    ecsParameters_enableECSManagedTags,
    ecsParameters_enableExecuteCommand,
    ecsParameters_group,
    ecsParameters_launchType,
    ecsParameters_networkConfiguration,
    ecsParameters_placementConstraints,
    ecsParameters_placementStrategy,
    ecsParameters_platformVersion,
    ecsParameters_propagateTags,
    ecsParameters_referenceId,
    ecsParameters_tags,
    ecsParameters_taskCount,
    ecsParameters_taskDefinitionArn,

    -- * EventBridgeParameters
    EventBridgeParameters (..),
    newEventBridgeParameters,
    eventBridgeParameters_detailType,
    eventBridgeParameters_source,

    -- * FlexibleTimeWindow
    FlexibleTimeWindow (..),
    newFlexibleTimeWindow,
    flexibleTimeWindow_maximumWindowInMinutes,
    flexibleTimeWindow_mode,

    -- * KinesisParameters
    KinesisParameters (..),
    newKinesisParameters,
    kinesisParameters_partitionKey,

    -- * NetworkConfiguration
    NetworkConfiguration (..),
    newNetworkConfiguration,
    networkConfiguration_awsvpcConfiguration,

    -- * PlacementConstraint
    PlacementConstraint (..),
    newPlacementConstraint,
    placementConstraint_expression,
    placementConstraint_type,

    -- * PlacementStrategy
    PlacementStrategy (..),
    newPlacementStrategy,
    placementStrategy_field,
    placementStrategy_type,

    -- * RetryPolicy
    RetryPolicy (..),
    newRetryPolicy,
    retryPolicy_maximumEventAgeInSeconds,
    retryPolicy_maximumRetryAttempts,

    -- * SageMakerPipelineParameter
    SageMakerPipelineParameter (..),
    newSageMakerPipelineParameter,
    sageMakerPipelineParameter_name,
    sageMakerPipelineParameter_value,

    -- * SageMakerPipelineParameters
    SageMakerPipelineParameters (..),
    newSageMakerPipelineParameters,
    sageMakerPipelineParameters_pipelineParameterList,

    -- * ScheduleGroupSummary
    ScheduleGroupSummary (..),
    newScheduleGroupSummary,
    scheduleGroupSummary_arn,
    scheduleGroupSummary_creationDate,
    scheduleGroupSummary_lastModificationDate,
    scheduleGroupSummary_name,
    scheduleGroupSummary_state,

    -- * ScheduleSummary
    ScheduleSummary (..),
    newScheduleSummary,
    scheduleSummary_arn,
    scheduleSummary_creationDate,
    scheduleSummary_groupName,
    scheduleSummary_lastModificationDate,
    scheduleSummary_name,
    scheduleSummary_state,
    scheduleSummary_target,

    -- * SqsParameters
    SqsParameters (..),
    newSqsParameters,
    sqsParameters_messageGroupId,

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

    -- * Target
    Target (..),
    newTarget,
    target_deadLetterConfig,
    target_ecsParameters,
    target_eventBridgeParameters,
    target_input,
    target_kinesisParameters,
    target_retryPolicy,
    target_sageMakerPipelineParameters,
    target_sqsParameters,
    target_arn,
    target_roleArn,

    -- * TargetSummary
    TargetSummary (..),
    newTargetSummary,
    targetSummary_arn,
  )
where

import qualified Amazonka.Core as Core
import qualified Amazonka.Core.Lens.Internal as Lens
import qualified Amazonka.Prelude as Prelude
import Amazonka.Scheduler.Types.AssignPublicIp
import Amazonka.Scheduler.Types.AwsVpcConfiguration
import Amazonka.Scheduler.Types.CapacityProviderStrategyItem
import Amazonka.Scheduler.Types.DeadLetterConfig
import Amazonka.Scheduler.Types.EcsParameters
import Amazonka.Scheduler.Types.EventBridgeParameters
import Amazonka.Scheduler.Types.FlexibleTimeWindow
import Amazonka.Scheduler.Types.FlexibleTimeWindowMode
import Amazonka.Scheduler.Types.KinesisParameters
import Amazonka.Scheduler.Types.LaunchType
import Amazonka.Scheduler.Types.NetworkConfiguration
import Amazonka.Scheduler.Types.PlacementConstraint
import Amazonka.Scheduler.Types.PlacementConstraintType
import Amazonka.Scheduler.Types.PlacementStrategy
import Amazonka.Scheduler.Types.PlacementStrategyType
import Amazonka.Scheduler.Types.PropagateTags
import Amazonka.Scheduler.Types.RetryPolicy
import Amazonka.Scheduler.Types.SageMakerPipelineParameter
import Amazonka.Scheduler.Types.SageMakerPipelineParameters
import Amazonka.Scheduler.Types.ScheduleGroupState
import Amazonka.Scheduler.Types.ScheduleGroupSummary
import Amazonka.Scheduler.Types.ScheduleState
import Amazonka.Scheduler.Types.ScheduleSummary
import Amazonka.Scheduler.Types.SqsParameters
import Amazonka.Scheduler.Types.Tag
import Amazonka.Scheduler.Types.Target
import Amazonka.Scheduler.Types.TargetSummary
import qualified Amazonka.Sign.V4 as Sign

-- | API version @2021-06-30@ of the Amazon EventBridge Scheduler SDK configuration.
defaultService :: Core.Service
defaultService :: Service
defaultService =
  Core.Service
    { $sel:abbrev:Service :: Abbrev
Core.abbrev = Abbrev
"Scheduler",
      $sel:signer:Service :: Signer
Core.signer = Signer
Sign.v4,
      $sel:endpointPrefix:Service :: ByteString
Core.endpointPrefix = ByteString
"scheduler",
      $sel:signingName:Service :: ByteString
Core.signingName = ByteString
"scheduler",
      $sel:version:Service :: ByteString
Core.version = ByteString
"2021-06-30",
      $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.parseJSONError Abbrev
"Scheduler",
      $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

-- | Updating or deleting the resource can cause an inconsistent state.
_ConflictException :: (Core.AsError a) => Lens.Fold a Core.ServiceError
_ConflictException :: forall a. AsError a => Fold a ServiceError
_ConflictException =
  forall a. AsError a => Service -> ErrorCode -> Fold a ServiceError
Core._MatchServiceError
    Service
defaultService
    ErrorCode
"ConflictException"
    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
409

-- | Unexpected error encountered while processing the request.
_InternalServerException :: (Core.AsError a) => Lens.Fold a Core.ServiceError
_InternalServerException :: forall a. AsError a => Fold a ServiceError
_InternalServerException =
  forall a. AsError a => Service -> ErrorCode -> Fold a ServiceError
Core._MatchServiceError
    Service
defaultService
    ErrorCode
"InternalServerException"
    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
500

-- | The request references a resource which does not exist.
_ResourceNotFoundException :: (Core.AsError a) => Lens.Fold a Core.ServiceError
_ResourceNotFoundException :: forall a. AsError a => Fold a ServiceError
_ResourceNotFoundException =
  forall a. AsError a => Service -> ErrorCode -> Fold a ServiceError
Core._MatchServiceError
    Service
defaultService
    ErrorCode
"ResourceNotFoundException"
    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 exceeds a service quota.
_ServiceQuotaExceededException :: (Core.AsError a) => Lens.Fold a Core.ServiceError
_ServiceQuotaExceededException :: forall a. AsError a => Fold a ServiceError
_ServiceQuotaExceededException =
  forall a. AsError a => Service -> ErrorCode -> Fold a ServiceError
Core._MatchServiceError
    Service
defaultService
    ErrorCode
"ServiceQuotaExceededException"
    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
402

-- | The request was denied due to request throttling.
_ThrottlingException :: (Core.AsError a) => Lens.Fold a Core.ServiceError
_ThrottlingException :: forall a. AsError a => Fold a ServiceError
_ThrottlingException =
  forall a. AsError a => Service -> ErrorCode -> Fold a ServiceError
Core._MatchServiceError
    Service
defaultService
    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
429

-- | The input fails to satisfy the constraints specified by an AWS service.
_ValidationException :: (Core.AsError a) => Lens.Fold a Core.ServiceError
_ValidationException :: forall a. AsError a => Fold a ServiceError
_ValidationException =
  forall a. AsError a => Service -> ErrorCode -> Fold a ServiceError
Core._MatchServiceError
    Service
defaultService
    ErrorCode
"ValidationException"
    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