aws 0.4.1 → 0.5.0

raw patch · 82 files changed

+2687/−2934 lines, 82 filesPVP ok

version bump matches the API change (PVP)

API changes (from Hackage documentation)

Files

• Aws.hs +46/−18
• Aws/Aws.hs +125/−92
• Aws/Core.hs +568/−0
• Aws/Credentials.hs +0/−58
• Aws/Http.hs +0/−30
• Aws/Query.hs +0/−76
• Aws/Response.hs +0/−49
• Aws/S3.hs +2/−12
• Aws/S3/Commands/DeleteObject.hs +4/−10
• Aws/S3/Commands/GetBucket.hs +4/−11
• Aws/S3/Commands/GetObject.hs +8/−12
• Aws/S3/Commands/GetService.hs +4/−11
• Aws/S3/Commands/PutBucket.hs +4/−10
• Aws/S3/Commands/PutObject.hs +4/−10
• Aws/S3/Core.hs +393/−0
• Aws/S3/Error.hs +0/−25
• Aws/S3/Info.hs +0/−55
• Aws/S3/Metadata.hs +0/−19
• Aws/S3/Model.hs +0/−109
• Aws/S3/Query.hs +0/−105
• Aws/S3/Response.hs +0/−74
• Aws/Ses.hs +2/−12
• Aws/Ses/Commands/SendRawEmail.hs +4/−10
• Aws/Ses/Core.hs +182/−0
• Aws/Ses/Error.hs +0/−20
• Aws/Ses/Info.hs +0/−26
• Aws/Ses/Metadata.hs +0/−19
• Aws/Ses/Model.hs +0/−73
• Aws/Ses/Query.hs +0/−43
• Aws/Ses/Response.hs +0/−30
• Aws/Signature.hs +0/−71
• Aws/SimpleDb.hs +2/−12
• Aws/SimpleDb/Commands.hs +4/−18
• Aws/SimpleDb/Commands/Attributes.hs +179/−0
• Aws/SimpleDb/Commands/BatchDeleteAttributes.hs +0/−43
• Aws/SimpleDb/Commands/BatchPutAttributes.hs +0/−43
• Aws/SimpleDb/Commands/CreateDomain.hs +0/−36
• Aws/SimpleDb/Commands/DeleteAttributes.hs +0/−50
• Aws/SimpleDb/Commands/DeleteDomain.hs +0/−36
• Aws/SimpleDb/Commands/Domain.hs +140/−0
• Aws/SimpleDb/Commands/DomainMetadata.hs +0/−59
• Aws/SimpleDb/Commands/GetAttributes.hs +0/−56
• Aws/SimpleDb/Commands/ListDomains.hs +0/−53
• Aws/SimpleDb/Commands/PutAttributes.hs +0/−50
• Aws/SimpleDb/Commands/Select.hs +4/−11
• Aws/SimpleDb/Core.hs +228/−0
• Aws/SimpleDb/Error.hs +0/−19
• Aws/SimpleDb/Info.hs +0/−42
• Aws/SimpleDb/Metadata.hs +0/−19
• Aws/SimpleDb/Model.hs +0/−78
• Aws/SimpleDb/Query.hs +0/−58
• Aws/SimpleDb/Response.hs +0/−51
• Aws/Sqs.hs +2/−10
• Aws/Sqs/Commands.hs +11/−24
• Aws/Sqs/Commands/AddPermission.hs +0/−48
• Aws/Sqs/Commands/ChangeMessageVisibility.hs +0/−39
• Aws/Sqs/Commands/CreateQueue.hs +0/−49
• Aws/Sqs/Commands/DeleteMessage.hs +0/−38
• Aws/Sqs/Commands/DeleteQueue.hs +0/−33
• Aws/Sqs/Commands/GetQueueAttributes.hs +0/−56
• Aws/Sqs/Commands/ListQueues.hs +0/−45
• Aws/Sqs/Commands/Message.hs +165/−0
• Aws/Sqs/Commands/Permission.hs +68/−0
• Aws/Sqs/Commands/Queue.hs +94/−0
• Aws/Sqs/Commands/QueueAttributes.hs +78/−0
• Aws/Sqs/Commands/ReceiveMessage.hs +0/−92
• Aws/Sqs/Commands/RemovePermission.hs +0/−41
• Aws/Sqs/Commands/SendMessage.hs +0/−48
• Aws/Sqs/Commands/SetQueueAttributes.hs +0/−40
• Aws/Sqs/Core.hs +328/−0
• Aws/Sqs/Error.hs +0/−27
• Aws/Sqs/Info.hs +0/−85
• Aws/Sqs/Metadata.hs +0/−16
• Aws/Sqs/Model.hs +0/−96
• Aws/Sqs/Query.hs +0/−70
• Aws/Sqs/Response.hs +0/−62
• Aws/Transaction.hs +0/−10
• Aws/Util.hs +0/−59
• Aws/Xml.hs +0/−59
• Examples/GetObject.hs +7/−6
• README.org +13/−2
• aws.cabal +14/−55

@@ -1,23 +1,51 @@ module Aws-(-  module Aws.Aws-, module Aws.Credentials-, module Aws.Http-, module Aws.Query-, module Aws.Response-, module Aws.Signature-, module Aws.Transaction-, module Aws.Util-, module Aws.Xml+( -- * Logging+  LogLevel(..)+, Logger+, defaultLog+  -- * Configuration+, Configuration(..)+, baseConfiguration+, dbgConfiguration+  -- * Transaction runners+  -- ** Safe runners+, aws+, awsRef+, simpleAws+, simpleAwsRef+  -- ** Unsafe runners+, unsafeAws+, unsafeAwsRef+  -- ** URI runners+, awsUri+  -- * Response+  -- ** Full HTTP response+, HTTPResponseConsumer+  -- ** Metadata in responses+, Response(..)+, ResponseMetadata+  -- ** Exception types+, XmlException(..)+, HeaderException(..)+, FormException(..)+  -- * Query+  -- ** Service configuration+, ServiceConfiguration+, DefaultServiceConfiguration(..)+  -- ** Expiration+, TimeInfo(..)+  -- * Transactions+, Transaction+  -- * Credentials+, Credentials(..)+, credentialsDefaultFile+, credentialsDefaultKey+, loadCredentialsFromFile+, loadCredentialsFromEnv+, loadCredentialsFromEnvOrFile+, loadCredentialsDefault ) where  import Aws.Aws-import Aws.Credentials-import Aws.Http-import Aws.Query-import Aws.Response-import Aws.Signature-import Aws.Transaction-import Aws.Util-import Aws.Xml+import Aws.Core

@@ -1,19 +1,30 @@ {-# LANGUAGE FlexibleContexts, OverloadedStrings #-} module Aws.Aws+( -- * Logging+  LogLevel(..)+, Logger+, defaultLog+  -- * Configuration+, Configuration(..)+, baseConfiguration+, dbgConfiguration+  -- * Transaction runners+  -- ** Safe runners+, aws+, awsRef+, simpleAws+, simpleAwsRef+  -- ** Unsafe runners+, unsafeAws+, unsafeAwsRef+  -- ** URI runners+, awsUri+) where -import           Aws.Credentials-import           Aws.Http-import           Aws.Query-import           Aws.Response-import           Aws.S3.Info-import           Aws.Ses.Info-import           Aws.Signature-import           Aws.SimpleDb.Info-import           Aws.Sqs.Info-import           Aws.Transaction+import           Aws.Core import           Control.Applicative-import           Control.Monad.Trans  (liftIO)+import           Control.Monad.Trans  (MonadIO(liftIO)) import           Data.Attempt         (attemptIO) import           Data.Conduit         (runResourceT) import           Data.IORef@@ -25,6 +36,7 @@ import qualified Data.Text.IO         as T import qualified Network.HTTP.Conduit as HTTP +-- | The severity of a log message, in rising order. data LogLevel     = Debug     | Info@@ -32,133 +44,154 @@     | Error     deriving (Show, Eq, Ord) -data Configuration-    = Configuration {-       timeInfo :: TimeInfo-      , credentials :: Credentials-      , sdbInfo :: SdbInfo-      , sdbInfoUri :: SdbInfo-      , s3Info :: S3Info-      , s3InfoUri :: S3Info-      , sqsInfo :: SqsInfo-      , sqsInfoUri :: SqsInfo-      , sesInfo :: SesInfo-      , sesInfoUri :: SesInfo-      , logger :: LogLevel -> T.Text -> IO ()-      }+-- | The interface for any logging function. Takes log level and a log message, and can perform an arbitrary+-- IO action.+type Logger = LogLevel -> T.Text -> IO () -defaultLog :: LogLevel -> LogLevel -> T.Text -> IO ()+-- | The default logger @defaultLog minLevel@, which prints log messages above level @minLevel@ to @stderr@.+defaultLog :: LogLevel -> Logger defaultLog minLevel lev t | lev >= minLevel = T.hPutStrLn stderr $ T.concat [T.pack $ show lev, ": ", t]                           | otherwise       = return () -class ConfigurationFetch a where-    configurationFetch :: Configuration -> a-    configurationFetchUri :: Configuration -> a-    configurationFetchUri = configurationFetch--instance ConfigurationFetch () where-    configurationFetch _ = ()--instance ConfigurationFetch SdbInfo where-    configurationFetch = sdbInfo-    configurationFetchUri = sdbInfoUri--instance ConfigurationFetch S3Info where-    configurationFetch = s3Info-    configurationFetchUri = s3InfoUri--instance ConfigurationFetch SqsInfo where-    configurationFetch = sqsInfo-    configurationFetchUri = sqsInfoUri--instance ConfigurationFetch SesInfo where-    configurationFetch = sesInfo-    configurationFetchUri = sesInfoUri+-- | The configuration for an AWS request. You can use multiple configurations in parallel, even over the same HTTP+-- connection manager.+data Configuration+    = Configuration {+        -- | Whether to restrict the signature validity with a plain timestamp, or with explicit expiration+        -- (absolute or relative).+        timeInfo :: TimeInfo+        -- | AWS access credentials.+      , credentials :: Credentials+        -- | The error / message logger.+      , logger :: Logger+      } -baseConfiguration :: IO Configuration+-- | The default configuration, with credentials loaded from environment variable or configuration file+-- (see 'loadCredentialsDefault').+baseConfiguration :: MonadIO io => io Configuration baseConfiguration = do   Just cr <- loadCredentialsDefault   return Configuration {                       timeInfo = Timestamp                     , credentials = cr-                    , sdbInfo = sdbHttpsPost sdbUsEast-                    , sdbInfoUri = sdbHttpsGet sdbUsEast-                    , s3Info = s3 HTTP s3EndpointUsClassic False-                    , s3InfoUri = s3 HTTP s3EndpointUsClassic True-                    , sqsInfo = sqs HTTP sqsEndpointUsClassic False-                    , sqsInfoUri = sqs HTTP sqsEndpointUsClassic True-                    , sesInfo = sesHttpsPost sesUsEast-                    , sesInfoUri = sesHttpsGet sesUsEast                     , logger = defaultLog Warning                     } -- TODO: better error handling when credentials cannot be loaded -debugConfiguration :: IO Configuration-debugConfiguration = do+-- | Debug configuration, which avoids using HTTPS for some queries. DO NOT USE THIS IN PRODUCTION!+dbgConfiguration :: MonadIO io => io Configuration+dbgConfiguration = do   c <- baseConfiguration-  return c {-      sdbInfo = sdbHttpPost sdbUsEast-    , sdbInfoUri = sdbHttpGet sdbUsEast-    , logger = defaultLog Debug-    }+  return c { logger = defaultLog Debug } -aws :: (Transaction r a-       , ConfigurationFetch (Info r))-      => Configuration -> HTTP.Manager -> r -> IO (Response (ResponseMetadata a) a)+-- | Run an AWS transaction, with HTTP manager and metadata wrapped in a 'Response'.+-- +-- All errors are caught and wrapped in the 'Response' value.+-- +-- 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 = unsafeAws -awsRef :: (Transaction r a-       , ConfigurationFetch (Info r))-      => Configuration -> HTTP.Manager -> IORef (ResponseMetadata a) -> r -> IO a+-- | 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.+-- +-- Usage (with existing 'HTTP.Manager'):+-- @+--     ref <- newIORef mempty;+--     resp <- awsRef cfg serviceCfg manager request+-- @++-- 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 = unsafeAwsRef -simpleAws :: (Transaction r a-             , ConfigurationFetch (Info r))-            => Configuration -> r -> IO (Response (ResponseMetadata a) a)-simpleAws cfg request = HTTP.withManager $ \manager -> liftIO $ aws cfg manager request+-- | 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.+-- +-- All errors are caught and wrapped in the 'Response' value.+-- +-- Usage:+-- @+--     resp <- simpleAws cfg serviceCfg 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 -simpleAwsRef :: (Transaction r a-             , ConfigurationFetch (Info r))-            => Configuration -> IORef (ResponseMetadata a) -> r -> IO a-simpleAwsRef cfg metadataRef request = HTTP.withManager $ \manager -> liftIO $ awsRef cfg manager metadataRef request+-- | Run an AWS transaction, /without/ HTTP manager and with metadata returned in an 'IORef'.+-- +-- Errors are not caught, and need to be handled with exception handlers.+-- +-- Usage:+-- @+--     ref <- newIORef mempty;+--     resp <- simpleAwsRef 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++-- | 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. unsafeAws   :: (ResponseConsumer r a,       Monoid (ResponseMetadata a),       SignQuery r,-      ConfigurationFetch (Info r)) =>-     Configuration -> HTTP.Manager -> r -> IO (Response (ResponseMetadata a) a)-unsafeAws cfg manager request = do+      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) $-            unsafeAwsRef cfg manager metadataRef request+            unsafeAwsRef cfg scfg manager metadataRef request   metadata <- readIORef metadataRef   return $ Response metadata resp +-- | 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.+-- +-- Errors are not caught, and need to be handled with exception handlers. unsafeAwsRef   :: (ResponseConsumer r a,       Monoid (ResponseMetadata a),       SignQuery r,-      ConfigurationFetch (Info r)) =>-     Configuration -> HTTP.Manager -> IORef (ResponseMetadata a) -> r -> IO a-unsafeAwsRef cfg manager metadataRef request = do+      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-  let info = configurationFetch cfg   let q = signQuery request info sd   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   return resp -awsUri :: (SignQuery request-          , ConfigurationFetch (Info request))-         => Configuration -> request -> IO B.ByteString-awsUri cfg request = do+-- | Run a URI-only AWS transaction. Returns a URI that can be sent anywhere. Does not work with all requests.+-- +-- Usage:+-- @+--     uri <- awsUri cfg request+-- @+awsUri :: (SignQuery request, MonadIO io)+         => Configuration -> ServiceConfiguration request -> request -> io B.ByteString+awsUri cfg info request = liftIO $ do   let ti = timeInfo cfg       cr = credentials cfg-      info = configurationFetchUri cfg   sd <- signatureData ti cr   let q = signQuery request info sd   logger cfg Debug $ T.pack $ "String to sign: " ++ show (sqStringToSign q)

@@ -0,0 +1,568 @@+{-# LANGUAGE MultiParamTypeClasses, FunctionalDependencies, TypeFamilies, FlexibleContexts, FlexibleInstances, DeriveFunctor, OverloadedStrings, RecordWildCards, DeriveDataTypeable #-}+module Aws.Core+( -- * Response+  -- ** Metadata in responses+  Response(..)+, tellMetadata+, tellMetadataRef+  -- ** Response data consumers+, HTTPResponseConsumer+, ResponseConsumer(..)+  -- ** Exception types+, XmlException(..)+, HeaderException(..)+, FormException(..)+  -- ** Response deconstruction helpers+, readHex2+  -- *** XML+, elContent+, elCont+, force+, forceM+, textReadInt+, readInt+, xmlCursorConsumer+  -- * Query+, SignedQuery(..)+, queryToHttpRequest+, queryToUri+  -- ** Expiration+, TimeInfo(..)+, AbsoluteTimeInfo(..)+, fromAbsoluteTimeInfo+, makeAbsoluteTimeInfo+ -- ** Signature+, SignatureData(..)+, signatureData+, SignQuery(..)+, AuthorizationHash(..)+, amzHash+, signature+  -- ** Query construction helpers+, queryList+, awsBool+, awsTrue+, awsFalse+, fmtTime+, fmtRfc822Time+, rfc822Time+, fmtAmzTime+, fmtTimeEpochSeconds+  -- * Transactions+, Transaction+  -- * Credentials+, Credentials(..)+, credentialsDefaultFile+, credentialsDefaultKey+, loadCredentialsFromFile+, loadCredentialsFromEnv+, loadCredentialsFromEnvOrFile+, loadCredentialsDefault+  -- * Service configuration+, DefaultServiceConfiguration(..)+  -- * HTTP types+, Protocol(..)+, defaultPort+, Method(..)+, httpMethod+)+where++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                (Source, 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 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++-- | 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)+    deriving (Show, Functor)++-- | An empty response with some metadata.+tellMetadata :: m -> Response m ()+tellMetadata m = Response m (return ())++instance Monoid m => Monad (Response m) where+    return x = Response mempty (Success x)+    Response m1 (Failure e) >>= _ = Response m1 (Failure e)+    Response m1 (Success x) >>= f = let Response m2 y = f x+                                    in Response (m1 `mappend` m2) y -- currently using First-semantics, Last SHOULD work too++instance (Monoid m, E.Exception e) => F.Failure e (Response m) where+    failure e = Response mempty (F.failure e)++-- | Add metadata to an 'IORef' (using 'mappend').+tellMetadataRef :: Monoid m => IORef m -> m -> IO ()+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+                            -> Source (ResourceT IO) ByteString+                            -> ResourceT IO a++-- | Class for types that AWS HTTP responses can be parsed into.+-- +-- The request is also passed for possibly required additional metadata.+-- +-- Note that for debugging, there is an instance for 'L.ByteString'.+class Monoid (ResponseMetadata resp) => ResponseConsumer req resp where+    -- | Metadata associated with a response. Typically there is one metadata type for each AWS service.+    type ResponseMetadata resp++    -- | Response parser. Takes the corresponding request, an 'IORef' for metadata, and HTTP response data.+    responseConsumer :: req -> IORef (ResponseMetadata resp) -> HTTPResponseConsumer resp++-- | 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)++-- | 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)+      => Transaction r a+      | r -> a, a -> r++-- | AWS access credentials.+data Credentials+    = Credentials {+        -- | AWS Access Key ID.+        accessKeyID :: B.ByteString+        -- | AWS Secret Access Key.+      , secretAccessKey :: B.ByteString+      }+    deriving (Show)++-- | The file where access credentials are loaded, when using 'loadCredentialsDefault'.+-- +-- Value: /<user directory>/@/.aws-keys@+credentialsDefaultFile :: MonadIO io => io FilePath+credentialsDefaultFile = liftIO $ (</> ".aws-keys") <$> getHomeDirectory++-- | The key to be used in the access credential file that is loaded, when using 'loadCredentialsDefault'.+-- +-- Value: @default@+credentialsDefaultKey :: T.Text+credentialsDefaultKey = "default"++-- | Load credentials from a (text) file given a key name.+-- +-- The file consists of a sequence of lines, each in the following format:+-- +-- @keyName awsKeyID awsKeySecret@+loadCredentialsFromFile :: MonadIO io => FilePath -> T.Text -> io (Maybe Credentials)+loadCredentialsFromFile file key = liftIO $ do+  contents <- map T.words . T.lines <$> T.readFile file+  return $ do +    [_key, keyID, secret] <- find (hasKey key) contents+    return Credentials { accessKeyID = T.encodeUtf8 keyID, secretAccessKey = T.encodeUtf8 secret }+      where+        hasKey _ [] = False+        hasKey k (k2 : _) = k == k2++-- | Load credentials from the environment variables @AWS_ACCESS_KEY_ID@ and @AWS_ACCESS_KEY_SECRET@ +--   (or @AWS_SECRET_ACCESS_KEY@), if possible.+loadCredentialsFromEnv :: MonadIO io => io (Maybe Credentials)+loadCredentialsFromEnv = liftIO $ do+  env <- getEnvironment+  let lk = flip lookup env+      keyID = lk "AWS_ACCESS_KEY_ID"+      secret = lk "AWS_ACCESS_KEY_SECRET" `mplus` lk "AWS_SECRET_ACCESS_KEY"+  return (Credentials <$> (T.encodeUtf8 . T.pack <$> keyID) <*> (T.encodeUtf8 . T.pack <$> secret))++-- | Load credentials from environment variables if possible, or alternatively from a file with a given key name.+-- +-- See 'loadCredentialsFromEnv' and 'loadCredentialsFromFile' for details.+loadCredentialsFromEnvOrFile :: MonadIO io => FilePath -> T.Text -> io (Maybe Credentials)+loadCredentialsFromEnvOrFile file key = +  do+    envcr <- loadCredentialsFromEnv+    case envcr of+      Just cr -> return (Just cr)+      Nothing -> loadCredentialsFromFile file key++-- | Load credentials from environment variables if possible, or alternative from the default file with the default+-- key name.+-- +-- Default file: /<user directory>/@/.aws-keys@+-- Default key name: @default@+-- +-- See 'loadCredentialsFromEnv' and 'loadCredentialsFromFile' for details.+loadCredentialsDefault :: MonadIO io => io (Maybe Credentials)+loadCredentialsDefault = do+  file <- credentialsDefaultFile+  loadCredentialsFromEnvOrFile file credentialsDefaultKey++-- | Protocols supported by AWS. Currently, all AWS services use the HTTP or HTTPS protocols.+data Protocol+    = HTTP+    | HTTPS+    deriving (Show)++-- | The default port to be used for a protocol if no specific port is specified.+defaultPort :: Protocol -> Int+defaultPort HTTP = 80+defaultPort HTTPS = 443++-- | Request method. Not all request methods are supported by all services.+data Method+    = Get       -- ^ GET method. Put all request parameters in a query string and HTTP headers.+    | PostQuery -- ^ POST method. Put all request parameters in a query string and HTTP headers, but send the query string+                --   as a POST payload+    | Post      -- ^ POST method. Sends a service- and request-specific request body.+    | Put       -- ^ PUT method.+    | Delete    -- ^ DELETE method.+    deriving (Show, Eq)++-- | HTTP method associated with a request method.+httpMethod :: Method -> HTTP.Method+httpMethod Get       = "GET"+httpMethod PostQuery = "POST"+httpMethod Post      = "POST"+httpMethod Put       = "PUT"+httpMethod Delete    = "DELETE"++-- | A pre-signed medium-level request object.+data SignedQuery+    = SignedQuery {+        -- | Request method.+        sqMethod :: Method+        -- | Protocol to be used.+      , sqProtocol :: Protocol+        -- | HTTP host.+      , sqHost :: B.ByteString+        -- | IP port.+      , sqPort :: Int+        -- | HTTP path.+      , sqPath :: B.ByteString+        -- | Query string list (used with 'Get' and 'PostQuery').+      , sqQuery :: HTTP.Query+        -- | Request date/time.+      , sqDate :: Maybe UTCTime+        -- | Authorization string (if applicable), for @Authorization@ header..+      , sqAuthorization :: Maybe B.ByteString+        -- | Request body content type.+      , sqContentType :: Maybe B.ByteString+        -- | Request body content MD5.+      , sqContentMd5 :: Maybe B.ByteString+        -- | Additional Amazon "amz" headers.+      , sqAmzHeaders :: HTTP.RequestHeaders+        -- | Additional non-"amz" headers.+      , sqOtherHeaders :: HTTP.RequestHeaders+        -- | Request body (used with 'Post' and 'Put').+      , sqBody :: Maybe (HTTP.RequestBody (C.ResourceT IO))+        -- | String to sign. Note that the string is already signed, this is passed mostly for debugging purposes.+      , sqStringToSign :: B.ByteString+      }+    --deriving (Show)++-- | Create a HTTP request from a 'SignedQuery' object.+queryToHttpRequest :: SignedQuery -> HTTP.Request (C.ResourceT IO)+queryToHttpRequest SignedQuery{..}+    = HTTP.def {+        HTTP.method = httpMethod sqMethod+      , HTTP.secure = case sqProtocol of+                        HTTP -> False+                        HTTPS -> True+      , HTTP.host = sqHost+      , HTTP.port = sqPort+      , HTTP.path = sqPath+      , 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 (\auth -> ("Authorization", auth)) sqAuthorization]+                              ++ sqAmzHeaders+                              ++ sqOtherHeaders+      , HTTP.requestBody = case sqMethod of+                             PostQuery -> HTTP.RequestBodyLBS . Blaze.toLazyByteString $ HTTP.renderQueryBuilder False sqQuery+                             _         -> case sqBody of+                                            Nothing -> HTTP.RequestBodyBuilder 0 mempty+                                            Just x  -> x+      , HTTP.decompress = HTTP.alwaysDecompress+      , HTTP.checkStatus = \_ _ -> Nothing+      }+    where contentType = case sqMethod of+                           PostQuery -> Just "application/x-www-form-urlencoded; charset=utf-8"+                           _ -> sqContentType++-- | Create a URI fro a 'SignedQuery' object. +-- +-- Unused / incompatible fields will be silently ignored.+queryToUri :: SignedQuery -> B.ByteString+queryToUri SignedQuery{..}+    = B.concat [+       case sqProtocol of+         HTTP -> "http://"+         HTTPS -> "https://"+      , sqHost+      , if sqPort == defaultPort sqProtocol then "" else T.encodeUtf8 . T.pack $ ':' : show sqPort+      , sqPath+      , HTTP.renderQuery True sqQuery+      ]++-- | Whether to restrict the signature validity with a plain timestamp, or with explicit expiration+-- (absolute or relative).+data TimeInfo+    = Timestamp                                      -- ^ Use a simple timestamp to let AWS check the request validity.+    | ExpiresAt { fromExpiresAt :: UTCTime }         -- ^ Let requests expire at a specific fixed time.+    | ExpiresIn { fromExpiresIn :: NominalDiffTime } -- ^ Let requests expire a specific number of seconds after they+                                                     -- were generated.+    deriving (Show)++-- | Like 'TimeInfo', but with all relative times replaced by absolute UTC.+data AbsoluteTimeInfo+    = AbsoluteTimestamp { fromAbsoluteTimestamp :: UTCTime }+    | AbsoluteExpires { fromAbsoluteExpires :: UTCTime }+    deriving (Show)++-- | Just the UTC time value.+fromAbsoluteTimeInfo :: AbsoluteTimeInfo -> UTCTime+fromAbsoluteTimeInfo (AbsoluteTimestamp time) = time+fromAbsoluteTimeInfo (AbsoluteExpires time) = time++-- | Convert 'TimeInfo' to 'AbsoluteTimeInfo' given the current UTC time.+makeAbsoluteTimeInfo :: TimeInfo -> UTCTime -> AbsoluteTimeInfo+makeAbsoluteTimeInfo Timestamp     now = AbsoluteTimestamp now+makeAbsoluteTimeInfo (ExpiresAt t) _   = AbsoluteExpires t+makeAbsoluteTimeInfo (ExpiresIn s) now = AbsoluteExpires $ addUTCTime s now++-- | Data that is always required for signing requests.+data SignatureData+    = SignatureData {+        -- | Expiration or timestamp.+        signatureTimeInfo :: AbsoluteTimeInfo+        -- | Current time.+      , signatureTime :: UTCTime+        -- | Access credentials.+      , signatureCredentials :: Credentials+      }++-- | Create signature data using the current system time.+signatureData :: TimeInfo -> Credentials -> IO SignatureData+signatureData rti cr = do+  now <- getCurrentTime+  let ti = makeAbsoluteTimeInfo rti now+  return SignatureData { signatureTimeInfo = ti, signatureTime = now, signatureCredentials = cr }++-- | A "signable" request object. Assembles together the Query, and signs it in one go.+class SignQuery r where+    -- | Additional information, like API endpoints and service-specific preferences.+    type ServiceConfiguration r :: *+    +    -- | Create a 'SignedQuery' from a request, additional 'Info', and 'SignatureData'.+    signQuery :: r -> ServiceConfiguration r -> SignatureData -> SignedQuery++-- | Supported crypto hashes for the signature.+data AuthorizationHash+    = HmacSHA1+    | HmacSHA256+    deriving (Show)++-- | Authorization hash identifier as expected by Amazon.+amzHash :: AuthorizationHash -> B.ByteString+amzHash HmacSHA1 = "HmacSHA1"+amzHash HmacSHA256 = "HmacSHA256"++-- | Create a signature. Usually, AWS wants a specifically constructed string to be signed.+-- +-- The signature is a HMAC-based hash of the string and the secret access key.+signature :: Credentials -> AuthorizationHash -> B.ByteString -> B.ByteString+signature cr ah input = Base64.encode sig+    where+      sig = case ah of+              HmacSHA1 -> computeSig (undefined :: SHA1.SHA1)+              HmacSHA256 -> computeSig (undefined :: SHA256.SHA256)+      computeSig :: Crypto.Hash c d => d -> B.ByteString+      computeSig t = Serialize.encode (HMAC.hmac' key input `asTypeOf` t)+      key :: HMAC.MacKey c d+      key = HMAC.MacKey (secretAccessKey cr)++-- | 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 debugging-only configuration for URI-only requests. (Normally using HTTP instead of HTTPS for easier debugging.)+    debugConfigurationUri :: config+    debugConfigurationUri = defaultConfigurationUri++-- | @queryList f prefix xs@ constructs a query list from a list of elements @xs@, using a common prefix @prefix@,+-- and a transformer function @f@.+-- +-- A dot (@.@) is interspersed between prefix and generated key.+-- +-- Example:+-- +-- @queryList swap \"pfx\" [(\"a\", \"b\"), (\"c\", \"d\")]@ evaluates to @[(\"pfx.b\", \"a\"), (\"pfx.d\", \"c\")]@+-- (except with ByteString instead of String, of course).+queryList :: (a -> [(B.ByteString, B.ByteString)]) -> B.ByteString -> [a] -> [(B.ByteString, B.ByteString)]+queryList f prefix xs = concat $ zipWith combine prefixList (map f xs)+    where prefixList = map (dot prefix . BU.fromString . show) [(1 :: Int) ..]+          combine pf = map $ first (pf `dot`)+          dot x y = B.concat [x, BU.fromString ".", y]++-- | A \"true\"/\"false\" boolean as requested by some services.+awsBool :: Bool -> B.ByteString+awsBool True = "true"+awsBool False = "false"++-- | \"true\"+awsTrue :: B.ByteString+awsTrue = awsBool True++-- | \"false\"+awsFalse :: B.ByteString+awsFalse = awsBool False++-- | Format time according to a format string, as a ByteString.+fmtTime :: String -> UTCTime -> B.ByteString+fmtTime s t = BU.fromString $ formatTime defaultTimeLocale s t++rfc822Time :: String+rfc822Time = "%a, %_d %b %Y %H:%M:%S GMT"++-- | Format time in RFC 822 format.+fmtRfc822Time :: UTCTime -> B.ByteString+fmtRfc822Time = fmtTime rfc822Time++-- | Format time in yyyy-mm-ddThh-mm-ss format.+fmtAmzTime :: UTCTime -> B.ByteString+fmtAmzTime = fmtTime "%Y-%m-%dT%H:%M:%S"++-- | Format time as seconds since the Unix epoch.+fmtTimeEpochSeconds :: UTCTime -> B.ByteString+fmtTimeEpochSeconds = fmtTime "%s"++-- | Parse a two-digit hex number.+readHex2 :: [Char] -> Maybe Word8+readHex2 [c1,c2] = do n1 <- readHex1 c1+                      n2 <- readHex1 c2+                      return . fromIntegral $ n1 * 16 + n2+    where+      readHex1 c | c >= '0' && c <= '9' = Just $ ord c - ord '0'+                 | c >= 'A' && c <= 'F' = Just $ ord c - ord 'A' + 10+                 | c >= 'a' && c <= 'f' = Just $ ord c - ord 'a' + 10+      readHex1 _                        = Nothing+readHex2 _ = Nothing++-- XML++-- | An error that occurred during XML parsing / validation.+newtype XmlException = XmlException { xmlErrorMessage :: String }+    deriving (Show, Typeable)++instance E.Exception XmlException++-- | An error that occurred during header parsing / validation.+newtype HeaderException = HeaderException { headerErrorMessage :: String }+    deriving (Show, Typeable)++instance E.Exception HeaderException++-- | An error that occurred during form parsing / validation.+newtype FormException  = FormException { formErrorMesage :: String }+    deriving (Show, Typeable)++instance E.Exception FormException+++-- | A specific element (case-insensitive, ignoring namespace - sadly necessary), extracting only the textual contents.+elContent :: T.Text -> Cursor -> [T.Text]+elContent name = laxElement name &/ content++-- | Like 'elContent', but extracts 'String's instead of 'T.Text'.+elCont :: T.Text -> Cursor -> [String]+elCont name = laxElement name &/ content &| T.unpack++-- | Extract the first element from a parser result list, and throw an 'XmlException' if the list is empty.+force :: F.Failure XmlException m => String -> [a] -> m a+force = Cu.force . XmlException++-- | Extract the first element from a monadic parser result list, and throw an 'XmlException' if the list is empty.+forceM :: F.Failure XmlException m => String -> [m a] -> m a+forceM = Cu.forceM . XmlException++-- | Read an integer from a 'T.Text', throwing an 'XmlException' on failure.+textReadInt :: (F.Failure XmlException m, Num a) => T.Text -> m a+textReadInt s = case reads $ T.unpack s of+                  [(n,"")] -> return $ fromInteger n+                  _        -> F.failure $ XmlException "Invalid Integer"++-- | Read an integer from a 'String', throwing an 'XmlException' on failure.+readInt :: (F.Failure XmlException m, Num a) => String -> m a+readInt s = case reads s of+              [(n,"")] -> return $ fromInteger n+              _        -> F.failure $ XmlException "Invalid Integer"++-- | Create a complete 'HTTPResponseConsumer' from a simple function that takes a 'Cu.Cursor' to XML in the response+-- body.+-- +-- This function is highly recommended for any services that parse relatively short XML responses. (If status and response+-- headers are required, simply take them as function parameters, and pass them through to this function.)+xmlCursorConsumer ::+    (Monoid m)+    => (Cu.Cursor -> Response m a)+    -> IORef m+    -> HTTPResponseConsumer a+xmlCursorConsumer parse metadataRef _status _headers source+    = do doc <- source $$ XML.sinkDoc XML.def+         let cursor = Cu.fromDocument doc+         let Response metadata x = parse cursor+         liftIO $ tellMetadataRef metadataRef metadata+         case x of+           Failure err -> liftIO $ C.monadThrow err+           Success v   -> return v

@@ -1,58 +0,0 @@-{-# LANGUAGE OverloadedStrings #-}-module Aws.Credentials-where-  -import           Control.Applicative-import           Control.Monad-import           Data.List-import           System.Directory-import           System.Environment-import           System.FilePath-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--data Credentials-    = Credentials {-        accessKeyID :: B.ByteString-      , secretAccessKey :: B.ByteString-      }-    deriving (Show)-             -credentialsDefaultFile :: IO FilePath-credentialsDefaultFile = (</> ".aws-keys") <$> getHomeDirectory--credentialsDefaultKey :: T.Text-credentialsDefaultKey = "default"--loadCredentialsFromFile :: FilePath -> T.Text -> IO (Maybe Credentials)-loadCredentialsFromFile file key = do-  contents <- map T.words . T.lines <$> T.readFile file-  return $ do -    [_key, keyID, secret] <- find (hasKey key) contents-    return Credentials { accessKeyID = T.encodeUtf8 keyID, secretAccessKey = T.encodeUtf8 secret }-      where-        hasKey _ [] = False-        hasKey k (k2 : _) = k == k2--loadCredentialsFromEnv :: IO (Maybe Credentials)-loadCredentialsFromEnv = do-  env <- getEnvironment-  let lk = flip lookup env-      keyID = lk "AWS_ACCESS_KEY_ID"-      secret = lk "AWS_ACCESS_KEY_SECRET" `mplus` lk "AWS_SECRET_ACCESS_KEY"-  return (Credentials <$> (T.encodeUtf8 . T.pack <$> keyID) <*> (T.encodeUtf8 . T.pack <$> secret))-  -loadCredentialsFromEnvOrFile :: FilePath -> T.Text -> IO (Maybe Credentials)-loadCredentialsFromEnvOrFile file key = -  do-    envcr <- loadCredentialsFromEnv-    case envcr of-      Just cr -> return (Just cr)-      Nothing -> loadCredentialsFromFile file key--loadCredentialsDefault :: IO (Maybe Credentials)-loadCredentialsDefault = do-  file <- credentialsDefaultFile-  loadCredentialsFromEnvOrFile file credentialsDefaultKey

@@ -1,30 +0,0 @@-{-# LANGUAGE OverloadedStrings #-}--module Aws.Http-where-  -import qualified Network.HTTP.Types    as HTTP--data Protocol-    = HTTP-    | HTTPS-    deriving (Show)--defaultPort :: Protocol -> Int-defaultPort HTTP = 80-defaultPort HTTPS = 443--data Method-    = Get-    | PostQuery-    | Post-    | Put-    | Delete-    deriving (Show, Eq)--httpMethod :: Method -> HTTP.Method-httpMethod Get       = "GET"-httpMethod PostQuery = "POST"-httpMethod Post      = "POST"-httpMethod Put       = "PUT"-httpMethod Delete    = "DELETE"

@@ -1,76 +0,0 @@-{-# LANGUAGE RecordWildCards, OverloadedStrings #-}-module Aws.Query-where--import           Aws.Http-import           Aws.Util-import           Data.Maybe-import           Data.Monoid-import           Data.Time-import qualified Blaze.ByteString.Builder as Blaze-import qualified Data.ByteString          as B-import qualified Data.Text                as T-import qualified Data.Text.Encoding       as T-import qualified Data.Conduit as C-import qualified Network.HTTP.Conduit     as HTTP-import qualified Network.HTTP.Types       as HTTP--data SignedQuery-    = SignedQuery {-        sqMethod :: Method-      , sqProtocol :: Protocol-      , sqHost :: B.ByteString-      , sqPort :: Int-      , sqPath :: B.ByteString-      , sqQuery :: HTTP.Query-      , sqDate :: Maybe UTCTime-      , sqAuthorization :: Maybe B.ByteString-      , sqContentType :: Maybe B.ByteString-      , sqContentMd5 :: Maybe B.ByteString-      , sqAmzHeaders :: HTTP.RequestHeaders-      , sqOtherHeaders :: HTTP.RequestHeaders-      , sqBody :: Maybe (HTTP.RequestBody (C.ResourceT IO))-      , sqStringToSign :: B.ByteString-      }-    --deriving (Show)--queryToHttpRequest :: SignedQuery -> HTTP.Request (C.ResourceT IO)-queryToHttpRequest SignedQuery{..}-    = HTTP.def {-        HTTP.method = httpMethod sqMethod-      , HTTP.secure = case sqProtocol of-                        HTTP -> False-                        HTTPS -> True-      , HTTP.host = sqHost-      , HTTP.port = sqPort-      , HTTP.path = sqPath-      , 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 (\auth -> ("Authorization", auth)) sqAuthorization]-                              ++ sqAmzHeaders-                              ++ sqOtherHeaders-      , HTTP.requestBody = case sqMethod of-                             PostQuery -> HTTP.RequestBodyLBS . Blaze.toLazyByteString $ HTTP.renderQueryBuilder False sqQuery-                             _         -> case sqBody of-                                            Nothing -> HTTP.RequestBodyBuilder 0 mempty-                                            Just x  -> x-      , HTTP.decompress = HTTP.alwaysDecompress-      , HTTP.checkStatus = \_ _ -> Nothing-      }-    where contentType = case sqMethod of-                           PostQuery -> Just "application/x-www-form-urlencoded; charset=utf-8"-                           _ -> sqContentType--queryToUri :: SignedQuery -> B.ByteString-queryToUri SignedQuery{..}-    = B.concat [-       case sqProtocol of-         HTTP -> "http://"-         HTTPS -> "https://"-      , sqHost-      , if sqPort == defaultPort sqProtocol then "" else T.encodeUtf8 . T.pack $ ':' : show sqPort-      , sqPath-      , HTTP.renderQuery True sqQuery-      ]

@@ -1,49 +0,0 @@-{-# LANGUAGE MultiParamTypeClasses, FlexibleInstances, DeriveDataTypeable, DeriveFunctor, TypeFamilies #-}--module Aws.Response-where--import           Data.ByteString         (ByteString)-import           Data.Conduit            (Source, ResourceT, ($$))-import           Data.IORef-import           Data.Monoid-import           Data.Attempt            (Attempt(..))-import qualified Control.Exception       as E-import qualified Control.Failure         as F-import qualified Data.ByteString.Lazy    as L-import qualified Data.Conduit.List       as CL-import qualified Network.HTTP.Conduit    as HTTP-import qualified Network.HTTP.Types      as HTTP--data Response m a = Response m (Attempt a)-    deriving (Show, Functor)--tellMetadata :: m -> Response m ()-tellMetadata m = Response m (return ())--instance Monoid m => Monad (Response m) where-    return x = Response mempty (Success x)-    Response m1 (Failure e) >>= _ = Response m1 (Failure e)-    Response m1 (Success x) >>= f = let Response m2 y = f x-                                    in Response (m1 `mappend` m2) y -- currently using First-semantics, Last SHOULD work too--instance (Monoid m, E.Exception e) => F.Failure e (Response m) where-    failure e = Response mempty (F.failure e)--tellMetadataRef :: Monoid m => IORef m -> m -> IO ()-tellMetadataRef r m = modifyIORef r (`mappend` m)--type HTTPResponseConsumer a =  HTTP.Status-                            -> HTTP.ResponseHeaders-                            -> Source (ResourceT IO) ByteString-                            -> ResourceT IO a--class ResponseConsumer r a where-    type ResponseMetadata a-    responseConsumer :: r -> IORef (ResponseMetadata a) -> HTTPResponseConsumer a--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)

@@ -1,19 +1,9 @@ module Aws.S3 (   module Aws.S3.Commands-, module Aws.S3.Error-, module Aws.S3.Info-, module Aws.S3.Metadata-, module Aws.S3.Model-, module Aws.S3.Query-, module Aws.S3.Response+, module Aws.S3.Core ) where  import Aws.S3.Commands-import Aws.S3.Error-import Aws.S3.Info-import Aws.S3.Metadata-import Aws.S3.Model-import Aws.S3.Query-import Aws.S3.Response+import Aws.S3.Core

@@ -2,15 +2,8 @@ module Aws.S3.Commands.DeleteObject where -import           Aws.Http-import           Aws.Response-import           Aws.S3.Info-import           Aws.S3.Metadata-import           Aws.S3.Model-import           Aws.S3.Query-import           Aws.S3.Response-import           Aws.Signature-import           Aws.Transaction+import           Aws.Core+import           Aws.S3.Core import           Data.ByteString.Char8      ({- IsString -}) import qualified Data.Text                  as T import qualified Data.Text.Encoding         as T@@ -23,8 +16,9 @@ data DeleteObjectResponse = DeleteObjectResponse{ } +-- | ServiceConfiguration: 'S3Configuration' instance SignQuery DeleteObject where-    type Info DeleteObject = S3Info+    type ServiceConfiguration DeleteObject = S3Configuration     signQuery DeleteObject {..} = s3SignQuery S3Query {                                  s3QMethod = Delete                                , s3QBucket = Just $ T.encodeUtf8 doBucket

@@ -2,16 +2,8 @@ module Aws.S3.Commands.GetBucket where -import           Aws.Http-import           Aws.Response-import           Aws.S3.Info-import           Aws.S3.Metadata-import           Aws.S3.Model-import           Aws.S3.Query-import           Aws.S3.Response-import           Aws.Signature-import           Aws.Transaction-import           Aws.Xml+import           Aws.Core+import           Aws.S3.Core import           Control.Applicative import           Control.Arrow              (second) import           Data.ByteString.Char8      ({- IsString -})@@ -55,8 +47,9 @@       }     deriving (Show) +-- | ServiceConfiguration: 'S3Configuration' instance SignQuery GetBucket where-    type Info GetBucket = S3Info+    type ServiceConfiguration GetBucket = S3Configuration     signQuery GetBucket {..} = s3SignQuery S3Query {                                  s3QMethod = Get                                , s3QBucket = Just $ T.encodeUtf8 gbBucket

@@ -2,15 +2,8 @@ module Aws.S3.Commands.GetObject where -import           Aws.Http-import           Aws.Response-import           Aws.S3.Info-import           Aws.S3.Metadata-import           Aws.S3.Model-import           Aws.S3.Query-import           Aws.S3.Response-import           Aws.Signature-import           Aws.Transaction+import           Aws.Core+import           Aws.S3.Core import           Control.Applicative import           Control.Arrow         (second) import           Data.ByteString.Char8 ({- IsString -})@@ -36,11 +29,12 @@ getObject b o i = GetObject b o i Nothing Nothing Nothing Nothing Nothing Nothing  data GetObjectResponse a-    = GetObjectResponse a+    = GetObjectResponse ObjectMetadata a     deriving (Show) +-- | ServiceConfiguration: 'S3Configuration' instance SignQuery (GetObject a) where-    type Info (GetObject a) = S3Info+    type ServiceConfiguration (GetObject a) = S3Configuration     signQuery GetObject {..} = s3SignQuery S3Query {                                    s3QMethod = Get                                  , s3QBucket = Just $ T.encodeUtf8 goBucket@@ -64,6 +58,8 @@ instance ResponseConsumer (GetObject a) (GetObjectResponse a) where     type ResponseMetadata (GetObjectResponse a) = S3Metadata     responseConsumer GetObject{..} metadata status headers source-        = GetObjectResponse <$> s3BinaryResponseConsumer goResponseConsumer metadata status headers source+        = GetObjectResponse +          <$> parseObjectMetadata headers +          <*> s3BinaryResponseConsumer goResponseConsumer metadata status headers source  instance Transaction (GetObject a) (GetObjectResponse a)

@@ -2,16 +2,8 @@ module Aws.S3.Commands.GetService where -import           Aws.Http-import           Aws.Response-import           Aws.S3.Info-import           Aws.S3.Metadata-import           Aws.S3.Model-import           Aws.S3.Query-import           Aws.S3.Response-import           Aws.Signature-import           Aws.Transaction-import           Aws.Xml+import           Aws.Core+import           Aws.S3.Core import           Data.Maybe import           Data.Time.Format import           System.Locale@@ -44,8 +36,9 @@             creationDate <- force "Invalid CreationDate" . maybeToList $ parseTime defaultTimeLocale "%Y-%m-%dT%H:%M:%S%QZ" creationDateString             return BucketInfo { bucketName = name, bucketCreationDate = creationDate } +-- | ServiceConfiguration: 'S3Configuration' instance SignQuery GetService where-    type Info GetService = S3Info+    type ServiceConfiguration GetService = S3Configuration     signQuery GetService = s3SignQuery S3Query {                                 s3QMethod = Get                               , s3QBucket = Nothing

@@ -1,15 +1,8 @@ {-# LANGUAGE RecordWildCards, TypeFamilies, OverloadedStrings, MultiParamTypeClasses, FlexibleInstances #-} module Aws.S3.Commands.PutBucket where -import           Aws.Http-import           Aws.Response-import           Aws.S3.Info-import           Aws.S3.Metadata-import           Aws.S3.Model-import           Aws.S3.Query-import           Aws.S3.Response-import           Aws.Signature-import           Aws.Transaction+import           Aws.Core+import           Aws.S3.Core import           Control.Monad import qualified Data.Text            as T import qualified Data.Text.Encoding   as T@@ -28,8 +21,9 @@     = PutBucketResponse     deriving (Show) +-- | ServiceConfiguration: 'S3Configuration' instance SignQuery PutBucket where-    type Info PutBucket = S3Info+    type ServiceConfiguration PutBucket = S3Configuration      signQuery PutBucket{..} = s3SignQuery (S3Query {                                              s3QMethod       = Put

@@ -2,15 +2,8 @@ module Aws.S3.Commands.PutObject where -import           Aws.Http-import           Aws.Response-import           Aws.S3.Info-import           Aws.S3.Metadata-import           Aws.S3.Model-import           Aws.S3.Query-import           Aws.S3.Response-import           Aws.Signature-import           Aws.Transaction+import           Aws.Core+import           Aws.S3.Core import           Control.Applicative import           Control.Arrow              (second) import           Data.ByteString.Char8      ({- IsString -})@@ -46,8 +39,9 @@     }   deriving (Show) +-- | ServiceConfiguration: 'S3Configuration' instance SignQuery PutObject where-    type Info PutObject = S3Info+    type ServiceConfiguration PutObject = S3Configuration     signQuery PutObject {..} = s3SignQuery S3Query {                                  s3QMethod = Put                                , s3QBucket = Just $ T.encodeUtf8 poBucket

@@ -0,0 +1,393 @@+{-# LANGUAGE DeriveDataTypeable, OverloadedStrings, RecordWildCards, FlexibleContexts #-}+module Aws.S3.Core where++import           Aws.Core+import           Control.Arrow                  ((***))+import           Control.Monad+import           Control.Monad.IO.Class+import           Data.Attempt                   (Attempt(..))+import           Data.Conduit                   (($$))+import           Data.Function+import           Data.IORef+import           Data.List+import           Data.Maybe+import           Data.Monoid+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 B8+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+import qualified Network.HTTP.Types             as HTTP+import qualified Text.XML                       as XML+import qualified Text.XML.Cursor                as Cu++data S3Authorization +    = S3AuthorizationHeader +    | S3AuthorizationQuery+    deriving (Show)++data RequestStyle+    = PathStyle -- ^ Requires correctly setting region endpoint, but allows non-DNS compliant bucket names in the US standard region.+    | BucketStyle -- ^ Bucket name must be DNS compliant.+    | VHostStyle+    deriving (Show)++data S3Configuration+    = S3Configuration {+        s3Protocol :: Protocol+      , s3Endpoint :: B.ByteString+      , s3RequestStyle :: RequestStyle+      , s3Port :: Int+      , s3UseUri :: Bool+      , s3DefaultExpiry :: NominalDiffTime+      }+    deriving (Show)++instance DefaultServiceConfiguration S3Configuration where+  defaultConfiguration = s3 HTTPS s3EndpointUsClassic False+  defaultConfigurationUri = s3 HTTPS s3EndpointUsClassic True+  +  debugConfiguration = s3 HTTP s3EndpointUsClassic False+  debugConfigurationUri = s3 HTTP s3EndpointUsClassic True++s3EndpointUsClassic :: B.ByteString+s3EndpointUsClassic = "s3.amazonaws.com"++s3EndpointUsWest :: B.ByteString+s3EndpointUsWest = "s3-us-west-1.amazonaws.com"++s3EndpointEu :: B.ByteString+s3EndpointEu = "s3-eu-west-1.amazonaws.com"++s3EndpointApSouthEast :: B.ByteString+s3EndpointApSouthEast = "s3-ap-southeast-1.amazonaws.com"++s3EndpointApNorthEast :: B.ByteString+s3EndpointApNorthEast = "s3-ap-northeast-1.amazonaws.com"++s3 :: Protocol -> B.ByteString -> Bool -> S3Configuration+s3 protocol endpoint uri +    = S3Configuration { +         s3Protocol = protocol+       , s3Endpoint = endpoint+       , s3RequestStyle = BucketStyle+       , s3Port = defaultPort protocol+       , s3UseUri = uri+       , s3DefaultExpiry = 15*60+       }++type ErrorCode = T.Text++data S3Error+    = S3Error {+        s3StatusCode :: HTTP.Status+      , s3ErrorCode :: ErrorCode -- Error/Code+      , s3ErrorMessage :: T.Text -- Error/Message+      , s3ErrorResource :: Maybe T.Text -- Error/Resource+      , s3ErrorHostId :: Maybe T.Text -- Error/HostId+      , s3ErrorAccessKeyId :: Maybe T.Text -- Error/AWSAccessKeyId+      , s3ErrorStringToSign :: Maybe B.ByteString -- Error/StringToSignBytes (hexadecimal encoding)+      }+    deriving (Show, Typeable)++instance C.Exception S3Error++data S3Metadata+    = S3Metadata {+        s3MAmzId2 :: Maybe T.Text+      , s3MRequestId :: Maybe T.Text+      }+    deriving (Show, Typeable)++instance Monoid S3Metadata where+    mempty = S3Metadata Nothing Nothing+    S3Metadata a1 r1 `mappend` S3Metadata a2 r2 = S3Metadata (a1 `mplus` a2) (r1 `mplus` r2)++data S3Query+    = S3Query {+        s3QMethod :: Method+      , s3QBucket :: Maybe B.ByteString+      , s3QObject :: Maybe B.ByteString+      , s3QSubresources :: HTTP.Query+      , s3QQuery :: HTTP.Query+      , s3QContentType :: Maybe B.ByteString+      , s3QContentMd5 :: Maybe B.ByteString+      , s3QAmzHeaders :: HTTP.RequestHeaders+      , s3QOtherHeaders :: HTTP.RequestHeaders+      , s3QRequestBody :: Maybe (HTTP.RequestBody (C.ResourceT IO))+      }++instance Show S3Query where+    show S3Query{..} = "S3Query [" +++                       " method: " ++ show s3QMethod +++                       " ; bucket: " ++ show s3QBucket +++                       " ; subresources: " ++ show s3QSubresources +++                       " ; query: " ++ show s3QQuery +++                       " ; request body: " ++ (case s3QRequestBody of Nothing -> "no"; _ -> "yes") +++                       "]"++s3SignQuery :: S3Query -> S3Configuration -> SignatureData -> SignedQuery+s3SignQuery S3Query{..} S3Configuration{..} SignatureData{..}+    = SignedQuery {+        sqMethod = s3QMethod+      , sqProtocol = s3Protocol+      , sqHost = B.intercalate "." $ catMaybes host+      , sqPort = s3Port+      , sqPath = mconcat $ catMaybes path+      , sqQuery = sortedSubresources ++ s3QQuery ++ authQuery+      , sqDate = Just signatureTime+      , sqAuthorization = authorization+      , sqContentType = s3QContentType+      , sqContentMd5 = s3QContentMd5+      , sqAmzHeaders = amzHeaders+      , sqOtherHeaders = s3QOtherHeaders+      , sqBody = s3QRequestBody+      , sqStringToSign = stringToSign+      }+    where+      amzHeaders = merge $ sortBy (compare `on` fst) s3QAmzHeaders+          where merge (x1@(k1,v1):x2@(k2,v2):xs) | k1 == k2  = merge ((k1, B8.intercalate "," [v1, v2]) : xs)+                                                 | otherwise = x1 : merge (x2 : xs)+                merge xs = xs++      (host, path) = case s3RequestStyle of+                       PathStyle   -> ([Just s3Endpoint], [Just "/", fmap (`B8.snoc` '/') s3QBucket, s3QObject])+                       BucketStyle -> ([s3QBucket, Just s3Endpoint], [Just "/", s3QObject])+                       VHostStyle  -> ([Just $ fromMaybe s3Endpoint s3QBucket], [Just "/", s3QObject])+      sortedSubresources = sort s3QSubresources+      canonicalizedResource = Blaze8.fromChar '/' `mappend`+                              maybe mempty (\s -> Blaze.copyByteString s `mappend` Blaze8.fromChar '/') s3QBucket `mappend`+                              maybe mempty Blaze.copyByteString s3QObject `mappend`+                              HTTP.renderQueryBuilder True sortedSubresources+      ti = case (s3UseUri, signatureTimeInfo) of+             (False, ti') -> ti'+             (True, AbsoluteTimestamp time) -> AbsoluteExpires $ s3DefaultExpiry `addUTCTime` time+             (True, AbsoluteExpires time) -> AbsoluteExpires time+      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 s3QContentType]+                       , [Blaze.copyByteString $ case ti of+                                                   AbsoluteTimestamp time -> fmtRfc822Time time+                                                   AbsoluteExpires time -> fmtTimeEpochSeconds time]+                       , map amzHeader amzHeaders+                       , [canonicalizedResource]+                       ]+          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)+      makeAuthQuery time+          = [("Expires", fmtTimeEpochSeconds time)+            , ("AWSAccessKeyId", accessKeyID signatureCredentials)+            , ("SignatureMethod", "HmacSHA256")+            , ("Signature", sig)]++s3ResponseConsumer :: HTTPResponseConsumer a+                   -> IORef S3Metadata+                   -> HTTPResponseConsumer a+s3ResponseConsumer inner metadata status headers source = do+      let headerString = fmap T.decodeUtf8 . flip lookup headers+      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++s3XmlResponseConsumer :: (Cu.Cursor -> Response S3Metadata a)+                      -> IORef S3Metadata+                      -> HTTPResponseConsumer a+s3XmlResponseConsumer parse metadataRef =+    s3ResponseConsumer (xmlCursorConsumer parse metadataRef) metadataRef++s3BinaryResponseConsumer :: HTTPResponseConsumer a+                         -> IORef S3Metadata+                         -> HTTPResponseConsumer a+s3BinaryResponseConsumer inner metadataRef = s3ResponseConsumer inner metadataRef++s3ErrorResponseConsumer :: HTTPResponseConsumer a+s3ErrorResponseConsumer status _headers source+    = do doc <- source $$ XML.sinkDoc XML.def+         let cursor = Cu.fromDocument doc+         liftIO $ case parseError cursor of+           Success err      -> C.monadThrow err+           Failure otherErr -> C.monadThrow otherErr+    where+      parseError :: Cu.Cursor -> Attempt S3Error+      parseError root = do code <- force "Missing error Code" $ root $/ elContent "Code"+                           message <- force "Missing error Message" $ root $/ elContent "Message"+                           let resource = listToMaybe $ root $/ elContent "Resource"+                               hostId = listToMaybe $ root $/ elContent "HostId"+                               accessKeyId = listToMaybe $ root $/ elContent "AWSAccessKeyId"+                               stringToSign = do unprocessed <- listToMaybe $ root $/ elCont "StringToSignBytes"+                                                 bytes <- mapM readHex2 $ words unprocessed+                                                 return $ B.pack bytes+                           return S3Error {+                                        s3StatusCode = status+                                      , s3ErrorCode = code+                                      , s3ErrorMessage = message+                                      , s3ErrorResource = resource+                                      , s3ErrorHostId = hostId+                                      , s3ErrorAccessKeyId = accessKeyId+                                      , s3ErrorStringToSign = stringToSign+                                      }++type CanonicalUserId = T.Text++data UserInfo+    = UserInfo {+        userId          :: CanonicalUserId+      , userDisplayName :: T.Text+      }+    deriving (Show)++parseUserInfo :: F.Failure XmlException m => Cu.Cursor -> m UserInfo+parseUserInfo el = do id_ <- force "Missing user ID" $ el $/ elContent "ID"+                      displayName <- force "Missing user DisplayName" $ el $/ elContent "DisplayName"+                      return UserInfo { userId = id_, userDisplayName = displayName }++data CannedAcl+    = AclPrivate+    | AclPublicRead+    | AclPublicReadWrite+    | AclAuthenticatedRead+    | AclBucketOwnerRead+    | AclBucketOwnerFullControl+    | AclLogDeliveryWrite+    deriving (Show)++writeCannedAcl :: CannedAcl -> T.Text+writeCannedAcl AclPrivate                = "private"+writeCannedAcl AclPublicRead             = "public-read"+writeCannedAcl AclPublicReadWrite        = "public-read-write"+writeCannedAcl AclAuthenticatedRead      = "authenticated-read"+writeCannedAcl AclBucketOwnerRead        = "bucket-owner-read"+writeCannedAcl AclBucketOwnerFullControl = "bucket-owner-full-control"+writeCannedAcl AclLogDeliveryWrite       = "log-delivery-write"++data StorageClass+    = Standard+    | ReducedRedundancy+    deriving (Show)++parseStorageClass :: F.Failure XmlException m => T.Text -> m StorageClass+parseStorageClass "STANDARD"           = return Standard+parseStorageClass "REDUCED_REDUNDANCY" = return ReducedRedundancy+parseStorageClass s = F.failure . XmlException $ "Invalid Storage Class: " ++ T.unpack s++writeStorageClass :: StorageClass -> T.Text+writeStorageClass Standard          = "STANDARD"+writeStorageClass ReducedRedundancy = "REDUCED_REDUNDANCY"++type Bucket = T.Text++data BucketInfo+    = BucketInfo {+        bucketName         :: Bucket+      , bucketCreationDate :: UTCTime+      }+    deriving (Show)++type Object = T.Text++data ObjectInfo+    = ObjectInfo {+        objectKey          :: T.Text+      , objectLastModified :: UTCTime+      , objectETag         :: T.Text+      , objectSize         :: Integer+      , objectStorageClass :: StorageClass+      , objectOwner        :: UserInfo+      }+    deriving (Show)++parseObjectInfo :: F.Failure XmlException m => Cu.Cursor -> m ObjectInfo+parseObjectInfo el+    = do key <- force "Missing object Key" $ el $/ elContent "Key"+         let time s = case parseTime defaultTimeLocale "%Y-%m-%dT%H:%M:%S%QZ" $ T.unpack s of+                        Nothing -> F.failure $ XmlException "Invalid time"+                        Just v -> return v+         lastModified <- forceM "Missing object LastModified" $ el $/ elContent "LastModified" &| time+         eTag <- force "Missing object ETag" $ el $/ elContent "ETag"+         size <- forceM "Missing object Size" $ el $/ elContent "Size" &| textReadInt+         storageClass <- forceM "Missing object StorageClass" $ el $/ elContent "StorageClass" &| parseStorageClass+         owner <- forceM "Missing object Owner" $ el $/ Cu.laxElement "Owner" &| parseUserInfo+         return ObjectInfo{+                      objectKey          = key+                    , objectLastModified = lastModified+                    , objectETag         = eTag+                    , objectSize         = size+                    , objectStorageClass = storageClass+                    , objectOwner        = owner+                    }++data ObjectMetadata+    = ObjectMetadata {+        omDeleteMarker         :: Bool+      , omETag                 :: T.Text+      , omLastModified         :: UTCTime+      , omVersionId            :: Maybe T.Text+-- TODO:+--      , omExpiration           :: Maybe (UTCTime, T.Text)+      , omUserMetadata         :: [(T.Text, T.Text)]+      , omMissingUserMetadata  :: Maybe T.Text+      , omServerSideEncryption :: Maybe T.Text+      }+    deriving (Show)++parseObjectMetadata :: F.Failure HeaderException m => HTTP.ResponseHeaders -> m ObjectMetadata+parseObjectMetadata h = ObjectMetadata+                        `liftM` deleteMarker+                        `ap` etag+                        `ap` lastModified+                        `ap` return versionId+--                        `ap` expiration+                        `ap` return userMetadata+                        `ap` return missingUserMetadata+                        `ap` return serverSideEncryption+  where deleteMarker = case B8.unpack `fmap` lookup "x-amz-delete-marker" h of+                         Nothing -> return False+                         Just "true" -> return True+                         Just "false" -> return False+                         Just x -> F.failure $ HeaderException ("Invalid x-amz-delete-marker " ++ x)+        etag = case T.decodeUtf8 `fmap` lookup "ETag" h of+                 Just x -> return x+                 Nothing -> F.failure $ HeaderException "ETag missing"+        lastModified = case B8.unpack `fmap` lookup "Last-Modified" h of+                         Just ts -> case parseTime defaultTimeLocale rfc822Time ts of+                                      Just t -> return t+                                      Nothing -> F.failure $ HeaderException "Invalid Last-Modified"+                         Nothing -> F.failure $ HeaderException "Last-Modified missing"+        versionId = T.decodeUtf8 `fmap` lookup "x-amz-version-id" h+        -- expiration = return undefined+        userMetadata = flip mapMaybe ht $+                       \(k, v) -> do i <- T.stripPrefix "x-amz-meta-" k+                                     return (i, v)+        missingUserMetadata = T.decodeUtf8 `fmap` lookup "x-amz-missing-meta" h+        serverSideEncryption = T.decodeUtf8 `fmap` lookup "x-amz-server-side-encryption" h++        ht = map ((T.decodeUtf8 . CI.foldedCase) *** T.decodeUtf8) h++type LocationConstraint = T.Text++locationUsClassic, locationUsWest, locationEu, locationApSouthEast, locationApNorthEast :: LocationConstraint+locationUsClassic = ""+locationUsWest = "us-west-1"+locationEu = "EU"+locationApSouthEast = "ap-southeast-1"+locationApNorthEast = "ap-northeast-1"

@@ -1,25 +0,0 @@-{-# LANGUAGE DeriveDataTypeable, MultiParamTypeClasses, RecordWildCards #-}-module Aws.S3.Error-where--import           Data.Typeable-import qualified Control.Exception  as C-import qualified Data.ByteString    as B-import qualified Data.Text          as T-import qualified Network.HTTP.Types as HTTP--type ErrorCode = T.Text--data S3Error-    = S3Error {-        s3StatusCode :: HTTP.Status-      , s3ErrorCode :: ErrorCode -- Error/Code-      , s3ErrorMessage :: T.Text -- Error/Message-      , s3ErrorResource :: Maybe T.Text -- Error/Resource-      , s3ErrorHostId :: Maybe T.Text -- Error/HostId-      , s3ErrorAccessKeyId :: Maybe T.Text -- Error/AWSAccessKeyId-      , s3ErrorStringToSign :: Maybe B.ByteString -- Error/StringToSignBytes (hexadecimal encoding)-      }-    deriving (Show, Typeable)--instance C.Exception S3Error

@@ -1,55 +0,0 @@-{-# LANGUAGE OverloadedStrings #-}-module Aws.S3.Info-where--import           Aws.Http-import           Data.Time-import qualified Data.ByteString as B--data S3Authorization -    = S3AuthorizationHeader -    | S3AuthorizationQuery-    deriving (Show)--data RequestStyle-    = PathStyle -- ^ Requires correctly setting region endpoint, but allows non-DNS compliant bucket names in the US standard region.-    | BucketStyle -- ^ Bucket name must be DNS compliant.-    | VHostStyle-    deriving (Show)--data S3Info-    = S3Info {-        s3Protocol :: Protocol-      , s3Endpoint :: B.ByteString-      , s3RequestStyle :: RequestStyle-      , s3Port :: Int-      , s3UseUri :: Bool-      , s3DefaultExpiry :: NominalDiffTime-      }-    deriving (Show)--s3EndpointUsClassic :: B.ByteString-s3EndpointUsClassic = "s3.amazonaws.com"--s3EndpointUsWest :: B.ByteString-s3EndpointUsWest = "s3-us-west-1.amazonaws.com"--s3EndpointEu :: B.ByteString-s3EndpointEu = "s3-eu-west-1.amazonaws.com"--s3EndpointApSouthEast :: B.ByteString-s3EndpointApSouthEast = "s3-ap-southeast-1.amazonaws.com"--s3EndpointApNorthEast :: B.ByteString-s3EndpointApNorthEast = "s3-ap-northeast-1.amazonaws.com"--s3 :: Protocol -> B.ByteString -> Bool -> S3Info-s3 protocol endpoint uri -    = S3Info { -         s3Protocol = protocol-       , s3Endpoint = endpoint-       , s3RequestStyle = BucketStyle-       , s3Port = defaultPort protocol-       , s3UseUri = uri-       , s3DefaultExpiry = 15*60-       }

@@ -1,19 +0,0 @@-{-# LANGUAGE DeriveDataTypeable #-}-module Aws.S3.Metadata-where-  -import           Control.Monad-import           Data.Monoid-import           Data.Typeable-import qualified Data.Text     as T--data S3Metadata-    = S3Metadata {-        s3MAmzId2 :: Maybe T.Text-      , s3MRequestId :: Maybe T.Text-      }-    deriving (Show, Typeable)--instance Monoid S3Metadata where-    mempty = S3Metadata Nothing Nothing-    S3Metadata a1 r1 `mappend` S3Metadata a2 r2 = S3Metadata (a1 `mplus` a2) (r1 `mplus` r2)

@@ -1,109 +0,0 @@-{-# LANGUAGE OverloadedStrings, FlexibleContexts #-}-module Aws.S3.Model-where--import           Aws.Xml-import           Data.Time-import           System.Locale-import           Text.XML.Cursor (($/), (&|))-import qualified Control.Failure as F-import qualified Text.XML.Cursor as Cu-import qualified Data.Text       as T--type CanonicalUserId = T.Text--data UserInfo-    = UserInfo {-        userId          :: CanonicalUserId-      , userDisplayName :: T.Text-      }-    deriving (Show)--parseUserInfo :: F.Failure XmlException m => Cu.Cursor -> m UserInfo-parseUserInfo el = do id_ <- force "Missing user ID" $ el $/ elContent "ID"-                      displayName <- force "Missing user DisplayName" $ el $/ elContent "DisplayName"-                      return UserInfo { userId = id_, userDisplayName = displayName }--data CannedAcl-    = AclPrivate-    | AclPublicRead-    | AclPublicReadWrite-    | AclAuthenticatedRead-    | AclBucketOwnerRead-    | AclBucketOwnerFullControl-    | AclLogDeliveryWrite-    deriving (Show)--writeCannedAcl :: CannedAcl -> T.Text-writeCannedAcl AclPrivate                = "private"-writeCannedAcl AclPublicRead             = "public-read"-writeCannedAcl AclPublicReadWrite        = "public-read-write"-writeCannedAcl AclAuthenticatedRead      = "authenticated-read"-writeCannedAcl AclBucketOwnerRead        = "bucket-owner-read"-writeCannedAcl AclBucketOwnerFullControl = "bucket-owner-full-control"-writeCannedAcl AclLogDeliveryWrite       = "log-delivery-write"--data StorageClass-    = Standard-    | ReducedRedundancy-    deriving (Show)--parseStorageClass :: F.Failure XmlException m => T.Text -> m StorageClass-parseStorageClass "STANDARD"           = return Standard-parseStorageClass "REDUCED_REDUNDANCY" = return ReducedRedundancy-parseStorageClass s = F.failure . XmlException $ "Invalid Storage Class: " ++ T.unpack s--writeStorageClass :: StorageClass -> T.Text-writeStorageClass Standard          = "STANDARD"-writeStorageClass ReducedRedundancy = "REDUCED_REDUNDANCY"--type Bucket = T.Text--data BucketInfo-    = BucketInfo {-        bucketName         :: Bucket-      , bucketCreationDate :: UTCTime-      }-    deriving (Show)--type Object = T.Text--data ObjectInfo-    = ObjectInfo {-        objectKey          :: T.Text-      , objectLastModified :: UTCTime-      , objectETag         :: T.Text-      , objectSize         :: Integer-      , objectStorageClass :: StorageClass-      , objectOwner        :: UserInfo-      }-    deriving (Show)--parseObjectInfo :: F.Failure XmlException m => Cu.Cursor -> m ObjectInfo-parseObjectInfo el-    = do key <- force "Missing object Key" $ el $/ elContent "Key"-         let time s = case parseTime defaultTimeLocale "%Y-%m-%dT%H:%M:%S%QZ" $ T.unpack s of-                        Nothing -> F.failure $ XmlException "Invalid time"-                        Just v -> return v-         lastModified <- forceM "Missing object LastModified" $ el $/ elContent "LastModified" &| time-         eTag <- force "Missing object ETag" $ el $/ elContent "ETag"-         size <- forceM "Missing object Size" $ el $/ elContent "Size" &| textReadInt-         storageClass <- forceM "Missing object StorageClass" $ el $/ elContent "StorageClass" &| parseStorageClass-         owner <- forceM "Missing object Owner" $ el $/ Cu.laxElement "Owner" &| parseUserInfo-         return ObjectInfo{-                      objectKey          = key-                    , objectLastModified = lastModified-                    , objectETag         = eTag-                    , objectSize         = size-                    , objectStorageClass = storageClass-                    , objectOwner        = owner-                    }--type LocationConstraint = T.Text--locationUsClassic, locationUsWest, locationEu, locationApSouthEast, locationApNorthEast :: LocationConstraint-locationUsClassic = ""-locationUsWest = "us-west-1"-locationEu = "EU"-locationApSouthEast = "ap-southeast-1"-locationApNorthEast = "ap-northeast-1"

@@ -1,105 +0,0 @@-{-# LANGUAGE OverloadedStrings, RecordWildCards #-}--module Aws.S3.Query-where--import           Aws.Credentials-import           Aws.Http-import           Aws.Query-import           Aws.S3.Info-import           Aws.Signature-import           Aws.Util-import           Data.Function-import           Data.List-import           Data.Maybe-import           Data.Monoid-import           Data.Time-import qualified Blaze.ByteString.Builder       as Blaze-import qualified Blaze.ByteString.Builder.Char8 as Blaze8-import qualified Data.ByteString                as B-import qualified Data.ByteString.Char8          as B8-import qualified Data.CaseInsensitive           as CI-import qualified Network.HTTP.Conduit           as HTTP-import qualified Data.Conduit as C-import qualified Network.HTTP.Types             as HTTP--data S3Query-    = S3Query {-        s3QMethod :: Method-      , s3QBucket :: Maybe B.ByteString-      , s3QObject :: Maybe B.ByteString-      , s3QSubresources :: HTTP.Query-      , s3QQuery :: HTTP.Query-      , s3QContentType :: Maybe B.ByteString-      , s3QContentMd5 :: Maybe B.ByteString-      , s3QAmzHeaders :: HTTP.RequestHeaders-      , s3QOtherHeaders :: HTTP.RequestHeaders-      , s3QRequestBody :: Maybe (HTTP.RequestBody (C.ResourceT IO))-      }--instance Show S3Query where-    show S3Query{..} = "S3Query [" ++-                       " method: " ++ show s3QMethod ++-                       " ; bucket: " ++ show s3QBucket ++-                       " ; subresources: " ++ show s3QSubresources ++-                       " ; query: " ++ show s3QQuery ++-                       " ; request body: " ++ (case s3QRequestBody of Nothing -> "no"; _ -> "yes") ++-                       "]"--s3SignQuery :: S3Query -> S3Info -> SignatureData -> SignedQuery-s3SignQuery S3Query{..} S3Info{..} SignatureData{..}-    = SignedQuery {-        sqMethod = s3QMethod-      , sqProtocol = s3Protocol-      , sqHost = B.intercalate "." $ catMaybes host-      , sqPort = s3Port-      , sqPath = mconcat $ catMaybes path-      , sqQuery = sortedSubresources ++ s3QQuery ++ authQuery-      , sqDate = Just signatureTime-      , sqAuthorization = authorization-      , sqContentType = s3QContentType-      , sqContentMd5 = s3QContentMd5-      , sqAmzHeaders = amzHeaders-      , sqOtherHeaders = s3QOtherHeaders-      , sqBody = s3QRequestBody-      , sqStringToSign = stringToSign-      }-    where-      amzHeaders = merge $ sortBy (compare `on` fst) s3QAmzHeaders-          where merge (x1@(k1,v1):x2@(k2,v2):xs) | k1 == k2  = merge ((k1, B8.intercalate "," [v1, v2]) : xs)-                                                 | otherwise = x1 : merge (x2 : xs)-                merge xs = xs--      (host, path) = case s3RequestStyle of-                       PathStyle   -> ([Just s3Endpoint], [Just "/", fmap (`B8.snoc` '/') s3QBucket, s3QObject])-                       BucketStyle -> ([s3QBucket, Just s3Endpoint], [Just "/", s3QObject])-                       VHostStyle  -> ([Just $ fromMaybe s3Endpoint s3QBucket], [Just "/", s3QObject])-      sortedSubresources = sort s3QSubresources-      canonicalizedResource = Blaze8.fromChar '/' `mappend`-                              maybe mempty (\s -> Blaze.copyByteString s `mappend` Blaze8.fromChar '/') s3QBucket `mappend`-                              maybe mempty Blaze.copyByteString s3QObject `mappend`-                              HTTP.renderQueryBuilder True sortedSubresources-      ti = case (s3UseUri, signatureTimeInfo) of-             (False, ti') -> ti'-             (True, AbsoluteTimestamp time) -> AbsoluteExpires $ s3DefaultExpiry `addUTCTime` time-             (True, AbsoluteExpires time) -> AbsoluteExpires time-      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 s3QContentType]-                       , [Blaze.copyByteString $ case ti of-                                                   AbsoluteTimestamp time -> fmtRfc822Time time-                                                   AbsoluteExpires time -> fmtTimeEpochSeconds time]-                       , map amzHeader amzHeaders-                       , [canonicalizedResource]-                       ]-          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)-      makeAuthQuery time-          = [("Expires", fmtTimeEpochSeconds time)-            , ("AWSAccessKeyId", accessKeyID signatureCredentials)-            , ("SignatureMethod", "HmacSHA256")-            , ("Signature", sig)]

@@ -1,74 +0,0 @@-{-# LANGUAGE FlexibleInstances, OverloadedStrings, ScopedTypeVariables, RecordWildCards, TypeFamilies, RankNTypes #-}-module Aws.S3.Response-where--import           Aws.Response-import           Aws.S3.Error-import           Aws.S3.Metadata-import           Aws.Util-import           Aws.Xml-import           Control.Monad.IO.Class-import           Data.Attempt                 (Attempt(..))-import           Data.Conduit                 (($$))-import           Data.IORef-import           Data.Maybe-import           Text.XML.Cursor              (($/))-import qualified Data.ByteString              as B-import qualified Data.Conduit                 as C-import qualified Data.Text.Encoding           as T-import qualified Network.HTTP.Types           as HTTP-import qualified Text.XML.Cursor              as Cu-import qualified Text.XML                     as XML--s3ResponseConsumer :: HTTPResponseConsumer a-                   -> IORef S3Metadata-                   -> HTTPResponseConsumer a-s3ResponseConsumer inner metadata status headers source = do-      let headerString = fmap T.decodeUtf8 . flip lookup headers-      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--s3XmlResponseConsumer :: (Cu.Cursor -> Response S3Metadata a)-                      -> IORef S3Metadata-                      -> HTTPResponseConsumer a-s3XmlResponseConsumer parse metadataRef =-    s3ResponseConsumer (xmlCursorConsumer parse metadataRef) metadataRef--s3BinaryResponseConsumer :: HTTPResponseConsumer a-                         -> IORef S3Metadata-                         -> HTTPResponseConsumer a-s3BinaryResponseConsumer inner metadataRef = s3ResponseConsumer inner metadataRef--s3ErrorResponseConsumer :: HTTPResponseConsumer a-s3ErrorResponseConsumer status _headers source-    = do doc <- source $$ XML.sinkDoc XML.def-         let cursor = Cu.fromDocument doc-         liftIO $ case parseError cursor of-           Success err      -> C.monadThrow err-           Failure otherErr -> C.monadThrow otherErr-    where-      parseError :: Cu.Cursor -> Attempt S3Error-      parseError root = do code <- force "Missing error Code" $ root $/ elContent "Code"-                           message <- force "Missing error Message" $ root $/ elContent "Message"-                           let resource = listToMaybe $ root $/ elContent "Resource"-                               hostId = listToMaybe $ root $/ elContent "HostId"-                               accessKeyId = listToMaybe $ root $/ elContent "AWSAccessKeyId"-                               stringToSign = do unprocessed <- listToMaybe $ root $/ elCont "StringToSignBytes"-                                                 bytes <- mapM readHex2 $ words unprocessed-                                                 return $ B.pack bytes-                           return S3Error {-                                        s3StatusCode = status-                                      , s3ErrorCode = code-                                      , s3ErrorMessage = message-                                      , s3ErrorResource = resource-                                      , s3ErrorHostId = hostId-                                      , s3ErrorAccessKeyId = accessKeyId-                                      , s3ErrorStringToSign = stringToSign-                                      }

@@ -1,17 +1,7 @@ module Aws.Ses     ( module Aws.Ses.Commands-    , module Aws.Ses.Error-    , module Aws.Ses.Info-    , module Aws.Ses.Metadata-    , module Aws.Ses.Model-    , module Aws.Ses.Query-    , module Aws.Ses.Response+    , module Aws.Ses.Core     ) where  import Aws.Ses.Commands-import Aws.Ses.Error-import Aws.Ses.Info-import Aws.Ses.Metadata-import Aws.Ses.Model-import Aws.Ses.Query-import Aws.Ses.Response+import Aws.Ses.Core

@@ -8,15 +8,8 @@ import Data.Typeable import Text.XML.Cursor (($//)) -import Aws.Signature-import Aws.Response-import Aws.Transaction-import Aws.Xml-import Aws.Ses.Info-import Aws.Ses.Query-import Aws.Ses.Metadata-import Aws.Ses.Model-import Aws.Ses.Response+import Aws.Core+import Aws.Ses.Core  -- | Send a raw e-mail message. data SendRawEmail =@@ -27,8 +20,9 @@       }     deriving (Eq, Ord, Show, Typeable) +-- | ServiceConfiguration: 'SesConfiguration' instance SignQuery SendRawEmail where-    type Info SendRawEmail = SesInfo+    type ServiceConfiguration SendRawEmail = SesConfiguration     signQuery SendRawEmail {..} =         sesSignQuery $ ("Action", "SendRawEmail") :                        concat [ sesAsQuery srmDestinations

@@ -0,0 +1,182 @@+{-# LANGUAGE DeriveDataTypeable, MultiParamTypeClasses, RecordWildCards, OverloadedStrings #-}+module Aws.Ses.Core+    ( SesError(..)+    , SesMetadata(..)++    , SesConfiguration(..)+    , sesUsEast+    , sesHttpsGet+    , sesHttpsPost++    , sesSignQuery++    , sesResponseConsumer++    , RawMessage(..)+    , Destination(..)+    , EmailAddress+    , Sender(..)+    , sesAsQuery+    ) 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 qualified Data.ByteString                as B+import qualified Data.ByteString.Base64         as B64+import qualified Data.Text.Encoding             as TE+import qualified Network.HTTP.Types             as HTTP+import qualified Text.XML.Cursor                as Cu++data SesError+    = SesError {+        sesStatusCode   :: HTTP.Status+      , sesErrorCode    :: Text+      , sesErrorMessage :: Text+      }+    deriving (Show, Typeable)++instance C.Exception SesError++data SesMetadata+    = SesMetadata {+        requestId :: Maybe Text+      }+    deriving (Show, Typeable)++instance Monoid SesMetadata where+    mempty = SesMetadata Nothing+    SesMetadata r1 `mappend` SesMetadata r2 = SesMetadata (r1 `mplus` r2)++data SesConfiguration+    = 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++sesUsEast :: B.ByteString+sesUsEast = "email.us-east-1.amazonaws.com"++sesHttpsGet :: B.ByteString -> SesConfiguration+sesHttpsGet endpoint = SesConfiguration Get endpoint++sesHttpsPost :: B.ByteString -> SesConfiguration+sesHttpsPost endpoint = SesConfiguration PostQuery endpoint++sesSignQuery :: [(B.ByteString, B.ByteString)] -> SesConfiguration -> SignatureData -> SignedQuery+sesSignQuery query si sd+    = SignedQuery {+        sqMethod        = sesiHttpMethod si+      , sqProtocol      = HTTPS+      , sqHost          = sesiHost si+      , sqPort          = defaultPort HTTPS+      , sqPath          = "/"+      , sqQuery         = HTTP.simpleQueryToQuery query'+      , sqDate          = Just $ signatureTime sd+      , sqAuthorization = Nothing+      , sqContentType   = Nothing+      , sqContentMd5    = Nothing+      , sqAmzHeaders    = [("X-Amzn-Authorization", authorization)]+      , sqOtherHeaders  = []+      , sqBody          = Nothing+      , sqStringToSign  = stringToSign+      }+    where+      stringToSign  = fmtRfc822Time (signatureTime sd)+      credentials   = signatureCredentials sd+      accessKeyId   = accessKeyID credentials+      authorization = B.concat [ "AWS3-HTTPS AWSAccessKeyId="+                               , accessKeyId+                               , ", Algorithm=HmacSHA256, Signature="+                               , signature credentials HmacSHA256 stringToSign+                               ]+      query' = ("AWSAccessKeyId", accessKeyId) : query++sesResponseConsumer :: (Cu.Cursor -> Response SesMetadata a)+                    -> IORef SesMetadata+                    -> HTTPResponseConsumer a+sesResponseConsumer inner metadataRef status = xmlCursorConsumer parse metadataRef status+    where+      parse cursor = do+        let requestId' = listToMaybe $ cursor $// elContent "RequestID"+        tellMetadata $ SesMetadata requestId'+        case cursor $/ Cu.laxElement "Error" of+          []      -> inner cursor+          (err:_) -> fromError err++      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++class SesAsQuery a where+    -- | Write a data type as a list of query parameters.+    sesAsQuery :: a -> [(B.ByteString, B.ByteString)]++instance SesAsQuery a => SesAsQuery (Maybe a) where+    sesAsQuery = maybe [] sesAsQuery+++-- | A raw e-mail.+data RawMessage = RawMessage { rawMessageData :: B.ByteString }+                deriving (Eq, Ord, Show, Typeable)++instance SesAsQuery RawMessage where+    sesAsQuery = (:[]) . (,) "RawMessage.Data" . B64.encode . rawMessageData+++-- | The destinations of an e-mail.+data Destination =+    Destination+      { destinationBccAddresses :: [EmailAddress]+      , destinationCcAddresses  :: [EmailAddress]+      , destinationToAddresses  :: [EmailAddress]+      } deriving (Eq, Ord, Show, Typeable)++instance SesAsQuery Destination where+    sesAsQuery (Destination bcc cc to) = concat [ go (s "Bcc") bcc+                                                , go (s "Cc")  cc+                                                , go (s "To")  to ]+        where+          go kind = zipWith f (map Blaze8.fromShow [one..])+              where txt = kind `mappend` s "Addresses.member."+                    f n v = ( Blaze.toByteString (txt `mappend` n)+                            , TE.encodeUtf8 v )+          s = Blaze.fromByteString+          one = 1 :: Int++instance Monoid Destination where+    mempty = Destination [] [] []+    mappend (Destination a1 a2 a3) (Destination b1 b2 b3) =+        Destination (a1 ++ b1) (a2 ++ b2) (a3 ++ b3)+++-- | An e-mail address.+type EmailAddress = Text+++-- | The sender's e-mail address.+data Sender = Sender { senderAddress :: EmailAddress }+              deriving (Eq, Ord, Show, Typeable)++instance SesAsQuery Sender where+    sesAsQuery = (:[]) . (,) "Source" . TE.encodeUtf8 . senderAddress

@@ -1,20 +0,0 @@-{-# LANGUAGE DeriveDataTypeable, MultiParamTypeClasses, RecordWildCards #-}-module Aws.Ses.Error-    ( SesError(..)-    ) where--import           Data.Typeable-import           Data.Text                 (Text)-import qualified Control.Exception         as C-import qualified Network.HTTP.Types        as HTTP---data SesError-    = SesError {-        sesStatusCode   :: HTTP.Status-      , sesErrorCode    :: Text-      , sesErrorMessage :: Text-      }-    deriving (Show, Typeable)--instance C.Exception SesError

@@ -1,26 +0,0 @@-{-# LANGUAGE OverloadedStrings #-}-module Aws.Ses.Info-    ( SesInfo(..)-    , sesUsEast-    , sesHttpsGet-    , sesHttpsPost-    ) where--import           Aws.Http-import qualified Data.ByteString as B--data SesInfo-    = SesInfo {-        sesiHttpMethod :: Method-      , sesiHost       :: B.ByteString-      }-    deriving (Show)--sesUsEast :: B.ByteString-sesUsEast = "email.us-east-1.amazonaws.com"--sesHttpsGet :: B.ByteString -> SesInfo-sesHttpsGet endpoint = SesInfo Get endpoint--sesHttpsPost :: B.ByteString -> SesInfo-sesHttpsPost endpoint = SesInfo PostQuery endpoint

@@ -1,19 +0,0 @@-{-# LANGUAGE DeriveDataTypeable #-}-module Aws.Ses.Metadata-    ( SesMetadata(..)-    ) where--import           Control.Monad-import           Data.Monoid-import           Data.Typeable-import qualified Data.Text     as T--data SesMetadata-    = SesMetadata {-        requestId :: Maybe T.Text-      }-    deriving (Show, Typeable)--instance Monoid SesMetadata where-    mempty = SesMetadata Nothing-    SesMetadata r1 `mappend` SesMetadata r2 = SesMetadata (r1 `mplus` r2)

@@ -1,73 +0,0 @@-{-# LANGUAGE DeriveDataTypeable, OverloadedStrings #-}-module Aws.Ses.Model-    ( RawMessage(..)-    , Destination(..)-    , EmailAddress-    , Sender(..)-    , sesAsQuery-    ) where--import Data.ByteString.Char8 ({-IsString-})-import Data.Monoid-import Data.Text (Text)-import Data.Typeable--import qualified Blaze.ByteString.Builder as Blaze-import qualified Blaze.ByteString.Builder.Char8 as Blaze8-import qualified Data.ByteString.Base64 as B64-import qualified Data.ByteString as B-import qualified Data.Text.Encoding as TE---class SesAsQuery a where-    -- | Write a data type as a list of query parameters.-    sesAsQuery :: a -> [(B.ByteString, B.ByteString)]--instance SesAsQuery a => SesAsQuery (Maybe a) where-    sesAsQuery = maybe [] sesAsQuery----- | A raw e-mail.-data RawMessage = RawMessage { rawMessageData :: B.ByteString }-                deriving (Eq, Ord, Show, Typeable)--instance SesAsQuery RawMessage where-    sesAsQuery = (:[]) . (,) "RawMessage.Data" . B64.encode . rawMessageData----- | The destinations of an e-mail.-data Destination =-    Destination-      { destinationBccAddresses :: [EmailAddress]-      , destinationCcAddresses  :: [EmailAddress]-      , destinationToAddresses  :: [EmailAddress]-      } deriving (Eq, Ord, Show, Typeable)--instance SesAsQuery Destination where-    sesAsQuery (Destination bcc cc to) = concat [ go (s "Bcc") bcc-                                                , go (s "Cc")  cc-                                                , go (s "To")  to ]-        where-          go kind = zipWith f (map Blaze8.fromShow [one..])-              where txt = kind `mappend` s "Addresses.member."-                    f n v = ( Blaze.toByteString (txt `mappend` n)-                            , TE.encodeUtf8 v )-          s = Blaze.fromByteString-          one = 1 :: Int--instance Monoid Destination where-    mempty = Destination [] [] []-    mappend (Destination a1 a2 a3) (Destination b1 b2 b3) =-        Destination (a1 ++ b1) (a2 ++ b2) (a3 ++ b3)----- | An e-mail address.-type EmailAddress = Text----- | The sender's e-mail address.-data Sender = Sender { senderAddress :: EmailAddress }-              deriving (Eq, Ord, Show, Typeable)--instance SesAsQuery Sender where-    sesAsQuery = (:[]) . (,) "Source" . TE.encodeUtf8 . senderAddress

@@ -1,43 +0,0 @@-{-# LANGUAGE OverloadedStrings #-}-module Aws.Ses.Query-    ( sesSignQuery-    ) where--import           Aws.Credentials-import           Aws.Http-import           Aws.Query-import           Aws.Signature-import           Aws.Ses.Info-import           Aws.Util-import qualified Data.ByteString                as B-import qualified Network.HTTP.Types             as HTTP---sesSignQuery :: [(B.ByteString, B.ByteString)] -> SesInfo -> SignatureData -> SignedQuery-sesSignQuery query si sd-    = SignedQuery {-        sqMethod        = sesiHttpMethod si-      , sqProtocol      = HTTPS-      , sqHost          = sesiHost si-      , sqPort          = defaultPort HTTPS-      , sqPath          = "/"-      , sqQuery         = HTTP.simpleQueryToQuery query'-      , sqDate          = Just $ signatureTime sd-      , sqAuthorization = Nothing-      , sqContentType   = Nothing-      , sqContentMd5    = Nothing-      , sqAmzHeaders    = [("X-Amzn-Authorization", authorization)]-      , sqOtherHeaders  = []-      , sqBody          = Nothing-      , sqStringToSign  = stringToSign-      }-    where-      stringToSign  = fmtRfc822Time (signatureTime sd)-      credentials   = signatureCredentials sd-      accessKeyId   = accessKeyID credentials-      authorization = B.concat [ "AWS3-HTTPS AWSAccessKeyId="-                               , accessKeyId-                               , ", Algorithm=HmacSHA256, Signature="-                               , signature credentials HmacSHA256 stringToSign-                               ]-      query' = ("AWSAccessKeyId", accessKeyId) : query

@@ -1,30 +0,0 @@-{-# LANGUAGE MultiParamTypeClasses, FlexibleInstances, FlexibleContexts, OverloadedStrings, TypeFamilies #-}-module Aws.Ses.Response-where--import           Aws.Response-import           Aws.Ses.Error-import           Aws.Ses.Metadata-import           Aws.Xml-import           Data.IORef-import           Data.Maybe-import           Text.XML.Cursor            (($/), ($//))-import qualified Control.Failure            as F-import qualified Text.XML.Cursor            as Cu--sesResponseConsumer :: (Cu.Cursor -> Response SesMetadata a)-                    -> IORef SesMetadata-                    -> HTTPResponseConsumer a-sesResponseConsumer inner metadataRef status = xmlCursorConsumer parse metadataRef status-    where-      parse cursor = do-        let requestId' = listToMaybe $ cursor $// elContent "RequestID"-        tellMetadata $ SesMetadata requestId'-        case cursor $/ Cu.laxElement "Error" of-          []      -> inner cursor-          (err:_) -> fromError err--      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

@@ -1,71 +0,0 @@-{-# LANGUAGE TypeFamilies, OverloadedStrings #-}-module Aws.Signature-where-  -import           Aws.Credentials-import           Aws.Query-import           Data.Time-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.Serialize         as Serialize--data TimeInfo-    = Timestamp-    | ExpiresAt { fromExpiresAt :: UTCTime }-    | ExpiresIn { fromExpiresIn :: NominalDiffTime }-    deriving (Show)--data AbsoluteTimeInfo-    = AbsoluteTimestamp { fromAbsoluteTimestamp :: UTCTime }-    | AbsoluteExpires { fromAbsoluteExpires :: UTCTime }-    deriving (Show)--fromAbsoluteTimeInfo :: AbsoluteTimeInfo -> UTCTime-fromAbsoluteTimeInfo (AbsoluteTimestamp time) = time-fromAbsoluteTimeInfo (AbsoluteExpires time) = time--makeAbsoluteTimeInfo :: TimeInfo -> UTCTime -> AbsoluteTimeInfo-makeAbsoluteTimeInfo Timestamp     now = AbsoluteTimestamp now-makeAbsoluteTimeInfo (ExpiresAt t) _   = AbsoluteExpires t-makeAbsoluteTimeInfo (ExpiresIn s) now = AbsoluteExpires $ addUTCTime s now--data SignatureData-    = SignatureData {-        signatureTimeInfo :: AbsoluteTimeInfo-      , signatureTime :: UTCTime-      , signatureCredentials :: Credentials-      }--signatureData :: TimeInfo -> Credentials -> IO SignatureData-signatureData rti cr = do-  now <- getCurrentTime-  let ti = makeAbsoluteTimeInfo rti now-  return SignatureData { signatureTimeInfo = ti, signatureTime = now, signatureCredentials = cr }--class SignQuery r where-    type Info r :: *-    signQuery :: r -> Info r -> SignatureData -> SignedQuery--data AuthorizationHash-    = HmacSHA1-    | HmacSHA256-    deriving (Show)--amzHash :: AuthorizationHash -> B.ByteString-amzHash HmacSHA1 = "HmacSHA1"-amzHash HmacSHA256 = "HmacSHA256"--signature :: Credentials -> AuthorizationHash -> B.ByteString -> B.ByteString-signature cr ah input = Base64.encode sig-    where-      sig = case ah of-              HmacSHA1 -> computeSig (undefined :: SHA1.SHA1)-              HmacSHA256 -> computeSig (undefined :: SHA256.SHA256)-      computeSig :: Crypto.Hash c d => d -> B.ByteString-      computeSig t = Serialize.encode (HMAC.hmac' key input `asTypeOf` t)-      key :: HMAC.MacKey c d-      key = HMAC.MacKey (secretAccessKey cr)

@@ -1,19 +1,9 @@ module Aws.SimpleDb (   module Aws.SimpleDb.Commands-, module Aws.SimpleDb.Error-, module Aws.SimpleDb.Info-, module Aws.SimpleDb.Metadata-, module Aws.SimpleDb.Model-, module Aws.SimpleDb.Query-, module Aws.SimpleDb.Response+, module Aws.SimpleDb.Core ) where  import Aws.SimpleDb.Commands-import Aws.SimpleDb.Error-import Aws.SimpleDb.Info-import Aws.SimpleDb.Metadata-import Aws.SimpleDb.Model-import Aws.SimpleDb.Query-import Aws.SimpleDb.Response+import Aws.SimpleDb.Core

@@ -1,25 +1,11 @@ module Aws.SimpleDb.Commands (-  module Aws.SimpleDb.Commands.BatchDeleteAttributes-, module Aws.SimpleDb.Commands.BatchPutAttributes-, module Aws.SimpleDb.Commands.CreateDomain-, module Aws.SimpleDb.Commands.DeleteAttributes-, module Aws.SimpleDb.Commands.DeleteDomain-, module Aws.SimpleDb.Commands.DomainMetadata-, module Aws.SimpleDb.Commands.GetAttributes-, module Aws.SimpleDb.Commands.ListDomains-, module Aws.SimpleDb.Commands.PutAttributes+  module Aws.SimpleDb.Commands.Attributes+, module Aws.SimpleDb.Commands.Domain , module Aws.SimpleDb.Commands.Select ) where -import Aws.SimpleDb.Commands.BatchDeleteAttributes-import Aws.SimpleDb.Commands.BatchPutAttributes-import Aws.SimpleDb.Commands.CreateDomain-import Aws.SimpleDb.Commands.DeleteAttributes-import Aws.SimpleDb.Commands.DeleteDomain-import Aws.SimpleDb.Commands.DomainMetadata-import Aws.SimpleDb.Commands.GetAttributes-import Aws.SimpleDb.Commands.ListDomains-import Aws.SimpleDb.Commands.PutAttributes+import Aws.SimpleDb.Commands.Attributes+import Aws.SimpleDb.Commands.Domain import Aws.SimpleDb.Commands.Select

@@ -0,0 +1,179 @@+{-# LANGUAGE RecordWildCards, TypeFamilies, FlexibleInstances, MultiParamTypeClasses, OverloadedStrings, TupleSections #-}+module Aws.SimpleDb.Commands.Attributes where++import           Aws.Core+import           Aws.SimpleDb.Core+import           Control.Applicative+import           Control.Monad+import           Data.Maybe+import           Text.XML.Cursor            (($//), (&|))+import qualified Data.Text                  as T+import qualified Data.Text.Encoding         as T+import qualified Text.XML.Cursor            as Cu++data GetAttributes+    = GetAttributes {+        gaItemName :: T.Text+      , gaAttributeName :: Maybe T.Text+      , gaConsistentRead :: Bool+      , gaDomainName :: T.Text+      }+    deriving (Show)++data GetAttributesResponse+    = GetAttributesResponse {+        garAttributes :: [Attribute T.Text]+      }+    deriving (Show)++getAttributes :: T.Text -> T.Text -> GetAttributes+getAttributes item domain = GetAttributes { gaItemName = item, gaAttributeName = Nothing, gaConsistentRead = False, gaDomainName = domain }++-- | ServiceConfiguration: 'SdbConfiguration'+instance SignQuery GetAttributes where+    type ServiceConfiguration GetAttributes = SdbConfiguration+    signQuery GetAttributes{..}+        = sdbSignQuery $+            [("Action", "GetAttributes"), ("ItemName", T.encodeUtf8 gaItemName), ("DomainName", T.encodeUtf8 gaDomainName)] +++            maybeToList (("AttributeName",) <$> T.encodeUtf8 <$> gaAttributeName) +++            (guard gaConsistentRead >> [("ConsistentRead", awsTrue)])++instance ResponseConsumer r GetAttributesResponse where+    type ResponseMetadata GetAttributesResponse = SdbMetadata+    responseConsumer _ = sdbResponseConsumer parse+        where parse cursor = do+                sdbCheckResponseType () "GetAttributesResponse" cursor+                attributes <- sequence $ cursor $// Cu.laxElement "Attribute" &| readAttribute+                return $ GetAttributesResponse attributes++instance Transaction GetAttributes GetAttributesResponse++data PutAttributes+    = PutAttributes {+        paItemName :: T.Text+      , paAttributes :: [Attribute SetAttribute]+      , paExpected :: [Attribute ExpectedAttribute]+      , paDomainName :: T.Text+      }+    deriving (Show)++data PutAttributesResponse+    = PutAttributesResponse+    deriving (Show)+             +putAttributes :: T.Text -> [Attribute SetAttribute] -> T.Text -> PutAttributes+putAttributes item attributes domain = PutAttributes { +                                         paItemName = item+                                       , paAttributes = attributes+                                       , paExpected = []+                                       , paDomainName = domain +                                       }+                                       +-- | ServiceConfiguration: 'SdbConfiguration'+instance SignQuery PutAttributes where+    type ServiceConfiguration PutAttributes = SdbConfiguration+    signQuery PutAttributes{..}+        = sdbSignQuery $ +            [("Action", "PutAttributes"), ("ItemName", T.encodeUtf8 paItemName), ("DomainName", T.encodeUtf8 paDomainName)] +++            queryList (attributeQuery setAttributeQuery) "Attribute" paAttributes +++            queryList (attributeQuery expectedAttributeQuery) "Expected" paExpected++instance ResponseConsumer r PutAttributesResponse where+    type ResponseMetadata PutAttributesResponse = SdbMetadata+    responseConsumer _ = sdbResponseConsumer $ sdbCheckResponseType PutAttributesResponse "PutAttributesResponse"++instance Transaction PutAttributes PutAttributesResponse++data DeleteAttributes+    = DeleteAttributes {+        daItemName :: T.Text+      , daAttributes :: [Attribute DeleteAttribute]+      , daExpected :: [Attribute ExpectedAttribute]+      , daDomainName :: T.Text+      }+    deriving (Show)++data DeleteAttributesResponse+    = DeleteAttributesResponse+    deriving (Show)+             +deleteAttributes :: T.Text -> [Attribute DeleteAttribute] -> T.Text -> DeleteAttributes+deleteAttributes item attributes domain = DeleteAttributes { +                                         daItemName = item+                                       , daAttributes = attributes+                                       , daExpected = []+                                       , daDomainName = domain +                                       }+                                       +-- | ServiceConfiguration: 'SdbConfiguration'+instance SignQuery DeleteAttributes where+    type ServiceConfiguration DeleteAttributes = SdbConfiguration+    signQuery DeleteAttributes{..}+        = sdbSignQuery $ +            [("Action", "DeleteAttributes"), ("ItemName", T.encodeUtf8 daItemName), ("DomainName", T.encodeUtf8 daDomainName)] +++            queryList (attributeQuery deleteAttributeQuery) "Attribute" daAttributes +++            queryList (attributeQuery expectedAttributeQuery) "Expected" daExpected++instance ResponseConsumer r DeleteAttributesResponse where+    type ResponseMetadata DeleteAttributesResponse = SdbMetadata+    responseConsumer _ = sdbResponseConsumer $ sdbCheckResponseType DeleteAttributesResponse "DeleteAttributesResponse"++instance Transaction DeleteAttributes DeleteAttributesResponse++data BatchPutAttributes+    = BatchPutAttributes {+        bpaItems :: [Item [Attribute SetAttribute]]+      , bpaDomainName :: T.Text+      }+    deriving (Show)++data BatchPutAttributesResponse+    = BatchPutAttributesResponse+    deriving (Show)+             +batchPutAttributes :: [Item [Attribute SetAttribute]] -> T.Text -> BatchPutAttributes+batchPutAttributes items domain = BatchPutAttributes { bpaItems = items, bpaDomainName = domain }++-- | ServiceConfiguration: 'SdbConfiguration'+instance SignQuery BatchPutAttributes where+    type ServiceConfiguration BatchPutAttributes = SdbConfiguration+    signQuery BatchPutAttributes{..}+        = sdbSignQuery $ +            [("Action", "BatchPutAttributes")+            , ("DomainName", T.encodeUtf8 bpaDomainName)] +++            queryList (itemQuery $ queryList (attributeQuery setAttributeQuery) "Attribute") "Item" bpaItems++instance ResponseConsumer r BatchPutAttributesResponse where+    type ResponseMetadata BatchPutAttributesResponse = SdbMetadata+    responseConsumer _ = sdbResponseConsumer $ sdbCheckResponseType BatchPutAttributesResponse "BatchPutAttributesResponse"++instance Transaction BatchPutAttributes BatchPutAttributesResponse++data BatchDeleteAttributes+    = BatchDeleteAttributes {+        bdaItems :: [Item [Attribute DeleteAttribute]]+      , bdaDomainName :: T.Text+      }+    deriving (Show)++data BatchDeleteAttributesResponse+    = BatchDeleteAttributesResponse+    deriving (Show)+             +batchDeleteAttributes :: [Item [Attribute DeleteAttribute]] -> T.Text -> BatchDeleteAttributes+batchDeleteAttributes items domain = BatchDeleteAttributes { bdaItems = items, bdaDomainName = domain }++-- | ServiceConfiguration: 'SdbConfiguration'+instance SignQuery BatchDeleteAttributes where+    type ServiceConfiguration BatchDeleteAttributes = SdbConfiguration+    signQuery BatchDeleteAttributes{..}+        = sdbSignQuery $ +            [("Action", "BatchDeleteAttributes")+            , ("DomainName", T.encodeUtf8 bdaDomainName)] +++            queryList (itemQuery $ queryList (attributeQuery deleteAttributeQuery) "Attribute") "Item" bdaItems++instance ResponseConsumer r BatchDeleteAttributesResponse where+    type ResponseMetadata BatchDeleteAttributesResponse = SdbMetadata+    responseConsumer _ = sdbResponseConsumer $ sdbCheckResponseType BatchDeleteAttributesResponse "BatchDeleteAttributesResponse"++instance Transaction BatchDeleteAttributes BatchDeleteAttributesResponse

@@ -1,43 +0,0 @@-{-# LANGUAGE RecordWildCards, TypeFamilies, FlexibleInstances, MultiParamTypeClasses, OverloadedStrings #-}-module Aws.SimpleDb.Commands.BatchDeleteAttributes-where--import           Aws.Response-import           Aws.Signature-import           Aws.SimpleDb.Info-import           Aws.SimpleDb.Metadata-import           Aws.SimpleDb.Model-import           Aws.SimpleDb.Query-import           Aws.SimpleDb.Response-import           Aws.Transaction-import           Aws.Util-import qualified Data.Text             as T-import qualified Data.Text.Encoding    as T--data BatchDeleteAttributes-    = BatchDeleteAttributes {-        bdaItems :: [Item [Attribute DeleteAttribute]]-      , bdaDomainName :: T.Text-      }-    deriving (Show)--data BatchDeleteAttributesResponse-    = BatchDeleteAttributesResponse-    deriving (Show)-             -batchDeleteAttributes :: [Item [Attribute DeleteAttribute]] -> T.Text -> BatchDeleteAttributes-batchDeleteAttributes items domain = BatchDeleteAttributes { bdaItems = items, bdaDomainName = domain }--instance SignQuery BatchDeleteAttributes where-    type Info BatchDeleteAttributes = SdbInfo-    signQuery BatchDeleteAttributes{..}-        = sdbSignQuery $ -            [("Action", "BatchDeleteAttributes")-            , ("DomainName", T.encodeUtf8 bdaDomainName)] ++-            queryList (itemQuery $ queryList (attributeQuery deleteAttributeQuery) "Attribute") "Item" bdaItems--instance ResponseConsumer r BatchDeleteAttributesResponse where-    type ResponseMetadata BatchDeleteAttributesResponse = SdbMetadata-    responseConsumer _ = sdbResponseConsumer $ sdbCheckResponseType BatchDeleteAttributesResponse "BatchDeleteAttributesResponse"--instance Transaction BatchDeleteAttributes BatchDeleteAttributesResponse

@@ -1,43 +0,0 @@-{-# LANGUAGE RecordWildCards, TypeFamilies, FlexibleInstances, MultiParamTypeClasses, OverloadedStrings #-}-module Aws.SimpleDb.Commands.BatchPutAttributes-where--import           Aws.Response-import           Aws.Signature-import           Aws.SimpleDb.Info-import           Aws.SimpleDb.Metadata-import           Aws.SimpleDb.Model-import           Aws.SimpleDb.Query-import           Aws.SimpleDb.Response-import           Aws.Transaction-import           Aws.Util-import qualified Data.Text             as T-import qualified Data.Text.Encoding    as T--data BatchPutAttributes-    = BatchPutAttributes {-        bpaItems :: [Item [Attribute SetAttribute]]-      , bpaDomainName :: T.Text-      }-    deriving (Show)--data BatchPutAttributesResponse-    = BatchPutAttributesResponse-    deriving (Show)-             -batchPutAttributes :: [Item [Attribute SetAttribute]] -> T.Text -> BatchPutAttributes-batchPutAttributes items domain = BatchPutAttributes { bpaItems = items, bpaDomainName = domain }--instance SignQuery BatchPutAttributes where-    type Info BatchPutAttributes = SdbInfo-    signQuery BatchPutAttributes{..}-        = sdbSignQuery $ -            [("Action", "BatchPutAttributes")-            , ("DomainName", T.encodeUtf8 bpaDomainName)] ++-            queryList (itemQuery $ queryList (attributeQuery setAttributeQuery) "Attribute") "Item" bpaItems--instance ResponseConsumer r BatchPutAttributesResponse where-    type ResponseMetadata BatchPutAttributesResponse = SdbMetadata-    responseConsumer _ = sdbResponseConsumer $ sdbCheckResponseType BatchPutAttributesResponse "BatchPutAttributesResponse"--instance Transaction BatchPutAttributes BatchPutAttributesResponse

@@ -1,36 +0,0 @@-{-# LANGUAGE RecordWildCards, TypeFamilies, FlexibleInstances, MultiParamTypeClasses, OverloadedStrings #-}-module Aws.SimpleDb.Commands.CreateDomain-where--import           Aws.Response-import           Aws.Signature-import           Aws.SimpleDb.Info-import           Aws.SimpleDb.Metadata-import           Aws.SimpleDb.Query-import           Aws.SimpleDb.Response-import           Aws.Transaction-import qualified Data.Text             as T-import qualified Data.Text.Encoding    as T--data CreateDomain-    = CreateDomain {-        cdDomainName :: T.Text-      }-    deriving (Show)--data CreateDomainResponse -    = CreateDomainResponse-    deriving (Show)-             -createDomain :: T.Text -> CreateDomain-createDomain name = CreateDomain { cdDomainName = name }-             -instance SignQuery CreateDomain where-    type Info CreateDomain = SdbInfo-    signQuery CreateDomain{..} = sdbSignQuery [("Action", "CreateDomain"), ("DomainName", T.encodeUtf8 cdDomainName)]--instance ResponseConsumer r CreateDomainResponse where-    type ResponseMetadata CreateDomainResponse = SdbMetadata-    responseConsumer _ = sdbResponseConsumer $ sdbCheckResponseType CreateDomainResponse "CreateDomainResponse"--instance Transaction CreateDomain CreateDomainResponse

@@ -1,50 +0,0 @@-{-# LANGUAGE RecordWildCards, TypeFamilies, FlexibleInstances, MultiParamTypeClasses, OverloadedStrings #-}-module Aws.SimpleDb.Commands.DeleteAttributes-where--import           Aws.Response-import           Aws.Signature-import           Aws.SimpleDb.Info-import           Aws.SimpleDb.Metadata-import           Aws.SimpleDb.Model-import           Aws.SimpleDb.Query-import           Aws.SimpleDb.Response-import           Aws.Transaction-import           Aws.Util-import qualified Data.Text             as T-import qualified Data.Text.Encoding    as T--data DeleteAttributes-    = DeleteAttributes {-        daItemName :: T.Text-      , daAttributes :: [Attribute DeleteAttribute]-      , daExpected :: [Attribute ExpectedAttribute]-      , daDomainName :: T.Text-      }-    deriving (Show)--data DeleteAttributesResponse-    = DeleteAttributesResponse-    deriving (Show)-             -deleteAttributes :: T.Text -> [Attribute DeleteAttribute] -> T.Text -> DeleteAttributes-deleteAttributes item attributes domain = DeleteAttributes { -                                         daItemName = item-                                       , daAttributes = attributes-                                       , daExpected = []-                                       , daDomainName = domain -                                       }-                                       -instance SignQuery DeleteAttributes where-    type Info DeleteAttributes = SdbInfo-    signQuery DeleteAttributes{..}-        = sdbSignQuery $ -            [("Action", "DeleteAttributes"), ("ItemName", T.encodeUtf8 daItemName), ("DomainName", T.encodeUtf8 daDomainName)] ++-            queryList (attributeQuery deleteAttributeQuery) "Attribute" daAttributes ++-            queryList (attributeQuery expectedAttributeQuery) "Expected" daExpected--instance ResponseConsumer r DeleteAttributesResponse where-    type ResponseMetadata DeleteAttributesResponse = SdbMetadata-    responseConsumer _ = sdbResponseConsumer $ sdbCheckResponseType DeleteAttributesResponse "DeleteAttributesResponse"--instance Transaction DeleteAttributes DeleteAttributesResponse

@@ -1,36 +0,0 @@-{-# LANGUAGE RecordWildCards, TypeFamilies, FlexibleInstances, MultiParamTypeClasses, OverloadedStrings #-}-module Aws.SimpleDb.Commands.DeleteDomain-where--import           Aws.Response-import           Aws.Signature-import           Aws.SimpleDb.Info-import           Aws.SimpleDb.Metadata-import           Aws.SimpleDb.Query-import           Aws.SimpleDb.Response-import           Aws.Transaction-import qualified Data.Text             as T-import qualified Data.Text.Encoding    as T--data DeleteDomain-    = DeleteDomain {-        ddDomainName :: T.Text-      }-    deriving (Show)--data DeleteDomainResponse-    = DeleteDomainResponse-    deriving (Show)-             -deleteDomain :: T.Text -> DeleteDomain-deleteDomain name = DeleteDomain { ddDomainName = name }-             -instance SignQuery DeleteDomain where-    type Info DeleteDomain = SdbInfo-    signQuery DeleteDomain{..} = sdbSignQuery [("Action", "DeleteDomain"), ("DomainName", T.encodeUtf8 ddDomainName)]--instance ResponseConsumer r DeleteDomainResponse where-    type ResponseMetadata DeleteDomainResponse = SdbMetadata-    responseConsumer _ = sdbResponseConsumer $ sdbCheckResponseType DeleteDomainResponse "DeleteDomainResponse"--instance Transaction DeleteDomain DeleteDomainResponse

@@ -0,0 +1,140 @@+{-# LANGUAGE RecordWildCards, TypeFamilies, FlexibleInstances, MultiParamTypeClasses, OverloadedStrings, TupleSections #-}+module Aws.SimpleDb.Commands.Domain where++import           Aws.Core+import           Aws.SimpleDb.Core+import           Control.Applicative+import           Data.Maybe+import           Data.Time+import           Data.Time.Clock.POSIX+import           Text.XML.Cursor       (($//), (&|))+import qualified Data.Text             as T+import qualified Data.Text.Encoding    as T++data CreateDomain+    = CreateDomain {+        cdDomainName :: T.Text+      }+    deriving (Show)++data CreateDomainResponse +    = CreateDomainResponse+    deriving (Show)+             +createDomain :: T.Text -> CreateDomain+createDomain name = CreateDomain { cdDomainName = name }+             +-- | ServiceConfiguration: 'SdbConfiguration'+instance SignQuery CreateDomain where+    type ServiceConfiguration CreateDomain = SdbConfiguration+    signQuery CreateDomain{..} = sdbSignQuery [("Action", "CreateDomain"), ("DomainName", T.encodeUtf8 cdDomainName)]++instance ResponseConsumer r CreateDomainResponse where+    type ResponseMetadata CreateDomainResponse = SdbMetadata+    responseConsumer _ = sdbResponseConsumer $ sdbCheckResponseType CreateDomainResponse "CreateDomainResponse"++instance Transaction CreateDomain CreateDomainResponse++data DeleteDomain+    = DeleteDomain {+        ddDomainName :: T.Text+      }+    deriving (Show)++data DeleteDomainResponse+    = DeleteDomainResponse+    deriving (Show)+             +deleteDomain :: T.Text -> DeleteDomain+deleteDomain name = DeleteDomain { ddDomainName = name }+             +-- | ServiceConfiguration: 'SdbConfiguration'+instance SignQuery DeleteDomain where+    type ServiceConfiguration DeleteDomain = SdbConfiguration+    signQuery DeleteDomain{..} = sdbSignQuery [("Action", "DeleteDomain"), ("DomainName", T.encodeUtf8 ddDomainName)]++instance ResponseConsumer r DeleteDomainResponse where+    type ResponseMetadata DeleteDomainResponse = SdbMetadata+    responseConsumer _ = sdbResponseConsumer $ sdbCheckResponseType DeleteDomainResponse "DeleteDomainResponse"++instance Transaction DeleteDomain DeleteDomainResponse++data DomainMetadata+    = DomainMetadata {+        dmDomainName :: T.Text+      }+    deriving (Show)++data DomainMetadataResponse+    = DomainMetadataResponse {+        dmrTimestamp :: UTCTime+      , dmrItemCount :: Integer+      , dmrAttributeValueCount :: Integer+      , dmrAttributeNameCount :: Integer+      , dmrItemNamesSizeBytes :: Integer+      , dmrAttributeValuesSizeBytes :: Integer+      , dmrAttributeNamesSizeBytes :: Integer+      }+    deriving (Show)++domainMetadata :: T.Text -> DomainMetadata+domainMetadata name = DomainMetadata { dmDomainName = name }++-- | ServiceConfiguration: 'SdbConfiguration'+instance SignQuery DomainMetadata where+    type ServiceConfiguration DomainMetadata = SdbConfiguration+    signQuery DomainMetadata{..} = sdbSignQuery [("Action", "DomainMetadata"), ("DomainName", T.encodeUtf8 dmDomainName)]++instance ResponseConsumer r DomainMetadataResponse where+    type ResponseMetadata DomainMetadataResponse = SdbMetadata++    responseConsumer _ = sdbResponseConsumer parse+        where parse cursor = do+                sdbCheckResponseType () "DomainMetadataResponse" cursor+                dmrTimestamp <- forceM "Timestamp expected" $ cursor $// elCont "Timestamp" &| (fmap posixSecondsToUTCTime . readInt)+                dmrItemCount <- forceM "ItemCount expected" $ cursor $// elCont "ItemCount" &| readInt+                dmrAttributeValueCount <- forceM "AttributeValueCount expected" $ cursor $// elCont "AttributeValueCount" &| readInt+                dmrAttributeNameCount <- forceM "AttributeNameCount expected" $ cursor $// elCont "AttributeNameCount" &| readInt+                dmrItemNamesSizeBytes <- forceM "ItemNamesSizeBytes expected" $ cursor $// elCont "ItemNamesSizeBytes" &| readInt+                dmrAttributeValuesSizeBytes <- forceM "AttributeValuesSizeBytes expected" $ cursor $// elCont "AttributeValuesSizeBytes" &| readInt+                dmrAttributeNamesSizeBytes <- forceM "AttributeNamesSizeBytes expected" $ cursor $// elCont "AttributeNamesSizeBytes" &| readInt+                return DomainMetadataResponse{..}++instance Transaction DomainMetadata DomainMetadataResponse++data ListDomains+    = ListDomains {+        ldMaxNumberOfDomains :: Maybe Int+      , ldNextToken :: Maybe T.Text+      }+    deriving (Show)++data ListDomainsResponse+    = ListDomainsResponse {+        ldrDomainNames :: [T.Text]+      , ldrNextToken :: Maybe T.Text+      }+    deriving (Show)++listDomains :: ListDomains+listDomains = ListDomains { ldMaxNumberOfDomains = Nothing, ldNextToken = Nothing }++-- | ServiceConfiguration: 'SdbConfiguration'+instance SignQuery ListDomains where+    type ServiceConfiguration ListDomains = SdbConfiguration+    signQuery ListDomains{..} = sdbSignQuery $ catMaybes [+                                  Just ("Action", "ListDomains")+                                , ("MaxNumberOfDomains",) . T.encodeUtf8 . T.pack . show <$> ldMaxNumberOfDomains+                                , ("NextToken",) . T.encodeUtf8 <$> ldNextToken+                                ]++instance ResponseConsumer r ListDomainsResponse where+    type ResponseMetadata ListDomainsResponse = SdbMetadata+    responseConsumer _ = sdbResponseConsumer parse+        where parse cursor = do+                sdbCheckResponseType () "ListDomainsResponse" cursor+                let names = cursor $// elContent "DomainName"+                let nextToken = listToMaybe $ cursor $// elContent "NextToken"+                return $ ListDomainsResponse names nextToken++instance Transaction ListDomains ListDomainsResponse

@@ -1,59 +0,0 @@-{-# LANGUAGE RecordWildCards, TypeFamilies, FlexibleInstances, MultiParamTypeClasses, OverloadedStrings #-}-module Aws.SimpleDb.Commands.DomainMetadata-where--import           Aws.Response-import           Aws.Signature-import           Aws.SimpleDb.Info-import           Aws.SimpleDb.Metadata-import           Aws.SimpleDb.Query-import           Aws.SimpleDb.Response-import           Aws.Transaction-import           Aws.Xml-import           Data.Time-import           Data.Time.Clock.POSIX-import           Text.XML.Cursor            (($//), (&|))-import qualified Data.Text                  as T-import qualified Data.Text.Encoding         as T--data DomainMetadata-    = DomainMetadata {-        dmDomainName :: T.Text-      }-    deriving (Show)--data DomainMetadataResponse-    = DomainMetadataResponse {-        dmrTimestamp :: UTCTime-      , dmrItemCount :: Integer-      , dmrAttributeValueCount :: Integer-      , dmrAttributeNameCount :: Integer-      , dmrItemNamesSizeBytes :: Integer-      , dmrAttributeValuesSizeBytes :: Integer-      , dmrAttributeNamesSizeBytes :: Integer-      }-    deriving (Show)--domainMetadata :: T.Text -> DomainMetadata-domainMetadata name = DomainMetadata { dmDomainName = name }--instance SignQuery DomainMetadata where-    type Info DomainMetadata = SdbInfo-    signQuery DomainMetadata{..} = sdbSignQuery [("Action", "DomainMetadata"), ("DomainName", T.encodeUtf8 dmDomainName)]--instance ResponseConsumer r DomainMetadataResponse where-    type ResponseMetadata DomainMetadataResponse = SdbMetadata--    responseConsumer _ = sdbResponseConsumer parse-        where parse cursor = do-                sdbCheckResponseType () "DomainMetadataResponse" cursor-                dmrTimestamp <- forceM "Timestamp expected" $ cursor $// elCont "Timestamp" &| (fmap posixSecondsToUTCTime . readInt)-                dmrItemCount <- forceM "ItemCount expected" $ cursor $// elCont "ItemCount" &| readInt-                dmrAttributeValueCount <- forceM "AttributeValueCount expected" $ cursor $// elCont "AttributeValueCount" &| readInt-                dmrAttributeNameCount <- forceM "AttributeNameCount expected" $ cursor $// elCont "AttributeNameCount" &| readInt-                dmrItemNamesSizeBytes <- forceM "ItemNamesSizeBytes expected" $ cursor $// elCont "ItemNamesSizeBytes" &| readInt-                dmrAttributeValuesSizeBytes <- forceM "AttributeValuesSizeBytes expected" $ cursor $// elCont "AttributeValuesSizeBytes" &| readInt-                dmrAttributeNamesSizeBytes <- forceM "AttributeNamesSizeBytes expected" $ cursor $// elCont "AttributeNamesSizeBytes" &| readInt-                return DomainMetadataResponse{..}--instance Transaction DomainMetadata DomainMetadataResponse

@@ -1,56 +0,0 @@-{-# LANGUAGE RecordWildCards, TypeFamilies, FlexibleInstances, MultiParamTypeClasses, OverloadedStrings, TupleSections #-}-module Aws.SimpleDb.Commands.GetAttributes-where--import           Aws.Response-import           Aws.Signature-import           Aws.SimpleDb.Info-import           Aws.SimpleDb.Metadata-import           Aws.SimpleDb.Model-import           Aws.SimpleDb.Query-import           Aws.SimpleDb.Response-import           Aws.Transaction-import           Aws.Util-import           Control.Applicative-import           Control.Monad-import           Data.Maybe-import           Text.XML.Cursor            (($//), (&|))-import qualified Data.Text                  as T-import qualified Data.Text.Encoding         as T-import qualified Text.XML.Cursor            as Cu--data GetAttributes-    = GetAttributes {-        gaItemName :: T.Text-      , gaAttributeName :: Maybe T.Text-      , gaConsistentRead :: Bool-      , gaDomainName :: T.Text-      }-    deriving (Show)--data GetAttributesResponse-    = GetAttributesResponse {-        garAttributes :: [Attribute T.Text]-      }-    deriving (Show)--getAttributes :: T.Text -> T.Text -> GetAttributes-getAttributes item domain = GetAttributes { gaItemName = item, gaAttributeName = Nothing, gaConsistentRead = False, gaDomainName = domain }--instance SignQuery GetAttributes where-    type Info GetAttributes = SdbInfo-    signQuery GetAttributes{..}-        = sdbSignQuery $-            [("Action", "GetAttributes"), ("ItemName", T.encodeUtf8 gaItemName), ("DomainName", T.encodeUtf8 gaDomainName)] ++-            maybeToList (("AttributeName",) <$> T.encodeUtf8 <$> gaAttributeName) ++-            (guard gaConsistentRead >> [("ConsistentRead", awsTrue)])--instance ResponseConsumer r GetAttributesResponse where-    type ResponseMetadata GetAttributesResponse = SdbMetadata-    responseConsumer _ = sdbResponseConsumer parse-        where parse cursor = do-                sdbCheckResponseType () "GetAttributesResponse" cursor-                attributes <- sequence $ cursor $// Cu.laxElement "Attribute" &| readAttribute-                return $ GetAttributesResponse attributes--instance Transaction GetAttributes GetAttributesResponse

@@ -1,53 +0,0 @@-{-# LANGUAGE RecordWildCards, TypeFamilies, FlexibleInstances, MultiParamTypeClasses, OverloadedStrings, TupleSections #-}-module Aws.SimpleDb.Commands.ListDomains-where--import           Aws.Response-import           Aws.Signature-import           Aws.SimpleDb.Info-import           Aws.SimpleDb.Metadata-import           Aws.SimpleDb.Query-import           Aws.SimpleDb.Response-import           Aws.Transaction-import           Aws.Xml-import           Control.Applicative-import           Data.Maybe-import           Text.XML.Cursor            (($//))-import qualified Data.Text                  as T-import qualified Data.Text.Encoding         as T--data ListDomains-    = ListDomains {-        ldMaxNumberOfDomains :: Maybe Int-      , ldNextToken :: Maybe T.Text-      }-    deriving (Show)--data ListDomainsResponse-    = ListDomainsResponse {-        ldrDomainNames :: [T.Text]-      , ldrNextToken :: Maybe T.Text-      }-    deriving (Show)--listDomains :: ListDomains-listDomains = ListDomains { ldMaxNumberOfDomains = Nothing, ldNextToken = Nothing }--instance SignQuery ListDomains where-    type Info ListDomains = SdbInfo-    signQuery ListDomains{..} = sdbSignQuery $ catMaybes [-                                  Just ("Action", "ListDomains")-                                , ("MaxNumberOfDomains",) . T.encodeUtf8 . T.pack . show <$> ldMaxNumberOfDomains-                                , ("NextToken",) . T.encodeUtf8 <$> ldNextToken-                                ]--instance ResponseConsumer r ListDomainsResponse where-    type ResponseMetadata ListDomainsResponse = SdbMetadata-    responseConsumer _ = sdbResponseConsumer parse-        where parse cursor = do-                sdbCheckResponseType () "ListDomainsResponse" cursor-                let names = cursor $// elContent "DomainName"-                let nextToken = listToMaybe $ cursor $// elContent "NextToken"-                return $ ListDomainsResponse names nextToken--instance Transaction ListDomains ListDomainsResponse

@@ -1,50 +0,0 @@-{-# LANGUAGE RecordWildCards, TypeFamilies, FlexibleInstances, MultiParamTypeClasses, OverloadedStrings #-}-module Aws.SimpleDb.Commands.PutAttributes-where--import           Aws.Response-import           Aws.Signature-import           Aws.SimpleDb.Info-import           Aws.SimpleDb.Metadata-import           Aws.SimpleDb.Model-import           Aws.SimpleDb.Query-import           Aws.SimpleDb.Response-import           Aws.Transaction-import           Aws.Util-import qualified Data.Text             as T-import qualified Data.Text.Encoding    as T--data PutAttributes-    = PutAttributes {-        paItemName :: T.Text-      , paAttributes :: [Attribute SetAttribute]-      , paExpected :: [Attribute ExpectedAttribute]-      , paDomainName :: T.Text-      }-    deriving (Show)--data PutAttributesResponse-    = PutAttributesResponse-    deriving (Show)-             -putAttributes :: T.Text -> [Attribute SetAttribute] -> T.Text -> PutAttributes-putAttributes item attributes domain = PutAttributes { -                                         paItemName = item-                                       , paAttributes = attributes-                                       , paExpected = []-                                       , paDomainName = domain -                                       }-                                       -instance SignQuery PutAttributes where-    type Info PutAttributes = SdbInfo-    signQuery PutAttributes{..}-        = sdbSignQuery $ -            [("Action", "PutAttributes"), ("ItemName", T.encodeUtf8 paItemName), ("DomainName", T.encodeUtf8 paDomainName)] ++-            queryList (attributeQuery setAttributeQuery) "Attribute" paAttributes ++-            queryList (attributeQuery expectedAttributeQuery) "Expected" paExpected--instance ResponseConsumer r PutAttributesResponse where-    type ResponseMetadata PutAttributesResponse = SdbMetadata-    responseConsumer _ = sdbResponseConsumer $ sdbCheckResponseType PutAttributesResponse "PutAttributesResponse"--instance Transaction PutAttributes PutAttributesResponse

@@ -2,16 +2,8 @@ module Aws.SimpleDb.Commands.Select where -import           Aws.Response-import           Aws.Signature-import           Aws.SimpleDb.Info-import           Aws.SimpleDb.Metadata-import           Aws.SimpleDb.Model-import           Aws.SimpleDb.Query-import           Aws.SimpleDb.Response-import           Aws.Transaction-import           Aws.Util-import           Aws.Xml+import           Aws.Core+import           Aws.SimpleDb.Core import           Control.Applicative import           Control.Monad import           Data.Maybe@@ -38,8 +30,9 @@ select :: T.Text -> Select select expr = Select { sSelectExpression = expr, sConsistentRead = False, sNextToken = Nothing } +-- | ServiceConfiguration: 'SdbConfiguration' instance SignQuery Select where-    type Info Select = SdbInfo+    type ServiceConfiguration Select = SdbConfiguration     signQuery Select{..}         = sdbSignQuery . catMaybes $             [ Just ("Action", "Select")

@@ -0,0 +1,228 @@+{-# 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 qualified Data.ByteString                as B+import qualified Data.ByteString.Base64         as Base64+import qualified Data.Text                      as T+import qualified Data.Text.Encoding             as T+import qualified Network.HTTP.Types             as HTTP+import qualified Text.XML.Cursor                as Cu++type ErrorCode = String++data SdbError+    = SdbError {+        sdbStatusCode :: HTTP.Status+      , sdbErrorCode :: ErrorCode+      , sdbErrorMessage :: String+      }+    deriving (Show, Typeable)++instance C.Exception SdbError++data SdbMetadata +    = SdbMetadata {+        requestId :: Maybe T.Text+      , boxUsage :: Maybe T.Text+      }+    deriving (Show, Typeable)++instance Monoid SdbMetadata where+    mempty = SdbMetadata Nothing Nothing+    SdbMetadata r1 b1 `mappend` SdbMetadata r2 b2 = SdbMetadata (r1 `mplus` r2) (b1 `mplus` b2)++data SdbConfiguration+    = SdbConfiguration {+        sdbiProtocol :: Protocol+      , sdbiHttpMethod :: Method+      , sdbiHost :: B.ByteString+      , sdbiPort :: Int+      }+    deriving (Show)++instance DefaultServiceConfiguration SdbConfiguration where+  defaultConfiguration = sdbHttpsPost sdbUsEast+  defaultConfigurationUri = sdbHttpsGet sdbUsEast+  +  debugConfiguration = sdbHttpPost sdbUsEast+  debugConfigurationUri = sdbHttpGet sdbUsEast+             +sdbUsEast :: B.ByteString+sdbUsEast = "sdb.amazonaws.com" ++sdbUsWest :: B.ByteString+sdbUsWest = "sdb.us-west-1.amazonaws.com"++sdbEuWest :: B.ByteString+sdbEuWest = "sdb.eu-west-1.amazonaws.com"++sdbApSoutheast :: B.ByteString+sdbApSoutheast = "sdb.ap-southeast-1.amazonaws.com"++sdbApNortheast :: B.ByteString+sdbApNortheast = "sdb.ap-northeast-1.amazonaws.com"+             +sdbHttpGet :: B.ByteString -> SdbConfiguration+sdbHttpGet endpoint = SdbConfiguration HTTP Get endpoint (defaultPort HTTP)+                          +sdbHttpPost :: B.ByteString -> SdbConfiguration+sdbHttpPost endpoint = SdbConfiguration HTTP PostQuery endpoint (defaultPort HTTP)+              +sdbHttpsGet :: B.ByteString -> SdbConfiguration+sdbHttpsGet endpoint = SdbConfiguration HTTPS Get endpoint (defaultPort HTTPS)+             +sdbHttpsPost :: B.ByteString -> SdbConfiguration+sdbHttpsPost endpoint = SdbConfiguration HTTPS PostQuery endpoint (defaultPort HTTPS)++sdbSignQuery :: [(B.ByteString, B.ByteString)] -> SdbConfiguration -> SignatureData -> SignedQuery+sdbSignQuery q si sd+    = SignedQuery {+        sqMethod = method+      , sqProtocol = sdbiProtocol si+      , sqHost = host+      , sqPort = sdbiPort si+      , sqPath = path+      , sqQuery = sq+      , sqDate = Just $ signatureTime sd+      , sqAuthorization = Nothing+      , sqContentType = Nothing+      , sqContentMd5 = Nothing+      , sqAmzHeaders = []+      , sqOtherHeaders = []+      , sqBody = Nothing+      , sqStringToSign = stringToSign+      }+    where+      ah = HmacSHA256+      q' = HTTP.simpleQueryToQuery . sort $ q ++ ("Version", "2009-04-15") : queryAuth+      ti = signatureTimeInfo sd+      cr = signatureCredentials sd+      queryAuth = [case ti of+                     AbsoluteTimestamp time -> ("Timestamp", fmtAmzTime time)+                     AbsoluteExpires   time -> ("Expires", fmtAmzTime time)+                  , ("AWSAccessKeyId", accessKeyID cr)+                  , ("SignatureMethod", amzHash ah)+                  , ("SignatureVersion", "2")+                  ]+      sq = ("Signature", Just sig) : q'+      method = sdbiHttpMethod si+      host = sdbiHost si+      path = "/"+      sig = signature cr ah stringToSign+      stringToSign = Blaze.toByteString . mconcat $ +                     intersperse (Blaze8.fromChar '\n')+                       [Blaze.copyByteString $ httpMethod method+                       , Blaze.copyByteString $ host+                       , Blaze.copyByteString $ path+                       , HTTP.renderQueryBuilder False q']++sdbResponseConsumer :: (Cu.Cursor -> Response SdbMetadata a)+                    -> IORef SdbMetadata+                    -> HTTPResponseConsumer a+sdbResponseConsumer inner metadataRef status headers source+    = xmlCursorConsumer parse metadataRef status headers source+    where parse cursor+              = do let requestId' = listToMaybe $ cursor $// elContent "RequestID"+                   let boxUsage' = listToMaybe $ cursor $// elContent "BoxUsage"+                   tellMetadata $ SdbMetadata requestId' boxUsage'+                   case cursor $/ Cu.laxElement "Error" of+                     []      -> inner cursor+                     (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++class SdbFromResponse a where+    sdbFromResponse :: Cu.Cursor -> Response SdbMetadata a++sdbCheckResponseType :: F.Failure XmlException m => a -> T.Text -> Cu.Cursor -> m a+sdbCheckResponseType a n c = do _ <- force ("Expected response type " ++ T.unpack n) (Cu.laxElement n c)+                                return a++decodeBase64 :: F.Failure XmlException m => Cu.Cursor -> m T.Text+decodeBase64 cursor =+  let encoded = T.concat $ cursor $/ Cu.content+      encoding = listToMaybe $ cursor $| Cu.laxAttribute "encoding" &| T.toCaseFold+  in+    case encoding of+      Nothing -> return encoded+      Just "base64" -> case Base64.decode . T.encodeUtf8 $ encoded of+                         Left msg -> F.failure $ XmlException ("Invalid Base64 data: " ++ msg)+                         Right x -> return $ T.decodeUtf8 x+      Just actual -> F.failure $ XmlException ("Unrecognized encoding " ++ T.unpack actual)++data Attribute a+    = ForAttribute { attributeName :: T.Text, attributeData :: a }+    deriving (Show)++readAttribute :: F.Failure XmlException m => Cu.Cursor -> m (Attribute T.Text)+readAttribute cursor = do+  name <- forceM "Missing Name" $ cursor $/ Cu.laxElement "Name" &| decodeBase64+  value <- forceM "Missing Value" $ cursor $/ Cu.laxElement "Value" &| decodeBase64+  return $ ForAttribute name value++data SetAttribute+    = SetAttribute { setAttribute :: T.Text, isReplaceAttribute :: Bool }+    deriving (Show)++attributeQuery :: (a -> [(B.ByteString, B.ByteString)]) -> Attribute a -> [(B.ByteString, B.ByteString)]+attributeQuery  f (ForAttribute name x) =  ("Name", T.encodeUtf8 name) : f x++addAttribute :: T.Text -> T.Text -> Attribute SetAttribute+addAttribute name value = ForAttribute name (SetAttribute value False)++replaceAttribute :: T.Text -> T.Text -> Attribute SetAttribute+replaceAttribute name value = ForAttribute name (SetAttribute value True)++setAttributeQuery :: SetAttribute -> [(B.ByteString, B.ByteString)]+setAttributeQuery (SetAttribute value replace)+    = ("Value", T.encodeUtf8 value) : [("Replace", awsTrue) | replace]++data DeleteAttribute+    = DeleteAttribute+    | ValuedDeleteAttribute { deleteAttributeValue :: T.Text }+    deriving (Show)++deleteAttributeQuery :: DeleteAttribute -> [(B.ByteString, B.ByteString)]+deleteAttributeQuery DeleteAttribute = []+deleteAttributeQuery (ValuedDeleteAttribute value) = [("Value", T.encodeUtf8 value)]++data ExpectedAttribute+    = ExpectedValue { expectedAttributeValue :: T.Text }+    | ExpectedExists { expectedAttributeExists :: Bool }+    deriving (Show)++expectedValue :: T.Text -> T.Text -> Attribute ExpectedAttribute+expectedValue name value = ForAttribute name (ExpectedValue value)++expectedExists :: T.Text -> Bool -> Attribute ExpectedAttribute+expectedExists name exists = ForAttribute name (ExpectedExists exists)++expectedAttributeQuery :: ExpectedAttribute -> [(B.ByteString, B.ByteString)]+expectedAttributeQuery (ExpectedValue value) = [("Value", T.encodeUtf8 value)]+expectedAttributeQuery (ExpectedExists exists) = [("Exists", awsBool exists)]++data Item a+    = Item { itemName :: T.Text, itemData :: a }+    deriving (Show)++readItem :: F.Failure XmlException m => Cu.Cursor -> m (Item [Attribute T.Text])+readItem cursor = do+  name <- force "Missing Name" <=< sequence $ cursor $/ Cu.laxElement "Name" &| decodeBase64+  attributes <- sequence $ cursor $/ Cu.laxElement "Attribute" &| readAttribute+  return $ Item name attributes++itemQuery :: (a -> [(B.ByteString, B.ByteString)]) -> Item a -> [(B.ByteString, B.ByteString)]+itemQuery f (Item name x) = ("ItemName", T.encodeUtf8 name) : f x

@@ -1,19 +0,0 @@-{-# LANGUAGE DeriveDataTypeable, MultiParamTypeClasses, RecordWildCards #-}-module Aws.SimpleDb.Error-where--import           Data.Typeable-import qualified Control.Exception         as C-import qualified Network.HTTP.Types        as HTTP--type ErrorCode = String--data SdbError-    = SdbError {-        sdbStatusCode :: HTTP.Status-      , sdbErrorCode :: ErrorCode-      , sdbErrorMessage :: String-      }-    deriving (Show, Typeable)--instance C.Exception SdbError

@@ -1,42 +0,0 @@-{-# LANGUAGE OverloadedStrings #-}-module Aws.SimpleDb.Info-where--import           Aws.Http-import qualified Data.ByteString as B--data SdbInfo-    = SdbInfo {-        sdbiProtocol :: Protocol-      , sdbiHttpMethod :: Method-      , sdbiHost :: B.ByteString-      , sdbiPort :: Int-      }-    deriving (Show)-             -sdbUsEast :: B.ByteString-sdbUsEast = "sdb.amazonaws.com" --sdbUsWest :: B.ByteString-sdbUsWest = "sdb.us-west-1.amazonaws.com"--sdbEuWest :: B.ByteString-sdbEuWest = "sdb.eu-west-1.amazonaws.com"--sdbApSoutheast :: B.ByteString-sdbApSoutheast = "sdb.ap-southeast-1.amazonaws.com"--sdbApNortheast :: B.ByteString-sdbApNortheast = "sdb.ap-northeast-1.amazonaws.com"-             -sdbHttpGet :: B.ByteString -> SdbInfo-sdbHttpGet endpoint = SdbInfo HTTP Get endpoint (defaultPort HTTP)-                          -sdbHttpPost :: B.ByteString -> SdbInfo-sdbHttpPost endpoint = SdbInfo HTTP PostQuery endpoint (defaultPort HTTP)-              -sdbHttpsGet :: B.ByteString -> SdbInfo-sdbHttpsGet endpoint = SdbInfo HTTPS Get endpoint (defaultPort HTTPS)-             -sdbHttpsPost :: B.ByteString -> SdbInfo-sdbHttpsPost endpoint = SdbInfo HTTPS PostQuery endpoint (defaultPort HTTPS)

@@ -1,19 +0,0 @@-{-# LANGUAGE DeriveDataTypeable #-}-module Aws.SimpleDb.Metadata-where-  -import           Control.Monad-import           Data.Monoid-import           Data.Typeable-import qualified Data.Text     as T--data SdbMetadata -    = SdbMetadata {-        requestId :: Maybe T.Text-      , boxUsage :: Maybe T.Text-      }-    deriving (Show, Typeable)--instance Monoid SdbMetadata where-    mempty = SdbMetadata Nothing Nothing-    SdbMetadata r1 b1 `mappend` SdbMetadata r2 b2 = SdbMetadata (r1 `mplus` r2) (b1 `mplus` b2)

@@ -1,78 +0,0 @@-{-# LANGUAGE OverloadedStrings, FlexibleContexts #-}-module Aws.SimpleDb.Model-where--import           Aws.SimpleDb.Response-import           Aws.Util-import           Aws.Xml-import           Control.Monad-import           Text.XML.Cursor            (($/), (&|))-import qualified Control.Failure            as F-import qualified Data.ByteString            as B-import qualified Data.Text                  as T-import qualified Data.Text.Encoding         as T-import qualified Text.XML.Cursor            as Cu--data Attribute a-    = ForAttribute { attributeName :: T.Text, attributeData :: a }-    deriving (Show)--readAttribute :: F.Failure XmlException m => Cu.Cursor -> m (Attribute T.Text)-readAttribute cursor = do-  name <- forceM "Missing Name" $ cursor $/ Cu.laxElement "Name" &| decodeBase64-  value <- forceM "Missing Value" $ cursor $/ Cu.laxElement "Value" &| decodeBase64-  return $ ForAttribute name value--data SetAttribute-    = SetAttribute { setAttribute :: T.Text, isReplaceAttribute :: Bool }-    deriving (Show)--attributeQuery :: (a -> [(B.ByteString, B.ByteString)]) -> Attribute a -> [(B.ByteString, B.ByteString)]-attributeQuery  f (ForAttribute name x) =  ("Name", T.encodeUtf8 name) : f x--addAttribute :: T.Text -> T.Text -> Attribute SetAttribute-addAttribute name value = ForAttribute name (SetAttribute value False)--replaceAttribute :: T.Text -> T.Text -> Attribute SetAttribute-replaceAttribute name value = ForAttribute name (SetAttribute value True)--setAttributeQuery :: SetAttribute -> [(B.ByteString, B.ByteString)]-setAttributeQuery (SetAttribute value replace)-    = ("Value", T.encodeUtf8 value) : [("Replace", awsTrue) | replace]--data DeleteAttribute-    = DeleteAttribute-    | ValuedDeleteAttribute { deleteAttributeValue :: T.Text }-    deriving (Show)--deleteAttributeQuery :: DeleteAttribute -> [(B.ByteString, B.ByteString)]-deleteAttributeQuery DeleteAttribute = []-deleteAttributeQuery (ValuedDeleteAttribute value) = [("Value", T.encodeUtf8 value)]--data ExpectedAttribute-    = ExpectedValue { expectedAttributeValue :: T.Text }-    | ExpectedExists { expectedAttributeExists :: Bool }-    deriving (Show)--expectedValue :: T.Text -> T.Text -> Attribute ExpectedAttribute-expectedValue name value = ForAttribute name (ExpectedValue value)--expectedExists :: T.Text -> Bool -> Attribute ExpectedAttribute-expectedExists name exists = ForAttribute name (ExpectedExists exists)--expectedAttributeQuery :: ExpectedAttribute -> [(B.ByteString, B.ByteString)]-expectedAttributeQuery (ExpectedValue value) = [("Value", T.encodeUtf8 value)]-expectedAttributeQuery (ExpectedExists exists) = [("Exists", awsBool exists)]--data Item a-    = Item { itemName :: T.Text, itemData :: a }-    deriving (Show)--readItem :: F.Failure XmlException m => Cu.Cursor -> m (Item [Attribute T.Text])-readItem cursor = do-  name <- force "Missing Name" <=< sequence $ cursor $/ Cu.laxElement "Name" &| decodeBase64-  attributes <- sequence $ cursor $/ Cu.laxElement "Attribute" &| readAttribute-  return $ Item name attributes--itemQuery :: (a -> [(B.ByteString, B.ByteString)]) -> Item a -> [(B.ByteString, B.ByteString)]-itemQuery f (Item name x) = ("ItemName", T.encodeUtf8 name) : f x

@@ -1,58 +0,0 @@-{-# LANGUAGE OverloadedStrings #-}-module Aws.SimpleDb.Query-where--import           Aws.Credentials-import           Aws.Http-import           Aws.Query-import           Aws.Signature-import           Aws.SimpleDb.Info-import           Aws.Util-import           Data.List-import           Data.Monoid-import qualified Blaze.ByteString.Builder       as Blaze-import qualified Blaze.ByteString.Builder.Char8 as Blaze8-import qualified Data.ByteString                as B-import qualified Network.HTTP.Types             as HTTP--sdbSignQuery :: [(B.ByteString, B.ByteString)] -> SdbInfo -> SignatureData -> SignedQuery-sdbSignQuery q si sd-    = SignedQuery {-        sqMethod = method-      , sqProtocol = sdbiProtocol si-      , sqHost = host-      , sqPort = sdbiPort si-      , sqPath = path-      , sqQuery = sq-      , sqDate = Just $ signatureTime sd-      , sqAuthorization = Nothing-      , sqContentType = Nothing-      , sqContentMd5 = Nothing-      , sqAmzHeaders = []-      , sqOtherHeaders = []-      , sqBody = Nothing-      , sqStringToSign = stringToSign-      }-    where-      ah = HmacSHA256-      q' = HTTP.simpleQueryToQuery . sort $ q ++ ("Version", "2009-04-15") : queryAuth-      ti = signatureTimeInfo sd-      cr = signatureCredentials sd-      queryAuth = [case ti of-                     AbsoluteTimestamp time -> ("Timestamp", fmtAmzTime time)-                     AbsoluteExpires   time -> ("Expires", fmtAmzTime time)-                  , ("AWSAccessKeyId", accessKeyID cr)-                  , ("SignatureMethod", amzHash ah)-                  , ("SignatureVersion", "2")-                  ]-      sq = ("Signature", Just sig) : q'-      method = sdbiHttpMethod si-      host = sdbiHost si-      path = "/"-      sig = signature cr ah stringToSign-      stringToSign = Blaze.toByteString . mconcat $ -                     intersperse (Blaze8.fromChar '\n')-                       [Blaze.copyByteString $ httpMethod method-                       , Blaze.copyByteString $ host-                       , Blaze.copyByteString $ path-                       , HTTP.renderQueryBuilder False q']

@@ -1,51 +0,0 @@-{-# LANGUAGE MultiParamTypeClasses, FlexibleInstances, FlexibleContexts, OverloadedStrings, TypeFamilies #-}-module Aws.SimpleDb.Response-where--import           Aws.Response-import           Aws.SimpleDb.Error-import           Aws.SimpleDb.Metadata-import           Aws.Xml-import           Data.IORef-import           Data.Maybe-import           Text.XML.Cursor            (($|), ($/), ($//), (&|))-import qualified Control.Failure            as F-import qualified Data.ByteString.Base64     as Base64-import qualified Data.Text                  as T-import qualified Data.Text.Encoding         as T-import qualified Text.XML.Cursor            as Cu--sdbResponseConsumer :: (Cu.Cursor -> Response SdbMetadata a)-                    -> IORef SdbMetadata-                    -> HTTPResponseConsumer a-sdbResponseConsumer inner metadataRef status headers source-    = xmlCursorConsumer parse metadataRef status headers source-    where parse cursor-              = do let requestId' = listToMaybe $ cursor $// elContent "RequestID"-                   let boxUsage' = listToMaybe $ cursor $// elContent "BoxUsage"-                   tellMetadata $ SdbMetadata requestId' boxUsage'-                   case cursor $/ Cu.laxElement "Error" of-                     []      -> inner cursor-                     (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--class SdbFromResponse a where-    sdbFromResponse :: Cu.Cursor -> Response SdbMetadata a--sdbCheckResponseType :: F.Failure XmlException m => a -> T.Text -> Cu.Cursor -> m a-sdbCheckResponseType a n c = do _ <- force ("Expected response type " ++ T.unpack n) (Cu.laxElement n c)-                                return a--decodeBase64 :: F.Failure XmlException m => Cu.Cursor -> m T.Text-decodeBase64 cursor =-  let encoded = T.concat $ cursor $/ Cu.content-      encoding = listToMaybe $ cursor $| Cu.laxAttribute "encoding" &| T.toCaseFold-  in-    case encoding of-      Nothing -> return encoded-      Just "base64" -> case Base64.decode . T.encodeUtf8 $ encoded of-                         Left msg -> F.failure $ XmlException ("Invalid Base64 data: " ++ msg)-                         Right x -> return $ T.decodeUtf8 x-      Just actual -> F.failure $ XmlException ("Unrecognized encoding " ++ T.unpack actual)

@@ -1,17 +1,9 @@ module Aws.Sqs (   module Aws.Sqs.Commands-, module Aws.Sqs.Error-, module Aws.Sqs.Info-, module Aws.Sqs.Metadata-, module Aws.Sqs.Query-, module Aws.Sqs.Response+, module Aws.Sqs.Core ) where  import Aws.Sqs.Commands-import Aws.Sqs.Error-import Aws.Sqs.Info-import Aws.Sqs.Metadata-import Aws.Sqs.Query-import Aws.Sqs.Response+import Aws.Sqs.Core

@@ -1,24 +1,11 @@-module Aws.Sqs.Commands(-  module Aws.Sqs.Commands.AddPermission,-  module Aws.Sqs.Commands.DeleteMessage,-  module Aws.Sqs.Commands.DeleteQueue,-  module Aws.Sqs.Commands.ListQueues,-  module Aws.Sqs.Commands.GetQueueAttributes,-  module Aws.Sqs.Commands.ChangeMessageVisibility,-  module Aws.Sqs.Commands.CreateQueue,-  module Aws.Sqs.Commands.ReceiveMessage,-  module Aws.Sqs.Commands.RemovePermission,-  module Aws.Sqs.Commands.SendMessage,-  module Aws.Sqs.Commands.SetQueueAttributes-)where-import Aws.Sqs.Commands.AddPermission-import Aws.Sqs.Commands.DeleteMessage-import Aws.Sqs.Commands.DeleteQueue-import Aws.Sqs.Commands.ListQueues-import Aws.Sqs.Commands.GetQueueAttributes-import Aws.Sqs.Commands.ChangeMessageVisibility-import Aws.Sqs.Commands.CreateQueue-import Aws.Sqs.Commands.ReceiveMessage-import Aws.Sqs.Commands.RemovePermission-import Aws.Sqs.Commands.SendMessage-import Aws.Sqs.Commands.SetQueueAttributes+module Aws.Sqs.Commands (+  module Aws.Sqs.Commands.Message,+  module Aws.Sqs.Commands.Permission,+  module Aws.Sqs.Commands.Queue,+  module Aws.Sqs.Commands.QueueAttributes+) where++import Aws.Sqs.Commands.Message+import Aws.Sqs.Commands.Permission+import Aws.Sqs.Commands.Queue+import Aws.Sqs.Commands.QueueAttributes

@@ -1,48 +0,0 @@-{-# LANGUAGE RecordWildCards, TypeFamilies, FlexibleInstances, MultiParamTypeClasses, OverloadedStrings, TupleSections #-}--module Aws.Sqs.Commands.AddPermission where--import           Aws.Response-import           Aws.Sqs.Info-import           Aws.Sqs.Metadata-import           Aws.Sqs.Model-import           Aws.Sqs.Query-import           Aws.Sqs.Response-import           Aws.Signature-import           Aws.Transaction-import qualified Data.Text             as T-import qualified Data.ByteString.Char8 as B-import qualified Network.HTTP.Types    as HTTP---data AddPermission = AddPermission{-  apLabel :: T.Text,-  apPermissions :: [(T.Text,SqsPermission)],-  apQueueName :: QueueName-}deriving (Show)--data AddPermissionResponse = AddPermissionResponse{-} deriving (Show)---formatPermissions :: [(T.Text,SqsPermission)] -> [HTTP.QueryItem]-formatPermissions perms = -  concat $ zipWith(\ x y -> [(B.pack $ "AwsAccountId." ++ show y, Just $ B.pack $ T.unpack $ fst x), -                             (B.pack $ "ActionName." ++ show y, Just $ B.pack $ T.unpack $ printPermission $ snd x)]) perms [1 :: Integer ..]--instance ResponseConsumer r AddPermissionResponse where-    type ResponseMetadata AddPermissionResponse = SqsMetadata-    responseConsumer _ = sqsXmlResponseConsumer parse-       where-         parse _ = do-           return AddPermissionResponse {}-        -instance SignQuery AddPermission  where -    type Info AddPermission  = SqsInfo-    signQuery AddPermission {..} = sqsSignQuery SqsQuery {-                                             sqsQueueName = Just apQueueName, -                                             sqsQuery = [("Action", Just "AddPermission"), -                                                        ("QueueName", Just $ B.pack $ T.unpack $ printQueueName apQueueName),-                                                        ("Label", Just $ B.pack $ T.unpack apLabel)] ++ formatPermissions apPermissions}--instance Transaction AddPermission AddPermissionResponse

@@ -1,39 +0,0 @@-{-# LANGUAGE RecordWildCards, TypeFamilies, FlexibleInstances, MultiParamTypeClasses, OverloadedStrings, TupleSections #-}--module Aws.Sqs.Commands.ChangeMessageVisibility where--import           Aws.Response-import           Aws.Sqs.Info-import           Aws.Sqs.Metadata-import qualified Aws.Sqs.Model as M-import           Aws.Sqs.Query-import           Aws.Sqs.Response-import           Aws.Signature-import           Aws.Transaction-import qualified Data.Text.Encoding           as TE-import qualified Data.ByteString.Char8        as B--data ChangeMessageVisibility = ChangeMessageVisibility {-  cmvReceiptHandle :: M.ReceiptHandle,-  cmvVisibilityTimeout :: Int,-  cmvQueueName :: M.QueueName-}deriving (Show)--data ChangeMessageVisibilityResponse = ChangeMessageVisibilityResponse{-} deriving (Show)--instance ResponseConsumer r ChangeMessageVisibilityResponse where-    type ResponseMetadata ChangeMessageVisibilityResponse = SqsMetadata-    responseConsumer _ = sqsXmlResponseConsumer parse-      where -        parse _ = do return ChangeMessageVisibilityResponse{}-    -instance SignQuery ChangeMessageVisibility  where -    type Info ChangeMessageVisibility  = SqsInfo-    signQuery ChangeMessageVisibility {..} = sqsSignQuery SqsQuery { -                                             sqsQueueName = Just cmvQueueName, -                                             sqsQuery = [("Action", Just "ChangeMessageVisibility"), -                                                         ("ReceiptHandle", Just $ TE.encodeUtf8 $ M.printReceiptHandle cmvReceiptHandle),-                                                         ("VisibilityTimeout", Just $ B.pack $ show cmvVisibilityTimeout)]}--instance Transaction ChangeMessageVisibility ChangeMessageVisibilityResponse

@@ -1,49 +0,0 @@-{-# LANGUAGE RecordWildCards, TypeFamilies, FlexibleInstances, MultiParamTypeClasses, OverloadedStrings, TupleSections #-}--module Aws.Sqs.Commands.CreateQueue where--import           Aws.Response-import           Aws.Sqs.Info-import           Aws.Sqs.Metadata-import           Aws.Sqs.Query-import           Aws.Sqs.Response-import           Aws.Signature-import           Aws.Transaction-import           Aws.Xml-import           Control.Applicative-import           Data.Maybe-import           Text.XML.Cursor              (($//), (&/))-import qualified Data.Text                    as T-import qualified Data.Text.Encoding           as TE-import qualified Text.XML.Cursor              as Cu-import qualified Data.ByteString.Char8        as B--data CreateQueue = CreateQueue{-  cqDefaultVisibilityTimeout :: Maybe Int,-  cqQueueName :: T.Text-}deriving (Show)--data CreateQueueResponse = CreateQueueResponse{-  cqrQueueUrl :: T.Text-} deriving (Show)---instance ResponseConsumer r CreateQueueResponse where-    type ResponseMetadata CreateQueueResponse = SqsMetadata-    responseConsumer _ = sqsXmlResponseConsumer parse-      where-        parse el = do-          url <- force "Missing Queue Url" $ el $// Cu.laxElement "QueueUrl" &/ Cu.content-          return CreateQueueResponse{ cqrQueueUrl = url}--instance SignQuery CreateQueue  where-    type Info CreateQueue  = SqsInfo-    signQuery CreateQueue {..} = sqsSignQuery SqsQuery {-                                             sqsQueueName = Nothing,-                                             sqsQuery = [("Action", Just "CreateQueue"),-                                                        ("QueueName", Just $ TE.encodeUtf8 cqQueueName)] ++-                                                        catMaybes [("DefaultVisibilityTimeout",) <$> case cqDefaultVisibilityTimeout of-                                                                                                       Just x -> Just $ Just $ B.pack $ show x-                                                                                                       Nothing -> Nothing]}--instance Transaction CreateQueue CreateQueueResponse

@@ -1,38 +0,0 @@-{-# LANGUAGE RecordWildCards, TypeFamilies, FlexibleInstances, MultiParamTypeClasses, OverloadedStrings, TupleSections #-}--module Aws.Sqs.Commands.DeleteMessage where--import           Aws.Response-import           Aws.Sqs.Info-import           Aws.Sqs.Metadata-import qualified Aws.Sqs.Model                as M-import           Aws.Sqs.Query-import           Aws.Sqs.Response-import           Aws.Signature-import           Aws.Transaction-import qualified Data.Text.Encoding           as TE--data DeleteMessage = DeleteMessage{-  dmReceiptHandle :: M.ReceiptHandle,-  dmQueueName :: M.QueueName -}deriving (Show)--data DeleteMessageResponse = DeleteMessageResponse{-} deriving (Show)--instance ResponseConsumer r DeleteMessageResponse where-    type ResponseMetadata DeleteMessageResponse = SqsMetadata-    responseConsumer _ = sqsXmlResponseConsumer parse-      where-        parse _ = do return DeleteMessageResponse {}-          -instance SignQuery DeleteMessage  where -    type Info DeleteMessage  = SqsInfo-    signQuery DeleteMessage {..} = sqsSignQuery SqsQuery {-                                             sqsQueueName = Just dmQueueName, -                                             sqsQuery = [("Action", Just "DeleteMessage"), -                                                        ("ReceiptHandle", Just $ TE.encodeUtf8 $ M.printReceiptHandle dmReceiptHandle )]} --instance Transaction DeleteMessage DeleteMessageResponse--

@@ -1,33 +0,0 @@-{-# LANGUAGE RecordWildCards, TypeFamilies, FlexibleInstances, MultiParamTypeClasses, OverloadedStrings, TupleSections #-}--module Aws.Sqs.Commands.DeleteQueue where--import           Aws.Response-import           Aws.Sqs.Info-import           Aws.Sqs.Metadata-import qualified Aws.Sqs.Model as M-import           Aws.Sqs.Query-import           Aws.Sqs.Response-import           Aws.Signature-import           Aws.Transaction--data DeleteQueue = DeleteQueue{-  dqQueueName :: M.QueueName -}deriving (Show)--data DeleteQueueResponse = DeleteQueueResponse{-} deriving (Show)--instance ResponseConsumer r DeleteQueueResponse where-    type ResponseMetadata DeleteQueueResponse = SqsMetadata-    responseConsumer _ = sqsXmlResponseConsumer parse-      where-        parse _ = do return DeleteQueueResponse{}-          -instance SignQuery DeleteQueue  where -    type Info DeleteQueue  = SqsInfo-    signQuery DeleteQueue {..} = sqsSignQuery SqsQuery {-                                             sqsQueueName = Just dqQueueName, -                                             sqsQuery = [("Action", Just "DeleteQueue")]}--instance Transaction DeleteQueue DeleteQueueResponse

@@ -1,56 +0,0 @@-{-# LANGUAGE RecordWildCards, TypeFamilies, FlexibleInstances, MultiParamTypeClasses, OverloadedStrings, TupleSections #-}--module Aws.Sqs.Commands.GetQueueAttributes where--import           Aws.Response-import           Aws.Sqs.Info-import           Aws.Sqs.Metadata-import qualified Aws.Sqs.Model as M-import           Aws.Sqs.Query-import           Aws.Sqs.Response-import           Aws.Signature-import           Aws.Transaction-import           Aws.Xml-import           Text.XML.Cursor              (($/), ($//), (&/), (&|))-import qualified Data.Text                    as T-import qualified Text.XML.Cursor              as Cu-import qualified Data.ByteString.Char8 as B--data GetQueueAttributes = GetQueueAttributes {-  gqaQueueName :: M.QueueName,-  gqaAttributes :: [M.QueueAttribute]-}deriving (Show)--data GetQueueAttributesResponse = GetQueueAttributesResponse{-  gqarAttributes :: [(M.QueueAttribute,T.Text)]-} deriving (Show)--parseAttributes :: Cu.Cursor -> [(M.QueueAttribute, T.Text)]-parseAttributes el = do-  name <- force "Missing Name" $ el $/ Cu.laxElement "Name" &/ Cu.content-  value <- force "Missing Value" $ el $/ Cu.laxElement "Value" &/ Cu.content-  parsedName <- M.parseQueueAttribute name-  return (parsedName, value)--instance ResponseConsumer r GetQueueAttributesResponse where-    type ResponseMetadata GetQueueAttributesResponse = SqsMetadata-    responseConsumer _ = sqsXmlResponseConsumer parse-      where-        parse el = do-          let attributes = concat $ el $// Cu.laxElement "Attribute" &| parseAttributes-          return GetQueueAttributesResponse{ gqarAttributes = attributes }--formatAttributes :: [M.QueueAttribute] -> [(B.ByteString, Maybe B.ByteString)]-formatAttributes attrs =-  case length attrs of-    0 -> undefined-    1 -> [("AttributeName", Just $ B.pack $ T.unpack $ M.printQueueAttribute $ attrs !! 0)]-    _ -> zipWith (\ x y -> ((B.concat ["AttributeName.", B.pack $ show $ y]), Just $ B.pack $ T.unpack $ M.printQueueAttribute x) ) attrs [1 :: Integer ..]--instance SignQuery GetQueueAttributes where-    type Info GetQueueAttributes = SqsInfo-    signQuery GetQueueAttributes{..} = sqsSignQuery SqsQuery {-                                              sqsQueueName = Just gqaQueueName,-                                              sqsQuery = [("Action", Just "GetQueueAttributes")] ++ (formatAttributes gqaAttributes)}--instance Transaction GetQueueAttributes GetQueueAttributesResponse

@@ -1,45 +0,0 @@-{-# LANGUAGE RecordWildCards, TypeFamilies, FlexibleInstances, MultiParamTypeClasses, OverloadedStrings, TupleSections #-}--module Aws.Sqs.Commands.ListQueues where--import           Aws.Response-import           Aws.Sqs.Info-import           Aws.Sqs.Metadata-import           Aws.Sqs.Query-import           Aws.Sqs.Response-import           Aws.Signature-import           Aws.Transaction-import           Control.Applicative-import           Data.Maybe-import           Text.XML.Cursor              (($//), (&/))-import qualified Data.Text                    as T-import qualified Data.Text.Encoding           as TE-import qualified Text.XML.Cursor              as Cu--data ListQueues = ListQueues {-  lqQueueNamePrefix :: Maybe T.Text-}deriving (Show)--data ListQueuesResponse = ListQueuesResponse{-  lqrQueueUrls :: [T.Text]-} deriving (Show)--instance ResponseConsumer r ListQueuesResponse where-    type ResponseMetadata ListQueuesResponse = SqsMetadata-    responseConsumer _ = sqsXmlResponseConsumer parse-      where-        parse el = do-            let queues = el $// Cu.laxElement "QueueUrl" &/ Cu.content-            return ListQueuesResponse { lqrQueueUrls = queues }--instance SignQuery ListQueues where-    type Info ListQueues = SqsInfo-    signQuery ListQueues{..} = sqsSignQuery SqsQuery {-                                              sqsQueueName = Nothing,-                                              sqsQuery = [("Action", Just "ListQueues")] ++ catMaybes [-                                              ("QueueNamePrefix",) <$> case lqQueueNamePrefix of-                                                                         Just x  -> Just $ Just $ TE.encodeUtf8 x-                                                                         Nothing -> Nothing]}--instance Transaction ListQueues ListQueuesResponse-

@@ -0,0 +1,165 @@+{-# LANGUAGE RecordWildCards, TypeFamilies, FlexibleInstances, MultiParamTypeClasses, OverloadedStrings, TupleSections, ScopedTypeVariables, FlexibleContexts #-}++module Aws.Sqs.Commands.Message where++import           Aws.Core+import           Aws.Sqs.Core+import           Control.Applicative+import           Data.Maybe+import           Text.XML.Cursor       (($/), ($//), (&/), (&|))+import qualified Control.Failure       as F+import qualified Data.ByteString.Char8 as B+import qualified Data.Text             as T+import qualified Data.Text.Encoding    as TE+import qualified Text.XML.Cursor       as Cu++data SendMessage = SendMessage{+  smMessage :: T.Text,+  smQueueName :: QueueName+}deriving (Show)++data SendMessageResponse = SendMessageResponse{+  smrMD5OfMessageBody :: T.Text,+  smrMessageId :: MessageId+} deriving (Show)++instance ResponseConsumer r SendMessageResponse where+    type ResponseMetadata SendMessageResponse = SqsMetadata+    responseConsumer _ = sqsXmlResponseConsumer parse+      where+        parse el = do+          md5 <- force "Missing MD5 Signature" $ el $// Cu.laxElement "MD5OfMessageBody" &/ Cu.content+          mid <- force "Missing Message Id" $ el $// Cu.laxElement "MessageId" &/ Cu.content+          return SendMessageResponse { smrMD5OfMessageBody = md5, smrMessageId = MessageId mid }++-- | ServiceConfiguration: 'SqsConfiguration'+instance SignQuery SendMessage  where+    type ServiceConfiguration SendMessage  = SqsConfiguration+    signQuery SendMessage {..} = sqsSignQuery SqsQuery {+                                             sqsQueueName = Just smQueueName,+                                             sqsQuery = [("Action", Just "SendMessage"),+                                                        ("MessageBody", Just $ TE.encodeUtf8 smMessage )]}++instance Transaction SendMessage SendMessageResponse++data DeleteMessage = DeleteMessage{+  dmReceiptHandle :: ReceiptHandle,+  dmQueueName :: QueueName +}deriving (Show)++data DeleteMessageResponse = DeleteMessageResponse{+} deriving (Show)++instance ResponseConsumer r DeleteMessageResponse where+    type ResponseMetadata DeleteMessageResponse = SqsMetadata+    responseConsumer _ = sqsXmlResponseConsumer parse+      where+        parse _ = do return DeleteMessageResponse {}+          +-- | ServiceConfiguration: 'SqsConfiguration'+instance SignQuery DeleteMessage  where +    type ServiceConfiguration DeleteMessage  = SqsConfiguration+    signQuery DeleteMessage {..} = sqsSignQuery SqsQuery {+                                             sqsQueueName = Just dmQueueName, +                                             sqsQuery = [("Action", Just "DeleteMessage"), +                                                        ("ReceiptHandle", Just $ TE.encodeUtf8 $ printReceiptHandle dmReceiptHandle )]} ++instance Transaction DeleteMessage DeleteMessageResponse++data ReceiveMessage+    = ReceiveMessage {+        rmVisibilityTimeout :: Maybe Int+      , rmAttributes :: [MessageAttribute]+      , rmMaxNumberOfMessages :: Maybe Int+      , rmQueueName :: QueueName+      }+    deriving (Show)++data Message+    = Message {+        mMessageId :: T.Text+      , mReceiptHandle :: ReceiptHandle+      , mMD5OfBody :: T.Text+      , mBody :: T.Text+      , mAttributes :: [(MessageAttribute,T.Text)]+      }+    deriving(Show)++data ReceiveMessageResponse+    = ReceiveMessageResponse {+        rmrMessages :: [Message]+      }+    deriving (Show)++readMessageAttribute :: F.Failure XmlException m => Cu.Cursor -> m (MessageAttribute,T.Text)+readMessageAttribute cursor = do+  name <- force "Missing Name" $ cursor $/ Cu.laxElement "Name" &/ Cu.content+  value <- force "Missing Value" $ cursor $/ Cu.laxElement "Value" &/ Cu.content+  parsedName <- parseMessageAttribute name+  return (parsedName, value)++readMessage :: Cu.Cursor -> [Message]+readMessage cursor = do+  mid :: T.Text <- force "Missing Message Id" $ cursor $// Cu.laxElement "MessageId" &/ Cu.content+  rh <- force "Missing Reciept Handle" $ cursor $// Cu.laxElement "ReceiptHandle" &/ Cu.content+  md5 <- force "Missing MD5 Signature" $ cursor $// Cu.laxElement "MD5OfBody" &/ Cu.content+  body <- force "Missing Body" $ cursor $// Cu.laxElement "Body" &/ Cu.content+  let attributes :: [(MessageAttribute, T.Text)] = concat $ cursor $// Cu.laxElement "Attribute" &| readMessageAttribute++  return Message{ mMessageId = mid, mReceiptHandle = ReceiptHandle rh, mMD5OfBody = md5, mBody = body, mAttributes = attributes}++formatMAttributes :: [MessageAttribute] -> [(B.ByteString, Maybe B.ByteString)]+formatMAttributes attrs =+  case length attrs of+    0 -> []+    1 -> [("AttributeName", Just $ B.pack $ show $ attrs !! 0)]+    _ -> zipWith (\ x y -> ((B.concat ["AttributeName.", B.pack $ show $ y]), Just $ TE.encodeUtf8 $ printMessageAttribute x) ) attrs [1 :: Integer ..]++instance ResponseConsumer r ReceiveMessageResponse where+    type ResponseMetadata ReceiveMessageResponse = SqsMetadata+    responseConsumer _ = sqsXmlResponseConsumer parse+      where+        parse el = do+          let messages = concat $ el $// Cu.laxElement "Message" &| readMessage+          return ReceiveMessageResponse{ rmrMessages = messages }++-- | ServiceConfiguration: 'SqsConfiguration'+instance SignQuery ReceiveMessage  where+    type ServiceConfiguration ReceiveMessage  = SqsConfiguration+    signQuery ReceiveMessage {..} = sqsSignQuery SqsQuery {+                                             sqsQueueName = Just rmQueueName,+                                             sqsQuery = [("Action", Just "ReceiveMessage")] +++                                                         catMaybes[("VisibilityTimeout",) <$> case rmVisibilityTimeout of+                                                                                                Just x -> Just $ Just $ B.pack $ show x+                                                                                                Nothing -> Nothing,+                                                                   ("MaxNumberOfMessages",) <$> case rmMaxNumberOfMessages of+                                                                                                  Just x -> Just $ Just $ B.pack $ show x+                                                                                                  Nothing -> Nothing] ++ formatMAttributes rmAttributes}++instance Transaction ReceiveMessage ReceiveMessageResponse++data ChangeMessageVisibility = ChangeMessageVisibility {+  cmvReceiptHandle :: ReceiptHandle,+  cmvVisibilityTimeout :: Int,+  cmvQueueName :: QueueName+}deriving (Show)++data ChangeMessageVisibilityResponse = ChangeMessageVisibilityResponse{+} deriving (Show)++instance ResponseConsumer r ChangeMessageVisibilityResponse where+    type ResponseMetadata ChangeMessageVisibilityResponse = SqsMetadata+    responseConsumer _ = sqsXmlResponseConsumer parse+      where +        parse _ = do return ChangeMessageVisibilityResponse{}+    +-- | ServiceConfiguration: 'SqsConfiguration'+instance SignQuery ChangeMessageVisibility  where +    type ServiceConfiguration ChangeMessageVisibility  = SqsConfiguration+    signQuery ChangeMessageVisibility {..} = sqsSignQuery SqsQuery { +                                             sqsQueueName = Just cmvQueueName, +                                             sqsQuery = [("Action", Just "ChangeMessageVisibility"), +                                                         ("ReceiptHandle", Just $ TE.encodeUtf8 $ printReceiptHandle cmvReceiptHandle),+                                                         ("VisibilityTimeout", Just $ B.pack $ show cmvVisibilityTimeout)]}++instance Transaction ChangeMessageVisibility ChangeMessageVisibilityResponse

@@ -0,0 +1,68 @@+{-# LANGUAGE RecordWildCards, TypeFamilies, FlexibleInstances, MultiParamTypeClasses, OverloadedStrings, TupleSections #-}++module Aws.Sqs.Commands.Permission where++import           Aws.Core+import           Aws.Sqs.Core+import qualified Data.ByteString.Char8 as B+import qualified Data.Text             as T+import qualified Data.Text.Encoding    as TE+import qualified Network.HTTP.Types    as HTTP++data AddPermission = AddPermission {+    apLabel :: T.Text,+    apPermissions :: [(T.Text,SqsPermission)],+    apQueueName :: QueueName+  } deriving (Show)++data AddPermissionResponse = AddPermissionResponse+  deriving (Show)+++formatPermissions :: [(T.Text,SqsPermission)] -> [HTTP.QueryItem]+formatPermissions perms = +  concat $ zipWith(\ x y -> [(B.pack $ "AwsAccountId." ++ show y, Just $ B.pack $ T.unpack $ fst x), +                             (B.pack $ "ActionName." ++ show y, Just $ B.pack $ T.unpack $ printPermission $ snd x)]) perms [1 :: Integer ..]++instance ResponseConsumer r AddPermissionResponse where+    type ResponseMetadata AddPermissionResponse = SqsMetadata+    responseConsumer _ = sqsXmlResponseConsumer parse+       where+         parse _ = do+           return AddPermissionResponse {}+        +-- | ServiceConfiguration: 'SqsConfiguration'+instance SignQuery AddPermission  where +    type ServiceConfiguration AddPermission  = SqsConfiguration+    signQuery AddPermission {..} = sqsSignQuery SqsQuery {+                                             sqsQueueName = Just apQueueName, +                                             sqsQuery = [("Action", Just "AddPermission"), +                                                        ("QueueName", Just $ B.pack $ T.unpack $ printQueueName apQueueName),+                                                        ("Label", Just $ B.pack $ T.unpack apLabel)] ++ formatPermissions apPermissions}++instance Transaction AddPermission AddPermissionResponse++data RemovePermission = RemovePermission {+    rpLabel :: T.Text,+    rpQueueName :: QueueName +  } deriving (Show)++data RemovePermissionResponse = RemovePermissionResponse +  deriving (Show)++instance ResponseConsumer r RemovePermissionResponse where+    type ResponseMetadata RemovePermissionResponse = SqsMetadata+    responseConsumer _ = sqsXmlResponseConsumer parse+      where +        parse _ = do+          return RemovePermissionResponse {}  +          +-- | ServiceConfiguration: 'SqsConfiguration'+instance SignQuery RemovePermission  where +    type ServiceConfiguration RemovePermission  = SqsConfiguration+    signQuery RemovePermission {..} = sqsSignQuery SqsQuery {+                                             sqsQueueName = Just rpQueueName, +                                             sqsQuery = [("Action", Just "RemovePermission"), +                                                        ("Label", Just $ TE.encodeUtf8 rpLabel )]} ++instance Transaction RemovePermission RemovePermissionResponse

@@ -0,0 +1,94 @@+{-# LANGUAGE RecordWildCards, TypeFamilies, FlexibleInstances, MultiParamTypeClasses, OverloadedStrings, TupleSections #-}++module Aws.Sqs.Commands.Queue where++import           Aws.Core+import           Aws.Sqs.Core+import           Control.Applicative+import           Data.Maybe+import           Text.XML.Cursor       (($//), (&/))+import qualified Data.Text             as T+import qualified Data.Text.Encoding    as TE+import qualified Text.XML.Cursor       as Cu+import qualified Data.ByteString.Char8 as B++data CreateQueue = CreateQueue {+    cqDefaultVisibilityTimeout :: Maybe Int,+    cqQueueName :: T.Text+  } deriving (Show)++data CreateQueueResponse = CreateQueueResponse {+    cqrQueueUrl :: T.Text+  } deriving (Show)+++instance ResponseConsumer r CreateQueueResponse where+    type ResponseMetadata CreateQueueResponse = SqsMetadata+    responseConsumer _ = sqsXmlResponseConsumer parse+      where+        parse el = do+          url <- force "Missing Queue Url" $ el $// Cu.laxElement "QueueUrl" &/ Cu.content+          return CreateQueueResponse{ cqrQueueUrl = url}++-- | ServiceConfiguration: 'SqsConfiguration'+instance SignQuery CreateQueue  where+    type ServiceConfiguration CreateQueue  = SqsConfiguration+    signQuery CreateQueue {..} = sqsSignQuery SqsQuery {+                                             sqsQueueName = Nothing,+                                             sqsQuery = [("Action", Just "CreateQueue"),+                                                        ("QueueName", Just $ TE.encodeUtf8 cqQueueName)] +++                                                        catMaybes [("DefaultVisibilityTimeout",) <$> case cqDefaultVisibilityTimeout of+                                                                                                       Just x -> Just $ Just $ B.pack $ show x+                                                                                                       Nothing -> Nothing]}++instance Transaction CreateQueue CreateQueueResponse++data DeleteQueue = DeleteQueue {+    dqQueueName :: QueueName +  } deriving (Show)++data DeleteQueueResponse = DeleteQueueResponse +  deriving (Show)++instance ResponseConsumer r DeleteQueueResponse where+    type ResponseMetadata DeleteQueueResponse = SqsMetadata+    responseConsumer _ = sqsXmlResponseConsumer parse+      where+        parse _ = do return DeleteQueueResponse{}+          +-- | ServiceConfiguration: 'SqsConfiguration'+instance SignQuery DeleteQueue  where +    type ServiceConfiguration DeleteQueue  = SqsConfiguration+    signQuery DeleteQueue {..} = sqsSignQuery SqsQuery {+                                             sqsQueueName = Just dqQueueName, +                                             sqsQuery = [("Action", Just "DeleteQueue")]}++instance Transaction DeleteQueue DeleteQueueResponse++data ListQueues = ListQueues {+    lqQueueNamePrefix :: Maybe T.Text+  } deriving (Show)++data ListQueuesResponse = ListQueuesResponse {+    lqrQueueUrls :: [T.Text]+  } deriving (Show)++instance ResponseConsumer r ListQueuesResponse where+    type ResponseMetadata ListQueuesResponse = SqsMetadata+    responseConsumer _ = sqsXmlResponseConsumer parse+      where+        parse el = do+            let queues = el $// Cu.laxElement "QueueUrl" &/ Cu.content+            return ListQueuesResponse { lqrQueueUrls = queues }++-- | ServiceConfiguration: 'SqsConfiguration'+instance SignQuery ListQueues where+    type ServiceConfiguration ListQueues = SqsConfiguration+    signQuery ListQueues{..} = sqsSignQuery SqsQuery {+                                              sqsQueueName = Nothing,+                                              sqsQuery = [("Action", Just "ListQueues")] ++ catMaybes [+                                              ("QueueNamePrefix",) <$> case lqQueueNamePrefix of+                                                                         Just x  -> Just $ Just $ TE.encodeUtf8 x+                                                                         Nothing -> Nothing]}++instance Transaction ListQueues ListQueuesResponse

@@ -0,0 +1,78 @@+{-# LANGUAGE RecordWildCards, TypeFamilies, FlexibleInstances, MultiParamTypeClasses, OverloadedStrings, TupleSections #-}++module Aws.Sqs.Commands.QueueAttributes where++import           Aws.Core+import           Aws.Sqs.Core+import           Text.XML.Cursor       (($/), ($//), (&/), (&|))+import qualified Data.ByteString.Char8 as B+import qualified Data.Text             as T+import qualified Data.Text.Encoding    as TE+import qualified Text.XML.Cursor       as Cu++data GetQueueAttributes = GetQueueAttributes {+  gqaQueueName :: QueueName,+  gqaAttributes :: [QueueAttribute]+}deriving (Show)++data GetQueueAttributesResponse = GetQueueAttributesResponse{+  gqarAttributes :: [(QueueAttribute,T.Text)]+} deriving (Show)++parseAttributes :: Cu.Cursor -> [(QueueAttribute, T.Text)]+parseAttributes el = do+  name <- force "Missing Name" $ el $/ Cu.laxElement "Name" &/ Cu.content+  value <- force "Missing Value" $ el $/ Cu.laxElement "Value" &/ Cu.content+  parsedName <- parseQueueAttribute name+  return (parsedName, value)++instance ResponseConsumer r GetQueueAttributesResponse where+    type ResponseMetadata GetQueueAttributesResponse = SqsMetadata+    responseConsumer _ = sqsXmlResponseConsumer parse+      where+        parse el = do+          let attributes = concat $ el $// Cu.laxElement "Attribute" &| parseAttributes+          return GetQueueAttributesResponse{ gqarAttributes = attributes }++formatAttributes :: [QueueAttribute] -> [(B.ByteString, Maybe B.ByteString)]+formatAttributes attrs =+  case length attrs of+    0 -> undefined+    1 -> [("AttributeName", Just $ B.pack $ T.unpack $ printQueueAttribute $ attrs !! 0)]+    _ -> zipWith (\ x y -> ((B.concat ["AttributeName.", B.pack $ show $ y]), Just $ B.pack $ T.unpack $ printQueueAttribute x) ) attrs [1 :: Integer ..]++-- | ServiceConfiguration: 'SqsConfiguration'+instance SignQuery GetQueueAttributes where+    type ServiceConfiguration GetQueueAttributes = SqsConfiguration+    signQuery GetQueueAttributes{..} = sqsSignQuery SqsQuery {+                                              sqsQueueName = Just gqaQueueName,+                                              sqsQuery = [("Action", Just "GetQueueAttributes")] ++ (formatAttributes gqaAttributes)}++instance Transaction GetQueueAttributes GetQueueAttributesResponse++data SetQueueAttributes = SetQueueAttributes{+  sqaAttribute :: QueueAttribute,+  sqaValue :: T.Text,+  sqaQueueName :: QueueName +}deriving (Show)++data SetQueueAttributesResponse = SetQueueAttributesResponse{+} deriving (Show)++instance ResponseConsumer r SetQueueAttributesResponse where+    type ResponseMetadata SetQueueAttributesResponse = SqsMetadata+    responseConsumer _ = sqsXmlResponseConsumer parse+      where +        parse _ = do+          return SetQueueAttributesResponse {}+          +-- | ServiceConfiguration: 'SqsConfiguration'+instance SignQuery SetQueueAttributes  where +    type ServiceConfiguration SetQueueAttributes  = SqsConfiguration+    signQuery SetQueueAttributes {..} = sqsSignQuery SqsQuery { +                                             sqsQueueName = Just sqaQueueName,+                                             sqsQuery = [("Action", Just "SetQueueAttributes"), +                                                        ("Attribute.Name", Just $ TE.encodeUtf8 $ printQueueAttribute sqaAttribute),+                                                        ("Attribute.Value", Just $ TE.encodeUtf8 sqaValue)]} ++instance Transaction SetQueueAttributes SetQueueAttributesResponse

@@ -1,92 +0,0 @@-{-# LANGUAGE RecordWildCards, TypeFamilies, FlexibleInstances, MultiParamTypeClasses, OverloadedStrings, TupleSections, FlexibleContexts, ScopedTypeVariables #-}--module Aws.Sqs.Commands.ReceiveMessage where--import           Aws.Response-import           Aws.Signature-import           Aws.Sqs.Info-import           Aws.Sqs.Metadata-import           Aws.Sqs.Query-import           Aws.Sqs.Response-import           Aws.Transaction-import           Aws.Xml-import           Control.Applicative-import           Data.Maybe-import           Text.XML.Cursor            (($/), ($//), (&/), (&|))-import qualified Aws.Sqs.Model              as M-import qualified Control.Failure            as F-import qualified Data.ByteString.Char8      as B-import qualified Data.Text                  as T-import qualified Data.Text.Encoding         as TE-import qualified Text.XML.Cursor            as Cu--data ReceiveMessage-    = ReceiveMessage {-        rmVisibilityTimeout :: Maybe Int-      , rmAttributes :: [M.MessageAttribute]-      , rmMaxNumberOfMessages :: Maybe Int-      , rmQueueName :: M.QueueName-      }-    deriving (Show)--data Message-    = Message {-        mMessageId :: T.Text-      , mReceiptHandle :: M.ReceiptHandle-      , mMD5OfBody :: T.Text-      , mBody :: T.Text-      , mAttributes :: [(M.MessageAttribute,T.Text)]-      }-    deriving(Show)--data ReceiveMessageResponse-    = ReceiveMessageResponse {-        rmrMessages :: [Message]-      }-    deriving (Show)--readMessageAttribute :: F.Failure XmlException m => Cu.Cursor -> m (M.MessageAttribute,T.Text)-readMessageAttribute cursor = do-  name <- force "Missing Name" $ cursor $/ Cu.laxElement "Name" &/ Cu.content-  value <- force "Missing Value" $ cursor $/ Cu.laxElement "Value" &/ Cu.content-  parsedName <- M.parseMessageAttribute name-  return (parsedName, value)--readMessage :: Cu.Cursor -> [Message]-readMessage cursor = do-  mid :: T.Text <- force "Missing Message Id" $ cursor $// Cu.laxElement "MessageId" &/ Cu.content-  rh <- force "Missing Reciept Handle" $ cursor $// Cu.laxElement "ReceiptHandle" &/ Cu.content-  md5 <- force "Missing MD5 Signature" $ cursor $// Cu.laxElement "MD5OfBody" &/ Cu.content-  body <- force "Missing Body" $ cursor $// Cu.laxElement "Body" &/ Cu.content-  let attributes :: [(M.MessageAttribute, T.Text)] = concat $ cursor $// Cu.laxElement "Attribute" &| readMessageAttribute--  return Message{ mMessageId = mid, mReceiptHandle = M.ReceiptHandle rh, mMD5OfBody = md5, mBody = body, mAttributes = attributes}--formatMAttributes :: [M.MessageAttribute] -> [(B.ByteString, Maybe B.ByteString)]-formatMAttributes attrs =-  case length attrs of-    0 -> []-    1 -> [("AttributeName", Just $ B.pack $ show $ attrs !! 0)]-    _ -> zipWith (\ x y -> ((B.concat ["AttributeName.", B.pack $ show $ y]), Just $ TE.encodeUtf8 $ M.printMessageAttribute x) ) attrs [1 :: Integer ..]--instance ResponseConsumer r ReceiveMessageResponse where-    type ResponseMetadata ReceiveMessageResponse = SqsMetadata-    responseConsumer _ = sqsXmlResponseConsumer parse-      where-        parse el = do-          let messages = concat $ el $// Cu.laxElement "Message" &| readMessage-          return ReceiveMessageResponse{ rmrMessages = messages }--instance SignQuery ReceiveMessage  where-    type Info ReceiveMessage  = SqsInfo-    signQuery ReceiveMessage {..} = sqsSignQuery SqsQuery {-                                             sqsQueueName = Just rmQueueName,-                                             sqsQuery = [("Action", Just "ReceiveMessage")] ++-                                                         catMaybes[("VisibilityTimeout",) <$> case rmVisibilityTimeout of-                                                                                                Just x -> Just $ Just $ B.pack $ show x-                                                                                                Nothing -> Nothing,-                                                                   ("MaxNumberOfMessages",) <$> case rmMaxNumberOfMessages of-                                                                                                  Just x -> Just $ Just $ B.pack $ show x-                                                                                                  Nothing -> Nothing] ++ formatMAttributes rmAttributes}--instance Transaction ReceiveMessage ReceiveMessageResponse

@@ -1,41 +0,0 @@-{-# LANGUAGE RecordWildCards, TypeFamilies, FlexibleInstances, MultiParamTypeClasses, OverloadedStrings, TupleSections #-}--module Aws.Sqs.Commands.RemovePermission where--import           Aws.Response-import           Aws.Sqs.Info-import           Aws.Sqs.Metadata-import qualified Aws.Sqs.Model as M-import           Aws.Sqs.Query-import           Aws.Sqs.Response-import           Aws.Signature-import           Aws.Transaction-import qualified Data.Text                    as T-import qualified Data.Text.Encoding           as TE--data RemovePermission = RemovePermission{-  rpLabel :: T.Text,-  rpQueueName :: M.QueueName -}deriving (Show)--data RemovePermissionResponse = RemovePermissionResponse{-} deriving (Show)--instance ResponseConsumer r RemovePermissionResponse where-    type ResponseMetadata RemovePermissionResponse = SqsMetadata-    responseConsumer _ = sqsXmlResponseConsumer parse-      where -        parse _ = do-          return RemovePermissionResponse {}  -          -instance SignQuery RemovePermission  where -    type Info RemovePermission  = SqsInfo-    signQuery RemovePermission {..} = sqsSignQuery SqsQuery {-                                             sqsQueueName = Just rpQueueName, -                                             sqsQuery = [("Action", Just "RemovePermission"), -                                                        ("Label", Just $ TE.encodeUtf8 rpLabel )]} --instance Transaction RemovePermission RemovePermissionResponse---

@@ -1,48 +0,0 @@-{-# LANGUAGE RecordWildCards, TypeFamilies, FlexibleInstances, MultiParamTypeClasses, OverloadedStrings, TupleSections #-}--module Aws.Sqs.Commands.SendMessage where--import           Aws.Response-import           Aws.Sqs.Info-import           Aws.Sqs.Metadata-import qualified Aws.Sqs.Model as M-import           Aws.Sqs.Query-import           Aws.Sqs.Response-import           Aws.Signature-import           Aws.Transaction-import           Aws.Xml-import           Text.XML.Cursor              (($//), (&/))-import qualified Data.Text                    as T-import qualified Data.Text.Encoding           as TE-import qualified Text.XML.Cursor              as Cu--data SendMessage = SendMessage{-  smMessage :: T.Text,-  smQueueName :: M.QueueName-}deriving (Show)--data SendMessageResponse = SendMessageResponse{-  smrMD5OfMessageBody :: T.Text,-  smrMessageId :: M.MessageId-} deriving (Show)--instance ResponseConsumer r SendMessageResponse where-    type ResponseMetadata SendMessageResponse = SqsMetadata-    responseConsumer _ = sqsXmlResponseConsumer parse-      where-        parse el = do-          md5 <- force "Missing MD5 Signature" $ el $// Cu.laxElement "MD5OfMessageBody" &/ Cu.content-          mid <- force "Missing Message Id" $ el $// Cu.laxElement "MessageId" &/ Cu.content-          return SendMessageResponse { smrMD5OfMessageBody = md5, smrMessageId = M.MessageId mid }--instance SignQuery SendMessage  where-    type Info SendMessage  = SqsInfo-    signQuery SendMessage {..} = sqsSignQuery SqsQuery {-                                             sqsQueueName = Just smQueueName,-                                             sqsQuery = [("Action", Just "SendMessage"),-                                                        ("MessageBody", Just $ TE.encodeUtf8 smMessage )]}--instance Transaction SendMessage SendMessageResponse---

@@ -1,40 +0,0 @@-{-# LANGUAGE RecordWildCards, TypeFamilies, FlexibleInstances, MultiParamTypeClasses, OverloadedStrings, TupleSections #-}--module Aws.Sqs.Commands.SetQueueAttributes where--import           Aws.Response-import           Aws.Sqs.Info-import           Aws.Sqs.Metadata-import qualified Aws.Sqs.Model as M-import           Aws.Sqs.Query-import           Aws.Sqs.Response-import           Aws.Signature-import           Aws.Transaction-import qualified Data.Text                    as T-import qualified Data.Text.Encoding           as TE--data SetQueueAttributes = SetQueueAttributes{-  sqaAttribute :: M.QueueAttribute,-  sqaValue :: T.Text,-  sqaQueueName :: M.QueueName -}deriving (Show)--data SetQueueAttributesResponse = SetQueueAttributesResponse{-} deriving (Show)--instance ResponseConsumer r SetQueueAttributesResponse where-    type ResponseMetadata SetQueueAttributesResponse = SqsMetadata-    responseConsumer _ = sqsXmlResponseConsumer parse-      where -        parse _ = do-          return SetQueueAttributesResponse {}-          -instance SignQuery SetQueueAttributes  where -    type Info SetQueueAttributes  = SqsInfo-    signQuery SetQueueAttributes {..} = sqsSignQuery SqsQuery { -                                             sqsQueueName = Just sqaQueueName,-                                             sqsQuery = [("Action", Just "SetQueueAttributes"), -                                                        ("Attribute.Name", Just $ TE.encodeUtf8 $ M.printQueueAttribute sqaAttribute),-                                                        ("Attribute.Value", Just $ TE.encodeUtf8 sqaValue)]} --instance Transaction SetQueueAttributes SetQueueAttributesResponse

@@ -0,0 +1,328 @@+{-# 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           Control.Monad+import           Control.Monad.IO.Class+import           Data.Attempt                   (Attempt(..))+import           Data.Conduit                   (($$))+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 qualified Network.HTTP.Types             as HTTP+import qualified Text.XML                       as XML+import qualified Text.XML.Cursor                as Cu++type ErrorCode = T.Text++data SqsError+    = SqsError {+        sqsStatusCode :: HTTP.Status+      , sqsErrorCode :: ErrorCode+      , sqsErrorType :: T.Text+      , sqsErrorMessage :: T.Text+      , sqsErrorDetail :: Maybe T.Text+      , sqsErrorMetadata :: Maybe SqsMetadata+      }+    | SqsXmlError { +        sqsXmlErrorMessage :: T.Text+      , sqsXmlErrorMetadata :: Maybe SqsMetadata+      }+    deriving (Show, Typeable)++instance C.Exception SqsError++data SqsMetadata+    = SqsMetadata {+        sqsMAmzId2 :: Maybe T.Text+      , sqsMRequestId :: Maybe T.Text+      }+    deriving (Show)++instance Monoid SqsMetadata where+    mempty = SqsMetadata Nothing Nothing+    SqsMetadata a1 r1 `mappend` SqsMetadata a2 r2 = SqsMetadata (a1 `mplus` a2) (r1 `mplus` r2)++data SqsAuthorization +    = SqsAuthorizationHeader +    | SqsAuthorizationQuery+    deriving (Show)++data Endpoint+    = Endpoint {+        endpointHost :: B.ByteString+      , endpointDefaultLocationConstraint :: LocationConstraint+      , endpointAllowedLocationConstraints :: [LocationConstraint]+      }+    deriving (Show)++data SqsConfiguration+    = SqsConfiguration {+        sqsProtocol :: Protocol+      , sqsEndpoint :: Endpoint+      , sqsPort :: Int+      , sqsUseUri :: Bool+      , sqsDefaultExpiry :: NominalDiffTime+      }+    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+  +sqsEndpointUsClassic :: Endpoint+sqsEndpointUsClassic +    = Endpoint { +        endpointHost = "queue.amazonaws.com"+      , endpointDefaultLocationConstraint = locationUsClassic+      , endpointAllowedLocationConstraints = [locationUsClassic+                                             , locationUsWest+                                             , locationEu+                                             , locationApSouthEast+                                             , locationApNorthEast]+      }++sqsEndpointUsWest :: Endpoint+sqsEndpointUsWest+    = Endpoint {+        endpointHost = "us-west-1.queue.amazonaws.com"+      , endpointDefaultLocationConstraint = locationUsWest+      , endpointAllowedLocationConstraints = [locationUsWest]+      }++sqsEndpointEu :: Endpoint+sqsEndpointEu+    = Endpoint {+        endpointHost = "eu-west-1.queue.amazonaws.com"+      , endpointDefaultLocationConstraint = locationEu+      , endpointAllowedLocationConstraints = [locationEu]+      }++sqsEndpointApSouthEast :: Endpoint+sqsEndpointApSouthEast+    = Endpoint {+        endpointHost = "ap-southeast-1.queue.amazonaws.com"+      , endpointDefaultLocationConstraint = locationApSouthEast+      , endpointAllowedLocationConstraints = [locationApSouthEast]+      }++sqsEndpointApNorthEast :: Endpoint+sqsEndpointApNorthEast+    = Endpoint {+        endpointHost = "sqs.ap-northeast-1.amazonaws.com"+      , endpointDefaultLocationConstraint = locationApNorthEast+      , endpointAllowedLocationConstraints = [locationApNorthEast]+      }++sqs :: Protocol -> Endpoint -> Bool -> SqsConfiguration+sqs protocol endpoint uri +    = SqsConfiguration { +        sqsProtocol = protocol+      , sqsEndpoint = endpoint+      , sqsPort = defaultPort protocol+      , sqsUseUri = uri+      , sqsDefaultExpiry = 15*60+      }++data SqsQuery = SqsQuery{+  sqsQueueName :: Maybe QueueName,+  sqsQuery :: HTTP.Query+}++sqsSignQuery :: SqsQuery -> SqsConfiguration -> SignatureData -> SignedQuery+sqsSignQuery SqsQuery{..} SqsConfiguration{..} SignatureData{..}+    = SignedQuery {+        sqMethod = method+      , sqProtocol = sqsProtocol+      , sqHost = endpointHost sqsEndpoint+      , sqPort = sqsPort+      , sqPath = path+      , sqQuery = signedQuery+      , sqDate = Just signatureTime+      , sqAuthorization = Nothing +      , sqBody = Nothing+      , sqStringToSign = stringToSign+      , sqContentType = Nothing+      , sqContentMd5 = Nothing+      , sqAmzHeaders = []+      , sqOtherHeaders = []+      }+    where+      method = PostQuery+      path = case sqsQueueName of+                Just x -> TE.encodeUtf8 $ printQueueName x+                Nothing -> "/"+      expandedQuery = sortBy (comparing fst) +                       ( sqsQuery ++ [ ("AWSAccessKeyId", Just(accessKeyID signatureCredentials)), +                       ("Expires", Just(BC.pack expiresString)), +                       ("SignatureMethod", Just("HmacSHA256")), ("SignatureVersion",Just("2")), ("Version",Just("2009-02-01"))++                       ])+      +      expires = AbsoluteExpires $ sqsDefaultExpiry `addUTCTime` signatureTime++      expiresString = formatTime defaultTimeLocale "%FT%TZ" (fromAbsoluteTimeInfo expires)++      sig = signature signatureCredentials HmacSHA256 stringToSign+      stringToSign = Blaze.toByteString . mconcat . intersperse (Blaze8.fromChar '\n') . concat  $+                       [[Blaze.copyByteString $ httpMethod method]+                       , [Blaze.copyByteString $ endpointHost sqsEndpoint]+                       , [Blaze.copyByteString path]+                       , [Blaze.copyByteString $ HTTP.renderQuery False expandedQuery ]]++      signedQuery = expandedQuery ++ (HTTP.simpleQueryToQuery $ makeAuthQuery)++      makeAuthQuery = [("Signature", sig)]++sqsResponseConsumer :: HTTPResponseConsumer a+                    -> IORef SqsMetadata+                    -> HTTPResponseConsumer a+sqsResponseConsumer inner metadata status headers source = do+      let headerString = fmap T.decodeUtf8 . flip lookup headers+      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++sqsXmlResponseConsumer :: (Cu.Cursor -> Response SqsMetadata a)+                       -> IORef SqsMetadata+                       -> HTTPResponseConsumer a+sqsXmlResponseConsumer parse metadataRef = sqsResponseConsumer (xmlCursorConsumer parse metadataRef) metadataRef++sqsErrorResponseConsumer :: HTTPResponseConsumer a+sqsErrorResponseConsumer status _headers source+    = do doc <- source $$ XML.sinkDoc XML.def+         let cursor = Cu.fromDocument doc+         liftIO $ case parseError cursor of+           Success err -> C.monadThrow err+           Failure otherErr -> C.monadThrow otherErr+    where+      parseError :: Cu.Cursor -> Attempt SqsError+      parseError root = do cursor <- force "Missing Error" $ root $/ Cu.laxElement "Error"+                           code <- force "Missing error Code" $ cursor $/ elContent "Code"+                           message <- force "Missing error Message" $ cursor $/ elContent "Message"+                           errorType <- force "Missing error Type" $ cursor $/ elContent "Type"+                           let detail = listToMaybe $ cursor $/ elContent "Detail"++                           return SqsError {+                                        sqsStatusCode = status+                                      , sqsErrorCode = code+                                      , sqsErrorMessage = message+                                      , sqsErrorType = errorType+                                      , sqsErrorDetail = detail+                                      , sqsErrorMetadata = Nothing+                                      }++data QueueName = QueueName{+  qName :: T.Text,+  qAccountNumber :: T.Text+} deriving(Show)++printQueueName :: QueueName -> T.Text+printQueueName queue = T.concat ["/", (qAccountNumber queue), "/", (qName queue), "/"]++data QueueAttribute+    = QueueAll+    | ApproximateNumberOfMessages+    | ApproximateNumberOfMessagesNotVisible+    | VisibilityTimeout+    | CreatedTimestamp+    | LastModifiedTimestamp+    | Policy+    | MaximumMessageSize+    | MessageRetentionPeriod+    | QueueArn+    deriving(Show, Enum, Eq)++data MessageAttribute+    = MessageAll+    | SenderId+    | SentTimestamp+    | ApproximateReceiveCount+    | ApproximateFirstReceiveTimestamp+    deriving(Show,Eq,Enum)++data SqsPermission+    = PermissionAll+    | PermissionSendMessage+    | PermissionReceiveMessage+    | PermissionDeleteMessage+    | PermissionChangeMessageVisibility+    | PermissionGetQueueAttributes+    deriving (Show, Enum, Eq)++parseQueueAttribute :: F.Failure XmlException m  => T.Text -> m QueueAttribute+parseQueueAttribute "ApproximateNumberOfMessages" = return ApproximateNumberOfMessages +parseQueueAttribute "ApproximateNumberOfMessagesNotVisible" = return ApproximateNumberOfMessagesNotVisible+parseQueueAttribute "VisibilityTimeout" = return VisibilityTimeout+parseQueueAttribute "CreatedTimestamp" = return CreatedTimestamp+parseQueueAttribute "LastModifiedTimestamp" = return LastModifiedTimestamp+parseQueueAttribute "Policy" = return Policy+parseQueueAttribute "MaximumMessageSize" = return MaximumMessageSize+parseQueueAttribute "MessageRetentionPeriod" = return MessageRetentionPeriod+parseQueueAttribute "QueueArn" = return QueueArn+parseQueueAttribute x = F.failure $ XmlException ( "Invalid Attribute Name. " ++ show x)++printQueueAttribute :: QueueAttribute -> T.Text+printQueueAttribute QueueAll = "All"+printQueueAttribute ApproximateNumberOfMessages = "ApproximateNumberOfMessages"+printQueueAttribute ApproximateNumberOfMessagesNotVisible = "ApproximateNumberOfMessagesNotVisible"+printQueueAttribute VisibilityTimeout = "VisibilityTimeout"+printQueueAttribute CreatedTimestamp = "CreatedTimestamp"+printQueueAttribute LastModifiedTimestamp = "LastModifiedTimestamp"+printQueueAttribute Policy = "Policy"+printQueueAttribute MaximumMessageSize = "MaximumMessageSize"+printQueueAttribute MessageRetentionPeriod = "MessageRetentionPeriod"+printQueueAttribute QueueArn = "QueueArn"++parseMessageAttribute :: F.Failure XmlException m  =>  T.Text -> m MessageAttribute+parseMessageAttribute "SenderId" = return SenderId+parseMessageAttribute "SentTimestamp" = return SentTimestamp+parseMessageAttribute "ApproximateReceiveCount" = return ApproximateReceiveCount+parseMessageAttribute "ApproximateFirstReceiveTimestamp" = return ApproximateFirstReceiveTimestamp+parseMessageAttribute x = F.failure $ XmlException ( "Invalid Attribute Name. " ++ show x)++printMessageAttribute :: MessageAttribute -> T.Text+printMessageAttribute MessageAll = "All"+printMessageAttribute SenderId = "SenderId"+printMessageAttribute SentTimestamp = "SentTimestamp"+printMessageAttribute ApproximateReceiveCount = "ApproximateReceiveCount"+printMessageAttribute ApproximateFirstReceiveTimestamp = "ApproximateFirstReceiveTimestamp"++printPermission :: SqsPermission -> T.Text+printPermission PermissionAll = "*"+printPermission PermissionSendMessage = "SendMessage"+printPermission PermissionReceiveMessage = "ReceiveMessage"+printPermission PermissionDeleteMessage = "DeleteMessage"+printPermission PermissionChangeMessageVisibility = "ChangeMessageVisibility"+printPermission PermissionGetQueueAttributes = "GetQueueAttributes"++newtype ReceiptHandle = ReceiptHandle T.Text deriving(Show,Eq)+newtype MessageId = MessageId T.Text deriving(Show,Eq)++printReceiptHandle :: ReceiptHandle -> T.Text+printReceiptHandle (ReceiptHandle handle) = handle 

@@ -1,27 +0,0 @@-{-# LANGUAGE DeriveDataTypeable, MultiParamTypeClasses #-}-module Aws.Sqs.Error where--import           Aws.Sqs.Metadata-import           Data.Typeable-import qualified Control.Exception  as C-import qualified Data.Text          as T-import qualified Network.HTTP.Types as HTTP--type ErrorCode = T.Text--data SqsError-    = SqsError {-        sqsStatusCode :: HTTP.Status-      , sqsErrorCode :: ErrorCode-      , sqsErrorType :: T.Text-      , sqsErrorMessage :: T.Text-      , sqsErrorDetail :: Maybe T.Text-      , sqsErrorMetadata :: Maybe SqsMetadata-      }-    | SqsXmlError { -        sqsXmlErrorMessage :: T.Text-      , sqsXmlErrorMetadata :: Maybe SqsMetadata-      }-    deriving (Show, Typeable)--instance C.Exception SqsError

@@ -1,85 +0,0 @@-{-# LANGUAGE OverloadedStrings #-}-module Aws.Sqs.Info where--import           Aws.Http-import           Aws.S3.Model-import           Data.Time-import qualified Data.ByteString as B--data SqsAuthorization -    = SqsAuthorizationHeader -    | SqsAuthorizationQuery-    deriving (Show)--data Endpoint-    = Endpoint {-        endpointHost :: B.ByteString-      , endpointDefaultLocationConstraint :: LocationConstraint-      , endpointAllowedLocationConstraints :: [LocationConstraint]-      }-    deriving (Show)--data SqsInfo-    = SqsInfo {-        sqsProtocol :: Protocol-      , sqsEndpoint :: Endpoint-      , sqsPort :: Int-      , sqsUseUri :: Bool-      , sqsDefaultExpiry :: NominalDiffTime-      }-    deriving (Show)--sqsEndpointUsClassic :: Endpoint-sqsEndpointUsClassic -    = Endpoint { -        endpointHost = "queue.amazonaws.com"-      , endpointDefaultLocationConstraint = locationUsClassic-      , endpointAllowedLocationConstraints = [locationUsClassic-                                             , locationUsWest-                                             , locationEu-                                             , locationApSouthEast-                                             , locationApNorthEast]-      }--sqsEndpointUsWest :: Endpoint-sqsEndpointUsWest-    = Endpoint {-        endpointHost = "us-west-1.queue.amazonaws.com"-      , endpointDefaultLocationConstraint = locationUsWest-      , endpointAllowedLocationConstraints = [locationUsWest]-      }--sqsEndpointEu :: Endpoint-sqsEndpointEu-    = Endpoint {-        endpointHost = "eu-west-1.queue.amazonaws.com"-      , endpointDefaultLocationConstraint = locationEu-      , endpointAllowedLocationConstraints = [locationEu]-      }--sqsEndpointApSouthEast :: Endpoint-sqsEndpointApSouthEast-    = Endpoint {-        endpointHost = "ap-southeast-1.queue.amazonaws.com"-      , endpointDefaultLocationConstraint = locationApSouthEast-      , endpointAllowedLocationConstraints = [locationApSouthEast]-      }--sqsEndpointApNorthEast :: Endpoint-sqsEndpointApNorthEast-    = Endpoint {-        endpointHost = "sqs.ap-northeast-1.amazonaws.com"-      , endpointDefaultLocationConstraint = locationApNorthEast-      , endpointAllowedLocationConstraints = [locationApNorthEast]-      }--sqs :: Protocol -> Endpoint -> Bool -> SqsInfo-sqs protocol endpoint uri -    = SqsInfo { -        sqsProtocol = protocol-      , sqsEndpoint = endpoint-      , sqsPort = defaultPort protocol-      , sqsUseUri = uri-      , sqsDefaultExpiry = 15*60-      }-

@@ -1,16 +0,0 @@-module Aws.Sqs.Metadata where--import           Control.Monad-import           Data.Monoid-import qualified Data.Text     as T--data SqsMetadata-    = SqsMetadata {-        sqsMAmzId2 :: Maybe T.Text-      , sqsMRequestId :: Maybe T.Text-      }-    deriving (Show)--instance Monoid SqsMetadata where-    mempty = SqsMetadata Nothing Nothing-    SqsMetadata a1 r1 `mappend` SqsMetadata a2 r2 = SqsMetadata (a1 `mplus` a2) (r1 `mplus` r2)

@@ -1,96 +0,0 @@-{-# LANGUAGE OverloadedStrings, FlexibleContexts #-}-module Aws.Sqs.Model where--import           Aws.Xml-import qualified Control.Failure as F-import qualified Data.Text       as T--data QueueName = QueueName{-  qName :: T.Text,-  qAccountNumber :: T.Text-} deriving(Show)--printQueueName :: QueueName -> T.Text-printQueueName queue = T.concat ["/", (qAccountNumber queue), "/", (qName queue), "/"]--data QueueAttribute-    = QueueAll-    | ApproximateNumberOfMessages-    | ApproximateNumberOfMessagesNotVisible-    | VisibilityTimeout-    | CreatedTimestamp-    | LastModifiedTimestamp-    | Policy-    | MaximumMessageSize-    | MessageRetentionPeriod-    | QueueArn-    deriving(Show, Enum, Eq)--data MessageAttribute-    = MessageAll-    | SenderId-    | SentTimestamp-    | ApproximateReceiveCount-    | ApproximateFirstReceiveTimestamp-    deriving(Show,Eq,Enum)--data SqsPermission-    = PermissionAll-    | SendMessage-    | ReceiveMessage-    | DeleteMessage-    | ChangeMessageVisibility-    | GetQueueAttributes-    deriving (Show, Enum, Eq)--parseQueueAttribute :: F.Failure XmlException m  => T.Text -> m QueueAttribute-parseQueueAttribute "ApproximateNumberOfMessages" = return ApproximateNumberOfMessages -parseQueueAttribute "ApproximateNumberOfMessagesNotVisible" = return ApproximateNumberOfMessagesNotVisible-parseQueueAttribute "VisibilityTimeout" = return VisibilityTimeout-parseQueueAttribute "CreatedTimestamp" = return CreatedTimestamp-parseQueueAttribute "LastModifiedTimestamp" = return LastModifiedTimestamp-parseQueueAttribute "Policy" = return Policy-parseQueueAttribute "MaximumMessageSize" = return MaximumMessageSize-parseQueueAttribute "MessageRetentionPeriod" = return MessageRetentionPeriod-parseQueueAttribute "QueueArn" = return QueueArn-parseQueueAttribute x = F.failure $ XmlException ( "Invalid Attribute Name. " ++ show x)--printQueueAttribute :: QueueAttribute -> T.Text-printQueueAttribute QueueAll = "All"-printQueueAttribute ApproximateNumberOfMessages = "ApproximateNumberOfMessages"-printQueueAttribute ApproximateNumberOfMessagesNotVisible = "ApproximateNumberOfMessagesNotVisible"-printQueueAttribute VisibilityTimeout = "VisibilityTimeout"-printQueueAttribute CreatedTimestamp = "CreatedTimestamp"-printQueueAttribute LastModifiedTimestamp = "LastModifiedTimestamp"-printQueueAttribute Policy = "Policy"-printQueueAttribute MaximumMessageSize = "MaximumMessageSize"-printQueueAttribute MessageRetentionPeriod = "MessageRetentionPeriod"-printQueueAttribute QueueArn = "QueueArn"--parseMessageAttribute :: F.Failure XmlException m  =>  T.Text -> m MessageAttribute-parseMessageAttribute "SenderId" = return SenderId-parseMessageAttribute "SentTimestamp" = return SentTimestamp-parseMessageAttribute "ApproximateReceiveCount" = return ApproximateReceiveCount-parseMessageAttribute "ApproximateFirstReceiveTimestamp" = return ApproximateFirstReceiveTimestamp-parseMessageAttribute x = F.failure $ XmlException ( "Invalid Attribute Name. " ++ show x)--printMessageAttribute :: MessageAttribute -> T.Text-printMessageAttribute MessageAll = "All"-printMessageAttribute SenderId = "SenderId"-printMessageAttribute SentTimestamp = "SentTimestamp"-printMessageAttribute ApproximateReceiveCount = "ApproximateReceiveCount"-printMessageAttribute ApproximateFirstReceiveTimestamp = "ApproximateFirstReceiveTimestamp"--printPermission :: SqsPermission -> T.Text-printPermission PermissionAll = "*"-printPermission SendMessage = "SendMessage"-printPermission ReceiveMessage = "ReceiveMessage"-printPermission DeleteMessage = "DeleteMessage"-printPermission ChangeMessageVisibility = "ChangeMessageVisibility"-printPermission GetQueueAttributes = "GetQueueAttributes"--newtype ReceiptHandle = ReceiptHandle T.Text deriving(Show,Eq)-newtype MessageId = MessageId T.Text deriving(Show,Eq)--printReceiptHandle :: ReceiptHandle -> T.Text-printReceiptHandle (ReceiptHandle handle) = handle 

@@ -1,70 +0,0 @@-{-# LANGUAGE OverloadedStrings,RecordWildCards #-}--module Aws.Sqs.Query where--import           Aws.Credentials-import           Aws.Http-import           Aws.Query-import           Aws.Sqs.Info-import           Aws.Sqs.Model-import           Aws.Signature-import           Data.List-import           Data.Monoid-import           Data.Ord-import           Data.Time-import           System.Locale-import qualified Blaze.ByteString.Builder       as Blaze-import qualified Blaze.ByteString.Builder.Char8 as Blaze8-import qualified Data.ByteString.Char8          as BC-import qualified Data.Text.Encoding             as TE-import qualified Network.HTTP.Types             as HTTP--data SqsQuery = SqsQuery{-  sqsQueueName :: Maybe QueueName,-  sqsQuery :: HTTP.Query-}--sqsSignQuery :: SqsQuery -> SqsInfo -> SignatureData -> SignedQuery-sqsSignQuery SqsQuery{..} SqsInfo{..} SignatureData{..}-    = SignedQuery {-        sqMethod = method-      , sqProtocol = sqsProtocol-      , sqHost = endpointHost sqsEndpoint-      , sqPort = sqsPort-      , sqPath = path-      , sqQuery = signedQuery-      , sqDate = Just signatureTime-      , sqAuthorization = Nothing -      , sqBody = Nothing-      , sqStringToSign = stringToSign-      , sqContentType = Nothing-      , sqContentMd5 = Nothing-      , sqAmzHeaders = []-      , sqOtherHeaders = []-      }-    where-      method = PostQuery-      path = case sqsQueueName of-                Just x -> TE.encodeUtf8 $ printQueueName x-                Nothing -> "/"-      expandedQuery = sortBy (comparing fst) -                       ( sqsQuery ++ [ ("AWSAccessKeyId", Just(accessKeyID signatureCredentials)), -                       ("Expires", Just(BC.pack expiresString)), -                       ("SignatureMethod", Just("HmacSHA256")), ("SignatureVersion",Just("2")), ("Version",Just("2009-02-01"))--                       ])-      -      expires = AbsoluteExpires $ sqsDefaultExpiry `addUTCTime` signatureTime--      expiresString = formatTime defaultTimeLocale "%FT%TZ" (fromAbsoluteTimeInfo expires)--      sig = signature signatureCredentials HmacSHA256 stringToSign-      stringToSign = Blaze.toByteString . mconcat . intersperse (Blaze8.fromChar '\n') . concat  $-                       [[Blaze.copyByteString $ httpMethod method]-                       , [Blaze.copyByteString $ endpointHost sqsEndpoint]-                       , [Blaze.copyByteString path]-                       , [Blaze.copyByteString $ HTTP.renderQuery False expandedQuery ]]--      signedQuery = expandedQuery ++ (HTTP.simpleQueryToQuery $ makeAuthQuery)--      makeAuthQuery = [("Signature", sig)]

@@ -1,62 +0,0 @@-{-# LANGUAGE FlexibleInstances, OverloadedStrings, ScopedTypeVariables, RecordWildCards #-}-module Aws.Sqs.Response where--import           Aws.Response-import           Aws.Sqs.Error-import           Aws.Sqs.Metadata-import           Aws.Xml-import           Control.Monad.IO.Class-import           Data.Attempt                 (Attempt(..))-import           Data.Conduit                 (($$))-import           Data.IORef-import           Data.Maybe-import           Text.XML.Cursor              (($/))-import qualified Data.Conduit                 as C-import qualified Data.Text.Encoding           as T-import qualified Network.HTTP.Types           as HTTP-import qualified Text.XML.Cursor              as Cu-import qualified Text.XML                     as XML--sqsResponseConsumer :: HTTPResponseConsumer a-                    -> IORef SqsMetadata-                    -> HTTPResponseConsumer a-sqsResponseConsumer inner metadata status headers source = do-      let headerString = fmap T.decodeUtf8 . flip lookup headers-      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--sqsXmlResponseConsumer :: (Cu.Cursor -> Response SqsMetadata a)-                       -> IORef SqsMetadata-                       -> HTTPResponseConsumer a-sqsXmlResponseConsumer parse metadataRef = sqsResponseConsumer (xmlCursorConsumer parse metadataRef) metadataRef--sqsErrorResponseConsumer :: HTTPResponseConsumer a-sqsErrorResponseConsumer status _headers source-    = do doc <- source $$ XML.sinkDoc XML.def-         let cursor = Cu.fromDocument doc-         liftIO $ case parseError cursor of-           Success err -> C.monadThrow err-           Failure otherErr -> C.monadThrow otherErr-    where-      parseError :: Cu.Cursor -> Attempt SqsError-      parseError root = do cursor <- force "Missing Error" $ root $/ Cu.laxElement "Error"-                           code <- force "Missing error Code" $ cursor $/ elContent "Code"-                           message <- force "Missing error Message" $ cursor $/ elContent "Message"-                           errorType <- force "Missing error Type" $ cursor $/ elContent "Type"-                           let detail = listToMaybe $ cursor $/ elContent "Detail"--                           return SqsError {-                                        sqsStatusCode = status-                                      , sqsErrorCode = code-                                      , sqsErrorMessage = message-                                      , sqsErrorType = errorType-                                      , sqsErrorDetail = detail-                                      , sqsErrorMetadata = Nothing-                                      }

@@ -1,10 +0,0 @@-{-# LANGUAGE MultiParamTypeClasses, FunctionalDependencies, FlexibleContexts #-}-module Aws.Transaction-where-  -import Aws.Response-import Aws.Signature-import Data.Monoid--class (SignQuery r, ResponseConsumer r a, Monoid (ResponseMetadata a))-    => Transaction r a | r -> a, a -> r

@@ -1,59 +0,0 @@-{-# LANGUAGE OverloadedStrings #-}-{-# LANGUAGE FlexibleContexts #-}--module Aws.Util where--import Control.Monad.Trans.Control-import           Control.Arrow-import           Control.Exception-import           Data.ByteString.Char8 ({- IsString -})-import           Data.Char-import           Data.Time-import           Data.Word-import           System.Locale-import qualified Control.Exception.Lifted-import qualified Data.ByteString       as B-import qualified Data.ByteString.UTF8  as BU-import qualified Data.Conduit          as C--tryError :: (Exception e, C.MonadResource m, MonadBaseControl IO m) => m b -> m (Either e b)-tryError = Control.Exception.Lifted.try--queryList :: (a -> [(B.ByteString, B.ByteString)]) -> B.ByteString -> [a] -> [(B.ByteString, B.ByteString)]-queryList f prefix xs = concat $ zipWith combine prefixList (map f xs)-    where prefixList = map (dot prefix . BU.fromString . show) [(1 :: Int) ..]-          combine pf = map $ first (pf `dot`)-          dot x y = B.concat [x, BU.fromString ".", y]--awsBool :: Bool -> B.ByteString-awsBool True = "true"-awsBool False = "false"--awsTrue :: B.ByteString-awsTrue = awsBool True--awsFalse :: B.ByteString-awsFalse = awsBool False--fmtTime :: String -> UTCTime -> B.ByteString-fmtTime s t = BU.fromString $ formatTime defaultTimeLocale s t--fmtRfc822Time :: UTCTime -> B.ByteString-fmtRfc822Time = fmtTime "%a, %_d %b %Y %H:%M:%S GMT"--fmtAmzTime :: UTCTime -> B.ByteString-fmtAmzTime = fmtTime "%Y-%m-%dT%H:%M:%S"--fmtTimeEpochSeconds :: UTCTime -> B.ByteString-fmtTimeEpochSeconds = fmtTime "%s"--readHex2 :: [Char] -> Maybe Word8-readHex2 [c1,c2] = do n1 <- readHex1 c1-                      n2 <- readHex1 c2-                      return . fromIntegral $ n1 * 16 + n2-    where-      readHex1 c | c >= '0' && c <= '9' = Just $ ord c - ord '0'-                 | c >= 'A' && c <= 'F' = Just $ ord c - ord 'A' + 10-                 | c >= 'a' && c <= 'f' = Just $ ord c - ord 'a' + 10-      readHex1 _                        = Nothing-readHex2 _ = Nothing

@@ -1,59 +0,0 @@-{-# LANGUAGE FlexibleContexts, DeriveDataTypeable #-}-module Aws.Xml-where--import           Aws.Response-import           Control.Monad.IO.Class-import           Data.Attempt                 (Attempt(..))-import           Data.Conduit                 (($$))-import           Data.IORef-import           Data.Monoid-import           Data.Typeable-import           Text.XML.Cursor-import qualified Control.Exception            as E-import qualified Control.Failure              as F-import qualified Data.Conduit                 as C-import qualified Data.Text                    as T-import qualified Text.XML.Cursor              as Cu-import qualified Text.XML                     as XML--newtype XmlException = XmlException { xmlErrorMessage :: String }-    deriving (Show, Typeable)--instance E.Exception XmlException--elContent :: T.Text -> Cursor -> [T.Text]-elContent name = laxElement name &/ content--elCont :: T.Text -> Cursor -> [String]-elCont name = laxElement name &/ content &| T.unpack--force :: F.Failure XmlException m => String -> [a] -> m a-force = Cu.force . XmlException--forceM :: F.Failure XmlException m => String -> [m a] -> m a-forceM = Cu.forceM . XmlException--textReadInt :: (F.Failure XmlException m, Num a) => T.Text -> m a-textReadInt s = case reads $ T.unpack s of-                  [(n,"")] -> return $ fromInteger n-                  _        -> F.failure $ XmlException "Invalid Integer"--readInt :: (F.Failure XmlException m, Num a) => String -> m a-readInt s = case reads s of-              [(n,"")] -> return $ fromInteger n-              _        -> F.failure $ XmlException "Invalid Integer"--xmlCursorConsumer ::-    (Monoid m)-    => (Cu.Cursor -> Response m a)-    -> IORef m-    -> HTTPResponseConsumer a-xmlCursorConsumer parse metadataRef _status _headers source-    = do doc <- source $$ XML.sinkDoc XML.def-         let cursor = Cu.fromDocument doc-         let Response metadata x = parse cursor-         liftIO $ tellMetadataRef metadataRef metadata-         case x of-           Failure err -> liftIO $ C.monadThrow err-           Success v   -> return v

@@ -7,20 +7,21 @@ import Data.IORef import Data.Monoid --- A small function to save the object's data into a file.+{- A small function to save the object's data into a file. -} saveObject :: Aws.HTTPResponseConsumer () saveObject status headers source = source $$ sinkFile "cloud-remote.pdf"  main :: IO () main = do-  -- Set up AWS credentials and the default configuration.+  {- 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).+  {- Create an IORef to store the response Metadata (so it is also available in case of an error). -}   metadataRef <- newIORef mempty -  -- Create a request object with S3.getObject and run the request with simpleAwsRef.-  Aws.simpleAwsRef cfg metadataRef $ S3.getObject "haskell-aws" "cloud-remote.pdf" saveObject+  {- 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 -  -- Print the response metadata.+  {- Print the response metadata. -}   print =<< readIORef metadataRef

@@ -66,12 +66,13 @@ 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    {- Create a request object with S3.getObject and run the request with simpleAwsRef. -}-  Aws.simpleAwsRef cfg metadataRef $ S3.getObject "haskell-aws" "cloud-remote.pdf" saveObject+  Aws.simpleAwsRef cfg s3Cfg metadataRef $ S3.getObject "haskell-aws" "cloud-remote.pdf" saveObject    {- Print the response metadata. -}   print =<< readIORef metadataRef@@ -91,6 +92,17 @@  * Release Notes +** 0.5 series++- 0.5.0 ::+    New configuration system: configuration split into general and service-specific parts.++    Significantly improved API reference documentation.++    Re-organised modules to make library easier to understand.++    Smaller improvements.+ ** 0.4 series  - 0.4.1 :: Documentation improvements.@@ -101,7 +113,6 @@  - 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]]

@@ -6,13 +6,13 @@ -- 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.4.1+Version:             0.5.0  -- A short (one-line) description of the package. 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.+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@@ -48,7 +48,7 @@ Source-repository this   type: git   location: https://github.com/aristidb/aws.git-  tag: 0.4.1+  tag: 0.5.0  Source-repository head   type: git@@ -59,10 +59,7 @@   Exposed-modules:                        Aws,                        Aws.Aws,-                       Aws.Credentials,-                       Aws.Http,-                       Aws.Query,-                       Aws.Response,+                       Aws.Core,                        Aws.S3,                        Aws.S3.Commands,                        Aws.S3.Commands.DeleteObject,@@ -71,62 +68,24 @@                        Aws.S3.Commands.GetService,                        Aws.S3.Commands.PutBucket,                        Aws.S3.Commands.PutObject,-                       Aws.S3.Error,-                       Aws.S3.Info,-                       Aws.S3.Metadata,-                       Aws.S3.Model,-                       Aws.S3.Query,-                       Aws.S3.Response,-                       Aws.Signature,+                       Aws.S3.Core,                        Aws.SimpleDb,                        Aws.SimpleDb.Commands,-                       Aws.SimpleDb.Commands.BatchDeleteAttributes,-                       Aws.SimpleDb.Commands.BatchPutAttributes,-                       Aws.SimpleDb.Commands.CreateDomain,-                       Aws.SimpleDb.Commands.DeleteAttributes,-                       Aws.SimpleDb.Commands.DeleteDomain,-                       Aws.SimpleDb.Commands.DomainMetadata,-                       Aws.SimpleDb.Commands.GetAttributes,-                       Aws.SimpleDb.Commands.ListDomains,-                       Aws.SimpleDb.Commands.PutAttributes,+                       Aws.SimpleDb.Commands.Attributes,+                       Aws.SimpleDb.Commands.Domain,                        Aws.SimpleDb.Commands.Select,-                       Aws.SimpleDb.Error,-                       Aws.SimpleDb.Info,-                       Aws.SimpleDb.Metadata,-                       Aws.SimpleDb.Model,-                       Aws.SimpleDb.Query,-                       Aws.SimpleDb.Response,+                       Aws.SimpleDb.Core,                        Aws.Sqs,                        Aws.Sqs.Commands,-                       Aws.Sqs.Commands.AddPermission,-                       Aws.Sqs.Commands.DeleteMessage,-                       Aws.Sqs.Commands.DeleteQueue,-                       Aws.Sqs.Commands.ListQueues,-                       Aws.Sqs.Commands.GetQueueAttributes,-                       Aws.Sqs.Commands.ChangeMessageVisibility,-                       Aws.Sqs.Commands.CreateQueue,-                       Aws.Sqs.Commands.ReceiveMessage,-                       Aws.Sqs.Commands.RemovePermission,-                       Aws.Sqs.Commands.SendMessage,-                       Aws.Sqs.Commands.SetQueueAttributes,-                       Aws.Sqs.Error,-                       Aws.Sqs.Info,-                       Aws.Sqs.Metadata,-                       Aws.Sqs.Model,-                       Aws.Sqs.Query,-                       Aws.Sqs.Response,+                       Aws.Sqs.Commands.Permission,+                       Aws.Sqs.Commands.Message,+                       Aws.Sqs.Commands.Queue,+                       Aws.Sqs.Commands.QueueAttributes,+                       Aws.Sqs.Core,                        Aws.Ses,                        Aws.Ses.Commands,                        Aws.Ses.Commands.SendRawEmail,-                       Aws.Ses.Error,-                       Aws.Ses.Info,-                       Aws.Ses.Metadata,-                       Aws.Ses.Model,-                       Aws.Ses.Query,-                       Aws.Ses.Response,-                       Aws.Transaction,-                       Aws.Util,-                       Aws.Xml+                       Aws.Ses.Core    -- Packages needed in order to build this package.   Build-depends:       attempt              >= 0.3.1.1 && < 0.5,