diff --git a/bench/locli/locli.cabal b/bench/locli/locli.cabal index 67f3cc7bc27..5cd50392a00 100644 --- a/bench/locli/locli.cabal +++ b/bench/locli/locli.cabal @@ -32,7 +32,6 @@ library Cardano.Unlog.Render Cardano.Unlog.Resources Cardano.Unlog.Run - Cardano.Unlog.SlotStats other-modules: Paths_locli @@ -45,6 +44,7 @@ library , bytestring , cardano-config , cardano-prelude + , iohk-monitoring , cardano-slotting , containers , deepseq @@ -53,7 +53,6 @@ library , file-embed , gnuplot , Histogram - , iohk-monitoring , optparse-applicative-fork , optparse-generic , ouroboros-network @@ -66,6 +65,7 @@ library , text , text-short , time + , trace-resources , transformers , transformers-except , unordered-containers diff --git a/bench/locli/src/Cardano/Analysis/API.hs b/bench/locli/src/Cardano/Analysis/API.hs index fcfe67760c0..3a3e334c59f 100644 --- a/bench/locli/src/Cardano/Analysis/API.hs +++ b/bench/locli/src/Cardano/Analysis/API.hs @@ -11,19 +11,21 @@ import Prelude ((!!), error) import Cardano.Prelude hiding (head) import Data.Aeson (ToJSON(..), FromJSON(..)) +import Data.List.Split (splitOn) import Data.Text qualified as T import Data.Text.Short (toText) import Data.Time.Clock (NominalDiffTime) -import Text.Printf (printf) +import Data.Time (UTCTime) +import Text.Printf (PrintfArg, printf) import Cardano.Slotting.Slot (EpochNo(..), SlotNo(..)) import Ouroboros.Network.Block (BlockNo(..)) import Cardano.Analysis.ChainFilter import Cardano.Analysis.Profile +import Cardano.Logging.Resources.Types import Cardano.Unlog.LogObject hiding (Text) import Cardano.Unlog.Render -import Cardano.Unlog.SlotStats import Data.Distribution @@ -130,14 +132,66 @@ data BPErrorKind data DataDomain = DataDomain - { ddRawSlotFirst :: SlotNo - , ddRawSlotLast :: SlotNo - , ddAnalysisSlotFirst :: SlotNo - , ddAnalysisSlotLast :: SlotNo + { ddRawSlotFirst :: !SlotNo + , ddRawSlotLast :: !SlotNo + , ddAnalysisSlotFirst :: !SlotNo + , ddAnalysisSlotLast :: !SlotNo } deriving (Generic, Show, ToJSON) -- Perhaps: Plutus.V1.Ledger.Slot.SlotRange = Interval Slot +-- | The top-level representation of the machine timeline analysis results. +data MachTimeline + = MachTimeline + { sSlotRange :: (SlotNo, SlotNo) -- ^ Analysis range, inclusive. + , sMaxChecks :: !Word64 + , sSlotMisses :: ![Word64] + , sSpanLensCPU85 :: ![Int] + , sSpanLensCPU85EBnd :: ![Int] + , sSpanLensCPU85Rwd :: ![Int] + -- distributions + , sMissDistrib :: !(Distribution Float Float) + , sLeadsDistrib :: !(Distribution Float Word64) + , sUtxoDistrib :: !(Distribution Float Word64) + , sDensityDistrib :: !(Distribution Float Float) + , sSpanCheckDistrib :: !(Distribution Float NominalDiffTime) + , sSpanLeadDistrib :: !(Distribution Float NominalDiffTime) + , sBlocklessDistrib :: !(Distribution Float Word64) + , sSpanLensCPU85Distrib + :: !(Distribution Float Int) + , sSpanLensCPU85EBndDistrib :: !(Distribution Float Int) + , sSpanLensCPU85RwdDistrib :: !(Distribution Float Int) + , sResourceDistribs :: !(Resources (Distribution Float Word64)) + } + deriving (Generic, Show, ToJSON) + +data SlotStats + = SlotStats + { slSlot :: !SlotNo + , slEpoch :: !Word64 + , slEpochSlot :: !Word64 + , slStart :: !SlotStart + , slCountChecks :: !Word64 + , slCountLeads :: !Word64 + , slChainDBSnap :: !Word64 + , slRejectedTx :: !Word64 + , slBlockNo :: !Word64 + , slBlockless :: !Word64 + , slOrderViol :: !Word64 + , slEarliest :: !UTCTime + , slSpanCheck :: !NominalDiffTime + , slSpanLead :: !NominalDiffTime + , slMempoolTxs :: !Word64 + , slTxsMemSpan :: !(Maybe NominalDiffTime) + , slTxsCollected :: !Word64 + , slTxsAccepted :: !Word64 + , slTxsRejected :: !Word64 + , slUtxoSize :: !Word64 + , slDensity :: !Float + , slResources :: !(Resources (Maybe Word64)) + } + deriving (Generic, Show, ToJSON) + -- -- * Key properties -- @@ -171,8 +225,17 @@ isValidBlockObservation BlockObservation{..} = -- 2. All timings account for processing of a single block boChainDelta == 1 +testSlotStats :: Profile -> SlotStats -> SlotCond -> Bool +testSlotStats Profile{genesis=GenesisProfile{}} + SlotStats{..} = \case + SlotGEq s -> slSlot >= s + SlotLEq s -> slSlot <= s + EpochGEq s -> fromIntegral slEpoch >= s + EpochLEq s -> fromIntegral slEpoch <= s + SlotHasLeaders -> slCountLeads > 0 + -- --- * Instances +-- * Timeline rendering instances -- instance RenderDistributions BlockPropagation where rdFields _ = @@ -271,3 +334,66 @@ instance RenderTimeline BlockEvents where bpeIsNegative _ _ = False rtCommentary BlockEvents{..} = (" " <>) . show <$> beErrors + +instance RenderTimeline SlotStats where + rtFields _ = + -- Width LeftPad + [ Field 5 0 "abs.slot" "abs." "slot#" $ IWord64 (unSlotNo . slSlot) + , Field 4 0 "slot" " epo" "slot" $ IWord64 slEpochSlot + , Field 2 0 "epoch" "ch " "#" $ IWord64 slEpoch + , Field 5 0 "block" "block" "no." $ IWord64 slBlockNo + , Field 5 0 "blockGap" "block" "gap" $ IWord64 slBlockless + , Field 3 0 "leadChecks" "lead" "chk" $ IWord64 slCountChecks + , Field 3 0 "leadShips" "ship" "win" $ IWord64 slCountLeads + , Field 4 0 "CDBSnap" "CDB" "snap" $ IWord64 slChainDBSnap + , Field 3 0 "rejTxs" "rej" "txs" $ IWord64 slRejectedTx + , Field 7 0 "checkSpan" "check" "span" $ IDeltaT slSpanCheck + , Field 5 0 "leadSpan" "lead" "span" $ IDeltaT slSpanLead + , Field 4 0 "mempoolTxSpan" (t 4!!0) "span" $ IText (maybe "" show.slTxsMemSpan) + , Field 4 0 "txsColl" (t 4!!1) "cold" $ IWord64 slTxsCollected + , Field 4 0 "txsAcc" (t 4!!2) "accd" $ IWord64 slTxsAccepted + , Field 4 0 "txsRej" (t 4!!3) "rejd" $ IWord64 slTxsRejected + , Field 5 1 "chDensity" "chain" "dens." $ IFloat slDensity + , Field 3 0 "CPU%" (c 3!!0) "all" $ IText (d 3.rCentiCpu.slResources) + , Field 3 0 "GC%" (c 3!!1) "GC" $ IText (d 3.fmap (min 999).rCentiGC.slResources) + , Field 3 0 "MUT%" (c 3!!2) "mut" $ IText (d 3.fmap (min 999).rCentiMut.slResources) + , Field 3 0 "majFlt" (g 3!!0) "maj" $ IText (d 3.rGcsMajor.slResources) + , Field 3 0 "minFlt" (g 3!!1) "min" $ IText (d 3.rGcsMinor.slResources) + , Field 6 0 "productiv" "Produc" "tivity" $ IText + (\SlotStats{..}-> + f 4 $ calcProd <$> (min 6 . -- workaround for ghc-8.10.2 + fromIntegral <$> rCentiMut slResources :: Maybe Float) + <*> (fromIntegral <$> rCentiCpu slResources)) + , Field 5 0 "rssMB" (m 5!!0) "RSS" $ IText (d 5.rRSS .slResources) + , Field 5 0 "heapMB" (m 5!!1) "Heap" $ IText (d 5.rHeap .slResources) + , Field 5 0 "liveMB" (m 5!!2) "Live" $ IText (d 5.rLive .slResources) + , Field 5 0 "allocatedMB" "Allocd" "MB" $ IText (d 5.rAlloc.slResources) + , Field 6 0 "allocMut" "Alloc/" "mutSec" $ IText + (\SlotStats{..}-> + d 5 $ + (ceiling :: Float -> Int) + <$> ((/) <$> (fromIntegral . (100 *) <$> rAlloc slResources) + <*> (fromIntegral . max 1 . (1024 *) <$> rCentiMut slResources))) + , Field 7 0 "mempoolTxs" "Mempool" "txs" $ IWord64 slMempoolTxs + , Field 9 0 "utxoEntries" "UTxO" "entries" $ IWord64 slUtxoSize + , Field 10 0 "absSlotTime" "Absolute" "slot time" $ IText + (\SlotStats{..}-> + T.pack $ " " `splitOn` show slStart !! 1) + ] + where + t w = nChunksEachOf 4 (w + 1) "mempool tx" + c w = nChunksEachOf 3 (w + 1) "%CPU" + g w = nChunksEachOf 2 (w + 1) "GCs" + m w = nChunksEachOf 3 (w + 1) "Memory use, MB" + + d, f :: PrintfArg a => Int -> Maybe a -> Text + d width = \case + Just x -> T.pack $ printf ("%"<>"" --(if exportMode then "0" else "") + <>show width<>"d") x + Nothing -> mconcat (replicate width "-") + f width = \case + Just x -> T.pack $ printf ("%0."<>show width<>"f") x + Nothing -> mconcat (replicate width "-") + + calcProd :: Float -> Float -> Float + calcProd mut' cpu' = if cpu' == 0 then 1 else mut' / cpu' diff --git a/bench/locli/src/Cardano/Analysis/BlockProp.hs b/bench/locli/src/Cardano/Analysis/BlockProp.hs index 207e8aeab33..949aadd72a0 100644 --- a/bench/locli/src/Cardano/Analysis/BlockProp.hs +++ b/bench/locli/src/Cardano/Analysis/BlockProp.hs @@ -55,7 +55,6 @@ import Cardano.Analysis.Profile import Cardano.Unlog.LogObject hiding (Text) import Cardano.Unlog.Render import Cardano.Unlog.Resources -import Cardano.Unlog.SlotStats -- | Block's events, as seen by its forger. diff --git a/bench/locli/src/Cardano/Analysis/ChainFilter.hs b/bench/locli/src/Cardano/Analysis/ChainFilter.hs index 8acdba4dca7..180516f59ca 100644 --- a/bench/locli/src/Cardano/Analysis/ChainFilter.hs +++ b/bench/locli/src/Cardano/Analysis/ChainFilter.hs @@ -3,15 +3,16 @@ {-# LANGUAGE LambdaCase #-} {-# LANGUAGE RankNTypes #-} {-# LANGUAGE ScopedTypeVariables #-} -{-# OPTIONS_GHC -Wno-deprecations #-} +{-# LANGUAGE StandaloneDeriving #-} +{-# OPTIONS_GHC -Wno-deprecations -Wno-orphans #-} {- HLINT ignore "Use head" -} module Cardano.Analysis.ChainFilter (module Cardano.Analysis.ChainFilter) where -import Cardano.Prelude hiding (head) +import Cardano.Prelude hiding (head) -import Data.Aeson +import Data.Aeson -import Cardano.Unlog.SlotStats +import Cardano.Slotting.Slot (EpochNo (..), SlotNo (..)) -- | Conditions for chain subsetting @@ -22,13 +23,23 @@ data ChainFilter -- | Block classification -- primary for validity as subjects of analysis. data BlockCond - = BUnitaryChainDelta -- ^ All timings account for processing of a single block. - | BFullnessGEq Double -- ^ Block fullness is above fraction. - | BFullnessLEq Double -- ^ Block fullness is below fraction. - | BSizeGEq Word64 - | BSizeLEq Word64 + = BUnitaryChainDelta -- ^ All timings account for + -- processing of a single block. + | BFullnessGEq Double -- ^ Block fullness is above fraction. + | BFullnessLEq Double -- ^ Block fullness is below fraction. + | BSizeGEq Word64 + | BSizeLEq Word64 deriving (FromJSON, Generic, NFData, Show, ToJSON) +deriving instance NFData EpochNo + +data SlotCond + = SlotGEq SlotNo + | SlotLEq SlotNo + | EpochGEq EpochNo + | EpochLEq EpochNo + | SlotHasLeaders + deriving (FromJSON, Generic, NFData, Show, ToJSON) cfIsSlotCond, cfIsBlockCond :: ChainFilter -> Bool cfIsSlotCond = \case { CSlot{} -> True; _ -> False; } diff --git a/bench/locli/src/Cardano/Analysis/Driver.hs b/bench/locli/src/Cardano/Analysis/Driver.hs index ef3f4eb94a1..dcc799b407e 100644 --- a/bench/locli/src/Cardano/Analysis/Driver.hs +++ b/bench/locli/src/Cardano/Analysis/Driver.hs @@ -39,7 +39,6 @@ import Cardano.Analysis.Profile import Cardano.Unlog.Commands import Cardano.Unlog.LogObject hiding (Text) import Cardano.Unlog.Render -import Cardano.Unlog.SlotStats data AnalysisCmdError diff --git a/bench/locli/src/Cardano/Analysis/MachTimeline.hs b/bench/locli/src/Cardano/Analysis/MachTimeline.hs index 0b1bb276e02..2379ce9d991 100644 --- a/bench/locli/src/Cardano/Analysis/MachTimeline.hs +++ b/bench/locli/src/Cardano/Analysis/MachTimeline.hs @@ -1,5 +1,4 @@ -{-# LANGUAGE DeriveAnyClass #-} -{-# LANGUAGE DeriveGeneric #-} +{-# LANGUAGE ImportQualifiedPost #-} {-# LANGUAGE LambdaCase #-} {-# LANGUAGE NamedFieldPuns #-} {-# LANGUAGE RankNTypes #-} @@ -10,53 +9,27 @@ {- HLINT ignore "Use head" -} module Cardano.Analysis.MachTimeline (module Cardano.Analysis.MachTimeline) where -import Prelude (String, (!!), error, head, last) -import Cardano.Prelude hiding (head) +import Prelude (String, (!!), error, head, last) +import Cardano.Prelude hiding (head) -import Control.Arrow ((&&&), (***)) -import Data.Aeson -import Data.Vector (Vector) -import qualified Data.Vector as Vec -import qualified Data.Map.Strict as Map +import Control.Arrow ((&&&), (***)) +import Data.Vector (Vector) +import Data.Vector qualified as Vec +import Data.Map.Strict qualified as Map -import Data.Time.Clock (NominalDiffTime, UTCTime) -import qualified Data.Time.Clock as Time +import Data.Time.Clock (NominalDiffTime, UTCTime) +import Data.Time.Clock qualified as Time -import Ouroboros.Network.Block (SlotNo(..)) +import Ouroboros.Network.Block (SlotNo(..)) -import Data.Accum -import Data.Distribution +import Data.Accum +import Data.Distribution -import Cardano.Analysis.Profile -import Cardano.Unlog.LogObject hiding (Text) -import Cardano.Unlog.Render -import Cardano.Unlog.Resources -import Cardano.Unlog.SlotStats - --- | The top-level representation of the machine timeline analysis results. -data MachTimeline - = MachTimeline - { sSlotRange :: (SlotNo, SlotNo) -- ^ Analysis range, inclusive. - , sMaxChecks :: !Word64 - , sSlotMisses :: ![Word64] - , sSpanLensCPU85 :: ![Int] - , sSpanLensCPU85EBnd :: ![Int] - , sSpanLensCPU85Rwd :: ![Int] - -- distributions - , sMissDistrib :: !(Distribution Float Float) - , sLeadsDistrib :: !(Distribution Float Word64) - , sUtxoDistrib :: !(Distribution Float Word64) - , sDensityDistrib :: !(Distribution Float Float) - , sSpanCheckDistrib :: !(Distribution Float NominalDiffTime) - , sSpanLeadDistrib :: !(Distribution Float NominalDiffTime) - , sBlocklessDistrib :: !(Distribution Float Word64) - , sSpanLensCPU85Distrib - :: !(Distribution Float Int) - , sSpanLensCPU85EBndDistrib :: !(Distribution Float Int) - , sSpanLensCPU85RwdDistrib :: !(Distribution Float Int) - , sResourceDistribs :: !(Resources (Distribution Float Word64)) - } - deriving (Generic, Show, ToJSON) +import Cardano.Analysis.API +import Cardano.Analysis.Profile +import Cardano.Unlog.LogObject hiding (Text) +import Cardano.Unlog.Render +import Cardano.Unlog.Resources instance RenderDistributions MachTimeline where rdFields _ = @@ -194,6 +167,32 @@ timelineFromLogObjects ci = } zeroRunScalars :: RunScalars zeroRunScalars = RunScalars Nothing Nothing Nothing + zeroSlotStats :: SlotStats + zeroSlotStats = + SlotStats + { slSlot = 0 + , slEpoch = 0 + , slEpochSlot = 0 + , slStart = SlotStart zeroUTCTime + , slCountChecks = 0 + , slCountLeads = 0 + , slOrderViol = 0 + , slEarliest = zeroUTCTime + , slSpanCheck = realToFrac (0 :: Int) + , slSpanLead = realToFrac (0 :: Int) + , slMempoolTxs = 0 + , slTxsMemSpan = Nothing + , slTxsCollected = 0 + , slTxsAccepted = 0 + , slTxsRejected = 0 + , slUtxoSize = 0 + , slDensity = 0 + , slResources = pure Nothing + , slChainDBSnap = 0 + , slRejectedTx = 0 + , slBlockNo = 0 + , slBlockless = 0 + } timelineStep :: ChainInfo -> TimelineAccum -> LogObject -> TimelineAccum timelineStep ci a@TimelineAccum{aSlotStats=cur:rSLs, ..} = \case diff --git a/bench/locli/src/Cardano/Analysis/Profile.hs b/bench/locli/src/Cardano/Analysis/Profile.hs index 86a83c1e89a..7692ef9b900 100644 --- a/bench/locli/src/Cardano/Analysis/Profile.hs +++ b/bench/locli/src/Cardano/Analysis/Profile.hs @@ -11,8 +11,8 @@ {-# OPTIONS_GHC -Wno-incomplete-patterns -Wno-name-shadowing #-} module Cardano.Analysis.Profile (module Cardano.Analysis.Profile) where -import Prelude (String) -import Cardano.Prelude +import Prelude (String) +import Cardano.Prelude import Data.Aeson.Types qualified as Aeson import Data.Aeson (FromJSON(..), Object, ToJSON(..), withObject, (.:)) diff --git a/bench/locli/src/Cardano/Analysis/TopHandler.hs b/bench/locli/src/Cardano/Analysis/TopHandler.hs index 0913e07d763..eea7bd0880a 100644 --- a/bench/locli/src/Cardano/Analysis/TopHandler.hs +++ b/bench/locli/src/Cardano/Analysis/TopHandler.hs @@ -44,13 +44,13 @@ module Cardano.Analysis.TopHandler -- (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE -- OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. -import Prelude +import Prelude -import Control.Exception +import Control.Exception -import System.Environment -import System.Exit -import System.IO +import System.Environment +import System.Exit +import System.IO -- | An exception handler to use for a program top level, as an alternative to diff --git a/bench/locli/src/Cardano/Unlog/Commands.hs b/bench/locli/src/Cardano/Unlog/Commands.hs index dbed36a0e25..8b024ede564 100644 --- a/bench/locli/src/Cardano/Unlog/Commands.hs +++ b/bench/locli/src/Cardano/Unlog/Commands.hs @@ -1,19 +1,20 @@ {-# LANGUAGE FlexibleContexts #-} +{-# LANGUAGE ImportQualifiedPost #-} {-# LANGUAGE UndecidableInstances #-} -- | CLI command types module Cardano.Unlog.Commands (module Cardano.Unlog.Commands) where -import Prelude +import Prelude -import Data.Text (Text) +import Data.Text (Text) -import Options.Applicative -import qualified Options.Applicative as Opt +import Options.Applicative +import Options.Applicative qualified as Opt -import Ouroboros.Network.Block (SlotNo(..)) +import Ouroboros.Network.Block (SlotNo(..)) -import Cardano.Unlog.LogObject hiding (Text) +import Cardano.Unlog.LogObject hiding (Text) -- -- Analysis CLI command data types diff --git a/bench/locli/src/Cardano/Unlog/LogObject.hs b/bench/locli/src/Cardano/Unlog/LogObject.hs index 63bab2891b2..965b5fe6924 100644 --- a/bench/locli/src/Cardano/Unlog/LogObject.hs +++ b/bench/locli/src/Cardano/Unlog/LogObject.hs @@ -2,36 +2,36 @@ {-# LANGUAGE DeriveGeneric #-} {-# LANGUAGE DerivingVia #-} {-# LANGUAGE GeneralisedNewtypeDeriving #-} +{-# LANGUAGE ImportQualifiedPost #-} {-# LANGUAGE ScopedTypeVariables #-} {-# LANGUAGE StandaloneDeriving #-} {-# OPTIONS_GHC -Wno-partial-fields -Wno-orphans #-} module Cardano.Unlog.LogObject (module Cardano.Unlog.LogObject) where -import Prelude (String, error, id) -import qualified Prelude -import Cardano.Prelude hiding (Text) - -import Control.Monad (fail) -import Data.Aeson (FromJSON(..), ToJSON(..), Value(..), Object, (.:)) -import Data.Aeson.Types (Parser) -import qualified Data.Aeson as AE -import qualified Data.Aeson.Types as AE -import qualified Data.ByteString.Lazy as LBS -import qualified Data.HashMap.Strict as HM -import qualified Data.Text as LText -import qualified Data.Text.Short as Text -import Data.Text.Short (ShortText, fromText, toText) -import Data.Time.Clock (NominalDiffTime, UTCTime) -import qualified Data.Map as Map -import Data.Vector (Vector) -import Quiet (Quiet (..)) - -import Ouroboros.Network.Block (BlockNo(..), SlotNo(..)) - -import Cardano.BM.Stats.Resources - -import Data.Accum (zeroUTCTime) +import Prelude (String, error, head, id, show) +import Cardano.Prelude hiding (Text, head, show) + +import Control.Monad (fail) +import Data.Aeson (FromJSON(..), ToJSON(..), Value(..), Object, (.:)) +import Data.Aeson.Types (Parser) +import Data.Aeson qualified as AE +import Data.Aeson.Types qualified as AE +import Data.ByteString.Lazy qualified as LBS +import Data.HashMap.Strict qualified as HM +import Data.Text qualified as LText +import Data.Text.Short qualified as Text +import Data.Text.Short (ShortText, fromText, toText) +import Data.Time.Clock (NominalDiffTime, UTCTime) +import Data.Map qualified as Map +import Data.Vector (Vector) +import Quiet (Quiet (..)) + +import Ouroboros.Network.Block (BlockNo(..), SlotNo(..)) + +import Cardano.Logging.Resources.Types + +import Data.Accum (zeroUTCTime) type Text = ShortText diff --git a/bench/locli/src/Cardano/Unlog/Parsers.hs b/bench/locli/src/Cardano/Unlog/Parsers.hs index 51076e6fb9d..d67bd6a9892 100644 --- a/bench/locli/src/Cardano/Unlog/Parsers.hs +++ b/bench/locli/src/Cardano/Unlog/Parsers.hs @@ -1,16 +1,17 @@ +{-# LANGUAGE ImportQualifiedPost #-} module Cardano.Unlog.Parsers ( opts , pref ) where -import Cardano.Prelude -import Prelude (String) +import Cardano.Prelude +import Prelude (String) -import Options.Applicative -import qualified Options.Applicative as Opt +import Options.Applicative +import Options.Applicative qualified as Opt -import Cardano.Unlog.Commands -import Cardano.Unlog.Run (Command (..)) +import Cardano.Unlog.Commands +import Cardano.Unlog.Run (Command (..)) command' :: String -> String -> Parser a -> Mod CommandFields a command' c descr p = diff --git a/bench/locli/src/Cardano/Unlog/Resources.hs b/bench/locli/src/Cardano/Unlog/Resources.hs index cfd6c8f83cf..ec88ced4cd6 100644 --- a/bench/locli/src/Cardano/Unlog/Resources.hs +++ b/bench/locli/src/Cardano/Unlog/Resources.hs @@ -13,13 +13,13 @@ module Cardano.Unlog.Resources , Resources(..) ) where -import Cardano.Prelude +import Cardano.Prelude -import Data.Accum -import Data.Distribution -import Data.Time.Clock (UTCTime) +import Data.Accum +import Data.Distribution +import Data.Time.Clock (UTCTime) -import Cardano.BM.Stats.Resources +import Cardano.Logging.Resources.Types -- | Resouce accumulators type ResAccums = Resources (Accum Word64 Word64) diff --git a/bench/locli/src/Cardano/Unlog/Run.hs b/bench/locli/src/Cardano/Unlog/Run.hs index 6de40521c59..12fdb660987 100644 --- a/bench/locli/src/Cardano/Unlog/Run.hs +++ b/bench/locli/src/Cardano/Unlog/Run.hs @@ -1,4 +1,4 @@ - +{-# LANGUAGE ImportQualifiedPost #-} -- | Dispatch for running all the CLI commands module Cardano.Unlog.Run ( Command(..) @@ -7,18 +7,18 @@ module Cardano.Unlog.Run , runCommand ) where -import Cardano.Prelude +import Cardano.Prelude -import Control.Monad.Trans.Except.Extra (firstExceptT) -import qualified Data.Text as Text +import Control.Monad.Trans.Except.Extra (firstExceptT) +import Data.Text qualified as Text -import Cardano.Analysis.Driver (AnalysisCmdError, renderAnalysisCmdError, - runAnalysisCommand) -import Cardano.Unlog.Commands (AnalysisCommand) +import Cardano.Analysis.Driver (AnalysisCmdError, renderAnalysisCmdError, + runAnalysisCommand) +import Cardano.Unlog.Commands (AnalysisCommand) -import Cardano.Config.Git.Rev (gitRev) -import Data.Version (showVersion) -import Paths_locli (version) +import Cardano.Config.Git.Rev (gitRev) +import Data.Version (showVersion) +import Paths_locli (version) -- | Sub-commands of 'locli'. data Command = diff --git a/bench/locli/src/Cardano/Unlog/SlotStats.hs b/bench/locli/src/Cardano/Unlog/SlotStats.hs deleted file mode 100644 index be763dae7ab..00000000000 --- a/bench/locli/src/Cardano/Unlog/SlotStats.hs +++ /dev/null @@ -1,169 +0,0 @@ -{-# LANGUAGE DeriveAnyClass #-} -{-# LANGUAGE DeriveGeneric #-} -{-# LANGUAGE LambdaCase #-} -{-# LANGUAGE RankNTypes #-} -{-# LANGUAGE RecordWildCards #-} -{-# LANGUAGE ScopedTypeVariables #-} -{-# LANGUAGE StandaloneDeriving #-} -{-# OPTIONS_GHC -Wno-deprecations -Wno-orphans #-} -{- HLINT ignore "Use head" -} -module Cardano.Unlog.SlotStats (module Cardano.Unlog.SlotStats) where - -import Prelude ((!!)) -import Cardano.Prelude hiding (head) - -import Data.Aeson -import qualified Data.Text as T -import Data.List.Split (splitOn) - -import Data.Time.Clock (UTCTime, NominalDiffTime) -import Text.Printf - -import Cardano.Slotting.Slot (EpochNo (..), SlotNo (..)) - -import Data.Accum -import Cardano.Analysis.Profile -import Cardano.Unlog.Render -import Cardano.Unlog.Resources - - --- type Text = ShortText - -data SlotStats - = SlotStats - { slSlot :: !SlotNo - , slEpoch :: !Word64 - , slEpochSlot :: !Word64 - , slStart :: !SlotStart - , slCountChecks :: !Word64 - , slCountLeads :: !Word64 - , slChainDBSnap :: !Word64 - , slRejectedTx :: !Word64 - , slBlockNo :: !Word64 - , slBlockless :: !Word64 - , slOrderViol :: !Word64 - , slEarliest :: !UTCTime - , slSpanCheck :: !NominalDiffTime - , slSpanLead :: !NominalDiffTime - , slMempoolTxs :: !Word64 - , slTxsMemSpan :: !(Maybe NominalDiffTime) - , slTxsCollected :: !Word64 - , slTxsAccepted :: !Word64 - , slTxsRejected :: !Word64 - , slUtxoSize :: !Word64 - , slDensity :: !Float - , slResources :: !(Resources (Maybe Word64)) - } - deriving (Generic, Show) - -data SlotCond - = SlotGEq SlotNo - | SlotLEq SlotNo - | EpochGEq EpochNo - | EpochLEq EpochNo - | SlotHasLeaders - deriving (FromJSON, Generic, NFData, Show, ToJSON) - -deriving instance NFData EpochNo - -testSlotStats :: Profile -> SlotStats -> SlotCond -> Bool -testSlotStats Profile{genesis=GenesisProfile{}} - SlotStats{..} = \case - SlotGEq s -> slSlot >= s - SlotLEq s -> slSlot <= s - EpochGEq s -> fromIntegral slEpoch >= s - EpochLEq s -> fromIntegral slEpoch <= s - SlotHasLeaders -> slCountLeads > 0 - -instance RenderTimeline SlotStats where - rtFields _ = - -- Width LeftPad - [ Field 5 0 "abs.slot" "abs." "slot#" $ IWord64 (unSlotNo . slSlot) - , Field 4 0 "slot" " epo" "slot" $ IWord64 slEpochSlot - , Field 2 0 "epoch" "ch " "#" $ IWord64 slEpoch - , Field 5 0 "block" "block" "no." $ IWord64 slBlockNo - , Field 5 0 "blockGap" "block" "gap" $ IWord64 slBlockless - , Field 3 0 "leadChecks" "lead" "chk" $ IWord64 slCountChecks - , Field 3 0 "leadShips" "ship" "win" $ IWord64 slCountLeads - , Field 4 0 "CDBSnap" "CDB" "snap" $ IWord64 slChainDBSnap - , Field 3 0 "rejTxs" "rej" "txs" $ IWord64 slRejectedTx - , Field 7 0 "checkSpan" "check" "span" $ IDeltaT slSpanCheck - , Field 5 0 "leadSpan" "lead" "span" $ IDeltaT slSpanLead - , Field 4 0 "mempoolTxSpan" (t 4!!0) "span" $ IText (maybe "" show.slTxsMemSpan) - , Field 4 0 "txsColl" (t 4!!1) "cold" $ IWord64 slTxsCollected - , Field 4 0 "txsAcc" (t 4!!2) "accd" $ IWord64 slTxsAccepted - , Field 4 0 "txsRej" (t 4!!3) "rejd" $ IWord64 slTxsRejected - , Field 5 1 "chDensity" "chain" "dens." $ IFloat slDensity - , Field 3 0 "CPU%" (c 3!!0) "all" $ IText (d 3.rCentiCpu.slResources) - , Field 3 0 "GC%" (c 3!!1) "GC" $ IText (d 3.fmap (min 999).rCentiGC.slResources) - , Field 3 0 "MUT%" (c 3!!2) "mut" $ IText (d 3.fmap (min 999).rCentiMut.slResources) - , Field 3 0 "majFlt" (g 3!!0) "maj" $ IText (d 3.rGcsMajor.slResources) - , Field 3 0 "minFlt" (g 3!!1) "min" $ IText (d 3.rGcsMinor.slResources) - , Field 6 0 "productiv" "Produc" "tivity" $ IText - (\SlotStats{..}-> - f 4 $ calcProd <$> (min 6 . -- workaround for ghc-8.10.2 - fromIntegral <$> rCentiMut slResources :: Maybe Float) - <*> (fromIntegral <$> rCentiCpu slResources)) - , Field 5 0 "rssMB" (m 5!!0) "RSS" $ IText (d 5.rRSS .slResources) - , Field 5 0 "heapMB" (m 5!!1) "Heap" $ IText (d 5.rHeap .slResources) - , Field 5 0 "liveMB" (m 5!!2) "Live" $ IText (d 5.rLive .slResources) - , Field 5 0 "allocatedMB" "Allocd" "MB" $ IText (d 5.rAlloc.slResources) - , Field 6 0 "allocMut" "Alloc/" "mutSec" $ IText - (\SlotStats{..}-> - d 5 $ - (ceiling :: Float -> Int) - <$> ((/) <$> (fromIntegral . (100 *) <$> rAlloc slResources) - <*> (fromIntegral . max 1 . (1024 *) <$> rCentiMut slResources))) - , Field 7 0 "mempoolTxs" "Mempool" "txs" $ IWord64 slMempoolTxs - , Field 9 0 "utxoEntries" "UTxO" "entries" $ IWord64 slUtxoSize - , Field 10 0 "absSlotTime" "Absolute" "slot time" $ IText - (\SlotStats{..}-> - T.pack $ " " `splitOn` show slStart !! 1) - ] - where - t w = nChunksEachOf 4 (w + 1) "mempool tx" - c w = nChunksEachOf 3 (w + 1) "%CPU" - g w = nChunksEachOf 2 (w + 1) "GCs" - m w = nChunksEachOf 3 (w + 1) "Memory use, MB" - - d, f :: PrintfArg a => Int -> Maybe a -> Text - d width = \case - Just x -> T.pack $ printf ("%"<>"" --(if exportMode then "0" else "") - <>show width<>"d") x - Nothing -> mconcat (replicate width "-") - f width = \case - Just x -> T.pack $ printf ("%0."<>show width<>"f") x - Nothing -> mconcat (replicate width "-") - - calcProd :: Float -> Float -> Float - calcProd mut' cpu' = if cpu' == 0 then 1 else mut' / cpu' - -instance ToJSON SlotStats - -zeroSlotStats :: SlotStats -zeroSlotStats = - SlotStats - { slSlot = 0 - , slEpoch = 0 - , slEpochSlot = 0 - , slStart = SlotStart zeroUTCTime - , slCountChecks = 0 - , slCountLeads = 0 - , slOrderViol = 0 - , slEarliest = zeroUTCTime - , slSpanCheck = realToFrac (0 :: Int) - , slSpanLead = realToFrac (0 :: Int) - , slMempoolTxs = 0 - , slTxsMemSpan = Nothing - , slTxsCollected = 0 - , slTxsAccepted = 0 - , slTxsRejected = 0 - , slUtxoSize = 0 - , slDensity = 0 - , slResources = pure Nothing - , slChainDBSnap = 0 - , slRejectedTx = 0 - , slBlockNo = 0 - , slBlockless = 0 - } - diff --git a/bench/locli/src/Cardano/Unlog/Timeline.hs b/bench/locli/src/Cardano/Unlog/Timeline.hs deleted file mode 100644 index e571355d4a1..00000000000 --- a/bench/locli/src/Cardano/Unlog/Timeline.hs +++ /dev/null @@ -1,287 +0,0 @@ -{-# LANGUAGE LambdaCase #-} -{-# LANGUAGE NamedFieldPuns #-} -{-# LANGUAGE RankNTypes #-} -{-# LANGUAGE RecordWildCards #-} -{-# LANGUAGE ScopedTypeVariables #-} -{-# LANGUAGE StrictData #-} -{-# OPTIONS_GHC -Wno-incomplete-patterns -Wno-name-shadowing #-} -module Cardano.Unlog.Timeline (module Cardano.Unlog.Timeline) where - -import Prelude (String, error) -import Cardano.Prelude - -import Control.Arrow ((&&&)) -import Data.Vector (Vector) -import qualified Data.Map.Strict as Map - -import Data.Time.Clock (NominalDiffTime, UTCTime) -import qualified Data.Time.Clock as Time - -import Ouroboros.Network.Block (SlotNo(..)) - -import Data.Accum -import Cardano.Analysis.Profile -import Cardano.Unlog.LogObject -import Cardano.Unlog.Resources -import Cardano.Unlog.SlotStats - - --- The "fold" state that accumulates as we process 'LogObject's into a stream --- of 'SlotStats'. -data TimelineAccum - = TimelineAccum - { aResAccums :: ResAccums - , aResTimestamp :: UTCTime - , aMempoolTxs :: Word64 - , aBlockNo :: Word64 - , aLastBlockSlot :: SlotNo - , aSlotStats :: [SlotStats] - , aRunScalars :: RunScalars - , aTxsCollectedAt:: Map.Map TId UTCTime - } - -data RunScalars - = RunScalars - { rsElapsed :: Maybe NominalDiffTime - , rsSubmitted :: Maybe Word64 - , rsThreadwiseTps :: Maybe (Vector Float) - } - -timelineFromLogObjects :: ChainInfo -> [LogObject] -> (RunScalars, [SlotStats]) -timelineFromLogObjects ci = - (aRunScalars &&& reverse . aSlotStats) - . foldl (timelineStep ci) zeroTimelineAccum - where - zeroTimelineAccum :: TimelineAccum - zeroTimelineAccum = - TimelineAccum - { aResAccums = mkResAccums - , aResTimestamp = zeroUTCTime - , aMempoolTxs = 0 - , aBlockNo = 0 - , aLastBlockSlot = 0 - , aSlotStats = [zeroSlotStats] - , aRunScalars = zeroRunScalars - , aTxsCollectedAt= mempty - } - zeroRunScalars :: RunScalars - zeroRunScalars = RunScalars Nothing Nothing Nothing - -timelineStep :: ChainInfo -> TimelineAccum -> LogObject -> TimelineAccum -timelineStep ci a@TimelineAccum{aSlotStats=cur:rSLs, ..} = \case - lo@LogObject{loAt, loBody=LOTraceStartLeadershipCheck slot _ _} -> - if slSlot cur > slot - -- Slot log entry for a slot we've supposedly done processing. - then a { aSlotStats = cur - { slOrderViol = slOrderViol cur + 1 - } : case (slSlot cur - slot, rSLs) of - -- Limited back-patching: - (1, p1:rest) -> onLeadershipCheck loAt p1:rest - (2, p1:p2:rest) -> p1:onLeadershipCheck loAt p2:rest - (3, p1:p2:p3:rest) -> p1:p2:onLeadershipCheck loAt p3:rest - _ -> rSLs -- Give up. - } - else if slSlot cur == slot - then a { aSlotStats = onLeadershipCheck loAt cur : rSLs - } - else if slot - slSlot cur > 1 - then let gap = unSlotNo $ slot - slSlot cur - 1 - gapStartSlot = slSlot cur + 1 in - updateOnNewSlot lo $ -- We have a slot check gap to patch: - patchSlotCheckGap gap gapStartSlot a - else updateOnNewSlot lo a - LogObject{loAt, loBody=LOTraceNodeIsLeader _} -> - a { aSlotStats = onLeadershipCertainty loAt True cur : rSLs - } - LogObject{loAt, loBody=LOTraceNodeNotLeader _} -> - a { aSlotStats = onLeadershipCertainty loAt False cur : rSLs - } - LogObject{loAt, loBody=LOResources rs} -> - -- Update resource stats accumulators & record values current slot. - a { aResAccums = accs - , aResTimestamp = loAt - , aSlotStats = cur { slResources = Just <$> extractResAccums accs - } : rSLs - } - where accs = updateResAccums loAt rs aResAccums - LogObject{loBody=LOMempoolTxs txCount} -> - a { aMempoolTxs = txCount - , aSlotStats = cur { slMempoolTxs = txCount - } : rSLs - } - LogObject{loBody=LOBlockContext blockNo} -> - let newBlock = aBlockNo /= blockNo in - a { aBlockNo = blockNo - , aLastBlockSlot = if newBlock - then slSlot cur - else aLastBlockSlot - , aSlotStats = cur { slBlockNo = blockNo - , slBlockless = if newBlock - then 0 - else slBlockless cur - } : rSLs - } - LogObject{loBody=LOLedgerTookSnapshot} -> - a { aSlotStats = cur { slChainDBSnap = slChainDBSnap cur + 1 - } : rSLs - } - LogObject{loBody=LOMempoolRejectedTx} -> - a { aSlotStats = cur { slRejectedTx = slRejectedTx cur + 1 - } : rSLs - } - LogObject{loBody=LOGeneratorSummary _noFails sent elapsed threadwiseTps} -> - a { aRunScalars = - aRunScalars - { rsThreadwiseTps = Just threadwiseTps - , rsElapsed = Just elapsed - , rsSubmitted = Just sent - } - } - LogObject{loBody=LOTxsCollected tid coll, loAt} -> - a { aTxsCollectedAt = - aTxsCollectedAt & - (\case - Just{} -> Just loAt - -- error $ mconcat - -- ["Duplicate LOTxsCollected for tid ", show tid, " at ", show loAt] - Nothing -> Just loAt) - `Map.alter` tid - , aSlotStats = - cur - { slTxsCollected = slTxsCollected cur + max 0 (fromIntegral coll) - } : rSLs - } - LogObject{loBody=LOTxsProcessed tid acc rej, loAt} -> - a { aTxsCollectedAt = tid `Map.delete` aTxsCollectedAt - , aSlotStats = - cur - { slTxsMemSpan = - case tid `Map.lookup` aTxsCollectedAt of - Nothing -> - -- error $ mconcat - -- ["LOTxsProcessed missing LOTxsCollected for tid", show tid, " at ", show loAt] - Just $ - 1.0 - + - fromMaybe 0 (slTxsMemSpan cur) - Just base -> - Just $ - (loAt `Time.diffUTCTime` base) - + - fromMaybe 0 (slTxsMemSpan cur) - , slTxsAccepted = slTxsAccepted cur + acc - , slTxsRejected = slTxsRejected cur + max 0 (fromIntegral rej) - } : rSLs - } - _ -> a - where - updateOnNewSlot :: LogObject -> TimelineAccum -> TimelineAccum - updateOnNewSlot LogObject{loAt, loBody=LOTraceStartLeadershipCheck slot utxo density} a' = - extendTimelineAccum ci slot loAt 1 utxo density a' - updateOnNewSlot _ _ = - error "Internal invariant violated: updateSlot called for a non-LOTraceStartLeadershipCheck LogObject." - - onLeadershipCheck :: UTCTime -> SlotStats -> SlotStats - onLeadershipCheck now sl@SlotStats{..} = - sl { slCountChecks = slCountChecks + 1 - , slSpanCheck = max 0 $ now `Time.diffUTCTime` slStart - } - - onLeadershipCertainty :: UTCTime -> Bool -> SlotStats -> SlotStats - onLeadershipCertainty now lead sl@SlotStats{..} = - sl { slCountLeads = slCountLeads + if lead then 1 else 0 - , slSpanLead = max 0 $ now `Time.diffUTCTime` (slSpanCheck `Time.addUTCTime` slStart) - } - - patchSlotCheckGap :: Word64 -> SlotNo -> TimelineAccum -> TimelineAccum - patchSlotCheckGap 0 _ a' = a' - patchSlotCheckGap n slot a'@TimelineAccum{aSlotStats=cur':_} = - patchSlotCheckGap (n - 1) (slot + 1) $ - extendTimelineAccum ci slot (slotStart ci slot) 0 (slUtxoSize cur') (slDensity cur') a' - patchSlotCheckGap _ _ _ = - error "Internal invariant violated: patchSlotCheckGap called with empty TimelineAccum chain." -timelineStep _ a = const a - -extendTimelineAccum :: - ChainInfo - -> SlotNo -> UTCTime -> Word64 -> Word64 -> Float - -> TimelineAccum -> TimelineAccum -extendTimelineAccum ci@CInfo{..} slot time checks utxo density a@TimelineAccum{..} = - let (epoch, epochSlot) = unSlotNo slot `divMod` epoch_length gsis in - a { aSlotStats = SlotStats - { slSlot = slot - , slEpoch = epoch - , slEpochSlot = epochSlot - , slStart = slotStart ci slot - , slEarliest = time - , slOrderViol = 0 - -- Updated as we see repeats: - , slCountChecks = checks - , slCountLeads = 0 - , slSpanCheck = max 0 $ time `Time.diffUTCTime` slotStart ci slot - , slSpanLead = 0 - , slTxsMemSpan = Nothing - , slTxsCollected= 0 - , slTxsAccepted = 0 - , slTxsRejected = 0 - , slMempoolTxs = aMempoolTxs - , slUtxoSize = utxo - , slDensity = density - , slChainDBSnap = 0 - , slRejectedTx = 0 - , slBlockNo = aBlockNo - , slBlockless = unSlotNo $ slot - aLastBlockSlot - , slResources = maybeDiscard - <$> discardObsoleteValues - <*> extractResAccums aResAccums - } : aSlotStats - } - where maybeDiscard :: (Word64 -> Maybe Word64) -> Word64 -> Maybe Word64 - maybeDiscard f = f - -data DerivedSlot - = DerivedSlot - { dsSlot :: SlotNo - , dsBlockless :: Word64 - } - -derivedSlotsHeader :: String -derivedSlotsHeader = - "Slot,Blockless span" - -renderDerivedSlot :: DerivedSlot -> String -renderDerivedSlot DerivedSlot{..} = - mconcat - [ show (unSlotNo dsSlot), ",", show dsBlockless - ] - -computeDerivedVectors :: [SlotStats] -> ([DerivedSlot], [DerivedSlot]) -computeDerivedVectors ss = - (\(_,_,d0,d1) -> (d0, d1)) $ - foldr step (0, 0, [], []) ss - where - step :: - SlotStats - -> (Word64, Word64, [DerivedSlot], [DerivedSlot]) - -> (Word64, Word64, [DerivedSlot], [DerivedSlot]) - step SlotStats{..} (lastBlockless, spanBLSC, accD0, accD1) = - if lastBlockless < slBlockless - then ( slBlockless - , slBlockless - , DerivedSlot - { dsSlot = slSlot - , dsBlockless = slBlockless - }:accD0 - , DerivedSlot - { dsSlot = slSlot - , dsBlockless = slBlockless - }:accD1 - ) - else ( slBlockless - , spanBLSC - , DerivedSlot - { dsSlot = slSlot - , dsBlockless = spanBLSC - }:accD0 - , accD1 - ) diff --git a/bench/locli/src/Data/Accum.hs b/bench/locli/src/Data/Accum.hs index ec6f9dc085a..f6c126be0b1 100644 --- a/bench/locli/src/Data/Accum.hs +++ b/bench/locli/src/Data/Accum.hs @@ -1,4 +1,5 @@ {-# LANGUAGE FlexibleInstances #-} +{-# LANGUAGE ImportQualifiedPost #-} {-# LANGUAGE MultiParamTypeClasses #-} {-# LANGUAGE RecordWildCards #-} {-# LANGUAGE ScopedTypeVariables #-} @@ -16,10 +17,10 @@ module Data.Accum , mkAccumTicksShare ) where -import Cardano.Prelude +import Cardano.Prelude -import Data.Time.Clock (UTCTime, NominalDiffTime, diffUTCTime) -import qualified Data.Time.Clock.POSIX as Time +import Data.Time.Clock (UTCTime, NominalDiffTime, diffUTCTime) +import Data.Time.Clock.POSIX qualified as Time data Accum a b = Accum