Use wallet state for private key management.

lib/wallet/api/http/Cardano/Wallet/Api/Http/Shelley/Server.hs

@@ -192,6 +192,7 @@ import Cardano.Wallet
     , logger
     , manageRewardBalance
     , networkLayer
+    , readPrivateKey
     , readWalletMeta
     , transactionLayer
     , utxoAssumptionsForWallet
@@ -1262,13 +1263,12 @@ patchSharedWallet ctx liftKey cred (ApiT wid) body = do
                 db & \W.DBLayer
                     { atomically
                     , readCheckpoint
-                    , readPrivateKey
                     , walletState
                     } -> do
                         cp <- atomically readCheckpoint
                         let state = getState cp
                         --could be for account and root key wallets
-                        prvKeyM <- atomically readPrivateKey
+                        prvKeyM <- atomically $ readPrivateKey walletState
                         meta <- atomically (readWalletMeta walletState)
                         pure (state, prvKeyM, meta)
 

lib/wallet/src/Cardano/Wallet.hs

@@ -76,6 +76,7 @@ module Cardano.Wallet
     , getWalletUtxoSnapshot
     , listUtxoStatistics
     , readWallet
+    , readPrivateKey
     , restoreWallet
     , updateWallet
     , updateWalletPassphraseWithOldPassphrase
@@ -221,6 +222,7 @@ module Cardano.Wallet
     , WalletFollowLog (..)
     , WalletLog (..)
     , TxSubmitLog (..)
+    , putPrivateKey
     ) where
 
 import Prelude hiding
@@ -441,6 +443,8 @@ import Cardano.Wallet.Primitive.Types.Address
     ( Address (..), AddressState (..) )
 import Cardano.Wallet.Primitive.Types.Coin
     ( Coin (..) )
+import Cardano.Wallet.Primitive.Types.Credentials
+    ( Credentials (..), PrivateKey )
 import Cardano.Wallet.Primitive.Types.Hash
     ( Hash (..) )
 import Cardano.Wallet.Primitive.Types.RewardAccount
@@ -561,6 +565,8 @@ import Data.ByteString
     ( ByteString )
 import Data.DBVar
     ( DBVar, readDBVar )
+import Data.Delta
+    ( Replace (..) )
 import Data.Delta.Update
     ( onDBVar, update )
 import Data.Either
@@ -870,6 +876,23 @@ checkWalletIntegrity db gp = db & \DBLayer{..} -> do
 readWalletMeta :: Functor f => DBVar f (DeltaWalletState s) -> f WalletMetadata
 readWalletMeta walletState = walletMeta . info <$> readDBVar walletState
 
+readPrivateKey
+    :: Functor stm
+    => DBVar stm (DeltaWalletState s)
+    -> stm (Maybe (PrivateKey (KeyOf s), PassphraseHash))
+readPrivateKey walletState =
+    readDBVar walletState <&> \mc -> do
+        (Credentials pk h) <- credentials mc
+        pure (pk, h)
+
+putPrivateKey
+    :: Monad m
+    => DBVar m (DeltaWalletState s)
+    -> (PrivateKey (KeyOf s), PassphraseHash)
+    -> m ()
+putPrivateKey walletState (pk, hpw) = onDBVar walletState $ update $ \_ ->
+    [UpdateCredentials $ Replace $ Just $ Credentials pk hpw]
+
 -- | Retrieve the wallet state for the wallet with the given ID.
 readWallet
     :: forall ctx s
@@ -3022,10 +3045,10 @@ attachPrivateKey
     -> (KeyOf s 'RootK XPrv, PassphraseHash)
     -> PassphraseScheme
     -> IO ()
-attachPrivateKey db (xprv, hpwd) scheme = db & \DBLayer{..} -> do
+attachPrivateKey db pk  scheme = db & \DBLayer{..} -> do
     now <- liftIO getCurrentTime
     atomically $ do
-        putPrivateKey (xprv, hpwd)
+        putPrivateKey walletState pk
         meta <- readWalletMeta walletState
         let modify x = x
                 { passphraseInfo = Just $ WalletPassphraseInfo
@@ -3063,7 +3086,7 @@ withRootKey DBLayer{..} wid pwd embed action = do
     (xprv, scheme) <- withExceptT embed . ExceptT . atomically $ do
         wMetadata <- readWalletMeta walletState
         let mScheme = passphraseScheme <$> passphraseInfo wMetadata
-        mXPrv <- readPrivateKey
+        mXPrv <- readPrivateKey walletState
         pure $ case (mXPrv, mScheme) of
             (Just (xprv, hpwd), Just scheme) ->
                 case checkPassphrase scheme pwd hpwd of

lib/wallet/src/Cardano/Wallet/DB.hs

@@ -29,7 +29,6 @@ module Cardano.Wallet.DB
     , DBCheckpoints (..)
     , DBDelegation (..)
     , DBTxHistory (..)
-    , DBPrivateKey (..)
     , mkDBLayerFromParts
 
     , hoistDBLayer
@@ -40,10 +39,6 @@ module Cardano.Wallet.DB
 
 import Prelude
 
-import Cardano.Address.Derivation
-    ( XPrv )
-import Cardano.Wallet.Address.Derivation
-    ( Depth (..) )
 import Cardano.Wallet.DB.Errors
 import Cardano.Wallet.DB.Store.Submissions.Layer
     ( getInSubmissionTransaction, getInSubmissionTransactions )
@@ -59,12 +54,8 @@ import Cardano.Wallet.DB.Store.Wallets.Model
     ( DeltaTxWalletsHistory )
 import Cardano.Wallet.DB.WalletState
     ( DeltaWalletState, WalletState (submissions), updateSubmissions )
-import Cardano.Wallet.Flavor
-    ( KeyOf )
 import Cardano.Wallet.Primitive.Model
     ( Wallet, currentTip )
-import Cardano.Wallet.Primitive.Passphrase
-    ( PassphraseHash )
 import Cardano.Wallet.Primitive.Slotting
     ( TimeInterpreter, epochOf, hoistTimeInterpreter, interpretQuery )
 import Cardano.Wallet.Primitive.Types
@@ -305,19 +296,6 @@ data DBLayer m s = forall stm. (MonadIO stm, MonadFail stm) => DBLayer
         -- ^ Removes any expired transactions from the pending set and marks
         -- their status as expired.
 
-    , putPrivateKey
-        :: (KeyOf s 'RootK XPrv, PassphraseHash)
-        -> stm ()
-        -- ^ Store or replace a private key for a given wallet. Note that wallet
-        -- _could_ be stored and manipulated without any private key associated
-        -- to it. A private key is only seldomly required for very specific
-        -- operations (like transaction signing).
-
-    , readPrivateKey
-        :: stm (Maybe (KeyOf s 'RootK XPrv, PassphraseHash))
-        -- ^ Read a previously stored private key and its associated passphrase
-        -- hash.
-
     , readGenesisParameters
         :: stm (Maybe GenesisParameters)
         -- ^ Read the *Byron* genesis parameters.
@@ -402,7 +380,6 @@ data DBLayerCollection stm m s = DBLayerCollection
     { dbCheckpoints :: DBCheckpoints stm s
     , dbDelegation :: DBDelegation stm
     , dbTxHistory :: DBTxHistory stm
-    , dbPrivateKey :: DBPrivateKey stm (KeyOf s)
 
     -- The following two functions will need to be split up
     -- and distributed the smaller layer parts as well.
@@ -486,8 +463,6 @@ mkDBLayerFromParts ti wid_ DBLayerCollection{..} = DBLayer
     , rollForwardTxSubmissions = \tip txs ->
             updateSubmissionsNoError dbCheckpoints
                 $ \_ -> Sbms.rollForwardTxSubmissions tip txs
-    , putPrivateKey = putPrivateKey_ dbPrivateKey
-    , readPrivateKey = readPrivateKey_ dbPrivateKey
     , readGenesisParameters = readGenesisParameters_ dbCheckpoints
     , rollbackTo = rollbackTo_
     , atomically = atomically_
@@ -611,22 +586,6 @@ data DBTxHistory stm = DBTxHistory
     }
 
 
--- | A database layer for storing the private key.
-data DBPrivateKey stm k = DBPrivateKey
-    { putPrivateKey_
-        :: (k 'RootK XPrv, PassphraseHash)
-        -> stm ()
-        -- ^ Store or replace a private key for a given wallet. Note that wallet
-        -- _could_ be stored and manipulated without any private key associated
-        -- to it. A private key is only seldomly required for very specific
-        -- operations (like transaction signing).
-
-    , readPrivateKey_
-        :: stm (Maybe (k 'RootK XPrv, PassphraseHash))
-        -- ^ Read a previously stored private key and its associated passphrase
-        -- hash.
-    }
-
 {-----------------------------------------------------------------------------
     Helper functions
 ------------------------------------------------------------------------------}

lib/wallet/src/Cardano/Wallet/DB/Layer.hs

@@ -41,8 +41,6 @@ module Cardano.Wallet.DB.Layer
 
 import Prelude
 
-import Cardano.Address.Derivation
-    ( XPrv )
 import Cardano.BM.Data.Severity
     ( Severity (..) )
 import Cardano.BM.Data.Tracer
@@ -64,10 +62,6 @@ import Cardano.DB.Sqlite.Delete
     )
 import Cardano.Slotting.Slot
     ( WithOrigin (..) )
-import Cardano.Wallet.Address.Derivation
-    ( Depth (..) )
-import Cardano.Wallet.Address.Keys.PersistPrivateKey
-    ( serializeXPrv, unsafeDeserializeXPrv )
 import Cardano.Wallet.Address.Keys.WalletKey
     ( keyTypeDescriptor )
 import Cardano.Wallet.Checkpoints
@@ -81,7 +75,6 @@ import Cardano.Wallet.DB
     , DBLayerCollection (..)
     , DBLayerParams (..)
     , DBOpen (..)
-    , DBPrivateKey (..)
     , DBTxHistory (..)
     , ErrNotGenesisBlockHeader (ErrNotGenesisBlockHeader)
     , ErrWalletAlreadyInitialized (ErrWalletAlreadyInitialized)
@@ -97,7 +90,6 @@ import Cardano.Wallet.DB.Sqlite.Schema
     , DelegationReward (..)
     , EntityField (..)
     , Key (..)
-    , PrivateKey (..)
     , StakeKeyCertificate (..)
     , TxMeta (..)
     , Wallet (..)
@@ -143,8 +135,6 @@ import Cardano.Wallet.DB.WalletState
     )
 import Cardano.Wallet.Flavor
     ( KeyFlavorS, WalletFlavorS, keyOfWallet )
-import Cardano.Wallet.Primitive.Passphrase.Types
-    ( PassphraseHash )
 import Cardano.Wallet.Primitive.Slotting
     ( TimeInterpreter, firstSlotInEpoch, hoistTimeInterpreter, interpretQuery )
 import Cardano.Wallet.Read.Eras.EraValue
@@ -190,7 +180,6 @@ import Database.Persist.Sql
     , Filter
     , SelectOpt (..)
     , deleteWhere
-    , insert_
     , repsert
     , selectFirst
     , selectKeysList
@@ -216,7 +205,6 @@ import UnliftIO.MVar
     ( modifyMVar, modifyMVar_, newMVar, readMVar, withMVar )
 
 import qualified Cardano.Wallet.Primitive.Model as W
-import qualified Cardano.Wallet.Primitive.Passphrase as W
 import qualified Cardano.Wallet.Primitive.Types as W
 import qualified Cardano.Wallet.Primitive.Types.Coin as Coin
 import qualified Cardano.Wallet.Primitive.Types.Hash as W
@@ -649,8 +637,6 @@ newDBFreshFromDBOpen wF ti wid_ DBOpen{atomically=atomically_} =
     dbDelegation = mkDBDelegation ti wid_
 
 
-    dbPrivateKey = mkDBPrivateKey (keyOfWallet wF) wid_
-
 mkDBFreshFromParts
     :: forall stm m s
      . ( PersistAddressBook s
@@ -833,42 +819,7 @@ genesisParametersFromEntity (Wallet _ _ _ _ _ hash startTime) =
         , W.getGenesisBlockDate = W.StartTime startTime
         }
 
-{-----------------------------------------------------------------------
-                    Private Key store
------------------------------------------------------------------------}
-mkDBPrivateKey
-    :: forall k
-     . KeyFlavorS k
-    -> W.WalletId
-    -> DBPrivateKey (SqlPersistT IO) k
-mkDBPrivateKey keyF wid = DBPrivateKey
-    { putPrivateKey_ = \key -> do
-        deleteWhere [PrivateKeyWalletId ==. wid]
-        insert_ (mkPrivateKeyEntity keyF wid key)
-    , readPrivateKey_ = selectPrivateKey keyF wid
-    }
-
-mkPrivateKeyEntity
-    :: forall k
-     . KeyFlavorS k
-    -> W.WalletId
-    -> (k 'RootK XPrv, W.PassphraseHash)
-    -> PrivateKey
-mkPrivateKeyEntity keyF wid kh = PrivateKey
-    { privateKeyWalletId = wid
-    , privateKeyRootKey = root
-    , privateKeyHash = hash
-    }
-  where
-    (root, hash) = serializeXPrv keyF kh
 
-privateKeyFromEntity
-    :: forall k
-     . KeyFlavorS k
-    -> PrivateKey
-    -> (k 'RootK XPrv, PassphraseHash)
-privateKeyFromEntity keyF (PrivateKey _ k h) =
-    unsafeDeserializeXPrv keyF (k, h)
 
 {-------------------------------------------------------------------------------
     SQLite database operations
@@ -948,16 +899,6 @@ selectTransactionInfo ti tip lookupTx lookupTxOut meta = do
                 Left _ -> error "failed to extract cbor for era"
     liftIO . evaluate $ force result
 
-selectPrivateKey
-    :: forall k m
-     . MonadIO m
-    => KeyFlavorS k
-    -> W.WalletId
-    -> SqlPersistT m (Maybe (k 'RootK XPrv, PassphraseHash))
-selectPrivateKey keyF wid = do
-    keys <- selectFirst [PrivateKeyWalletId ==. wid] []
-    pure $ (privateKeyFromEntity keyF . entityVal) <$> keys
-
 selectGenesisParameters
     :: MonadIO m
     => W.WalletId

lib/wallet/src/Cardano/Wallet/DB/Pure/Layer.hs

@@ -33,12 +33,10 @@ import Cardano.Wallet.DB.Pure.Implementation
     , mPutCheckpoint
     , mPutDelegationCertificate
     , mPutDelegationRewardBalance
-    , mPutPrivateKey
     , mPutTxHistory
     , mReadCheckpoint
     , mReadDelegationRewardBalance
     , mReadGenesisParameters
-    , mReadPrivateKey
     , mReadTxHistory
     , mRollbackTo
     )
@@ -159,14 +157,6 @@ newDBFresh timeInterpreter wid = do
                     [] -> pure Nothing
                     t:_ -> pure $ Just t
 
-        {-----------------------------------------------------------------------
-                                       Keystore
-        -----------------------------------------------------------------------}
-
-        , putPrivateKey = noErrorAlterDB db . mPutPrivateKey
-
-        , readPrivateKey = join <$> readDBMaybe db mReadPrivateKey
-
         {-----------------------------------------------------------------------
                                        Pending Tx
         -----------------------------------------------------------------------}

lib/wallet/src/Cardano/Wallet/DB/Store/PrivateKey/Store.hs

@@ -11,7 +11,6 @@
 -- License: Apache-2.0
 module Cardano.Wallet.DB.Store.PrivateKey.Store
     ( mkStorePrivateKey
-    , HashedCredentials (..)
     , DeltaPrivateKey
     , StorePrivateKey
     ) where
@@ -25,7 +24,7 @@ import Cardano.Wallet.Flavor
 import Cardano.Wallet.Primitive.Types
     ( WalletId )
 import Cardano.Wallet.Primitive.Types.Credentials
-    ( Credentials (..), HashedCredentials (..) )
+    ( Credentials (..), HashedCredentials )
 import Control.Exception
     ( SomeException (..) )
 import Control.Monad.Class.MonadThrow

lib/wallet/src/Cardano/Wallet/DB/WalletState.hs

@@ -53,7 +53,7 @@ import Cardano.Wallet.Checkpoints
 import Cardano.Wallet.DB.Store.Info.Store
     ( DeltaWalletInfo, WalletInfo (..) )
 import Cardano.Wallet.DB.Store.PrivateKey.Store
-    ( DeltaPrivateKey, HashedCredentials )
+    ( DeltaPrivateKey )
 import Cardano.Wallet.DB.Store.Submissions.Layer
     ( emptyTxSubmissions )
 import Cardano.Wallet.DB.Store.Submissions.Operations
@@ -62,6 +62,8 @@ import Cardano.Wallet.Flavor
     ( KeyOf )
 import Cardano.Wallet.Primitive.Types
     ( BlockHeader )
+import Cardano.Wallet.Primitive.Types.Credentials
+    ( HashedCredentials )
 import Cardano.Wallet.Primitive.Types.UTxO
     ( UTxO )
 import Data.Delta