    {-# LANGUAGE DeriveDataTypeable #-}
    {-# LANGUAGE OverloadedStrings  #-}
    {-# LANGUAGE CPP #-}
    module Network.Mail.Mime.SES
        ( sendMailSES
        , sendMailSESWithResponse
        , sendMailSESGlobal
        , renderSendMailSES
        , renderSendMailSESGlobal
        , SES (..)
        , usEast1
        , usWest2
        , euWest1
        , SESException (..)
        ) where

    import           Control.Exception           (Exception, throwIO)
    import           Control.Monad.IO.Class      (MonadIO, liftIO)
    import           Data.ByteString             (ByteString)
    import           Data.ByteString.Base64      (encode)
    import qualified Data.ByteString.Char8       as S8
    import qualified Data.ByteString.Lazy        as L
    import           Data.Conduit                (Sink, await, ($$), (=$))
    import           Data.Text                   (Text)
    import qualified Data.Text                   as T
    import qualified Data.Text.Encoding          as E
    import           Data.Time                   (getCurrentTime)
    import           Data.Typeable               (Typeable)
    import           Data.XML.Types              (Content (ContentText), Event (EventBeginElement, EventContent))
    import           Network.HTTP.Client         (Manager,
                                                  requestHeaders, responseBody,
                                                  responseStatus, urlEncodedBody,
                                                  withResponse)
    import           Network.HTTP.Client.Conduit (bodyReaderSource)
    import           Network.HTTP.Types          (Status)
    import           Network.HTTP.Client.TLS     (getGlobalManager)
    import           Network.Mail.Mime           (Mail, renderMail')
    import           Text.XML.Stream.Parse       (def, parseBytes)

    import Network.Mail.Mime.SES.Internal

    data SES = SES
        { SES -> ByteString
    sesFrom         :: !ByteString
        , SES -> [ByteString]
    sesTo           :: ![ByteString]
        , SES -> ByteString
    sesAccessKey    :: !ByteString
        , SES -> ByteString
    sesSecretKey    :: !ByteString
        , SES -> Maybe ByteString
    sesSessionToken :: !(Maybe ByteString)
        , SES -> Text
    sesRegion       :: !Text
        }
      deriving Int -> SES -> ShowS
    [SES] -> ShowS
    SES -> String
    (Int -> SES -> ShowS)
    -> (SES -> String) -> ([SES] -> ShowS) -> Show SES
    forall a.
    (Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
    $cshowsPrec :: Int -> SES -> ShowS
    showsPrec :: Int -> SES -> ShowS
    $cshow :: SES -> String
    show :: SES -> String
    $cshowList :: [SES] -> ShowS
    showList :: [SES] -> ShowS
    Show

    renderSendMailSES :: MonadIO m => Manager -> SES -> Mail -> m ()
    renderSendMailSES :: forall (m :: * -> *). MonadIO m => Manager -> SES -> Mail -> m ()
    renderSendMailSES Manager
    m SES
    ses Mail
    mail = IO ByteString -> m ByteString
    forall a. IO a -> m a
    forall (m :: * -> *) a. MonadIO m => IO a -> m a
    liftIO (Mail -> IO ByteString
    renderMail' Mail
    mail) m ByteString -> (ByteString -> m ()) -> m ()
    forall a b. m a -> (a -> m b) -> m b
    forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
    >>= Manager -> SES -> ByteString -> m ()
    forall (m :: * -> *).
    MonadIO m =>
    Manager -> SES -> ByteString -> m ()
    sendMailSES Manager
    m SES
    ses

    -- | @since 0.4.1
    -- Same as 'renderSendMailSES' but uses the global 'Manager'.
    renderSendMailSESGlobal :: MonadIO m => SES -> Mail -> m ()
    renderSendMailSESGlobal :: forall (m :: * -> *). MonadIO m => SES -> Mail -> m ()
    renderSendMailSESGlobal SES
    ses Mail
    mail = do
      Manager
    mgr <- IO Manager -> m Manager
    forall a. IO a -> m a
    forall (m :: * -> *) a. MonadIO m => IO a -> m a
    liftIO IO Manager
    getGlobalManager
      Manager -> SES -> Mail -> m ()
    forall (m :: * -> *). MonadIO m => Manager -> SES -> Mail -> m ()
    renderSendMailSES Manager
    mgr SES
    ses Mail
    mail

    sendMailSES :: MonadIO m => Manager -> SES
                -> L.ByteString -- ^ Raw message data. You must ensure that
                                -- the message format complies with
                                -- Internet email standards regarding
                                -- email header fields, MIME types, and
                                -- MIME encoding.
                -> m ()
    sendMailSES :: forall (m :: * -> *).
    MonadIO m =>
    Manager -> SES -> ByteString -> m ()
    sendMailSES Manager
    manager SES
    ses ByteString
    msg =
      Manager
    -> SES -> ByteString -> (Status -> Sink Event IO ()) -> m ()
    forall (m :: * -> *) a.
    MonadIO m =>
    Manager -> SES -> ByteString -> (Status -> Sink Event IO a) -> m a
    sendMailSESWithResponse Manager
    manager SES
    ses ByteString
    msg Status -> Sink Event IO ()
    checkForError

    -- | @since 0.4.3
    -- Generalised version of 'sendMailSES' which allows customising the final return type.
    sendMailSESWithResponse :: MonadIO m => Manager -> SES
                            -> L.ByteString
                            -> (Status -> Sink Event IO a)
                            -- ^ What to do with the HTTP 'Status' returned in the 'Response'.
                            -> m a
    sendMailSESWithResponse :: forall (m :: * -> *) a.
    MonadIO m =>
    Manager -> SES -> ByteString -> (Status -> Sink Event IO a) -> m a
    sendMailSESWithResponse Manager
    manager SES
    ses ByteString
    msg Status -> Sink Event IO a
    onResponseStatus = IO a -> m a
    forall a. IO a -> m a
    forall (m :: * -> *) a. MonadIO m => IO a -> m a
    liftIO (IO a -> m a) -> IO a -> m a
    forall a b. (a -> b) -> a -> b
    $ do
        UTCTime
    now <- IO UTCTime
    getCurrentTime
        Request
    requestBase <- String -> IO Request
    buildRequest ([String] -> String
    forall (t :: * -> *) a. Foldable t => t [a] -> [a]
    concat [String
    "https://email.", Text -> String
    T.unpack (SES -> Text
    sesRegion SES
    ses) , String
    ".amazonaws.com"])
        let headers :: [(HeaderName, ByteString)]
    headers =
              [ (HeaderName
    "Date", UTCTime -> ByteString
    formatAmazonTime UTCTime
    now)
              ]
              [(HeaderName, ByteString)]
    -> [(HeaderName, ByteString)] -> [(HeaderName, ByteString)]
    forall a. [a] -> [a] -> [a]
    ++ case SES -> Maybe ByteString
    sesSessionToken SES
    ses of
                   Just ByteString
    token -> [(HeaderName
    "X-Amz-Security-Token", ByteString
    token)]
                   Maybe ByteString
    Nothing    -> []
        let tentativeRequest :: Request
    tentativeRequest = [(ByteString, ByteString)] -> Request -> Request
    urlEncodedBody [(ByteString, ByteString)]
    qs (Request -> Request) -> Request -> Request
    forall a b. (a -> b) -> a -> b
    $ Request
    requestBase {requestHeaders = headers}
            canonicalRequest :: ByteString
    canonicalRequest = Request -> ByteString
    canonicalizeRequest Request
    tentativeRequest
            stringToSign :: ByteString
    stringToSign = ByteString -> UTCTime -> ByteString -> ByteString -> ByteString
    makeStringToSign ByteString
    "ses" UTCTime
    now (Text -> ByteString
    E.encodeUtf8 (SES -> Text
    sesRegion SES
    ses)) ByteString
    canonicalRequest
            sig :: ByteString
    sig = ByteString
    -> UTCTime -> ByteString -> ByteString -> ByteString -> ByteString
    makeSig ByteString
    "ses" UTCTime
    now (Text -> ByteString
    E.encodeUtf8 (SES -> Text
    sesRegion SES
    ses)) (SES -> ByteString
    sesSecretKey SES
    ses) ByteString
    stringToSign
            authorizationString :: ByteString
    authorizationString = ByteString
    -> UTCTime
    -> ByteString
    -> [(HeaderName, ByteString)]
    -> ByteString
    -> ByteString
    -> ByteString
    makeAuthorizationString ByteString
    "ses" UTCTime
    now (Text -> ByteString
    E.encodeUtf8 (SES -> Text
    sesRegion SES
    ses))
                                  (Request -> [(HeaderName, ByteString)]
    patchedRequestHeaders Request
    tentativeRequest) (SES -> ByteString
    sesAccessKey SES
    ses) ByteString
    sig
            finalRequest :: Request
    finalRequest = Request
    tentativeRequest {requestHeaders = ("Authorization", authorizationString): requestHeaders tentativeRequest}
        Request -> Manager -> (Response BodyReader -> IO a) -> IO a
    forall a.
    Request -> Manager -> (Response BodyReader -> IO a) -> IO a
    withResponse Request
    finalRequest Manager
    manager ((Response BodyReader -> IO a) -> IO a)
    -> (Response BodyReader -> IO a) -> IO a
    forall a b. (a -> b) -> a -> b
    $ \Response BodyReader
    res ->
               BodyReader -> ConduitM () ByteString IO ()
    forall (m :: * -> *) i.
    MonadIO m =>
    BodyReader -> ConduitM i ByteString m ()
    bodyReaderSource (Response BodyReader -> BodyReader
    forall body. Response body -> body
    responseBody Response BodyReader
    res)
            ConduitM () ByteString IO () -> Sink ByteString IO a -> IO a
    forall (m :: * -> *) a b.
    Monad m =>
    Source m a -> Sink a m b -> m b
    $$ ParseSettings -> ConduitT ByteString Event IO ()
    forall (m :: * -> *).
    MonadThrow m =>
    ParseSettings -> ConduitT ByteString Event m ()
    parseBytes ParseSettings
    forall a. Default a => a
    def
            ConduitT ByteString Event IO ()
    -> Sink Event IO a -> Sink ByteString IO a
    forall (m :: * -> *) a b c r.
    Monad m =>
    Conduit a m b -> ConduitT b c m r -> ConduitT a c m r
    =$ Status -> Sink Event IO a
    onResponseStatus (Response BodyReader -> Status
    forall body. Response body -> Status
    responseStatus Response BodyReader
    res)
      where
        qs :: [(ByteString, ByteString)]
    qs =
              (ByteString
    "Action", ByteString
    "SendRawEmail")
            (ByteString, ByteString)
    -> [(ByteString, ByteString)] -> [(ByteString, ByteString)]
    forall a. a -> [a] -> [a]
    : (ByteString
    "Source", SES -> ByteString
    sesFrom SES
    ses)
            (ByteString, ByteString)
    -> [(ByteString, ByteString)] -> [(ByteString, ByteString)]
    forall a. a -> [a] -> [a]
    : (ByteString
    "RawMessage.Data", ByteString -> ByteString
    encode (ByteString -> ByteString) -> ByteString -> ByteString
    forall a b. (a -> b) -> a -> b
    $ [ByteString] -> ByteString
    S8.concat ([ByteString] -> ByteString) -> [ByteString] -> ByteString
    forall a b. (a -> b) -> a -> b
    $ ByteString -> [ByteString]
    L.toChunks ByteString
    msg)
            (ByteString, ByteString)
    -> [(ByteString, ByteString)] -> [(ByteString, ByteString)]
    forall a. a -> [a] -> [a]
    : (Int -> ByteString -> (ByteString, ByteString))
    -> [Int] -> [ByteString] -> [(ByteString, ByteString)]
    forall a b c. (a -> b -> c) -> [a] -> [b] -> [c]
    zipWith Int -> ByteString -> (ByteString, ByteString)
    forall {a} {b}. Show a => a -> b -> (ByteString, b)
    mkDest [Int
    1 :: Int ..] (SES -> [ByteString]
    sesTo SES
    ses)
        mkDest :: a -> b -> (ByteString, b)
    mkDest a
    num b
    addr = (String -> ByteString
    S8.pack (String -> ByteString) -> String -> ByteString
    forall a b. (a -> b) -> a -> b
    $ String
    "Destinations.member." String -> ShowS
    forall a. [a] -> [a] -> [a]
    ++ a -> String
    forall a. Show a => a -> String
    show a
    num, b
    addr)

    -- | @since 0.4.1
    -- Same as 'sendMailSES' but uses the global 'Manager'.
    sendMailSESGlobal :: MonadIO m => SES
                      -> L.ByteString -- ^ Raw message data. You must ensure that
                                      -- the message format complies with
                                      -- Internet email standards regarding
                                      -- email header fields, MIME types, and
                                      -- MIME encoding.
                      -> m ()
    sendMailSESGlobal :: forall (m :: * -> *). MonadIO m => SES -> ByteString -> m ()
    sendMailSESGlobal SES
    ses ByteString
    msg = do
      Manager
    mgr <- IO Manager -> m Manager
    forall a. IO a -> m a
    forall (m :: * -> *) a. MonadIO m => IO a -> m a
    liftIO IO Manager
    getGlobalManager
      Manager -> SES -> ByteString -> m ()
    forall (m :: * -> *).
    MonadIO m =>
    Manager -> SES -> ByteString -> m ()
    sendMailSES Manager
    mgr SES
    ses ByteString
    msg

    checkForError :: Status -> Sink Event IO ()
    checkForError :: Status -> Sink Event IO ()
    checkForError Status
    status = do
        Name
    name <- ConduitT Event Void IO Name
    forall {o}. ConduitT Event o IO Name
    getFirstStart
        if Name
    name Name -> Name -> Bool
    forall a. Eq a => a -> a -> Bool
    == Name
    errorResponse
            then Text -> Text -> Text -> Sink Event IO ()
    forall {m :: * -> *} {o} {b}.
    MonadIO m =>
    Text -> Text -> Text -> ConduitT Event o m b
    loop Text
    "" Text
    "" Text
    ""
            else () -> Sink Event IO ()
    forall a. a -> ConduitT Event Void IO a
    forall (m :: * -> *) a. Monad m => a -> m a
    return ()
      where
        errorResponse :: Name
    errorResponse = Name
    "{http://ses.amazonaws.com/doc/2010-12-01/}ErrorResponse"
        getFirstStart :: ConduitT Event o IO Name
    getFirstStart = do
            Maybe Event
    mx <- ConduitT Event o IO (Maybe Event)
    forall (m :: * -> *) i o. Monad m => ConduitT i o m (Maybe i)
    await
            case Maybe Event
    mx of
                Maybe Event
    Nothing -> Name -> ConduitT Event o IO Name
    forall a. a -> ConduitT Event o IO a
    forall (m :: * -> *) a. Monad m => a -> m a
    return Name
    errorResponse
                Just (EventBeginElement Name
    name [(Name, [Content])]
    _) -> Name -> ConduitT Event o IO Name
    forall a. a -> ConduitT Event o IO a
    forall (m :: * -> *) a. Monad m => a -> m a
    return Name
    name
                Maybe Event
    _ -> ConduitT Event o IO Name
    getFirstStart
        loop :: Text -> Text -> Text -> ConduitT Event o m b
    loop Text
    code Text
    msg Text
    reqid =
            ConduitT Event o m (Maybe Event)
    forall (m :: * -> *) i o. Monad m => ConduitT i o m (Maybe i)
    await ConduitT Event o m (Maybe Event)
    -> (Maybe Event -> ConduitT Event o m b) -> ConduitT Event o m b
    forall a b.
    ConduitT Event o m a
    -> (a -> ConduitT Event o m b) -> ConduitT Event o m b
    forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
    >>= ConduitT Event o m b
    -> (Event -> ConduitT Event o m b)
    -> Maybe Event
    -> ConduitT Event o m b
    forall b a. b -> (a -> b) -> Maybe a -> b
    maybe ConduitT Event o m b
    forall {a}. ConduitT Event o m a
    finish Event -> ConduitT Event o m b
    go
          where
            getContent :: ([Text] -> [Text]) -> ConduitT Event o m Text
    getContent [Text] -> [Text]
    front = do
                Maybe Event
    mx <- ConduitT Event o m (Maybe Event)
    forall (m :: * -> *) i o. Monad m => ConduitT i o m (Maybe i)
    await
                case Maybe Event
    mx of
                    Just (EventContent (ContentText Text
    t)) -> ([Text] -> [Text]) -> ConduitT Event o m Text
    getContent ([Text] -> [Text]
    front ([Text] -> [Text]) -> ([Text] -> [Text]) -> [Text] -> [Text]
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . (Text
    tText -> [Text] -> [Text]
    forall a. a -> [a] -> [a]
    :))
                    Maybe Event
    _ -> Text -> ConduitT Event o m Text
    forall a. a -> ConduitT Event o m a
    forall (m :: * -> *) a. Monad m => a -> m a
    return (Text -> ConduitT Event o m Text)
    -> Text -> ConduitT Event o m Text
    forall a b. (a -> b) -> a -> b
    $ [Text] -> Text
    T.concat ([Text] -> Text) -> [Text] -> Text
    forall a b. (a -> b) -> a -> b
    $ [Text] -> [Text]
    front []
            go :: Event -> ConduitT Event o m b
    go (EventBeginElement Name
    "{http://ses.amazonaws.com/doc/2010-12-01/}Code" [(Name, [Content])]
    _) = do
                Text
    t <- ([Text] -> [Text]) -> ConduitT Event o m Text
    forall {m :: * -> *} {o}.
    Monad m =>
    ([Text] -> [Text]) -> ConduitT Event o m Text
    getContent [Text] -> [Text]
    forall a. a -> a
    id
                Text -> Text -> Text -> ConduitT Event o m b
    loop Text
    t Text
    msg Text
    reqid
            go (EventBeginElement Name
    "{http://ses.amazonaws.com/doc/2010-12-01/}Message" [(Name, [Content])]
    _) = do
                Text
    t <- ([Text] -> [Text]) -> ConduitT Event o m Text
    forall {m :: * -> *} {o}.
    Monad m =>
    ([Text] -> [Text]) -> ConduitT Event o m Text
    getContent [Text] -> [Text]
    forall a. a -> a
    id
                Text -> Text -> Text -> ConduitT Event o m b
    loop Text
    code Text
    t Text
    reqid
            go (EventBeginElement Name
    "{http://ses.amazonaws.com/doc/2010-12-01/}RequestId" [(Name, [Content])]
    _) = do
                Text
    t <- ([Text] -> [Text]) -> ConduitT Event o m Text
    forall {m :: * -> *} {o}.
    Monad m =>
    ([Text] -> [Text]) -> ConduitT Event o m Text
    getContent [Text] -> [Text]
    forall a. a -> a
    id
                Text -> Text -> Text -> ConduitT Event o m b
    loop Text
    code Text
    msg Text
    t
            go Event
    _ = Text -> Text -> Text -> ConduitT Event o m b
    loop Text
    code Text
    msg Text
    reqid
            finish :: ConduitT Event o m a
    finish = IO a -> ConduitT Event o m a
    forall a. IO a -> ConduitT Event o m a
    forall (m :: * -> *) a. MonadIO m => IO a -> m a
    liftIO (IO a -> ConduitT Event o m a) -> IO a -> ConduitT Event o m a
    forall a b. (a -> b) -> a -> b
    $ SESException -> IO a
    forall e a. Exception e => e -> IO a
    throwIO SESException
                { seStatus :: Status
    seStatus = Status
    status
                , seCode :: Text
    seCode = Text
    code
                , seMessage :: Text
    seMessage = Text
    msg
                , seRequestId :: Text
    seRequestId = Text
    reqid
                }

    -- |
    --
    -- Exposed since: 0.3.2
    data SESException = SESException
        { SESException -> Status
    seStatus    :: !Status
        , SESException -> Text
    seCode      :: !Text
        , SESException -> Text
    seMessage   :: !Text
        , SESException -> Text
    seRequestId :: !Text
        }
        deriving (Int -> SESException -> ShowS
    [SESException] -> ShowS
    SESException -> String
    (Int -> SESException -> ShowS)
    -> (SESException -> String)
    -> ([SESException] -> ShowS)
    -> Show SESException
    forall a.
    (Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
    $cshowsPrec :: Int -> SESException -> ShowS
    showsPrec :: Int -> SESException -> ShowS
    $cshow :: SESException -> String
    show :: SESException -> String
    $cshowList :: [SESException] -> ShowS
    showList :: [SESException] -> ShowS
    Show, Typeable)
    instance Exception SESException

    usEast1 :: Text
    usEast1 :: Text
    usEast1 = Text
    "us-east-1"

    usWest2 :: Text
    usWest2 :: Text
    usWest2 = Text
    "us-west-2"

    euWest1 :: Text
    euWest1 :: Text
    euWest1 = Text
    "eu-west-1"