Fix compilation and broadcast to self

The end-to-end test is still not passing though as nodes 2 and 3 are not seeing the tx confirmed
input-output-hk · Jun 7, 2021 · 67fe5b8 · 67fe5b8
1 parent 74a76a2
commit 67fe5b8
Show file tree

Hide file tree

Showing 5 changed files with 13 additions and 8 deletions.
diff --git a/hydra-node/exe/hydra-node/Main.hs b/hydra-node/exe/hydra-node/Main.hs
@@ -7,17 +7,17 @@ import Cardano.Prelude hiding (Option, option)
 import Control.Concurrent.STM (newBroadcastTChanIO, writeTChan)
 import Hydra.API.Server (runAPIServer)
 import Hydra.Chain.ZeroMQ (createMockChainClient)
-import qualified Hydra.Ledger.Mock as Ledger
-import Hydra.Logging
-import Hydra.Logging.Messages (HydraLog (..))
-import Hydra.Logging.Monitoring (withMonitoring)
 import Hydra.HeadLogic (
   Environment (..),
   Event (..),
   HeadParameters (..),
   SnapshotStrategy (..),
   createHeadState,
  )
+import qualified Hydra.Ledger.Mock as Ledger
+import Hydra.Logging
+import Hydra.Logging.Messages (HydraLog (..))
+import Hydra.Logging.Monitoring (withMonitoring)
 import Hydra.Network.Ouroboros (withOuroborosHydraNetwork)
 import Hydra.Node (
   EventQueue (..),
@@ -35,7 +35,7 @@ main = do
     withMonitoring monitoringPort tracer' $ \tracer -> do
       let env = Environment nodeId
       eq <- createEventQueue
-      let headState = createHeadState [] (HeadParameters 3) SnapshotStrategy
+      let headState = createHeadState [] (HeadParameters 3 []) SnapshotStrategy
       hh <- createHydraHead headState Ledger.mockLedger
       oc <- createMockChainClient eq (contramap MockChain tracer)
       withOuroborosHydraNetwork (show host, port) peers (putEvent eq . NetworkEvent) $ \hn -> do

diff --git a/hydra-node/src/Hydra/HeadLogic.hs b/hydra-node/src/Hydra/HeadLogic.hs
@@ -166,7 +166,7 @@ update ::
   Outcome tx
 update Environment{party} ledger (HeadState p st) ev = case (st, ev) of
   (InitState, ClientEvent (Init parties)) ->
-    newState p InitState [OnChainEffect (InitTx $ makeAllTokens parties)]
+    newState (p{parties}) InitState [OnChainEffect (InitTx $ makeAllTokens parties)]
   (InitState, OnChainEvent (InitTx tokens)) ->
     newState p (CollectingState tokens mempty) [ClientEffect ReadyToCommit]
   --

diff --git a/hydra-node/src/Hydra/Network/Ouroboros.hs b/hydra-node/src/Hydra/Network/Ouroboros.hs
@@ -98,7 +98,9 @@ withOuroborosHydraNetwork localHost remoteHosts networkCallback between = do
       race_ (listen iomgr hydraServer) $ do
         between $
           HydraNetwork
-            { broadcast = atomically . writeTChan bchan
+            { broadcast = \e -> do
+                atomically $ writeTChan bchan e
+                networkCallback (MessageReceived e)
             }
  where
   resolveSockAddr (hostname, port) = do

diff --git a/hydra-node/test/Hydra/NetworkSpec.hs b/hydra-node/test/Hydra/NetworkSpec.hs
@@ -62,6 +62,9 @@ spec = describe "Networking layer" $ do
               failAfter 1 $ takeMVar node1received `shouldReturn` MessageReceived requestTx
               failAfter 1 $ takeMVar node2received `shouldReturn` MessageReceived requestTx
 
+    it "broadcasts messages to itself" $ do
+      pendingWith "not tested yet"
+
   describe "0MQ Network" $
     it "broadcasts messages between 3 connected peers" $ do
       pendingWith "missing network callback"

diff --git a/local-cluster/test/Test/EndToEndSpec.hs b/local-cluster/test/Test/EndToEndSpec.hs
@@ -44,7 +44,7 @@ spec = describe "End-to-end test using a mocked chain though" $ do
                 -- NOTE(SN): uses MockTx and its UTxO type [MockTx]
                 waitForResponse 3 [n1, n2, n3] "HeadIsOpen []"
                 sendRequest n1 "NewTx (ValidTx 42)"
-                waitForResponse 3 [n1, n2, n3] "TxConfirmed (ValidTx 42)"
+                waitForResponse 10 [n1, n2, n3] "TxConfirmed (ValidTx 42)"
                 sendRequest n1 "Close"
                 waitForResponse 3 [n1] "HeadIsClosed 3s [ValidTx 42]"
                 waitForResponse (contestationPeriod + 3) [n1] "HeadIsFinalized [ValidTx 42]"