-- |
-- Module      : Amazonka.Error
-- 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)
module Amazonka.Error where

import Amazonka.Core.Lens.Internal (Choice, Fold, Optic', filtered)
import Amazonka.Data
import Amazonka.Prelude
import Amazonka.Types
import qualified Amazonka.Types as ServiceError (ServiceError (..))
import qualified Data.Aeson as Aeson
import qualified Data.Aeson.Types as Aeson.Types
import qualified Data.ByteString.Lazy as LBS
import Data.Either (fromRight)
import qualified Data.Text as Text
import qualified Network.HTTP.Client as Client
import Network.HTTP.Types.Status (Status (..))

-- | Provides a generalised prism for catching a specific service error
-- identified by the opaque service abbreviation and error code.
--
-- This can be used if the generated error prisms provided by
-- @Amazonka.<ServiceName>.Types@ do not cover all the thrown error codes.
-- For example to define a new error prism:
--
-- > {-# LANGUAGE OverloadedStrings #-}
-- >
-- > import Amazonka.S3 (ServiceError, s3)
-- >
-- > _NoSuchBucketPolicy :: AsError a => Fold a ServiceError
-- > _NoSuchBucketPolicy = _MatchServiceError s3 "NoSuchBucketPolicy"
--
-- With example usage being:
--
-- >>> import Control.Exception.Lens (trying)
-- >>> :t trying _NoSuchBucketPolicy
-- MonadCatch m => m a -> m (Either ServiceError a)
_MatchServiceError ::
  AsError a =>
  Service ->
  ErrorCode ->
  Fold a ServiceError
_MatchServiceError :: forall a. AsError a => Service -> ErrorCode -> Fold a ServiceError
_MatchServiceError Service
s ErrorCode
c = (ServiceError -> f ServiceError) -> a -> f a
forall a. AsError a => Prism' a ServiceError
Prism' a ServiceError
_ServiceError ((ServiceError -> f ServiceError) -> a -> f a)
-> ((ServiceError -> f ServiceError)
    -> ServiceError -> f ServiceError)
-> (ServiceError -> f ServiceError)
-> a
-> f a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Service
-> (ServiceError -> f ServiceError)
-> ServiceError
-> f ServiceError
forall (f :: * -> *) (p :: * -> * -> *).
(Applicative f, Choice p) =>
Service -> Optic' p f ServiceError ServiceError
hasService Service
s ((ServiceError -> f ServiceError)
 -> ServiceError -> f ServiceError)
-> ((ServiceError -> f ServiceError)
    -> ServiceError -> f ServiceError)
-> (ServiceError -> f ServiceError)
-> ServiceError
-> f ServiceError
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ErrorCode
-> (ServiceError -> f ServiceError)
-> ServiceError
-> f ServiceError
forall (f :: * -> *) (p :: * -> * -> *).
(Applicative f, Choice p) =>
ErrorCode -> Optic' p f ServiceError ServiceError
hasCode ErrorCode
c

statusSuccess :: Status -> Bool
statusSuccess :: Status -> Bool
statusSuccess (Status -> Int
statusCode -> Int
n) = Int
n Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= Int
200 Bool -> Bool -> Bool
&& Int
n Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
300 Bool -> Bool -> Bool
|| Int
n Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
304

_HttpStatus :: AsError a => Traversal' a Status
_HttpStatus :: forall a. AsError a => Traversal' a Status
_HttpStatus = (Error -> f Error) -> a -> f a
forall a. AsError a => Prism' a Error
Prism' a Error
_Error ((Error -> f Error) -> a -> f a)
-> ((Status -> f Status) -> Error -> f Error)
-> (Status -> f Status)
-> a
-> f a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Status -> f Status) -> Error -> f Error
forall {f :: * -> *}.
Applicative f =>
(Status -> f Status) -> Error -> f Error
f
  where
    f :: (Status -> f Status) -> Error -> f Error
f Status -> f Status
g = \case
      TransportError (Client.HttpExceptionRequest Request
rq (Client.StatusCodeException Response ()
rs ByteString
b)) ->
        (\Status
x -> HttpException -> Error
TransportError (Request -> HttpExceptionContent -> HttpException
Client.HttpExceptionRequest Request
rq (Response () -> ByteString -> HttpExceptionContent
Client.StatusCodeException (Response ()
rs {responseStatus :: Status
Client.responseStatus = Status
x}) ByteString
b)))
          (Status -> Error) -> f Status -> f Error
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Status -> f Status
g (Response () -> Status
forall body. Response body -> Status
Client.responseStatus Response ()
rs)
      --
      TransportError HttpException
e ->
        Error -> f Error
forall a. a -> f a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (HttpException -> Error
TransportError HttpException
e)
      --
      SerializeError (SerializeError' Abbrev
a Status
s Maybe ByteStringLazy
b String
e) ->
        (\Status
x -> SerializeError -> Error
SerializeError (Abbrev
-> Status -> Maybe ByteStringLazy -> String -> SerializeError
SerializeError' Abbrev
a Status
x Maybe ByteStringLazy
b String
e)) (Status -> Error) -> f Status -> f Error
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Status -> f Status
g Status
s
      --
      ServiceError e :: ServiceError
e@ServiceError' {Status
status :: Status
$sel:status:ServiceError' :: ServiceError -> Status
status} ->
        (\Status
x -> ServiceError -> Error
ServiceError (ServiceError
e {$sel:status:ServiceError' :: Status
status = Status
x})) (Status -> Error) -> f Status -> f Error
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Status -> f Status
g Status
status

hasService ::
  (Applicative f, Choice p) =>
  Service ->
  Optic' p f ServiceError ServiceError
hasService :: forall (f :: * -> *) (p :: * -> * -> *).
(Applicative f, Choice p) =>
Service -> Optic' p f ServiceError ServiceError
hasService Service {Abbrev
abbrev :: Abbrev
$sel:abbrev:Service :: Service -> Abbrev
abbrev} = (ServiceError -> Bool) -> Optic' p f ServiceError ServiceError
forall (p :: * -> * -> *) (f :: * -> *) a.
(Choice p, Applicative f) =>
(a -> Bool) -> Optic' p f a a
filtered ((Abbrev
abbrev Abbrev -> Abbrev -> Bool
forall a. Eq a => a -> a -> Bool
==) (Abbrev -> Bool)
-> (ServiceError -> Abbrev) -> ServiceError -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ServiceError -> Abbrev
ServiceError.abbrev)

hasStatus ::
  (Applicative f, Choice p) =>
  Int ->
  Optic' p f ServiceError ServiceError
hasStatus :: forall (f :: * -> *) (p :: * -> * -> *).
(Applicative f, Choice p) =>
Int -> Optic' p f ServiceError ServiceError
hasStatus Int
n = (ServiceError -> Bool) -> Optic' p f ServiceError ServiceError
forall (p :: * -> * -> *) (f :: * -> *) a.
(Choice p, Applicative f) =>
(a -> Bool) -> Optic' p f a a
filtered ((Int
n Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
==) (Int -> Bool) -> (ServiceError -> Int) -> ServiceError -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Status -> Int
forall a. Enum a => a -> Int
fromEnum (Status -> Int) -> (ServiceError -> Status) -> ServiceError -> Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ServiceError -> Status
ServiceError.status)

hasCode ::
  (Applicative f, Choice p) =>
  ErrorCode ->
  Optic' p f ServiceError ServiceError
hasCode :: forall (f :: * -> *) (p :: * -> * -> *).
(Applicative f, Choice p) =>
ErrorCode -> Optic' p f ServiceError ServiceError
hasCode ErrorCode
c = (ServiceError -> Bool) -> Optic' p f ServiceError ServiceError
forall (p :: * -> * -> *) (f :: * -> *) a.
(Choice p, Applicative f) =>
(a -> Bool) -> Optic' p f a a
filtered ((ErrorCode
c ErrorCode -> ErrorCode -> Bool
forall a. Eq a => a -> a -> Bool
==) (ErrorCode -> Bool)
-> (ServiceError -> ErrorCode) -> ServiceError -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ServiceError -> ErrorCode
ServiceError.code)

serviceError ::
  Abbrev ->
  Status ->
  [Header] ->
  Maybe ErrorCode ->
  Maybe ErrorMessage ->
  Maybe RequestId ->
  ServiceError
serviceError :: Abbrev
-> Status
-> [Header]
-> Maybe ErrorCode
-> Maybe ErrorMessage
-> Maybe RequestId
-> ServiceError
serviceError Abbrev
a Status
s [Header]
h Maybe ErrorCode
c Maybe ErrorMessage
m Maybe RequestId
r =
  Abbrev
-> Status
-> [Header]
-> ErrorCode
-> Maybe ErrorMessage
-> Maybe RequestId
-> ServiceError
ServiceError' Abbrev
a Status
s [Header]
h (ErrorCode -> Maybe ErrorCode -> ErrorCode
forall a. a -> Maybe a -> a
fromMaybe (Status -> [Header] -> ErrorCode
getErrorCode Status
s [Header]
h) Maybe ErrorCode
c) Maybe ErrorMessage
m (Maybe RequestId
r Maybe RequestId -> Maybe RequestId -> Maybe RequestId
forall a. Maybe a -> Maybe a -> Maybe a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> [Header] -> Maybe RequestId
getRequestId [Header]
h)

getRequestId :: [Header] -> Maybe RequestId
getRequestId :: [Header] -> Maybe RequestId
getRequestId [Header]
h
  | Right RequestId
hAMZ <- [Header]
h [Header] -> HeaderName -> Either String RequestId
forall a. FromText a => [Header] -> HeaderName -> Either String a
.# HeaderName
hAMZRequestId = RequestId -> Maybe RequestId
forall a. a -> Maybe a
Just RequestId
hAMZ
  | Right RequestId
hAMZN <- [Header]
h [Header] -> HeaderName -> Either String RequestId
forall a. FromText a => [Header] -> HeaderName -> Either String a
.# HeaderName
hAMZNRequestId = RequestId -> Maybe RequestId
forall a. a -> Maybe a
Just RequestId
hAMZN
  | Bool
otherwise = Maybe RequestId
forall a. Maybe a
Nothing

getErrorCode :: Status -> [Header] -> ErrorCode
getErrorCode :: Status -> [Header] -> ErrorCode
getErrorCode Status
s [Header]
h =
  case [Header]
h [Header] -> HeaderName -> Either String Text
forall a. FromText a => [Header] -> HeaderName -> Either String a
.# HeaderName
hAMZNErrorType of
    Left String
_ -> Text -> ErrorCode
newErrorCode (ByteString -> Text
forall a. ToText a => a -> Text
toText (Status -> ByteString
statusMessage Status
s))
    Right Text
x -> Text -> ErrorCode
newErrorCode Text
code
      where
        -- For headers only, botocore takes everything in the header
        -- value before a colon:
        -- https://github.com/boto/botocore/blob/fec0e5bd5e4a9d7dcadb36198423e61437294fe6/botocore/parsers.py#L1006-L1015
        (Text
code, Text
_) = (Char -> Bool) -> Text -> (Text, Text)
Text.break (Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
':') Text
x

parseJSONError ::
  Abbrev ->
  Status ->
  [Header] ->
  ByteStringLazy ->
  Error
parseJSONError :: Abbrev -> Status -> [Header] -> ByteStringLazy -> Error
parseJSONError Abbrev
a Status
s [Header]
h ByteStringLazy
bs =
  Abbrev
-> Status
-> [Header]
-> ByteStringLazy
-> Either String ServiceError
-> Error
decodeError Abbrev
a Status
s [Header]
h ByteStringLazy
bs (ByteStringLazy -> Either String ServiceError
parse ByteStringLazy
bs)
  where
    parse :: ByteStringLazy -> Either String ServiceError
parse =
      ByteStringLazy -> Either String Value
forall a. FromJSON a => ByteStringLazy -> Either String a
eitherDecode'
        (ByteStringLazy -> Either String Value)
-> (Value -> Either String ServiceError)
-> ByteStringLazy
-> Either String ServiceError
forall (m :: * -> *) a b c.
Monad m =>
(a -> m b) -> (b -> m c) -> a -> m c
>=> (Value -> Parser ServiceError)
-> Value -> Either String ServiceError
forall a b. (a -> Parser b) -> a -> Either String b
Aeson.Types.parseEither (String
-> (Object -> Parser ServiceError) -> Value -> Parser ServiceError
forall a. String -> (Object -> Parser a) -> Value -> Parser a
Aeson.withObject String
"JSONError" Object -> Parser ServiceError
go)

    go :: Object -> Parser ServiceError
go Object
o = do
      Maybe ErrorCode
e <- (ErrorCode -> Maybe ErrorCode
forall a. a -> Maybe a
Just (ErrorCode -> Maybe ErrorCode)
-> Parser ErrorCode -> Parser (Maybe ErrorCode)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Object
o Object -> Key -> Parser ErrorCode
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"__type") Parser (Maybe ErrorCode)
-> Parser (Maybe ErrorCode) -> Parser (Maybe ErrorCode)
forall a. Parser a -> Parser a -> Parser a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Object
o Object -> Key -> Parser (Maybe ErrorCode)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"code"
      Maybe ErrorMessage
m <- Maybe ErrorCode -> Object -> Parser (Maybe ErrorMessage)
forall {a} {a}.
(Eq a, IsString a, IsString a, FromJSON a) =>
Maybe a -> Object -> Parser (Maybe a)
msg Maybe ErrorCode
e Object
o

      ServiceError -> Parser ServiceError
forall a. a -> Parser a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Abbrev
-> Status
-> [Header]
-> Maybe ErrorCode
-> Maybe ErrorMessage
-> Maybe RequestId
-> ServiceError
serviceError Abbrev
a Status
s [Header]
h Maybe ErrorCode
e Maybe ErrorMessage
m Maybe RequestId
forall a. Maybe a
Nothing)

    msg :: Maybe a -> Object -> Parser (Maybe a)
msg Maybe a
c Object
o =
      if Maybe a
c Maybe a -> Maybe a -> Bool
forall a. Eq a => a -> a -> Bool
== a -> Maybe a
forall a. a -> Maybe a
Just a
"RequestEntityTooLarge"
        then Maybe a -> Parser (Maybe a)
forall a. a -> Parser a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (a -> Maybe a
forall a. a -> Maybe a
Just a
"Request body must be less than 1 MB")
        else
          a -> Maybe a
forall a. a -> Maybe a
Just (a -> Maybe a) -> Parser a -> Parser (Maybe a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Object
o Object -> Key -> Parser a
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"message"
            Parser (Maybe a) -> Parser (Maybe a) -> Parser (Maybe a)
forall a. Parser a -> Parser a -> Parser a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Object
o Object -> Key -> Parser (Maybe a)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"Message"

parseXMLError ::
  Abbrev ->
  Status ->
  [Header] ->
  ByteStringLazy ->
  Error
parseXMLError :: Abbrev -> Status -> [Header] -> ByteStringLazy -> Error
parseXMLError Abbrev
a Status
s [Header]
h ByteStringLazy
bs = Abbrev
-> Status
-> [Header]
-> ByteStringLazy
-> Either String ServiceError
-> Error
decodeError Abbrev
a Status
s [Header]
h ByteStringLazy
bs ([Node] -> ServiceError
go ([Node] -> ServiceError)
-> Either String [Node] -> Either String ServiceError
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ByteStringLazy -> Either String [Node]
forall a. FromXML a => ByteStringLazy -> Either String a
decodeXML ByteStringLazy
bs)
  where
    go :: [Node] -> ServiceError
go [Node]
x =
      Abbrev
-> Status
-> [Header]
-> Maybe ErrorCode
-> Maybe ErrorMessage
-> Maybe RequestId
-> ServiceError
serviceError
        Abbrev
a
        Status
s
        [Header]
h
        ([Node] -> Maybe ErrorCode
code [Node]
x)
        (Either String [Node] -> Maybe ErrorMessage
forall {a}. FromXML a => Either String [Node] -> Maybe a
may' (Text -> [Node] -> Either String [Node]
firstElement Text
"Message" [Node]
x))
        (Either String [Node] -> Maybe RequestId
forall {a}. FromXML a => Either String [Node] -> Maybe a
may' (Text -> [Node] -> Either String [Node]
firstElement Text
"RequestId" [Node]
x) Maybe RequestId -> Maybe RequestId -> Maybe RequestId
forall a. Maybe a -> Maybe a -> Maybe a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Either String [Node] -> Maybe RequestId
forall {a}. FromXML a => Either String [Node] -> Maybe a
may' (Text -> [Node] -> Either String [Node]
firstElement Text
"RequestID" [Node]
x))

    code :: [Node] -> Maybe ErrorCode
code [Node]
x = Maybe ErrorCode
-> Either String (Maybe ErrorCode) -> Maybe ErrorCode
forall b a. b -> Either a b -> b
fromRight Maybe ErrorCode
root (Either String (Maybe ErrorCode) -> Maybe ErrorCode)
-> Either String (Maybe ErrorCode) -> Maybe ErrorCode
forall a b. (a -> b) -> a -> b
$ [Node] -> Either String (Maybe ErrorCode)
forall a. FromXML a => [Node] -> Either String a
parseXML ([Node] -> Either String (Maybe ErrorCode))
-> Either String [Node] -> Either String (Maybe ErrorCode)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< Text -> [Node] -> Either String [Node]
firstElement Text
"Code" [Node]
x

    root :: Maybe ErrorCode
root = Text -> ErrorCode
newErrorCode (Text -> ErrorCode) -> Maybe Text -> Maybe ErrorCode
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ByteStringLazy -> Maybe Text
rootElementName ByteStringLazy
bs

    may' :: Either String [Node] -> Maybe a
may' Either String [Node]
x = (String -> Maybe a) -> (a -> Maybe a) -> Either String a -> Maybe a
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either (Maybe a -> String -> Maybe a
forall a b. a -> b -> a
const Maybe a
forall a. Maybe a
Nothing) a -> Maybe a
forall a. a -> Maybe a
Just (Either String a -> Maybe a) -> Either String a -> Maybe a
forall a b. (a -> b) -> a -> b
$ [Node] -> Either String a
forall a. FromXML a => [Node] -> Either String a
parseXML ([Node] -> Either String a)
-> Either String [Node] -> Either String a
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< Either String [Node]
x

parseRESTError ::
  Abbrev ->
  Status ->
  [Header] ->
  a ->
  Error
parseRESTError :: forall a. Abbrev -> Status -> [Header] -> a -> Error
parseRESTError Abbrev
a Status
s [Header]
h a
_ =
  ServiceError -> Error
ServiceError (Abbrev
-> Status
-> [Header]
-> Maybe ErrorCode
-> Maybe ErrorMessage
-> Maybe RequestId
-> ServiceError
serviceError Abbrev
a Status
s [Header]
h Maybe ErrorCode
forall a. Maybe a
Nothing Maybe ErrorMessage
forall a. Maybe a
Nothing Maybe RequestId
forall a. Maybe a
Nothing)

decodeError ::
  Abbrev ->
  Status ->
  [Header] ->
  ByteStringLazy ->
  Either String ServiceError ->
  Error
decodeError :: Abbrev
-> Status
-> [Header]
-> ByteStringLazy
-> Either String ServiceError
-> Error
decodeError Abbrev
a Status
s [Header]
h ByteStringLazy
bs Either String ServiceError
e
  | ByteStringLazy -> Bool
LBS.null ByteStringLazy
bs = Abbrev -> Status -> [Header] -> ByteStringLazy -> Error
forall a. Abbrev -> Status -> [Header] -> a -> Error
parseRESTError Abbrev
a Status
s [Header]
h ByteStringLazy
bs
  | Bool
otherwise =
      (String -> Error)
-> (ServiceError -> Error) -> Either String ServiceError -> Error
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either
        (SerializeError -> Error
SerializeError (SerializeError -> Error)
-> (String -> SerializeError) -> String -> Error
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Abbrev
-> Status -> Maybe ByteStringLazy -> String -> SerializeError
SerializeError' Abbrev
a Status
s (ByteStringLazy -> Maybe ByteStringLazy
forall a. a -> Maybe a
Just ByteStringLazy
bs))
        ServiceError -> Error
ServiceError
        Either String ServiceError
e