genvalidity-mergeless 0.0.0.0 → 0.1.0.0

raw patch · 8 files changed

+761/−560 lines, 8 filesdep +criteriondep +genvalidity-criteriondep +genvalidity-uuiddep −genvalidity-typed-uuiddep −typed-uuiddep ~mergelessPVP ok

version bump matches the API change (PVP)

Dependencies added: criterion, genvalidity-criterion, genvalidity-uuid, pretty-show

Dependencies removed: genvalidity-typed-uuid, typed-uuid

Dependency ranges changed: mergeless

API changes (from Hackage documentation)

Files

• bench/Bench.hs +40/−0
• genvalidity-mergeless.cabal +31/−10
• src/Data/GenValidity/Mergeless.hs +4/−79
• src/Data/GenValidity/Mergeless/Collection.hs +109/−0
• src/Data/GenValidity/Mergeless/Item.hs +34/−0
• test/Data/Mergeless/CollectionSpec.hs +439/−0
• test/Data/Mergeless/ItemSpec.hs +104/−0
• test/Data/MergelessSpec.hs +0/−471

@@ -0,0 +1,40 @@+{-# LANGUAGE AllowAmbiguousTypes #-}+{-# LANGUAGE TypeApplications #-}+{-# LANGUAGE ScopedTypeVariables #-}++module Main where++import Criterion.Main as Criterion++import Data.GenValidity.Criterion+import Data.GenValidity.Mergeless ()++import Data.Mergeless.Collection+import Data.Mergeless.Item++main :: IO ()+main =+  Criterion.defaultMain+    [ bgroup+        "Utils"+        [ genValidBench @(Added Bool)+        , genValidBench @(Synced Bool)+        , genValidBench @(ClientAddition Int)+        ]+    , bgroup+        "Item"+        [ genValidBench @(ClientItem Bool)+        , genValidBench @(ItemSyncRequest Bool)+        , genValidBench @(ItemSyncResponse Bool)+        , genValidBench @(ServerItem Bool)+        ]+    , bgroup+        "Collection"+        [ genValidBench @ClientId+        , genValidBench @(ClientStore Int Bool)+        , genValidBench @(SyncRequest Int Bool)+        , genValidBench @(ClientAddition Int)+        , genValidBench @(SyncResponse Int Bool)+        , genValidBench @(ServerStore Int Bool)+        ]+    ]

@@ -1,11 +1,13 @@--- This file has been generated from package.yaml by hpack version 0.28.2.+cabal-version: 1.12++-- This file has been generated from package.yaml by hpack version 0.33.0. -- -- see: https://github.com/sol/hpack ----- hash: 6e70257c58f9b084549d6af348ed63f6b22a88fc476bc7ccf0ccc1aa729f5891+-- hash: 13b8526e5aa6ded49e51ebf12a1008ee6f2e8f428b081a7766bfc17ddeef7848  name:           genvalidity-mergeless-version:        0.0.0.0+version:        0.1.0.0 description:    Please see the README on GitHub at <https://github.com/NorfairKing/mergeless#readme> homepage:       https://github.com/NorfairKing/mergeless#readme bug-reports:    https://github.com/NorfairKing/mergeless/issues@@ -14,10 +16,9 @@ copyright:      Copyright: (c) 2018 Tom Sydney Kerckhove license:        MIT build-type:     Simple-cabal-version:  >= 1.10 extra-source-files:-    ChangeLog.md     README.md+    ChangeLog.md  source-repository head   type: git@@ -26,6 +27,8 @@ library   exposed-modules:       Data.GenValidity.Mergeless+      Data.GenValidity.Mergeless.Collection+      Data.GenValidity.Mergeless.Item   other-modules:       Paths_genvalidity_mergeless   hs-source-dirs:@@ -33,17 +36,19 @@   build-depends:       QuickCheck     , base >=4.7 && <5+    , containers     , genvalidity     , genvalidity-containers     , genvalidity-time-    , mergeless+    , mergeless >=0.2.0.0   default-language: Haskell2010 -test-suite genvalidity-mergeless-test+test-suite mergeless-test   type: exitcode-stdio-1.0   main-is: Spec.hs   other-modules:-      Data.MergelessSpec+      Data.Mergeless.CollectionSpec+      Data.Mergeless.ItemSpec       Paths_genvalidity_mergeless   hs-source-dirs:       test@@ -55,12 +60,28 @@     , genvalidity-hspec     , genvalidity-hspec-aeson     , genvalidity-mergeless-    , genvalidity-typed-uuid+    , genvalidity-uuid     , hspec     , mergeless     , mtl+    , pretty-show     , random     , time-    , typed-uuid     , uuid+  default-language: Haskell2010++benchmark genvalidity-mergeless-bench+  type: exitcode-stdio-1.0+  main-is: Bench.hs+  other-modules:+      Paths_genvalidity_mergeless+  hs-source-dirs:+      bench+  ghc-options: -threaded -rtsopts -with-rtsopts=-N+  build-depends:+      base >=4.7 && <5+    , criterion+    , genvalidity-criterion+    , genvalidity-mergeless+    , mergeless   default-language: Haskell2010

@@ -1,82 +1,7 @@ {-# OPTIONS_GHC -fno-warn-orphans #-} -module Data.GenValidity.Mergeless where--import Test.QuickCheck--import Data.GenValidity-import Data.GenValidity.Containers ()-import Data.GenValidity.Time ()--import Data.Mergeless--instance (GenUnchecked i, GenUnchecked a, Ord i, Ord a) =>-         GenUnchecked (Store i a)--instance (GenValid i, GenValid a, Ord i, Ord a) => GenValid (Store i a) where-    genValid = (Store <$> genValid) `suchThat` isValid--instance (GenInvalid i, GenInvalid a, Ord i, Ord a) =>-         GenInvalid (Store i a)--instance (GenUnchecked i, GenUnchecked a) => GenUnchecked (StoreItem i a)--instance (GenValid i, GenValid a) => GenValid (StoreItem i a)--instance (GenInvalid i, GenInvalid a) => GenInvalid (StoreItem i a)--instance GenUnchecked a => GenUnchecked (Added a)--instance GenValid a => GenValid (Added a) where-    genValid = (Added <$> genValid <*> genValid) `suchThat` isValid--instance GenInvalid a => GenInvalid (Added a)--instance (GenUnchecked i, GenUnchecked a) => GenUnchecked (Synced i a)--instance (GenValid i, GenValid a) => GenValid (Synced i a) where-    genValid =-        (Synced <$> genValid <*> genValid <*> genValid <*> genValid) `suchThat`-        isValid--instance (GenInvalid i, GenInvalid a) => GenInvalid (Synced i a)--instance (GenUnchecked i, GenUnchecked a, Ord i, Ord a) =>-         GenUnchecked (SyncRequest i a)--instance (GenValid i, GenValid a, Ord i, Ord a) =>-         GenValid (SyncRequest i a) where-    genValid =-        (SyncRequest <$> genValid <*> genValid <*> genValid) `suchThat` isValid--instance (GenInvalid i, GenInvalid a, Ord i, Ord a) =>-         GenInvalid (SyncRequest i a)--instance (GenUnchecked i, GenUnchecked a, Ord i, Ord a) =>-         GenUnchecked (SyncResponse i a)--instance (GenValid i, GenValid a, Ord i, Ord a) =>-         GenValid (SyncResponse i a) where-    genValid =-        (SyncResponse <$> genValid <*> genValid <*> genValid) `suchThat` isValid--instance (GenInvalid i, GenInvalid a, Ord i, Ord a) =>-         GenInvalid (SyncResponse i a)--instance GenUnchecked a => GenUnchecked (CentralItem a)--instance GenValid a => GenValid (CentralItem a) where-    genValid =-        (CentralItem <$> genValid <*> genValid <*> genValid) `suchThat` isValid--instance GenInvalid a => GenInvalid (CentralItem a)--instance (GenUnchecked i, GenUnchecked a, Ord i, Ord a) =>-         GenUnchecked (CentralStore i a)--instance (GenValid i, GenValid a, Ord i, Ord a) =>-         GenValid (CentralStore i a) where-    genValid = (CentralStore <$> genValid) `suchThat` isValid+module Data.GenValidity.Mergeless+  ( module Data.GenValidity.Mergeless.Collection+  ) where -instance (GenInvalid i, GenInvalid a, Ord i, Ord a) =>-         GenInvalid (CentralStore i a)+import Data.GenValidity.Mergeless.Collection

@@ -0,0 +1,109 @@+{-# LANGUAGE RecordWildCards #-}+{-# LANGUAGE ScopedTypeVariables #-}+{-# OPTIONS_GHC -fno-warn-orphans #-}++module Data.GenValidity.Mergeless.Collection where++import qualified Data.Map as M+import Data.Map (Map)+import qualified Data.Set as S+import Data.Set (Set)++import Control.Monad++import Data.GenValidity+import Data.GenValidity.Containers ()+import Data.GenValidity.Time ()+import Test.QuickCheck++import Data.GenValidity.Mergeless.Item ()+import Data.Mergeless++instance GenUnchecked ClientId++instance GenValid ClientId where+  genValid = genValidStructurallyWithoutExtraChecking+  shrinkValid = shrinkValidStructurallyWithoutExtraFiltering++instance (GenUnchecked i, GenUnchecked a, Show i, Show a, Ord i, Ord a) =>+         GenUnchecked (ClientStore i a)++instance (GenValid i, GenValid a, Show i, Show a, Ord i, Ord a) => GenValid (ClientStore i a) where+  genValid =+    sized $ \n -> do+      (a, b, c) <- genSplit3 n+      (s1, s2) <- resize (a + b) (genValid >>= splitSet)+      clientStoreAdded <- resize c genValid+      clientStoreSynced <- mapWithIds s1+      let clientStoreDeleted = s2+      pure ClientStore {..}+  shrinkValid = shrinkValidStructurally++instance (GenUnchecked i, GenUnchecked a, Show i, Show a, GenInvalid i, GenInvalid a, Ord i, Ord a) =>+         GenInvalid (ClientStore i a)++instance (GenUnchecked i, GenUnchecked a, Show i, Show a, Ord i, Ord a) =>+         GenUnchecked (SyncRequest i a)++instance (GenValid i, GenValid a, Show i, Show a, Ord i, Ord a) => GenValid (SyncRequest i a) where+  genValid =+    sized $ \n -> do+      (a, b, c) <- genSplit3 n+      (s1, s2) <- resize (a + b) (genValid >>= splitSet)+      syncRequestAdded <- resize c genValid+      let syncRequestSynced = s1+      let syncRequestDeleted = s2+      pure SyncRequest {..}+  shrinkValid = shrinkValidStructurally++instance (GenUnchecked i, GenUnchecked a, Show i, Show a, GenInvalid i, GenInvalid a, Ord i, Ord a) =>+         GenInvalid (SyncRequest i a)++instance (GenUnchecked i, GenUnchecked a, Show i, Show a, Ord i, Ord a) =>+         GenUnchecked (SyncResponse i a)++instance (GenValid i, GenValid a, Show i, Show a, Ord i, Ord a) => GenValid (SyncResponse i a) where+  genValid = do+    (s1, s2) <- genValid >>= splitSet+    (s3, s4) <- splitSet s1+    (s5, s6) <- splitSet s2+    syncResponseClientAdded <-+      fmap M.fromList $+      forM (S.toList s3) $ \i -> do+        cid <- genValid -- TODO maybe we can find a way to not generate duplicate client ids and speed up this generator, but it's fine for now.+        pure (cid, i)+    let syncResponseClientDeleted = s4+    syncResponseServerAdded <- mapWithIds s5+    let syncResponseServerDeleted = s6+    pure SyncResponse {..}+  shrinkValid = shrinkValidStructurally++splitSet :: Ord i => Set i -> Gen (Set i, Set i)+splitSet s =+  if S.null s+    then pure (S.empty, S.empty)+    else do+      a <- elements $ S.toList s+      pure $ S.split a s++mapWithIds :: (Ord i, GenValid a) => Set i -> Gen (Map i a)+mapWithIds s = fmap M.fromList $ forM (S.toList s) $ \i -> (,) i <$> genValid++instance (GenUnchecked i, GenUnchecked a, Show i, Show a, GenInvalid i, GenInvalid a, Ord i, Ord a) =>+         GenInvalid (SyncResponse i a)++instance (GenUnchecked i, GenUnchecked a, Ord i, Ord a) => GenUnchecked (ServerStore i a)++instance (GenValid i, GenValid a, Show i, Show a, Ord i, Ord a) => GenValid (ServerStore i a) where+  genValid = genValidStructurallyWithoutExtraChecking+  shrinkValid = shrinkValidStructurallyWithoutExtraFiltering++instance (GenUnchecked i, GenUnchecked a, Show i, Show a, GenInvalid i, GenInvalid a, Ord i, Ord a) =>+         GenInvalid (ServerStore i a)++genUnsyncedStore ::+     forall i a. (Ord i, Ord a, GenValid i, GenValid a)+  => Gen (ClientStore i a)+genUnsyncedStore = do+  as <- genValid+  pure $ emptyClientStore {clientStoreAdded = as}

@@ -0,0 +1,34 @@+{-# LANGUAGE ScopedTypeVariables #-}+{-# OPTIONS_GHC -fno-warn-orphans #-}++module Data.GenValidity.Mergeless.Item where++import Data.GenValidity+import Data.GenValidity.Containers ()+import Data.GenValidity.Time ()++import Data.Mergeless.Item++instance GenUnchecked a => GenUnchecked (ClientItem a)++instance GenValid a => GenValid (ClientItem a) where+  genValid = genValidStructurallyWithoutExtraChecking+  shrinkValid = shrinkValidStructurallyWithoutExtraFiltering++instance GenUnchecked a => GenUnchecked (ItemSyncRequest a)++instance GenValid a => GenValid (ItemSyncRequest a) where+  genValid = genValidStructurallyWithoutExtraChecking+  shrinkValid = shrinkValidStructurallyWithoutExtraFiltering++instance GenUnchecked a => GenUnchecked (ItemSyncResponse a)++instance GenValid a => GenValid (ItemSyncResponse a) where+  genValid = genValidStructurallyWithoutExtraChecking+  shrinkValid = shrinkValidStructurallyWithoutExtraFiltering++instance GenUnchecked a => GenUnchecked (ServerItem a)++instance GenValid a => GenValid (ServerItem a) where+  genValid = genValidStructurallyWithoutExtraChecking+  shrinkValid = shrinkValidStructurallyWithoutExtraFiltering

@@ -0,0 +1,439 @@+{-# LANGUAGE DeriveGeneric #-}+{-# LANGUAGE GeneralizedNewtypeDeriving #-}+{-# LANGUAGE RankNTypes #-}+{-# LANGUAGE ScopedTypeVariables #-}+{-# LANGUAGE TypeApplications #-}++module Data.Mergeless.CollectionSpec+  ( spec+  ) where++import Data.Int (Int)+import Data.List+import qualified Data.Map.Strict as M+import Data.Ord+import qualified Data.Set as S+import GHC.Generics (Generic)+import System.Random++import Control.Monad.State++import Test.Hspec+import Test.QuickCheck+import Test.Validity+import Test.Validity.Aeson++import Data.GenValidity.Mergeless.Collection ()+import Data.GenValidity.UUID ()+import Data.Mergeless.Collection+import Data.UUID++{-# ANN module ("HLint: ignore Reduce duplication" :: String) #-}++spec :: Spec+spec = do+  genValidSpec @(ClientStore Int Int)+  jsonSpecOnValid @(ClientStore Int Int)+  genValidSpec @(SyncRequest Int Int)+  jsonSpecOnValid @(SyncRequest Int Int)+  genValidSpec @(SyncResponse Int Int)+  jsonSpecOnValid @(SyncResponse Int Int)+  genValidSpec @(ServerStore Int Int)+  jsonSpecOnValid @(ServerStore Int Int)+  describe "emptyStore" $ it "is valid" $ shouldBeValid (emptyClientStore @Int @Int)+  describe "storeSize" $ do+    it "does not crash" $ producesValidsOnValids (storeSize @Int @Int)+    specify "adding an item makes the store bigger" $+      forAllValid $ \store ->+        forAllValid $ \added -> do+          let size1 = storeSize (store :: ClientStore Int Int)+          let store' = addItemToClientStore added store+          let size2 = storeSize store'+          size2 `shouldBe` (size1 + 1)+    specify "deleting an unsynced item after adding it leaves the store with the original size" $+      forAllValid $ \store ->+        forAllValid $ \added ->+          let size1 = storeSize (store :: ClientStore Int Int)+              store' = addItemToClientStore added store+           in case sortOn (Down . fst) $ M.toList (clientStoreAdded store') of+                [] -> expectationFailure "Expected a nonempty list"+                (i, _):_ ->+                  let store'' = deleteUnsyncedFromClientStore i store'+                      size2 = storeSize store''+                   in size2 `shouldBe` size1+    specify "deleting a synced item after adding it leaves the store with the original size" $+      forAllValid $ \store ->+        forAll (genValid `suchThat` (\uuid -> not $ M.member uuid $ clientStoreSynced store)) $ \uuid ->+          forAllValid $ \synced ->+            let size1 = storeSize (store :: ClientStore Int Int)+                store' = store {clientStoreSynced = M.insert uuid synced $ clientStoreSynced store}+                store'' = deleteSyncedFromClientStore uuid store'+                size2 = storeSize store''+             in size2 `shouldBe` size1+  describe "addItemToClientStore" $+    it "produces valid stores" $ producesValidsOnValids2 (addItemToClientStore @Int @Int)+  describe "deleteUnsyncedFromClientStore" $+    it "produces valid stores" $ producesValidsOnValids2 (deleteUnsyncedFromClientStore @Int @Int)+  describe "deleteSyncedFromClientStore" $+    it "produces valid stores" $ producesValidsOnValids2 (deleteSyncedFromClientStore @Int @Int)+  describe "makeSyncRequest" $+    it "produces valid sync requests" $ producesValidsOnValids (makeSyncRequest @Int @Int)+  describe "mergeSyncResponse" $ do+    it "produces valid sync stores" $ producesValidsOnValids2 (mergeSyncResponse @Int @Int)+    it "adds the single item that the server tells it to add to an empty client store" $+      forAllValid $ \cid ->+        forAllValid $ \a ->+          forAllValid $ \u -> do+            let cstore1 = emptyClientStore {clientStoreAdded = M.singleton cid (a :: Int)}+                resp = emptySyncResponse {syncResponseClientAdded = M.singleton cid (u :: Int)}+                cstore2 = mergeSyncResponse cstore1 resp+            clientStoreSynced cstore2 `shouldBe` M.singleton u a+    it "deletes items that the server instructed to be deleted" $+      forAllValid $ \cs ->+        forAllValid $ \sr -> do+          let cs' = mergeSyncResponse @Int @Int cs sr+          clientStoreDeleted cs' `shouldBe`+            (clientStoreDeleted cs `S.difference` syncResponseClientDeleted sr)+  describe "processServerSync" $+    describe "deterministic UUIDs" $ serverSyncSpec @Int evalDM $ processServerSync genD++serverSyncSpec ::+     forall a i m. (Show i, Ord i, GenValid i, Show a, Ord a, GenValid a, MonadIO m)+  => (forall r. m r -> IO r)+  -> (ServerStore i a -> SyncRequest i a -> m (SyncResponse i a, ServerStore i a))+  -> Spec+serverSyncSpec eval func = do+  describe "Single client" $ do+    describe "Single-item" $ do+      it "succesfully downloads a single item from the server for an empty client" $+        forAllValid $ \u ->+          forAllValid $ \i ->+            eval $ do+              let sstore1 = emptyServerStore {serverStoreItems = M.singleton u i}+              let cstore1 = emptyClientStore+              let req = makeSyncRequest cstore1+              (resp, sstore2) <- func sstore1 req+              let cstore2 = mergeSyncResponse cstore1 resp+              liftIO $ do+                sstore2 `shouldBe` sstore1+                clientStoreSynced cstore2 `shouldBe` serverStoreItems sstore2+      it "succesfully uploads a single item to the server for an empty server" $+        forAllValid $ \c ->+          forAllValid $ \i ->+            eval $ do+              let cstore1 = emptyClientStore {clientStoreAdded = M.singleton c i}+              let sstore1 = emptyServerStore+              let req = makeSyncRequest cstore1+              (resp, sstore2) <- func sstore1 req+              let cstore2 = mergeSyncResponse cstore1 resp+              liftIO $ do+                clientStoreSynced cstore2 `shouldBe` serverStoreItems sstore2+                sort (M.elems (clientStoreSynced cstore2)) `shouldBe`+                  sort (M.elems $ M.singleton c i)+    describe "Multi-item" $ do+      it "succesfully downloads everything from the server for an empty client" $+        forAllValid $ \sstore1 ->+          eval $ do+            let cstore1 = emptyClientStore+            let req = makeSyncRequest cstore1+            (resp, sstore2) <- func sstore1 req+            let cstore2 = mergeSyncResponse cstore1 resp+            liftIO $ do+              sstore2 `shouldBe` sstore1+              clientStoreSynced cstore2 `shouldBe` serverStoreItems sstore2+      it "succesfully uploads everything to the server for an empty server" $+        forAllValid $ \items ->+          eval $ do+            let cstore1 = emptyClientStore {clientStoreAdded = items}+            let sstore1 = emptyServerStore+            let req = makeSyncRequest cstore1+            (resp, sstore2) <- func sstore1 req+            let cstore2 = mergeSyncResponse cstore1 resp+            liftIO $ do+              clientStoreSynced cstore2 `shouldBe` serverStoreItems sstore2+              sort (M.elems (clientStoreSynced cstore2)) `shouldBe` sort (M.elems items)+      it "is idempotent with one client" $+        forAllValid $ \cstore1 ->+          forAllValid $ \sstore1 ->+            eval $ do+              let req1 = makeSyncRequest cstore1+              (resp1, sstore2) <- func sstore1 req1+              let cstore2 = mergeSyncResponse cstore1 resp1+                  req2 = makeSyncRequest cstore2+              (resp2, sstore3) <- func sstore2 req2+              let cstore3 = mergeSyncResponse cstore2 resp2+              liftIO $ do+                cstore2 `shouldBe` cstore3+                sstore2 `shouldBe` sstore3+  describe "Multiple clients" $ do+    describe "Single-item" $ do+      it "successfully syncs an addition accross to a second client" $+        forAllValid $ \i ->+          eval $ do+            let cAstore1 = emptyClientStore {clientStoreAdded = M.singleton (ClientId 0) i}+              -- Client B is empty+            let cBstore1 = emptyClientStore+              -- The server is empty+            let sstore1 = emptyServerStore+              -- Client A makes sync request 1+            let req1 = makeSyncRequest cAstore1+              -- The server processes sync request 1+            (resp1, sstore2) <- func sstore1 req1+            let addedItems = syncResponseClientAdded resp1+            case M.toList addedItems of+              [(ClientId 0, clientAdditionId)] -> do+                let items = M.singleton clientAdditionId i+                liftIO $ sstore2 `shouldBe` (ServerStore {serverStoreItems = items})+                  -- Client A merges the response+                let cAstore2 = mergeSyncResponse cAstore1 resp1+                liftIO $ cAstore2 `shouldBe` (emptyClientStore {clientStoreSynced = items})+                  -- Client B makes sync request 2+                let req2 = makeSyncRequest cBstore1+                  -- The server processes sync request 2+                (resp2, sstore3) <- func sstore2 req2+                liftIO $ do+                  resp2 `shouldBe` (emptySyncResponse {syncResponseServerAdded = items})+                  sstore3 `shouldBe` sstore2+                --  pPrint cBstore2+                  -- Client B merges the response+                let cBstore2 = mergeSyncResponse cBstore1 resp2+                liftIO $ cBstore2 `shouldBe` (emptyClientStore {clientStoreSynced = items})+                  -- Client A and Client B now have the same store+                liftIO $ cAstore2 `shouldBe` cBstore2+              _ -> liftIO $ expectationFailure "Should have found exactly one added item."+      it "succesfully syncs a deletion across to a second client" $+        forAllValid $ \uuid ->+          forAllValid $ \i ->+            eval $ do+              let cAstore1 = emptyClientStore {clientStoreSynced = M.singleton uuid i}+                  -- Client A has a synced item.+                  -- Client B had synced that same item, but has since deleted it.+              let cBstore1 = emptyClientStore {clientStoreDeleted = S.singleton uuid}+                  -- The server still has the undeleted item+              let sstore1 = ServerStore {serverStoreItems = M.singleton uuid i}+                  -- Client B makes sync request 1+              let req1 = makeSyncRequest cBstore1+                  -- The server processes sync request 1+              (resp1, sstore2) <- func sstore1 req1+              liftIO $ do+                resp1 `shouldBe` emptySyncResponse {syncResponseClientDeleted = S.singleton uuid}+                sstore2 `shouldBe` emptyServerStore+                  -- Client B merges the response+              let cBstore2 = mergeSyncResponse cBstore1 resp1+              liftIO $ cBstore2 `shouldBe` emptyClientStore+                  -- Client A makes sync request 2+              let req2 = makeSyncRequest cAstore1+                  -- The server processes sync request 2+              (resp2, sstore3) <- func sstore2 req2+              liftIO $ do+                resp2 `shouldBe` emptySyncResponse {syncResponseServerDeleted = S.singleton uuid}+                sstore3 `shouldBe` sstore2+                  -- Client A merges the response+              let cAstore2 = mergeSyncResponse cAstore1 resp2+              liftIO $ cAstore2 `shouldBe` emptyClientStore+                  -- Client A and Client B now have the same store+              liftIO $ cAstore2 `shouldBe` cBstore2+      it "does not run into a conflict if two clients both try to sync a deletion" $+        forAllValid $ \uuid ->+          forAllValid $ \i ->+            eval $ do+              let cAstore1 = emptyClientStore {clientStoreDeleted = S.singleton uuid}+                  -- Both client a and client b delete an item.+              let cBstore1 = emptyClientStore {clientStoreDeleted = S.singleton uuid}+                  -- The server still has the undeleted item+              let sstore1 = ServerStore {serverStoreItems = M.singleton uuid i}+                  -- Client A makes sync request 1+              let req1 = makeSyncRequest cAstore1+                  -- The server processes sync request 1+              (resp1, sstore2) <- func sstore1 req1+              liftIO $ do+                resp1 `shouldBe` (emptySyncResponse {syncResponseClientDeleted = S.singleton uuid})+                sstore2 `shouldBe` (ServerStore {serverStoreItems = M.empty})+                  -- Client A merges the response+              let cAstore2 = mergeSyncResponse cAstore1 resp1+              liftIO $ cAstore2 `shouldBe` emptyClientStore+                  -- Client B makes sync request 2+              let req2 = makeSyncRequest cBstore1+                  -- The server processes sync request 2+              (resp2, sstore3) <- func sstore2 req2+              liftIO $ do+                resp2 `shouldBe` (emptySyncResponse {syncResponseClientDeleted = S.singleton uuid})+                sstore3 `shouldBe` sstore2+                  -- Client B merges the response+              let cBstore2 = mergeSyncResponse cBstore1 resp2+              liftIO $ do+                cBstore2 `shouldBe` emptyClientStore+                    -- Client A and Client B now have the same store+                cAstore2 `shouldBe` cBstore2+    describe "Multiple items" $ do+      it+        "makes no change if the sync request reflects the same local state with an empty sync response" $+        forAllValid $ \sis -> do+          let cs = ServerStore sis+          (sr, cs') <-+            eval $+            func cs $+            SyncRequest+              { syncRequestAdded = M.empty+              , syncRequestSynced = M.keysSet sis+              , syncRequestDeleted = S.empty+              }+          cs' `shouldBe` cs+          sr `shouldBe`+            SyncResponse+              { syncResponseClientAdded = M.empty+              , syncResponseClientDeleted = S.empty+              , syncResponseServerAdded = M.empty+              , syncResponseServerDeleted = S.empty+              }+      it "successfully syncs additions accross to a second client" $+        forAllValid $ \is ->+          eval $ do+            let cAstore1 = emptyClientStore {clientStoreAdded = is}+              -- Client B is empty+            let cBstore1 = emptyClientStore+              -- The server is empty+            let sstore1 = emptyServerStore+              -- Client A makes sync request 1+            let req1 = makeSyncRequest cAstore1+              -- The server processes sync request 1+            (resp1, sstore2) <- func sstore1 req1+              -- Client A merges the response+            let cAstore2 = mergeSyncResponse cAstore1 resp1+            let items = clientStoreSynced cAstore2+            liftIO $ do+              clientStoreAdded cAstore2 `shouldBe` M.empty+              sstore2 `shouldBe` (ServerStore {serverStoreItems = items})+            liftIO $ cAstore2 `shouldBe` (emptyClientStore {clientStoreSynced = items})+              -- Client B makes sync request 2+            let req2 = makeSyncRequest cBstore1+              -- The server processes sync request 2+            (resp2, sstore3) <- func sstore2 req2+            liftIO $ do+              resp2 `shouldBe` (emptySyncResponse {syncResponseServerAdded = items})+              sstore3 `shouldBe` sstore2+              -- Client B merges the response+            let cBstore2 = mergeSyncResponse cBstore1 resp2+            liftIO $ cBstore2 `shouldBe` (emptyClientStore {clientStoreSynced = items})+              -- Client A and Client B now have the same store+            liftIO $ cAstore2 `shouldBe` cBstore2+      it "succesfully syncs deletions across to a second client" $+        forAllValid $ \syncedItems ->+          eval $ do+            let itemIds = M.keysSet syncedItems+            let cAstore1 = emptyClientStore {clientStoreSynced = syncedItems}+                -- Client A has synced items+                -- Client B had synced the same items, but has since deleted them.+            let cBstore1 = emptyClientStore {clientStoreDeleted = itemIds}+                -- The server still has the undeleted item+            let sstore1 = ServerStore {serverStoreItems = syncedItems}+                -- Client B makes sync request 1+            let req1 = makeSyncRequest cBstore1+                -- The server processes sync request 1+            (resp1, sstore2) <- func sstore1 req1+            liftIO $ do+              resp1 `shouldBe` emptySyncResponse {syncResponseClientDeleted = itemIds}+              sstore2 `shouldBe` emptyServerStore+                -- Client B merges the response+            let cBstore2 = mergeSyncResponse cBstore1 resp1+            liftIO $ cBstore2 `shouldBe` emptyClientStore+                -- Client A makes sync request 2+            let req2 = makeSyncRequest cAstore1+                -- The server processes sync request 2+            (resp2, sstore3) <- func sstore2 req2+            liftIO $ do+              resp2 `shouldBe` emptySyncResponse {syncResponseServerDeleted = itemIds}+              sstore3 `shouldBe` sstore2+                -- Client A merges the response+            let cAstore2 = mergeSyncResponse cAstore1 resp2+            liftIO $ cAstore2 `shouldBe` emptyClientStore+                -- Client A and Client B now have the same store+            liftIO $ cAstore2 `shouldBe` cBstore2+      it "does not run into a conflict if two clients both try to sync a deletion" $+        forAllValid $ \items ->+          eval $ do+            let cAstore1 = emptyClientStore {clientStoreDeleted = M.keysSet items}+                -- Both client a and client b delete their items.+            let cBstore1 = emptyClientStore {clientStoreDeleted = M.keysSet items}+                -- The server still has the undeleted items+            let sstore1 = ServerStore {serverStoreItems = items}+                -- Client A makes sync request 1+            let req1 = makeSyncRequest cAstore1+                -- The server processes sync request 1+            (resp1, sstore2) <- func sstore1 req1+            liftIO $ 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+            let cAstore2 = mergeSyncResponse cAstore1 resp1+            liftIO $ cAstore2 `shouldBe` emptyClientStore+                -- Client B makes sync request 2+            let req2 = makeSyncRequest cBstore1+                -- The server processes sync request 2+            (resp2, sstore3) <- func sstore2 req2+            liftIO $ do+              resp2 `shouldBe` (emptySyncResponse {syncResponseClientDeleted = M.keysSet items})+              sstore3 `shouldBe` sstore2+                -- Client B merges the response+            let cBstore2 = mergeSyncResponse cBstore1 resp2+            liftIO $ do+              cBstore2 `shouldBe` emptyClientStore+                  -- Client A and Client B now have the same store+              cAstore2 `shouldBe` cBstore2+  describe "General properties" $ do+    it "produces valid results" $+      forAllValid $ \cs ->+        forAllValid $ \sr -> do+          res <- eval $ func cs sr+          shouldBeValid res+    it "successfully syncs two clients using a central store" $+      forAllValid $ \store1 ->+        eval $ do+          let central = ServerStore M.empty+          let store2 = emptyClientStore+          let sreq1 = makeSyncRequest store1+          (sresp1, central') <- func central sreq1+          let store1' = mergeSyncResponse store1 sresp1+          let sreq2 = makeSyncRequest store2+          (sresp2, central'') <- func central' sreq2+          let store2' = mergeSyncResponse store2 sresp2+          let sreq3 = makeSyncRequest store1'+          (sresp3, _) <- func central'' sreq3+          let store1'' = mergeSyncResponse store1' sresp3+          liftIO $ store1'' `shouldBe` store2'+    it "ensures that syncing is idempotent" $+      forAllValid $ \central1 ->+        forAllValid $ \local1 ->+          eval $ do+            let sreq1 = makeSyncRequest local1+            (sresp1, central2) <- func central1 sreq1+            let local2 = mergeSyncResponse local1 sresp1+            let sreq2 = makeSyncRequest local2+            (sresp2, central3) <- func central2 sreq2+            let local3 = mergeSyncResponse local2 sresp2+            liftIO $ do+              local2 `shouldBe` local3+              central2 `shouldBe` central3++newtype D m a =+  D+    { unD :: StateT StdGen m a+    }+  deriving (Generic, Functor, Applicative, Monad, MonadState StdGen, MonadTrans, MonadIO)++-- evalD :: D Identity a -> a+-- evalD = runIdentity . evalDM+-- runD :: D Identity a -> StdGen -> (a, StdGen)+-- runD = runState . unD+evalDM :: Functor m => D m a -> m a+evalDM d = fst <$> runDM d (mkStdGen 42)++runDM :: D m a -> StdGen -> m (a, StdGen)+runDM = runStateT . unD++genD :: Monad m => D m UUID+genD = do+  r <- get+  let (u, r') = random r+  put r'+  pure u

@@ -0,0 +1,104 @@+{-# LANGUAGE TypeApplications #-}++module Data.Mergeless.ItemSpec+  ( spec+  ) where++import Data.Int (Int)++import Test.Hspec+import Test.Validity+import Test.Validity.Aeson++import Data.GenValidity.Mergeless.Item ()+import Data.GenValidity.UUID ()+import Data.Mergeless.Item++{-# ANN module ("HLint: ignore Reduce duplication" :: String) #-}++spec :: Spec+spec = do+  eqSpecOnValid @(ClientItem Int)+  genValidSpec @(ClientItem Int)+  jsonSpecOnValid @(ClientItem Int)+  eqSpecOnValid @(ItemSyncRequest Int)+  genValidSpec @(ItemSyncRequest Int)+  jsonSpecOnValid @(ItemSyncRequest Int)+  eqSpecOnValid @(ItemSyncResponse Int)+  genValidSpec @(ItemSyncResponse Int)+  jsonSpecOnValid @(ItemSyncResponse Int)+  eqSpecOnValid @(ServerItem Int)+  genValidSpec @(ServerItem Int)+  jsonSpecOnValid @(ServerItem Int)+  describe "makeItemSyncrequest" $+    it "produces valid requests" $ producesValidsOnValids (makeItemSyncRequest @Int)+  describe "mergeItemSyncResponse" $+    it "produces valid client items" $ producesValidsOnValids2 (mergeItemSyncResponse @Int)+  describe "processItemSync" $+    it "produces valid tuples" $ producesValidsOnValids2 (processServerItemSync @Int)+  describe "processItemSync" $ do+    describe "Interaction" $ do+      it "makes no changes if the sync request reflects the state of the empty server" $ do+        let store1 = ServerItemEmpty+            req = ItemSyncRequestPoll+        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 $ \s -> do+          let store1 = ServerItemFull s+              req = ItemSyncRequestKnown+          let (resp, store2) = processServerItemSync @Int store1 req+          store2 `shouldBe` store1+          resp `shouldBe` ItemSyncResponseInSyncFull+    describe "Client changes" $ do+      it "adds the item that the client tells the server to add" $+        forAllValid $ \a -> do+          let store1 = ServerItemEmpty+              req = ItemSyncRequestNew a+          let (resp, store2) = processServerItemSync @Int store1 req+          store2 `shouldBe` ServerItemFull a+          resp `shouldBe` ItemSyncResponseClientAdded+      it "deletes the item that the client tells the server to delete" $+        forAllValid $ \s -> do+          let store1 = ServerItemFull s+              req = ItemSyncRequestDeleted+          let (resp, store2) = processServerItemSync @Int store1 req+          store2 `shouldBe` ServerItemEmpty+          resp `shouldBe` ItemSyncResponseClientDeleted+    describe "Server changes" $ do+      it "tells the client that there is a new item at the server side" $+        forAllValid $ \s -> do+          let store1 = ServerItemFull s+              req = ItemSyncRequestPoll+          let (resp, store2) = processServerItemSync @Int store1 req+          store2 `shouldBe` store1+          resp `shouldBe` ItemSyncResponseServerAdded s+      it "tells the client that there is a deleted item at the server side" $ do+        let store1 = ServerItemEmpty+            req = ItemSyncRequestKnown+        let (resp, store2) = processServerItemSync @Int store1 req+        store2 `shouldBe` store1+        resp `shouldBe` ItemSyncResponseServerDeleted+    describe "High level properties" $ do+      it "it always possible to add an item from scratch" $+        forAllValid $ \a -> do+          let cstore1 = ClientAdded (a :: Int)+          let sstore1 = ServerItemEmpty+          let req1 = makeItemSyncRequest cstore1+              (resp1, sstore2) = processServerItemSync sstore1 req1+              cstore2 = mergeItemSyncResponse cstore1 resp1+          resp1 `shouldBe` ItemSyncResponseClientAdded+          sstore2 `shouldBe` ServerItemFull a+          cstore2 `shouldBe` ClientSynced a+      it "is idempotent with one client" $+        forAllValid $ \si1 ->+          forAllValid $ \ci1 -> do+            let req1 = makeItemSyncRequest @Int ci1+                (resp1, si2) = processServerItemSync si1 req1+                ci2 = mergeItemSyncResponse ci1 resp1+                req2 = makeItemSyncRequest ci2+                (resp2, si3) = processServerItemSync si2 req2+                ci3 = mergeItemSyncResponse ci2 resp2+            ci3 `shouldBe` ci2+            si3 `shouldBe` si2

@@ -1,471 +0,0 @@-{-# LANGUAGE DeriveGeneric #-}-{-# LANGUAGE TypeApplications #-}-{-# LANGUAGE GeneralizedNewtypeDeriving #-}--module Data.MergelessSpec-    ( spec-    ) where--import qualified Data.Map.Strict as M-import qualified Data.Set as S-import Data.Time-import qualified Data.UUID.Typed as Typed-import GHC.Generics (Generic)-import System.Random--import Control.Monad.State--import Test.Hspec-import Test.QuickCheck-import Test.Validity-import Test.Validity.Aeson--import Data.GenValidity.Mergeless ()-import Data.GenValidity.UUID.Typed ()-import Data.Mergeless-import Data.UUID.Typed--{-# ANN module ("HLint: ignore Reduce duplication" :: String) #-}--spec :: Spec-spec = do-    eqSpecOnValid @(Store Double Double)-    ordSpecOnValid @(Store Double Double)-    genValiditySpec @(Store Double Double)-    jsonSpecOnValid @(Store Double Double)-    eqSpecOnValid @(StoreItem Double Double)-    ordSpecOnValid @(StoreItem Double Double)-    genValiditySpec @(StoreItem Double Double)-    jsonSpecOnValid @(StoreItem Double Double)-    eqSpecOnValid @(Added Double)-    ordSpecOnValid @(Added Double)-    genValiditySpec @(Added Double)-    jsonSpecOnValid @(Added Double)-    eqSpecOnValid @(Synced Double Double)-    ordSpecOnValid @(Synced Double Double)-    genValiditySpec @(Synced Double Double)-    jsonSpecOnValid @(Synced Double Double)-    eqSpecOnValid @(SyncRequest Double Double)-    ordSpecOnValid @(SyncRequest Double Double)-    genValiditySpec @(SyncRequest Double Double)-    jsonSpecOnValid @(SyncRequest Double Double)-    eqSpecOnValid @(SyncResponse Double Double)-    ordSpecOnValid @(SyncResponse Double Double)-    genValiditySpec @(SyncResponse Double Double)-    jsonSpecOnValid @(SyncResponse Double Double)-    eqSpecOnValid @(CentralItem Double)-    ordSpecOnValid @(CentralItem Double)-    genValiditySpec @(CentralItem Double)-    jsonSpecOnValid @(CentralItem Double)-    eqSpecOnValid @(CentralStore Double Double)-    ordSpecOnValid @(CentralStore Double Double)-    genValiditySpec @(CentralStore Double Double)-    jsonSpecOnValid @(CentralStore Double Double)-    describe "makeSyncRequest" $-        it "produces valid sync requests" $-        producesValidsOnValids (makeSyncRequest @Double @Double)-    describe "mergeSyncResponse" $-        it "produces valid sync stores" $-        producesValidsOnValids2 (mergeSyncResponse @Double @Double)-    describe "processSyncWith" $ do-        it-            "makes no change if the sync request reflects the same local state with an empty sync response" $-            forAllValid $ \synct ->-                forAllValid $ \sis -> do-                    let cs = CentralStore sis-                    let (sr, cs') =-                            evalD $-                            processSyncWith @(UUID Double) @Double genD synct cs $-                            SyncRequest S.empty (M.keysSet sis) S.empty-                    cs' `shouldBe` cs-                    sr `shouldBe` SyncResponse S.empty S.empty S.empty-        it "deletes the deleted items" $-            forAllValid $ \synct ->-                forAllValid $ \cs ->-                    forAllValid $ \sreq -> do-                        let (_, cs') =-                                evalD $-                                processSyncWith-                                    @(UUID Double)-                                    @Double-                                    genD-                                    synct-                                    cs-                                    sreq-                        syncRequestUndeletedItems sreq `shouldSatisfy`-                            (not .-                             any-                                 (`S.member` (M.keysSet $ centralStoreItems cs')))-        it "returns the items that were added in the sync response" $-            forAllValid $ \synct ->-                forAllValid $ \cs ->-                    forAllValid $ \sreq -> do-                        let (sresp, _) =-                                evalD $-                                processSyncWith-                                    @(UUID Double)-                                    @Double-                                    genD-                                    synct-                                    cs-                                    sreq-                        S.map syncedValue (syncResponseAddedItems sresp) `shouldBe`-                            S.map addedValue (syncRequestAddedItems sreq)-        it "returns the single added item" $-            forAllValid $ \synct ->-                forAllValid $ \cs ->-                    forAllValid $ \ai -> do-                        let (sresp, _) =-                                evalD $-                                processSyncWith-                                    @(UUID Double)-                                    @Double-                                    genD-                                    synct-                                    cs-                                    SyncRequest-                                    { syncRequestAddedItems = S.singleton ai-                                    , syncRequestSyncedItems = S.empty-                                    , syncRequestUndeletedItems = S.empty-                                    }-                        S.map syncedValue (syncResponseAddedItems sresp) `shouldBe`-                            S.singleton (addedValue ai)-        it "adds the items that were added" $-            forAllValid $ \synct ->-                forAllValid $ \cs ->-                    forAllValid $ \sreq -> do-                        let (_, cs') =-                                evalD $-                                processSyncWith-                                    @(UUID Double)-                                    @Double-                                    genD-                                    synct-                                    cs-                                    sreq-                        S.map addedValue (syncRequestAddedItems sreq) `shouldSatisfy`-                            all-                                (`elem` (M.elems $-                                         M.map centralValue $-                                         centralStoreItems cs'))-        it-            "returns the single remotely added item if the sync request is empty and the central store has one item" $-            forAllValid $ \synct ->-                forAllValid $ \(uuid, ci) -> do-                    let (sresp, _) =-                            evalD $-                            processSyncWith-                                @(UUID Double)-                                @Double-                                genD-                                synct-                                (CentralStore $ M.singleton uuid ci)-                                SyncRequest-                                { syncRequestAddedItems = S.empty-                                , syncRequestSyncedItems = S.empty-                                , syncRequestUndeletedItems = S.empty-                                }-                    S.map syncedValue (syncResponseNewRemoteItems sresp) `shouldBe`-                        S.singleton (centralValue ci)-        it-            "returns all remotely added items when no items are locally added or deleted" $-            forAllValid $ \synct ->-                forAllValid $ \cs ->-                    forAllValid $ \sis -> do-                        let (sresp, _) =-                                evalD $-                                processSyncWith-                                    @(UUID Double)-                                    @Double-                                    genD-                                    synct-                                    cs-                                    SyncRequest-                                    { syncRequestAddedItems = S.empty-                                    , syncRequestSyncedItems = sis-                                    , syncRequestUndeletedItems = S.empty-                                    }-                        S.map syncedUuid (syncResponseNewRemoteItems sresp) `shouldBe`-                            S.difference (M.keysSet $ centralStoreItems cs) sis-        it "returns all remotely added items when no items are locally deleted " $-            forAllValid $ \synct ->-                forAllValid $ \cs ->-                    forAllValid $ \sis ->-                        forAllValid $ \ais -> do-                            let (sresp, _) =-                                    evalD $-                                    processSyncWith-                                        @(UUID Double)-                                        @Double-                                        genD-                                        synct-                                        cs-                                        SyncRequest-                                        { syncRequestAddedItems = ais-                                        , syncRequestSyncedItems = sis-                                        , syncRequestUndeletedItems = S.empty-                                        }-                            S.map syncedUuid (syncResponseNewRemoteItems sresp) `shouldBe`-                                S.difference-                                    (M.keysSet $ centralStoreItems cs)-                                    sis-        it-            "returns all remotely added items that weren't deleted when no items are locally added " $-            forAllValid $ \synct ->-                forAllValid $ \cs ->-                    forAllValid $ \sis ->-                        forAllValid $ \dis -> do-                            let (sresp, _) =-                                    evalD $-                                    processSyncWith-                                        @(UUID Double)-                                        @Double-                                        genD-                                        synct-                                        cs-                                        SyncRequest-                                        { syncRequestAddedItems = S.empty-                                        , syncRequestSyncedItems = sis-                                        , syncRequestUndeletedItems = dis-                                        }-                            S.map syncedUuid (syncResponseNewRemoteItems sresp) `shouldBe`-                                S.difference-                                    (S.difference-                                         (M.keysSet $ centralStoreItems cs)-                                         dis)-                                    sis-        it "returns all remotely added items that weren't deleted" $-            forAllValid $ \synct ->-                forAllValid $ \cs ->-                    forAllValid $ \sreq -> do-                        let (sresp, _) =-                                evalD $-                                processSyncWith-                                    @(UUID Double)-                                    @Double-                                    genD-                                    synct-                                    cs-                                    sreq-                        S.map syncedUuid (syncResponseNewRemoteItems sresp) `shouldBe`-                            S.difference-                                (S.difference-                                     (M.keysSet $ centralStoreItems cs)-                                     (syncRequestUndeletedItems sreq))-                                (syncRequestSyncedItems sreq)-        it-            "successfully syncs two clients using a central store when using incrementing words" $-            forAllValid $ \store1 ->-                forAllValid $ \(synct1, synct2, synct3) -> do-                    let (s1, s2) =-                            evalI $ do-                                let central = CentralStore M.empty-                                let store2 = Store S.empty-                                let sreq1 = makeSyncRequest @Word @Double store1-                                (sresp1, central') <--                                    processSyncWith genI synct1 central sreq1-                                let store1' = mergeSyncResponse store1 sresp1-                                let sreq2 = makeSyncRequest store2-                                (sresp2, central'') <--                                    processSyncWith genI synct2 central' sreq2-                                let store2' = mergeSyncResponse store2 sresp2-                                let sreq3 = makeSyncRequest store1'-                                (sresp3, _) <--                                    processSyncWith genI synct3 central'' sreq3-                                let store1'' = mergeSyncResponse store1' sresp3-                                pure (store1'', store2')-                    s1 `shouldBe` s2-        it-            "successfully syncs two clients using a central store when using deterministic UUIDs" $-            forAllValid $ \store1 ->-                forAllValid $ \(synct1, synct2, synct3) -> do-                    let (s1, s2) =-                            evalD $ do-                                let central = CentralStore M.empty-                                let store2 = Store S.empty-                                let sreq1 =-                                        makeSyncRequest-                                            @(UUID Double)-                                            @Double-                                            store1-                                (sresp1, central') <--                                    processSyncWith genD synct1 central sreq1-                                let store1' = mergeSyncResponse store1 sresp1-                                let sreq2 = makeSyncRequest store2-                                (sresp2, central'') <--                                    processSyncWith genD synct2 central' sreq2-                                let store2' = mergeSyncResponse store2 sresp2-                                let sreq3 = makeSyncRequest store1'-                                (sresp3, _) <--                                    processSyncWith genD synct3 central'' sreq3-                                let store1'' = mergeSyncResponse store1' sresp3-                                pure (store1'', store2')-                    s1 `shouldBe` s2-        it-            "produces valid results when building up a central store from nothing using incrementing words" $-            forAllValid $ \tups ->-                shouldBeValid $-                evalI $ do-                    let initCentralStore = CentralStore M.empty-                    let go cs (store, synct) = do-                            let sreq = makeSyncRequest @Word @Double store-                            (_, central') <- processSyncWith genI synct cs sreq-                            pure central'-                    foldM-                        go-                        initCentralStore-                        (tups :: [(Store Word Double, UTCTime)])-        it-            "produces valid results when building up a central store from nothing using deterministic UUIDs" $-            forAllValid $ \tups ->-                shouldBeValid $-                evalD $ do-                    let initCentralStore = CentralStore M.empty-                    let go cs (store, synct) = do-                            let sreq =-                                    makeSyncRequest @(UUID Double) @Double store-                            (_, central') <- processSyncWith genD synct cs sreq-                            pure central'-                    foldM-                        go-                        initCentralStore-                        (tups :: [(Store (UUID Double) Double, UTCTime)])-        -- This property does not hold.-        xit "produces valid results when using incrementing words" $-            producesValidsOnValids3 $ \synct cs sr ->-                evalI $ processSyncWith @Word @Double genI synct cs sr-        it "produces valid results when using determinisitic UUIDs" $-            producesValidsOnValids3 $ \synct cs sr ->-                evalD $ processSyncWith @(UUID Double) @Double genD synct cs sr-        it "makes syncing idempotent with incrementing words" $-            forAllValid $ \synct1 ->-                forAll (genValid `suchThat` (>= synct1)) $ \synct2 ->-                    forAllValid $ \central1 ->-                        forAllValid $ \local1 -> do-                            let d1 = 0-                            let sreq1 = makeSyncRequest @Word @Double local1-                            let ((sresp1, central2), d2) =-                                    runI-                                        (processSyncWith-                                             genI-                                             synct1-                                             central1-                                             sreq1)-                                        d1-                            let local2 = mergeSyncResponse local1 sresp1-                            let sreq2 = makeSyncRequest local2-                            let ((sresp2, central3), _) =-                                    runI-                                        (processSyncWith-                                             genI-                                             synct2-                                             central2-                                             sreq2)-                                        d2-                            let local3 = mergeSyncResponse local2 sresp2-                            local2 `shouldBe` local3-                            central2 `shouldBe` central3-        it "makes syncing idempotent with deterministic UUIDs" $-            forAllValid $ \synct1 ->-                forAll (genValid `suchThat` (>= synct1)) $ \synct2 ->-                    forAllValid $ \central1 ->-                        forAllValid $ \local1 -> do-                            let d1 = mkStdGen 42-                            let sreq1 =-                                    makeSyncRequest-                                        @(UUID Double)-                                        @Double-                                        local1-                            let ((sresp1, central2), d2) =-                                    runD-                                        (processSyncWith-                                             genD-                                             synct1-                                             central1-                                             sreq1)-                                        d1-                            let local2 = mergeSyncResponse local1 sresp1-                            let sreq2 = makeSyncRequest local2-                            let ((sresp2, central3), _) =-                                    runD-                                        (processSyncWith-                                             genD-                                             synct2-                                             central2-                                             sreq2)-                                        d2-                            let local3 = mergeSyncResponse local2 sresp2-                            local2 `shouldBe` local3-                            central2 `shouldBe` central3-        it "makes syncing idempotent with random UUIDs" $-            forAllValid $ \synct1 ->-                forAll (genValid `suchThat` (>= synct1)) $ \synct2 ->-                    forAllValid $ \central1 ->-                        forAllValid $ \local1 -> do-                            let sreq1 =-                                    makeSyncRequest-                                        @(UUID Double)-                                        @Double-                                        local1-                            (sresp1, central2) <--                                processSyncWith-                                    nextRandomUUID-                                    synct1-                                    central1-                                    sreq1-                            let local2 = mergeSyncResponse local1 sresp1-                            let sreq2 = makeSyncRequest local2-                            (sresp2, central3) <--                                processSyncWith-                                    nextRandomUUID-                                    synct2-                                    central2-                                    sreq2-                            let local3 = mergeSyncResponse local2 sresp2-                            local2 `shouldBe` local3-                            central2 `shouldBe` central3-    describe "processSync" $-        it "makes syncing idempotent when using random UUIDs" $-        forAllValid $ \central1 ->-            forAllValid $ \local1 -> do-                let sreq1 = makeSyncRequest @(UUID Double) @Double local1-                (sresp1, central2) <- processSync nextRandomUUID central1 sreq1-                let local2 = mergeSyncResponse local1 sresp1-                let sreq2 = makeSyncRequest local2-                (sresp2, central3) <- processSync nextRandomUUID central2 sreq2-                let local3 = mergeSyncResponse local2 sresp2-                local2 `shouldBe` local3-                central2 `shouldBe` central3--newtype D a = D-    { unD :: State StdGen a-    } deriving (Generic, Functor, Applicative, Monad, MonadState StdGen)--evalD :: D a -> a-evalD d = fst $ runD d $ mkStdGen 42--runD :: D a -> StdGen -> (a, StdGen)-runD = runState . unD--genD :: D (Typed.UUID a)-genD = do-    r <- get-    let (u, r') = random r-    put r'-    pure u--newtype I a = I-    { unI :: State Word a-    } deriving (Generic, Functor, Applicative, Monad, MonadState Word)--evalI :: I a -> a-evalI i = fst $ runI i 0--runI :: I a -> Word -> (a, Word)-runI = runState . unI--genI :: I Word-genI = do-    i <- get-    modify succ-    pure i