DB: Switch to more flexible collaborator model
This commit is contained in:
parent
bf2e172f6e
commit
bfa9774f83
13 changed files with 504 additions and 118 deletions
|
@ -1,6 +1,7 @@
|
||||||
-- This file is part of Vervis.
|
-- This file is part of Vervis.
|
||||||
--
|
--
|
||||||
-- Written in 2016, 2018, 2019, 2020 by fr33domlover <fr33domlover@riseup.net>.
|
-- Written in 2016, 2018, 2019, 2020, 2022
|
||||||
|
-- by fr33domlover <fr33domlover@riseup.net>.
|
||||||
--
|
--
|
||||||
-- ♡ Copying is an act of love. Please copy, reuse and share.
|
-- ♡ Copying is an act of love. Please copy, reuse and share.
|
||||||
--
|
--
|
||||||
|
@ -572,16 +573,67 @@ RemoteMessage
|
||||||
UniqueRemoteMessage rest
|
UniqueRemoteMessage rest
|
||||||
UniqueRemoteMessageCreate create
|
UniqueRemoteMessageCreate create
|
||||||
|
|
||||||
RepoCollab
|
|
||||||
|
------------------------------------------------------------------------------
|
||||||
|
-- Collaborators
|
||||||
|
------------------------------------------------------------------------------
|
||||||
|
|
||||||
|
Collab
|
||||||
|
|
||||||
|
-------------------------------- Collab topic --------------------------------
|
||||||
|
|
||||||
|
CollabRoleLocal
|
||||||
|
collab CollabId
|
||||||
|
role RoleId
|
||||||
|
|
||||||
|
UniqueCollabRoleLocal collab
|
||||||
|
|
||||||
|
CollabTopicLocalRepo
|
||||||
|
collab CollabId
|
||||||
repo RepoId
|
repo RepoId
|
||||||
person PersonId
|
|
||||||
role RoleId Maybe
|
|
||||||
|
|
||||||
UniqueRepoCollab repo person
|
UniqueCollabTopicLocalRepo collab
|
||||||
|
|
||||||
ProjectCollab
|
CollabTopicLocalProject
|
||||||
|
collab CollabId
|
||||||
project ProjectId
|
project ProjectId
|
||||||
person PersonId
|
|
||||||
role RoleId Maybe
|
|
||||||
|
|
||||||
UniqueProjectCollab project person
|
UniqueCollabTopicLocalProject collab
|
||||||
|
|
||||||
|
CollabTopicRemote
|
||||||
|
collab CollabId
|
||||||
|
topic RemoteObjectId
|
||||||
|
role LocalURI Maybe
|
||||||
|
|
||||||
|
UniqueCollabTopicRemote collab
|
||||||
|
|
||||||
|
-------------------------------- Collab sender -------------------------------
|
||||||
|
|
||||||
|
CollabSenderLocal
|
||||||
|
collab CollabId
|
||||||
|
activity OutboxItemId
|
||||||
|
|
||||||
|
UniqueCollabSenderLocal collab
|
||||||
|
UniqueCollabSenderLocalActivity activity
|
||||||
|
|
||||||
|
CollabSenderRemote
|
||||||
|
collab CollabId
|
||||||
|
actor RemoteActorId
|
||||||
|
activity RemoteActivityId
|
||||||
|
|
||||||
|
UniqueCollabSenderRemote collab
|
||||||
|
UniqueCollabSenderRemoteActivity activity
|
||||||
|
|
||||||
|
-------------------------------- Collab recipient ----------------------------
|
||||||
|
|
||||||
|
CollabRecipLocal
|
||||||
|
collab CollabId
|
||||||
|
person PersonId
|
||||||
|
|
||||||
|
UniqueCollabRecipLocal collab
|
||||||
|
|
||||||
|
CollabRecipRemote
|
||||||
|
collab CollabId
|
||||||
|
actor RemoteActorId
|
||||||
|
|
||||||
|
UniqueCollabRecipRemote collab
|
||||||
|
|
59
migrations/2022_06_14_collab.model
Normal file
59
migrations/2022_06_14_collab.model
Normal file
|
@ -0,0 +1,59 @@
|
||||||
|
Collab
|
||||||
|
|
||||||
|
|
||||||
|
|
||||||
|
CollabRoleLocal
|
||||||
|
collab CollabId
|
||||||
|
role RoleId
|
||||||
|
|
||||||
|
UniqueCollabRoleLocal collab
|
||||||
|
|
||||||
|
CollabTopicLocalRepo
|
||||||
|
collab CollabId
|
||||||
|
repo RepoId
|
||||||
|
|
||||||
|
UniqueCollabTopicLocalRepo collab
|
||||||
|
|
||||||
|
CollabTopicLocalProject
|
||||||
|
collab CollabId
|
||||||
|
project ProjectId
|
||||||
|
|
||||||
|
UniqueCollabTopicLocalProject collab
|
||||||
|
|
||||||
|
CollabTopicRemote
|
||||||
|
collab CollabId
|
||||||
|
topic RemoteObjectId
|
||||||
|
role LocalURI Maybe
|
||||||
|
|
||||||
|
UniqueCollabTopicRemote collab
|
||||||
|
|
||||||
|
|
||||||
|
|
||||||
|
CollabSenderLocal
|
||||||
|
collab CollabId
|
||||||
|
activity OutboxItemId
|
||||||
|
|
||||||
|
UniqueCollabSenderLocal collab
|
||||||
|
UniqueCollabSenderLocalActivity activity
|
||||||
|
|
||||||
|
CollabSenderRemote
|
||||||
|
collab CollabId
|
||||||
|
actor RemoteActorId
|
||||||
|
activity RemoteActivityId
|
||||||
|
|
||||||
|
UniqueCollabSenderRemote collab
|
||||||
|
UniqueCollabSenderRemoteActivity activity
|
||||||
|
|
||||||
|
|
||||||
|
|
||||||
|
CollabRecipLocal
|
||||||
|
collab CollabId
|
||||||
|
person PersonId
|
||||||
|
|
||||||
|
UniqueCollabRecipLocal collab
|
||||||
|
|
||||||
|
CollabRecipRemote
|
||||||
|
collab CollabId
|
||||||
|
actor RemoteActorId
|
||||||
|
|
||||||
|
UniqueCollabRecipRemote collab
|
94
migrations/2022_06_14_collab_mig.model
Normal file
94
migrations/2022_06_14_collab_mig.model
Normal file
|
@ -0,0 +1,94 @@
|
||||||
|
Outbox
|
||||||
|
|
||||||
|
OutboxItem
|
||||||
|
outbox OutboxId
|
||||||
|
activity PersistJSONObject
|
||||||
|
published UTCTime
|
||||||
|
|
||||||
|
Person
|
||||||
|
|
||||||
|
Project
|
||||||
|
ident PrjIdent
|
||||||
|
sharer Int64
|
||||||
|
name Text Maybe
|
||||||
|
desc Text Maybe
|
||||||
|
workflow Int64
|
||||||
|
nextTicket Int
|
||||||
|
wiki RepoId Maybe
|
||||||
|
collabUser RoleId Maybe
|
||||||
|
collabAnon RoleId Maybe
|
||||||
|
inbox Int64
|
||||||
|
outbox OutboxId
|
||||||
|
followers Int64
|
||||||
|
|
||||||
|
Repo
|
||||||
|
ident RpIdent
|
||||||
|
sharer Int64
|
||||||
|
vcs VersionControlSystem
|
||||||
|
project ProjectId Maybe
|
||||||
|
desc Text Maybe
|
||||||
|
mainBranch Text
|
||||||
|
collabUser RoleId Maybe
|
||||||
|
collabAnon RoleId Maybe
|
||||||
|
inbox Int64
|
||||||
|
outbox OutboxId
|
||||||
|
followers Int64
|
||||||
|
|
||||||
|
Role
|
||||||
|
|
||||||
|
|
||||||
|
|
||||||
|
Collab
|
||||||
|
|
||||||
|
|
||||||
|
|
||||||
|
CollabRoleLocal
|
||||||
|
collab CollabId
|
||||||
|
role RoleId
|
||||||
|
|
||||||
|
UniqueCollabRoleLocal collab
|
||||||
|
|
||||||
|
CollabTopicLocalRepo
|
||||||
|
collab CollabId
|
||||||
|
repo RepoId
|
||||||
|
|
||||||
|
UniqueCollabTopicLocalRepo collab
|
||||||
|
|
||||||
|
CollabTopicLocalProject
|
||||||
|
collab CollabId
|
||||||
|
project ProjectId
|
||||||
|
|
||||||
|
UniqueCollabTopicLocalProject collab
|
||||||
|
|
||||||
|
|
||||||
|
|
||||||
|
CollabSenderLocal
|
||||||
|
collab CollabId
|
||||||
|
activity OutboxItemId
|
||||||
|
|
||||||
|
UniqueCollabSenderLocal collab
|
||||||
|
UniqueCollabSenderLocalActivity activity
|
||||||
|
|
||||||
|
|
||||||
|
|
||||||
|
CollabRecipLocal
|
||||||
|
collab CollabId
|
||||||
|
person PersonId
|
||||||
|
|
||||||
|
UniqueCollabRecipLocal collab
|
||||||
|
|
||||||
|
|
||||||
|
|
||||||
|
RepoCollab
|
||||||
|
repo RepoId
|
||||||
|
person PersonId
|
||||||
|
role RoleId Maybe
|
||||||
|
|
||||||
|
UniqueRepoCollab repo person
|
||||||
|
|
||||||
|
ProjectCollab
|
||||||
|
project ProjectId
|
||||||
|
person PersonId
|
||||||
|
role RoleId Maybe
|
||||||
|
|
||||||
|
UniqueProjectCollab project person
|
|
@ -1,6 +1,6 @@
|
||||||
{- This file is part of Vervis.
|
{- This file is part of Vervis.
|
||||||
-
|
-
|
||||||
- Written in 2019 by fr33domlover <fr33domlover@riseup.net>.
|
- Written in 2019, 2022 by fr33domlover <fr33domlover@riseup.net>.
|
||||||
-
|
-
|
||||||
- ♡ Copying is an act of love. Please copy, reuse and share.
|
- ♡ Copying is an act of love. Please copy, reuse and share.
|
||||||
-
|
-
|
||||||
|
@ -63,11 +63,13 @@ import Control.Applicative ((<|>))
|
||||||
import Control.Monad.IO.Class
|
import Control.Monad.IO.Class
|
||||||
import Control.Monad.Trans.Maybe
|
import Control.Monad.Trans.Maybe
|
||||||
import Control.Monad.Trans.Reader
|
import Control.Monad.Trans.Reader
|
||||||
import Data.Maybe (fromMaybe, isJust)
|
import Data.Maybe
|
||||||
import Database.Persist.Class (getBy)
|
import Database.Persist.Class (getBy)
|
||||||
import Database.Persist.Sql (SqlBackend)
|
import Database.Persist.Sql (SqlBackend)
|
||||||
import Database.Persist.Types (Entity (..))
|
import Database.Persist.Types (Entity (..))
|
||||||
|
|
||||||
|
import qualified Database.Esqueleto as E
|
||||||
|
|
||||||
import Vervis.Model
|
import Vervis.Model
|
||||||
import Vervis.Model.Ident
|
import Vervis.Model.Ident
|
||||||
import Vervis.Model.Role
|
import Vervis.Model.Role
|
||||||
|
@ -132,9 +134,19 @@ checkRepoAccess mpid op shr rp = do
|
||||||
Nothing -> pure $ fromMaybe Guest $ asAnon repo
|
Nothing -> pure $ fromMaybe Guest $ asAnon repo
|
||||||
status <$> roleHasAccess role op
|
status <$> roleHasAccess role op
|
||||||
where
|
where
|
||||||
asCollab rid pid =
|
asCollab rid pid = do
|
||||||
fmap (maybe Developer RoleID . repoCollabRole . entityVal) <$>
|
fmap (maybe Developer RoleID . E.unValue . snd) . listToMaybe <$> do
|
||||||
getBy (UniqueRepoCollab rid pid)
|
E.select $ E.from $ \ (topic `E.InnerJoin` recip `E.LeftOuterJoin` role) -> do
|
||||||
|
E.on $ E.just (topic E.^. CollabTopicLocalRepoCollab) E.==. role E.?. CollabRoleLocalCollab
|
||||||
|
E.on $ topic E.^. CollabTopicLocalRepoCollab E.==. recip E.^. CollabRecipLocalCollab
|
||||||
|
E.where_ $
|
||||||
|
topic E.^. CollabTopicLocalRepoRepo E.==. E.val rid E.&&.
|
||||||
|
recip E.^. CollabRecipLocalPerson E.==. E.val pid
|
||||||
|
E.limit 1
|
||||||
|
return
|
||||||
|
( topic E.^. CollabTopicLocalRepoCollab
|
||||||
|
, role E.?. CollabRoleLocalRole
|
||||||
|
)
|
||||||
asUser = fmap RoleID . repoCollabUser
|
asUser = fmap RoleID . repoCollabUser
|
||||||
asAnon = fmap RoleID . repoCollabAnon
|
asAnon = fmap RoleID . repoCollabAnon
|
||||||
|
|
||||||
|
@ -160,8 +172,18 @@ checkProjectAccess mpid op shr prj = do
|
||||||
Nothing -> pure $ fromMaybe Guest $ asAnon project
|
Nothing -> pure $ fromMaybe Guest $ asAnon project
|
||||||
status <$> roleHasAccess role op
|
status <$> roleHasAccess role op
|
||||||
where
|
where
|
||||||
asCollab jid pid =
|
asCollab jid pid = do
|
||||||
fmap (maybe Developer RoleID . projectCollabRole . entityVal) <$>
|
fmap (maybe Developer RoleID . E.unValue . snd) . listToMaybe <$> do
|
||||||
getBy (UniqueProjectCollab jid pid)
|
E.select $ E.from $ \ (topic `E.InnerJoin` recip `E.LeftOuterJoin` role) -> do
|
||||||
|
E.on $ E.just (topic E.^. CollabTopicLocalProjectCollab) E.==. role E.?. CollabRoleLocalCollab
|
||||||
|
E.on $ topic E.^. CollabTopicLocalProjectCollab E.==. recip E.^. CollabRecipLocalCollab
|
||||||
|
E.where_ $
|
||||||
|
topic E.^. CollabTopicLocalProjectProject E.==. E.val jid E.&&.
|
||||||
|
recip E.^. CollabRecipLocalPerson E.==. E.val pid
|
||||||
|
E.limit 1
|
||||||
|
return
|
||||||
|
( topic E.^. CollabTopicLocalProjectCollab
|
||||||
|
, role E.?. CollabRoleLocalRole
|
||||||
|
)
|
||||||
asUser = fmap RoleID . projectCollabUser
|
asUser = fmap RoleID . projectCollabUser
|
||||||
asAnon = fmap RoleID . projectCollabAnon
|
asAnon = fmap RoleID . projectCollabAnon
|
||||||
|
|
|
@ -1,6 +1,6 @@
|
||||||
{- This file is part of Vervis.
|
{- This file is part of Vervis.
|
||||||
-
|
-
|
||||||
- Written in 2019, 2020 by fr33domlover <fr33domlover@riseup.net>.
|
- Written in 2019, 2020, 2021, 2022 by fr33domlover <fr33domlover@riseup.net>.
|
||||||
-
|
-
|
||||||
- ♡ Copying is an act of love. Please copy, reuse and share.
|
- ♡ Copying is an act of love. Please copy, reuse and share.
|
||||||
-
|
-
|
||||||
|
@ -1124,7 +1124,10 @@ insertActivityToLocalInboxes makeInboxItem requireOwner mauthor mibidAuthor reci
|
||||||
(localRecipProjectTeam d || any (localRecipTicketTeam . snd) ts)
|
(localRecipProjectTeam d || any (localRecipTicketTeam . snd) ts)
|
||||||
]
|
]
|
||||||
jids <- selectKeysList [ProjectSharer ==. sid, ProjectIdent <-. prjs] []
|
jids <- selectKeysList [ProjectSharer ==. sid, ProjectIdent <-. prjs] []
|
||||||
pids <- map (projectCollabPerson . entityVal) <$> selectList [ProjectCollabProject <-. jids] []
|
pids <- fmap (map E.unValue) $ E.select $ E.from $ \ (topic `E.InnerJoin` recip) -> do
|
||||||
|
E.on $ topic E.^. CollabTopicLocalProjectCollab E.==. recip E.^. CollabRecipLocalCollab
|
||||||
|
E.where_ $ topic E.^. CollabTopicLocalProjectProject `E.in_` E.valList jids
|
||||||
|
return $ recip E.^. CollabRecipLocalPerson
|
||||||
map (personInbox . entityVal) <$> selectList [PersonId <-. pids] [Asc PersonInbox]
|
map (personInbox . entityVal) <$> selectList [PersonId <-. pids] [Asc PersonInbox]
|
||||||
getRepoTeams sid repos = do
|
getRepoTeams sid repos = do
|
||||||
let rps =
|
let rps =
|
||||||
|
@ -1134,7 +1137,10 @@ insertActivityToLocalInboxes makeInboxItem requireOwner mauthor mibidAuthor reci
|
||||||
(localRecipRepo d || not requireOwner || isAuthor (LocalActorRepo shr rp))
|
(localRecipRepo d || not requireOwner || isAuthor (LocalActorRepo shr rp))
|
||||||
]
|
]
|
||||||
rids <- selectKeysList [RepoSharer ==. sid, RepoIdent <-. rps] []
|
rids <- selectKeysList [RepoSharer ==. sid, RepoIdent <-. rps] []
|
||||||
pids <- map (repoCollabPerson . entityVal) <$> selectList [RepoCollabRepo <-. rids] []
|
pids <- fmap (map E.unValue) $ E.select $ E.from $ \ (topic `E.InnerJoin` recip) -> do
|
||||||
|
E.on $ topic E.^. CollabTopicLocalRepoCollab E.==. recip E.^. CollabRecipLocalCollab
|
||||||
|
E.where_ $ topic E.^. CollabTopicLocalRepoRepo `E.in_` E.valList rids
|
||||||
|
return $ recip E.^. CollabRecipLocalPerson
|
||||||
map (personInbox . entityVal) <$> selectList [PersonId <-. pids] [Asc PersonInbox]
|
map (personInbox . entityVal) <$> selectList [PersonId <-. pids] [Asc PersonInbox]
|
||||||
|
|
||||||
-- | Given a list of local recipients, which may include actors and
|
-- | Given a list of local recipients, which may include actors and
|
||||||
|
|
|
@ -1,6 +1,6 @@
|
||||||
{- This file is part of Vervis.
|
{- This file is part of Vervis.
|
||||||
-
|
-
|
||||||
- Written in 2016, 2019 by fr33domlover <fr33domlover@riseup.net>.
|
- Written in 2016, 2019, 2022 by fr33domlover <fr33domlover@riseup.net>.
|
||||||
-
|
-
|
||||||
- ♡ Copying is an act of love. Please copy, reuse and share.
|
- ♡ Copying is an act of love. Please copy, reuse and share.
|
||||||
-
|
-
|
||||||
|
@ -72,12 +72,11 @@ mkIdentField sid = checkIdentUnique sid . checkIdentTemplate $ textField
|
||||||
selectCollabFromAll :: RepoId -> Field Handler PersonId
|
selectCollabFromAll :: RepoId -> Field Handler PersonId
|
||||||
selectCollabFromAll rid = selectField $ do
|
selectCollabFromAll rid = selectField $ do
|
||||||
l <- runDB $ select $
|
l <- runDB $ select $
|
||||||
from $ \ (collab `RightOuterJoin` person `InnerJoin` sharer) -> do
|
from $ \ (person `InnerJoin` sharer `LeftOuterJoin` (recip `InnerJoin` topic)) -> do
|
||||||
|
on $ recip ^. CollabRecipLocalCollab ==. topic ^. CollabTopicLocalRepoCollab &&. topic ^. CollabTopicLocalRepoRepo ==. val rid
|
||||||
|
on $ person ^. PersonId ==. recip ^. CollabRecipLocalPerson
|
||||||
on $ person ^. PersonIdent ==. sharer ^. SharerId
|
on $ person ^. PersonIdent ==. sharer ^. SharerId
|
||||||
on $
|
where_ $ isNothing $ just $ recip ^. CollabRecipLocalId
|
||||||
collab ?. RepoCollabRepo ==. just (val rid) &&.
|
|
||||||
collab ?. RepoCollabPerson ==. just (person ^. PersonId)
|
|
||||||
where_ $ isNothing $ collab ?. RepoCollabId
|
|
||||||
return (sharer ^. SharerIdent, person ^. PersonId)
|
return (sharer ^. SharerIdent, person ^. PersonId)
|
||||||
optionsPairs $ map (bimap (shr2text . unValue) unValue) l
|
optionsPairs $ map (bimap (shr2text . unValue) unValue) l
|
||||||
|
|
||||||
|
@ -87,19 +86,15 @@ selectCollabFromAll rid = selectField $ do
|
||||||
selectCollabFromProject :: ProjectId -> RepoId -> Field Handler PersonId
|
selectCollabFromProject :: ProjectId -> RepoId -> Field Handler PersonId
|
||||||
selectCollabFromProject jid rid = selectField $ do
|
selectCollabFromProject jid rid = selectField $ do
|
||||||
l <- runDB $ select $ from $
|
l <- runDB $ select $ from $
|
||||||
\ ( pcollab `InnerJoin`
|
\ (topic `InnerJoin` recip `InnerJoin` person `InnerJoin` sharer `LeftOuterJoin` (recipR `InnerJoin` topicR)) -> do
|
||||||
person `LeftOuterJoin`
|
on $ recipR ^. CollabRecipLocalCollab ==. topicR ^. CollabTopicLocalRepoCollab &&.
|
||||||
rcollab `InnerJoin`
|
topicR ^. CollabTopicLocalRepoRepo ==. val rid
|
||||||
sharer
|
on $ person ^. PersonId ==. recipR ^. CollabRecipLocalPerson
|
||||||
) -> do
|
|
||||||
on $ person ^. PersonIdent ==. sharer ^. SharerId
|
on $ person ^. PersonIdent ==. sharer ^. SharerId
|
||||||
on $
|
on $ recip ^. CollabRecipLocalPerson ==. person ^. PersonId
|
||||||
rcollab ?. RepoCollabRepo ==. just (val rid) &&.
|
on $ topic ^. CollabTopicLocalProjectCollab ==. recip ^. CollabRecipLocalCollab &&.
|
||||||
rcollab ?. RepoCollabPerson ==. just (person ^. PersonId)
|
topic ^. CollabTopicLocalProjectProject ==. val jid
|
||||||
on $
|
where_ $ isNothing $ just $ recipR ^. CollabRecipLocalId
|
||||||
pcollab ^. ProjectCollabProject ==. val jid &&.
|
|
||||||
pcollab ^. ProjectCollabPerson ==. person ^. PersonId
|
|
||||||
where_ $ isNothing $ rcollab ?. RepoCollabId
|
|
||||||
return (sharer ^. SharerIdent, person ^. PersonId)
|
return (sharer ^. SharerIdent, person ^. PersonId)
|
||||||
optionsPairs $ map (bimap (shr2text . unValue) unValue) l
|
optionsPairs $ map (bimap (shr2text . unValue) unValue) l
|
||||||
|
|
||||||
|
@ -126,12 +121,13 @@ selectProjectForExisting :: SharerId -> RepoId -> Field Handler ProjectId
|
||||||
selectProjectForExisting sid rid = checkMembers $ selectProjectForNew sid
|
selectProjectForExisting sid rid = checkMembers $ selectProjectForNew sid
|
||||||
where
|
where
|
||||||
checkMembers = checkM $ \ jid -> do
|
checkMembers = checkM $ \ jid -> do
|
||||||
l <- runDB $ select $ from $ \ (rc `LeftOuterJoin` pc) -> do
|
l <- runDB $ select $ from $ \ (recipR `InnerJoin` topicR `LeftOuterJoin` (recipJ `InnerJoin` topicJ)) -> do
|
||||||
on $
|
on $ topicJ ^. CollabTopicLocalProjectProject ==. val jid &&.
|
||||||
rc ^. RepoCollabRepo ==. val rid &&.
|
recipJ ^. CollabRecipLocalCollab ==. topicJ ^. CollabTopicLocalProjectCollab
|
||||||
pc ?. ProjectCollabProject ==. just (val jid) &&.
|
on $ recipR ^. CollabRecipLocalPerson ==. recipJ ^. CollabRecipLocalPerson
|
||||||
pc ?. ProjectCollabPerson ==. just (rc ^. RepoCollabPerson)
|
on $ topicR ^. CollabTopicLocalRepoRepo ==. val rid &&.
|
||||||
where_ $ isNothing $ pc ?. ProjectCollabId
|
recipR ^. CollabRecipLocalCollab ==. topicR ^. CollabTopicLocalRepoCollab
|
||||||
|
where_ $ isNothing $ just $ recipJ ^. CollabRecipLocalId
|
||||||
limit 1
|
limit 1
|
||||||
return ()
|
return ()
|
||||||
return $ if null l
|
return $ if null l
|
||||||
|
|
|
@ -1,6 +1,6 @@
|
||||||
{- This file is part of Vervis.
|
{- This file is part of Vervis.
|
||||||
-
|
-
|
||||||
- Written in 2016, 2020 by fr33domlover <fr33domlover@riseup.net>.
|
- Written in 2016, 2020, 2022 by fr33domlover <fr33domlover@riseup.net>.
|
||||||
-
|
-
|
||||||
- ♡ Copying is an act of love. Please copy, reuse and share.
|
- ♡ Copying is an act of love. Please copy, reuse and share.
|
||||||
-
|
-
|
||||||
|
@ -43,11 +43,12 @@ import Vervis.Model.Ident (shr2text)
|
||||||
selectAssigneeFromProject :: PersonId -> ProjectId -> Field Handler PersonId
|
selectAssigneeFromProject :: PersonId -> ProjectId -> Field Handler PersonId
|
||||||
selectAssigneeFromProject pid jid = selectField $ do
|
selectAssigneeFromProject pid jid = selectField $ do
|
||||||
l <- runDB $ select $ from $
|
l <- runDB $ select $ from $
|
||||||
\ (pcollab `InnerJoin` person `InnerJoin` sharer) -> do
|
\ (topic `InnerJoin` recip `InnerJoin` person `InnerJoin` sharer) -> do
|
||||||
on $ person ^. PersonIdent ==. sharer ^. SharerId
|
on $ person ^. PersonIdent ==. sharer ^. SharerId
|
||||||
on $ pcollab ^. ProjectCollabPerson ==. person ^. PersonId
|
on $ recip ^. CollabRecipLocalPerson ==. person ^. PersonId
|
||||||
|
on $ topic ^. CollabTopicLocalProjectCollab ==. recip ^. CollabRecipLocalCollab
|
||||||
where_ $
|
where_ $
|
||||||
pcollab ^. ProjectCollabProject ==. val jid &&.
|
topic ^. CollabTopicLocalProjectProject ==. val jid &&.
|
||||||
person ^. PersonId !=. val pid
|
person ^. PersonId !=. val pid
|
||||||
return (sharer ^. SharerIdent, person ^. PersonId)
|
return (sharer ^. SharerIdent, person ^. PersonId)
|
||||||
optionsPairs $ map (shr2text . unValue *** unValue) l
|
optionsPairs $ map (shr2text . unValue *** unValue) l
|
||||||
|
|
|
@ -1,6 +1,6 @@
|
||||||
{- This file is part of Vervis.
|
{- This file is part of Vervis.
|
||||||
-
|
-
|
||||||
- Written in 2016, 2019 by fr33domlover <fr33domlover@riseup.net>.
|
- Written in 2016, 2019, 2022 by fr33domlover <fr33domlover@riseup.net>.
|
||||||
-
|
-
|
||||||
- ♡ Copying is an act of love. Please copy, reuse and share.
|
- ♡ Copying is an act of love. Please copy, reuse and share.
|
||||||
-
|
-
|
||||||
|
@ -94,15 +94,15 @@ newProjectCollabAForm sid jid = NewProjectCollab
|
||||||
<*> aopt selectRole "Custom role" Nothing
|
<*> aopt selectRole "Custom role" Nothing
|
||||||
where
|
where
|
||||||
selectPerson = selectField $ do
|
selectPerson = selectField $ do
|
||||||
l <- runDB $ select $
|
l <- runDB $ E.select $
|
||||||
from $ \ (collab `RightOuterJoin` person `InnerJoin` sharer) -> do
|
E.from $ \ (person `E.InnerJoin` sharer `E.LeftOuterJoin` (recip `E.InnerJoin` topic)) -> do
|
||||||
on $ person ^. PersonIdent E.==. sharer ^. SharerId
|
E.on $ recip E.^. CollabRecipLocalCollab E.==. topic E.^. CollabTopicLocalProjectCollab E.&&.
|
||||||
on $
|
topic E.^. CollabTopicLocalProjectProject E.==. E.val jid
|
||||||
collab ?. ProjectCollabProject E.==. just (val jid) &&.
|
E.on $ person E.^. PersonId E.==. recip E.^. CollabRecipLocalPerson
|
||||||
collab ?. ProjectCollabPerson E.==. just (person ^. PersonId)
|
E.on $ person E.^. PersonIdent E.==. sharer E.^. SharerId
|
||||||
where_ $ E.isNothing $ collab ?. ProjectCollabId
|
E.where_ $ E.isNothing $ E.just $ recip E.^. CollabRecipLocalId
|
||||||
return (sharer ^. SharerIdent, person ^. PersonId)
|
return (sharer E.^. SharerIdent, person E.^. PersonId)
|
||||||
optionsPairs $ map (bimap (shr2text . unValue) unValue) l
|
optionsPairs $ map (bimap (shr2text . E.unValue) E.unValue) l
|
||||||
selectRole =
|
selectRole =
|
||||||
selectField $
|
selectField $
|
||||||
optionsPersistKey [RoleSharer ==. sid] [] $
|
optionsPersistKey [RoleSharer ==. sid] [] $
|
||||||
|
|
|
@ -1,6 +1,6 @@
|
||||||
{- This file is part of Vervis.
|
{- This file is part of Vervis.
|
||||||
-
|
-
|
||||||
- Written in 2016, 2019 by fr33domlover <fr33domlover@riseup.net>.
|
- Written in 2016, 2019, 2022 by fr33domlover <fr33domlover@riseup.net>.
|
||||||
-
|
-
|
||||||
- ♡ Copying is an act of love. Please copy, reuse and share.
|
- ♡ Copying is an act of love. Please copy, reuse and share.
|
||||||
-
|
-
|
||||||
|
@ -32,8 +32,11 @@ module Vervis.Handler.Project
|
||||||
)
|
)
|
||||||
where
|
where
|
||||||
|
|
||||||
|
import Data.Foldable
|
||||||
import Data.Maybe (fromMaybe)
|
import Data.Maybe (fromMaybe)
|
||||||
import Data.Text (Text)
|
import Data.Text (Text)
|
||||||
|
import Data.Time.Clock
|
||||||
|
import Data.Traversable
|
||||||
import Database.Persist
|
import Database.Persist
|
||||||
import Database.Esqueleto hiding (delete, (%), (==.))
|
import Database.Esqueleto hiding (delete, (%), (==.))
|
||||||
import Text.Blaze.Html (Html)
|
import Text.Blaze.Html (Html)
|
||||||
|
@ -46,10 +49,12 @@ import Yesod.Persist.Core (runDB, get404, getBy404)
|
||||||
|
|
||||||
import qualified Database.Esqueleto as E
|
import qualified Database.Esqueleto as E
|
||||||
|
|
||||||
|
import Database.Persist.JSON
|
||||||
import Network.FedURI
|
import Network.FedURI
|
||||||
import Web.ActivityPub hiding (Project (..), Repo (..))
|
import Web.ActivityPub hiding (Project (..), Repo (..))
|
||||||
import Yesod.ActivityPub
|
import Yesod.ActivityPub
|
||||||
import Yesod.FedURI
|
import Yesod.FedURI
|
||||||
|
import Yesod.MonadSite
|
||||||
|
|
||||||
import qualified Web.ActivityPub as AP
|
import qualified Web.ActivityPub as AP
|
||||||
|
|
||||||
|
@ -85,6 +90,8 @@ postProjectsR shr = do
|
||||||
((result, widget), enctype) <- runFormPost $ newProjectForm sid
|
((result, widget), enctype) <- runFormPost $ newProjectForm sid
|
||||||
case result of
|
case result of
|
||||||
FormSuccess np -> do
|
FormSuccess np -> do
|
||||||
|
now <- liftIO getCurrentTime
|
||||||
|
host <- asksSite siteInstanceHost
|
||||||
pid <- requireAuthId
|
pid <- requireAuthId
|
||||||
runDB $ do
|
runDB $ do
|
||||||
ibid <- insert Inbox
|
ibid <- insert Inbox
|
||||||
|
@ -105,12 +112,18 @@ postProjectsR shr = do
|
||||||
, projectFollowers = fsid
|
, projectFollowers = fsid
|
||||||
}
|
}
|
||||||
jid <- insert project
|
jid <- insert project
|
||||||
let collab = ProjectCollab
|
|
||||||
{ projectCollabProject = jid
|
obiid <-
|
||||||
, projectCollabPerson = pid
|
insert $
|
||||||
, projectCollabRole = npRole np
|
OutboxItem
|
||||||
}
|
obid
|
||||||
insert_ collab
|
(persistJSONObjectFromDoc $ Doc host emptyActivity)
|
||||||
|
now
|
||||||
|
cid <- insert Collab
|
||||||
|
for_ (npRole np) $ \ rlid -> insert_ $ CollabRoleLocal cid rlid
|
||||||
|
insert_ $ CollabTopicLocalProject cid jid
|
||||||
|
insert_ $ CollabSenderLocal cid obiid
|
||||||
|
insert_ $ CollabRecipLocal cid pid
|
||||||
setMessage "Project added."
|
setMessage "Project added."
|
||||||
redirect $ ProjectR shr (npIdent np)
|
redirect $ ProjectR shr (npIdent np)
|
||||||
FormMissing -> do
|
FormMissing -> do
|
||||||
|
@ -212,33 +225,39 @@ getProjectDevsR shr prj = do
|
||||||
Entity sid _ <- getBy404 $ UniqueSharer shr
|
Entity sid _ <- getBy404 $ UniqueSharer shr
|
||||||
Entity jid _ <- getBy404 $ UniqueProject prj sid
|
Entity jid _ <- getBy404 $ UniqueProject prj sid
|
||||||
return jid
|
return jid
|
||||||
select $ from $ \ (collab `InnerJoin`
|
E.select $ E.from $ \ (topic `E.InnerJoin` recip `E.InnerJoin` person `E.InnerJoin` sharer `E.LeftOuterJoin` (crole `E.InnerJoin` role)) -> do
|
||||||
person `InnerJoin`
|
E.on $ crole E.?. CollabRoleLocalRole E.==. role E.?. RoleId
|
||||||
sharer `LeftOuterJoin`
|
E.on $ E.just (recip E.^. CollabRecipLocalCollab) E.==. crole E.?. CollabRoleLocalCollab
|
||||||
role) -> do
|
E.on $ person E.^. PersonIdent E.==. sharer E.^. SharerId
|
||||||
on $ collab ^. ProjectCollabRole E.==. role ?. RoleId
|
E.on $ recip E.^. CollabRecipLocalPerson E.==. person E.^. PersonId
|
||||||
on $ person ^. PersonIdent E.==. sharer ^. SharerId
|
E.on $ topic E.^. CollabTopicLocalProjectCollab E.==. recip E.^. CollabRecipLocalCollab
|
||||||
on $ collab ^. ProjectCollabPerson E.==. person ^. PersonId
|
E.where_ $ topic E.^. CollabTopicLocalProjectProject E.==. E.val jid
|
||||||
where_ $ collab ^. ProjectCollabProject E.==. val jid
|
return (sharer, role E.?. RoleIdent)
|
||||||
return (sharer, role ?. RoleIdent)
|
|
||||||
defaultLayout $(widgetFile "project/collab/list")
|
defaultLayout $(widgetFile "project/collab/list")
|
||||||
|
|
||||||
postProjectDevsR :: ShrIdent -> PrjIdent -> Handler Html
|
postProjectDevsR :: ShrIdent -> PrjIdent -> Handler Html
|
||||||
postProjectDevsR shr rp = do
|
postProjectDevsR shr rp = do
|
||||||
(sid, jid) <- runDB $ do
|
(sid, jid, obid) <- runDB $ do
|
||||||
Entity s _ <- getBy404 $ UniqueSharer shr
|
Entity sid _ <- getBy404 $ UniqueSharer shr
|
||||||
Entity j _ <- getBy404 $ UniqueProject rp s
|
Entity jid j <- getBy404 $ UniqueProject rp sid
|
||||||
return (s, j)
|
return (sid, jid, projectOutbox j)
|
||||||
((result, widget), enctype) <- runFormPost $ newProjectCollabForm sid jid
|
((result, widget), enctype) <- runFormPost $ newProjectCollabForm sid jid
|
||||||
case result of
|
case result of
|
||||||
FormSuccess nc -> do
|
FormSuccess nc -> do
|
||||||
|
now <- liftIO getCurrentTime
|
||||||
|
host <- asksSite siteInstanceHost
|
||||||
runDB $ do
|
runDB $ do
|
||||||
let collab = ProjectCollab
|
obiid <-
|
||||||
{ projectCollabProject = jid
|
insert $
|
||||||
, projectCollabPerson = ncPerson nc
|
OutboxItem
|
||||||
, projectCollabRole = ncRole nc
|
obid
|
||||||
}
|
(persistJSONObjectFromDoc $ Doc host emptyActivity)
|
||||||
insert_ collab
|
now
|
||||||
|
cid <- insert Collab
|
||||||
|
for_ (ncRole nc) $ \ rlid -> insert_ $ CollabRoleLocal cid rlid
|
||||||
|
insert_ $ CollabTopicLocalProject cid jid
|
||||||
|
insert_ $ CollabSenderLocal cid obiid
|
||||||
|
insert_ $ CollabRecipLocal cid (ncPerson nc)
|
||||||
setMessage "Collaborator added."
|
setMessage "Collaborator added."
|
||||||
redirect $ ProjectDevsR shr rp
|
redirect $ ProjectDevsR shr rp
|
||||||
FormMissing -> do
|
FormMissing -> do
|
||||||
|
@ -268,8 +287,20 @@ getProjectDevR shr prj 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 $ UniqueProjectCollab jid pid
|
l <- E.select $ E.from $ \ (topic `E.InnerJoin` recip) -> do
|
||||||
fmap roleIdent <$> traverse getJust (projectCollabRole collab)
|
E.on $ topic E.^. CollabTopicLocalProjectCollab E.==. recip E.^. CollabRecipLocalCollab
|
||||||
|
E.where_ $
|
||||||
|
topic E.^. CollabTopicLocalProjectProject E.==. E.val jid E.&&.
|
||||||
|
recip E.^. CollabRecipLocalPerson E.==. E.val pid
|
||||||
|
return $ recip E.^. CollabRecipLocalCollab
|
||||||
|
cid <-
|
||||||
|
case l of
|
||||||
|
[] -> notFound
|
||||||
|
[E.Value cid] -> return cid
|
||||||
|
_ -> error "Multiple collabs for project+person"
|
||||||
|
mcrole <- getValBy $ UniqueCollabRoleLocal cid
|
||||||
|
for mcrole $
|
||||||
|
\ (CollabRoleLocal _cid rlid) -> roleIdent <$> getJust rlid
|
||||||
defaultLayout $(widgetFile "project/collab/one")
|
defaultLayout $(widgetFile "project/collab/one")
|
||||||
|
|
||||||
deleteProjectDevR :: ShrIdent -> PrjIdent -> ShrIdent -> Handler Html
|
deleteProjectDevR :: ShrIdent -> PrjIdent -> ShrIdent -> Handler Html
|
||||||
|
@ -283,7 +314,26 @@ deleteProjectDevR 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 $ UniqueProjectCollab jid pid
|
collabs <- E.select $ E.from $ \ (recip `E.InnerJoin` topic) -> do
|
||||||
|
E.on $ recip E.^. CollabRecipLocalCollab E.==. topic E.^. CollabTopicLocalProjectCollab
|
||||||
|
E.where_ $
|
||||||
|
recip E.^. CollabRecipLocalPerson E.==. E.val pid E.&&.
|
||||||
|
topic E.^. CollabTopicLocalProjectProject E.==. E.val jid
|
||||||
|
return
|
||||||
|
( recip E.^. CollabRecipLocalId
|
||||||
|
, topic E.^. CollabTopicLocalProjectId
|
||||||
|
, recip E.^. CollabRecipLocalCollab
|
||||||
|
)
|
||||||
|
(E.Value crid, E.Value ctid, E.Value cid) <-
|
||||||
|
case collabs of
|
||||||
|
[] -> notFound
|
||||||
|
[c] -> return c
|
||||||
|
_ -> error "More than 1 collab for project+person"
|
||||||
|
deleteWhere [CollabRoleLocalCollab ==. cid]
|
||||||
|
delete ctid
|
||||||
|
deleteWhere [CollabSenderLocalCollab ==. cid]
|
||||||
|
deleteWhere [CollabSenderRemoteCollab ==. cid]
|
||||||
|
delete crid
|
||||||
delete cid
|
delete cid
|
||||||
setMessage "Collaborator removed."
|
setMessage "Collaborator removed."
|
||||||
redirect $ ProjectDevsR shr rp
|
redirect $ ProjectDevsR shr rp
|
||||||
|
|
|
@ -1,6 +1,7 @@
|
||||||
{- This file is part of Vervis.
|
{- This file is part of Vervis.
|
||||||
-
|
-
|
||||||
- Written in 2016, 2018, 2019, 2020 by fr33domlover <fr33domlover@riseup.net>.
|
- Written in 2016, 2018, 2019, 2020, 2022
|
||||||
|
- by fr33domlover <fr33domlover@riseup.net>.
|
||||||
-
|
-
|
||||||
- ♡ Copying is an act of love. Please copy, reuse and share.
|
- ♡ Copying is an act of love. Please copy, reuse and share.
|
||||||
-
|
-
|
||||||
|
@ -47,6 +48,7 @@ import Control.Monad.IO.Class (liftIO)
|
||||||
import Control.Monad.Logger (logWarn)
|
import Control.Monad.Logger (logWarn)
|
||||||
import Control.Monad.Trans.Except
|
import Control.Monad.Trans.Except
|
||||||
import Data.Bifunctor
|
import Data.Bifunctor
|
||||||
|
import Data.Foldable
|
||||||
import Data.Git.Graph
|
import Data.Git.Graph
|
||||||
import Data.Git.Harder
|
import Data.Git.Harder
|
||||||
import Data.Git.Named (RefName (..))
|
import Data.Git.Named (RefName (..))
|
||||||
|
@ -61,6 +63,7 @@ import Data.List (inits)
|
||||||
import Data.Text (Text, unpack)
|
import Data.Text (Text, unpack)
|
||||||
import Data.Text.Encoding
|
import Data.Text.Encoding
|
||||||
import Data.Text.Encoding.Error (lenientDecode)
|
import Data.Text.Encoding.Error (lenientDecode)
|
||||||
|
import Data.Time.Clock
|
||||||
import Data.Traversable (for)
|
import Data.Traversable (for)
|
||||||
import Database.Persist
|
import Database.Persist
|
||||||
import Database.Persist.Sql
|
import Database.Persist.Sql
|
||||||
|
@ -87,6 +90,7 @@ import qualified Data.Text.Lazy.Encoding as L (decodeUtf8With)
|
||||||
import qualified Database.Esqueleto as E
|
import qualified Database.Esqueleto as E
|
||||||
|
|
||||||
import Data.MediaType
|
import Data.MediaType
|
||||||
|
import Database.Persist.JSON
|
||||||
import Network.FedURI
|
import Network.FedURI
|
||||||
import Web.ActivityPub hiding (Repo (..), Project)
|
import Web.ActivityPub hiding (Repo (..), Project)
|
||||||
import Yesod.ActivityPub
|
import Yesod.ActivityPub
|
||||||
|
@ -143,6 +147,7 @@ postReposR user = do
|
||||||
((result, widget), enctype) <- runFormPost $ newRepoForm sid Nothing
|
((result, widget), enctype) <- runFormPost $ newRepoForm sid Nothing
|
||||||
case result of
|
case result of
|
||||||
FormSuccess nrp -> do
|
FormSuccess nrp -> do
|
||||||
|
now <- liftIO getCurrentTime
|
||||||
parent <- askSharerDir user
|
parent <- askSharerDir user
|
||||||
liftIO $ createDirectoryIfMissing True parent
|
liftIO $ createDirectoryIfMissing True parent
|
||||||
let repoName =
|
let repoName =
|
||||||
|
@ -188,12 +193,18 @@ postReposR user = do
|
||||||
, repoFollowers = fsid
|
, repoFollowers = fsid
|
||||||
}
|
}
|
||||||
rid <- insert repo
|
rid <- insert repo
|
||||||
let collab = RepoCollab
|
|
||||||
{ repoCollabRepo = rid
|
obiid <-
|
||||||
, repoCollabPerson = pid
|
insert $
|
||||||
, repoCollabRole = nrpRole nrp
|
OutboxItem
|
||||||
}
|
obid
|
||||||
insert_ collab
|
(persistJSONObjectFromDoc $ Doc host emptyActivity)
|
||||||
|
now
|
||||||
|
cid <- insert Collab
|
||||||
|
for_ (nrpRole nrp) $ \ rlid -> insert_ $ CollabRoleLocal cid rlid
|
||||||
|
insert_ $ CollabTopicLocalRepo cid rid
|
||||||
|
insert_ $ CollabSenderLocal cid obiid
|
||||||
|
insert_ $ CollabRecipLocal cid pid
|
||||||
setMessage "Repo added."
|
setMessage "Repo added."
|
||||||
redirect $ RepoR user (nrpIdent nrp)
|
redirect $ RepoR user (nrpIdent nrp)
|
||||||
FormMissing -> do
|
FormMissing -> do
|
||||||
|
@ -362,33 +373,39 @@ getRepoDevsR shr rp = do
|
||||||
Entity s _ <- getBy404 $ UniqueSharer shr
|
Entity s _ <- getBy404 $ UniqueSharer shr
|
||||||
Entity r _ <- getBy404 $ UniqueRepo rp s
|
Entity r _ <- getBy404 $ UniqueRepo rp s
|
||||||
return r
|
return r
|
||||||
E.select $ E.from $ \ (collab `E.InnerJoin`
|
E.select $ E.from $ \ (topic `E.InnerJoin` recip `E.InnerJoin` person `E.InnerJoin` sharer `E.LeftOuterJoin` (crole `E.InnerJoin` role)) -> do
|
||||||
person `E.InnerJoin`
|
E.on $ crole E.?. CollabRoleLocalRole E.==. role E.?. RoleId
|
||||||
sharer `E.LeftOuterJoin`
|
E.on $ E.just (recip E.^. CollabRecipLocalCollab) E.==. crole E.?. CollabRoleLocalCollab
|
||||||
role) -> do
|
|
||||||
E.on $ collab E.^. RepoCollabRole E.==. role E.?. RoleId
|
|
||||||
E.on $ person E.^. PersonIdent E.==. sharer E.^. SharerId
|
E.on $ person E.^. PersonIdent E.==. sharer E.^. SharerId
|
||||||
E.on $ collab E.^. RepoCollabPerson E.==. person E.^. PersonId
|
E.on $ recip E.^. CollabRecipLocalPerson E.==. person E.^. PersonId
|
||||||
E.where_ $ collab E.^. RepoCollabRepo E.==. E.val rid
|
E.on $ topic E.^. CollabTopicLocalRepoCollab E.==. recip E.^. CollabRecipLocalCollab
|
||||||
|
E.where_ $ topic E.^. CollabTopicLocalRepoRepo E.==. E.val rid
|
||||||
return (sharer, role E.?. RoleIdent)
|
return (sharer, role E.?. RoleIdent)
|
||||||
defaultLayout $(widgetFile "repo/collab/list")
|
defaultLayout $(widgetFile "repo/collab/list")
|
||||||
|
|
||||||
postRepoDevsR :: ShrIdent -> RpIdent -> Handler Html
|
postRepoDevsR :: ShrIdent -> RpIdent -> Handler Html
|
||||||
postRepoDevsR shr rp = do
|
postRepoDevsR shr rp = do
|
||||||
(sid, mjid, rid) <- runDB $ do
|
(sid, mjid, obid, rid) <- runDB $ do
|
||||||
Entity s _ <- getBy404 $ UniqueSharer shr
|
Entity s _ <- getBy404 $ UniqueSharer shr
|
||||||
Entity r repository <- getBy404 $ UniqueRepo rp s
|
Entity r repository <- getBy404 $ UniqueRepo rp s
|
||||||
return (s, repoProject repository, r)
|
return (s, repoProject repository, repoOutbox repository, r)
|
||||||
((result, widget), enctype) <- runFormPost $ newRepoCollabForm sid mjid rid
|
((result, widget), enctype) <- runFormPost $ newRepoCollabForm sid mjid rid
|
||||||
case result of
|
case result of
|
||||||
FormSuccess nc -> do
|
FormSuccess nc -> do
|
||||||
|
now <- liftIO getCurrentTime
|
||||||
|
host <- asksSite siteInstanceHost
|
||||||
runDB $ do
|
runDB $ do
|
||||||
let collab = RepoCollab
|
obiid <-
|
||||||
{ repoCollabRepo = rid
|
insert $
|
||||||
, repoCollabPerson = ncPerson nc
|
OutboxItem
|
||||||
, repoCollabRole = ncRole nc
|
obid
|
||||||
}
|
(persistJSONObjectFromDoc $ Doc host emptyActivity)
|
||||||
insert_ collab
|
now
|
||||||
|
cid <- insert Collab
|
||||||
|
for_ (ncRole nc) $ \ rlid -> insert_ $ CollabRoleLocal cid rlid
|
||||||
|
insert_ $ CollabTopicLocalRepo cid rid
|
||||||
|
insert_ $ CollabSenderLocal cid obiid
|
||||||
|
insert_ $ CollabRecipLocal cid (ncPerson nc)
|
||||||
setMessage "Collaborator added."
|
setMessage "Collaborator added."
|
||||||
redirect $ RepoDevsR shr rp
|
redirect $ RepoDevsR shr rp
|
||||||
FormMissing -> do
|
FormMissing -> do
|
||||||
|
@ -419,8 +436,20 @@ 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 $ UniqueRepoCollab rid pid
|
l <- E.select $ E.from $ \ (topic `E.InnerJoin` recip) -> do
|
||||||
fmap roleIdent <$> traverse getJust (repoCollabRole collab)
|
E.on $ topic E.^. CollabTopicLocalRepoCollab E.==. recip E.^. CollabRecipLocalCollab
|
||||||
|
E.where_ $
|
||||||
|
topic E.^. CollabTopicLocalRepoRepo E.==. E.val rid E.&&.
|
||||||
|
recip E.^. CollabRecipLocalPerson E.==. E.val pid
|
||||||
|
return $ recip E.^. CollabRecipLocalCollab
|
||||||
|
cid <-
|
||||||
|
case l of
|
||||||
|
[] -> notFound
|
||||||
|
[E.Value cid] -> return cid
|
||||||
|
_ -> error "Multiple collabs for repo+person"
|
||||||
|
mcrole <- getValBy $ UniqueCollabRoleLocal cid
|
||||||
|
for mcrole $
|
||||||
|
\ (CollabRoleLocal _cid rlid) -> roleIdent <$> getJust rlid
|
||||||
defaultLayout $(widgetFile "repo/collab/one")
|
defaultLayout $(widgetFile "repo/collab/one")
|
||||||
|
|
||||||
deleteRepoDevR :: ShrIdent -> RpIdent -> ShrIdent -> Handler Html
|
deleteRepoDevR :: ShrIdent -> RpIdent -> ShrIdent -> Handler Html
|
||||||
|
@ -434,7 +463,26 @@ 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 $ UniqueRepoCollab rid pid
|
collabs <- E.select $ E.from $ \ (recip `E.InnerJoin` topic) -> do
|
||||||
|
E.on $ recip E.^. CollabRecipLocalCollab E.==. topic E.^. CollabTopicLocalRepoCollab
|
||||||
|
E.where_ $
|
||||||
|
recip E.^. CollabRecipLocalPerson E.==. E.val pid E.&&.
|
||||||
|
topic E.^. CollabTopicLocalRepoRepo E.==. E.val rid
|
||||||
|
return
|
||||||
|
( recip E.^. CollabRecipLocalId
|
||||||
|
, topic E.^. CollabTopicLocalRepoId
|
||||||
|
, recip E.^. CollabRecipLocalCollab
|
||||||
|
)
|
||||||
|
(E.Value crid, E.Value ctid, E.Value cid) <-
|
||||||
|
case collabs of
|
||||||
|
[] -> notFound
|
||||||
|
[c] -> return c
|
||||||
|
_ -> error "More than 1 collab for repo+person"
|
||||||
|
deleteWhere [CollabRoleLocalCollab ==. cid]
|
||||||
|
delete ctid
|
||||||
|
deleteWhere [CollabSenderLocalCollab ==. cid]
|
||||||
|
deleteWhere [CollabSenderRemoteCollab ==. cid]
|
||||||
|
delete crid
|
||||||
delete cid
|
delete cid
|
||||||
setMessage "Collaborator removed."
|
setMessage "Collaborator removed."
|
||||||
redirect $ RepoDevsR shr rp
|
redirect $ RepoDevsR shr rp
|
||||||
|
|
|
@ -1,6 +1,7 @@
|
||||||
{- This file is part of Vervis.
|
{- This file is part of Vervis.
|
||||||
-
|
-
|
||||||
- Written in 2016, 2018, 2019, 2020 by fr33domlover <fr33domlover@riseup.net>.
|
- Written in 2016, 2018, 2019, 2020, 2021, 2022
|
||||||
|
- by fr33domlover <fr33domlover@riseup.net>.
|
||||||
-
|
-
|
||||||
- ♡ Copying is an act of love. Please copy, reuse and share.
|
- ♡ Copying is an act of love. Please copy, reuse and share.
|
||||||
-
|
-
|
||||||
|
@ -1785,6 +1786,43 @@ changes hLocal ctx =
|
||||||
update rid [Repo282Vcs =. vcs]
|
update rid [Repo282Vcs =. vcs]
|
||||||
-- 283
|
-- 283
|
||||||
, addFieldPrimRequired "Patch" ("???" :: Text) "type"
|
, addFieldPrimRequired "Patch" ("???" :: Text) "type"
|
||||||
|
-- 284
|
||||||
|
, addEntities model_2022_06_14
|
||||||
|
-- 285
|
||||||
|
, unchecked $ lift $ do
|
||||||
|
rcs <- selectList ([] :: [Filter RepoCollab285]) []
|
||||||
|
for_ rcs $ \ (Entity _ (RepoCollab285 rid pid mrlid)) -> do
|
||||||
|
cid <- insert Collab285
|
||||||
|
for_ mrlid $ \ rlid -> insert_ $ CollabRoleLocal285 cid rlid
|
||||||
|
insert_ $ CollabTopicLocalRepo285 cid rid
|
||||||
|
obiid <- do
|
||||||
|
r <- getJust rid
|
||||||
|
insert $
|
||||||
|
OutboxItem285
|
||||||
|
(repo285Outbox r)
|
||||||
|
(persistJSONObjectFromDoc $ Doc hLocal emptyActivity)
|
||||||
|
defaultTime
|
||||||
|
insert_ $ CollabSenderLocal285 cid obiid
|
||||||
|
insert_ $ CollabRecipLocal285 cid pid
|
||||||
|
|
||||||
|
jcs <- selectList ([] :: [Filter ProjectCollab285]) []
|
||||||
|
for_ jcs $ \ (Entity _ (ProjectCollab285 jid pid mrlid)) -> do
|
||||||
|
cid <- insert Collab285
|
||||||
|
for_ mrlid $ \ rlid -> insert_ $ CollabRoleLocal285 cid rlid
|
||||||
|
insert_ $ CollabTopicLocalProject285 cid jid
|
||||||
|
obiid <- do
|
||||||
|
j <- getJust jid
|
||||||
|
insert $
|
||||||
|
OutboxItem285
|
||||||
|
(project285Outbox j)
|
||||||
|
(persistJSONObjectFromDoc $ Doc hLocal emptyActivity)
|
||||||
|
defaultTime
|
||||||
|
insert_ $ CollabSenderLocal285 cid obiid
|
||||||
|
insert_ $ CollabRecipLocal285 cid pid
|
||||||
|
-- 286
|
||||||
|
, removeEntity "RepoCollab"
|
||||||
|
-- 287
|
||||||
|
, removeEntity "ProjectCollab"
|
||||||
]
|
]
|
||||||
|
|
||||||
migrateDB
|
migrateDB
|
||||||
|
|
|
@ -1,6 +1,6 @@
|
||||||
{- This file is part of Vervis.
|
{- This file is part of Vervis.
|
||||||
-
|
-
|
||||||
- Written in 2018, 2019, 2020 by fr33domlover <fr33domlover@riseup.net>.
|
- Written in 2018, 2019, 2020, 2022 by fr33domlover <fr33domlover@riseup.net>.
|
||||||
-
|
-
|
||||||
- ♡ Copying is an act of love. Please copy, reuse and share.
|
- ♡ Copying is an act of love. Please copy, reuse and share.
|
||||||
-
|
-
|
||||||
|
@ -245,6 +245,20 @@ module Vervis.Migration.Model
|
||||||
, Patch280Generic (..)
|
, Patch280Generic (..)
|
||||||
, Repo282
|
, Repo282
|
||||||
, Repo282Generic (..)
|
, Repo282Generic (..)
|
||||||
|
, model_2022_06_14
|
||||||
|
, Collab285Generic (..)
|
||||||
|
, CollabRecipLocal285Generic (..)
|
||||||
|
, CollabRoleLocal285Generic (..)
|
||||||
|
, CollabSenderLocal285Generic (..)
|
||||||
|
, CollabTopicLocalProject285Generic (..)
|
||||||
|
, CollabTopicLocalRepo285Generic (..)
|
||||||
|
, OutboxItem285Generic (..)
|
||||||
|
, Project285Generic (..)
|
||||||
|
, ProjectCollab285
|
||||||
|
, ProjectCollab285Generic (..)
|
||||||
|
, Repo285Generic (..)
|
||||||
|
, RepoCollab285
|
||||||
|
, RepoCollab285Generic (..)
|
||||||
)
|
)
|
||||||
where
|
where
|
||||||
|
|
||||||
|
@ -481,3 +495,9 @@ makeEntitiesMigration "280"
|
||||||
|
|
||||||
makeEntitiesMigration "282"
|
makeEntitiesMigration "282"
|
||||||
$(modelFile "migrations/2020_08_13_vcs.model")
|
$(modelFile "migrations/2020_08_13_vcs.model")
|
||||||
|
|
||||||
|
model_2022_06_14 :: [Entity SqlBackend]
|
||||||
|
model_2022_06_14 = $(schema "2022_06_14_collab")
|
||||||
|
|
||||||
|
makeEntitiesMigration "285"
|
||||||
|
$(modelFile "migrations/2022_06_14_collab_mig.model")
|
||||||
|
|
|
@ -445,7 +445,7 @@ test-suite test
|
||||||
TupleSections
|
TupleSections
|
||||||
build-depends: base
|
build-depends: base
|
||||||
, vervis
|
, vervis
|
||||||
, yesod-test >= 1.5.0.1 && < 1.6
|
, yesod-test
|
||||||
, yesod-core
|
, yesod-core
|
||||||
, yesod
|
, yesod
|
||||||
, persistent
|
, persistent
|
||||||
|
|
Loading…
Reference in a new issue