{-# 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 qualified Data.Text as T
import           DBAnalyser.Parsers
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
    (DBAnalyserConfig
conf, BlockType
blocktype) <- IO (DBAnalyserConfig, BlockType)
getCmdLine
    IO (Maybe AnalysisResult) -> IO ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (IO (Maybe AnalysisResult) -> IO ())
-> IO (Maybe AnalysisResult) -> IO ()
forall a b. (a -> b) -> a -> b
$ case BlockType
blocktype of
      ByronBlock   ByronBlockArgs
args -> DBAnalyserConfig -> ByronBlockArgs -> IO (Maybe AnalysisResult)
forall blk.
(RunNode blk, Show (Header blk), HasAnalysis blk,
 HasProtocolInfo blk, HasTxs 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) =>
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) =>
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
        ])