simplex-chat/tests/WalletTests.hs

{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE PostfixOperators #-}

module WalletTests where

import ChatClient
import ChatTests.DBUtils
import ChatTests.Utils
import Control.Monad ((<=<))
import qualified Data.ByteArray as BA
import qualified Data.ByteArray.Encoding as BAE
import Data.ByteString.Char8 (ByteString)
import qualified Data.ByteString.Char8 as B
import Data.Char (toUpper)
import Data.Either (isRight)
import Data.List (nub)
import qualified Data.Text as T
import Simplex.Chat.Wallet (AccountIndex, WalletError (..), accountSecret, deriveAccountKey, entropyFromMnemonic, renderAccountPath, seedMaster, seedMnemonic)
import qualified Simplex.Messaging.Crypto.BIP39 as B39
import qualified Simplex.Messaging.Crypto.Secp256k1 as S
import Simplex.Messaging.Encoding.String (strEncode)
import Simplex.Messaging.Eth.Address (addressFromPrivateKey)
import Simplex.Messaging.Util (safeDecodeUtf8)
import Test.Hspec hiding (it)
import qualified Test.Hspec as Hspec

-- | The standard BIP-39 test vector, 12 words, to check the addresses against another wallet.
testPhrase12 :: ByteString
testPhrase12 = B.unwords $ replicate 11 "abandon" <> ["about"]

-- | The 24 word all-zero-entropy vector, the length the commands take.
testPhrase24 :: ByteString
testPhrase24 = B.unwords $ replicate 23 "abandon" <> ["art"]

seedEntropy :: ByteString -> BA.ScrubbedBytes
seedEntropy phrase = BA.convert . B39.mnemonicToEntropy . either error id $ B39.parseMnemonic phrase

accountKey :: BA.ScrubbedBytes -> AccountIndex -> IO S.Secp256k1PrivateKey
accountKey entropy n = do
  m <- either (error . show) id <$> seedMaster entropy
  either (error . show) id <$> deriveAccountKey m n

addressOf :: S.Secp256k1PrivateKey -> IO String
addressOf k = B.unpack . strEncode <$> addressFromPrivateKey k

-- | The address a wallet reaches when the secret is imported as a private key.
addressFromSecret :: String -> IO String
addressFromSecret secret =
  addressOf . either error id =<< S.mkPrivateKey (either error id $ BAE.convertFromBase BAE.Base16 (B.drop 2 $ B.pack secret))

-- | An @export account@ row: the index, the path, the address, the secret.
exportRow :: HasCallStack => String -> (String, String, String, String)
exportRow row = case words row of
  [idx, path, address, secret] -> (idx, path, address, secret)
  _ -> error $ "unexpected export row: " <> row

walletDerivationTests :: Spec
walletDerivationTests = do
  Hspec.it "accounts are the accounts another wallet derives for the same phrase" $ do
    let addrOf n = addressOf =<< accountKey (seedEntropy testPhrase12) n
    -- Ledger Live accounts 1 and 2 for this phrase, the published values for it
    addrOf 0 `shouldReturn` "0x9858EfFD232B4033E47d90003D41EC34EcaEda94"
    addrOf 1 `shouldReturn` "0x78839F6054d7ed13918bAe0473BA31b1Ca9D7265"
  Hspec.it "the exported secret is the one another wallet shows for that account" $ do
    k <- accountKey (seedEntropy testPhrase12) 0
    -- as a wallet shows it for m/44'/60'/0'/0/0 of this phrase
    accountSecret k `shouldBe` "0x1ab42cc412b618bdea3a599e3c9bae199ebf030895b039e9db1e30dafb12b727"
  Hspec.it "every account has its own address" $ do
    let entropy = seedEntropy testPhrase12
    addrs <- mapM (addressOf <=< accountKey entropy) [0 .. 9]
    length (nub addrs) `shouldBe` 10
  Hspec.it "a secret whose first byte is zero keeps its 64 hex digits" $ do
    k <- either error id <$> S.mkPrivateKey (BA.convert $ B.pack ('\0' : replicate 31 '\1'))
    let secret = T.unpack $ accountSecret k
    take 4 secret `shouldBe` "0x00"
    length secret `shouldBe` 66
  Hspec.it "renders the path an account sits at" $ do
    renderAccountPath 0 `shouldBe` "m/44'/60'/0'/0/0"
    renderAccountPath 7 `shouldBe` "m/44'/60'/7'/0/0"
  Hspec.it "round-trips the phrase it was imported from" $
    seedMnemonic (seedEntropy testPhrase24) `shouldBe` Right (safeDecodeUtf8 testPhrase24)
  Hspec.it "takes 24 words only, with a valid checksum" $ do
    entropyFromMnemonic testPhrase24 `shouldSatisfy` isRight
    entropyFromMnemonic testPhrase12 `shouldBe` Left WEBadMnemonic
    entropyFromMnemonic (B.unwords $ replicate 24 "abandon") `shouldBe` Left WEBadMnemonic

walletTests :: SpecWith TestParams
walletTests = do
  it "creates no wallet until asked, and only one" testWalletCreate
  it "binds the next free account, and re-binding one it holds changes nothing" testWalletBind
  it "keeps each profile's accounts apart" testWalletAccountsPerProfile
  it "taking the next account skips one already bound by index" testWalletBindByIndexThenNext
  it "leaves a deleted profile's account for another profile to take" testWalletDeletedProfileAccount
  it "derives an address without taking it" testWalletAddress
  it "exports the master phrase and one account's secret" testWalletExport
  it "will not take a new account on an imported phrase" testWalletImport
  it "the wallet, the accounts and the counter come back after a restart" testWalletPersists
  it "deletes the wallet, and one can be made again" testWalletDelete
  it "a hidden profile is bound no account" testWalletHiddenProfile
  it "will not export an account another profile holds" testWalletExportNotMine
  it "refuses an index BIP-32 cannot harden, on every command" testWalletIndexTooLarge

testWalletCreate :: HasCallStack => TestParams -> IO ()
testWalletCreate ps = withNewTestChat ps "alice" aliceProfile $ \alice -> do
  alice ##> "/_wallet"
  alice <## "no wallet on this device"
  -- reading creates nothing
  alice ##> "/_wallet"
  alice <## "no wallet on this device"
  alice ##> "/_wallet export master"
  alice <## "wallet: this device has no wallet"
  alice ##> "/_wallet bind"
  alice <## "wallet: this device has no wallet"
  alice ##> "/_wallet delete"
  alice <## "wallet: this device has no wallet"
  alice ##> "/_wallet create new"
  alice <## "wallet, no accounts for this profile"
  alice ##> "/_wallet create new"
  alice <## "wallet: this device already has a wallet"
  alice ##> "/_wallet delete"
  alice <## "ok"
  -- a mistyped phrase says nothing about which word was wrong
  alice ##> ("/_wallet create mnemonic=" <> B.unpack (B.unwords $ replicate 24 "abandon"))
  alice <## "wallet: not a valid 24 word recovery phrase"
  -- a phrase is taken as a backup card writes it, case and all
  alice ##> ("/_wallet create mnemonic=" <> map toUpper (B.unpack testPhrase24))
  alice <## "wallet, no accounts for this profile"
  alice ##> "/_wallet export master"
  alice <## B.unpack testPhrase24

testWalletBind :: HasCallStack => TestParams -> IO ()
testWalletBind ps = withNewTestChat ps "alice" aliceProfile $ \alice -> do
  alice ##> "/_wallet create new"
  alice <## "wallet, no accounts for this profile"
  alice ##> "/_wallet bind"
  alice <## "accounts: 0"
  -- a profile owns as many accounts as it owns names
  alice ##> "/_wallet bind"
  alice <## "accounts: 0, 1"
  -- binding one it already holds changes nothing
  alice ##> "/_wallet bind account=0"
  alice <## "accounts: 0, 1"

testWalletAccountsPerProfile :: HasCallStack => TestParams -> IO ()
testWalletAccountsPerProfile ps = withNewTestChat ps "alice" aliceProfile $ \alice -> do
  alice ##> "/_wallet create new"
  alice <## "wallet, no accounts for this profile"
  alice ##> "/_wallet bind"
  alice <## "accounts: 0"
  alice ##> "/create user alisa"
  showActiveUser alice "alisa"
  -- the wallet is the device's, the accounts are the profile's
  alice ##> "/_wallet"
  alice <## "wallet, no accounts for this profile"
  alice ##> "/_wallet bind"
  alice <## "accounts: 1"
  alice ##> "/_wallet bind account=0"
  alice <## "wallet: another profile holds this account"

testWalletBindByIndexThenNext :: HasCallStack => TestParams -> IO ()
testWalletBindByIndexThenNext ps = withNewTestChat ps "alice" aliceProfile $ \alice -> do
  alice ##> "/_wallet create new"
  alice <## "wallet, no accounts for this profile"
  -- an account a scan found, bound by index, is still taken
  alice ##> "/_wallet bind account=2"
  alice <## "accounts: 2"
  alice ##> "/_wallet bind"
  alice <## "accounts: 2, 3"
  -- accounts are listed by index, not by the order they were bound
  alice ##> "/_wallet bind account=1"
  alice <## "accounts: 1, 2, 3"
  -- and binding a low index never moves the counter back onto an account held
  alice ##> "/_wallet bind"
  alice <## "accounts: 1, 2, 3, 4"

testWalletDeletedProfileAccount :: HasCallStack => TestParams -> IO ()
testWalletDeletedProfileAccount ps = withNewTestChat ps "alice" aliceProfile $ \alice -> do
  alice ##> "/_wallet create new"
  alice <## "wallet, no accounts for this profile"
  alice ##> "/_wallet bind"
  alice <## "accounts: 0"
  alice ##> "/create user alisa"
  showActiveUser alice "alisa"
  -- deleting a profile does not take its account with it
  alice ##> "/delete user alice"
  alice <### ["ok", "completed deleting user"]
  alice ##> "/_wallet"
  alice <## "wallet, no accounts for this profile"
  -- and another profile can take it, which is how a name outlives its profile
  alice ##> "/_wallet bind account=0"
  alice <## "accounts: 0"

testWalletAddress :: HasCallStack => TestParams -> IO ()
testWalletAddress ps = withNewTestChat ps "alice" aliceProfile $ \alice -> do
  alice ##> "/_wallet create new"
  alice <## "wallet, no accounts for this profile"
  -- reading the next free account does not take it
  alice ##> "/_wallet address"
  addr <- getTermLine alice
  alice ##> "/_wallet address"
  addr' <- getTermLine alice
  addr' `shouldBe` addr
  words addr !! 1 `shouldBe` "m/44'/60'/0'/0/0"
  alice ##> "/_wallet address account=3"
  at3 <- getTermLine alice
  words at3 !! 1 `shouldBe` "m/44'/60'/3'/0/0"
  -- a zero-padded index is the same index
  alice ##> "/_wallet address account=0000000003"
  getTermLine alice `shouldReturn` at3
  -- a malformed index is a parse error, never a silent bind of the next account
  alice ##> "/_wallet bind account=abc"
  alice <## "bad chat command: Failed reading: empty"
  alice ##> "/_wallet"
  alice <## "wallet, no accounts for this profile"

testWalletExport :: HasCallStack => TestParams -> IO ()
testWalletExport ps = withNewTestChat ps "alice" aliceProfile $ \alice -> do
  alice ##> ("/_wallet create mnemonic=" <> B.unpack testPhrase24)
  alice <## "wallet, no accounts for this profile"
  alice ##> "/_wallet export master"
  alice <## B.unpack testPhrase24
  alice ##> "/_wallet export account 0"
  (idx, path, address, secret) <- exportRow <$> getTermLine alice
  idx `shouldBe` "0"
  path `shouldBe` "m/44'/60'/0'/0/0"
  -- m/44'/60'/0'/0/0 of the 24 word vector, pinned so a change of path fails here
  address `shouldBe` "0xF278cF59F82eDcf871d630F28EcC8056f25C1cdb"
  addressFromSecret secret `shouldReturn` address
  -- the index reaches the key, not only the path printed beside it
  alice ##> "/_wallet export account 1"
  (idx', path', address', _) <- exportRow <$> getTermLine alice
  idx' `shouldBe` "1"
  path' `shouldBe` "m/44'/60'/1'/0/0"
  (addressOf =<< accountKey (seedEntropy testPhrase24) 1) `shouldReturn` address'
  -- and an address is read from the account the command names, not the counter
  alice ##> "/_wallet address account=1"
  addressRow <- words <$> getTermLine alice
  addressRow `shouldBe` ["1", "m/44'/60'/1'/0/0", address']

testWalletImport :: HasCallStack => TestParams -> IO ()
testWalletImport ps = withNewTestChat ps "alice" aliceProfile $ \alice -> do
  alice ##> ("/_wallet create mnemonic=" <> B.unpack testPhrase24)
  alice <## "wallet, no accounts for this profile"
  -- the phrase does not say how many accounts it has been used for
  alice ##> "/_wallet bind"
  alice <## "wallet: unknown how many accounts this phrase has used, a scan of the chain has to run first"
  alice ##> "/_wallet address"
  alice <## "wallet: unknown how many accounts this phrase has used, a scan of the chain has to run first"
  -- binding an account a scan found is what a restored device does
  alice ##> "/_wallet bind account=4"
  alice <## "accounts: 4"
  -- and the counter stays unknown, because the phrase still does not say
  alice ##> "/_wallet bind"
  alice <## "wallet: unknown how many accounts this phrase has used, a scan of the chain has to run first"

testWalletPersists :: HasCallStack => TestParams -> IO ()
testWalletPersists ps = do
  phrase <- withNewTestChat ps "alice" aliceProfile $ \alice -> do
    alice ##> "/_wallet create new"
    alice <## "wallet, no accounts for this profile"
    alice ##> "/_wallet bind account=2"
    alice <## "accounts: 2"
    alice ##> "/_wallet export master"
    getTermLine alice
  -- same database, new session: an account holding a name must stay reachable
  withTestChat ps "alice" $ \alice -> do
    alice ##> "/_wallet"
    alice <## "accounts: 2"
    alice ##> "/_wallet export master"
    alice <## phrase
    -- the counter came back too, so no account is handed out a second time
    alice ##> "/_wallet bind"
    alice <## "accounts: 2, 3"

testWalletDelete :: HasCallStack => TestParams -> IO ()
testWalletDelete ps = withNewTestChat ps "alice" aliceProfile $ \alice -> do
  alice ##> "/_wallet create new"
  alice <## "wallet, no accounts for this profile"
  alice ##> "/_wallet bind account=1"
  alice <## "accounts: 1"
  alice ##> "/_wallet delete"
  alice <## "ok"
  alice ##> "/_wallet"
  alice <## "no wallet on this device"
  alice ##> "/_wallet create new"
  alice <## "wallet, no accounts for this profile"
  -- the new wallet holds no account and its counter starts over
  alice ##> "/_wallet bind"
  alice <## "accounts: 0"

testWalletHiddenProfile :: HasCallStack => TestParams -> IO ()
testWalletHiddenProfile ps = withNewTestChat ps "alice" aliceProfile $ \alice -> do
  alice ##> "/_wallet create new"
  alice <## "wallet, no accounts for this profile"
  alice ##> "/create user alisa"
  showActiveUser alice "alisa"
  alice ##> "/hide user my_password"
  alice <## "current user alisa:"
  alice <## "messages are hidden (use /tail to view)"
  alice <## "profile is hidden"
  alice ##> "/_wallet bind"
  alice <## "wallet: a hidden profile cannot own an account"

testWalletExportNotMine :: HasCallStack => TestParams -> IO ()
testWalletExportNotMine ps = withNewTestChat ps "alice" aliceProfile $ \alice -> do
  alice ##> "/_wallet create new"
  alice <## "wallet, no accounts for this profile"
  alice ##> "/_wallet bind"
  alice <## "accounts: 0"
  -- the profile's own account is its to export
  alice ##> "/_wallet export account 0"
  (_, path, _, _) <- exportRow <$> getTermLine alice
  path `shouldBe` "m/44'/60'/0'/0/0"
  alice ##> "/create user alisa"
  showActiveUser alice "alisa"
  -- account 0 is the other profile's, and its key is not this profile's to take
  alice ##> "/_wallet export account 0"
  alice <## "wallet: another profile holds this account"
  -- an account nobody holds is still derivable, which is what a scan needs
  alice ##> "/_wallet export account 7"
  (_, path', _, _) <- exportRow <$> getTermLine alice
  path' `shouldBe` "m/44'/60'/7'/0/0"

testWalletIndexTooLarge :: HasCallStack => TestParams -> IO ()
testWalletIndexTooLarge ps = withNewTestChat ps "alice" aliceProfile $ \alice -> do
  alice ##> "/_wallet create new"
  alice <## "wallet, no accounts for this profile"
  -- 2^31 is already a hardened component, so it would derive account 0's key
  alice ##> "/_wallet address account=2147483648"
  alice <## "wallet: account index is too large to harden"
  alice ##> "/_wallet bind account=2147483648"
  alice <## "wallet: account index is too large to harden"
  alice ##> "/_wallet export account 2147483648"
  alice <## "wallet: account index is too large to harden"
  -- the largest index that can be hardened is usable, and the counter follows it
  alice ##> "/_wallet bind account=2147483647"
  alice <## "accounts: 2147483647"
  alice ##> "/_wallet bind"
  alice <## "wallet: account index is too large to harden"