Merge pull request #625 from fegu/master

Added support for SendGrid and standard SMTP

CONTRIBUTING.md

@@ -99,6 +99,8 @@ The documentation reads a bit like a tutorial, but should still be kept somewhat
 
 - Please add Haddock-comments to new methods intended to be used by directly when developing using IHP.
 
+- Please consider carefully before adding new packages as requirements to IHP itself. Make sure the packages are actively maintained.
+
 ## Running Tests
 
 When inside the IHP directory, you can run the Test Suite by loading it into a `ghci` like this:

Guide/mail.markdown

@@ -89,32 +89,60 @@ action MyAction = do
 
 ## Mail Servers
 
-By default, IHP uses your local `sendmail` to send out the email. IHP also supports sending mail via AWS Simple Email Service (SES). This is recommended for production.
+By default, IHP uses your local `sendmail` to send out the email. IHP also supports sending mail via AWS Simple Email Service (SES), SendGrid (via Azure or directly) or via any standard SMTP server.
 
-### Custom SMTP Server
+Remember that the successfull delivery of email largely depends on the from-domain allowing your mailserver by means of SPF and/or DKIM. Consult your chosen email server documentation for details.
 
-Currently using a custom SMTP server is not yet supported. We recommend to use `sendmail` locally (the default) and AWS SES in production.
+The delivery method is set in `Config/Config.hs` as shown below.
 
-### AWS SES
+### Any SMTP Server
+
+```haskell
+-- Add this import
+import IHP.Mail
+
+config :: ConfigBuilder
+config = do
+    -- other options here, then add:
+    option $ SMTP
+        { host = "smtp.myisp.com"
+        , port = 2525
+        , credentials = Nothing -- or Just ("myusername","hunter2")
+        }
+```
+
+### SendGrid
 
-To use SES open `Config/Config.hs` and add a `mailServer` function to the construction of `FrameworkConfig`:
+```haskell
+-- Add this import
+import IHP.Mail
+
+config :: ConfigBuilder
+config = do
+    -- other options here, then add:
+    option $ SendGrid
+        { apiKey = "YOUR SENDGRID API KEY"
+        , category = Nothing -- or Just "mailcategory"
+        }
+```
+
+
+### AWS SES
 
 ```haskell
 -- Add this import
 import IHP.Mail
 
 config :: ConfigBuilder
 config = do
-    option Development
-    option $ AppHostname "localhost"
+    -- other options here, then add:
     option $ SES
         { accessKey = "YOUR AWS ACCESS KEY"
         , secretKey = "YOUR AWS SECRET KEY"
         , region = "eu-west-1" -- YOUR REGION
         }
 ```
 
-After that, all emails will be sent through AWS SES.
 
 ## Email Attachments
 

IHP/Mail.hs

@@ -19,10 +19,13 @@ 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
 
 buildMail :: (BuildMail mail, ?context :: context, ConfigProvider context) => mail -> IO Mail
 buildMail mail = let ?mail = mail in simpleMail (to mail) from subject (cs $ text mail) (html mail |> Blaze.renderHtml) []
@@ -46,6 +49,16 @@ sendWithMailServer SES { .. } mail = do
         }
     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 = SMTP.sendMail' host port mail
+    | otherwise = SMTP.sendMailWithLogin' host port (fst creds) (snd creds) mail
+    where creds = fromJust credentials
+
 sendWithMailServer Sendmail mail = do
     message <- renderMail' mail
     sendmail message
@@ -68,4 +81,4 @@ class BuildMail mail where
 
     -- | 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))
+    text mail = stripTags (cs $ Blaze.renderHtml (html mail))

IHP/Mail/Types.hs

@@ -9,17 +9,22 @@ module IHP.Mail.Types
 where
 
 import IHP.Prelude
-import Network.Mail.Mime
-import qualified Network.Mail.Mime.SES as Mailer
-import Text.Blaze.Html5 (Html)
-import qualified Text.Blaze.Html.Renderer.Text as Blaze
+import Network.Socket (PortNumber) 
 
 -- | Configuration for a mailer used by IHP
 data MailServer =
-    -- | Uses AWS SES for sending emails. Highly recommended in production
+    -- | 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
+    -- | Uses the local Sendmail binary for sending emails. Avoid this with IHP Cloud
     | Sendmail
+    -- | Uses SendGrid for sending emails
+    | SendGrid { apiKey :: Text
+               , category :: Maybe Text }
+    -- | Uses a generic SMTP for sending emails
+    | SMTP { host :: String
+           , port :: PortNumber
+           -- (Username,Password) combination
+           , credentials :: Maybe (String, String)}

IHP/SchemaCompiler.hs

@@ -391,6 +391,7 @@ compileCreate table@(CreateTable { name, columns }) =
             "create :: (?modelContext :: ModelContext) => " <> modelName <> " -> IO " <> modelName <> "\n"
                 <> "create model = do\n"
                 <> indent ("List.head <$> withDatabaseConnection \\databaseConnection -> Database.PostgreSQL.Simple.query databaseConnection \"INSERT INTO " <> name <> " (" <> columnNames <> ") VALUES (" <> values <> ") RETURNING *\" (" <> compileToRowValues bindings <> ")\n")
+                <> "createMany [] = pure []\n"
                 <> "createMany models = do\n"
                 <> indent ("withDatabaseConnection \\databaseConnection -> "
                     <> createManyQueryFn <> " databaseConnection (Query $ \"INSERT INTO " <> name <> " (" <> columnNames <> ") VALUES \" <> (ByteString.intercalate \", \" (List.map (\\_ -> \"(" <> values <> ")\") models)) <> \" RETURNING *\") " <> createManyFieldValues <> "\n"

ihp.cabal

@@ -74,6 +74,7 @@ common shared-properties
             , binary
             , mime-mail
             , mime-mail-ses
+            , smtp-mail
             , http-client
             , http-client-tls
             , resource-pool

ihp.nix

@@ -34,6 +34,7 @@
 , wai-websockets
 , mime-mail
 , mime-mail-ses
+, smtp-mail
 , attoparsec
 , case-insensitive
 , http-media
@@ -89,6 +90,7 @@ mkDerivation {
     wai-websockets
     mime-mail
     mime-mail-ses
+    smtp-mail
     attoparsec
     case-insensitive
     http-media

shell.nix

@@ -35,6 +35,7 @@ let
 	    wai-websockets
 	    mime-mail
 	    mime-mail-ses
+	    smtp-mail
 	    attoparsec
 	    case-insensitive
 	    http-media