{-# LANGUAGE OverloadedStrings #-}

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

import Control.Concurrent (forkIO)
import Control.Exception (throwIO, try)
import Control.Monad (forM, unless, when)
import Control.Monad.IO.Class (liftIO)
import Control.Monad.Logger
  ( LoggingT
  , NoLoggingT
  , logDebugN
  , logErrorN
  , logInfoN
  , runNoLoggingT
  )
import Crypto.Secp256k1 (SecKey(..))
import Data.Aeson
import qualified Data.ByteString as BS
import Data.HexString (HexString, hexBytes, hexString, toBytes, toText)
import Data.Int (Int32, Int64)
import Data.List
import Data.Maybe (catMaybes, fromJust, fromMaybe, isJust, isNothing)
import Data.Scientific (Scientific, scientific, toBoundedInteger)
import qualified Data.Text as T
import qualified Data.Text.Encoding as E
import Data.Time
import qualified Data.UUID as U
import Data.UUID.V4 (nextRandom)
import qualified Database.Esqueleto.Experimental as ESQ
import Database.Persist
import Database.Persist.Sqlite
import Haskoin.Crypto.Keys (XPrvKey(..))
import Lens.Micro ((&), (.~), (^.), set)
import ZcashHaskell.Keys
import ZcashHaskell.Orchard
  ( decodeUfvk
  , decodeUivk
  , decryptOrchardActionFvk
  , decryptOrchardActionIvk
  , decryptOrchardActionSK
  , encodeUnifiedAddress
  , genOrchardReceiver
  , genOrchardReceiverFvk
  , genOrchardReceiverIvk
  , genOrchardSpendingKey
  , getOrchardTreeParts
  , isValidUnifiedAddress
  , parseAddress
  , updateOrchardWitness
  )
import ZcashHaskell.Sapling
  ( decodeSaplingOutputEsk
  , decodeSaplingOutputFvk
  , decodeSaplingOutputIvk
  , genSaplingInternalAddress
  , genSaplingInternalAddressFvk
  , genSaplingPaymentAddress
  , genSaplingReceiverFvk
  , genSaplingReceiverIvk
  , genSaplingSpendingKey
  , getSaplingTreeParts
  , updateSaplingWitness
  )
import ZcashHaskell.Transparent
  ( genTransparentPrvKey
  , genTransparentReceiver
  , genTransparentReceiverFvk
  , genTransparentReceiverIvk
  , genTransparentSecretKey
  )
import ZcashHaskell.Types
import ZcashHaskell.Utils
import Zenith.DB
import Zenith.Tree
import Zenith.Types
  ( AccountType(..)
  , Config(..)
  , HexStringDB(..)
  , OrchardSpendingKeyDB(..)
  , PhraseDB(..)
  , PrivacyPolicy(..)
  , ProposedNote(..)
  , RseedDB(..)
  , SaplingSpendingKeyDB(..)
  , ScopeDB(..)
  , TransparentSpendingKeyDB(..)
  , UnifiedAddressDB(..)
  , UnifiedFvkDB(..)
  , UnifiedIvkDB(..)
  , ValidAddressAPI(..)
  , ZcashNetDB(..)
  , ZebraTreeInfo(..)
  , ZenithStatus(..)
  , ZenithUuid(..)
  )
import Zenith.Utils (getTransparentFromUA)

-- * 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 ::
     ConnectionPool
  -> T.Text -- ^ Host where `zebrad` is avaiable
  -> Int -- ^ Port where `zebrad` is available
  -> ZcashNetDB
  -> Int -- ^ Block height
  -> IO ZebraTreeInfo
getCommitmentTrees pool nodeHost nodePort znet block = do
  bh' <- getBlockHash pool block znet
  case bh' of
    Nothing -> 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
    Just bh -> do
      r <-
        makeZebraCall
          nodeHost
          nodePort
          "z_gettreestate"
          [Data.Aeson.String $ toText bh]
      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
  -> ZcashNet -- ^ The network
  -> Entity ZcashWallet -- ^ The Zcash wallet that this account will be attached to
  -> IO ZcashAccount
createZcashAccount n i znet zw = do
  orSk <- createOrchardSpendingKey (entityVal zw) i
  sapSk <- createSaplingSpendingKey (entityVal zw) i
  tSk <- createTransparentSpendingKey (entityVal zw) i
  FullVk fvk <- deriveUfvk znet (Just orSk) (Just sapSk) (Just tSk)
  IncomingVk ivk <- deriveUivk znet (Just orSk) (Just sapSk) (Just tSk)
  return $
    ZcashAccount
      i
      (entityKey zw)
      n
      (Just $ OrchardSpendingKeyDB orSk)
      (Just $ SaplingSpendingKeyDB sapSk)
      (Just $ TransparentSpendingKeyDB tSk)
      (Just $ UnifiedFvkDB fvk)
      (Just $ UnifiedIvkDB ivk)
      Local

-- * 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
  case zcashAccountType (entityVal za) of
    Local -> 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)
      let tKey = getTranSK <$> zcashAccountTPrivateKey (entityVal za)
      tRec <-
        case tKey of
          Nothing -> return Nothing
          Just k -> do
            x <- genTransparentReceiver i scope k
            return $ Just x
      return $
        WalletAddress
          i
          (entityKey za)
          n
          (UnifiedAddressDB $
           encodeUnifiedAddress $ UnifiedAddress zNet oRec sRec tRec)
          (ScopeDB scope)
    FullViewKey -> do
      let fvk = zcashAccountFvk (entityVal za)
      let oRec = genOrchardReceiverFvk i scope . o_key . getFvk =<< fvk
      let sRec =
            case scope of
              External -> genSaplingReceiverFvk i . s_key . getFvk =<< fvk
              Internal -> genSaplingInternalAddressFvk . s_key . getFvk =<< fvk
      let tKey = t_key . getFvk <$> fvk
      tRec <-
        case tKey of
          Nothing -> return Nothing
          Just k -> genTransparentReceiverFvk i scope k
      return $
        WalletAddress
          i
          (entityKey za)
          n
          (UnifiedAddressDB $
           encodeUnifiedAddress $ UnifiedAddress zNet oRec sRec tRec)
          (ScopeDB scope)
    IncomingViewKey -> do
      let ivk = zcashAccountIvk (entityVal za)
      let oRec = genOrchardReceiverIvk i . i_o_key . getIvk =<< ivk
      let sRec = genSaplingReceiverIvk i . i_s_key . getIvk =<< ivk
      let tKey = i_t_key . getIvk <$> ivk
      tRec <-
        case tKey of
          Nothing -> return Nothing
          Just k -> genTransparentReceiverIvk i k
      return $
        WalletAddress
          i
          (entityKey za)
          n
          (UnifiedAddressDB $
           encodeUnifiedAddress $ UnifiedAddress zNet oRec sRec 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 do
        let tKey = getTranSK <$> zcashAccountTPrivateKey (entityVal za)
        case tKey of
          Nothing -> return Nothing
          Just k -> Just <$> genTransparentReceiver i scope k
  return $
    WalletAddress
      i
      (entityKey za)
      n
      (UnifiedAddressDB $
       encodeUnifiedAddress $ UnifiedAddress zNet oRec sRec tRec)
      (ScopeDB scope)

importViewingKey ::
     ConnectionPool -- ^ database connection to use
  -> T.Text -- ^ name to use
  -> ZcashNet -- ^ the network the wallet is on
  -> ValidVk -- ^ viewing key
  -> Int -- ^ birthday height
  -> IO (Either T.Text Int64)
importViewingKey pool name znet vk bh = do
  minBh <- getMinBirthdayHeight pool $ ZcashNetDB znet
  let checkNet =
        case znet of
          MainNet ->
            case vk of
              FullVk fvk -> net fvk == 1
              IncomingVk ivk -> i_net ivk == 1
          TestNet ->
            case vk of
              FullVk fvk -> net fvk == 2
              IncomingVk ivk -> i_net ivk == 2
          RegTestNet -> False
  if checkNet
    then do
      when (bh < minBh) $ do
        clearWalletTransactions pool
        clearWalletData pool
      vkWallet <- getVkWallet pool
      wal <-
        case vkWallet of
          Nothing -> do
            x <- saveVkWallet pool znet bh
            case x of
              Nothing -> fail "Couldn't create VK wallet"
              Just w -> return w
          Just w -> return w
      maxIx <- getMaxAccount pool $ entityKey wal
      case vk of
        FullVk fvk -> do
          acc <-
            saveAccount pool $
            ZcashAccount
              (maxIx + 1)
              (entityKey wal)
              name
              Nothing
              Nothing
              Nothing
              (Just $ UnifiedFvkDB fvk)
              Nothing
              FullViewKey
          case acc of
            Nothing -> return $ Left "Failed to save VK account"
            Just acc' -> do
              defAddr <- createWalletAddress "Default" 0 znet External acc'
              chgAddr <- createWalletAddress "Change" 0 znet Internal acc'
              _ <- saveAddress pool defAddr
              _ <- saveAddress pool chgAddr
              return $ Right $ fromSqlKey (entityKey acc')
        IncomingVk ivk -> do
          acc1 <-
            saveAccount pool $
            ZcashAccount
              (maxIx + 1)
              (entityKey wal)
              name
              Nothing
              Nothing
              Nothing
              Nothing
              (Just $ UnifiedIvkDB ivk)
              IncomingViewKey
          case acc1 of
            Nothing -> return $ Left "Failed to save VK account"
            Just acc1' -> do
              defAddr <- createWalletAddress "Default" 0 znet External acc1'
              chgAddr <- createWalletAddress "Change" 0 znet Internal acc1'
              _ <- saveAddress pool defAddr
              _ <- saveAddress pool chgAddr
              return $ Right $ fromSqlKey $ entityKey acc1'
    else return $ Left "Viewing key is not for the current network"

parseVK :: T.Text -> Maybe ValidVk
parseVK input =
  case decodeUfvk (E.encodeUtf8 input) of
    Just fvk -> Just $ FullVk fvk
    Nothing ->
      case decodeUivk (E.encodeUtf8 input) of
        Just ivk -> Just $ IncomingVk ivk
        Nothing -> Nothing

importSeedPhrase ::
     ConnectionPool -- ^ database connection to use
  -> T.Text -- ^ name to use
  -> ZcashNet -- ^ the network the wallet is on
  -> Phrase -- ^ seed phrase
  -> Int -- ^ birthday height
  -> IO (Either T.Text Int64)
importSeedPhrase pool name znet ph bh = do
  minBh <- getMinBirthdayHeight pool $ ZcashNetDB znet
  when (bh < minBh) $ do
    clearWalletTransactions pool
    clearWalletData pool
  case getWalletSeed ph of
    Nothing -> return $ Left "Invalid seed phrase"
    Just _ -> do
      nw <-
        saveWallet pool $
        ZcashWallet name (ZcashNetDB znet) (PhraseDB ph) bh 0 True
      case nw of
        Nothing -> return $ Left "Wallet with that name already exists"
        Just nw' -> do
          aIx <- getMaxAccount pool (entityKey nw')
          na <-
            try $ createZcashAccount "Default" (aIx + 1) znet nw' :: IO
              (Either IOError ZcashAccount)
          case na of
            Left e -> return $ Left $ T.pack $ show e
            Right na' -> do
              acc <- saveAccount pool na'
              case acc of
                Nothing -> return $ Left "Failed to save VK account"
                Just acc' -> do
                  defAddr <- createWalletAddress "Default" 0 znet External acc'
                  chgAddr <- createWalletAddress "Change" 0 znet Internal acc'
                  _ <- saveAddress pool defAddr
                  _ <- saveAddress pool chgAddr
                  return $ Right $ fromSqlKey (entityKey acc')

-- * 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
  -> NoLoggingT IO ()
findSaplingOutputs config b znet za = do
  let dbPath = c_dbPath config
  let zn = getNet znet
  pool <- liftIO $ runNoLoggingT $ initPool dbPath
  tList <- liftIO $ getShieldedOutputs pool b znet
  sT <- liftIO $ getSaplingTree pool
  case sT of
    Nothing ->
      liftIO $ throwIO $ userError "Failed to read Sapling commitment tree"
    Just (sT', treeSync) -> do
      logDebugN "Sapling tree valid"
      let acType = zcashAccountType $ entityVal za
      mapM_ (decryptNotes sT' zn pool acType) tList
      sapNotes <- liftIO $ getWalletSapNotes pool (entityKey za)
      liftIO $ findSapSpends pool (entityKey za) sapNotes
  where
    sk :: Maybe SaplingSpendingKeyDB
    sk = zcashAccountSapSpendKey $ entityVal za
    fvk :: Maybe UnifiedFvkDB
    fvk = zcashAccountFvk $ entityVal za
    ivk :: Maybe UnifiedIvkDB
    ivk = zcashAccountIvk $ entityVal za
    decryptNotes ::
         Tree SaplingNode
      -> ZcashNet
      -> ConnectionPool
      -> AccountType
      -> (Entity ZcashTransaction, Entity ShieldOutput)
      -> NoLoggingT IO ()
    decryptNotes st n pool act (zt, o) = do
      case getNotePosition st $ fromSqlKey $ entityKey o of
        Nothing -> do
          logErrorN "Couldn't find sapling note in commitment tree"
          return ()
        Just nP -> do
          let externalDecode =
                case act of
                  Local -> decodeShOut External n nP o
                  FullViewKey -> decodeShOutFvk External o $ fromIntegral nP
                  IncomingViewKey -> decodeShOutIvk o
          let internalDecode =
                case act of
                  Local -> decodeShOut Internal n nP o
                  FullViewKey -> decodeShOutFvk Internal o $ fromIntegral nP
                  IncomingViewKey -> Nothing
          logDebugN "got position"
          case externalDecode of
            Nothing -> do
              logDebugN "couldn't decode external"
              case internalDecode of
                Nothing -> do
                  logDebugN "couldn't decode internal"
                Just dn1 -> do
                  wId <- liftIO $ saveWalletTransaction pool (entityKey za) zt
                  liftIO $
                    saveWalletSapNote
                      pool
                      wId
                      nP
                      True
                      (entityKey za)
                      (entityKey o)
                      dn1
            Just dn0 -> do
              wId <- liftIO $ saveWalletTransaction pool (entityKey za) zt
              liftIO $
                saveWalletSapNote
                  pool
                  wId
                  nP
                  False
                  (entityKey za)
                  (entityKey o)
                  dn0
    decodeShOut ::
         Scope -> ZcashNet -> Int32 -> Entity ShieldOutput -> Maybe DecodedNote
    decodeShOut scope n pos s =
      case sk of
        Nothing -> Nothing
        Just sk' -> 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
            (fromIntegral pos)
    decodeShOutFvk :: Scope -> Entity ShieldOutput -> Int64 -> Maybe DecodedNote
    decodeShOutFvk scope s pos =
      case fvk of
        Nothing -> Nothing
        Just sk' -> do
          decodeSaplingOutputFvk
            (s_key $ getFvk 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))
            scope
            pos
    decodeShOutIvk :: Entity ShieldOutput -> Maybe DecodedNote
    decodeShOutIvk s =
      case ivk of
        Nothing -> Nothing
        Just sk' -> do
          decodeSaplingOutputIvk
            (i_s_key $ getIvk 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))

-- | 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 zn = getNet znet
  pool <- runNoLoggingT $ initPool dbPath
  tList <- getOrchardActions pool b znet
  sT <- getOrchardTree pool
  case sT of
    Nothing -> throwIO $ userError "Failed to read Orchard commitment tree"
    Just (sT', treeSync) -> do
      mapM_ (decryptNotes sT' pool) tList
      orchNotes <- getWalletOrchNotes pool (entityKey za)
      findOrchSpends pool (entityKey za) orchNotes
  where
    decryptNotes ::
         Tree OrchardNode
      -> ConnectionPool
      -> (Entity ZcashTransaction, Entity OrchAction)
      -> IO ()
    decryptNotes ot pool (zt, o) = do
      case getNotePosition ot (fromSqlKey $ entityKey o) of
        Nothing -> do
          return ()
        Just nP -> do
          let externalDecode =
                case zcashAccountType (entityVal za) of
                  Local -> decodeOrchAction External o
                  FullViewKey -> decodeOrchActionFvk External o
                  IncomingViewKey -> decodeOrchActionIvk o
          let internalDecode =
                case zcashAccountType (entityVal za) of
                  Local -> decodeOrchAction Internal o
                  FullViewKey -> decodeOrchActionFvk Internal o
                  IncomingViewKey -> Nothing
          case externalDecode of
            Nothing ->
              case internalDecode of
                Nothing -> return ()
                Just dn1 -> do
                  wId <- saveWalletTransaction pool (entityKey za) zt
                  saveWalletOrchNote
                    pool
                    wId
                    nP
                    True
                    (entityKey za)
                    (entityKey o)
                    dn1
            Just dn -> do
              wId <- saveWalletTransaction pool (entityKey za) zt
              saveWalletOrchNote
                pool
                wId
                nP
                False
                (entityKey za)
                (entityKey o)
                dn
    sk :: Maybe OrchardSpendingKeyDB
    sk = zcashAccountOrchSpendKey $ entityVal za
    fvk :: Maybe UnifiedFvkDB
    fvk = zcashAccountFvk $ entityVal za
    ivk :: Maybe UnifiedIvkDB
    ivk = zcashAccountIvk $ entityVal za
    decodeOrchAction :: Scope -> Entity OrchAction -> Maybe DecodedNote
    decodeOrchAction scope o =
      case sk of
        Nothing -> Nothing
        Just sk' -> do
          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)
    decodeOrchActionFvk :: Scope -> Entity OrchAction -> Maybe DecodedNote
    decodeOrchActionFvk scope o =
      case fvk of
        Nothing -> Nothing
        Just sk' -> do
          decryptOrchardActionFvk (getFvk 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)
    decodeOrchActionIvk :: Entity OrchAction -> Maybe DecodedNote
    decodeOrchActionIvk o =
      case ivk of
        Nothing -> Nothing
        Just sk' -> do
          decryptOrchardActionIvk (getIvk sk') $
            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 noteSync maxId
        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 maxId
        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])
  -> [OutgoingNote]
  -> Int64
calculateTxFee (t, s, o) nout =
  fromIntegral $ 5000 * (tcount + saction + oaction)
  where
    tout =
      length $
      filter
        (\(OutgoingNote x _ _ _ _ _) -> x == 1 || x == 2 || x == 5 || x == 6)
        nout
    sout = length $ filter (\(OutgoingNote x _ _ _ _ _) -> x == 3) nout
    oout = length $ filter (\(OutgoingNote x _ _ _ _ _) -> x == 4) nout
    tcount = max (length t) tout
    scount = max (length s) sout
    ocount = max (length o) oout
    saction =
      if scount == 1
        then 2
        else scount
    oaction =
      if ocount == 1
        then 2
        else ocount

-- | Prepare a transaction for sending
{-
 -prepareTx ::
 -     ConnectionPool
 -  -> T.Text
 -  -> Int
 -  -> ZcashNet
 -  -> ZcashAccountId
 -  -> Int
 -  -> Scientific
 -  -> 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 pool zebraHost zebraPort (ZcashNetDB zn) 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' = toBoundedInteger $ amt * scientific 1 8
 -      case zats' of
 -        Nothing -> return $ Left ZHError
 -        Just zats -> do
 -          logDebugN $ T.pack $ show (zats :: Int64)
 -          {-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 (fromIntegral $ 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
 -              (fromInteger noteTotal - 5000 - zats)
 -          logDebugN "Calculating fee"
 -          let feeResponse =
 -                createTransaction
 -                  (Just sT)
 -                  (Just oT)
 -                  tSpends
 -                  sSpends
 -                  oSpends
 -                  dummy
 -                  zn
 -                  bh
 -                  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 (fromIntegral 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
 -                  (fromInteger noteTotal - fromInteger feeAmt - zats)
 -              logDebugN $ T.pack $ show outgoing
 -              let tx =
 -                    createTransaction
 -                      (Just sT)
 -                      (Just oT)
 -                      tSpends
 -                      sSpends
 -                      oSpends
 -                      outgoing
 -                      zn
 -                      bh
 -                      True
 -              logDebugN $ T.pack $ show tx
 -              return tx
 -  where
 -    makeOutgoing ::
 -         Entity ZcashAccount
 -      -> (Int, BS.ByteString)
 -      -> Int64
 -      -> Int64
 -      -> 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
 -}
deshieldNotes ::
     ConnectionPool
  -> T.Text
  -> Int
  -> ZcashNet
  -> ZcashAccountId
  -> Int
  -> Scientific
  -> NoLoggingT IO (Either TxError HexString)
deshieldNotes pool zebraHost zebraPort znet za bh pnote = do
  bal <- liftIO $ getShieldedBalance pool za
  addrs <- getAddresses pool za
  let defAddr =
        parseAddress $
        E.encodeUtf8 $ getUA $ walletAddressUAddress $ entityVal $ head addrs
  case defAddr of
    Nothing -> return $ Left ZHError
    Just (Unified x) -> do
      case getTransparentFromUA x of
        Nothing -> return $ Left ZHError
        Just ta -> do
          let zats = pnote * scientific 1 8
          if fromInteger bal > (scientific 2 4 + zats)
            then prepareTxV2
                   pool
                   zebraHost
                   zebraPort
                   znet
                   za
                   bh
                   [ ProposedNote
                       (ValidAddressAPI $ Transparent ta)
                       pnote
                       Nothing
                   ]
                   Low
            else return $ Left InsufficientFunds
    _anyOther -> return $ Left ZHError

shieldTransparentNotes ::
     ConnectionPool
  -> T.Text
  -> Int
  -> ZcashNet
  -> ZcashAccountId
  -> Int
  -> NoLoggingT IO [Either TxError U.UUID]
shieldTransparentNotes pool zHost zPort znet za bh = do
  accRead <- liftIO $ getAccountById pool za
  logDebugN $ T.pack $ "Target block: " ++ show bh
  case accRead of
    Nothing -> do
      logErrorN "Can't find Account"
      return [Left ZHError]
    Just acc -> do
      trNotes' <- liftIO $ getWalletUnspentTrNotes pool za
      if null trNotes'
        then return [Left InsufficientFunds]
        else do
          dRecvs <- liftIO $ getReceivers pool trNotes'
          let fNotes =
                map
                  (\x ->
                     filter
                       (\y -> walletTrNoteAddress (entityVal y) == x)
                       trNotes')
                  dRecvs
          sTree <- liftIO $ getSaplingTree pool
          oTree <- liftIO $ getOrchardTree pool
          forM fNotes $ \trNotes -> do
            opid <- liftIO nextRandom
            startTime <- liftIO getCurrentTime
            opkey <-
              liftIO $
              saveOperation pool $
              Operation (ZenithUuid opid) startTime Nothing Processing Nothing
            case opkey of
              Nothing -> return $ Left ZHError
              Just opkey' -> do
                let noteTotal = getTotalAmount (trNotes, [], [])
                tSpends <-
                  liftIO $
                  prepTSpends
                    (getTranSK <$> zcashAccountTPrivateKey (entityVal acc))
                    trNotes
                chgAddr <- liftIO $ getInternalAddresses pool $ entityKey acc
                let internalUA =
                      getUA $ walletAddressUAddress $ entityVal $ head chgAddr
                let oRcvr =
                      fromJust $
                      o_rec =<< isValidUnifiedAddress (E.encodeUtf8 internalUA)
                let dummy =
                      OutgoingNote
                        4
                        "deadbeef"
                        (getBytes oRcvr)
                        (fromIntegral $ noteTotal - 500)
                        ""
                        True
                let feeAmt = calculateTxFee (trNotes, [], []) [dummy]
                let osk' =
                      getOrchSK <$> zcashAccountOrchSpendKey (entityVal acc)
                case osk' of
                  Nothing -> return $ Left ZHError
                  Just osk -> do
                    let snote =
                          OutgoingNote
                            4
                            (getBytes osk)
                            (getBytes oRcvr)
                            (fromIntegral $ noteTotal - fromIntegral feeAmt)
                            ""
                            True
                    _ <-
                      liftIO $
                      forkIO $ do
                        tx <-
                          liftIO $
                          createTransaction
                            (maybe
                               (hexString "00")
                               (getHash . value . fst)
                               sTree)
                            (maybe
                               (hexString "00")
                               (getHash . value . fst)
                               oTree)
                            tSpends
                            []
                            []
                            [snote]
                            znet
                            (bh + 3)
                            True
                        case tx of
                          Left e ->
                            finalizeOperation pool opkey' Failed $
                            T.pack $ show e
                          Right rawTx -> do
                            zebraRes <-
                              makeZebraCall
                                zHost
                                zPort
                                "sendrawtransaction"
                                [Data.Aeson.String $ toText rawTx]
                            case zebraRes of
                              Left e1 ->
                                finalizeOperation pool opkey' Failed $
                                T.pack $ show e1
                              Right txId ->
                                finalizeOperation pool opkey' Successful $
                                "Tx ID: " <> toText txId
                    logDebugN $ T.pack $ show opid
                    return $ Right opid
  where
    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 ::
         Maybe TransparentSpendingKey
      -> [Entity WalletTrNote]
      -> IO [TransparentTxSpend]
    prepTSpends sk' notes = do
      case sk' of
        Nothing -> return []
        Just sk -> 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))

-- | Prepare a transaction for sending
prepareTxV2 ::
     ConnectionPool
  -> T.Text
  -> Int
  -> ZcashNet
  -> ZcashAccountId
  -> Int
  -> [ProposedNote]
  -> PrivacyPolicy
  -> NoLoggingT IO (Either TxError HexString)
prepareTxV2 pool zebraHost zebraPort zn za bh pnotes policy = do
  accRead <- liftIO $ getAccountById pool za
  let recipients = map extractReceiver pnotes
  logDebugN $ T.pack $ show recipients
  logDebugN $ T.pack $ "Target block: " ++ show bh
  sTree <- liftIO $ getSaplingTree pool
  oTree <- liftIO $ getOrchardTree pool
  case accRead of
    Nothing -> do
      logErrorN "Can't find Account"
      return $ Left ZHError
    Just acc -> do
      logDebugN $ T.pack $ show acc
      let amt = foldl' (\x y -> x + pn_amt y) 0 pnotes
      let zats' = toBoundedInteger $ amt * scientific 1 8
      case zats' of
        Nothing -> do
          logErrorN "Failed to parse amount into zats"
          return $ Left ZHError
        Just zats -> do
          logDebugN $ "amt: " <> T.pack (show amt)
          logDebugN $ "zats: " <> T.pack (show zats)
          {-firstPass <- liftIO $ selectUnspentNotes pool za zats-}
          --let fee = calculateTxFee firstPass $ fst recipient
          --logDebugN $ T.pack $ "calculated fee " ++ show fee
          notePlan <-
            liftIO $
            selectUnspentNotesV2
              pool
              za
              (zats + 20000)
              (map (\(x, _, _, _) -> x) recipients)
              policy
          case notePlan of
            Right (tList, sList, oList) -> do
              logDebugN "selected notes"
              logDebugN $ T.pack $ show tList
              logDebugN $ T.pack $ show sList
              logDebugN $ T.pack $ show oList
              let noteTotal = getTotalAmount (tList, sList, oList)
              logDebugN $ "noteTotal: " <> T.pack (show noteTotal)
              draft <-
                liftIO $
                makeOutgoing
                  acc
                  recipients
                  (noteTotal - 5000 - fromIntegral zats)
                  policy
              case draft of
                Left e -> return $ Left e
                Right draftOut' -> do
                  let draftOut = catMaybes draftOut'
                  let fee = calculateTxFee (tList, sList, oList) draftOut
                  logDebugN $ T.pack $ "calculated fee " ++ show fee
                  finalNotePlan <-
                    liftIO $
                    selectUnspentNotesV2
                      pool
                      za
                      (zats + fee)
                      (map (\(x, _, _, _) -> x) recipients)
                      policy
                  case finalNotePlan of
                    Right (tList1, sList1, oList1) -> do
                      logDebugN $ T.pack $ "selected notes with fee" ++ show fee
                      logDebugN $ T.pack $ show tList1
                      logDebugN $ T.pack $ show sList1
                      logDebugN $ T.pack $ show oList1
                      tSpends1 <-
                        liftIO $
                        prepTSpends
                          (getTranSK <$> zcashAccountTPrivateKey (entityVal acc))
                          tList1
                      sSpends1 <-
                        liftIO $
                        prepSSpends
                          (getSapSK <$> zcashAccountSapSpendKey (entityVal acc))
                          (maybe InvalidTree fst sTree)
                          sList1
                      oSpends1 <-
                        liftIO $
                        prepOSpends
                          (getOrchSK <$>
                           zcashAccountOrchSpendKey (entityVal acc))
                          (maybe InvalidTree fst oTree)
                          oList1
                      let noteTotal1 = getTotalAmount (tList1, sList1, oList1)
                      outgoing' <-
                        liftIO $
                        makeOutgoing
                          acc
                          recipients
                          (noteTotal1 - fee - fromIntegral zats)
                          policy
                      logDebugN $ T.pack $ show outgoing'
                      case outgoing' of
                        Left e -> return $ Left e
                        Right outgoing'' -> do
                          let outgoing = catMaybes outgoing''
                          tx <-
                            liftIO $
                            createTransaction
                              (maybe
                                 (hexString "00")
                                 (getHash . value . fst)
                                 sTree)
                              (maybe
                                 (hexString "00")
                                 (getHash . value . fst)
                                 oTree)
                              tSpends1
                              sSpends1
                              oSpends1
                              outgoing
                              zn
                              bh
                              True
                          logDebugN $ T.pack $ show tx
                          return tx
                    Left e -> return $ Left e
            Left e -> do
              logErrorN $ T.pack $ show e
              return $ Left e
  where
    extractReceiver :: ProposedNote -> (Int, BS.ByteString, Int64, T.Text)
    extractReceiver (ProposedNote (ValidAddressAPI va) amt m) =
      let zats' = toBoundedInteger $ amt * scientific 1 8
       in case zats' of
            Nothing -> (0, "", 0, "")
            Just zats ->
              case va of
                Unified ua ->
                  case o_rec ua of
                    Nothing ->
                      case s_rec ua of
                        Nothing ->
                          case t_rec ua of
                            Nothing -> (0, "", 0, "")
                            Just r3 ->
                              case tr_type r3 of
                                P2PKH ->
                                  ( 1
                                  , toBytes $ tr_bytes r3
                                  , zats
                                  , fromMaybe "" m)
                                P2SH ->
                                  ( 2
                                  , toBytes $ tr_bytes r3
                                  , zats
                                  , fromMaybe "" m)
                        Just r2 -> (3, getBytes r2, zats, fromMaybe "" m)
                    Just r1 -> (4, getBytes r1, zats, fromMaybe "" m)
                Sapling sa ->
                  (3, getBytes $ sa_receiver sa, zats, fromMaybe "" m)
                Transparent ta ->
                  case tr_type (ta_receiver ta) of
                    P2PKH ->
                      ( 1
                      , toBytes $ tr_bytes (ta_receiver ta)
                      , zats
                      , fromMaybe "" m)
                    P2SH ->
                      ( 2
                      , toBytes $ tr_bytes (ta_receiver ta)
                      , zats
                      , fromMaybe "" m)
                Exchange ea ->
                  case tr_type (ex_address ea) of
                    P2PKH ->
                      ( 5
                      , toBytes $ tr_bytes (ex_address ea)
                      , zats
                      , fromMaybe "" m)
                    P2SH ->
                      ( 6
                      , toBytes $ tr_bytes (ex_address ea)
                      , zats
                      , fromMaybe "" m)
    prepareOutgoingNote ::
         ZcashAccount
      -> (Int, BS.ByteString, Int64, T.Text)
      -> Maybe OutgoingNote
    prepareOutgoingNote zac (k, r, a, m)
      | k == 4 && isNothing (zcashAccountOrchSpendKey zac) = Nothing
      | k == 3 && isNothing (zcashAccountSapSpendKey zac) = Nothing
      | otherwise =
        Just $
        OutgoingNote
          (if k == 5
             then 1
             else if k == 6
                    then 2
                    else fromIntegral k)
          (case k of
             4 -> getBytes $ getOrchSK $ fromJust $ zcashAccountOrchSpendKey zac
             3 -> getBytes $ getSapSK $ fromJust $ zcashAccountSapSpendKey zac
             _anyOther -> BS.empty)
          r
          (fromIntegral a)
          (E.encodeUtf8 m)
          False
    makeOutgoing ::
         Entity ZcashAccount
      -> [(Int, BS.ByteString, Int64, T.Text)]
      -> Int64
      -> PrivacyPolicy
      -> IO (Either TxError [Maybe OutgoingNote])
    makeOutgoing acc recvs chg pol = do
      let k = map (\(x, _, _, _) -> x) recvs
      let j = map (\(_, _, x, _) -> x) recvs
      chgAddr <- getInternalAddresses pool $ entityKey acc
      let internalUA = getUA $ walletAddressUAddress $ entityVal $ head chgAddr
      case pol of
        Full ->
          if elem 1 k || elem 2 k || elem 5 k || elem 6 k
            then return $
                 Left $
                 PrivacyPolicyError
                   "Receiver not compatible with privacy policy"
            else if elem 3 k && elem 4 k
                   then return $
                        Left $
                        PrivacyPolicyError
                          "Multiple shielded pools not allowed for Full privacy"
                   else if 3 `elem` k &&
                           isJust (zcashAccountSapSpendKey $ entityVal acc)
                          then do
                            let chgRcvr =
                                  fromJust $
                                  s_rec =<<
                                  isValidUnifiedAddress
                                    (E.encodeUtf8 internalUA)
                            let cnote =
                                  Just $
                                  OutgoingNote
                                    3
                                    (getBytes $
                                     getSapSK $
                                     fromJust $
                                     zcashAccountSapSpendKey $ entityVal acc)
                                    (getBytes chgRcvr)
                                    (fromIntegral chg)
                                    ""
                                    True
                            let onotes =
                                  map
                                    (prepareOutgoingNote (entityVal acc))
                                    recvs
                            return $ Right $ cnote : onotes
                          else if 4 `elem` k &&
                                  isJust
                                    (zcashAccountOrchSpendKey $ entityVal acc)
                                 then do
                                   let chgRcvr =
                                         fromJust $
                                         o_rec =<<
                                         isValidUnifiedAddress
                                           (E.encodeUtf8 internalUA)
                                   let cnote =
                                         Just $
                                         OutgoingNote
                                           4
                                           (getBytes $
                                            getOrchSK $
                                            fromJust $
                                            zcashAccountOrchSpendKey $
                                            entityVal acc)
                                           (getBytes chgRcvr)
                                           (fromIntegral chg)
                                           ""
                                           True
                                   let onotes =
                                         map
                                           (prepareOutgoingNote (entityVal acc))
                                           recvs
                                   return $ Right $ cnote : onotes
                                 else return $ Left ZHError
        Medium ->
          if elem 1 k || elem 2 k || elem 5 k || elem 6 k
            then return $
                 Left $
                 PrivacyPolicyError
                   "Receiver not compatible with privacy policy"
            else do
              let chgRcvr =
                    fromJust $
                    o_rec =<< isValidUnifiedAddress (E.encodeUtf8 internalUA)
              let cnote =
                    Just $
                    OutgoingNote
                      4
                      (getBytes $
                       getOrchSK $
                       fromJust $ zcashAccountOrchSpendKey $ entityVal acc)
                      (getBytes chgRcvr)
                      (fromIntegral chg)
                      ""
                      True
              let onotes = map (prepareOutgoingNote (entityVal acc)) recvs
              return $ Right $ cnote : onotes
        Low ->
          if elem 5 k || elem 6 k
            then return $
                 Left $
                 PrivacyPolicyError
                   "Receiver not compatible with privacy policy"
            else do
              let chgRcvr =
                    fromJust $
                    o_rec =<< isValidUnifiedAddress (E.encodeUtf8 internalUA)
              let cnote =
                    Just $
                    OutgoingNote
                      4
                      (getBytes $
                       getOrchSK $
                       fromJust $ zcashAccountOrchSpendKey $ entityVal acc)
                      (getBytes chgRcvr)
                      (fromIntegral chg)
                      ""
                      True
              let onotes = map (prepareOutgoingNote (entityVal acc)) recvs
              return $ Right $ cnote : onotes
        None ->
          if elem 3 k || elem 4 k
            then return $
                 Left $
                 PrivacyPolicyError
                   "Receiver not compatible with privacy policy"
            else do
              let chgRcvr =
                    fromJust $
                    t_rec =<< isValidUnifiedAddress (E.encodeUtf8 internalUA)
              let cnote =
                    Just $
                    OutgoingNote
                      1
                      BS.empty
                      (toBytes $ tr_bytes chgRcvr)
                      (fromIntegral chg)
                      ""
                      True
              let onotes = map (prepareOutgoingNote (entityVal acc)) recvs
              return $ Right $ cnote : onotes
    getTotalAmount ::
         ( [Entity WalletTrNote]
         , [Entity WalletSapNote]
         , [Entity WalletOrchNote])
      -> Int64
    getTotalAmount (t, s, o) =
      sum (map (fromIntegral . walletTrNoteValue . entityVal) t) +
      sum (map (fromIntegral . walletSapNoteValue . entityVal) s) +
      sum (map (fromIntegral . walletOrchNoteValue . entityVal) o)
    prepTSpends ::
         Maybe TransparentSpendingKey
      -> [Entity WalletTrNote]
      -> IO [TransparentTxSpend]
    prepTSpends sk' notes = do
      case sk' of
        Nothing -> return []
        Just sk -> 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 ::
         Maybe SaplingSpendingKey
      -> Tree SaplingNode
      -> [Entity WalletSapNote]
      -> IO [SaplingTxSpend]
    prepSSpends sk' tree notes = do
      case sk' of
        Nothing -> return []
        Just sk -> do
          forM notes $ \n -> do
            let notePath =
                  Zenith.Tree.path
                    (fromIntegral $ walletSapNotePosition $ entityVal n)
                    tree
            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))
                (fromMaybe nullPath notePath)
    prepOSpends ::
         Maybe OrchardSpendingKey
      -> Tree OrchardNode
      -> [Entity WalletOrchNote]
      -> IO [OrchardTxSpend]
    prepOSpends sk' tree notes = do
      case sk' of
        Nothing -> return []
        Just sk -> do
          forM notes $ \n -> do
            let notePath =
                  Zenith.Tree.path
                    (fromIntegral $ walletOrchNotePosition $ entityVal n)
                    tree
            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))
                (fromMaybe nullPath notePath)

-- | Sync the wallet with the data store
syncWallet ::
     Config -- ^ configuration parameters
  -> Entity ZcashWallet
  -> NoLoggingT IO ()
syncWallet config w = do
  startTime <- liftIO getCurrentTime
  logDebugN $ T.pack $ show startTime
  let walletDb = c_dbPath config
  let znet = zcashWalletNetwork $ entityVal w
  pool <- liftIO $ runNoLoggingT $ initPool walletDb
  accs <- liftIO $ runNoLoggingT $ getAccounts pool $ entityKey w
  addrs <-
    concat <$>
    mapM (liftIO . runNoLoggingT . getAddresses pool . entityKey) accs
  logDebugN $ "addrs: " <> T.pack (show addrs)
  intAddrs <-
    concat <$> mapM (liftIO . getInternalAddresses pool . entityKey) accs
  chainTip <- liftIO $ getMaxBlock pool znet
  logDebugN $ "chain tip: " <> T.pack (show chainTip)
  lastBlock <- liftIO $ getLastSyncBlock pool $ entityKey w
  logDebugN $ "last block: " <> T.pack (show lastBlock)
  let startBlock =
        if lastBlock > 0
          then lastBlock
          else 1 + zcashWalletBirthdayHeight (entityVal w)
  logDebugN $ "start block: " <> T.pack (show startBlock)
  mapM_ (liftIO . findTransparentNotes pool startBlock znet) addrs
  mapM_ (liftIO . findTransparentNotes pool startBlock znet) intAddrs
  logDebugN "processed transparent notes"
  mapM_ (liftIO . findTransparentSpends pool . entityKey) accs
  logDebugN "processed transparent spends"
  liftIO $
    runNoLoggingT $
    mapM_
      (findSaplingOutputs config startBlock (zcashWalletNetwork $ entityVal w))
      accs
  logDebugN "processed sapling outputs"
  liftIO $
    mapM_
      (findOrchardActions config startBlock (zcashWalletNetwork $ entityVal w))
      accs
  logDebugN "processed orchard actions"
  _ <- liftIO $ updateWalletSync pool chainTip (entityKey w)
  logDebugN "updated wallet lastSync"
  mapM_ (liftIO . runNoLoggingT . getWalletTransactions pool) addrs

-- | Update commitment trees
updateCommitmentTrees ::
     ConnectionPool -> T.Text -> Int -> ZcashNetDB -> NoLoggingT IO ()
updateCommitmentTrees pool zHost zPort zNet = do
  sTdb <- liftIO $ getSaplingTree pool
  oTdb <- liftIO $ getOrchardTree pool
  maxBlock <- liftIO $ getMaxBlock pool zNet
  newSapTree <-
    case sTdb of
      Nothing -> do
        logDebugN ">no Sapling tree in DB"
        bh <- liftIO $ getMinBirthdayHeight pool zNet
        logDebugN $ ">min birthday: " <> T.pack (show bh)
        saplingNotes <- liftIO $ getShieldedOutputs pool (bh + 1) zNet
        let saplingComm =
              map
                (\(_, y) ->
                   ( getHex $ shieldOutputCmu (entityVal y)
                   , fromSqlKey (entityKey y)))
                saplingNotes
        logDebugN ">got shielded outputs"
        treeInfo <- liftIO $ getCommitmentTrees pool zHost zPort zNet bh
        case getSaplingTreeParts (SaplingCommitmentTree $ ztiSapling treeInfo) of
          Nothing -> do
            logDebugN ">failed to load tree from Zebra"
            return InvalidTree
          Just t1 -> do
            let newTree = mkSaplingTree t1
            let zippedSapComms =
                  zip [(getPosition (value newTree) + 1) ..] saplingComm
            return $ batchAppend newTree zippedSapComms
      Just (sTree, sSync) -> do
        logDebugN $ ">Sapling tree found, synced to " <> T.pack (show sSync)
        saplingNotes <- liftIO $ getShieldedOutputs pool (sSync + 1) zNet
        let saplingComm =
              map
                (\(_, y) ->
                   ( getHex $ shieldOutputCmu (entityVal y)
                   , fromSqlKey (entityKey y)))
                saplingNotes
        logDebugN ">got shielded outputs"
        let zippedSapComms =
              zip [(getPosition (value sTree) + 1) ..] saplingComm
        return $ batchAppend sTree zippedSapComms
  newOrchTree <-
    case oTdb of
      Nothing -> do
        logDebugN ">no Orchard tree in DB"
        bh <- liftIO $ getMinBirthdayHeight pool zNet
        logDebugN $ ">min birthday: " <> T.pack (show bh)
        orchardNotes <- liftIO $ getOrchardActions pool (bh + 1) zNet
        let orchardComm =
              map
                (\(_, y) ->
                   ( getHex $ orchActionCmx (entityVal y)
                   , fromSqlKey (entityKey y)))
                orchardNotes
        logDebugN ">got orchard actions"
        treeInfo <- liftIO $ getCommitmentTrees pool zHost zPort zNet bh
        case getOrchardTreeParts (OrchardCommitmentTree $ ztiOrchard treeInfo) of
          Nothing -> do
            logDebugN ">failed to load tree from Zebra"
            return InvalidTree
          Just t1 -> do
            let newTree = mkOrchardTree t1
            let zippedOrchComms =
                  zip [(getPosition (value newTree) + 1) ..] orchardComm
            return $ batchAppend newTree zippedOrchComms
      Just (oTree, oSync) -> do
        logDebugN $ ">Orchard tree found, synced to " <> T.pack (show oSync)
        orchardNotes <- liftIO $ getOrchardActions pool (oSync + 1) zNet
        let orchardComm =
              map
                (\(_, y) ->
                   ( getHex $ orchActionCmx (entityVal y)
                   , fromSqlKey (entityKey y)))
                orchardNotes
        logDebugN ">got orchard actions"
        let zippedOrchComms =
              zip [(getPosition (value oTree) + 1) ..] orchardComm
        return $ batchAppend oTree zippedOrchComms
  case newSapTree of
    Branch {} -> do
      logInfoN ">Saving updated Sapling tree to db"
      _ <- liftIO $ upsertSaplingTree pool maxBlock newSapTree
      case newOrchTree of
        Branch {} -> do
          logInfoN ">Saving updated Orchard tree to db"
          _ <- liftIO $ upsertOrchardTree pool maxBlock newOrchTree
          return ()
        _anyOther -> do
          logErrorN ">Failed to update the Orchard tree"
          return ()
    _anyOther -> do
      logErrorN ">Failed to update the Sapling tree"
      return ()
