crdt-event-fold 1.4.0.0 → 1.5.1.1

raw patch · 4 files changed

+104/−47 lines, 4 filesdep +exceptionsdep ~aesondep ~basedep ~binaryPVP ok

version bump matches the API change (PVP)

Dependencies added: exceptions

Dependency ranges changed: aeson, base, binary, containers, data-dword, hspec, monad-logger

API changes (from Hackage documentation)

Files

• crdt-event-fold.cabal +26/−25
• src/Data/CRDT/EventFold.hs +45/−13
• src/Data/CRDT/EventFold/Monad.hs +4/−6
• test/test.hs +29/−3

@@ -1,8 +1,6 @@--- Initial crdt-event-fold.cabal generated by cabal init.  For further --- documentation, see http://haskell.org/cabal/users-guide/-+cabal-version:       3.0 name:                crdt-event-fold-version:             1.4.0.0+version:             1.5.1.1 synopsis:            Garbage collected event folding CRDT. description:         Garbage collected event folding CRDT. Consistently                      apply arbitrary operations to replicated data.@@ -11,39 +9,42 @@ license-file:        LICENSE author:              Rick Owens maintainer:          rick@owensmurray.com-copyright:           2020 Owens Murray, LLC.+copyright:           2022 Owens Murray, LLC. category:            CRDT build-type:          Simple extra-source-files:  README.md-cabal-version:       >=1.10 +common dependencies+  build-depends:+    , aeson              >= 1.5.6.0 && < 1.6+    , base               >= 4.14    && < 4.15+    , binary             >= 0.8.8.0 && < 0.9+    , containers         >= 0.6.5.1 && < 0.7+    , data-default-class >= 0.1.2.0 && < 0.2+    , data-dword         >= 0.3.2.1 && < 0.4+    , exceptions         >= 0.10.4  && < 0.11+    , monad-logger       >= 0.3.36  && < 0.4+    , mtl                >= 2.2.2   && < 2.3+    , transformers       >= 0.5.6.2 && < 0.6+ library+  import: dependencies   exposed-modules:          Data.CRDT.EventFold     Data.CRDT.EventFold.Monad   -- other-modules:          -- other-extensions:    -  build-depends:-    aeson              >= 1.4.7.1 && < 1.5,-    base               >= 4.13    && < 4.14,-    binary             >= 0.8.7.0 && < 0.9,-    containers         >= 0.6.2.1 && < 0.7,-    data-default-class >= 0.1.2.0 && < 0.2,-    data-dword         >= 0.3.2   && < 0.4,-    monad-logger       >= 0.3.35  && < 0.4,-    mtl                >= 2.2.2   && < 2.3,-    transformers       >= 0.5.6.2 && < 0.6-  hs-source-dirs:      src-  default-language:    Haskell2010+  hs-source-dirs: src+  default-language: Haskell2010  test-suite tests-  main-is:        test.hs-  type:           exitcode-stdio-1.0+  import: dependencies+  main-is: test.hs+  type: exitcode-stdio-1.0   hs-source-dirs: test-  default-language:    Haskell2010+  default-language: Haskell2010   build-depends:-    base,-    crdt-event-fold,--    hspec+    , crdt-event-fold+    , containers >= 0.6.5.1 && < 0.7+    , hspec      >= 2.7.10 && < 2.8 

@@ -138,6 +138,7 @@   events,   diffMerge,   MergeError(..),+  acknowledge,    -- ** Participation   participate,@@ -161,11 +162,13 @@   -- * Underlying Types   EventFold,   EventId,+  bottomEid,   Diff,  ) where  +import Control.Exception (Exception) import Data.Aeson (FromJSON(parseJSON), ToJSON(toEncoding, toJSON),   FromJSONKey, ToJSONKey) import Data.Bifunctor (first)@@ -176,6 +179,7 @@ import Data.Maybe (catMaybes) import Data.Set ((\\), Set, member, union) import GHC.Generics (Generic)+import Type.Reflection (Typeable) import qualified Data.DoubleWord as DW import qualified Data.Map as Map import qualified Data.Map.Merge.Lazy as Map.Merge@@ -357,6 +361,7 @@     )   =>     Show (MergeError o p e)+instance (Typeable o, Typeable p, Typeable e, Show (Output e), Show o, Show p, Show e, Show (State e)) => Exception (MergeError o p e)   {- | `Delta` is how we represent mutations to the event fold state. -}@@ -584,7 +589,7 @@     of       Nothing -> Left (DiffTooSparse orig ep)       Just (ef1, outputs1) ->-        let (ef2, outputs2) = acknowledge participant ef1+        let (ef2, outputs2) = acknowledge_ participant ef1         in           Right (             UpdateResult@@ -664,7 +669,7 @@   of     Left err -> Left err     Right (UpdateResult ef outputs _prop) ->-      let (ef2, outputs2) = acknowledge participant (unEventFold ef)+      let (ef2, outputs2) = acknowledge_ participant (unEventFold ef)       in         Right (           UpdateResult@@ -709,11 +714,32 @@   Returns the new 'EventFold' value, along with the output for all of   the events that can now be considered "fully consistent". -}-acknowledge :: (Event e, Ord p)+acknowledge+  :: ( Eq (Output e)+     , Eq e+     , Eq o+     , Event e+     , Ord p+     )   => p+  -> EventFold o p e+  -> UpdateResult o p e+acknowledge p (EventFold ef) =+  let (ef2, outputs) = acknowledge_ p ef+  in+    UpdateResult {+      urEventFold = EventFold ef2,+      urOutputs = outputs,+      urNeedsPropagation = ef /= ef2+    }+++{- | Internal version of 'acknowledge'. -}+acknowledge_ :: (Event e, Ord p)+  => p   -> EventFoldF o p e Identity   -> (EventFoldF o p e Identity, Map (EventId p) (Output e))-acknowledge p ef =+acknowledge_ p ef =     {-       First do a normal reduction, then do a special acknowledgement of the       reduction error, if any.@@ -768,8 +794,8 @@     (       eid,       let-        (ef2, outputs1) =-          acknowledge+        (ef2, outputs) =+          acknowledge_             self             ef {               psEvents =@@ -778,11 +804,10 @@                   (Identity (Join peer), mempty)                   (psEvents ef)             }-        (ef3, outputs2) = acknowledge peer ef2       in         UpdateResult {-          urEventFold = EventFold ef3,-          urOutputs = Map.union outputs1 outputs2,+          urEventFold = EventFold ef2,+          urOutputs = outputs,           {-              By definition, we have added some new information that             needs propagating.@@ -806,7 +831,7 @@ disassociate peer (EventFold ef) =     let       (ef2, outputs) =-        acknowledge+        acknowledge_           peer           ef {             psEvents =@@ -855,7 +880,7 @@       eid,       let         (ef2, outputs) =-          acknowledge+          acknowledge_             p             (               (unEventFold ef) {@@ -987,7 +1012,9 @@   this context, a participant is "diverging" if there is an event   that the participant has not acknowledged but we are expecting it   to acknowledge. Along with the participant, return the last known-  `EventId` which that participant has acknowledged.+  `EventId` which that participant has acknowledged, or 'BottomEid'+  if the participant has a acknowledged no events, as may be the case+  immediately after the participant joined replication. -} divergent :: forall o p e. (Ord p) => EventFold o p e -> Map p (EventId p) divergent@@ -1022,7 +1049,7 @@       (         unionWith           max-          (Map.insert p eid acc)+          (Map.insert p BottomEid acc)           (Map.fromList [(a, eid) | a <- Set.toList acks]),         max maxEid eid       )@@ -1259,5 +1286,10 @@   case Map.minView (psEvents ef) of     Just ((Identity (Error _ _), _), _) -> True     _ -> False+++{- | The bottom 'EventId', possibly useful for comparison in tests. -}+bottomEid :: EventId p+bottomEid = BottomEid  

@@ -16,6 +16,7 @@ ) where  +import Control.Monad.Catch (MonadThrow) import Control.Monad.IO.Class (MonadIO) import Control.Monad.Logger (MonadLogger, MonadLoggerIO) import Control.Monad.Reader (MonadReader(ask), ReaderT(runReaderT))@@ -42,14 +43,10 @@   event :: e -> m (Output e, EventId p)    {- | Perform a full merge. See 'EF.fullMerge'. -}-  fullMerge-    :: EventFold o p e-    -> m (Either (MergeError o p e) ())+  fullMerge :: EventFold o p e -> m (Either (MergeError o p e) ())    {- | Perform a diff merge. See 'EF.diffMerge'. -}-  diffMerge-    :: Diff o p e-    -> m (Either (MergeError o p e) ())+  diffMerge :: Diff o p e -> m (Either (MergeError o p e) ())    {- | Allow a new participant to join in the cluster. See 'EF.participate'. -}   participate :: p -> m (EventId p)@@ -87,6 +84,7 @@     , MonadIO     , MonadLogger     , MonadLoggerIO+    , MonadThrow     ) instance MonadTrans (EventFoldT o p e) where   lift = EventFoldT . lift . lift

@@ -11,9 +11,10 @@  import Data.CRDT.EventFold (Event(Output, State, apply),   EventResult(Pure), UpdateResult(urEventFold, urNeedsPropagation,-  urOutputs), EventFold, diffMerge, disassociate, divergent, event,-  events, fullMerge, infimumValue, new, participate)+  urOutputs), EventFold, acknowledge, bottomEid, diffMerge, disassociate,+  divergent, event, events, fullMerge, infimumValue, new, participate) import Test.Hspec (describe, hspec, it, shouldBe, shouldNotBe)+import qualified Data.Map as Map   data Ops@@ -29,7 +30,7 @@   main :: IO ()-main = hspec $+main = hspec $ do   describe "EventFold" $     it "works in a specific contrived scenario" $ do       {- New crdt with the participant 'a'.  -}@@ -41,8 +42,16 @@       let (_eid, r) = participate 'a' 'b' a       let a = urEventFold r       let b = urEventFold r+      show a `shouldBe` "EventFold {unEventFold = EventFoldF {psOrigin = 0, psInfimum = Infimum {eventId = BottomEid, participants = fromList \"a\", stateValue = 0}, psEvents = fromList [(Eid 0 'a',(Identity (Join 'b'),fromList \"a\"))]}}"+      show b `shouldBe` "EventFold {unEventFold = EventFoldF {psOrigin = 0, psInfimum = Infimum {eventId = BottomEid, participants = fromList \"a\", stateValue = 0}, psEvents = fromList [(Eid 0 'a',(Identity (Join 'b'),fromList \"a\"))]}}"++      let r = acknowledge 'b' b+      let b = urEventFold r+      let Right r = diffMerge 'a' a (events 'a' b)+      let a = urEventFold r       show a `shouldBe` "EventFold {unEventFold = EventFoldF {psOrigin = 0, psInfimum = Infimum {eventId = Eid 0 'a', participants = fromList \"ab\", stateValue = 0}, psEvents = fromList []}}"       show b `shouldBe` "EventFold {unEventFold = EventFoldF {psOrigin = 0, psInfimum = Infimum {eventId = Eid 0 'a', participants = fromList \"ab\", stateValue = 0}, psEvents = fromList []}}"+       urOutputs r `shouldBe` mempty       urNeedsPropagation r `shouldBe` True       show (divergent a) `shouldBe` "fromList []"@@ -148,6 +157,8 @@       {- 'c' joins on 'a' -}       let (_eid, r) = participate 'a' 'c' a       let a = urEventFold r+      let r = acknowledge 'c' a+      let a = urEventFold r       let c = urEventFold r       show a `shouldBe` "EventFold {unEventFold = EventFoldF {psOrigin = 0, psInfimum = Infimum {eventId = Eid 2 'a', participants = fromList \"ab\", stateValue = -3}, psEvents = fromList [(Eid 3 'a',(Identity (Event Inc),fromList \"ac\")),(Eid 4 'a',(Identity (Join 'c'),fromList \"ac\"))]}}"       show b `shouldBe` "EventFold {unEventFold = EventFoldF {psOrigin = 0, psInfimum = Infimum {eventId = Eid 2 'a', participants = fromList \"ab\", stateValue = -3}, psEvents = fromList [(Eid 3 'b',(Identity (Event Inc),fromList \"b\"))]}}"@@ -311,4 +322,19 @@         show (divergent c) `shouldBe` "fromList []"         show a `shouldBe` show b         show a `shouldBe` show c++  describe "divergent" $ do+    it "marks an unacked join as divergent" $ do+      let+        a = new 0 'a' :: EventFold Int Char Ops+        b = urEventFold . snd . participate 'a' 'b' $ a+      divergent b `shouldBe` Map.fromList [('b', bottomEid)]+    it "does not mark an acked join as divergent" $ do+      let+        a = new 0 'a' :: EventFold Int Char Ops+        b = urEventFold . snd . participate 'a' 'b' $ a+        c = urEventFold . snd . participate 'a' 'c' $ b+        d = urEventFold . acknowledge 'c' $ c+      divergent d `shouldBe` Map.fromList [('b', bottomEid)]+