From: fr33domlover <fr33domlo...@rel4tion.org> --- config/routes | 68 ++++----- src/Handler/NewDesign.hs | 5 +- src/Handler/ResetPassphrase.hs | 3 +- src/Handler/User/Balance.hs | 28 ++-- src/Handler/User/ChangePassphrase.hs | 20 +-- src/Handler/User/Comment.hs | 234 ++++++++++++++++++------------- src/Handler/User/ConfirmDelete.hs | 23 +-- src/Handler/User/Delete.hs | 25 ++-- src/Handler/User/Discussion.hs | 23 ++- src/Handler/User/Edit.hs | 19 ++- src/Handler/User/EstEligible.hs | 8 +- src/Handler/User/NewDiscussion.hs | 16 +-- src/Handler/User/Notifications.hs | 21 ++- src/Handler/User/Pledges.hs | 10 +- src/Handler/User/ProjectNotifications.hs | 16 +-- src/Handler/User/ResetPassphrase.hs | 33 +++-- src/Handler/User/SelectProject.hs | 21 ++- src/Handler/User/Tickets.hs | 10 +- src/Handler/User/User.hs | 8 +- src/Handler/User/Utils.hs | 3 +- src/Handler/User/VerifyEmail.hs | 15 +- src/Model/Comment.hs | 4 +- src/Model/Comment/HandlerInfo.hs | 5 +- src/Model/Comment/Routes.hs | 34 ++--- src/Model/Markdown.hs | 4 +- src/View/SnowdriftEvent.hs | 4 +- src/View/User.hs | 3 +- src/Widgets/UserPledges.hs | 3 +- templates/change-passphrase.hamlet | 2 +- templates/dashboard/nav.hamlet | 2 +- templates/dashboard/notifications.hamlet | 4 +- templates/delete_user.hamlet | 2 +- templates/edit_user.hamlet | 2 +- templates/project_feed.hamlet | 4 +- templates/project_notifications.hamlet | 2 +- templates/set-passphrase.hamlet | 2 +- templates/user.hamlet | 25 ++-- templates/user_confirm_delete.hamlet | 2 +- templates/user_discuss.hamlet | 14 +- templates/user_discussion_wrapper.hamlet | 4 +- templates/user_notifications.hamlet | 2 +- templates/user_select_project.hamlet | 2 +- 42 files changed, 389 insertions(+), 346 deletions(-)
diff --git a/config/routes b/config/routes index 7118d51..1c9c934 100644 --- a/config/routes +++ b/config/routes @@ -113,20 +113,20 @@ -- User -/u UsersR GET -/u/#UserId/balance UserBalanceR GET POST -/u/#UserId/t UserTicketsR GET -/u/#UserId/change-passphrase UserChangePassphraseR GET POST -/u/#UserId/delete DeleteUserR GET POST -/u/#UserId/confirm-delete/#Text UserConfirmDeleteR GET POST -/u/#UserId/edit EditUserR GET POST -/u/#UserId/elig UserEstEligibleR POST -/u/#UserId/user-notifications UserNotificationsR GET POST -/u/#UserId/pledges UserPledgesR GET -/u/#UserId/project-notifications/#ProjectId ProjectNotificationsR GET POST -/u/#UserId/reset-passphrase/#Text UserResetPassphraseR GET POST -/u/#UserId/select-project UserSelectProjectR GET POST -/u/#UserId/verify-email/#Text UserVerifyEmailR GET +/u UsersR GET +/u/#UserHandle/balance UserBalanceR GET POST +/u/#UserHandle/t UserTicketsR GET +/u/#UserHandle/change-passphrase UserChangePassphraseR GET POST +/u/#UserHandle/delete DeleteUserR GET POST +/u/#UserHandle/confirm-delete/#Text UserConfirmDeleteR GET POST +/u/#UserHandle/edit EditUserR GET POST +/u/#UserHandle/elig UserEstEligibleR POST +/u/#UserHandle/user-notifications UserNotificationsR GET POST +/u/#UserHandle/pledges UserPledgesR GET +/u/#UserHandle/project-notifications/#ProjectId ProjectNotificationsR GET POST +/u/#UserHandle/reset-passphrase/#Text UserResetPassphraseR GET POST +/u/#UserHandle/select-project UserSelectProjectR GET POST +/u/#UserHandle/verify-email/#Text UserVerifyEmailR GET -- Notifications @@ -200,26 +200,26 @@ /c/#CommentId CommentDirectLinkR GET DELETE /c/#CommentId/tag/#TagId CommentTagR GET POST -/u/#UserId/d UserDiscussionR GET POST -/u/#UserId/d/new NewUserDiscussionR GET POST -/u/#UserId/c/#CommentId UserCommentR GET -/u/#UserId/c/#CommentId/claim ClaimUserCommentR GET POST -/u/#UserId/c/#CommentId/close CloseUserCommentR GET POST -/u/#UserId/c/#CommentId/delete DeleteUserCommentR GET POST -/u/#UserId/c/#CommentId/edit EditUserCommentR GET POST -/u/#UserId/c/#CommentId/flag FlagUserCommentR GET POST -/u/#UserId/c/#CommentId/approve ApproveUserCommentR GET POST -/u/#UserId/c/#CommentId/reply ReplyUserCommentR GET POST -/u/#UserId/c/#CommentId/rethread RethreadUserCommentR GET POST -/u/#UserId/c/#CommentId/retract RetractUserCommentR GET POST -/u/#UserId/c/#CommentId/tag/!new UserCommentAddTagR GET -/u/#UserId/c/#CommentId/tags UserCommentTagsR GET -/u/#UserId/c/#CommentId/tag/#TagId UserCommentTagR GET POST -/u/#UserId/c/#CommentId/tag/!apply UserCommentApplyTagR POST -/u/#UserId/c/#CommentId/tag/!create UserCommentCreateTagR POST -/u/#UserId/c/#CommentId/unclaim UnclaimUserCommentR GET POST -/u/#UserId/c/#CommentId/watch WatchUserCommentR GET POST -/u/#UserId/c/#CommentId/unwatch UnwatchUserCommentR GET POST +/u/#UserHandle/d UserDiscussionR GET POST +/u/#UserHandle/d/new NewUserDiscussionR GET POST +/u/#UserHandle/c/#CommentId UserCommentR GET +/u/#UserHandle/c/#CommentId/claim ClaimUserCommentR GET POST +/u/#UserHandle/c/#CommentId/close CloseUserCommentR GET POST +/u/#UserHandle/c/#CommentId/delete DeleteUserCommentR GET POST +/u/#UserHandle/c/#CommentId/edit EditUserCommentR GET POST +/u/#UserHandle/c/#CommentId/flag FlagUserCommentR GET POST +/u/#UserHandle/c/#CommentId/approve ApproveUserCommentR GET POST +/u/#UserHandle/c/#CommentId/reply ReplyUserCommentR GET POST +/u/#UserHandle/c/#CommentId/rethread RethreadUserCommentR GET POST +/u/#UserHandle/c/#CommentId/retract RetractUserCommentR GET POST +/u/#UserHandle/c/#CommentId/tag/!new UserCommentAddTagR GET +/u/#UserHandle/c/#CommentId/tags UserCommentTagsR GET +/u/#UserHandle/c/#CommentId/tag/#TagId UserCommentTagR GET POST +/u/#UserHandle/c/#CommentId/tag/!apply UserCommentApplyTagR POST +/u/#UserHandle/c/#CommentId/tag/!create UserCommentCreateTagR POST +/u/#UserHandle/c/#CommentId/unclaim UnclaimUserCommentR GET POST +/u/#UserHandle/c/#CommentId/watch WatchUserCommentR GET POST +/u/#UserHandle/c/#CommentId/unwatch UnwatchUserCommentR GET POST /p/#Text/d ProjectDiscussionR GET /p/#Text/d/new NewProjectDiscussionR GET POST diff --git a/src/Handler/NewDesign.hs b/src/Handler/NewDesign.hs index 24cc985..3289aae 100644 --- a/src/Handler/NewDesign.hs +++ b/src/Handler/NewDesign.hs @@ -77,7 +77,7 @@ projectNav handle = dashboardNav :: Widget dashboardNav = do - uid <- handlerToWidget requireAuthId + Entity uid user <- handlerToWidget requireAuth $(widgetFile "dashboard/nav") getHomeR, @@ -242,7 +242,8 @@ getUserByIdR user_id = do getUNotificationsR :: Handler Html getUNotificationsR = do showArchived <- lookupGetParam "state" - user_id <- requireAuthId + Entity user_id user <- requireAuth + let nick = userNick user notifs <- runDB $ do case showArchived of Just "archived" -> do diff --git a/src/Handler/ResetPassphrase.hs b/src/Handler/ResetPassphrase.hs index 54d0a6c..585e4cb 100644 --- a/src/Handler/ResetPassphrase.hs +++ b/src/Handler/ResetPassphrase.hs @@ -18,8 +18,9 @@ getResetPassphraseR = do initResetPassphrase :: UserId -> Text -> Handler Html initResetPassphrase user_id email = do + user <- runDB $ get404 user_id hash <- liftIO newHash - uri <- getUrlRender <*> pure (UserResetPassphraseR user_id hash) + uri <- getUrlRender <*> pure (UserResetPassphraseR (userNick user) hash) runDB $ insert_ $ ResetPassphrase user_id email uri False alertSuccess "Sent an email with further instructions." redirect HomeR diff --git a/src/Handler/User/Balance.hs b/src/Handler/User/Balance.hs index ebe9ef6..7eb03f6 100644 --- a/src/Handler/User/Balance.hs +++ b/src/Handler/User/Balance.hs @@ -13,16 +13,17 @@ import qualified Mechanism as Mech -- check permissions for user balance view -getUserBalanceR :: UserId -> Handler Html -getUserBalanceR user_id = do +getUserBalanceR :: UserHandle -> Handler Html +getUserBalanceR nick = do viewer_id <- requireAuthId + Entity user_id _ <- runDB $ getBy404 $ UniqueUserNick nick if viewer_id /= user_id then permissionDenied "You must be a site administrator to view user balances." - else getUserBalanceR' user_id + else getUserBalanceR' nick -getUserBalanceR' :: UserId -> Handler Html -getUserBalanceR' user_id = do - user <- runYDB $ get404 user_id +getUserBalanceR' :: UserHandle -> Handler Html +getUserBalanceR' nick = do + Entity user_id user <- runDB $ getBy404 $ UniqueUserNick nick -- TODO: restrict viewing balance to user or snowdrift admins (logged) -- before moving to real money @@ -30,7 +31,7 @@ getUserBalanceR' user_id = do -- (permissionDenied -- "You can only view your own account balance history.") - Just account <- runDB $ get $ userAccount user + account <- runDB $ get404 $ userAccount user offset' <- lookupParamDefault "offset" 0 limit' <- lookupParamDefault "count" 20 @@ -41,8 +42,7 @@ getUserBalanceR' user_id = do (add_funds_form, _) <- generateFormPost addTestCashForm defaultLayout $ do - snowdriftDashTitle "User Balance" $ - userDisplayName' (Entity user_id user) + snowdriftDashTitle "User Balance" $ userDisplayName user $(widgetFile "user_balance") where -- Warning: We can do better than 'read'. @@ -54,16 +54,16 @@ getUserBalanceR' user_id = do param <- listToMaybe $ reads $ T.unpack param_str return $ fst param -postUserBalanceR :: UserId -> Handler Html -postUserBalanceR user_id = do - Entity viewer_id _ <- requireAuth +postUserBalanceR :: UserHandle -> Handler Html +postUserBalanceR nick = do + viewer_id <- requireAuthId + Entity user_id user <- runDB $ getBy404 $ UniqueUserNick nick unless (user_id == viewer_id) $ permissionDenied "You can only add money to your own account." ((result, _), _) <- runFormPost addTestCashForm now <- liftIO getCurrentTime - user <- runYDB $ get404 user_id case result of FormSuccess amount -> do @@ -74,5 +74,5 @@ postUserBalanceR user_id = do either alertDanger (const (alertSuccess "Balance updated")) res - redirect (UserBalanceR user_id) + redirect $ UserBalanceR nick _ -> error "Error processing form." diff --git a/src/Handler/User/ChangePassphrase.hs b/src/Handler/User/ChangePassphrase.hs index cbab6c5..e45b80d 100644 --- a/src/Handler/User/ChangePassphrase.hs +++ b/src/Handler/User/ChangePassphrase.hs @@ -9,28 +9,28 @@ import Handler.User.Utils import Model.User import View.User -getUserChangePassphraseR :: UserId -> Handler Html -getUserChangePassphraseR user_id = do +getUserChangePassphraseR :: UserHandle -> Handler Html +getUserChangePassphraseR nick = do + Entity user_id user <- runDB $ getBy404 $ UniqueUserNick nick void $ checkEditUser user_id - user <- runYDB $ get404 user_id (form, enctype) <- generateFormPost changePassphraseForm defaultLayout $ do - snowdriftDashTitle "Change Passphrase" $ - userDisplayName' (Entity user_id user) + snowdriftDashTitle "Change Passphrase" $ userDisplayName user $(widgetFile "change-passphrase") -postUserChangePassphraseR :: UserId -> Handler Html -postUserChangePassphraseR user_id = do +postUserChangePassphraseR :: UserHandle -> Handler Html +postUserChangePassphraseR nick = do + Entity user_id user <- runDB $ getBy404 $ UniqueUserNick nick void $ checkEditUser user_id ((result, form), enctype) <- runFormPost changePassphraseForm case result of FormSuccess ChangePassphrase {..} -> do - user <- runYDB $ get404 user_id is_valid_passphrase <- validateUser (UniqueUser $ userIdent user) currentPassphrase if is_valid_passphrase - then resetPassphrase user_id user newPassphrase newPassphrase' $ - UserChangePassphraseR user_id + then + resetPassphrase user_id user newPassphrase newPassphrase' $ + UserChangePassphraseR nick else do alertDanger "Sorry, that is not the correct current passphrase." defaultLayout $(widgetFile "change-passphrase") diff --git a/src/Handler/User/Comment.hs b/src/Handler/User/Comment.hs index 5310bed..1b7acaf 100644 --- a/src/Handler/User/Comment.hs +++ b/src/Handler/User/Comment.hs @@ -97,8 +97,16 @@ makeUserCommentForestWidget -> Bool -> Widget -> Handler (Widget, Forest (Entity Comment)) -makeUserCommentForestWidget muser user_id comments = - makeCommentForestWidget (userCommentHandlerInfo muser user_id) comments muser +makeUserCommentForestWidget muser user_id comments mods max_depth is_preview form = do + user <- runDB $ get404 user_id + makeCommentForestWidget + (userCommentHandlerInfo muser user_id (userNick user)) + comments + muser + mods + max_depth + is_preview + form makeUserCommentTreeWidget :: Maybe (Entity User) @@ -121,11 +129,12 @@ makeUserCommentActionWidget -> MaxDepth -> Handler (Widget, Tree (Entity Comment)) makeUserCommentActionWidget make_comment_action_widget user_id comment_id mods max_depth = do - (user, comment) <- checkCommentUrlRequireAuth user_id comment_id + (viewer, comment) <- checkCommentUrlRequireAuth user_id comment_id + user <- runDB $ get404 user_id make_comment_action_widget (Entity comment_id comment) - user - (userCommentHandlerInfo (Just user) user_id) + viewer + (userCommentHandlerInfo (Just viewer) user_id (userNick user)) mods max_depth False @@ -133,14 +142,16 @@ makeUserCommentActionWidget make_comment_action_widget user_id comment_id mods m userDiscussionPage :: UserId -> Widget -> Widget userDiscussionPage user_id widget = do user <- handlerToWidget $ runDB $ get404 user_id + let nick = userNick user $(widgetFile "user_discussion_wrapper") toWidget $(cassiusFile "templates/comment.cassius") -------------------------------------------------------------------------------- -- / -getUserCommentR :: UserId -> CommentId -> Handler Html -getUserCommentR user_id comment_id = do +getUserCommentR :: UserHandle -> CommentId -> Handler Html +getUserCommentR nick comment_id = do + Entity user_id user <- runDB $ getBy404 $ UniqueUserNick nick (muser, comment) <- checkCommentUrl user_id comment_id maxDepth <- getMaxDepth (widget, _) <- @@ -160,13 +171,14 @@ getUserCommentR user_id comment_id = do runDB (userMaybeViewUserCommentsDB user_id (map entityKey (Tree.flatten comment_tree))) -} - defaultLayout (userDiscussionPage user_id widget) + defaultLayout $ userDiscussionPage user_id widget -------------------------------------------------------------------------------- -- /claim -getClaimUserCommentR :: UserId -> CommentId -> Handler Html -getClaimUserCommentR user_id comment_id = do +getClaimUserCommentR :: UserHandle -> CommentId -> Handler Html +getClaimUserCommentR nick comment_id = do + Entity user_id user <- runDB $ getBy404 $ UniqueUserNick nick (widget, _) <- makeUserCommentActionWidget makeClaimCommentWidget @@ -175,10 +187,11 @@ getClaimUserCommentR user_id comment_id = do def =<< getMaxDepth - defaultLayout (userDiscussionPage user_id widget) + defaultLayout $ userDiscussionPage user_id widget -postClaimUserCommentR :: UserId -> CommentId -> Handler Html -postClaimUserCommentR user_id comment_id = do +postClaimUserCommentR :: UserHandle -> CommentId -> Handler Html +postClaimUserCommentR nick comment_id = do + Entity user_id user <- runDB $ getBy404 $ UniqueUserNick nick (viewer, comment) <- checkCommentUrlRequireAuth user_id comment_id checkUserCommentActionPermission can_claim viewer user_id (Entity comment_id comment) @@ -186,16 +199,19 @@ postClaimUserCommentR user_id comment_id = do viewer comment_id comment - (userCommentHandlerInfo (Just viewer) user_id) + (userCommentHandlerInfo (Just viewer) user_id nick) >>= \case - Nothing -> redirect (UserCommentR user_id comment_id) - Just (widget, form) -> defaultLayout $ previewWidget form "claim" (userDiscussionPage user_id widget) + Nothing -> redirect $ UserCommentR nick comment_id + Just (widget, form) -> + defaultLayout $ + previewWidget form "claim" (userDiscussionPage user_id widget) -------------------------------------------------------------------------------- -- /approve -getApproveUserCommentR :: UserId -> CommentId -> Handler Html -getApproveUserCommentR user_id comment_id = do +getApproveUserCommentR :: UserHandle -> CommentId -> Handler Html +getApproveUserCommentR nick comment_id = do + Entity user_id user <- runDB $ getBy404 $ UniqueUserNick nick (widget, _) <- makeUserCommentActionWidget makeApproveCommentWidget @@ -205,19 +221,21 @@ getApproveUserCommentR user_id comment_id = do =<< getMaxDepth defaultLayout (userDiscussionPage user_id widget) -postApproveUserCommentR :: UserId -> CommentId -> Handler Html -postApproveUserCommentR user_id comment_id = do +postApproveUserCommentR :: UserHandle -> CommentId -> Handler Html +postApproveUserCommentR nick comment_id = do + Entity user_id user <- runDB $ getBy404 $ UniqueUserNick nick (viewer, comment) <- checkCommentUrlRequireAuth user_id comment_id checkUserCommentActionPermission can_approve viewer user_id (Entity comment_id comment) postApproveComment user_id comment_id comment - redirect (UserCommentR user_id comment_id) + redirect $ UserCommentR nick comment_id -------------------------------------------------------------------------------- -- /close -getCloseUserCommentR :: UserId -> CommentId -> Handler Html -getCloseUserCommentR user_id comment_id = do +getCloseUserCommentR :: UserHandle -> CommentId -> Handler Html +getCloseUserCommentR nick comment_id = do + Entity user_id user <- runDB $ getBy404 $ UniqueUserNick nick (widget, _) <- makeUserCommentActionWidget makeCloseCommentWidget @@ -227,8 +245,9 @@ getCloseUserCommentR user_id comment_id = do =<< getMaxDepth defaultLayout (userDiscussionPage user_id widget) -postCloseUserCommentR :: UserId -> CommentId -> Handler Html -postCloseUserCommentR user_id comment_id = do +postCloseUserCommentR :: UserHandle -> CommentId -> Handler Html +postCloseUserCommentR nick comment_id = do + Entity user_id user <- runDB $ getBy404 $ UniqueUserNick nick (viewer, comment) <- checkCommentUrlRequireAuth user_id comment_id checkUserCommentActionPermission can_close viewer user_id (Entity comment_id comment) @@ -236,16 +255,19 @@ postCloseUserCommentR user_id comment_id = do viewer comment_id comment - (userCommentHandlerInfo (Just viewer) user_id) + (userCommentHandlerInfo (Just viewer) user_id nick) >>= \case - Nothing -> redirect (UserCommentR user_id comment_id) - Just (widget, form) -> defaultLayout $ previewWidget form "close" (userDiscussionPage user_id widget) + Nothing -> redirect (UserCommentR nick comment_id) + Just (widget, form) -> + defaultLayout $ + previewWidget form "close" (userDiscussionPage user_id widget) -------------------------------------------------------------------------------- -- /delete -getDeleteUserCommentR :: UserId -> CommentId -> Handler Html -getDeleteUserCommentR user_id comment_id = do +getDeleteUserCommentR :: UserHandle -> CommentId -> Handler Html +getDeleteUserCommentR nick comment_id = do + Entity user_id user <- runDB $ getBy404 $ UniqueUserNick nick (widget, _) <- makeUserCommentActionWidget makeDeleteCommentWidget @@ -255,21 +277,23 @@ getDeleteUserCommentR user_id comment_id = do =<< getMaxDepth defaultLayout (userDiscussionPage user_id widget) -postDeleteUserCommentR :: UserId -> CommentId -> Handler Html -postDeleteUserCommentR user_id comment_id = do +postDeleteUserCommentR :: UserHandle -> CommentId -> Handler Html +postDeleteUserCommentR nick comment_id = do + Entity user_id user <- runDB $ getBy404 $ UniqueUserNick nick (viewer, comment) <- checkCommentUrlRequireAuth user_id comment_id checkUserCommentActionPermission can_delete viewer user_id (Entity comment_id comment) was_deleted <- postDeleteComment comment_id if was_deleted - then redirect (UserDiscussionR user_id) - else redirect (UserCommentR user_id comment_id) + then redirect $ UserDiscussionR nick + else redirect $ UserCommentR nick comment_id -------------------------------------------------------------------------------- -- /edit -getEditUserCommentR :: UserId -> CommentId -> Handler Html -getEditUserCommentR user_id comment_id = do +getEditUserCommentR :: UserHandle -> CommentId -> Handler Html +getEditUserCommentR nick comment_id = do + Entity user_id user <- runDB $ getBy404 $ UniqueUserNick nick (widget, _) <- makeUserCommentActionWidget makeEditCommentWidget @@ -279,24 +303,28 @@ getEditUserCommentR user_id comment_id = do =<< getMaxDepth defaultLayout (userDiscussionPage user_id widget) -postEditUserCommentR :: UserId -> CommentId -> Handler Html -postEditUserCommentR user_id comment_id = do +postEditUserCommentR :: UserHandle -> CommentId -> Handler Html +postEditUserCommentR nick comment_id = do + Entity user_id user <- runDB $ getBy404 $ UniqueUserNick nick (viewer, comment) <- checkCommentUrlRequireAuth user_id comment_id checkUserCommentActionPermission can_edit viewer user_id (Entity comment_id comment) postEditComment viewer (Entity comment_id comment) - (userCommentHandlerInfo (Just viewer) user_id) + (userCommentHandlerInfo (Just viewer) user_id nick) >>= \case - Nothing -> redirect (UserCommentR user_id comment_id) -- Edit made. - Just (widget, form) -> defaultLayout $ previewWidget form "post" (userDiscussionPage user_id widget) + Nothing -> redirect (UserCommentR nick comment_id) -- Edit made. + Just (widget, form) -> + defaultLayout $ + previewWidget form "post" (userDiscussionPage user_id widget) -------------------------------------------------------------------------------- -- /flag -getFlagUserCommentR :: UserId -> CommentId -> Handler Html -getFlagUserCommentR user_id comment_id = do +getFlagUserCommentR :: UserHandle -> CommentId -> Handler Html +getFlagUserCommentR nick comment_id = do + Entity user_id user <- runDB $ getBy404 $ UniqueUserNick nick (widget, _) <- makeUserCommentActionWidget makeFlagCommentWidget @@ -306,24 +334,28 @@ getFlagUserCommentR user_id comment_id = do =<< getMaxDepth defaultLayout (userDiscussionPage user_id widget) -postFlagUserCommentR :: UserId -> CommentId -> Handler Html -postFlagUserCommentR user_id comment_id = do +postFlagUserCommentR :: UserHandle -> CommentId -> Handler Html +postFlagUserCommentR nick comment_id = do + Entity user_id user <- runDB $ getBy404 $ UniqueUserNick nick (viewer, comment) <- checkCommentUrlRequireAuth user_id comment_id checkUserCommentActionPermission can_flag viewer user_id (Entity comment_id comment) postFlagComment viewer (Entity comment_id comment) - (userCommentHandlerInfo (Just viewer) user_id) + (userCommentHandlerInfo (Just viewer) user_id nick) >>= \case - Nothing -> redirect (UserDiscussionR user_id) - Just (widget, form) -> defaultLayout $ previewWidget form "flag" (userDiscussionPage user_id widget) + Nothing -> redirect $ UserDiscussionR nick + Just (widget, form) -> + defaultLayout $ + previewWidget form "flag" (userDiscussionPage user_id widget) -------------------------------------------------------------------------------- -- /reply -getReplyUserCommentR :: UserId -> CommentId -> Handler Html -getReplyUserCommentR user_id comment_id = do +getReplyUserCommentR :: UserHandle -> CommentId -> Handler Html +getReplyUserCommentR nick comment_id = do + Entity user_id user <- runDB $ getBy404 $ UniqueUserNick nick (widget, _) <- makeUserCommentActionWidget makeReplyCommentWidget @@ -333,13 +365,12 @@ getReplyUserCommentR user_id comment_id = do =<< getMaxDepth defaultLayout (userDiscussionPage user_id widget) -postReplyUserCommentR :: UserId -> CommentId -> Handler Html -postReplyUserCommentR user_id parent_id = do +postReplyUserCommentR :: UserHandle -> CommentId -> Handler Html +postReplyUserCommentR nick parent_id = do + Entity user_id user <- runDB $ getBy404 $ UniqueUserNick nick (viewer, parent) <- checkCommentUrlRequireAuth user_id parent_id checkUserCommentActionPermission can_reply viewer user_id (Entity parent_id parent) - user <- runYDB $ get404 user_id - postNewComment (Just parent_id) viewer @@ -347,9 +378,9 @@ postReplyUserCommentR user_id parent_id = do (makeUserCommentActionPermissionsMap (Just viewer) user_id def) >>= \case ConfirmedPost (Left err) -> do alertDanger err - redirect $ ReplyUserCommentR user_id parent_id + redirect $ ReplyUserCommentR nick parent_id ConfirmedPost (Right _) -> - redirect $ UserCommentR user_id parent_id + redirect $ UserCommentR nick parent_id Preview (widget, form) -> defaultLayout $ previewWidget form "post" $ userDiscussionPage user_id widget @@ -357,8 +388,9 @@ postReplyUserCommentR user_id parent_id = do -------------------------------------------------------------------------------- -- /rethread -getRethreadUserCommentR :: UserId -> CommentId -> Handler Html -getRethreadUserCommentR user_id comment_id = do +getRethreadUserCommentR :: UserHandle -> CommentId -> Handler Html +getRethreadUserCommentR nick comment_id = do + Entity user_id user <- runDB $ getBy404 $ UniqueUserNick nick (widget, _) <- makeUserCommentActionWidget makeRethreadCommentWidget @@ -368,8 +400,9 @@ getRethreadUserCommentR user_id comment_id = do =<< getMaxDepth defaultLayout (userDiscussionPage user_id widget) -postRethreadUserCommentR :: UserId -> CommentId -> Handler Html -postRethreadUserCommentR user_id comment_id = do +postRethreadUserCommentR :: UserHandle -> CommentId -> Handler Html +postRethreadUserCommentR nick comment_id = do + Entity user_id user <- runDB $ getBy404 $ UniqueUserNick nick (viewer, comment) <- checkCommentUrlRequireAuth user_id comment_id checkUserCommentActionPermission can_rethread viewer user_id (Entity comment_id comment) postRethreadComment user_id comment_id comment @@ -377,8 +410,9 @@ postRethreadUserCommentR user_id comment_id = do -------------------------------------------------------------------------------- -- /retract -getRetractUserCommentR :: UserId -> CommentId -> Handler Html -getRetractUserCommentR user_id comment_id = do +getRetractUserCommentR :: UserHandle -> CommentId -> Handler Html +getRetractUserCommentR nick comment_id = do + Entity user_id user <- runDB $ getBy404 $ UniqueUserNick nick (widget, _) <- makeUserCommentActionWidget makeRetractCommentWidget @@ -388,8 +422,9 @@ getRetractUserCommentR user_id comment_id = do =<< getMaxDepth defaultLayout (userDiscussionPage user_id widget) -postRetractUserCommentR :: UserId -> CommentId -> Handler Html -postRetractUserCommentR user_id comment_id = do +postRetractUserCommentR :: UserHandle -> CommentId -> Handler Html +postRetractUserCommentR nick comment_id = do + Entity user_id user <- runDB $ getBy404 $ UniqueUserNick nick (viewer, comment) <- checkCommentUrlRequireAuth user_id comment_id checkUserCommentActionPermission can_retract viewer user_id (Entity comment_id comment) @@ -397,43 +432,47 @@ postRetractUserCommentR user_id comment_id = do viewer comment_id comment - (userCommentHandlerInfo (Just viewer) user_id) + (userCommentHandlerInfo (Just viewer) user_id nick) >>= \case - Nothing -> redirect (UserCommentR user_id comment_id) - Just (widget, form) -> defaultLayout $ previewWidget form "retract" (userDiscussionPage user_id widget) + Nothing -> redirect $ UserCommentR nick comment_id + Just (widget, form) -> + defaultLayout $ + previewWidget form "retract" (userDiscussionPage user_id widget) -------------------------------------------------------------------------------- -- /tags -getUserCommentTagsR :: UserId -> CommentId -> Handler Html +getUserCommentTagsR :: UserHandle -> CommentId -> Handler Html getUserCommentTagsR _ = getCommentTags -------------------------------------------------------------------------------- -- /tag/#TagId -getUserCommentTagR :: UserId -> CommentId -> TagId -> Handler Html +getUserCommentTagR :: UserHandle -> CommentId -> TagId -> Handler Html getUserCommentTagR _ = getCommentTagR -postUserCommentTagR :: UserId -> CommentId -> TagId -> Handler () +postUserCommentTagR :: UserHandle -> CommentId -> TagId -> Handler () postUserCommentTagR _ = postCommentTagR -------------------------------------------------------------------------------- -- /tag/apply, /tag/create -postUserCommentApplyTagR, postUserCommentCreateTagR :: UserId -> CommentId -> Handler Html +postUserCommentApplyTagR, postUserCommentCreateTagR :: UserHandle -> CommentId -> Handler Html postUserCommentApplyTagR = applyOrCreate postCommentApplyTag postUserCommentCreateTagR = applyOrCreate postCommentCreateTag -applyOrCreate :: (CommentId -> Handler ()) -> UserId -> CommentId -> Handler Html -applyOrCreate action user_id comment_id = do +applyOrCreate + :: (CommentId -> Handler ()) -> UserHandle -> CommentId -> Handler Html +applyOrCreate action nick comment_id = do action comment_id - redirect (UserCommentR user_id comment_id) + redirect $ UserCommentR nick comment_id -------------------------------------------------------------------------------- -- /tag/new -getUserCommentAddTagR :: UserId -> CommentId -> Handler Html -getUserCommentAddTagR user_id comment_id = do +getUserCommentAddTagR :: UserHandle -> CommentId -> Handler Html +getUserCommentAddTagR nick comment_id = do + Entity user_id user <- runDB $ getBy404 $ UniqueUserNick nick (viewer, comment) <- checkCommentUrlRequireAuth user_id comment_id checkUserCommentActionPermission can_add_tag viewer user_id (Entity comment_id comment) getUserCommentAddTag comment_id user_id @@ -442,8 +481,9 @@ getUserCommentAddTagR user_id comment_id = do -------------------------------------------------------------------------------- -- /unclaim -getUnclaimUserCommentR :: UserId -> CommentId -> Handler Html -getUnclaimUserCommentR user_id comment_id = do +getUnclaimUserCommentR :: UserHandle -> CommentId -> Handler Html +getUnclaimUserCommentR nick comment_id = do + Entity user_id user <- runDB $ getBy404 $ UniqueUserNick nick (widget, _) <- makeUserCommentActionWidget makeUnclaimCommentWidget @@ -454,8 +494,9 @@ getUnclaimUserCommentR user_id comment_id = do defaultLayout (userDiscussionPage user_id widget) -postUnclaimUserCommentR :: UserId -> CommentId -> Handler Html -postUnclaimUserCommentR user_id comment_id = do +postUnclaimUserCommentR :: UserHandle -> CommentId -> Handler Html +postUnclaimUserCommentR nick comment_id = do + Entity user_id user <- runDB $ getBy404 $ UniqueUserNick nick (viewer, comment) <- checkCommentUrlRequireAuth user_id comment_id checkUserCommentActionPermission can_unclaim viewer user_id (Entity comment_id comment) @@ -463,17 +504,20 @@ postUnclaimUserCommentR user_id comment_id = do viewer comment_id comment - (userCommentHandlerInfo (Just viewer) user_id) + (userCommentHandlerInfo (Just viewer) user_id nick) >>= \case - Nothing -> redirect (UserCommentR user_id comment_id) - Just (widget, form) -> defaultLayout $ previewWidget form "unclaim" (userDiscussionPage user_id widget) + Nothing -> redirect $ UserCommentR nick comment_id + Just (widget, form) -> + defaultLayout $ + previewWidget form "unclaim" (userDiscussionPage user_id widget) -------------------------------------------------------------------------------- -- /watch -getWatchUserCommentR :: UserId -> CommentId -> Handler Html -getWatchUserCommentR user_id comment_id = do +getWatchUserCommentR :: UserHandle -> CommentId -> Handler Html +getWatchUserCommentR nick comment_id = do + Entity user_id user <- runDB $ getBy404 $ UniqueUserNick nick (widget, _) <- makeUserCommentActionWidget makeWatchCommentWidget @@ -484,20 +528,22 @@ getWatchUserCommentR user_id comment_id = do defaultLayout (userDiscussionPage user_id widget) -postWatchUserCommentR :: UserId -> CommentId -> Handler Html -postWatchUserCommentR user_id comment_id = do +postWatchUserCommentR :: UserHandle -> CommentId -> Handler Html +postWatchUserCommentR nick comment_id = do + Entity user_id user <- runDB $ getBy404 $ UniqueUserNick nick (viewer@(Entity viewer_id _), comment) <- checkCommentUrlRequireAuth user_id comment_id checkUserCommentActionPermission can_watch viewer user_id (Entity comment_id comment) postWatchComment viewer_id comment_id - redirect (UserCommentR user_id comment_id) + redirect $ UserCommentR nick comment_id -------------------------------------------------------------------------------- -- /unwatch -getUnwatchUserCommentR :: UserId -> CommentId -> Handler Html -getUnwatchUserCommentR user_id comment_id = do +getUnwatchUserCommentR :: UserHandle -> CommentId -> Handler Html +getUnwatchUserCommentR nick comment_id = do + Entity user_id user <- runDB $ getBy404 $ UniqueUserNick nick (widget, _) <- makeUserCommentActionWidget makeUnwatchCommentWidget @@ -508,12 +554,12 @@ getUnwatchUserCommentR user_id comment_id = do defaultLayout (userDiscussionPage user_id widget) -postUnwatchUserCommentR :: UserId -> CommentId -> Handler Html -postUnwatchUserCommentR user_id comment_id = do +postUnwatchUserCommentR :: UserHandle -> CommentId -> Handler Html +postUnwatchUserCommentR nick comment_id = do + Entity user_id user <- runDB $ getBy404 $ UniqueUserNick nick (viewer@(Entity viewer_id _), comment) <- checkCommentUrlRequireAuth user_id comment_id checkUserCommentActionPermission can_unwatch viewer user_id (Entity comment_id comment) postUnwatchComment viewer_id comment_id - redirect (UserCommentR user_id comment_id) - + redirect $ UserCommentR nick comment_id diff --git a/src/Handler/User/ConfirmDelete.hs b/src/Handler/User/ConfirmDelete.hs index 5a31c08..eaef0e4 100644 --- a/src/Handler/User/ConfirmDelete.hs +++ b/src/Handler/User/ConfirmDelete.hs @@ -7,9 +7,9 @@ import Handler.User.Utils (checkEditUser) import Model.User -checkConfirmDelete :: UserId -> Text -> Handler User -checkConfirmDelete user_id hash = do - confirm_uri <- getUrlRender <*> pure (UserConfirmDeleteR user_id hash) +checkConfirmDelete :: UserId -> UserHandle -> Text -> Handler User +checkConfirmDelete user_id nick hash = do + confirm_uri <- getUrlRender <*> pure (UserConfirmDeleteR nick hash) muser_email <- runDB $ fetchUserEmail user_id case muser_email of Nothing -> notFound @@ -18,19 +18,20 @@ checkConfirmDelete user_id hash = do void $ getBy404 $ UniqueDeleteConfirmation user_id email confirm_uri get404 user_id -getUserConfirmDeleteR :: UserId -> Text -> Handler Html -getUserConfirmDeleteR user_id hash = do +getUserConfirmDeleteR :: UserHandle -> Text -> Handler Html +getUserConfirmDeleteR nick hash = do + Entity user_id _ <- runDB $ getBy404 $ UniqueUserNick nick void $ checkEditUser user_id - user <- checkConfirmDelete user_id hash + user <- checkConfirmDelete user_id nick hash defaultLayout $ do - snowdriftDashTitle "Delete Account" $ - userDisplayName' (Entity user_id user) + snowdriftDashTitle "Delete Account" $ userDisplayName user $(widgetFile "user_confirm_delete") -postUserConfirmDeleteR :: UserId -> Text -> Handler Html -postUserConfirmDeleteR user_id hash = do +postUserConfirmDeleteR :: UserHandle -> Text -> Handler Html +postUserConfirmDeleteR nick hash = do + Entity user_id _ <- runDB $ getBy404 $ UniqueUserNick nick void $ checkEditUser user_id - void $ checkConfirmDelete user_id hash + void $ checkConfirmDelete user_id nick hash runDB $ deleteUserDB user_id alertSuccess "Successfully deleted your account." redirect HomeR diff --git a/src/Handler/User/Delete.hs b/src/Handler/User/Delete.hs index a083789..9b740a8 100644 --- a/src/Handler/User/Delete.hs +++ b/src/Handler/User/Delete.hs @@ -9,30 +9,31 @@ import Model.User startDeleteConfirmation :: UserId -> Handler () startDeleteConfirmation user_id = do hash <- liftIO newHash - confirm_uri <- getUrlRender <*> (pure $ UserConfirmDeleteR user_id hash) + user <- runDB $ get404 user_id + let nick = userNick user + confirm_uri <- getUrlRender <*> (pure $ UserConfirmDeleteR nick hash) muser_email <- runDB $ fetchUserEmailVerified user_id case muser_email of Nothing -> alertDanger $ - "Cannot continue without a verified email address. " <> - "Please add one to your profile and verify it." + "Cannot continue without a verified email address. \ + \Please add one to your profile and verify it." Just user_email -> do runDB $ insert_ $ DeleteConfirmation user_id user_email confirm_uri False alertSuccess $ "Confirmation email has been sent to " <> user_email <> "." -getDeleteUserR :: UserId -> Handler Html -getDeleteUserR user_id = do +getDeleteUserR :: UserHandle -> Handler Html +getDeleteUserR nick = do + Entity user_id user <- runDB $ getBy404 $ UniqueUserNick nick void $ checkEditUser user_id - user <- runYDB $ get404 user_id defaultLayout $ do - snowdriftDashTitle "Delete Account" $ - userDisplayName' (Entity user_id user) + snowdriftDashTitle "Delete Account" $ userDisplayName user $(widgetFile "delete_user") -postDeleteUserR :: UserId -> Handler Html -postDeleteUserR user_id = do - user <- runDB $ get404 user_id +postDeleteUserR :: UserHandle -> Handler Html +postDeleteUserR nick = do + Entity user_id _ <- runDB $ getBy404 $ UniqueUserNick nick void $ checkEditUser user_id startDeleteConfirmation user_id - redirect $ UserR $ userNick user + redirect $ UserR nick diff --git a/src/Handler/User/Discussion.hs b/src/Handler/User/Discussion.hs index 6c91042..2b10438 100644 --- a/src/Handler/User/Discussion.hs +++ b/src/Handler/User/Discussion.hs @@ -14,25 +14,25 @@ import Model.User import View.Comment -- | generates the associated discussion page for each user -getUserDiscussionR :: UserId -> Handler Html -getUserDiscussionR user_id = do +getUserDiscussionR :: UserHandle -> Handler Html +getUserDiscussionR nick = do closedView <- lookupGetParam "state" - getDiscussion closedView (getUserDiscussion user_id closedView) + Entity user_id user <- runDB $ getBy404 $ UniqueUserNick nick + getDiscussion closedView (getUserDiscussion user_id user closedView) getUserDiscussion :: UserId + -> User -> Maybe Text -> (DiscussionId -> ExprCommentCond -> DB [Entity Comment]) -- ^ Root comment getter. -> Handler Html -getUserDiscussion user_id closedView get_root_comments = do +getUserDiscussion user_id user closedView get_root_comments = do mviewer <- maybeAuth let mviewer_id = entityKey <$> mviewer - (user, root_comments) <- runYDB $ do - user <- get404 user_id + root_comments <- runYDB $ do let has_permission = exprCommentUserPermissionFilter mviewer_id (val user_id) - root_comments <- get_root_comments (userDiscussion user) has_permission - return (user, root_comments) + get_root_comments (userDiscussion user) has_permission maxDepth <- getMaxDepth (comment_forest_no_css, _) <- @@ -53,10 +53,9 @@ getUserDiscussion user_id closedView get_root_comments = do (comment_form, _) <- generateFormPost commentNewTopicForm defaultLayout $ do - snowdriftTitle $ - userDisplayName' (Entity user_id user) <> - " User Discussion" + snowdriftTitle $ userDisplayName user <> " User Discussion" + let nick = userNick user $(widgetFile "user_discuss") -postUserDiscussionR :: UserId -> Handler Html +postUserDiscussionR :: UserHandle -> Handler Html postUserDiscussionR _ = error "TODO(mitchell)" diff --git a/src/Handler/User/Edit.hs b/src/Handler/User/Edit.hs index 9936600..b959ae6 100644 --- a/src/Handler/User/Edit.hs +++ b/src/Handler/User/Edit.hs @@ -14,19 +14,19 @@ import Widgets.Preview -- /#UserId/edit -getEditUserR :: UserId -> Handler Html -getEditUserR user_id = do +getEditUserR :: UserHandle -> Handler Html +getEditUserR nick = do + Entity user_id user <- runDB $ getBy404 $ UniqueUserNick nick _ <- checkEditUser user_id - user <- runYDB (get404 user_id) (form, enctype) <- generateFormPost $ editUserForm (Just user) defaultLayoutNew "edit-user" $ do - snowdriftDashTitle "User Profile" $ - userDisplayName' (Entity user_id user) + snowdriftDashTitle "User Profile" $ userDisplayName user $(widgetFile "edit_user") -postEditUserR :: UserId -> Handler Html -postEditUserR user_id = do +postEditUserR :: UserHandle -> Handler Html +postEditUserR nick = do + Entity user_id user <- runDB $ getBy404 $ UniqueUserNick nick viewer_id <- checkEditUser user_id ((result, _), _) <- runFormPost $ editUserForm Nothing @@ -45,8 +45,6 @@ postEditUserR user_id = do redirect $ UserR $ userUpdateNick user_update _ -> do - user <- runYDB $ get404 user_id - let updated_user = updateUserPreview user_update user (form, _) <- generateFormPost $ editUserForm (Just updated_user) @@ -56,6 +54,5 @@ postEditUserR user_id = do previewWidget form "update" $ renderUser (Just viewer_id) user_id updated_user mempty _ -> do - user <- runYDB $ get404 user_id alertDanger "Failed to update user." - redirect $ UserR $ userNick user + redirect $ UserR nick diff --git a/src/Handler/User/EstEligible.hs b/src/Handler/User/EstEligible.hs index 6e702de..6ea041b 100644 --- a/src/Handler/User/EstEligible.hs +++ b/src/Handler/User/EstEligible.hs @@ -7,8 +7,9 @@ import View.User -- /#UserId/elig -postUserEstEligibleR :: UserId -> Handler Html -postUserEstEligibleR user_id = do +postUserEstEligibleR :: UserHandle -> Handler Html +postUserEstEligibleR nick = do + Entity user_id user <- runDB $ getBy404 $ UniqueUserNick nick establisher_id <- requireAuthId ok <- canMakeEligible user_id establisher_id @@ -17,8 +18,7 @@ postUserEstEligibleR user_id = do ((result, _), _) <- runFormPost establishUserForm case result of - FormSuccess reason -> do - user <- runYDB (get404 user_id) + FormSuccess reason -> case userEstablished user of EstUnestablished -> do honor_pledge <- getUrlRender >>= \r -> return $ r HonorPledgeR diff --git a/src/Handler/User/NewDiscussion.hs b/src/Handler/User/NewDiscussion.hs index 5f4278d..0ef1999 100644 --- a/src/Handler/User/NewDiscussion.hs +++ b/src/Handler/User/NewDiscussion.hs @@ -10,17 +10,17 @@ import Model.Comment.ActionPermissions import View.Comment import Widgets.Preview -getNewUserDiscussionR :: UserId -> Handler Html -getNewUserDiscussionR user_id = do +getNewUserDiscussionR :: UserHandle -> Handler Html +getNewUserDiscussionR nick = do void requireAuth let widget = commentNewTopicFormWidget - user <- runDB $ get404 user_id + Entity user_id user <- runDB $ getBy404 $ UniqueUserNick nick defaultLayout $(widgetFile "user_discussion_wrapper") -postNewUserDiscussionR :: UserId -> Handler Html -postNewUserDiscussionR user_id = do +postNewUserDiscussionR :: UserHandle -> Handler Html +postNewUserDiscussionR nick = do viewer <- requireAuth - User{..} <- runYDB $ get404 user_id + Entity user_id User{..} <- runDB $ getBy404 $ UniqueUserNick nick postNewComment Nothing @@ -29,9 +29,9 @@ postNewUserDiscussionR user_id = do (makeUserCommentActionPermissionsMap (Just viewer) user_id Default.def) >>= \case ConfirmedPost (Left err) -> do alertDanger err - redirect $ NewUserDiscussionR user_id + redirect $ NewUserDiscussionR nick ConfirmedPost (Right comment_id) -> - redirect $ UserCommentR user_id comment_id + redirect $ UserCommentR nick comment_id Com.Preview (widget, form) -> defaultLayout $ previewWidget form "post" $ userDiscussionPage user_id widget diff --git a/src/Handler/User/Notifications.hs b/src/Handler/User/Notifications.hs index f7fc63e..5cc7137 100644 --- a/src/Handler/User/Notifications.hs +++ b/src/Handler/User/Notifications.hs @@ -9,10 +9,10 @@ import View.User -- /#UserId/user-notifications -getUserNotificationsR :: UserId -> Handler Html -getUserNotificationsR user_id = do +getUserNotificationsR :: UserHandle -> Handler Html +getUserNotificationsR nick = do + Entity user_id user <- runDB $ getBy404 $ UniqueUserNick nick void $ checkEditUser user_id - user <- runYDB $ get404 user_id let fetchNotifPref = runYDB . fetchUserNotificationPrefDB user_id mbal <- fetchNotifPref NotifBalanceLow mucom <- fetchNotifPref NotifUnapprovedComment @@ -26,12 +26,12 @@ getUserNotificationsR user_id = do userNotificationsForm is_moderator mbal mucom mrcom mrep mecon mflag mflagr defaultLayout $ do - snowdriftDashTitle "Notification Preferences" $ - userDisplayName' (Entity user_id user) + snowdriftDashTitle "Notification Preferences" $ userDisplayName user $(widgetFile "user_notifications") -postUserNotificationsR :: UserId -> Handler Html -postUserNotificationsR user_id = do +postUserNotificationsR :: UserHandle -> Handler Html +postUserNotificationsR nick = do + Entity user_id user <- runDB $ getBy404 $ UniqueUserNick nick void $ checkEditUser user_id is_moderator <- runDB $ userIsModerator user_id ((result, form), enctype) <- runFormPost $ @@ -42,9 +42,8 @@ postUserNotificationsR user_id = do forM_ (userNotificationPref notif_pref) $ \(ntype, ndeliv) -> runDB $ updateUserNotificationPrefDB user_id ntype ndeliv alertSuccess "Successfully updated the notification preferences." - user <- runDB $ get404 user_id - redirect $ UserR $ userNick user + redirect $ UserR nick _ -> do - alertDanger $ "Failed to update the notification preferences. " - <> "Please try again." + alertDanger $ "Failed to update the notification preferences. \ + \Please try again." defaultLayout $(widgetFile "user_notifications") diff --git a/src/Handler/User/Pledges.hs b/src/Handler/User/Pledges.hs index 8f6e24f..2713dc3 100644 --- a/src/Handler/User/Pledges.hs +++ b/src/Handler/User/Pledges.hs @@ -8,14 +8,12 @@ import Widgets.UserPledges -- /#UserId/pledges -getUserPledgesR :: UserId -> Handler Html -getUserPledgesR user_id = do +getUserPledgesR :: UserHandle -> Handler Html +getUserPledgesR nick = do -- TODO: refine permissions here _ <- requireAuthId - user <- runYDB $ get404 user_id + Entity user_id user <- runDB $ getBy404 $ UniqueUserNick nick defaultLayout $ do - snowdriftDashTitle "User Pledges" $ - userDisplayName' (Entity user_id user) - + snowdriftDashTitle "User Pledges" $ userDisplayName user $(widgetFile "user_pledges") diff --git a/src/Handler/User/ProjectNotifications.hs b/src/Handler/User/ProjectNotifications.hs index 1c78b05..93d4c89 100644 --- a/src/Handler/User/ProjectNotifications.hs +++ b/src/Handler/User/ProjectNotifications.hs @@ -9,10 +9,10 @@ import View.User -- /#UserId/project-notifications -getProjectNotificationsR :: UserId -> ProjectId -> Handler Html -getProjectNotificationsR user_id project_id = do +getProjectNotificationsR :: UserHandle -> ProjectId -> Handler Html +getProjectNotificationsR nick project_id = do + Entity user_id user <- runDB $ getBy404 $ UniqueUserNick nick void $ checkEditUser user_id - user <- runYDB $ get404 user_id project <- runYDB $ get404 project_id let fetchNotifPref = runYDB . fetchProjectNotificationPrefDB user_id project_id @@ -31,11 +31,12 @@ getProjectNotificationsR user_id project_id = do defaultLayout $ do snowdriftDashTitle ("Notification Preferences for " <> projectName project) - (userDisplayName' $ Entity user_id user) + (userDisplayName user) $(widgetFile "project_notifications") -postProjectNotificationsR :: UserId -> ProjectId -> Handler Html -postProjectNotificationsR user_id project_id = do +postProjectNotificationsR :: UserHandle -> ProjectId -> Handler Html +postProjectNotificationsR nick project_id = do + Entity user_id user <- runDB $ getBy404 $ UniqueUserNick nick void $ checkEditUser user_id is_team_member <- runDB (userIsProjectTeamMemberDB user_id project_id) ((result, form), enctype) <- runFormPost $ @@ -47,8 +48,7 @@ postProjectNotificationsR user_id project_id = do runDB $ updateProjectNotificationPrefDB user_id project_id ntype ndeliv alertSuccess "Successfully updated the notification preferences." - user <- runDB $ get404 user_id - redirect $ UserR $ userNick user + redirect $ UserR nick _ -> do project <- runYDB $ get404 project_id alertDanger "Failed to update the notification preferences." diff --git a/src/Handler/User/ResetPassphrase.hs b/src/Handler/User/ResetPassphrase.hs index e25e738..076be5e 100644 --- a/src/Handler/User/ResetPassphrase.hs +++ b/src/Handler/User/ResetPassphrase.hs @@ -8,35 +8,34 @@ import Model.User import View.User -- /#UserId/reset-passphrase/#Text -checkResetPassphrase :: UserId -> Text -> Handler User -checkResetPassphrase user_id hash = do - uri <- getUrlRender <*> pure (UserResetPassphraseR user_id hash) +checkResetPassphrase :: UserHandle -> Text -> Handler (UserId, User) +checkResetPassphrase nick hash = do + Entity user_id user <- runDB $ getBy404 $ UniqueUserNick nick + uri <- getUrlRender <*> pure (UserResetPassphraseR nick hash) memail <- runDB $ fetchUserEmail user_id case memail of Nothing -> notFound - Just email -> - runYDB $ do - -- Check whether the hash is in the DB. - void $ getBy404 $ UniquePassphraseReset user_id email uri - get404 user_id + Just email -> do + -- Check whether the hash is in the DB. + runYDB $ void $ getBy404 $ UniquePassphraseReset user_id email uri + return (user_id, user) -getUserResetPassphraseR :: UserId -> Text -> Handler Html -getUserResetPassphraseR user_id hash = do - user <- checkResetPassphrase user_id hash +getUserResetPassphraseR :: UserHandle -> Text -> Handler Html +getUserResetPassphraseR nick hash = do + (user_id, user) <- checkResetPassphrase nick hash (form, enctype) <- generateFormPost setPassphraseForm defaultLayout $ do - snowdriftDashTitle "Set Passphrase" $ - userDisplayName' (Entity user_id user) + snowdriftDashTitle "Set Passphrase" $ userDisplayName user $(widgetFile "set-passphrase") -postUserResetPassphraseR :: UserId -> Text -> Handler Html -postUserResetPassphraseR user_id hash = do - user <- checkResetPassphrase user_id hash +postUserResetPassphraseR :: UserHandle -> Text -> Handler Html +postUserResetPassphraseR nick hash = do + (user_id, user) <- checkResetPassphrase nick hash ((result, form), enctype) <- runFormPost setPassphraseForm case result of FormSuccess SetPassphrase {..} -> resetPassphrase user_id user passphrase passphrase' $ - UserResetPassphraseR user_id hash + UserResetPassphraseR nick hash _ -> do alertDanger "Oops, failed to set the passphrase." defaultLayout $(widgetFile "set-passphrase") diff --git a/src/Handler/User/SelectProject.hs b/src/Handler/User/SelectProject.hs index 5904d84..298c1f6 100644 --- a/src/Handler/User/SelectProject.hs +++ b/src/Handler/User/SelectProject.hs @@ -12,23 +12,22 @@ import Model.User -- /#UserId/select-project -getUserSelectProjectR :: UserId -> Handler Html -getUserSelectProjectR user_id = do +getUserSelectProjectR :: UserHandle -> Handler Html +getUserSelectProjectR nick = do + Entity user_id user <- runDB $ getBy404 $ UniqueUserNick nick void $ checkEditUser user_id - user <- runYDB $ get404 user_id projects <- runDB $ fetchUserWatchingProjectsDB user_id if length projects == 1 - then redirect $ ProjectNotificationsR user_id $ entityKey $ head projects + then redirect $ ProjectNotificationsR nick $ entityKey $ head projects else defaultLayout $ do - snowdriftDashTitle "Select Project" $ - userDisplayName' (Entity user_id user) + snowdriftDashTitle "Select Project" $ userDisplayName user $(widgetFile "user_select_project") -postUserSelectProjectR :: UserId -> Handler Html -postUserSelectProjectR user_id = do - user <- runDB $ get404 user_id +postUserSelectProjectR :: UserHandle -> Handler Html +postUserSelectProjectR nick = do + Entity user_id user <- runDB $ getBy404 $ UniqueUserNick nick void $ checkEditUser user_id mproject_id <- lookupPostParam "project_id" - maybe (redirect $ UserR $ userNick user) - (redirect . ProjectNotificationsR user_id . key . PersistInt64) + maybe (redirect $ UserR nick) + (redirect . ProjectNotificationsR nick . key . PersistInt64) (join $ Traversable.forM mproject_id $ readMaybe . T.unpack) diff --git a/src/Handler/User/Tickets.hs b/src/Handler/User/Tickets.hs index dd5c2e8..36ec84d 100644 --- a/src/Handler/User/Tickets.hs +++ b/src/Handler/User/Tickets.hs @@ -5,15 +5,13 @@ import Import import Handler.Utils import Model.User -getUserTicketsR :: UserId -> Handler Html -getUserTicketsR user_id = do - user <- runYDB $ get404 user_id +getUserTicketsR :: UserHandle -> Handler Html +getUserTicketsR nick = do + Entity user_id user <- runDB $ getBy404 $ UniqueUserNick nick mviewer_id <- maybeAuthId claimed_tickets <- claimedTickets user_id watched_tickets <- watchedTickets user_id defaultLayout $ do - snowdriftDashTitle "User Tickets" $ - userDisplayName' (Entity user_id user) - + snowdriftDashTitle "User Tickets" $ userDisplayName user $(widgetFile "user_tickets") diff --git a/src/Handler/User/User.hs b/src/Handler/User/User.hs index 2076542..6814c8e 100644 --- a/src/Handler/User/User.hs +++ b/src/Handler/User/User.hs @@ -5,13 +5,13 @@ import Import import Handler.User.Utils (checkEditUser, startEmailVerification) import Model.User -postUserR :: UserId -> Handler Html -postUserR user_id = do - user <- runDB $ get404 user_id +postUserR :: UserHandle -> Handler Html +postUserR nick = do + Entity user_id user <- runDB $ getBy404 $ UniqueUserNick nick void $ checkEditUser user_id memail <- runDB $ fetchUserEmail user_id case memail of Nothing -> alertDanger "No email address is associated with your account." Just email -> startEmailVerification user_id email - redirect $ UserR $ userNick user + redirect $ UserR nick diff --git a/src/Handler/User/Utils.hs b/src/Handler/User/Utils.hs index 4ec1948..7763820 100644 --- a/src/Handler/User/Utils.hs +++ b/src/Handler/User/Utils.hs @@ -38,8 +38,9 @@ resetPassphrase user_id user passphrase passphrase' route = startEmailVerification :: UserId -> Text -> HandlerT App IO () startEmailVerification user_id user_email = do + user <- runDB $ get404 user_id hash <- liftIO newHash - ver_uri <- getUrlRender <*> pure (UserVerifyEmailR user_id hash) + ver_uri <- getUrlRender <*> pure (UserVerifyEmailR (userNick user) hash) runDB $ do insert_ $ EmailVerification user_id user_email ver_uri False update $ \u -> do diff --git a/src/Handler/User/VerifyEmail.hs b/src/Handler/User/VerifyEmail.hs index 24e639d..50d502c 100644 --- a/src/Handler/User/VerifyEmail.hs +++ b/src/Handler/User/VerifyEmail.hs @@ -13,17 +13,18 @@ import Model.User -- /#UserId/verify-email/#Text -getUserVerifyEmailR :: UserId -> Text -> Handler Html -getUserVerifyEmailR user_id hash = do +getUserVerifyEmailR :: UserHandle -> Text -> Handler Html +getUserVerifyEmailR nick hash = do + Entity user_id user <- runDB $ getBy404 $ UniqueUserNick nick void $ checkEditUser user_id - ver_uri <- getUrlRender <*> pure (UserVerifyEmailR user_id hash) + ver_uri <- getUrlRender <*> pure (UserVerifyEmailR nick hash) (mver_email, muser_email) <- runDB $ (,) <$> fetchVerEmail ver_uri user_id <*> fetchUserEmail user_id if | Maybe.isNothing mver_email -> notFound | Maybe.isNothing muser_email -> do - alertDanger $ "Failed to verify the email address since none is " - <> "associated with the account." + alertDanger $ "Failed to verify the email address since none is \ + \associated with the account." redirect HomeR | otherwise -> do let ver_email = fromJust mver_email @@ -34,6 +35,6 @@ getUserVerifyEmailR user_id hash = do alertSuccess "Successfully verified the email address." redirect HomeR else do - alertDanger $ "Current email address does not match the " - <> "verification link." + alertDanger $ "Current email address does not match the \ + \verification link." redirect HomeR diff --git a/src/Model/Comment.hs b/src/Model/Comment.hs index e937e94..097cdb4 100644 --- a/src/Model/Comment.hs +++ b/src/Model/Comment.hs @@ -1198,8 +1198,8 @@ makeCommentRouteDB langs comment_id = get comment_id >>= \case (wikiTargetTarget wiki_target) comment_id - DiscussionOnUser (Entity user_id _) -> - return $ Just $ UserCommentR user_id comment_id + DiscussionOnUser (Entity _ user) -> + return $ Just $ UserCommentR (userNick user) comment_id DiscussionOnBlogPost (Entity _ blog_post) -> do project <- getJust $ blogPostProject blog_post diff --git a/src/Model/Comment/HandlerInfo.hs b/src/Model/Comment/HandlerInfo.hs index 67c5379..9d06762 100644 --- a/src/Model/Comment/HandlerInfo.hs +++ b/src/Model/Comment/HandlerInfo.hs @@ -78,10 +78,11 @@ wikiPageCommentHandlerInfo userCommentHandlerInfo :: Maybe (Entity User) -> UserId + -> UserHandle -> CommentMods -> CommentHandlerInfo -userCommentHandlerInfo muser user_id mods = +userCommentHandlerInfo muser user_id nick mods = CommentHandlerInfo (exprCommentUserPermissionFilter (entityKey <$> muser) (val user_id)) - (userCommentRoutes user_id) + (userCommentRoutes nick) (makeUserCommentActionPermissionsMap muser user_id mods) diff --git a/src/Model/Comment/Routes.hs b/src/Model/Comment/Routes.hs index 086b633..cf2f7bf 100644 --- a/src/Model/Comment/Routes.hs +++ b/src/Model/Comment/Routes.hs @@ -128,21 +128,21 @@ wikiPageCommentRoutes project_handle language target = CommentRoutes = UnwatchWikiCommentR project_handle language target } -userCommentRoutes :: UserId -> CommentRoutes -userCommentRoutes user_id = CommentRoutes - { comment_route_add_tag = UserCommentAddTagR user_id - , comment_route_approve = ApproveUserCommentR user_id - , comment_route_claim = ClaimUserCommentR user_id - , comment_route_close = CloseUserCommentR user_id - , comment_route_delete = DeleteUserCommentR user_id - , comment_route_edit = EditUserCommentR user_id - , comment_route_flag = FlagUserCommentR user_id - , comment_route_permalink = UserCommentR user_id - , comment_route_reply = ReplyUserCommentR user_id - , comment_route_rethread = RethreadUserCommentR user_id - , comment_route_retract = RetractUserCommentR user_id - , comment_route_tag = UserCommentTagR user_id - , comment_route_unclaim = UnclaimUserCommentR user_id - , comment_route_watch = WatchUserCommentR user_id - , comment_route_unwatch = UnwatchUserCommentR user_id +userCommentRoutes :: UserHandle -> CommentRoutes +userCommentRoutes nick = CommentRoutes + { comment_route_add_tag = UserCommentAddTagR nick + , comment_route_approve = ApproveUserCommentR nick + , comment_route_claim = ClaimUserCommentR nick + , comment_route_close = CloseUserCommentR nick + , comment_route_delete = DeleteUserCommentR nick + , comment_route_edit = EditUserCommentR nick + , comment_route_flag = FlagUserCommentR nick + , comment_route_permalink = UserCommentR nick + , comment_route_reply = ReplyUserCommentR nick + , comment_route_rethread = RethreadUserCommentR nick + , comment_route_retract = RetractUserCommentR nick + , comment_route_tag = UserCommentTagR nick + , comment_route_unclaim = UnclaimUserCommentR nick + , comment_route_watch = WatchUserCommentR nick + , comment_route_unwatch = UnwatchUserCommentR nick } diff --git a/src/Model/Markdown.hs b/src/Model/Markdown.hs index dfbde12..5d481d2 100644 --- a/src/Model/Markdown.hs +++ b/src/Model/Markdown.hs @@ -51,8 +51,8 @@ fixLinks project' discussion_on line' = do wikiTargetLanguage wikiTargetTarget comment_id - DiscussionOnUser (Entity user_id _) -> - UserCommentR user_id comment_id + DiscussionOnUser (Entity _ user) -> + UserCommentR (userNick user) comment_id DiscussionOnBlogPost (Entity _ BlogPost{..}) -> BlogPostCommentR project' blogPostHandle comment_id diff --git a/src/View/SnowdriftEvent.hs b/src/View/SnowdriftEvent.hs index bd32c31..39cb484 100644 --- a/src/View/SnowdriftEvent.hs +++ b/src/View/SnowdriftEvent.hs @@ -81,8 +81,8 @@ renderCommentPostedEvent ^{comment_widget} |]) - DiscussionOnUser (Entity user_id _) -> - (userCommentRoutes user_id, [whamlet| + DiscussionOnUser (Entity _ user) -> + (userCommentRoutes (userNick user), [whamlet| <div .event> On your user discussion page: ^{comment_widget} diff --git a/src/View/User.hs b/src/View/User.hs index 44b5074..34ac14d 100644 --- a/src/View/User.hs +++ b/src/View/User.hs @@ -152,6 +152,7 @@ renderUser mviewer_id user_id user projects_and_roles = do avatar <- getUserAvatar (StaticR img_default_avatar_png) (Just user) + let nick = userNick user $(widgetFile "user") setPassphraseForm :: Form SetPassphrase @@ -174,7 +175,7 @@ userNameWidget user_id = do Just user -> [whamlet| <a href=@{UserR $ userNick user}> - #{userDisplayName' (Entity user_id user)} + #{userDisplayName user} |] addTestCashForm :: Form Milray diff --git a/src/Widgets/UserPledges.hs b/src/Widgets/UserPledges.hs index 43f3c8f..77c538f 100644 --- a/src/Widgets/UserPledges.hs +++ b/src/Widgets/UserPledges.hs @@ -16,11 +16,12 @@ userPledgeSummary user_id = do project_summary <- handlerToWidget $ runDB $ map (uncurry summarizeProject') <$> Mech.fetchUserPledgesDB user_id + user <- handlerToWidget $ runDB $ get404 user_id toWidget [hamlet| $if null project_summary not pledged to any projects $else - <a href=@{UserPledgesR user_id}> + <a href=@{UserPledgesR $ userNick user}> <p> Patron to #{plural (length project_summary) "project" "projects"} diff --git a/templates/change-passphrase.hamlet b/templates/change-passphrase.hamlet index 01a04c3..711c014 100644 --- a/templates/change-passphrase.hamlet +++ b/templates/change-passphrase.hamlet @@ -1,5 +1,5 @@ Change your passphrase: <br> -<form method=POST action=@{UserChangePassphraseR user_id} enctype=#{enctype}> +<form method=POST action=@{UserChangePassphraseR nick} enctype=#{enctype}> ^{form} <button>update diff --git a/templates/dashboard/nav.hamlet b/templates/dashboard/nav.hamlet index d6bb5d3..fb72560 100644 --- a/templates/dashboard/nav.hamlet +++ b/templates/dashboard/nav.hamlet @@ -10,4 +10,4 @@ <li> <a href=@{URolesR}>Project Roles <li> - <a href=@{EditUserR uid}>Edit profile + <a href=@{EditUserR $ userNick user}>Edit profile diff --git a/templates/dashboard/notifications.hamlet b/templates/dashboard/notifications.hamlet index 6349575..cf23cf6 100644 --- a/templates/dashboard/notifications.hamlet +++ b/templates/dashboard/notifications.hamlet @@ -7,10 +7,10 @@ $nothing <div .user-prefs> <div .user-pref> - <a href=@{UserNotificationsR user_id}> + <a href=@{UserNotificationsR nick}> system notification preferences <div .user-pref> - <a href=@{UserSelectProjectR user_id}> + <a href=@{UserSelectProjectR nick}> watched projects notification preferences $if null notifs diff --git a/templates/delete_user.hamlet b/templates/delete_user.hamlet index 1c7c109..920f53f 100644 --- a/templates/delete_user.hamlet +++ b/templates/delete_user.hamlet @@ -5,5 +5,5 @@ and wiki edits). Since the process is <span .text-warning>irreversible</span>, we need to send you a confirmation email first. In order to do that, click on the button below. -<form method=POST action=@{DeleteUserR user_id}> +<form method=POST action=@{DeleteUserR nick}> <button>confirm diff --git a/templates/edit_user.hamlet b/templates/edit_user.hamlet index 8025809..d98d6e7 100644 --- a/templates/edit_user.hamlet +++ b/templates/edit_user.hamlet @@ -3,6 +3,6 @@ <em>These fields are all optional <br> -<form method=POST action=@{EditUserR user_id} enctype=#{enctype}> +<form method=POST action=@{EditUserR nick} enctype=#{enctype}> ^{form} <input type=submit name=mode value=preview> diff --git a/templates/project_feed.hamlet b/templates/project_feed.hamlet index e31f525..5dbac44 100644 --- a/templates/project_feed.hamlet +++ b/templates/project_feed.hamlet @@ -1,10 +1,10 @@ <h1>#{projectName project} activity feed <div .feed-watching> - $maybe user_id <- muser_id + $maybe Entity user_id user <- muser $if is_watching You are watching this project. - <a href=@{ProjectNotificationsR user_id project_id}> + <a href=@{ProjectNotificationsR (userNick user) project_id}> Edit notification preferences <form method=POST action=@{UnwatchProjectR project_id}> <input type=submit value="unwatch"> diff --git a/templates/project_notifications.hamlet b/templates/project_notifications.hamlet index db13fb1..0ac6a0c 100644 --- a/templates/project_notifications.hamlet +++ b/templates/project_notifications.hamlet @@ -2,6 +2,6 @@ <em>Note: email sending requires a verified email address <br> -<form method=POST action=@{ProjectNotificationsR user_id project_id} enctype=#{enctype}> +<form method=POST action=@{ProjectNotificationsR nick project_id} enctype=#{enctype}> ^{form} <button>update diff --git a/templates/set-passphrase.hamlet b/templates/set-passphrase.hamlet index 2bf13f6..d69ba11 100644 --- a/templates/set-passphrase.hamlet +++ b/templates/set-passphrase.hamlet @@ -1,6 +1,6 @@ Set the new passphrase: <form method=POST - action=@{UserResetPassphraseR user_id hash} + action=@{UserResetPassphraseR nick hash} enctype=#{enctype}> ^{form} <button>update diff --git a/templates/user.hamlet b/templates/user.hamlet index a2b059d..f888850 100644 --- a/templates/user.hamlet +++ b/templates/user.hamlet @@ -1,25 +1,25 @@ $if Just user_id == mviewer_id <div .user-prefs> <div .user-pref> - <a href=@{EditUserR user_id}> + <a href=@{EditUserR nick}> edit profile <div .user-pref> - <a href=@{DeleteUserR user_id}> + <a href=@{DeleteUserR nick}> delete account <div .user-pref> - <a href=@{UserChangePassphraseR user_id}> + <a href=@{UserChangePassphraseR nick}> change passphrase <div .user-pref> - <a href=@{UserNotificationsR user_id}> + <a href=@{UserNotificationsR nick}> user notification preferences <div .user-pref> - <a href=@{UserSelectProjectR user_id}> + <a href=@{UserSelectProjectR nick}> watched projects notification preferences <div .row> <div .col-md-6> <h1> - #{userDisplayName' user_entity} + #{userDisplayName user} <div .row> <div .col-sm-5> <figure> @@ -37,11 +37,11 @@ $if Just user_id == mviewer_id $maybe email <- userEmail user #{email} (not shown publicly) $if isJust (userEmail user) && not (userEmail_verified user) - <form method=POST action=@{UserR $ userNick user}> + <form method=POST action=@{UserR nick}> <button>resend verification email <br> - $maybe nick <- userIrcNick user - #{nick} on <a href=@{WikiR "snowdrift" LangEn "irc"}>irc.freenode.net</a> + $maybe ircnick <- userIrcNick user + #{ircnick} on <a href=@{WikiR "snowdrift" LangEn "irc"}>irc.freenode.net</a> <div .col-md-6> $maybe blurb <- userBlurb user @@ -85,8 +85,8 @@ $if Just user_id == mviewer_id <h4>Ticket Activity - <a href=@{UserTicketsR user_id}> - #{userDisplayName' user_entity}'s claimed and watched tickets + <a href=@{UserTicketsR nick}> + #{userDisplayName user}'s claimed and watched tickets $maybe (est_form, est_form_enctype) <- mest_form_and_enctype <div .row> @@ -103,7 +103,6 @@ $maybe (est_form, est_form_enctype) <- mest_form_and_enctype They will then become fully established after affirming the <a href=@{WikiR "snowdrift" LangEn "honor"}>honor pledge</a>. - <form action=@{UserEstEligibleR user_id} method=post enctype=#{est_form_enctype}> + <form action=@{UserEstEligibleR nick} method=post enctype=#{est_form_enctype}> ^{est_form} <input type=submit value="Approve"> - diff --git a/templates/user_confirm_delete.hamlet b/templates/user_confirm_delete.hamlet index d5d4361..00ca5f4 100644 --- a/templates/user_confirm_delete.hamlet +++ b/templates/user_confirm_delete.hamlet @@ -6,5 +6,5 @@ Your submissions (such as comments and wiki edits) will stay on the site but will be assigned to the special "deleted user." If you want to delete them as well, now it is a good time to do so. -<form method=POST action=@{UserConfirmDeleteR user_id hash}> +<form method=POST action=@{UserConfirmDeleteR nick hash}> <button>delete diff --git a/templates/user_discuss.hamlet b/templates/user_discuss.hamlet index d8f9c14..ddefea4 100644 --- a/templates/user_discuss.hamlet +++ b/templates/user_discuss.hamlet @@ -1,28 +1,28 @@ $maybe _ <- closedView - <h1 .text-center>#{userDisplayName' (Entity user_id user)} closed discussion threads + <h1 .text-center>#{userDisplayName user} closed discussion threads $nothing - <h1 .text-center>#{userDisplayName' (Entity user_id user)} personal discussion + <h1 .text-center>#{userDisplayName user} personal discussion <div .page-toolbox> <div .page-tool> - <a href=@{UserR $ userNick user}>back to user profile + <a href=@{UserR nick}>back to user profile $maybe _ <- closedView <div .page-tool> - <a href=@{UserDiscussionR user_id}> + <a href=@{UserDiscussionR nick}> back to open discussion $nothing $if has_comments <div .page-tool> - <a href=@{NewUserDiscussionR user_id}>new top-level comment + <a href=@{NewUserDiscussionR nick}>new top-level comment <div .page-tool> - <a href=@?{(UserDiscussionR user_id, [("state", "closed")])}> + <a href=@?{(UserDiscussionR nick, [("state", "closed")])}> view closed threads ^{comment_forest} $if not has_comments && not (isJust closedView) $maybe _ <- mviewer - <form action=@{NewUserDiscussionR user_id} method=POST> + <form action=@{NewUserDiscussionR nick} method=POST> ^{comment_form} <input type=submit name=mode value=preview> $nothing diff --git a/templates/user_discussion_wrapper.hamlet b/templates/user_discussion_wrapper.hamlet index f4b9843..41e7259 100644 --- a/templates/user_discussion_wrapper.hamlet +++ b/templates/user_discussion_wrapper.hamlet @@ -1,7 +1,7 @@ <div .page-toolbox> <div .page-tool> - <a href=@{UserDiscussionR user_id}> back to full discussion + <a href=@{UserDiscussionR nick}> back to full discussion <div .page-tool> - <a href=@{UserR $ userNick user}> back to user page + <a href=@{UserR nick}> back to user page ^{widget} diff --git a/templates/user_notifications.hamlet b/templates/user_notifications.hamlet index daea038..9571d6c 100644 --- a/templates/user_notifications.hamlet +++ b/templates/user_notifications.hamlet @@ -2,6 +2,6 @@ <em>Note: email sending requires a verified email address <br> -<form method=POST action=@{UserNotificationsR user_id} enctype=#{enctype}> +<form method=POST action=@{UserNotificationsR nick} enctype=#{enctype}> ^{form} <button>update diff --git a/templates/user_select_project.hamlet b/templates/user_select_project.hamlet index 307104a..aff62eb 100644 --- a/templates/user_select_project.hamlet +++ b/templates/user_select_project.hamlet @@ -2,7 +2,7 @@ $if null projects No watched projects $else Select a project: - <form method=POST action=@{UserSelectProjectR user_id}> + <form method=POST action=@{UserSelectProjectR nick}> <select .form-control name=project_id> $forall Entity project_id project <- projects <option value=#{toPathPiece project_id}>#{projectName project} -- 1.9.1 _______________________________________________ Dev mailing list Dev@lists.snowdrift.coop https://lists.snowdrift.coop/mailman/listinfo/dev