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
Nothing -> do
return ("" :: Text)
block <- fmap extraSignupBlocked getExtra
-- We break up the default layout into two components:
-- default-layout is the contents of the body tag, and

View file

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

View file

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

View file

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