DB: Move project inbox, outbox & followers into a new Actor table
This commit is contained in:
fr33domlover
parent
86b35e9b56
commit
88b8027572
19 changed files with 272 additions and 124 deletions
|
|
@ -32,6 +32,18 @@ RemoteObject
|
|||
-- People
|
||||
-------------------------------------------------------------------------------
|
||||
|
||||
Actor
|
||||
name Text
|
||||
desc Text
|
||||
createdAt UTCTime
|
||||
inbox InboxId
|
||||
outbox OutboxId
|
||||
followers FollowerSetId
|
||||
|
||||
UniqueActorInbox inbox
|
||||
UniqueActorOutbox outbox
|
||||
UniqueActorFollowers followers
|
||||
|
||||
Sharer
|
||||
ident ShrIdent
|
||||
name Text Maybe
|
||||
|
|
@ -265,6 +277,7 @@ RoleAccess
|
|||
-------------------------------------------------------------------------------
|
||||
|
||||
Project
|
||||
actor ActorId
|
||||
ident PrjIdent
|
||||
sharer SharerId
|
||||
name Text Maybe
|
||||
|
|
@ -274,14 +287,9 @@ Project
|
|||
wiki RepoId Maybe
|
||||
collabUser RoleId Maybe
|
||||
collabAnon RoleId Maybe
|
||||
inbox InboxId
|
||||
outbox OutboxId
|
||||
followers FollowerSetId
|
||||
|
||||
UniqueProjectActor actor
|
||||
UniqueProject ident sharer
|
||||
UniqueProjectInbox inbox
|
||||
UniqueProjectOutbox outbox
|
||||
UniqueProjectFollowers followers
|
||||
|
||||
Repo
|
||||
ident RpIdent
|
||||
|
|
|
|||
11
migrations/2022_07_17_actor.model
Normal file
11
migrations/2022_07_17_actor.model
Normal file
|
|
@ -0,0 +1,11 @@
|
|||
Actor
|
||||
name Text
|
||||
desc Text
|
||||
createdAt UTCTime
|
||||
inbox InboxId
|
||||
outbox OutboxId
|
||||
followers FollowerSetId
|
||||
|
||||
UniqueActorInbox inbox
|
||||
UniqueActorOutbox outbox
|
||||
UniqueActorFollowers followers
|
||||
28
migrations/2022_07_17_project_actor.model
Normal file
28
migrations/2022_07_17_project_actor.model
Normal file
|
|
@ -0,0 +1,28 @@
|
|||
Inbox
|
||||
|
||||
Outbox
|
||||
|
||||
FollowerSet
|
||||
|
||||
Actor
|
||||
name Text
|
||||
desc Text
|
||||
createdAt UTCTime
|
||||
inbox InboxId
|
||||
outbox OutboxId
|
||||
followers FollowerSetId
|
||||
|
||||
Project
|
||||
actor ActorId
|
||||
ident Text
|
||||
sharer Int64
|
||||
name Text Maybe
|
||||
desc Text Maybe
|
||||
workflow Int64
|
||||
nextTicket Int
|
||||
wiki Int64 Maybe
|
||||
collabUser Int64 Maybe
|
||||
collabAnon Int64 Maybe
|
||||
inbox InboxId
|
||||
outbox OutboxId
|
||||
followers FollowerSetId
|
||||
|
|
@ -87,7 +87,7 @@ import Crypto.PublicVerifKey
|
|||
import Database.Persist.JSON
|
||||
import Network.FedURI
|
||||
import Network.HTTP.Digest
|
||||
import Web.ActivityPub hiding (Patch, Ticket, Follow, Repo (..))
|
||||
import Web.ActivityPub hiding (Patch, Ticket, Follow, Repo (..), Project (..), Actor (..))
|
||||
import Yesod.ActivityPub
|
||||
import Yesod.Auth.Unverified
|
||||
import Yesod.FedURI
|
||||
|
|
@ -1199,13 +1199,13 @@ createTicketC (Entity pidUser personUser) sharerUser summary audience ticket muT
|
|||
]
|
||||
(recipsC, ibid, actor) =
|
||||
case ent of
|
||||
Left (Entity _ j) ->
|
||||
Left (Entity _ j, a) ->
|
||||
let prj = projectIdent j
|
||||
in ( [ LocalPersonCollectionProjectTeam shr prj
|
||||
, LocalPersonCollectionProjectFollowers shr prj
|
||||
, LocalPersonCollectionSharerFollowers shrUser
|
||||
]
|
||||
, projectInbox j
|
||||
, actorInbox a
|
||||
, LocalActorProject shr prj
|
||||
)
|
||||
Right (Entity _ r, _, _, _) ->
|
||||
|
|
@ -1465,8 +1465,9 @@ createTicketC (Entity pidUser personUser) sharerUser summary audience ticket muT
|
|||
sid <- MaybeT $ getKeyBy $ UniqueSharer shr
|
||||
MaybeT $ getBy $ UniqueProject prj sid
|
||||
ej@(Entity _ j) <- fromMaybeE mej "Local context: no such project"
|
||||
obiidAccept <- lift $ insertEmptyOutboxItem (projectOutbox j) now
|
||||
return (shr, Left ej, obiidAccept)
|
||||
a <- lift $ getJust $ projectActor j
|
||||
obiidAccept <- lift $ insertEmptyOutboxItem (actorOutbox a) now
|
||||
return (shr, Left (ej, a), obiidAccept)
|
||||
prepareProject now (Left (WITRepo shr rp mb typ diff)) = Left <$> do
|
||||
mer <- lift $ runMaybeT $ do
|
||||
sid <- MaybeT $ getKeyBy $ UniqueSharer shr
|
||||
|
|
@ -1515,7 +1516,7 @@ createTicketC (Entity pidUser personUser) sharerUser summary audience ticket muT
|
|||
, ticketContextLocalAccept = obiidAccept
|
||||
}
|
||||
case ent of
|
||||
Left (Entity jid _) -> do
|
||||
Left (Entity jid _, _) -> do
|
||||
insert_ TicketProjectLocal
|
||||
{ ticketProjectLocalContext = tclid
|
||||
, ticketProjectLocalProject = jid
|
||||
|
|
@ -1707,7 +1708,7 @@ createTicketC (Entity pidUser personUser) sharerUser summary audience ticket muT
|
|||
talkhid <- encodeKeyHashid talid
|
||||
let (outboxItemRoute, actorRoute) =
|
||||
case ent of
|
||||
Left (Entity _ j) ->
|
||||
Left (Entity _ j, _) ->
|
||||
let prj = projectIdent j
|
||||
in (ProjectOutboxItemR shrJ prj, ProjectR shrJ prj)
|
||||
Right (Entity _ r, _, _, _) ->
|
||||
|
|
@ -1846,14 +1847,16 @@ followC shrUser summary audience follow@(AP.Follow uObject muContext hide) = do
|
|||
sid <- MaybeT $ getKeyBy $ UniqueSharer shr
|
||||
MaybeT $ getValBy $ UniqueProject prj sid
|
||||
project <- fromMaybeE mproject "Follow object: No such project in DB"
|
||||
return (projectFollowers project, projectInbox project, False, projectOutbox project)
|
||||
actor <- lift $ getJust $ projectActor project
|
||||
return (actorFollowers actor, actorInbox actor, False, actorOutbox actor)
|
||||
getFollowee (FolloweeProjectTicket shr prj ltkhid) = do
|
||||
(_, Entity _ j, _, Entity _ lt, _, _, _, _) <- do
|
||||
mticket <- lift $ runMaybeT $ do
|
||||
ltid <- decodeKeyHashidM ltkhid
|
||||
MaybeT $ getProjectTicket shr prj ltid
|
||||
fromMaybeE mticket "Follow object: No such project-ticket in DB"
|
||||
return (localTicketFollowers lt, projectInbox j, False, projectOutbox j)
|
||||
a <- lift $ getJust $ projectActor j
|
||||
return (localTicketFollowers lt, actorInbox a, False, actorOutbox a)
|
||||
getFollowee (FolloweeRepo shr rp) = do
|
||||
mrepo <- lift $ runMaybeT $ do
|
||||
sid <- MaybeT $ getKeyBy $ UniqueSharer shr
|
||||
|
|
@ -1971,8 +1974,9 @@ offerTicketC (Entity pidUser personUser) sharerUser summary audience ticket uTar
|
|||
Left (WITProject shr prj) -> Just . Left <$> do
|
||||
mproj <- lift $ runMaybeT $ do
|
||||
Entity sid s <- MaybeT $ getBy $ UniqueSharer shr
|
||||
ej <- MaybeT $ getBy $ UniqueProject prj sid
|
||||
return (s, ej)
|
||||
ej@(Entity _ j) <- MaybeT $ getBy $ UniqueProject prj sid
|
||||
a <- lift $ getJust $ projectActor j
|
||||
return (s, ej, a)
|
||||
fromMaybeE mproj "Offer target no such local project in DB"
|
||||
Left (WITRepo shr rp mb typ diffs) -> Just . Right <$> do
|
||||
mproj <- lift $ runMaybeT $ do
|
||||
|
|
@ -2022,12 +2026,12 @@ offerTicketC (Entity pidUser personUser) sharerUser summary audience ticket uTar
|
|||
maccept <- lift $ for mproject $ \ project -> do
|
||||
let obid =
|
||||
case project of
|
||||
Left (_, Entity _ j) -> projectOutbox j
|
||||
Left (_, _, a) -> actorOutbox a
|
||||
Right (_, Entity _ r, _, _, _) -> repoOutbox r
|
||||
obiidAccept <- insertEmptyOutboxItem obid now
|
||||
let insertTXL =
|
||||
case project of
|
||||
Left (_, Entity jid _) ->
|
||||
Left (_, Entity jid _, _) ->
|
||||
\ tclid -> insert_ $ TicketProjectLocal tclid jid
|
||||
Right (_, Entity rid _, mb, _, _) ->
|
||||
\ tclid -> insert_ $ TicketRepoLocal tclid rid mb
|
||||
|
|
@ -2040,9 +2044,9 @@ offerTicketC (Entity pidUser personUser) sharerUser summary audience ticket uTar
|
|||
(docAccept, localRecipsAccept) <- insertAccept shrUser luOffer project obiidAccept ltid
|
||||
let (actor, ibid) =
|
||||
case project of
|
||||
Left (s, Entity _ j) ->
|
||||
Left (s, Entity _ j, a) ->
|
||||
( LocalActorProject (sharerIdent s) (projectIdent j)
|
||||
, projectInbox j
|
||||
, actorInbox a
|
||||
)
|
||||
Right (s, Entity _ r, _, _, _) ->
|
||||
( LocalActorRepo (sharerIdent s) (repoIdent r)
|
||||
|
|
@ -2237,7 +2241,7 @@ offerTicketC (Entity pidUser personUser) sharerUser summary audience ticket uTar
|
|||
insertAccept shrUser luOffer project obiidAccept ltid = do
|
||||
let (collections, outboxItemRoute, projectRoute, ticketRoute) =
|
||||
case project of
|
||||
Left (s, Entity _ j) ->
|
||||
Left (s, Entity _ j, _) ->
|
||||
let shr = sharerIdent s
|
||||
prj = projectIdent j
|
||||
in ( [ LocalPersonCollectionProjectTeam shr prj
|
||||
|
|
@ -2395,8 +2399,8 @@ offerDepC (Entity pidUser personUser) sharerUser summary audience dep uTarget =
|
|||
MaybeT (getValBy $ UniquePersonIdent sid)
|
||||
WorkItemProjectTicket shr prj _ -> do
|
||||
sid <- MaybeT $ getKeyBy $ UniqueSharer shr
|
||||
projectInbox <$>
|
||||
MaybeT (getValBy $ UniqueProject prj sid)
|
||||
j <- MaybeT $ getValBy $ UniqueProject prj sid
|
||||
lift $ actorInbox <$> getJust (projectActor j)
|
||||
WorkItemRepoProposal shr rp _ -> do
|
||||
sid <- MaybeT $ getKeyBy $ UniqueSharer shr
|
||||
repoInbox <$>
|
||||
|
|
@ -2422,8 +2426,9 @@ offerDepC (Entity pidUser personUser) sharerUser summary audience dep uTarget =
|
|||
return (personOutbox p, personInbox p)
|
||||
WorkItemProjectTicket shr prj _ -> do
|
||||
sid <- MaybeT $ getKeyBy $ UniqueSharer shr
|
||||
j <- MaybeT (getValBy $ UniqueProject prj sid)
|
||||
return (projectOutbox j, projectInbox j)
|
||||
j <- MaybeT $ getValBy $ UniqueProject prj sid
|
||||
a <- lift $ getJust $ projectActor j
|
||||
return (actorOutbox a, actorInbox a)
|
||||
WorkItemRepoProposal shr rp _ -> do
|
||||
sid <- MaybeT $ getKeyBy $ UniqueSharer shr
|
||||
r <- MaybeT (getValBy $ UniqueRepo rp sid)
|
||||
|
|
@ -2646,8 +2651,9 @@ resolveC (Entity pidUser personUser) sharerUser summary audience (Resolve uObjec
|
|||
return (personOutbox p, personInbox p)
|
||||
WorkItemProjectTicket shr prj _ -> do
|
||||
sid <- MaybeT $ getKeyBy $ UniqueSharer shr
|
||||
j <- MaybeT (getValBy $ UniqueProject prj sid)
|
||||
return (projectOutbox j, projectInbox j)
|
||||
j <- MaybeT $ getValBy $ UniqueProject prj sid
|
||||
a <- lift $ getJust $ projectActor j
|
||||
return (actorOutbox a, actorInbox a)
|
||||
WorkItemRepoProposal shr rp _ -> do
|
||||
sid <- MaybeT $ getKeyBy $ UniqueSharer shr
|
||||
r <- MaybeT (getValBy $ UniqueRepo rp sid)
|
||||
|
|
@ -2765,8 +2771,9 @@ undoC (Entity _pidUser personUser) sharerUser summary audience undo@(Undo uObjec
|
|||
return (personOutbox p, personInbox p)
|
||||
WorkItemProjectTicket shr prj _ -> do
|
||||
sid <- MaybeT $ getKeyBy $ UniqueSharer shr
|
||||
j <- MaybeT (getValBy $ UniqueProject prj sid)
|
||||
return (projectOutbox j, projectInbox j)
|
||||
j <- MaybeT $ getValBy $ UniqueProject prj sid
|
||||
a <- lift $ getJust $ projectActor j
|
||||
return (actorOutbox a, actorInbox a)
|
||||
WorkItemRepoProposal shr rp _ -> do
|
||||
sid <- MaybeT $ getKeyBy $ UniqueSharer shr
|
||||
r <- MaybeT (getValBy $ UniqueRepo rp sid)
|
||||
|
|
|
|||
|
|
@ -38,7 +38,7 @@ module Vervis.ActivityPub
|
|||
, checkForward
|
||||
, parseTarget
|
||||
--, checkDep
|
||||
, getProjectAndDeps
|
||||
--, getProjectAndDeps
|
||||
, deliverRemoteDB'
|
||||
, deliverRemoteDB''
|
||||
, deliverRemoteHttp
|
||||
|
|
@ -110,7 +110,7 @@ import Yesod.HttpSignature
|
|||
import Database.Persist.JSON
|
||||
import Network.FedURI
|
||||
import Network.HTTP.Digest
|
||||
import Web.ActivityPub hiding (Author (..), Ticket, Project, Repo)
|
||||
import Web.ActivityPub hiding (Author (..), Ticket, Project (..), Repo, Actor (..))
|
||||
import Yesod.ActivityPub
|
||||
import Yesod.MonadSite
|
||||
import Yesod.FedURI
|
||||
|
|
@ -515,6 +515,7 @@ checkDep hProject shrProject prjProject u = do
|
|||
_ -> throwE "Expected ticket route, got non-ticket route"
|
||||
-}
|
||||
|
||||
{-
|
||||
getProjectAndDeps shr prj {-deps-} = do
|
||||
msid <- lift $ getKeyBy $ UniqueSharer shr
|
||||
sid <- fromMaybeE msid "Offer target: no such local sharer"
|
||||
|
|
@ -526,6 +527,7 @@ getProjectAndDeps shr prj {-deps-} = do
|
|||
fromMaybeE mtid "Local dep: No such ticket number in DB"
|
||||
-}
|
||||
return (sid, jid, projectInbox j, projectFollowers j{-, tids-})
|
||||
-}
|
||||
|
||||
data Recip
|
||||
= RecipRA (Entity RemoteActor)
|
||||
|
|
@ -918,8 +920,13 @@ insertActivityToLocalInboxes makeInboxItem requireOwner mauthor mibidAuthor reci
|
|||
[prj | (prj, j) <- projects
|
||||
, localRecipProject $ localRecipProjectDirect j
|
||||
]
|
||||
in map (projectInbox . entityVal) <$>
|
||||
selectList [ProjectSharer ==. sid, ProjectIdent <-. prjs] []
|
||||
in fmap (map E.unValue) $
|
||||
E.select $ E.from $ \ (j `E.InnerJoin` a) -> do
|
||||
E.on $ j E.^. ProjectActor E.==. a E.^. ActorId
|
||||
E.where_ $
|
||||
j E.^. ProjectSharer E.==. E.val sid E.&&.
|
||||
j E.^. ProjectIdent `E.in_` E.valList prjs
|
||||
return $ a E.^. ActorInbox
|
||||
getRepoInboxes sid repos =
|
||||
let rps =
|
||||
[rp | (rp, r) <- repos
|
||||
|
|
@ -983,8 +990,13 @@ insertActivityToLocalInboxes makeInboxItem requireOwner mauthor mibidAuthor reci
|
|||
(localRecipProject d || not requireOwner || isAuthor (LocalActorProject shr prj))
|
||||
]
|
||||
fsidsJ <-
|
||||
map (projectFollowers . entityVal) <$>
|
||||
selectList [ProjectSharer ==. sid, ProjectIdent <-. prjsJ] []
|
||||
fmap (map E.unValue) $
|
||||
E.select $ E.from $ \ (j `E.InnerJoin` a) -> do
|
||||
E.on $ j E.^. ProjectActor E.==. a E.^. ActorId
|
||||
E.where_ $
|
||||
j E.^. ProjectSharer E.==. E.val sid E.&&.
|
||||
j E.^. ProjectIdent `E.in_` E.valList prjsJ
|
||||
return $ a E.^. ActorFollowers
|
||||
let prjsT =
|
||||
if requireOwner
|
||||
then
|
||||
|
|
@ -1274,7 +1286,8 @@ getActivity (Left (actor, obiid)) = Just . Left <$> do
|
|||
j <- do
|
||||
mj <- lift $ getValBy $ UniqueProject prj sid
|
||||
fromMaybeE mj "No such project"
|
||||
return $ projectOutbox j
|
||||
a <- lift $ getJust $ projectActor j
|
||||
return $ actorOutbox a
|
||||
getActorOutbox (LocalActorRepo shr rp) = do
|
||||
sid <- do
|
||||
msid <- lift $ getKeyBy $ UniqueSharer shr
|
||||
|
|
@ -1295,12 +1308,16 @@ data ActorEntity
|
|||
|
||||
getOutboxActorEntity obid = do
|
||||
mp <- getBy $ UniquePersonOutbox obid
|
||||
mj <- getBy $ UniqueProjectOutbox obid
|
||||
ma <- getBy $ UniqueActorOutbox obid
|
||||
mr <- getBy $ UniqueRepoOutbox obid
|
||||
case (mp, mj, mr) of
|
||||
case (mp, ma, mr) of
|
||||
(Nothing, Nothing, Nothing) -> error "obid not in use"
|
||||
(Just p, Nothing, Nothing) -> return $ ActorPerson p
|
||||
(Nothing, Just j, Nothing) -> return $ ActorProject j
|
||||
(Nothing, Just (Entity aid _), Nothing) -> do
|
||||
mj <- getBy $ UniqueProjectActor aid
|
||||
case mj of
|
||||
Nothing -> error "found Actor not in use by any Project"
|
||||
Just j -> return $ ActorProject j
|
||||
(Nothing, Nothing, Just r) -> return $ ActorRepo r
|
||||
_ -> error "obid used by multiple actors"
|
||||
|
||||
|
|
|
|||
|
|
@ -1,6 +1,6 @@
|
|||
{- This file is part of Vervis.
|
||||
-
|
||||
- Written in 2019, 2020 by fr33domlover <fr33domlover@riseup.net>.
|
||||
- Written in 2019, 2020, 2022 by fr33domlover <fr33domlover@riseup.net>.
|
||||
-
|
||||
- ♡ Copying is an act of love. Please copy, reuse and share.
|
||||
-
|
||||
|
|
@ -54,7 +54,7 @@ import qualified Data.Text.Lazy as TL
|
|||
|
||||
import Development.PatchMediaType
|
||||
import Network.FedURI
|
||||
import Web.ActivityPub hiding (Follow, Ticket, Project, Repo)
|
||||
import Web.ActivityPub hiding (Follow, Ticket, Project (..), Repo, Actor (..))
|
||||
import Yesod.ActivityPub
|
||||
import Yesod.FedURI
|
||||
import Yesod.Hashids
|
||||
|
|
@ -428,8 +428,8 @@ undoFollowProject shrAuthor pidAuthor shrFollowee prjFollowee =
|
|||
msid <- lift $ getKeyBy $ UniqueSharer shrFollowee
|
||||
fromMaybeE msid "No such local sharer"
|
||||
mj <- lift $ getValBy $ UniqueProject prjFollowee sidFollowee
|
||||
projectFollowers <$>
|
||||
fromMaybeE mj "Unfollow target no such local project"
|
||||
j <- fromMaybeE mj "Unfollow target no such local project"
|
||||
lift $ actorFollowers <$> getJust (projectActor j)
|
||||
|
||||
undoFollowTicket
|
||||
:: (MonadUnliftIO m, MonadHandler m, HandlerSite m ~ App, MonadSite m, SiteEnv m ~ App)
|
||||
|
|
|
|||
|
|
@ -197,11 +197,14 @@ handleSharerInbox shrRecip _now (ActivityAuthLocal (ActivityAuthLocalProject jid
|
|||
getBy404 $ UniquePersonIdent sid
|
||||
mobi <- lift $ get obiid
|
||||
obi <- fromMaybeE mobi "Local activity: No such ID in DB"
|
||||
mjidOutbox <-
|
||||
lift $ getKeyBy $ UniqueProjectOutbox $ outboxItemOutbox obi
|
||||
jidOutbox <-
|
||||
fromMaybeE mjidOutbox "Local activity not in a project outbox"
|
||||
j <- lift $ getJust jidOutbox
|
||||
maidOutbox <-
|
||||
lift $ getKeyBy $ UniqueActorOutbox $ outboxItemOutbox obi
|
||||
aidOutbox <-
|
||||
fromMaybeE maidOutbox "Local activity not in an actor outbox"
|
||||
mejOutbox <-
|
||||
lift $ getBy $ UniqueProjectActor aidOutbox
|
||||
Entity jidOutbox j <-
|
||||
fromMaybeE mejOutbox "Local activity not in a project outbox"
|
||||
s <- lift $ getJust $ projectSharer j
|
||||
unless (sharerIdent s == shrActivity) $
|
||||
throwE "Local activity: ID invalid, hashid and author shr mismatch"
|
||||
|
|
|
|||
|
|
@ -1,6 +1,6 @@
|
|||
{- This file is part of Vervis.
|
||||
-
|
||||
- Written in 2019, 2020 by fr33domlover <fr33domlover@riseup.net>.
|
||||
- Written in 2019, 2020, 2022 by fr33domlover <fr33domlover@riseup.net>.
|
||||
-
|
||||
- ♡ Copying is an act of love. Please copy, reuse and share.
|
||||
-
|
||||
|
|
@ -53,7 +53,7 @@ import Yesod.HttpSignature
|
|||
import Database.Persist.JSON
|
||||
import Network.FedURI
|
||||
import Network.HTTP.Digest
|
||||
import Web.ActivityPub
|
||||
import Web.ActivityPub hiding (Project (..), Actor (..))
|
||||
import Yesod.ActivityPub
|
||||
import Yesod.FedURI
|
||||
import Yesod.Hashids
|
||||
|
|
@ -434,7 +434,8 @@ projectCreateNoteF now shrRecip prjRecip author body mfwd luCreate note = do
|
|||
getProjectRecip404 = do
|
||||
sid <- getKeyBy404 $ UniqueSharer shrRecip
|
||||
Entity jid j <- getBy404 $ UniqueProject prjRecip sid
|
||||
return (jid, projectInbox j)
|
||||
a <- getJust $ projectActor j
|
||||
return (jid, actorInbox a)
|
||||
|
||||
repoCreateNoteF
|
||||
:: UTCTime
|
||||
|
|
|
|||
|
|
@ -1,6 +1,6 @@
|
|||
{- This file is part of Vervis.
|
||||
-
|
||||
- Written in 2019, 2020 by fr33domlover <fr33domlover@riseup.net>.
|
||||
- Written in 2019, 2020, 2022 by fr33domlover <fr33domlover@riseup.net>.
|
||||
-
|
||||
- ♡ Copying is an act of love. Please copy, reuse and share.
|
||||
-
|
||||
|
|
@ -63,7 +63,7 @@ import qualified Data.Text.Lazy as TL
|
|||
|
||||
import Database.Persist.JSON
|
||||
import Network.FedURI
|
||||
import Web.ActivityPub hiding (Ticket (..), Follow)
|
||||
import Web.ActivityPub hiding (Ticket (..), Follow, Project (..), Actor (..))
|
||||
import Yesod.ActivityPub
|
||||
import Yesod.FedURI
|
||||
import Yesod.Hashids
|
||||
|
|
@ -466,8 +466,8 @@ projectFollowF shr prj =
|
|||
objRoute
|
||||
(ProjectR shr prj)
|
||||
getRecip
|
||||
(projectInbox . fst)
|
||||
(projectOutbox . fst)
|
||||
(actorInbox . fst)
|
||||
(actorOutbox . fst)
|
||||
followers
|
||||
(ProjectOutboxItemR shr prj)
|
||||
where
|
||||
|
|
@ -480,17 +480,18 @@ projectFollowF shr prj =
|
|||
getRecip mltkhid = do
|
||||
sid <- getKeyBy404 $ UniqueSharer shr
|
||||
j <- getValBy404 $ UniqueProject prj sid
|
||||
a <- getJust $ projectActor j
|
||||
mmt <- for mltkhid $ \ ltkhid -> runMaybeT $ do
|
||||
ltid <- decodeKeyHashidM ltkhid
|
||||
(_, _, _, Entity _ lt, _, _, _, _) <- MaybeT $ getProjectTicket shr prj ltid
|
||||
return lt
|
||||
return $
|
||||
case mmt of
|
||||
Nothing -> Just (j, Nothing)
|
||||
Nothing -> Just (a, Nothing)
|
||||
Just Nothing -> Nothing
|
||||
Just (Just t) -> Just (j, Just t)
|
||||
Just (Just t) -> Just (a, Just t)
|
||||
|
||||
followers (j, Nothing) = projectFollowers j
|
||||
followers (a, Nothing) = actorFollowers a
|
||||
followers (_, Just lt) = localTicketFollowers lt
|
||||
|
||||
repoFollowF
|
||||
|
|
@ -715,10 +716,11 @@ projectUndoF
|
|||
projectUndoF shrRecip prjRecip now author body mfwd luUndo (Undo uObj) = do
|
||||
object <- parseActivity uObj
|
||||
mmmhttp <- runDBExcept $ do
|
||||
Entity jid j <- lift $ do
|
||||
(Entity jid j, a) <- lift $ do
|
||||
sid <- getKeyBy404 $ UniqueSharer shrRecip
|
||||
getBy404 $ UniqueProject prjRecip sid
|
||||
mractid <- lift $ insertToInbox now author body (projectInbox j) luUndo False
|
||||
ej@(Entity _ j) <- getBy404 $ UniqueProject prjRecip sid
|
||||
(ej,) <$> getJust (projectActor j)
|
||||
mractid <- lift $ insertToInbox now author body (actorInbox a) luUndo False
|
||||
for mractid $ \ ractid -> do
|
||||
mobject' <- getActivity object
|
||||
lift $ for mobject' $ \ object' -> do
|
||||
|
|
@ -728,7 +730,7 @@ projectUndoF shrRecip prjRecip now author body mfwd luUndo (Undo uObj) = do
|
|||
for mobject'' $ \ object'' -> do
|
||||
(result, mfwdColl, macceptAuds) <-
|
||||
case object'' of
|
||||
Left erf -> (,Nothing,Nothing) <$> deleteRemoteFollow (isJust . myWorkItem) author (projectFollowers j) erf
|
||||
Left erf -> (,Nothing,Nothing) <$> deleteRemoteFollow (isJust . myWorkItem) author (actorFollowers a) erf
|
||||
Right tr -> deleteResolve myWorkItem prepareAccept tr
|
||||
mremotesHttpFwd <- for (liftA2 (,) mfwd mfwdColl) $ \ ((localRecips, sig), colls) -> do
|
||||
let sieve = makeRecipientSet [] colls
|
||||
|
|
@ -739,14 +741,14 @@ projectUndoF shrRecip prjRecip now author body mfwd luUndo (Undo uObj) = do
|
|||
sieve False False localRecips
|
||||
(sig,) <$> deliverRemoteDB_J (actbBL body) ractid jid sig remoteRecips
|
||||
mremotesHttpAccept <- for macceptAuds $ \ acceptAuds -> do
|
||||
obiidAccept <- insertEmptyOutboxItem (projectOutbox j) now
|
||||
obiidAccept <- insertEmptyOutboxItem (actorOutbox a) now
|
||||
(docAccept, localRecipsAccept, remoteRecipsAccept, fwdHostsAccept) <-
|
||||
insertAcceptOnUndo (LocalActorProject shrRecip prjRecip) author luUndo obiidAccept acceptAuds
|
||||
knownRemoteRecipsAccept <-
|
||||
deliverLocal'
|
||||
False
|
||||
(LocalActorProject shrRecip prjRecip)
|
||||
(projectInbox j)
|
||||
(actorInbox a)
|
||||
obiidAccept
|
||||
localRecipsAccept
|
||||
(obiidAccept,docAccept,fwdHostsAccept,) <$>
|
||||
|
|
|
|||
|
|
@ -78,7 +78,7 @@ import qualified Data.Text.Lazy as TL
|
|||
|
||||
import Database.Persist.JSON
|
||||
import Network.FedURI
|
||||
import Web.ActivityPub hiding (Patch, Ticket (..), Repo (..))
|
||||
import Web.ActivityPub hiding (Patch, Ticket (..), Repo (..), Project (..), Actor (..))
|
||||
import Yesod.ActivityPub
|
||||
import Yesod.FedURI
|
||||
import Yesod.Hashids
|
||||
|
|
@ -325,7 +325,8 @@ projectOfferTicketF now shrRecip prjRecip author body mfwd luOffer ticket uTarge
|
|||
Entity jid j <- do
|
||||
sid <- getKeyBy404 $ UniqueSharer shrRecip
|
||||
getBy404 $ UniqueProject prjRecip sid
|
||||
mractid <- insertToInbox now author body (projectInbox j) luOffer False
|
||||
a <- getJust $ projectActor j
|
||||
mractid <- insertToInbox now author body (actorInbox a) luOffer False
|
||||
for mractid $ \ ractid -> do
|
||||
mremotesHttpFwd <- for mfwd $ \ (localRecips, sig) -> do
|
||||
let sieve =
|
||||
|
|
@ -341,7 +342,7 @@ projectOfferTicketF now shrRecip prjRecip author body mfwd luOffer ticket uTarge
|
|||
sieve False False localRecips
|
||||
(sig,) <$> deliverRemoteDB_J (actbBL body) ractid jid sig remoteRecips
|
||||
(obiidAccept, docAccept, fwdHostsAccept, recipsAccept) <- do
|
||||
obiidAccept <- insertEmptyOutboxItem (projectOutbox j) now
|
||||
obiidAccept <- insertEmptyOutboxItem (actorOutbox a) now
|
||||
(_, ltid) <- insertLocalTicket now author (flip TicketProjectLocal jid) summary content source ractid obiidAccept
|
||||
(docAccept, localRecipsAccept, remoteRecipsAccept, fwdHostsAccept) <-
|
||||
insertAccept shrRecip prjRecip author luOffer ltid obiidAccept
|
||||
|
|
@ -349,7 +350,7 @@ projectOfferTicketF now shrRecip prjRecip author body mfwd luOffer ticket uTarge
|
|||
deliverLocal'
|
||||
False
|
||||
(LocalActorProject shrRecip prjRecip)
|
||||
(projectInbox j)
|
||||
(actorInbox a)
|
||||
obiidAccept
|
||||
localRecipsAccept
|
||||
(obiidAccept,docAccept,fwdHostsAccept,) <$>
|
||||
|
|
@ -946,9 +947,10 @@ projectCreateTicketF now shrRecip prjRecip author body mfwd luCreate ticket muTa
|
|||
Entity jid j <- do
|
||||
sid <- getKeyBy404 $ UniqueSharer shrRecip
|
||||
getBy404 $ UniqueProject prjRecip sid
|
||||
mractid <- insertToInbox now author body (projectInbox j) luCreate False
|
||||
a <- getJust $ projectActor j
|
||||
mractid <- insertToInbox now author body (actorInbox a) luCreate False
|
||||
for mractid $ \ ractid -> do
|
||||
obiidAccept <- insertEmptyOutboxItem (projectOutbox j) now
|
||||
obiidAccept <- insertEmptyOutboxItem (actorOutbox a) now
|
||||
let makeTPL tclid = TicketProjectLocal tclid jid
|
||||
result <- insertRemoteTicket makeTPL author (AP.ticketId tlocal) published title desc src ractid obiidAccept
|
||||
unless (isRight result) $ delete obiidAccept
|
||||
|
|
@ -972,7 +974,7 @@ projectCreateTicketF now shrRecip prjRecip author body mfwd luCreate ticket muTa
|
|||
deliverLocal'
|
||||
False
|
||||
(LocalActorProject shrRecip prjRecip)
|
||||
(projectInbox j)
|
||||
(actorInbox a)
|
||||
obiidAccept
|
||||
localRecipsAccept
|
||||
(mremotesHttpFwd,obiidAccept,docAccept,fwdHostsAccept,) <$>
|
||||
|
|
@ -2191,9 +2193,10 @@ projectOfferDepF
|
|||
-> ExceptT Text Handler (Text, Maybe (ExceptT Text Worker Text))
|
||||
projectOfferDepF now shrRecip prjRecip author body mfwd luOffer dep uTarget = do
|
||||
(parent, child) <- checkDepAndTarget dep uTarget
|
||||
Entity jidRecip projectRecip <- lift $ runDB $ do
|
||||
(Entity jidRecip projectRecip, actorRecip) <- lift $ runDB $ do
|
||||
sid <- getKeyBy404 $ UniqueSharer shrRecip
|
||||
getBy404 $ UniqueProject prjRecip sid
|
||||
ej@(Entity _ j) <- getBy404 $ UniqueProject prjRecip sid
|
||||
(ej,) <$> getJust (projectActor j)
|
||||
return $ (,) "Ran initial checks, doing the rest asynchronously" $ Just $ do
|
||||
relevantParent <-
|
||||
for (ticketRelevance shrRecip prjRecip parent) $ \ parentLtid -> do
|
||||
|
|
@ -2205,7 +2208,7 @@ projectOfferDepF now shrRecip prjRecip author body mfwd luOffer dep uTarget = do
|
|||
childDetail <- getWorkItemDetail "Child" child
|
||||
return (parentLtid, parentAuthor, childDetail)
|
||||
mhttp <- runSiteDBExcept $ do
|
||||
mractid <- lift $ insertToInbox' now author body (projectInbox projectRecip) luOffer False
|
||||
mractid <- lift $ insertToInbox' now author body (actorInbox actorRecip) luOffer False
|
||||
for mractid $ \ (ractid, ibiid) -> do
|
||||
insertDepOffer ibiid parent child
|
||||
mremotesHttpFwd <- lift $ for mfwd $ \ (localRecips, sig) -> do
|
||||
|
|
@ -2223,7 +2226,7 @@ projectOfferDepF now shrRecip prjRecip author body mfwd luOffer dep uTarget = do
|
|||
sieve False False localRecips
|
||||
(sig,) <$> deliverRemoteDB_J (actbBL body) ractid jidRecip sig remoteRecips
|
||||
mremotesHttpAccept <- lift $ for relevantParent $ \ (parentLtid, parentAuthor, childDetail) -> do
|
||||
obiidAccept <- insertEmptyOutboxItem (projectOutbox projectRecip) now
|
||||
obiidAccept <- insertEmptyOutboxItem (actorOutbox actorRecip) now
|
||||
tdid <- insertDep now author ractid parentLtid (widIdent childDetail) obiidAccept
|
||||
(docAccept, localRecipsAccept, remoteRecipsAccept, fwdHostsAccept) <-
|
||||
insertAccept luOffer obiidAccept tdid parentLtid parentAuthor childDetail
|
||||
|
|
@ -2231,7 +2234,7 @@ projectOfferDepF now shrRecip prjRecip author body mfwd luOffer dep uTarget = do
|
|||
deliverLocal'
|
||||
False
|
||||
(LocalActorProject shrRecip prjRecip)
|
||||
(projectInbox projectRecip)
|
||||
(actorInbox actorRecip)
|
||||
obiidAccept
|
||||
localRecipsAccept
|
||||
(obiidAccept,docAccept,fwdHostsAccept,) <$> deliverRemoteDB'' fwdHostsAccept obiidAccept remoteRecipsAccept knownRemoteRecipsAccept
|
||||
|
|
@ -2679,9 +2682,10 @@ projectResolveF
|
|||
projectResolveF now shrRecip prjRecip author body mfwd luResolve (Resolve uObject) = do
|
||||
object <- parseWorkItem "Resolve object" uObject
|
||||
mmmmhttp <- runDBExcept $ do
|
||||
Entity jidRecip projectRecip <- lift $ do
|
||||
(Entity jidRecip projectRecip, actorRecip) <- lift $ do
|
||||
sid <- getKeyBy404 $ UniqueSharer shrRecip
|
||||
getBy404 $ UniqueProject prjRecip sid
|
||||
ej@(Entity _ j) <- getBy404 $ UniqueProject prjRecip sid
|
||||
(ej,) <$> getJust (projectActor j)
|
||||
mltid <-
|
||||
case relevantObject object of
|
||||
Nothing -> do
|
||||
|
|
@ -2690,7 +2694,7 @@ projectResolveF now shrRecip prjRecip author body mfwd luResolve (Resolve uObjec
|
|||
Right _ -> return ()
|
||||
return Nothing
|
||||
Just ltid -> Just . (ltid,) <$> getObjectLtid ltid
|
||||
mractid <- lift $ insertToInbox now author body (projectInbox projectRecip) luResolve False
|
||||
mractid <- lift $ insertToInbox now author body (actorInbox actorRecip) luResolve False
|
||||
lift $ for mractid $ \ ractid -> for mltid $ \ (ltid, tid) -> do
|
||||
mremotesHttpFwd <- for mfwd $ \ (localRecips, sig) -> do
|
||||
ltkhid <- encodeKeyHashid ltid
|
||||
|
|
@ -2707,7 +2711,7 @@ projectResolveF now shrRecip prjRecip author body mfwd luResolve (Resolve uObjec
|
|||
localRecipSieve'
|
||||
sieve False False localRecips
|
||||
(sig,) <$> deliverRemoteDB_J (actbBL body) ractid jidRecip sig remoteRecips
|
||||
obiidAccept <- insertEmptyOutboxItem (projectOutbox projectRecip) now
|
||||
obiidAccept <- insertEmptyOutboxItem (actorOutbox actorRecip) now
|
||||
mmtrrid <- insertResolve author ltid ractid obiidAccept
|
||||
case mmtrrid of
|
||||
Just (Just _) -> update tid [TicketStatus =. TSClosed]
|
||||
|
|
@ -2719,7 +2723,7 @@ projectResolveF now shrRecip prjRecip author body mfwd luResolve (Resolve uObjec
|
|||
deliverLocal'
|
||||
False
|
||||
(LocalActorProject shrRecip prjRecip)
|
||||
(projectInbox projectRecip)
|
||||
(actorInbox actorRecip)
|
||||
obiidAccept
|
||||
localRecipsAccept
|
||||
(mremotesHttpFwd,obiidAccept,docAccept,fwdHostsAccept,) <$>
|
||||
|
|
|
|||
|
|
@ -113,7 +113,8 @@ newProjectCollabForm sid jid = renderDivs $ newProjectCollabAForm sid jid
|
|||
|
||||
editProjectAForm :: SharerId -> Entity Project -> AForm Handler Project
|
||||
editProjectAForm sid (Entity jid project) = Project
|
||||
<$> pure (projectIdent project)
|
||||
<$> pure (projectActor project)
|
||||
<*> pure (projectIdent project)
|
||||
<*> pure (projectSharer project)
|
||||
<*> aopt textField "Name" (Just $ projectName project)
|
||||
<*> aopt textField "Description" (Just $ projectDesc project)
|
||||
|
|
@ -122,9 +123,6 @@ editProjectAForm sid (Entity jid project) = Project
|
|||
<*> aopt selectWiki "Wiki" (Just $ projectWiki project)
|
||||
<*> aopt selectRole "User role" (Just $ projectCollabUser project)
|
||||
<*> aopt selectRole "Guest role" (Just $ projectCollabAnon project)
|
||||
<*> pure (projectInbox project)
|
||||
<*> pure (projectOutbox project)
|
||||
<*> pure (projectFollowers project)
|
||||
where
|
||||
selectWiki =
|
||||
selectField $
|
||||
|
|
|
|||
|
|
@ -1,6 +1,6 @@
|
|||
{- This file is part of Vervis.
|
||||
-
|
||||
- Written in 2019, 2020 by fr33domlover <fr33domlover@riseup.net>.
|
||||
- Written in 2019, 2020, 2022 by fr33domlover <fr33domlover@riseup.net>.
|
||||
-
|
||||
- ♡ Copying is an act of love. Please copy, reuse and share.
|
||||
-
|
||||
|
|
@ -75,7 +75,7 @@ import qualified Database.Esqueleto as E
|
|||
|
||||
import Database.Persist.JSON
|
||||
import Network.FedURI
|
||||
import Web.ActivityPub
|
||||
import Web.ActivityPub hiding (Project (..), Actor (..))
|
||||
import Yesod.ActivityPub
|
||||
import Yesod.Auth.Unverified
|
||||
import Yesod.FedURI
|
||||
|
|
@ -257,7 +257,8 @@ getProjectInboxR shr prj = getInbox here getInboxId
|
|||
getInboxId = do
|
||||
sid <- getKeyBy404 $ UniqueSharer shr
|
||||
j <- getValBy404 $ UniqueProject prj sid
|
||||
return $ projectInbox j
|
||||
a <- getJust $ projectActor j
|
||||
return $ actorInbox a
|
||||
|
||||
getRepoInboxR :: ShrIdent -> RpIdent -> Handler TypedContent
|
||||
getRepoInboxR shr rp = getInbox here getInboxId
|
||||
|
|
@ -430,7 +431,8 @@ getProjectOutboxR shr prj = getOutbox here getObid
|
|||
getObid = do
|
||||
sid <- getKeyBy404 $ UniqueSharer shr
|
||||
j <- getValBy404 $ UniqueProject prj sid
|
||||
return $ projectOutbox j
|
||||
a <- getJust $ projectActor j
|
||||
return $ actorOutbox a
|
||||
|
||||
getProjectOutboxItemR
|
||||
:: ShrIdent -> PrjIdent -> KeyHashid OutboxItem -> Handler TypedContent
|
||||
|
|
@ -440,7 +442,8 @@ getProjectOutboxItemR shr prj obikhid = getOutboxItem here getObid obikhid
|
|||
getObid = do
|
||||
sid <- getKeyBy404 $ UniqueSharer shr
|
||||
j <- getValBy404 $ UniqueProject prj sid
|
||||
return $ projectOutbox j
|
||||
a <- getJust $ projectActor j
|
||||
return $ actorOutbox a
|
||||
|
||||
getRepoOutboxR :: ShrIdent -> RpIdent -> Handler TypedContent
|
||||
getRepoOutboxR shr rp = getOutbox here getObid
|
||||
|
|
|
|||
|
|
@ -1,6 +1,6 @@
|
|||
{- This file is part of Vervis.
|
||||
-
|
||||
- Written in 2016, 2018, 2019 by fr33domlover <fr33domlover@riseup.net>.
|
||||
- Written in 2016, 2018, 2019, 2022 by fr33domlover <fr33domlover@riseup.net>.
|
||||
-
|
||||
- ♡ Copying is an act of love. Please copy, reuse and share.
|
||||
-
|
||||
|
|
@ -42,7 +42,7 @@ import Yesod.Hashids
|
|||
|
||||
import Vervis.ActorKey
|
||||
import Vervis.Foundation
|
||||
import Vervis.Model
|
||||
import Vervis.Model hiding (Actor (..))
|
||||
import Vervis.Model.Ident
|
||||
import Vervis.Secure
|
||||
import Vervis.Settings
|
||||
|
|
|
|||
|
|
@ -51,7 +51,7 @@ import qualified Database.Esqueleto as E
|
|||
|
||||
import Database.Persist.JSON
|
||||
import Network.FedURI
|
||||
import Web.ActivityPub hiding (Project (..), Repo (..))
|
||||
import Web.ActivityPub hiding (Project (..), Repo (..), Actor (..))
|
||||
import Yesod.ActivityPub
|
||||
import Yesod.FedURI
|
||||
import Yesod.MonadSite
|
||||
|
|
@ -97,8 +97,17 @@ postProjectsR shr = do
|
|||
ibid <- insert Inbox
|
||||
obid <- insert Outbox
|
||||
fsid <- insert FollowerSet
|
||||
aid <- insert Actor
|
||||
{ actorName = fromMaybe "" $ npName np
|
||||
, actorDesc = fromMaybe "" $ npDesc np
|
||||
, actorCreatedAt = now
|
||||
, actorInbox = ibid
|
||||
, actorOutbox = obid
|
||||
, actorFollowers = fsid
|
||||
}
|
||||
let project = Project
|
||||
{ projectIdent = npIdent np
|
||||
{ projectActor = aid
|
||||
, projectIdent = npIdent np
|
||||
, projectSharer = sid
|
||||
, projectName = npName np
|
||||
, projectDesc = npDesc np
|
||||
|
|
@ -107,9 +116,6 @@ postProjectsR shr = do
|
|||
, projectWiki = Nothing
|
||||
, projectCollabAnon = Nothing
|
||||
, projectCollabUser = Nothing
|
||||
, projectInbox = ibid
|
||||
, projectOutbox = obid
|
||||
, projectFollowers = fsid
|
||||
}
|
||||
jid <- insert project
|
||||
|
||||
|
|
@ -141,7 +147,7 @@ getProjectNewR shr = do
|
|||
|
||||
getProjectR :: ShrIdent -> PrjIdent -> Handler TypedContent
|
||||
getProjectR shar proj = do
|
||||
(project, workflow, wsharer, repos) <- runDB $ do
|
||||
(actor, project, workflow, wsharer, repos) <- runDB $ do
|
||||
Entity sid s <- getBy404 $ UniqueSharer shar
|
||||
Entity pid p <- getBy404 $ UniqueProject proj sid
|
||||
w <- get404 $ projectWorkflow p
|
||||
|
|
@ -150,29 +156,30 @@ getProjectR shar proj = do
|
|||
then return s
|
||||
else get404 $ workflowSharer w
|
||||
rs <- selectList [RepoProject ==. Just pid] [Asc RepoIdent]
|
||||
return (p, w, sw, rs)
|
||||
a <- getJust $ projectActor p
|
||||
return (a, p, w, sw, rs)
|
||||
|
||||
route2fed <- getEncodeRouteHome
|
||||
route2local <- getEncodeRouteLocal
|
||||
let projectAP = AP.Project
|
||||
{ AP.projectActor = Actor
|
||||
{ actorId = route2local $ ProjectR shar proj
|
||||
, actorType = ActorTypeProject
|
||||
, actorUsername = Nothing
|
||||
, actorName =
|
||||
{ AP.projectActor = AP.Actor
|
||||
{ AP.actorId = route2local $ ProjectR shar proj
|
||||
, AP.actorType = ActorTypeProject
|
||||
, AP.actorUsername = Nothing
|
||||
, AP.actorName =
|
||||
Just $ fromMaybe (prj2text proj) $ projectName project
|
||||
, actorSummary = projectDesc project
|
||||
, actorInbox = route2local $ ProjectInboxR shar proj
|
||||
, actorOutbox =
|
||||
, AP.actorSummary = projectDesc project
|
||||
, AP.actorInbox = route2local $ ProjectInboxR shar proj
|
||||
, AP.actorOutbox =
|
||||
Just $ route2local $ ProjectOutboxR shar proj
|
||||
, actorFollowers =
|
||||
, AP.actorFollowers =
|
||||
Just $ route2local $ ProjectFollowersR shar proj
|
||||
, actorFollowing = Nothing
|
||||
, actorPublicKeys =
|
||||
, AP.actorFollowing = Nothing
|
||||
, AP.actorPublicKeys =
|
||||
[ Left $ route2local ActorKey1R
|
||||
, Left $ route2local ActorKey2R
|
||||
]
|
||||
, actorSshKeys = []
|
||||
, AP.actorSshKeys = []
|
||||
}
|
||||
, AP.projectTeam = route2local $ ProjectTeamR shar proj
|
||||
}
|
||||
|
|
@ -180,7 +187,7 @@ getProjectR shar proj = do
|
|||
followW
|
||||
(ProjectFollowR shar proj)
|
||||
(ProjectUnfollowR shar proj)
|
||||
(return $ projectFollowers project)
|
||||
(return $ actorFollowers actor)
|
||||
provideHtmlAndAP projectAP $(widgetFile "project/one")
|
||||
|
||||
putProjectR :: ShrIdent -> PrjIdent -> Handler Html
|
||||
|
|
@ -240,7 +247,8 @@ postProjectDevsR shr rp = do
|
|||
(sid, jid, obid) <- runDB $ do
|
||||
Entity sid _ <- getBy404 $ UniqueSharer shr
|
||||
Entity jid j <- getBy404 $ UniqueProject rp sid
|
||||
return (sid, jid, projectOutbox j)
|
||||
a <- getJust $ projectActor j
|
||||
return (sid, jid, actorOutbox a)
|
||||
((result, widget), enctype) <- runFormPost $ newProjectCollabForm sid jid
|
||||
case result of
|
||||
FormSuccess nc -> do
|
||||
|
|
@ -390,4 +398,5 @@ getProjectFollowersR shr prj = getFollowersCollection here getFsid
|
|||
getFsid = do
|
||||
sid <- getKeyBy404 $ UniqueSharer shr
|
||||
j <- getValBy404 $ UniqueProject prj sid
|
||||
return $ projectFollowers j
|
||||
a <- getJust $ projectActor j
|
||||
return $ actorFollowers a
|
||||
|
|
|
|||
|
|
@ -117,7 +117,7 @@ import Vervis.Foundation
|
|||
import Vervis.Handler.Repo.Darcs
|
||||
import Vervis.Handler.Repo.Git
|
||||
import Vervis.Path
|
||||
import Vervis.Model
|
||||
import Vervis.Model hiding (Actor (..))
|
||||
import Vervis.Model.Ident
|
||||
import Development.PatchMediaType
|
||||
import Vervis.Paginate
|
||||
|
|
|
|||
|
|
@ -1,6 +1,6 @@
|
|||
{- This file is part of Vervis.
|
||||
-
|
||||
- Written in 2016, 2019, 2020 by fr33domlover <fr33domlover@riseup.net>.
|
||||
- Written in 2016, 2019, 2020, 2022 by fr33domlover <fr33domlover@riseup.net>.
|
||||
-
|
||||
- ♡ Copying is an act of love. Please copy, reuse and share.
|
||||
-
|
||||
|
|
@ -137,13 +137,13 @@ getSharerFollowingR shr = do
|
|||
selectList [PersonFollowers <-. fsids] []
|
||||
map (SharerR . sharerIdent . entityVal) <$>
|
||||
selectList [SharerId <-. sids] []
|
||||
getProjects fsids = do
|
||||
jids <- selectKeysList [ProjectFollowers <-. fsids] []
|
||||
pairs <- E.select $ E.from $ \ (j `E.InnerJoin` s) -> do
|
||||
getProjects fsids =
|
||||
fmap (map $ \ (E.Value shr, E.Value prj) -> ProjectR shr prj) $
|
||||
E.select $ E.from $ \ (a `E.InnerJoin` j `E.InnerJoin` s) -> do
|
||||
E.on $ j E.^. ProjectSharer E.==. s E.^. SharerId
|
||||
E.where_ $ j E.^. ProjectId `E.in_` E.valList jids
|
||||
E.on $ a E.^. ActorId E.==. j E.^. ProjectActor
|
||||
E.where_ $ a E.^. ActorFollowers `E.in_` E.valList fsids
|
||||
return (s E.^. SharerIdent, j E.^. ProjectIdent)
|
||||
return $ map (\ (E.Value shr, E.Value prj) -> ProjectR shr prj) pairs
|
||||
getTickets fsids = do
|
||||
ltids <- selectKeysList [LocalTicketFollowers <-. fsids] []
|
||||
triples <-
|
||||
|
|
|
|||
|
|
@ -1829,6 +1829,50 @@ changes hLocal ctx =
|
|||
, removeEntity "RepoCollab"
|
||||
-- 287
|
||||
, removeEntity "ProjectCollab"
|
||||
-- 288
|
||||
, addEntities model_2022_07_17
|
||||
-- 289
|
||||
, addFieldRefRequired''
|
||||
"Project"
|
||||
(do ibid <- insert Inbox289
|
||||
obid <- insert Outbox289
|
||||
fsid <- insert FollowerSet289
|
||||
insertEntity $ Actor289 "" "" defaultTime ibid obid fsid
|
||||
)
|
||||
(Just $ \ (Entity aidTemp aTemp) -> do
|
||||
js <- selectList ([] :: [Filter Project289]) []
|
||||
for js $ \ (Entity jid j) -> do
|
||||
aid <- insert Actor289
|
||||
{ actor289Name = fromMaybe "" $ project289Name j
|
||||
, actor289Desc = fromMaybe "" $ project289Desc j
|
||||
, actor289CreatedAt = defaultTime
|
||||
, actor289Inbox = project289Inbox j
|
||||
, actor289Outbox = project289Outbox j
|
||||
, actor289Followers = project289Followers j
|
||||
}
|
||||
update jid [Project289Actor =. aid]
|
||||
|
||||
delete aidTemp
|
||||
delete $ actor289Inbox aTemp
|
||||
delete $ actor289Outbox aTemp
|
||||
delete $ actor289Followers aTemp
|
||||
)
|
||||
"actor"
|
||||
"Actor"
|
||||
-- 290
|
||||
, addUnique "Project" $ Unique "UniqueProjectActor" ["actor"]
|
||||
-- 291
|
||||
, removeUnique "Project" "UniqueProjectInbox"
|
||||
-- 292
|
||||
, removeUnique "Project" "UniqueProjectOutbox"
|
||||
-- 293
|
||||
, removeUnique "Project" "UniqueProjectFollowers"
|
||||
-- 294
|
||||
, removeField "Project" "inbox"
|
||||
-- 295
|
||||
, removeField "Project" "outbox"
|
||||
-- 296
|
||||
, removeField "Project" "followers"
|
||||
]
|
||||
|
||||
migrateDB
|
||||
|
|
|
|||
|
|
@ -259,6 +259,13 @@ module Vervis.Migration.Model
|
|||
, Repo285Generic (..)
|
||||
, RepoCollab285
|
||||
, RepoCollab285Generic (..)
|
||||
, model_2022_07_17
|
||||
, Project289
|
||||
, Inbox289Generic (..)
|
||||
, Outbox289Generic (..)
|
||||
, FollowerSet289Generic (..)
|
||||
, Actor289Generic (..)
|
||||
, Project289Generic (..)
|
||||
)
|
||||
where
|
||||
|
||||
|
|
@ -501,3 +508,9 @@ model_2022_06_14 = $(schema "2022_06_14_collab")
|
|||
|
||||
makeEntitiesMigration "285"
|
||||
$(modelFile "migrations/2022_06_14_collab_mig.model")
|
||||
|
||||
model_2022_07_17 :: [Entity SqlBackend]
|
||||
model_2022_07_17 = $(schema "2022_07_17_actor")
|
||||
|
||||
makeEntitiesMigration "289"
|
||||
$(modelFile "migrations/2022_07_17_project_actor.model")
|
||||
|
|
|
|||
|
|
@ -1,6 +1,6 @@
|
|||
{- This file is part of Vervis.
|
||||
-
|
||||
- Written in 2019, 2020 by fr33domlover <fr33domlover@riseup.net>.
|
||||
- Written in 2019, 2020, 2022 by fr33domlover <fr33domlover@riseup.net>.
|
||||
-
|
||||
- ♡ Copying is an act of love. Please copy, reuse and share.
|
||||
-
|
||||
|
|
@ -65,7 +65,7 @@ import Web.ActivityPub
|
|||
import Yesod.MonadSite
|
||||
|
||||
import Vervis.FedURI
|
||||
import Vervis.Model
|
||||
import Vervis.Model hiding (Actor (..))
|
||||
|
||||
newtype InstanceMutex = InstanceMutex (TVar (HashMap Host (MVar ())))
|
||||
|
||||
|
|
|
|||
Loading…
Reference in a new issue