From: fr33domlover <fr33domlo...@rel4tion.org>
Making UserR take a Text that refers to a whole new User field is a
big
change. Many handlers and templates need to be updated. Therefore
please
read below carefully to understand my plan and what exactly this
commit
does.
The GOAL is to move all UserId-based routes to use UserHandle
instead,
which is Text. That "handle" references a new 'userNick` field in
the
User table. But since this is a huge change, this commit does a
smaller
change. The rest will come in the next patches. What this commit
does
is:
1. Update the UserR route and add a deprecated UserByIdR route
2. Add the 'userNick' field to account creation and account update
forms
3. Require a pattern for the 'userNick' field to avoid all-digit
nicknames and other potential issues
4. Fix all handlers and templates to pass the 'userNick' to 'UserR'
instead of the 'userId'. That includes inserting 'get404' calls
in
several places just to get the User value, and other helpers that
will be removed later. They are used just so that the code
builds and
works after applying this patch.
The next patch(es) will update all the other handlers and probably
change some of the helper functions to work with the new 'userNick'
field.
Before this gets committed, some input/review from dev and desig
teams
will be great. But don't be pedantic, as the next commits will
change
many things and will remove some of the ugly parts used here
temporarily.
I suggest we make this change in 2 steps because it's so big:
1. Change the routes and UI as needed, and do whatever is needed to
make the
code build again
2. When done, refactor and add helpers and put all the chaos back
to order
---
config/models | 7 +
config/routes | 3 +-
src/Foundation.hs | 24 +++-
src/Handler/NewDesign.hs | 19 ++-
src/Handler/Project.hs | 20 +--
src/Handler/User/Comment.hs | 1 +
src/Handler/User/Delete.hs | 3 +-
src/Handler/User/Edit.hs | 7 +-
src/Handler/User/NewDiscussion.hs | 1 +
src/Handler/User/Notifications.hs | 3 +-
src/Handler/User/ProjectNotifications.hs | 3 +-
src/Handler/User/SelectProject.hs | 3 +-
src/Handler/User/User.hs | 3 +-
src/Handler/User/Utils.hs | 2 +-
src/Handler/Who.hs | 10 +-
src/Model/Transaction.hs | 2 +-
src/Model/User.hs | 7 +-
src/Model/User/Internal.hs | 18 +--
src/View/SnowdriftEvent.hs | 22 +--
src/View/User.hs | 37 ++++-
templates/application.hamlet | 2 +-
templates/auth/create-user-form.hamlet | 12 +-
templates/comment.hamlet | 7 +-
templates/default/navbar.hamlet | 35 ++---
templates/invite.hamlet | 8 +-
templates/navbar.hamlet | 8 +-
templates/project_patrons.hamlet | 2 +-
templates/project_transactions.hamlet | 2 +-
templates/sponsors.hamlet | 226
+++++++++++++++----------------
templates/tag.hamlet | 2 +-
templates/user.hamlet | 2 +-
templates/user_discuss.hamlet | 2 +-
templates/user_discussion_wrapper.hamlet | 2 +-
templates/user_tickets.hamlet | 2 +-
templates/users.hamlet | 2 +-
templates/who.hamlet | 4 +-
templates/wiki_history.hamlet | 2 +-
tests/TestImport.hs | 2 +-
38 files changed, 295 insertions(+), 222 deletions(-)
diff --git a/config/models b/config/models
index a592753..bf64b14 100644
--- a/config/models
+++ b/config/models
@@ -16,6 +16,12 @@ Transaction
User
ident Text
+ -- ^ Private login name, never shown in UI, may be an email
address in the
+ -- case of Persona logins.
+ nick Text
default=concat('user-',floor(random()*100000))
+ -- ^ Public user unique nickname, shown in the UI.
+ -- TODO the default value is meant just for initial
migration, remove it
+ -- once all users get assigned auto-generated nicks
email Text Maybe
email_verified Bool default=false
createdTs UTCTime
@@ -35,6 +41,7 @@ User
discussion DiscussionId
default=nextval('discussion_id_seq'::regclass)
UniqueUser ident
+ UniqueUserNick nick
UniqueUserAccount account
UniqueUserDiscussion discussion
diff --git a/config/routes b/config/routes
index 999f36b..7118d51 100644
--- a/config/routes
+++ b/config/routes
@@ -74,7 +74,8 @@
-- ## Browsing a particular user (may need fleshing out?)
--
-/u/#UserHandle UserR GET
+/u/!#UserId UserByIdR GET
+/u/#UserHandle UserR GET
-- Yesod jibber jabber
/static StaticR Static appStatic
diff --git a/src/Foundation.hs b/src/Foundation.hs
index 78797fc..5648436 100644
--- a/src/Foundation.hs
+++ b/src/Foundation.hs
@@ -12,6 +12,7 @@ import Control.Monad.Writer.Strict (WriterT,
runWriterT)
import Data.Char (isSpace)
import Data.Text as T
import Network.HTTP.Conduit (Manager)
+import System.Random (randomRIO)
import Text.Blaze.Html.Renderer.Text (renderHtml)
import Text.Hamlet (hamletFile)
import Text.Jasmine (minifym)
@@ -62,9 +63,11 @@ plural _ _ y = y
-- Set up i18n messages. See the message folder.
mkMessage "App" "messages" "en"
--- FIXME
+-- Type of project identifier path piece in URLs
type ProjectHandle = Text
-type UserHandle = UserId
+
+-- Type of user identifier path piece in URLs
+type UserHandle = Text
-- This is where we define all of the routes in our application.
For a full
-- explanation of the syntax, please see:
@@ -243,8 +246,13 @@ instance YesodAuth App where
("hashdb", _) -> return $ UserError $
IdentifierNotFound ident
("browserid", _) -> do
let emailStuff = Just $ NewEmail True ident
+ -- Generate nickname automatically. This is ugly,
but we're
+ -- deprecating Persona anyway.
+ num <- liftIO $ randomRIO (0, 99999 :: Int)
+ let nick = "user-" <> pack (show num)
muid <-
- createUser ident Nothing Nothing emailStuff
Nothing Nothing
+ createUser
+ ident Nothing nick Nothing emailStuff
Nothing Nothing
return $ case muid of
-- The Nothing case never really runs because
'createUser'
-- throws an exception on failure
@@ -268,9 +276,10 @@ data NewEmail = NewEmail
, neAddr :: Text
}
-createUser :: Text -> Maybe Text -> Maybe Text -> Maybe NewEmail
-> Maybe Text
- -> Maybe Text -> Handler (Maybe UserId)
-createUser ident passph name newEmail avatar nick = do
+createUser
+ :: Text -> Maybe Text -> Text -> Maybe Text -> Maybe NewEmail
-> Maybe Text
+ -> Maybe Text -> Handler (Maybe UserId)
+createUser ident passph nickname name newEmail avatar ircNick = do
langs <- mapMaybe (readMaybe . T.unpack) <$> languages
now <- liftIO getCurrentTime
handle (\DBException -> return Nothing) $ runYDB $ do
@@ -309,6 +318,7 @@ createUser ident passph name newEmail avatar
nick = do
where
newUser langs now account_id discussion_id =
User { userIdent = ident
+ , userNick = nickname
, userEmail = (neAddr <$> newEmail)
, userEmail_verified = (maybe False neVerified
newEmail)
, userCreatedTs = now
@@ -319,7 +329,7 @@ createUser ident passph name newEmail avatar
nick = do
, userAvatar = avatar
, userBlurb = Nothing
, userStatement = Nothing
- , userIrcNick = nick
+ , userIrcNick = ircNick
, userLanguages = langs
, userReadNotifications = now
, userReadApplications = now
diff --git a/src/Handler/NewDesign.hs b/src/Handler/NewDesign.hs
index 05829ab..99b8622 100644
--- a/src/Handler/NewDesign.hs
+++ b/src/Handler/NewDesign.hs
@@ -181,14 +181,15 @@ postCreateAccountR = do
((result, form), _) <- runFormPost $ createUserForm Nothing
case result of
- FormSuccess (ident, passph, name, memail, avatar, nick) ->
do
+ FormSuccess (ident, passph, nickname, name, memail,
avatar, ircnick) -> do
muser_id <-
createUser ident
(Just passph)
+ nickname
name
(NewEmail False <$> memail)
avatar
- nick
+ ircnick
fromMaybe (pure())
(startEmailVerification <$> muser_id <*>
memail)
case muser_id of
@@ -210,11 +211,11 @@ postCreateAccountR = do
|]
-- | Public profile for a user.
-getUserR :: UserId -> Handler Html
-getUserR user_id = do
+getUserR :: UserHandle -> Handler Html
+getUserR nickname = do
mviewer_id <- maybeAuthId
- user <- runYDB $ get404 user_id
+ Entity user_id user <- runYDB $ getBy404 $ UniqueUserNick
nickname
projects_and_roles <- runDB (fetchUserProjectsAndRolesDB
user_id)
when ( Just user_id == mviewer_id
@@ -230,6 +231,14 @@ getUserR user_id = do
alphaRewriteNotice
renderUser mviewer_id user_id user projects_and_roles
+-- | Pick user by numeric ID, and simply redirect to 'UserR'.
+--
+-- TODO remove this at some point?
+getUserByIdR :: UserId -> Handler Html
+getUserByIdR user_id = do
+ user <- runYDB $ get404 user_id
+ redirect $ UserR $ userNick user
+
getUNotificationsR :: Handler Html
getUNotificationsR = do
showArchived <- lookupGetParam "state"
diff --git a/src/Handler/Project.hs b/src/Handler/Project.hs
index 5ab1834..4c7eff9 100644
--- a/src/Handler/Project.hs
+++ b/src/Handler/Project.hs
@@ -433,21 +433,23 @@ getInviteR project_handle = do
outstanding_invites <- runDB $
select $
- from $ \invite -> do
+ from $ \ (invite `InnerJoin` user) -> do
+ on_ $ invite ^. InviteUser ==. user ^. UserId
where_ ( invite ^. InviteRedeemed ==. val False )
orderBy [ desc (invite ^. InviteCreatedTs) ]
- return invite
+ return (invite, user ^. UserNick)
redeemed_invites <- runDB $
select $
- from $ \invite -> do
- where_ ( invite ^. InviteRedeemed ==. val True )
+ from $ \ (invite `InnerJoin` user) -> do
+ on_ $ invite ^. InviteUser ==. user ^. UserId
+ where_ $ invite ^. InviteRedeemed ==. val True
orderBy [ desc (invite ^. InviteCreatedTs) ]
- return invite
+ return (invite, user ^. UserNick)
- let redeemed_users = S.fromList $ mapMaybe (inviteRedeemedBy .
entityVal) redeemed_invites
- redeemed_inviters = S.fromList $ map (inviteUser .
entityVal) redeemed_invites
- outstanding_inviters = S.fromList $ map (inviteUser .
entityVal) outstanding_invites
+ let redeemed_users = S.fromList $ mapMaybe (inviteRedeemedBy .
entityVal . fst) redeemed_invites
+ redeemed_inviters = S.fromList $ map (inviteUser .
entityVal . fst) redeemed_invites
+ outstanding_inviters = S.fromList $ map (inviteUser .
entityVal . fst) outstanding_invites
user_ids = S.toList $ redeemed_users `S.union`
redeemed_inviters `S.union` outstanding_inviters
user_entities <- runDB $ selectList [ UserId <-. user_ids ] []
@@ -458,7 +460,7 @@ getInviteR project_handle = do
format_user (Just user_id) =
let Entity _ user = fromMaybe (error "getInviteR:
user_id not found in users map")
(M.lookup user_id users)
- in fromMaybe (userIdent user) $ userName user
+ in fromMaybe (userNick user) $ userName user
format_inviter user_id =
userDisplayName $ fromMaybe (error "getInviteR(#2):
user_id not found in users map")
diff --git a/src/Handler/User/Comment.hs
b/src/Handler/User/Comment.hs
index dd14dd9..5310bed 100644
--- a/src/Handler/User/Comment.hs
+++ b/src/Handler/User/Comment.hs
@@ -132,6 +132,7 @@ 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
$(widgetFile "user_discussion_wrapper")
toWidget $(cassiusFile "templates/comment.cassius")
diff --git a/src/Handler/User/Delete.hs b/src/Handler/User/Delete.hs
index c52b49b..1ab6aa7 100644
--- a/src/Handler/User/Delete.hs
+++ b/src/Handler/User/Delete.hs
@@ -32,6 +32,7 @@ getDeleteUserR user_id = do
postDeleteUserR :: UserId -> Handler Html
postDeleteUserR user_id = do
+ user <- runDB $ get404 user_id
void $ checkEditUser user_id
startDeleteConfirmation user_id
- redirect $ UserR user_id
+ redirect $ UserR $ userNick user
diff --git a/src/Handler/User/Edit.hs b/src/Handler/User/Edit.hs
index 6248d26..d126c95 100644
--- a/src/Handler/User/Edit.hs
+++ b/src/Handler/User/Edit.hs
@@ -41,8 +41,8 @@ postEditUserR user_id = do
mcurrent_email <- runDB $ fetchUserEmail
user_id
when (mcurrent_email /= Just user_email) $
startEmailVerification user_id
user_email
- runDB (updateUserDB user_id user_update)
- redirect (UserR user_id)
+ runDB $ updateUserDB user_id user_update
+ redirect $ UserR $ userUpdateNick user_update
_ -> do
user <- runYDB $ get404 user_id
@@ -56,5 +56,6 @@ 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 user_id)
+ redirect $ UserR $ userNick user
diff --git a/src/Handler/User/NewDiscussion.hs
b/src/Handler/User/NewDiscussion.hs
index a6965c3..5f4278d 100644
--- a/src/Handler/User/NewDiscussion.hs
+++ b/src/Handler/User/NewDiscussion.hs
@@ -14,6 +14,7 @@ getNewUserDiscussionR :: UserId -> Handler Html
getNewUserDiscussionR user_id = do
void requireAuth
let widget = commentNewTopicFormWidget
+ user <- runDB $ get404 user_id
defaultLayout $(widgetFile "user_discussion_wrapper")
postNewUserDiscussionR :: UserId -> Handler Html
diff --git a/src/Handler/User/Notifications.hs
b/src/Handler/User/Notifications.hs
index bd67096..fe1dc1c 100644
--- a/src/Handler/User/Notifications.hs
+++ b/src/Handler/User/Notifications.hs
@@ -42,7 +42,8 @@ postUserNotificationsR user_id = do
forM_ (userNotificationPref notif_pref) $ \(ntype,
ndeliv) ->
runDB $ updateUserNotificationPrefDB user_id ntype
ndeliv
alertSuccess "Successfully updated the notification
preferences."
- redirect $ UserR user_id
+ user <- runDB $ get404 user_id
+ redirect $ UserR $ userNick user
_ -> do
alertDanger $ "Failed to update the notification
preferences. "
<> "Please try again."
diff --git a/src/Handler/User/ProjectNotifications.hs
b/src/Handler/User/ProjectNotifications.hs
index 7de8233..d5c90bf 100644
--- a/src/Handler/User/ProjectNotifications.hs
+++ b/src/Handler/User/ProjectNotifications.hs
@@ -47,7 +47,8 @@ postProjectNotificationsR user_id project_id = do
runDB $ updateProjectNotificationPrefDB
user_id project_id ntype ndeliv
alertSuccess "Successfully updated the notification
preferences."
- redirect (UserR user_id)
+ user <- runDB $ get404 user_id
+ redirect $ UserR $ userNick user
_ -> do
project <- runYDB $ get404 project_id
alertDanger "Failed to update the notification
preferences."
diff --git a/src/Handler/User/SelectProject.hs
b/src/Handler/User/SelectProject.hs
index 377c8e4..fdac755 100644
--- a/src/Handler/User/SelectProject.hs
+++ b/src/Handler/User/SelectProject.hs
@@ -26,8 +26,9 @@ getUserSelectProjectR user_id = do
postUserSelectProjectR :: UserId -> Handler Html
postUserSelectProjectR user_id = do
+ user <- runDB $ get404 user_id
void $ checkEditUser user_id
mproject_id <- lookupPostParam "project_id"
- maybe (redirect $ UserR user_id)
+ maybe (redirect $ UserR $ userNick user)
(redirect . ProjectNotificationsR user_id . key .
PersistInt64)
(join $ Traversable.forM mproject_id $ readMaybe .
T.unpack)
diff --git a/src/Handler/User/User.hs b/src/Handler/User/User.hs
index 57020cf..2076542 100644
--- a/src/Handler/User/User.hs
+++ b/src/Handler/User/User.hs
@@ -7,10 +7,11 @@ import Model.User
postUserR :: UserId -> Handler Html
postUserR user_id = do
+ user <- runDB $ get404 user_id
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 user_id
+ redirect $ UserR $ userNick user
diff --git a/src/Handler/User/Utils.hs b/src/Handler/User/Utils.hs
index baeceba..4ec1948 100644
--- a/src/Handler/User/Utils.hs
+++ b/src/Handler/User/Utils.hs
@@ -31,7 +31,7 @@ resetPassphrase user_id user passphrase
passphrase' route =
updateUserPassphraseDB user_id (userHash user')
(userSalt user')
deleteFromResetPassphrase user_id
alertSuccess "You successfully updated your
passphrase."
- redirect $ UserR user_id
+ redirect $ UserR $ userNick user'
else do
alertDanger "The passphrases you entered do not match."
redirect route
diff --git a/src/Handler/Who.hs b/src/Handler/Who.hs
index 2eaa54b..906e3ed 100644
--- a/src/Handler/Who.hs
+++ b/src/Handler/Who.hs
@@ -8,17 +8,19 @@ import Handler.Utils
import Model.Markdown
userShortName :: User -> Text
-userShortName user = fromMaybe (userIdent user) $ userName user
+userShortName user = fromMaybe (userNick user) $ userName user
getWhoR :: Text -> Handler Html
getWhoR project_handle = do
- Entity project_id project <- runYDB $ getBy404 $
UniqueProjectHandle project_handle
+ Entity project_id project <-
+ runYDB $ getBy404 $ UniqueProjectHandle project_handle
team_members <- runDB $
select $
from $ \(user `InnerJoin` project_user_role) -> do
on_ $ user ^. UserId ==. project_user_role ^.
ProjectUserRoleUser
- where_ $ (project_user_role ^. ProjectUserRoleProject ==.
val project_id)
- &&. (project_user_role ^. ProjectUserRoleRole ==. val
TeamMember)
+ where_ $
+ project_user_role ^. ProjectUserRoleProject ==. val
project_id &&.
+ project_user_role ^. ProjectUserRoleRole ==. val
TeamMember
return user
let members = sortBy (compare `on` (userCreatedTs .
entityVal)) team_members
diff --git a/src/Model/Transaction.hs b/src/Model/Transaction.hs
index c9fe404..d4d0b10 100644
--- a/src/Model/Transaction.hs
+++ b/src/Model/Transaction.hs
@@ -36,7 +36,7 @@ renderOtherAccount is_credit transaction
user_accounts project_accounts = do
(Nothing, Just (Entity user_id user)) ->
[hamlet|
- <a href=@{UserR user_id}>
+ <a href=@{UserR $ userNick user}>
#{userDisplayName (Entity user_id user)}
|]
diff --git a/src/Model/User.hs b/src/Model/User.hs
index 629b1bb..e5ddc8c 100644
--- a/src/Model/User.hs
+++ b/src/Model/User.hs
@@ -174,8 +174,8 @@ curUserIsEligibleEstablish =
-- | Get a User's public display name (defaults to userN if no
name has
-- been set).
userDisplayName :: Entity User -> Text
-userDisplayName (Entity user_id user) =
- fromMaybe ("user" <> toPathPiece user_id) (userName user)
+userDisplayName (Entity _user_id user) =
+ fromMaybe (userNick user) (userName user)
-- | Apply a UserUpdate in memory, for preview. For this reason,
-- userUpdateNotificationPreferences doesn't need to be touched.
@@ -229,7 +229,8 @@ fetchUserWatchingProjectsDB user_id =
updateUserDB :: UserId -> UserUpdate -> DB ()
updateUserDB user_id UserUpdate{..} = update $ \u -> do
- set u [ UserName =. val userUpdateName
+ set u [ UserNick =. val userUpdateNick
+ , UserName =. val userUpdateName
, UserAvatar =. val userUpdateAvatar
, UserEmail =. val userUpdateEmail
, UserIrcNick =. val userUpdateIrcNick
diff --git a/src/Model/User/Internal.hs b/src/Model/User/Internal.hs
index 2bf2299..a4e4630 100644
--- a/src/Model/User/Internal.hs
+++ b/src/Model/User/Internal.hs
@@ -8,15 +8,15 @@ import qualified Database.Persist as P
import Model.Notification
import WrappedValues
-data UserUpdate =
- UserUpdate
- { userUpdateName :: Maybe Text
- , userUpdateAvatar :: Maybe Text
- , userUpdateEmail :: Maybe Text
- , userUpdateIrcNick :: Maybe Text
- , userUpdateBlurb :: Maybe Markdown
- , userUpdateStatement :: Maybe Markdown
- }
+data UserUpdate = UserUpdate
+ { userUpdateNick :: Text
+ , userUpdateName :: Maybe Text
+ , userUpdateAvatar :: Maybe Text
+ , userUpdateEmail :: Maybe Text
+ , userUpdateIrcNick :: Maybe Text
+ , userUpdateBlurb :: Maybe Markdown
+ , userUpdateStatement :: Maybe Markdown
+ }
data ChangePassphrase = ChangePassphrase
{ currentPassphrase :: Text
diff --git a/src/View/SnowdriftEvent.hs b/src/View/SnowdriftEvent.hs
index a9579ae..d4e92f4 100644
--- a/src/View/SnowdriftEvent.hs
+++ b/src/View/SnowdriftEvent.hs
@@ -123,7 +123,7 @@ renderCommentPendingEvent comment_id comment
user_map = do
[whamlet|
<div .event>
^{renderTime $ commentCreatedTs comment}
- <a href=@{UserR (commentUser comment)}>
#{userDisplayName (Entity (commentUser comment) poster)}
+ <a href=@{UserR $ userNick poster}> #{userDisplayName
(Entity (commentUser comment) poster)}
posted a
<a href=@{CommentDirectLinkR comment_id}> comment
awaiting moderator approval: #{commentText comment}
@@ -142,7 +142,7 @@ renderCommentRethreadedEvent Rethread{..}
user_map = do
[whamlet|
<div .event>
^{renderTime rethreadTs}
- <a href=@{UserR rethreadModerator}> #{userDisplayName
(Entity rethreadModerator user)}
+ <a href=@{UserR $ userNick user}> #{userDisplayName
(Entity rethreadModerator user)}
rethreaded a comment from
<del>@{old_route}
to
@@ -163,7 +163,7 @@ renderCommentClosedEvent CommentClosing{..}
user_map ticket_map = do
[whamlet|
<div .event>
^{renderTime commentClosingTs}
- <a href=@{UserR commentClosingClosedBy}>
#{userDisplayName (Entity commentClosingClosedBy user)}
+ <a href=@{UserR $ userNick user}>
#{userDisplayName (Entity commentClosingClosedBy user)}
closed ticket
<a href=@{CommentDirectLinkR
commentClosingComment}>
<div .ticket-title>SD-#{ticket_str}:
#{ticketName}
@@ -173,7 +173,7 @@ renderCommentClosedEvent CommentClosing{..}
user_map ticket_map = do
[whamlet|
<div .event>
^{renderTime commentClosingTs}
- <a href=@{UserR commentClosingClosedBy}>
#{userDisplayName (Entity commentClosingClosedBy user)}
+ <a href=@{UserR $ userNick user}>
#{userDisplayName (Entity commentClosingClosedBy user)}
closed
<a href=@{CommentDirectLinkR
commentClosingComment}>
comment thread
@@ -191,7 +191,7 @@ renderTicketClaimedEvent (Left (_,
TicketClaiming{..})) user_map ticket_map = do
[whamlet|
<div .event>
^{renderTime ticketClaimingTs}
- <a href=@{UserR ticketClaimingUser}> #{userDisplayName
(Entity ticketClaimingUser user)}
+ <a href=@{UserR $ userNick user}> #{userDisplayName
(Entity ticketClaimingUser user)}
claimed ticket
<a href=@{CommentDirectLinkR ticketClaimingTicket}>
<div .ticket-title>SD-#{ticket_str}: #{ticketName}
@@ -208,7 +208,7 @@ renderTicketClaimedEvent (Right (_,
TicketOldClaiming{..})) user_map ticket_map
[whamlet|
<div .event>
^{renderTime ticketOldClaimingClaimTs}
- <a href=@{UserR ticketOldClaimingUser}>
#{userDisplayName (Entity ticketOldClaimingUser user)}
+ <a href=@{UserR $ userNick user}> #{userDisplayName
(Entity ticketOldClaimingUser user)}
claimed ticket
<a href=@{CommentDirectLinkR ticketOldClaimingTicket}>
<div .ticket-title>SD-#{ticket_str}: #{ticketName}
@@ -251,7 +251,7 @@ renderWikiPageEvent project_handle wiki_page_id
wiki_page _ = do
<div .event>
^{renderTime $ wikiPageCreatedTs wiki_page}
<!--
- <a href=@{UserR (wikiPageUser wiki_page)}>
+ <a href=@{UserR $ userNick editor}>
#{userDisplayName (Entity (wikiPageUser
wiki_page) editor)}
-->
made a new wiki page: #
@@ -265,7 +265,7 @@ renderWikiEditEvent project_handle edit_id
wiki_edit wiki_target_map user_map =
[whamlet|
<div .event>
^{renderTime $ wikiEditTs wiki_edit}
- <a href=@{UserR (wikiEditUser wiki_edit)}>
+ <a href=@{UserR $ userNick editor}>
#{userDisplayName (Entity (wikiEditUser wiki_edit)
editor)}
edited the
<a href=@{WikiR project_handle (wikiTargetLanguage
wiki_target) (wikiTargetTarget wiki_target)}> #{wikiTargetTarget
wiki_target}
@@ -300,7 +300,7 @@ renderNewPledgeEvent _ SharesPledged{..}
user_map = do
[whamlet|
<div .event>
^{renderTime sharesPledgedTs}
- <a href=@{UserR sharesPledgedUser}> #{userDisplayName
(Entity sharesPledgedUser pledger)}
+ <a href=@{UserR $ userNick pledger}> #{userDisplayName
(Entity sharesPledgedUser pledger)}
made a new pledge of #{show mills} per patron!
|]
@@ -315,7 +315,7 @@ renderUpdatedPledgeEvent old_shares _
SharesPledged{..} user_map = do
[whamlet|
<div .event>
^{renderTime sharesPledgedTs}
- <a href=@{UserR sharesPledgedUser}> #{userDisplayName
(Entity sharesPledgedUser pledger)}
+ <a href=@{UserR $ userNick pledger}> #{userDisplayName
(Entity sharesPledgedUser pledger)}
#{verb} their pledge from #{show old_mills} to #{show
new_mills} per patron#{punc}
|]
@@ -326,6 +326,6 @@ renderDeletedPledgeEvent ts user_id shares
user_map = do
[whamlet|
<div .event>
^{renderTime ts}
- <a href=@{UserR user_id}>#{userDisplayName (Entity
user_id pledger)}
+ <a href=@{UserR $ userNick pledger}>#{userDisplayName
(Entity user_id pledger)}
withdrew their #{show mills} per patron pledge.
|]
diff --git a/src/View/User.hs b/src/View/User.hs
index 67de9f8..7498f8a 100644
--- a/src/View/User.hs
+++ b/src/View/User.hs
@@ -14,9 +14,11 @@ module View.User
import Import hiding (UserNotificationPref,
ProjectNotificationPref)
+import Data.Char (isDigit)
import Data.String (fromString)
import qualified Data.Map as M
import qualified Data.Set as S
+import qualified Data.Text as T
import Avatar
import DeprecatedBootstrap
@@ -28,23 +30,44 @@ import Model.User.Internal
import Widgets.Markdown (snowdriftMarkdownField)
import Widgets.UserPledges
+nickField :: Field Handler Text
+nickField =
+ -- A safe and initial reasonable nickname pattern. It's much
easier to make
+ -- it restrictive now and relax later, than to make it too
relaxed and have
+ -- conflicts and ugly URLs and other issues later.
+ let isAsciiLetter c = 'a' <= c && c <= 'z' || 'A' <= c && c <=
'Z'
+ first = isAsciiLetter
+ rest c = isAsciiLetter c || isDigit c || c `elem` ("-._"
:: String)
+ validnick t =
+ case T.uncons t of
+ Just (c, r) -> first c && T.all rest r
+ Nothing -> False
+ msg :: Text
+ msg = "The first character must be a letter, and every
other character\
+ \ must be a letter, a digit, ‘.’ (period) ,
‘-’ (dash) or ‘_’\
+ \ (underscore)."
+ in checkBool validnick msg textField
+
createUserForm :: Maybe Text
-> Form (Text
,Text
+ ,Text
,Maybe Text
,Maybe Text
,Maybe Text
,Maybe Text
)
createUserForm ident extra = do
+
(identRes, identView) <- mreq textField "" ident
-- we use "passphrase" usually, but passwordField is Yesod term
(passph1Res, passph1View) <- mreq passwordField "" Nothing
(passph2Res, passph2View) <- mreq passwordField "" Nothing
+ (nickRes, nickView) <- mreq nickField "" Nothing
(nameRes, nameView) <- mopt textField "" Nothing
(emailRes, emailView) <- mopt emailField "" Nothing
(avatarRes, avatarView) <- mopt textField "" Nothing
- (nickRes, nickView) <- mopt textField "" Nothing
+ (ircNickRes, ircNickView) <- mopt textField "" Nothing
let view = $(widgetFile "auth/create-user-form")
passphRes = case (passph1Res, passph2Res) of
@@ -54,15 +77,16 @@ createUserForm ident extra = do
(FormSuccess _, x) -> x
(x, _) -> x
- result = (,,,,,) <$> identRes <*> passphRes <*> nameRes
- <*> emailRes <*> avatarRes <*> nickRes
+ result = (,,,,,,) <$> identRes <*> passphRes <*> nickRes
<*> nameRes
+ <*> emailRes <*> avatarRes <*> ircNickRes
return (result, view)
editUserForm :: Maybe User -> Form UserUpdate
editUserForm muser = renderBootstrap3 BootstrapBasicForm $
UserUpdate
- <$> aopt' textField "Public Name" (userName <$> muser)
+ <$> areq' nickField "Public unique nickname" (userNick <$>
muser)
+ <*> aopt' textField "Public Name" (userName <$> muser)
<*> aopt' textField "Avatar image (link)" (userAvatar <$>
muser)
<*> aopt' emailField "Email (not shown publicly)"
(userEmail <$> muser)
<*> aopt' textField "IRC nick @freenode.net" (userIrcNick
<$> muser)
@@ -103,7 +127,8 @@ establishUserForm =
previewUserForm :: User -> Form UserUpdate
previewUserForm User{..} = renderBootstrap3 BootstrapBasicForm $
UserUpdate
- <$> aopt hiddenField "" (Just userName)
+ <$> areq hiddenField "" (Just userNick)
+ <*> aopt hiddenField "" (Just userName)
<*> aopt hiddenField "" (Just userAvatar)
<*> aopt hiddenField "" (Just userEmail)
<*> aopt hiddenField "" (Just userIrcNick)
@@ -148,7 +173,7 @@ userNameWidget user_id = do
Nothing -> [whamlet|deleted user|]
Just user ->
[whamlet|
- <a href=@{UserR user_id}>
+ <a href=@{UserR $ userNick user}>
#{userDisplayName (Entity user_id user)}
|]
diff --git a/templates/application.hamlet
b/templates/application.hamlet
index a1cc750..ddd9fb1 100644
--- a/templates/application.hamlet
+++ b/templates/application.hamlet
@@ -4,7 +4,7 @@
<td>
Account:
<td>
- <a href=@{UserR (volunteerApplicationUser application)}>
+ <a href=@{UserR $ userNick $ entityVal user}>
#{userDisplayName user}
<tr>
diff --git a/templates/auth/create-user-form.hamlet
b/templates/auth/create-user-form.hamlet
index 5a2972f..5698206 100644
--- a/templates/auth/create-user-form.hamlet
+++ b/templates/auth/create-user-form.hamlet
@@ -9,7 +9,7 @@
<tr>
<td>
<label for=#{fvId identView}>
- Account name (private, used for logging in):
+ Account name (private, used only for logging in):
<td>
^{fvInput identView}
<tr>
@@ -26,6 +26,12 @@
^{fvInput passph2View}
<tr>
<td>
+ <label for=#{fvId nickView}>
+ Unique nickname (public, required):
+ <td>
+ ^{fvInput nickView}
+ <tr>
+ <td>
<label for=#{fvId nameView}>
Name (public, optional):
<td>
@@ -44,7 +50,7 @@
^{fvInput avatarView}
<tr>
<td>
- <label for=#{fvId nickView}>
+ <label for=#{fvId ircNickView}>
IRC Nick (irc.freenode.net, optional):
<td>
- ^{fvInput nickView}
+ ^{fvInput ircNickView}
diff --git a/templates/comment.hamlet b/templates/comment.hamlet
index 97db8ce..febbb70 100644
--- a/templates/comment.hamlet
+++ b/templates/comment.hamlet
@@ -5,14 +5,14 @@
<span .p-name>
#{userDisplayName (Entity user_id user)}
$else
- <a .u-url .p-name href=@{UserR user_id}>
+ <a .u-url .p-name href=@{UserR $ userNick user}>
$maybe author_avatar <- userAvatar user
<img .u-photo .small_avatar src=#{author_avatar}> #
#{userDisplayName (Entity user_id user)}
$if can_establish
<div .comment-head-item>
- <a href=@{UserR user_id}>
+ <a href=@{UserR $ userNick user}>
(establish user)
$with ts <- fromMaybe (commentCreatedTs comment)
(commentApprovedTs comment)
@@ -65,7 +65,8 @@
claimed
^{renderTime (ticketClaimingTs claim)}
by
- <a href=@{UserR claiming_user_id}>#{userDisplayName
$ Entity claiming_user_id claiming_user}#
+ <a href=@{UserR $ userNick claiming_user}>
+ #{userDisplayName $ Entity claiming_user_id
claiming_user}#
$maybe note <- ticketClaimingNote claim
: #{note}
diff --git a/templates/default/navbar.hamlet
b/templates/default/navbar.hamlet
index 6b4da61..4073beb 100644
--- a/templates/default/navbar.hamlet
+++ b/templates/default/navbar.hamlet
@@ -20,22 +20,23 @@
<button type=submit>go
<ul .right .break4>
<li>
- $maybe Entity uid user <- maybeUser
- $with name <- fromMaybe (userIdent user) $ userName user
- <div .ddown>
- <a href .ddown-toggle .user>#{name}
- <ul>
- <li>
- <a href=@{HomeR} :active HomeR:.active>Dashboard
- <li>
- <a href=@{UserR uid} :active (UserR
uid):.active>Profile
- <li>
- <a href=@{UTransactionsR} :active
UTransactionsR:.active>
- Transactions
- <li>
- <a href=@{UNotificationsR} :active
UNotificationsR:.active>
- Notifications
- <li>
- <a href=@{AuthR LogoutR}>Log Out
+ $maybe Entity _uid user <- maybeUser
+ $with name <- fromMaybe (userNick user) $ userName user
+ $with nick <- userNick user
+ <div .ddown>
+ <a href .ddown-toggle .user>#{name}
+ <ul>
+ <li>
+ <a href=@{HomeR} :active HomeR:.active>Dashboard
+ <li>
+ <a href=@{UserR nick} :active (UserR
nick):.active>Profile
+ <li>
+ <a href=@{UTransactionsR} :active
UTransactionsR:.active>
+ Transactions
+ <li>
+ <a href=@{UNotificationsR} :active
UNotificationsR:.active>
+ Notifications
+ <li>
+ <a href=@{AuthR LogoutR}>Log Out
$nothing
<a href=@{AuthR LoginR} :authActive:.active>Log In
diff --git a/templates/invite.hamlet b/templates/invite.hamlet
index 1356c39..9543aeb 100644
--- a/templates/invite.hamlet
+++ b/templates/invite.hamlet
@@ -65,12 +65,12 @@ $else
<th>Info
<th>Role
<th>Code
- $forall Entity _ invite <- outstanding_invites
+ $forall (Entity _ invite, Value nick) <- outstanding_invites
<tr>
<td>^{renderTime (inviteCreatedTs invite)}
$with user_id <- inviteUser invite
<td>
- <a href=@{UserR user_id}>
+ <a href=@{UserR nick}>
#{format_inviter user_id}
<td>#{inviteTag invite}
<td>#{roleAbbrev (inviteRole invite)}
@@ -89,13 +89,13 @@ $else
<th>Info
<th>Role
<th>Code
- $forall Entity _ invite <- redeemed_invites
+ $forall (Entity _ invite, Value nick) <- redeemed_invites
<tr>
<td>^{renderTime (fromMaybe now (inviteRedeemedTs invite))}
<td>#{format_user (inviteRedeemedBy invite)}
$with user_id <- inviteUser invite
<td>
- <a href=@{UserR user_id}>
+ <a href=@{UserR nick}>
#{format_inviter user_id}
<td>#{inviteTag invite}
diff --git a/templates/navbar.hamlet b/templates/navbar.hamlet
index 78dc98a..b525fff 100644
--- a/templates/navbar.hamlet
+++ b/templates/navbar.hamlet
@@ -17,9 +17,9 @@
$else
<span .glyphicon .glyphicon-envelope>
- $with name <- fromMaybe (userIdent user) $ userName user
+ $with name <- fromMaybe (userNick user) $ userName user
<li>
- <a href=@{UserR user_id}>#{name}
+ <a href=@{UserR $ userNick user}>#{name}
<li>
<a href=@{AuthR LogoutR}>Log Out
$nothing
@@ -42,9 +42,9 @@
#{num_unread_notifs}
$else
<span .glyphicon .glyphicon-envelope>
- $with name <- fromMaybe (userIdent user) $ userName user
+ $with name <- fromMaybe (userNick user) $ userName user
<li>
- <a href=@{UserR user_id}>#{name}
+ <a href=@{UserR $ userNick user}>#{name}
<li>
<a href=@{AuthR LogoutR}>Log Out
$nothing
diff --git a/templates/project_patrons.hamlet
b/templates/project_patrons.hamlet
index e739755..98cacdf 100644
--- a/templates/project_patrons.hamlet
+++ b/templates/project_patrons.hamlet
@@ -8,7 +8,7 @@ $else
$forall (pledge, user) <- pledges
<tr>
<td>
- <a href=@{UserR (entityKey user)}>
+ <a href=@{UserR $ userNick $ entityVal user}>
#{userDisplayName user}
<td>
#{show $ millMilray $ pledgeFundedShares $ entityVal
pledge}
diff --git a/templates/project_transactions.hamlet
b/templates/project_transactions.hamlet
index f402a84..2f69858 100644
--- a/templates/project_transactions.hamlet
+++ b/templates/project_transactions.hamlet
@@ -33,7 +33,7 @@ $else
$maybe other_account_id <- getOtherAccount
transaction
$case M.lookup other_account_id account_map
$of Just (Right user)
- <a href=@{UserR $ entityKey user}>
+ <a href=@{UserR $ userNick $ entityVal user}>
#{userDisplayName user}
$of Just (Left project)
diff --git a/templates/sponsors.hamlet b/templates/sponsors.hamlet
index 5981a7f..1645db9 100644
--- a/templates/sponsors.hamlet
+++ b/templates/sponsors.hamlet
@@ -24,16 +24,16 @@
<a href="https://www.alephobjects.com/";>
Aleph Objects, Inc.
<li>
- <a href=@{UserR (toSqlKey 335)}>
+ <a href=@{UserByIdR (toSqlKey 335)}>
Denver Bohling
<li>
- <a href=@{UserR (toSqlKey 213)}>
+ <a href=@{UserByIdR (toSqlKey 213)}>
Philip Horger
<li>
- <a href=@{UserR (toSqlKey 380)}>
+ <a href=@{UserByIdR (toSqlKey 380)}>
jamessan
<li>
- <a href=@{UserR (toSqlKey 551)}>
+ <a href=@{UserByIdR (toSqlKey 551)}>
Tanu Kaskinen
<li>
<a href="http://linuxfund.org/";>
@@ -41,12 +41,12 @@
<li>
Pat McGee
<li>
- <a href=@{UserR (toSqlKey 529)}>
+ <a href=@{UserByIdR (toSqlKey 529)}>
Tomasz Muras
<li>
Paul Phillips
<li>
- <a href=@{UserR (toSqlKey 31)}>
+ <a href=@{UserByIdR (toSqlKey 31)}>
Kate & Ira Pohl
<h2 .text-center>General pre-launch donors
@@ -60,29 +60,29 @@
<li>
Chris Aniszczyk
<li>
- <a href=@{UserR (toSqlKey 503)}>
+ <a href=@{UserByIdR (toSqlKey 503)}>
Jorge Aranda
<li>
- <a href=@{UserR (toSqlKey 527)}>
+ <a href=@{UserByIdR (toSqlKey 527)}>
Pierre Arlais, Bearstech
<li>
- <a href=@{UserR (toSqlKey 869)}>
+ <a href=@{UserByIdR (toSqlKey 869)}>
Christopher Armstrong
<li>
- <a href=@{UserR (toSqlKey 876)}>
+ <a href=@{UserByIdR (toSqlKey 876)}>
Xavier Antoviaque, OpenCraft
<li>
- <a href=@{UserR (toSqlKey 868)}>
+ <a href=@{UserByIdR (toSqlKey 868)}>
Artyom
<li>
- <a href=@{UserR (toSqlKey 17)}>
+ <a href=@{UserByIdR (toSqlKey 17)}>
Greg Austic
<li>
Autious
<li>
Kenneth Ballenegger
<li>
- <a href=@{UserR (toSqlKey 866)}>
+ <a href=@{UserByIdR (toSqlKey 866)}>
Moritz Bartl
<li>
Brennen Bearnes
@@ -93,18 +93,18 @@
<li>
Nick Barry
<li>
- <a href=@{UserR (toSqlKey 520)}>
+ <a href=@{UserByIdR (toSqlKey 520)}>
Ingo Blechschmidt
<li>
- <a href=@{UserR (toSqlKey 560)}>
+ <a href=@{UserByIdR (toSqlKey 560)}>
Eduard Bopp
<li>
- <a href=@{UserR (toSqlKey 464)}>
+ <a href=@{UserByIdR (toSqlKey 464)}>
Nathan Bouscal
<li>
Jeremy Bowers
<li>
- <a href=@{UserR (toSqlKey 304)}>
+ <a href=@{UserByIdR (toSqlKey 304)}>
Bret Comnes
<li>
Tim Bunce
@@ -113,21 +113,21 @@
<li>
Lee Butts
<li>
- <a href=@{UserR (toSqlKey 883)}>
+ <a href=@{UserByIdR (toSqlKey 883)}>
Javier Merino Cacho
<li>
- <a href=@{UserR (toSqlKey 762)}>
+ <a href=@{UserByIdR (toSqlKey 762)}>
Scott Calvert & family
<li>
Mike Chaberski
<li>
- <a href=@{UserR (toSqlKey 863)}>
+ <a href=@{UserByIdR (toSqlKey 863)}>
Jacob Chapman
<li>
- <a href=@{UserR (toSqlKey 337)}>
+ <a href=@{UserByIdR (toSqlKey 337)}>
Chato
<li>
- <a href=@{UserR (toSqlKey 284)}>
+ <a href=@{UserByIdR (toSqlKey 284)}>
Paul Chiusano
<li>
Jesper Cockx
@@ -142,34 +142,34 @@
<li>
Debian KDE
<li>
- <a href=@{UserR (toSqlKey 393)}>
+ <a href=@{UserByIdR (toSqlKey 393)}>
Jeroen Dekkers
<li>
Holger Dell
<li>
- <a href=@{UserR (toSqlKey 362)}>
+ <a href=@{UserByIdR (toSqlKey 362)}>
Sebastian Dröge
<li>
<a href="http://andrewdurham.com/";>
Andrew Durham
<li>
- <a href=@{UserR (toSqlKey 397)}>
+ <a href=@{UserByIdR (toSqlKey 397)}>
Christoph Egger
<li>
Carol Ann Emerick
<li>
- <a href=@{UserR (toSqlKey 374)}>
+ <a href=@{UserByIdR (toSqlKey 374)}>
Victor Engmark
<li>
Eric Entzel
<li>
- <a href=@{UserR (toSqlKey 315)}>
+ <a href=@{UserByIdR (toSqlKey 315)}>
Kent Fenwick
<li>
- <a href=@{UserR (toSqlKey 629)}>
+ <a href=@{UserByIdR (toSqlKey 629)}>
John Feras
<li>
- <a href=@{UserR (toSqlKey 279)}>
+ <a href=@{UserByIdR (toSqlKey 279)}>
Karl Fogel / QuestionCopyright.org
<li>
<a href="http://fossetcon.org/";>
@@ -188,28 +188,28 @@
<li>
FTL Software
<li>
- <a href=@{UserR (toSqlKey 218)}>
+ <a href=@{UserByIdR (toSqlKey 218)}>
Curtis Gagliardi
<li>
Luis Gasca
<li>
Denver Gingerich
<li>
- <a href=@{UserR (toSqlKey 369)}>
+ <a href=@{UserByIdR (toSqlKey 369)}>
Daniel Glassey
<li>
Brook Heisler
<li>
Raphaël Hertzog
<li>
- <a href=@{UserR (toSqlKey 240)}>
+ <a href=@{UserByIdR (toSqlKey 240)}>
Joey Hess
<li>
Joshua Hoblitt
<li>
Claudio Hoffmann
<li>
- <a href=@{UserR (toSqlKey 349)}>
+ <a href=@{UserByIdR (toSqlKey 349)}>
Thomas Hochstein
<li>
Martin Höcker
@@ -218,117 +218,117 @@
<li>
Lance Holton
<li>
- <a href=@{UserR (toSqlKey 630)}>
+ <a href=@{UserByIdR (toSqlKey 630)}>
hotzeplotz
<li>
- <a href=@{UserR (toSqlKey 982)}>
+ <a href=@{UserByIdR (toSqlKey 982)}>
Antonin Houska
<li>
- <a href=@{UserR (toSqlKey 623)}>
+ <a href=@{UserByIdR (toSqlKey 623)}>
Karl Ove Hufthammer
<li>
Eskild Hustvedt
<li>
- <a href=@{UserR (toSqlKey 779)}>
+ <a href=@{UserByIdR (toSqlKey 779)}>
Iko
<li>
Arya Irani
<li>
- <a href=@{UserR (toSqlKey 371)}>
+ <a href=@{UserByIdR (toSqlKey 371)}>
Geoffrey Irving
<li>
- <a href=@{UserR (toSqlKey 543)}>
+ <a href=@{UserByIdR (toSqlKey 543)}>
Seth de l'Isle
<li>
Ethan Johnson
<li>
H. Ryan Jones
<li>
- <a href=@{UserR (toSqlKey 419)}>
+ <a href=@{UserByIdR (toSqlKey 419)}>
Ollie Jones
<li>
- <a href=@{UserR (toSqlKey 157)}>
+ <a href=@{UserByIdR (toSqlKey 157)}>
Michiel de Jong
<li>
- <a href=@{UserR (toSqlKey 633)}>
+ <a href=@{UserByIdR (toSqlKey 633)}>
Hasen el Judy | حسن الجودي | ハセン
<li>
Alan Keefer
<li>
- <a href=@{UserR (toSqlKey 247)}>
+ <a href=@{UserByIdR (toSqlKey 247)}>
Ian Kelling
<li>
Andrew Klofas
<li>
- <a href=@{UserR (toSqlKey 668)}>
+ <a href=@{UserByIdR (toSqlKey 668)}>
Robert Klotzner
<li>
Fabrice Knevez
<li>
Georg Kolling
<li>
- <a href=@{UserR (toSqlKey 246)}>
+ <a href=@{UserByIdR (toSqlKey 246)}>
Eric Kow
<li>
Alanna Krause
<li>
- <a href=@{UserR (toSqlKey 1019)}>
+ <a href=@{UserByIdR (toSqlKey 1019)}>
Ramana Kumar
<li>
- <a href=@{UserR (toSqlKey 651)}>
+ <a href=@{UserByIdR (toSqlKey 651)}>
Michael F. Lamb
<li>
- <a href=@{UserR (toSqlKey 898)}>
+ <a href=@{UserByIdR (toSqlKey 898)}>
Daniel Landau
<li>
- <a href=@{UserR (toSqlKey 875)}>
+ <a href=@{UserByIdR (toSqlKey 875)}>
Brianna Laugher
<li>
Jean-Pierre Laurin
<li>
Alexander Lang
<li>
- <a href=@{UserR (toSqlKey 524)}>
+ <a href=@{UserByIdR (toSqlKey 524)}>
Kirsten Larsen
<li>
Matt Lee
<li>
- <a href=@{UserR (toSqlKey 510)}>
+ <a href=@{UserByIdR (toSqlKey 510)}>
Nathan Lee
<li>
- <a href=@{UserR (toSqlKey 28)}>
+ <a href=@{UserByIdR (toSqlKey 28)}>
Randall Leeds
<li>
- <a href=@{UserR (toSqlKey 183)}>
+ <a href=@{UserByIdR (toSqlKey 183)}>
Charles Lehner
<li>
- <a href=@{UserR (toSqlKey 454)}>
+ <a href=@{UserByIdR (toSqlKey 454)}>
R. Diaz de Leon
<li>
Federico Leva
<li>
Aaron Levin
<li>
- <a href=@{UserR (toSqlKey 90)}>
+ <a href=@{UserByIdR (toSqlKey 90)}>
Carl Lewis
<li>
- <a href=@{UserR (toSqlKey 167)}>
+ <a href=@{UserByIdR (toSqlKey 167)}>
John A. Lewis
<li>
Katrin Leinweber
<li>
- <a href=@{UserR (toSqlKey 428)}>
+ <a href=@{UserByIdR (toSqlKey 428)}>
Greg Lindahl
<li>
- <a href=@{UserR (toSqlKey 566)}>
+ <a href=@{UserByIdR (toSqlKey 566)}>
Thorbjørn Lindeijer
<li>
- <a href=@{UserR (toSqlKey 40)}>
+ <a href=@{UserByIdR (toSqlKey 40)}>
Mike Linksvayer
<li>
Yun-Mei Lo
<li>
- <a href=@{UserR (toSqlKey 532)}>
+ <a href=@{UserByIdR (toSqlKey 532)}>
Brendan Long
<li>
Hans Lub
@@ -337,24 +337,24 @@
<li>
Magan Adam
<li>
- <a href=@{UserR (toSqlKey 852)}>
+ <a href=@{UserByIdR (toSqlKey 852)}>
Patrick Masson
<li>
- <a href=@{UserR (toSqlKey 564)}>
+ <a href=@{UserByIdR (toSqlKey 564)}>
Martin Mauch
<li>
- <a href=@{UserR (toSqlKey 341)}>
+ <a href=@{UserByIdR (toSqlKey 341)}>
Francois Marier
<li>
- <a href=@{UserR (toSqlKey 152)}>
+ <a href=@{UserByIdR (toSqlKey 152)}>
Sean McGregor
<li>
- <a href=@{UserR (toSqlKey 903)}>
+ <a href=@{UserByIdR (toSqlKey 903)}>
Ewen McNeill
<li>
Jan Mechtel
<li>
- <a href=@{UserR (toSqlKey 354)}>
+ <a href=@{UserByIdR (toSqlKey 354)}>
Simon Michael
<li>
Florin Mihaila
@@ -365,29 +365,29 @@
<li>
Havard Moen
<li>
- <a href=@{UserR (toSqlKey 384)}>
+ <a href=@{UserByIdR (toSqlKey 384)}>
Ramakrishnan Muthukrishnan
<li>
- <a href=@{UserR (toSqlKey 556)}>
+ <a href=@{UserByIdR (toSqlKey 556)}>
Lauro Gripa Neto
<li>
- <a href=@{UserR (toSqlKey 340)}>
+ <a href=@{UserByIdR (toSqlKey 340)}>
Perry Nguyen
<li>
- <a href=@{UserR (toSqlKey 828)}>
+ <a href=@{UserByIdR (toSqlKey 828)}>
Nmlgc
<li>
Lachlan O'Dea
<li>
- <a href=@{UserR (toSqlKey 636)}>
+ <a href=@{UserByIdR (toSqlKey 636)}>
Robert Orzanna
<li>
- <a href=@{UserR (toSqlKey 467)}>
+ <a href=@{UserByIdR (toSqlKey 467)}>
Étienne Vallette d'Osia
<li>
Tom Paluck
<li>
- <a href=@{UserR (toSqlKey 232)}>
+ <a href=@{UserByIdR (toSqlKey 232)}>
Răzvan Panda
<li>
Fabian Peters
@@ -396,45 +396,45 @@
<li>
Karl Pietrzak
<li>
- <a href=@{UserR (toSqlKey 347)}>
+ <a href=@{UserByIdR (toSqlKey 347)}>
Steve Phillips / elimisteve
<li>
- <a href=@{UserR (toSqlKey 873)}>
+ <a href=@{UserByIdR (toSqlKey 873)}>
Pini
<li>
- <a href=@{UserR (toSqlKey 877)}>
+ <a href=@{UserByIdR (toSqlKey 877)}>
Josh Poimboeuf
<li>
- <a href=@{UserR (toSqlKey 230)}>
+ <a href=@{UserByIdR (toSqlKey 230)}>
Timotheus Pokorra
<li>
Michał Politowski
<li>
- <a href=@{UserR (toSqlKey 507)}>
+ <a href=@{UserByIdR (toSqlKey 507)}>
Shuwen Qian
<li>
Aaron Quamme
<li>
- <a href=@{UserR (toSqlKey 879)}>
+ <a href=@{UserByIdR (toSqlKey 879)}>
Lane Rasberry
<li>
Olav Reinert
<li>
Dan Revel
<li>
- <a href=@{UserR (toSqlKey 446)}>
+ <a href=@{UserByIdR (toSqlKey 446)}>
Kevin Riggle
<li>
- <a href=@{UserR (toSqlKey 437)}>
+ <a href=@{UserByIdR (toSqlKey 437)}>
Matt Ritter
<li>
- <a href=@{UserR (toSqlKey 106)}>
+ <a href=@{UserByIdR (toSqlKey 106)}>
Sage Ross
<li>
<a href="http://www.roundware.org/";>
Roundware.org
<li>
- <a href=@{UserR (toSqlKey 367)}>
+ <a href=@{UserByIdR (toSqlKey 367)}>
Hugo Roy (FSFE)
<li>
Noé Rubinstein
@@ -443,63 +443,63 @@
<li>
Marc Saegesser
<li>
- <a href=@{UserR (toSqlKey 95)}>
+ <a href=@{UserByIdR (toSqlKey 95)}>
Chris Sakkas, livinglibre.com
<li>
Olli Savolainen
<li>
Tobias Schachman
<li>
- <a href=@{UserR (toSqlKey 867)}>
+ <a href=@{UserByIdR (toSqlKey 867)}>
Brian Schroeder
<li>
- <a href=@{UserR (toSqlKey 459)}>
+ <a href=@{UserByIdR (toSqlKey 459)}>
Sean Seefried
<li>
Paul Sexton
<li>
Kendrick Shaw
<li>
- <a href=@{UserR (toSqlKey 501)}>
+ <a href=@{UserByIdR (toSqlKey 501)}>
Howard Lewis Ship
<li>
- <a href=@{UserR (toSqlKey 870)}>
+ <a href=@{UserByIdR (toSqlKey 870)}>
Juan Raphael Diaz Simões
<li>
- <a href=@{UserR (toSqlKey 418)}>
+ <a href=@{UserByIdR (toSqlKey 418)}>
Brandon Skari
<li>
Don Smith
<li>
- <a href=@{UserR (toSqlKey 634)}>
+ <a href=@{UserByIdR (toSqlKey 634)}>
Leon P Smith
<li>
- <a href=@{UserR (toSqlKey 544)}>
+ <a href=@{UserByIdR (toSqlKey 544)}>
Nick Smith
<li>
Jim Snow
<li>
Khaled Soliman
<li>
- <a href=@{UserR (toSqlKey 316)}>
+ <a href=@{UserByIdR (toSqlKey 316)}>
Rodrigo Souto
<li>
- <a href=@{UserR (toSqlKey 297)}>
+ <a href=@{UserByIdR (toSqlKey 297)}>
Adam Souzis
<li>
Adam Spitz
<li>
Charles Stanhope
<li>
- <a href=@{UserR (toSqlKey 606)}>
+ <a href=@{UserByIdR (toSqlKey 606)}>
Stephen Starkey
<li>
- <a href=@{UserR (toSqlKey 482)}>
+ <a href=@{UserByIdR (toSqlKey 482)}>
Startifact
<li>
statuszer0
<li>
- <a href=@{UserR (toSqlKey 568)}>
+ <a href=@{UserByIdR (toSqlKey 568)}>
Bob Steffes
<li>
Hugh Stimson
@@ -512,10 +512,10 @@
<li>
Zachary Tellman
<li>
- <a href=@{UserR (toSqlKey 874)}>
+ <a href=@{UserByIdR (toSqlKey 874)}>
Seth Tisue
<li>
- <a href=@{UserR (toSqlKey 263)}>
+ <a href=@{UserByIdR (toSqlKey 263)}>
Frank Thomas
<li>
Greg Tomei
@@ -524,7 +524,7 @@
<li>
Christian Uhl
<li>
- <a href=@{UserR (toSqlKey 423)}>
+ <a href=@{UserByIdR (toSqlKey 423)}>
Vakranas
<li>
Timothy Vollmer
@@ -533,54 +533,54 @@
<li>
Markus Vuorio (Maakuth)
<li>
- <a href=@{UserR (toSqlKey 590)}>
+ <a href=@{UserByIdR (toSqlKey 590)}>
Tobias Gulbrandsen Waaler
<li>
- <a href=@{UserR (toSqlKey 614)}>
+ <a href=@{UserByIdR (toSqlKey 614)}>
Albert Wavering
<li>
- <a href=@{UserR (toSqlKey 640)}>
+ <a href=@{UserByIdR (toSqlKey 640)}>
Christopher Webber, GNU MediaGoblin
<li>
- <a href=@{UserR (toSqlKey 351)}>
+ <a href=@{UserByIdR (toSqlKey 351)}>
Stephen Paul Weber (singpolyma)
<li>
- <a href=@{UserR (toSqlKey 399)}>
+ <a href=@{UserByIdR (toSqlKey 399)}>
Patrick Weemeeuw
<li>
David Whitman
<li>
- <a href=@{UserR (toSqlKey 495)}>
+ <a href=@{UserByIdR (toSqlKey 495)}>
Kevin Wichmann
<li>
- <a href=@{UserR (toSqlKey 458)}>
+ <a href=@{UserByIdR (toSqlKey 458)}>
Alex Willemsma
<li>
Carl Witty
<li>
- <a href=@{UserR (toSqlKey 23)}>
+ <a href=@{UserByIdR (toSqlKey 23)}>
Barry & Devorah Wolf
<li>
- <a href=@{UserR (toSqlKey 321)}>
+ <a href=@{UserByIdR (toSqlKey 321)}>
Nicolas Wormser
<li>
- <a href=@{UserR (toSqlKey 415)}>
+ <a href=@{UserByIdR (toSqlKey 415)}>
Thomas Wrenn
<li>
- <a href=@{UserR (toSqlKey 488)}>
+ <a href=@{UserByIdR (toSqlKey 488)}>
Daniel Yokomizo
<li>
- <a href=@{UserR (toSqlKey 272)}>
+ <a href=@{UserByIdR (toSqlKey 272)}>
Brent Yorgey
<li>
Philip Young
<li>
- <a href=@{UserR (toSqlKey 908)}>
+ <a href=@{UserByIdR (toSqlKey 908)}>
Milan Zamazal
<li>
Shafiq Akram Zakaria
<li>
- <a href=@{UserR (toSqlKey 406)}>
+ <a href=@{UserByIdR (toSqlKey 406)}>
Massimo Zaniboni
<li>
Jan Zernisch
diff --git a/templates/tag.hamlet b/templates/tag.hamlet
index 532be93..842dcff 100644
--- a/templates/tag.hamlet
+++ b/templates/tag.hamlet
@@ -10,7 +10,7 @@ $else
$forall (user, votes) <- user_votes
<tr>
<td>
- <a href=@{UserR (entityKey user)}>
+ <a href=@{UserR $ userNick $ entityVal user}>
#{userDisplayName user}
<td>
diff --git a/templates/user.hamlet b/templates/user.hamlet
index db580c4..5dce7a5 100644
--- a/templates/user.hamlet
+++ b/templates/user.hamlet
@@ -37,7 +37,7 @@ $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 user_id}>
+ <form method=POST action=@{UserR $ userNick user}>
<button>resend verification email
<br>
$maybe nick <- userIrcNick user
diff --git a/templates/user_discuss.hamlet
b/templates/user_discuss.hamlet
index 9df64ed..6a7ee23 100644
--- a/templates/user_discuss.hamlet
+++ b/templates/user_discuss.hamlet
@@ -5,7 +5,7 @@ $nothing
<div .page-toolbox>
<div .page-tool>
- <a href=@{UserR user_id}>back to user profile
+ <a href=@{UserR $ userNick user}>back to user profile
$maybe _ <- closedView
<div .page-tool>
<a href=@{UserDiscussionR user_id}>
diff --git a/templates/user_discussion_wrapper.hamlet
b/templates/user_discussion_wrapper.hamlet
index 60fc5da..f4b9843 100644
--- a/templates/user_discussion_wrapper.hamlet
+++ b/templates/user_discussion_wrapper.hamlet
@@ -2,6 +2,6 @@
<div .page-tool>
<a href=@{UserDiscussionR user_id}> back to full discussion
<div .page-tool>
- <a href=@{UserR user_id}> back to user page
+ <a href=@{UserR $ userNick user}> back to user page
^{widget}
diff --git a/templates/user_tickets.hamlet
b/templates/user_tickets.hamlet
index d4dd78a..303c9f6 100644
--- a/templates/user_tickets.hamlet
+++ b/templates/user_tickets.hamlet
@@ -76,7 +76,7 @@
<td>
$maybe user_entity <- u
- <a href=@{UserR $ entityKey user_entity}>
+ <a href=@{UserR $ userNick $ entityVal user_entity}>
#{userDisplayName user_entity}
<td>
diff --git a/templates/users.hamlet b/templates/users.hamlet
index 56f7097..1721efe 100644
--- a/templates/users.hamlet
+++ b/templates/users.hamlet
@@ -24,7 +24,7 @@
$forall (_, user) <- users
<tr>
<td>
- <a href=@{UserR $ entityKey user}>
+ <a href=@{UserR $ userNick $ entityVal user}>
#{userDisplayName user}
<td>
$maybe nick <- userIrcNick $ entityVal user
diff --git a/templates/who.hamlet b/templates/who.hamlet
index ead591f..65004ce 100644
--- a/templates/who.hamlet
+++ b/templates/who.hamlet
@@ -1,11 +1,11 @@
<h1>
<div .text-center> #{projectName project} Team
-$forall Entity user_id user <- members
+$forall Entity _uid user <- members
<hr>
<div .row>
<div .bio_name .col-sm-3>
- <a href=@{UserR user_id}>
+ <a href=@{UserR $ userNick user}>
#{userShortName user}
<br>
$maybe avatar <- userAvatar user
diff --git a/templates/wiki_history.hamlet
b/templates/wiki_history.hamlet
index d6ba673..7182860 100644
--- a/templates/wiki_history.hamlet
+++ b/templates/wiki_history.hamlet
@@ -14,7 +14,7 @@
<td>
$with user_id <- wikiEditUser edit
$maybe user <- M.lookup user_id users
- <a href=@{UserR user_id}>
+ <a href=@{UserR $ userNick $ entityVal user}>
#{userDisplayName user}
<td>
$maybe comment <- wikiEditComment edit
diff --git a/tests/TestImport.hs b/tests/TestImport.hs
index 0a3130e..79d80f7 100644
--- a/tests/TestImport.hs
+++ b/tests/TestImport.hs
@@ -301,7 +301,7 @@ editWiki project language page content comment
= do
establish :: UserId -> YesodExample App ()
establish user_id = do
- get200 $ UserR user_id
+ get200 $ UserByIdR user_id
withStatus 303 False $ request $ do
addToken
--
1.9.1
_______________________________________________
Dev mailing list
Dev@lists.snowdrift.coop
https://lists.snowdrift.coop/mailman/listinfo/dev
