forge/Vervis
1
0
Fork 0
Code Pull requests Activity

UI, S2S: Implement Join flow in S2S + deck devs page now lists join requests

Browse source
This commit is contained in:
fr33domlover 2022-11-14 15:11:25 +00:00
parent e4d7156cbc
commit 72796a6bdc
12 changed files with 433 additions and 76 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

37
migrations/530_2022-11-01_join.model Normal file
View file

@ -0,0 +1,37 @@
CollabFulfillsJoin
collab CollabId
UniqueCollabFulfillsJoin collab
CollabApproverLocal
collab CollabFulfillsJoinId
accept OutboxItemId
UniqueCollabApproverLocal collab
UniqueCollabApproverLocalAccept accept
CollabApproverRemote
collab CollabFulfillsJoinId
actor RemoteActorId
accept RemoteActivityId
UniqueCollabApproverRemote collab
UniqueCollabApproverRemoteAccept accept
CollabRecipLocalJoin
collab CollabRecipLocalId
fulfills CollabFulfillsJoinId
join OutboxItemId
UniqueCollabRecipLocalJoinCollab collab
UniqueCollabRecipLocalJoinFulfills fulfills
UniqueCollabRecipLocalJoinJoin join
CollabRecipRemoteJoin
collab CollabRecipRemoteId
fulfills CollabFulfillsJoinId
join RemoteActivityId
UniqueCollabRecipRemoteJoinCollab collab
UniqueCollabRecipRemoteJoinFulfills fulfills
UniqueCollabRecipRemoteJoinJoin join

82
src/Vervis/Data/Collab.hs
View file

@ -22,6 +22,7 @@ module Vervis.Data.Collab
( GrantRecipBy (..)
, parseInvite
, parseJoin
, parseGrant
, parseAccept
@ -33,6 +34,7 @@ import Control.Monad
import Control.Monad.Trans.Except
import Data.Barbie
import Data.Bifunctor
import Data.Bitraversable
import Data.Functor.Identity
import Data.Text (Text)
import Database.Persist.Types
@ -54,6 +56,11 @@ import Vervis.FedURI
import Vervis.Foundation
import Vervis.Model
parseGrantResource (RepoR r) = Just $ GrantResourceRepo r
parseGrantResource (DeckR d) = Just $ GrantResourceDeck d
parseGrantResource (LoomR l) = Just $ GrantResourceLoom l
parseGrantResource _ = Nothing
data GrantRecipBy f = GrantRecipPerson (f Person)
deriving (Generic, FunctorB, TraversableB, ConstraintsB)
@ -74,6 +81,25 @@ unhashGrantRecip resource = do
unhashGrantRecipE resource e =
ExceptT $ maybe (Left e) Right <$> unhashGrantRecip resource
verifyRole (Left AP.RoleAdmin) = pure ()
verifyRole (Right _) =
throwE "ForgeFed Admin is the only role allowed currently"
parseTopic u = do
routeOrRemote <- parseFedURI u
bitraverse
(\ route -> do
resourceHash <-
fromMaybeE
(parseGrantResource route)
"Not a shared resource route"
unhashGrantResourceE
resourceHash
"Contains invalid hashid"
)
pure
routeOrRemote
parseInvite
:: Either PersonId FedURI
-> AP.Invite URIMode
@ -83,57 +109,39 @@ parseInvite
)
parseInvite sender (AP.Invite instrument object target) = do
verifyRole instrument
(,) <$> parseTopic target
<*> parseRecipient object
(,) <$> nameExceptT "Invite target" (parseTopic target)
<*> nameExceptT "Invite object" (parseRecipient object)
where
verifyRole (Left AP.RoleAdmin) = pure ()
verifyRole (Right _) =
throwE "ForgeFed Admin is the only role allowed currently"
parseTopic u@(ObjURI h lu) = do
hl <- hostIsLocal h
if hl
then Left <$> do
route <-
fromMaybeE
(decodeRouteLocal lu)
"Invite target isn't a valid route"
resourceHash <-
fromMaybeE
(parseGrantResource route)
"Invite target isn't a shared resource route"
unhashGrantResourceE
resourceHash
"Invite target contains invalid hashid"
else pure $ Right u
where
parseGrantResource (RepoR r) = Just $ GrantResourceRepo r
parseGrantResource (DeckR d) = Just $ GrantResourceDeck d
parseGrantResource (LoomR l) = Just $ GrantResourceLoom l
parseGrantResource _ = Nothing
parseRecipient u@(ObjURI h lu) = do
hl <- hostIsLocal h
if hl
then Left <$> do
route <-
fromMaybeE
(decodeRouteLocal lu)
"Invite object isn't a valid route"
parseRecipient u = do
routeOrRemote <- parseFedURI u
bitraverse
(\ route -> do
recipHash <-
fromMaybeE
(parseGrantRecip route)
"Invite object isn't a grant recipient route"
"Not a grant recipient route"
recipKey <-
unhashGrantRecipE
recipHash
"Invite object contains invalid hashid"
"Contains invalid hashid"
case recipKey of
GrantRecipPerson p | Left p == sender ->
throwE "Invite local sender and recipient are the same Person"
_ -> return recipKey
else Right <$> do
)
(\ u -> do
when (Right u == sender) $
throwE "Invite remote sender and recipient are the same actor"
return u
)
routeOrRemote
parseJoin
:: AP.Join URIMode
-> ExceptT Text Handler (Either (GrantResourceBy Key) FedURI)
parseJoin (AP.Join instrument object) = do
verifyRole instrument
nameExceptT "Join object" (parseTopic object)
parseGrant
:: AP.Grant URIMode

246
src/Vervis/Federation/Collab.hs
View file

@ -19,6 +19,10 @@ module Vervis.Federation.Collab
( personInviteF
, topicInviteF
, repoJoinF
, deckJoinF
, loomJoinF
, repoAcceptF
, deckAcceptF
, loomAcceptF
@ -27,6 +31,7 @@ module Vervis.Federation.Collab
)
where
import Control.Applicative
import Control.Exception hiding (Handler)
import Control.Monad
import Control.Monad.IO.Class
@ -316,6 +321,118 @@ topicInviteF now recipByHash author body mfwd luInvite invite = do
Right remoteActorID ->
insert_ $ CollabRecipRemote collabID remoteActorID
topicJoinF
:: (PersistRecordBackend topic SqlBackend, ToBackendKey SqlBackend topic)
=> (topic -> ActorId)
-> (forall f. f topic -> GrantResourceBy f)
-> UTCTime
-> KeyHashid topic
-> RemoteAuthor
-> ActivityBody
-> Maybe (RecipientRoutes, ByteString)
-> LocalURI
-> AP.Join URIMode
-> ExceptT Text Handler (Text, Maybe (ExceptT Text Worker Text))
topicJoinF topicActor topicResource now recipHash author body mfwd luJoin join = (,Nothing) <$> do
-- Check input
recipKey <- decodeKeyHashid404 recipHash
verifyNothingE
(AP.activityCapability $ actbActivity body)
"Capability not needed"
resource <- parseJoin join
unless (resource == Left (topicResource recipKey)) $
throwE "Join's object isn't me, don't need this Join"
maybeHttp <- lift $ runDB $ do
-- Find recipient topic in DB, returning 404 if doesn't exist because
-- we're in the topic's inbox post handler
(recipActorID, recipActor) <- do
topic <- get404 recipKey
let actorID = topicActor topic
(actorID,) <$> getJust actorID
-- Insert the Join to topic's inbox
mractid <- insertToInbox now author body (actorInbox recipActor) luJoin False
for mractid $ \ joinID -> do
-- Insert Collab record to DB
insertCollab (topicResource recipKey) joinID
-- Forward the Join activity to relevant local stages,
-- and schedule delivery for unavailable remote members of
-- them
for mfwd $ \ (localRecips, sig) -> do
let recipByHash =
grantResourceLocalActor $ topicResource recipHash
sieve =
makeRecipientSet
[]
[localActorFollowers recipByHash]
forwardActivityDB
(actbBL body) localRecips sig recipActorID recipByHash
sieve joinID
-- Launch asynchronous HTTP forwarding of the Join activity
case maybeHttp of
Nothing -> return "I already have this activity in my inbox, doing nothing"
Just maybeForward -> do
traverse_ (forkWorker "topicJoinF inbox-forwarding") maybeForward
return $
case maybeForward of
Nothing -> "Inserted Collab to DB, no inbox-forwarding to do"
Just _ -> "Inserted Collab to DB and ran inbox-forwarding of the Join"
where
insertCollab topic joinID = do
collabID <- insert Collab
fulfillsID <- insert $ CollabFulfillsJoin collabID
case topic of
GrantResourceRepo repoID ->
insert_ $ CollabTopicRepo collabID repoID
GrantResourceDeck deckID ->
insert_ $ CollabTopicDeck collabID deckID
GrantResourceLoom loomID ->
insert_ $ CollabTopicLoom collabID loomID
let authorID = remoteAuthorId author
recipID <- insert $ CollabRecipRemote collabID authorID
insert_ $ CollabRecipRemoteJoin recipID fulfillsID joinID
repoJoinF
:: UTCTime
-> KeyHashid Repo
-> RemoteAuthor
-> ActivityBody
-> Maybe (RecipientRoutes, ByteString)
-> LocalURI
-> AP.Join URIMode
-> ExceptT Text Handler (Text, Maybe (ExceptT Text Worker Text))
repoJoinF = topicJoinF repoActor GrantResourceRepo
deckJoinF
:: UTCTime
-> KeyHashid Deck
-> RemoteAuthor
-> ActivityBody
-> Maybe (RecipientRoutes, ByteString)
-> LocalURI
-> AP.Join URIMode
-> ExceptT Text Handler (Text, Maybe (ExceptT Text Worker Text))
deckJoinF = topicJoinF deckActor GrantResourceDeck
loomJoinF
:: UTCTime
-> KeyHashid Loom
-> RemoteAuthor
-> ActivityBody
-> Maybe (RecipientRoutes, ByteString)
-> LocalURI
-> AP.Join URIMode
-> ExceptT Text Handler (Text, Maybe (ExceptT Text Worker Text))
loomJoinF = topicJoinF loomActor GrantResourceLoom
topicAcceptF
:: (PersistRecordBackend topic SqlBackend, ToBackendKey SqlBackend topic)
=> (topic -> ActorId)
@ -333,6 +450,14 @@ topicAcceptF topicActor topicResource now recipHash author body mfwd luAccept ac
-- Check input
acceptee <- parseAccept accept
-- Verify the capability URI is one of:
-- * Outbox item URI of a local actor, i.e. a local activity
-- * A remote URI
maybeCap <-
traverse
(nameExceptT "Accept capability" . parseActivityURI)
(AP.activityCapability $ actbActivity body)
-- Find recipient topic in DB, returning 404 if doesn't exist because
-- we're in the topic's inbox post handler
recipKey <- decodeKeyHashid404 recipHash
@ -347,55 +472,76 @@ topicAcceptF topicActor topicResource now recipHash author body mfwd luAccept ac
a <- getActivity acceptee
fromMaybeE a "Can't find acceptee in DB"
-- See if the accepted activity is an Invite to a local resource,
-- grabbing the Collab record from our DB
(fulfillsID, inviteSender) <-
case accepteeDB of
Left (actorByKey, _actorEntity, itemID) -> do
maybeSender <-
lift $ getValBy $ UniqueCollabInviterLocalInvite itemID
(,Left actorByKey) . collabInviterLocalCollab <$>
fromMaybeE maybeSender "Accepted local activity isn't an Invite I'm aware of"
Right remoteActivityID -> do
maybeSender <-
lift $ getValBy $ UniqueCollabInviterRemoteInvite remoteActivityID
CollabInviterRemote collab actorID _ <-
fromMaybeE maybeSender "Accepted remote activity isn't an Invite I'm aware of"
actor <- lift $ getJust actorID
sender <- lift $ (,remoteActorFollowers actor) <$> getRemoteActorURI actor
return (collab, Right sender)
-- See if the accepted activity is an Invite or Join to a local
-- resource, grabbing the Collab record from our DB
collab <- do
maybeCollab <-
lift $ runMaybeT $
Left <$> tryInvite accepteeDB <|>
Right <$> tryJoin accepteeDB
fromMaybeE maybeCollab "Accepted activity isn't an Invite or Join I'm aware of"
-- Find the local resource and verify it's me
CollabFulfillsInvite collabID <- lift $ getJust fulfillsID
collabID <-
lift $ case collab of
Left (fulfillsID, _) ->
collabFulfillsInviteCollab <$> getJust fulfillsID
Right (fulfillsID, _) ->
collabFulfillsJoinCollab <$> getJust fulfillsID
topic <- lift $ getCollabTopic collabID
unless (topicResource recipKey == topic) $
throwE "Accept object is an Invite for some other resource"
-- Find the Collab recipient and verify it's the sender of the Accept
recipID <- do
recip <-
lift $
requireEitherAlt
(getBy $ UniqueCollabRecipLocal collabID)
(getBy $ UniqueCollabRecipRemote collabID)
"Found Collab with no recip"
"Found Collab with multiple recips"
case recip of
Right (Entity crrid crr)
| collabRecipRemoteActor crr == remoteAuthorId author -> return crrid
_ -> throwE "Accepting an Invite whose recipient is someone else"
idsForAccept <-
case collab of
-- If accepting an Invite, find the Collab recipient and verify
-- it's the sender of the Accept
Left (fulfillsID, _) -> Left <$> do
recip <-
lift $
requireEitherAlt
(getBy $ UniqueCollabRecipLocal collabID)
(getBy $ UniqueCollabRecipRemote collabID)
"Found Collab with no recip"
"Found Collab with multiple recips"
case recip of
Right (Entity crrid crr)
| collabRecipRemoteActor crr == remoteAuthorId author -> return (fulfillsID, crrid)
_ -> throwE "Accepting an Invite whose recipient is someone else"
-- If accepting a Join, verify accepter has permission
Right (fulfillsID, _) -> Right <$> do
capID <- fromMaybeE maybeCap "No capability provided"
capability <-
case capID of
Left (capActor, _, capItem) -> return (capActor, capItem)
Right _ -> throwE "Capability is a remote URI, i.e. not authored by the local resource"
verifyCapability
capability
(Right $ remoteAuthorId author)
(topicResource recipKey)
return fulfillsID
-- Verify the Collab isn't already validated
maybeEnabled <- lift $ getBy $ UniqueCollabEnable collabID
verifyNothingE maybeEnabled "I already sent a Grant for this Invite"
verifyNothingE maybeEnabled "I already sent a Grant for this Invite/Join"
-- Record the Accept on the Collab
mractid <- lift $ insertToInbox now author body (actorInbox recipActor) luAccept False
for mractid $ \ acceptID -> do
maybeAccept <- lift $ insertUnique $ CollabRecipRemoteAccept recipID fulfillsID acceptID
unless (isNothing maybeAccept) $ do
lift $ delete acceptID
throwE "This Invite already has an Accept by recip"
case idsForAccept of
Left (fulfillsID, recipID) -> do
maybeAccept <- lift $ insertUnique $ CollabRecipRemoteAccept recipID fulfillsID acceptID
unless (isNothing maybeAccept) $ do
lift $ delete acceptID
throwE "This Invite already has an Accept by recip"
Right fulfillsID -> do
maybeAccept <- lift $ insertUnique $ CollabApproverRemote fulfillsID (remoteAuthorId author) acceptID
unless (isNothing maybeAccept) $ do
lift $ delete acceptID
throwE "This Join already has an Accept"
-- Forward the Accept activity to relevant local stages, and
-- schedule delivery for unavailable remote members of them
@ -414,8 +560,9 @@ topicAcceptF topicActor topicResource now recipHash author body mfwd luAccept ac
lift $ insert_ $ CollabEnable collabID grantID
-- Prepare a Grant activity and insert to topic's outbox
let inviterOrJoiner = either snd snd collab
(actionGrant, localRecipsGrant, remoteRecipsGrant, fwdHostsGrant) <-
lift $ prepareGrant inviteSender
lift $ prepareGrant inviterOrJoiner
let recipByKey = grantResourceLocalActor $ topicResource recipKey
_luGrant <- lift $ updateOutboxItem recipByKey grantID actionGrant
@ -440,6 +587,31 @@ topicAcceptF topicActor topicResource now recipHash author body mfwd luAccept ac
where
tryInvite (Left (actorByKey, _actorEntity, itemID)) =
(,Left actorByKey) . collabInviterLocalCollab <$>
MaybeT (getValBy $ UniqueCollabInviterLocalInvite itemID)
tryInvite (Right remoteActivityID) = do
CollabInviterRemote collab actorID _ <-
MaybeT $ getValBy $
UniqueCollabInviterRemoteInvite remoteActivityID
actor <- lift $ getJust actorID
sender <-
lift $ (,remoteActorFollowers actor) <$> getRemoteActorURI actor
return (collab, Right sender)
tryJoin (Left (actorByKey, _actorEntity, itemID)) =
(,Left actorByKey) . collabRecipLocalJoinFulfills <$>
MaybeT (getValBy $ UniqueCollabRecipLocalJoinJoin itemID)
tryJoin (Right remoteActivityID) = do
CollabRecipRemoteJoin recipID fulfillsID _ <-
MaybeT $ getValBy $
UniqueCollabRecipRemoteJoinJoin remoteActivityID
remoteActorID <- lift $ collabRecipRemoteActor <$> getJust recipID
actor <- lift $ getJust remoteActorID
joiner <-
lift $ (,remoteActorFollowers actor) <$> getRemoteActorURI actor
return (fulfillsID, Right joiner)
prepareGrant sender = do
encodeRouteHome <- getEncodeRouteHome

11
src/Vervis/Handler/Deck.hs
View file

@ -201,6 +201,8 @@ postDeckInboxR recipDeckHash =
deckFollowF now recipDeckHash author body mfwd luActivity follow
AP.InviteActivity invite ->
topicInviteF now (GrantResourceDeck recipDeckHash) author body mfwd luActivity invite
AP.JoinActivity join ->
deckJoinF now recipDeckHash author body mfwd luActivity join
OfferActivity (Offer obj target) ->
case obj of
OfferTicket ticket ->
@ -404,7 +406,7 @@ getDeckStampR = servePerActorKey deckActor LocalActorDeck
getDeckCollabsR :: KeyHashid Deck -> Handler Html
getDeckCollabsR deckHash = do
deckID <- decodeKeyHashid404 deckHash
(deck, actor, collabs, invites) <- runDB $ do
(deck, actor, collabs, invites, joins) <- runDB $ do
deck <- get404 deckID
actor <- getJust $ deckActor deck
collabs <- do
@ -418,7 +420,12 @@ getDeckCollabsR deckHash = do
<$> (getPersonWidgetInfo =<< bitraverse grabPerson pure inviter)
<*> getPersonWidgetInfo recip
<*> pure time
return (deck, actor, collabs, invites)
joins <- do
joins' <-
getTopicJoins CollabTopicDeckCollab CollabTopicDeckDeck deckID
for joins' $ \ (recip, time) ->
(,time) <$> getPersonWidgetInfo recip
return (deck, actor, collabs, invites, joins)
defaultLayout $(widgetFile "deck/collab/list")
where
grabPerson actorID = do

2
src/Vervis/Handler/Loom.hs
View file

@ -164,6 +164,8 @@ postLoomInboxR recipLoomHash =
loomFollowF now recipLoomHash author body mfwd luActivity follow
AP.InviteActivity invite ->
topicInviteF now (GrantResourceLoom recipLoomHash) author body mfwd luActivity invite
AP.JoinActivity join ->
loomJoinF now recipLoomHash author body mfwd luActivity join
AP.OfferActivity (AP.Offer obj target) ->
case obj of
AP.OfferTicket ticket ->

2
src/Vervis/Handler/Repo.hs
View file

@ -277,6 +277,8 @@ postRepoInboxR recipRepoHash =
repoFollowF now recipRepoHash author body mfwd luActivity follow
AP.InviteActivity invite ->
topicInviteF now (GrantResourceRepo recipRepoHash) author body mfwd luActivity invite
AP.JoinActivity join ->
repoJoinF now recipRepoHash author body mfwd luActivity join
{-
OfferActivity (Offer obj target) ->
case obj of

2
src/Vervis/Migration.hs
View file

@ -2933,6 +2933,8 @@ changes hLocal ctx =
, addUnique' "CollabRecipRemoteAccept" "Invite" ["invite"]
-- 529
, removeField "Ticket" "status"
-- 530
, addEntities model_530_join
]
migrateDB

4
src/Vervis/Migration/Entities.hs
View file

@ -59,6 +59,7 @@ module Vervis.Migration.Entities
, model_494_mr_origin
, model_497_sigkey
, model_508_invite
, model_530_join
)
where
@ -231,3 +232,6 @@ model_497_sigkey = $(schema "497_2022-09-29_sigkey")
model_508_invite :: [Entity SqlBackend]
model_508_invite = $(schema "508_2022-10-19_invite")
model_530_join :: [Entity SqlBackend]
model_530_join = $(schema "530_2022-11-01_join")

51
src/Vervis/Persist/Collab.hs
View file

@ -18,6 +18,7 @@ module Vervis.Persist.Collab
, getGrantRecip
, getTopicGrants
, getTopicInvites
, getTopicJoins
)
where
@ -150,3 +151,53 @@ getTopicInvites topicCollabField topicActorField resourceID =
(Just _, Just _) -> error "Multi recip"
, time
)
getTopicJoins
:: ( MonadIO m
, PersistRecordBackend topic SqlBackend
, PersistRecordBackend resource SqlBackend
)
=> EntityField topic CollabId
-> EntityField topic (Key resource)
-> Key resource
-> ReaderT SqlBackend m [(Either PersonId RemoteActorId, UTCTime)]
getTopicJoins topicCollabField topicActorField resourceID =
fmap (map adapt) $
E.select $ E.from $
\ (topic `E.LeftOuterJoin` enable `E.InnerJoin` fulfills
`E.LeftOuterJoin` (joinL `E.InnerJoin` recipL `E.InnerJoin` item)
`E.LeftOuterJoin` (joinR `E.InnerJoin` recipR `E.InnerJoin` activity)
) -> do
E.on $ joinR E.?. CollabRecipRemoteJoinJoin E.==. activity E.?. RemoteActivityId
E.on $ joinR E.?. CollabRecipRemoteJoinCollab E.==. recipR E.?. CollabRecipRemoteId
E.on $ E.just (fulfills E.^. CollabFulfillsJoinId) E.==. joinR E.?. CollabRecipRemoteJoinFulfills
E.on $ joinL E.?. CollabRecipLocalJoinJoin E.==. item E.?. OutboxItemId
E.on $ joinL E.?. CollabRecipLocalJoinCollab E.==. recipL E.?. CollabRecipLocalId
E.on $ E.just (fulfills E.^. CollabFulfillsJoinId) E.==. joinL E.?. CollabRecipLocalJoinFulfills
E.on $ topic E.^. topicCollabField E.==. fulfills E.^. CollabFulfillsJoinCollab
E.on $ E.just (topic E.^. topicCollabField) E.==. enable E.?. CollabEnableCollab
E.where_ $
topic E.^. topicActorField E.==. E.val resourceID E.&&.
E.isNothing (enable E.?. CollabEnableId)
E.orderBy [E.asc $ fulfills E.^. CollabFulfillsJoinId]
return
( recipL E.?. CollabRecipLocalPerson
, item E.?. OutboxItemPublished
, recipR E.?. CollabRecipRemoteActor
, activity E.?. RemoteActivityReceived
)
where
adapt (E.Value recipL, E.Value timeL, E.Value recipR, E.Value timeR) =
let l = case (recipL, timeL) of
(Nothing, Nothing) -> Nothing
(Just r, Just t) -> Just (r, t)
_ -> error "Impossible"
r = case (recipR, timeR) of
(Nothing, Nothing) -> Nothing
(Just r, Just t) -> Just (r, t)
_ -> error "Impossible"
in case (l, r) of
(Nothing, Nothing) -> error "No recip"
(Just (personID, time), Nothing) -> (Left personID, time)
(Nothing, Just (remoteActorID, time)) -> (Right remoteActorID, time)
(Just _, Just _) -> error "Multi recip"

21
src/Web/ActivityPub.hs
View file

@ -70,6 +70,7 @@ module Web.ActivityPub
, Follow (..)
, Grant (..)
, Invite (..)
, Join (..)
, OfferObject (..)
, Offer (..)
, Push (..)
@ -1568,6 +1569,22 @@ encodeInvite (Invite obj context target)
<> "context" .= context
<> "target" .= target
data Join u = Join
{ joinInstrument :: Either Role (ObjURI u)
, joinObject :: ObjURI u
}
parseJoin :: UriMode u => Object -> Parser (Join u)
parseJoin o =
Join
<$> o .:+ "instrument"
<*> o .: "object"
encodeJoin :: UriMode u => Join u -> Series
encodeJoin (Join obj context)
= "object" .=+ obj
<> "context" .= context
data OfferObject u = OfferTicket (Ticket u) | OfferDep (TicketDependency u)
instance ActivityPub OfferObject where
@ -1688,6 +1705,7 @@ data SpecificActivity u
| FollowActivity (Follow u)
| GrantActivity (Grant u)
| InviteActivity (Invite u)
| JoinActivity (Join u)
| OfferActivity (Offer u)
| PushActivity (Push u)
| RejectActivity (Reject u)
@ -1745,6 +1763,7 @@ instance ActivityPub Activity where
"Follow" -> FollowActivity <$> parseFollow o
"Grant" -> GrantActivity <$> parseGrant o
"Invite" -> InviteActivity <$> parseInvite o
"Join" -> JoinActivity <$> parseJoin o
"Offer" -> OfferActivity <$> parseOffer o a actor
"Push" -> PushActivity <$> parsePush a o
"Reject" -> RejectActivity <$> parseReject o
@ -1771,6 +1790,7 @@ instance ActivityPub Activity where
activityType (FollowActivity _) = "Follow"
activityType (GrantActivity _) = "Grant"
activityType (InviteActivity _) = "Invite"
activityType (JoinActivity _) = "Join"
activityType (OfferActivity _) = "Offer"
activityType (PushActivity _) = "Push"
activityType (RejectActivity _) = "Reject"
@ -1783,6 +1803,7 @@ instance ActivityPub Activity where
encodeSpecific _ _ (FollowActivity a) = encodeFollow a
encodeSpecific _ _ (GrantActivity a) = encodeGrant a
encodeSpecific _ _ (InviteActivity a) = encodeInvite a
encodeSpecific _ _ (JoinActivity a) = encodeJoin a
encodeSpecific h u (OfferActivity a) = encodeOffer h u a
encodeSpecific h _ (PushActivity a) = encodePush h a
encodeSpecific _ _ (RejectActivity a) = encodeReject a

13
templates/deck/collab/list.hamlet
View file

@ -42,4 +42,17 @@ $# <http://creativecommons.org/publicdomain/zero/1.0/>.
<td>Admin
<td>#{showDate time}
<h2>Joins
<table>
<tr>
<th>Joiner
<th>Role
<th>Time
$forall (joiner, time) <- joins
<tr>
<td>^{personLinkFedW joiner}
<td>Admin
<td>#{showDate time}
$# <a href=@{ProjectDevNewR shr prj}>Add…

38
th/models
View file

@ -612,6 +612,44 @@ CollabInviterRemote
UniqueCollabInviterRemote collab
UniqueCollabInviterRemoteInvite invite
CollabFulfillsJoin
collab CollabId
UniqueCollabFulfillsJoin collab
CollabApproverLocal
collab CollabFulfillsJoinId
accept OutboxItemId
UniqueCollabApproverLocal collab
UniqueCollabApproverLocalAccept accept
CollabApproverRemote
collab CollabFulfillsJoinId
actor RemoteActorId
accept RemoteActivityId
UniqueCollabApproverRemote collab
UniqueCollabApproverRemoteAccept accept
CollabRecipLocalJoin
collab CollabRecipLocalId
fulfills CollabFulfillsJoinId
join OutboxItemId
UniqueCollabRecipLocalJoinCollab collab
UniqueCollabRecipLocalJoinFulfills fulfills
UniqueCollabRecipLocalJoinJoin join
CollabRecipRemoteJoin
collab CollabRecipRemoteId
fulfills CollabFulfillsJoinId
join RemoteActivityId
UniqueCollabRecipRemoteJoinCollab collab
UniqueCollabRecipRemoteJoinFulfills fulfills
UniqueCollabRecipRemoteJoinJoin join
-------------------------------- Collab topic --------------------------------
-- Removed for now, until I figure out whether/how to federate custom roles