From 7f0c5824500ddf80596d7cc1cdc4b817acea6622 Mon Sep 17 00:00:00 2001 From: nek0 Date: Sun, 24 Dec 2017 07:57:23 +0100 Subject: [PATCH] version bump --- Foundation.hs | 73 ++++++++++++++++++++++++++++++++++++++++++++++++++- eidolon.cabal | 4 +-- 2 files changed, 74 insertions(+), 3 deletions(-) diff --git a/Foundation.hs b/Foundation.hs index 13d59cc..659308c 100755 --- a/Foundation.hs +++ b/Foundation.hs @@ -14,7 +14,7 @@ -- You should have received a copy of the GNU Affero General Public License -- along with this program. If not, see . -{-# LANGUAGE FlexibleInstances #-} +{-# LANGUAGE FlexibleInstances, PackageImports #-} module Foundation where @@ -39,6 +39,9 @@ import Network.Wai import Helper hiding (hmacKeccak) import Yesod.Auth import Yesod.Auth.HmacKeccak +import "yesod-auth-hmac-keccak" Yesod.Auth.Types (gimmeFile) +import "yesod-auth-hmac-keccak" Yesod.Auth.Message as Auth +import Yesod.Form.Bootstrap3 import System.IO.Unsafe (unsafePerformIO) -- | The site argument for your application. This can be a good place to @@ -273,6 +276,74 @@ instance RenderMessage App FormMessage where instance YesodHmacKeccak (HmacPersistDB App User Token) App where runHmacDB = runHmacPersistDB rawLoginRoute = Just LoginRawR + getNewAccountR = do + master <- lift $ getYesod + if not (appSignupBlocked $ appSettings master) + then do + tm <- getRouteToParent + lift $ defaultLayout $ do + ((_, widget), enctype) <- liftHandlerT $ runFormPost $ + renderBootstrap3 BootstrapBasicForm $ eidolonAccountForm + (appTos1 $ appSettings master) + (appTos2 $ appSettings master) + render <- getUrlRenderParams + toWidgetHead $ gimmeFile render + setTitleI MsgRegisterLong + [whamlet| +
+
+ ^{widget} + |] + else do + setMessage "User signup has been disabled" + redirect LoginR + + postNewAccountR = do + master <- lift $ getYesod + if not (appSignupBlocked $ appSettings master) + then do + tm <- getRouteToParent + ((result, _), _) <- lift $ 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 + FormSuccess d -> do + case (eadTos1 d, eadTos2 d) of + (Just True, Just True) -> do + lift $ setMessageI MsgActivationSent + lift $ createNewAccount + (NewAccountData (eadUsername d) (eadEmail d)) + tm + redirect LoginR + _ -> do + lift $ setMessage "Please Accept the Terms of Service" + redirect newAccountR + else do + lift $ setMessage "User signup has been disabled" + redirect LoginR + +data EidolonAccountData = EidolonAccountData + { eadUsername :: T.Text + , eadEmail :: T.Text + , eadTos1 :: Maybe Bool + , eadTos2 :: Maybe Bool + } + +eidolonAccountForm tos1 tos2= EidolonAccountData + <$> areq (checkM checkValidUsername textField) userSettings Nothing + <*> areq emailField emailSettings Nothing + <*> aopt checkBoxField (tosSettings tos1) Nothing + <*> aopt checkBoxField (tosSettings tos2) Nothing + <* bootstrapSubmit ("Sign up" :: BootstrapSubmit T.Text) + where + userSettings = bfs (SomeMessage MsgUsername) + emailSettings = bfs (SomeMessage MsgEmail) + tosSettings t = bfs (SomeMessage t) instance UserCredentials (Entity User) where userUserName = userName . entityVal diff --git a/eidolon.cabal b/eidolon.cabal index 51016e6..30f9708 100755 --- a/eidolon.cabal +++ b/eidolon.cabal @@ -1,5 +1,5 @@ name: eidolon -version: 0.1.11.9 +version: 0.1.11.10 synopsis: Image gallery in Yesod homepage: https://eidolon.nek0.eu license: AGPL-3 @@ -148,7 +148,7 @@ library , texmath , fuzzy , yesod-auth - , yesod-auth-hmac-keccak + , yesod-auth-hmac-keccak >= 0.0.0.4 executable eidolon if flag(library-only)