{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE LambdaCase #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE TypeFamilies #-}
{-# LANGUAGE UndecidableInstances #-}

{-# OPTIONS_GHC -Wno-orphans  #-}
{-# OPTIONS_GHC -Wno-deprecations  #-}

module Cardano.Node.Tracing.Tracers.KESInfo
  ( severityKESInfo
  , namesForKESInfo
  , traceAsKESInfo
  , docForgeKESInfo
  ) where

import           Data.SOP.Strict

import           Cardano.Logging
import           Cardano.Prelude hiding (All, Show, show)

import           Cardano.Node.Queries (GetKESInfo (..))
import           Cardano.Protocol.TPraos.OCert (KESPeriod (..))

import           Ouroboros.Consensus.Block.Forging
import           Ouroboros.Consensus.Node.Tracers (TraceLabelCreds (..))
import qualified Ouroboros.Consensus.Protocol.Ledger.HotKey as HotKey

traceAsKESInfo
  :: forall m blk . (GetKESInfo blk, MonadIO m)
  => Proxy blk
  -> Trace m (TraceLabelCreds HotKey.KESInfo)
  -> Trace m (TraceLabelCreds (ForgeStateInfo blk))
traceAsKESInfo :: Proxy blk
-> Trace m (TraceLabelCreds KESInfo)
-> Trace m (TraceLabelCreds (ForgeStateInfo blk))
traceAsKESInfo Proxy blk
pr Trace m (TraceLabelCreds KESInfo)
tr = Proxy blk
-> Trace m (Maybe (TraceLabelCreds KESInfo))
-> Trace m (TraceLabelCreds (ForgeStateInfo blk))
forall (m :: * -> *) blk.
(GetKESInfo blk, MonadIO m) =>
Proxy blk
-> Trace m (Maybe (TraceLabelCreds KESInfo))
-> Trace m (TraceLabelCreds (ForgeStateInfo blk))
traceAsMaybeKESInfo Proxy blk
pr (Trace m (TraceLabelCreds KESInfo)
-> Trace m (Maybe (TraceLabelCreds KESInfo))
forall (m :: * -> *) a. Monad m => Trace m a -> Trace m (Maybe a)
filterTraceMaybe Trace m (TraceLabelCreds KESInfo)
tr)

traceAsMaybeKESInfo
  :: forall m blk . (GetKESInfo blk, MonadIO m)
  => Proxy blk
  -> Trace m (Maybe (TraceLabelCreds HotKey.KESInfo))
  -> Trace m (TraceLabelCreds (ForgeStateInfo blk))
traceAsMaybeKESInfo :: Proxy blk
-> Trace m (Maybe (TraceLabelCreds KESInfo))
-> Trace m (TraceLabelCreds (ForgeStateInfo blk))
traceAsMaybeKESInfo Proxy blk
pr (Trace Tracer
  m
  (LoggingContext,
   Either TraceControl (Maybe (TraceLabelCreds KESInfo)))
tr) = Tracer
  m
  (LoggingContext,
   Either TraceControl (TraceLabelCreds (ForgeStateInfo blk)))
-> Trace m (TraceLabelCreds (ForgeStateInfo blk))
forall (m :: * -> *) a.
Tracer m (LoggingContext, Either TraceControl a) -> Trace m a
Trace (Tracer
   m
   (LoggingContext,
    Either TraceControl (TraceLabelCreds (ForgeStateInfo blk)))
 -> Trace m (TraceLabelCreds (ForgeStateInfo blk)))
-> Tracer
     m
     (LoggingContext,
      Either TraceControl (TraceLabelCreds (ForgeStateInfo blk)))
-> Trace m (TraceLabelCreds (ForgeStateInfo blk))
forall a b. (a -> b) -> a -> b
$
  ((LoggingContext,
  Either TraceControl (TraceLabelCreds (ForgeStateInfo blk)))
 -> (LoggingContext,
     Either TraceControl (Maybe (TraceLabelCreds KESInfo))))
-> Tracer
     m
     (LoggingContext,
      Either TraceControl (Maybe (TraceLabelCreds KESInfo)))
-> Tracer
     m
     (LoggingContext,
      Either TraceControl (TraceLabelCreds (ForgeStateInfo blk)))
forall (f :: * -> *) a b. Contravariant f => (a -> b) -> f b -> f a
contramap
        (\case
          (LoggingContext
lc, Right (TraceLabelCreds Text
c ForgeStateInfo blk
e)) ->
            case Proxy blk -> ForgeStateInfo blk -> Maybe KESInfo
forall blk.
GetKESInfo blk =>
Proxy blk -> ForgeStateInfo blk -> Maybe KESInfo
getKESInfoFromStateInfo Proxy blk
pr ForgeStateInfo blk
e of
              Just KESInfo
kesi -> (LoggingContext
lc, Maybe (TraceLabelCreds KESInfo)
-> Either TraceControl (Maybe (TraceLabelCreds KESInfo))
forall a b. b -> Either a b
Right (TraceLabelCreds KESInfo -> Maybe (TraceLabelCreds KESInfo)
forall a. a -> Maybe a
Just (Text -> KESInfo -> TraceLabelCreds KESInfo
forall a. Text -> a -> TraceLabelCreds a
TraceLabelCreds Text
c KESInfo
kesi)))
              Maybe KESInfo
Nothing   -> (LoggingContext
lc, Maybe (TraceLabelCreds KESInfo)
-> Either TraceControl (Maybe (TraceLabelCreds KESInfo))
forall a b. b -> Either a b
Right Maybe (TraceLabelCreds KESInfo)
forall a. Maybe a
Nothing)
          (LoggingContext
lc, Left TraceControl
ctrl) -> (LoggingContext
lc, TraceControl
-> Either TraceControl (Maybe (TraceLabelCreds KESInfo))
forall a b. a -> Either a b
Left TraceControl
ctrl))
        Tracer
  m
  (LoggingContext,
   Either TraceControl (Maybe (TraceLabelCreds KESInfo)))
tr

--------------------------------------------------------------------------------
-- KESInfo Tracer
--------------------------------------------------------------------------------

severityKESInfo :: TraceLabelCreds HotKey.KESInfo -> SeverityS
severityKESInfo :: TraceLabelCreds KESInfo -> SeverityS
severityKESInfo (TraceLabelCreds Text
_creds KESInfo
a) = KESInfo -> SeverityS
severityKESInfo'  KESInfo
a

severityKESInfo' :: HotKey.KESInfo -> SeverityS
severityKESInfo' :: KESInfo -> SeverityS
severityKESInfo' KESInfo
forgeStateInfo =
    let maxKesEvos :: Word
maxKesEvos = Word
endKesPeriod Word -> Word -> Word
forall a. Num a => a -> a -> a
- Word
startKesPeriod
        oCertExpiryKesPeriod :: Word
oCertExpiryKesPeriod = Word
startKesPeriod Word -> Word -> Word
forall a. Num a => a -> a -> a
+ Word
maxKesEvos
        kesPeriodsUntilExpiry :: Word
kesPeriodsUntilExpiry = Word -> Word -> Word
forall a. Ord a => a -> a -> a
max Word
0 (Word
oCertExpiryKesPeriod Word -> Word -> Word
forall a. Num a => a -> a -> a
- Word
currKesPeriod)
    in if Word
kesPeriodsUntilExpiry Word -> Word -> Bool
forall a. Ord a => a -> a -> Bool
> Word
7
      then SeverityS
Info
      else if Word
kesPeriodsUntilExpiry Word -> Word -> Bool
forall a. Ord a => a -> a -> Bool
<= Word
1
        then SeverityS
Alert
        else SeverityS
Warning
    where
    HotKey.KESInfo
      { kesStartPeriod :: KESInfo -> KESPeriod
HotKey.kesStartPeriod = KESPeriod Word
startKesPeriod
      , kesEvolution :: KESInfo -> Word
HotKey.kesEvolution = Word
currKesPeriod
      , kesEndPeriod :: KESInfo -> KESPeriod
HotKey.kesEndPeriod = KESPeriod Word
endKesPeriod
      } = KESInfo
forgeStateInfo

namesForKESInfo :: TraceLabelCreds HotKey.KESInfo -> [Text]
namesForKESInfo :: TraceLabelCreds KESInfo -> [Text]
namesForKESInfo (TraceLabelCreds Text
_creds KESInfo
a) = KESInfo -> [Text]
namesForKESInfo' KESInfo
a

namesForKESInfo' :: HotKey.KESInfo -> [Text]
namesForKESInfo' :: KESInfo -> [Text]
namesForKESInfo' KESInfo
_fsi = []

docForgeKESInfo :: Documented (TraceLabelCreds HotKey.KESInfo)
docForgeKESInfo :: Documented (TraceLabelCreds KESInfo)
docForgeKESInfo = [DocMsg (TraceLabelCreds KESInfo)]
-> Documented (TraceLabelCreds KESInfo)
forall a. [DocMsg a] -> Documented a
Documented [
    [Text]
-> [(Text, Text)] -> Text -> DocMsg (TraceLabelCreds KESInfo)
forall a. [Text] -> [(Text, Text)] -> Text -> DocMsg a
DocMsg
      []
      []
      Text
"kesStartPeriod \
      \\nkesEndPeriod is kesStartPeriod + tpraosMaxKESEvo\
      \\nkesEvolution is the current evolution or /relative period/."
    ]