Add client_id to token in all cases

changelog.d/3-bug-fixes/token-client-bug

@@ -0,0 +1 @@
+Requesting a new token with the client_id now works correctly when the old token is part of the request

libs/zauth/src/Data/ZAuth/Creation.hs

@@ -155,10 +155,10 @@ providerToken dur pid = do
   d <- expiry dur
   newToken d P Nothing (mkProvider pid)
 
-renewToken :: ToByteString a => Integer -> Token a -> Create (Token a)
-renewToken dur tkn = do
+renewToken :: ToByteString a => Integer -> Header -> a -> Create (Token a)
+renewToken dur hdr bdy = do
   d <- expiry dur
-  newToken d (tkn ^. header . typ) (tkn ^. header . tag) (tkn ^. body)
+  newToken d (hdr ^. typ) (hdr ^. tag) bdy
 
 newToken :: ToByteString a => POSIXTime -> Type -> Maybe Tag -> a -> Create (Token a)
 newToken ti ty ta a = do

services/brig/src/Brig/User/Auth/Cookie.hs

@@ -193,7 +193,7 @@ newAccessToken ::
 newAccessToken c mt = do
   t' <- case mt of
     Nothing -> ZAuth.newAccessToken (cookieValue c)
-    Just t -> ZAuth.renewAccessToken t
+    Just t -> ZAuth.renewAccessToken (ZAuth.userTokenClient (cookieValue c)) t
   zSettings <- view (zauthEnv . ZAuth.settings)
   let ttl = view (ZAuth.settingsTTL (Proxy @a)) zSettings
   pure $

services/brig/src/Brig/ZAuth.hs

@@ -86,7 +86,7 @@ module Brig.ZAuth
   )
 where
 
-import Control.Lens (Lens', makeLenses, over, (^.))
+import Control.Lens (Lens', makeLenses, over, (.~), (^.))
 import Control.Monad.Catch
 import Data.Aeson
 import Data.Bits
@@ -238,7 +238,7 @@ instance TokenPair LegalHoldUser LegalHoldAccess where
 class (FromByteString (Token a), ToByteString a) => AccessTokenLike a where
   accessTokenOf :: Token a -> UserId
   accessTokenClient :: Token a -> Maybe ClientId
-  renewAccessToken :: MonadZAuth m => Token a -> m (Token a)
+  renewAccessToken :: MonadZAuth m => Maybe ClientId -> Token a -> m (Token a)
   settingsTTL :: Proxy a -> Lens' Settings Integer
 
 instance AccessTokenLike Access where
@@ -319,13 +319,19 @@ newAccessToken' xt = liftZAuth $ do
       let AccessTokenTimeout ttl = z ^. settings . accessTokenTimeout
        in ZC.accessToken1 ttl (xt ^. body . user) (xt ^. body . client)
 
-renewAccessToken' :: MonadZAuth m => Token Access -> m (Token Access)
-renewAccessToken' old = liftZAuth $ do
+renewAccessToken' :: MonadZAuth m => Maybe ClientId -> Token Access -> m (Token Access)
+renewAccessToken' mcid old = liftZAuth $ do
   z <- ask
   liftIO $
     ZC.runCreate (z ^. private) (z ^. settings . keyIndex) $
       let AccessTokenTimeout ttl = z ^. settings . accessTokenTimeout
-       in ZC.renewToken ttl old
+       in ZC.renewToken
+            ttl
+            (old ^. header)
+            ( clientId
+                .~ fmap Data.Id.client mcid
+                $ (old ^. body)
+            )
 
 newBotToken :: MonadZAuth m => ProviderId -> BotId -> ConvId -> m (Token Bot)
 newBotToken pid bid cid = liftZAuth $ do
@@ -385,13 +391,20 @@ newLegalHoldAccessToken xt = liftZAuth $ do
             (xt ^. body . legalHoldUser . user)
             (xt ^. body . legalHoldUser . client)
 
-renewLegalHoldAccessToken :: MonadZAuth m => Token LegalHoldAccess -> m (Token LegalHoldAccess)
-renewLegalHoldAccessToken old = liftZAuth $ do
+renewLegalHoldAccessToken ::
+  MonadZAuth m =>
+  Maybe ClientId ->
+  Token LegalHoldAccess ->
+  m (Token LegalHoldAccess)
+renewLegalHoldAccessToken _mcid old = liftZAuth $ do
   z <- ask
   liftIO $
     ZC.runCreate (z ^. private) (z ^. settings . keyIndex) $
       let LegalHoldAccessTokenTimeout ttl = z ^. settings . legalHoldAccessTokenTimeout
-       in ZC.renewToken ttl old
+       in ZC.renewToken
+            ttl
+            (old ^. header)
+            (old ^. body)
 
 validateToken ::
   (MonadZAuth m, ToByteString a) =>

services/brig/test/integration/API/User/Auth.hs

@@ -151,6 +151,7 @@ tests conf m z db b g n =
           test m "new-session-cookie" (testNewSessionCookie conf b),
           test m "suspend-inactive" (testSuspendInactiveUsers conf b),
           test m "client access" (testAccessWithClientId b),
+          test m "client access with old token" (testAccessWithClientIdAndOldToken b),
           test m "client access incorrect" (testAccessWithIncorrectClientId b),
           test m "multiple client accesses" (testAccessWithExistingClientId b)
         ],
@@ -1014,6 +1015,58 @@ testAccessWithClientId brig = do
     assertSaneAccessToken now (userId u) (decodeToken' @ZAuth.Access r)
     ZAuth.accessTokenClient @ZAuth.Access atoken @?= Just (clientId cl)
 
+-- here a fresh client gets a token without client_id first, then allocates a
+-- new client ID and finally calls access again with the new client_id
+testAccessWithClientIdAndOldToken :: Brig -> Http ()
+testAccessWithClientIdAndOldToken brig = do
+  u <- randomUser brig
+  rs <-
+    login
+      brig
+      ( emailLogin
+          (fromJust (userEmail u))
+          defPassword
+          (Just "nexus1")
+      )
+      PersistentCookie
+      <!! const 200 === statusCode
+  let c = decodeCookie rs
+  token0 <-
+    fmap (decodeToken' @ZAuth.Access) $
+      post
+        ( unversioned
+            . brig
+            . path "/access"
+            . cookie c
+        )
+        <!! const 200 === statusCode
+  cl <-
+    responseJsonError
+      =<< addClient
+        brig
+        (userId u)
+        (defNewClient PermanentClientType [] (Imports.head someLastPrekeys))
+        <!! const 201 === statusCode
+  r <-
+    post
+      ( unversioned
+          . brig
+          . path "/access"
+          . queryItem "client_id" (toByteString' (clientId cl))
+          . header "Authorization" ("Bearer " <> toByteString' token0)
+          . cookie c
+      )
+      <!! const 200 === statusCode
+  now <- liftIO getCurrentTime
+  liftIO $ do
+    let ck = decodeCookie r
+        Just token = fromByteString (cookie_value ck)
+        atoken = decodeToken' @ZAuth.Access r
+    assertSanePersistentCookie @ZAuth.User ck
+    ZAuth.userTokenClient @ZAuth.User token @?= Just (clientId cl)
+    assertSaneAccessToken now (userId u) atoken
+    ZAuth.accessTokenClient @ZAuth.Access atoken @?= Just (clientId cl)
+
 testAccessWithIncorrectClientId :: Brig -> Http ()
 testAccessWithIncorrectClientId brig = do
   u <- randomUser brig