Create remote 1-1 conversations

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.

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

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

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

@@ -0,0 +1,89 @@
+-- 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.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
+  { -- | The Nothing value here indicated that there an impossible request was
+    -- received, e.g., a remote actor for a remotely owned connect conversation
+    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

libs/types-common/src/Data/UUID/Tagged.hs

@@ -17,48 +17,60 @@
 
 module Data.UUID.Tagged
   ( UUID,
+    toUUID,
     V4,
+    V5,
     Version (..),
     version,
     variant,
     addv4,
     unpack,
+    create,
+    mk,
   )
 where
 
 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

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))

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"
 }

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"
 }

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",

libs/wire-api/test/unit/Test/Wire/API/Golden/Generated/Connect_user.hs

@@ -16,15 +16,20 @@
 -- with this program. If not, see <https://www.gnu.org/licenses/>.
 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 (..))
 
 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

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"

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