module Network.AWS.Response
(
nullResponse
, headerResponse
, xmlResponse
, xmlHeaderResponse
, jsonResponse
, jsonHeaderResponse
, bodyResponse
) where
import Control.Applicative
import Control.Monad
import Control.Monad.IO.Class
import Control.Monad.Trans.Resource
import Data.Aeson
import Data.Bifunctor
import qualified Data.ByteString.Lazy as LBS
import Data.Conduit
import qualified Data.Conduit.Binary as Conduit
import Data.Monoid
import Network.AWS.Data (FromXML (..), LazyByteString,
build, decodeXML)
import Network.AWS.Types
import Network.HTTP.Client hiding (Request, Response)
import Network.HTTP.Types
import Text.XML (Node)
nullResponse :: (MonadResource m, AWSService (Sv a))
=> Rs a
-> Logger
-> Request a
-> Either HttpException ClientResponse
-> m (Response' a)
nullResponse rs l = receive l $ \_ _ _ bdy ->
liftResourceT (bdy $$+- return (Right rs))
headerResponse :: (MonadResource m, AWSService (Sv a))
=> (ResponseHeaders -> Either String (Rs a))
-> Logger
-> Request a
-> Either HttpException ClientResponse
-> m (Response' a)
headerResponse f = deserialise (const (Right ())) (\hs _ _ -> f hs)
xmlResponse :: (MonadResource m, AWSService (Sv a), FromXML (Rs a))
=> Logger
-> Request a
-> Either HttpException ClientResponse
-> m (Response' a)
xmlResponse = deserialise (decodeXML >=> parseXML) (\_ _ -> Right)
xmlHeaderResponse :: (MonadResource m, AWSService (Sv a))
=> (ResponseHeaders -> [Node] -> Either String (Rs a))
-> Logger
-> Request a
-> Either HttpException ClientResponse
-> m (Response' a)
xmlHeaderResponse f = deserialise decodeXML (\hs _ -> f hs)
jsonResponse :: (MonadResource m, AWSService (Sv a), FromJSON (Rs a))
=> Logger
-> Request a
-> Either HttpException ClientResponse
-> m (Response' a)
jsonResponse = deserialise eitherDecode' (\_ _ -> Right)
jsonHeaderResponse :: (MonadResource m, AWSService (Sv a))
=> (ResponseHeaders -> Int -> Object -> Either String (Rs a))
-> Logger
-> Request a
-> Either HttpException ClientResponse
-> m (Response' a)
jsonHeaderResponse = deserialise eitherDecode'
bodyResponse :: (MonadResource m, AWSService (Sv a))
=> (ResponseHeaders -> Int -> ResponseBody -> Either String (Rs a))
-> Logger
-> Request a
-> Either HttpException ClientResponse
-> m (Response' a)
bodyResponse f l = receive l $ \a hs s bdy ->
return (SerializerError a `first` f hs s bdy)
deserialise :: (AWSService (Sv a), MonadResource m)
=> (LazyByteString -> Either String b)
-> (ResponseHeaders -> Int -> b -> Either String (Rs a))
-> Logger
-> Request a
-> Either HttpException ClientResponse
-> m (Response' a)
deserialise g f l = receive l $ \a hs s bdy -> do
lbs <- sinkLbs l bdy
return $! case g lbs of
Left e -> Left (SerializerError a e)
Right o ->
case f hs s o of
Left e -> Left (SerializerError a e)
Right x -> Right x
receive :: forall m a. (MonadResource m, AWSService (Sv a))
=> Logger
-> (Abbrev -> ResponseHeaders -> Int -> ResponseBody -> m (Response a))
-> Request a
-> Either HttpException ClientResponse
-> m (Response' a)
receive l f = const (either (return . Left . HttpError) success)
where
success rs = do
let s = responseStatus rs
bdy = responseBody rs
hs = responseHeaders rs
case _svcHandle svc s of
Just g -> Left . g <$> sinkLbs l bdy
Nothing -> do
x <- f (_svcAbbrev svc) hs (fromEnum s) bdy
case x of
Left e -> return (Left e)
Right y -> return (Right (s, y))
svc = service :: Service (Sv a)
sinkLbs :: MonadResource m => Logger -> ResponseBody -> m LBS.ByteString
sinkLbs l bdy = do
lbs <- liftResourceT (bdy $$+- Conduit.sinkLbs)
liftIO $ l Trace ("[Client Response Body] {\n" <> build lbs <> "\n}")
return lbs