zenith/src/Zenith/Core.hs

{-# LANGUAGE OverloadedStrings #-}

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

import Control.Exception (throwIO, try)
import Control.Monad (forM, unless, when)
import Control.Monad.IO.Class (liftIO)
import Control.Monad.Logger
  ( LoggingT
  , MonadLoggerIO
  , NoLoggingT
  , logDebugN
  , logErrorN
  , logInfoN
  , logWarnN
  , runFileLoggingT
  , runNoLoggingT
  , runStdoutLoggingT
  )
import Crypto.Secp256k1 (SecKey(..))
import Data.Aeson
import Data.Binary.Get hiding (getBytes)
import qualified Data.ByteString as BS
import qualified Data.ByteString.Lazy as LBS
import Data.Digest.Pure.MD5
import Data.HexString (HexString, hexString, toBytes, toText)
import Data.List
import Data.Maybe (fromJust)
import Data.Pool (Pool)
import qualified Data.Text as T
import qualified Data.Text.Encoding as E
import Data.Time
import qualified Database.Esqueleto.Experimental as ESQ
import Database.Persist
import Database.Persist.Sqlite
import GHC.Float.RealFracMethods (floorFloatInteger)
import Haskoin.Crypto.Keys (XPrvKey(..))
import Lens.Micro ((&), (.~), (^.), set)
import Network.HTTP.Client
import ZcashHaskell.Keys
import ZcashHaskell.Orchard
  ( decryptOrchardActionSK
  , encodeUnifiedAddress
  , genOrchardReceiver
  , genOrchardSpendingKey
  , getOrchardNotePosition
  , getOrchardWitness
  , isValidUnifiedAddress
  , updateOrchardCommitmentTree
  , updateOrchardWitness
  )
import ZcashHaskell.Sapling
  ( decodeSaplingOutputEsk
  , genSaplingInternalAddress
  , genSaplingPaymentAddress
  , genSaplingSpendingKey
  , getSaplingNotePosition
  , getSaplingWitness
  , updateSaplingCommitmentTree
  , updateSaplingWitness
  )
import ZcashHaskell.Transparent
  ( genTransparentPrvKey
  , genTransparentReceiver
  , genTransparentSecretKey
  )
import ZcashHaskell.Types
import ZcashHaskell.Utils
import Zenith.DB
import Zenith.Types
  ( Config(..)
  , HexStringDB(..)
  , OrchardSpendingKeyDB(..)
  , PhraseDB(..)
  , PrivacyPolicy(..)
  , RseedDB(..)
  , 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)

-- | Create an external unified address for the given account and index with custom receivers
createCustomWalletAddress ::
     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
  -> Bool -- ^ Exclude Sapling
  -> Bool -- ^ Exclude Transparent
  -> IO WalletAddress
createCustomWalletAddress n i zNet scope za exSap exTr = do
  let oRec =
        genOrchardReceiver i scope $
        getOrchSK $ zcashAccountOrchSpendKey $ entityVal za
  let sRec =
        if exSap
          then Nothing
          else case scope of
                 External ->
                   genSaplingPaymentAddress i $
                   getSapSK $ zcashAccountSapSpendKey $ entityVal za
                 Internal ->
                   genSaplingInternalAddress $
                   getSapSK $ zcashAccountSapSpendKey $ entityVal za
  tRec <-
    if exTr
      then return Nothing
      else Just <$>
           genTransparentReceiver
             i
             scope
             (getTranSK $ zcashAccountTPrivateKey $ entityVal za)
  return $
    WalletAddress
      i
      (entityKey za)
      n
      (UnifiedAddressDB $
       encodeUnifiedAddress $ UnifiedAddress zNet oRec sRec 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
  -> Entity ZcashAccount -- ^ The account to use
  -> IO ()
findSaplingOutputs config b znet za = do
  let dbPath = c_dbPath config
  let zebraHost = c_zebraHost config
  let zebraPort = c_zebraPort config
  let zn = getNet znet
  pool <- runNoLoggingT $ initPool dbPath
  tList <- getShieldedOutputs pool b znet
  trees <- getCommitmentTrees zebraHost zebraPort (b - 1)
  let sT = SaplingCommitmentTree $ ztiSapling trees
  decryptNotes sT zn pool tList
  sapNotes <- getWalletSapNotes pool (entityKey za)
  findSapSpends pool (entityKey za) sapNotes
  where
    sk :: SaplingSpendingKeyDB
    sk = zcashAccountSapSpendKey $ entityVal za
    decryptNotes ::
         SaplingCommitmentTree
      -> ZcashNet
      -> ConnectionPool
      -> [(Entity ZcashTransaction, Entity ShieldOutput)]
      -> IO ()
    decryptNotes _ _ _ [] = return ()
    decryptNotes st n pool ((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 pool txs
                    Just dn1 -> do
                      wId <- saveWalletTransaction pool (entityKey za) zt
                      saveWalletSapNote
                        pool
                        wId
                        nP
                        (fromJust noteWitness)
                        True
                        (entityKey za)
                        (entityKey o)
                        dn1
                      decryptNotes uT n pool txs
                Just dn0 -> do
                  wId <- saveWalletTransaction pool (entityKey za) zt
                  saveWalletSapNote
                    pool
                    wId
                    nP
                    (fromJust noteWitness)
                    False
                    (entityKey za)
                    (entityKey o)
                    dn0
                  decryptNotes uT n pool 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
  -> Entity ZcashAccount -- ^ The account to use
  -> IO ()
findOrchardActions config b znet za = do
  let dbPath = c_dbPath config
  let zebraHost = c_zebraHost config
  let zebraPort = c_zebraPort config
  let zn = getNet znet
  pool <- runNoLoggingT $ initPool dbPath
  tList <- getOrchardActions pool b znet
  trees <- getCommitmentTrees zebraHost zebraPort (b - 1)
  let sT = OrchardCommitmentTree $ ztiOrchard trees
  decryptNotes sT zn pool tList
  orchNotes <- getWalletOrchNotes pool (entityKey za)
  findOrchSpends pool (entityKey za) orchNotes
  where
    decryptNotes ::
         OrchardCommitmentTree
      -> ZcashNet
      -> ConnectionPool
      -> [(Entity ZcashTransaction, Entity OrchAction)]
      -> IO ()
    decryptNotes _ _ _ [] = return ()
    decryptNotes ot n pool ((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 pool txs
                    Just dn1 -> do
                      wId <- saveWalletTransaction pool (entityKey za) zt
                      saveWalletOrchNote
                        pool
                        wId
                        nP
                        (fromJust noteWitness)
                        True
                        (entityKey za)
                        (entityKey o)
                        dn1
                      decryptNotes uT n pool txs
                Just dn -> do
                  wId <- saveWalletTransaction pool (entityKey za) zt
                  saveWalletOrchNote
                    pool
                    wId
                    nP
                    (fromJust noteWitness)
                    False
                    (entityKey za)
                    (entityKey o)
                    dn
                  decryptNotes uT n pool txs
    sk :: OrchardSpendingKeyDB
    sk = zcashAccountOrchSpendKey $ entityVal za
    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)

updateSaplingWitnesses :: ConnectionPool -> IO ()
updateSaplingWitnesses pool = do
  sapNotes <- getUnspentSapNotes pool
  maxId <- liftIO $ getMaxSaplingNote pool
  mapM_ (updateOneNote maxId) sapNotes
  where
    updateOneNote :: ShieldOutputId -> Entity WalletSapNote -> IO ()
    updateOneNote maxId n = do
      let noteSync = walletSapNoteWitPos $ entityVal n
      when (noteSync < maxId) $ do
        cmus <- liftIO $ getSaplingCmus pool $ walletSapNoteWitPos $ entityVal n
        let cmuList = map (\(ESQ.Value x) -> getHex x) cmus
        let newWitness =
              updateSaplingWitness
                (SaplingWitness $ getHex $ walletSapNoteWitness $ entityVal n)
                cmuList
        liftIO $ updateSapNoteRecord pool (entityKey n) newWitness maxId

updateOrchardWitnesses :: ConnectionPool -> IO ()
updateOrchardWitnesses pool = do
  orchNotes <- getUnspentOrchNotes pool
  maxId <- getMaxOrchardNote pool
  mapM_ (updateOneNote maxId) orchNotes
  where
    updateOneNote :: OrchActionId -> Entity WalletOrchNote -> IO ()
    updateOneNote maxId n = do
      let noteSync = walletOrchNoteWitPos $ entityVal n
      when (noteSync < maxId) $ do
        cmxs <- liftIO $ getOrchardCmxs pool noteSync
        let cmxList = map (\(ESQ.Value x) -> getHex x) cmxs
        let newWitness =
              updateOrchardWitness
                (OrchardWitness $ getHex $ walletOrchNoteWitness $ entityVal n)
                cmxList
        liftIO $ updateOrchNoteRecord pool (entityKey n) newWitness maxId

-- | Calculate fee per ZIP-317
calculateTxFee ::
     ([Entity WalletTrNote], [Entity WalletSapNote], [Entity WalletOrchNote])
  -> Int
  -> Integer
calculateTxFee (t, s, o) i =
  fromIntegral
    (5000 * (max (length t) tout + max (length s) sout + length o + oout))
  where
    tout =
      if i == 1 || i == 2
        then 1
        else 0
    sout =
      if i == 3
        then 1
        else 0
    oout =
      if i == 4
        then 1
        else 0

-- | Prepare a transaction for sending
prepareTx ::
     ConnectionPool
  -> T.Text
  -> Int
  -> ZcashNet
  -> ZcashAccountId
  -> Int
  -> Float
  -> UnifiedAddress
  -> T.Text
  -> LoggingT IO (Either TxError HexString)
prepareTx pool zebraHost zebraPort zn za bh amt ua memo = do
  accRead <- liftIO $ getAccountById pool za
  let recipient =
        case o_rec ua of
          Nothing ->
            case s_rec ua of
              Nothing ->
                case t_rec ua of
                  Nothing -> (0, "")
                  Just r3 ->
                    case tr_type r3 of
                      P2PKH -> (1, toBytes $ tr_bytes r3)
                      P2SH -> (2, toBytes $ tr_bytes r3)
              Just r2 -> (3, getBytes r2)
          Just r1 -> (4, getBytes r1)
  logDebugN $ T.pack $ show recipient
  logDebugN $ T.pack $ "Target block: " ++ show bh
  trees <- liftIO $ getCommitmentTrees zebraHost zebraPort bh
  let sT = SaplingCommitmentTree $ ztiSapling trees
  let oT = OrchardCommitmentTree $ ztiOrchard trees
  case accRead of
    Nothing -> do
      logErrorN "Can't find Account"
      return $ Left ZHError
    Just acc -> do
      logDebugN $ T.pack $ show acc
      let zats = fromIntegral $ floorFloatInteger $ amt * (10 ^ 8)
      logDebugN $ T.pack $ show zats
      {-firstPass <- liftIO $ selectUnspentNotes pool za zats-}
      --let fee = calculateTxFee firstPass $ fst recipient
      --logDebugN $ T.pack $ "calculated fee " ++ show fee
      (tList, sList, oList) <- liftIO $ selectUnspentNotes pool za (zats + 5000)
      logDebugN "selected notes"
      logDebugN $ T.pack $ show tList
      logDebugN $ T.pack $ show sList
      logDebugN $ T.pack $ show oList
      let noteTotal = getTotalAmount (tList, sList, oList)
      tSpends <-
        liftIO $
        prepTSpends (getTranSK $ zcashAccountTPrivateKey $ entityVal acc) tList
      --print tSpends
      sSpends <-
        liftIO $
        prepSSpends (getSapSK $ zcashAccountSapSpendKey $ entityVal acc) sList
      --print sSpends
      oSpends <-
        liftIO $
        prepOSpends (getOrchSK $ zcashAccountOrchSpendKey $ entityVal acc) oList
      --print oSpends
      dummy <-
        liftIO $ makeOutgoing acc recipient zats (noteTotal - 5000 - zats)
      logDebugN "Calculating fee"
      let feeResponse =
            createTransaction
              (Just sT)
              (Just oT)
              tSpends
              sSpends
              oSpends
              dummy
              zn
              (bh + 3)
              False
      case feeResponse of
        Left e1 -> return $ Left Fee
        Right fee -> do
          let feeAmt =
                fromIntegral (runGet getInt64le $ LBS.fromStrict $ toBytes fee)
          (tList1, sList1, oList1) <-
            liftIO $ selectUnspentNotes pool za (zats + feeAmt)
          logDebugN $ T.pack $ "selected notes with fee" ++ show feeAmt
          logDebugN $ T.pack $ show tList
          logDebugN $ T.pack $ show sList
          logDebugN $ T.pack $ show oList
          outgoing <-
            liftIO $ makeOutgoing acc recipient zats (noteTotal - feeAmt - zats)
          logDebugN $ T.pack $ show outgoing
          let tx =
                createTransaction
                  (Just sT)
                  (Just oT)
                  tSpends
                  sSpends
                  oSpends
                  outgoing
                  zn
                  (bh + 3)
                  True
          logDebugN $ T.pack $ show tx
          return tx
  where
    makeOutgoing ::
         Entity ZcashAccount
      -> (Int, BS.ByteString)
      -> Integer
      -> Integer
      -> IO [OutgoingNote]
    makeOutgoing acc (k, recvr) zats chg = do
      chgAddr <- runNoLoggingT $ getInternalAddresses pool $ entityKey acc
      let internalUA = getUA $ walletAddressUAddress $ entityVal $ head chgAddr
      let chgRcvr =
            fromJust $ o_rec =<< isValidUnifiedAddress (E.encodeUtf8 internalUA)
      return
        [ OutgoingNote
            4
            (getBytes $ getOrchSK $ zcashAccountOrchSpendKey $ entityVal acc)
            (getBytes chgRcvr)
            (fromIntegral chg)
            ""
            True
        , OutgoingNote
            (fromIntegral k)
            (case k of
               4 ->
                 getBytes $ getOrchSK $ zcashAccountOrchSpendKey $ entityVal acc
               3 ->
                 getBytes $ getSapSK $ zcashAccountSapSpendKey $ entityVal acc
               _ -> "")
            recvr
            (fromIntegral zats)
            (E.encodeUtf8 memo)
            False
        ]
    getTotalAmount ::
         ( [Entity WalletTrNote]
         , [Entity WalletSapNote]
         , [Entity WalletOrchNote])
      -> Integer
    getTotalAmount (t, s, o) =
      sum (map (fromIntegral . walletTrNoteValue . entityVal) t) +
      sum (map (fromIntegral . walletSapNoteValue . entityVal) s) +
      sum (map (fromIntegral . walletOrchNoteValue . entityVal) o)
    prepTSpends ::
         TransparentSpendingKey
      -> [Entity WalletTrNote]
      -> IO [TransparentTxSpend]
    prepTSpends sk notes = do
      forM notes $ \n -> do
        tAddRead <- getAddressById pool $ walletTrNoteAddress $ entityVal n
        case tAddRead of
          Nothing -> throwIO $ userError "Couldn't read t-address"
          Just tAdd -> do
            (XPrvKey _ _ _ _ (SecKey xp_key)) <-
              genTransparentSecretKey
                (walletAddressIndex $ entityVal tAdd)
                (getScope $ walletAddressScope $ entityVal tAdd)
                sk
            mReverseTxId <- getWalletTxId pool $ walletTrNoteTx $ entityVal n
            case mReverseTxId of
              Nothing -> throwIO $ userError "failed to get tx ID"
              Just (ESQ.Value reverseTxId) -> do
                let flipTxId = BS.reverse $ toBytes $ getHex reverseTxId
                return $
                  TransparentTxSpend
                    xp_key
                    (RawOutPoint
                       flipTxId
                       (fromIntegral $ walletTrNotePosition $ entityVal n))
                    (RawTxOut
                       (fromIntegral $ walletTrNoteValue $ entityVal n)
                       (walletTrNoteScript $ entityVal n))
    prepSSpends ::
         SaplingSpendingKey -> [Entity WalletSapNote] -> IO [SaplingTxSpend]
    prepSSpends sk notes = do
      forM notes $ \n -> do
        return $
          SaplingTxSpend
            (getBytes sk)
            (DecodedNote
               (fromIntegral $ walletSapNoteValue $ entityVal n)
               (walletSapNoteRecipient $ entityVal n)
               (E.encodeUtf8 $ walletSapNoteMemo $ entityVal n)
               (getHex $ walletSapNoteNullifier $ entityVal n)
               ""
               (getRseed $ walletSapNoteRseed $ entityVal n))
            (toBytes $ getHex $ walletSapNoteWitness $ entityVal n)
    prepOSpends ::
         OrchardSpendingKey -> [Entity WalletOrchNote] -> IO [OrchardTxSpend]
    prepOSpends sk notes = do
      forM notes $ \n -> do
        return $
          OrchardTxSpend
            (getBytes sk)
            (DecodedNote
               (fromIntegral $ walletOrchNoteValue $ entityVal n)
               (walletOrchNoteRecipient $ entityVal n)
               (E.encodeUtf8 $ walletOrchNoteMemo $ entityVal n)
               (getHex $ walletOrchNoteNullifier $ entityVal n)
               (walletOrchNoteRho $ entityVal n)
               (getRseed $ walletOrchNoteRseed $ entityVal n))
            (toBytes $ getHex $ walletOrchNoteWitness $ entityVal n)
    sapAnchor :: [Entity WalletSapNote] -> Maybe SaplingWitness
    sapAnchor notes =
      if not (null notes)
        then Just $
             SaplingWitness $
             getHex $ walletSapNoteWitness $ entityVal $ head notes
        else Nothing
    orchAnchor :: [Entity WalletOrchNote] -> Maybe OrchardWitness
    orchAnchor notes =
      if not (null notes)
        then Just $
             OrchardWitness $
             getHex $ walletOrchNoteWitness $ entityVal $ head notes
        else Nothing

-- | Prepare a transaction for sending
prepareTxV2 ::
     ConnectionPool
  -> T.Text
  -> Int
  -> ZcashNet
  -> ZcashAccountId
  -> Int
  -> Float
  -> ValidAddress
  -> T.Text
  -> PrivacyPolicy
  -> LoggingT IO (Either TxError HexString)
prepareTxV2 pool zebraHost zebraPort zn za bh amt va memo policy = do
  accRead <- liftIO $ getAccountById pool za
  let recipient =
        case va of
          Unified ua ->
            case o_rec ua of
              Nothing ->
                case s_rec ua of
                  Nothing ->
                    case t_rec ua of
                      Nothing -> (0, "")
                      Just r3 ->
                        case tr_type r3 of
                          P2PKH -> (1, toBytes $ tr_bytes r3)
                          P2SH -> (2, toBytes $ tr_bytes r3)
                  Just r2 -> (3, getBytes r2)
              Just r1 -> (4, getBytes r1)
          Sapling sa -> (3, getBytes $ sa_receiver sa)
          Transparent ta ->
            case tr_type (ta_receiver ta) of
              P2PKH -> (1, toBytes $ tr_bytes (ta_receiver ta))
              P2SH -> (2, toBytes $ tr_bytes (ta_receiver ta))
          Exchange ea ->
            case tr_type (ex_address ea) of
              P2PKH -> (1, toBytes $ tr_bytes (ex_address ea))
              P2SH -> (2, toBytes $ tr_bytes (ex_address ea))
  logDebugN $ T.pack $ show recipient
  logDebugN $ T.pack $ "Target block: " ++ show bh
  trees <- liftIO $ getCommitmentTrees zebraHost zebraPort bh
  let sT = SaplingCommitmentTree $ ztiSapling trees
  let oT = OrchardCommitmentTree $ ztiOrchard trees
  case accRead of
    Nothing -> do
      logErrorN "Can't find Account"
      return $ Left ZHError
    Just acc -> do
      logDebugN $ T.pack $ show acc
      let zats = fromIntegral $ floorFloatInteger $ amt * (10 ^ 8)
      logDebugN $ T.pack $ show zats
      {-firstPass <- liftIO $ selectUnspentNotes pool za zats-}
      --let fee = calculateTxFee firstPass $ fst recipient
      --logDebugN $ T.pack $ "calculated fee " ++ show fee
      (tList, sList, oList) <- liftIO $ selectUnspentNotes pool za (zats + 5000)
      logDebugN "selected notes"
      logDebugN $ T.pack $ show tList
      logDebugN $ T.pack $ show sList
      logDebugN $ T.pack $ show oList
      let noteTotal = getTotalAmount (tList, sList, oList)
      tSpends <-
        liftIO $
        prepTSpends (getTranSK $ zcashAccountTPrivateKey $ entityVal acc) tList
      --print tSpends
      sSpends <-
        liftIO $
        prepSSpends (getSapSK $ zcashAccountSapSpendKey $ entityVal acc) sList
      --print sSpends
      oSpends <-
        liftIO $
        prepOSpends (getOrchSK $ zcashAccountOrchSpendKey $ entityVal acc) oList
      --print oSpends
      dummy <-
        liftIO $ makeOutgoing acc recipient zats (noteTotal - 5000 - zats)
      logDebugN "Calculating fee"
      let feeResponse =
            createTransaction
              (Just sT)
              (Just oT)
              tSpends
              sSpends
              oSpends
              dummy
              zn
              (bh + 3)
              False
      case feeResponse of
        Left e1 -> return $ Left Fee
        Right fee -> do
          let feeAmt =
                fromIntegral (runGet getInt64le $ LBS.fromStrict $ toBytes fee)
          (tList1, sList1, oList1) <-
            liftIO $ selectUnspentNotes pool za (zats + feeAmt)
          logDebugN $ T.pack $ "selected notes with fee" ++ show feeAmt
          logDebugN $ T.pack $ show tList
          logDebugN $ T.pack $ show sList
          logDebugN $ T.pack $ show oList
          outgoing <-
            liftIO $ makeOutgoing acc recipient zats (noteTotal - feeAmt - zats)
          logDebugN $ T.pack $ show outgoing
          let tx =
                createTransaction
                  (Just sT)
                  (Just oT)
                  tSpends
                  sSpends
                  oSpends
                  outgoing
                  zn
                  (bh + 3)
                  True
          logDebugN $ T.pack $ show tx
          return tx
  where
    makeOutgoing ::
         Entity ZcashAccount
      -> (Int, BS.ByteString)
      -> Integer
      -> Integer
      -> IO [OutgoingNote]
    makeOutgoing acc (k, recvr) zats chg = do
      chgAddr <- runNoLoggingT $ getInternalAddresses pool $ entityKey acc
      let internalUA = getUA $ walletAddressUAddress $ entityVal $ head chgAddr
      let chgRcvr =
            fromJust $ o_rec =<< isValidUnifiedAddress (E.encodeUtf8 internalUA)
      return
        [ OutgoingNote
            4
            (getBytes $ getOrchSK $ zcashAccountOrchSpendKey $ entityVal acc)
            (getBytes chgRcvr)
            (fromIntegral chg)
            ""
            True
        , OutgoingNote
            (fromIntegral k)
            (case k of
               4 ->
                 getBytes $ getOrchSK $ zcashAccountOrchSpendKey $ entityVal acc
               3 ->
                 getBytes $ getSapSK $ zcashAccountSapSpendKey $ entityVal acc
               _ -> "")
            recvr
            (fromIntegral zats)
            (E.encodeUtf8 memo)
            False
        ]
    getTotalAmount ::
         ( [Entity WalletTrNote]
         , [Entity WalletSapNote]
         , [Entity WalletOrchNote])
      -> Integer
    getTotalAmount (t, s, o) =
      sum (map (fromIntegral . walletTrNoteValue . entityVal) t) +
      sum (map (fromIntegral . walletSapNoteValue . entityVal) s) +
      sum (map (fromIntegral . walletOrchNoteValue . entityVal) o)
    prepTSpends ::
         TransparentSpendingKey
      -> [Entity WalletTrNote]
      -> IO [TransparentTxSpend]
    prepTSpends sk notes = do
      forM notes $ \n -> do
        tAddRead <- getAddressById pool $ walletTrNoteAddress $ entityVal n
        case tAddRead of
          Nothing -> throwIO $ userError "Couldn't read t-address"
          Just tAdd -> do
            (XPrvKey _ _ _ _ (SecKey xp_key)) <-
              genTransparentSecretKey
                (walletAddressIndex $ entityVal tAdd)
                (getScope $ walletAddressScope $ entityVal tAdd)
                sk
            mReverseTxId <- getWalletTxId pool $ walletTrNoteTx $ entityVal n
            case mReverseTxId of
              Nothing -> throwIO $ userError "failed to get tx ID"
              Just (ESQ.Value reverseTxId) -> do
                let flipTxId = BS.reverse $ toBytes $ getHex reverseTxId
                return $
                  TransparentTxSpend
                    xp_key
                    (RawOutPoint
                       flipTxId
                       (fromIntegral $ walletTrNotePosition $ entityVal n))
                    (RawTxOut
                       (fromIntegral $ walletTrNoteValue $ entityVal n)
                       (walletTrNoteScript $ entityVal n))
    prepSSpends ::
         SaplingSpendingKey -> [Entity WalletSapNote] -> IO [SaplingTxSpend]
    prepSSpends sk notes = do
      forM notes $ \n -> do
        return $
          SaplingTxSpend
            (getBytes sk)
            (DecodedNote
               (fromIntegral $ walletSapNoteValue $ entityVal n)
               (walletSapNoteRecipient $ entityVal n)
               (E.encodeUtf8 $ walletSapNoteMemo $ entityVal n)
               (getHex $ walletSapNoteNullifier $ entityVal n)
               ""
               (getRseed $ walletSapNoteRseed $ entityVal n))
            (toBytes $ getHex $ walletSapNoteWitness $ entityVal n)
    prepOSpends ::
         OrchardSpendingKey -> [Entity WalletOrchNote] -> IO [OrchardTxSpend]
    prepOSpends sk notes = do
      forM notes $ \n -> do
        return $
          OrchardTxSpend
            (getBytes sk)
            (DecodedNote
               (fromIntegral $ walletOrchNoteValue $ entityVal n)
               (walletOrchNoteRecipient $ entityVal n)
               (E.encodeUtf8 $ walletOrchNoteMemo $ entityVal n)
               (getHex $ walletOrchNoteNullifier $ entityVal n)
               (walletOrchNoteRho $ entityVal n)
               (getRseed $ walletOrchNoteRseed $ entityVal n))
            (toBytes $ getHex $ walletOrchNoteWitness $ entityVal n)
    sapAnchor :: [Entity WalletSapNote] -> Maybe SaplingWitness
    sapAnchor notes =
      if not (null notes)
        then Just $
             SaplingWitness $
             getHex $ walletSapNoteWitness $ entityVal $ head notes
        else Nothing
    orchAnchor :: [Entity WalletOrchNote] -> Maybe OrchardWitness
    orchAnchor notes =
      if not (null notes)
        then Just $
             OrchardWitness $
             getHex $ walletOrchNoteWitness $ entityVal $ head notes
        else Nothing

-- | Sync the wallet with the data store
syncWallet ::
     Config -- ^ configuration parameters
  -> Entity ZcashWallet
  -> IO ()
syncWallet config w = do
  startTime <- liftIO getCurrentTime
  let walletDb = c_dbPath config
  let znet = zcashWalletNetwork $ entityVal w
  pool <- runNoLoggingT $ initPool walletDb
  accs <- runNoLoggingT $ getAccounts pool $ entityKey w
  addrs <- concat <$> mapM (runNoLoggingT . getAddresses pool . entityKey) accs
  intAddrs <-
    concat <$> mapM (runNoLoggingT . getInternalAddresses pool . entityKey) accs
  chainTip <- getMaxBlock pool znet
  let lastBlock = zcashWalletLastSync $ entityVal w
  let startBlock =
        if lastBlock > 0
          then lastBlock
          else zcashWalletBirthdayHeight $ entityVal w
  mapM_ (liftIO . findTransparentNotes pool startBlock znet) addrs
  mapM_ (liftIO . findTransparentNotes pool startBlock znet) intAddrs
  mapM_ (liftIO . findTransparentSpends pool . entityKey) accs
  sapNotes <-
    liftIO $
    mapM
      (findSaplingOutputs config startBlock (zcashWalletNetwork $ entityVal w))
      accs
  orchNotes <-
    liftIO $
    mapM
      (findOrchardActions config startBlock (zcashWalletNetwork $ entityVal w))
      accs
  _ <- updateSaplingWitnesses pool
  _ <- updateOrchardWitnesses pool
  _ <- liftIO $ updateWalletSync pool chainTip (entityKey w)
  mapM_ (runNoLoggingT . getWalletTransactions pool) addrs