DONOTMERGE exploring what EBB removal could ultimately look like in the code

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

@@ -542,6 +542,7 @@ library unstable-cardano-tools
     filepath,
     fs-api ^>=0.3,
     githash,
+    lz4,
     microlens,
     mtl,
     network,

ouroboros-consensus-cardano/src/unstable-cardano-tools/Cardano/Tools/DBAnalyser/Analysis.hs

@@ -25,6 +25,8 @@ module Cardano.Tools.DBAnalyser.Analysis (
   , runAnalysis
   ) where
 
+import qualified Codec.Compression.LZ4 as LZ4
+
 import qualified Cardano.Slotting.Slot as Slotting
 import qualified Cardano.Tools.DBAnalyser.Analysis.BenchmarkLedgerOps.FileWriting as F
 import qualified Cardano.Tools.DBAnalyser.Analysis.BenchmarkLedgerOps.SlotDataPoint as DP
@@ -38,6 +40,7 @@ import           Control.Monad (unless, void, when)
 import           Control.Monad.Except (runExcept)
 import           Control.ResourceRegistry
 import           Control.Tracer (Tracer (..), nullTracer, traceWith)
+import qualified Data.ByteString.Lazy as BL
 import           Data.Int (Int64)
 import           Data.List (intercalate)
 import qualified Data.Map.Strict as Map
@@ -174,11 +177,15 @@ data TraceEvent blk =
     --   * slot number when the block was forged
     --   * cumulative tx output
     --   * count tx output
-  | EbbEvent (HeaderHash blk) (ChainHash blk) Bool
+  | EbbEvent (HeaderHash blk) (ChainHash blk) Bool Int SizeInBytes SizeInBytes SizeInBytes
     -- ^ triggered when EBB block has been found, it holds:
     --   * its hash,
     --   * hash of previous block
     --   * flag whether the EBB is known
+    --   * number of preceding EBBs
+    --   * header size
+    --   * its size
+    --   * its size after LZ4
   | CountedBlocksEvent Int
     -- ^ triggered once during CountBLocks analysis,
     --   when blocks were counted
@@ -233,10 +240,14 @@ instance (HasAnalysis blk, LedgerSupportsProtocol blk) => Show (TraceEvent blk)
     , "cumulative: " <> show cumulative
     , "count: " <> show count
     ]
-  show (EbbEvent ebb previous known)      = intercalate "\t" [
+  show (EbbEvent ebb previous known i hsz sz sz2)      = intercalate "\t" [
       "EBB: "   <> show ebb
     , "Prev: "  <> show previous
     , "Known: " <> show known
+    , "Index: " <> show i
+    , "ByteSizeHeader: " <> show (getSizeInBytes hsz)
+    , "ByteSize: " <> show (getSizeInBytes sz)
+    , "ByteSizeLZ4: " <> show (getSizeInBytes sz2)
     ]
   show (CountedBlocksEvent counted)       = "Counted " <> show counted <> " blocks."
   show (HeaderSizeEvent bn sn hSz bSz)    = intercalate "\t" $ [
@@ -355,20 +366,25 @@ showBlockTxsSize AnalysisEnv { db, registry, startFrom, limit, tracer } = do
 
 showEBBs :: forall blk. HasAnalysis blk => Analysis blk StartFromPoint
 showEBBs AnalysisEnv { db, registry, startFrom, limit, tracer } = do
-    processAll_ db registry GetBlock startFrom limit process
+    _ <- processAll db registry ((,,) <$> GetBlock <*> GetRawBlock <*> GetRawHeader) startFrom limit (0, BL.empty, BL.empty) process
     pure Nothing
   where
-    process :: blk -> IO ()
-    process blk =
+    process :: (Int, BL.ByteString, BL.ByteString) -> (blk, BL.ByteString, BL.ByteString) -> IO (Int, BL.ByteString, BL.ByteString)
+    process (!i, cacc, hacc) (blk, bbytes, hbytes) =
         case blockIsEBB blk of
           Just _epoch -> do
+            let cbytes = maybe undefined BL.fromStrict $ LZ4.compressHC $ BL.toStrict bbytes
             let known =  Map.lookup
                             (blockHash blk)
                             (HasAnalysis.knownEBBs (Proxy @blk))
                        == Just (blockPrevHash blk)
-                event = EbbEvent (blockHash blk) (blockPrevHash blk) known
+                event = EbbEvent (blockHash blk) (blockPrevHash blk) known i (SizeInBytes $ fromIntegral $ BL.length hbytes) (SizeInBytes $ fromIntegral $ BL.length bbytes) (SizeInBytes $ fromIntegral $ BL.length cbytes)
             traceWith tracer event
-          _otherwise -> return () -- Skip regular blocks
+            when (i == 175) $ do
+              BL.writeFile "EbbsHcConcat.bin" (cacc <> cbytes)
+              BL.writeFile "EbbHeadersConcat.bin" (hacc <> hbytes)
+            pure $ (i+1, cacc <> cbytes, hacc <> hbytes)
+          _otherwise -> return (i, cacc, hacc) -- Skip regular blocks
 
 {-------------------------------------------------------------------------------
   Analysis: store a ledger at specific slot

ouroboros-consensus/ouroboros-consensus.cabal

@@ -70,7 +70,6 @@ library
   exposed-modules:
     Ouroboros.Consensus.Block
     Ouroboros.Consensus.Block.Abstract
-    Ouroboros.Consensus.Block.EBB
     Ouroboros.Consensus.Block.Forging
     Ouroboros.Consensus.Block.NestedContent
     Ouroboros.Consensus.Block.RealPoint

ouroboros-consensus/src/ouroboros-consensus/Ouroboros/Consensus/Block.hs

@@ -2,7 +2,6 @@
 module Ouroboros.Consensus.Block (module X) where
 
 import           Ouroboros.Consensus.Block.Abstract as X
-import           Ouroboros.Consensus.Block.EBB as X
 import           Ouroboros.Consensus.Block.Forging as X
 import           Ouroboros.Consensus.Block.NestedContent as X
 import           Ouroboros.Consensus.Block.RealPoint as X

ouroboros-consensus/src/ouroboros-consensus/Ouroboros/Consensus/Block/Abstract.hs

@@ -19,12 +19,9 @@ module Ouroboros.Consensus.Block.Abstract (
     -- * Working with headers
   , GetHeader (..)
   , Header
-  , blockIsEBB
-  , blockToIsEBB
   , getBlockHeaderFields
   , headerHash
   , headerPoint
-  , headerToIsEBB
     -- * Raw hash
   , ConvertRawHash (..)
   , decodeRawHash
@@ -73,10 +70,8 @@ import qualified Data.ByteString as Strict
 import           Data.ByteString.Short (ShortByteString)
 import qualified Data.ByteString.Short as Short
 import           Data.Kind (Type)
-import           Data.Maybe (isJust)
 import           Data.Word (Word32, Word64)
 import           NoThunks.Class (NoThunks)
-import           Ouroboros.Consensus.Block.EBB
 import           Ouroboros.Network.Block (ChainHash (..), HasHeader (..),
                      HeaderFields (..), HeaderHash, Point, StandardHash,
                      blockHash, blockNo, blockPoint, blockSlot, castHash,
@@ -133,19 +128,6 @@ class HasHeader (Header blk) => GetHeader blk where
   -- header matches that of the block.
   blockMatchesHeader :: Header blk -> blk -> Bool
 
-  -- | When the given header is the header of an Epoch Boundary Block, returns
-  -- its epoch number.
-  headerIsEBB        :: Header blk -> Maybe EpochNo
-
-headerToIsEBB :: GetHeader blk => Header blk -> IsEBB
-headerToIsEBB = toIsEBB . isJust . headerIsEBB
-
-blockIsEBB :: GetHeader blk => blk -> Maybe EpochNo
-blockIsEBB = headerIsEBB . getHeader
-
-blockToIsEBB :: GetHeader blk => blk -> IsEBB
-blockToIsEBB = headerToIsEBB . getHeader
-
 type instance BlockProtocol (Header blk) = BlockProtocol blk
 
 {-------------------------------------------------------------------------------

ouroboros-consensus/src/ouroboros-consensus/Ouroboros/Consensus/HardFork/Combinator/Block.hs

@@ -68,12 +68,6 @@ instance CanHardFork xs => GetHeader (HardForkBlock xs) where
       matchesSingle :: GetHeader blk => Product Header I blk -> K Bool blk
       matchesSingle (Pair hdr (I blk)) = K (blockMatchesHeader hdr blk)
 
-  headerIsEBB =
-        hcollapse
-      . hcmap proxySingle (K . headerIsEBB)
-      . getOneEraHeader
-      . getHardForkHeader
-
 {-------------------------------------------------------------------------------
   HasHeader
 -------------------------------------------------------------------------------}
@@ -229,9 +223,6 @@ instance CanHardFork xs => BasicEnvelopeValidation (HardForkBlock xs) where
       case isNonEmpty (Proxy @xs) of
         ProofNonEmpty p _ -> minimumPossibleSlotNo p
 
-  -- TODO: If the block is from a different era as the current tip, we just
-  -- expect @succ b@. This may not be sufficient: if we ever transition /to/
-  -- an era with EBBs, this is not correct.
   expectedNextBlockNo _ (OneEraTipInfo oldTip) (OneEraTipInfo newBlock) b =
       case Match.matchNS oldTip newBlock of
         Right matched  -> hcollapse $ hcmap proxySingle aux matched
@@ -243,20 +234,6 @@ instance CanHardFork xs => BasicEnvelopeValidation (HardForkBlock xs) where
       aux (Pair (WrapTipInfo old) (WrapTipInfo new)) = K $
           expectedNextBlockNo (Proxy @blk) old new b
 
-  -- TODO: If the block is from a different era as the current tip, we just
-  -- expect @succ s@. This may not be sufficient: if we ever transition /to/
-  -- an era with EBBs, this is not correct.
-  minimumNextSlotNo _ (OneEraTipInfo oldTip) (OneEraTipInfo newBlock) s =
-      case Match.matchNS oldTip newBlock of
-        Right matched  -> hcollapse $ hcmap proxySingle aux matched
-        Left _mismatch -> succ s
-    where
-      aux :: forall blk. SingleEraBlock blk
-          => Product WrapTipInfo WrapTipInfo blk
-          -> K SlotNo blk
-      aux (Pair (WrapTipInfo old) (WrapTipInfo new)) = K $
-          minimumNextSlotNo (Proxy @blk) old new s
-
 {-------------------------------------------------------------------------------
   Other instances (primarily for the benefit of tests)
 -------------------------------------------------------------------------------}

ouroboros-consensus/src/ouroboros-consensus/Ouroboros/Consensus/HeaderStateHistory.hs

@@ -103,10 +103,6 @@ cast (HeaderStateHistory history) =
 --
 -- We also return the oldest 'HeaderStateWithTime' that was rewound, if any.
 --
--- NOTE: we don't distinguish headers of regular blocks from headers of EBBs.
--- Whenever we use \"header\" it can be either. In practice, EBB headers do not
--- affect the 'ChainDepState', but they /do/ affect the 'AnnTip'.
---
 -- PRECONDITION: the point to rewind to must correspond to a header (or
 -- 'GenesisPoint') that was previously applied to the header state history.
 --

ouroboros-consensus/src/ouroboros-consensus/Ouroboros/Consensus/HeaderValidation.hs

@@ -44,14 +44,10 @@ module Ouroboros.Consensus.HeaderValidation (
     -- * Errors
   , HeaderError (..)
   , castHeaderError
-    -- * TipInfoIsEBB
-  , TipInfoIsEBB (..)
     -- * Serialization
-  , decodeAnnTipIsEBB
   , decodeHeaderState
   , defaultDecodeAnnTip
   , defaultEncodeAnnTip
-  , encodeAnnTipIsEBB
   , encodeHeaderState
     -- * Type family instances
   , Ticked (..)
@@ -87,9 +83,7 @@ import qualified Ouroboros.Consensus.Util.CBOR as Util.CBOR
 -- | Annotated information about the tip of the chain
 --
 -- The annotation is the additional information we need to validate the
--- header envelope. Under normal circumstances no additional information is
--- required, but for instance for Byron we need to know if the previous header
--- was an EBB.
+-- header envelope.
 data AnnTip blk = AnnTip {
       annTipSlotNo  :: !SlotNo
     , annTipBlockNo :: !BlockNo
@@ -275,13 +269,6 @@ class ( HasHeader (Header blk)
   minimumPossibleSlotNo :: Proxy blk -> SlotNo
   minimumPossibleSlotNo _ = SlotNo 0
 
-  -- | Minimum next slot number
-  minimumNextSlotNo :: proxy blk
-                    -> TipInfo blk -- ^ Old tip
-                    -> TipInfo blk -- ^ New block
-                    -> SlotNo -> SlotNo
-  minimumNextSlotNo _ _ _ = succ
-
 -- | Validate header envelope
 class ( BasicEnvelopeValidation blk
       , GetPrevHash blk
@@ -311,8 +298,8 @@ validateEnvelope :: forall blk. (ValidateEnvelope blk)
 validateEnvelope cfg ledgerView oldTip hdr = do
     unless (actualBlockNo == expectedBlockNo) $
       throwError $ UnexpectedBlockNo expectedBlockNo actualBlockNo
-    unless (actualSlotNo >= expectedSlotNo) $
-      throwError $ UnexpectedSlotNo expectedSlotNo actualSlotNo
+    unless (actualSlotNo >= minimumSlotNo) $
+      throwError $ UnexpectedSlotNo minimumSlotNo actualSlotNo
     unless (checkPrevHash' (annTipHash <$> oldTip) actualPrevHash) $
       throwError $ UnexpectedPrevHash (annTipHash <$> oldTip) actualPrevHash
     validateIfCheckpoint (topLevelConfigCheckpoints cfg) hdr
@@ -334,13 +321,11 @@ validateEnvelope cfg ledgerView oldTip hdr = do
     actualBlockNo  = blockNo        hdr
     actualPrevHash = headerPrevHash hdr
 
-    expectedSlotNo :: SlotNo -- Lower bound only
-    expectedSlotNo =
+    minimumSlotNo :: SlotNo
+    minimumSlotNo =
         case oldTip of
           Origin        -> minimumPossibleSlotNo p
-          NotOrigin tip -> minimumNextSlotNo p (annTipInfo tip)
-                                               (getTipInfo hdr)
-                                               (annTipSlotNo tip)
+          NotOrigin tip -> succ $ annTipSlotNo tip
 
     expectedBlockNo  :: BlockNo
     expectedBlockNo =
@@ -486,19 +471,6 @@ revalidateHeader cfg ledgerView hdr st =
           (untickedHeaderStateTip st)
           hdr
 
-{-------------------------------------------------------------------------------
-  TipInfoIsEBB
--------------------------------------------------------------------------------}
-
--- | Reusable strict data type for 'TipInfo' in case the 'TipInfo' should
--- contain 'IsEBB' in addition to the 'HeaderHash'.
-data TipInfoIsEBB blk = TipInfoIsEBB !(HeaderHash blk) !IsEBB
-  deriving (Generic)
-
-deriving instance StandardHash blk => Eq   (TipInfoIsEBB blk)
-deriving instance StandardHash blk => Show (TipInfoIsEBB blk)
-deriving instance StandardHash blk => NoThunks (TipInfoIsEBB blk)
-
 {-------------------------------------------------------------------------------
   Serialisation
 -------------------------------------------------------------------------------}
@@ -523,36 +495,6 @@ defaultDecodeAnnTip decodeHash = do
     annTipBlockNo <- decode
     return AnnTip{..}
 
-encodeAnnTipIsEBB :: TipInfo blk ~ TipInfoIsEBB blk
-                  => (HeaderHash blk -> Encoding)
-                  -> (AnnTip     blk -> Encoding)
-encodeAnnTipIsEBB encodeHash AnnTip{..} = mconcat [
-      encodeListLen 4
-    , encode     annTipSlotNo
-    , encodeHash hash
-    , encode     annTipBlockNo
-    , encodeInfo isEBB
-    ]
-  where
-    TipInfoIsEBB hash isEBB = annTipInfo
-
-    encodeInfo :: IsEBB -> Encoding
-    encodeInfo = encode
-
-decodeAnnTipIsEBB :: TipInfo blk ~ TipInfoIsEBB blk
-                  => (forall s. Decoder s (HeaderHash blk))
-                  -> (forall s. Decoder s (AnnTip     blk))
-decodeAnnTipIsEBB decodeHash = do
-    enforceSize "AnnTip" 4
-    annTipSlotNo  <- decode
-    hash          <- decodeHash
-    annTipBlockNo <- decode
-    isEBB         <- decodeInfo
-    return AnnTip{annTipInfo = TipInfoIsEBB hash isEBB, ..}
-  where
-    decodeInfo :: forall s. Decoder s IsEBB
-    decodeInfo = decode
-
 encodeHeaderState :: (ChainDepState (BlockProtocol blk) -> Encoding)
                   -> (AnnTip      blk -> Encoding)
                   -> (HeaderState blk -> Encoding)

ouroboros-consensus/src/ouroboros-consensus/Ouroboros/Consensus/Ledger/Basics.hs

@@ -146,7 +146,7 @@ class ( -- Requirements on the ledger state itself
   -- that as soon as a certain slot was reached, /any/ block would be invalid.
   --
   -- PRECONDITION: The slot number must be strictly greater than the slot at
-  -- the tip of the ledger (except for EBBs, obviously..).
+  -- the tip of the ledger.
   --
   -- NOTE: 'applyChainTickLedgerResult' should /not/ change the tip of the
   -- underlying ledger state, which should still refer to the most recent