signup can now be blocked

This commit is contained in:
nek0 2014-12-14 20:22:50 +01:00
parent 914a572ac7
commit 69ab9059c2
4 changed files with 10 additions and 7 deletions

View file

@ -84,7 +84,7 @@ instance Yesod App where
return $ userSlug user return $ userSlug user
Nothing -> do Nothing -> do
return ("" :: Text) return ("" :: Text)
block <- fmap extraSignupBlocked getExtra
-- We break up the default layout into two components: -- We break up the default layout into two components:
-- default-layout is the contents of the body tag, and -- default-layout is the contents of the body tag, and

View file

@ -8,7 +8,7 @@ import Data.Maybe
getSignupR :: Handler Html getSignupR :: Handler Html
getSignupR = do getSignupR = do
block <- fmap extraSignupBlocked appExtra block <- fmap extraSignupBlocked I.getExtra
case block of case block of
False -> do False -> do
defaultLayout $ do defaultLayout $ do
@ -20,7 +20,7 @@ getSignupR = do
postSignupR :: Handler Html postSignupR :: Handler Html
postSignupR = do postSignupR = do
block <- fmap extraSignupBlocked appExtra block <- fmap I.extraSignupBlocked I.getExtra
case block of case block of
False -> do False -> do
mUserName <- lookupPostParam "username" mUserName <- lookupPostParam "username"

View file

@ -67,10 +67,12 @@ widgetFile = (if development then widgetFileReload
data Extra = Extra data Extra = Extra
{ extraCopyright :: Text { extraCopyright :: Text
, extraAnalytics :: Maybe Text -- ^ Google Analytics -- , extraAnalytics :: Maybe Text -- ^ Google Analytics
, extraSignupBlocked :: Bool
} deriving Show } deriving Show
parseExtra :: DefaultEnv -> Object -> Parser Extra parseExtra :: DefaultEnv -> Object -> Parser Extra
parseExtra _ o = Extra parseExtra _ o = Extra
<$> o .: "copyright" <$> o .: "copyright"
<*> o .:? "analytics" -- <*> o .:? "analytics"
<*> o .: "signupBlocked"

View file

@ -14,8 +14,9 @@
$nothing $nothing
<li> <li>
<a href=@{LoginR}>Login <a href=@{LoginR}>Login
<li> $if block == False
<a href=@{SignupR}>Signup <li>
<a href=@{SignupR}>Signup
$maybe msg <- mmsg $maybe msg <- mmsg