user signup can now be disabled

Handler/Signup.hs

@@ -8,55 +8,66 @@ import Data.Maybe
 
 getSignupR :: Handler Html
 getSignupR = do
---  (signupWidget, enctype) <- generateFormPost signupForm
+  block <- fmap extraSignupBlocked appExtra
-  defaultLayout $ do
+  case block of
-    setTitle "Eidolon :: Signup"
+    False -> do
-    $(widgetFile "signup")
+      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"
+  block <- fmap extraSignupBlocked appExtra
-  newUserName <- case validateLen (fromJust mUserName) of
+  case block of
-    True -> return $ fromJust $ mUserName
     False -> do
-      setMessage "Invalid username"
+      mUserName <- lookupPostParam "username"
-      redirect $ SignupR
+      newUserName <- case validateLen (fromJust mUserName) of
-  mEmail <- lookupPostParam "email"
+        True -> return $ fromJust $ mUserName
-  mTos1 <- lookupPostParam "tos-1"
+        False -> do
-  mTos2 <- lookupPostParam "tos-2"
+          setMessage "Invalid username"
-  case (mTos1, mTos2) of
+          redirect $ SignupR
-    (Just "tos-1", Just "tos-2") ->
+      mEmail <- lookupPostParam "email"
-      return ()
+      mTos1 <- lookupPostParam "tos-1"
-    _ -> do
+      mTos2 <- lookupPostParam "tos-2"
-      setMessage "You need to agree to our terms."
+      case (mTos1, mTos2) of
-      redirect $ SignupR
+        (Just "tos-1", Just "tos-2") ->
-  -- create user
+          return ()
-  namesakes <- runDB $ selectList [UserName ==. newUserName] []
+        _ -> do
-  case namesakes of
+          setMessage "You need to agree to our terms."
-    [] -> do
+          redirect $ SignupR
-      salt <- liftIO generateSalt
+      -- create user
-      newUser <- return $ User newUserName
+      namesakes <- runDB $ selectList [UserName ==. newUserName] []
-        newUserName
+      case namesakes of
-        (fromJust mEmail)
+        [] -> do
-        salt
+          salt <- liftIO generateSalt
-        ""
+          newUser <- return $ User newUserName
-        []
+            newUserName
-        False
+            (fromJust mEmail)
-      activatorText <- liftIO generateString
+            salt
-      aId <- runDB $ insert $ Activator activatorText newUser
+            ""
-      tId <- runDB $ insert $ Token (encodeUtf8 activatorText) "activate" Nothing
+            []
-      activateLink <- ($ ActivateR activatorText) <$> getUrlRender
+            False
-      sendMail (userEmail newUser) "Please activate your account!" $
+          activatorText <- liftIO generateString
-        [shamlet|
+          aId <- runDB $ insert $ Activator activatorText newUser
-          <h1>Hello #{userSlug newUser} and Welcome to Eidolon!
+          tId <- runDB $ insert $ Token (encodeUtf8 activatorText) "activate" Nothing
-          To complete your sgnup please activate your account by visiting the following link:
+          activateLink <- ($ ActivateR activatorText) <$> getUrlRender
-          <a href="#{activateLink}">#{activateLink}
+          sendMail (userEmail newUser) "Please activate your account!" $
-        |]
+            [shamlet|
-      setMessage "User pending activation"
+              <h1>Hello #{userSlug newUser} and Welcome to Eidolon!
+              To complete your sgnup please activate your account by visiting the following link:
+              <a href="#{activateLink}">#{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 =

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