2024-02-12 21:09:36 +00:00
|
|
|
{-# LANGUAGE OverloadedStrings #-}
|
|
|
|
|
|
|
|
-- 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-07 14:01:29 +00:00
|
|
|
import qualified Data.ByteString as BS
|
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-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-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-02-12 21:09:36 +00:00
|
|
|
-> IO (Maybe ZebraGetInfo)
|
2024-02-28 21:12:57 +00:00
|
|
|
checkZebra nodeHost nodePort = do
|
|
|
|
res <- makeZebraCall nodeHost nodePort "getinfo" []
|
2024-02-12 21:09:36 +00:00
|
|
|
let body = responseBody (res :: Response (RpcResponse ZebraGetInfo))
|
|
|
|
return $ result body
|
|
|
|
|
|
|
|
-- | 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-02-12 21:09:36 +00:00
|
|
|
-> IO (Maybe ZebraGetBlockChainInfo)
|
2024-02-28 21:12:57 +00:00
|
|
|
checkBlockChain nodeHost nodePort = do
|
|
|
|
let f = makeZebraCall nodeHost nodePort
|
2024-03-07 20:20:06 +00:00
|
|
|
result . responseBody <$> f "getblockchaininfo" []
|
2024-02-12 21:09:36 +00:00
|
|
|
|
|
|
|
-- | Generic RPC call function
|
|
|
|
connectZebra ::
|
2024-02-14 18:03:18 +00:00
|
|
|
FromJSON a => T.Text -> Int -> T.Text -> [Data.Aeson.Value] -> IO (Maybe a)
|
2024-02-28 21:12:57 +00:00
|
|
|
connectZebra nodeHost nodePort m params = do
|
|
|
|
res <- makeZebraCall nodeHost nodePort m params
|
2024-02-12 21:09:36 +00:00
|
|
|
let body = responseBody res
|
|
|
|
return $ result body
|
2024-03-07 14:01:29 +00:00
|
|
|
|
|
|
|
-- * Spending Keys
|
|
|
|
-- | Create an Orchard Spending Key for the given wallet and account index
|
|
|
|
createOrchardSpendingKey :: ZcashWallet -> Int -> IO BS.ByteString
|
|
|
|
createOrchardSpendingKey zw i = do
|
|
|
|
let s = getWalletSeed $ zcashWalletSeedPhrase zw
|
|
|
|
case s of
|
|
|
|
Nothing -> throwIO $ userError "Unable to generate seed"
|
|
|
|
Just s' -> do
|
|
|
|
let coinType =
|
|
|
|
case 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
|
|
|
|
|
|
|
|
-- * 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
|
|
|
|
return $ ZcashAccount i (entityKey zw) n orSk "fakeSapKey" "fakeTkey"
|
2024-03-07 20:20:06 +00:00
|
|
|
|
|
|
|
-- * Addresses
|
|
|
|
-- | Create a unified address for the given account and index
|
|
|
|
createWalletAddress ::
|
|
|
|
T.Text -- ^ The address nickname
|
|
|
|
-> Int -- ^ The address' index
|
|
|
|
-> ZcashNet -- ^ The network for this address
|
|
|
|
-> Entity ZcashAccount -- ^ The Zcash account that the address will be attached to
|
|
|
|
-> IO WalletAddress
|
|
|
|
createWalletAddress n i zNet za = do
|
|
|
|
return $
|
|
|
|
WalletAddress
|
|
|
|
i
|
|
|
|
(entityKey za)
|
|
|
|
n
|
|
|
|
(UnifiedAddress
|
|
|
|
zNet
|
|
|
|
"fakeBString"
|
|
|
|
"fakeBString"
|
|
|
|
(Just $ TransparentAddress P2PKH zNet "fakeBString"))
|