amazonka-core 1.4.1 → 1.4.2

raw patch · 4 files changed

+47/−38 lines, 4 filesdep ~timePVP: major bump suggested

API removals or changes: PVP suggests a major version bump

Dependency ranges changed: time

API changes (from Hackage documentation)

Files

• amazonka-core.cabal +2/−2
• src/Network/AWS/Error.hs +3/−3
• src/Network/AWS/Response.hs +38/−32
• src/Network/AWS/Types.hs +4/−1

@@ -1,5 +1,5 @@ name:                  amazonka-core-version:               1.4.1+version:               1.4.2 synopsis:              Core data types and functionality for Amazonka libraries. homepage:              https://github.com/brendanhay/amazonka bug-reports:           https://github.com/brendanhay/amazonka/issues@@ -109,7 +109,7 @@             , time       >= 1.2 && < 1.5     else         build-depends:-              time       >= 1.5 && < 1.6+              time       >= 1.5  test-suite tests     type:              exitcode-stdio-1.0

@@ -40,8 +40,8 @@             -> TransportError <$> (StatusCodeException <$> g s <*> pure h <*> pure c)         TransportError e             -> pure (TransportError e)-        SerializeError (SerializeError' a s e)-            -> g s <&> \x -> SerializeError (SerializeError' a x e)+        SerializeError (SerializeError' a s b e)+            -> g s <&> \x -> SerializeError (SerializeError' a x b e)         ServiceError e             -> g (_serviceStatus e) <&> \x -> ServiceError (e { _serviceStatus = x }) @@ -132,6 +132,6 @@ decodeError a s h bs e     | LBS.null bs = parseRESTError a s h bs     | otherwise   =-        either (SerializeError . SerializeError' a s)+        either (SerializeError . SerializeError' a s (Just bs))                ServiceError                e

@@ -14,6 +14,7 @@ -- module Network.AWS.Response where +import           Control.Applicative          (pure) import           Control.Monad.Catch import           Control.Monad.IO.Class import           Control.Monad.Trans.Resource@@ -39,8 +40,8 @@             -> Proxy a             -> ClientResponse             -> m (Response a)-receiveNull rs _ = receive $ \_ _ x ->-    liftResourceT (x $$+- return (Right rs))+receiveNull rs _ = stream $ \_ _ x ->+    liftResourceT (x $$+- pure (Right rs))  receiveEmpty :: MonadResource m              => (Int -> ResponseHeaders -> () -> Either String (Rs a))@@ -49,8 +50,8 @@              -> Proxy a              -> ClientResponse              -> m (Response a)-receiveEmpty f _ = receive $ \s h x ->-    liftResourceT (x $$+- return (f s h ()))+receiveEmpty f _ = stream $ \s h x ->+    liftResourceT (x $$+- pure (f s h ()))  receiveXMLWrapper :: MonadResource m                   => Text@@ -87,8 +88,9 @@             -> Proxy a             -> ClientResponse             -> m (Response a)-receiveBody f _ = receive $ \s h x -> return (f s h (RsBody x))+receiveBody f _ = stream $ \s h x -> pure (f s h (RsBody x)) +-- | Deserialise an entire response body, such as an XML or JSON payload. deserialise :: MonadResource m             => (LazyByteString -> Either String b)             -> (Int -> ResponseHeaders -> b -> Either String (Rs a))@@ -97,34 +99,38 @@             -> Proxy a             -> ClientResponse             -> m (Response a)-deserialise g f l = receive $ \s h x -> do-    lbs <- sinkLBS x-    liftIO . l Debug . build $ "[Raw Response Body] {\n" <> lbs <> "\n}"-    return $! g lbs >>= f s h--receive :: MonadResource m-        => (Int -> ResponseHeaders -> ResponseBody -> m (Either String (Rs a)))-        -> Service-        -> Proxy a-        -> ClientResponse-        -> m (Response a)-receive f Service{..} _ rs-    | not (_svcCheck s) = sinkLBS x >>= serviceErr-    | otherwise          = do-        p <- f (fromEnum s) h x-        either serializeErr-               (return . (s,))-               p-  where-    s = responseStatus  rs-    h = responseHeaders rs-    x = responseBody    rs--    serviceErr :: MonadThrow m => LazyByteString -> m a-    serviceErr = throwM . _svcError _svcAbbrev s h+deserialise g f l Service{..} _ rs = do+    let s = responseStatus  rs+        h = responseHeaders rs+        x = responseBody    rs+    b <- sinkLBS x+    if not (_svcCheck s)+        then throwM (_svcError s h b)+        else do+            liftIO . l Debug . build $ "[Raw Response Body] {\n" <> b <> "\n}"+            case g b >>= f (fromEnum s) h of+                Right r -> pure (s, r)+                Left  e -> throwM . SerializeError $+                    SerializeError' _svcAbbrev s (Just b) e -    serializeErr :: MonadThrow m => String -> m a-    serializeErr e = throwM (SerializeError (SerializeError' _svcAbbrev s e))+-- | Stream a raw response body, such as an S3 object payload.+stream :: MonadResource m+       => (Int -> ResponseHeaders -> ResponseBody -> m (Either String (Rs a)))+       -> Service+       -> Proxy a+       -> ClientResponse+       -> m (Response a)+stream f Service{..} _ rs = do+    let s = responseStatus  rs+        h = responseHeaders rs+        x = responseBody    rs+    if not (_svcCheck s)+        then sinkLBS x >>= throwM . _svcError s h+        else do+            e <- f (fromEnum s) h x+            either (throwM . SerializeError . SerializeError' _svcAbbrev s Nothing)+                   (pure . (s,))+                   e  sinkLBS :: MonadResource m => ResponseBody -> m LazyByteString sinkLBS bdy = liftResourceT (bdy $$+- Conduit.sinkLbs)

@@ -223,6 +223,8 @@ data SerializeError = SerializeError'     { _serializeAbbrev  :: !Abbrev     , _serializeStatus  :: !Status+    , _serializeBody    :: Maybe LazyByteString+      -- ^ The response body, if the response was not streaming.     , _serializeMessage :: String     } deriving (Eq, Show, Typeable) @@ -232,6 +234,7 @@         , "  service = " <> build _serializeAbbrev         , "  status  = " <> build _serializeStatus         , "  message = " <> build _serializeMessage+        , "  body    = " <> build _serializeBody         , "}"         ] @@ -418,7 +421,7 @@     , _svcEndpoint :: !(Region -> Endpoint)     , _svcTimeout  :: !(Maybe Seconds)     , _svcCheck    :: !(Status -> Bool)-    , _svcError    :: !(Abbrev -> Status -> [Header] -> LazyByteString -> Error)+    , _svcError    :: !(Status -> [Header] -> LazyByteString -> Error)     , _svcRetry    :: !Retry     }