{-# 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 -> FilePath
daemonMonitorMetaDir :: FilePath
  -- ^ The directory holding the @state@/@meta@ files of the snapshots produced
  -- by the node (watched for completed snapshots).
  , DaemonOpts -> FilePath
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 -> FilePath
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 -> FilePath
convertSnapshotInDir :: FilePath
  -- ^ The input snapshot (a directory named after the slot, holding at least the
  -- @state@/@meta@ files).
  , ConvertOpts -> Maybe FilePath
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 -> FilePath
convertSnapshotOutDir :: FilePath
  -- ^ The output snapshot (a directory named after the slot).
  , ConvertOpts -> Maybe FilePath
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 -> FilePath
lsmDbDir :: FilePath
  -- ^ The LSM database (session) directory.
  , LsmDbOpts -> FilePath
lsmRootDir :: FilePath
  -- ^ The export-to (for @export@) or import-from (for @import@) root directory.
  -- The exported snapshot named @N@ lives at @<this>/N@.
  , LsmDbOpts -> FilePath
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 -> (FilePath -> FilePath -> FilePath -> IO ()) -> IO ()
runLsmDb LsmDbOpts
o FilePath -> FilePath -> FilePath -> IO ()
lsmDbExportSnapshot
    LsmImport LsmDbOpts
o -> LsmDbOpts -> (FilePath -> FilePath -> FilePath -> IO ()) -> IO ()
runLsmDb LsmDbOpts
o FilePath -> FilePath -> FilePath -> 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 -> FilePath -> IO ()
putStrLn (Error (CardanoBlock StandardCrypto) -> FilePath
forall a. Show a => a -> FilePath
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 -> FilePath
daemonMonitorMetaDir DaemonOpts
o
  withManager $ \WatchManager
manager -> do
    FilePath -> IO ()
putStrLn (FilePath -> IO ()) -> FilePath -> IO ()
forall a b. (a -> b) -> a -> b
$ FilePath
"Watching " FilePath -> FilePath -> FilePath
forall a. Semigroup a => a -> a -> a
<> FilePath -> FilePath
forall a. Show a => a -> FilePath
show FilePath
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 -> FilePath -> ActionPredicate -> Action -> IO (IO ())
watchTree
        WatchManager
manager
        FilePath
monitorDir
        ( \case
            CloseWrite FilePath
ep UTCTime
_ EventIsDirectory
IsFile -> FilePath
"meta" FilePath -> FilePath -> Bool
forall a. Eq a => [a] -> [a] -> Bool
`L.isSuffixOf` FilePath
ep
            Event
_ -> Bool
False
        )
        ( \case
            CloseWrite FilePath
ep UTCTime
_ EventIsDirectory
IsFile ->
              case [FilePath] -> [FilePath]
forall a. [a] -> [a]
reverse ([FilePath] -> [FilePath]) -> [FilePath] -> [FilePath]
forall a b. (a -> b) -> a -> b
$ FilePath -> [FilePath]
splitDirectories FilePath
ep of
                (FilePath
_ : name :: FilePath
name@(FilePath -> Maybe DiskSnapshot
snapshotFromPath -> Just DiskSnapshot
ds) : [FilePath]
_) -> do
                  let exportedDir :: FilePath
exportedDir = DaemonOpts -> FilePath
daemonLsmSnapshotsExportDir DaemonOpts
o FilePath -> FilePath -> FilePath
</> FilePath
name
                      from :: Snapshot
from =
                        SnapshotsDirectoryWithFormat -> DiskSnapshot -> Snapshot
Snapshot
                          ( SnapshotsDirectory
-> ExportedSnapshotPath -> SnapshotsDirectoryWithFormat
ExportedLSMSnapshot
                              (FilePath -> SnapshotsDirectory
SnapshotsDirectory FilePath
monitorDir)
                              (FilePath -> ExportedSnapshotPath
ExportedSnapshotPath FilePath
exportedDir)
                          )
                          DiskSnapshot
ds
                      to :: Snapshot
to =
                        SnapshotsDirectoryWithFormat -> DiskSnapshot -> Snapshot
Snapshot
                          (SnapshotsDirectory
-> StandaloneFormat -> SnapshotsDirectoryWithFormat
StandaloneSnapshot (FilePath -> SnapshotsDirectory
SnapshotsDirectory (DaemonOpts -> FilePath
daemonMemSnapshotDir DaemonOpts
o)) StandaloneFormat
Mem)
                          DiskSnapshot
ds
                  FilePath -> IO ()
putStrLn (FilePath -> IO ()) -> FilePath -> IO ()
forall a b. (a -> b) -> a -> b
$
                    FilePath
"Converting snapshot " FilePath -> FilePath -> FilePath
forall a. Semigroup a => a -> a -> a
<> FilePath
ep FilePath -> FilePath -> FilePath
forall a. Semigroup a => a -> a -> a
<> FilePath
" to " FilePath -> FilePath -> FilePath
forall a. Semigroup a => a -> a -> a
<> (DaemonOpts -> FilePath
daemonMemSnapshotDir DaemonOpts
o FilePath -> FilePath -> FilePath
</> FilePath
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 -> FilePath -> IO ()
putStrLn (FilePath -> IO ()) -> FilePath -> IO ()
forall a b. (a -> b) -> a -> b
$ Error (CardanoBlock StandardCrypto) -> FilePath
forall a. Show a => a -> FilePath
show Error (CardanoBlock StandardCrypto)
err
                    Right () -> FilePath -> IO ()
putStrLn FilePath
"Done"
                [FilePath]
_ -> () -> 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 -> (FilePath -> FilePath -> FilePath -> IO ()) -> IO ()
runLsmDb LsmDbOpts
o FilePath -> FilePath -> FilePath -> 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
$ FilePath -> IO DiskSnapshot
requireSnapshotName FilePath
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
$ FilePath -> FilePath -> FilePath -> IO ()
op (LsmDbOpts -> FilePath
lsmDbDir LsmDbOpts
o) FilePath
name (LsmDbOpts -> FilePath
lsmRootDir LsmDbOpts
o FilePath -> FilePath -> FilePath
</> FilePath
name)
  case res of
    Left (SomeException
e :: SomeException) -> FilePath -> IO ()
putStrLn (SomeException -> FilePath
forall e. Exception e => e -> FilePath
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 () -> FilePath -> IO ()
putStrLn FilePath
"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 :: FilePath
name = LsmDbOpts -> FilePath
lsmSnapName LsmDbOpts
o

-- | Parse a snapshot name, exiting with a helpful message if it is malformed.
requireSnapshotName :: String -> IO DiskSnapshot
requireSnapshotName :: FilePath -> IO DiskSnapshot
requireSnapshotName FilePath
name =
  case FilePath -> Maybe DiskSnapshot
snapshotFromPath FilePath
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
      FilePath -> IO ()
putStrLn (FilePath -> IO ()) -> FilePath -> IO ()
forall a b. (a -> b) -> a -> b
$
        FilePath
"\""
          FilePath -> FilePath -> FilePath
forall a. Semigroup a => a -> a -> a
<> FilePath
name
          FilePath -> FilePath -> FilePath
forall a. Semigroup a => a -> a -> a
<> FilePath
"\" is not a valid snapshot name. It should be named after the slot"
          FilePath -> FilePath -> FilePath
forall a. Semigroup a => a -> a -> a
<> FilePath
" number of the contained state and an optional suffix, such as"
          FilePath -> FilePath -> FilePath
forall a. Semigroup a => a -> a -> a
<> FilePath
" `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 :: FilePath -> Maybe FilePath -> IO Snapshot
mkSnapshot FilePath
snapPath Maybe FilePath
mExportRoot = do
  let (FilePath
parent, FilePath
name) = FilePath -> (FilePath, FilePath)
splitFileName FilePath
snapPath
  ds <- FilePath -> IO DiskSnapshot
requireSnapshotName FilePath
name
  pure $
    Snapshot
      ( case mExportRoot of
          Just FilePath
root ->
            SnapshotsDirectory
-> ExportedSnapshotPath -> SnapshotsDirectoryWithFormat
ExportedLSMSnapshot
              (FilePath -> SnapshotsDirectory
SnapshotsDirectory FilePath
parent)
              (FilePath -> ExportedSnapshotPath
ExportedSnapshotPath (FilePath
root FilePath -> FilePath -> FilePath
</> FilePath
name))
          Maybe FilePath
Nothing -> SnapshotsDirectory
-> StandaloneFormat -> SnapshotsDirectoryWithFormat
StandaloneSnapshot (FilePath -> SnapshotsDirectory
SnapshotsDirectory FilePath
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
<> FilePath -> InfoMod Command
forall a. FilePath -> InfoMod a
header
          FilePath
"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
<> FilePath -> InfoMod Command
forall a. FilePath -> InfoMod a
progDesc
          ( FilePath
"Conversions operate on Mem snapshots and standalone (exported) LSM"
              FilePath -> FilePath -> FilePath
forall a. Semigroup a => a -> a -> a
<> FilePath
" snapshots, never on live LSM databases. Use the `lsm` commands to"
              FilePath -> FilePath -> FilePath
forall a. Semigroup a => a -> a -> a
<> FilePath
" export snapshots out of, or import snapshots into, an offline LSM"
              FilePath -> FilePath -> FilePath
forall a. Semigroup a => a -> a -> a
<> FilePath
" 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 =
  FilePath -> Mod OptionFields (a -> a) -> Parser (a -> a)
forall a. FilePath -> Mod OptionFields (a -> a) -> Parser (a -> a)
infoOption
    FilePath
versionString
    ( FilePath -> Mod OptionFields (a -> a)
forall (f :: * -> *) a. HasName f => FilePath -> Mod f a
long FilePath
"version"
        Mod OptionFields (a -> a)
-> Mod OptionFields (a -> a) -> Mod OptionFields (a -> a)
forall a. Semigroup a => a -> a -> a
<> FilePath -> Mod OptionFields (a -> a)
forall (f :: * -> *) a. FilePath -> Mod f a
help FilePath
"Show version, build platform and git commit, then exit."
    )

versionString :: String
versionString :: FilePath
versionString =
  FilePath
"snapshot-converter, part of ouroboros-consensus "
    FilePath -> FilePath -> FilePath
forall a. Semigroup a => a -> a -> a
<> Version -> FilePath
showVersion Version
version
    FilePath -> FilePath -> FilePath
forall a. Semigroup a => a -> a -> a
<> FilePath
" - "
    FilePath -> FilePath -> FilePath
forall a. Semigroup a => a -> a -> a
<> FilePath
os
    FilePath -> FilePath -> FilePath
forall a. Semigroup a => a -> a -> a
<> FilePath
"-"
    FilePath -> FilePath -> FilePath
forall a. Semigroup a => a -> a -> a
<> FilePath
arch
    FilePath -> FilePath -> FilePath
forall a. Semigroup a => a -> a -> a
<> FilePath
" - "
    FilePath -> FilePath -> FilePath
forall a. Semigroup a => a -> a -> a
<> FilePath
compilerName
    FilePath -> FilePath -> FilePath
forall a. Semigroup a => a -> a -> a
<> FilePath
"-"
    FilePath -> FilePath -> FilePath
forall a. Semigroup a => a -> a -> a
<> Version -> FilePath
showVersion Version
compilerVersion
    FilePath -> FilePath -> FilePath
forall a. Semigroup a => a -> a -> a
<> FilePath
"\ngit rev "
    FilePath -> FilePath -> FilePath
forall a. Semigroup a => a -> a -> a
<> Text -> FilePath
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 =
  FilePath -> Doc
forall ann. FilePath -> Doc ann
forall a ann. Pretty a => a -> Doc ann
pretty (FilePath -> Doc) -> FilePath -> Doc
forall a b. (a -> b) -> a -> b
$
    FilePath -> [FilePath] -> FilePath
forall a. [a] -> [[a]] -> [a]
L.intercalate
      FilePath
"\n"
      [ FilePath
"Typical flows (a snapshot is a directory named after its slot, e.g. `100`"
      , FilePath
"or `100_my-suffix`):"
      , FilePath
""
      , FilePath
"  # Mem snapshot -> standalone (exported) LSM snapshot"
      , FilePath
"  snapshot-converter convert --config CONFIG \\"
      , FilePath
"    --snapshot-in  SNAPSHOTS/100 \\"
      , FilePath
"    --snapshot-out OUT/100 \\"
      , FilePath
"    --lsm-export-to EXPORTED"
      , FilePath
""
      , FilePath
"  # standalone (exported) LSM snapshot -> Mem snapshot"
      , FilePath
"  snapshot-converter convert --config CONFIG \\"
      , FilePath
"    --snapshot-in    SNAPSHOTS/100 \\"
      , FilePath
"    --lsm-import-from EXPORTED \\"
      , FilePath
"    --snapshot-out   OUT/100"
      , FilePath
""
      , FilePath
"  # import a standalone (exported) LSM snapshot into a new offline LSM database"
      , FilePath
"  snapshot-converter lsm import \\"
      , FilePath
"    --lsm-database    LSM_DB \\"
      , FilePath
"    --lsm-import-from EXPORTED \\"
      , FilePath
"    --snapshot        100"
      , FilePath
""
      , FilePath
"  # export a snapshot out of an offline LSM database"
      , FilePath
"  snapshot-converter lsm export \\"
      , FilePath
"    --lsm-database  LSM_DB \\"
      , FilePath
"    --lsm-export-to EXPORTED \\"
      , FilePath
"    --snapshot      100"
      ]

commandParser :: Parser Command
commandParser :: Parser Command
commandParser =
  Mod CommandFields Command -> Parser Command
forall a. Mod CommandFields a -> Parser a
hsubparser
    ( FilePath -> ParserInfo Command -> Mod CommandFields Command
forall a. FilePath -> ParserInfo a -> Mod CommandFields a
command
        FilePath
"daemon"
        ( Parser Command -> InfoMod Command -> ParserInfo Command
forall a. Parser a -> InfoMod a -> ParserInfo a
info
            Parser Command
daemonCmd
            ( FilePath -> InfoMod Command
forall a. FilePath -> InfoMod a
progDesc (FilePath -> InfoMod Command) -> FilePath -> InfoMod Command
forall a b. (a -> b) -> a -> b
$
                FilePath
"Watch a directory for completed snapshots and convert each exported"
                  FilePath -> FilePath -> FilePath
forall a. Semigroup a => a -> a -> a
<> FilePath
" LSM snapshot into a Mem snapshot as it is produced. Meaningful"
                  FilePath -> FilePath -> FilePath
forall a. Semigroup a => a -> a -> a
<> FilePath
" only for a node producing LSM snapshots."
            )
        )
        Mod CommandFields Command
-> Mod CommandFields Command -> Mod CommandFields Command
forall a. Semigroup a => a -> a -> a
<> FilePath -> ParserInfo Command -> Mod CommandFields Command
forall a. FilePath -> ParserInfo a -> Mod CommandFields a
command
          FilePath
"convert"
          ( Parser Command -> InfoMod Command -> ParserInfo Command
forall a. Parser a -> InfoMod a -> ParserInfo a
info
              Parser Command
convertCmd
              ( FilePath -> InfoMod Command
forall a. FilePath -> InfoMod a
progDesc (FilePath -> InfoMod Command) -> FilePath -> InfoMod Command
forall a b. (a -> b) -> a -> b
$
                  FilePath
"Convert a single snapshot between an exported LSM snapshot and a Mem"
                    FilePath -> FilePath -> FilePath
forall a. Semigroup a => a -> a -> a
<> FilePath
" snapshot. The input/output paths must be named after the slot"
                    FilePath -> FilePath -> FilePath
forall a. Semigroup a => a -> a -> a
<> FilePath
" 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
<> FilePath -> ParserInfo Command -> Mod CommandFields Command
forall a. FilePath -> ParserInfo a -> Mod CommandFields a
command
          FilePath
"lsm"
          ( Parser Command -> InfoMod Command -> ParserInfo Command
forall a. Parser a -> InfoMod a -> ParserInfo a
info
              Parser Command
lsmCmd
              (FilePath -> InfoMod Command
forall a. FilePath -> InfoMod a
progDesc FilePath
"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
<$> ( FilePath -> FilePath -> FilePath -> DaemonOpts
DaemonOpts
            (FilePath -> FilePath -> FilePath -> DaemonOpts)
-> Parser FilePath -> Parser (FilePath -> FilePath -> DaemonOpts)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Mod OptionFields FilePath -> Parser FilePath
forall s. IsString s => Mod OptionFields s -> Parser s
strOption
              ( FilePath -> Mod OptionFields FilePath
forall (f :: * -> *) a. HasName f => FilePath -> Mod f a
long FilePath
"monitor-snapshots-in"
                  Mod OptionFields FilePath
-> Mod OptionFields FilePath -> Mod OptionFields FilePath
forall a. Semigroup a => a -> a -> a
<> FilePath -> Mod OptionFields FilePath
forall (f :: * -> *) a. HasMetavar f => FilePath -> Mod f a
metavar FilePath
"DIR"
                  Mod OptionFields FilePath
-> Mod OptionFields FilePath -> Mod OptionFields FilePath
forall a. Semigroup a => a -> a -> a
<> FilePath -> Mod OptionFields FilePath
forall (f :: * -> *) a. FilePath -> Mod f a
help FilePath
"Directory with the node's snapshots (state/meta), watched for completion."
              )
            Parser (FilePath -> FilePath -> DaemonOpts)
-> Parser FilePath -> Parser (FilePath -> 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 FilePath -> Parser FilePath
forall s. IsString s => Mod OptionFields s -> Parser s
strOption
              ( FilePath -> Mod OptionFields FilePath
forall (f :: * -> *) a. HasName f => FilePath -> Mod f a
long FilePath
"lsm-exported-path"
                  Mod OptionFields FilePath
-> Mod OptionFields FilePath -> Mod OptionFields FilePath
forall a. Semigroup a => a -> a -> a
<> FilePath -> Mod OptionFields FilePath
forall (f :: * -> *) a. HasMetavar f => FilePath -> Mod f a
metavar FilePath
"DIR"
                  Mod OptionFields FilePath
-> Mod OptionFields FilePath -> Mod OptionFields FilePath
forall a. Semigroup a => a -> a -> a
<> FilePath -> Mod OptionFields FilePath
forall (f :: * -> *) a. FilePath -> Mod f a
help FilePath
"Directory into which the node exports its LSM snapshots."
              )
            Parser (FilePath -> DaemonOpts)
-> Parser FilePath -> 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 FilePath -> Parser FilePath
forall s. IsString s => Mod OptionFields s -> Parser s
strOption
              ( FilePath -> Mod OptionFields FilePath
forall (f :: * -> *) a. HasName f => FilePath -> Mod f a
long FilePath
"output-snapshots-in"
                  Mod OptionFields FilePath
-> Mod OptionFields FilePath -> Mod OptionFields FilePath
forall a. Semigroup a => a -> a -> a
<> FilePath -> Mod OptionFields FilePath
forall (f :: * -> *) a. HasMetavar f => FilePath -> Mod f a
metavar FilePath
"DIR"
                  Mod OptionFields FilePath
-> Mod OptionFields FilePath -> Mod OptionFields FilePath
forall a. Semigroup a => a -> a -> a
<> FilePath -> Mod OptionFields FilePath
forall (f :: * -> *) a. FilePath -> Mod f a
help FilePath
"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
<$> ( FilePath
-> Maybe FilePath -> FilePath -> Maybe FilePath -> ConvertOpts
ConvertOpts
            (FilePath
 -> Maybe FilePath -> FilePath -> Maybe FilePath -> ConvertOpts)
-> Parser FilePath
-> Parser
     (Maybe FilePath -> FilePath -> Maybe FilePath -> ConvertOpts)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Mod OptionFields FilePath -> Parser FilePath
forall s. IsString s => Mod OptionFields s -> Parser s
strOption
              ( FilePath -> Mod OptionFields FilePath
forall (f :: * -> *) a. HasName f => FilePath -> Mod f a
long FilePath
"snapshot-in"
                  Mod OptionFields FilePath
-> Mod OptionFields FilePath -> Mod OptionFields FilePath
forall a. Semigroup a => a -> a -> a
<> FilePath -> Mod OptionFields FilePath
forall (f :: * -> *) a. HasMetavar f => FilePath -> Mod f a
metavar FilePath
"PATH"
                  Mod OptionFields FilePath
-> Mod OptionFields FilePath -> Mod OptionFields FilePath
forall a. Semigroup a => a -> a -> a
<> FilePath -> Mod OptionFields FilePath
forall (f :: * -> *) a. FilePath -> Mod f a
help FilePath
"The input snapshot (directory named after the slot)."
              )
            Parser
  (Maybe FilePath -> FilePath -> Maybe FilePath -> ConvertOpts)
-> Parser (Maybe FilePath)
-> Parser (FilePath -> Maybe FilePath -> 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 FilePath -> Parser (Maybe FilePath)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
optional
              ( Mod OptionFields FilePath -> Parser FilePath
forall s. IsString s => Mod OptionFields s -> Parser s
strOption
                  ( FilePath -> Mod OptionFields FilePath
forall (f :: * -> *) a. HasName f => FilePath -> Mod f a
long FilePath
"lsm-import-from"
                      Mod OptionFields FilePath
-> Mod OptionFields FilePath -> Mod OptionFields FilePath
forall a. Semigroup a => a -> a -> a
<> FilePath -> Mod OptionFields FilePath
forall (f :: * -> *) a. HasMetavar f => FilePath -> Mod f a
metavar FilePath
"DIR"
                      Mod OptionFields FilePath
-> Mod OptionFields FilePath -> Mod OptionFields FilePath
forall a. Semigroup a => a -> a -> a
<> FilePath -> Mod OptionFields FilePath
forall (f :: * -> *) a. FilePath -> Mod f a
help FilePath
"If set, the input is an exported LSM snapshot rooted here."
                  )
              )
            Parser (FilePath -> Maybe FilePath -> ConvertOpts)
-> Parser FilePath -> Parser (Maybe FilePath -> 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 FilePath -> Parser FilePath
forall s. IsString s => Mod OptionFields s -> Parser s
strOption
              ( FilePath -> Mod OptionFields FilePath
forall (f :: * -> *) a. HasName f => FilePath -> Mod f a
long FilePath
"snapshot-out"
                  Mod OptionFields FilePath
-> Mod OptionFields FilePath -> Mod OptionFields FilePath
forall a. Semigroup a => a -> a -> a
<> FilePath -> Mod OptionFields FilePath
forall (f :: * -> *) a. HasMetavar f => FilePath -> Mod f a
metavar FilePath
"PATH"
                  Mod OptionFields FilePath
-> Mod OptionFields FilePath -> Mod OptionFields FilePath
forall a. Semigroup a => a -> a -> a
<> FilePath -> Mod OptionFields FilePath
forall (f :: * -> *) a. FilePath -> Mod f a
help FilePath
"The output snapshot (directory named after the slot)."
              )
            Parser (Maybe FilePath -> ConvertOpts)
-> Parser (Maybe FilePath) -> 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 FilePath -> Parser (Maybe FilePath)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
optional
              ( Mod OptionFields FilePath -> Parser FilePath
forall s. IsString s => Mod OptionFields s -> Parser s
strOption
                  ( FilePath -> Mod OptionFields FilePath
forall (f :: * -> *) a. HasName f => FilePath -> Mod f a
long FilePath
"lsm-export-to"
                      Mod OptionFields FilePath
-> Mod OptionFields FilePath -> Mod OptionFields FilePath
forall a. Semigroup a => a -> a -> a
<> FilePath -> Mod OptionFields FilePath
forall (f :: * -> *) a. HasMetavar f => FilePath -> Mod f a
metavar FilePath
"DIR"
                      Mod OptionFields FilePath
-> Mod OptionFields FilePath -> Mod OptionFields FilePath
forall a. Semigroup a => a -> a -> a
<> FilePath -> Mod OptionFields FilePath
forall (f :: * -> *) a. FilePath -> Mod f a
help FilePath
"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
    ( FilePath -> ParserInfo Command -> Mod CommandFields Command
forall a. FilePath -> ParserInfo a -> Mod CommandFields a
command
        FilePath
"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
<$> FilePath -> FilePath -> Parser LsmDbOpts
lsmDbOpts FilePath
"lsm-export-to" FilePath
"Root directory to export the snapshot into (as <DIR>/<snapshot>)."
            )
            (FilePath -> InfoMod Command
forall a. FilePath -> InfoMod a
progDesc FilePath
"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
<> FilePath -> ParserInfo Command -> Mod CommandFields Command
forall a. FilePath -> ParserInfo a -> Mod CommandFields a
command
          FilePath
"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
<$> FilePath -> FilePath -> Parser LsmDbOpts
lsmDbOpts FilePath
"lsm-import-from" FilePath
"Root directory holding the exported snapshot (at <DIR>/<snapshot>)."
              )
              ( FilePath -> InfoMod Command
forall a. FilePath -> InfoMod a
progDesc
                  FilePath
"Import an exported snapshot into a new (offline) LSM database."
              )
          )
    )

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