{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE RecordWildCards #-}
module Network.ZRE.Peer (
    newPeerFromBeacon
  , newPeerFromHello
  , newPeerFromEndpoint
  , makePeer
  , destroyPeer
  , msgPeer
  , msgPeerUUID
  , msgAll
  , msgGroup
  , joinGroup
  , joinGroups
  , leaveGroup
  , leaveGroups
  , lookupPeer
  , updatePeer
  , updateLastHeard
  , printPeer
  , printAll
  , msgAllJoin
  , msgAllLeave
  , shoutGroup
  , shoutGroupMulti
  , whisperPeerUUID
  ) where

import Control.Monad
import Control.Monad.IO.Class
import Control.Concurrent
import Control.Concurrent.Async
import Control.Concurrent.STM
import qualified Data.Map as M
import qualified Data.Set as Set
import qualified Data.ByteString.Char8 as B
import Data.ByteString (ByteString)
import Data.Time.Clock
import Data.UUID
import Data.ZRE()
import System.ZMQ4.Endpoint
import Data.ZRE
import Network.ZRE.Types hiding (Shout, Whisper)
import Network.ZRE.Utils
import Network.ZRE.ZMQ (zreDealer)

printPeer :: Peer -> ByteString
printPeer :: Peer -> ByteString
printPeer Peer{GroupSeq
Maybe (Async ())
Maybe ByteString
Headers
Groups
TBQueue ZRECmd
UTCTime
UUID
Endpoint
peerLastHeard :: Peer -> UTCTime
peerQueue :: Peer -> TBQueue ZRECmd
peerAsyncPing :: Peer -> Maybe (Async ())
peerAsync :: Peer -> Maybe (Async ())
peerHeaders :: Peer -> Headers
peerName :: Peer -> Maybe ByteString
peerGroupSeq :: Peer -> GroupSeq
peerGroups :: Peer -> Groups
peerSeq :: Peer -> GroupSeq
peerUUID :: Peer -> UUID
peerEndpoint :: Peer -> Endpoint
peerLastHeard :: UTCTime
peerQueue :: TBQueue ZRECmd
peerAsyncPing :: Maybe (Async ())
peerAsync :: Maybe (Async ())
peerHeaders :: Headers
peerName :: Maybe ByteString
peerGroupSeq :: GroupSeq
peerGroups :: Groups
peerSeq :: GroupSeq
peerUUID :: UUID
peerEndpoint :: Endpoint
..} = ByteString -> [ByteString] -> ByteString
B.intercalate ByteString
" "
  [ByteString
"Peer",
    Maybe ByteString -> ByteString
forall a. Show a => a -> ByteString
bshow Maybe ByteString
peerName,
    Endpoint -> ByteString
pEndpoint Endpoint
peerEndpoint,
    UUID -> ByteString
toASCIIBytes UUID
peerUUID,
    GroupSeq -> ByteString
forall a. Show a => a -> ByteString
bshow GroupSeq
peerSeq,
    GroupSeq -> ByteString
forall a. Show a => a -> ByteString
bshow GroupSeq
peerGroupSeq,
    Groups -> ByteString
forall a. Show a => a -> ByteString
bshow Groups
peerGroups,
    UTCTime -> ByteString
forall a. Show a => a -> ByteString
bshow UTCTime
peerLastHeard]

newPeer :: MonadIO m
        => TVar ZREState
        -> Endpoint
        -> UUID
        -> Set.Set Group
        -> GroupSeq
        -> Maybe Name
        -> Headers
        -> UTCTime
        -> STM (TVar Peer, Maybe (m a), Maybe (IO b))
newPeer :: TVar ZREState
-> Endpoint
-> UUID
-> Groups
-> GroupSeq
-> Maybe ByteString
-> Headers
-> UTCTime
-> STM (TVar Peer, Maybe (m a), Maybe (IO b))
newPeer TVar ZREState
s Endpoint
endpoint UUID
uuid Groups
groups GroupSeq
groupSeq Maybe ByteString
mname Headers
headers UTCTime
t = do
  ZREState
st <- TVar ZREState -> STM ZREState
forall a. TVar a -> STM a
readTVar TVar ZREState
s
  TBQueue ZRECmd
peerQ <- Natural -> STM (TBQueue ZRECmd)
forall a. Natural -> STM (TBQueue a)
newTBQueue Natural
100
  TBQueue ZRECmd -> ZRECmd -> STM ()
forall a. TBQueue a -> a -> STM ()
writeTBQueue TBQueue ZRECmd
peerQ (ZRECmd -> STM ()) -> ZRECmd -> STM ()
forall a b. (a -> b) -> a -> b
$ Endpoint -> Groups -> GroupSeq -> ByteString -> Headers -> ZRECmd
Hello (ZREState -> Endpoint
zreEndpoint ZREState
st) (ZREState -> Groups
zreGroups ZREState
st) (ZREState -> GroupSeq
zreGroupSeq ZREState
st) (ZREState -> ByteString
zreName ZREState
st) (ZREState -> Headers
zreHeaders ZREState
st)

  let p :: Peer
p = Peer :: Endpoint
-> UUID
-> GroupSeq
-> Groups
-> GroupSeq
-> Maybe ByteString
-> Headers
-> Maybe (Async ())
-> Maybe (Async ())
-> TBQueue ZRECmd
-> UTCTime
-> Peer
Peer {
              peerEndpoint :: Endpoint
peerEndpoint  = Endpoint
endpoint
            , peerUUID :: UUID
peerUUID      = UUID
uuid
            , peerSeq :: GroupSeq
peerSeq       = GroupSeq
1
            , peerGroups :: Groups
peerGroups    = Groups
groups
            , peerGroupSeq :: GroupSeq
peerGroupSeq  = GroupSeq
0
            , peerName :: Maybe ByteString
peerName      = Maybe ByteString
mname
            , peerHeaders :: Headers
peerHeaders   = Headers
headers
            , peerAsync :: Maybe (Async ())
peerAsync     = Maybe (Async ())
forall a. Maybe a
Nothing
            , peerAsyncPing :: Maybe (Async ())
peerAsyncPing = Maybe (Async ())
forall a. Maybe a
Nothing
            , peerQueue :: TBQueue ZRECmd
peerQueue     = TBQueue ZRECmd
peerQ
            , peerLastHeard :: UTCTime
peerLastHeard = UTCTime
t }
  TVar Peer
np <- Peer -> STM (TVar Peer)
forall a. a -> STM (TVar a)
newTVar (Peer -> STM (TVar Peer)) -> Peer -> STM (TVar Peer)
forall a b. (a -> b) -> a -> b
$ Peer
p

  TVar ZREState -> (ZREState -> ZREState) -> STM ()
forall a. TVar a -> (a -> a) -> STM ()
modifyTVar TVar ZREState
s ((ZREState -> ZREState) -> STM ())
-> (ZREState -> ZREState) -> STM ()
forall a b. (a -> b) -> a -> b
$ \ZREState
x -> ZREState
x { zrePeers :: Peers
zrePeers = UUID -> TVar Peer -> Peers -> Peers
forall k a. Ord k => k -> a -> Map k a -> Map k a
M.insert UUID
uuid TVar Peer
np (ZREState -> Peers
zrePeers ZREState
x) }

  TVar ZREState -> Event -> STM ()
emit TVar ZREState
s (Event -> STM ()) -> Event -> STM ()
forall a b. (a -> b) -> a -> b
$ UUID -> Maybe ByteString -> Groups -> Headers -> Endpoint -> Event
New UUID
uuid Maybe ByteString
mname Groups
groups Headers
headers Endpoint
endpoint
  case Maybe ByteString
mname of
    (Just ByteString
name) -> TVar ZREState -> Event -> STM ()
emit TVar ZREState
s (Event -> STM ()) -> Event -> STM ()
forall a b. (a -> b) -> a -> b
$ UUID -> ByteString -> Groups -> Headers -> Endpoint -> Event
Ready UUID
uuid ByteString
name Groups
groups Headers
headers Endpoint
endpoint
    Maybe ByteString
Nothing -> () -> STM ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()

  TVar ZREState -> TVar Peer -> Groups -> GroupSeq -> STM ()
joinGroups TVar ZREState
s TVar Peer
np Groups
groups GroupSeq
groupSeq

  (TVar Peer, Maybe (m a), Maybe (IO b))
-> STM (TVar Peer, Maybe (m a), Maybe (IO b))
forall (m :: * -> *) a. Monad m => a -> m a
return ((TVar Peer, Maybe (m a), Maybe (IO b))
 -> STM (TVar Peer, Maybe (m a), Maybe (IO b)))
-> (TVar Peer, Maybe (m a), Maybe (IO b))
-> STM (TVar Peer, Maybe (m a), Maybe (IO b))
forall a b. (a -> b) -> a -> b
$ (TVar Peer
np, m a -> Maybe (m a)
forall a. a -> Maybe a
Just (m a -> Maybe (m a)) -> m a -> Maybe (m a)
forall a b. (a -> b) -> a -> b
$ Endpoint -> ByteString -> TBQueue ZRECmd -> m a
forall (m :: * -> *) a.
MonadIO m =>
Endpoint -> ByteString -> TBQueue ZRECmd -> m a
zreDealer Endpoint
endpoint (UUID -> ByteString
uuidByteString (UUID -> ByteString) -> UUID -> ByteString
forall a b. (a -> b) -> a -> b
$ ZREState -> UUID
zreUUID ZREState
st) TBQueue ZRECmd
peerQ, IO b -> Maybe (IO b)
forall a. a -> Maybe a
Just (IO b -> Maybe (IO b)) -> IO b -> Maybe (IO b)
forall a b. (a -> b) -> a -> b
$ TVar ZREState -> TVar Peer -> IO b
forall b. TVar ZREState -> TVar Peer -> IO b
pinger TVar ZREState
s TVar Peer
np)

newPeerFromBeacon :: MonadIO m
                  => Address
                  -> Port
                  -> UTCTime
                  -> UUID
                  -> TVar ZREState
                  -> STM (TVar Peer, Maybe (m a), Maybe (IO b))
newPeerFromBeacon :: ByteString
-> GroupSeq
-> UTCTime
-> UUID
-> TVar ZREState
-> STM (TVar Peer, Maybe (m a), Maybe (IO b))
newPeerFromBeacon ByteString
addr GroupSeq
port UTCTime
t UUID
uuid TVar ZREState
s = do
  TVar ZREState -> ByteString -> STM ()
emitdbg TVar ZREState
s ByteString
"New peer from beacon"
  let endpoint :: Endpoint
endpoint = ByteString -> GroupSeq -> Endpoint
newTCPEndpoint ByteString
addr GroupSeq
port
  TVar ZREState
-> Endpoint
-> UUID
-> Groups
-> GroupSeq
-> Maybe ByteString
-> Headers
-> UTCTime
-> STM (TVar Peer, Maybe (m a), Maybe (IO b))
forall (m :: * -> *) a b.
MonadIO m =>
TVar ZREState
-> Endpoint
-> UUID
-> Groups
-> GroupSeq
-> Maybe ByteString
-> Headers
-> UTCTime
-> STM (TVar Peer, Maybe (m a), Maybe (IO b))
newPeer TVar ZREState
s Endpoint
endpoint UUID
uuid (Groups
forall a. Set a
Set.empty :: Groups) GroupSeq
0 Maybe ByteString
forall a. Maybe a
Nothing Headers
forall k a. Map k a
M.empty UTCTime
t

newPeerFromHello :: MonadIO m
                 => ZRECmd
                 -> UTCTime
                 -> UUID
                 -> TVar ZREState
                 -> STM (TVar Peer, Maybe (m a), Maybe (IO b))
newPeerFromHello :: ZRECmd
-> UTCTime
-> UUID
-> TVar ZREState
-> STM (TVar Peer, Maybe (m a), Maybe (IO b))
newPeerFromHello (Hello Endpoint
endpoint Groups
groups GroupSeq
groupSeq ByteString
name Headers
headers) UTCTime
t UUID
uuid TVar ZREState
s = do
  TVar ZREState -> ByteString -> STM ()
emitdbg TVar ZREState
s ByteString
"New peer from hello"
  TVar ZREState
-> Endpoint
-> UUID
-> Groups
-> GroupSeq
-> Maybe ByteString
-> Headers
-> UTCTime
-> STM (TVar Peer, Maybe (m a), Maybe (IO b))
forall (m :: * -> *) a b.
MonadIO m =>
TVar ZREState
-> Endpoint
-> UUID
-> Groups
-> GroupSeq
-> Maybe ByteString
-> Headers
-> UTCTime
-> STM (TVar Peer, Maybe (m a), Maybe (IO b))
newPeer TVar ZREState
s Endpoint
endpoint UUID
uuid Groups
groups GroupSeq
groupSeq (ByteString -> Maybe ByteString
forall a. a -> Maybe a
Just ByteString
name) Headers
headers UTCTime
t
newPeerFromHello ZRECmd
_ UTCTime
_ UUID
_ TVar ZREState
_ = [Char] -> STM (TVar Peer, Maybe (m a), Maybe (IO b))
forall a. HasCallStack => [Char] -> a
error [Char]
"not a hello message"

newPeerFromEndpoint :: MonadIO m
                    => Endpoint
                    -> UTCTime
                    -> UUID
                    -> TVar ZREState
                    -> STM (TVar Peer, Maybe (m a), Maybe (IO b))
newPeerFromEndpoint :: Endpoint
-> UTCTime
-> UUID
-> TVar ZREState
-> STM (TVar Peer, Maybe (m a), Maybe (IO b))
newPeerFromEndpoint Endpoint
endpoint UTCTime
t UUID
uuid TVar ZREState
s = do
  TVar ZREState -> ByteString -> STM ()
emitdbg TVar ZREState
s ByteString
"New peer from endpoint"
  TVar ZREState
-> Endpoint
-> UUID
-> Groups
-> GroupSeq
-> Maybe ByteString
-> Headers
-> UTCTime
-> STM (TVar Peer, Maybe (m a), Maybe (IO b))
forall (m :: * -> *) a b.
MonadIO m =>
TVar ZREState
-> Endpoint
-> UUID
-> Groups
-> GroupSeq
-> Maybe ByteString
-> Headers
-> UTCTime
-> STM (TVar Peer, Maybe (m a), Maybe (IO b))
newPeer TVar ZREState
s Endpoint
endpoint UUID
uuid (Groups
forall a. Set a
Set.empty :: Groups) GroupSeq
0 Maybe ByteString
forall a. Maybe a
Nothing Headers
forall k a. Map k a
M.empty UTCTime
t

makePeer :: TVar ZREState
            -> UUID
            -> (UTCTime
                -> UUID
                -> TVar ZREState
                -> STM (TVar Peer, Maybe (IO ()), Maybe (IO ())))
            -> IO (TVar Peer)
makePeer :: TVar ZREState
-> UUID
-> (UTCTime
    -> UUID
    -> TVar ZREState
    -> STM (TVar Peer, Maybe (IO ()), Maybe (IO ())))
-> IO (TVar Peer)
makePeer TVar ZREState
s UUID
uuid UTCTime
-> UUID
-> TVar ZREState
-> STM (TVar Peer, Maybe (IO ()), Maybe (IO ()))
newPeerFn = do
  UTCTime
t <- IO UTCTime
getCurrentTime
  (TVar Peer, Maybe (IO ()), Maybe (IO ()))
res <- STM (TVar Peer, Maybe (IO ()), Maybe (IO ()))
-> IO (TVar Peer, Maybe (IO ()), Maybe (IO ()))
forall a. STM a -> IO a
atomically (STM (TVar Peer, Maybe (IO ()), Maybe (IO ()))
 -> IO (TVar Peer, Maybe (IO ()), Maybe (IO ())))
-> STM (TVar Peer, Maybe (IO ()), Maybe (IO ()))
-> IO (TVar Peer, Maybe (IO ()), Maybe (IO ()))
forall a b. (a -> b) -> a -> b
$ do
    ZREState
st <- TVar ZREState -> STM ZREState
forall a. TVar a -> STM a
readTVar TVar ZREState
s
    case UUID -> Peers -> Maybe (TVar Peer)
forall k a. Ord k => k -> Map k a -> Maybe a
M.lookup UUID
uuid (Peers -> Maybe (TVar Peer)) -> Peers -> Maybe (TVar Peer)
forall a b. (a -> b) -> a -> b
$ ZREState -> Peers
zrePeers ZREState
st of
      (Just TVar Peer
peer) -> (TVar Peer, Maybe (IO ()), Maybe (IO ()))
-> STM (TVar Peer, Maybe (IO ()), Maybe (IO ()))
forall (m :: * -> *) a. Monad m => a -> m a
return (TVar Peer
peer, Maybe (IO ())
forall a. Maybe a
Nothing, Maybe (IO ())
forall a. Maybe a
Nothing)
      Maybe (TVar Peer)
Nothing -> UTCTime
-> UUID
-> TVar ZREState
-> STM (TVar Peer, Maybe (IO ()), Maybe (IO ()))
newPeerFn UTCTime
t UUID
uuid TVar ZREState
s

  case (TVar Peer, Maybe (IO ()), Maybe (IO ()))
res of
    -- fixme: clumsy
    (TVar Peer
peer, Just IO ()
deal, Just IO ()
ping) -> do
      Async ()
a <- IO () -> IO (Async ())
forall a. IO a -> IO (Async a)
async IO ()
deal
      Async ()
b <- IO () -> IO (Async ())
forall a. IO a -> IO (Async a)
async IO ()
ping
      STM () -> IO ()
forall a. STM a -> IO a
atomically (STM () -> IO ()) -> STM () -> IO ()
forall a b. (a -> b) -> a -> b
$ do
        TVar Peer -> (Peer -> Peer) -> STM ()
updatePeer TVar Peer
peer ((Peer -> Peer) -> STM ()) -> (Peer -> Peer) -> STM ()
forall a b. (a -> b) -> a -> b
$ \Peer
x -> Peer
x { peerAsync :: Maybe (Async ())
peerAsync = (Async () -> Maybe (Async ())
forall a. a -> Maybe a
Just Async ()
a) }
        TVar Peer -> (Peer -> Peer) -> STM ()
updatePeer TVar Peer
peer ((Peer -> Peer) -> STM ()) -> (Peer -> Peer) -> STM ()
forall a b. (a -> b) -> a -> b
$ \Peer
x -> Peer
x { peerAsyncPing :: Maybe (Async ())
peerAsyncPing = (Async () -> Maybe (Async ())
forall a. a -> Maybe a
Just Async ()
b) }

      TVar Peer -> IO (TVar Peer)
forall (m :: * -> *) a. Monad m => a -> m a
return TVar Peer
peer
    (TVar Peer
peer, Maybe (IO ())
_, Maybe (IO ())
_) -> TVar Peer -> IO (TVar Peer)
forall (m :: * -> *) a. Monad m => a -> m a
return TVar Peer
peer

destroyPeer :: TVar ZREState -> UUID -> IO ()
destroyPeer :: TVar ZREState -> UUID -> IO ()
destroyPeer TVar ZREState
s UUID
uuid = do
  [Maybe (Async ())]
asyncs <- STM [Maybe (Async ())] -> IO [Maybe (Async ())]
forall a. STM a -> IO a
atomically (STM [Maybe (Async ())] -> IO [Maybe (Async ())])
-> STM [Maybe (Async ())] -> IO [Maybe (Async ())]
forall a b. (a -> b) -> a -> b
$ do
    Maybe (TVar Peer)
mpt <- TVar ZREState -> UUID -> STM (Maybe (TVar Peer))
lookupPeer TVar ZREState
s UUID
uuid
    case Maybe (TVar Peer)
mpt of
      Maybe (TVar Peer)
Nothing -> [Maybe (Async ())] -> STM [Maybe (Async ())]
forall (m :: * -> *) a. Monad m => a -> m a
return []
      (Just TVar Peer
peer) -> do
        Peer{GroupSeq
Maybe (Async ())
Maybe ByteString
Headers
Groups
TBQueue ZRECmd
UTCTime
UUID
Endpoint
peerLastHeard :: UTCTime
peerQueue :: TBQueue ZRECmd
peerAsyncPing :: Maybe (Async ())
peerAsync :: Maybe (Async ())
peerHeaders :: Headers
peerName :: Maybe ByteString
peerGroupSeq :: GroupSeq
peerGroups :: Groups
peerSeq :: GroupSeq
peerUUID :: UUID
peerEndpoint :: Endpoint
peerLastHeard :: Peer -> UTCTime
peerQueue :: Peer -> TBQueue ZRECmd
peerAsyncPing :: Peer -> Maybe (Async ())
peerAsync :: Peer -> Maybe (Async ())
peerHeaders :: Peer -> Headers
peerName :: Peer -> Maybe ByteString
peerGroupSeq :: Peer -> GroupSeq
peerGroups :: Peer -> Groups
peerSeq :: Peer -> GroupSeq
peerUUID :: Peer -> UUID
peerEndpoint :: Peer -> Endpoint
..} <- TVar Peer -> STM Peer
forall a. TVar a -> STM a
readTVar TVar Peer
peer
        TVar ZREState -> (ZREState -> ZREState) -> STM ()
forall a. TVar a -> (a -> a) -> STM ()
modifyTVar TVar ZREState
s ((ZREState -> ZREState) -> STM ())
-> (ZREState -> ZREState) -> STM ()
forall a b. (a -> b) -> a -> b
$ \ZREState
x -> ZREState
x { zrePeers :: Peers
zrePeers = UUID -> Peers -> Peers
forall k a. Ord k => k -> Map k a -> Map k a
M.delete UUID
uuid (ZREState -> Peers
zrePeers ZREState
x) }
        TVar ZREState -> TVar Peer -> Groups -> GroupSeq -> STM ()
leaveGroups TVar ZREState
s TVar Peer
peer Groups
peerGroups GroupSeq
peerGroupSeq
        TVar ZREState -> Event -> STM ()
emit TVar ZREState
s (Event -> STM ()) -> Event -> STM ()
forall a b. (a -> b) -> a -> b
$ UUID -> Maybe ByteString -> Event
Quit UUID
uuid Maybe ByteString
peerName

        [Maybe (Async ())] -> STM [Maybe (Async ())]
forall (m :: * -> *) a. Monad m => a -> m a
return [Maybe (Async ())
peerAsync, Maybe (Async ())
peerAsyncPing]

  -- this is called from pinger so no more code is executed after this point
  (Maybe (Async ()) -> IO ()) -> [Maybe (Async ())] -> IO ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ Maybe (Async ()) -> IO ()
forall a. Maybe (Async a) -> IO ()
cancelM [Maybe (Async ())]
asyncs
  where
    cancelM :: Maybe (Async a) -> IO ()
cancelM Maybe (Async a)
Nothing = () -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
    cancelM (Just Async a
a) = Async a -> IO ()
forall a. Async a -> IO ()
cancel Async a
a

pinger :: TVar ZREState -> TVar Peer -> IO b
pinger :: TVar ZREState -> TVar Peer -> IO b
pinger TVar ZREState
s TVar Peer
peer = IO () -> IO b
forall (f :: * -> *) a b. Applicative f => f a -> f b
forever (IO () -> IO b) -> IO () -> IO b
forall a b. (a -> b) -> a -> b
$ do
  p :: Peer
p@Peer{GroupSeq
Maybe (Async ())
Maybe ByteString
Headers
Groups
TBQueue ZRECmd
UTCTime
UUID
Endpoint
peerLastHeard :: UTCTime
peerQueue :: TBQueue ZRECmd
peerAsyncPing :: Maybe (Async ())
peerAsync :: Maybe (Async ())
peerHeaders :: Headers
peerName :: Maybe ByteString
peerGroupSeq :: GroupSeq
peerGroups :: Groups
peerSeq :: GroupSeq
peerUUID :: UUID
peerEndpoint :: Endpoint
peerLastHeard :: Peer -> UTCTime
peerQueue :: Peer -> TBQueue ZRECmd
peerAsyncPing :: Peer -> Maybe (Async ())
peerAsync :: Peer -> Maybe (Async ())
peerHeaders :: Peer -> Headers
peerName :: Peer -> Maybe ByteString
peerGroupSeq :: Peer -> GroupSeq
peerGroups :: Peer -> Groups
peerSeq :: Peer -> GroupSeq
peerUUID :: Peer -> UUID
peerEndpoint :: Peer -> Endpoint
..} <- STM Peer -> IO Peer
forall a. STM a -> IO a
atomically (STM Peer -> IO Peer) -> STM Peer -> IO Peer
forall a b. (a -> b) -> a -> b
$ TVar Peer -> STM Peer
forall a. TVar a -> STM a
readTVar TVar Peer
peer
  ZRECfg
cfg <- STM ZRECfg -> IO ZRECfg
forall a. STM a -> IO a
atomically (STM ZRECfg -> IO ZRECfg) -> STM ZRECfg -> IO ZRECfg
forall a b. (a -> b) -> a -> b
$ ZREState -> ZRECfg
zreCfg (ZREState -> ZRECfg) -> STM ZREState -> STM ZRECfg
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> TVar ZREState -> STM ZREState
forall a. TVar a -> STM a
readTVar TVar ZREState
s

  UTCTime
now <- IO UTCTime
getCurrentTime
  if UTCTime -> UTCTime -> NominalDiffTime
diffUTCTime UTCTime
now UTCTime
peerLastHeard NominalDiffTime -> NominalDiffTime -> Bool
forall a. Ord a => a -> a -> Bool
> (Float -> NominalDiffTime
forall a b. (Real a, Fractional b) => a -> b
realToFrac (Float -> NominalDiffTime) -> Float -> NominalDiffTime
forall a b. (a -> b) -> a -> b
$ ZRECfg -> Float
zreDeadPeriod ZRECfg
cfg)
    then do
      STM () -> IO ()
forall a. STM a -> IO a
atomically (STM () -> IO ()) -> STM () -> IO ()
forall a b. (a -> b) -> a -> b
$ TVar ZREState -> ByteString -> STM ()
emitdbg TVar ZREState
s (ByteString -> STM ()) -> ByteString -> STM ()
forall a b. (a -> b) -> a -> b
$ [ByteString] -> ByteString
B.unwords [ByteString
"Peer over deadPeriod, destroying", Peer -> ByteString
forall a. Show a => a -> ByteString
bshow Peer
p]
      TVar ZREState -> UUID -> IO ()
destroyPeer TVar ZREState
s UUID
peerUUID
    else do
      let tdiff :: NominalDiffTime
tdiff = UTCTime -> UTCTime -> NominalDiffTime
diffUTCTime UTCTime
now UTCTime
peerLastHeard
      if NominalDiffTime
tdiff NominalDiffTime -> NominalDiffTime -> Bool
forall a. Ord a => a -> a -> Bool
> (Float -> NominalDiffTime
forall a b. (Real a, Fractional b) => a -> b
realToFrac (Float -> NominalDiffTime) -> Float -> NominalDiffTime
forall a b. (a -> b) -> a -> b
$ ZRECfg -> Float
zreQuietPeriod ZRECfg
cfg)
        then do
          STM () -> IO ()
forall a. STM a -> IO a
atomically (STM () -> IO ()) -> STM () -> IO ()
forall a b. (a -> b) -> a -> b
$ TVar ZREState -> ByteString -> STM ()
emitdbg TVar ZREState
s (ByteString -> STM ()) -> ByteString -> STM ()
forall a b. (a -> b) -> a -> b
$ [ByteString] -> ByteString
B.unwords [ByteString
"Peer over quietPeriod, sending hugz", Peer -> ByteString
forall a. Show a => a -> ByteString
bshow Peer
p]
          STM () -> IO ()
forall a. STM a -> IO a
atomically (STM () -> IO ()) -> STM () -> IO ()
forall a b. (a -> b) -> a -> b
$ TBQueue ZRECmd -> ZRECmd -> STM ()
forall a. TBQueue a -> a -> STM ()
writeTBQueue TBQueue ZRECmd
peerQueue (ZRECmd -> STM ()) -> ZRECmd -> STM ()
forall a b. (a -> b) -> a -> b
$ ZRECmd
Ping
          GroupSeq -> IO ()
threadDelay (GroupSeq -> IO ()) -> GroupSeq -> IO ()
forall a b. (a -> b) -> a -> b
$ Float -> GroupSeq
forall a. RealFrac a => a -> GroupSeq
sec (ZRECfg -> Float
zreQuietPingRate ZRECfg
cfg)
        else do
          GroupSeq -> IO ()
threadDelay (GroupSeq -> IO ()) -> GroupSeq -> IO ()
forall a b. (a -> b) -> a -> b
$ NominalDiffTime -> GroupSeq
forall a. RealFrac a => a -> GroupSeq
sec (NominalDiffTime -> GroupSeq) -> NominalDiffTime -> GroupSeq
forall a b. (a -> b) -> a -> b
$ (Float -> NominalDiffTime
forall a b. (Real a, Fractional b) => a -> b
realToFrac (Float -> NominalDiffTime) -> Float -> NominalDiffTime
forall a b. (a -> b) -> a -> b
$ ZRECfg -> Float
zreQuietPeriod ZRECfg
cfg) NominalDiffTime -> NominalDiffTime -> NominalDiffTime
forall a. Num a => a -> a -> a
- NominalDiffTime
tdiff

lookupPeer :: TVar ZREState -> UUID -> STM (Maybe (TVar Peer))
lookupPeer :: TVar ZREState -> UUID -> STM (Maybe (TVar Peer))
lookupPeer TVar ZREState
s UUID
uuid = do
  ZREState
st <- TVar ZREState -> STM ZREState
forall a. TVar a -> STM a
readTVar TVar ZREState
s
  Maybe (TVar Peer) -> STM (Maybe (TVar Peer))
forall (m :: * -> *) a. Monad m => a -> m a
return (Maybe (TVar Peer) -> STM (Maybe (TVar Peer)))
-> Maybe (TVar Peer) -> STM (Maybe (TVar Peer))
forall a b. (a -> b) -> a -> b
$ UUID -> Peers -> Maybe (TVar Peer)
forall k a. Ord k => k -> Map k a -> Maybe a
M.lookup UUID
uuid (Peers -> Maybe (TVar Peer)) -> Peers -> Maybe (TVar Peer)
forall a b. (a -> b) -> a -> b
$ ZREState -> Peers
zrePeers ZREState
st

updatePeer :: TVar Peer -> (Peer -> Peer) -> STM ()
updatePeer :: TVar Peer -> (Peer -> Peer) -> STM ()
updatePeer TVar Peer
peer Peer -> Peer
fn = TVar Peer -> (Peer -> Peer) -> STM ()
forall a. TVar a -> (a -> a) -> STM ()
modifyTVar TVar Peer
peer Peer -> Peer
fn

--updatePeerUUID :: TVar ZREState -> UUID -> (Peer -> Peer) -> STM ()
--updatePeerUUID s uuid fn = do
--  st <- readTVar s
--  case M.lookup uuid $ zrePeers st of
--    Nothing -> return ()
--    (Just peer) -> updatePeer peer fn

updateLastHeard :: TVar Peer -> UTCTime -> STM ()
updateLastHeard :: TVar Peer -> UTCTime -> STM ()
updateLastHeard TVar Peer
peer UTCTime
val = TVar Peer -> (Peer -> Peer) -> STM ()
updatePeer TVar Peer
peer ((Peer -> Peer) -> STM ()) -> (Peer -> Peer) -> STM ()
forall a b. (a -> b) -> a -> b
$ \Peer
x -> Peer
x { peerLastHeard :: UTCTime
peerLastHeard = UTCTime
val }

-- join `peer` to `group`, update group sequence nuber to `groupSeq`
joinGroup :: TVar ZREState -> TVar Peer -> Group -> GroupSeq -> STM ()
joinGroup :: TVar ZREState -> TVar Peer -> Group -> GroupSeq -> STM ()
joinGroup TVar ZREState
s TVar Peer
peer Group
group GroupSeq
groupSeq = do
  TVar Peer -> (Peer -> Peer) -> STM ()
updatePeer TVar Peer
peer ((Peer -> Peer) -> STM ()) -> (Peer -> Peer) -> STM ()
forall a b. (a -> b) -> a -> b
$ \Peer
x -> Peer
x { peerGroups :: Groups
peerGroups = Group -> Groups -> Groups
forall a. Ord a => a -> Set a -> Set a
Set.insert Group
group (Peer -> Groups
peerGroups Peer
x) }
  TVar Peer -> (Peer -> Peer) -> STM ()
updatePeer TVar Peer
peer ((Peer -> Peer) -> STM ()) -> (Peer -> Peer) -> STM ()
forall a b. (a -> b) -> a -> b
$ \Peer
x -> Peer
x { peerGroupSeq :: GroupSeq
peerGroupSeq = GroupSeq
groupSeq }
  Peer
p <- TVar Peer -> STM Peer
forall a. TVar a -> STM a
readTVar TVar Peer
peer
  TVar ZREState -> Event -> STM ()
emit TVar ZREState
s (Event -> STM ()) -> Event -> STM ()
forall a b. (a -> b) -> a -> b
$ UUID -> Group -> Event
GroupJoin (Peer -> UUID
peerUUID Peer
p) Group
group
  TVar ZREState -> (ZREState -> ZREState) -> STM ()
forall a. TVar a -> (a -> a) -> STM ()
modifyTVar TVar ZREState
s ((ZREState -> ZREState) -> STM ())
-> (ZREState -> ZREState) -> STM ()
forall a b. (a -> b) -> a -> b
$ \ZREState
x -> ZREState
x { zrePeerGroups :: PeerGroups
zrePeerGroups = (Maybe Peers -> Maybe Peers) -> Group -> PeerGroups -> PeerGroups
forall k a.
Ord k =>
(Maybe a -> Maybe a) -> k -> Map k a -> Map k a
M.alter (Peer -> Maybe Peers -> Maybe Peers
f Peer
p) Group
group (PeerGroups -> PeerGroups) -> PeerGroups -> PeerGroups
forall a b. (a -> b) -> a -> b
$ ZREState -> PeerGroups
zrePeerGroups ZREState
x }
  where
    f :: Peer -> Maybe Peers -> Maybe Peers
f Peer
p Maybe Peers
Nothing = Peers -> Maybe Peers
forall a. a -> Maybe a
Just (Peers -> Maybe Peers) -> Peers -> Maybe Peers
forall a b. (a -> b) -> a -> b
$ [(UUID, TVar Peer)] -> Peers
forall k a. Ord k => [(k, a)] -> Map k a
M.fromList [(Peer -> UUID
peerUUID Peer
p, TVar Peer
peer)]
    f Peer
p (Just Peers
old) = Peers -> Maybe Peers
forall a. a -> Maybe a
Just (Peers -> Maybe Peers) -> Peers -> Maybe Peers
forall a b. (a -> b) -> a -> b
$ UUID -> TVar Peer -> Peers -> Peers
forall k a. Ord k => k -> a -> Map k a -> Map k a
M.insert (Peer -> UUID
peerUUID Peer
p) TVar Peer
peer Peers
old

joinGroups :: TVar ZREState -> TVar Peer -> Set.Set Group -> GroupSeq -> STM ()
joinGroups :: TVar ZREState -> TVar Peer -> Groups -> GroupSeq -> STM ()
joinGroups TVar ZREState
s TVar Peer
peer Groups
groups GroupSeq
groupSeq = do
  (Group -> STM ()) -> [Group] -> STM ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ (\Group
x -> TVar ZREState -> TVar Peer -> Group -> GroupSeq -> STM ()
joinGroup TVar ZREState
s TVar Peer
peer Group
x GroupSeq
groupSeq) ([Group] -> STM ()) -> [Group] -> STM ()
forall a b. (a -> b) -> a -> b
$ Groups -> [Group]
forall a. Set a -> [a]
Set.toList Groups
groups

leaveGroup :: TVar ZREState -> TVar Peer -> Group -> GroupSeq -> STM ()
leaveGroup :: TVar ZREState -> TVar Peer -> Group -> GroupSeq -> STM ()
leaveGroup TVar ZREState
s TVar Peer
peer Group
group GroupSeq
groupSeq = do
  TVar Peer -> (Peer -> Peer) -> STM ()
updatePeer TVar Peer
peer ((Peer -> Peer) -> STM ()) -> (Peer -> Peer) -> STM ()
forall a b. (a -> b) -> a -> b
$ \Peer
x -> Peer
x { peerGroups :: Groups
peerGroups = Group -> Groups -> Groups
forall a. Ord a => a -> Set a -> Set a
Set.delete Group
group (Peer -> Groups
peerGroups Peer
x) }
  TVar Peer -> (Peer -> Peer) -> STM ()
updatePeer TVar Peer
peer ((Peer -> Peer) -> STM ()) -> (Peer -> Peer) -> STM ()
forall a b. (a -> b) -> a -> b
$ \Peer
x -> Peer
x { peerGroupSeq :: GroupSeq
peerGroupSeq = GroupSeq
groupSeq }
  Peer
p <- TVar Peer -> STM Peer
forall a. TVar a -> STM a
readTVar TVar Peer
peer
  TVar ZREState -> Event -> STM ()
emit TVar ZREState
s (Event -> STM ()) -> Event -> STM ()
forall a b. (a -> b) -> a -> b
$ UUID -> Group -> Event
GroupLeave (Peer -> UUID
peerUUID Peer
p) Group
group
  TVar ZREState -> (ZREState -> ZREState) -> STM ()
forall a. TVar a -> (a -> a) -> STM ()
modifyTVar TVar ZREState
s ((ZREState -> ZREState) -> STM ())
-> (ZREState -> ZREState) -> STM ()
forall a b. (a -> b) -> a -> b
$ \ZREState
x -> ZREState
x { zrePeerGroups :: PeerGroups
zrePeerGroups = (Maybe Peers -> Maybe Peers) -> Group -> PeerGroups -> PeerGroups
forall k a.
Ord k =>
(Maybe a -> Maybe a) -> k -> Map k a -> Map k a
M.alter (Peer -> Maybe Peers -> Maybe Peers
forall a. Peer -> Maybe (Map UUID a) -> Maybe (Map UUID a)
f Peer
p) Group
group (PeerGroups -> PeerGroups) -> PeerGroups -> PeerGroups
forall a b. (a -> b) -> a -> b
$ ZREState -> PeerGroups
zrePeerGroups ZREState
x }
  where
    f :: Peer -> Maybe (Map UUID a) -> Maybe (Map UUID a)
f Peer
_ Maybe (Map UUID a)
Nothing = Maybe (Map UUID a)
forall a. Maybe a
Nothing
    f Peer
p (Just Map UUID a
old) = Map UUID a -> Maybe (Map UUID a)
forall k a. Map k a -> Maybe (Map k a)
nEmpty (Map UUID a -> Maybe (Map UUID a))
-> Map UUID a -> Maybe (Map UUID a)
forall a b. (a -> b) -> a -> b
$ UUID -> Map UUID a -> Map UUID a
forall k a. Ord k => k -> Map k a -> Map k a
M.delete (Peer -> UUID
peerUUID Peer
p) Map UUID a
old
    nEmpty :: Map k a -> Maybe (Map k a)
nEmpty Map k a
pmap | Map k a -> Bool
forall k a. Map k a -> Bool
M.null Map k a
pmap = Maybe (Map k a)
forall a. Maybe a
Nothing
    nEmpty Map k a
pmap = Map k a -> Maybe (Map k a)
forall a. a -> Maybe a
Just Map k a
pmap

leaveGroups :: TVar ZREState -> TVar Peer -> Set.Set Group -> GroupSeq -> STM ()
leaveGroups :: TVar ZREState -> TVar Peer -> Groups -> GroupSeq -> STM ()
leaveGroups TVar ZREState
s TVar Peer
peer Groups
groups GroupSeq
groupSeq = do
  (Group -> STM ()) -> [Group] -> STM ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ (\Group
x -> TVar ZREState -> TVar Peer -> Group -> GroupSeq -> STM ()
leaveGroup TVar ZREState
s TVar Peer
peer Group
x GroupSeq
groupSeq) ([Group] -> STM ()) -> [Group] -> STM ()
forall a b. (a -> b) -> a -> b
$ Groups -> [Group]
forall a. Set a -> [a]
Set.toList Groups
groups

msgPeer :: TVar Peer -> ZRECmd -> STM ()
msgPeer :: TVar Peer -> ZRECmd -> STM ()
msgPeer TVar Peer
peer ZRECmd
msg = do
  Peer
p <- TVar Peer -> STM Peer
forall a. TVar a -> STM a
readTVar TVar Peer
peer
  TBQueue ZRECmd -> ZRECmd -> STM ()
forall a. TBQueue a -> a -> STM ()
writeTBQueue (Peer -> TBQueue ZRECmd
peerQueue Peer
p) ZRECmd
msg

msgPeerUUID :: TVar ZREState -> UUID -> ZRECmd -> STM ()
msgPeerUUID :: TVar ZREState -> UUID -> ZRECmd -> STM ()
msgPeerUUID TVar ZREState
s UUID
uuid ZRECmd
msg = do
  ZREState
st <- TVar ZREState -> STM ZREState
forall a. TVar a -> STM a
readTVar TVar ZREState
s
  case UUID -> Peers -> Maybe (TVar Peer)
forall k a. Ord k => k -> Map k a -> Maybe a
M.lookup UUID
uuid (Peers -> Maybe (TVar Peer)) -> Peers -> Maybe (TVar Peer)
forall a b. (a -> b) -> a -> b
$ ZREState -> Peers
zrePeers ZREState
st of
    Maybe (TVar Peer)
Nothing -> () -> STM ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
    (Just TVar Peer
peer) -> do
      TVar Peer -> ZRECmd -> STM ()
msgPeer TVar Peer
peer ZRECmd
msg
      () -> STM ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()

msgAll :: TVar ZREState -> ZRECmd -> STM ()
msgAll :: TVar ZREState -> ZRECmd -> STM ()
msgAll TVar ZREState
s ZRECmd
msg = do
  ZREState
st <- TVar ZREState -> STM ZREState
forall a. TVar a -> STM a
readTVar TVar ZREState
s
  (TVar Peer -> STM ()) -> Peers -> STM ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ ((TVar Peer -> ZRECmd -> STM ()) -> ZRECmd -> TVar Peer -> STM ()
forall a b c. (a -> b -> c) -> b -> a -> c
flip TVar Peer -> ZRECmd -> STM ()
msgPeer ZRECmd
msg) (ZREState -> Peers
zrePeers ZREState
st)

msgGroup :: TVar ZREState -> Group -> ZRECmd -> STM ()
msgGroup :: TVar ZREState -> Group -> ZRECmd -> STM ()
msgGroup TVar ZREState
s Group
groupname ZRECmd
msg = do
  ZREState
st <- TVar ZREState -> STM ZREState
forall a. TVar a -> STM a
readTVar TVar ZREState
s
  case Group -> PeerGroups -> Maybe Peers
forall k a. Ord k => k -> Map k a -> Maybe a
M.lookup Group
groupname (PeerGroups -> Maybe Peers) -> PeerGroups -> Maybe Peers
forall a b. (a -> b) -> a -> b
$ ZREState -> PeerGroups
zrePeerGroups ZREState
st of
    Maybe Peers
Nothing -> () -> STM ()
forall (m :: * -> *) a. Monad m => a -> m a
return () -- XXX: should report no such group error?
    (Just Peers
group) -> do
      (TVar Peer -> STM ()) -> Peers -> STM ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ ((TVar Peer -> ZRECmd -> STM ()) -> ZRECmd -> TVar Peer -> STM ()
forall a b c. (a -> b -> c) -> b -> a -> c
flip TVar Peer -> ZRECmd -> STM ()
msgPeer ZRECmd
msg) Peers
group

shoutGroup :: TVar ZREState -> Group -> ByteString -> STM ()
shoutGroup :: TVar ZREState -> Group -> ByteString -> STM ()
shoutGroup TVar ZREState
s Group
group ByteString
msg = TVar ZREState -> Group -> ZRECmd -> STM ()
msgGroup TVar ZREState
s Group
group (ZRECmd -> STM ()) -> ZRECmd -> STM ()
forall a b. (a -> b) -> a -> b
$ Group -> [ByteString] -> ZRECmd
Shout Group
group [ByteString
msg]

shoutGroupMulti :: TVar ZREState -> Group -> Content -> STM ()
shoutGroupMulti :: TVar ZREState -> Group -> [ByteString] -> STM ()
shoutGroupMulti TVar ZREState
s Group
group [ByteString]
mmsg = TVar ZREState -> Group -> ZRECmd -> STM ()
msgGroup TVar ZREState
s Group
group (ZRECmd -> STM ()) -> ZRECmd -> STM ()
forall a b. (a -> b) -> a -> b
$ Group -> [ByteString] -> ZRECmd
Shout Group
group [ByteString]
mmsg

msgAllJoin :: TVar ZREState -> Group -> GroupSeq -> STM ()
msgAllJoin :: TVar ZREState -> Group -> GroupSeq -> STM ()
msgAllJoin TVar ZREState
s Group
group GroupSeq
sq = TVar ZREState -> ZRECmd -> STM ()
msgAll TVar ZREState
s (ZRECmd -> STM ()) -> ZRECmd -> STM ()
forall a b. (a -> b) -> a -> b
$ Group -> GroupSeq -> ZRECmd
Join Group
group GroupSeq
sq

msgAllLeave :: TVar ZREState -> Group -> GroupSeq -> STM ()
msgAllLeave :: TVar ZREState -> Group -> GroupSeq -> STM ()
msgAllLeave TVar ZREState
s Group
group GroupSeq
sq = TVar ZREState -> ZRECmd -> STM ()
msgAll TVar ZREState
s (ZRECmd -> STM ()) -> ZRECmd -> STM ()
forall a b. (a -> b) -> a -> b
$ Group -> GroupSeq -> ZRECmd
Leave Group
group GroupSeq
sq

whisperPeerUUID :: TVar ZREState -> UUID -> ByteString -> STM ()
whisperPeerUUID :: TVar ZREState -> UUID -> ByteString -> STM ()
whisperPeerUUID TVar ZREState
s UUID
uuid ByteString
msg = TVar ZREState -> UUID -> ZRECmd -> STM ()
msgPeerUUID TVar ZREState
s UUID
uuid (ZRECmd -> STM ()) -> ZRECmd -> STM ()
forall a b. (a -> b) -> a -> b
$ [ByteString] -> ZRECmd
Whisper [ByteString
msg]

printPeers :: M.Map k (TVar Peer) -> IO ()
printPeers :: Map k (TVar Peer) -> IO ()
printPeers Map k (TVar Peer)
x = do
  (TVar Peer -> IO ()) -> [TVar Peer] -> IO ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ TVar Peer -> IO ()
ePrint ([TVar Peer] -> IO ()) -> [TVar Peer] -> IO ()
forall a b. (a -> b) -> a -> b
$ Map k (TVar Peer) -> [TVar Peer]
forall k a. Map k a -> [a]
M.elems Map k (TVar Peer)
x
  where
    ePrint :: TVar Peer -> IO ()
ePrint TVar Peer
pt = do
      Peer
p <- STM Peer -> IO Peer
forall a. STM a -> IO a
atomically (STM Peer -> IO Peer) -> STM Peer -> IO Peer
forall a b. (a -> b) -> a -> b
$ TVar Peer -> STM Peer
forall a. TVar a -> STM a
readTVar TVar Peer
pt
      ByteString -> IO ()
B.putStrLn (ByteString -> IO ()) -> ByteString -> IO ()
forall a b. (a -> b) -> a -> b
$ Peer -> ByteString
printPeer Peer
p

printGroup :: (Group, M.Map k (TVar Peer)) -> IO ()
printGroup :: (Group, Map k (TVar Peer)) -> IO ()
printGroup (Group
g, Map k (TVar Peer)
v) = do
  ByteString -> IO ()
B.putStrLn (ByteString -> IO ()) -> ByteString -> IO ()
forall a b. (a -> b) -> a -> b
$ ByteString -> [ByteString] -> ByteString
B.intercalate ByteString
" " [ByteString
"group", Group -> ByteString
unGroup Group
g, ByteString
"->"]
  Map k (TVar Peer) -> IO ()
forall k. Map k (TVar Peer) -> IO ()
printPeers Map k (TVar Peer)
v

printAll :: TVar ZREState -> IO ()
printAll :: TVar ZREState -> IO ()
printAll TVar ZREState
s = do
  ZREState
st <- STM ZREState -> IO ZREState
forall a. STM a -> IO a
atomically (STM ZREState -> IO ZREState) -> STM ZREState -> IO ZREState
forall a b. (a -> b) -> a -> b
$ TVar ZREState -> STM ZREState
forall a. TVar a -> STM a
readTVar TVar ZREState
s
  Peers -> IO ()
forall k. Map k (TVar Peer) -> IO ()
printPeers (Peers -> IO ()) -> Peers -> IO ()
forall a b. (a -> b) -> a -> b
$ ZREState -> Peers
zrePeers ZREState
st
  ((Group, Peers) -> IO ()) -> [(Group, Peers)] -> IO ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ (Group, Peers) -> IO ()
forall k. (Group, Map k (TVar Peer)) -> IO ()
printGroup ([(Group, Peers)] -> IO ()) -> [(Group, Peers)] -> IO ()
forall a b. (a -> b) -> a -> b
$ PeerGroups -> [(Group, Peers)]
forall k a. Map k a -> [(k, a)]
M.toList (PeerGroups -> [(Group, Peers)]) -> PeerGroups -> [(Group, Peers)]
forall a b. (a -> b) -> a -> b
$ ZREState -> PeerGroups
zrePeerGroups ZREState
st