packages feed

aws 0.1 → 0.2

raw patch · 21 files changed

+382/−51 lines, 21 filesdep −tlsdep ~http-conduitPVP ok

version bump matches the API change (PVP)

Dependencies removed: tls

Dependency ranges changed: http-conduit

API changes (from Hackage documentation)

- Aws.Debug: debugPrint :: Show a => String -> a -> IO ()
- Aws.Response: instance ResponseConsumer r Response
+ Aws.Aws: Debug :: LogLevel
+ Aws.Aws: Error :: LogLevel
+ Aws.Aws: Info :: LogLevel
+ Aws.Aws: Warning :: LogLevel
+ Aws.Aws: data LogLevel
+ Aws.Aws: defaultLog :: LogLevel -> LogLevel -> Text -> IO ()
+ Aws.Aws: instance ConfigurationFetch SesInfo
+ Aws.Aws: instance Eq LogLevel
+ Aws.Aws: instance Ord LogLevel
+ Aws.Aws: instance Show LogLevel
+ Aws.Aws: logger :: Configuration -> LogLevel -> Text -> IO ()
+ Aws.Aws: sesInfo :: Configuration -> SesInfo
+ Aws.Aws: sesInfoUri :: Configuration -> SesInfo
+ Aws.Aws: simpleAws :: (Transaction r a, ConfigurationFetch (Info r)) => Configuration -> r -> IO (Response (ResponseMetadata a) a)
+ Aws.Response: instance ResponseConsumer r (Response ByteString)
+ Aws.Response: type HTTPResponseConsumer a = Status -> ResponseHeaders -> BufferedSource IO ByteString -> ResourceT IO a
+ Aws.Ses.Commands.SendRawEmail: SendRawEmail :: Maybe Destination -> RawMessage -> Maybe Sender -> SendRawEmail
+ Aws.Ses.Commands.SendRawEmail: SendRawEmailResponse :: Text -> SendRawEmailResponse
+ Aws.Ses.Commands.SendRawEmail: data SendRawEmail
+ Aws.Ses.Commands.SendRawEmail: data SendRawEmailResponse
+ Aws.Ses.Commands.SendRawEmail: instance Eq SendRawEmail
+ Aws.Ses.Commands.SendRawEmail: instance Eq SendRawEmailResponse
+ Aws.Ses.Commands.SendRawEmail: instance Ord SendRawEmail
+ Aws.Ses.Commands.SendRawEmail: instance Ord SendRawEmailResponse
+ Aws.Ses.Commands.SendRawEmail: instance ResponseConsumer SendRawEmail SendRawEmailResponse
+ Aws.Ses.Commands.SendRawEmail: instance Show SendRawEmail
+ Aws.Ses.Commands.SendRawEmail: instance Show SendRawEmailResponse
+ Aws.Ses.Commands.SendRawEmail: instance SignQuery SendRawEmail
+ Aws.Ses.Commands.SendRawEmail: instance Transaction SendRawEmail SendRawEmailResponse
+ Aws.Ses.Commands.SendRawEmail: instance Typeable SendRawEmail
+ Aws.Ses.Commands.SendRawEmail: instance Typeable SendRawEmailResponse
+ Aws.Ses.Commands.SendRawEmail: srmDestinations :: SendRawEmail -> Maybe Destination
+ Aws.Ses.Commands.SendRawEmail: srmRawMessage :: SendRawEmail -> RawMessage
+ Aws.Ses.Commands.SendRawEmail: srmSource :: SendRawEmail -> Maybe Sender
+ Aws.Ses.Commands.SendRawEmail: srmrMessageId :: SendRawEmailResponse -> Text
+ Aws.Ses.Error: SesError :: Status -> Text -> Text -> SesError
+ Aws.Ses.Error: data SesError
+ Aws.Ses.Error: instance Exception SesError
+ Aws.Ses.Error: instance Show SesError
+ Aws.Ses.Error: instance Typeable SesError
+ Aws.Ses.Error: sesErrorCode :: SesError -> Text
+ Aws.Ses.Error: sesErrorMessage :: SesError -> Text
+ Aws.Ses.Error: sesStatusCode :: SesError -> Status
+ Aws.Ses.Info: SesInfo :: Method -> ByteString -> SesInfo
+ Aws.Ses.Info: data SesInfo
+ Aws.Ses.Info: instance Show SesInfo
+ Aws.Ses.Info: sesHttpsGet :: ByteString -> SesInfo
+ Aws.Ses.Info: sesHttpsPost :: ByteString -> SesInfo
+ Aws.Ses.Info: sesUsEast :: ByteString
+ Aws.Ses.Info: sesiHost :: SesInfo -> ByteString
+ Aws.Ses.Info: sesiHttpMethod :: SesInfo -> Method
+ Aws.Ses.Metadata: SesMetadata :: Maybe Text -> SesMetadata
+ Aws.Ses.Metadata: data SesMetadata
+ Aws.Ses.Metadata: instance Monoid SesMetadata
+ Aws.Ses.Metadata: instance Show SesMetadata
+ Aws.Ses.Metadata: instance Typeable SesMetadata
+ Aws.Ses.Metadata: requestId :: SesMetadata -> Maybe Text
+ Aws.Ses.Model: Destination :: [EmailAddress] -> [EmailAddress] -> [EmailAddress] -> Destination
+ Aws.Ses.Model: RawMessage :: ByteString -> RawMessage
+ Aws.Ses.Model: Sender :: EmailAddress -> Sender
+ Aws.Ses.Model: data Destination
+ Aws.Ses.Model: data RawMessage
+ Aws.Ses.Model: data Sender
+ Aws.Ses.Model: destinationBccAddresses :: Destination -> [EmailAddress]
+ Aws.Ses.Model: destinationCcAddresses :: Destination -> [EmailAddress]
+ Aws.Ses.Model: destinationToAddresses :: Destination -> [EmailAddress]
+ Aws.Ses.Model: instance Eq Destination
+ Aws.Ses.Model: instance Eq RawMessage
+ Aws.Ses.Model: instance Eq Sender
+ Aws.Ses.Model: instance Monoid Destination
+ Aws.Ses.Model: instance Ord Destination
+ Aws.Ses.Model: instance Ord RawMessage
+ Aws.Ses.Model: instance Ord Sender
+ Aws.Ses.Model: instance SesAsQuery Destination
+ Aws.Ses.Model: instance SesAsQuery RawMessage
+ Aws.Ses.Model: instance SesAsQuery Sender
+ Aws.Ses.Model: instance SesAsQuery a => SesAsQuery (Maybe a)
+ Aws.Ses.Model: instance Show Destination
+ Aws.Ses.Model: instance Show RawMessage
+ Aws.Ses.Model: instance Show Sender
+ Aws.Ses.Model: instance Typeable Destination
+ Aws.Ses.Model: instance Typeable RawMessage
+ Aws.Ses.Model: instance Typeable Sender
+ Aws.Ses.Model: rawMessageData :: RawMessage -> ByteString
+ Aws.Ses.Model: senderAddress :: Sender -> EmailAddress
+ Aws.Ses.Model: sesAsQuery :: SesAsQuery a => a -> [(ByteString, ByteString)]
+ Aws.Ses.Model: type EmailAddress = Text
+ Aws.Ses.Query: sesSignQuery :: [(ByteString, ByteString)] -> SesInfo -> SignatureData -> SignedQuery
+ Aws.Ses.Response: sesResponseConsumer :: (Cursor -> Response SesMetadata a) -> IORef SesMetadata -> HTTPResponseConsumer a
- Aws.Aws: Configuration :: TimeInfo -> Credentials -> SdbInfo -> SdbInfo -> S3Info -> S3Info -> SqsInfo -> SqsInfo -> Configuration
+ Aws.Aws: Configuration :: TimeInfo -> Credentials -> SdbInfo -> SdbInfo -> S3Info -> S3Info -> SqsInfo -> SqsInfo -> SesInfo -> SesInfo -> (LogLevel -> Text -> IO ()) -> Configuration
- Aws.Aws: aws :: (Transaction r a, ConfigurationFetch (Info r)) => Configuration -> r -> IO (Response (ResponseMetadata a) a)
+ Aws.Aws: aws :: (Transaction r a, ConfigurationFetch (Info r)) => Configuration -> Manager -> r -> IO (Response (ResponseMetadata a) a)
- Aws.Aws: unsafeAws :: (ResponseConsumer r a, Monoid (ResponseMetadata a), SignQuery r, ConfigurationFetch (Info r)) => Configuration -> r -> IO (Response (ResponseMetadata a) a)
+ Aws.Aws: unsafeAws :: (ResponseConsumer r a, Monoid (ResponseMetadata a), SignQuery r, ConfigurationFetch (Info r)) => Configuration -> Manager -> r -> IO (Response (ResponseMetadata a) a)
- Aws.Response: responseConsumer :: ResponseConsumer r a => r -> IORef (ResponseMetadata a) -> ResponseConsumer IO a
+ Aws.Response: responseConsumer :: ResponseConsumer r a => r -> IORef (ResponseMetadata a) -> HTTPResponseConsumer a
- Aws.S3.Commands.GetObject: GetObject :: Bucket -> Object -> ResponseConsumer IO a -> Maybe Text -> Maybe Text -> Maybe Text -> Maybe Text -> Maybe Text -> Maybe Text -> GetObject a
+ Aws.S3.Commands.GetObject: GetObject :: Bucket -> Object -> HTTPResponseConsumer a -> Maybe Text -> Maybe Text -> Maybe Text -> Maybe Text -> Maybe Text -> Maybe Text -> GetObject a
- Aws.S3.Commands.GetObject: getObject :: Bucket -> Text -> (ResponseConsumer IO a) -> GetObject a
+ Aws.S3.Commands.GetObject: getObject :: Bucket -> Text -> HTTPResponseConsumer a -> GetObject a
- Aws.S3.Commands.GetObject: goResponseConsumer :: GetObject a -> ResponseConsumer IO a
+ Aws.S3.Commands.GetObject: goResponseConsumer :: GetObject a -> HTTPResponseConsumer a
- Aws.S3.Response: s3BinaryResponseConsumer :: ResponseConsumer IO a -> IORef S3Metadata -> ResponseConsumer IO a
+ Aws.S3.Response: s3BinaryResponseConsumer :: HTTPResponseConsumer a -> IORef S3Metadata -> HTTPResponseConsumer a
- Aws.S3.Response: s3ErrorResponseConsumer :: ResponseConsumer IO a
+ Aws.S3.Response: s3ErrorResponseConsumer :: HTTPResponseConsumer a
- Aws.S3.Response: s3ResponseConsumer :: ResponseConsumer IO a -> IORef S3Metadata -> ResponseConsumer IO a
+ Aws.S3.Response: s3ResponseConsumer :: HTTPResponseConsumer a -> IORef S3Metadata -> HTTPResponseConsumer a
- Aws.S3.Response: s3XmlResponseConsumer :: (Cursor -> Response S3Metadata a) -> IORef S3Metadata -> ResponseConsumer IO a
+ Aws.S3.Response: s3XmlResponseConsumer :: (Cursor -> Response S3Metadata a) -> IORef S3Metadata -> HTTPResponseConsumer a
- Aws.SimpleDb.Response: sdbResponseConsumer :: (Cursor -> Response SdbMetadata a) -> IORef SdbMetadata -> ResponseConsumer IO a
+ Aws.SimpleDb.Response: sdbResponseConsumer :: (Cursor -> Response SdbMetadata a) -> IORef SdbMetadata -> HTTPResponseConsumer a
- Aws.Sqs.Response: sqsErrorResponseConsumer :: ResponseConsumer IO a
+ Aws.Sqs.Response: sqsErrorResponseConsumer :: HTTPResponseConsumer a
- Aws.Sqs.Response: sqsResponseConsumer :: ResponseConsumer IO a -> IORef SqsMetadata -> ResponseConsumer IO a
+ Aws.Sqs.Response: sqsResponseConsumer :: HTTPResponseConsumer a -> IORef SqsMetadata -> HTTPResponseConsumer a
- Aws.Sqs.Response: sqsXmlResponseConsumer :: (Cursor -> Response SqsMetadata a) -> IORef SqsMetadata -> ResponseConsumer IO a
+ Aws.Sqs.Response: sqsXmlResponseConsumer :: (Cursor -> Response SqsMetadata a) -> IORef SqsMetadata -> HTTPResponseConsumer a
- Aws.Xml: xmlCursorConsumer :: Monoid m => (Cursor -> Response m a) -> IORef m -> ResponseConsumer IO a
+ Aws.Xml: xmlCursorConsumer :: Monoid m => (Cursor -> Response m a) -> IORef m -> HTTPResponseConsumer a

Files

Aws.hs view
@@ -2,7 +2,6 @@ (   module Aws.Aws , module Aws.Credentials-, module Aws.Debug , module Aws.Http , module Aws.Query , module Aws.Response@@ -15,7 +14,6 @@  import Aws.Aws import Aws.Credentials-import Aws.Debug import Aws.Http import Aws.Query import Aws.Response
Aws/Aws.hs view
@@ -1,25 +1,37 @@-{-# LANGUAGE FlexibleContexts #-}+{-# LANGUAGE FlexibleContexts, OverloadedStrings #-} module Aws.Aws where  import           Aws.Credentials-import           Aws.Debug 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           Control.Applicative-import           Data.Attempt            (attemptIO)+import           Control.Monad.Trans  (liftIO)+import           Data.Attempt         (attemptIO)+import           Data.Conduit         (runResourceT) import           Data.IORef import           Data.Monoid-import qualified Control.Exception       as E-import qualified Data.ByteString         as B-import qualified Network.HTTP.Conduit    as HTTP+import           System.IO            (stderr)+import qualified Control.Exception    as E+import qualified Data.ByteString      as B+import qualified Data.Text            as T+import qualified Data.Text.IO         as T+import qualified Network.HTTP.Conduit as HTTP +data LogLevel+    = Debug+    | Info+    | Warning+    | Error+    deriving (Show, Eq, Ord)+ data Configuration     = Configuration {        timeInfo :: TimeInfo@@ -30,8 +42,15 @@       , s3InfoUri :: S3Info       , sqsInfo :: SqsInfo       , sqsInfoUri :: SqsInfo+      , sesInfo :: SesInfo+      , sesInfoUri :: SesInfo+      , logger :: LogLevel -> T.Text -> IO ()       } +defaultLog :: LogLevel -> LogLevel -> T.Text -> IO ()+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@@ -52,6 +71,10 @@     configurationFetch = sqsInfo     configurationFetchUri = sqsInfoUri +instance ConfigurationFetch SesInfo where+    configurationFetch = sesInfo+    configurationFetchUri = sesInfoUri+ baseConfiguration :: IO Configuration baseConfiguration = do   Just cr <- loadCredentialsDefault@@ -64,34 +87,48 @@                     , 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   c <- baseConfiguration-  return c { sdbInfo = sdbHttpPost sdbUsEast, sdbInfoUri = sdbHttpGet sdbUsEast  }+  return c {+      sdbInfo = sdbHttpPost sdbUsEast+    , sdbInfoUri = sdbHttpGet sdbUsEast+    , logger = defaultLog Debug+    }  aws :: (Transaction r a        , ConfigurationFetch (Info r))-      => Configuration -> r -> IO (Response (ResponseMetadata a) a)+      => Configuration -> HTTP.Manager -> r -> IO (Response (ResponseMetadata a) a) aws = unsafeAws +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+ unsafeAws   :: (ResponseConsumer r a,       Monoid (ResponseMetadata a),       SignQuery r,       ConfigurationFetch (Info r)) =>-     Configuration -> r -> IO (Response (ResponseMetadata a) a)-unsafeAws cfg request = do+     Configuration -> HTTP.Manager -> r -> IO (Response (ResponseMetadata a) a)+unsafeAws cfg manager request = do   sd <- signatureData <$> timeInfo <*> credentials $ cfg   let info = configurationFetch cfg   let q = signQuery request info sd-  debugPrint "String to sign" $ sqStringToSign q+  logger cfg Debug $ T.pack $ "String to sign: " ++ show (sqStringToSign q)   let httpRequest = queryToHttpRequest q   metadataRef <- newIORef mempty   resp <- attemptIO (id :: E.SomeException -> E.SomeException) $-          HTTP.withManager $ HTTP.httpRedirect httpRequest (responseConsumer request metadataRef)+          runResourceT $ do+            HTTP.Response status headers body <- HTTP.http httpRequest manager+            responseConsumer request metadataRef status headers body   metadata <- readIORef metadataRef   return $ Response metadata resp @@ -104,6 +141,6 @@       info = configurationFetchUri cfg   sd <- signatureData ti cr   let q = signQuery request info sd-  debugPrint "String to sign" $ sqStringToSign q+  logger cfg Debug $ T.pack $ "String to sign: " ++ show (sqStringToSign q)   return $ queryToUri q 
− Aws/Debug.hs
@@ -1,5 +0,0 @@-module Aws.Debug-where-  -debugPrint :: (Show a) => String -> a -> IO ()-debugPrint p v = putStrLn $ "AWS Debug: " ++ p ++ " - " ++ show v
Aws/Query.hs view
@@ -13,7 +13,6 @@ import qualified Data.Text.Encoding       as T import qualified Network.HTTP.Conduit     as HTTP import qualified Network.HTTP.Types       as HTTP-import qualified Network.TLS              as TLS  data SignedQuery     = SignedQuery {@@ -41,7 +40,6 @@       , HTTP.secure = case sqProtocol of                         HTTP -> False                         HTTPS -> True-      , HTTP.checkCerts = \_ _ -> return TLS.CertificateUsageAccept -- FIXME: actually check certificates       , HTTP.host = sqHost       , HTTP.port = sqPort       , HTTP.path = sqPath@@ -58,6 +56,7 @@                                             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"
Aws/Response.hs view
@@ -3,12 +3,17 @@ module Aws.Response where +import           Data.ByteString         (ByteString)+import           Data.Conduit            (BufferedSource, 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)@@ -28,10 +33,17 @@ tellMetadataRef :: Monoid m => IORef m -> m -> IO () tellMetadataRef r m = modifyIORef r (`mappend` m) +type HTTPResponseConsumer a =  HTTP.Status+                            -> HTTP.ResponseHeaders+                            -> BufferedSource IO ByteString+                            -> ResourceT IO a+ class ResponseConsumer r a where     type ResponseMetadata a-    responseConsumer :: r -> IORef (ResponseMetadata a) -> HTTP.ResponseConsumer IO a+    responseConsumer :: r -> IORef (ResponseMetadata a) -> HTTPResponseConsumer a -instance ResponseConsumer r HTTP.Response where-    type ResponseMetadata HTTP.Response = ()-    responseConsumer _ _ = HTTP.lbsConsumer+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 headers $ L.fromChunks chunks)
Aws/S3/Commands/GetObject.hs view
@@ -17,14 +17,13 @@ import           Data.Maybe import qualified Data.Text             as T import qualified Data.Text.Encoding    as T-import qualified Network.HTTP.Conduit  as HTTP import qualified Network.HTTP.Types    as HTTP  data GetObject a     = GetObject {         goBucket :: Bucket       , goObjectName :: Object-      , goResponseConsumer :: HTTP.ResponseConsumer IO a+      , goResponseConsumer :: HTTPResponseConsumer a       , goResponseContentType :: Maybe T.Text       , goResponseContentLanguage :: Maybe T.Text       , goResponseExpires :: Maybe T.Text@@ -33,7 +32,7 @@       , goResponseContentEncoding :: Maybe T.Text       } -getObject :: Bucket -> T.Text -> (HTTP.ResponseConsumer IO a) -> GetObject a+getObject :: Bucket -> T.Text -> HTTPResponseConsumer a -> GetObject a getObject b o i = GetObject b o i Nothing Nothing Nothing Nothing Nothing Nothing  data GetObjectResponse a
Aws/S3/Commands/PutObject.hs view
@@ -70,8 +70,9 @@  instance ResponseConsumer PutObject PutObjectResponse where     type ResponseMetadata PutObjectResponse = S3Metadata-    responseConsumer _ = s3ResponseConsumer $ \_ _ _ ->-                         return $ PutObjectResponse Nothing+    responseConsumer _ = s3ResponseConsumer $ \_status headers _body -> do+      let vid = T.decodeUtf8 `fmap` lookup "x-amz-version-id" headers+      return $ PutObjectResponse vid  instance Transaction PutObject PutObjectResponse 
Aws/S3/Response.hs view
@@ -16,14 +16,13 @@ import qualified Data.ByteString              as B import qualified Data.Conduit                 as C 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.Cursor              as Cu import qualified Text.XML                     as XML -s3ResponseConsumer :: HTTP.ResponseConsumer IO a+s3ResponseConsumer :: HTTPResponseConsumer a                    -> IORef S3Metadata-                   -> HTTP.ResponseConsumer IO a+                   -> HTTPResponseConsumer a s3ResponseConsumer inner metadata status headers source = do       let headerString = fmap T.decodeUtf8 . flip lookup headers       let amzId2 = headerString "x-amz-id-2"@@ -38,16 +37,16 @@  s3XmlResponseConsumer :: (Cu.Cursor -> Response S3Metadata a)                       -> IORef S3Metadata-                      -> HTTP.ResponseConsumer IO a+                      -> HTTPResponseConsumer a s3XmlResponseConsumer parse metadataRef =     s3ResponseConsumer (xmlCursorConsumer parse metadataRef) metadataRef -s3BinaryResponseConsumer :: HTTP.ResponseConsumer IO a+s3BinaryResponseConsumer :: HTTPResponseConsumer a                          -> IORef S3Metadata-                         -> HTTP.ResponseConsumer IO a+                         -> HTTPResponseConsumer a s3BinaryResponseConsumer inner metadataRef = s3ResponseConsumer inner metadataRef -s3ErrorResponseConsumer :: HTTP.ResponseConsumer IO a+s3ErrorResponseConsumer :: HTTPResponseConsumer a s3ErrorResponseConsumer status _headers source     = do doc <- source $$ XML.sinkDoc XML.def          let cursor = Cu.fromDocument doc
+ Aws/Ses.hs view
@@ -0,0 +1,17 @@+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+    ) 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
+ Aws/Ses/Commands.hs view
@@ -0,0 +1,5 @@+module Aws.Ses.Commands+    ( module Aws.Ses.Commands.SendRawEmail+    ) where++import Aws.Ses.Commands.SendRawEmail
+ Aws/Ses/Commands/SendRawEmail.hs view
@@ -0,0 +1,54 @@+{-# LANGUAGE DeriveDataTypeable, RecordWildCards, TypeFamilies, MultiParamTypeClasses, OverloadedStrings #-}+module Aws.Ses.Commands.SendRawEmail+    ( SendRawEmail(..)+    , SendRawEmailResponse(..)+    ) where++import Data.Text (Text)+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++-- | Send a raw e-mail message.+data SendRawEmail =+    SendRawEmail+      { srmDestinations :: Maybe Destination+      , srmRawMessage   :: RawMessage+      , srmSource       :: Maybe Sender+      }+    deriving (Eq, Ord, Show, Typeable)++instance SignQuery SendRawEmail where+    type Info SendRawEmail = SesInfo+    signQuery SendRawEmail {..} =+        sesSignQuery $ ("Action", "SendRawEmail") :+                       concat [ sesAsQuery srmDestinations+                              , sesAsQuery srmRawMessage+                              , sesAsQuery srmSource+                              ]++-- | The response sent back by Amazon SES after a+-- 'SendRawEmail' command.+data SendRawEmailResponse =+    SendRawEmailResponse { srmrMessageId :: Text }+    deriving (Eq, Ord, Show, Typeable)+++instance ResponseConsumer SendRawEmail SendRawEmailResponse where+    type ResponseMetadata SendRawEmailResponse = SesMetadata+    responseConsumer _ =+      sesResponseConsumer $ \cursor -> do+        messageId <- force "MessageId not found" $ cursor $// elContent "MessageId"+        return (SendRawEmailResponse messageId)+++instance Transaction SendRawEmail SendRawEmailResponse where
+ Aws/Ses/Error.hs view
@@ -0,0 +1,20 @@+{-# 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
+ Aws/Ses/Info.hs view
@@ -0,0 +1,26 @@+{-# 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
+ Aws/Ses/Metadata.hs view
@@ -0,0 +1,19 @@+{-# 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)
+ Aws/Ses/Model.hs view
@@ -0,0 +1,73 @@+{-# 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
+ Aws/Ses/Query.hs view
@@ -0,0 +1,43 @@+{-# 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
+ Aws/Ses/Response.hs view
@@ -0,0 +1,30 @@+{-# 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
Aws/SimpleDb/Response.hs view
@@ -13,12 +13,11 @@ import qualified Data.ByteString.Base64     as Base64 import qualified Data.Text                  as T import qualified Data.Text.Encoding         as T-import qualified Network.HTTP.Conduit       as HTTP import qualified Text.XML.Cursor            as Cu  sdbResponseConsumer :: (Cu.Cursor -> Response SdbMetadata a)                     -> IORef SdbMetadata-                    -> HTTP.ResponseConsumer IO a+                    -> HTTPResponseConsumer a sdbResponseConsumer inner metadataRef status headers source     = xmlCursorConsumer parse metadataRef status headers source     where parse cursor
Aws/Sqs/Response.hs view
@@ -13,14 +13,13 @@ import           Text.XML.Cursor              (($/)) import qualified Data.Conduit                 as C 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.Cursor              as Cu import qualified Text.XML                     as XML -sqsResponseConsumer :: HTTP.ResponseConsumer IO a+sqsResponseConsumer :: HTTPResponseConsumer a                     -> IORef SqsMetadata-                    -> HTTP.ResponseConsumer IO a+                    -> HTTPResponseConsumer a sqsResponseConsumer inner metadata status headers source = do       let headerString = fmap T.decodeUtf8 . flip lookup headers       let amzId2 = headerString "x-amz-id-2"@@ -35,10 +34,10 @@  sqsXmlResponseConsumer :: (Cu.Cursor -> Response SqsMetadata a)                        -> IORef SqsMetadata-                       -> HTTP.ResponseConsumer IO a+                       -> HTTPResponseConsumer a sqsXmlResponseConsumer parse metadataRef = sqsResponseConsumer (xmlCursorConsumer parse metadataRef) metadataRef -sqsErrorResponseConsumer :: HTTP.ResponseConsumer IO a+sqsErrorResponseConsumer :: HTTPResponseConsumer a sqsErrorResponseConsumer status _headers source     = do doc <- source $$ XML.sinkDoc XML.def          let cursor = Cu.fromDocument doc
Aws/Xml.hs view
@@ -14,7 +14,6 @@ import qualified Control.Failure              as F import qualified Data.Conduit                 as C import qualified Data.Text                    as T-import qualified Network.HTTP.Conduit         as HTTP import qualified Text.XML.Cursor              as Cu import qualified Text.XML                     as XML @@ -49,7 +48,7 @@     (Monoid m)     => (Cu.Cursor -> Response m a)     -> IORef m-    -> HTTP.ResponseConsumer IO a+    -> HTTPResponseConsumer a xmlCursorConsumer parse metadataRef _status _headers source     = do doc <- source $$ XML.sinkDoc XML.def          let cursor = Cu.fromDocument doc
aws.cabal view
@@ -6,7 +6,7 @@ -- The package version. See the Haskell package versioning policy -- (http://www.haskell.org/haskellwiki/Package_versioning_policy) for -- standards guiding when and how versions should be incremented.-Version:             0.1+Version:             0.2  -- A short (one-line) description of the package. Synopsis:            Amazon Web Services (AWS) for Haskell@@ -51,7 +51,6 @@                        Aws,                        Aws.Aws,                        Aws.Credentials,-                       Aws.Debug,                        Aws.Http,                        Aws.Query,                        Aws.Response,@@ -107,6 +106,15 @@                        Aws.Sqs.Model,                        Aws.Sqs.Query,                        Aws.Sqs.Response,+                       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@@ -125,7 +133,7 @@                        directory            >= 1.0     && < 1.2,                        failure              >= 0.1.0.1 && < 0.2,                        filepath             >= 1.1     && < 1.3,-                       http-conduit         >= 1.0     && < 1.1,+                       http-conduit         >= 1.1.2.2 && < 1.2,                        http-types           >= 0.6     && < 0.7,                        lifted-base          == 0.1.*,                        mtl                  == 2.*,@@ -133,7 +141,6 @@                        shortcircuit         == 0.1.*,                        text                 >= 0.11,                        time                 >= 1.1.4   && < 1.3,-                       tls                  >= 0.7.1,                        transformers         >= 0.2.2.0 && < 0.3,                        utf8-string          == 0.3.*,                        xml-conduit          >= 0.5.0