From 01211fe8aefe7cba165a79cb9eafb3e88fe892af Mon Sep 17 00:00:00 2001 From: Matthias Fischmann Date: Fri, 27 Dec 2024 13:52:42 +0100 Subject: [PATCH] [WPB-15151] translate more LH tests to /integration; increase coverage (#4387) --- .../wpb-15151-revive-and-translate-tests | 2 +- integration/test/SetupHelpers.hs | 26 -- integration/test/Test/LegalHold.hs | 183 +++++++---- .../test/integration/API/Teams/LegalHold.hs | 1 + .../API/Teams/LegalHold/DisabledByDefault.hs | 289 +----------------- 5 files changed, 130 insertions(+), 371 deletions(-) diff --git a/changelog.d/5-internal/wpb-15151-revive-and-translate-tests b/changelog.d/5-internal/wpb-15151-revive-and-translate-tests index 4e6263ee994..efa3adb2c1b 100644 --- a/changelog.d/5-internal/wpb-15151-revive-and-translate-tests +++ b/changelog.d/5-internal/wpb-15151-revive-and-translate-tests @@ -1 +1 @@ -Revive and translate old integration test. \ No newline at end of file +Revive and translate old integration test (#4387, ##) diff --git a/integration/test/SetupHelpers.hs b/integration/test/SetupHelpers.hs index e9afe467a84..41044541270 100644 --- a/integration/test/SetupHelpers.hs +++ b/integration/test/SetupHelpers.hs @@ -8,7 +8,6 @@ import API.BrigInternal import API.Cargohold import API.Common import API.Galley -import API.GalleyInternal (legalholdWhitelistTeam) import API.Spar import Control.Monad.Reader import Crypto.Random (getRandomBytes) @@ -34,7 +33,6 @@ import qualified SAML2.WebSSO.API.Example as SAML import qualified SAML2.WebSSO.Test.MockResponse as SAML import SAML2.WebSSO.Test.Util (SampleIdP (..), makeSampleIdPMetadata) import Testlib.JSON -import Testlib.MockIntegrationService (mkLegalHoldSettings) import Testlib.Prelude import Testlib.Printing (indent) import qualified Text.XML as XML @@ -324,30 +322,6 @@ setupProvider u np@(NewProvider {..}) = do activateProvider dom key code loginProvider dom newProviderEmail pass $> provider --- | setup a legalhold device for @uid@, authorised by @owner@ --- at the specified port -setUpLHDevice :: - (HasCallStack, MakesValue tid, MakesValue owner, MakesValue uid) => - tid -> - owner -> - uid -> - -- | the host and port the LH service is running on - (String, Int) -> - App () -setUpLHDevice tid alice bob lhPort = do - legalholdWhitelistTeam tid alice - >>= assertStatus 200 - - -- the status messages for these have already been tested - postLegalHoldSettings tid alice (mkLegalHoldSettings lhPort) - >>= assertStatus 201 - - requestLegalHoldDevice tid alice bob - >>= assertStatus 201 - - approveLegalHoldDevice tid bob defPassword - >>= assertStatus 200 - lhDeviceIdOf :: (MakesValue user) => user -> App String lhDeviceIdOf bob = do bobId <- objId bob diff --git a/integration/test/Test/LegalHold.hs b/integration/test/Test/LegalHold.hs index e8efce43287..ed24c84d0e1 100644 --- a/integration/test/Test/LegalHold.hs +++ b/integration/test/Test/LegalHold.hs @@ -107,8 +107,8 @@ testLHPreventAddingNonConsentingUsers v = do m %. "qualified_id" mems `shouldMatchSet` forM us (\m -> m %. "qualified_id") -testLHGetAndUpdateSettings :: (HasCallStack) => ImplicitConsent -> LhApiVersion -> App () -testLHGetAndUpdateSettings implicitConsent v = ensureLHFeatureConfigForServer implicitConsent $ \dom -> do +testLHGetAndUpdateSettings :: (HasCallStack) => Consent -> LhApiVersion -> App () +testLHGetAndUpdateSettings consent v = ensureLHFeatureConfigForServer consent $ \dom -> do withMockServer def (lhMockAppV v) $ \lhDomAndPort _chan -> do (owner, tid, [alice]) <- createTeam dom 2 stranger <- randomUser dom def @@ -127,13 +127,7 @@ testLHGetAndUpdateSettings implicitConsent v = ensureLHFeatureConfigForServer im getSettingsWorks owner "disabled" getSettingsWorks alice "disabled" - 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 + whitelistOrEnableLHForTeam consent dom tid owner getSettingsFails stranger getSettingsWorks owner "not_configured" @@ -327,9 +321,9 @@ testLHDeleteClientManually = do -- other unspecific client error. resp.json %. "message" `shouldMatch` "LegalHold clients cannot be deleted. LegalHold must be disabled on this user by an admin" -testLHRequestDevice :: LhApiVersion -> App () -testLHRequestDevice v = do - (alice, tid, [bob]) <- createTeam OwnDomain 2 +testLHRequestDevice :: Consent -> LhApiVersion -> App () +testLHRequestDevice consent v = ensureLHFeatureConfigForServer consent $ \dom -> do + (alice, tid, [bob]) <- createTeam dom 2 let reqNotEnabled requester requestee = requestLegalHoldDevice tid requester requestee >>= assertLabel 403 "legalhold-not-enabled" @@ -340,7 +334,7 @@ testLHRequestDevice v = do pks <- replicateM 3 getPrekey withMockServer def (lhMockAppWithPrekeys v MkCreateMock {nextLastPrey = pure lpk, somePrekeys = pure pks}) \lhDomAndPort _chan -> do - let statusShouldBe :: String -> App () + let statusShouldBe :: (HasCallStack) => String -> App () statusShouldBe status = legalholdUserStatus tid alice bob `bindResponse` \resp -> do resp.status `shouldMatchInt` 200 @@ -351,11 +345,16 @@ testLHRequestDevice v = do reqNotEnabled requester bob statusShouldBe "no_consent" - legalholdWhitelistTeam tid alice >>= assertSuccess + whitelistOrEnableLHForTeam consent dom tid alice postLegalHoldSettings tid alice (mkLegalHoldSettings lhDomAndPort) >>= assertSuccess - - statusShouldBe "disabled" - + statusShouldBe case consent of + Implicit -> "disabled" + Explicit -> "no_consent" + + let expected = case consent of + Implicit -> 204 + Explicit -> 201 + in consentToLegalHold tid bob defPassword >>= assertStatus expected requestLegalHoldDevice tid alice bob >>= assertStatus 201 statusShouldBe "pending" @@ -387,30 +386,32 @@ checkChanVal :: (HasCallStack) => Chan (t, LazyByteString) -> (Value -> MaybeT A checkChanVal chan match = checkChan chan \(_, bs) -> runMaybeT do MaybeT (pure (decode bs)) >>= match -testLHApproveDevice :: App () -testLHApproveDevice = do +testLHApproveDevice :: Consent -> App () +testLHApproveDevice consent = ensureLHFeatureConfigForServer consent $ \dom -> do -- team users -- alice (boss) and bob and charlie (member) - (alice, tid, [bob, charlie]) <- createTeam OwnDomain 3 + (alice, tid, [bob, charlie]) <- createTeam dom 3 -- ollie the outsider ollie <- do - o <- randomUser OwnDomain def + o <- randomUser dom def connectTwoUsers o alice pure o -- sandy the stranger - sandy <- randomUser OwnDomain def + sandy <- randomUser dom def - legalholdWhitelistTeam tid alice >>= assertStatus 200 + whitelistOrEnableLHForTeam consent dom tid alice approveLegalHoldDevice tid (bob %. "qualified_id") defPassword >>= assertLabel 412 "legalhold-not-pending" withMockServer def lhMockApp \lhDomAndPort chan -> do - legalholdWhitelistTeam tid alice - >>= assertStatus 200 postLegalHoldSettings tid alice (mkLegalHoldSettings lhDomAndPort) >>= assertStatus 201 + let expected = case consent of + Implicit -> 204 + Explicit -> 201 + in consentToLegalHold tid bob defPassword >>= assertStatus expected requestLegalHoldDevice tid alice bob >>= assertStatus 201 @@ -473,11 +474,11 @@ testLHApproveDevice = do outsiderClient <- objId $ addClient outsider def `bindResponse` getJSON 201 assertNoNotifications outsider outsiderClient Nothing isUserLegalholdEnabledNotif -testLHGetDeviceStatus :: LhApiVersion -> App () -testLHGetDeviceStatus v = do +testLHGetDeviceStatus :: (HasCallStack) => Consent -> LhApiVersion -> App () +testLHGetDeviceStatus consent v = ensureLHFeatureConfigForServer consent $ \dom -> do -- team users -- alice (team owner) and bob (member) - (alice, tid, [bob]) <- createTeam OwnDomain 2 + (alice, tid, [bob]) <- createTeam dom 2 for_ [alice, bob] \user -> do legalholdUserStatus tid alice user `bindResponse` \resp -> do resp.status `shouldMatchInt` 200 @@ -490,12 +491,13 @@ testLHGetDeviceStatus v = do def do lhMockAppWithPrekeys v MkCreateMock {nextLastPrey = pure lpk, somePrekeys = pure pks} \lhDomAndPort _chan -> do - legalholdWhitelistTeam tid alice - >>= assertStatus 200 - + whitelistOrEnableLHForTeam consent dom tid alice legalholdUserStatus tid alice bob `bindResponse` \resp -> do resp.status `shouldMatchInt` 200 - resp.json %. "status" `shouldMatch` "disabled" + resp.json %. "status" `shouldMatch` case consent of + Implicit -> "disabled" + Explicit -> "no_consent" + lookupField resp.json "last_prekey" >>= assertNothing runMaybeT (lookupFieldM resp.json "client" >>= flip lookupFieldM "id") @@ -505,6 +507,10 @@ testLHGetDeviceStatus v = do postLegalHoldSettings tid alice (mkLegalHoldSettings lhDomAndPort) >>= assertStatus 201 + let expected = case consent of + Implicit -> 204 + Explicit -> 201 + in consentToLegalHold tid bob defPassword >>= assertStatus expected requestLegalHoldDevice tid alice bob >>= assertStatus 201 @@ -530,12 +536,12 @@ testLHGetDeviceStatus v = do setTimeoutTo :: Int -> Env -> Env setTimeoutTo tSecs env = env {timeOutSeconds = tSecs} -testLHDisableForUser :: App () -testLHDisableForUser = do - (alice, tid, [bob]) <- createTeam OwnDomain 2 +testLHDisableForUser :: (HasCallStack) => Consent -> App () +testLHDisableForUser consent = ensureLHFeatureConfigForServer consent $ \dom -> do + (alice, tid, [bob]) <- createTeam dom 2 withMockServer def lhMockApp \lhDomAndPort chan -> do - setUpLHDevice tid alice bob lhDomAndPort + setUpLHDevice consent dom tid alice bob lhDomAndPort awaitNotification bob noValue isUserClientAddNotif >>= \notif -> do notif %. "payload.0.client.type" `shouldMatch` "legalhold" @@ -573,30 +579,34 @@ testLHDisableForUser = do shouldBeEmpty lhClients -testLHEnablePerTeam :: LhApiVersion -> App () -testLHEnablePerTeam v = do +testLHEnablePerTeam :: (HasCallStack) => Consent -> LhApiVersion -> App () +testLHEnablePerTeam consent v = ensureLHFeatureConfigForServer consent $ \dom -> do -- team users -- alice (team owner) and bob (member) - (alice, tid, [bob]) <- createTeam OwnDomain 2 + (alice, tid, [bob]) <- createTeam dom 2 legalholdIsEnabled tid alice `bindResponse` \resp -> do resp.status `shouldMatchInt` 200 resp.json %. "lockStatus" `shouldMatch` "unlocked" resp.json %. "status" `shouldMatch` "disabled" withMockServer def (lhMockAppV v) \lhDomAndPort _chan -> do - setUpLHDevice tid alice bob lhDomAndPort + setUpLHDevice consent dom tid alice bob lhDomAndPort legalholdUserStatus tid alice bob `bindResponse` \resp -> do resp.status `shouldMatchInt` 200 resp.json %. "status" `shouldMatch` "enabled" putLegalholdStatus tid alice "disabled" - `bindResponse` assertLabel 403 "legalhold-whitelisted-only" + `bindResponse` case consent of + Implicit -> assertLabel 403 "legalhold-whitelisted-only" + Explicit -> assertStatus 200 -- the put doesn't have any influence on the status being "enabled" legalholdUserStatus tid alice bob `bindResponse` \resp -> do resp.status `shouldMatchInt` 200 - resp.json %. "status" `shouldMatch` "enabled" + resp.json %. "status" `shouldMatch` case consent of + Implicit -> "enabled" + Explicit -> "disabled" testLHGetMembersIncludesStatus :: LhApiVersion -> App () testLHGetMembersIncludesStatus v = do @@ -811,30 +821,37 @@ testLHNoConsentRemoveFromGroup approvedOrPending admin = do LHApproved -> assertLabel 403 "access-denied" LHPending -> assertStatus 200 -testLHHappyFlow :: LhApiVersion -> App () -testLHHappyFlow v = do - (alice, tid, [bob]) <- createTeam OwnDomain 2 - let statusShouldBe :: String -> App () +testLHHappyFlow :: (HasCallStack) => Consent -> LhApiVersion -> App () +testLHHappyFlow consent v = ensureLHFeatureConfigForServer consent $ \dom -> do + (alice, tid, [bob]) <- createTeam dom 2 + + let statusShouldBe :: (HasCallStack) => String -> App () statusShouldBe status = legalholdUserStatus tid alice bob `bindResponse` \resp -> do resp.status `shouldMatchInt` 200 resp.json %. "status" `shouldMatch` status - legalholdWhitelistTeam tid alice >>= assertStatus 200 + whitelistOrEnableLHForTeam consent dom tid alice lpk <- getLastPrekey pks <- replicateM 3 getPrekey - withMockServer def (lhMockAppWithPrekeys v MkCreateMock {nextLastPrey = pure lpk, somePrekeys = pure pks}) \lhDomAndPort _chan -> do - postLegalHoldSettings tid alice (mkLegalHoldSettings lhDomAndPort) >>= assertStatus 201 + let ourLHMockApp = lhMockAppWithPrekeys v MkCreateMock {nextLastPrey = pure lpk, somePrekeys = pure pks} + withMockServer def ourLHMockApp \lhDomAndPort _chan -> do + statusShouldBe $ case consent of + Implicit -> "disabled" + Explicit -> "no_consent" - -- implicit consent + consentToLegalHold tid bob defPassword >>= assertStatus case consent of + Implicit -> 204 + Explicit -> 201 statusShouldBe "disabled" - -- whitelisting is idempotent - legalholdWhitelistTeam tid alice >>= assertStatus 200 + + postLegalHoldSettings tid alice (mkLegalHoldSettings lhDomAndPort) >>= assertStatus 201 statusShouldBe "disabled" - -- memmbers cannot request LH devices + -- members cannot request LH devices requestLegalHoldDevice tid bob alice >>= assertLabel 403 "operation-denied" + requestLegalHoldDevice tid bob bob >>= assertLabel 403 "operation-denied" -- owners can; bob should now have a pending request requestLegalHoldDevice tid alice bob >>= assertStatus 201 @@ -856,6 +873,18 @@ testLHHappyFlow v = do >>= assertJust "client id is present" resp.json %. "last_prekey" `shouldMatch` lpk + -- user cannot delete their own LH device + disableLegalHold tid bob bob defPassword >>= assertLabel 403 "operation-denied" + legalholdUserStatus tid alice bob `bindResponse` \resp -> do + resp.status `shouldMatchInt` 200 + resp.json %. "status" `shouldMatch` "enabled" + + -- admin can delete LH device + disableLegalHold tid alice bob defPassword >>= assertSuccess + legalholdUserStatus tid alice bob `bindResponse` \resp -> do + resp.status `shouldMatchInt` 200 + resp.json %. "status" `shouldMatch` "disabled" + testLHGetStatus :: LhApiVersion -> App () testLHGetStatus v = do (alice, tid, [bob]) <- createTeam OwnDomain 2 @@ -1117,19 +1146,59 @@ testNoCommonVersion = do -- 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 +data Consent = Implicit | Explicit 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 +ensureLHFeatureConfigForServer :: Consent -> (String {- domain -} -> App ()) -> App () +ensureLHFeatureConfigForServer Implicit 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 = +ensureLHFeatureConfigForServer Explicit app = withModifiedBackend (def {galleyCfg = upd}) app where upd = setField "settings.featureFlags.legalhold" "disabled-by-default" + +whitelistOrEnableLHForTeam :: (HasCallStack, MakesValue tid, MakesValue user, MakesValue dom) => Consent -> dom -> tid -> user -> App () +whitelistOrEnableLHForTeam consent dom tid user = do + case consent of + Implicit -> do + legalholdWhitelistTeam tid user >>= assertSuccess + legalholdIsTeamInWhitelist tid user >>= assertSuccess + Explicit -> do + -- legalhold has implicit lock status "unlocked", so it just needs to be enabled: + let payload = object ["status" .= "enabled"] + API.GalleyInternal.setTeamFeatureConfig dom tid "legalhold" payload >>= assertSuccess + +-- | setup a legalhold device for @uid@, authorised by @owner@ +-- at the specified port +setUpLHDevice :: + (HasCallStack, MakesValue dom, MakesValue tid, MakesValue owner, MakesValue uid) => + Consent -> + dom -> + tid -> + owner -> + uid -> + -- | the host and port the LH service is running on + (String, Int) -> + App () +setUpLHDevice consent dom tid alice bob lhPort = do + whitelistOrEnableLHForTeam consent dom tid alice + + -- the status messages for these have already been tested + postLegalHoldSettings tid alice (mkLegalHoldSettings lhPort) + >>= assertStatus 201 + + let expected = case consent of + Implicit -> 204 + Explicit -> 201 + in consentToLegalHold tid bob defPassword >>= assertStatus expected + requestLegalHoldDevice tid alice bob + >>= assertStatus 201 + + approveLegalHoldDevice tid bob defPassword + >>= assertStatus 200 diff --git a/services/galley/test/integration/API/Teams/LegalHold.hs b/services/galley/test/integration/API/Teams/LegalHold.hs index 8b7b32c4795..72c2ee87686 100644 --- a/services/galley/test/integration/API/Teams/LegalHold.hs +++ b/services/galley/test/integration/API/Teams/LegalHold.hs @@ -60,6 +60,7 @@ tests s = testGroup "Legalhold" [testsPublic s, testsInternal s] testsPublic :: IO TestSetup -> TestTree testsPublic s = -- See also Client Tests in Brig; where behaviour around deleting/adding LH clients is tested + -- These tests should all go to /integration/test/Test/LegalHold.hs (which should be cleaned up to tell a coherent story). testGroup "Teams LegalHold API (with flag whitelist-teams-and-implicit-consent)" [ -- legal hold settings diff --git a/services/galley/test/integration/API/Teams/LegalHold/DisabledByDefault.hs b/services/galley/test/integration/API/Teams/LegalHold/DisabledByDefault.hs index 8f7194254a2..ec30e7b7083 100644 --- a/services/galley/test/integration/API/Teams/LegalHold/DisabledByDefault.hs +++ b/services/galley/test/integration/API/Teams/LegalHold/DisabledByDefault.hs @@ -31,7 +31,6 @@ import Bilge hiding (accept, head, timeout, trace) import Bilge.Assert import Brig.Types.Intra (UserSet (..)) import Brig.Types.Test.Arbitrary () -import Cassandra.Exec qualified as Cql import Control.Category ((>>>)) import Control.Concurrent.Chan import Control.Lens @@ -42,11 +41,8 @@ import Data.Map.Strict qualified as Map import Data.PEM import Data.Range import Data.Set qualified as Set -import Galley.Cassandra.Client import Galley.Cassandra.LegalHold -import Galley.Cassandra.LegalHold qualified as LegalHoldData import Galley.Env qualified as Galley -import Galley.Types.Clients qualified as Clients import Imports import Network.HTTP.Types.Status (status200, status404) import Network.Wai as Wai @@ -54,38 +50,28 @@ import Network.Wai.Handler.Warp qualified as Warp import Network.Wai.Utilities.Error qualified as Error import Test.QuickCheck.Instances () import Test.Tasty -import Test.Tasty.Cannon qualified as WS import Test.Tasty.HUnit -import TestHelpers import TestSetup import Wire.API.Message qualified as Msg import Wire.API.Provider.Service import Wire.API.Team.Feature qualified as Public import Wire.API.Team.LegalHold -import Wire.API.Team.LegalHold.External import Wire.API.Team.Member import Wire.API.Team.Member qualified as Team import Wire.API.Team.Permission import Wire.API.Team.Role import Wire.API.User.Client import Wire.API.User.Client qualified as Client -import Wire.API.UserEvent qualified as Ev tests :: IO TestSetup -> TestTree tests s = -- See also Client Tests in Brig; where behaviour around deleting/adding LH clients is tested + -- These tests should all go to /integration/test/Test/LegalHold.hs (which should be cleaned up to tell a coherent story). testGroup "Teams LegalHold API (with flag disabled-by-default)" - [ -- device handling (CRUD) - testOnlyIfLhEnabled s "POST /teams/{tid}/legalhold/{uid}" testRequestLegalHoldDevice, - testOnlyIfLhEnabled s "PUT /teams/{tid}/legalhold/approve" testApproveLegalHoldDevice, - test s "(user denies approval: nothing needs to be done in backend)" (pure ()), - testOnlyIfLhEnabled s "GET /teams/{tid}/legalhold/{uid}" testGetLegalHoldDeviceStatus, - testOnlyIfLhEnabled s "DELETE /teams/{tid}/legalhold/{uid}" testDisableLegalHoldForUser, - -- legal hold settings + [ -- legal hold settings testOnlyIfLhEnabled s "POST /teams/{tid}/legalhold/settings" testCreateLegalHoldTeamSettings, 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, -- behavior of existing end-points testOnlyIfLhEnabled s "POST /clients" testCannotCreateLegalHoldDeviceOldAPI, @@ -102,244 +88,6 @@ tests s = testOnlyIfLhEnabled s "User can fetch prekeys of LH users if consent is given and user has only new clients" (testClaimKeys TCKConsentAndNewClients) ] -testRequestLegalHoldDevice :: TestM () -testRequestLegalHoldDevice = do - (owner, tid) <- createBindingTeam - member <- randomUser - addTeamMemberInternal tid member (rolePermissions RoleMember) Nothing - -- Can't request a device if team feature flag is disabled - requestLegalHoldDevice owner member tid !!! testResponse 403 (Just "legalhold-not-enabled") - cannon <- view tsCannon - -- Assert that the appropriate LegalHold Request notification is sent to the user's - -- clients - WS.bracketR2 cannon member member $ \(ws, ws') -> withDummyTestServiceForTeam' owner tid $ \_ _chan -> do - do - -- test device creation without consent - requestLegalHoldDevice member member tid !!! testResponse 403 (Just "operation-denied") - UserLegalHoldStatusResponse userStatus _ _ <- getUserStatusTyped member tid - liftIO $ - assertEqual - "User with insufficient permissions should be unable to start flow" - UserLegalHoldNoConsent - userStatus - - do - requestLegalHoldDevice owner member tid !!! testResponse 409 (Just "legalhold-no-consent") - UserLegalHoldStatusResponse userStatus _ _ <- getUserStatusTyped member tid - liftIO $ - assertEqual - "User with insufficient permissions should be unable to start flow" - UserLegalHoldNoConsent - userStatus - - do - -- test granting consent - lhs <- view legalHoldStatus <$> getTeamMember member tid member - liftIO $ assertEqual "" lhs UserLegalHoldNoConsent - - grantConsent tid member - lhs' <- view legalHoldStatus <$> getTeamMember member tid member - liftIO $ assertEqual "" lhs' UserLegalHoldDisabled - - grantConsent tid member - lhs'' <- view legalHoldStatus <$> getTeamMember member tid member - liftIO $ assertEqual "" lhs'' UserLegalHoldDisabled - - do - requestLegalHoldDevice member member tid !!! testResponse 403 (Just "operation-denied") - UserLegalHoldStatusResponse userStatus _ _ <- getUserStatusTyped member tid - liftIO $ - assertEqual - "User with insufficient permissions should be unable to start flow" - UserLegalHoldDisabled - userStatus - - do - requestLegalHoldDevice owner member tid !!! testResponse 201 Nothing - UserLegalHoldStatusResponse userStatus _ _ <- getUserStatusTyped member tid - liftIO $ - assertEqual - "requestLegalHoldDevice should set user status to Pending" - UserLegalHoldPending - userStatus - do - requestLegalHoldDevice owner member tid !!! testResponse 204 Nothing - UserLegalHoldStatusResponse userStatus _ _ <- getUserStatusTyped member tid - liftIO $ - assertEqual - "requestLegalHoldDevice when already pending should leave status as Pending" - UserLegalHoldPending - userStatus - - cassState <- view tsCass - liftIO $ do - storedPrekeys <- Cql.runClient cassState (LegalHoldData.selectPendingPrekeys member) - assertBool "user should have pending prekeys stored" (not . null $ storedPrekeys) - let pluck = \case - (Ev.LegalHoldClientRequested rdata) -> do - Ev.lhcTargetUser rdata @?= member - Ev.lhcLastPrekey rdata @?= head someLastPrekeys - Ev.lhcClientId rdata @?= someClientId - _ -> assertBool "Unexpected event" False - assertNotification ws pluck - -- all devices get notified. - assertNotification ws' pluck - -testApproveLegalHoldDevice :: TestM () -testApproveLegalHoldDevice = do - (owner, tid) <- createBindingTeam - member <- do - usr <- randomUser - addTeamMemberInternal tid usr (rolePermissions RoleMember) Nothing - pure usr - member2 <- do - usr <- randomUser - addTeamMemberInternal tid usr (rolePermissions RoleMember) Nothing - pure usr - outsideContact <- do - usr <- randomUser - connectUsers member (List1.singleton usr) - pure usr - stranger <- randomUser - grantConsent tid owner - grantConsent tid member - grantConsent tid member2 - -- not allowed to approve if team setting is disabled - approveLegalHoldDevice (Just defPassword) owner member tid - !!! testResponse 403 (Just "legalhold-not-enabled") - cannon <- view tsCannon - WS.bracketRN cannon [owner, member, member, member2, outsideContact, stranger] $ - \[ows, mws, mws', member2Ws, outsideContactWs, strangerWs] -> withDummyTestServiceForTeam' owner tid $ \_ chan -> do - requestLegalHoldDevice owner member tid !!! testResponse 201 Nothing - liftIO . assertMatchJSON chan $ \(RequestNewLegalHoldClientV0 userId' teamId') -> do - assertEqual "userId == member" userId' member - assertEqual "teamId == tid" teamId' tid - -- Only the user themself can approve adding a LH device - approveLegalHoldDevice (Just defPassword) owner member tid !!! testResponse 403 (Just "access-denied") - -- Requires password - approveLegalHoldDevice Nothing member member tid !!! const 403 === statusCode - approveLegalHoldDevice (Just defPassword) member member tid !!! testResponse 200 Nothing - -- checks if the cookie we give to the legalhold service is actually valid - assertMatchJSON chan $ \(LegalHoldServiceConfirm _clientId _uid _tid authToken) -> - renewToken authToken - cassState <- view tsCass - liftIO $ do - clients' <- Cql.runClient cassState $ lookupClients [member] - assertBool "Expect clientId to be saved on the user" $ - Clients.contains member someClientId clients' - UserLegalHoldStatusResponse userStatus _ _ <- getUserStatusTyped member tid - liftIO $ - assertEqual - "After approval user legalhold status should be Enabled" - UserLegalHoldEnabled - userStatus - let pluck = \case - Ev.ClientAdded eClient -> do - eClient.clientId @?= someClientId - clientType eClient @?= LegalHoldClientType - clientClass eClient @?= Just LegalHoldClient - _ -> assertBool "Unexpected event" False - assertNotification mws pluck - assertNotification mws' pluck - -- Other team users should get a user.legalhold-enable event - let pluck' = \case - Ev.UserLegalHoldEnabled eUser -> eUser @?= member - _ -> assertBool "Unexpected event" False - assertNotification ows pluck' - -- We send to all members of a team. which includes the team-settings - assertNotification member2Ws pluck' - when False $ do - -- this doesn't work any more since consent (personal users cannot grant consent). - assertNotification outsideContactWs pluck' - assertNoNotification strangerWs - -testGetLegalHoldDeviceStatus :: TestM () -testGetLegalHoldDeviceStatus = do - (owner, tid) <- createBindingTeam - member <- randomUser - addTeamMemberInternal tid member (rolePermissions RoleMember) Nothing - forM_ [owner, member] $ \uid -> do - status <- getUserStatusTyped uid tid - liftIO $ - assertEqual - "unexpected status" - (UserLegalHoldStatusResponse UserLegalHoldNoConsent Nothing Nothing) - status - withDummyTestServiceForTeam' owner tid $ \_ _chan -> do - grantConsent tid member - do - UserLegalHoldStatusResponse userStatus lastPrekey' clientId' <- getUserStatusTyped member tid - liftIO $ - do - assertEqual "User legal hold status should start as disabled" UserLegalHoldDisabled userStatus - assertEqual "last_prekey should be Nothing when LH is disabled" Nothing lastPrekey' - assertEqual "client.id should be Nothing when LH is disabled" Nothing clientId' - do - requestLegalHoldDevice owner member tid !!! testResponse 201 Nothing - assertZeroLegalHoldDevices member - UserLegalHoldStatusResponse userStatus lastPrekey' clientId' <- getUserStatusTyped member tid - liftIO $ - do - assertEqual "requestLegalHoldDevice should set user status to Pending" UserLegalHoldPending userStatus - assertEqual "last_prekey should be set when LH is pending" (Just (head someLastPrekeys)) lastPrekey' - assertEqual "client.id should be set when LH is pending" (Just someClientId) clientId' - do - requestLegalHoldDevice owner member tid !!! testResponse 204 Nothing - UserLegalHoldStatusResponse userStatus _ _ <- getUserStatusTyped member tid - liftIO $ - assertEqual - "requestLegalHoldDevice when already pending should leave status as Pending" - UserLegalHoldPending - userStatus - do - approveLegalHoldDevice (Just defPassword) member member tid !!! testResponse 200 Nothing - UserLegalHoldStatusResponse userStatus lastPrekey' clientId' <- getUserStatusTyped member tid - liftIO $ - do - assertEqual "approving should change status to Enabled" UserLegalHoldEnabled userStatus - assertEqual "last_prekey should be set when LH is pending" (Just (head someLastPrekeys)) lastPrekey' - assertEqual "client.id should be set when LH is pending" (Just someClientId) clientId' - assertExactlyOneLegalHoldDevice member - requestLegalHoldDevice owner member tid !!! testResponse 409 (Just "legalhold-already-enabled") - -testDisableLegalHoldForUser :: TestM () -testDisableLegalHoldForUser = do - (owner, tid) <- createBindingTeam - member <- randomUser - addTeamMemberInternal tid member (rolePermissions RoleMember) Nothing - cannon <- view tsCannon - WS.bracketR2 cannon owner member $ \(ows, mws) -> withDummyTestServiceForTeam' owner tid $ \_ chan -> do - grantConsent tid member - requestLegalHoldDevice owner member tid !!! testResponse 201 Nothing - approveLegalHoldDevice (Just defPassword) member member tid !!! testResponse 200 Nothing - assertNotification mws $ \case - Ev.ClientAdded client -> do - client.clientId @?= someClientId - clientType client @?= LegalHoldClientType - clientClass client @?= Just LegalHoldClient - _ -> assertBool "Unexpected event" False - -- Only the admin can disable legal hold - disableLegalHoldForUser (Just defPassword) tid member member !!! testResponse 403 (Just "operation-denied") - assertExactlyOneLegalHoldDevice member - -- Require password to disable for usern - disableLegalHoldForUser Nothing tid owner member !!! const 403 === statusCode - assertExactlyOneLegalHoldDevice member - disableLegalHoldForUser (Just defPassword) tid owner member !!! testResponse 200 Nothing - liftIO . assertMatchChan chan $ \(req, _) -> do - assertEqual "method" "POST" (requestMethod req) - assertEqual "path" (pathInfo req) ["legalhold", "remove"] - assertNotification mws $ \case - Ev.ClientEvent (Ev.ClientRemoved clientId') -> clientId' @?= someClientId - _ -> assertBool "Unexpected event" False - assertNotification mws $ \case - Ev.UserEvent (Ev.UserLegalHoldDisabled uid) -> uid @?= member - _ -> assertBool "Unexpected event" False - -- Other users should also get the event - assertNotification ows $ \case - Ev.UserLegalHoldDisabled uid -> uid @?= member - _ -> assertBool "Unexpected event" False - assertZeroLegalHoldDevices member - data IsWorking = Working | NotWorking deriving (Eq, Show) @@ -450,39 +198,6 @@ testRemoveLegalHoldFromTeam = do userStatus assertZeroLegalHoldDevices member -testEnablePerTeam :: TestM () -testEnablePerTeam = do - (owner, tid) <- createBindingTeam - member <- randomUser - addTeamMemberInternal tid member (rolePermissions RoleMember) Nothing - do - feat :: Public.Feature Public.LegalholdConfig <- responseJsonUnsafe <$> (getEnabled tid (getEnabled tid do - grantConsent tid member - requestLegalHoldDevice owner member tid !!! const 201 === statusCode - approveLegalHoldDevice (Just defPassword) member member tid !!! testResponse 200 Nothing - do - UserLegalHoldStatusResponse status _ _ <- getUserStatusTyped member tid - liftIO $ assertEqual "User legal hold status should be enabled" UserLegalHoldEnabled status - do - putEnabled tid Public.FeatureStatusDisabled -- disable again - feat :: Public.Feature Public.LegalholdConfig <- responseJsonUnsafe <$> (getEnabled tid