diff --git a/Aws/Core.hs b/Aws/Core.hs --- a/Aws/Core.hs +++ b/Aws/Core.hs @@ -1,4 +1,4 @@ -{-# LANGUAGE MultiParamTypeClasses, FunctionalDependencies, TypeFamilies, FlexibleContexts, FlexibleInstances, DeriveFunctor, OverloadedStrings, RecordWildCards, DeriveDataTypeable #-} +{-# LANGUAGE MultiParamTypeClasses, FunctionalDependencies, TypeFamilies, FlexibleContexts, FlexibleInstances, DeriveFunctor, OverloadedStrings, RecordWildCards, DeriveDataTypeable, Rank2Types, ExistentialQuantification #-} module Aws.Core ( -- * Response -- ** Metadata in responses @@ -72,11 +72,11 @@ import Control.Arrow import Control.Monad import Control.Monad.IO.Class -import Data.Attempt (Attempt(..)) -import Data.ByteString (ByteString) -import Data.ByteString.Char8 ({- IsString -}) +import Data.Attempt (Attempt(..)) +import Data.ByteString (ByteString) +import Data.ByteString.Char8 ({- IsString -}) import Data.Char -import Data.Conduit (Source, ResourceT, ($$)) +import Data.Conduit (ResourceT, ($$+-)) import Data.IORef import Data.List import Data.Maybe @@ -86,30 +86,31 @@ import Data.Word import System.Directory import System.Environment -import System.FilePath (()) +import System.FilePath (()) import System.Locale -import Text.XML.Cursor hiding (force, forceM) -import qualified Blaze.ByteString.Builder as Blaze -import qualified Control.Exception as E -import qualified Control.Failure as F -import qualified Crypto.Classes as Crypto -import qualified Crypto.HMAC as HMAC -import qualified Crypto.Hash.SHA1 as SHA1 -import qualified Crypto.Hash.SHA256 as SHA256 -import qualified Data.ByteString as B -import qualified Data.ByteString.Base64 as Base64 -import qualified Data.ByteString.Lazy as L -import qualified Data.ByteString.UTF8 as BU -import qualified Data.Conduit as C -import qualified Data.Conduit.List as CL -import qualified Data.Serialize as Serialize -import qualified Data.Text as T -import qualified Data.Text.Encoding as T -import qualified Data.Text.IO as T -import qualified Network.HTTP.Conduit as HTTP -import qualified Network.HTTP.Types as HTTP -import qualified Text.XML as XML -import qualified Text.XML.Cursor as Cu +import Text.XML.Cursor hiding (force, forceM) +import qualified Blaze.ByteString.Builder as Blaze +import qualified Control.Exception as E +import qualified Control.Failure as F +import qualified Crypto.Classes as Crypto +import qualified Crypto.HMAC as HMAC +import qualified Crypto.Hash.MD5 as MD5 +import qualified Crypto.Hash.SHA1 as SHA1 +import qualified Crypto.Hash.SHA256 as SHA256 +import qualified Data.ByteString as B +import qualified Data.ByteString.Base64 as Base64 +import qualified Data.ByteString.Lazy as L +import qualified Data.ByteString.UTF8 as BU +import qualified Data.Conduit as C +import qualified Data.Conduit.List as CL +import qualified Data.Serialize as Serialize +import qualified Data.Text as T +import qualified Data.Text.Encoding as T +import qualified Data.Text.IO as T +import qualified Network.HTTP.Conduit as HTTP +import qualified Network.HTTP.Types as HTTP +import qualified Text.XML as XML +import qualified Text.XML.Cursor as Cu -- | A response with metadata. Can also contain an error response, or an internal error, via 'Attempt'. -- @@ -137,7 +138,7 @@ -- | A full HTTP response parser. Takes HTTP status, response headers, and response body. type HTTPResponseConsumer a = HTTP.Status -> HTTP.ResponseHeaders - -> Source (ResourceT IO) ByteString + -> C.ResumableSource (ResourceT IO) ByteString -> ResourceT IO a -- | Class for types that AWS HTTP responses can be parsed into. @@ -156,7 +157,7 @@ instance ResponseConsumer r (HTTP.Response L.ByteString) where type ResponseMetadata (HTTP.Response L.ByteString) = () responseConsumer _ _ status headers bufsource = do - chunks <- bufsource $$ CL.consume + chunks <- bufsource $$+- CL.consume return (HTTP.Response status HTTP.http11 headers $ L.fromChunks chunks) -- | Associates a request type and a response type in a bi-directional way. @@ -290,7 +291,7 @@ -- | Request body content type. , sqContentType :: Maybe B.ByteString -- | Request body content MD5. - , sqContentMd5 :: Maybe B.ByteString + , sqContentMd5 :: Maybe MD5.MD5 -- | Additional Amazon "amz" headers. , sqAmzHeaders :: HTTP.RequestHeaders -- | Additional non-"amz" headers. @@ -316,7 +317,7 @@ , HTTP.queryString = HTTP.renderQuery False sqQuery , HTTP.requestHeaders = catMaybes [fmap (\d -> ("Date", fmtRfc822Time d)) sqDate , fmap (\c -> ("Content-Type", c)) contentType - , fmap (\md5 -> ("Content-MD5", md5)) sqContentMd5 + , fmap (\md5 -> ("Content-MD5", Serialize.encode md5)) sqContentMd5 , fmap (\auth -> ("Authorization", auth)) sqAuthorization] ++ sqAmzHeaders ++ sqOtherHeaders @@ -559,7 +560,7 @@ -> IORef m -> HTTPResponseConsumer a xmlCursorConsumer parse metadataRef _status _headers source - = do doc <- source $$ XML.sinkDoc XML.def + = do doc <- source $$+- XML.sinkDoc XML.def let cursor = Cu.fromDocument doc let Response metadata x = parse cursor liftIO $ tellMetadataRef metadataRef metadata diff --git a/Aws/S3/Commands/GetBucket.hs b/Aws/S3/Commands/GetBucket.hs --- a/Aws/S3/Commands/GetBucket.hs +++ b/Aws/S3/Commands/GetBucket.hs @@ -5,15 +5,15 @@ import Aws.Core import Aws.S3.Core import Control.Applicative -import Control.Arrow (second) -import Data.ByteString.Char8 ({- IsString -}) +import Data.ByteString.Char8 ({- IsString -}) import Data.Maybe -import Text.XML.Cursor (($/), (&|), (&//)) -import qualified Data.Text as T -import qualified Data.Text.Encoding as T +import Text.XML.Cursor (($/), (&|), (&//)) +import qualified Data.ByteString.Char8 as B8 +import qualified Data.Text as T +import qualified Data.Text.Encoding as T import qualified Data.Traversable -import qualified Network.HTTP.Types as HTTP -import qualified Text.XML.Cursor as Cu +import qualified Network.HTTP.Types as HTTP +import qualified Text.XML.Cursor as Cu data GetBucket = GetBucket { @@ -55,8 +55,8 @@ , s3QBucket = Just $ T.encodeUtf8 gbBucket , s3QObject = Nothing , s3QSubresources = [] - , s3QQuery = HTTP.simpleQueryToQuery $ map (second T.encodeUtf8) $ catMaybes [ - ("delimiter",) <$> gbDelimiter + , s3QQuery = HTTP.toQuery [ + ("delimiter" :: B8.ByteString ,) <$> gbDelimiter , ("marker",) <$> gbMarker , ("max-keys",) . T.pack . show <$> gbMaxKeys , ("prefix",) <$> gbPrefix diff --git a/Aws/S3/Commands/GetObject.hs b/Aws/S3/Commands/GetObject.hs --- a/Aws/S3/Commands/GetObject.hs +++ b/Aws/S3/Commands/GetObject.hs @@ -5,9 +5,8 @@ import Aws.Core import Aws.S3.Core import Control.Applicative -import Control.Arrow (second) import Data.ByteString.Char8 ({- IsString -}) -import Data.Maybe +import qualified Data.ByteString.Char8 as B8 import qualified Data.Text as T import qualified Data.Text.Encoding as T import qualified Network.HTTP.Types as HTTP @@ -17,6 +16,7 @@ goBucket :: Bucket , goObjectName :: Object , goResponseConsumer :: HTTPResponseConsumer a + , goVersionId :: Maybe T.Text , goResponseContentType :: Maybe T.Text , goResponseContentLanguage :: Maybe T.Text , goResponseExpires :: Maybe T.Text @@ -26,7 +26,7 @@ } getObject :: Bucket -> T.Text -> HTTPResponseConsumer a -> GetObject a -getObject b o i = GetObject b o i Nothing Nothing Nothing Nothing Nothing Nothing +getObject b o i = GetObject b o i Nothing Nothing Nothing Nothing Nothing Nothing Nothing data GetObjectResponse a = GetObjectResponse ObjectMetadata a @@ -39,9 +39,11 @@ s3QMethod = Get , s3QBucket = Just $ T.encodeUtf8 goBucket , s3QObject = Just $ T.encodeUtf8 goObjectName - , s3QSubresources = [] - , s3QQuery = HTTP.simpleQueryToQuery $ map (second T.encodeUtf8) $ catMaybes [ - ("response-content-type",) <$> goResponseContentType + , s3QSubresources = HTTP.toQuery [ + ("versionId" :: B8.ByteString,) <$> goVersionId + ] + , s3QQuery = HTTP.toQuery [ + ("response-content-type" :: B8.ByteString,) <$> goResponseContentType , ("response-content-language",) <$> goResponseContentLanguage , ("response-expires",) <$> goResponseExpires , ("response-cache-control",) <$> goResponseCacheControl @@ -58,8 +60,8 @@ instance ResponseConsumer (GetObject a) (GetObjectResponse a) where type ResponseMetadata (GetObjectResponse a) = S3Metadata responseConsumer GetObject{..} metadata status headers source - = GetObjectResponse - <$> parseObjectMetadata headers - <*> s3BinaryResponseConsumer goResponseConsumer metadata status headers source + = do rsp <- s3BinaryResponseConsumer goResponseConsumer metadata status headers source + om <- parseObjectMetadata headers + return $ GetObjectResponse om rsp instance Transaction (GetObject a) (GetObjectResponse a) diff --git a/Aws/S3/Commands/PutBucket.hs b/Aws/S3/Commands/PutBucket.hs --- a/Aws/S3/Commands/PutBucket.hs +++ b/Aws/S3/Commands/PutBucket.hs @@ -4,6 +4,7 @@ import Aws.Core import Aws.S3.Core import Control.Monad +import qualified Data.Map as M import qualified Data.Text as T import qualified Data.Text.Encoding as T import qualified Network.HTTP.Conduit as HTTP @@ -48,11 +49,11 @@ }) where root = XML.Element { XML.elementName = "{http://s3.amazonaws.com/doc/2006-03-01/}CreateBucketConfiguration" - , XML.elementAttributes = [] + , XML.elementAttributes = M.empty , XML.elementNodes = [ XML.NodeElement (XML.Element { XML.elementName = "{http://s3.amazonaws.com/doc/2006-03-01/}LocationConstraint" - , XML.elementAttributes = [] + , XML.elementAttributes = M.empty , XML.elementNodes = [XML.NodeContent pbLocationConstraint] }) ] diff --git a/Aws/S3/Commands/PutObject.hs b/Aws/S3/Commands/PutObject.hs --- a/Aws/S3/Commands/PutObject.hs +++ b/Aws/S3/Commands/PutObject.hs @@ -5,15 +5,16 @@ import Aws.Core import Aws.S3.Core import Control.Applicative -import Control.Arrow (second) -import Data.ByteString.Char8 ({- IsString -}) +import Control.Arrow (second) +import Data.ByteString.Char8 ({- IsString -}) import Data.Maybe -import qualified Data.ByteString.Char8 as B -import qualified Data.CaseInsensitive as CI -import qualified Data.Text as T -import qualified Data.Text.Encoding as T -import qualified Network.HTTP.Conduit as HTTP -import qualified Data.Conduit as C +import qualified Crypto.Hash.MD5 as MD5 +import qualified Data.ByteString.Char8 as B +import qualified Data.CaseInsensitive as CI +import qualified Data.Conduit as C +import qualified Data.Text as T +import qualified Data.Text.Encoding as T +import qualified Network.HTTP.Conduit as HTTP data PutObject = PutObject { poObjectName :: T.Text, @@ -22,7 +23,7 @@ poCacheControl :: Maybe T.Text, poContentDisposition :: Maybe T.Text, poContentEncoding :: Maybe T.Text, - poContentMD5 :: Maybe B.ByteString, + poContentMD5 :: Maybe MD5.MD5, poExpires :: Maybe Int, poAcl :: Maybe CannedAcl, poStorageClass :: Maybe StorageClass, @@ -30,8 +31,8 @@ poMetadata :: [(T.Text,T.Text)] } -putObject :: T.Text -> Bucket -> HTTP.RequestBody (C.ResourceT IO) -> PutObject -putObject obj bucket body = PutObject obj bucket Nothing Nothing Nothing Nothing Nothing Nothing Nothing Nothing body [] +putObject :: Bucket -> T.Text -> HTTP.RequestBody (C.ResourceT IO) -> PutObject +putObject bucket obj body = PutObject obj bucket Nothing Nothing Nothing Nothing Nothing Nothing Nothing Nothing body [] data PutObjectResponse = PutObjectResponse { diff --git a/Aws/S3/Core.hs b/Aws/S3/Core.hs --- a/Aws/S3/Core.hs +++ b/Aws/S3/Core.hs @@ -1,4 +1,4 @@ -{-# LANGUAGE DeriveDataTypeable, OverloadedStrings, RecordWildCards, FlexibleContexts #-} +{-# LANGUAGE DeriveDataTypeable, OverloadedStrings, RecordWildCards, FlexibleContexts, Rank2Types #-} module Aws.S3.Core where import Aws.Core @@ -6,7 +6,7 @@ import Control.Monad import Control.Monad.IO.Class import Data.Attempt (Attempt(..)) -import Data.Conduit (($$)) +import Data.Conduit (($$+-)) import Data.Function import Data.IORef import Data.List @@ -20,10 +20,12 @@ import qualified Blaze.ByteString.Builder.Char8 as Blaze8 import qualified Control.Exception as C import qualified Control.Failure as F +import qualified Crypto.Hash.MD5 as MD5 import qualified Data.ByteString as B import qualified Data.ByteString.Char8 as B8 import qualified Data.CaseInsensitive as CI import qualified Data.Conduit as C +import qualified Data.Serialize as Serialize import qualified Data.Text as T import qualified Data.Text.Encoding as T import qualified Network.HTTP.Conduit as HTTP @@ -121,7 +123,7 @@ , s3QSubresources :: HTTP.Query , s3QQuery :: HTTP.Query , s3QContentType :: Maybe B.ByteString - , s3QContentMd5 :: Maybe B.ByteString + , s3QContentMd5 :: Maybe MD5.MD5 , s3QAmzHeaders :: HTTP.RequestHeaders , s3QOtherHeaders :: HTTP.RequestHeaders , s3QRequestBody :: Maybe (HTTP.RequestBody (C.ResourceT IO)) @@ -144,7 +146,7 @@ , sqHost = B.intercalate "." $ catMaybes host , sqPort = s3Port , sqPath = mconcat $ catMaybes path - , sqQuery = sortedSubresources ++ s3QQuery ++ authQuery + , sqQuery = sortedSubresources ++ s3QQuery ++ authQuery :: HTTP.Query , sqDate = Just signatureTime , sqAuthorization = authorization , sqContentType = s3QContentType @@ -176,7 +178,7 @@ sig = signature signatureCredentials HmacSHA1 stringToSign stringToSign = Blaze.toByteString . mconcat . intersperse (Blaze8.fromChar '\n') . concat $ [[Blaze.copyByteString $ httpMethod s3QMethod] - , [maybe mempty Blaze.copyByteString s3QContentMd5] + , [maybe mempty (Blaze.copyByteString . Serialize.encode) s3QContentMd5] , [maybe mempty Blaze.copyByteString s3QContentType] , [Blaze.copyByteString $ case ti of AbsoluteTimestamp time -> fmtRfc822Time time @@ -187,9 +189,9 @@ where amzHeader (k, v) = Blaze.copyByteString (CI.foldedCase k) `mappend` Blaze8.fromChar ':' `mappend` Blaze.copyByteString v (authorization, authQuery) = case ti of AbsoluteTimestamp _ -> (Just $ B.concat ["AWS ", accessKeyID signatureCredentials, ":", sig], []) - AbsoluteExpires time -> (Nothing, HTTP.simpleQueryToQuery $ makeAuthQuery time) + AbsoluteExpires time -> (Nothing, HTTP.toQuery $ makeAuthQuery time) makeAuthQuery time - = [("Expires", fmtTimeEpochSeconds time) + = [("Expires" :: B8.ByteString, fmtTimeEpochSeconds time) , ("AWSAccessKeyId", accessKeyID signatureCredentials) , ("SignatureMethod", "HmacSHA256") , ("Signature", sig)] @@ -222,7 +224,7 @@ s3ErrorResponseConsumer :: HTTPResponseConsumer a s3ErrorResponseConsumer status _headers source - = do doc <- source $$ XML.sinkDoc XML.def + = do doc <- source $$+- XML.sinkDoc XML.def let cursor = Cu.fromDocument doc liftIO $ case parseError cursor of Success err -> C.monadThrow err diff --git a/Aws/SimpleDb/Core.hs b/Aws/SimpleDb/Core.hs --- a/Aws/SimpleDb/Core.hs +++ b/Aws/SimpleDb/Core.hs @@ -106,7 +106,7 @@ } where ah = HmacSHA256 - q' = HTTP.simpleQueryToQuery . sort $ q ++ ("Version", "2009-04-15") : queryAuth + q' = HTTP.toQuery . sort $ q ++ ("Version", "2009-04-15") : queryAuth ti = signatureTimeInfo sd cr = signatureCredentials sd queryAuth = [case ti of diff --git a/Aws/Sqs/Core.hs b/Aws/Sqs/Core.hs --- a/Aws/Sqs/Core.hs +++ b/Aws/Sqs/Core.hs @@ -6,7 +6,7 @@ import Control.Monad import Control.Monad.IO.Class import Data.Attempt (Attempt(..)) -import Data.Conduit (($$)) +import Data.Conduit (($$+-)) import Data.IORef import Data.List import Data.Maybe @@ -215,7 +215,7 @@ sqsErrorResponseConsumer :: HTTPResponseConsumer a sqsErrorResponseConsumer status _headers source - = do doc <- source $$ XML.sinkDoc XML.def + = do doc <- source $$+- XML.sinkDoc XML.def let cursor = Cu.fromDocument doc liftIO $ case parseError cursor of Success err -> C.monadThrow err diff --git a/Examples/GetObject.hs b/Examples/GetObject.hs --- a/Examples/GetObject.hs +++ b/Examples/GetObject.hs @@ -9,7 +9,7 @@ {- A small function to save the object's data into a file. -} saveObject :: Aws.HTTPResponseConsumer () -saveObject status headers source = source $$ sinkFile "cloud-remote.pdf" +saveObject status headers source = source $$+- sinkFile "cloud-remote.pdf" main :: IO () main = do diff --git a/Examples/SimpleDb.hs b/Examples/SimpleDb.hs new file mode 100644 --- /dev/null +++ b/Examples/SimpleDb.hs @@ -0,0 +1,25 @@ +import qualified Aws +import qualified Aws.SimpleDb as Sdb +import Data.Attempt +import Control.Exception +import qualified Data.Text as T +import qualified Data.Text.IO as T + +main :: IO () +main = do + {- Load configuration -} + cfg <- Aws.baseConfiguration + let sdbCfg = Aws.defaultConfiguration + + putStrLn "Making request..." + + {- Make request -} + let req = Sdb.listDomains { Sdb.ldMaxNumberOfDomains = Just 10 } + Aws.Response _metadata resp <- Aws.simpleAws cfg sdbCfg req + + {- Analyze response -} + case resp of + Success (Sdb.ListDomainsResponse names _token) -> do + putStrLn "First 10 domains:" + mapM_ (T.putStrLn . T.cons '\t') names + Failure err -> print (toException err) diff --git a/README.org b/README.org --- a/README.org +++ b/README.org @@ -60,7 +60,7 @@ {- A small function to save the object's data into a file. -} saveObject :: Aws.HTTPResponseConsumer () -saveObject status headers source = source $$ sinkFile "cloud-remote.pdf" +saveObject status headers source = source $$+- sinkFile "cloud-remote.pdf" main :: IO () main = do @@ -92,6 +92,26 @@ * Release Notes +** 0.7 series (planned) + +Feature ideas: + +- Change ServiceConfiguration concept so as to indicate in the type whether this is for URI-only requests (i.e. + awsUri) + +** 0.6 series + +- 0.6.0 + - API Cleanup + - General: Use Crypto.Hash.MD5.MD5 when a Content-MD5 hash is required, instead of ByteString. + - S3: Made parameter order to S3.putObject consistent with S3.getObject. + - Updated dependencies: + - conduit 0.5 (as well as http-conduit 1.5 and xml-conduit 1.0). + - http-types 0.7. + - Minor changes. + - Internal changes (notable for people who want to add more commands): + - http-types' new 'QueryLike' interface allows creating query lists more conveniently. + ** 0.5 series - 0.5.0 :: @@ -113,6 +133,7 @@ - 0.3.2 :: Add awsRef / simpleAwsRef request variants for those who prefer an =IORef= over a =Data.Attempt.Attempt= value. Also improve README and add simple example. + * Resources - [[https://github.com/aristidb/aws][aws on Github]] diff --git a/aws.cabal b/aws.cabal --- a/aws.cabal +++ b/aws.cabal @@ -6,7 +6,7 @@ -- The package version. See the Haskell package versioning policy -- (http://www.haskell.org/haskellwiki/Package_versioning_policy) for -- standards guiding when and how versions should be incremented. -Version: 0.5.0 +Version: 0.6.0 -- A short (one-line) description of the package. Synopsis: Amazon Web Services (AWS) for Haskell @@ -41,6 +41,7 @@ -- a README. Extra-source-files: README.org Examples/GetObject.hs + Examples/SimpleDb.hs -- Constraint on the version of Cabal needed to build this package. Cabal-version: >=1.8 @@ -95,14 +96,15 @@ bytestring == 0.9.*, case-insensitive >= 0.2 && < 0.5, cereal == 0.3.*, - conduit >= 0.4 && < 0.5, + conduit >= 0.5 && < 0.6, + containers >= 0.4, crypto-api >= 0.9, cryptohash >= 0.6 && < 0.8, directory >= 1.0 && < 1.2, failure >= 0.1.0.1 && < 0.3, filepath >= 1.1 && < 1.4, - http-conduit >= 1.4 && < 1.5, - http-types >= 0.6 && < 0.7, + http-conduit >= 1.5 && < 1.6, + http-types >= 0.7 && < 0.8, lifted-base == 0.1.*, mtl == 2.*, monad-control >= 0.3, @@ -111,7 +113,7 @@ time >= 1.1.4 && < 1.5, transformers >= 0.2.2.0 && < 0.4, utf8-string == 0.3.*, - xml-conduit >= 0.7.0 + xml-conduit >= 1.0.1 && <1.1 GHC-Options: -Wall