{-# LANGUAGE OverloadedStrings, GADTs, FlexibleContexts #-}
module EmailVerification (newAccountEmail, resetAccountEmail) where
import qualified Yesod.Core as YC
import qualified Yesod.Core.Handler as YH
import qualified Data.Text as DT (Text, append, concat)
import qualified Network.Mail.Mime as Mime
import qualified Data.Text.Lazy as DTL
import JRState (JRState(..))
import Control.Monad.Logger (logInfoN)
import qualified Network.Wai as WAI
import qualified Branding (visibleName)
import Data.Text.Encoding (decodeUtf8)
import TextShow (showt)
emailEnaction :: (YC.MonadLogger m, YC.MonadHandler m, YC.HandlerSite m ~ JRState) => DT.Text -> DT.Text -> DT.Text -> DT.Text -> m ()
emailEnaction what uname email path = YH.waiRequest >>= \req -> maybe (YC.getYesod >>= enactSc) (\hostName -> enactRq (decodeUtf8 hostName) (WAI.isSecure req)) (WAI.requestHeaderHost req) where
enactRq serverHost isSecure = emailAction what uname email fullURL where
fullURL = DT.concat [if isSecure then "https" else "http", "://", serverHost, path]
enactSc site = emailAction what uname email fullURL where
fullURL = DT.concat [appRoot site, maybe "" (DT.append ":" . showt) (portNumber site), path]
newAccountEmail, resetAccountEmail :: (YC.MonadLogger m, YC.MonadHandler m, YC.HandlerSite m ~ JRState) => DT.Text -> DT.Text -> DT.Text -> m ()
newAccountEmail = emailEnaction "Verification"
resetAccountEmail = emailEnaction "Reset password"
emailAction :: (YC.MonadLogger m, YC.MonadIO m) => DT.Text -> DT.Text -> DT.Text -> DT.Text -> m ()
emailAction text uname email url = YC.liftIO (Mime.renderSendMail $ makeEmail uname email url) >> logAccountEmail uname email url text
logAccountEmail :: YC.MonadLogger m => DT.Text -> DT.Text -> DT.Text -> DT.Text -> m ()
logAccountEmail uname email url action = logInfoN $ DT.concat [ action, " email for ", uname, " (", email, "): ", url ]
makeEmail :: DT.Text -> DT.Text -> DT.Text -> Mime.Mail
makeEmail uname email url =
Mime.simpleMail'
(Mime.Address (Just uname) email)
(Mime.Address (Just $ DT.append Branding.visibleName " Verification") "root@localhost")
(DT.append Branding.visibleName " Account")
(DTL.concat [ "Your URL is ", DTL.fromChunks [ url ] ])