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

    import           Control.Exception           (Exception, throwIO)
    import           Control.Monad.IO.Class      (MonadIO, liftIO)
    import           Crypto.Hash                 (Digest, SHA256, hmac,
                                                  hmacGetDigest)
    import           Data.Byteable               (toBytes)
    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           Data.Time                   (getCurrentTime)
    import           Data.Time.Format            (formatTime)
    import           Data.Typeable               (Typeable)
    import           Data.XML.Types              (Content (ContentText), Event (EventBeginElement, EventContent))
    import           Network.HTTP.Client         (Manager,
    #if MIN_VERSION_http_client(0, 5, 0)
                                                  parseRequest,
    #else
                                                  checkStatus,
                                                  parseUrl,
    #endif
                                                  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)

    #if MIN_VERSION_time(1,5,0)
    import           Data.Time                   (defaultTimeLocale)
    #else
    import           System.Locale               (defaultTimeLocale)
    #endif

    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
    showList :: [SES] -> ShowS
    $cshowList :: [SES] -> ShowS
    show :: SES -> String
    $cshow :: SES -> String
    showsPrec :: Int -> SES -> ShowS
    $cshowsPrec :: Int -> SES -> ShowS
    Show

    renderSendMailSES :: MonadIO m => Manager -> SES -> Mail -> m ()
    renderSendMailSES :: Manager -> SES -> Mail -> m ()
    renderSendMailSES m :: Manager
    m ses :: SES
    ses mail :: Mail
    mail = IO ByteString -> m ByteString
    forall (m :: * -> *) a. MonadIO m => IO a -> m a
    liftIO (Mail -> IO ByteString
    renderMail' Mail
    mail) m ByteString -> (ByteString -> m ()) -> m ()
    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 :: SES -> Mail -> m ()
    renderSendMailSESGlobal ses :: SES
    ses mail :: Mail
    mail = do
      Manager
    mgr <- IO Manager -> m Manager
    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 :: Manager -> SES -> ByteString -> m ()
    sendMailSES manager :: Manager
    manager ses :: SES
    ses msg :: ByteString
    msg = IO () -> m ()
    forall (m :: * -> *) a. MonadIO m => IO a -> m a
    liftIO (IO () -> m ()) -> IO () -> m ()
    forall a b. (a -> b) -> a -> b
    $ do
        UTCTime
    now <- IO UTCTime
    getCurrentTime
        let date :: ByteString
    date = String -> ByteString
    S8.pack (String -> ByteString) -> String -> ByteString
    forall a b. (a -> b) -> a -> b
    $ UTCTime -> String
    format UTCTime
    now
            sig :: ByteString
    sig = ByteString -> ByteString -> ByteString
    makeSig ByteString
    date (ByteString -> ByteString) -> ByteString -> ByteString
    forall a b. (a -> b) -> a -> b
    $ SES -> ByteString
    sesSecretKey SES
    ses
            region :: String
    region = Text -> String
    T.unpack (Text -> String) -> Text -> String
    forall a b. (a -> b) -> a -> b
    $ SES -> Text
    sesRegion SES
    ses
    #if MIN_VERSION_http_client(0, 5, 0)
        Request
    req' <- String -> IO Request
    forall (m :: * -> *). MonadThrow m => String -> m Request
    parseRequest (String -> IO Request) -> String -> IO Request
    forall a b. (a -> b) -> a -> b
    $ [String] -> String
    forall (t :: * -> *) a. Foldable t => t [a] -> [a]
    concat ["https://email.", String
    region , ".amazonaws.com"]
    #else
        req' <- parseUrl $ concat ["https://email.", region , ".amazonaws.com"]
    #endif
        let auth :: ByteString
    auth = [ByteString] -> ByteString
    S8.concat
                [ "AWS3-HTTPS AWSAccessKeyId="
                , SES -> ByteString
    sesAccessKey SES
    ses
                , ", Algorithm=HmacSHA256, Signature="
                , ByteString
    sig
                ]
        let req :: Request
    req = [(ByteString, ByteString)] -> Request -> Request
    urlEncodedBody [(ByteString, ByteString)]
    qs (Request -> Request) -> Request -> Request
    forall a b. (a -> b) -> a -> b
    $ Request
    req'
                { requestHeaders :: RequestHeaders
    requestHeaders =
                    [ ("Date", ByteString
    date)
                    , ("X-Amzn-Authorization", ByteString
    auth)
                    ] RequestHeaders -> RequestHeaders -> RequestHeaders
    forall a. [a] -> [a] -> [a]
    ++ case SES -> Maybe ByteString
    sesSessionToken SES
    ses of
                        Just token :: ByteString
    token -> [("X-Amz-Security-Token", ByteString
    token)]
                        Nothing    -> []
    #if !MIN_VERSION_http_client(0, 5, 0)
                , checkStatus = \_ _ _ -> Nothing
    #endif
                }
        Request -> Manager -> (Response BodyReader -> IO ()) -> IO ()
    forall a.
    Request -> Manager -> (Response BodyReader -> IO a) -> IO a
    withResponse Request
    req Manager
    manager ((Response BodyReader -> IO ()) -> IO ())
    -> (Response BodyReader -> IO ()) -> IO ()
    forall a b. (a -> b) -> a -> b
    $ \res :: 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 () -> IO ()
    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 ()
    -> ConduitT Event Void IO () -> Sink ByteString IO ()
    forall (m :: * -> *) a b c r.
    Monad m =>
    Conduit a m b -> ConduitT b c m r -> ConduitT a c m r
    =$ Status -> ConduitT Event Void IO ()
    checkForError (Response BodyReader -> Status
    forall body. Response body -> Status
    responseStatus Response BodyReader
    res)
      where
        qs :: [(ByteString, ByteString)]
    qs =
              ("Action", "SendRawEmail")
            (ByteString, ByteString)
    -> [(ByteString, ByteString)] -> [(ByteString, ByteString)]
    forall a. a -> [a] -> [a]
    : ("Source", SES -> ByteString
    sesFrom SES
    ses)
            (ByteString, ByteString)
    -> [(ByteString, ByteString)] -> [(ByteString, ByteString)]
    forall a. a -> [a] -> [a]
    : ("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 [1 :: Int ..] (SES -> [ByteString]
    sesTo SES
    ses)
        mkDest :: a -> b -> (ByteString, b)
    mkDest num :: a
    num addr :: b
    addr = (String -> ByteString
    S8.pack (String -> ByteString) -> String -> ByteString
    forall a b. (a -> b) -> a -> b
    $ "Destinations.member." String -> ShowS
    forall a. [a] -> [a] -> [a]
    ++ a -> String
    forall a. Show a => a -> String
    show a
    num, b
    addr)
        format :: UTCTime -> String
    format = TimeLocale -> String -> UTCTime -> String
    forall t. FormatTime t => TimeLocale -> String -> t -> String
    formatTime TimeLocale
    defaultTimeLocale "%a, %e %b %Y %H:%M:%S %z"

    -- | @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 :: SES -> ByteString -> m ()
    sendMailSESGlobal ses :: SES
    ses msg :: ByteString
    msg = do
      Manager
    mgr <- IO Manager -> m Manager
    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 -> ConduitT Event Void IO ()
    checkForError status :: 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 -> ConduitT Event Void IO ()
    forall (m :: * -> *) o b.
    MonadIO m =>
    Text -> Text -> Text -> ConduitT Event o m b
    loop "" "" ""
            else () -> ConduitT Event Void IO ()
    forall (m :: * -> *) a. Monad m => a -> m a
    return ()
      where
        errorResponse :: Name
    errorResponse = "{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. Monad m => Consumer i m (Maybe i)
    await
            case Maybe Event
    mx of
                Nothing -> Name -> ConduitT Event o IO Name
    forall (m :: * -> *) a. Monad m => a -> m a
    return Name
    errorResponse
                Just (EventBeginElement name :: Name
    name _) -> Name -> ConduitT Event o IO Name
    forall (m :: * -> *) a. Monad m => a -> m a
    return Name
    name
                _ -> ConduitT Event o IO Name
    getFirstStart
        loop :: Text -> Text -> Text -> ConduitT Event o m b
    loop code :: Text
    code msg :: Text
    msg reqid :: Text
    reqid =
            ConduitT Event o m (Maybe Event)
    forall (m :: * -> *) i. Monad m => Consumer i m (Maybe i)
    await ConduitT Event o m (Maybe Event)
    -> (Maybe Event -> 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 front :: [Text] -> [Text]
    front = do
                Maybe Event
    mx <- ConduitT Event o m (Maybe Event)
    forall (m :: * -> *) i. Monad m => Consumer i m (Maybe i)
    await
                case Maybe Event
    mx of
                    Just (EventContent (ContentText t :: 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]
    :))
                    _ -> Text -> ConduitT Event o m Text
    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 "{http://ses.amazonaws.com/doc/2010-12-01/}Code" _) = 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 "{http://ses.amazonaws.com/doc/2010-12-01/}Message" _) = 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 "{http://ses.amazonaws.com/doc/2010-12-01/}RequestId" _) = 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 _ = 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 (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 $WSESException :: Status -> Text -> Text -> Text -> SESException
    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
    showList :: [SESException] -> ShowS
    $cshowList :: [SESException] -> ShowS
    show :: SESException -> String
    $cshow :: SESException -> String
    showsPrec :: Int -> SESException -> ShowS
    $cshowsPrec :: Int -> SESException -> ShowS
    Show, Typeable)
    instance Exception SESException

    makeSig :: ByteString -> ByteString -> ByteString
    makeSig :: ByteString -> ByteString -> ByteString
    makeSig payload :: ByteString
    payload key :: ByteString
    key =
        ByteString -> ByteString
    encode (ByteString -> ByteString) -> ByteString -> ByteString
    forall a b. (a -> b) -> a -> b
    $ Digest SHA256 -> ByteString
    forall a. Byteable a => a -> ByteString
    toBytes (HMAC SHA256 -> Digest SHA256
    forall a. HMAC a -> Digest a
    hmacGetDigest (HMAC SHA256 -> Digest SHA256) -> HMAC SHA256 -> Digest SHA256
    forall a b. (a -> b) -> a -> b
    $ ByteString -> ByteString -> HMAC SHA256
    forall a. HashAlgorithm a => ByteString -> ByteString -> HMAC a
    hmac ByteString
    key ByteString
    payload :: Digest SHA256)

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

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

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