{-# LANGUAGE LambdaCase #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE ViewPatterns #-}

module Main (main) where

import Cardano.Crypto.Init (cryptoInit)
import Cardano.Tools.DBAnalyser.HasAnalysis (mkProtocolInfo)
import Cardano.Tools.GitRev (gitRev)
import Control.Concurrent (threadDelay)
import Control.Exception (SomeException, displayException, try)
import Control.Monad (forever, void)
import Control.Monad.Except (runExceptT)
import DBAnalyser.Parsers (CardanoBlockArgs, parseCardanoArgs)
import qualified Data.List as L
import qualified Data.Text as T
import Data.Version (showVersion)
import Main.Utf8
import Options.Applicative
import Options.Applicative.Help.Pretty (Doc, pretty)
import Ouroboros.Consensus.Cardano.SnapshotConversion
import Ouroboros.Consensus.Storage.LedgerDB.Snapshots
import Ouroboros.Consensus.Storage.LedgerDB.V2.LSM
  ( lsmDbExportSnapshot
  , lsmDbImportSnapshot
  )
import Paths_ouroboros_consensus (version)
import System.Exit
import System.FSNotify
import System.FilePath (splitDirectories, splitFileName, (</>))
import System.Info (arch, compilerName, compilerVersion, os)

{-------------------------------------------------------------------------------
  Commands
-------------------------------------------------------------------------------}

-- | The various ways in which the tool can be invoked.
--
-- 'Daemon' and 'Convert' operate purely on /standalone (exported) LSM
-- snapshots/ and Mem snapshots; they never touch a live LSM database, and so
-- carry the 'CardanoBlockArgs' needed to decode ledger states.
--
-- 'LsmExport' and 'LsmImport' operate directly on a (offline) LSM database; no
-- ledger decoding is involved, hence no 'CardanoBlockArgs'.
data Command
  = Daemon DaemonOpts CardanoBlockArgs
  | Convert ConvertOpts CardanoBlockArgs
  | LsmExport LsmDbOpts
  | LsmImport LsmDbOpts

-- | Options for the daemon: watch a directory for completed snapshots and
-- convert each exported LSM snapshot into a Mem snapshot.
data DaemonOpts = DaemonOpts
  { DaemonOpts -> [Char]
daemonMonitorMetaDir :: FilePath
  -- ^ The directory holding the @state@/@meta@ files of the snapshots produced
  -- by the node (watched for completed snapshots).
  , DaemonOpts -> [Char]
daemonLsmSnapshotsExportDir :: FilePath
  -- ^ The directory into which the node exports its LSM snapshots. The exported
  -- snapshot for a snapshot named @N@ is expected at @<this>/N@.
  , DaemonOpts -> [Char]
daemonMemSnapshotDir :: FilePath
  -- ^ The directory into which to write the converted Mem snapshots.
  }

-- | Options for a one-shot conversion between an exported LSM snapshot and a Mem
-- snapshot (in either direction).
data ConvertOpts = ConvertOpts
  { ConvertOpts -> [Char]
convertSnapshotInDir :: FilePath
  -- ^ The input snapshot (a directory named after the slot, holding at least the
  -- @state@/@meta@ files).
  , ConvertOpts -> Maybe [Char]
convertImportInDir :: Maybe FilePath
  -- ^ If set, the input is an exported LSM snapshot whose tables live at
  -- @<this>/<input snapshot name>@; otherwise the input is a Mem snapshot.
  , ConvertOpts -> [Char]
convertSnapshotOutDir :: FilePath
  -- ^ The output snapshot (a directory named after the slot).
  , ConvertOpts -> Maybe [Char]
convertExportOutDir :: Maybe FilePath
  -- ^ If set, the output is an exported LSM snapshot whose tables are written to
  -- @<this>/<output snapshot name>@; otherwise the output is a Mem snapshot.
  }

-- | Options for the @lsm export@/@lsm import@ commands.
data LsmDbOpts = LsmDbOpts
  { LsmDbOpts -> [Char]
lsmDbDir :: FilePath
  -- ^ The LSM database (session) directory.
  , LsmDbOpts -> [Char]
lsmRootDir :: FilePath
  -- ^ The export-to (for @export@) or import-from (for @import@) root directory.
  -- The exported snapshot named @N@ lives at @<this>/N@.
  , LsmDbOpts -> [Char]
lsmSnapName :: String
  -- ^ The snapshot name, e.g. @163470034@ or @163470034_my-suffix@.
  }

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
  cmd <- ParserInfo Command -> IO Command
forall a. ParserInfo a -> IO a
execParser ParserInfo Command
opts
  case cmd of
    Daemon DaemonOpts
o CardanoBlockArgs
args -> DaemonOpts -> CardanoBlockArgs -> IO ()
runDaemon DaemonOpts
o CardanoBlockArgs
args
    Convert ConvertOpts
o CardanoBlockArgs
args -> ConvertOpts -> CardanoBlockArgs -> IO ()
runConvert ConvertOpts
o CardanoBlockArgs
args
    LsmExport LsmDbOpts
o -> LsmDbOpts -> ([Char] -> [Char] -> [Char] -> IO ()) -> IO ()
runLsmDb LsmDbOpts
o [Char] -> [Char] -> [Char] -> IO ()
lsmDbExportSnapshot
    LsmImport LsmDbOpts
o -> LsmDbOpts -> ([Char] -> [Char] -> [Char] -> IO ()) -> IO ()
runLsmDb LsmDbOpts
o [Char] -> [Char] -> [Char] -> IO ()
lsmDbImportSnapshot

{-------------------------------------------------------------------------------
  Running the commands
-------------------------------------------------------------------------------}

runConvert :: ConvertOpts -> CardanoBlockArgs -> IO ()
runConvert :: ConvertOpts -> CardanoBlockArgs -> IO ()
runConvert ConvertOpts
o CardanoBlockArgs
args = do
  pInfo <- CardanoBlockArgs -> IO (ProtocolInfo (CardanoBlock StandardCrypto))
forall blk.
HasProtocolInfo blk =>
Args blk -> IO (ProtocolInfo blk)
mkProtocolInfo CardanoBlockArgs
args
  from <- mkSnapshot (convertSnapshotInDir o) (convertImportInDir o)
  to <- mkSnapshot (convertSnapshotOutDir o) (convertExportOutDir o)
  eRes <- runExceptT (convertSnapshot True pInfo from to)
  case eRes of
    Left Error (CardanoBlock StandardCrypto)
err -> [Char] -> IO ()
putStrLn (Error (CardanoBlock StandardCrypto) -> [Char]
forall a. Show a => a -> [Char]
show Error (CardanoBlock StandardCrypto)
err) IO () -> IO () -> IO ()
forall a b. IO a -> IO b -> IO b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> IO ()
forall a. IO a
exitFailure
    Right () -> IO ()
forall a. IO a
exitSuccess

runDaemon :: DaemonOpts -> CardanoBlockArgs -> IO ()
runDaemon :: DaemonOpts -> CardanoBlockArgs -> IO ()
runDaemon DaemonOpts
o CardanoBlockArgs
args = do
  pInfo <- CardanoBlockArgs -> IO (ProtocolInfo (CardanoBlock StandardCrypto))
forall blk.
HasProtocolInfo blk =>
Args blk -> IO (ProtocolInfo blk)
mkProtocolInfo CardanoBlockArgs
args
  let monitorDir = DaemonOpts -> [Char]
daemonMonitorMetaDir DaemonOpts
o
  withManager $ \WatchManager
manager -> do
    [Char] -> IO ()
putStrLn ([Char] -> IO ()) -> [Char] -> IO ()
forall a b. (a -> b) -> a -> b
$ [Char]
"Watching " [Char] -> [Char] -> [Char]
forall a. Semigroup a => a -> a -> a
<> [Char] -> [Char]
forall a. Show a => a -> [Char]
show [Char]
monitorDir
    IO (IO ()) -> IO ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (IO (IO ()) -> IO ()) -> IO (IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$
      WatchManager -> [Char] -> ActionPredicate -> Action -> IO (IO ())
watchTree
        WatchManager
manager
        [Char]
monitorDir
        ( \case
            CloseWrite [Char]
ep UTCTime
_ EventIsDirectory
IsFile -> [Char]
"meta" [Char] -> [Char] -> Bool
forall a. Eq a => [a] -> [a] -> Bool
`L.isSuffixOf` [Char]
ep
            Event
_ -> Bool
False
        )
        ( \case
            CloseWrite [Char]
ep UTCTime
_ EventIsDirectory
IsFile ->
              case [[Char]] -> [[Char]]
forall a. [a] -> [a]
reverse ([[Char]] -> [[Char]]) -> [[Char]] -> [[Char]]
forall a b. (a -> b) -> a -> b
$ [Char] -> [[Char]]
splitDirectories [Char]
ep of
                ([Char]
_ : name :: [Char]
name@([Char] -> Maybe DiskSnapshot
snapshotFromPath -> Just DiskSnapshot
ds) : [[Char]]
_) -> do
                  let exportedDir :: [Char]
exportedDir = DaemonOpts -> [Char]
daemonLsmSnapshotsExportDir DaemonOpts
o [Char] -> [Char] -> [Char]
</> [Char]
name
                      from :: Snapshot
from =
                        SnapshotsDirectoryWithFormat -> DiskSnapshot -> Snapshot
Snapshot
                          ( SnapshotsDirectory
-> ExportedSnapshotPath -> SnapshotsDirectoryWithFormat
ExportedLSMSnapshot
                              ([Char] -> SnapshotsDirectory
SnapshotsDirectory [Char]
monitorDir)
                              ([Char] -> ExportedSnapshotPath
ExportedSnapshotPath [Char]
exportedDir)
                          )
                          DiskSnapshot
ds
                      to :: Snapshot
to =
                        SnapshotsDirectoryWithFormat -> DiskSnapshot -> Snapshot
Snapshot
                          (SnapshotsDirectory
-> StandaloneFormat -> SnapshotsDirectoryWithFormat
StandaloneSnapshot ([Char] -> SnapshotsDirectory
SnapshotsDirectory (DaemonOpts -> [Char]
daemonMemSnapshotDir DaemonOpts
o)) StandaloneFormat
Mem)
                          DiskSnapshot
ds
                  [Char] -> IO ()
putStrLn ([Char] -> IO ()) -> [Char] -> IO ()
forall a b. (a -> b) -> a -> b
$
                    [Char]
"Converting snapshot " [Char] -> [Char] -> [Char]
forall a. Semigroup a => a -> a -> a
<> [Char]
ep [Char] -> [Char] -> [Char]
forall a. Semigroup a => a -> a -> a
<> [Char]
" to " [Char] -> [Char] -> [Char]
forall a. Semigroup a => a -> a -> a
<> (DaemonOpts -> [Char]
daemonMemSnapshotDir DaemonOpts
o [Char] -> [Char] -> [Char]
</> [Char]
name)
                  res <- ExceptT (Error (CardanoBlock StandardCrypto)) IO ()
-> IO (Either (Error (CardanoBlock StandardCrypto)) ())
forall e (m :: * -> *) a. ExceptT e m a -> m (Either e a)
runExceptT (Bool
-> ProtocolInfo (CardanoBlock StandardCrypto)
-> Snapshot
-> Snapshot
-> ExceptT (Error (CardanoBlock StandardCrypto)) IO ()
convertSnapshot Bool
False ProtocolInfo (CardanoBlock StandardCrypto)
pInfo Snapshot
from Snapshot
to)
                  case res of
                    Left Error (CardanoBlock StandardCrypto)
err -> [Char] -> IO ()
putStrLn ([Char] -> IO ()) -> [Char] -> IO ()
forall a b. (a -> b) -> a -> b
$ Error (CardanoBlock StandardCrypto) -> [Char]
forall a. Show a => a -> [Char]
show Error (CardanoBlock StandardCrypto)
err
                    Right () -> [Char] -> IO ()
putStrLn [Char]
"Done"
                [[Char]]
_ -> () -> IO ()
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ()
            Event
_ -> () -> IO ()
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ()
        )
    IO () -> IO ()
forall (f :: * -> *) a b. Applicative f => f a -> f b
forever (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$ Int -> IO ()
threadDelay Int
1000000

-- | Validate the snapshot name and run an LSM database operation (export or
-- import) on the snapshot directory @<root>/<name>@, reporting the result.
runLsmDb :: LsmDbOpts -> (FilePath -> String -> FilePath -> IO ()) -> IO ()
runLsmDb :: LsmDbOpts -> ([Char] -> [Char] -> [Char] -> IO ()) -> IO ()
runLsmDb LsmDbOpts
o [Char] -> [Char] -> [Char] -> IO ()
op = do
  IO DiskSnapshot -> IO ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (IO DiskSnapshot -> IO ()) -> IO DiskSnapshot -> IO ()
forall a b. (a -> b) -> a -> b
$ [Char] -> IO DiskSnapshot
requireSnapshotName [Char]
name
  res <- IO () -> IO (Either SomeException ())
forall e a. Exception e => IO a -> IO (Either e a)
try (IO () -> IO (Either SomeException ()))
-> IO () -> IO (Either SomeException ())
forall a b. (a -> b) -> a -> b
$ [Char] -> [Char] -> [Char] -> IO ()
op (LsmDbOpts -> [Char]
lsmDbDir LsmDbOpts
o) [Char]
name (LsmDbOpts -> [Char]
lsmRootDir LsmDbOpts
o [Char] -> [Char] -> [Char]
</> [Char]
name)
  case res of
    Left (SomeException
e :: SomeException) -> [Char] -> IO ()
putStrLn (SomeException -> [Char]
forall e. Exception e => e -> [Char]
displayException SomeException
e) IO () -> IO () -> IO ()
forall a b. IO a -> IO b -> IO b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> IO ()
forall a. IO a
exitFailure
    Right () -> [Char] -> IO ()
putStrLn [Char]
"Done" IO () -> IO () -> IO ()
forall a b. IO a -> IO b -> IO b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> IO ()
forall a. IO a
exitSuccess
 where
  name :: [Char]
name = LsmDbOpts -> [Char]
lsmSnapName LsmDbOpts
o

-- | Parse a snapshot name, exiting with a helpful message if it is malformed.
requireSnapshotName :: String -> IO DiskSnapshot
requireSnapshotName :: [Char] -> IO DiskSnapshot
requireSnapshotName [Char]
name =
  case [Char] -> Maybe DiskSnapshot
snapshotFromPath [Char]
name of
    Just DiskSnapshot
ds -> DiskSnapshot -> IO DiskSnapshot
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure DiskSnapshot
ds
    Maybe DiskSnapshot
Nothing -> do
      [Char] -> IO ()
putStrLn ([Char] -> IO ()) -> [Char] -> IO ()
forall a b. (a -> b) -> a -> b
$
        [Char]
"\""
          [Char] -> [Char] -> [Char]
forall a. Semigroup a => a -> a -> a
<> [Char]
name
          [Char] -> [Char] -> [Char]
forall a. Semigroup a => a -> a -> a
<> [Char]
"\" is not a valid snapshot name. It should be named after the slot"
          [Char] -> [Char] -> [Char]
forall a. Semigroup a => a -> a -> a
<> [Char]
" number of the contained state and an optional suffix, such as"
          [Char] -> [Char] -> [Char]
forall a. Semigroup a => a -> a -> a
<> [Char]
" `163470034` or `163470034_my-suffix`."
      IO DiskSnapshot
forall a. IO a
exitFailure

-- | Interpret a snapshot path plus an optional exported-LSM root directory as a
-- 'Snapshot'. When the root is given, the snapshot is an exported LSM snapshot
-- whose tables live at @<root>/<snapshot name>@; otherwise it is a Mem snapshot.
mkSnapshot :: FilePath -> Maybe FilePath -> IO Snapshot
mkSnapshot :: [Char] -> Maybe [Char] -> IO Snapshot
mkSnapshot [Char]
snapPath Maybe [Char]
mExportRoot = do
  let ([Char]
parent, [Char]
name) = [Char] -> ([Char], [Char])
splitFileName [Char]
snapPath
  ds <- [Char] -> IO DiskSnapshot
requireSnapshotName [Char]
name
  pure $
    Snapshot
      ( case mExportRoot of
          Just [Char]
root ->
            SnapshotsDirectory
-> ExportedSnapshotPath -> SnapshotsDirectoryWithFormat
ExportedLSMSnapshot
              ([Char] -> SnapshotsDirectory
SnapshotsDirectory [Char]
parent)
              ([Char] -> ExportedSnapshotPath
ExportedSnapshotPath ([Char]
root [Char] -> [Char] -> [Char]
</> [Char]
name))
          Maybe [Char]
Nothing -> SnapshotsDirectory
-> StandaloneFormat -> SnapshotsDirectoryWithFormat
StandaloneSnapshot ([Char] -> SnapshotsDirectory
SnapshotsDirectory [Char]
parent) StandaloneFormat
Mem
      )
      ds

{-------------------------------------------------------------------------------
  Optparse-applicative
-------------------------------------------------------------------------------}

opts :: ParserInfo Command
opts :: ParserInfo Command
opts =
  Parser Command -> InfoMod Command -> ParserInfo Command
forall a. Parser a -> InfoMod a -> ParserInfo a
info
    (Parser Command
commandParser Parser Command -> Parser (Command -> Command) -> Parser Command
forall (f :: * -> *) a b. Applicative f => f a -> f (a -> b) -> f b
<**> Parser (Command -> Command)
forall a. Parser (a -> a)
versionOption Parser Command -> Parser (Command -> Command) -> Parser Command
forall (f :: * -> *) a b. Applicative f => f a -> f (a -> b) -> f b
<**> Parser (Command -> Command)
forall a. Parser (a -> a)
helper)
    ( InfoMod Command
forall a. InfoMod a
fullDesc
        InfoMod Command -> InfoMod Command -> InfoMod Command
forall a. Semigroup a => a -> a -> a
<> [Char] -> InfoMod Command
forall a. [Char] -> InfoMod a
header
          [Char]
"Utility for managing and converting the ledger snapshots used by cardano-node."
        InfoMod Command -> InfoMod Command -> InfoMod Command
forall a. Semigroup a => a -> a -> a
<> [Char] -> InfoMod Command
forall a. [Char] -> InfoMod a
progDesc
          ( [Char]
"Conversions operate on Mem snapshots and standalone (exported) LSM"
              [Char] -> [Char] -> [Char]
forall a. Semigroup a => a -> a -> a
<> [Char]
" snapshots, never on live LSM databases. Use the `lsm` commands to"
              [Char] -> [Char] -> [Char]
forall a. Semigroup a => a -> a -> a
<> [Char]
" export snapshots out of, or import snapshots into, an offline LSM"
              [Char] -> [Char] -> [Char]
forall a. Semigroup a => a -> a -> a
<> [Char]
" database."
          )
        InfoMod Command -> InfoMod Command -> InfoMod Command
forall a. Semigroup a => a -> a -> a
<> Maybe Doc -> InfoMod Command
forall a. Maybe Doc -> InfoMod a
footerDoc (Doc -> Maybe Doc
forall a. a -> Maybe a
Just Doc
examplesFooter)
    )

-- | Report the tool version. The snapshot on-disk format is tied to the
-- ouroboros-consensus code, so we report the ouroboros-consensus package
-- version together with the exact git commit this tool was built from; that
-- pair identifies which builds a given snapshot is compatible with. We also
-- report the build platform and compiler, following the @cardano-cli
-- --version@ format.
versionOption :: Parser (a -> a)
versionOption :: forall a. Parser (a -> a)
versionOption =
  [Char] -> Mod OptionFields (a -> a) -> Parser (a -> a)
forall a. [Char] -> Mod OptionFields (a -> a) -> Parser (a -> a)
infoOption
    [Char]
versionString
    ( [Char] -> Mod OptionFields (a -> a)
forall (f :: * -> *) a. HasName f => [Char] -> Mod f a
long [Char]
"version"
        Mod OptionFields (a -> a)
-> Mod OptionFields (a -> a) -> Mod OptionFields (a -> a)
forall a. Semigroup a => a -> a -> a
<> [Char] -> Mod OptionFields (a -> a)
forall (f :: * -> *) a. [Char] -> Mod f a
help [Char]
"Show version, build platform and git commit, then exit."
    )

versionString :: String
versionString :: [Char]
versionString =
  [Char]
"snapshot-converter, part of ouroboros-consensus "
    [Char] -> [Char] -> [Char]
forall a. Semigroup a => a -> a -> a
<> Version -> [Char]
showVersion Version
version
    [Char] -> [Char] -> [Char]
forall a. Semigroup a => a -> a -> a
<> [Char]
" - "
    [Char] -> [Char] -> [Char]
forall a. Semigroup a => a -> a -> a
<> [Char]
os
    [Char] -> [Char] -> [Char]
forall a. Semigroup a => a -> a -> a
<> [Char]
"-"
    [Char] -> [Char] -> [Char]
forall a. Semigroup a => a -> a -> a
<> [Char]
arch
    [Char] -> [Char] -> [Char]
forall a. Semigroup a => a -> a -> a
<> [Char]
" - "
    [Char] -> [Char] -> [Char]
forall a. Semigroup a => a -> a -> a
<> [Char]
compilerName
    [Char] -> [Char] -> [Char]
forall a. Semigroup a => a -> a -> a
<> [Char]
"-"
    [Char] -> [Char] -> [Char]
forall a. Semigroup a => a -> a -> a
<> Version -> [Char]
showVersion Version
compilerVersion
    [Char] -> [Char] -> [Char]
forall a. Semigroup a => a -> a -> a
<> [Char]
"\ngit rev "
    [Char] -> [Char] -> [Char]
forall a. Semigroup a => a -> a -> a
<> Text -> [Char]
T.unpack Text
gitRev

-- | Worked examples covering the expected flows, shown at the bottom of the
-- top-level @--help@ output. The @convert@ examples require @--config@; the
-- @lsm@ examples operate directly on an offline database and do not.
examplesFooter :: Doc
examplesFooter :: Doc
examplesFooter =
  [Char] -> Doc
forall ann. [Char] -> Doc ann
forall a ann. Pretty a => a -> Doc ann
pretty ([Char] -> Doc) -> [Char] -> Doc
forall a b. (a -> b) -> a -> b
$
    [Char] -> [[Char]] -> [Char]
forall a. [a] -> [[a]] -> [a]
L.intercalate
      [Char]
"\n"
      [ [Char]
"Typical flows (a snapshot is a directory named after its slot, e.g. `100`"
      , [Char]
"or `100_my-suffix`):"
      , [Char]
""
      , [Char]
"  # Mem snapshot -> standalone (exported) LSM snapshot"
      , [Char]
"  snapshot-converter convert --config CONFIG \\"
      , [Char]
"    --snapshot-in  SNAPSHOTS/100 \\"
      , [Char]
"    --snapshot-out OUT/100 \\"
      , [Char]
"    --lsm-export-to EXPORTED"
      , [Char]
""
      , [Char]
"  # standalone (exported) LSM snapshot -> Mem snapshot"
      , [Char]
"  snapshot-converter convert --config CONFIG \\"
      , [Char]
"    --snapshot-in    SNAPSHOTS/100 \\"
      , [Char]
"    --lsm-import-from EXPORTED \\"
      , [Char]
"    --snapshot-out   OUT/100"
      , [Char]
""
      , [Char]
"  # import a standalone (exported) LSM snapshot into a new offline LSM database"
      , [Char]
"  snapshot-converter lsm import \\"
      , [Char]
"    --lsm-database    LSM_DB \\"
      , [Char]
"    --lsm-import-from EXPORTED \\"
      , [Char]
"    --snapshot        100"
      , [Char]
""
      , [Char]
"  # export a snapshot out of an offline LSM database"
      , [Char]
"  snapshot-converter lsm export \\"
      , [Char]
"    --lsm-database  LSM_DB \\"
      , [Char]
"    --lsm-export-to EXPORTED \\"
      , [Char]
"    --snapshot      100"
      ]

commandParser :: Parser Command
commandParser :: Parser Command
commandParser =
  Mod CommandFields Command -> Parser Command
forall a. Mod CommandFields a -> Parser a
hsubparser
    ( [Char] -> ParserInfo Command -> Mod CommandFields Command
forall a. [Char] -> ParserInfo a -> Mod CommandFields a
command
        [Char]
"daemon"
        ( Parser Command -> InfoMod Command -> ParserInfo Command
forall a. Parser a -> InfoMod a -> ParserInfo a
info
            Parser Command
daemonCmd
            ( [Char] -> InfoMod Command
forall a. [Char] -> InfoMod a
progDesc ([Char] -> InfoMod Command) -> [Char] -> InfoMod Command
forall a b. (a -> b) -> a -> b
$
                [Char]
"Watch a directory for completed snapshots and convert each exported"
                  [Char] -> [Char] -> [Char]
forall a. Semigroup a => a -> a -> a
<> [Char]
" LSM snapshot into a Mem snapshot as it is produced. Meaningful"
                  [Char] -> [Char] -> [Char]
forall a. Semigroup a => a -> a -> a
<> [Char]
" only for a node producing LSM snapshots."
            )
        )
        Mod CommandFields Command
-> Mod CommandFields Command -> Mod CommandFields Command
forall a. Semigroup a => a -> a -> a
<> [Char] -> ParserInfo Command -> Mod CommandFields Command
forall a. [Char] -> ParserInfo a -> Mod CommandFields a
command
          [Char]
"convert"
          ( Parser Command -> InfoMod Command -> ParserInfo Command
forall a. Parser a -> InfoMod a -> ParserInfo a
info
              Parser Command
convertCmd
              ( [Char] -> InfoMod Command
forall a. [Char] -> InfoMod a
progDesc ([Char] -> InfoMod Command) -> [Char] -> InfoMod Command
forall a b. (a -> b) -> a -> b
$
                  [Char]
"Convert a single snapshot between an exported LSM snapshot and a Mem"
                    [Char] -> [Char] -> [Char]
forall a. Semigroup a => a -> a -> a
<> [Char]
" snapshot. The input/output paths must be named after the slot"
                    [Char] -> [Char] -> [Char]
forall a. Semigroup a => a -> a -> a
<> [Char]
" number of the contained state (e.g. `100` or `100_my-suffix`)."
              )
          )
        Mod CommandFields Command
-> Mod CommandFields Command -> Mod CommandFields Command
forall a. Semigroup a => a -> a -> a
<> [Char] -> ParserInfo Command -> Mod CommandFields Command
forall a. [Char] -> ParserInfo a -> Mod CommandFields a
command
          [Char]
"lsm"
          ( Parser Command -> InfoMod Command -> ParserInfo Command
forall a. Parser a -> InfoMod a -> ParserInfo a
info
              Parser Command
lsmCmd
              ([Char] -> InfoMod Command
forall a. [Char] -> InfoMod a
progDesc [Char]
"Export snapshots out of / import snapshots into an offline LSM database.")
          )
    )

daemonCmd :: Parser Command
daemonCmd :: Parser Command
daemonCmd =
  DaemonOpts -> CardanoBlockArgs -> Command
Daemon
    (DaemonOpts -> CardanoBlockArgs -> Command)
-> Parser DaemonOpts -> Parser (CardanoBlockArgs -> Command)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ( [Char] -> [Char] -> [Char] -> DaemonOpts
DaemonOpts
            ([Char] -> [Char] -> [Char] -> DaemonOpts)
-> Parser [Char] -> Parser ([Char] -> [Char] -> DaemonOpts)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Mod OptionFields [Char] -> Parser [Char]
forall s. IsString s => Mod OptionFields s -> Parser s
strOption
              ( [Char] -> Mod OptionFields [Char]
forall (f :: * -> *) a. HasName f => [Char] -> Mod f a
long [Char]
"monitor-snapshots-in"
                  Mod OptionFields [Char]
-> Mod OptionFields [Char] -> Mod OptionFields [Char]
forall a. Semigroup a => a -> a -> a
<> [Char] -> Mod OptionFields [Char]
forall (f :: * -> *) a. HasMetavar f => [Char] -> Mod f a
metavar [Char]
"DIR"
                  Mod OptionFields [Char]
-> Mod OptionFields [Char] -> Mod OptionFields [Char]
forall a. Semigroup a => a -> a -> a
<> [Char] -> Mod OptionFields [Char]
forall (f :: * -> *) a. [Char] -> Mod f a
help [Char]
"Directory with the node's snapshots (state/meta), watched for completion."
              )
            Parser ([Char] -> [Char] -> DaemonOpts)
-> Parser [Char] -> Parser ([Char] -> DaemonOpts)
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Mod OptionFields [Char] -> Parser [Char]
forall s. IsString s => Mod OptionFields s -> Parser s
strOption
              ( [Char] -> Mod OptionFields [Char]
forall (f :: * -> *) a. HasName f => [Char] -> Mod f a
long [Char]
"lsm-exported-path"
                  Mod OptionFields [Char]
-> Mod OptionFields [Char] -> Mod OptionFields [Char]
forall a. Semigroup a => a -> a -> a
<> [Char] -> Mod OptionFields [Char]
forall (f :: * -> *) a. HasMetavar f => [Char] -> Mod f a
metavar [Char]
"DIR"
                  Mod OptionFields [Char]
-> Mod OptionFields [Char] -> Mod OptionFields [Char]
forall a. Semigroup a => a -> a -> a
<> [Char] -> Mod OptionFields [Char]
forall (f :: * -> *) a. [Char] -> Mod f a
help [Char]
"Directory into which the node exports its LSM snapshots."
              )
            Parser ([Char] -> DaemonOpts) -> Parser [Char] -> Parser DaemonOpts
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Mod OptionFields [Char] -> Parser [Char]
forall s. IsString s => Mod OptionFields s -> Parser s
strOption
              ( [Char] -> Mod OptionFields [Char]
forall (f :: * -> *) a. HasName f => [Char] -> Mod f a
long [Char]
"output-snapshots-in"
                  Mod OptionFields [Char]
-> Mod OptionFields [Char] -> Mod OptionFields [Char]
forall a. Semigroup a => a -> a -> a
<> [Char] -> Mod OptionFields [Char]
forall (f :: * -> *) a. HasMetavar f => [Char] -> Mod f a
metavar [Char]
"DIR"
                  Mod OptionFields [Char]
-> Mod OptionFields [Char] -> Mod OptionFields [Char]
forall a. Semigroup a => a -> a -> a
<> [Char] -> Mod OptionFields [Char]
forall (f :: * -> *) a. [Char] -> Mod f a
help [Char]
"Directory into which to write the converted Mem snapshots."
              )
        )
    Parser (CardanoBlockArgs -> Command)
-> Parser CardanoBlockArgs -> Parser Command
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Parser CardanoBlockArgs
parseCardanoArgs

convertCmd :: Parser Command
convertCmd :: Parser Command
convertCmd =
  ConvertOpts -> CardanoBlockArgs -> Command
Convert
    (ConvertOpts -> CardanoBlockArgs -> Command)
-> Parser ConvertOpts -> Parser (CardanoBlockArgs -> Command)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ( [Char] -> Maybe [Char] -> [Char] -> Maybe [Char] -> ConvertOpts
ConvertOpts
            ([Char] -> Maybe [Char] -> [Char] -> Maybe [Char] -> ConvertOpts)
-> Parser [Char]
-> Parser (Maybe [Char] -> [Char] -> Maybe [Char] -> ConvertOpts)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Mod OptionFields [Char] -> Parser [Char]
forall s. IsString s => Mod OptionFields s -> Parser s
strOption
              ( [Char] -> Mod OptionFields [Char]
forall (f :: * -> *) a. HasName f => [Char] -> Mod f a
long [Char]
"snapshot-in"
                  Mod OptionFields [Char]
-> Mod OptionFields [Char] -> Mod OptionFields [Char]
forall a. Semigroup a => a -> a -> a
<> [Char] -> Mod OptionFields [Char]
forall (f :: * -> *) a. HasMetavar f => [Char] -> Mod f a
metavar [Char]
"PATH"
                  Mod OptionFields [Char]
-> Mod OptionFields [Char] -> Mod OptionFields [Char]
forall a. Semigroup a => a -> a -> a
<> [Char] -> Mod OptionFields [Char]
forall (f :: * -> *) a. [Char] -> Mod f a
help [Char]
"The input snapshot (directory named after the slot)."
              )
            Parser (Maybe [Char] -> [Char] -> Maybe [Char] -> ConvertOpts)
-> Parser (Maybe [Char])
-> Parser ([Char] -> Maybe [Char] -> ConvertOpts)
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Parser [Char] -> Parser (Maybe [Char])
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
optional
              ( Mod OptionFields [Char] -> Parser [Char]
forall s. IsString s => Mod OptionFields s -> Parser s
strOption
                  ( [Char] -> Mod OptionFields [Char]
forall (f :: * -> *) a. HasName f => [Char] -> Mod f a
long [Char]
"lsm-import-from"
                      Mod OptionFields [Char]
-> Mod OptionFields [Char] -> Mod OptionFields [Char]
forall a. Semigroup a => a -> a -> a
<> [Char] -> Mod OptionFields [Char]
forall (f :: * -> *) a. HasMetavar f => [Char] -> Mod f a
metavar [Char]
"DIR"
                      Mod OptionFields [Char]
-> Mod OptionFields [Char] -> Mod OptionFields [Char]
forall a. Semigroup a => a -> a -> a
<> [Char] -> Mod OptionFields [Char]
forall (f :: * -> *) a. [Char] -> Mod f a
help [Char]
"If set, the input is an exported LSM snapshot rooted here."
                  )
              )
            Parser ([Char] -> Maybe [Char] -> ConvertOpts)
-> Parser [Char] -> Parser (Maybe [Char] -> ConvertOpts)
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Mod OptionFields [Char] -> Parser [Char]
forall s. IsString s => Mod OptionFields s -> Parser s
strOption
              ( [Char] -> Mod OptionFields [Char]
forall (f :: * -> *) a. HasName f => [Char] -> Mod f a
long [Char]
"snapshot-out"
                  Mod OptionFields [Char]
-> Mod OptionFields [Char] -> Mod OptionFields [Char]
forall a. Semigroup a => a -> a -> a
<> [Char] -> Mod OptionFields [Char]
forall (f :: * -> *) a. HasMetavar f => [Char] -> Mod f a
metavar [Char]
"PATH"
                  Mod OptionFields [Char]
-> Mod OptionFields [Char] -> Mod OptionFields [Char]
forall a. Semigroup a => a -> a -> a
<> [Char] -> Mod OptionFields [Char]
forall (f :: * -> *) a. [Char] -> Mod f a
help [Char]
"The output snapshot (directory named after the slot)."
              )
            Parser (Maybe [Char] -> ConvertOpts)
-> Parser (Maybe [Char]) -> Parser ConvertOpts
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Parser [Char] -> Parser (Maybe [Char])
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
optional
              ( Mod OptionFields [Char] -> Parser [Char]
forall s. IsString s => Mod OptionFields s -> Parser s
strOption
                  ( [Char] -> Mod OptionFields [Char]
forall (f :: * -> *) a. HasName f => [Char] -> Mod f a
long [Char]
"lsm-export-to"
                      Mod OptionFields [Char]
-> Mod OptionFields [Char] -> Mod OptionFields [Char]
forall a. Semigroup a => a -> a -> a
<> [Char] -> Mod OptionFields [Char]
forall (f :: * -> *) a. HasMetavar f => [Char] -> Mod f a
metavar [Char]
"DIR"
                      Mod OptionFields [Char]
-> Mod OptionFields [Char] -> Mod OptionFields [Char]
forall a. Semigroup a => a -> a -> a
<> [Char] -> Mod OptionFields [Char]
forall (f :: * -> *) a. [Char] -> Mod f a
help [Char]
"If set, the output is an exported LSM snapshot rooted here."
                  )
              )
        )
    Parser (CardanoBlockArgs -> Command)
-> Parser CardanoBlockArgs -> Parser Command
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Parser CardanoBlockArgs
parseCardanoArgs

lsmCmd :: Parser Command
lsmCmd :: Parser Command
lsmCmd =
  Mod CommandFields Command -> Parser Command
forall a. Mod CommandFields a -> Parser a
hsubparser
    ( [Char] -> ParserInfo Command -> Mod CommandFields Command
forall a. [Char] -> ParserInfo a -> Mod CommandFields a
command
        [Char]
"export"
        ( Parser Command -> InfoMod Command -> ParserInfo Command
forall a. Parser a -> InfoMod a -> ParserInfo a
info
            ( LsmDbOpts -> Command
LsmExport
                (LsmDbOpts -> Command) -> Parser LsmDbOpts -> Parser Command
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [Char] -> [Char] -> Parser LsmDbOpts
lsmDbOpts [Char]
"lsm-export-to" [Char]
"Root directory to export the snapshot into (as <DIR>/<snapshot>)."
            )
            ([Char] -> InfoMod Command
forall a. [Char] -> InfoMod a
progDesc [Char]
"Export a snapshot out of an offline LSM database into a standalone directory.")
        )
        Mod CommandFields Command
-> Mod CommandFields Command -> Mod CommandFields Command
forall a. Semigroup a => a -> a -> a
<> [Char] -> ParserInfo Command -> Mod CommandFields Command
forall a. [Char] -> ParserInfo a -> Mod CommandFields a
command
          [Char]
"import"
          ( Parser Command -> InfoMod Command -> ParserInfo Command
forall a. Parser a -> InfoMod a -> ParserInfo a
info
              ( LsmDbOpts -> Command
LsmImport
                  (LsmDbOpts -> Command) -> Parser LsmDbOpts -> Parser Command
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [Char] -> [Char] -> Parser LsmDbOpts
lsmDbOpts [Char]
"lsm-import-from" [Char]
"Root directory holding the exported snapshot (at <DIR>/<snapshot>)."
              )
              ( [Char] -> InfoMod Command
forall a. [Char] -> InfoMod a
progDesc
                  [Char]
"Import an exported snapshot into a new (offline) LSM database."
              )
          )
    )

lsmDbOpts :: String -> String -> Parser LsmDbOpts
lsmDbOpts :: [Char] -> [Char] -> Parser LsmDbOpts
lsmDbOpts [Char]
dirFlag [Char]
dirHelp =
  [Char] -> [Char] -> [Char] -> LsmDbOpts
LsmDbOpts
    ([Char] -> [Char] -> [Char] -> LsmDbOpts)
-> Parser [Char] -> Parser ([Char] -> [Char] -> LsmDbOpts)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Mod OptionFields [Char] -> Parser [Char]
forall s. IsString s => Mod OptionFields s -> Parser s
strOption
      ( [Char] -> Mod OptionFields [Char]
forall (f :: * -> *) a. HasName f => [Char] -> Mod f a
long [Char]
"lsm-database"
          Mod OptionFields [Char]
-> Mod OptionFields [Char] -> Mod OptionFields [Char]
forall a. Semigroup a => a -> a -> a
<> [Char] -> Mod OptionFields [Char]
forall (f :: * -> *) a. HasMetavar f => [Char] -> Mod f a
metavar [Char]
"DIR"
          Mod OptionFields [Char]
-> Mod OptionFields [Char] -> Mod OptionFields [Char]
forall a. Semigroup a => a -> a -> a
<> [Char] -> Mod OptionFields [Char]
forall (f :: * -> *) a. [Char] -> Mod f a
help [Char]
"The LSM database (session) directory."
      )
    Parser ([Char] -> [Char] -> LsmDbOpts)
-> Parser [Char] -> Parser ([Char] -> LsmDbOpts)
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Mod OptionFields [Char] -> Parser [Char]
forall s. IsString s => Mod OptionFields s -> Parser s
strOption
      ( [Char] -> Mod OptionFields [Char]
forall (f :: * -> *) a. HasName f => [Char] -> Mod f a
long [Char]
dirFlag
          Mod OptionFields [Char]
-> Mod OptionFields [Char] -> Mod OptionFields [Char]
forall a. Semigroup a => a -> a -> a
<> [Char] -> Mod OptionFields [Char]
forall (f :: * -> *) a. HasMetavar f => [Char] -> Mod f a
metavar [Char]
"DIR"
          Mod OptionFields [Char]
-> Mod OptionFields [Char] -> Mod OptionFields [Char]
forall a. Semigroup a => a -> a -> a
<> [Char] -> Mod OptionFields [Char]
forall (f :: * -> *) a. [Char] -> Mod f a
help [Char]
dirHelp
      )
    Parser ([Char] -> LsmDbOpts) -> Parser [Char] -> Parser LsmDbOpts
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Mod OptionFields [Char] -> Parser [Char]
forall s. IsString s => Mod OptionFields s -> Parser s
strOption
      ( [Char] -> Mod OptionFields [Char]
forall (f :: * -> *) a. HasName f => [Char] -> Mod f a
long [Char]
"snapshot"
          Mod OptionFields [Char]
-> Mod OptionFields [Char] -> Mod OptionFields [Char]
forall a. Semigroup a => a -> a -> a
<> [Char] -> Mod OptionFields [Char]
forall (f :: * -> *) a. HasMetavar f => [Char] -> Mod f a
metavar [Char]
"NAME"
          Mod OptionFields [Char]
-> Mod OptionFields [Char] -> Mod OptionFields [Char]
forall a. Semigroup a => a -> a -> a
<> [Char] -> Mod OptionFields [Char]
forall (f :: * -> *) a. [Char] -> Mod f a
help [Char]
"The snapshot name, e.g. 163470034 or 163470034_my-suffix."
      )