diff --git a/src/Vervis/Federation.hs b/src/Vervis/Federation.hs index 6cc0df2..55eef97 100644 --- a/src/Vervis/Federation.hs +++ b/src/Vervis/Federation.hs @@ -391,19 +391,6 @@ verifyHostLocal h t = do local <- hostIsLocal h unless local $ throwE t -parseAudience :: Monad m => Audience -> Text -> ExceptT Text m FedURI -parseAudience (Audience to bto cc bcc aud) t = - case toSingleton to of - Just fu - | null bto && null cc && null bcc && null aud -> - return fu - _ -> throwE t - where - toSingleton v = - case v of - [x] -> Just x - _ -> Nothing - fromMaybeE :: Monad m => Maybe a -> Text -> ExceptT Text m a fromMaybeE Nothing t = throwE t fromMaybeE (Just x) _ = return x @@ -483,7 +470,7 @@ parseParent uParent = do else return $ Right p concatRecipients :: Audience -> [FedURI] -concatRecipients (Audience to bto cc bcc gen) = concat [to, bto, cc, bcc, gen] +concatRecipients (Audience to bto cc bcc gen _) = concat [to, bto, cc, bcc, gen] getLocalParentMessageId :: DiscussionId -> ShrIdent -> LocalMessageId -> ExceptT Text AppDB MessageId getLocalParentMessageId did shr lmid = do @@ -1180,14 +1167,15 @@ handleOutboxNote host (Note mluNote luAttrib aud muParent muContext mpublished c (hContext, luContext) = f2l uContext parent <- parseParent uContext muParent local <- hostIsLocal hContext + let remotes' = remotes L.\\ audienceNonActors aud if local then do ticket <- parseContextTicket luContext shrs <- verifyTicketRecipients ticket localsSet - return (parent, shrs, Just ticket, remotes) + return (parent, shrs, Just ticket, remotes') else do shrs <- verifyOnlySharers localsSet - return (parent, shrs, Nothing, remotes) + return (parent, shrs, Nothing, remotes') where -- First step: Split into remote and local: splitRecipients :: NonEmpty FedURI -> Handler ([LocalURI], [FedURI]) diff --git a/src/Web/ActivityPub.hs b/src/Web/ActivityPub.hs index 68a54d9..4c90867 100644 --- a/src/Web/ActivityPub.hs +++ b/src/Web/ActivityPub.hs @@ -44,7 +44,6 @@ module Web.ActivityPub -- * Utilities , publicURI - , deliverTo , hActivityPubActor , provideAP , APGetError (..) @@ -329,20 +328,12 @@ instance ActivityPub Actor where <> "publicKey" `pair` encodePublicKeySet host pkeys data Audience = Audience - { audienceTo :: [FedURI] - , audienceBto :: [FedURI] - , audienceCc :: [FedURI] - , audienceBcc :: [FedURI] - , audienceGeneral :: [FedURI] - } - -deliverTo :: FedURI -> Audience -deliverTo to = Audience - { audienceTo = [to] - , audienceBto = [] - , audienceCc = [] - , audienceBcc = [] - , audienceGeneral = [] + { audienceTo :: [FedURI] + , audienceBto :: [FedURI] + , audienceCc :: [FedURI] + , audienceBcc :: [FedURI] + , audienceGeneral :: [FedURI] + , audienceNonActors :: [FedURI] } newtype AdaptAudience = AdaptAudience @@ -367,18 +358,20 @@ parseAudience o = <*> o .:& "cc" <*> o .:& "bcc" <*> o .:& "audience" + <*> o .:& (frg <> "nonActors") where obj .:& key = do l <- obj .:? key .!= [] return $ map unAdapt l encodeAudience :: Audience -> Series -encodeAudience (Audience to bto cc bcc aud) - = "to" .=% to - <> "bto" .=% bto - <> "cc" .=% cc - <> "bcc" .=% bcc - <> "audience" .=% aud +encodeAudience (Audience to bto cc bcc aud nons) + = "to" .=% to + <> "bto" .=% bto + <> "cc" .=% cc + <> "bcc" .=% bcc + <> "audience" .=% aud + <> (frg <> "nonActors") .=% nons where t .=% v = if null v