Fix: Connection type when unblocking after LH

CHANGELOG.md

@@ -18,7 +18,7 @@
 
 ## Release Notes
 
-Deploy brig before galley (#1526)
+Deploy brig before galley (#1526, #1549)
 
 ## Features
 

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

@@ -55,7 +55,7 @@ data UserIds = UserIds
 -- | Data that is passed to the @\/i\/users\/connections-status@ endpoint.
 data ConnectionsStatusRequest = ConnectionsStatusRequest
   { csrFrom :: ![UserId],
-    csrTo :: ![UserId]
+    csrTo :: !(Maybe [UserId])
   }
   deriving (Eq, Show, Generic)
 

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

@@ -28,6 +28,8 @@ module Wire.API.Connection
     UserConnectionList (..),
     Message (..),
     Relation (..),
+    RelationWithHistory (..),
+    relationDropHistory,
 
     -- * Requests
     ConnectionRequest (..),
@@ -165,6 +167,41 @@ data Relation
   deriving (Arbitrary) via (GenericUniform Relation)
   deriving (ToSchema) via (CustomSwagger '[ConstructorTagModifier CamelToKebab] Relation)
 
+-- | '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
+-- 'relationDropHistory'.
+data RelationWithHistory
+  = AcceptedWithHistory
+  | BlockedWithHistory
+  | PendingWithHistory
+  | IgnoredWithHistory
+  | SentWithHistory
+  | CancelledWithHistory
+  | MissingLegalholdConsentFromAccepted
+  | MissingLegalholdConsentFromBlocked
+  | MissingLegalholdConsentFromPending
+  | MissingLegalholdConsentFromIgnored
+  | MissingLegalholdConsentFromSent
+  | MissingLegalholdConsentFromCancelled
+  deriving stock (Eq, Ord, Show, Generic)
+  deriving (Arbitrary) via (GenericUniform RelationWithHistory)
+
+relationDropHistory :: RelationWithHistory -> Relation
+relationDropHistory = \case
+  AcceptedWithHistory -> Accepted
+  BlockedWithHistory -> Blocked
+  PendingWithHistory -> Pending
+  IgnoredWithHistory -> Ignored
+  SentWithHistory -> Sent
+  CancelledWithHistory -> Cancelled
+  MissingLegalholdConsentFromAccepted -> MissingLegalholdConsent
+  MissingLegalholdConsentFromBlocked -> MissingLegalholdConsent
+  MissingLegalholdConsentFromPending -> MissingLegalholdConsent
+  MissingLegalholdConsentFromIgnored -> MissingLegalholdConsent
+  MissingLegalholdConsentFromSent -> MissingLegalholdConsent
+  MissingLegalholdConsentFromCancelled -> MissingLegalholdConsent
+
 typeRelation :: Doc.DataType
 typeRelation =
   Doc.string $

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

@@ -30,6 +30,7 @@ module Brig.API.Connection
     lookupConnections,
     Data.lookupConnection,
     Data.lookupConnectionStatus,
+    Data.lookupConnectionStatus',
     Data.lookupContactList,
   )
 where
@@ -59,6 +60,7 @@ import qualified Galley.Types.Teams as Team
 import Imports
 import qualified System.Logger.Class as Log
 import System.Logger.Message
+import Wire.API.Connection (RelationWithHistory (..))
 import qualified Wire.API.Conversation as Conv
 
 createConnection ::
@@ -106,8 +108,8 @@ createConnectionToLocalUser self crUser ConnectionRequest {crName, crMessage} co
         logConnection self crUser
           . msg (val "Creating connection")
       cnv <- Intra.createConnectConv self crUser (Just crName) (Just crMessage) (Just conn)
-      s2o' <- Data.insertConnection self crUser Sent (Just crMessage) cnv
-      o2s' <- Data.insertConnection crUser self Pending (Just crMessage) cnv
+      s2o' <- Data.insertConnection self crUser SentWithHistory (Just crMessage) cnv
+      o2s' <- Data.insertConnection crUser self PendingWithHistory (Just crMessage) cnv
       e2o <- ConnectionUpdated o2s' (ucStatus <$> o2s) <$> Data.lookupName self
       let e2s = ConnectionUpdated s2o' (ucStatus <$> s2o) Nothing
       mapM_ (Intra.onConnectionEvent self (Just conn)) [e2o, e2s]
@@ -121,7 +123,7 @@ createConnectionToLocalUser self crUser ConnectionRequest {crName, crMessage} co
       (Accepted, Blocked) -> return $ ConnectionExists s2o
       (Sent, Blocked) -> return $ ConnectionExists s2o
       (Blocked, _) -> throwE $ InvalidTransition self Sent
-      (_, Blocked) -> change s2o Sent
+      (_, Blocked) -> change s2o SentWithHistory
       (_, Sent) -> accept s2o o2s
       (_, Accepted) -> accept s2o o2s
       (_, Ignored) -> resend s2o o2s
@@ -136,12 +138,12 @@ createConnectionToLocalUser self crUser ConnectionRequest {crName, crMessage} co
         logConnection self (ucTo s2o)
           . msg (val "Accepting connection")
       cnv <- lift $ for (ucConvId s2o) $ Intra.acceptConnectConv self (Just conn)
-      s2o' <- lift $ Data.updateConnection s2o Accepted
+      s2o' <- lift $ Data.updateConnection s2o AcceptedWithHistory
       o2s' <-
         lift $
           if (cnvType <$> cnv) == Just ConnectConv
-            then Data.updateConnection o2s Blocked
-            else Data.updateConnection o2s Accepted
+            then Data.updateConnection o2s BlockedWithHistory
+            else Data.updateConnection o2s AcceptedWithHistory
       e2o <- lift $ ConnectionUpdated o2s' (Just $ ucStatus o2s) <$> Data.lookupName self
       let e2s = ConnectionUpdated s2o' (Just $ ucStatus s2o) Nothing
       lift $ mapM_ (Intra.onConnectionEvent self (Just conn)) [e2o, e2s]
@@ -157,7 +159,7 @@ createConnectionToLocalUser self crUser ConnectionRequest {crName, crMessage} co
       s2o' <- insert (Just s2o) (Just o2s)
       return $ ConnectionExists s2o'
 
-    change :: UserConnection -> Relation -> ExceptT ConnectionError AppIO ConnectionResult
+    change :: UserConnection -> RelationWithHistory -> ExceptT ConnectionError AppIO ConnectionResult
     change c s = ConnectionExists <$> lift (Data.updateConnection c s)
 
     belongSameTeam :: AppIO Bool
@@ -270,22 +272,23 @@ updateConnection self other newStatus conn = do
       when (ucStatus o2s `elem` [Sent, Pending]) . lift $ do
         o2s' <-
           if (cnvType <$> cnv) /= Just ConnectConv
-            then Data.updateConnection o2s Accepted
-            else Data.updateConnection o2s Blocked
+            then Data.updateConnection o2s AcceptedWithHistory
+            else Data.updateConnection o2s BlockedWithHistory
         e2o <- ConnectionUpdated o2s' (Just $ ucStatus o2s) <$> Data.lookupName self
         Intra.onConnectionEvent self conn e2o
-      lift $ Just <$> Data.updateConnection s2o Accepted
+      lift $ Just <$> Data.updateConnection s2o AcceptedWithHistory
 
     block :: UserConnection -> ExceptT ConnectionError AppIO (Maybe UserConnection)
     block s2o = lift $ do
       Log.info $
         logConnection self (ucTo s2o)
           . msg (val "Blocking connection")
       for_ (ucConvId s2o) $ Intra.blockConv (ucFrom s2o) conn
-      Just <$> Data.updateConnection s2o Blocked
+      Just <$> Data.updateConnection s2o BlockedWithHistory
 
     unblock :: UserConnection -> UserConnection -> Relation -> ExceptT ConnectionError AppIO (Maybe UserConnection)
     unblock s2o o2s new = do
+      -- FUTUREWORK: new is always in [Sent, Accepted]. Refactor to total function.
       when (new `elem` [Sent, Accepted]) $
         checkLimit self
       Log.info $
@@ -295,30 +298,50 @@ updateConnection self other newStatus conn = do
       when (ucStatus o2s == Sent && new == Accepted) . lift $ do
         o2s' :: UserConnection <-
           if (cnvType <$> cnv) /= Just ConnectConv
-            then Data.updateConnection o2s Accepted
-            else Data.updateConnection o2s Blocked
+            then Data.updateConnection o2s AcceptedWithHistory
+            else Data.updateConnection o2s BlockedWithHistory
         e2o :: ConnectionEvent <- ConnectionUpdated o2s' (Just $ ucStatus o2s) <$> Data.lookupName self
         -- TODO: is this correct? shouldnt o2s be sent to other?
         Intra.onConnectionEvent self conn e2o
-      lift $ Just <$> Data.updateConnection s2o new
+      lift $ Just <$> Data.updateConnection s2o (mkRelationWithHistory (error "impossible") new)
 
     cancel :: UserConnection -> UserConnection -> ExceptT ConnectionError AppIO (Maybe UserConnection)
     cancel s2o o2s = do
       Log.info $
         logConnection self (ucTo s2o)
           . msg (val "Cancelling connection")
       lift . for_ (ucConvId s2o) $ Intra.blockConv (ucFrom s2o) conn
-      o2s' <- lift $ Data.updateConnection o2s Cancelled
+      o2s' <- lift $ Data.updateConnection o2s CancelledWithHistory
       let e2o = ConnectionUpdated o2s' (Just $ ucStatus o2s) Nothing
       lift $ Intra.onConnectionEvent self conn e2o
       change s2o Cancelled
 
     change :: UserConnection -> Relation -> ExceptT ConnectionError AppIO (Maybe UserConnection)
-    change c s = lift $ Just <$> Data.updateConnection c s
+    change c s = do
+      -- FUTUREWORK: refactor to total function. Gets only called with either Ignored, Accepted, Cancelled
+      lift $ Just <$> Data.updateConnection c (mkRelationWithHistory (error "impossible") s)
 
 connection :: UserId -> UserId -> ExceptT ConnectionError AppIO UserConnection
 connection a b = lift (Data.lookupConnection a b) >>= tryJust (NotConnected a b)
 
+mkRelationWithHistory :: HasCallStack => Relation -> Relation -> RelationWithHistory
+mkRelationWithHistory oldRel = \case
+  Accepted -> AcceptedWithHistory
+  Blocked -> BlockedWithHistory
+  Pending -> PendingWithHistory
+  Ignored -> IgnoredWithHistory
+  Sent -> SentWithHistory
+  Cancelled -> CancelledWithHistory
+  MissingLegalholdConsent ->
+    case oldRel of
+      Accepted -> MissingLegalholdConsentFromAccepted
+      Blocked -> MissingLegalholdConsentFromBlocked
+      Pending -> MissingLegalholdConsentFromPending
+      Ignored -> MissingLegalholdConsentFromIgnored
+      Sent -> MissingLegalholdConsentFromSent
+      Cancelled -> MissingLegalholdConsentFromCancelled
+      MissingLegalholdConsent -> error "impossible old relation"
+
 updateConnectionInternal ::
   UpdateConnectionsInternal ->
   ExceptT ConnectionError AppIO ()
@@ -337,9 +360,8 @@ updateConnectionInternal = \case
         s2o <- connection self other
         o2s <- connection other self
         for_ [s2o, o2s] $ \(uconn :: UserConnection) -> lift $ do
-          -- TODO: check if Ignored is a possibility
           Intra.blockConv (ucFrom uconn) Nothing `mapM_` ucConvId uconn
-          uconn' <- Data.updateConnection uconn MissingLegalholdConsent
+          uconn' <- Data.updateConnection uconn (mkRelationWithHistory (ucStatus uconn) MissingLegalholdConsent)
           let ev = ConnectionUpdated uconn' (Just $ ucStatus uconn) Nothing
           Intra.onConnectionEvent self Nothing ev
 
@@ -371,19 +393,32 @@ updateConnectionInternal = \case
 
         unblockDirected :: UserConnection -> UserConnection -> ExceptT ConnectionError AppIO ()
         unblockDirected uconn uconnRev = do
-          cnv :: Maybe Conv.Conversation <- lift . for (ucConvId uconn) $ Intra.unblockConv (ucFrom uconn) Nothing
-          uconnRev' :: UserConnection <- do
-            newRelation <- case cnvType <$> cnv of
-              Just RegularConv -> throwE (InvalidTransition (ucFrom uconn) Accepted) -- (impossible, connection conv is always 1:1)
-              Just SelfConv -> throwE (InvalidTransition (ucFrom uconn) Accepted)
-              Just One2OneConv -> pure Accepted
-              Just ConnectConv -> pure Sent
-              Nothing -> throwE (InvalidTransition (ucFrom uconn) Accepted)
-            lift $ Data.updateConnection uconnRev newRelation
-
+          void . lift . for (ucConvId uconn) $ Intra.unblockConv (ucFrom uconn) Nothing
+          uconnRevRel :: RelationWithHistory <- relationWithHistory (ucFrom uconnRev) (ucTo uconnRev)
+          uconnRev' <- lift $ Data.updateConnection uconnRev (undoRelationHistory uconnRevRel)
           connEvent :: ConnectionEvent <- lift $ ConnectionUpdated uconnRev' (Just $ ucStatus uconnRev) <$> Data.lookupName (ucFrom uconn)
           lift $ Intra.onConnectionEvent (ucFrom uconn) Nothing connEvent
 
+    relationWithHistory :: UserId -> UserId -> ExceptT ConnectionError AppIO RelationWithHistory
+    relationWithHistory a b = lift (Data.lookupRelationWithHistory a b) >>= tryJust (NotConnected a b)
+
+    undoRelationHistory :: RelationWithHistory -> RelationWithHistory
+    undoRelationHistory = \case
+      -- these cases are relevant.
+      MissingLegalholdConsentFromAccepted -> AcceptedWithHistory
+      MissingLegalholdConsentFromBlocked -> BlockedWithHistory
+      MissingLegalholdConsentFromPending -> PendingWithHistory
+      MissingLegalholdConsentFromIgnored -> IgnoredWithHistory
+      MissingLegalholdConsentFromSent -> SentWithHistory
+      MissingLegalholdConsentFromCancelled -> CancelledWithHistory
+      -- these cases should not be reachable, but if they are, this is probably what is expected from this function.
+      AcceptedWithHistory -> AcceptedWithHistory
+      BlockedWithHistory -> BlockedWithHistory
+      PendingWithHistory -> PendingWithHistory
+      IgnoredWithHistory -> IgnoredWithHistory
+      SentWithHistory -> SentWithHistory
+      CancelledWithHistory -> CancelledWithHistory
+
 autoConnect ::
   UserId ->
   Set UserId ->

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

@@ -499,7 +499,7 @@ getConnectionsStatusH (_ ::: req ::: flt) = do
 
 getConnectionsStatus :: ConnectionsStatusRequest -> Maybe Relation -> AppIO [ConnectionStatus]
 getConnectionsStatus ConnectionsStatusRequest {csrFrom, csrTo} flt = do
-  r <- API.lookupConnectionStatus csrFrom csrTo
+  r <- maybe (API.lookupConnectionStatus' csrFrom) (API.lookupConnectionStatus csrFrom) csrTo
   return $ maybe r (filterByRelation r) flt
   where
     filterByRelation l rel = filter ((== rel) . csStatus) l