Implement status updates for remote conversations

changelog.d/6-federation/self-member-status

@@ -0,0 +1 @@
+Added support for updating self member status of remote conversations

docs/reference/cassandra-schema.cql

@@ -105,6 +105,12 @@ CREATE TABLE galley_test.user_remote_conv (
     user uuid,
     conv_remote_domain text,
     conv_remote_id uuid,
+    hidden boolean,
+    hidden_ref text,
+    otr_archived boolean,
+    otr_archived_ref text,
+    otr_muted_ref text,
+    otr_muted_status int,
     PRIMARY KEY (user, conv_remote_domain, conv_remote_id)
 ) WITH CLUSTERING ORDER BY (conv_remote_domain ASC, conv_remote_id ASC)
     AND bloom_filter_fp_chance = 0.1

libs/galley-types/galley-types.cabal

@@ -4,7 +4,7 @@ cabal-version: 1.12
 --
 -- see: https://github.com/sol/hpack
 --
--- hash: ebbe442ba952db0f975a3f93ffa72db3b1b971f506a30baaca5615f93b4b376a
+-- hash: 8d07ea070b6384ec247f4473abb198bbb9639f72543920cbe46f561df96963ca
 
 name:           galley-types
 version:        0.81.0
@@ -43,6 +43,7 @@ library
     , imports
     , lens >=4.12
     , string-conversions
+    , tagged
     , text >=0.11
     , time >=1.4
     , types-common >=0.16

libs/galley-types/package.yaml

@@ -22,6 +22,7 @@ library:
   - lens >=4.12
   - QuickCheck
   - string-conversions
+  - tagged
   - text >=0.11
   - time >=1.4
   - types-common >=0.16

libs/galley-types/src/Galley/Types.hs

@@ -20,13 +20,21 @@
 module Galley.Types
   ( foldrOtrRecipients,
     Accept (..),
-    ConversationMeta (..),
 
     -- * re-exports
+    ConversationMetadata (..),
     Conversation (..),
-    LocalMember,
-    RemoteMember,
-    InternalMember (..),
+    cnvQualifiedId,
+    cnvType,
+    cnvCreator,
+    cnvAccess,
+    cnvAccessRole,
+    cnvName,
+    cnvTeam,
+    cnvMessageTimer,
+    cnvReceiptMode,
+    RemoteMember (..),
+    LocalMember (..),
     ConvMembers (..),
     OtherMember (..),
     Connect (..),
@@ -74,11 +82,9 @@ module Galley.Types
 where
 
 import Data.Aeson
-import Data.Id (ClientId, ConvId, TeamId, UserId)
-import Data.Json.Util ((#))
+import Data.Id (ClientId, UserId)
 import qualified Data.Map.Strict as Map
-import Data.Misc (Milliseconds)
-import Galley.Types.Conversations.Members (InternalMember (..), LocalMember, RemoteMember)
+import Galley.Types.Conversations.Members (LocalMember (..), RemoteMember (..))
 import Imports
 import Wire.API.Conversation hiding (Member (..))
 import Wire.API.Conversation.Code
@@ -89,48 +95,6 @@ import Wire.API.Message
 import Wire.API.User (UserIdList (..))
 import Wire.API.User.Client
 
---------------------------------------------------------------------------------
--- ConversationMeta
-
-data ConversationMeta = ConversationMeta
-  { cmId :: !ConvId,
-    cmType :: !ConvType,
-    cmCreator :: !UserId,
-    cmAccess :: ![Access],
-    cmAccessRole :: !AccessRole,
-    cmName :: !(Maybe Text),
-    cmTeam :: !(Maybe TeamId),
-    cmMessageTimer :: !(Maybe Milliseconds),
-    cmReceiptMode :: !(Maybe ReceiptMode)
-  }
-  deriving (Eq, Show)
-
-instance ToJSON ConversationMeta where
-  toJSON c =
-    object $
-      "id" .= cmId c
-        # "type" .= cmType c
-        # "creator" .= cmCreator c
-        # "access" .= cmAccess c
-        # "access_role" .= cmAccessRole c
-        # "name" .= cmName c
-        # "team" .= cmTeam c
-        # "message_timer" .= cmMessageTimer c
-        # "receipt_mode" .= cmReceiptMode c
-        # []
-
-instance FromJSON ConversationMeta where
-  parseJSON = withObject "conversation-meta" $ \o ->
-    ConversationMeta <$> o .: "id"
-      <*> o .: "type"
-      <*> o .: "creator"
-      <*> o .: "access"
-      <*> o .: "access_role"
-      <*> o .: "name"
-      <*> o .:? "team"
-      <*> o .:? "message_timer"
-      <*> o .:? "receipt_mode"
-
 --------------------------------------------------------------------------------
 -- Accept
 

libs/galley-types/src/Galley/Types/Conversations/Members.hs

@@ -18,37 +18,73 @@
 -- with this program. If not, see <https://www.gnu.org/licenses/>.
 
 module Galley.Types.Conversations.Members
-  ( LocalMember,
-    RemoteMember (..),
-    InternalMember (..),
+  ( RemoteMember (..),
+    remoteMemberToOther,
+    LocalMember (..),
+    localMemberToOther,
+    MemberStatus (..),
+    defMemberStatus,
   )
 where
 
+import Data.Domain
 import Data.Id as Id
-import Data.Qualified (Remote)
+import Data.Qualified
+import Data.Tagged
 import Imports
-import Wire.API.Conversation.Member (MutedStatus)
+import Wire.API.Conversation
 import Wire.API.Conversation.Role (RoleName)
 import Wire.API.Provider.Service (ServiceRef)
 
-type LocalMember = InternalMember Id.UserId
-
+-- | Internal (cassandra) representation of a remote conversation member.
 data RemoteMember = RemoteMember
   { rmId :: Remote UserId,
     rmConvRoleName :: RoleName
   }
   deriving stock (Show)
 
--- | Internal (cassandra) representation of a conversation member.
-data InternalMember id = InternalMember
-  { memId :: id,
-    memService :: Maybe ServiceRef,
-    memOtrMutedStatus :: Maybe MutedStatus,
-    memOtrMutedRef :: Maybe Text,
-    memOtrArchived :: Bool,
-    memOtrArchivedRef :: Maybe Text,
-    memHidden :: Bool,
-    memHiddenRef :: Maybe Text,
-    memConvRoleName :: RoleName
+remoteMemberToOther :: RemoteMember -> OtherMember
+remoteMemberToOther x =
+  OtherMember
+    { omQualifiedId = unTagged (rmId x),
+      omService = Nothing,
+      omConvRoleName = rmConvRoleName x
+    }
+
+-- | Internal (cassandra) representation of a local conversation member.
+data LocalMember = LocalMember
+  { lmId :: UserId,
+    lmStatus :: MemberStatus,
+    lmService :: Maybe ServiceRef,
+    lmConvRoleName :: RoleName
+  }
+  deriving stock (Show)
+
+localMemberToOther :: Domain -> LocalMember -> OtherMember
+localMemberToOther domain x =
+  OtherMember
+    { omQualifiedId = Qualified (lmId x) domain,
+      omService = lmService x,
+      omConvRoleName = lmConvRoleName x
+    }
+
+data MemberStatus = MemberStatus
+  { msOtrMutedStatus :: Maybe MutedStatus,
+    msOtrMutedRef :: Maybe Text,
+    msOtrArchived :: Bool,
+    msOtrArchivedRef :: Maybe Text,
+    msHidden :: Bool,
+    msHiddenRef :: Maybe Text
   }
-  deriving stock (Functor, Show)
+  deriving stock (Show)
+
+defMemberStatus :: MemberStatus
+defMemberStatus =
+  MemberStatus
+    { msOtrMutedStatus = Nothing,
+      msOtrMutedRef = Nothing,
+      msOtrArchived = False,
+      msOtrArchivedRef = Nothing,
+      msHidden = False,
+      msHiddenRef = Nothing
+    }

libs/types-common/src/Data/Qualified.hs

@@ -23,6 +23,8 @@ module Data.Qualified
     Qualified (..),
     Remote,
     toRemote,
+    Local,
+    toLocal,
     renderQualifiedId,
     partitionRemoteOrLocalIds,
     partitionRemoteOrLocalIds',
@@ -66,6 +68,13 @@ type Remote a = Tagged "remote" (Qualified a)
 toRemote :: Qualified a -> Remote a
 toRemote = Tagged
 
+-- | A type representing a Qualified value where the domain is guaranteed to be
+-- the local one.
+type Local a = Tagged "local" (Qualified a)
+
+toLocal :: Qualified a -> Local a
+toLocal = Tagged
+
 -- | FUTUREWORK: Maybe delete this, it is only used in printing federation not
 -- implemented errors
 renderQualified :: (a -> Text) -> Qualified a -> Text

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

@@ -30,8 +30,7 @@ import Servant.API (JSON, Post, ReqBody, Summary, (:>))
 import Servant.API.Generic ((:-))
 import Servant.Client.Generic (AsClientT, genericClient)
 import Wire.API.Arbitrary (Arbitrary, GenericUniform (..))
-import Wire.API.Conversation (Access, AccessRole, ConvType, Conversation, ReceiptMode)
-import Wire.API.Conversation.Member (OtherMember)
+import Wire.API.Conversation
 import Wire.API.Conversation.Role (RoleName)
 import Wire.API.Federation.Client (FederationClientFailure, FederatorClient)
 import Wire.API.Federation.Domain (OriginDomainHeader)
@@ -60,6 +59,7 @@ data Api routes = Api
       routes
         :- "federation"
         :> "get-conversations"
+        :> OriginDomainHeader
         :> ReqBody '[JSON] GetConversationsRequest
         :> Post '[JSON] GetConversationsResponse,
     -- used by backend that owns the conversation to inform the backend about
@@ -100,15 +100,35 @@ data Api routes = Api
   deriving (Generic)
 
 data GetConversationsRequest = GetConversationsRequest
-  { gcrUserId :: Qualified UserId,
+  { gcrUserId :: UserId,
     gcrConvIds :: [ConvId]
   }
   deriving stock (Eq, Show, Generic)
   deriving (Arbitrary) via (GenericUniform GetConversationsRequest)
   deriving (ToJSON, FromJSON) via (CustomEncoded GetConversationsRequest)
 
+data RemoteConvMembers = RemoteConvMembers
+  { rcmSelfRole :: RoleName,
+    rcmOthers :: [OtherMember]
+  }
+  deriving stock (Eq, Show, Generic)
+  deriving (Arbitrary) via (GenericUniform RemoteConvMembers)
+  deriving (FromJSON, ToJSON) via (CustomEncoded RemoteConvMembers)
+
+-- | A conversation hosted on a remote backend. This contains the same
+-- information as a 'Conversation', with the exception that conversation status
+-- fields (muted/archived/hidden) are omitted, since they are not known by the
+-- remote backend.
+data RemoteConversation = RemoteConversation
+  { rcnvMetadata :: ConversationMetadata,
+    rcnvMembers :: RemoteConvMembers
+  }
+  deriving stock (Eq, Show, Generic)
+  deriving (Arbitrary) via (GenericUniform RemoteConversation)
+  deriving (FromJSON, ToJSON) via (CustomEncoded RemoteConversation)
+
 newtype GetConversationsResponse = GetConversationsResponse
-  { gcresConvs :: [Conversation]
+  { gcresConvs :: [RemoteConversation]
   }
   deriving stock (Eq, Show, Generic)
   deriving (Arbitrary) via (GenericUniform GetConversationsResponse)