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
