module Hydra.Network.HeartbeatSpec where

import Hydra.Prelude
import Test.Hydra.Prelude

import Control.Concurrent.Class.MonadSTM (MonadSTM (readTVarIO), modifyTVar', newTVarIO)
import Control.Monad.IOSim (runSimOrThrow)
import Hydra.Network (Network (..), NetworkCallback (..), NetworkComponent, NodeId (..))
import Hydra.Network.Heartbeat (Heartbeat (..), withHeartbeat)
import Hydra.Network.Message (Connectivity (Connected, Disconnected))

spec :: Spec
spec :: Spec
spec = Spec -> Spec
forall a. SpecWith a -> SpecWith a
parallel (Spec -> Spec) -> Spec -> Spec
forall a b. (a -> b) -> a -> b
$ do
  let nodeId :: NodeId
nodeId = Text -> NodeId
NodeId Text
"node_id-1"

      otherNodeId :: NodeId
otherNodeId = Text -> NodeId
NodeId Text
"node_id-2"

  String -> Expectation -> SpecWith (Arg Expectation)
forall a.
(HasCallStack, Example a) =>
String -> a -> SpecWith (Arg a)
it String
"sends a heartbeat message with local host after 500 ms" (Expectation -> SpecWith (Arg Expectation))
-> Expectation -> SpecWith (Arg Expectation)
forall a b. (a -> b) -> a -> b
$ do
    let sentHeartbeats :: [Heartbeat ()]
sentHeartbeats = (forall s. IOSim s [Heartbeat ()]) -> [Heartbeat ()]
forall a. (forall s. IOSim s a) -> a
runSimOrThrow ((forall s. IOSim s [Heartbeat ()]) -> [Heartbeat ()])
-> (forall s. IOSim s [Heartbeat ()]) -> [Heartbeat ()]
forall a b. (a -> b) -> a -> b
$ do
          (NetworkComponent (IOSim s) (Heartbeat ()) (Heartbeat ()) ()
capturingComponent, IOSim s [Heartbeat ()]
getOutgoingMessages) <- IOSim
  s
  (NetworkComponent (IOSim s) (Heartbeat ()) (Heartbeat ()) (),
   IOSim s [Heartbeat ()])
forall (m :: * -> *).
MonadSTM m =>
m (NetworkComponent m (Heartbeat ()) (Heartbeat ()) (),
   m [Heartbeat ()])
captureOutgoing

          NodeId
-> NetworkComponent (IOSim s) (Heartbeat ()) (Heartbeat ()) ()
-> NetworkComponent (IOSim s) (Either Connectivity ()) () ()
forall (m :: * -> *) inbound outbound a.
(MonadAsync m, MonadDelay m) =>
NodeId
-> NetworkComponent m (Heartbeat inbound) (Heartbeat outbound) a
-> NetworkComponent m (Either Connectivity inbound) outbound a
withHeartbeat NodeId
nodeId NetworkComponent (IOSim s) (Heartbeat ()) (Heartbeat ()) ()
capturingComponent NetworkCallback (Either Connectivity ()) (IOSim s)
forall (m :: * -> *) b. Monad m => NetworkCallback b m
noop ((Network (IOSim s) () -> IOSim s ()) -> IOSim s ())
-> (Network (IOSim s) () -> IOSim s ()) -> IOSim s ()
forall a b. (a -> b) -> a -> b
$ \Network (IOSim s) ()
_ ->
            DiffTime -> IOSim s ()
forall (m :: * -> *). MonadDelay m => DiffTime -> m ()
threadDelay DiffTime
1.1

          IOSim s [Heartbeat ()]
getOutgoingMessages

    [Heartbeat ()]
sentHeartbeats [Heartbeat ()] -> [Heartbeat ()] -> Expectation
forall a. (HasCallStack, Show a, Eq a) => a -> a -> Expectation
`shouldBe` [NodeId -> Heartbeat ()
forall msg. NodeId -> Heartbeat msg
Ping NodeId
nodeId]

  String -> Expectation -> SpecWith (Arg Expectation)
forall a.
(HasCallStack, Example a) =>
String -> a -> SpecWith (Arg a)
it String
"sends Connected when Ping received from other peer" (Expectation -> SpecWith (Arg Expectation))
-> Expectation -> SpecWith (Arg Expectation)
forall a b. (a -> b) -> a -> b
$ do
    let receivedHeartbeats :: [Connectivity]
receivedHeartbeats = (forall s. IOSim s [Connectivity]) -> [Connectivity]
forall a. (forall s. IOSim s a) -> a
runSimOrThrow ((forall s. IOSim s [Connectivity]) -> [Connectivity])
-> (forall s. IOSim s [Connectivity]) -> [Connectivity]
forall a b. (a -> b) -> a -> b
$ do
          (NetworkCallback (Either Connectivity Any) (IOSim s)
callback, IOSim s [Connectivity]
getConnectivityEvents) <- IOSim
  s
  (NetworkCallback (Either Connectivity Any) (IOSim s),
   IOSim s [Connectivity])
forall (m :: * -> *) a.
MonadSTM m =>
m (NetworkCallback (Either Connectivity a) m, m [Connectivity])
captureConnectivity

          NodeId
-> NetworkComponent (IOSim s) (Heartbeat Any) (Heartbeat Any) ()
-> NetworkComponent (IOSim s) (Either Connectivity Any) Any ()
forall (m :: * -> *) inbound outbound a.
(MonadAsync m, MonadDelay m) =>
NodeId
-> NetworkComponent m (Heartbeat inbound) (Heartbeat outbound) a
-> NetworkComponent m (Either Connectivity inbound) outbound a
withHeartbeat NodeId
nodeId (\NetworkCallback{Heartbeat Any -> IOSim s ()
deliver :: Heartbeat Any -> IOSim s ()
$sel:deliver:NetworkCallback :: forall msg (m :: * -> *). NetworkCallback msg m -> msg -> m ()
deliver} Network (IOSim s) (Heartbeat Any) -> IOSim s ()
_ -> Heartbeat Any -> IOSim s ()
deliver (NodeId -> Heartbeat Any
forall msg. NodeId -> Heartbeat msg
Ping NodeId
otherNodeId)) NetworkCallback (Either Connectivity Any) (IOSim s)
callback ((Network (IOSim s) Any -> IOSim s ()) -> IOSim s ())
-> (Network (IOSim s) Any -> IOSim s ()) -> IOSim s ()
forall a b. (a -> b) -> a -> b
$ \Network (IOSim s) Any
_ ->
            DiffTime -> IOSim s ()
forall (m :: * -> *). MonadDelay m => DiffTime -> m ()
threadDelay DiffTime
1

          IOSim s [Connectivity]
getConnectivityEvents

    [Connectivity]
receivedHeartbeats [Connectivity] -> [Connectivity] -> Expectation
forall a. (HasCallStack, Show a, Eq a) => a -> a -> Expectation
`shouldBe` [NodeId -> Connectivity
Connected NodeId
otherNodeId]

  String -> Expectation -> SpecWith (Arg Expectation)
forall a.
(HasCallStack, Example a) =>
String -> a -> SpecWith (Arg a)
it String
"sends Connected when any message received from other party" (Expectation -> SpecWith (Arg Expectation))
-> Expectation -> SpecWith (Arg Expectation)
forall a b. (a -> b) -> a -> b
$ do
    let receivedHeartbeats :: [Connectivity]
receivedHeartbeats = (forall s. IOSim s [Connectivity]) -> [Connectivity]
forall a. (forall s. IOSim s a) -> a
runSimOrThrow ((forall s. IOSim s [Connectivity]) -> [Connectivity])
-> (forall s. IOSim s [Connectivity]) -> [Connectivity]
forall a b. (a -> b) -> a -> b
$ do
          (NetworkCallback (Either Connectivity ()) (IOSim s)
callback, IOSim s [Connectivity]
getConnectivityEvents) <- IOSim
  s
  (NetworkCallback (Either Connectivity ()) (IOSim s),
   IOSim s [Connectivity])
forall (m :: * -> *) a.
MonadSTM m =>
m (NetworkCallback (Either Connectivity a) m, m [Connectivity])
captureConnectivity

          NodeId
-> NetworkComponent (IOSim s) (Heartbeat ()) (Heartbeat Any) ()
-> NetworkComponent (IOSim s) (Either Connectivity ()) Any ()
forall (m :: * -> *) inbound outbound a.
(MonadAsync m, MonadDelay m) =>
NodeId
-> NetworkComponent m (Heartbeat inbound) (Heartbeat outbound) a
-> NetworkComponent m (Either Connectivity inbound) outbound a
withHeartbeat NodeId
nodeId (\NetworkCallback{Heartbeat () -> IOSim s ()
$sel:deliver:NetworkCallback :: forall msg (m :: * -> *). NetworkCallback msg m -> msg -> m ()
deliver :: Heartbeat () -> IOSim s ()
deliver} Network (IOSim s) (Heartbeat Any) -> IOSim s ()
_ -> Heartbeat () -> IOSim s ()
deliver (NodeId -> () -> Heartbeat ()
forall msg. NodeId -> msg -> Heartbeat msg
Data NodeId
otherNodeId ())) NetworkCallback (Either Connectivity ()) (IOSim s)
callback ((Network (IOSim s) Any -> IOSim s ()) -> IOSim s ())
-> (Network (IOSim s) Any -> IOSim s ()) -> IOSim s ()
forall a b. (a -> b) -> a -> b
$ \Network (IOSim s) Any
_ ->
            DiffTime -> IOSim s ()
forall (m :: * -> *). MonadDelay m => DiffTime -> m ()
threadDelay DiffTime
1

          IOSim s [Connectivity]
getConnectivityEvents

    [Connectivity]
receivedHeartbeats [Connectivity] -> [Connectivity] -> Expectation
forall a. (HasCallStack, Show a, Eq a) => a -> a -> Expectation
`shouldBe` [NodeId -> Connectivity
Connected NodeId
otherNodeId]

  String -> Expectation -> SpecWith (Arg Expectation)
forall a.
(HasCallStack, Example a) =>
String -> a -> SpecWith (Arg a)
it String
"do not send Connected on subsequent messages from already Connected party" (Expectation -> SpecWith (Arg Expectation))
-> Expectation -> SpecWith (Arg Expectation)
forall a b. (a -> b) -> a -> b
$ do
    let receivedHeartbeats :: [Connectivity]
receivedHeartbeats = (forall s. IOSim s [Connectivity]) -> [Connectivity]
forall a. (forall s. IOSim s a) -> a
runSimOrThrow ((forall s. IOSim s [Connectivity]) -> [Connectivity])
-> (forall s. IOSim s [Connectivity]) -> [Connectivity]
forall a b. (a -> b) -> a -> b
$ do
          (NetworkCallback (Either Connectivity ()) (IOSim s)
callback, IOSim s [Connectivity]
getConnectivityEvents) <- IOSim
  s
  (NetworkCallback (Either Connectivity ()) (IOSim s),
   IOSim s [Connectivity])
forall (m :: * -> *) a.
MonadSTM m =>
m (NetworkCallback (Either Connectivity a) m, m [Connectivity])
captureConnectivity

          NodeId
-> NetworkComponent (IOSim s) (Heartbeat ()) (Heartbeat Any) ()
-> NetworkComponent (IOSim s) (Either Connectivity ()) Any ()
forall (m :: * -> *) inbound outbound a.
(MonadAsync m, MonadDelay m) =>
NodeId
-> NetworkComponent m (Heartbeat inbound) (Heartbeat outbound) a
-> NetworkComponent m (Either Connectivity inbound) outbound a
withHeartbeat NodeId
nodeId (\NetworkCallback{Heartbeat () -> IOSim s ()
$sel:deliver:NetworkCallback :: forall msg (m :: * -> *). NetworkCallback msg m -> msg -> m ()
deliver :: Heartbeat () -> IOSim s ()
deliver} Network (IOSim s) (Heartbeat Any) -> IOSim s ()
_ -> Heartbeat () -> IOSim s ()
deliver (NodeId -> () -> Heartbeat ()
forall msg. NodeId -> msg -> Heartbeat msg
Data NodeId
otherNodeId ()) IOSim s () -> IOSim s () -> IOSim s ()
forall a b. IOSim s a -> IOSim s b -> IOSim s b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Heartbeat () -> IOSim s ()
deliver (NodeId -> Heartbeat ()
forall msg. NodeId -> Heartbeat msg
Ping NodeId
otherNodeId)) NetworkCallback (Either Connectivity ()) (IOSim s)
callback ((Network (IOSim s) Any -> IOSim s ()) -> IOSim s ())
-> (Network (IOSim s) Any -> IOSim s ()) -> IOSim s ()
forall a b. (a -> b) -> a -> b
$ \Network (IOSim s) Any
_ ->
            DiffTime -> IOSim s ()
forall (m :: * -> *). MonadDelay m => DiffTime -> m ()
threadDelay DiffTime
1

          IOSim s [Connectivity]
getConnectivityEvents

    [Connectivity]
receivedHeartbeats [Connectivity] -> [Connectivity] -> Expectation
forall a. (HasCallStack, Show a, Eq a) => a -> a -> Expectation
`shouldBe` [NodeId -> Connectivity
Connected NodeId
otherNodeId]

  String -> Expectation -> SpecWith (Arg Expectation)
forall a.
(HasCallStack, Example a) =>
String -> a -> SpecWith (Arg a)
it String
"sends Disconnected given no messages has been received from known party within twice heartbeat delay" (Expectation -> SpecWith (Arg Expectation))
-> Expectation -> SpecWith (Arg Expectation)
forall a b. (a -> b) -> a -> b
$ do
    let receivedHeartbeats :: [Connectivity]
receivedHeartbeats = (forall s. IOSim s [Connectivity]) -> [Connectivity]
forall a. (forall s. IOSim s a) -> a
runSimOrThrow ((forall s. IOSim s [Connectivity]) -> [Connectivity])
-> (forall s. IOSim s [Connectivity]) -> [Connectivity]
forall a b. (a -> b) -> a -> b
$ do
          (NetworkCallback (Either Connectivity Any) (IOSim s)
callback, IOSim s [Connectivity]
getConnectivityEvents) <- IOSim
  s
  (NetworkCallback (Either Connectivity Any) (IOSim s),
   IOSim s [Connectivity])
forall (m :: * -> *) a.
MonadSTM m =>
m (NetworkCallback (Either Connectivity a) m, m [Connectivity])
captureConnectivity

          let component :: NetworkCallback (Heartbeat msg) m -> (Network m msg -> m a) -> m ()
component NetworkCallback{Heartbeat msg -> m ()
$sel:deliver:NetworkCallback :: forall msg (m :: * -> *). NetworkCallback msg m -> msg -> m ()
deliver :: Heartbeat msg -> m ()
deliver} Network m msg -> m a
action =
                m a -> m () -> m ()
forall a b. m a -> m b -> m ()
forall (m :: * -> *) a b. MonadAsync m => m a -> m b -> m ()
race_
                  (Network m msg -> m a
action (Network{$sel:broadcast:Network :: msg -> m ()
broadcast = m () -> msg -> m ()
forall a b. a -> b -> a
const (m () -> msg -> m ()) -> m () -> msg -> m ()
forall a b. (a -> b) -> a -> b
$ () -> m ()
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ()}))
                  (Heartbeat msg -> m ()
deliver (NodeId -> Heartbeat msg
forall msg. NodeId -> Heartbeat msg
Ping NodeId
otherNodeId) m () -> m () -> m ()
forall a b. m a -> m b -> m b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> DiffTime -> m ()
forall (m :: * -> *). MonadDelay m => DiffTime -> m ()
threadDelay DiffTime
4 m () -> m () -> m ()
forall a b. m a -> m b -> m b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Heartbeat msg -> m ()
deliver (NodeId -> Heartbeat msg
forall msg. NodeId -> Heartbeat msg
Ping NodeId
otherNodeId) m () -> m () -> m ()
forall a b. m a -> m b -> m b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> DiffTime -> m ()
forall (m :: * -> *). MonadDelay m => DiffTime -> m ()
threadDelay DiffTime
7)

          NodeId
-> NetworkComponent (IOSim s) (Heartbeat Any) (Heartbeat Any) ()
-> NetworkComponent (IOSim s) (Either Connectivity Any) Any ()
forall (m :: * -> *) inbound outbound a.
(MonadAsync m, MonadDelay m) =>
NodeId
-> NetworkComponent m (Heartbeat inbound) (Heartbeat outbound) a
-> NetworkComponent m (Either Connectivity inbound) outbound a
withHeartbeat NodeId
nodeId NetworkComponent (IOSim s) (Heartbeat Any) (Heartbeat Any) ()
forall {m :: * -> *} {m :: * -> *} {msg} {msg} {a}.
(MonadAsync m, MonadDelay m, Applicative m) =>
NetworkCallback (Heartbeat msg) m -> (Network m msg -> m a) -> m ()
component NetworkCallback (Either Connectivity Any) (IOSim s)
callback ((Network (IOSim s) Any -> IOSim s ()) -> IOSim s ())
-> (Network (IOSim s) Any -> IOSim s ()) -> IOSim s ()
forall a b. (a -> b) -> a -> b
$ \Network (IOSim s) Any
_ ->
            DiffTime -> IOSim s ()
forall (m :: * -> *). MonadDelay m => DiffTime -> m ()
threadDelay DiffTime
20

          IOSim s [Connectivity]
getConnectivityEvents

    [Connectivity]
receivedHeartbeats [Connectivity] -> [Connectivity] -> Expectation
forall a. (HasCallStack, Show a, Eq a) => a -> a -> Expectation
`shouldBe` [NodeId -> Connectivity
Disconnected NodeId
otherNodeId, NodeId -> Connectivity
Connected NodeId
otherNodeId]

  String -> Expectation -> SpecWith (Arg Expectation)
forall a.
(HasCallStack, Example a) =>
String -> a -> SpecWith (Arg a)
it String
"stop sending heartbeat message given action sends a message" (Expectation -> SpecWith (Arg Expectation))
-> Expectation -> SpecWith (Arg Expectation)
forall a b. (a -> b) -> a -> b
$ do
    let sentHeartbeats :: [Heartbeat ()]
sentHeartbeats = (forall s. IOSim s [Heartbeat ()]) -> [Heartbeat ()]
forall a. (forall s. IOSim s a) -> a
runSimOrThrow ((forall s. IOSim s [Heartbeat ()]) -> [Heartbeat ()])
-> (forall s. IOSim s [Heartbeat ()]) -> [Heartbeat ()]
forall a b. (a -> b) -> a -> b
$ do
          (NetworkComponent (IOSim s) (Heartbeat ()) (Heartbeat ()) ()
capturingComponent, IOSim s [Heartbeat ()]
getOutgoingMessages) <- IOSim
  s
  (NetworkComponent (IOSim s) (Heartbeat ()) (Heartbeat ()) (),
   IOSim s [Heartbeat ()])
forall (m :: * -> *).
MonadSTM m =>
m (NetworkComponent m (Heartbeat ()) (Heartbeat ()) (),
   m [Heartbeat ()])
captureOutgoing

          NodeId
-> NetworkComponent (IOSim s) (Heartbeat ()) (Heartbeat ()) ()
-> NetworkComponent (IOSim s) (Either Connectivity ()) () ()
forall (m :: * -> *) inbound outbound a.
(MonadAsync m, MonadDelay m) =>
NodeId
-> NetworkComponent m (Heartbeat inbound) (Heartbeat outbound) a
-> NetworkComponent m (Either Connectivity inbound) outbound a
withHeartbeat NodeId
nodeId NetworkComponent (IOSim s) (Heartbeat ()) (Heartbeat ()) ()
capturingComponent NetworkCallback (Either Connectivity ()) (IOSim s)
forall (m :: * -> *) b. Monad m => NetworkCallback b m
noop ((Network (IOSim s) () -> IOSim s ()) -> IOSim s ())
-> (Network (IOSim s) () -> IOSim s ()) -> IOSim s ()
forall a b. (a -> b) -> a -> b
$ \Network{() -> IOSim s ()
$sel:broadcast:Network :: forall (m :: * -> *) msg. Network m msg -> msg -> m ()
broadcast :: () -> IOSim s ()
broadcast} -> do
            DiffTime -> IOSim s ()
forall (m :: * -> *). MonadDelay m => DiffTime -> m ()
threadDelay DiffTime
0.6
            () -> IOSim s ()
broadcast ()
            DiffTime -> IOSim s ()
forall (m :: * -> *). MonadDelay m => DiffTime -> m ()
threadDelay DiffTime
1

          IOSim s [Heartbeat ()]
getOutgoingMessages

    [Heartbeat ()]
sentHeartbeats [Heartbeat ()] -> [Heartbeat ()] -> Expectation
forall a. (HasCallStack, Show a, Eq a) => a -> a -> Expectation
`shouldBe` [NodeId -> () -> Heartbeat ()
forall msg. NodeId -> msg -> Heartbeat msg
Data NodeId
nodeId (), NodeId -> Heartbeat ()
forall msg. NodeId -> Heartbeat msg
Ping NodeId
nodeId]

  String -> Expectation -> SpecWith (Arg Expectation)
forall a.
(HasCallStack, Example a) =>
String -> a -> SpecWith (Arg a)
it String
"restart sending heartbeat messages given last message sent is older than heartbeat delay" (Expectation -> SpecWith (Arg Expectation))
-> Expectation -> SpecWith (Arg Expectation)
forall a b. (a -> b) -> a -> b
$ do
    let sentHeartbeats :: [Heartbeat ()]
sentHeartbeats = (forall s. IOSim s [Heartbeat ()]) -> [Heartbeat ()]
forall a. (forall s. IOSim s a) -> a
runSimOrThrow ((forall s. IOSim s [Heartbeat ()]) -> [Heartbeat ()])
-> (forall s. IOSim s [Heartbeat ()]) -> [Heartbeat ()]
forall a b. (a -> b) -> a -> b
$ do
          (NetworkComponent (IOSim s) (Heartbeat ()) (Heartbeat ()) ()
capturingComponent, IOSim s [Heartbeat ()]
getOutgoingMessages) <- IOSim
  s
  (NetworkComponent (IOSim s) (Heartbeat ()) (Heartbeat ()) (),
   IOSim s [Heartbeat ()])
forall (m :: * -> *).
MonadSTM m =>
m (NetworkComponent m (Heartbeat ()) (Heartbeat ()) (),
   m [Heartbeat ()])
captureOutgoing

          NodeId
-> NetworkComponent (IOSim s) (Heartbeat ()) (Heartbeat ()) ()
-> NetworkComponent (IOSim s) (Either Connectivity ()) () ()
forall (m :: * -> *) inbound outbound a.
(MonadAsync m, MonadDelay m) =>
NodeId
-> NetworkComponent m (Heartbeat inbound) (Heartbeat outbound) a
-> NetworkComponent m (Either Connectivity inbound) outbound a
withHeartbeat NodeId
nodeId NetworkComponent (IOSim s) (Heartbeat ()) (Heartbeat ()) ()
capturingComponent NetworkCallback (Either Connectivity ()) (IOSim s)
forall (m :: * -> *) b. Monad m => NetworkCallback b m
noop ((Network (IOSim s) () -> IOSim s ()) -> IOSim s ())
-> (Network (IOSim s) () -> IOSim s ()) -> IOSim s ()
forall a b. (a -> b) -> a -> b
$ \Network{() -> IOSim s ()
$sel:broadcast:Network :: forall (m :: * -> *) msg. Network m msg -> msg -> m ()
broadcast :: () -> IOSim s ()
broadcast} -> do
            DiffTime -> IOSim s ()
forall (m :: * -> *). MonadDelay m => DiffTime -> m ()
threadDelay DiffTime
0.6
            () -> IOSim s ()
broadcast ()
            DiffTime -> IOSim s ()
forall (m :: * -> *). MonadDelay m => DiffTime -> m ()
threadDelay DiffTime
3.6

          IOSim s [Heartbeat ()]
getOutgoingMessages

    [Heartbeat ()]
sentHeartbeats [Heartbeat ()] -> [Heartbeat ()] -> Expectation
forall a. (HasCallStack, Show a, Eq a) => a -> a -> Expectation
`shouldBe` [NodeId -> Heartbeat ()
forall msg. NodeId -> Heartbeat msg
Ping NodeId
nodeId, NodeId -> () -> Heartbeat ()
forall msg. NodeId -> msg -> Heartbeat msg
Data NodeId
nodeId (), NodeId -> Heartbeat ()
forall msg. NodeId -> Heartbeat msg
Ping NodeId
nodeId]

noop :: Monad m => NetworkCallback b m
noop :: forall (m :: * -> *) b. Monad m => NetworkCallback b m
noop = NetworkCallback{$sel:deliver:NetworkCallback :: b -> m ()
deliver = m () -> b -> m ()
forall a b. a -> b -> a
const (m () -> b -> m ()) -> m () -> b -> m ()
forall a b. (a -> b) -> a -> b
$ () -> m ()
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ()}

captureOutgoing :: MonadSTM m => m (NetworkComponent m (Heartbeat ()) (Heartbeat ()) (), m [Heartbeat ()])
captureOutgoing :: forall (m :: * -> *).
MonadSTM m =>
m (NetworkComponent m (Heartbeat ()) (Heartbeat ()) (),
   m [Heartbeat ()])
captureOutgoing = do
  TVar m [Heartbeat ()]
tv <- [Heartbeat ()] -> m (TVar m [Heartbeat ()])
forall a. a -> m (TVar m a)
forall (m :: * -> *) a. MonadSTM m => a -> m (TVar m a)
newTVarIO []
  (NetworkComponent m (Heartbeat ()) (Heartbeat ()) (),
 m [Heartbeat ()])
-> m (NetworkComponent m (Heartbeat ()) (Heartbeat ()) (),
      m [Heartbeat ()])
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (\NetworkCallback (Heartbeat ()) m
_ Network m (Heartbeat ()) -> m ()
action -> Network m (Heartbeat ()) -> m ()
action Network{$sel:broadcast:Network :: Heartbeat () -> m ()
broadcast = TVar m [Heartbeat ()] -> Heartbeat () -> m ()
forall {m :: * -> *} {a}. MonadSTM m => TVar m [a] -> a -> m ()
broadcast TVar m [Heartbeat ()]
tv}, TVar m [Heartbeat ()] -> m [Heartbeat ()]
forall a. TVar m a -> m a
forall (m :: * -> *) a. MonadSTM m => TVar m a -> m a
readTVarIO TVar m [Heartbeat ()]
tv)
 where
  broadcast :: TVar m [a] -> a -> m ()
broadcast TVar m [a]
tv a
msg =
    STM m () -> m ()
forall a. HasCallStack => STM m a -> m a
forall (m :: * -> *) a.
(MonadSTM m, HasCallStack) =>
STM m a -> m a
atomically (STM m () -> m ()) -> STM m () -> m ()
forall a b. (a -> b) -> a -> b
$ TVar m [a] -> ([a] -> [a]) -> STM m ()
forall a. TVar m a -> (a -> a) -> STM m ()
forall (m :: * -> *) a.
MonadSTM m =>
TVar m a -> (a -> a) -> STM m ()
modifyTVar' TVar m [a]
tv (a
msg :)

captureConnectivity :: MonadSTM m => m (NetworkCallback (Either Connectivity a) m, m [Connectivity])
captureConnectivity :: forall (m :: * -> *) a.
MonadSTM m =>
m (NetworkCallback (Either Connectivity a) m, m [Connectivity])
captureConnectivity = do
  TVar m [Connectivity]
tv <- [Connectivity] -> m (TVar m [Connectivity])
forall a. a -> m (TVar m a)
forall (m :: * -> *) a. MonadSTM m => a -> m (TVar m a)
newTVarIO []
  (NetworkCallback (Either Connectivity a) m, m [Connectivity])
-> m (NetworkCallback (Either Connectivity a) m, m [Connectivity])
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (NetworkCallback{$sel:deliver:NetworkCallback :: Either Connectivity a -> m ()
deliver = TVar m [Connectivity] -> Either Connectivity a -> m ()
forall {m :: * -> *} {a} {b}.
MonadSTM m =>
TVar m [a] -> Either a b -> m ()
record TVar m [Connectivity]
tv}, TVar m [Connectivity] -> m [Connectivity]
forall a. TVar m a -> m a
forall (m :: * -> *) a. MonadSTM m => TVar m a -> m a
readTVarIO TVar m [Connectivity]
tv)
 where
  record :: TVar m [a] -> Either a b -> m ()
record TVar m [a]
tv = \case
    Left a
c -> STM m () -> m ()
forall a. HasCallStack => STM m a -> m a
forall (m :: * -> *) a.
(MonadSTM m, HasCallStack) =>
STM m a -> m a
atomically (STM m () -> m ()) -> STM m () -> m ()
forall a b. (a -> b) -> a -> b
$ TVar m [a] -> ([a] -> [a]) -> STM m ()
forall a. TVar m a -> (a -> a) -> STM m ()
forall (m :: * -> *) a.
MonadSTM m =>
TVar m a -> (a -> a) -> STM m ()
modifyTVar' TVar m [a]
tv (a
c :)
    Right b
_ -> () -> m ()
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ()