From fe734a665024a75efbb45b85bce7b4b8d50defcc Mon Sep 17 00:00:00 2001 From: paolino Date: Mon, 29 May 2023 13:28:50 +0000 Subject: [PATCH] Use wallet state for private key management. --- .../Cardano/Wallet/Api/Http/Shelley/Server.hs | 4 +- lib/wallet/src/Cardano/Wallet.hs | 29 +++++- lib/wallet/src/Cardano/Wallet/DB.hs | 41 -------- lib/wallet/src/Cardano/Wallet/DB/Layer.hs | 59 ------------ .../src/Cardano/Wallet/DB/Pure/Layer.hs | 10 -- .../Wallet/DB/Store/PrivateKey/Store.hs | 3 +- .../src/Cardano/Wallet/DB/WalletState.hs | 4 +- .../test/unit/Cardano/Wallet/DB/LayerSpec.hs | 19 ++-- .../test/unit/Cardano/Wallet/DB/Properties.hs | 38 +------- .../unit/Cardano/Wallet/DB/StateMachine.hs | 94 ++----------------- .../Wallet/DB/Store/PrivateKey/StoreSpec.hs | 4 +- 11 files changed, 56 insertions(+), 249 deletions(-) diff --git a/lib/wallet/api/http/Cardano/Wallet/Api/Http/Shelley/Server.hs b/lib/wallet/api/http/Cardano/Wallet/Api/Http/Shelley/Server.hs index 54cb2ef2b54..a09364425a8 100644 --- a/lib/wallet/api/http/Cardano/Wallet/Api/Http/Shelley/Server.hs +++ b/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) diff --git a/lib/wallet/src/Cardano/Wallet.hs b/lib/wallet/src/Cardano/Wallet.hs index b9c4415a438..11988a89393 100644 --- a/lib/wallet/src/Cardano/Wallet.hs +++ b/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 diff --git a/lib/wallet/src/Cardano/Wallet/DB.hs b/lib/wallet/src/Cardano/Wallet/DB.hs index a2298b483c0..ff403d7fab1 100644 --- a/lib/wallet/src/Cardano/Wallet/DB.hs +++ b/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 ------------------------------------------------------------------------------} diff --git a/lib/wallet/src/Cardano/Wallet/DB/Layer.hs b/lib/wallet/src/Cardano/Wallet/DB/Layer.hs index abd18d74338..d3348cad3ac 100644 --- a/lib/wallet/src/Cardano/Wallet/DB/Layer.hs +++ b/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 diff --git a/lib/wallet/src/Cardano/Wallet/DB/Pure/Layer.hs b/lib/wallet/src/Cardano/Wallet/DB/Pure/Layer.hs index ec90506aad4..313508a242b 100644 --- a/lib/wallet/src/Cardano/Wallet/DB/Pure/Layer.hs +++ b/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 -----------------------------------------------------------------------} diff --git a/lib/wallet/src/Cardano/Wallet/DB/Store/PrivateKey/Store.hs b/lib/wallet/src/Cardano/Wallet/DB/Store/PrivateKey/Store.hs index f929740b820..42b2849a89a 100644 --- a/lib/wallet/src/Cardano/Wallet/DB/Store/PrivateKey/Store.hs +++ b/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 diff --git a/lib/wallet/src/Cardano/Wallet/DB/WalletState.hs b/lib/wallet/src/Cardano/Wallet/DB/WalletState.hs index 8d800d2dc08..c930f87d56e 100644 --- a/lib/wallet/src/Cardano/Wallet/DB/WalletState.hs +++ b/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 diff --git a/lib/wallet/test/unit/Cardano/Wallet/DB/LayerSpec.hs b/lib/wallet/test/unit/Cardano/Wallet/DB/LayerSpec.hs index c878fae1b61..2d3aed46950 100644 --- a/lib/wallet/test/unit/Cardano/Wallet/DB/LayerSpec.hs +++ b/lib/wallet/test/unit/Cardano/Wallet/DB/LayerSpec.hs @@ -52,11 +52,9 @@ import Cardano.DB.Sqlite import Cardano.Mnemonic ( SomeMnemonic (..) ) import Cardano.Wallet - ( readWalletMeta ) + ( putPrivateKey, readPrivateKey, readWalletMeta ) import Cardano.Wallet.Address.Derivation ( Depth (..), DerivationType (..), Index, PaymentAddress (..) ) -import Cardano.Wallet.Address.Derivation.Byron - ( ByronKey (..) ) import Cardano.Wallet.Address.Derivation.Icarus ( IcarusKey ) import Cardano.Wallet.Address.Derivation.Shared @@ -292,12 +290,11 @@ spec = manualMigrationsSpec stateMachineSpec - :: forall k s + :: forall s . ( PersistAddressBook s - , TestConstraints s k + , TestConstraints s , Typeable s , WalletFlavor s - , KeyOf s ~ k ) => Spec stateMachineSpec = describe ("State machine test (" ++ showState @s ++ ")") $ do @@ -313,11 +310,11 @@ stateMachineSpec = describe ("State machine test (" ++ showState @s ++ ")") $ do stateMachineSpecSeq, stateMachineSpecRnd, stateMachineSpecShared :: Spec stateMachineSpecSeq = - stateMachineSpec @ShelleyKey @TestState + stateMachineSpec @TestState stateMachineSpecRnd = - stateMachineSpec @ByronKey @(RndState 'Mainnet) + stateMachineSpec @(RndState 'Mainnet) stateMachineSpecShared = - stateMachineSpec @SharedKey @(SharedState 'Mainnet SharedKey) + stateMachineSpec @(SharedState 'Mainnet SharedKey) instance PaymentAddress SharedKey 'CredFromScriptK where paymentAddress _ = error @@ -968,7 +965,7 @@ readTransactions' DBLayer{..} a1 a2 mstatus = readPrivateKey' :: DBLayer m s -> m (Maybe (KeyOf s 'RootK XPrv, PassphraseHash)) -readPrivateKey' DBLayer{..} = atomically readPrivateKey +readPrivateKey' DBLayer{..} = atomically $ readPrivateKey walletState -- | Attach an arbitrary private key to a wallet attachPrivateKey @@ -980,7 +977,7 @@ attachPrivateKey DBLayer{..} = do seed <- liftIO $ generate $ SomeMnemonic <$> genMnemonic @15 (scheme, h) <- liftIO $ encryptPassphrase pwd let k = generateKeyFromSeed (seed, Nothing) (preparePassphrase scheme pwd) - atomically $ putPrivateKey (k, h) + atomically $ putPrivateKey walletState (k, h) return (k, h) cutRandomly :: [a] -> IO [[a]] diff --git a/lib/wallet/test/unit/Cardano/Wallet/DB/Properties.hs b/lib/wallet/test/unit/Cardano/Wallet/DB/Properties.hs index b26923f7e38..7b037cbab84 100644 --- a/lib/wallet/test/unit/Cardano/Wallet/DB/Properties.hs +++ b/lib/wallet/test/unit/Cardano/Wallet/DB/Properties.hs @@ -25,10 +25,6 @@ module Cardano.Wallet.DB.Properties import Prelude -import Cardano.Address.Derivation - ( XPrv ) -import Cardano.Wallet.Address.Derivation - ( Depth (RootK) ) import Cardano.Wallet.DB ( DBFresh (..) , DBLayer (..) @@ -42,12 +38,8 @@ import Cardano.Wallet.DB.Pure.Implementation ( filterTxHistory ) import Cardano.Wallet.DummyTarget.Primitive.Types ( dummyGenesisParameters ) -import Cardano.Wallet.Flavor - ( KeyOf ) import Cardano.Wallet.Primitive.Model ( Wallet (currentTip), applyBlock, currentTip ) -import Cardano.Wallet.Primitive.Passphrase.Types - ( PassphraseHash ) import Cardano.Wallet.Primitive.Types ( ChainPoint (..) , GenesisParameters @@ -146,12 +138,7 @@ testWid = WalletId (hash ("test" :: ByteString)) -- | Wallet properties. properties - :: ( GenState s - , Show (KeyOf s 'RootK XPrv) - , Arbitrary (KeyOf s 'RootK XPrv) - , Buildable (KeyOf s 'RootK XPrv, PassphraseHash) - , Eq (KeyOf s 'RootK XPrv) - ) + :: GenState s => WithDBFresh s -> SpecWith () properties withFreshDB = describe "DB.Properties" $ do @@ -176,12 +163,6 @@ properties withFreshDB = describe "DB.Properties" $ do testOnLayer (\db _ -> lift . putTxHistory_ db) (\db _ -> readTxHistory_ db) - it "Private Key" - $ property - $ prop_readAfterPut - testOnLayer - (\DBLayer{..} _wid -> lift . atomically . putPrivateKey) - (\DBLayer{..} _wid -> atomically readPrivateKey) describe "getTx properties" $ do it "can read after putting tx history for valid tx id" @@ -192,23 +173,21 @@ properties withFreshDB = describe "DB.Properties" $ do $ prop_getTxAfterPutInvalidTxId testOnLayer describe "put doesn't affect other resources" $ do - it "Checkpoint vs Wallet Metadata & Tx History & Private Key" + it "Checkpoint vs Wallet Metadata & Tx History" $ property $ prop_isolation testOnLayer (\DBLayer{..} _wid -> lift . atomically . putCheckpoint) (\db _ -> readTxHistory_ db) - (\DBLayer{..} _wid -> atomically readPrivateKey) - it "Tx History vs Checkpoint & Wallet Metadata & Private Key" + (\DBLayer{} _wid -> pure [0 :: Int]) + it "Tx History vs Checkpoint & Wallet Metadata" $ property $ prop_isolation testOnLayer (\db _ -> lift . putTxHistory_ db) (\DBLayer{..} _ -> atomically readCheckpoint) - (\DBLayer{..} _wid -> atomically readPrivateKey) + (\DBLayer{} _wid -> pure [0 :: Int]) - let lastMay [] = Nothing - lastMay xs = Just (last xs) describe "sequential puts replace values in order" $ do it "Checkpoint" $ checkCoverage @@ -230,13 +209,6 @@ properties withFreshDB = describe "DB.Properties" $ do . unGenTxHistory in Identity . sort' . fold ) - it "Private Key" - $ checkCoverage - $ prop_sequentialPut - testOnLayer - (\DBLayer{..} _wid -> lift . atomically . putPrivateKey) - (\DBLayer{..} _wid -> atomically readPrivateKey) - lastMay describe "rollback" $ do it diff --git a/lib/wallet/test/unit/Cardano/Wallet/DB/StateMachine.hs b/lib/wallet/test/unit/Cardano/Wallet/DB/StateMachine.hs index b3eef97842b..f3f24006cdd 100644 --- a/lib/wallet/test/unit/Cardano/Wallet/DB/StateMachine.hs +++ b/lib/wallet/test/unit/Cardano/Wallet/DB/StateMachine.hs @@ -50,8 +50,6 @@ module Cardano.Wallet.DB.StateMachine import Prelude -import Cardano.Address.Derivation - ( XPrv ) import Cardano.Address.Script ( ScriptTemplate (..) ) import Cardano.Pool.Types @@ -60,8 +58,6 @@ import Cardano.Wallet.Address.Book ( AddressBookIso ) import Cardano.Wallet.Address.Derivation ( Depth (..), DerivationPrefix, Index, KeyFingerprint, Role (..) ) -import Cardano.Wallet.Address.Derivation.Byron - ( ByronKey ) import Cardano.Wallet.Address.Derivation.Shared () import Cardano.Wallet.Address.Derivation.SharedKey @@ -80,8 +76,6 @@ import Cardano.Wallet.Address.Discovery.Shared , SharedAddressPools (..) , SharedState (..) ) -import Cardano.Wallet.Address.Keys.PersistPrivateKey - ( unsafeDeserializeXPrv ) import Cardano.Wallet.DB ( DBLayer (..), DBLayerParams (..) ) import Cardano.Wallet.DB.Arbitrary @@ -97,23 +91,17 @@ import Cardano.Wallet.DB.Pure.Implementation , mPutCheckpoint , mPutDelegationCertificate , mPutDelegationRewardBalance - , mPutPrivateKey , mPutTxHistory , mReadCheckpoint , mReadDelegationRewardBalance , mReadGenesisParameters - , mReadPrivateKey , mReadTxHistory , mRollbackTo ) import Cardano.Wallet.DummyTarget.Primitive.Types ( dummyGenesisParameters, dummyTimeInterpreter ) -import Cardano.Wallet.Flavor - ( KeyFlavorS (..), KeyOf ) import Cardano.Wallet.Primitive.Model ( Wallet ) -import Cardano.Wallet.Primitive.Passphrase.Types - ( PassphraseHash (..) ) import Cardano.Wallet.Primitive.Types ( BlockHeader (..) , ChainPoint @@ -187,8 +175,6 @@ import Crypto.Hash ( Blake2b_160, Digest, digestFromByteString, hash ) import Data.Bifunctor ( first ) -import Data.ByteString - ( ByteString ) import Data.Foldable ( foldl', toList ) import Data.Functor.Classes @@ -225,7 +211,6 @@ import Test.QuickCheck , Property , applyArbitrary2 , arbitraryBoundedEnum - , elements , frequency , generate , resize @@ -297,37 +282,6 @@ unMockWid (MWid wid) = WalletId m -- | Represent (XPrv, Hash) as a string. type MPrivKey = String -class MockPrivKey k where - -- | Stuff a mock private key into the type used by 'DBLayer'. - fromMockPrivKey - :: MPrivKey - -> (k XPrv, PassphraseHash) - - -- | Unstuff the DBLayer private key into the mock type. - toMockPrivKey :: (k XPrv, PassphraseHash) -> MPrivKey - toMockPrivKey (_, h) = B8.unpack (BA.convert h) - -zeroes :: ByteString -zeroes = B8.replicate 256 '0' - -instance MockPrivKey (ShelleyKey 'RootK) where - fromMockPrivKey s = (k, unMockPrivKeyHash s) - where - (k, _) = unsafeDeserializeXPrv ShelleyKeyS (zeroes, mempty) - -instance MockPrivKey (SharedKey 'RootK) where - fromMockPrivKey s = (k, unMockPrivKeyHash s) - where - (k, _) = unsafeDeserializeXPrv SharedKeyS (zeroes, mempty) - -instance MockPrivKey (ByronKey 'RootK) where - fromMockPrivKey s = (k, unMockPrivKeyHash s) - where - (k, _) = unsafeDeserializeXPrv ByronKeyS - (zeroes <> ":", mempty) - -unMockPrivKeyHash :: MPrivKey -> PassphraseHash -unMockPrivKeyHash = PassphraseHash . BA.convert . B8.pack {------------------------------------------------------------------------------- Language @@ -345,8 +299,6 @@ data Cmd s wid (Range SlotNo) (Maybe TxStatus) | GetTx (Hash "Tx") - | PutPrivateKey MPrivKey - | ReadPrivateKey | ReadGenesisParameters | RollbackTo wid Slot | PutDelegationCertificate DelegationCertificate SlotNo @@ -364,7 +316,6 @@ data Success s wid | Metadata WalletMetadata | TxHistory [TransactionInfo] | LocalTxSubmission [LocalTxSubmissionStatus (Hash "Tx")] - | PrivateKey (Maybe MPrivKey) | GenesisParams (Maybe GenesisParameters) | ChainPoints [ChainPoint] | Point ChainPoint @@ -413,10 +364,6 @@ runMock = \case -- TODO: Implement mGetTx -- . mGetTx wid tid . (Right Nothing,) - PutPrivateKey pk -> - first (Resp . fmap Unit) . mPutPrivateKey pk - ReadPrivateKey -> - first (Resp . fmap PrivateKey) . mReadPrivateKey ReadGenesisParameters -> first (Resp . fmap GenesisParams) . mReadGenesisParameters PutDelegationRewardBalance _wid amt -> @@ -435,7 +382,8 @@ runMock = \case -------------------------------------------------------------------------------} runIO - :: forall m s k. (MonadIO m, MockPrivKey (k 'RootK), k ~ KeyOf s) + :: forall m s + . MonadIO m => DBLayer m s -> Cmd s WalletId -> m (Resp s WalletId) @@ -472,11 +420,6 @@ runIO DBLayer{..} = fmap Resp . go readTransactions minWith order range status Nothing GetTx tid -> runDBSuccess atomically (TxHistory . maybe [] pure) $ getTx tid - PutPrivateKey pk -> - runDBSuccess atomically Unit $ - putPrivateKey (fromMockPrivKey pk) - ReadPrivateKey -> Right . PrivateKey . fmap toMockPrivKey <$> - atomically readPrivateKey ReadGenesisParameters -> Right . GenesisParams <$> atomically readGenesisParameters PutDelegationRewardBalance _wid amt -> runDBSuccess atomically Unit $ @@ -611,10 +554,6 @@ generatorWithWid wids = <*> genSortOrder <*> genRange <*> arbitrary - , declareGenerator "PutPrivateKey" 3 - $ PutPrivateKey <$> genPrivKey - , declareGenerator "ReadPrivateKey" 3 - $ pure ReadPrivateKey , declareGenerator "RollbackTo" 1 $ RollbackTo <$> genId <*> arbitrary -- TODO: Implement mPrune @@ -627,9 +566,6 @@ generatorWithWid wids = genId :: Gen (Reference WalletId r) genId = QC.elements wids - genPrivKey :: Gen MPrivKey - genPrivKey = elements ["pk1", "pk2", "pk3"] - genSortOrder :: Gen SortOrder genSortOrder = arbitraryBoundedEnum @@ -687,7 +623,7 @@ postcondition m c r = e = lockstep m c r semantics - :: (MonadIO m, MockPrivKey (k 'RootK), k ~ KeyOf s) + :: MonadIO m => DBLayer m s -> Cmd s :@ Concrete -> m (Resp s :@ Concrete) @@ -701,16 +637,15 @@ symbolicResp m c = where (resp, _mock') = step m c -type TestConstraints s k = - ( MockPrivKey (k 'RootK) - , Eq s +type TestConstraints s = + ( Eq s , GenState s , Arbitrary (Wallet s) , ToExpr s ) sm - :: (MonadIO m, TestConstraints s k, k ~ KeyOf s) + :: (MonadIO m, TestConstraints s) => MWid -> DBLayerParams s -> DBLayer m s @@ -947,8 +882,6 @@ data Tag | TxUnsortedInputs -- ^ Putting a transaction with unsorted inputs. | TxUnsortedOutputs - | SuccessfulReadPrivateKey - -- ^ Private key was written then read. | PutCheckpointTwice -- ^ Multiple checkpoints are successfully saved to a wallet. | RolledBackOnce @@ -965,7 +898,6 @@ tag = Foldl.fold $ catMaybes <$> sequenceA , readTransactions null UnsuccessfulReadTxHistory , txUnsorted inputs TxUnsortedInputs , txUnsorted outputs TxUnsortedOutputs - , countAction SuccessfulReadPrivateKey (>= 1) isReadPrivateKeySuccess , countAction PutCheckpointTwice (>= 2) isPutCheckpointSuccess , countAction RolledBackOnce (>= 1) isRollbackSuccess ] @@ -996,15 +928,6 @@ tag = Foldl.fold $ catMaybes <$> sequenceA | any enough matches = Just res | otherwise = Nothing - isReadPrivateKeySuccess :: Event s Symbolic -> Maybe () - isReadPrivateKeySuccess ev = case (cmd ev, mockResp ev, before ev) of - (At ReadPrivateKey - , Resp (Right (PrivateKey (Just _))) - , Model _ _wids ) - -> Just () - _otherwise - -> Nothing - readTransactions :: ([TransactionInfo] -> Bool) -> Tag @@ -1094,7 +1017,8 @@ genDBParams = <*> pure dummyGenesisParameters prop_sequential - :: forall s k. (TestConstraints s k, k ~ KeyOf s) + :: forall s + . TestConstraints s => (WalletId -> DBLayerParams s -> (IO (IO (),DBLayer IO s))) -> Property prop_sequential newDB = @@ -1110,7 +1034,7 @@ prop_sequential newDB = measureTag p t = QC.cover 5 (t `Set.member` matchedTags) (show t) p in QC.checkCoverage $ - forAllCommands (sm @IO @s @k testMWid params dbLayerUnused) Nothing $ + forAllCommands (sm @IO @s testMWid params dbLayerUnused) Nothing $ \cmds -> monadicIO $ do (destroyDB, db) <- run (newDB testWid params) let sm' = sm testMWid params db diff --git a/lib/wallet/test/unit/Cardano/Wallet/DB/Store/PrivateKey/StoreSpec.hs b/lib/wallet/test/unit/Cardano/Wallet/DB/Store/PrivateKey/StoreSpec.hs index 7c3dd740964..b8b00bb455e 100644 --- a/lib/wallet/test/unit/Cardano/Wallet/DB/Store/PrivateKey/StoreSpec.hs +++ b/lib/wallet/test/unit/Cardano/Wallet/DB/Store/PrivateKey/StoreSpec.hs @@ -34,13 +34,13 @@ import Cardano.Wallet.DB.Fixtures , withInitializedWalletProp ) import Cardano.Wallet.DB.Store.PrivateKey.Store - ( DeltaPrivateKey, HashedCredentials, mkStorePrivateKey ) + ( DeltaPrivateKey, mkStorePrivateKey ) import Cardano.Wallet.Flavor ( KeyFlavorS (..) ) import Cardano.Wallet.Primitive.Types ( WalletId ) import Cardano.Wallet.Primitive.Types.Credentials - ( Credentials (Credentials) ) + ( Credentials (Credentials), HashedCredentials ) import Data.Delta ( Replace (..) ) import Fmt