Check connections when adding remote users to a conv

changelog.d/5-internal/delete-internal-get-conn-status

@@ -0,0 +1 @@
+Brig: Delete deprecated `GET /i/users/connections-status` endpoint.

changelog.d/6-federation/check-connections

@@ -0,0 +1 @@
+Check connections when adding remote users to a local conversation and local users to remote conversations.

changelog.d/6-federation/fix-remote-conv

@@ -0,0 +1 @@
+The creator of a conversation now appears as a member when the conversation is fetched from a remote backend

libs/brig-types/src/Brig/Types/Connection.hs

@@ -25,7 +25,6 @@
 module Brig.Types.Connection
   ( module C,
     UserIds (..),
-    ConnectionsStatusRequest (..),
     UpdateConnectionsInternal (..),
 
     -- * re-exports
@@ -40,6 +39,7 @@ where
 import Brig.Types.Common as C
 import Data.Aeson
 import Data.Id (UserId)
+import Data.Qualified
 import Imports
 import Wire.API.Arbitrary
 import Wire.API.Connection
@@ -51,13 +51,6 @@ data UserIds = UserIds
   {cUsers :: [UserId]}
   deriving (Eq, Show, Generic)
 
--- | Data that is passed to the @\/i\/users\/connections-status@ endpoint.
-data ConnectionsStatusRequest = ConnectionsStatusRequest
-  { csrFrom :: ![UserId],
-    csrTo :: !(Maybe [UserId])
-  }
-  deriving (Eq, Show, Generic)
-
 -- FUTUREWORK: This needs to get Qualified IDs when implementing
 -- Legalhold + Federation, as it's used in the internal
 -- putConnectionInternal / galley->Brig "/i/users/connections-status"
@@ -67,6 +60,8 @@ data ConnectionsStatusRequest = ConnectionsStatusRequest
 data UpdateConnectionsInternal
   = BlockForMissingLHConsent UserId [UserId]
   | RemoveLHBlocksInvolving UserId
+  | -- | This must only be used by tests
+    CreateConnectionForTest UserId (Qualified UserId)
   deriving (Eq, Show, Generic)
   deriving (Arbitrary) via (GenericUniform UpdateConnectionsInternal)
 
@@ -86,16 +81,3 @@ instance ToJSON UserIds where
   toJSON (UserIds us) =
     object
       ["ids" .= us]
-
-instance FromJSON ConnectionsStatusRequest where
-  parseJSON = withObject "ConnectionsStatusRequest" $ \o -> do
-    csrFrom <- o .: "from"
-    csrTo <- o .: "to"
-    pure ConnectionsStatusRequest {..}
-
-instance ToJSON ConnectionsStatusRequest where
-  toJSON ConnectionsStatusRequest {csrFrom, csrTo} =
-    object
-      [ "from" .= csrFrom,
-        "to" .= csrTo
-      ]

libs/brig-types/src/Brig/Types/Intra.hs

@@ -1,4 +1,3 @@
-{-# LANGUAGE GeneralizedNewtypeDeriving #-}
 {-# LANGUAGE OverloadedStrings #-}
 
 -- This file is part of the Wire Server implementation.
@@ -24,7 +23,6 @@ module Brig.Types.Intra
   ( AccountStatus (..),
     AccountStatusUpdate (..),
     AccountStatusResp (..),
-    ConnectionStatus (..),
     UserAccount (..),
     NewUserScimInvitation (..),
     UserSet (..),
@@ -91,30 +89,6 @@ instance FromJSON AccountStatusUpdate where
 instance ToJSON AccountStatusUpdate where
   toJSON s = object ["status" .= suStatus s]
 
--------------------------------------------------------------------------------
--- ConnectionStatus
-
-data ConnectionStatus = ConnectionStatus
-  { csFrom :: !UserId,
-    csTo :: !UserId,
-    csStatus :: !Relation
-  }
-  deriving (Eq, Show, Generic)
-
-instance FromJSON ConnectionStatus where
-  parseJSON = withObject "connection-status" $ \o ->
-    ConnectionStatus <$> o .: "from"
-      <*> o .: "to"
-      <*> o .: "status"
-
-instance ToJSON ConnectionStatus where
-  toJSON cs =
-    object
-      [ "from" .= csFrom cs,
-        "to" .= csTo cs,
-        "status" .= csStatus cs
-      ]
-
 -------------------------------------------------------------------------------
 -- UserAccount
 

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

@@ -36,6 +36,7 @@ module Data.Qualified
     foldQualified,
     partitionQualified,
     indexQualified,
+    bucketQualified,
     indexRemote,
     deprecatedSchema,
   )
@@ -131,6 +132,11 @@ indexQualified = foldr add mempty
     add :: Qualified a -> Map Domain [a] -> Map Domain [a]
     add (Qualified x domain) = Map.insertWith (<>) domain [x]
 
+-- | Bucket a list of qualified values by domain.
+bucketQualified :: Foldable f => f (Qualified a) -> [Qualified [a]]
+bucketQualified = map (\(d, a) -> Qualified a d) . Map.assocs . indexQualified
+
+-- FUTUREWORK: Rename this to 'bucketRemote'
 indexRemote :: (Functor f, Foldable f) => f (Remote a) -> [Remote [a]]
 indexRemote =
   map (uncurry toRemoteUnsafe)

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

@@ -151,7 +151,11 @@ newtype GetConversationsResponse = GetConversationsResponse
 data NewRemoteConversation conv = NewRemoteConversation
   { -- | The time when the conversation was created
     rcTime :: UTCTime,
-    -- | The user that created the conversation
+    -- | The user that created the conversation.
+    --
+    -- FUTUREWORK: Make this unqualified and assume that this user has the same domain
+    -- as the backend invoking this RPC. Otehrwise a third party can figure out
+    -- connections.
     rcOrigUserId :: Qualified UserId,
     -- | The conversation ID, local to the backend invoking the RPC
     rcCnvId :: conv,

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

@@ -48,17 +48,16 @@ where
 import Control.Applicative (optional)
 import Control.Lens ((?~))
 import Data.Aeson as Aeson
-import Data.Attoparsec.ByteString (takeByteString)
-import Data.ByteString.Conversion
 import Data.Id
 import Data.Json.Util (UTCTimeMillis)
 import Data.Qualified (Qualified (qUnqualified), deprecatedSchema)
 import Data.Range
 import qualified Data.Schema as P
+import Data.Swagger as S
 import qualified Data.Swagger.Build.Api as Doc
-import Data.Swagger.Schema as S
 import Data.Text as Text
 import Imports
+import Servant.API
 import Wire.API.Arbitrary (Arbitrary (..), GenericUniform (..))
 import Wire.API.Routes.MultiTablePaging
 
@@ -173,6 +172,9 @@ data Relation
   deriving (Arbitrary) via (GenericUniform Relation)
   deriving (FromJSON, ToJSON, S.ToSchema) via (P.Schema Relation)
 
+instance S.ToParamSchema Relation where
+  toParamSchema _ = mempty & S.type_ ?~ S.SwaggerString
+
 -- | 'updateConnectionInternal', requires knowledge of the previous state (before
 -- 'MissingLegalholdConsent'), but the clients don't need that information.  To avoid having
 -- to change the API, we introduce an internal variant of 'Relation' with surjective mapping
@@ -245,20 +247,19 @@ instance P.ToSchema Relation where
           P.element "missing-legalhold-consent" MissingLegalholdConsent
         ]
 
-instance FromByteString Relation where
-  parser =
-    takeByteString >>= \case
-      "accepted" -> return Accepted
-      "blocked" -> return Blocked
-      "pending" -> return Pending
-      "ignored" -> return Ignored
-      "sent" -> return Sent
-      "cancelled" -> return Cancelled
-      "missing-legalhold-consent" -> return MissingLegalholdConsent
-      x -> fail $ "Invalid relation-type " <> show x
-
-instance ToByteString Relation where
-  builder = \case
+instance FromHttpApiData Relation where
+  parseQueryParam = \case
+    "accepted" -> return Accepted
+    "blocked" -> return Blocked
+    "pending" -> return Pending
+    "ignored" -> return Ignored
+    "sent" -> return Sent
+    "cancelled" -> return Cancelled
+    "missing-legalhold-consent" -> return MissingLegalholdConsent
+    x -> Left $ "Invalid relation-type " <> x
+
+instance ToHttpApiData Relation where
+  toQueryParam = \case
     Accepted -> "accepted"
     Blocked -> "blocked"
     Pending -> "pending"
@@ -267,7 +268,7 @@ instance ToByteString Relation where
     Cancelled -> "cancelled"
     MissingLegalholdConsent -> "missing-legalhold-consent"
 
---------------------------------------------------------------------------------
+----------------
 -- Requests
 
 -- | Payload type for a connection request from one user to another.

libs/wire-api/src/Wire/API/Routes/Internal/Brig.hs

@@ -36,6 +36,8 @@ import qualified Servant
 import Servant.Swagger (HasSwagger (toSwagger))
 import Servant.Swagger.Internal.Orphans ()
 import Servant.Swagger.UI
+import Wire.API.Connection
+import Wire.API.Routes.Internal.Brig.Connection
 import Wire.API.Routes.Internal.Brig.EJPD
 import qualified Wire.API.Team.Feature as ApiFt
 
@@ -85,12 +87,36 @@ type DeleteAccountFeatureConfig =
     :> "conferenceCalling"
     :> Delete '[Servant.JSON] NoContent
 
+type GetAllConnectionsUnqualified =
+  Summary "Get all connections of a given user"
+    :> "users"
+    :> "connections-status"
+    :> ReqBody '[Servant.JSON] ConnectionsStatusRequest
+    :> QueryParam'
+         [ Optional,
+           Strict,
+           Description "Only returns connections with the given relation, if omitted, returns all connections"
+         ]
+         "filter"
+         Relation
+    :> Post '[Servant.JSON] [ConnectionStatus]
+
+type GetAllConnections =
+  Summary "Get all connections of a given user"
+    :> "users"
+    :> "connections-status"
+    :> "v2"
+    :> ReqBody '[Servant.JSON] ConnectionsStatusRequestV2
+    :> Post '[Servant.JSON] [ConnectionStatusV2]
+
 type API =
   "i"
     :> ( EJPDRequest
            :<|> GetAccountFeatureConfig
            :<|> PutAccountFeatureConfig
            :<|> DeleteAccountFeatureConfig
+           :<|> GetAllConnectionsUnqualified
+           :<|> GetAllConnections
        )
 
 type SwaggerDocsAPI = "api" :> "internal" :> SwaggerSchemaUI "swagger-ui" "swagger.json"

libs/wire-api/src/Wire/API/Routes/Internal/Brig/Connection.hs

@@ -0,0 +1,73 @@
+{-# LANGUAGE RecordWildCards #-}
+
+module Wire.API.Routes.Internal.Brig.Connection where
+
+import Data.Aeson (FromJSON, ToJSON)
+import Data.Id
+import Data.Qualified
+import Data.Schema
+import qualified Data.Swagger as S
+import Imports
+import Wire.API.Connection
+
+data ConnectionsStatusRequest = ConnectionsStatusRequest
+  { csrFrom :: ![UserId],
+    csrTo :: !(Maybe [UserId])
+  }
+  deriving (Eq, Show, Generic)
+  deriving (ToJSON, FromJSON, S.ToSchema) via (Schema ConnectionsStatusRequest)
+
+instance ToSchema ConnectionsStatusRequest where
+  schema =
+    object "ConnectionsStatusRequest" $
+      ConnectionsStatusRequest
+        <$> csrFrom .= field "from" (array schema)
+        <*> csrTo .= optField "to" Nothing (array schema)
+
+data ConnectionsStatusRequestV2 = ConnectionsStatusRequestV2
+  { csrv2From :: ![UserId],
+    csrv2To :: !(Maybe [Qualified UserId]),
+    csrv2Relation :: !(Maybe Relation)
+  }
+  deriving (Eq, Show, Generic)
+  deriving (ToJSON, FromJSON, S.ToSchema) via (Schema ConnectionsStatusRequestV2)
+
+instance ToSchema ConnectionsStatusRequestV2 where
+  schema =
+    object "ConnectionsStatusRequestV2" $
+      ConnectionsStatusRequestV2
+        <$> csrv2From .= field "from" (array schema)
+        <*> csrv2To .= optField "to" Nothing (array schema)
+        <*> csrv2Relation .= optField "relation" Nothing schema
+
+data ConnectionStatus = ConnectionStatus
+  { csFrom :: !UserId,
+    csTo :: !UserId,
+    csStatus :: !Relation
+  }
+  deriving (Eq, Show, Generic)
+  deriving (ToJSON, FromJSON, S.ToSchema) via (Schema ConnectionStatus)
+
+instance ToSchema ConnectionStatus where
+  schema =
+    object "ConnectionStatus" $
+      ConnectionStatus
+        <$> csFrom .= field "from" schema
+        <*> csTo .= field "to" schema
+        <*> csStatus .= field "status" schema
+
+data ConnectionStatusV2 = ConnectionStatusV2
+  { csv2From :: !UserId,
+    csv2To :: !(Qualified UserId),
+    csv2Status :: !Relation
+  }
+  deriving (Eq, Show, Generic)
+  deriving (ToJSON, FromJSON, S.ToSchema) via (Schema ConnectionStatusV2)
+
+instance ToSchema ConnectionStatusV2 where
+  schema =
+    object "ConnectionStatusV2" $
+      ConnectionStatusV2
+        <$> csv2From .= field "from" schema
+        <*> csv2To .= field "qualified_to" schema
+        <*> csv2Status .= field "status" schema

libs/wire-api/test/unit/Test/Wire/API/Roundtrip/ByteString.hs

@@ -26,7 +26,6 @@ import qualified Wire.API.Arbitrary as Arbitrary ()
 import qualified Wire.API.Asset.V3 as Asset.V3
 import qualified Wire.API.Asset.V3.Resumable as Asset.V3.Resumable
 import qualified Wire.API.Call.Config as Call.Config
-import qualified Wire.API.Connection as Connection
 import qualified Wire.API.Conversation.Code as Conversation.Code
 import qualified Wire.API.Conversation.Role as Conversation.Role
 import qualified Wire.API.Properties as Properties
@@ -58,7 +57,6 @@ tests =
       testRoundTrip @Call.Config.Transport,
       testRoundTrip @Call.Config.TurnHost,
       testRoundTrip @Call.Config.TurnURI,
-      testRoundTrip @Connection.Relation,
       testRoundTrip @Conversation.Code.Key,
       testRoundTrip @Conversation.Code.Value,
       testRoundTrip @Conversation.Role.RoleName,

libs/wire-api/wire-api.cabal

@@ -4,7 +4,7 @@ cabal-version: 1.12
 --
 -- see: https://github.com/sol/hpack
 --
--- hash: d2c9713a3cbd002394d82471bd12407b388620823e1087fb4dd300cbecde7c25
+-- hash: 2d17ec32d1990b4f59c918291cd7a1286d20e5c54ad921ecd5eb9d01b4b9f1c8
 
 name:           wire-api
 version:        0.1.0
@@ -50,6 +50,7 @@ library
       Wire.API.Push.Token
       Wire.API.Push.V2.Token
       Wire.API.Routes.Internal.Brig
+      Wire.API.Routes.Internal.Brig.Connection
       Wire.API.Routes.Internal.Brig.EJPD
       Wire.API.Routes.MultiTablePaging
       Wire.API.Routes.MultiTablePaging.State