zenith/src/Zenith/Core.hs

{-# 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(..)
  )

-- * 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 (Maybe ZebraGetInfo)
checkZebra nodeHost nodePort = do
  res <- makeZebraCall nodeHost nodePort "getinfo" []
  let body = responseBody (res :: Response (RpcResponse ZebraGetInfo))
  return $ result body

-- | Checks the status of the Zcash blockchain
checkBlockChain ::
     T.Text -- ^ Host where `zebrad` is available
  -> Int -- ^ Port where `zebrad` is available
  -> IO (Maybe ZebraGetBlockChainInfo)
checkBlockChain nodeHost nodePort = do
  let f = makeZebraCall nodeHost nodePort
  result . responseBody <$> f "getblockchaininfo" []

-- | Generic RPC call function
connectZebra ::
     FromJSON a => T.Text -> Int -> T.Text -> [Data.Aeson.Value] -> IO (Maybe a)
connectZebra nodeHost nodePort m params = do
  res <- makeZebraCall nodeHost nodePort m params
  let body = responseBody res
  return $ result body

-- * 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)