{-# LANGUAGE OverloadedStrings #-} -- | Core wallet functionality for Zenith module Zenith.Core where import Control.Exception (throwIO) import Data.Aeson import Data.HexString (hexString) import qualified Data.Text as T import Database.Persist import Network.HTTP.Client import ZcashHaskell.Keys import ZcashHaskell.Orchard ( encodeUnifiedAddress , genOrchardReceiver , genOrchardSpendingKey ) import ZcashHaskell.Sapling ( genSaplingInternalAddress , genSaplingPaymentAddress , genSaplingSpendingKey ) import ZcashHaskell.Transparent (genTransparentPrvKey, genTransparentReceiver) import ZcashHaskell.Types import ZcashHaskell.Utils import Zenith.DB import Zenith.Types ( OrchardSpendingKeyDB(..) , PhraseDB(..) , SaplingSpendingKeyDB(..) , ScopeDB(..) , TransparentSpendingKeyDB(..) , UnifiedAddressDB(..) , ZcashNetDB(..) , ZebraTreeInfo(..) ) -- * Zebra Node interaction -- | Checks the status of the `zebrad` node checkZebra :: T.Text -- ^ Host where `zebrad` is available -> Int -- ^ Port where `zebrad` is available -> IO ZebraGetInfo checkZebra nodeHost nodePort = do res <- makeZebraCall nodeHost nodePort "getinfo" [] case res of Left e -> throwIO $ userError e Right bi -> return bi -- | Checks the status of the Zcash blockchain checkBlockChain :: T.Text -- ^ Host where `zebrad` is available -> Int -- ^ Port where `zebrad` is available -> IO ZebraGetBlockChainInfo checkBlockChain nodeHost nodePort = do r <- makeZebraCall nodeHost nodePort "getblockchaininfo" [] case r of Left e -> throwIO $ userError e Right bci -> return bci -- | Get commitment trees from Zebra getCommitmentTrees :: T.Text -- ^ Host where `zebrad` is avaiable -> Int -- ^ Port where `zebrad` is available -> Int -- ^ Block height -> IO ZebraTreeInfo getCommitmentTrees nodeHost nodePort block = do r <- makeZebraCall nodeHost nodePort "z_gettreestate" [Data.Aeson.String $ T.pack $ show block] case r of Left e -> throwIO $ userError e Right zti -> return zti -- * Spending Keys -- | Create an Orchard Spending Key for the given wallet and account index createOrchardSpendingKey :: ZcashWallet -> Int -> IO OrchardSpendingKey createOrchardSpendingKey zw i = do let s = getWalletSeed $ getPhrase $ zcashWalletSeedPhrase zw case s of Nothing -> throwIO $ userError "Unable to generate seed" Just s' -> do let coinType = case getNet $ zcashWalletNetwork zw of MainNet -> MainNetCoin TestNet -> TestNetCoin RegTestNet -> RegTestNetCoin let r = genOrchardSpendingKey s' coinType i case r of Nothing -> throwIO $ userError "Unable to generate Orchard spending key" Just sk -> return sk -- | Create a Sapling spending key for the given wallet and account index createSaplingSpendingKey :: ZcashWallet -> Int -> IO SaplingSpendingKey createSaplingSpendingKey zw i = do let s = getWalletSeed $ getPhrase $ zcashWalletSeedPhrase zw case s of Nothing -> throwIO $ userError "Unable to generate seed" Just s' -> do let coinType = case getNet $ zcashWalletNetwork zw of MainNet -> MainNetCoin TestNet -> TestNetCoin RegTestNet -> RegTestNetCoin let r = genSaplingSpendingKey s' coinType i case r of Nothing -> throwIO $ userError "Unable to generate Sapling spending key" Just sk -> return sk createTransparentSpendingKey :: ZcashWallet -> Int -> IO TransparentSpendingKey createTransparentSpendingKey zw i = do let s = getWalletSeed $ getPhrase $ zcashWalletSeedPhrase zw case s of Nothing -> throwIO $ userError "Unable to generate seed" Just s' -> do let coinType = case getNet $ zcashWalletNetwork zw of MainNet -> MainNetCoin TestNet -> TestNetCoin RegTestNet -> RegTestNetCoin genTransparentPrvKey s' coinType i -- * Accounts -- | Create an account for the given wallet and account index createZcashAccount :: T.Text -- ^ The account's name -> Int -- ^ The account's index -> Entity ZcashWallet -- ^ The Zcash wallet that this account will be attached to -> IO ZcashAccount createZcashAccount n i zw = do orSk <- createOrchardSpendingKey (entityVal zw) i sapSk <- createSaplingSpendingKey (entityVal zw) i tSk <- createTransparentSpendingKey (entityVal zw) i return $ ZcashAccount i (entityKey zw) n (OrchardSpendingKeyDB orSk) (SaplingSpendingKeyDB sapSk) (TransparentSpendingKeyDB tSk) -- * Addresses -- | Create an external unified address for the given account and index createWalletAddress :: T.Text -- ^ The address nickname -> Int -- ^ The address' index -> ZcashNet -- ^ The network for this address -> Scope -- ^ External or Internal -> Entity ZcashAccount -- ^ The Zcash account that the address will be attached to -> IO WalletAddress createWalletAddress n i zNet scope za = do let oRec = genOrchardReceiver i scope $ getOrchSK $ zcashAccountOrchSpendKey $ entityVal za let sRec = case scope of External -> genSaplingPaymentAddress i $ getSapSK $ zcashAccountSapSpendKey $ entityVal za Internal -> genSaplingInternalAddress $ getSapSK $ zcashAccountSapSpendKey $ entityVal za tRec <- genTransparentReceiver i scope $ getTranSK $ zcashAccountTPrivateKey $ entityVal za return $ WalletAddress i (entityKey za) n (UnifiedAddressDB $ encodeUnifiedAddress $ UnifiedAddress zNet oRec sRec (Just tRec)) (ScopeDB scope) -- * Wallet -- | Sync the wallet with the data store syncWallet :: T.Text -- ^ The database path -> Entity ZcashWallet -> IO String syncWallet walletDb w = do accs <- getAccounts walletDb $ entityKey w addrs <- concat <$> mapM (getAddresses walletDb . entityKey) accs lastBlock <- getMaxWalletBlock walletDb trNotes <- mapM (findTransparentNotes walletDb lastBlock . entityVal) addrs sapNotes <- mapM (findSaplingOutputs walletDb lastBlock (zcashWalletNetwork $ entityVal w) . zcashAccountSapSpendKey . entityVal) accs print "Transparent Notes: " print trNotes print "Sapling notes: " print sapNotes return "Testing"