Put roles under sharers, now groups' roles can be managed too

2016-06-06 19:41:22 +00:00 · 2016-06-06 19:41:22 +00:00 · 23c06c535a
commit 23c06c535a
parent f2e4bb4291
14 changed files with 195 additions and 159 deletions
--- a/config/routes
+++ b/config/routes
@ -50,17 +50,17 @@
 /k/!new                                      KeyNewR           GET
 /k/#KyIdent                                  KeyR              GET DELETE POST

-/rr                                          RepoRolesR        GET POST
-/rr/!new                                     RepoRoleNewR      GET
-/rr/#RlIdent                                 RepoRoleR         GET DELETE POST
-/rr/#RlIdent/a                               RepoRoleOpsR      GET POST
-/rr/#RlIdent/a/!new                          RepoRoleOpNewR    GET
+/s/#ShrIdent/rr                              RepoRolesR        GET POST
+/s/#ShrIdent/rr/!new                         RepoRoleNewR      GET
+/s/#ShrIdent/rr/#RlIdent                     RepoRoleR         GET DELETE POST
+/s/#ShrIdent/rr/#RlIdent/a                   RepoRoleOpsR      GET POST
+/s/#ShrIdent/rr/#RlIdent/a/!new              RepoRoleOpNewR    GET

-/pr                                          ProjectRolesR     GET POST
-/pr/!new                                     ProjectRoleNewR   GET
-/pr/#RlIdent                                 ProjectRoleR      GET DELETE POST
-/pr/#RlIdent/a                               ProjectRoleOpsR   GET POST
-/pr/#RlIdent/a/!new                          ProjectRoleOpNewR GET
+/s/#ShrIdent/pr                              ProjectRolesR     GET POST
+/s/#ShrIdent/pr/!new                         ProjectRoleNewR   GET
+/s/#ShrIdent/pr/#RlIdent                     ProjectRoleR      GET DELETE POST
+/s/#ShrIdent/pr/#RlIdent/a                   ProjectRoleOpsR   GET POST
+/s/#ShrIdent/pr/#RlIdent/a/!new              ProjectRoleOpNewR GET

 -- ----------------------------------------------------------------------------
 -- Projects
--- a/src/Vervis/Foundation.hs
+++ b/src/Vervis/Foundation.hs
@ -120,57 +120,57 @@ instance Yesod App where

    -- Who can access which pages.
    isAuthorized r w = case (r, w) of
-        (GroupsR                 , True) -> personAny
-        (GroupNewR               , _   ) -> personAny
-        (GroupMembersR grp       , True) -> groupRole (== GRAdmin) grp
-        (GroupMemberNewR grp     , _   ) -> groupRole (== GRAdmin) grp
-        (GroupMemberR grp _memb  , True) -> groupRole (== GRAdmin) grp
+        (GroupsR                   , True) -> personAny
+        (GroupNewR                 , _   ) -> personAny
+        (GroupMembersR grp         , True) -> groupAdmin grp
+        (GroupMemberNewR grp       , _   ) -> groupAdmin grp
+        (GroupMemberR grp _memb    , True) -> groupAdmin grp

-        (KeysR                   , _   ) -> personAny
-        (KeyR _key               , _   ) -> personAny
-        (KeyNewR                 , _   ) -> personAny
+        (KeysR                     , _   ) -> personAny
+        (KeyR _key                 , _   ) -> personAny
+        (KeyNewR                   , _   ) -> personAny

-        (RepoRolesR              , _   ) -> personAny
-        (RepoRoleNewR            , _   ) -> personAny
-        (RepoRoleR _rl           , _   ) -> personAny
-        (RepoRoleOpsR _rl        , _   ) -> personAny
-        (RepoRoleOpNewR _rl      , _   ) -> personAny
+        (RepoRolesR shr            , _   ) -> personOrGroupAdmin shr
+        (RepoRoleNewR shr          , _   ) -> personOrGroupAdmin shr
+        (RepoRoleR shr _rl         , _   ) -> personOrGroupAdmin shr
+        (RepoRoleOpsR shr _rl      , _   ) -> personOrGroupAdmin shr
+        (RepoRoleOpNewR shr _rl    , _   ) -> personOrGroupAdmin shr

-        (ProjectRolesR           , _   ) -> personAny
-        (ProjectRoleNewR         , _   ) -> personAny
-        (ProjectRoleR _rl        , _   ) -> personAny
-        (ProjectRoleOpsR _rl     , _   ) -> personAny
-        (ProjectRoleOpNewR _rl   , _   ) -> personAny
+        (ProjectRolesR shr         , _   ) -> personOrGroupAdmin shr
+        (ProjectRoleNewR shr       , _   ) -> personOrGroupAdmin shr
+        (ProjectRoleR shr _rl      , _   ) -> personOrGroupAdmin shr
+        (ProjectRoleOpsR shr _rl   , _   ) -> personOrGroupAdmin shr
+        (ProjectRoleOpNewR shr _rl , _   ) -> personOrGroupAdmin shr

-        (ReposR shar             , True) -> person shar
-        (RepoNewR user           , _   ) -> person user
-        (RepoR shar _            , True) -> person shar
-        (RepoEditR shr _rp       , _   ) -> person shr
-        (RepoDevsR shr _rp       , _   ) -> person shr
-        (RepoDevNewR shr _rp     , _   ) -> person shr
-        (RepoDevR shr _rp _dev   , _   ) -> person shr
+        (ReposR shar               , True) -> person shar
+        (RepoNewR user             , _   ) -> person user
+        (RepoR shar _              , True) -> person shar
+        (RepoEditR shr _rp         , _   ) -> person shr
+        (RepoDevsR shr _rp         , _   ) -> person shr
+        (RepoDevNewR shr _rp       , _   ) -> person shr
+        (RepoDevR shr _rp _dev     , _   ) -> person shr

-        (ProjectsR shar          , True) -> person shar
-        (ProjectNewR user        , _   ) -> person user
-        (ProjectR shr _prj       , True) -> person shr
-        (ProjectEditR shr _prj   , _   ) -> person shr
+        (ProjectsR shar            , True) -> person shar
+        (ProjectNewR user          , _   ) -> person user
+        (ProjectR shr _prj         , True) -> person shr
+        (ProjectEditR shr _prj     , _   ) -> person shr
        (ProjectDevsR shr _prj     , _   ) -> person shr
        (ProjectDevNewR shr _prj   , _   ) -> person shr
        (ProjectDevR shr _prj _dev , _   ) -> person shr

-        (TicketsR shar _         , True) -> person shar
-        (TicketNewR _ _          , _   ) -> personAny
-        (TicketR user _ _        , True) -> person user
-        (TicketEditR user _ _    , _   ) -> person user
-        (TicketCloseR user _ _   , _   ) -> person user
-        (TicketOpenR user _ _    , _   ) -> person user
-        (TicketClaimR s j _      , _   ) -> projOp ProjOpClaimTicket s j
-        (TicketUnclaimR s j _    , _   ) -> projOp ProjOpUnclaimTicket s j
-        (TicketDiscussionR _ _ _ , True) -> personAny
-        (TicketMessageR _ _ _ _  , True) -> personAny
-        (TicketTopReplyR _ _ _   , _   ) -> personAny
-        (TicketReplyR _ _ _ _    , _   ) -> personAny
-        _                                -> return Authorized
+        (TicketsR shar _           , True) -> person shar
+        (TicketNewR _ _            , _   ) -> personAny
+        (TicketR user _ _          , True) -> person user
+        (TicketEditR user _ _      , _   ) -> person user
+        (TicketCloseR user _ _     , _   ) -> person user
+        (TicketOpenR user _ _      , _   ) -> person user
+        (TicketClaimR s j _        , _   ) -> projOp ProjOpClaimTicket s j
+        (TicketUnclaimR s j _      , _   ) -> projOp ProjOpUnclaimTicket s j
+        (TicketDiscussionR _ _ _   , True) -> personAny
+        (TicketMessageR _ _ _ _    , True) -> personAny
+        (TicketTopReplyR _ _ _     , _   ) -> personAny
+        (TicketReplyR _ _ _ _      , _   ) -> personAny
+        _                                  -> return Authorized
        where
        personAnd
            :: (Entity Person -> Handler AuthResult) -> Handler AuthResult
@ -205,6 +205,43 @@ instance Yesod App where
                        then Authorized
                        else Unauthorized "Not the expected group role"

+        groupAdmin :: ShrIdent -> Handler AuthResult
+        groupAdmin = groupRole (== GRAdmin)
+
+        personOrGroupAdmin :: ShrIdent -> Handler AuthResult
+        personOrGroupAdmin shr = personAnd $ \ (Entity vpid _vp) -> runDB $ do
+            mes <- getBy $ UniqueSharer shr
+            case mes of
+                Nothing             -> return $ Unauthorized "No such sharer"
+                Just (Entity sid _) -> do
+                    mep <- getBy $ UniquePersonIdent sid
+                    case mep of
+                        Just (Entity pid _p) ->
+                            return $ if pid == vpid
+                                then Authorized
+                                else
+                                    Unauthorized
+                                    "Can’t access other people’s roles"
+                        Nothing -> do
+                            meg <- getBy $ UniqueGroup sid
+                            case meg of
+                                Nothing -> do
+                                    $logWarn $
+                                        "Found non-person non-group \
+                                        \sharer: " <> shr2text shr
+                                    return $ Unauthorized "Zombine sharer"
+                                Just (Entity gid _g) -> do
+                                    mem <- getBy $ UniqueGroupMember vpid gid
+                                    return $ case mem of
+                                        Nothing ->
+                                            Unauthorized "Not a group member"
+                                        Just (Entity _mid m) ->
+                                            if groupMemberRole m == GRAdmin
+                                                then Authorized
+                                                else
+                                                    Unauthorized
+                                                    "Not a group admin"
+
        projOp
            :: ProjectOperation -> ShrIdent -> PrjIdent -> Handler AuthResult
        projOp op shr prj = personAnd $ \ (Entity pid _p) -> do
@ -333,17 +370,27 @@ instance YesodBreadcrumbs App where
        KeyNewR                          -> ("New", Just KeysR)
        KeyR key                         -> (ky2text key, Just KeysR)

-        RepoRolesR                       -> ("Repo Roles", Just HomeR)
-        RepoRoleNewR                     -> ("New", Just RepoRolesR)
-        RepoRoleR rl                     -> (rl2text rl, Just RepoRolesR)
-        RepoRoleOpsR rl                  -> ("Operations", Just $ RepoRoleR rl)
-        RepoRoleOpNewR rl                -> ("New", Just $ RepoRoleOpsR rl)
+        RepoRolesR shr                   -> ("Repo Roles", Just $ SharerR shr)
+        RepoRoleNewR shr                 -> ("New", Just $ RepoRolesR shr)
+        RepoRoleR shr rl                 -> (rl2text rl, Just $ RepoRolesR shr)
+        RepoRoleOpsR shr rl              -> ( "Operations"
+                                            , Just $ RepoRoleR shr rl
+                                            )
+        RepoRoleOpNewR shr rl            -> ("New", Just $ RepoRoleOpsR shr rl)

-        ProjectRolesR                    -> ("Project Roles", Just HomeR)
-        ProjectRoleNewR                  -> ("New", Just ProjectRolesR)
-        ProjectRoleR rl                  -> (rl2text rl, Just ProjectRolesR)
-        ProjectRoleOpsR rl               -> ("Operations", Just $ ProjectRoleR rl)
-        ProjectRoleOpNewR rl             -> ("New", Just $ ProjectRoleOpsR rl)
+        ProjectRolesR shr                -> ( "Project Roles"
+                                            , Just $ SharerR shr
+                                            )
+        ProjectRoleNewR shr              -> ("New", Just $ ProjectRolesR shr)
+        ProjectRoleR shr rl              -> ( rl2text rl
+                                            , Just $ ProjectRolesR shr
+                                            )
+        ProjectRoleOpsR shr rl           -> ( "Operations"
+                                            , Just $ ProjectRoleR shr rl
+                                            )
+        ProjectRoleOpNewR shr rl         -> ( "New"
+                                            , Just $ ProjectRoleOpsR shr rl
+                                            )

        ReposR shar                      -> ("Repos", Just $ PersonR shar)
        RepoNewR shar                    -> ("New", Just $ ReposR shar)
--- a/src/Vervis/Handler/Role.hs
+++ b/src/Vervis/Handler/Role.hs
@ -49,21 +49,19 @@ import Yesod.Persist.Core (runDB, getBy404)
 import Vervis.Form.Role
 import Vervis.Foundation
 import Vervis.Model
-import Vervis.Model.Ident (RlIdent, rl2text)
+import Vervis.Model.Ident (ShrIdent, RlIdent, rl2text)
 import Vervis.Settings (widgetFile)

-getRepoRolesR :: Handler Html
-getRepoRolesR = do
-    pid <- requireAuthId
+getRepoRolesR :: ShrIdent -> Handler Html
+getRepoRolesR shr = do
    roles <- runDB $ do
-        person <- getJust pid
-        selectList [RepoRoleSharer ==. personIdent person] []
+        Entity sid _ <- getBy404 $ UniqueSharer shr
+        selectList [RepoRoleSharer ==. sid] []
    defaultLayout $(widgetFile "repo/role/list")

-postRepoRolesR :: Handler Html
-postRepoRolesR = do
-    pid <- requireAuthId
-    sid <- fmap personIdent $ runDB $ getJust pid
+postRepoRolesR :: ShrIdent -> Handler Html
+postRepoRolesR shr = do
+    sid <- fmap entityKey $ runDB $ getBy404 $ UniqueSharer shr
    ((result, widget), enctype) <- runFormPost $ newRepoRoleForm sid
    case result of
        FormSuccess nrr -> do
@ -74,7 +72,7 @@ postRepoRolesR = do
                        , repoRoleDesc   = nrrDesc nrr
                        }
                insert_ role
-            redirect $ RepoRolesR
+            redirect $ RepoRolesR shr
        FormMissing -> do
            setMessage "Field(s) missing"
            defaultLayout $(widgetFile "repo/role/new")
@ -82,53 +80,48 @@ postRepoRolesR = do
            setMessage "Invalid input, see errors below"
            defaultLayout $(widgetFile "repo/role/new")

-getRepoRoleNewR :: Handler Html
-getRepoRoleNewR = do
-    pid <- requireAuthId
-    sid <- fmap personIdent $ runDB $ getJust pid
+getRepoRoleNewR :: ShrIdent -> Handler Html
+getRepoRoleNewR shr = do
+    sid <- fmap entityKey $ runDB $ getBy404 $ UniqueSharer shr
    ((_result, widget), enctype) <- runFormPost $ newRepoRoleForm sid
    defaultLayout $(widgetFile "repo/role/new")

-getRepoRoleR :: RlIdent -> Handler Html
-getRepoRoleR rl = do
-    pid <- requireAuthId
-    sid <- fmap personIdent $ runDB $ getJust pid
-    Entity _rid role <- runDB $ getBy404 $ UniqueRepoRole sid rl
+getRepoRoleR :: ShrIdent -> RlIdent -> Handler Html
+getRepoRoleR shr rl = do
+    Entity _rid role <- runDB $ do
+        Entity sid _ <- getBy404 $ UniqueSharer shr
+        getBy404 $ UniqueRepoRole sid rl
    defaultLayout $(widgetFile "repo/role/one")

-deleteRepoRoleR :: RlIdent -> Handler Html
-deleteRepoRoleR rl = do
-    pid <- requireAuthId
+deleteRepoRoleR :: ShrIdent -> RlIdent -> Handler Html
+deleteRepoRoleR shr rl = do
    runDB $ do
-        person <- getJust pid
-        let sid = personIdent person
+        Entity sid _s <- getBy404 $ UniqueSharer shr
        Entity rid _r <- getBy404 $ UniqueRepoRole sid rl
        delete rid
    setMessage "Role deleted."
-    redirect RepoRolesR
+    redirect $ RepoRolesR shr

-postRepoRoleR :: RlIdent -> Handler Html
-postRepoRoleR rl = do
+postRepoRoleR :: ShrIdent -> RlIdent -> Handler Html
+postRepoRoleR shr rl = do
    mmethod <- lookupPostParam "_method"
    case mmethod of
-        Just "DELETE" -> deleteRepoRoleR rl
+        Just "DELETE" -> deleteRepoRoleR shr rl
        _             -> notFound

-getRepoRoleOpsR :: RlIdent -> Handler Html
-getRepoRoleOpsR rl = do
-    pid <- requireAuthId
+getRepoRoleOpsR :: ShrIdent -> RlIdent -> Handler Html
+getRepoRoleOpsR shr rl = do
    ops <- runDB $ do
-        sid <- personIdent <$> getJust pid
+        Entity sid _s <- getBy404 $ UniqueSharer shr
        Entity rid _r <- getBy404 $ UniqueRepoRole sid rl
        as <- selectList [RepoAccessRole ==. rid] []
        return $ map (repoAccessOp . entityVal) as
    defaultLayout $(widgetFile "repo/role/op/list")

-postRepoRoleOpsR :: RlIdent -> Handler Html
-postRepoRoleOpsR rl = do
-    pid <- requireAuthId
+postRepoRoleOpsR :: ShrIdent -> RlIdent -> Handler Html
+postRepoRoleOpsR shr rl = do
    let getrid = do
-            sid <- personIdent <$> getJust pid
+            Entity sid _ <- getBy404 $ UniqueSharer shr
            fmap entityKey $ getBy404 $ UniqueRepoRole sid rl
    ((result, widget), enctype) <- runFormPost $ newRepoRoleOpForm getrid
    case result of
@ -140,7 +133,7 @@ postRepoRoleOpsR rl = do
                        , repoAccessOp   = op
                        }
                insert_ access
-            redirect $ RepoRoleOpsR rl
+            redirect $ RepoRoleOpsR shr rl
        FormMissing -> do
            setMessage "Field(s) missing"
            defaultLayout $(widgetFile "repo/role/op/new")
@ -148,27 +141,24 @@ postRepoRoleOpsR rl = do
            setMessage "Invalid input, see errors below"
            defaultLayout $(widgetFile "repo/role/op/new")

-getRepoRoleOpNewR :: RlIdent -> Handler Html
-getRepoRoleOpNewR rl = do
-    pid <- requireAuthId
+getRepoRoleOpNewR :: ShrIdent -> RlIdent -> Handler Html
+getRepoRoleOpNewR shr rl = do
    let getrid = do
-            sid <- personIdent <$> getJust pid
+            Entity sid _ <- getBy404 $ UniqueSharer shr
            fmap entityKey $ getBy404 $ UniqueRepoRole sid rl
    ((_result, widget), enctype) <- runFormPost $ newRepoRoleOpForm getrid
    defaultLayout $(widgetFile "repo/role/op/new")

-getProjectRolesR :: Handler Html
-getProjectRolesR = do
-    pid <- requireAuthId
+getProjectRolesR :: ShrIdent -> Handler Html
+getProjectRolesR shr = do
    roles <- runDB $ do
-        person <- getJust pid
-        selectList [ProjectRoleSharer ==. personIdent person] []
+        Entity sid _ <- getBy404 $ UniqueSharer shr
+        selectList [ProjectRoleSharer ==. sid] []
    defaultLayout $(widgetFile "project/role/list")

-postProjectRolesR :: Handler Html
-postProjectRolesR = do
-    pid <- requireAuthId
-    sid <- fmap personIdent $ runDB $ getJust pid
+postProjectRolesR :: ShrIdent -> Handler Html
+postProjectRolesR shr = do
+    sid <- fmap entityKey $ runDB $ getBy404 $ UniqueSharer shr
    ((result, widget), enctype) <- runFormPost $ newProjectRoleForm sid
    case result of
        FormSuccess npr -> do
@ -179,7 +169,7 @@ postProjectRolesR = do
                        , projectRoleDesc   = nprDesc npr
                        }
                insert_ role
-            redirect $ ProjectRolesR
+            redirect $ ProjectRolesR shr
        FormMissing -> do
            setMessage "Field(s) missing"
            defaultLayout $(widgetFile "project/role/new")
@ -187,53 +177,48 @@ postProjectRolesR = do
            setMessage "Invalid input, see errors below"
            defaultLayout $(widgetFile "project/role/new")

-getProjectRoleNewR :: Handler Html
-getProjectRoleNewR = do
-    pid <- requireAuthId
-    sid <- fmap personIdent $ runDB $ getJust pid
+getProjectRoleNewR :: ShrIdent -> Handler Html
+getProjectRoleNewR shr = do
+    sid <- fmap entityKey $ runDB $ getBy404 $ UniqueSharer shr
    ((_result, widget), enctype) <- runFormPost $ newProjectRoleForm sid
    defaultLayout $(widgetFile "project/role/new")

-getProjectRoleR :: RlIdent -> Handler Html
-getProjectRoleR rl = do
-    pid <- requireAuthId
+getProjectRoleR :: ShrIdent -> RlIdent -> Handler Html
+getProjectRoleR shr rl = do
    Entity _rid role <- runDB $ do
-        sid <- personIdent <$> getJust pid
+        Entity sid _ <- getBy404 $ UniqueSharer shr
        getBy404 $ UniqueProjectRole sid rl
    defaultLayout $(widgetFile "project/role/one")

-deleteProjectRoleR :: RlIdent -> Handler Html
-deleteProjectRoleR rl = do
-    pid <- requireAuthId
+deleteProjectRoleR :: ShrIdent -> RlIdent -> Handler Html
+deleteProjectRoleR shr rl = do
    runDB $ do
-        sid <- personIdent <$> getJust pid
+        Entity sid _s <- getBy404 $ UniqueSharer shr
        Entity rid _r <- getBy404 $ UniqueProjectRole sid rl
        delete rid
    setMessage "Role deleted."
-    redirect ProjectRolesR
+    redirect $ ProjectRolesR shr

-postProjectRoleR :: RlIdent -> Handler Html
-postProjectRoleR rl = do
+postProjectRoleR :: ShrIdent -> RlIdent -> Handler Html
+postProjectRoleR shr rl = do
    mmethod <- lookupPostParam "_method"
    case mmethod of
-        Just "DELETE" -> deleteProjectRoleR rl
+        Just "DELETE" -> deleteProjectRoleR shr rl
        _             -> notFound

-getProjectRoleOpsR :: RlIdent -> Handler Html
-getProjectRoleOpsR rl = do
-    pid <- requireAuthId
+getProjectRoleOpsR :: ShrIdent -> RlIdent -> Handler Html
+getProjectRoleOpsR shr rl = do
    ops <- runDB $ do
-        sid <- personIdent <$> getJust pid
+        Entity sid _s <- getBy404 $ UniqueSharer shr
        Entity rid _r <- getBy404 $ UniqueProjectRole sid rl
        as <- selectList [ProjectAccessRole ==. rid] []
        return $ map (projectAccessOp . entityVal) as
    defaultLayout $(widgetFile "project/role/op/list")

-postProjectRoleOpsR :: RlIdent -> Handler Html
-postProjectRoleOpsR rl = do
-    pid <- requireAuthId
+postProjectRoleOpsR :: ShrIdent -> RlIdent -> Handler Html
+postProjectRoleOpsR shr rl = do
    let getrid = do
-            sid <- personIdent <$> getJust pid
+            Entity sid _ <- getBy404 $ UniqueSharer shr
            fmap entityKey $ getBy404 $ UniqueProjectRole sid rl
    ((result, widget), enctype) <- runFormPost $ newProjectRoleOpForm getrid
    case result of
@ -245,7 +230,7 @@ postProjectRoleOpsR rl = do
                        , projectAccessOp   = op
                        }
                insert_ access
-            redirect $ ProjectRoleOpsR rl
+            redirect $ ProjectRoleOpsR shr rl
        FormMissing -> do
            setMessage "Field(s) missing"
            defaultLayout $(widgetFile "project/role/op/new")
@ -253,11 +238,10 @@ postProjectRoleOpsR rl = do
            setMessage "Invalid input, see errors below"
            defaultLayout $(widgetFile "project/role/op/new")

-getProjectRoleOpNewR :: RlIdent -> Handler Html
-getProjectRoleOpNewR rl = do
-    pid <- requireAuthId
+getProjectRoleOpNewR :: ShrIdent -> RlIdent -> Handler Html
+getProjectRoleOpNewR shr rl = do
    let getrid = do
-            sid <- personIdent <$> getJust pid
+            Entity sid _ <- getBy404 $ UniqueSharer shr
            fmap entityKey $ getBy404 $ UniqueProjectRole sid rl
    ((_result, widget), enctype) <- runFormPost $ newProjectRoleOpForm getrid
    defaultLayout $(widgetFile "project/role/op/new")
--- a/templates/personal-overview.hamlet
+++ b/templates/personal-overview.hamlet
@ -34,9 +34,9 @@ $# <http://creativecommons.org/publicdomain/zero/1.0/>.
 <h2>Repository Roles

 <p>
-  <a href=@{RepoRolesR}>Repository roles
+  <a href=@{RepoRolesR ident}>Repository roles

 <h2>Project Roles

 <p>
-  <a href=@{ProjectRolesR}>Project roles
+  <a href=@{ProjectRolesR ident}>Project roles
--- a/templates/project/role/list.hamlet
+++ b/templates/project/role/list.hamlet
@ -12,10 +12,11 @@ $# You should have received a copy of the CC0 Public Domain Dedication along
 $# with this software. If not, see
 $# <http://creativecommons.org/publicdomain/zero/1.0/>.

-<a href=@{ProjectRoleNewR}>New…
+<p>
+  <a href=@{ProjectRoleNewR shr}>New…

 <ul>
  $forall Entity _rid role <- roles
    <li>
-      <a href=@{ProjectRoleR $ projectRoleIdent role}>
+      <a href=@{ProjectRoleR shr $ projectRoleIdent role}>
        #{rl2text $ projectRoleIdent role}
--- a/templates/project/role/new.hamlet
+++ b/templates/project/role/new.hamlet
@ -12,6 +12,6 @@ $# You should have received a copy of the CC0 Public Domain Dedication along
 $# with this software. If not, see
 $# <http://creativecommons.org/publicdomain/zero/1.0/>.

-<form method=POST action=@{ProjectRolesR} enctype=#{enctype}>
+<form method=POST action=@{ProjectRolesR shr} enctype=#{enctype}>
  ^{widget}
  <input type=submit>
--- a/templates/project/role/one.hamlet
+++ b/templates/project/role/one.hamlet
@ -13,12 +13,12 @@ $# with this software. If not, see
 $# <http://creativecommons.org/publicdomain/zero/1.0/>.

 <div>
-  <form method=POST action=@{ProjectRoleR rl}>
+  <form method=POST action=@{ProjectRoleR shr rl}>
    <input type=hidden name=_method value=DELETE>
    <input type=submit value="Delete this role">

 <p>
-  <a href=@{ProjectRoleOpsR rl}>Operations
+  <a href=@{ProjectRoleOpsR shr rl}>Operations

 <p>
  #{projectRoleDesc role}
--- a/templates/project/role/op/list.hamlet
+++ b/templates/project/role/op/list.hamlet
@ -12,7 +12,8 @@ $# You should have received a copy of the CC0 Public Domain Dedication along
 $# with this software. If not, see
 $# <http://creativecommons.org/publicdomain/zero/1.0/>.

-<a href=@{ProjectRoleOpNewR rl}>New…
+<p>
+  <a href=@{ProjectRoleOpNewR shr rl}>New…

 <ul>
  $forall op <- ops
--- a/templates/project/role/op/new.hamlet
+++ b/templates/project/role/op/new.hamlet
@ -12,6 +12,6 @@ $# You should have received a copy of the CC0 Public Domain Dedication along
 $# with this software. If not, see
 $# <http://creativecommons.org/publicdomain/zero/1.0/>.

-<form method=POST action=@{ProjectRoleOpsR rl} enctype=#{enctype}>
+<form method=POST action=@{ProjectRoleOpsR shr rl} enctype=#{enctype}>
  ^{widget}
  <input type=submit>
--- a/templates/repo/role/list.hamlet
+++ b/templates/repo/role/list.hamlet
@ -12,9 +12,11 @@ $# You should have received a copy of the CC0 Public Domain Dedication along
 $# with this software. If not, see
 $# <http://creativecommons.org/publicdomain/zero/1.0/>.

-<a href=@{RepoRoleNewR}>New…
+<p>
+  <a href=@{RepoRoleNewR shr}>New…

 <ul>
  $forall Entity _rid role <- roles
    <li>
-      <a href=@{RepoRoleR $ repoRoleIdent role}>#{rl2text $ repoRoleIdent role}
+      <a href=@{RepoRoleR shr $ repoRoleIdent role}>
+        #{rl2text $ repoRoleIdent role}
--- a/templates/repo/role/new.hamlet
+++ b/templates/repo/role/new.hamlet
@ -12,6 +12,6 @@ $# You should have received a copy of the CC0 Public Domain Dedication along
 $# with this software. If not, see
 $# <http://creativecommons.org/publicdomain/zero/1.0/>.

-<form method=POST action=@{RepoRolesR} enctype=#{enctype}>
+<form method=POST action=@{RepoRolesR shr} enctype=#{enctype}>
  ^{widget}
  <input type=submit>
--- a/templates/repo/role/one.hamlet
+++ b/templates/repo/role/one.hamlet
@ -13,12 +13,12 @@ $# with this software. If not, see
 $# <http://creativecommons.org/publicdomain/zero/1.0/>.

 <div>
-  <form method=POST action=@{RepoRoleR rl}>
+  <form method=POST action=@{RepoRoleR shr rl}>
    <input type=hidden name=_method value=DELETE>
    <input type=submit value="Delete this role">

 <p>
-  <a href=@{RepoRoleOpsR rl}>Operations
+  <a href=@{RepoRoleOpsR shr rl}>Operations

 <p>
  #{repoRoleDesc role}
--- a/templates/repo/role/op/list.hamlet
+++ b/templates/repo/role/op/list.hamlet
@ -12,7 +12,8 @@ $# You should have received a copy of the CC0 Public Domain Dedication along
 $# with this software. If not, see
 $# <http://creativecommons.org/publicdomain/zero/1.0/>.

-<a href=@{RepoRoleOpNewR rl}>New…
+<p>
+  <a href=@{RepoRoleOpNewR shr rl}>New…

 <ul>
  $forall op <- ops
--- a/templates/repo/role/op/new.hamlet
+++ b/templates/repo/role/op/new.hamlet
@ -12,6 +12,6 @@ $# You should have received a copy of the CC0 Public Domain Dedication along
 $# with this software. If not, see
 $# <http://creativecommons.org/publicdomain/zero/1.0/>.

-<form method=POST action=@{RepoRoleOpsR rl} enctype=#{enctype}>
+<form method=POST action=@{RepoRoleOpsR shr rl} enctype=#{enctype}>
  ^{widget}
  <input type=submit>