Prekeys investigation: test (#2694)

* log randomPrekey state of things

* Add an integration test to ensure list of prekeys does not become empty.

This test should also run for the dynamoDB case, to ensure our
implementation isn't buggy (it probably isn't, but to check for
regressions)

* add another test for last prekey validation

* Add one more test, fix warning from previous test

* logging on startup: log using info level, not warning

* fixup: expected status code is 201, not 200

* remove commented out code

* changelog

* linter? make format doesn't work; or local/CI don't agree

changelog.d/5-internal/pr-2694

@@ -0,0 +1 @@
+Add two integration tests arounds last prekeys

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

@@ -25,6 +25,7 @@ module Wire.API.User.Client.Prekey
     LastPrekey,
     lastPrekey,
     unpackLastPrekey,
+    fakeLastPrekey,
     lastPrekeyId,
     PrekeyBundle (..),
     ClientPrekey (..),
@@ -101,6 +102,11 @@ lastPrekeyId = PrekeyId maxBound
 lastPrekey :: Text -> LastPrekey
 lastPrekey = LastPrekey . Prekey lastPrekeyId
 
+-- for tests only
+-- This fake last prekey has the wrong prekeyId
+fakeLastPrekey :: LastPrekey
+fakeLastPrekey = LastPrekey $ Prekey (PrekeyId 7) "pQABAQcCoQBYIDXdN8VlKb5lbgPmoDPLPyqNIEyShG4oT/DlW0peRRZUA6EAoQBYILLf1TIwSB62q69Ojs/X1tzJ+dYHNAw4QbW/7TC5vSZqBPY="
+
 --------------------------------------------------------------------------------
 -- PrekeyBundle
 

services/brig/src/Brig/App.hs

@@ -232,8 +232,12 @@ newEnv o = do
     SqsQueue q -> SqsQueue <$> AWS.getQueueUrl (aws ^. AWS.amazonkaEnv) q
   mSFTEnv <- mapM Calling.mkSFTEnv $ Opt.sft o
   prekeyLocalLock <- case Opt.randomPrekeys o of
-    Just True -> Just <$> newMVar ()
-    _ -> pure Nothing
+    Just True -> do
+      Log.info lgr $ Log.msg (Log.val "randomPrekeys: active")
+      Just <$> newMVar ()
+    _ -> do
+      Log.info lgr $ Log.msg (Log.val "randomPrekeys: not active; using dynamoDB instead.")
+      pure Nothing
   kpLock <- newMVar ()
   pure $!
     Env

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

@@ -50,6 +50,7 @@ import Data.Text.Ascii (AsciiChars (validate))
 import qualified Data.Vector as Vec
 import Imports
 import qualified Network.Wai.Utilities.Error as Error
+import qualified System.Logger as Log
 import Test.QuickCheck (arbitrary, generate)
 import Test.Tasty hiding (Timeout)
 import Test.Tasty.Cannon hiding (Cannon)
@@ -103,6 +104,9 @@ tests _cl _at opts p db b c g =
       test p "get /clients - 200" $ testListClients b,
       test p "get /clients/:client/prekeys - 200" $ testListPrekeyIds b,
       test p "post /clients - 400" $ testTooManyClients opts b,
+      test p "client/prekeys not empty" $ testPrekeysNotEmptyRandomPrekeys opts b,
+      test p "lastprekeys not bogus" $ testRegularPrekeysCannotBeSentAsLastPrekeys b,
+      test p "lastprekeys not bogus during update" $ testRegularPrekeysCannotBeSentAsLastPrekeysDuringUpdate b,
       test p "delete /clients/:client - 200 (pwd)" $ testRemoveClient True b c,
       test p "delete /clients/:client - 200 (no pwd)" $ testRemoveClient False b c,
       test p "delete /clients/:client - 400 (short pwd)" $ testRemoveClientShortPwd b,
@@ -689,6 +693,61 @@ testTooManyClients opts brig = do
       const (Just "too-many-clients") === fmap Error.label . responseJsonMaybe
       const (Just "application/json") === getHeader "Content-Type"
 
+-- Ensure that the list of prekeys for a user does not become empty, and the
+-- last resort prekey keeps being returned if it's the only key left.
+-- Test with featureFlag randomPrekeys=true
+testPrekeysNotEmptyRandomPrekeys :: Opt.Opts -> Brig -> Http ()
+testPrekeysNotEmptyRandomPrekeys opts brig = do
+  -- Run the test for randomPrekeys (not dynamoDB locking)
+  let newOpts = opts {Opt.randomPrekeys = Just True}
+  ensurePrekeysNotEmpty newOpts brig
+
+ensurePrekeysNotEmpty :: Opt.Opts -> Brig -> Http ()
+ensurePrekeysNotEmpty opts brig = withSettingsOverrides opts $ do
+  lgr <- Log.new Log.defSettings
+  uid <- userId <$> randomUser brig
+  -- Create a client with 1 regular prekey and 1 last resort prekey
+  c <- responseJsonError =<< addClient brig uid (defNewClient PermanentClientType [somePrekeys !! 10] (someLastPrekeys !! 10))
+  -- Claim the first regular one
+  _rs1 <- getPreKey brig uid uid (clientId c) <!! const 200 === statusCode
+  -- Claim again; this should give the last resort one
+  rs2 <- getPreKey brig uid uid (clientId c) <!! const 200 === statusCode
+  let pId2 = prekeyId . prekeyData <$> responseJsonMaybe rs2
+  liftIO $ assertEqual "last prekey rs2" (Just lastPrekeyId) pId2
+  liftIO $ Log.warn lgr (Log.msg (Log.val "First claim of last resort successful, claim again..."))
+  -- Claim again; this should (again) give the last resort one
+  rs3 <- getPreKey brig uid uid (clientId c) <!! const 200 === statusCode
+  let pId3 = prekeyId . prekeyData <$> responseJsonMaybe rs3
+  liftIO $ assertEqual "last prekey rs3" (Just lastPrekeyId) pId3
+
+testRegularPrekeysCannotBeSentAsLastPrekeys :: Brig -> Http ()
+testRegularPrekeysCannotBeSentAsLastPrekeys brig = do
+  uid <- userId <$> randomUser brig
+  -- The parser should reject a normal prekey in the lastPrekey field
+  addClient brig uid (defNewClient PermanentClientType [head somePrekeys] fakeLastPrekey) !!! const 400 === statusCode
+
+testRegularPrekeysCannotBeSentAsLastPrekeysDuringUpdate :: Brig -> Http ()
+testRegularPrekeysCannotBeSentAsLastPrekeysDuringUpdate brig = do
+  uid <- userId <$> randomUser brig
+  c <- responseJsonError =<< addClient brig uid (defNewClient PermanentClientType [head somePrekeys] (someLastPrekeys !! 11)) <!! const 201 === statusCode
+  let newPrekey = somePrekeys !! 2
+  let update =
+        defUpdateClient
+          { updateClientPrekeys = [newPrekey],
+            updateClientLastKey = Just fakeLastPrekey,
+            updateClientLabel = Just "label"
+          }
+  -- The parser should reject a normal prekey in the lastPrekey field
+  put
+    ( brig
+        . paths ["clients", toByteString' (clientId c)]
+        . zUser uid
+        . contentJson
+        . body (RequestBodyLBS $ encode update)
+    )
+    !!! const 400
+      === statusCode
+
 -- @END
 
 -- The testRemoveClient test conforms to the following testing standards:

services/brig/test/integration/Util.hs

@@ -687,7 +687,13 @@ defNewClientWithVerificationCode mbCode ty pks lpk =
       newClientVerificationCode = mbCode
     }
 
-getPreKey :: Brig -> UserId -> UserId -> ClientId -> Http ResponseLBS
+getPreKey ::
+  (MonadIO m, MonadCatch m, MonadFail m, MonadHttp m, HasCallStack) =>
+  Brig ->
+  UserId ->
+  UserId ->
+  ClientId ->
+  m ResponseLBS
 getPreKey brig zusr u c =
   get $
     apiVersion "v1"