Skip to content

Commit

Permalink
Delete Cascade Migration
Browse files Browse the repository at this point in the history 
Closes: #397
Closes: #256
  • Loading branch information
@kderme @erikd
kderme authored and erikd committed Jan 5, 2021
1 parent 5fa2552 commit 1227676
Show file tree
Hide file tree
Showing 4 changed files with 139 additions and 46 deletions.
8 changes: 4 additions & 4 deletions cardano-db/src/Cardano/Db/Delete.hs
View file
Original file line number Diff line number Diff line change
Expand Up @@ -9,7 +9,7 @@ import Cardano.Slotting.Slot (SlotNo (..))
import Control.Monad.IO.Class (MonadIO)
import Control.Monad.Trans.Reader (ReaderT)

import Database.Persist.Sql (SqlBackend, deleteCascade, selectKeysList, (==.))
import Database.Persist.Sql (SqlBackend, delete, selectKeysList, (==.))

import Cardano.Db.Schema

Expand All @@ -21,22 +21,22 @@ import Ouroboros.Network.Block (BlockNo (..))
deleteCascadeBlock :: MonadIO m => Block -> ReaderT SqlBackend m Bool
deleteCascadeBlock block = do
keys <- selectKeysList [ BlockHash ==. blockHash block ] []
mapM_ deleteCascade keys
mapM_ delete keys
pure $ not (null keys)

-- | Delete a block if it exists. Returns 'True' if it did exist and has been
-- deleted and 'False' if it did not exist.
deleteCascadeBlockNo :: MonadIO m => BlockNo -> ReaderT SqlBackend m Bool
deleteCascadeBlockNo (BlockNo blockNo) = do
keys <- selectKeysList [ BlockBlockNo ==. Just blockNo ] []
mapM_ deleteCascade keys
mapM_ delete keys
pure $ not (null keys)

-- | Delete a block if it exists. Returns 'True' if it did exist and has been
-- deleted and 'False' if it did not exist.
deleteCascadeSlotNo :: MonadIO m => SlotNo -> ReaderT SqlBackend m Bool
deleteCascadeSlotNo (SlotNo slotNo) = do
keys <- selectKeysList [ BlockSlotNo ==. Just slotNo ] []
mapM_ deleteCascade keys
mapM_ delete keys
pure $ not (null keys)

79 changes: 39 additions & 40 deletions cardano-db/src/Cardano/Db/Schema.hs
View file
Original file line number Diff line number Diff line change
Expand Up @@ -41,7 +41,6 @@ import Database.Persist.TH

share
[ mkPersist sqlSettings
, mkDeleteCascade sqlSettings
, mkMigrate "migrateCardanoDb"
]
[persistLowerCase|
Expand All @@ -64,8 +63,8 @@ share

SlotLeader
hash ByteString sqltype=hash28type
poolHashId PoolHashId Maybe -- This will be non-null when a block is mined by a pool.
description Text -- Description of the Slots leader.
poolHashId PoolHashId Maybe OnDeleteCascade -- This will be non-null when a block is mined by a pool.
description Text -- Description of the Slots leader.
UniqueSlotLeader hash

-- Each table has autogenerated primary key named 'id', the Haskell type
Expand All @@ -80,11 +79,11 @@ share
slotNo Word64 Maybe sqltype=uinteger
epochSlotNo Word64 Maybe sqltype=uinteger
blockNo Word64 Maybe sqltype=uinteger
previousId BlockId Maybe
previousId BlockId Maybe OnDeleteCascade
-- Shelley does not have a Merkel Root, but Byron does.
-- Once we are well into the Shelley era, this column can be dropped.
merkelRoot ByteString Maybe sqltype=hash32type
slotLeaderId SlotLeaderId
slotLeaderId SlotLeaderId OnDeleteCascade
size Word64 sqltype=uinteger
time UTCTime sqltype=timestamp
txCount Word64
Expand All @@ -97,7 +96,7 @@ share

Tx
hash ByteString sqltype=hash32type
blockId BlockId -- This type is the primary key for the 'block' table.
blockId BlockId OnDeleteCascade -- This type is the primary key for the 'block' table.
blockIndex Word64 sqltype=uinteger -- The index of this transaction within the block.
outSum DbLovelace sqltype=lovelace
fee DbLovelace sqltype=lovelace
Expand All @@ -112,22 +111,22 @@ share
StakeAddress -- Can be an address of a script hash
hashRaw ByteString sqltype=addr29type
view Text
registeredTxId TxId -- Only used for rollback.
registeredTxId TxId OnDeleteCascade -- Only used for rollback.
UniqueStakeAddress hashRaw

TxOut
txId TxId -- This type is the primary key for the 'tx' table.
txId TxId OnDeleteCascade -- This type is the primary key for the 'tx' table.
index Word16 sqltype=txindex
address Text
addressRaw ByteString
paymentCred ByteString Maybe sqltype=hash28type
stakeAddressId StakeAddressId Maybe
stakeAddressId StakeAddressId Maybe OnDeleteCascade
value DbLovelace sqltype=lovelace
UniqueTxout txId index -- The (tx_id, index) pair must be unique.

TxIn
txInId TxId -- The transaction where this is used as an input.
txOutId TxId -- The transaction where this was created as an output.
txInId TxId OnDeleteCascade -- The transaction where this is used as an input.
txOutId TxId OnDeleteCascade -- The transaction where this was created as an output.
txOutIndex Word16 sqltype=txindex
UniqueTxin txOutId txOutIndex

Expand Down Expand Up @@ -167,37 +166,37 @@ share
PoolMetaData
url Text
hash ByteString sqltype=hash32type
registeredTxId TxId -- Only used for rollback.
registeredTxId TxId OnDeleteCascade -- Only used for rollback.
UniquePoolMetaData url hash

PoolUpdate
hashId PoolHashId
hashId PoolHashId OnDeleteCascade
certIndex Word16
vrfKeyHash ByteString sqltype=hash32type
pledge DbLovelace sqltype=lovelace
rewardAddr ByteString sqltype=addr29type
activeEpochNo Word64
metaId PoolMetaDataId Maybe
metaId PoolMetaDataId Maybe OnDeleteCascade
margin Double -- sqltype=percentage????
fixedCost DbLovelace sqltype=lovelace
registeredTxId TxId -- Slot number in which the pool was registered.
registeredTxId TxId OnDeleteCascade -- Slot number in which the pool was registered.
UniquePoolUpdate hashId registeredTxId

PoolOwner
hash ByteString sqltype=hash28type
poolHashId PoolHashId
registeredTxId TxId -- Slot number in which the owner was registered.
poolHashId PoolHashId OnDeleteCascade
registeredTxId TxId OnDeleteCascade -- Slot number in which the owner was registered.
UniquePoolOwner hash poolHashId registeredTxId

PoolRetire
hashId PoolHashId
hashId PoolHashId OnDeleteCascade
certIndex Word16
announcedTxId TxId -- Slot number in which the pool announced it was retiring.
announcedTxId TxId OnDeleteCascade -- Slot number in which the pool announced it was retiring.
retiringEpoch Word64 sqltype=uinteger -- Epoch number in which the pool will retire.
UniquePoolRetiring hashId announcedTxId

PoolRelay
updateId PoolUpdateId
updateId PoolUpdateId OnDeleteCascade
ipv4 Text Maybe
ipv6 Text Maybe
dnsName Text Maybe
Expand All @@ -212,47 +211,47 @@ share
-- -----------------------------------------------------------------------------------------------

Reserve
addrId StakeAddressId
addrId StakeAddressId OnDeleteCascade
certIndex Word16
-- poolId PoolHashId
amount DbLovelace sqltype=lovelace
txId TxId
txId TxId OnDeleteCascade
UniqueReserves addrId txId

Withdrawal
addrId StakeAddressId
addrId StakeAddressId OnDeleteCascade
-- poolId PoolHashId
amount DbLovelace sqltype=lovelace
txId TxId
txId TxId OnDeleteCascade
UniqueWithdrawal addrId txId

Delegation
addrId StakeAddressId
addrId StakeAddressId OnDeleteCascade
certIndex Word16
poolHashId PoolHashId
poolHashId PoolHashId OnDeleteCascade
activeEpochNo Word64
txId TxId
txId TxId OnDeleteCascade
UniqueDelegation addrId poolHashId txId

-- When was a staking key/script registered
StakeRegistration
addrId StakeAddressId
addrId StakeAddressId OnDeleteCascade
certIndex Word16
txId TxId
txId TxId OnDeleteCascade
UniqueStakeRegistration addrId txId

-- When was a staking key/script deregistered
StakeDeregistration
addrId StakeAddressId
addrId StakeAddressId OnDeleteCascade
certIndex Word16
txId TxId
txId TxId OnDeleteCascade
UniqueStakeDeregistration addrId txId

TxMetadata
key DbWord64 sqltype=word64type
json Text Maybe sqltype=jsonb
bytes ByteString sqltype=bytea
txId TxId
txId TxId OnDeleteCascade
UniqueTxMetadata key txId

-- -----------------------------------------------------------------------------------------------
Expand All @@ -264,20 +263,20 @@ share
addrId StakeAddressId
amount DbLovelace sqltype=lovelace
epochNo Word64
poolId PoolHashId
blockId BlockId
poolId PoolHashId OnDeleteCascade
blockId BlockId OnDeleteCascade
UniqueReward addrId blockId

EpochStake
addrId StakeAddressId
poolId PoolHashId
addrId StakeAddressId OnDeleteCascade
poolId PoolHashId OnDeleteCascade
amount DbLovelace sqltype=lovelace
epochNo Word64
blockId BlockId -- To make rollbacks work correctly.
blockId BlockId OnDeleteCascade -- To make rollbacks work correctly.
UniqueStake addrId epochNo

Treasury
addrId StakeAddressId
addrId StakeAddressId OnDeleteCascade
certIndex Word16
-- poolId PoolHashId
amount DbLovelace sqltype=lovelace
Expand Down Expand Up @@ -326,7 +325,7 @@ share
minUtxoValue DbLovelace Maybe sqltype=lovelace
minPoolCost DbLovelace Maybe sqltype=lovelace

registeredTxId TxId -- Slot number in which update registered.
registeredTxId TxId OnDeleteCascade -- Slot number in which update registered.
UniqueParamProposal key registeredTxId

EpochParam
Expand All @@ -352,7 +351,7 @@ share

nonce ByteString Maybe sqltype=hash32type

blockId BlockId -- The first block where these parameters are valid.
blockId BlockId OnDeleteCascade -- The first block where these parameters are valid.
UniqueEpochParam epochNo blockId

|]
4 changes: 2 additions & 2 deletions cardano-db/test/Test/IO/Cardano/Db/Util.hs
View file
Original file line number Diff line number Diff line change
Expand Up @@ -28,7 +28,7 @@ import Data.Time.Calendar (Day (..))
import Data.Time.Clock (UTCTime (..))
import Data.Word (Word64)

import Database.Persist.Sql (SqlBackend, deleteCascade, selectKeysList)
import Database.Persist.Sql (SqlBackend, delete, selectKeysList)

import Cardano.Db

Expand All @@ -42,7 +42,7 @@ assertBool msg bool =
deleteAllBlocksCascade :: MonadIO m => ReaderT SqlBackend m ()
deleteAllBlocksCascade = do
(keys :: [BlockId]) <- selectKeysList [] []
mapM_ deleteCascade keys
mapM_ delete keys

dummyUTCTime :: UTCTime
dummyUTCTime = UTCTime (ModifiedJulianDay 0) 0
Expand Down

0 comments on commit 1227676

Please sign in to comment.