diff --git a/src/Vervis/Federation/Offer.hs b/src/Vervis/Federation/Offer.hs index 9419bd8..ace9f3f 100644 --- a/src/Vervis/Federation/Offer.hs +++ b/src/Vervis/Federation/Offer.hs @@ -234,11 +234,12 @@ repoRejectF shr rp = rejectF getIbid route -} followF - :: AppDB a + :: (Route App -> Maybe a) -> Route App - -> (a -> InboxId) - -> (a -> OutboxId) - -> (a -> FollowerSetId) + -> (a -> AppDB b) + -> (b -> InboxId) + -> (b -> OutboxId) + -> (b -> FollowerSetId) -> (KeyHashid OutboxItem -> Route App) -> UTCTime -> RemoteAuthor @@ -246,22 +247,23 @@ followF -> AP.Follow URIMode -> ExceptT Text Handler Text followF - getRecip recipRoute recipInbox recipOutbox recipFollowers outboxItemRoute + objRoute recipRoute getRecip recipInbox recipOutbox recipFollowers outboxItemRoute now author body (AP.Follow (ObjURI hObj luObj) hide) = do - me <- do + mobj <- do local <- hostIsLocal hObj return $ - case decodeRouteLocal luObj of - Just r | local && r == recipRoute -> True - _ -> False - if me - then do + if local + then Nothing + else objRoute =<< decodeRouteLocal luObj + case mobj of + Nothing -> return "Follow object unrelated to me, ignoring activity" + Just obj -> do luFollow <- fromMaybeE (activityId $ actbActivity body) "Follow without 'id'" emsg <- lift $ runDB $ do - recip <- getRecip + recip <- getRecip obj newItem <- insertToInbox luFollow $ recipInbox recip if newItem then do @@ -287,7 +289,6 @@ followF forkWorker "followF: Accept delivery" $ deliverRemoteHttp dont obiid doc remotesHttp return "Follow request accepted" - else return "Follow object unrelated to me, ignoring activity" where dont = Authority "dont-do.any-forwarding" Nothing @@ -357,14 +358,18 @@ sharerFollowF -> ExceptT Text Handler Text sharerFollowF shr = followF - getRecip + objRoute (SharerR shr) + getRecip personInbox personOutbox personFollowers (SharerOutboxItemR shr) where - getRecip = do + objRoute (SharerR shr') | shr == shr' = Just () + objRoute _ = Nothing + + getRecip () = do sid <- getKeyBy404 $ UniqueSharer shr getValBy404 $ UniquePersonIdent sid @@ -378,16 +383,28 @@ projectFollowF -> ExceptT Text Handler Text projectFollowF shr prj = followF - getRecip + objRoute (ProjectR shr prj) - projectInbox - projectOutbox - projectFollowers + getRecip + (projectInbox . fst) + (projectOutbox . fst) + followers (ProjectOutboxItemR shr prj) where - getRecip = do + objRoute (ProjectR shr' prj') + | shr == shr' && prj == prj' = Just Nothing + objRoute (TicketR shr' prj' num) + | shr == shr' && prj == prj' = Just $ Just num + objRoute _ = Nothing + + getRecip mnum = do sid <- getKeyBy404 $ UniqueSharer shr - getValBy404 $ UniqueProject prj sid + Entity jid j <- getBy404 $ UniqueProject prj sid + mt <- for mnum $ \ num -> getValBy404 $ UniqueTicket jid num + return (j, mt) + + followers (j, Nothing) = projectFollowers j + followers (_, Just t) = ticketFollowers t repoFollowF :: ShrIdent @@ -399,13 +416,17 @@ repoFollowF -> ExceptT Text Handler Text repoFollowF shr rp = followF - getRecip + objRoute (RepoR shr rp) + getRecip repoInbox repoOutbox repoFollowers (RepoOutboxItemR shr rp) where - getRecip = do + objRoute (RepoR shr' rp') | shr == shr' && rp == rp' = Just () + objRoute _ = Nothing + + getRecip () = do sid <- getKeyBy404 $ UniqueSharer shr getValBy404 $ UniqueRepo rp sid