Skip to content

Commit

Permalink
progress
Browse files Browse the repository at this point in the history
  • Loading branch information
erikd committed Apr 8, 2021
1 parent eefcfbe commit b4e1d41
Show file tree
Hide file tree
Showing 7 changed files with 194 additions and 148 deletions.
1 change: 1 addition & 0 deletions cardano-db-sync/cardano-db-sync.cabal
Expand Up @@ -50,6 +50,7 @@ library
Cardano.DbSync.Era.Shelley.Generic.Util
Cardano.DbSync.Era.Shelley.Generic.Witness
Cardano.DbSync.Era.Shelley.Insert
Cardano.DbSync.Era.Shelley.Insert.Epoch
Cardano.DbSync.Era.Shelley.Query

Cardano.DbSync.Era.Util
Expand Down
8 changes: 4 additions & 4 deletions cardano-db-sync/src/Cardano/DbSync/Era/Shelley/Insert.hs
Expand Up @@ -147,7 +147,7 @@ renderInsertName eraName =

logMyShit :: Trace IO Text -> LedgerEnv -> IO ()
logMyShit tracer env =
readTVarIO (ruState $ leRewardUpdate env) >>= logInfo tracer . textShow
readTVarIO (ruState $ leEpochUpdate env) >>= logInfo tracer . textShow

-- -----------------------------------------------------------------------------

Expand All @@ -156,14 +156,14 @@ insertOnNewEpoch
=> Trace IO Text -> DB.BlockId -> SlotNo -> EpochNo -> Generic.NewEpoch
-> ExceptT SyncNodeError (ReaderT SqlBackend m) ()
insertOnNewEpoch tracer blkId slotNo epochNo newEpoch = do
whenJust (Generic.epochUpdate newEpoch) $ \esum -> do
whenJust (Generic.neEpochUpdate newEpoch) $ \esum -> do
let stakes = Generic.euStakeDistribution esum

whenJust (Generic.euRewards esum) $ \ grewards ->
insertGenericRewards grewards stakes

insertEpochParam tracer blkId epochNo (Generic.euProtoParams esum) (Generic.euNonce esum)
insertEpochStake tracer epochNo stakes
insertEpochParam tracer blkId epochNo (Generic.neProtoParams newEpoch) (Generic.neNonce newEpoch)
insertEpochStake tracer blkId epochNo stakes

whenJust (Generic.adaPots newEpoch) $ \pots ->
insertPots blkId slotNo epochNo pots
Expand Down
153 changes: 90 additions & 63 deletions cardano-db-sync/src/Cardano/DbSync/Era/Shelley/Insert/Epoch.hs
@@ -1,80 +1,107 @@
{-# LANGUAGE AllowAmbiguousTypes #-}
{-# LANGUAGE DataKinds #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE NoImplicitPrelude #-}
{-# LANGUAGE RankNTypes #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE TypeFamilies #-}
{-# LANGUAGE OverloadedStrings #-}

module Cardano.DbSync.Era.Shelley.Insert.Epoch
( EpochState (..)
, containsUnicodeNul
, safeDecodeUtf8
( epochUpdateThread
) where

import Cardano.Prelude

import Cardano.Api (SerialiseAsCBOR (..))
import Cardano.Api.Shelley (TxMetadataValue (..), makeTransactionMetadata,
metadataValueToJsonNoSchema)
import Cardano.BM.Trace (Trace, logInfo)

import Cardano.BM.Trace (Trace, logDebug, logInfo, logWarning)

import Cardano.Db (DbLovelace (..), DbWord64 (..))

import qualified Cardano.Crypto.Hash as Crypto
-- import Cardano.Db (DbLovelace (..), DbWord64 (..))

import qualified Cardano.Db as DB

import qualified Cardano.DbSync.Era.Shelley.Generic as Generic
import Cardano.DbSync.Era.Shelley.Generic.ParamProposal
import Cardano.DbSync.Era.Shelley.Query
import Cardano.DbSync.Era.Util (liftLookupFail)
-- import Cardano.DbSync.Era.Shelley.Generic.ParamProposal
-- import Cardano.DbSync.Era.Shelley.Query

import Cardano.Sync.Api
import Cardano.Sync.Error
import Cardano.Sync.LedgerState
import Cardano.Sync.Types
-- import Cardano.Sync.Types
import Cardano.Sync.Util

import Cardano.Ledger.Mary.Value (AssetName (..), PolicyID (..), Value (..))

import Cardano.Slotting.Block (BlockNo (..))
import Cardano.Slotting.Slot (EpochNo (..), EpochSize (..), SlotNo (..))

import Control.Monad.Extra (whenJust)
import Control.Monad.Logger (LoggingT)
import Control.Monad.Trans.Control (MonadBaseControl)

import qualified Data.Aeson as Aeson
import qualified Data.ByteString.Char8 as BS
import qualified Data.ByteString.Lazy.Char8 as LBS
import Data.Group (invert)
import Data.List.Split.Internals (chunksOf)
import qualified Data.Map.Strict as Map
import qualified Data.Set as Set
import qualified Data.Text as Text
import qualified Data.Text.Encoding as Text
import qualified Data.Text.Encoding.Error as Text

import Database.Persist.Sql (SqlBackend, putMany)

import Ouroboros.Consensus.Cardano.Block (StandardCrypto)

import qualified Shelley.Spec.Ledger.Address as Shelley
import Shelley.Spec.Ledger.BaseTypes (strictMaybeToMaybe)
import qualified Shelley.Spec.Ledger.BaseTypes as Shelley
import Shelley.Spec.Ledger.Coin (Coin (..))
import qualified Shelley.Spec.Ledger.Coin as Shelley
import qualified Shelley.Spec.Ledger.Credential as Shelley
import qualified Shelley.Spec.Ledger.Keys as Shelley
import qualified Shelley.Spec.Ledger.PParams as Shelley
import qualified Shelley.Spec.Ledger.Rewards as Shelley
import qualified Shelley.Spec.Ledger.TxBody as Shelley

data EpochState
= WaitingForData
| Processing
| WaitingForBoundary
deriving (Eq, Show)

-- import Cardano.Slotting.Block (BlockNo (..))
import Cardano.Slotting.Slot (EpochNo (..))

import Control.Concurrent.STM.TMVar (putTMVar, takeTMVar)
import Control.Concurrent.STM.TVar (writeTVar)
-- import Control.Monad.Extra (whenJust)
-- import Control.Monad.Logger (LoggingT)
-- import Control.Monad.Trans.Control (MonadBaseControl)

-- import qualified Data.Aeson as Aeson
-- import qualified Data.ByteString.Char8 as BS
-- import qualified Data.ByteString.Lazy.Char8 as LBS
-- import Data.Group (invert)
-- import Data.List.Split.Internals (chunksOf)
-- import qualified Data.Map.Strict as Map
-- import qualified Data.Set as Set
-- import qualified Data.Text as Text

import Database.Persist.Sql (SqlBackend)



-- Here we insert data that only changes on epoch boundaries, like epoch rewards
-- and the updated stake distribution. These are calculated 48 hours after the
-- start of the previous epoch. They used to be inserted in the database at
-- the new epoch, but this operation (synchronous) was taking 6 minutes, which
-- is significantly too long.

-- The idea now is to grab the relevant data when it is first calculated, start
-- a database transaction, insert all the data, but only commit the transaction
-- when the epoch rolls over. All the synchronisation is done using `TMVar`s
-- and `TVar`s.

-- This function runs forever in a separate thread and the EpochUpdate data to
-- be inserted is passed via a `TMVar` and another `TMVar` is used to signal the
-- main insert thread of completion.

epochUpdateThread :: Trace IO Text -> LedgerEnv -> SqlBackend -> IO ()
epochUpdateThread tracer env backend =
loop
where
loop :: IO a
loop = do
-- Will block until data arrives.
epochUpdate <- atomically $ takeTMVar (ruInsertDone $ leEpochUpdate env)

liftIO . logInfo tracer $
mconcat
[ "Asynchonously inserting epoch updates for epoch "
, textShow (unEpochNo $ Generic.euEpoch epochUpdate)
]
-- This starts a new database connection and runs the following in a
-- transaction.
DB.runDbAction backend (Just tracer) $ do
-- Insert the data.
insertEpochUpdate tracer epochUpdate

liftIO $ do
-- Signal the main thread that insertion is complete.
atomically $ do
writeTVar (ruState $ leEpochUpdate env) WaitingForEpoch
putTMVar (ruUpdateReady $ leEpochUpdate env) ()

logInfo tracer $
mconcat
[ "Asynchonous insert for epoch "
, textShow (unEpochNo $ Generic.euEpoch epochUpdate)
, " done, waiting for epoch boundary"
]

void . atomically $ takeTMVar (ruCommit $ leEpochUpdate env)
logInfo tracer $
mconcat
[ "Committing insert for epoch "
, textShow (unEpochNo $ Generic.euEpoch epochUpdate)
, " done"
]

loop

insertEpochUpdate :: MonadIO m => Trace IO Text -> Generic.EpochUpdate -> ReaderT SqlBackend m ()
insertEpochUpdate tracer _eu =
liftIO $ logInfo tracer "insertEpochUpdate"
56 changes: 35 additions & 21 deletions cardano-sync/src/Cardano/Sync/Era/Shelley/Generic/EpochUpdate.hs
@@ -1,22 +1,27 @@
{-# LANGUAGE NoImplicitPrelude #-}
module Cardano.Sync.Era.Shelley.Generic.EpochUpdate
( NewEpoch (..)
, EpochUpdate (..)
, AdaPots (..)
, allegraEpochUpdate
, epochUpdate
, maryEpochUpdate
, shelleyEpochUpdate
) where

import Cardano.Prelude

import Cardano.Slotting.Slot (EpochNo (..))

import Cardano.Sync.Era.Shelley.Generic.ProtoParams
import Cardano.Sync.Era.Shelley.Generic.Rewards
import Cardano.Sync.Era.Shelley.Generic.StakeDist
import Cardano.Sync.Types

import Data.Maybe (fromMaybe)

import Ouroboros.Consensus.Block (EpochNo)
import Ouroboros.Consensus.Cardano.Block (LedgerState (..), StandardAllegra, StandardMary,
StandardShelley)
import Ouroboros.Consensus.Cardano.CanHardFork ()
import Ouroboros.Consensus.Ledger.Extended (ExtLedgerState (..))
import Ouroboros.Consensus.Shelley.Ledger.Block (ShelleyBlock)

import qualified Shelley.Spec.Ledger.BaseTypes as Shelley
Expand All @@ -26,14 +31,15 @@ data NewEpoch = NewEpoch
{ epoch :: !EpochNo
, isEBB :: !Bool
, adaPots :: !(Maybe AdaPots)
, epochUpdate :: !(Maybe EpochUpdate)
, neProtoParams :: !ProtoParams
, neNonce :: !Shelley.Nonce
, neEpochUpdate :: !(Maybe EpochUpdate)
}

data EpochUpdate = EpochUpdate
{ euProtoParams :: !ProtoParams
{ euEpoch :: !EpochNo
, euRewards :: !(Maybe Rewards)
, euStakeDistribution :: !StakeDist
, euNonce :: !Shelley.Nonce
}

-- There is a similar type in ledger-spec, but it is not exported yet.
Expand All @@ -46,29 +52,37 @@ data AdaPots = AdaPots
, apFees :: !Coin
}

allegraEpochUpdate :: Shelley.Network -> LedgerState (ShelleyBlock StandardAllegra) -> Maybe Rewards -> Maybe Shelley.Nonce -> EpochUpdate
allegraEpochUpdate network sls mRewards mNonce =
-- Create an EpochUpdate from the current epoch state and the rewards from the last epoch.
epochUpdate :: Shelley.Network -> EpochNo -> ExtLedgerState CardanoBlock -> Maybe Rewards -> Maybe EpochUpdate
epochUpdate nw epochNo els mRewards =
case ledgerState els of
LedgerStateByron _ -> Nothing
LedgerStateShelley sls -> Just $ shelleyEpochUpdate nw epochNo sls mRewards
LedgerStateAllegra als -> Just $ allegraEpochUpdate nw epochNo als mRewards
LedgerStateMary mls -> Just $ maryEpochUpdate nw epochNo mls mRewards



allegraEpochUpdate :: Shelley.Network -> EpochNo -> LedgerState (ShelleyBlock StandardAllegra) -> Maybe Rewards -> EpochUpdate
allegraEpochUpdate nw epochNo als mRewards =
EpochUpdate
{ euProtoParams = allegraProtoParams sls
{ euEpoch = epochNo
, euRewards = mRewards
, euStakeDistribution = allegraStakeDist network sls
, euNonce = fromMaybe Shelley.NeutralNonce mNonce
, euStakeDistribution = allegraStakeDist nw als
}

maryEpochUpdate :: Shelley.Network -> LedgerState (ShelleyBlock StandardMary) -> Maybe Rewards -> Maybe Shelley.Nonce -> EpochUpdate
maryEpochUpdate network sls mRewards mNonce =
maryEpochUpdate :: Shelley.Network -> EpochNo -> LedgerState (ShelleyBlock StandardMary) -> Maybe Rewards -> EpochUpdate
maryEpochUpdate nw epochNo mls mRewards =
EpochUpdate
{ euProtoParams = maryProtoParams sls
{ euEpoch = epochNo
, euRewards = mRewards
, euStakeDistribution = maryStakeDist network sls
, euNonce = fromMaybe Shelley.NeutralNonce mNonce
, euStakeDistribution = maryStakeDist nw mls
}

shelleyEpochUpdate :: Shelley.Network -> LedgerState (ShelleyBlock StandardShelley) -> Maybe Rewards -> Maybe Shelley.Nonce -> EpochUpdate
shelleyEpochUpdate network sls mRewards mNonce =
shelleyEpochUpdate :: Shelley.Network -> EpochNo -> LedgerState (ShelleyBlock StandardShelley) -> Maybe Rewards -> EpochUpdate
shelleyEpochUpdate nw epochNo sls mRewards =
EpochUpdate
{ euProtoParams = shelleyProtoParams sls
{ euEpoch = epochNo
, euRewards = mRewards
, euStakeDistribution = shelleyStakeDist network sls
, euNonce = fromMaybe Shelley.NeutralNonce mNonce
, euStakeDistribution = shelleyStakeDist nw sls
}
19 changes: 17 additions & 2 deletions cardano-sync/src/Cardano/Sync/Era/Shelley/Generic/ProtoParams.hs
@@ -1,6 +1,9 @@
{-# LANGUAGE NoImplicitPrelude #-}
{-# LANGUAGE OverloadedStrings #-}
module Cardano.Sync.Era.Shelley.Generic.ProtoParams
( ProtoParams (..)
, epochProtoParams

, allegraProtoParams
, maryProtoParams
, shelleyProtoParams
Expand All @@ -9,9 +12,11 @@ module Cardano.Sync.Era.Shelley.Generic.ProtoParams
import Cardano.Prelude

import Cardano.Slotting.Slot (EpochNo (..))
import Cardano.Sync.Types

import Ouroboros.Consensus.Cardano.Block (LedgerState (..), StandardAllegra, StandardMary,
StandardShelley)
import Ouroboros.Consensus.Ledger.Extended (ExtLedgerState (..))

import Ouroboros.Consensus.Cardano (Nonce (..))
import Ouroboros.Consensus.Shelley.Ledger.Block (ShelleyBlock)
Expand All @@ -23,6 +28,7 @@ import qualified Shelley.Spec.Ledger.LedgerState as Shelley
import Shelley.Spec.Ledger.PParams (ProtVer)
import qualified Shelley.Spec.Ledger.PParams as Shelley


data ProtoParams = ProtoParams
{ ppMinfeeA :: !Natural
, ppMinfeeB :: !Natural
Expand All @@ -43,6 +49,17 @@ data ProtoParams = ProtoParams
, ppMinPoolCost :: !Coin
}


epochProtoParams :: ExtLedgerState CardanoBlock -> ProtoParams
epochProtoParams lstate =
case ledgerState lstate of
LedgerStateByron _ -> panic "epochProtoParams: Unexpected Byron era"
LedgerStateShelley sls -> shelleyProtoParams sls
LedgerStateAllegra als -> allegraProtoParams als
LedgerStateMary mls -> maryProtoParams mls

-- -------------------------------------------------------------------------------------------------

allegraProtoParams :: LedgerState (ShelleyBlock StandardAllegra) -> ProtoParams
allegraProtoParams =
toProtoParams . Shelley.esPp . Shelley.nesEs . Consensus.shelleyLedgerState
Expand All @@ -55,8 +72,6 @@ shelleyProtoParams :: LedgerState (ShelleyBlock StandardShelley) -> ProtoParams
shelleyProtoParams =
toProtoParams . Shelley.esPp . Shelley.nesEs . Consensus.shelleyLedgerState

-- -------------------------------------------------------------------------------------------------

toProtoParams :: Shelley.PParams' Identity era -> ProtoParams
toProtoParams params =
ProtoParams
Expand Down

0 comments on commit b4e1d41

Please sign in to comment.