diff --git a/src/Vervis/API.hs b/src/Vervis/API.hs index b7d9d49..61d7dcd 100644 --- a/src/Vervis/API.hs +++ b/src/Vervis/API.hs @@ -1036,16 +1036,17 @@ verifyProjectRecip (Left (WITRepo shr rp _ _ _)) localRecips = createTicketTrackerC :: Entity Person + -> Actor -> Maybe TextHtml -> Audience URIMode -> AP.ActorDetail + -> Maybe (Host, AP.ActorLocal URIMode) -> Maybe FedURI -> ExceptT Text Handler OutboxItemId -createTicketTrackerC (Entity pidUser personUser) summary audience tracker muTarget = do - error "Temporarily disabled" +createTicketTrackerC (Entity pidUser personUser) senderActor summary audience tracker mlocal muTarget = do -{- -- Check input + verifyNothingE mlocal "'id' not allowed in new TicketTracker to create" (name, msummary) <- parseTracker tracker senderHash <- encodeKeyHashid pidUser now <- liftIO getCurrentTime @@ -1056,14 +1057,14 @@ createTicketTrackerC (Entity pidUser personUser) summary audience tracker muTarg checkFederation remoteRecips (obiid, deliverHttpCreate, deliverHttpGrant) <- runDBExcept $ do - -- Insert new project to DB - obiidCreate <- lift $ insertEmptyOutboxItem (personOutbox personUser) now - wid <- findWorkflow $ personIdent personUser - (jid, obidDeck, ibidDeck) <- lift $ insertDeck now name msummary obiidCreate wid + -- Insert new deck to DB + obiidCreate <- lift $ insertEmptyOutboxItem (actorOutbox senderActor) now + wid <- findWorkflow + (jid, obidDeck, ibidDeck, aidDeck, fsidDeck) <- lift $ insertDeck now name msummary obiidCreate wid -- Insert the Create activity to author's outbox deckHash <- encodeKeyHashid jid - docCreate <- lift $ insertCreateToOutbox shrUser now blinded name msummary obiidCreate deckHash + docCreate <- lift $ insertCreateToOutbox senderHash now blinded name msummary obiidCreate deckHash -- Deliver the Create activity to local recipients, and schedule -- delivery for unavailable remote recipients @@ -1071,16 +1072,16 @@ createTicketTrackerC (Entity pidUser personUser) summary audience tracker muTarg let sieve = makeRecipientSet [] [LocalStagePersonFollowers senderHash] moreRemoteRecips <- - lift $ deliverLocal' True (LocalActorPerson senderHash) (personInbox personUser) obiidCreate $ + lift $ deliverLocal' True (LocalActorPerson senderHash) (personActor personUser) obiidCreate $ localRecipSieve sieve False localRecips checkFederation moreRemoteRecips lift $ deliverRemoteDB'' fwdHosts obiidCreate remoteRecips moreRemoteRecips - -- Insert collaboration access for project's creator + -- Insert collaboration access for deck's creator obiidGrant <- lift $ insertEmptyOutboxItem obidDeck now lift $ insertCollab jid obiidGrant - -- Insert a Grant activity to project's outbox + -- Insert a Grant activity to deck's outbox let grantRecipActors = [LocalActorPerson senderHash] grantRecipStages = [LocalStagePersonFollowers senderHash] docGrant <- @@ -1090,11 +1091,29 @@ createTicketTrackerC (Entity pidUser personUser) summary audience tracker muTarg -- delivery for unavailable remote recipients remoteRecipsHttpGrant <- do remoteRecips <- - lift $ deliverLocal' True (LocalActorDeck shrUser deckHash) ibidDeck obiidGrant $ + lift $ deliverLocal' True (LocalActorDeck deckHash) aidDeck obiidGrant $ makeRecipientSet grantRecipActors grantRecipStages checkFederation remoteRecips lift $ deliverRemoteDB'' [] obiidGrant [] remoteRecips + -- Insert follow record + obiidFollow <- lift $ insertEmptyOutboxItem (actorOutbox senderActor) now + obiidAccept <- lift $ insertEmptyOutboxItem obidDeck now + lift $ insert_ $ Follow (personActor personUser) fsidDeck True obiidFollow obiidAccept + + -- Insert a Follow activity to sender's outbox, and an Accept to the + -- deck's outbox + luFollow <- lift $ insertFollowToOutbox senderHash deckHash obiidFollow + lift $ insertAcceptToOutbox senderHash deckHash obiidAccept luFollow + + -- Deliver the Follow and Accept by simply manually inserting them to + -- deck and sender inboxes respectively + lift $ do + ibiidF <- insert $ InboxItem False + insert_ $ InboxItemLocal ibidDeck obiidFollow ibiidF + ibiidA <- insert $ InboxItem False + insert_ $ InboxItemLocal (actorInbox senderActor) obiidAccept ibiidA + -- Return instructions for HTTP delivery to remote recipients return ( obiidCreate @@ -1117,7 +1136,7 @@ createTicketTrackerC (Entity pidUser personUser) summary audience tracker muTarg return (name, msummary) findWorkflow = do - mw <- lift $ selectFirst ([] :: Filter Workflow) [] + mw <- lift $ selectFirst ([] :: [Filter Workflow]) [] entityKey <$> fromMaybeE mw "Can't find a workflow" insertDeck now name msummary obiidCreate wid = do @@ -1141,7 +1160,7 @@ createTicketTrackerC (Entity pidUser personUser) summary audience tracker muTarg , deckCollabUser = Nothing , deckCreate = obiidCreate } - return (did, obid, ibid) + return (did, obid, ibid, aid, fsid) insertCreateToOutbox senderHash now blinded name msummary obiidCreate deckHash = do encodeRouteLocal <- getEncodeRouteLocal @@ -1176,9 +1195,9 @@ createTicketTrackerC (Entity pidUser personUser) summary audience tracker muTarg update obiidCreate [OutboxItemActivity =. persistJSONObjectFromDoc create] return create - insertCollab jid obiidGrant = do + insertCollab did obiidGrant = do cid <- insert Collab - insert_ $ CollabTopicLocalProject cid jid + insert_ $ CollabTopicLocalDeck cid did insert_ $ CollabSenderLocal cid obiidGrant insert_ $ CollabRecipLocal cid pidUser insert_ $ CollabFulfillsLocalTopicCreation cid @@ -1210,7 +1229,50 @@ createTicketTrackerC (Entity pidUser personUser) summary audience tracker muTarg } update obiidGrant [OutboxItemActivity =. persistJSONObjectFromDoc grant] return grant --} + + insertFollowToOutbox senderHash deckHash obiidFollow = do + encodeRouteLocal <- getEncodeRouteLocal + encodeRouteHome <- getEncodeRouteHome + hLocal <- asksSite siteInstanceHost + + obikhid <- encodeKeyHashid obiidFollow + let luFollow = encodeRouteLocal $ PersonOutboxItemR senderHash obikhid + recips = [encodeRouteHome $ DeckR deckHash] + doc = Doc hLocal Activity + { activityId = Just luFollow + , activityActor = encodeRouteLocal $ PersonR senderHash + , activityCapability = Nothing + , activitySummary = Nothing + , activityAudience = AP.Audience recips [] [] [] [] [] + , activitySpecific = FollowActivity AP.Follow + { AP.followObject = encodeRouteHome $ DeckR deckHash + , AP.followContext = Nothing + , AP.followHide = False + } + } + update obiidFollow [OutboxItemActivity =. persistJSONObjectFromDoc doc] + return luFollow + + insertAcceptToOutbox senderHash deckHash obiidAccept luFollow = do + hLocal <- asksSite siteInstanceHost + encodeRouteLocal <- getEncodeRouteLocal + encodeRouteHome <- getEncodeRouteHome + + obikhid <- encodeKeyHashid obiidAccept + + let recips = [encodeRouteHome $ PersonR senderHash] + doc = Doc hLocal Activity + { activityId = Just $ encodeRouteLocal $ DeckOutboxItemR deckHash obikhid + , activityActor = encodeRouteLocal $ DeckR deckHash + , activityCapability = Nothing + , activitySummary = Nothing + , activityAudience = Audience recips [] [] [] [] [] + , activitySpecific = AcceptActivity Accept + { acceptObject = ObjURI hLocal luFollow + , acceptResult = Nothing + } + } + update obiidAccept [OutboxItemActivity =. persistJSONObjectFromDoc doc] data Followee = FolloweePerson (KeyHashid Person) diff --git a/src/Vervis/Handler/Person.hs b/src/Vervis/Handler/Person.hs index 0483890..8044612 100644 --- a/src/Vervis/Handler/Person.hs +++ b/src/Vervis/Handler/Person.hs @@ -61,6 +61,7 @@ import Database.Persist.Local import Vervis.ActivityPub import Vervis.Actor import Vervis.ActorKey +import Vervis.API import Vervis.Foundation import Vervis.Model import Vervis.Model.Ident @@ -127,7 +128,9 @@ postPersonOutboxR personHash = do unless federation badMethod personID <- decodeKeyHashid404 personHash - person <- runDB $ get404 personID + (person, actor) <- runDB $ do + p <- get404 personID + (p,) <$> getJust (personActor p) verifyPermission personID verifyContentTypeAP @@ -138,7 +141,7 @@ postPersonOutboxR personHash = do result <- runExceptT $ do verifyAttribution $ AP.activityActor activity - handle (Entity personID person) activity + handle (Entity personID person) actor activity case result of Left err -> invalidArgs [err] Right outboxItemID -> do @@ -157,8 +160,17 @@ postPersonOutboxR personHash = do Just (PersonR actorHash) | actorHash == personHash -> return () _ -> throwE "Can't post activity attributed to someone else" - handle eperson (AP.Activity _mid actor mcap summary audience specific) = + handle eperson actorDB (AP.Activity _mid _actorAP mcap summary audience specific) = case specific of + AP.CreateActivity (AP.Create obj mtarget) -> + case obj of + {- + CreateNote _ note -> + createNoteC eperson sharer summary audience note mtarget + -} + AP.CreateTicketTracker detail mlocal -> + createTicketTrackerC eperson actorDB summary audience detail mlocal mtarget + _ -> throwE "Unsupported Create 'object' type" {- AddActivity (AP.Add obj target) -> case obj of @@ -167,13 +179,6 @@ postPersonOutboxR personHash = do _ -> throwE "Unsupported Add 'object' type" ApplyActivity apply -> applyC eperson sharer summary audience mcap apply - CreateActivity (Create obj mtarget) -> - case obj of - CreateNote _ note -> - createNoteC eperson sharer summary audience note mtarget - CreateTicket _ ticket -> - createTicketC eperson sharer summary audience ticket mtarget - _ -> throwE "Unsupported Create 'object' type" FollowActivity follow -> followC shr summary audience follow OfferActivity (Offer obj target) ->