{-# LANGUAGE OverloadedRecordDot #-}

-- | Test the real networking layer
module Hydra.NetworkSpec where

import Hydra.Prelude
import Test.Hydra.Prelude

import Codec.CBOR.Read (deserialiseFromBytes)
import Codec.CBOR.Write (toLazyByteString)
import Control.Concurrent.Class.MonadSTM (
  newTQueue,
  readTQueue,
  writeTQueue,
 )
import Hydra.Ledger.Simple (SimpleTx (..))
import Hydra.Logging (showLogsOnFailure)
import Hydra.Network (
  Connectivity (..),
  Host (..),
  Network (..),
  NetworkCallback (..),
  ProtocolVersion (..),
 )
import Hydra.Network.Etcd (withEtcdNetwork)
import Hydra.Network.Message (Message (..))
import Hydra.Node.Network (NetworkConfiguration (..))
import System.Directory (removeFile)
import System.FilePath ((</>))
import Test.Aeson.GenericSpecs (roundtripAndGoldenSpecs)
import Test.Hydra.Node.Fixture (alice, aliceSk, bob, bobSk, carol, carolSk)
import Test.Network.Ports (randomUnusedTCPPorts, withFreePort)
import Test.QuickCheck (Property, (===))
import Test.QuickCheck.Instances.ByteString ()
import Test.Util (noopCallback, waitEq)

spec :: Spec
spec :: Spec
spec = do
  -- TODO: add tests about advertise being honored
  String -> Spec -> Spec
forall a. HasCallStack => String -> SpecWith a -> SpecWith a
describe String
"Etcd" (Spec -> Spec) -> Spec -> Spec
forall a b. (a -> b) -> a -> b
$
    ((Tracer IO EtcdLog -> IO ()) -> IO ())
-> SpecWith (Tracer IO EtcdLog) -> Spec
forall a. (ActionWith a -> IO ()) -> SpecWith a -> Spec
around (Text -> (Tracer IO EtcdLog -> IO ()) -> IO ()
forall (m :: * -> *) msg a.
(MonadSTM m, MonadCatch m, MonadFork m, MonadTime m, MonadSay m,
 ToJSON msg) =>
Text -> (Tracer m msg -> m a) -> m a
showLogsOnFailure Text
"NetworkSpec") (SpecWith (Tracer IO EtcdLog) -> Spec)
-> SpecWith (Tracer IO EtcdLog) -> Spec
forall a b. (a -> b) -> a -> b
$ do
      let v1 :: ProtocolVersion
v1 = Natural -> ProtocolVersion
ProtocolVersion Natural
1

      String
-> (Tracer IO EtcdLog -> IO ())
-> SpecWith (Arg (Tracer IO EtcdLog -> IO ()))
forall a.
(HasCallStack, Example a) =>
String -> a -> SpecWith (Arg a)
it String
"broadcasts to self" ((Tracer IO EtcdLog -> IO ())
 -> SpecWith (Arg (Tracer IO EtcdLog -> IO ())))
-> (Tracer IO EtcdLog -> IO ())
-> SpecWith (Arg (Tracer IO EtcdLog -> IO ()))
forall a b. (a -> b) -> a -> b
$ \Tracer IO EtcdLog
tracer -> do
        NominalDiffTime -> IO () -> IO ()
forall (m :: * -> *) a.
(HasCallStack, MonadTimer m, MonadThrow m) =>
NominalDiffTime -> m a -> m a
failAfter NominalDiffTime
5 (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$
          String -> (String -> IO ()) -> IO ()
forall (m :: * -> *) r.
MonadIO m =>
String -> (String -> m r) -> m r
withTempDir String
"test-etcd" ((String -> IO ()) -> IO ()) -> (String -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \String
tmp -> do
            (PortNumber -> IO ()) -> IO ()
forall a. (PortNumber -> IO a) -> IO a
withFreePort ((PortNumber -> IO ()) -> IO ()) -> (PortNumber -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \PortNumber
port -> do
              let config :: NetworkConfiguration
config =
                    NetworkConfiguration
                      { $sel:listen:NetworkConfiguration :: Host
listen = Text -> PortNumber -> Host
Host Text
forall s. IsString s => s
lo PortNumber
port
                      , $sel:advertise:NetworkConfiguration :: Host
advertise = Text -> PortNumber -> Host
Host Text
forall s. IsString s => s
lo PortNumber
port
                      , $sel:signingKey:NetworkConfiguration :: SigningKey HydraKey
signingKey = SigningKey HydraKey
aliceSk
                      , $sel:otherParties:NetworkConfiguration :: [Party]
otherParties = []
                      , $sel:peers:NetworkConfiguration :: [Host]
peers = []
                      , $sel:nodeId:NetworkConfiguration :: NodeId
nodeId = NodeId
"alice"
                      , $sel:persistenceDir:NetworkConfiguration :: String
persistenceDir = String
tmp String -> String -> String
</> String
"alice"
                      }
              (NetworkCallback Text IO
recordingCallback, IO Text
waitNext, IO Connectivity
_) <- IO (NetworkCallback Text IO, IO Text, IO Connectivity)
forall (m :: * -> *) msg.
MonadSTM m =>
m (NetworkCallback msg m, m msg, m Connectivity)
newRecordingCallback
              Tracer IO EtcdLog
-> ProtocolVersion
-> NetworkConfiguration
-> NetworkComponent IO Text Text ()
forall msg.
(ToCBOR msg, FromCBOR msg, Eq msg) =>
Tracer IO EtcdLog
-> ProtocolVersion
-> NetworkConfiguration
-> NetworkComponent IO msg msg ()
withEtcdNetwork Tracer IO EtcdLog
tracer ProtocolVersion
v1 NetworkConfiguration
config NetworkCallback Text IO
recordingCallback ((Network IO Text -> IO ()) -> IO ())
-> (Network IO Text -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \Network IO Text
n -> do
                Network IO Text -> Text -> IO ()
forall (m :: * -> *) msg. Network m msg -> msg -> m ()
broadcast Network IO Text
n (Text
"asdf" :: Text)
                IO Text
waitNext IO Text -> Text -> IO ()
forall a. (HasCallStack, Show a, Eq a) => IO a -> a -> IO ()
`shouldReturn` Text
"asdf"

      String
-> (Tracer IO EtcdLog -> IO ())
-> SpecWith (Arg (Tracer IO EtcdLog -> IO ()))
forall a.
(HasCallStack, Example a) =>
String -> a -> SpecWith (Arg a)
it String
"broadcasts messages to single connected peer" ((Tracer IO EtcdLog -> IO ())
 -> SpecWith (Arg (Tracer IO EtcdLog -> IO ())))
-> (Tracer IO EtcdLog -> IO ())
-> SpecWith (Arg (Tracer IO EtcdLog -> IO ()))
forall a b. (a -> b) -> a -> b
$ \Tracer IO EtcdLog
tracer -> do
        String -> (String -> IO ()) -> IO ()
forall (m :: * -> *) r.
MonadIO m =>
String -> (String -> m r) -> m r
withTempDir String
"test-etcd" ((String -> IO ()) -> IO ()) -> (String -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \String
tmp -> do
          NominalDiffTime -> IO () -> IO ()
forall (m :: * -> *) a.
(HasCallStack, MonadTimer m, MonadThrow m) =>
NominalDiffTime -> m a -> m a
failAfter NominalDiffTime
5 (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$ do
            PeerConfig2{NetworkConfiguration
aliceConfig :: NetworkConfiguration
$sel:aliceConfig:PeerConfig2 :: PeerConfig2 -> NetworkConfiguration
aliceConfig, NetworkConfiguration
bobConfig :: NetworkConfiguration
$sel:bobConfig:PeerConfig2 :: PeerConfig2 -> NetworkConfiguration
bobConfig} <- String -> IO PeerConfig2
setup2Peers String
tmp
            forall msg.
(ToCBOR msg, FromCBOR msg, Eq msg) =>
Tracer IO EtcdLog
-> ProtocolVersion
-> NetworkConfiguration
-> NetworkComponent IO msg msg ()
withEtcdNetwork @Int Tracer IO EtcdLog
tracer ProtocolVersion
v1 NetworkConfiguration
aliceConfig NetworkCallback Int IO
forall (m :: * -> *) msg. Applicative m => NetworkCallback msg m
noopCallback ((Network IO Int -> IO ()) -> IO ())
-> (Network IO Int -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \Network IO Int
n1 -> do
              (NetworkCallback Int IO
recordReceived, IO Int
waitNext, IO Connectivity
_) <- IO (NetworkCallback Int IO, IO Int, IO Connectivity)
forall (m :: * -> *) msg.
MonadSTM m =>
m (NetworkCallback msg m, m msg, m Connectivity)
newRecordingCallback
              forall msg.
(ToCBOR msg, FromCBOR msg, Eq msg) =>
Tracer IO EtcdLog
-> ProtocolVersion
-> NetworkConfiguration
-> NetworkComponent IO msg msg ()
withEtcdNetwork @Int Tracer IO EtcdLog
tracer ProtocolVersion
v1 NetworkConfiguration
bobConfig NetworkCallback Int IO
recordReceived ((Network IO Int -> IO ()) -> IO ())
-> (Network IO Int -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \Network IO Int
_n2 -> do
                Network IO Int -> Int -> IO ()
forall (m :: * -> *) msg. Network m msg -> msg -> m ()
broadcast Network IO Int
n1 Int
123
                IO Int
waitNext IO Int -> Int -> IO ()
forall a. (HasCallStack, Show a, Eq a) => IO a -> a -> IO ()
`shouldReturn` Int
123

      String
-> (Tracer IO EtcdLog -> IO ())
-> SpecWith (Arg (Tracer IO EtcdLog -> IO ()))
forall a.
(HasCallStack, Example a) =>
String -> a -> SpecWith (Arg a)
it String
"handles broadcast to minority" ((Tracer IO EtcdLog -> IO ())
 -> SpecWith (Arg (Tracer IO EtcdLog -> IO ())))
-> (Tracer IO EtcdLog -> IO ())
-> SpecWith (Arg (Tracer IO EtcdLog -> IO ()))
forall a b. (a -> b) -> a -> b
$ \Tracer IO EtcdLog
tracer -> do
        String -> (String -> IO ()) -> IO ()
forall (m :: * -> *) r.
MonadIO m =>
String -> (String -> m r) -> m r
withTempDir String
"test-etcd" ((String -> IO ()) -> IO ()) -> (String -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \String
tmp -> do
          NominalDiffTime -> IO () -> IO ()
forall (m :: * -> *) a.
(HasCallStack, MonadTimer m, MonadThrow m) =>
NominalDiffTime -> m a -> m a
failAfter NominalDiffTime
20 (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$ do
            PeerConfig3{NetworkConfiguration
aliceConfig :: NetworkConfiguration
$sel:aliceConfig:PeerConfig3 :: PeerConfig3 -> NetworkConfiguration
aliceConfig, NetworkConfiguration
bobConfig :: NetworkConfiguration
$sel:bobConfig:PeerConfig3 :: PeerConfig3 -> NetworkConfiguration
bobConfig, NetworkConfiguration
carolConfig :: NetworkConfiguration
$sel:carolConfig:PeerConfig3 :: PeerConfig3 -> NetworkConfiguration
carolConfig} <- String -> IO PeerConfig3
setup3Peers String
tmp
            (NetworkCallback Int IO
recordReceived, IO Int
waitNext, IO Connectivity
_) <- IO (NetworkCallback Int IO, IO Int, IO Connectivity)
forall (m :: * -> *) msg.
MonadSTM m =>
m (NetworkCallback msg m, m msg, m Connectivity)
newRecordingCallback
            forall msg.
(ToCBOR msg, FromCBOR msg, Eq msg) =>
Tracer IO EtcdLog
-> ProtocolVersion
-> NetworkConfiguration
-> NetworkComponent IO msg msg ()
withEtcdNetwork @Int Tracer IO EtcdLog
tracer ProtocolVersion
v1 NetworkConfiguration
aliceConfig NetworkCallback Int IO
recordReceived ((Network IO Int -> IO ()) -> IO ())
-> (Network IO Int -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \Network IO Int
n1 -> do
              -- Bob and carol start and stop
              forall msg.
(ToCBOR msg, FromCBOR msg, Eq msg) =>
Tracer IO EtcdLog
-> ProtocolVersion
-> NetworkConfiguration
-> NetworkComponent IO msg msg ()
withEtcdNetwork @Int Tracer IO EtcdLog
tracer ProtocolVersion
v1 NetworkConfiguration
bobConfig NetworkCallback Int IO
forall (m :: * -> *) msg. Applicative m => NetworkCallback msg m
noopCallback ((Network IO Int -> IO ()) -> IO ())
-> (Network IO Int -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \Network IO Int
_ -> do
                forall msg.
(ToCBOR msg, FromCBOR msg, Eq msg) =>
Tracer IO EtcdLog
-> ProtocolVersion
-> NetworkConfiguration
-> NetworkComponent IO msg msg ()
withEtcdNetwork @Int Tracer IO EtcdLog
tracer ProtocolVersion
v1 NetworkConfiguration
carolConfig NetworkCallback Int IO
forall (m :: * -> *) msg. Applicative m => NetworkCallback msg m
noopCallback ((Network IO Int -> IO ()) -> IO ())
-> (Network IO Int -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \Network IO Int
_ -> do
                  () -> IO ()
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ()
              -- Alice sends a message while she is the only one online (= minority)
              Network IO Int -> Int -> IO ()
forall (m :: * -> *) msg. Network m msg -> msg -> m ()
broadcast Network IO Int
n1 Int
123
            -- Now, alice stops too!
            -- Start alice, bob and carol again
            forall msg.
(ToCBOR msg, FromCBOR msg, Eq msg) =>
Tracer IO EtcdLog
-> ProtocolVersion
-> NetworkConfiguration
-> NetworkComponent IO msg msg ()
withEtcdNetwork @Int Tracer IO EtcdLog
tracer ProtocolVersion
v1 NetworkConfiguration
aliceConfig NetworkCallback Int IO
recordReceived ((Network IO Int -> IO ()) -> IO ())
-> (Network IO Int -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \Network IO Int
_ -> do
              forall msg.
(ToCBOR msg, FromCBOR msg, Eq msg) =>
Tracer IO EtcdLog
-> ProtocolVersion
-> NetworkConfiguration
-> NetworkComponent IO msg msg ()
withEtcdNetwork @Int Tracer IO EtcdLog
tracer ProtocolVersion
v1 NetworkConfiguration
bobConfig NetworkCallback Int IO
forall (m :: * -> *) msg. Applicative m => NetworkCallback msg m
noopCallback ((Network IO Int -> IO ()) -> IO ())
-> (Network IO Int -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \Network IO Int
_ -> do
                forall msg.
(ToCBOR msg, FromCBOR msg, Eq msg) =>
Tracer IO EtcdLog
-> ProtocolVersion
-> NetworkConfiguration
-> NetworkComponent IO msg msg ()
withEtcdNetwork @Int Tracer IO EtcdLog
tracer ProtocolVersion
v1 NetworkConfiguration
carolConfig NetworkCallback Int IO
forall (m :: * -> *) msg. Applicative m => NetworkCallback msg m
noopCallback ((Network IO Int -> IO ()) -> IO ())
-> (Network IO Int -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \Network IO Int
_ -> do
                  -- Alice should see her own message eventually (when part of majority again)
                  IO Int
waitNext IO Int -> Int -> IO ()
forall a. (HasCallStack, Show a, Eq a) => IO a -> a -> IO ()
`shouldReturn` Int
123

      String
-> (Tracer IO EtcdLog -> IO ())
-> SpecWith (Arg (Tracer IO EtcdLog -> IO ()))
forall a.
(HasCallStack, Example a) =>
String -> a -> SpecWith (Arg a)
it String
"handles broadcast to majority" ((Tracer IO EtcdLog -> IO ())
 -> SpecWith (Arg (Tracer IO EtcdLog -> IO ())))
-> (Tracer IO EtcdLog -> IO ())
-> SpecWith (Arg (Tracer IO EtcdLog -> IO ()))
forall a b. (a -> b) -> a -> b
$ \Tracer IO EtcdLog
tracer -> do
        String -> (String -> IO ()) -> IO ()
forall (m :: * -> *) r.
MonadIO m =>
String -> (String -> m r) -> m r
withTempDir String
"test-etcd" ((String -> IO ()) -> IO ()) -> (String -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \String
tmp -> do
          NominalDiffTime -> IO () -> IO ()
forall (m :: * -> *) a.
(HasCallStack, MonadTimer m, MonadThrow m) =>
NominalDiffTime -> m a -> m a
failAfter NominalDiffTime
20 (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$ do
            PeerConfig3{NetworkConfiguration
$sel:aliceConfig:PeerConfig3 :: PeerConfig3 -> NetworkConfiguration
aliceConfig :: NetworkConfiguration
aliceConfig, NetworkConfiguration
$sel:bobConfig:PeerConfig3 :: PeerConfig3 -> NetworkConfiguration
bobConfig :: NetworkConfiguration
bobConfig, NetworkConfiguration
$sel:carolConfig:PeerConfig3 :: PeerConfig3 -> NetworkConfiguration
carolConfig :: NetworkConfiguration
carolConfig} <- String -> IO PeerConfig3
setup3Peers String
tmp
            (NetworkCallback Int IO
recordReceived, IO Int
waitNext, IO Connectivity
_) <- IO (NetworkCallback Int IO, IO Int, IO Connectivity)
forall (m :: * -> *) msg.
MonadSTM m =>
m (NetworkCallback msg m, m msg, m Connectivity)
newRecordingCallback
            forall msg.
(ToCBOR msg, FromCBOR msg, Eq msg) =>
Tracer IO EtcdLog
-> ProtocolVersion
-> NetworkConfiguration
-> NetworkComponent IO msg msg ()
withEtcdNetwork @Int Tracer IO EtcdLog
tracer ProtocolVersion
v1 NetworkConfiguration
aliceConfig NetworkCallback Int IO
forall (m :: * -> *) msg. Applicative m => NetworkCallback msg m
noopCallback ((Network IO Int -> IO ()) -> IO ())
-> (Network IO Int -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \Network IO Int
n1 ->
              forall msg.
(ToCBOR msg, FromCBOR msg, Eq msg) =>
Tracer IO EtcdLog
-> ProtocolVersion
-> NetworkConfiguration
-> NetworkComponent IO msg msg ()
withEtcdNetwork @Int Tracer IO EtcdLog
tracer ProtocolVersion
v1 NetworkConfiguration
bobConfig NetworkCallback Int IO
forall (m :: * -> *) msg. Applicative m => NetworkCallback msg m
noopCallback ((Network IO Int -> IO ()) -> IO ())
-> (Network IO Int -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \Network IO Int
_ -> do
                forall msg.
(ToCBOR msg, FromCBOR msg, Eq msg) =>
Tracer IO EtcdLog
-> ProtocolVersion
-> NetworkConfiguration
-> NetworkComponent IO msg msg ()
withEtcdNetwork @Int Tracer IO EtcdLog
tracer ProtocolVersion
v1 NetworkConfiguration
carolConfig NetworkCallback Int IO
recordReceived ((Network IO Int -> IO ()) -> IO ())
-> (Network IO Int -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \Network IO Int
_ -> do
                  -- Alice sends a message while Carol is online
                  Network IO Int -> Int -> IO ()
forall (m :: * -> *) msg. Network m msg -> msg -> m ()
broadcast Network IO Int
n1 Int
123
                  IO Int
waitNext IO Int -> Int -> IO ()
forall a. (HasCallStack, Show a, Eq a) => IO a -> a -> IO ()
`shouldReturn` Int
123
                -- Alice sends a message while Carol is offline
                Network IO Int -> Int -> IO ()
forall (m :: * -> *) msg. Network m msg -> msg -> m ()
broadcast Network IO Int
n1 Int
456
                -- Carol starts again
                forall msg.
(ToCBOR msg, FromCBOR msg, Eq msg) =>
Tracer IO EtcdLog
-> ProtocolVersion
-> NetworkConfiguration
-> NetworkComponent IO msg msg ()
withEtcdNetwork @Int Tracer IO EtcdLog
tracer ProtocolVersion
v1 NetworkConfiguration
carolConfig NetworkCallback Int IO
recordReceived ((Network IO Int -> IO ()) -> IO ())
-> (Network IO Int -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \Network IO Int
_ -> do
                  -- Carol should receive messages sent by alice while offline
                  -- (without duplication of 123)
                  IO Int
waitNext IO Int -> Int -> IO ()
forall a. (HasCallStack, Show a, Eq a) => IO a -> a -> IO ()
`shouldReturn` Int
456

      String
-> (Tracer IO EtcdLog -> IO ())
-> SpecWith (Arg (Tracer IO EtcdLog -> IO ()))
forall a.
(HasCallStack, Example a) =>
String -> a -> SpecWith (Arg a)
it String
"emits connectivity events" ((Tracer IO EtcdLog -> IO ())
 -> SpecWith (Arg (Tracer IO EtcdLog -> IO ())))
-> (Tracer IO EtcdLog -> IO ())
-> SpecWith (Arg (Tracer IO EtcdLog -> IO ()))
forall a b. (a -> b) -> a -> b
$ \Tracer IO EtcdLog
tracer -> do
        String -> (String -> IO ()) -> IO ()
forall (m :: * -> *) r.
MonadIO m =>
String -> (String -> m r) -> m r
withTempDir String
"test-etcd" ((String -> IO ()) -> IO ()) -> (String -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \String
tmp -> do
          NominalDiffTime -> IO () -> IO ()
forall (m :: * -> *) a.
(HasCallStack, MonadTimer m, MonadThrow m) =>
NominalDiffTime -> m a -> m a
failAfter NominalDiffTime
20 (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$ do
            PeerConfig3{NetworkConfiguration
$sel:aliceConfig:PeerConfig3 :: PeerConfig3 -> NetworkConfiguration
aliceConfig :: NetworkConfiguration
aliceConfig, NetworkConfiguration
$sel:bobConfig:PeerConfig3 :: PeerConfig3 -> NetworkConfiguration
bobConfig :: NetworkConfiguration
bobConfig, NetworkConfiguration
$sel:carolConfig:PeerConfig3 :: PeerConfig3 -> NetworkConfiguration
carolConfig :: NetworkConfiguration
carolConfig} <- String -> IO PeerConfig3
setup3Peers String
tmp
            -- Record and assert connectivity events from alice's perspective
            (NetworkCallback Int IO
recordReceived, IO Int
_, IO Connectivity
waitConnectivity) <- IO (NetworkCallback Int IO, IO Int, IO Connectivity)
forall (m :: * -> *) msg.
MonadSTM m =>
m (NetworkCallback msg m, m msg, m Connectivity)
newRecordingCallback
            let
              waitFor :: HasCallStack => Connectivity -> IO ()
              waitFor :: HasCallStack => Connectivity -> IO ()
waitFor = IO Connectivity -> NominalDiffTime -> Connectivity -> IO ()
forall a.
(HasCallStack, Eq a, Show a) =>
IO a -> NominalDiffTime -> a -> IO ()
waitEq IO Connectivity
waitConnectivity NominalDiffTime
10
            forall msg.
(ToCBOR msg, FromCBOR msg, Eq msg) =>
Tracer IO EtcdLog
-> ProtocolVersion
-> NetworkConfiguration
-> NetworkComponent IO msg msg ()
withEtcdNetwork @Int Tracer IO EtcdLog
tracer ProtocolVersion
v1 NetworkConfiguration
aliceConfig NetworkCallback Int IO
recordReceived ((Network IO Int -> IO ()) -> IO ())
-> (Network IO Int -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \Network IO Int
_ -> do
              forall msg.
(ToCBOR msg, FromCBOR msg, Eq msg) =>
Tracer IO EtcdLog
-> ProtocolVersion
-> NetworkConfiguration
-> NetworkComponent IO msg msg ()
withEtcdNetwork @Int Tracer IO EtcdLog
tracer ProtocolVersion
v1 NetworkConfiguration
bobConfig NetworkCallback Int IO
forall (m :: * -> *) msg. Applicative m => NetworkCallback msg m
noopCallback ((Network IO Int -> IO ()) -> IO ())
-> (Network IO Int -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \Network IO Int
_ -> do
                -- Alice now on majority cluster
                HasCallStack => Connectivity -> IO ()
Connectivity -> IO ()
waitFor Connectivity
NetworkConnected
                HasCallStack => Connectivity -> IO ()
Connectivity -> IO ()
waitFor (Connectivity -> IO ()) -> Connectivity -> IO ()
forall a b. (a -> b) -> a -> b
$ Host -> Connectivity
PeerConnected NetworkConfiguration
bobConfig.advertise
                forall msg.
(ToCBOR msg, FromCBOR msg, Eq msg) =>
Tracer IO EtcdLog
-> ProtocolVersion
-> NetworkConfiguration
-> NetworkComponent IO msg msg ()
withEtcdNetwork @Int Tracer IO EtcdLog
tracer ProtocolVersion
v1 NetworkConfiguration
carolConfig NetworkCallback Int IO
forall (m :: * -> *) msg. Applicative m => NetworkCallback msg m
noopCallback ((Network IO Int -> IO ()) -> IO ())
-> (Network IO Int -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \Network IO Int
_ -> do
                  HasCallStack => Connectivity -> IO ()
Connectivity -> IO ()
waitFor (Connectivity -> IO ()) -> Connectivity -> IO ()
forall a b. (a -> b) -> a -> b
$ Host -> Connectivity
PeerConnected NetworkConfiguration
carolConfig.advertise
                  -- Carol stops
                  () -> IO ()
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ()
                HasCallStack => Connectivity -> IO ()
Connectivity -> IO ()
waitFor (Connectivity -> IO ()) -> Connectivity -> IO ()
forall a b. (a -> b) -> a -> b
$ Host -> Connectivity
PeerDisconnected NetworkConfiguration
carolConfig.advertise
                -- Bob stops
                () -> IO ()
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ()
              -- We are now in minority
              HasCallStack => Connectivity -> IO ()
Connectivity -> IO ()
waitFor Connectivity
NetworkDisconnected
              -- Carol starts again and we reach a majority
              forall msg.
(ToCBOR msg, FromCBOR msg, Eq msg) =>
Tracer IO EtcdLog
-> ProtocolVersion
-> NetworkConfiguration
-> NetworkComponent IO msg msg ()
withEtcdNetwork @Int Tracer IO EtcdLog
tracer ProtocolVersion
v1 NetworkConfiguration
carolConfig NetworkCallback Int IO
forall (m :: * -> *) msg. Applicative m => NetworkCallback msg m
noopCallback ((Network IO Int -> IO ()) -> IO ())
-> (Network IO Int -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \Network IO Int
_ -> do
                HasCallStack => Connectivity -> IO ()
Connectivity -> IO ()
waitFor Connectivity
NetworkConnected
                HasCallStack => Connectivity -> IO ()
Connectivity -> IO ()
waitFor (Connectivity -> IO ()) -> Connectivity -> IO ()
forall a b. (a -> b) -> a -> b
$ Host -> Connectivity
PeerConnected NetworkConfiguration
carolConfig.advertise

      String
-> (Tracer IO EtcdLog -> IO ())
-> SpecWith (Arg (Tracer IO EtcdLog -> IO ()))
forall a.
(HasCallStack, Example a) =>
String -> a -> SpecWith (Arg a)
it String
"checks protocol version" ((Tracer IO EtcdLog -> IO ())
 -> SpecWith (Arg (Tracer IO EtcdLog -> IO ())))
-> (Tracer IO EtcdLog -> IO ())
-> SpecWith (Arg (Tracer IO EtcdLog -> IO ()))
forall a b. (a -> b) -> a -> b
$ \Tracer IO EtcdLog
tracer -> do
        String -> (String -> IO ()) -> IO ()
forall (m :: * -> *) r.
MonadIO m =>
String -> (String -> m r) -> m r
withTempDir String
"test-etcd" ((String -> IO ()) -> IO ()) -> (String -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \String
tmp -> do
          NominalDiffTime -> IO () -> IO ()
forall (m :: * -> *) a.
(HasCallStack, MonadTimer m, MonadThrow m) =>
NominalDiffTime -> m a -> m a
failAfter NominalDiffTime
10 (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$ do
            PeerConfig2{NetworkConfiguration
$sel:aliceConfig:PeerConfig2 :: PeerConfig2 -> NetworkConfiguration
aliceConfig :: NetworkConfiguration
aliceConfig, NetworkConfiguration
$sel:bobConfig:PeerConfig2 :: PeerConfig2 -> NetworkConfiguration
bobConfig :: NetworkConfiguration
bobConfig} <- String -> IO PeerConfig2
setup2Peers String
tmp
            let v2 :: ProtocolVersion
v2 = Natural -> ProtocolVersion
ProtocolVersion Natural
2
            (NetworkCallback Int IO
recordAlice, IO Int
_, IO Connectivity
waitAlice) <- IO (NetworkCallback Int IO, IO Int, IO Connectivity)
forall (m :: * -> *) msg.
MonadSTM m =>
m (NetworkCallback msg m, m msg, m Connectivity)
newRecordingCallback
            (NetworkCallback Int IO
recordBob, IO Int
_, IO Connectivity
waitBob) <- IO (NetworkCallback Int IO, IO Int, IO Connectivity)
forall (m :: * -> *) msg.
MonadSTM m =>
m (NetworkCallback msg m, m msg, m Connectivity)
newRecordingCallback
            let aliceSees :: Connectivity -> IO ()
aliceSees = IO Connectivity -> NominalDiffTime -> Connectivity -> IO ()
forall a.
(HasCallStack, Eq a, Show a) =>
IO a -> NominalDiffTime -> a -> IO ()
waitEq IO Connectivity
waitAlice NominalDiffTime
5
                bobSees :: Connectivity -> IO ()
bobSees = IO Connectivity -> NominalDiffTime -> Connectivity -> IO ()
forall a.
(HasCallStack, Eq a, Show a) =>
IO a -> NominalDiffTime -> a -> IO ()
waitEq IO Connectivity
waitBob NominalDiffTime
5
            forall msg.
(ToCBOR msg, FromCBOR msg, Eq msg) =>
Tracer IO EtcdLog
-> ProtocolVersion
-> NetworkConfiguration
-> NetworkComponent IO msg msg ()
withEtcdNetwork @Int Tracer IO EtcdLog
tracer ProtocolVersion
v1 NetworkConfiguration
aliceConfig NetworkCallback Int IO
recordAlice ((Network IO Int -> IO ()) -> IO ())
-> (Network IO Int -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \Network IO Int
_ -> do
              forall msg.
(ToCBOR msg, FromCBOR msg, Eq msg) =>
Tracer IO EtcdLog
-> ProtocolVersion
-> NetworkConfiguration
-> NetworkComponent IO msg msg ()
withEtcdNetwork @Int Tracer IO EtcdLog
tracer ProtocolVersion
v2 NetworkConfiguration
bobConfig NetworkCallback Int IO
recordBob ((Network IO Int -> IO ()) -> IO ())
-> (Network IO Int -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \Network IO Int
_ -> do
                -- Both will try to write to the cluster at the same time
                -- Hence, either one or the other will see the mismatch
                IO () -> IO () -> IO ()
forall a b. IO a -> IO b -> IO ()
forall (m :: * -> *) a b. MonadAsync m => m a -> m b -> m ()
race_
                  (Connectivity -> IO ()
aliceSees VersionMismatch{$sel:ourVersion:PeerConnected :: ProtocolVersion
ourVersion = ProtocolVersion
v1, $sel:theirVersion:PeerConnected :: Maybe ProtocolVersion
theirVersion = ProtocolVersion -> Maybe ProtocolVersion
forall a. a -> Maybe a
Just ProtocolVersion
v2})
                  (Connectivity -> IO ()
bobSees VersionMismatch{$sel:ourVersion:PeerConnected :: ProtocolVersion
ourVersion = ProtocolVersion
v2, $sel:theirVersion:PeerConnected :: Maybe ProtocolVersion
theirVersion = ProtocolVersion -> Maybe ProtocolVersion
forall a. a -> Maybe a
Just ProtocolVersion
v1})

      String
-> (Tracer IO EtcdLog -> IO ())
-> SpecWith (Arg (Tracer IO EtcdLog -> IO ()))
forall a.
(HasCallStack, Example a) =>
String -> a -> SpecWith (Arg a)
it String
"resends messages" ((Tracer IO EtcdLog -> IO ())
 -> SpecWith (Arg (Tracer IO EtcdLog -> IO ())))
-> (Tracer IO EtcdLog -> IO ())
-> SpecWith (Arg (Tracer IO EtcdLog -> IO ()))
forall a b. (a -> b) -> a -> b
$ \Tracer IO EtcdLog
tracer -> do
        String -> (String -> IO ()) -> IO ()
forall (m :: * -> *) r.
MonadIO m =>
String -> (String -> m r) -> m r
withTempDir String
"test-etcd" ((String -> IO ()) -> IO ()) -> (String -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \String
tmp -> do
          NominalDiffTime -> IO () -> IO ()
forall (m :: * -> *) a.
(HasCallStack, MonadTimer m, MonadThrow m) =>
NominalDiffTime -> m a -> m a
failAfter NominalDiffTime
20 (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$ do
            PeerConfig3{NetworkConfiguration
$sel:aliceConfig:PeerConfig3 :: PeerConfig3 -> NetworkConfiguration
aliceConfig :: NetworkConfiguration
aliceConfig, NetworkConfiguration
$sel:bobConfig:PeerConfig3 :: PeerConfig3 -> NetworkConfiguration
bobConfig :: NetworkConfiguration
bobConfig, NetworkConfiguration
$sel:carolConfig:PeerConfig3 :: PeerConfig3 -> NetworkConfiguration
carolConfig :: NetworkConfiguration
carolConfig} <- String -> IO PeerConfig3
setup3Peers String
tmp
            (NetworkCallback Int IO
recordBob, IO Int
waitBob, IO Connectivity
_) <- IO (NetworkCallback Int IO, IO Int, IO Connectivity)
forall (m :: * -> *) msg.
MonadSTM m =>
m (NetworkCallback msg m, m msg, m Connectivity)
newRecordingCallback
            (NetworkCallback Int IO
recordCarol, IO Int
waitCarol, IO Connectivity
_) <- IO (NetworkCallback Int IO, IO Int, IO Connectivity)
forall (m :: * -> *) msg.
MonadSTM m =>
m (NetworkCallback msg m, m msg, m Connectivity)
newRecordingCallback
            forall msg.
(ToCBOR msg, FromCBOR msg, Eq msg) =>
Tracer IO EtcdLog
-> ProtocolVersion
-> NetworkConfiguration
-> NetworkComponent IO msg msg ()
withEtcdNetwork @Int Tracer IO EtcdLog
tracer ProtocolVersion
v1 NetworkConfiguration
aliceConfig NetworkCallback Int IO
forall (m :: * -> *) msg. Applicative m => NetworkCallback msg m
noopCallback ((Network IO Int -> IO ()) -> IO ())
-> (Network IO Int -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \Network IO Int
n1 ->
              forall msg.
(ToCBOR msg, FromCBOR msg, Eq msg) =>
Tracer IO EtcdLog
-> ProtocolVersion
-> NetworkConfiguration
-> NetworkComponent IO msg msg ()
withEtcdNetwork @Int Tracer IO EtcdLog
tracer ProtocolVersion
v1 NetworkConfiguration
bobConfig NetworkCallback Int IO
recordBob ((Network IO Int -> IO ()) -> IO ())
-> (Network IO Int -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \Network IO Int
_ -> do
                let messages :: [Int]
messages = [Int
1 .. Int
1000]
                -- Bob should see messages as we go
                [Int] -> (Int -> IO ()) -> IO ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
t a -> (a -> m b) -> m ()
forM_ [Int]
messages ((Int -> IO ()) -> IO ()) -> (Int -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \Int
msg -> do
                  Network IO Int -> Int -> IO ()
forall (m :: * -> *) msg. Network m msg -> msg -> m ()
broadcast Network IO Int
n1 Int
msg
                  IO Int
waitBob IO Int -> Int -> IO ()
forall a. (HasCallStack, Show a, Eq a) => IO a -> a -> IO ()
`shouldReturn` Int
msg
                -- Carol only starts now and should see all messages delivered
                forall msg.
(ToCBOR msg, FromCBOR msg, Eq msg) =>
Tracer IO EtcdLog
-> ProtocolVersion
-> NetworkConfiguration
-> NetworkComponent IO msg msg ()
withEtcdNetwork @Int Tracer IO EtcdLog
tracer ProtocolVersion
v1 NetworkConfiguration
carolConfig NetworkCallback Int IO
recordCarol ((Network IO Int -> IO ()) -> IO ())
-> (Network IO Int -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \Network IO Int
_ -> do
                  [Int] -> (Int -> IO ()) -> IO ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
t a -> (a -> m b) -> m ()
forM_ [Int]
messages ((Int -> IO ()) -> IO ()) -> (Int -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \Int
msg ->
                    IO Int
waitCarol IO Int -> Int -> IO ()
forall a. (HasCallStack, Show a, Eq a) => IO a -> a -> IO ()
`shouldReturn` Int
msg
                -- Carol only delivers new messages even after restart
                forall msg.
(ToCBOR msg, FromCBOR msg, Eq msg) =>
Tracer IO EtcdLog
-> ProtocolVersion
-> NetworkConfiguration
-> NetworkComponent IO msg msg ()
withEtcdNetwork @Int Tracer IO EtcdLog
tracer ProtocolVersion
v1 NetworkConfiguration
carolConfig NetworkCallback Int IO
recordCarol ((Network IO Int -> IO ()) -> IO ())
-> (Network IO Int -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \Network IO Int
_ -> do
                  Network IO Int -> Int -> IO ()
forall (m :: * -> *) msg. Network m msg -> msg -> m ()
broadcast Network IO Int
n1 Int
1001
                  IO Int
waitCarol IO Int -> Int -> IO ()
forall a. (HasCallStack, Show a, Eq a) => IO a -> a -> IO ()
`shouldReturn` Int
1001
                -- We can reset the last known view (internal implementation detail)
                String -> IO ()
removeFile (NetworkConfiguration -> String
persistenceDir NetworkConfiguration
carolConfig String -> String -> String
</> String
"last-known-revision")
                forall msg.
(ToCBOR msg, FromCBOR msg, Eq msg) =>
Tracer IO EtcdLog
-> ProtocolVersion
-> NetworkConfiguration
-> NetworkComponent IO msg msg ()
withEtcdNetwork @Int Tracer IO EtcdLog
tracer ProtocolVersion
v1 NetworkConfiguration
carolConfig NetworkCallback Int IO
recordCarol ((Network IO Int -> IO ()) -> IO ())
-> (Network IO Int -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \Network IO Int
_ -> do
                  -- NOTE: The etcd component would "auto-compact" messages down
                  -- to 1000 messages after 5 minutes. This would result in
                  -- starting at 1001 here, but is hard to test (without waiting
                  -- 5 minutes).
                  [Int] -> (Int -> IO ()) -> IO ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
t a -> (a -> m b) -> m ()
forM_ [Int]
messages ((Int -> IO ()) -> IO ()) -> (Int -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \Int
msg ->
                    IO Int
waitCarol IO Int -> Int -> IO ()
forall a. (HasCallStack, Show a, Eq a) => IO a -> a -> IO ()
`shouldReturn` Int
msg

  String -> Spec -> Spec
forall a. HasCallStack => String -> SpecWith a -> SpecWith a
describe String
"Serialisation" (Spec -> Spec) -> Spec -> Spec
forall a b. (a -> b) -> a -> b
$ do
    String -> (Message SimpleTx -> Property) -> Spec
forall prop.
(HasCallStack, Testable prop) =>
String -> prop -> Spec
prop String
"can roundtrip CBOR encoding/decoding of Hydra Message" ((Message SimpleTx -> Property) -> Spec)
-> (Message SimpleTx -> Property) -> Spec
forall a b. (a -> b) -> a -> b
$ forall a. (ToCBOR a, FromCBOR a, Eq a, Show a) => a -> Property
prop_canRoundtripCBOREncoding @(Message SimpleTx)
    Proxy (Message SimpleTx) -> Spec
forall a.
(Arbitrary a, ToJSON a, FromJSON a, Typeable a) =>
Proxy a -> Spec
roundtripAndGoldenSpecs (forall t. Proxy t
forall {k} (t :: k). Proxy t
Proxy @(Message SimpleTx))

lo :: IsString s => s
lo :: forall s. IsString s => s
lo = s
"127.0.0.1"

data PeerConfig2 = PeerConfig2
  { PeerConfig2 -> NetworkConfiguration
aliceConfig :: NetworkConfiguration
  , PeerConfig2 -> NetworkConfiguration
bobConfig :: NetworkConfiguration
  }

setup2Peers :: FilePath -> IO PeerConfig2
setup2Peers :: String -> IO PeerConfig2
setup2Peers String
tmp = do
  [PortNumber
port1, PortNumber
port2] <- (Int -> PortNumber) -> [Int] -> [PortNumber]
forall a b. (a -> b) -> [a] -> [b]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Int -> PortNumber
forall a b. (Integral a, Num b) => a -> b
fromIntegral ([Int] -> [PortNumber]) -> IO [Int] -> IO [PortNumber]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Int -> IO [Int]
randomUnusedTCPPorts Int
2
  let aliceHost :: Host
aliceHost = Text -> PortNumber -> Host
Host Text
forall s. IsString s => s
lo PortNumber
port1
  let bobHost :: Host
bobHost = Text -> PortNumber -> Host
Host Text
forall s. IsString s => s
lo PortNumber
port2
  PeerConfig2 -> IO PeerConfig2
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure
    PeerConfig2
      { $sel:aliceConfig:PeerConfig2 :: NetworkConfiguration
aliceConfig =
          NetworkConfiguration
            { $sel:listen:NetworkConfiguration :: Host
listen = Text -> PortNumber -> Host
Host Text
forall s. IsString s => s
lo PortNumber
port1
            , $sel:advertise:NetworkConfiguration :: Host
advertise = Text -> PortNumber -> Host
Host Text
forall s. IsString s => s
lo PortNumber
port1
            , $sel:signingKey:NetworkConfiguration :: SigningKey HydraKey
signingKey = SigningKey HydraKey
aliceSk
            , $sel:otherParties:NetworkConfiguration :: [Party]
otherParties = [Party
bob, Party
carol]
            , $sel:peers:NetworkConfiguration :: [Host]
peers = [Host
bobHost]
            , $sel:nodeId:NetworkConfiguration :: NodeId
nodeId = NodeId
"alice"
            , $sel:persistenceDir:NetworkConfiguration :: String
persistenceDir = String
tmp String -> String -> String
</> String
"alice"
            }
      , $sel:bobConfig:PeerConfig2 :: NetworkConfiguration
bobConfig =
          NetworkConfiguration
            { $sel:listen:NetworkConfiguration :: Host
listen = Text -> PortNumber -> Host
Host Text
forall s. IsString s => s
lo PortNumber
port2
            , $sel:advertise:NetworkConfiguration :: Host
advertise = Text -> PortNumber -> Host
Host Text
forall s. IsString s => s
lo PortNumber
port2
            , $sel:signingKey:NetworkConfiguration :: SigningKey HydraKey
signingKey = SigningKey HydraKey
bobSk
            , $sel:otherParties:NetworkConfiguration :: [Party]
otherParties = [Party
alice, Party
carol]
            , $sel:peers:NetworkConfiguration :: [Host]
peers = [Host
aliceHost]
            , $sel:nodeId:NetworkConfiguration :: NodeId
nodeId = NodeId
"bob"
            , $sel:persistenceDir:NetworkConfiguration :: String
persistenceDir = String
tmp String -> String -> String
</> String
"bob"
            }
      }

data PeerConfig3 = PeerConfig3
  { PeerConfig3 -> NetworkConfiguration
aliceConfig :: NetworkConfiguration
  , PeerConfig3 -> NetworkConfiguration
bobConfig :: NetworkConfiguration
  , PeerConfig3 -> NetworkConfiguration
carolConfig :: NetworkConfiguration
  }

setup3Peers :: FilePath -> IO PeerConfig3
setup3Peers :: String -> IO PeerConfig3
setup3Peers String
tmp = do
  [PortNumber
port1, PortNumber
port2, PortNumber
port3] <- (Int -> PortNumber) -> [Int] -> [PortNumber]
forall a b. (a -> b) -> [a] -> [b]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Int -> PortNumber
forall a b. (Integral a, Num b) => a -> b
fromIntegral ([Int] -> [PortNumber]) -> IO [Int] -> IO [PortNumber]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Int -> IO [Int]
randomUnusedTCPPorts Int
3
  let aliceHost :: Host
aliceHost = Text -> PortNumber -> Host
Host Text
forall s. IsString s => s
lo PortNumber
port1
  let bobHost :: Host
bobHost = Text -> PortNumber -> Host
Host Text
forall s. IsString s => s
lo PortNumber
port2
  let carolHost :: Host
carolHost = Text -> PortNumber -> Host
Host Text
forall s. IsString s => s
lo PortNumber
port3
  PeerConfig3 -> IO PeerConfig3
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure
    PeerConfig3
      { $sel:aliceConfig:PeerConfig3 :: NetworkConfiguration
aliceConfig =
          NetworkConfiguration
            { $sel:listen:NetworkConfiguration :: Host
listen = Text -> PortNumber -> Host
Host Text
forall s. IsString s => s
lo PortNumber
port1
            , $sel:advertise:NetworkConfiguration :: Host
advertise = Text -> PortNumber -> Host
Host Text
forall s. IsString s => s
lo PortNumber
port1
            , $sel:signingKey:NetworkConfiguration :: SigningKey HydraKey
signingKey = SigningKey HydraKey
aliceSk
            , $sel:otherParties:NetworkConfiguration :: [Party]
otherParties = [Party
bob, Party
carol]
            , $sel:peers:NetworkConfiguration :: [Host]
peers = [Host
bobHost, Host
carolHost]
            , $sel:nodeId:NetworkConfiguration :: NodeId
nodeId = NodeId
"alice"
            , $sel:persistenceDir:NetworkConfiguration :: String
persistenceDir = String
tmp String -> String -> String
</> String
"alice"
            }
      , $sel:bobConfig:PeerConfig3 :: NetworkConfiguration
bobConfig =
          NetworkConfiguration
            { $sel:listen:NetworkConfiguration :: Host
listen = Text -> PortNumber -> Host
Host Text
forall s. IsString s => s
lo PortNumber
port2
            , $sel:advertise:NetworkConfiguration :: Host
advertise = Text -> PortNumber -> Host
Host Text
forall s. IsString s => s
lo PortNumber
port2
            , $sel:signingKey:NetworkConfiguration :: SigningKey HydraKey
signingKey = SigningKey HydraKey
bobSk
            , $sel:otherParties:NetworkConfiguration :: [Party]
otherParties = [Party
alice, Party
carol]
            , $sel:peers:NetworkConfiguration :: [Host]
peers = [Host
aliceHost, Host
carolHost]
            , $sel:nodeId:NetworkConfiguration :: NodeId
nodeId = NodeId
"bob"
            , $sel:persistenceDir:NetworkConfiguration :: String
persistenceDir = String
tmp String -> String -> String
</> String
"bob"
            }
      , $sel:carolConfig:PeerConfig3 :: NetworkConfiguration
carolConfig =
          NetworkConfiguration
            { $sel:listen:NetworkConfiguration :: Host
listen = Text -> PortNumber -> Host
Host Text
forall s. IsString s => s
lo PortNumber
port3
            , $sel:advertise:NetworkConfiguration :: Host
advertise = Text -> PortNumber -> Host
Host Text
forall s. IsString s => s
lo PortNumber
port3
            , $sel:signingKey:NetworkConfiguration :: SigningKey HydraKey
signingKey = SigningKey HydraKey
carolSk
            , $sel:otherParties:NetworkConfiguration :: [Party]
otherParties = [Party
alice, Party
bob]
            , $sel:peers:NetworkConfiguration :: [Host]
peers = [Host
aliceHost, Host
bobHost]
            , $sel:nodeId:NetworkConfiguration :: NodeId
nodeId = NodeId
"carol"
            , $sel:persistenceDir:NetworkConfiguration :: String
persistenceDir = String
tmp String -> String -> String
</> String
"carol"
            }
      }

prop_canRoundtripCBOREncoding ::
  (ToCBOR a, FromCBOR a, Eq a, Show a) => a -> Property
prop_canRoundtripCBOREncoding :: forall a. (ToCBOR a, FromCBOR a, Eq a, Show a) => a -> Property
prop_canRoundtripCBOREncoding a
a =
  let encoded :: ByteString
encoded = Encoding -> ByteString
toLazyByteString (Encoding -> ByteString) -> Encoding -> ByteString
forall a b. (a -> b) -> a -> b
$ a -> Encoding
forall a. ToCBOR a => a -> Encoding
toCBOR a
a
   in ((ByteString, a) -> a
forall a b. (a, b) -> b
snd ((ByteString, a) -> a)
-> Either DeserialiseFailure (ByteString, a)
-> Either DeserialiseFailure a
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (forall s. Decoder s a)
-> ByteString -> Either DeserialiseFailure (ByteString, a)
forall a.
(forall s. Decoder s a)
-> ByteString -> Either DeserialiseFailure (ByteString, a)
deserialiseFromBytes Decoder s a
forall s. Decoder s a
forall a s. FromCBOR a => Decoder s a
fromCBOR ByteString
encoded) Either DeserialiseFailure a
-> Either DeserialiseFailure a -> Property
forall a. (Eq a, Show a) => a -> a -> Property
=== a -> Either DeserialiseFailure a
forall a b. b -> Either a b
Right a
a

newRecordingCallback :: MonadSTM m => m (NetworkCallback msg m, m msg, m Connectivity)
newRecordingCallback :: forall (m :: * -> *) msg.
MonadSTM m =>
m (NetworkCallback msg m, m msg, m Connectivity)
newRecordingCallback = do
  TQueue m msg
received <- STM m (TQueue m msg) -> m (TQueue m msg)
forall a. HasCallStack => STM m a -> m a
forall (m :: * -> *) a.
(MonadSTM m, HasCallStack) =>
STM m a -> m a
atomically STM m (TQueue m msg)
forall a. STM m (TQueue m a)
forall (m :: * -> *) a. MonadSTM m => STM m (TQueue m a)
newTQueue
  TQueue m Connectivity
connectivity <- STM m (TQueue m Connectivity) -> m (TQueue m Connectivity)
forall a. HasCallStack => STM m a -> m a
forall (m :: * -> *) a.
(MonadSTM m, HasCallStack) =>
STM m a -> m a
atomically STM m (TQueue m Connectivity)
forall a. STM m (TQueue m a)
forall (m :: * -> *) a. MonadSTM m => STM m (TQueue m a)
newTQueue
  (NetworkCallback msg m, m msg, m Connectivity)
-> m (NetworkCallback msg m, m msg, m Connectivity)
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure
    ( NetworkCallback
        { $sel:deliver:NetworkCallback :: msg -> m ()
deliver = 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 ()) -> (msg -> STM m ()) -> msg -> m ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. TQueue m msg -> msg -> STM m ()
forall a. TQueue m a -> a -> STM m ()
forall (m :: * -> *) a. MonadSTM m => TQueue m a -> a -> STM m ()
writeTQueue TQueue m msg
received
        , $sel:onConnectivity:NetworkCallback :: Connectivity -> m ()
onConnectivity = 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 ())
-> (Connectivity -> STM m ()) -> Connectivity -> m ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. TQueue m Connectivity -> Connectivity -> STM m ()
forall a. TQueue m a -> a -> STM m ()
forall (m :: * -> *) a. MonadSTM m => TQueue m a -> a -> STM m ()
writeTQueue TQueue m Connectivity
connectivity
        }
    , STM m msg -> m msg
forall a. HasCallStack => STM m a -> m a
forall (m :: * -> *) a.
(MonadSTM m, HasCallStack) =>
STM m a -> m a
atomically (STM m msg -> m msg) -> STM m msg -> m msg
forall a b. (a -> b) -> a -> b
$ TQueue m msg -> STM m msg
forall a. TQueue m a -> STM m a
forall (m :: * -> *) a. MonadSTM m => TQueue m a -> STM m a
readTQueue TQueue m msg
received
    , STM m Connectivity -> m Connectivity
forall a. HasCallStack => STM m a -> m a
forall (m :: * -> *) a.
(MonadSTM m, HasCallStack) =>
STM m a -> m a
atomically (STM m Connectivity -> m Connectivity)
-> STM m Connectivity -> m Connectivity
forall a b. (a -> b) -> a -> b
$ TQueue m Connectivity -> STM m Connectivity
forall a. TQueue m a -> STM m a
forall (m :: * -> *) a. MonadSTM m => TQueue m a -> STM m a
readTQueue TQueue m Connectivity
connectivity
    )