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.
-