Rename role related tables to reflect the role unification
There used to be project roles and repo roles, and they were separate. A while ago I merged them, and there has been a single role system, used with both repos and projects. However the table names were still "ProjectRole" and things like that. This patch renames some tables to just refer to a "Role" because there's only one kind of role system.
This commit is contained in:
parent
dccb91f47c
commit
21b7325c1b
14 changed files with 86 additions and 74 deletions
|
@ -176,24 +176,24 @@ GroupMember
|
||||||
|
|
||||||
UniqueGroupMember person group
|
UniqueGroupMember person group
|
||||||
|
|
||||||
ProjectRole
|
Role
|
||||||
ident RlIdent
|
ident RlIdent
|
||||||
sharer SharerId
|
sharer SharerId
|
||||||
desc Text
|
desc Text
|
||||||
|
|
||||||
UniqueProjectRole sharer ident
|
UniqueRole sharer ident
|
||||||
|
|
||||||
ProjectRoleInherit
|
RoleInherit
|
||||||
parent ProjectRoleId
|
parent RoleId
|
||||||
child ProjectRoleId
|
child RoleId
|
||||||
|
|
||||||
UniqueProjectRoleInherit parent child
|
UniqueRoleInherit parent child
|
||||||
|
|
||||||
ProjectAccess
|
RoleAccess
|
||||||
role ProjectRoleId
|
role RoleId
|
||||||
op ProjectOperation
|
op ProjectOperation
|
||||||
|
|
||||||
UniqueProjectAccess role op
|
UniqueRoleAccess role op
|
||||||
|
|
||||||
-------------------------------------------------------------------------------
|
-------------------------------------------------------------------------------
|
||||||
-- Projects
|
-- Projects
|
||||||
|
@ -207,8 +207,8 @@ Project
|
||||||
workflow WorkflowId
|
workflow WorkflowId
|
||||||
nextTicket Int
|
nextTicket Int
|
||||||
wiki RepoId Maybe
|
wiki RepoId Maybe
|
||||||
collabUser ProjectRoleId Maybe
|
collabUser RoleId Maybe
|
||||||
collabAnon ProjectRoleId Maybe
|
collabAnon RoleId Maybe
|
||||||
|
|
||||||
UniqueProject ident sharer
|
UniqueProject ident sharer
|
||||||
|
|
||||||
|
@ -219,8 +219,8 @@ Repo
|
||||||
project ProjectId Maybe
|
project ProjectId Maybe
|
||||||
desc Text Maybe
|
desc Text Maybe
|
||||||
mainBranch Text
|
mainBranch Text
|
||||||
collabUser ProjectRoleId Maybe
|
collabUser RoleId Maybe
|
||||||
collabAnon ProjectRoleId Maybe
|
collabAnon RoleId Maybe
|
||||||
|
|
||||||
UniqueRepo ident sharer
|
UniqueRepo ident sharer
|
||||||
|
|
||||||
|
@ -348,13 +348,13 @@ RemoteMessage
|
||||||
RepoCollab
|
RepoCollab
|
||||||
repo RepoId
|
repo RepoId
|
||||||
person PersonId
|
person PersonId
|
||||||
role ProjectRoleId Maybe
|
role RoleId Maybe
|
||||||
|
|
||||||
UniqueRepoCollab repo person
|
UniqueRepoCollab repo person
|
||||||
|
|
||||||
ProjectCollab
|
ProjectCollab
|
||||||
project ProjectId
|
project ProjectId
|
||||||
person PersonId
|
person PersonId
|
||||||
role ProjectRoleId Maybe
|
role RoleId Maybe
|
||||||
|
|
||||||
UniqueProjectCollab project person
|
UniqueProjectCollab project person
|
||||||
|
|
|
@ -106,7 +106,7 @@ roleHasAccess (RoleID rlid) op =
|
||||||
fmap isJust . runMaybeT $
|
fmap isJust . runMaybeT $
|
||||||
MaybeT (roleHas rlid op) <|> MaybeT (ancestorHas rlid op)
|
MaybeT (roleHas rlid op) <|> MaybeT (ancestorHas rlid op)
|
||||||
where
|
where
|
||||||
roleHas role operation = getBy $ UniqueProjectAccess role operation
|
roleHas role operation = getBy $ UniqueRoleAccess role operation
|
||||||
ancestorHas = flip getProjectRoleAncestorWithOpQ
|
ancestorHas = flip getProjectRoleAncestorWithOpQ
|
||||||
|
|
||||||
status :: Bool -> ObjectAccessStatus
|
status :: Bool -> ObjectAccessStatus
|
||||||
|
|
|
@ -43,28 +43,28 @@ newProjectRoleIdentField sid = checkUniqueCI roleIdentField
|
||||||
checkUniqueCI = checkM $ \ rl -> do
|
checkUniqueCI = checkM $ \ rl -> do
|
||||||
sames <- runDB $ select $ from $ \ role -> do
|
sames <- runDB $ select $ from $ \ role -> do
|
||||||
where_ $
|
where_ $
|
||||||
role ^. ProjectRoleSharer ==. val sid &&.
|
role ^. RoleSharer ==. val sid &&.
|
||||||
lower_ (role ^. ProjectRoleIdent) ==. lower_ (val rl)
|
lower_ (role ^. RoleIdent) ==. lower_ (val rl)
|
||||||
limit 1
|
limit 1
|
||||||
return ()
|
return ()
|
||||||
return $ if null sames
|
return $ if null sames
|
||||||
then Right rl
|
then Right rl
|
||||||
else Left ("This role name is already in use" :: Text)
|
else Left ("This role name is already in use" :: Text)
|
||||||
|
|
||||||
newProjectOpField :: AppDB ProjectRoleId -> Field Handler ProjectOperation
|
newProjectOpField :: AppDB RoleId -> Field Handler ProjectOperation
|
||||||
newProjectOpField getrid = checkOpNew getrid opField
|
newProjectOpField getrid = checkOpNew getrid opField
|
||||||
where
|
where
|
||||||
opField :: Field Handler ProjectOperation
|
opField :: Field Handler ProjectOperation
|
||||||
opField = selectField optionsEnum
|
opField = selectField optionsEnum
|
||||||
|
|
||||||
checkOpNew
|
checkOpNew
|
||||||
:: AppDB ProjectRoleId
|
:: AppDB RoleId
|
||||||
-> Field Handler ProjectOperation
|
-> Field Handler ProjectOperation
|
||||||
-> Field Handler ProjectOperation
|
-> Field Handler ProjectOperation
|
||||||
checkOpNew getrid = checkM $ \ op -> do
|
checkOpNew getrid = checkM $ \ op -> do
|
||||||
ma <- runDB $ do
|
ma <- runDB $ do
|
||||||
rid <- getrid
|
rid <- getrid
|
||||||
getBy $ UniqueProjectAccess rid op
|
getBy $ UniqueRoleAccess rid op
|
||||||
return $ case ma of
|
return $ case ma of
|
||||||
Nothing -> Right op
|
Nothing -> Right op
|
||||||
Just _ -> Left ("Role already has this operation" :: Text)
|
Just _ -> Left ("Role already has this operation" :: Text)
|
||||||
|
|
|
@ -39,7 +39,7 @@ data NewProject = NewProject
|
||||||
, npName :: Maybe Text
|
, npName :: Maybe Text
|
||||||
, npDesc :: Maybe Text
|
, npDesc :: Maybe Text
|
||||||
, npWflow :: WorkflowId
|
, npWflow :: WorkflowId
|
||||||
, npRole :: Maybe ProjectRoleId
|
, npRole :: Maybe RoleId
|
||||||
}
|
}
|
||||||
|
|
||||||
newProjectAForm :: SharerId -> AForm Handler NewProject
|
newProjectAForm :: SharerId -> AForm Handler NewProject
|
||||||
|
@ -52,8 +52,8 @@ newProjectAForm sid = NewProject
|
||||||
where
|
where
|
||||||
selectRole =
|
selectRole =
|
||||||
selectField $
|
selectField $
|
||||||
optionsPersistKey [ProjectRoleSharer ==. sid] [] $
|
optionsPersistKey [RoleSharer ==. sid] [] $
|
||||||
rl2text . projectRoleIdent
|
rl2text . roleIdent
|
||||||
selectWorkflow = selectField $ do
|
selectWorkflow = selectField $ do
|
||||||
l <- runDB $ select $ from $ \ (w `InnerJoin` s) -> do
|
l <- runDB $ select $ from $ \ (w `InnerJoin` s) -> do
|
||||||
on $ w ^. WorkflowSharer E.==. s ^. SharerId
|
on $ w ^. WorkflowSharer E.==. s ^. SharerId
|
||||||
|
@ -77,7 +77,7 @@ newProjectForm sid = renderDivs $ newProjectAForm sid
|
||||||
|
|
||||||
data NewProjectCollab = NewProjectCollab
|
data NewProjectCollab = NewProjectCollab
|
||||||
{ ncPerson :: PersonId
|
{ ncPerson :: PersonId
|
||||||
, ncRole :: Maybe ProjectRoleId
|
, ncRole :: Maybe RoleId
|
||||||
}
|
}
|
||||||
|
|
||||||
newProjectCollabAForm
|
newProjectCollabAForm
|
||||||
|
@ -98,8 +98,8 @@ newProjectCollabAForm sid jid = NewProjectCollab
|
||||||
optionsPairs $ map (shr2text . unValue *** unValue) l
|
optionsPairs $ map (shr2text . unValue *** unValue) l
|
||||||
selectRole =
|
selectRole =
|
||||||
selectField $
|
selectField $
|
||||||
optionsPersistKey [ProjectRoleSharer ==. sid] [] $
|
optionsPersistKey [RoleSharer ==. sid] [] $
|
||||||
rl2text . projectRoleIdent
|
rl2text . roleIdent
|
||||||
|
|
||||||
newProjectCollabForm :: SharerId -> ProjectId -> Form NewProjectCollab
|
newProjectCollabForm :: SharerId -> ProjectId -> Form NewProjectCollab
|
||||||
newProjectCollabForm sid jid = renderDivs $ newProjectCollabAForm sid jid
|
newProjectCollabForm sid jid = renderDivs $ newProjectCollabAForm sid jid
|
||||||
|
@ -122,8 +122,8 @@ editProjectAForm sid (Entity jid project) = Project
|
||||||
rp2text . repoIdent
|
rp2text . repoIdent
|
||||||
selectRole =
|
selectRole =
|
||||||
selectField $
|
selectField $
|
||||||
optionsPersistKey [ProjectRoleSharer ==. sid] [] $
|
optionsPersistKey [RoleSharer ==. sid] [] $
|
||||||
rl2text . projectRoleIdent
|
rl2text . roleIdent
|
||||||
|
|
||||||
editProjectForm :: SharerId -> Entity Project -> Form Project
|
editProjectForm :: SharerId -> Entity Project -> Form Project
|
||||||
editProjectForm s j = renderDivs $ editProjectAForm s j
|
editProjectForm s j = renderDivs $ editProjectAForm s j
|
||||||
|
|
|
@ -39,7 +39,7 @@ data NewRepo = NewRepo
|
||||||
, nrpVcs :: VersionControlSystem
|
, nrpVcs :: VersionControlSystem
|
||||||
, nrpProj :: Maybe ProjectId
|
, nrpProj :: Maybe ProjectId
|
||||||
, nrpDesc :: Maybe Text
|
, nrpDesc :: Maybe Text
|
||||||
, nrpRole :: Maybe ProjectRoleId
|
, nrpRole :: Maybe RoleId
|
||||||
}
|
}
|
||||||
|
|
||||||
newRepoAForm :: SharerId -> Maybe ProjectId -> AForm Handler NewRepo
|
newRepoAForm :: SharerId -> Maybe ProjectId -> AForm Handler NewRepo
|
||||||
|
@ -57,15 +57,15 @@ newRepoAForm sid mjid = NewRepo
|
||||||
]
|
]
|
||||||
selectRole =
|
selectRole =
|
||||||
selectField $
|
selectField $
|
||||||
optionsPersistKey [ProjectRoleSharer ==. sid] [] $
|
optionsPersistKey [RoleSharer ==. sid] [] $
|
||||||
rl2text . projectRoleIdent
|
rl2text . roleIdent
|
||||||
|
|
||||||
newRepoForm :: SharerId -> Maybe ProjectId -> Form NewRepo
|
newRepoForm :: SharerId -> Maybe ProjectId -> Form NewRepo
|
||||||
newRepoForm sid mjid = renderDivs $ newRepoAForm sid mjid
|
newRepoForm sid mjid = renderDivs $ newRepoAForm sid mjid
|
||||||
|
|
||||||
data NewRepoCollab = NewRepoCollab
|
data NewRepoCollab = NewRepoCollab
|
||||||
{ ncPerson :: PersonId
|
{ ncPerson :: PersonId
|
||||||
, ncRole :: Maybe ProjectRoleId
|
, ncRole :: Maybe RoleId
|
||||||
}
|
}
|
||||||
|
|
||||||
newRepoCollabAForm
|
newRepoCollabAForm
|
||||||
|
@ -78,8 +78,8 @@ newRepoCollabAForm sid mjid rid = NewRepoCollab
|
||||||
selectPerson (Just jid) = selectCollabFromProject jid rid
|
selectPerson (Just jid) = selectCollabFromProject jid rid
|
||||||
selectRole =
|
selectRole =
|
||||||
selectField $
|
selectField $
|
||||||
optionsPersistKey [ProjectRoleSharer ==. sid] [] $
|
optionsPersistKey [RoleSharer ==. sid] [] $
|
||||||
rl2text . projectRoleIdent
|
rl2text . roleIdent
|
||||||
|
|
||||||
newRepoCollabForm
|
newRepoCollabForm
|
||||||
:: SharerId -> Maybe ProjectId -> RepoId -> Form NewRepoCollab
|
:: SharerId -> Maybe ProjectId -> RepoId -> Form NewRepoCollab
|
||||||
|
@ -103,8 +103,8 @@ editRepoAForm sid (Entity rid repo) = Repo
|
||||||
selectProject' = selectProjectForExisting (repoSharer repo) rid
|
selectProject' = selectProjectForExisting (repoSharer repo) rid
|
||||||
selectRole =
|
selectRole =
|
||||||
selectField $
|
selectField $
|
||||||
optionsPersistKey [ProjectRoleSharer ==. sid] [] $
|
optionsPersistKey [RoleSharer ==. sid] [] $
|
||||||
rl2text . projectRoleIdent
|
rl2text . roleIdent
|
||||||
|
|
||||||
editRepoForm :: SharerId -> Entity Repo -> Form Repo
|
editRepoForm :: SharerId -> Entity Repo -> Form Repo
|
||||||
editRepoForm s r = renderDivs $ editRepoAForm s r
|
editRepoForm s r = renderDivs $ editRepoAForm s r
|
||||||
|
|
|
@ -46,9 +46,9 @@ newProjectRoleAForm sid = NewProjectRole
|
||||||
newProjectRoleForm :: SharerId -> Form NewProjectRole
|
newProjectRoleForm :: SharerId -> Form NewProjectRole
|
||||||
newProjectRoleForm sid = renderDivs $ newProjectRoleAForm sid
|
newProjectRoleForm sid = renderDivs $ newProjectRoleAForm sid
|
||||||
|
|
||||||
newProjectRoleOpAForm :: AppDB ProjectRoleId -> AForm Handler ProjectOperation
|
newProjectRoleOpAForm :: AppDB RoleId -> AForm Handler ProjectOperation
|
||||||
newProjectRoleOpAForm getrid =
|
newProjectRoleOpAForm getrid =
|
||||||
areq (newProjectOpField getrid) "Operation*" Nothing
|
areq (newProjectOpField getrid) "Operation*" Nothing
|
||||||
|
|
||||||
newProjectRoleOpForm :: AppDB ProjectRoleId -> Form ProjectOperation
|
newProjectRoleOpForm :: AppDB RoleId -> Form ProjectOperation
|
||||||
newProjectRoleOpForm getrid = renderDivs $ newProjectRoleOpAForm getrid
|
newProjectRoleOpForm getrid = renderDivs $ newProjectRoleOpAForm getrid
|
||||||
|
|
|
@ -193,11 +193,11 @@ getProjectDevsR shr prj = do
|
||||||
person `InnerJoin`
|
person `InnerJoin`
|
||||||
sharer `LeftOuterJoin`
|
sharer `LeftOuterJoin`
|
||||||
role) -> do
|
role) -> do
|
||||||
on $ collab ^. ProjectCollabRole E.==. role ?. ProjectRoleId
|
on $ collab ^. ProjectCollabRole E.==. role ?. RoleId
|
||||||
on $ person ^. PersonIdent E.==. sharer ^. SharerId
|
on $ person ^. PersonIdent E.==. sharer ^. SharerId
|
||||||
on $ collab ^. ProjectCollabPerson E.==. person ^. PersonId
|
on $ collab ^. ProjectCollabPerson E.==. person ^. PersonId
|
||||||
where_ $ collab ^. ProjectCollabProject E.==. val jid
|
where_ $ collab ^. ProjectCollabProject E.==. val jid
|
||||||
return (sharer, role ?. ProjectRoleIdent)
|
return (sharer, role ?. RoleIdent)
|
||||||
defaultLayout $(widgetFile "project/collab/list")
|
defaultLayout $(widgetFile "project/collab/list")
|
||||||
|
|
||||||
postProjectDevsR :: ShrIdent -> PrjIdent -> Handler Html
|
postProjectDevsR :: ShrIdent -> PrjIdent -> Handler Html
|
||||||
|
@ -246,7 +246,7 @@ getProjectDevR shr prj dev = do
|
||||||
Entity p _ <- getBy404 $ UniquePersonIdent s
|
Entity p _ <- getBy404 $ UniquePersonIdent s
|
||||||
return p
|
return p
|
||||||
Entity _cid collab <- getBy404 $ UniqueProjectCollab jid pid
|
Entity _cid collab <- getBy404 $ UniqueProjectCollab jid pid
|
||||||
fmap projectRoleIdent <$> traverse getJust (projectCollabRole collab)
|
fmap roleIdent <$> traverse getJust (projectCollabRole collab)
|
||||||
defaultLayout $(widgetFile "project/collab/one")
|
defaultLayout $(widgetFile "project/collab/one")
|
||||||
|
|
||||||
deleteProjectDevR :: ShrIdent -> PrjIdent -> ShrIdent -> Handler Html
|
deleteProjectDevR :: ShrIdent -> PrjIdent -> ShrIdent -> Handler Html
|
||||||
|
|
|
@ -283,11 +283,11 @@ getRepoDevsR shr rp = do
|
||||||
person `InnerJoin`
|
person `InnerJoin`
|
||||||
sharer `LeftOuterJoin`
|
sharer `LeftOuterJoin`
|
||||||
role) -> do
|
role) -> do
|
||||||
on $ collab ^. RepoCollabRole ==. role ?. ProjectRoleId
|
on $ collab ^. RepoCollabRole ==. role ?. RoleId
|
||||||
on $ person ^. PersonIdent ==. sharer ^. SharerId
|
on $ person ^. PersonIdent ==. sharer ^. SharerId
|
||||||
on $ collab ^. RepoCollabPerson ==. person ^. PersonId
|
on $ collab ^. RepoCollabPerson ==. person ^. PersonId
|
||||||
where_ $ collab ^. RepoCollabRepo ==. val rid
|
where_ $ collab ^. RepoCollabRepo ==. val rid
|
||||||
return (sharer, role ?. ProjectRoleIdent)
|
return (sharer, role ?. RoleIdent)
|
||||||
defaultLayout $(widgetFile "repo/collab/list")
|
defaultLayout $(widgetFile "repo/collab/list")
|
||||||
|
|
||||||
postRepoDevsR :: ShrIdent -> RpIdent -> Handler Html
|
postRepoDevsR :: ShrIdent -> RpIdent -> Handler Html
|
||||||
|
@ -337,7 +337,7 @@ getRepoDevR shr rp dev = do
|
||||||
Entity p _ <- getBy404 $ UniquePersonIdent s
|
Entity p _ <- getBy404 $ UniquePersonIdent s
|
||||||
return p
|
return p
|
||||||
Entity _cid collab <- getBy404 $ UniqueRepoCollab rid pid
|
Entity _cid collab <- getBy404 $ UniqueRepoCollab rid pid
|
||||||
fmap projectRoleIdent <$> traverse getJust (repoCollabRole collab)
|
fmap roleIdent <$> traverse getJust (repoCollabRole collab)
|
||||||
defaultLayout $(widgetFile "repo/collab/one")
|
defaultLayout $(widgetFile "repo/collab/one")
|
||||||
|
|
||||||
deleteRepoDevR :: ShrIdent -> RpIdent -> ShrIdent -> Handler Html
|
deleteRepoDevR :: ShrIdent -> RpIdent -> ShrIdent -> Handler Html
|
||||||
|
|
|
@ -64,10 +64,10 @@ postProjectRolesR shr = do
|
||||||
case result of
|
case result of
|
||||||
FormSuccess npr -> do
|
FormSuccess npr -> do
|
||||||
runDB $ do
|
runDB $ do
|
||||||
let role = ProjectRole
|
let role = Role
|
||||||
{ projectRoleIdent = nprIdent npr
|
{ roleIdent = nprIdent npr
|
||||||
, projectRoleSharer = sid
|
, roleSharer = sid
|
||||||
, projectRoleDesc = nprDesc npr
|
, roleDesc = nprDesc npr
|
||||||
}
|
}
|
||||||
insert_ role
|
insert_ role
|
||||||
redirect $ ProjectRolesR shr
|
redirect $ ProjectRolesR shr
|
||||||
|
@ -88,14 +88,14 @@ getProjectRoleR :: ShrIdent -> RlIdent -> Handler Html
|
||||||
getProjectRoleR shr rl = do
|
getProjectRoleR shr rl = do
|
||||||
Entity _rid role <- runDB $ do
|
Entity _rid role <- runDB $ do
|
||||||
Entity sid _ <- getBy404 $ UniqueSharer shr
|
Entity sid _ <- getBy404 $ UniqueSharer shr
|
||||||
getBy404 $ UniqueProjectRole sid rl
|
getBy404 $ UniqueRole sid rl
|
||||||
defaultLayout $(widgetFile "project/role/one")
|
defaultLayout $(widgetFile "project/role/one")
|
||||||
|
|
||||||
deleteProjectRoleR :: ShrIdent -> RlIdent -> Handler Html
|
deleteProjectRoleR :: ShrIdent -> RlIdent -> Handler Html
|
||||||
deleteProjectRoleR shr rl = do
|
deleteProjectRoleR shr rl = do
|
||||||
runDB $ do
|
runDB $ do
|
||||||
Entity sid _s <- getBy404 $ UniqueSharer shr
|
Entity sid _s <- getBy404 $ UniqueSharer shr
|
||||||
Entity rid _r <- getBy404 $ UniqueProjectRole sid rl
|
Entity rid _r <- getBy404 $ UniqueRole sid rl
|
||||||
delete rid
|
delete rid
|
||||||
setMessage "Role deleted."
|
setMessage "Role deleted."
|
||||||
redirect $ ProjectRolesR shr
|
redirect $ ProjectRolesR shr
|
||||||
|
@ -111,24 +111,24 @@ getProjectRoleOpsR :: ShrIdent -> RlIdent -> Handler Html
|
||||||
getProjectRoleOpsR shr rl = do
|
getProjectRoleOpsR shr rl = do
|
||||||
ops <- runDB $ do
|
ops <- runDB $ do
|
||||||
Entity sid _s <- getBy404 $ UniqueSharer shr
|
Entity sid _s <- getBy404 $ UniqueSharer shr
|
||||||
Entity rid _r <- getBy404 $ UniqueProjectRole sid rl
|
Entity rid _r <- getBy404 $ UniqueRole sid rl
|
||||||
as <- selectList [ProjectAccessRole ==. rid] []
|
as <- selectList [RoleAccessRole ==. rid] []
|
||||||
return $ map (projectAccessOp . entityVal) as
|
return $ map (roleAccessOp . entityVal) as
|
||||||
defaultLayout $(widgetFile "project/role/op/list")
|
defaultLayout $(widgetFile "project/role/op/list")
|
||||||
|
|
||||||
postProjectRoleOpsR :: ShrIdent -> RlIdent -> Handler Html
|
postProjectRoleOpsR :: ShrIdent -> RlIdent -> Handler Html
|
||||||
postProjectRoleOpsR shr rl = do
|
postProjectRoleOpsR shr rl = do
|
||||||
let getrid = do
|
let getrid = do
|
||||||
Entity sid _ <- getBy404 $ UniqueSharer shr
|
Entity sid _ <- getBy404 $ UniqueSharer shr
|
||||||
fmap entityKey $ getBy404 $ UniqueProjectRole sid rl
|
fmap entityKey $ getBy404 $ UniqueRole sid rl
|
||||||
((result, widget), enctype) <- runFormPost $ newProjectRoleOpForm getrid
|
((result, widget), enctype) <- runFormPost $ newProjectRoleOpForm getrid
|
||||||
case result of
|
case result of
|
||||||
FormSuccess op -> do
|
FormSuccess op -> do
|
||||||
runDB $ do
|
runDB $ do
|
||||||
rid <- getrid
|
rid <- getrid
|
||||||
let access = ProjectAccess
|
let access = RoleAccess
|
||||||
{ projectAccessRole = rid
|
{ roleAccessRole = rid
|
||||||
, projectAccessOp = op
|
, roleAccessOp = op
|
||||||
}
|
}
|
||||||
insert_ access
|
insert_ access
|
||||||
redirect $ ProjectRoleOpsR shr rl
|
redirect $ ProjectRoleOpsR shr rl
|
||||||
|
@ -143,6 +143,6 @@ getProjectRoleOpNewR :: ShrIdent -> RlIdent -> Handler Html
|
||||||
getProjectRoleOpNewR shr rl = do
|
getProjectRoleOpNewR shr rl = do
|
||||||
let getrid = do
|
let getrid = do
|
||||||
Entity sid _ <- getBy404 $ UniqueSharer shr
|
Entity sid _ <- getBy404 $ UniqueSharer shr
|
||||||
fmap entityKey $ getBy404 $ UniqueProjectRole sid rl
|
fmap entityKey $ getBy404 $ UniqueRole 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")
|
||||||
|
|
|
@ -474,6 +474,18 @@ changes hLocal ctx =
|
||||||
"OutboxItem"
|
"OutboxItem"
|
||||||
-- 78
|
-- 78
|
||||||
, addUnique "LocalMessage" $ Unique "UniqueLocalMessageCreate" ["create"]
|
, addUnique "LocalMessage" $ Unique "UniqueLocalMessageCreate" ["create"]
|
||||||
|
-- 79
|
||||||
|
, renameEntity "ProjectRole" "Role"
|
||||||
|
-- 80
|
||||||
|
, renameUnique "Role" "UniqueProjectRole" "UniqueRole"
|
||||||
|
-- 81
|
||||||
|
, renameEntity "ProjectRoleInherit" "RoleInherit"
|
||||||
|
-- 82
|
||||||
|
, renameUnique "RoleInherit" "UniqueProjectRoleInherit" "UniqueRoleInherit"
|
||||||
|
-- 83
|
||||||
|
, renameEntity "ProjectAccess" "RoleAccess"
|
||||||
|
-- 84
|
||||||
|
, renameUnique "RoleAccess" "UniqueProjectAccess" "UniqueRoleAccess"
|
||||||
]
|
]
|
||||||
|
|
||||||
migrateDB :: MonadIO m => Text -> HashidsContext -> ReaderT SqlBackend m (Either Text (Int, Int))
|
migrateDB :: MonadIO m => Text -> HashidsContext -> ReaderT SqlBackend m (Either Text (Int, Int))
|
||||||
|
|
|
@ -71,7 +71,7 @@ instance Hashable MessageId where
|
||||||
hash = hash . fromSqlKey
|
hash = hash . fromSqlKey
|
||||||
|
|
||||||
-- "Vervis.Role" uses a 'HashMap' where the key type is 'ProjectRoleId'
|
-- "Vervis.Role" uses a 'HashMap' where the key type is 'ProjectRoleId'
|
||||||
instance Hashable ProjectRoleId where
|
instance Hashable RoleId where
|
||||||
hashWithSalt salt = hashWithSalt salt . fromSqlKey
|
hashWithSalt salt = hashWithSalt salt . fromSqlKey
|
||||||
hash = hash . fromSqlKey
|
hash = hash . fromSqlKey
|
||||||
|
|
||||||
|
|
|
@ -45,12 +45,12 @@ import Vervis.Model.Role
|
||||||
getProjectRoleAncestorWithOpQ
|
getProjectRoleAncestorWithOpQ
|
||||||
:: MonadIO m
|
:: MonadIO m
|
||||||
=> ProjectOperation
|
=> ProjectOperation
|
||||||
-> ProjectRoleId
|
-> RoleId
|
||||||
-> ReaderT SqlBackend m (Maybe (Entity ProjectAccess))
|
-> ReaderT SqlBackend m (Maybe (Entity RoleAccess))
|
||||||
getProjectRoleAncestorWithOpQ op role = do
|
getProjectRoleAncestorWithOpQ op role = do
|
||||||
conn <- ask
|
conn <- ask
|
||||||
let dbname = connEscapeName conn
|
let dbname = connEscapeName conn
|
||||||
eAcc = entityDef $ dummyFromField ProjectAccessId
|
eAcc = entityDef $ dummyFromField RoleAccessId
|
||||||
tAcc = dbname $ entityDB eAcc
|
tAcc = dbname $ entityDB eAcc
|
||||||
qcols =
|
qcols =
|
||||||
T.intercalate ", " $
|
T.intercalate ", " $
|
||||||
|
@ -62,17 +62,17 @@ getProjectRoleAncestorWithOpQ op role = do
|
||||||
rawSqlWithGraph
|
rawSqlWithGraph
|
||||||
Ancestors
|
Ancestors
|
||||||
role
|
role
|
||||||
ProjectRoleInheritParent
|
RoleInheritParent
|
||||||
ProjectRoleInheritChild
|
RoleInheritChild
|
||||||
(\ temp -> mconcat
|
(\ temp -> mconcat
|
||||||
[ "SELECT ??"
|
[ "SELECT ??"
|
||||||
, " FROM ", dbname temp, " INNER JOIN ", tAcc
|
, " FROM ", dbname temp, " INNER JOIN ", tAcc
|
||||||
, " ON "
|
, " ON "
|
||||||
, dbname temp, ".", field ProjectRoleInheritParent
|
, dbname temp, ".", field RoleInheritParent
|
||||||
, " = "
|
, " = "
|
||||||
, tAcc, ".", field ProjectAccessRole
|
, tAcc, ".", field RoleAccessRole
|
||||||
, " WHERE "
|
, " WHERE "
|
||||||
, tAcc, ".", field ProjectAccessOp
|
, tAcc, ".", field RoleAccessOp
|
||||||
, " = ?"
|
, " = ?"
|
||||||
, " LIMIT 1"
|
, " LIMIT 1"
|
||||||
]
|
]
|
||||||
|
|
|
@ -37,14 +37,14 @@ import Vervis.Model.Ident
|
||||||
getProjectRoleGraph :: SharerId -> AppDB (Gr RlIdent ())
|
getProjectRoleGraph :: SharerId -> AppDB (Gr RlIdent ())
|
||||||
getProjectRoleGraph sid = do
|
getProjectRoleGraph sid = do
|
||||||
(roles, inhs) <- do
|
(roles, inhs) <- do
|
||||||
prs <- P.selectList [ProjectRoleSharer P.==. sid] []
|
prs <- P.selectList [RoleSharer P.==. sid] []
|
||||||
prhs <- select $ from $ \ (pr `InnerJoin` prh) -> do
|
prhs <- select $ from $ \ (pr `InnerJoin` prh) -> do
|
||||||
on $ pr ^. ProjectRoleId ==. prh ^. ProjectRoleInheritParent
|
on $ pr ^. RoleId ==. prh ^. RoleInheritParent
|
||||||
where_ $ pr ^. ProjectRoleSharer ==. val sid
|
where_ $ pr ^. RoleSharer ==. val sid
|
||||||
return prh
|
return prh
|
||||||
return (prs, prhs)
|
return (prs, prhs)
|
||||||
let numbered = zip [1..] roles
|
let numbered = zip [1..] roles
|
||||||
nodes = map (second $ projectRoleIdent . entityVal) numbered
|
nodes = map (second $ roleIdent . entityVal) numbered
|
||||||
nodeMap = M.fromList $ map (swap . second entityKey) numbered
|
nodeMap = M.fromList $ map (swap . second entityKey) numbered
|
||||||
pridToNode prid =
|
pridToNode prid =
|
||||||
case M.lookup prid nodeMap of
|
case M.lookup prid nodeMap of
|
||||||
|
@ -54,7 +54,7 @@ getProjectRoleGraph sid = do
|
||||||
map
|
map
|
||||||
( (\ (c, p) -> (c, p, ()))
|
( (\ (c, p) -> (c, p, ()))
|
||||||
. (pridToNode *** pridToNode)
|
. (pridToNode *** pridToNode)
|
||||||
. (projectRoleInheritChild &&& projectRoleInheritParent)
|
. (roleInheritChild &&& roleInheritParent)
|
||||||
. entityVal
|
. entityVal
|
||||||
)
|
)
|
||||||
inhs
|
inhs
|
||||||
|
|
|
@ -19,4 +19,4 @@ $# <http://creativecommons.org/publicdomain/zero/1.0/>.
|
||||||
<a href=@{ProjectRoleOpsR shr rl}>Operations
|
<a href=@{ProjectRoleOpsR shr rl}>Operations
|
||||||
|
|
||||||
<p>
|
<p>
|
||||||
#{projectRoleDesc role}
|
#{roleDesc role}
|
||||||
|
|
Loading…
Reference in a new issue