{-# LANGUAGE ScopedTypeVariables #-}

module Cardano.RTView
    ( runCardanoRTView
    ) where

import           Cardano.Prelude hiding (newMVar)

import           Control.Concurrent.Async (async, waitAnyCancel)
import           Control.Concurrent.MVar.Strict (MVar, newMVar)
import qualified Data.Text.IO as TIO

import           Cardano.BM.Backend.Switchboard (addUserDefinedBackend)
import           Cardano.BM.Data.Backend (Backend (..))
import qualified Cardano.BM.Setup as Setup
import           Cardano.BM.Trace (Trace, logNotice)
import           Cardano.BM.Tracing (appendName)

import           Cardano.RTView.Acceptor (launchMetricsAcceptor)
import           Cardano.RTView.CLI (RTViewParams (..))
import           Cardano.RTView.Config (prepareConfigAndParams)
import           Cardano.RTView.ErrorBuffer (ErrorBuffer, effectuate, realize, unrealize)
import           Cardano.RTView.NodeState.Types (NodesState, defaultNodesState)
import           Cardano.RTView.NodeState.Updater (launchNodeStateUpdater)
import           Cardano.RTView.Server (launchServer)

-- | Run the service.
runCardanoRTView :: RTViewParams -> IO ()
runCardanoRTView :: RTViewParams -> IO ()
runCardanoRTView RTViewParams
params' = do
  Text -> IO ()
TIO.putStrLn Text
"━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━"
  Text -> IO ()
TIO.putStrLn Text
" RTView: real-time watching for Cardano nodes "
  Text -> IO ()
TIO.putStrLn Text
"━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━"

  (Configuration
config, RTViewParams
params, [RemoteAddrNamed]
acceptors) <- RTViewParams -> IO (Configuration, RTViewParams, [RemoteAddrNamed])
prepareConfigAndParams RTViewParams
params'

  (Trace IO Text
tr :: Trace IO Text, Switchboard Text
switchBoard) <- Configuration -> Text -> IO (Trace IO Text, Switchboard Text)
forall (m :: * -> *) a.
(MonadIO m, ToJSON a, FromJSON a, ToObject a) =>
Configuration -> Text -> m (Trace m a, Switchboard a)
Setup.setupTrace_ Configuration
config Text
"cardano-rt-view"
  let accTr :: Trace IO Text
accTr = Text -> Trace IO Text -> Trace IO Text
forall (m :: * -> *) a. Text -> Trace m a -> Trace m a
appendName Text
"acceptor" Trace IO Text
tr

  -- Initialise own backend (error buffer).
  ErrorBuffer Text
be :: ErrorBuffer Text <- Configuration -> IO (ErrorBuffer Text)
forall (t :: * -> *) a. IsBackend t a => Configuration -> IO (t a)
realize Configuration
config
  let ebBe :: Backend Text
ebBe = MkBackend :: forall a. (LogObject a -> IO ()) -> IO () -> Backend a
MkBackend { bEffectuate :: LogObject Text -> IO ()
bEffectuate = ErrorBuffer Text -> LogObject Text -> IO ()
forall (t :: * -> *) a.
IsEffectuator t a =>
t a -> LogObject a -> IO ()
effectuate ErrorBuffer Text
be
                       , bUnrealize :: IO ()
bUnrealize  = ErrorBuffer Text -> IO ()
forall (t :: * -> *) a. IsBackend t a => t a -> IO ()
unrealize ErrorBuffer Text
be
                       }
  Switchboard Text -> Backend Text -> Text -> IO ()
forall a. Switchboard a -> Backend a -> Text -> IO ()
addUserDefinedBackend Switchboard Text
switchBoard Backend Text
ebBe Text
"ErrorBufferBK"

  Trace IO Text -> Text -> IO ()
forall (m :: * -> *) a. MonadIO m => Trace m a -> a -> m ()
logNotice Trace IO Text
tr Text
"Starting service; hit CTRL-C to terminate..."

  NodesState
initStateOfNodes <- Configuration -> IO NodesState
defaultNodesState Configuration
config
  -- This MVar contains state (info, metrics) for all nodes we receive metrics from.
  MVar NodesState
nodesStateMVar :: MVar NodesState <- NodesState -> IO (MVar NodesState)
forall a. NFData a => a -> IO (MVar a)
newMVar NodesState
initStateOfNodes

  -- Launch 3 threads:
  --   1. acceptor plugin (it launches |TraceAcceptor| plugin),
  --   2. node state updater (it gets metrics from |LogBuffer| and updates NodeState),
  --   3. server (it serves requests from user's browser and shows nodes' metrics in the real time).
  Async ()
acceptorThr <- IO () -> IO (Async ())
forall a. IO a -> IO (Async a)
async (IO () -> IO (Async ())) -> IO () -> IO (Async ())
forall a b. (a -> b) -> a -> b
$ Configuration -> Trace IO Text -> Switchboard Text -> IO ()
launchMetricsAcceptor Configuration
config Trace IO Text
accTr Switchboard Text
switchBoard
  Async ()
updaterThr  <- IO () -> IO (Async ())
forall a. IO a -> IO (Async a)
async (IO () -> IO (Async ())) -> IO () -> IO (Async ())
forall a b. (a -> b) -> a -> b
$ Trace IO Text
-> Switchboard Text -> ErrorBuffer Text -> MVar NodesState -> IO ()
launchNodeStateUpdater Trace IO Text
tr Switchboard Text
switchBoard ErrorBuffer Text
be MVar NodesState
nodesStateMVar
  Async ()
serverThr   <- IO () -> IO (Async ())
forall a. IO a -> IO (Async a)
async (IO () -> IO (Async ())) -> IO () -> IO (Async ())
forall a b. (a -> b) -> a -> b
$ MVar NodesState -> RTViewParams -> [RemoteAddrNamed] -> IO ()
launchServer MVar NodesState
nodesStateMVar RTViewParams
params [RemoteAddrNamed]
acceptors

  IO (Async (), ()) -> IO ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (IO (Async (), ()) -> IO ()) -> IO (Async (), ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ [Async ()] -> IO (Async (), ())
forall a. [Async a] -> IO (Async a, a)
waitAnyCancel [Async ()
acceptorThr, Async ()
updaterThr, Async ()
serverThr]