module Network.AWS.Error
(
statusSuccess
, AWSError (..)
, AWSErrorCode (..)
, ErrorCode (..)
, ErrorType (..)
, ServiceError (..)
, RESTError
, restRequestId
, restType
, restCode
, restMessage
, restError
, JSONError
, jsonType
, jsonCode
, jsonMessage
, jsonError
) where
import Control.Applicative
import Control.Lens
import Data.Aeson
import qualified Data.ByteString.Lazy as LBS
import Data.ByteString.Lazy.Char8 (unpack)
import Data.String
import Data.Text (Text)
import GHC.Generics
import Network.AWS.Data
import Network.AWS.Types
import Network.HTTP.Types
statusSuccess :: Status -> Bool
statusSuccess (statusCode -> n) = n >= 200 && n < 400
class AWSError a where
awsError :: a -> ServiceError String
instance Show a => AWSError (ServiceError a) where
awsError = \case
HttpError e -> HttpError e
SerializerError a e -> SerializerError a e
ServiceError a s x -> ServiceError a s (show x)
Errors xs -> Errors (map awsError xs)
newtype ErrorCode = ErrorCode Text
deriving (Eq, Ord, Show, FromXML, FromJSON, IsString, Generic)
class AWSErrorCode a where
awsErrorCode :: a -> ErrorCode
data ErrorType
= Receiver
| Sender
deriving (Eq, Ord, Enum, Show, Generic)
instance FromText ErrorType where
parser = takeText >>= \case
"Receiver" -> pure Receiver
"Sender" -> pure Sender
e -> fail $ "Failure parsing ErrorType from " ++ show e
instance FromXML ErrorType where
parseXML = parseXMLText "Type"
data RESTError = RESTError
{ _restRequestId :: Text
, _restType :: Maybe ErrorType
, _restCode :: ErrorCode
, _restMessage :: Text
} deriving (Eq, Show, Generic)
makeLenses ''RESTError
instance AWSErrorCode RESTError where
awsErrorCode = _restCode
instance FromXML RESTError where
parseXML x = withElement "Error" f x <|> f x
where
f y = RESTError
<$> x .@ "RequestId"
<*> y .@? "Type"
<*> y .@ "Code"
<*> y .@ "Message"
restError :: FromXML (Er a)
=> (Status -> Bool)
-> Service a
-> Status
-> Maybe (LBS.ByteString -> ServiceError (Er a))
restError f Service{..} s
| f s = Nothing
| otherwise = Just go
where
go x = either failure success (decodeXML x >>= parseXML)
where
failure e = SerializerError _svcAbbrev (e ++ ":\n" ++ unpack x)
success = ServiceError _svcAbbrev s
data JSONError = JSONError
{ _jsonType :: Maybe Text
, _jsonCode :: ErrorCode
, _jsonMessage :: Text
} deriving (Eq, Show, Generic)
makeLenses ''JSONError
instance AWSErrorCode JSONError where
awsErrorCode = _jsonCode
instance FromJSON JSONError where
parseJSON = withObject "JSONError" $ \o -> rest o <|> post o
where
rest o = JSONError
<$> o .:? "Type"
<*> o .: "Code"
<*> o .: "Message"
post o = JSONError
<$> o .:? "__type"
<*> o .: "code"
<*> o .: "message"
jsonError :: FromJSON (Er a)
=> (Status -> Bool)
-> Service a
-> Status
-> Maybe (LBS.ByteString -> ServiceError (Er a))
jsonError f Service{..} s
| f s = Nothing
| otherwise = Just go
where
go x = either failure success (eitherDecode' x)
where
failure e = SerializerError _svcAbbrev (e ++ ":\n" ++ unpack x)
success = ServiceError _svcAbbrev s