Skip to content

Commit afa332c

Browse files
kdermekderme
authored
Merge pull request #1872 from IntersectMBO/1870-variant-collateral-txout
1870 - add variant for collateral txout
2 parents e8a00e5 + 1a03fb6 commit afa332c

File tree

16 files changed

+316
-186
lines changed

16 files changed

+316
-186
lines changed

‎cardano-chain-gen/test/Test/Cardano/Db/Mock/Validate.hs

Lines changed: 22 additions & 7 deletions
Original file line numberDiff line numberDiff line change
@@ -45,6 +45,7 @@ module Test.Cardano.Db.Mock.Validate (
4545
import Cardano.Db
4646
import qualified Cardano.Db as DB
4747
import qualified Cardano.Db.Schema.Core.TxOut as C
48+
import qualified Cardano.Db.Schema.Variant.TxOut as V
4849
import qualified Cardano.DbSync.Era.Shelley.Generic as Generic
4950
import Cardano.DbSync.Era.Shelley.Generic.Util
5051
import qualified Cardano.Ledger.Address as Ledger
@@ -417,15 +418,29 @@ assertBabbageCounts env expected =
417418
referenceTxIn <-
418419
maybe 0 unValue . listToMaybe
419420
<$> (select . from $ \(_a :: SqlExpr (Entity ReferenceTxIn)) -> pure countRows)
420-
collTxOut <-
421-
maybe 0 unValue . listToMaybe
422-
<$> (select . from $ \(_a :: SqlExpr (Entity CollateralTxOut)) -> pure countRows)
421+
collTxOut <- case txOutTableTypeFromConfig env of
422+
TxOutCore -> do
423+
maybe 0 unValue . listToMaybe
424+
<$> (select . from $ \(_a :: SqlExpr (Entity C.CollateralTxOut)) -> pure countRows)
425+
TxOutVariantAddress -> do
426+
maybe 0 unValue . listToMaybe
427+
<$> (select . from $ \(_a :: SqlExpr (Entity V.CollateralTxOut)) -> pure countRows)
423428
inlineDatum <-
424-
maybe 0 unValue . listToMaybe
425-
<$> (select . from $ \txOut -> where_ (isJust (txOut ^. C.TxOutInlineDatumId)) >> pure countRows)
429+
case txOutTableTypeFromConfig env of
430+
TxOutCore -> do
431+
maybe 0 unValue . listToMaybe
432+
<$> (select . from $ \txOut -> where_ (isJust (txOut ^. C.TxOutInlineDatumId)) >> pure countRows)
433+
TxOutVariantAddress -> do
434+
maybe 0 unValue . listToMaybe
435+
<$> (select . from $ \txOut -> where_ (isJust (txOut ^. V.TxOutInlineDatumId)) >> pure countRows)
426436
referenceScript <-
427-
maybe 0 unValue . listToMaybe
428-
<$> (select . from $ \txOut -> where_ (isJust (txOut ^. C.TxOutReferenceScriptId)) >> pure countRows)
437+
case txOutTableTypeFromConfig env of
438+
TxOutCore -> do
439+
maybe 0 unValue . listToMaybe
440+
<$> (select . from $ \txOut -> where_ (isJust (txOut ^. C.TxOutReferenceScriptId)) >> pure countRows)
441+
TxOutVariantAddress -> do
442+
maybe 0 unValue . listToMaybe
443+
<$> (select . from $ \txOut -> where_ (isJust (txOut ^. V.TxOutReferenceScriptId)) >> pure countRows)
429444
pure
430445
( scripts
431446
, redeemers

‎cardano-db-sync/src/Cardano/DbSync/Api.hs

Lines changed: 1 addition & 1 deletion
Original file line numberDiff line numberDiff line change
@@ -178,7 +178,7 @@ runExtraMigrationsMaybe :: SyncEnv -> IO ()
178178
runExtraMigrationsMaybe syncEnv = do
179179
let pcm = getPruneConsume syncEnv
180180
txOutTableType = getTxOutTableType syncEnv
181-
logInfo (getTrace syncEnv) $ textShow pcm
181+
logInfo (getTrace syncEnv) $ "runExtraMigrationsMaybe: " <> textShow pcm
182182
DB.runDbIohkNoLogging (envBackend syncEnv) $
183183
DB.runExtraMigrations
184184
(getTrace syncEnv)

‎cardano-db-sync/src/Cardano/DbSync/Era/Byron/Genesis.hs

Lines changed: 1 addition & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -243,6 +243,7 @@ insertTxOutsByron syncEnv disInOut blkId (address, value) = do
243243
, V.txOutReferenceScriptId = Nothing
244244
, V.txOutAddressId = addrDetailId
245245
, V.txOutConsumedByTxId = Nothing
246+
, V.txOutStakeAddressId = Nothing
246247
}
247248

248249
mkVAddress :: ByteString -> V.Address

‎cardano-db-sync/src/Cardano/DbSync/Era/Byron/Insert.hs

Lines changed: 1 addition & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -383,6 +383,7 @@ insertTxOutByron syncEnv _hasConsumed bootStrap txId index txout =
383383
, V.txOutReferenceScriptId = Nothing
384384
, V.txOutTxId = txId
385385
, V.txOutValue = DbLovelace (Byron.unsafeGetLovelace $ Byron.txOutValue txout)
386+
, V.txOutStakeAddressId = Nothing
386387
}
387388

388389
vAddress :: V.Address

‎cardano-db-sync/src/Cardano/DbSync/Era/Shelley/Genesis.hs

Lines changed: 1 addition & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -285,6 +285,7 @@ insertTxOuts syncEnv trce blkId (TxIn txInId _, txOut) = do
285285
, V.txOutReferenceScriptId = Nothing
286286
, V.txOutTxId = txId
287287
, V.txOutValue = Generic.coinToDbLovelace (txOut ^. Core.valueTxOutL)
288+
, V.txOutStakeAddressId = Nothing -- No stake addresses in Shelley Genesis
288289
}
289290

290291
vAddress :: V.Address

‎cardano-db-sync/src/Cardano/DbSync/Era/Universal/Insert/Tx.hs

Lines changed: 49 additions & 23 deletions
Original file line numberDiff line numberDiff line change
@@ -16,13 +16,12 @@ module Cardano.DbSync.Era.Universal.Insert.Tx (
1616
import Cardano.BM.Trace (Trace)
1717
import Cardano.Db (DbLovelace (..), DbWord64 (..))
1818
import qualified Cardano.Db as DB
19-
import Cardano.DbSync.Api
20-
import Cardano.DbSync.Api.Types (InsertOptions (..), SyncEnv (..))
21-
import Cardano.DbSync.Cache.Types (CacheStatus (..))
22-
2319
import qualified Cardano.Db.Schema.Core.TxOut as C
2420
import qualified Cardano.Db.Schema.Variant.TxOut as V
21+
import Cardano.DbSync.Api
22+
import Cardano.DbSync.Api.Types (InsertOptions (..), SyncEnv (..))
2523
import Cardano.DbSync.Cache (queryTxIdWithCache, tryUpdateCacheTx)
24+
import Cardano.DbSync.Cache.Types (CacheStatus (..))
2625
import qualified Cardano.DbSync.Era.Shelley.Generic as Generic
2726
import Cardano.DbSync.Era.Shelley.Generic.Metadata (TxMetadataValue (..), metadataValueToJsonNoSchema)
2827
import Cardano.DbSync.Era.Shelley.Generic.Tx.Types (TxIn (..))
@@ -255,7 +254,7 @@ insertTxOut tracer cache iopts (txId, txHash) (Generic.TxOut index addr value ma
255254
addrId <- lift $ insertAddress addr vAddress
256255
pure $
257256
DB.VTxOutW
258-
(mkTxOutVariant addrId mDatumId mScriptId)
257+
(mkTxOutVariant mSaId addrId mDatumId mScriptId)
259258
Nothing
260259
-- TODO: Unsure about what we should return here for eutxo
261260
let !eutxo =
@@ -271,8 +270,8 @@ insertTxOut tracer cache iopts (txId, txHash) (Generic.TxOut index addr value ma
271270
addrText :: Text
272271
addrText = Generic.renderAddress addr
273272

274-
mkTxOutVariant :: V.AddressId -> Maybe DB.DatumId -> Maybe DB.ScriptId -> V.TxOut
275-
mkTxOutVariant addrId mDatumId mScriptId =
273+
mkTxOutVariant :: Maybe DB.StakeAddressId -> V.AddressId -> Maybe DB.DatumId -> Maybe DB.ScriptId -> V.TxOut
274+
mkTxOutVariant mSaId addrId mDatumId mScriptId =
276275
V.TxOut
277276
{ V.txOutAddressId = addrId
278277
, V.txOutConsumedByTxId = Nothing
@@ -282,6 +281,7 @@ insertTxOut tracer cache iopts (txId, txHash) (Generic.TxOut index addr value ma
282281
, V.txOutReferenceScriptId = mScriptId
283282
, V.txOutTxId = txId
284283
, V.txOutValue = Generic.coinToDbLovelace value
284+
, V.txOutStakeAddressId = mSaId
285285
}
286286

287287
insertAddress ::
@@ -425,25 +425,51 @@ insertCollateralTxOut tracer cache iopts (txId, _txHash) (Generic.TxOut index ad
425425
whenMaybe mScript $
426426
lift . insertScript tracer txId
427427
_ <-
428-
lift
429-
. DB.insertCollateralTxOut
430-
$ DB.CollateralTxOut
431-
{ DB.collateralTxOutTxId = txId
432-
, DB.collateralTxOutIndex = index
433-
, DB.collateralTxOutAddress = Generic.renderAddress addr
434-
, DB.collateralTxOutAddressHasScript = hasScript
435-
, DB.collateralTxOutPaymentCred = Generic.maybePaymentCred addr
436-
, DB.collateralTxOutStakeAddressId = mSaId
437-
, DB.collateralTxOutValue = Generic.coinToDbLovelace value
438-
, DB.collateralTxOutDataHash = Generic.dataHashToBytes <$> Generic.getTxOutDatumHash dt
439-
, DB.collateralTxOutMultiAssetsDescr = textShow maMap
440-
, DB.collateralTxOutInlineDatumId = mDatumId
441-
, DB.collateralTxOutReferenceScriptId = mScriptId
442-
}
428+
case ioTxOutTableType iopts of
429+
DB.TxOutCore -> do
430+
lift
431+
. DB.insertCollateralTxOut
432+
$ DB.CCollateralTxOutW
433+
$ C.CollateralTxOut
434+
{ C.collateralTxOutTxId = txId
435+
, C.collateralTxOutIndex = index
436+
, C.collateralTxOutAddress = Generic.renderAddress addr
437+
, C.collateralTxOutAddressHasScript = hasScript
438+
, C.collateralTxOutPaymentCred = Generic.maybePaymentCred addr
439+
, C.collateralTxOutStakeAddressId = mSaId
440+
, C.collateralTxOutValue = Generic.coinToDbLovelace value
441+
, C.collateralTxOutDataHash = Generic.dataHashToBytes <$> Generic.getTxOutDatumHash dt
442+
, C.collateralTxOutMultiAssetsDescr = textShow maMap
443+
, C.collateralTxOutInlineDatumId = mDatumId
444+
, C.collateralTxOutReferenceScriptId = mScriptId
445+
}
446+
DB.TxOutVariantAddress -> do
447+
let vAddress =
448+
V.Address
449+
{ V.addressAddress = Generic.renderAddress addr
450+
, V.addressRaw = Ledger.serialiseAddr addr
451+
, V.addressHasScript = hasScript
452+
, V.addressPaymentCred = Generic.maybePaymentCred addr
453+
, V.addressStakeAddressId = mSaId
454+
}
455+
addrId <- lift $ insertAddress addr vAddress
456+
lift
457+
. DB.insertCollateralTxOut
458+
$ DB.VCollateralTxOutW
459+
$ V.CollateralTxOut
460+
{ V.collateralTxOutTxId = txId
461+
, V.collateralTxOutIndex = index
462+
, V.collateralTxOutAddressId = addrId
463+
, V.collateralTxOutStakeAddressId = mSaId
464+
, V.collateralTxOutValue = Generic.coinToDbLovelace value
465+
, V.collateralTxOutDataHash = Generic.dataHashToBytes <$> Generic.getTxOutDatumHash dt
466+
, V.collateralTxOutMultiAssetsDescr = textShow maMap
467+
, V.collateralTxOutInlineDatumId = mDatumId
468+
, V.collateralTxOutReferenceScriptId = mScriptId
469+
}
443470
pure ()
444471
where
445472
-- TODO: Is there any reason to add new tables for collateral multi-assets/multi-asset-outputs
446-
447473
hasScript :: Bool
448474
hasScript = maybe False Generic.hasCredScript (Generic.getPaymentCred addr)
449475

‎cardano-db/src/Cardano/Db/Operations/Delete.hs

Lines changed: 9 additions & 9 deletions
Original file line numberDiff line numberDiff line change
@@ -79,7 +79,7 @@ deleteBlocksBlockId trce txOutTableType blockId = do
7979
(cminIds, completed) <- findMinIdsRec mMinIds mempty
8080
mTxId <- queryMinRefId TxBlockId blockId
8181
minIds <- if completed then pure cminIds else completeMinId mTxId cminIds
82-
blockCountInt <- deleteTablesAfterBlockId blockId mTxId minIds
82+
blockCountInt <- deleteTablesAfterBlockId txOutTableType blockId mTxId minIds
8383
pure (mTxId, blockCountInt)
8484
where
8585
findMinIdsRec :: MonadIO m => [Maybe MinIdsWrapper] -> MinIdsWrapper -> ReaderT SqlBackend m (MinIdsWrapper, Bool)
@@ -102,10 +102,8 @@ deleteBlocksBlockId trce txOutTableType blockId = do
102102
CMinIdsWrapper (MinIds m1 m2 m3) -> isJust m1 && isJust m2 && isJust m3
103103
VMinIdsWrapper (MinIds m1 m2 m3) -> isJust m1 && isJust m2 && isJust m3
104104

105-
-- (MinIds m1 m2 m3) isJust m1 && isJust m2 && isJust m3
106-
107-
deleteTablesAfterBlockId :: MonadIO m => BlockId -> Maybe TxId -> MinIdsWrapper -> ReaderT SqlBackend m Int64
108-
deleteTablesAfterBlockId blkId mtxId minIdsW = do
105+
deleteTablesAfterBlockId :: MonadIO m => TxOutTableType -> BlockId -> Maybe TxId -> MinIdsWrapper -> ReaderT SqlBackend m Int64
106+
deleteTablesAfterBlockId txOutTableType blkId mtxId minIdsW = do
109107
deleteWhere [AdaPotsBlockId >=. blkId]
110108
deleteWhere [ReverseIndexBlockId >=. blkId]
111109
deleteWhere [EpochParamBlockId >=. blkId]
@@ -122,11 +120,11 @@ deleteTablesAfterBlockId blkId mtxId minIdsW = do
122120
queryFirstAndDeleteAfter OffChainVoteDataVotingAnchorId vaId
123121
queryFirstAndDeleteAfter OffChainVoteFetchErrorVotingAnchorId vaId
124122
deleteWhere [VotingAnchorId >=. vaId]
125-
deleteTablesAfterTxId mtxId minIdsW
123+
deleteTablesAfterTxId txOutTableType mtxId minIdsW
126124
deleteWhereCount [BlockId >=. blkId]
127125

128-
deleteTablesAfterTxId :: (MonadIO m) => Maybe TxId -> MinIdsWrapper -> ReaderT SqlBackend m ()
129-
deleteTablesAfterTxId mtxId minIdsW = do
126+
deleteTablesAfterTxId :: (MonadIO m) => TxOutTableType -> Maybe TxId -> MinIdsWrapper -> ReaderT SqlBackend m ()
127+
deleteTablesAfterTxId txOutTableType mtxId minIdsW = do
130128
case minIdsW of
131129
CMinIdsWrapper (MinIds mtxInId mtxOutId mmaTxOutId) -> do
132130
whenJust mtxInId $ \txInId -> deleteWhere [TxInId >=. txInId]
@@ -138,7 +136,9 @@ deleteTablesAfterTxId mtxId minIdsW = do
138136
whenJust mmaTxOutId $ \maTxOutId -> deleteWhere [V.MaTxOutId >=. maTxOutId]
139137

140138
whenJust mtxId $ \txId -> do
141-
queryFirstAndDeleteAfter CollateralTxOutTxId txId
139+
case txOutTableType of
140+
TxOutCore -> queryFirstAndDeleteAfter C.CollateralTxOutTxId txId
141+
TxOutVariantAddress -> queryFirstAndDeleteAfter V.CollateralTxOutTxId txId
142142
queryFirstAndDeleteAfter CollateralTxInTxInId txId
143143
queryFirstAndDeleteAfter ReferenceTxInTxInId txId
144144
queryFirstAndDeleteAfter PoolRetireAnnouncedTxId txId

‎cardano-db/src/Cardano/Db/Operations/Insert.hs

Lines changed: 0 additions & 4 deletions
Original file line numberDiff line numberDiff line change
@@ -44,7 +44,6 @@ module Cardano.Db.Operations.Insert (
4444
insertTxIn,
4545
insertManyTxMint,
4646
insertManyTxMetadata,
47-
insertCollateralTxOut,
4847
insertWithdrawal,
4948
insertRedeemer,
5049
insertCostModel,
@@ -298,9 +297,6 @@ insertManyTxMint = insertMany' "TxMint"
298297
insertTxCBOR :: (MonadBaseControl IO m, MonadIO m) => TxCbor -> ReaderT SqlBackend m TxCborId
299298
insertTxCBOR = insertUnchecked "TxCBOR"
300299

301-
insertCollateralTxOut :: (MonadBaseControl IO m, MonadIO m) => CollateralTxOut -> ReaderT SqlBackend m CollateralTxOutId
302-
insertCollateralTxOut = insertUnchecked "CollateralTxOut"
303-
304300
insertWithdrawal :: (MonadBaseControl IO m, MonadIO m) => Withdrawal -> ReaderT SqlBackend m WithdrawalId
305301
insertWithdrawal = insertUnchecked "Withdrawal"
306302

‎cardano-db/src/Cardano/Db/Operations/Other/ConsumedTxOut.hs

Lines changed: 23 additions & 4 deletions
Original file line numberDiff line numberDiff line change
@@ -114,7 +114,7 @@ runExtraMigrations trce txOutTableType blockNoDiff pcm = do
114114
DBExtraMigration "runExtraMigrations: The configuration option 'tx_out.use_address_table' was previously set and the database updated. Unfortunately reverting this isn't possible."
115115
-- Has the user given txout address config && the migration wasn't previously set
116116
when (isTxOutVariant && not isTxOutAddressSet) $ do
117-
updateTxOutAndCreateAddress
117+
updateTxOutAndCreateAddress trce
118118
insertExtraMigration TxOutAddressPreviouslySet
119119
-- first check if pruneTxOut flag is missing and it has previously been used
120120
when (isPruneTxOutPreviouslySet migrationValues && not (pcmPruneTxOut pcm)) $
@@ -407,18 +407,29 @@ createPruneConstraintTxOut = do
407407
exceptHandler e =
408408
liftIO $ throwIO (DBPruneConsumed $ show e)
409409

410+
-- Be very mindfull that these queries can fail silently and make tests fail making it hard to know why.
411+
-- To help mitigate this, logs are printed after each query is ran, so one can know where it stopped.
410412
updateTxOutAndCreateAddress ::
411413
forall m.
412414
( MonadBaseControl IO m
413415
, MonadIO m
414416
) =>
417+
Trace IO Text ->
415418
ReaderT SqlBackend m ()
416-
updateTxOutAndCreateAddress = do
419+
updateTxOutAndCreateAddress trc = do
417420
handle exceptHandler $ rawExecute dropViewsQuery []
421+
liftIO $ logInfo trc "updateTxOutAndCreateAddress: Dropped views"
418422
handle exceptHandler $ rawExecute alterTxOutQuery []
423+
liftIO $ logInfo trc "updateTxOutAndCreateAddress: Altered tx_out"
424+
handle exceptHandler $ rawExecute alterCollateralTxOutQuery []
425+
liftIO $ logInfo trc "updateTxOutAndCreateAddress: Altered collateral_tx_out"
419426
handle exceptHandler $ rawExecute createAddressTableQuery []
427+
liftIO $ logInfo trc "updateTxOutAndCreateAddress: Created address table"
420428
handle exceptHandler $ rawExecute createIndexPaymentCredQuery []
429+
liftIO $ logInfo trc "updateTxOutAndCreateAddress: Created index payment_cred"
421430
handle exceptHandler $ rawExecute createIndexRawQuery []
431+
liftIO $ logInfo trc "updateTxOutAndCreateAddress: Created index raw"
432+
liftIO $ logInfo trc "updateTxOutAndCreateAddress: Completed"
422433
where
423434
dropViewsQuery =
424435
Text.unlines
@@ -432,8 +443,16 @@ updateTxOutAndCreateAddress = do
432443
, " ADD COLUMN \"address_id\" INT8 NOT NULL,"
433444
, " DROP COLUMN \"address\","
434445
, " DROP COLUMN \"address_has_script\","
435-
, " DROP COLUMN \"payment_cred\","
436-
, " DROP COLUMN \"stake_address_id\""
446+
, " DROP COLUMN \"payment_cred\""
447+
]
448+
449+
alterCollateralTxOutQuery =
450+
Text.unlines
451+
[ "ALTER TABLE \"collateral_tx_out\""
452+
, " ADD COLUMN \"address_id\" INT8 NOT NULL,"
453+
, " DROP COLUMN \"address\","
454+
, " DROP COLUMN \"address_has_script\","
455+
, " DROP COLUMN \"payment_cred\""
437456
]
438457

439458
createAddressTableQuery =

‎cardano-db/src/Cardano/Db/Operations/TxOut/TxOutInsert.hs

Lines changed: 11 additions & 1 deletion
Original file line numberDiff line numberDiff line change
@@ -8,7 +8,7 @@
88
module Cardano.Db.Operations.TxOut.TxOutInsert where
99

1010
import Cardano.Db.Operations.Insert (insertMany', insertUnchecked)
11-
import Cardano.Db.Operations.Types (MaTxOutIdW (..), MaTxOutW (..), TxOutIdW (..), TxOutW (..))
11+
import Cardano.Db.Operations.Types (CollateralTxOutIdW (..), CollateralTxOutW (..), MaTxOutIdW (..), MaTxOutW (..), TxOutIdW (..), TxOutW (..))
1212
import qualified Cardano.Db.Schema.Core.TxOut as C
1313
import qualified Cardano.Db.Schema.Variant.TxOut as V
1414
import Control.Monad.IO.Class (MonadIO)
@@ -90,3 +90,13 @@ insertManyMaTxOut maTxOutWs = do
9090
extractVariantMaTxOut :: MaTxOutW -> V.MaTxOut
9191
extractVariantMaTxOut (VMaTxOutW maTxOut) = maTxOut
9292
extractVariantMaTxOut (CMaTxOutW _) = error "Unexpected CMaTxOutW in VariantMaTxOut list"
93+
94+
insertCollateralTxOut :: (MonadBaseControl IO m, MonadIO m) => CollateralTxOutW -> ReaderT SqlBackend m CollateralTxOutIdW
95+
insertCollateralTxOut collateralTxOutW =
96+
case collateralTxOutW of
97+
CCollateralTxOutW txOut -> do
98+
val <- insertUnchecked "CollateralTxOut" txOut
99+
pure $ CCollateralTxOutIdW val
100+
VCollateralTxOutW txOut -> do
101+
val <- insertUnchecked "CollateralTxOut" txOut
102+
pure $ VCollateralTxOutIdW val

0 commit comments

Comments
 (0)