From 48882d65ad3fc4b0df076668b703780a55b12af1 Mon Sep 17 00:00:00 2001
From: fr33domlover <fr33domlover@riseup.net>
Date: Fri, 17 May 2019 10:47:53 +0000
Subject: [PATCH] Allow AP C2S client to list recipients that aren't actors to
 deliver to

---
 src/Vervis/Federation.hs | 20 ++++----------------
 src/Web/ActivityPub.hs   | 35 ++++++++++++++---------------------
 2 files changed, 18 insertions(+), 37 deletions(-)

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