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 973528717..0d14730bd 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 @@ -54,7 +54,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 @@ -156,11 +156,11 @@ blockHash = blockNumber :: ShelleyBasedEra era => ShelleyBlock era -> BlockNo blockNumber = Shelley.bheaderBlockNo . blockBody -blockPrevHash :: ShelleyBasedEra era => ShelleyBlock era -> ByteString +blockPrevHash :: ShelleyBasedEra era => ShelleyBlock era -> Maybe ByteString blockPrevHash blk = case Shelley.bheaderPrev (Shelley.bhbody . Shelley.bheader $ Consensus.shelleyBlockRaw blk) of - Shelley.GenesisHash -> "Cardano.DbSync.Era.Shelley.Generic.Block.blockPrevHash" - Shelley.BlockHash h -> Crypto.hashToBytes (Shelley.unHashHeader h) + Shelley.GenesisHash -> Nothing + Shelley.BlockHash h -> Just $ Crypto.hashToBytes (Shelley.unHashHeader h) blockOpCert :: ShelleyBasedEra era => ShelleyBlock era -> ByteString blockOpCert = KES.rawSerialiseVerKeyKES . Shelley.ocertVkHot . Shelley.bheaderOCert . blockBody 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 f227ad853..a4c231b2e 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 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 @@ -317,7 +325,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 @@ -334,9 +342,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 when (fromIntegral (Ledger.unCoin $ Shelley._poolPledge params) > maxLovelace) $ liftIO . logWarning tracer $ @@ -379,8 +387,9 @@ insertPoolRegister tracer lStateSnap network (EpochNo epoch) blkId txId idx para 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/Plugin/Default.hs b/cardano-db-sync/src/Cardano/DbSync/Plugin/Default.hs index 1419b382f..7bc8d5eec 100644 --- a/cardano-db-sync/src/Cardano/DbSync/Plugin/Default.hs +++ b/cardano-db-sync/src/Cardano/DbSync/Plugin/Default.hs @@ -8,7 +8,7 @@ module Cardano.DbSync.Plugin.Default ) where -import Cardano.Prelude +import Cardano.Prelude hiding (atomically) import Cardano.BM.Trace (Trace, logDebug, logInfo) @@ -38,7 +38,7 @@ import Cardano.Sync.Plugin import Cardano.Sync.Types import Cardano.Sync.Util -import Control.Monad.Class.MonadSTM.Strict (putTMVar, tryTakeTMVar) +import Control.Monad.Class.MonadSTM.Strict (atomically, tryPutTMVar, tryTakeTMVar) import Control.Monad.Trans.Control (MonadBaseControl) import Control.Monad.Trans.Except.Extra (newExceptT) @@ -179,7 +179,7 @@ stashPoolRewards tracer lenv epoch rmap = do mMirRwd <- liftIO . atomically $ tryTakeTMVar (leMirRewards lenv) case mMirRwd of Nothing -> - liftIO . atomically $ putTMVar (lePoolRewards lenv) (epoch, rmap) + void . liftIO . atomically $ tryPutTMVar (lePoolRewards lenv) (epoch, rmap) Just mirMap -> validateEpochRewards tracer (leNetwork lenv) (epoch - 2) (Map.unionWith plusCoin rmap mirMap) @@ -191,6 +191,6 @@ stashMirRewards tracer lenv mirMap = do mRwds <- liftIO . atomically $ tryTakeTMVar (lePoolRewards lenv) case mRwds of Nothing -> - liftIO . atomically $ putTMVar (leMirRewards lenv) mirMap + void . liftIO . atomically $ tryPutTMVar (leMirRewards lenv) mirMap Just (epoch, rmap) -> validateEpochRewards tracer (leNetwork lenv) (epoch - 2) (Map.unionWith plusCoin rmap mirMap) 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 c37384119..b352e5dda 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 @@ -125,7 +126,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) @@ -337,6 +338,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 212552d9c..02315cbe8 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/Shelley/Generic/Rewards.hs b/cardano-sync/src/Cardano/Sync/Era/Shelley/Generic/Rewards.hs index 87e84b207..fb6805899 100644 --- a/cardano-sync/src/Cardano/Sync/Era/Shelley/Generic/Rewards.hs +++ b/cardano-sync/src/Cardano/Sync/Era/Shelley/Generic/Rewards.hs @@ -109,7 +109,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/schema/migration-2-0024-20210910.sql b/schema/migration-2-0024-20210910.sql new file mode 100644 index 000000000..c5e2ffea9 --- /dev/null +++ b/schema/migration-2-0024-20210910.sql @@ -0,0 +1,23 @@ +-- 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 = 24 THEN + EXECUTE 'ALTER TABLE "redeemer" ADD CONSTRAINT "redeemer_datum_id_fkey" FOREIGN KEY("datum_id") REFERENCES "datum"("id") ON DELETE CASCADE ON UPDATE RESTRICT' ; + 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() ;