ihp-mail (empty) → 1.5.0

raw patch · 6 files changed

+325/−0 lines, 6 filesdep +basedep +blaze-htmldep +bytestring

Dependencies added: base, blaze-html, bytestring, http-client, http-client-tls, ihp, mime-mail, mime-mail-ses, network, smtp-mail, string-conversions, text, typerep-map

Files

IHP/Mail.hs +163/−0
IHP/Mail/Types.hs +49/−0
IHP/MailPrelude.hs +17/−0
LICENSE +21/−0
changelog.md +9/−0
ihp-mail.cabal +66/−0

+ IHP/Mail.hs view

@@ -0,0 +1,163 @@+{-|+Module: IHP.Mail+Description: Send Emails+Copyright: (c) digitally induced GmbH, 2020+-}+module IHP.Mail+( MailServer (..)+, BuildMail (..)+, SMTPEncryption (..)+, sendMail+, sendWithMailServer+)+where++import IHP.Prelude+import IHP.Mail.Types+import IHP.FrameworkConfig++import           Network.Mail.Mime+import qualified Network.Mail.Mime.SES                as Mailer+import qualified Network.Mail.SMTP                    as SMTP+import qualified Network.HTTP.Client+import qualified Network.HTTP.Client.TLS+import Text.Blaze.Html5 (Html)+import qualified Text.Blaze.Html.Renderer.Text as Blaze+import qualified Data.Text as Text+import Data.Maybe+import qualified Data.TMap as TMap++buildMail :: (BuildMail mail, ?context :: context, ConfigProvider context) => mail -> Mail+buildMail mail =+    let ?mail = mail in+    let mail' = simpleMailInMemory (to mail) from subject (cs $ text mail) (html mail |> Blaze.renderHtml) attachments' in+    mail' { mailCc      = cc mail+          , mailBcc     = bcc mail+          , mailHeaders = ("Subject", subject) : h+          }+    where+        h = case replyTo mail of+            Nothing      -> headers mail+            Just replyTo -> ("Reply-To", renderAddress replyTo) : (headers mail)++        attachments' = mail+                |> attachments+                |> map (\MailAttachment { name, content, contentType } -> (contentType, name, content))++-- | Retrieves the mail server configuration from the framework config's appConfig TMap+--+-- Returns an error if no mail server has been configured. Users must add+-- @option Sendmail@ or similar to their Config.hs.+getMailServer :: (?context :: context, ConfigProvider context) => MailServer+getMailServer = ?context.frameworkConfig.appConfig+    |> TMap.lookup @MailServer+    |> fromMaybe (error "No mail server configured. Add 'option Sendmail' or similar to Config.hs")++-- | Sends an email+--+-- Uses the mail server provided via @option@ in Config.hs, stored in appConfig+sendMail :: (BuildMail mail, ?context :: context, ConfigProvider context) => mail -> IO ()+sendMail mail = sendWithMailServer getMailServer (buildMail mail)++sendWithMailServer :: MailServer -> Mail -> IO ()+sendWithMailServer SES { .. } mail = do+    manager <- Network.HTTP.Client.newManager Network.HTTP.Client.TLS.tlsManagerSettings+    let ses = Mailer.SES {+            Mailer.sesFrom = cs $ addressEmail (mailFrom mail),+            Mailer.sesTo = map (cs . addressEmail) ((mailTo mail) <> (mailCc mail) <> (mailBcc mail)),+            Mailer.sesAccessKey = accessKey,+            Mailer.sesSecretKey = secretKey,+            Mailer.sesSessionToken = Nothing,+            Mailer.sesRegion = region+        }+    Mailer.renderSendMailSES manager ses mail++sendWithMailServer SendGrid { .. } mail = do+    let mail' = if isJust category then mail {mailHeaders = ("X-SMTPAPI","{\"category\": \"" ++ (fromJust category) ++ "\"}") : headers} else mail+    SMTP.sendMailWithLoginSTARTTLS' "smtp.sendgrid.net" 587 "apikey" (Text.unpack apiKey) mail'+    where headers = mailHeaders mail++sendWithMailServer IHP.Mail.Types.SMTP { .. } mail+    | isNothing credentials =+          case encryption of+              Unencrypted -> SMTP.sendMail' host port mail+              TLS -> SMTP.sendMailTLS' host port mail+              STARTTLS -> SMTP.sendMailSTARTTLS' host port mail+    | otherwise =+          case encryption of+              Unencrypted -> SMTP.sendMailWithLogin' host port (fst creds) (snd creds) mail+              TLS -> SMTP.sendMailWithLoginTLS' host port (fst creds) (snd creds) mail+              STARTTLS -> SMTP.sendMailWithLoginSTARTTLS' host port (fst creds) (snd creds) mail+    where creds = fromJust credentials++sendWithMailServer Sendmail mail = do+    message <- renderMail' mail+    sendmail message++class BuildMail mail where+    -- | You can use @?mail@ to make this dynamic based on the given entity+    subject :: (?mail :: mail) => Text++    -- | The email receiver+    --+    -- __Example:__+    --+    -- > to ConfirmationMail { .. } = Address { addressName = Just (user.name), addressEmail = user.email }+    --+    -- __Example:__ Send all emails to a fixed email address while in development mode+    --+    -- > to CreateAccountMail { .. } = Address+    -- >     { addressName = Just (fullName admin)+    -- >     , addressEmail =+    -- >         if isDevelopment then+    -- >             "staging@example.com"+    -- >         else+    -- >             admin.email+    -- >     }+    --+    to :: (?context :: context, ConfigProvider context) => mail -> Address++    -- | Sets an optional reply-to address+    replyTo :: (?context :: context, ConfigProvider context) => mail -> Maybe Address+    replyTo mail = Nothing++    -- | Public list of addresses to receive a copy of the mail (CC)+    cc :: (?context :: context, ConfigProvider context) => mail -> [Address]+    cc mail = []++    -- | Hidden list of addresses to receive a copy of the mail (BCC)+    bcc :: (?context :: context, ConfigProvider context) => mail -> [Address]+    bcc mail = []++    -- | Custom headers, excluding @from@, @to@, @cc@, @bcc@, @subject@, and @reply-to@+    --+    -- __Example:__ Add a custom X-Mailer header+    --+    -- > headers CreateAccountMail { .. } = [("X-Mailer", "mail4j 2.17.0")]+    --+    headers :: (?context :: context, ConfigProvider context) => mail -> Headers+    headers mail = []++    -- | Your sender address+    --+    -- __Example:__+    --+    -- > from = Address { addressName = "Acme Inc.", addressEmail = "hi@example.com" }+    --+    from :: (?mail :: mail, ?context :: context, ConfigProvider context) => Address++    -- | Similiar to a normal html view, HSX can be used here+    html :: (?context :: context, ConfigProvider context) => mail -> Html++    -- | When no plain text version of the email is specified it falls back to using the html version but striping out all the html tags+    text :: (?context :: context, ConfigProvider context) => mail -> Text+    text mail = stripTags (cs $ Blaze.renderHtml (html mail))++    -- | Optional, mail attachments+    --+    -- __Example:__+    --+    -- > attachments = [ MailAttachment { name = "attached_file.xml", contentType = "application/xml", content = "<xml><hello/></xml>" } ]+    --+    attachments :: (?context :: context, ConfigProvider context) => mail -> [MailAttachment]+    attachments mail = []

+ IHP/Mail/Types.hs view

@@ -0,0 +1,49 @@+{-|+Module: IHP.Mail.Types+Description: Types for emails+Copyright: (c) digitally induced GmbH, 2020+-}+module IHP.Mail.Types+( MailServer (..)+, MailAttachment (..)+, SMTPEncryption (..)+)+where++import IHP.Prelude+import IHP.EnvVar+import Network.Socket (PortNumber)++-- | Configuration for a mailer used by IHP+data SMTPEncryption = Unencrypted | TLS | STARTTLS++data MailServer =+    -- | Uses AWS SES for sending emails+    SES { accessKey :: ByteString+        , secretKey :: ByteString+        --  | E.g. @"us-east-1"@ or @"eu-west-1"@+        , region :: Text }+    -- | Uses the local Sendmail binary for sending emails+    | Sendmail+    -- | Uses SendGrid for sending emails+    | SendGrid { apiKey :: Text+               , category :: Maybe Text }+    -- | Uses a generic SMTP server for sending emails+    | SMTP { host :: String+           , port :: PortNumber+           -- (Username,Password) combination+           , credentials :: Maybe (String, String)+           , encryption :: SMTPEncryption }++data MailAttachment = MailAttachment+    { name :: Text -- ^ File name of an attachment+    , content :: LByteString+    , contentType :: Text+    } deriving (Eq, Show)++-- | Allow reading SMTP encryption settings from environment variables+instance EnvVarReader SMTPEncryption where+    envStringToValue "Unencrypted" = Right Unencrypted+    envStringToValue "TLS"         = Right TLS+    envStringToValue "STARTTLS"    = Right STARTTLS+    envStringToValue _             = Left "Should be set to 'Unencrypted', 'TLS', or 'STARTTLS'"

+ IHP/MailPrelude.hs view

@@ -0,0 +1,17 @@+{-# OPTIONS_HADDOCK not-home, hide #-}+{-|+Module: IHP.MailPrelude+Description: Prelude for email views+Copyright: (c) digitally induced GmbH, 2020+-}+module IHP.MailPrelude+( module IHP.Mail+, module Network.Mail.Mime+, module IHP.ViewPrelude+, module IHP.Mail.Types+) where++import IHP.Mail+import IHP.Mail.Types+import Network.Mail.Mime+import IHP.ViewPrelude hiding (html)

+ LICENSE view

@@ -0,0 +1,21 @@+The MIT License (MIT)++Copyright (c) 2020 digitally induced GmbH++Permission is hereby granted, free of charge, to any person obtaining a copy+of this software and associated documentation files (the "Software"), to deal+in the Software without restriction, including without limitation the rights+to use, copy, modify, merge, publish, distribute, sublicense, and/or sell+copies of the Software, and to permit persons to whom the Software is+furnished to do so, subject to the following conditions:++The above copyright notice and this permission notice shall be included in all+copies or substantial portions of the Software.++THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR+IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY,+FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE+AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER+LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM,+OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE+SOFTWARE.

+ changelog.md view

@@ -0,0 +1,9 @@+# Changelog for `ihp-mail`++## v1.5.0++- Add `EnvVarReader` instance for `SMTPEncryption`++## v1.4.0++- Initial release as a standalone package, extracted from ihp

+ ihp-mail.cabal view

@@ -0,0 +1,66 @@+cabal-version:       2.2+name:                ihp-mail+version:             1.5.0+synopsis:            Email support for IHP+description:         Provides email sending functionality for IHP applications+license:             MIT+license-file:        LICENSE+author:              digitally induced GmbH+maintainer:          hello@digitallyinduced.com+homepage:            https://ihp.digitallyinduced.com/+bug-reports:         https://github.com/digitallyinduced/ihp/issues+copyright:           (c) digitally induced GmbH+category:            Web, IHP+stability:           Stable+build-type:          Simple+extra-source-files:  changelog.md++source-repository head+    type:     git+    location: https://github.com/digitallyinduced/ihp++common shared-properties+    default-language: GHC2021+    default-extensions:+        OverloadedStrings+        , NoImplicitPrelude+        , ImplicitParams+        , DisambiguateRecordFields+        , DuplicateRecordFields+        , OverloadedLabels+        , DataKinds+        , QuasiQuotes+        , TypeFamilies+        , PackageImports+        , RecordWildCards+        , DefaultSignatures+        , FunctionalDependencies+        , PartialTypeSignatures+        , BlockArguments+        , LambdaCase+        , TemplateHaskell+        , OverloadedRecordDot+        , DeepSubsumption+    ghc-options: -Werror=incomplete-patterns -Werror=unused-imports -Werror=missing-fields++library+    import: shared-properties+    hs-source-dirs: .+    exposed-modules:+        IHP.Mail+        , IHP.Mail.Types+        , IHP.MailPrelude+    build-depends:+        base >= 4.17.0 && < 4.22+        , ihp+        , mime-mail+        , mime-mail-ses+        , smtp-mail+        , http-client+        , http-client-tls+        , blaze-html+        , text+        , bytestring+        , network+        , string-conversions+        , typerep-map