module Network.AWS.Error
(
statusSuccess
, ErrorType (..)
, RESTError
, restRequestId
, restType
, restCode
, restMessage
, restError
, JSONError
, jsonType
, 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.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
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 :: Text
, _restMessage :: Text
} deriving (Eq, Show, Generic)
makeLenses ''RESTError
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
, _jsonMessage :: Text
} deriving (Eq, Show, Generic)
makeLenses ''JSONError
instance FromJSON JSONError where
parseJSON = withObject "JSONError" $ \o -> rest o <|> post o
where
rest o = JSONError <$> o .:? "Type" <*> o .: "Message"
post o = JSONError <$> o .:? "__type" <*> 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