crdt (empty) → 0.1

raw patch · 15 files changed

+453/−0 lines, 15 filesdep +QuickCheckdep +basedep +crdt

Dependencies added: QuickCheck, base, crdt, derive, tasty, tasty-quickcheck, vector

Files

• LICENSE +26/−0
• crdt.cabal +57/−0
• lib/CRDT/Cm.hs +27/−0
• lib/CRDT/Cv.hs +25/−0
• lib/CRDT/GCounter/Cm.hs +21/−0
• lib/CRDT/GCounter/Cv.hs +37/−0
• lib/CRDT/GCounter/Cv/Internal.hs +16/−0
• lib/CRDT/LWW.hs +31/−0
• lib/CRDT/PNCounter/Cm.hs +22/−0
• lib/CRDT/PNCounter/Cv.hs +40/−0
• lib/CRDT/PNCounter/Cv/Internal.hs +22/−0
• test/Instances.hs +4/−0
• test/Instances/Cm.hs +19/−0
• test/Instances/Cv.hs +25/−0
• test/Main.hs +81/−0

@@ -0,0 +1,26 @@+Copyright 2017 Yuriy Syrovetskiy++Redistribution and use in source and binary forms, with or without modification,+are permitted provided that the following conditions are met:++1. Redistributions of source code must retain the above copyright notice,+   this list of conditions and the following disclaimer.++2. Redistributions in binary form must reproduce the above copyright notice,+   this list of conditions and the following disclaimer in the documentation+   and/or other materials provided with the distribution.++3. Neither the name of the copyright holder nor the names of its contributors+   may be used to endorse or promote products derived from this software without+   specific prior written permission.++THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS" AND+ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED+WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE+DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT HOLDER OR CONTRIBUTORS BE LIABLE FOR+ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES+(INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES;+LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON+ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT+(INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS+SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.

@@ -0,0 +1,57 @@+-- This file has been generated from package.yaml by hpack version 0.17.0.+--+-- see: https://github.com/sol/hpack++name:           crdt+version:        0.1+synopsis:       Conflict-free replicated data types+description:    Definitions of CmRDT and CvRDT. Implementations for some classic CRDTs.+category:       Distributed Systems+homepage:       https://github.com/cblp/crdt#readme+bug-reports:    https://github.com/cblp/crdt/issues+maintainer:     Yuriy Syrovetskiy <cblp@cblp.su>+license:        BSD3+license-file:   LICENSE+build-type:     Simple+cabal-version:  >= 1.10++source-repository head+  type: git+  location: https://github.com/cblp/crdt++library+  hs-source-dirs:+      lib+  build-depends:+      base >= 4.9 && < 4.10+    , vector+  exposed-modules:+      CRDT.Cm+      CRDT.Cv+      CRDT.GCounter.Cm+      CRDT.GCounter.Cv+      CRDT.GCounter.Cv.Internal+      CRDT.LWW+      CRDT.PNCounter.Cm+      CRDT.PNCounter.Cv+      CRDT.PNCounter.Cv.Internal+  default-language: Haskell2010++test-suite test+  type: exitcode-stdio-1.0+  main-is: Main.hs+  hs-source-dirs:+      test+  build-depends:+      base >= 4.9 && < 4.10+    , vector+    , derive+    , QuickCheck+    , tasty+    , tasty-quickcheck+    , crdt+  other-modules:+      Instances+      Instances.Cm+      Instances.Cv+  default-language: Haskell2010

@@ -0,0 +1,27 @@+{-# LANGUAGE TypeFamilies #-}++module CRDT.Cm+    ( CmRDT (..)+    , query+    ) where++import Data.Kind (Type)++{- |+Operation-based, or commutative (Cm) replicated data type.++[Commutativity law]++    @'update' op1 . 'update' op2 == 'update' op2 . 'update' op1@+-}+class CmRDT op where++    -- | The type of the target value+    type State op :: Type++    -- | Apply operation to a value+    update :: op -> State op -> State op++-- | Build state from a series of operations.+query :: (Foldable f, CmRDT op) => f op -> State op -> State op+query ops initial = foldr update initial ops

@@ -0,0 +1,25 @@+module CRDT.Cv+    ( CvRDT+    ) where++import Data.Semigroup (Semigroup (..))++{- |+State-based, or convergent (Cv) replicated data type.++Update is any function modifying @state@.++Query function is not needed. State itself is exposed.+In other words, @query = 'id'@.++Laws:++[commutativity]++    @x '<>' y == y '<>' x@++[idempotency]++    @x '<>' x == x@+-}+class Semigroup state => CvRDT state

@@ -0,0 +1,21 @@+{-# LANGUAGE TypeFamilies #-}++module CRDT.GCounter.Cm+    ( GCounter (..)+    , initial+    ) where++import CRDT.Cm (CmRDT, State, update)++-- | Grow-only counter.+--+-- Commutativity: 'Increment' obviously commutes with itself.+data GCounter a = Increment++instance Num a => CmRDT (GCounter a) where+    type State (GCounter a) = a+    update _ = (+1)++-- | Initial state+initial :: Num a => a+initial = 0

@@ -0,0 +1,37 @@+module CRDT.GCounter.Cv+    ( GCounter+    , increment+    , initial+    , query+    ) where++import           Data.Monoid         ((<>))+import qualified Data.Vector         as Vector+import qualified Data.Vector.Mutable as VectorM++import CRDT.GCounter.Cv.Internal++-- | Increment counter+increment+    :: Num a+    => Word -- ^ replica id+    -> GCounter a+    -> GCounter a+increment replicaId (GCounter vec) = let+    i = fromIntegral replicaId+    vecResized =+        if i + 1 > length vec then+            vec <> Vector.replicate (i + 1 - length vec) 0+        else+            vec+    vecUpdated = Vector.modify (\vm -> VectorM.modify vm (+1) i) vecResized+    in+    GCounter vecUpdated++-- | Initial state+initial :: GCounter a+initial = GCounter Vector.empty++-- | Get value from the state+query :: Num a => GCounter a -> a+query (GCounter v) = sum v

@@ -0,0 +1,16 @@+module CRDT.GCounter.Cv.Internal where++import           Data.Semigroup (Semigroup ((<>)))+import           Data.Vector    (Vector)+import qualified Data.Vector    as Vector++import CRDT.Cv (CvRDT)++-- | Grow-only counter.+newtype GCounter a = GCounter (Vector a)+    deriving Eq++instance Ord a => Semigroup (GCounter a) where+    GCounter x <> GCounter y = GCounter $ Vector.zipWith max x y++instance Ord a => CvRDT (GCounter a)

@@ -0,0 +1,31 @@+{-# LANGUAGE TypeFamilies #-}++module CRDT.LWW+    ( LWW (..)+    , Timestamp+    ) where++import Data.Semigroup  (Semigroup (..))+import Numeric.Natural (Natural)++import           CRDT.Cm (CmRDT, State)+import qualified CRDT.Cm as Cm+import           CRDT.Cv (CvRDT)++type Timestamp = Natural++-- | Last write wins. Interesting, this type is both 'CmRDT' and 'CvRDT'.+data LWW a = Write+    { timestamp :: !Timestamp+    , value     :: !a+    }+    deriving (Eq, Ord)++instance Ord a => Semigroup (LWW a) where+    (<>) = max++instance Ord a => CmRDT (LWW a) where+    type State (LWW a) = LWW a+    update = max++instance Ord a => CvRDT (LWW a)

@@ -0,0 +1,22 @@+{-# LANGUAGE LambdaCase #-}+{-# LANGUAGE TypeFamilies #-}++module CRDT.PNCounter.Cm+    ( PNCounter (..)+    , initial+    ) where++import CRDT.Cm (CmRDT, State, update)++-- | Positive-negative counter. Allows incrementing and decrementing.+data PNCounter a = Increment | Decrement++instance Num a => CmRDT (PNCounter a) where+    type State (PNCounter a) = a+    update = \case+        Increment -> (+1)+        Decrement -> subtract 1++-- | Initial state+initial :: Num a => a+initial = 0

@@ -0,0 +1,40 @@+{-# LANGUAGE NamedFieldPuns #-}++module CRDT.PNCounter.Cv+    ( PNCounter+    , decrement+    , increment+    , initial+    , query+    ) where++import qualified CRDT.GCounter.Cv as GCounter++import CRDT.PNCounter.Cv.Internal++-- | Get value from the state+query :: Num a => PNCounter a -> a+query PNCounter{positive, negative} =+    GCounter.query positive - GCounter.query negative++-- | Decrement counter+decrement+    :: Num a+    => Word -- ^ replica id+    -> PNCounter a+    -> PNCounter a+decrement i pnc@PNCounter{negative} =+    pnc{negative = GCounter.increment i negative}++-- | Increment counter+increment+    :: Num a+    => Word -- ^ replica id+    -> PNCounter a+    -> PNCounter a+increment i pnc@PNCounter{positive} =+    pnc{positive = GCounter.increment i positive}++-- | Initial state+initial :: PNCounter a+initial = PNCounter{positive = GCounter.initial, negative = GCounter.initial}

@@ -0,0 +1,22 @@+module CRDT.PNCounter.Cv.Internal where++import Data.Semigroup (Semigroup (..))++import CRDT.Cv          (CvRDT)+import CRDT.GCounter.Cv (GCounter)++{- |+Positive-negative counter. Allows incrementing and decrementing.+Nice example of combining of existing CvRDT ('GCounter' in this case)+to create another CvRDT.+-}+data PNCounter a = PNCounter+    { positive :: !(GCounter a)+    , negative :: !(GCounter a)+    }+    deriving Eq++instance Ord a => Semigroup (PNCounter a) where+    PNCounter p1 n1 <> PNCounter p2 n2 = PNCounter (p1 <> p2) (n1 <> n2)++instance Ord a => CvRDT (PNCounter a)

@@ -0,0 +1,4 @@+module Instances () where++import Instances.Cm ()+import Instances.Cv ()

@@ -0,0 +1,19 @@+{-# OPTIONS_GHC -Wno-orphans #-}++{-# LANGUAGE GeneralizedNewtypeDeriving #-}+{-# LANGUAGE StandaloneDeriving #-}+{-# LANGUAGE TemplateHaskell #-}++module Instances.Cm () where++import Data.DeriveTH   (derives, makeArbitrary)+import Test.QuickCheck (Arbitrary, arbitrary, choose)++import CRDT.LWW          (LWW (..))+import CRDT.PNCounter.Cm (PNCounter (..))++derives [makeArbitrary] [''PNCounter, ''LWW]++deriving instance Show (PNCounter a)++deriving instance Show a => Show (LWW a)

@@ -0,0 +1,25 @@+{-# OPTIONS_GHC -Wno-orphans #-}++{-# LANGUAGE GeneralizedNewtypeDeriving #-}+{-# LANGUAGE StandaloneDeriving #-}++module Instances.Cv () where++import           Data.Vector     (Vector)+import qualified Data.Vector     as Vector+import           Test.QuickCheck (Arbitrary, arbitrary)++import CRDT.GCounter.Cv.Internal  (GCounter (..))+import CRDT.PNCounter.Cv.Internal (PNCounter (..))++instance Arbitrary a => Arbitrary (Vector a) where+    arbitrary = Vector.fromList <$> arbitrary++deriving instance Arbitrary a => Arbitrary (GCounter a)++deriving instance Show a => Show (GCounter a)++instance Arbitrary a => Arbitrary (PNCounter a) where+    arbitrary = PNCounter <$> arbitrary <*> arbitrary++deriving instance Show a => Show (PNCounter a)

@@ -0,0 +1,81 @@+{-# LANGUAGE FlexibleContexts #-}+{-# LANGUAGE ScopedTypeVariables #-}++import Data.Proxy            (Proxy (..))+import Data.Semigroup        ((<>))+import Test.QuickCheck       (Arbitrary, Small (..))+import Test.Tasty            (TestTree, defaultMain, testGroup)+import Test.Tasty.QuickCheck (testProperty)++import           CRDT.Cm           (CmRDT, State)+import qualified CRDT.Cm           as Cm+import           CRDT.Cv           (CvRDT)+import qualified CRDT.GCounter.Cv  as GcCv+import           CRDT.LWW          (LWW)+import qualified CRDT.PNCounter.Cm as PncCm+import qualified CRDT.PNCounter.Cv as PncCv++import Instances ()++main :: IO ()+main = defaultMain $ testGroup "" [gCounter, pnCounter, lww]++gCounter :: TestTree+gCounter = testGroup "GCounter"+    [ testGroup "Cv"+        [ cvrdtLaws (Proxy :: Proxy (GcCv.GCounter Int))+        , testProperty "increment" $+            \(c :: GcCv.GCounter Int) (Small i) ->+                GcCv.query (GcCv.increment i c) == succ (GcCv.query c)+        ]+    ]++pnCounter :: TestTree+pnCounter = testGroup "PNCounter"+    [ testGroup "Cv"+        [ cvrdtLaws (Proxy :: Proxy (PncCv.PNCounter Int))+        , testProperty "increment" $+            \(c :: PncCv.PNCounter Int) (Small i) ->+                PncCv.query (PncCv.increment i c) == succ (PncCv.query c)+        , testProperty "decrement" $+            \(c :: PncCv.PNCounter Int) (Small i) ->+                PncCv.query (PncCv.decrement i c) == pred (PncCv.query c)+        ]+    , testGroup "Cm"+        [ cmrdtCommutativity (Proxy :: Proxy (PncCm.PNCounter Int)) ]+    ]++lww :: TestTree+lww = testGroup "LWW"+    [ testGroup "Cm" [ cmrdtCommutativity (Proxy :: Proxy (LWW Int)) ]+    , testGroup "Cv" [ cvrdtLaws (Proxy :: Proxy (LWW Int)) ]+    ]++cvrdtLaws+    :: forall a . (Arbitrary a, CvRDT a, Eq a, Show a) => Proxy a -> TestTree+cvrdtLaws _ = testGroup "CvRDT laws"+    [ testProperty "associativity" associativity+    , testProperty "commutativity" commutativity+    , testProperty "idempotency"   idempotency+    ]+  where+    associativity :: a -> a -> a -> Bool+    associativity x y z = (x <> y) <> z == x <> (y <> z)++    commutativity :: a -> a -> Bool+    commutativity x y = x <> y == y <> x++    idempotency :: a -> Bool+    idempotency x = x <> x == x++cmrdtCommutativity+    :: forall op+    . ( Arbitrary op, CmRDT op, Show op+      , Arbitrary (State op), Eq (State op), Show (State op)+      )+    => Proxy op -> TestTree+cmrdtCommutativity _ = testProperty "CmRDT law: commutativity" commutativity+  where+    commutativity :: op -> op -> State op -> Bool+    commutativity op1 op2 x =+        (Cm.update op1 . Cm.update op2) x == (Cm.update op2 . Cm.update op1) x