diff --git a/Handler/Signup.hs b/Handler/Signup.hs index cadbfc6..096cc82 100644 --- a/Handler/Signup.hs +++ b/Handler/Signup.hs @@ -8,55 +8,66 @@ import Data.Maybe getSignupR :: Handler Html getSignupR = do --- (signupWidget, enctype) <- generateFormPost signupForm - defaultLayout $ do - setTitle "Eidolon :: Signup" - $(widgetFile "signup") + block <- fmap extraSignupBlocked appExtra + case block of + False -> do + defaultLayout $ do + setTitle "Eidolon :: Signup" + $(widgetFile "signup") + True -> do + setMessage "User signup has been disabled" + redirect $ HomeR postSignupR :: Handler Html postSignupR = do - mUserName <- lookupPostParam "username" - newUserName <- case validateLen (fromJust mUserName) of - True -> return $ fromJust $ mUserName + block <- fmap extraSignupBlocked appExtra + case block of False -> do - setMessage "Invalid username" - redirect $ SignupR - mEmail <- lookupPostParam "email" - mTos1 <- lookupPostParam "tos-1" - mTos2 <- lookupPostParam "tos-2" - case (mTos1, mTos2) of - (Just "tos-1", Just "tos-2") -> - return () - _ -> do - setMessage "You need to agree to our terms." - redirect $ SignupR - -- create user - namesakes <- runDB $ selectList [UserName ==. newUserName] [] - case namesakes of - [] -> do - salt <- liftIO generateSalt - newUser <- return $ User newUserName - newUserName - (fromJust mEmail) - salt - "" - [] - False - activatorText <- liftIO generateString - aId <- runDB $ insert $ Activator activatorText newUser - tId <- runDB $ insert $ Token (encodeUtf8 activatorText) "activate" Nothing - activateLink <- ($ ActivateR activatorText) <$> getUrlRender - sendMail (userEmail newUser) "Please activate your account!" $ - [shamlet| -

Hello #{userSlug newUser} and Welcome to Eidolon! - To complete your sgnup please activate your account by visiting the following link: - #{activateLink} - |] - setMessage "User pending activation" + mUserName <- lookupPostParam "username" + newUserName <- case validateLen (fromJust mUserName) of + True -> return $ fromJust $ mUserName + False -> do + setMessage "Invalid username" + redirect $ SignupR + mEmail <- lookupPostParam "email" + mTos1 <- lookupPostParam "tos-1" + mTos2 <- lookupPostParam "tos-2" + case (mTos1, mTos2) of + (Just "tos-1", Just "tos-2") -> + return () + _ -> do + setMessage "You need to agree to our terms." + redirect $ SignupR + -- create user + namesakes <- runDB $ selectList [UserName ==. newUserName] [] + case namesakes of + [] -> do + salt <- liftIO generateSalt + newUser <- return $ User newUserName + newUserName + (fromJust mEmail) + salt + "" + [] + False + activatorText <- liftIO generateString + aId <- runDB $ insert $ Activator activatorText newUser + tId <- runDB $ insert $ Token (encodeUtf8 activatorText) "activate" Nothing + activateLink <- ($ ActivateR activatorText) <$> getUrlRender + sendMail (userEmail newUser) "Please activate your account!" $ + [shamlet| +

Hello #{userSlug newUser} and Welcome to Eidolon! + To complete your sgnup please activate your account by visiting the following link: + #{activateLink} + |] + setMessage "User pending activation" + redirect $ HomeR + _ -> do + setMessage "This user already exists" + redirect $ SignupR + True -> do + setMessage "User signup is disabled" redirect $ HomeR - _ -> do - setMessage "This user already exists" - redirect $ SignupR validateLen :: Text -> Bool validateLen a = diff --git a/config/settings.yml b/config/settings.yml index cc386a3..910db87 100644 --- a/config/settings.yml +++ b/config/settings.yml @@ -3,7 +3,8 @@ Default: &defaults port: 3000 approot: "http://localhost:3000" copyright: Insert copyright statement here - #analytics: UA-YOURCODE + #enter only True or False + signupBlocked: False Development: <<: *defaults