Update One2One conversation when connection status changes

changelog.d/6-federation/update-one2ones

@@ -0,0 +1 @@
+Update One2One conversation when connection status changes

libs/galley-types/galley-types.cabal

@@ -4,7 +4,7 @@ cabal-version: 1.12
 --
 -- see: https://github.com/sol/hpack
 --
--- hash: d7419acbff460382bb822952b693f55513e729a4e3bcd0ddfdeea9e5285a805b
+-- hash: ccecf8384a3050034fc05928ae9bd039006f4479289f73de11832052791a691f
 
 name:           galley-types
 version:        0.81.0
@@ -24,6 +24,7 @@ library
       Galley.Types.Bot.Service
       Galley.Types.Conversations.Intra
       Galley.Types.Conversations.Members
+      Galley.Types.Conversations.One2One
       Galley.Types.Conversations.Roles
       Galley.Types.Teams
       Galley.Types.Teams.Intra
@@ -38,17 +39,23 @@ library
       QuickCheck
     , aeson >=0.6
     , base >=4 && <5
+    , bytestring
+    , bytestring-conversion
     , containers >=0.5
+    , cryptonite
     , currency-codes >=2.0
+    , errors
     , exceptions >=0.10.0
     , imports
     , lens >=4.12
+    , memory
     , schema-profunctor
     , string-conversions
     , tagged
     , text >=0.11
     , time >=1.4
     , types-common >=0.16
+    , uuid
     , wire-api
   default-language: Haskell2010
 

libs/galley-types/package.yaml

@@ -16,17 +16,23 @@ library:
   dependencies:
   - aeson >=0.6
   - base >=4 && <5
+  - bytestring
+  - bytestring-conversion
   - containers >=0.5
+  - cryptonite
   - currency-codes >=2.0
+  - errors
   - exceptions >=0.10.0
   - lens >=4.12
+  - memory
   - QuickCheck
   - schema-profunctor
   - string-conversions
   - tagged
   - text >=0.11
   - time >=1.4
   - types-common >=0.16
+  - uuid
 tests:
   galley-types-tests:
     main: Main.hs

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

@@ -0,0 +1,116 @@
+-- This file is part of the Wire Server implementation.
+--
+-- Copyright (C) 2021 Wire Swiss GmbH <opensource@wire.com>
+--
+-- 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 <https://www.gnu.org/licenses/>.
+
+module Galley.Types.Conversations.One2One (one2OneConvId) 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 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

services/brig/src/Brig/API/Connection/Remote.hs

@@ -36,7 +36,7 @@ import Control.Error.Util ((??))
 import Control.Monad.Trans.Except (runExceptT, throwE)
 import Data.Id as Id
 import Data.Qualified
-import Data.UUID.V4
+import Galley.Types.Conversations.Intra (Actor (..), DesiredMembership (..), UpsertOne2OneConversationRequest (..), UpsertOne2OneConversationResponse (uuorConvId))
 import Imports
 import Network.Wai.Utilities.Error
 import Wire.API.Connection (relationWithHistory)
@@ -107,11 +107,32 @@ updateOne2OneConv ::
   Remote UserId ->
   Maybe (Qualified ConvId) ->
   Relation ->
+  Actor ->
   AppIO (Qualified ConvId)
-updateOne2OneConv _ _ _ _ _ = do
-  -- FUTUREWORK: use galley internal API to update 1-1 conversation and retrieve ID
-  uid <- liftIO nextRandom
-  qUntagged <$> qualifyLocal (Id uid)
+updateOne2OneConv lUsr _mbConn remoteUser mbConvId rel actor = do
+  let request =
+        UpsertOne2OneConversationRequest
+          { uooLocalUser = lUsr,
+            uooRemoteUser = remoteUser,
+            uooActor = actor,
+            uooActorDesiredMembership = desiredMembership actor rel,
+            uooConvId = mbConvId
+          }
+  uuorConvId <$> Intra.upsertOne2OneConversation request
+  where
+    desiredMembership :: Actor -> Relation -> DesiredMembership
+    desiredMembership a r =
+      let isIncluded =
+            a
+              `elem` case r of
+                Accepted -> [LocalActor, RemoteActor]
+                Blocked -> []
+                Pending -> [RemoteActor]
+                Ignored -> [RemoteActor]
+                Sent -> [LocalActor]
+                Cancelled -> []
+                MissingLegalholdConsent -> []
+       in if isIncluded then Included else Excluded
 
 -- | Perform a state transition on a connection, handle conversation updates and
 -- push events.
@@ -126,14 +147,15 @@ transitionTo ::
   Remote UserId ->
   Maybe UserConnection ->
   Maybe Relation ->
+  Actor ->
   ConnectionM (ResponseForExistedCreated UserConnection, Bool)
-transitionTo self _ _ Nothing Nothing =
+transitionTo self _ _ Nothing Nothing _ =
   -- This can only happen if someone tries to ignore as a first action on a
   -- connection. This shouldn't be possible.
   throwE (InvalidTransition (tUnqualified self))
-transitionTo self mzcon other Nothing (Just rel) = lift $ do
+transitionTo self mzcon other Nothing (Just rel) actor = lift $ do
   -- update 1-1 connection
-  qcnv <- updateOne2OneConv self mzcon other Nothing rel
+  qcnv <- updateOne2OneConv self mzcon other Nothing rel actor
 
   -- create connection
   connection <-
@@ -146,10 +168,10 @@ transitionTo self mzcon other Nothing (Just rel) = lift $ do
   -- send event
   pushEvent self mzcon connection
   pure (Created connection, True)
-transitionTo _self _zcon _other (Just connection) Nothing = pure (Existed connection, False)
-transitionTo self mzcon other (Just connection) (Just rel) = lift $ do
+transitionTo _self _zcon _other (Just connection) Nothing _actor = pure (Existed connection, False)
+transitionTo self mzcon other (Just connection) (Just rel) actor = lift $ do
   -- update 1-1 conversation
-  void $ updateOne2OneConv self Nothing other (ucConvId connection) rel
+  void $ updateOne2OneConv self Nothing other (ucConvId connection) rel actor
 
   -- update connection
   connection' <- Data.updateConnection connection (relationWithHistory rel)
@@ -184,7 +206,7 @@ performLocalAction self mzcon other mconnection action = do
       fromMaybe rel1 $ do
         reactionAction <- (mreaction :: Maybe RemoteConnectionAction)
         transition (RCA reactionAction) rel1
-  transitionTo self mzcon other mconnection mrel2
+  transitionTo self mzcon other mconnection mrel2 LocalActor
   where
     remoteAction :: LocalConnectionAction -> Maybe RemoteConnectionAction
     remoteAction LocalConnect = Just RemoteConnect
@@ -220,7 +242,7 @@ performRemoteAction ::
 performRemoteAction self other mconnection action = do
   let rel0 = maybe Cancelled ucStatus mconnection
   let rel1 = transition (RCA action) rel0
-  result <- runExceptT . void $ transitionTo self Nothing other mconnection rel1
+  result <- runExceptT . void $ transitionTo self Nothing other mconnection rel1 RemoteActor
   pure $ either (const (Just RemoteRescind)) (const (reaction rel1)) result
   where
     reaction :: Maybe Relation -> Maybe RemoteConnectionAction

services/brig/test/integration/API/User.hs

@@ -41,8 +41,8 @@ import Test.Tasty hiding (Timeout)
 import Util
 import Util.Options.Common
 
-tests :: Opt.Opts -> FedBrigClient -> Manager -> Brig -> Cannon -> CargoHold -> Galley -> Nginz -> AWS.Env -> DB.ClientState -> IO TestTree
-tests conf fbc p b c ch g n aws db = do
+tests :: Opt.Opts -> FedBrigClient -> FedGalleyClient -> Manager -> Brig -> Cannon -> CargoHold -> Galley -> Nginz -> AWS.Env -> DB.ClientState -> IO TestTree
+tests conf fbc fgc p b c ch g n aws db = do
   let cl = ConnectionLimit $ Opt.setUserMaxConnections (Opt.optSettings conf)
   let at = Opt.setActivationTimeout (Opt.optSettings conf)
   z <- mkZAuthEnv (Just conf)
@@ -52,7 +52,7 @@ tests conf fbc p b c ch g n aws db = do
       [ API.User.Client.tests cl at conf p b c g,
         API.User.Account.tests cl at conf p b c ch g aws,
         API.User.Auth.tests conf p z b g n,
-        API.User.Connection.tests cl at conf p b c g fbc db,
+        API.User.Connection.tests cl at conf p b c g fbc fgc db,
         API.User.Handles.tests cl at conf p b c g,
         API.User.PasswordReset.tests cl at conf p b c g,
         API.User.Property.tests cl at conf p b c g,