content: {-# LANGUAGE DeriveAnyClass        #-}
  {-# LANGUAGE DeriveGeneric         #-}
  {-# LANGUAGE FlexibleInstances     #-}
  {-# LANGUAGE MultiParamTypeClasses #-}
  {-# LANGUAGE RecordWildCards       #-}
  {-# LANGUAGE TypeFamilies          #-}
  
  module Bench.Network.Commons
         ( MsgId
         , Ping (..)
         , Pong (..)
         , Payload (..)
         , logMeasure
  
         , loadLogConfig
  
         , Timestamp
         , MeasureEvent (..)
         , MeasureInfo (..)
         , LogMessage (..)
         , measureInfoParser
         , logMessageParser
         ) where
  
  import           Control.Applicative ((<|>))
  import           Control.Lens ((&), (.~), (^.))
  import           Control.Monad (join)
  import           Control.Monad.Trans (MonadIO (..))
  
  import           Data.Attoparsec.Text (Parser, char, decimal, string, takeWhile)
  import           Data.Binary (Binary (..))
  import qualified Data.ByteString.Lazy as BL
  import           Data.Data (Data)
  import           Data.Functor (($>))
  import qualified Data.HashMap.Strict as HM
  import           Data.Int (Int64)
  import           Data.Monoid ((<>))
  import           Data.Text (Text)
  import           Data.Time.Units (toMicroseconds)
  import           Formatting.Buildable (Buildable (build))
  
  import qualified Formatting as F
  import           GHC.Generics (Generic)
  import           Prelude hiding (takeWhile)
  
  import           Node (Message (..))
  import           Pos.Util (realTime)
  import           Pos.Util.Log.Internal (LoggingHandler)
  import           Pos.Util.Log.LoggerConfig (defaultInteractiveConfiguration,
                       lcLoggerTree, ltMinSeverity, ltNamedSeverity)
  import           Pos.Util.Trace (Trace, traceWith)
  import           Pos.Util.Wlog (LoggerConfig (..), Severity (..),
                       parseLoggerConfig, setLogPrefix, setupLogging')
  
  -- * Transfered data types
  
  type MsgId = Int
  
  -- | Serializes into message of (given size + const)
  data Payload = Payload
      { getPayload :: Int64
      } deriving (Generic, Data)
  
  data Ping = Ping MsgId Payload
      deriving (Generic, Data, Binary)
  
  instance Message Ping where
      messageCode _ = 0
      formatMessage _ = "Ping"
  
  data Pong = Pong MsgId Payload
      deriving (Generic, Data, Binary)
  
  instance Message Pong where
      messageCode _ = 1
      formatMessage _ = "Pong"
  
  instance Binary Payload where
      get = Payload . BL.length <$> get
      put (Payload l) = put $ BL.replicate l 42
  
  
  -- * Util
  
  logMeasure :: (MonadIO m) => Trace IO Text -> MeasureEvent -> MsgId -> Payload -> m ()
  logMeasure logTrace miEvent miId miPayload = do
      miTime <- toMicroseconds <$> realTime
      liftIO $ traceWith logTrace $ F.sformat F.build $ LogMessage MeasureInfo{..}
  
  defaultLogConfig :: LoggerConfig
  defaultLogConfig =
      let lc0   = defaultInteractiveConfiguration Info
          newlt = lc0 ^. lcLoggerTree
                      & ltMinSeverity .~ Info
                      & ltNamedSeverity .~
                          HM.fromList [ ("cardano-sl.sender", Info)
                                      , ("cardano-sl.sender.comm", Error)
                                      , ("cardano-sl.receiver", Info)
                                      , ("cardano-sl.receiver.comm", Error) ]
      in
      lc0 & lcLoggerTree .~ newlt
  
  
  loadLogConfig :: MonadIO m => Maybe FilePath -> Maybe FilePath -> m LoggingHandler
  loadLogConfig logsPrefix configFile = do
      lc1 <- case configFile of
          Nothing  -> return defaultLogConfig
          Just lc0 -> parseLoggerConfig lc0
      lc <- liftIO $ setLogPrefix logsPrefix lc1
      setupLogging' "bench" lc
  
  
  -- * Logging & parsing
  
  -- ** Measure event
  
  -- | Type of event in measurement.
  data MeasureEvent
      = PingSent
      | PingReceived
      | PongSent
      | PongReceived
      deriving (Show, Eq, Ord, Enum, Bounded)
  
  instance Buildable MeasureEvent where
      build PingSent     = "• → "
      build PingReceived = " → •"
      build PongSent     = " ← •"
      build PongReceived = "• ← "
  
  measureEventParser :: Parser MeasureEvent
  measureEventParser = string "• → " $> PingSent
                   <|> string " → •" $> PingReceived
                   <|> string " ← •" $> PongSent
                   <|> string "• ← " $> PongReceived
  
  
  -- ** Measure info
  
  type Timestamp = Integer
  
  -- | Single event in measurement.
  data MeasureInfo = MeasureInfo
      { miId      :: MsgId
      , miEvent   :: MeasureEvent
      , miTime    :: Timestamp
      , miPayload :: Payload
      }
  
  instance Buildable MeasureInfo where
      build MeasureInfo{..} = mconcat
          [ build miId
          , " "
          , build miEvent
          , " ("
          , build $ getPayload miPayload
          , ") "
          , build miTime
          ]
  
  measureInfoParser :: Parser MeasureInfo
  measureInfoParser = do
      miId <- decimal
      _ <- string " "
      miEvent <- measureEventParser
      _ <- string " ("
      miPayload <- Payload <$> decimal
      _ <- string ") "
      miTime <- decimal
      return MeasureInfo{..}
  
  
  -- ** Log message
  
  -- | Allows to extract bare message content from logs.
  -- Just inserts separator at beginning.
  data LogMessage a = LogMessage a
  
  instance Buildable a => Buildable (LogMessage a) where
      build (LogMessage a) = "#" <> build a
  
  logMessageParser :: Parser a -> Parser (Maybe (LogMessage a))
  logMessageParser p = (takeWhile (/= '#') >>) . join $ do
          (char '#' $> (Just . LogMessage <$> p))
      <|> pure (pure Nothing)
  