From f7a1f928efe55b3ba3a96c29c0918adebecb3008 Mon Sep 17 00:00:00 2001 From: nek0 Date: Tue, 20 Mar 2018 09:45:39 +0100 Subject: [PATCH] modernize to yesod-core >= 1.6 --- Foundation.hs | 39 ++++++++++++++++++++------------------- eidolon.cabal | 2 +- 2 files changed, 21 insertions(+), 20 deletions(-) diff --git a/Foundation.hs b/Foundation.hs index fe14658..e64d67b 100755 --- a/Foundation.hs +++ b/Foundation.hs @@ -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| diff --git a/eidolon.cabal b/eidolon.cabal index 73ed989..2095748 100755 --- a/eidolon.cabal +++ b/eidolon.cabal @@ -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