diff --git a/changelog.d/5-internal/wpb-15151-revive-and-translate-tests b/changelog.d/5-internal/wpb-15151-revive-and-translate-tests new file mode 100644 index 00000000000..4e6263ee994 --- /dev/null +++ b/changelog.d/5-internal/wpb-15151-revive-and-translate-tests @@ -0,0 +1 @@ +Revive and translate old integration test. \ No newline at end of file diff --git a/integration/test/API/Galley.hs b/integration/test/API/Galley.hs index 6fadfa02f6e..2d9aa7cd9d4 100644 --- a/integration/test/API/Galley.hs +++ b/integration/test/API/Galley.hs @@ -717,10 +717,23 @@ getTeamFeature user tid featureName = do req <- baseRequest user Galley Versioned (joinHttpPath ["teams", tidStr, "features", featureName]) submit "GET" req -setTeamFeatureConfig :: (HasCallStack, MakesValue user, MakesValue team, MakesValue featureName, MakesValue payload) => user -> team -> featureName -> payload -> App Response +setTeamFeatureConfig :: + (HasCallStack, MakesValue user, MakesValue team, MakesValue featureName, MakesValue payload) => + user -> + team -> + featureName -> + payload -> + App Response setTeamFeatureConfig = setTeamFeatureConfigVersioned Versioned -setTeamFeatureConfigVersioned :: (HasCallStack, MakesValue user, MakesValue team, MakesValue featureName, MakesValue payload) => Versioned -> user -> team -> featureName -> payload -> App Response +setTeamFeatureConfigVersioned :: + (HasCallStack, MakesValue user, MakesValue team, MakesValue featureName, MakesValue payload) => + Versioned -> + user -> + team -> + featureName -> + payload -> + App Response setTeamFeatureConfigVersioned versioned user team featureName payload = do tid <- asString team fn <- asString featureName diff --git a/integration/test/API/GalleyInternal.hs b/integration/test/API/GalleyInternal.hs index 65592f37108..be0d09fbecf 100644 --- a/integration/test/API/GalleyInternal.hs +++ b/integration/test/API/GalleyInternal.hs @@ -98,7 +98,13 @@ generateVerificationCode' domain email = do emailStr <- asString email submit "POST" $ req & addJSONObject ["email" .= emailStr, "action" .= "login"] -setTeamFeatureConfig :: (HasCallStack, MakesValue domain, MakesValue team, MakesValue featureName, MakesValue payload) => domain -> team -> featureName -> payload -> App Response +setTeamFeatureConfig :: + (HasCallStack, MakesValue domain, MakesValue team, MakesValue featureName, MakesValue payload) => + domain -> + team -> + featureName -> + payload -> + App Response setTeamFeatureConfig domain team featureName payload = do tid <- asString team fn <- asString featureName @@ -106,7 +112,13 @@ setTeamFeatureConfig domain team featureName payload = do req <- baseRequest domain Galley Unversioned $ joinHttpPath ["i", "teams", tid, "features", fn] submit "PUT" $ req & addJSON p -patchTeamFeatureConfig :: (HasCallStack, MakesValue domain, MakesValue team, MakesValue featureName, MakesValue payload) => domain -> team -> featureName -> payload -> App Response +patchTeamFeatureConfig :: + (HasCallStack, MakesValue domain, MakesValue team, MakesValue featureName, MakesValue payload) => + domain -> + team -> + featureName -> + payload -> + App Response patchTeamFeatureConfig domain team featureName payload = do tid <- asString team fn <- asString featureName diff --git a/integration/test/Test/LegalHold.hs b/integration/test/Test/LegalHold.hs index ee2a9e1f4cf..e8efce43287 100644 --- a/integration/test/Test/LegalHold.hs +++ b/integration/test/Test/LegalHold.hs @@ -107,11 +107,11 @@ testLHPreventAddingNonConsentingUsers v = do m %. "qualified_id" mems `shouldMatchSet` forM us (\m -> m %. "qualified_id") -testLHGetAndUpdateSettings :: (HasCallStack) => LhApiVersion -> App () -testLHGetAndUpdateSettings v = do +testLHGetAndUpdateSettings :: (HasCallStack) => ImplicitConsent -> LhApiVersion -> App () +testLHGetAndUpdateSettings implicitConsent v = ensureLHFeatureConfigForServer implicitConsent $ \dom -> do withMockServer def (lhMockAppV v) $ \lhDomAndPort _chan -> do - (owner, tid, [alice]) <- createTeam OwnDomain 2 - stranger <- randomUser OwnDomain def + (owner, tid, [alice]) <- createTeam dom 2 + stranger <- randomUser dom def let getSettingsWorks :: (HasCallStack) => Value -> String -> App () getSettingsWorks target status = bindResponse (getLegalHoldSettings tid target) $ \resp -> do @@ -127,8 +127,13 @@ testLHGetAndUpdateSettings v = do getSettingsWorks owner "disabled" getSettingsWorks alice "disabled" - legalholdWhitelistTeam tid owner >>= assertSuccess - legalholdIsTeamInWhitelist tid owner >>= assertSuccess + case implicitConsent of + ImplicitConsent -> do + legalholdWhitelistTeam tid owner >>= assertSuccess + legalholdIsTeamInWhitelist tid owner >>= assertSuccess + ExplicitConsent -> do + let payload = object ["status" .= "enabled"] -- legalhold has implicit lock status "unlocked" + API.GalleyInternal.setTeamFeatureConfig dom tid "legalhold" payload >>= assertSuccess getSettingsFails stranger getSettingsWorks owner "not_configured" @@ -1102,3 +1107,29 @@ testNoCommonVersion = do bindResponse (requestLegalHoldDevice tid alice bob) $ \resp -> do resp.status `shouldMatchInt` 500 resp.json %. "label" `shouldMatch` "server-error" + +-- | LH can be configured in a way that does not require users to give preliminary consent to +-- LH when being added to a team. The user still has to approve the LH device before the +-- recording starts. This is called "implicit consent", was introduced to accomodate specific +-- work flows, and there is some hope that it'll be removed in the future. +-- +-- Explicit consent requires users to consent on entering the team, and then approve the +-- actual being put under recording again if it happens. +-- +-- This flag allows to make tests run through both configurations with minimal adjustment. +data ImplicitConsent = ImplicitConsent | ExplicitConsent + deriving (Eq, Show, Generic) + +-- | Ensure that the LH config is as expected: Either by expecting it from the +-- current server's config. Or, by creating a new one. +ensureLHFeatureConfigForServer :: ImplicitConsent -> (String {- domain -} -> App ()) -> App () +ensureLHFeatureConfigForServer ImplicitConsent app = do + -- This should be set in the server's config file. Thus, we only assert here + -- (to guard against accidential change.) + cfg <- readServiceConfig Galley + (cfg %. "settings.featureFlags.legalhold") `shouldMatch` "whitelist-teams-and-implicit-consent" + app =<< asString OwnDomain +ensureLHFeatureConfigForServer ExplicitConsent app = + withModifiedBackend (def {galleyCfg = upd}) app + where + upd = setField "settings.featureFlags.legalhold" "disabled-by-default" diff --git a/integration/test/Testlib/ModService.hs b/integration/test/Testlib/ModService.hs index 59b81e68204..83b5cfcf900 100644 --- a/integration/test/Testlib/ModService.hs +++ b/integration/test/Testlib/ModService.hs @@ -56,7 +56,7 @@ import Prelude withModifiedBackend :: (HasCallStack) => ServiceOverrides -> ((HasCallStack) => String -> App a) -> App a withModifiedBackend overrides k = - startDynamicBackends [overrides] (\domains -> k (head domains)) + startDynamicBackends [overrides] (\[domains] -> k domains) copyDirectoryRecursively :: FilePath -> FilePath -> IO () copyDirectoryRecursively from to = do diff --git a/services/galley/test/integration/API/Teams/LegalHold/DisabledByDefault.hs b/services/galley/test/integration/API/Teams/LegalHold/DisabledByDefault.hs index c5d2cebc175..8f7194254a2 100644 --- a/services/galley/test/integration/API/Teams/LegalHold/DisabledByDefault.hs +++ b/services/galley/test/integration/API/Teams/LegalHold/DisabledByDefault.hs @@ -84,7 +84,6 @@ tests s = testOnlyIfLhEnabled s "DELETE /teams/{tid}/legalhold/{uid}" testDisableLegalHoldForUser, -- legal hold settings testOnlyIfLhEnabled s "POST /teams/{tid}/legalhold/settings" testCreateLegalHoldTeamSettings, - testOnlyIfLhEnabled s "GET /teams/{tid}/legalhold/settings" testGetLegalHoldTeamSettings, testOnlyIfLhEnabled s "DELETE /teams/{tid}/legalhold/settings" testRemoveLegalHoldFromTeam, testOnlyIfLhEnabled s "GET, PUT [/i]?/teams/{tid}/legalhold" testEnablePerTeam, testOnlyIfLhEnabled s "GET, PUT [/i]?/teams/{tid}/legalhold - too large" testEnablePerTeamTooLarge, @@ -400,49 +399,6 @@ testCreateLegalHoldTeamSettings = do -- synchronously and respond with 201 withTestService (lhapp Working) (lhtest Working) -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 - -- returns 403 if user is not in team. - newService <- newLegalHoldService lhPort - 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 - putEnabled tid Public.FeatureStatusEnabled -- enable it for this team - - -- 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