SQSERVICES-1083 Separate Access Control For Guests And Services

docs/reference/cassandra-schema.cql

@@ -227,6 +227,7 @@ CREATE TABLE galley_test.conversation (
     conv uuid PRIMARY KEY,
     access set<int>,
     access_role int,
+    access_roles_v2 set<int>,
     creator uuid,
     deleted boolean,
     message_timer bigint,

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

@@ -27,7 +27,7 @@ module Galley.Types
     cnvType,
     cnvCreator,
     cnvAccess,
-    cnvAccessRole,
+    cnvAccessRoles,
     cnvName,
     cnvTeam,
     cnvMessageTimer,
@@ -55,7 +55,9 @@ module Galley.Types
     TypingData (..),
     OtrMessage (..),
     Access (..),
-    AccessRole (..),
+    AccessRoleV2 (..),
+    AccessRoleLegacy (..),
+    FromAccessRoleLegacy (..),
     ConversationList (..),
     ConversationRename (..),
     ConversationAccessData (..),

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

@@ -29,7 +29,7 @@ import Servant.API
 import Wire.API.Arbitrary (Arbitrary, GenericUniform (..))
 import Wire.API.Conversation
   ( Access,
-    AccessRole,
+    AccessRoleV2,
     ConvType,
     ConversationMetadata,
     ReceiptMode,
@@ -118,7 +118,7 @@ data NewRemoteConversation conv = NewRemoteConversation
     -- | The conversation type
     rcCnvType :: ConvType,
     rcCnvAccess :: [Access],
-    rcCnvAccessRole :: AccessRole,
+    rcCnvAccessRoles :: Set AccessRoleV2,
     -- | The conversation name,
     rcCnvName :: Maybe Text,
     -- | Members of the conversation apart from the creator

libs/wire-api-federation/test/Test/Wire/API/Federation/Golden/NewRemoteConversation.hs

@@ -20,7 +20,7 @@ testObject_NewRemoteConversation1 =
       rcCnvId = Id (fromJust (UUID.fromString "d13dbe58-d4e3-450f-9c0c-1e632f548740")),
       rcCnvType = RegularConv,
       rcCnvAccess = [InviteAccess, CodeAccess],
-      rcCnvAccessRole = ActivatedAccessRole,
+      rcCnvAccessRoles = Set.fromList [TeamMemberAccessRole, NonTeamMemberAccessRole],
       rcCnvName = Just "gossip",
       rcNonCreatorMembers =
         Set.fromList
@@ -59,7 +59,7 @@ testObject_NewRemoteConversation2 =
       rcCnvId = Id (fromJust (UUID.fromString "d13dbe58-d4e3-450f-9c0c-1e632f548740")),
       rcCnvType = One2OneConv,
       rcCnvAccess = [],
-      rcCnvAccessRole = ActivatedAccessRole,
+      rcCnvAccessRoles = Set.fromList [TeamMemberAccessRole, NonTeamMemberAccessRole],
       rcCnvName = Nothing,
       rcNonCreatorMembers = Set.fromList [],
       rcMessageTimer = Nothing,

libs/wire-api-federation/test/golden/testObject_NewRemoteConversation1.json

@@ -29,7 +29,10 @@
             "id": "6801e49b-918c-4eef-baed-f18522152fca"
         }
     ],
-    "cnv_access_role": "activated",
+    "cnv_access_roles": [
+        "team_member",
+        "non_team_member"
+    ],
     "cnv_type": 0,
     "receipt_mode": 42,
     "message_timer": 1000,

libs/wire-api-federation/test/golden/testObject_NewRemoteConversation2.json

@@ -3,7 +3,10 @@
     "time": "1864-04-12T12:22:43.673Z",
     "cnv_access": [],
     "non_creator_members": [],
-    "cnv_access_role": "activated",
+    "cnv_access_roles": [
+        "team_member",
+        "non_team_member"
+    ],
     "cnv_type": 2,
     "receipt_mode": null,
     "message_timer": null,

libs/wire-api/src/Wire/API/Conversation.hs

@@ -24,15 +24,14 @@ module Wire.API.Conversation
   ( -- * Conversation
     ConversationMetadata (..),
     Conversation (..),
-    mkConversation,
     cnvType,
     cnvCreator,
     cnvAccess,
-    cnvAccessRole,
     cnvName,
     cnvTeam,
     cnvMessageTimer,
     cnvReceiptMode,
+    cnvAccessRoles,
     ConversationCoverView (..),
     ConversationList (..),
     ListConversations (..),
@@ -46,9 +45,15 @@ module Wire.API.Conversation
 
     -- * Conversation properties
     Access (..),
-    AccessRole (..),
+    AccessRoleV2 (..),
+    AccessRoleLegacy (..),
     ConvType (..),
     ReceiptMode (..),
+    FromAccessRoleLegacy (..),
+    fromAccessRoleLegacy,
+    toAccessRoleLegacy,
+    defRole,
+    maybeRole,
 
     -- * create
     NewConv (..),
@@ -90,7 +95,6 @@ import Control.Applicative
 import Control.Lens (at, (?~))
 import Data.Aeson (FromJSON (..), ToJSON (..))
 import qualified Data.Aeson as A
-import qualified Data.Aeson.Types as A
 import Data.Id
 import Data.List.NonEmpty (NonEmpty)
 import Data.List1
@@ -118,7 +122,7 @@ data ConversationMetadata = ConversationMetadata
     -- FUTUREWORK: Make this a qualified user ID.
     cnvmCreator :: UserId,
     cnvmAccess :: [Access],
-    cnvmAccessRole :: AccessRole,
+    cnvmAccessRoles :: Set AccessRoleV2,
     cnvmName :: Maybe Text,
     -- FUTUREWORK: Think if it makes sense to make the team ID qualified due to
     -- federation.
@@ -130,13 +134,32 @@ data ConversationMetadata = ConversationMetadata
   deriving (Arbitrary) via (GenericUniform ConversationMetadata)
   deriving (FromJSON, ToJSON) via Schema ConversationMetadata
 
-conversationMetadataObjectSchema ::
-  SchemaP
-    SwaggerDoc
-    A.Object
-    [A.Pair]
-    ConversationMetadata
-    ConversationMetadata
+accessRolesSchema :: ObjectSchema SwaggerDoc (Set AccessRoleV2)
+accessRolesSchema = toOutput .= accessRolesSchemaTuple `withParser` validate
+  where
+    toOutput accessRoles = (Just $ toAccessRoleLegacy accessRoles, Just accessRoles)
+    validate =
+      \case
+        (_, Just v2) -> pure v2
+        (Just legacy, Nothing) -> pure $ fromAccessRoleLegacy legacy
+        (Nothing, Nothing) -> fail "access_role|access_role_v2"
+
+accessRolesSchemaOpt :: ObjectSchema SwaggerDoc (Maybe (Set AccessRoleV2))
+accessRolesSchemaOpt = toOutput .= accessRolesSchemaTuple `withParser` validate
+  where
+    toOutput accessRoles = (toAccessRoleLegacy <$> accessRoles, accessRoles)
+    validate =
+      \case
+        (_, Just v2) -> pure $ Just v2
+        (Just legacy, Nothing) -> pure $ Just (fromAccessRoleLegacy legacy)
+        (Nothing, Nothing) -> pure Nothing
+
+accessRolesSchemaTuple :: ObjectSchema SwaggerDoc (Maybe AccessRoleLegacy, Maybe (Set AccessRoleV2))
+accessRolesSchemaTuple =
+  (,) <$> fst .= optField "access_role" (maybeWithDefault A.Null schema)
+    <*> snd .= optField "access_role_v2" (maybeWithDefault A.Null $ set schema)
+
+conversationMetadataObjectSchema :: ObjectSchema SwaggerDoc ConversationMetadata
 conversationMetadataObjectSchema =
   ConversationMetadata
     <$> cnvmType .= field "type" schema
@@ -146,18 +169,17 @@ conversationMetadataObjectSchema =
         (description ?~ "The creator's user ID")
         schema
     <*> cnvmAccess .= field "access" (array schema)
-    <*> cnvmAccessRole .= field "access_role" schema
+    <*> cnvmAccessRoles .= accessRolesSchema
     <*> cnvmName .= optField "name" (maybeWithDefault A.Null schema)
     <* const ("0.0" :: Text) .= optional (field "last_event" schema)
     <* const ("1970-01-01T00:00:00.000Z" :: Text)
       .= optional (field "last_event_time" schema)
     <*> cnvmTeam .= optField "team" (maybeWithDefault A.Null schema)
     <*> cnvmMessageTimer
-      .= ( optFieldWithDocModifier
-             "message_timer"
-             (description ?~ "Per-conversation message timer (can be null)")
-             (maybeWithDefault A.Null schema)
-         )
+      .= optFieldWithDocModifier
+        "message_timer"
+        (description ?~ "Per-conversation message timer (can be null)")
+        (maybeWithDefault A.Null schema)
     <*> cnvmReceiptMode .= optField "receipt_mode" (maybeWithDefault A.Null schema)
 
 instance ToSchema ConversationMetadata where
@@ -178,21 +200,6 @@ data Conversation = Conversation
   deriving (Arbitrary) via (GenericUniform Conversation)
   deriving (FromJSON, ToJSON, S.ToSchema) via Schema Conversation
 
-mkConversation ::
-  Qualified ConvId ->
-  ConvType ->
-  UserId ->
-  [Access] ->
-  AccessRole ->
-  Maybe Text ->
-  ConvMembers ->
-  Maybe TeamId ->
-  Maybe Milliseconds ->
-  Maybe ReceiptMode ->
-  Conversation
-mkConversation qid ty uid acc role name mems tid ms rm =
-  Conversation qid (ConversationMetadata ty uid acc role name tid ms rm) mems
-
 cnvType :: Conversation -> ConvType
 cnvType = cnvmType . cnvMetadata
 
@@ -202,8 +209,8 @@ cnvCreator = cnvmCreator . cnvMetadata
 cnvAccess :: Conversation -> [Access]
 cnvAccess = cnvmAccess . cnvMetadata
 
-cnvAccessRole :: Conversation -> AccessRole
-cnvAccessRole = cnvmAccessRole . cnvMetadata
+cnvAccessRoles :: Conversation -> Set AccessRoleV2
+cnvAccessRoles = cnvmAccessRoles . cnvMetadata
 
 cnvName :: Conversation -> Maybe Text
 cnvName = cnvmName . cnvMetadata
@@ -421,25 +428,87 @@ typeAccess = Doc.string . Doc.enum $ cs . A.encode <$> [(minBound :: Access) ..]
 -- | AccessRoles define who can join conversations. The roles are
 -- "supersets", i.e. Activated includes Team and NonActivated includes
 -- Activated.
-data AccessRole
+data AccessRoleLegacy
   = -- | Nobody can be invited to this conversation
     --   (e.g. it's a 1:1 conversation)
     PrivateAccessRole
   | -- | Team-only conversation
     TeamAccessRole
   | -- | Conversation for users who have activated
-    --   email or phone
+    --   email, phone or SSO and bots
     ActivatedAccessRole
   | -- | No checks
     NonActivatedAccessRole
+  deriving stock (Eq, Ord, Show, Generic, Enum, Bounded)
+  deriving (Arbitrary) via (GenericUniform AccessRoleLegacy)
+  deriving (ToJSON, FromJSON, S.ToSchema) via Schema AccessRoleLegacy
+
+fromAccessRoleLegacy :: AccessRoleLegacy -> Set AccessRoleV2
+fromAccessRoleLegacy = \case
+  PrivateAccessRole -> privateAccessRole
+  TeamAccessRole -> teamAccessRole
+  ActivatedAccessRole -> activatedAccessRole
+  NonActivatedAccessRole -> nonActivatedAccessRole
+
+privateAccessRole :: Set AccessRoleV2
+privateAccessRole = Set.fromList []
+
+teamAccessRole :: Set AccessRoleV2
+teamAccessRole = Set.fromList [TeamMemberAccessRole]
+
+activatedAccessRole :: Set AccessRoleV2
+activatedAccessRole = Set.fromList [TeamMemberAccessRole, NonTeamMemberAccessRole, ServiceAccessRole]
+
+nonActivatedAccessRole :: Set AccessRoleV2
+nonActivatedAccessRole = Set.fromList [TeamMemberAccessRole, NonTeamMemberAccessRole, GuestAccessRole, ServiceAccessRole]
+
+defRole :: Set AccessRoleV2
+defRole = activatedAccessRole
+
+maybeRole :: ConvType -> Maybe (Set AccessRoleV2) -> Set AccessRoleV2
+maybeRole SelfConv _ = privateAccessRole
+maybeRole ConnectConv _ = privateAccessRole
+maybeRole One2OneConv _ = privateAccessRole
+maybeRole RegularConv Nothing = defRole
+maybeRole RegularConv (Just r) = r
+
+data AccessRoleV2
+  = TeamMemberAccessRole
+  | NonTeamMemberAccessRole
+  | GuestAccessRole
+  | ServiceAccessRole
   deriving stock (Eq, Ord, Show, Generic)
-  deriving (Arbitrary) via (GenericUniform AccessRole)
-  deriving (ToJSON, FromJSON, S.ToSchema) via Schema AccessRole
+  deriving (Arbitrary) via (GenericUniform AccessRoleV2)
+  deriving (ToJSON, FromJSON, S.ToSchema) via Schema AccessRoleV2
+
+toAccessRoleLegacy :: Set AccessRoleV2 -> AccessRoleLegacy
+toAccessRoleLegacy accessRoles = do
+  fromMaybe NonActivatedAccessRole $ find (allMember accessRoles . fromAccessRoleLegacy) [minBound ..]
+  where
+    allMember :: Ord a => Set a -> Set a -> Bool
+    allMember rhs lhs = all (`Set.member` lhs) rhs
+
+-- | Wrapper around `Set AccessRoleV2` for Cassandra Cql instance
+-- that converts legacy access role into access role V2
+newtype FromAccessRoleLegacy = FromAccessRoleLegacy {unFromAccessRoleLegacy :: Set.Set AccessRoleV2}
+
+-- todo(leif): add docs
+instance ToSchema AccessRoleV2 where
+  schema =
+    (S.schema . description ?~ "Which users/services can join conversations") $
+      enum @Text "AccessRoleV2" $
+        mconcat
+          [ element "team_member" TeamMemberAccessRole,
+            element "non_team_member" NonTeamMemberAccessRole,
+            element "guest" GuestAccessRole,
+            element "service" ServiceAccessRole
+          ]
 
-instance ToSchema AccessRole where
+-- todo(leif): add docs
+instance ToSchema AccessRoleLegacy where
   schema =
-    (S.schema . description ?~ "Which users can join conversations") $
-      enum @Text "AccessRole" $
+    (S.schema . description ?~ "Which users can join conversations (deprecated)") $
+      enum @Text "AccessRoleLegacy" $
         mconcat
           [ element "private" PrivateAccessRole,
             element "team" TeamAccessRole,
@@ -586,7 +655,7 @@ data NewConv = NewConv
     newConvQualifiedUsers :: [Qualified UserId],
     newConvName :: Maybe Text,
     newConvAccess :: Set Access,
-    newConvAccessRole :: Maybe AccessRole,
+    newConvAccessRoles :: Maybe (Set AccessRoleV2),
     newConvTeam :: Maybe ConvTeamInfo,
     newConvMessageTimer :: Maybe Milliseconds,
     newConvReceiptMode :: Maybe ReceiptMode,
@@ -619,7 +688,7 @@ newConvSchema =
       <*> newConvName .= maybe_ (optField "name" schema)
       <*> (Set.toList . newConvAccess)
         .= (fromMaybe mempty <$> optField "access" (Set.fromList <$> array schema))
-      <*> newConvAccessRole .= maybe_ (optField "access_role" schema)
+      <*> newConvAccessRoles .= accessRolesSchemaOpt
       <*> newConvTeam
         .= maybe_
           ( optFieldWithDocModifier
@@ -766,7 +835,7 @@ modelConversationUpdateName = Doc.defineModel "ConversationUpdateName" $ do
 
 data ConversationAccessData = ConversationAccessData
   { cupAccess :: Set Access,
-    cupAccessRole :: AccessRole
+    cupAccessRoles :: Set AccessRoleV2
   }
   deriving stock (Eq, Show, Generic)
   deriving (Arbitrary) via (GenericUniform ConversationAccessData)
@@ -777,14 +846,14 @@ instance ToSchema ConversationAccessData where
     object "ConversationAccessData" $
       ConversationAccessData
         <$> cupAccess .= field "access" (set schema)
-        <*> cupAccessRole .= field "access_role" schema
+        <*> cupAccessRoles .= field "access_role" (set schema)
 
 modelConversationAccessData :: Doc.Model
 modelConversationAccessData = Doc.defineModel "ConversationAccessData" $ do
   Doc.description "Contains conversation properties to update"
   Doc.property "access" (Doc.unique $ Doc.array typeAccess) $
     Doc.description "List of conversation access modes."
-  Doc.property "access_role" (Doc.bytes') $
+  Doc.property "access_role" Doc.bytes' $
     Doc.description "Conversation access role: private|team|activated|non_activated"
 
 data ConversationReceiptModeUpdate = ConversationReceiptModeUpdate