Remove isStakeKeyRegistered from DBLayer.

cardano-foundation · May 30, 2023 · 303f6bd · 303f6bd
1 parent 3f32b71
commit 303f6bd
Show file tree

Hide file tree

Showing 5 changed files with 17 additions and 16 deletions.
diff --git a/lib/wallet/src/Cardano/Wallet.hs b/lib/wallet/src/Cardano/Wallet.hs
@@ -108,6 +108,7 @@ module Cardano.Wallet
     , ErrWritePolicyPublicKey (..)
     , ErrGetPolicyId (..)
     , readWalletMeta
+    , isStakeKeyRegistered
 
     -- * Shared Wallet
     , updateCosigner
@@ -640,6 +641,7 @@ import qualified Cardano.Wallet.Address.Discovery.Random as Rnd
 import qualified Cardano.Wallet.Address.Discovery.Sequential as Seq
 import qualified Cardano.Wallet.Address.Discovery.Shared as Shared
 import qualified Cardano.Wallet.Checkpoints.Policy as CP
+import qualified Cardano.Wallet.DB.Store.Delegations.Layer as Dlgs
 import qualified Cardano.Wallet.DB.Store.Submissions.Layer as Submissions
 import qualified Cardano.Wallet.DB.WalletState as WS
 import qualified Cardano.Wallet.DB.WalletState as WalletState
@@ -2768,6 +2770,14 @@ data DelegationFee = DelegationFee
 
 instance NFData DelegationFee
 
+isStakeKeyRegistered
+    :: Functor stm
+    => DBVar stm (DeltaWalletState s)
+    -> stm Bool
+isStakeKeyRegistered walletState =
+    Dlgs.isStakeKeyRegistered . view #delegations
+        <$> readDBVar walletState
+
 delegationFee
     :: forall s
      . ( AddressBookIso s
@@ -2794,13 +2804,17 @@ delegationFee db@DBLayer{..} netLayer txLayer timeTranslation era
             -- previously, and the difference should be negligible.
             (PreSelection [])
         deposit <- liftIO
-            $ atomically isStakeKeyRegistered <&> \case
+            $ atomically (isStakeKeyRegistered walletState) <&> \case
                 False -> toWallet
                     $ Write.stakeKeyDeposit recentEra
                     $ Write.pparamsLedger protocolParams
                 True -> Coin 0
         pure DelegationFee { feePercentiles, deposit }
 
+
+
+
+
 transactionFee
     :: forall s era
      . ( AddressBookIso s

diff --git a/lib/wallet/src/Cardano/Wallet/DB.hs b/lib/wallet/src/Cardano/Wallet/DB.hs
@@ -230,8 +230,6 @@ data DBLayer m s = forall stm. (MonadIO stm, MonadFail stm) => DBLayer
 
     , readDelegation :: stm WalletDelegation
 
-    , isStakeKeyRegistered :: stm Bool
-
     , putDelegationCertificate
         :: DelegationCertificate
         -> SlotNo
@@ -412,7 +410,6 @@ mkDBLayerFromParts ti wid_ DBLayerCollection{..} = DBLayer
             currentEpoch <- liftIO $
                 interpretQuery ti (epochOf $ cp ^. #currentTip . #slotNo)
             readDelegation_ dbDelegation currentEpoch
-    , isStakeKeyRegistered = isStakeKeyRegistered_ dbDelegation
     , putDelegationCertificate = putDelegationCertificate_ dbDelegation
     , putDelegationRewardBalance = putDelegationRewardBalance_ dbDelegation
     , readDelegationRewardBalance = readDelegationRewardBalance_ dbDelegation

diff --git a/lib/wallet/src/Cardano/Wallet/DB/Pure/Layer.hs b/lib/wallet/src/Cardano/Wallet/DB/Pure/Layer.hs
@@ -28,7 +28,6 @@ import Cardano.Wallet.DB.Pure.Implementation
     , Err (..)
     , ModelOp
     , mInitializeWallet
-    , mIsStakeKeyRegistered
     , mListCheckpoints
     , mPutCheckpoint
     , mPutDelegationCertificate
@@ -124,8 +123,6 @@ newDBFresh timeInterpreter wid = do
         , putDelegationCertificate = \cert sl -> noErrorAlterDB db $
             mPutDelegationCertificate cert sl
 
-        , isStakeKeyRegistered = throwErrorReadDB db mIsStakeKeyRegistered
-
         {-----------------------------------------------------------------------
                                      Tx History
         -----------------------------------------------------------------------}

diff --git a/lib/wallet/src/Cardano/Wallet/Delegation.hs b/lib/wallet/src/Cardano/Wallet/Delegation.hs
@@ -33,6 +33,7 @@ import Cardano.Wallet
     , WalletException (..)
     , WalletLog (..)
     , fetchRewardBalance
+    , isStakeKeyRegistered
     , readRewardAccount
     , transactionExpirySlot
     )
@@ -122,7 +123,7 @@ joinStakePoolDelegationAction
     (walletDelegation, stakeKeyIsRegistered) <-
         atomically $
             (,) <$> readDelegation
-                <*> isStakeKeyRegistered
+                <*> isStakeKeyRegistered walletState
 
     let retirementInfo =
             PoolRetirementEpochInfo currentEpoch . view #retirementEpoch <$>

diff --git a/lib/wallet/test/unit/Cardano/Wallet/DB/StateMachine.hs b/lib/wallet/test/unit/Cardano/Wallet/DB/StateMachine.hs
@@ -86,7 +86,6 @@ import Cardano.Wallet.DB.Pure.Implementation
     , TxHistory
     , WalletDatabase (..)
     , mInitializeWallet
-    , mIsStakeKeyRegistered
     , mListCheckpoints
     , mPutCheckpoint
     , mPutDelegationCertificate
@@ -302,7 +301,6 @@ data Cmd s wid
     | ReadGenesisParameters
     | RollbackTo wid Slot
     | PutDelegationCertificate DelegationCertificate SlotNo
-    | IsStakeKeyRegistered wid
     | PutDelegationRewardBalance wid Coin
     | ReadDelegationRewardBalance
     deriving stock (Show, Generic1, Eq, Functor, Foldable, Traversable)
@@ -352,8 +350,6 @@ runMock = \case
         first (Resp . fmap Checkpoint) . mReadCheckpoint
     PutDelegationCertificate cert sl ->
         first (Resp . fmap Unit) . mPutDelegationCertificate cert sl
-    IsStakeKeyRegistered _wid ->
-        first (Resp . fmap StakeKeyStatus) . mIsStakeKeyRegistered
     PutTxHistory txs ->
         first (Resp . fmap Unit) . mPutTxHistory txs
     ReadTxHistory minW order range status ->
@@ -411,8 +407,6 @@ runIO DBLayer{..} = fmap Resp . go
             atomically listCheckpoints
         PutDelegationCertificate pool sl ->
             runDBSuccess atomically Unit $ putDelegationCertificate pool sl
-        IsStakeKeyRegistered _wid ->
-            runDBSuccess atomically StakeKeyStatus isStakeKeyRegistered
         PutTxHistory txs -> runDBSuccess atomically Unit $ putTxHistory txs
         ReadTxHistory minWith order range status ->
             fmap (Right . TxHistory) $
@@ -544,8 +538,6 @@ generatorWithWid wids =
         $ pure ListCheckpoints
     , declareGenerator "PutDelegationCertificate" 5
         $ PutDelegationCertificate <$> arbitrary <*> arbitrary
-    , declareGenerator "IsStakeKeyRegistered" 1
-        $ IsStakeKeyRegistered <$> genId
     , declareGenerator "PutTxHistory" 5
         $ PutTxHistory <$> fmap unGenTxHistory arbitrary
     , declareGenerator "ReadTxHistory" 5