{-# LANGUAGE CPP #-}
{-# LANGUAGE LambdaCase #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE ViewPatterns #-}
#if __GLASGOW_HASKELL__ >= 912
{-# LANGUAGE MultilineStrings #-}
#endif

module Main (main) where

import Cardano.Crypto.Init (cryptoInit)
import Cardano.Tools.DBAnalyser.HasAnalysis (mkProtocolInfo)
import Control.Concurrent
import Control.Monad (forever, void)
import Control.Monad.Except
import DBAnalyser.Parsers
import qualified Data.List as L
#if __GLASGOW_HASKELL__ < 912
import qualified Data.Text as T
#endif
import Main.Utf8
import Options.Applicative
import Options.Applicative.Help (Doc)
#if __GLASGOW_HASKELL__ < 912
import Options.Applicative.Help.Pretty (Pretty (pretty))
#endif
import Ouroboros.Consensus.Cardano.SnapshotConversion
import Ouroboros.Consensus.Storage.LedgerDB.Snapshots
import System.Exit
import System.FSNotify
import System.FilePath

data Config
  = -- | Run in daemon mode
    DaemonConfig
      -- | Where the input snapshot will be in
      SnapshotsDirectoryWithFormat
      -- | Where to put the converted snapshots
      SnapshotsDirectory
  | -- | Run in normal mode
    NoDaemonConfig
      -- | Where and in which format the input snapshot is in
      Snapshot'
      -- | Where and in which format the output snapshot must be in
      Snapshot'

-- | Helper for parsing a directory that contains both the snapshots directory
-- and the particular snapshot.
data Snapshot'
  = StandaloneSnapshot' FilePath StandaloneFormat
  | LSMSnapshot' FilePath LSMDatabaseFilePath

snapshot'ToSnapshot :: Snapshot' -> Snapshot
snapshot'ToSnapshot :: Snapshot' -> Snapshot
snapshot'ToSnapshot (LSMSnapshot' FilePath
s LSMDatabaseFilePath
lsmfp) =
  let (FilePath
snapFp, FilePath
snapName) = FilePath -> (FilePath, FilePath)
splitFileName FilePath
s
   in case FilePath -> Maybe DiskSnapshot
snapshotFromPath FilePath
snapName of
        Just DiskSnapshot
snap -> SnapshotsDirectoryWithFormat -> DiskSnapshot -> Snapshot
Snapshot (SnapshotsDirectory
-> LSMDatabaseFilePath -> SnapshotsDirectoryWithFormat
LSMSnapshot (FilePath -> SnapshotsDirectory
SnapshotsDirectory FilePath
snapFp) LSMDatabaseFilePath
lsmfp) DiskSnapshot
snap
        Maybe DiskSnapshot
Nothing -> FilePath -> Snapshot
forall a. HasCallStack => FilePath -> a
error (FilePath -> Snapshot) -> FilePath -> Snapshot
forall a b. (a -> b) -> a -> b
$ FilePath
"Malformed input, last fragment of the input \"" FilePath -> FilePath -> FilePath
forall a. Semigroup a => a -> a -> a
<> FilePath
s FilePath -> FilePath -> FilePath
forall a. Semigroup a => a -> a -> a
<> FilePath
"\"is not a snapshot name"
snapshot'ToSnapshot (StandaloneSnapshot' FilePath
s StandaloneFormat
fmt) =
  let (FilePath
snapFp, FilePath
snapName) = FilePath -> (FilePath, FilePath)
splitFileName FilePath
s
   in case FilePath -> Maybe DiskSnapshot
snapshotFromPath FilePath
snapName of
        Just DiskSnapshot
snap -> SnapshotsDirectoryWithFormat -> DiskSnapshot -> Snapshot
Snapshot (SnapshotsDirectory
-> StandaloneFormat -> SnapshotsDirectoryWithFormat
StandaloneSnapshot (FilePath -> SnapshotsDirectory
SnapshotsDirectory FilePath
snapFp) StandaloneFormat
fmt) DiskSnapshot
snap
        Maybe DiskSnapshot
Nothing -> FilePath -> Snapshot
forall a. HasCallStack => FilePath -> a
error (FilePath -> Snapshot) -> FilePath -> Snapshot
forall a b. (a -> b) -> a -> b
$ FilePath
"Malformed input, last fragment of the input \"" FilePath -> FilePath -> FilePath
forall a. Semigroup a => a -> a -> a
<> FilePath
s FilePath -> FilePath -> FilePath
forall a. Semigroup a => a -> a -> a
<> FilePath
"\"is not a snapshot name"

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, args) <- IO (Config, CardanoBlockArgs)
getCommandLineConfig
  pInfo <- mkProtocolInfo args
  case conf of
    NoDaemonConfig (Snapshot' -> Snapshot
snapshot'ToSnapshot -> Snapshot
f) (Snapshot' -> Snapshot
snapshot'ToSnapshot -> Snapshot
t) -> do
      eRes <- 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
True ProtocolInfo (CardanoBlock StandardCrypto)
pInfo Snapshot
f Snapshot
t)
      case eRes of
        Left Error (CardanoBlock StandardCrypto)
err -> do
          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
          IO ()
forall a. IO a
exitFailure
        Right () -> IO ()
forall a. IO a
exitSuccess
    DaemonConfig from :: SnapshotsDirectoryWithFormat
from@(SnapshotsDirectory -> FilePath
getSnapshotDir (SnapshotsDirectory -> FilePath)
-> (SnapshotsDirectoryWithFormat -> SnapshotsDirectory)
-> SnapshotsDirectoryWithFormat
-> FilePath
forall b c a. (b -> c) -> (a -> b) -> a -> c
. SnapshotsDirectoryWithFormat -> SnapshotsDirectory
snapshotDirectory -> FilePath
ledgerDbPath) SnapshotsDirectory
to -> do
      (WatchManager -> IO ()) -> IO ()
forall a. (WatchManager -> IO a) -> IO a
withManager ((WatchManager -> IO ()) -> IO ())
-> (WatchManager -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \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
ledgerDbPath
        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
ledgerDbPath
            ( \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 -> do
                  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
_ : snapName :: FilePath
snapName@(FilePath -> Maybe DiskSnapshot
snapshotFromPath -> Just DiskSnapshot
ds) : [FilePath]
_) -> do
                      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
<> (SnapshotsDirectory -> FilePath
getSnapshotDir SnapshotsDirectory
to FilePath -> FilePath -> FilePath
</> FilePath
snapName)
                      res <-
                        ExceptT (Error (CardanoBlock StandardCrypto)) IO ()
-> IO (Either (Error (CardanoBlock StandardCrypto)) ())
forall e (m :: * -> *) a. ExceptT e m a -> m (Either e a)
runExceptT (ExceptT (Error (CardanoBlock StandardCrypto)) IO ()
 -> IO (Either (Error (CardanoBlock StandardCrypto)) ()))
-> ExceptT (Error (CardanoBlock StandardCrypto)) IO ()
-> IO (Either (Error (CardanoBlock StandardCrypto)) ())
forall a b. (a -> b) -> a -> b
$
                          Bool
-> ProtocolInfo (CardanoBlock StandardCrypto)
-> Snapshot
-> Snapshot
-> ExceptT (Error (CardanoBlock StandardCrypto)) IO ()
convertSnapshot
                            Bool
False
                            ProtocolInfo (CardanoBlock StandardCrypto)
pInfo
                            (SnapshotsDirectoryWithFormat -> DiskSnapshot -> Snapshot
Snapshot SnapshotsDirectoryWithFormat
from DiskSnapshot
ds)
                            (SnapshotsDirectoryWithFormat -> DiskSnapshot -> Snapshot
Snapshot (SnapshotsDirectory
-> StandaloneFormat -> SnapshotsDirectoryWithFormat
StandaloneSnapshot SnapshotsDirectory
to StandaloneFormat
Mem) DiskSnapshot
ds)
                      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

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

getCommandLineConfig :: IO (Config, CardanoBlockArgs)
getCommandLineConfig :: IO (Config, CardanoBlockArgs)
getCommandLineConfig =
  ParserInfo (Config, CardanoBlockArgs)
-> IO (Config, CardanoBlockArgs)
forall a. ParserInfo a -> IO a
execParser (ParserInfo (Config, CardanoBlockArgs)
 -> IO (Config, CardanoBlockArgs))
-> ParserInfo (Config, CardanoBlockArgs)
-> IO (Config, CardanoBlockArgs)
forall a b. (a -> b) -> a -> b
$
    Parser (Config, CardanoBlockArgs)
-> InfoMod (Config, CardanoBlockArgs)
-> ParserInfo (Config, CardanoBlockArgs)
forall a. Parser a -> InfoMod a -> ParserInfo a
info
      ( (,)
          (Config -> CardanoBlockArgs -> (Config, CardanoBlockArgs))
-> Parser Config
-> Parser (CardanoBlockArgs -> (Config, CardanoBlockArgs))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser Config
parseConfig
          Parser (CardanoBlockArgs -> (Config, CardanoBlockArgs))
-> Parser CardanoBlockArgs -> Parser (Config, CardanoBlockArgs)
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 Parser (Config, CardanoBlockArgs)
-> Parser
     ((Config, CardanoBlockArgs) -> (Config, CardanoBlockArgs))
-> Parser (Config, CardanoBlockArgs)
forall (f :: * -> *) a b. Applicative f => f a -> f (a -> b) -> f b
<**> Parser ((Config, CardanoBlockArgs) -> (Config, CardanoBlockArgs))
forall a. Parser (a -> a)
helper
      )
      ( InfoMod (Config, CardanoBlockArgs)
forall a. InfoMod a
fullDesc
          InfoMod (Config, CardanoBlockArgs)
-> InfoMod (Config, CardanoBlockArgs)
-> InfoMod (Config, CardanoBlockArgs)
forall a. Semigroup a => a -> a -> a
<> FilePath -> InfoMod (Config, CardanoBlockArgs)
forall a. FilePath -> InfoMod a
header FilePath
"Utility for converting snapshots among the different snapshot formats used by cardano-node."
          InfoMod (Config, CardanoBlockArgs)
-> InfoMod (Config, CardanoBlockArgs)
-> InfoMod (Config, CardanoBlockArgs)
forall a. Semigroup a => a -> a -> a
<> Maybe Doc -> InfoMod (Config, CardanoBlockArgs)
forall a. Maybe Doc -> InfoMod a
progDescDoc Maybe Doc
programDescription
      )

parseConfig :: Parser Config
parseConfig :: Parser Config
parseConfig =
  ( SnapshotsDirectoryWithFormat -> SnapshotsDirectory -> Config
DaemonConfig
      (SnapshotsDirectoryWithFormat -> SnapshotsDirectory -> Config)
-> Parser SnapshotsDirectoryWithFormat
-> Parser (SnapshotsDirectory -> Config)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ( ( SnapshotsDirectory
-> LSMDatabaseFilePath -> SnapshotsDirectoryWithFormat
LSMSnapshot
                (SnapshotsDirectory
 -> LSMDatabaseFilePath -> SnapshotsDirectoryWithFormat)
-> Parser SnapshotsDirectory
-> Parser (LSMDatabaseFilePath -> SnapshotsDirectoryWithFormat)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (FilePath -> SnapshotsDirectory
SnapshotsDirectory (FilePath -> SnapshotsDirectory)
-> Parser FilePath -> Parser SnapshotsDirectory
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-lsm-snapshots-in"))
                Parser (LSMDatabaseFilePath -> SnapshotsDirectoryWithFormat)
-> Parser LSMDatabaseFilePath
-> Parser SnapshotsDirectoryWithFormat
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (FilePath -> LSMDatabaseFilePath
LSMDatabaseFilePath (FilePath -> LSMDatabaseFilePath)
-> Parser FilePath -> Parser LSMDatabaseFilePath
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"))
            )
              Parser SnapshotsDirectoryWithFormat
-> Parser SnapshotsDirectoryWithFormat
-> Parser SnapshotsDirectoryWithFormat
forall a. Parser a -> Parser a -> Parser a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> ( SnapshotsDirectory
-> StandaloneFormat -> SnapshotsDirectoryWithFormat
StandaloneSnapshot
                      (SnapshotsDirectory
 -> StandaloneFormat -> SnapshotsDirectoryWithFormat)
-> Parser SnapshotsDirectory
-> Parser (StandaloneFormat -> SnapshotsDirectoryWithFormat)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (FilePath -> SnapshotsDirectory
SnapshotsDirectory (FilePath -> SnapshotsDirectory)
-> Parser FilePath -> Parser SnapshotsDirectory
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-lmdb-snapshots-in"))
                      Parser (StandaloneFormat -> SnapshotsDirectoryWithFormat)
-> Parser StandaloneFormat -> Parser SnapshotsDirectoryWithFormat
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> StandaloneFormat -> Parser StandaloneFormat
forall a. a -> Parser a
forall (f :: * -> *) a. Applicative f => a -> f a
pure StandaloneFormat
LMDB
                  )
          )
      Parser (SnapshotsDirectory -> Config)
-> Parser SnapshotsDirectory -> Parser Config
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (FilePath -> SnapshotsDirectory
SnapshotsDirectory (FilePath -> SnapshotsDirectory)
-> Parser FilePath -> Parser SnapshotsDirectory
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
"output-mem-snapshots-in"))
  )
    Parser Config -> Parser Config -> Parser Config
forall a. Parser a -> Parser a -> Parser a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> ( Snapshot' -> Snapshot' -> Config
NoDaemonConfig
            (Snapshot' -> Snapshot' -> Config)
-> Parser Snapshot' -> Parser (Snapshot' -> Config)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ( ( FilePath -> LSMDatabaseFilePath -> Snapshot'
LSMSnapshot'
                      (FilePath -> LSMDatabaseFilePath -> Snapshot')
-> Parser FilePath -> Parser (LSMDatabaseFilePath -> Snapshot')
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
"input-lsm-snapshot"))
                      Parser (LSMDatabaseFilePath -> Snapshot')
-> Parser LSMDatabaseFilePath -> Parser Snapshot'
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (FilePath -> LSMDatabaseFilePath
LSMDatabaseFilePath (FilePath -> LSMDatabaseFilePath)
-> Parser FilePath -> Parser LSMDatabaseFilePath
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
"input-lsm-database"))
                  )
                    Parser Snapshot' -> Parser Snapshot' -> Parser Snapshot'
forall a. Parser a -> Parser a -> Parser a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> ( FilePath -> StandaloneFormat -> Snapshot'
StandaloneSnapshot'
                            (FilePath -> StandaloneFormat -> Snapshot')
-> Parser FilePath -> Parser (StandaloneFormat -> Snapshot')
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
"input-mem")
                            Parser (StandaloneFormat -> Snapshot')
-> Parser StandaloneFormat -> Parser Snapshot'
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> StandaloneFormat -> Parser StandaloneFormat
forall a. a -> Parser a
forall (f :: * -> *) a. Applicative f => a -> f a
pure StandaloneFormat
Mem
                        )
                    Parser Snapshot' -> Parser Snapshot' -> Parser Snapshot'
forall a. Parser a -> Parser a -> Parser a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> ( FilePath -> StandaloneFormat -> Snapshot'
StandaloneSnapshot'
                            (FilePath -> StandaloneFormat -> Snapshot')
-> Parser FilePath -> Parser (StandaloneFormat -> Snapshot')
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
"input-lmdb")
                            Parser (StandaloneFormat -> Snapshot')
-> Parser StandaloneFormat -> Parser Snapshot'
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> StandaloneFormat -> Parser StandaloneFormat
forall a. a -> Parser a
forall (f :: * -> *) a. Applicative f => a -> f a
pure StandaloneFormat
LMDB
                        )
                )
            Parser (Snapshot' -> Config) -> Parser Snapshot' -> Parser Config
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> ( ( FilePath -> LSMDatabaseFilePath -> Snapshot'
LSMSnapshot'
                      (FilePath -> LSMDatabaseFilePath -> Snapshot')
-> Parser FilePath -> Parser (LSMDatabaseFilePath -> Snapshot')
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
"output-lsm-snapshot"))
                      Parser (LSMDatabaseFilePath -> Snapshot')
-> Parser LSMDatabaseFilePath -> Parser Snapshot'
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (FilePath -> LSMDatabaseFilePath
LSMDatabaseFilePath (FilePath -> LSMDatabaseFilePath)
-> Parser FilePath -> Parser LSMDatabaseFilePath
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
"output-lsm-database"))
                  )
                    Parser Snapshot' -> Parser Snapshot' -> Parser Snapshot'
forall a. Parser a -> Parser a -> Parser a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> ( FilePath -> StandaloneFormat -> Snapshot'
StandaloneSnapshot'
                            (FilePath -> StandaloneFormat -> Snapshot')
-> Parser FilePath -> Parser (StandaloneFormat -> Snapshot')
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
"output-mem")
                            Parser (StandaloneFormat -> Snapshot')
-> Parser StandaloneFormat -> Parser Snapshot'
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> StandaloneFormat -> Parser StandaloneFormat
forall a. a -> Parser a
forall (f :: * -> *) a. Applicative f => a -> f a
pure StandaloneFormat
Mem
                        )
                    Parser Snapshot' -> Parser Snapshot' -> Parser Snapshot'
forall a. Parser a -> Parser a -> Parser a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> ( FilePath -> StandaloneFormat -> Snapshot'
StandaloneSnapshot'
                            (FilePath -> StandaloneFormat -> Snapshot')
-> Parser FilePath -> Parser (StandaloneFormat -> Snapshot')
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
"output-lmdb")
                            Parser (StandaloneFormat -> Snapshot')
-> Parser StandaloneFormat -> Parser Snapshot'
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> StandaloneFormat -> Parser StandaloneFormat
forall a. a -> Parser a
forall (f :: * -> *) a. Applicative f => a -> f a
pure StandaloneFormat
LMDB
                        )
                )
        )

#if __GLASGOW_HASKELL__ >= 912
programDescription :: Maybe Doc
programDescription =
  Just
    """
    # Running in oneshot mode

        `snapshot-converter` can be invoked to convert a single snapshot to a different
        format. The three formats supported at the moment are: Mem, LMDB and LSM.

        As snapshots in Mem and LMDB are fully contained in one directory, providing
        that one is enough. On the other hand, converting an LSM snapshot requires a
        reference to the snapshot directory as well as the LSM database directory.

        To run in oneshot mode, you have to provide input and output parameters as in:
        ```
        # mem to lsm
        $ snapshot-converter --input-mem <PATH> --output-lsm-snapshot <PATH> --output-lsm-database <PATH> --config <PATH>
        # mem to lmdb
        $ snapshot-converter --input-mem <PATH> --output-lmdb <PATH> --config <PATH>

        # lmdb to lsm
        $ snapshot-converter --input-lmdb <PATH> --output-lsm-snapshot <PATH> --output-lsm-database --config <PATH>
        # lmdb to mem
        $ snapshot-converter --input-lmdb <PATH> --output-mem <PATH> --config <PATH>

        # lsm to mem
        $ snapshot-converter --input-lsm-snapshot <PATH> --input-lsm-database <PATH> --output-mem <PATH> --config <PATH>
        # lsm to mem
        $ snapshot-converter --input-lsm-snapshot <PATH> --input-lsm-database <PATH> --output-lmdb <PATH> --config <PATH>
        ```

        Note that the input and output paths need to be named after the slot number
        of the contained ledger state, this means for example that a snapshot for
        slot 100 has to be contained in a directory `100[_suffix]` and has to be
        written to a directory `100[_some_other_suffix]`. Providing a wrong slot
        number will throw an error.

        This naming convention is the same expected by `cardano-node`.

    # Running in daemon mode

        `snapshot-converter` can be invoked as a daemon to monitor and convert
        snapshots produced by a `cardano-node` into Mem format as they are
        written by the node. This is only meaningful to run if your node
        produces LMDB or LSM snapshots:

        ```
        # lsm to mem
        $ snapshot-converter --monitor-lsm-snapshots-in <PATH> --lsm-database <PATH> --output-mem-snapshots-in <PATH> --config <PATH>
        # lmdb to mem
        $ snapshot-converter --monitor-lmdb-snapshots-in <PATH> --output-mem-snapshots-in <PATH> --config <PATH>
        ```
    """
#else
programDescription :: Maybe Doc
programDescription :: Maybe Doc
programDescription =
  Doc -> Maybe Doc
forall a. a -> Maybe a
Just
   (Doc -> Maybe Doc) -> (FilePath -> Doc) -> FilePath -> Maybe Doc
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Doc
forall ann. Text -> Doc ann
forall a ann. Pretty a => a -> Doc ann
pretty
   (Text -> Doc) -> (FilePath -> Text) -> FilePath -> Doc
forall b c a. (b -> c) -> (a -> b) -> a -> c
. FilePath -> Text
T.pack
   (FilePath -> Maybe Doc) -> FilePath -> Maybe Doc
forall a b. (a -> b) -> a -> b
$ [FilePath] -> FilePath
unlines
     [ FilePath
"# Running in oneshot mode"
     , FilePath
""
     , FilePath
"    `snapshot-converter` can be invoked to convert a single snapshot to a different"
     , FilePath
"    format. The three formats supported at the moment are: Mem, LMDB and LSM."
     , FilePath
""
     , FilePath
"    As snapshots in Mem and LMDB are fully contained in one directory, providing"
     , FilePath
"    that one is enough. On the other hand, converting an LSM snapshot requires a"
     , FilePath
"    reference to the snapshot directory as well as the LSM database directory."
     , FilePath
""
     , FilePath
"    To run in oneshot mode, you have to provide input and output parameters as in:"
     , FilePath
"    ```"
     , FilePath
"    # mem to lsm"
     , FilePath
"    $ snapshot-converter --input-mem <PATH> --output-lsm-snapshot <PATH> --output-lsm-database <PATH> --config <PATH>"
     , FilePath
"    # mem to lmdb"
     , FilePath
"    $ snapshot-converter --input-mem <PATH> --output-lmdb <PATH> --config <PATH>"
     , FilePath
""
     , FilePath
"    # lmdb to lsm"
     , FilePath
"    $ snapshot-converter --input-lmdb <PATH> --output-lsm-snapshot <PATH> --output-lsm-database --config <PATH>"
     , FilePath
"    # lmdb to mem"
     , FilePath
"    $ snapshot-converter --input-lmdb <PATH> --output-mem <PATH> --config <PATH>"
     , FilePath
""
     , FilePath
"    # lsm to mem"
     , FilePath
"    $ snapshot-converter --input-lsm-snapshot <PATH> --input-lsm-database <PATH> --output-mem <PATH> --config <PATH>"
     , FilePath
"    # lsm to mem"
     , FilePath
"    $ snapshot-converter --input-lsm-snapshot <PATH> --input-lsm-database <PATH> --output-lmdb <PATH> --config <PATH>"
     , FilePath
"    ```"
     , FilePath
""
     , FilePath
"    Note that the input and output paths need to be named after the slot number"
     , FilePath
"    of the contained ledger state, this means for example that a snapshot for"
     , FilePath
"    slot 100 has to be contained in a directory `100[_suffix]` and has to be"
     , FilePath
"    written to a directory `100[_some_other_suffix]`. Providing a wrong slot"
     , FilePath
"    number will throw an error."
     , FilePath
""
     , FilePath
"    This naming convention is the same expected by `cardano-node`."
     , FilePath
""
     , FilePath
"# Running in daemon mode"
     , FilePath
""
     , FilePath
"    `snapshot-converter` can be invoked as a daemon to monitor and convert"
     , FilePath
"    snapshots produced by a `cardano-node` into Mem format as they are"
     , FilePath
"    written by the node. This is only meaningful to run if your node"
     , FilePath
"    produces LMDB or LSM snapshots:"
     , FilePath
""
     , FilePath
"    ```"
     , FilePath
"    # lsm to mem"
     , FilePath
"    $ snapshot-converter --monitor-lsm-snapshots-in <PATH> --lsm-database <PATH> --output-mem-snapshots-in <PATH> --config <PATH>"
     , FilePath
"    # lmdb to mem"
     , FilePath
"    $ snapshot-converter --monitor-lmdb-snapshots-in <PATH> --output-mem-snapshots-in <PATH> --config <PATH>"
     , FilePath
"    ```"
     ]
#endif