Add ClientCapabilities to NewClient. (#1552)

libs/api-bot/src/Network/Wire/Bot/Monad.hs

@@ -387,7 +387,8 @@ addBotClient self cty label = do
             newClientType = cty,
             newClientClass = Nothing,
             newClientCookie = Nothing,
-            newClientModel = Nothing
+            newClientModel = Nothing,
+            newClientCapabilities = Nothing
           }
   cid <- clientId <$> runBotSession self (registerClient nc)
   clt <- BotClient cid label box <$> liftIO Clients.empty

libs/wire-api/src/Wire/API/Team/LegalHold.hs

@@ -347,7 +347,9 @@ camelToUnderscore = concatMap go . (ix 0 %~ toLower)
 -- | Bots are not protected to be potentially recorded by legalhold devices.
 data LegalholdProtectee
   = ProtectedUser UserId
-  | UnprotectedBot
+  | -- | add UserId here if you want to protect bots as well (or just remove and use
+    -- 'ProtectedUser', but then you'll loose the user type information).
+    UnprotectedBot
   | -- | FUTUREWORK: protection against legalhold when looking up prekeys accross federated
     -- instances.
     LegalholdPlusFederationNotImplemented

libs/wire-api/src/Wire/API/User/Client.hs

@@ -604,7 +604,8 @@ data NewClient = NewClient
     newClientClass :: Maybe ClientClass,
     newClientCookie :: Maybe CookieLabel,
     newClientPassword :: Maybe PlainTextPassword,
-    newClientModel :: Maybe Text
+    newClientModel :: Maybe Text,
+    newClientCapabilities :: Maybe (Set ClientCapability)
   }
   deriving stock (Eq, Show, Generic)
   deriving (Arbitrary) via (GenericUniform NewClient)
@@ -644,6 +645,9 @@ modelNewClient = Doc.defineModel "NewClient" $ do
   Doc.property "model" Doc.string' $ do
     Doc.description "Optional model information of this client"
     Doc.optional
+  Doc.property "capabilities" typeClientCapability $ do
+    Doc.description "Hints for the backend so it can behave in a backwards-compatible way."
+    Doc.optional
 
 newClient :: ClientType -> LastPrekey -> NewClient
 newClient t k =
@@ -655,7 +659,8 @@ newClient t k =
       newClientClass = if t == LegalHoldClientType then Just LegalHoldClient else Nothing,
       newClientCookie = Nothing,
       newClientPassword = Nothing,
-      newClientModel = Nothing
+      newClientModel = Nothing,
+      newClientCapabilities = Nothing
     }
 
 instance ToJSON NewClient where
@@ -669,6 +674,7 @@ instance ToJSON NewClient where
         # "cookie" A..= newClientCookie c
         # "password" A..= newClientPassword c
         # "model" A..= newClientModel c
+        # "capabilities" A..= newClientCapabilities c
         # []
 
 instance FromJSON NewClient where
@@ -682,6 +688,7 @@ instance FromJSON NewClient where
       <*> o A..:? "cookie"
       <*> o A..:? "password"
       <*> o A..:? "model"
+      <*> o A..:? "capabilities"
 
 --------------------------------------------------------------------------------
 -- UpdateClient

libs/wire-api/test/golden/testObject_NewClient_user_2.json

@@ -7,5 +7,8 @@
     "password": "I􄇏󳃛oIC\u0008y󿗄1㕛&w>S~z豿\u0007{2Dj\u000b|Z\"\u000c􂼄*[ｍV􉐛kS𣚇A􎁼􁹁(2\u0010뱍\u000ei\u000f(󼅍𩌬f?q\u000e5𣱽d􄾘^nI􍚯_?󸵊H𝄻\u001af󳈙\n󵈿x\u0006dZ􁓹^N\u000ca\u0016\u001ab=􏡷SP😄aTd\u0019𭜏\u0013\u0006\u0017!󷁠𢬯o{uoN\u0018qL\u0015\u001bc=\u000b@o2󾵲\u0004𢲖\u001f􇠦5v\u0002\u001d_k,\u0013mAV>$󻎕􃆜\u001e􊄳\n⌔-ea}G`r? 󵐇\u0001\u001f𠚕9\u0008rl𥶽}u𝢇􇷚􃗸@M6M𥷣𘃸𨺤|E5Ud􀨐tLjQ󹭵ᩎ\u001e\u000b\u0011jE\u0006'~f\u000fR󶰝\u0015d}}􂱸q󻹖\u0011𤺆9𧋕\u001e𘣰\u0003𭦜\r\u001c\u001f迌㟍\u0015/\u001d掶􊓾\u0000(:􁙩n#m9x 􇍝𬲸}􀿎퓖\u001d󲊹\u0008`􉡹G#T\u0012-8\u0015䞆𠷿\tp/!\u00024C\u001a'DP'.\u0007􏁊8<9\u0016\u0015Eq𩁒Ep]\u0007jZ%󺘵၊O製>\u0018\u0006w*f<􍇟\u000ejzpjY\u001f\u001a䪎\u0011\u0011\u0006|\u000e􃸴;𡇑F!f七b%􀂊t9\u0012\u000c𝤒X! 𠡿C\u001e󻎮𧨐C!冻H(/\u001dV)e\u00162\u0000#H$BAJy\u0017𧭞X𡜶\u001c\u001a~\u000c\u001b;\n<\u001df~{\u0008_",
     "model": "om",
     "type": "permanent",
-    "prekeys": []
+    "prekeys": [],
+    "capabilities": [
+        "legalhold-implicit-consent"
+    ]
 }

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

@@ -115,13 +115,15 @@ addClient u con ip new = do
   acc <- lift (Data.lookupAccount u) >>= maybe (throwE (ClientUserNotFound u)) return
   loc <- maybe (return Nothing) locationOf ip
   maxPermClients <- fromMaybe Opt.defUserMaxPermClients <$> Opt.setUserMaxPermClients <$> view settings
-  (clt, old, count) <- Data.addClient u clientId' new maxPermClients loc !>> ClientDataError
-  when (newClientType new == LegalHoldClientType) $ do
-    -- FUTUREWORK: this only works if there aren't any capabilities set yet.  we should add
-    -- capabilities to `NewClient`; do this next line only if LH devices don't send the cap
-    -- themselves; and merge 'Data.updateClientCapabilities' and 'Data.addClient'.
-    let caps = Just (Set.singleton Client.ClientSupportsLegalholdImplicitConsent)
-    Data.updateClientCapabilities u clientId' caps
+  let caps :: Maybe (Set Client.ClientCapability)
+      caps = updlhdev $ newClientCapabilities new
+        where
+          updlhdev =
+            if newClientType new == LegalHoldClientType
+              then Just . maybe (Set.singleton lhcaps) (Set.insert lhcaps)
+              else id
+          lhcaps = Client.ClientSupportsLegalholdImplicitConsent
+  (clt, old, count) <- Data.addClient u clientId' new maxPermClients loc caps !>> ClientDataError
   let usr = accountUser acc
   lift $ do
     for_ old $ execDelete u con

services/brig/src/Brig/Data/Client.hs

@@ -93,8 +93,9 @@ addClient ::
   NewClient ->
   Int ->
   Maybe Location ->
+  Maybe (Imports.Set ClientCapability) ->
   ExceptT ClientDataError AppIO (Client, [Client], Word)
-addClient u newId c maxPermClients loc = do
+addClient u newId c maxPermClients loc cps = do
   clients <- lookupClients u
   let typed = filter ((== newClientType c) . clientType) clients
   let count = length typed
@@ -128,10 +129,9 @@ addClient u newId c maxPermClients loc = do
       let lat = Latitude . view latitude <$> loc
           lon = Longitude . view longitude <$> loc
           mdl = newClientModel c
-          prm = (u, newId, now, newClientType c, newClientLabel c, newClientClass c, newClientCookie c, lat, lon, mdl)
-          cps = ClientCapabilityList mempty
+          prm = (u, newId, now, newClientType c, newClientLabel c, newClientClass c, newClientCookie c, lat, lon, mdl, C.Set . Set.toList <$> cps)
       retry x5 $ write insertClient (params Quorum prm)
-      return $! Client newId (newClientType c) now (newClientClass c) (newClientLabel c) (newClientCookie c) loc mdl cps
+      return $! Client newId (newClientType c) now (newClientClass c) (newClientLabel c) (newClientCookie c) loc mdl (ClientCapabilityList $ fromMaybe mempty cps)
 
 lookupClient :: MonadClient m => UserId -> ClientId -> m (Maybe Client)
 lookupClient u c =
@@ -250,8 +250,8 @@ claimPrekey u c =
 -------------------------------------------------------------------------------
 -- Queries
 
-insertClient :: PrepQuery W (UserId, ClientId, UTCTimeMillis, ClientType, Maybe Text, Maybe ClientClass, Maybe CookieLabel, Maybe Latitude, Maybe Longitude, Maybe Text) ()
-insertClient = "INSERT INTO clients (user, client, tstamp, type, label, class, cookie, lat, lon, model) VALUES (?, ?, ?, ?, ?, ?, ?, ?, ?, ?)"
+insertClient :: PrepQuery W (UserId, ClientId, UTCTimeMillis, ClientType, Maybe Text, Maybe ClientClass, Maybe CookieLabel, Maybe Latitude, Maybe Longitude, Maybe Text, Maybe (C.Set ClientCapability)) ()
+insertClient = "INSERT INTO clients (user, client, tstamp, type, label, class, cookie, lat, lon, model, capabilities) VALUES (?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?)"
 
 updateClientLabelQuery :: PrepQuery W (Maybe Text, UserId, ClientId) ()
 updateClientLabelQuery = "UPDATE clients SET label = ? WHERE user = ? AND client = ?"

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

@@ -65,7 +65,7 @@ import Data.LegalHold
 import qualified Data.List as List
 import Data.List1 (maybeList1)
 import qualified Data.Map.Strict as Map
-import Data.Misc (Fingerprint (..), Rsa)
+import Data.Misc (Fingerprint (..), FutureWork (FutureWork), Rsa)
 import Data.Predicate
 import Data.Qualified
 import Data.Range
@@ -103,7 +103,7 @@ import qualified Wire.API.Provider.Service as Public
 import qualified Wire.API.Provider.Service.Tag as Public
 import Wire.API.Team.LegalHold (LegalholdProtectee (UnprotectedBot))
 import qualified Wire.API.User as Public (UserProfile, publicProfile)
-import qualified Wire.API.User.Client as Public (Client, PubClient (..), UserClientPrekeyMap, UserClients, userClients)
+import qualified Wire.API.User.Client as Public (Client, ClientCapability (ClientSupportsLegalholdImplicitConsent), PubClient (..), UserClientPrekeyMap, UserClients, userClients)
 import qualified Wire.API.User.Client.Prekey as Public (PrekeyId)
 import qualified Wire.API.User.Identity as Public (Email)
 
@@ -858,8 +858,12 @@ addBot zuid zcon cid add = do
           }
   lift $ User.insertAccount (UserAccount usr Active) (Just (cid, cnvTeam cnv)) Nothing True
   maxPermClients <- fromMaybe Opt.defUserMaxPermClients <$> Opt.setUserMaxPermClients <$> view settings
-  (clt, _, _) <-
-    User.addClient (botUserId bid) bcl newClt maxPermClients Nothing
+  (clt, _, _) <- do
+    _ <- do
+      -- if we want to protect bots against lh, 'addClient' cannot just send lh capability
+      -- implicitly in the next line.
+      pure $ FutureWork @'UnprotectedBot undefined
+    User.addClient (botUserId bid) bcl newClt maxPermClients Nothing (Just $ Set.singleton Public.ClientSupportsLegalholdImplicitConsent)
       !>> const (StdError badGateway) -- MalformedPrekeys
 
   -- Add the bot to the conversation

services/galley/src/Galley/Intra/Client.hs

@@ -120,6 +120,7 @@ addLegalHoldClientToUser uid connId prekeys lastPrekey' = do
         Nothing
         Nothing
         Nothing
+        Nothing
 
 -- | Calls 'Brig.API.removeLegalHoldClientH'.
 removeLegalHoldClientFromUser :: UserId -> Galley ()

services/galley/test/integration/API/Teams/LegalHold.hs

@@ -907,11 +907,18 @@ testOldClientsBlockDeviceHandshake = do
     legalholderLHDevice <- doEnableLH legalholder legalholder
     _legalholder2LHDevice <- doEnableLH legalholder legalholder2
 
-    legalholderClient <- randomClient legalholder (someLastPrekeys !! 1)
-    upgradeClientToLH legalholder legalholderClient
-    legalholder2Client <- randomClient legalholder2 (someLastPrekeys !! 3)
-    upgradeClientToLH legalholder2 legalholder2Client
-
+    let caps = Set.singleton Client.ClientSupportsLegalholdImplicitConsent
+    legalholderClient <- do
+      clnt <- randomClientWithCaps legalholder (someLastPrekeys !! 1) (Just caps)
+      ensureClientCaps legalholder clnt (Client.ClientCapabilityList caps)
+      pure clnt
+    legalholder2Client <- do
+      clnt <- randomClient legalholder2 (someLastPrekeys !! 3)
+      -- this another way to do it (instead of providing caps during client creation).
+      ensureClientCaps legalholder2 clnt (Client.ClientCapabilityList mempty)
+      upgradeClientToLH legalholder2 clnt
+      ensureClientCaps legalholder2 clnt (Client.ClientCapabilityList caps)
+      pure clnt
     grantConsent tid2 peer
     connectUsers peer (List1.list1 legalholder [legalholder2])
 

services/galley/test/integration/API/Util.hs

@@ -23,7 +23,7 @@ import qualified API.SQS as SQS
 import Bilge hiding (timeout)
 import Bilge.Assert
 import Brig.Types
-import Brig.Types.Intra (ConnectionStatus (ConnectionStatus), UserAccount (..), UserSet)
+import Brig.Types.Intra (ConnectionStatus (ConnectionStatus), UserAccount (..), UserSet (..))
 import Brig.Types.Team.Invitation
 import Brig.Types.User.Auth (CookieLabel (..))
 import Control.Exception (finally)
@@ -95,7 +95,8 @@ import qualified Wire.API.Event.Team as TE
 import Wire.API.Federation.GRPC.Types (OutwardResponse (..))
 import qualified Wire.API.Federation.Mock as Mock
 import qualified Wire.API.Message.Proto as Proto
-import Wire.API.User.Client (ClientCapability (..), UserClientsFull)
+import Wire.API.User.Client (ClientCapability (..), UserClientsFull (UserClientsFull))
+import qualified Wire.API.User.Client as Client
 
 -------------------------------------------------------------------------------
 -- API Operations
@@ -1284,7 +1285,10 @@ ephemeralUser = do
   return $ Brig.Types.userId user
 
 randomClient :: HasCallStack => UserId -> LastPrekey -> TestM ClientId
-randomClient uid lk = do
+randomClient uid lk = randomClientWithCaps uid lk Nothing
+
+randomClientWithCaps :: HasCallStack => UserId -> LastPrekey -> Maybe (Set Client.ClientCapability) -> TestM ClientId
+randomClientWithCaps uid lk caps = do
   b <- view tsBrig
   resp <-
     post (b . paths ["i", "clients", toByteString' uid] . json newClientBody)
@@ -1296,7 +1300,8 @@ randomClient uid lk = do
     rStatus = 201
     newClientBody =
       (newClient cType lk)
-        { newClientPassword = Just defPassword
+        { newClientPassword = Just defPassword,
+          newClientCapabilities = caps
         }
 
 ensureDeletedState :: HasCallStack => Bool -> UserId -> UserId -> TestM ()
@@ -1335,6 +1340,12 @@ getInternalClientsFull userSet = do
         . json userSet
   responseJsonError res
 
+ensureClientCaps :: HasCallStack => UserId -> ClientId -> Client.ClientCapabilityList -> TestM ()
+ensureClientCaps uid cid caps = do
+  UserClientsFull (Map.lookup uid -> (Just clnts)) <- getInternalClientsFull (UserSet $ Set.singleton uid)
+  let [clnt] = filter ((== cid) . clientId) $ Set.toList clnts
+  liftIO $ assertEqual ("ensureClientCaps: " <> show (uid, cid, caps)) (clientCapabilities clnt) caps
+
 -- TODO: Refactor, as used also in brig
 deleteClient :: UserId -> ClientId -> Maybe PlainTextPassword -> TestM ResponseLBS
 deleteClient u c pw = do