diff --git a/src/Vervis/Federation.hs b/src/Vervis/Federation.hs index 09c882a..944444e 100644 --- a/src/Vervis/Federation.hs +++ b/src/Vervis/Federation.hs @@ -431,33 +431,21 @@ handleOutboxNote host (Note mluNote luAttrib aud muParent muContext mpublished c return mid return (did, Left <$> mmidParent, Just (sid, ticketFollowers t)) Nothing -> do - (rd, rdnew) <- do + (rd, rdnew) <- lift $ do let (hContext, luContext) = f2l uContext - miid <- lift $ getKeyBy $ UniqueInstance hContext - mrd <- - case miid of - Just iid -> lift $ getValBy $ UniqueRemoteDiscussionIdent iid luContext - Nothing -> return Nothing + iid <- either entityKey id <$> insertBy' (Instance hContext) + mrd <- getValBy $ UniqueRemoteDiscussionIdent iid luContext case mrd of Just rd -> return (rd, False) - Nothing -> lift $ withHostLock hContext $ do - (iid, inew) <- - case miid of - Just i -> return (i, False) - Nothing -> idAndNew <$> insertBy (Instance hContext) - if inew - then do - did <- insert Discussion - rd <- insertRecord $ RemoteDiscussion iid luContext did - return (rd, True) - else do - mrd <- getValBy $ UniqueRemoteDiscussionIdent iid luContext - case mrd of - Just rd -> return (rd, False) - Nothing -> do - did <- insert Discussion - rd <- insertRecord $ RemoteDiscussion iid luContext did - return (rd, True) + Nothing -> do + did <- insert Discussion + let rd = RemoteDiscussion iid luContext did + erd <- insertBy' rd + case erd of + Left (Entity _ rd') -> do + delete did + return (rd', False) + Right _ -> return (rd, True) let did = remoteDiscussionDiscuss rd meparent <- for mparent $ \ parent -> case parent of diff --git a/src/Vervis/RemoteActorStore.hs b/src/Vervis/RemoteActorStore.hs index 60698b4..d4c1123 100644 --- a/src/Vervis/RemoteActorStore.hs +++ b/src/Vervis/RemoteActorStore.hs @@ -338,7 +338,7 @@ keyListedByActorShared iid vkid host luKey luActor = do RoomModeInstant -> do when reject $ throwE "Actor key storage limit is 0 and set to reject" luInbox <- actorInbox <$> ExceptT (keyListedByActor manager host luKey luActor) - lift $ runDB $ either entityKey id <$> insertBy (RemoteActor luActor iid luInbox Nothing) + lift $ runDB $ either entityKey id <$> insertBy' (RemoteActor luActor iid luInbox Nothing) RoomModeCached m -> do eresult <- do ments <- lift $ runDB $ do @@ -361,7 +361,7 @@ keyListedByActorShared iid vkid host luKey luActor = do vkExists <- isJust <$> get vkid case mrsid of Nothing -> do - rsid <- insert $ RemoteActor luActor iid luInbox Nothing + rsid <- either entityKey id <$> insertBy' (RemoteActor luActor iid luInbox Nothing) when vkExists $ insert_ $ VerifKeySharedUsage vkid rsid return $ Right rsid Just rsid -> runExceptT $ do