Skip to content
This repository has been archived by the owner on Aug 18, 2020. It is now read-only.

Commit

Permalink
Merge pull request #3580 from input-output-hk/adinapoli/cbr-419/fresh…
Browse files Browse the repository at this point in the history 
…-account-on-wallet-restoration

[CBR-419][CBR-416] Fresh account (and address) on wallet restoration
  • Loading branch information
@adinapoli-iohk
adinapoli-iohk authored Sep 12, 2018
2 parents 9311686 + fd9ba33 commit 53097d2
Show file tree
Hide file tree
Showing 17 changed files with 375 additions and 317 deletions.
3 changes: 1 addition & 2 deletions src/Cardano/Wallet/API/V1/Handlers/Accounts.hs
View file
Original file line number Diff line number Diff line change
Expand Up @@ -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
Expand Down
142 changes: 46 additions & 96 deletions src/Cardano/Wallet/Kernel/Accounts.hs
View file
Original file line number Diff line number Diff line change
@@ -1,6 +1,5 @@
module Cardano.Wallet.Kernel.Accounts (
createHdRandomAccount
, createHdFixedAccount
createAccount
, deleteAccount
, updateAccount
-- * Errors
Expand All @@ -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 (..),
Expand All @@ -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.
Expand All @@ -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

Expand All @@ -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).
Expand All @@ -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
Expand Down
51 changes: 32 additions & 19 deletions src/Cardano/Wallet/Kernel/Addresses.hs
View file
Original file line number Diff line number Diff line change
@@ -1,5 +1,6 @@
module Cardano.Wallet.Kernel.Addresses (
createAddress
createAddress
, newHdAddress
-- * Errors
, CreateAddressError(..)
) where
Expand All @@ -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
Expand All @@ -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)

Expand Down Expand Up @@ -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
Expand All @@ -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
Expand All @@ -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)
Expand All @@ -133,29 +133,42 @@ 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
(Left (CreateHdAddressExists _)) ->
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
Loading

0 comments on commit 53097d2

Please sign in to comment.