Commit
This commit does not belong to any branch on this repository, and may belong to a fork outside of the repository.
Move Delegation migration code to its module.
Extract necessary Persistent schema definition to migrate delegation.
- Loading branch information
Showing
4 changed files
with
194 additions
and
71 deletions.
There are no files selected for viewing
This file contains bidirectional Unicode text that may be interpreted or compiled differently than what appears below. To review, open the file in an editor that reveals hidden Unicode characters.
Learn more about bidirectional Unicode characters
94 changes: 94 additions & 0 deletions
94
lib/wallet/src/Cardano/Wallet/DB/Store/Delegations/Migration.hs
This file contains bidirectional Unicode text that may be interpreted or compiled differently than what appears below. To review, open the file in an editor that reveals hidden Unicode characters.
Learn more about bidirectional Unicode characters
| Original file line number | Diff line number | Diff line change |
|---|---|---|
| @@ -0,0 +1,94 @@ | ||
| {-# LANGUAGE DataKinds #-} | ||
| {-# LANGUAGE LambdaCase #-} | ||
|
|
||
| module Cardano.Wallet.DB.Store.Delegations.Migration | ||
| ( migration | ||
| ) where | ||
|
|
||
| import Prelude | ||
|
|
||
| import Cardano.Pool.Types | ||
| ( PoolId ) | ||
| import Cardano.Wallet.DB.Store.Delegations.Migration.Schema | ||
| ( DelegationCertificate (..), EntityField (..), StakeKeyCertificate (..) ) | ||
| import Cardano.Wallet.Delegation.Model | ||
| ( History, Operation (Delegate, Deregister, Register) ) | ||
| import Cardano.Wallet.Primitive.Types | ||
| ( SlotNo, WalletId ) | ||
| import Data.Delta | ||
| ( Delta (Base, apply) ) | ||
| import Data.Map.Strict | ||
| ( Map ) | ||
| import Data.Store | ||
| ( Store (..), UpdateStore ) | ||
| import Data.These | ||
| ( These (..) ) | ||
| import Database.Persist.Sql | ||
| ( Entity (Entity) | ||
| , PersistQueryWrite (deleteWhere) | ||
| , SqlPersistT | ||
| , selectList | ||
| , (==.) | ||
| ) | ||
|
|
||
| import qualified Cardano.Wallet.Primitive.Types as W | ||
| import qualified Data.Map as Map | ||
| import qualified Data.Map.Merge.Strict as Map | ||
|
|
||
| readOldEncoding | ||
| :: WalletId | ||
| -> SqlPersistT IO (Base (Operation SlotNo PoolId)) | ||
| readOldEncoding wid = do | ||
| skcs <- selectList [StakeKeyCertWalletId ==. wid] [] | ||
| dcs <- selectList [CertWalletId ==. wid] [] | ||
| pure $ Map.foldlWithKey' applyChange mempty (slotMap skcs dcs) | ||
| where | ||
| applyChange | ||
| :: History SlotNo PoolId | ||
| -> SlotNo | ||
| -> These W.StakeKeyCertificate (Maybe PoolId) | ||
| -> History SlotNo PoolId | ||
| applyChange h s = \case | ||
| This W.StakeKeyDeregistration -> apply (Deregister s) h | ||
| This W.StakeKeyRegistration -> apply (Register s) h | ||
| That Nothing -> h | ||
| That (Just p) -> apply (Delegate p s) h | ||
| These W.StakeKeyDeregistration _ -> apply (Deregister s) h | ||
| These W.StakeKeyRegistration (Just p) -> | ||
| apply (Delegate p s) $ apply (Register s) h | ||
| These W.StakeKeyRegistration Nothing -> | ||
| apply (Register s) h | ||
|
|
||
| slotMap | ||
| :: [Entity StakeKeyCertificate] | ||
| -> [Entity DelegationCertificate] | ||
| -> Map SlotNo (These W.StakeKeyCertificate (Maybe PoolId)) | ||
| slotMap skcs dcs = | ||
| mapMergeThese | ||
| ( Map.fromList | ||
| [ (slot, type') | ||
| | Entity _ (StakeKeyCertificate _ slot type') <- skcs | ||
| ] | ||
| ) | ||
| ( Map.fromList | ||
| [ (slot, type') | ||
| | Entity _ (DelegationCertificate _ slot type') <- dcs | ||
| ] | ||
| ) | ||
|
|
||
| mapMergeThese :: Ord k => Map k a -> Map k b -> Map k (These a b) | ||
| mapMergeThese = | ||
| Map.merge | ||
| (Map.mapMaybeMissing $ \_ -> Just . This) | ||
| (Map.mapMaybeMissing $ \_ -> Just . That) | ||
| (Map.zipWithMaybeMatched $ \_ x y -> Just $ These x y) | ||
|
|
||
| migration | ||
| :: UpdateStore (SqlPersistT IO) (Operation SlotNo PoolId) | ||
| -> WalletId | ||
| -> SqlPersistT IO () | ||
| migration store wid = do | ||
| old <- readOldEncoding wid | ||
| writeS store old | ||
| deleteWhere [StakeKeyCertWalletId ==. wid] | ||
| deleteWhere [CertWalletId ==. wid] |
95 changes: 95 additions & 0 deletions
95
lib/wallet/src/Cardano/Wallet/DB/Store/Delegations/Migration/Schema.hs
This file contains bidirectional Unicode text that may be interpreted or compiled differently than what appears below. To review, open the file in an editor that reveals hidden Unicode characters.
Learn more about bidirectional Unicode characters
| Original file line number | Diff line number | Diff line change |
|---|---|---|
| @@ -0,0 +1,95 @@ | ||
| {-# LANGUAGE DataKinds #-} | ||
| {-# LANGUAGE DeriveGeneric #-} | ||
| {-# LANGUAGE DerivingStrategies #-} | ||
| {-# LANGUAGE EmptyDataDecls #-} | ||
| {-# LANGUAGE FlexibleInstances #-} | ||
| {-# LANGUAGE GADTs #-} | ||
| {-# LANGUAGE GeneralizedNewtypeDeriving #-} | ||
| {-# LANGUAGE MultiParamTypeClasses #-} | ||
| {-# LANGUAGE QuasiQuotes #-} | ||
| {-# LANGUAGE StandaloneDeriving #-} | ||
| {-# LANGUAGE TemplateHaskell #-} | ||
| {-# LANGUAGE TypeFamilies #-} | ||
| {-# LANGUAGE UndecidableInstances #-} | ||
|
|
||
| -- | | ||
| -- Copyright: © 2018-2023 IOHK | ||
| -- License: Apache-2.0 | ||
| -- | ||
| -- Auto-generated Sqlite & Persistent machinery via Template-Haskell. This has | ||
| -- been moved into a separate file so that we can treat it slightly differently | ||
| -- when computing code-coverage. | ||
| -- | ||
| -- More than 6K lines end-up being generated from the instructions below! As a | ||
| -- result, we're going to ignore code-coverage on the following module and, no | ||
| -- hand-written functions should be written in this module! | ||
|
|
||
| module Cardano.Wallet.DB.Store.Delegations.Migration.Schema where | ||
|
|
||
| import Prelude | ||
|
|
||
| import Cardano.Pool.Types | ||
| ( PoolId ) | ||
| import Cardano.Slotting.Slot | ||
| ( SlotNo ) | ||
| import Cardano.Wallet.DB.Sqlite.Types | ||
| ( BlockId, DelegationStatusEnum (..), sqlSettings' ) | ||
| import Data.Text | ||
| ( Text ) | ||
| import Data.Time.Clock | ||
| ( UTCTime ) | ||
| import Database.Persist.TH | ||
| ( mkPersist, persistLowerCase, share ) | ||
| import GHC.Generics | ||
| ( Generic (..) ) | ||
|
|
||
| import qualified Cardano.Wallet.Primitive.Passphrase.Types as W | ||
| import qualified Cardano.Wallet.Primitive.Types as W | ||
|
|
||
| share | ||
| [ mkPersist sqlSettings' | ||
| ] | ||
| [persistLowerCase| | ||
|
|
||
|
|
||
| -- Wallet IDs, address discovery state, and metadata. | ||
| Wallet | ||
| walId W.WalletId sql=wallet_id | ||
| walCreationTime UTCTime sql=creation_time | ||
| walName Text sql=name | ||
| walPassphraseLastUpdatedAt UTCTime Maybe sql=passphrase_last_updated_at | ||
| walPassphraseScheme W.PassphraseScheme Maybe sql=passphrase_scheme | ||
| walGenesisHash BlockId sql=genesis_hash | ||
| walGenesisStart UTCTime sql=genesis_start | ||
|
|
||
| Primary walId | ||
| deriving Show Generic | ||
| -- Track whether the wallet's stake key is registered or not. | ||
| StakeKeyCertificate | ||
| stakeKeyCertWalletId W.WalletId sql=wallet_id | ||
| stakeKeyCertSlot SlotNo sql=slot | ||
| stakeKeyCertType W.StakeKeyCertificate sql=type | ||
|
|
||
| Primary stakeKeyCertWalletId stakeKeyCertSlot | ||
| Foreign Wallet OnDeleteCascade stakeKeyRegistration stakeKeyCertWalletId | ||
| deriving Show Generic | ||
|
|
||
| -- Store known delegation certificates for a particular wallet | ||
| DelegationCertificate | ||
| certWalletId W.WalletId sql=wallet_id | ||
| certSlot SlotNo sql=slot | ||
| certPoolId PoolId Maybe sql=delegation | ||
|
|
||
| Primary certWalletId certSlot | ||
| Foreign Wallet OnDeleteCascade delegationCertificate certWalletId | ||
| deriving Show Generic | ||
|
|
||
| Delegations sql=delegations | ||
| delegationSlot SlotNo sql=slot | ||
| delegationStatus DelegationStatusEnum sql=status | ||
| delegationPool PoolId Maybe sql=pool | ||
|
|
||
| Primary delegationSlot | ||
| deriving Show Generic Eq | ||
|
|
||
| |] |
This file contains bidirectional Unicode text that may be interpreted or compiled differently than what appears below. To review, open the file in an editor that reveals hidden Unicode characters.
Learn more about bidirectional Unicode characters