From 9eb235529ce6fb3c55454e1f29b543a9b11c59be Mon Sep 17 00:00:00 2001 From: Matthias Fischmann Date: Fri, 24 Sep 2021 09:18:18 +0200 Subject: [PATCH] ... --- libs/wire-api/src/Wire/API/User/RichInfo.hs | 1 + .../test/unit/Test/Wire/API/User/RichInfo.hs | 34 +++++++++++++++++++ services/spar/test/Test/Spar/ScimSpec.hs | 33 ------------------ 3 files changed, 35 insertions(+), 33 deletions(-) diff --git a/libs/wire-api/src/Wire/API/User/RichInfo.hs b/libs/wire-api/src/Wire/API/User/RichInfo.hs index 66aab8ce65c..f4ea538950d 100644 --- a/libs/wire-api/src/Wire/API/User/RichInfo.hs +++ b/libs/wire-api/src/Wire/API/User/RichInfo.hs @@ -265,6 +265,7 @@ richInfoAssocListFromObject richinfoObj = do instance Arbitrary RichInfoAssocList where arbitrary = mkRichInfoAssocList <$> arbitrary + shrink (RichInfoAssocList things) = RichInfoAssocList <$> QC.shrink things -------------------------------------------------------------------------------- -- RichField diff --git a/libs/wire-api/test/unit/Test/Wire/API/User/RichInfo.hs b/libs/wire-api/test/unit/Test/Wire/API/User/RichInfo.hs index 2db757efb0f..0557c56c467 100644 --- a/libs/wire-api/test/unit/Test/Wire/API/User/RichInfo.hs +++ b/libs/wire-api/test/unit/Test/Wire/API/User/RichInfo.hs @@ -24,9 +24,11 @@ import Data.Aeson import Data.Aeson.QQ import Data.Aeson.Types as Aeson import Imports +import Test.QuickCheck import Test.Tasty import Test.Tasty.HUnit import Test.Tasty.QuickCheck +import qualified Web.Scim.Schema.Common as Scim import Wire.API.User.RichInfo tests :: TestTree @@ -148,3 +150,35 @@ testRichInfo = assertEqual "RichInfoMapAndList" (Aeson.Success $ mkRichInfoMapAndList [RichField "foo" "bar"]) $ fromJSON inputJSON ] ] + <> moreRichInfoNormalizationTests + +moreRichInfoNormalizationTests :: [TestTree] +moreRichInfoNormalizationTests = + [ testCase "'normalizeRichInfoAssocList'" $ do + let f = length . unRichInfoAssocList + assertEqual mempty (f (normalizeRichInfoAssocList assocs)) (f assocs) + assertEqual mempty (normalizeRichInfoAssocList assocs) assocs, + testGroup + "'toRichInfoAssocList', 'fromRichInfoAssocList'" + [ testCase "works (counter-example of earlier bug)" $ do + let x = mkRichInfoMapAndList [RichField "A" "b", RichField "a" "x"] + y = (fromRichInfoAssocList . toRichInfoAssocList) x + assertEqual mempty (toRichInfoAssocList x) (toRichInfoAssocList y), + testCase "works (counter-example of earlier bug)" $ do + assertEqual mempty (jsonroundtrip assocs) assocs + assertEqual mempty (toRichInfoAssocList . fromRichInfoAssocList $ assocs) assocs + assertEqual mempty (toRichInfoAssocList . jsonroundtrip . fromRichInfoAssocList $ assocs) assocs, + testProperty "works (property)" $ \(someAssocs :: RichInfoAssocList) -> + (jsonroundtrip someAssocs) === someAssocs + .&&. (toRichInfoAssocList . fromRichInfoAssocList $ someAssocs) === someAssocs + .&&. (toRichInfoAssocList . jsonroundtrip . fromRichInfoAssocList $ someAssocs) === someAssocs + ] + ] + where + jsonroundtrip :: forall a. (ToJSON a, FromJSON a) => a -> a + jsonroundtrip = unsafeParse . Scim.jsonLower . Aeson.toJSON + where + unsafeParse = either (error . show) id . Aeson.parseEither Aeson.parseJSON + + assocs :: RichInfoAssocList + assocs = mkRichInfoAssocList [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"}] diff --git a/services/spar/test/Test/Spar/ScimSpec.hs b/services/spar/test/Test/Spar/ScimSpec.hs index 350cce62bde..2db4310e428 100644 --- a/services/spar/test/Test/Spar/ScimSpec.hs +++ b/services/spar/test/Test/Spar/ScimSpec.hs @@ -255,22 +255,12 @@ spec = describe "toScimStoredUser'" $ do `shouldBe` (Right (ScimUserExtra (RichInfo (mkRichInfoAssocList expectedAssocList)))) describe "normalization" $ do - -- FUTUREWORK: all of this should probably go to - -- `/libs/wire-api/test/unit/Test/Wire/API/User/RichInfo.hs`, but you'd have to translate - -- everything to tasty first. - 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 = assocs}}} assocs :: RichInfoAssocList assocs = mkRichInfoAssocList [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"}] - describe "'normalizeRichInfoAssocList'" $ do - it "works (counter-example of earlier bug)" $ do - let f = length . unRichInfoAssocList - f (normalizeRichInfoAssocList assocs) `shouldBe` f assocs - normalizeRichInfoAssocList assocs `shouldBe` assocs - describe "'normalizeLikeStored'" $ do it "works (counter-example of earlier bug)" $ do let f = length . unRichInfoAssocList . unRichInfo . view sueRichInfo . Scim.extra @@ -280,26 +270,3 @@ spec = describe "toScimStoredUser'" $ do it "keeps user record intact (property)" . property $ \(usr' :: (Scim.User SparTag)) -> counterexample (show usr') $ do normalizeLikeStored usr' `shouldBe` usr' - - describe "'toRichInfoAssocList', 'fromRichInfoAssocList'" $ do - it "works (counter-example of earlier bug)" $ do - let x = mkRichInfoMapAndList [RichField "A" "b", RichField "a" "x"] - y = (fromRichInfoAssocList . toRichInfoAssocList) x - toRichInfoAssocList x `shouldBe` toRichInfoAssocList y - - let testcase :: RichInfoAssocList -> Expectation - testcase someAssocs = do - let jsonroundtrip :: forall a. (ToJSON a, FromJSON a) => a -> a - jsonroundtrip = unsafeParse . Scim.jsonLower . Aeson.toJSON - where - unsafeParse = either (error . show) id . Aeson.parseEither Aeson.parseJSON - - jsonroundtrip someAssocs `shouldBe` someAssocs - (toRichInfoAssocList . fromRichInfoAssocList) someAssocs `shouldBe` someAssocs - (toRichInfoAssocList . jsonroundtrip . fromRichInfoAssocList) someAssocs `shouldBe` someAssocs - - it "works (counter-example of earlier bug)" $ - testcase assocs - - it "works (property)" . property $ - testcase