modernize to yesod-core >= 1.6

This commit is contained in:
nek0 2018-03-20 09:45:39 +01:00
parent 923b3cdd82
commit f7a1f928ef
2 changed files with 21 additions and 20 deletions

View file

@ -71,7 +71,7 @@ mkMessage "App" "messages" "en"
-- explanation for this split.
mkYesodData "App" $(parseRoutesFile "config/routes")
type Form x = Html -> MForm (HandlerT App IO) (FormResult x, Widget)
type Form x = Html -> MForm (HandlerFor App) (FormResult x, Widget)
renderLayout :: Widget -> Handler Html
renderLayout widget = do
@ -274,15 +274,16 @@ instance RenderMessage App FormMessage where
-- https://github.com/yesodweb/yesod/wiki/Sending-email
instance YesodHmacKeccak (HmacPersistDB App User Token) App where
runHmacDB = runHmacPersistDB
runHmacDB = liftHandler . runHmacPersistDB
rawLoginRoute = Just LoginRawR
getNewAccountR = do
master <- lift $ getYesod
master <- getYesod
tm <- getRouteToParent
if not (appSignupBlocked $ appSettings master)
then do
tm <- getRouteToParent
lift $ defaultLayout $ do
((_, widget), enctype) <- liftHandlerT $ runFormPost $
authLayout $ do
((_, widget), enctype) <- runFormPost $
renderBootstrap3 BootstrapBasicForm $ eidolonAccountForm
(appTos1 $ appSettings master)
(appTos2 $ appSettings master)
@ -296,36 +297,36 @@ instance YesodHmacKeccak (HmacPersistDB App User Token) App where
|]
else do
setMessage "User signup has been disabled"
redirect LoginR
redirect (tm LoginR)
postNewAccountR = do
master <- lift $ getYesod
tm <- getRouteToParent
master <- getYesod
if not (appSignupBlocked $ appSettings master)
then do
tm <- getRouteToParent
((result, _), _) <- lift $ runFormPost $
((result, _), _) <- runFormPost $
renderBootstrap3 BootstrapBasicForm $ eidolonAccountForm
(appTos1 $ appSettings master)
(appTos2 $ appSettings master)
case result of
FormMissing -> invalidArgs ["Form is missing"]
FormFailure m -> do
lift $ setMessage $ toHtml $ T.concat m
redirect newAccountR
setMessage $ toHtml $ T.concat m
redirect (tm newAccountR)
FormSuccess d -> do
case (eadTos1 d, eadTos2 d) of
(Just True, Just True) -> do
lift $ setMessageI MsgActivationSent
lift $ createNewAccount
setMessageI MsgActivationSent
createNewAccount
(NewAccountData (eadUsername d) (eadEmail d))
tm
redirect LoginR
redirect (tm LoginR)
_ -> do
lift $ setMessage "Please Accept the Terms of Service"
redirect newAccountR
setMessage "Please Accept the Terms of Service"
redirect (tm newAccountR)
else do
lift $ setMessage "User signup has been disabled"
redirect LoginR
setMessage "User signup has been disabled"
redirect (tm LoginR)
data EidolonAccountData = EidolonAccountData
{ eadUsername :: T.Text
@ -388,7 +389,7 @@ See you soon!
|]
sendReactivateEmail username email url = do
muser <- runDB $ getBy $ UniqueUser username
muser <- runHmacDB $ loadUser username
let user = entityVal $ fromJust muser
sendMail email "Reset your password" $
[shamlet|

View file

@ -3,7 +3,7 @@ version: 0.1.11.11
synopsis: Image gallery in Yesod
homepage: https://eidolon.nek0.eu
license: AGPL-3
license-file: LICENSE.md
license-file: LICENSE
author: Amedeo Molnár
maintainer: nek0@chelnok.de
category: Web