content: {-# LANGUAGE BangPatterns #-}
  {-# LANGUAGE FlexibleInstances #-}
  {-# LANGUAGE OverloadedStrings #-}
  
  module Cardano.Tracer.Handlers.RTView.State.Historical
    ( BlockchainHistory (..)
    , DataName (..)
    , History
    , HistoricalData
    , HistoricalPoint
    , HistoricalPoints
    , POSIXTime
    , ResourcesHistory (..)
    , TransactionsHistory (..)
    , ValueH (..)
    , addHistoricalData
    , getHistoricalData
    , initBlockchainHistory
    , initResourcesHistory
    , initTransactionsHistory
    , readValueI
    , readValueD
    ) where
  
  import           Cardano.Tracer.Handlers.Utils
  import           Cardano.Tracer.Types (NodeId)
  
  import           Control.Concurrent.STM (atomically)
  import           Control.Concurrent.STM.TVar (TVar, modifyTVar', newTVarIO, readTVarIO)
  import           Control.Monad (mzero)
  import qualified Data.ByteString.Char8 as BSC
  import           Data.Csv (FromField (..), ToField (..))
  import           Data.Map.Strict (Map)
  import qualified Data.Map.Strict as M
  import           Data.Set (Set)
  import qualified Data.Set as S
  import           Data.Text (Text, isInfixOf)
  import           Data.Text.Encoding (decodeUtf8)
  import           Data.Text.Read (decimal, double)
  import           Data.Time.Clock (UTCTime)
  import           Data.Word (Word64)
  import           Text.Printf (printf)
  
  -- | A lot of information received from the node is useful as historical data.
  --   It means that such an information should be displayed on time charts,
  --   where X axis is a time in UTC. An example: resource metrics, chain information,
  --   tx information, etc.
  type POSIXTime = Word64
  
  data ValueH
    = ValueD Double
    | ValueI Int
    deriving (Eq, Ord)
  
  instance Show ValueH where
    show (ValueD d) = show d
    show (ValueI i) = show i
  
  instance Num ValueH where
    (+) (ValueI i1) (ValueI i2) = ValueI (i1 + i2)
    (+) (ValueD d1) (ValueD d2) = ValueD (d1 + d2)
    (+) (ValueI i1) (ValueD d1) = ValueD (fromIntegral i1 + d1)
    (+) (ValueD d1) (ValueI i1) = ValueD (fromIntegral i1 + d1)
  
    (-) (ValueI i1) (ValueI i2) = ValueI (i1 - i2)
    (-) (ValueD d1) (ValueD d2) = ValueD (d1 - d2)
    (-) (ValueI i1) (ValueD d1) = ValueD (fromIntegral i1 - d1)
    (-) (ValueD d1) (ValueI i1) = ValueD (fromIntegral i1 - d1)
  
    (*) (ValueI i1) (ValueI i2) = ValueI (i1 * i2)
    (*) (ValueD d1) (ValueD d2) = ValueD (d1 * d2)
    (*) (ValueI i1) (ValueD d1) = ValueD (fromIntegral i1 * d1)
    (*) (ValueD d1) (ValueI i1) = ValueD (fromIntegral i1 * d1)
  
    abs (ValueI i) = ValueI (abs i)
    abs (ValueD d) = ValueD (abs d)
  
    signum (ValueI i) = ValueI (signum i)
    signum (ValueD d) = ValueD (signum d)
  
    fromInteger i = ValueI (fromInteger i)
  
  type HistoricalPoint = (POSIXTime, ValueH)
  
  instance FromField ValueH where
    parseField s =
      let t = decodeUtf8 s in
      if "." `isInfixOf` t
        then either (const mzero) (return . ValueD . fst) $ double t
        else either (const mzero) (return . ValueI . fst) $ decimal t
  
  instance ToField ValueH where
    toField (ValueI i) = toField i
    toField (ValueD d) = BSC.pack $ printf "%.3f" d
  
  type HistoricalPoints = Set HistoricalPoint
  
  -- | Historical points for particular data.
  data DataName
    = CPUData
    | MemoryData
    | GCMajorNumData
    | GCMinorNumData
    | GCLiveMemoryData
    | CPUTimeGCData
    | CPUTimeAppData
    | ThreadsNumData
    -- Chain
    | ChainDensityData
    | SlotNumData
    | BlockNumData
    | SlotInEpochData
    | EpochData
    | NodeCannotForgeData
    | ForgedSlotLastData
    | NodeIsLeaderData
    | NodeIsNotLeaderData
    | ForgedInvalidSlotLastData
    | AdoptedSlotLastData
    | NotAdoptedSlotLastData
    | AboutToLeadSlotLastData
    | CouldNotForgeSlotLastData
    -- TX
    | TxsProcessedNumData
    | MempoolBytesData
    | TxsInMempoolData
    deriving (Eq, Ord, Read, Show)
  
  type HistoricalData = Map DataName HistoricalPoints
  type History        = TVar (Map NodeId HistoricalData)
  
  newtype BlockchainHistory   = ChainHistory History
  newtype ResourcesHistory    = ResHistory   History
  newtype TransactionsHistory = TXHistory    History
  
  initBlockchainHistory :: IO BlockchainHistory
  initBlockchainHistory = ChainHistory <$> newTVarIO M.empty
  
  initResourcesHistory :: IO ResourcesHistory
  initResourcesHistory = ResHistory <$> newTVarIO M.empty
  
  initTransactionsHistory :: IO TransactionsHistory
  initTransactionsHistory = TXHistory <$> newTVarIO M.empty
  
  addHistoricalData
    :: History
    -> NodeId
    -> UTCTime
    -> DataName
    -> ValueH
    -> IO ()
  addHistoricalData history nodeId now dataName valueH = atomically $
    modifyTVar' history $ \currentHistory ->
      case M.lookup nodeId currentHistory of
        Nothing ->
          -- There is no historical data for this node yet.
          let firstPoint = S.singleton (utc2s now, valueH)
              newDataForNode = M.singleton dataName firstPoint
          in M.insert nodeId newDataForNode currentHistory
        Just dataForNode ->
          let newDataForNode =
                case M.lookup dataName dataForNode of
                  Nothing ->
                    -- There is no historical points for this dataName yet.
                    let firstPoint = S.singleton (utc2s now, valueH)
                    in M.insert dataName firstPoint dataForNode
                  Just points ->
                    let pointsWeKeep = S.fromList . deleteOutdated . S.toAscList $ points
                        newPoints = S.insert (utc2s now, valueH) pointsWeKeep
                    in M.adjust (const newPoints) dataName dataForNode
          in M.adjust (const newDataForNode) nodeId currentHistory
   where
    -- All points that older than 'minAge' should be deleted.
    deleteOutdated = go
     where
      go [] = []
      go (point@(tsInSec, _):otherPoints) =
        if tsInSec < minAge
          then
            -- This point is too old, do not keep it anymore.
            go otherPoints
          else
            -- This point should be kept.
            -- Since the points were converted to asc list, all the next points
            -- are definitely newer (have bigger 'tsInSec'), so there is no need
            -- to check them.
            point : otherPoints
  
    !minAge = utc2s now - pointsAgeInSec
    pointsAgeInSec = 12 * 60 * 60
  
  getHistoricalData
    :: History
    -> NodeId
    -> DataName
    -> IO [(POSIXTime, ValueH)]
  getHistoricalData history nodeId dataName = do
    history' <- readTVarIO history
    case M.lookup nodeId history' of
      Nothing -> return []
      Just dataForNode ->
        case M.lookup dataName dataForNode of
          Nothing -> return []
          Just points -> return $ S.toAscList points
  
  readValueI
    :: Monad m
    => Text
    -> (ValueH -> m ())
    -> m ()
  readValueI t f =
    case decimal t of
      Left _ -> return ()
      Right (i, _) -> f (ValueI i)
  
  readValueD
    :: Monad m
    => Text
    -> (ValueH -> m ())
    -> m ()
  readValueD t f =
    case double t of
      Left _ -> return ()
      Right (d, _) -> f (ValueD d)
  