2024-02-12 21:09:36 +00:00
|
|
|
{-# LANGUAGE OverloadedStrings #-}
|
|
|
|
|
2024-03-22 20:39:37 +00:00
|
|
|
-- | Core wallet functionality for Zenith
|
2024-02-09 22:18:48 +00:00
|
|
|
module Zenith.Core where
|
|
|
|
|
2024-03-07 14:01:29 +00:00
|
|
|
import Control.Exception (throwIO)
|
2024-02-12 21:09:36 +00:00
|
|
|
import Data.Aeson
|
2024-03-17 12:17:52 +00:00
|
|
|
import Data.HexString (hexString)
|
2024-02-09 22:18:48 +00:00
|
|
|
import qualified Data.Text as T
|
2024-03-07 14:01:29 +00:00
|
|
|
import Database.Persist
|
2024-02-12 21:09:36 +00:00
|
|
|
import Network.HTTP.Client
|
2024-03-07 14:01:29 +00:00
|
|
|
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)
|
2024-02-12 21:09:36 +00:00
|
|
|
import ZcashHaskell.Types
|
|
|
|
import ZcashHaskell.Utils
|
2024-03-07 14:01:29 +00:00
|
|
|
import Zenith.DB
|
2024-03-17 12:17:52 +00:00
|
|
|
import Zenith.Types
|
|
|
|
( OrchardSpendingKeyDB(..)
|
|
|
|
, PhraseDB(..)
|
|
|
|
, SaplingSpendingKeyDB(..)
|
|
|
|
, ScopeDB(..)
|
|
|
|
, TransparentSpendingKeyDB(..)
|
|
|
|
, UnifiedAddressDB(..)
|
|
|
|
, ZcashNetDB(..)
|
|
|
|
)
|
2024-02-12 21:09:36 +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
|
2024-03-22 20:39:37 +00:00
|
|
|
-> IO ZebraGetInfo
|
2024-02-28 21:12:57 +00:00
|
|
|
checkZebra nodeHost nodePort = do
|
|
|
|
res <- makeZebraCall nodeHost nodePort "getinfo" []
|
2024-03-22 20:39:37 +00:00
|
|
|
case res of
|
|
|
|
Left e -> throwIO $ userError e
|
|
|
|
Right bi -> return bi
|
2024-02-12 21:09:36 +00:00
|
|
|
|
|
|
|
-- | 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
|
2024-03-22 20:39:37 +00:00
|
|
|
-> IO ZebraGetBlockChainInfo
|
2024-02-28 21:12:57 +00:00
|
|
|
checkBlockChain nodeHost nodePort = do
|
2024-03-22 20:39:37 +00:00
|
|
|
r <- makeZebraCall nodeHost nodePort "getblockchaininfo" []
|
|
|
|
case r of
|
|
|
|
Left e -> throwIO $ userError e
|
|
|
|
Right bci -> return bci
|
2024-03-07 14:01:29 +00:00
|
|
|
|
|
|
|
-- * 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
|
2024-03-07 14:01:29 +00:00
|
|
|
createOrchardSpendingKey zw i = do
|
2024-03-17 12:17:52 +00:00
|
|
|
let s = getWalletSeed $ getPhrase $ zcashWalletSeedPhrase zw
|
2024-03-07 14:01:29 +00:00
|
|
|
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
|
2024-03-07 14:01:29 +00:00
|
|
|
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
|
|
|
|
|
2024-03-07 14:01:29 +00:00
|
|
|
-- * 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)
|