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| -