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 +0/−2
- Aws/Aws.hs +50/−13
- Aws/Debug.hs +0/−5
- Aws/Query.hs +1/−2
- Aws/Response.hs +16/−4
- Aws/S3/Commands/GetObject.hs +2/−3
- Aws/S3/Commands/PutObject.hs +3/−2
- Aws/S3/Response.hs +6/−7
- Aws/Ses.hs +17/−0
- Aws/Ses/Commands.hs +5/−0
- Aws/Ses/Commands/SendRawEmail.hs +54/−0
- Aws/Ses/Error.hs +20/−0
- Aws/Ses/Info.hs +26/−0
- Aws/Ses/Metadata.hs +19/−0
- Aws/Ses/Model.hs +73/−0
- Aws/Ses/Query.hs +43/−0
- Aws/Ses/Response.hs +30/−0
- Aws/SimpleDb/Response.hs +1/−2
- Aws/Sqs/Response.hs +4/−5
- Aws/Xml.hs +1/−2
- aws.cabal +11/−4
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