sup39/vervis
1
0
Fork 0
mirror of https://code.sup39.dev/repos/Wqawg synced 2024-12-29 02:24:52 +09:00
Code Issues Activity

Make all role-related code repo-specific

Browse source
This commit is contained in:
fr33domlover 2016-06-01 07:35:22 +00:00
parent 13bf3e1953
commit 10c27464dd
15 changed files with 188 additions and 177 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

18
config/models
View file

@ -53,25 +53,25 @@ GroupMember
UniqueGroupMember person group UniqueGroupMember person group
Role RepoRole
ident RlIdent ident RlIdent
person PersonId person PersonId
desc Text desc Text
UniqueRole person ident UniqueRepoRole person ident
Access RepoAccess
role RoleId role RepoRoleId
op Operation op RepoOperation
UniqueAccess role op UniqueRepoAccess role op
Collab RepoCollab
repo RepoId repo RepoId
person PersonId person PersonId
role RoleId role RepoRoleId
UniqueCollab repo person UniqueRepoCollab repo person
------------------------------------------------------------------------------- -------------------------------------------------------------------------------
-- Projects -- Projects

10
config/routes
View file

@ -50,11 +50,11 @@
/k/!new KeyNewR GET /k/!new KeyNewR GET
/k/#KyIdent KeyR GET DELETE POST /k/#KyIdent KeyR GET DELETE POST
/r RolesR GET POST /rr RepoRolesR GET POST
/r/!new RoleNewR GET /rr/!new RepoRoleNewR GET
/r/#RlIdent RoleR GET DELETE POST /rr/#RlIdent RepoRoleR GET DELETE POST
/r/#RlIdent/a RoleOpsR GET POST /rr/#RlIdent/a RepoRoleOpsR GET POST
/r/#RlIdent/a/!new RoleOpNewR GET /rr/#RlIdent/a/!new RepoRoleOpNewR GET
-- ---------------------------------------------------------------------------- -- ----------------------------------------------------------------------------
-- Projects -- Projects

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

@ -14,8 +14,8 @@
-} -}
module Vervis.Field.Role module Vervis.Field.Role
( newRoleIdentField ( newRepoRoleIdentField
, newOpField , newRepoOpField
) )
where where
@ -40,36 +40,38 @@ import Vervis.Model
import Vervis.Model.Ident (RlIdent, rl2text, text2rl) import Vervis.Model.Ident (RlIdent, rl2text, text2rl)
import Vervis.Model.Role import Vervis.Model.Role
checkUniqueCI :: PersonId -> Field Handler RlIdent -> Field Handler RlIdent newRepoRoleIdentField :: PersonId -> Field Handler RlIdent
checkUniqueCI pid = checkM $ \ rl -> do newRepoRoleIdentField pid = checkUniqueCI pid roleIdentField
sames <- runDB $ select $ from $ \ role -> do where
where_ $ roleIdentField :: Field Handler RlIdent
role ^. RolePerson ==. val pid &&. roleIdentField = convertField text2rl rl2text textField
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)
roleIdentField :: Field Handler RlIdent checkUniqueCI :: PersonId -> Field Handler RlIdent -> Field Handler RlIdent
roleIdentField = convertField text2rl rl2text textField 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 newRepoOpField :: AppDB RepoRoleId -> Field Handler RepoOperation
newRoleIdentField pid = checkUniqueCI pid roleIdentField newRepoOpField getrid = checkOpNew getrid opField
where
opField :: Field Handler RepoOperation
opField = selectField optionsEnum
opField :: Field Handler Operation checkOpNew
opField = selectField optionsEnum :: AppDB RepoRoleId
-> Field Handler RepoOperation
checkOpNew -> Field Handler RepoOperation
:: AppDB RoleId -> Field Handler Operation -> Field Handler Operation checkOpNew getrid = checkM $ \ op -> do
checkOpNew getrid = checkM $ \ op -> do ma <- runDB $ do
ma <- runDB $ do rid <- getrid
rid <- getrid getBy $ UniqueRepoAccess rid op
getBy $ UniqueAccess 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)
newOpField :: AppDB RoleId -> Field Handler Operation
newOpField getrid = checkOpNew getrid opField

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

@ -16,8 +16,8 @@
module Vervis.Form.Repo module Vervis.Form.Repo
( NewRepo (..) ( NewRepo (..)
, newRepoForm , newRepoForm
, NewCollab (..) , NewRepoCollab (..)
, newCollabForm , newRepoCollabForm
) )
where where
@ -38,7 +38,7 @@ data NewRepo = NewRepo
, nrpVcs :: VersionControlSystem , nrpVcs :: VersionControlSystem
, nrpProj :: Maybe ProjectId , nrpProj :: Maybe ProjectId
, nrpDesc :: Maybe Text , nrpDesc :: Maybe Text
, nrpRole :: RoleId , nrpRole :: RepoRoleId
} }
newRepoAForm newRepoAForm
@ -61,19 +61,19 @@ newRepoAForm pid sid mpid = NewRepo
prj2text . projectIdent prj2text . projectIdent
selectRole = selectRole =
selectField $ selectField $
optionsPersistKey [RolePerson ==. pid] [] $ optionsPersistKey [RepoRolePerson ==. pid] [] $
rl2text . roleIdent rl2text . repoRoleIdent
newRepoForm :: PersonId -> SharerId -> Maybe ProjectId -> Form NewRepo newRepoForm :: PersonId -> SharerId -> Maybe ProjectId -> Form NewRepo
newRepoForm pid sid mpid = renderDivs $ newRepoAForm pid sid mpid newRepoForm pid sid mpid = renderDivs $ newRepoAForm pid sid mpid
data NewCollab = NewCollab data NewRepoCollab = NewRepoCollab
{ ncPerson :: PersonId { ncPerson :: PersonId
, ncRole :: RoleId , ncRole :: RepoRoleId
} }
newCollabAForm :: PersonId -> RepoId -> AForm Handler NewCollab newRepoCollabAForm :: PersonId -> RepoId -> AForm Handler NewRepoCollab
newCollabAForm pid rid = NewCollab newRepoCollabAForm pid rid = NewRepoCollab
<$> areq selectPerson "Person*" Nothing <$> areq selectPerson "Person*" Nothing
<*> areq selectRole "Role*" Nothing <*> areq selectRole "Role*" Nothing
where where
@ -82,15 +82,15 @@ newCollabAForm pid rid = NewCollab
from $ \ (collab `RightOuterJoin` person `InnerJoin` sharer) -> do from $ \ (collab `RightOuterJoin` person `InnerJoin` sharer) -> do
on $ person ^. PersonIdent E.==. sharer ^. SharerId on $ person ^. PersonIdent E.==. sharer ^. SharerId
on $ on $
collab ?. CollabRepo E.==. just (val rid) &&. collab ?. RepoCollabRepo E.==. just (val rid) &&.
collab ?. CollabPerson E.==. just (person ^. PersonId) collab ?. RepoCollabPerson E.==. just (person ^. PersonId)
where_ $ isNothing $ collab ?. CollabId where_ $ isNothing $ collab ?. RepoCollabId
return (sharer ^. SharerIdent, person ^. PersonId) return (sharer ^. SharerIdent, person ^. PersonId)
optionsPairs $ map (shr2text . unValue *** unValue) l optionsPairs $ map (shr2text . unValue *** unValue) l
selectRole = selectRole =
selectField $ selectField $
optionsPersistKey [RolePerson ==. pid] [] $ optionsPersistKey [RepoRolePerson ==. pid] [] $
rl2text . roleIdent rl2text . repoRoleIdent
newCollabForm :: PersonId -> RepoId -> Form NewCollab newRepoCollabForm :: PersonId -> RepoId -> Form NewRepoCollab
newCollabForm pid rid = renderDivs $ newCollabAForm pid rid newRepoCollabForm pid rid = renderDivs $ newRepoCollabAForm pid rid

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

@ -14,9 +14,9 @@
-} -}
module Vervis.Form.Role module Vervis.Form.Role
( NewRole (..) ( NewRepoRole (..)
, newRoleForm , newRepoRoleForm
, newRoleOpForm , newRepoRoleOpForm
) )
where where
@ -33,21 +33,21 @@ import Vervis.Model
import Vervis.Model.Ident (RlIdent) import Vervis.Model.Ident (RlIdent)
import Vervis.Model.Role import Vervis.Model.Role
data NewRole = NewRole data NewRepoRole = NewRepoRole
{ nrIdent :: RlIdent { nrrIdent :: RlIdent
, nrDesc :: Text , nrrDesc :: Text
} }
newRoleAForm :: PersonId -> AForm Handler NewRole newRepoRoleAForm :: PersonId -> AForm Handler NewRepoRole
newRoleAForm pid = NewRole newRepoRoleAForm pid = NewRepoRole
<$> areq (newRoleIdentField pid) "Name*" Nothing <$> areq (newRepoRoleIdentField pid) "Name*" Nothing
<*> areq textField "Description" Nothing <*> areq textField "Description" Nothing
newRoleForm :: PersonId -> Form NewRole newRepoRoleForm :: PersonId -> Form NewRepoRole
newRoleForm pid = renderDivs $ newRoleAForm pid newRepoRoleForm pid = renderDivs $ newRepoRoleAForm pid
newRoleOpAForm :: AppDB RoleId -> AForm Handler Operation newRepoRoleOpAForm :: AppDB RepoRoleId -> AForm Handler RepoOperation
newRoleOpAForm getrid = areq (newOpField getrid) "Operation*" Nothing newRepoRoleOpAForm getrid = areq (newRepoOpField getrid) "Operation*" Nothing
newRoleOpForm :: AppDB RoleId -> Form Operation newRepoRoleOpForm :: AppDB RepoRoleId -> Form RepoOperation
newRoleOpForm getrid = renderDivs $ newRoleOpAForm getrid newRepoRoleOpForm getrid = renderDivs $ newRepoRoleOpAForm getrid

20
src/Vervis/Foundation.hs
View file

@ -129,11 +129,11 @@ instance Yesod App where
(KeyR _key , _ ) -> personAny (KeyR _key , _ ) -> personAny
(KeyNewR , _ ) -> personAny (KeyNewR , _ ) -> personAny
(RolesR , _ ) -> personAny (RepoRolesR , _ ) -> personAny
(RoleNewR , _ ) -> personAny (RepoRoleNewR , _ ) -> personAny
(RoleR _rl , _ ) -> personAny (RepoRoleR _rl , _ ) -> personAny
(RoleOpsR _rl , _ ) -> personAny (RepoRoleOpsR _rl , _ ) -> personAny
(RoleOpNewR _rl , _ ) -> personAny (RepoRoleOpNewR _rl , _ ) -> personAny
(ReposR shar , True) -> person shar (ReposR shar , True) -> person shar
(RepoNewR user , _ ) -> person user (RepoNewR user , _ ) -> person user
@ -301,11 +301,11 @@ instance YesodBreadcrumbs App where
KeyNewR -> ("New", Just KeysR) KeyNewR -> ("New", Just KeysR)
KeyR key -> (ky2text key, Just KeysR) KeyR key -> (ky2text key, Just KeysR)
RolesR -> ("Roles", Just HomeR) RepoRolesR -> ("Repo Roles", Just HomeR)
RoleNewR -> ("New", Just RolesR) RepoRoleNewR -> ("New", Just RepoRolesR)
RoleR rl -> (rl2text rl, Just RolesR) RepoRoleR rl -> (rl2text rl, Just RepoRolesR)
RoleOpsR rl -> ("Operations", Just $ RoleR rl) RepoRoleOpsR rl -> ("Operations", Just $ RepoRoleR rl)
RoleOpNewR rl -> ("New", Just $ RoleOpsR rl) RepoRoleOpNewR rl -> ("New", Just $ RepoRoleOpsR 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)

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

@ -133,10 +133,10 @@ postReposR user = do
, repoMainBranch = "master" , repoMainBranch = "master"
} }
rid <- insert repo rid <- insert repo
let collab = Collab let collab = RepoCollab
{ collabRepo = rid { repoCollabRepo = rid
, collabPerson = pid , repoCollabPerson = pid
, collabRole = nrpRole nrp , repoCollabRole = nrpRole nrp
} }
insert_ collab insert_ collab
setMessage "Repo added." setMessage "Repo added."
@ -228,11 +228,11 @@ getRepoDevsR shr rp = do
return r return r
select $ from $ \ (collab, person, sharer, role) -> do select $ from $ \ (collab, person, sharer, role) -> do
where_ $ where_ $
collab ^. CollabRepo ==. val rid &&. collab ^. RepoCollabRepo ==. val rid &&.
collab ^. CollabPerson ==. person ^. PersonId &&. collab ^. RepoCollabPerson ==. person ^. PersonId &&.
person ^. PersonIdent ==. sharer ^. SharerId &&. person ^. PersonIdent ==. sharer ^. SharerId &&.
collab ^. CollabRole ==. role ^. RoleId collab ^. RepoCollabRole ==. role ^. RepoRoleId
return (sharer, role ^. RoleIdent) return (sharer, role ^. RepoRoleIdent)
defaultLayout $(widgetFile "repo/collab/list") defaultLayout $(widgetFile "repo/collab/list")
postRepoDevsR :: ShrIdent -> RpIdent -> Handler Html postRepoDevsR :: ShrIdent -> RpIdent -> Handler Html
@ -242,14 +242,14 @@ postRepoDevsR shr rp = do
Entity p _ <- getBy404 $ UniquePersonIdent s Entity p _ <- getBy404 $ UniquePersonIdent s
Entity r _ <- getBy404 $ UniqueRepo rp s Entity r _ <- getBy404 $ UniqueRepo rp s
return (p, r) return (p, r)
((result, widget), enctype) <- runFormPost $ newCollabForm pid rid ((result, widget), enctype) <- runFormPost $ newRepoCollabForm pid rid
case result of case result of
FormSuccess nc -> do FormSuccess nc -> do
runDB $ do runDB $ do
let collab = Collab let collab = RepoCollab
{ collabRepo = rid { repoCollabRepo = rid
, collabPerson = ncPerson nc , repoCollabPerson = ncPerson nc
, collabRole = ncRole nc , repoCollabRole = ncRole nc
} }
insert_ collab insert_ collab
setMessage "Collaborator added." setMessage "Collaborator added."
@ -268,7 +268,7 @@ getRepoDevNewR shr rp = do
Entity p _ <- getBy404 $ UniquePersonIdent s Entity p _ <- getBy404 $ UniquePersonIdent s
Entity r _ <- getBy404 $ UniqueRepo rp s Entity r _ <- getBy404 $ UniqueRepo rp s
return (p, r) return (p, r)
((_result, widget), enctype) <- runFormPost $ newCollabForm pid rid ((_result, widget), enctype) <- runFormPost $ newRepoCollabForm pid rid
defaultLayout $(widgetFile "repo/collab/new") defaultLayout $(widgetFile "repo/collab/new")
getRepoDevR :: ShrIdent -> RpIdent -> ShrIdent -> Handler Html getRepoDevR :: ShrIdent -> RpIdent -> ShrIdent -> Handler Html
@ -282,9 +282,9 @@ getRepoDevR shr rp dev = do
Entity s _ <- getBy404 $ UniqueSharer dev Entity s _ <- getBy404 $ UniqueSharer dev
Entity p _ <- getBy404 $ UniquePersonIdent s Entity p _ <- getBy404 $ UniquePersonIdent s
return p return p
Entity _cid collab <- getBy404 $ UniqueCollab rid pid Entity _cid collab <- getBy404 $ UniqueRepoCollab rid pid
role <- getJust $ collabRole collab role <- getJust $ repoCollabRole collab
return $ roleIdent role return $ repoRoleIdent role
defaultLayout $(widgetFile "repo/collab/one") defaultLayout $(widgetFile "repo/collab/one")
deleteRepoDevR :: ShrIdent -> RpIdent -> ShrIdent -> Handler Html deleteRepoDevR :: ShrIdent -> RpIdent -> ShrIdent -> Handler Html
@ -298,7 +298,7 @@ deleteRepoDevR shr rp dev = do
Entity s _ <- getBy404 $ UniqueSharer dev Entity s _ <- getBy404 $ UniqueSharer dev
Entity p _ <- getBy404 $ UniquePersonIdent s Entity p _ <- getBy404 $ UniquePersonIdent s
return p return p
Entity cid _collab <- getBy404 $ UniqueCollab rid pid Entity cid _collab <- getBy404 $ UniqueRepoCollab rid pid
delete cid delete cid
setMessage "Collaborator removed." setMessage "Collaborator removed."
redirect $ RepoDevsR shr rp redirect $ RepoDevsR shr rp

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

@ -14,15 +14,15 @@
-} -}
module Vervis.Handler.Role module Vervis.Handler.Role
( getRolesR ( getRepoRolesR
, postRolesR , postRepoRolesR
, getRoleNewR , getRepoRoleNewR
, getRoleR , getRepoRoleR
, deleteRoleR , deleteRepoRoleR
, postRoleR , postRepoRoleR
, getRoleOpsR , getRepoRoleOpsR
, postRoleOpsR , postRepoRoleOpsR
, getRoleOpNewR , getRepoRoleOpNewR
) )
where where
@ -43,94 +43,95 @@ import Vervis.Model
import Vervis.Model.Ident (RlIdent, rl2text) import Vervis.Model.Ident (RlIdent, rl2text)
import Vervis.Settings (widgetFile) import Vervis.Settings (widgetFile)
getRolesR :: Handler Html getRepoRolesR :: Handler Html
getRolesR = do getRepoRolesR = do
pid <- requireAuthId pid <- requireAuthId
roles <- runDB $ selectList [RolePerson ==. pid] [] roles <- runDB $ selectList [RepoRolePerson ==. pid] []
defaultLayout $(widgetFile "role/list") defaultLayout $(widgetFile "repo/role/list")
postRolesR :: Handler Html postRepoRolesR :: Handler Html
postRolesR = do postRepoRolesR = do
pid <- requireAuthId pid <- requireAuthId
((result, widget), enctype) <- runFormPost $ newRoleForm pid ((result, widget), enctype) <- runFormPost $ newRepoRoleForm pid
case result of case result of
FormSuccess nr -> do FormSuccess nrr -> do
runDB $ do runDB $ do
let role = Role let role = RepoRole
{ roleIdent = nrIdent nr { repoRoleIdent = nrrIdent nrr
, rolePerson = pid , repoRolePerson = pid
, roleDesc = nrDesc nr , repoRoleDesc = nrrDesc nrr
} }
insert_ role insert_ role
redirect $ RolesR redirect $ RepoRolesR
FormMissing -> do FormMissing -> do
setMessage "Field(s) missing" setMessage "Field(s) missing"
defaultLayout $(widgetFile "role/new") defaultLayout $(widgetFile "repo/role/new")
FormFailure _l -> do FormFailure _l -> do
setMessage "Invalid input, see errors below" setMessage "Invalid input, see errors below"
defaultLayout $(widgetFile "role/new") defaultLayout $(widgetFile "repo/role/new")
getRoleNewR :: Handler Html getRepoRoleNewR :: Handler Html
getRoleNewR = do getRepoRoleNewR = do
pid <- requireAuthId pid <- requireAuthId
((_result, widget), enctype) <- runFormPost $ newRoleForm pid ((_result, widget), enctype) <- runFormPost $ newRepoRoleForm pid
defaultLayout $(widgetFile "role/new") defaultLayout $(widgetFile "repo/role/new")
getRoleR :: RlIdent -> Handler Html getRepoRoleR :: RlIdent -> Handler Html
getRoleR rl = do getRepoRoleR rl = do
pid <- requireAuthId pid <- requireAuthId
Entity _rid role <- runDB $ getBy404 $ UniqueRole pid rl Entity _rid role <- runDB $ getBy404 $ UniqueRepoRole pid rl
defaultLayout $(widgetFile "role/one") defaultLayout $(widgetFile "repo/role/one")
deleteRoleR :: RlIdent -> Handler Html deleteRepoRoleR :: RlIdent -> Handler Html
deleteRoleR rl = do deleteRepoRoleR rl = do
pid <- requireAuthId pid <- requireAuthId
runDB $ do runDB $ do
Entity rid _r <- getBy404 $ UniqueRole pid rl Entity rid _r <- getBy404 $ UniqueRepoRole pid rl
delete rid delete rid
setMessage "Role deleted." setMessage "Role deleted."
redirect RolesR redirect RepoRolesR
postRoleR :: RlIdent -> Handler Html postRepoRoleR :: RlIdent -> Handler Html
postRoleR rl = do postRepoRoleR rl = do
mmethod <- lookupPostParam "_method" mmethod <- lookupPostParam "_method"
case mmethod of case mmethod of
Just "DELETE" -> deleteRoleR rl Just "DELETE" -> deleteRepoRoleR rl
_ -> notFound _ -> notFound
getRoleOpsR :: RlIdent -> Handler Html getRepoRoleOpsR :: RlIdent -> Handler Html
getRoleOpsR rl = do getRepoRoleOpsR rl = do
pid <- requireAuthId pid <- requireAuthId
ops <- runDB $ do ops <- runDB $ do
Entity rid _r <- getBy404 $ UniqueRole pid rl Entity rid _r <- getBy404 $ UniqueRepoRole pid rl
map (accessOp . entityVal) <$> selectList [AccessRole ==. rid] [] as <- selectList [RepoAccessRole ==. rid] []
defaultLayout $(widgetFile "role/op/list") return $ map (repoAccessOp . entityVal) as
defaultLayout $(widgetFile "repo/role/op/list")
postRoleOpsR :: RlIdent -> Handler Html postRepoRoleOpsR :: RlIdent -> Handler Html
postRoleOpsR rl = do postRepoRoleOpsR rl = do
pid <- requireAuthId pid <- requireAuthId
let getrid = fmap entityKey $ getBy404 $ UniqueRole pid rl let getrid = fmap entityKey $ getBy404 $ UniqueRepoRole pid rl
((result, widget), enctype) <- runFormPost $ newRoleOpForm getrid ((result, widget), enctype) <- runFormPost $ newRepoRoleOpForm getrid
case result of case result of
FormSuccess op -> do FormSuccess op -> do
runDB $ do runDB $ do
rid <- getrid rid <- getrid
let access = Access let access = RepoAccess
{ accessRole = rid { repoAccessRole = rid
, accessOp = op , repoAccessOp = op
} }
insert_ access insert_ access
redirect $ RoleOpsR rl redirect $ RepoRoleOpsR rl
FormMissing -> do FormMissing -> do
setMessage "Field(s) missing" setMessage "Field(s) missing"
defaultLayout $(widgetFile "role/op/new") defaultLayout $(widgetFile "repo/role/op/new")
FormFailure _l -> do FormFailure _l -> do
setMessage "Invalid input, see errors below" setMessage "Invalid input, see errors below"
defaultLayout $(widgetFile "role/op/new") defaultLayout $(widgetFile "repo/role/op/new")
getRoleOpNewR :: RlIdent -> Handler Html getRepoRoleOpNewR :: RlIdent -> Handler Html
getRoleOpNewR rl = do getRepoRoleOpNewR rl = do
pid <- requireAuthId pid <- requireAuthId
let getrid = fmap entityKey $ getBy404 $ UniqueRole pid rl let getrid = fmap entityKey $ getBy404 $ UniqueRepoRole pid rl
((_result, widget), enctype) <- runFormPost $ newRoleOpForm getrid ((_result, widget), enctype) <- runFormPost $ newRepoRoleOpForm getrid
defaultLayout $(widgetFile "role/op/new") defaultLayout $(widgetFile "repo/role/op/new")

14
src/Vervis/Model/Role.hs
View file

@ -14,7 +14,8 @@
-} -}
module Vervis.Model.Role module Vervis.Model.Role
( Operation (..) ( RepoOperation (..)
, ProjectOperation (..)
) )
where where
@ -22,6 +23,13 @@ import Prelude
import Database.Persist.TH 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"

4
src/Vervis/Ssh.hs
View file

@ -226,8 +226,8 @@ canPushTo shr' rp' = do
ma <- runChanDB $ runMaybeT $ do ma <- runChanDB $ runMaybeT $ do
Entity sid _sharer <- MaybeT $ getBy $ UniqueSharer shr Entity sid _sharer <- MaybeT $ getBy $ UniqueSharer shr
Entity rid _repo <- MaybeT $ getBy $ UniqueRepo rp sid Entity rid _repo <- MaybeT $ getBy $ UniqueRepo rp sid
Entity _cid collab <- MaybeT $ getBy $ UniqueCollab rid pid Entity _cid collab <- MaybeT $ getBy $ UniqueRepoCollab rid pid
MaybeT $ getBy $ UniqueAccess (collabRole collab) OpRepoPush MaybeT $ getBy $ UniqueRepoAccess (repoCollabRole collab) RepoOpPush
return $ isJust ma return $ isJust ma
runAction :: FilePath -> Bool -> Action -> Channel ActionResult runAction :: FilePath -> Bool -> Action -> Channel ActionResult

2
templates/role/list.hamlet → templates/repo/role/list.hamlet
View file

@ -15,4 +15,4 @@ $# <http://creativecommons.org/publicdomain/zero/1.0/>.
<ul> <ul>
$forall Entity _rid role <- roles $forall Entity _rid role <- roles
<li> <li>
<a href=@{RoleR $ roleIdent role}>#{rl2text $ roleIdent role} <a href=@{RepoRoleR $ repoRoleIdent role}>#{rl2text $ repoRoleIdent role}

2
templates/role/new.hamlet → templates/repo/role/new.hamlet
View file

@ -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=@{RolesR} enctype=#{enctype}> <form method=POST action=@{RepoRolesR} enctype=#{enctype}>
^{widget} ^{widget}
<input type=submit> <input type=submit>

6
templates/role/one.hamlet → templates/repo/role/one.hamlet
View file

@ -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=@{RoleR rl}> <form method=POST action=@{RepoRoleR 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=@{RoleOpsR rl}>Operations <a href=@{RepoRoleOpsR rl}>Operations
<p> <p>
#{roleDesc role} #{repoRoleDesc role}

0
templates/role/op/list.hamlet → templates/repo/role/op/list.hamlet
View file

2
templates/role/op/new.hamlet → templates/repo/role/op/new.hamlet
View file

@ -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=@{RoleOpsR rl} enctype=#{enctype}> <form method=POST action=@{RepoRoleOpsR rl} enctype=#{enctype}>
^{widget} ^{widget}
<input type=submit> <input type=submit>