From 29e7581b19a13dcd7195da029a7c07487e9a2de7 Mon Sep 17 00:00:00 2001 From: Pere Lev Date: Sat, 27 Apr 2024 22:46:37 +0300 Subject: [PATCH] DB: Give each actor a secondary inbox, for collecting errors --- migrations/625_2024-04-27_errbox.model | 18 +++++++++++ src/Vervis/Actor/Person/Client.hs | 45 ++++---------------------- src/Vervis/Foundation.hs | 2 ++ src/Vervis/Migration.hs | 14 ++++++++ src/Vervis/Migration/Model2024.hs | 3 ++ src/Vervis/Persist/Actor.hs | 2 ++ th/models | 1 + 7 files changed, 46 insertions(+), 39 deletions(-) create mode 100644 migrations/625_2024-04-27_errbox.model diff --git a/migrations/625_2024-04-27_errbox.model b/migrations/625_2024-04-27_errbox.model new file mode 100644 index 0000000..71d57fc --- /dev/null +++ b/migrations/625_2024-04-27_errbox.model @@ -0,0 +1,18 @@ +Outbox +FollowerSet + +Inbox + +Actor + name Text + desc Text + createdAt UTCTime + inbox InboxId + outbox OutboxId + followers FollowerSetId + justCreatedBy ActorId Maybe + errbox InboxId + + UniqueActorInbox inbox + UniqueActorOutbox outbox + UniqueActorFollowers followers diff --git a/src/Vervis/Actor/Person/Client.hs b/src/Vervis/Actor/Person/Client.hs index d46a8c0..d9b0e1d 100644 --- a/src/Vervis/Actor/Person/Client.hs +++ b/src/Vervis/Actor/Person/Client.hs @@ -460,18 +460,7 @@ clientCreateDeck now personMeID (ClientMsg maybeCap localRecips remoteRecips fwd entityKey <$> fromMaybeE mw "Can't find a workflow" insertDeck now name msummary obiidCreate wid actorMeID = do - ibid <- insert Inbox - obid <- insert Outbox - fsid <- insert FollowerSet - aid <- insert Actor - { actorName = name - , actorDesc = fromMaybe "" msummary - , actorCreatedAt = now - , actorInbox = ibid - , actorOutbox = obid - , actorFollowers = fsid - , actorJustCreatedBy = Just actorMeID - } + Entity aid a <- insertActor now name (fromMaybe "" msummary) (Just actorMeID) rid <- insert $ Resource aid did <- insert Deck { deckActor = aid @@ -481,7 +470,7 @@ clientCreateDeck now personMeID (ClientMsg maybeCap localRecips remoteRecips fwd , deckWiki = Nothing , deckCreate = obiidCreate } - return (did, rid, fsid) + return (did, rid, actorFollowers a) prepareCreate name msummary deckHash = do encodeRouteLocal <- getEncodeRouteLocal @@ -629,25 +618,14 @@ clientCreateProject now personMeID (ClientMsg maybeCap localRecips remoteRecips return (name, msummary) insertProject now name msummary obiidCreate actorMeID = do - ibid <- insert Inbox - obid <- insert Outbox - fsid <- insert FollowerSet - aid <- insert Actor - { actorName = name - , actorDesc = fromMaybe "" msummary - , actorCreatedAt = now - , actorInbox = ibid - , actorOutbox = obid - , actorFollowers = fsid - , actorJustCreatedBy = Just actorMeID - } + Entity aid a <- insertActor now name (fromMaybe "" msummary) (Just actorMeID) rid <- insert $ Resource aid did <- insert Project { projectActor = aid , projectResource = rid , projectCreate = obiidCreate } - return (did, rid, fsid) + return (did, rid, actorFollowers a) prepareCreate name msummary projectHash = do encodeRouteLocal <- getEncodeRouteLocal @@ -795,25 +773,14 @@ clientCreateTeam now personMeID (ClientMsg maybeCap localRecips remoteRecips fwd return (name, msummary) insertTeam now name msummary obiidCreate actorMeID = do - ibid <- insert Inbox - obid <- insert Outbox - fsid <- insert FollowerSet - aid <- insert Actor - { actorName = name - , actorDesc = fromMaybe "" msummary - , actorCreatedAt = now - , actorInbox = ibid - , actorOutbox = obid - , actorFollowers = fsid - , actorJustCreatedBy = Just actorMeID - } + Entity aid a <- insertActor now name (fromMaybe "" msummary) (Just actorMeID) rid <- insert $ Resource aid gid <- insert Group { groupActor = aid , groupResource = rid , groupCreate = obiidCreate } - return (gid, rid, fsid) + return (gid, rid, actorFollowers a) prepareCreate name msummary groupHash = do encodeRouteLocal <- getEncodeRouteLocal diff --git a/src/Vervis/Foundation.hs b/src/Vervis/Foundation.hs index b6a897a..62fa8d4 100644 --- a/src/Vervis/Foundation.hs +++ b/src/Vervis/Foundation.hs @@ -663,6 +663,7 @@ instance AccountDB AccountPersistDB' where addNewUser name email key pwd = AccountPersistDB' $ runDB $ do now <- liftIO getCurrentTime ibid <- insert Inbox + rbid <- insert Inbox obid <- insert Outbox fsid <- insert FollowerSet let actor = Actor @@ -673,6 +674,7 @@ instance AccountDB AccountPersistDB' where , actorOutbox = obid , actorFollowers = fsid , actorJustCreatedBy = Nothing + , actorErrbox = rbid } aid <- insert actor let defTime = UTCTime (ModifiedJulianDay 0) 0 diff --git a/src/Vervis/Migration.hs b/src/Vervis/Migration.hs index c183bf1..15115e8 100644 --- a/src/Vervis/Migration.hs +++ b/src/Vervis/Migration.hs @@ -3604,6 +3604,20 @@ changes hLocal ctx = , removeEntity "CollabTopicGroup" -- 624 , addFieldPrimRequired "InboxItem" T.empty "result" + -- 625 + , addFieldRefRequired'' + "Actor" + (insertEntity Inbox625) + (Just $ \ (Entity tempInboxID Inbox625) -> do + l <- selectKeysList [] [] + for_ l $ \ k -> do + inboxID <- insert Inbox625 + update k [Actor625Errbox =. inboxID] + + delete tempInboxID + ) + "errbox" + "Inbox" ] migrateDB diff --git a/src/Vervis/Migration/Model2024.hs b/src/Vervis/Migration/Model2024.hs index 550483e..e49bbcd 100644 --- a/src/Vervis/Migration/Model2024.hs +++ b/src/Vervis/Migration/Model2024.hs @@ -66,3 +66,6 @@ makeEntitiesMigration "604" makeEntitiesMigration "611" $(modelFile "migrations/611_2024-04-20_permit_resource.model") + +makeEntitiesMigration "625" + $(modelFile "migrations/625_2024-04-27_errbox.model") diff --git a/src/Vervis/Persist/Actor.hs b/src/Vervis/Persist/Actor.hs index 3f2d8df..a9b0a67 100644 --- a/src/Vervis/Persist/Actor.hs +++ b/src/Vervis/Persist/Actor.hs @@ -211,6 +211,7 @@ getRemoteActivityURI act = do insertActor now name desc mby = do ibid <- insert Inbox + rbid <- insert Inbox obid <- insert Outbox fsid <- insert FollowerSet let actor = Actor @@ -221,6 +222,7 @@ insertActor now name desc mby = do , actorOutbox = obid , actorFollowers = fsid , actorJustCreatedBy = mby + , actorErrbox = rbid } actorID <- insert actor return $ Entity actorID actor diff --git a/th/models b/th/models index 1c3c06d..35490b0 100644 --- a/th/models +++ b/th/models @@ -121,6 +121,7 @@ Actor outbox OutboxId followers FollowerSetId justCreatedBy ActorId Maybe + errbox InboxId UniqueActorInbox inbox UniqueActorOutbox outbox