in development mode, log email instead of sending
This commit is contained in:
parent
c10d6c7164
commit
773e8f517a
@ -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
|
||||||
|
|||||||
Loading…
Reference in New Issue
Block a user