...
 
Commits (2)
......@@ -70,8 +70,9 @@ instance Yesod App where
defaultLayout widget = do
auth <- maybeAuth
let user = case auth of
Nothing -> Nothing
Just (Entity uid (User name _ _ _ _ _)) -> Just (uid, name)
Nothing -> Nothing
Just (Entity _ (User _ _ _ _ _ _ False)) -> Nothing
Just (Entity uid (User name _ _ _ _ _ _)) -> Just (uid, name)
pc <- widgetToPageContent widget
req <- waiRequest
mmessage <- getMessage
......@@ -158,7 +159,7 @@ instance YesodPersist App where
authenticateUser :: (YesodPersist site, YesodPersistBackend site ~ SqlBackend, AuthId master ~ Key User) => Text -> HandlerT site IO (AuthenticationResult master)
authenticateUser ident = runDB $ do
joined <- liftIO getCurrentTime
userid <- D.insertOrGet $ User "" ident Nothing Nothing False joined
userid <- D.insertOrGet $ User "" ident Nothing Nothing False joined True
return $ Authenticated userid
instance YesodAuth App where
......@@ -187,7 +188,7 @@ instance YesodAuthEmail App where
addUnverified email verkey = do
let name = takeWhile (/= '@') email -- use part of email before '@'
joined <- liftIO getCurrentTime
runDB $ insert $ User name email Nothing (Just verkey) False joined
runDB $ insert $ User name email Nothing (Just verkey) False joined True
sendVerifyEmail = E.sendVerifyEmail
getVerifyKey = runDB . fmap (join . fmap userVerkey) . get
......
......@@ -27,7 +27,7 @@ userForm user = renderDivs $ FormUser
getUserR :: Lang -> UserId -> Handler Html
getUserR lang userid = do
aid <- requireAuthId
(User name email _ _ active joined) <- runDB $ get404 userid
(User name email _ _ active joined _) <- runDB $ get404 userid
unless active $ permissionDenied ""
joinedTime <- formatRelativeTime joined
let jobsview = JobsView 0 20 [] [] [JobsWidgetFilterUser userid]
......
......@@ -6,6 +6,7 @@ User
verkey Text Maybe -- Used for resetting passwords
active Bool
joined UTCTime
enabled Bool default=TRUE -- is the account enabled
UniqueUser email
deriving Typeable
Group
......
#!/usr/bin/env bash
# This scripts starts a development version of the ODF Test Server
if [ ! -e static/bootstrap-3.3.6-dist ]; then
wget https://github.com/twbs/bootstrap/releases/download/v3.3.6/bootstrap-3.3.6-dist.zip
unzip -d static bootstrap-3.3.6-dist.zip
fi
docker build -t devserver docker/devserver
docker run -ti -p 3000:3000 -v `pwd`:/odfserver --rm devserver
......@@ -55,7 +55,7 @@ addTestAccount True pool = do
pwd = "user"
sp <- saltPass pwd
flip runSqlPool pool $ do
_ <- insertUnique $ User name uid (Just sp) Nothing True CT.epochTime
_ <- insertUnique $ User name uid (Just sp) Nothing True CT.epochTime True
return ()
createDatabase :: Pool SqlBackend -> IO Database
......