DB: Switch to more flexible collaborator model
This commit is contained in:
fr33domlover
parent
bf2e172f6e
commit
bfa9774f83
13 changed files with 504 additions and 118 deletions
|
|
@ -1,6 +1,7 @@
|
|||
-- 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.
|
||||
--
|
||||
|
|
@ -572,16 +573,67 @@ RemoteMessage
|
|||
UniqueRemoteMessage rest
|
||||
UniqueRemoteMessageCreate create
|
||||
|
||||
RepoCollab
|
||||
|
||||
------------------------------------------------------------------------------
|
||||
-- Collaborators
|
||||
------------------------------------------------------------------------------
|
||||
|
||||
Collab
|
||||
|
||||
-------------------------------- Collab topic --------------------------------
|
||||
|
||||
CollabRoleLocal
|
||||
collab CollabId
|
||||
role RoleId
|
||||
|
||||
UniqueCollabRoleLocal collab
|
||||
|
||||
CollabTopicLocalRepo
|
||||
collab CollabId
|
||||
repo RepoId
|
||||
person PersonId
|
||||
role RoleId Maybe
|
||||
|
||||
UniqueRepoCollab repo person
|
||||
UniqueCollabTopicLocalRepo collab
|
||||
|
||||
ProjectCollab
|
||||
CollabTopicLocalProject
|
||||
collab CollabId
|
||||
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.
|
||||
-
|
||||
- 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.
|
||||
-
|
||||
|
|
@ -63,11 +63,13 @@ import Control.Applicative ((<|>))
|
|||
import Control.Monad.IO.Class
|
||||
import Control.Monad.Trans.Maybe
|
||||
import Control.Monad.Trans.Reader
|
||||
import Data.Maybe (fromMaybe, isJust)
|
||||
import Data.Maybe
|
||||
import Database.Persist.Class (getBy)
|
||||
import Database.Persist.Sql (SqlBackend)
|
||||
import Database.Persist.Types (Entity (..))
|
||||
|
||||
import qualified Database.Esqueleto as E
|
||||
|
||||
import Vervis.Model
|
||||
import Vervis.Model.Ident
|
||||
import Vervis.Model.Role
|
||||
|
|
@ -132,9 +134,19 @@ checkRepoAccess mpid op shr rp = do
|
|||
Nothing -> pure $ fromMaybe Guest $ asAnon repo
|
||||
status <$> roleHasAccess role op
|
||||
where
|
||||
asCollab rid pid =
|
||||
fmap (maybe Developer RoleID . repoCollabRole . entityVal) <$>
|
||||
getBy (UniqueRepoCollab rid pid)
|
||||
asCollab rid pid = do
|
||||
fmap (maybe Developer RoleID . E.unValue . snd) . listToMaybe <$> do
|
||||
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
|
||||
asAnon = fmap RoleID . repoCollabAnon
|
||||
|
||||
|
|
@ -160,8 +172,18 @@ checkProjectAccess mpid op shr prj = do
|
|||
Nothing -> pure $ fromMaybe Guest $ asAnon project
|
||||
status <$> roleHasAccess role op
|
||||
where
|
||||
asCollab jid pid =
|
||||
fmap (maybe Developer RoleID . projectCollabRole . entityVal) <$>
|
||||
getBy (UniqueProjectCollab jid pid)
|
||||
asCollab jid pid = do
|
||||
fmap (maybe Developer RoleID . E.unValue . snd) . listToMaybe <$> do
|
||||
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
|
||||
asAnon = fmap RoleID . projectCollabAnon
|
||||
|
|
|
|||
|
|
@ -1,6 +1,6 @@
|
|||
{- 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.
|
||||
-
|
||||
|
|
@ -1124,7 +1124,10 @@ insertActivityToLocalInboxes makeInboxItem requireOwner mauthor mibidAuthor reci
|
|||
(localRecipProjectTeam d || any (localRecipTicketTeam . snd) ts)
|
||||
]
|
||||
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]
|
||||
getRepoTeams sid repos = do
|
||||
let rps =
|
||||
|
|
@ -1134,7 +1137,10 @@ insertActivityToLocalInboxes makeInboxItem requireOwner mauthor mibidAuthor reci
|
|||
(localRecipRepo d || not requireOwner || isAuthor (LocalActorRepo shr rp))
|
||||
]
|
||||
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]
|
||||
|
||||
-- | Given a list of local recipients, which may include actors and
|
||||
|
|
|
|||
|
|
@ -1,6 +1,6 @@
|
|||
{- 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.
|
||||
-
|
||||
|
|
@ -72,12 +72,11 @@ mkIdentField sid = checkIdentUnique sid . checkIdentTemplate $ textField
|
|||
selectCollabFromAll :: RepoId -> Field Handler PersonId
|
||||
selectCollabFromAll rid = selectField $ do
|
||||
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 $
|
||||
collab ?. RepoCollabRepo ==. just (val rid) &&.
|
||||
collab ?. RepoCollabPerson ==. just (person ^. PersonId)
|
||||
where_ $ isNothing $ collab ?. RepoCollabId
|
||||
where_ $ isNothing $ just $ recip ^. CollabRecipLocalId
|
||||
return (sharer ^. SharerIdent, person ^. PersonId)
|
||||
optionsPairs $ map (bimap (shr2text . unValue) unValue) l
|
||||
|
||||
|
|
@ -87,19 +86,15 @@ selectCollabFromAll rid = selectField $ do
|
|||
selectCollabFromProject :: ProjectId -> RepoId -> Field Handler PersonId
|
||||
selectCollabFromProject jid rid = selectField $ do
|
||||
l <- runDB $ select $ from $
|
||||
\ ( pcollab `InnerJoin`
|
||||
person `LeftOuterJoin`
|
||||
rcollab `InnerJoin`
|
||||
sharer
|
||||
) -> do
|
||||
\ (topic `InnerJoin` recip `InnerJoin` person `InnerJoin` sharer `LeftOuterJoin` (recipR `InnerJoin` topicR)) -> do
|
||||
on $ recipR ^. CollabRecipLocalCollab ==. topicR ^. CollabTopicLocalRepoCollab &&.
|
||||
topicR ^. CollabTopicLocalRepoRepo ==. val rid
|
||||
on $ person ^. PersonId ==. recipR ^. CollabRecipLocalPerson
|
||||
on $ person ^. PersonIdent ==. sharer ^. SharerId
|
||||
on $
|
||||
rcollab ?. RepoCollabRepo ==. just (val rid) &&.
|
||||
rcollab ?. RepoCollabPerson ==. just (person ^. PersonId)
|
||||
on $
|
||||
pcollab ^. ProjectCollabProject ==. val jid &&.
|
||||
pcollab ^. ProjectCollabPerson ==. person ^. PersonId
|
||||
where_ $ isNothing $ rcollab ?. RepoCollabId
|
||||
on $ recip ^. CollabRecipLocalPerson ==. person ^. PersonId
|
||||
on $ topic ^. CollabTopicLocalProjectCollab ==. recip ^. CollabRecipLocalCollab &&.
|
||||
topic ^. CollabTopicLocalProjectProject ==. val jid
|
||||
where_ $ isNothing $ just $ recipR ^. CollabRecipLocalId
|
||||
return (sharer ^. SharerIdent, person ^. PersonId)
|
||||
optionsPairs $ map (bimap (shr2text . unValue) unValue) l
|
||||
|
||||
|
|
@ -126,12 +121,13 @@ selectProjectForExisting :: SharerId -> RepoId -> Field Handler ProjectId
|
|||
selectProjectForExisting sid rid = checkMembers $ selectProjectForNew sid
|
||||
where
|
||||
checkMembers = checkM $ \ jid -> do
|
||||
l <- runDB $ select $ from $ \ (rc `LeftOuterJoin` pc) -> do
|
||||
on $
|
||||
rc ^. RepoCollabRepo ==. val rid &&.
|
||||
pc ?. ProjectCollabProject ==. just (val jid) &&.
|
||||
pc ?. ProjectCollabPerson ==. just (rc ^. RepoCollabPerson)
|
||||
where_ $ isNothing $ pc ?. ProjectCollabId
|
||||
l <- runDB $ select $ from $ \ (recipR `InnerJoin` topicR `LeftOuterJoin` (recipJ `InnerJoin` topicJ)) -> do
|
||||
on $ topicJ ^. CollabTopicLocalProjectProject ==. val jid &&.
|
||||
recipJ ^. CollabRecipLocalCollab ==. topicJ ^. CollabTopicLocalProjectCollab
|
||||
on $ recipR ^. CollabRecipLocalPerson ==. recipJ ^. CollabRecipLocalPerson
|
||||
on $ topicR ^. CollabTopicLocalRepoRepo ==. val rid &&.
|
||||
recipR ^. CollabRecipLocalCollab ==. topicR ^. CollabTopicLocalRepoCollab
|
||||
where_ $ isNothing $ just $ recipJ ^. CollabRecipLocalId
|
||||
limit 1
|
||||
return ()
|
||||
return $ if null l
|
||||
|
|
|
|||
|
|
@ -1,6 +1,6 @@
|
|||
{- 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.
|
||||
-
|
||||
|
|
@ -43,11 +43,12 @@ import Vervis.Model.Ident (shr2text)
|
|||
selectAssigneeFromProject :: PersonId -> ProjectId -> Field Handler PersonId
|
||||
selectAssigneeFromProject pid jid = selectField $ do
|
||||
l <- runDB $ select $ from $
|
||||
\ (pcollab `InnerJoin` person `InnerJoin` sharer) -> do
|
||||
\ (topic `InnerJoin` recip `InnerJoin` person `InnerJoin` sharer) -> do
|
||||
on $ person ^. PersonIdent ==. sharer ^. SharerId
|
||||
on $ pcollab ^. ProjectCollabPerson ==. person ^. PersonId
|
||||
on $ recip ^. CollabRecipLocalPerson ==. person ^. PersonId
|
||||
on $ topic ^. CollabTopicLocalProjectCollab ==. recip ^. CollabRecipLocalCollab
|
||||
where_ $
|
||||
pcollab ^. ProjectCollabProject ==. val jid &&.
|
||||
topic ^. CollabTopicLocalProjectProject ==. val jid &&.
|
||||
person ^. PersonId !=. val pid
|
||||
return (sharer ^. SharerIdent, person ^. PersonId)
|
||||
optionsPairs $ map (shr2text . unValue *** unValue) l
|
||||
|
|
|
|||
|
|
@ -1,6 +1,6 @@
|
|||
{- 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.
|
||||
-
|
||||
|
|
@ -94,15 +94,15 @@ newProjectCollabAForm sid jid = NewProjectCollab
|
|||
<*> aopt selectRole "Custom role" Nothing
|
||||
where
|
||||
selectPerson = selectField $ do
|
||||
l <- runDB $ select $
|
||||
from $ \ (collab `RightOuterJoin` person `InnerJoin` sharer) -> do
|
||||
on $ person ^. PersonIdent E.==. sharer ^. SharerId
|
||||
on $
|
||||
collab ?. ProjectCollabProject E.==. just (val jid) &&.
|
||||
collab ?. ProjectCollabPerson E.==. just (person ^. PersonId)
|
||||
where_ $ E.isNothing $ collab ?. ProjectCollabId
|
||||
return (sharer ^. SharerIdent, person ^. PersonId)
|
||||
optionsPairs $ map (bimap (shr2text . unValue) unValue) l
|
||||
l <- runDB $ E.select $
|
||||
E.from $ \ (person `E.InnerJoin` sharer `E.LeftOuterJoin` (recip `E.InnerJoin` topic)) -> do
|
||||
E.on $ recip E.^. CollabRecipLocalCollab E.==. topic E.^. CollabTopicLocalProjectCollab E.&&.
|
||||
topic E.^. CollabTopicLocalProjectProject E.==. E.val jid
|
||||
E.on $ person E.^. PersonId E.==. recip E.^. CollabRecipLocalPerson
|
||||
E.on $ person E.^. PersonIdent E.==. sharer E.^. SharerId
|
||||
E.where_ $ E.isNothing $ E.just $ recip E.^. CollabRecipLocalId
|
||||
return (sharer E.^. SharerIdent, person E.^. PersonId)
|
||||
optionsPairs $ map (bimap (shr2text . E.unValue) E.unValue) l
|
||||
selectRole =
|
||||
selectField $
|
||||
optionsPersistKey [RoleSharer ==. sid] [] $
|
||||
|
|
|
|||
|
|
@ -1,6 +1,6 @@
|
|||
{- 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.
|
||||
-
|
||||
|
|
@ -32,8 +32,11 @@ module Vervis.Handler.Project
|
|||
)
|
||||
where
|
||||
|
||||
import Data.Foldable
|
||||
import Data.Maybe (fromMaybe)
|
||||
import Data.Text (Text)
|
||||
import Data.Time.Clock
|
||||
import Data.Traversable
|
||||
import Database.Persist
|
||||
import Database.Esqueleto hiding (delete, (%), (==.))
|
||||
import Text.Blaze.Html (Html)
|
||||
|
|
@ -46,10 +49,12 @@ import Yesod.Persist.Core (runDB, get404, getBy404)
|
|||
|
||||
import qualified Database.Esqueleto as E
|
||||
|
||||
import Database.Persist.JSON
|
||||
import Network.FedURI
|
||||
import Web.ActivityPub hiding (Project (..), Repo (..))
|
||||
import Yesod.ActivityPub
|
||||
import Yesod.FedURI
|
||||
import Yesod.MonadSite
|
||||
|
||||
import qualified Web.ActivityPub as AP
|
||||
|
||||
|
|
@ -85,6 +90,8 @@ postProjectsR shr = do
|
|||
((result, widget), enctype) <- runFormPost $ newProjectForm sid
|
||||
case result of
|
||||
FormSuccess np -> do
|
||||
now <- liftIO getCurrentTime
|
||||
host <- asksSite siteInstanceHost
|
||||
pid <- requireAuthId
|
||||
runDB $ do
|
||||
ibid <- insert Inbox
|
||||
|
|
@ -105,12 +112,18 @@ postProjectsR shr = do
|
|||
, projectFollowers = fsid
|
||||
}
|
||||
jid <- insert project
|
||||
let collab = ProjectCollab
|
||||
{ projectCollabProject = jid
|
||||
, projectCollabPerson = pid
|
||||
, projectCollabRole = npRole np
|
||||
}
|
||||
insert_ collab
|
||||
|
||||
obiid <-
|
||||
insert $
|
||||
OutboxItem
|
||||
obid
|
||||
(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."
|
||||
redirect $ ProjectR shr (npIdent np)
|
||||
FormMissing -> do
|
||||
|
|
@ -212,33 +225,39 @@ getProjectDevsR shr prj = do
|
|||
Entity sid _ <- getBy404 $ UniqueSharer shr
|
||||
Entity jid _ <- getBy404 $ UniqueProject prj sid
|
||||
return jid
|
||||
select $ from $ \ (collab `InnerJoin`
|
||||
person `InnerJoin`
|
||||
sharer `LeftOuterJoin`
|
||||
role) -> do
|
||||
on $ collab ^. ProjectCollabRole E.==. role ?. RoleId
|
||||
on $ person ^. PersonIdent E.==. sharer ^. SharerId
|
||||
on $ collab ^. ProjectCollabPerson E.==. person ^. PersonId
|
||||
where_ $ collab ^. ProjectCollabProject E.==. val jid
|
||||
return (sharer, role ?. RoleIdent)
|
||||
E.select $ E.from $ \ (topic `E.InnerJoin` recip `E.InnerJoin` person `E.InnerJoin` sharer `E.LeftOuterJoin` (crole `E.InnerJoin` role)) -> do
|
||||
E.on $ crole E.?. CollabRoleLocalRole E.==. role E.?. RoleId
|
||||
E.on $ E.just (recip E.^. CollabRecipLocalCollab) E.==. crole E.?. CollabRoleLocalCollab
|
||||
E.on $ person E.^. PersonIdent E.==. sharer E.^. SharerId
|
||||
E.on $ recip E.^. CollabRecipLocalPerson E.==. person E.^. PersonId
|
||||
E.on $ topic E.^. CollabTopicLocalProjectCollab E.==. recip E.^. CollabRecipLocalCollab
|
||||
E.where_ $ topic E.^. CollabTopicLocalProjectProject E.==. E.val jid
|
||||
return (sharer, role E.?. RoleIdent)
|
||||
defaultLayout $(widgetFile "project/collab/list")
|
||||
|
||||
postProjectDevsR :: ShrIdent -> PrjIdent -> Handler Html
|
||||
postProjectDevsR shr rp = do
|
||||
(sid, jid) <- runDB $ do
|
||||
Entity s _ <- getBy404 $ UniqueSharer shr
|
||||
Entity j _ <- getBy404 $ UniqueProject rp s
|
||||
return (s, j)
|
||||
(sid, jid, obid) <- runDB $ do
|
||||
Entity sid _ <- getBy404 $ UniqueSharer shr
|
||||
Entity jid j <- getBy404 $ UniqueProject rp sid
|
||||
return (sid, jid, projectOutbox j)
|
||||
((result, widget), enctype) <- runFormPost $ newProjectCollabForm sid jid
|
||||
case result of
|
||||
FormSuccess nc -> do
|
||||
now <- liftIO getCurrentTime
|
||||
host <- asksSite siteInstanceHost
|
||||
runDB $ do
|
||||
let collab = ProjectCollab
|
||||
{ projectCollabProject = jid
|
||||
, projectCollabPerson = ncPerson nc
|
||||
, projectCollabRole = ncRole nc
|
||||
}
|
||||
insert_ collab
|
||||
obiid <-
|
||||
insert $
|
||||
OutboxItem
|
||||
obid
|
||||
(persistJSONObjectFromDoc $ Doc host emptyActivity)
|
||||
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."
|
||||
redirect $ ProjectDevsR shr rp
|
||||
FormMissing -> do
|
||||
|
|
@ -268,8 +287,20 @@ getProjectDevR shr prj dev = do
|
|||
Entity s _ <- getBy404 $ UniqueSharer dev
|
||||
Entity p _ <- getBy404 $ UniquePersonIdent s
|
||||
return p
|
||||
Entity _cid collab <- getBy404 $ UniqueProjectCollab jid pid
|
||||
fmap roleIdent <$> traverse getJust (projectCollabRole collab)
|
||||
l <- E.select $ E.from $ \ (topic `E.InnerJoin` recip) -> do
|
||||
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")
|
||||
|
||||
deleteProjectDevR :: ShrIdent -> PrjIdent -> ShrIdent -> Handler Html
|
||||
|
|
@ -283,7 +314,26 @@ deleteProjectDevR shr rp dev = do
|
|||
Entity s _ <- getBy404 $ UniqueSharer dev
|
||||
Entity p _ <- getBy404 $ UniquePersonIdent s
|
||||
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
|
||||
setMessage "Collaborator removed."
|
||||
redirect $ ProjectDevsR shr rp
|
||||
|
|
|
|||
|
|
@ -1,6 +1,7 @@
|
|||
{- 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.
|
||||
-
|
||||
|
|
@ -47,6 +48,7 @@ import Control.Monad.IO.Class (liftIO)
|
|||
import Control.Monad.Logger (logWarn)
|
||||
import Control.Monad.Trans.Except
|
||||
import Data.Bifunctor
|
||||
import Data.Foldable
|
||||
import Data.Git.Graph
|
||||
import Data.Git.Harder
|
||||
import Data.Git.Named (RefName (..))
|
||||
|
|
@ -61,6 +63,7 @@ import Data.List (inits)
|
|||
import Data.Text (Text, unpack)
|
||||
import Data.Text.Encoding
|
||||
import Data.Text.Encoding.Error (lenientDecode)
|
||||
import Data.Time.Clock
|
||||
import Data.Traversable (for)
|
||||
import Database.Persist
|
||||
import Database.Persist.Sql
|
||||
|
|
@ -87,6 +90,7 @@ import qualified Data.Text.Lazy.Encoding as L (decodeUtf8With)
|
|||
import qualified Database.Esqueleto as E
|
||||
|
||||
import Data.MediaType
|
||||
import Database.Persist.JSON
|
||||
import Network.FedURI
|
||||
import Web.ActivityPub hiding (Repo (..), Project)
|
||||
import Yesod.ActivityPub
|
||||
|
|
@ -143,6 +147,7 @@ postReposR user = do
|
|||
((result, widget), enctype) <- runFormPost $ newRepoForm sid Nothing
|
||||
case result of
|
||||
FormSuccess nrp -> do
|
||||
now <- liftIO getCurrentTime
|
||||
parent <- askSharerDir user
|
||||
liftIO $ createDirectoryIfMissing True parent
|
||||
let repoName =
|
||||
|
|
@ -188,12 +193,18 @@ postReposR user = do
|
|||
, repoFollowers = fsid
|
||||
}
|
||||
rid <- insert repo
|
||||
let collab = RepoCollab
|
||||
{ repoCollabRepo = rid
|
||||
, repoCollabPerson = pid
|
||||
, repoCollabRole = nrpRole nrp
|
||||
}
|
||||
insert_ collab
|
||||
|
||||
obiid <-
|
||||
insert $
|
||||
OutboxItem
|
||||
obid
|
||||
(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."
|
||||
redirect $ RepoR user (nrpIdent nrp)
|
||||
FormMissing -> do
|
||||
|
|
@ -362,33 +373,39 @@ getRepoDevsR shr rp = do
|
|||
Entity s _ <- getBy404 $ UniqueSharer shr
|
||||
Entity r _ <- getBy404 $ UniqueRepo rp s
|
||||
return r
|
||||
E.select $ E.from $ \ (collab `E.InnerJoin`
|
||||
person `E.InnerJoin`
|
||||
sharer `E.LeftOuterJoin`
|
||||
role) -> do
|
||||
E.on $ collab E.^. RepoCollabRole E.==. role E.?. RoleId
|
||||
E.select $ E.from $ \ (topic `E.InnerJoin` recip `E.InnerJoin` person `E.InnerJoin` sharer `E.LeftOuterJoin` (crole `E.InnerJoin` role)) -> do
|
||||
E.on $ crole E.?. CollabRoleLocalRole E.==. role E.?. RoleId
|
||||
E.on $ E.just (recip E.^. CollabRecipLocalCollab) E.==. crole E.?. CollabRoleLocalCollab
|
||||
E.on $ person E.^. PersonIdent E.==. sharer E.^. SharerId
|
||||
E.on $ collab E.^. RepoCollabPerson E.==. person E.^. PersonId
|
||||
E.where_ $ collab E.^. RepoCollabRepo E.==. E.val rid
|
||||
E.on $ recip E.^. CollabRecipLocalPerson E.==. person E.^. PersonId
|
||||
E.on $ topic E.^. CollabTopicLocalRepoCollab E.==. recip E.^. CollabRecipLocalCollab
|
||||
E.where_ $ topic E.^. CollabTopicLocalRepoRepo E.==. E.val rid
|
||||
return (sharer, role E.?. RoleIdent)
|
||||
defaultLayout $(widgetFile "repo/collab/list")
|
||||
|
||||
postRepoDevsR :: ShrIdent -> RpIdent -> Handler Html
|
||||
postRepoDevsR shr rp = do
|
||||
(sid, mjid, rid) <- runDB $ do
|
||||
(sid, mjid, obid, rid) <- runDB $ do
|
||||
Entity s _ <- getBy404 $ UniqueSharer shr
|
||||
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
|
||||
case result of
|
||||
FormSuccess nc -> do
|
||||
now <- liftIO getCurrentTime
|
||||
host <- asksSite siteInstanceHost
|
||||
runDB $ do
|
||||
let collab = RepoCollab
|
||||
{ repoCollabRepo = rid
|
||||
, repoCollabPerson = ncPerson nc
|
||||
, repoCollabRole = ncRole nc
|
||||
}
|
||||
insert_ collab
|
||||
obiid <-
|
||||
insert $
|
||||
OutboxItem
|
||||
obid
|
||||
(persistJSONObjectFromDoc $ Doc host emptyActivity)
|
||||
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."
|
||||
redirect $ RepoDevsR shr rp
|
||||
FormMissing -> do
|
||||
|
|
@ -419,8 +436,20 @@ getRepoDevR shr rp dev = do
|
|||
Entity s _ <- getBy404 $ UniqueSharer dev
|
||||
Entity p _ <- getBy404 $ UniquePersonIdent s
|
||||
return p
|
||||
Entity _cid collab <- getBy404 $ UniqueRepoCollab rid pid
|
||||
fmap roleIdent <$> traverse getJust (repoCollabRole collab)
|
||||
l <- E.select $ E.from $ \ (topic `E.InnerJoin` recip) -> do
|
||||
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")
|
||||
|
||||
deleteRepoDevR :: ShrIdent -> RpIdent -> ShrIdent -> Handler Html
|
||||
|
|
@ -434,7 +463,26 @@ deleteRepoDevR shr rp dev = do
|
|||
Entity s _ <- getBy404 $ UniqueSharer dev
|
||||
Entity p _ <- getBy404 $ UniquePersonIdent s
|
||||
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
|
||||
setMessage "Collaborator removed."
|
||||
redirect $ RepoDevsR shr rp
|
||||
|
|
|
|||
|
|
@ -1,6 +1,7 @@
|
|||
{- 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.
|
||||
-
|
||||
|
|
@ -1785,6 +1786,43 @@ changes hLocal ctx =
|
|||
update rid [Repo282Vcs =. vcs]
|
||||
-- 283
|
||||
, 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
|
||||
|
|
|
|||
|
|
@ -1,6 +1,6 @@
|
|||
{- 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.
|
||||
-
|
||||
|
|
@ -245,6 +245,20 @@ module Vervis.Migration.Model
|
|||
, Patch280Generic (..)
|
||||
, Repo282
|
||||
, Repo282Generic (..)
|
||||
, model_2022_06_14
|
||||
, Collab285Generic (..)
|
||||
, CollabRecipLocal285Generic (..)
|
||||
, CollabRoleLocal285Generic (..)
|
||||
, CollabSenderLocal285Generic (..)
|
||||
, CollabTopicLocalProject285Generic (..)
|
||||
, CollabTopicLocalRepo285Generic (..)
|
||||
, OutboxItem285Generic (..)
|
||||
, Project285Generic (..)
|
||||
, ProjectCollab285
|
||||
, ProjectCollab285Generic (..)
|
||||
, Repo285Generic (..)
|
||||
, RepoCollab285
|
||||
, RepoCollab285Generic (..)
|
||||
)
|
||||
where
|
||||
|
||||
|
|
@ -481,3 +495,9 @@ makeEntitiesMigration "280"
|
|||
|
||||
makeEntitiesMigration "282"
|
||||
$(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
|
||||
build-depends: base
|
||||
, vervis
|
||||
, yesod-test >= 1.5.0.1 && < 1.6
|
||||
, yesod-test
|
||||
, yesod-core
|
||||
, yesod
|
||||
, persistent
|
||||
|
|
|
|||
Loading…
Reference in a new issue