-- | Compact measurements of current state. Sampling these instead of counting
-- transitions keeps gauges correct after replay, side-loading and rollbacks.
module Hydra.Node.Stats where

import Hydra.Prelude

import Data.Map.Strict qualified as Map
import Hydra.HeadLogic.State
import Hydra.Node.State
import Hydra.Tx (HeadParameters (..), IsTx (..), Snapshot (..), getSnapshot)

data NodeStats = NodeStats
  { NodeStats -> Bool
synchronized :: Bool
  , NodeStats -> Text
phase :: Text
  , NodeStats -> Natural
queuedInputs :: Natural
  , NodeStats -> Int
parkedInputs :: Int
  , NodeStats -> Natural
confirmedNumber :: Natural
  , NodeStats -> Bool
snapshotPending :: Bool
  , NodeStats -> Int
missingSignatures :: Int
  , NodeStats -> Int
pendingTransactions :: Int
  , NodeStats -> Int
inactiveDeposits :: Int
  , NodeStats -> Int
activeDeposits :: Int
  , NodeStats -> Int
expiredDeposits :: Int
  , NodeStats -> Text
decommitState :: Text
  , NodeStats -> Int
fanoutRemainingOutputs :: Int
  , NodeStats -> Text
fanoutMode :: Text
  }
  deriving stock (NodeStats -> NodeStats -> Bool
(NodeStats -> NodeStats -> Bool)
-> (NodeStats -> NodeStats -> Bool) -> Eq NodeStats
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: NodeStats -> NodeStats -> Bool
== :: NodeStats -> NodeStats -> Bool
$c/= :: NodeStats -> NodeStats -> Bool
/= :: NodeStats -> NodeStats -> Bool
Eq, Int -> NodeStats -> ShowS
[NodeStats] -> ShowS
NodeStats -> String
(Int -> NodeStats -> ShowS)
-> (NodeStats -> String)
-> ([NodeStats] -> ShowS)
-> Show NodeStats
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> NodeStats -> ShowS
showsPrec :: Int -> NodeStats -> ShowS
$cshow :: NodeStats -> String
show :: NodeStats -> String
$cshowList :: [NodeStats] -> ShowS
showList :: [NodeStats] -> ShowS
Show, (forall x. NodeStats -> Rep NodeStats x)
-> (forall x. Rep NodeStats x -> NodeStats) -> Generic NodeStats
forall x. Rep NodeStats x -> NodeStats
forall x. NodeStats -> Rep NodeStats x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. NodeStats -> Rep NodeStats x
from :: forall x. NodeStats -> Rep NodeStats x
$cto :: forall x. Rep NodeStats x -> NodeStats
to :: forall x. Rep NodeStats x -> NodeStats
Generic)
  deriving anyclass ([NodeStats] -> Value
[NodeStats] -> Encoding
NodeStats -> Bool
NodeStats -> Value
NodeStats -> Encoding
(NodeStats -> Value)
-> (NodeStats -> Encoding)
-> ([NodeStats] -> Value)
-> ([NodeStats] -> Encoding)
-> (NodeStats -> Bool)
-> ToJSON NodeStats
forall a.
(a -> Value)
-> (a -> Encoding)
-> ([a] -> Value)
-> ([a] -> Encoding)
-> (a -> Bool)
-> ToJSON a
$ctoJSON :: NodeStats -> Value
toJSON :: NodeStats -> Value
$ctoEncoding :: NodeStats -> Encoding
toEncoding :: NodeStats -> Encoding
$ctoJSONList :: [NodeStats] -> Value
toJSONList :: [NodeStats] -> Value
$ctoEncodingList :: [NodeStats] -> Encoding
toEncodingList :: [NodeStats] -> Encoding
$comitField :: NodeStats -> Bool
omitField :: NodeStats -> Bool
ToJSON)

nodeStats :: IsTx tx => Natural -> Int -> NodeState tx -> NodeStats
nodeStats :: forall tx. IsTx tx => Natural -> Int -> NodeState tx -> NodeStats
nodeStats Natural
queuedInputs Int
parkedInputs NodeState tx
ns =
  case NodeState tx -> HeadState tx
forall tx. NodeState tx -> HeadState tx
headState NodeState tx
ns of
    Idle{} -> NodeStats
base
    Open OpenState{$sel:parameters:OpenState :: forall tx. OpenState tx -> HeadParameters
parameters = HeadParameters{[Party]
parties :: [Party]
$sel:parties:HeadParameters :: HeadParameters -> [Party]
parties}, $sel:coordinatedHeadState:OpenState :: forall tx. OpenState tx -> CoordinatedHeadState tx
coordinatedHeadState = CoordinatedHeadState{ConfirmedSnapshot tx
confirmedSnapshot :: ConfirmedSnapshot tx
$sel:confirmedSnapshot:CoordinatedHeadState :: forall tx. CoordinatedHeadState tx -> ConfirmedSnapshot tx
confirmedSnapshot, SeenSnapshot tx
seenSnapshot :: SeenSnapshot tx
$sel:seenSnapshot:CoordinatedHeadState :: forall tx. CoordinatedHeadState tx -> SeenSnapshot tx
seenSnapshot, Map (TxIdType tx) tx
allTxs :: Map (TxIdType tx) tx
$sel:allTxs:CoordinatedHeadState :: forall tx. CoordinatedHeadState tx -> Map (TxIdType tx) tx
allTxs, Maybe tx
decommitTx :: Maybe tx
$sel:decommitTx:CoordinatedHeadState :: forall tx. CoordinatedHeadState tx -> Maybe tx
decommitTx, $sel:version:CoordinatedHeadState :: forall tx. CoordinatedHeadState tx -> SnapshotVersion
version = SnapshotVersion
coordinatedVersion}} ->
      let snap :: Snapshot tx
snap@Snapshot{$sel:version:Snapshot :: forall tx. Snapshot tx -> SnapshotVersion
version = SnapshotVersion
snapshotVersion} = ConfirmedSnapshot tx -> Snapshot tx
forall tx. IsTx tx => ConfirmedSnapshot tx -> Snapshot tx
getSnapshot ConfirmedSnapshot tx
confirmedSnapshot
          missing :: Int
missing = case SeenSnapshot tx
seenSnapshot of
            SeenSnapshot{Map Party (Signature (Snapshot tx))
signatories :: Map Party (Signature (Snapshot tx))
$sel:signatories:NoSeenSnapshot :: forall tx. SeenSnapshot tx -> Map Party (Signature (Snapshot tx))
signatories} -> Int -> Int -> Int
forall a. Ord a => a -> a -> a
max Int
0 ([Party] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [Party]
parties Int -> Int -> Int
forall a. Num a => a -> a -> a
- Map Party (Signature (Snapshot tx)) -> Int
forall k a. Map k a -> Int
Map.size Map Party (Signature (Snapshot tx))
signatories)
            RequestedSnapshot{} -> [Party] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [Party]
parties
            SeenSnapshot tx
_ -> Int
0
          dc :: Text
dc
            | SnapshotVersion
snapshotVersion SnapshotVersion -> SnapshotVersion -> Bool
forall a. Eq a => a -> a -> Bool
== SnapshotVersion
coordinatedVersion Bool -> Bool -> Bool
&& Maybe (UTxOType tx) -> Bool
forall a. Maybe a -> Bool
isJust (Snapshot tx -> Maybe (UTxOType tx)
forall tx. Snapshot tx -> Maybe (UTxOType tx)
utxoToDecommit Snapshot tx
snap) = Text
"approved"
            | Maybe tx -> Bool
forall a. Maybe a -> Bool
isJust Maybe tx
decommitTx = Text
"requested"
            | Bool
otherwise = Text
"none"
       in (Snapshot tx -> NodeStats -> NodeStats
forall tx. Snapshot tx -> NodeStats -> NodeStats
withSnapshot Snapshot tx
snap NodeStats
base)
            { phase = "open"
            , snapshotPending = snapshotInFlight seenSnapshot
            , missingSignatures = missing
            , pendingTransactions = Map.size allTxs
            , decommitState = dc
            }
    Closed ClosedState{ConfirmedSnapshot tx
confirmedSnapshot :: ConfirmedSnapshot tx
$sel:confirmedSnapshot:ClosedState :: forall tx. ClosedState tx -> ConfirmedSnapshot tx
confirmedSnapshot} ->
      (Snapshot tx -> NodeStats -> NodeStats
forall tx. Snapshot tx -> NodeStats -> NodeStats
withSnapshot (ConfirmedSnapshot tx -> Snapshot tx
forall tx. IsTx tx => ConfirmedSnapshot tx -> Snapshot tx
getSnapshot ConfirmedSnapshot tx
confirmedSnapshot) NodeStats
base)
        { phase = "closed"
        }
    FanoutProgress PartialFanoutState{ConfirmedSnapshot tx
confirmedSnapshot :: ConfirmedSnapshot tx
$sel:confirmedSnapshot:PartialFanoutState :: forall tx. PartialFanoutState tx -> ConfirmedSnapshot tx
confirmedSnapshot, UTxOType tx
remainingOutputs :: UTxOType tx
$sel:remainingOutputs:PartialFanoutState :: forall tx. PartialFanoutState tx -> UTxOType tx
remainingOutputs, FanoutMode tx
mode :: FanoutMode tx
$sel:mode:PartialFanoutState :: forall tx. PartialFanoutState tx -> FanoutMode tx
mode} ->
      (Snapshot tx -> NodeStats -> NodeStats
forall tx. Snapshot tx -> NodeStats -> NodeStats
withSnapshot (ConfirmedSnapshot tx -> Snapshot tx
forall tx. IsTx tx => ConfirmedSnapshot tx -> Snapshot tx
getSnapshot ConfirmedSnapshot tx
confirmedSnapshot) NodeStats
base)
        { phase = "fanout"
        , fanoutRemainingOutputs = length $ outputsOfUTxO remainingOutputs
        , fanoutMode = case mode of
            FanoutMode tx
AutoDrain -> Text
"automatic"
            DistributingSelection{} -> Text
"selected"
            FanoutMode tx
AwaitingSelection -> Text
"deferred"
        }
 where
  pending :: [Deposit tx]
pending = Map (TxIdType tx) (Deposit tx) -> [Deposit tx]
forall k a. Map k a -> [a]
Map.elems (Map (TxIdType tx) (Deposit tx) -> [Deposit tx])
-> Map (TxIdType tx) (Deposit tx) -> [Deposit tx]
forall a b. (a -> b) -> a -> b
$ NodeState tx -> Map (TxIdType tx) (Deposit tx)
forall tx. NodeState tx -> PendingDeposits tx
pendingDeposits NodeState tx
ns
  count :: DepositStatus -> Int
count DepositStatus
status' = [Deposit tx] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length ([Deposit tx] -> Int) -> [Deposit tx] -> Int
forall a b. (a -> b) -> a -> b
$ (Deposit tx -> Bool) -> [Deposit tx] -> [Deposit tx]
forall a. (a -> Bool) -> [a] -> [a]
filter (\Deposit{DepositStatus
status :: DepositStatus
$sel:status:Deposit :: forall tx. Deposit tx -> DepositStatus
status} -> DepositStatus
status DepositStatus -> DepositStatus -> Bool
forall a. Eq a => a -> a -> Bool
== DepositStatus
status') [Deposit tx]
pending
  withSnapshot :: Snapshot tx -> NodeStats -> NodeStats
  withSnapshot :: forall tx. Snapshot tx -> NodeStats -> NodeStats
withSnapshot Snapshot{SnapshotNumber
number :: SnapshotNumber
$sel:number:Snapshot :: forall tx. Snapshot tx -> SnapshotNumber
number} NodeStats
st = NodeStats
st{confirmedNumber = fromIntegral number}
  base :: NodeStats
base =
    NodeStats
      { $sel:synchronized:NodeStats :: Bool
synchronized = case NodeState tx
ns of NodeInSync{} -> Bool
True; NodeCatchingUp{} -> Bool
False
      , $sel:phase:NodeStats :: Text
phase = Text
"idle"
      , Natural
$sel:queuedInputs:NodeStats :: Natural
queuedInputs :: Natural
queuedInputs
      , Int
$sel:parkedInputs:NodeStats :: Int
parkedInputs :: Int
parkedInputs
      , $sel:confirmedNumber:NodeStats :: Natural
confirmedNumber = Natural
0
      , $sel:snapshotPending:NodeStats :: Bool
snapshotPending = Bool
False
      , $sel:missingSignatures:NodeStats :: Int
missingSignatures = Int
0
      , $sel:pendingTransactions:NodeStats :: Int
pendingTransactions = Int
0
      , $sel:inactiveDeposits:NodeStats :: Int
inactiveDeposits = DepositStatus -> Int
count DepositStatus
Inactive
      , $sel:activeDeposits:NodeStats :: Int
activeDeposits = DepositStatus -> Int
count DepositStatus
Active
      , $sel:expiredDeposits:NodeStats :: Int
expiredDeposits = DepositStatus -> Int
count DepositStatus
Expired
      , $sel:decommitState:NodeStats :: Text
decommitState = Text
"none"
      , $sel:fanoutRemainingOutputs:NodeStats :: Int
fanoutRemainingOutputs = Int
0
      , $sel:fanoutMode:NodeStats :: Text
fanoutMode = Text
"none"
      }