Put roles under sharers, now groups' roles can be managed too
This commit is contained in:
parent
f2e4bb4291
commit
23c06c535a
14 changed files with 195 additions and 159 deletions
|
@ -50,17 +50,17 @@
|
||||||
/k/!new KeyNewR GET
|
/k/!new KeyNewR GET
|
||||||
/k/#KyIdent KeyR GET DELETE POST
|
/k/#KyIdent KeyR GET DELETE POST
|
||||||
|
|
||||||
/rr RepoRolesR GET POST
|
/s/#ShrIdent/rr RepoRolesR GET POST
|
||||||
/rr/!new RepoRoleNewR GET
|
/s/#ShrIdent/rr/!new RepoRoleNewR GET
|
||||||
/rr/#RlIdent RepoRoleR GET DELETE POST
|
/s/#ShrIdent/rr/#RlIdent RepoRoleR GET DELETE POST
|
||||||
/rr/#RlIdent/a RepoRoleOpsR GET POST
|
/s/#ShrIdent/rr/#RlIdent/a RepoRoleOpsR GET POST
|
||||||
/rr/#RlIdent/a/!new RepoRoleOpNewR GET
|
/s/#ShrIdent/rr/#RlIdent/a/!new RepoRoleOpNewR GET
|
||||||
|
|
||||||
/pr ProjectRolesR GET POST
|
/s/#ShrIdent/pr ProjectRolesR GET POST
|
||||||
/pr/!new ProjectRoleNewR GET
|
/s/#ShrIdent/pr/!new ProjectRoleNewR GET
|
||||||
/pr/#RlIdent ProjectRoleR GET DELETE POST
|
/s/#ShrIdent/pr/#RlIdent ProjectRoleR GET DELETE POST
|
||||||
/pr/#RlIdent/a ProjectRoleOpsR GET POST
|
/s/#ShrIdent/pr/#RlIdent/a ProjectRoleOpsR GET POST
|
||||||
/pr/#RlIdent/a/!new ProjectRoleOpNewR GET
|
/s/#ShrIdent/pr/#RlIdent/a/!new ProjectRoleOpNewR GET
|
||||||
|
|
||||||
-- ----------------------------------------------------------------------------
|
-- ----------------------------------------------------------------------------
|
||||||
-- Projects
|
-- Projects
|
||||||
|
|
|
@ -122,25 +122,25 @@ instance Yesod App where
|
||||||
isAuthorized r w = case (r, w) of
|
isAuthorized r w = case (r, w) of
|
||||||
(GroupsR , True) -> personAny
|
(GroupsR , True) -> personAny
|
||||||
(GroupNewR , _ ) -> personAny
|
(GroupNewR , _ ) -> personAny
|
||||||
(GroupMembersR grp , True) -> groupRole (== GRAdmin) grp
|
(GroupMembersR grp , True) -> groupAdmin grp
|
||||||
(GroupMemberNewR grp , _ ) -> groupRole (== GRAdmin) grp
|
(GroupMemberNewR grp , _ ) -> groupAdmin grp
|
||||||
(GroupMemberR grp _memb , True) -> groupRole (== GRAdmin) grp
|
(GroupMemberR grp _memb , True) -> groupAdmin grp
|
||||||
|
|
||||||
(KeysR , _ ) -> personAny
|
(KeysR , _ ) -> personAny
|
||||||
(KeyR _key , _ ) -> personAny
|
(KeyR _key , _ ) -> personAny
|
||||||
(KeyNewR , _ ) -> personAny
|
(KeyNewR , _ ) -> personAny
|
||||||
|
|
||||||
(RepoRolesR , _ ) -> personAny
|
(RepoRolesR shr , _ ) -> personOrGroupAdmin shr
|
||||||
(RepoRoleNewR , _ ) -> personAny
|
(RepoRoleNewR shr , _ ) -> personOrGroupAdmin shr
|
||||||
(RepoRoleR _rl , _ ) -> personAny
|
(RepoRoleR shr _rl , _ ) -> personOrGroupAdmin shr
|
||||||
(RepoRoleOpsR _rl , _ ) -> personAny
|
(RepoRoleOpsR shr _rl , _ ) -> personOrGroupAdmin shr
|
||||||
(RepoRoleOpNewR _rl , _ ) -> personAny
|
(RepoRoleOpNewR shr _rl , _ ) -> personOrGroupAdmin shr
|
||||||
|
|
||||||
(ProjectRolesR , _ ) -> personAny
|
(ProjectRolesR shr , _ ) -> personOrGroupAdmin shr
|
||||||
(ProjectRoleNewR , _ ) -> personAny
|
(ProjectRoleNewR shr , _ ) -> personOrGroupAdmin shr
|
||||||
(ProjectRoleR _rl , _ ) -> personAny
|
(ProjectRoleR shr _rl , _ ) -> personOrGroupAdmin shr
|
||||||
(ProjectRoleOpsR _rl , _ ) -> personAny
|
(ProjectRoleOpsR shr _rl , _ ) -> personOrGroupAdmin shr
|
||||||
(ProjectRoleOpNewR _rl , _ ) -> personAny
|
(ProjectRoleOpNewR shr _rl , _ ) -> personOrGroupAdmin shr
|
||||||
|
|
||||||
(ReposR shar , True) -> person shar
|
(ReposR shar , True) -> person shar
|
||||||
(RepoNewR user , _ ) -> person user
|
(RepoNewR user , _ ) -> person user
|
||||||
|
@ -205,6 +205,43 @@ instance Yesod App where
|
||||||
then Authorized
|
then Authorized
|
||||||
else Unauthorized "Not the expected group role"
|
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
|
projOp
|
||||||
:: ProjectOperation -> ShrIdent -> PrjIdent -> Handler AuthResult
|
:: ProjectOperation -> ShrIdent -> PrjIdent -> Handler AuthResult
|
||||||
projOp op shr prj = personAnd $ \ (Entity pid _p) -> do
|
projOp op shr prj = personAnd $ \ (Entity pid _p) -> do
|
||||||
|
@ -333,17 +370,27 @@ instance YesodBreadcrumbs App where
|
||||||
KeyNewR -> ("New", Just KeysR)
|
KeyNewR -> ("New", Just KeysR)
|
||||||
KeyR key -> (ky2text key, Just KeysR)
|
KeyR key -> (ky2text key, Just KeysR)
|
||||||
|
|
||||||
RepoRolesR -> ("Repo Roles", Just HomeR)
|
RepoRolesR shr -> ("Repo Roles", Just $ SharerR shr)
|
||||||
RepoRoleNewR -> ("New", Just RepoRolesR)
|
RepoRoleNewR shr -> ("New", Just $ RepoRolesR shr)
|
||||||
RepoRoleR rl -> (rl2text rl, Just RepoRolesR)
|
RepoRoleR shr rl -> (rl2text rl, Just $ RepoRolesR shr)
|
||||||
RepoRoleOpsR rl -> ("Operations", Just $ RepoRoleR rl)
|
RepoRoleOpsR shr rl -> ( "Operations"
|
||||||
RepoRoleOpNewR rl -> ("New", Just $ RepoRoleOpsR rl)
|
, Just $ RepoRoleR shr rl
|
||||||
|
)
|
||||||
|
RepoRoleOpNewR shr rl -> ("New", Just $ RepoRoleOpsR shr rl)
|
||||||
|
|
||||||
ProjectRolesR -> ("Project Roles", Just HomeR)
|
ProjectRolesR shr -> ( "Project Roles"
|
||||||
ProjectRoleNewR -> ("New", Just ProjectRolesR)
|
, Just $ SharerR shr
|
||||||
ProjectRoleR rl -> (rl2text rl, Just ProjectRolesR)
|
)
|
||||||
ProjectRoleOpsR rl -> ("Operations", Just $ ProjectRoleR rl)
|
ProjectRoleNewR shr -> ("New", Just $ ProjectRolesR shr)
|
||||||
ProjectRoleOpNewR rl -> ("New", Just $ ProjectRoleOpsR rl)
|
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)
|
ReposR shar -> ("Repos", Just $ PersonR shar)
|
||||||
RepoNewR shar -> ("New", Just $ ReposR shar)
|
RepoNewR shar -> ("New", Just $ ReposR shar)
|
||||||
|
|
|
@ -49,21 +49,19 @@ import Yesod.Persist.Core (runDB, getBy404)
|
||||||
import Vervis.Form.Role
|
import Vervis.Form.Role
|
||||||
import Vervis.Foundation
|
import Vervis.Foundation
|
||||||
import Vervis.Model
|
import Vervis.Model
|
||||||
import Vervis.Model.Ident (RlIdent, rl2text)
|
import Vervis.Model.Ident (ShrIdent, RlIdent, rl2text)
|
||||||
import Vervis.Settings (widgetFile)
|
import Vervis.Settings (widgetFile)
|
||||||
|
|
||||||
getRepoRolesR :: Handler Html
|
getRepoRolesR :: ShrIdent -> Handler Html
|
||||||
getRepoRolesR = do
|
getRepoRolesR shr = do
|
||||||
pid <- requireAuthId
|
|
||||||
roles <- runDB $ do
|
roles <- runDB $ do
|
||||||
person <- getJust pid
|
Entity sid _ <- getBy404 $ UniqueSharer shr
|
||||||
selectList [RepoRoleSharer ==. personIdent person] []
|
selectList [RepoRoleSharer ==. sid] []
|
||||||
defaultLayout $(widgetFile "repo/role/list")
|
defaultLayout $(widgetFile "repo/role/list")
|
||||||
|
|
||||||
postRepoRolesR :: Handler Html
|
postRepoRolesR :: ShrIdent -> Handler Html
|
||||||
postRepoRolesR = do
|
postRepoRolesR shr = do
|
||||||
pid <- requireAuthId
|
sid <- fmap entityKey $ runDB $ getBy404 $ UniqueSharer shr
|
||||||
sid <- fmap personIdent $ runDB $ getJust pid
|
|
||||||
((result, widget), enctype) <- runFormPost $ newRepoRoleForm sid
|
((result, widget), enctype) <- runFormPost $ newRepoRoleForm sid
|
||||||
case result of
|
case result of
|
||||||
FormSuccess nrr -> do
|
FormSuccess nrr -> do
|
||||||
|
@ -74,7 +72,7 @@ postRepoRolesR = do
|
||||||
, repoRoleDesc = nrrDesc nrr
|
, repoRoleDesc = nrrDesc nrr
|
||||||
}
|
}
|
||||||
insert_ role
|
insert_ role
|
||||||
redirect $ RepoRolesR
|
redirect $ RepoRolesR shr
|
||||||
FormMissing -> do
|
FormMissing -> do
|
||||||
setMessage "Field(s) missing"
|
setMessage "Field(s) missing"
|
||||||
defaultLayout $(widgetFile "repo/role/new")
|
defaultLayout $(widgetFile "repo/role/new")
|
||||||
|
@ -82,53 +80,48 @@ postRepoRolesR = do
|
||||||
setMessage "Invalid input, see errors below"
|
setMessage "Invalid input, see errors below"
|
||||||
defaultLayout $(widgetFile "repo/role/new")
|
defaultLayout $(widgetFile "repo/role/new")
|
||||||
|
|
||||||
getRepoRoleNewR :: Handler Html
|
getRepoRoleNewR :: ShrIdent -> Handler Html
|
||||||
getRepoRoleNewR = do
|
getRepoRoleNewR shr = do
|
||||||
pid <- requireAuthId
|
sid <- fmap entityKey $ runDB $ getBy404 $ UniqueSharer shr
|
||||||
sid <- fmap personIdent $ runDB $ getJust pid
|
|
||||||
((_result, widget), enctype) <- runFormPost $ newRepoRoleForm sid
|
((_result, widget), enctype) <- runFormPost $ newRepoRoleForm sid
|
||||||
defaultLayout $(widgetFile "repo/role/new")
|
defaultLayout $(widgetFile "repo/role/new")
|
||||||
|
|
||||||
getRepoRoleR :: RlIdent -> Handler Html
|
getRepoRoleR :: ShrIdent -> RlIdent -> Handler Html
|
||||||
getRepoRoleR rl = do
|
getRepoRoleR shr rl = do
|
||||||
pid <- requireAuthId
|
Entity _rid role <- runDB $ do
|
||||||
sid <- fmap personIdent $ runDB $ getJust pid
|
Entity sid _ <- getBy404 $ UniqueSharer shr
|
||||||
Entity _rid role <- runDB $ getBy404 $ UniqueRepoRole sid rl
|
getBy404 $ UniqueRepoRole sid rl
|
||||||
defaultLayout $(widgetFile "repo/role/one")
|
defaultLayout $(widgetFile "repo/role/one")
|
||||||
|
|
||||||
deleteRepoRoleR :: RlIdent -> Handler Html
|
deleteRepoRoleR :: ShrIdent -> RlIdent -> Handler Html
|
||||||
deleteRepoRoleR rl = do
|
deleteRepoRoleR shr rl = do
|
||||||
pid <- requireAuthId
|
|
||||||
runDB $ do
|
runDB $ do
|
||||||
person <- getJust pid
|
Entity sid _s <- getBy404 $ UniqueSharer shr
|
||||||
let sid = personIdent person
|
|
||||||
Entity rid _r <- getBy404 $ UniqueRepoRole sid rl
|
Entity rid _r <- getBy404 $ UniqueRepoRole sid rl
|
||||||
delete rid
|
delete rid
|
||||||
setMessage "Role deleted."
|
setMessage "Role deleted."
|
||||||
redirect RepoRolesR
|
redirect $ RepoRolesR shr
|
||||||
|
|
||||||
postRepoRoleR :: RlIdent -> Handler Html
|
postRepoRoleR :: ShrIdent -> RlIdent -> Handler Html
|
||||||
postRepoRoleR rl = do
|
postRepoRoleR shr rl = do
|
||||||
mmethod <- lookupPostParam "_method"
|
mmethod <- lookupPostParam "_method"
|
||||||
case mmethod of
|
case mmethod of
|
||||||
Just "DELETE" -> deleteRepoRoleR rl
|
Just "DELETE" -> deleteRepoRoleR shr rl
|
||||||
_ -> notFound
|
_ -> notFound
|
||||||
|
|
||||||
getRepoRoleOpsR :: RlIdent -> Handler Html
|
getRepoRoleOpsR :: ShrIdent -> RlIdent -> Handler Html
|
||||||
getRepoRoleOpsR rl = do
|
getRepoRoleOpsR shr rl = do
|
||||||
pid <- requireAuthId
|
|
||||||
ops <- runDB $ do
|
ops <- runDB $ do
|
||||||
sid <- personIdent <$> getJust pid
|
Entity sid _s <- getBy404 $ UniqueSharer shr
|
||||||
Entity rid _r <- getBy404 $ UniqueRepoRole sid rl
|
Entity rid _r <- getBy404 $ UniqueRepoRole sid rl
|
||||||
as <- selectList [RepoAccessRole ==. rid] []
|
as <- selectList [RepoAccessRole ==. rid] []
|
||||||
return $ map (repoAccessOp . entityVal) as
|
return $ map (repoAccessOp . entityVal) as
|
||||||
defaultLayout $(widgetFile "repo/role/op/list")
|
defaultLayout $(widgetFile "repo/role/op/list")
|
||||||
|
|
||||||
postRepoRoleOpsR :: RlIdent -> Handler Html
|
postRepoRoleOpsR :: ShrIdent -> RlIdent -> Handler Html
|
||||||
postRepoRoleOpsR rl = do
|
postRepoRoleOpsR shr rl = do
|
||||||
pid <- requireAuthId
|
|
||||||
let getrid = do
|
let getrid = do
|
||||||
sid <- personIdent <$> getJust pid
|
Entity sid _ <- getBy404 $ UniqueSharer shr
|
||||||
fmap entityKey $ getBy404 $ UniqueRepoRole sid rl
|
fmap entityKey $ getBy404 $ UniqueRepoRole sid rl
|
||||||
((result, widget), enctype) <- runFormPost $ newRepoRoleOpForm getrid
|
((result, widget), enctype) <- runFormPost $ newRepoRoleOpForm getrid
|
||||||
case result of
|
case result of
|
||||||
|
@ -140,7 +133,7 @@ postRepoRoleOpsR rl = do
|
||||||
, repoAccessOp = op
|
, repoAccessOp = op
|
||||||
}
|
}
|
||||||
insert_ access
|
insert_ access
|
||||||
redirect $ RepoRoleOpsR rl
|
redirect $ RepoRoleOpsR shr rl
|
||||||
FormMissing -> do
|
FormMissing -> do
|
||||||
setMessage "Field(s) missing"
|
setMessage "Field(s) missing"
|
||||||
defaultLayout $(widgetFile "repo/role/op/new")
|
defaultLayout $(widgetFile "repo/role/op/new")
|
||||||
|
@ -148,27 +141,24 @@ postRepoRoleOpsR rl = do
|
||||||
setMessage "Invalid input, see errors below"
|
setMessage "Invalid input, see errors below"
|
||||||
defaultLayout $(widgetFile "repo/role/op/new")
|
defaultLayout $(widgetFile "repo/role/op/new")
|
||||||
|
|
||||||
getRepoRoleOpNewR :: RlIdent -> Handler Html
|
getRepoRoleOpNewR :: ShrIdent -> RlIdent -> Handler Html
|
||||||
getRepoRoleOpNewR rl = do
|
getRepoRoleOpNewR shr rl = do
|
||||||
pid <- requireAuthId
|
|
||||||
let getrid = do
|
let getrid = do
|
||||||
sid <- personIdent <$> getJust pid
|
Entity sid _ <- getBy404 $ UniqueSharer shr
|
||||||
fmap entityKey $ getBy404 $ UniqueRepoRole sid rl
|
fmap entityKey $ getBy404 $ UniqueRepoRole sid rl
|
||||||
((_result, widget), enctype) <- runFormPost $ newRepoRoleOpForm getrid
|
((_result, widget), enctype) <- runFormPost $ newRepoRoleOpForm getrid
|
||||||
defaultLayout $(widgetFile "repo/role/op/new")
|
defaultLayout $(widgetFile "repo/role/op/new")
|
||||||
|
|
||||||
getProjectRolesR :: Handler Html
|
getProjectRolesR :: ShrIdent -> Handler Html
|
||||||
getProjectRolesR = do
|
getProjectRolesR shr = do
|
||||||
pid <- requireAuthId
|
|
||||||
roles <- runDB $ do
|
roles <- runDB $ do
|
||||||
person <- getJust pid
|
Entity sid _ <- getBy404 $ UniqueSharer shr
|
||||||
selectList [ProjectRoleSharer ==. personIdent person] []
|
selectList [ProjectRoleSharer ==. sid] []
|
||||||
defaultLayout $(widgetFile "project/role/list")
|
defaultLayout $(widgetFile "project/role/list")
|
||||||
|
|
||||||
postProjectRolesR :: Handler Html
|
postProjectRolesR :: ShrIdent -> Handler Html
|
||||||
postProjectRolesR = do
|
postProjectRolesR shr = do
|
||||||
pid <- requireAuthId
|
sid <- fmap entityKey $ runDB $ getBy404 $ UniqueSharer shr
|
||||||
sid <- fmap personIdent $ runDB $ getJust pid
|
|
||||||
((result, widget), enctype) <- runFormPost $ newProjectRoleForm sid
|
((result, widget), enctype) <- runFormPost $ newProjectRoleForm sid
|
||||||
case result of
|
case result of
|
||||||
FormSuccess npr -> do
|
FormSuccess npr -> do
|
||||||
|
@ -179,7 +169,7 @@ postProjectRolesR = do
|
||||||
, projectRoleDesc = nprDesc npr
|
, projectRoleDesc = nprDesc npr
|
||||||
}
|
}
|
||||||
insert_ role
|
insert_ role
|
||||||
redirect $ ProjectRolesR
|
redirect $ ProjectRolesR shr
|
||||||
FormMissing -> do
|
FormMissing -> do
|
||||||
setMessage "Field(s) missing"
|
setMessage "Field(s) missing"
|
||||||
defaultLayout $(widgetFile "project/role/new")
|
defaultLayout $(widgetFile "project/role/new")
|
||||||
|
@ -187,53 +177,48 @@ postProjectRolesR = do
|
||||||
setMessage "Invalid input, see errors below"
|
setMessage "Invalid input, see errors below"
|
||||||
defaultLayout $(widgetFile "project/role/new")
|
defaultLayout $(widgetFile "project/role/new")
|
||||||
|
|
||||||
getProjectRoleNewR :: Handler Html
|
getProjectRoleNewR :: ShrIdent -> Handler Html
|
||||||
getProjectRoleNewR = do
|
getProjectRoleNewR shr = do
|
||||||
pid <- requireAuthId
|
sid <- fmap entityKey $ runDB $ getBy404 $ UniqueSharer shr
|
||||||
sid <- fmap personIdent $ runDB $ getJust pid
|
|
||||||
((_result, widget), enctype) <- runFormPost $ newProjectRoleForm sid
|
((_result, widget), enctype) <- runFormPost $ newProjectRoleForm sid
|
||||||
defaultLayout $(widgetFile "project/role/new")
|
defaultLayout $(widgetFile "project/role/new")
|
||||||
|
|
||||||
getProjectRoleR :: RlIdent -> Handler Html
|
getProjectRoleR :: ShrIdent -> RlIdent -> Handler Html
|
||||||
getProjectRoleR rl = do
|
getProjectRoleR shr rl = do
|
||||||
pid <- requireAuthId
|
|
||||||
Entity _rid role <- runDB $ do
|
Entity _rid role <- runDB $ do
|
||||||
sid <- personIdent <$> getJust pid
|
Entity sid _ <- getBy404 $ UniqueSharer shr
|
||||||
getBy404 $ UniqueProjectRole sid rl
|
getBy404 $ UniqueProjectRole sid rl
|
||||||
defaultLayout $(widgetFile "project/role/one")
|
defaultLayout $(widgetFile "project/role/one")
|
||||||
|
|
||||||
deleteProjectRoleR :: RlIdent -> Handler Html
|
deleteProjectRoleR :: ShrIdent -> RlIdent -> Handler Html
|
||||||
deleteProjectRoleR rl = do
|
deleteProjectRoleR shr rl = do
|
||||||
pid <- requireAuthId
|
|
||||||
runDB $ do
|
runDB $ do
|
||||||
sid <- personIdent <$> getJust pid
|
Entity sid _s <- getBy404 $ UniqueSharer shr
|
||||||
Entity rid _r <- getBy404 $ UniqueProjectRole sid rl
|
Entity rid _r <- getBy404 $ UniqueProjectRole sid rl
|
||||||
delete rid
|
delete rid
|
||||||
setMessage "Role deleted."
|
setMessage "Role deleted."
|
||||||
redirect ProjectRolesR
|
redirect $ ProjectRolesR shr
|
||||||
|
|
||||||
postProjectRoleR :: RlIdent -> Handler Html
|
postProjectRoleR :: ShrIdent -> RlIdent -> Handler Html
|
||||||
postProjectRoleR rl = do
|
postProjectRoleR shr rl = do
|
||||||
mmethod <- lookupPostParam "_method"
|
mmethod <- lookupPostParam "_method"
|
||||||
case mmethod of
|
case mmethod of
|
||||||
Just "DELETE" -> deleteProjectRoleR rl
|
Just "DELETE" -> deleteProjectRoleR shr rl
|
||||||
_ -> notFound
|
_ -> notFound
|
||||||
|
|
||||||
getProjectRoleOpsR :: RlIdent -> Handler Html
|
getProjectRoleOpsR :: ShrIdent -> RlIdent -> Handler Html
|
||||||
getProjectRoleOpsR rl = do
|
getProjectRoleOpsR shr rl = do
|
||||||
pid <- requireAuthId
|
|
||||||
ops <- runDB $ do
|
ops <- runDB $ do
|
||||||
sid <- personIdent <$> getJust pid
|
Entity sid _s <- getBy404 $ UniqueSharer shr
|
||||||
Entity rid _r <- getBy404 $ UniqueProjectRole sid rl
|
Entity rid _r <- getBy404 $ UniqueProjectRole sid rl
|
||||||
as <- selectList [ProjectAccessRole ==. rid] []
|
as <- selectList [ProjectAccessRole ==. rid] []
|
||||||
return $ map (projectAccessOp . entityVal) as
|
return $ map (projectAccessOp . entityVal) as
|
||||||
defaultLayout $(widgetFile "project/role/op/list")
|
defaultLayout $(widgetFile "project/role/op/list")
|
||||||
|
|
||||||
postProjectRoleOpsR :: RlIdent -> Handler Html
|
postProjectRoleOpsR :: ShrIdent -> RlIdent -> Handler Html
|
||||||
postProjectRoleOpsR rl = do
|
postProjectRoleOpsR shr rl = do
|
||||||
pid <- requireAuthId
|
|
||||||
let getrid = do
|
let getrid = do
|
||||||
sid <- personIdent <$> getJust pid
|
Entity sid _ <- getBy404 $ UniqueSharer shr
|
||||||
fmap entityKey $ getBy404 $ UniqueProjectRole sid rl
|
fmap entityKey $ getBy404 $ UniqueProjectRole sid rl
|
||||||
((result, widget), enctype) <- runFormPost $ newProjectRoleOpForm getrid
|
((result, widget), enctype) <- runFormPost $ newProjectRoleOpForm getrid
|
||||||
case result of
|
case result of
|
||||||
|
@ -245,7 +230,7 @@ postProjectRoleOpsR rl = do
|
||||||
, projectAccessOp = op
|
, projectAccessOp = op
|
||||||
}
|
}
|
||||||
insert_ access
|
insert_ access
|
||||||
redirect $ ProjectRoleOpsR rl
|
redirect $ ProjectRoleOpsR shr rl
|
||||||
FormMissing -> do
|
FormMissing -> do
|
||||||
setMessage "Field(s) missing"
|
setMessage "Field(s) missing"
|
||||||
defaultLayout $(widgetFile "project/role/op/new")
|
defaultLayout $(widgetFile "project/role/op/new")
|
||||||
|
@ -253,11 +238,10 @@ postProjectRoleOpsR rl = do
|
||||||
setMessage "Invalid input, see errors below"
|
setMessage "Invalid input, see errors below"
|
||||||
defaultLayout $(widgetFile "project/role/op/new")
|
defaultLayout $(widgetFile "project/role/op/new")
|
||||||
|
|
||||||
getProjectRoleOpNewR :: RlIdent -> Handler Html
|
getProjectRoleOpNewR :: ShrIdent -> RlIdent -> Handler Html
|
||||||
getProjectRoleOpNewR rl = do
|
getProjectRoleOpNewR shr rl = do
|
||||||
pid <- requireAuthId
|
|
||||||
let getrid = do
|
let getrid = do
|
||||||
sid <- personIdent <$> getJust pid
|
Entity sid _ <- getBy404 $ UniqueSharer shr
|
||||||
fmap entityKey $ getBy404 $ UniqueProjectRole sid rl
|
fmap entityKey $ getBy404 $ UniqueProjectRole sid rl
|
||||||
((_result, widget), enctype) <- runFormPost $ newProjectRoleOpForm getrid
|
((_result, widget), enctype) <- runFormPost $ newProjectRoleOpForm getrid
|
||||||
defaultLayout $(widgetFile "project/role/op/new")
|
defaultLayout $(widgetFile "project/role/op/new")
|
||||||
|
|
|
@ -34,9 +34,9 @@ $# <http://creativecommons.org/publicdomain/zero/1.0/>.
|
||||||
<h2>Repository Roles
|
<h2>Repository Roles
|
||||||
|
|
||||||
<p>
|
<p>
|
||||||
<a href=@{RepoRolesR}>Repository roles
|
<a href=@{RepoRolesR ident}>Repository roles
|
||||||
|
|
||||||
<h2>Project Roles
|
<h2>Project Roles
|
||||||
|
|
||||||
<p>
|
<p>
|
||||||
<a href=@{ProjectRolesR}>Project roles
|
<a href=@{ProjectRolesR ident}>Project roles
|
||||||
|
|
|
@ -12,10 +12,11 @@ $# You should have received a copy of the CC0 Public Domain Dedication along
|
||||||
$# with this software. If not, see
|
$# with this software. If not, see
|
||||||
$# <http://creativecommons.org/publicdomain/zero/1.0/>.
|
$# <http://creativecommons.org/publicdomain/zero/1.0/>.
|
||||||
|
|
||||||
<a href=@{ProjectRoleNewR}>New…
|
<p>
|
||||||
|
<a href=@{ProjectRoleNewR shr}>New…
|
||||||
|
|
||||||
<ul>
|
<ul>
|
||||||
$forall Entity _rid role <- roles
|
$forall Entity _rid role <- roles
|
||||||
<li>
|
<li>
|
||||||
<a href=@{ProjectRoleR $ projectRoleIdent role}>
|
<a href=@{ProjectRoleR shr $ projectRoleIdent role}>
|
||||||
#{rl2text $ projectRoleIdent role}
|
#{rl2text $ projectRoleIdent role}
|
||||||
|
|
|
@ -12,6 +12,6 @@ $# You should have received a copy of the CC0 Public Domain Dedication along
|
||||||
$# with this software. If not, see
|
$# with this software. If not, see
|
||||||
$# <http://creativecommons.org/publicdomain/zero/1.0/>.
|
$# <http://creativecommons.org/publicdomain/zero/1.0/>.
|
||||||
|
|
||||||
<form method=POST action=@{ProjectRolesR} enctype=#{enctype}>
|
<form method=POST action=@{ProjectRolesR shr} enctype=#{enctype}>
|
||||||
^{widget}
|
^{widget}
|
||||||
<input type=submit>
|
<input type=submit>
|
||||||
|
|
|
@ -13,12 +13,12 @@ $# with this software. If not, see
|
||||||
$# <http://creativecommons.org/publicdomain/zero/1.0/>.
|
$# <http://creativecommons.org/publicdomain/zero/1.0/>.
|
||||||
|
|
||||||
<div>
|
<div>
|
||||||
<form method=POST action=@{ProjectRoleR rl}>
|
<form method=POST action=@{ProjectRoleR shr rl}>
|
||||||
<input type=hidden name=_method value=DELETE>
|
<input type=hidden name=_method value=DELETE>
|
||||||
<input type=submit value="Delete this role">
|
<input type=submit value="Delete this role">
|
||||||
|
|
||||||
<p>
|
<p>
|
||||||
<a href=@{ProjectRoleOpsR rl}>Operations
|
<a href=@{ProjectRoleOpsR shr rl}>Operations
|
||||||
|
|
||||||
<p>
|
<p>
|
||||||
#{projectRoleDesc role}
|
#{projectRoleDesc role}
|
||||||
|
|
|
@ -12,7 +12,8 @@ $# You should have received a copy of the CC0 Public Domain Dedication along
|
||||||
$# with this software. If not, see
|
$# with this software. If not, see
|
||||||
$# <http://creativecommons.org/publicdomain/zero/1.0/>.
|
$# <http://creativecommons.org/publicdomain/zero/1.0/>.
|
||||||
|
|
||||||
<a href=@{ProjectRoleOpNewR rl}>New…
|
<p>
|
||||||
|
<a href=@{ProjectRoleOpNewR shr rl}>New…
|
||||||
|
|
||||||
<ul>
|
<ul>
|
||||||
$forall op <- ops
|
$forall op <- ops
|
||||||
|
|
|
@ -12,6 +12,6 @@ $# You should have received a copy of the CC0 Public Domain Dedication along
|
||||||
$# with this software. If not, see
|
$# with this software. If not, see
|
||||||
$# <http://creativecommons.org/publicdomain/zero/1.0/>.
|
$# <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}
|
^{widget}
|
||||||
<input type=submit>
|
<input type=submit>
|
||||||
|
|
|
@ -12,9 +12,11 @@ $# You should have received a copy of the CC0 Public Domain Dedication along
|
||||||
$# with this software. If not, see
|
$# with this software. If not, see
|
||||||
$# <http://creativecommons.org/publicdomain/zero/1.0/>.
|
$# <http://creativecommons.org/publicdomain/zero/1.0/>.
|
||||||
|
|
||||||
<a href=@{RepoRoleNewR}>New…
|
<p>
|
||||||
|
<a href=@{RepoRoleNewR shr}>New…
|
||||||
|
|
||||||
<ul>
|
<ul>
|
||||||
$forall Entity _rid role <- roles
|
$forall Entity _rid role <- roles
|
||||||
<li>
|
<li>
|
||||||
<a href=@{RepoRoleR $ repoRoleIdent role}>#{rl2text $ repoRoleIdent role}
|
<a href=@{RepoRoleR shr $ repoRoleIdent role}>
|
||||||
|
#{rl2text $ repoRoleIdent role}
|
||||||
|
|
|
@ -12,6 +12,6 @@ $# You should have received a copy of the CC0 Public Domain Dedication along
|
||||||
$# with this software. If not, see
|
$# with this software. If not, see
|
||||||
$# <http://creativecommons.org/publicdomain/zero/1.0/>.
|
$# <http://creativecommons.org/publicdomain/zero/1.0/>.
|
||||||
|
|
||||||
<form method=POST action=@{RepoRolesR} enctype=#{enctype}>
|
<form method=POST action=@{RepoRolesR shr} enctype=#{enctype}>
|
||||||
^{widget}
|
^{widget}
|
||||||
<input type=submit>
|
<input type=submit>
|
||||||
|
|
|
@ -13,12 +13,12 @@ $# with this software. If not, see
|
||||||
$# <http://creativecommons.org/publicdomain/zero/1.0/>.
|
$# <http://creativecommons.org/publicdomain/zero/1.0/>.
|
||||||
|
|
||||||
<div>
|
<div>
|
||||||
<form method=POST action=@{RepoRoleR rl}>
|
<form method=POST action=@{RepoRoleR shr rl}>
|
||||||
<input type=hidden name=_method value=DELETE>
|
<input type=hidden name=_method value=DELETE>
|
||||||
<input type=submit value="Delete this role">
|
<input type=submit value="Delete this role">
|
||||||
|
|
||||||
<p>
|
<p>
|
||||||
<a href=@{RepoRoleOpsR rl}>Operations
|
<a href=@{RepoRoleOpsR shr rl}>Operations
|
||||||
|
|
||||||
<p>
|
<p>
|
||||||
#{repoRoleDesc role}
|
#{repoRoleDesc role}
|
||||||
|
|
|
@ -12,7 +12,8 @@ $# You should have received a copy of the CC0 Public Domain Dedication along
|
||||||
$# with this software. If not, see
|
$# with this software. If not, see
|
||||||
$# <http://creativecommons.org/publicdomain/zero/1.0/>.
|
$# <http://creativecommons.org/publicdomain/zero/1.0/>.
|
||||||
|
|
||||||
<a href=@{RepoRoleOpNewR rl}>New…
|
<p>
|
||||||
|
<a href=@{RepoRoleOpNewR shr rl}>New…
|
||||||
|
|
||||||
<ul>
|
<ul>
|
||||||
$forall op <- ops
|
$forall op <- ops
|
||||||
|
|
|
@ -12,6 +12,6 @@ $# You should have received a copy of the CC0 Public Domain Dedication along
|
||||||
$# with this software. If not, see
|
$# with this software. If not, see
|
||||||
$# <http://creativecommons.org/publicdomain/zero/1.0/>.
|
$# <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}
|
^{widget}
|
||||||
<input type=submit>
|
<input type=submit>
|
||||||
|
|
Loading…
Reference in a new issue