zenith/src/Zenith/Core.hs

182 lines
5.8 KiB
Haskell
Raw Normal View History

{-# LANGUAGE OverloadedStrings #-}
-- | Core wallet functionality for Zenith
module Zenith.Core where
import Control.Exception (throwIO)
import Data.Aeson
2024-03-17 12:17:52 +00:00
import Data.HexString (hexString)
import qualified Data.Text as T
import Database.Persist
import Network.HTTP.Client
import ZcashHaskell.Keys
import ZcashHaskell.Orchard
2024-03-17 12:17:52 +00:00
( encodeUnifiedAddress
, genOrchardReceiver
, genOrchardSpendingKey
)
import ZcashHaskell.Sapling
( genSaplingInternalAddress
, genSaplingPaymentAddress
, genSaplingSpendingKey
)
import ZcashHaskell.Transparent (genTransparentPrvKey, genTransparentReceiver)
import ZcashHaskell.Types
import ZcashHaskell.Utils
import Zenith.DB
2024-03-17 12:17:52 +00:00
import Zenith.Types
( OrchardSpendingKeyDB(..)
, PhraseDB(..)
, SaplingSpendingKeyDB(..)
, ScopeDB(..)
, TransparentSpendingKeyDB(..)
, UnifiedAddressDB(..)
, ZcashNetDB(..)
)
-- * Zebra Node interaction
-- | Checks the status of the `zebrad` node
checkZebra ::
2024-02-14 18:03:18 +00:00
T.Text -- ^ Host where `zebrad` is available
-> Int -- ^ Port where `zebrad` is available
-> IO ZebraGetInfo
2024-02-28 21:12:57 +00:00
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 ::
2024-02-14 18:03:18 +00:00
T.Text -- ^ Host where `zebrad` is available
-> Int -- ^ Port where `zebrad` is available
-> IO ZebraGetBlockChainInfo
2024-02-28 21:12:57 +00:00
checkBlockChain nodeHost nodePort = do
r <- makeZebraCall nodeHost nodePort "getblockchaininfo" []
case r of
Left e -> throwIO $ userError e
Right bci -> return bci
-- * Spending Keys
-- | Create an Orchard Spending Key for the given wallet and account index
2024-03-17 12:17:52 +00:00
createOrchardSpendingKey :: ZcashWallet -> Int -> IO OrchardSpendingKey
createOrchardSpendingKey zw i = do
2024-03-17 12:17:52 +00:00
let s = getWalletSeed $ getPhrase $ zcashWalletSeedPhrase zw
case s of
Nothing -> throwIO $ userError "Unable to generate seed"
Just s' -> do
let coinType =
2024-03-17 12:17:52 +00:00
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
2024-03-17 12:17:52 +00:00
-- | 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
2024-03-17 12:17:52 +00:00
sapSk <- createSaplingSpendingKey (entityVal zw) i
tSk <- createTransparentSpendingKey (entityVal zw) i
return $
ZcashAccount
i
(entityKey zw)
n
(OrchardSpendingKeyDB orSk)
(SaplingSpendingKeyDB sapSk)
(TransparentSpendingKeyDB tSk)
2024-03-07 20:20:06 +00:00
-- * Addresses
2024-03-17 12:17:52 +00:00
-- | Create an external unified address for the given account and index
2024-03-07 20:20:06 +00:00
createWalletAddress ::
T.Text -- ^ The address nickname
-> Int -- ^ The address' index
-> ZcashNet -- ^ The network for this address
2024-03-17 12:17:52 +00:00
-> Scope -- ^ External or Internal
2024-03-07 20:20:06 +00:00
-> Entity ZcashAccount -- ^ The Zcash account that the address will be attached to
-> IO WalletAddress
2024-03-17 12:17:52 +00:00
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
2024-03-07 20:20:06 +00:00
return $
WalletAddress
i
(entityKey za)
n
2024-03-17 12:17:52 +00:00
(UnifiedAddressDB $
encodeUnifiedAddress $ UnifiedAddress zNet oRec sRec (Just tRec))
(ScopeDB scope)
2024-04-04 18:21:55 +00:00
-- * Wallet
-- | Sync the wallet with the data store
syncWallet ::
2024-04-04 19:35:08 +00:00
T.Text -- ^ The database path
2024-04-04 18:21:55 +00:00
-> Entity ZcashWallet
2024-04-07 14:25:25 +00:00
-> 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
2024-04-08 20:51:14 +00:00
sapNotes <-
mapM
(findSaplingOutputs walletDb lastBlock (zcashWalletNetwork $ entityVal w) .
zcashAccountSapSpendKey . entityVal)
accs
print "Transparent Notes: "
print trNotes
print "Sapling notes: "
print sapNotes
return "Testing"