genvalidity-mergeful 0.1.0.0 → 0.2.0.0

raw patch · 10 files changed

+890/−569 lines, 10 filesdep +criteriondep +genvalidity-criteriondep ~basePVP ok

version bump matches the API change (PVP)

Dependencies added: criterion, genvalidity-criterion

Dependency ranges changed: base

API changes (from Hackage documentation)

Files

• bench/Bench.hs +44/−0
• genvalidity-mergeful.cabal +22/−6
• src/Data/GenValidity/Mergeful/Collection.hs +43/−25
• src/Data/GenValidity/Mergeful/Item.hs +6/−2
• src/Data/GenValidity/Mergeful/Timed.hs +7/−2
• src/Data/GenValidity/Mergeful/Value.hs +10/−4
• test/Data/Mergeful/CollectionSpec.hs +497/−338
• test/Data/Mergeful/ItemSpec.hs +220/−157
• test/Data/Mergeful/TimedSpec.hs +5/−6
• test/Data/Mergeful/ValueSpec.hs +36/−29

@@ -0,0 +1,44 @@+{-# LANGUAGE AllowAmbiguousTypes #-}+{-# LANGUAGE ScopedTypeVariables #-}+{-# LANGUAGE TypeApplications #-}++module Main where++import Criterion.Main as Criterion+import Data.GenValidity.Criterion+import Data.GenValidity.Mergeful ()+import Data.Mergeful.Collection+import Data.Mergeful.Item+import Data.Mergeful.Value++main :: IO ()+main =+  Criterion.defaultMain+    [ bgroup "Utils" [genValidBench @ServerTime, genValidBench @(Timed Bool)],+      bgroup+        "Value"+        [ genValidBench @ChangedFlag,+          genValidBench @(ValueMergeResult Bool),+          genValidBench @(ClientValue Bool),+          genValidBench @(ValueSyncRequest Bool),+          genValidBench @(ValueSyncResponse Bool),+          genValidBench @(ServerValue Bool)+        ],+      bgroup+        "Item"+        [ genValidBench @(ItemMergeResult Bool),+          genValidBench @(ClientItem Bool),+          genValidBench @(ItemSyncRequest Bool),+          genValidBench @(ItemSyncResponse Bool),+          genValidBench @(ServerItem Bool)+        ],+      bgroup+        "Collection"+        [ genValidBench @ClientId,+          genValidBench @(ClientStore ClientId Int Bool),+          genValidBench @(SyncRequest ClientId Int Bool),+          genValidBench @(ClientAddition Int),+          genValidBench @(SyncResponse ClientId Int Bool),+          genValidBench @(ServerStore Int Bool)+        ]+    ]

@@ -1,19 +1,19 @@ cabal-version: 1.12 --- This file has been generated from package.yaml by hpack version 0.31.2.+-- This file has been generated from package.yaml by hpack version 0.33.0. -- -- see: https://github.com/sol/hpack ----- hash: 86196b99586836b920b517c4273efac7cc705762e7ff8c445e911cfdafe35620+-- hash: cab74b20dcf0eadc6956a8ce9d4325af4494785285a9b5a43aa8fda713de2bb1  name:           genvalidity-mergeful-version:        0.1.0.0+version:        0.2.0.0 description:    Please see the README on GitHub at <https://github.com/NorfairKing/mergeful#readme> homepage:       https://github.com/NorfairKing/mergeful#readme bug-reports:    https://github.com/NorfairKing/mergeful/issues author:         Tom Sydney Kerckhove maintainer:     syd@cs-syd.eu-copyright:      Copyright: (c) 2019 Tom Sydney Kerckhove+copyright:      Copyright: (c) 2019-2020 Tom Sydney Kerckhove license:        MIT license-file:   LICENSE build-type:     Simple@@ -38,7 +38,7 @@       src   build-depends:       QuickCheck-    , base >=4.7 && <5+    , base <5     , containers     , genvalidity     , genvalidity-containers@@ -60,7 +60,7 @@   ghc-options: -threaded -rtsopts -with-rtsopts=-N   build-depends:       QuickCheck-    , base >=4.7 && <5+    , base <5     , containers     , genvalidity-hspec     , genvalidity-hspec-aeson@@ -73,4 +73,20 @@     , random     , time     , uuid+  default-language: Haskell2010++benchmark mergeful-bench+  type: exitcode-stdio-1.0+  main-is: Bench.hs+  other-modules:+      Paths_genvalidity_mergeful+  hs-source-dirs:+      bench+  ghc-options: -threaded -rtsopts -with-rtsopts=-N+  build-depends:+      base <5+    , criterion+    , genvalidity-criterion+    , genvalidity-mergeful+    , mergeful   default-language: Haskell2010

@@ -1,35 +1,36 @@ {-# LANGUAGE RecordWildCards #-}+{-# LANGUAGE ScopedTypeVariables #-} {-# OPTIONS_GHC -fno-warn-orphans #-}  module Data.GenValidity.Mergeful.Collection where +import Data.GenValidity+import Data.GenValidity.Containers ()+import Data.GenValidity.Mergeful.Item ()+import Data.GenValidity.Time () import Data.Map (Map) import qualified Data.Map as M+import Data.Mergeful import Data.Set (Set) import qualified Data.Set as S- import Data.Traversable--import Data.GenValidity-import Data.GenValidity.Containers ()-import Data.GenValidity.Time ()- import Test.QuickCheck -import Data.GenValidity.Mergeful.Item ()--import Data.Mergeful- instance GenUnchecked ClientId  instance GenValid ClientId -instance (GenUnchecked i, Ord i, GenUnchecked a) => GenUnchecked (ClientStore i a)+instance+  (GenUnchecked ci, GenUnchecked si, Ord ci, Ord si, GenUnchecked a) =>+  GenUnchecked (ClientStore ci si a) -instance (GenValid i, Show i, Ord i, GenValid a) => GenValid (ClientStore i a) where+instance+  (GenValid ci, GenValid si, Show ci, Show si, Ord ci, Ord si, GenValid a) =>+  GenValid (ClientStore ci si a)+  where   genValid =     (`suchThat` isValid) $ do-      identifiers <- scale (* 3) genValid+      identifiers <- genValid       (s1, s2) <- splitSet identifiers       (s3, s4) <- splitSet s1       clientStoreAddedItems <- genValid@@ -39,18 +40,23 @@       pure ClientStore {..}   shrinkValid = shrinkValidStructurally -instance (GenUnchecked i, Ord i, GenUnchecked a) => GenUnchecked (ServerStore i a)+instance (GenUnchecked si, Ord si, GenUnchecked a) => GenUnchecked (ServerStore si a) -instance (GenValid i, Show i, Ord i, GenValid a) => GenValid (ServerStore i a) where+instance (GenValid si, Show si, Ord si, GenValid a) => GenValid (ServerStore si a) where   genValid = genValidStructurallyWithoutExtraChecking   shrinkValid = shrinkValidStructurallyWithoutExtraFiltering -instance (GenUnchecked i, Ord i, GenUnchecked a) => GenUnchecked (SyncRequest i a)+instance+  (GenUnchecked ci, GenUnchecked si, Ord ci, Ord si, GenUnchecked a) =>+  GenUnchecked (SyncRequest ci si a) -instance (GenValid i, Show i, Ord i, GenValid a) => GenValid (SyncRequest i a) where+instance+  (GenValid ci, GenValid si, Show ci, Show si, Ord ci, Ord si, GenValid a) =>+  GenValid (SyncRequest ci si a)+  where   genValid =     (`suchThat` isValid) $ do-      identifiers <- scale (* 3) genValid+      identifiers <- genValid       (s1, s2) <- splitSet identifiers       (s3, s4) <- splitSet s1       syncRequestNewItems <- genValid@@ -60,12 +66,23 @@       pure SyncRequest {..}   shrinkValid = shrinkValidStructurally -instance (GenUnchecked i, Ord i, GenUnchecked a) => GenUnchecked (SyncResponse i a)+instance GenUnchecked si => GenUnchecked (ClientAddition si) -instance (GenValid i, Show i, Ord i, GenValid a) => GenValid (SyncResponse i a) where+instance GenValid si => GenValid (ClientAddition si) where+  genValid = genValidStructurallyWithoutExtraChecking+  shrinkValid = shrinkValidStructurallyWithoutExtraFiltering++instance+  (GenUnchecked ci, GenUnchecked si, Ord ci, Ord si, GenUnchecked a) =>+  GenUnchecked (SyncResponse ci si a)++instance+  (GenValid ci, GenValid si, Show ci, Show si, Ord ci, Ord si, GenValid a) =>+  GenValid (SyncResponse ci si a)+  where   genValid =     (`suchThat` isValid) $ do-      identifiers <- scale (* 10) genValid+      identifiers <- scale (* 2) genValid       (s01, s02) <- splitSet identifiers       (s03, s04) <- splitSet s01       (s05, s06) <- splitSet s02@@ -75,10 +92,11 @@       (s13, s14) <- splitSet s06       (s15, s16) <- splitSet s07       syncResponseClientAdded <--        do m <- genValid :: Gen (Map ClientId ())-           if S.null s08-             then pure M.empty-             else forM m $ \() -> (,) <$> elements (S.toList s08) <*> genValid+        do+          m <- genValid :: Gen (Map ci ())+          if S.null s08+            then pure M.empty+            else forM m $ \() -> ClientAddition <$> elements (S.toList s08) <*> genValid       syncResponseClientChanged <- mapWithIds s09       let syncResponseClientDeleted = s10       syncResponseServerAdded <- mapWithIds s11

@@ -3,10 +3,14 @@ module Data.GenValidity.Mergeful.Item where  import Data.GenValidity-+import Data.GenValidity.Mergeful.Timed () import Data.Mergeful.Item -import Data.GenValidity.Mergeful.Timed ()+instance GenUnchecked a => GenUnchecked (ItemMergeResult a)++instance GenValid a => GenValid (ItemMergeResult a) where+  genValid = genValidStructurallyWithoutExtraChecking+  shrinkValid = shrinkValidStructurallyWithoutExtraFiltering  instance GenUnchecked a => GenUnchecked (ClientItem a) 

@@ -3,8 +3,8 @@ module Data.GenValidity.Mergeful.Timed where  import Data.GenValidity- import Data.Mergeful.Timed+import Test.QuickCheck  instance GenUnchecked a => GenUnchecked (Timed a) @@ -15,5 +15,10 @@ instance GenUnchecked ServerTime  instance GenValid ServerTime where-  genValid = genValidStructurallyWithoutExtraChecking+  genValid = ServerTime <$> arbitrary++  -- Use the quickcheck generator to produce Word64s+  -- This will hide the failures around maxBound for Word64+  -- but that's fine in this case.+  -- See also the comment for the 'ServerTime' constructor.   shrinkValid = shrinkValidStructurallyWithoutExtraFiltering

@@ -3,14 +3,20 @@ module Data.GenValidity.Mergeful.Value where  import Data.GenValidity--import Data.Mergeful.Value- import Data.GenValidity.Mergeful.Timed ()+import Data.Mergeful.Value  instance GenUnchecked ChangedFlag -instance GenValid ChangedFlag+instance GenValid ChangedFlag where+  genValid = genValidStructurallyWithoutExtraChecking+  shrinkValid = shrinkValidStructurallyWithoutExtraFiltering++instance GenUnchecked a => GenUnchecked (ValueMergeResult a)++instance GenValid a => GenValid (ValueMergeResult a) where+  genValid = genValidStructurallyWithoutExtraChecking+  shrinkValid = shrinkValidStructurallyWithoutExtraFiltering  instance GenUnchecked a => GenUnchecked (ClientValue a) 

@@ -2,295 +2,247 @@ {-# LANGUAGE GeneralizedNewtypeDeriving #-} {-# LANGUAGE RankNTypes #-} {-# LANGUAGE RecordWildCards #-}+{-# LANGUAGE ScopedTypeVariables #-} {-# LANGUAGE TypeApplications #-}  module Data.Mergeful.CollectionSpec-  ( spec-  ) where+  ( spec,+  )+where +import Control.Monad.State import Data.Functor.Identity+import Data.GenValidity.Mergeful ()+import Data.GenValidity.Mergeful.Item ()+import Data.GenValidity.UUID () import Data.List import qualified Data.Map as M+import Data.Mergeful import qualified Data.Set as S import Data.UUID import GHC.Generics (Generic) import System.Random-import Text.Show.Pretty--import Control.Monad.State- import Test.Hspec+import Test.Hspec.QuickCheck import Test.QuickCheck import Test.Validity import Test.Validity.Aeson--import Data.GenValidity.UUID ()--import Data.Mergeful-import Data.Mergeful.Timed--import Data.GenValidity.Mergeful ()-import Data.GenValidity.Mergeful.Item ()+import Text.Show.Pretty  {-# ANN module ("HLint: ignore Reduce duplication" :: String) #-}  spec :: Spec-spec = do+spec = modifyMaxShrinks (min 0) $ do   genValidSpec @ClientId   jsonSpecOnValid @ClientId-  genValidSpec @(ClientStore Int Int)-  jsonSpecOnValid @(ClientStore Int Int)+  genValidSpec @(ClientStore ClientId Int Int)+  jsonSpecOnValid @(ClientStore ClientId Int Int)   genValidSpec @(ServerStore Int Int)   jsonSpecOnValid @(ServerStore Int Int)-  genValidSpec @(SyncRequest Int Int)-  jsonSpecOnValid @(SyncRequest Int Int)-  genValidSpec @(SyncResponse Int Int)-  jsonSpecOnValid @(SyncResponse Int Int)-  describe "initialClientStore" $ it "is valid" $ shouldBeValid $ initialClientStore @Int @Int+  genValidSpec @(SyncRequest ClientId Int Int)+  jsonSpecOnValid @(SyncRequest ClientId Int Int)+  genValidSpec @(ClientAddition Int)+  jsonSpecOnValid @(ClientAddition Int)+  genValidSpec @(SyncResponse ClientId Int Int)+  jsonSpecOnValid @(SyncResponse ClientId Int Int)+  describe "initialClientStore"+    $ it "is valid"+    $ shouldBeValid+    $ initialClientStore @ClientId @Int @Int   describe "addItemToClientStore" $ do-    it "produces valid stores" $ producesValidsOnValids2 (addItemToClientStore @Int @Int)-    it "makes the client store one bigger" $-      forAllValid $ \cs ->+    it "produces valid stores" $ producesValidsOnValids2 (addItemToClientStore @ClientId @Int @Int)+    it "makes the client store one bigger"+      $ forAllValid+      $ \cs ->         forAllValid $ \a ->-          clientStoreSize @Int @Int (addItemToClientStore a cs) `shouldBe` (clientStoreSize cs + 1)-    it "ensures that the added item is in fact in the result" $-      forAllValid $ \cs ->+          clientStoreSize @ClientId @Int @Int (addItemToClientStore a cs)+            `shouldBe` (clientStoreSize cs + 1)+    it "ensures that the added item is in fact in the result"+      $ forAllValid+      $ \cs ->         forAllValid $ \a ->-          let cs' = addItemToClientStore @Int @Int a cs+          let cs' = addItemToClientStore @ClientId @Int @Int a cs            in a `elem` clientStoreAddedItems cs'   describe "markItemDeletedInClientStore" $ do-    it "produces valid stores" $ producesValidsOnValids2 (markItemDeletedInClientStore @Int @Int)+    it "produces valid stores" $+      producesValidsOnValids2 (markItemDeletedInClientStore @ClientId @Int @Int)     it "makes the client store one smaller" $       let p cs = S.size (clientStoreUndeletedSyncIdSet cs) > 0        in forAllShrink (genValid `suchThat` p) (filter p . shrinkValid) $ \cs ->             forAll (elements $ S.toList $ clientStoreUndeletedSyncIdSet cs) $ \i ->-              (clientStoreSize @Int @Int (markItemDeletedInClientStore i cs) + 1) `shouldBe`-              clientStoreSize cs+              (clientStoreSize @ClientId @Int @Int (markItemDeletedInClientStore i cs) + 1)+                `shouldBe` clientStoreSize cs     it "ensures that the added item is in fact not in the result" $       let p cs = S.size (clientStoreUndeletedSyncIdSet cs) > 0        in forAllShrink (genValid `suchThat` p) (filter p . shrinkValid) $ \cs ->             forAll (elements $ S.toList $ clientStoreUndeletedSyncIdSet cs) $ \i ->-              let cs' = markItemDeletedInClientStore @Int @Int i cs+              let cs' = markItemDeletedInClientStore @ClientId @Int @Int i cs                in M.lookup (Right i) (clientStoreItems cs') `shouldBe` Nothing   describe "changeItemInClientStore" $ do-    it "produces valid stores" $ producesValidsOnValids3 (changeItemInClientStore @Int @Int)+    it "produces valid stores" $+      producesValidsOnValids3 (changeItemInClientStore @ClientId @Int @Int)     it "doesn't change the size of the client store" $       let p cs = S.size (clientStoreUndeletedSyncIdSet cs) > 0        in forAllShrink (genValid `suchThat` p) (filter p . shrinkValid) $ \cs ->             forAll (elements $ S.toList $ clientStoreUndeletedSyncIdSet cs) $ \i ->               forAllValid $ \a ->-                clientStoreSize @Int @Int (changeItemInClientStore i a cs) `shouldBe`-                clientStoreSize cs+                clientStoreSize @ClientId @Int @Int (changeItemInClientStore i a cs)+                  `shouldBe` clientStoreSize cs     it "ensures that the changed item is in fact in the result" $       let p cs = S.size (clientStoreUndeletedSyncIdSet cs) > 0        in forAllShrink (genValid `suchThat` p) (filter p . shrinkValid) $ \cs ->             forAll (elements $ S.toList $ clientStoreUndeletedSyncIdSet cs) $ \i ->               forAllValid $ \a ->-                let cs' = changeItemInClientStore @Int @Int i a cs+                let cs' = changeItemInClientStore @ClientId @Int @Int i a cs                  in M.lookup (Right i) (clientStoreItems cs') `shouldBe` Just a   describe "deleteItemFromClientStore" $ do-    it "produces valid stores" $ producesValidsOnValids2 (deleteItemFromClientStore @Int @Int)+    it "produces valid stores" $+      producesValidsOnValids2 (deleteItemFromClientStore @ClientId @Int @Int)     it "makes the client store one smaller" $       let p cs = S.size (clientStoreClientIdSet cs) > 0        in forAllShrink (genValid `suchThat` p) (filter p . shrinkValid) $ \cs ->             forAll (elements $ S.toList $ clientStoreClientIdSet cs) $ \cid ->-              (clientStoreSize @Int @Int (deleteItemFromClientStore cid cs) + 1) `shouldBe`-              clientStoreSize cs+              (clientStoreSize @ClientId @Int @Int (deleteItemFromClientStore cid cs) + 1)+                `shouldBe` clientStoreSize cs   describe "initialServerStore" $ it "is valid" $ shouldBeValid $ initialServerStore @Int @Int-  describe "initialSyncRequest" $ it "is valid" $ shouldBeValid $ initialSyncRequest @Int @Int-  describe "emptySyncResponse" $ it "is valid" $ shouldBeValid $ emptySyncResponse @Int @Int-  describe "makeSyncRequest" $-    it "produces valid requests" $ producesValidsOnValids (makeSyncRequest @Int @Int)-  describe "mergeAddedItems" $-    it "produces valid results" $ producesValidsOnValids2 (mergeAddedItems @Int @Int)-  describe "mergeSyncedButChangedItems" $-    it "produces valid results" $ producesValidsOnValids2 (mergeSyncedButChangedItems @Int @Int)-  describe "mergeAddedItems" $-    it "produces valid results" $ producesValidsOnValids2 (mergeAddedItems @Int @Int)-  describe "mergeSyncedButChangedItems" $-    it "produces valid results" $ producesValidsOnValids2 (mergeSyncedButChangedItems @Int @Int)-  describe "mergeDeletedItems" $-    it "produces valid results" $ producesValidsOnValids2 (mergeDeletedItems @Int @Int)-  describe "mergeSyncResponseIgnoreProblems" $-    it "produces valid requests" $-    forAllValid $ \store ->-      forAllValid $ \response ->-        let res = mergeSyncResponseIgnoreProblems @Int @Int store response-         in case prettyValidate res of-              Right _ -> pure ()-              Left err ->-                expectationFailure $-                unlines-                  [ "Store:"-                  , ppShow store-                  , "Response:"-                  , ppShow response-                  , "Invalid result:"-                  , ppShow res-                  , "error:"-                  , err-                  ]-  describe "processServerSync" $-    it "produces valid tuples of a response and a store" $-    producesValidsOnValids2-      (\store request -> evalD $ processServerSync genD (store :: ServerStore UUID Int) request)-  describe "Syncing with mergeSyncResponseIgnoreProblems" $ do-    mergeFunctionSpec @Int mergeSyncResponseIgnoreProblems-    it "does not lose data after a conflict occurs" $-      forAllValid $ \uuid ->-        forAllValid $ \time1 ->-          forAllValid $ \i1 ->-            forAllValid $ \i2 ->-              forAllValid $ \i3 ->-                evalDM $ do-                  let sstore1 =-                        ServerStore-                          {serverStoreItems = M.singleton (uuid :: UUID) (Timed (i1 :: Int) time1)}-                      -- The server has an item-                      -- The first client has synced it, and modified it.-                  let cAstore1 =-                        initialClientStore-                          {clientStoreSyncedButChangedItems = M.singleton uuid (Timed i2 time1)}-                      -- The second client has synced it too, and modified it too.-                  let cBstore1 =-                        initialClientStore-                          {clientStoreSyncedButChangedItems = M.singleton uuid (Timed i3 time1)}-                      -- Client A makes sync request 1-                  let req1 = makeSyncRequest cAstore1-                      -- The server processes sync request 1-                  (resp1, sstore2) <- processServerSync genD sstore1 req1-                  let time2 = incrementServerTime time1-                      -- The server updates the item accordingly-                  lift $ do-                    resp1 `shouldBe`-                      (emptySyncResponse {syncResponseClientChanged = M.singleton uuid time2})-                    sstore2 `shouldBe`-                      (ServerStore {serverStoreItems = M.singleton uuid (Timed i2 time2)})-                      -- Client A merges the response-                  let cAstore2 = mergeSyncResponseIgnoreProblems cAstore1 resp1-                  lift $-                    cAstore2 `shouldBe`-                    (initialClientStore {clientStoreSyncedItems = M.singleton uuid (Timed i2 time2)})-                      -- Client B makes sync request 2-                  let req2 = makeSyncRequest cBstore1-                      -- The server processes sync request 2-                  (resp2, sstore3) <- processServerSync genD sstore2 req2-                      -- The server reports a conflict and does not change its store-                  lift $ do-                    resp2 `shouldBe`-                      (emptySyncResponse {syncResponseConflicts = M.singleton uuid (Timed i2 time2)})-                    sstore3 `shouldBe` sstore2-                      -- Client B merges the response-                  let cBstore2 = mergeSyncResponseIgnoreProblems cBstore1 resp2-                      -- Client does not update, but keeps its conflict-                  lift $-                    cBstore2 `shouldBe`-                    (initialClientStore-                       {clientStoreSyncedButChangedItems = M.singleton uuid (Timed i3 time1)})-                      -- Client A and Client B now *do not* have the same store+  describe "initialSyncRequest"+    $ it "is valid"+    $ shouldBeValid+    $ initialSyncRequest @ClientId @Int @Int+  describe "emptySyncResponse"+    $ it "is valid"+    $ shouldBeValid+    $ emptySyncResponse @ClientId @Int @Int+  describe "makeSyncRequest"+    $ it "produces valid requests"+    $ producesValidsOnValids (makeSyncRequest @ClientId @Int @Int)+  describe "mergeAddedItems"+    $ it "produces valid results"+    $ producesValidsOnValids2 (mergeAddedItems @ClientId @Int @Int)+  describe "mergeSyncedButChangedItems"+    $ it "produces valid results"+    $ producesValidsOnValids2 (mergeSyncedButChangedItems @Int @Int)+  describe "mergeDeletedItems"+    $ it "produces valid results"+    $ producesValidsOnValids2 (mergeDeletedItems @Int @Int)+  xdescribe "There must not be id conflicts" $ do+    describe "mergeSyncResponseFromServer"+      $ it "produces valid requests"+      $ forAllValid+      $ \store ->+        forAllValid $ \response ->+          let res = mergeSyncResponseFromServer @ClientId @Int @Int store response+           in case prettyValidate res of+                Right _ -> pure ()+                Left err ->+                  expectationFailure $+                    unlines+                      [ "Store:",+                        ppShow store,+                        "Response:",+                        ppShow response,+                        "Invalid result:",+                        ppShow res,+                        "error:",+                        err+                      ]+    describe "mergeSyncResponseFromClient"+      $ it "produces valid requests"+      $ forAllValid+      $ \store ->+        forAllValid $ \response ->+          let res = mergeSyncResponseFromClient @ClientId @Int @Int store response+           in case prettyValidate res of+                Right _ -> pure ()+                Left err ->+                  expectationFailure $+                    unlines+                      [ "Store:",+                        ppShow store,+                        "Response:",+                        ppShow response,+                        "Invalid result:",+                        ppShow res,+                        "error:",+                        err+                      ]+    describe "mergeSyncResponseUsingCRDT"+      $ it "produces valid requests"+      $ forAllValid+      $ \store ->+        forAllValid $ \response ->+          let res = mergeSyncResponseUsingCRDT @ClientId @Int @Int max store response+           in case prettyValidate res of+                Right _ -> pure ()+                Left err ->+                  expectationFailure $+                    unlines+                      [ "Store:",+                        ppShow store,+                        "Response:",+                        ppShow response,+                        "Invalid result:",+                        ppShow res,+                        "error:",+                        err+                      ]+  describe "processServerSync"+    $ it "produces valid tuples of a response and a store"+    $ producesValidsOnValids2+      ( \store request ->+          evalD $ processServerSync @ClientId @UUID genD (store :: ServerStore UUID Int) request+      )+  describe "Syncing with mergeSyncResponseFromClient" $ do+    let strat = mergeFromClientStrategy+    helperFunctionsSpec strat+    mergeFunctionSpec @Int strat+    noDataLossSpec @Int strat+    xdescribe "does not hold" $ do+      emptyResponseSpec @Int strat+      noDivergenceSpec @Int strat   describe "Syncing with mergeSyncResponseFromServer" $ do-    mergeFunctionSpec @Int mergeSyncResponseFromServer-    describe "mergeSyncResponseFromServer" $-      it "only differs from mergeSyncResponseIgnoreProblems on conflicts" $-      forAllValid $ \cstore ->-        forAllValid $ \sresp@SyncResponse {..} -> do-          let cstoreA = mergeSyncResponseFromServer (cstore :: ClientStore UUID Int) sresp-              cstoreB = mergeSyncResponseIgnoreProblems cstore sresp-          if cstoreA == cstoreB-            then pure ()-            else unless-                   (or-                      [ not (M.null syncResponseConflicts)-                      , not (M.null syncResponseConflictsClientDeleted)-                      , not (S.null syncResponseConflictsServerDeleted)-                      ]) $-                 expectationFailure $-                 unlines-                   [ "There was a difference between mergeSyncResponseFromServer and mergeSyncResponseIgnoreProblems that was somehow unrelated to the conflicts:"-                   , "syncResponseConflicts:"-                   , ppShow syncResponseConflicts-                   , "syncResponseConflictsClientDeleted:"-                   , ppShow syncResponseConflictsClientDeleted-                   , "syncResponseConflictsServerDeleted:"-                   , ppShow syncResponseConflictsServerDeleted-                   , "client store after mergeSyncResponseFromServer:"-                   , ppShow cstoreA-                   , "client store after mergeSyncResponseIgnoreProblems:"-                   , ppShow cstoreB-                   ]-    it "does not diverge after a conflict occurs" $-      forAllValid $ \uuid ->-        forAllValid $ \time1 ->-          forAllValid $ \i1 ->-            forAllValid $ \i2 ->-              forAllValid $ \i3 ->-                evalDM $ do-                  let sstore1 =-                        ServerStore-                          {serverStoreItems = M.singleton (uuid :: UUID) (Timed (i1 :: Int) time1)}-                      -- The server has an item-                      -- The first client has synced it, and modified it.-                  let cAstore1 =-                        initialClientStore-                          {clientStoreSyncedButChangedItems = M.singleton uuid (Timed i2 time1)}-                      -- The second client has synced it too, and modified it too.-                  let cBstore1 =-                        initialClientStore-                          {clientStoreSyncedButChangedItems = M.singleton uuid (Timed i3 time1)}-                      -- Client A makes sync request 1-                  let req1 = makeSyncRequest cAstore1-                      -- The server processes sync request 1-                  (resp1, sstore2) <- processServerSync genD sstore1 req1-                  let time2 = incrementServerTime time1-                      -- The server updates the item accordingly-                  lift $ do-                    resp1 `shouldBe`-                      (emptySyncResponse {syncResponseClientChanged = M.singleton uuid time2})-                    sstore2 `shouldBe`-                      (ServerStore {serverStoreItems = M.singleton uuid (Timed i2 time2)})-                      -- Client A merges the response-                  let cAstore2 = mergeSyncResponseFromServer cAstore1 resp1-                  lift $-                    cAstore2 `shouldBe`-                    (initialClientStore {clientStoreSyncedItems = M.singleton uuid (Timed i2 time2)})-                      -- Client B makes sync request 2-                  let req2 = makeSyncRequest cBstore1-                      -- The server processes sync request 2-                  (resp2, sstore3) <- processServerSync genD sstore2 req2-                      -- The server reports a conflict and does not change its store-                  lift $ do-                    resp2 `shouldBe`-                      (emptySyncResponse {syncResponseConflicts = M.singleton uuid (Timed i2 time2)})-                    sstore3 `shouldBe` sstore2-                      -- Client B merges the response-                  let cBstore2 = mergeSyncResponseFromServer cBstore1 resp2-                      -- Client does not update, but keeps its conflict-                  lift $ do-                    cBstore2 `shouldBe`-                      (initialClientStore-                         {clientStoreSyncedItems = M.singleton uuid (Timed i2 time2)})-                        -- Client A and Client B now have the same store-                    cBstore2 `shouldBe` cAstore2-  describe "Syncing with mergeSyncResponseUsingStrategy with a GCounter" $-    mergeFunctionSpec @Int $-    mergeSyncResponseUsingStrategy-      ItemMergeStrategy-        { itemMergeStrategyMergeChangeConflict =-            \clientItem (Timed serverItem t) -> Timed (max clientItem serverItem) t-        , itemMergeStrategyMergeClientDeletedConflict = \serverItem -> Just serverItem-        , itemMergeStrategyMergeServerDeletedConflict = \_ -> Nothing-        }+    let strat = mergeFromServerStrategy+    helperFunctionsSpec strat+    mergeFunctionSpec @Int strat+    noDivergenceSpec @Int strat+    emptyResponseSpec @Int strat+    noDifferentExceptForConflicts @Int strat mergeFromClientStrategy+    xdescribe "does not hold" $ noDataLossSpec @Int strat+  describe "Syncing with mergeSyncResponseUsingStrategy with a GCounter" $ do+    let strat = mergeUsingCRDTStrategy max+    helperFunctionsSpec strat+    mergeFunctionSpec strat+    noDataLossSpec strat+    noDivergenceSpec strat+    emptyResponseSpec strat+    noDifferentExceptForConflicts strat mergeFromClientStrategy+    noDifferentExceptForConflicts strat mergeFromServerStrategy +helperFunctionsSpec :: ItemMergeStrategy Int -> Spec+helperFunctionsSpec ItemMergeStrategy {..} = do+  describe "mergeSyncedButChangedConflicts"+    $ it "produces valid results"+    $ producesValidsOnValids2 (mergeSyncedButChangedConflicts @Int @Int itemMergeStrategyMergeChangeConflict)+  describe "mergeClientDeletedConflicts"+    $ it "produces valid results"+    $ producesValidsOnValids (mergeClientDeletedConflicts @Int @Int itemMergeStrategyMergeClientDeletedConflict)+  describe "mergeServerDeletedConflicts"+    $ it "produces valid results"+    $ producesValidsOnValids (mergeServerDeletedConflicts @Int @Int itemMergeStrategyMergeServerDeletedConflict)+ mergeFunctionSpec ::-     forall a. (Show a, Ord a, GenValid a)-  => (forall i. Ord i =>-                  ClientStore i a -> SyncResponse i a -> ClientStore i a)-  -> Spec-mergeFunctionSpec mergeFunc = do-  describe "Single client" $-    describe "Multi-item" $ do-      it "succesfully downloads everything from the server for an empty client" $-        forAllValid $ \sstore1 ->+  forall a.+  (Show a, Ord a, GenValid a) =>+  ItemMergeStrategy a ->+  Spec+mergeFunctionSpec strat = do+  let mergeFunc = mergeSyncResponseUsingStrategy strat+  describe "Single client"+    $ describe "Multi-item"+    $ do+      it "succesfully downloads everything from the server for an empty client"+        $ forAllValid+        $ \sstore1 ->           evalDM $ do             let cstore1 = initialClientStore             let req = makeSyncRequest cstore1@@ -299,8 +251,9 @@             lift $ do               sstore2 `shouldBe` sstore1               clientStoreSyncedItems cstore2 `shouldBe` serverStoreItems sstore2-      it "succesfully uploads everything to the server for an empty server" $-        forAllValid $ \items ->+      it "succesfully uploads everything to the server for an empty server"+        $ forAllValid+        $ \items ->           evalDM $ do             let cstore1 = initialClientStore {clientStoreAddedItems = items}             let sstore1 = initialServerStore@@ -308,11 +261,12 @@             (resp, sstore2) <- processServerSync genD sstore1 req             let cstore2 = mergeFunc cstore1 resp             lift $ do-              sort (M.elems (M.map timedValue (clientStoreSyncedItems cstore2))) `shouldBe`-                sort (M.elems items)+              sort (M.elems (M.map timedValue (clientStoreSyncedItems cstore2)))+                `shouldBe` sort (M.elems items)               clientStoreSyncedItems cstore2 `shouldBe` serverStoreItems sstore2-      it "is idempotent with one client" $-        forAllValid $ \cstore1 ->+      it "is idempotent with one client"+        $ forAllValid+        $ \cstore1 ->           forAllValid $ \sstore1 ->             evalDM $ do               let req1 = makeSyncRequest cstore1@@ -326,262 +280,467 @@                 sstore2 `shouldBe` sstore3   describe "Multiple clients" $ do     describe "Single-item" $ do-      it "successfully syncs an addition accross to a second client" $-        forAllValid $ \i ->+      it "successfully syncs an addition accross to a second client"+        $ forAllValid+        $ \i ->           evalDM $ do             let cAstore1 = initialClientStore {clientStoreAddedItems = M.singleton (ClientId 0) i}-              -- Client B is empty+            -- Client B is empty             let cBstore1 = initialClientStore-              -- The server is empty+            -- The server is empty             let sstore1 = initialServerStore-              -- Client A makes sync request 1+            -- Client A makes sync request 1             let req1 = makeSyncRequest cAstore1-              -- The server processes sync request 1+            -- The server processes sync request 1             (resp1, sstore2) <- processServerSync genD sstore1 req1             let addedItems = syncResponseClientAdded resp1             case M.toList addedItems of-              [(ClientId 0, (uuid, st))] -> do+              [(ClientId 0, ClientAddition uuid st)] -> do                 let time = initialServerTime                 lift $ st `shouldBe` time                 let items = M.singleton uuid (Timed i st)                 lift $ sstore2 `shouldBe` (ServerStore {serverStoreItems = items})-                  -- Client A merges the response+                -- Client A merges the response                 let cAstore2 = mergeFunc cAstore1 resp1                 lift $ cAstore2 `shouldBe` (initialClientStore {clientStoreSyncedItems = items})-                  -- Client B makes sync request 2+                -- Client B makes sync request 2                 let req2 = makeSyncRequest cBstore1-                  -- The server processes sync request 2+                -- The server processes sync request 2                 (resp2, sstore3) <- processServerSync genD sstore2 req2                 lift $ do                   resp2 `shouldBe` (emptySyncResponse {syncResponseServerAdded = items})                   sstore3 `shouldBe` sstore2-                  -- Client B merges the response+                -- Client B merges the response                 let cBstore2 = mergeFunc cBstore1 resp2                 lift $ cBstore2 `shouldBe` (initialClientStore {clientStoreSyncedItems = items})-                  -- Client A and Client B now have the same store+                -- Client A and Client B now have the same store                 lift $ cAstore2 `shouldBe` cBstore2               _ -> lift $ expectationFailure "Should have found exactly one added item."-      it "successfully syncs a modification accross to a second client" $-        forAllValid $ \uuid ->+      it "successfully syncs a modification accross to a second client"+        $ forAllValid+        $ \uuid ->           forAllValid $ \i ->             forAllValid $ \j ->               forAllValid $ \time1 ->                 evalDM $ do                   let cAstore1 =                         initialClientStore-                          {clientStoreSyncedItems = M.singleton uuid (Timed i time1)}-                    -- Client B had synced that same item, but has since modified it+                          { clientStoreSyncedItems = M.singleton uuid (Timed i time1)+                          }+                  -- Client B had synced that same item, but has since modified it                   let cBstore1 =                         initialClientStore-                          {clientStoreSyncedButChangedItems = M.singleton uuid (Timed j time1)}-                    -- The server is has the item that both clients had before+                          { clientStoreSyncedButChangedItems = M.singleton uuid (Timed j time1)+                          }+                  -- The server is has the item that both clients had before                   let sstore1 = ServerStore {serverStoreItems = M.singleton uuid (Timed i time1)}-                    -- Client B makes sync request 1+                  -- Client B makes sync request 1                   let req1 = makeSyncRequest cBstore1-                    -- The server processes sync request 1+                  -- The server processes sync request 1                   (resp1, sstore2) <- processServerSync genD sstore1 req1                   let time2 = incrementServerTime time1                   lift $ do-                    resp1 `shouldBe`-                      emptySyncResponse {syncResponseClientChanged = M.singleton uuid time2}-                    sstore2 `shouldBe`-                      ServerStore {serverStoreItems = M.singleton uuid (Timed j time2)}-                    -- Client B merges the response+                    resp1+                      `shouldBe` emptySyncResponse {syncResponseClientChanged = M.singleton uuid time2}+                    sstore2+                      `shouldBe` ServerStore {serverStoreItems = M.singleton uuid (Timed j time2)}+                  -- Client B merges the response                   let cBstore2 = mergeFunc cBstore1 resp1                   lift $-                    cBstore2 `shouldBe`-                    initialClientStore {clientStoreSyncedItems = M.singleton uuid (Timed j time2)}-                    -- Client A makes sync request 2+                    cBstore2+                      `shouldBe` initialClientStore {clientStoreSyncedItems = M.singleton uuid (Timed j time2)}+                  -- Client A makes sync request 2                   let req2 = makeSyncRequest cAstore1-                    -- The server processes sync request 2+                  -- The server processes sync request 2                   (resp2, sstore3) <- processServerSync genD sstore2 req2                   lift $ do-                    resp2 `shouldBe`-                      emptySyncResponse-                        {syncResponseServerChanged = M.singleton uuid (Timed j time2)}+                    resp2+                      `shouldBe` emptySyncResponse+                        { syncResponseServerChanged = M.singleton uuid (Timed j time2)+                        }                     sstore3 `shouldBe` sstore2-                    -- Client A merges the response+                  -- Client A merges the response                   let cAstore2 = mergeFunc cAstore1 resp2                   lift $-                    cAstore2 `shouldBe`-                    initialClientStore {clientStoreSyncedItems = M.singleton uuid (Timed j time2)}-                    -- Client A and Client B now have the same store+                    cAstore2+                      `shouldBe` initialClientStore {clientStoreSyncedItems = M.singleton uuid (Timed j time2)}+                  -- Client A and Client B now have the same store                   lift $ cAstore2 `shouldBe` cBstore2-      it "succesfully syncs a deletion across to a second client" $-        forAllValid $ \uuid ->+      it "succesfully syncs a deletion across to a second client"+        $ forAllValid+        $ \uuid ->           forAllValid $ \time1 ->             forAllValid $ \i ->               evalDM $ do                 let cAstore1 =                       initialClientStore {clientStoreSyncedItems = M.singleton uuid (Timed i time1)}-                  -- Client A has a synced item.-                  -- Client B had synced that same item, but has since deleted it.+                -- Client A has a synced item.+                -- Client B had synced that same item, but has since deleted it.                 let cBstore1 = initialClientStore {clientStoreDeletedItems = M.singleton uuid time1}-                  -- The server still has the undeleted item+                -- The server still has the undeleted item                 let sstore1 = ServerStore {serverStoreItems = M.singleton uuid (Timed i time1)}-                  -- Client B makes sync request 1+                -- Client B makes sync request 1                 let req1 = makeSyncRequest cBstore1-                  -- The server processes sync request 1+                -- The server processes sync request 1                 (resp1, sstore2) <- processServerSync genD sstore1 req1                 lift $ do                   resp1 `shouldBe` emptySyncResponse {syncResponseClientDeleted = S.singleton uuid}                   sstore2 `shouldBe` initialServerStore-                  -- Client B merges the response+                -- Client B merges the response                 let cBstore2 = mergeFunc cBstore1 resp1                 lift $ cBstore2 `shouldBe` initialClientStore-                  -- Client A makes sync request 2+                -- Client A makes sync request 2                 let req2 = makeSyncRequest cAstore1-                  -- The server processes sync request 2+                -- The server processes sync request 2                 (resp2, sstore3) <- processServerSync genD sstore2 req2                 lift $ do                   resp2 `shouldBe` emptySyncResponse {syncResponseServerDeleted = S.singleton uuid}                   sstore3 `shouldBe` sstore2-                  -- Client A merges the response+                -- Client A merges the response                 let cAstore2 = mergeFunc cAstore1 resp2                 lift $ cAstore2 `shouldBe` initialClientStore-                  -- Client A and Client B now have the same store+                -- Client A and Client B now have the same store                 lift $ cAstore2 `shouldBe` cBstore2-      it "does not run into a conflict if two clients both try to sync a deletion" $-        forAllValid $ \uuid ->+      it "does not run into a conflict if two clients both try to sync a deletion"+        $ forAllValid+        $ \uuid ->           forAllValid $ \time1 ->             forAllValid $ \i ->               evalDM $ do                 let cAstore1 = initialClientStore {clientStoreDeletedItems = M.singleton uuid time1}-                  -- Both client a and client b delete an item.+                -- Both client a and client b delete an item.                 let cBstore1 = initialClientStore {clientStoreDeletedItems = M.singleton uuid time1}-                  -- The server still has the undeleted item+                -- The server still has the undeleted item                 let sstore1 = ServerStore {serverStoreItems = M.singleton uuid (Timed i time1)}-                  -- Client A makes sync request 1+                -- Client A makes sync request 1                 let req1 = makeSyncRequest cAstore1-                  -- The server processes sync request 1+                -- The server processes sync request 1                 (resp1, sstore2) <- processServerSync genD sstore1 req1                 lift $ do-                  resp1 `shouldBe`-                    (emptySyncResponse {syncResponseClientDeleted = S.singleton uuid})+                  resp1+                    `shouldBe` (emptySyncResponse {syncResponseClientDeleted = S.singleton uuid})                   sstore2 `shouldBe` (ServerStore {serverStoreItems = M.empty})-                  -- Client A merges the response+                -- Client A merges the response                 let cAstore2 = mergeFunc cAstore1 resp1                 lift $ cAstore2 `shouldBe` initialClientStore-                  -- Client B makes sync request 2+                -- Client B makes sync request 2                 let req2 = makeSyncRequest cBstore1-                  -- The server processes sync request 2+                -- The server processes sync request 2                 (resp2, sstore3) <- processServerSync genD sstore2 req2                 lift $ do-                  resp2 `shouldBe`-                    (emptySyncResponse {syncResponseClientDeleted = S.singleton uuid})+                  resp2+                    `shouldBe` (emptySyncResponse {syncResponseClientDeleted = S.singleton uuid})                   sstore3 `shouldBe` sstore2-                  -- Client B merges the response+                -- Client B merges the response                 let cBstore2 = mergeFunc cBstore1 resp2                 lift $ do                   cBstore2 `shouldBe` initialClientStore-                    -- Client A and Client B now have the same store+                  -- Client A and Client B now have the same store                   cAstore2 `shouldBe` cBstore2     describe "Multiple items" $ do-      it "successfully syncs additions accross to a second client" $-        forAllValid $ \is ->+      it "successfully syncs additions accross to a second client"+        $ forAllValid+        $ \is ->           evalDM $ do             let cAstore1 = initialClientStore {clientStoreAddedItems = is}-              -- Client B is empty+            -- Client B is empty             let cBstore1 = initialClientStore-              -- The server is empty+            -- The server is empty             let sstore1 = initialServerStore-              -- Client A makes sync request 1+            -- Client A makes sync request 1             let req1 = makeSyncRequest cAstore1-              -- The server processes sync request 1+            -- The server processes sync request 1             (resp1, sstore2) <- processServerSync genD sstore1 req1             let (rest, items) = mergeAddedItems is (syncResponseClientAdded resp1)             lift $ do               rest `shouldBe` M.empty               sstore2 `shouldBe` (ServerStore {serverStoreItems = items})-              -- Client A merges the response+            -- Client A merges the response             let cAstore2 = mergeFunc cAstore1 resp1             lift $ cAstore2 `shouldBe` (initialClientStore {clientStoreSyncedItems = items})-              -- Client B makes sync request 2+            -- Client B makes sync request 2             let req2 = makeSyncRequest cBstore1-              -- The server processes sync request 2+            -- The server processes sync request 2             (resp2, sstore3) <- processServerSync genD sstore2 req2             lift $ do               resp2 `shouldBe` (emptySyncResponse {syncResponseServerAdded = items})               sstore3 `shouldBe` sstore2-              -- Client B merges the response+            -- Client B merges the response             let cBstore2 = mergeFunc cBstore1 resp2             lift $ cBstore2 `shouldBe` (initialClientStore {clientStoreSyncedItems = items})-              -- Client A and Client B now have the same store+            -- Client A and Client B now have the same store             lift $ cAstore2 `shouldBe` cBstore2-      it "succesfully syncs deletions across to a second client" $-        forAllValid $ \items ->+      it "succesfully syncs deletions across to a second client"+        $ forAllValid+        $ \items ->           forAllValid $ \time1 ->             evalDM $ do               let syncedItems = M.map (\i -> Timed i time1) items                   itemTimes = M.map (const time1) items                   itemIds = M.keysSet items               let cAstore1 = initialClientStore {clientStoreSyncedItems = syncedItems}-                -- Client A has synced items-                -- Client B had synced the same items, but has since deleted them.+              -- Client A has synced items+              -- Client B had synced the same items, but has since deleted them.               let cBstore1 = initialClientStore {clientStoreDeletedItems = itemTimes}-                -- The server still has the undeleted item+              -- The server still has the undeleted item               let sstore1 = ServerStore {serverStoreItems = syncedItems}-                -- Client B makes sync request 1+              -- Client B makes sync request 1               let req1 = makeSyncRequest cBstore1-                -- The server processes sync request 1+              -- The server processes sync request 1               (resp1, sstore2) <- processServerSync genD sstore1 req1               lift $ do                 resp1 `shouldBe` emptySyncResponse {syncResponseClientDeleted = itemIds}                 sstore2 `shouldBe` initialServerStore-                -- Client B merges the response+              -- Client B merges the response               let cBstore2 = mergeFunc cBstore1 resp1               lift $ cBstore2 `shouldBe` initialClientStore-                -- Client A makes sync request 2+              -- Client A makes sync request 2               let req2 = makeSyncRequest cAstore1-                -- The server processes sync request 2+              -- The server processes sync request 2               (resp2, sstore3) <- processServerSync genD sstore2 req2               lift $ do                 resp2 `shouldBe` emptySyncResponse {syncResponseServerDeleted = itemIds}                 sstore3 `shouldBe` sstore2-                -- Client A merges the response+              -- Client A merges the response               let cAstore2 = mergeFunc cAstore1 resp2               lift $ cAstore2 `shouldBe` initialClientStore-                -- Client A and Client B now have the same store+              -- Client A and Client B now have the same store               lift $ cAstore2 `shouldBe` cBstore2-      it "does not run into a conflict if two clients both try to sync a deletion" $-        forAllValid $ \items ->+      it "does not run into a conflict if two clients both try to sync a deletion"+        $ forAllValid+        $ \items ->           forAllValid $ \time1 ->             evalDM $ do               let cAstore1 =                     initialClientStore {clientStoreDeletedItems = M.map (const time1) items}-                -- Both client a and client b delete their items.+              -- Both client a and client b delete their items.               let cBstore1 =                     initialClientStore {clientStoreDeletedItems = M.map (const time1) items}-                -- The server still has the undeleted items+              -- The server still has the undeleted items               let sstore1 = ServerStore {serverStoreItems = M.map (\i -> Timed i time1) items}-                -- Client A makes sync request 1+              -- Client A makes sync request 1               let req1 = makeSyncRequest cAstore1-                -- The server processes sync request 1+              -- The server processes sync request 1               (resp1, sstore2) <- processServerSync genD sstore1 req1               lift $ do                 resp1 `shouldBe` (emptySyncResponse {syncResponseClientDeleted = M.keysSet items})                 sstore2 `shouldBe` (ServerStore {serverStoreItems = M.empty}) -- TODO will probably need some sort of tombstoning.-                -- Client A merges the response+                      -- Client A merges the response               let cAstore2 = mergeFunc cAstore1 resp1               lift $ cAstore2 `shouldBe` initialClientStore-                -- Client B makes sync request 2+              -- Client B makes sync request 2               let req2 = makeSyncRequest cBstore1-                -- The server processes sync request 2+              -- The server processes sync request 2               (resp2, sstore3) <- processServerSync genD sstore2 req2               lift $ do                 resp2 `shouldBe` (emptySyncResponse {syncResponseClientDeleted = M.keysSet items})                 sstore3 `shouldBe` sstore2-                -- Client B merges the response+              -- Client B merges the response               let cBstore2 = mergeFunc cBstore1 resp2               lift $ do                 cBstore2 `shouldBe` initialClientStore-                  -- Client A and Client B now have the same store+                -- Client A and Client B now have the same store                 cAstore2 `shouldBe` cBstore2 -newtype D m a =-  D-    { unD :: StateT StdGen m a-    }+noDataLossSpec ::+  forall a.+  (Show a, Ord a, GenValid a) =>+  ItemMergeStrategy a ->+  Spec+noDataLossSpec strat = do+  let mergeFunc = mergeSyncResponseUsingStrategy strat+  it "does not lose data after a conflict occurs"+    $ forAllValid+    $ \uuid ->+      forAllValid $ \time1 ->+        forAllValid $ \i1 ->+          forAllValid $ \i2 ->+            forAllValid $ \i3 ->+              evalDM $ do+                let sstore1 = ServerStore {serverStoreItems = M.singleton uuid (Timed i1 time1)}+                -- The server has an item+                -- The first client has synced it, and modified it.+                let cAstore1 =+                      initialClientStore+                        { clientStoreSyncedButChangedItems = M.singleton uuid (Timed i2 time1)+                        }+                -- The second client has synced it too, and modified it too.+                let cBstore1 =+                      initialClientStore+                        { clientStoreSyncedButChangedItems = M.singleton uuid (Timed i3 time1)+                        }+                -- Client A makes sync request 1+                let req1 = makeSyncRequest @ClientId @UUID cAstore1+                -- The server processes sync request 1+                (resp1, sstore2) <- processServerSync genD sstore1 req1+                let time2 = incrementServerTime time1+                -- The server updates the item accordingly+                lift $ do+                  resp1+                    `shouldBe` (emptySyncResponse {syncResponseClientChanged = M.singleton uuid time2})+                  sstore2+                    `shouldBe` (ServerStore {serverStoreItems = M.singleton uuid (Timed i2 time2)})+                -- Client A merges the response+                let cAstore2 = mergeFunc cAstore1 resp1+                lift $+                  cAstore2+                    `shouldBe` (initialClientStore {clientStoreSyncedItems = M.singleton uuid (Timed i2 time2)})+                -- Client B makes sync request 2+                let req2 = makeSyncRequest cBstore1+                -- The server processes sync request 2+                (resp2, sstore3) <- processServerSync genD sstore2 req2+                -- The server reports a conflict and does not change its store+                lift $ do+                  resp2+                    `shouldBe` (emptySyncResponse {syncResponseConflicts = M.singleton uuid (Timed i2 time2)})+                  sstore3 `shouldBe` sstore2+                -- Client B merges the response+                let cBstore2 = mergeSyncResponseFromClient @ClientId @UUID cBstore1 resp2+                -- Client does not update, but keeps its conflict+                -- Client A and Client B now *do not* have the same store+                lift $+                  cBstore2+                    `shouldBe` ( initialClientStore+                                   { clientStoreSyncedButChangedItems = M.singleton uuid (Timed i3 time1)+                                   }+                               )++noDivergenceSpec ::+  forall a.+  (Show a, Ord a, GenValid a) =>+  ItemMergeStrategy a ->+  Spec+noDivergenceSpec strat = do+  let mergeFunc = mergeSyncResponseUsingStrategy strat+  it "does not diverge after a conflict occurs"+    $ forAllValid+    $ \uuid ->+      forAllValid $ \time1 ->+        forAllValid $ \iS ->+          forAllValid $ \iA ->+            forAllValid $ \iB ->+              evalDM $ do+                let sstore1 = ServerStore {serverStoreItems = M.singleton uuid (Timed iS time1)}+                -- The server has an item+                -- The first client has synced it, and modified it.+                let cAstore1 =+                      initialClientStore+                        { clientStoreSyncedButChangedItems = M.singleton uuid (Timed iA time1)+                        }+                -- The second client has synced it too, and modified it too.+                let cBstore1 =+                      initialClientStore+                        { clientStoreSyncedButChangedItems = M.singleton uuid (Timed iB time1)+                        }+                -- Client A makes sync request 1+                let req1 = makeSyncRequest @ClientId @UUID cAstore1+                -- The server processes sync request 1+                (resp1, sstore2) <- processServerSync genD sstore1 req1+                let time2 = incrementServerTime time1+                -- The server updates the item accordingly+                lift $ do+                  resp1+                    `shouldBe` (emptySyncResponse {syncResponseClientChanged = M.singleton uuid time2})+                  sstore2+                    `shouldBe` (ServerStore {serverStoreItems = M.singleton uuid (Timed iA time2)})+                -- Client A merges the response+                let cAstore2 = mergeFunc cAstore1 resp1+                -- Client A has the item from the server because there was no conflict.+                lift $+                  cAstore2+                    `shouldBe` initialClientStore {clientStoreSyncedItems = M.singleton uuid (Timed iA time2)}+                -- Client B makes sync request 2+                let req2 = makeSyncRequest cBstore1+                -- The server processes sync request 2+                (resp2, sstore3) <- processServerSync genD sstore2 req2+                -- The server reports a conflict and does not change its store+                lift $ do+                  resp2+                    `shouldBe` (emptySyncResponse {syncResponseConflicts = M.singleton uuid (Timed iA time2)})+                  sstore3 `shouldBe` sstore2+                -- Client B merges the response+                let cBstore2 = mergeFunc cBstore1 resp2+                lift $ do+                  let expected = case itemMergeStrategyMergeChangeConflict strat iB iA of+                        KeepLocal -> initialClientStore {clientStoreSyncedButChangedItems = M.singleton uuid (Timed iB time1)}+                        TakeRemote -> initialClientStore {clientStoreSyncedItems = M.singleton uuid (Timed iA time2)}+                        Merged im -> initialClientStore {clientStoreSyncedButChangedItems = M.singleton uuid (Timed im time2)}+                  cBstore2+                    `shouldBe` expected+                -- In case of a previous merge, the synced item will still be changed, so we need to sync again with B and then with A+                let req3 = makeSyncRequest cBstore2+                (resp3, sstore4) <- processServerSync genD sstore3 req3+                let cBstore3 = mergeFunc cBstore2 resp3+                let req4 = makeSyncRequest cAstore2+                (resp4, _) <- processServerSync genD sstore4 req4+                let cAstore3 = mergeFunc cAstore2 resp4+                lift $+                  cBstore3 `shouldBe` cAstore3++emptyResponseSpec ::+  forall a.+  (Show a, Eq a, Ord a, GenValid a) =>+  ItemMergeStrategy a ->+  Spec+emptyResponseSpec strat = do+  let mergeFunc = mergeSyncResponseUsingStrategy strat+  it "is returns an empty response on the second sync with no modifications"+    $ forAllValid+    $ \cstore1 ->+      forAllValid $ \sstore1 ->+        evalDM $ do+          let req1 = makeSyncRequest @ClientId @UUID cstore1+          (resp1, sstore2) <- processServerSync genD sstore1 req1+          let cstore2 = mergeFunc cstore1 resp1+              req2 = makeSyncRequest cstore2+          (resp2, _) <- processServerSync genD sstore2 req2+          lift $ resp2 `shouldBe` emptySyncResponse++noDifferentExceptForConflicts ::+  forall a.+  (Show a, Eq a, Ord a, GenValid a) =>+  ItemMergeStrategy a ->+  ItemMergeStrategy a ->+  Spec+noDifferentExceptForConflicts strat1 strat2 = do+  let mergeFunc1 = mergeSyncResponseUsingStrategy strat1+      mergeFunc2 = mergeSyncResponseUsingStrategy strat2+  describe "mergeSyncResponseFromServer"+    $ it "only differs from mergeSyncResponseFromClient on conflicts"+    $ forAllValid+    $ \cstore ->+      forAllValid $ \sresp@SyncResponse {..} -> do+        let cstoreA = mergeFunc1 (cstore :: ClientStore ClientId UUID a) sresp+            cstoreB = mergeFunc2 cstore sresp+        if cstoreA == cstoreB+          then pure ()+          else+            unless+              ( or+                  [ not (M.null syncResponseConflicts),+                    not (M.null syncResponseConflictsClientDeleted),+                    not (S.null syncResponseConflictsServerDeleted)+                  ]+              )+              $ expectationFailure+              $ unlines+                [ "There was a difference between mergeFunc1 and mergeFunc2 that was somehow unrelated to the conflicts:",+                  "syncResponseConflicts:",+                  ppShow syncResponseConflicts,+                  "syncResponseConflictsClientDeleted:",+                  ppShow syncResponseConflictsClientDeleted,+                  "syncResponseConflictsServerDeleted:",+                  ppShow syncResponseConflictsServerDeleted,+                  "client store after mergeFunc1:",+                  ppShow cstoreA,+                  "client store after mergeFunc2:",+                  ppShow cstoreB+                ]++newtype D m a+  = D+      { unD :: StateT StdGen m a+      }   deriving (Generic, Functor, Applicative, Monad, MonadState StdGen, MonadTrans, MonadIO)  evalD :: D Identity a -> a

@@ -1,19 +1,19 @@+{-# LANGUAGE RankNTypes #-} {-# LANGUAGE TypeApplications #-}  module Data.Mergeful.ItemSpec-  ( spec-  ) where+  ( spec,+  )+where +import Data.GenValidity.Mergeful.Item ()+import Data.Mergeful.Item+import Data.Mergeful.Timed import Test.Hspec import Test.QuickCheck import Test.Validity import Test.Validity.Aeson -import Data.Mergeful.Item-import Data.Mergeful.Timed--import Data.GenValidity.Mergeful.Item ()- {-# ANN module ("HLint: ignore Reduce duplication" :: String) #-}  forAllSubsequent :: Testable prop => ((ServerTime, ServerTime) -> prop) -> Property@@ -31,13 +31,21 @@   jsonSpecOnValid @(ItemSyncRequest Int)   genValidSpec @(ItemSyncResponse Int)   jsonSpecOnValid @(ItemSyncResponse Int)-  describe "makeItemSyncRequest" $-    it "produces valid requests" $ producesValidsOnValids (makeItemSyncRequest @Int)-  describe "mergeItemSyncResponseRaw" $-    it "produces valid client stores" $ producesValidsOnValids2 (mergeItemSyncResponseRaw @Int)-  describe "mergeItemSyncResponseIgnoreProblems" $-    it "produces valid client stores" $-    producesValidsOnValids2 (mergeItemSyncResponseIgnoreProblems @Int)+  describe "makeItemSyncRequest"+    $ it "produces valid requests"+    $ producesValidsOnValids (makeItemSyncRequest @Int)+  describe "mergeItemSyncResponseRaw"+    $ it "produces valid client stores"+    $ producesValidsOnValids2 (mergeItemSyncResponseRaw @Int)+  describe "mergeItemSyncResponseFromServer"+    $ it "produces valid client stores"+    $ producesValidsOnValids2 (mergeItemSyncResponseFromServer @Int)+  describe "mergeItemSyncResponseFromClient"+    $ it "produces valid client stores"+    $ producesValidsOnValids2 (mergeItemSyncResponseFromClient @Int)+  describe "mergeItemSyncResponseUsingCRDT"+    $ it "produces valid client stores"+    $ producesValidsOnValids2 (mergeItemSyncResponseUsingCRDT @Int max)   describe "processServerItemSync" $ do     it "produces valid responses and stores" $ producesValidsOnValids2 (processServerItemSync @Int)     it "makes no changes if the sync request reflects the state of the empty server" $ do@@ -46,8 +54,9 @@       let (resp, store2) = processServerItemSync @Int store1 req       store2 `shouldBe` store1       resp `shouldBe` ItemSyncResponseInSyncEmpty-    it "makes no changes if the sync request reflects the state of the full server" $-      forAllValid $ \i ->+    it "makes no changes if the sync request reflects the state of the full server"+      $ forAllValid+      $ \i ->         forAllValid $ \st -> do           let store1 = ServerFull $ Timed i st               req = ItemSyncRequestKnown st@@ -55,16 +64,18 @@           store2 `shouldBe` store1           resp `shouldBe` ItemSyncResponseInSyncFull     describe "Client changes" $ do-      it "adds the item that the client tells the server to add" $-        forAllValid $ \i -> do+      it "adds the item that the client tells the server to add"+        $ forAllValid+        $ \i -> do           let store1 = ServerEmpty               req = ItemSyncRequestNew i           let (resp, store2) = processServerItemSync @Int store1 req           let time = initialServerTime           store2 `shouldBe` ServerFull (Timed i time)           resp `shouldBe` ItemSyncResponseClientAdded time-      it "changes the item that the client tells the server to change" $-        forAllValid $ \i ->+      it "changes the item that the client tells the server to change"+        $ forAllValid+        $ \i ->           forAllValid $ \j ->             forAllValid $ \st -> do               let store1 = ServerFull (Timed i st)@@ -73,8 +84,9 @@               let time = incrementServerTime st               store2 `shouldBe` ServerFull (Timed j time)               resp `shouldBe` ItemSyncResponseClientChanged time-      it "deletes the item that the client tells the server to delete" $-        forAllValid $ \i ->+      it "deletes the item that the client tells the server to delete"+        $ forAllValid+        $ \i ->           forAllValid $ \st -> do             let store1 = ServerFull (Timed i st)                 req = ItemSyncRequestDeletedLocally st@@ -82,32 +94,36 @@             store2 `shouldBe` ServerEmpty             resp `shouldBe` ItemSyncResponseClientDeleted     describe "Server changes" $ do-      it "tells the client that there is a new item at the server side" $-        forAllValid $ \i ->+      it "tells the client that there is a new item at the server side"+        $ forAllValid+        $ \i ->           forAllValid $ \st -> do             let store1 = ServerFull (Timed i st)                 req = ItemSyncRequestPoll             let (resp, store2) = processServerItemSync @Int store1 req             store2 `shouldBe` store1             resp `shouldBe` ItemSyncResponseServerAdded (Timed i st)-      it "tells the client that there is a modified item at the server side" $-        forAllValid $ \i ->+      it "tells the client that there is a modified item at the server side"+        $ forAllValid+        $ \i ->           forAllSubsequent $ \(st, st') -> do             let store1 = ServerFull (Timed i st')                 req = ItemSyncRequestKnown st             let (resp, store2) = processServerItemSync @Int store1 req             store2 `shouldBe` store1             resp `shouldBe` ItemSyncResponseServerChanged (Timed i st')-      it "tells the client that there is a deleted item at the server side" $-        forAllValid $ \st -> do+      it "tells the client that there is a deleted item at the server side"+        $ forAllValid+        $ \st -> do           let store1 = ServerEmpty               req = ItemSyncRequestKnown st           let (resp, store2) = processServerItemSync @Int store1 req           store2 `shouldBe` store1           resp `shouldBe` ItemSyncResponseServerDeleted     describe "Conflicts" $ do-      it "notices a conflict if the client and server are trying to sync different items" $-        forAllValid $ \i ->+      it "notices a conflict if the client and server are trying to sync different items"+        $ forAllValid+        $ \i ->           forAllValid $ \j ->             forAllSubsequent $ \(st, st') -> do               let store1 = ServerFull (Timed i st')@@ -116,8 +132,9 @@               store2 `shouldBe` store1               resp `shouldBe` ItemSyncResponseConflict (Timed i st')       it-        "notices a server-deleted-conflict if the client has a deleted item and server has a modified item" $-        forAllValid $ \i ->+        "notices a server-deleted-conflict if the client has a deleted item and server has a modified item"+        $ forAllValid+        $ \i ->           forAllSubsequent $ \(st, st') -> do             let store1 = ServerFull (Timed i st')                 req = ItemSyncRequestDeletedLocally st@@ -125,8 +142,9 @@             store2 `shouldBe` store1             resp `shouldBe` ItemSyncResponseConflictClientDeleted (Timed i st')       it-        "notices a server-deleted-conflict if the client has a modified item and server has no item" $-        forAllValid $ \i ->+        "notices a server-deleted-conflict if the client has a modified item and server has no item"+        $ forAllValid+        $ \i ->           forAllValid $ \st -> do             let store1 = ServerEmpty                 req = ItemSyncRequestKnownButChanged (Timed i st)@@ -134,139 +152,184 @@             store2 `shouldBe` store1             resp `shouldBe` ItemSyncResponseConflictServerDeleted   describe "syncing" $ do-    it "it always possible to add an item from scratch" $-      forAllValid $ \i -> do-        let cstore1 = ClientAdded (i :: Int)-        let sstore1 = ServerEmpty-        let req1 = makeItemSyncRequest cstore1-            (resp1, sstore2) = processServerItemSync sstore1 req1-            cstore2 = mergeItemSyncResponseIgnoreProblems cstore1 resp1-        let time = initialServerTime-        resp1 `shouldBe` ItemSyncResponseClientAdded time-        sstore2 `shouldBe` ServerFull (Timed i time)-        cstore2 `shouldBe` ClientItemSynced (Timed i time)-    it "succesfully syncs an addition across to a second client" $-      forAllValid $ \i -> do-        let cAstore1 = ClientAdded i-        -- Client B is empty-        let cBstore1 = ClientEmpty-        -- The server is empty-        let sstore1 = ServerEmpty-        -- Client A makes sync request 1-        let req1 = makeItemSyncRequest cAstore1-        -- The server processes sync request 1-        let (resp1, sstore2) = processServerItemSync @Int sstore1 req1-        let time = initialServerTime-        resp1 `shouldBe` ItemSyncResponseClientAdded time-        sstore2 `shouldBe` ServerFull (Timed i time)-        -- Client A merges the response-        let cAstore2 = mergeItemSyncResponseIgnoreProblems cAstore1 resp1-        cAstore2 `shouldBe` ClientItemSynced (Timed i time)-        -- Client B makes sync request 2-        let req2 = makeItemSyncRequest cBstore1-        -- The server processes sync request 2-        let (resp2, sstore3) = processServerItemSync sstore2 req2-        resp2 `shouldBe` ItemSyncResponseServerAdded (Timed i time)-        sstore3 `shouldBe` ServerFull (Timed i time)-        -- Client B merges the response-        let cBstore2 = mergeItemSyncResponseIgnoreProblems cBstore1 resp2-        cBstore2 `shouldBe` ClientItemSynced (Timed i time)-        -- Client A and Client B now have the same store-        cAstore2 `shouldBe` cBstore2-    it "succesfully syncs a modification across to a second client" $-      forAllValid $ \time1 ->-        forAllValid $ \i ->-          forAllValid $ \j -> do-            let cAstore1 = ClientItemSynced (Timed i time1)-            -- Client B had synced that same item, but has since modified it-            let cBstore1 = ClientItemSyncedButChanged (Timed j time1)-            -- The server is has the item that both clients had before-            let sstore1 = ServerFull (Timed i time1)-            -- Client B makes sync request 1-            let req1 = makeItemSyncRequest cBstore1-            -- The server processes sync request 1-            let (resp1, sstore2) = processServerItemSync @Int sstore1 req1-            let time2 = incrementServerTime time1-            resp1 `shouldBe` ItemSyncResponseClientChanged time2-            sstore2 `shouldBe` ServerFull (Timed j time2)-            -- Client B merges the response-            let cBstore2 = mergeItemSyncResponseIgnoreProblems cBstore1 resp1-            cBstore2 `shouldBe` ClientItemSynced (Timed j time2)-            -- Client A makes sync request 2-            let req2 = makeItemSyncRequest cAstore1-            -- The server processes sync request 2-            let (resp2, sstore3) = processServerItemSync sstore2 req2-            resp2 `shouldBe` ItemSyncResponseServerChanged (Timed j time2)-            sstore3 `shouldBe` ServerFull (Timed j time2)-            -- Client A merges the response-            let cAstore2 = mergeItemSyncResponseIgnoreProblems cAstore1 resp2-            cAstore2 `shouldBe` ClientItemSynced (Timed j time2)-            -- Client A and Client B now have the same store-            cAstore2 `shouldBe` cBstore2-    it "succesfully syncs a deletion across to a second client" $-      forAllValid $ \time1 ->-        forAllValid $ \i -> do+    describe "fromServer" $ do+      syncingSpec @Int mergeFromServer+      emptyResponseSpec @Int mergeFromServer+    describe "fromClient" $ do+      syncingSpec @Int mergeFromClient+      xdescribe "does not hold" $ emptyResponseSpec @Int mergeFromClient+    describe "gadt" $ do+      let merge = mergeUsingCRDT @Int max+      syncingSpec merge+      emptyResponseSpec merge++syncingSpec ::+  forall a.+  (Show a, Eq a, GenValid a) =>+  (ClientItem a -> ItemMergeResult a -> ClientItem a) ->+  Spec+syncingSpec mergeStrategy = do+  let mergeSyncResponse ci = mergeStrategy ci . mergeItemSyncResponseRaw ci+  it "it always possible to add an item from scratch"+    $ forAllValid+    $ \i -> do+      let cstore1 = ClientAdded i+      let sstore1 = ServerEmpty+      let req1 = makeItemSyncRequest cstore1+          (resp1, sstore2) = processServerItemSync sstore1 req1+          cstore2 = mergeSyncResponse cstore1 resp1+      let time = initialServerTime+      resp1 `shouldBe` ItemSyncResponseClientAdded time+      sstore2 `shouldBe` ServerFull (Timed i time)+      cstore2 `shouldBe` ClientItemSynced (Timed i time)+  it "succesfully syncs an addition across to a second client"+    $ forAllValid+    $ \i -> do+      let cAstore1 = ClientAdded i+      -- Client B is empty+      let cBstore1 = ClientEmpty+      -- The server is empty+      let sstore1 = ServerEmpty+      -- Client A makes sync request 1+      let req1 = makeItemSyncRequest cAstore1+      -- The server processes sync request 1+      let (resp1, sstore2) = processServerItemSync sstore1 req1+      let time = initialServerTime+      resp1 `shouldBe` ItemSyncResponseClientAdded time+      sstore2 `shouldBe` ServerFull (Timed i time)+      -- Client A merges the response+      let cAstore2 = mergeSyncResponse cAstore1 resp1+      cAstore2 `shouldBe` ClientItemSynced (Timed i time)+      -- Client B makes sync request 2+      let req2 = makeItemSyncRequest cBstore1+      -- The server processes sync request 2+      let (resp2, sstore3) = processServerItemSync sstore2 req2+      resp2 `shouldBe` ItemSyncResponseServerAdded (Timed i time)+      sstore3 `shouldBe` ServerFull (Timed i time)+      -- Client B merges the response+      let cBstore2 = mergeSyncResponse cBstore1 resp2+      cBstore2 `shouldBe` ClientItemSynced (Timed i time)+      -- Client A and Client B now have the same store+      cAstore2 `shouldBe` cBstore2+  it "succesfully syncs a modification across to a second client"+    $ forAllValid+    $ \time1 ->+      forAllValid $ \i ->+        forAllValid $ \j -> do           let cAstore1 = ClientItemSynced (Timed i time1)-          -- Client B had synced that same item, but has since deleted it-          let cBstore1 = ClientDeleted time1-          -- The server still has the undeleted item+          -- Client B had synced that same item, but has since modified it+          let cBstore1 = ClientItemSyncedButChanged (Timed j time1)+          -- The server is has the item that both clients had before           let sstore1 = ServerFull (Timed i time1)           -- Client B makes sync request 1           let req1 = makeItemSyncRequest cBstore1           -- The server processes sync request 1-          let (resp1, sstore2) = processServerItemSync @Int sstore1 req1-          resp1 `shouldBe` ItemSyncResponseClientDeleted-          sstore2 `shouldBe` ServerEmpty+          let (resp1, sstore2) = processServerItemSync sstore1 req1+          let time2 = incrementServerTime time1+          resp1 `shouldBe` ItemSyncResponseClientChanged time2+          sstore2 `shouldBe` ServerFull (Timed j time2)           -- Client B merges the response-          let cBstore2 = mergeItemSyncResponseIgnoreProblems cBstore1 resp1-          cBstore2 `shouldBe` ClientEmpty+          let cBstore2 = mergeSyncResponse cBstore1 resp1+          cBstore2 `shouldBe` ClientItemSynced (Timed j time2)           -- Client A makes sync request 2           let req2 = makeItemSyncRequest cAstore1           -- The server processes sync request 2           let (resp2, sstore3) = processServerItemSync sstore2 req2-          resp2 `shouldBe` ItemSyncResponseServerDeleted-          sstore3 `shouldBe` ServerEmpty-          -- Client A merges the response-          let cAstore2 = mergeItemSyncResponseIgnoreProblems cAstore1 resp2-          cAstore2 `shouldBe` ClientEmpty-          -- Client A and Client B now have the same store-          cAstore2 `shouldBe` cBstore2-    it "does not run into a conflict if two clients both try to sync a deletion" $-      forAllValid $ \time1 ->-        forAllValid $ \i -> do-          let cAstore1 = ClientDeleted time1-          -- Both client a and client b delete an item.-          let cBstore1 = ClientDeleted time1-          -- The server still has the undeleted item-          let sstore1 = ServerFull (Timed i time1)-          -- Client A makes sync request 1-          let req1 = makeItemSyncRequest cAstore1-          -- The server processes sync request 1-          let (resp1, sstore2) = processServerItemSync @Int sstore1 req1-          resp1 `shouldBe` ItemSyncResponseClientDeleted-          sstore2 `shouldBe` ServerEmpty+          resp2 `shouldBe` ItemSyncResponseServerChanged (Timed j time2)+          sstore3 `shouldBe` ServerFull (Timed j time2)           -- Client A merges the response-          let cAstore2 = mergeItemSyncResponseIgnoreProblems cAstore1 resp1-          cAstore2 `shouldBe` ClientEmpty-          -- Client B makes sync request 2-          let req2 = makeItemSyncRequest cBstore1-          -- The server processes sync request 2-          let (resp2, sstore3) = processServerItemSync sstore2 req2-          resp2 `shouldBe` ItemSyncResponseClientDeleted-          sstore3 `shouldBe` ServerEmpty-          -- Client B merges the response-          let cBstore2 = mergeItemSyncResponseIgnoreProblems cBstore1 resp2-          cBstore2 `shouldBe` ClientEmpty+          let cAstore2 = mergeSyncResponse cAstore1 resp2+          cAstore2 `shouldBe` ClientItemSynced (Timed j time2)           -- Client A and Client B now have the same store           cAstore2 `shouldBe` cBstore2-    it "is idempotent with one client" $-      forAllValid $ \cstore1 ->-        forAllValid $ \sstore1 -> do-          let req1 = makeItemSyncRequest (cstore1 :: ClientItem Int)-              (resp1, sstore2) = processServerItemSync sstore1 req1-              cstore2 = mergeItemSyncResponseIgnoreProblems cstore1 resp1-              req2 = makeItemSyncRequest cstore2-              (resp2, sstore3) = processServerItemSync sstore2 req2-              cstore3 = mergeItemSyncResponseIgnoreProblems cstore2 resp2-          cstore2 `shouldBe` cstore3-          sstore2 `shouldBe` sstore3+  it "succesfully syncs a deletion across to a second client"+    $ forAllValid+    $ \time1 ->+      forAllValid $ \i -> do+        let cAstore1 = ClientItemSynced (Timed i time1)+        -- Client B had synced that same item, but has since deleted it+        let cBstore1 = ClientDeleted time1+        -- The server still has the undeleted item+        let sstore1 = ServerFull (Timed i time1)+        -- Client B makes sync request 1+        let req1 = makeItemSyncRequest cBstore1+        -- The server processes sync request 1+        let (resp1, sstore2) = processServerItemSync sstore1 req1+        resp1 `shouldBe` ItemSyncResponseClientDeleted+        sstore2 `shouldBe` ServerEmpty+        -- Client B merges the response+        let cBstore2 = mergeSyncResponse cBstore1 resp1+        cBstore2 `shouldBe` ClientEmpty+        -- Client A makes sync request 2+        let req2 = makeItemSyncRequest cAstore1+        -- The server processes sync request 2+        let (resp2, sstore3) = processServerItemSync sstore2 req2+        resp2 `shouldBe` ItemSyncResponseServerDeleted+        sstore3 `shouldBe` ServerEmpty+        -- Client A merges the response+        let cAstore2 = mergeSyncResponse cAstore1 resp2+        cAstore2 `shouldBe` ClientEmpty+        -- Client A and Client B now have the same store+        cAstore2 `shouldBe` cBstore2+  it "does not run into a conflict if two clients both try to sync a deletion"+    $ forAllValid+    $ \time1 ->+      forAllValid $ \i -> do+        let cAstore1 = ClientDeleted time1+        -- Both client a and client b delete an item.+        let cBstore1 = ClientDeleted time1+        -- The server still has the undeleted item+        let sstore1 = ServerFull (Timed i time1)+        -- Client A makes sync request 1+        let req1 = makeItemSyncRequest cAstore1+        -- The server processes sync request 1+        let (resp1, sstore2) = processServerItemSync sstore1 req1+        resp1 `shouldBe` ItemSyncResponseClientDeleted+        sstore2 `shouldBe` ServerEmpty+        -- Client A merges the response+        let cAstore2 = mergeSyncResponse cAstore1 resp1+        cAstore2 `shouldBe` ClientEmpty+        -- Client B makes sync request 2+        let req2 = makeItemSyncRequest cBstore1+        -- The server processes sync request 2+        let (resp2, sstore3) = processServerItemSync sstore2 req2+        resp2 `shouldBe` ItemSyncResponseClientDeleted+        sstore3 `shouldBe` ServerEmpty+        -- Client B merges the response+        let cBstore2 = mergeSyncResponse cBstore1 resp2+        cBstore2 `shouldBe` ClientEmpty+        -- Client A and Client B now have the same store+        cAstore2 `shouldBe` cBstore2+  it "is idempotent with one client"+    $ forAllValid+    $ \cstore1 ->+      forAllValid $ \sstore1 -> do+        let req1 = makeItemSyncRequest cstore1+            (resp1, sstore2) = processServerItemSync sstore1 req1+            cstore2 = mergeSyncResponse cstore1 resp1+            req2 = makeItemSyncRequest cstore2+            (resp2, sstore3) = processServerItemSync sstore2 req2+            cstore3 = mergeSyncResponse cstore2 resp2+        cstore3 `shouldBe` cstore2+        sstore3 `shouldBe` sstore2++emptyResponseSpec ::+  forall a.+  (Show a, Eq a, GenValid a) =>+  (ClientItem a -> ItemMergeResult a -> ClientItem a) ->+  Spec+emptyResponseSpec mergeStrategy = do+  let mergeSyncResponse ci = mergeStrategy ci . mergeItemSyncResponseRaw ci+  it "is returns an empty response on the second sync with no modifications"+    $ forAllValid+    $ \cstore1 ->+      forAllValid $ \sstore1 -> do+        let req1 = makeItemSyncRequest cstore1+            (resp1, sstore2) = processServerItemSync sstore1 req1+            cstore2 = mergeSyncResponse cstore1 resp1+            req2 = makeItemSyncRequest cstore2+            (resp2, _) = processServerItemSync sstore2 req2+        case resp2 of+          ItemSyncResponseInSyncEmpty -> pure ()+          ItemSyncResponseInSyncFull -> pure ()+          _ -> expectationFailure $ "Sync response was not empty: " <> show resp2

@@ -1,16 +1,15 @@ {-# LANGUAGE TypeApplications #-}  module Data.Mergeful.TimedSpec-  ( spec-  ) where+  ( spec,+  )+where +import Data.GenValidity.Mergeful.Item ()+import Data.Mergeful.Timed import Test.Hspec import Test.Validity import Test.Validity.Aeson--import Data.Mergeful.Timed--import Data.GenValidity.Mergeful.Item ()  spec :: Spec spec = do

@@ -1,19 +1,18 @@ {-# LANGUAGE TypeApplications #-}  module Data.Mergeful.ValueSpec-  ( spec-  ) where+  ( spec,+  )+where +import Data.GenValidity.Mergeful.Value ()+import Data.Mergeful.Timed+import Data.Mergeful.Value import Test.Hspec import Test.QuickCheck import Test.Validity import Test.Validity.Aeson -import Data.Mergeful.Timed-import Data.Mergeful.Value--import Data.GenValidity.Mergeful.Value ()- {-# ANN module ("HLint: ignore Reduce duplication" :: String) #-}  forAllSubsequent :: Testable prop => ((ServerTime, ServerTime) -> prop) -> Property@@ -31,26 +30,30 @@   jsonSpecOnValid @(ValueSyncRequest Int)   genValidSpec @(ValueSyncResponse Int)   jsonSpecOnValid @(ValueSyncResponse Int)-  describe "makeValueSyncRequest" $-    it "produces valid requests" $ producesValidsOnValids (makeValueSyncRequest @Int)-  describe "mergeValueSyncResponseRaw" $-    it "produces valid client stores" $ producesValidsOnValids2 (mergeValueSyncResponseRaw @Int)-  describe "mergeValueSyncResponseIgnoreProblems" $-    it "produces valid client stores" $-    producesValidsOnValids2 (mergeValueSyncResponseIgnoreProblems @Int)+  describe "makeValueSyncRequest"+    $ it "produces valid requests"+    $ producesValidsOnValids (makeValueSyncRequest @Int)+  describe "mergeValueSyncResponseRaw"+    $ it "produces valid client stores"+    $ producesValidsOnValids2 (mergeValueSyncResponseRaw @Int)+  describe "mergeValueSyncResponseIgnoreProblems"+    $ it "produces valid client stores"+    $ producesValidsOnValids2 (mergeValueSyncResponseIgnoreProblems @Int)   describe "processServerValueSync" $ do     it "produces valid responses and stores" $ producesValidsOnValids2 (processServerValueSync @Int)-    it "makes no changes if the sync request reflects the state of the server" $-      forAllValid $ \i ->+    it "makes no changes if the sync request reflects the state of the server"+      $ forAllValid+      $ \i ->         forAllValid $ \st -> do           let store1 = ServerValue $ Timed i st               req = ValueSyncRequestKnown st           let (resp, store2) = processServerValueSync @Int store1 req           store2 `shouldBe` store1           resp `shouldBe` ValueSyncResponseInSync-    describe "Client changes" $-      it "changes the item that the client tells the server to change" $-      forAllValid $ \i ->+    describe "Client changes"+      $ it "changes the item that the client tells the server to change"+      $ forAllValid+      $ \i ->         forAllValid $ \j ->           forAllValid $ \st -> do             let store1 = ServerValue (Timed i st)@@ -59,18 +62,20 @@             let time = incrementServerTime st             store2 `shouldBe` ServerValue (Timed j time)             resp `shouldBe` ValueSyncResponseClientChanged time-    describe "Server changes" $-      it "tells the client that there is a modified item at the server side" $-      forAllValid $ \i ->+    describe "Server changes"+      $ it "tells the client that there is a modified item at the server side"+      $ forAllValid+      $ \i ->         forAllSubsequent $ \(st, st') -> do           let store1 = ServerValue (Timed i st')               req = ValueSyncRequestKnown st           let (resp, store2) = processServerValueSync @Int store1 req           store2 `shouldBe` store1           resp `shouldBe` ValueSyncResponseServerChanged (Timed i st')-    describe "Conflicts" $-      it "notices a conflict if the client and server are trying to sync different items" $-      forAllValid $ \i ->+    describe "Conflicts"+      $ it "notices a conflict if the client and server are trying to sync different items"+      $ forAllValid+      $ \i ->         forAllValid $ \j ->           forAllSubsequent $ \(st, st') -> do             let store1 = ServerValue (Timed i st')@@ -79,8 +84,9 @@             store2 `shouldBe` store1             resp `shouldBe` ValueSyncResponseConflict (Timed i st')   describe "syncing" $ do-    it "succesfully syncs a modification across to a second client" $-      forAllValid $ \time1 ->+    it "succesfully syncs a modification across to a second client"+      $ forAllValid+      $ \time1 ->         forAllValid $ \i ->           forAllValid $ \j -> do             let cAstore1 = ClientValue (Timed i time1) NotChanged@@ -109,8 +115,9 @@             cAstore2 `shouldBe` ClientValue (Timed j time2) NotChanged             -- Client A and Client B now have the same store             cAstore2 `shouldBe` cBstore2-    it "is idempotent with one client" $-      forAllValid $ \cstore1 ->+    it "is idempotent with one client"+      $ forAllValid+      $ \cstore1 ->         forAllValid $ \sstore1 -> do           let req1 = makeValueSyncRequest (cstore1 :: ClientValue Int)               (resp1, sstore2) = processServerValueSync sstore1 req1