diff --git a/config/models b/config/models index fe9cefd..5a417d7 100644 --- a/config/models +++ b/config/models @@ -59,22 +59,22 @@ VerifKey instance InstanceId expires UTCTime Maybe public PublicVerifKey - sharer RemoteSharerId Maybe + sharer RemoteActorId Maybe UniqueVerifKey instance ident VerifKeySharedUsage key VerifKeyId - user RemoteSharerId + user RemoteActorId UniqueVerifKeySharedUsage key user -RemoteSharer +RemoteActor ident LocalURI instance InstanceId inbox LocalURI - UniqueRemoteSharer instance ident + UniqueRemoteActor instance ident Instance host Text @@ -90,7 +90,7 @@ Follow UniqueFollow person target RemoteFollow - actor RemoteSharerId + actor RemoteActorId target FollowerSetId UniqueRemoteFollow actor target @@ -273,7 +273,7 @@ LocalMessage UniqueLocalMessage rest RemoteMessage - author RemoteSharerId + author RemoteActorId instance InstanceId ident LocalURI rest MessageId diff --git a/src/Vervis/Discussion.hs b/src/Vervis/Discussion.hs index f652f03..f3761e5 100644 --- a/src/Vervis/Discussion.hs +++ b/src/Vervis/Discussion.hs @@ -59,11 +59,11 @@ getMessages getdid = runDB $ do where_ $ m ^. MessageRoot ==. val did return (m, lm ^. LocalMessageId, s) r <- select $ from $ \ (rm `InnerJoin` m `InnerJoin` rs `InnerJoin` i) -> do - on $ rs ^. RemoteSharerInstance ==. i ^. InstanceId - on $ rm ^. RemoteMessageAuthor ==. rs ^. RemoteSharerId + on $ rs ^. RemoteActorInstance ==. i ^. InstanceId + on $ rm ^. RemoteMessageAuthor ==. rs ^. RemoteActorId on $ rm ^. RemoteMessageRest ==. m ^. MessageId where_ $ m ^. MessageRoot ==. val did - return (m, i ^. InstanceHost, rs ^. RemoteSharerIdent) + return (m, i ^. InstanceHost, rs ^. RemoteActorIdent) return $ map mklocal l ++ map mkremote r where mklocal (Entity mid m, Value lmid, Entity _ s) = diff --git a/src/Vervis/Federation.hs b/src/Vervis/Federation.hs index c72afbd..30fb9c6 100644 --- a/src/Vervis/Federation.hs +++ b/src/Vervis/Federation.hs @@ -162,7 +162,7 @@ getLocalParentMessageId did shr lmid = do -- | Handle an activity that came to our inbox. Return a description of what we -- did, and whether we stored the activity or not (so that we can decide -- whether to log it for debugging). -handleInboxActivity :: Object -> Text -> InstanceId -> RemoteSharerId -> Activity -> Handler (Text, Bool) +handleInboxActivity :: Object -> Text -> InstanceId -> RemoteActorId -> Activity -> Handler (Text, Bool) handleInboxActivity raw hActor iidActor rsidActor (Activity _id _luActor audience specific) = case specific of CreateActivity (Create note) -> do @@ -372,8 +372,8 @@ handleOutboxNote host (Note mluNote luAttrib aud muParent muContext mpublished c Right (luRecip, rdid) -> do mluInbox <- runDB $ runMaybeT $ do iid <- MaybeT $ getKeyBy $ UniqueInstance hRecip - rs <- MaybeT $ getValBy $ UniqueRemoteSharer iid luRecip - return $ remoteSharerInbox rs + rs <- MaybeT $ getValBy $ UniqueRemoteActor iid luRecip + return $ remoteActorInbox rs case mluInbox of Just luInbox -> return $ l2f hRecip luInbox Nothing -> do @@ -384,7 +384,7 @@ handleOutboxNote host (Note mluNote luAttrib aud muParent muContext mpublished c Right actor -> withHostLock hRecip $ runDB $ do iid <- either entityKey id <$> insertBy (Instance hRecip) let luInbox = actorInbox actor - rsid <- either entityKey id <$> insertBy (RemoteSharer luRecip iid luInbox) + rsid <- either entityKey id <$> insertBy (RemoteActor luRecip iid luInbox) update rdid [RemoteDiscussionActor =. Just rsid, RemoteDiscussionUnlinkedActor =. Nothing] return $ l2f hRecip luInbox -- TODO based on the httpPostAP usage in postOutboxR @@ -460,7 +460,7 @@ handleOutboxNote host (Note mluNote luAttrib aud muParent muContext mpublished c {- mrs <- lift $ runDB $ runMaybeT $ do iid <- MaybeT $ getKeyBy $ UniqueInstance hRecip - MaybeT $ getBy $ UniqueRemoteSharer iid luRecip + MaybeT $ getBy $ UniqueRemoteActor iid luRecip erecip <- case mrs of Just ers -> return $ Left ers @@ -503,9 +503,9 @@ handleOutboxNote host (Note mluNote luAttrib aud muParent muContext mpublished c minb <- case eactor of Left rsid -> do rs <- lift $ getJust rsid - unless (remoteSharerInstance rs == iid && remoteSharerIdent rs == luRecip) $ + unless (remoteActorInstance rs == iid && remoteActorIdent rs == luRecip) $ throwE "Known remote context, but its actor doesn't match the new Note's recipient" - return $ Just $ remoteSharerInbox rs + return $ Just $ remoteActorInbox rs Right uActor -> do unless (uActor == l2f hRecip luRecip) $ throwE "Known remote context, but its unlinked actor doesn't match the new Note's recipient" @@ -523,7 +523,7 @@ handleOutboxNote host (Note mluNote luAttrib aud muParent muContext mpublished c mrs <- if inew then return Nothing - else getBy $ UniqueRemoteSharer iid luRecip + else getBy $ UniqueRemoteActor iid luRecip did <- insert Discussion rdid <- insert RemoteDiscussion { remoteDiscussionActor = entityKey <$> mrs @@ -535,7 +535,7 @@ handleOutboxNote host (Note mluNote luAttrib aud muParent muContext mpublished c Nothing -> Just $ l2f hRecip luRecip Just _ -> Nothing } - return (did, rdid, remoteSharerInbox . entityVal <$> mrs) + return (did, rdid, remoteActorInbox . entityVal <$> mrs) storeRemoteDiscussion :: Maybe InstanceId @@ -750,7 +750,7 @@ handleOutboxNote host (Note mluNote luAttrib aud muParent muContext mpublished c -- -- doc :: Doc Activity -- remoteRecips :: [FedURI] - -- moreRemotes :: [((InstanceId, Text), NonEmpty (RemoteSharerId, LocalURI))] + -- moreRemotes :: [((InstanceId, Text), NonEmpty (RemoteActorId, LocalURI))] return lmid where verifyNothing :: Monad m => Maybe a -> e -> ExceptT e m () @@ -999,7 +999,7 @@ handleOutboxNote host (Note mluNote luAttrib aud muParent muContext mpublished c :: OutboxItemId -> [ShrIdent] -> Maybe (SharerId, FollowerSetId) - -> ExceptT Text AppDB [((InstanceId, Text), NonEmpty (RemoteSharerId, LocalURI))] + -> ExceptT Text AppDB [((InstanceId, Text), NonEmpty (RemoteActorId, LocalURI))] deliverLocal obid recips mticket = do recipPids <- traverse getPersonId $ nub recips (morePids, remotes) <- @@ -1068,11 +1068,11 @@ handleOutboxNote host (Note mluNote luAttrib aud muParent muContext mpublished c case id_ of Left pid -> return pid Right _gid -> throwE "Local Note addresses a local group" - groupRemotes :: [(InstanceId, Text, RemoteSharerId, LocalURI)] -> [((InstanceId, Text), NonEmpty (RemoteSharerId, LocalURI))] + groupRemotes :: [(InstanceId, Text, RemoteActorId, LocalURI)] -> [((InstanceId, Text), NonEmpty (RemoteActorId, LocalURI))] groupRemotes = groupWithExtractBy ((==) `on` fst) fst snd . map toPairs where toPairs (iid, h, rsid, lu) = ((iid, h), (rsid, lu)) - getTicketTeam :: SharerId -> AppDB ([PersonId], [((InstanceId, Text), NonEmpty (RemoteSharerId, LocalURI))]) + getTicketTeam :: SharerId -> AppDB ([PersonId], [((InstanceId, Text), NonEmpty (RemoteActorId, LocalURI))]) getTicketTeam sid = do id_ <- getPersonOrGroupId sid (,[]) <$> case id_ of @@ -1080,19 +1080,19 @@ handleOutboxNote host (Note mluNote luAttrib aud muParent muContext mpublished c Right gid -> map (groupMemberPerson . entityVal) <$> selectList [GroupMemberGroup ==. gid] [] - getFollowers :: FollowerSetId -> AppDB ([PersonId], [((InstanceId, Text), NonEmpty (RemoteSharerId, LocalURI))]) + getFollowers :: FollowerSetId -> AppDB ([PersonId], [((InstanceId, Text), NonEmpty (RemoteActorId, LocalURI))]) getFollowers fsid = do local <- selectList [FollowTarget ==. fsid] [] remote <- E.select $ E.from $ \ (rf `E.InnerJoin` rs `E.InnerJoin` i) -> do - E.on $ rs E.^. RemoteSharerInstance E.==. i E.^. InstanceId - E.on $ rf E.^. RemoteFollowActor E.==. rs E.^. RemoteSharerId + E.on $ rs E.^. RemoteActorInstance E.==. i E.^. InstanceId + E.on $ rf E.^. RemoteFollowActor E.==. rs E.^. RemoteActorId E.where_ $ rf E.^. RemoteFollowTarget E.==. E.val fsid E.orderBy [E.asc $ i E.^. InstanceId] return ( i E.^. InstanceId , i E.^. InstanceHost - , rs E.^. RemoteSharerId - , rs E.^. RemoteSharerInbox + , rs E.^. RemoteActorId + , rs E.^. RemoteActorInbox ) return ( map (followPerson . entityVal) local @@ -1137,7 +1137,7 @@ handleOutboxNote host (Note mluNote luAttrib aud muParent muContext mpublished c -- (3) Insert/update reachability records for actors we suddenly succeed -- to reach -- - -- So, for each RemoteSharer, we're going to add a field 'errorSince'. + -- So, for each RemoteActor, we're going to add a field 'errorSince'. -- Its type will be Maybe UTCTime, and the meaning is: -- -- - Nothing: We haven't observed the inbox being down @@ -1145,7 +1145,7 @@ handleOutboxNote host (Note mluNote luAttrib aud muParent muContext mpublished c -- since that time all our following attempts failed too -- -- In this context, inbox error means any result that isn't a 2xx status. - deliverRemote :: Doc Activity -> [FedURI] -> [((InstanceId, Text), NonEmpty (RemoteSharerId, LocalURI))] -> Handler () + deliverRemote :: Doc Activity -> [FedURI] -> [((InstanceId, Text), NonEmpty (RemoteActorId, LocalURI))] -> Handler () deliverRemote doc recips known = runDB $ do recips' <- for (groupByHost recips) $ \ (h, lus) -> do let lus' = NE.nub lus @@ -1154,10 +1154,10 @@ handleOutboxNote host (Note mluNote luAttrib aud muParent muContext mpublished c then return ((iid, h), (Nothing, Just lus')) else do es <- for lus' $ \ lu -> do - mers <- getBy $ UniqueRemoteSharer iid lu + mers <- getBy $ UniqueRemoteActor iid lu return $ case mers of - Just (Entity rsid rs) -> Left (rsid, remoteSharerInbox rs) + Just (Entity rsid rs) -> Left (rsid, remoteActorInbox rs) Nothing -> Right lu let (newKnown, unknown) = partitionEithers $ NE.toList es return ((iid, h), (nonEmpty newKnown, nonEmpty unknown)) diff --git a/src/Vervis/Foundation.hs b/src/Vervis/Foundation.hs index f81431b..fe999d1 100644 --- a/src/Vervis/Foundation.hs +++ b/src/Vervis/Foundation.hs @@ -629,7 +629,7 @@ instance YesodRemoteActorStore App where data ActorDetail = ActorDetail { actorDetailId :: FedURI , actorDetailInstance :: InstanceId - , actorDetailSharer :: RemoteSharerId + , actorDetailSharer :: RemoteActorId } instance YesodHttpSig App where @@ -660,7 +660,7 @@ instance YesodHttpSig App where (ua, s, rsid) <- case mremote of Just (rsid, rs) -> do - let sharer = remoteSharerIdent rs + let sharer = remoteActorIdent rs for_ mluActorHeader $ \ u -> if sharer == u then return () diff --git a/src/Vervis/Handler/Discussion.hs b/src/Vervis/Handler/Discussion.hs index 7f35b68..f995724 100644 --- a/src/Vervis/Handler/Discussion.hs +++ b/src/Vervis/Handler/Discussion.hs @@ -80,9 +80,9 @@ getNode getdid mid = do return $ MessageTreeNodeLocal lmid s (Nothing, Just (Entity _rmid rm)) -> do rs <- getJust $ remoteMessageAuthor rm - i <- getJust $ remoteSharerInstance rs + i <- getJust $ remoteActorInstance rs return $ MessageTreeNodeRemote $ - l2f (instanceHost i) (remoteSharerIdent rs) + l2f (instanceHost i) (remoteActorIdent rs) return $ MessageTreeNode mid m author {- @@ -135,8 +135,8 @@ getDiscussionMessage shr lmid = selectRep $ provideAP $ runDB $ do return $ route2fed $ MessageR (sharerIdent s) lmhidParent (Nothing, Just rmParent) -> do rs <- getJust $ remoteMessageAuthor rmParent - i <- getJust $ remoteSharerInstance rs - return $ l2f (instanceHost i) (remoteSharerIdent rs) + i <- getJust $ remoteActorInstance rs + return $ l2f (instanceHost i) (remoteActorIdent rs) host <- getsYesod $ appInstanceHost . appSettings route2local <- getEncodeRouteLocal diff --git a/src/Vervis/Handler/Inbox.hs b/src/Vervis/Handler/Inbox.hs index fa970cd..6b1f798 100644 --- a/src/Vervis/Handler/Inbox.hs +++ b/src/Vervis/Handler/Inbox.hs @@ -161,7 +161,7 @@ postInboxR = do recordUsed now msg = recordActivity now $ ActivityReportUsed msg recordUnused now ct d msg = recordActivity now $ ActivityReportUnused ct (encodePretty d) msg recordError now e = recordActivity now $ ActivityReportHandlerError e - getActivity :: UTCTime -> ExceptT String Handler (ContentType, (WithValue (Doc Activity), (InstanceId, RemoteSharerId))) + getActivity :: UTCTime -> ExceptT String Handler (ContentType, (WithValue (Doc Activity), (InstanceId, RemoteActorId))) getActivity now = do contentType <- do ctypes <- lookupHeaders "Content-Type" @@ -299,7 +299,7 @@ postOutboxR shr = do Nothing -> return $ Left Nothing Just (Entity iid _) -> maybe (Left $ Just iid) Right <$> - getBy (UniqueRemoteSharer iid lto) + getBy (UniqueRemoteActor iid lto) case mrs of Left miid -> do eres <- fetchAPID manager actorId h lto @@ -319,12 +319,12 @@ postOutboxR shr = do case miid of Just iid -> return (iid, False) Nothing -> idAndNew <$> insertBy (Instance h) - let rs = RemoteSharer lto iid inbox + let rs = RemoteActor lto iid inbox if inew then insert_ rs else insertUnique_ rs return $ Just inbox - Right (Entity _rsid rs) -> return $ Just $ remoteSharerInbox rs + Right (Entity _rsid rs) -> return $ Just $ remoteActorInbox rs getActorKey :: ((ActorKey, ActorKey, Bool) -> ActorKey) -> Route App -> Handler TypedContent getActorKey choose route = selectRep $ provideAP $ do diff --git a/src/Vervis/Migration.hs b/src/Vervis/Migration.hs index b41356b..d724897 100644 --- a/src/Vervis/Migration.hs +++ b/src/Vervis/Migration.hs @@ -234,6 +234,10 @@ changes = "unlinkedParent" -- 55 , addEntities model_2019_04_11 + -- 56 + , renameEntity "RemoteSharer" "RemoteActor" + -- 57 + , renameUnique "RemoteActor" "UniqueRemoteSharer" "UniqueRemoteActor" ] migrateDB :: MonadIO m => ReaderT SqlBackend m (Either Text (Int, Int)) diff --git a/src/Vervis/RemoteActorStore.hs b/src/Vervis/RemoteActorStore.hs index 919d469..a1fbf6f 100644 --- a/src/Vervis/RemoteActorStore.hs +++ b/src/Vervis/RemoteActorStore.hs @@ -78,7 +78,7 @@ class Yesod site => YesodRemoteActorStore site where siteActorRoomMode :: site -> Maybe Int siteRejectOnMaxKeys :: site -> Bool - siteActorFetchShare :: site -> ResultShare (HandlerFor site) FedURI (Either String (Entity RemoteSharer)) InstanceId + siteActorFetchShare :: site -> ResultShare (HandlerFor site) FedURI (Either String (Entity RemoteActor)) InstanceId -- TODO this is copied from stm-2.5, remove when we upgrade LTS stateTVar :: TVar s -> (s -> (a, s)) -> STM a @@ -132,10 +132,10 @@ instanceAndActor => Text -> LocalURI -> LocalURI - -> YesodDB site (InstanceId, RemoteSharerId, Maybe Bool) + -> YesodDB site (InstanceId, RemoteActorId, Maybe Bool) instanceAndActor host luActor luInbox = do (iid, inew) <- idAndNew <$> insertBy (Instance host) - let rs = RemoteSharer luActor iid luInbox + let rs = RemoteActor luActor iid luInbox if inew then do rsid <- insert rs @@ -149,7 +149,7 @@ actorRoom , BaseBackend (YesodPersistBackend site) ~ SqlBackend ) => Int - -> RemoteSharerId + -> RemoteActorId -> YesodDB site Bool actorRoom limit rsid = do sumUpTo limit @@ -160,7 +160,7 @@ getOldUsageId :: ( PersistQueryRead (YesodPersistBackend site) , BaseBackend (YesodPersistBackend site) ~ SqlBackend ) - => RemoteSharerId + => RemoteActorId -> YesodDB site (Maybe VerifKeySharedUsageId) getOldUsageId rsid = fmap entityKey . listToMaybe <$> selectList [VerifKeySharedUsageUser ==. rsid] [Asc VerifKeySharedUsageId, LimitTo 1] @@ -168,7 +168,7 @@ getOldPersonalKeyId :: ( PersistQueryRead (YesodPersistBackend site) , BaseBackend (YesodPersistBackend site) ~ SqlBackend ) - => RemoteSharerId + => RemoteActorId -> YesodDB site (Maybe VerifKeyId) getOldPersonalKeyId rsid = fmap entityKey . listToMaybe <$> selectList [VerifKeySharer ==. Just rsid] [Asc VerifKeyExpires, Asc VerifKeyId, LimitTo 1] @@ -178,7 +178,7 @@ makeActorRoomByPersonal , BaseBackend (YesodPersistBackend site) ~ SqlBackend ) => Int - -> RemoteSharerId + -> RemoteActorId -> VerifKeyId -> YesodDB site () makeActorRoomByPersonal limit rsid vkid = do @@ -194,7 +194,7 @@ makeActorRoomByUsage , BaseBackend (YesodPersistBackend site) ~ SqlBackend ) => Int - -> RemoteSharerId + -> RemoteActorId -> VerifKeySharedUsageId -> YesodDB site () makeActorRoomByUsage limit rsid suid = do @@ -219,7 +219,7 @@ makeActorRoomForUsage , BaseBackend (YesodPersistBackend site) ~ SqlBackend ) => Int - -> RemoteSharerId + -> RemoteActorId -> YesodDB site () makeActorRoomForUsage limit rsid = do msuid <- getOldUsageId rsid @@ -243,7 +243,7 @@ makeActorRoomForPersonalKey , BaseBackend (YesodPersistBackend site) ~ SqlBackend ) => Int - -> RemoteSharerId + -> RemoteActorId -> YesodDB site () makeActorRoomForPersonalKey limit rsid = do mvkid <- getOldPersonalKeyId rsid @@ -320,7 +320,7 @@ keyListedByActorShared -> Text -> LocalURI -> LocalURI - -> ExceptT String (HandlerFor site) RemoteSharerId + -> ExceptT String (HandlerFor site) RemoteActorId keyListedByActorShared iid vkid host luKey luActor = do manager <- getsYesod getHttpManager reject <- getsYesod siteRejectOnMaxKeys @@ -329,11 +329,11 @@ 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 (RemoteSharer luActor iid luInbox) + lift $ runDB $ either entityKey id <$> insertBy (RemoteActor luActor iid luInbox) RoomModeCached m -> do eresult <- do ments <- lift $ runDB $ do - mrs <- getBy $ UniqueRemoteSharer iid luActor + mrs <- getBy $ UniqueRemoteActor iid luActor for mrs $ \ (Entity rsid _) -> (rsid,) . isJust <$> getBy (UniqueVerifKeySharedUsage vkid rsid) @@ -352,7 +352,7 @@ keyListedByActorShared iid vkid host luKey luActor = do vkExists <- isJust <$> get vkid case mrsid of Nothing -> do - rsid <- insert $ RemoteSharer luActor iid luInbox + rsid <- insert $ RemoteActor luActor iid luInbox when vkExists $ insert_ $ VerifKeySharedUsage vkid rsid return $ Right rsid Just rsid -> runExceptT $ do @@ -385,7 +385,7 @@ addVerifKey => Text -> LocalURI -> VerifKeyDetail - -> ExceptT String (YesodDB site) (InstanceId, RemoteSharerId) + -> ExceptT String (YesodDB site) (InstanceId, RemoteActorId) addVerifKey h uinb vkd = if vkdShared vkd then addSharedKey h uinb vkd @@ -452,19 +452,19 @@ actorFetchShareSettings , BaseBackend (YesodPersistBackend site) ~ SqlBackend , HasHttpManager site ) - => ResultShareSettings (HandlerFor site) FedURI (Either String (Entity RemoteSharer)) InstanceId + => ResultShareSettings (HandlerFor site) FedURI (Either String (Entity RemoteActor)) InstanceId actorFetchShareSettings = ResultShareSettings { resultShareFork = forkHandler $ \ e -> logError $ "ActorFetchShare action failed! " <> T.pack (displayException e) , resultShareAction = \ u iid -> do let (h, lu) = f2l u - mers <- runDB $ getBy $ UniqueRemoteSharer iid lu + mers <- runDB $ getBy $ UniqueRemoteActor iid lu case mers of Just ers -> return $ Right ers Nothing -> do manager <- getsYesod getHttpManager eactor <- fetchAPID manager actorId h lu for eactor $ \ actor -> runDB $ - insertEntity $ RemoteSharer lu iid (actorInbox actor) + insertEntity $ RemoteActor lu iid (actorInbox actor) } fetchRemoteActor @@ -473,9 +473,9 @@ fetchRemoteActor , BaseBackend (YesodPersistBackend site) ~ SqlBackend , YesodRemoteActorStore site ) - => InstanceId -> Text -> LocalURI -> HandlerFor site (Either String (Entity RemoteSharer)) + => InstanceId -> Text -> LocalURI -> HandlerFor site (Either String (Entity RemoteActor)) fetchRemoteActor iid host luActor = do - mers <- runDB $ getBy $ UniqueRemoteSharer iid luActor + mers <- runDB $ getBy $ UniqueRemoteActor iid luActor case mers of Just ers -> return $ Right ers Nothing -> do