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 local <- hostIsLocal h
unless local $ throwE t 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 :: Monad m => Maybe a -> Text -> ExceptT Text m a
fromMaybeE Nothing t = throwE t fromMaybeE Nothing t = throwE t
fromMaybeE (Just x) _ = return x fromMaybeE (Just x) _ = return x
@ -483,7 +470,7 @@ parseParent uParent = do
else return $ Right p else return $ Right p
concatRecipients :: Audience -> [FedURI] 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 :: DiscussionId -> ShrIdent -> LocalMessageId -> ExceptT Text AppDB MessageId
getLocalParentMessageId did shr lmid = do getLocalParentMessageId did shr lmid = do
@ -1180,14 +1167,15 @@ handleOutboxNote host (Note mluNote luAttrib aud muParent muContext mpublished c
(hContext, luContext) = f2l uContext (hContext, luContext) = f2l uContext
parent <- parseParent uContext muParent parent <- parseParent uContext muParent
local <- hostIsLocal hContext local <- hostIsLocal hContext
let remotes' = remotes L.\\ audienceNonActors aud
if local if local
then do then do
ticket <- parseContextTicket luContext ticket <- parseContextTicket luContext
shrs <- verifyTicketRecipients ticket localsSet shrs <- verifyTicketRecipients ticket localsSet
return (parent, shrs, Just ticket, remotes) return (parent, shrs, Just ticket, remotes')
else do else do
shrs <- verifyOnlySharers localsSet shrs <- verifyOnlySharers localsSet
return (parent, shrs, Nothing, remotes) return (parent, shrs, Nothing, remotes')
where where
-- First step: Split into remote and local: -- First step: Split into remote and local:
splitRecipients :: NonEmpty FedURI -> Handler ([LocalURI], [FedURI]) splitRecipients :: NonEmpty FedURI -> Handler ([LocalURI], [FedURI])

View file

@ -44,7 +44,6 @@ module Web.ActivityPub
-- * Utilities -- * Utilities
, publicURI , publicURI
, deliverTo
, hActivityPubActor , hActivityPubActor
, provideAP , provideAP
, APGetError (..) , APGetError (..)
@ -329,20 +328,12 @@ instance ActivityPub Actor where
<> "publicKey" `pair` encodePublicKeySet host pkeys <> "publicKey" `pair` encodePublicKeySet host pkeys
data Audience = Audience data Audience = Audience
{ audienceTo :: [FedURI] { audienceTo :: [FedURI]
, audienceBto :: [FedURI] , audienceBto :: [FedURI]
, audienceCc :: [FedURI] , audienceCc :: [FedURI]
, audienceBcc :: [FedURI] , audienceBcc :: [FedURI]
, audienceGeneral :: [FedURI] , audienceGeneral :: [FedURI]
} , audienceNonActors :: [FedURI]
deliverTo :: FedURI -> Audience
deliverTo to = Audience
{ audienceTo = [to]
, audienceBto = []
, audienceCc = []
, audienceBcc = []
, audienceGeneral = []
} }
newtype AdaptAudience = AdaptAudience newtype AdaptAudience = AdaptAudience
@ -367,18 +358,20 @@ parseAudience o =
<*> o .:& "cc" <*> o .:& "cc"
<*> o .:& "bcc" <*> o .:& "bcc"
<*> o .:& "audience" <*> o .:& "audience"
<*> o .:& (frg <> "nonActors")
where where
obj .:& key = do obj .:& key = do
l <- obj .:? key .!= [] l <- obj .:? key .!= []
return $ map unAdapt l return $ map unAdapt l
encodeAudience :: Audience -> Series encodeAudience :: Audience -> Series
encodeAudience (Audience to bto cc bcc aud) encodeAudience (Audience to bto cc bcc aud nons)
= "to" .=% to = "to" .=% to
<> "bto" .=% bto <> "bto" .=% bto
<> "cc" .=% cc <> "cc" .=% cc
<> "bcc" .=% bcc <> "bcc" .=% bcc
<> "audience" .=% aud <> "audience" .=% aud
<> (frg <> "nonActors") .=% nons
where where
t .=% v = t .=% v =
if null v if null v