Merge pull request #13 from oscoin/f/network-delays

Inject Network Faults in Tests

Author: kim

.stylish-haskell.yaml

@@ -86,7 +86,7 @@ steps:
       #   >     )
       #
       # Default: inline
-      long_list_align: new_line_multiline
+      long_list_align: multiline
 
       # Align empty list (importing instances)
       #

gossip.cabal

@@ -30,6 +30,7 @@ common common
       , base
       , bytestring
       , containers
+      , safe-exceptions
       , splitmix
       , stm
       , transformers
@@ -82,11 +83,9 @@ library
       , hashable
       , list-t
       , microlens
-      , microlens-mtl
       , mtl
       , network
       , random
-      , safe-exceptions
       , serialise
       , stm-containers < 1
       , text
@@ -104,11 +103,15 @@ test-suite tests
         algebraic-graphs == 0.2.*
       , gossip
       , hedgehog
+      , hedgehog-quickcheck
+      , QuickCheck
+      , random
 
     other-modules:
         Network.Gossip.Test.Assert
         Network.Gossip.Test.Broadcast
         Network.Gossip.Test.Gen
+        Network.Gossip.Test.Helpers
         Network.Gossip.Test.Membership
 
     ghc-options:

src/Network/Gossip/HyParView.hs

@@ -58,7 +58,11 @@ import           Codec.Serialise (Serialise)
 import           Control.Applicative (liftA2)
 import           Control.Concurrent.STM
 import           Control.Exception.Safe
-                 (Exception, SomeException, toException, tryAny)
+                 ( Exception
+                 , SomeException
+                 , toException
+                 , tryAny
+                 )
 import           Control.Monad (when)
 import           Control.Monad.Reader
 import           Control.Monad.Trans.Cont

src/Network/Gossip/HyParView/Periodic.hs

@@ -15,7 +15,11 @@ import qualified Network.Gossip.HyParView as H
 
 import           Control.Concurrent (threadDelay)
 import           Control.Concurrent.Async
-                 (Async, Concurrently(..), async, uninterruptibleCancel)
+                 ( Async
+                 , Concurrently(..)
+                 , async
+                 , uninterruptibleCancel
+                 )
 import           Control.Exception.Safe (bracket)
 import           Control.Monad (forever)
 import           Data.Hashable (Hashable)

src/Network/Gossip/IO/Run.hs

@@ -31,11 +31,12 @@ import           Data.Foldable (toList)
 import           Data.Hashable (Hashable)
 import           GHC.Generics (Generic)
 import           Network.Socket (HostName, PortNumber)
+import           Prelude hiding (round)
 import qualified System.Random.SplitMix as SplitMix
 
 data ProtocolMessage n =
-      ProtocolPlumtree  (P.Message n)
-    | ProtocolHyParView (H.RPC     n)
+      ProtocolPlumtree  (P.RPC n)
+    | ProtocolHyParView (H.RPC n)
     deriving (Eq, Generic)
 
 instance (Eq n, Hashable n, Serialise n) => Serialise (ProtocolMessage n)
@@ -97,9 +98,13 @@ withGossip self
             bootstrap env
             k env
   where
-    sendIHaves env to xs =
+    sendIHaves env to round xs =
         runNetwork env $
-            S.send to $ WirePayload (ProtocolPlumtree (P.IHaveM xs))
+            S.send to . WirePayload . ProtocolPlumtree $ P.RPC
+                { P.rpcSender  = self
+                , P.rpcRound   = Just round
+                , P.rpcPayload = P.IHave xs
+                }
 
     listen env = async $
         runNetwork env (S.listen (evalNetwork env) host port)
@@ -133,8 +138,8 @@ evalPlumtree env@Env { envApplyMessage, envLookupMessage } = go
                 `onException` runHyParView env (H.eject to)
             k >>= go
 
-        P.SendLazy to ihaves k -> do
-            runScheduler env $ PS.sendLazy to ihaves
+        P.SendLazy to round ihaves k -> do
+            runScheduler env $ PS.sendLazy to round ihaves
             k >>= go
 
         P.Later t mid action k -> do