Skip to content
Permalink
Browse files

add socket-debug flag

  • Loading branch information...
karknu committed May 14, 2019
1 parent ed7879a commit 6e9ef1e3c796e2128671d85974c6525102ad43b3
Showing with 27 additions and 6 deletions.
  1. +8 −0 ouroboros-network/ouroboros-network.cabal
  2. +19 −6 ouroboros-network/test/Test/Socket.hs
@@ -18,6 +18,11 @@ Flag ipv6
-- Default to False since travis lacks IPv6 support
Default: False

Flag socket-debug
Description: Enable verbose debug output during socket tests
Manual: True
Default: False

source-repository head
type: git
location: https://github.com/input-output-hk/ouroboros-network
@@ -220,6 +225,9 @@ test-suite tests
if flag(ipv6)
cpp-options: -DOUROBOROS_NETWORK_IPV6

if flag(socket-debug)
cpp-options: -DOUROBOROS_NETWORK_SOCKET_DEBUG

test-suite test-cddl
type: exitcode-stdio-1.0
hs-source-dirs: test-cddl src
@@ -12,6 +12,9 @@ module Test.Socket (tests) where
import Control.Monad
import Control.Monad.Class.MonadAsync
import Control.Monad.Class.MonadFork
#ifdef OUROBOROS_NETWORK_SOCKET_DEBUG
import Control.Monad.Class.MonadSay
#endif
import Control.Monad.Class.MonadSTM
import Control.Monad.Class.MonadThrow
import Control.Monad.Class.MonadTimer
@@ -62,6 +65,16 @@ import Test.Tasty.QuickCheck (testProperty)
-}
-- #define OUROBOROS_NETWORK_IPV6

-- #define OUROBOROS_NETWORK_SOCKET_DEBUG

#ifdef OUROBOROS_NETWORK_SOCKET_DEBUG
socketSendRecvTracer :: Show a => Tracer IO a
socketSendRecvTracer = Tracer (say . show)
#else
socketSendRecvTracer :: Tracer IO a
socketSendRecvTracer = nullTracer
#endif

--
-- The list of all tests
--
@@ -161,7 +174,7 @@ prop_socket_send_recv clientAddr serverAddr f xs = do
let -- Server Node; only req-resp server
srvPeer :: Peer (ReqResp.ReqResp Int Int) AsServer ReqResp.StIdle IO ()
srvPeer = ReqResp.reqRespServerPeer (reqRespServerMapAccumL sv (\a -> pure . f a) 0)
srvPeers Mxt.ReqResp1 = OnlyServer nullTracer ReqResp.codecReqResp srvPeer
srvPeers Mxt.ReqResp1 = OnlyServer socketSendRecvTracer ReqResp.codecReqResp srvPeer
serNet = NetworkInterface {
nodeAddress = serverAddr,
protocols = srvPeers
@@ -170,7 +183,7 @@ prop_socket_send_recv clientAddr serverAddr f xs = do
-- Client Node; only req-resp client
cliPeer :: Peer (ReqResp.ReqResp Int Int) AsClient ReqResp.StIdle IO ()
cliPeer = ReqResp.reqRespClientPeer (reqRespClientMap cv xs)
cliPeers Mxt.ReqResp1 = OnlyClient nullTracer ReqResp.codecReqResp cliPeer
cliPeers Mxt.ReqResp1 = OnlyClient socketSendRecvTracer ReqResp.codecReqResp cliPeer
cliNet = NetworkInterface {
nodeAddress = clientAddr,
protocols = cliPeers
@@ -198,7 +211,7 @@ prop_socket_recv_close f _ = ioProperty $ do

let srvPeer :: Peer (ReqResp.ReqResp Int Int) AsServer ReqResp.StIdle IO ()
srvPeer = ReqResp.reqRespServerPeer (reqRespServerMapAccumL sv (\a -> pure . f a) 0)
srvPeers Mxt.ReqResp1 = OnlyServer nullTracer ReqResp.codecReqResp srvPeer
srvPeers Mxt.ReqResp1 = OnlyServer socketSendRecvTracer ReqResp.codecReqResp srvPeer

bracket
(Socket.socket Socket.AF_INET Socket.Stream Socket.defaultProtocol)
@@ -250,7 +263,7 @@ prop_socket_client_connect_error _ xs = ioProperty $ do

let cliPeer :: Peer (ReqResp.ReqResp Int Int) AsClient ReqResp.StIdle IO ()
cliPeer = ReqResp.reqRespClientPeer (reqRespClientMap cv xs)
cliPeers Mxt.ReqResp1 = OnlyClient nullTracer ReqResp.codecReqResp cliPeer
cliPeers Mxt.ReqResp1 = OnlyClient socketSendRecvTracer ReqResp.codecReqResp cliPeer
ni = NetworkInterface {
nodeAddress = serverAddr,
protocols = cliPeers
@@ -282,15 +295,15 @@ demo chain0 updates = do
consumerPeer = ChainSync.chainSyncClientPeer
(ChainSync.chainSyncClientExample consumerVar
(consumerClient done target consumerVar))
consumerPeers Mxt.ChainSync1 = OnlyClient nullTracer ChainSync.codecChainSync consumerPeer
consumerPeers Mxt.ChainSync1 = OnlyClient socketSendRecvTracer ChainSync.codecChainSync consumerPeer
consumerNet = NetworkInterface {
nodeAddress = consumerAddress,
protocols = consumerPeers
}

producerPeer :: Peer (ChainSync.ChainSync block (Point block)) AsServer ChainSync.StIdle IO ()
producerPeer = ChainSync.chainSyncServerPeer (ChainSync.chainSyncServerExample () producerVar)
producerPeers Mxt.ChainSync1 = OnlyServer nullTracer ChainSync.codecChainSync producerPeer
producerPeers Mxt.ChainSync1 = OnlyServer socketSendRecvTracer ChainSync.codecChainSync producerPeer
producerNet = NetworkInterface {
nodeAddress = producerAddress,
protocols = producerPeers

0 comments on commit 6e9ef1e

Please sign in to comment.
You can’t perform that action at this time.