diff --git a/src/Vervis/Persist/Collab.hs b/src/Vervis/Persist/Collab.hs index f3a2959..be7ddd5 100644 --- a/src/Vervis/Persist/Collab.hs +++ b/src/Vervis/Persist/Collab.hs @@ -960,12 +960,57 @@ getPermitsForResource -> ReaderT SqlBackend m [ ( Either (LocalActorBy Key, OutboxItemId) FedURI , AP.Role - , Either - (LocalActorBy Key, Actor) - (Instance, RemoteObject, RemoteActor) + , Maybe + (Either + (LocalActorBy Key, Actor) + (Instance, RemoteObject, RemoteActor) + ) ) ] getPermitsForResource personID actor = do + direct <- + bitraverse + (\ resourceID -> + fmap (resourceID,) $ + E.select $ E.from $ \ (permit `E.InnerJoin` topic `E.InnerJoin` enable) -> do + E.on $ topic E.^. PermitTopicLocalId E.==. enable E.^. PermitTopicEnableLocalTopic + E.on $ permit E.^. PermitId E.==. topic E.^. PermitTopicLocalPermit + E.where_ $ + permit E.^. PermitPerson E.==. E.val personID E.&&. + topic E.^. PermitTopicLocalTopic E.==. E.val resourceID + return + ( permit E.^. PermitRole + , enable E.^. PermitTopicEnableLocalGrant + ) + ) + (\ actorID -> + E.select $ E.from $ \ (permit `E.InnerJoin` topic `E.InnerJoin` enable) -> do + E.on $ topic E.^. PermitTopicRemoteId E.==. enable E.^. PermitTopicEnableRemoteTopic + E.on $ permit E.^. PermitId E.==. topic E.^. PermitTopicRemotePermit + E.where_ $ + permit E.^. PermitPerson E.==. E.val personID E.&&. + topic E.^. PermitTopicRemoteActor E.==. E.val actorID + return + ( permit E.^. PermitRole + , enable E.^. PermitTopicEnableRemoteGrant + ) + ) + actor + directsFinal <- + case direct of + Left (resourceID, ds) -> do + lr <- getLocalResource resourceID + let la = resourceToActor lr + return $ + map + (\ (E.Value role, E.Value grantID) -> + (Left (la, grantID), role, Nothing) + ) + ds + Right ds -> for ds $ \ (E.Value role, E.Value grantID) -> do + grant <- getJust grantID + u <- getRemoteActivityURI grant + return (Right u, role, Nothing) exts <- case actor of Left resourceID -> @@ -996,34 +1041,36 @@ getPermitsForResource personID actor = do , extend E.^. PermitTopicExtendId , extend E.^. PermitTopicExtendRole ) - for exts $ \ (E.Value permitID, E.Value extendID, E.Value role) -> do - sender <- - requireEitherAlt - (getValBy $ UniquePermitTopicExtendLocal extendID) - (getValBy $ UniquePermitTopicExtendRemote extendID) - "PermitTopicExtend* neither" - "PermitTopicExtend* both" - (uExt, via) <- - case sender of - Left (PermitTopicExtendLocal _ enableID grantID) -> do - PermitTopicEnableLocal _ topicID _ <- getJust enableID - byk <- getPermitTopicLocal topicID - bye <- do - m <- getLocalResourceEntity byk - case m of - Nothing -> error "I just found this PermitTopicLocal in DB but now the specific actor ID isn't found" - Just bye -> pure bye - Resource aid <- getJust $ localResourceID bye - a <- getJust aid - let byk' = resourceToActor byk - return (Left (byk', grantID), Left (byk', a)) - Right (PermitTopicExtendRemote _ enableID grantID) -> do - PermitTopicEnableRemote _ topicID _ <- getJust enableID - PermitTopicRemote _ remoteActorID <- getJust topicID - remoteActor <- getJust remoteActorID - remoteObject <- getJust $ remoteActorIdent remoteActor - inztance <- getJust $ remoteObjectInstance remoteObject - grant <- getJust grantID - u <- getRemoteActivityURI grant - return (Right u, Right (inztance, remoteObject, remoteActor)) - return (uExt, role, via) + extsFinal <- + for exts $ \ (E.Value permitID, E.Value extendID, E.Value role) -> do + sender <- + requireEitherAlt + (getValBy $ UniquePermitTopicExtendLocal extendID) + (getValBy $ UniquePermitTopicExtendRemote extendID) + "PermitTopicExtend* neither" + "PermitTopicExtend* both" + (uExt, via) <- + case sender of + Left (PermitTopicExtendLocal _ enableID grantID) -> do + PermitTopicEnableLocal _ topicID _ <- getJust enableID + byk <- getPermitTopicLocal topicID + bye <- do + m <- getLocalResourceEntity byk + case m of + Nothing -> error "I just found this PermitTopicLocal in DB but now the specific actor ID isn't found" + Just bye -> pure bye + Resource aid <- getJust $ localResourceID bye + a <- getJust aid + let byk' = resourceToActor byk + return (Left (byk', grantID), Left (byk', a)) + Right (PermitTopicExtendRemote _ enableID grantID) -> do + PermitTopicEnableRemote _ topicID _ <- getJust enableID + PermitTopicRemote _ remoteActorID <- getJust topicID + remoteActor <- getJust remoteActorID + remoteObject <- getJust $ remoteActorIdent remoteActor + inztance <- getJust $ remoteObjectInstance remoteObject + grant <- getJust grantID + u <- getRemoteActivityURI grant + return (Right u, Right (inztance, remoteObject, remoteActor)) + return (uExt, role, Just via) + return $ directsFinal ++ extsFinal diff --git a/src/Vervis/Widget/Tracker.hs b/src/Vervis/Widget/Tracker.hs index 4a22fff..636965f 100644 --- a/src/Vervis/Widget/Tracker.hs +++ b/src/Vervis/Widget/Tracker.hs @@ -182,7 +182,11 @@ actorLinkFedW (Right (inztance, object, actor)) = personPermitsForResourceW :: [ ( Either (LocalActorBy Key, OutboxItemId) FedURI , AP.Role - , Either (LocalActorBy Key, Actor) (Instance, RemoteObject, RemoteActor) + , Maybe + (Either + (LocalActorBy Key, Actor) + (Instance, RemoteObject, RemoteActor) + ) ) ] -> Widget @@ -194,7 +198,7 @@ personPermitsForResourceW permits = do [whamlet|