{-# LANGUAGE LambdaCase #-}
{-# LANGUAGE NamedFieldPuns #-}
{-# LANGUAGE OverloadedStrings #-}
{-# OPTIONS_GHC -Wno-orphans #-}

-- | How the LeiosDB's events are logged.
module Ouroboros.Consensus.Tracing.LeiosDB () where

import Cardano.Logging
import Data.Aeson (Value (String), (.=))
import qualified Data.Text as Text
import Ouroboros.Consensus.Storage.LeiosDB.Trace (LeiosDbStats (..), TraceLeiosDb (..))

instance LogFormatting TraceLeiosDb where
  forMachine :: DetailLevel -> TraceLeiosDb -> Object
forMachine DetailLevel
_dtal = \case
    TraceLeiosDbInsertCollision [Char]
table [Char]
key ->
      [Object] -> Object
forall a. Monoid a => [a] -> a
mconcat [Key
"kind" Key -> Value -> Object
forall v. ToJSON v => Key -> v -> Object
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= Text -> Value
String Text
"LeiosDbInsertCollision", Key
"table" Key -> [Char] -> Object
forall v. ToJSON v => Key -> v -> Object
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= [Char]
table, Key
"key" Key -> [Char] -> Object
forall v. ToJSON v => Key -> v -> Object
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= [Char]
key]
    TraceLeiosDbWriterQueueFull [Char]
job ->
      [Object] -> Object
forall a. Monoid a => [a] -> a
mconcat [Key
"kind" Key -> Value -> Object
forall v. ToJSON v => Key -> v -> Object
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= Text -> Value
String Text
"LeiosDbWriterQueueFull", Key
"job" Key -> [Char] -> Object
forall v. ToJSON v => Key -> v -> Object
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= [Char]
job]
    TraceLeiosDbWriteAbandoned [Char]
job ->
      [Object] -> Object
forall a. Monoid a => [a] -> a
mconcat [Key
"kind" Key -> Value -> Object
forall v. ToJSON v => Key -> v -> Object
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= Text -> Value
String Text
"LeiosDbWriteAbandoned", Key
"job" Key -> [Char] -> Object
forall v. ToJSON v => Key -> v -> Object
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= [Char]
job]
    TraceLeiosDbWriteJobDone [Char]
job ->
      [Object] -> Object
forall a. Monoid a => [a] -> a
mconcat [Key
"kind" Key -> Value -> Object
forall v. ToJSON v => Key -> v -> Object
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= Text -> Value
String Text
"LeiosDbWriteJobDone", Key
"job" Key -> [Char] -> Object
forall v. ToJSON v => Key -> v -> Object
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= [Char]
job]
    TraceLeiosDbStats LeiosDbStats{Int
volatileEbs :: Int
volatileEbs :: LeiosDbStats -> Int
volatileEbs, Int
immutableEbs :: Int
immutableEbs :: LeiosDbStats -> Int
immutableEbs, Integer
walBytes :: Integer
walBytes :: LeiosDbStats -> Integer
walBytes} ->
      [Object] -> Object
forall a. Monoid a => [a] -> a
mconcat
        [ Key
"kind" Key -> Value -> Object
forall v. ToJSON v => Key -> v -> Object
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= Text -> Value
String Text
"LeiosDbStats"
        , Key
"volatileEbs" Key -> Int -> Object
forall v. ToJSON v => Key -> v -> Object
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= Int
volatileEbs
        , Key
"immutableEbs" Key -> Int -> Object
forall v. ToJSON v => Key -> v -> Object
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= Int
immutableEbs
        , Key
"walBytes" Key -> Integer -> Object
forall v. ToJSON v => Key -> v -> Object
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= Integer
walBytes
        ]
    TraceLeiosDbCopiedToImmutable Int
copiedEbs ->
      [Object] -> Object
forall a. Monoid a => [a] -> a
mconcat [Key
"kind" Key -> Value -> Object
forall v. ToJSON v => Key -> v -> Object
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= Text -> Value
String Text
"LeiosDbCopiedToImmutable", Key
"copiedEbs" Key -> Int -> Object
forall v. ToJSON v => Key -> v -> Object
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= Int
copiedEbs]
    TraceLeiosDbEvicted Int
evictedEbs ->
      [Object] -> Object
forall a. Monoid a => [a] -> a
mconcat [Key
"kind" Key -> Value -> Object
forall v. ToJSON v => Key -> v -> Object
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= Text -> Value
String Text
"LeiosDbEvicted", Key
"evictedEbs" Key -> Int -> Object
forall v. ToJSON v => Key -> v -> Object
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= Int
evictedEbs]
    TraceLeiosDbGCError [Char]
reason ->
      [Object] -> Object
forall a. Monoid a => [a] -> a
mconcat [Key
"kind" Key -> Value -> Object
forall v. ToJSON v => Key -> v -> Object
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= Text -> Value
String Text
"LeiosDbSweepError", Key
"reason" Key -> [Char] -> Object
forall v. ToJSON v => Key -> v -> Object
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= [Char]
reason]
    TraceLeiosDbCopyError [Char]
ebHash [Char]
reason ->
      [Object] -> Object
forall a. Monoid a => [a] -> a
mconcat [Key
"kind" Key -> Value -> Object
forall v. ToJSON v => Key -> v -> Object
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= Text -> Value
String Text
"LeiosDbCopyError", Key
"ebHash" Key -> [Char] -> Object
forall v. ToJSON v => Key -> v -> Object
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= [Char]
ebHash, Key
"reason" Key -> [Char] -> Object
forall v. ToJSON v => Key -> v -> Object
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= [Char]
reason]

  forHuman :: TraceLeiosDb -> Text
forHuman = \case
    TraceLeiosDbInsertCollision [Char]
table [Char]
key ->
      Text
"Ignored a row already in the LeiosDB's " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> [Char] -> Text
Text.pack [Char]
table Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
" table: " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> [Char] -> Text
Text.pack [Char]
key
    TraceLeiosDbWriterQueueFull [Char]
job ->
      Text
"A LeiosDB write waited for room in the writer's queue: " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> [Char] -> Text
Text.pack [Char]
job
    TraceLeiosDbWriteAbandoned [Char]
job ->
      Text
"A LeiosDB write was lost while waiting for room in the writer's queue: " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> [Char] -> Text
Text.pack [Char]
job
    TraceLeiosDbWriteJobDone [Char]
job ->
      Text
"The LeiosDB writer ran " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> [Char] -> Text
Text.pack [Char]
job
    TraceLeiosDbStats LeiosDbStats{Int
volatileEbs :: LeiosDbStats -> Int
volatileEbs :: Int
volatileEbs, Int
immutableEbs :: LeiosDbStats -> Int
immutableEbs :: Int
immutableEbs, Integer
walBytes :: LeiosDbStats -> Integer
walBytes :: Integer
walBytes} ->
      Text
"The LeiosDB holds "
        Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Int -> Text
forall a. Show a => a -> Text
showT Int
volatileEbs
        Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
" EB rows in its volatile partition and "
        Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Int -> Text
forall a. Show a => a -> Text
showT Int
immutableEbs
        Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
" EBs in its immutable partition, with a "
        Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Integer -> Text
forall a. Show a => a -> Text
showT Integer
walBytes
        Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
" byte write-ahead log"
    TraceLeiosDbCopiedToImmutable Int
copiedEbs ->
      Text
"Copied " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Int -> Text
forall a. Show a => a -> Text
showT Int
copiedEbs Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
" EBs to the LeiosDB's immutable partition"
    TraceLeiosDbEvicted Int
evictedEbs ->
      Text
"Evicted " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Int -> Text
forall a. Show a => a -> Text
showT Int
evictedEbs Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
" EB rows from the LeiosDB's volatile partition"
    TraceLeiosDbGCError [Char]
reason ->
      Text
"A LeiosDB sweep pass failed and will be retried: " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> [Char] -> Text
Text.pack [Char]
reason
    TraceLeiosDbCopyError [Char]
ebHash [Char]
reason ->
      Text
"Copying EB "
        Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> [Char] -> Text
Text.pack [Char]
ebHash
        Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
" to the LeiosDB's immutable partition failed and will be retried: "
        Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> [Char] -> Text
Text.pack [Char]
reason

  asMetrics :: TraceLeiosDb -> [Metric]
asMetrics = \case
    TraceLeiosDbStats LeiosDbStats{Int
volatileEbs :: LeiosDbStats -> Int
volatileEbs :: Int
volatileEbs, Int
immutableEbs :: LeiosDbStats -> Int
immutableEbs :: Int
immutableEbs, Integer
walBytes :: LeiosDbStats -> Integer
walBytes :: Integer
walBytes} ->
      [ Text -> Integer -> Metric
IntM Text
"leiosDbVolatileEbs" (Int -> Integer
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
volatileEbs)
      , Text -> Integer -> Metric
IntM Text
"leiosDbImmutableEbs" (Int -> Integer
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
immutableEbs)
      , Text -> Integer -> Metric
IntM Text
"leiosDbWalBytes" Integer
walBytes
      ]
    TraceLeiosDbCopiedToImmutable Int
copiedEbs ->
      [Text -> Maybe Int -> Metric
CounterM Text
"leiosDbCopiedEbs" (Int -> Maybe Int
forall a. a -> Maybe a
Just Int
copiedEbs)]
    TraceLeiosDbEvicted Int
evictedEbs ->
      [Text -> Maybe Int -> Metric
CounterM Text
"leiosDbEvictedEbs" (Int -> Maybe Int
forall a. a -> Maybe a
Just Int
evictedEbs)]
    TraceLeiosDbGCError{} ->
      [Text -> Maybe Int -> Metric
CounterM Text
"leiosDbSweepErrors" (Int -> Maybe Int
forall a. a -> Maybe a
Just Int
1)]
    TraceLeiosDbCopyError{} ->
      [Text -> Maybe Int -> Metric
CounterM Text
"leiosDbCopyErrors" (Int -> Maybe Int
forall a. a -> Maybe a
Just Int
1)]
    TraceLeiosDbWriteAbandoned{} ->
      [Text -> Maybe Int -> Metric
CounterM Text
"leiosDbWritesAbandoned" (Int -> Maybe Int
forall a. a -> Maybe a
Just Int
1)]
    TraceLeiosDbInsertCollision{} -> []
    TraceLeiosDbWriterQueueFull{} -> []
    TraceLeiosDbWriteJobDone{} -> []

instance MetaTrace TraceLeiosDb where
  namespaceFor :: TraceLeiosDb -> Namespace TraceLeiosDb
namespaceFor = \case
    TraceLeiosDbInsertCollision{} -> [Text] -> [Text] -> Namespace TraceLeiosDb
forall a. [Text] -> [Text] -> Namespace a
Namespace [] [Text
"InsertCollision"]
    TraceLeiosDbWriterQueueFull{} -> [Text] -> [Text] -> Namespace TraceLeiosDb
forall a. [Text] -> [Text] -> Namespace a
Namespace [] [Text
"WriterQueueFull"]
    TraceLeiosDbWriteAbandoned{} -> [Text] -> [Text] -> Namespace TraceLeiosDb
forall a. [Text] -> [Text] -> Namespace a
Namespace [] [Text
"WriteAbandoned"]
    TraceLeiosDbWriteJobDone{} -> [Text] -> [Text] -> Namespace TraceLeiosDb
forall a. [Text] -> [Text] -> Namespace a
Namespace [] [Text
"WriteJobDone"]
    TraceLeiosDbStats{} -> [Text] -> [Text] -> Namespace TraceLeiosDb
forall a. [Text] -> [Text] -> Namespace a
Namespace [] [Text
"Stats"]
    TraceLeiosDbCopiedToImmutable{} -> [Text] -> [Text] -> Namespace TraceLeiosDb
forall a. [Text] -> [Text] -> Namespace a
Namespace [] [Text
"Copied"]
    TraceLeiosDbEvicted{} -> [Text] -> [Text] -> Namespace TraceLeiosDb
forall a. [Text] -> [Text] -> Namespace a
Namespace [] [Text
"Evicted"]
    TraceLeiosDbGCError{} -> [Text] -> [Text] -> Namespace TraceLeiosDb
forall a. [Text] -> [Text] -> Namespace a
Namespace [] [Text
"SweepError"]
    TraceLeiosDbCopyError{} -> [Text] -> [Text] -> Namespace TraceLeiosDb
forall a. [Text] -> [Text] -> Namespace a
Namespace [] [Text
"CopyError"]

  severityFor :: Namespace TraceLeiosDb -> Maybe TraceLeiosDb -> Maybe SeverityS
severityFor (Namespace [Text]
_ [Text
"InsertCollision"]) Maybe TraceLeiosDb
_ = SeverityS -> Maybe SeverityS
forall a. a -> Maybe a
Just SeverityS
Info
  severityFor (Namespace [Text]
_ [Text
"WriterQueueFull"]) Maybe TraceLeiosDb
_ = SeverityS -> Maybe SeverityS
forall a. a -> Maybe a
Just SeverityS
Info
  severityFor (Namespace [Text]
_ [Text
"WriteAbandoned"]) Maybe TraceLeiosDb
_ = SeverityS -> Maybe SeverityS
forall a. a -> Maybe a
Just SeverityS
Warning
  severityFor (Namespace [Text]
_ [Text
"WriteJobDone"]) Maybe TraceLeiosDb
_ = SeverityS -> Maybe SeverityS
forall a. a -> Maybe a
Just SeverityS
Debug
  severityFor (Namespace [Text]
_ [Text
"Stats"]) Maybe TraceLeiosDb
_ = SeverityS -> Maybe SeverityS
forall a. a -> Maybe a
Just SeverityS
Info
  severityFor (Namespace [Text]
_ [Text
"Copied"]) Maybe TraceLeiosDb
_ = SeverityS -> Maybe SeverityS
forall a. a -> Maybe a
Just SeverityS
Info
  severityFor (Namespace [Text]
_ [Text
"Evicted"]) Maybe TraceLeiosDb
_ = SeverityS -> Maybe SeverityS
forall a. a -> Maybe a
Just SeverityS
Info
  severityFor (Namespace [Text]
_ [Text
"SweepError"]) Maybe TraceLeiosDb
_ = SeverityS -> Maybe SeverityS
forall a. a -> Maybe a
Just SeverityS
Warning
  severityFor (Namespace [Text]
_ [Text
"CopyError"]) Maybe TraceLeiosDb
_ = SeverityS -> Maybe SeverityS
forall a. a -> Maybe a
Just SeverityS
Warning
  severityFor Namespace TraceLeiosDb
_ Maybe TraceLeiosDb
_ = Maybe SeverityS
forall a. Maybe a
Nothing

  documentFor :: Namespace TraceLeiosDb -> Maybe Text
documentFor (Namespace [Text]
_ [Text
"InsertCollision"]) =
    Text -> Maybe Text
forall a. a -> Maybe a
Just Text
"An insert found its row already present, and left it as it was."
  documentFor (Namespace [Text]
_ [Text
"WriterQueueFull"]) =
    Text -> Maybe Text
forall a. a -> Maybe a
Just
      Text
"A write had to wait for room in the writer's queue: the writer is the bottleneck, and every producer is now behind it."
  documentFor (Namespace [Text]
_ [Text
"WriteAbandoned"]) =
    Text -> Maybe Text
forall a. a -> Maybe a
Just
      Text
"The submitting thread died while waiting for room in the writer's queue, so its write is lost."
  documentFor (Namespace [Text]
_ [Text
"WriteJobDone"]) =
    Text -> Maybe Text
forall a. a -> Maybe a
Just Text
"The writer ran a job."
  documentFor (Namespace [Text]
_ [Text
"Stats"]) =
    Text -> Maybe Text
forall a. a -> Maybe a
Just Text
"The sizes of the two partitions, sampled on a timer."
  documentFor (Namespace [Text]
_ [Text
"Copied"]) =
    Text -> Maybe Text
forall a. a -> Maybe a
Just Text
"The copier committed EBs' closures to the immutable partition."
  documentFor (Namespace [Text]
_ [Text
"Evicted"]) =
    Text -> Maybe Text
forall a. a -> Maybe a
Just Text
"A sweep pass evicted EB announcement rows from the volatile partition."
  documentFor (Namespace [Text]
_ [Text
"SweepError"]) =
    Text -> Maybe Text
forall a. a -> Maybe a
Just Text
"A sweep pass failed. It is retried."
  documentFor (Namespace [Text]
_ [Text
"CopyError"]) =
    Text -> Maybe Text
forall a. a -> Maybe a
Just Text
"Copying an EB failed. It stays pinned, so it is still the next one to copy."
  documentFor Namespace TraceLeiosDb
_ = Maybe Text
forall a. Maybe a
Nothing

  metricsDocFor :: Namespace TraceLeiosDb -> [(Text, Text)]
metricsDocFor (Namespace [Text]
_ [Text
"Stats"]) =
    [
      ( Text
"leiosDbVolatileEbs"
      , Text
"EB announcement rows in the volatile partition. An EB copied but not yet evicted counts in both partitions."
      )
    , (Text
"leiosDbImmutableEbs", Text
"EBs in the immutable partition")
    , (Text
"leiosDbWalBytes", Text
"The size of the volatile partition's write-ahead log, in bytes")
    ]
  metricsDocFor (Namespace [Text]
_ [Text
"Copied"]) =
    [(Text
"leiosDbCopiedEbs", Text
"EBs copied into the immutable partition")]
  metricsDocFor (Namespace [Text]
_ [Text
"Evicted"]) =
    [(Text
"leiosDbEvictedEbs", Text
"EB announcement rows evicted from the volatile partition")]
  metricsDocFor (Namespace [Text]
_ [Text
"SweepError"]) =
    [(Text
"leiosDbSweepErrors", Text
"Failed sweep passes, each retried")]
  metricsDocFor (Namespace [Text]
_ [Text
"CopyError"]) =
    [(Text
"leiosDbCopyErrors", Text
"Failed copies, each retried")]
  metricsDocFor (Namespace [Text]
_ [Text
"WriteAbandoned"]) =
    [(Text
"leiosDbWritesAbandoned", Text
"Writes lost while waiting for room in the writer's queue")]
  metricsDocFor Namespace TraceLeiosDb
_ = []

  allNamespaces :: [Namespace TraceLeiosDb]
allNamespaces =
    [ [Text] -> [Text] -> Namespace TraceLeiosDb
forall a. [Text] -> [Text] -> Namespace a
Namespace [] [Text
"InsertCollision"]
    , [Text] -> [Text] -> Namespace TraceLeiosDb
forall a. [Text] -> [Text] -> Namespace a
Namespace [] [Text
"WriterQueueFull"]
    , [Text] -> [Text] -> Namespace TraceLeiosDb
forall a. [Text] -> [Text] -> Namespace a
Namespace [] [Text
"WriteAbandoned"]
    , [Text] -> [Text] -> Namespace TraceLeiosDb
forall a. [Text] -> [Text] -> Namespace a
Namespace [] [Text
"WriteJobDone"]
    , [Text] -> [Text] -> Namespace TraceLeiosDb
forall a. [Text] -> [Text] -> Namespace a
Namespace [] [Text
"Stats"]
    , [Text] -> [Text] -> Namespace TraceLeiosDb
forall a. [Text] -> [Text] -> Namespace a
Namespace [] [Text
"Copied"]
    , [Text] -> [Text] -> Namespace TraceLeiosDb
forall a. [Text] -> [Text] -> Namespace a
Namespace [] [Text
"Evicted"]
    , [Text] -> [Text] -> Namespace TraceLeiosDb
forall a. [Text] -> [Text] -> Namespace a
Namespace [] [Text
"SweepError"]
    , [Text] -> [Text] -> Namespace TraceLeiosDb
forall a. [Text] -> [Text] -> Namespace a
Namespace [] [Text
"CopyError"]
    ]