Skip to content
Permalink
Browse files

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
  • Loading branch information...
avieth committed Jul 11, 2019
1 parent 068495a commit c52c4de527168fd68bee30e72b441c5563e96a64
@@ -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,
@@ -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
@@ -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 ()
@@ -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

0 comments on commit c52c4de

Please sign in to comment.
You can’t perform that action at this time.