content: {-# LANGUAGE FlexibleContexts      #-}
  {-# LANGUAGE FlexibleInstances     #-}
  {-# LANGUAGE LambdaCase            #-}
  {-# LANGUAGE MultiParamTypeClasses #-}
  {-# LANGUAGE RankNTypes            #-}
  {-# LANGUAGE RecordWildCards       #-}
  {-# LANGUAGE TypeApplications      #-}
  
  module Main where
  
  import           Control.Applicative (empty)
  import           Control.Concurrent (threadDelay)
  import           Control.Exception (throwIO)
  import           Control.Exception.Safe (throwString)
  import           Control.Monad (unless)
  
  import           Data.Functor.Contravariant (contramap)
  import           Data.Text (Text)
  import           GHC.IO.Encoding (setLocaleEncoding, utf8)
  import           Options.Applicative.Simple (simpleOptions)
  import           System.Random (mkStdGen)
  
  import           Bench.Network.Commons (MeasureEvent (..), Ping (..), Pong (..),
                       loadLogConfig, logMeasure)
  import qualified Network.Transport.TCP as TCP
  import           Node (ConversationActions (..), Listener (..), NodeAction (..),
                       defaultNodeEnvironment, noReceiveDelay, node,
                       simpleNodeEndPoint)
  import           Node.Message.Binary (binaryPacking)
  import           Pos.Util.Trace (Severity (..), Trace, wlogTrace)
  import           Pos.Util.Wlog (removeAllHandlers)
  import           ReceiverOptions (Args (..), argsParser)
  
  main :: IO ()
  main = do
      (Args {..}, ()) <-
          simpleOptions
              "bench-receiver"
              "Server utility for benches"
              "Use it!"
              argsParser
              empty
  
      lh <- loadLogConfig logsPrefix logConfig
      setLocaleEncoding utf8
  
      transport <- do
          transportOrError <-
              TCP.createTransport (TCP.defaultTCPAddr "127.0.0.1" (show port))
              TCP.defaultTCPParameters
          either throwIO return transportOrError
  
      let prng = mkStdGen 0
  
      node logTrace (simpleNodeEndPoint transport) (const noReceiveDelay) (const noReceiveDelay) prng binaryPacking () defaultNodeEnvironment $ \_ ->
          NodeAction (const [pingListener noPong]) $ \_ -> do
              threadDelay (duration * 1000000)
      removeAllHandlers lh
    where
  
      logTrace :: Trace IO (Severity, Text)
      logTrace = wlogTrace "receiver"
  
      logTrace' :: Trace IO Text
      logTrace' = contramap ((,) Info) logTrace
  
      pingListener noPong =
          Listener $ \_ _ cactions -> do
              (mid, payload) <- recv cactions maxBound >>= \case
                  Just (Ping mid payload) -> return (mid, payload)
                  _ -> throwString "Expected a ping"
              logMeasure logTrace' PingReceived mid payload
              unless noPong $ do
                  logMeasure logTrace' PongSent mid payload
                  send cactions (Pong mid payload)
  