diff --git a/changelog.d/5-internal/wpb8628-clean-up-syntax-of-tests-from-bsi-audit b/changelog.d/5-internal/wpb8628-clean-up-syntax-of-tests-from-bsi-audit new file mode 100644 index 00000000000..63c5cb9df02 --- /dev/null +++ b/changelog.d/5-internal/wpb8628-clean-up-syntax-of-tests-from-bsi-audit @@ -0,0 +1 @@ +Clean up syntax of test cases that occur in BSI audit. \ No newline at end of file diff --git a/integration/test/Test/AccessUpdate.hs b/integration/test/Test/AccessUpdate.hs index 0152c6e63e6..1d9ad94ad23 100644 --- a/integration/test/Test/AccessUpdate.hs +++ b/integration/test/Test/AccessUpdate.hs @@ -38,7 +38,6 @@ testBaz :: HasCallStack => App () testBaz = pure () -} --- | @SF.Federation @SF.Separation @TSFI.RESTfulAPI @S2 -- -- The test asserts that, among others, remote users are removed from a -- conversation when an access update occurs that disallows guests from @@ -74,8 +73,6 @@ testAccessUpdateGuestRemoved = do res.status `shouldMatchInt` 200 res.json %. "members.others.0.qualified_id" `shouldMatch` objQidObject bob --- @END - testAccessUpdateGuestRemovedUnreachableRemotes :: HasCallStack => App () testAccessUpdateGuestRemovedUnreachableRemotes = do resourcePool <- asks resourcePool diff --git a/integration/test/Test/Login.hs b/integration/test/Test/Login.hs index 1617e8b3a0f..b16f5ec3074 100644 --- a/integration/test/Test/Login.hs +++ b/integration/test/Test/Login.hs @@ -23,7 +23,6 @@ testLoginVerify6DigitEmailCodeSuccess = do bindResponse (loginWith2ndFactor owner email defPassword code) $ \resp -> do resp.status `shouldMatchInt` 200 --- @SF.Channel @TSFI.RESTfulAPI @S2 -- -- Test that login fails with wrong second factor email verification code testLoginVerify6DigitWrongCodeFails :: HasCallStack => App () @@ -39,9 +38,6 @@ testLoginVerify6DigitWrongCodeFails = do resp.status `shouldMatchInt` 403 resp.json %. "label" `shouldMatch` "code-authentication-failed" --- @END - --- @SF.Channel @TSFI.RESTfulAPI @S2 -- -- Test that login without verification code fails if SndFactorPasswordChallenge feature is enabled in team testLoginVerify6DigitMissingCodeFails :: HasCallStack => App () @@ -54,9 +50,6 @@ testLoginVerify6DigitMissingCodeFails = do resp.status `shouldMatchInt` 403 resp.json %. "label" `shouldMatch` "code-authentication-required" --- @END - --- @SF.Channel @TSFI.RESTfulAPI @S2 -- -- Test that login fails with expired second factor email verification code testLoginVerify6DigitExpiredCodeFails :: HasCallStack => App () @@ -80,8 +73,6 @@ testLoginVerify6DigitExpiredCodeFails = do resp.status `shouldMatchInt` 403 resp.json %. "label" `shouldMatch` "code-authentication-failed" --- @END - testLoginVerify6DigitResendCodeSuccessAndRateLimiting :: HasCallStack => App () testLoginVerify6DigitResendCodeSuccessAndRateLimiting = do (owner, team, []) <- createTeam OwnDomain 0 diff --git a/libs/zauth/test/ZAuth.hs b/libs/zauth/test/ZAuth.hs index 80545f884ae..db94845d04c 100644 --- a/libs/zauth/test/ZAuth.hs +++ b/libs/zauth/test/ZAuth.hs @@ -56,7 +56,7 @@ tests = do ], testGroup "Signing and Verifying" - [ testCase "expired" (runCreate z 1 $ testExpired v), + [ testCase "testExpired - expired" (runCreate z 1 $ testExpired v), testCase "not expired" (runCreate z 2 $ testNotExpired v), testCase "signed access-token is valid" (runCreate z 3 $ testSignAndVerify v) ], @@ -94,7 +94,6 @@ testNotExpired p = do liftIO $ assertBool "testNotExpired: validation failed" (isRight x) -- The testExpired test conforms to the following testing standards: --- @SF.Channel @TSFI.RESTfulAPI @TSFI.NTP @S2 @S3 -- -- Using an expired access token should fail testExpired :: V.Env -> Create () @@ -105,8 +104,6 @@ testExpired p = do x <- liftIO $ runValidate p $ check t liftIO $ Left Expired @=? x --- @END - testSignAndVerify :: V.Env -> Create () testSignAndVerify p = do u <- liftIO nextRandom diff --git a/services/brig/test/integration/API/User/Account.hs b/services/brig/test/integration/API/User/Account.hs index 1ea564fcbb5..494ffecdc6e 100644 --- a/services/brig/test/integration/API/User/Account.hs +++ b/services/brig/test/integration/API/User/Account.hs @@ -102,17 +102,17 @@ tests _ at opts p b c ch g aws userJournalWatcher = testGroup "account" [ test p "post /register - 201 (with preverified)" $ testCreateUserWithPreverified opts b userJournalWatcher, - test p "post /register - 400 (with preverified)" $ testCreateUserWithInvalidVerificationCode b, + test p "testCreateUserWithInvalidVerificationCode - post /register - 400 (with preverified)" $ testCreateUserWithInvalidVerificationCode b, test p "post /register - 201" $ testCreateUser b g, test p "post /register - 201 + no email" $ testCreateUserNoEmailNoPassword b, test p "post /register - 201 anonymous" $ testCreateUserAnon b g, - test p "post /register - 400 empty name" $ testCreateUserEmptyName b, - test p "post /register - 400 name too long" $ testCreateUserLongName b, + test p "testCreateUserEmptyName - post /register - 400 empty name" $ testCreateUserEmptyName b, + test p "testCreateUserLongName - post /register - 400 name too long" $ testCreateUserLongName b, test p "post /register - 201 anonymous expiry" $ testCreateUserAnonExpiry b, test p "post /register - 201 pending" $ testCreateUserPending opts b, test p "post /register - 201 existing activation" $ testCreateAccountPendingActivationKey opts b, - test p "post /register - 409 conflict" $ testCreateUserConflict opts b, - test p "post /register - 400 invalid input" $ testCreateUserInvalidEmailOrPhone opts b, + test p "testCreateUserConflict - post /register - 409 conflict" $ testCreateUserConflict opts b, + test p "testCreateUserInvalidEmailOrPhone - post /register - 400 invalid input" $ testCreateUserInvalidEmailOrPhone opts b, test p "post /register - 403 blacklist" $ testCreateUserBlacklist opts b aws, test p "post /register - 400 external-SSO" $ testCreateUserExternalSSO b, test p "post /register - 403 restricted user creation" $ testRestrictedUserCreation opts b, @@ -172,7 +172,6 @@ tests _ at opts p b c ch g aws userJournalWatcher = ] -- The testCreateUserWithInvalidVerificationCode test conforms to the following testing standards: --- @SF.Provisioning @TSFI.RESTfulAPI @S2 -- -- Registering with an invalid verification code and valid account details should fail. testCreateUserWithInvalidVerificationCode :: Brig -> Http () @@ -197,8 +196,6 @@ testCreateUserWithInvalidVerificationCode brig = do ] postUserRegister' regEmail brig !!! const 404 === statusCode --- @END - testUpdateUserEmailByTeamOwner :: Opt.Opts -> Brig -> Http () testUpdateUserEmailByTeamOwner opts brig = do (_, teamOwner, emailOwner : otherTeamMember : _) <- createPopulatedBindingTeamWithNamesAndHandles brig 2 @@ -336,7 +333,6 @@ assertOnlySelfConversations galley uid = do liftIO $ cnvType conv @?= SelfConv -- The testCreateUserEmptyName test conforms to the following testing standards: --- @SF.Provisioning @TSFI.RESTfulAPI @S2 -- -- An empty name is not allowed on registration testCreateUserEmptyName :: Brig -> Http () @@ -348,10 +344,7 @@ testCreateUserEmptyName brig = do post (brig . path "/register" . contentJson . body p) !!! const 400 === statusCode --- @END - -- The testCreateUserLongName test conforms to the following testing standards: --- @SF.Provisioning @TSFI.RESTfulAPI @S2 -- -- a name with > 128 characters is not allowed. testCreateUserLongName :: Brig -> Http () @@ -364,8 +357,6 @@ testCreateUserLongName brig = do post (brig . path "/register" . contentJson . body p) !!! const 400 === statusCode --- @END - testCreateUserAnon :: Brig -> Galley -> Http () testCreateUserAnon brig galley = do let p = @@ -443,7 +434,6 @@ testCreateUserNoEmailNoPassword brig = do !!! (const 202 === statusCode) -- The testCreateUserConflict test conforms to the following testing standards: --- @SF.Provisioning @TSFI.RESTfulAPI @S2 -- -- email address must not be taken on @/register@. testCreateUserConflict :: Opt.Opts -> Brig -> Http () @@ -475,10 +465,7 @@ testCreateUserConflict _ brig = do const 409 === statusCode const (Just "key-exists") === fmap Error.label . responseJsonMaybe --- @END - -- The testCreateUserInvalidEmailOrPhone test conforms to the following testing standards: --- @SF.Provisioning @TSFI.RESTfulAPI @S2 -- -- Test to make sure a new user cannot be created with an invalid email address or invalid phone number. testCreateUserInvalidEmailOrPhone :: Opt.Opts -> Brig -> Http () @@ -508,8 +495,6 @@ testCreateUserInvalidEmailOrPhone _ brig = do post (brig . path "/register" . contentJson . body reqPhone) !!! const 400 === statusCode --- @END - testCreateUserBlacklist :: Opt.Opts -> Brig -> AWS.Env -> Http () testCreateUserBlacklist (Opt.setRestrictUserCreation . Opt.optSettings -> Just True) _ _ = pure () testCreateUserBlacklist _ brig aws = @@ -893,7 +878,7 @@ testCreateUserAnonExpiry b = do let diff = diffUTCTime a now minExp = 1 :: Integer -- 1 second maxExp = 60 * 60 * 24 * 10 :: Integer -- 10 days - liftIO $ assertBool "expiry must in be the future" (diff >= fromIntegral minExp) + liftIO $ assertBool "expiry must be in the future" (diff >= fromIntegral minExp) liftIO $ assertBool "expiry must be less than 10 days" (diff < fromIntegral maxExp) expire :: ResponseLBS -> Maybe UTCTime expire r = field "expires_at" =<< responseJsonMaybe r diff --git a/services/brig/test/integration/API/User/Auth.hs b/services/brig/test/integration/API/User/Auth.hs index a52cd738b41..8a23e8cbb27 100644 --- a/services/brig/test/integration/API/User/Auth.hs +++ b/services/brig/test/integration/API/User/Auth.hs @@ -100,9 +100,9 @@ tests conf m z db b g n = test m "handle" (testHandleLogin b), test m "email-untrusted-domain" (testLoginUntrustedDomain b), test m "send-phone-code" (testSendLoginCode b), - test m "failure" (testLoginFailure b), + test m "testLoginFailure - failure" (testLoginFailure b), test m "throttle" (testThrottleLogins conf b), - test m "limit-retry" (testLimitRetries conf b), + test m "testLimitRetries - limit-retry" (testLimitRetries conf b), test m "login with 6 character password" (testLoginWith6CharPassword b db), testGroup "sso-login" @@ -129,8 +129,8 @@ tests conf m z db b g n = ], testGroup "refresh /access" - [ test m "invalid-cookie" (testInvalidCookie @ZAuth.User z b), - test m "invalid-cookie legalhold" (testInvalidCookie @ZAuth.LegalHoldUser z b), + [ test m "testInvalidCookie - invalid-cookie" (testInvalidCookie @ZAuth.User z b), + test m "testInvalidCookie - invalid-cookie legalhold" (testInvalidCookie @ZAuth.LegalHoldUser z b), test m "invalid-token" (testInvalidToken z b), test m "missing-cookie" (testMissingCookie @ZAuth.User @ZAuth.Access z b), test m "missing-cookie legalhold" (testMissingCookie @ZAuth.LegalHoldUser @ZAuth.LegalHoldAccess z b), @@ -161,7 +161,7 @@ tests conf m z db b g n = [ test m "list" (testListCookies b), test m "remove-by-label" (testRemoveCookiesByLabel b), test m "remove-by-label-id" (testRemoveCookiesByLabelAndId b), - test m "limit" (testTooManyCookies conf b), + test m "testTooManyCookies - limit" (testTooManyCookies conf b), test m "logout" (testLogout b) ], testGroup @@ -423,7 +423,6 @@ testSendLoginCode brig = do liftIO $ assertEqual "timeout" (Just (Code.Timeout 600)) _timeout -- The testLoginFailure test conforms to the following testing standards: --- @SF.Provisioning @TSFI.RESTfulAPI @S2 -- -- Test that trying to log in with a wrong password or non-existent email fails. testLoginFailure :: Brig -> Http () @@ -446,8 +445,6 @@ testLoginFailure brig = do PersistentCookie !!! const 403 === statusCode --- @END - testThrottleLogins :: Opts.Opts -> Brig -> Http () testThrottleLogins conf b = do -- Get the maximum amount of times we are allowed to login before @@ -473,7 +470,6 @@ testThrottleLogins conf b = do login b (defEmailLogin e) SessionCookie !!! const 200 === statusCode -- The testLimitRetries test conforms to the following testing standards: --- @SF.Channel @TSFI.RESTfulAPI @TSFI.NTP @S2 -- -- The following test tests the login retries. It checks that a user can make -- only a prespecified number of attempts to log in with an invalid password, @@ -528,8 +524,6 @@ testLimitRetries conf brig = do liftIO $ threadDelay (1000000 * 2) login brig (defEmailLogin email) SessionCookie !!! const 200 === statusCode --- @END - ------------------------------------------------------------------------------- -- LegalHold Login @@ -656,7 +650,6 @@ testNoUserSsoLogin brig = do -- Token Refresh -- The testInvalidCookie test conforms to the following testing standards: --- @SF.Provisioning @TSFI.RESTfulAPI @TSFI.NTP @S2 -- -- Test that invalid and expired tokens do not work. testInvalidCookie :: forall u. ZAuth.UserTokenLike u => ZAuth.Env -> Brig -> Http () @@ -674,8 +667,6 @@ testInvalidCookie z b = do const 403 === statusCode const (Just "expired") =~= responseBody --- @END - testInvalidToken :: ZAuth.Env -> Brig -> Http () testInvalidToken z b = do user <- Public.userId <$> randomUser b @@ -1188,7 +1179,6 @@ testRemoveCookiesByLabelAndId b = do listCookies b (userId u) >>= liftIO . ([lbl] @=?) . map cookieLabel -- The testTooManyCookies test conforms to the following testing standards: --- @SF.Provisioning @TSFI.RESTfulAPI @S2 -- -- The test asserts that there is an upper limit for the number of user cookies -- per cookie type. It does that by concurrently attempting to create more @@ -1238,8 +1228,6 @@ testTooManyCookies config b = do ) xxx -> error ("Unexpected status code when logging in: " ++ show xxx) --- @END - testLogout :: Brig -> Http () testLogout b = do Just email <- userEmail <$> randomUser b diff --git a/services/brig/test/integration/API/User/Client.hs b/services/brig/test/integration/API/User/Client.hs index 0fb44b9063f..b7bbd4c2cd1 100644 --- a/services/brig/test/integration/API/User/Client.hs +++ b/services/brig/test/integration/API/User/Client.hs @@ -108,27 +108,27 @@ tests _cl _at opts p db n b c g = testGroup "post /clients - verification code" [ test p "success" $ testAddGetClientVerificationCode db b g, - test p "missing code" $ testAddGetClientMissingCode b g, - test p "wrong code" $ testAddGetClientWrongCode b g, - test p "expired code" $ testAddGetClientCodeExpired db opts b g + test p "testAddGetClientMissingCode - missing code" $ testAddGetClientMissingCode b g, + test p "testAddGetClientWrongCode - wrong code" $ testAddGetClientWrongCode b g, + test p "testAddGetClientCodeExpired - expired code" $ testAddGetClientCodeExpired db opts b g ], test p "post /clients - 201 (with mls keys)" $ testAddGetClient def {addWithMLSKeys = True} b c, test p "post /clients - 403" $ testClientReauthentication b, 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, - test p "delete /clients/:client - 403 (incorrect pwd)" $ testRemoveClientIncorrectPwd b, + test p "testTooManyClients - post /clients - 400" $ testTooManyClients opts b, + test p "testPrekeysNotEmptyRandomPrekeys - client/prekeys not empty" $ testPrekeysNotEmptyRandomPrekeys opts b, + test p "testRegularPrekeysCannotBeSentAsLastPrekeys - lastprekeys not bogus" $ testRegularPrekeysCannotBeSentAsLastPrekeys b, + test p "testRegularPrekeysCannotBeSentAsLastPrekeysDuringUpdate - lastprekeys not bogus during update" $ testRegularPrekeysCannotBeSentAsLastPrekeysDuringUpdate b, + test p "testRemoveClient - delete /clients/:client - 200 (pwd)" $ testRemoveClient True b c, + test p "testRemoveClient - delete /clients/:client - 200 (no pwd)" $ testRemoveClient False b c, + test p "testRemoveClientShortPwd - delete /clients/:client - 400 (short pwd)" $ testRemoveClientShortPwd b, + test p "testRemoveClientIncorrectPwd - delete /clients/:client - 403 (incorrect pwd)" $ testRemoveClientIncorrectPwd b, test p "put /clients/:client - 200" $ testUpdateClient opts b, test p "put /clients/:client - 200 (mls keys)" $ testMLSPublicKeyUpdate b, test p "get /clients/:client - 404" $ testMissingClient b, test p "get /clients/:client - 200" $ testMLSClient b, - test p "post /clients - 200 multiple temporary" $ testAddMultipleTemporary b g c, + test p "testAddMultipleTemporary - post /clients - 200 multiple temporary" $ testAddMultipleTemporary b g c, test p "client/prekeys/race" $ testPreKeyRace b, test p "get/head nonce/clients" $ testNewNonce b, testGroup @@ -161,7 +161,6 @@ testAddGetClientVerificationCode db brig galley = do const 200 === statusCode const (Just c) === responseJsonMaybe --- @SF.Channel @TSFI.RESTfulAPI @S2 -- -- Test that device cannot be added with missing second factor email verification code when this feature is enabled testAddGetClientMissingCode :: Brig -> Galley -> Http () @@ -178,9 +177,6 @@ testAddGetClientMissingCode brig galley = do const 403 === statusCode const (Just "code-authentication-required") === fmap Error.label . responseJsonMaybe --- @END - --- @SF.Channel @TSFI.RESTfulAPI @S2 -- -- Test that device cannot be added with wrong second factor email verification code when this feature is enabled testAddGetClientWrongCode :: Brig -> Galley -> Http () @@ -198,9 +194,6 @@ testAddGetClientWrongCode brig galley = do const 403 === statusCode const (Just "code-authentication-failed") === fmap Error.label . responseJsonMaybe --- @END - --- @SF.Channel @TSFI.RESTfulAPI @S2 -- -- Test that device cannot be added with expired second factor email verification code when this feature is enabled testAddGetClientCodeExpired :: DB.ClientState -> Opt.Opts -> Brig -> Galley -> Http () @@ -225,8 +218,6 @@ testAddGetClientCodeExpired db opts brig galley = do const 403 === statusCode const (Just "code-authentication-failed") === fmap Error.label . responseJsonMaybe --- @END - data AddGetClient = AddGetClient { addWithPassword :: Bool, addWithMLSKeys :: Bool @@ -904,7 +895,6 @@ testMultiUserGetPrekeysQualifiedV4 brig opts = do const (Right $ expectedUserClientMap) === responseJsonEither -- The testTooManyClients test conforms to the following testing standards: --- @SF.Provisioning @TSFI.RESTfulAPI @S2 -- -- The test validates the upper bound on the number of permanent clients per -- user. It does so by trying to create one permanent client more than allowed. @@ -937,25 +927,25 @@ 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) 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) responseJsonMaybe rs3 - liftIO $ assertEqual "last prekey rs3" (Just lastPrekeyId) pId3 + ensurePrekeysNotEmpty newOpts + where + ensurePrekeysNotEmpty :: Opt.Opts -> Http () + ensurePrekeysNotEmpty newOpts = withSettingsOverrides newOpts $ 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) 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) responseJsonMaybe rs3 + liftIO $ assertEqual "last prekey rs3" (Just lastPrekeyId) pId3 testRegularPrekeysCannotBeSentAsLastPrekeys :: Brig -> Http () testRegularPrekeysCannotBeSentAsLastPrekeys brig = do @@ -985,10 +975,7 @@ testRegularPrekeysCannotBeSentAsLastPrekeysDuringUpdate brig = do !!! const 400 === statusCode --- @END - -- The testRemoveClient test conforms to the following testing standards: --- @SF.Provisioning @TSFI.RESTfulAPI @S2 -- -- This test validates creating and deleting a client. A client is created and -- consequently deleted. Deleting a second time yields response 404 not found. @@ -1034,10 +1021,7 @@ testRemoveClient hasPwd brig cannon = do newClientCookie = Just defCookieLabel } --- @END - -- The testRemoveClientShortPwd test conforms to the following testing standards: --- @SF.Provisioning @TSFI.RESTfulAPI @S2 -- -- The test checks if a client can be deleted by providing a too short password. -- This is done by using a single-character password, whereas the minimum is 6 @@ -1070,10 +1054,7 @@ testRemoveClientShortPwd brig = do newClientCookie = Just defCookieLabel } --- @END - -- The testRemoveClientIncorrectPwd test conforms to the following testing standards: --- @SF.Provisioning @TSFI.RESTfulAPI @S2 -- -- The test checks if a client can be deleted by providing a syntax-valid, but -- incorrect password. The client deletion attempt fails with a 403 error @@ -1106,8 +1087,6 @@ testRemoveClientIncorrectPwd brig = do newClientCookie = Just defCookieLabel } --- @END - testUpdateClient :: Opt.Opts -> Brig -> Http () testUpdateClient opts brig = do uid <- userId <$> randomUser brig @@ -1300,7 +1279,6 @@ testMissingClient brig = do . responseHeaders -- The testAddMultipleTemporary test conforms to the following testing standards: --- @SF.Provisioning @TSFI.RESTfulAPI @S2 -- Legacy (galley) -- -- Add temporary client, check that all services (both galley and @@ -1358,8 +1336,6 @@ testAddMultipleTemporary brig galley cannon = do . zUser u pure $ Vec.length <$> (preview _Array =<< responseJsonMaybe @Value r) --- @END - testPreKeyRace :: Brig -> Http () testPreKeyRace brig = do uid <- userId <$> randomUser brig diff --git a/services/brig/test/integration/API/User/Handles.hs b/services/brig/test/integration/API/User/Handles.hs index d8bb4ac98ce..88164a3e600 100644 --- a/services/brig/test/integration/API/User/Handles.hs +++ b/services/brig/test/integration/API/User/Handles.hs @@ -56,7 +56,7 @@ tests :: ConnectionLimit -> Opt.Timeout -> Opt.Opts -> Manager -> Brig -> Cannon tests _cl _at conf p b c g = testGroup "handles" - [ test p "handles/update" $ testHandleUpdate b c, + [ test p "testHandleUpdate - handles/update" $ testHandleUpdate b c, test p "handles/race" $ testHandleRace b, test p "handles/query" $ testHandleQuery conf b, test p "handles/query - team-search-visibility SearchVisibilityStandard" $ testHandleQuerySearchVisibilityStandard conf b, @@ -69,7 +69,6 @@ tests _cl _at conf p b c g = ] -- The next line contains a mapping from the testHandleUpdate test to the following test standards: --- @SF.Provisioning @TSFI.RESTfulAPI @S2 -- -- The test validates various updates to the user's handle. First, it attempts -- to set invalid handles. This fails. Then it successfully sets a valid handle. @@ -140,8 +139,6 @@ testHandleUpdate brig cannon = do put (brig . path "/self/handle" . contentJson . zUser uid2 . zConn "c" . body update) !!! const 200 === statusCode --- @END - testHandleRace :: Brig -> Http () testHandleRace brig = do us <- replicateM 10 (userId <$> randomUser brig) diff --git a/services/federator/test/integration/Test/Federator/IngressSpec.hs b/services/federator/test/integration/Test/Federator/IngressSpec.hs index 62b4f1b7401..f28fca1bdf1 100644 --- a/services/federator/test/integration/Test/Federator/IngressSpec.hs +++ b/services/federator/test/integration/Test/Federator/IngressSpec.hs @@ -73,45 +73,42 @@ spec env = do responseStatusCode resp `shouldBe` HTTP.status200 actualProfile `shouldBe` Just [expectedProfile] - -- @SF.Federation @TSFI.RESTfulAPI @S2 @S3 @S7 - -- - -- This test was primarily intended to test that federator is using the API right (header - -- name etc.), but it is also effectively testing that federator rejects clients without - -- certificates that have been validated by ingress. - -- - -- We can't test end-to-end here: the TLS termination happens in k8s, and would have to be - -- tested there (and with a good emulation of the concrete configuration of the prod - -- system). - it "rejectRequestsWithoutClientCertIngress" $ - runTestFederator env $ do - brig <- view teBrig <$> ask - user <- randomUser brig - hdl <- randomHandle - _ <- putHandle brig (userId user) hdl + it "testRejectRequestsWithoutClientCertIngress" (testRejectRequestsWithoutClientCertIngress env) - settings <- view teSettings - sslCtxWithoutCert <- - either (throwM @_ @FederationSetupError) pure - <=< runM - . runEmbedded (liftIO @(TestFederator IO)) - . runError - $ mkSSLContextWithoutCert settings - runTestSem $ do - r <- - runError @RemoteError $ - inwardBrigCallViaIngressWithSettings - sslCtxWithoutCert - "get-user-by-handle" - (Aeson.fromEncoding (Aeson.toEncoding hdl)) - liftToCodensity . embed $ case r of - Right _ -> expectationFailure "Expected client certificate error, got response" - Left (RemoteError {}) -> - expectationFailure "Expected client certificate error, got remote error" - Left (RemoteErrorResponse _ _ status _) -> status `shouldBe` HTTP.status400 +-- +-- This test was primarily intended to test that federator is using the API right (header +-- name etc.), but it is also effectively testing that federator rejects clients without +-- certificates that have been validated by ingress. +-- +-- We can't test end-to-end here: the TLS termination happens in k8s, and would have to be +-- tested there (and with a good emulation of the concrete configuration of the prod +-- system). +testRejectRequestsWithoutClientCertIngress :: TestEnv -> IO () +testRejectRequestsWithoutClientCertIngress env = runTestFederator env $ do + brig <- view teBrig <$> ask + user <- randomUser brig + hdl <- randomHandle + _ <- putHandle brig (userId user) hdl --- FUTUREWORK: ORMOLU_DISABLE --- @END --- ORMOLU_ENABLE + settings <- view teSettings + sslCtxWithoutCert <- + either (throwM @_ @FederationSetupError) pure + <=< runM + . runEmbedded (liftIO @(TestFederator IO)) + . runError + $ mkSSLContextWithoutCert settings + runTestSem $ do + r <- + runError @RemoteError $ + inwardBrigCallViaIngressWithSettings + sslCtxWithoutCert + "get-user-by-handle" + (Aeson.fromEncoding (Aeson.toEncoding hdl)) + liftToCodensity . embed $ case r of + Right _ -> expectationFailure "Expected client certificate error, got response" + Left (RemoteError {}) -> + expectationFailure "Expected client certificate error, got remote error" + Left (RemoteErrorResponse _ _ status _) -> status `shouldBe` HTTP.status400 liftToCodensity :: Member (Embed (Codensity IO)) r => Sem (Embed IO ': r) a -> Sem r a liftToCodensity = runEmbedded @IO @(Codensity IO) lift diff --git a/services/federator/test/integration/Test/Federator/InwardSpec.hs b/services/federator/test/integration/Test/Federator/InwardSpec.hs index 33cd7e89c92..85980f8948c 100644 --- a/services/federator/test/integration/Test/Federator/InwardSpec.hs +++ b/services/federator/test/integration/Test/Federator/InwardSpec.hs @@ -79,14 +79,7 @@ spec env = liftIO $ bdy `shouldBe` [expectedProfile] - -- @SF.Federation @TSFI.RESTfulAPI @S2 @S3 @S7 - -- - -- This test is covered by the unit tests 'validateDomainCertWrongDomain' because - -- the domain matching is checked on certificate validation. - it "shouldRejectMissmatchingOriginDomainInward" $ - runTestFederator env $ - pure () - -- @END + it "testShouldRejectMissmatchingOriginDomainInward" (testShouldRejectMissmatchingOriginDomainInward env) it "should be able to call cargohold" $ runTestFederator env $ do @@ -117,23 +110,24 @@ spec env = inwardCall "/i/users" (encode o) !!! const 404 === statusCode - -- @SF.Federation @TSFI.RESTfulAPI @S2 @S3 @S7 - -- - -- See related tests in unit tests (for matching client certificates against domain names) - -- and "IngressSpec". - it "rejectRequestsWithoutClientCertInward" $ - runTestFederator env $ do - originDomain <- originDomain <$> view teTstOpts - hdl <- randomHandle - inwardCallWithHeaders - "federation/brig/get-user-by-handle" - [(originDomainHeaderName, toByteString' originDomain)] - (encode hdl) - !!! const 400 === statusCode - --- TODO: ORMOLU_DISABLE --- @END --- ORMOLU_ENABLE + it "testRejectRequestsWithoutClientCertInward" (testRejectRequestsWithoutClientCertInward env) + +-- This test is covered by the unit tests 'validateDomainCertWrongDomain' because +-- the domain matching is checked on certificate validation. +testShouldRejectMissmatchingOriginDomainInward :: TestEnv -> IO () +testShouldRejectMissmatchingOriginDomainInward env = runTestFederator env $ pure () + +-- See related tests in unit tests (for matching client certificates against domain names) +-- and "IngressSpec". +testRejectRequestsWithoutClientCertInward :: TestEnv -> IO () +testRejectRequestsWithoutClientCertInward env = runTestFederator env $ do + originDomain <- originDomain <$> view teTstOpts + hdl <- randomHandle + inwardCallWithHeaders + "federation/brig/get-user-by-handle" + [(originDomainHeaderName, toByteString' originDomain)] + (encode hdl) + !!! const 400 === statusCode inwardCallWithHeaders :: (MonadIO m, MonadHttp m, MonadReader TestEnv m, HasCallStack) => diff --git a/services/federator/test/unit/Test/Federator/ExternalServer.hs b/services/federator/test/unit/Test/Federator/ExternalServer.hs index ec0b0438e24..7e499e3bc56 100644 --- a/services/federator/test/unit/Test/Federator/ExternalServer.hs +++ b/services/federator/test/unit/Test/Federator/ExternalServer.hs @@ -247,11 +247,9 @@ requestNoCertificate = assertEqual "no calls to any service should be made" [] serviceCalls pure Wai.ResponseReceived --- @SF.Federation @TSFI.Federate @TSFI.DNS @S2 @S3 @S7 --- Reject request if the client certificate for federator is invalid requestInvalidCertificate :: TestTree requestInvalidCertificate = - testCase "should fail with a 404 when an invalid certificate is given" $ do + testCase "testRequestInvalidCertificate - should fail with a 404 when an invalid certificate is given" $ do request <- testRequest def @@ -267,8 +265,6 @@ requestInvalidCertificate = assertEqual "no calls to any service should be made" [] serviceCalls pure Wai.ResponseReceived --- @END - testInvalidPaths :: TestTree testInvalidPaths = do let invalidPaths = diff --git a/services/federator/test/unit/Test/Federator/InternalServer.hs b/services/federator/test/unit/Test/Federator/InternalServer.hs index 3fb41d2d869..86f9f7e93e7 100644 --- a/services/federator/test/unit/Test/Federator/InternalServer.hs +++ b/services/federator/test/unit/Test/Federator/InternalServer.hs @@ -107,12 +107,11 @@ federatedRequestSuccess = body <- Wai.lazyResponseBody res body @?= "\"bar\"" --- @SF.Federation @TSFI.Federate @TSFI.DNS @S2 @S3 @S7 -- -- Refuse to send outgoing request to non-included domain when AllowDynamic is configured. federatedRequestFailureAllowList :: TestTree federatedRequestFailureAllowList = - testCase "should not make a call when target domain not in the allow list" $ do + testCase "federatedRequestFailureAllowList - should not make a call when target domain not in the allow list" $ do let settings = noClientCertSettings let targetDomain = Domain "target.example.com" headers = [(originDomainHeaderName, "origin.example.com")] @@ -150,5 +149,3 @@ federatedRequestFailureAllowList = . interpretMetricsEmpty $ callOutward Nothing targetDomain Brig (RPC "get-user-by-handle") request eith @?= Left (FederationDenied targetDomain) - --- @END diff --git a/services/federator/test/unit/Test/Federator/Options.hs b/services/federator/test/unit/Test/Federator/Options.hs index 1530489e0f5..bece8365ab0 100644 --- a/services/federator/test/unit/Test/Federator/Options.hs +++ b/services/federator/test/unit/Test/Federator/Options.hs @@ -139,29 +139,7 @@ testSettings = <> show e Right _ -> assertFailure "expected failure for non-existing client certificate, got success", - -- @SF.Federation @TSFI.Federate @S3 @S7 - testCase "failToStartWithInvalidServerCredentials" $ do - let settings = - defRunSettings - "test/resources/unit/invalid.pem" - "test/resources/unit/localhost-key.pem" - assertParsesAs settings . B8.pack $ - [QQ.i| - useSystemCAStore: true - tcpConnectionTimeout: 1000 - federationStrategy: - allowAll: null - clientCertificate: test/resources/unit/invalid.pem - clientPrivateKey: test/resources/unit/localhost-key.pem|] - try @FederationSetupError (mkTLSSettingsOrThrow settings) >>= \case - Left (InvalidClientCertificate _) -> pure () - Left e -> - assertFailure $ - "expected invalid client certificate exception, got: " - <> show e - Right _ -> - assertFailure "expected failure for invalid client certificate, got success", - -- @END + testCase "failToStartWithInvalidServerCredentials" failToStartWithInvalidServerCredentials, testCase "fail on invalid private key" $ do let settings = defRunSettings @@ -185,6 +163,29 @@ testSettings = assertFailure "expected failure for invalid private key, got success" ] +failToStartWithInvalidServerCredentials :: IO () +failToStartWithInvalidServerCredentials = do + let settings = + defRunSettings + "test/resources/unit/invalid.pem" + "test/resources/unit/localhost-key.pem" + assertParsesAs settings . B8.pack $ + [QQ.i| + useSystemCAStore: true + tcpConnectionTimeout: 1000 + federationStrategy: + allowAll: null + clientCertificate: test/resources/unit/invalid.pem + clientPrivateKey: test/resources/unit/localhost-key.pem|] + try @FederationSetupError (mkTLSSettingsOrThrow settings) >>= \case + Left (InvalidClientCertificate _) -> pure () + Left e -> + assertFailure $ + "expected invalid client certificate exception, got: " + <> show e + Right _ -> + assertFailure "expected failure for invalid client certificate, got success" + assertParsesAs :: (HasCallStack, Eq a, FromJSON a, Show a) => a -> ByteString -> Assertion assertParsesAs v bs = assertEqual "YAML parsing" (Right v) $ diff --git a/services/federator/test/unit/Test/Federator/Remote.hs b/services/federator/test/unit/Test/Federator/Remote.hs index 43be50b23d1..8d8de9f0660 100644 --- a/services/federator/test/unit/Test/Federator/Remote.hs +++ b/services/federator/test/unit/Test/Federator/Remote.hs @@ -129,7 +129,6 @@ testValidatesCertificateSuccess = Right _ -> assertFailure "Congratulations, you fixed a known issue!" ] --- @SF.Federation @TSFI.Federate @TSFI.DNS @S2 -- -- This is a group of test cases where refusing to connect with the server is -- checked. The second test case refuses to connect with a server when the @@ -138,7 +137,7 @@ testValidatesCertificateSuccess = testValidatesCertificateWrongHostname :: TestTree testValidatesCertificateWrongHostname = testGroup - "refuses to connect with server" + "testValidatesCertificateWrongHostname - refuses to connect with server" [ testCase "when the server's certificate doesn't match the hostname" $ withMockServer certForWrongDomain $ \port -> do tlsSettings <- mkTLSSettingsOrThrow settings @@ -155,8 +154,6 @@ testValidatesCertificateWrongHostname = Right _ -> assertFailure "Expected connection with the server to fail" ] --- @END - testConnectionError :: TestTree testConnectionError = testCase "connection failures are reported correctly" $ do tlsSettings <- mkTLSSettingsOrThrow settings diff --git a/services/federator/test/unit/Test/Federator/Validation.hs b/services/federator/test/unit/Test/Federator/Validation.hs index 4086567271b..24879f15aae 100644 --- a/services/federator/test/unit/Test/Federator/Validation.hs +++ b/services/federator/test/unit/Test/Federator/Validation.hs @@ -115,12 +115,11 @@ federateWithAllowListFail = $ ensureCanFederateWith (Domain "hello.world") assertBool "federating should not be allowed" (isLeft eith) --- @SF.Federation @TSFI.Federate @TSFI.DNS @S2 @S3 @S7 -- -- Refuse to send outgoing request to non-included domain when AllowDynamic is configured. validateDomainAllowListFail :: TestTree validateDomainAllowListFail = - testCase "allow list validation" $ do + testCase "validateDomainAllowListFail - allow list validation" $ do Right exampleCert <- decodeCertificate <$> BS.readFile "test/resources/unit/localhost.example.com.pem" let settings = noClientCertSettings res <- @@ -133,8 +132,6 @@ validateDomainAllowListFail = $ validateDomain exampleCert (Domain "localhost.example.com") res @?= Left (FederationDenied (Domain "localhost.example.com")) --- @END - validateDomainAllowListSuccess :: TestTree validateDomainAllowListSuccess = testCase "should give parsed domain if in the allow list" $ do @@ -151,13 +148,12 @@ validateDomainAllowListSuccess = $ validateDomain exampleCert domain assertEqual "validateDomain should give 'localhost.example.com' as domain" domain res --- @SF.Federation @TSFI.Federate @TSFI.DNS @S3 @S7 -- -- Reject request if the infrastructure domain in the client cert does not match the backend -- domain in the `Wire-origin-domain` header. validateDomainCertWrongDomain :: TestTree validateDomainCertWrongDomain = - testCase "should fail if the client certificate has a wrong domain" $ do + testCase "validateDomainCertWrongDomain - should fail if the client certificate has a wrong domain" $ do Right exampleCert <- decodeCertificate <$> BS.readFile "test/resources/unit/localhost.example.com.pem" res <- runM @@ -169,8 +165,6 @@ validateDomainCertWrongDomain = $ validateDomain exampleCert (Domain "foo.example.com") res @?= Left (AuthenticationFailure (pure [X509.NameMismatch "foo.example.com"])) --- @END - validateDomainCertCN :: TestTree validateDomainCertCN = testCase "should succeed if the certificate has subject CN but no SAN" $ do @@ -253,12 +247,9 @@ validateDomainNonIdentitySRV = $ validateDomain exampleCert domain res @?= domain --- @SF.Federation @TSFI.Federate @TSFI.DNS @S2 @S3 @S7 -- Reject request if the client certificate for federator is invalid validateDomainCertInvalid :: TestTree validateDomainCertInvalid = - testCase "should fail if the client certificate is invalid" $ do + testCase "validateDomainCertInvalid - should fail if the client certificate is invalid" $ do let res = decodeCertificate "not a certificate" res @?= Left "no certificate found" - --- @END diff --git a/services/galley/test/integration/API.hs b/services/galley/test/integration/API.hs index fbf625a5138..b20fb577974 100644 --- a/services/galley/test/integration/API.hs +++ b/services/galley/test/integration/API.hs @@ -209,27 +209,27 @@ tests s = test s "conversation receipt mode update" putReceiptModeOk, test s "remote conversation receipt mode update" putRemoteReceiptModeOk, test s "leave connect conversation" leaveConnectConversation, - test s "post conversations/:cnv/otr/message: message delivery and missing clients" postCryptoMessageVerifyMsgSentAndRejectIfMissingClient, - test s "post conversations/:cnv/otr/message: mismatch and prekey fetching" postCryptoMessageVerifyRejectMissingClientAndRepondMissingPrekeysJson, - test s "post conversations/:cnv/otr/message: mismatch with protobuf" postCryptoMessageVerifyRejectMissingClientAndRepondMissingPrekeysProto, + test s "postCryptoMessageVerifyMsgSentAndRejectIfMissingClient - post conversations/:cnv/otr/message: message delivery and missing clients" postCryptoMessageVerifyMsgSentAndRejectIfMissingClient, + test s "postCryptoMessageVerifyRejectMissingClientAndRespondMissingPrekeysJson - post conversations/:cnv/otr/message: mismatch and prekey fetching" postCryptoMessageVerifyRejectMissingClientAndRespondMissingPrekeysJson, + test s "postCryptoMessageVerifyRejectMissingClientAndRespondMissingPrekeysProto - post conversations/:cnv/otr/message: mismatch with protobuf" postCryptoMessageVerifyRejectMissingClientAndRespondMissingPrekeysProto, test s "post conversations/:cnv/otr/message: unknown sender client" postCryptoMessageNotAuthorizeUnknownClient, - test s "post conversations/:cnv/otr/message: ignore_missing and report_missing" postCryptoMessageVerifyCorrectResponseIfIgnoreAndReportMissingQueryParam, - test s "post message qualified - local owning backend - missing clients" postMessageQualifiedLocalOwningBackendMissingClients, + test s "postCryptoMessageVerifyCorrectResponseIfIgnoreAndReportMissingQueryParam - post conversations/:cnv/otr/message: ignore_missing and report_missing" postCryptoMessageVerifyCorrectResponseIfIgnoreAndReportMissingQueryParam, + test s "postMessageQualifiedLocalOwningBackendMissingClients - post message qualified - local owning backend - missing clients" postMessageQualifiedLocalOwningBackendMissingClients, test s "post message qualified - local owning backend - redundant and deleted clients" postMessageQualifiedLocalOwningBackendRedundantAndDeletedClients, - test s "post message qualified - local owning backend - ignore missing" postMessageQualifiedLocalOwningBackendIgnoreMissingClients, + test s "postMessageQualifiedLocalOwningBackendIgnoreMissingClients - post message qualified - local owning backend - ignore missing" postMessageQualifiedLocalOwningBackendIgnoreMissingClients, test s "post message qualified - local owning backend - failed to send clients" postMessageQualifiedLocalOwningBackendFailedToSendClients, test s "post message qualified - local owning backend - failed to fetch clients" postMessageQualifiedFailedToSendFetchingClients, test s "post message qualified - remote owning backend - federation failure" postMessageQualifiedRemoteOwningBackendFailure, test s "post message qualified - remote owning backend - success" postMessageQualifiedRemoteOwningBackendSuccess, test s "join conversation" postJoinConvOk, test s "get code-access conversation information" testJoinCodeConv, - test s "join code-access conversation - no password" postJoinCodeConvOk, + test s "postJoinCodeConvOk - join code-access conversation - no password" postJoinCodeConvOk, test s "join code-access conversation - password" postJoinCodeConvWithPassword, test s "convert invite to code-access conversation" postConvertCodeConv, test s "convert code to team-access conversation" postConvertTeamConv, test s "team member can't join via guest link if access role removed" testTeamMemberCantJoinViaGuestLinkIfAccessRoleRemoved, test s "cannot join private conversation" postJoinConvFail, - test s "revoke guest links for team conversation" testJoinTeamConvGuestLinksDisabled, + test s "testJoinTeamConvGuestLinksDisabled - revoke guest links for team conversation" testJoinTeamConvGuestLinksDisabled, test s "revoke guest links for non-team conversation" testJoinNonTeamConvGuestLinksDisabled, test s "get code rejected if guest links disabled" testGetCodeRejectedIfGuestLinksDisabled, test s "post code rejected if guest links disabled" testPostCodeRejectedIfGuestLinksDisabled, @@ -242,8 +242,8 @@ tests s = ], test s "remove user with only local convs" removeUserNoFederation, test s "iUpsertOne2OneConversation" testAllOne2OneConversationRequests, - test s "post message - reject if missing client" postMessageRejectIfMissingClients, - test s "post message - client that is not in group doesn't receive message" postMessageClientNotInGroupDoesNotReceiveMsg, + test s "postMessageRejectIfMissingClients - post message - reject if missing client" postMessageRejectIfMissingClients, + test s "postMessageClientNotInGroupDoesNotReceiveMsg - post message - client that is not in group doesn't receive message" postMessageClientNotInGroupDoesNotReceiveMsg, test s "get guest links status from foreign team conversation" getGuestLinksStatusFromForeignTeamConv, testGroup "Typing indicators" @@ -410,7 +410,6 @@ postConvWithUnreachableRemoteUsers rbs = do groupConvs WS.assertNoEvent (3 # Second) [wsAlice, wsAlex] --- @SF.Separation @TSFI.RESTfulAPI @S2 -- This test verifies whether a message actually gets sent all the way to -- cannon. postCryptoMessageVerifyMsgSentAndRejectIfMissingClient :: TestM () @@ -499,12 +498,9 @@ postCryptoMessageVerifyMsgSentAndRejectIfMissingClient = do liftIO $ assertBool "unexpected equal clients" (bc /= bc2) assertNoMsg wsB2 (wsAssertOtr qconv qalice ac bc cipher) --- @END - --- @SF.Separation @TSFI.RESTfulAPI @S2 -- This test verifies basic mismatch behavior of the the JSON endpoint. -postCryptoMessageVerifyRejectMissingClientAndRepondMissingPrekeysJson :: TestM () -postCryptoMessageVerifyRejectMissingClientAndRepondMissingPrekeysJson = do +postCryptoMessageVerifyRejectMissingClientAndRespondMissingPrekeysJson :: TestM () +postCryptoMessageVerifyRejectMissingClientAndRespondMissingPrekeysJson = do (alice, ac) <- randomUserWithClient (head someLastPrekeys) (bob, bc) <- randomUserWithClient (someLastPrekeys !! 1) (eve, ec) <- randomUserWithClient (someLastPrekeys !! 2) @@ -527,12 +523,9 @@ postCryptoMessageVerifyRejectMissingClientAndRepondMissingPrekeysJson = do Map.keys (userClientMap (getUserClientPrekeyMap p)) @=? [eve] Map.keys <$> Map.lookup eve (userClientMap (getUserClientPrekeyMap p)) @=? Just [ec] --- @END - --- @SF.Separation @TSFI.RESTfulAPI @S2 -- This test verifies basic mismatch behaviour of the protobuf endpoint. -postCryptoMessageVerifyRejectMissingClientAndRepondMissingPrekeysProto :: TestM () -postCryptoMessageVerifyRejectMissingClientAndRepondMissingPrekeysProto = do +postCryptoMessageVerifyRejectMissingClientAndRespondMissingPrekeysProto :: TestM () +postCryptoMessageVerifyRejectMissingClientAndRespondMissingPrekeysProto = do (alice, ac) <- randomUserWithClient (head someLastPrekeys) (bob, bc) <- randomUserWithClient (someLastPrekeys !! 1) (eve, ec) <- randomUserWithClient (someLastPrekeys !! 2) @@ -557,8 +550,6 @@ postCryptoMessageVerifyRejectMissingClientAndRepondMissingPrekeysProto = do Map.keys (userClientMap (getUserClientPrekeyMap p)) @=? [eve] Map.keys <$> Map.lookup eve (userClientMap (getUserClientPrekeyMap p)) @=? Just [ec] --- @END - -- | This test verifies behaviour when an unknown client posts the message. Only -- tests the Protobuf endpoint. postCryptoMessageNotAuthorizeUnknownClient :: TestM () @@ -574,7 +565,6 @@ postCryptoMessageNotAuthorizeUnknownClient = do postProtoOtrMessage alice (ClientId 0x172618352518396) conv m !!! const 403 === statusCode --- @SF.Separation @TSFI.RESTfulAPI @S2 -- This test verifies the following scenario. -- A client sends a message to all clients of a group and one more who is not part of the group. -- The server must not send this message to client ids not part of the group. @@ -600,9 +590,6 @@ postMessageClientNotInGroupDoesNotReceiveMsg = do checkEveGetsMsg checkChadDoesNotGetMsg --- @END - --- @SF.Separation @TSFI.RESTfulAPI @S2 -- This test verifies that when a client sends a message not to all clients of a group then the server should reject the message and sent a notification to the sender (412 Missing clients). -- The test is somewhat redundant because this is already tested as part of other tests already. This is a stand alone test that solely tests the behavior described above. postMessageRejectIfMissingClients :: TestM () @@ -630,9 +617,6 @@ postMessageRejectIfMissingClients = do mkMsg :: ByteString -> (UserId, ClientId) -> (UserId, ClientId, Text) mkMsg text (uid, clientId) = (uid, clientId, toBase64Text text) --- @END - --- @SF.Separation @TSFI.RESTfulAPI @S2 -- This test verifies behaviour under various values of ignore_missing and -- report_missing. Only tests the JSON endpoint. postCryptoMessageVerifyCorrectResponseIfIgnoreAndReportMissingQueryParam :: TestM () @@ -690,9 +674,6 @@ postCryptoMessageVerifyCorrectResponseIfIgnoreAndReportMissingQueryParam = do where listToByteString = BS.intercalate "," . map toByteString' --- @END - --- @SF.Separation @TSFI.RESTfulAPI @S2 -- Sets up a conversation on Backend A known as "owning backend". One of the -- users from Backend A will send the message but have a missing client. It is -- expected that the message will not be sent. @@ -753,8 +734,6 @@ postMessageQualifiedLocalOwningBackendMissingClients = do assertMismatchQualified mempty expectedMissing mempty mempty mempty WS.assertNoEvent (1 # Second) [wsBob, wsChad] --- @END - -- | Sets up a conversation on Backend A known as "owning backend". One of the -- users from Backend A will send the message, it is expected that message will -- be sent successfully. @@ -845,7 +824,6 @@ postMessageQualifiedLocalOwningBackendRedundantAndDeletedClients = do -- Wait less for no message WS.assertNoEvent (1 # Second) [wsNonMember] --- @SF.Separation @TSFI.RESTfulAPI @S2 -- Sets up a conversation on Backend A known as "owning backend". One of the -- users from Backend A will send the message but have a missing client. It is -- expected that the message will be sent except when it is specifically @@ -972,8 +950,6 @@ postMessageQualifiedLocalOwningBackendIgnoreMissingClients = do assertMismatchQualified mempty expectedMissing mempty mempty mempty WS.assertNoEvent (1 # Second) [wsBob, wsChad] --- @END - postMessageQualifiedLocalOwningBackendFailedToSendClients :: TestM () postMessageQualifiedLocalOwningBackendFailedToSendClients = do -- WS receive timeout @@ -1203,7 +1179,6 @@ testPostCodeRejectedIfGuestLinksDisabled = do setStatus Public.FeatureStatusEnabled checkPostCode 200 --- @SF.Separation @TSFI.RESTfulAPI @S2 -- Check if guests cannot join anymore if guest invite feature was disabled on team level testJoinTeamConvGuestLinksDisabled :: TestM () testJoinTeamConvGuestLinksDisabled = do @@ -1261,8 +1236,6 @@ testJoinTeamConvGuestLinksDisabled = do postJoinCodeConv bob' cCode !!! const 200 === statusCode checkFeatureStatus Public.FeatureStatusEnabled --- @END - testJoinNonTeamConvGuestLinksDisabled :: TestM () testJoinNonTeamConvGuestLinksDisabled = do let convName = "testConversation" @@ -1286,7 +1259,6 @@ testJoinNonTeamConvGuestLinksDisabled = do const (Right (ConversationCoverView convId (Just convName) False)) === responseJsonEither const 200 === statusCode --- @SF.Separation @TSFI.RESTfulAPI @S2 -- This test case covers a negative check that if access code of a guest link is revoked no further -- people can join the group conversation. Additionally it covers: -- Random users can use invite link @@ -1341,8 +1313,6 @@ postJoinCodeConvOk = do putQualifiedAccessUpdate alice qconv noCodeAccess !!! const 200 === statusCode postJoinCodeConv dave payload !!! const 404 === statusCode --- @END - postJoinCodeConvWithPassword :: TestM () postJoinCodeConvWithPassword = do alice <- randomUser diff --git a/services/galley/test/integration/API/Federation.hs b/services/galley/test/integration/API/Federation.hs index e6bd8eea883..abd5bfccac8 100644 --- a/services/galley/test/integration/API/Federation.hs +++ b/services/galley/test/integration/API/Federation.hs @@ -69,7 +69,7 @@ tests s = testGroup "federation" [ test s "POST /federation/get-conversations : All Found" getConversationsAllFound, - test s "POST /federation/get-conversations : Conversations user is not a part of are excluded from result" getConversationsNotPartOf, + test s "getConversationsNotPartOf - POST /federation/get-conversations : Conversations user is not a part of are excluded from result" getConversationsNotPartOf, test s "POST /federation/on-conversation-created : Add local user to remote conversation" onConvCreated, test s "POST /federation/on-conversation-updated : Add local user to remote conversation" addLocalUser, test s "POST /federation/on-conversation-updated : Add only unconnected local users to remote conversation" addUnconnectedUsersOnly, @@ -159,7 +159,6 @@ getConversationsAllFound = do (Just (sort [bob, qUnqualified carlQ])) (fmap (sort . map (qUnqualified . omQualifiedId) . (.members.others)) c2) --- @SF.Federation @TSFI.RESTfulAPI @S2 -- -- The test asserts that via a federation client a user cannot fetch -- conversation details of a conversation they are not part of: they get an @@ -188,8 +187,6 @@ getConversationsNotPartOf = do GetConversationsRequest rando [qUnqualified . cnvQualifiedId $ cnv1] liftIO $ assertEqual "conversation list not empty" [] convs --- @END - onConvCreated :: TestM () onConvCreated = do c <- view tsCannon diff --git a/services/galley/test/integration/API/Teams.hs b/services/galley/test/integration/API/Teams.hs index dc5fffe2731..060116473e0 100644 --- a/services/galley/test/integration/API/Teams.hs +++ b/services/galley/test/integration/API/Teams.hs @@ -144,14 +144,14 @@ tests s = testGroup "delete team - verification code" [ test s "success" testDeleteTeamVerificationCodeSuccess, - test s "wrong code" testDeleteTeamVerificationCodeWrongCode, - test s "missing code" testDeleteTeamVerificationCodeMissingCode, - test s "expired code" testDeleteTeamVerificationCodeExpiredCode + test s "testDeleteTeamVerificationCodeWrongCode - wrong code" testDeleteTeamVerificationCodeWrongCode, + test s "testDeleteTeamVerificationCodeMissingCode - missing code" testDeleteTeamVerificationCodeMissingCode, + test s "testDeleteTeamVerificationCodeExpiredCode - expired code" testDeleteTeamVerificationCodeExpiredCode ], test s "delete team conversation" testDeleteTeamConv, test s "update team data" testUpdateTeam, test s "update team data icon validation" testUpdateTeamIconValidation, - test s "update team member" testUpdateTeamMember, + test s "testUpdateTeamMember - update team member" testUpdateTeamMember, test s "update team status" testUpdateTeamStatus, test s "send billing events to owners even in large teams" testBillingInLargeTeam, testGroup "broadcast" $ @@ -1044,7 +1044,6 @@ testDeleteTeamVerificationCodeSuccess = do const 202 === statusCode assertTeamDelete 10 "team delete, should be there" tid --- @SF.Channel @TSFI.RESTfulAPI @S2 -- -- Test that team cannot be deleted with missing second factor email verification code when this feature is enabled testDeleteTeamVerificationCodeMissingCode :: TestM () @@ -1066,9 +1065,6 @@ testDeleteTeamVerificationCodeMissingCode = do const 403 === statusCode const "code-authentication-required" === (Error.label . responseJsonUnsafeWithMsg "error label") --- @END - --- @SF.Channel @TSFI.RESTfulAPI @S2 -- -- Test that team cannot be deleted with expired second factor email verification code when this feature is enabled testDeleteTeamVerificationCodeExpiredCode :: TestM () @@ -1093,9 +1089,6 @@ testDeleteTeamVerificationCodeExpiredCode = do const 403 === statusCode const "code-authentication-failed" === (Error.label . responseJsonUnsafeWithMsg "error label") --- @END - --- @SF.Channel @TSFI.RESTfulAPI @S2 -- -- Test that team cannot be deleted with wrong second factor email verification code when this feature is enabled testDeleteTeamVerificationCodeWrongCode :: TestM () @@ -1118,8 +1111,6 @@ testDeleteTeamVerificationCodeWrongCode = do const 403 === statusCode const "code-authentication-failed" === (Error.label . responseJsonUnsafeWithMsg "error label") --- @END - setFeatureLockStatus :: forall cfg. (KnownSymbol (Public.FeatureSymbol cfg)) => TeamId -> Public.LockStatus -> TestM () setFeatureLockStatus tid status = do g <- viewGalley @@ -1397,7 +1388,6 @@ testBillingInLargeTeam = do assertTeamUpdate ("delete fanoutLimit + 3rd billing member: " <> show ownerFanoutPlusThree) team (fanoutLimit + 2) (allOwnersBeforeFanoutLimit <> [ownerFanoutPlusTwo]) refreshIndex --- | @SF.Management @TSFI.RESTfulAPI @S2 -- This test covers: -- Promotion, demotion of team roles. -- Demotion by superior roles is allowed. @@ -1464,8 +1454,6 @@ testUpdateTeamMember = do e ^. eventTeam @?= tid e ^. eventData @?= EdMemberUpdate uid mPerm --- @END - testUpdateTeamStatus :: TestM () testUpdateTeamStatus = do g <- viewGalley diff --git a/services/spar/test-integration/Test/Spar/APISpec.hs b/services/spar/test-integration/Test/Spar/APISpec.hs index 52d502da6fc..ea777758532 100644 --- a/services/spar/test-integration/Test/Spar/APISpec.hs +++ b/services/spar/test-integration/Test/Spar/APISpec.hs @@ -214,30 +214,9 @@ specInitiateLogin = do specFinalizeLogin :: SpecWith TestEnv specFinalizeLogin = do describe "POST /sso/finalize-login" $ do - -- @SF.Channel @TSFI.RESTfulAPI @S2 @S3 - -- Send authentication error and no cookie if response from SSO IdP was rejected - context "rejectsSAMLResponseSayingAccessNotGranted" $ do - it "responds with a very peculiar 'forbidden' HTTP response" $ do - (user, tid) <- callCreateUserWithTeam - (idp, (_, privcreds)) <- registerTestIdPWithMeta user - authnreq <- negotiateAuthnRequest idp - spmeta <- getTestSPMetadata tid - authnresp <- runSimpleSP $ mkAuthnResponse privcreds idp spmeta authnreq False - sparresp <- submitAuthnResponse tid authnresp - liftIO $ do - statusCode sparresp `shouldBe` 200 - let bdy = maybe "" (cs @LByteString @String) (responseBody sparresp) - bdy `shouldContain` "" - bdy `shouldContain` "" - bdy `shouldContain` "wire:sso:error:forbidden" - bdy `shouldContain` "window.opener.postMessage({" - bdy `shouldContain` "\"type\":\"AUTH_ERROR\"" - bdy `shouldContain` "\"payload\":{" - bdy `shouldContain` "\"label\":\"forbidden\"" - bdy `shouldContain` "}, receiverOrigin)" - hasPersistentCookieHeader sparresp `shouldBe` Left "no set-cookie header" - - -- @END + context "not granted" $ do + it "testRejectsSAMLResponseSayingAccessNotGranted - responds with a very peculiar 'forbidden' HTTP response" $ + testRejectsSAMLResponseSayingAccessNotGranted context "access granted" $ do let loginSuccess :: HasCallStack => ResponseLBS -> TestSpar () @@ -314,7 +293,6 @@ specFinalizeLogin = do authnresp <- runSimpleSP $ mkAuthnResponse privcreds idp3 spmeta authnreq True loginSuccess =<< submitAuthnResponse tid3 authnresp - -- @SF.Channel @TSFI.RESTfulAPI @S2 @S3 -- Do not authenticate if SSO IdP response is for different team context "rejectsSAMLResponseInWrongTeam" $ do it "fails" $ do @@ -341,8 +319,6 @@ specFinalizeLogin = do authnresp <- runSimpleSP $ mkAuthnResponseWithSubj subj privcreds idp2 spmeta authnreq True loginFailure =<< submitAuthnResponse tid2 authnresp - -- @END - context "user is created once, then deleted in team settings, then can login again." $ do it "responds with 'allowed'" $ do (ownerid, teamid) <- callCreateUserWithTeam @@ -406,115 +382,10 @@ specFinalizeLogin = do pending context "bad AuthnResponse" $ do - let check :: - (IdP -> TestSpar SAML.AuthnRequest) -> - (SignPrivCreds -> IdP -> SAML.SPMetadata -> SAML.AuthnRequest -> SimpleSP SignedAuthnResponse) -> - (TeamId -> SignedAuthnResponse -> TestSpar (Response (Maybe LByteString))) -> - (ResponseLBS -> IO ()) -> - TestSpar () - check mkareq mkaresp submitaresp checkresp = do - (ownerid, teamid) <- callCreateUserWithTeam - (idp, (_, privcreds)) <- registerTestIdPWithMeta ownerid - authnreq <- mkareq idp - spmeta <- getTestSPMetadata teamid - authnresp <- - runSimpleSP $ - mkaresp - privcreds - idp - spmeta - authnreq - sparresp <- submitaresp teamid authnresp - liftIO $ checkresp sparresp - - shouldContainInBase64 :: String -> String -> Expectation - shouldContainInBase64 hay needle = cs hay'' `shouldContain` needle - where - Right (Just hay'') = decodeBase64 <$> validateBase64 hay' - hay' = cs $ f hay - where - -- exercise to the reader: do this more idiomatically! - f (splitAt 5 -> ("
", s)) = g s
-                  f (_ : s) = f s
-                  f "" = ""
-                  g (splitAt 6 -> ("
", _)) = "" - g (c : s) = c : g s - g "" = "" - - -- @SF.Channel @TSFI.RESTfulAPI @S2 @S3 - -- Do not authenticate if SSO IdP response is for unknown issuer - it "rejectsSAMLResponseFromWrongIssuer" $ do - let mkareq = negotiateAuthnRequest - mkaresp privcreds idp spmeta authnreq = - mkAuthnResponse - privcreds - (idp & idpMetadata . edIssuer .~ Issuer [uri|http://unknown-issuer/|]) - spmeta - authnreq - True - submitaresp = submitAuthnResponse - checkresp sparresp = do - statusCode sparresp `shouldBe` 404 - -- body should contain the error label in the title, the verbatim haskell error, and the request: - (cs . fromJust . responseBody $ sparresp) `shouldContain` "wire:sso:error:not-found" - (cs . fromJust . responseBody $ sparresp) `shouldContainInBase64` "(CustomError (IdpDbError IdpNotFound)" - (cs . fromJust . responseBody $ sparresp) `shouldContainInBase64` "Input {iName = \"SAMLResponse\"" - check mkareq mkaresp submitaresp checkresp - - -- @END - - -- @SF.Channel @TSFI.RESTfulAPI @S2 @S3 - -- Do not authenticate if SSO IdP response is signed with wrong key - it "rejectsSAMLResponseSignedWithWrongKey" $ do - (ownerid, _teamid) <- callCreateUserWithTeam - (_, (_, badprivcreds)) <- registerTestIdPWithMeta ownerid - let mkareq = negotiateAuthnRequest - mkaresp _ idp spmeta authnreq = - mkAuthnResponse - badprivcreds - idp - spmeta - authnreq - True - submitaresp = submitAuthnResponse - checkresp sparresp = statusCode sparresp `shouldBe` 400 - check mkareq mkaresp submitaresp checkresp - - -- @END - - -- @SF.Channel @TSFI.RESTfulAPI @S2 @S3 - -- Do not authenticate if SSO IdP response has no corresponding request anymore - it "rejectsSAMLResponseIfRequestIsStale" $ do - let mkareq idp = do - req <- negotiateAuthnRequest idp - runSpar $ AReqIDStore.unStore (req ^. SAML.rqID) - pure req - mkaresp privcreds idp spmeta authnreq = mkAuthnResponse privcreds idp spmeta authnreq True - submitaresp = submitAuthnResponse - checkresp sparresp = do - statusCode sparresp `shouldBe` 200 - (cs . fromJust . responseBody $ sparresp) `shouldContain` "wire:sso:error:forbidden" - (cs . fromJust . responseBody $ sparresp) `shouldContain` "bad InResponseTo attribute(s)" - check mkareq mkaresp submitaresp checkresp - - -- @END - - -- @SF.Channel @TSFI.RESTfulAPI @S2 @S3 - -- Do not authenticate if SSO IdP response is gone missing - it "rejectsSAMLResponseIfResponseIsStale" $ do - let mkareq = negotiateAuthnRequest - mkaresp privcreds idp spmeta authnreq = mkAuthnResponse privcreds idp spmeta authnreq True - submitaresp teamid authnresp = do - _ <- submitAuthnResponse teamid authnresp - submitAuthnResponse teamid authnresp - checkresp sparresp = do - statusCode sparresp `shouldBe` 200 - (cs . fromJust . responseBody $ sparresp) `shouldContain` "wire:sso:error:forbidden" - check mkareq mkaresp submitaresp checkresp - - -- {- ORMOLU_DISABLE -} -- FUTUREWORK: try a newer release of ormolu? - -- @END - -- {- ORMOLU_ENABLE -} + it "testRejectsSAMLResponseFromWrongIssuer" testRejectsSAMLResponseFromWrongIssuer + it "testRejectsSAMLResponseSignedWithWrongKey" testRejectsSAMLResponseSignedWithWrongKey + it "testRejectsSAMLResponseIfRequestIsStale" testRejectsSAMLResponseIfRequestIsStale + it "testRejectsSAMLResponseIfResponseIsStale" testRejectsSAMLResponseIfResponseIsStale context "IdP changes response format" $ do it "treats NameId case-insensitively" $ do @@ -1787,3 +1658,134 @@ specReAuthSsoUserWithPassword = payload = RequestBodyLBS . encode . object . maybeToList $ fmap ("password" .=) pw + +---------------------------------------------------------------------- +-- tests for bsi audit + +testRejectsSAMLResponseSayingAccessNotGranted :: TestSpar () +testRejectsSAMLResponseSayingAccessNotGranted = do + (user, tid) <- callCreateUserWithTeam + (idp, (_, privcreds)) <- registerTestIdPWithMeta user + authnreq <- negotiateAuthnRequest idp + spmeta <- getTestSPMetadata tid + authnresp <- runSimpleSP $ mkAuthnResponse privcreds idp spmeta authnreq False + sparresp <- submitAuthnResponse tid authnresp + liftIO $ do + statusCode sparresp `shouldBe` 200 + let bdy = maybe "" (cs @LByteString @String) (responseBody sparresp) + bdy `shouldContain` "" + bdy `shouldContain` "" + bdy `shouldContain` "wire:sso:error:forbidden" + bdy `shouldContain` "window.opener.postMessage({" + bdy `shouldContain` "\"type\":\"AUTH_ERROR\"" + bdy `shouldContain` "\"payload\":{" + bdy `shouldContain` "\"label\":\"forbidden\"" + bdy `shouldContain` "}, receiverOrigin)" + hasPersistentCookieHeader sparresp `shouldBe` Left "no set-cookie header" + +-- Do not authenticate if SSO IdP response is for unknown issuer +testRejectsSAMLResponseFromWrongIssuer :: TestSpar () +testRejectsSAMLResponseFromWrongIssuer = do + let mkareq = negotiateAuthnRequest + mkaresp privcreds idp spmeta authnreq = + mkAuthnResponse + privcreds + (idp & idpMetadata . edIssuer .~ Issuer [uri|http://unknown-issuer/|]) + spmeta + authnreq + True + submitaresp = submitAuthnResponse + checkresp sparresp = do + statusCode sparresp `shouldBe` 404 + -- body should contain the error label in the title, the verbatim haskell error, and the request: + (cs . fromJust . responseBody $ sparresp) `shouldContain` "wire:sso:error:not-found" + (cs . fromJust . responseBody $ sparresp) `shouldContainInBase64` "(CustomError (IdpDbError IdpNotFound)" + (cs . fromJust . responseBody $ sparresp) `shouldContainInBase64` "Input {iName = \"SAMLResponse\"" + checkSamlFlow + mkareq + mkaresp + submitaresp + checkresp + +-- Do not authenticate if SSO IdP response is signed with wrong key +testRejectsSAMLResponseSignedWithWrongKey :: TestSpar () +testRejectsSAMLResponseSignedWithWrongKey = do + (ownerid, _teamid) <- callCreateUserWithTeam + (_, (_, badprivcreds)) <- registerTestIdPWithMeta ownerid + let mkareq = negotiateAuthnRequest + mkaresp _ idp spmeta authnreq = + mkAuthnResponse + badprivcreds + idp + spmeta + authnreq + True + submitaresp = submitAuthnResponse + checkresp sparresp = statusCode sparresp `shouldBe` 400 + checkSamlFlow mkareq mkaresp submitaresp checkresp + +-- Do not authenticate if SSO IdP response has no corresponding request anymore +testRejectsSAMLResponseIfRequestIsStale :: TestSpar () +testRejectsSAMLResponseIfRequestIsStale = do + let mkareq idp = do + req <- negotiateAuthnRequest idp + runSpar $ AReqIDStore.unStore (req ^. SAML.rqID) + pure req + mkaresp privcreds idp spmeta authnreq = mkAuthnResponse privcreds idp spmeta authnreq True + submitaresp = submitAuthnResponse + checkresp sparresp = do + statusCode sparresp `shouldBe` 200 + (cs . fromJust . responseBody $ sparresp) `shouldContain` "wire:sso:error:forbidden" + (cs . fromJust . responseBody $ sparresp) `shouldContain` "bad InResponseTo attribute(s)" + checkSamlFlow mkareq mkaresp submitaresp checkresp + +-- Do not authenticate if SSO IdP response is gone missing +testRejectsSAMLResponseIfResponseIsStale :: TestSpar () +testRejectsSAMLResponseIfResponseIsStale = do + let mkareq = negotiateAuthnRequest + mkaresp privcreds idp spmeta authnreq = mkAuthnResponse privcreds idp spmeta authnreq True + submitaresp teamid authnresp = do + _ <- submitAuthnResponse teamid authnresp + submitAuthnResponse teamid authnresp + checkresp sparresp = do + statusCode sparresp `shouldBe` 200 + (cs . fromJust . responseBody $ sparresp) `shouldContain` "wire:sso:error:forbidden" + checkSamlFlow mkareq mkaresp submitaresp checkresp + +---------------------------------------------------------------------- +-- Helpers + +shouldContainInBase64 :: String -> String -> Expectation +shouldContainInBase64 hay needle = cs hay'' `shouldContain` needle + where + Right (Just hay'') = decodeBase64 <$> validateBase64 hay' + hay' = cs $ f hay + where + -- exercise to the reader: do this more idiomatically! + f (splitAt 5 -> ("
", s)) = g s
+        f (_ : s) = f s
+        f "" = ""
+        g (splitAt 6 -> ("
", _)) = "" + g (c : s) = c : g s + g "" = "" + +checkSamlFlow :: + (IdP -> TestSpar SAML.AuthnRequest) -> + (SignPrivCreds -> IdP -> SAML.SPMetadata -> SAML.AuthnRequest -> SimpleSP SignedAuthnResponse) -> + (TeamId -> SignedAuthnResponse -> TestSpar (Response (Maybe LByteString))) -> + (ResponseLBS -> IO ()) -> + TestSpar () +checkSamlFlow mkareq mkaresp submitaresp checkresp = do + (ownerid, teamid) <- callCreateUserWithTeam + (idp, (_, privcreds)) <- registerTestIdPWithMeta ownerid + authnreq <- mkareq idp + spmeta <- getTestSPMetadata teamid + authnresp <- + runSimpleSP $ + mkaresp + privcreds + idp + spmeta + authnreq + sparresp <- submitaresp teamid authnresp + liftIO $ checkresp sparresp diff --git a/services/spar/test-integration/Test/Spar/Scim/AuthSpec.hs b/services/spar/test-integration/Test/Spar/Scim/AuthSpec.hs index e646e8e2a57..9247594fe87 100644 --- a/services/spar/test-integration/Test/Spar/Scim/AuthSpec.hs +++ b/services/spar/test-integration/Test/Spar/Scim/AuthSpec.hs @@ -63,7 +63,7 @@ spec = do specDeleteToken specListTokens describe "Miscellaneous" $ do - it "doesn't allow SCIM operations with invalid or missing SCIM token" testAuthIsNeeded + it "testAuthIsNeeded - doesn't allow SCIM operations with invalid or missing SCIM token" testAuthIsNeeded ---------------------------------------------------------------------------- -- Token creation @@ -74,9 +74,9 @@ specCreateToken = describe "POST /auth-tokens" $ do it "works" testCreateToken it "respects the token limit" testTokenLimit it "requires the team to have no more than one IdP" testNumIdPs - it "authorizes only admins and owners" testCreateTokenAuthorizesOnlyAdmins + it "testCreateTokenAuthorizesOnlyAdmins - authorizes only admins and owners" testCreateTokenAuthorizesOnlyAdmins it "requires a password" testCreateTokenRequiresPassword - it "works with verification code" testCreateTokenWithVerificationCode + it "testCreateTokenWithVerificationCode - works with verification code" testCreateTokenWithVerificationCode -- FUTUREWORK: we should also test that for a password-less user, e.g. for an SSO user, -- reauthentication is not required. We currently (2019-03-05) can't test that because @@ -106,8 +106,6 @@ testCreateToken = do listUsers_ (Just token) (Just fltr) (env ^. teSpar) !!! const 200 === statusCode --- @SF.Channel @TSFI.RESTfulAPI @S2 --- -- Test positive case but also that a SCIM token cannot be created with wrong -- or missing second factor email verification code when this feature is enabled testCreateTokenWithVerificationCode :: TestSpar () @@ -143,8 +141,6 @@ testCreateTokenWithVerificationCode = do call $ post (brig . paths ["verification-code", "send"] . contentJson . json (Public.SendVerificationCode action email)) --- @END - unlockFeature :: GalleyReq -> TeamId -> TestSpar () unlockFeature galley tid = call $ put (galley . paths ["i", "teams", toByteString' tid, "features", featureNameBS @Public.SndFactorPasswordChallengeConfig, toByteString' Public.LockStatusUnlocked]) !!! const 200 === statusCode @@ -223,7 +219,6 @@ testNumIdPs = do createToken_ owner (CreateScimToken "drei" (Just defPassword) Nothing) (env ^. teSpar) !!! checkErr 400 (Just "more-than-one-idp") --- @SF.Provisioning @TSFI.RESTfulAPI @S2 -- Test that a token can only be created as a team owner testCreateTokenAuthorizesOnlyAdmins :: TestSpar () testCreateTokenAuthorizesOnlyAdmins = do @@ -256,8 +251,6 @@ testCreateTokenAuthorizesOnlyAdmins = do (mkUser RoleAdmin >>= createToken') !!! const 200 === statusCode --- @END - -- | Test that for a user with a password, token creation requires reauthentication (i.e. the -- field @"password"@ should be provided). -- @@ -456,7 +449,6 @@ testDeletedTokensAreUnlistable = do ---------------------------------------------------------------------------- -- Miscellaneous tests --- @SF.Provisioning @TSFI.RESTfulAPI @S2 -- This test verifies that the SCIM API responds with an authentication error -- and can't be used if it receives an invalid secret token -- or if no token is provided at all @@ -468,5 +460,3 @@ testAuthIsNeeded = do listUsers_ (Just invalidToken) Nothing (env ^. teSpar) !!! checkErr 401 Nothing -- Try to do @GET /Users@ without a token and check that it fails listUsers_ Nothing Nothing (env ^. teSpar) !!! checkErr 401 Nothing - --- @END diff --git a/services/spar/test-integration/Test/Spar/Scim/UserSpec.hs b/services/spar/test-integration/Test/Spar/Scim/UserSpec.hs index 5d23f93a9be..1ff2bdb2584 100644 --- a/services/spar/test-integration/Test/Spar/Scim/UserSpec.hs +++ b/services/spar/test-integration/Test/Spar/Scim/UserSpec.hs @@ -490,7 +490,7 @@ specCreateUser = describe "POST /Users" $ do it "set locale to hr and update to default" $ testCreateUserWithSamlIdPWithPreferredLanguage (Just (Locale (Language HR) Nothing)) Nothing it "set locale to default and update to default" $ testCreateUserWithSamlIdPWithPreferredLanguage Nothing Nothing it "requires externalId to be present" $ testExternalIdIsRequired - it "rejects invalid handle" $ testCreateRejectsInvalidHandle + it "testCreateRejectsInvalidHandle - rejects invalid handle" $ testCreateRejectsInvalidHandle it "rejects occupied handle" $ testCreateRejectsTakenHandle it "rejects occupied externalId (uref)" $ testCreateRejectsTakenExternalId True it "rejects occupied externalId (email)" $ testCreateRejectsTakenExternalId False @@ -840,9 +840,6 @@ testExternalIdIsRequired = do createUser_ (Just tok) user' (env ^. teSpar) !!! const 400 === statusCode --- The next line contains a mapping from this test to the following test standards: --- @SF.Provisioning @TSFI.RESTfulAPI @S2 --- -- Test that user creation fails if handle is invalid testCreateRejectsInvalidHandle :: TestSpar () testCreateRejectsInvalidHandle = do @@ -853,8 +850,6 @@ testCreateRejectsInvalidHandle = do createUser_ (Just tok) (user {Scim.User.userName = "#invalid name"}) (env ^. teSpar) !!! const 400 === statusCode --- @END - -- | Test that user creation fails if handle is already in use (even on different team). testCreateRejectsTakenHandle :: TestSpar () testCreateRejectsTakenHandle = do