-- |
-- Module      : Amazonka.Auth.Exception
-- Copyright   : (c) 2013-2023 Brendan Hay
-- License     : Mozilla Public License, v. 2.0.
-- Maintainer  : Brendan Hay <brendan.g.hay+amazonka@gmail.com>
-- Stability   : provisional
-- Portability : non-portable (GHC extensions)
--
-- Exception for errors involving AWS authentication.
module Amazonka.Auth.Exception where

import Amazonka.Core.Lens.Internal (exception, prism)
import Amazonka.Data
import Amazonka.Prelude
import Amazonka.Types

-- | An error thrown when attempting to read AuthN/AuthZ information.
data AuthError
  = RetrievalError HttpException
  | MissingEnvError Text
  | MissingFileError FilePath
  | InvalidFileError Text
  | InvalidIAMError Text
  | CredentialChainExhausted
  deriving stock (Int -> AuthError -> ShowS
[AuthError] -> ShowS
AuthError -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [AuthError] -> ShowS
$cshowList :: [AuthError] -> ShowS
show :: AuthError -> String
$cshow :: AuthError -> String
showsPrec :: Int -> AuthError -> ShowS
$cshowsPrec :: Int -> AuthError -> ShowS
Show, forall x. Rep AuthError x -> AuthError
forall x. AuthError -> Rep AuthError x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep AuthError x -> AuthError
$cfrom :: forall x. AuthError -> Rep AuthError x
Generic)

instance Exception AuthError

instance ToLog AuthError where
  build :: AuthError -> ByteStringBuilder
build = \case
    RetrievalError HttpException
e -> forall a. ToLog a => a -> ByteStringBuilder
build HttpException
e
    MissingEnvError Text
e -> ByteStringBuilder
"[MissingEnvError]  { message = " forall a. Semigroup a => a -> a -> a
<> forall a. ToLog a => a -> ByteStringBuilder
build Text
e forall a. Semigroup a => a -> a -> a
<> ByteStringBuilder
"}"
    MissingFileError String
f -> ByteStringBuilder
"[MissingFileError] { path = " forall a. Semigroup a => a -> a -> a
<> forall a. ToLog a => a -> ByteStringBuilder
build String
f forall a. Semigroup a => a -> a -> a
<> ByteStringBuilder
"}"
    InvalidFileError Text
e -> ByteStringBuilder
"[InvalidFileError] { message = " forall a. Semigroup a => a -> a -> a
<> forall a. ToLog a => a -> ByteStringBuilder
build Text
e forall a. Semigroup a => a -> a -> a
<> ByteStringBuilder
"}"
    InvalidIAMError Text
e -> ByteStringBuilder
"[InvalidIAMError]  { message = " forall a. Semigroup a => a -> a -> a
<> forall a. ToLog a => a -> ByteStringBuilder
build Text
e forall a. Semigroup a => a -> a -> a
<> ByteStringBuilder
"}"
    AuthError
CredentialChainExhausted -> ByteStringBuilder
"[CredentialChainExhausted]"

class AsAuthError a where
  -- | A general authentication error.
  _AuthError :: Prism' a AuthError

  {-# MINIMAL _AuthError #-}

  -- | An error occured while communicating over HTTP with
  -- the local metadata endpoint.
  _RetrievalError :: Prism' a HttpException

  -- | The named environment variable was not found.
  _MissingEnvError :: Prism' a Text

  -- | The specified credentials file could not be found.
  _MissingFileError :: Prism' a FilePath

  -- | An error occured parsing the credentials file.
  _InvalidFileError :: Prism' a Text

  -- | The specified IAM profile could not be found or deserialised.
  _InvalidIAMError :: Prism' a Text

  _RetrievalError = forall a. AsAuthError a => Prism' a AuthError
_AuthError forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. AsAuthError a => Prism' a HttpException
_RetrievalError
  _MissingEnvError = forall a. AsAuthError a => Prism' a AuthError
_AuthError forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. AsAuthError a => Prism' a Text
_MissingEnvError
  _MissingFileError = forall a. AsAuthError a => Prism' a AuthError
_AuthError forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. AsAuthError a => Prism' a String
_MissingFileError
  _InvalidFileError = forall a. AsAuthError a => Prism' a AuthError
_AuthError forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. AsAuthError a => Prism' a Text
_InvalidFileError
  _InvalidIAMError = forall a. AsAuthError a => Prism' a AuthError
_AuthError forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. AsAuthError a => Prism' a Text
_InvalidIAMError

instance AsAuthError SomeException where
  _AuthError :: Prism' SomeException AuthError
_AuthError = forall a. Exception a => Prism' SomeException a
exception

instance AsAuthError AuthError where
  _AuthError :: Prism' AuthError AuthError
_AuthError = forall a. a -> a
id

  _RetrievalError :: Prism' AuthError HttpException
_RetrievalError = forall b t s a. (b -> t) -> (s -> Either t a) -> Prism s t a b
prism HttpException -> AuthError
RetrievalError forall a b. (a -> b) -> a -> b
$ \case
    RetrievalError HttpException
e -> forall a b. b -> Either a b
Right HttpException
e
    AuthError
x -> forall a b. a -> Either a b
Left AuthError
x

  _MissingEnvError :: Prism' AuthError Text
_MissingEnvError = forall b t s a. (b -> t) -> (s -> Either t a) -> Prism s t a b
prism Text -> AuthError
MissingEnvError forall a b. (a -> b) -> a -> b
$ \case
    MissingEnvError Text
e -> forall a b. b -> Either a b
Right Text
e
    AuthError
x -> forall a b. a -> Either a b
Left AuthError
x

  _MissingFileError :: Prism' AuthError String
_MissingFileError = forall b t s a. (b -> t) -> (s -> Either t a) -> Prism s t a b
prism String -> AuthError
MissingFileError forall a b. (a -> b) -> a -> b
$ \case
    MissingFileError String
f -> forall a b. b -> Either a b
Right String
f
    AuthError
x -> forall a b. a -> Either a b
Left AuthError
x

  _InvalidFileError :: Prism' AuthError Text
_InvalidFileError = forall b t s a. (b -> t) -> (s -> Either t a) -> Prism s t a b
prism Text -> AuthError
InvalidFileError forall a b. (a -> b) -> a -> b
$ \case
    InvalidFileError Text
e -> forall a b. b -> Either a b
Right Text
e
    AuthError
x -> forall a b. a -> Either a b
Left AuthError
x

  _InvalidIAMError :: Prism' AuthError Text
_InvalidIAMError = forall b t s a. (b -> t) -> (s -> Either t a) -> Prism s t a b
prism Text -> AuthError
InvalidIAMError forall a b. (a -> b) -> a -> b
$ \case
    InvalidIAMError Text
e -> forall a b. b -> Either a b
Right Text
e
    AuthError
x -> forall a b. a -> Either a b
Left AuthError
x