diff --git a/amazonka-core.cabal b/amazonka-core.cabal --- a/amazonka-core.cabal +++ b/amazonka-core.cabal @@ -1,5 +1,5 @@ name: amazonka-core -version: 0.2.3 +version: 0.3.0 synopsis: Core functionality and data types for Amazonka libraries. homepage: https://github.com/brendanhay/amazonka license: OtherLicense @@ -81,7 +81,6 @@ , conduit >= 1.1 && < 1.3 , conduit-extra == 1.1.* , cryptohash == 0.11.* - , cryptohash-conduit >= 0.1.1 , data-default-class >= 0.0.1 , hashable >= 1.2 , http-client >= 0.4.3 && < 0.5 @@ -96,7 +95,7 @@ , text >= 1.1 , time >= 1.5 , transformers == 0.4.* - , unordered-containers >= 0.2.3 + , unordered-containers >= 0.2.5 , vector >= 0.10.9 , xml-conduit == 1.2.* diff --git a/src/Network/AWS/Data/Internal/Body.hs b/src/Network/AWS/Data/Internal/Body.hs --- a/src/Network/AWS/Data/Internal/Body.hs +++ b/src/Network/AWS/Data/Internal/Body.hs @@ -13,28 +13,20 @@ module Network.AWS.Data.Internal.Body where -import Control.Applicative import Control.Lens -import Control.Monad.IO.Class import Control.Monad.Morph import Control.Monad.Trans.Resource import Crypto.Hash -import qualified Crypto.Hash.Conduit as Conduit import Data.Aeson import Data.ByteString (ByteString) -import qualified Data.ByteString as BS import qualified Data.ByteString.Lazy as LBS import qualified Data.ByteString.Lazy.Char8 as LBS8 import Data.Conduit -import qualified Data.Conduit.Binary as Conduit -import Data.IORef -import Data.Int import Data.List (intersperse) import Data.Monoid import Data.String import Network.AWS.Data.Internal.ByteString import Network.HTTP.Client -import System.IO data RsBody = RsBody (ResumableSource (ResourceT IO) ByteString) @@ -97,34 +89,3 @@ instance ToBody Value where toBody = toBody . encode - -sourceBody :: Digest SHA256 -> Int64 -> Source IO ByteString -> RqBody -sourceBody h n = RqBody h . RequestBodyStream n . sourcePopper - -sourceHandle :: Digest SHA256 -> Int64 -> Handle -> RqBody -sourceHandle h n = sourceBody h n . Conduit.sourceHandle - -sourceFile :: Digest SHA256 -> Int64 -> FilePath -> RqBody -sourceFile h n = sourceBody h n . hoist runResourceT . Conduit.sourceFile - -sourceFileIO :: MonadIO m => FilePath -> m RqBody -sourceFileIO f = liftIO $ sourceFile - <$> runResourceT (Conduit.sourceFile f $$ Conduit.sinkHash) - <*> (fromIntegral <$> withBinaryFile f ReadMode hFileSize) - <*> pure f - -sourcePopper :: Source IO ByteString -> GivesPopper () -sourcePopper src f = do - (rsrc0, ()) <- src $$+ return () - irsrc <- newIORef rsrc0 - let popper :: IO ByteString - popper = do - rsrc <- readIORef irsrc - (rsrc', mres) <- rsrc $$++ await - writeIORef irsrc rsrc' - case mres of - Nothing -> return mempty - Just bs - | BS.null bs -> popper - | otherwise -> return bs - f popper diff --git a/src/Network/AWS/Request/RestJSON.hs b/src/Network/AWS/Request/RestJSON.hs --- a/src/Network/AWS/Request/RestJSON.hs +++ b/src/Network/AWS/Request/RestJSON.hs @@ -17,17 +17,18 @@ , delete , post , put + , stream ) where -import Control.Applicative -import Control.Lens hiding (Action) -import Data.Aeson -import Data.Monoid -import Network.AWS.Data -import Network.AWS.Request.Internal -import Network.AWS.Types -import Network.HTTP.Types.Header -import Network.HTTP.Types.Method +import Control.Applicative +import Control.Lens hiding (Action) +import Data.Aeson +import Data.Monoid +import Network.AWS.Data +import Network.AWS.Request.Internal +import Network.AWS.Types +import Network.HTTP.Types.Header +import Network.HTTP.Types.Method get :: (ToPath a, ToQuery a, ToHeaders a) => a -> Request a get = defaultRequest @@ -48,11 +49,21 @@ -> Request a put x = get x & rqMethod .~ PUT - & rqHeaders <>~ toHeader hContentType content + & rqHeaders <>~ toHeader hContentType ct & rqBody .~ toBody (toJSON x) where - content = ("application/x-amz-json-" <>) <$> _svcJSONVersion svc + ct = ("application/x-amz-json-" <>) <$> _svcJSONVersion svc svc :: Service (Sv a) svc = service {-# INLINE put #-} + +stream :: (AWSService (Sv a), ToPath a, ToQuery a, ToHeaders a, ToBody a) + => StdMethod + -> a + -> Request a +stream m x = content $ get x & rqMethod .~ m & rqBody .~ toBody x +{-# INLINE stream #-} + +content :: Request a -> Request a +content rq = rq & rqHeaders %~ hdr hAMZContentSHA256 (bodyHash (rq ^. rqBody)) diff --git a/src/Network/AWS/Request/S3.hs b/src/Network/AWS/Request/S3.hs --- a/src/Network/AWS/Request/S3.hs +++ b/src/Network/AWS/Request/S3.hs @@ -17,12 +17,12 @@ , stream ) where -import Control.Lens -import Network.AWS.Data -import Network.AWS.Request.Internal -import Network.AWS.Types -import Network.HTTP.Types.Method -import Prelude hiding (head) +import Control.Lens +import Network.AWS.Data +import Network.AWS.Request.Internal +import Network.AWS.Types +import Network.HTTP.Types.Method +import Prelude hiding (head) get :: (ToPath a, ToQuery a, ToHeaders a) => a -> Request a get = content . defaultRequest diff --git a/src/Network/AWS/Response.hs b/src/Network/AWS/Response.hs --- a/src/Network/AWS/Response.hs +++ b/src/Network/AWS/Response.hs @@ -36,7 +36,8 @@ import Data.Conduit import qualified Data.Conduit.Binary as Conduit import Data.Monoid -import Network.AWS.Data (LazyByteString, FromXML(..), decodeXML, build) +import Network.AWS.Data (FromXML (..), LazyByteString, + build, decodeXML) import Network.AWS.Types import Network.HTTP.Client hiding (Request, Response) import Network.HTTP.Types @@ -48,7 +49,7 @@ -> Request a -> Either HttpException ClientResponse -> m (Response' a) -nullResponse rs l = receive l $ \_ _ bdy -> +nullResponse rs l = receive l $ \_ _ _ bdy -> liftResourceT (bdy $$+- return (Right rs)) headerResponse :: (MonadResource m, AWSService (Sv a)) @@ -57,14 +58,14 @@ -> Request a -> Either HttpException ClientResponse -> m (Response' a) -headerResponse f = deserialise (const (Right ())) (const . f) +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) (const Right) +xmlResponse = deserialise (decodeXML >=> parseXML) (\_ _ -> Right) xmlHeaderResponse :: (MonadResource m, AWSService (Sv a)) => (ResponseHeaders -> [Node] -> Either String (Rs a)) @@ -72,17 +73,17 @@ -> Request a -> Either HttpException ClientResponse -> m (Response' a) -xmlHeaderResponse = deserialise decodeXML +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' (const Right) +jsonResponse = deserialise eitherDecode' (\_ _ -> Right) jsonHeaderResponse :: (MonadResource m, AWSService (Sv a)) - => (ResponseHeaders -> Object -> Either String (Rs a)) + => (ResponseHeaders -> Int -> Object -> Either String (Rs a)) -> Logger -> Request a -> Either HttpException ClientResponse @@ -90,33 +91,33 @@ jsonHeaderResponse = deserialise eitherDecode' bodyResponse :: (MonadResource m, AWSService (Sv a)) - => (ResponseHeaders -> ResponseBody -> Either String (Rs a)) + => (ResponseHeaders -> Int -> ResponseBody -> Either String (Rs a)) -> Logger -> Request a -> Either HttpException ClientResponse -> m (Response' a) -bodyResponse f l = receive l $ \a hs bdy -> - return (SerializerError a `first` f hs bdy) +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 -> b -> Either String (Rs a)) + => (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 bdy -> do +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 o of + 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 -> ResponseBody -> m (Response a)) + -> (Abbrev -> ResponseHeaders -> Int -> ResponseBody -> m (Response a)) -> Request a -> Either HttpException ClientResponse -> m (Response' a) @@ -129,7 +130,7 @@ case _svcHandle svc s of Just g -> Left . g <$> sinkLbs l bdy Nothing -> do - x <- f (_svcAbbrev svc) hs bdy + x <- f (_svcAbbrev svc) hs (fromEnum s) bdy case x of Left e -> return (Left e) Right y -> return (Right (s, y))