Use generic SMTP rather than Sendmail-specific mail client.

[?]

Jul 4, 2015, 4:08 PM

6L5BK5EHPAOQX3JCKUJ273UDNAC23LPQL4HIJGM4AV3P3QK5OKIQC

Dependencies

[2] LCBJULKE Fix swapped default and key in QConfig.
[3] GCVQD44V Create amends endpoint, switch to UUID primary keys
[4] 4U7F3CPI THE GREAT RENAMING OF THINGS!
[5] PGZJ736C Update aftok.cfg.example and revise INSTALL instructions
[6] Z7KS5XHH Very WIP. Wow.
[7] 2XQD6KKK Add invitation logic and clean up DBProg error handling.
[8] PBD7LZYQ Postgres & auth are beginning to function.
[9] V2VDN77H Enable postgres configuration via environment variable for Heroku.
[10] M3KUPGZK Add invitation email template.
[11] IZEVQF62 Work in progress replacing sqlite with postgres.
[12] O5FVTOM6 Undo JSON silliness, enable a couple more routes.
[13] OBFPJS2G Project successfully builds and tests under nix.
[14] SPJCFHXW Update shell scripts to point to https://aftok.com and prompt for input.
[*] 64C6AWH6 Rename Ananke -> Quixotic, project reboot.
[*] TCOAKCGG Completed conversion to snap.
[*] QO4NFWIY Added sample config file.
[*] NVOCQVAS Initial failing tests.

Change contents

edit in aftok.cabal at line 116

[17.52]

[3.1248]

, mime-mail
edit in aftok.cabal at line 119

[3.1348]

[3.3183]

, network
replacement in aftok.cabal at line 123

[3.7326]→[3.1349:1388](∅→∅)

, sendgrid-haskell >= 1.0

[3.7326]

[3.1388]

, smtp-mail >= 0.1.4.5
replacement in conf/aftok.cfg.example at line 25

[3.258]→[3.258:307](∅→∅)

sendgridUser = "example"
sendgridKey = "abcdefg"

[3.258]

[3.307]

smtpHost = "smtp.sendgrid.net"
# smtpPort = 25
smtpUser = "whoareyou"
smtpPass = "iami"
replacement in lib/Aftok.hs at line 60

[3.7130]→[3.7130:7179](∅→∅)

randomInvCode = InvitationCode <$> randBytes 256

[3.7130]

[3.3399]

randomInvCode = InvitationCode <$> randBytes 32
replacement in lib/Aftok.hs at line 65

[3.7291]→[3.7291:7315](∅→∅)

if length code == 256

[3.7291]

[3.7315]

if length code == 32
replacement in server/Aftok/QConfig.hs at line 8

[3.4683]→[3.7726:7776](∅→∅)

import qualified Network.Sendgrid.Api as Sendgrid

[3.4683]

[3.4683]

import qualified Network.Socket as NS
import qualified Network.Mail.SMTP as SMTP
replacement in server/Aftok/QConfig.hs at line 23

[3.5002]→[3.7806:7850](∅→∅)

, sendgridAuth :: Sendgrid.Authentication

[3.5002]

[3.7850]

, smtpConfig :: SmtpConfig
edit in server/Aftok/QConfig.hs at line 26

[3.5084]

[3.5084]

data SmtpConfig = SmtpConfig
{ smtpHost :: NS.HostName
, smtpPort :: Maybe NS.PortNumber
, smtpUser :: SMTP.UserName
, smtpPass :: SMTP.Password
}
replacement in server/Aftok/QConfig.hs at line 48

[3.5653]→[3.7890:7925](∅→∅)

<*> readSendgridAuth cfg

[3.5653]

[2.3]

<*> readSmtpConfig cfg
replacement in server/Aftok/QConfig.hs at line 51

[3.7969]→[3.7969:8170](∅→∅)

readSendgridAuth :: CT.Config -> IO Sendgrid.Authentication
readSendgridAuth cfg =
Sendgrid.Authentication <$> C.require cfg "sendgridUser"
<*> C.require cfg "sendgridKey"

[3.7969]

[3.5811]

readSmtpConfig :: CT.Config -> IO SmtpConfig
readSmtpConfig cfg =
SmtpConfig <$> C.require cfg "smtpHost"
<*> ((fmap . fmap) fromInteger $ C.lookup cfg "smtpPort")
<*> C.require cfg "smtpUser"
<*> C.require cfg "smtpKey"
replacement in server/Aftok/Snaplet/Projects.hs at line 11

[3.8711]→[3.8711:8761](∅→∅)

import qualified Network.Sendgrid.Api as Sendgrid

[3.8711]

[3.8761]

import Network.Mail.SMTP as SMTP
import Network.Mail.Mime
replacement in server/Aftok/Snaplet/Projects.hs at line 61

[3.9326]→[3.9326:9687](∅→∅)

inviteEmail <- liftIO $
projectInviteEmail (templatePath cfg) (p ^. projectName) (u ^. userEmail) toEmail invCode
maybeSuccess <- liftIO $ Sendgrid.sendEmail (sendgridAuth cfg) inviteEmail
maybe
(snapError 500 "The invitation record was created successfully, but the introductory email could not be sent.")
(const $ pure ())
maybeSuccess

[3.9326]

[3.9687]

liftIO $ sendProjectInviteEmail cfg (p ^. projectName) (u ^. userEmail) toEmail invCode

sendProjectInviteEmail :: QConfig
-> ProjectName
-> Email -- Inviting user's email address
-> Email -- Invitee's email address
-> InvitationCode
-> IO ()
sendProjectInviteEmail cfg pn fromEmail toEmail invCode =
let SmtpConfig{..} = smtpConfig cfg
mailer = maybe (sendMailWithLogin smtpHost) (sendMailWithLogin' smtpHost) smtpPort
in buildProjectInviteEmail (templatePath cfg) pn fromEmail toEmail invCode >>=
(mailer smtpUser smtpPass)
replacement in server/Aftok/Snaplet/Projects.hs at line 77

[3.9688]→[3.9688:9947](∅→∅)

projectInviteEmail :: System.IO.FilePath
-> ProjectName
-> Email -> Email
-> InvitationCode
-> IO Sendgrid.EmailMessage
projectInviteEmail templatePath pn from' to' invCode = do

[3.9688]

[3.9947]

buildProjectInviteEmail :: System.IO.FilePath
-> ProjectName
-> Email -- Inviting user's email address
-> Email -- Invitee's email address
-> InvitationCode
-> IO Mail
buildProjectInviteEmail templatePath pn fromEmail toEmail invCode = do
replacement in server/Aftok/Snaplet/Projects.hs at line 85

[3.9991]→[3.9991:10124](∅→∅),[3.10124]→[3.441:679](∅→∅),[3.679]→[3.10188:10222](∅→∅),[3.10188]→[3.10188:10222](∅→∅),[3.10222]→[3.680:717](∅→∅),[3.717]→[3.10260:10398](∅→∅),[3.10260]→[3.10260:10398](∅→∅)

template <- maybe (fail "Could not find template for invitation email") pure $
getStringTemplate "invitation_email" templates
let setAttrs = setAttribute "from_email" (from' ^. _Email) .
setAttribute "project_name" pn .
setAttribute "to_email" (to' ^. _Email) .
setAttribute "inv_code" (renderInvCode invCode)
return $ Sendgrid.EmailMessage
{ from = "invitations@aftok.com"
, to = unpack $ to' ^. _Email
, subject = unpack $ "Welcome to the "<>pn<>" Aftok!"
, text = render $ setAttrs template
}

[3.9991]

[3.3685]

case getStringTemplate "invitation_email" templates of
Nothing -> fail "Could not find template for invitation email"
Just template ->
let setAttrs = setAttribute "from_email" (fromEmail ^. _Email) .
setAttribute "project_name" pn .
setAttribute "to_email" (toEmail ^. _Email) .
setAttribute "inv_code" (renderInvCode invCode)
fromAddr = Address Nothing ("invitations@aftok.com")
toAddr = Address Nothing (toEmail ^. _Email)
subject = "Welcome toEmail the "<>pn<>" Aftok!"
body = plainTextPart . render $ setAttrs template
in pure $ SMTP.simpleMail fromAddr [toAddr] [] [] subject [body]