forge/Vervis
1
0
Fork 0
Code Pull requests Activity

Rename RemoteSharer entity to RemoteActor

Browse source
This commit is contained in:
fr33domlover 2019-04-12 00:56:27 +00:00
parent 7621c0280a
commit 3f9364e4aa
8 changed files with 65 additions and 61 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

12
config/models
View file

@ -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

6
src/Vervis/Discussion.hs
View file

@ -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) =

44
src/Vervis/Federation.hs
View file

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

4
src/Vervis/Foundation.hs
View file

@ -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 ()

8
src/Vervis/Handler/Discussion.hs
View file

@ -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

8
src/Vervis/Handler/Inbox.hs
View file

@ -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

4
src/Vervis/Migration.hs
View file

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

40
src/Vervis/RemoteActorStore.hs
View file

@ -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