-- |
-- 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 = forall a. AsError a => Prism' a ServiceError
_ServiceError forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (f :: * -> *) (p :: * -> * -> *).
(Applicative f, Choice p) =>
Service -> Optic' p f ServiceError ServiceError
hasService Service
s forall b c a. (b -> c) -> (a -> b) -> a -> c
. 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 forall a. Ord a => a -> a -> Bool
>= Int
200 Bool -> Bool -> Bool
&& Int
n forall a. Ord a => a -> a -> Bool
< Int
300 Bool -> Bool -> Bool
|| Int
n forall a. Eq a => a -> a -> Bool
== Int
304

_HttpStatus :: AsError a => Traversal' a Status
_HttpStatus :: forall a. AsError a => Traversal' a Status
_HttpStatus = forall a. AsError a => Prism' a Error
_Error forall b c a. (b -> c) -> (a -> b) -> a -> c
. 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)))
          forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Status -> f Status
g (forall body. Response body -> Status
Client.responseStatus Response ()
rs)
      --
      TransportError HttpException
e ->
        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)) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Status -> f Status
g Status
s
      --
      ServiceError e :: ServiceError
e@ServiceError' {Status
$sel:status:ServiceError' :: ServiceError -> Status
status :: Status
status} ->
        (\Status
x -> ServiceError -> Error
ServiceError (ServiceError
e {$sel:status:ServiceError' :: Status
status = Status
x})) 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
$sel:abbrev:Service :: Service -> Abbrev
abbrev :: Abbrev
abbrev} = forall (p :: * -> * -> *) (f :: * -> *) a.
(Choice p, Applicative f) =>
(a -> Bool) -> Optic' p f a a
filtered ((Abbrev
abbrev forall a. Eq a => a -> a -> 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 = forall (p :: * -> * -> *) (f :: * -> *) a.
(Choice p, Applicative f) =>
(a -> Bool) -> Optic' p f a a
filtered ((Int
n forall a. Eq a => a -> a -> Bool
==) forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Enum a => a -> Int
fromEnum 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 = forall (p :: * -> * -> *) (f :: * -> *) a.
(Choice p, Applicative f) =>
(a -> Bool) -> Optic' p f a a
filtered ((ErrorCode
c forall a. Eq a => a -> a -> 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 (forall a. a -> Maybe a -> a
fromMaybe (Status -> [Header] -> ErrorCode
getErrorCode Status
s [Header]
h) Maybe ErrorCode
c) Maybe ErrorMessage
m (Maybe RequestId
r 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 forall a. FromText a => [Header] -> HeaderName -> Either String a
.# HeaderName
hAMZRequestId = forall a. a -> Maybe a
Just RequestId
hAMZ
  | Right RequestId
hAMZN <- [Header]
h forall a. FromText a => [Header] -> HeaderName -> Either String a
.# HeaderName
hAMZNRequestId = forall a. a -> Maybe a
Just RequestId
hAMZN
  | Bool
otherwise = forall a. Maybe a
Nothing

getErrorCode :: Status -> [Header] -> ErrorCode
getErrorCode :: Status -> [Header] -> ErrorCode
getErrorCode Status
s [Header]
h =
  case [Header]
h forall a. FromText a => [Header] -> HeaderName -> Either String a
.# HeaderName
hAMZNErrorType of
    Left String
_ -> Text -> ErrorCode
newErrorCode (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 (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 =
      forall a. FromJSON a => ByteStringLazy -> Either String a
eitherDecode'
        forall (m :: * -> *) a b c.
Monad m =>
(a -> m b) -> (b -> m c) -> a -> m c
>=> forall a b. (a -> Parser b) -> a -> Either String b
Aeson.Types.parseEither (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 <- (forall a. a -> Maybe a
Just forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Object
o forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"__type") forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Object
o forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"code"
      Maybe ErrorMessage
m <- forall {a} {a}.
(Eq a, IsString a, IsString a, FromJSON a) =>
Maybe a -> Object -> Parser (Maybe a)
msg Maybe ErrorCode
e Object
o

      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 forall a. Maybe a
Nothing)

    msg :: Maybe a -> Object -> Parser (Maybe a)
msg Maybe a
c Object
o =
      if Maybe a
c forall a. Eq a => a -> a -> Bool
== forall a. a -> Maybe a
Just a
"RequestEntityTooLarge"
        then forall (f :: * -> *) a. Applicative f => a -> f a
pure (forall a. a -> Maybe a
Just a
"Request body must be less than 1 MB")
        else
          forall a. a -> Maybe a
Just forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Object
o forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"message"
            forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Object
o 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 forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> 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)
        (forall {a}. FromXML a => Either String [Node] -> Maybe a
may' (Text -> [Node] -> Either String [Node]
firstElement Text
"Message" [Node]
x))
        (forall {a}. FromXML a => Either String [Node] -> Maybe a
may' (Text -> [Node] -> Either String [Node]
firstElement Text
"RequestId" [Node]
x) forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> 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 = forall b a. b -> Either a b -> b
fromRight Maybe ErrorCode
root forall a b. (a -> b) -> a -> b
$ forall a. FromXML a => [Node] -> Either String a
parseXML 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 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 = forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either (forall a b. a -> b -> a
const forall a. Maybe a
Nothing) forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ forall a. FromXML a => [Node] -> Either String a
parseXML 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 forall a. Maybe a
Nothing forall a. Maybe a
Nothing 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 = forall a. Abbrev -> Status -> [Header] -> a -> Error
parseRESTError Abbrev
a Status
s [Header]
h ByteStringLazy
bs
  | Bool
otherwise =
      forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either
        (SerializeError -> Error
SerializeError forall b c a. (b -> c) -> (a -> b) -> a -> c
. Abbrev
-> Status -> Maybe ByteStringLazy -> String -> SerializeError
SerializeError' Abbrev
a Status
s (forall a. a -> Maybe a
Just ByteStringLazy
bs))
        ServiceError -> Error
ServiceError
        Either String ServiceError
e