module Aws.Ses.Commands.SendRawEmail
    ( SendRawEmail(..)
    , SendRawEmailResponse(..)
    ) where

import Data.Text (Text)
import Data.Typeable
import Control.Applicative
import qualified Data.ByteString.Char8 as BS
import Text.XML.Cursor (($//))
import qualified Data.Text.Encoding as T
import Prelude

import Aws.Core
import Aws.Ses.Core

-- | Send a raw e-mail message.
data SendRawEmail =
    SendRawEmail
      { SendRawEmail -> [EmailAddress]
srmDestinations :: [EmailAddress]
      , SendRawEmail -> RawMessage
srmRawMessage   :: RawMessage
      , SendRawEmail -> Maybe Sender
srmSource       :: Maybe Sender
      }
    deriving (SendRawEmail -> SendRawEmail -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: SendRawEmail -> SendRawEmail -> Bool
$c/= :: SendRawEmail -> SendRawEmail -> Bool
== :: SendRawEmail -> SendRawEmail -> Bool
$c== :: SendRawEmail -> SendRawEmail -> Bool
Eq, Eq SendRawEmail
SendRawEmail -> SendRawEmail -> Bool
SendRawEmail -> SendRawEmail -> Ordering
SendRawEmail -> SendRawEmail -> SendRawEmail
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: SendRawEmail -> SendRawEmail -> SendRawEmail
$cmin :: SendRawEmail -> SendRawEmail -> SendRawEmail
max :: SendRawEmail -> SendRawEmail -> SendRawEmail
$cmax :: SendRawEmail -> SendRawEmail -> SendRawEmail
>= :: SendRawEmail -> SendRawEmail -> Bool
$c>= :: SendRawEmail -> SendRawEmail -> Bool
> :: SendRawEmail -> SendRawEmail -> Bool
$c> :: SendRawEmail -> SendRawEmail -> Bool
<= :: SendRawEmail -> SendRawEmail -> Bool
$c<= :: SendRawEmail -> SendRawEmail -> Bool
< :: SendRawEmail -> SendRawEmail -> Bool
$c< :: SendRawEmail -> SendRawEmail -> Bool
compare :: SendRawEmail -> SendRawEmail -> Ordering
$ccompare :: SendRawEmail -> SendRawEmail -> Ordering
Ord, Int -> SendRawEmail -> ShowS
[SendRawEmail] -> ShowS
SendRawEmail -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [SendRawEmail] -> ShowS
$cshowList :: [SendRawEmail] -> ShowS
show :: SendRawEmail -> String
$cshow :: SendRawEmail -> String
showsPrec :: Int -> SendRawEmail -> ShowS
$cshowsPrec :: Int -> SendRawEmail -> ShowS
Show, Typeable)

-- | ServiceConfiguration: 'SesConfiguration'
instance SignQuery SendRawEmail where
    type ServiceConfiguration SendRawEmail = SesConfiguration
    signQuery :: forall queryType.
SendRawEmail
-> ServiceConfiguration SendRawEmail queryType
-> SignatureData
-> SignedQuery
signQuery SendRawEmail {[EmailAddress]
Maybe Sender
RawMessage
srmSource :: Maybe Sender
srmRawMessage :: RawMessage
srmDestinations :: [EmailAddress]
srmSource :: SendRawEmail -> Maybe Sender
srmRawMessage :: SendRawEmail -> RawMessage
srmDestinations :: SendRawEmail -> [EmailAddress]
..} =
        forall qt.
[(ByteString, ByteString)]
-> SesConfiguration qt -> SignatureData -> SignedQuery
sesSignQuery forall a b. (a -> b) -> a -> b
$ (ByteString
"Action", ByteString
"SendRawEmail") forall a. a -> [a] -> [a]
:
                       forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat [ [(ByteString, ByteString)]
destinations
                              , forall a. SesAsQuery a => a -> [(ByteString, ByteString)]
sesAsQuery RawMessage
srmRawMessage
                              , forall a. SesAsQuery a => a -> [(ByteString, ByteString)]
sesAsQuery Maybe Sender
srmSource
                              ]
      where
        destinations :: [(ByteString, ByteString)]
destinations = forall a b. [a] -> [b] -> [(a, b)]
zip (Int -> ByteString
enumMember   forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ([Int
1..] :: [Int]))
                           (EmailAddress -> ByteString
T.encodeUtf8 forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$>  [EmailAddress]
srmDestinations)
        enumMember :: Int -> ByteString
enumMember   = ByteString -> ByteString -> ByteString
BS.append ByteString
"Destinations.member." forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> ByteString
BS.pack forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Show a => a -> String
show

-- | The response sent back by Amazon SES after a
-- 'SendRawEmail' command.
data SendRawEmailResponse =
    SendRawEmailResponse { SendRawEmailResponse -> EmailAddress
srmrMessageId :: Text }
    deriving (SendRawEmailResponse -> SendRawEmailResponse -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: SendRawEmailResponse -> SendRawEmailResponse -> Bool
$c/= :: SendRawEmailResponse -> SendRawEmailResponse -> Bool
== :: SendRawEmailResponse -> SendRawEmailResponse -> Bool
$c== :: SendRawEmailResponse -> SendRawEmailResponse -> Bool
Eq, Eq SendRawEmailResponse
SendRawEmailResponse -> SendRawEmailResponse -> Bool
SendRawEmailResponse -> SendRawEmailResponse -> Ordering
SendRawEmailResponse
-> SendRawEmailResponse -> SendRawEmailResponse
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: SendRawEmailResponse
-> SendRawEmailResponse -> SendRawEmailResponse
$cmin :: SendRawEmailResponse
-> SendRawEmailResponse -> SendRawEmailResponse
max :: SendRawEmailResponse
-> SendRawEmailResponse -> SendRawEmailResponse
$cmax :: SendRawEmailResponse
-> SendRawEmailResponse -> SendRawEmailResponse
>= :: SendRawEmailResponse -> SendRawEmailResponse -> Bool
$c>= :: SendRawEmailResponse -> SendRawEmailResponse -> Bool
> :: SendRawEmailResponse -> SendRawEmailResponse -> Bool
$c> :: SendRawEmailResponse -> SendRawEmailResponse -> Bool
<= :: SendRawEmailResponse -> SendRawEmailResponse -> Bool
$c<= :: SendRawEmailResponse -> SendRawEmailResponse -> Bool
< :: SendRawEmailResponse -> SendRawEmailResponse -> Bool
$c< :: SendRawEmailResponse -> SendRawEmailResponse -> Bool
compare :: SendRawEmailResponse -> SendRawEmailResponse -> Ordering
$ccompare :: SendRawEmailResponse -> SendRawEmailResponse -> Ordering
Ord, Int -> SendRawEmailResponse -> ShowS
[SendRawEmailResponse] -> ShowS
SendRawEmailResponse -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [SendRawEmailResponse] -> ShowS
$cshowList :: [SendRawEmailResponse] -> ShowS
show :: SendRawEmailResponse -> String
$cshow :: SendRawEmailResponse -> String
showsPrec :: Int -> SendRawEmailResponse -> ShowS
$cshowsPrec :: Int -> SendRawEmailResponse -> ShowS
Show, Typeable)


instance ResponseConsumer SendRawEmail SendRawEmailResponse where
    type ResponseMetadata SendRawEmailResponse = SesMetadata
    responseConsumer :: Request
-> SendRawEmail
-> IORef (ResponseMetadata SendRawEmailResponse)
-> HTTPResponseConsumer SendRawEmailResponse
responseConsumer Request
_ SendRawEmail
_ =
      forall a.
(Cursor -> Response SesMetadata a)
-> IORef SesMetadata -> HTTPResponseConsumer a
sesResponseConsumer forall a b. (a -> b) -> a -> b
$ \Cursor
cursor -> do
        EmailAddress
messageId <- forall (m :: * -> *) a. MonadThrow m => String -> [a] -> m a
force String
"MessageId not found" forall a b. (a -> b) -> a -> b
$ Cursor
cursor forall node a. Cursor node -> (Cursor node -> [a]) -> [a]
$// EmailAddress -> Cursor -> [EmailAddress]
elContent EmailAddress
"MessageId"
        forall (m :: * -> *) a. Monad m => a -> m a
return (EmailAddress -> SendRawEmailResponse
SendRawEmailResponse EmailAddress
messageId)


instance Transaction SendRawEmail SendRawEmailResponse where

instance AsMemoryResponse SendRawEmailResponse where
    type MemoryResponse SendRawEmailResponse = SendRawEmailResponse
    loadToMemory :: SendRawEmailResponse
-> ResourceT IO (MemoryResponse SendRawEmailResponse)
loadToMemory = forall (m :: * -> *) a. Monad m => a -> m a
return