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

    -- * Errors
    _AccessDeniedException,
    _InternalServerException,
    _ResourceNotFoundException,
    _ValidationException,

    -- * EnvironmentStatus
    EnvironmentStatus (..),

    -- * LoggingLevel
    LoggingLevel (..),

    -- * Unit
    Unit (..),

    -- * UpdateStatus
    UpdateStatus (..),

    -- * WebserverAccessMode
    WebserverAccessMode (..),

    -- * Dimension
    Dimension (..),
    newDimension,
    dimension_name,
    dimension_value,

    -- * Environment
    Environment (..),
    newEnvironment,
    environment_airflowConfigurationOptions,
    environment_airflowVersion,
    environment_arn,
    environment_createdAt,
    environment_dagS3Path,
    environment_environmentClass,
    environment_executionRoleArn,
    environment_kmsKey,
    environment_lastUpdate,
    environment_loggingConfiguration,
    environment_maxWorkers,
    environment_minWorkers,
    environment_name,
    environment_networkConfiguration,
    environment_pluginsS3ObjectVersion,
    environment_pluginsS3Path,
    environment_requirementsS3ObjectVersion,
    environment_requirementsS3Path,
    environment_schedulers,
    environment_serviceRoleArn,
    environment_sourceBucketArn,
    environment_status,
    environment_tags,
    environment_webserverAccessMode,
    environment_webserverUrl,
    environment_weeklyMaintenanceWindowStart,

    -- * LastUpdate
    LastUpdate (..),
    newLastUpdate,
    lastUpdate_createdAt,
    lastUpdate_error,
    lastUpdate_source,
    lastUpdate_status,

    -- * LoggingConfiguration
    LoggingConfiguration (..),
    newLoggingConfiguration,
    loggingConfiguration_dagProcessingLogs,
    loggingConfiguration_schedulerLogs,
    loggingConfiguration_taskLogs,
    loggingConfiguration_webserverLogs,
    loggingConfiguration_workerLogs,

    -- * LoggingConfigurationInput
    LoggingConfigurationInput (..),
    newLoggingConfigurationInput,
    loggingConfigurationInput_dagProcessingLogs,
    loggingConfigurationInput_schedulerLogs,
    loggingConfigurationInput_taskLogs,
    loggingConfigurationInput_webserverLogs,
    loggingConfigurationInput_workerLogs,

    -- * MetricDatum
    MetricDatum (..),
    newMetricDatum,
    metricDatum_dimensions,
    metricDatum_statisticValues,
    metricDatum_unit,
    metricDatum_value,
    metricDatum_metricName,
    metricDatum_timestamp,

    -- * ModuleLoggingConfiguration
    ModuleLoggingConfiguration (..),
    newModuleLoggingConfiguration,
    moduleLoggingConfiguration_cloudWatchLogGroupArn,
    moduleLoggingConfiguration_enabled,
    moduleLoggingConfiguration_logLevel,

    -- * ModuleLoggingConfigurationInput
    ModuleLoggingConfigurationInput (..),
    newModuleLoggingConfigurationInput,
    moduleLoggingConfigurationInput_enabled,
    moduleLoggingConfigurationInput_logLevel,

    -- * NetworkConfiguration
    NetworkConfiguration (..),
    newNetworkConfiguration,
    networkConfiguration_securityGroupIds,
    networkConfiguration_subnetIds,

    -- * StatisticSet
    StatisticSet (..),
    newStatisticSet,
    statisticSet_maximum,
    statisticSet_minimum,
    statisticSet_sampleCount,
    statisticSet_sum,

    -- * UpdateError
    UpdateError (..),
    newUpdateError,
    updateError_errorCode,
    updateError_errorMessage,

    -- * UpdateNetworkConfigurationInput
    UpdateNetworkConfigurationInput (..),
    newUpdateNetworkConfigurationInput,
    updateNetworkConfigurationInput_securityGroupIds,
  )
where

import qualified Amazonka.Core as Core
import qualified Amazonka.Core.Lens.Internal as Lens
import Amazonka.MwAA.Types.Dimension
import Amazonka.MwAA.Types.Environment
import Amazonka.MwAA.Types.EnvironmentStatus
import Amazonka.MwAA.Types.LastUpdate
import Amazonka.MwAA.Types.LoggingConfiguration
import Amazonka.MwAA.Types.LoggingConfigurationInput
import Amazonka.MwAA.Types.LoggingLevel
import Amazonka.MwAA.Types.MetricDatum
import Amazonka.MwAA.Types.ModuleLoggingConfiguration
import Amazonka.MwAA.Types.ModuleLoggingConfigurationInput
import Amazonka.MwAA.Types.NetworkConfiguration
import Amazonka.MwAA.Types.StatisticSet
import Amazonka.MwAA.Types.Unit
import Amazonka.MwAA.Types.UpdateError
import Amazonka.MwAA.Types.UpdateNetworkConfigurationInput
import Amazonka.MwAA.Types.UpdateStatus
import Amazonka.MwAA.Types.WebserverAccessMode
import qualified Amazonka.Prelude as Prelude
import qualified Amazonka.Sign.V4 as Sign

-- | API version @2020-07-01@ of the Amazon MWAA SDK configuration.
defaultService :: Core.Service
defaultService :: Service
defaultService =
  Core.Service
    { $sel:abbrev:Service :: Abbrev
Core.abbrev = Abbrev
"MwAA",
      $sel:signer:Service :: Signer
Core.signer = Signer
Sign.v4,
      $sel:endpointPrefix:Service :: ByteString
Core.endpointPrefix = ByteString
"airflow",
      $sel:signingName:Service :: ByteString
Core.signingName = ByteString
"airflow",
      $sel:version:Service :: ByteString
Core.version = ByteString
"2020-07-01",
      $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
"MwAA",
      $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

-- | Access to the Apache Airflow Web UI or CLI has been denied due to
-- insufficient permissions. To learn more, see
-- <https://docs.aws.amazon.com/mwaa/latest/userguide/access-policies.html Accessing an Amazon MWAA environment>.
_AccessDeniedException :: (Core.AsError a) => Lens.Fold a Core.ServiceError
_AccessDeniedException :: forall a. AsError a => Fold a ServiceError
_AccessDeniedException =
  forall a. AsError a => Service -> ErrorCode -> Fold a ServiceError
Core._MatchServiceError
    Service
defaultService
    ErrorCode
"AccessDeniedException"
    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

-- | InternalServerException: An internal error has occurred.
_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

-- | ResourceNotFoundException: The resource is not available.
_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

-- | ValidationException: The provided input is not valid.
_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