Make federated connection functions work with qualified IDs

changelog.d/5-internal/fed-connections-data

@@ -0,0 +1 @@
+Make connection DB functions work with Qualified IDs

services/brig/brig.cabal

@@ -4,7 +4,7 @@ cabal-version: 1.12
 --
 -- see: https://github.com/sol/hpack
 --
--- hash: d5382afdfc45e225067c7848e99d40349897ddd6eeb69be59038373e57ada716
+-- hash: 74882d161b7ecee96907491a40139775942d4f15987cbe1aa30d13b30fc79e0e
 
 name:           brig
 version:        1.35.0
@@ -173,6 +173,7 @@ library
     , metrics-wai >=0.3
     , mime
     , mime-mail >=0.4
+    , mmorph
     , mtl >=2.1
     , mu-grpc-client
     , multihash >=0.1.3
@@ -207,6 +208,7 @@ library
     , string-conversions
     , swagger >=0.1
     , swagger2
+    , tagged
     , template >=0.2
     , text >=0.11
     , text-icu-translit >=0.1

services/brig/package.yaml

@@ -72,6 +72,7 @@ library:
   - mime
   - mime-mail >=0.4
   - MonadRandom >=0.5
+  - mmorph
   - mtl >=2.1
   - mu-grpc-client
   - multihash >=0.1.3
@@ -106,6 +107,7 @@ library:
   - string-conversions
   - swagger >=0.1
   - swagger2
+  - tagged
   - template >=0.2
   - text >=0.11
   - text-icu-translit >=0.1

services/brig/src/Brig/API/Public.hs

@@ -261,7 +261,7 @@ servantSitemap =
         BrigAPI.getClient = getClient,
         BrigAPI.getClientCapabilities = getClientCapabilities,
         BrigAPI.getClientPrekeys = getClientPrekeys,
-        BrigAPI.createConnectionUnqualified = createLocalConnection,
+        BrigAPI.createConnectionUnqualified = createConnectionUnqualified,
         BrigAPI.createConnection = createConnection,
         BrigAPI.listLocalConnections = listLocalConnections,
         BrigAPI.listConnections = listConnections,
@@ -1085,22 +1085,23 @@ customerExtensionCheckBlockedDomains email = do
         when (domain `elem` blockedDomains) $
           throwM $ customerExtensionBlockedDomain domain
 
-createLocalConnection :: UserId -> ConnId -> Public.ConnectionRequest -> Handler (Public.ResponseForExistedCreated Public.UserConnection)
-createLocalConnection self conn cr = do
-  API.createConnection self cr conn !>> connError
+createConnectionUnqualified :: UserId -> ConnId -> Public.ConnectionRequest -> Handler (Public.ResponseForExistedCreated Public.UserConnection)
+createConnectionUnqualified self conn cr = do
+  lself <- qualifyLocal self
+  target <- qualifyLocal (Public.crUser cr)
+  API.createConnection lself conn (unTagged target) !>> connError
 
--- | FUTUREWORK: also create remote connections: https://wearezeta.atlassian.net/browse/SQCORE-958
 createConnection :: UserId -> ConnId -> Qualified UserId -> Handler (Public.ResponseForExistedCreated Public.UserConnection)
-createConnection self conn (Qualified otherUser otherDomain) = do
-  localDomain <- viewFederationDomain
-  if localDomain == otherDomain
-    then createLocalConnection self conn (Public.ConnectionRequest otherUser (unsafeRange "_"))
-    else throwM federationNotImplemented
+createConnection self conn target = do
+  lself <- qualifyLocal self
+  API.createConnection lself conn target !>> connError
 
 updateLocalConnection :: UserId -> ConnId -> UserId -> Public.ConnectionUpdate -> Handler (Public.UpdateResult Public.UserConnection)
 updateLocalConnection self conn other update = do
   let newStatus = Public.cuStatus update
-  mc <- API.updateConnection self other newStatus (Just conn) !>> connError
+  lself <- qualifyLocal self
+  lother <- qualifyLocal other
+  mc <- API.updateConnection lself lother newStatus (Just conn) !>> connError
   return $ maybe Public.Unchanged Public.Updated mc
 
 -- | FUTUREWORK: also update remote connections: https://wearezeta.atlassian.net/browse/SQCORE-959
@@ -1119,15 +1120,15 @@ listLocalConnections uid start msize = do
 -- | FUTUREWORK: also list remote connections: https://wearezeta.atlassian.net/browse/SQCORE-963
 listConnections :: UserId -> Public.ListConnectionsRequestPaginated -> Handler Public.ConnectionsPage
 listConnections uid req = do
-  localDomain <- viewFederationDomain
+  self <- qualifyLocal uid
   let size = Public.gmtprSize req
-  res :: C.PageWithState Data.LocalConnection <- Data.lookupLocalConnectionsPage uid convertedState (rcast size)
-  return (pageToConnectionsPage localDomain Public.PagingLocals res)
+  res :: C.PageWithState Public.UserConnection <- Data.lookupLocalConnectionsPage self convertedState (rcast size)
+  return (pageToConnectionsPage Public.PagingLocals res)
   where
-    pageToConnectionsPage :: Domain -> Public.LocalOrRemoteTable -> Data.PageWithState Data.LocalConnection -> Public.ConnectionsPage
-    pageToConnectionsPage localDomain table page@Data.PageWithState {..} =
+    pageToConnectionsPage :: Public.LocalOrRemoteTable -> Data.PageWithState Public.UserConnection -> Public.ConnectionsPage
+    pageToConnectionsPage table page@Data.PageWithState {..} =
       Public.MultiTablePage
-        { mtpResults = Data.localToUserConn localDomain <$> pwsResults,
+        { mtpResults = pwsResults,
           mtpHasMore = C.pwsHasMore page,
           -- FUTUREWORK confusingly, using 'ConversationPagingState' instead of 'ConnectionPagingState' doesn't fail any tests.
           -- Is this type actually useless? Or the tests not good enough?
@@ -1140,7 +1141,10 @@ listConnections uid req = do
     convertedState = fmap mkState . Public.mtpsState =<< Public.gmtprState req
 
 getLocalConnection :: UserId -> UserId -> Handler (Maybe Public.UserConnection)
-getLocalConnection self other = lift $ API.lookupLocalConnection self other
+getLocalConnection self other = do
+  lself <- qualifyLocal self
+  lother <- qualifyLocal other
+  lift $ Data.lookupConnection lself (unTagged lother)
 
 getConnection :: UserId -> Qualified UserId -> Handler (Maybe Public.UserConnection)
 getConnection self (Qualified otherUser otherDomain) = do

services/brig/src/Brig/API/Types.hs

@@ -41,6 +41,7 @@ import Brig.Types.Code (Timeout)
 import Brig.Types.Intra
 import Brig.User.Auth.Cookie (RetryAfter (..))
 import Data.Id
+import Data.Qualified
 import Imports
 import qualified Network.Wai.Utilities.Error as Wai
 import Wire.API.Federation.Client (FederationError)
@@ -116,9 +117,9 @@ data ConnectionError
   | -- | An invalid connection status change.
     InvalidTransition UserId Relation
   | -- | The target user in an connection attempt is invalid, e.g. not activated.
-    InvalidUser UserId
+    InvalidUser (Qualified UserId)
   | -- | An attempt at updating a non-existent connection.
-    NotConnected UserId UserId
+    NotConnected UserId (Qualified UserId)
   | -- | An attempt at creating a connection from an account with
     -- no verified user identity.
     ConnectNoIdentity

services/brig/src/Brig/App.hs

@@ -64,6 +64,7 @@ module Brig.App
     forkAppIO,
     locationOf,
     viewFederationDomain,
+    qualifyLocal,
   )
 where
 
@@ -106,6 +107,7 @@ import Data.List1 (List1, list1)
 import Data.Metrics (Metrics)
 import qualified Data.Metrics.Middleware as Metrics
 import Data.Misc
+import Data.Qualified (Local, Qualified (..), toLocal)
 import Data.Text (unpack)
 import qualified Data.Text as Text
 import Data.Text.Encoding (encodeUtf8)
@@ -540,3 +542,6 @@ readTurnList = Text.readFile >=> return . fn . mapMaybe fromByteString . fmap Te
 
 viewFederationDomain :: MonadReader Env m => m (Domain)
 viewFederationDomain = view (settings . Opt.federationDomain)
+
+qualifyLocal :: MonadReader Env m => a -> m (Local a)
+qualifyLocal a = fmap (toLocal . Qualified a) viewFederationDomain