diff --git a/config/models b/config/models index d2369e2..bef7d7a 100644 --- a/config/models +++ b/config/models @@ -455,11 +455,19 @@ Patch created UTCTime content Text -RemoteTicketDependency - ident RemoteObjectId +TicketDependencyOffer + offer InboxItemId child LocalTicketId + UniqueTicketDependencyOffer offer + +RemoteTicketDependency + ident RemoteObjectId + child LocalTicketId + accept RemoteActivityId + UniqueRemoteTicketDependency ident + UniqueRemoteTicketDependencyAccept accept LocalTicketDependency parent LocalTicketId diff --git a/migrations/2020_06_18_tdo.model b/migrations/2020_06_18_tdo.model new file mode 100644 index 0000000..0708634 --- /dev/null +++ b/migrations/2020_06_18_tdo.model @@ -0,0 +1,5 @@ +TicketDependencyOffer + offer InboxItemId + child LocalTicketId + + UniqueTicketDependencyOffer offer diff --git a/src/Vervis/Federation/Offer.hs b/src/Vervis/Federation/Offer.hs index 5cedcbc..3d3fa51 100644 --- a/src/Vervis/Federation/Offer.hs +++ b/src/Vervis/Federation/Offer.hs @@ -37,6 +37,7 @@ import Control.Monad.Trans.Except import Control.Monad.Trans.Maybe import Data.Aeson import Data.Bifunctor +import Data.Bitraversable import Data.Foldable import Data.Function import Data.List (nub, union) @@ -74,8 +75,10 @@ import Database.Persist.Local import Yesod.Persist.Local import Vervis.ActivityPub +import Vervis.ActivityPub.Recipient import Vervis.FedURI import Vervis.Federation.Auth +import Vervis.Federation.Util import Vervis.Foundation import Vervis.Model import Vervis.Model.Ident @@ -93,43 +96,38 @@ sharerAcceptF sharerAcceptF shr now author body (Accept (ObjURI hOffer luOffer) mresult) = do luAccept <- fromMaybeE (activityId $ actbActivity body) "Accept without 'id'" - lift $ runDB $ do + (localRecips, _) <- do + mrecips <- parseAudience $ activityAudience $ actbActivity body + fromMaybeE mrecips "Accept with no recipients" + msig <- checkForward $ LocalActorSharer shr + mres <- lift $ runDB $ do Entity pidRecip recip <- do sid <- getKeyBy404 $ UniqueSharer shr getBy404 $ UniquePersonIdent sid - mractid <- insertToInbox luAccept $ personInbox recip - encodeRouteLocal <- getEncodeRouteLocal - let me = localUriPath $ encodeRouteLocal $ SharerR shr - case mractid of - Nothing -> return $ "Activity already exists in inbox of " <> me - Just ractid -> do - mv <- - runMaybeT - $ Left <$> insertFollow pidRecip (personOutbox recip) ractid - <|> Right <$> updateTicket pidRecip (personOutbox recip) ractid - case mv of - Nothing -> - return $ "Activity inserted to inbox of " <> me - Just (Left ()) -> - return $ "Accept received for follow request by " <> me - Just (Right ()) -> - return $ "Accept received for ticket by " <> me + mractid <- insertToInbox now author body (personInbox recip) luAccept True + for mractid $ \ ractid -> do + mv <- runMaybeT $ asum + [ insertFollow pidRecip (personOutbox recip) ractid + , updateTicket pidRecip (personOutbox recip) ractid + , insertDep msig (personInbox recip) ractid + ] + for mv $ bitraverse pure $ traverse $ \ (sig, collections) -> do + let sieve = makeRecipientSet [] collections + remoteRecips <- + insertRemoteActivityToLocalInboxes + False ractid $ + localRecipSieve' + sieve False False localRecips + (sig,) <$> deliverRemoteDB_S (actbBL body) ractid (personIdent recip) sig remoteRecips + case mres of + Nothing -> return "Activity already in my inbox" + Just Nothing -> return "Activity inserted to my inbox" + Just (Just (t, mfwd)) -> do + for_ mfwd $ \ (sig, remotes) -> do + forkWorker "sharerAcceptF inbox-forwarding" $ + deliverRemoteHTTP_S now shr (actbBL body) sig remotes + return t where - insertToInbox luAccept ibidRecip = do - let iidAuthor = remoteAuthorInstance author - roid <- - either entityKey id <$> insertBy' (RemoteObject iidAuthor luAccept) - let jsonObj = persistJSONFromBL $ actbBL body - ract = RemoteActivity roid jsonObj now - ractid <- either entityKey id <$> insertBy' ract - ibiid <- insert $ InboxItem True - mibrid <- insertUnique $ InboxItemRemote ibidRecip ractid ibiid - encodeRouteLocal <- getEncodeRouteLocal - case mibrid of - Nothing -> do - delete ibiid - return Nothing - Just _ -> return $ Just ractid insertFollow pidRecip obidRecip ractidAccept = do guard =<< hostIsLocal hOffer route <- MaybeT . pure $ decodeRouteLocal luOffer @@ -156,6 +154,7 @@ sharerAcceptF shr now author body (Accept (ObjURI hOffer luOffer) mresult) = do , followRemoteFollow = followRemoteRequestActivity frr , followRemoteAccept = ractidAccept } + return ("Accept received for my follow request", Nothing) updateTicket pidRecip obidRecip ractidAccept = do guard =<< hostIsLocal hOffer route <- MaybeT . pure $ decodeRouteLocal luOffer @@ -176,7 +175,64 @@ sharerAcceptF shr now author body (Accept (ObjURI hOffer luOffer) mresult) = do , ticketProjectRemoteAcceptAccept = True , ticketProjectRemoteAcceptResult = mresult } - return () + return ("Accept received for my ticket", Nothing) + insertDep msig ibidRecip ractidAccept = do + luResult <- MaybeT $ pure mresult + hl <- hostIsLocal hOffer + ibiidOffer <- + if hl + then do + route <- MaybeT . pure $ decodeRouteLocal luOffer + obiid <- + case route of + SharerOutboxItemR shr' obikhid -> do + obiid <- decodeKeyHashidM obikhid + obi <- MaybeT $ get obiid + p <- do + sid <- MaybeT $ getKeyBy $ UniqueSharer shr' + MaybeT $ getValBy $ UniquePersonIdent sid + guard $ personOutbox p == outboxItemOutbox obi + return obiid + _ -> MaybeT $ pure Nothing + inboxItemLocalItem <$> + MaybeT (getValBy $ UniqueInboxItemLocal ibidRecip obiid) + else do + iid <- MaybeT $ getKeyBy $ UniqueInstance hOffer + roid <- MaybeT $ getKeyBy $ UniqueRemoteObject iid luOffer + ractid <- MaybeT $ getKeyBy $ UniqueRemoteActivity roid + inboxItemRemoteItem <$> + MaybeT (getValBy $ UniqueInboxItemRemote ibidRecip ractid) + Entity tdoid tdo <- + MaybeT $ getBy $ UniqueTicketDependencyOffer ibiidOffer + let ltidChild = ticketDependencyOfferChild tdo + child <- lift $ getWorkItem ltidChild + (talid, patch) <- + case child of + WorkItemSharerTicket shr' t p | shr == shr' -> return (t, p) + _ -> MaybeT $ pure Nothing + lift $ do + delete tdoid + roidResult <- + let iid = remoteAuthorInstance author + in either entityKey id <$> + insertBy' (RemoteObject iid luResult) + insert_ RemoteTicketDependency + { remoteTicketDependencyIdent = roidResult + , remoteTicketDependencyChild = ltidChild + , remoteTicketDependencyAccept = ractidAccept + } + talkhid <- encodeKeyHashid talid + let collections = + [ let coll = + if patch + then LocalPersonCollectionSharerPatchFollowers + else LocalPersonCollectionSharerTicketFollowers + in coll shr talkhid + ] + return + ( "Inserted remote reverse ticket dep" + , (,collections) <$> msig + ) sharerRejectF :: ShrIdent @@ -192,7 +248,7 @@ sharerRejectF shr now author body (Reject (ObjURI hOffer luOffer)) = do Entity pidRecip recip <- do sid <- getKeyBy404 $ UniqueSharer shr getBy404 $ UniquePersonIdent sid - mractid <- insertToInbox luReject $ personInbox recip + mractid <- insertToInbox now author body (personInbox recip) luReject True encodeRouteLocal <- getEncodeRouteLocal let me = localUriPath $ encodeRouteLocal $ SharerR shr case mractid of @@ -205,21 +261,6 @@ sharerRejectF shr now author body (Reject (ObjURI hOffer luOffer)) = do Just () -> return $ "Reject received for follow request by " <> me where - insertToInbox luReject ibidRecip = do - let iidAuthor = remoteAuthorInstance author - roid <- - either entityKey id <$> insertBy' (RemoteObject iidAuthor luReject) - let jsonObj = persistJSONFromBL $ actbBL body - ract = RemoteActivity roid jsonObj now - ractid <- either entityKey id <$> insertBy' ract - ibiid <- insert $ InboxItem True - mibrid <- insertUnique $ InboxItemRemote ibidRecip ractid ibiid - encodeRouteLocal <- getEncodeRouteLocal - case mibrid of - Nothing -> do - delete ibiid - return Nothing - Just _ -> return $ Just ractid deleteFollow pidRecip obidRecip = runMaybeT $ do guard =<< hostIsLocal hOffer route <- MaybeT . pure $ decodeRouteLocal luOffer diff --git a/src/Vervis/Federation/Util.hs b/src/Vervis/Federation/Util.hs index fa999ac..32880e3 100644 --- a/src/Vervis/Federation/Util.hs +++ b/src/Vervis/Federation/Util.hs @@ -55,8 +55,9 @@ insertToInbox now author body ibid luAct unread = do , remoteActivityReceived = now } ibiid <- insert $ InboxItem unread - new <- isRight <$> insertBy' (InboxItemRemote ibid ractid ibiid) - return $ - if new - then Just ractid - else Nothing + mibrid <- insertUnique $ InboxItemRemote ibid ractid ibiid + case mibrid of + Nothing -> do + delete ibiid + return Nothing + Just _ -> return $ Just ractid diff --git a/src/Vervis/Migration.hs b/src/Vervis/Migration.hs index 93e385f..7a00418 100644 --- a/src/Vervis/Migration.hs +++ b/src/Vervis/Migration.hs @@ -1704,6 +1704,14 @@ changes hLocal ctx = ) "accept" "OutboxItem" + -- 267 + , addEntities model_2020_06_18 + -- 268 + , addFieldRefRequiredEmpty + "RemoteTicketDependency" "accept" "RemoteActivity" + -- 269 + , addUnique "RemoteTicketDependency" $ + Unique "UniqueRemoteTicketDependencyAccept" ["accept"] ] migrateDB diff --git a/src/Vervis/Migration/Model.hs b/src/Vervis/Migration/Model.hs index 566d0b7..17700e2 100644 --- a/src/Vervis/Migration/Model.hs +++ b/src/Vervis/Migration/Model.hs @@ -217,7 +217,6 @@ module Vervis.Migration.Model , LocalTicket263Generic (..) , LocalTicketDependency263 , LocalTicketDependency263Generic (..) - , Outbox266Generic (..) , OutboxItem266Generic (..) , LocalTicketDependency266 @@ -227,6 +226,7 @@ module Vervis.Migration.Model , TicketUnderProject266Generic (..) , TicketProjectLocal266Generic (..) , Project266Generic (..) + , model_2020_06_18 ) where @@ -442,3 +442,6 @@ makeEntitiesMigration "263" $(modelFile "migrations/2020_06_02_tdp.model") makeEntitiesMigration "266" $(modelFile "migrations/2020_06_15_td_accept.model") + +model_2020_06_18 :: [Entity SqlBackend] +model_2020_06_18 = $(schema "2020_06_18_tdo")