Allow AP C2S client to list recipients that aren't actors to deliver to

This commit is contained in:
fr33domlover 2019-05-17 10:47:53 +00:00
parent 1f7ceada64
commit 48882d65ad
2 changed files with 18 additions and 37 deletions

View file

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

View file

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