aws 0.6.2 → 0.7.0

raw patch · 28 files changed

+749/−320 lines, 28 filesdep +awsdep +resourcetdep ~base64-bytestringdep ~http-conduitdep ~textnew-component:exe:GetObjectnew-component:exe:SimpleDbPVP ok

version bump matches the API change (PVP)

Dependencies added: aws, resourcet

Dependency ranges changed: base64-bytestring, http-conduit, text

API changes (from Hackage documentation)

Files

• Aws.hs +12/−1
• Aws/Aws.hs +136/−51
• Aws/Core.hs +99/−49
• Aws/S3/Commands.hs +3/−1
• Aws/S3/Commands/CopyObject.hs +107/−0
• Aws/S3/Commands/DeleteObject.hs +4/−4
• Aws/S3/Commands/GetBucket.hs +4/−1
• Aws/S3/Commands/GetObject.hs +28/−15
• Aws/S3/Commands/GetService.hs +5/−2
• Aws/S3/Commands/PutBucket.hs +5/−3
• Aws/S3/Commands/PutObject.hs +5/−3
• Aws/S3/Core.hs +33/−18
• Aws/Ses/Commands/SendRawEmail.hs +4/−1
• Aws/Ses/Core.hs +24/−22
• Aws/SimpleDb/Commands/Attributes.hs +20/−1
• Aws/SimpleDb/Commands/Domain.hs +23/−1
• Aws/SimpleDb/Commands/Select.hs +11/−1
• Aws/SimpleDb/Core.hs +30/−23
• Aws/Sqs/Commands/Message.hs +16/−1
• Aws/Sqs/Commands/Permission.hs +8/−1
• Aws/Sqs/Commands/Queue.hs +12/−1
• Aws/Sqs/Commands/QueueAttributes.hs +8/−1
• Aws/Sqs/Core.hs +36/−28
• Examples/GetObject.hs +12/−16
• Examples/SimpleDb.hs +4/−9
• LICENSE +1/−1
• README.org +41/−22
• aws.cabal +58/−43

@@ -11,19 +11,27 @@   -- ** Safe runners , aws , awsRef+, pureAws , simpleAws-, simpleAwsRef   -- ** Unsafe runners , unsafeAws , unsafeAwsRef   -- ** URI runners , awsUri+  -- ** Iterated runners+--, awsIteratedAll+, awsIteratedSource+, awsIteratedList   -- * Response   -- ** Full HTTP response , HTTPResponseConsumer   -- ** Metadata in responses , Response(..)+, readResponse+, readResponseIO , ResponseMetadata+  -- ** Memory responses+, AsMemoryResponse(..)   -- ** Exception types , XmlException(..) , HeaderException(..)@@ -32,10 +40,13 @@   -- ** Service configuration , ServiceConfiguration , DefaultServiceConfiguration(..)+, NormalQuery+, UriOnlyQuery   -- ** Expiration , TimeInfo(..)   -- * Transactions , Transaction+, IteratedTransaction   -- * Credentials , Credentials(..) , credentialsDefaultFile

@@ -1,4 +1,3 @@-{-# LANGUAGE FlexibleContexts, OverloadedStrings #-} module Aws.Aws ( -- * Logging   LogLevel(..)@@ -12,29 +11,39 @@   -- ** Safe runners , aws , awsRef+, pureAws , simpleAws-, simpleAwsRef   -- ** Unsafe runners , unsafeAws , unsafeAwsRef   -- ** URI runners , awsUri+  -- * Iterated runners+--, awsIteratedAll+, awsIteratedSource+, awsIteratedList ) where  import           Aws.Core import           Control.Applicative-import           Control.Monad.Trans  (MonadIO(liftIO))-import           Data.Attempt         (attemptIO)-import           Data.Conduit         (runResourceT)+import qualified Control.Exception.Lifted as E+import           Control.Monad+import           Control.Monad.IO.Class+import           Control.Monad.Trans+import           Control.Monad.Trans.Resource+import           Data.Attempt         (Attempt(Success, Failure))+import qualified Data.ByteString      as B+import qualified Data.CaseInsensitive as CI+import qualified Data.Conduit         as C+import qualified Data.Conduit.List    as CL import           Data.IORef import           Data.Monoid-import           System.IO            (stderr)-import qualified Control.Exception    as E-import qualified Data.ByteString      as B 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           System.IO            (stderr)  -- | The severity of a log message, in rising order. data LogLevel@@ -69,7 +78,7 @@ -- | The default configuration, with credentials loaded from environment variable or configuration file -- (see 'loadCredentialsDefault'). baseConfiguration :: MonadIO io => io Configuration-baseConfiguration = do+baseConfiguration = liftIO $ do   Just cr <- loadCredentialsDefault   return Configuration {                       timeInfo = Timestamp@@ -78,7 +87,7 @@                     } -- TODO: better error handling when credentials cannot be loaded --- | Debug configuration, which avoids using HTTPS for some queries. DO NOT USE THIS IN PRODUCTION!+-- | Debug configuration, which logs much more verbosely. dbgConfiguration :: MonadIO io => io Configuration dbgConfiguration = do   c <- baseConfiguration@@ -88,18 +97,26 @@ --  -- All errors are caught and wrapped in the 'Response' value. -- +-- Metadata is logged at level 'Info'.+--  -- Usage (with existing 'HTTP.Manager'): -- @ --     resp <- aws cfg serviceCfg manager request -- @-aws :: (Transaction r a, MonadIO io)-      => Configuration -> ServiceConfiguration r -> HTTP.Manager -> r -> io (Response (ResponseMetadata a) a)+aws :: (Transaction r a)+      => Configuration +      -> ServiceConfiguration r NormalQuery +      -> HTTP.Manager +      -> r +      -> ResourceT IO (Response (ResponseMetadata a) a) aws = unsafeAws  -- | Run an AWS transaction, with HTTP manager and metadata returned in an 'IORef'. --  -- Errors are not caught, and need to be handled with exception handlers. -- +-- Metadata is not logged.+--  -- Usage (with existing 'HTTP.Manager'): -- @ --     ref <- newIORef mempty;@@ -107,56 +124,76 @@ -- @  -- Unfortunately, the ";" above seems necessary, as haddock does not want to split lines for me.-awsRef :: (Transaction r a, MonadIO io)-      => Configuration -> ServiceConfiguration r -> HTTP.Manager -> IORef (ResponseMetadata a) -> r -> io a+awsRef :: (Transaction r a)+      => Configuration +      -> ServiceConfiguration r NormalQuery +      -> HTTP.Manager +      -> IORef (ResponseMetadata a) +      -> r +      -> ResourceT IO a awsRef = unsafeAwsRef --- | Run an AWS transaction, /without/ HTTP manager and with metadata wrapped in a 'Response'.--- --- Note that this is potentially less efficient than using 'aws', because HTTP connections cannot be re-used.+-- | Run an AWS transaction, with HTTP manager and without metadata. -- --- All errors are caught and wrapped in the 'Response' value.+-- Metadata is logged at level 'Info'. -- --- Usage:+-- Usage (with existing 'HTTP.Manager'): -- @---     resp <- simpleAws cfg serviceCfg request+--     resp <- aws cfg serviceCfg manager request -- @-simpleAws :: (Transaction r a, MonadIO io)-            => Configuration -> ServiceConfiguration r -> r -> io (Response (ResponseMetadata a) a)-simpleAws cfg scfg request = liftIO $ HTTP.withManager $ \manager -> aws cfg scfg manager request+pureAws :: (Transaction r a)+      => Configuration +      -> ServiceConfiguration r NormalQuery +      -> HTTP.Manager +      -> r +      -> ResourceT IO a+pureAws cfg scfg mgr req = readResponseIO =<< aws cfg scfg mgr req --- | Run an AWS transaction, /without/ HTTP manager and with metadata returned in an 'IORef'.+-- | Run an AWS transaction, /without/ HTTP manager and without metadata. -- --- Errors are not caught, and need to be handled with exception handlers.+-- Metadata is logged at level 'Info'. -- +-- Note that this is potentially less efficient than using 'aws', because HTTP connections cannot be re-used.+--  -- Usage: -- @---     ref <- newIORef mempty;---     resp <- simpleAwsRef cfg serviceCfg request+--     resp <- simpleAws cfg serviceCfg request -- @---- Unfortunately, the ";" above seems necessary, as haddock does not want to split lines for me.-simpleAwsRef :: (Transaction r a, MonadIO io)-            => Configuration -> ServiceConfiguration r -> IORef (ResponseMetadata a) -> r -> io a-simpleAwsRef cfg scfg metadataRef request = liftIO $ HTTP.withManager $ -                                              \manager -> awsRef cfg scfg manager metadataRef request+simpleAws :: (Transaction r a, AsMemoryResponse a, MonadIO io)+            => Configuration +            -> ServiceConfiguration r NormalQuery+            -> r +            -> io (MemoryResponse a)+simpleAws cfg scfg request+  = liftIO $ HTTP.withManager $ \manager ->+      loadToMemory =<< readResponseIO =<< aws cfg scfg manager request  -- | Run an AWS transaction, without enforcing that response and request type form a valid transaction pair. --  -- This is especially useful for debugging and development, you should not have to use it in production. --  -- All errors are caught and wrapped in the 'Response' value.+-- +-- Metadata is wrapped in the Response, and also logged at level 'Info'. unsafeAws   :: (ResponseConsumer r a,       Monoid (ResponseMetadata a),-      SignQuery r,-      MonadIO io) =>-     Configuration -> ServiceConfiguration r -> HTTP.Manager -> r -> io (Response (ResponseMetadata a) a)-unsafeAws cfg scfg manager request = liftIO $ do-  metadataRef <- newIORef mempty-  resp <- attemptIO (id :: E.SomeException -> E.SomeException) $+      Loggable (ResponseMetadata a),+      SignQuery r) =>+     Configuration -> ServiceConfiguration r NormalQuery -> HTTP.Manager -> r -> ResourceT IO (Response (ResponseMetadata a) a)+unsafeAws cfg scfg manager request = do+  metadataRef <- liftIO $ newIORef mempty++  let catchAll :: ResourceT IO a -> ResourceT IO (Attempt a)+      catchAll = E.handle (return . failure') . fmap Success++      failure' :: E.SomeException -> Attempt a+      failure' = Failure++  resp <- catchAll $             unsafeAwsRef cfg scfg manager metadataRef request-  metadata <- readIORef metadataRef+  metadata <- liftIO $ readIORef metadataRef+  liftIO $ logger cfg Info $ "Response metadata: " `mappend` toLogText metadata   return $ Response metadata resp  -- | Run an AWS transaction, without enforcing that response and request type form a valid transaction pair.@@ -164,21 +201,24 @@ -- This is especially useful for debugging and development, you should not have to use it in production. --  -- Errors are not caught, and need to be handled with exception handlers.+-- +-- Metadata is put in the 'IORef', but not logged. unsafeAwsRef   :: (ResponseConsumer r a,       Monoid (ResponseMetadata a),-      SignQuery r,-      MonadIO io) =>-     Configuration -> ServiceConfiguration r -> HTTP.Manager -> IORef (ResponseMetadata a) -> r -> io a-unsafeAwsRef cfg info manager metadataRef request = liftIO $ do-  sd <- signatureData <$> timeInfo <*> credentials $ cfg+      SignQuery r) =>+     Configuration -> ServiceConfiguration r NormalQuery -> HTTP.Manager -> IORef (ResponseMetadata a) -> r -> ResourceT IO a+unsafeAwsRef cfg info manager metadataRef request = do+  sd <- liftIO $ signatureData <$> timeInfo <*> credentials $ cfg   let q = signQuery request info sd-  logger cfg Debug $ T.pack $ "String to sign: " ++ show (sqStringToSign q)+  liftIO $ logger cfg Debug $ T.pack $ "String to sign: " ++ show (sqStringToSign q)   let httpRequest = queryToHttpRequest q-  logger cfg Debug $ T.pack $ "Host: " ++ show (HTTP.host httpRequest)-  resp <- runResourceT $ do-      HTTP.Response status _ headers body <- HTTP.http httpRequest manager-      responseConsumer request metadataRef status headers body+  liftIO $ logger cfg Debug $ T.pack $ "Host: " ++ show (HTTP.host httpRequest)+  resp <- do+      hresp <- HTTP.http httpRequest manager+      forM_ (HTTP.responseHeaders hresp) $ \(hname,hvalue) -> liftIO $ do+        logger cfg Debug $ T.decodeUtf8 $ "Response header '" `mappend` CI.original hname `mappend` "': '" `mappend` hvalue `mappend` "'"+      responseConsumer request metadataRef hresp   return resp  -- | Run a URI-only AWS transaction. Returns a URI that can be sent anywhere. Does not work with all requests.@@ -188,7 +228,7 @@ --     uri <- awsUri cfg request -- @ awsUri :: (SignQuery request, MonadIO io)-         => Configuration -> ServiceConfiguration request -> request -> io B.ByteString+         => Configuration -> ServiceConfiguration request UriOnlyQuery -> request -> io B.ByteString awsUri cfg info request = liftIO $ do   let ti = timeInfo cfg       cr = credentials cfg@@ -197,3 +237,48 @@   logger cfg Debug $ T.pack $ "String to sign: " ++ show (sqStringToSign q)   return $ queryToUri q +{-+-- | Run an iterated AWS transaction. May make multiple HTTP requests.+awsIteratedAll :: (IteratedTransaction r a)+                  => Configuration+                  -> ServiceConfiguration r NormalQuery+                  -> HTTP.Manager+                  -> r+                  -> ResourceT IO (Response [ResponseMetadata a] a)+awsIteratedAll cfg scfg manager req_ = go req_ Nothing+  where go request prevResp = do Response meta respAttempt <- aws cfg scfg manager request+                                 case maybeCombineIteratedResponse prevResp <$> respAttempt of+                                   f@(Failure _) -> return (Response [meta] f)+                                   s@(Success resp) -> +                                     case nextIteratedRequest request resp of+                                       Nothing -> +                                         return (Response [meta] s)+                                       Just nextRequest -> +                                         mapMetadata (meta:) `liftM` go nextRequest (Just resp)+-}++awsIteratedSource :: (IteratedTransaction r a)+                     => Configuration+                     -> ServiceConfiguration r NormalQuery+                     -> HTTP.Manager+                     -> r+                     -> C.GSource (ResourceT IO) (Response (ResponseMetadata a) a)+awsIteratedSource cfg scfg manager req_ = go req_+  where go request = do resp <- lift $ aws cfg scfg manager request+                        C.yield resp+                        case responseResult resp of+                          Failure _ -> return ()+                          Success x ->+                            case nextIteratedRequest request x of+                              Nothing -> return ()+                              Just nextRequest -> go nextRequest++awsIteratedList :: (IteratedTransaction r a, ListResponse a i)+                     => Configuration+                     -> ServiceConfiguration r NormalQuery+                     -> HTTP.Manager+                     -> r+                     -> C.GSource (ResourceT IO) i+awsIteratedList cfg scfg manager req+  = awsIteratedSource cfg scfg manager req+    C.>+> CL.concatMapM (fmap listResponse . readResponseIO)

@@ -1,13 +1,21 @@-{-# LANGUAGE MultiParamTypeClasses, FunctionalDependencies, TypeFamilies, FlexibleContexts, FlexibleInstances, DeriveFunctor, OverloadedStrings, RecordWildCards, DeriveDataTypeable, Rank2Types, ExistentialQuantification #-} module Aws.Core-( -- * Response+( -- * Logging+  Loggable(..)+  -- * Response   -- ** Metadata in responses-  Response(..)+, Response(..)+, readResponse+, readResponseIO , tellMetadata , tellMetadataRef+, mapMetadata   -- ** Response data consumers , HTTPResponseConsumer , ResponseConsumer(..)+  -- ** Memory response+, AsMemoryResponse(..)+  -- ** List response+, ListResponse(..)   -- ** Exception types , XmlException(..) , HeaderException(..)@@ -24,6 +32,8 @@ , xmlCursorConsumer   -- * Query , SignedQuery(..)+, NormalQuery+, UriOnlyQuery , queryToHttpRequest , queryToUri   -- ** Expiration@@ -49,8 +59,12 @@ , fmtAmzTime , fmtTimeEpochSeconds , parseHttpDate+, httpDate1+, textHttpDate+, iso8601UtcDate   -- * Transactions , Transaction+, IteratedTransaction(..)   -- * Credentials , Credentials(..) , credentialsDefaultFile@@ -69,60 +83,78 @@ ) where +import qualified Blaze.ByteString.Builder as Blaze import           Control.Applicative 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.Char-import           Data.Conduit             (ResourceT, ($$+-))-import           Data.IORef-import           Data.List-import           Data.Maybe-import           Data.Monoid-import           Data.Time-import           Data.Typeable-import           Data.Word-import           System.Directory-import           System.Environment-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           Control.Monad+import           Control.Monad.IO.Class 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           Data.Attempt             (Attempt(..), FromAttempt(..))+import           Data.ByteString          (ByteString) import qualified Data.ByteString          as B import qualified Data.ByteString.Base64   as Base64+import           Data.ByteString.Char8    ({- IsString -}) import qualified Data.ByteString.Lazy     as L import qualified Data.ByteString.UTF8     as BU+import           Data.Char+import           Data.Conduit             (ResourceT, ($$+-)) import qualified Data.Conduit             as C-import qualified Data.Conduit.List        as CL+import           Data.IORef+import           Data.List+import           Data.Maybe+import           Data.Monoid 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           Data.Time+import           Data.Typeable+import           Data.Word import qualified Network.HTTP.Conduit     as HTTP import qualified Network.HTTP.Types       as HTTP+import           System.Directory+import           System.Environment+import           System.FilePath          ((</>))+import           System.Locale import qualified Text.XML                 as XML import qualified Text.XML.Cursor          as Cu+import           Text.XML.Cursor          hiding (force, forceM) +-- | Types that can be logged (textually).+class Loggable a where+    toLogText :: a -> T.Text+ -- | A response with metadata. Can also contain an error response, or an internal error, via 'Attempt'. --  -- Response forms a Writer-like monad.-data Response m a = Response m (Attempt a)+data Response m a = Response { responseMetadata :: m+                             , responseResult :: Attempt a }     deriving (Show, Functor) +-- | Read a response result (if it's a success response, fail otherwise).+readResponse :: FromAttempt f => Response m a -> f a+readResponse = fromAttempt . responseResult++-- | Read a response result (if it's a success response, fail otherwise). In MonadIO.+readResponseIO :: MonadIO io => Response m a -> io a+readResponseIO = liftIO . readResponse+ -- | An empty response with some metadata. tellMetadata :: m -> Response m () tellMetadata m = Response m (return ()) +-- | Apply a function to the metadata.+mapMetadata :: (m -> n) -> Response m a -> Response n a+mapMetadata f (Response m a) = Response (f m) a++--multiResponse :: Monoid m => Response m a -> Response [m] a -> + instance Monoid m => Monad (Response m) where     return x = Response mempty (Success x)     Response m1 (Failure e) >>= _ = Response m1 (Failure e)@@ -137,10 +169,8 @@ tellMetadataRef r m = modifyIORef r (`mappend` m)  -- | A full HTTP response parser. Takes HTTP status, response headers, and response body.-type HTTPResponseConsumer a =  HTTP.Status-                            -> HTTP.ResponseHeaders-                            -> C.ResumableSource (ResourceT IO) ByteString-                            -> ResourceT IO a+type HTTPResponseConsumer a = HTTP.Response (C.ResumableSource (ResourceT IO) ByteString)+                              -> ResourceT IO a  -- | Class for types that AWS HTTP responses can be parsed into. -- @@ -157,20 +187,31 @@ -- | Does not parse response. For debugging. instance ResponseConsumer r (HTTP.Response L.ByteString) where     type ResponseMetadata (HTTP.Response L.ByteString) = ()-    responseConsumer _ _ status headers bufsource = do-      chunks <- bufsource $$+- CL.consume-      return (HTTP.Response status HTTP.http11 headers $ L.fromChunks chunks)+    responseConsumer _ _ resp = HTTP.lbsResponse resp +-- | Class for responses that are fully loaded into memory+class AsMemoryResponse resp where+    type MemoryResponse resp :: *+    loadToMemory :: resp -> ResourceT IO (MemoryResponse resp)++-- | Responses that have one main list in them, and perhaps some decoration.+class ListResponse resp item | resp -> item where+    listResponse :: resp -> [item]+ -- | Associates a request type and a response type in a bi-directional way. --  -- This allows the type-checker to infer the response type when given the request type and vice versa. --  -- Note that the actual request generation and response parsing resides in 'SignQuery' and 'ResponseConsumer' -- respectively.-class (SignQuery r, ResponseConsumer r a)+class (SignQuery r, ResponseConsumer r a, Loggable (ResponseMetadata a))       => Transaction r a       | r -> a, a -> r +-- | A transaction that may need to be split over multiple requests, for example because of upstream response size limits.+class Transaction r a => IteratedTransaction r a | r -> a , a -> r where+    nextIteratedRequest :: r -> a -> Maybe r+ -- | AWS access credentials. data Credentials     = Credentials {@@ -393,13 +434,18 @@   let ti = makeAbsoluteTimeInfo rti now   return SignatureData { signatureTimeInfo = ti, signatureTime = now, signatureCredentials = cr } +-- | Tag type for normal queries.+data NormalQuery+-- | Tag type for URI-only queries.+data UriOnlyQuery+ -- | A "signable" request object. Assembles together the Query, and signs it in one go.-class SignQuery r where+class SignQuery request where     -- | Additional information, like API endpoints and service-specific preferences.-    type ServiceConfiguration r :: *+    type ServiceConfiguration request :: * {- Query Type -} -> *          -- | Create a 'SignedQuery' from a request, additional 'Info', and 'SignatureData'.-    signQuery :: r -> ServiceConfiguration r -> SignatureData -> SignedQuery+    signQuery :: request -> ServiceConfiguration request queryType -> SignatureData -> SignedQuery  -- | Supported crypto hashes for the signature. data AuthorizationHash@@ -428,19 +474,12 @@  -- | Default configuration for a specific service. class DefaultServiceConfiguration config where-    -- | Default service configuration for normal requests.-    defaultConfiguration :: config-    -    -- | Default service configuration for URI-only requests.-    defaultConfigurationUri :: config--    -- | Default debugging-only configuration for normal requests. (Normally using HTTP instead of HTTPS for easier debugging.)-    debugConfiguration :: config-    debugConfiguration = defaultConfiguration+    -- | Default service configuration.+    defServiceConfig :: config -    -- | Default debugging-only configuration for URI-only requests. (Normally using HTTP instead of HTTPS for easier debugging.)-    debugConfigurationUri :: config-    debugConfigurationUri = defaultConfigurationUri+    -- | Default debugging-only configuration. (Normally using HTTP instead of HTTPS for easier debugging.)+    debugServiceConfig :: config+    debugServiceConfig = defServiceConfig  -- | @queryList f prefix xs@ constructs a query list from a list of elements @xs@, using a common prefix @prefix@, -- and a transformer function @f@.@@ -496,6 +535,17 @@                   <|> p "%a %b %_d %H:%M:%S %Y" s     -- asctime-date   where p = parseTime defaultTimeLocale +-- | HTTP-date (section 3.3.1 of RFC 2616, first type - RFC1123-style)+httpDate1 :: String+httpDate1 = "%a, %d %b %Y %H:%M:%S GMT" -- rfc1123-date++-- | Format (as Text) HTTP-date (section 3.3.1 of RFC 2616, first type - RFC1123-style)+textHttpDate :: UTCTime -> T.Text+textHttpDate = T.pack . formatTime defaultTimeLocale httpDate1++iso8601UtcDate :: String+iso8601UtcDate = "%Y-%m-%dT%H:%M:%S%QZ"+ -- | Parse a two-digit hex number. readHex2 :: [Char] -> Maybe Word8 readHex2 [c1,c2] = do n1 <- readHex1 c1@@ -567,7 +617,7 @@     => (Cu.Cursor -> Response m a)     -> IORef m     -> HTTPResponseConsumer a-xmlCursorConsumer parse metadataRef _status _headers source+xmlCursorConsumer parse metadataRef (HTTP.Response { HTTP.responseBody = source })     = do doc <- source $$+- XML.sinkDoc XML.def          let cursor = Cu.fromDocument doc          let Response metadata x = parse cursor

@@ -1,6 +1,7 @@ module Aws.S3.Commands (-  module Aws.S3.Commands.DeleteObject+  module Aws.S3.Commands.CopyObject+, module Aws.S3.Commands.DeleteObject , module Aws.S3.Commands.GetBucket , module Aws.S3.Commands.GetObject , module Aws.S3.Commands.GetService@@ -9,6 +10,7 @@ ) where +import Aws.S3.Commands.CopyObject import Aws.S3.Commands.DeleteObject import Aws.S3.Commands.GetBucket import Aws.S3.Commands.GetObject

@@ -0,0 +1,107 @@+module Aws.S3.Commands.CopyObject+where++import           Aws.Core+import           Aws.S3.Core+import           Control.Applicative+import           Control.Arrow (second)+import           Control.Failure+import qualified Data.CaseInsensitive as CI+import           Data.Maybe+import qualified Data.Text as T+import qualified Data.Text.Encoding as T+import           Data.Time+import qualified Network.HTTP.Conduit as HTTP+import           Text.XML.Cursor (($/), (&|))+import           System.Locale++data CopyMetadataDirective = CopyMetadata | ReplaceMetadata [(T.Text,T.Text)]+  deriving (Show)++data CopyObject = CopyObject { coObjectName :: T.Text+                             , coBucket :: Bucket+                             , coSource :: ObjectId+                             , coMetadataDirective :: CopyMetadataDirective+                             , coIfMatch :: Maybe T.Text+                             , coIfNoneMatch :: Maybe T.Text+                             , coIfUnmodifiedSince :: Maybe UTCTime+                             , coIfModifiedSince :: Maybe UTCTime+                             , coStorageClass :: Maybe StorageClass+                             , coAcl :: Maybe CannedAcl+                             }+  deriving (Show)++copyObject :: Bucket -> T.Text -> ObjectId -> CopyMetadataDirective -> CopyObject+copyObject bucket obj src meta = CopyObject obj bucket src meta Nothing Nothing Nothing Nothing Nothing Nothing++data CopyObjectResponse +  = CopyObjectResponse {+      corVersionId :: Maybe T.Text+    , corLastModified :: UTCTime+    , corETag :: T.Text+    }+  deriving (Show)++-- | ServiceConfiguration: 'S3Configuration'+instance SignQuery CopyObject where+    type ServiceConfiguration CopyObject = S3Configuration+    signQuery CopyObject {..} = s3SignQuery S3Query {+                                 s3QMethod = Put+                               , s3QBucket = Just $ T.encodeUtf8 coBucket+                               , s3QObject = Just $ T.encodeUtf8 coObjectName+                               , s3QSubresources = []+                               , s3QQuery = []+                               , s3QContentType = Nothing+                               , s3QContentMd5 = Nothing+                               , s3QAmzHeaders = map (second T.encodeUtf8) $ catMaybes [+                                   Just ("x-amz-copy-source",+                                         oidBucket `T.append` "/" `T.append` oidObject `T.append`+                                         case oidVersion of+                                           Nothing -> T.empty+                                           Just v -> "?versionId=" `T.append` v)+                                 , Just ("x-amz-metadata-directive", case coMetadataDirective of+                                            CopyMetadata -> "COPY"+                                            ReplaceMetadata _ -> "REPLACE")+                                 , ("x-amz-copy-source-if-match",)+                                   <$> coIfMatch+                                 , ("x-amz-copy-source-if-none-match",)+                                   <$> coIfNoneMatch+                                 , ("x-amz-copy-source-if-unmodified-since",)+                                   <$> textHttpDate <$> coIfUnmodifiedSince+                                 , ("x-amz-copy-source-if-modified-since",)+                                   <$> textHttpDate <$> coIfModifiedSince+                                 , ("x-amz-acl",)+                                   <$> writeCannedAcl <$> coAcl+                                 , ("x-amz-storage-class",)+                                   <$> writeStorageClass <$> coStorageClass+                                 ] ++ map ( \x -> (CI.mk . T.encodeUtf8 $+                                                   T.concat ["x-amz-meta-", fst x], snd x))+                                          coMetadata+                               , s3QOtherHeaders = map (second T.encodeUtf8) $ catMaybes []+                               , s3QRequestBody = Nothing+                               }+      where coMetadata = case coMetadataDirective of+                           CopyMetadata -> []+                           ReplaceMetadata xs -> xs+            ObjectId{..} = coSource++instance ResponseConsumer CopyObject CopyObjectResponse where+    type ResponseMetadata CopyObjectResponse = S3Metadata+    responseConsumer _ mref = flip s3ResponseConsumer mref $ \resp -> do+        let vid = T.decodeUtf8 `fmap` lookup "x-amz-version-id" (HTTP.responseHeaders resp)+        (lastMod, etag) <- xmlCursorConsumer parse mref resp+        return $ CopyObjectResponse vid lastMod etag+      where parse el = do+              let parseHttpDate' x = case parseTime defaultTimeLocale iso8601UtcDate x of+                                       Nothing -> failure $ XmlException ("Invalid Last-Modified " ++ x)+                                       Just y -> return y+              lastMod <- forceM "Missing Last-Modified" $ el $/ elContent "LastModified" &| (parseHttpDate' . T.unpack)+              etag <- force "Missing ETag" $ el $/ elContent "ETag"+              return (lastMod, etag)+      ++instance Transaction CopyObject CopyObjectResponse++instance AsMemoryResponse CopyObjectResponse where+    type MemoryResponse CopyObjectResponse = CopyObjectResponse+    loadToMemory = return

@@ -1,4 +1,3 @@-{-# LANGUAGE TypeFamilies, RecordWildCards, TupleSections, OverloadedStrings, MultiParamTypeClasses, FlexibleInstances, UndecidableInstances, GADTs, RankNTypes #-} module Aws.S3.Commands.DeleteObject where @@ -34,9 +33,10 @@  instance ResponseConsumer DeleteObject DeleteObjectResponse where     type ResponseMetadata DeleteObjectResponse = S3Metadata-    responseConsumer _ = s3ResponseConsumer $ \_ _ _ ->-                         return DeleteObjectResponse-+    responseConsumer _ = s3ResponseConsumer $ \_ -> return DeleteObjectResponse  instance Transaction DeleteObject DeleteObjectResponse +instance AsMemoryResponse DeleteObjectResponse where+    type MemoryResponse DeleteObjectResponse = DeleteObjectResponse+    loadToMemory = return

@@ -1,4 +1,3 @@-{-# LANGUAGE TypeFamilies, RecordWildCards, TupleSections, OverloadedStrings, MultiParamTypeClasses, FlexibleInstances #-} module Aws.S3.Commands.GetBucket where @@ -91,3 +90,7 @@                                               }  instance Transaction GetBucket GetBucketResponse++instance AsMemoryResponse GetBucketResponse where+    type MemoryResponse GetBucketResponse = GetBucketResponse+    loadToMemory = return

@@ -1,21 +1,23 @@-{-# LANGUAGE TypeFamilies, RecordWildCards, TupleSections, OverloadedStrings, MultiParamTypeClasses, FlexibleInstances, UndecidableInstances, GADTs, RankNTypes #-} module Aws.S3.Commands.GetObject where  import           Aws.Core import           Aws.S3.Core import           Control.Applicative+import           Control.Monad.Trans.Resource (ResourceT) import           Data.ByteString.Char8 ({- IsString -}) import qualified Data.ByteString.Char8 as B8+import qualified Data.ByteString.Lazy  as L+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 import qualified Network.HTTP.Types    as HTTP -data GetObject a+data GetObject     = GetObject {         goBucket :: Bucket       , goObjectName :: Object-      , goResponseConsumer :: HTTPResponseConsumer a       , goVersionId :: Maybe T.Text       , goResponseContentType :: Maybe T.Text       , goResponseContentLanguage :: Maybe T.Text@@ -24,17 +26,24 @@       , goResponseContentDisposition :: Maybe T.Text       , goResponseContentEncoding :: Maybe T.Text       }+  deriving (Show) -getObject :: Bucket -> T.Text -> HTTPResponseConsumer a -> GetObject a-getObject b o i = GetObject b o i Nothing Nothing Nothing Nothing Nothing Nothing Nothing+getObject :: Bucket -> T.Text -> GetObject+getObject b o = GetObject b o Nothing Nothing Nothing Nothing Nothing Nothing Nothing -data GetObjectResponse a-    = GetObjectResponse ObjectMetadata a+data GetObjectResponse+    = GetObjectResponse {+        gorMetadata :: ObjectMetadata,+        gorResponse :: HTTP.Response (C.ResumableSource (ResourceT IO) B8.ByteString)+      }++data GetObjectMemoryResponse+    = GetObjectMemoryResponse ObjectMetadata (HTTP.Response L.ByteString)     deriving (Show)  -- | ServiceConfiguration: 'S3Configuration'-instance SignQuery (GetObject a) where-    type ServiceConfiguration (GetObject a) = S3Configuration+instance SignQuery GetObject where+    type ServiceConfiguration GetObject = S3Configuration     signQuery GetObject {..} = s3SignQuery S3Query {                                    s3QMethod = Get                                  , s3QBucket = Just $ T.encodeUtf8 goBucket@@ -57,11 +66,15 @@                                  , s3QRequestBody = Nothing                                  } -instance ResponseConsumer (GetObject a) (GetObjectResponse a) where-    type ResponseMetadata (GetObjectResponse a) = S3Metadata-    responseConsumer GetObject{..} metadata status headers source-        = do rsp <- s3BinaryResponseConsumer goResponseConsumer metadata status headers source-             om <- parseObjectMetadata headers+instance ResponseConsumer GetObject GetObjectResponse where+    type ResponseMetadata GetObjectResponse = S3Metadata+    responseConsumer GetObject{..} metadata resp+        = do rsp <- s3BinaryResponseConsumer return metadata resp+             om <- parseObjectMetadata (HTTP.responseHeaders resp)              return $ GetObjectResponse om rsp -instance Transaction (GetObject a) (GetObjectResponse a)+instance Transaction GetObject GetObjectResponse++instance AsMemoryResponse GetObjectResponse where+    type MemoryResponse GetObjectResponse = GetObjectMemoryResponse+    loadToMemory (GetObjectResponse om x) = GetObjectMemoryResponse om <$> HTTP.lbsResponse x

@@ -1,4 +1,3 @@-{-# LANGUAGE TypeFamilies, MultiParamTypeClasses, FlexibleInstances, OverloadedStrings #-} module Aws.S3.Commands.GetService where @@ -33,7 +32,7 @@           parseBucket el = do             name <- force "Missing owner Name" $ el $/ elContent "Name"             creationDateString <- force "Missing owner CreationDate" $ el $/ elContent "CreationDate" &| T.unpack-            creationDate <- force "Invalid CreationDate" . maybeToList $ parseTime defaultTimeLocale "%Y-%m-%dT%H:%M:%S%QZ" creationDateString+            creationDate <- force "Invalid CreationDate" . maybeToList $ parseTime defaultTimeLocale iso8601UtcDate creationDateString             return BucketInfo { bucketName = name, bucketCreationDate = creationDate }  -- | ServiceConfiguration: 'S3Configuration'@@ -53,3 +52,7 @@                               }  instance Transaction GetService GetServiceResponse++instance AsMemoryResponse GetServiceResponse where+  type MemoryResponse GetServiceResponse = GetServiceResponse+  loadToMemory = return

@@ -1,4 +1,3 @@-{-# LANGUAGE RecordWildCards, TypeFamilies, OverloadedStrings, MultiParamTypeClasses, FlexibleInstances #-} module Aws.S3.Commands.PutBucket where  import           Aws.Core@@ -62,7 +61,10 @@ instance ResponseConsumer r PutBucketResponse where     type ResponseMetadata PutBucketResponse = S3Metadata -    responseConsumer _ = s3ResponseConsumer inner-        where inner _status _headers _source = return PutBucketResponse+    responseConsumer _ = s3ResponseConsumer $ \_ -> return PutBucketResponse  instance Transaction PutBucket PutBucketResponse++instance AsMemoryResponse PutBucketResponse where+    type MemoryResponse PutBucketResponse = PutBucketResponse+    loadToMemory = return

@@ -1,4 +1,3 @@-{-# LANGUAGE TypeFamilies, RecordWildCards, TupleSections, OverloadedStrings, MultiParamTypeClasses, FlexibleInstances, UndecidableInstances, GADTs, RankNTypes #-} module Aws.S3.Commands.PutObject where @@ -66,9 +65,12 @@  instance ResponseConsumer PutObject PutObjectResponse where     type ResponseMetadata PutObjectResponse = S3Metadata-    responseConsumer _ = s3ResponseConsumer $ \_status headers _body -> do-      let vid = T.decodeUtf8 `fmap` lookup "x-amz-version-id" headers+    responseConsumer _ = s3ResponseConsumer $ \resp -> do+      let vid = T.decodeUtf8 `fmap` lookup "x-amz-version-id" (HTTP.responseHeaders resp)       return $ PutObjectResponse vid  instance Transaction PutObject PutObjectResponse +instance AsMemoryResponse PutObjectResponse where+    type MemoryResponse PutObjectResponse = PutObjectResponse+    loadToMemory = return

@@ -1,4 +1,3 @@-{-# LANGUAGE DeriveDataTypeable, OverloadedStrings, RecordWildCards, FlexibleContexts, Rank2Types #-} module Aws.S3.Core where  import           Aws.Core@@ -45,7 +44,7 @@     | VHostStyle     deriving (Show) -data S3Configuration+data S3Configuration qt     = S3Configuration {         s3Protocol :: Protocol       , s3Endpoint :: B.ByteString@@ -56,13 +55,15 @@       }     deriving (Show) -instance DefaultServiceConfiguration S3Configuration where-  defaultConfiguration = s3 HTTPS s3EndpointUsClassic False-  defaultConfigurationUri = s3 HTTPS s3EndpointUsClassic True+instance DefaultServiceConfiguration (S3Configuration NormalQuery) where+  defServiceConfig = s3 HTTPS s3EndpointUsClassic False   -  debugConfiguration = s3 HTTP s3EndpointUsClassic False-  debugConfigurationUri = s3 HTTP s3EndpointUsClassic True+  debugServiceConfig = s3 HTTP s3EndpointUsClassic False +instance DefaultServiceConfiguration (S3Configuration UriOnlyQuery) where+  defServiceConfig = s3 HTTPS s3EndpointUsClassic True+  debugServiceConfig = s3 HTTP s3EndpointUsClassic True+ s3EndpointUsClassic :: B.ByteString s3EndpointUsClassic = "s3.amazonaws.com" @@ -78,7 +79,7 @@ s3EndpointApNorthEast :: B.ByteString s3EndpointApNorthEast = "s3-ap-northeast-1.amazonaws.com" -s3 :: Protocol -> B.ByteString -> Bool -> S3Configuration+s3 :: Protocol -> B.ByteString -> Bool -> S3Configuration qt s3 protocol endpoint uri      = S3Configuration {           s3Protocol = protocol@@ -116,6 +117,12 @@     mempty = S3Metadata Nothing Nothing     S3Metadata a1 r1 `mappend` S3Metadata a2 r2 = S3Metadata (a1 `mplus` a2) (r1 `mplus` r2) +instance Loggable S3Metadata where+    toLogText (S3Metadata id2 rid) = "S3: request ID=" `mappend`+                                     fromMaybe "<none>" rid `mappend`+                                     ", x-amz-id-2=" `mappend`+                                     fromMaybe "<none>" id2+ data S3Query     = S3Query {         s3QMethod :: Method@@ -139,7 +146,7 @@                        " ; request body: " ++ (case s3QRequestBody of Nothing -> "no"; _ -> "yes") ++                        "]" -s3SignQuery :: S3Query -> S3Configuration -> SignatureData -> SignedQuery+s3SignQuery :: S3Query -> S3Configuration qt -> SignatureData -> SignedQuery s3SignQuery S3Query{..} S3Configuration{..} SignatureData{..}     = SignedQuery {         sqMethod = s3QMethod@@ -200,17 +207,17 @@ s3ResponseConsumer :: HTTPResponseConsumer a                    -> IORef S3Metadata                    -> HTTPResponseConsumer a-s3ResponseConsumer inner metadata status headers source = do-      let headerString = fmap T.decodeUtf8 . flip lookup headers+s3ResponseConsumer inner metadata resp = do+      let headerString = fmap T.decodeUtf8 . flip lookup (HTTP.responseHeaders resp)       let amzId2 = headerString "x-amz-id-2"       let requestId = headerString "x-amz-request-id"        let m = S3Metadata { s3MAmzId2 = amzId2, s3MRequestId = requestId }       liftIO $ tellMetadataRef metadata m -      if status >= HTTP.status400-        then s3ErrorResponseConsumer status headers source-        else inner status headers source+      if HTTP.responseStatus resp >= HTTP.status400+        then s3ErrorResponseConsumer resp+        else inner resp  s3XmlResponseConsumer :: (Cu.Cursor -> Response S3Metadata a)                       -> IORef S3Metadata@@ -224,8 +231,8 @@ s3BinaryResponseConsumer inner metadataRef = s3ResponseConsumer inner metadataRef  s3ErrorResponseConsumer :: HTTPResponseConsumer a-s3ErrorResponseConsumer status _headers source-    = do doc <- source $$+- XML.sinkDoc XML.def+s3ErrorResponseConsumer resp+    = do doc <- HTTP.responseBody resp $$+- XML.sinkDoc XML.def          let cursor = Cu.fromDocument doc          liftIO $ case parseError cursor of            Success err      -> C.monadThrow err@@ -241,7 +248,7 @@                                                  bytes <- mapM readHex2 $ words unprocessed                                                  return $ B.pack bytes                            return S3Error {-                                        s3StatusCode = status+                                        s3StatusCode = HTTP.responseStatus resp                                       , s3ErrorCode = code                                       , s3ErrorMessage = message                                       , s3ErrorResource = resource@@ -308,6 +315,14 @@  type Object = T.Text +data ObjectId+    = ObjectId {+        oidBucket :: Bucket+      , oidObject :: Object+      , oidVersion :: Maybe T.Text+      }+    deriving (Show)+ data ObjectInfo     = ObjectInfo {         objectKey          :: T.Text@@ -374,7 +389,7 @@         lastModified = case B8.unpack `fmap` lookup "Last-Modified" h of                          Just ts -> case parseHttpDate ts of                                       Just t -> return t-                                      Nothing -> F.failure $ HeaderException "Invalid Last-Modified"+                                      Nothing -> F.failure $ HeaderException ("Invalid Last-Modified: " ++ ts)                          Nothing -> F.failure $ HeaderException "Last-Modified missing"         versionId = T.decodeUtf8 `fmap` lookup "x-amz-version-id" h         -- expiration = return undefined

@@ -1,4 +1,3 @@-{-# LANGUAGE DeriveDataTypeable, RecordWildCards, TypeFamilies, MultiParamTypeClasses, OverloadedStrings #-} module Aws.Ses.Commands.SendRawEmail     ( SendRawEmail(..)     , SendRawEmailResponse(..)@@ -46,3 +45,7 @@   instance Transaction SendRawEmail SendRawEmailResponse where++instance AsMemoryResponse SendRawEmailResponse where+    type MemoryResponse SendRawEmailResponse = SendRawEmailResponse+    loadToMemory = return

@@ -1,4 +1,3 @@-{-# LANGUAGE DeriveDataTypeable, MultiParamTypeClasses, RecordWildCards, OverloadedStrings #-} module Aws.Ses.Core     ( SesError(..)     , SesMetadata(..)@@ -20,22 +19,23 @@     ) where  import           Aws.Core-import           Control.Monad                  (mplus)-import           Data.ByteString.Char8          ({-IsString-})-import           Data.IORef-import           Data.Maybe-import           Data.Monoid-import           Data.Text                      (Text)-import           Data.Typeable-import           Text.XML.Cursor                (($/), ($//)) import qualified Blaze.ByteString.Builder       as Blaze import qualified Blaze.ByteString.Builder.Char8 as Blaze8 import qualified Control.Exception              as C import qualified Control.Failure                as F+import           Control.Monad                  (mplus) import qualified Data.ByteString                as B import qualified Data.ByteString.Base64         as B64+import           Data.ByteString.Char8          ({-IsString-})+import           Data.IORef+import           Data.Maybe+import           Data.Monoid+import           Data.Text                      (Text) import qualified Data.Text.Encoding             as TE+import           Data.Typeable+import qualified Network.HTTP.Conduit           as HTTP import qualified Network.HTTP.Types             as HTTP+import           Text.XML.Cursor                (($/), ($//)) import qualified Text.XML.Cursor                as Cu  data SesError@@ -54,35 +54,37 @@       }     deriving (Show, Typeable) +instance Loggable SesMetadata where+    toLogText (SesMetadata rid) = "SES: request ID=" `mappend` fromMaybe "<none>" rid+ instance Monoid SesMetadata where     mempty = SesMetadata Nothing     SesMetadata r1 `mappend` SesMetadata r2 = SesMetadata (r1 `mplus` r2) -data SesConfiguration+data SesConfiguration qt     = SesConfiguration {         sesiHttpMethod :: Method       , sesiHost       :: B.ByteString       }     deriving (Show) -instance DefaultServiceConfiguration SesConfiguration where-    defaultConfiguration = sesHttpsPost sesUsEast-    defaultConfigurationUri = sesHttpsGet sesUsEast-    -    -- HTTP is not supported right now, always use HTTPS-    --debugConfiguration = sesHttpPost sesUsEast-    --debugConfigurationUri = sesHttpGet sesUsEast+-- HTTP is not supported right now, always use HTTPS+instance DefaultServiceConfiguration (SesConfiguration NormalQuery) where+    defServiceConfig = sesHttpsPost sesUsEast +instance DefaultServiceConfiguration (SesConfiguration UriOnlyQuery) where+    defServiceConfig = sesHttpsGet sesUsEast+ sesUsEast :: B.ByteString sesUsEast = "email.us-east-1.amazonaws.com" -sesHttpsGet :: B.ByteString -> SesConfiguration+sesHttpsGet :: B.ByteString -> SesConfiguration qt sesHttpsGet endpoint = SesConfiguration Get endpoint -sesHttpsPost :: B.ByteString -> SesConfiguration+sesHttpsPost :: B.ByteString -> SesConfiguration NormalQuery sesHttpsPost endpoint = SesConfiguration PostQuery endpoint -sesSignQuery :: [(B.ByteString, B.ByteString)] -> SesConfiguration -> SignatureData -> SignedQuery+sesSignQuery :: [(B.ByteString, B.ByteString)] -> SesConfiguration qt -> SignatureData -> SignedQuery sesSignQuery query si sd     = SignedQuery {         sqMethod        = sesiHttpMethod si@@ -114,7 +116,7 @@ sesResponseConsumer :: (Cu.Cursor -> Response SesMetadata a)                     -> IORef SesMetadata                     -> HTTPResponseConsumer a-sesResponseConsumer inner metadataRef status = xmlCursorConsumer parse metadataRef status+sesResponseConsumer inner metadataRef resp = xmlCursorConsumer parse metadataRef resp     where       parse cursor = do         let requestId' = listToMaybe $ cursor $// elContent "RequestID"@@ -126,7 +128,7 @@       fromError cursor = do         errCode    <- force "Missing Error Code"    $ cursor $// elContent "Code"         errMessage <- force "Missing Error Message" $ cursor $// elContent "Message"-        F.failure $ SesError status errCode errMessage+        F.failure $ SesError (HTTP.responseStatus resp) errCode errMessage  class SesAsQuery a where     -- | Write a data type as a list of query parameters.

@@ -1,4 +1,3 @@-{-# LANGUAGE RecordWildCards, TypeFamilies, FlexibleInstances, MultiParamTypeClasses, OverloadedStrings, TupleSections #-} module Aws.SimpleDb.Commands.Attributes where  import           Aws.Core@@ -48,6 +47,10 @@  instance Transaction GetAttributes GetAttributesResponse +instance AsMemoryResponse GetAttributesResponse where+    type MemoryResponse GetAttributesResponse = GetAttributesResponse+    loadToMemory = return+ data PutAttributes     = PutAttributes {         paItemName :: T.Text@@ -84,6 +87,10 @@  instance Transaction PutAttributes PutAttributesResponse +instance AsMemoryResponse PutAttributesResponse where+    type MemoryResponse PutAttributesResponse = PutAttributesResponse+    loadToMemory = return+ data DeleteAttributes     = DeleteAttributes {         daItemName :: T.Text@@ -120,6 +127,10 @@  instance Transaction DeleteAttributes DeleteAttributesResponse +instance AsMemoryResponse DeleteAttributesResponse where+    type MemoryResponse DeleteAttributesResponse = DeleteAttributesResponse+    loadToMemory = return+ data BatchPutAttributes     = BatchPutAttributes {         bpaItems :: [Item [Attribute SetAttribute]]@@ -149,6 +160,10 @@  instance Transaction BatchPutAttributes BatchPutAttributesResponse +instance AsMemoryResponse BatchPutAttributesResponse where+    type MemoryResponse BatchPutAttributesResponse = BatchPutAttributesResponse+    loadToMemory = return+ data BatchDeleteAttributes     = BatchDeleteAttributes {         bdaItems :: [Item [Attribute DeleteAttribute]]@@ -177,3 +192,7 @@     responseConsumer _ = sdbResponseConsumer $ sdbCheckResponseType BatchDeleteAttributesResponse "BatchDeleteAttributesResponse"  instance Transaction BatchDeleteAttributes BatchDeleteAttributesResponse++instance AsMemoryResponse BatchDeleteAttributesResponse where+    type MemoryResponse BatchDeleteAttributesResponse = BatchDeleteAttributesResponse+    loadToMemory = return

@@ -1,4 +1,3 @@-{-# LANGUAGE RecordWildCards, TypeFamilies, FlexibleInstances, MultiParamTypeClasses, OverloadedStrings, TupleSections #-} module Aws.SimpleDb.Commands.Domain where  import           Aws.Core@@ -35,6 +34,10 @@  instance Transaction CreateDomain CreateDomainResponse +instance AsMemoryResponse CreateDomainResponse where+    type MemoryResponse CreateDomainResponse = CreateDomainResponse+    loadToMemory = return+ data DeleteDomain     = DeleteDomain {         ddDomainName :: T.Text@@ -59,6 +62,10 @@  instance Transaction DeleteDomain DeleteDomainResponse +instance AsMemoryResponse DeleteDomainResponse where+    type MemoryResponse DeleteDomainResponse = DeleteDomainResponse+    loadToMemory = return+ data DomainMetadata     = DomainMetadata {         dmDomainName :: T.Text@@ -102,6 +109,10 @@  instance Transaction DomainMetadata DomainMetadataResponse +instance AsMemoryResponse DomainMetadataResponse where+    type MemoryResponse DomainMetadataResponse = DomainMetadataResponse+    loadToMemory = return+ data ListDomains     = ListDomains {         ldMaxNumberOfDomains :: Maybe Int@@ -138,3 +149,14 @@                 return $ ListDomainsResponse names nextToken  instance Transaction ListDomains ListDomainsResponse++instance AsMemoryResponse ListDomainsResponse where+    type MemoryResponse ListDomainsResponse = ListDomainsResponse+    loadToMemory = return++instance ListResponse ListDomainsResponse T.Text where+    listResponse = ldrDomainNames++instance IteratedTransaction ListDomains ListDomainsResponse where+  nextIteratedRequest req ListDomainsResponse{ldrNextToken=nt} = req{ldNextToken=nt} <$ nt+  --combineIteratedResponse (ListDomainsResponse dn1 _) (ListDomainsResponse dn2 nt2) = ListDomainsResponse (dn1 ++ dn2) nt2

@@ -1,4 +1,3 @@-{-# LANGUAGE RecordWildCards, TypeFamilies, FlexibleInstances, MultiParamTypeClasses, OverloadedStrings, TupleSections #-} module Aws.SimpleDb.Commands.Select where @@ -51,3 +50,14 @@                 return $ SelectResponse items nextToken  instance Transaction Select SelectResponse++instance AsMemoryResponse SelectResponse where+    type MemoryResponse SelectResponse = SelectResponse+    loadToMemory = return++instance ListResponse SelectResponse (Item [Attribute T.Text]) where+    listResponse = srItems++instance IteratedTransaction Select SelectResponse where+  nextIteratedRequest req SelectResponse{srNextToken=nt} = req{sNextToken=nt} <$ nt+--  combineIteratedResponse (SelectResponse s1 _) (SelectResponse s2 nt2) = SelectResponse (s1 ++ s2) nt2

@@ -1,23 +1,23 @@-{-# LANGUAGE DeriveDataTypeable, MultiParamTypeClasses, RecordWildCards, OverloadedStrings, FlexibleContexts #-} module Aws.SimpleDb.Core where  import           Aws.Core-import           Control.Monad-import           Data.IORef-import           Data.List-import           Data.Maybe-import           Data.Monoid-import           Data.Typeable-import           Text.XML.Cursor                (($|), ($/), ($//), (&|)) import qualified Blaze.ByteString.Builder       as Blaze import qualified Blaze.ByteString.Builder.Char8 as Blaze8 import qualified Control.Exception              as C import qualified Control.Failure                as F+import           Control.Monad import qualified Data.ByteString                as B import qualified Data.ByteString.Base64         as Base64+import           Data.IORef+import           Data.List+import           Data.Maybe+import           Data.Monoid import qualified Data.Text                      as T import qualified Data.Text.Encoding             as T+import           Data.Typeable+import qualified Network.HTTP.Conduit           as HTTP import qualified Network.HTTP.Types             as HTTP+import           Text.XML.Cursor                (($|), ($/), ($//), (&|)) import qualified Text.XML.Cursor                as Cu  type ErrorCode = String@@ -39,11 +39,17 @@       }     deriving (Show, Typeable) +instance Loggable SdbMetadata where+    toLogText (SdbMetadata rid bu) = "SimpleDB: request ID=" `mappend`+                                     fromMaybe "<none>" rid `mappend`+                                     ", box usage=" `mappend`+                                     fromMaybe "<not available>" bu+ instance Monoid SdbMetadata where     mempty = SdbMetadata Nothing Nothing     SdbMetadata r1 b1 `mappend` SdbMetadata r2 b2 = SdbMetadata (r1 `mplus` r2) (b1 `mplus` b2) -data SdbConfiguration+data SdbConfiguration qt     = SdbConfiguration {         sdbiProtocol :: Protocol       , sdbiHttpMethod :: Method@@ -52,12 +58,13 @@       }     deriving (Show) -instance DefaultServiceConfiguration SdbConfiguration where-  defaultConfiguration = sdbHttpsPost sdbUsEast-  defaultConfigurationUri = sdbHttpsGet sdbUsEast-  -  debugConfiguration = sdbHttpPost sdbUsEast-  debugConfigurationUri = sdbHttpGet sdbUsEast+instance DefaultServiceConfiguration (SdbConfiguration NormalQuery) where+  defServiceConfig = sdbHttpsPost sdbUsEast+  debugServiceConfig = sdbHttpPost sdbUsEast++instance DefaultServiceConfiguration (SdbConfiguration UriOnlyQuery) where+  defServiceConfig = sdbHttpsGet sdbUsEast  +  debugServiceConfig = sdbHttpGet sdbUsEast               sdbUsEast :: B.ByteString sdbUsEast = "sdb.amazonaws.com" @@ -74,19 +81,19 @@ sdbApNortheast :: B.ByteString sdbApNortheast = "sdb.ap-northeast-1.amazonaws.com"              -sdbHttpGet :: B.ByteString -> SdbConfiguration+sdbHttpGet :: B.ByteString -> SdbConfiguration qt sdbHttpGet endpoint = SdbConfiguration HTTP Get endpoint (defaultPort HTTP)                           -sdbHttpPost :: B.ByteString -> SdbConfiguration+sdbHttpPost :: B.ByteString -> SdbConfiguration NormalQuery sdbHttpPost endpoint = SdbConfiguration HTTP PostQuery endpoint (defaultPort HTTP)               -sdbHttpsGet :: B.ByteString -> SdbConfiguration+sdbHttpsGet :: B.ByteString -> SdbConfiguration qt sdbHttpsGet endpoint = SdbConfiguration HTTPS Get endpoint (defaultPort HTTPS)              -sdbHttpsPost :: B.ByteString -> SdbConfiguration+sdbHttpsPost :: B.ByteString -> SdbConfiguration NormalQuery sdbHttpsPost endpoint = SdbConfiguration HTTPS PostQuery endpoint (defaultPort HTTPS) -sdbSignQuery :: [(B.ByteString, B.ByteString)] -> SdbConfiguration -> SignatureData -> SignedQuery+sdbSignQuery :: [(B.ByteString, B.ByteString)] -> SdbConfiguration qt -> SignatureData -> SignedQuery sdbSignQuery q si sd     = SignedQuery {         sqMethod = method@@ -131,8 +138,8 @@ sdbResponseConsumer :: (Cu.Cursor -> Response SdbMetadata a)                     -> IORef SdbMetadata                     -> HTTPResponseConsumer a-sdbResponseConsumer inner metadataRef status headers source-    = xmlCursorConsumer parse metadataRef status headers source+sdbResponseConsumer inner metadataRef resp+    = xmlCursorConsumer parse metadataRef resp     where parse cursor               = do let requestId' = listToMaybe $ cursor $// elContent "RequestID"                    let boxUsage' = listToMaybe $ cursor $// elContent "BoxUsage"@@ -142,7 +149,7 @@                      (err:_) -> fromError err           fromError cursor = do errCode <- force "Missing Error Code" $ cursor $// elCont "Code"                                 errMessage <- force "Missing Error Message" $ cursor $// elCont "Message"-                                F.failure $ SdbError status errCode errMessage+                                F.failure $ SdbError (HTTP.responseStatus resp) errCode errMessage  class SdbFromResponse a where     sdbFromResponse :: Cu.Cursor -> Response SdbMetadata a

@@ -1,4 +1,3 @@-{-# LANGUAGE RecordWildCards, TypeFamilies, FlexibleInstances, MultiParamTypeClasses, OverloadedStrings, TupleSections, ScopedTypeVariables, FlexibleContexts #-}  module Aws.Sqs.Commands.Message where @@ -42,6 +41,10 @@  instance Transaction SendMessage SendMessageResponse +instance AsMemoryResponse SendMessageResponse where+    type MemoryResponse SendMessageResponse = SendMessageResponse+    loadToMemory = return+ data DeleteMessage = DeleteMessage{   dmReceiptHandle :: ReceiptHandle,   dmQueueName :: QueueName @@ -66,6 +69,10 @@  instance Transaction DeleteMessage DeleteMessageResponse +instance AsMemoryResponse DeleteMessageResponse where+    type MemoryResponse DeleteMessageResponse = DeleteMessageResponse+    loadToMemory = return+ data ReceiveMessage     = ReceiveMessage {         rmVisibilityTimeout :: Maybe Int@@ -138,6 +145,10 @@  instance Transaction ReceiveMessage ReceiveMessageResponse +instance AsMemoryResponse ReceiveMessageResponse where+    type MemoryResponse ReceiveMessageResponse = ReceiveMessageResponse+    loadToMemory = return+ data ChangeMessageVisibility = ChangeMessageVisibility {   cmvReceiptHandle :: ReceiptHandle,   cmvVisibilityTimeout :: Int,@@ -163,3 +174,7 @@                                                          ("VisibilityTimeout", Just $ B.pack $ show cmvVisibilityTimeout)]}  instance Transaction ChangeMessageVisibility ChangeMessageVisibilityResponse++instance AsMemoryResponse ChangeMessageVisibilityResponse where+    type MemoryResponse ChangeMessageVisibilityResponse = ChangeMessageVisibilityResponse+    loadToMemory = return

@@ -1,4 +1,3 @@-{-# LANGUAGE RecordWildCards, TypeFamilies, FlexibleInstances, MultiParamTypeClasses, OverloadedStrings, TupleSections #-}  module Aws.Sqs.Commands.Permission where @@ -42,6 +41,10 @@  instance Transaction AddPermission AddPermissionResponse +instance AsMemoryResponse AddPermissionResponse where+    type MemoryResponse AddPermissionResponse = AddPermissionResponse+    loadToMemory = return+ data RemovePermission = RemovePermission {     rpLabel :: T.Text,     rpQueueName :: QueueName @@ -66,3 +69,7 @@                                                         ("Label", Just $ TE.encodeUtf8 rpLabel )]}   instance Transaction RemovePermission RemovePermissionResponse++instance AsMemoryResponse RemovePermissionResponse where+    type MemoryResponse RemovePermissionResponse = RemovePermissionResponse+    loadToMemory = return

@@ -1,4 +1,3 @@-{-# LANGUAGE RecordWildCards, TypeFamilies, FlexibleInstances, MultiParamTypeClasses, OverloadedStrings, TupleSections #-}  module Aws.Sqs.Commands.Queue where @@ -43,6 +42,10 @@  instance Transaction CreateQueue CreateQueueResponse +instance AsMemoryResponse CreateQueueResponse where+    type MemoryResponse CreateQueueResponse = CreateQueueResponse+    loadToMemory = return+ data DeleteQueue = DeleteQueue {     dqQueueName :: QueueName    } deriving (Show)@@ -65,6 +68,10 @@  instance Transaction DeleteQueue DeleteQueueResponse +instance AsMemoryResponse DeleteQueueResponse where+    type MemoryResponse DeleteQueueResponse = DeleteQueueResponse+    loadToMemory = return+ data ListQueues = ListQueues {     lqQueueNamePrefix :: Maybe T.Text   } deriving (Show)@@ -92,3 +99,7 @@                                                                          Nothing -> Nothing]}  instance Transaction ListQueues ListQueuesResponse++instance AsMemoryResponse ListQueuesResponse where+    type MemoryResponse ListQueuesResponse = ListQueuesResponse+    loadToMemory = return

@@ -1,4 +1,3 @@-{-# LANGUAGE RecordWildCards, TypeFamilies, FlexibleInstances, MultiParamTypeClasses, OverloadedStrings, TupleSections #-}  module Aws.Sqs.Commands.QueueAttributes where @@ -50,6 +49,10 @@  instance Transaction GetQueueAttributes GetQueueAttributesResponse +instance AsMemoryResponse GetQueueAttributesResponse where+    type MemoryResponse GetQueueAttributesResponse = GetQueueAttributesResponse+    loadToMemory = return+ data SetQueueAttributes = SetQueueAttributes{   sqaAttribute :: QueueAttribute,   sqaValue :: T.Text,@@ -76,3 +79,7 @@                                                         ("Attribute.Value", Just $ TE.encodeUtf8 sqaValue)]}   instance Transaction SetQueueAttributes SetQueueAttributesResponse++instance AsMemoryResponse SetQueueAttributesResponse where+    type MemoryResponse SetQueueAttributesResponse = SetQueueAttributesResponse+    loadToMemory = return

@@ -1,33 +1,33 @@-{-# LANGUAGE DeriveDataTypeable, MultiParamTypeClasses, OverloadedStrings, RecordWildCards, FlexibleContexts #-} module Aws.Sqs.Core where  import           Aws.Core import           Aws.S3.Core                    (LocationConstraint, locationUsClassic, locationUsWest, locationApSouthEast, locationApNorthEast, locationEu)+import qualified Blaze.ByteString.Builder       as Blaze+import qualified Blaze.ByteString.Builder.Char8 as Blaze8+import qualified Control.Exception              as C+import qualified Control.Failure                as F import           Control.Monad import           Control.Monad.IO.Class import           Data.Attempt                   (Attempt(..))+import qualified Data.ByteString                as B+import qualified Data.ByteString.Char8          as BC import           Data.Conduit                   (($$+-))+import qualified Data.Conduit                   as C import           Data.IORef import           Data.List import           Data.Maybe import           Data.Monoid import           Data.Ord-import           Data.Time-import           Data.Typeable-import           System.Locale-import           Text.XML.Cursor                (($/))-import qualified Blaze.ByteString.Builder       as Blaze-import qualified Blaze.ByteString.Builder.Char8 as Blaze8-import qualified Control.Exception              as C-import qualified Control.Failure                as F-import qualified Data.ByteString                as B-import qualified Data.ByteString.Char8          as BC-import qualified Data.Conduit                   as C import qualified Data.Text                      as T import qualified Data.Text.Encoding             as T import qualified Data.Text.Encoding             as TE+import           Data.Time+import           Data.Typeable+import qualified Network.HTTP.Conduit           as HTTP import qualified Network.HTTP.Types             as HTTP+import           System.Locale import qualified Text.XML                       as XML+import           Text.XML.Cursor                (($/)) import qualified Text.XML.Cursor                as Cu  type ErrorCode = T.Text@@ -56,6 +56,12 @@       }     deriving (Show) +instance Loggable SqsMetadata where+    toLogText (SqsMetadata id2 rid) = "SQS: request ID=" `mappend`+                                      fromMaybe "<none>" rid `mappend`+                                      ", x-amz-id-2=" `mappend`+                                      fromMaybe "<none>" id2+ instance Monoid SqsMetadata where     mempty = SqsMetadata Nothing Nothing     SqsMetadata a1 r1 `mappend` SqsMetadata a2 r2 = SqsMetadata (a1 `mplus` a2) (r1 `mplus` r2)@@ -73,7 +79,7 @@       }     deriving (Show) -data SqsConfiguration+data SqsConfiguration qt     = SqsConfiguration {         sqsProtocol :: Protocol       , sqsEndpoint :: Endpoint@@ -83,11 +89,13 @@       }     deriving (Show) -instance DefaultServiceConfiguration SqsConfiguration where-    defaultConfiguration = sqs HTTPS sqsEndpointUsClassic False-    defaultConfigurationUri = sqs HTTPS sqsEndpointUsClassic True-    debugConfiguration = sqs HTTP sqsEndpointUsClassic False-    debugConfigurationUri = sqs HTTP sqsEndpointUsClassic True+instance DefaultServiceConfiguration (SqsConfiguration NormalQuery) where+    defServiceConfig = sqs HTTPS sqsEndpointUsClassic False+    debugServiceConfig = sqs HTTP sqsEndpointUsClassic False++instance DefaultServiceConfiguration (SqsConfiguration UriOnlyQuery) where+    defServiceConfig = sqs HTTPS sqsEndpointUsClassic True+    debugServiceConfig = sqs HTTP sqsEndpointUsClassic True    sqsEndpointUsClassic :: Endpoint sqsEndpointUsClassic @@ -133,7 +141,7 @@       , endpointAllowedLocationConstraints = [locationApNorthEast]       } -sqs :: Protocol -> Endpoint -> Bool -> SqsConfiguration+sqs :: Protocol -> Endpoint -> Bool -> SqsConfiguration qt sqs protocol endpoint uri      = SqsConfiguration {          sqsProtocol = protocol@@ -148,7 +156,7 @@   sqsQuery :: HTTP.Query } -sqsSignQuery :: SqsQuery -> SqsConfiguration -> SignatureData -> SignedQuery+sqsSignQuery :: SqsQuery -> SqsConfiguration qt -> SignatureData -> SignedQuery sqsSignQuery SqsQuery{..} SqsConfiguration{..} SignatureData{..}     = SignedQuery {         sqMethod = method@@ -196,17 +204,17 @@ sqsResponseConsumer :: HTTPResponseConsumer a                     -> IORef SqsMetadata                     -> HTTPResponseConsumer a-sqsResponseConsumer inner metadata status headers source = do-      let headerString = fmap T.decodeUtf8 . flip lookup headers+sqsResponseConsumer inner metadata resp = do+      let headerString = fmap T.decodeUtf8 . flip lookup (HTTP.responseHeaders resp)       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+      if HTTP.responseStatus resp >= HTTP.status400+        then sqsErrorResponseConsumer resp+        else inner resp  sqsXmlResponseConsumer :: (Cu.Cursor -> Response SqsMetadata a)                        -> IORef SqsMetadata@@ -214,8 +222,8 @@ sqsXmlResponseConsumer parse metadataRef = sqsResponseConsumer (xmlCursorConsumer parse metadataRef) metadataRef  sqsErrorResponseConsumer :: HTTPResponseConsumer a-sqsErrorResponseConsumer status _headers source-    = do doc <- source $$+- XML.sinkDoc XML.def+sqsErrorResponseConsumer resp+    = do doc <- HTTP.responseBody resp $$+- XML.sinkDoc XML.def          let cursor = Cu.fromDocument doc          liftIO $ case parseError cursor of            Success err -> C.monadThrow err@@ -229,7 +237,7 @@                            let detail = listToMaybe $ cursor $/ elContent "Detail"                             return SqsError {-                                        sqsStatusCode = status+                                        sqsStatusCode = HTTP.responseStatus resp                                       , sqsErrorCode = code                                       , sqsErrorMessage = message                                       , sqsErrorType = errorType

@@ -2,26 +2,22 @@  import qualified Aws import qualified Aws.S3 as S3-import Data.Conduit-import Data.Conduit.Binary-import Data.IORef-import Data.Monoid--{- A small function to save the object's data into a file. -}-saveObject :: Aws.HTTPResponseConsumer ()-saveObject status headers source = source $$+- sinkFile "cloud-remote.pdf"+import           Data.Conduit (($$+-))+import           Data.Conduit.Binary (sinkFile)+import           Network.HTTP.Conduit (withManager, responseBody)  main :: IO () main = do   {- Set up AWS credentials and the default configuration. -}   cfg <- Aws.baseConfiguration-  let s3Cfg = Aws.defaultConfiguration--  {- Create an IORef to store the response Metadata (so it is also available in case of an error). -}-  metadataRef <- newIORef mempty+  let s3cfg = Aws.defServiceConfig :: S3.S3Configuration Aws.NormalQuery -  {- Create a request object with S3.getObject and run the request with simpleAwsRef. -}-  Aws.simpleAwsRef cfg s3Cfg metadataRef $ S3.getObject "haskell-aws" "cloud-remote.pdf" saveObject+  {- Set up a ResourceT region with an available HTTP manager. -}+  withManager $ \mgr -> do+    {- Create a request object with S3.getObject and run the request with pureAws. -}+    S3.GetObjectResponse { S3.gorResponse = rsp } <-+      Aws.pureAws cfg s3cfg mgr $+        S3.getObject "haskell-aws" "cloud-remote.pdf" -  {- Print the response metadata. -}-  print =<< readIORef metadataRef+    {- Save the response to a file. -}+    responseBody rsp $$+- sinkFile "cloud-remote.pdf"

@@ -1,7 +1,5 @@ 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 @@ -9,17 +7,14 @@ main = do   {- Load configuration -}   cfg <- Aws.baseConfiguration-  let sdbCfg = Aws.defaultConfiguration+  let sdbCfg = Aws.defServiceConfig    putStrLn "Making request..."    {- Make request -}   let req = Sdb.listDomains { Sdb.ldMaxNumberOfDomains = Just 10 }-  Aws.Response _metadata resp <- Aws.simpleAws cfg sdbCfg req+  Sdb.ListDomainsResponse names _token <- 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)+  putStrLn "First 10 domains:"+  mapM_ (T.putStrLn . T.cons '\t') names

@@ -1,4 +1,4 @@-Copyright (c) 2010, Aristid Breitkreuz+Copyright (c) 2010, 2011, 2012, Aristid Breitkreuz  All rights reserved. 

@@ -5,6 +5,9 @@ The ~aws~ package attempts to provide support for using Amazon Web Services like S3 (storage), SQS (queuing) and others to Haskell programmers. The ultimate goal is to support all Amazon Web Services. +(If you are viewing this README online, please note that you can find the README+for the latest stable version at https://github.com/aristidb/aws/blob/stable/README.org).+ * Installation  Make sure you have a recent GHC installed, as well as cabal-install, and installation should be as easy as:@@ -46,36 +49,32 @@  You do have to replace AccessKeyID and SecretKey with the Access Key ID and the Secret Key respectively, of course. -Then, copy this example into a Haskell file, and run it with ~runghc~:+Then, copy this example into a Haskell file, and run it with ~runghc~ (after installing aws):  #+BEGIN_SRC haskell {-# LANGUAGE OverloadedStrings #-}  import qualified Aws import qualified Aws.S3 as S3-import Data.Conduit-import Data.Conduit.Binary-import Data.IORef-import Data.Monoid--{- A small function to save the object's data into a file. -}-saveObject :: Aws.HTTPResponseConsumer ()-saveObject status headers source = source $$+- sinkFile "cloud-remote.pdf"+import           Data.Conduit (($$+-))+import           Data.Conduit.Binary (sinkFile)+import           Network.HTTP.Conduit (withManager, responseBody)  main :: IO () main = do   {- Set up AWS credentials and the default configuration. -}   cfg <- Aws.baseConfiguration-  let s3Cfg = Aws.defaultConfiguration--  {- Create an IORef to store the response Metadata (so it is also available in case of an error). -}-  metadataRef <- newIORef mempty+  let s3cfg = Aws.defServiceConfig :: S3.S3Configuration Aws.NormalQuery -  {- Create a request object with S3.getObject and run the request with simpleAwsRef. -}-  Aws.simpleAwsRef cfg s3Cfg metadataRef $ S3.getObject "haskell-aws" "cloud-remote.pdf" saveObject+  {- Set up a ResourceT region with an available HTTP manager. -}+  withManager $ \mgr -> do+    {- Create a request object with S3.getObject and run the request with pureAws. -}+    S3.GetObjectResponse { S3.gorResponse = rsp } <-+      Aws.pureAws cfg s3cfg mgr $+        S3.getObject "haskell-aws" "cloud-remote.pdf" -  {- Print the response metadata. -}-  print =<< readIORef metadataRef+    {- Save the response to a file. -}+    responseBody rsp $$+- sinkFile "cloud-remote.pdf" #+END_SRC  You can also find this example in the source distribution in the ~Examples/~ folder.@@ -92,12 +91,20 @@  * Release Notes -** 0.7 series (planned)--Feature ideas:+** 0.7 series -- Change ServiceConfiguration concept so as to indicate in the type whether this is for URI-only requests (i.e.-  awsUri)+- 0.7.0+  - Change ServiceConfiguration concept so as to indicate in the type whether this is for URI-only requests+    (i.e. awsUri)+  - EXPERIMENTAL: Direct support for iterated transaction, i.e. such where multiple HTTP requests might be necessary due to e.g. response size limits.+  - Put aws functions in ResourceT to be able to safely return Sources and streams.+    - simpleAws* does not require ResourceT and converts streams into memory values (like ByteStrings) first.+  - Log response metadata (level Info), and do not let all aws runners return it.+  - S3:+    - GetObject: No longer require a response consumer in the request, return the HTTP response (with the body as a stream) instead.+    - Add CopyObject (PUT Object Copy) request type.+  - Add Examples cabal flag for building code examples.+  - Many more, small improvements.  ** 0.6 series @@ -145,3 +152,15 @@ - [[https://github.com/aristidb/aws][aws on Github]] - [[http://hackage.haskell.org/package/aws][aws on Hackage]] (includes reference documentation) - [[http://aws.amazon.com/][Official Amazon Web Services website]]++* Contributors++| Name               | Github       | E-Mail                    | Company                | Components    |+|--------------------+--------------+---------------------------+------------------------+---------------|+| Aristid Breitkreuz | [[https://github.com/aristidb][aristidb]]     | aristidb@gmail.com        | -                      | Maintainer    |+| Bas van Dijk       | [[https://github.com/basvandijk][basvandijk]]   | v.dijk.bas@gmail.com      | [[http://erudify.ch][Erudify AG]]             | S3            |+| David Vollbracht   | [[https://github.com/qxjit][qxjit]]        |                           |                        |               |+| Felipe Lessa       | [[https://github.com/meteficha][meteficha]]    | felipe.lessa@gmail.com    | currently secret       | Core, S3, SES |+| Nathan Howell      | [[https://github.com/NathanHowell][NathanHowell]] | nhowell@alphaheavy.com    | [[http://www.alphaheavy.com][Alpha Heavy Industries]] | S3            |+| Ozgun Ataman       | [[https://github.com/ozataman][ozataman]]     | ozgun.ataman@soostone.com | [[http://soostone.com][Soostone Inc]]           | Core, S3      |+| Steve Severance    | [[https://github.com/sseveran][sseveran]]     | sseverance@alphaheavy.com | [[http://www.alphaheavy.com][Alpha Heavy Industries]] | S3, SQS       |

@@ -1,50 +1,21 @@--- aws.cabal auto-generated by cabal init. For additional options, see--- http://www.haskell.org/cabal/release/cabal-latest/doc/users-guide/authors.html#pkg-descr.--- The name of the package. Name:                aws---- 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.6.2---- A short (one-line) description of the package.+Version:             0.7.0 Synopsis:            Amazon Web Services (AWS) for Haskell---- A longer description of the package. Description:         Bindings for Amazon Web Services (AWS), with the aim of supporting all AWS services. To see a high level overview of the library, see the README at <https://github.com/aristidb/aws/blob/master/README.org>.---- URL for the project homepage or repository. Homepage:            http://github.com/aristidb/aws---- The license under which the package is released. License:             BSD3---- The file containing the license text. License-file:        LICENSE---- The package author(s).-Author:              Aristid Breitkreuz, Felipe Lessa---- An email address to which users can send suggestions, bug reports,--- and patches.+Author:              Aristid Breitkreuz, contributors see README Maintainer:          aristidb@googlemail.com---- A copyright notice.-Copyright:           Copyright (C) 2010 Aristid Breitkreuz-+Copyright:           See contributors list in README and LICENSE file Category:            Network, Web- Build-type:          Simple --- Extra files to be distributed with the package, such as examples or--- 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+Cabal-version:       >=1.10  Source-repository this   type: git@@ -55,14 +26,18 @@   type: git   location: https://github.com/aristidb/aws.git +Flag Examples+  Description: Build the examples.+  Default: False+ Library-  -- Modules exported by the library.   Exposed-modules:                        Aws,                        Aws.Aws,                        Aws.Core,                        Aws.S3,                        Aws.S3.Commands,+                       Aws.S3.Commands.CopyObject,                        Aws.S3.Commands.DeleteObject,                        Aws.S3.Commands.GetBucket,                        Aws.S3.Commands.GetObject,@@ -88,10 +63,10 @@                        Aws.Ses.Commands.SendRawEmail,                        Aws.Ses.Core -  -- Packages needed in order to build this package.-  Build-depends:       attempt              >= 0.3.1.1 && < 0.5,+  Build-depends:+                       attempt              >= 0.3.1.1 && < 0.5,                        base                 == 4.*,-                       base64-bytestring    == 0.1.*,+                       base64-bytestring    == 1.0.*,                        blaze-builder        >= 0.2.1.4 && < 0.4,                        bytestring           == 0.9.*,                        case-insensitive     >= 0.2     && < 0.5,@@ -103,12 +78,13 @@                        directory            >= 1.0     && < 1.2,                        failure              >= 0.1.0.1 && < 0.3,                        filepath             >= 1.1     && < 1.4,-                       http-conduit         >= 1.5     && < 1.6,+                       http-conduit         >= 1.6     && < 1.7,                        http-types           >= 0.7     && < 0.8,                        lifted-base          == 0.1.*,-                       mtl                  == 2.*,                        monad-control        >= 0.3,+                       mtl                  == 2.*,                        old-locale           == 1.*,+                       resourcet            >= 0.3.3 && <0.4,                        text                 >= 0.11,                        time                 >= 1.1.4   && < 1.5,                        transformers         >= 0.2.2.0 && < 0.4,@@ -117,9 +93,48 @@    GHC-Options: -Wall -  -- Modules not exported by this package.-  -- Other-modules:+  Default-Language: Haskell2010+  Default-Extensions:+        RecordWildCards,+        TypeFamilies,+        MultiParamTypeClasses,+        FlexibleContexts,+        FlexibleInstances,+        FunctionalDependencies,+        DeriveFunctor,+        DeriveDataTypeable,+        OverloadedStrings,+        TupleSections,+        ScopedTypeVariables,+        EmptyDataDecls -  -- Extra tools (e.g. alex, hsc2hs, ...) needed to build the source.-  -- Build-tools:+Executable GetObject+  Main-is: GetObject.hs+  Hs-source-dirs: Examples +  if !flag(Examples)+    Buildable: False+  else+    Buildable: True+    Build-depends:+                       base == 4.*,+                       aws,+                       http-conduit >= 1.6 && < 1.7,+                       conduit >= 0.5 && < 0.6++  Default-Language: Haskell2010++Executable SimpleDb+  Main-is: SimpleDb.hs+  Hs-source-dirs: Examples++  if !flag(Examples)+    Buildable: False+  else+    Buildable: True+    Build-depends:+                       base == 4.*,+                       aws,+                       text >=0.11.2++  Default-Language: Haskell2010