forge/Vervis
1
0
Fork 0
Code Pull requests Activity

DB: Avoid bulk-selecting specific-actor records

Browse source 
When looking up a specfic actor record for a given ActorId, you're pretty much
guaranteed to find the actor if it exists, because there's 1 function in the
codebase that handles this. Whenever a new actor type is added, which is a rare
event, that function gets updated.

But when mass-selecting actors using Esqueleto? Then, you need to LeftOuterJoin
by yourself on each actor type. This is both ugly and error prone, because all
those places in the codebase need to be updated when adding an actor type. The
only downside is that it means O(n) DB queries instead of O(1).

Perhaps there's some elegant way to "add" the specific-actor Joins to a given
Esqueleto query. Something to do some other time, as an optimization, if the
need arises.
This commit is contained in:
fr33domlover 2022-10-18 16:05:33 +00:00
parent 118b787416
commit 6407aaf897
1 changed files with 32 additions and 94 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

108
src/Vervis/Web/Delivery.hs
View file

@ -87,6 +87,7 @@ import Vervis.Data.Actor
import Vervis.FedURI import Vervis.FedURI
import Vervis.Foundation import Vervis.Foundation
import Vervis.Model import Vervis.Model
import Vervis.Persist.Actor
import Vervis.Recipient import Vervis.Recipient
import Vervis.RemoteActorStore import Vervis.RemoteActorStore
import Vervis.Settings import Vervis.Settings
@ -893,14 +894,6 @@ fork action = do
return False return False
Right success -> return success Right success -> return success
localActor Nothing Nothing Nothing Nothing Nothing = error "Found unused Actor"
localActor (Just p) Nothing Nothing Nothing Nothing = LocalActorPerson p
localActor Nothing (Just g) Nothing Nothing Nothing = LocalActorGroup g
localActor Nothing Nothing (Just r) Nothing Nothing = LocalActorRepo r
localActor Nothing Nothing Nothing (Just d) Nothing = LocalActorDeck d
localActor Nothing Nothing Nothing Nothing (Just l) = LocalActorLoom l
localActor _ _ _ _ _ = error "Found multiple-use Actor"
retryUnlinkedDelivery :: Worker () retryUnlinkedDelivery :: Worker ()
retryUnlinkedDelivery = do retryUnlinkedDelivery = do
now <- liftIO $ getCurrentTime now <- liftIO $ getCurrentTime
@ -909,18 +902,7 @@ retryUnlinkedDelivery = do
-- Get all unlinked deliveries which aren't running already in outbox -- Get all unlinked deliveries which aren't running already in outbox
-- post handlers -- post handlers
unlinked' <- E.select $ E.from $ unlinked' <- E.select $ E.from $
\ (udl `E.InnerJoin` obi `E.InnerJoin` a `E.InnerJoin` ura `E.InnerJoin` ro `E.InnerJoin` i `E.LeftOuterJoin` ra `E.LeftOuterJoin` rc \ (udl `E.InnerJoin` obi `E.InnerJoin` a `E.InnerJoin` ura `E.InnerJoin` ro `E.InnerJoin` i `E.LeftOuterJoin` ra `E.LeftOuterJoin` rc) -> do
`E.LeftOuterJoin` p
`E.LeftOuterJoin` g
`E.LeftOuterJoin` r
`E.LeftOuterJoin` d
`E.LeftOuterJoin` l
) -> do
E.on $ E.just (a E.^. ActorId) E.==. l E.?. LoomActor
E.on $ E.just (a E.^. ActorId) E.==. d E.?. DeckActor
E.on $ E.just (a E.^. ActorId) E.==. r E.?. RepoActor
E.on $ E.just (a E.^. ActorId) E.==. g E.?. GroupActor
E.on $ E.just (a E.^. ActorId) E.==. p E.?. PersonActor
E.on $ E.just (ro E.^. RemoteObjectId) E.==. rc E.?. RemoteCollectionIdent E.on $ E.just (ro E.^. RemoteObjectId) E.==. rc E.?. RemoteCollectionIdent
E.on $ E.just (ro E.^. RemoteObjectId) E.==. ra E.?. RemoteActorIdent E.on $ E.just (ro E.^. RemoteObjectId) E.==. ra E.?. RemoteActorIdent
E.on $ ro E.^. RemoteObjectInstance E.==. i E.^. InstanceId E.on $ ro E.^. RemoteObjectInstance E.==. i E.^. InstanceId
@ -941,23 +923,16 @@ retryUnlinkedDelivery = do
, obi E.^. OutboxItemActivity , obi E.^. OutboxItemActivity
, ra E.?. RemoteActorId , ra E.?. RemoteActorId
, rc E.?. RemoteCollectionId , rc E.?. RemoteCollectionId
, a E.^. ActorId , a E.^. ActorId
, p E.?. PersonId
, g E.?. GroupId
, r E.?. RepoId
, d E.?. DeckId
, l E.?. LoomId
) )
-- Strip the E.Value wrappers and organize the records for the -- Strip the E.Value wrappers and organize the records for the
-- filtering and grouping we'll need to do -- filtering and grouping we'll need to do
let unlinked = map adaptUnlinked unlinked' unlinked <- traverse adaptUnlinked unlinked'
-- Split into found (recipient has been reached) and lonely (recipient -- Split into found (recipient has been reached) and lonely (recipient
-- hasn't been reached -- hasn't been reached
(found, lonely) = partitionMaybes unlinked let (found, lonely) = partitionMaybes unlinked
-- Turn the found ones into linked deliveries -- Turn the found ones into linked deliveries
deleteWhere [UnlinkedDeliveryId <-. map (unlinkedID . snd) found] deleteWhere [UnlinkedDeliveryId <-. map (unlinkedID . snd) found]
@ -988,10 +963,9 @@ retryUnlinkedDelivery = do
where where
adaptUnlinked adaptUnlinked (Entity iid (Instance h), E.Value uraid, E.Value luRecip, E.Value since, E.Value udlid, E.Value obid, E.Value fwd, E.Value act, E.Value mraid, E.Value mrcid, E.Value actorID) = do
( Entity iid (Instance h), E.Value uraid, E.Value luRecip, E.Value since, E.Value udlid, E.Value obid, E.Value fwd, E.Value act, E.Value mraid, E.Value mrcid actorByKey <- getLocalActor actorID
, E.Value actorID, E.Value mp, E.Value mg, E.Value mr, E.Value md, E.Value ml return
) =
( Left <$> mraid <|> Right <$> mrcid ( Left <$> mraid <|> Right <$> mrcid
, ( ( (iid, h) , ( ( (iid, h)
, ( (uraid, luRecip) , ( (uraid, luRecip)
@ -1000,7 +974,7 @@ retryUnlinkedDelivery = do
, obid , obid
, BL.fromStrict $ persistJSONBytes act , BL.fromStrict $ persistJSONBytes act
, actorID , actorID
, localActor mp mg mr md ml , actorByKey
) )
) )
) )
@ -1073,18 +1047,7 @@ retryLinkedDelivery = do
-- Now let's grab the linked deliveries, and similarly delete old ones -- Now let's grab the linked deliveries, and similarly delete old ones
-- and return the rest for HTTP delivery. -- and return the rest for HTTP delivery.
linked <- E.select $ E.from $ linked <- E.select $ E.from $
\ (dl `E.InnerJoin` ra `E.InnerJoin` ro `E.InnerJoin` i `E.InnerJoin` obi `E.InnerJoin` a \ (dl `E.InnerJoin` ra `E.InnerJoin` ro `E.InnerJoin` i `E.InnerJoin` obi `E.InnerJoin` a) -> do
`E.LeftOuterJoin` p
`E.LeftOuterJoin` g
`E.LeftOuterJoin` r
`E.LeftOuterJoin` d
`E.LeftOuterJoin` l
) -> do
E.on $ E.just (a E.^. ActorId) E.==. l E.?. LoomActor
E.on $ E.just (a E.^. ActorId) E.==. d E.?. DeckActor
E.on $ E.just (a E.^. ActorId) E.==. r E.?. RepoActor
E.on $ E.just (a E.^. ActorId) E.==. g E.?. GroupActor
E.on $ E.just (a E.^. ActorId) E.==. p E.?. PersonActor
E.on $ obi E.^. OutboxItemOutbox E.==. a E.^. ActorOutbox E.on $ obi E.^. OutboxItemOutbox E.==. a E.^. ActorOutbox
E.on $ dl E.^. DeliveryActivity E.==. obi E.^. OutboxItemId E.on $ dl E.^. DeliveryActivity E.==. obi E.^. OutboxItemId
E.on $ ro E.^. RemoteObjectInstance E.==. i E.^. InstanceId E.on $ ro E.^. RemoteObjectInstance E.==. i E.^. InstanceId
@ -1102,19 +1065,12 @@ retryLinkedDelivery = do
, dl E.^. DeliveryId , dl E.^. DeliveryId
, dl E.^. DeliveryForwarding , dl E.^. DeliveryForwarding
, obi E.^. OutboxItemActivity , obi E.^. OutboxItemActivity
, a E.^. ActorId , a E.^. ActorId
, p E.?. PersonId
, g E.?. GroupId
, r E.?. RepoId
, d E.?. DeckId
, l E.?. LoomId
) )
dropAfter <- lift $ asksSite $ appDropDeliveryAfter . appSettings dropAfter <- lift $ asksSite $ appDropDeliveryAfter . appSettings
linked' <- traverse adaptLinked linked
let (linkedOld, linkedNew) = let (linkedOld, linkedNew) =
partitionEithers $ partitionEithers $ map (decideBySinceDL dropAfter now) linked'
map (decideBySinceDL dropAfter now . adaptLinked) linked
deleteWhere [DeliveryId <-. linkedOld] deleteWhere [DeliveryId <-. linkedOld]
return $ groupLinked linkedNew return $ groupLinked linkedNew
@ -1134,17 +1090,16 @@ retryLinkedDelivery = do
where where
adaptLinked adaptLinked (E.Value iid, E.Value h, E.Value raid, E.Value ident, E.Value inbox, E.Value since, E.Value dlid, E.Value fwd, E.Value act, E.Value actorID) = do
( E.Value iid, E.Value h, E.Value raid, E.Value ident, E.Value inbox, E.Value since, E.Value dlid, E.Value fwd, E.Value act actorByKey <- getLocalActor actorID
, E.Value actorID, E.Value mp, E.Value mg, E.Value mr, E.Value md, E.Value ml return
) =
( ( (iid, h) ( ( (iid, h)
, ( (raid, (ident, inbox)) , ( (raid, (ident, inbox))
, ( dlid , ( dlid
, fwd , fwd
, BL.fromStrict $ persistJSONBytes act , BL.fromStrict $ persistJSONBytes act
, actorID , actorID
, localActor mp mg mr md ml , actorByKey
) )
) )
) )
@ -1205,36 +1160,18 @@ retryForwarding = do
-- Same for forwarding deliveries, which are always linked -- Same for forwarding deliveries, which are always linked
forwarding <- E.select $ E.from $ forwarding <- E.select $ E.from $
\ (fw `E.InnerJoin` ra `E.InnerJoin` ro `E.InnerJoin` i \ (fw `E.InnerJoin` ra `E.InnerJoin` ro `E.InnerJoin` i) -> do
`E.LeftOuterJoin` p
`E.LeftOuterJoin` g
`E.LeftOuterJoin` r
`E.LeftOuterJoin` d
`E.LeftOuterJoin` l
) -> do
E.on $ E.just (fw E.^. ForwardingForwarder) E.==. l E.?. LoomActor
E.on $ E.just (fw E.^. ForwardingForwarder) E.==. d E.?. DeckActor
E.on $ E.just (fw E.^. ForwardingForwarder) E.==. r E.?. RepoActor
E.on $ E.just (fw E.^. ForwardingForwarder) E.==. g E.?. GroupActor
E.on $ E.just (fw E.^. ForwardingForwarder) E.==. p E.?. PersonActor
E.on $ ro E.^. RemoteObjectInstance E.==. i E.^. InstanceId E.on $ ro E.^. RemoteObjectInstance E.==. i E.^. InstanceId
E.on $ ra E.^. RemoteActorIdent E.==. ro E.^. RemoteObjectId E.on $ ra E.^. RemoteActorIdent E.==. ro E.^. RemoteObjectId
E.on $ fw E.^. ForwardingRecipient E.==. ra E.^. RemoteActorId E.on $ fw E.^. ForwardingRecipient E.==. ra E.^. RemoteActorId
E.where_ $ fw E.^. ForwardingRunning E.==. E.val False E.where_ $ fw E.^. ForwardingRunning E.==. E.val False
E.orderBy [E.asc $ ro E.^. RemoteObjectInstance, E.asc $ ra E.^. RemoteActorId] E.orderBy [E.asc $ ro E.^. RemoteObjectInstance, E.asc $ ra E.^. RemoteActorId]
return return (i, ra, fw)
(i, ra, fw
, p E.?. PersonId
, g E.?. GroupId
, r E.?. RepoId
, d E.?. DeckId
, l E.?. LoomId
)
dropAfter <- lift $ asksSite $ appDropDeliveryAfter . appSettings dropAfter <- lift $ asksSite $ appDropDeliveryAfter . appSettings
forwarding' <- traverse adaptForwarding forwarding
let (forwardingOld, forwardingNew) = let (forwardingOld, forwardingNew) =
partitionEithers $ partitionEithers $
map (decideBySinceFW dropAfter now . adaptForwarding) map (decideBySinceFW dropAfter now) forwarding'
forwarding
deleteWhere [ForwardingId <-. forwardingOld] deleteWhere [ForwardingId <-. forwardingOld]
return $ groupForwarding forwardingNew return $ groupForwarding forwardingNew
@ -1258,13 +1195,14 @@ retryForwarding = do
( Entity iid (Instance h) ( Entity iid (Instance h)
, Entity raid (RemoteActor _ _ inbox _ since) , Entity raid (RemoteActor _ _ inbox _ since)
, Entity fwid (Forwarding _ _ body sig fwderID _) , Entity fwid (Forwarding _ _ body sig fwderID _)
, E.Value mp, E.Value mg, E.Value mr, E.Value md, E.Value ml ) = do
) = actorByKey <- getLocalActor fwderID
return
( ( (iid, h) ( ( (iid, h)
, ( (raid, inbox) , ( (raid, inbox)
, ( fwid , ( fwid
, BL.fromStrict body , BL.fromStrict body
, localActor mp mg mr md ml , actorByKey
, sig , sig
, fwderID , fwderID
) )