diff --git a/config/models b/config/models index cded20f..dca1b9a 100644 --- a/config/models +++ b/config/models @@ -53,25 +53,25 @@ GroupMember UniqueGroupMember person group -Role +RepoRole ident RlIdent person PersonId desc Text - UniqueRole person ident + UniqueRepoRole person ident -Access - role RoleId - op Operation +RepoAccess + role RepoRoleId + op RepoOperation - UniqueAccess role op + UniqueRepoAccess role op -Collab +RepoCollab repo RepoId person PersonId - role RoleId + role RepoRoleId - UniqueCollab repo person + UniqueRepoCollab repo person ------------------------------------------------------------------------------- -- Projects diff --git a/config/routes b/config/routes index da098c8..ed0470b 100644 --- a/config/routes +++ b/config/routes @@ -50,11 +50,11 @@ /k/!new KeyNewR GET /k/#KyIdent KeyR GET DELETE POST -/r RolesR GET POST -/r/!new RoleNewR GET -/r/#RlIdent RoleR GET DELETE POST -/r/#RlIdent/a RoleOpsR GET POST -/r/#RlIdent/a/!new RoleOpNewR GET +/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 -- ---------------------------------------------------------------------------- -- Projects diff --git a/src/Vervis/Field/Role.hs b/src/Vervis/Field/Role.hs index c8acc0a..47db2eb 100644 --- a/src/Vervis/Field/Role.hs +++ b/src/Vervis/Field/Role.hs @@ -14,8 +14,8 @@ -} module Vervis.Field.Role - ( newRoleIdentField - , newOpField + ( newRepoRoleIdentField + , newRepoOpField ) where @@ -40,36 +40,38 @@ import Vervis.Model import Vervis.Model.Ident (RlIdent, rl2text, text2rl) import Vervis.Model.Role -checkUniqueCI :: PersonId -> Field Handler RlIdent -> Field Handler RlIdent -checkUniqueCI pid = checkM $ \ rl -> do - sames <- runDB $ select $ from $ \ role -> do - where_ $ - role ^. RolePerson ==. val pid &&. - 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) +newRepoRoleIdentField :: PersonId -> Field Handler RlIdent +newRepoRoleIdentField pid = checkUniqueCI pid roleIdentField + where + roleIdentField :: Field Handler RlIdent + roleIdentField = convertField text2rl rl2text textField -roleIdentField :: Field Handler RlIdent -roleIdentField = convertField text2rl rl2text textField + checkUniqueCI :: PersonId -> Field Handler RlIdent -> Field Handler RlIdent + checkUniqueCI pid = checkM $ \ rl -> do + sames <- runDB $ select $ from $ \ role -> do + where_ $ + role ^. RepoRolePerson ==. val pid &&. + lower_ (role ^. RepoRoleIdent) ==. lower_ (val rl) + limit 1 + return () + return $ if null sames + then Right rl + else Left ("This role name is already in use" :: Text) -newRoleIdentField :: PersonId -> Field Handler RlIdent -newRoleIdentField pid = checkUniqueCI pid roleIdentField +newRepoOpField :: AppDB RepoRoleId -> Field Handler RepoOperation +newRepoOpField getrid = checkOpNew getrid opField + where + opField :: Field Handler RepoOperation + opField = selectField optionsEnum -opField :: Field Handler Operation -opField = selectField optionsEnum - -checkOpNew - :: AppDB RoleId -> Field Handler Operation -> Field Handler Operation -checkOpNew getrid = checkM $ \ op -> do - ma <- runDB $ do - rid <- getrid - getBy $ UniqueAccess rid op - return $ case ma of - Nothing -> Right op - Just _ -> Left ("Role already has this operation" :: Text) - -newOpField :: AppDB RoleId -> Field Handler Operation -newOpField getrid = checkOpNew getrid opField + checkOpNew + :: AppDB RepoRoleId + -> Field Handler RepoOperation + -> Field Handler RepoOperation + checkOpNew getrid = checkM $ \ op -> do + ma <- runDB $ do + rid <- getrid + getBy $ UniqueRepoAccess rid op + return $ case ma of + Nothing -> Right op + Just _ -> Left ("Role already has this operation" :: Text) diff --git a/src/Vervis/Form/Repo.hs b/src/Vervis/Form/Repo.hs index 2b05324..4d3e2ab 100644 --- a/src/Vervis/Form/Repo.hs +++ b/src/Vervis/Form/Repo.hs @@ -16,8 +16,8 @@ module Vervis.Form.Repo ( NewRepo (..) , newRepoForm - , NewCollab (..) - , newCollabForm + , NewRepoCollab (..) + , newRepoCollabForm ) where @@ -38,7 +38,7 @@ data NewRepo = NewRepo , nrpVcs :: VersionControlSystem , nrpProj :: Maybe ProjectId , nrpDesc :: Maybe Text - , nrpRole :: RoleId + , nrpRole :: RepoRoleId } newRepoAForm @@ -61,19 +61,19 @@ newRepoAForm pid sid mpid = NewRepo prj2text . projectIdent selectRole = selectField $ - optionsPersistKey [RolePerson ==. pid] [] $ - rl2text . roleIdent + optionsPersistKey [RepoRolePerson ==. pid] [] $ + rl2text . repoRoleIdent newRepoForm :: PersonId -> SharerId -> Maybe ProjectId -> Form NewRepo newRepoForm pid sid mpid = renderDivs $ newRepoAForm pid sid mpid -data NewCollab = NewCollab +data NewRepoCollab = NewRepoCollab { ncPerson :: PersonId - , ncRole :: RoleId + , ncRole :: RepoRoleId } -newCollabAForm :: PersonId -> RepoId -> AForm Handler NewCollab -newCollabAForm pid rid = NewCollab +newRepoCollabAForm :: PersonId -> RepoId -> AForm Handler NewRepoCollab +newRepoCollabAForm pid rid = NewRepoCollab <$> areq selectPerson "Person*" Nothing <*> areq selectRole "Role*" Nothing where @@ -82,15 +82,15 @@ newCollabAForm pid rid = NewCollab from $ \ (collab `RightOuterJoin` person `InnerJoin` sharer) -> do on $ person ^. PersonIdent E.==. sharer ^. SharerId on $ - collab ?. CollabRepo E.==. just (val rid) &&. - collab ?. CollabPerson E.==. just (person ^. PersonId) - where_ $ isNothing $ collab ?. CollabId + collab ?. RepoCollabRepo E.==. just (val rid) &&. + collab ?. RepoCollabPerson E.==. just (person ^. PersonId) + where_ $ isNothing $ collab ?. RepoCollabId return (sharer ^. SharerIdent, person ^. PersonId) optionsPairs $ map (shr2text . unValue *** unValue) l selectRole = selectField $ - optionsPersistKey [RolePerson ==. pid] [] $ - rl2text . roleIdent + optionsPersistKey [RepoRolePerson ==. pid] [] $ + rl2text . repoRoleIdent -newCollabForm :: PersonId -> RepoId -> Form NewCollab -newCollabForm pid rid = renderDivs $ newCollabAForm pid rid +newRepoCollabForm :: PersonId -> RepoId -> Form NewRepoCollab +newRepoCollabForm pid rid = renderDivs $ newRepoCollabAForm pid rid diff --git a/src/Vervis/Form/Role.hs b/src/Vervis/Form/Role.hs index a1f366c..fd25089 100644 --- a/src/Vervis/Form/Role.hs +++ b/src/Vervis/Form/Role.hs @@ -14,9 +14,9 @@ -} module Vervis.Form.Role - ( NewRole (..) - , newRoleForm - , newRoleOpForm + ( NewRepoRole (..) + , newRepoRoleForm + , newRepoRoleOpForm ) where @@ -33,21 +33,21 @@ import Vervis.Model import Vervis.Model.Ident (RlIdent) import Vervis.Model.Role -data NewRole = NewRole - { nrIdent :: RlIdent - , nrDesc :: Text +data NewRepoRole = NewRepoRole + { nrrIdent :: RlIdent + , nrrDesc :: Text } -newRoleAForm :: PersonId -> AForm Handler NewRole -newRoleAForm pid = NewRole - <$> areq (newRoleIdentField pid) "Name*" Nothing - <*> areq textField "Description" Nothing +newRepoRoleAForm :: PersonId -> AForm Handler NewRepoRole +newRepoRoleAForm pid = NewRepoRole + <$> areq (newRepoRoleIdentField pid) "Name*" Nothing + <*> areq textField "Description" Nothing -newRoleForm :: PersonId -> Form NewRole -newRoleForm pid = renderDivs $ newRoleAForm pid +newRepoRoleForm :: PersonId -> Form NewRepoRole +newRepoRoleForm pid = renderDivs $ newRepoRoleAForm pid -newRoleOpAForm :: AppDB RoleId -> AForm Handler Operation -newRoleOpAForm getrid = areq (newOpField getrid) "Operation*" Nothing +newRepoRoleOpAForm :: AppDB RepoRoleId -> AForm Handler RepoOperation +newRepoRoleOpAForm getrid = areq (newRepoOpField getrid) "Operation*" Nothing -newRoleOpForm :: AppDB RoleId -> Form Operation -newRoleOpForm getrid = renderDivs $ newRoleOpAForm getrid +newRepoRoleOpForm :: AppDB RepoRoleId -> Form RepoOperation +newRepoRoleOpForm getrid = renderDivs $ newRepoRoleOpAForm getrid diff --git a/src/Vervis/Foundation.hs b/src/Vervis/Foundation.hs index 499456e..11d3a22 100644 --- a/src/Vervis/Foundation.hs +++ b/src/Vervis/Foundation.hs @@ -129,11 +129,11 @@ instance Yesod App where (KeyR _key , _ ) -> personAny (KeyNewR , _ ) -> personAny - (RolesR , _ ) -> personAny - (RoleNewR , _ ) -> personAny - (RoleR _rl , _ ) -> personAny - (RoleOpsR _rl , _ ) -> personAny - (RoleOpNewR _rl , _ ) -> personAny + (RepoRolesR , _ ) -> personAny + (RepoRoleNewR , _ ) -> personAny + (RepoRoleR _rl , _ ) -> personAny + (RepoRoleOpsR _rl , _ ) -> personAny + (RepoRoleOpNewR _rl , _ ) -> personAny (ReposR shar , True) -> person shar (RepoNewR user , _ ) -> person user @@ -301,11 +301,11 @@ instance YesodBreadcrumbs App where KeyNewR -> ("New", Just KeysR) KeyR key -> (ky2text key, Just KeysR) - RolesR -> ("Roles", Just HomeR) - RoleNewR -> ("New", Just RolesR) - RoleR rl -> (rl2text rl, Just RolesR) - RoleOpsR rl -> ("Operations", Just $ RoleR rl) - RoleOpNewR rl -> ("New", Just $ RoleOpsR rl) + 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) ReposR shar -> ("Repos", Just $ PersonR shar) RepoNewR shar -> ("New", Just $ ReposR shar) diff --git a/src/Vervis/Handler/Repo.hs b/src/Vervis/Handler/Repo.hs index 7ac9242..bfbd3b1 100644 --- a/src/Vervis/Handler/Repo.hs +++ b/src/Vervis/Handler/Repo.hs @@ -133,10 +133,10 @@ postReposR user = do , repoMainBranch = "master" } rid <- insert repo - let collab = Collab - { collabRepo = rid - , collabPerson = pid - , collabRole = nrpRole nrp + let collab = RepoCollab + { repoCollabRepo = rid + , repoCollabPerson = pid + , repoCollabRole = nrpRole nrp } insert_ collab setMessage "Repo added." @@ -228,11 +228,11 @@ getRepoDevsR shr rp = do return r select $ from $ \ (collab, person, sharer, role) -> do where_ $ - collab ^. CollabRepo ==. val rid &&. - collab ^. CollabPerson ==. person ^. PersonId &&. - person ^. PersonIdent ==. sharer ^. SharerId &&. - collab ^. CollabRole ==. role ^. RoleId - return (sharer, role ^. RoleIdent) + collab ^. RepoCollabRepo ==. val rid &&. + collab ^. RepoCollabPerson ==. person ^. PersonId &&. + person ^. PersonIdent ==. sharer ^. SharerId &&. + collab ^. RepoCollabRole ==. role ^. RepoRoleId + return (sharer, role ^. RepoRoleIdent) defaultLayout $(widgetFile "repo/collab/list") postRepoDevsR :: ShrIdent -> RpIdent -> Handler Html @@ -242,14 +242,14 @@ postRepoDevsR shr rp = do Entity p _ <- getBy404 $ UniquePersonIdent s Entity r _ <- getBy404 $ UniqueRepo rp s return (p, r) - ((result, widget), enctype) <- runFormPost $ newCollabForm pid rid + ((result, widget), enctype) <- runFormPost $ newRepoCollabForm pid rid case result of FormSuccess nc -> do runDB $ do - let collab = Collab - { collabRepo = rid - , collabPerson = ncPerson nc - , collabRole = ncRole nc + let collab = RepoCollab + { repoCollabRepo = rid + , repoCollabPerson = ncPerson nc + , repoCollabRole = ncRole nc } insert_ collab setMessage "Collaborator added." @@ -268,7 +268,7 @@ getRepoDevNewR shr rp = do Entity p _ <- getBy404 $ UniquePersonIdent s Entity r _ <- getBy404 $ UniqueRepo rp s return (p, r) - ((_result, widget), enctype) <- runFormPost $ newCollabForm pid rid + ((_result, widget), enctype) <- runFormPost $ newRepoCollabForm pid rid defaultLayout $(widgetFile "repo/collab/new") getRepoDevR :: ShrIdent -> RpIdent -> ShrIdent -> Handler Html @@ -282,9 +282,9 @@ getRepoDevR shr rp dev = do Entity s _ <- getBy404 $ UniqueSharer dev Entity p _ <- getBy404 $ UniquePersonIdent s return p - Entity _cid collab <- getBy404 $ UniqueCollab rid pid - role <- getJust $ collabRole collab - return $ roleIdent role + Entity _cid collab <- getBy404 $ UniqueRepoCollab rid pid + role <- getJust $ repoCollabRole collab + return $ repoRoleIdent role defaultLayout $(widgetFile "repo/collab/one") deleteRepoDevR :: ShrIdent -> RpIdent -> ShrIdent -> Handler Html @@ -298,7 +298,7 @@ deleteRepoDevR shr rp dev = do Entity s _ <- getBy404 $ UniqueSharer dev Entity p _ <- getBy404 $ UniquePersonIdent s return p - Entity cid _collab <- getBy404 $ UniqueCollab rid pid + Entity cid _collab <- getBy404 $ UniqueRepoCollab rid pid delete cid setMessage "Collaborator removed." redirect $ RepoDevsR shr rp diff --git a/src/Vervis/Handler/Role.hs b/src/Vervis/Handler/Role.hs index 8cc8e4c..675d9bf 100644 --- a/src/Vervis/Handler/Role.hs +++ b/src/Vervis/Handler/Role.hs @@ -14,15 +14,15 @@ -} module Vervis.Handler.Role - ( getRolesR - , postRolesR - , getRoleNewR - , getRoleR - , deleteRoleR - , postRoleR - , getRoleOpsR - , postRoleOpsR - , getRoleOpNewR + ( getRepoRolesR + , postRepoRolesR + , getRepoRoleNewR + , getRepoRoleR + , deleteRepoRoleR + , postRepoRoleR + , getRepoRoleOpsR + , postRepoRoleOpsR + , getRepoRoleOpNewR ) where @@ -43,94 +43,95 @@ import Vervis.Model import Vervis.Model.Ident (RlIdent, rl2text) import Vervis.Settings (widgetFile) -getRolesR :: Handler Html -getRolesR = do +getRepoRolesR :: Handler Html +getRepoRolesR = do pid <- requireAuthId - roles <- runDB $ selectList [RolePerson ==. pid] [] - defaultLayout $(widgetFile "role/list") + roles <- runDB $ selectList [RepoRolePerson ==. pid] [] + defaultLayout $(widgetFile "repo/role/list") -postRolesR :: Handler Html -postRolesR = do +postRepoRolesR :: Handler Html +postRepoRolesR = do pid <- requireAuthId - ((result, widget), enctype) <- runFormPost $ newRoleForm pid + ((result, widget), enctype) <- runFormPost $ newRepoRoleForm pid case result of - FormSuccess nr -> do + FormSuccess nrr -> do runDB $ do - let role = Role - { roleIdent = nrIdent nr - , rolePerson = pid - , roleDesc = nrDesc nr + let role = RepoRole + { repoRoleIdent = nrrIdent nrr + , repoRolePerson = pid + , repoRoleDesc = nrrDesc nrr } insert_ role - redirect $ RolesR + redirect $ RepoRolesR FormMissing -> do setMessage "Field(s) missing" - defaultLayout $(widgetFile "role/new") + defaultLayout $(widgetFile "repo/role/new") FormFailure _l -> do setMessage "Invalid input, see errors below" - defaultLayout $(widgetFile "role/new") + defaultLayout $(widgetFile "repo/role/new") -getRoleNewR :: Handler Html -getRoleNewR = do +getRepoRoleNewR :: Handler Html +getRepoRoleNewR = do pid <- requireAuthId - ((_result, widget), enctype) <- runFormPost $ newRoleForm pid - defaultLayout $(widgetFile "role/new") + ((_result, widget), enctype) <- runFormPost $ newRepoRoleForm pid + defaultLayout $(widgetFile "repo/role/new") -getRoleR :: RlIdent -> Handler Html -getRoleR rl = do +getRepoRoleR :: RlIdent -> Handler Html +getRepoRoleR rl = do pid <- requireAuthId - Entity _rid role <- runDB $ getBy404 $ UniqueRole pid rl - defaultLayout $(widgetFile "role/one") + Entity _rid role <- runDB $ getBy404 $ UniqueRepoRole pid rl + defaultLayout $(widgetFile "repo/role/one") -deleteRoleR :: RlIdent -> Handler Html -deleteRoleR rl = do +deleteRepoRoleR :: RlIdent -> Handler Html +deleteRepoRoleR rl = do pid <- requireAuthId runDB $ do - Entity rid _r <- getBy404 $ UniqueRole pid rl + Entity rid _r <- getBy404 $ UniqueRepoRole pid rl delete rid setMessage "Role deleted." - redirect RolesR + redirect RepoRolesR -postRoleR :: RlIdent -> Handler Html -postRoleR rl = do +postRepoRoleR :: RlIdent -> Handler Html +postRepoRoleR rl = do mmethod <- lookupPostParam "_method" case mmethod of - Just "DELETE" -> deleteRoleR rl + Just "DELETE" -> deleteRepoRoleR rl _ -> notFound -getRoleOpsR :: RlIdent -> Handler Html -getRoleOpsR rl = do +getRepoRoleOpsR :: RlIdent -> Handler Html +getRepoRoleOpsR rl = do pid <- requireAuthId ops <- runDB $ do - Entity rid _r <- getBy404 $ UniqueRole pid rl - map (accessOp . entityVal) <$> selectList [AccessRole ==. rid] [] - defaultLayout $(widgetFile "role/op/list") + Entity rid _r <- getBy404 $ UniqueRepoRole pid rl + as <- selectList [RepoAccessRole ==. rid] [] + return $ map (repoAccessOp . entityVal) as + defaultLayout $(widgetFile "repo/role/op/list") -postRoleOpsR :: RlIdent -> Handler Html -postRoleOpsR rl = do +postRepoRoleOpsR :: RlIdent -> Handler Html +postRepoRoleOpsR rl = do pid <- requireAuthId - let getrid = fmap entityKey $ getBy404 $ UniqueRole pid rl - ((result, widget), enctype) <- runFormPost $ newRoleOpForm getrid + let getrid = fmap entityKey $ getBy404 $ UniqueRepoRole pid rl + ((result, widget), enctype) <- runFormPost $ newRepoRoleOpForm getrid case result of FormSuccess op -> do runDB $ do rid <- getrid - let access = Access - { accessRole = rid - , accessOp = op + let access = RepoAccess + { repoAccessRole = rid + , repoAccessOp = op } insert_ access - redirect $ RoleOpsR rl + redirect $ RepoRoleOpsR rl FormMissing -> do setMessage "Field(s) missing" - defaultLayout $(widgetFile "role/op/new") + defaultLayout $(widgetFile "repo/role/op/new") FormFailure _l -> do setMessage "Invalid input, see errors below" - defaultLayout $(widgetFile "role/op/new") + defaultLayout $(widgetFile "repo/role/op/new") -getRoleOpNewR :: RlIdent -> Handler Html -getRoleOpNewR rl = do +getRepoRoleOpNewR :: RlIdent -> Handler Html +getRepoRoleOpNewR rl = do pid <- requireAuthId - let getrid = fmap entityKey $ getBy404 $ UniqueRole pid rl - ((_result, widget), enctype) <- runFormPost $ newRoleOpForm getrid - defaultLayout $(widgetFile "role/op/new") + let getrid = fmap entityKey $ getBy404 $ UniqueRepoRole pid rl + ((_result, widget), enctype) <- runFormPost $ newRepoRoleOpForm getrid + defaultLayout $(widgetFile "repo/role/op/new") diff --git a/src/Vervis/Model/Role.hs b/src/Vervis/Model/Role.hs index 565a418..21235ab 100644 --- a/src/Vervis/Model/Role.hs +++ b/src/Vervis/Model/Role.hs @@ -14,7 +14,8 @@ -} module Vervis.Model.Role - ( Operation (..) + ( RepoOperation (..) + , ProjectOperation (..) ) where @@ -22,6 +23,13 @@ import Prelude import Database.Persist.TH -data Operation = OpRepoPush deriving (Eq, Show, Read, Enum, Bounded) +data RepoOperation = RepoOpPush deriving (Eq, Show, Read, Enum, Bounded) -derivePersistField "Operation" +derivePersistField "RepoOperation" + +data ProjectOperation + = ProjOpAskToClaimTicket + | ProjOpClaimTicket + deriving (Eq, Show, Read, Enum, Bounded) + +derivePersistField "ProjectOperation" diff --git a/src/Vervis/Ssh.hs b/src/Vervis/Ssh.hs index 67a6afb..0ebd130 100644 --- a/src/Vervis/Ssh.hs +++ b/src/Vervis/Ssh.hs @@ -226,8 +226,8 @@ canPushTo shr' rp' = do ma <- runChanDB $ runMaybeT $ do Entity sid _sharer <- MaybeT $ getBy $ UniqueSharer shr Entity rid _repo <- MaybeT $ getBy $ UniqueRepo rp sid - Entity _cid collab <- MaybeT $ getBy $ UniqueCollab rid pid - MaybeT $ getBy $ UniqueAccess (collabRole collab) OpRepoPush + Entity _cid collab <- MaybeT $ getBy $ UniqueRepoCollab rid pid + MaybeT $ getBy $ UniqueRepoAccess (repoCollabRole collab) RepoOpPush return $ isJust ma runAction :: FilePath -> Bool -> Action -> Channel ActionResult diff --git a/templates/role/list.hamlet b/templates/repo/role/list.hamlet similarity index 87% rename from templates/role/list.hamlet rename to templates/repo/role/list.hamlet index 6a29e47..d36e17d 100644 --- a/templates/role/list.hamlet +++ b/templates/repo/role/list.hamlet @@ -15,4 +15,4 @@ $# .