diff --git a/changelog.d/5-internal/one2one-upsert b/changelog.d/5-internal/one2one-upsert new file mode 100644 index 00000000000..5371eb9a786 --- /dev/null +++ b/changelog.d/5-internal/one2one-upsert @@ -0,0 +1 @@ +Add internal endpoint to insert or update a 1-1 conversation. This is to be used by brig when updating the status of a connection. diff --git a/libs/galley-types/galley-types.cabal b/libs/galley-types/galley-types.cabal index 891555cac72..8af1c5e5f5a 100644 --- a/libs/galley-types/galley-types.cabal +++ b/libs/galley-types/galley-types.cabal @@ -4,7 +4,7 @@ cabal-version: 1.12 -- -- see: https://github.com/sol/hpack -- --- hash: 8d07ea070b6384ec247f4473abb198bbb9639f72543920cbe46f561df96963ca +-- hash: d7419acbff460382bb822952b693f55513e729a4e3bcd0ddfdeea9e5285a805b name: galley-types version: 0.81.0 @@ -22,6 +22,7 @@ library Galley.Types Galley.Types.Bot Galley.Types.Bot.Service + Galley.Types.Conversations.Intra Galley.Types.Conversations.Members Galley.Types.Conversations.Roles Galley.Types.Teams @@ -42,6 +43,7 @@ library , exceptions >=0.10.0 , imports , lens >=4.12 + , schema-profunctor , string-conversions , tagged , text >=0.11 diff --git a/libs/galley-types/package.yaml b/libs/galley-types/package.yaml index 3c8971ad0a0..3d84f4036eb 100644 --- a/libs/galley-types/package.yaml +++ b/libs/galley-types/package.yaml @@ -21,6 +21,7 @@ library: - exceptions >=0.10.0 - lens >=4.12 - QuickCheck + - schema-profunctor - string-conversions - tagged - text >=0.11 diff --git a/libs/galley-types/src/Galley/Types/Conversations/Intra.hs b/libs/galley-types/src/Galley/Types/Conversations/Intra.hs new file mode 100644 index 00000000000..0cb0ba9afd7 --- /dev/null +++ b/libs/galley-types/src/Galley/Types/Conversations/Intra.hs @@ -0,0 +1,87 @@ +-- This file is part of the Wire Server implementation. +-- +-- Copyright (C) 2021 Wire Swiss GmbH +-- +-- This program is free software: you can redistribute it and/or modify it under +-- the terms of the GNU Affero General Public License as published by the Free +-- Software Foundation, either version 3 of the License, or (at your option) any +-- later version. +-- +-- This program is distributed in the hope that it will be useful, but WITHOUT +-- ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS +-- FOR A PARTICULAR PURPOSE. See the GNU Affero General Public License for more +-- details. +-- +-- You should have received a copy of the GNU Affero General Public License along +-- with this program. If not, see . + +module Galley.Types.Conversations.Intra + ( DesiredMembership (..), + Actor (..), + UpsertOne2OneConversationRequest (..), + UpsertOne2OneConversationResponse (..), + ) +where + +import qualified Data.Aeson as A +import Data.Aeson.Types (FromJSON, ToJSON) +import Data.Id (ConvId, UserId) +import Data.Qualified +import Data.Schema +import Imports + +data DesiredMembership = Included | Excluded + deriving (Show, Eq, Generic) + deriving (FromJSON, ToJSON) via Schema DesiredMembership + +instance ToSchema DesiredMembership where + schema = + enum @Text "DesiredMembership" $ + mconcat + [ element "included" Included, + element "excluded" Excluded + ] + +data Actor = LocalActor | RemoteActor + deriving (Show, Eq, Generic) + deriving (FromJSON, ToJSON) via Schema Actor + +instance ToSchema Actor where + schema = + enum @Text "Actor" $ + mconcat + [ element "local_actor" LocalActor, + element "remote_actor" RemoteActor + ] + +data UpsertOne2OneConversationRequest = UpsertOne2OneConversationRequest + { uooLocalUser :: Local UserId, + uooRemoteUser :: Remote UserId, + uooActor :: Actor, + uooActorDesiredMembership :: DesiredMembership, + uooConvId :: Maybe (Qualified ConvId) + } + deriving (Show, Generic) + deriving (FromJSON, ToJSON) via Schema UpsertOne2OneConversationRequest + +instance ToSchema UpsertOne2OneConversationRequest where + schema = + object "UpsertOne2OneConversationRequest" $ + UpsertOne2OneConversationRequest + <$> (qUntagged . uooLocalUser) .= field "local_user" (qTagUnsafe <$> schema) + <*> (qUntagged . uooRemoteUser) .= field "remote_user" (qTagUnsafe <$> schema) + <*> uooActor .= field "actor" schema + <*> uooActorDesiredMembership .= field "actor_desired_membership" schema + <*> uooConvId .= field "conversation_id" (optWithDefault A.Null schema) + +newtype UpsertOne2OneConversationResponse = UpsertOne2OneConversationResponse + { uuorConvId :: Qualified ConvId + } + deriving (Show, Generic) + deriving (FromJSON, ToJSON) via Schema UpsertOne2OneConversationResponse + +instance ToSchema UpsertOne2OneConversationResponse where + schema = + object "UpsertOne2OneConversationResponse" $ + UpsertOne2OneConversationResponse + <$> uuorConvId .= field "conversation_id" schema diff --git a/libs/types-common/src/Data/UUID/Tagged.hs b/libs/types-common/src/Data/UUID/Tagged.hs index cd822e7d04a..e3552f0b0ba 100644 --- a/libs/types-common/src/Data/UUID/Tagged.hs +++ b/libs/types-common/src/Data/UUID/Tagged.hs @@ -17,12 +17,16 @@ module Data.UUID.Tagged ( UUID, + toUUID, V4, + V5, Version (..), version, variant, addv4, unpack, + create, + mk, ) where @@ -30,35 +34,43 @@ import Data.Bits import qualified Data.UUID as D import qualified Data.UUID.V4 as D4 import Imports -import Test.QuickCheck (Arbitrary, arbitrary) -- | Versioned UUID. -newtype UUID v = UUID D.UUID deriving (Eq, Ord, Show) +newtype UUID v = UUID {toUUID :: D.UUID} + deriving (Eq, Ord, Show) instance NFData (UUID v) where rnf (UUID a) = seq a () class Version v where - -- | Create a fresh versioned UUID. - create :: IO (UUID v) - -- | Try to turn a plain UUID into a versioned UUID. fromUUID :: D.UUID -> Maybe (UUID v) + fromUUID u = guard (version u == versionValue @v) $> UUID u + + versionValue :: Word32 data V4 instance Version V4 where - create = UUID <$> D4.nextRandom - fromUUID u = case version u of - 4 -> Just (UUID u) - _ -> Nothing - -instance Arbitrary (UUID V4) where - arbitrary = do - a <- arbitrary - b <- retainVersion 4 <$> arbitrary - c <- retainVariant 2 <$> arbitrary - d <- arbitrary - pure $ UUID $ D.fromWords a b c d + versionValue = 4 + +data V5 + +instance Version V5 where + versionValue = 5 + +mk :: forall v. Version v => D.UUID -> UUID v +mk u = UUID $ + case D.toWords u of + (x0, x1, x2, x3) -> + D.fromWords + x0 + (retainVersion (versionValue @v) x1) + (retainVariant 2 x2) + x3 + +-- | Create a fresh UUIDv4. +create :: IO (UUID V4) +create = UUID <$> D4.nextRandom -- | Extract the 'D.UUID' from a versioned UUID. unpack :: UUID v -> D.UUID diff --git a/libs/wire-api/src/Wire/API/Event/Conversation.hs b/libs/wire-api/src/Wire/API/Event/Conversation.hs index 0cc3da6702e..d681659225f 100644 --- a/libs/wire-api/src/Wire/API/Event/Conversation.hs +++ b/libs/wire-api/src/Wire/API/Event/Conversation.hs @@ -352,7 +352,7 @@ instance ToSchema SimpleMember where .= (field "conversation_role" schema <|> pure roleNameWireAdmin) data Connect = Connect - { cRecipient :: UserId, + { cRecipient :: Qualified UserId, -- FUTUREWORK: As a follow-up from -- https://github.com/wireapp/wire-server/pull/1726, the message field can -- be removed from this event. @@ -370,7 +370,8 @@ instance ToSchema Connect where connectObjectSchema :: ObjectSchema SwaggerDoc Connect connectObjectSchema = Connect - <$> cRecipient .= field "recipient" schema + <$> cRecipient .= field "qualified_recipient" schema + <* (Just . qUnqualified . cRecipient) .= optField "recipient" Nothing schema <*> cMessage .= lax (field "message" (optWithDefault A.Null schema)) <*> cName .= lax (field "name" (optWithDefault A.Null schema)) <*> cEmail .= lax (field "email" (optWithDefault A.Null schema)) diff --git a/libs/wire-api/test/golden/testObject_Connect_user_1.json b/libs/wire-api/test/golden/testObject_Connect_user_1.json index 551cb7d2b1e..63d654e6666 100644 --- a/libs/wire-api/test/golden/testObject_Connect_user_1.json +++ b/libs/wire-api/test/golden/testObject_Connect_user_1.json @@ -2,5 +2,9 @@ "email": "test email", "message": "E", "name": ".🝊]G", + "qualified_recipient": { + "domain": "foo.example.com", + "id": "00000002-0000-0001-0000-000400000004" + }, "recipient": "00000002-0000-0001-0000-000400000004" } diff --git a/libs/wire-api/test/golden/testObject_Connect_user_2.json b/libs/wire-api/test/golden/testObject_Connect_user_2.json index 8ce9a35dd43..76257ece7c0 100644 --- a/libs/wire-api/test/golden/testObject_Connect_user_2.json +++ b/libs/wire-api/test/golden/testObject_Connect_user_2.json @@ -2,5 +2,9 @@ "email": null, "message": null, "name": null, + "qualified_recipient": { + "domain": "bar.example.com", + "id": "00000005-0000-0007-0000-000200000008" + }, "recipient": "00000005-0000-0007-0000-000200000008" } diff --git a/libs/wire-api/test/golden/testObject_Event_user_10.json b/libs/wire-api/test/golden/testObject_Event_user_10.json index 3ec9ea0854c..7a1f9dcd990 100644 --- a/libs/wire-api/test/golden/testObject_Event_user_10.json +++ b/libs/wire-api/test/golden/testObject_Event_user_10.json @@ -4,6 +4,10 @@ "email": "󲛚", "message": "L", "name": "fq", + "qualified_recipient": { + "domain": "faraway.example.com", + "id": "00000008-0000-0000-0000-000600000001" + }, "recipient": "00000008-0000-0000-0000-000600000001" }, "from": "00007f28-0000-40b1-0000-56ab0000748d", diff --git a/libs/wire-api/test/unit/Test/Wire/API/Golden/Generated/Connect_user.hs b/libs/wire-api/test/unit/Test/Wire/API/Golden/Generated/Connect_user.hs index ad3dcd121da..2e402120580 100644 --- a/libs/wire-api/test/unit/Test/Wire/API/Golden/Generated/Connect_user.hs +++ b/libs/wire-api/test/unit/Test/Wire/API/Golden/Generated/Connect_user.hs @@ -16,7 +16,9 @@ -- with this program. If not, see . module Test.Wire.API.Golden.Generated.Connect_user where +import Data.Domain import Data.Id (Id (Id)) +import Data.Qualified import qualified Data.UUID as UUID (fromString) import Imports (Maybe (Just, Nothing), fromJust) import Wire.API.Event.Conversation (Connect (..)) @@ -24,7 +26,10 @@ import Wire.API.Event.Conversation (Connect (..)) testObject_Connect_user_1 :: Connect testObject_Connect_user_1 = Connect - { cRecipient = Id (fromJust (UUID.fromString "00000002-0000-0001-0000-000400000004")), + { cRecipient = + Qualified + (Id (fromJust (UUID.fromString "00000002-0000-0001-0000-000400000004"))) + (Domain "foo.example.com"), cMessage = Just "E", cName = Just ".\128842]G", cEmail = Just "test email" @@ -33,7 +38,10 @@ testObject_Connect_user_1 = testObject_Connect_user_2 :: Connect testObject_Connect_user_2 = Connect - { cRecipient = Id (fromJust (UUID.fromString "00000005-0000-0007-0000-000200000008")), + { cRecipient = + Qualified + (Id (fromJust (UUID.fromString "00000005-0000-0007-0000-000200000008"))) + (Domain "bar.example.com"), cMessage = Nothing, cName = Nothing, cEmail = Nothing diff --git a/libs/wire-api/test/unit/Test/Wire/API/Golden/Generated/Event_user.hs b/libs/wire-api/test/unit/Test/Wire/API/Golden/Generated/Event_user.hs index 6f5e8a6c28a..bf7223ebb75 100644 --- a/libs/wire-api/test/unit/Test/Wire/API/Golden/Generated/Event_user.hs +++ b/libs/wire-api/test/unit/Test/Wire/API/Golden/Generated/Event_user.hs @@ -214,7 +214,10 @@ testObject_Event_user_10 = (read "1864-05-25 01:31:49.802 UTC") ( EdConnect ( Connect - { cRecipient = Id (fromJust (UUID.fromString "00000008-0000-0000-0000-000600000001")), + { cRecipient = + Qualified + (Id (fromJust (UUID.fromString "00000008-0000-0000-0000-000600000001"))) + (Domain "faraway.example.com"), cMessage = Just "L", cName = Just "fq", cEmail = Just "\992986" diff --git a/services/brig/src/Brig/IO/Intra.hs b/services/brig/src/Brig/IO/Intra.hs index afac8627dde..271c72b7f80 100644 --- a/services/brig/src/Brig/IO/Intra.hs +++ b/services/brig/src/Brig/IO/Intra.hs @@ -32,6 +32,7 @@ module Brig.IO.Intra blockConv, unblockConv, getConv, + upsertOne2OneConversation, -- * Clients Brig.IO.Intra.newClient, @@ -93,6 +94,7 @@ import Data.Qualified import Data.Range import qualified Data.Set as Set import Galley.Types (Connect (..), Conversation) +import Galley.Types.Conversations.Intra (UpsertOne2OneConversationRequest, UpsertOne2OneConversationResponse) import qualified Galley.Types.Teams as Team import Galley.Types.Teams.Intra (GuardLegalholdPolicyConflicts (GuardLegalholdPolicyConflicts)) import qualified Galley.Types.Teams.Intra as Team @@ -533,7 +535,7 @@ createSelfConv u = do . zUser u . expect2xx --- | Calls 'Galley.API.createConnectConversationH'. +-- | Calls 'Galley.API.Create.createConnectConversation'. createLocalConnectConv :: Local UserId -> Local UserId -> @@ -545,18 +547,17 @@ createLocalConnectConv from to cname conn = do logConnection (tUnqualified from) (qUntagged to) . remote "galley" . msg (val "Creating connect conversation") + let req = + path "/i/conversations/connect" + . zUser (tUnqualified from) + . maybe id (header "Z-Connection" . fromConnId) conn + . contentJson + . lbytes (encode $ Connect (qUntagged to) Nothing cname Nothing) + . expect2xx r <- galleyRequest POST req maybe (error "invalid conv id") return $ fromByteString $ getHeader' "Location" r - where - req = - path "/i/conversations/connect" - . zUser (tUnqualified from) - . maybe id (header "Z-Connection" . fromConnId) conn - . contentJson - . lbytes (encode $ Connect (tUnqualified to) Nothing cname Nothing) - . expect2xx createConnectConv :: Qualified UserId -> @@ -658,6 +659,18 @@ getConv usr cnv = do . zUser usr . expect [status200, status404] +upsertOne2OneConversation :: UpsertOne2OneConversationRequest -> AppIO UpsertOne2OneConversationResponse +upsertOne2OneConversation urequest = do + response <- galleyRequest POST req + case Bilge.statusCode response of + 200 -> decodeBody "galley" response + _ -> throwM internalServerError + where + req = + paths ["i", "conversations", "one2one", "upsert"] + . header "Content-Type" "application/json" + . lbytes (encode urequest) + -- | Calls 'Galley.API.getTeamConversationH'. getTeamConv :: UserId -> TeamId -> ConvId -> AppIO (Maybe Team.TeamConversation) getTeamConv usr tid cnv = do diff --git a/services/galley/galley.cabal b/services/galley/galley.cabal index a43ea917332..57fabd19156 100644 --- a/services/galley/galley.cabal +++ b/services/galley/galley.cabal @@ -4,7 +4,7 @@ cabal-version: 1.12 -- -- see: https://github.com/sol/hpack -- --- hash: a5b2ec0bd44d4fcabec564b4e7683a01cfb75cdb1c78a6eee520d6c48c95bb1d +-- hash: c121411458d6b0f7118ae1589134cb37711d29cad840e07d0f135663c59cc53a name: galley version: 0.83.0 @@ -35,6 +35,7 @@ library Galley.API.LegalHold.Conflicts Galley.API.Mapping Galley.API.Message + Galley.API.One2One Galley.API.Public Galley.API.Query Galley.API.Teams @@ -87,6 +88,7 @@ library , base >=4.6 && <5 , base64-bytestring >=1.0 , bilge >=0.21.1 + , binary , brig-types >=0.73.1 , bytestring >=0.9 , bytestring-conversion >=0.2 @@ -95,6 +97,7 @@ library , cassava >=0.5.2 , cereal >=0.4 , containers >=0.5 + , cryptonite , currency-codes >=2.0 , data-default >=0.5 , enclosed-exceptions >=1.0 @@ -113,6 +116,7 @@ library , imports , insert-ordered-containers , lens >=4.4 + , memory , metrics-wai >=0.4 , mtl >=2.2 , optparse-applicative >=0.10 @@ -172,6 +176,7 @@ executable galley , base , case-insensitive , extended + , extra >=1.3 , galley , galley-types , imports @@ -230,11 +235,13 @@ executable galley-integration , cereal , containers , cookie + , cql-io , currency-codes , data-timeout , errors , exceptions , extended + , extra >=1.3 , galley , galley-types , gundeck-types @@ -311,6 +318,7 @@ executable galley-migrate-data , containers , exceptions , extended + , extra >=1.3 , galley-types , imports , lens @@ -378,6 +386,7 @@ executable galley-schema , case-insensitive , cassandra-util , extended + , extra >=1.3 , imports , optparse-applicative , raw-strings-qq >=1.0 @@ -399,6 +408,7 @@ test-suite galley-types-tests other-modules: Test.Galley.API Test.Galley.API.Message + Test.Galley.API.One2One Test.Galley.Intra.User Test.Galley.Mapping Test.Galley.Roundtrip @@ -413,6 +423,7 @@ test-suite galley-types-tests , case-insensitive , containers , extended + , extra >=1.3 , galley , galley-types , http-types diff --git a/services/galley/package.yaml b/services/galley/package.yaml index a4bda422abc..2ae2bfe98a5 100644 --- a/services/galley/package.yaml +++ b/services/galley/package.yaml @@ -13,6 +13,7 @@ dependencies: - imports - case-insensitive - extended +- extra >=1.3 - safe >=0.3 - ssl-util - raw-strings-qq >=1.0 @@ -31,6 +32,7 @@ library: - base >=4.6 && <5 - base64-bytestring >=1.0 - bilge >=0.21.1 + - binary - brig-types >=0.73.1 - bytestring >=0.9 - bytestring-conversion >=0.2 @@ -38,12 +40,12 @@ library: - cassava >= 0.5.2 - cereal >=0.4 - containers >=0.5 + - cryptonite - currency-codes >=2.0 - data-default >=0.5 - enclosed-exceptions >=1.0 - errors >=2.0 - exceptions >=0.4 - - extra >=1.3 - galley-types >=0.65.0 - gundeck-types >=1.35.2 - HsOpenSSL >=0.11 @@ -56,6 +58,7 @@ library: - http2-client-grpc - insert-ordered-containers - lens >=4.4 + - memory - metrics-wai >=0.4 - mtl >=2.2 - optparse-applicative >=0.10 @@ -162,6 +165,7 @@ executables: - cereal - containers - cookie + - cql-io - currency-codes - metrics-wai - data-timeout diff --git a/services/galley/src/Galley/API/Create.hs b/services/galley/src/Galley/API/Create.hs index b5581f1b6cf..ccd977b2670 100644 --- a/services/galley/src/Galley/API/Create.hs +++ b/services/galley/src/Galley/API/Create.hs @@ -20,7 +20,7 @@ module Galley.API.Create internalCreateManagedConversationH, createSelfConversation, createOne2OneConversation, - createConnectConversationH, + createConnectConversation, ) where @@ -36,6 +36,7 @@ import Data.Time import qualified Data.UUID.Tagged as U import Galley.API.Error import Galley.API.Mapping +import Galley.API.One2One import Galley.API.Util import Galley.App import qualified Galley.Data as Data @@ -51,6 +52,7 @@ import Network.Wai.Predicate hiding (setStatus) import Network.Wai.Utilities import qualified Wire.API.Conversation as Public import Wire.API.ErrorDescription (MissingLegalholdConsent) +import Wire.API.Federation.Error (federationNotImplemented) import Wire.API.Routes.Public.Galley (ConversationResponse) import Wire.API.Routes.Public.Util import Wire.API.Team.LegalHold (LegalholdProtectee (LegalholdPlusFederationNotImplemented)) @@ -96,13 +98,9 @@ createRegularGroupConv :: UserId -> ConnId -> NewConvUnmanaged -> Galley Convers createRegularGroupConv zusr zcon (NewConvUnmanaged body) = do lusr <- qualifyLocal zusr name <- rangeCheckedMaybe (newConvName body) - let unqualifiedUserIds = newConvUsers body - qualifiedUserIds = newConvQualifiedUsers body - allUsers = - toUserList lusr $ - map (qUntagged . qualifyAs lusr) unqualifiedUserIds <> qualifiedUserIds + let allUsers = newConvMembers lusr body checkedUsers <- checkedConvSize allUsers - ensureConnected zusr (ulLocals allUsers) + ensureConnected lusr allUsers checkRemoteUsersExist (ulRemotes allUsers) ensureNoLegalholdConflicts (ulRemotes allUsers) (ulLocals allUsers) c <- @@ -125,11 +123,7 @@ createTeamGroupConv :: UserId -> ConnId -> Public.ConvTeamInfo -> Public.NewConv createTeamGroupConv zusr zcon tinfo body = do lusr <- qualifyLocal zusr name <- rangeCheckedMaybe (newConvName body) - let unqualifiedUserIds = newConvUsers body - qualifiedUserIds = newConvQualifiedUsers body - allUsers = - toUserList lusr $ - map (qUntagged . qualifyAs lusr) unqualifiedUserIds <> qualifiedUserIds + let allUsers = newConvMembers lusr body convTeam = cnvTeamId tinfo zusrMembership <- Data.teamMember convTeam zusr @@ -186,75 +180,157 @@ createSelfConversation zusr = do createOne2OneConversation :: UserId -> ConnId -> NewConvUnmanaged -> Galley ConversationResponse createOne2OneConversation zusr zcon (NewConvUnmanaged j) = do lusr <- qualifyLocal zusr - otherUserId <- head . fromRange <$> (rangeChecked (newConvUsers j) :: Galley (Range 1 1 [UserId])) - (x, y) <- toUUIDs zusr otherUserId - when (x == y) $ - throwM $ - invalidOp "Cannot create a 1-1 with yourself" - case newConvTeam j of + let allUsers = newConvMembers lusr j + other <- ensureOne (ulAll lusr allUsers) + when (qUntagged lusr == other) $ + throwM (invalidOp "Cannot create a 1-1 with yourself") + mtid <- case newConvTeam j of Just ti | cnvManaged ti -> throwM noManagedTeamConv - | otherwise -> - checkBindingTeamPermissions zusr otherUserId (cnvTeamId ti) - Nothing -> do - ensureConnected zusr [otherUserId] + | otherwise -> do + foldQualified + lusr + (\lother -> checkBindingTeamPermissions lusr lother (cnvTeamId ti)) + (const (pure Nothing)) + other + Nothing -> ensureConnected lusr allUsers $> Nothing n <- rangeCheckedMaybe (newConvName j) - c <- Data.conversation (Data.one2OneConvId x y) - maybe (create lusr x y n $ newConvTeam j) (conversationExisted zusr) c + foldQualified + lusr + (createLegacyOne2OneConversationUnchecked lusr zcon n mtid) + (createOne2OneConversationUnchecked lusr zcon n mtid . qUntagged) + other where verifyMembership tid u = do membership <- Data.teamMember tid u when (isNothing membership) $ throwM noBindingTeamMembers - checkBindingTeamPermissions x y tid = do - zusrMembership <- Data.teamMember tid zusr + checkBindingTeamPermissions lusr lother tid = do + zusrMembership <- Data.teamMember tid (tUnqualified lusr) void $ permissionCheck CreateConversation zusrMembership Data.teamBinding tid >>= \case Just Binding -> do - verifyMembership tid x - verifyMembership tid y + verifyMembership tid (tUnqualified lusr) + verifyMembership tid (tUnqualified lother) + pure (Just tid) Just _ -> throwM nonBindingTeam Nothing -> throwM teamNotFound - create lusr x y n tinfo = do - c <- Data.createOne2OneConversation lusr x y n (cnvTeamId <$> tinfo) - notifyCreatedConversation Nothing zusr (Just zcon) c - conversationCreated zusr c -createConnectConversationH :: UserId ::: Maybe ConnId ::: JsonRequest Connect -> Galley Response -createConnectConversationH (usr ::: conn ::: req) = do - j <- fromJsonBody req - handleConversationResponse <$> createConnectConversation usr conn j +createLegacyOne2OneConversationUnchecked :: + Local UserId -> + ConnId -> + Maybe (Range 1 256 Text) -> + Maybe TeamId -> + Local UserId -> + Galley ConversationResponse +createLegacyOne2OneConversationUnchecked self zcon name mtid other = do + lcnv <- localOne2OneConvId self other + mc <- Data.conversation (tUnqualified lcnv) + case mc of + Just c -> conversationExisted (tUnqualified self) c + Nothing -> do + (x, y) <- toUUIDs (tUnqualified self) (tUnqualified other) + c <- Data.createLegacyOne2OneConversation self x y name mtid + notifyCreatedConversation Nothing (tUnqualified self) (Just zcon) c + conversationCreated (tUnqualified self) c + +createOne2OneConversationUnchecked :: + Local UserId -> + ConnId -> + Maybe (Range 1 256 Text) -> + Maybe TeamId -> + Qualified UserId -> + Galley ConversationResponse +createOne2OneConversationUnchecked self zcon name mtid other = do + let create = + foldQualified + self + createOne2OneConversationLocally + createOne2OneConversationRemotely + create (one2OneConvId (qUntagged self) other) self zcon name mtid other + +createOne2OneConversationLocally :: + Local ConvId -> + Local UserId -> + ConnId -> + Maybe (Range 1 256 Text) -> + Maybe TeamId -> + Qualified UserId -> + Galley ConversationResponse +createOne2OneConversationLocally lcnv self zcon name mtid other = do + mc <- Data.conversation (tUnqualified lcnv) + case mc of + Just c -> conversationExisted (tUnqualified self) c + Nothing -> do + c <- Data.createOne2OneConversation lcnv self other name mtid + notifyCreatedConversation Nothing (tUnqualified self) (Just zcon) c + conversationCreated (tUnqualified self) c + +createOne2OneConversationRemotely :: + Remote ConvId -> + Local UserId -> + ConnId -> + Maybe (Range 1 256 Text) -> + Maybe TeamId -> + Qualified UserId -> + Galley ConversationResponse +createOne2OneConversationRemotely _ _ _ _ _ _ = + throwM federationNotImplemented -createConnectConversation :: UserId -> Maybe ConnId -> Connect -> Galley ConversationResponse +createConnectConversation :: + UserId -> + Maybe ConnId -> + Connect -> + Galley ConversationResponse createConnectConversation usr conn j = do lusr <- qualifyLocal usr - (x, y) <- toUUIDs usr (cRecipient j) + foldQualified + lusr + (\lrcpt -> createLegacyConnectConversation lusr conn lrcpt j) + (createConnectConversationWithRemote lusr conn) + (cRecipient j) + +createConnectConversationWithRemote :: + Local UserId -> + Maybe ConnId -> + Remote UserId -> + Galley ConversationResponse +createConnectConversationWithRemote _ _ _ = + throwM federationNotImplemented + +createLegacyConnectConversation :: + Local UserId -> + Maybe ConnId -> + Local UserId -> + Connect -> + Galley ConversationResponse +createLegacyConnectConversation lusr conn lrecipient j = do + (x, y) <- toUUIDs (tUnqualified lusr) (tUnqualified lrecipient) n <- rangeCheckedMaybe (cName j) - conv <- Data.conversation (Data.one2OneConvId x y) - maybe (create lusr x y n) (update n) conv + conv <- Data.conversation (Data.localOne2OneConvId x y) + maybe (create x y n) (update n) conv where - create lusr x y n = do + create x y n = do c <- Data.createConnectConversation lusr x y n now <- liftIO getCurrentTime let lcid = qualifyAs lusr (Data.convId c) e = Event ConvConnect (qUntagged lcid) (qUntagged lusr) now (EdConnect j) - notifyCreatedConversation Nothing usr conn c - for_ (newPushLocal ListComplete usr (ConvEvent e) (recipient <$> Data.convLocalMembers c)) $ \p -> + notifyCreatedConversation Nothing (tUnqualified lusr) conn c + for_ (newPushLocal ListComplete (tUnqualified lusr) (ConvEvent e) (recipient <$> Data.convLocalMembers c)) $ \p -> push1 $ p & pushRoute .~ RouteDirect & pushConn .~ conn - conversationCreated usr c + conversationCreated (tUnqualified lusr) c update n conv = do let mems = Data.convLocalMembers conv - in conversationExisted usr + in conversationExisted (tUnqualified lusr) =<< if - | usr `isMember` mems -> + | (tUnqualified lusr) `isMember` mems -> -- we already were in the conversation, maybe also other connect n conv | otherwise -> do lcid <- qualifyLocal (Data.convId conv) - lusr <- qualifyLocal usr mm <- Data.addMember lcid lusr let conv' = conv @@ -266,7 +342,7 @@ createConnectConversation usr conn j = do connect n conv' else do -- we were not in the conversation, but someone else - conv'' <- acceptOne2One usr conv' conn + conv'' <- acceptOne2One (tUnqualified lusr) conv' conn if Data.convType conv'' == ConnectConv then connect n conv'' else return conv'' @@ -274,15 +350,14 @@ createConnectConversation usr conn j = do | Data.convType conv == ConnectConv = do localDomain <- viewFederationDomain let qconv = Qualified (Data.convId conv) localDomain - qusr = Qualified usr localDomain n' <- case n of Just x -> do Data.updateConversation (Data.convId conv) x return . Just $ fromRange x Nothing -> return $ Data.convName conv t <- liftIO getCurrentTime - let e = Event ConvConnect qconv qusr t (EdConnect j) - for_ (newPushLocal ListComplete usr (ConvEvent e) (recipient <$> Data.convLocalMembers conv)) $ \p -> + let e = Event ConvConnect qconv (qUntagged lusr) t (EdConnect j) + for_ (newPushLocal ListComplete (tUnqualified lusr) (ConvEvent e) (recipient <$> Data.convLocalMembers conv)) $ \p -> push1 $ p & pushRoute .~ RouteDirect @@ -330,6 +405,11 @@ notifyCreatedConversation dtime usr conn c = do & pushConn .~ conn & pushRoute .~ route +localOne2OneConvId :: Local UserId -> Local UserId -> Galley (Local ConvId) +localOne2OneConvId self other = do + (x, y) <- toUUIDs (tUnqualified self) (tUnqualified other) + pure . qualifyAs self $ Data.localOne2OneConvId x y + toUUIDs :: UserId -> UserId -> Galley (U.UUID U.V4, U.UUID U.V4) toUUIDs a b = do a' <- U.fromUUID (toUUID a) & ifNothing invalidUUID4 @@ -343,3 +423,12 @@ access :: NewConv -> [Access] access a = case Set.toList (newConvAccess a) of [] -> Data.defRegularConvAccess (x : xs) -> x : xs + +newConvMembers :: Local x -> NewConv -> UserList UserId +newConvMembers loc body = + UserList (newConvUsers body) [] + <> toUserList loc (newConvQualifiedUsers body) + +ensureOne :: [a] -> Galley a +ensureOne [x] = pure x +ensureOne _ = throwM (invalidRange "One-to-one conversations can only have a single invited member") diff --git a/services/galley/src/Galley/API/Internal.hs b/services/galley/src/Galley/API/Internal.hs index 65b8fd7a92e..925e5456f23 100644 --- a/services/galley/src/Galley/API/Internal.hs +++ b/services/galley/src/Galley/API/Internal.hs @@ -43,6 +43,7 @@ import qualified Galley.API.CustomBackend as CustomBackend import Galley.API.Error (throwErrorDescriptionType) import Galley.API.LegalHold (getTeamLegalholdWhitelistedH, setTeamLegalholdWhitelistedH, unsetTeamLegalholdWhitelistedH) import Galley.API.LegalHold.Conflicts (guardLegalholdPolicyConflicts) +import qualified Galley.API.One2One as One2One import qualified Galley.API.Query as Query import Galley.API.Teams (uncheckedDeleteTeamMember) import qualified Galley.API.Teams as Teams @@ -57,6 +58,7 @@ import qualified Galley.Queue as Q import Galley.Types import Galley.Types.Bot (AddBot, RemoveBot) import Galley.Types.Bot.Service +import Galley.Types.Conversations.Intra (UpsertOne2OneConversationRequest (..), UpsertOne2OneConversationResponse (..)) import Galley.Types.Teams hiding (MemberLeave) import Galley.Types.Teams.Intra import Galley.Types.Teams.SearchVisibility @@ -79,6 +81,7 @@ import Wire.API.ErrorDescription (MissingLegalholdConsent) import Wire.API.Routes.MultiTablePaging (mtpHasMore, mtpPagingState, mtpResults) import Wire.API.Routes.MultiVerb (MultiVerb, RespondEmpty) import Wire.API.Routes.Public (ZOptConn, ZUser) +import Wire.API.Routes.Public.Galley (ConversationVerb) import qualified Wire.API.Team.Feature as Public data InternalApi routes = InternalApi @@ -175,7 +178,29 @@ data InternalApi routes = InternalApi :> ZOptConn :> "i" :> "user" - :> MultiVerb 'DELETE '[Servant.JSON] '[RespondEmpty 200 "Remove a user from Galley"] () + :> MultiVerb 'DELETE '[Servant.JSON] '[RespondEmpty 200 "Remove a user from Galley"] (), + -- This endpoint can lead to the following events being sent: + -- - ConvCreate event to self, if conversation did not exist before + -- - ConvConnect event to self, if other didn't join the connect conversation before + iConnect :: + routes + :- Summary "Create a connect conversation (deprecated)" + :> ZUser + :> ZOptConn + :> "i" + :> "conversations" + :> "connect" + :> ReqBody '[Servant.JSON] Connect + :> ConversationVerb, + iUpsertOne2OneConversation :: + routes + :- Summary "Create or Update a connect or one2one conversation." + :> "i" + :> "conversations" + :> "one2one" + :> "upsert" + :> ReqBody '[Servant.JSON] UpsertOne2OneConversationRequest + :> Post '[Servant.JSON] UpsertOne2OneConversationResponse } deriving (Generic) @@ -250,7 +275,9 @@ servantSitemap = iTeamFeatureStatusClassifiedDomainsGet = iGetTeamFeature @'Public.TeamFeatureClassifiedDomains Features.getClassifiedDomainsInternal, iTeamFeatureStatusConferenceCallingPut = iPutTeamFeature @'Public.TeamFeatureConferenceCalling Features.setConferenceCallingInternal, iTeamFeatureStatusConferenceCallingGet = iGetTeamFeature @'Public.TeamFeatureConferenceCalling Features.getConferenceCallingInternal, - iDeleteUser = rmUser + iDeleteUser = rmUser, + iConnect = Create.createConnectConversation, + iUpsertOne2OneConversation = One2One.iUpsertOne2OneConversation } iGetTeamFeature :: @@ -290,14 +317,6 @@ sitemap = do .&. zauthConnId .&. jsonRequest @NewConvManaged - -- This endpoint can lead to the following events being sent: - -- - ConvCreate event to self, if conversation did not exist before - -- - ConvConnect event to self, if other didn't join the connect conversation before - post "/i/conversations/connect" (continue Create.createConnectConversationH) $ - zauthUserId - .&. opt zauthConnId - .&. jsonRequest @Connect - -- This endpoint can lead to the following events being sent: -- - MemberJoin event to you, if the conversation existed and had < 2 members before -- - MemberJoin event to other, if the conversation existed and only the other was member diff --git a/services/galley/src/Galley/API/One2One.hs b/services/galley/src/Galley/API/One2One.hs new file mode 100644 index 00000000000..fa9de3f254b --- /dev/null +++ b/services/galley/src/Galley/API/One2One.hs @@ -0,0 +1,166 @@ +-- This file is part of the Wire Server implementation. +-- +-- Copyright (C) 2021 Wire Swiss GmbH +-- +-- This program is free software: you can redistribute it and/or modify it under +-- the terms of the GNU Affero General Public License as published by the Free +-- Software Foundation, either version 3 of the License, or (at your option) any +-- later version. +-- +-- This program is distributed in the hope that it will be useful, but WITHOUT +-- ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS +-- FOR A PARTICULAR PURPOSE. See the GNU Affero General Public License for more +-- details. +-- +-- You should have received a copy of the GNU Affero General Public License along +-- with this program. If not, see . +{-# LANGUAGE RecordWildCards #-} + +module Galley.API.One2One + ( one2OneConvId, + iUpsertOne2OneConversation, + ) +where + +import Control.Error (atMay) +import qualified Crypto.Hash as Crypto +import Data.Bits +import Data.ByteArray (convert) +import qualified Data.ByteString as B +import Data.ByteString.Conversion +import qualified Data.ByteString.Lazy as L +import Data.Id +import Data.Qualified +import Data.UUID (UUID) +import qualified Data.UUID as UUID +import qualified Data.UUID.Tagged as U +import Galley.App (Galley) +import qualified Galley.Data as Data +import Galley.Types.Conversations.Intra (Actor (..), DesiredMembership (..), UpsertOne2OneConversationRequest (..), UpsertOne2OneConversationResponse (..)) +import Galley.Types.UserList (UserList (..)) +import Imports + +-- | The hash function used to obtain the 1-1 conversation ID for a pair of users. +-- +-- /Note/: the hash function must always return byte strings of length > 16. +hash :: ByteString -> ByteString +hash = convert . Crypto.hash @ByteString @Crypto.SHA256 + +-- | A randomly-generated UUID to use as a namespace for the UUIDv5 of 1-1 +-- conversation IDs +namespace :: UUID +namespace = UUID.fromWords 0x9a51edb8 0x060c0d9a 0x0c2950a8 0x5d152982 + +compareDomains :: Ord a => Qualified a -> Qualified a -> Ordering +compareDomains (Qualified a1 dom1) (Qualified a2 dom2) = + compare (dom1, a1) (dom2, a2) + +quidToByteString :: Qualified UserId -> ByteString +quidToByteString (Qualified uid domain) = toByteString' uid <> toByteString' domain + +-- | This function returns the 1-1 conversation for a given pair of users. +-- +-- Let A, B denote the (not necessarily distinct) backends of the two users, +-- with the domain of A less or equal than the domain of B in the lexicographic +-- ordering of their ascii encodings. Given users a@A and b@B, the UUID and +-- owning domain of the unique 1-1 conversation between a and b shall be a +-- deterministic function of the input data, plus some fixed parameters, as +-- described below. +-- +-- __Parameters__ +-- +-- * A (collision-resistant) hash function h with N bits of output, where N +-- s a multiple of 8 strictly larger than 128; this is set to SHA256. +-- * A "namespace" UUID n. +-- +-- __Algorithm__ +-- +-- First, in the special case where A and B are the same backend, assume that +-- the UUID of a is lower than that of b. If that is not the case, swap a +-- and b in the following. This is necessary to ensure that the function we +-- describe below is symmetric in its arguments. +-- Let c be the bytestring obtained as the concatenation of the following 5 +-- components: +-- +-- * the 16 bytes of the namespace n +-- * the 16 bytes of the UUID of a +-- * the ascii encoding of the domain of A +-- * the 16 bytes of the UUID of b +-- * the ascii encoding of the domain of B, +-- +-- and let x = h(c) be its hashed value. The UUID of the 1-1 conversation +-- between a and b is obtained by converting the first 128 bits of x to a UUID +-- V5. Note that our use of V5 here is not strictly compliant with RFC 4122, +-- since we are using a custom hash and not necessarily SHA1. +-- +-- The owning domain for the conversation is set to be A if bit 128 of x (i.e. +-- the most significant bit of the octet at index 16) is 0, and B otherwise. +-- This is well-defined, because we assumed the number of bits of x to be +-- strictly larger than 128. +one2OneConvId :: Qualified UserId -> Qualified UserId -> Qualified ConvId +one2OneConvId a b = case compareDomains a b of + GT -> one2OneConvId b a + _ -> + let c = + mconcat + [ L.toStrict (UUID.toByteString namespace), + quidToByteString a, + quidToByteString b + ] + x = hash c + result = + U.toUUID . U.mk @U.V5 + . fromMaybe UUID.nil + -- fromByteString only returns 'Nothing' when the input is not + -- exactly 16 bytes long, here this should not be a case since + -- 'hash' is supposed to return atleast 16 bytes and we use 'B.take + -- 16' to truncate it + . UUID.fromByteString + . L.fromStrict + . B.take 16 + $ x + domain + | fromMaybe 0 (atMay (B.unpack x) 16) .&. 0x80 == 0 = qDomain a + | otherwise = qDomain b + in Qualified (Id result) domain + +iUpsertOne2OneConversation :: UpsertOne2OneConversationRequest -> Galley UpsertOne2OneConversationResponse +iUpsertOne2OneConversation UpsertOne2OneConversationRequest {..} = do + let convId = fromMaybe (one2OneConvId (qUntagged uooLocalUser) (qUntagged uooRemoteUser)) uooConvId + + let dolocal :: Local ConvId -> Galley () + dolocal lconvId = do + mbConv <- Data.conversation (tUnqualified lconvId) + case mbConv of + Nothing -> do + let members = + case (uooActor, uooActorDesiredMembership) of + (LocalActor, Included) -> UserList [tUnqualified uooLocalUser] [] + (LocalActor, Excluded) -> UserList [] [] + (RemoteActor, Included) -> UserList [] [uooRemoteUser] + (RemoteActor, Excluded) -> UserList [] [] + unless (null members) $ + Data.createConnectConversationWithRemote lconvId uooLocalUser members + Just conv -> do + case (uooActor, uooActorDesiredMembership) of + (LocalActor, Included) -> do + void $ Data.addMember lconvId uooLocalUser + unless (null (Data.convRemoteMembers conv)) $ + Data.acceptConnect (tUnqualified lconvId) + (LocalActor, Excluded) -> Data.removeMember (tUnqualified uooLocalUser) (tUnqualified lconvId) + (RemoteActor, Included) -> do + void $ Data.addMembers lconvId (UserList [] [uooRemoteUser]) + unless (null (Data.convLocalMembers conv)) $ + Data.acceptConnect (tUnqualified lconvId) + (RemoteActor, Excluded) -> Data.removeRemoteMembersFromLocalConv (tUnqualified lconvId) (pure uooRemoteUser) + doremote :: Remote ConvId -> Galley () + doremote rconvId = + case (uooActor, uooActorDesiredMembership) of + (LocalActor, Included) -> do + Data.addLocalMembersToRemoteConv (qUntagged rconvId) [tUnqualified uooLocalUser] + (LocalActor, Excluded) -> do + Data.removeLocalMembersFromRemoteConv (qUntagged rconvId) [tUnqualified uooLocalUser] + (RemoteActor, _) -> pure () + + foldQualified uooLocalUser dolocal doremote convId + pure (UpsertOne2OneConversationResponse convId) diff --git a/services/galley/src/Galley/API/Util.hs b/services/galley/src/Galley/API/Util.hs index 045588dc954..f12365ae722 100644 --- a/services/galley/src/Galley/API/Util.hs +++ b/services/galley/src/Galley/API/Util.hs @@ -99,18 +99,17 @@ ensureConnectedOrSameTeam (Qualified u domain) uids = do sameTeamUids <- forM uTeams $ \team -> fmap (view userId) <$> Data.teamMembersLimited team uids -- Do not check connections for users that are on the same team - ensureConnected u (uids \\ join sameTeamUids) + ensureConnectedToLocals u (uids \\ join sameTeamUids) -- | Check that the user is connected to everybody else. -- -- The connection has to be bidirectional (e.g. if A connects to B and later -- B blocks A, the status of A-to-B is still 'Accepted' but it doesn't mean -- that they are connected). -ensureConnected :: UserId -> [UserId] -> Galley () -ensureConnected _ [] = pure () -ensureConnected u localUserIds = do +ensureConnected :: Local UserId -> UserList UserId -> Galley () +ensureConnected self others = do -- FUTUREWORK(federation, #1262): check remote connections - ensureConnectedToLocals u localUserIds + ensureConnectedToLocals (tUnqualified self) (ulLocals others) ensureConnectedToLocals :: UserId -> [UserId] -> Galley () ensureConnectedToLocals _ [] = pure () diff --git a/services/galley/src/Galley/Data.hs b/services/galley/src/Galley/Data.hs index 55be7a13813..0e3267a7f54 100644 --- a/services/galley/src/Galley/Data.hs +++ b/services/galley/src/Galley/Data.hs @@ -68,7 +68,9 @@ module Galley.Data conversationMeta, conversationsRemote, createConnectConversation, + createConnectConversationWithRemote, createConversation, + createLegacyOne2OneConversation, createOne2OneConversation, createSelfConversation, isConvAlive, @@ -112,7 +114,7 @@ module Galley.Data updateClient, -- * Utilities - one2OneConvId, + localOne2OneConvId, newMember, -- * Defaults @@ -156,7 +158,14 @@ import Galley.Types.Clients (Clients) import qualified Galley.Types.Clients as Clients import Galley.Types.Conversations.Members import Galley.Types.Conversations.Roles -import Galley.Types.Teams hiding (Event, EventType (..), teamConversations, teamMembers) +import Galley.Types.Teams hiding + ( Event, + EventType (..), + self, + teamConversations, + teamMembers, + ) +import qualified Galley.Types.Teams as Teams import Galley.Types.Teams.Intra import Galley.Types.UserList import Galley.Validation @@ -435,7 +444,7 @@ updateTeamMember oldPerms tid uid newPerms = do when (SetBilling `Set.member` lostPerms) $ addPrepQuery Cql.deleteBillingTeamMember (tid, uid) where - permDiff = Set.difference `on` view self + permDiff = Set.difference `on` view Teams.self acquiredPerms = newPerms `permDiff` oldPerms lostPerms = oldPerms `permDiff` newPerms @@ -671,7 +680,7 @@ createConnectConversation :: Maybe (Range 1 256 Text) -> m Conversation createConnectConversation loc a b name = do - let conv = one2OneConvId a b + let conv = localOne2OneConvId a b lconv = qualifyAs loc conv a' = Id . U.unpack $ a retry x5 $ @@ -681,7 +690,20 @@ createConnectConversation loc a b name = do (lmems, rmems) <- addMembers lconv (UserList [a'] []) pure $ newConv conv ConnectConv a' lmems rmems [PrivateAccess] privateRole name Nothing Nothing Nothing -createOne2OneConversation :: +createConnectConversationWithRemote :: + MonadClient m => + Local ConvId -> + Local UserId -> + UserList UserId -> + m () +createConnectConversationWithRemote lconvId creator m = do + retry x5 $ + write Cql.insertConv (params Quorum (tUnqualified lconvId, ConnectConv, tUnqualified creator, privateOnly, privateRole, Nothing, Nothing, Nothing, Nothing)) + -- We add only one member, second one gets added later, + -- when the other user accepts the connection request. + void $ addMembers lconvId m + +createLegacyOne2OneConversation :: MonadClient m => Local x -> U.UUID U.V4 -> @@ -689,21 +711,36 @@ createOne2OneConversation :: Maybe (Range 1 256 Text) -> Maybe TeamId -> m Conversation -createOne2OneConversation loc a b name ti = do - let conv = one2OneConvId a b +createLegacyOne2OneConversation loc a b name ti = do + let conv = localOne2OneConvId a b lconv = qualifyAs loc conv a' = Id (U.unpack a) b' = Id (U.unpack b) - retry x5 $ case ti of - Nothing -> write Cql.insertConv (params Quorum (conv, One2OneConv, a', privateOnly, privateRole, fromRange <$> name, Nothing, Nothing, Nothing)) + createOne2OneConversation + lconv + (qualifyAs loc a') + (qUntagged (qualifyAs loc b')) + name + ti + +createOne2OneConversation :: + MonadClient m => + Local ConvId -> + Local UserId -> + Qualified UserId -> + Maybe (Range 1 256 Text) -> + Maybe TeamId -> + m Conversation +createOne2OneConversation lconv self other name mtid = do + retry x5 $ case mtid of + Nothing -> write Cql.insertConv (params Quorum (tUnqualified lconv, One2OneConv, tUnqualified self, privateOnly, privateRole, fromRange <$> name, Nothing, Nothing, Nothing)) Just tid -> batch $ do setType BatchLogged setConsistency Quorum - addPrepQuery Cql.insertConv (conv, One2OneConv, a', privateOnly, privateRole, fromRange <$> name, Just tid, Nothing, Nothing) - addPrepQuery Cql.insertTeamConv (tid, conv, False) - -- FUTUREWORK: federated one2one - (lmems, rmems) <- addMembers lconv (UserList [a', b'] []) - pure $ newConv conv One2OneConv a' lmems rmems [PrivateAccess] privateRole name ti Nothing Nothing + addPrepQuery Cql.insertConv (tUnqualified lconv, One2OneConv, tUnqualified self, privateOnly, privateRole, fromRange <$> name, Just tid, Nothing, Nothing) + addPrepQuery Cql.insertTeamConv (tid, tUnqualified lconv, False) + (lmems, rmems) <- addMembers lconv (toUserList self [qUntagged self, other]) + pure $ newConv (tUnqualified lconv) One2OneConv (tUnqualified self) lmems rmems [PrivateAccess] privateRole name mtid Nothing Nothing updateConversation :: MonadClient m => ConvId -> Range 1 256 Text -> m () updateConversation cid name = retry x5 $ write Cql.updateConvName (params Quorum (fromRange name, cid)) @@ -736,8 +773,8 @@ acceptConnect cid = retry x5 $ write Cql.updateConvType (params Quorum (One2OneC -- together pairwise, and then setting the version bits (v4) and variant bits -- (variant 2). This means that we always know what the UUID is for a -- one-to-one conversation which hopefully makes them unique. -one2OneConvId :: U.UUID U.V4 -> U.UUID U.V4 -> ConvId -one2OneConvId a b = Id . U.unpack $ U.addv4 a b +localOne2OneConvId :: U.UUID U.V4 -> U.UUID U.V4 -> ConvId +localOne2OneConvId a b = Id . U.unpack $ U.addv4 a b newConv :: ConvId -> @@ -845,7 +882,7 @@ toRemoteMember :: UserId -> Domain -> RoleName -> RemoteMember toRemoteMember u d = RemoteMember (toRemoteUnsafe d u) memberLists :: - (MonadClient m, Log.MonadLogger m, MonadThrow m) => + (MonadClient m, MonadThrow m) => [ConvId] -> m [[LocalMember]] memberLists convs = do @@ -860,7 +897,7 @@ memberLists convs = do mkMem (cnv, usr, srv, prv, st, omus, omur, oar, oarr, hid, hidr, crn) = (cnv, toMember (usr, srv, prv, st, omus, omur, oar, oarr, hid, hidr, crn)) -members :: (MonadClient m, Log.MonadLogger m, MonadThrow m) => ConvId -> m [LocalMember] +members :: (MonadClient m, MonadThrow m) => ConvId -> m [LocalMember] members conv = join <$> memberLists [conv] lookupRemoteMembers :: (MonadClient m) => ConvId -> m [RemoteMember] diff --git a/services/galley/src/Galley/Types/UserList.hs b/services/galley/src/Galley/Types/UserList.hs index ffcabd6984e..c63148d6b97 100644 --- a/services/galley/src/Galley/Types/UserList.hs +++ b/services/galley/src/Galley/Types/UserList.hs @@ -33,6 +33,13 @@ data UserList a = UserList } deriving (Functor, Foldable, Traversable) +instance Semigroup (UserList a) where + UserList locals1 remotes1 <> UserList locals2 remotes2 = + UserList (locals1 <> locals2) (remotes1 <> remotes2) + +instance Monoid (UserList a) where + mempty = UserList mempty mempty + toUserList :: Foldable f => Local x -> f (Qualified a) -> UserList a toUserList loc = uncurry UserList . partitionQualified loc diff --git a/services/galley/test/integration/API.hs b/services/galley/test/integration/API.hs index 7d0b95730bf..5a3b6e8cb3d 100644 --- a/services/galley/test/integration/API.hs +++ b/services/galley/test/integration/API.hs @@ -59,9 +59,13 @@ import Data.String.Conversions (cs) import qualified Data.Text as T import qualified Data.Text.Ascii as Ascii import Data.Time.Clock (getCurrentTime) +import Database.CQL.IO import Galley.API.Mapping +import Galley.API.One2One (one2OneConvId) +import qualified Galley.Data as Data import Galley.Options (Opts, optFederator) import Galley.Types hiding (LocalMember (..)) +import Galley.Types.Conversations.Intra import Galley.Types.Conversations.Members import Galley.Types.Conversations.Roles import qualified Galley.Types.Teams as Teams @@ -215,7 +219,8 @@ tests s = test s "convert invite to code-access conversation" postConvertCodeConv, test s "convert code to team-access conversation" postConvertTeamConv, test s "cannot join private conversation" postJoinConvFail, - test s "remove user" removeUser + test s "remove user" removeUser, + test s "iUpsertOne2OneConversation" testAllOne2OneConversationRequests ] emptyFederatedBrig :: FederatedBrig.Api (AsServerT Handler) @@ -1573,11 +1578,11 @@ postConnectConvOk2 :: TestM () postConnectConvOk2 = do alice <- randomUser bob <- randomUser - m <- decodeConvId <$> request alice bob - n <- decodeConvId <$> request alice bob + m <- decodeConvId <$> req alice bob + n <- decodeConvId <$> req alice bob liftIO $ m @=? n where - request alice bob = + req alice bob = postConnectConv alice bob "Alice" "connect with me!" (Just "me@me.com") putConvAcceptOk :: TestM () @@ -2942,3 +2947,54 @@ removeUser = do omService = Nothing, omConvRoleName = roleNameWireAdmin } + +testAllOne2OneConversationRequests :: TestM () +testAllOne2OneConversationRequests = do + for_ [LocalActor, RemoteActor] $ \actor -> + for_ [Included, Excluded] $ \desired -> + for_ [True, False] $ \shouldBeLocal -> + testOne2OneConversationRequest shouldBeLocal actor desired + +testOne2OneConversationRequest :: Bool -> Actor -> DesiredMembership -> TestM () +testOne2OneConversationRequest shouldBeLocal actor desired = do + alice <- qTagUnsafe <$> randomQualifiedUser + (bob, expectedConvId) <- generateRemoteAndConvId alice + db <- view tsCass + + convId <- do + let req = UpsertOne2OneConversationRequest alice bob actor desired Nothing + res <- + iUpsertOne2OneConversation req + responseJsonError res + + liftIO $ convId @?= expectedConvId + + case shouldBeLocal of + True -> do + mems <- runClient db $ do + lmems <- fmap (qUntagged . qualifyAs alice . lmId) <$> Data.members (qUnqualified convId) + rmems <- fmap (qUntagged . rmId) <$> Data.lookupRemoteMembers (qUnqualified convId) + pure (lmems <> rmems) + let actorId = case actor of + LocalActor -> qUntagged alice + RemoteActor -> qUntagged bob + liftIO $ isJust (find (actorId ==) mems) @?= (desired == Included) + liftIO $ filter (actorId /=) mems @?= [] + False -> do + mems <- runClient db $ do + smap <- Data.remoteConversationStatus (tUnqualified alice) [qTagUnsafe convId] + case Map.lookup (qTagUnsafe convId) smap of + Just _ -> pure [qUntagged alice] + _ -> pure [] + when (actor == LocalActor) $ + liftIO $ isJust (find (qUntagged alice ==) mems) @?= (desired == Included) + where + generateRemoteAndConvId :: Local UserId -> TestM (Remote UserId, Qualified ConvId) + generateRemoteAndConvId lUserId = do + other <- Qualified <$> randomId <*> pure (Domain "far-away.example.com") + let convId = one2OneConvId (qUntagged lUserId) other + isLocal = tDomain lUserId == qDomain convId + if shouldBeLocal == isLocal + then pure (qTagUnsafe other, convId) + else generateRemoteAndConvId lUserId diff --git a/services/galley/test/integration/API/Util.hs b/services/galley/test/integration/API/Util.hs index ec3bbcc83fc..aa6549d3ebf 100644 --- a/services/galley/test/integration/API/Util.hs +++ b/services/galley/test/integration/API/Util.hs @@ -71,6 +71,7 @@ import qualified Galley.Options as Opts import qualified Galley.Run as Run import Galley.Types import qualified Galley.Types as Conv +import Galley.Types.Conversations.Intra (UpsertOne2OneConversationRequest (..)) import Galley.Types.Conversations.Roles hiding (DeleteConversation) import Galley.Types.Teams hiding (Event, EventType (..)) import qualified Galley.Types.Teams as Team @@ -594,6 +595,7 @@ postO2OConv u1 u2 n = do postConnectConv :: UserId -> UserId -> Text -> Text -> Maybe Text -> TestM ResponseLBS postConnectConv a b name msg email = do + qb <- Qualified <$> pure b <*> viewFederationDomain g <- view tsGalley post $ g @@ -601,7 +603,7 @@ postConnectConv a b name msg email = do . zUser a . zConn "conn" . zType "access" - . json (Connect b (Just msg) (Just name) email) + . json (Connect qb (Just msg) (Just name) email) putConvAccept :: UserId -> ConvId -> TestM ResponseLBS putConvAccept invited cid = do @@ -2328,3 +2330,8 @@ fedRequestsForDomain domain component = assertOne :: (HasCallStack, MonadIO m, Show a) => [a] -> m a assertOne [a] = pure a assertOne xs = liftIO . assertFailure $ "Expected exactly one element, found " <> show xs + +iUpsertOne2OneConversation :: UpsertOne2OneConversationRequest -> TestM ResponseLBS +iUpsertOne2OneConversation req = do + galley <- view tsGalley + post (galley . path "/i/conversations/one2one/upsert" . Bilge.json req) diff --git a/services/galley/test/unit/Main.hs b/services/galley/test/unit/Main.hs index c0a1dbcdd31..bfd608d4db7 100644 --- a/services/galley/test/unit/Main.hs +++ b/services/galley/test/unit/Main.hs @@ -23,6 +23,7 @@ where import Imports import qualified Test.Galley.API import qualified Test.Galley.API.Message +import qualified Test.Galley.API.One2One import qualified Test.Galley.Intra.User import qualified Test.Galley.Mapping import qualified Test.Galley.Roundtrip @@ -34,6 +35,7 @@ main = =<< sequence [ pure Test.Galley.API.tests, pure Test.Galley.API.Message.tests, + pure Test.Galley.API.One2One.tests, pure Test.Galley.Intra.User.tests, pure Test.Galley.Mapping.tests, Test.Galley.Roundtrip.tests diff --git a/services/galley/test/unit/Test/Galley/API/One2One.hs b/services/galley/test/unit/Test/Galley/API/One2One.hs new file mode 100644 index 00000000000..d3f6f0332fe --- /dev/null +++ b/services/galley/test/unit/Test/Galley/API/One2One.hs @@ -0,0 +1,51 @@ +{-# LANGUAGE NumericUnderscores #-} + +-- This file is part of the Wire Server implementation. +-- +-- Copyright (C) 2021 Wire Swiss GmbH +-- +-- This program is free software: you can redistribute it and/or modify it under +-- the terms of the GNU Affero General Public License as published by the Free +-- Software Foundation, either version 3 of the License, or (at your option) any +-- later version. +-- +-- This program is distributed in the hope that it will be useful, but WITHOUT +-- ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS +-- FOR A PARTICULAR PURPOSE. See the GNU Affero General Public License for more +-- details. +-- +-- You should have received a copy of the GNU Affero General Public License along +-- with this program. If not, see . + +-- | Tests for one-to-one conversations +module Test.Galley.API.One2One where + +import Data.Id +import Data.List.Extra +import Data.Qualified +import Galley.API.One2One (one2OneConvId) +import Imports +import Test.Tasty +import Test.Tasty.HUnit (Assertion, testCase, (@?=)) +import Test.Tasty.QuickCheck + +tests :: TestTree +tests = + testGroup + "one2OneConvId" + [ testProperty "symmetry" one2OneConvIdSymmetry, + testCase "non-collision" one2OneConvIdNonCollision + ] + +one2OneConvIdSymmetry :: Qualified UserId -> Qualified UserId -> Property +one2OneConvIdSymmetry quid1 quid2 = one2OneConvId quid1 quid2 === one2OneConvId quid2 quid1 + +-- | Make sure that we never get the same conversation ID for a pair of +-- (assumingly) distinct qualified user IDs +one2OneConvIdNonCollision :: Assertion +one2OneConvIdNonCollision = do + let len = 10_000 + -- A generator of lists of length 'len' of qualified user ID pairs + let gen = vectorOf len arbitrary + quids <- head <$> sample' gen + anySame (fmap (uncurry one2OneConvId) quids) @?= False