nek0/eidolon
1
0
Fork 0
Code Issues Pull requests Projects Releases Wiki Activity

modernize to yesod-core >= 1.6

Browse source
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
Show stats Download patch file Download diff file Expand all files Collapse all files

39
Foundation.hs
View file

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

2
eidolon.cabal
View file

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