...

wireapp · Sep 24, 2021 · e32fb17 · e32fb17
1 parent 7894e62
commit e32fb17
Show file tree

Hide file tree

Showing 3 changed files with 23 additions and 20 deletions.
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
@@ -41,15 +41,15 @@ testRichInfo =
           [ check
               "map comes in alpha order, at the end of the assoc list"
               (mkRichInfoMapAndList [RichField "b" "2", RichField "c" "3", RichField "a" "1"])
-              (mkRichInfoAssocList [RichField "b" "2", RichField "a" "1", RichField "c" "3"]),
+              (mkRichInfoAssocList [RichField "b" "2", RichField "c" "3", RichField "a" "1"]),
             check
               "map overwrites assoc list"
               (mkRichInfoMapAndList [RichField "a" "c"])
-              (mkRichInfoAssocList [RichField "a" "b"]),
+              (mkRichInfoAssocList [RichField "a" "c"]),
             check
               "treats RichField keys case-insensitively"
               (mkRichInfoMapAndList [RichField "A" "c", RichField "B" "b"])
-              (mkRichInfoAssocList [RichField "a" "b", RichField "B" "b"])
+              (mkRichInfoAssocList [RichField "a" "c", RichField "b" "b"])
           ],
     testProperty "RichInfoAssocList <-> RichInfoMapAndList roundtrip" $ \riAssocList -> do
       toRichInfoAssocList (fromRichInfoAssocList riAssocList) === riAssocList,
@@ -113,12 +113,11 @@ testRichInfo =
                                         }
                                      }
                                    }|]
-          assertEqual "RichInfoMapAndList" (Aeson.Success $ mkRichInfoMapAndList [RichField "foo" "bar"]) $ fromJSON inputJSON,
+          assertEqual "RichInfoMapAndList" (Aeson.Success $ mkRichInfoMapAndList [RichField "foo" "bar", RichField "bar" "baz"]) $ fromJSON inputJSON,
         testCase "Without Old RichInfoMapAndList" $ do
           let inputJSON =
                 [aesonQQ|{
                                     "urn:ietf:params:scim:schemas:extension:wire:1.0:User" : {
-                                      "bar": "baz"
                                     }
                                   }|]
           assertEqual "RichInfoMapAndList" (Aeson.Success $ mkRichInfoMapAndList []) $ fromJSON inputJSON,

diff --git a/services/spar/test-integration/Test/Spar/Scim/UserSpec.hs b/services/spar/test-integration/Test/Spar/Scim/UserSpec.hs
@@ -554,10 +554,10 @@ testLocation = do
 
 testRichInfo :: TestSpar ()
 testRichInfo = do
-  let richInfo = RichInfo (RichInfoAssocList [RichField "Platforms" "OpenBSD; Plan9"])
-      richInfoOverwritten = RichInfo (RichInfoAssocList [RichField "Platforms" "Windows10"])
-      richInfoPatchedMap = RichInfo (RichInfoAssocList [RichField "Platforms" "Arch, BTW"])
-      richInfoPatchedList = RichInfo (RichInfoAssocList [RichField "Platforms" "none"])
+  let richInfo = RichInfo (mkRichInfoAssocList [RichField "Platforms" "OpenBSD; Plan9"])
+      richInfoOverwritten = RichInfo (mkRichInfoAssocList [RichField "Platforms" "Windows10"])
+      richInfoPatchedMap = RichInfo (mkRichInfoAssocList [RichField "Platforms" "Arch, BTW"])
+      richInfoPatchedList = RichInfo (mkRichInfoAssocList [RichField "Platforms" "none"])
       (Aeson.Success patchOpMap) =
         fromJSON
           [aesonQQ|{

diff --git a/services/spar/test/Test/Spar/ScimSpec.hs b/services/spar/test/Test/Spar/ScimSpec.hs
@@ -278,7 +278,7 @@ spec = describe "toScimStoredUser'" $ do
         normalizeLikeStored usr `shouldBe` usr
 
       it "keeps user record intact (property)" . property $
-        \(WithNormalizedRichFields (usr' :: (Scim.User SparTag))) -> counterexample (show usr') $ do
+        \(usr' :: (Scim.User SparTag)) -> counterexample (show usr') $ do
           normalizeLikeStored usr' `shouldBe` usr'
 
     describe "'toRichInfoAssocList', 'fromRichInfoAssocList'" $ do
@@ -287,15 +287,19 @@ spec = describe "toScimStoredUser'" $ do
             y = (fromRichInfoAssocList . toRichInfoAssocList) x
         toRichInfoAssocList x `shouldBe` toRichInfoAssocList y
 
-      it "works (counter-example of earlier bug)" $ 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
+      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
 
-        jsonroundtrip assocs `shouldBe` assocs
-        (toRichInfoAssocList . fromRichInfoAssocList) assocs `shouldBe` assocs
-        (toRichInfoAssocList . jsonroundtrip . fromRichInfoAssocList) assocs `shouldBe` assocs
+      it "works (counter-example of earlier bug)" $
+        testcase assocs
 
-      it "works (property)" $ do
-        pendingWith "TODO"
+      it "works (property)" . property $
+        testcase