diff --git a/src/Cardano/Wallet/API/V1/Handlers/Accounts.hs b/src/Cardano/Wallet/API/V1/Handlers/Accounts.hs index c841ddc3adc..a7523fcfeb2 100644 --- a/src/Cardano/Wallet/API/V1/Handlers/Accounts.hs +++ b/src/Cardano/Wallet/API/V1/Handlers/Accounts.hs @@ -63,8 +63,7 @@ newAccount :: PassiveWalletLayer IO -> NewAccount -> Handler (WalletResponse Account) newAccount layer wId newAccountRequest = do - let req = WalletLayer.CreateHdAccountRandomIndex newAccountRequest - res <- liftIO $ WalletLayer.createAccount layer wId req + res <- liftIO $ WalletLayer.createAccount layer wId newAccountRequest case res of Left e -> throwM e Right account -> return $ single account diff --git a/src/Cardano/Wallet/Kernel/Accounts.hs b/src/Cardano/Wallet/Kernel/Accounts.hs index b99622c4800..1426af025e4 100644 --- a/src/Cardano/Wallet/Kernel/Accounts.hs +++ b/src/Cardano/Wallet/Kernel/Accounts.hs @@ -1,6 +1,5 @@ module Cardano.Wallet.Kernel.Accounts ( - createHdRandomAccount - , createHdFixedAccount + createAccount , deleteAccount , updateAccount -- * Errors @@ -17,6 +16,8 @@ import System.Random.MWC (GenIO, createSystemRandom, uniformR) import Data.Acid (update) +import Pos.Crypto (EncryptedSecretKey, PassPhrase) + import Cardano.Wallet.Kernel.DB.AcidState (CreateHdAccount (..), DB, DeleteHdAccount (..), UpdateHdAccountName (..)) import Cardano.Wallet.Kernel.DB.HdWallet (AccountName (..), @@ -43,9 +44,6 @@ data CreateAccountError = | CreateAccountKeystoreNotFound WalletId -- ^ When trying to create the 'Account', the 'Keystore' didn't have -- any secret associated with the input 'WalletId'. - | CreateAccountAlreadyExists HdRootId HdAccountIx - -- ^ When creating a certain account, the account already existed in - -- the database. | CreateAccountHdRndAccountSpaceSaturated HdRootId -- ^ The available number of HD accounts in use is such that trying -- to find another random index would be too expensive. @@ -59,8 +57,6 @@ instance Buildable CreateAccountError where bprint ("CreateAccountUnknownHdRoot " % F.build) uRoot build (CreateAccountKeystoreNotFound accId) = bprint ("CreateAccountKeystoreNotFound " % F.build) accId - build (CreateAccountAlreadyExists rootId accId) = - bprint ("CreateAccountAlreadyExists " % F.build % F.build) rootId accId build (CreateAccountHdRndAccountSpaceSaturated hdAcc) = bprint ("CreateAccountHdRndAccountSpaceSaturated " % F.build) hdAcc @@ -69,95 +65,68 @@ instance Show CreateAccountError where instance Exception CreateAccountError - -createHdRandomAccount :: AccountName - -- ^ The name for this account. - -> WalletId - -- ^ An abstract notion of a 'Wallet identifier - -> PassiveWallet - -> IO (Either CreateAccountError HdAccount) -createHdRandomAccount = createAccount newHdRndAccount - --- | Creates an 'HdAccount' from a @fixed@ index. Note how, despite tempting, --- it's incorrect to call this @sequential generation@, as in such case the --- index wouldn't be passed but merely an internal detail of such function. --- @fixed@ here really means "externally provided". -createHdFixedAccount :: HdAccountIx - -- ^ The account index to target - -> AccountName - -- ^ The name for this account. - -> WalletId - -- ^ An abstract notion of a 'Wallet identifier - -> PassiveWallet - -> IO (Either CreateAccountError HdAccount) -createHdFixedAccount newIndex = createAccount (newHdFixedAccount newIndex) - - -type MkNewAccount = AccountName - -> HdRootId - -> PassiveWallet - -> IO (Either CreateAccountError HdAccount) - -- | Creates a new 'Account' for the input wallet. -- Note: @it does not@ generate a new 'Address' to go in tandem with this --- 'Account'. This will be responsibility of the caller. -createAccount :: MkNewAccount - -- ^ A function to create the account. +-- 'Account'. This will be responsibility of the wallet layer. +createAccount :: PassPhrase + -- ^ The 'Passphrase' (a.k.a the \"Spending Password\"). -> AccountName -- ^ The name for this account. -> WalletId -- ^ An abstract notion of a 'Wallet identifier -> PassiveWallet - -> IO (Either CreateAccountError HdAccount) -createAccount creationFunction accountName walletId pw = do + -> IO (Either CreateAccountError (DB, HdAccount)) +createAccount spendingPassword accountName walletId pw = do let keystore = pw ^. walletKeystore case walletId of WalletIdHdRnd hdRootId -> do mbEsk <- Keystore.lookup (WalletIdHdRnd hdRootId) keystore case mbEsk of Nothing -> return (Left $ CreateAccountKeystoreNotFound walletId) - Just _ -> creationFunction accountName hdRootId pw - --- | Creates a new 'Account' using a fixed (given) index. -newHdFixedAccount :: HdAccountIx - -> AccountName - -> HdRootId - -> PassiveWallet - -> IO (Either CreateAccountError HdAccount) -newHdFixedAccount newIndex accountName rootId pw = do - let onFailure err = case err of - CreateHdAccountExists _ -> - -- Nothing we can do; we were asked to create a specific account - -- with a specific index, but there was a collision in the DB - return (Left $ CreateAccountAlreadyExists rootId newIndex) - CreateHdAccountUnknownRoot _ -> - return (Left $ CreateAccountUnknownHdRoot rootId) - tryGenerateAccount onFailure newIndex rootId accountName pw + Just esk -> + createHdRndAccount spendingPassword + accountName + esk + hdRootId + pw -- | Creates a new 'Account' using the random HD derivation under the hood. -- This code follows the same pattern of 'createHdRndAddress', but the two -- functions are "similarly different" enough to not make convenient generalise -- the code. -newHdRndAccount :: AccountName - -> HdRootId - -> PassiveWallet - -> IO (Either CreateAccountError HdAccount) -newHdRndAccount accountName rootId pw = do +createHdRndAccount :: PassPhrase + -> AccountName + -> EncryptedSecretKey + -> HdRootId + -> PassiveWallet + -> IO (Either CreateAccountError (DB, HdAccount)) +createHdRndAccount _spendingPassword accountName _esk rootId pw = do gen <- createSystemRandom go gen 0 where - go :: GenIO -> Word32 -> IO (Either CreateAccountError HdAccount) + go :: GenIO -> Word32 -> IO (Either CreateAccountError (DB, HdAccount)) go gen collisions = case collisions >= maxAllowedCollisions of True -> return $ Left (CreateAccountHdRndAccountSpaceSaturated rootId) - False -> do - let onFailure err = case err of - CreateHdAccountExists _ -> - go gen (succ collisions) - CreateHdAccountUnknownRoot _ -> - return (Left $ CreateAccountUnknownHdRoot rootId) - newIndex <- deriveIndex (flip uniformR gen) HdAccountIx HardDerivation - tryGenerateAccount onFailure newIndex rootId accountName pw + False -> tryGenerateAccount gen collisions + + tryGenerateAccount :: GenIO + -> Word32 + -- ^ The current number of collisions + -> IO (Either CreateAccountError (DB, HdAccount)) + tryGenerateAccount gen collisions = do + newIndex <- deriveIndex (flip uniformR gen) HdAccountIx HardDerivation + let hdAccountId = HdAccountId rootId newIndex + newAccount = initHdAccount hdAccountId initState & + hdAccountName .~ accountName + db = pw ^. wallets + res <- update db (CreateHdAccount newAccount) + case res of + (Left (CreateHdAccountExists _)) -> + go gen (succ collisions) + (Left (CreateHdAccountUnknownRoot _)) -> + return (Left $ CreateAccountUnknownHdRoot rootId) + Right (db', ()) -> return (Right (db', newAccount)) -- The maximum number of allowed collisions. This number was -- empirically calculated based on a [beta distribution](https://en.wikipedia.org/wiki/Beta_distribution). @@ -169,30 +138,11 @@ newHdRndAccount accountName rootId pw = do maxAllowedCollisions :: Word32 maxAllowedCollisions = 42 -tryGenerateAccount :: (CreateHdAccountError -> IO (Either CreateAccountError HdAccount)) - -- ^ An action to be run in case of errors - -> HdAccountIx - -> HdRootId - -> AccountName - -- ^ The requested index - -> PassiveWallet - -> IO (Either CreateAccountError HdAccount) -tryGenerateAccount onFailure newIndex rootId accountName pw = do - let hdAccountId = HdAccountId rootId newIndex - newAccount = initHdAccount hdAccountId initialAccountState & - hdAccountName .~ accountName - db = pw ^. wallets - res <- update db (CreateHdAccount newAccount) - case res of - (Left e) -> onFailure e - Right () -> return (Right newAccount) - where - initialAccountState :: HdAccountState - initialAccountState = HdAccountStateUpToDate HdAccountUpToDate { - _hdUpToDateCheckpoints = Checkpoints . one $ initCheckpoint mempty - } - - + -- Initial account state + initState :: HdAccountState + initState = HdAccountStateUpToDate HdAccountUpToDate { + _hdUpToDateCheckpoints = Checkpoints . one $ initCheckpoint mempty + } -- | Deletes an HD 'Account' from the data storage. deleteAccount :: HdAccountId diff --git a/src/Cardano/Wallet/Kernel/Addresses.hs b/src/Cardano/Wallet/Kernel/Addresses.hs index dd175682c27..9fa819e334e 100644 --- a/src/Cardano/Wallet/Kernel/Addresses.hs +++ b/src/Cardano/Wallet/Kernel/Addresses.hs @@ -1,5 +1,6 @@ module Cardano.Wallet.Kernel.Addresses ( - createAddress + createAddress + , newHdAddress -- * Errors , CreateAddressError(..) ) where @@ -15,13 +16,13 @@ import System.Random.MWC (GenIO, createSystemRandom, uniformR) import Data.Acid (update) -import Pos.Core (IsBootstrapEraAddr (..), deriveLvl2KeyPair) +import Pos.Core (Address, IsBootstrapEraAddr (..), deriveLvl2KeyPair) import Pos.Crypto (EncryptedSecretKey, PassPhrase, ShouldCheckPassphrase (..)) import Cardano.Wallet.Kernel.DB.AcidState (CreateHdAddress (..)) import Cardano.Wallet.Kernel.DB.HdWallet (HdAccountId, - HdAccountIx (..), HdAddress (..), HdAddressId (..), + HdAccountIx (..), HdAddress, HdAddressId (..), HdAddressIx (..), hdAccountIdIx, hdAccountIdParent, hdAddressIdIx) import Cardano.Wallet.Kernel.DB.HdWallet.Create @@ -32,6 +33,7 @@ import Cardano.Wallet.Kernel.Internal (PassiveWallet, walletKeystore, wallets) import qualified Cardano.Wallet.Kernel.Keystore as Keystore import Cardano.Wallet.Kernel.Types (AccountId (..), WalletId (..)) +import Cardano.Wallet.WalletLayer.Kernel.Conv (toCardanoAddress) import Test.QuickCheck (Arbitrary (..), oneof) @@ -76,7 +78,7 @@ createAddress :: PassPhrase -> AccountId -- ^ An abstract notion of an 'Account' identifier -> PassiveWallet - -> IO (Either CreateAddressError HdAddress) + -> IO (Either CreateAddressError Address) createAddress spendingPassword accId pw = do let keystore = pw ^. walletKeystore case accId of @@ -101,9 +103,7 @@ createAddress spendingPassword accId pw = do keystore case mbEsk of Nothing -> return (Left $ CreateAddressKeystoreNotFound accId) - Just esk -> - createHdRndAddress spendingPassword esk hdAccId pw - + Just esk -> createHdRndAddress spendingPassword esk hdAccId pw -- | Creates a new 'Address' using the random HD derivation under the hood. -- Being this an operation bound not only by the number of available derivation @@ -119,12 +119,12 @@ createHdRndAddress :: PassPhrase -> EncryptedSecretKey -> HdAccountId -> PassiveWallet - -> IO (Either CreateAddressError HdAddress) + -> IO (Either CreateAddressError Address) createHdRndAddress spendingPassword esk accId pw = do gen <- createSystemRandom go gen 0 where - go :: GenIO -> Word32 -> IO (Either CreateAddressError HdAddress) + go :: GenIO -> Word32 -> IO (Either CreateAddressError Address) go gen collisions = case collisions >= maxAllowedCollisions of True -> return $ Left (CreateAddressHdRndAddressSpaceSaturated accId) @@ -133,20 +133,14 @@ createHdRndAddress spendingPassword esk accId pw = do tryGenerateAddress :: GenIO -> Word32 -- ^ The current number of collisions - -> IO (Either CreateAddressError HdAddress) + -> IO (Either CreateAddressError Address) tryGenerateAddress gen collisions = do newIndex <- deriveIndex (flip uniformR gen) HdAddressIx HardDerivation let hdAddressId = HdAddressId accId newIndex - mbAddr = deriveLvl2KeyPair (IsBootstrapEraAddr True) - (ShouldCheckPassphrase True) - spendingPassword - esk - (accId ^. hdAccountIdIx . to getHdAccountIx) - (hdAddressId ^. hdAddressIdIx . to getHdAddressIx) + mbAddr = newHdAddress esk spendingPassword accId hdAddressId case mbAddr of Nothing -> return (Left $ CreateAddressHdRndGenerationFailed accId) - Just (newAddress, _) -> do - let hdAddress = initHdAddress hdAddressId newAddress + Just hdAddress -> do let db = pw ^. wallets res <- update db (CreateHdAddress hdAddress) case res of @@ -154,8 +148,27 @@ createHdRndAddress spendingPassword esk accId pw = do go gen (succ collisions) (Left (CreateHdAddressUnknown _)) -> return (Left $ CreateAddressUnknownHdAccount accId) - Right () -> return . Right $ hdAddress + Right () -> return (Right $ toCardanoAddress hdAddress) -- The maximum number of allowed collisions. maxAllowedCollisions :: Word32 maxAllowedCollisions = 1024 + + +-- | Generates a new 'HdAddress' by performing the HD crypto derivation +-- underneath. Returns 'Nothing' if the cryptographic derivation fails. +newHdAddress :: EncryptedSecretKey + -> PassPhrase + -> HdAccountId + -> HdAddressId + -> Maybe HdAddress +newHdAddress esk spendingPassword accId hdAddressId = + let mbAddr = deriveLvl2KeyPair (IsBootstrapEraAddr True) + (ShouldCheckPassphrase True) + spendingPassword + esk + (accId ^. hdAccountIdIx . to getHdAccountIx) + (hdAddressId ^. hdAddressIdIx . to getHdAddressIx) + in case mbAddr of + Nothing -> Nothing + Just (newAddress, _) -> Just $ initHdAddress hdAddressId newAddress diff --git a/src/Cardano/Wallet/Kernel/DB/AcidState.hs b/src/Cardano/Wallet/Kernel/DB/AcidState.hs index 00a88f4597b..68def0a632f 100644 --- a/src/Cardano/Wallet/Kernel/DB/AcidState.hs +++ b/src/Cardano/Wallet/Kernel/DB/AcidState.hs @@ -66,7 +66,7 @@ import Cardano.Wallet.Kernel.DB.HdWallet import qualified Cardano.Wallet.Kernel.DB.HdWallet.Create as HD import qualified Cardano.Wallet.Kernel.DB.HdWallet.Delete as HD import qualified Cardano.Wallet.Kernel.DB.HdWallet.Update as HD -import Cardano.Wallet.Kernel.DB.InDb (InDb (InDb)) +import Cardano.Wallet.Kernel.DB.InDb (InDb (InDb), fromDb) import Cardano.Wallet.Kernel.DB.Spec import Cardano.Wallet.Kernel.DB.Spec.Pending (Pending) import qualified Cardano.Wallet.Kernel.DB.Spec.Update as Spec @@ -432,13 +432,26 @@ observableRollbackUseInTestsOnly = runUpdateDiscardSnapshot $ -- NOTE: We allow an initial set of accounts with associated addresses and -- balances /ONLY/ for testing purpose. Normally this should be empty; see -- 'createHdWallet'/'createWalletHdRnd' in "Cardano.Wallet.Kernel.Wallets". +-- +-- INVARIANT: Creating a new wallet always come with a fresh HdAccount and +-- a fresh 'HdAddress' attached to it, so we have to pass these two extra +-- piece of into to the update function. We do @not@ build these inside the +-- update function because derivation requires an 'EncryptedSecretKey' and +-- definitely we do not want it to show up in our acid-state logs. +-- createHdWallet :: HdRoot + -> HdAccountId + -- ^ The default HdAccountId to go with this HdRoot. This + -- function will take responsibility of creating the associated + -- 'HdAccount'. + -> HdAddress + -- ^ The default HdAddress to go with this HdRoot. -> Map HdAccountId (Utxo,[AddrWithId]) -> Update DB (Either HD.CreateHdRootError ()) -createHdWallet newRoot utxoByAccount = +createHdWallet newRoot defaultHdAccountId defaultHdAddress utxoByAccount = runUpdateDiscardSnapshot . zoom dbHdWallets $ do HD.createHdRoot newRoot - updateAccounts_ $ map mkUpdate (Map.toList utxoByAccount) + updateAccounts_ $ map mkUpdate (Map.toList (insertDefault utxoByAccount)) where mkUpdate :: (HdAccountId, (Utxo, [AddrWithId])) -> AccountUpdate HD.CreateHdRootError () @@ -449,16 +462,41 @@ createHdWallet newRoot utxoByAccount = , accountUpdate = return () -- just need to create it, no more } + insertDefault :: Map HdAccountId (Utxo, [AddrWithId]) + -> Map HdAccountId (Utxo, [AddrWithId]) + insertDefault m = + let defaultAddr = ( defaultHdAddress ^. hdAddressId + , defaultHdAddress ^. hdAddressAddress . fromDb + ) + in case Map.lookup defaultHdAccountId m of + Just (utxo, addrs) -> + Map.insert defaultHdAccountId (utxo, defaultAddr : addrs) m + Nothing -> + Map.insert defaultHdAccountId (mempty, [defaultAddr]) m + -- | Begin restoration by creating an HdWallet with the given HdRoot, -- starting from the 'HdAccountOutsideK' state. +-- +-- INVARIANT: Creating a new wallet always come with a fresh HdAccount and +-- a fresh 'HdAddress' attached to it, so we have to pass these two extra +-- piece of into to the update function. We do @not@ build these inside the +-- update function because derivation requires an 'EncryptedSecretKey' and +-- definitely we do not want it to show up in our acid-state logs. +-- restoreHdWallet :: HdRoot + -> HdAccountId + -- ^ The default HdAccountId to go with this HdRoot. This + -- function will take responsibility of creating the associated + -- 'HdAccount'. + -> HdAddress + -- ^ The default HdAddress to go with this HdRoot -> Map HdAccountId (Utxo, Utxo, [AddrWithId]) -- ^ Current and genesis UTxO per account -> Update DB (Either HD.CreateHdRootError ()) -restoreHdWallet newRoot utxoByAccount = +restoreHdWallet newRoot defaultHdAccountId defaultHdAddress utxoByAccount = runUpdateDiscardSnapshot . zoom dbHdWallets $ do HD.createHdRoot newRoot - updateAccounts_ $ map mkUpdate (Map.toList utxoByAccount) + updateAccounts_ $ map mkUpdate (Map.toList (insertDefault utxoByAccount)) where mkUpdate :: (HdAccountId, (Utxo, Utxo, [AddrWithId])) -> AccountUpdate HD.CreateHdRootError () @@ -469,6 +507,18 @@ restoreHdWallet newRoot utxoByAccount = , accountUpdate = return () -- Create it only } + insertDefault :: Map HdAccountId (Utxo, Utxo, [AddrWithId]) + -> Map HdAccountId (Utxo, Utxo, [AddrWithId]) + insertDefault m = + let defaultAddr = ( defaultHdAddress ^. hdAddressId + , defaultHdAddress ^. hdAddressAddress . fromDb + ) + in case Map.lookup defaultHdAccountId m of + Just (utxo, utxo', addrs) -> + Map.insert defaultHdAccountId (utxo, utxo', defaultAddr : addrs) m + Nothing -> + Map.insert defaultHdAccountId (mempty, mempty, [defaultAddr]) m + {------------------------------------------------------------------------------- Internal: support for updating accounts -------------------------------------------------------------------------------} @@ -571,12 +621,8 @@ updateAccounts_ = mapM_ updateAccount Wrap HD C(R)UD operations -------------------------------------------------------------------------------} -createHdRoot :: HdRoot -> Update DB (Either HD.CreateHdRootError ()) -createHdRoot hdRoot = runUpdateDiscardSnapshot . zoom dbHdWallets $ - HD.createHdRoot hdRoot - -createHdAccount :: HdAccount -> Update DB (Either HD.CreateHdAccountError ()) -createHdAccount hdAccount = runUpdateDiscardSnapshot . zoom dbHdWallets $ +createHdAccount :: HdAccount -> Update DB (Either HD.CreateHdAccountError (DB, ())) +createHdAccount hdAccount = runUpdate' . zoom dbHdWallets $ HD.createHdAccount hdAccount createHdAddress :: HdAddress -> Update DB (Either HD.CreateHdAddressError ()) @@ -662,7 +708,6 @@ makeAcidic ''DB [ , 'applyHistoricalBlock , 'restorationComplete -- Updates on HD wallets - , 'createHdRoot , 'createHdAddress , 'createHdAccount , 'createHdWallet diff --git a/src/Cardano/Wallet/Kernel/DB/HdWallet/Create.hs b/src/Cardano/Wallet/Kernel/DB/HdWallet/Create.hs index 2696c9e682f..9a05500ad02 100644 --- a/src/Cardano/Wallet/Kernel/DB/HdWallet/Create.hs +++ b/src/Cardano/Wallet/Kernel/DB/HdWallet/Create.hs @@ -67,9 +67,9 @@ deriveSafeCopy 1 'base ''CreateHdAddressError CREATE -------------------------------------------------------------------------------} --- | Create a new wallet +-- | Create a new wallet. createHdRoot :: HdRoot -> Update' CreateHdRootError HdWallets () -createHdRoot hdRoot = +createHdRoot hdRoot = do zoom hdWalletsRoots $ do exists <- gets $ IxSet.member rootId when exists $ throwError $ CreateHdRootExists rootId diff --git a/src/Cardano/Wallet/Kernel/Restore.hs b/src/Cardano/Wallet/Kernel/Restore.hs index 641f13b63ee..f66053343ab 100644 --- a/src/Cardano/Wallet/Kernel/Restore.hs +++ b/src/Cardano/Wallet/Kernel/Restore.hs @@ -51,7 +51,7 @@ import Pos.Chain.Block (Block, Blund, HeaderHash, MainBlock, Undo, headerHash, mainBlockSlot) import Pos.Chain.Txp (TxIn (..), TxOut (..), TxOutAux (..), Utxo, genesisUtxo) -import Pos.Core as Core (BlockCount (..), Coin, Config (..), +import Pos.Core as Core (Address, BlockCount (..), Coin, Config (..), GenesisHash, SlotId, flattenSlotId, mkCoin, unsafeIntegerToCoin) import Pos.Crypto (EncryptedSecretKey) @@ -70,25 +70,38 @@ import Pos.Util.Trace (Severity (Error)) -- background thread that will asynchronously restore the wallet history. -- -- Wallet initialization parameters match those of 'createWalletHdRnd' +-- NOTE: We pass in a fresh 'Address' which will be used to initialise the +-- companion 'HdAccount' this wallet will be created with. The reason why +-- we do this is that, if we were to use the 'PassPhrase' directly, it would +-- have been impossible for upstream code dealing with migrations to call +-- this function, as during migration time you don't have access to the +-- users' spending passwords. +-- During migration, instead, you can pick one of the @existing@ addresses +-- in the legacy wallet layer, and use it as input. restoreWallet :: Kernel.PassiveWallet - -> Bool -- ^ Spending password + -> Bool + -- ^ Did this wallet have a spending password set? + -> Address + -- ^ The stock address to use for the companion 'HdAccount'. -> HD.WalletName -> HD.AssuranceLevel -> EncryptedSecretKey -> (Blund -> IO (Map HD.HdAccountId PrefilteredBlock, [TxMeta])) -> IO (Either CreateHdRootError (HD.HdRoot, Coin)) -restoreWallet pw spendingPass name assurance esk prefilter = do +restoreWallet pw hasSpendingPassword defaultCardanoAddress name assurance esk prefilter = do coreConfig <- getCoreConfig (pw ^. walletNode) walletInitInfo <- withNodeState (pw ^. walletNode) $ getWalletInitInfo coreConfig wkey case walletInitInfo of WalletCreate utxos -> do - root <- createWalletHdRnd pw spendingPass name assurance esk $ \root -> - Left $ CreateHdWallet root utxos + root <- createWalletHdRnd pw hasSpendingPassword defaultCardanoAddress name assurance esk $ + \root defaultHdAccount defaultHdAddress -> + Left $ CreateHdWallet root defaultHdAccount defaultHdAddress utxos return $ fmap (, mkCoin 0) root WalletRestore utxos (tgtTip, tgtSlot) -> do -- Create the wallet - mRoot <- createWalletHdRnd pw spendingPass name assurance esk $ \root -> - Right $ RestoreHdWallet root utxos + mRoot <- createWalletHdRnd pw hasSpendingPassword defaultCardanoAddress name assurance esk $ + \root defaultHdAccount defaultHdAddress -> + Right $ RestoreHdWallet root defaultHdAccount defaultHdAddress utxos case mRoot of Left err -> return (Left err) Right root -> do diff --git a/src/Cardano/Wallet/Kernel/Transactions.hs b/src/Cardano/Wallet/Kernel/Transactions.hs index c0a5db2ab99..834fbe912f3 100644 --- a/src/Cardano/Wallet/Kernel/Transactions.hs +++ b/src/Cardano/Wallet/Kernel/Transactions.hs @@ -68,8 +68,7 @@ import Cardano.Wallet.Kernel.Types (AccountId (..), RawResolvedTx (..), WalletId (..)) import Cardano.Wallet.Kernel.Util (shuffleNE) import Cardano.Wallet.Kernel.Util.Core -import Cardano.Wallet.WalletLayer.Kernel.Conv (exceptT, - toCardanoAddress) +import Cardano.Wallet.WalletLayer.Kernel.Conv (exceptT) {------------------------------------------------------------------------------- Generating payments and estimating fees @@ -255,10 +254,9 @@ newTransaction ActiveWallet{..} spendingPassword options accountId payees = runE genChangeAddr :: MonadIO m => ExceptT Kernel.CreateAddressError m Address genChangeAddr = ExceptT $ liftIO $ - fmap toCardanoAddress <$> - Kernel.createAddress spendingPassword - (AccountIdHdRnd accountId) - walletPassive + Kernel.createAddress spendingPassword + (AccountIdHdRnd accountId) + walletPassive -- | This is called when we create a new Pending Transaction. -- This actually returns a function because we don`t know yet our outputs. @@ -496,7 +494,7 @@ redeemAda w@ActiveWallet{..} accId pw rsk = runExceptT $ do pw (AccountIdHdRnd accId) walletPassive - (tx, meta) <- mkTx (toCardanoAddress changeAddr) + (tx, meta) <- mkTx changeAddr withExceptT RedeemAdaNewForeignFailed $ ExceptT $ liftIO $ newForeign w diff --git a/src/Cardano/Wallet/Kernel/Wallets.hs b/src/Cardano/Wallet/Kernel/Wallets.hs index 640d91dfae6..a0b692453dc 100644 --- a/src/Cardano/Wallet/Kernel/Wallets.hs +++ b/src/Cardano/Wallet/Kernel/Wallets.hs @@ -3,6 +3,9 @@ module Cardano.Wallet.Kernel.Wallets ( , updateHdWallet , updatePassword , deleteHdWallet + , defaultHdAccountId + , defaultHdAddressId + , defaultHdAddress -- * Errors , CreateWalletError(..) , UpdateWalletPasswordError(..) @@ -19,21 +22,24 @@ import qualified Formatting.Buildable import Data.Acid.Advanced (update') -import Pos.Core (Timestamp) +import Pos.Core (Address, Timestamp) import Pos.Crypto (EncryptedSecretKey, PassPhrase, changeEncPassphrase, checkPassMatches, emptyPassphrase, - safeDeterministicKeyGen) + firstHardened, safeDeterministicKeyGen) +import Cardano.Wallet.Kernel.Addresses (newHdAddress) import Cardano.Wallet.Kernel.BIP39 (Mnemonic) import qualified Cardano.Wallet.Kernel.BIP39 as BIP39 import Cardano.Wallet.Kernel.DB.AcidState (CreateHdWallet (..), DeleteHdRoot (..), RestoreHdWallet, UpdateHdRootPassword (..), UpdateHdWallet (..)) -import Cardano.Wallet.Kernel.DB.HdWallet (AssuranceLevel, HdRoot, +import Cardano.Wallet.Kernel.DB.HdWallet (AssuranceLevel, + HdAccountId (..), HdAccountIx (..), HdAddress, + HdAddressId (..), HdAddressIx (..), HdRoot, HdRootId, WalletName, eskToHdRootId) import qualified Cardano.Wallet.Kernel.DB.HdWallet as HD import qualified Cardano.Wallet.Kernel.DB.HdWallet.Create as HD -import Cardano.Wallet.Kernel.DB.InDb (InDb (..)) +import Cardano.Wallet.Kernel.DB.InDb (InDb (..), fromDb) import Cardano.Wallet.Kernel.Internal (PassiveWallet, walletKeystore, wallets) import qualified Cardano.Wallet.Kernel.Keystore as Keystore @@ -50,6 +56,9 @@ import Test.QuickCheck (Arbitrary (..), oneof) data CreateWalletError = CreateWalletFailed HD.CreateHdRootError -- ^ When trying to create the 'Wallet', the DB operation failed. + | CreateWalletDefaultAddressDerivationFailed + -- ^ When generating the default address for the companion 'HdAddress', + -- the derivation failed instance Arbitrary CreateWalletError where arbitrary = oneof [] @@ -57,6 +66,8 @@ instance Arbitrary CreateWalletError where instance Buildable CreateWalletError where build (CreateWalletFailed dbOperation) = bprint ("CreateWalletUnknownHdAccount " % F.build) dbOperation + build CreateWalletDefaultAddressDerivationFailed = + bprint "CreateWalletDefaultAddressDerivationFailed" instance Show CreateWalletError where show = formatToString build @@ -146,43 +157,80 @@ createHdWallet pw mnemonic spendingPassword assuranceLevel walletName = do let newRootId = eskToHdRootId esk Keystore.insert (WalletIdHdRnd newRootId) esk (pw ^. walletKeystore) - -- STEP 3: Atomically generate the wallet and the initial internal structure in - -- an acid-state transaction. - res <- createWalletHdRnd pw - (spendingPassword /= emptyPassphrase) - walletName - assuranceLevel - esk - -- Brand new wallets have no Utxo - -- See preconditon above. - (\hdRoot -> Left $ CreateHdWallet hdRoot mempty) - case res of - -- NOTE(adinapoli): This is the @only@ error the DB can return, at - -- least for now, so we are pattern matching directly on it. In the - -- case of more errors being added, carefully thinking would have to - -- be put into whether or not we should remove the key from the keystore - -- at this point. Surely we don't want to do this in the case the - -- wallet already exists, or we would end up deleting the key of the - -- existing wallet! - -- Fix properly as part of [CBR-404]. - Left e@(HD.CreateHdRootExists _) -> - return . Left $ CreateWalletFailed e - Right hdRoot -> return (Right hdRoot) + -- STEP 2.5: Generate the fresh Cardano Address which will be used for the + -- companion 'HdAddress' + let mbHdAddress = + newHdAddress esk + spendingPassword + (defaultHdAccountId newRootId) + (defaultHdAddressId newRootId) + case mbHdAddress of + Nothing -> do + -- Here, ideally, we would like to do some cleanup and call + -- >>> Keystore.delete (WalletIdHdRnd newRootId) (pw ^. walletKeystore) + -- However, this wouldn't be correct in case, for example, the user + -- is trying to create the same wallet twice. In that case we would + -- wipe a pre-existing, perfectly valid key! + -- The solution to this and other problems will be provided with [CBR-404]. + -- For the moment, the less evil solution is to simply allow dangling + -- keys in the keystore. Being 'Keystore.insert' idempotent, doing so + -- won't compromise using the wallet. + return $ Left CreateWalletDefaultAddressDerivationFailed + Just hdAddress -> do + -- STEP 3: Atomically generate the wallet and the initial internal structure in + -- an acid-state transaction. + res <- createWalletHdRnd pw + (spendingPassword /= emptyPassphrase) + (hdAddress ^. HD.hdAddressAddress . fromDb) + walletName + assuranceLevel + esk + -- Brand new wallets have no Utxo + -- See preconditon above. + (\hdRoot hdAccountId hdAddr -> + Left $ CreateHdWallet hdRoot + hdAccountId + hdAddr + mempty + ) + case res of + -- NOTE(adinapoli): This is the @only@ error the DB can return, + -- so we are pattern matching directly on it. In the + -- case of more errors being added, carefully thinking would have to + -- be put into whether or not we should remove the key from the keystore + -- at this point. Surely we don't want to do this in the case the + -- wallet already exists, or we would end up deleting the key of the + -- existing wallet! + -- Fix properly as part of [CBR-404]. + Left e@(HD.CreateHdRootExists _) -> + return . Left $ CreateWalletFailed e + + Right hdRoot -> return (Right hdRoot) -- | Creates an HD wallet where new accounts and addresses are generated -- via random index derivation. -- -- Fails with CreateHdWalletError if the HdRootId already exists. +-- +-- INVARIANT: Whenever we create an HdRoot, it @must@ come with a fresh +-- account and address, both at 'firstHardened' index. +-- createWalletHdRnd :: PassiveWallet -> Bool - -- ^ Whether or not this wallet has a spending password set. + -- Does this wallet have a spending password? + -> Address + -- The 'Address' to use for the companion 'HdAddress'. -> HD.WalletName -> AssuranceLevel -> EncryptedSecretKey - -> (HdRoot -> Either CreateHdWallet RestoreHdWallet) + -> ( HdRoot + -> HdAccountId + -> HdAddress + -> Either CreateHdWallet RestoreHdWallet + ) -> IO (Either HD.CreateHdRootError HdRoot) -createWalletHdRnd pw hasSpendingPassword name assuranceLevel esk createWallet = do +createWalletHdRnd pw hasSpendingPassword defaultCardanoAddress name assuranceLevel esk createWallet = do created <- InDb <$> getCurrentTimestamp let rootId = eskToHdRootId esk newRoot = HD.initHdRoot rootId @@ -191,12 +239,14 @@ createWalletHdRnd pw hasSpendingPassword name assuranceLevel esk createWallet = assuranceLevel created - res <- case createWallet newRoot of - Left create -> update' (pw ^. wallets) create - Right restore -> update' (pw ^. wallets) restore - return $ case res of - Left err -> Left err - Right () -> Right newRoot + hdAddress = defaultHdAddressWith rootId defaultCardanoAddress + + -- We now have all the date we need to atomically generate a new + -- wallet with a default account & address. + res <- case createWallet newRoot (defaultHdAccountId rootId) hdAddress of + Left create -> update' (pw ^. wallets) create + Right restore -> update' (pw ^. wallets) restore + return $ either Left (const (Right newRoot)) res where hdSpendingPassword :: InDb Timestamp -> HD.HasSpendingPassword @@ -204,6 +254,33 @@ createWalletHdRnd pw hasSpendingPassword name assuranceLevel esk createWallet = if hasSpendingPassword then HD.HasSpendingPassword created else HD.NoSpendingPassword +-- | Creates a default 'HdAddress' at a fixed derivation path. This is +-- useful for tests, but otherwise you may want to use 'defaultHdAddressWith'. +defaultHdAddress :: EncryptedSecretKey + -> PassPhrase + -> HD.HdRootId + -> Maybe HdAddress +defaultHdAddress esk spendingPassword rootId = + let hdAccountId = defaultHdAccountId rootId + hdAddressId = HdAddressId hdAccountId (HdAddressIx firstHardened) + in newHdAddress esk spendingPassword hdAccountId hdAddressId + +-- | Given a Cardano 'Address', it returns a default 'HdAddress' at a fixed +-- and predictable generation path. +defaultHdAddressWith :: HD.HdRootId -> Address -> HdAddress +defaultHdAddressWith rootId cardanoAddress = + let hdAccountId = defaultHdAccountId rootId + hdAddressId = HdAddressId hdAccountId (HdAddressIx firstHardened) + in HD.HdAddress hdAddressId (InDb cardanoAddress) + +defaultHdAccountId :: HdRootId -> HdAccountId +defaultHdAccountId rootId = HdAccountId rootId (HdAccountIx firstHardened) + +defaultHdAddressId :: HdRootId -> HdAddressId +defaultHdAddressId rootId = + HdAddressId (defaultHdAccountId rootId) (HdAddressIx firstHardened) + + deleteHdWallet :: PassiveWallet -> HD.HdRootId -> IO (Either HD.UnknownHdRoot ()) diff --git a/src/Cardano/Wallet/WalletLayer.hs b/src/Cardano/Wallet/WalletLayer.hs index d3af0065978..401a96ff088 100644 --- a/src/Cardano/Wallet/WalletLayer.hs +++ b/src/Cardano/Wallet/WalletLayer.hs @@ -3,7 +3,6 @@ module Cardano.Wallet.WalletLayer , ActiveWalletLayer (..) -- * Types , CreateWallet(..) - , CreateAccount(..) -- ** Errors , CreateWalletError(..) , GetWalletError(..) @@ -73,7 +72,6 @@ data CreateWallet = data CreateWalletError = CreateWalletError Kernel.CreateWalletError - | CreateWalletFirstAccountCreationFailed CreateAccountError -- | Unsound show instance needed for the 'Exception' instance. instance Show CreateWalletError where @@ -83,14 +81,11 @@ instance Exception CreateWalletError instance Arbitrary CreateWalletError where arbitrary = oneof [ CreateWalletError <$> arbitrary - , CreateWalletFirstAccountCreationFailed <$> arbitrary ] instance Buildable CreateWalletError where build (CreateWalletError kernelError) = bprint ("CreateWalletError " % build) kernelError - build (CreateWalletFirstAccountCreationFailed kernelError) = - bprint ("CreateWalletFirstAccountCreationFailed " % build) kernelError data GetWalletError = GetWalletError (V1 Kernel.UnknownHdRoot) @@ -236,21 +231,10 @@ instance Buildable ValidateAddressError where -- Errors when dealing with Accounts ------------------------------------------------------------ -data CreateAccount = - CreateHdAccountFixedIndex Kernel.HdAccountIx NewAccount - -- ^ Creates a new HD 'Account' using as the account index - -- the supplied one. - | CreateHdAccountRandomIndex NewAccount - -- ^ Creates a new HD 'Account' using as the account index - -- a randomly-generated one. - data CreateAccountError = CreateAccountError Kernel.CreateAccountError | CreateAccountWalletIdDecodingFailed Text -- ^ Decoding the parent's 'WalletId' from a raw 'Text' failed. - | CreateAccountFirstAddressGenerationFailed Kernel.CreateAddressError - -- ^ When trying to create the first 'Address' to go in tandem with this - -- 'Account', the generation failed. deriving Eq -- | Unsound show instance needed for the 'Exception' instance. @@ -262,7 +246,6 @@ instance Exception CreateAccountError instance Arbitrary CreateAccountError where arbitrary = oneof [ CreateAccountError <$> arbitrary , CreateAccountWalletIdDecodingFailed <$> arbitrary - , CreateAccountFirstAddressGenerationFailed <$> arbitrary ] instance Buildable CreateAccountError where @@ -270,8 +253,6 @@ instance Buildable CreateAccountError where bprint ("CreateAccountError " % build) kernelError build (CreateAccountWalletIdDecodingFailed txt) = bprint ("CreateAccountWalletIdDecodingFailed " % build) txt - build (CreateAccountFirstAddressGenerationFailed kernelError) = - bprint ("CreateAccountFirstAddressGenerationFailed " % build) kernelError data GetAccountError = GetAccountError (V1 Kernel.UnknownHdAccount) @@ -418,7 +399,7 @@ data PassiveWalletLayer m = PassiveWalletLayer -> m (Either GetUtxosError [(Account, Utxo)]) -- accounts , createAccount :: WalletId - -> CreateAccount + -> NewAccount -> m (Either CreateAccountError Account) , getAccounts :: WalletId -> m (Either GetAccountsError (IxSet Account)) diff --git a/src/Cardano/Wallet/WalletLayer/Kernel/Accounts.hs b/src/Cardano/Wallet/WalletLayer/Kernel/Accounts.hs index 727b53eb185..6431e917df9 100644 --- a/src/Cardano/Wallet/WalletLayer/Kernel/Accounts.hs +++ b/src/Cardano/Wallet/WalletLayer/Kernel/Accounts.hs @@ -1,6 +1,5 @@ module Cardano.Wallet.WalletLayer.Kernel.Accounts ( createAccount - , createHdAccount , getAccount , getAccountBalance , getAccountAddresses @@ -22,80 +21,48 @@ import Cardano.Wallet.API.Response (WalletResponse, respondWith) import Cardano.Wallet.API.V1.Types (V1 (..), WalletAddress) import qualified Cardano.Wallet.API.V1.Types as V1 import qualified Cardano.Wallet.Kernel.Accounts as Kernel -import qualified Cardano.Wallet.Kernel.Addresses as Kernel import qualified Cardano.Wallet.Kernel.DB.HdWallet as HD +import Cardano.Wallet.Kernel.DB.Read (addressesByAccountId) import Cardano.Wallet.Kernel.DB.Util.IxSet (Indexed (..), IxSet) import qualified Cardano.Wallet.Kernel.DB.Util.IxSet as IxSet import qualified Cardano.Wallet.Kernel.Internal as Kernel import qualified Cardano.Wallet.Kernel.Read as Kernel -import Cardano.Wallet.Kernel.Types (AccountId (..), WalletId (..)) -import Cardano.Wallet.WalletLayer (CreateAccount (..), - CreateAccountError (..), DeleteAccountError (..), - GetAccountError (..), GetAccountsError (..), - UpdateAccountError (..)) +import Cardano.Wallet.Kernel.Types (WalletId (..)) +import Cardano.Wallet.WalletLayer (CreateAccountError (..), + DeleteAccountError (..), GetAccountError (..), + GetAccountsError (..), UpdateAccountError (..)) import Cardano.Wallet.WalletLayer.Kernel.Conv +-- | Creates a new account. It does @not@ create a default address to go +-- alongside this wallet nor it should be, as the invariant applies only to +-- new wallet being created/restored and is enforced elsewhere. createAccount :: MonadIO m => Kernel.PassiveWallet -> V1.WalletId - -> CreateAccount + -> V1.NewAccount -> m (Either CreateAccountError V1.Account) -createAccount wallet wId createAccountRequest = liftIO $ do - either (Left . identity) (Right . uncurry mkAccount) - <$> createHdAccount wallet wId createAccountRequest - where - -- We cannot use the general 'fromAccount' function here since we lack - -- a DB snapshot. We /could/ in principle ask for a snapshot and use that, - -- but if meanwhile the account has already been changed that might lead - -- to confusing results. Modifying the kernel code to do this atomically - -- and return the (single) final snapshot might be possible but right now - -- is more difficult than it appears (I've tried). - mkAccount :: HD.HdAccount -> HD.HdAddress -> V1.Account - mkAccount acc addr = V1.Account { - accIndex = toAccountId (acc ^. HD.hdAccountId) - , accAmount = V1.V1 (Core.mkCoin 0) - , accName = V1.naccName (toNewAccountRq createAccountRequest) - , accWalletId = wId - , accAddresses = [ toAddress acc addr ] - } - -createHdAccount :: MonadIO m - => Kernel.PassiveWallet - -> V1.WalletId - -> CreateAccount - -> m (Either CreateAccountError (HD.HdAccount, HD.HdAddress)) -createHdAccount wallet wId createAccountRequest = liftIO $ runExceptT $ do - let (V1.NewAccount mbSpendingPassword accountName) = toNewAccountRq createAccountRequest +createAccount wallet wId (V1.NewAccount mbSpendingPassword accountName) = liftIO $ runExceptT $ do rootId <- withExceptT CreateAccountWalletIdDecodingFailed $ fromRootId wId - acc <- withExceptT CreateAccountError $ ExceptT $ liftIO $ - case createAccountRequest of - CreateHdAccountRandomIndex _ -> - Kernel.createHdRandomAccount (HD.AccountName accountName) - (WalletIdHdRnd rootId) - wallet - CreateHdAccountFixedIndex newIndex _ -> - Kernel.createHdFixedAccount newIndex - (HD.AccountName accountName) - (WalletIdHdRnd rootId) - wallet + (db, acc) <- withExceptT CreateAccountError $ ExceptT $ liftIO $ + Kernel.createAccount passPhrase + (HD.AccountName accountName) + (WalletIdHdRnd rootId) + wallet let accId = acc ^. HD.hdAccountId - -- Create a new address to go in tandem with this brand-new 'Account'. - fmap (acc,) $ - withExceptT CreateAccountFirstAddressGenerationFailed $ ExceptT $ liftIO $ - Kernel.createAddress (passPhrase mbSpendingPassword) - (AccountIdHdRnd accId) - wallet + let accountAddresses = addressesByAccountId db accId + pure $ mkAccount acc (IxSet.toList accountAddresses) where - passPhrase = maybe mempty coerce - - -toNewAccountRq :: CreateAccount -> V1.NewAccount -toNewAccountRq createAccountRequest = - case createAccountRequest of - CreateHdAccountFixedIndex _ rq -> rq - CreateHdAccountRandomIndex rq -> rq + passPhrase = maybe mempty coerce mbSpendingPassword + mkAccount :: HD.HdAccount -> [Indexed HD.HdAddress] -> V1.Account + mkAccount account addresses = V1.Account { + accIndex = toAccountId (account ^. HD.hdAccountId) + , accAmount = V1.V1 (Core.mkCoin 0) + , accName = accountName + , accWalletId = wId + , accAddresses = map (toAddress account . view IxSet.ixedIndexed) addresses + } -- | Retrieves a full set of accounts. getAccounts :: V1.WalletId diff --git a/src/Cardano/Wallet/WalletLayer/Kernel/Addresses.hs b/src/Cardano/Wallet/WalletLayer/Kernel/Addresses.hs index 1c5f8201e99..aa55ab4fa92 100644 --- a/src/Cardano/Wallet/WalletLayer/Kernel/Addresses.hs +++ b/src/Cardano/Wallet/WalletLayer/Kernel/Addresses.hs @@ -10,7 +10,7 @@ import Universum import Control.Monad.Trans.Except import Data.Coerce (coerce) -import Pos.Core (decodeTextAddress) +import Pos.Core (Address, decodeTextAddress) import Cardano.Wallet.API.Request (RequestParams (..)) import Cardano.Wallet.API.Request.Pagination (Page (..), @@ -50,8 +50,8 @@ createAddress wallet -- | Creates a new 'WalletAddress'. As this is a brand new, fresh Address, -- it's fine to have 'False' for both 'isUsed' and 'isChange'. - mkAddress :: HD.HdAddress -> WalletAddress - mkAddress addr = WalletAddress (V1 $ toCardanoAddress addr) False False + mkAddress :: Address -> WalletAddress + mkAddress addr = WalletAddress (V1 addr) False False diff --git a/src/Cardano/Wallet/WalletLayer/Kernel/Conv.hs b/src/Cardano/Wallet/WalletLayer/Kernel/Conv.hs index 331a99532b4..5d9876edc71 100644 --- a/src/Cardano/Wallet/WalletLayer/Kernel/Conv.hs +++ b/src/Cardano/Wallet/WalletLayer/Kernel/Conv.hs @@ -197,8 +197,9 @@ toAddress acc hdAddress = cardanoAddress = hdAddress ^. HD.hdAddressAddress . fromDb addressMeta = acc ^. HD.hdAccountState . HD.hdAccountStateCurrent . cpAddressMeta cardanoAddress +-- | Converts a Kernel 'HdAddress' into a Cardano 'Address'. toCardanoAddress :: HD.HdAddress -> Address -toCardanoAddress hdAddress = hdAddress ^. HD.hdAddressAddress . fromDb +toCardanoAddress hdAddr = hdAddr ^. HD.hdAddressAddress . fromDb {------------------------------------------------------------------------------- Custom errors diff --git a/src/Cardano/Wallet/WalletLayer/Kernel/Wallets.hs b/src/Cardano/Wallet/WalletLayer/Kernel/Wallets.hs index 38b41417afd..e1b7511cd5c 100644 --- a/src/Cardano/Wallet/WalletLayer/Kernel/Wallets.hs +++ b/src/Cardano/Wallet/WalletLayer/Kernel/Wallets.hs @@ -12,6 +12,7 @@ module Cardano.Wallet.WalletLayer.Kernel.Wallets ( import Universum +import Control.Monad.Except (throwError) import Data.Coerce (coerce) import qualified Data.Map as M import Data.Maybe (fromJust) @@ -20,11 +21,11 @@ import Pos.Chain.Block (Blund, mainBlockSlot, undoTx) import Pos.Chain.Txp (Utxo) import Pos.Core (Config (..), mkCoin) import Pos.Core.Slotting (Timestamp) -import Pos.Crypto.HD (firstHardened) import Pos.Crypto.Signing import Cardano.Wallet.API.V1.Types (V1 (..)) import qualified Cardano.Wallet.API.V1.Types as V1 +import Cardano.Wallet.Kernel.Addresses (newHdAddress) import qualified Cardano.Wallet.Kernel.BIP39 as BIP39 import Cardano.Wallet.Kernel.DB.AcidState (dbHdWallets) import Cardano.Wallet.Kernel.DB.BlockContext @@ -48,12 +49,10 @@ import Cardano.Wallet.Kernel.Types (RawResolvedBlock (..), WalletId (..), fromRawResolvedBlock) import Cardano.Wallet.Kernel.Util.Core (getCurrentTimestamp) import qualified Cardano.Wallet.Kernel.Wallets as Kernel -import Cardano.Wallet.WalletLayer (CreateAccount (..), - CreateWallet (..), CreateWalletError (..), - DeleteWalletError (..), GetUtxosError (..), - GetWalletError (..), UpdateWalletError (..), - UpdateWalletPasswordError (..)) -import qualified Cardano.Wallet.WalletLayer.Kernel.Accounts as Accounts +import Cardano.Wallet.WalletLayer (CreateWallet (..), + CreateWalletError (..), DeleteWalletError (..), + GetUtxosError (..), GetWalletError (..), + UpdateWalletError (..), UpdateWalletPasswordError (..)) import Cardano.Wallet.WalletLayer.Kernel.Conv createWallet :: MonadIO m @@ -82,16 +81,6 @@ createWallet wallet newWalletRequest = liftIO $ do (spendingPassword newwalSpendingPassword) (fromAssuranceLevel newwalAssuranceLevel) (HD.WalletName newwalName) - let rootId = root ^. HD.hdRootId - _ <- withExceptT CreateWalletFirstAccountCreationFailed $ ExceptT $ do - -- When we create a new wallet, we want to create a new account - -- with a predictable, fixed seed, in compliance with the old - -- schema.We offload this to the WalletLayer so that we can be - -- sure it will also create a fresh address and we won't - -- duplicate work. - let newAccount = V1.NewAccount newwalSpendingPassword "Default account" - let rq = CreateHdAccountFixedIndex (HD.HdAccountIx firstHardened) newAccount - Accounts.createHdAccount wallet (toRootId rootId) rq return (mkRoot newwalName newwalAssuranceLevel now root) restore :: V1.NewWallet @@ -128,18 +117,26 @@ createWallet wallet newWalletRequest = liftIO $ do Nothing -> (M.empty, []) Just rb -> prefilterBlock rb wId esk - (root, coins) <- withExceptT (CreateWalletError . Kernel.CreateWalletFailed) $ ExceptT $ - restoreWallet - wallet - (pwd /= emptyPassphrase) - (HD.WalletName walletName) - hdAssuranceLevel - esk - prefilter + mbHdAddress = newHdAddress esk + pwd + (Kernel.defaultHdAccountId rootId) + (Kernel.defaultHdAddressId rootId) + case mbHdAddress of + Nothing -> throwError (CreateWalletError Kernel.CreateWalletDefaultAddressDerivationFailed) + Just hdAddress -> do + (root, coins) <- withExceptT (CreateWalletError . Kernel.CreateWalletFailed) $ ExceptT $ + restoreWallet + wallet + (pwd /= emptyPassphrase) + (hdAddress ^. HD.hdAddressAddress . fromDb) + (HD.WalletName walletName) + hdAssuranceLevel + esk + prefilter - -- Return the wallet information, with an updated balance. - let root' = mkRoot walletName (toAssuranceLevel hdAssuranceLevel) now root - updateSyncState wallet wId (root' { V1.walBalance = V1 coins }) + -- Return the wallet information, with an updated balance. + let root' = mkRoot walletName (toAssuranceLevel hdAssuranceLevel) now root + updateSyncState wallet wId (root' { V1.walBalance = V1 coins }) mkRoot :: Text -> V1.AssuranceLevel -> Timestamp -> HD.HdRoot -> V1.Wallet mkRoot v1WalletName v1AssuranceLevel now hdRoot = V1.Wallet { @@ -162,11 +159,6 @@ createWallet wallet newWalletRequest = liftIO $ do createdAt = hdRoot ^. HD.hdRootCreatedAt . fromDb walletId = toRootId $ hdRoot ^. HD.hdRootId - -- (V1.BackupPhrase mnemonic) - -- mbSpendingPassword - -- v1AssuranceLevel - -- v1WalletName - -- operation mnemonic (V1.NewWallet (V1.BackupPhrase m) _ _ _ _) = m spendingPassword = maybe emptyPassphrase coerce diff --git a/test/unit/Test/Spec/Accounts.hs b/test/unit/Test/Spec/Accounts.hs index 35af9f5c6d5..f337f53cb4a 100644 --- a/test/unit/Test/Spec/Accounts.hs +++ b/test/unit/Test/Spec/Accounts.hs @@ -23,8 +23,7 @@ import qualified Cardano.Wallet.Kernel.DB.HdWallet as Kernel import qualified Cardano.Wallet.Kernel.DB.Util.IxSet as IxSet import qualified Cardano.Wallet.Kernel.Internal as Internal import qualified Cardano.Wallet.Kernel.Keystore as Keystore -import Cardano.Wallet.WalletLayer (CreateAccount (..), - PassiveWalletLayer) +import Cardano.Wallet.WalletLayer (PassiveWalletLayer) import qualified Cardano.Wallet.WalletLayer as WalletLayer import qualified Cardano.Wallet.WalletLayer.Kernel.Wallets as Wallets import Control.Monad.Except (runExceptT) @@ -81,7 +80,7 @@ spec = describe "Accounts" $ do withFixture $ \_ layer _ Fixture{..} -> do res <- WalletLayer.createAccount layer (V1.walId fixtureV1Wallet) - (CreateHdAccountRandomIndex fixtureNewAccountRq) + fixtureNewAccountRq (bimap STB STB res) `shouldSatisfy` isRight prop "fails if the parent wallet doesn't exists" $ withMaxSuccess 50 $ do @@ -90,7 +89,7 @@ spec = describe "Accounts" $ do pwd <- genSpendingPassword request <- genNewAccountRq pwd withLayer $ \layer _ -> do - res <- WalletLayer.createAccount layer wId (CreateHdAccountRandomIndex request) + res <- WalletLayer.createAccount layer wId request case res of Left (WalletLayer.CreateAccountError (CreateAccountKeystoreNotFound _)) -> return () @@ -110,7 +109,10 @@ spec = describe "Accounts" $ do res <- runExceptT . runHandler' $ hdl (bimap identity STB res) `shouldSatisfy` isRight - prop "comes with 1 address by default" $ withMaxSuccess 50 $ do + prop "does NOT come with 1 address by default" $ withMaxSuccess 50 $ do + -- We expect newly created accounts to @not@ have any associated + -- addresses. Remember, it's only when we create a new HdRoot that + -- we enforce this invariant. monadicIO $ do withFixture $ \_ layer _ Fixture{..} -> do let hdl = Handlers.newAccount layer (V1.walId fixtureV1Wallet) fixtureNewAccountRq @@ -118,7 +120,7 @@ spec = describe "Accounts" $ do case res of Left e -> throwM e Right API.WalletResponse{..} -> - length (V1.accAddresses wrData) `shouldBe` 1 + length (V1.accAddresses wrData) `shouldBe` 0 describe "DeleteAccount" $ do @@ -127,7 +129,7 @@ spec = describe "Accounts" $ do withFixture $ \_ layer _ Fixture{..} -> do let wId = V1.walId fixtureV1Wallet (Right V1.Account{..}) <- - WalletLayer.createAccount layer wId (CreateHdAccountRandomIndex fixtureNewAccountRq) + WalletLayer.createAccount layer wId fixtureNewAccountRq res <- WalletLayer.deleteAccount layer wId accIndex (bimap STB STB res) `shouldSatisfy` isRight @@ -220,7 +222,7 @@ spec = describe "Accounts" $ do withFixture $ \_ layer _ Fixture{..} -> do let wId = V1.walId fixtureV1Wallet (Right V1.Account{..}) <- - WalletLayer.createAccount layer wId (CreateHdAccountRandomIndex fixtureNewAccountRq) + WalletLayer.createAccount layer wId fixtureNewAccountRq let updateAccountRq = V1.AccountUpdate "My nice account" res <- WalletLayer.updateAccount layer wId accIndex updateAccountRq case res of @@ -291,7 +293,7 @@ spec = describe "Accounts" $ do withFixture $ \_ layer _ Fixture{..} -> do (Right V1.Account{..}) <- WalletLayer.createAccount layer (V1.walId fixtureV1Wallet) - (CreateHdAccountRandomIndex fixtureNewAccountRq) + fixtureNewAccountRq res <- WalletLayer.getAccount layer (V1.walId fixtureV1Wallet) accIndex case res of @@ -357,7 +359,7 @@ spec = describe "Accounts" $ do -- by the 'createWallet' endpoint, for a total of 5. forM_ [1..4] $ \(_i :: Int) -> WalletLayer.createAccount layer (V1.walId fixtureV1Wallet) - (CreateHdAccountRandomIndex fixtureNewAccountRq) + fixtureNewAccountRq res <- WalletLayer.getAccounts layer (V1.walId fixtureV1Wallet) case res of Left e -> fail (show e) @@ -428,7 +430,7 @@ spec = describe "Accounts" $ do -- by the 'createWallet' endpoint, for a total of 5. forM_ [1..4] $ \(_i :: Int) -> WalletLayer.createAccount layer (V1.walId fixtureV1Wallet) - (CreateHdAccountRandomIndex fixtureNewAccountRq) + fixtureNewAccountRq accounts <- WalletLayer.getAccounts layer (V1.walId fixtureV1Wallet) let accountIndices = case accounts of @@ -480,7 +482,7 @@ spec = describe "Accounts" $ do -- by the 'createWallet' endpoint, for a total of 5. forM_ [1..4] $ \(_i :: Int) -> WalletLayer.createAccount layer (V1.walId fixtureV1Wallet) - (CreateHdAccountRandomIndex fixtureNewAccountRq) + fixtureNewAccountRq accountsBefore <- WalletLayer.getAccounts layer (V1.walId fixtureV1Wallet) let accountIndices = case accountsBefore of @@ -508,7 +510,7 @@ spec = describe "Accounts" $ do let zero = V1 (mkCoin 0) (Right V1.Account{..}) <- WalletLayer.createAccount layer (V1.walId fixtureV1Wallet) - (CreateHdAccountRandomIndex fixtureNewAccountRq) + fixtureNewAccountRq res <- WalletLayer.getAccountBalance layer (V1.walId fixtureV1Wallet) accIndex case res of @@ -544,7 +546,7 @@ spec = describe "Accounts" $ do -- by the 'createWallet' endpoint, for a total of 5. forM_ [1..4] $ \(_i :: Int) -> WalletLayer.createAccount layer (V1.walId fixtureV1Wallet) - (CreateHdAccountRandomIndex fixtureNewAccountRq) + fixtureNewAccountRq accounts <- WalletLayer.getAccounts layer (V1.walId fixtureV1Wallet) let accountIndices = case accounts of diff --git a/test/unit/Test/Spec/Addresses.hs b/test/unit/Test/Spec/Addresses.hs index 311010c466c..f7a8eb0d9d9 100644 --- a/test/unit/Test/Spec/Addresses.hs +++ b/test/unit/Test/Spec/Addresses.hs @@ -17,7 +17,7 @@ import Test.QuickCheck (arbitrary, choose, elements, withMaxSuccess, import Test.QuickCheck.Monadic (PropertyM, monadicIO, pick) import Pos.Core (Address) -import Pos.Crypto (EncryptedSecretKey, firstHardened, +import Pos.Crypto (EncryptedSecretKey, emptyPassphrase, firstHardened, safeDeterministicKeyGen) import Cardano.Wallet.API.Request (RequestParams (..)) @@ -41,6 +41,7 @@ import Cardano.Wallet.Kernel.Internal (PassiveWallet, wallets) import qualified Cardano.Wallet.Kernel.Keystore as Keystore import qualified Cardano.Wallet.Kernel.Read as Kernel import Cardano.Wallet.Kernel.Types (AccountId (..), WalletId (..)) +import qualified Cardano.Wallet.Kernel.Wallets as Kernel import Cardano.Wallet.WalletLayer (PassiveWalletLayer) import qualified Cardano.Wallet.WalletLayer as WalletLayer import qualified Cardano.Wallet.WalletLayer.Kernel.Addresses as Addresses @@ -79,8 +80,11 @@ prepareFixtures = do <*> (InDb <$> pick arbitrary) newAccountId <- HdAccountId newRootId <$> deriveIndex (pick . choose) HdAccountIx HardDerivation let accounts = M.singleton newAccountId mempty + hdAccountId = Kernel.defaultHdAccountId newRootId + (Just hdAddress) = Kernel.defaultHdAddress esk emptyPassphrase newRootId + return $ \pw -> do - void $ liftIO $ update (pw ^. wallets) (CreateHdWallet newRoot accounts) + void $ liftIO $ update (pw ^. wallets) (CreateHdWallet newRoot hdAccountId hdAddress accounts) return $ Fixture { fixtureHdRootId = newRootId , fixtureAccountId = AccountIdHdRnd newAccountId diff --git a/test/unit/Test/Spec/NewPayment.hs b/test/unit/Test/Spec/NewPayment.hs index e7facd81f12..f79116c6b83 100644 --- a/test/unit/Test/Spec/NewPayment.hs +++ b/test/unit/Test/Spec/NewPayment.hs @@ -26,7 +26,7 @@ import Pos.Chain.Txp (TxOut (..), TxOutAux (..)) import Pos.Core (Address, Coin (..), IsBootstrapEraAddr (..), deriveLvl2KeyPair, mkCoin) import Pos.Crypto (EncryptedSecretKey, ShouldCheckPassphrase (..), - safeDeterministicKeyGen) + emptyPassphrase, safeDeterministicKeyGen) import Test.Spec.CoinSelection.Generators (InitialBalance (..), Pay (..), genPayee, genUtxoWithAtLeast) @@ -53,6 +53,7 @@ import qualified Cardano.Wallet.Kernel.NodeStateAdaptor as Node import qualified Cardano.Wallet.Kernel.PrefilterTx as Kernel import qualified Cardano.Wallet.Kernel.Transactions as Kernel import Cardano.Wallet.Kernel.Types (AccountId (..), WalletId (..)) +import qualified Cardano.Wallet.Kernel.Wallets as Kernel import Cardano.Wallet.WalletLayer (ActiveWalletLayer) import qualified Cardano.Wallet.WalletLayer as WalletLayer import qualified Cardano.Wallet.WalletLayer.Kernel.Conv as Kernel.Conv @@ -110,9 +111,11 @@ prepareFixtures initialBalance toPay = do liftIO $ Keystore.insert (WalletIdHdRnd newRootId) esk keystore let pw = Kernel.walletPassive aw - let accounts = Kernel.prefilterUtxo newRootId esk utxo' + let accounts = Kernel.prefilterUtxo newRootId esk utxo' + hdAccountId = Kernel.defaultHdAccountId newRootId + (Just hdAddress) = Kernel.defaultHdAddress esk emptyPassphrase newRootId - void $ liftIO $ update (pw ^. wallets) (CreateHdWallet newRoot accounts) + void $ liftIO $ update (pw ^. wallets) (CreateHdWallet newRoot hdAccountId hdAddress accounts) return $ Fixture { fixtureHdRootId = newRootId , fixtureAccountId = AccountIdHdRnd newAccountId diff --git a/test/unit/Wallet/Inductive/Cardano.hs b/test/unit/Wallet/Inductive/Cardano.hs index b15410d6f09..1462a8355bf 100644 --- a/test/unit/Wallet/Inductive/Cardano.hs +++ b/test/unit/Wallet/Inductive/Cardano.hs @@ -25,11 +25,13 @@ import qualified Formatting.Buildable import Pos.Chain.Txp (Utxo, formatUtxo) import Pos.Core (HasConfiguration, Timestamp (..)) import Pos.Core.Chrono -import Pos.Crypto (EncryptedSecretKey) +import Pos.Crypto (EncryptedSecretKey, emptyPassphrase) +import qualified Cardano.Wallet.Kernel.Addresses as Kernel import qualified Cardano.Wallet.Kernel.BListener as Kernel import qualified Cardano.Wallet.Kernel.DB.AcidState as DB import qualified Cardano.Wallet.Kernel.DB.HdWallet as HD +import Cardano.Wallet.Kernel.DB.InDb (fromDb) import qualified Cardano.Wallet.Kernel.Internal as Internal import Cardano.Wallet.Kernel.Invariants as Kernel import qualified Cardano.Wallet.Kernel.Keystore as Keystore @@ -217,14 +219,25 @@ equivalentT useWW activeWallet esk = \mkWallet w -> -> Utxo -> TranslateT EquivalenceViolation m HD.HdAccountId walletBootT ctxt utxo = do + let newRootId = HD.eskToHdRootId esk + let (Just defaultAddress) = Kernel.newHdAddress esk + emptyPassphrase + (Kernel.defaultHdAccountId newRootId) + (Kernel.defaultHdAddressId newRootId) res <- liftIO $ Kernel.createWalletHdRnd passiveWallet False + (defaultAddress ^. HD.hdAddressAddress . fromDb) walletName assuranceLevel esk - (\root -> Left $ DB.CreateHdWallet root (prefilterUtxo (root ^. HD.hdRootId) esk utxo)) + (\root defaultAccount defAddress -> + Left $ DB.CreateHdWallet root + defaultAccount + defAddress + (prefilterUtxo (root ^. HD.hdRootId) esk utxo) + ) case res of Left e -> createWalletErr (STB e) Right hdRoot -> do