module Network.AWS.Error where
import Control.Applicative
import Control.Lens
import Control.Monad
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 = match "Receiver" Receiver
<|> match "Sender" Sender
instance FromXML ErrorType where
parseXML = parseXMLText "Type"
data RESTMessage = RESTMessage
{ _msgType :: !ErrorType
, _msgCode :: Text
, _msgRESTMessage :: Text
} deriving (Eq, Ord, Show, Generic)
makeLenses ''RESTMessage
instance FromXML RESTMessage where
parseXML x = RESTMessage
<$> x .@ "Type"
<*> x .@ "Code"
<*> x .@ "Message"
data RESTError = RESTError
{ _errError :: RESTMessage
, _errRequestId :: Text
} deriving (Eq, Show, Generic)
makeLenses ''RESTError
instance FromXML RESTError where
parseXML x = RESTError
<$> x .@ "Error"
<*> x .@ "RequestId"
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
{ _errType :: Maybe Text
, _errMessage :: Text
} deriving (Eq, Show, Generic)
makeLenses ''JSONError
instance FromJSON JSONError where
parseJSON = withObject "JSONError" $ \o -> JSONError
<$> (o .:? "__type" <|> o .:? "Type")
<*> (o .: "message" <|> 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