diff --git a/ouroboros-consensus-cardano/app/n2n-pg.hs b/ouroboros-consensus-cardano/app/n2n-pg.hs index 5de9f6aa5e..0562c3504e 100644 --- a/ouroboros-consensus-cardano/app/n2n-pg.hs +++ b/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 } diff --git a/ouroboros-consensus-cardano/ouroboros-consensus-cardano.cabal b/ouroboros-consensus-cardano/ouroboros-consensus-cardano.cabal index 5f46724e62..1aade6d10d 100644 --- a/ouroboros-consensus-cardano/ouroboros-consensus-cardano.cabal +++ b/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, diff --git a/ouroboros-consensus-cardano/src/unstable-cardano-tools/Cardano/Tools/N2NPG/Run.hs b/ouroboros-consensus-cardano/src/unstable-cardano-tools/Cardano/Tools/N2NPG/Run.hs index 69f42094df..77b137451c 100644 --- a/ouroboros-consensus-cardano/src/unstable-cardano-tools/Cardano/Tools/N2NPG/Run.hs +++ b/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