Do not drop our own messages

hydra-node/src/Hydra/Network/Authenticate.hs

@@ -68,7 +68,7 @@ withAuthentication tracer signingKey parties withRawNetwork NetworkCallback{deli
   withRawNetwork NetworkCallback{deliver = checkSignature} authenticate
  where
   checkSignature (Signed msg sig party@Party{vkey = partyVkey}) =
-    if verify partyVkey sig msg && elem party parties
+    if verify partyVkey sig msg && party `elem` (deriveParty signingKey : parties)
       then deliver $ Authenticated msg party
       else traceWith tracer (mkAuthLog msg sig party)
 

hydra-node/src/Hydra/Network/Etcd.hs

@@ -25,7 +25,7 @@ import System.Process.Typed (byteStringInput, proc, readProcessStdout_, runProce
 -- | Concrete network component that broadcasts messages to an etcd cluster and
 -- listens for incoming messages.
 withEtcdNetwork ::
-  (ToCBOR msg, FromCBOR msg, Show msg) =>
+  (ToCBOR msg, FromCBOR msg) =>
   Tracer IO () ->
   NetworkConfiguration msg ->
   NetworkComponent IO msg msg ()
@@ -89,33 +89,32 @@ putMessage endpoint msg = do
   -- XXX: error handling
   runProcess_ $
     proc "etcdctl" ["--endpoints", endpoint, "put", key]
-      & setStdin (byteStringInput (spy' "etcd hex" hexMsg))
+      & setStdin (byteStringInput hexMsg)
  where
-  -- FIXME
+  -- FIXME: use different keys per message types? per peer?
   key = "foo"
 
   hexMsg = LBase16.encode $ serialize msg
 
 -- | Fetch and wait for messages from the etcd cluster.
 waitMessages ::
   forall m msg.
-  (MonadIO m, MonadDelay m, FromCBOR msg, Show msg, MonadCatch m) =>
+  (MonadIO m, MonadDelay m, FromCBOR msg, MonadCatch m, MonadFail m) =>
   String ->
   NetworkCallback msg m ->
   m ()
 waitMessages endpoint NetworkCallback{deliver} = do
   forever $ do
     threadDelay 0.1
+    -- TODO: use revisions? and use compaction to limit storage
     -- FIXME: use watch instead of poll
     try (getKey endpoint "foo") >>= \case
-      Left (e :: SomeException) -> putStrLn $ "etcd get error" <> show e
+      Left (e :: SomeException) -> fail $ "etcd get error" <> show e
       Right entry -> do
-        putStrLn $ "etcd get" <> show entry
         -- HACK: lenient decoding
         case decodeFull' $ Base16.decodeLenient (value entry) of
-          Left err -> putStrLn $ "Failed to decode etcd entry: " <> show err
-          Right msg -> do
-            putStrLn $ "etcd get msg: " <> show (msg :: msg)
+          Left err -> fail $ "Failed to decode etcd entry: " <> show err
+          Right msg ->
             deliver msg
 
 getKey :: MonadIO m => String -> String -> m EtcdEntry

hydra-node/test/Hydra/NetworkSpec.hs

@@ -21,7 +21,6 @@ import Hydra.Network.Reliability (MessagePersistence (..))
 import Hydra.Node.Network (NetworkConfiguration (..), configureMessagePersistence)
 import Hydra.Node.ParameterMismatch (ParameterMismatch)
 import System.FilePath ((</>))
-import System.Process.Typed (runProcess_, shell)
 import Test.Aeson.GenericSpecs (roundtripAndGoldenSpecs)
 import Test.Hydra.Node.Fixture (alice, aliceSk, bob, bobSk)
 import Test.Network.Ports (randomUnusedTCPPorts)