DB: Add RemoteObject entity and use it in RemoteActivity instead of iid+lu

config/models

@@ -12,6 +12,12 @@
 -- with this software. If not, see
 -- <http://creativecommons.org/publicdomain/zero/1.0/>.
 
+RemoteObject
+    instance InstanceId
+    ident    LocalURI
+
+    UniqueRemoteObject instance ident
+
 -------------------------------------------------------------------------------
 -- People
 -------------------------------------------------------------------------------
@@ -66,12 +72,11 @@ InboxItemLocal
     UniqueInboxItemLocalItem item
 
 RemoteActivity
-    instance InstanceId
+    ident    RemoteObjectId
-    ident    LocalURI
     content  PersistJSONObject
     received UTCTime
 
-    UniqueRemoteActivity instance ident
+    UniqueRemoteActivity ident
 
 InboxItemRemote
     inbox    InboxId

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
+        roid <-
-            ract = RemoteActivity iidAuthor luCreate jsonObj now
+            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    = roid
-            , remoteActivityIdent    = luCreate
             , remoteActivityContent  = persistJSONFromBL $ actbBL body
             , remoteActivityReceived = now
             }

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
+        roid <-
-            ract = RemoteActivity iidAuthor luAccept jsonObj now
+            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
+        roid <-
-            ract = RemoteActivity iidAuthor luReject jsonObj now
+            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
+        roid <-
-            ract = RemoteActivity iidAuthor luFollow jsonObj now
+            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
+        roid <-
-            ract = RemoteActivity iidAuthor luUndo jsonObj now
+            either entityKey id <$> insertBy' (RemoteObject iidAuthor luUndo)
-        in  either entityKey id <$> insertBy' ract
+        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
+        mractidObj <- runMaybeT $ do
-        case mraidObj of
+            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
+            Just ractidObj -> do
-                merf <- getBy $ UniqueRemoteFollowFollow raidObj
+                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
+    insertToInbox ibidRecip ractid = do
-        let iidAuthor = remoteAuthorInstance author
-            jsonObj = persistJSONFromBL $ actbBL body
-            ract = RemoteActivity iidAuthor luUndo jsonObj now
         ibiid <- insert $ InboxItem False
         mibrid <- insertUnique $ InboxItemRemote ibidRecip ractid ibiid
         case mibrid of

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
+        roid <-
-            ract = RemoteActivity iidAuthor luPush jsonObj now
+            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

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
+        roid <-
-            ract = RemoteActivity iidAuthor luOffer jsonObj now
+            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    = roid
-            , remoteActivityIdent    = luOffer
             , remoteActivityContent  = persistJSONFromBL $ actbBL body
             , remoteActivityReceived = now
             }

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

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")