diff --git a/lib/wallet/cardano-wallet.cabal b/lib/wallet/cardano-wallet.cabal index 4d501c7262b..e2c00c1a4a2 100644 --- a/lib/wallet/cardano-wallet.cabal +++ b/lib/wallet/cardano-wallet.cabal @@ -311,6 +311,7 @@ library Cardano.Wallet.Primitive.SyncProgress Cardano.Wallet.Primitive.Types Cardano.Wallet.Primitive.Types.Address.Constants + Cardano.Wallet.Primitive.Types.Credentials Cardano.Wallet.Primitive.Types.MinimumUTxO Cardano.Wallet.Primitive.Types.MinimumUTxO.Gen Cardano.Wallet.Primitive.Types.ProtocolMagic diff --git a/lib/wallet/src/Cardano/Wallet/DB/Layer.hs b/lib/wallet/src/Cardano/Wallet/DB/Layer.hs index 78791b22da5..abd18d74338 100644 --- a/lib/wallet/src/Cardano/Wallet/DB/Layer.hs +++ b/lib/wallet/src/Cardano/Wallet/DB/Layer.hs @@ -546,9 +546,9 @@ newDBFreshFromDBOpen -> DBOpen (SqlPersistT IO) IO s -- ^ A (thread-)safe wrapper for query execution. -> DBFresh IO s -newDBFreshFromDBOpen wf ti wid_ DBOpen{atomically=atomically_} = +newDBFreshFromDBOpen wF ti wid_ DBOpen{atomically=atomically_} = mkDBFreshFromParts ti wid_ - getWalletId_ (mkStoreWallet wid_) + getWalletId_ (mkStoreWallet wF wid_) dbLayerCollection atomically_ where transactionsQS = newQueryStoreTxWalletsHistory @@ -649,7 +649,7 @@ newDBFreshFromDBOpen wf ti wid_ DBOpen{atomically=atomically_} = dbDelegation = mkDBDelegation ti wid_ - dbPrivateKey = mkDBPrivateKey (keyOfWallet wf) wid_ + dbPrivateKey = mkDBPrivateKey (keyOfWallet wF) wid_ mkDBFreshFromParts :: forall stm m s diff --git a/lib/wallet/src/Cardano/Wallet/DB/Store/Checkpoints.hs b/lib/wallet/src/Cardano/Wallet/DB/Store/Checkpoints.hs index 9fb4f20c92c..3ffdc8dfe35 100644 --- a/lib/wallet/src/Cardano/Wallet/DB/Store/Checkpoints.hs +++ b/lib/wallet/src/Cardano/Wallet/DB/Store/Checkpoints.hs @@ -100,6 +100,8 @@ import Cardano.Wallet.DB.Sqlite.Types ) import Cardano.Wallet.DB.Store.Info.Store ( mkStoreInfo ) +import Cardano.Wallet.DB.Store.PrivateKey.Store + ( mkStorePrivateKey ) import Cardano.Wallet.DB.Store.Submissions.Operations ( mkStoreSubmissions ) import Cardano.Wallet.DB.WalletState @@ -110,7 +112,7 @@ import Cardano.Wallet.DB.WalletState , getSlot ) import Cardano.Wallet.Flavor - ( KeyFlavorS (..) ) + ( KeyFlavorS (..), WalletFlavorS, keyOfWallet ) import Cardano.Wallet.Primitive.Types.TokenBundle ( TokenBundle ) import Cardano.Wallet.Primitive.Types.TokenMap @@ -119,6 +121,8 @@ import Cardano.Wallet.Read.NetworkId ( HasSNetworkId (..), NetworkDiscriminantCheck ) import Control.Monad ( forM, forM_, unless, void, when ) +import Control.Monad.Class.MonadThrow + ( throwIO ) import Control.Monad.Trans.Class ( lift ) import Control.Monad.Trans.Maybe @@ -178,8 +182,6 @@ import qualified Cardano.Wallet.Primitive.Types.Tx.TxOut as W ( TxOut (TxOut) ) import qualified Cardano.Wallet.Primitive.Types.Tx.TxOut as W.TxOut import qualified Cardano.Wallet.Primitive.Types.UTxO as W -import Control.Monad.Class.MonadThrow - ( throwIO ) import qualified Data.Map.Merge.Strict as Map import qualified Data.Map.Strict as Map @@ -190,13 +192,15 @@ import qualified Data.Map.Strict as Map -- | Store for 'WalletState' of a single wallet. mkStoreWallet :: forall s. PersistAddressBook s - => W.WalletId + => WalletFlavorS s + -> W.WalletId -> UpdateStore (SqlPersistT IO) (DeltaWalletState s) -mkStoreWallet wid = mkUpdateStore load write update +mkStoreWallet wF wid = mkUpdateStore load write update where checkpointsStore = mkStoreCheckpoints wid submissionsStore = mkStoreSubmissions wid infoStore = mkStoreInfo + pkStore = mkStorePrivateKey (keyOfWallet wF) wid load = do eprologue <- @@ -205,18 +209,21 @@ mkStoreWallet wid = mkUpdateStore load write update echeckpoints <- loadS checkpointsStore esubmissions <- loadS submissionsStore einfo <- loadS infoStore + ecredentials <- loadS pkStore pure $ WalletState <$> eprologue <*> echeckpoints <*> esubmissions <*> einfo + <*> ecredentials write wallet = do writeS infoStore (wallet ^. #info) insertPrologue wid (wallet ^. #prologue) writeS checkpointsStore (wallet ^. #checkpoints) writeS submissionsStore (wallet ^. #submissions) + writeS pkStore (wallet ^. #credentials) update = updateLoad load throwIO $ updateSequence update1 where @@ -229,6 +236,8 @@ mkStoreWallet wid = mkUpdateStore load write update (submissions s) deltas update1 _ (UpdateInfo delta) = updateS infoStore Nothing delta + update1 _ (UpdateCredentials delta) = do + updateS pkStore Nothing delta -- | Store for the 'Checkpoints' belonging to a 'WalletState'. mkStoreCheckpoints 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 5441639fdbf..f929740b820 100644 --- a/lib/wallet/src/Cardano/Wallet/DB/Store/PrivateKey/Store.hs +++ b/lib/wallet/src/Cardano/Wallet/DB/Store/PrivateKey/Store.hs @@ -3,7 +3,6 @@ {-# LANGUAGE MultiParamTypeClasses #-} {-# LANGUAGE RankNTypes #-} {-# LANGUAGE ScopedTypeVariables #-} -{-# LANGUAGE StandaloneDeriving #-} {-# LANGUAGE TypeFamilies #-} {-# LANGUAGE UndecidableInstances #-} @@ -12,27 +11,21 @@ -- License: Apache-2.0 module Cardano.Wallet.DB.Store.PrivateKey.Store ( mkStorePrivateKey - , PrivateKey (..) + , HashedCredentials (..) , DeltaPrivateKey , StorePrivateKey ) where import Prelude -import Cardano.Address.Derivation - ( XPrv ) -import Cardano.Wallet.Address.Derivation - ( Depth (..) ) import Cardano.Wallet.Address.Keys.PersistPrivateKey ( serializeXPrv, unsafeDeserializeXPrv ) -import Cardano.Wallet.DB.Errors - ( ErrWalletNotInitialized (ErrWalletNotInitialized) ) import Cardano.Wallet.Flavor ( KeyFlavorS ) -import Cardano.Wallet.Primitive.Passphrase.Types - ( PassphraseHash ) import Cardano.Wallet.Primitive.Types ( WalletId ) +import Cardano.Wallet.Primitive.Types.Credentials + ( Credentials (..), HashedCredentials (..) ) import Control.Exception ( SomeException (..) ) import Control.Monad.Class.MonadThrow @@ -48,14 +41,8 @@ import Database.Persist.Sql import qualified Cardano.Wallet.DB.Sqlite.Schema as Schema --- | A 'PrivateKey' for a given 'KeyFlavor'. -data PrivateKey k = PrivateKey (k 'RootK XPrv) PassphraseHash - -deriving instance Eq (k 'RootK XPrv) => Eq (PrivateKey k) -deriving instance Show (k 'RootK XPrv) => Show (PrivateKey k) - -- | A 'Delta' for 'PrivateKey'. -type DeltaPrivateKey k = Replace (PrivateKey k) +type DeltaPrivateKey k = Replace (Maybe (HashedCredentials k)) -- | A 'Store' for 'PrivateKey'. type StorePrivateKey k = UpdateStore (SqlPersistT IO) (DeltaPrivateKey k) @@ -71,29 +58,31 @@ mkStorePrivateKey -> StorePrivateKey k mkStorePrivateKey kF wid = mkUpdateStore load write update where - load :: SqlPersistT IO (Either SomeException (PrivateKey k)) + load :: SqlPersistT IO + (Either SomeException (Maybe (HashedCredentials k))) load = do keys <- selectFirst [] [] case keys of - Nothing -> pure $ Left $ SomeException ErrWalletNotInitialized - Just key -> pure $ Right $ privateKeyFromEntity $ entityVal key + Nothing -> pure $ Right Nothing + Just key -> pure $ Right $ Just + $ privateKeyFromEntity $ entityVal key where - privateKeyFromEntity :: Schema.PrivateKey -> PrivateKey k + privateKeyFromEntity :: Schema.PrivateKey -> HashedCredentials k privateKeyFromEntity (Schema.PrivateKey _ k h) = - uncurry PrivateKey $ unsafeDeserializeXPrv kF (k, h) + uncurry Credentials $ unsafeDeserializeXPrv kF (k, h) - write :: PrivateKey k -> SqlPersistT IO () - write key = do + write :: Maybe (HashedCredentials k) -> SqlPersistT IO () + write (Just key) = do deleteWhere ([] :: [Filter Schema.PrivateKey]) insert_ (mkPrivateKeyEntity key) + write Nothing = deleteWhere ([] :: [Filter Schema.PrivateKey]) - update :: Maybe (PrivateKey k) -> DeltaPrivateKey k -> SqlPersistT IO () + update :: Maybe (Maybe (HashedCredentials k)) + -> DeltaPrivateKey k -> SqlPersistT IO () update = updateLoad load throwIO $ \_ -> \case - Replace key -> do - deleteWhere ([] :: [Filter Schema.PrivateKey]) - insert_ (mkPrivateKeyEntity key) + Replace key -> write key - mkPrivateKeyEntity (PrivateKey k h) = + mkPrivateKeyEntity (Credentials k h) = Schema.PrivateKey { Schema.privateKeyWalletId = wid , Schema.privateKeyRootKey = root diff --git a/lib/wallet/src/Cardano/Wallet/DB/WalletState.hs b/lib/wallet/src/Cardano/Wallet/DB/WalletState.hs index 7a45cca1e9b..8d800d2dc08 100644 --- a/lib/wallet/src/Cardano/Wallet/DB/WalletState.hs +++ b/lib/wallet/src/Cardano/Wallet/DB/WalletState.hs @@ -1,8 +1,11 @@ +{-# LANGUAGE DataKinds #-} {-# LANGUAGE DeriveGeneric #-} +{-# LANGUAGE FlexibleContexts #-} {-# LANGUAGE NamedFieldPuns #-} {-# LANGUAGE OverloadedLabels #-} {-# LANGUAGE StandaloneDeriving #-} {-# LANGUAGE TypeFamilies #-} +{-# LANGUAGE UndecidableInstances #-} -- | -- Copyright: © 2022 IOHK @@ -39,16 +42,24 @@ module Cardano.Wallet.DB.WalletState import Prelude +import Cardano.Address.Derivation + ( XPrv ) import Cardano.Wallet.Address.Book ( AddressBookIso (..), Discoveries, Prologue ) +import Cardano.Wallet.Address.Derivation + ( Depth (RootK) ) import Cardano.Wallet.Checkpoints ( Checkpoints ) import Cardano.Wallet.DB.Store.Info.Store ( DeltaWalletInfo, WalletInfo (..) ) +import Cardano.Wallet.DB.Store.PrivateKey.Store + ( DeltaPrivateKey, HashedCredentials ) import Cardano.Wallet.DB.Store.Submissions.Layer ( emptyTxSubmissions ) import Cardano.Wallet.DB.Store.Submissions.Operations ( DeltaTxSubmissions, TxSubmissions ) +import Cardano.Wallet.Flavor + ( KeyOf ) import Cardano.Wallet.Primitive.Types ( BlockHeader ) import Cardano.Wallet.Primitive.Types.UTxO @@ -121,9 +132,12 @@ data WalletState s = WalletState , checkpoints :: !(Checkpoints (WalletCheckpoint s)) , submissions :: !TxSubmissions , info :: !WalletInfo + , credentials :: Maybe (HashedCredentials (KeyOf s)) } deriving (Generic) -deriving instance AddressBookIso s => Eq (WalletState s) +deriving instance + (AddressBookIso s, Eq (KeyOf s 'RootK XPrv)) + => Eq (WalletState s) -- | Create a wallet from the genesis block. fromGenesis @@ -139,6 +153,7 @@ fromGenesis cp winfo , checkpoints = CPS.fromGenesis checkpoint , submissions = emptyTxSubmissions , info = winfo + , credentials = Nothing } | otherwise = Nothing where @@ -166,6 +181,7 @@ data DeltaWalletState1 s -- ^ Update the wallet checkpoints. | UpdateSubmissions DeltaTxSubmissions | UpdateInfo DeltaWalletInfo + | UpdateCredentials (DeltaPrivateKey (KeyOf s)) instance Delta (DeltaWalletState1 s) where type Base (DeltaWalletState1 s) = WalletState s @@ -173,12 +189,14 @@ instance Delta (DeltaWalletState1 s) where apply (UpdateCheckpoints d) = over #checkpoints $ apply d apply (UpdateSubmissions d) = over #submissions $ apply d apply (UpdateInfo d) = over #info $ apply d + apply (UpdateCredentials d) = over #credentials $ apply d -instance Buildable (DeltaWalletState1 s) where +instance Buildable (DeltaWalletState1 s) where build (ReplacePrologue _) = "ReplacePrologue …" build (UpdateCheckpoints d) = "UpdateCheckpoints (" <> build d <> ")" build (UpdateSubmissions d) = "UpdateSubmissions (" <> build d <> ")" build (UpdateInfo d) = "UpdateInfo (" <> build d <> ")" + build (UpdateCredentials _d) = "UpdatePrivateKey" instance Show (DeltaWalletState1 s) where show = pretty diff --git a/lib/wallet/src/Cardano/Wallet/Primitive/Types/Credentials.hs b/lib/wallet/src/Cardano/Wallet/Primitive/Types/Credentials.hs new file mode 100644 index 00000000000..d0fd625cb1b --- /dev/null +++ b/lib/wallet/src/Cardano/Wallet/Primitive/Types/Credentials.hs @@ -0,0 +1,34 @@ +{-# LANGUAGE DataKinds #-} +{-# LANGUAGE StandaloneDeriving #-} +{-# LANGUAGE UndecidableInstances #-} + +module Cardano.Wallet.Primitive.Types.Credentials + ( Credentials (..) + , PrivateKey + , HashedCredentials + , ClearCredentials) where + +import Prelude + + +import Cardano.Address.Derivation + ( XPrv ) +import Cardano.Wallet.Address.Derivation + ( Depth (RootK) ) +import Cardano.Wallet.Primitive.Passphrase.Types + ( Passphrase, PassphraseHash ) + +type PrivateKey k = k 'RootK XPrv + +-- | A 'PrivateKey' for a given 'KeyFlavor'. +data Credentials k pw = Credentials + { credentialsKey :: PrivateKey k + , credentialsPassword :: pw + } + +deriving instance (Eq (PrivateKey k), Eq pw) => Eq (Credentials k pw) +deriving instance (Show (PrivateKey k), Show pw) => Show (Credentials k pw) + +type HashedCredentials k = Credentials k PassphraseHash + +type ClearCredentials k = Credentials k (Passphrase "encryption") diff --git a/lib/wallet/test/unit/Cardano/Wallet/DB/Sqlite/StoresSpec.hs b/lib/wallet/test/unit/Cardano/Wallet/DB/Sqlite/StoresSpec.hs index 86c606511ad..7b8b36de294 100644 --- a/lib/wallet/test/unit/Cardano/Wallet/DB/Sqlite/StoresSpec.hs +++ b/lib/wallet/test/unit/Cardano/Wallet/DB/Sqlite/StoresSpec.hs @@ -10,10 +10,14 @@ module Cardano.Wallet.DB.Sqlite.StoresSpec import Prelude +import Cardano.Address.Derivation + ( XPrv ) import Cardano.DB.Sqlite ( ForeignKeysSetting (..), SqliteContext (runQuery) ) import Cardano.Wallet.Address.Book ( AddressBookIso (..), Prologue, getPrologue ) +import Cardano.Wallet.Address.Derivation + ( Depth (RootK) ) import Cardano.Wallet.Address.Derivation.Shared ( SharedKey ) import Cardano.Wallet.Address.Derivation.Shelley @@ -44,6 +48,8 @@ import Cardano.Wallet.DB.WalletState ) import Cardano.Wallet.DummyTarget.Primitive.Types ( dummyGenesisParameters ) +import Cardano.Wallet.Flavor + ( KeyOf, WalletFlavorS (ShelleyWallet) ) import Cardano.Wallet.Primitive.Types ( SlotNo (..), WalletId (..), WithOrigin (..) ) import Cardano.Wallet.Read.NetworkId @@ -100,7 +106,7 @@ spec = do around (withDBInMemory ForeignKeysEnabled) $ do describe "Update" $ do it "mkStoreWallet" $ - property . prop_StoreWallet @(SeqState 'Mainnet ShelleyKey) + property . prop_StoreWallet (ShelleyWallet @'Mainnet) {------------------------------------------------------------------------------- Properties @@ -148,11 +154,13 @@ prop_StoreWallet :: forall s . ( PersistAddressBook s , GenState s + , Eq (KeyOf s 'RootK XPrv) ) - => SqliteContext + => WalletFlavorS s + -> SqliteContext -> (WalletId, InitialCheckpoint s) -> Property -prop_StoreWallet db (wid, InitialCheckpoint cp0) = +prop_StoreWallet wF db (wid, InitialCheckpoint cp0) = monadicIO (setup >> prop) where toIO = runQuery db @@ -166,7 +174,7 @@ prop_StoreWallet db (wid, InitialCheckpoint cp0) = prop = do prop_StoreUpdates toIO - (mkStoreWallet wid) + (mkStoreWallet wF wid) genState genDeltaWalletState 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 95b6710eed3..7c3dd740964 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,11 +34,13 @@ import Cardano.Wallet.DB.Fixtures , withInitializedWalletProp ) import Cardano.Wallet.DB.Store.PrivateKey.Store - ( DeltaPrivateKey, PrivateKey (..), mkStorePrivateKey ) + ( DeltaPrivateKey, HashedCredentials, mkStorePrivateKey ) import Cardano.Wallet.Flavor ( KeyFlavorS (..) ) import Cardano.Wallet.Primitive.Types ( WalletId ) +import Cardano.Wallet.Primitive.Types.Credentials + ( Credentials (Credentials) ) import Data.Delta ( Replace (..) ) import Fmt @@ -82,14 +84,14 @@ propStore runQ wid kF = genPrivateKey (logScale . genDelta) -genPrivateKey :: Arbitrary (k 'RootK XPrv) => Gen (PrivateKey k) -genPrivateKey = PrivateKey <$> arbitrary <*> arbitrary +genPrivateKey :: Arbitrary (k 'RootK XPrv) => Gen (Maybe (HashedCredentials k)) +genPrivateKey = fmap Just $ Credentials <$> arbitrary <*> arbitrary instance Buildable (DeltaPrivateKey k) where build _ = "DeltaPrivateKey" genDelta :: Arbitrary (k 'RootK XPrv) - => PrivateKey k + => (Maybe (HashedCredentials k)) -> Gen (DeltaPrivateKey k) genDelta _ = Replace <$> genPrivateKey