[WPB-15151] Fix flaky test, remove redundant test (#4384)

Co-authored-by: Sven Tennie <[email protected]>

changelog.d/5-internal/wpb-15151-translate-flake

@@ -0,0 +1 @@
+Translate integration test to new suite.

integration/test/API/Galley.hs

@@ -638,6 +638,12 @@ getLegalHoldStatus tid zusr = do
   req <- baseRequest zusr Galley Versioned (joinHttpPath ["teams", tidStr, "legalhold", uidStr])
   submit "GET" req
 
+getLegalHoldSettings :: (HasCallStack, MakesValue tid, MakesValue zusr) => tid -> zusr -> App Response
+getLegalHoldSettings tid zusr = do
+  tidStr <- asString tid
+  req <- baseRequest zusr Galley Versioned (joinHttpPath ["teams", tidStr, "legalhold", "settings"])
+  submit "GET" 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 =

integration/test/Test/LegalHold.hs

@@ -29,6 +29,7 @@ import Control.Monad.Trans.Class (lift)
 import Data.Aeson.Lens
 import qualified Data.ByteString.Char8 as BS8
 import Data.ByteString.Lazy (LazyByteString)
+import Data.List.Extra (trim)
 import qualified Data.Map as Map
 import qualified Data.ProtoLens as Proto
 import Data.ProtoLens.Labels ()
@@ -47,7 +48,7 @@ import Testlib.Prekeys
 import Testlib.Prelude
 import UnliftIO (Chan, readChan, timeout)
 
-testLHPreventAddingNonConsentingUsers :: LhApiVersion -> App ()
+testLHPreventAddingNonConsentingUsers :: (HasCallStack) => LhApiVersion -> App ()
 testLHPreventAddingNonConsentingUsers v = do
   withMockServer def (lhMockAppV v) $ \lhDomAndPort _chan -> do
     (owner, tid, [alice, alex]) <- createTeam OwnDomain 3
@@ -106,6 +107,49 @@ testLHPreventAddingNonConsentingUsers v = do
               m %. "qualified_id"
         mems `shouldMatchSet` forM us (\m -> m %. "qualified_id")
 
+testLHGetAndUpdateSettings :: (HasCallStack) => LhApiVersion -> App ()
+testLHGetAndUpdateSettings v = do
+  withMockServer def (lhMockAppV v) $ \lhDomAndPort _chan -> do
+    (owner, tid, [alice]) <- createTeam OwnDomain 2
+    stranger <- randomUser OwnDomain def
+
+    let getSettingsWorks :: (HasCallStack) => Value -> String -> App ()
+        getSettingsWorks target status = bindResponse (getLegalHoldSettings tid target) $ \resp -> do
+          resp.status `shouldMatchInt` 200
+          resp.json %. "status" `shouldMatch` status
+
+        getSettingsFails :: (HasCallStack) => Value -> App ()
+        getSettingsFails target = bindResponse (getLegalHoldSettings tid target) $ \resp -> do
+          resp.status `shouldMatchInt` 403
+          resp.json %. "label" `shouldMatch` "no-team-member"
+
+    getSettingsFails stranger
+    getSettingsWorks owner "disabled"
+    getSettingsWorks alice "disabled"
+
+    legalholdWhitelistTeam tid owner >>= assertSuccess
+    legalholdIsTeamInWhitelist tid owner >>= assertSuccess
+
+    getSettingsFails stranger
+    getSettingsWorks owner "not_configured"
+    getSettingsWorks alice "not_configured"
+
+    let lhSettings = mkLegalHoldSettings lhDomAndPort
+    bindResponse (postLegalHoldSettings tid owner lhSettings) $ \resp -> do
+      resp.status `shouldMatchInt` 201
+
+    bindResponse (getLegalHoldSettings tid alice) $ \resp ->
+      do
+        resp.status `shouldMatchInt` 200
+        assertFieldMissing resp.json "label"
+        (resp.json %. "settings" %. "auth_token") `shouldMatch` (lhSettings %. "auth_token")
+        (resp.json %. "settings" %. "base_url") `shouldMatch` (lhSettings %. "base_url")
+        (resp.json %. "settings" %. "public_key" >>= asString <&> trim)
+          `shouldMatch` (lhSettings %. "public_key")
+        (resp.json %. "settings" %. "team_id") `shouldMatch` tid
+        (resp.json %. "settings" %. "fingerprint" >>= asString <&> length)
+          `shouldNotMatch` (0 :: Int)
+
 testLHMessageExchange ::
   (HasCallStack) =>
   TaggedBool "clients1New" ->

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

@@ -64,7 +64,6 @@ testsPublic s =
     "Teams LegalHold API (with flag whitelist-teams-and-implicit-consent)"
     [ -- legal hold settings
       testOnlyIfLhWhitelisted s "POST /teams/{tid}/legalhold/settings" testCreateLegalHoldTeamSettings,
-      testOnlyIfLhWhitelisted s "GET /teams/{tid}/legalhold/settings" testGetLegalHoldTeamSettings,
       testOnlyIfLhWhitelisted s "Not implemented: DELETE /teams/{tid}/legalhold/settings" testRemoveLegalHoldFromTeam,
       -- behavior of existing end-points
       testOnlyIfLhWhitelisted s "POST /clients" testCannotCreateLegalHoldDeviceOldAPI,
@@ -163,52 +162,6 @@ testCreateLegalHoldTeamSettings = withTeam $ \owner tid -> do
   -- synchronously and respond with 201
   withTestService (lhapp Working) (lhtest Working)
 
--- NOTE: we do not expect event TeamEvent'TEAM_UPDATE as a reaction to this POST.
-
-testGetLegalHoldTeamSettings :: TestM ()
-testGetLegalHoldTeamSettings = do
-  (owner, tid) <- createBindingTeam
-  stranger <- randomUser
-  member <- randomUser
-  addTeamMemberInternal tid member (rolePermissions RoleMember) Nothing
-  let lhapp :: Chan () -> Application
-      lhapp _ch _req res = res $ responseLBS status200 mempty mempty
-  withTestService lhapp $ \lhPort _ -> do
-    newService <- newLegalHoldService lhPort
-    -- returns 403 if user is not in team.
-    getSettings stranger tid !!! testResponse 403 (Just "no-team-member")
-    -- returns 200 with corresp. status if legalhold for team is disabled
-    do
-      let respOk :: ResponseLBS -> TestM ()
-          respOk resp = liftIO $ do
-            assertEqual "bad status code" 200 (statusCode resp)
-            assertEqual "bad body" ViewLegalHoldServiceDisabled (responseJsonUnsafe resp)
-      getSettings owner tid >>= respOk
-      getSettings member tid >>= respOk
-
-    putLHWhitelistTeam tid !!! const 200 === statusCode
-
-    -- returns 200 with corresp. status if legalhold for team is enabled, but not configured
-    do
-      let respOk :: ResponseLBS -> TestM ()
-          respOk resp = liftIO $ do
-            assertEqual "bad status code" 200 (statusCode resp)
-            assertEqual "bad body" ViewLegalHoldServiceNotConfigured (responseJsonUnsafe resp)
-      getSettings owner tid >>= respOk
-      getSettings member tid >>= respOk
-    postSettings owner tid newService !!! testResponse 201 Nothing
-    -- returns legal hold service info if team is under legal hold and user is in team (even
-    -- no permissions).
-    ViewLegalHoldService service <- getSettingsTyped member tid
-    liftIO $ do
-      let sKey = newLegalHoldServiceKey newService
-      Just (_, fpr) <- validateServiceKey sKey
-      assertEqual "viewLegalHoldServiceTeam" tid (viewLegalHoldServiceTeam service)
-      assertEqual "viewLegalHoldServiceUrl" (newLegalHoldServiceUrl newService) (viewLegalHoldServiceUrl service)
-      assertEqual "viewLegalHoldServiceFingerprint" fpr (viewLegalHoldServiceFingerprint service)
-      assertEqual "viewLegalHoldServiceKey" sKey (viewLegalHoldServiceKey service)
-      assertEqual "viewLegalHoldServiceAuthToken" (newLegalHoldServiceToken newService) (viewLegalHoldServiceAuthToken service)
-
 testRemoveLegalHoldFromTeam :: TestM ()
 testRemoveLegalHoldFromTeam = do
   (owner, tid) <- createBindingTeam

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

@@ -400,8 +400,6 @@ testCreateLegalHoldTeamSettings = do
   -- synchronously and respond with 201
   withTestService (lhapp Working) (lhtest Working)
 
--- NOTE: we do not expect event TeamEvent'TEAM_UPDATE as a reaction to this POST.
-
 testGetLegalHoldTeamSettings :: TestM ()
 testGetLegalHoldTeamSettings = do
   (owner, tid) <- createBindingTeam

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

@@ -275,7 +275,7 @@ postSettings uid tid new =
         . json new
   where
     policy :: RetryPolicy
-    policy = limitRetriesByCumulativeDelay 5_000_000 $ exponentialBackoff 50
+    policy = limitRetriesByCumulativeDelay 10_000_000 $ exponentialBackoff 50
     only412 :: RetryStatus -> ResponseLBS -> TestM Bool
     only412 _ resp = pure $ statusCode resp == 412