zenith/src/Zenith/Core.hs

{-# LANGUAGE OverloadedStrings #-}

-- | Core wallet functionality for Zenith
module Zenith.Core where

import Control.Exception (throwIO, try)
import Data.Aeson
import Data.HexString (hexString)
import Data.Maybe (fromJust)
import qualified Data.Text as T
import qualified Data.Text.Encoding as E
import Database.Persist
import Database.Persist.Sqlite
import Network.HTTP.Client
import ZcashHaskell.Keys
import ZcashHaskell.Orchard
  ( decryptOrchardActionSK
  , encodeUnifiedAddress
  , genOrchardReceiver
  , genOrchardSpendingKey
  , getOrchardNotePosition
  , getOrchardWitness
  , updateOrchardCommitmentTree
  )
import ZcashHaskell.Sapling
  ( decodeSaplingOutputEsk
  , genSaplingInternalAddress
  , genSaplingPaymentAddress
  , genSaplingSpendingKey
  , getSaplingNotePosition
  , getSaplingWitness
  , updateSaplingCommitmentTree
  )
import ZcashHaskell.Transparent (genTransparentPrvKey, genTransparentReceiver)
import ZcashHaskell.Types
import ZcashHaskell.Utils
import Zenith.DB
import Zenith.Types
  ( Config(..)
  , HexStringDB(..)
  , OrchardSpendingKeyDB(..)
  , PhraseDB(..)
  , SaplingSpendingKeyDB(..)
  , ScopeDB(..)
  , TransparentSpendingKeyDB(..)
  , UnifiedAddressDB(..)
  , ZcashNetDB(..)
  , ZebraTreeInfo(..)
  )

-- * 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 ZebraGetInfo
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 ::
     T.Text -- ^ Host where `zebrad` is available
  -> Int -- ^ Port where `zebrad` is available
  -> IO ZebraGetBlockChainInfo
checkBlockChain nodeHost nodePort = do
  r <- makeZebraCall nodeHost nodePort "getblockchaininfo" []
  case r of
    Left e -> throwIO $ userError e
    Right bci -> return bci

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

-- * Wallet
-- | 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)
                        dn1
                      decryptNotes uT n txs
                Just dn0 -> do
                  print dn0
                  wId <- saveWalletTransaction (c_dbPath config) zt
                  saveWalletSapNote
                    (c_dbPath config)
                    wId
                    nP
                    (fromJust noteWitness)
                    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)
                        dn1
                      decryptNotes uT n txs
                Just dn -> do
                  print dn
                  wId <- saveWalletTransaction (c_dbPath config) zt
                  saveWalletOrchNote
                    (c_dbPath config)
                    wId
                    nP
                    (fromJust noteWitness)
                    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)

-- | Sync the wallet with the data store
syncWallet ::
     Config -- ^ configuration parameters
  -> Entity ZcashWallet
  -> IO String
syncWallet config w = do
  let walletDb = c_dbPath config
  accs <- getAccounts walletDb $ entityKey w
  addrs <- concat <$> mapM (getAddresses walletDb . entityKey) accs
  lastBlock <- getMaxWalletBlock walletDb
  let startBlock =
        if lastBlock > 0
          then lastBlock
          else zcashWalletBirthdayHeight $ entityVal w
  trNotes <- mapM (findTransparentNotes walletDb startBlock . entityVal) addrs
  mapM_ (saveWalletTrNote walletDb) $ concat trNotes
  sapNotes <-
    mapM
      (findSaplingOutputs config startBlock (zcashWalletNetwork $ entityVal w) .
       zcashAccountSapSpendKey . entityVal)
      accs
  orchNotes <-
    mapM
      (findOrchardActions config startBlock (zcashWalletNetwork $ entityVal w) .
       zcashAccountOrchSpendKey . entityVal)
      accs
  return "Testing"

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