From a71712a22907bc92694bdd45ec4fa4d32bb9f87a Mon Sep 17 00:00:00 2001 From: Alexander Vieth Date: Mon, 19 Aug 2019 17:47:46 -0400 Subject: [PATCH 1/4] module description in Genesis.Convert --- src/lib/Ouroboros/Byron/Proxy/Genesis/Convert.hs | 14 +++++++++++--- 1 file changed, 11 insertions(+), 3 deletions(-) diff --git a/src/lib/Ouroboros/Byron/Proxy/Genesis/Convert.hs b/src/lib/Ouroboros/Byron/Proxy/Genesis/Convert.hs index 9ccf45d6..9ace5fa3 100644 --- a/src/lib/Ouroboros/Byron/Proxy/Genesis/Convert.hs +++ b/src/lib/Ouroboros/Byron/Proxy/Genesis/Convert.hs @@ -1,3 +1,14 @@ +{-| +Module : Ouroboros.Byron.Proxy.Genesis.Convert +Description : Conversion of legacy cardano-sl genesis configuration. + +cardano-byron-proxy must use legacy cardano-sl genesis configuration in order +to run the Byron side, and must also use a similar configuration to set up +the Shelley side. The definitions in this module convert values of legacy Byron +configuration types (cardano-sl) into their corresponding new Shelley +types (cardano-ledger). +-} + {-# LANGUAGE ScopedTypeVariables #-} {-# LANGUAGE GADTSyntax #-} {-# LANGUAGE OverloadedStrings #-} @@ -8,8 +19,6 @@ {-# LANGUAGE ApplicativeDo #-} {-# LANGUAGE PatternSynonyms #-} -{-# LANGUAGE TypeFamilies #-} - module Ouroboros.Byron.Proxy.Genesis.Convert where import Data.Coerce (coerce) @@ -196,7 +205,6 @@ convertProtocolParameters bvd = Cardano.ProtocolParameters , Cardano.ppUnlockStakeEpoch = convertEpochIndex (CSL.bvdUnlockStakeEpoch bvd) } - convertGenesisSpec :: CSL.GenesisSpec -> Cardano.GenesisSpec convertGenesisSpec gspec = Cardano.UnsafeGenesisSpec { Cardano.gsAvvmDistr = convertAvvmDistr (CSL.gsAvvmDistr gspec) From 1a3b01be3702cd6a74ac208cbf052b9691c6c461 Mon Sep 17 00:00:00 2001 From: Alexander Vieth Date: Mon, 19 Aug 2019 19:01:37 -0400 Subject: [PATCH 2/4] better index/db intersection computation Now the index will not always rollback to origin when its tip is not in the database. It will try to find an intersection point within the security parameter, and roll back only to that point. --- src/cddl-test/Main.hs | 2 +- src/exec/Byron.hs | 23 +---- src/exec/DB.hs | 7 +- src/lib/Ouroboros/Byron/Proxy/Block.hs | 31 +++++-- .../Ouroboros/Byron/Proxy/Index/ChainDB.hs | 85 +++++++++++++------ src/lib/Ouroboros/Byron/Proxy/Index/Sqlite.hs | 74 +++++++++++----- src/lib/Ouroboros/Byron/Proxy/Index/Types.hs | 23 ++++- 7 files changed, 161 insertions(+), 84 deletions(-) diff --git a/src/cddl-test/Main.hs b/src/cddl-test/Main.hs index 670cd30d..74da337c 100644 --- a/src/cddl-test/Main.hs +++ b/src/cddl-test/Main.hs @@ -102,7 +102,7 @@ dbArgs fp = do , immErr = EH.exceptions , immEpochInfo = epochInfo , immValidation = ValidateMostRecentEpoch - , immIsEBB = isEBB + , immIsEBB = fmap fst . isEBB , immAddHdrEnv = Byron.byronAddHeaderEnvelope , immCheckIntegrity = const True -- No validation , immHasFS = ioHasFS $ MountPoint (fp "immutable") diff --git a/src/exec/Byron.hs b/src/exec/Byron.hs index 01ce56a6..0d0d1aca 100644 --- a/src/exec/Byron.hs +++ b/src/exec/Byron.hs @@ -22,7 +22,6 @@ import Data.List.NonEmpty (NonEmpty) import qualified Data.List.NonEmpty as NE import Data.Maybe (mapMaybe) import qualified Data.Text.Lazy.Builder as Text -import Data.Word (Word64) import System.Random (StdGen, getStdGen, randomR) import qualified Cardano.Binary as Binary @@ -34,14 +33,14 @@ import qualified Pos.Chain.Block as CSL (Block, BlockHeader (..), GenesisBlock, MainBlockHeader, HeaderHash, headerHash) import qualified Pos.Infra.Diffusion.Types as CSL -import Ouroboros.Byron.Proxy.Block (ByronBlock, +import Ouroboros.Byron.Proxy.Block (ByronBlock, checkpointOffsets, coerceHashToLegacy, headerHash) import Ouroboros.Byron.Proxy.Main import Ouroboros.Consensus.Block (Header) import Ouroboros.Consensus.Ledger.Byron (ByronHash(..), byronHeaderRaw, mkByronBlock) import Ouroboros.Consensus.Ledger.Byron.Auxiliary as Cardano -import Ouroboros.Consensus.Protocol.Abstract (SecurityParam (maxRollbacks)) +import Ouroboros.Consensus.Protocol.Abstract (SecurityParam) import Ouroboros.Network.Block (ChainHash (..), Point, pointHash) import qualified Ouroboros.Network.AnchoredFragment as AF import qualified Ouroboros.Network.ChainFragment as CF @@ -136,25 +135,14 @@ download tracer genesisBlock epochSlots securityParam db bp = do checkpoints :: AF.AnchoredFragment (Header ByronBlock) -> [CSL.HeaderHash] - checkpoints = mapMaybe pointToHash . AF.selectPoints (fmap fromIntegral offsets) + checkpoints = mapMaybe pointToHash . + AF.selectPoints (fmap fromIntegral (checkpointOffsets securityParam)) pointToHash :: Point (Header ByronBlock) -> Maybe CSL.HeaderHash pointToHash pnt = case pointHash pnt of GenesisHash -> Nothing BlockHash (ByronHash hash) -> Just $ coerceHashToLegacy hash - -- Offsets for selectPoints. Defined in the same way as for the Shelley - -- chain sync client: fibonacci numbers including 0 and k. - offsets :: [Word64] - offsets = 0 : foldr includeK ([] {- this is never forced -}) (tail fibs) - - includeK :: Word64 -> [Word64] -> [Word64] - includeK w ws | w >= k = [k] - | otherwise = w : ws - - fibs :: [Word64] - fibs = 1 : 1 : zipWith (+) fibs (tail fibs) - streamer :: CSL.HeaderHash -> CSL.StreamBlocks CSL.Block IO CSL.HeaderHash streamer tipHash = CSL.StreamBlocks { CSL.streamBlocksMore = \blocks -> do @@ -188,9 +176,6 @@ download tracer genesisBlock epochSlots securityParam db bp = do let (idx, rndGen') = randomR (0, NE.length ne - 1) rndGen in (ne NE.!! idx, rndGen') - k :: Word64 - k = maxRollbacks securityParam - recodeBlockOrFail :: Cardano.EpochSlots -> (forall x . Binary.DecoderError -> IO x) diff --git a/src/exec/DB.hs b/src/exec/DB.hs index 5b8de8f9..3b28b9b0 100644 --- a/src/exec/DB.hs +++ b/src/exec/DB.hs @@ -23,10 +23,10 @@ import Ouroboros.Consensus.BlockchainTime (BlockchainTime) import Ouroboros.Consensus.Ledger.Byron.Config (pbftEpochSlots) import Ouroboros.Consensus.Ledger.Extended (ExtLedgerState) import Ouroboros.Consensus.Node (withChainDB) +import Ouroboros.Consensus.Util.ResourceRegistry (ResourceRegistry) import Ouroboros.Consensus.Protocol (NodeConfig, pbftExtConfig) -import Ouroboros.Consensus.Util.ResourceRegistry (ResourceRegistry) -import qualified Ouroboros.Consensus.Util.ResourceRegistry as ResourceRegistry +import Ouroboros.Consensus.Protocol.Abstract (protocolSecurityParam) import Ouroboros.Storage.ChainDB.API (ChainDB) import qualified Ouroboros.Storage.ChainDB.Impl as ChainDB import Ouroboros.Storage.ChainDB.Impl.Args (ChainDbArgs (..)) @@ -61,8 +61,7 @@ withDB dbOptions dbTracer indexTracer rr btime nodeConfig extLedgerState k = do withChainDB dbTracer rr btime (dbFilePath dbOptions) nodeConfig extLedgerState customiseArgs $ \cdb -> Sqlite.withIndexAuto epochSlots indexTracer (indexFilePath dbOptions) $ \idx -> do - _ <- ResourceRegistry.forkLinkedThread rr $ Index.trackChainDB rr idx cdb - k idx cdb + Index.trackChainDB rr idx cdb (protocolSecurityParam nodeConfig) (k idx cdb) where diff --git a/src/lib/Ouroboros/Byron/Proxy/Block.hs b/src/lib/Ouroboros/Byron/Proxy/Block.hs index d1dd464e..6abf2811 100644 --- a/src/lib/Ouroboros/Byron/Proxy/Block.hs +++ b/src/lib/Ouroboros/Byron/Proxy/Block.hs @@ -19,9 +19,11 @@ module Ouroboros.Byron.Proxy.Block , coerceHashToLegacy , headerHash , isEBB + , checkpointOffsets ) where import qualified Codec.CBOR.Write as CBOR (toStrictByteString) +import Data.Word (Word64) import qualified Pos.Chain.Block as CSL (HeaderHash) import qualified Pos.Crypto.Hashing as Legacy (AbstractHash (..)) @@ -31,8 +33,9 @@ import qualified Cardano.Chain.Block as Cardano import Cardano.Crypto.Hashing (AbstractHash (..)) import qualified Ouroboros.Consensus.Block as Consensus (GetHeader (..)) -import Ouroboros.Consensus.Ledger.Byron (ByronBlock (..), ByronHash (..), - encodeByronBlock, byronHeaderHash) +import Ouroboros.Consensus.Ledger.Byron (ByronBlock (..), + ByronHash (..), encodeByronBlock, byronHeaderHash) +import Ouroboros.Consensus.Protocol.Abstract (SecurityParam (..)) import Ouroboros.Storage.Common (EpochNo(..)) -- For type instance HeaderHash (Header blk) = HeaderHash blk @@ -60,11 +63,23 @@ headerHash = unByronHash . byronHeaderHash -- | Return @Just@ the epoch number if the block is an EBB, @Nothing@ for -- regular blocks -isEBB :: ByronBlock -> Maybe EpochNo +isEBB :: ByronBlock -> Maybe (EpochNo, ByronHash) isEBB blk = case byronBlockRaw blk of Cardano.ABOBBlock _ -> Nothing - Cardano.ABOBBoundary ebb -> Just - . EpochNo - . Cardano.boundaryEpoch - . Cardano.boundaryHeader - $ ebb + Cardano.ABOBBoundary ebb -> Just (epochNo, byronHash) + where + epochNo = EpochNo . Cardano.boundaryEpoch . Cardano.boundaryHeader $ ebb + byronHash = ByronHash . headerHash . Consensus.getHeader $ blk + +-- | Compute the offsets for use by ChainFragment.selectPoints or +-- AnchoredFragment.selectPoints for some security parameter k. It uses +-- fibonacci numbers with 0 and k as endpoints, and the duplicate 1 at the +-- start removed. +checkpointOffsets :: SecurityParam -> [Word64] +checkpointOffsets (SecurityParam k) = 0 : foldr includeK ([] {- this is never forced -}) (tail fibs) + where + includeK :: Word64 -> [Word64] -> [Word64] + includeK w ws | w >= k = [k] + | otherwise = w : ws + fibs :: [Word64] + fibs = 1 : 1 : zipWith (+) fibs (tail fibs) diff --git a/src/lib/Ouroboros/Byron/Proxy/Index/ChainDB.hs b/src/lib/Ouroboros/Byron/Proxy/Index/ChainDB.hs index 56a327af..5216fa0f 100644 --- a/src/lib/Ouroboros/Byron/Proxy/Index/ChainDB.hs +++ b/src/lib/Ouroboros/Byron/Proxy/Index/ChainDB.hs @@ -5,14 +5,18 @@ module Ouroboros.Byron.Proxy.Index.ChainDB ( trackChainDB ) where +import Control.Concurrent.Async (race) import Control.Exception (bracket) +import Data.Word (Word64) +import Ouroboros.Byron.Proxy.Block (checkpointOffsets) import Ouroboros.Byron.Proxy.Index.Types (Index) import qualified Ouroboros.Byron.Proxy.Index.Types as Index import Ouroboros.Consensus.Block (GetHeader (Header)) import Ouroboros.Consensus.Util.ResourceRegistry (ResourceRegistry) +import Ouroboros.Consensus.Protocol.Abstract (SecurityParam) import Ouroboros.Network.Block (ChainUpdate (..), Point (..)) -import Ouroboros.Network.Point (WithOrigin (Origin)) +import Ouroboros.Network.Point (WithOrigin (Origin), block) import Ouroboros.Storage.ChainDB.API (ChainDB, Reader) import qualified Ouroboros.Storage.ChainDB.API as ChainDB @@ -21,7 +25,7 @@ trackReaderBlocking :: ( Monad m ) => Index m (Header blk) -> Reader m blk (Header blk) - -> m x + -> m void trackReaderBlocking idx reader = do instruction <- ChainDB.readerInstructionBlocking reader case instruction of @@ -50,42 +54,69 @@ trackReader idx reader = do trackReader idx reader Nothing -> pure () --- | Have an Index track a ChainDB using its Reader API. You probably want to --- race this with some other thread that runs your application. --- --- If the ChainDB does not contain the tip of the Index, then the whole index --- will be rebuilt. +-- | Have an Index track a ChainDB using its Reader API for the duration of +-- some monadic action. -- -- It will spawn a thread to do the index updates. This must be the only -- index writer. It is run by `race` with the action, so exceptions in either -- the action or the writer thread will be re-thrown here. -- --- If the tip of the index is not in the ChainDB, then the entire index will be --- rebuilt. This is not ideal: there may be an intersection. TODO would be --- better to check the newest slot older than `k` back from tip of index, and --- go from there. +-- If the tip of the index is in the ChainDB, then no work must be done in the +-- beginning. But if it's not in the ChainDB, there will have to be a rollback +-- on the index. The SecurityParam k is used to decide how far back to try. If +-- Only index entries at most k slots old will be checked against the +-- ChainDB. If none are in it, then the entire index will be rebuild (rollback +-- to Origin). trackChainDB - :: forall blk void . + :: forall blk t . ResourceRegistry IO -> Index IO (Header blk) -> ChainDB IO blk - -> IO void -trackChainDB rr idx cdb = bracket acquireReader releaseReader $ \rdr -> do - tipPoint <- Index.tip idx - mPoint <- ChainDB.readerForward rdr [Point tipPoint] - -- `readerForward` docs say that if we get `Nothing`, the next reader - -- instruction may not be a rollback, so we'll manually roll the index - -- back. It's assumed the read pointer will be at origin (nothing else - -- would make sense). - case mPoint of - Nothing -> Index.rollbackward idx Origin - Just _ -> pure () - -- First, block until the index is caught up to the tip ... - trackReader idx rdr - -- ... then attempt to stay in sync. - trackReaderBlocking idx rdr + -> SecurityParam + -> IO t + -> IO t +trackChainDB rr idx cdb k act = bracket acquireReader releaseReader $ \rdr -> do + checkpoints <- Index.streamFromTip idx checkpointsFold + mPoint <- ChainDB.readerForward rdr checkpoints + case mPoint of + -- `readerForward` docs say that the next instruction will be a rollback, + -- so we don't have to do anything here; the call to `trackReader` will + -- do what needs to be done. + Just _ -> pure () + -- `readerForward` docs say that if we get `Nothing`, the next reader + -- instruction may not be a rollback, so we'll manually roll the index + -- back. It's assumed the read pointer will be at origin (nothing else + -- would make sense). + Nothing -> Index.rollbackward idx Origin + -- First, block until the index is caught up to the tip ... + trackReader idx rdr + -- ... then attempt to stay in sync. + outcome <- race (trackReaderBlocking idx rdr) act + case outcome of + Left impossible -> impossible + Right t -> pure t where acquireReader :: IO (Reader IO blk (Header blk)) acquireReader = ChainDB.deserialiseReader <$> ChainDB.newHeaderReader cdb rr releaseReader :: Reader IO blk (Header blk) -> IO () releaseReader = ChainDB.readerClose + + checkpointsFold :: Index.Fold (Header blk) [Point blk] + checkpointsFold = checkpointsFoldN 0 (checkpointOffsets k) + + -- Count up from 0 on the first parameter. Whenever it coincides with the + -- head of the second parameter (an increasing list) include that point. + -- Stop when the second list is empty. + -- Since checkpointsFold always includes the paramater k, the k'th entry + -- in the index will always be in here, unless the index is shorter + -- than k. This block is _at least_ k slots behind the DB, so if it's not + -- in the DB then the index is way out of date. + checkpointsFoldN + :: Word64 + -> [Word64] + -> Index.Fold (Header blk) [Point blk] + checkpointsFoldN _ [] = Index.Stop [] + checkpointsFoldN w (o : os) = Index.More [] $ \slotNo hash -> + if w == o + then fmap ((:) (Point (block slotNo hash))) (checkpointsFoldN (w+1) os) + else checkpointsFoldN (w+1) (o : os) diff --git a/src/lib/Ouroboros/Byron/Proxy/Index/Sqlite.hs b/src/lib/Ouroboros/Byron/Proxy/Index/Sqlite.hs index 24165d6c..2e7a7843 100644 --- a/src/lib/Ouroboros/Byron/Proxy/Index/Sqlite.hs +++ b/src/lib/Ouroboros/Byron/Proxy/Index/Sqlite.hs @@ -55,10 +55,11 @@ index -> Sql.Statement -- for insert -> Index IO (Header ByronBlock) index epochSlots tracer conn insertStatement = Index - { Index.lookup = sqliteLookup epochSlots conn - , tip = sqliteTip epochSlots conn - , rollforward = sqliteRollforward epochSlots tracer insertStatement - , rollbackward = sqliteRollbackward epochSlots tracer conn + { Index.lookup = sqliteLookup epochSlots conn + , tip = sqliteTip epochSlots conn + , streamFromTip = sqliteStreamFromTip epochSlots conn + , rollforward = sqliteRollforward epochSlots tracer insertStatement + , rollbackward = sqliteRollbackward epochSlots tracer conn } -- | Open a new or existing SQLite database. If new, it will set up the schema. @@ -157,6 +158,24 @@ createTable conn = Sql.execute_ conn sql_create_table createIndex :: Sql.Connection -> IO () createIndex conn = Sql.execute_ conn sql_create_index +convertHashBlob :: ByteString -> IO HeaderHash +convertHashBlob blob = case digestFromByteString blob of + Just hh -> pure (AbstractHash hh) + Nothing -> throwIO $ InvalidHash blob + +-- | Convert the database encoding of relative slot to the offset in an +-- epoch. The header hash is taken for error-reporting purposes. +offsetInEpoch :: HeaderHash -> Int -> IO Word64 +offsetInEpoch hh i + | i == -1 = pure 0 + | i >= 0 = pure $ fromIntegral i + | otherwise = throwIO $ InvalidRelativeSlot hh i + +toAbsoluteSlot :: EpochSlots -> HeaderHash -> Word64 -> Int -> IO SlotNo +toAbsoluteSlot epochSlots hh epochNo slotInt = do + offset <- offsetInEpoch hh slotInt + pure $ SlotNo $ unEpochSlots epochSlots * epochNo + offset + -- | The tip is the entry with the highest epoch and slot pair. sql_get_tip :: Query sql_get_tip = @@ -169,18 +188,36 @@ sqliteTip epochSlots conn = do case rows of [] -> pure Origin ((hhBlob, epoch, slotInt) : _) -> do - hh <- case digestFromByteString hhBlob of - Just hh -> pure (AbstractHash hh) - Nothing -> throwIO $ InvalidHash hhBlob - offsetInEpoch :: Word64 <- - if slotInt == -1 - then pure 0 - else if slotInt >= 0 - then pure $ fromIntegral slotInt - else throwIO $ InvalidRelativeSlot hh slotInt - let slotNo = SlotNo $ unEpochSlots epochSlots * epoch + offsetInEpoch + hh <- convertHashBlob hhBlob + slotNo <- toAbsoluteSlot epochSlots hh epoch slotInt pure $ At $ Point.Block slotNo (ByronHash hh) +sql_get_all :: Query +sql_get_all = + "SELECT header_hash, epoch, slot FROM block_index\ + \ ORDER BY epoch DESC, slot DESC;" + +-- | Stream rows from the tip by using the prepared statement and nextRow +-- API. +sqliteStreamFromTip + :: EpochSlots + -> Sql.Connection + -> Index.Fold (Header ByronBlock) t + -> IO t +sqliteStreamFromTip epochSlots conn fold = Sql.withStatement conn sql_get_all $ \stmt -> + go stmt fold + where + go stmt step = case step of + Index.Stop t -> pure t + Index.More t k -> do + next <- Sql.nextRow stmt + case next of + Nothing -> pure t + Just (hhBlob, epoch, slotInt) -> do + hh <- convertHashBlob hhBlob + slotNo <- toAbsoluteSlot epochSlots hh epoch slotInt + go stmt (k slotNo (ByronHash hh)) + sql_get_hash :: Query sql_get_hash = "SELECT epoch, slot FROM block_index\ @@ -194,13 +231,8 @@ sqliteLookup epochSlots conn (ByronHash hh@(AbstractHash digest)) = do case rows of [] -> pure Nothing ((epoch, slotInt) : _) -> do - offsetInEpoch :: Word64 <- - if slotInt == -1 - then pure 0 - else if slotInt >= 0 - then pure $ fromIntegral slotInt - else throwIO $ InvalidRelativeSlot hh slotInt - pure $ Just $ SlotNo $ unEpochSlots epochSlots * epoch + offsetInEpoch + slotNo <- toAbsoluteSlot epochSlots hh epoch slotInt + pure $ Just slotNo -- | Note that there is a UNIQUE constraint. This will fail if a duplicate -- entry is inserted. diff --git a/src/lib/Ouroboros/Byron/Proxy/Index/Types.hs b/src/lib/Ouroboros/Byron/Proxy/Index/Types.hs index 28f4243c..1114f331 100644 --- a/src/lib/Ouroboros/Byron/Proxy/Index/Types.hs +++ b/src/lib/Ouroboros/Byron/Proxy/Index/Types.hs @@ -1,7 +1,9 @@ {-# LANGUAGE GADTSyntax #-} +{-# LANGUAGE RankNTypes #-} module Ouroboros.Byron.Proxy.Index.Types ( Index (..) + , Fold (..) ) where import Ouroboros.Network.Block (HeaderHash, SlotNo (..)) @@ -19,19 +21,32 @@ import qualified Ouroboros.Network.Point as Point (Block) data Index m header = Index { -- | Lookup the epoch number and relative slot for a given header hash. -- `Nothing` means it's not in the index. - lookup :: HeaderHash header -> m (Maybe SlotNo) + lookup :: HeaderHash header -> m (Maybe SlotNo) -- | Check the current tip. `Nothing` means the index is empty. Otherwise, -- you get the point and also its header hash. - , tip :: m (WithOrigin (Point.Block SlotNo (HeaderHash header))) + , tip :: m (WithOrigin (Point.Block SlotNo (HeaderHash header))) + -- | Lazily fold over all entries in the index beginning at the tip. + , streamFromTip :: forall t . Fold header t -> m t -- | Extend the index with a new entry. The point must be newer than -- the latest point in the index (current tip). Whether this is checked -- or enforced depends upon the implementation. - , rollforward :: header -> m () + , rollforward :: header -> m () -- | Roll back to a given point, making it the tip of the index. -- TPoint is used because you can rollback to the origin, clearing the -- index. -- An index implementation need not actually use the header hash here. -- It could or could not check that the point actually corresponds to the -- entry at that hash. - , rollbackward :: WithOrigin (Point.Block SlotNo (HeaderHash header)) -> m () + , rollbackward :: WithOrigin (Point.Block SlotNo (HeaderHash header)) -> m () } + +-- | Defined for use in streamFromTip. A fold over the slot number and header +-- hash pairs in an index. +data Fold header t where + Stop :: t -> Fold header t + -- | First argument is for when there are no more entries in the index. + More :: t -> (SlotNo -> HeaderHash header -> Fold header t) -> Fold header t + +instance Functor (Fold header) where + fmap f (Stop t) = Stop (f t) + fmap f (More eof k) = More (f eof) (\slot hash -> fmap f (k slot hash)) From f4e5b30f95508c7f6668540bb4bd49f1cbec1265 Mon Sep 17 00:00:00 2001 From: Alexander Vieth Date: Tue, 20 Aug 2019 13:20:05 -0400 Subject: [PATCH 3/4] call monitorStaticConfig on Byron topology --- src/exec/Main.hs | 6 +----- 1 file changed, 1 insertion(+), 5 deletions(-) diff --git a/src/exec/Main.hs b/src/exec/Main.hs index 1c222f88..cad48edb 100644 --- a/src/exec/Main.hs +++ b/src/exec/Main.hs @@ -491,11 +491,7 @@ runByron tracer byronOptions genesisConfig blockConfig updateConfig nodeConfig e networkConfig <- CSL.intNetworkConfigOpts (Trace.named cslTrace) (boNetworkOptions byronOptions) - let networkConfig' = networkConfig - { ncEnqueuePolicy = Policy.defaultEnqueuePolicyRelay - , ncDequeuePolicy = Policy.defaultDequeuePolicyRelay - } - bpc :: ByronProxyConfig + let bpc :: ByronProxyConfig bpc = configFromCSLConfigs genesisConfig blockConfig From 772e701029819b7d0f64dbb7a3d76de1b3a8f1c9 Mon Sep 17 00:00:00 2001 From: Alexander Vieth Date: Thu, 29 Aug 2019 20:34:41 -0400 Subject: [PATCH 4/4] fixes after rebase conflicts --- src/exec/DB.hs | 4 +++- src/exec/Main.hs | 3 +-- .../Ouroboros/Byron/Proxy/Index/ChainDB.hs | 20 +++++-------------- 3 files changed, 9 insertions(+), 18 deletions(-) diff --git a/src/exec/DB.hs b/src/exec/DB.hs index 3b28b9b0..08dae309 100644 --- a/src/exec/DB.hs +++ b/src/exec/DB.hs @@ -24,6 +24,7 @@ import Ouroboros.Consensus.Ledger.Byron.Config (pbftEpochSlots) import Ouroboros.Consensus.Ledger.Extended (ExtLedgerState) import Ouroboros.Consensus.Node (withChainDB) import Ouroboros.Consensus.Util.ResourceRegistry (ResourceRegistry) +import qualified Ouroboros.Consensus.Util.ResourceRegistry as ResourceRegistry import Ouroboros.Consensus.Protocol (NodeConfig, pbftExtConfig) import Ouroboros.Consensus.Protocol.Abstract (protocolSecurityParam) @@ -61,7 +62,8 @@ withDB dbOptions dbTracer indexTracer rr btime nodeConfig extLedgerState k = do withChainDB dbTracer rr btime (dbFilePath dbOptions) nodeConfig extLedgerState customiseArgs $ \cdb -> Sqlite.withIndexAuto epochSlots indexTracer (indexFilePath dbOptions) $ \idx -> do - Index.trackChainDB rr idx cdb (protocolSecurityParam nodeConfig) (k idx cdb) + _ <- ResourceRegistry.forkLinkedThread rr $ Index.trackChainDB rr idx cdb (protocolSecurityParam nodeConfig) + k idx cdb where diff --git a/src/exec/Main.hs b/src/exec/Main.hs index cad48edb..f0991e8c 100644 --- a/src/exec/Main.hs +++ b/src/exec/Main.hs @@ -55,7 +55,6 @@ import qualified Pos.Infra.Network.CLI as CSL (NetworkConfigOpts (..), launchStaticConfigMonitoring, listenNetworkAddressOption) import Pos.Infra.Network.Types (NetworkConfig (..)) -import qualified Pos.Infra.Network.Policy as Policy import qualified Pos.Launcher.Configuration as CSL (Configuration (..), ConfigurationOptions (..)) import qualified Pos.Client.CLI.Options as CSL (configurationOptionsParser) @@ -497,7 +496,7 @@ runByron tracer byronOptions genesisConfig blockConfig updateConfig nodeConfig e blockConfig updateConfig nodeConfig - networkConfig' + networkConfig 64 -- Batch size. trace genesisBlock = CSL.genesisBlock0 (CSL.configProtocolMagic genesisConfig) diff --git a/src/lib/Ouroboros/Byron/Proxy/Index/ChainDB.hs b/src/lib/Ouroboros/Byron/Proxy/Index/ChainDB.hs index 5216fa0f..a045b1a3 100644 --- a/src/lib/Ouroboros/Byron/Proxy/Index/ChainDB.hs +++ b/src/lib/Ouroboros/Byron/Proxy/Index/ChainDB.hs @@ -5,7 +5,6 @@ module Ouroboros.Byron.Proxy.Index.ChainDB ( trackChainDB ) where -import Control.Concurrent.Async (race) import Control.Exception (bracket) import Data.Word (Word64) @@ -54,12 +53,7 @@ trackReader idx reader = do trackReader idx reader Nothing -> pure () --- | Have an Index track a ChainDB using its Reader API for the duration of --- some monadic action. --- --- It will spawn a thread to do the index updates. This must be the only --- index writer. It is run by `race` with the action, so exceptions in either --- the action or the writer thread will be re-thrown here. +-- | Have an Index track a ChainDB using its Reader API. -- -- If the tip of the index is in the ChainDB, then no work must be done in the -- beginning. But if it's not in the ChainDB, there will have to be a rollback @@ -68,14 +62,13 @@ trackReader idx reader = do -- ChainDB. If none are in it, then the entire index will be rebuild (rollback -- to Origin). trackChainDB - :: forall blk t . + :: forall blk void . ResourceRegistry IO -> Index IO (Header blk) -> ChainDB IO blk -> SecurityParam - -> IO t - -> IO t -trackChainDB rr idx cdb k act = bracket acquireReader releaseReader $ \rdr -> do + -> IO void +trackChainDB rr idx cdb k = bracket acquireReader releaseReader $ \rdr -> do checkpoints <- Index.streamFromTip idx checkpointsFold mPoint <- ChainDB.readerForward rdr checkpoints case mPoint of @@ -91,10 +84,7 @@ trackChainDB rr idx cdb k act = bracket acquireReader releaseReader $ \rdr -> do -- First, block until the index is caught up to the tip ... trackReader idx rdr -- ... then attempt to stay in sync. - outcome <- race (trackReaderBlocking idx rdr) act - case outcome of - Left impossible -> impossible - Right t -> pure t + trackReaderBlocking idx rdr where acquireReader :: IO (Reader IO blk (Header blk)) acquireReader = ChainDB.deserialiseReader <$> ChainDB.newHeaderReader cdb rr