Implement remote admin action: Update receipt mode

changelog.d/6-federation/receipt-mode

@@ -0,0 +1 @@
+Implement remote admin action: Update receipt mode

libs/wire-api-federation/src/Wire/API/Federation/API/Galley.hs

@@ -31,6 +31,7 @@ import Wire.API.Conversation
 import Wire.API.Conversation.Action
 import Wire.API.Conversation.Protocol
 import Wire.API.Conversation.Role (RoleName)
+import Wire.API.Error.Galley
 import Wire.API.Federation.API.Common
 import Wire.API.Federation.Endpoint
 import Wire.API.Message
@@ -57,6 +58,7 @@ type GalleyApi =
     -- this backend
     :<|> FedEndpoint "send-message" MessageSendRequest MessageSendResponse
     :<|> FedEndpoint "on-user-deleted-conversations" UserDeletedConversationsNotification EmptyResponse
+    :<|> FedEndpoint "update-conversation" ConversationUpdateRequest ConversationUpdateResponse
 
 data GetConversationsRequest = GetConversationsRequest
   { gcrUserId :: UserId,
@@ -229,3 +231,25 @@ data UserDeletedConversationsNotification = UserDeletedConversationsNotification
   deriving stock (Eq, Show, Generic)
   deriving (Arbitrary) via (GenericUniform UserDeletedConversationsNotification)
   deriving (FromJSON, ToJSON) via (CustomEncoded UserDeletedConversationsNotification)
+
+data ConversationUpdateRequest = ConversationUpdateRequest
+  { -- | The user that is attempting to perform the action. This is qualified
+    -- implicitly by the origin domain
+    curUser :: UserId,
+    -- | Id of conversation the action should be performed on. The is qualified
+    -- implicity by the owning backend which receives this request.
+    curConvId :: ConvId,
+    curAction :: SomeConversationAction
+  }
+  deriving stock (Eq, Show, Generic)
+  deriving (Arbitrary) via (GenericUniform ConversationUpdateRequest)
+  deriving (FromJSON, ToJSON) via (CustomEncoded ConversationUpdateRequest)
+
+data ConversationUpdateResponse
+  = ConversationUpdateResponseError GalleyError
+  | ConversationUpdateResponseUpdate ConversationUpdate
+  | ConversationUpdateResponseNoChanges
+  deriving stock (Eq, Show, Generic)
+  deriving
+    (ToJSON, FromJSON)
+    via (CustomEncoded ConversationUpdateResponse)

libs/wire-api-federation/src/Wire/API/Federation/Error.hs

@@ -140,6 +140,8 @@ data FederationError
     -- indicate a bug in either backend, or an incompatibility in the
     -- server-to-server API.
     FederationUnexpectedBody Text
+  | -- | Federator client got an unexpected error response from remote backend
+    FederationUnexpectedError Text
   deriving (Show, Typeable)
 
 instance Exception FederationError
@@ -152,6 +154,7 @@ federationErrorToWai FederationNotImplemented = federationNotImplemented
 federationErrorToWai FederationNotConfigured = federationNotConfigured
 federationErrorToWai (FederationCallFailure err) = federationClientErrorToWai err
 federationErrorToWai (FederationUnexpectedBody s) = federationUnexpectedBody s
+federationErrorToWai (FederationUnexpectedError t) = federationUnexpectedError t
 
 federationClientErrorToWai :: FederatorClientError -> Wai.Error
 federationClientErrorToWai (FederatorClientHTTP2Error e) =
@@ -276,6 +279,13 @@ federationUnexpectedBody msg =
     "federation-unexpected-body"
     ("Could parse body, but response was not expected: " <> LT.fromStrict msg)
 
+federationUnexpectedError :: Text -> Wai.Error
+federationUnexpectedError msg =
+  Wai.mkError
+    unexpectedFederationResponseStatus
+    "federation-unexpected-wai-error"
+    ("Could parse body, but got an unexpected error response: " <> LT.fromStrict msg)
+
 federationNotConfigured :: Wai.Error
 federationNotConfigured =
   Wai.mkError

libs/wire-api/src/Wire/API/Error/Galley.hs

@@ -14,6 +14,9 @@
 --
 -- You should have received a copy of the GNU Affero General Public License along
 -- with this program. If not, see <https://www.gnu.org/licenses/>.
+{-# LANGUAGE StandaloneKindSignatures #-}
+{-# LANGUAGE TemplateHaskell #-}
+{-# OPTIONS_GHC -Wno-unused-top-binds #-}
 
 module Wire.API.Error.Galley
   ( GalleyError (..),
@@ -27,6 +30,8 @@ module Wire.API.Error.Galley
 where
 
 import Control.Lens ((%~))
+import Data.Aeson (FromJSON (..), ToJSON (..))
+import Data.Singletons.CustomStar (genSingletons)
 import Data.Singletons.Prelude (Show_)
 import qualified Data.Swagger as S
 import Data.Tagged
@@ -40,6 +45,7 @@ import Wire.API.Error
 import qualified Wire.API.Error.Brig as BrigError
 import Wire.API.Routes.API
 import Wire.API.Team.Permission
+import Wire.API.Util.Aeson (CustomEncoded (..))
 
 data GalleyError
   = InvalidAction
@@ -100,6 +106,10 @@ data GalleyError
   | TooManyTeamMembersOnTeamWithLegalhold
   | NoLegalHoldDeviceAllocated
   | UserLegalHoldNotPending
+  deriving (Show, Eq, Generic)
+  deriving (FromJSON, ToJSON) via (CustomEncoded GalleyError)
+
+$(genSingletons [''GalleyError])
 
 instance KnownError (MapError e) => IsSwaggerError (e :: GalleyError) where
   addToSwagger = addStaticErrorToSwagger @(MapError e)

libs/wire-api/src/Wire/API/Routes/Public/Util.hs

@@ -60,6 +60,7 @@ type ResponsesForExistedCreated eDesc cDesc a =
 data UpdateResult a
   = Unchanged
   | Updated !a
+  deriving (Functor)
 
 type UpdateResponses unchangedDesc updatedDesc a =
   '[ RespondEmpty 204 unchangedDesc,

libs/wire-api/src/Wire/API/Team/Permission.hs

@@ -58,6 +58,7 @@ import qualified Data.Swagger as S
 import qualified Data.Swagger.Build.Api as Doc
 import Imports
 import Wire.API.Arbitrary (Arbitrary (arbitrary), GenericUniform (..))
+import Wire.API.Util.Aeson (CustomEncoded (..))
 
 --------------------------------------------------------------------------------
 -- Permissions
@@ -151,6 +152,7 @@ data Perm
   -- read Note [team roles] first.
   deriving stock (Eq, Ord, Show, Enum, Bounded, Generic)
   deriving (Arbitrary) via (GenericUniform Perm)
+  deriving (FromJSON, ToJSON) via (CustomEncoded Perm)
 
 permsToInt :: Set Perm -> Word64
 permsToInt = Set.foldr' (\p n -> n .|. permToInt p) 0

services/galley/src/Galley/API/Action.hs

@@ -21,6 +21,7 @@ module Galley.API.Action
     ConversationJoin (..),
     ConversationMemberUpdate (..),
     HasConversationActionEffects,
+    HasConversationActionGalleyErrors,
 
     -- * Performing actions
     updateLocalConversationWithLocalUser,
@@ -32,13 +33,15 @@ module Galley.API.Action
     ensureConversationActionAllowed,
     addMembersToLocalConversation,
     notifyConversationAction,
+    notifyRemoteConversationAction,
     ConversationUpdate,
   )
 where
 
 import qualified Brig.Types.User as User
 import Control.Arrow
 import Control.Lens
+import Data.ByteString.Conversion (toByteString')
 import Data.Id
 import Data.Kind
 import Data.List.NonEmpty (nonEmpty)
@@ -72,6 +75,8 @@ import Imports
 import Polysemy
 import Polysemy.Error
 import Polysemy.Input
+import qualified Polysemy.TinyLog as P
+import qualified System.Logger as Log
 import Wire.API.Conversation hiding (Conversation, Member)
 import Wire.API.Conversation.Action
 import Wire.API.Conversation.Protocol
@@ -129,7 +134,6 @@ type family HasConversationActionEffects (tag :: ConversationActionTag) r :: Con
          BrigAccess,
          CodeStore,
          Error InvalidInput,
-         Error InvalidInput,
          Error NoChanges,
          ErrorS 'InvalidTargetAccess,
          ErrorS ('ActionDenied 'RemoveConversationMember),
@@ -148,6 +152,63 @@ type family HasConversationActionEffects (tag :: ConversationActionTag) r :: Con
   HasConversationActionEffects 'ConversationReceiptModeUpdateTag r =
     Members '[ConversationStore, Error NoChanges] r
 
+type family HasConversationActionGalleyErrors (tag :: ConversationActionTag) :: EffectRow where
+  HasConversationActionGalleyErrors 'ConversationJoinTag =
+    '[ ErrorS ('ActionDenied 'LeaveConversation),
+       ErrorS ('ActionDenied 'AddConversationMember),
+       ErrorS 'NotATeamMember,
+       ErrorS 'InvalidOperation,
+       ErrorS 'ConvNotFound,
+       ErrorS 'NotConnected,
+       ErrorS 'ConvAccessDenied,
+       ErrorS 'TooManyMembers,
+       ErrorS 'MissingLegalholdConsent
+     ]
+  HasConversationActionGalleyErrors 'ConversationLeaveTag =
+    '[ ErrorS ('ActionDenied 'LeaveConversation),
+       ErrorS 'InvalidOperation,
+       ErrorS 'ConvNotFound
+     ]
+  HasConversationActionGalleyErrors 'ConversationRemoveMembersTag =
+    '[ ErrorS ('ActionDenied 'RemoveConversationMember),
+       ErrorS 'InvalidOperation,
+       ErrorS 'ConvNotFound
+     ]
+  HasConversationActionGalleyErrors 'ConversationMemberUpdateTag =
+    '[ ErrorS ('ActionDenied 'ModifyOtherConversationMember),
+       ErrorS 'InvalidOperation,
+       ErrorS 'ConvNotFound,
+       ErrorS 'ConvMemberNotFound
+     ]
+  HasConversationActionGalleyErrors 'ConversationDeleteTag =
+    '[ ErrorS ('ActionDenied 'DeleteConversation),
+       ErrorS 'NotATeamMember,
+       ErrorS 'InvalidOperation,
+       ErrorS 'ConvNotFound
+     ]
+  HasConversationActionGalleyErrors 'ConversationRenameTag =
+    '[ ErrorS ('ActionDenied 'ModifyConversationName),
+       ErrorS 'InvalidOperation,
+       ErrorS 'ConvNotFound
+     ]
+  HasConversationActionGalleyErrors 'ConversationMessageTimerUpdateTag =
+    '[ ErrorS ('ActionDenied 'ModifyConversationMessageTimer),
+       ErrorS 'InvalidOperation,
+       ErrorS 'ConvNotFound
+     ]
+  HasConversationActionGalleyErrors 'ConversationReceiptModeUpdateTag =
+    '[ ErrorS ('ActionDenied 'ModifyConversationReceiptMode),
+       ErrorS 'InvalidOperation,
+       ErrorS 'ConvNotFound
+     ]
+  HasConversationActionGalleyErrors 'ConversationAccessDataTag =
+    '[ ErrorS ('ActionDenied 'RemoveConversationMember),
+       ErrorS ('ActionDenied 'ModifyConversationAccess),
+       ErrorS 'InvalidOperation,
+       ErrorS 'InvalidTargetAccess,
+       ErrorS 'ConvNotFound
+     ]
+
 noChanges :: Member (Error NoChanges) r => Sem r a
 noChanges = throw NoChanges
 
@@ -637,3 +698,51 @@ notifyConversationAction tag quid con lcnv targets action = do
 
   -- notify local participants and bots
   pushConversationEvent con e (qualifyAs lcnv (bmLocals targets)) (bmBots targets) $> e
+
+-- | Notify all local members about a remote conversation update that originated
+-- from a local user
+notifyRemoteConversationAction ::
+  Members
+    '[ FederatorAccess,
+       ExternalAccess,
+       GundeckAccess,
+       MemberStore,
+       Input (Local ()),
+       P.TinyLog
+     ]
+    r =>
+  Remote ConversationUpdate ->
+  ConnId ->
+  Sem r Event
+notifyRemoteConversationAction rconvUpdate con = do
+  let convUpdate = tUnqualified rconvUpdate
+      rconvId = qualifyAs rconvUpdate . cuConvId $ convUpdate
+
+  let event =
+        case cuAction convUpdate of
+          SomeConversationAction tag action ->
+            conversationActionToEvent tag (cuTime convUpdate) (cuOrigUserId convUpdate) (qUntagged rconvId) action
+
+  -- Note: we generally do not send notifications to users that are not part of
+  -- the conversation (from our point of view), to prevent spam from the remote
+  -- backend.
+  (presentUsers, allUsersArePresent) <-
+    E.selectRemoteMembers (cuAlreadyPresentUsers convUpdate) rconvId
+  loc <- qualifyLocal ()
+  let localPresentUsers = qualifyAs loc presentUsers
+
+  unless allUsersArePresent $
+    P.warn $
+      Log.field "conversation" (toByteString' . tUnqualified $ rconvId)
+        . Log.field "domain" (toByteString' (tDomain rconvUpdate))
+        . Log.msg
+          ( "Attempt to send notification about conversation update \
+            \to users not in the conversation" ::
+              ByteString
+          )
+
+  -- FUTUREWORK: Check if presentUsers contain bots when federated bots are
+  -- implemented.
+  let bots = []
+
+  pushConversationEvent (Just con) event localPresentUsers bots $> event