in development mode, log email instead of sending

This commit is contained in:
Greg Weber 2011-08-24 07:03:09 -07:00
parent c10d6c7164
commit 773e8f517a

View File

@ -1,5 +1,6 @@
{-# LANGUAGE QuasiQuotes, TemplateHaskell, TypeFamilies #-} {-# LANGUAGE QuasiQuotes, TemplateHaskell, TypeFamilies #-}
{-# LANGUAGE OverloadedStrings, MultiParamTypeClasses #-} {-# LANGUAGE OverloadedStrings, MultiParamTypeClasses #-}
{-# LANGUAGE CPP #-}
module Foundation module Foundation
( ~sitearg~ (..) ( ~sitearg~ (..)
, ~sitearg~Route (..) , ~sitearg~Route (..)
@ -31,13 +32,13 @@ import Model
import Data.Maybe (isJust) import Data.Maybe (isJust)
import Control.Monad (join, unless) import Control.Monad (join, unless)
import Network.Mail.Mime import Network.Mail.Mime
import qualified Data.Text.Lazy
import qualified Data.Text.Lazy.Encoding import qualified Data.Text.Lazy.Encoding
import Text.Jasmine (minifym) import Text.Jasmine (minifym)
import qualified Data.Text as T import qualified Data.Text as T
import Web.ClientSession (getKey) import Web.ClientSession (getKey)
import Text.Blaze.Renderer.Utf8 (renderHtml) import Text.Blaze.Renderer.Utf8 (renderHtml)
import Text.Hamlet (shamlet) import Text.Hamlet (shamlet)
import Text.Shakespeare.Text (stext)
-- | The site argument for your application. This can be a good place to -- | The site argument for your application. This can be a good place to
-- keep settings and values requiring initialization before your application -- keep settings and values requiring initialization before your application
@ -143,32 +144,43 @@ instance YesodAuth ~sitearg~ where
, authEmail , authEmail
] ]
deliver :: ~sitearg~ -> L.ByteString -> IO ()
#ifdef PRODUCTION
deliver _ = sendmail
#else
deliver y = logLazyText (getLogger y) . Data.Text.Lazy.Encoding.decodeUtf8
#endif
instance YesodAuthEmail ~sitearg~ where instance YesodAuthEmail ~sitearg~ where
type AuthEmailId ~sitearg~ = EmailId type AuthEmailId ~sitearg~ = EmailId
addUnverified email verkey = addUnverified email verkey =
runDB $ insert $ Email email Nothing $ Just verkey runDB $ insert $ Email email Nothing $ Just verkey
sendVerifyEmail email _ verurl = liftIO $ renderSendMail Mail
{ mailHeaders = sendVerifyEmail email _ verurl = do
[ ("From", "noreply") y <- getYesod
, ("To", email) liftIO $ deliver y =<< renderMail' Mail
, ("Subject", "Verify your email address") {
] mailHeaders =
, mailParts = [[textPart, htmlPart]] [ ("From", "noreply")
} , ("To", email)
, ("Subject", "Verify your email address")
]
, mailParts = [[textPart, htmlPart]]
}
where where
textPart = Part textPart = Part
{ partType = "text/plain; charset=utf-8" { partType = "text/plain; charset=utf-8"
, partEncoding = None , partEncoding = None
, partFilename = Nothing , partFilename = Nothing
, partContent = Data.Text.Lazy.Encoding.encodeUtf8 , partContent = Data.Text.Lazy.Encoding.encodeUtf8 [stext|
$ Data.Text.Lazy.unlines Please confirm your email address by clicking on the link below.
[ "Please confirm your email address by clicking on the link below."
, "" #{verurl}
, Data.Text.Lazy.fromChunks [verurl]
, "" Thank you |]
, "Thank you"
]
, partHeaders = [] , partHeaders = []
} }
htmlPart = Part htmlPart = Part