module Aws.Ses.Core
    ( SesError(..)
    , SesMetadata(..)

    , SesConfiguration(..)
    , sesEuWest1
    , sesUsEast
    , sesUsEast1
    , sesUsWest2
    , sesHttpsGet
    , sesHttpsPost

    , sesSignQuery

    , sesResponseConsumer

    , RawMessage(..)
    , Destination(..)
    , EmailAddress
    , Sender(..)
    , sesAsQuery
    ) where

import           Aws.Core
import qualified Blaze.ByteString.Builder       as Blaze
import qualified Blaze.ByteString.Builder.Char8 as Blaze8
import qualified Control.Exception              as C
import           Control.Monad                  (mplus)
import           Control.Monad.Trans.Resource   (throwM)
import qualified Data.ByteString                as B
import qualified Data.ByteString.Base64         as B64
import           Data.ByteString.Char8          ({-IsString-})
import           Data.IORef
import           Data.Maybe
import           Data.Monoid
import qualified Data.Semigroup                 as Sem
import           Data.Text                      (Text)
import qualified Data.Text.Encoding             as TE
import           Data.Typeable
import           Prelude
import qualified Network.HTTP.Conduit           as HTTP
import qualified Network.HTTP.Types             as HTTP
import           Text.XML.Cursor                (($/), ($//))
import qualified Text.XML.Cursor                as Cu

data SesError
    = SesError {
        SesError -> Status
sesStatusCode   :: HTTP.Status
      , SesError -> Text
sesErrorCode    :: Text
      , SesError -> Text
sesErrorMessage :: Text
      }
    deriving (Int -> SesError -> ShowS
[SesError] -> ShowS
SesError -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [SesError] -> ShowS
$cshowList :: [SesError] -> ShowS
show :: SesError -> String
$cshow :: SesError -> String
showsPrec :: Int -> SesError -> ShowS
$cshowsPrec :: Int -> SesError -> ShowS
Show, Typeable)

instance C.Exception SesError

data SesMetadata
    = SesMetadata {
        SesMetadata -> Maybe Text
requestId :: Maybe Text
      }
    deriving (Int -> SesMetadata -> ShowS
[SesMetadata] -> ShowS
SesMetadata -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [SesMetadata] -> ShowS
$cshowList :: [SesMetadata] -> ShowS
show :: SesMetadata -> String
$cshow :: SesMetadata -> String
showsPrec :: Int -> SesMetadata -> ShowS
$cshowsPrec :: Int -> SesMetadata -> ShowS
Show, Typeable)

instance Loggable SesMetadata where
    toLogText :: SesMetadata -> Text
toLogText (SesMetadata Maybe Text
rid) = Text
"SES: request ID=" forall a. Monoid a => a -> a -> a
`mappend` forall a. a -> Maybe a -> a
fromMaybe Text
"<none>" Maybe Text
rid

instance Sem.Semigroup SesMetadata where
    SesMetadata Maybe Text
r1 <> :: SesMetadata -> SesMetadata -> SesMetadata
<> SesMetadata Maybe Text
r2 = Maybe Text -> SesMetadata
SesMetadata (Maybe Text
r1 forall (m :: * -> *) a. MonadPlus m => m a -> m a -> m a
`mplus` Maybe Text
r2)

instance Monoid SesMetadata where
    mempty :: SesMetadata
mempty = Maybe Text -> SesMetadata
SesMetadata forall a. Maybe a
Nothing
    mappend :: SesMetadata -> SesMetadata -> SesMetadata
mappend = forall a. Semigroup a => a -> a -> a
(Sem.<>)

data SesConfiguration qt
    = SesConfiguration {
        forall qt. SesConfiguration qt -> Method
sesiHttpMethod :: Method
      , forall qt. SesConfiguration qt -> ByteString
sesiHost       :: B.ByteString
      }
    deriving (Int -> SesConfiguration qt -> ShowS
forall qt. Int -> SesConfiguration qt -> ShowS
forall qt. [SesConfiguration qt] -> ShowS
forall qt. SesConfiguration qt -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [SesConfiguration qt] -> ShowS
$cshowList :: forall qt. [SesConfiguration qt] -> ShowS
show :: SesConfiguration qt -> String
$cshow :: forall qt. SesConfiguration qt -> String
showsPrec :: Int -> SesConfiguration qt -> ShowS
$cshowsPrec :: forall qt. Int -> SesConfiguration qt -> ShowS
Show)

-- HTTP is not supported right now, always use HTTPS
instance DefaultServiceConfiguration (SesConfiguration NormalQuery) where
    defServiceConfig :: SesConfiguration NormalQuery
defServiceConfig = ByteString -> SesConfiguration NormalQuery
sesHttpsPost ByteString
sesUsEast1

instance DefaultServiceConfiguration (SesConfiguration UriOnlyQuery) where
    defServiceConfig :: SesConfiguration UriOnlyQuery
defServiceConfig = forall qt. ByteString -> SesConfiguration qt
sesHttpsGet ByteString
sesUsEast1

sesEuWest1 :: B.ByteString
sesEuWest1 :: ByteString
sesEuWest1 = ByteString
"email.eu-west-1.amazonaws.com"

sesUsEast :: B.ByteString
sesUsEast :: ByteString
sesUsEast = ByteString
sesUsEast1

sesUsEast1 :: B.ByteString
sesUsEast1 :: ByteString
sesUsEast1 = ByteString
"email.us-east-1.amazonaws.com"

sesUsWest2 :: B.ByteString
sesUsWest2 :: ByteString
sesUsWest2 = ByteString
"email.us-west-2.amazonaws.com"

sesHttpsGet :: B.ByteString -> SesConfiguration qt
sesHttpsGet :: forall qt. ByteString -> SesConfiguration qt
sesHttpsGet ByteString
endpoint = forall qt. Method -> ByteString -> SesConfiguration qt
SesConfiguration Method
Get ByteString
endpoint

sesHttpsPost :: B.ByteString -> SesConfiguration NormalQuery
sesHttpsPost :: ByteString -> SesConfiguration NormalQuery
sesHttpsPost ByteString
endpoint = forall qt. Method -> ByteString -> SesConfiguration qt
SesConfiguration Method
PostQuery ByteString
endpoint

sesSignQuery :: [(B.ByteString, B.ByteString)] -> SesConfiguration qt -> SignatureData -> SignedQuery
sesSignQuery :: forall qt.
[(ByteString, ByteString)]
-> SesConfiguration qt -> SignatureData -> SignedQuery
sesSignQuery [(ByteString, ByteString)]
query SesConfiguration qt
si SignatureData
sd
    = SignedQuery {
        sqMethod :: Method
sqMethod        = forall qt. SesConfiguration qt -> Method
sesiHttpMethod SesConfiguration qt
si
      , sqProtocol :: Protocol
sqProtocol      = Protocol
HTTPS
      , sqHost :: ByteString
sqHost          = forall qt. SesConfiguration qt -> ByteString
sesiHost SesConfiguration qt
si
      , sqPort :: Int
sqPort          = Protocol -> Int
defaultPort Protocol
HTTPS
      , sqPath :: ByteString
sqPath          = ByteString
"/"
      , sqQuery :: Query
sqQuery         = [(ByteString, ByteString)] -> Query
HTTP.simpleQueryToQuery [(ByteString, ByteString)]
query'
      , sqDate :: Maybe UTCTime
sqDate          = forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ SignatureData -> UTCTime
signatureTime SignatureData
sd
      , sqAuthorization :: Maybe (IO ByteString)
sqAuthorization = forall a. Maybe a
Nothing
      , sqContentType :: Maybe ByteString
sqContentType   = forall a. Maybe a
Nothing
      , sqContentMd5 :: Maybe (Digest MD5)
sqContentMd5    = forall a. Maybe a
Nothing
      , sqAmzHeaders :: RequestHeaders
sqAmzHeaders    = RequestHeaders
amzHeaders
      , sqOtherHeaders :: RequestHeaders
sqOtherHeaders  = []
      , sqBody :: Maybe RequestBody
sqBody          = forall a. Maybe a
Nothing
      , sqStringToSign :: ByteString
sqStringToSign  = ByteString
stringToSign
      }
    where
      stringToSign :: ByteString
stringToSign  = UTCTime -> ByteString
fmtRfc822Time (SignatureData -> UTCTime
signatureTime SignatureData
sd)
      credentials :: Credentials
credentials   = SignatureData -> Credentials
signatureCredentials SignatureData
sd
      accessKeyId :: ByteString
accessKeyId   = Credentials -> ByteString
accessKeyID Credentials
credentials
      amzHeaders :: RequestHeaders
amzHeaders    = forall a. [Maybe a] -> [a]
catMaybes
                    [ forall a. a -> Maybe a
Just (HeaderName
"X-Amzn-Authorization", ByteString
authorization)
                    , (HeaderName
"x-amz-security-token",) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
`fmap` Credentials -> Maybe ByteString
iamToken Credentials
credentials
                    ]
      authorization :: ByteString
authorization = [ByteString] -> ByteString
B.concat
                    [ ByteString
"AWS3-HTTPS AWSAccessKeyId="
                    , ByteString
accessKeyId
                    , ByteString
", Algorithm=HmacSHA256, Signature="
                    , Credentials -> AuthorizationHash -> ByteString -> ByteString
signature Credentials
credentials AuthorizationHash
HmacSHA256 ByteString
stringToSign
                    ]
      query' :: [(ByteString, ByteString)]
query' = (ByteString
"AWSAccessKeyId", ByteString
accessKeyId) forall a. a -> [a] -> [a]
: [(ByteString, ByteString)]
query

sesResponseConsumer :: (Cu.Cursor -> Response SesMetadata a)
                    -> IORef SesMetadata
                    -> HTTPResponseConsumer a
sesResponseConsumer :: forall a.
(Cursor -> Response SesMetadata a)
-> IORef SesMetadata -> HTTPResponseConsumer a
sesResponseConsumer Cursor -> Response SesMetadata a
inner IORef SesMetadata
metadataRef Response (ConduitM () ByteString (ResourceT IO) ())
resp = forall m a.
Monoid m =>
(Cursor -> Response m a) -> IORef m -> HTTPResponseConsumer a
xmlCursorConsumer Cursor -> Response SesMetadata a
parse IORef SesMetadata
metadataRef Response (ConduitM () ByteString (ResourceT IO) ())
resp
    where
      parse :: Cursor -> Response SesMetadata a
parse Cursor
cursor = do
        let requestId' :: Maybe Text
requestId' = forall a. [a] -> Maybe a
listToMaybe forall a b. (a -> b) -> a -> b
$ Cursor
cursor forall node a. Cursor node -> (Cursor node -> [a]) -> [a]
$// Text -> Cursor -> [Text]
elContent Text
"RequestID"
        forall m. m -> Response m ()
tellMetadata forall a b. (a -> b) -> a -> b
$ Maybe Text -> SesMetadata
SesMetadata Maybe Text
requestId'
        case Cursor
cursor forall node a. Cursor node -> (Cursor node -> [a]) -> [a]
$/ Text -> Axis
Cu.laxElement Text
"Error" of
          []      -> Cursor -> Response SesMetadata a
inner Cursor
cursor
          (Cursor
err:[Cursor]
_) -> Cursor -> Response SesMetadata a
fromError Cursor
err

      fromError :: Cursor -> Response SesMetadata a
fromError Cursor
cursor = do
        Text
errCode    <- forall (m :: * -> *) a. MonadThrow m => String -> [a] -> m a
force String
"Missing Error Code"    forall a b. (a -> b) -> a -> b
$ Cursor
cursor forall node a. Cursor node -> (Cursor node -> [a]) -> [a]
$// Text -> Cursor -> [Text]
elContent Text
"Code"
        Text
errMessage <- forall (m :: * -> *) a. MonadThrow m => String -> [a] -> m a
force String
"Missing Error Message" forall a b. (a -> b) -> a -> b
$ Cursor
cursor forall node a. Cursor node -> (Cursor node -> [a]) -> [a]
$// Text -> Cursor -> [Text]
elContent Text
"Message"
        forall (m :: * -> *) e a. (MonadThrow m, Exception e) => e -> m a
throwM forall a b. (a -> b) -> a -> b
$ Status -> Text -> Text -> SesError
SesError (forall body. Response body -> Status
HTTP.responseStatus Response (ConduitM () ByteString (ResourceT IO) ())
resp) Text
errCode Text
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 a -> [(ByteString, ByteString)]
sesAsQuery = forall b a. b -> (a -> b) -> Maybe a -> b
maybe [] forall a. SesAsQuery a => a -> [(ByteString, ByteString)]
sesAsQuery


-- | A raw e-mail.
data RawMessage = RawMessage { RawMessage -> ByteString
rawMessageData :: B.ByteString }
                deriving (RawMessage -> RawMessage -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: RawMessage -> RawMessage -> Bool
$c/= :: RawMessage -> RawMessage -> Bool
== :: RawMessage -> RawMessage -> Bool
$c== :: RawMessage -> RawMessage -> Bool
Eq, Eq RawMessage
RawMessage -> RawMessage -> Bool
RawMessage -> RawMessage -> Ordering
RawMessage -> RawMessage -> RawMessage
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 :: RawMessage -> RawMessage -> RawMessage
$cmin :: RawMessage -> RawMessage -> RawMessage
max :: RawMessage -> RawMessage -> RawMessage
$cmax :: RawMessage -> RawMessage -> RawMessage
>= :: RawMessage -> RawMessage -> Bool
$c>= :: RawMessage -> RawMessage -> Bool
> :: RawMessage -> RawMessage -> Bool
$c> :: RawMessage -> RawMessage -> Bool
<= :: RawMessage -> RawMessage -> Bool
$c<= :: RawMessage -> RawMessage -> Bool
< :: RawMessage -> RawMessage -> Bool
$c< :: RawMessage -> RawMessage -> Bool
compare :: RawMessage -> RawMessage -> Ordering
$ccompare :: RawMessage -> RawMessage -> Ordering
Ord, Int -> RawMessage -> ShowS
[RawMessage] -> ShowS
RawMessage -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [RawMessage] -> ShowS
$cshowList :: [RawMessage] -> ShowS
show :: RawMessage -> String
$cshow :: RawMessage -> String
showsPrec :: Int -> RawMessage -> ShowS
$cshowsPrec :: Int -> RawMessage -> ShowS
Show, Typeable)

instance SesAsQuery RawMessage where
    sesAsQuery :: RawMessage -> [(ByteString, ByteString)]
sesAsQuery = (forall a. a -> [a] -> [a]
:[]) forall b c a. (b -> c) -> (a -> b) -> a -> c
. (,) ByteString
"RawMessage.Data" forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> ByteString
B64.encode forall b c a. (b -> c) -> (a -> b) -> a -> c
. RawMessage -> ByteString
rawMessageData


-- | The destinations of an e-mail.
data Destination =
    Destination
      { Destination -> [Text]
destinationBccAddresses :: [EmailAddress]
      , Destination -> [Text]
destinationCcAddresses  :: [EmailAddress]
      , Destination -> [Text]
destinationToAddresses  :: [EmailAddress]
      } deriving (Destination -> Destination -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Destination -> Destination -> Bool
$c/= :: Destination -> Destination -> Bool
== :: Destination -> Destination -> Bool
$c== :: Destination -> Destination -> Bool
Eq, Eq Destination
Destination -> Destination -> Bool
Destination -> Destination -> Ordering
Destination -> Destination -> Destination
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 :: Destination -> Destination -> Destination
$cmin :: Destination -> Destination -> Destination
max :: Destination -> Destination -> Destination
$cmax :: Destination -> Destination -> Destination
>= :: Destination -> Destination -> Bool
$c>= :: Destination -> Destination -> Bool
> :: Destination -> Destination -> Bool
$c> :: Destination -> Destination -> Bool
<= :: Destination -> Destination -> Bool
$c<= :: Destination -> Destination -> Bool
< :: Destination -> Destination -> Bool
$c< :: Destination -> Destination -> Bool
compare :: Destination -> Destination -> Ordering
$ccompare :: Destination -> Destination -> Ordering
Ord, Int -> Destination -> ShowS
[Destination] -> ShowS
Destination -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Destination] -> ShowS
$cshowList :: [Destination] -> ShowS
show :: Destination -> String
$cshow :: Destination -> String
showsPrec :: Int -> Destination -> ShowS
$cshowsPrec :: Int -> Destination -> ShowS
Show, Typeable)

instance SesAsQuery Destination where
    sesAsQuery :: Destination -> [(ByteString, ByteString)]
sesAsQuery (Destination [Text]
bcc [Text]
cc [Text]
to) = forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat [ Builder -> [Text] -> [(ByteString, ByteString)]
go (ByteString -> Builder
s ByteString
"Bcc") [Text]
bcc
                                                , Builder -> [Text] -> [(ByteString, ByteString)]
go (ByteString -> Builder
s ByteString
"Cc")  [Text]
cc
                                                , Builder -> [Text] -> [(ByteString, ByteString)]
go (ByteString -> Builder
s ByteString
"To")  [Text]
to ]
        where
          go :: Builder -> [Text] -> [(ByteString, ByteString)]
go Builder
kind = forall a b c. (a -> b -> c) -> [a] -> [b] -> [c]
zipWith Builder -> Text -> (ByteString, ByteString)
f (forall a b. (a -> b) -> [a] -> [b]
map forall a. Show a => a -> Builder
Blaze8.fromShow [Int
one..])
              where txt :: Builder
txt = Builder
kind forall a. Monoid a => a -> a -> a
`mappend` ByteString -> Builder
s ByteString
"Addresses.member."
                    f :: Builder -> Text -> (ByteString, ByteString)
f Builder
n Text
v = ( Builder -> ByteString
Blaze.toByteString (Builder
txt forall a. Monoid a => a -> a -> a
`mappend` Builder
n)
                            , Text -> ByteString
TE.encodeUtf8 Text
v )
          s :: ByteString -> Builder
s = ByteString -> Builder
Blaze.fromByteString
          one :: Int
one = Int
1 :: Int

instance Sem.Semigroup Destination where
    (Destination [Text]
a1 [Text]
a2 [Text]
a3) <> :: Destination -> Destination -> Destination
<> (Destination [Text]
b1 [Text]
b2 [Text]
b3) =
        [Text] -> [Text] -> [Text] -> Destination
Destination ([Text]
a1 forall a. [a] -> [a] -> [a]
++ [Text]
b1) ([Text]
a2 forall a. [a] -> [a] -> [a]
++ [Text]
b2) ([Text]
a3 forall a. [a] -> [a] -> [a]
++ [Text]
b3)

instance Monoid Destination where
    mempty :: Destination
mempty = [Text] -> [Text] -> [Text] -> Destination
Destination [] [] []
    mappend :: Destination -> Destination -> Destination
mappend = forall a. Semigroup a => a -> a -> a
(Sem.<>)

-- | An e-mail address.
type EmailAddress = Text


-- | The sender's e-mail address.
data Sender = Sender { Sender -> Text
senderAddress :: EmailAddress }
              deriving (Sender -> Sender -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Sender -> Sender -> Bool
$c/= :: Sender -> Sender -> Bool
== :: Sender -> Sender -> Bool
$c== :: Sender -> Sender -> Bool
Eq, Eq Sender
Sender -> Sender -> Bool
Sender -> Sender -> Ordering
Sender -> Sender -> Sender
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 :: Sender -> Sender -> Sender
$cmin :: Sender -> Sender -> Sender
max :: Sender -> Sender -> Sender
$cmax :: Sender -> Sender -> Sender
>= :: Sender -> Sender -> Bool
$c>= :: Sender -> Sender -> Bool
> :: Sender -> Sender -> Bool
$c> :: Sender -> Sender -> Bool
<= :: Sender -> Sender -> Bool
$c<= :: Sender -> Sender -> Bool
< :: Sender -> Sender -> Bool
$c< :: Sender -> Sender -> Bool
compare :: Sender -> Sender -> Ordering
$ccompare :: Sender -> Sender -> Ordering
Ord, Int -> Sender -> ShowS
[Sender] -> ShowS
Sender -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Sender] -> ShowS
$cshowList :: [Sender] -> ShowS
show :: Sender -> String
$cshow :: Sender -> String
showsPrec :: Int -> Sender -> ShowS
$cshowsPrec :: Int -> Sender -> ShowS
Show, Typeable)

instance SesAsQuery Sender where
    sesAsQuery :: Sender -> [(ByteString, ByteString)]
sesAsQuery = (forall a. a -> [a] -> [a]
:[]) forall b c a. (b -> c) -> (a -> b) -> a -> c
. (,) ByteString
"Source" forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> ByteString
TE.encodeUtf8 forall b c a. (b -> c) -> (a -> b) -> a -> c
. Sender -> Text
senderAddress