{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE RankNTypes #-}
{-# LANGUAGE ScopedTypeVariables #-}

-- | Database analysis tool.
--
-- Usage: db-analyser --db PATH [--verbose] [--analyse-from SLOT_NUMBER]
--                    [--db-validation ARG]
--                    [--show-slot-block-no | --count-tx-outputs |
--                      --show-block-header-size | --show-block-txs-size |
--                      --show-ebbs | --store-ledger SLOT_NUMBER
--                      [--full-ledger-validation] |
--                      --count-blocks | --checkThunks BLOCK_COUNT |
--                      --trace-ledger | --repro-mempool-and-forge INT |
--                      --benchmark-ledger-ops [--out-file FILE] [--reapply] |
--                      --get-block-application-metrics NUM [--out-file FILE]]
--                    [--num-blocks-to-process INT] COMMAND
module Main (main) where

import Cardano.Crypto.Init (cryptoInit)
import Cardano.Tools.DBAnalyser.Run
import Cardano.Tools.DBAnalyser.Types
import Cardano.Tools.GitRev (gitRev)
import Control.Monad (void)
import DBAnalyser.Parsers
import qualified Data.Text as T
import Main.Utf8 (withStdTerminalHandles)
import Options.Applicative
  ( execParser
  , footer
  , fullDesc
  , helper
  , info
  , progDesc
  , (<**>)
  )

main :: IO ()
IO ()
main = IO () -> IO ()
forall (m :: * -> *) r. (MonadIO m, MonadMask m) => m r -> m r
withStdTerminalHandles (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$ do
  IO ()
cryptoInit
  (conf, blocktype) <- IO (DBAnalyserConfig, BlockType)
getCmdLine
  void $ case blocktype of
    ByronBlock ByronBlockArgs
args -> DBAnalyserConfig -> ByronBlockArgs -> IO (Maybe AnalysisResult)
forall blk.
(RunNode blk, Show (Header blk), HasAnalysis blk,
 HasProtocolInfo blk, HasTxs blk,
 CanStowLedgerTables (LedgerState blk)) =>
DBAnalyserConfig -> Args blk -> IO (Maybe AnalysisResult)
analyse DBAnalyserConfig
conf ByronBlockArgs
args
    ShelleyBlock ShelleyBlockArgs
args -> DBAnalyserConfig -> ShelleyBlockArgs -> IO (Maybe AnalysisResult)
forall blk.
(RunNode blk, Show (Header blk), HasAnalysis blk,
 HasProtocolInfo blk, HasTxs blk,
 CanStowLedgerTables (LedgerState blk)) =>
DBAnalyserConfig -> Args blk -> IO (Maybe AnalysisResult)
analyse DBAnalyserConfig
conf ShelleyBlockArgs
args
    CardanoBlock CardanoBlockArgs
args -> DBAnalyserConfig -> CardanoBlockArgs -> IO (Maybe AnalysisResult)
forall blk.
(RunNode blk, Show (Header blk), HasAnalysis blk,
 HasProtocolInfo blk, HasTxs blk,
 CanStowLedgerTables (LedgerState blk)) =>
DBAnalyserConfig -> Args blk -> IO (Maybe AnalysisResult)
analyse DBAnalyserConfig
conf CardanoBlockArgs
args

getCmdLine :: IO (DBAnalyserConfig, BlockType)
getCmdLine :: IO (DBAnalyserConfig, BlockType)
getCmdLine = ParserInfo (DBAnalyserConfig, BlockType)
-> IO (DBAnalyserConfig, BlockType)
forall a. ParserInfo a -> IO a
execParser ParserInfo (DBAnalyserConfig, BlockType)
opts
 where
  opts :: ParserInfo (DBAnalyserConfig, BlockType)
opts =
    Parser (DBAnalyserConfig, BlockType)
-> InfoMod (DBAnalyserConfig, BlockType)
-> ParserInfo (DBAnalyserConfig, BlockType)
forall a. Parser a -> InfoMod a -> ParserInfo a
info
      (Parser (DBAnalyserConfig, BlockType)
parseCmdLine Parser (DBAnalyserConfig, BlockType)
-> Parser
     ((DBAnalyserConfig, BlockType) -> (DBAnalyserConfig, BlockType))
-> Parser (DBAnalyserConfig, BlockType)
forall (f :: * -> *) a b. Applicative f => f a -> f (a -> b) -> f b
<**> Parser
  ((DBAnalyserConfig, BlockType) -> (DBAnalyserConfig, BlockType))
forall a. Parser (a -> a)
helper)
      ( [InfoMod (DBAnalyserConfig, BlockType)]
-> InfoMod (DBAnalyserConfig, BlockType)
forall a. Monoid a => [a] -> a
mconcat
          [ InfoMod (DBAnalyserConfig, BlockType)
forall a. InfoMod a
fullDesc
          , String -> InfoMod (DBAnalyserConfig, BlockType)
forall a. String -> InfoMod a
progDesc String
"Simple framework used to analyse a Chain DB"
          , String -> InfoMod (DBAnalyserConfig, BlockType)
forall a. String -> InfoMod a
footer (String -> InfoMod (DBAnalyserConfig, BlockType))
-> String -> InfoMod (DBAnalyserConfig, BlockType)
forall a b. (a -> b) -> a -> b
$ String
"ouroboros-consensus commit: " String -> String -> String
forall a. Semigroup a => a -> a -> a
<> Text -> String
T.unpack Text
gitRev
          ]
      )