Skip to content
Permalink
Browse files

socketSendRecvTracer

  • Loading branch information...
coot committed May 14, 2019
1 parent ed7879a commit 95c75e6f5f1a87936c7460809619f5f2756035ff
Showing with 22 additions and 3 deletions.
  1. +15 −0 ouroboros-network/src/Ouroboros/Network/Socket.hs
  2. +7 −3 ouroboros-network/test/Test/Mux.hs
@@ -1,7 +1,9 @@
{-# LANGUAGE CPP #-}
{-# LANGUAGE RankNTypes #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE NamedFieldPuns #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE QuantifiedConstraints #-}

-- |
-- Module exports interface for running a node over a socket over TCP \/ IP.
@@ -29,6 +31,9 @@ import qualified Network.Socket as Socket hiding (recv)
import qualified Network.Socket.ByteString.Lazy as Socket (recv, sendAll)

import Ouroboros.Network.Time
import Network.TypedProtocol.Core
import Network.TypedProtocol.Driver
import Control.Tracer (Tracer (..), nullTracer)

import qualified Ouroboros.Network.Server.Socket as Server
import qualified Ouroboros.Network.Mux as Mx
@@ -43,6 +48,16 @@ import Ouroboros.Network.Mux.Interface ( Connection (..)

import Text.Printf

#define OUROBOROS_NETWORK_SOCKET_DEBUG

socketSendRecvTracer :: (MonadSay m, (forall st st'. Show (Message ps st st')))
=> Tracer m (TraceSendRecv ps)
#ifdef OUROBOROS_NETWORK_SOCKET_DEBUG
socketSendRecvTracer = Tracer (say . show)
#else
socketSendRecvTracer = nullTracer
#endif

-- |
-- Create @'MuxBearer'@ from a socket.
--
@@ -1,4 +1,6 @@
{-# LANGUAGE CPP #-}
{-# LANGUAGE DataKinds #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE TypeFamilies #-}
{-# LANGUAGE RankNTypes #-}
{-# LANGUAGE ScopedTypeVariables #-}
@@ -32,7 +34,9 @@ import Control.Monad.Class.MonadAsync
import Control.Monad.Class.MonadSTM
import Control.Monad.Class.MonadThrow
import Control.Monad.Class.MonadTime
import Control.Tracer (nullTracer)
import Control.Monad.Class.MonadSay
import Control.Tracer (Tracer (..), nullTracer)
import Network.TypedProtocol.Codec
import Network.TypedProtocol.Driver
import Network.TypedProtocol.ReqResp.Client
import Network.TypedProtocol.ReqResp.Server
@@ -255,12 +259,12 @@ setupMiniReqRsp serverAction mpsEndVar request response = do
clientPeer = reqRespClientPeer (plainClient [request])

clientInit clientResultVar clientChan = do
result <- runPeer nullTracer codecReqResp clientChan clientPeer
result <- runPeer socketSendRecvTracer codecReqResp clientChan clientPeer
atomically (putTMVar clientResultVar result)
end

serverRsp serverResultVar serverChan = do
result <- runPeer nullTracer codecReqResp serverChan serverPeer
result <- runPeer socketSendRecvTracer codecReqResp serverChan serverPeer
atomically (putTMVar serverResultVar result)
end

0 comments on commit 95c75e6

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