module Aws.Sqs.Response where
import Aws.Response
import Aws.Sqs.Error
import Aws.Sqs.Metadata
import Aws.Xml
import Control.Monad.IO.Class
import Data.Attempt (Attempt(..))
import Data.Conduit (($$))
import Data.IORef
import Data.Maybe
import Text.XML.Cursor (($/))
import qualified Data.Conduit as C
import qualified Data.Text.Encoding as T
import qualified Network.HTTP.Conduit as HTTP
import qualified Network.HTTP.Types as HTTP
import qualified Text.XML.Cursor as Cu
import qualified Text.XML as XML
sqsResponseConsumer :: HTTP.ResponseConsumer IO a
-> IORef SqsMetadata
-> HTTP.ResponseConsumer IO a
sqsResponseConsumer inner metadata status headers source = do
let headerString = fmap T.decodeUtf8 . flip lookup headers
let amzId2 = headerString "x-amz-id-2"
let requestId = headerString "x-amz-request-id"
let m = SqsMetadata { sqsMAmzId2 = amzId2, sqsMRequestId = requestId }
liftIO $ tellMetadataRef metadata m
if status >= HTTP.status400
then sqsErrorResponseConsumer status headers source
else inner status headers source
sqsXmlResponseConsumer :: (Cu.Cursor -> Response SqsMetadata a)
-> IORef SqsMetadata
-> HTTP.ResponseConsumer IO a
sqsXmlResponseConsumer parse metadataRef = sqsResponseConsumer (xmlCursorConsumer parse metadataRef) metadataRef
sqsErrorResponseConsumer :: HTTP.ResponseConsumer IO a
sqsErrorResponseConsumer status _headers source
= do doc <- source $$ XML.sinkDoc XML.def
let cursor = Cu.fromDocument doc
liftIO $ case parseError cursor of
Success err -> C.resourceThrow err
Failure otherErr -> C.resourceThrow otherErr
where
parseError :: Cu.Cursor -> Attempt SqsError
parseError root = do cursor <- force "Missing Error" $ root $/ Cu.laxElement "Error"
code <- force "Missing error Code" $ cursor $/ elContent "Code"
message <- force "Missing error Message" $ cursor $/ elContent "Message"
errorType <- force "Missing error Type" $ cursor $/ elContent "Type"
let detail = listToMaybe $ cursor $/ elContent "Detail"
return SqsError {
sqsStatusCode = status
, sqsErrorCode = code
, sqsErrorMessage = message
, sqsErrorType = errorType
, sqsErrorDetail = detail
, sqsErrorMetadata = Nothing
}