Permalink
Browse files

Merge pull request #391 from serokell/epicallan/ad501-move-wallet-res…

…tore-logic

[AD-501] Move wallet restore logic to cardano modules
  • Loading branch information...
epicallan committed Dec 6, 2018
2 parents 9a8ff06 + 979dac7 commit 01b6b904c5535f232add440eb21ce5820ee001d0
@@ -17,7 +17,7 @@ import Ariadne.Cardano.Face
import Ariadne.Config.Wallet (WalletConfig(..))
import Ariadne.UX.PasswordManager
import Ariadne.Wallet.Backend.KeyStorage
import Ariadne.Wallet.Backend.Restore
import Ariadne.Wallet.Backend.Restore (restoreFromKeyFile, restoreWallet)
import Ariadne.Wallet.Backend.Tx
import Ariadne.Wallet.Cardano.Kernel.Keystore
(DeletePolicy(..), keystoreComponent)
@@ -104,8 +104,8 @@ createWalletBackend walletConfig cardanoFace sendWalletEvent getPass voidPass =
newAddress pwl this walletSelRef getPassPhrase voidWrongPass
, walletNewAccount = newAccount pwl this walletSelRef
, walletNewWallet = newWallet pwl walletConfig this getPassTemp waitUiConfirm
, walletRestore = restoreWallet pwl this runCardanoMode getPassTemp
, walletRestoreFromFile = restoreFromKeyFile pwl this runCardanoMode
, walletRestore = restoreWallet pwl runCardanoMode getPassTemp
, walletRestoreFromFile = restoreFromKeyFile pwl runCardanoMode
, walletRename = renameSelection pwl this walletSelRef
, walletRemove = removeSelection pwl this walletSelRef waitUiConfirm
, walletRefreshState =
@@ -7,162 +7,62 @@ module Ariadne.Wallet.Backend.Restore
import qualified Universum.Unsafe as Unsafe (init)
import Control.Exception (Exception(displayException))
import Control.Lens (at, non, (?~))
import Control.Natural (type (~>))
import qualified Data.ByteString as BS
import qualified Data.Map.Strict as Map
import Pos.Binary.Class (decodeFull')
import Pos.Util.BackupPhrase (BackupPhrase(..))
import Pos.Core.Configuration (HasConfiguration)
import Pos.Crypto (EncryptedSecretKey, PassPhrase)
import qualified Pos.Crypto as Crypto
import Pos.Txp.Toil.Types (Utxo)
import Pos.Util.BackupPhrase (BackupPhrase(..), safeKeysFromPhrase)
import Pos.Util.UserSecret (usKeys0)
import Pos.Crypto (PassPhrase)
import Ariadne.Cardano.Face
import Ariadne.Wallet.Backend.AddressDiscovery
(AddressWithPathToUtxoMap, discoverHDAddressWithUtxo)
import Ariadne.Wallet.Backend.KeyStorage (addWallet)
import Ariadne.Wallet.Cardano.Kernel.Bip32 (DerivationPath(..))
import Ariadne.Wallet.Cardano.Kernel.Bip39 (mnemonicToSeedNoPassword)
import Ariadne.Wallet.Cardano.Kernel.Bip44
(Bip44DerivationPath(..), bip44PathToAddressId, decodeBip44DerivationPath)
import Ariadne.Wallet.Cardano.Kernel.DB.HdWallet
import Ariadne.Wallet.Cardano.Kernel.PrefilterTx
(PrefilteredUtxo, UtxoByAccount)
import Ariadne.Wallet.Cardano.Kernel.Wallets
(HasNonemptyPassphrase(..), CreateWithAddress(..), mkHasPP)
import Ariadne.Cardano.Face (CardanoMode)
import Ariadne.Wallet.Cardano.Kernel.DB.HdWallet (WalletName(..))
import Ariadne.Wallet.Cardano.Kernel.Restore (RestoreFrom(..), WrongMnemonic(..))
import Ariadne.Wallet.Cardano.WalletLayer.Types (PassiveWalletLayer(..))
import Ariadne.Wallet.Face
newtype WrongMnemonic = WrongMnemonic Text
deriving (Eq, Show)
instance Exception WrongMnemonic where
displayException (WrongMnemonic txt) =
"Wrong mnemonic: " <> show txt
data SecretsDecodingError = SecretsDecodingError FilePath Text
deriving (Eq, Show)
instance Exception SecretsDecodingError where
displayException (SecretsDecodingError path txt) =
"Failed to decode " <> path <> ": " <> show txt
import Ariadne.Wallet.Face (Mnemonic(..))
restoreWallet ::
HasConfiguration
=> PassiveWalletLayer IO
-> WalletFace
-> (CardanoMode ~> IO)
-> IO PassPhrase
-> Maybe WalletName
-> Mnemonic
-> IO ()
restoreWallet pwl face runCardanoMode getPassTemp mbWalletName (Mnemonic mnemonic) = do
restoreWallet pwl runCardanoMode getPassTemp mbWalletName mnemonic = do
pp <- getPassTemp
let mnemonicWords = words mnemonic
isAriadneMnemonic = fromMaybe False $ do
lastWord <- last <$> nonEmpty mnemonicWords
pure (lastWord == "ariadne-v0") -- TODO AD-124: version parsing?
esk <- if
| isAriadneMnemonic ->
let seed = mnemonicToSeedNoPassword (unwords $ Unsafe.init mnemonicWords)
in pure . snd $ Crypto.safeDeterministicKeyGen seed pp
| length mnemonicWords == 12 ->
case safeKeysFromPhrase pp (BackupPhrase mnemonicWords) of
Left e -> throwM $ WrongMnemonic e
Right (sk, _) -> pure sk
| otherwise -> throwM $ WrongMnemonic "Unknown mnemonic type"
let hasPP = mkHasPP pp
restoreFromSecretKey pwl face runCardanoMode mbWalletName esk hasPP assurance
where
-- TODO(AD-251): allow selecting assurance.
assurance = AssuranceLevelNormal
rFrom <- getMnemonicRestore mnemonic pp
pwlRestoreWallet pwl runCardanoMode rFrom (getWalletName mbWalletName)
restoreFromKeyFile ::
HasConfiguration
=> PassiveWalletLayer IO
-> WalletFace
-> (CardanoMode ~> IO)
-> Maybe WalletName
-> FilePath
-> IO ()
restoreFromKeyFile pwl face runCardanoMode mbWalletName path = do
keyFile <- BS.readFile path
us <- case decodeFull' keyFile of
Left e -> throwM $ SecretsDecodingError path e
Right us -> pure us
let templateName i (WalletName n) = WalletName $ n <> " " <> pretty i
traverse_
(\(i,esk) -> do
let hasPP = HasNonemptyPassphrase $
isNothing $ Crypto.checkPassMatches Crypto.emptyPassphrase esk
restoreFromSecretKey
pwl
face
runCardanoMode
(templateName i <$> mbWalletName)
esk
hasPP
assurance)
(zip [(0 :: Int)..] $ us ^. usKeys0)
where
-- TODO(AD-251): allow selecting assurance.
assurance = AssuranceLevelNormal
restoreFromSecretKey ::
HasConfiguration
=> PassiveWalletLayer IO
-> WalletFace
-> (CardanoMode ~> IO)
-> Maybe WalletName
-> EncryptedSecretKey
-> HasNonemptyPassphrase
-> AssuranceLevel
-> IO ()
restoreFromSecretKey pwl face runCardanoMode mbWalletName esk hasPP assurance = do
utxoByAccount <- runCardanoMode $ collectUtxo esk
addWallet pwl face esk mbWalletName utxoByAccount hasPP WithoutAddress assurance
restoreFromKeyFile pwl runCardanoMode mbWalletName path =
let walletName = getWalletName mbWalletName
in pwlRestoreWallet pwl runCardanoMode (RestoreFromKeyFile path) walletName
getMnemonicRestore ::
MonadThrow m
=> Mnemonic
-> PassPhrase
-> m RestoreFrom
getMnemonicRestore (Mnemonic mnemonic) pp = do
let mnemonicWords = words mnemonic
collectUtxo ::
HasConfiguration
=> EncryptedSecretKey
-> CardanoMode UtxoByAccount
collectUtxo esk = do
m <- discoverHDAddressWithUtxo $ Crypto.deriveHDPassphrase $ Crypto.encToPublic esk
pure $ groupAddresses $ filterAddresses m
where
toHdAddressId :: Bip44DerivationPath -> HdAddressId
toHdAddressId = bip44PathToAddressId (eskToHdRootId esk)
let isAriadneMnemonic = fromMaybe False $ do
lastWord <- last <$> nonEmpty mnemonicWords
pure (lastWord == "ariadne-v0") -- TODO AD-124: version parsing?
-- TODO: simply ignoring addresses which are not BIP-44 compliant
-- is not perfect (though normal users shouldn't have addresses at
-- different levels). We should probably at least show some
-- message if we encounter such addresses. Let's do it after
-- switching to modern wallet data layer.
rFromEither <- if
| isAriadneMnemonic ->
pure . Left $ Mnemonic (unwords $ Unsafe.init mnemonicWords)
| length mnemonicWords == 12 ->
pure . Right $ BackupPhrase mnemonicWords
| otherwise -> throwM $ WrongMnemonic "Unknown mnemonic type"
filterAddresses :: AddressWithPathToUtxoMap -> PrefilteredUtxo
filterAddresses = Map.fromList . mapMaybe f . toPairs
where
f ((DerivationPath derPath, addr), utxo) =
case decodeBip44DerivationPath derPath of
Nothing -> Nothing
Just bip44DerPath -> Just ((toHdAddressId bip44DerPath, addr), utxo)
pure $ RestoreFromMnemonic rFromEither pp
groupAddresses :: PrefilteredUtxo -> UtxoByAccount
groupAddresses =
-- See https://hackage.haskell.org/package/lens-3.10.1/docs/Control-Lens-Iso.html#v:non
-- or a comment in Ariadne.Wallet.Backend.AddressDiscovery.discoverHDAddressesWithUtxo
-- for an explanation of how this works.
let step :: UtxoByAccount ->
(HdAddressId, Address) ->
Utxo ->
UtxoByAccount
step utxoByAccount addrWithId@(addressId, _) utxo =
utxoByAccount &
at (addressId ^. hdAddressIdParent) .
non mempty .
at addrWithId ?~ utxo
in Map.foldlWithKey' step mempty
getWalletName :: Maybe WalletName -> WalletName
getWalletName = fromMaybe (WalletName "Restored wallet")
@@ -1,4 +1,4 @@
module Ariadne.Wallet.Backend.AddressDiscovery
module Ariadne.Wallet.Cardano.Kernel.AddressDiscovery
( AddressWithPathToUtxoMap
, discoverHDAddressWithUtxo
, discoverHDAddressesWithUtxo
@@ -0,0 +1,172 @@
-- | Cardano Wallet restoration logic.
module Ariadne.Wallet.Cardano.Kernel.Restore
( collectUtxo
, restoreWallets
, RestoreFrom (..)
, WalletToRestore (..)
, WrongMnemonic (..)
) where
import Control.Exception (Exception(displayException))
import Control.Lens (at, non, (?~))
import qualified Data.ByteString as BS
import qualified Data.Map.Strict as Map
import Pos.Binary.Class (decodeFull')
import Pos.Core.Configuration (HasConfiguration)
import Pos.Crypto (EncryptedSecretKey, PassPhrase)
import qualified Pos.Crypto as Crypto
(checkPassMatches, deriveHDPassphrase, emptyPassphrase, encToPublic,
safeDeterministicKeyGen)
import Pos.Txp.Toil.Types (Utxo)
import Pos.Util.BackupPhrase (BackupPhrase(..), safeKeysFromPhrase)
import Pos.Util.UserSecret (usKeys0)
import Ariadne.Cardano.Face (Address, CardanoMode)
import Ariadne.Wallet.Cardano.Kernel.AddressDiscovery
(AddressWithPathToUtxoMap, discoverHDAddressWithUtxo)
import Ariadne.Wallet.Cardano.Kernel.Bip32 (DerivationPath(..))
import Ariadne.Wallet.Cardano.Kernel.Bip39 (mnemonicToSeedNoPassword)
import Ariadne.Wallet.Cardano.Kernel.Bip44
(Bip44DerivationPath(..), bip44PathToAddressId, decodeBip44DerivationPath)
import Ariadne.Wallet.Cardano.Kernel.DB.HdWallet
(AssuranceLevel(..), HdAddressId, WalletName(..), eskToHdRootId,
hdAddressIdParent)
import Ariadne.Wallet.Cardano.Kernel.PrefilterTx
(PrefilteredUtxo, UtxoByAccount)
import Ariadne.Wallet.Cardano.Kernel.Wallets
(HasNonemptyPassphrase(..), mkHasPP)
import Ariadne.Wallet.Face (Mnemonic(..))
newtype WrongMnemonic = WrongMnemonic Text
deriving (Eq, Show)
instance Exception WrongMnemonic where
displayException (WrongMnemonic txt) =
"Wrong mnemonic: " <> show txt
data SecretsDecodingError = SecretsDecodingError FilePath Text
deriving (Eq, Show)
instance Exception SecretsDecodingError where
displayException (SecretsDecodingError path txt) =
"Failed to decode " <> path <> ": " <> show txt
data RestoreFrom
= RestoreFromMnemonic !(Either Mnemonic BackupPhrase)
!PassPhrase
| RestoreFromKeyFile !FilePath
data WalletToRestore = WalletToRestore
!EncryptedSecretKey
!HasNonemptyPassphrase
!WalletName
!AssuranceLevel
restoreWallets
:: RestoreFrom
-> WalletName
-> IO [WalletToRestore]
restoreWallets rFrom walletName = do
case rFrom of
RestoreFromMnemonic eMnemonicBPhrase pp -> do
walletRestore <- restoreWalletFromMnemonic pp walletName eMnemonicBPhrase
pure [walletRestore]
RestoreFromKeyFile path ->
restoreFromKeyFile walletName path
restoreWalletFromMnemonic
:: MonadThrow m
=> PassPhrase
-> WalletName
-> Either Mnemonic BackupPhrase
-> m WalletToRestore
restoreWalletFromMnemonic pp walletName eMnemonicBPhrase = do
let hasPP = mkHasPP pp
esk <- getKeyFromMnemonic pp eMnemonicBPhrase
pure $ WalletToRestore esk hasPP walletName assurance
where
-- TODO(AD-251): allow selecting assurance.
assurance = AssuranceLevelNormal
restoreFromKeyFile
:: WalletName
-> FilePath
-> IO [WalletToRestore]
restoreFromKeyFile walletName path = do
esks <- readNonAriadneKeys path
let templateName i (WalletName n) = WalletName $ n <> " " <> pretty i
let hasPP esk = HasNonemptyPassphrase $ isNothing $ Crypto.checkPassMatches Crypto.emptyPassphrase esk
pure $
fmap
(\(i,esk) -> WalletToRestore esk (hasPP esk) (templateName i walletName) assurance)
(zip [(0 :: Int)..] esks)
where
-- TODO(AD-251): allow selecting assurance.
assurance = AssuranceLevelNormal
getKeyFromMnemonic
:: MonadThrow m
=> PassPhrase
-> Either Mnemonic BackupPhrase
-> m EncryptedSecretKey
getKeyFromMnemonic pp = \case
Left (Mnemonic mnemonic) ->
let seed = mnemonicToSeedNoPassword mnemonic
in pure . snd $ Crypto.safeDeterministicKeyGen seed pp
Right backupPhrase ->
case safeKeysFromPhrase pp backupPhrase of
Left e -> throwM $ WrongMnemonic e
Right (sk, _) -> pure sk
-- | Reads daedalus wallet keys from file for wallet restoration
readNonAriadneKeys :: FilePath -> IO [EncryptedSecretKey]
readNonAriadneKeys path = do
keyFile <- BS.readFile path
case decodeFull' keyFile of
Left e -> throwM $ SecretsDecodingError path e
Right us -> pure $ us ^. usKeys0
collectUtxo ::
HasConfiguration
=> EncryptedSecretKey
-> CardanoMode UtxoByAccount
collectUtxo esk = do
m <- discoverHDAddressWithUtxo $ Crypto.deriveHDPassphrase $ Crypto.encToPublic esk
pure $ groupAddresses $ filterAddresses m
where
toHdAddressId :: Bip44DerivationPath -> HdAddressId
toHdAddressId = bip44PathToAddressId (eskToHdRootId esk)
-- TODO: simply ignoring addresses which are not BIP-44 compliant
-- is not perfect (though normal users shouldn't have addresses at
-- different levels). We should probably at least show some
-- message if we encounter such addresses. Let's do it after
-- switching to modern wallet data layer.
filterAddresses :: AddressWithPathToUtxoMap -> PrefilteredUtxo
filterAddresses = Map.fromList . mapMaybe f . toPairs
where
f ((DerivationPath derPath, addr), utxo) =
case decodeBip44DerivationPath derPath of
Nothing -> Nothing
Just bip44DerPath -> Just ((toHdAddressId bip44DerPath, addr), utxo)
groupAddresses :: PrefilteredUtxo -> UtxoByAccount
groupAddresses =
-- See https://hackage.haskell.org/package/lens-3.10.1/docs/Control-Lens-Iso.html#v:non
-- or a comment in Ariadne.Wallet.Cardano.Kernel.AddressDiscovery.discoverHDAddressesWithUtxo
-- for an explanation of how this works.
let step :: UtxoByAccount ->
(HdAddressId, Address) ->
Utxo ->
UtxoByAccount
step utxoByAccount addrWithId@(addressId, _) utxo =
utxoByAccount &
at (addressId ^. hdAddressIdParent) .
non mempty .
at addrWithId ?~ utxo
in Map.foldlWithKey' step mempty
Oops, something went wrong.

0 comments on commit 01b6b90

Please sign in to comment.