-- |
-- Module      : Amazonka.Error
-- Copyright   : (c) 2013-2021 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.Data
import Amazonka.Lens (Choice, Getting, Optic', filtered)
import Amazonka.Prelude
import Amazonka.Types
import qualified Data.Aeson as Aeson
import qualified Data.Aeson.Types as Aeson.Types
import qualified Data.ByteString.Lazy as LBS
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 => Getting (First ServiceError) 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 ->
  Getting (First ServiceError) a ServiceError
_MatchServiceError :: Service -> ErrorCode -> Getting (First ServiceError) a ServiceError
_MatchServiceError Service
s ErrorCode
c = Getting (First ServiceError) a ServiceError
forall a. AsError a => Prism' a ServiceError
_ServiceError Getting (First ServiceError) a ServiceError
-> ((ServiceError -> Const (First ServiceError) ServiceError)
    -> ServiceError -> Const (First ServiceError) ServiceError)
-> Getting (First ServiceError) a ServiceError
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Service
-> (ServiceError -> Const (First ServiceError) ServiceError)
-> ServiceError
-> Const (First ServiceError) ServiceError
forall (f :: * -> *) (p :: * -> * -> *).
(Applicative f, Choice p) =>
Service -> Optic' p f ServiceError ServiceError
hasService Service
s ((ServiceError -> Const (First ServiceError) ServiceError)
 -> ServiceError -> Const (First ServiceError) ServiceError)
-> ((ServiceError -> Const (First ServiceError) ServiceError)
    -> ServiceError -> Const (First ServiceError) ServiceError)
-> (ServiceError -> Const (First ServiceError) ServiceError)
-> ServiceError
-> Const (First ServiceError) ServiceError
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ErrorCode
-> (ServiceError -> Const (First ServiceError) ServiceError)
-> ServiceError
-> Const (First ServiceError) 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
400

_HttpStatus :: AsError a => Getting (First Status) a Status
_HttpStatus :: Getting (First Status) a Status
_HttpStatus = (Error -> Const (First Status) Error)
-> a -> Const (First Status) a
forall a. AsError a => Prism' a Error
_Error ((Error -> Const (First Status) Error)
 -> a -> Const (First Status) a)
-> ((Status -> Const (First Status) Status)
    -> Error -> Const (First Status) Error)
-> Getting (First Status) a Status
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Status -> Const (First Status) Status)
-> Error -> Const (First Status) 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 (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 ServiceError
e ->
        (\Status
x -> ServiceError -> Error
ServiceError (ServiceError
e {$sel:_serviceErrorStatus:ServiceError' :: Status
_serviceErrorStatus = Status
x}))
          (Status -> Error) -> f Status -> f Error
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Status -> f Status
g (ServiceError -> Status
_serviceErrorStatus ServiceError
e)

hasService ::
  (Applicative f, Choice p) =>
  Service ->
  Optic' p f ServiceError ServiceError
hasService :: Service -> Optic' p f ServiceError ServiceError
hasService Service
s = (ServiceError -> Bool) -> Optic' p f ServiceError ServiceError
forall (p :: * -> * -> *) (f :: * -> *) a.
(Choice p, Applicative f) =>
(a -> Bool) -> Optic' p f a a
filtered ((Service -> Abbrev
_serviceAbbrev Service
s 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
_serviceErrorAbbrev)

hasStatus ::
  (Applicative f, Choice p) =>
  Int ->
  Optic' p f ServiceError ServiceError
hasStatus :: 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
_serviceErrorStatus)

hasCode ::
  (Applicative f, Choice p) =>
  ErrorCode ->
  Optic' p f ServiceError ServiceError
hasCode :: 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
_serviceErrorCode)

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 (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 =
  (String -> Maybe RequestId)
-> (RequestId -> Maybe RequestId)
-> Either String RequestId
-> Maybe RequestId
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either (Maybe RequestId -> String -> Maybe RequestId
forall a b. a -> b -> a
const Maybe RequestId
forall a. Maybe a
Nothing) RequestId -> Maybe RequestId
forall a. a -> Maybe a
Just ([Header]
h [Header] -> HeaderName -> Either String RequestId
forall a. FromText a => [Header] -> HeaderName -> Either String a
.# HeaderName
hAMZRequestId Either String RequestId
-> Either String RequestId -> Either String RequestId
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> [Header]
h [Header] -> HeaderName -> Either String RequestId
forall a. FromText a => [Header] -> HeaderName -> Either String a
.# HeaderName
hAMZNRequestId)

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
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 -> Text -> Parser ErrorCode
forall a. FromJSON a => Object -> Text -> Parser a
.: Text
"__type") Parser (Maybe ErrorCode)
-> Parser (Maybe ErrorCode) -> Parser (Maybe ErrorCode)
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Object
o Object -> Text -> Parser (Maybe ErrorCode)
forall a. FromJSON a => Object -> Text -> Parser (Maybe a)
.:? Text
"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 (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 (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 -> Text -> Parser a
forall a. FromJSON a => Object -> Text -> Parser a
.: Text
"message"
            Parser (Maybe a) -> Parser (Maybe a) -> Parser (Maybe a)
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Object
o Object -> Text -> Parser (Maybe a)
forall a. FromJSON a => Object -> Text -> Parser (Maybe a)
.:? Text
"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 (ByteStringLazy -> Either String [Node]
forall a. FromXML a => ByteStringLazy -> Either String a
decodeXML ByteStringLazy
bs Either String [Node]
-> ([Node] -> Either String ServiceError)
-> Either String ServiceError
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= [Node] -> Either String ServiceError
go)
  where
    go :: [Node] -> Either String ServiceError
go [Node]
x =
      Abbrev
-> Status
-> [Header]
-> Maybe ErrorCode
-> Maybe ErrorMessage
-> Maybe RequestId
-> ServiceError
serviceError Abbrev
a Status
s [Header]
h
        (Maybe ErrorCode
 -> Maybe ErrorMessage -> Maybe RequestId -> ServiceError)
-> Either String (Maybe ErrorCode)
-> Either
     String (Maybe ErrorMessage -> Maybe RequestId -> ServiceError)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [Node] -> Either String (Maybe ErrorCode)
code [Node]
x
        Either
  String (Maybe ErrorMessage -> Maybe RequestId -> ServiceError)
-> Either String (Maybe ErrorMessage)
-> Either String (Maybe RequestId -> ServiceError)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Either String [Node] -> Either String (Maybe ErrorMessage)
forall a a. FromXML a => Either a [Node] -> Either String (Maybe a)
may' (Text -> [Node] -> Either String [Node]
firstElement Text
"Message" [Node]
x)
        Either String (Maybe RequestId -> ServiceError)
-> Either String (Maybe RequestId) -> Either String ServiceError
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Either String [Node] -> Either String (Maybe RequestId)
forall a a. FromXML a => Either a [Node] -> Either String (Maybe a)
may' (Text -> [Node] -> Either String [Node]
firstElement Text
"RequestId" [Node]
x Either String [Node]
-> Either String [Node] -> Either String [Node]
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Text -> [Node] -> Either String [Node]
firstElement Text
"RequestID" [Node]
x)

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

    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 a [Node] -> Either String (Maybe a)
may' (Left a
_) = Maybe a -> Either String (Maybe a)
forall (f :: * -> *) a. Applicative f => a -> f a
pure Maybe a
forall a. Maybe a
Nothing
    may' (Right [Node]
x) = a -> Maybe a
forall a. a -> Maybe a
Just (a -> Maybe a) -> Either String a -> Either String (Maybe a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [Node] -> Either String a
forall a. FromXML a => [Node] -> Either String a
parseXML [Node]
x

parseRESTError ::
  Abbrev ->
  Status ->
  [Header] ->
  a ->
  Error
parseRESTError :: 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