ChainDB almost up and running

All that's left is to use the existing ByronBlock type
ouroboros-consensus, but one which includes EBBs is still in a branch by
nclarke so we'll have to wait

byron-proxy/byron-proxy.cabal

@@ -84,17 +84,20 @@ executable byron-proxy
                        byron-proxy,
                        bytestring,
                        cardano-binary,
+                       cardano-crypto-wrapper,
                        cardano-ledger,
                        cardano-sl,
                        cardano-sl-binary,
                        cardano-sl-chain,
+                       cardano-sl-crypto,
                        cardano-sl-infra,
                        cardano-sl-util,
                        cborg,
                        containers,
                        contra-tracer,
                        directory,
                        exceptions,
+                       filepath,
                        iohk-monitoring,
                        io-sim-classes,
                        lens,

byron-proxy/src/exec/DB.hs

@@ -2,35 +2,38 @@
 
 module DB
   ( DBConfig (..)
-  , DBTrace (..)
   , withDB
   ) where
 
 import qualified Codec.CBOR.Encoding as CBOR
 import qualified Codec.CBOR.Decoding as CBOR
 
-import Control.Exception (throwIO)
+import Control.Exception (bracket, throwIO)
 import Control.Tracer (Tracer)
+import Data.Time.Clock (secondsToDiffTime)
 import qualified System.Directory (createDirectoryIfMissing)
+import System.FilePath ((</>))
 
 import qualified Cardano.Binary as Binary (fromCBOR, toCBOR)
 import qualified Cardano.Chain.Block as Cardano (HeaderHash)
 import qualified Cardano.Chain.Slotting as Cardano (EpochSlots (..))
 
-import           Ouroboros.Byron.Proxy.Block (Block)
+import           Ouroboros.Byron.Proxy.Block (Block, decodeBlock, encodeBlock, isEBB)
 import           Ouroboros.Byron.Proxy.Index.Types (Index)
-import qualified Ouroboros.Byron.Proxy.Index.Sqlite as Index
-import qualified Ouroboros.Storage.Common as Immutable
-import qualified Ouroboros.Storage.EpochInfo as Immutable
-import qualified Ouroboros.Storage.ImmutableDB.API as Immutable
-import qualified Ouroboros.Storage.ImmutableDB.Impl as Immutable
+import qualified Ouroboros.Byron.Proxy.Index.Sqlite as Sqlite
+import Ouroboros.Consensus.Protocol.Abstract (SecurityParam (..))
+import Ouroboros.Consensus.Util.ThreadRegistry (ThreadRegistry, withThreadRegistry)
 import Ouroboros.Storage.FS.API.Types (MountPoint (..))
-import Ouroboros.Storage.FS.API (HasFS)
-import Ouroboros.Storage.FS.IO (HandleIO, ioHasFS)
-import qualified Ouroboros.Storage.Util.ErrorHandling as FS (exceptions)
-
-data DBTrace where
-  DBWrite :: !SlotNo -> DBTrace
+import Ouroboros.Storage.FS.IO (ioHasFS)
+import Ouroboros.Storage.Common (EpochSize (..))
+import Ouroboros.Storage.ChainDB.API (ChainDB)
+import qualified Ouroboros.Storage.ChainDB.API as ChainDB
+import qualified Ouroboros.Storage.ChainDB.Impl as ChainDB
+import Ouroboros.Storage.ChainDB.Impl.Args (ChainDbArgs (..))
+import Ouroboros.Storage.ImmutableDB.Types (ValidationPolicy (..))
+import Ouroboros.Storage.LedgerDB.DiskPolicy (defaultDiskPolicy)
+import Ouroboros.Storage.LedgerDB.MemPolicy (defaultMemPolicy)
+import qualified Ouroboros.Storage.Util.ErrorHandling as EH
 
 data DBConfig = DBConfig
   { dbFilePath    :: !FilePath
@@ -47,31 +50,60 @@ data DBConfig = DBConfig
 -- The directory at `dbFilePath` will be created if it does not exist.
 withDB
   :: DBConfig
-  -> Tracer IO DBTrace
+  -> Tracer IO (ChainDB.TraceEvent Block)
   -> (Index IO -> ChainDB IO Block -> IO t)
   -> IO t
 withDB dbOptions tracer k = do
   -- The ChainDB/Storage layer will not create a directory for us, we have
   -- to ensure it exists.
   System.Directory.createDirectoryIfMissing True (dbFilePath dbOptions)
-  let fsMountPoint :: MountPoint
-      fsMountPoint = MountPoint (dbFilePath dbOptions)
-      fs :: HasFS IO HandleIO
-      fs = ioHasFS fsMountPoint
-      getEpochSize epoch = pure $ Immutable.EpochSize $
-        fromIntegral (Cardano.unEpochSlots (slotsPerEpoch dbOptions))
-  epochInfo <- Immutable.newEpochInfo getEpochSize
-  let openChainDB = (error "ChainDB.openDB not yet available")
-        decodeHeaderHash
-        encodeHeaderHash
-        fs
-        FS.exceptions
-        epochInfo
-        Immutable.ValidateMostRecentEpoch
-        (DB.epochFileParser (slotsPerEpoch dbOptions) fs)
-      withChainDB = error "withChainDB not yet available"
-  Index.withDB_ (indexFilePath dbOptions) $ \idx ->
-    withChainDB openChainDB $ \idb -> k idx idb
+  let epochSlots = slotsPerEpoch dbOptions
+      epochSize = EpochSize $
+        fromIntegral (Cardano.unEpochSlots epochSlots)
+      fp = dbFilePath dbOptions
+      securityParam = SecurityParam 2600
+      chainDBArgs :: ThreadRegistry IO -> ChainDbArgs IO Block
+      chainDBArgs = \threadRegistry -> ChainDB.ChainDbArgs
+        { cdbDecodeHash = decodeHeaderHash
+        , cdbEncodeHash = encodeHeaderHash
+
+        , cdbDecodeBlock = decodeBlock epochSlots
+        , cdbEncodeBlock = encodeBlock
+
+        , cdbDecodeLedger = undefined
+        , cdbEncodeLedger = undefined
+
+        , cdbDecodeChainState = undefined
+        , cdbEncodeChainState = undefined
+
+        , cdbErrImmDb = EH.exceptions
+        , cdbErrVolDb = EH.exceptions
+        , cdbErrVolDbSTM = EH.throwSTM
+
+        , cdbHasFSImmDb = ioHasFS $ MountPoint (fp </> "immutable")
+        , cdbHasFSVolDb = ioHasFS $ MountPoint (fp </> "volatile")
+        , cdbHasFSLgrDB = ioHasFS $ MountPoint (fp </> "ledger")
+
+        , cdbValidation = ValidateMostRecentEpoch
+        , cdbBlocksPerFile = 26000 -- ?
+        , cdbMemPolicy = defaultMemPolicy securityParam
+        , cdbDiskPolicy = defaultDiskPolicy securityParam (secondsToDiffTime 20)
+
+        , cdbNodeConfig = undefined
+        , cdbEpochSize = const (pure epochSize)
+        , cdbIsEBB = isEBB
+        , cdbGenesis = pure undefined
+
+        , cdbTracer = tracer
+        , cdbThreadRegistry = threadRegistry
+        , cdbGcDelay = secondsToDiffTime 20
+        }
+  withThreadRegistry $ \tr -> k undefined undefined
+    {-
+    bracket (ChainDB.openDB (chainDBArgs tr)) ChainDB.closeDB $ \cdb ->
+      Sqlite.withIndexAuto (indexFilePath dbOptions) $ \idx ->
+        k idx cdb
+    -}
 
 encodeHeaderHash :: Cardano.HeaderHash -> CBOR.Encoding
 encodeHeaderHash = Binary.toCBOR

byron-proxy/src/exec/Main.hs

@@ -23,6 +23,7 @@ import qualified Cardano.BM.Data.LogItem as Monitoring
 import qualified Cardano.BM.Data.Severity as Monitoring
 
 import qualified Cardano.Chain.Slotting as Cardano
+import qualified Cardano.Crypto as Crypto (ProtocolMagicId (..))
 
 import qualified Pos.Chain.Block as CSL (genesisBlock0)
 import qualified Pos.Chain.Lrc as CSL (genesisLeaders)
@@ -33,6 +34,7 @@ import qualified Pos.Chain.Genesis as CSL.Genesis (Config)
 import qualified Pos.Chain.Genesis as CSL (configEpochSlots, configGenesisHash,
                                            configProtocolConstants, configProtocolMagic,
                                            configBlockVersionData)
+import qualified Pos.Crypto as CSL (ProtocolMagicId (..), getProtocolMagicId)
 import qualified Pos.Diffusion.Full as CSL (FullDiffusionConfiguration (..))
 
 import qualified Pos.Infra.Network.CLI as CSL (NetworkConfigOpts (..),
@@ -51,10 +53,14 @@ import qualified Pos.Util.Trace.Named as Trace (LogNamed (..), appendName, named
 import qualified Pos.Util.Trace
 import qualified Pos.Util.Wlog as Wlog
 
-import Ouroboros.Network.Block (SlotNo (..))
-
-import qualified Ouroboros.Byron.Proxy.DB as DB
+import Ouroboros.Byron.Proxy.Block (Block)
+import Ouroboros.Byron.Proxy.Index.Types (Index)
 import Ouroboros.Byron.Proxy.Main
+import Ouroboros.Network.Block (SlotNo (..), Point (..))
+import Ouroboros.Network.Point (WithOrigin (..))
+import qualified Ouroboros.Network.Point as Point (Block (..))
+import Ouroboros.Storage.ChainDB.API (ChainDB)
+import Ouroboros.Storage.ChainDB.Impl.Types (TraceEvent (..), TraceAddBlockEvent (..))
 
 import qualified Byron
 import DB (DBConfig (..), withDB)
@@ -250,9 +256,10 @@ runClient
   -> ClientOptions
   -> CSL.Genesis.Config
   -> Cardano.EpochSlots
-  -> DB.DB IO
+  -> Index IO
+  -> ChainDB IO Block
   -> IO ()
-runClient tracer clientOptions genesisConfig epochSlots db =
+runClient tracer clientOptions genesisConfig epochSlots idx db =
 
   case coByron clientOptions of
 
@@ -273,6 +280,7 @@ runClient tracer clientOptions genesisConfig epochSlots db =
           bpc = ByronProxyConfig
             { bpcAdoptedBVData = CSL.configBlockVersionData genesisConfig
               -- ^ Hopefully that never needs to change.
+            , bpcEpochSlots = epochSlots
             , bpcNetworkConfig = networkConfig
                 { ncEnqueuePolicy = Policy.defaultEnqueuePolicyRelay
                 , ncDequeuePolicy = Policy.defaultDequeuePolicyRelay
@@ -300,7 +308,7 @@ runClient tracer clientOptions genesisConfig epochSlots db =
           genesisBlock = CSL.genesisBlock0 (CSL.configProtocolMagic genesisConfig)
                                            (CSL.configGenesisHash genesisConfig)
                                            (CSL.genesisLeaders genesisConfig)
-      withByronProxy (contramap (\(a, b) -> ("", a, b)) tracer) bpc db $ \bp -> void $
+      withByronProxy (contramap (\(a, b) -> ("", a, b)) tracer) bpc idx db $ \bp -> void $
         concurrently (byronClient genesisBlock bp) shelleyClient
 
   where
@@ -310,8 +318,8 @@ runClient tracer clientOptions genesisConfig epochSlots db =
   byronClient genesisBlock bp = case coShelley clientOptions of
     Nothing -> void $ concurrently
       (Byron.download textTracer genesisBlock epochSlots db bp)
-      (Byron.announce textTracer Nothing                 db bp)
-    Just _  -> Byron.announce textTracer Nothing db bp
+      (Byron.announce Nothing                            db bp)
+    Just _  -> Byron.announce Nothing db bp
 
   shelleyClient = case coShelley clientOptions of
     Nothing -> pure ()
@@ -336,6 +344,12 @@ main = do
         confOpts = bpoCardanoConfigurationOptions bpo
     CSL.withConfigurations infoTrace Nothing Nothing False confOpts $ \genesisConfig _ _ _ -> do
       let epochSlots = Cardano.EpochSlots (fromIntegral (CSL.configEpochSlots genesisConfig))
+          protocolMagic = Crypto.ProtocolMagicId
+            . fromIntegral -- Int32 -> Word32
+            . CSL.unProtocolMagicId
+            . CSL.getProtocolMagicId
+            . CSL.configProtocolMagic
+            $ genesisConfig
           -- Next, set up the database, taking care to seed with the genesis
           -- block if it's empty.
           dbc :: DBConfig
@@ -345,10 +359,23 @@ main = do
             , slotsPerEpoch = epochSlots
             }
           -- Trace DB writes in such a way that they appear in EKG.
-          dbTracer = flip contramap (Logging.convertTrace trace) $ \(DB.DBWrite (SlotNo count)) ->
-            ("db", Monitoring.Info, Monitoring.LogValue "block count" (Monitoring.PureI (fromIntegral count)))
-      withDB dbc dbTracer $ \db -> do
-        let server = Shelley.Server.runServer (bpoServerOptions bpo) epochSlots db
-            client = runClient (Logging.convertTrace' trace) (bpoClientOptions bpo) genesisConfig epochSlots db
+          -- FIXME surprisingly, contra-tracer doesn't give a way to do this.
+          -- It should export
+          --
+          --   Applicative m => (a -> Maybe b) -> Tracer m a -> Tracer m b
+          --
+          -- or similar
+          Tracer doConvertedTrace = Logging.convertTrace trace
+          dbTracer :: Tracer IO (TraceEvent Block)
+          dbTracer = Tracer $ \trEvent -> case trEvent of
+            TraceAddBlockEvent (AddedBlockToVolDB point) -> case point of
+              Point Origin -> pure ()
+              Point (At (Point.Block (SlotNo slotno) _)) ->
+                let val = ("db", Monitoring.Info, Monitoring.LogValue "block count" (Monitoring.PureI (fromIntegral slotno)))
+                in  doConvertedTrace val
+            _ -> pure ()
+      withDB dbc dbTracer $ \idx cdb -> do
+        let server = Shelley.Server.runServer (bpoServerOptions bpo) epochSlots cdb
+            client = runClient (Logging.convertTrace' trace) (bpoClientOptions bpo) genesisConfig epochSlots idx cdb
         _ <- concurrently server client
         pure ()

byron-proxy/src/lib/Ouroboros/Byron/Proxy/Block.hs

@@ -13,6 +13,7 @@ module Ouroboros.Byron.Proxy.Block
   , toSerializedBlock
   , coerceHashFromLegacy
   , coerceHashToLegacy
+  , isEBB
   ) where
 
 import qualified Codec.CBOR.Decoding as CBOR
@@ -116,3 +117,8 @@ coerceHashToLegacy (AbstractHash digest) = Legacy.AbstractHash digest
 
 coerceHashFromLegacy :: CSL.HeaderHash -> Cardano.HeaderHash
 coerceHashFromLegacy (Legacy.AbstractHash digest) = AbstractHash digest
+
+isEBB :: Block -> Maybe Cardano.HeaderHash
+isEBB blk = case Binary.unAnnotated (getBlock blk) of
+  Cardano.ABOBBlock _    -> Nothing
+  Cardano.ABOBBoundary b -> Just $ headerHashOfBlock blk