From f2e4bb429142db9ab5bcbfa5b553ac3f8b0c762e Mon Sep 17 00:00:00 2001 From: fr33domlover Date: Mon, 6 Jun 2016 17:29:54 +0000 Subject: [PATCH] Roles now under by sharers, i.e. now groups too --- config/models | 8 ++--- src/Vervis/Field/Project.hs | 8 ++--- src/Vervis/Field/Role.hs | 27 ++++++---------- src/Vervis/Form/Project.hs | 34 ++++++++++---------- src/Vervis/Form/Repo.hs | 23 +++++++------- src/Vervis/Form/Role.hs | 20 ++++++------ src/Vervis/Handler/Project.hs | 43 ++++++++++++------------- src/Vervis/Handler/Repo.hs | 21 ++++++------ src/Vervis/Handler/Role.hs | 60 ++++++++++++++++++++++++----------- templates/repo/new.hamlet | 2 -- 10 files changed, 127 insertions(+), 119 deletions(-) diff --git a/config/models b/config/models index b0dec4e..3ae1d5d 100644 --- a/config/models +++ b/config/models @@ -55,10 +55,10 @@ GroupMember RepoRole ident RlIdent - person PersonId + sharer SharerId desc Text - UniqueRepoRole person ident + UniqueRepoRole sharer ident RepoAccess role RepoRoleId @@ -75,10 +75,10 @@ RepoCollab ProjectRole ident RlIdent - person PersonId + sharer SharerId desc Text - UniqueProjectRole person ident + UniqueProjectRole sharer ident ProjectAccess role ProjectRoleId diff --git a/src/Vervis/Field/Project.hs b/src/Vervis/Field/Project.hs index 8bd0cdc..08e1c92 100644 --- a/src/Vervis/Field/Project.hs +++ b/src/Vervis/Field/Project.hs @@ -39,15 +39,15 @@ checkTemplate = in checkBool identOk msg checkUniqueCI :: SharerId -> Field Handler PrjIdent -> Field Handler PrjIdent -checkUniqueCI sid = checkM $ \ ident -> do +checkUniqueCI sid = checkM $ \ prj -> do sames <- runDB $ select $ from $ \ project -> do where_ $ - project ^. ProjectSharer ==. val sid &&. - lower_ (project ^. ProjectIdent) ==. lower_ (val ident) + project ^. ProjectSharer ==. val sid &&. + lower_ (project ^. ProjectIdent) ==. lower_ (val prj) limit 1 return () return $ if null sames - then Right ident + then Right prj else Left ("You already have a project by that name" :: Text) projectIdentField :: Field Handler PrjIdent diff --git a/src/Vervis/Field/Role.hs b/src/Vervis/Field/Role.hs index 84676f8..918c952 100644 --- a/src/Vervis/Field/Role.hs +++ b/src/Vervis/Field/Role.hs @@ -23,10 +23,6 @@ where import Prelude --- import Control.Monad (void) --- import Control.Monad.Trans.Maybe --- import Data.Char (isDigit) --- import Data.Maybe (isNothing, isJust) import Data.Text (Text) import Database.Esqueleto import Yesod.Form.Fields (textField, selectField, optionsEnum) @@ -34,9 +30,6 @@ import Yesod.Form.Functions (checkM, convertField) import Yesod.Form.Types (Field) import Yesod.Persist.Core (runDB) --- import qualified Data.Text as T (null, all, find, split) - --- import Data.Char.Local (isAsciiLetter) import Vervis.Foundation (Handler, AppDB) import Vervis.Model import Vervis.Model.Ident (RlIdent, rl2text, text2rl) @@ -45,14 +38,14 @@ import Vervis.Model.Role roleIdentField :: Field Handler RlIdent roleIdentField = convertField text2rl rl2text textField -newRepoRoleIdentField :: PersonId -> Field Handler RlIdent -newRepoRoleIdentField pid = checkUniqueCI pid roleIdentField +newRepoRoleIdentField :: SharerId -> Field Handler RlIdent +newRepoRoleIdentField sid = checkUniqueCI roleIdentField where - checkUniqueCI :: PersonId -> Field Handler RlIdent -> Field Handler RlIdent - checkUniqueCI pid = checkM $ \ rl -> do + checkUniqueCI :: Field Handler RlIdent -> Field Handler RlIdent + checkUniqueCI = checkM $ \ rl -> do sames <- runDB $ select $ from $ \ role -> do where_ $ - role ^. RepoRolePerson ==. val pid &&. + role ^. RepoRoleSharer ==. val sid &&. lower_ (role ^. RepoRoleIdent) ==. lower_ (val rl) limit 1 return () @@ -78,14 +71,14 @@ newRepoOpField getrid = checkOpNew getrid opField Nothing -> Right op Just _ -> Left ("Role already has this operation" :: Text) -newProjectRoleIdentField :: PersonId -> Field Handler RlIdent -newProjectRoleIdentField pid = checkUniqueCI pid roleIdentField +newProjectRoleIdentField :: SharerId -> Field Handler RlIdent +newProjectRoleIdentField sid = checkUniqueCI roleIdentField where - checkUniqueCI :: PersonId -> Field Handler RlIdent -> Field Handler RlIdent - checkUniqueCI pid = checkM $ \ rl -> do + checkUniqueCI :: Field Handler RlIdent -> Field Handler RlIdent + checkUniqueCI = checkM $ \ rl -> do sames <- runDB $ select $ from $ \ role -> do where_ $ - role ^. ProjectRolePerson ==. val pid &&. + role ^. ProjectRoleSharer ==. val sid &&. lower_ (role ^. ProjectRoleIdent) ==. lower_ (val rl) limit 1 return () diff --git a/src/Vervis/Form/Project.hs b/src/Vervis/Form/Project.hs index 963ee4d..b44b638 100644 --- a/src/Vervis/Form/Project.hs +++ b/src/Vervis/Form/Project.hs @@ -40,8 +40,8 @@ data NewProject = NewProject , npRole :: ProjectRoleId } -newProjectAForm :: PersonId -> SharerId -> AForm Handler NewProject -newProjectAForm pid sid = NewProject +newProjectAForm :: SharerId -> AForm Handler NewProject +newProjectAForm sid = NewProject <$> areq (newProjectIdentField sid) "Identifier*" Nothing <*> aopt textField "Name" Nothing <*> aopt textField "Description" Nothing @@ -49,11 +49,11 @@ newProjectAForm pid sid = NewProject where selectRole = selectField $ - optionsPersistKey [ProjectRolePerson ==. pid] [] $ + optionsPersistKey [ProjectRoleSharer ==. sid] [] $ rl2text . projectRoleIdent -newProjectForm :: PersonId -> SharerId -> Form NewProject -newProjectForm pid sid = renderDivs $ newProjectAForm pid sid +newProjectForm :: SharerId -> Form NewProject +newProjectForm sid = renderDivs $ newProjectAForm sid data NewProjectCollab = NewProjectCollab { ncPerson :: PersonId @@ -61,8 +61,8 @@ data NewProjectCollab = NewProjectCollab } newProjectCollabAForm - :: PersonId -> ProjectId -> AForm Handler NewProjectCollab -newProjectCollabAForm pid rid = NewProjectCollab + :: SharerId -> ProjectId -> AForm Handler NewProjectCollab +newProjectCollabAForm sid jid = NewProjectCollab <$> areq selectPerson "Person*" Nothing <*> areq selectRole "Role*" Nothing where @@ -71,27 +71,27 @@ newProjectCollabAForm pid rid = NewProjectCollab from $ \ (collab `RightOuterJoin` person `InnerJoin` sharer) -> do on $ person ^. PersonIdent E.==. sharer ^. SharerId on $ - collab ?. ProjectCollabProject E.==. just (val rid) &&. + collab ?. ProjectCollabProject E.==. just (val jid) &&. collab ?. ProjectCollabPerson E.==. just (person ^. PersonId) where_ $ isNothing $ collab ?. ProjectCollabId return (sharer ^. SharerIdent, person ^. PersonId) optionsPairs $ map (shr2text . unValue *** unValue) l selectRole = selectField $ - optionsPersistKey [ProjectRolePerson ==. pid] [] $ + optionsPersistKey [ProjectRoleSharer ==. sid] [] $ rl2text . projectRoleIdent -newProjectCollabForm :: PersonId -> ProjectId -> Form NewProjectCollab -newProjectCollabForm pid rid = renderDivs $ newProjectCollabAForm pid rid +newProjectCollabForm :: SharerId -> ProjectId -> Form NewProjectCollab +newProjectCollabForm sid jid = renderDivs $ newProjectCollabAForm sid jid editProjectAForm :: Entity Project -> AForm Handler Project editProjectAForm (Entity jid project) = Project - <$> pure (projectIdent project) - <*> pure (projectSharer project) - <*> aopt textField "Name" (Just $ projectName project) - <*> aopt textField "Description" (Just $ projectDesc project) - <*> pure (projectNextTicket project) - <*> aopt selectWiki "Wiki" (Just $ projectWiki project) + <$> pure (projectIdent project) + <*> pure (projectSharer project) + <*> aopt textField "Name" (Just $ projectName project) + <*> aopt textField "Description" (Just $ projectDesc project) + <*> pure (projectNextTicket project) + <*> aopt selectWiki "Wiki" (Just $ projectWiki project) where selectWiki = selectField $ diff --git a/src/Vervis/Form/Repo.hs b/src/Vervis/Form/Repo.hs index df15d55..c796139 100644 --- a/src/Vervis/Form/Repo.hs +++ b/src/Vervis/Form/Repo.hs @@ -42,12 +42,11 @@ data NewRepo = NewRepo , nrpRole :: RepoRoleId } -newRepoAForm - :: PersonId -> SharerId -> Maybe ProjectId -> AForm Handler NewRepo -newRepoAForm pid sid mpid = NewRepo +newRepoAForm :: SharerId -> Maybe ProjectId -> AForm Handler NewRepo +newRepoAForm sid mjid = NewRepo <$> (text2rp <$> areq (mkIdentField sid) "Identifier*" Nothing) <*> areq (selectFieldList vcsList) "Version control system*" Nothing - <*> aopt (selectProjectForNew sid) "Project" (Just mpid) + <*> aopt (selectProjectForNew sid) "Project" (Just mjid) <*> aopt textField "Description" Nothing <*> areq selectRole "Your role*" Nothing where @@ -58,11 +57,11 @@ newRepoAForm pid sid mpid = NewRepo ] selectRole = selectField $ - optionsPersistKey [RepoRolePerson ==. pid] [] $ + optionsPersistKey [RepoRoleSharer ==. sid] [] $ rl2text . repoRoleIdent -newRepoForm :: PersonId -> SharerId -> Maybe ProjectId -> Form NewRepo -newRepoForm pid sid mpid = renderDivs $ newRepoAForm pid sid mpid +newRepoForm :: SharerId -> Maybe ProjectId -> Form NewRepo +newRepoForm sid mjid = renderDivs $ newRepoAForm sid mjid data NewRepoCollab = NewRepoCollab { ncPerson :: PersonId @@ -70,8 +69,8 @@ data NewRepoCollab = NewRepoCollab } newRepoCollabAForm - :: PersonId -> Maybe ProjectId -> RepoId -> AForm Handler NewRepoCollab -newRepoCollabAForm pid mjid rid = NewRepoCollab + :: SharerId -> Maybe ProjectId -> RepoId -> AForm Handler NewRepoCollab +newRepoCollabAForm sid mjid rid = NewRepoCollab <$> areq (selectPerson mjid) "Person*" Nothing <*> areq selectRole "Role*" Nothing where @@ -79,12 +78,12 @@ newRepoCollabAForm pid mjid rid = NewRepoCollab selectPerson (Just jid) = selectCollabFromProject jid rid selectRole = selectField $ - optionsPersistKey [RepoRolePerson ==. pid] [] $ + optionsPersistKey [RepoRoleSharer ==. sid] [] $ rl2text . repoRoleIdent newRepoCollabForm - :: PersonId -> Maybe ProjectId -> RepoId -> Form NewRepoCollab -newRepoCollabForm pid mjid rid = renderDivs $ newRepoCollabAForm pid mjid rid + :: SharerId -> Maybe ProjectId -> RepoId -> Form NewRepoCollab +newRepoCollabForm sid mjid rid = renderDivs $ newRepoCollabAForm sid mjid rid editRepoAForm :: Entity Repo -> AForm Handler Repo editRepoAForm (Entity rid repo) = Repo diff --git a/src/Vervis/Form/Role.hs b/src/Vervis/Form/Role.hs index 0d9f6c6..4d60a0c 100644 --- a/src/Vervis/Form/Role.hs +++ b/src/Vervis/Form/Role.hs @@ -41,13 +41,13 @@ data NewRepoRole = NewRepoRole , nrrDesc :: Text } -newRepoRoleAForm :: PersonId -> AForm Handler NewRepoRole -newRepoRoleAForm pid = NewRepoRole - <$> areq (newRepoRoleIdentField pid) "Name*" Nothing +newRepoRoleAForm :: SharerId -> AForm Handler NewRepoRole +newRepoRoleAForm sid = NewRepoRole + <$> areq (newRepoRoleIdentField sid) "Name*" Nothing <*> areq textField "Description" Nothing -newRepoRoleForm :: PersonId -> Form NewRepoRole -newRepoRoleForm pid = renderDivs $ newRepoRoleAForm pid +newRepoRoleForm :: SharerId -> Form NewRepoRole +newRepoRoleForm sid = renderDivs $ newRepoRoleAForm sid newRepoRoleOpAForm :: AppDB RepoRoleId -> AForm Handler RepoOperation newRepoRoleOpAForm getrid = areq (newRepoOpField getrid) "Operation*" Nothing @@ -60,13 +60,13 @@ data NewProjectRole = NewProjectRole , nprDesc :: Text } -newProjectRoleAForm :: PersonId -> AForm Handler NewProjectRole -newProjectRoleAForm pid = NewProjectRole - <$> areq (newProjectRoleIdentField pid) "Name*" Nothing +newProjectRoleAForm :: SharerId -> AForm Handler NewProjectRole +newProjectRoleAForm sid = NewProjectRole + <$> areq (newProjectRoleIdentField sid) "Name*" Nothing <*> areq textField "Description" Nothing -newProjectRoleForm :: PersonId -> Form NewProjectRole -newProjectRoleForm pid = renderDivs $ newProjectRoleAForm pid +newProjectRoleForm :: SharerId -> Form NewProjectRole +newProjectRoleForm sid = renderDivs $ newProjectRoleAForm sid newProjectRoleOpAForm :: AppDB ProjectRoleId -> AForm Handler ProjectOperation newProjectRoleOpAForm getrid = diff --git a/src/Vervis/Handler/Project.hs b/src/Vervis/Handler/Project.hs index 42911ae..05e37e0 100644 --- a/src/Vervis/Handler/Project.hs +++ b/src/Vervis/Handler/Project.hs @@ -66,11 +66,11 @@ getProjectsR ident = do postProjectsR :: ShrIdent -> Handler Html postProjectsR shr = do - pid <- requireAuthId Entity sid _ <- runDB $ getBy404 $ UniqueSharer shr - ((result, widget), enctype) <- runFormPost $ newProjectForm pid sid + ((result, widget), enctype) <- runFormPost $ newProjectForm sid case result of FormSuccess np -> do + pid <- requireAuthId runDB $ do let project = Project { projectIdent = npIdent np @@ -98,9 +98,8 @@ postProjectsR shr = do getProjectNewR :: ShrIdent -> Handler Html getProjectNewR shr = do - pid <- requireAuthId Entity sid _ <- runDB $ getBy404 $ UniqueSharer shr - ((_result, widget), enctype) <- runFormPost $ newProjectForm pid sid + ((_result, widget), enctype) <- runFormPost $ newProjectForm sid defaultLayout $(widgetFile "project/new") getProjectR :: ShrIdent -> PrjIdent -> Handler Html @@ -163,17 +162,16 @@ getProjectDevsR shr rp = do postProjectDevsR :: ShrIdent -> PrjIdent -> Handler Html postProjectDevsR shr rp = do - (pid, rid) <- runDB $ do + (sid, jid) <- runDB $ do Entity s _ <- getBy404 $ UniqueSharer shr - Entity p _ <- getBy404 $ UniquePersonIdent s - Entity r _ <- getBy404 $ UniqueProject rp s - return (p, r) - ((result, widget), enctype) <- runFormPost $ newProjectCollabForm pid rid + Entity j _ <- getBy404 $ UniqueProject rp s + return (s, j) + ((result, widget), enctype) <- runFormPost $ newProjectCollabForm sid jid case result of FormSuccess nc -> do runDB $ do let collab = ProjectCollab - { projectCollabProject = rid + { projectCollabProject = jid , projectCollabPerson = ncPerson nc , projectCollabRole = ncRole nc } @@ -189,26 +187,25 @@ postProjectDevsR shr rp = do getProjectDevNewR :: ShrIdent -> PrjIdent -> Handler Html getProjectDevNewR shr rp = do - (pid, rid) <- runDB $ do + (sid, jid) <- runDB $ do Entity s _ <- getBy404 $ UniqueSharer shr - Entity p _ <- getBy404 $ UniquePersonIdent s - Entity r _ <- getBy404 $ UniqueProject rp s - return (p, r) - ((_result, widget), enctype) <- runFormPost $ newProjectCollabForm pid rid + Entity j _ <- getBy404 $ UniqueProject rp s + return (s, j) + ((_result, widget), enctype) <- runFormPost $ newProjectCollabForm sid jid defaultLayout $(widgetFile "project/collab/new") getProjectDevR :: ShrIdent -> PrjIdent -> ShrIdent -> Handler Html getProjectDevR shr rp dev = do rl <- runDB $ do - rid <- do + jid <- do Entity s _ <- getBy404 $ UniqueSharer shr - Entity r _ <- getBy404 $ UniqueProject rp s - return r + Entity j _ <- getBy404 $ UniqueProject rp s + return j pid <- do Entity s _ <- getBy404 $ UniqueSharer dev Entity p _ <- getBy404 $ UniquePersonIdent s return p - Entity _cid collab <- getBy404 $ UniqueProjectCollab rid pid + Entity _cid collab <- getBy404 $ UniqueProjectCollab jid pid role <- getJust $ projectCollabRole collab return $ projectRoleIdent role defaultLayout $(widgetFile "project/collab/one") @@ -216,15 +213,15 @@ getProjectDevR shr rp dev = do deleteProjectDevR :: ShrIdent -> PrjIdent -> ShrIdent -> Handler Html deleteProjectDevR shr rp dev = do runDB $ do - rid <- do + jid <- do Entity s _ <- getBy404 $ UniqueSharer shr - Entity r _ <- getBy404 $ UniqueProject rp s - return r + Entity j _ <- getBy404 $ UniqueProject rp s + return j pid <- do Entity s _ <- getBy404 $ UniqueSharer dev Entity p _ <- getBy404 $ UniquePersonIdent s return p - Entity cid _collab <- getBy404 $ UniqueProjectCollab rid pid + Entity cid _collab <- getBy404 $ UniqueProjectCollab jid pid delete cid setMessage "Collaborator removed." redirect $ ProjectDevsR shr rp diff --git a/src/Vervis/Handler/Repo.hs b/src/Vervis/Handler/Repo.hs index 60e5ff5..cd297e2 100644 --- a/src/Vervis/Handler/Repo.hs +++ b/src/Vervis/Handler/Repo.hs @@ -113,9 +113,8 @@ getReposR user = do postReposR :: ShrIdent -> Handler Html postReposR user = do - Entity pid person <- requireAuth Entity sid _sharer <- runDB $ getBy404 $ UniqueSharer user - ((result, widget), enctype) <- runFormPost $ newRepoForm pid sid Nothing + ((result, widget), enctype) <- runFormPost $ newRepoForm sid Nothing case result of FormSuccess nrp -> do parent <- askSharerDir user @@ -126,6 +125,7 @@ postReposR user = do case nrpVcs nrp of VCSDarcs -> D.createRepo parent repoName VCSGit -> G.createRepo parent repoName + Entity pid person <- requireAuth runDB $ do let repo = Repo { repoIdent = nrpIdent nrp @@ -153,9 +153,8 @@ postReposR user = do getRepoNewR :: ShrIdent -> Handler Html getRepoNewR user = do - Entity pid person <- requireAuth Entity sid _sharer <- runDB $ getBy404 $ UniqueSharer user - ((_result, widget), enctype) <- runFormPost $ newRepoForm pid sid Nothing + ((_result, widget), enctype) <- runFormPost $ newRepoForm sid Nothing defaultLayout $(widgetFile "repo/new") selectRepo :: ShrIdent -> RpIdent -> AppDB Repo @@ -278,12 +277,11 @@ getRepoDevsR shr rp = do postRepoDevsR :: ShrIdent -> RpIdent -> Handler Html postRepoDevsR shr rp = do - (pid, mjid, rid) <- runDB $ do + (sid, mjid, rid) <- runDB $ do Entity s _ <- getBy404 $ UniqueSharer shr - Entity p _ <- getBy404 $ UniquePersonIdent s Entity r repository <- getBy404 $ UniqueRepo rp s - return (p, repoProject repository, r) - ((result, widget), enctype) <- runFormPost $ newRepoCollabForm pid mjid rid + return (s, repoProject repository, r) + ((result, widget), enctype) <- runFormPost $ newRepoCollabForm sid mjid rid case result of FormSuccess nc -> do runDB $ do @@ -304,13 +302,12 @@ postRepoDevsR shr rp = do getRepoDevNewR :: ShrIdent -> RpIdent -> Handler Html getRepoDevNewR shr rp = do - (pid, mjid, rid) <- runDB $ do + (sid, mjid, rid) <- runDB $ do Entity s _ <- getBy404 $ UniqueSharer shr - Entity p _ <- getBy404 $ UniquePersonIdent s Entity r repository <- getBy404 $ UniqueRepo rp s - return (p, repoProject repository, r) + return (s, repoProject repository, r) ((_result, widget), enctype) <- - runFormPost $ newRepoCollabForm pid mjid rid + runFormPost $ newRepoCollabForm sid mjid rid defaultLayout $(widgetFile "repo/collab/new") getRepoDevR :: ShrIdent -> RpIdent -> ShrIdent -> Handler Html diff --git a/src/Vervis/Handler/Role.hs b/src/Vervis/Handler/Role.hs index 323e653..9775bd0 100644 --- a/src/Vervis/Handler/Role.hs +++ b/src/Vervis/Handler/Role.hs @@ -55,19 +55,22 @@ import Vervis.Settings (widgetFile) getRepoRolesR :: Handler Html getRepoRolesR = do pid <- requireAuthId - roles <- runDB $ selectList [RepoRolePerson ==. pid] [] + roles <- runDB $ do + person <- getJust pid + selectList [RepoRoleSharer ==. personIdent person] [] defaultLayout $(widgetFile "repo/role/list") postRepoRolesR :: Handler Html postRepoRolesR = do pid <- requireAuthId - ((result, widget), enctype) <- runFormPost $ newRepoRoleForm pid + sid <- fmap personIdent $ runDB $ getJust pid + ((result, widget), enctype) <- runFormPost $ newRepoRoleForm sid case result of FormSuccess nrr -> do runDB $ do let role = RepoRole { repoRoleIdent = nrrIdent nrr - , repoRolePerson = pid + , repoRoleSharer = sid , repoRoleDesc = nrrDesc nrr } insert_ role @@ -82,20 +85,24 @@ postRepoRolesR = do getRepoRoleNewR :: Handler Html getRepoRoleNewR = do pid <- requireAuthId - ((_result, widget), enctype) <- runFormPost $ newRepoRoleForm pid + sid <- fmap personIdent $ runDB $ getJust pid + ((_result, widget), enctype) <- runFormPost $ newRepoRoleForm sid defaultLayout $(widgetFile "repo/role/new") getRepoRoleR :: RlIdent -> Handler Html getRepoRoleR rl = do pid <- requireAuthId - Entity _rid role <- runDB $ getBy404 $ UniqueRepoRole pid rl + sid <- fmap personIdent $ runDB $ getJust pid + Entity _rid role <- runDB $ getBy404 $ UniqueRepoRole sid rl defaultLayout $(widgetFile "repo/role/one") deleteRepoRoleR :: RlIdent -> Handler Html deleteRepoRoleR rl = do pid <- requireAuthId runDB $ do - Entity rid _r <- getBy404 $ UniqueRepoRole pid rl + person <- getJust pid + let sid = personIdent person + Entity rid _r <- getBy404 $ UniqueRepoRole sid rl delete rid setMessage "Role deleted." redirect RepoRolesR @@ -111,7 +118,8 @@ getRepoRoleOpsR :: RlIdent -> Handler Html getRepoRoleOpsR rl = do pid <- requireAuthId ops <- runDB $ do - Entity rid _r <- getBy404 $ UniqueRepoRole pid rl + sid <- personIdent <$> getJust pid + Entity rid _r <- getBy404 $ UniqueRepoRole sid rl as <- selectList [RepoAccessRole ==. rid] [] return $ map (repoAccessOp . entityVal) as defaultLayout $(widgetFile "repo/role/op/list") @@ -119,7 +127,9 @@ getRepoRoleOpsR rl = do postRepoRoleOpsR :: RlIdent -> Handler Html postRepoRoleOpsR rl = do pid <- requireAuthId - let getrid = fmap entityKey $ getBy404 $ UniqueRepoRole pid rl + let getrid = do + sid <- personIdent <$> getJust pid + fmap entityKey $ getBy404 $ UniqueRepoRole sid rl ((result, widget), enctype) <- runFormPost $ newRepoRoleOpForm getrid case result of FormSuccess op -> do @@ -141,26 +151,31 @@ postRepoRoleOpsR rl = do getRepoRoleOpNewR :: RlIdent -> Handler Html getRepoRoleOpNewR rl = do pid <- requireAuthId - let getrid = fmap entityKey $ getBy404 $ UniqueRepoRole pid rl + let getrid = do + sid <- personIdent <$> getJust pid + fmap entityKey $ getBy404 $ UniqueRepoRole sid rl ((_result, widget), enctype) <- runFormPost $ newRepoRoleOpForm getrid defaultLayout $(widgetFile "repo/role/op/new") getProjectRolesR :: Handler Html getProjectRolesR = do pid <- requireAuthId - roles <- runDB $ selectList [ProjectRolePerson ==. pid] [] + roles <- runDB $ do + person <- getJust pid + selectList [ProjectRoleSharer ==. personIdent person] [] defaultLayout $(widgetFile "project/role/list") postProjectRolesR :: Handler Html postProjectRolesR = do pid <- requireAuthId - ((result, widget), enctype) <- runFormPost $ newProjectRoleForm pid + sid <- fmap personIdent $ runDB $ getJust pid + ((result, widget), enctype) <- runFormPost $ newProjectRoleForm sid case result of FormSuccess npr -> do runDB $ do let role = ProjectRole { projectRoleIdent = nprIdent npr - , projectRolePerson = pid + , projectRoleSharer = sid , projectRoleDesc = nprDesc npr } insert_ role @@ -175,20 +190,24 @@ postProjectRolesR = do getProjectRoleNewR :: Handler Html getProjectRoleNewR = do pid <- requireAuthId - ((_result, widget), enctype) <- runFormPost $ newProjectRoleForm pid + sid <- fmap personIdent $ runDB $ getJust pid + ((_result, widget), enctype) <- runFormPost $ newProjectRoleForm sid defaultLayout $(widgetFile "project/role/new") getProjectRoleR :: RlIdent -> Handler Html getProjectRoleR rl = do pid <- requireAuthId - Entity _rid role <- runDB $ getBy404 $ UniqueProjectRole pid rl + Entity _rid role <- runDB $ do + sid <- personIdent <$> getJust pid + getBy404 $ UniqueProjectRole sid rl defaultLayout $(widgetFile "project/role/one") deleteProjectRoleR :: RlIdent -> Handler Html deleteProjectRoleR rl = do pid <- requireAuthId runDB $ do - Entity rid _r <- getBy404 $ UniqueProjectRole pid rl + sid <- personIdent <$> getJust pid + Entity rid _r <- getBy404 $ UniqueProjectRole sid rl delete rid setMessage "Role deleted." redirect ProjectRolesR @@ -204,7 +223,8 @@ getProjectRoleOpsR :: RlIdent -> Handler Html getProjectRoleOpsR rl = do pid <- requireAuthId ops <- runDB $ do - Entity rid _r <- getBy404 $ UniqueProjectRole pid rl + sid <- personIdent <$> getJust pid + Entity rid _r <- getBy404 $ UniqueProjectRole sid rl as <- selectList [ProjectAccessRole ==. rid] [] return $ map (projectAccessOp . entityVal) as defaultLayout $(widgetFile "project/role/op/list") @@ -212,7 +232,9 @@ getProjectRoleOpsR rl = do postProjectRoleOpsR :: RlIdent -> Handler Html postProjectRoleOpsR rl = do pid <- requireAuthId - let getrid = fmap entityKey $ getBy404 $ UniqueProjectRole pid rl + let getrid = do + sid <- personIdent <$> getJust pid + fmap entityKey $ getBy404 $ UniqueProjectRole sid rl ((result, widget), enctype) <- runFormPost $ newProjectRoleOpForm getrid case result of FormSuccess op -> do @@ -234,6 +256,8 @@ postProjectRoleOpsR rl = do getProjectRoleOpNewR :: RlIdent -> Handler Html getProjectRoleOpNewR rl = do pid <- requireAuthId - let getrid = fmap entityKey $ getBy404 $ UniqueProjectRole pid rl + let getrid = do + sid <- personIdent <$> getJust pid + fmap entityKey $ getBy404 $ UniqueProjectRole sid rl ((_result, widget), enctype) <- runFormPost $ newProjectRoleOpForm getrid defaultLayout $(widgetFile "project/role/op/new") diff --git a/templates/repo/new.hamlet b/templates/repo/new.hamlet index 022d71f..e75a72d 100644 --- a/templates/repo/new.hamlet +++ b/templates/repo/new.hamlet @@ -12,8 +12,6 @@ $# You should have received a copy of the CC0 Public Domain Dedication along $# with this software. If not, see $# . -Enter your details and click "Submit" to create a new repo. -
^{widget}