diff --git a/LICENSE b/LICENSE new file mode 100644 --- /dev/null +++ b/LICENSE @@ -0,0 +1,21 @@ +MIT License + +Copyright (c) 2026 James R. Thompson + +Permission is hereby granted, free of charge, to any person obtaining a copy +of this software and associated documentation files (the "Software"), to deal +in the Software without restriction, including without limitation the rights +to use, copy, modify, merge, publish, distribute, sublicense, and/or sell +copies of the Software, and to permit persons to whom the Software is +furnished to do so, subject to the following conditions: + +The above copyright notice and this permission notice shall be included in all +copies or substantial portions of the Software. + +THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR +IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY, +FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE +AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER +LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM, +OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE +SOFTWARE. diff --git a/README.md b/README.md new file mode 100644 --- /dev/null +++ b/README.md @@ -0,0 +1,127 @@ +# Dotted Version Vectors (DVV) + +[![License: MIT](https://img.shields.io/badge/License-MIT-yellow.svg)](https://opensource.org/licenses/MIT) + +A GHC-Haskell implementation of [**Dotted Version Vectors (DVV)**](https://gsd.di.uminho.pt/members/vff/dotted-version-vectors-2012.pdf), a data structure for tracking causality and resolving conflicts in distributed systems. This library is inspired by the canonical Erlang example implementation and leverages GHC to provide a safe and expressive API. + +## Table of Contents + +- [Introduction](#introduction) +- [Key Concepts](#key-concepts) +- [Usage](#usage) + - [Construction](#construction) + - [Recording Events](#recording-events) + - [Synchronization](#synchronization) + - [Conflict Resolution](#conflict-resolution) +- [Type Safety](#type-safety) + +## Introduction + +In distributed systems, multiple actors can concurrently update a piece of data. Traditional version vectors can track which updates happened after others, but they struggle to represent multiple concurrent "siblings" when conflicts occur. + +**Dotted Version Vectors** solve this by combining: +1. **History (Context):** A summary of all events seen by the system. +2. **Dots:** Discrete events (actor + sequence number) that created specific values. +3. **Siblings:** A set of values that are concurrent (i.e., none of them has "seen" the others). + +## Key Concepts + +- **Dot:** A pair `{Actor, Counter}` representing a single write. +- **History (Version Vector):** A mapping from actors to their latest sequence numbers. +- **DVV:** A structure containing a history and a set of active siblings. + +### How it Works + +DVV provides a mechanism for **causal ordering**. When an actor writes a value, it creates a "Dot" – a unique identifier for that specific version of the data. + +```mermaid +graph TD + A[DVV State] --> B(Causal History) + A --> C(Active Siblings) + B --> B1[Actor A: 5] + B --> B2[Actor B: 3] + C --> C1["Dot(A, 6): Value 'X'"] + C --> C2["Dot(B, 4): Value 'Y'"] +``` + +1. **Event Creation:** When actor `A` updates a value, it increments its counter in the DVV's history. The new value is stored associated with the new Dot `(A, next_counter)`. +2. **Causality:** If version `V2` is created knowing about version `V1` (e.g., `V2` was created using `V1` as context), `V2` supersedes `V1`. +3. **Synchronization:** When two DVVs are merged (`sync`), the resulting history is the point-wise maximum of both. Any sibling from one DVV is retained in the merged result *only if* it hasn't been superseded by the other DVV's history. + +## Usage + +### 1. Construction and Initialization + +You can start with an empty DVV or a singleton: + +```haskell +import Data.DVV +import qualified Data.HashMap.Strict as Map + +-- An empty DVV +empty :: DVV String Int +empty = EmptyDVV + +-- A singleton DVV (initial write) +initial :: DVV String Int +initial = SingletonDVV "actor1" 42 +``` + +### 2. Recording Events + +Use `event` to record new updates. You can optionally provide a `VersionVector` as context to indicate which versions the new update supersedes. + +```haskell +-- Recording a new event on top of existing state +-- This will increment actor1's counter. +v1 = event initial Nothing "actor1" 43 + +-- Providing context to prune siblings +-- If 'v1' had multiple siblings, passing its 'context' here would replace them +v2 = event v1 (Just (context v1)) "actor2" 44 +``` + +### 3. Synchronization (Merging) + +Merge two DVVs to resolve their histories and collect concurrent siblings. + +```haskell +let d1 = SingletonDVV "A" 10 + d2 = SingletonDVV "B" 20 + merged = sync d1 d2 +-- 'merged' now contains both values as siblings because they are concurrent. +-- values merged == [10, 20] +``` + +### 4. Conflict Resolution + +When a `sync` results in multiple siblings (a conflict), you can reconcile them. + +#### Manual Reconciliation + +```haskell +-- Pick the maximum value from siblings +let resolved = reconcile max "resolver-actor" merged +``` + +#### Last-Write-Wins (LWW) + +If your values have timestamps or you just want a deterministic winner: + +```haskell +-- Assuming values are (Timestamp, ActualValue) +let lwwResolved = lww (\(t1, _) (t2, _) -> compare t1 t2) "actor" conflictDvv +``` + +## Type Safety + +This library uses `HashMap` internally for efficiency and requires actor IDs to be instances of `Hashable`. The `DVV` type is also an instance of `Functor`, `Foldable`, and `Traversable`, making it easy to manipulate the stored values. + +## Performance Considerations + +- **Singleton Optimization:** `SingletonDVV` is a specialized constructor for the common case of a single value with no complex history, reducing memory overhead. +- **Pruning:** Use the `prune` function to truncate old causal history if the number of actors grows too large, though this should be used with caution as it affects future synchronization accuracy. + +## License + +This project is licensed under the MIT License - see the [LICENSE](LICENSE) file for details. diff --git a/Setup.hs b/Setup.hs new file mode 100644 --- /dev/null +++ b/Setup.hs @@ -0,0 +1,3 @@ +import Distribution.Simple + +main = defaultMain diff --git a/changelog.md b/changelog.md new file mode 100644 --- /dev/null +++ b/changelog.md @@ -0,0 +1,2 @@ +# 0.1.0.0 [James R. Thompson](mailto:jamesthompsonoxford@gmail.com) January 2026 +Initial library for basic DVV definitions and operations. diff --git a/dvv.cabal b/dvv.cabal new file mode 100644 --- /dev/null +++ b/dvv.cabal @@ -0,0 +1,58 @@ +cabal-version: 3.0 +name: dvv +version: 0.1.0.0 +license: MIT +license-file: LICENSE +copyright: 2026-Present, James R. Thompson +maintainer: James R. Thompson +author: James R. Thompson +synopsis: Dotted Version Vectors (DVV) +homepage: https://github.com/jamesthompson/dvv +description: + Dotted Version Vectors (DVV) provide a mechanism for tracking causality + and detecting conflicts in distributed systems. This implementation supports + efficient synchronization, event recording, and conflict resolution. + +category: Data +build-type: Simple +extra-source-files: README.md fourmolu.yaml Setup.hs changelog.md + +source-repository head + type: git + location: https://github.com/jamesthompson/dvv.git + +library + exposed-modules: Data.DVV + hs-source-dirs: src + default-language: Haskell2010 + ghc-options: + -Wall -Wcompat -Widentities -Wincomplete-uni-patterns + -Wincomplete-record-updates -Wredundant-constraints + -Wnoncanonical-monad-instances -Wmissing-export-lists + -Wpartial-fields -Wmissing-deriving-strategies -fwrite-ide-info + -hiedir=.hie + + build-depends: + base >=4.14 && <5, + unordered-containers >=0.2.0.0 && <0.3, + hashable >=1.4.0.0 && <1.6 + +test-suite dvv-test + type: exitcode-stdio-1.0 + main-is: Spec.hs + hs-source-dirs: test + default-language: Haskell2010 + ghc-options: + -Wall -Wcompat -Widentities -Wincomplete-uni-patterns + -Wincomplete-record-updates -Wredundant-constraints + -Wnoncanonical-monad-instances -Wmissing-export-lists + -Wpartial-fields -Wmissing-deriving-strategies -fwrite-ide-info + -hiedir=.hie + + build-depends: + base >=4.14 && <5, + dvv, + hspec, + QuickCheck, + unordered-containers, + hashable diff --git a/fourmolu.yaml b/fourmolu.yaml new file mode 100644 --- /dev/null +++ b/fourmolu.yaml @@ -0,0 +1,77 @@ +# Number of spaces per indentation step +indentation: 2 + +# Max line length for automatic line breaking +column-limit: 80 + +# Styling of arrows in type signatures (choices: trailing, leading, or leading-args) +function-arrows: trailing + +# How to place commas in multi-line lists, records, etc. (choices: leading or trailing) +comma-style: leading + +# Styling of import/export lists (choices: leading, trailing, or diff-friendly) +import-export-style: diff-friendly + +# Rules for grouping import declarations +import-grouping: legacy + +# Whether to full-indent or half-indent 'where' bindings past the preceding body +indent-wheres: false + +# Whether to leave a space before an opening record brace +record-brace-space: false + +# Number of spaces between top-level declarations +newlines-between-decls: 1 + +# How to print Haddock comments (choices: single-line, multi-line, or multi-line-compact) +haddock-style: multi-line + +# How to print module docstring +haddock-style-module: null + +# Where to put docstring comments in function signatures (choices: auto, leading, or trailing) +haddock-location-signature: auto + +# Styling of let blocks (choices: auto, inline, newline, or mixed) +let-style: auto + +# How to align the 'in' keyword with respect to the 'let' keyword (choices: left-align, right-align, or no-space) +in-style: right-align + +# Styling of if-statements (choices: indented or hanging) +if-style: indented + +# Whether to put parentheses around a single constraint (choices: auto, always, or never) +single-constraint-parens: always + +# Whether to put parentheses around a single deriving class (choices: auto, always, or never) +single-deriving-parens: always + +# Whether to sort constraints +sort-constraints: false + +# Whether to sort derived classes +sort-derived-classes: false + +# Whether to sort deriving clauses +sort-deriving-clauses: false + +# Whether to place section operators (those that are infixr 0, such as $) in trailing position, continuing the expression indented below +trailing-section-operators: true + +# Output Unicode syntax (choices: detect, always, or never) +unicode: never + +# Give the programmer more choice on where to insert blank lines +respectful: true + +# Fixity information for operators +fixities: [] + +# Module reexports Fourmolu should know about +reexports: [] + +# Modules defined by the current Cabal package for import grouping +local-modules: [] diff --git a/src/Data/DVV.hs b/src/Data/DVV.hs new file mode 100644 --- /dev/null +++ b/src/Data/DVV.hs @@ -0,0 +1,224 @@ +{-# LANGUAGE DeriveGeneric #-} +{-# LANGUAGE DeriveTraversable #-} +{-# LANGUAGE DerivingStrategies #-} +{-# LANGUAGE ScopedTypeVariables #-} + +-- | +-- Module : Data.DVV +-- Description : Dotted Version Vectors for causal tracking and conflict detection +-- Copyright : (c) James R. Thompson +-- License : BSD3 +-- Stability : experimental +-- +-- Dotted Version Vectors (DVVs) provide a mechanism for tracking causality +-- and detecting conflicts in distributed systems. This implementation supports +-- efficient synchronization, event recording, and conflict resolution. +module Data.DVV + ( -- * Core Types + Count, + Dot (..), + VersionVector, + DVV (..), + + -- * Operations + sync, + context, + event, + values, + prune, + reconcile, + lww, + + -- * Analysis + size, + ) +where + +import Data.HashMap.Strict (HashMap) +import qualified Data.HashMap.Strict as Map +import Data.Hashable (Hashable (hashWithSalt)) +import Data.List (foldl', foldl1') +import Data.Maybe (fromMaybe) +import Data.Word (Word64) +import GHC.Generics (Generic) + +-- | A logical actor's count, 1-indexed, positive only. +type Count = Word64 + +-- | A Dot is a pair of a replica ID and a logical counter. +data Dot actorID = Dot !actorID !Count + deriving stock (Eq, Show, Ord, Functor, Foldable, Traversable, Generic) + +-- | Dot is a pair of an actor (identifier) and a logical counter, +-- but we hash using the actor value only. +instance (Hashable actorID) => Hashable (Dot actorID) where + hashWithSalt salt (Dot actorID _) = hashWithSalt salt actorID + +-- | A Version Vector is a mapping from actor IDs to their latest known counter. +-- Requires keys to be Hashable. +type VersionVector actorID = HashMap actorID Count + +-- | A Dotted Version Vector (DVV) consisting of a Causal History (Version Vector) +-- and a set of concurrent values associated with Dots. +-- +-- Note: A Singleton has no causal history, its counter is implicitly 1. +-- +-- @actorID@ is the type of actor IDs. Must be Hashable. +-- @value@ is the type of the value stored. +data DVV actorID value + = EmptyDVV + | SingletonDVV !actorID !value + | DVV !(VersionVector actorID) !(HashMap (Dot actorID) value) + deriving stock (Eq, Show, Ord, Functor, Foldable, Traversable, Generic) + +-- | Extract all values currently in the DVV. +values :: DVV actorID value -> [value] +values EmptyDVV = [] +values (SingletonDVV _ v) = [v] +values (DVV _ vals) = Map.elems vals + +-- | Returns the causal context (Version Vector) of the DVV. +context :: + (Hashable actorID) => + DVV actorID value -> + VersionVector actorID +context EmptyDVV = Map.empty +context (SingletonDVV actor _) = Map.singleton actor 1 +context (DVV causalHistory vals) = + foldl' updateVec causalHistory (Map.keys vals) + where + updateVec m (Dot actor counter) = Map.insertWith max actor counter m + +-- | Safely extracts the components of any DVV state into a standard history map and values map. +extractComponents :: + (Hashable actorID) => + DVV actorID value -> + (VersionVector actorID, HashMap (Dot actorID) value) +extractComponents EmptyDVV = (Map.empty, Map.empty) +extractComponents (SingletonDVV actor val) = (Map.empty, Map.singleton (Dot actor 1) val) +extractComponents (DVV vec vals) = (vec, vals) + +-- | Synchronize (merge) two DVVs. +sync :: + (Hashable actorID, Ord value) => + DVV actorID value -> + DVV actorID value -> + DVV actorID value +sync EmptyDVV d = d +sync d EmptyDVV = d +sync d1 d2 = + let (vL, valsL) = extractComponents d1 + (vR, valsR) = extractComponents d2 + in merge vL valsL vR valsR + +-- | Internal merge logic for general DVV components. +merge :: + (Hashable actorID, Ord value) => + VersionVector actorID -> + HashMap (Dot actorID) value -> + VersionVector actorID -> + HashMap (Dot actorID) value -> + DVV actorID value +merge vL valsL vR valsR = + let newVec = Map.unionWith max vL vR + -- Use unionWith to handle duplicate dots consistently (pick min for determinism) + candidates = Map.unionWith min valsL valsR + isActive (Dot actor counter) _ = + case Map.lookup actor newVec of + Nothing -> True + Just maxC -> counter > maxC + newVals = Map.filterWithKey isActive candidates + in case Map.toList newVals of + [] -> EmptyDVV + [(Dot actor 1, val)] | Map.null newVec -> SingletonDVV actor val + _ -> DVV newVec newVals + +-- | Record a new event (update). +event :: + (Hashable actorID) => + -- | The current local DVV state + DVV actorID value -> + -- | The Context provided by the client (optional) + Maybe (VersionVector actorID) -> + -- | The Actor generating this event + actorID -> + -- | The new value + value -> + DVV actorID value +event currentState maybeContext actorID newValue = + let ctx = fromMaybe Map.empty maybeContext + (causalHistory, vals) = extractComponents currentState + currentMax = Map.lookup actorID (context currentState) + nextCount = maybe 1 (+ 1) currentMax + newDot = Dot actorID nextCount + + filterOld (Dot i c) _ = + case Map.lookup i ctx of + Nothing -> True + Just cnt -> c > cnt + + filteredVals = Map.filterWithKey filterOld vals + newVec = Map.unionWith max causalHistory ctx + finalVals = Map.insert newDot newValue filteredVals + in DVV newVec finalVals + +-- | Prune the causal history (Version Vector). +prune :: + -- | Threshold count for pruning + Count -> + -- | DVV to prune + DVV actorID value -> + DVV actorID value +prune _ EmptyDVV = EmptyDVV +prune _ s@(SingletonDVV _ _) = s +prune threshold (DVV causalHistory vals) = + let newVec = Map.filter (>= threshold) causalHistory + in DVV newVec vals + +-- | Reconcile multiple siblings into a single value using a merge strategy. +reconcile :: + (Hashable actorID) => + -- | Merge function, take two values and deduce a new value (n.b. it's fine to just pick one of the inputs) + (value -> value -> value) -> + -- | The actor ID that will "own" the new reconciled event. + actorID -> + -- | The DVV to reconcile. + DVV actorID value -> + DVV actorID value +reconcile _ _ EmptyDVV = EmptyDVV +reconcile _ _ s@(SingletonDVV _ _) = s +reconcile mergeFn actorID dvv + | size dvv <= 1 = dvv + | otherwise = + let allVals = values dvv + mergedVal = foldl1' mergeFn allVals + ctx = context dvv + in event dvv (Just ctx) actorID mergedVal + +-- | Last-Write-Wins (LWW) reconciliation. +-- +-- Reduces multiple concurrent values (siblings) into a single "winning" value based on the provided +-- comparison function. This operation creates a new event (dot) for the winning value that +-- supersedes all current values in the DVV. +-- +-- If there are zero or one values, the DVV is returned unchanged. +lww :: + (Hashable actorID) => + -- | A function to compare two values. 'GT' indicates the first value wins. + (value -> value -> Ordering) -> + -- | The actor ID that will "own" the new reconciled event. + actorID -> + -- | The DVV to reconcile. + DVV actorID value -> + DVV actorID value +lww compareFn = reconcile pickBest + where + pickBest v1 v2 = case compareFn v1 v2 of + GT -> v1 + _ -> v2 + +-- | Return the number of elements (siblings) in the DVV. +size :: DVV actorID value -> Int +size EmptyDVV = 0 +size (SingletonDVV _ _) = 1 +size (DVV _ vals) = Map.size vals diff --git a/test/Spec.hs b/test/Spec.hs new file mode 100644 --- /dev/null +++ b/test/Spec.hs @@ -0,0 +1,273 @@ +{-# LANGUAGE FlexibleInstances #-} +{-# LANGUAGE OverloadedStrings #-} +{-# LANGUAGE ScopedTypeVariables #-} +{-# LANGUAGE TypeApplications #-} +{-# LANGUAGE TypeSynonymInstances #-} + +import Control.Monad (foldM) +import Data.DVV +import qualified Data.HashMap.Strict as Map +import Data.Hashable (Hashable) +import Test.Hspec hiding (context) +import Test.QuickCheck + +-- Helper to make tests more readable +type ID = String + +type Value = String + +main :: IO () +main = hspec $ do + describe "DVV Operations" $ do + it "should yield the correct size, values, and context for an empty DVV" $ do + let d = EmptyDVV :: DVV ID Value + size d `shouldBe` 0 + values d `shouldBe` [] + context d `shouldBe` Map.empty + + it "should yield the correct size, values, and context for a singleton DVV" $ do + let d = SingletonDVV "A" "v1" :: DVV ID Value + size d `shouldBe` 1 + values d `shouldBe` ["v1"] + context d `shouldBe` Map.fromList [("A", 1)] + + it "should handle events correctly (update)" $ do + -- A starts with v1 + let d0 = SingletonDVV "A" "v1" :: DVV ID Value + + -- A updates with v2, knowing about d0 + let ctx0 = context d0 + d1 = event d0 (Just ctx0) "A" "v2" + + size d1 `shouldBe` 1 + values d1 `shouldBe` ["v2"] + context d1 `shouldBe` Map.fromList [("A", 2)] + + -- A updates again with v3 + let ctx1 = context d1 + d2 = event d1 (Just ctx1) "A" "v3" + + size d2 `shouldBe` 1 + values d2 `shouldBe` ["v3"] + context d2 `shouldBe` Map.fromList [("A", 3)] + + it "should handle concurrent updates (siblings)" $ do + -- A starts with v1 + let d0 = SingletonDVV "A" "v1" :: DVV ID Value + + -- B also starts with v2 (concurrent to A:v1) + let dOther = SingletonDVV "B" "v2" :: DVV ID Value + + -- Sync them + let dSync = sync d0 dOther + size dSync `shouldBe` 2 + values dSync `shouldContain` ["v1"] + values dSync `shouldContain` ["v2"] + context dSync `shouldBe` Map.fromList [("A", 1), ("B", 1)] + + it "should resolve siblings with event superseding" $ do + -- Start with synced state having {A:1, v1} and {B:1, v2} + let d0 = SingletonDVV "A" "v1" :: DVV ID Value + dOther = SingletonDVV "B" "v2" + dSync = sync d0 dOther + + -- A updates. A knows about the whole context of dSync. + let ctx = context dSync + dFinal = event dSync (Just ctx) "A" "v3" + + size dFinal `shouldBe` 1 + values dFinal `shouldBe` ["v3"] + -- Dot should be A:2. Context should be {A: 2, B: 1} + context dFinal `shouldBe` Map.fromList [("A", 2), ("B", 1)] + + it "should keep concurrent updates if context is missing information" $ do + -- B makes an update v1 + let dB = SingletonDVV "B" "v1" :: DVV ID Value + + -- A makes an update v2, but A DOES NOT KNOW about B. + let dA = SingletonDVV "A" "v2" + + -- Sync them. Should have both. + let dSync = sync dA dB + + -- A updates again, using only A's context. + let ctxA = context dA + dFinal = event dSync (Just ctxA) "A" "v3" + + -- v2 (A:1) is superseded. v1 (B:1) is NOT. + size dFinal `shouldBe` 2 + values dFinal `shouldContain` ["v1"] + values dFinal `shouldContain` ["v3"] + context dFinal `shouldBe` Map.fromList [("A", 2), ("B", 1)] + + it "should handle multiple siblings from different actors" $ do + let dA = SingletonDVV "A" "v1" :: DVV ID Value + dB = SingletonDVV "B" "v2" + dC = SingletonDVV "C" "v3" + + dAB = sync dA dB + dABC = sync dAB dC + + size dABC `shouldBe` 3 + context dABC `shouldBe` Map.fromList [("A", 1), ("B", 1), ("C", 1)] + + it "should prune old history" $ do + -- Create a DVV with history {A: 10, B: 5} + let d0 = SingletonDVV "A" "v1" :: DVV ID Value + d10 = foldl (\d i -> event d (Just $ context d) "A" (show @Int i)) d0 [2 .. 10] + dB = SingletonDVV "B" "vB" + dB5 = foldl (\d i -> event d (Just $ context d) "B" (show @Int i)) dB [2 .. 5] + + dSync = sync d10 dB5 + + context dSync `shouldBe` Map.fromList [("A", 10), ("B", 5)] + + -- To test prune properly, we need history that IS NOT supported by a value. + -- Make A supersede B:5 first (so B:5 is removed from values), but B:5 remains in history. + let dVoidB = event dSync (Just $ context dSync) "A" "superseding-everything" + + -- Now A:11. B:5 is superseded (removed from values). + -- Values: {A:11}. Vector: {A:11, B:5} (merged context). + context dVoidB `shouldBe` Map.fromList [("A", 11), ("B", 5)] + + let dPruned = prune 8 dVoidB + -- Now B:5 < 8, so it should be removed from vector. + -- A:11 >= 8, keeps A:11. + context dPruned `shouldBe` Map.fromList [("A", 11)] + + it "should reconcile siblings into a single value with new dot" $ do + let dA = SingletonDVV "A" "v1" :: DVV ID Value + dB = SingletonDVV "B" "v2" + dSync = sync dA dB + + size dSync `shouldBe` 2 + + -- Reconcile with "concatenation" + let dReconciled = reconcile (\a b -> a ++ b) "C" dSync + + size dReconciled `shouldBe` 1 + let val = head (values dReconciled) + val `shouldSatisfy` (\v -> v == "v1v2" || v == "v2v1") + + -- Context should now include C:1 + context dReconciled `shouldBe` Map.fromList [("A", 1), ("B", 1), ("C", 1)] + + it "should use Last-Write-Wins (lww) to pick a winner" $ do + let dA = SingletonDVV "A" "apple" :: DVV ID Value + dB = SingletonDVV "B" "banana" + dSync = sync dA dB + + -- lww with string comparison (lexicographical) + let dLWW = lww compare "A" dSync + + size dLWW `shouldBe` 1 + values dLWW `shouldBe` ["banana"] -- banana > apple + + -- Reconcile advances the dot for the actor performing the reconcile (A). + -- Previous A was 1. New dot is A:2. + -- B remains at 1 (as history). + context dLWW `shouldBe` Map.fromList [("A", 2), ("B", 1)] + + describe "DVV QuickCheck Properties" $ do + it "sync is idempotent: sync d d == d (semantically)" $ + property $ \(d :: DVV ID Value) -> + let synced = sync d d + in (values synced, context synced) `shouldBe` (values d, context d) + + it "sync is commutative: sync d1 d2 == sync d2 d1" $ + property $ \(d1 :: DVV ID Value) (d2 :: DVV ID Value) -> + sync d1 d2 `shouldBe` sync d2 d1 + + it "sync is associative: sync (sync d1 d2) d3 == sync d1 (sync d2 d3)" $ + property $ \(d1 :: DVV ID Value) (d2 :: DVV ID Value) (d3 :: DVV ID Value) -> + sync (sync d1 d2) d3 `shouldBe` sync d1 (sync d2 d3) + + it "sync with EmptyDVV is identity: sync EmptyDVV d == d" $ + property $ \(d :: DVV ID Value) -> + sync EmptyDVV d `shouldBe` d + + it "context is monotonic after sync: context d1 <= context (sync d1 d2)" $ + property $ \(d1 :: DVV ID Value) (d2 :: DVV ID Value) -> + let ctx1 = context d1 + ctxSync = context (sync d1 d2) + in all (\(k, v) -> Map.lookup k ctxSync >= Just v) (Map.toList ctx1) + + it "event increases context counter for the actor" $ + property $ \(d :: DVV ID Value) (actor :: ID) (val :: Value) -> + let ctx = context d + d' = event d (Just ctx) actor val + ctx' = context d' + oldCount = Map.findWithDefault 0 actor ctx + newCount = Map.findWithDefault 0 actor ctx' + in newCount `shouldBe` (oldCount + 1) + + it "event with full context produces exactly one value" $ + property $ \(d :: DVV ID Value) (actor :: ID) (val :: Value) -> + let ctx = context d + d' = event d (Just ctx) actor val + in size d' `shouldBe` 1 + + it "values are preserved or superseded after sync" $ + property $ \(d1 :: DVV ID Value) (d2 :: DVV ID Value) -> + let synced = sync d1 d2 + in size synced <= size d1 + size d2 + + it "prune removes only old history, not active values" $ + property $ \(d :: DVV ID Value) (threshold :: Count) -> + let pruned = prune threshold d + in values pruned `shouldBe` values d + + it "reconcile reduces siblings to one value" $ + property $ \(d :: DVV ID Value) (actor :: ID) -> + let reconciled = reconcile (++) actor d + in size reconciled <= 1 + + it "lww reduces siblings to one value" $ + property $ \(d :: DVV ID Value) (actor :: ID) -> + let resolved = lww compare actor d + in size resolved <= 1 + + it "context contains all actor IDs from values" $ + property $ \(d :: DVV ID Value) -> + case d of + EmptyDVV -> True + SingletonDVV actor _ -> Map.member actor (context d) + DVV _ vals -> + let ctx = context d + actors = [actor | Dot actor _ <- Map.keys vals] + in all (`Map.member` ctx) actors + +-- QuickCheck Arbitrary instances + +instance + (Arbitrary actorID, Hashable actorID, Arbitrary value) => + Arbitrary (DVV actorID value) + where + arbitrary = sized $ \n -> do + if n <= 0 + then pure EmptyDVV + else + frequency + [ (1, pure EmptyDVV) + , (3, SingletonDVV <$> arbitrary <*> arbitrary) + , (2, arbitraryDVV) + ] + where + arbitraryDVV = do + numActors <- chooseInt (1, 5) + actors <- vectorOf numActors arbitrary + -- Build up a DVV through events + let base = EmptyDVV + foldM addEvent base actors + + addEvent d actor = do + val <- arbitrary + let ctx = context d + pure $ event d (Just ctx) actor val + + shrink EmptyDVV = [] + shrink (SingletonDVV _ _) = [EmptyDVV] + shrink (DVV _ vals) + | Map.null vals = [EmptyDVV] + | otherwise = + EmptyDVV : [SingletonDVV actor val | (Dot actor _, val) <- Map.toList vals]