Merge #1021

1021: Rewrite LedgerDB in-memory representation r=edsko a=edsko I rewrote the in-memory representation of the ledger DB. I just tested it against the Byron proxy running in profiling mode. With the old version of the Ledger DB, the top of the time profile looks like ``` ledgerDbReapply Ouroboros.Storage.LedgerDB.InMemory src/Ouroboros/Storage/LedgerDB/InMemory.hs:361:1-79 15.2 27.9 copyAndFreeze Data.ByteArray.Methods Data/ByteArray/Methods.hs:(237,1)-(240,21) 6.7 1.6 ledgerDbPush Ouroboros.Storage.LedgerDB.InMemory src/Ouroboros/Storage/LedgerDB/InMemory.hs:(332,1)-(356,11) 6.5 21.3 == Cardano.Chain.Common.KeyHash src/Cardano/Chain/Common/KeyHash.hs:31:16-17 4.3 7.0 ref Ouroboros.Storage.LedgerDB.InMemory src/Ouroboros/Storage/LedgerDB/InMemory.hs:(122,1)-(123,17) 4.2 0.0 ``` With the new version: ``` == Cardano.Chain.Common.KeyHash src/Cardano/Chain/Common/KeyHash.hs:31:16-17 29.5 47.3 copyAndFreeze Data.ByteArray.Methods Data/ByteArray/Methods.hs:(237,1)-(240,21) 3.3 1.9 compare Cardano.Chain.Common.KeyHash src/Cardano/Chain/Common/KeyHash.hs:32:16-18 2.9 6.6 lookup Data.Map.Internal Data/Map/Internal.hs:(561,1)-(567,18) 2.8 3.2 deserialiseIncremental Codec.CBOR.Read src/Codec/CBOR/Read.hs:(165,1)-(167,46) 2.8 1.3 ``` where the Ledger DB has disappeared _entirely_ from the profile. That top entry, a whopping 30% of time and 48% of memory allocation spent in `(==)` from `Cardano.Chain.Common.KeyHash` seems like it might benefit from a closer look also! The heap profile with the existing implementation: ![cardano-byron-proxy](https://user-images.githubusercontent.com/935288/64791691-5e83d280-d578-11e9-84bc-bc27186a1905.png) And with the new implementation: ![cardano-byron-proxy](https://user-images.githubusercontent.com/935288/64791703-63e11d00-d578-11e9-8c00-cb3520bd90cc.png) I updated the tests; the hardest part was modifying the tests to figure out which snapshots we store (that makes sense, that is precisely where the new implementation provides weaker guarantees than the old version), and then ran it over 1,000,000 tests, all of which passed. Co-authored-by: Edsko de Vries <[email protected]>
IntersectMBO · Sep 13, 2019 · 2ad7dce · 2ad7dce
2 parents a244d70 + ba0f730
commit 2ad7dce
Show file tree

Hide file tree

Showing 17 changed files with 724 additions and 843 deletions.
diff --git a/ouroboros-consensus/ouroboros-consensus.cabal b/ouroboros-consensus/ouroboros-consensus.cabal
@@ -141,8 +141,6 @@ library
                        Ouroboros.Storage.LedgerDB.Conf
                        Ouroboros.Storage.LedgerDB.DiskPolicy
                        Ouroboros.Storage.LedgerDB.InMemory
-                       Ouroboros.Storage.LedgerDB.MemPolicy
-                       Ouroboros.Storage.LedgerDB.Offsets
                        Ouroboros.Storage.LedgerDB.OnDisk
                        Ouroboros.Storage.Util
                        Ouroboros.Storage.Util.ErrorHandling

diff --git a/ouroboros-consensus/src/Ouroboros/Consensus/Node.hs b/ouroboros-consensus/src/Ouroboros/Consensus/Node.hs
@@ -64,7 +64,7 @@ import qualified Ouroboros.Storage.ChainDB as ChainDB
 import           Ouroboros.Storage.EpochInfo (newEpochInfo)
 import           Ouroboros.Storage.ImmutableDB (ValidationPolicy (..))
 import           Ouroboros.Storage.LedgerDB.DiskPolicy (defaultDiskPolicy)
-import           Ouroboros.Storage.LedgerDB.MemPolicy (defaultMemPolicy)
+import           Ouroboros.Storage.LedgerDB.InMemory (ledgerDbDefaultParams)
 
 -- | Start a node.
 --
@@ -175,7 +175,7 @@ initChainDB tracer registry dbPath cfg initLedger slotLength
       , ChainDB.cdbIsEBB            = \blk -> if nodeIsEBB blk
                                               then Just (blockHash blk)
                                               else Nothing
-      , ChainDB.cdbMemPolicy        = defaultMemPolicy secParam
+      , ChainDB.cdbParamsLgrDB      = ledgerDbDefaultParams secParam
       , ChainDB.cdbNodeConfig       = cfg
       , ChainDB.cdbRegistry         = registry
       , ChainDB.cdbTracer           = tracer

diff --git a/ouroboros-consensus/src/Ouroboros/Consensus/Protocol/Abstract.hs b/ouroboros-consensus/src/Ouroboros/Consensus/Protocol/Abstract.hs
@@ -1,4 +1,5 @@
 {-# LANGUAGE ConstraintKinds            #-}
+{-# LANGUAGE DeriveGeneric              #-}
 {-# LANGUAGE FlexibleContexts           #-}
 {-# LANGUAGE FlexibleInstances          #-}
 {-# LANGUAGE FunctionalDependencies     #-}
@@ -33,6 +34,7 @@ import           Data.Functor.Identity
 import           Data.Kind (Constraint)
 import           Data.Typeable (Typeable)
 import           Data.Word (Word64)
+import           GHC.Generics (Generic)
 
 import           Control.Monad.Class.MonadSay
 
@@ -208,7 +210,7 @@ class ( Show (ChainState    p)
 -- NOTE: This talks about the number of /blocks/ we can roll back, not
 -- the number of /slots/.
 newtype SecurityParam = SecurityParam { maxRollbacks :: Word64 }
-  deriving (Show, Eq)
+  deriving (Show, Eq, Generic)
 
 {-------------------------------------------------------------------------------
   State monad

diff --git a/ouroboros-consensus/src/Ouroboros/Storage/ChainDB/Impl.hs b/ouroboros-consensus/src/Ouroboros/Storage/ChainDB/Impl.hs
@@ -19,7 +19,6 @@ module Ouroboros.Storage.ChainDB.Impl (
   , TraceOpenEvent (..)
   , TraceIteratorEvent (..)
   , LgrDB.TraceLedgerReplayEvent
-  , ReasonInvalid (..)
     -- * Internals for testing purposes
   , openDBInternal
   , Internal (..)

diff --git a/ouroboros-consensus/src/Ouroboros/Storage/ChainDB/Impl/Args.hs b/ouroboros-consensus/src/Ouroboros/Storage/ChainDB/Impl/Args.hs
@@ -69,7 +69,7 @@ data ChainDbArgs m blk = forall h1 h2 h3. ChainDbArgs {
       -- Policy
     , cdbValidation       :: ImmDB.ValidationPolicy
     , cdbBlocksPerFile    :: Int
-    , cdbMemPolicy        :: LgrDB.MemPolicy
+    , cdbParamsLgrDB      :: LgrDB.LedgerDbParams
     , cdbDiskPolicy       :: LgrDB.DiskPolicy m
 
       -- Integration
@@ -160,7 +160,7 @@ fromChainDbArgs ChainDbArgs{..} = (
         , lgrEncodeLedger     = cdbEncodeLedger
         , lgrEncodeChainState = cdbEncodeChainState
         , lgrEncodeHash       = cdbEncodeHash
-        , lgrMemPolicy        = cdbMemPolicy
+        , lgrParams           = cdbParamsLgrDB
         , lgrDiskPolicy       = cdbDiskPolicy
         , lgrGenesis          = cdbGenesis
         , lgrTracer           = contramap TraceLedgerEvent cdbTracer
@@ -206,7 +206,7 @@ toChainDbArgs ImmDB.ImmDbArgs{..}
       -- Policy
     , cdbValidation       = immValidation
     , cdbBlocksPerFile    = volBlocksPerFile
-    , cdbMemPolicy        = lgrMemPolicy
+    , cdbParamsLgrDB      = lgrParams
     , cdbDiskPolicy       = lgrDiskPolicy
       -- Integration
     , cdbNodeConfig       = lgrNodeConfig

diff --git a/ouroboros-consensus/src/Ouroboros/Storage/ChainDB/Impl/ChainSel.hs b/ouroboros-consensus/src/Ouroboros/Storage/ChainDB/Impl/ChainSel.hs
@@ -622,6 +622,8 @@ chainSelection lgrDB tracer cfg varInvalid
 -- 'ChainAndLedger' is a prefix of the given candidate fragment (upto the last
 -- valid block), if that fragment is still preferred ('preferCandidate') over
 -- the current chain, if not, 'Nothing' is returned.
+--
+-- Returns 'Nothing' if this candidate requires a rollback we cannot support.
 validateCandidate
   :: forall m blk.
      ( MonadSTM m
@@ -639,33 +641,32 @@ validateCandidate
 validateCandidate lgrDB tracer cfg varInvalid
                   (ChainAndLedger curChain curLedger) candSuffix =
     LgrDB.validate lgrDB curLedger rollback newBlocks >>= \case
-      LgrDB.InvalidBlockInPrefix e pt -> do
-        addInvalidBlocks (hashesStartingFrom pt)
-        trace (InvalidBlock e pt)
-        trace (InvalidCandidate (_suffix candSuffix) InvalidBlockInPrefix)
+      LgrDB.MaximumRollbackExceeded supported _ -> do
+        trace $ CandidateExceedsRollback {
+            _supportedRollback = supported
+          , _candidateRollback = _rollback candSuffix
+          , _candidate         = _suffix   candSuffix
+          }
         return Nothing
-      LgrDB.PushSuffix (LgrDB.InvalidBlock e pt ledger') -> do
+      LgrDB.RollbackSuccessful (LgrDB.InvalidBlock e pt ledger') -> do
         let lastValid  = castPoint $ LgrDB.currentPoint ledger'
             candidate' = fromMaybe
               (error "cannot rollback to point on fragment") $
               AF.rollback lastValid candidate
         addInvalidBlocks (hashesStartingFrom pt)
         trace (InvalidBlock e pt)
 
-        -- The candidate is now a prefix of the original candidate. We
-        -- already know the candidate is at least as long as the current
-        -- chain (otherwise, we'd be in the 'InvalidBlockInPrefix' case). We
-        -- always prefer longer chains, but the prefix of the candidate
-        -- might be exactly as long as the current chain, in which case we
-        -- must check again whether it is preferred over the current chain.
+        -- The candidate is now a prefix of the original candidate, and might be
+        -- shorter than (or as long as) the current chain. We must check again
+        -- whether it is preferred over the current chain.
         if preferCandidate cfg curChain candidate'
           then do
             trace (ValidCandidate (_suffix candSuffix))
             return $ Just $ mkChainAndLedger candidate' ledger'
           else do
-            trace (InvalidCandidate (_suffix candSuffix) InvalidBlockInSuffix)
+            trace (InvalidCandidate (_suffix candSuffix))
             return Nothing
-      LgrDB.PushSuffix (LgrDB.ValidBlocks ledger') -> do
+      LgrDB.RollbackSuccessful (LgrDB.ValidBlocks ledger') -> do
         trace (ValidCandidate (_suffix candSuffix))
         return $ Just $ mkChainAndLedger candidate ledger'
   where

diff --git a/ouroboros-consensus/src/Ouroboros/Storage/ChainDB/Impl/LgrDB.hs b/ouroboros-consensus/src/Ouroboros/Storage/ChainDB/Impl/LgrDB.hs
@@ -37,11 +37,11 @@ module Ouroboros.Storage.ChainDB.Impl.LgrDB (
     -- * Garbage collect points of previously applied blocks
   , garbageCollectPrevApplied
     -- * Re-exports
-  , MemPolicy
+  , LedgerDbParams(..)
   , DiskPolicy (..)
   , DiskSnapshot
-  , LedgerDB.SwitchResult (..)
   , LedgerDB.PushManyResult (..)
+  , LedgerDB.SwitchResult (..)
   , TraceEvent (..)
   , TraceReplayEvent (..)
   ) where
@@ -90,9 +90,9 @@ import qualified Ouroboros.Storage.Util.ErrorHandling as EH
 
 import           Ouroboros.Storage.LedgerDB.Conf
 import           Ouroboros.Storage.LedgerDB.DiskPolicy (DiskPolicy (..))
-import           Ouroboros.Storage.LedgerDB.InMemory (Apply (..), RefOrVal (..))
+import           Ouroboros.Storage.LedgerDB.InMemory (Apply (..),
+                     LedgerDbParams (..), RefOrVal (..))
 import qualified Ouroboros.Storage.LedgerDB.InMemory as LedgerDB
-import           Ouroboros.Storage.LedgerDB.MemPolicy (MemPolicy)
 import           Ouroboros.Storage.LedgerDB.OnDisk (DiskSnapshot,
                      NextBlock (..), StreamAPI (..), TraceEvent (..),
                      TraceReplayEvent (..))
@@ -143,7 +143,7 @@ data LgrDbArgs m blk = forall h. LgrDbArgs {
     , lgrEncodeLedger     :: LedgerState blk                -> Encoding
     , lgrEncodeChainState :: ChainState (BlockProtocol blk) -> Encoding
     , lgrEncodeHash       :: HeaderHash blk                 -> Encoding
-    , lgrMemPolicy        :: MemPolicy
+    , lgrParams           :: LedgerDbParams
     , lgrDiskPolicy       :: DiskPolicy m
     , lgrGenesis          :: m (ExtLedgerState blk)
     , lgrTracer           :: Tracer m (TraceEvent (Point blk))
@@ -173,7 +173,7 @@ defaultArgs fp = LgrDbArgs {
     , lgrEncodeLedger     = error "no default for lgrEncodeLedger"
     , lgrEncodeChainState = error "no default for lgrEncodeChainState"
     , lgrEncodeHash       = error "no default for lgrEncodeHash"
-    , lgrMemPolicy        = error "no default for lgrMemPolicy"
+    , lgrParams           = error "no default for lgrParams"
     , lgrDiskPolicy       = error "no default for lgrDiskPolicy"
     , lgrGenesis          = error "no default for lgrGenesis"
     , lgrTracer           = nullTracer
@@ -269,7 +269,7 @@ initFromDisk args@LgrDbArgs{..} replayTracer lgrDbConf immDB = wrapFailure args
         lgrHasFS
         (decodeExtLedgerState lgrDecodeLedger lgrDecodeChainState)
         (Block.decodePoint lgrDecodeHash)
-        lgrMemPolicy
+        lgrParams
         lgrDbConf
         (streamAPI immDB)
     return db
@@ -398,11 +398,9 @@ validate LgrDB{..} ledgerDB numRollbacks = \hdrs -> do
     validBlockPoints :: ValidateResult blk
                      -> ([Point blk] -> [Point blk])
     validBlockPoints = \case
-      LedgerDB.PushSuffix (LedgerDB.ValidBlocks _)              -> id
-      LedgerDB.PushSuffix (LedgerDB.InvalidBlock _ lastValid _) ->
-        takeWhile (/= lastValid)
-      LedgerDB.InvalidBlockInPrefix _ lastValid                 ->
-        takeWhile (/= lastValid)
+      LedgerDB.MaximumRollbackExceeded _ _                              -> const []
+      LedgerDB.RollbackSuccessful (LedgerDB.ValidBlocks _)              -> id
+      LedgerDB.RollbackSuccessful (LedgerDB.InvalidBlock _ lastValid _) -> takeWhile (/= lastValid)
 
     addPoints :: [Point blk] -> Set (Point blk)
               -> Set (Point blk)

diff --git a/ouroboros-consensus/src/Ouroboros/Storage/ChainDB/Impl/Types.hs b/ouroboros-consensus/src/Ouroboros/Storage/ChainDB/Impl/Types.hs
@@ -33,13 +33,13 @@ module Ouroboros.Storage.ChainDB.Impl.Types (
   , TraceInitChainSelEvent (..)
   , TraceOpenEvent (..)
   , TraceIteratorEvent (..)
-  , ReasonInvalid (..)
   ) where
 
 import           Data.List.NonEmpty (NonEmpty)
 import           Data.Map.Strict (Map)
 import           Data.Time.Clock (DiffTime)
 import           Data.Typeable (Typeable)
+import           Data.Word
 import           GHC.Generics (Generic)
 
 import           Control.Monad.Class.MonadSTM.Strict
@@ -395,12 +395,21 @@ data TraceValidationEvent blk
 
   | InvalidCandidate
     { _candidate     :: AnchoredFragment (Header blk)
-    , _reasonInvalid :: ReasonInvalid
     }
     -- ^ A candidate chain was invalid.
 
   | ValidCandidate (AnchoredFragment (Header blk))
     -- ^ A candidate chain was valid.
+
+  | CandidateExceedsRollback
+    { _supportedRollback :: Word64
+    , _candidateRollback :: Word64
+    , _candidate         :: AnchoredFragment (Header blk)
+    }
+    -- ^ Candidate required rollback past what LedgerDB supported
+    --
+    -- This should only happen in exceptional circumstances (like after
+    -- disk corruption).
   deriving (Generic)
 
 deriving instance
@@ -413,22 +422,6 @@ deriving instance
   , ProtocolLedgerView          blk
   ) => Show (TraceValidationEvent blk)
 
--- | Why a candidate is invalid.
---
--- Prefix and suffix: when switching to a fork, we roll back @r@ blocks and
--- then apply @n >= r@ blocks. The first @r@ blocks are the prefix and the
--- remaining blocks are the suffix.
---
--- If a block is invalid in the prefix we must reject the candidate.
---
--- If a block is invalid in the suffix, we can trim the candidate to the last
--- block before it. The trimmed candidate is valid iff it is still prefered
--- over the current chain.
-data ReasonInvalid
-  = InvalidBlockInPrefix
-  | InvalidBlockInSuffix
-  deriving (Eq, Show)
-
 data TraceInitChainSelEvent blk
   = InitChainSelValidation (TraceValidationEvent blk)
     -- ^ An event traced during validation performed while performing initial