diff --git a/.hlint.yaml b/.hlint.yaml index 9543d5534..5ce14167b 100644 --- a/.hlint.yaml +++ b/.hlint.yaml @@ -37,6 +37,7 @@ - {name: [Data.Text], as: Text} - {name: [Data.ByteString.Char8], as: BS} - {name: [Data.ByteString.Lazy.Char8], as: LBS} + - {name: [Data.ByteString.Short], as: SBS} # Banned functions - functions: diff --git a/cardano-db-sync/src/Cardano/DbSync/Era/Cardano/Util.hs b/cardano-db-sync/src/Cardano/DbSync/Era/Cardano/Util.hs index 63d24ee40..e355bf5c6 100644 --- a/cardano-db-sync/src/Cardano/DbSync/Era/Cardano/Util.hs +++ b/cardano-db-sync/src/Cardano/DbSync/Era/Cardano/Util.hs @@ -5,7 +5,7 @@ module Cardano.DbSync.Era.Cardano.Util import Cardano.Prelude -import qualified Data.ByteString.Short as BSS +import qualified Data.ByteString.Short as SBS import Ouroboros.Consensus.Cardano.Block (CardanoBlock) import qualified Ouroboros.Consensus.HardFork.Combinator as Consensus @@ -16,5 +16,5 @@ unChainHash :: ChainHash (CardanoBlock era) -> ByteString unChainHash ch = case ch of GenesisHash -> "genesis" - BlockHash bh -> BSS.fromShort (Consensus.getOneEraHash bh) + BlockHash bh -> SBS.fromShort (Consensus.getOneEraHash bh) diff --git a/cardano-db-sync/src/Cardano/DbSync/Era/Shelley/Generic/Block.hs b/cardano-db-sync/src/Cardano/DbSync/Era/Shelley/Generic/Block.hs index 39281f26b..2d56776fa 100644 --- a/cardano-db-sync/src/Cardano/DbSync/Era/Shelley/Generic/Block.hs +++ b/cardano-db-sync/src/Cardano/DbSync/Era/Shelley/Generic/Block.hs @@ -55,7 +55,7 @@ import qualified Shelley.Spec.Ledger.Tx as Shelley data Block = Block { blkEra :: !BlockEra , blkHash :: !ByteString - , blkPreviousHash :: !ByteString + , blkPreviousHash :: !(Maybe ByteString) -- Nothing is used for first block after Genesis. , blkCreatorPoolHash :: !ByteString , blkSlotLeader :: !ByteString , blkSlotNo :: !SlotNo @@ -157,11 +157,11 @@ blockHash = blockNumber :: ShelleyBasedEra era => ShelleyBlock era -> BlockNo blockNumber = Protocol.bheaderBlockNo . blockBody -blockPrevHash :: ShelleyBasedEra era => ShelleyBlock era -> ByteString +blockPrevHash :: ShelleyBasedEra era => ShelleyBlock era -> Maybe ByteString blockPrevHash blk = case Protocol.bheaderPrev (Protocol.bhbody . Shelley.bheader $ Consensus.shelleyBlockRaw blk) of - Protocol.GenesisHash -> "Cardano.DbSync.Era.Shelley.Generic.Block.blockPrevHash" - Protocol.BlockHash (Protocol.HashHeader h) -> Crypto.hashToBytes h + Protocol.GenesisHash -> Just "Cardano.DbSync.Era.Shelley.Generic.Block.blockPrevHash" + Protocol.BlockHash (Protocol.HashHeader h) -> Just $ Crypto.hashToBytes h blockOpCert :: ShelleyBasedEra era => ShelleyBlock era -> ByteString blockOpCert = KES.rawSerialiseVerKeyKES . Protocol.ocertVkHot . Protocol.bheaderOCert . blockBody diff --git a/cardano-db-sync/src/Cardano/DbSync/Era/Shelley/Generic/Tx.hs b/cardano-db-sync/src/Cardano/DbSync/Era/Shelley/Generic/Tx.hs index 2356fac37..d68c88ada 100644 --- a/cardano-db-sync/src/Cardano/DbSync/Era/Shelley/Generic/Tx.hs +++ b/cardano-db-sync/src/Cardano/DbSync/Era/Shelley/Generic/Tx.hs @@ -69,6 +69,7 @@ import Ouroboros.Consensus.Cardano.Block (StandardAllegra, StandardAlo StandardMary, StandardShelley) import Ouroboros.Consensus.Shelley.Ledger.Block (ShelleyBasedEra) +import qualified Shelley.Spec.Ledger.CompactAddr as Ledger import Shelley.Spec.Ledger.Scripts (ScriptHash) import qualified Shelley.Spec.Ledger.Tx as Shelley import qualified Shelley.Spec.Ledger.TxBody as Shelley @@ -119,6 +120,7 @@ data TxIn = TxIn data TxOut = TxOut { txOutIndex :: !Word16 , txOutAddress :: !(Ledger.Addr StandardCrypto) + , txOutAddressRaw :: !ByteString , txOutAdaValue :: !Coin , txOutMaValue :: !(Map (PolicyID StandardCrypto) (Map AssetName Integer)) , txOutDataHash :: !(Maybe ByteString) @@ -173,14 +175,20 @@ fromAllegraTx (blkIndex, tx) = } where fromTxOut :: Word16 -> Shelley.TxOut StandardAllegra -> TxOut - fromTxOut index (Shelley.TxOut addr ada) = + fromTxOut index txOut = TxOut { txOutIndex = index , txOutAddress = addr + , txOutAddressRaw = SBS.fromShort bs , txOutAdaValue = ada , txOutMaValue = mempty -- Allegra does not support Multi-Assets , txOutDataHash = mempty -- Allegra does not support scripts } + where + Shelley.TxOutCompact (Ledger.UnsafeCompactAddr bs) _ = txOut + -- This pattern match also does the deserialisation of the address + Shelley.TxOut addr ada = txOut + txMeta :: Shelley.Tx StandardAllegra -> Maybe (ShelleyMa.AuxiliaryData StandardAllegra) txMeta (Shelley.Tx _body _wit md) = strictMaybeToMaybe md @@ -243,14 +251,19 @@ fromShelleyTx (blkIndex, tx) = } where fromTxOut :: Word16 -> Shelley.TxOut StandardShelley -> TxOut - fromTxOut index (Shelley.TxOut addr ada) = + fromTxOut index txOut = TxOut { txOutIndex = index , txOutAddress = addr + , txOutAddressRaw = SBS.fromShort bs , txOutAdaValue = ada , txOutMaValue = mempty -- Shelley does not support Multi-Assets , txOutDataHash = mempty -- Shelley does not support scripts } + where + Shelley.TxOutCompact (Ledger.UnsafeCompactAddr bs) _ = txOut + -- This pattern match also does the deserialisation of the address + Shelley.TxOut addr ada = txOut txOutValue :: Shelley.TxOut StandardShelley -> Integer txOutValue (Shelley.TxOut _ (Coin coin)) = coin @@ -284,14 +297,19 @@ fromMaryTx (blkIndex, tx) = } where fromTxOut :: Word16 -> Shelley.TxOut StandardMary -> TxOut - fromTxOut index (Shelley.TxOut addr (Value ada maMap)) = + fromTxOut index txOut = TxOut { txOutIndex = index , txOutAddress = addr + , txOutAddressRaw = SBS.fromShort bs , txOutAdaValue = Coin ada , txOutMaValue = maMap , txOutDataHash = mempty -- Mary does not support scripts } + where + Shelley.TxOutCompact (Ledger.UnsafeCompactAddr bs) _ = txOut + -- This pattern match also does the deserialisation of the address + Shelley.TxOut addr (Value ada maMap) = txOut txMeta :: Shelley.Tx StandardMary -> Maybe (ShelleyMa.AuxiliaryData StandardMary) txMeta (Shelley.Tx _body _wit md) = strictMaybeToMaybe md @@ -358,14 +376,22 @@ fromAlonzoTx pp (blkIndex, tx) = } where fromTxOut :: Word16 -> Alonzo.TxOut StandardAlonzo -> TxOut - fromTxOut index (Alonzo.TxOut addr (Value ada maMap) mDataHash) = + fromTxOut index txOut = TxOut { txOutIndex = index , txOutAddress = addr + , txOutAddressRaw = SBS.fromShort caddr , txOutAdaValue = Coin ada , txOutMaValue = maMap , txOutDataHash = getDataHash <$> strictMaybeToMaybe mDataHash } + where + caddr = case txOut of + Alonzo.TxOutCompact (Ledger.UnsafeCompactAddr bs) _-> bs + Alonzo.TxOutCompactDH (Ledger.UnsafeCompactAddr bs) _ _-> bs + -- This pattern match also does the deserialisation of the address + Alonzo.TxOut addr (Value ada maMap) mDataHash = txOut + txBody :: Ledger.TxBody StandardAlonzo txBody = getField @"body" tx diff --git a/cardano-db-sync/src/Cardano/DbSync/Era/Shelley/Genesis.hs b/cardano-db-sync/src/Cardano/DbSync/Era/Shelley/Genesis.hs index 184ce6f07..a4bee8962 100644 --- a/cardano-db-sync/src/Cardano/DbSync/Era/Shelley/Genesis.hs +++ b/cardano-db-sync/src/Cardano/DbSync/Era/Shelley/Genesis.hs @@ -23,12 +23,14 @@ import Control.Monad.Trans.Except.Extra (newExceptT) import qualified Cardano.Db as DB import qualified Cardano.DbSync.Era.Shelley.Generic.Util as Generic +import Cardano.DbSync.Era.Shelley.Insert import Cardano.DbSync.Era.Util (liftLookupFail) import Cardano.Sync.Error import Cardano.Sync.Util import qualified Cardano.Ledger.Address as Ledger import qualified Cardano.Ledger.Coin as Ledger +import Cardano.Ledger.Credential (Credential (KeyHashObj)) import Cardano.Ledger.Era (Crypto) import qualified Data.ByteString.Char8 as BS @@ -40,7 +42,8 @@ import qualified Data.Time.Clock as Time import Database.Persist.Sql (SqlBackend) import Ouroboros.Consensus.Cardano.Block (StandardCrypto, StandardShelley) -import Ouroboros.Consensus.Shelley.Node (ShelleyGenesis (..)) +import Ouroboros.Consensus.Shelley.Node (ShelleyGenesis (..), ShelleyGenesisStaking (..), + emptyGenesisStaking) import qualified Shelley.Spec.Ledger.Genesis as Shelley import Shelley.Spec.Ledger.Scripts () @@ -59,17 +62,23 @@ insertValidateGenesisDist backend tracer networkName cfg = do then newExceptT $ DB.runDbIohkLogging backend tracer insertAction else newExceptT $ DB.runDbIohkNoLogging backend insertAction where + hasInitialFunds :: Bool + hasInitialFunds = not $ Map.null $ sgInitialFunds cfg + + hasStakes :: Bool + hasStakes = sgStaking cfg /= emptyGenesisStaking + insertAction :: (MonadBaseControl IO m, MonadIO m) => ReaderT SqlBackend m (Either SyncNodeError ()) insertAction = do ebid <- DB.queryBlockId (configGenesisHash cfg) case ebid of - Right bid -> validateGenesisDistribution tracer networkName cfg bid + Right bid -> validateGenesisDistribution tracer networkName cfg bid hasStakes Left _ -> runExceptT $ do liftIO $ logInfo tracer "Inserting Shelley Genesis distribution" emeta <- lift DB.queryMeta case emeta of - Right _ -> pure () -- Metadata from Byron era already exists. TODO Validate metadata. + Right _ -> pure () -- Metadata from Shelley era already exists. TODO Validate metadata. Left _ -> do count <- lift DB.queryBlockCount when (count > 0) $ @@ -79,6 +88,8 @@ insertValidateGenesisDist backend tracer networkName cfg = do { DB.metaStartTime = configStartTime cfg , DB.metaNetworkName = networkName } + -- No reason to insert the artificial block if there are no funds or stakes definitions. + when (hasInitialFunds || hasStakes) $ do -- Insert an 'artificial' Genesis block (with a genesis specific slot leader). We -- need this block to attach the genesis distribution transactions to. -- It would be nice to not need this artificial block, but that would @@ -90,6 +101,13 @@ insertValidateGenesisDist backend tracer networkName cfg = do , DB.slotLeaderPoolHashId = Nothing , DB.slotLeaderDescription = "Shelley Genesis slot leader" } + -- We attach the Genesis Shelley Block after the block with the biggest Slot. + -- In most cases this will simply be the Genesis Byron artificial Block, + -- since this configuration is used for networks which start from Shelley. + -- This means the previous block will have two blocks after it, resulting in a + -- tree format, which is unavoidable. + pid <- lift DB.queryLatestBlockId + liftIO $ logInfo tracer $ textShow pid bid <- lift . DB.insertBlock $ DB.Block { DB.blockHash = configGenesisHash cfg @@ -97,7 +115,7 @@ insertValidateGenesisDist backend tracer networkName cfg = do , DB.blockSlotNo = Nothing , DB.blockEpochSlotNo = Nothing , DB.blockBlockNo = Nothing - , DB.blockPreviousId = Nothing + , DB.blockPreviousId = pid , DB.blockSlotLeaderId = slid , DB.blockSize = 0 , DB.blockTime = configStartTime cfg @@ -113,16 +131,16 @@ insertValidateGenesisDist backend tracer networkName cfg = do lift $ mapM_ (insertTxOuts bid) $ genesisUtxOs cfg liftIO . logInfo tracer $ "Initial genesis distribution populated. Hash " <> renderByteArray (configGenesisHash cfg) - + insertStaking tracer bid cfg supply <- lift DB.queryTotalSupply liftIO $ logInfo tracer ("Total genesis supply of Ada: " <> DB.renderAda supply) -- | Validate that the initial Genesis distribution in the DB matches the Genesis data. validateGenesisDistribution :: (MonadBaseControl IO m, MonadIO m) - => Trace IO Text -> Text -> ShelleyGenesis StandardShelley -> DB.BlockId + => Trace IO Text -> Text -> ShelleyGenesis StandardShelley -> DB.BlockId -> Bool -> ReaderT SqlBackend m (Either SyncNodeError ()) -validateGenesisDistribution tracer networkName cfg bid = +validateGenesisDistribution tracer networkName cfg bid hasStakeTx = runExceptT $ do liftIO $ logInfo tracer "Validating Genesis distribution" meta <- liftLookupFail "Shelley.validateGenesisDistribution" DB.queryMeta @@ -143,7 +161,7 @@ validateGenesisDistribution tracer networkName cfg bid = ] txCount <- lift $ DB.queryBlockTxCount bid - let expectedTxCount = fromIntegral $length (genesisTxos cfg) + let expectedTxCount = fromIntegral $length (genesisTxos cfg) + if hasStakeTx then 1 else 0 when (txCount /= expectedTxCount) $ dbSyncNodeError $ Text.concat [ "Shelley.validateGenesisDistribution: Expected initial block to have " @@ -151,7 +169,7 @@ validateGenesisDistribution tracer networkName cfg bid = , " but got " , textShow txCount ] - totalSupply <- lift DB.queryGenesisSupply + totalSupply <- lift DB.queryShelleyGenesisSupply let expectedSupply = configGenesisSupply cfg when (expectedSupply /= totalSupply) $ dbSyncNodeError $ Text.concat @@ -160,10 +178,9 @@ validateGenesisDistribution tracer networkName cfg bid = , " but got " , textShow totalSupply ] - supply <- lift DB.queryGenesisSupply liftIO $ do logInfo tracer "Initial genesis distribution present and correct" - logInfo tracer ("Total genesis supply of Ada: " <> DB.renderAda supply) + logInfo tracer ("Total genesis supply of Ada: " <> DB.renderAda totalSupply) -- ----------------------------------------------------------------------------- @@ -188,6 +205,7 @@ insertTxOuts blkId (Shelley.TxIn txInId _, txOut) = do , DB.txValidContract = True , DB.txScriptSize = 0 } + _ <- insertStakeAddressRefIfMissing txId (txOutAddress txOut) void . DB.insertTxOut $ DB.TxOut { DB.txOutTxId = txId @@ -209,13 +227,45 @@ insertTxOuts blkId (Shelley.TxIn txInId _, txOut) = do hasScript addr = maybe False Generic.hasCredScript (Generic.getPaymentCred addr) +-- Insert pools and delegations coming from Genesis. +insertStaking + :: (MonadBaseControl IO m, MonadIO m) + => Trace IO Text + -> DB.BlockId + -> ShelleyGenesis StandardShelley + -> ExceptT SyncNodeError (ReaderT SqlBackend m) () +insertStaking tracer blkId genesis = do + -- All Genesis staking comes from an artifical transaction + -- with a hash generated by hashing the address. + txId <- lift $ DB.insertTx $ + DB.Tx + { DB.txHash = configGenesisStakingHash + , DB.txBlockId = blkId + , DB.txBlockIndex = 0 + , DB.txOutSum = DB.DbLovelace 0 + , DB.txFee = DB.DbLovelace 0 + , DB.txDeposit = 0 + , DB.txSize = 0 + , DB.txInvalidHereafter = Nothing + , DB.txInvalidBefore = Nothing + , DB.txValidContract = True + , DB.txScriptSize = 0 + } + let params = zip [0..] $ Map.elems (sgsPools $ sgStaking genesis) + forM_ params $ uncurry (insertPoolRegister tracer (Left 2) (sgNetworkId genesis) 0 blkId txId) + let stakes = zip [0..] $ Map.toList (sgsStake $ sgStaking genesis) + forM_ stakes $ \(n, (keyStaking, keyPool)) -> insertDelegation tracer (sgNetworkId genesis) 0 0 txId n Nothing (KeyHashObj keyStaking) [] keyPool + -- ----------------------------------------------------------------------------- configGenesisHash :: ShelleyGenesis StandardShelley -> ByteString -configGenesisHash _ = BS.take 28 ("GenesisHash " <> BS.replicate 28 '\0') +configGenesisHash _ = BS.take 32 ("Shelley Genesis Block Hash " <> BS.replicate 32 '\0') genesisHashSlotLeader :: ShelleyGenesis StandardShelley -> ByteString -genesisHashSlotLeader = configGenesisHash +genesisHashSlotLeader _ = BS.take 28 ("Shelley Genesis SlotLeader Hash" <> BS.replicate 28 '\0') + +configGenesisStakingHash :: ByteString +configGenesisStakingHash = BS.take 32 ("Shelley Genesis Staking Tx Hash " <> BS.replicate 32 '\0') configGenesisSupply :: ShelleyGenesis StandardShelley -> DB.Ada configGenesisSupply = diff --git a/cardano-db-sync/src/Cardano/DbSync/Era/Shelley/Insert.hs b/cardano-db-sync/src/Cardano/DbSync/Era/Shelley/Insert.hs index 2da6c5f43..0486c9405 100644 --- a/cardano-db-sync/src/Cardano/DbSync/Era/Shelley/Insert.hs +++ b/cardano-db-sync/src/Cardano/DbSync/Era/Shelley/Insert.hs @@ -12,6 +12,12 @@ module Cardano.DbSync.Era.Shelley.Insert , postEpochRewards , postEpochStake + -- These are exported for data in Shelley Genesis + , insertPoolRegister + , insertDelegation + , insertStakeAddressRefIfMissing + + -- Util , containsUnicodeNul , safeDecodeUtf8 ) where @@ -29,10 +35,10 @@ import qualified Cardano.Crypto.Hash as Crypto import Cardano.Db (DbLovelace (..), DbWord64 (..), SyncState (..)) import qualified Cardano.Db as DB -import Cardano.DbSync.Era import qualified Cardano.DbSync.Era.Shelley.Generic as Generic import Cardano.DbSync.Era.Shelley.Generic.ParamProposal import Cardano.DbSync.Era.Shelley.Insert.Epoch +import Cardano.DbSync.Era.Shelley.Offline import Cardano.DbSync.Era.Shelley.Query import Cardano.DbSync.Era.Util (liftLookupFail, safeDecodeUtf8) @@ -81,7 +87,9 @@ insertShelleyBlock -> ReaderT SqlBackend m (Either SyncNodeError ()) insertShelleyBlock tracer lenv firstBlockOfEpoch blk lStateSnap details = do runExceptT $ do - pbid <- liftLookupFail (renderInsertName (Generic.blkEra blk)) $ DB.queryBlockId (Generic.blkPreviousHash blk) + pbid <- case Generic.blkPreviousHash blk of + Nothing -> liftLookupFail (renderInsertName (Generic.blkEra blk)) DB.queryGenesis -- this is for networks that fork from Byron on epoch 0. + Just pHash -> liftLookupFail (renderInsertName (Generic.blkEra blk)) $ DB.queryBlockId pHash mPhid <- lift $ queryPoolHashId (Generic.blkCreatorPoolHash blk) slid <- lift . DB.insertSlotLeader $ Generic.mkSlotLeader (Generic.blkSlotLeader blk) mPhid @@ -246,14 +254,14 @@ insertTxOut :: (MonadBaseControl IO m, MonadIO m) => Trace IO Text -> DB.TxId -> Generic.TxOut -> ExceptT e (ReaderT SqlBackend m) () -insertTxOut tracer txId (Generic.TxOut index addr value maMap dataHash) = do +insertTxOut tracer txId (Generic.TxOut index addr addrRaw value maMap dataHash) = do mSaId <- lift $ insertStakeAddressRefIfMissing txId addr txOutId <- lift . DB.insertTxOut $ DB.TxOut { DB.txOutTxId = txId , DB.txOutIndex = index , DB.txOutAddress = Generic.renderAddress addr - , DB.txOutAddressRaw = Ledger.serialiseAddr addr + , DB.txOutAddressRaw = addrRaw , DB.txOutAddressHasScript = hasScript , DB.txOutPaymentCred = Generic.maybePaymentCred addr , DB.txOutStakeAddressId = mSaId @@ -320,7 +328,7 @@ insertPoolCert -> ExceptT SyncNodeError (ReaderT SqlBackend m) () insertPoolCert tracer lStateSnap network epoch blkId txId idx pCert = case pCert of - Shelley.RegPool pParams -> insertPoolRegister tracer lStateSnap network epoch blkId txId idx pParams + Shelley.RegPool pParams -> insertPoolRegister tracer (Right lStateSnap) network epoch blkId txId idx pParams Shelley.RetirePool keyHash epochNum -> insertPoolRetire txId epochNum idx keyHash insertDelegCert @@ -337,9 +345,9 @@ insertDelegCert tracer network txId idx ridx epochNo slotNo redeemers dCert = insertPoolRegister :: (MonadBaseControl IO m, MonadIO m) - => Trace IO Text -> LedgerStateSnapshot -> Ledger.Network -> EpochNo -> DB.BlockId -> DB.TxId -> Word16 -> Shelley.PoolParams StandardCrypto + => Trace IO Text -> Either Word64 LedgerStateSnapshot -> Ledger.Network -> EpochNo -> DB.BlockId -> DB.TxId -> Word16 -> Shelley.PoolParams StandardCrypto -> ExceptT SyncNodeError (ReaderT SqlBackend m) () -insertPoolRegister _tracer lStateSnap network (EpochNo epoch) blkId txId idx params = do +insertPoolRegister _tracer mlStateSnap network (EpochNo epoch) blkId txId idx params = do poolHashId <- insertPoolHash (Shelley._poolId params) mdId <- case strictMaybeToMaybe $ Shelley._poolMD params of @@ -367,8 +375,9 @@ insertPoolRegister _tracer lStateSnap network (EpochNo epoch) blkId txId idx par where mkEpochActivationDelay :: MonadIO m => DB.PoolHashId -> ExceptT SyncNodeError (ReaderT SqlBackend m) Word64 - mkEpochActivationDelay poolHashId = - if Set.member (Shelley._poolId params) $ getPoolParams (lssOldState lStateSnap) + mkEpochActivationDelay poolHashId = case mlStateSnap of + Left n -> pure n + Right lStateSnap -> if Set.member (Shelley._poolId params) $ getPoolParams (lssOldState lStateSnap) then pure 3 else do -- if the pool is not registered at the end of the previous block, check for diff --git a/cardano-db-sync/src/Cardano/DbSync/Rollback.hs b/cardano-db-sync/src/Cardano/DbSync/Rollback.hs index 6f1a1a466..7b70cb0d1 100644 --- a/cardano-db-sync/src/Cardano/DbSync/Rollback.hs +++ b/cardano-db-sync/src/Cardano/DbSync/Rollback.hs @@ -7,7 +7,7 @@ module Cardano.DbSync.Rollback ) where import Cardano.Prelude -import qualified Data.ByteString.Short as BSS +import qualified Data.ByteString.Short as SBS import Cardano.BM.Trace (Trace, logInfo) @@ -64,7 +64,7 @@ rollbackToPoint backend trce point = queryBlockId pnt = case getPoint pnt of Origin -> DB.queryGenesis - At blk -> DB.queryBlockId (BSS.fromShort . getOneEraHash $ blockPointHash blk) + At blk -> DB.queryBlockId (SBS.fromShort . getOneEraHash $ blockPointHash blk) -- For testing and debugging. unsafeRollback :: Trace IO Text -> SlotNo -> IO (Either SyncNodeError ()) diff --git a/cardano-db/src/Cardano/Db/Delete.hs b/cardano-db/src/Cardano/Db/Delete.hs index 84b7a146f..2bb771248 100644 --- a/cardano-db/src/Cardano/Db/Delete.hs +++ b/cardano-db/src/Cardano/Db/Delete.hs @@ -10,7 +10,7 @@ import Cardano.Slotting.Slot (SlotNo (..)) import Control.Monad.IO.Class (MonadIO) import Control.Monad.Trans.Reader (ReaderT) -import Database.Persist.Sql (SqlBackend, delete, selectKeysList, (==.)) +import Database.Persist.Sql (SqlBackend, delete, selectKeysList, (!=.), (==.)) import Cardano.Db.Schema @@ -29,7 +29,8 @@ deleteCascadeBlock block = do -- deleted and 'False' if it did not exist. deleteCascadeAfter :: MonadIO m => BlockId -> ReaderT SqlBackend m Bool deleteCascadeAfter bid = do - keys <- selectKeysList [ BlockPreviousId ==. Just bid ] [] + -- Genesis artificial blocks are not deleted (Byron or Shelley) since they have null epoch + keys <- selectKeysList [ BlockPreviousId ==. Just bid, BlockEpochNo !=. Nothing ] [] mapM_ delete keys pure $ not (null keys) diff --git a/cardano-db/src/Cardano/Db/Query.hs b/cardano-db/src/Cardano/Db/Query.hs index d9b5432cb..36957b85d 100644 --- a/cardano-db/src/Cardano/Db/Query.hs +++ b/cardano-db/src/Cardano/Db/Query.hs @@ -23,6 +23,7 @@ module Cardano.Db.Query , queryFeesUpToBlockNo , queryFeesUpToSlotNo , queryGenesisSupply + , queryShelleyGenesisSupply , queryLatestBlock , queryLatestCachedEpochNo , queryLatestEpochNo @@ -127,7 +128,7 @@ queryAddressBalanceAtSlot addr slotNo = do queryGenesis :: MonadIO m => ReaderT SqlBackend m (Either LookupFail BlockId) queryGenesis = do res <- select . from $ \ blk -> do - where_ (isNothing (blk ^. BlockEpochNo)) + where_ (isNothing (blk ^. BlockPreviousId)) pure $ blk ^. BlockId case res of [blk] -> pure $ Right (unValue blk) @@ -339,6 +340,18 @@ queryGenesisSupply = do res <- select . from $ \ (txOut `InnerJoin` tx `InnerJoin` blk) -> do on (tx ^. TxBlockId ==. blk ^. BlockId) on (tx ^. TxId ==. txOut ^. TxOutTxId) + where_ (isNothing $ blk ^. BlockPreviousId) + pure $ sum_ (txOut ^. TxOutValue) + pure $ unValueSumAda (listToMaybe res) + +-- | Return the total Shelley Genesis coin supply. The Shelley Genesis Block +-- is the unique which has a non-null PreviousId, but has null Epoch. +queryShelleyGenesisSupply :: MonadIO m => ReaderT SqlBackend m Ada +queryShelleyGenesisSupply = do + res <- select . from $ \ (txOut `InnerJoin` tx `InnerJoin` blk) -> do + on (tx ^. TxBlockId ==. blk ^. BlockId) + on (tx ^. TxId ==. txOut ^. TxOutTxId) + where_ (isJust $ blk ^. BlockPreviousId) where_ (isNothing $ blk ^. BlockEpochNo) pure $ sum_ (txOut ^. TxOutValue) pure $ unValueSumAda (listToMaybe res) diff --git a/cardano-db/src/Cardano/Db/Schema.hs b/cardano-db/src/Cardano/Db/Schema.hs index fa0b0da43..ab4a79582 100644 --- a/cardano-db/src/Cardano/Db/Schema.hs +++ b/cardano-db/src/Cardano/Db/Schema.hs @@ -414,7 +414,7 @@ share minPoolCost DbLovelace Maybe sqltype=lovelace coinsPerUtxoWord DbLovelace Maybe sqltype=lovelace - costModelsId CostModelsId Maybe + costModelsId CostModelsId Maybe OnDeleteCascade priceMem Double Maybe -- sqltype=rational priceStep Double Maybe -- sqltype=rational maxTxExMem DbWord64 Maybe sqltype=word64type @@ -452,7 +452,7 @@ share nonce ByteString Maybe sqltype=hash32type coinsPerUtxoWord DbLovelace Maybe sqltype=lovelace - costModelsId CostModelsId Maybe + costModelsId CostModelsId Maybe OnDeleteCascade priceMem Double Maybe -- sqltype=rational priceStep Double Maybe -- sqltype=rational maxTxExMem DbWord64 Maybe sqltype=word64type diff --git a/cardano-sync/src/Cardano/Sync/Era/Cardano/Util.hs b/cardano-sync/src/Cardano/Sync/Era/Cardano/Util.hs index aed6c1dac..1cec33b0f 100644 --- a/cardano-sync/src/Cardano/Sync/Era/Cardano/Util.hs +++ b/cardano-sync/src/Cardano/Sync/Era/Cardano/Util.hs @@ -5,7 +5,7 @@ module Cardano.Sync.Era.Cardano.Util import Cardano.Prelude -import qualified Data.ByteString.Short as BSS +import qualified Data.ByteString.Short as SBS import Ouroboros.Consensus.Cardano.Block (CardanoBlock) import qualified Ouroboros.Consensus.HardFork.Combinator as Consensus @@ -17,6 +17,6 @@ unChainHash :: ChainHash (CardanoBlock era) -> ByteString unChainHash ch = case ch of GenesisHash -> "genesis" - BlockHash bh -> BSS.fromShort (Consensus.getOneEraHash bh) + BlockHash bh -> SBS.fromShort (Consensus.getOneEraHash bh) diff --git a/cardano-sync/src/Cardano/Sync/Era/Shelley/Generic/Rewards.hs b/cardano-sync/src/Cardano/Sync/Era/Shelley/Generic/Rewards.hs index aedf39344..d0555b221 100644 --- a/cardano-sync/src/Cardano/Sync/Era/Shelley/Generic/Rewards.hs +++ b/cardano-sync/src/Cardano/Sync/Era/Shelley/Generic/Rewards.hs @@ -114,7 +114,8 @@ genericRewards network era epoch lstate = cleanup :: Map StakeCred (Set Reward) -> Rewards cleanup rmap = Rewards - { rwdEpoch = epoch - 1 -- Epoch in which rewards were earned. + { rwdEpoch = if epoch < 1 then 0 else epoch - 1 -- Epoch in which rewards were earned. + -- The check exists for networks that start at Shelley. , rwdRewards = filterByEra era rmap } diff --git a/cardano-sync/src/Cardano/Sync/LedgerState.hs b/cardano-sync/src/Cardano/Sync/LedgerState.hs index a7a5860e9..62b779811 100644 --- a/cardano-sync/src/Cardano/Sync/LedgerState.hs +++ b/cardano-sync/src/Cardano/Sync/LedgerState.hs @@ -71,7 +71,7 @@ import Control.Monad.Class.MonadSTM.Strict (StrictTMVar, StrictTVar, T import qualified Data.ByteString.Base16 as Base16 import qualified Data.ByteString.Char8 as BS import qualified Data.ByteString.Lazy.Char8 as LBS -import qualified Data.ByteString.Short as BSS +import qualified Data.ByteString.Short as SBS import qualified Data.List as List import qualified Data.Map.Strict as Map import qualified Data.Set as Set @@ -752,7 +752,7 @@ tickThenReapplyCheckHash cfg block lsb = , " but block previous hash is " , renderByteArray (Cardano.unChainHash $ blockPrevHash block) , " and block current hash is " - , renderByteArray (BSS.fromShort . Consensus.getOneEraHash $ blockHash block), "." + , renderByteArray (SBS.fromShort . Consensus.getOneEraHash $ blockHash block), "." ] totalAdaPots @@ -762,7 +762,7 @@ totalAdaPots totalAdaPots = Shelley.totalAdaPotsES . Shelley.nesEs . Consensus.shelleyLedgerState getHeaderHash :: HeaderHash CardanoBlock -> ByteString -getHeaderHash bh = BSS.fromShort (Consensus.getOneEraHash bh) +getHeaderHash bh = SBS.fromShort (Consensus.getOneEraHash bh) -- | This will fail if the state is not a 'LedgerStateAlonzo' getAlonzoPParams :: CardanoLedgerState -> PParams StandardAlonzo diff --git a/doc/schema-management.md b/doc/schema-management.md index 097b9d5e1..91d2905bd 100644 --- a/doc/schema-management.md +++ b/doc/schema-management.md @@ -28,7 +28,8 @@ order them in the correct order for applying to the database. Whenever the Haskell schema definition in `Cardano.Db.Schema` is updated, a schema migration can be generated using the command: ``` -cabal run cardano-db-sync-db-tool -- create-migration --mdir schema/ +export PGPASSFILE=config/pgpass-testnet +cabal run cardano-db-tool -- create-migration --mdir schema/ ``` which will only generate a migration if one is needed. It is usually best to run the test suite (`cabal test cardano-db-sync db` which tests the migrations) first and then generate the migration. diff --git a/schema/migration-2-0025-20211001.sql b/schema/migration-2-0025-20211001.sql new file mode 100644 index 000000000..c906fec63 --- /dev/null +++ b/schema/migration-2-0025-20211001.sql @@ -0,0 +1,22 @@ +-- Persistent generated migration. + +CREATE FUNCTION migrate() RETURNS void AS $$ +DECLARE + next_version int ; +BEGIN + SELECT stage_two + 1 INTO next_version FROM schema_version ; + IF next_version = 25 THEN + EXECUTE 'ALTER TABLE "param_proposal" DROP CONSTRAINT "param_proposal_cost_models_id_fkey"' ; + EXECUTE 'ALTER TABLE "param_proposal" ADD CONSTRAINT "param_proposal_cost_models_id_fkey" FOREIGN KEY("cost_models_id") REFERENCES "cost_models"("id") ON DELETE CASCADE ON UPDATE RESTRICT' ; + EXECUTE 'ALTER TABLE "epoch_param" DROP CONSTRAINT "epoch_param_cost_models_id_fkey"' ; + EXECUTE 'ALTER TABLE "epoch_param" ADD CONSTRAINT "epoch_param_cost_models_id_fkey" FOREIGN KEY("cost_models_id") REFERENCES "cost_models"("id") ON DELETE CASCADE ON UPDATE RESTRICT' ; + -- Hand written SQL statements can be added here. + UPDATE schema_version SET stage_two = next_version ; + RAISE NOTICE 'DB has been migrated to stage_two version %', next_version ; + END IF ; +END ; +$$ LANGUAGE plpgsql ; + +SELECT migrate() ; + +DROP FUNCTION migrate() ;