From 7eb487a5545d69ddb00c56a64a45766fc9c984b5 Mon Sep 17 00:00:00 2001 From: Matthias Fischmann Date: Mon, 20 Sep 2021 16:49:57 +0200 Subject: [PATCH] Broken tests [WIP] --- libs/wire-api/src/Wire/API/User/RichInfo.hs | 1 + .../Test/Spar/Scim/UserSpec.hs | 25 ++++- services/spar/test-integration/Util/Scim.hs | 3 +- services/spar/test/Test/Spar/ScimSpec.hs | 92 +++++++++++++++++-- 4 files changed, 112 insertions(+), 9 deletions(-) diff --git a/libs/wire-api/src/Wire/API/User/RichInfo.hs b/libs/wire-api/src/Wire/API/User/RichInfo.hs index e0bb65bb2f9..ecfeed8d56e 100644 --- a/libs/wire-api/src/Wire/API/User/RichInfo.hs +++ b/libs/wire-api/src/Wire/API/User/RichInfo.hs @@ -33,6 +33,7 @@ module Wire.API.User.RichInfo -- * RichInfoAssocList RichInfoAssocList (..), normalizeRichInfoAssocList, + richInfoAssocListFromObject, richInfoAssocListURN, -- * RichField diff --git a/services/spar/test-integration/Test/Spar/Scim/UserSpec.hs b/services/spar/test-integration/Test/Spar/Scim/UserSpec.hs index 4ade02f3eb9..2649f146526 100644 --- a/services/spar/test-integration/Test/Spar/Scim/UserSpec.hs +++ b/services/spar/test-integration/Test/Spar/Scim/UserSpec.hs @@ -64,6 +64,7 @@ import Spar.Data (lookupScimExternalId) import qualified Spar.Data as Data import qualified Spar.Intra.Brig as Intra import Spar.Scim +import Spar.Scim.Types (normalizeLikeStored) import qualified Spar.Scim.User as SU import qualified Text.XML.DSig as SAML import qualified URI.ByteString as URI @@ -776,6 +777,7 @@ specListUsers :: SpecWith TestEnv specListUsers = describe "GET /Users" $ do it "lists all SCIM users in a team" $ testListProvisionedUsers context "1 SAML IdP" $ do + focus . it "BLA" $ testBla it "finds a SCIM-provisioned user by userName or externalId" $ testFindProvisionedUser it "finds a user autoprovisioned via saml by externalId via email" $ testFindSamlAutoProvisionedUserMigratedWithEmailInTeamWithSSO it "finds a user invited via team settings by externalId via email" $ testFindTeamSettingsInvitedUserMigratedWithEmailInTeamWithSSO @@ -790,6 +792,24 @@ specListUsers = describe "GET /Users" $ do it "doesn't list users from other teams" $ testUserListFailsWithNotFoundIfOutsideTeam it "doesn't find users from other teams" $ testUserFindFailsWithNotFoundIfOutsideTeam +testBla :: TestSpar () +testBla = do + let job i = do + print i + user <- randomScimUser + (tok, (_, _, _)) <- registerIdPAndScimToken + storedUser <- createUser tok user + [storedUser'] <- listUsers tok (Just (filterBy "userName" (Scim.User.userName user))) + -- the following two lines break after a while, and have been doing so on develop + -- since at least 1a30f5ff9a2d767fa75b35cb20c89091eea50a4b. + liftIO $ storedUser' `shouldBe` storedUser + liftIO $ Scim.value (Scim.thing storedUser') `shouldBe` normalizeLikeStored user {Scim.User.emails = [] {- only after validation -}} + let Just externalId = Scim.User.externalId user + users' <- listUsers tok (Just (filterBy "externalId" externalId)) + liftIO $ users' `shouldBe` [storedUser] + job (i + 1) + job (1 :: Int) + -- | Test that SCIM-provisioned team members are listed, and users that were not provisioned -- via SCIM are not listed. testListProvisionedUsers :: TestSpar () @@ -805,8 +825,9 @@ testFindProvisionedUser = do user <- randomScimUser (tok, (_, _, _)) <- registerIdPAndScimToken storedUser <- createUser tok user - users <- listUsers tok (Just (filterBy "userName" (Scim.User.userName user))) - liftIO $ users `shouldBe` [storedUser] + [storedUser'] <- listUsers tok (Just (filterBy "userName" (Scim.User.userName user))) + liftIO $ storedUser' `shouldBe` storedUser + liftIO $ Scim.value (Scim.thing storedUser') `shouldBe` normalizeLikeStored user {Scim.User.emails = [] {- only after validation -}} let Just externalId = Scim.User.externalId user users' <- listUsers tok (Just (filterBy "externalId" externalId)) liftIO $ users' `shouldBe` [storedUser] diff --git a/services/spar/test-integration/Util/Scim.hs b/services/spar/test-integration/Util/Scim.hs index f536fdb9cfe..139d0af9e95 100644 --- a/services/spar/test-integration/Util/Scim.hs +++ b/services/spar/test-integration/Util/Scim.hs @@ -37,6 +37,7 @@ import qualified SAML2.WebSSO as SAML import SAML2.WebSSO.Types (IdPId, idpId) import Spar.Data as Data import qualified Spar.Intra.Brig as Intra +import Spar.Scim.Types (normalizeLikeStored) import Spar.Scim.User (synthesizeScimUser, validateScimUser') import Test.QuickCheck (arbitrary, generate) import qualified Text.Email.Parser as Email @@ -100,7 +101,7 @@ registerScimToken teamid midpid = do -- FUTUREWORK: make this more exhaustive. change everything that can be changed! move this to the -- hspec package when done. randomScimUser :: (HasCallStack, MonadRandom m, MonadIO m) => m (Scim.User.User SparTag) -randomScimUser = fst <$> randomScimUserWithSubject +randomScimUser = normalizeLikeStored . fst <$> randomScimUserWithSubject -- | Like 'randomScimUser', but also returns the intended subject ID that the user should -- have. It's already available as 'Scim.User.externalId' but it's not structured. diff --git a/services/spar/test/Test/Spar/ScimSpec.hs b/services/spar/test/Test/Spar/ScimSpec.hs index 63239082c0c..a45594a9b9d 100644 --- a/services/spar/test/Test/Spar/ScimSpec.hs +++ b/services/spar/test/Test/Spar/ScimSpec.hs @@ -9,7 +9,7 @@ {-# LANGUAGE TypeFamilies #-} {-# LANGUAGE ViewPatterns #-} {-# OPTIONS_GHC -Wno-incomplete-uni-patterns #-} -{-# OPTIONS_GHC -Wno-orphans #-} +{-# OPTIONS_GHC -Wno-orphans -Wno-unused-imports #-} -- This file is part of the Wire Server implementation. -- @@ -30,18 +30,25 @@ module Test.Spar.ScimSpec where -import Control.Lens (view) -import Data.Aeson (eitherDecode', encode, parseJSON) +import Control.Exception (assert) +import Control.Lens (preview, view) +import Data.Aeson +import qualified Data.Aeson.Lens as AL import Data.Aeson.QQ (aesonQQ) import qualified Data.Aeson.Types as Aeson +import qualified Data.CaseInsensitive as CI +import qualified Data.HashMap.Strict as HM import Data.Id import Data.Json.Util (fromUTCTimeMillis, toUTCTimeMillis) +import Data.String.Conversions (cs) +import qualified Data.Text import qualified Data.UUID as UUID import Imports import Network.URI (parseURI) import qualified SAML2.WebSSO as SAML import Spar.Scim import Spar.Scim.Types (normalizeLikeStored) +import System.IO.Unsafe (unsafePerformIO) import Test.Hspec import Test.QuickCheck import URI.ByteString @@ -51,9 +58,8 @@ import qualified Web.Scim.Schema.Common as Scim import qualified Web.Scim.Schema.Meta as Scim import Web.Scim.Schema.PatchOp (Op (Remove), Operation (..), PatchOp (..), Path (NormalPath), applyOperation) import qualified Web.Scim.Schema.ResourceType as ScimR -import Web.Scim.Schema.Schema (Schema (CustomSchema)) -import qualified Web.Scim.Schema.Schema as Scim -import qualified Web.Scim.Schema.User as Scim +import Web.Scim.Schema.Schema as Scim +import Web.Scim.Schema.User as Scim import qualified Web.Scim.Schema.User.Name as ScimN import Wire.API.User.RichInfo @@ -261,3 +267,77 @@ spec = describe "toScimStoredUser'" $ do \(WithNormalizedRichFields (usr :: (Scim.User SparTag))) -> counterexample (show usr) $ do let f = length . unRichInfoAssocList . unRichInfo . view sueRichInfo . Scim.extra f (normalizeLikeStored usr) `shouldBe` f usr + +test1 :: Spec +test1 = do + it "works" $ do + let x = RichInfoAssocList {unRichInfoAssocList = [RichField {richFieldType = "0-plIe\176041Sdu]\129492ouXy*]j\49123`jDNJ:N%\32939\&6\183443\\>HSi\6502q,\28951wZ].\11331w`", richFieldValue = "C ny6Nx0f&b\121034\29092r"}, RichField {richFieldType = "[&c;VP9\42304Q.I\43963OS\83057}G ]\175364xYLqO\156677q*ZBtZ`vKc", richFieldValue = "+FEv\28180"}, RichField {richFieldType = "}121@^z{", richFieldValue = "{KZQqjqs Py%ETB>;y1}\142167\181794\164475p"}, RichField {richFieldType = "\48098\&2#-p\68080\&9\37971|\190007K|m(", richFieldValue = ":j7\83424lQ\19571\188281*[)D8\50056\9019n\189416\100233]*!={FX|/!!&my]+8\175071\135759\&0\13316K'(\14120\172092w,2"}, RichField {richFieldType = "\50520MX>\\kQcBz\169538\147873\\\177286FqS!GW]#\20027_n", richFieldValue = "53\190108.?%t[ &9=hd9t:}Q@yj#w~B\164946B# fs!\39091}eEP"}, RichField {richFieldType = "sE7hmj\164437:", richFieldValue = "ns\"EJftf6~g5U\"&tt\20456@]M"}, RichField {richFieldType = "\172698p\41097sHk \37897X0Io\8286OU\173780\18370h\46873&GAOpuQU+T)]rC\5068WCA\68875(-\175596'", richFieldValue = "lRiP"}]} + + y = normalizeRichInfoAssocList x + f = length . unRichInfoAssocList + f x `shouldBe` f y + + let q :: [Text] + q = CI.original . richFieldType <$> unRichInfoAssocList x + + (length . sort . nub $ Data.Text.toLower <$> q) `shouldBe` (length . sort . nub $ q) + + it "works" $ do + let usr :: User SparTag + usr = User {schemas = [PatchOp20, CustomSchema "asdf", ResourceType20, CustomSchema "", CustomSchema "", Group20, ServiceProviderConfig20], userName = ">/nP6S3|)RBmeJ/'PqYzRr\96446F\42072HS_izq", externalId = Just "nZ\179219)DZ\13375\\v", name = Nothing, displayName = Just "`b++0RD Ty~ z/S`Z\\\"bDE-\13666\&32>%<\189311", nickName = Nothing, profileUrl = Nothing, title = Nothing, userType = Nothing, preferredLanguage = Nothing, locale = Nothing, active = Nothing, password = Nothing, emails = [], phoneNumbers = [], ims = [], photos = [], addresses = [], entitlements = [], roles = [], x509Certificates = [], extra = ScimUserExtra {_sueRichInfo = RichInfo {unRichInfo = RichInfoAssocList {unRichInfoAssocList = [RichField {richFieldType = "0-plIe\176041Sdu]\129492ouXy*]j\49123`jDNJ:N%\32939\&6\183443\\>HSi\6502q,\28951wZ].\11331w`", richFieldValue = "C ny6Nx0f&b\121034\29092r"}, RichField {richFieldType = "[&c;VP9\42304Q.I\43963OS\83057}G ]\175364xYLqO\156677q*ZBtZ`vKc", richFieldValue = "+FEv\28180"}, RichField {richFieldType = "}121@^z{", richFieldValue = "{KZQqjqs Py%ETB>;y1}\142167\181794\164475p"}, RichField {richFieldType = "\48098\&2#-p\68080\&9\37971|\190007K|m(", richFieldValue = ":j7\83424lQ\19571\188281*[)D8\50056\9019n\189416\100233]*!={FX|/!!&my]+8\175071\135759\&0\13316K'(\14120\172092w,2"}, RichField {richFieldType = "\50520MX>\\kQcBz\169538\147873\\\177286FqS!GW]#\20027_n", richFieldValue = "53\190108.?%t[ &9=hd9t:}Q@yj#w~B\164946B# fs!\39091}eEP"}, RichField {richFieldType = "sE7hmj\164437:", richFieldValue = "ns\"EJftf6~g5U\"&tt\20456@]M"}, RichField {richFieldType = "\172698p\41097sHk \37897X0Io\8286OU\173780\18370h\46873&GAOpuQU+T)]rC\5068WCA\68875(-\175596'", richFieldValue = "lRiP"}]}}}} + + -- writeFile "/tmp/x" $ cs $ encode usr + + let f = length . unRichInfoAssocList . unRichInfo . view sueRichInfo . Scim.extra + f (normalizeLikeStored' True usr) `shouldBe` f usr + f (normalizeLikeStored' False {- TODO this should also pass! -} usr) `shouldBe` f usr + + it "works" $ do + pendingWith + ( "next steps: print usr above in line 287; test whether things break in 'richInfoAssocListFromObject'" + -- ... but i really can't see how? my money right now is on a unicode bug + ) + +-- | cloned from 'normalizeLikeStored' +normalizeLikeStored' :: Bool -> User SparTag -> User SparTag +normalizeLikeStored' working usr = + lowerSerialized + usr + { extra = tweakExtra $ extra usr + } + where + lowerSerialized :: User SparTag -> User SparTag + lowerSerialized = + either (error . show {- impossible; evidence: roundtrip tests -}) id + . Aeson.parseEither Aeson.parseJSON + . jsonLower' working + . Aeson.toJSON + + tweakExtra :: ScimUserExtra -> ScimUserExtra + tweakExtra = ScimUserExtra . RichInfo . normalizeRichInfoAssocList . unRichInfo . view sueRichInfo + +-- | cloned from 'jsonLower' +jsonLower' :: Bool -> Value -> Value +jsonLower' working (Object o) = checkgood $ Object o' + where + o' :: HM.HashMap Text Value + o' = HM.fromList . lowerPairs . HM.toList $ o + + lowerPair (key, val) = ((if working then id else Data.Text.toLower) key, jsonLower' working val) + + checkgood a = + if length (HM.keys o) /= length (HM.keys o') + then error $ show (o, o') + else a + + lowerPairs xs = + assert good $ + assert better $ + xs' + where + xs' = lowerPair <$> xs + good = f xs == f xs' + better = (length . HM.keys . HM.fromList $ xs') == f xs' + f = length . nub . sort . fmap fst +jsonLower' working (Array x) = Array (jsonLower' working <$> x) +jsonLower' _ x = x