sdzx-1 / fused-effects-gossip

fused-effect-Gossip

Gossip

resources

1. https://www.cnblogs.com/duanxz/p/3768351.html
2. https://zhuanlan.zhihu.com/p/41228196
3. https://juejin.cn/post/6930774718114955278
4. https://flopezluis.github.io/gossip-simulator/
5. https://managementfromscratch.wordpress.com/2016/04/01/introduction-to-gossip/
6. https://www.serf.io/docs/internals/simulator.html

计划

1. 用fused-effects，和io-classes这两个库实现Gossip协议
2. 用多线程模拟多个node执行协议
3. 在IOSim s中验证代码
4. 同时在IO 和 IOSim s这两种环境种执行代码，比较结果
5. 加入网络层，并进行测试

Anti-entropy

Push version

data Push = Push deriving (Show)
data Value
  = Value
  { _value :: String
  , _time  :: Int
  } deriving (Show, Eq, Ord)

makeLenses ''Value

loop :: (HasLabelled NodeAction (NodeAction Value (Push, Value)) sig m,
            Has Random sig m)
     => m ()
loop = do
  peers <- getPeers
  q <- (`Set.elemAt` peers) <$> uniformR (0, Set.size peers - 1)
  value <- readStore
  sendMessage q (Push, value)
  wait 1
  loop

receive :: (HasLabelled NodeAction (NodeAction Value (Push, Value)) sig m)
        => m ()
receive = do
  (sid, (Push, v)) <- readMessage
  value <- readStore
  when (value ^. time < v ^. time) $ updateStore v
  receive

-- 快速模拟收敛结果
runSim = do
  total <- getLine
  i <- randomIO
  case traceResult False $ runST $ runS (read total) 30 (mkStdGen i) of
    Left e -> print e
    Right l -> do
      let dis = foldl (\ m (k,v) -> Map.insertWith (+) v 1 m) Map.empty l
      print dis
  runSim


runS :: forall s. Int -> DiffTime -> StdGen -> ST s (SimTrace [(NodeId, Value)])
runS total time gen = runSimTraceST $ do
  let list = [0 .. total -1]
  ls <- forM list $ \i -> do
    tq <- newTQueueIO
    sirS <- newTVarIO S
    ss <- newTVarIO (Value (show i) i)
    return ((NodeId i, tq), (sirS, ss))

  forM_  list $ \i -> do
    let ((a,b),(c,d)) = ls !! i
        otherTQ = Map.fromList $ map (fst . (ls !!)) (L.delete i list)
        ns = NodeState a b otherTQ c d
    forkIO $ void $
      runNodeAction @(IOSim s) @Value @(Push, Value) ns
         $ runRandom gen loop
    forkIO $ void $
      runNodeAction @(IOSim s) @Value @(Push, Value) ns receive
  threadDelay time
  forM ls $ \((nid, _),(_, tv)) -> (nid,) <$> readTVarIO tv

Pull version

data Pull = Pull
          | Reply
          deriving (Show)

data ValueOrTime = T Int  | V Value deriving (Show)

data Value
  = Value
  { _value :: String
  , _time  :: Int
  } deriving (Show, Eq, Ord)

makeLenses ''Value

loop :: (HasLabelled NodeAction (NodeAction Value (Pull, ValueOrTime)) sig m,
            Has Random sig m)
     => m ()
loop = do
  peers <- getPeers
  q <- (`Set.elemAt` peers) <$> uniformR (0, Set.size peers - 1)
  value <- readStore
  sendMessage q (Pull, T (value ^. time))
  wait 1
  loop

receive :: (HasLabelled NodeAction (NodeAction Value (Pull, ValueOrTime)) sig m)
        => m ()
receive = do
  (sid, (method, v)) <- readMessage
  value <- readStore
  case (method, v) of
    (Pull, T t) -> when (value ^. time > t) $ sendMessage sid (Reply, V value)
    (Reply,V v) -> when (value ^. time < v ^. time) $ updateStore v
    _           -> error "never happened"
  receive

PushPull version

data PushPull
  = PushPull
  | Reply
  deriving (Show)

data ValueOrTime = T Int  | V Value deriving (Show)

data Value
  = Value
  { _value :: String
  , _time  :: Int
  } deriving (Show, Eq, Ord)

makeLenses ''Value


loop :: (HasLabelled NodeAction (NodeAction Value (PushPull, ValueOrTime)) sig m,
            Has Random sig m)
     => m ()
loop = do
  peers <- getPeers
  q <- (`Set.elemAt` peers) <$> uniformR (0, Set.size peers - 1)
  value <- readStore
  sendMessage q (PushPull, V value)
  wait 1
  loop


receive :: (HasLabelled NodeAction (NodeAction Value (PushPull, ValueOrTime)) sig m)
        => m ()
receive = do
  (sid, (method, v)) <- readMessage
  value <- readStore
  case (method, v) of
    (PushPull, V v) -> do
      if value ^. time < v ^. time
        then updateStore v
        else when (value ^. time > v ^. time) $ sendMessage sid (Reply, V value)
    (Reply,V v)     -> when (value ^. time < v ^. time) $ updateStore v
    _               -> error "never happened"
  receive

CRDT

resources

1. https://lars.hupel.info/topics/crdt/01-intro/
2. https://bartoszsypytkowski.com/the-state-of-a-state-based-crdts/
3. https://crdt.tech/resources

crdt demo