moved stuff to helper
This commit is contained in:
parent
eb22685597
commit
06c55cc449
2 changed files with 25 additions and 29 deletions
|
@ -56,35 +56,6 @@ postSignupR = do
|
||||||
setMessage "This user already exists"
|
setMessage "This user already exists"
|
||||||
redirect $ SignupR
|
redirect $ SignupR
|
||||||
|
|
||||||
--signupForm :: Form User
|
|
||||||
--signupForm = renderDivs $ User
|
|
||||||
-- <$> areq textField "Username" Nothing
|
|
||||||
-- <*> areq emailField "Email" Nothing
|
|
||||||
-- <*> areq passwordField "Password" Nothing
|
|
||||||
-- <*> pure ("" :: ByteString)
|
|
||||||
-- <*> pure []
|
|
||||||
|
|
||||||
validateLen :: Text -> Bool
|
validateLen :: Text -> Bool
|
||||||
validateLen a =
|
validateLen a =
|
||||||
(T.length a) > 3
|
(T.length a) > 3
|
||||||
|
|
||||||
generateString :: IO T.Text
|
|
||||||
generateString = (toHex . B.pack . I.take 16 . randoms) <$> newStdGen
|
|
||||||
|
|
||||||
sendMail :: MonadIO m => Text -> Text -> Html -> m ()
|
|
||||||
sendMail toEmail subject body =
|
|
||||||
liftIO $ renderSendMail
|
|
||||||
Mail
|
|
||||||
{ mailFrom = Address Nothing "noreply" -- TODO: set sender Address
|
|
||||||
, mailTo = [Address Nothing toEmail]
|
|
||||||
, mailCc = []
|
|
||||||
, mailBcc = []
|
|
||||||
, mailHeaders = [("Subject", subject)]
|
|
||||||
, mailParts = [[Part
|
|
||||||
{ partType = "text/html; charset=utf-8"
|
|
||||||
, partEncoding = None
|
|
||||||
, partFilename = Nothing
|
|
||||||
, partHeaders = []
|
|
||||||
, partContent = renderHtml body
|
|
||||||
}]]
|
|
||||||
}
|
|
||||||
|
|
25
Helper.hs
25
Helper.hs
|
@ -8,6 +8,8 @@ module Helper
|
||||||
, makeRandomToken
|
, makeRandomToken
|
||||||
, generateSalt
|
, generateSalt
|
||||||
, tagField
|
, tagField
|
||||||
|
, sendMail
|
||||||
|
, generateString
|
||||||
)
|
)
|
||||||
where
|
where
|
||||||
|
|
||||||
|
@ -29,6 +31,8 @@ import Yesod.Persist.Core
|
||||||
import Yesod.Core.Types
|
import Yesod.Core.Types
|
||||||
import Yesod
|
import Yesod
|
||||||
import Numeric (readHex, showHex)
|
import Numeric (readHex, showHex)
|
||||||
|
import Network.Mail.Mime
|
||||||
|
import Text.Blaze.Html.Renderer.Utf8
|
||||||
|
|
||||||
getUserIdFromText :: T.Text -> UserId
|
getUserIdFromText :: T.Text -> UserId
|
||||||
getUserIdFromText tempUserId =
|
getUserIdFromText tempUserId =
|
||||||
|
@ -83,3 +87,24 @@ tagField = Field
|
||||||
[whamlet|<input id=#{idAttr} type="text" name=#{nameAttr} value=#{either id (T.intercalate " ") eResult}>|]
|
[whamlet|<input id=#{idAttr} type="text" name=#{nameAttr} value=#{either id (T.intercalate " ") eResult}>|]
|
||||||
, fieldEnctype = UrlEncoded
|
, fieldEnctype = UrlEncoded
|
||||||
}
|
}
|
||||||
|
|
||||||
|
sendMail :: MonadIO m => T.Text -> T.Text -> Html -> m ()
|
||||||
|
sendMail toEmail subject body =
|
||||||
|
liftIO $ renderSendMail
|
||||||
|
Mail
|
||||||
|
{ mailFrom = Address Nothing "noreply" -- TODO: set sender Address
|
||||||
|
, mailTo = [Address Nothing toEmail]
|
||||||
|
, mailCc = []
|
||||||
|
, mailBcc = []
|
||||||
|
, mailHeaders = [("Subject", subject)]
|
||||||
|
, mailParts = [[Part
|
||||||
|
{ partType = "text/html; charset=utf-8"
|
||||||
|
, partEncoding = None
|
||||||
|
, partFilename = Nothing
|
||||||
|
, partHeaders = []
|
||||||
|
, partContent = renderHtml body
|
||||||
|
}]]
|
||||||
|
}
|
||||||
|
|
||||||
|
generateString :: IO T.Text
|
||||||
|
generateString = (toHex . B.pack . take 16 . randoms) <$> newStdGen
|
||||||
|
|
Loading…
Add table
Reference in a new issue