zenith/src/Zenith/Core.hs

393 lines
13 KiB
Haskell
Raw Normal View History

{-# LANGUAGE OverloadedStrings #-}
-- | Core wallet functionality for Zenith
module Zenith.Core where
2024-04-18 01:28:47 +00:00
import Control.Exception (throwIO, try)
import Data.Aeson
2024-03-17 12:17:52 +00:00
import Data.HexString (hexString)
2024-04-18 01:28:47 +00:00
import Data.Maybe (fromJust)
import qualified Data.Text as T
2024-04-18 01:28:47 +00:00
import qualified Data.Text.Encoding as E
import Database.Persist
2024-04-18 01:28:47 +00:00
import Database.Persist.Sqlite
import Network.HTTP.Client
import ZcashHaskell.Keys
import ZcashHaskell.Orchard
2024-04-18 01:28:47 +00:00
( decryptOrchardActionSK
, encodeUnifiedAddress
2024-03-17 12:17:52 +00:00
, genOrchardReceiver
, genOrchardSpendingKey
2024-04-18 01:28:47 +00:00
, getOrchardNotePosition
, getOrchardWitness
, updateOrchardCommitmentTree
2024-03-17 12:17:52 +00:00
)
import ZcashHaskell.Sapling
2024-04-18 01:28:47 +00:00
( decodeSaplingOutputEsk
, genSaplingInternalAddress
2024-03-17 12:17:52 +00:00
, genSaplingPaymentAddress
, genSaplingSpendingKey
2024-04-18 01:28:47 +00:00
, getSaplingNotePosition
, getSaplingWitness
, updateSaplingCommitmentTree
2024-03-17 12:17:52 +00:00
)
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
2024-04-18 01:28:47 +00:00
( Config(..)
, HexStringDB(..)
, OrchardSpendingKeyDB(..)
2024-03-17 12:17:52 +00:00
, PhraseDB(..)
, SaplingSpendingKeyDB(..)
, ScopeDB(..)
, TransparentSpendingKeyDB(..)
, UnifiedAddressDB(..)
, ZcashNetDB(..)
2024-04-09 18:32:39 +00:00
, ZebraTreeInfo(..)
2024-03-17 12:17:52 +00:00
)
-- * 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
2024-04-09 18:32:39 +00:00
-- | 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
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
2024-04-18 01:28:47 +00:00
-- | Find the Sapling notes that match the given spending key
findSaplingOutputs ::
Config -- ^ the configuration parameters
-> Int -- ^ the starting block
-> ZcashNetDB -- ^ The network
-> SaplingSpendingKeyDB -- ^ The spending key to trial decrypt
-> IO ()
findSaplingOutputs config b znet sk = do
let dbPath = c_dbPath config
let zebraHost = c_zebraHost config
let zebraPort = c_zebraPort config
let zn = getNet znet
tList <- getShieldedOutputs dbPath b
trees <- getCommitmentTrees zebraHost zebraPort (b - 1)
let sT = SaplingCommitmentTree $ ztiSapling trees
decryptNotes sT zn tList
where
decryptNotes ::
SaplingCommitmentTree
-> ZcashNet
-> [(Entity ZcashTransaction, Entity ShieldOutput)]
-> IO ()
decryptNotes _ _ [] = return ()
decryptNotes st n ((zt, o):txs) = do
let updatedTree =
updateSaplingCommitmentTree
st
(getHex $ shieldOutputCmu $ entityVal o)
case updatedTree of
Nothing -> throwIO $ userError "Failed to update commitment tree"
Just uT -> do
let noteWitness = getSaplingWitness uT
let notePos = getSaplingNotePosition <$> noteWitness
case notePos of
Nothing -> throwIO $ userError "Failed to obtain note position"
Just nP -> do
case decodeShOut External n nP o of
Nothing -> do
case decodeShOut Internal n nP o of
Nothing -> do
decryptNotes uT n txs
Just dn1 -> do
print dn1
wId <- saveWalletTransaction (c_dbPath config) zt
saveWalletSapNote
(c_dbPath config)
wId
nP
(fromJust noteWitness)
2024-04-21 12:07:51 +00:00
True
2024-04-18 01:28:47 +00:00
dn1
decryptNotes uT n txs
Just dn0 -> do
print dn0
wId <- saveWalletTransaction (c_dbPath config) zt
saveWalletSapNote
(c_dbPath config)
wId
nP
(fromJust noteWitness)
2024-04-21 12:07:51 +00:00
False
2024-04-18 01:28:47 +00:00
dn0
decryptNotes uT n txs
decodeShOut ::
Scope
-> ZcashNet
-> Integer
-> Entity ShieldOutput
-> Maybe DecodedNote
decodeShOut scope n pos s = do
decodeSaplingOutputEsk
(getSapSK sk)
(ShieldedOutput
(getHex $ shieldOutputCv $ entityVal s)
(getHex $ shieldOutputCmu $ entityVal s)
(getHex $ shieldOutputEphKey $ entityVal s)
(getHex $ shieldOutputEncCipher $ entityVal s)
(getHex $ shieldOutputOutCipher $ entityVal s)
(getHex $ shieldOutputProof $ entityVal s))
n
scope
pos
-- | Get Orchard actions
findOrchardActions ::
Config -- ^ the configuration parameters
-> Int -- ^ the starting block
-> ZcashNetDB -- ^ The network
-> OrchardSpendingKeyDB -- ^ The spending key to trial decrypt
-> IO ()
findOrchardActions config b znet sk = do
let dbPath = c_dbPath config
let zebraHost = c_zebraHost config
let zebraPort = c_zebraPort config
let zn = getNet znet
tList <- getOrchardActions dbPath b
trees <- getCommitmentTrees zebraHost zebraPort (b - 1)
let sT = OrchardCommitmentTree $ ztiOrchard trees
decryptNotes sT zn tList
where
decryptNotes ::
OrchardCommitmentTree
-> ZcashNet
-> [(Entity ZcashTransaction, Entity OrchAction)]
-> IO ()
decryptNotes _ _ [] = return ()
decryptNotes ot n ((zt, o):txs) = do
let updatedTree =
updateOrchardCommitmentTree
ot
(getHex $ orchActionCmx $ entityVal o)
case updatedTree of
Nothing -> throwIO $ userError "Failed to update commitment tree"
Just uT -> do
let noteWitness = getOrchardWitness uT
let notePos = getOrchardNotePosition <$> noteWitness
case notePos of
Nothing -> throwIO $ userError "Failed to obtain note position"
Just nP ->
case decodeOrchAction External nP o of
Nothing ->
case decodeOrchAction Internal nP o of
Nothing -> decryptNotes uT n txs
Just dn1 -> do
print dn1
wId <- saveWalletTransaction (c_dbPath config) zt
saveWalletOrchNote
(c_dbPath config)
wId
nP
(fromJust noteWitness)
2024-04-21 12:07:51 +00:00
True
2024-04-18 01:28:47 +00:00
dn1
decryptNotes uT n txs
Just dn -> do
print dn
wId <- saveWalletTransaction (c_dbPath config) zt
saveWalletOrchNote
(c_dbPath config)
wId
nP
(fromJust noteWitness)
2024-04-21 12:07:51 +00:00
False
2024-04-18 01:28:47 +00:00
dn
decryptNotes uT n txs
decodeOrchAction ::
Scope -> Integer -> Entity OrchAction -> Maybe DecodedNote
decodeOrchAction scope pos o =
decryptOrchardActionSK (getOrchSK sk) scope $
OrchardAction
(getHex $ orchActionNf $ entityVal o)
(getHex $ orchActionRk $ entityVal o)
(getHex $ orchActionCmx $ entityVal o)
(getHex $ orchActionEphKey $ entityVal o)
(getHex $ orchActionEncCipher $ entityVal o)
(getHex $ orchActionOutCipher $ entityVal o)
(getHex $ orchActionCv $ entityVal o)
(getHex $ orchActionAuth $ entityVal o)
2024-04-04 18:21:55 +00:00
-- | Sync the wallet with the data store
syncWallet ::
2024-04-18 01:28:47 +00:00
Config -- ^ configuration parameters
2024-04-04 18:21:55 +00:00
-> Entity ZcashWallet
2024-04-07 14:25:25 +00:00
-> IO String
2024-04-18 01:28:47 +00:00
syncWallet config w = do
let walletDb = c_dbPath config
2024-04-07 14:25:25 +00:00
accs <- getAccounts walletDb $ entityKey w
addrs <- concat <$> mapM (getAddresses walletDb . entityKey) accs
2024-04-21 12:07:51 +00:00
intAddrs <- concat <$> mapM (getInternalAddresses walletDb . entityKey) accs
2024-04-07 14:25:25 +00:00
lastBlock <- getMaxWalletBlock walletDb
2024-04-18 01:28:47 +00:00
let startBlock =
if lastBlock > 0
then lastBlock
else zcashWalletBirthdayHeight $ entityVal w
trNotes <- mapM (findTransparentNotes walletDb startBlock . entityVal) addrs
2024-04-21 12:07:51 +00:00
mapM_ (saveWalletTrNote walletDb External) $ concat trNotes
trChNotes <-
mapM (findTransparentNotes walletDb startBlock . entityVal) intAddrs
mapM_ (saveWalletTrNote walletDb Internal) $ concat trChNotes
2024-04-08 20:51:14 +00:00
sapNotes <-
mapM
2024-04-18 01:28:47 +00:00
(findSaplingOutputs config startBlock (zcashWalletNetwork $ entityVal w) .
2024-04-08 20:51:14 +00:00
zcashAccountSapSpendKey . entityVal)
accs
2024-04-18 01:28:47 +00:00
orchNotes <-
mapM
(findOrchardActions config startBlock (zcashWalletNetwork $ entityVal w) .
zcashAccountOrchSpendKey . entityVal)
accs
2024-04-08 20:51:14 +00:00
return "Testing"
2024-04-18 01:28:47 +00:00
testSync :: Config -> IO ()
testSync config = do
let dbPath = c_dbPath config
w <- runSqlite dbPath $ selectFirst [ZcashWalletName ==. "Main"] []
case w of
Nothing -> print "No wallet"
Just w' -> do
r <- syncWallet config w'
print r