diff --git a/config/models b/config/models index c1c03c2..8ace824 100644 --- a/config/models +++ b/config/models @@ -12,6 +12,12 @@ -- with this software. If not, see -- . +RemoteObject + instance InstanceId + ident LocalURI + + UniqueRemoteObject instance ident + ------------------------------------------------------------------------------- -- People ------------------------------------------------------------------------------- @@ -66,12 +72,11 @@ InboxItemLocal UniqueInboxItemLocalItem item RemoteActivity - instance InstanceId - ident LocalURI + ident RemoteObjectId content PersistJSONObject received UTCTime - UniqueRemoteActivity instance ident + UniqueRemoteActivity ident InboxItemRemote inbox InboxId diff --git a/src/Vervis/Federation/Discussion.hs b/src/Vervis/Federation/Discussion.hs index c1aff8d..ec622d8 100644 --- a/src/Vervis/Federation/Discussion.hs +++ b/src/Vervis/Federation/Discussion.hs @@ -144,8 +144,10 @@ sharerCreateNoteF now shrRecip author body (Note mluNote _ _ muParent muContext throwE "Remote parent belongs to a different discussion" insertToInbox luCreate ibidRecip = do let iidAuthor = remoteAuthorInstance author - jsonObj = persistJSONFromBL $ actbBL body - ract = RemoteActivity iidAuthor luCreate jsonObj now + roid <- + either entityKey id <$> insertBy' (RemoteObject iidAuthor luCreate) + 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 @@ -255,9 +257,10 @@ projectCreateNoteF now shrRecip prjRecip author body (Note mluNote _ _ muParent insertToDiscussion luCreate luNote published ibid did meparent fsid = do let iidAuthor = remoteAuthorInstance author raidAuthor = remoteAuthorId author + roid <- + either entityKey id <$> insertBy' (RemoteObject iidAuthor luCreate) ractid <- either entityKey id <$> insertBy' RemoteActivity - { remoteActivityInstance = iidAuthor - , remoteActivityIdent = luCreate + { remoteActivityIdent = roid , remoteActivityContent = persistJSONFromBL $ actbBL body , remoteActivityReceived = now } diff --git a/src/Vervis/Federation/Offer.hs b/src/Vervis/Federation/Offer.hs index 68d1294..5f5db66 100644 --- a/src/Vervis/Federation/Offer.hs +++ b/src/Vervis/Federation/Offer.hs @@ -109,8 +109,10 @@ sharerAcceptF shr now author body (Accept (ObjURI hOffer luOffer) _) = do where insertToInbox luAccept ibidRecip = do let iidAuthor = remoteAuthorInstance author - jsonObj = persistJSONFromBL $ actbBL body - ract = RemoteActivity iidAuthor luAccept jsonObj now + 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 @@ -176,8 +178,10 @@ sharerRejectF shr now author body (Reject (ObjURI hOffer luOffer)) = do where insertToInbox luReject ibidRecip = do let iidAuthor = remoteAuthorInstance author - jsonObj = persistJSONFromBL $ actbBL body - ract = RemoteActivity iidAuthor luReject jsonObj now + 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 @@ -270,8 +274,10 @@ followF insertToInbox luFollow ibidRecip = do let iidAuthor = remoteAuthorInstance author - jsonObj = persistJSONFromBL $ actbBL body - ract = RemoteActivity iidAuthor luFollow jsonObj now + roid <- + either entityKey id <$> insertBy' (RemoteObject iidAuthor luFollow) + 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 @@ -433,7 +439,7 @@ undoF case mreason of Just reason -> return $ "Not using this Undo: " <> reason Nothing -> do - inserted <- insertToInbox luUndo (recipInbox recip) ractid + inserted <- insertToInbox (recipInbox recip) ractid encodeRouteLocal <- getEncodeRouteLocal let me = localUriPath $ encodeRouteLocal recipRoute return $ @@ -441,18 +447,22 @@ undoF then "Undo applied and inserted to inbox of " <> me else "Undo applied and already exists in inbox of " <> me where - insertActivity luUndo = + insertActivity luUndo = do let iidAuthor = remoteAuthorInstance author - jsonObj = persistJSONFromBL $ actbBL body - ract = RemoteActivity iidAuthor luUndo jsonObj now - in either entityKey id <$> insertBy' ract + roid <- + either entityKey id <$> insertBy' (RemoteObject iidAuthor luUndo) + let jsonObj = persistJSONFromBL $ actbBL body + ract = RemoteActivity roid jsonObj now + either entityKey id <$> insertBy' ract deleteRemoteFollow idRecip fsidRecip = do let iidAuthor = remoteAuthorInstance author - mraidObj <- getKeyBy $ UniqueRemoteActivity iidAuthor luObj - case mraidObj of + mractidObj <- runMaybeT $ do + roid <- MaybeT $ getKeyBy $ UniqueRemoteObject iidAuthor luObj + MaybeT $ getKeyBy $ UniqueRemoteActivity roid + case mractidObj of Nothing -> return $ Just "Undo object isn't a known activity" - Just raidObj -> do - merf <- getBy $ UniqueRemoteFollowFollow raidObj + Just ractidObj -> do + merf <- getBy $ UniqueRemoteFollowFollow ractidObj case merf of Nothing -> return $ Just "Undo object doesn't match an active RemoteFollow" Just (Entity rfid rf) @@ -465,10 +475,7 @@ undoF mr <- trySubObjects idRecip (remoteFollowTarget rf) when (isNothing mr) $ delete rfid return mr - insertToInbox luUndo ibidRecip ractid = do - let iidAuthor = remoteAuthorInstance author - jsonObj = persistJSONFromBL $ actbBL body - ract = RemoteActivity iidAuthor luUndo jsonObj now + insertToInbox ibidRecip ractid = do ibiid <- insert $ InboxItem False mibrid <- insertUnique $ InboxItemRemote ibidRecip ractid ibiid case mibrid of diff --git a/src/Vervis/Federation/Push.hs b/src/Vervis/Federation/Push.hs index 6058f5b..f6b819a 100644 --- a/src/Vervis/Federation/Push.hs +++ b/src/Vervis/Federation/Push.hs @@ -98,8 +98,10 @@ sharerPushF shr now author body push = do where insertToInbox luPush ibidRecip = do let iidAuthor = remoteAuthorInstance author - jsonObj = persistJSONFromBL $ actbBL body - ract = RemoteActivity iidAuthor luPush jsonObj now + roid <- + either entityKey id <$> insertBy' (RemoteObject iidAuthor luPush) + 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 diff --git a/src/Vervis/Federation/Ticket.hs b/src/Vervis/Federation/Ticket.hs index f561428..4c76aae 100644 --- a/src/Vervis/Federation/Ticket.hs +++ b/src/Vervis/Federation/Ticket.hs @@ -120,8 +120,10 @@ sharerOfferTicketF now shrRecip author body (Offer ticket uTarget) = do -} insertToInbox luOffer ibidRecip = do let iidAuthor = remoteAuthorInstance author - jsonObj = persistJSONFromBL $ actbBL body - ract = RemoteActivity iidAuthor luOffer jsonObj now + roid <- + either entityKey id <$> insertBy' (RemoteObject iidAuthor luOffer) + 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 @@ -223,10 +225,11 @@ projectOfferTicketF _ -> Nothing insertTicket ra luOffer jid ibid {-deps-} = do let iidAuthor = remoteAuthorInstance author - raidAuthor = remoteAuthorId author + roid <- + either entityKey id <$> insertBy' (RemoteObject iidAuthor luOffer) + let raidAuthor = remoteAuthorId author ractid <- either entityKey id <$> insertBy' RemoteActivity - { remoteActivityInstance = iidAuthor - , remoteActivityIdent = luOffer + { remoteActivityIdent = roid , remoteActivityContent = persistJSONFromBL $ actbBL body , remoteActivityReceived = now } diff --git a/src/Vervis/Migration.hs b/src/Vervis/Migration.hs index 01095aa..0378fbe 100644 --- a/src/Vervis/Migration.hs +++ b/src/Vervis/Migration.hs @@ -1091,6 +1091,39 @@ changes hLocal ctx = , removeField "Follow" "manual" -- 150 , removeField "RemoteFollow" "manual" + -- 151 + , addEntities model_2019_11_04 + -- 152 + , addFieldRefRequired'' + "RemoteActivity" + (do iid <- insert $ Instance152 $ Authority "152.fake.fake" Nothing + insertEntity $ RemoteObject152 iid $ LocalURI "/fake/152" + ) + (Just $ \ (Entity roidTemp roTemp) -> do + racts <- selectList ([] :: [Filter RemoteActivity152]) [] + for_ racts $ \ (Entity ractid ract) -> do + let iid = remoteActivity152Instance ract + lu = remoteActivity152Ident ract + roid <- insert $ RemoteObject152 iid lu + update ractid [RemoteActivity152IdentNew =. roid] + delete roidTemp + delete $ remoteObject152Instance roTemp + ) + "identNew" + "RemoteObject" + -- 153 + , addUnique "RemoteActivity" $ + Unique "UniqueRemoteActivityNew" ["identNew"] + -- 154 + , removeUnique "RemoteActivity" "UniqueRemoteActivity" + -- 155 + , renameUnique "RemoteActivity" "UniqueRemoteActivityNew" "UniqueRemoteActivity" + -- 156 + , removeField "RemoteActivity" "instance" + -- 157 + , removeField "RemoteActivity" "ident" + -- 158 + , renameField "RemoteActivity" "identNew" "ident" ] migrateDB diff --git a/src/Vervis/Migration/Model.hs b/src/Vervis/Migration/Model.hs index ad7d131..fcf5410 100644 --- a/src/Vervis/Migration/Model.hs +++ b/src/Vervis/Migration/Model.hs @@ -125,6 +125,11 @@ module Vervis.Migration.Model , Outbox138Generic (..) , Repo138 , model_2019_09_25 + , model_2019_11_04 + , Instance152Generic (..) + , RemoteObject152Generic (..) + , RemoteActivity152Generic (..) + , RemoteActivity152 ) where @@ -255,3 +260,9 @@ makeEntitiesMigration "138" model_2019_09_25 :: [Entity SqlBackend] model_2019_09_25 = $(schema "2019_09_25") + +model_2019_11_04 :: [Entity SqlBackend] +model_2019_11_04 = $(schema "2019_11_04") + +makeEntitiesMigration "152" + $(modelFile "migrations/2019_11_04_remote_activity_ident.model")