cleanup

ouroboros-consensus-cardano-tools/app/CardanoLedgerStateConverter/Parsers.hs

@@ -7,29 +7,17 @@ import           Ouroboros.Consensus.Storage.LedgerDB.OnDisk (DiskSnapshot (..))
 import           Cardano.Tools.CardanoLedgerStateConverter.Types
 
 
-{-------------------------------------------------------------------------------
-  Parsing
--------------------------------------------------------------------------------}
-
 parseCmdLine :: Parser Config
-parseCmdLine = Config
-    <$> strOption (mconcat [
-            long "db"
-          , help "Path to the Chain DB"
-          , metavar "PATH"
-          ])
-    <*> parseSelectDB
-
-parseSelectDB :: Parser SelectDB
-parseSelectDB = SelectImmutableDB . snd <$> ((,) <$> onlyImmutableDB <*> analyseFrom)
-  where
-    onlyImmutableDB = flag' () (mconcat [
-        long "only-immutable-db"
-      , help "Validate only the Immutable DB (e.g. do not do ledger validation)"
-      ])
+parseCmdLine =
+  Config
+    <$> strOption ( long "db"
+                    <> help "Path to the Chain DB"
+                    <> metavar "PATH")
+    <*> parseSnapshot
 
-    analyseFrom :: Parser (Maybe DiskSnapshot)
-    analyseFrom = optional $ ((flip DiskSnapshot $ Just "db-analyser") . read) <$> strOption
-      (  long "analyse-from"
-      <> metavar "SLOT_NUMBER"
-      <> help "Start analysis from ledger state stored at specific slot number" )
+parseSnapshot :: Parser DiskSnapshot
+parseSnapshot =
+  flip DiskSnapshot (Just "db-analyser") . read <$> strOption
+    (  long "slot"
+    <> metavar "SLOT_NUMBER"
+    <> help "slot number for snapshot" )

ouroboros-consensus-cardano-tools/app/cardano-ledger-state-converter.hs

@@ -14,7 +14,7 @@ import           Cardano.Tools.CardanoLedgerStateConverter.Types
 
 
 main :: IO ()
-main = getCmdLine >>= analyse
+main = getCmdLine >>= convert
 
 getCmdLine :: IO Config
 getCmdLine = execParser opts

ouroboros-consensus-cardano-tools/src/Cardano/Tools/CardanoLedgerStateConverter/Run.hs

@@ -1,9 +1,8 @@
 {-# LANGUAGE ScopedTypeVariables #-}
-{-# LANGUAGE GADTs          #-}
 {-# LANGUAGE NamedFieldPuns #-}
 {-# LANGUAGE TypeApplications #-}
 
-module Cardano.Tools.CardanoLedgerStateConverter.Run (analyse) where
+module Cardano.Tools.CardanoLedgerStateConverter.Run (convert) where
 
 import           Codec.CBOR.Decoding (Decoder)
 import           Codec.Serialise (Serialise (decode))
@@ -18,47 +17,24 @@ import           Ouroboros.Consensus.Util.Orphans ()
 import qualified Ouroboros.Consensus.Storage.ChainDB as ChainDB
 import           Ouroboros.Consensus.Storage.LedgerDB.DiskPolicy
                      (SnapshotInterval (..), defaultDiskPolicy)
-import           Ouroboros.Consensus.Storage.LedgerDB.OnDisk (readSnapshot)
+import           Ouroboros.Consensus.Storage.LedgerDB.OnDisk (readSnapshot, DiskSnapshot (..))
 
 import           Cardano.Tools.CardanoLedgerStateConverter.Types
 
 import           Cardano.Ledger.Crypto (StandardCrypto)
-import qualified Cardano.Ledger.Allegra as SL
-import qualified Cardano.Ledger.Alonzo as SL
-import qualified Cardano.Ledger.Babbage as SL
-import qualified Cardano.Ledger.Mary as SL
-import qualified Cardano.Ledger.Shelley as SL
-import qualified Cardano.Ledger.Shelley.API as SL
 import           Ouroboros.Consensus.Cardano (CardanoBlock)
 import qualified Ouroboros.Consensus.Cardano.Block as Cardano
 import qualified Ouroboros.Consensus.Ledger.Basics as Consensus
 import qualified Ouroboros.Consensus.Ledger.Extended as Consensus
 import           Ouroboros.Consensus.Shelley.Ledger (shelleyLedgerState)
 import           Ouroboros.Consensus.Shelley.Ledger.Config (CodecConfig (ShelleyCodecConfig))
 import           Ouroboros.Consensus.Byron.Ledger.Config (CodecConfig (ByronCodecConfig))
-import           Cardano.Binary (ToCBOR (..), serialize')
+import           Cardano.Binary (serialize')
 import           Cardano.Chain.Slotting (EpochSlots(..))
 import qualified Data.ByteString as BS
 import           Cardano.Tools.DBAnalyser.Block.Cardano ()
 
 
-data AnyShelleyEra c era where
-    ShelleyEra :: AnyShelleyEra c (SL.ShelleyEra c)
-    AllegraEra :: AnyShelleyEra c (SL.AllegraEra c)
-    MaryEra    :: AnyShelleyEra c (SL.MaryEra    c)
-    AlonzoEra  :: AnyShelleyEra c (SL.AlonzoEra  c)
-    BabbageEra :: AnyShelleyEra c (SL.BabbageEra c)
-
-data SomeNewEpochState where
-    SomeNewEpochState ::
-         !(AnyShelleyEra StandardCrypto era)
-      -> !(SL.NewEpochState era)
-      -> SomeNewEpochState
-
-instance ToCBOR SomeNewEpochState where
-  toCBOR (SomeNewEpochState AlonzoEra nes) = toCBOR nes
-  toCBOR _ = error "dont look back"
-
 -- | Returns @Nothing@ only for a Cardano ledger state in the Byron era
 projectNewEpochState ::
      Consensus.ExtLedgerState (CardanoBlock StandardCrypto)
@@ -77,21 +53,19 @@ projectNewEpochState extLedgerState =
 
     f era = Just . SomeNewEpochState era . shelleyLedgerState
 
-analyse :: Config -> IO ()
-analyse Config{dbDir, selectDB} = do
+convert :: Config -> IO ()
+convert Config{dbDir, snapShot} = do
       let diskPolicy = defaultDiskPolicy (SecurityParam 0) DefaultSnapshotInterval
           args' = ChainDB.defaultArgs (Node.stdMkChainDbHasFS dbDir) diskPolicy
           ledgerDbFS = ChainDB.cdbHasFSLgrDB args'
+          outputFilename = "newEpochState-" <> show (dsNumber snapShot) <> ".cbor"
+
+      initLedgerErr <- runExceptT $ readSnapshot ledgerDbFS decodeExtLedgerState' decode snapShot
+      initLedger <- either (error . show) pure initLedgerErr
+      case projectNewEpochState initLedger of
+        Nothing -> error "failed to get ledger state from extended ledger state"
+        Just ls -> BS.writeFile outputFilename (serialize' ls)
 
-      case selectDB of
-        SelectImmutableDB initializeFrom -> do
-          initLedgerErr <- runExceptT $ case initializeFrom of
-            Nothing       -> error "no snapshot given"
-            Just snapshot -> readSnapshot ledgerDbFS decodeExtLedgerState' decode snapshot
-          initLedger <- either (error . show) pure initLedgerErr
-          case projectNewEpochState initLedger of
-            Nothing -> error "failed to get ledger state from extended ledger state"
-            Just ls -> BS.writeFile "newEpochState.cbor" (serialize' ls)
   where
     decodeExtLedgerState' :: forall s .Decoder s (ExtLedgerState (CardanoBlock StandardCrypto))
     decodeExtLedgerState' =

ouroboros-consensus-cardano-tools/src/Cardano/Tools/CardanoLedgerStateConverter/Types.hs

@@ -1,15 +1,43 @@
+{-# LANGUAGE GADTs          #-}
 
 module Cardano.Tools.CardanoLedgerStateConverter.Types
-  ( SelectDB (..)
+  ( AnyShelleyEra (..)
+  , SomeNewEpochState (..)
   , Config (..)
   ) where
 
+import           Cardano.Binary (ToCBOR (..))
+import qualified Cardano.Ledger.Allegra as SL
+import qualified Cardano.Ledger.Alonzo as SL
+import qualified Cardano.Ledger.Babbage as SL
+import           Cardano.Ledger.Crypto (StandardCrypto)
+import qualified Cardano.Ledger.Mary as SL
+import qualified Cardano.Ledger.Shelley as SL
+import qualified Cardano.Ledger.Shelley.API as SL
 import           Ouroboros.Consensus.Storage.LedgerDB.OnDisk (DiskSnapshot)
 
+data AnyShelleyEra c era where
+    ShelleyEra :: AnyShelleyEra c (SL.ShelleyEra c)
+    AllegraEra :: AnyShelleyEra c (SL.AllegraEra c)
+    MaryEra    :: AnyShelleyEra c (SL.MaryEra    c)
+    AlonzoEra  :: AnyShelleyEra c (SL.AlonzoEra  c)
+    BabbageEra :: AnyShelleyEra c (SL.BabbageEra c)
+
+data SomeNewEpochState where
+    SomeNewEpochState ::
+         !(AnyShelleyEra StandardCrypto era)
+      -> !(SL.NewEpochState era)
+      -> SomeNewEpochState
+
+instance ToCBOR SomeNewEpochState where
+  toCBOR (SomeNewEpochState ShelleyEra nes) = toCBOR nes
+  toCBOR (SomeNewEpochState AllegraEra nes) = toCBOR nes
+  toCBOR (SomeNewEpochState MaryEra    nes) = toCBOR nes
+  toCBOR (SomeNewEpochState AlonzoEra  nes) = toCBOR nes
+  toCBOR (SomeNewEpochState BabbageEra nes) = toCBOR nes
 
-data SelectDB = SelectImmutableDB (Maybe DiskSnapshot)
 
 data Config = Config {
     dbDir      :: FilePath
-  , selectDB   :: SelectDB
+  , snapShot   :: DiskSnapshot
   }