infallibel wallet and account derivation

src/Simplex/Chat/Library/Commands.hs

@@ -65,7 +65,7 @@ import Simplex.Chat.Badges.Types (BadgeAlert (..), BadgeAlertKind (..), BadgeIss
 import Simplex.Chat.Badges.Code (badgeCodeText, parseBadgeCode)
 import Simplex.Chat.Badges.Service (BadgeBalance (..), BadgeServiceCommand (..), BadgeServiceErrorCode (..), BadgeServiceRequest (..), BadgeServiceResponse (..), BadgeStatement (..), StatementDebitType (..), StatementEntry (..), StatementEntryType (..), currentBadgeServiceVersion)
 import Simplex.Chat.Names (SimplexDomainProof (..), SimplexDomainClaim (..), claimDomain, mkDomainClaim)
-import Simplex.Chat.Wallet (AccountIndex, AccountKey, WalletAddress, WalletError (..), accountSecret, deriveAccount, entropyFromMnemonic, newSeedEntropy, newWalletMaster, seedMnemonic)
+import Simplex.Chat.Wallet (AccountIndex, AccountKey, WalletAddress, WalletError (..), accountSecret, deriveAccount, importWalletMaster, newWalletMaster, seedMnemonic)
 import Simplex.Chat.Call
 import Simplex.Chat.Controller
 import Simplex.Chat.Delivery (DeliveryJobScope (..), DeliveryJobSpec (..), DeliveryWorkerScope (..))
@@ -1506,10 +1506,9 @@ processChatCommand cxt nm = \case
     wallet_ <- withFastStore getWallet
     when (isJust wallet_) $ throwWalletError WEMasterExists
     -- the counter starts at 0 for a generated seed and is unknown for an imported one
-    (entropy, nextAccount) <- case mnemonic_ of
-      Nothing -> (,Just 0) <$> (asks random >>= atomically . newSeedEntropy)
-      Just phrase -> (,Nothing) <$> liftWallet (entropyFromMnemonic phrase)
-    master <- liftWallet $ newWalletMaster entropy
+    (master, nextAccount) <- case mnemonic_ of
+      Nothing -> (,Just 0) <$> (liftIO . newWalletMaster =<< asks random)
+      Just phrase -> (,Nothing) <$> liftWallet (importWalletMaster phrase)
     created <- withFastStore' $ \db -> createWallet db master nextAccount
     unless created $ throwWalletError WEMasterExists
     pure $ CRWallet user (Just [])
@@ -6039,7 +6038,7 @@ withWalletStore action = liftWallet =<< withFastStore action
 walletAccount :: Wallet -> AccountIndex -> CM (AccountKey, WalletAddress)
 walletAccount Wallet {walletMaster} n = do
   g <- asks random
-  liftError' (ChatError . CEWallet) (deriveAccount g walletMaster n)
+  liftIO $ deriveAccount g walletMaster n
 
 chatCommandP :: Parser ChatCommand
 chatCommandP =

src/Simplex/Chat/View.hs

@@ -2813,7 +2813,8 @@ viewChatError isCmd logLevel testView = \case
             SDEUnknownDomain -> "is not included in the connection link's profile"
        in [plain $ "SimpleX name " <> strEncode domain <> " " <> reason]
     CEWallet walletErr ->
-      let reason = case walletErr of
+      let reason :: Text
+          reason = case walletErr of
             WENoMaster -> "this device has no wallet"
             WEMasterExists -> "this device already has a wallet"
             WEBadMnemonic -> "not a valid 24 word recovery phrase"
@@ -2822,7 +2823,6 @@ viewChatError isCmd logLevel testView = \case
             WEAccountNotHeld -> "this profile does not hold this account"
             WECounterUnknown -> "the next account is unknown after an import"
             WEAccountsExhausted -> "every account index is used"
-            WEDerivation e -> "derivation failed: " <> T.pack e
        in [plain $ "wallet: " <> reason]
     CENotResolvedLocally -> ["no matching chat found, name resolution is disabled"]
     CEUnsupportedConnReq -> [ "", "Connection link is not supported by the your app version, please ugrade it.", plain updateStr]

src/Simplex/Chat/Wallet.hs

@@ -6,9 +6,9 @@ module Simplex.Chat.Wallet
     AccountKey,
     WalletAddress (..),
     WalletError (..),
-    newSeedEntropy,
-    entropyFromMnemonic,
     newWalletMaster,
+    entropyFromMnemonic,
+    importWalletMaster,
     seedMnemonic,
     deriveAccount,
     accountSecret,
@@ -16,11 +16,8 @@ module Simplex.Chat.Wallet
 where
 
 import Control.Concurrent.STM
-import Control.Monad.Except
-import Control.Monad.IO.Class (liftIO)
 import Crypto.Random (ChaChaDRG)
 import qualified Data.Aeson.TH as JQ
-import Data.Bifunctor (first)
 import qualified Data.ByteArray.Encoding as BAE
 import Data.Text (Text)
 import Data.Text.Encoding (decodeLatin1)
@@ -31,7 +28,6 @@ import qualified Simplex.Messaging.Crypto.Secp256k1 as S
 import Simplex.Messaging.Encoding.String (strEncode)
 import Simplex.Messaging.Eth.Address (addressFromPrivateKey)
 import Simplex.Messaging.Parsers (defaultJSON, dropPrefix, sumTypeJSON)
-import Simplex.Messaging.Util (liftError')
 
 type AccountKey = S.Secp256k1PrivateKey
 
@@ -51,30 +47,29 @@ data WalletError
   | WEAccountNotHeld
   | WECounterUnknown
   | WEAccountsExhausted
-  | WEDerivation {derivationError :: String}
   deriving (Eq, Show)
 
 masterStrength :: B39.EntropyStrength
 masterStrength = B39.ES256
 
-newSeedEntropy :: TVar ChaChaDRG -> STM B39.WalletEntropy
-newSeedEntropy = B39.randomEntropy masterStrength
+newWalletMaster :: TVar ChaChaDRG -> IO B32.WalletMaster
+newWalletMaster g = (`B32.mkWalletMaster` "") <$> atomically (B39.randomEntropy masterStrength g)
 
 entropyFromMnemonic :: Text -> Either WalletError B39.WalletEntropy
 entropyFromMnemonic phrase = case B39.parsePhrase phrase of
   Right ent | B39.entropyWordCount ent == 24 -> Right ent
   _ -> Left WEBadMnemonic
 
-newWalletMaster :: B39.WalletEntropy -> Either WalletError B32.WalletMaster
-newWalletMaster ent = first WEDerivation $ B32.mkWalletMaster ent ""
+importWalletMaster :: Text -> Either WalletError B32.WalletMaster
+importWalletMaster phrase = (`B32.mkWalletMaster` "") <$> entropyFromMnemonic phrase
 
 seedMnemonic :: B32.WalletMaster -> Text
 seedMnemonic = decodeLatin1 . B39.entropyPhrase . B32.masterEntropy
 
-deriveAccount :: TVar ChaChaDRG -> B32.WalletMaster -> AccountIndex -> IO (Either WalletError (AccountKey, WalletAddress))
-deriveAccount g master n = runExceptT $ do
-  k <- B32.xkKey <$> liftError' WEDerivation (B32.derivePath g (B32.walletMasterKey master) path)
-  a <- liftIO $ addressFromPrivateKey g k
+deriveAccount :: TVar ChaChaDRG -> B32.WalletMaster -> AccountIndex -> IO (AccountKey, WalletAddress)
+deriveAccount g master n = do
+  k <- B32.xkKey <$> B32.derivePath g (B32.walletMasterKey master) path
+  a <- addressFromPrivateKey g k
   pure (k, WalletAddress {accountIndex = n, keyPath = decodeLatin1 $ B32.renderPath path, address = decodeLatin1 $ strEncode a})
   where
     path = bip44Path Ethereum n