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

    -- * Errors
    _AccessDeniedException,
    _BadRequestException,
    _ConflictException,
    _InternalServiceErrorException,
    _NotFoundException,
    _ResourceNotFoundException,
    _ServiceLimitExceededException,
    _ThrottlingException,
    _TooManyRequestsException,
    _ValidationException,

    -- * Category
    Category (..),

    -- * EncryptionAlgorithm
    EncryptionAlgorithm (..),

    -- * HashAlgorithm
    HashAlgorithm (..),

    -- * ImageFormat
    ImageFormat (..),

    -- * SigningProfileStatus
    SigningProfileStatus (..),

    -- * SigningStatus
    SigningStatus (..),

    -- * ValidityType
    ValidityType (..),

    -- * Destination
    Destination (..),
    newDestination,
    destination_s3,

    -- * EncryptionAlgorithmOptions
    EncryptionAlgorithmOptions (..),
    newEncryptionAlgorithmOptions,
    encryptionAlgorithmOptions_allowedValues,
    encryptionAlgorithmOptions_defaultValue,

    -- * HashAlgorithmOptions
    HashAlgorithmOptions (..),
    newHashAlgorithmOptions,
    hashAlgorithmOptions_allowedValues,
    hashAlgorithmOptions_defaultValue,

    -- * Permission
    Permission (..),
    newPermission,
    permission_action,
    permission_principal,
    permission_profileVersion,
    permission_statementId,

    -- * S3Destination
    S3Destination (..),
    newS3Destination,
    s3Destination_bucketName,
    s3Destination_prefix,

    -- * S3SignedObject
    S3SignedObject (..),
    newS3SignedObject,
    s3SignedObject_bucketName,
    s3SignedObject_key,

    -- * S3Source
    S3Source (..),
    newS3Source,
    s3Source_bucketName,
    s3Source_key,
    s3Source_version,

    -- * SignatureValidityPeriod
    SignatureValidityPeriod (..),
    newSignatureValidityPeriod,
    signatureValidityPeriod_type,
    signatureValidityPeriod_value,

    -- * SignedObject
    SignedObject (..),
    newSignedObject,
    signedObject_s3,

    -- * SigningConfiguration
    SigningConfiguration (..),
    newSigningConfiguration,
    signingConfiguration_encryptionAlgorithmOptions,
    signingConfiguration_hashAlgorithmOptions,

    -- * SigningConfigurationOverrides
    SigningConfigurationOverrides (..),
    newSigningConfigurationOverrides,
    signingConfigurationOverrides_encryptionAlgorithm,
    signingConfigurationOverrides_hashAlgorithm,

    -- * SigningImageFormat
    SigningImageFormat (..),
    newSigningImageFormat,
    signingImageFormat_supportedFormats,
    signingImageFormat_defaultFormat,

    -- * SigningJob
    SigningJob (..),
    newSigningJob,
    signingJob_createdAt,
    signingJob_isRevoked,
    signingJob_jobId,
    signingJob_jobInvoker,
    signingJob_jobOwner,
    signingJob_platformDisplayName,
    signingJob_platformId,
    signingJob_profileName,
    signingJob_profileVersion,
    signingJob_signatureExpiresAt,
    signingJob_signedObject,
    signingJob_signingMaterial,
    signingJob_source,
    signingJob_status,

    -- * SigningJobRevocationRecord
    SigningJobRevocationRecord (..),
    newSigningJobRevocationRecord,
    signingJobRevocationRecord_reason,
    signingJobRevocationRecord_revokedAt,
    signingJobRevocationRecord_revokedBy,

    -- * SigningMaterial
    SigningMaterial (..),
    newSigningMaterial,
    signingMaterial_certificateArn,

    -- * SigningPlatform
    SigningPlatform (..),
    newSigningPlatform,
    signingPlatform_category,
    signingPlatform_displayName,
    signingPlatform_maxSizeInMB,
    signingPlatform_partner,
    signingPlatform_platformId,
    signingPlatform_revocationSupported,
    signingPlatform_signingConfiguration,
    signingPlatform_signingImageFormat,
    signingPlatform_target,

    -- * SigningPlatformOverrides
    SigningPlatformOverrides (..),
    newSigningPlatformOverrides,
    signingPlatformOverrides_signingConfiguration,
    signingPlatformOverrides_signingImageFormat,

    -- * SigningProfile
    SigningProfile (..),
    newSigningProfile,
    signingProfile_arn,
    signingProfile_platformDisplayName,
    signingProfile_platformId,
    signingProfile_profileName,
    signingProfile_profileVersion,
    signingProfile_profileVersionArn,
    signingProfile_signatureValidityPeriod,
    signingProfile_signingMaterial,
    signingProfile_signingParameters,
    signingProfile_status,
    signingProfile_tags,

    -- * SigningProfileRevocationRecord
    SigningProfileRevocationRecord (..),
    newSigningProfileRevocationRecord,
    signingProfileRevocationRecord_revocationEffectiveFrom,
    signingProfileRevocationRecord_revokedAt,
    signingProfileRevocationRecord_revokedBy,

    -- * Source
    Source (..),
    newSource,
    source_s3,
  )
where

import qualified Amazonka.Core as Core
import qualified Amazonka.Core.Lens.Internal as Lens
import qualified Amazonka.Prelude as Prelude
import qualified Amazonka.Sign.V4 as Sign
import Amazonka.Signer.Types.Category
import Amazonka.Signer.Types.Destination
import Amazonka.Signer.Types.EncryptionAlgorithm
import Amazonka.Signer.Types.EncryptionAlgorithmOptions
import Amazonka.Signer.Types.HashAlgorithm
import Amazonka.Signer.Types.HashAlgorithmOptions
import Amazonka.Signer.Types.ImageFormat
import Amazonka.Signer.Types.Permission
import Amazonka.Signer.Types.S3Destination
import Amazonka.Signer.Types.S3SignedObject
import Amazonka.Signer.Types.S3Source
import Amazonka.Signer.Types.SignatureValidityPeriod
import Amazonka.Signer.Types.SignedObject
import Amazonka.Signer.Types.SigningConfiguration
import Amazonka.Signer.Types.SigningConfigurationOverrides
import Amazonka.Signer.Types.SigningImageFormat
import Amazonka.Signer.Types.SigningJob
import Amazonka.Signer.Types.SigningJobRevocationRecord
import Amazonka.Signer.Types.SigningMaterial
import Amazonka.Signer.Types.SigningPlatform
import Amazonka.Signer.Types.SigningPlatformOverrides
import Amazonka.Signer.Types.SigningProfile
import Amazonka.Signer.Types.SigningProfileRevocationRecord
import Amazonka.Signer.Types.SigningProfileStatus
import Amazonka.Signer.Types.SigningStatus
import Amazonka.Signer.Types.Source
import Amazonka.Signer.Types.ValidityType

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

-- | You do not have sufficient access to perform this action.
_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

-- | The request contains invalid parameters for the ARN or tags. This
-- exception also occurs when you call a tagging API on a cancelled signing
-- profile.
_BadRequestException :: (Core.AsError a) => Lens.Fold a Core.ServiceError
_BadRequestException :: forall a. AsError a => Fold a ServiceError
_BadRequestException =
  forall a. AsError a => Service -> ErrorCode -> Fold a ServiceError
Core._MatchServiceError
    Service
defaultService
    ErrorCode
"BadRequestException"
    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 resource encountered a conflicting 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

-- | An internal error occurred.
_InternalServiceErrorException :: (Core.AsError a) => Lens.Fold a Core.ServiceError
_InternalServiceErrorException :: forall a. AsError a => Fold a ServiceError
_InternalServiceErrorException =
  forall a. AsError a => Service -> ErrorCode -> Fold a ServiceError
Core._MatchServiceError
    Service
defaultService
    ErrorCode
"InternalServiceErrorException"
    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 signing profile was not found.
_NotFoundException :: (Core.AsError a) => Lens.Fold a Core.ServiceError
_NotFoundException :: forall a. AsError a => Fold a ServiceError
_NotFoundException =
  forall a. AsError a => Service -> ErrorCode -> Fold a ServiceError
Core._MatchServiceError
    Service
defaultService
    ErrorCode
"NotFoundException"
    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 specified resource could not be found.
_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 client is making a request that exceeds service limits.
_ServiceLimitExceededException :: (Core.AsError a) => Lens.Fold a Core.ServiceError
_ServiceLimitExceededException :: forall a. AsError a => Fold a ServiceError
_ServiceLimitExceededException =
  forall a. AsError a => Service -> ErrorCode -> Fold a ServiceError
Core._MatchServiceError
    Service
defaultService
    ErrorCode
"ServiceLimitExceededException"
    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.
--
-- Instead of this error, @TooManyRequestsException@ should be used.
_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 allowed number of job-signing requests has been exceeded.
--
-- This error supersedes the error @ThrottlingException@.
_TooManyRequestsException :: (Core.AsError a) => Lens.Fold a Core.ServiceError
_TooManyRequestsException :: forall a. AsError a => Fold a ServiceError
_TooManyRequestsException =
  forall a. AsError a => Service -> ErrorCode -> Fold a ServiceError
Core._MatchServiceError
    Service
defaultService
    ErrorCode
"TooManyRequestsException"
    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

-- | You signing certificate could not be validated.
_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