forge/Vervis
1
0
Fork 0
Code Pull requests Activity

Rename role related tables to reflect the role unification

Browse source 
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:
fr33domlover 2019-05-31 15:02:57 +00:00
parent dccb91f47c
commit 21b7325c1b
14 changed files with 86 additions and 74 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

30
config/models
View file

@ -176,24 +176,24 @@ GroupMember
UniqueGroupMember person group
ProjectRole
Role
ident RlIdent
sharer SharerId
desc Text
UniqueProjectRole sharer ident
UniqueRole sharer ident
ProjectRoleInherit
parent ProjectRoleId
child ProjectRoleId
RoleInherit
parent RoleId
child RoleId
UniqueProjectRoleInherit parent child
UniqueRoleInherit parent child
ProjectAccess
role ProjectRoleId
RoleAccess
role RoleId
op ProjectOperation
UniqueProjectAccess role op
UniqueRoleAccess role op
-------------------------------------------------------------------------------
-- Projects
@ -207,8 +207,8 @@ Project
workflow WorkflowId
nextTicket Int
wiki RepoId Maybe
collabUser ProjectRoleId Maybe
collabAnon ProjectRoleId Maybe
collabUser RoleId Maybe
collabAnon RoleId Maybe
UniqueProject ident sharer
@ -219,8 +219,8 @@ Repo
project ProjectId Maybe
desc Text Maybe
mainBranch Text
collabUser ProjectRoleId Maybe
collabAnon ProjectRoleId Maybe
collabUser RoleId Maybe
collabAnon RoleId Maybe
UniqueRepo ident sharer
@ -348,13 +348,13 @@ RemoteMessage
RepoCollab
repo RepoId
person PersonId
role ProjectRoleId Maybe
role RoleId Maybe
UniqueRepoCollab repo person
ProjectCollab
project ProjectId
person PersonId
role ProjectRoleId Maybe
role RoleId Maybe
UniqueProjectCollab project person

2
src/Vervis/Access.hs
View file

@ -106,7 +106,7 @@ roleHasAccess (RoleID rlid) op =
fmap isJust . runMaybeT $
MaybeT (roleHas rlid op) <|> MaybeT (ancestorHas rlid op)
where
roleHas role operation = getBy $ UniqueProjectAccess role operation
roleHas role operation = getBy $ UniqueRoleAccess role operation
ancestorHas = flip getProjectRoleAncestorWithOpQ
status :: Bool -> ObjectAccessStatus

10
src/Vervis/Field/Role.hs
View file

@ -43,28 +43,28 @@ newProjectRoleIdentField sid = checkUniqueCI roleIdentField
checkUniqueCI = checkM $ \ rl -> do
sames <- runDB $ select $ from $ \ role -> do
where_ $
role ^. ProjectRoleSharer ==. val sid &&.
lower_ (role ^. ProjectRoleIdent) ==. lower_ (val rl)
role ^. RoleSharer ==. val sid &&.
lower_ (role ^. RoleIdent) ==. lower_ (val rl)
limit 1
return ()
return $ if null sames
then Right rl
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
where
opField :: Field Handler ProjectOperation
opField = selectField optionsEnum
checkOpNew
:: AppDB ProjectRoleId
:: AppDB RoleId
-> Field Handler ProjectOperation
-> Field Handler ProjectOperation
checkOpNew getrid = checkM $ \ op -> do
ma <- runDB $ do
rid <- getrid
getBy $ UniqueProjectAccess rid op
getBy $ UniqueRoleAccess rid op
return $ case ma of
Nothing -> Right op
Just _ -> Left ("Role already has this operation" :: Text)

16
src/Vervis/Form/Project.hs
View file

@ -39,7 +39,7 @@ data NewProject = NewProject
, npName :: Maybe Text
, npDesc :: Maybe Text
, npWflow :: WorkflowId
, npRole :: Maybe ProjectRoleId
, npRole :: Maybe RoleId
}
newProjectAForm :: SharerId -> AForm Handler NewProject
@ -52,8 +52,8 @@ newProjectAForm sid = NewProject
where
selectRole =
selectField $
optionsPersistKey [ProjectRoleSharer ==. sid] [] $
rl2text . projectRoleIdent
optionsPersistKey [RoleSharer ==. sid] [] $
rl2text . roleIdent
selectWorkflow = selectField $ do
l <- runDB $ select $ from $ \ (w `InnerJoin` s) -> do
on $ w ^. WorkflowSharer E.==. s ^. SharerId
@ -77,7 +77,7 @@ newProjectForm sid = renderDivs $ newProjectAForm sid
data NewProjectCollab = NewProjectCollab
{ ncPerson :: PersonId
, ncRole :: Maybe ProjectRoleId
, ncRole :: Maybe RoleId
}
newProjectCollabAForm
@ -98,8 +98,8 @@ newProjectCollabAForm sid jid = NewProjectCollab
optionsPairs $ map (shr2text . unValue *** unValue) l
selectRole =
selectField $
optionsPersistKey [ProjectRoleSharer ==. sid] [] $
rl2text . projectRoleIdent
optionsPersistKey [RoleSharer ==. sid] [] $
rl2text . roleIdent
newProjectCollabForm :: SharerId -> ProjectId -> Form NewProjectCollab
newProjectCollabForm sid jid = renderDivs $ newProjectCollabAForm sid jid
@ -122,8 +122,8 @@ editProjectAForm sid (Entity jid project) = Project
rp2text . repoIdent
selectRole =
selectField $
optionsPersistKey [ProjectRoleSharer ==. sid] [] $
rl2text . projectRoleIdent
optionsPersistKey [RoleSharer ==. sid] [] $
rl2text . roleIdent
editProjectForm :: SharerId -> Entity Project -> Form Project
editProjectForm s j = renderDivs $ editProjectAForm s j

16
src/Vervis/Form/Repo.hs
View file

@ -39,7 +39,7 @@ data NewRepo = NewRepo
, nrpVcs :: VersionControlSystem
, nrpProj :: Maybe ProjectId
, nrpDesc :: Maybe Text
, nrpRole :: Maybe ProjectRoleId
, nrpRole :: Maybe RoleId
}
newRepoAForm :: SharerId -> Maybe ProjectId -> AForm Handler NewRepo
@ -57,15 +57,15 @@ newRepoAForm sid mjid = NewRepo
]
selectRole =
selectField $
optionsPersistKey [ProjectRoleSharer ==. sid] [] $
rl2text . projectRoleIdent
optionsPersistKey [RoleSharer ==. sid] [] $
rl2text . roleIdent
newRepoForm :: SharerId -> Maybe ProjectId -> Form NewRepo
newRepoForm sid mjid = renderDivs $ newRepoAForm sid mjid
data NewRepoCollab = NewRepoCollab
{ ncPerson :: PersonId
, ncRole :: Maybe ProjectRoleId
, ncRole :: Maybe RoleId
}
newRepoCollabAForm
@ -78,8 +78,8 @@ newRepoCollabAForm sid mjid rid = NewRepoCollab
selectPerson (Just jid) = selectCollabFromProject jid rid
selectRole =
selectField $
optionsPersistKey [ProjectRoleSharer ==. sid] [] $
rl2text . projectRoleIdent
optionsPersistKey [RoleSharer ==. sid] [] $
rl2text . roleIdent
newRepoCollabForm
:: SharerId -> Maybe ProjectId -> RepoId -> Form NewRepoCollab
@ -103,8 +103,8 @@ editRepoAForm sid (Entity rid repo) = Repo
selectProject' = selectProjectForExisting (repoSharer repo) rid
selectRole =
selectField $
optionsPersistKey [ProjectRoleSharer ==. sid] [] $
rl2text . projectRoleIdent
optionsPersistKey [RoleSharer ==. sid] [] $
rl2text . roleIdent
editRepoForm :: SharerId -> Entity Repo -> Form Repo
editRepoForm s r = renderDivs $ editRepoAForm s r

4
src/Vervis/Form/Role.hs
View file

@ -46,9 +46,9 @@ newProjectRoleAForm sid = NewProjectRole
newProjectRoleForm :: SharerId -> Form NewProjectRole
newProjectRoleForm sid = renderDivs $ newProjectRoleAForm sid
newProjectRoleOpAForm :: AppDB ProjectRoleId -> AForm Handler ProjectOperation
newProjectRoleOpAForm :: AppDB RoleId -> AForm Handler ProjectOperation
newProjectRoleOpAForm getrid =
areq (newProjectOpField getrid) "Operation*" Nothing
newProjectRoleOpForm :: AppDB ProjectRoleId -> Form ProjectOperation
newProjectRoleOpForm :: AppDB RoleId -> Form ProjectOperation
newProjectRoleOpForm getrid = renderDivs $ newProjectRoleOpAForm getrid

6
src/Vervis/Handler/Project.hs
View file

@ -193,11 +193,11 @@ getProjectDevsR shr prj = do
person `InnerJoin`
sharer `LeftOuterJoin`
role) -> do
on $ collab ^. ProjectCollabRole E.==. role ?. ProjectRoleId
on $ collab ^. ProjectCollabRole E.==. role ?. RoleId
on $ person ^. PersonIdent E.==. sharer ^. SharerId
on $ collab ^. ProjectCollabPerson E.==. person ^. PersonId
where_ $ collab ^. ProjectCollabProject E.==. val jid
return (sharer, role ?. ProjectRoleIdent)
return (sharer, role ?. RoleIdent)
defaultLayout $(widgetFile "project/collab/list")
postProjectDevsR :: ShrIdent -> PrjIdent -> Handler Html
@ -246,7 +246,7 @@ getProjectDevR shr prj dev = do
Entity p _ <- getBy404 $ UniquePersonIdent s
return p
Entity _cid collab <- getBy404 $ UniqueProjectCollab jid pid
fmap projectRoleIdent <$> traverse getJust (projectCollabRole collab)
fmap roleIdent <$> traverse getJust (projectCollabRole collab)
defaultLayout $(widgetFile "project/collab/one")
deleteProjectDevR :: ShrIdent -> PrjIdent -> ShrIdent -> Handler Html

6
src/Vervis/Handler/Repo.hs
View file

@ -283,11 +283,11 @@ getRepoDevsR shr rp = do
person `InnerJoin`
sharer `LeftOuterJoin`
role) -> do
on $ collab ^. RepoCollabRole ==. role ?. ProjectRoleId
on $ collab ^. RepoCollabRole ==. role ?. RoleId
on $ person ^. PersonIdent ==. sharer ^. SharerId
on $ collab ^. RepoCollabPerson ==. person ^. PersonId
where_ $ collab ^. RepoCollabRepo ==. val rid
return (sharer, role ?. ProjectRoleIdent)
return (sharer, role ?. RoleIdent)
defaultLayout $(widgetFile "repo/collab/list")
postRepoDevsR :: ShrIdent -> RpIdent -> Handler Html
@ -337,7 +337,7 @@ getRepoDevR shr rp dev = do
Entity p _ <- getBy404 $ UniquePersonIdent s
return p
Entity _cid collab <- getBy404 $ UniqueRepoCollab rid pid
fmap projectRoleIdent <$> traverse getJust (repoCollabRole collab)
fmap roleIdent <$> traverse getJust (repoCollabRole collab)
defaultLayout $(widgetFile "repo/collab/one")
deleteRepoDevR :: ShrIdent -> RpIdent -> ShrIdent -> Handler Html

28
src/Vervis/Handler/Role.hs
View file

@ -64,10 +64,10 @@ postProjectRolesR shr = do
case result of
FormSuccess npr -> do
runDB $ do
let role = ProjectRole
{ projectRoleIdent = nprIdent npr
, projectRoleSharer = sid
, projectRoleDesc = nprDesc npr
let role = Role
{ roleIdent = nprIdent npr
, roleSharer = sid
, roleDesc = nprDesc npr
}
insert_ role
redirect $ ProjectRolesR shr
@ -88,14 +88,14 @@ getProjectRoleR :: ShrIdent -> RlIdent -> Handler Html
getProjectRoleR shr rl = do
Entity _rid role <- runDB $ do
Entity sid _ <- getBy404 $ UniqueSharer shr
getBy404 $ UniqueProjectRole sid rl
getBy404 $ UniqueRole sid rl
defaultLayout $(widgetFile "project/role/one")
deleteProjectRoleR :: ShrIdent -> RlIdent -> Handler Html
deleteProjectRoleR shr rl = do
runDB $ do
Entity sid _s <- getBy404 $ UniqueSharer shr
Entity rid _r <- getBy404 $ UniqueProjectRole sid rl
Entity rid _r <- getBy404 $ UniqueRole sid rl
delete rid
setMessage "Role deleted."
redirect $ ProjectRolesR shr
@ -111,24 +111,24 @@ getProjectRoleOpsR :: ShrIdent -> RlIdent -> Handler Html
getProjectRoleOpsR shr rl = do
ops <- runDB $ do
Entity sid _s <- getBy404 $ UniqueSharer shr
Entity rid _r <- getBy404 $ UniqueProjectRole sid rl
as <- selectList [ProjectAccessRole ==. rid] []
return $ map (projectAccessOp . entityVal) as
Entity rid _r <- getBy404 $ UniqueRole sid rl
as <- selectList [RoleAccessRole ==. rid] []
return $ map (roleAccessOp . entityVal) as
defaultLayout $(widgetFile "project/role/op/list")
postProjectRoleOpsR :: ShrIdent -> RlIdent -> Handler Html
postProjectRoleOpsR shr rl = do
let getrid = do
Entity sid _ <- getBy404 $ UniqueSharer shr
fmap entityKey $ getBy404 $ UniqueProjectRole sid rl
fmap entityKey $ getBy404 $ UniqueRole sid rl
((result, widget), enctype) <- runFormPost $ newProjectRoleOpForm getrid
case result of
FormSuccess op -> do
runDB $ do
rid <- getrid
let access = ProjectAccess
{ projectAccessRole = rid
, projectAccessOp = op
let access = RoleAccess
{ roleAccessRole = rid
, roleAccessOp = op
}
insert_ access
redirect $ ProjectRoleOpsR shr rl
@ -143,6 +143,6 @@ getProjectRoleOpNewR :: ShrIdent -> RlIdent -> Handler Html
getProjectRoleOpNewR shr rl = do
let getrid = do
Entity sid _ <- getBy404 $ UniqueSharer shr
fmap entityKey $ getBy404 $ UniqueProjectRole sid rl
fmap entityKey $ getBy404 $ UniqueRole sid rl
((_result, widget), enctype) <- runFormPost $ newProjectRoleOpForm getrid
defaultLayout $(widgetFile "project/role/op/new")

12
src/Vervis/Migration.hs
View file

@ -474,6 +474,18 @@ changes hLocal ctx =
"OutboxItem"
-- 78
, 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))

2
src/Vervis/Model.hs
View file

@ -71,7 +71,7 @@ instance Hashable MessageId where
hash = hash . fromSqlKey
-- "Vervis.Role" uses a 'HashMap' where the key type is 'ProjectRoleId'
instance Hashable ProjectRoleId where
instance Hashable RoleId where
hashWithSalt salt = hashWithSalt salt . fromSqlKey
hash = hash . fromSqlKey

16
src/Vervis/Query.hs
View file

@ -45,12 +45,12 @@ import Vervis.Model.Role
getProjectRoleAncestorWithOpQ
:: MonadIO m
=> ProjectOperation
-> ProjectRoleId
-> ReaderT SqlBackend m (Maybe (Entity ProjectAccess))
-> RoleId
-> ReaderT SqlBackend m (Maybe (Entity RoleAccess))
getProjectRoleAncestorWithOpQ op role = do
conn <- ask
let dbname = connEscapeName conn
eAcc = entityDef $ dummyFromField ProjectAccessId
eAcc = entityDef $ dummyFromField RoleAccessId
tAcc = dbname $ entityDB eAcc
qcols =
T.intercalate ", " $
@ -62,17 +62,17 @@ getProjectRoleAncestorWithOpQ op role = do
rawSqlWithGraph
Ancestors
role
ProjectRoleInheritParent
ProjectRoleInheritChild
RoleInheritParent
RoleInheritChild
(\ temp -> mconcat
[ "SELECT ??"
, " FROM ", dbname temp, " INNER JOIN ", tAcc
, " ON "
, dbname temp, ".", field ProjectRoleInheritParent
, dbname temp, ".", field RoleInheritParent
, " = "
, tAcc, ".", field ProjectAccessRole
, tAcc, ".", field RoleAccessRole
, " WHERE "
, tAcc, ".", field ProjectAccessOp
, tAcc, ".", field RoleAccessOp
, " = ?"
, " LIMIT 1"
]

10
src/Vervis/Role.hs
View file

@ -37,14 +37,14 @@ import Vervis.Model.Ident
getProjectRoleGraph :: SharerId -> AppDB (Gr RlIdent ())
getProjectRoleGraph sid = do
(roles, inhs) <- do
prs <- P.selectList [ProjectRoleSharer P.==. sid] []
prs <- P.selectList [RoleSharer P.==. sid] []
prhs <- select $ from $ \ (pr `InnerJoin` prh) -> do
on $ pr ^. ProjectRoleId ==. prh ^. ProjectRoleInheritParent
where_ $ pr ^. ProjectRoleSharer ==. val sid
on $ pr ^. RoleId ==. prh ^. RoleInheritParent
where_ $ pr ^. RoleSharer ==. val sid
return prh
return (prs, prhs)
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
pridToNode prid =
case M.lookup prid nodeMap of
@ -54,7 +54,7 @@ getProjectRoleGraph sid = do
map
( (\ (c, p) -> (c, p, ()))
. (pridToNode *** pridToNode)
. (projectRoleInheritChild &&& projectRoleInheritParent)
. (roleInheritChild &&& roleInheritParent)
. entityVal
)
inhs

2
templates/project/role/one.hamlet
View file

@ -19,4 +19,4 @@ $# <http://creativecommons.org/publicdomain/zero/1.0/>.
<a href=@{ProjectRoleOpsR shr rl}>Operations
<p>
#{projectRoleDesc role}
#{roleDesc role}