Allow to specify points (does not require an ImmutableDB)

Author: amesgen

ouroboros-consensus-cardano/app/n2n-pg.hs

@@ -4,11 +4,14 @@
 module Main (main) where
 
 import           Cardano.Crypto.Init (cryptoInit)
-import           Cardano.Tools.N2NPG.Run (Opts (..))
+import           Cardano.Tools.N2NPG.Run (Opts (..), StartFrom (..))
 import qualified Cardano.Tools.N2NPG.Run as N2NPG
+import qualified Data.ByteString.Base16 as B16
+import qualified Data.ByteString.Char8 as BC8
 import           Main.Utf8 (withStdTerminalHandles)
 import           Options.Applicative
 import           Ouroboros.Consensus.Block
+import           Text.Read (readEither)
 
 main :: IO ()
 main = withStdTerminalHandles $ do
@@ -27,7 +30,7 @@ optsParser =
         , help "Path to config file, in the same format as for the node or db-analyser"
         , metavar "PATH"
         ]
-      immutableDBDir <- strOption $ mconcat
+      immutableDBDir <- optional $ strOption $ mconcat
         [ long "db"
         , help "Path to the ImmutableDB, only used for hash lookups"
         , metavar "PATH"
@@ -42,10 +45,17 @@ optsParser =
         , help "Server address"
         , metavar "HOST:PORT"
         ]
-      startSlots <- some $ option (SlotNo <$> auto) $ mconcat
+      let readStartFrom = eitherReader $ \sf -> case break (== '@') sf of
+            (h, '@' : s) -> do
+              hash <- B16.decode $ BC8.pack h
+              slot <- readEither s
+              pure $ StartFromPoint (SlotNo slot) hash
+            (s, _) -> StartFromSlot . SlotNo <$> readEither s
+      startFrom <- some $ option readStartFrom $ mconcat
         [ long "start-from"
-        , metavar "SLOT_NUMBER"
-        , help "Start downloading from this slot (must be in the ImmutableDB)"
+        , metavar "SLOT_NUMBER or HASH@SLOT_NUMBER"
+        , help $ "Start downloading from this slot (must be in the ImmutableDB) "
+              <> "or the given point (hash and slot)"
         ]
       numBlocks <- option auto $ mconcat
         [ long "num-blocks"
@@ -56,6 +66,6 @@ optsParser =
           configFile
         , immutableDBDir
         , serverAddr
-        , startSlots
+        , startFrom
         , numBlocks
         }

ouroboros-consensus-cardano/ouroboros-consensus-cardano.cabal

@@ -661,6 +661,8 @@ executable n2n-pg
   main-is: n2n-pg.hs
   build-depends:
     base,
+    base16-bytestring,
+    bytestring,
     cardano-crypto-class,
     optparse-applicative,
     ouroboros-consensus,

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

@@ -1,4 +1,5 @@
 {-# LANGUAGE DataKinds           #-}
+{-# LANGUAGE DerivingStrategies  #-}
 {-# LANGUAGE FlexibleContexts    #-}
 {-# LANGUAGE GADTs               #-}
 {-# LANGUAGE LambdaCase          #-}
@@ -7,8 +8,11 @@
 {-# LANGUAGE ScopedTypeVariables #-}
 {-# LANGUAGE TypeApplications    #-}
 
+{-# OPTIONS_GHC -Wwarn #-}
+
 module Cardano.Tools.N2NPG.Run (
     Opts (..)
+  , StartFrom (..)
   , run
   ) where
 
@@ -19,6 +23,7 @@ import           Control.Monad.Class.MonadSay (MonadSay (..))
 import           Control.Monad.Cont
 import           Control.Monad.Trans (MonadTrans (..))
 import           Control.Tracer (nullTracer, stdoutTracer)
+import           Data.ByteString (ByteString)
 import qualified Data.ByteString.Lazy as BL
 import           Data.Functor ((<&>))
 import           Data.Functor.Contravariant ((>$<))
@@ -31,6 +36,7 @@ import           Network.TypedProtocol (N (..), Nat (..), PeerHasAgency (..),
                      PeerPipelined (..), PeerReceiver (..), PeerRole (..),
                      PeerSender (..), natToInt)
 import           Ouroboros.Consensus.Block
+import           Ouroboros.Consensus.Cardano.Block
 import           Ouroboros.Consensus.Config
 import           Ouroboros.Consensus.Config.SupportsNode
                      (ConfigSupportsNode (..))
@@ -84,29 +90,45 @@ import           System.FS.IO (ioHasFS)
 
 data Opts = Opts {
     configFile     :: FilePath
-  , immutableDBDir :: FilePath
+  , immutableDBDir :: Maybe FilePath
   , serverAddr     :: (Socket.HostName, Socket.ServiceName)
-  , startSlots     :: [SlotNo]
+  , startFrom      :: [StartFrom]
   , numBlocks      :: Word64
   }
+  deriving stock (Show)
+
+data StartFrom =
+    -- | Start from a specific slot number. We will use the ImmutableDB to find
+    -- the corresponding hash.
+    StartFromSlot SlotNo
+    -- | Start from a specific point, ie a pair of slot number and hash.
+  | StartFromPoint SlotNo ByteString
+  deriving stock (Show)
 
 run :: Opts -> IO ()
 run opts = evalContT $ do
-    let immDBFS = SomeHasFS $ ioHasFS $ MountPoint immutableDBDir
+    let mImmDBFS = SomeHasFS . ioHasFS . MountPoint <$> immutableDBDir
         args = Cardano.CardanoBlockArgs configFile Nothing
     ProtocolInfo{pInfoConfig = cfg} <- lift $ mkProtocolInfo args
     registry <- ContT withRegistry
-    internalImmDB <- ContT $ withImmutableDBInternal cfg registry immDBFS
+    mInternalImmDB <-
+      traverse (ContT . withImmutableDBInternal cfg registry) mImmDBFS
     snocket <- Snocket.socketSnocket <$> ContT withIOManager
     lift $ do
       ptQueue        <- newTQueueIO
       varNumDequeued <- newTVarIO (0 :: Word64)
       blockFetchDone <- newEmptyTMVarIO
 
-      startPoints <- for startSlots $ \s ->
-        ImmutableDB.getHashForSlot internalImmDB s >>= \case
-          Just h  -> pure $ BlockPoint s h
-          Nothing -> fail $ "Slot not in ImmutableDB: " <> show s
+      startPoints <- for startFrom $ \case
+        StartFromSlot s -> case mInternalImmDB of
+          Just internalImmDB ->
+            ImmutableDB.getHashForSlot internalImmDB s >>= \case
+              Just h  -> pure $ BlockPoint s h
+              Nothing -> fail $ "Slot not in ImmutableDB: " <> show s
+          Nothing -> fail "Need to specify the path to an ImmutableDB"
+        StartFromPoint s h -> pure $ BlockPoint s (fromRawHash p h)
+          where
+            p = Proxy @(CardanoBlock StandardCrypto)
 
       let totalBlocks = numBlocks * fromIntegral (length startPoints)
 
@@ -138,7 +160,7 @@ run opts = evalContT $ do
         configFile
       , immutableDBDir
       , serverAddr = (serverHostName, serverPort)
-      , startSlots
+      , startFrom
       , numBlocks
       } = opts