WIP: [WPB-5687] port flaking LH tests to new integration (#3876)

* [fix] use -e flag to abort when `docker-compose` fails * [feat] make `HasTests` easier to use - delegate only the testcase generation to the user - use an OVERLAPPABLE default instance if the type is a Generic Enum - cover more cases - don't use newtype Wrappers wherever possible * [feat] port over flaking Legalhold tests and delete them from galley integration * [feat] minor testlib improvements and additions --------- Co-authored-by: Matthias Fischmann <[email protected]>
wireapp · Jul 24, 2024 · 3cbdc90 · 3cbdc90
1 parent 193fe56
commit 3cbdc90
Show file tree

Hide file tree

Showing 28 changed files with 958 additions and 639 deletions.
diff --git a/.hlint.yaml b/.hlint.yaml
@@ -11,6 +11,7 @@
 - ignore: { name: Avoid lambda using `infix` }
 - ignore: { name: Eta reduce }
 - ignore: { name: Use section }
+- ignore: { name: "Use :" }
 - ignore: { name: Use underscore }
 
 # custom rules:

diff --git a/changelog.d/5-internal/WPB-5687 b/changelog.d/5-internal/WPB-5687
@@ -0,0 +1 @@
+port flaking LH tests to new integration and improve the ergonomics of our testing library
diff --git a/deploy/dockerephemeral/run.sh b/deploy/dockerephemeral/run.sh
@@ -1,6 +1,6 @@
 #!/usr/bin/env bash
 
-set -x
+set -xe
 
 # run.sh should work no matter what is the current directory
 SCRIPT_DIR="$( cd "$( dirname "${BASH_SOURCE[0]}" )" && pwd )"

diff --git a/integration/test/API/Brig.hs b/integration/test/API/Brig.hs
@@ -131,6 +131,7 @@ getUserByHandle user domain handle = do
       joinHttpPath ["users", "by-handle", domainStr, handle]
   submit "GET" req
 
+-- | https://staging-nginz-https.zinfra.io/v5/api/swagger-ui/#/default/get_clients__client_
 getClient ::
   (HasCallStack, MakesValue user, MakesValue client) =>
   user ->
@@ -143,13 +144,14 @@ getClient u cli = do
       joinHttpPath ["clients", c]
   submit "GET" req
 
+-- | https://staging-nginz-https.zinfra.io/v5/api/swagger-ui/#/default/delete_self
 deleteUser :: (HasCallStack, MakesValue user) => user -> App Response
 deleteUser user = do
   req <- baseRequest user Brig Versioned "/self"
   submit "DELETE" $
     req & addJSONObject ["password" .= defPassword]
 
--- | https://staging-nginz-https.zinfra.io/api-internal/swagger-ui/brig/#/brig/post_i_clients__uid_
+-- | https://staging-nginz-https.zinfra.io/v5/api/swagger-ui/#/default/post_clients
 addClient ::
   (HasCallStack, MakesValue user) =>
   user ->
@@ -320,9 +322,7 @@ uploadKeyPackages cid kps = do
       "/mls/key-packages/self/" <> cid.client
   submit
     "POST"
-    ( req
-        & addJSONObject ["key_packages" .= map (T.decodeUtf8 . Base64.encode) kps]
-    )
+    (req & addJSONObject ["key_packages" .= map (T.decodeUtf8 . Base64.encode) kps])
 
 claimKeyPackagesWithParams :: (MakesValue u, MakesValue v) => Ciphersuite -> u -> v -> [(String, String)] -> App Response
 claimKeyPackagesWithParams suite u v params = do
@@ -334,7 +334,7 @@ claimKeyPackagesWithParams suite u v params = do
     req
       & addQueryParams ([("ciphersuite", suite.code)] <> params)
 
-claimKeyPackages :: (MakesValue u, MakesValue v) => Ciphersuite -> u -> v -> App Response
+claimKeyPackages :: (HasCallStack, MakesValue u, MakesValue v) => Ciphersuite -> u -> v -> App Response
 claimKeyPackages suite u v = claimKeyPackagesWithParams suite u v []
 
 countKeyPackages :: Ciphersuite -> ClientIdentity -> App Response
@@ -630,3 +630,9 @@ getMultiUserPrekeyBundle :: (HasCallStack, MakesValue caller, ToJSON userClients
 getMultiUserPrekeyBundle caller userClients = do
   req <- baseRequest caller Brig Versioned $ joinHttpPath ["users", "list-prekeys"]
   submit "POST" (addJSON userClients req)
+
+-- | https://staging-nginz-https.zinfra.io/v5/api/swagger-ui/#/default/post_access
+renewToken :: (HasCallStack, MakesValue uid) => uid -> String -> App Response
+renewToken caller cookie = do
+  req <- baseRequest caller Brig Versioned "access"
+  submit "POST" (addHeader "Cookie" ("zuid=" <> cookie) req)
diff --git a/integration/test/API/BrigInternal.hs b/integration/test/API/BrigInternal.hs
@@ -236,3 +236,10 @@ addClient user args = do
   req <- baseRequest user Brig Unversioned $ "/i/clients/" <> uid
   val <- mkAddClientValue args
   submit "POST" $ req & addJSONObject val
+
+-- | https://staging-nginz-https.zinfra.io/api-internal/swagger-ui/brig/#/brig/post_i_clients_full
+getClientsFull :: (HasCallStack, MakesValue users, MakesValue uid) => uid -> users -> App Response
+getClientsFull user users = do
+  val <- make users
+  baseRequest user Brig Unversioned do joinHttpPath ["i", "clients", "full"]
+    >>= submit "POST" . addJSONObject ["users" .= val]
diff --git a/integration/test/API/Galley.hs b/integration/test/API/Galley.hs
@@ -243,7 +243,7 @@ postProteusMessage user conv msgs = do
   convDomain <- objDomain conv
   convId <- objId conv
   let bytes = Proto.encodeMessage msgs
-  req <- baseRequest user Galley Versioned ("/conversations/" <> convDomain <> "/" <> convId <> "/proteus/messages")
+  req <- baseRequest user Galley Versioned (joinHttpPath ["conversations", convDomain, convId, "proteus", "messages"])
   submit "POST" (addProtobuf bytes req)
 
 mkProteusRecipient :: (HasCallStack, MakesValue user, MakesValue client) => user -> client -> String -> App Proto.QualifiedUserEntry
@@ -527,16 +527,32 @@ enableLegalHold tid ownerid = do
   req <- baseRequest ownerid Galley Versioned (joinHttpPath ["teams", tidStr, "features", "legalhold"])
   submit "PUT" (addJSONObject ["status" .= "enabled", "ttl" .= "unlimited"] req)
 
--- | https://staging-nginz-https.zinfra.io/v5/api/swagger-ui/#/default/post_teams__tid__legalhold_settings
-postLegalHoldSettings :: (HasCallStack, MakesValue owner, MakesValue tid, MakesValue newService) => owner -> tid -> newService -> App Response
-postLegalHoldSettings owner tid newSettings = retrying policy only412 $ \_ -> do
+-- | https://staging-nginz-https.zinfra.io/v5/api/swagger-ui/#/default/delete_teams__tid__legalhold__uid_
+disableLegalHold ::
+  (HasCallStack, MakesValue tid, MakesValue ownerid, MakesValue uid) =>
+  tid ->
+  ownerid ->
+  uid ->
+  -- | the password for user with $uid$
+  String ->
+  App Response
+disableLegalHold tid ownerid uid pw = do
   tidStr <- asString tid
-  req <- baseRequest owner Galley Versioned (joinHttpPath ["teams", tidStr, "legalhold", "settings"])
-  newSettingsObj <- make newSettings
-  submit "POST" (addJSON newSettingsObj req)
+  uidStr <- objId uid
+  req <- baseRequest ownerid Galley Versioned (joinHttpPath ["teams", tidStr, "legalhold", uidStr])
+  submit "DELETE" (addJSONObject ["password" .= pw] req)
+
+-- | https://staging-nginz-https.zinfra.io/v5/api/swagger-ui/#/default/post_teams__tid__legalhold_settings
+postLegalHoldSettings :: (HasCallStack, MakesValue ownerid, MakesValue tid, MakesValue newService) => tid -> ownerid -> newService -> App Response
+postLegalHoldSettings tid owner newSettings =
+  asks ((* 1_000_000) . timeOutSeconds) >>= \tSecs -> retrying (policy tSecs) only412 $ \_ -> do
+    tidStr <- asString tid
+    req <- baseRequest owner Galley Versioned (joinHttpPath ["teams", tidStr, "legalhold", "settings"])
+    newSettingsObj <- make newSettings
+    submit "POST" (addJSON newSettingsObj req)
   where
-    policy :: RetryPolicy
-    policy = limitRetriesByCumulativeDelay 5_000_000 $ exponentialBackoff 50
+    policy :: Int -> RetryPolicy
+    policy tSecs = limitRetriesByCumulativeDelay tSecs $ exponentialBackoff 50
 
     only412 :: RetryStatus -> Response -> App Bool
     only412 _ resp = pure $ resp.status == 412
@@ -550,10 +566,18 @@ requestLegalHoldDevice tid ownerid uid = do
   submit "POST" req
 
 -- | https://staging-nginz-https.zinfra.io/v5/api/swagger-ui/#/default/put_teams__tid__legalhold__uid__approve
+--
+--   like approveLegalHoldDevice' but approves for the requesting party
 approveLegalHoldDevice :: (HasCallStack, MakesValue tid, MakesValue uid) => tid -> uid -> String -> App Response
-approveLegalHoldDevice tid uid pwd = do
+approveLegalHoldDevice tid uid = approveLegalHoldDevice' tid uid uid
+
+-- | https://staging-nginz-https.zinfra.io/v5/api/swagger-ui/#/default/put_teams__tid__legalhold__uid__approve
+--
+--   useful for testing unauthorized requests
+approveLegalHoldDevice' :: (HasCallStack, MakesValue tid, MakesValue uid, MakesValue forUid) => tid -> uid -> forUid -> String -> App Response
+approveLegalHoldDevice' tid uid forUid pwd = do
   tidStr <- asString tid
-  uidStr <- asString $ uid %. "id"
+  uidStr <- asString $ forUid %. "id"
   req <- baseRequest uid Galley Versioned (joinHttpPath ["teams", tidStr, "legalhold", uidStr, "approve"])
   submit "PUT" (addJSONObject ["password" .= pwd] req)
 
@@ -590,3 +614,18 @@ getTeamFeature user tid featureName = do
   tidStr <- asString tid
   req <- baseRequest user Galley Versioned (joinHttpPath ["teams", tidStr, "features", featureName])
   submit "GET" req
+
+-- | https://staging-nginz-https.zinfra.io/v5/api/swagger-ui/#/default/put_teams__tid__features_legalhold
+putLegalholdStatus ::
+  (HasCallStack, MakesValue tid, MakesValue usr) =>
+  tid ->
+  usr ->
+  -- | the status to put to
+  String ->
+  App Response
+putLegalholdStatus tid usr status = do
+  tidStr <- asString tid
+
+  baseRequest usr Galley Versioned (joinHttpPath ["teams", tidStr, "features", "legalhold"])
+    >>= submit "PUT"
+      . addJSONObject ["status" .= status, "ttl" .= "unlimited"]
diff --git a/integration/test/API/GalleyInternal.hs b/integration/test/API/GalleyInternal.hs
@@ -58,14 +58,16 @@ getFederationStatus user domains =
           "GET"
           $ req & addJSONObject ["domains" .= domainList]
 
-legalholdWhitelistTeam :: (HasCallStack, MakesValue uid, MakesValue tid) => uid -> tid -> App Response
-legalholdWhitelistTeam uid tid = do
+-- | https://staging-nginz-https.zinfra.io/api-internal/swagger-ui/galley/#/galley/put_i_legalhold_whitelisted_teams__tid_
+legalholdWhitelistTeam :: (HasCallStack, MakesValue uid, MakesValue tid) => tid -> uid -> App Response
+legalholdWhitelistTeam tid uid = do
   tidStr <- asString tid
   req <- baseRequest uid Galley Unversioned $ joinHttpPath ["i", "legalhold", "whitelisted-teams", tidStr]
   submit "PUT" req
 
-legalholdIsTeamInWhitelist :: (HasCallStack, MakesValue uid, MakesValue tid) => uid -> tid -> App Response
-legalholdIsTeamInWhitelist uid tid = do
+-- | https://staging-nginz-https.zinfra.io/api-internal/swagger-ui/galley/#/galley/get_i_legalhold_whitelisted_teams__tid_
+legalholdIsTeamInWhitelist :: (HasCallStack, MakesValue uid, MakesValue tid) => tid -> uid -> App Response
+legalholdIsTeamInWhitelist tid uid = do
   tidStr <- asString tid
   req <- baseRequest uid Galley Unversioned $ joinHttpPath ["i", "legalhold", "whitelisted-teams", tidStr]
   submit "GET" req
@@ -77,3 +79,10 @@ setTeamFeatureConfig versioned domain team featureName payload = do
   p <- make payload
   req <- baseRequest domain Galley versioned $ joinHttpPath ["teams", tid, "features", fn]
   submit "PUT" $ req & addJSON p
+
+-- | https://staging-nginz-https.zinfra.io/api-internal/swagger-ui/galley/#/galley/get_i_teams__tid__features_legalhold
+legalholdIsEnabled :: (HasCallStack, MakesValue tid, MakesValue uid) => tid -> uid -> App Response
+legalholdIsEnabled tid uid = do
+  tidStr <- asString tid
+  baseRequest uid Galley Unversioned do joinHttpPath ["i", "teams", tidStr, "features", "legalhold"]
+    >>= submit "GET"
diff --git a/integration/test/MLS/Util.hs b/integration/test/MLS/Util.hs
@@ -3,7 +3,6 @@
 module MLS.Util where
 
 import API.Brig
-import qualified API.BrigCommon as BrigC
 import API.Galley
 import Control.Concurrent.Async hiding (link)
 import Control.Monad
@@ -37,7 +36,6 @@ import System.IO hiding (print, putStrLn)
 import System.IO.Temp
 import System.Posix.Files
 import System.Process
-import Testlib.App
 import Testlib.Assertions
 import Testlib.HTTP
 import Testlib.JSON
@@ -141,15 +139,21 @@ argSubst from to_ s =
 
 createWireClient :: (MakesValue u, HasCallStack) => u -> App ClientIdentity
 createWireClient u = do
-  lpk <- getLastPrekey
-  c <- addClient u def {BrigC.lastPrekey = Just lpk} >>= getJSON 201
-  mkClientIdentity u c
-
--- data CredentialType = BasicCredentialType | X509CredentialType
---
--- instance MakesValue CredentialType where
---   make BasicCredentialType = make "basic"
---   make X509CredentialType = make "x509"
+  addClient u def
+    >>= getJSON 201
+    >>= mkClientIdentity u
+
+data CredentialType = BasicCredentialType | X509CredentialType
+
+instance MakesValue CredentialType where
+  make BasicCredentialType = make "basic"
+  make X509CredentialType = make "x509"
+
+instance TestCases CredentialType where
+  testCases =
+    [ MkTestCase "[ctype=basic]" BasicCredentialType,
+      MkTestCase "[ctype=x509]" X509CredentialType
+    ]
 
 data InitMLSClient = InitMLSClient
   {credType :: CredentialType}

diff --git a/integration/test/Notifications.hs b/integration/test/Notifications.hs
@@ -2,11 +2,48 @@
 module Notifications where
 
 import API.Gundeck
+import Control.Error (lastMay)
 import Control.Monad.Extra
 import Control.Monad.Reader (asks)
 import Testlib.Prelude
+import UnliftIO (timeout)
 import UnliftIO.Concurrent
 
+-- | assert that no notifications with the predicate happen within the timeout
+assertNoNotifications ::
+  (HasCallStack, MakesValue user, MakesValue client) =>
+  -- | the user
+  user ->
+  -- | the client of that user
+  client ->
+  -- | the last notif
+  Maybe String ->
+  -- | the predicate
+  (Value -> App Bool) ->
+  App ()
+assertNoNotifications u uc since0 p = do
+  ucid <- objId uc
+  let go since = do
+        notifs <-
+          getNotifications u def {client = Just ucid, since = since}
+            `bindResponse` asList
+            . (%. "notifications")
+            . (.json)
+        partitionM p notifs >>= \case
+          ([], nonMatching) ->
+            threadDelay 1_000 *> case nonMatching of
+              (lastMay -> Just lst) -> objId lst >>= go . Just
+              _ -> go Nothing
+          (matching, _) -> do
+            pj <- prettyJSON matching
+            assertFailure $
+              unlines
+                [ "Expected no matching events  but got:",
+                  pj
+                ]
+  Nothing <- asks timeOutSeconds >>= flip timeout (go since0)
+  pure ()
+
 awaitNotifications ::
   (HasCallStack, MakesValue user, MakesValue client) =>
   user ->
@@ -18,34 +55,35 @@ awaitNotifications ::
   (Value -> App Bool) ->
   App [Value]
 awaitNotifications user client since0 n selector = do
-  tSecs <- asks timeOutSeconds
+  tSecs <- asks ((* 1000) . timeOutSeconds)
   assertAwaitResult =<< go tSecs since0 (AwaitResult False n [] [])
   where
-    go 0 _ res = pure res
-    go timeRemaining since res0 = do
-      c <- make client & asString
-      notifs <- bindResponse
-        ( getNotifications
-            user
-            def {since = since, client = Just c}
-        )
-        $ \resp -> asList (resp.json %. "notifications")
-      lastNotifId <- case notifs of
-        [] -> pure since
-        _ -> Just <$> objId (last notifs)
-      (matching, notMatching) <- partitionM selector notifs
-      let matchesSoFar = res0.matches <> matching
-          res =
-            res0
-              { matches = matchesSoFar,
-                nonMatches = res0.nonMatches <> notMatching,
-                success = length matchesSoFar >= res0.nMatchesExpected
-              }
-      if res.success
-        then pure res
-        else do
-          threadDelay (1_000_000)
-          go (timeRemaining - 1) lastNotifId res
+    go timeRemaining since res0
+      | timeRemaining <= 0 = pure res0
+      | otherwise =
+          do
+            c <- make client & asString
+            notifs <-
+              getNotifications
+                user
+                def {since = since, client = Just c}
+                `bindResponse` \resp -> asList (resp.json %. "notifications")
+            lastNotifId <- case notifs of
+              [] -> pure since
+              _ -> Just <$> objId (last notifs)
+            (matching, notMatching) <- partitionM selector notifs
+            let matchesSoFar = res0.matches <> matching
+                res =
+                  res0
+                    { matches = matchesSoFar,
+                      nonMatches = res0.nonMatches <> notMatching,
+                      success = length matchesSoFar >= res0.nMatchesExpected
+                    }
+            if res.success
+              then pure res
+              else do
+                threadDelay 1_000
+                go (timeRemaining - 1) lastNotifId res
 
 awaitNotification ::
   (HasCallStack, MakesValue user, MakesValue client, MakesValue lastNotifId) =>
@@ -110,8 +148,32 @@ isConvCreateNotif n = fieldEquals n "payload.0.type" "conversation.create"
 isConvDeleteNotif :: MakesValue a => a -> App Bool
 isConvDeleteNotif n = fieldEquals n "payload.0.type" "conversation.delete"
 
+notifTypeIsEqual :: MakesValue a => String -> a -> App Bool
+notifTypeIsEqual typ n = nPayload n %. "type" `isEqual` typ
+
 isTeamMemberLeaveNotif :: MakesValue a => a -> App Bool
-isTeamMemberLeaveNotif n = nPayload n %. "type" `isEqual` "team.member-leave"
+isTeamMemberLeaveNotif = notifTypeIsEqual "team.member-leave"
+
+isUserActivateNotif :: MakesValue a => a -> App Bool
+isUserActivateNotif = notifTypeIsEqual "user.activate"
+
+isUserClientAddNotif :: MakesValue a => a -> App Bool
+isUserClientAddNotif = notifTypeIsEqual "user.client-add"
+
+isUserClientRemoveNotif :: MakesValue a => a -> App Bool
+isUserClientRemoveNotif = notifTypeIsEqual "user.client-remove"
+
+isUserLegalholdRequestNotif :: MakesValue a => a -> App Bool
+isUserLegalholdRequestNotif = notifTypeIsEqual "user.legalhold-request"
+
+isUserLegalholdEnabledNotif :: MakesValue a => a -> App Bool
+isUserLegalholdEnabledNotif = notifTypeIsEqual "user.legalhold-enable"
+
+isUserLegalholdDisabledNotif :: MakesValue a => a -> App Bool
+isUserLegalholdDisabledNotif = notifTypeIsEqual "user.legalhold-disable"
+
+isUserConnectionNotif :: MakesValue a => a -> App Bool
+isUserConnectionNotif = notifTypeIsEqual "user.connection"
 
 assertLeaveNotification ::
   ( HasCallStack,
Original file line number	Diff line number	Diff line change
		@@ -0,0 +1 @@
		port flaking LH tests to new integration and improve the ergonomics of our testing library