{-# LANGUAGE NoImplicitPrelude #-} {-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE TypeOperators #-} -- | Hooks interpreter that sends a mail via a SMTP server for each element. -- You may want to consult "Network.HaskellNet.SMTP", "Network.HaskellNet.SMTP.SSL" and "Network.Mail.Mime" modules for additional information. -- -- Here is an example configuration: -- -- > sendmail :: SendMailSettings -- > sendmail = SendMailSettings smtpServer formatMail -- > -- > formatMail :: FormatMail -- > formatMail = FormatMail -- > (\a b -> (defaultFormatFrom a b) { addressEmail = "user@host" } ) -- > defaultFormatSubject -- > defaultFormatBody -- > (\_ _ -> [Address Nothing "user@host"]) -- > -- > smtpServer :: Feed -> FeedElement -> SMTPServer -- > smtpServer _ _ = SMTPServer -- > (Just $ Authentication PLAIN "user" "password") -- > (StartTls "smtp.server" defaultSettingsSMTPSTARTTLS) -- module Imm.Hooks.SendMail (module Imm.Hooks.SendMail, module Reexport) where -- {{{ Imports import Imm.Feed import Imm.Hooks import Imm.Prelude import Imm.Pretty import Data.NonNull import Data.Time import Network.HaskellNet.SMTP as Reexport import Network.HaskellNet.SMTP.SSL as Reexport import Network.Mail.Mime as Reexport hiding (sendmail) import Network.Socket import Text.Atom.Types import Text.RSS.Types -- }}} -- * Settings type Username = String type Password = String type ServerName = String -- | How to connect to the SMTP server data ConnectionSettings = Plain ServerName PortNumber | Ssl ServerName Settings | StartTls ServerName Settings deriving(Eq, Show) -- | How to authenticate to the SMTP server data Authentication = Authentication AuthType Username Password deriving(Eq, Show) data SMTPServer = SMTPServer (Maybe Authentication) ConnectionSettings deriving (Eq, Show) -- | How to format outgoing mails from feed elements data FormatMail = FormatMail { formatFrom :: Feed -> FeedElement -> Address -- ^ How to write the From: header of feed mails , formatSubject :: Feed -> FeedElement -> Text -- ^ How to write the Subject: header of feed mails , formatBody :: Feed -> FeedElement -> Text -- ^ How to write the body of feed mails (sic!) , formatTo :: Feed -> FeedElement -> [Address] -- ^ How to write the To: header of feed mails } data SendMailSettings = SendMailSettings (Feed -> FeedElement -> SMTPServer) FormatMail -- * Interpreter -- | Interpreter for 'HooksF' mkCoHooks :: (MonadIO m) => SendMailSettings -> CoHooksF m SendMailSettings mkCoHooks a@(SendMailSettings connectionSettings formatMail) = CoHooksF coOnNewElement where coOnNewElement feed element = do timezone <- io getCurrentTimeZone currentTime <- io getCurrentTime let mail = buildMail formatMail currentTime timezone feed element io $ withSMTPConnection (connectionSettings feed element) $ sendMimeMail2 mail return a -- | Fill 'addressName' with the feed title and, if available, the authors' names. -- -- This function leaves 'addressEmail' empty. You are expected to fill it adequately, because many SMTP servers enforce constraints on the From: email. defaultFormatFrom :: Feed -> FeedElement -> Address defaultFormatFrom (Rss doc) (RssElement item) = Address (Just $ channelTitle doc <> " (" <> itemAuthor item <> ")") "" defaultFormatFrom (Atom feed) (AtomElement entry) = Address (Just $ title <> " (" <> authors <> ")") "" where title = show . prettyAtomText $ feedTitle feed authors = intercalate ", " $ map (toNullable . personName) $ entryAuthors entry <> feedAuthors feed defaultFormatFrom _ _ = Address (Just "Unknown") "" -- | Fill mail subject with the element title defaultFormatSubject :: Feed -> FeedElement -> Text defaultFormatSubject _ element = getTitle element -- | Fill mail body with: -- -- - a list of links associated to the element -- - the element's content or description/summary defaultFormatBody :: Feed -> FeedElement -> Text defaultFormatBody _ (RssElement item) = "
" <> maybe "
" <> itemDescription item <> "
" defaultFormatBody _ (AtomElement entry) = "" <> intercalate "
" links <> "
" <> fromMaybe "