rvv001- zcash-haskell updated

CHANGELOG.md

@@ -20,6 +20,7 @@ and this project adheres to [Semantic Versioning](https://semver.org/spec/v2.0.0
 	- `getnewaccount` RPC method
 	- `getnewaddress` RPC method
 	- `getoperationstatus` RPC method
+	- `sendmany` RPC method
 - Function `prepareTxV2` implementing `PrivacyPolicy`
 
 ### Changed
@@ -27,6 +28,7 @@ and this project adheres to [Semantic Versioning](https://semver.org/spec/v2.0.0
 - Detection of changes in database schema for automatic re-scan
 - Block tracking for chain re-org detection
 - Refactored `ZcashPool`
+- Preventing write operations to occur during wallet sync
 
 
 ## [0.6.0.0-beta]

app/Server.hs

@@ -2,15 +2,22 @@
 
 module Server where
 
+import Control.Concurrent (forkIO, threadDelay)
 import Control.Exception (throwIO, try)
-import Control.Monad (when)
+import Control.Monad (forever, when)
 import Data.Configurator
 import Network.Wai.Handler.Warp (run)
 import Servant
 import ZcashHaskell.Types (ZebraGetBlockChainInfo(..), ZebraGetInfo(..))
 import Zenith.Core (checkBlockChain, checkZebra)
 import Zenith.DB (initDb)
-import Zenith.RPC (State(..), ZenithRPC(..), authenticate, zenithServer)
+import Zenith.RPC
+  ( State(..)
+  , ZenithRPC(..)
+  , authenticate
+  , scanZebra
+  , zenithServer
+  )
 import Zenith.Scanner (rescanZebra)
 import Zenith.Types (Config(..))
 
@@ -39,6 +46,12 @@ main = do
             Left e2 -> throwIO $ userError e2
             Right x' -> do
               when x' $ rescanZebra zebraHost zebraPort dbFilePath
+              _ <-
+                forkIO $
+                forever $ do
+                  _ <-
+                    scanZebra dbFilePath zebraHost zebraPort (zgb_net chainInfo)
+                  threadDelay 90000000
               let myState =
                     State
                       (zgb_net chainInfo)

src/Zenith/CLI.hs

@@ -2,6 +2,7 @@
 {-# LANGUAGE TypeApplications #-}
 {-# LANGUAGE OverloadedStrings #-}
 {-# LANGUAGE ScopedTypeVariables #-}
+{-# LANGUAGE LambdaCase #-}
 
 module Zenith.CLI where
 
@@ -62,13 +63,14 @@ import qualified Brick.Widgets.List as L
 import qualified Brick.Widgets.ProgressBar as P
 import Control.Concurrent (forkIO, threadDelay)
 import Control.Exception (throw, throwIO, try)
-import Control.Monad (forever, unless, void, when)
+import Control.Monad (forM_, forever, unless, void, when)
 import Control.Monad.IO.Class (liftIO)
 import Control.Monad.Logger
   ( LoggingT
+  , NoLoggingT
   , logDebugN
-  , runFileLoggingT
   , runNoLoggingT
+  , runStderrLoggingT
   )
 import Data.Aeson
 import Data.HexString (HexString(..), toText)
@@ -88,8 +90,15 @@ import System.Hclip
 import Text.Printf
 import Text.Wrap (FillScope(..), FillStrategy(..), WrapSettings(..))
 import ZcashHaskell.Keys (generateWalletSeedPhrase)
-import ZcashHaskell.Orchard (getSaplingFromUA, isValidUnifiedAddress)
+import ZcashHaskell.Orchard
-import ZcashHaskell.Transparent (encodeTransparentReceiver)
+  ( getSaplingFromUA
+  , isValidUnifiedAddress
+  , parseAddress
+  )
+import ZcashHaskell.Transparent
+  ( decodeTransparentAddress
+  , encodeTransparentReceiver
+  )
 import ZcashHaskell.Types
 import ZcashHaskell.Utils (getBlockTime, makeZebraCall)
 import Zenith.Core
@@ -100,9 +109,12 @@ import Zenith.Types
   , HexStringDB(..)
   , PhraseDB(..)
   , PrivacyPolicy(..)
-  , UnifiedAddressDB(..)
+  , ProposedNote(..)
-  , ZcashNetDB(..)
   , ShieldDeshieldOp(..)
+  , UnifiedAddressDB(..)
+  , ValidAddressAPI(..)
+  , ZcashNetDB(..)
+  , ZenithStatus(..)
   )
 import Zenith.Utils
   ( displayTaz
@@ -161,11 +173,9 @@ data AdrBookEntry = AdrBookEntry
 
 makeLenses ''AdrBookEntry
 
-data ShDshEntry = ShDshEntry 
+newtype ShDshEntry = ShDshEntry
-  { _totalTransparent :: !Float
+  { _shAmt :: Float
-  , _totalShielded :: !Float
+  } deriving (Show)
-  , _shAmt  :: !Float
-  }  deriving (Show)
 
 makeLenses ''ShDshEntry
 
@@ -232,7 +242,8 @@ data State = State
   , _sentTx :: !(Maybe HexString)
   , _unconfBalance :: !Integer
   , _deshieldForm :: !(Form ShDshEntry () Name)
-  , _shieldForm :: !(Form ShDshEntry () Name)
+  , _tBalance :: !Integer
+  , _sBalance :: !Integer
   }
 
 makeLenses ''State
@@ -249,11 +260,11 @@ drawUI s = [splashDialog s, helpDialog s, displayDialog s, inputDialog s, ui s]
            (" Zenith - " <>
             show (st ^. network) <>
             " - " <>
-            (T.unpack
+            T.unpack
-               (maybe
+              (maybe
-                  "(None)"
+                 "(None)"
-                  (\(_, w) -> zcashWalletName $ entityVal w)
+                 (\(_, w) -> zcashWalletName $ entityVal w)
-                  (L.listSelectedElement (st ^. wallets)))) ++
+                 (L.listSelectedElement (st ^. wallets))) ++
             " "))
         (C.hCenter
            (str
@@ -280,25 +291,24 @@ drawUI s = [splashDialog s, helpDialog s, displayDialog s, inputDialog s, ui s]
          (C.hCenter
             (str ("Last block seen: " ++ show (st ^. syncBlock) ++ "\n")) <=>
           listTxBox " Transactions " (st ^. network) (st ^. transactions))) <=>
-        (vBox 
+      (vBox
-          [C.hCenter
+         [ C.hCenter
-            (hBox
+             (hBox
-            [ capCommand "W" "allets"
+                [ capCommand "W" "allets"
-            , capCommand "A" "ccounts"
+                , capCommand "A" "ccounts"
-            , capCommand "V" "iew address"
+                , capCommand "V" "iew address"
-            , capCommand3 "" "S" "end Tx"
+                , capCommand3 "" "S" "end Tx"
-            ])
+                ])
-          ,C.hCenter  
+         , C.hCenter
-            (hBox 
+             (hBox
-            [ capCommand2 "Address " "B" "ook"
+                [ capCommand2 "Address " "B" "ook"
-            , capCommand2 "s" "H" "ield"
+                , capCommand2 "s" "H" "ield"
-            , capCommand "D" "e-shield"
+                , capCommand "D" "e-shield"
-            , capCommand "Q" "uit"
+                , capCommand "Q" "uit"
-            , capCommand "?" " Help"
+                , capCommand "?" " Help"
-            , str $ show (st ^. timer)
+                , str $ show (st ^. timer)
-            ])
+                ])
-          ]
+         ])
-         )   
     listBox :: Show e => String -> L.List Name e -> Widget Name
     listBox titleLabel l =
       C.vCenter $
@@ -424,14 +434,33 @@ drawUI s = [splashDialog s, helpDialog s, displayDialog s, inputDialog s, ui s]
                (hBox [capCommand "↲ " "Send", capCommand "<esc> " "Cancel"]))
         DeshieldForm ->
           D.renderDialog
-            (D.dialog (Just (str " De-Shield Zec ")) Nothing 50)
+            (D.dialog (Just (str " De-Shield ZEC ")) Nothing 50)
-            (renderForm (st ^. deshieldForm) <=>
+            (C.hCenter
+               (padAll 1 $
+                vBox
+                  [ str $
+                    "Transparent Bal.: " ++
+                    if st ^. network == MainNet
+                      then displayZec (st ^. tBalance)
+                      else displayTaz (st ^. tBalance)
+                  , str $
+                    "Shielded Bal.:    " ++
+                    if st ^. network == MainNet
+                      then displayZec (st ^. sBalance)
+                      else displayTaz (st ^. sBalance)
+                  ]) <=>
+             renderForm (st ^. deshieldForm) <=>
              C.hCenter
                (hBox [capCommand "P" "roceed", capCommand "<esc> " "Cancel"]))
         ShieldForm ->
           D.renderDialog
-            (D.dialog (Just (str " Shield Zec ")) Nothing 50)
+            (D.dialog (Just (str " Shield ZEC ")) Nothing 50)
-            (renderForm (st ^. shieldForm) <=>
+            (C.hCenter
+               (str $
+                "Shield " ++
+                if st ^. network == MainNet
+                  then displayZec (st ^. tBalance)
+                  else displayTaz (st ^. tBalance) ++ "?") <=>
              C.hCenter
                (hBox [capCommand "P" "roceed", capCommand "<esc> " "Cancel"]))
         Blank -> emptyWidget
@@ -678,26 +707,10 @@ mkSendForm bal =
       padBottom (Pad 1) $ vLimit 1 (hLimit 15 $ str s <+> fill ' ') <+> w
 
 mkDeshieldForm :: Integer -> ShDshEntry -> Form ShDshEntry e Name
-mkDeshieldForm bal =
+mkDeshieldForm tbal =
   newForm
-    [ label "Total Transp.  : " @@= 
+    [ label "Amount: " @@=
-        editShowableFieldWithValidate totalTransparent TotalTranspField (isAmountValid bal)
+      editShowableFieldWithValidate shAmt AmtField (isAmountValid tbal)
-    , label "Total Shielded : " @@= 
-        editShowableFieldWithValidate totalShielded TotalShieldedField (isAmountValid bal) 
-    , label "Amount: " @@=
-      editShowableFieldWithValidate shAmt AmtField (isAmountValid bal)
-    ]
-  where
-    isAmountValid :: Integer -> Float -> Bool
-    isAmountValid b i = (fromIntegral b / 100000000.0) >= i
-    label s w =
-      padBottom (Pad 1) $ vLimit 1 (hLimit 15 $ str s <+> fill ' ') <+> w
-
-mkShieldForm :: Integer -> ShDshEntry -> Form ShDshEntry e Name
-mkShieldForm bal =
-  newForm
-    [ label "Amount to Shield: " @@=
-      editShowableFieldWithValidate shAmt AmtField (isAmountValid bal)
     ]
   where
     isAmountValid :: Integer -> Float -> Bool
@@ -819,34 +832,45 @@ scanZebra dbP zHost zPort b eChan znet = do
   pool <- liftIO $ runNoLoggingT $ initPool dbP
   dbBlock <- liftIO $ getMaxBlock pool $ ZcashNetDB znet
   chkBlock <- liftIO $ checkIntegrity dbP zHost zPort dbBlock 1
-  logDebugN $
+  syncChk <- liftIO $ isSyncing pool
-    "dbBlock: " <>
+  if syncChk
-    T.pack (show dbBlock) <> " chkBlock: " <> T.pack (show chkBlock)
+    then liftIO $ BC.writeBChan eChan $ TickMsg "Sync alread in progress"
-  when (chkBlock /= dbBlock) $ liftIO $ rewindWalletData pool chkBlock
-  let sb =
-        if chkBlock == dbBlock
-          then max dbBlock b
-          else max chkBlock b
-  if sb > zgb_blocks bStatus || sb < 1
-    then do
-      liftIO $ BC.writeBChan eChan $ TickMsg "Invalid starting block for scan"
     else do
-      let bList = [(sb + 1) .. (zgb_blocks bStatus)]
+      logDebugN $
-      if not (null bList)
+        "dbBlock: " <>
+        T.pack (show dbBlock) <> " chkBlock: " <> T.pack (show chkBlock)
+      when (chkBlock /= dbBlock) $ liftIO $ rewindWalletData pool chkBlock
+      let sb =
+            if chkBlock == dbBlock
+              then max dbBlock b
+              else max chkBlock b
+      if sb > zgb_blocks bStatus || sb < 1
         then do
-          let step =
+          liftIO $
-                (1.0 :: Float) / fromIntegral (zgb_blocks bStatus - (sb + 1))
+            BC.writeBChan eChan $ TickMsg "Invalid starting block for scan"
-          mapM_ (liftIO . processBlock pool step) bList
+        else do
-        else liftIO $ BC.writeBChan eChan $ TickVal 1.0
+          let bList = [(sb + 1) .. (zgb_blocks bStatus)]
-  confUp <-
+          if not (null bList)
-    liftIO $ try $ updateConfs zHost zPort pool :: LoggingT
+            then do
-      IO
+              let step =
-      (Either IOError ())
+                    (1.0 :: Float) /
-  case confUp of
+                    fromIntegral (zgb_blocks bStatus - (sb + 1))
-    Left _e0 ->
+              _ <- liftIO $ startSync pool
-      liftIO $
+              mapM_ (liftIO . processBlock pool step) bList
-      BC.writeBChan eChan $ TickMsg "Failed to update unconfirmed transactions"
+              confUp <-
-    Right _ -> return ()
+                liftIO $ try $ updateConfs zHost zPort pool :: LoggingT
+                  IO
+                  (Either IOError ())
+              case confUp of
+                Left _e0 -> do
+                  _ <- liftIO $ completeSync pool Failed
+                  liftIO $
+                    BC.writeBChan eChan $
+                    TickMsg "Failed to update unconfirmed transactions"
+                Right _ -> do
+                  _ <- liftIO $ completeSync pool Successful
+                  return ()
+            else liftIO $ BC.writeBChan eChan $ TickVal 1.0
   where
     processBlock :: ConnectionPool -> Float -> Int -> IO ()
     processBlock pool step bl = do
@@ -858,7 +882,9 @@ scanZebra dbP zHost zPort b eChan znet = do
           "getblock"
           [Data.Aeson.String $ T.pack $ show bl, jsonNumber 1]
       case r of
-        Left e1 -> liftIO $ BC.writeBChan eChan $ TickMsg e1
+        Left e1 -> do
+          _ <- liftIO $ completeSync pool Failed
+          liftIO $ BC.writeBChan eChan $ TickMsg e1
         Right blk -> do
           r2 <-
             liftIO $
@@ -868,7 +894,9 @@ scanZebra dbP zHost zPort b eChan znet = do
               "getblock"
               [Data.Aeson.String $ T.pack $ show bl, jsonNumber 0]
           case r2 of
-            Left e2 -> liftIO $ BC.writeBChan eChan $ TickMsg e2
+            Left e2 -> do
+              _ <- liftIO $ completeSync pool Failed
+              liftIO $ BC.writeBChan eChan $ TickMsg e2
             Right hb -> do
               let blockTime = getBlockTime hb
               bi <-
@@ -925,7 +953,7 @@ appEvent (BT.AppEvent t) = do
                      Just (_k, w) -> return w
               _ <-
                 liftIO $
-                runFileLoggingT "zenith.log" $
+                runNoLoggingT $
                 syncWallet
                   (Config
                      (s ^. dbPath)
@@ -935,11 +963,11 @@ appEvent (BT.AppEvent t) = do
                      "pwd"
                      8080)
                   selWallet
-              BT.modify $ set displayBox BlankDisplay
-              BT.modify $ set barValue 0.0
               updatedState <- BT.get
               ns <- liftIO $ refreshWallet updatedState
               BT.put ns
+              BT.modify $ set displayBox BlankDisplay
+              BT.modify $ set barValue 0.0
             else BT.modify $ set barValue $ validBarValue (v + s ^. barValue)
         BlankDisplay -> do
           case s ^. dialogBox of
@@ -964,7 +992,7 @@ appEvent (BT.AppEvent t) = do
                   _ <-
                     liftIO $
                     forkIO $
-                    runFileLoggingT "zenith.log" $
+                    runStderrLoggingT $
                     scanZebra
                       (s ^. dbPath)
                       (s ^. zebraHost)
@@ -1188,6 +1216,7 @@ appEvent (BT.VtyEvent e) = do
                                  (fs1 ^. sendAmt)
                                  (fs1 ^. sendTo)
                                  (fs1 ^. sendMemo)
+                                 (fs1 ^. policyField)
                              BT.modify $ set msg "Preparing transaction..."
                              BT.modify $ set displayBox SendDisplay
                              BT.modify $ set dialogBox Blank
@@ -1201,16 +1230,102 @@ appEvent (BT.VtyEvent e) = do
                            fs <- BT.gets formState
                            BT.modify $
                              setFieldValid
-                               (isRecipientValidGUI (fs ^. policyField) (fs ^. sendTo))
+                               (isRecipientValidGUI
+                                  (fs ^. policyField)
+                                  (fs ^. sendTo))
                                RecField
                    DeshieldForm -> do
-                      case e of 
+                     case e of
-                        V.EvKey V.KEsc [] -> BT.modify $ set dialogBox Blank
+                       V.EvKey V.KEsc [] -> BT.modify $ set dialogBox Blank
-                        ev ->
+                       V.EvKey (V.KChar 'p') [] -> do
-                          BT.zoom deshieldForm $ do
+                         if allFieldsValid (s ^. deshieldForm)
-                            handleFormEvent (BT.VtyEvent ev)
+                           then do
---                            fs <- BT.gets formState
+                             pool <-
---                        ev -> BT.zoom deshieldForm $ L.handleListEvent ev
+                               liftIO $ runNoLoggingT $ initPool $ s ^. dbPath
+                             selWal <-
+                               do case L.listSelectedElement $ s ^. wallets of
+                                    Nothing -> do
+                                      let fWall =
+                                            L.listSelectedElement $
+                                            L.listMoveToBeginning $ s ^. wallets
+                                      case fWall of
+                                        Nothing ->
+                                          throw $
+                                          userError "Failed to select wallet"
+                                        Just (_j, w1) -> return w1
+                                    Just (_k, w) -> return w
+                             selAcc <-
+                               do case L.listSelectedElement $ s ^. accounts of
+                                    Nothing -> do
+                                      let fAcc =
+                                            L.listSelectedElement $
+                                            L.listMoveToBeginning $
+                                            s ^. accounts
+                                      case fAcc of
+                                        Nothing ->
+                                          throw $
+                                          userError "Failed to select wallet"
+                                        Just (_j, w1) -> return w1
+                                    Just (_k, w) -> return w
+                             selAddr <-
+                               do case L.listSelectedElement $ s ^. addresses of
+                                    Nothing -> do
+                                      let fAddr =
+                                            L.listSelectedElement $
+                                            L.listMoveToBeginning $
+                                            s ^. addresses
+                                      case fAddr of
+                                        Nothing ->
+                                          throw $
+                                          userError "Failed to select address"
+                                        Just (_j, w1) -> return w1
+                                    Just (_k, w) -> return w
+                             fs1 <- BT.zoom deshieldForm $ BT.gets formState
+                             let tAddrMaybe =
+                                   Transparent <$>
+                                   ((decodeTransparentAddress .
+                                     E.encodeUtf8 .
+                                     encodeTransparentReceiver (s ^. network)) =<<
+                                    (t_rec =<<
+                                     (isValidUnifiedAddress .
+                                      E.encodeUtf8 .
+                                      getUA . walletAddressUAddress)
+                                       (entityVal selAddr)))
+                             bl <-
+                               liftIO $ getLastSyncBlock pool $ entityKey selWal
+                             case tAddrMaybe of
+                               Nothing -> do
+                                 BT.modify $
+                                   set
+                                     msg
+                                     "Failed to obtain transparent address"
+                                 BT.modify $ set displayBox MsgDisplay
+                                 BT.modify $ set dialogBox Blank
+                               Just tAddr -> do
+                                 _ <-
+                                   liftIO $
+                                   forkIO $
+                                   deshieldTransaction
+                                     pool
+                                     (s ^. eventDispatch)
+                                     (s ^. zebraHost)
+                                     (s ^. zebraPort)
+                                     (s ^. network)
+                                     (entityKey selAcc)
+                                     bl
+                                     (ProposedNote
+                                        (ValidAddressAPI tAddr)
+                                        (fs1 ^. shAmt)
+                                        Nothing)
+                                 BT.modify $ set displayBox SendDisplay
+                                 BT.modify $ set dialogBox Blank
+                           else do
+                             BT.modify $ set msg "Invalid inputs"
+                             BT.modify $ set displayBox MsgDisplay
+                             BT.modify $ set dialogBox Blank
+                       ev ->
+                         BT.zoom deshieldForm $ do
+                           handleFormEvent (BT.VtyEvent ev)
                    AdrBook -> do
                      case e of
                        V.EvKey (V.KChar 'x') [] ->
@@ -1228,7 +1343,7 @@ appEvent (BT.VtyEvent e) = do
                                "Address copied to Clipboard from >>\n" ++
                                T.unpack (addressBookAbdescrip (entityVal a))
                              BT.modify $ set displayBox MsgDisplay
-                           _ -> do
+                           _any -> do
                              BT.modify $
                                set msg "Error while copying the address!!"
                              BT.modify $ set displayBox MsgDisplay
@@ -1394,6 +1509,53 @@ appEvent (BT.VtyEvent e) = do
                          BT.put s'
                          BT.modify $ set dialogBox AdrBook
                        ev -> BT.modify $ set dialogBox AdrBookDelForm
+                   ShieldForm -> do
+                     case e of
+                       V.EvKey V.KEsc [] -> BT.modify $ set dialogBox Blank
+                       V.EvKey (V.KChar 'p') [] -> do
+                         pool <- liftIO $ runNoLoggingT $ initPool $ s ^. dbPath
+                         selWal <-
+                           do case L.listSelectedElement $ s ^. wallets of
+                                Nothing -> do
+                                  let fWall =
+                                        L.listSelectedElement $
+                                        L.listMoveToBeginning $ s ^. wallets
+                                  case fWall of
+                                    Nothing ->
+                                      throw $
+                                      userError "Failed to select wallet"
+                                    Just (_j, w1) -> return w1
+                                Just (_k, w) -> return w
+                         selAcc <-
+                           do case L.listSelectedElement $ s ^. accounts of
+                                Nothing -> do
+                                  let fAcc =
+                                        L.listSelectedElement $
+                                        L.listMoveToBeginning $ s ^. accounts
+                                  case fAcc of
+                                    Nothing ->
+                                      throw $
+                                      userError "Failed to select account"
+                                    Just (_j, w1) -> return w1
+                                Just (_k, w) -> return w
+                         bl <- liftIO $ getLastSyncBlock pool $ entityKey selWal
+                         _ <-
+                           liftIO $
+                           forkIO $
+                           shieldTransaction
+                             pool
+                             (s ^. eventDispatch)
+                             (s ^. zebraHost)
+                             (s ^. zebraPort)
+                             (s ^. network)
+                             (entityKey selAcc)
+                             bl
+                         BT.modify $ set msg "Preparing transaction..."
+                         BT.modify $ set displayBox SendDisplay
+                         BT.modify $ set dialogBox Blank
+                       ev ->
+                         BT.zoom deshieldForm $ do
+                           handleFormEvent (BT.VtyEvent ev)
                    -- Process any other event    
                    Blank -> do
                      case e of
@@ -1420,10 +1582,57 @@ appEvent (BT.VtyEvent e) = do
                          BT.modify $ set dialogBox SendTx
                        V.EvKey (V.KChar 'b') [] ->
                          BT.modify $ set dialogBox AdrBook
-                       V.EvKey (V.KChar 'd') [] ->
+                       V.EvKey (V.KChar 'd') [] -> do
+                         pool <- liftIO $ runNoLoggingT $ initPool $ s ^. dbPath
+                         selAcc <-
+                           do case L.listSelectedElement $ s ^. accounts of
+                                Nothing -> do
+                                  let fAcc =
+                                        L.listSelectedElement $
+                                        L.listMoveToBeginning $ s ^. accounts
+                                  case fAcc of
+                                    Nothing ->
+                                      throw $
+                                      userError "Failed to select account"
+                                    Just (_j, w1) -> return w1
+                                Just (_k, w) -> return w
+                         tBal <-
+                           liftIO $
+                           getTransparentBalance pool $ entityKey selAcc
+                         sBal <-
+                           liftIO $ getShieldedBalance pool $ entityKey selAcc
+                         BT.modify $ set tBalance tBal
+                         BT.modify $ set sBalance sBal
+                         BT.modify $
+                           set deshieldForm $
+                           mkDeshieldForm sBal (ShDshEntry 0.0)
                          BT.modify $ set dialogBox DeshieldForm
-                       V.EvKey (V.KChar 'h') [] ->
+                       V.EvKey (V.KChar 'h') [] -> do
-                         BT.modify $ set dialogBox ShieldForm
+                         pool <- liftIO $ runNoLoggingT $ initPool $ s ^. dbPath
+                         selAcc <-
+                           do case L.listSelectedElement $ s ^. accounts of
+                                Nothing -> do
+                                  let fAcc =
+                                        L.listSelectedElement $
+                                        L.listMoveToBeginning $ s ^. accounts
+                                  case fAcc of
+                                    Nothing ->
+                                      throw $
+                                      userError "Failed to select account"
+                                    Just (_j, w1) -> return w1
+                                Just (_k, w) -> return w
+                         tBal <-
+                           liftIO $
+                           getTransparentBalance pool $ entityKey selAcc
+                         BT.modify $ set tBalance tBal
+                         if tBal > 20000
+                           then BT.modify $ set dialogBox ShieldForm
+                           else do
+                             BT.modify $
+                               set
+                                 msg
+                                 "Not enough transparent funds in this account"
+                             BT.modify $ set displayBox MsgDisplay
                        ev ->
                          case r of
                            Just AList ->
@@ -1438,6 +1647,8 @@ appEvent (BT.VtyEvent e) = do
     printMsg s = BT.modify $ updateMsg s
     updateMsg :: String -> State -> State
     updateMsg = set msg
+--                            fs <- BT.gets formState
+--                        ev -> BT.zoom shdshForm $ L.handleListEvent ev
 appEvent _ = return ()
 
 theMap :: A.AttrMap
@@ -1520,6 +1731,14 @@ runZenithTUI config = do
                 if not (null accList)
                   then getUnconfirmedBalance pool $ entityKey $ head accList
                   else return 0
+              tBal <-
+                if not (null accList)
+                  then getTransparentBalance pool $ entityKey $ head accList
+                  else return 0
+              sBal <-
+                if not (null accList)
+                  then getShieldedBalance pool $ entityKey $ head accList
+                  else return 0
               eventChan <- BC.newBChan 10
               _ <-
                 forkIO $
@@ -1533,7 +1752,7 @@ runZenithTUI config = do
                 State
                   (zgb_net chainInfo)
                   (L.list WList (Vec.fromList walList) 1)
-                  (L.list AcList (Vec.fromList accList) 0)
+                  (L.list AcList (Vec.fromList accList) 1)
                   (L.list AList (Vec.fromList addrList) 1)
                   (L.list TList (Vec.fromList txList) 1)
                   ("Start up Ok! Connected to Zebra " ++
@@ -1562,8 +1781,9 @@ runZenithTUI config = do
                   ""
                   Nothing
                   uBal
-                  (mkDeshieldForm 0 (ShDshEntry 0 0 0.0 ))
+                  (mkDeshieldForm 0 (ShDshEntry 0.0))
-                  (mkShieldForm 0 (ShDshEntry 0 0 0.0 ))
+                  tBal
+                  sBal
     Left _e -> do
       print $
         "No Zebra node available on port " <>
@@ -1583,7 +1803,7 @@ refreshWallet s = do
              Just (j, w1) -> return (j, w1)
          Just (k, w) -> return (k, w)
   aL <- runNoLoggingT $ getAccounts pool $ entityKey selWallet
-  let bl = zcashWalletLastSync $ entityVal selWallet
+  let bl = zcashWalletLastSync $ entityVal $ walList !! ix
   addrL <-
     if not (null aL)
       then runNoLoggingT $ getAddresses pool $ entityKey $ head aL
@@ -1777,15 +1997,30 @@ sendTransaction ::
   -> Float
   -> T.Text
   -> T.Text
+  -> PrivacyPolicy
   -> IO ()
-sendTransaction pool chan zHost zPort znet accId bl amt ua memo = do
+sendTransaction pool chan zHost zPort znet accId bl amt ua memo policy = do
   BC.writeBChan chan $ TickMsg "Preparing transaction..."
-  case parseAddressUA ua znet of
+  case parseAddress (E.encodeUtf8 ua) of
     Nothing -> BC.writeBChan chan $ TickMsg "Incorrect address"
     Just outUA -> do
       res <-
-        runFileLoggingT "zenith.log" $
+        runNoLoggingT $
-        prepareTx pool zHost zPort znet accId bl amt outUA memo
+        prepareTxV2
+          pool
+          zHost
+          zPort
+          znet
+          accId
+          bl
+          [ ProposedNote
+              (ValidAddressAPI outUA)
+              amt
+              (if memo == ""
+                 then Nothing
+                 else Just memo)
+          ]
+          policy
       BC.writeBChan chan $ TickMsg "Transaction ready, sending to Zebra..."
       case res of
         Left e -> BC.writeBChan chan $ TickMsg $ show e
@@ -1799,3 +2034,56 @@ sendTransaction pool chan zHost zPort znet accId bl amt ua memo = do
           case resp of
             Left e1 -> BC.writeBChan chan $ TickMsg $ "Zebra error: " ++ show e1
             Right txId -> BC.writeBChan chan $ TickTx txId
+
+shieldTransaction ::
+     ConnectionPool
+  -> BC.BChan Tick
+  -> T.Text
+  -> Int
+  -> ZcashNet
+  -> ZcashAccountId
+  -> Int
+  -> IO ()
+shieldTransaction pool chan zHost zPort znet accId bl = do
+  BC.writeBChan chan $ TickMsg "Preparing shielding transaction..."
+  res <- runNoLoggingT $ shieldTransparentNotes pool zHost zPort znet accId bl
+  forM_ res $ \case
+    Left e -> BC.writeBChan chan $ TickMsg $ show e
+    Right rawTx -> do
+      BC.writeBChan chan $ TickMsg "Transaction ready, sending to Zebra..."
+      resp <-
+        makeZebraCall
+          zHost
+          zPort
+          "sendrawtransaction"
+          [Data.Aeson.String $ toText rawTx]
+      case resp of
+        Left e1 -> BC.writeBChan chan $ TickMsg $ "Zebra error: " ++ show e1
+        Right txId -> BC.writeBChan chan $ TickTx txId
+
+deshieldTransaction ::
+     ConnectionPool
+  -> BC.BChan Tick
+  -> T.Text
+  -> Int
+  -> ZcashNet
+  -> ZcashAccountId
+  -> Int
+  -> ProposedNote
+  -> IO ()
+deshieldTransaction pool chan zHost zPort znet accId bl pnote = do
+  BC.writeBChan chan $ TickMsg "Deshielding funds..."
+  res <- runNoLoggingT $ deshieldNotes pool zHost zPort znet accId bl pnote
+  case res of
+    Left e -> BC.writeBChan chan $ TickMsg $ show e
+    Right rawTx -> do
+      BC.writeBChan chan $ TickMsg "Transaction ready, sending to Zebra..."
+      resp <-
+        makeZebraCall
+          zHost
+          zPort
+          "sendrawtransaction"
+          [Data.Aeson.String $ toText rawTx]
+      case resp of
+        Left e1 -> BC.writeBChan chan $ TickMsg $ "Zebra error: " ++ show e1
+        Right txId -> BC.writeBChan chan $ TickTx txId

src/Zenith/Core.hs

@@ -26,7 +26,7 @@ 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.Maybe (fromJust, fromMaybe)
 import Data.Pool (Pool)
 import qualified Data.Text as T
 import qualified Data.Text.Encoding as E
@@ -34,7 +34,11 @@ import Data.Time
 import qualified Database.Esqueleto.Experimental as ESQ
 import Database.Persist
 import Database.Persist.Sqlite
-import GHC.Float.RealFracMethods (floorFloatInteger)
+import GHC.Float.RealFracMethods
+  ( ceilingFloatInteger
+  , floorFloatInt
+  , floorFloatInteger
+  )
 import Haskoin.Crypto.Keys (XPrvKey(..))
 import Lens.Micro ((&), (.~), (^.), set)
 import Network.HTTP.Client
@@ -75,11 +79,13 @@ import Zenith.Types
   , OrchardSpendingKeyDB(..)
   , PhraseDB(..)
   , PrivacyPolicy(..)
+  , ProposedNote(..)
   , RseedDB(..)
   , SaplingSpendingKeyDB(..)
   , ScopeDB(..)
   , TransparentSpendingKeyDB(..)
   , UnifiedAddressDB(..)
+  , ValidAddressAPI(..)
   , ZcashNetDB(..)
   , ZebraTreeInfo(..)
   )
@@ -541,7 +547,7 @@ prepareTx pool zebraHost zebraPort zn za bh amt ua memo = do
       return $ Left ZHError
     Just acc -> do
       logDebugN $ T.pack $ show acc
-      let zats = fromIntegral $ floorFloatInteger $ amt * (10 ^ 8)
+      let zats = floorFloatInteger $ amt * (10 ^ 8)
       logDebugN $ T.pack $ show zats
       {-firstPass <- liftIO $ selectUnspentNotes pool za zats-}
       --let fee = calculateTxFee firstPass $ fst recipient
@@ -721,6 +727,123 @@ prepareTx pool zebraHost zebraPort zn za bh amt ua memo = do
              getHex $ walletOrchNoteWitness $ entityVal $ head notes
         else Nothing
 
+deshieldNotes ::
+     ConnectionPool
+  -> T.Text
+  -> Int
+  -> ZcashNet
+  -> ZcashAccountId
+  -> Int
+  -> ProposedNote
+  -> NoLoggingT IO (Either TxError HexString)
+deshieldNotes pool zebraHost zebraPort znet za bh pnote = do
+  bal <- liftIO $ getShieldedBalance pool za
+  let zats = ceilingFloatInteger $ pn_amt pnote * (10 ^ 8)
+  if bal > (20000 + zats)
+    then prepareTxV2 pool zebraHost zebraPort znet za bh [pnote] Low
+    else return $ Left InsufficientFunds
+
+shieldTransparentNotes ::
+     ConnectionPool
+  -> T.Text
+  -> Int
+  -> ZcashNet
+  -> ZcashAccountId
+  -> Int
+  -> NoLoggingT IO [Either TxError HexString]
+shieldTransparentNotes pool zebraHost zebraPort znet za bh = do
+  accRead <- liftIO $ getAccountById pool za
+  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
+      trNotes' <- liftIO $ getWalletUnspentTrNotes pool za
+      dRecvs <- liftIO $ getReceivers pool trNotes'
+      let fNotes =
+            map
+              (\x ->
+                 filter (\y -> walletTrNoteAddress (entityVal y) == x) trNotes')
+              dRecvs
+      forM fNotes $ \trNotes -> do
+        let noteTotal = getTotalAmount (trNotes, [], [])
+        let fee = calculateTxFee (trNotes, [], []) 4
+        tSpends <-
+          liftIO $
+          prepTSpends
+            (getTranSK $ zcashAccountTPrivateKey $ entityVal acc)
+            trNotes
+        chgAddr <- getInternalAddresses pool $ entityKey acc
+        let internalUA =
+              getUA $ walletAddressUAddress $ entityVal $ head chgAddr
+        let oRcvr =
+              fromJust $
+              o_rec =<< isValidUnifiedAddress (E.encodeUtf8 internalUA)
+        let snote =
+              OutgoingNote
+                4
+                (getBytes $ getOrchSK $ zcashAccountOrchSpendKey $ entityVal acc)
+                (getBytes oRcvr)
+                (fromIntegral $ noteTotal - fee)
+                ""
+                True
+        let tx =
+              createTransaction
+                (Just sT)
+                (Just oT)
+                tSpends
+                []
+                []
+                [snote]
+                znet
+                (bh + 3)
+                True
+        logDebugN $ T.pack $ show tx
+        return tx
+  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 ::
+         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))
+
 -- | Prepare a transaction for sending
 prepareTxV2 ::
      ConnectionPool
@@ -729,38 +852,13 @@ prepareTxV2 ::
   -> ZcashNet
   -> ZcashAccountId
   -> Int
-  -> Float
+  -> [ProposedNote]
-  -> ValidAddress
-  -> T.Text
   -> PrivacyPolicy
-  -> LoggingT IO (Either TxError HexString)
+  -> NoLoggingT IO (Either TxError HexString)
-prepareTxV2 pool zebraHost zebraPort zn za bh amt va memo policy = do
+prepareTxV2 pool zebraHost zebraPort zn za bh pnotes policy = do
   accRead <- liftIO $ getAccountById pool za
-  let recipient =
+  let recipients = map extractReceiver pnotes
-        case va of
+  logDebugN $ T.pack $ show recipients
-          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
@@ -771,14 +869,21 @@ prepareTxV2 pool zebraHost zebraPort zn za bh amt va memo policy = do
       return $ Left ZHError
     Just acc -> do
       logDebugN $ T.pack $ show acc
-      let zats = fromIntegral $ floorFloatInteger $ amt * (10 ^ 8)
+      let amt = foldl' (\x y -> x + pn_amt y) 0 pnotes
-      logDebugN $ T.pack $ show zats
+      let zats = ceilingFloatInteger $ amt * (10 ^ 8)
+      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 + 10000) (fst recipient) policy
+        selectUnspentNotesV2
+          pool
+          za
+          (zats + 10000)
+          (map (\(x, _, _, _) -> x) recipients)
+          policy
       case notePlan of
         Right (tList, sList, oList) -> do
           logDebugN "selected notes"
@@ -786,6 +891,7 @@ prepareTxV2 pool zebraHost zebraPort zn za bh amt va memo policy = do
           logDebugN $ T.pack $ show sList
           logDebugN $ T.pack $ show oList
           let noteTotal = getTotalAmount (tList, sList, oList)
+          logDebugN $ "noteTotal: " <> T.pack (show noteTotal)
           tSpends <-
             liftIO $
             prepTSpends
@@ -806,7 +912,7 @@ prepareTxV2 pool zebraHost zebraPort zn za bh amt va memo policy = do
             --print oSpends
           dummy' <-
             liftIO $
-            makeOutgoing acc recipient zats (noteTotal - 5000 - zats) policy
+            makeOutgoing acc recipients (noteTotal - 5000 - zats) policy
           case dummy' of
             Left e -> return $ Left e
             Right dummy -> do
@@ -834,7 +940,7 @@ prepareTxV2 pool zebraHost zebraPort zn za bh amt va memo policy = do
                       pool
                       za
                       (zats + feeAmt)
-                      (fst recipient)
+                      (map (\(x, _, _, _) -> x) recipients)
                       policy
                   case finalNotePlan of
                     Right (tList1, sList1, oList1) -> do
@@ -863,8 +969,7 @@ prepareTxV2 pool zebraHost zebraPort zn za bh amt va memo policy = do
                         liftIO $
                         makeOutgoing
                           acc
-                          recipient
+                          recipients
-                          zats
                           (noteTotal1 - feeAmt - zats)
                           policy
                       logDebugN $ T.pack $ show outgoing'
@@ -889,30 +994,136 @@ prepareTxV2 pool zebraHost zebraPort zn za bh amt va memo policy = do
           logErrorN $ T.pack $ show e
           return $ Left e
   where
+    extractReceiver :: ProposedNote -> (Int, BS.ByteString, Int, T.Text)
+    extractReceiver (ProposedNote (ValidAddressAPI va) amt m) =
+      let zats = fromIntegral $ floorFloatInteger $ amt * (10 ^ 8)
+       in 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, Int, T.Text) -> OutgoingNote
+    prepareOutgoingNote zac (k, r, a, m) =
+      OutgoingNote
+        (if k == 5
+           then 1
+           else if k == 6
+                  then 2
+                  else fromIntegral k)
+        (case k of
+           4 -> getBytes $ getOrchSK $ zcashAccountOrchSpendKey zac
+           3 -> getBytes $ getSapSK $ zcashAccountSapSpendKey zac
+           _anyOther -> BS.empty)
+        r
+        (fromIntegral a)
+        (E.encodeUtf8 m)
+        False
     makeOutgoing ::
          Entity ZcashAccount
-      -> (Int, BS.ByteString)
+      -> [(Int, BS.ByteString, Int, T.Text)]
-      -> Integer
       -> Integer
       -> PrivacyPolicy
       -> IO (Either TxError [OutgoingNote])
-    makeOutgoing acc (k, recvr) zats chg policy = do
+    makeOutgoing acc recvs chg pol = do
+      let k = map (\(x, _, _, _) -> x) recvs
+      let j = map (\(_, _, x, _) -> x) recvs
       chgAddr <- runNoLoggingT $ getInternalAddresses pool $ entityKey acc
       let internalUA = getUA $ walletAddressUAddress $ entityVal $ head chgAddr
-      case k of
+      case pol of
-        4 ->
+        Full ->
-          case policy of
+          if elem 1 k || elem 2 k || elem 5 k || elem 6 k
-            None ->
+            then return $
-              return $
+                 Left $
-              Left $
+                 PrivacyPolicyError
-              PrivacyPolicyError "Receiver not compatible with privacy policy"
+                   "Receiver not compatible with privacy policy"
-            _anyOther -> do
+            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
+                          then do
+                            let chgRcvr =
+                                  fromJust $
+                                  s_rec =<<
+                                  isValidUnifiedAddress
+                                    (E.encodeUtf8 internalUA)
+                            let cnote =
+                                  OutgoingNote
+                                    3
+                                    (getBytes $
+                                     getSapSK $
+                                     zcashAccountSapSpendKey $ entityVal acc)
+                                    (getBytes chgRcvr)
+                                    (fromIntegral chg)
+                                    ""
+                                    True
+                            let onotes =
+                                  map
+                                    (prepareOutgoingNote (entityVal acc))
+                                    recvs
+                            return $ Right $ cnote : onotes
+                          else if 4 `elem` k
+                                 then do
+                                   let chgRcvr =
+                                         fromJust $
+                                         o_rec =<<
+                                         isValidUnifiedAddress
+                                           (E.encodeUtf8 internalUA)
+                                   let cnote =
+                                         OutgoingNote
+                                           4
+                                           (getBytes $
+                                            getOrchSK $
+                                            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)
-              return $
+              let cnote =
-                Right
+                    OutgoingNote
-                  [ OutgoingNote
                       4
                       (getBytes $
                        getOrchSK $ zcashAccountOrchSpendKey $ entityVal acc)
@@ -920,51 +1131,20 @@ prepareTxV2 pool zebraHost zebraPort zn za bh amt va memo policy = do
                       (fromIntegral chg)
                       ""
                       True
-                  , OutgoingNote
+              let onotes = map (prepareOutgoingNote (entityVal acc)) recvs
-                      4
+              return $ Right $ cnote : onotes
-                      (getBytes $
+        Low ->
-                       getOrchSK $ zcashAccountOrchSpendKey $ entityVal acc)
+          if elem 5 k || elem 6 k
-                      recvr
+            then return $
-                      (fromIntegral zats)
+                 Left $
-                      (E.encodeUtf8 memo)
+                 PrivacyPolicyError
-                      False
+                   "Receiver not compatible with privacy policy"
-                  ]
+            else do
-        3 ->
-          case policy of
-            None ->
-              return $
-              Left $
-              PrivacyPolicyError "Receiver not compatible with privacy policy"
-            Full -> do
-              let chgRcvr =
-                    fromJust $
-                    s_rec =<< isValidUnifiedAddress (E.encodeUtf8 internalUA)
-              return $
-                Right
-                  [ OutgoingNote
-                      3
-                      (getBytes $
-                       getSapSK $ zcashAccountSapSpendKey $ entityVal acc)
-                      (getBytes chgRcvr)
-                      (fromIntegral chg)
-                      ""
-                      True
-                  , OutgoingNote
-                      3
-                      (getBytes $
-                       getSapSK $ zcashAccountSapSpendKey $ entityVal acc)
-                      recvr
-                      (fromIntegral zats)
-                      (E.encodeUtf8 memo)
-                      False
-                  ]
-            _anyOther -> do
               let chgRcvr =
                     fromJust $
                     o_rec =<< isValidUnifiedAddress (E.encodeUtf8 internalUA)
-              return $
+              let cnote =
-                Right
+                    OutgoingNote
-                  [ OutgoingNote
                       4
                       (getBytes $
                        getOrchSK $ zcashAccountOrchSpendKey $ entityVal acc)
@@ -972,58 +1152,28 @@ prepareTxV2 pool zebraHost zebraPort zn za bh amt va memo policy = do
                       (fromIntegral chg)
                       ""
                       True
-                  , OutgoingNote
+              let onotes = map (prepareOutgoingNote (entityVal acc)) recvs
-                      3
+              return $ Right $ cnote : onotes
-                      (getBytes $
+        None ->
-                       getSapSK $ zcashAccountSapSpendKey $ entityVal acc)
+          if elem 3 k || elem 4 k
-                      recvr
+            then return $
-                      (fromIntegral zats)
+                 Left $
-                      (E.encodeUtf8 memo)
+                 PrivacyPolicyError
-                      False
+                   "Receiver not compatible with privacy policy"
-                  ]
+            else do
-        2 ->
-          if policy <= Low
-            then do
               let chgRcvr =
                     fromJust $
                     t_rec =<< isValidUnifiedAddress (E.encodeUtf8 internalUA)
-              return $
+              let cnote =
-                Right
+                    OutgoingNote
-                  [ OutgoingNote
                       1
                       BS.empty
                       (toBytes $ tr_bytes chgRcvr)
                       (fromIntegral chg)
                       ""
                       True
-                  , OutgoingNote 2 BS.empty recvr (fromIntegral zats) "" False
+              let onotes = map (prepareOutgoingNote (entityVal acc)) recvs
-                  ]
+              return $ Right $ cnote : onotes
-            else return $
-                 Left $
-                 PrivacyPolicyError
-                   "Receiver not compatible with privacy policy"
-        1 ->
-          if policy <= Low
-            then do
-              let chgRcvr =
-                    fromJust $
-                    t_rec =<< isValidUnifiedAddress (E.encodeUtf8 internalUA)
-              return $
-                Right
-                  [ OutgoingNote
-                      1
-                      BS.empty
-                      (toBytes $ tr_bytes chgRcvr)
-                      (fromIntegral chg)
-                      ""
-                      True
-                  , OutgoingNote 1 BS.empty recvr (fromIntegral zats) "" False
-                  ]
-            else return $
-                 Left $
-                 PrivacyPolicyError
-                   "Receiver not compatible with privacy policy"
-        _anyOther -> return $ Left ZHError
     getTotalAmount ::
          ( [Entity WalletTrNote]
          , [Entity WalletSapNote]
@@ -1111,7 +1261,7 @@ prepareTxV2 pool zebraHost zebraPort zn za bh amt va memo policy = do
 syncWallet ::
      Config -- ^ configuration parameters
   -> Entity ZcashWallet
-  -> LoggingT IO ()
+  -> NoLoggingT IO ()
 syncWallet config w = do
   startTime <- liftIO getCurrentTime
   let walletDb = c_dbPath config

src/Zenith/DB.hs

@@ -291,6 +291,13 @@ share
     result T.Text Maybe
     UniqueOp uuid
     deriving Show Eq
+  ChainSync
+    name T.Text
+    start UTCTime
+    end UTCTime Maybe
+    status ZenithStatus
+    UniqueSync name
+    deriving Show Eq
     |]
 
 -- ** Type conversions
@@ -1184,6 +1191,61 @@ getTrNotes pool tr = do
         where_ (tnotes ^. WalletTrNoteScript ==. val s)
         pure tnotes
 
+getTrFilteredNotes ::
+     ConnectionPool
+  -> [HexStringDB]
+  -> TransparentReceiver
+  -> IO [Entity WalletTrNote]
+getTrFilteredNotes pool txs tr = do
+  let s =
+        BS.concat
+          [ BS.pack [0x76, 0xA9, 0x14]
+          , (toBytes . tr_bytes) tr
+          , BS.pack [0x88, 0xAC]
+          ]
+  runNoLoggingT $
+    PS.retryOnBusy $
+    flip PS.runSqlPool pool $ do
+      select $ do
+        (wt :& tnotes) <-
+          from $ table @WalletTransaction `innerJoin` table @WalletTrNote `on`
+          (\(wt :& tnotes) ->
+             wt ^. WalletTransactionId ==. tnotes ^. WalletTrNoteTx)
+        where_ (tnotes ^. WalletTrNoteScript ==. val s)
+        where_ (wt ^. WalletTransactionTxId `in_` valList txs)
+        pure tnotes
+
+traceTrDag :: ConnectionPool -> Entity WalletTrNote -> IO [Entity WalletTrNote]
+traceTrDag pool note = do
+  trSpend <-
+    runNoLoggingT $
+    PS.retryOnBusy $
+    flip PS.runSqlPool pool $ do
+      selectOne $ do
+        trSpends <- from $ table @WalletTrSpend
+        where_ (trSpends ^. WalletTrSpendNote ==. val (entityKey note))
+        pure trSpends
+  case trSpend of
+    Nothing -> return []
+    Just tnote -> do
+      nxtChg <-
+        runNoLoggingT $
+        PS.retryOnBusy $
+        flip PS.runSqlPool pool $ do
+          selectOne $ do
+            nts <- from $ table @WalletTrNote
+            where_
+              (nts ^. WalletTrNoteTx ==. val (walletTrSpendTx $ entityVal tnote) &&.
+               nts ^.
+               WalletTrNoteChange ==.
+               val True)
+            pure nts
+      case nxtChg of
+        Nothing -> return []
+        Just nxt -> do
+          nxtSearch <- traceTrDag pool nxt
+          return $ nxt : nxtSearch
+
 getSapNotes :: ConnectionPool -> SaplingReceiver -> IO [Entity WalletSapNote]
 getSapNotes pool sr = do
   runNoLoggingT $
@@ -1194,6 +1256,57 @@ getSapNotes pool sr = do
         where_ (snotes ^. WalletSapNoteRecipient ==. val (getBytes sr))
         pure snotes
 
+getSapFilteredNotes ::
+     ConnectionPool
+  -> [HexStringDB]
+  -> SaplingReceiver
+  -> IO [Entity WalletSapNote]
+getSapFilteredNotes pool txs sr = do
+  runNoLoggingT $
+    PS.retryOnBusy $
+    flip PS.runSqlPool pool $ do
+      select $ do
+        (wt :& snotes) <-
+          from $ table @WalletTransaction `innerJoin` table @WalletSapNote `on`
+          (\(wt :& snotes) ->
+             wt ^. WalletTransactionId ==. snotes ^. WalletSapNoteTx)
+        where_ (snotes ^. WalletSapNoteRecipient ==. val (getBytes sr))
+        where_ (wt ^. WalletTransactionTxId `in_` valList txs)
+        pure snotes
+
+traceSapDag ::
+     ConnectionPool -> Entity WalletSapNote -> IO [Entity WalletSapNote]
+traceSapDag pool note = do
+  sapSpend <-
+    runNoLoggingT $
+    PS.retryOnBusy $
+    flip PS.runSqlPool pool $ do
+      selectOne $ do
+        sapSpends <- from $ table @WalletSapSpend
+        where_ (sapSpends ^. WalletSapSpendNote ==. val (entityKey note))
+        pure sapSpends
+  case sapSpend of
+    Nothing -> return []
+    Just snote -> do
+      nxtChg <-
+        runNoLoggingT $
+        PS.retryOnBusy $
+        flip PS.runSqlPool pool $ do
+          selectOne $ do
+            nts <- from $ table @WalletSapNote
+            where_
+              (nts ^. WalletSapNoteTx ==.
+               val (walletSapSpendTx $ entityVal snote) &&.
+               nts ^.
+               WalletSapNoteChange ==.
+               val True)
+            pure nts
+      case nxtChg of
+        Nothing -> return []
+        Just nxt -> do
+          nxtSearch <- traceSapDag pool nxt
+          return $ nxt : nxtSearch
+
 getOrchNotes :: ConnectionPool -> OrchardReceiver -> IO [Entity WalletOrchNote]
 getOrchNotes pool o = do
   runNoLoggingT $
@@ -1204,6 +1317,57 @@ getOrchNotes pool o = do
         where_ (onotes ^. WalletOrchNoteRecipient ==. val (getBytes o))
         pure onotes
 
+getOrchFilteredNotes ::
+     ConnectionPool
+  -> [HexStringDB]
+  -> OrchardReceiver
+  -> IO [Entity WalletOrchNote]
+getOrchFilteredNotes pool txs o = do
+  runNoLoggingT $
+    PS.retryOnBusy $
+    flip PS.runSqlPool pool $ do
+      select $ do
+        (wt :& onotes) <-
+          from $ table @WalletTransaction `innerJoin` table @WalletOrchNote `on`
+          (\(wt :& onotes) ->
+             wt ^. WalletTransactionId ==. onotes ^. WalletOrchNoteTx)
+        where_ (onotes ^. WalletOrchNoteRecipient ==. val (getBytes o))
+        where_ (wt ^. WalletTransactionTxId `in_` valList txs)
+        pure onotes
+
+traceOrchDag ::
+     ConnectionPool -> Entity WalletOrchNote -> IO [Entity WalletOrchNote]
+traceOrchDag pool note = do
+  orchSpend <-
+    runNoLoggingT $
+    PS.retryOnBusy $
+    flip PS.runSqlPool pool $ do
+      selectOne $ do
+        orchSpends <- from $ table @WalletOrchSpend
+        where_ (orchSpends ^. WalletOrchSpendNote ==. val (entityKey note))
+        pure orchSpends
+  case orchSpend of
+    Nothing -> return []
+    Just onote -> do
+      nxtChg <-
+        runNoLoggingT $
+        PS.retryOnBusy $
+        flip PS.runSqlPool pool $ do
+          selectOne $ do
+            nts <- from $ table @WalletOrchNote
+            where_
+              (nts ^. WalletOrchNoteTx ==.
+               val (walletOrchSpendTx $ entityVal onote) &&.
+               nts ^.
+               WalletOrchNoteChange ==.
+               val True)
+            pure nts
+      case nxtChg of
+        Nothing -> return []
+        Just nxt -> do
+          nxtSearch <- traceOrchDag pool nxt
+          return $ nxt : nxtSearch
+
 getWalletNotes ::
      ConnectionPool -- ^ database path
   -> Entity WalletAddress
@@ -1248,47 +1412,66 @@ getWalletTransactions pool w = do
     case tReceiver of
       Nothing -> return []
       Just tR -> liftIO $ getTrNotes pool tR
-  trChgNotes <-
+  sapNotes <-
-    case ctReceiver of
+    case sReceiver of
       Nothing -> return []
-      Just tR -> liftIO $ getTrNotes pool tR
+      Just sR -> liftIO $ getSapNotes pool sR
+  orchNotes <-
+    case oReceiver of
+      Nothing -> return []
+      Just oR -> liftIO $ getOrchNotes pool oR
+  clearUserTx (entityKey w)
+  mapM_ addTr trNotes
+  mapM_ addSap sapNotes
+  mapM_ addOrch orchNotes
   trSpends <-
     PS.retryOnBusy $
     flip PS.runSqlPool pool $ do
       select $ do
         trSpends <- from $ table @WalletTrSpend
         where_
-          (trSpends ^. WalletTrSpendNote `in_`
+          (trSpends ^. WalletTrSpendNote `in_` valList (map entityKey trNotes))
-           valList (map entityKey (trNotes <> trChgNotes)))
         pure trSpends
-  sapNotes <-
+  sapSpends <- mapM (getSapSpends . entityKey) sapNotes
-    case sReceiver of
+  orchSpends <- mapM (getOrchSpends . entityKey) orchNotes
-      Nothing -> return []
-      Just sR -> liftIO $ getSapNotes pool sR
-  sapChgNotes <-
-    case csReceiver of
-      Nothing -> return []
-      Just sR -> liftIO $ getSapNotes pool sR
-  sapSpends <- mapM (getSapSpends . entityKey) (sapNotes <> sapChgNotes)
-  orchNotes <-
-    case oReceiver of
-      Nothing -> return []
-      Just oR -> liftIO $ getOrchNotes pool oR
-  orchChgNotes <-
-    case coReceiver of
-      Nothing -> return []
-      Just oR -> liftIO $ getOrchNotes pool oR
-  orchSpends <- mapM (getOrchSpends . entityKey) (orchNotes <> orchChgNotes)
-  clearUserTx (entityKey w)
-  mapM_ addTr trNotes
-  mapM_ addTr trChgNotes
-  mapM_ addSap sapNotes
-  mapM_ addSap sapChgNotes
-  mapM_ addOrch orchNotes
-  mapM_ addOrch orchChgNotes
   mapM_ subTSpend trSpends
   mapM_ subSSpend $ catMaybes sapSpends
   mapM_ subOSpend $ catMaybes orchSpends
+  foundTxs <- getTxs $ entityKey w
+  trChgNotes <-
+    case ctReceiver of
+      Nothing -> return []
+      Just tR -> liftIO $ getTrFilteredNotes pool foundTxs tR
+  trChgNotes' <- liftIO $ mapM (traceTrDag pool) trChgNotes
+  trChgSpends <-
+    PS.retryOnBusy $
+    flip PS.runSqlPool pool $ do
+      select $ do
+        trS <- from $ table @WalletTrSpend
+        where_
+          (trS ^. WalletTrSpendNote `in_`
+           valList (map entityKey (trChgNotes <> concat trChgNotes')))
+        pure trS
+  sapChgNotes <-
+    case csReceiver of
+      Nothing -> return []
+      Just sR -> liftIO $ getSapFilteredNotes pool foundTxs sR
+  sapChgNotes' <- liftIO $ mapM (traceSapDag pool) sapChgNotes
+  sapChgSpends <-
+    mapM (getSapSpends . entityKey) (sapChgNotes <> concat sapChgNotes')
+  orchChgNotes <-
+    case coReceiver of
+      Nothing -> return []
+      Just oR -> liftIO $ getOrchFilteredNotes pool foundTxs oR
+  orchChgNotes' <- liftIO $ mapM (traceOrchDag pool) orchChgNotes
+  orchChgSpends <-
+    mapM (getOrchSpends . entityKey) (orchChgNotes <> concat orchChgNotes')
+  mapM_ addTr (trChgNotes <> concat trChgNotes')
+  mapM_ addSap (sapChgNotes <> concat sapChgNotes')
+  mapM_ addOrch (orchChgNotes <> concat orchChgNotes')
+  mapM_ subTSpend trChgSpends
+  mapM_ subSSpend $ catMaybes sapChgSpends
+  mapM_ subOSpend $ catMaybes orchChgSpends
   where
     clearUserTx :: WalletAddressId -> NoLoggingT IO ()
     clearUserTx waId = do
@@ -1298,6 +1481,16 @@ getWalletTransactions pool w = do
             u <- from $ table @UserTx
             where_ (u ^. UserTxAddress ==. val waId)
             return ()
+    getTxs :: WalletAddressId -> NoLoggingT IO [HexStringDB]
+    getTxs waId = do
+      res <-
+        PS.retryOnBusy $
+        flip PS.runSqlPool pool $ do
+          select $ do
+            t <- from $ table @UserTx
+            where_ (t ^. UserTxAddress ==. val waId)
+            return (t ^. UserTxHex)
+      return $ map (\(Value x) -> x) res
     getSapSpends ::
          WalletSapNoteId -> NoLoggingT IO (Maybe (Entity WalletSapSpend))
     getSapSpends n = do
@@ -1837,6 +2030,51 @@ getUnconfPoolBalance pool za = do
   let oBal = sum oAmts
   return $ AccountBalance tBal sBal oBal
 
+rewindWalletTransactions :: ConnectionPool -> Int -> IO ()
+rewindWalletTransactions pool b = do
+  runNoLoggingT $
+    PS.retryOnBusy $
+    flip PS.runSqlPool pool $ do
+      delete $ do
+        _ <- from $ table @UserTx
+        return ()
+      oldTxs <-
+        select $ do
+          txs <- from $ table @WalletTransaction
+          where_ $ txs ^. WalletTransactionBlock >. val b
+          pure txs
+      let oldKeys = map entityKey oldTxs
+      delete $ do
+        x <- from $ table @WalletOrchSpend
+        where_ $ x ^. WalletOrchSpendTx `in_` valList oldKeys
+        return ()
+      delete $ do
+        x <- from $ table @WalletOrchNote
+        where_ $ x ^. WalletOrchNoteTx `in_` valList oldKeys
+        return ()
+      delete $ do
+        x <- from $ table @WalletSapNote
+        where_ $ x ^. WalletSapNoteTx `in_` valList oldKeys
+        return ()
+      delete $ do
+        x <- from $ table @WalletSapSpend
+        where_ $ x ^. WalletSapSpendTx `in_` valList oldKeys
+        return ()
+      delete $ do
+        x <- from $ table @WalletTrNote
+        where_ $ x ^. WalletTrNoteTx `in_` valList oldKeys
+        return ()
+      delete $ do
+        x <- from $ table @WalletTrSpend
+        where_ $ x ^. WalletTrSpendTx `in_` valList oldKeys
+        return ()
+      delete $ do
+        txs <- from $ table @WalletTransaction
+        where_ $ txs ^. WalletTransactionBlock >. val b
+        return ()
+      update $ \w -> do
+        set w [ZcashWalletLastSync =. val b]
+
 clearWalletTransactions :: ConnectionPool -> IO ()
 clearWalletTransactions pool = do
   runNoLoggingT $
@@ -2080,7 +2318,7 @@ selectUnspentNotesV2 ::
      ConnectionPool
   -> ZcashAccountId
   -> Integer
-  -> Int
+  -> [Int]
   -> PrivacyPolicy
   -> IO
        (Either
@@ -2091,27 +2329,40 @@ selectUnspentNotesV2 ::
 selectUnspentNotesV2 pool za amt recv policy = do
   case policy of
     Full ->
-      case recv of
+      if elem 1 recv || elem 2 recv || elem 5 recv || elem 6 recv
-        4 -> do
+        then return $
-          orchNotes <- getWalletUnspentOrchNotes pool za
+             Left $ PrivacyPolicyError "Receiver not capable of Full privacy"
-          let (a1, oList) = checkOrchard (fromIntegral amt) orchNotes
+        else if elem 4 recv && elem 3 recv
-          if a1 > 0
+               then return $
-            then return $
+                    Left $
-                 Left $ PrivacyPolicyError "Not enough notes for Full privacy"
+                    PrivacyPolicyError
-            else return $ Right ([], [], oList)
+                      "Combination of receivers not allowed for Full privacy"
-        3 -> do
+               else if 4 `elem` recv
-          sapNotes <- getWalletUnspentSapNotes pool za
+                      then do
-          let (a2, sList) = checkSapling (fromIntegral amt) sapNotes
+                        orchNotes <- getWalletUnspentOrchNotes pool za
-          if a2 > 0
+                        let (a1, oList) =
-            then return $
+                              checkOrchard (fromIntegral amt) orchNotes
-                 Left $ PrivacyPolicyError "Not enough notes for Full privacy"
+                        if a1 > 0
-            else return $ Right ([], sList, [])
+                          then return $
-        _anyOther ->
+                               Left $
-          return $
+                               PrivacyPolicyError
-          Left $ PrivacyPolicyError "Receiver not capable of Full privacy"
+                                 "Not enough notes for Full privacy"
+                          else return $ Right ([], [], oList)
+                      else do
+                        sapNotes <- getWalletUnspentSapNotes pool za
+                        let (a2, sList) =
+                              checkSapling (fromIntegral amt) sapNotes
+                        if a2 > 0
+                          then return $
+                               Left $
+                               PrivacyPolicyError
+                                 "Not enough notes for Full privacy"
+                          else return $ Right ([], sList, [])
     Medium ->
-      if recv > 2
+      if elem 1 recv || elem 2 recv || elem 5 recv || elem 6 recv
-        then do
+        then return $
+             Left $ PrivacyPolicyError "Receiver not capable of Medium privacy"
+        else do
           orchNotes <- getWalletUnspentOrchNotes pool za
           let (a1, oList) = checkOrchard (fromIntegral amt) orchNotes
           if a1 > 0
@@ -2124,27 +2375,16 @@ selectUnspentNotesV2 pool za amt recv policy = do
                      PrivacyPolicyError "Not enough notes for Medium privacy"
                 else return $ Right ([], sList, oList)
             else return $ Right ([], [], oList)
-        else return $
-             Left $ PrivacyPolicyError "Receiver not capable of Medium privacy"
     Low ->
-      if recv == 0
+      if 0 `elem` recv
         then return $ Left ZHError
         else do
-          case recv of
+          if elem 5 recv || elem 6 recv
-            3 -> do
+            then return $
-              sapNotes <- getWalletUnspentSapNotes pool za
+                 Left $
-              let (a1, sList) = checkSapling (fromIntegral amt) sapNotes
+                 PrivacyPolicyError
-              if a1 > 0
+                   "Exchange addresses not supported with Low privacy"
-                then do
+            else do
-                  orchNotes <- getWalletUnspentOrchNotes pool za
-                  let (a2, oList) = checkOrchard a1 orchNotes
-                  if a2 > 0
-                    then return $
-                         Left $
-                         PrivacyPolicyError "Not enough notes for Low privacy"
-                    else return $ Right ([], sList, oList)
-                else return $ Right ([], sList, [])
-            _anyOther -> do
               orchNotes <- getWalletUnspentOrchNotes pool za
               let (a1, oList) = checkOrchard (fromIntegral amt) orchNotes
               if a1 > 0
@@ -2152,27 +2392,27 @@ selectUnspentNotesV2 pool za amt recv policy = do
                   sapNotes <- getWalletUnspentSapNotes pool za
                   let (a2, sList) = checkSapling a1 sapNotes
                   if a2 > 0
-                    then return $
+                    then do
-                         Left $
+                      trNotes <- getWalletUnspentTrNotes pool za
-                         PrivacyPolicyError "Not enough notes for Low privacy"
+                      let (a3, tList) = checkTransparent a2 trNotes
+                      if a3 > 0
+                        then return $ Left InsufficientFunds
+                        else return $ Right (tList, sList, oList)
                     else return $ Right ([], sList, oList)
                 else return $ Right ([], [], oList)
     None -> do
-      orchNotes <- getWalletUnspentOrchNotes pool za
+      if elem 3 recv || elem 4 recv
-      let (a1, oList) = checkOrchard (fromIntegral amt) orchNotes
+        then return $
-      if a1 > 0
+             Left $
-        then do
+             PrivacyPolicyError
-          sapNotes <- getWalletUnspentSapNotes pool za
+               "Shielded recipients not compatible with privacy policy."
-          let (a2, sList) = checkSapling a1 sapNotes
+        else do
-          if a2 > 0
+          trNotes <- getWalletUnspentTrNotes pool za
-            then do
+          let (a3, tList) = checkTransparent (fromIntegral amt) trNotes
-              trNotes <- getWalletUnspentTrNotes pool za
+          if a3 > 0
-              let (a3, tList) = checkTransparent a2 trNotes
+            then return $
-              if a3 > 0
+                 Left $ PrivacyPolicyError "Insufficient transparent funds"
-                then return $ Left InsufficientFunds
+            else return $ Right (tList, [], [])
-                else return $ Right (tList, sList, oList)
-            else return $ Right ([], sList, oList)
-        else return $ Right ([], [], oList)
   where
     checkTransparent ::
          Int64 -> [Entity WalletTrNote] -> (Int64, [Entity WalletTrNote])
@@ -2235,6 +2475,19 @@ saveConfs pool b c = do
         set bl [ZcashBlockConf =. val c]
         where_ $ bl ^. ZcashBlockHeight ==. val b
 
+getReceivers :: ConnectionPool -> [Entity WalletTrNote] -> IO [WalletAddressId]
+getReceivers pool ns = do
+  r <-
+    runNoLoggingT $
+    PS.retryOnBusy $
+    flip PS.runSqlPool pool $ do
+      select $
+        distinct $ do
+          t <- from $ table @WalletTrNote
+          where_ (t ^. WalletTrNoteId `in_` valList (map entityKey ns))
+          return (t ^. WalletTrNoteAddress)
+  return $ map (\(Value x) -> x) r
+
 -- | Helper function to extract a Unified Address from the database
 readUnifiedAddressDB :: WalletAddress -> Maybe UnifiedAddress
 readUnifiedAddressDB =
@@ -2327,13 +2580,83 @@ finalizeOperation pool op status result = do
         ]
       where_ (ops ^. OperationId ==. val op)
 
+-- * Chain sync
+-- | Check if the wallet is currently running a sync
+isSyncing :: ConnectionPool -> IO Bool
+isSyncing pool = do
+  s <-
+    runNoLoggingT $
+    PS.retryOnBusy $
+    flip PS.runSqlPool pool $
+    selectOne $ do
+      r <- from $ table @ChainSync
+      where_ $ r ^. ChainSyncStatus ==. val Processing
+      pure r
+  case s of
+    Nothing -> return False
+    Just _ -> return True
+
+-- | Record the start of a sync
+startSync :: ConnectionPool -> IO ()
+startSync pool = do
+  start <- getCurrentTime
+  _ <-
+    runNoLoggingT $
+    PS.retryOnBusy $
+    flip PS.runSqlPool pool $
+    upsert (ChainSync "Internal" start Nothing Processing) []
+  return ()
+
+-- | Complete a sync
+completeSync :: ConnectionPool -> ZenithStatus -> IO ()
+completeSync pool st = do
+  end <- getCurrentTime
+  _ <-
+    runNoLoggingT $
+    PS.retryOnBusy $
+    flip PS.runSqlPool pool $
+    update $ \s -> do
+      set s [ChainSyncEnd =. val (Just end), ChainSyncStatus =. val st]
+      where_ (s ^. ChainSyncName ==. val "Internal")
+  return ()
+
 -- | Rewind the data store to a given block height
 rewindWalletData :: ConnectionPool -> Int -> IO ()
 rewindWalletData pool b = do
+  rewindWalletTransactions pool b
   runNoLoggingT $
     PS.retryOnBusy $
-    flip PS.runSqlPool pool $
+    flip PS.runSqlPool pool $ do
-    delete $ do
+      oldBlocks <-
-      blk <- from $ table @ZcashBlock
+        select $ do
-      where_ $ blk ^. ZcashBlockHeight >=. val b
+          blk <- from $ table @ZcashBlock
-  clearWalletTransactions pool
+          where_ $ blk ^. ZcashBlockHeight >. val b
+          pure blk
+      let oldBlkKeys = map entityKey oldBlocks
+      oldTxs <-
+        select $ do
+          txs <- from $ table @ZcashTransaction
+          where_ $ txs ^. ZcashTransactionBlockId `in_` valList oldBlkKeys
+          pure txs
+      let oldTxKeys = map entityKey oldTxs
+      delete $ do
+        x <- from $ table @TransparentNote
+        where_ $ x ^. TransparentNoteTx `in_` valList oldTxKeys
+      delete $ do
+        x <- from $ table @TransparentSpend
+        where_ $ x ^. TransparentSpendTx `in_` valList oldTxKeys
+      delete $ do
+        x <- from $ table @ShieldOutput
+        where_ $ x ^. ShieldOutputTx `in_` valList oldTxKeys
+      delete $ do
+        x <- from $ table @ShieldSpend
+        where_ $ x ^. ShieldSpendTx `in_` valList oldTxKeys
+      delete $ do
+        x <- from $ table @OrchAction
+        where_ $ x ^. OrchActionTx `in_` valList oldTxKeys
+      delete $ do
+        x <- from $ table @ZcashTransaction
+        where_ $ x ^. ZcashTransactionId `in_` valList oldTxKeys
+      delete $ do
+        blk <- from $ table @ZcashBlock
+        where_ $ blk ^. ZcashBlockHeight >. val b

src/Zenith/GUI.hs

@@ -1391,8 +1391,7 @@ handleEvent wenv node model evt =
                  case currentWallet of
                    Nothing -> return $ ShowError "No wallet available"
                    Just cW -> do
-                     runFileLoggingT "zenith.log" $
+                     runNoLoggingT $ syncWallet (model ^. configuration) cW
-                       syncWallet (model ^. configuration) cW
                      pool <-
                        runNoLoggingT $
                        initPool $ c_dbPath $ model ^. configuration
@@ -1613,7 +1612,6 @@ handleEvent wenv node model evt =
       res <- liftIO $ updateAdrsInAdrBook pool d a a
       return $ ShowMessage "Address Book entry updated!!"
 
---                            model & recipientValid .~ ((model ^. privacyChoice) == Low)  ]
 scanZebra :: T.Text -> T.Text -> Int -> ZcashNet -> (AppEvent -> IO ()) -> IO ()
 scanZebra dbPath zHost zPort net sendMsg = do
   bStatus <- liftIO $ checkBlockChain zHost zPort
@@ -1621,24 +1619,35 @@ scanZebra dbPath zHost zPort net sendMsg = do
   b <- liftIO $ getMinBirthdayHeight pool
   dbBlock <- getMaxBlock pool $ ZcashNetDB net
   chkBlock <- checkIntegrity dbPath zHost zPort dbBlock 1
-  unless (chkBlock == dbBlock) $ rewindWalletData pool chkBlock
+  syncChk <- isSyncing pool
-  let sb =
+  if syncChk
-        if chkBlock == dbBlock
+    then sendMsg (ShowError "Sync already in progress")
-          then max dbBlock b
-          else max chkBlock b
-  if sb > zgb_blocks bStatus || sb < 1
-    then sendMsg (ShowError "Invalid starting block for scan")
     else do
-      let bList = [(sb + 1) .. (zgb_blocks bStatus)]
+      unless (chkBlock == dbBlock) $ rewindWalletData pool chkBlock
-      if not (null bList)
+      let sb =
-        then do
+            if chkBlock == dbBlock
-          let step = (1.0 :: Float) / fromIntegral (length bList)
+              then max dbBlock b
-          mapM_ (processBlock pool step) bList
+              else max chkBlock b
-        else sendMsg (SyncVal 1.0)
+      if sb > zgb_blocks bStatus || sb < 1
-  confUp <- try $ updateConfs zHost zPort pool :: IO (Either IOError ())
+        then sendMsg (ShowError "Invalid starting block for scan")
-  case confUp of
+        else do
-    Left _e0 -> sendMsg (ShowError "Failed to update unconfirmed transactions")
+          let bList = [(sb + 1) .. (zgb_blocks bStatus)]
-    Right _ -> return ()
+          if not (null bList)
+            then do
+              let step = (1.0 :: Float) / fromIntegral (length bList)
+              _ <- startSync pool
+              mapM_ (processBlock pool step) bList
+              confUp <-
+                try $ updateConfs zHost zPort pool :: IO (Either IOError ())
+              case confUp of
+                Left _e0 -> do
+                  _ <- completeSync pool Failed
+                  sendMsg
+                    (ShowError "Failed to update unconfirmed transactions")
+                Right _ -> do
+                  _ <- completeSync pool Successful
+                  return ()
+            else sendMsg (SyncVal 1.0)
   where
     processBlock :: ConnectionPool -> Float -> Int -> IO ()
     processBlock pool step bl = do
@@ -1650,7 +1659,9 @@ scanZebra dbPath zHost zPort net sendMsg = do
           "getblock"
           [Data.Aeson.String $ showt bl, jsonNumber 1]
       case r of
-        Left e1 -> sendMsg (ShowError $ showt e1)
+        Left e1 -> do
+          _ <- completeSync pool Failed
+          sendMsg (ShowError $ showt e1)
         Right blk -> do
           r2 <-
             liftIO $
@@ -1660,7 +1671,9 @@ scanZebra dbPath zHost zPort net sendMsg = do
               "getblock"
               [Data.Aeson.String $ showt bl, jsonNumber 0]
           case r2 of
-            Left e2 -> sendMsg (ShowError $ showt e2)
+            Left e2 -> do
+              _ <- completeSync pool Failed
+              sendMsg (ShowError $ showt e2)
             Right hb -> do
               let blockTime = getBlockTime hb
               bi <-
@@ -1695,8 +1708,22 @@ sendTransaction config znet accId bl amt ua memo policy sendMsg = do
       let zPort = c_zebraPort config
       pool <- runNoLoggingT $ initPool dbPath
       res <-
-        runFileLoggingT "zenith.log" $
+        runNoLoggingT $
-        prepareTxV2 pool zHost zPort znet accId bl amt addr memo policy
+        prepareTxV2
+          pool
+          zHost
+          zPort
+          znet
+          accId
+          bl
+          [ ProposedNote
+              (ValidAddressAPI addr)
+              amt
+              (if memo == ""
+                 then Nothing
+                 else Just memo)
+          ]
+          policy
       case res of
         Left e -> sendMsg $ ShowError $ T.pack $ show e
         Right rawTx -> do

src/Zenith/RPC.hs

@@ -8,21 +8,28 @@
 {-# LANGUAGE TypeFamilies #-}
 {-# LANGUAGE UndecidableInstances #-}
 {-# LANGUAGE LambdaCase #-}
+{-# LANGUAGE DerivingStrategies #-}
 
 module Zenith.RPC where
 
+import Control.Concurrent (forkIO)
 import Control.Exception (try)
+import Control.Monad (unless, when)
 import Control.Monad.IO.Class (liftIO)
-import Control.Monad.Logger (runNoLoggingT)
+import Control.Monad.Logger (runFileLoggingT, runNoLoggingT, runStderrLoggingT)
 import Data.Aeson
+import qualified Data.HexString as H
 import Data.Int
 import Data.Scientific (floatingOrInteger)
 import qualified Data.Text as T
 import qualified Data.Text.Encoding as E
+import Data.Time.Clock (getCurrentTime)
 import qualified Data.UUID as U
+import Data.UUID.V4 (nextRandom)
 import qualified Data.Vector as V
 import Database.Esqueleto.Experimental
-  ( entityKey
+  ( ConnectionPool
+  , entityKey
   , entityVal
   , fromSqlKey
   , toSqlKey
@@ -31,43 +38,72 @@ import Servant
 import Text.Read (readMaybe)
 import ZcashHaskell.Keys (generateWalletSeedPhrase)
 import ZcashHaskell.Orchard (parseAddress)
-import ZcashHaskell.Types (RpcError(..), Scope(..), ZcashNet(..))
+import ZcashHaskell.Types
-import Zenith.Core (createCustomWalletAddress, createZcashAccount)
+  ( BlockResponse(..)
+  , RpcError(..)
+  , Scope(..)
+  , ZcashNet(..)
+  , ZebraGetBlockChainInfo(..)
+  )
+import ZcashHaskell.Utils (getBlockTime, makeZebraCall)
+import Zenith.Core
+  ( checkBlockChain
+  , createCustomWalletAddress
+  , createZcashAccount
+  , prepareTxV2
+  , syncWallet
+  )
 import Zenith.DB
   ( Operation(..)
   , ZcashAccount(..)
+  , ZcashBlock(..)
   , ZcashWallet(..)
+  , completeSync
+  , finalizeOperation
   , findNotesByAddress
   , getAccountById
   , getAccounts
   , getAddressById
   , getAddresses
   , getExternalAddresses
+  , getLastSyncBlock
   , getMaxAccount
   , getMaxAddress
+  , getMaxBlock
+  , getMinBirthdayHeight
   , getOperation
   , getPoolBalance
   , getUnconfPoolBalance
   , getWalletNotes
   , getWallets
   , initPool
+  , isSyncing
+  , rewindWalletData
   , saveAccount
   , saveAddress
+  , saveBlock
+  , saveOperation
   , saveWallet
+  , startSync
   , toZcashAccountAPI
   , toZcashAddressAPI
   , toZcashWalletAPI
   , walletExists
   )
+import Zenith.Scanner (checkIntegrity, processTx, updateConfs)
 import Zenith.Types
   ( AccountBalance(..)
   , Config(..)
+  , HexStringDB(..)
   , PhraseDB(..)
+  , PrivacyPolicy(..)
+  , ProposedNote(..)
   , ZcashAccountAPI(..)
   , ZcashAddressAPI(..)
   , ZcashNetDB(..)
   , ZcashNoteAPI(..)
   , ZcashWalletAPI(..)
+  , ZenithStatus(..)
   , ZenithUuid(..)
   )
 import Zenith.Utils (jsonNumber)
@@ -83,6 +119,7 @@ data ZenithMethod
   | GetNewAccount
   | GetNewAddress
   | GetOperationStatus
+  | SendMany
   | UnknownMethod
   deriving (Eq, Prelude.Show)
 
@@ -97,6 +134,7 @@ instance ToJSON ZenithMethod where
   toJSON GetNewAccount = Data.Aeson.String "getnewaccount"
   toJSON GetNewAddress = Data.Aeson.String "getnewaddress"
   toJSON GetOperationStatus = Data.Aeson.String "getoperationstatus"
+  toJSON SendMany = Data.Aeson.String "sendmany"
   toJSON UnknownMethod = Data.Aeson.Null
 
 instance FromJSON ZenithMethod where
@@ -112,6 +150,7 @@ instance FromJSON ZenithMethod where
       "getnewaccount" -> pure GetNewAccount
       "getnewaddress" -> pure GetNewAddress
       "getoperationstatus" -> pure GetOperationStatus
+      "sendmany" -> pure SendMany
       _ -> pure UnknownMethod
 
 data ZenithParams
@@ -125,6 +164,7 @@ data ZenithParams
   | NameIdParams !T.Text !Int
   | NewAddrParams !Int !T.Text !Bool !Bool
   | OpParams !ZenithUuid
+  | SendParams !Int ![ProposedNote] !PrivacyPolicy
   | TestParams !T.Text
   deriving (Eq, Prelude.Show)
 
@@ -148,6 +188,8 @@ instance ToJSON ZenithParams where
     [Data.Aeson.String "ExcludeTransparent" | t]
   toJSON (OpParams i) =
     Data.Aeson.Array $ V.fromList [Data.Aeson.String $ U.toText $ getUuid i]
+  toJSON (SendParams i ns p) =
+    Data.Aeson.Array $ V.fromList [jsonNumber i, toJSON ns, toJSON p]
 
 data ZenithResponse
   = InfoResponse !T.Text !ZenithInfo
@@ -159,6 +201,7 @@ data ZenithResponse
   | NewItemResponse !T.Text !Int64
   | NewAddrResponse !T.Text !ZcashAddressAPI
   | OpResponse !T.Text !Operation
+  | SendResponse !T.Text !U.UUID
   | ErrorResponse !T.Text !Double !T.Text
   deriving (Eq, Prelude.Show)
 
@@ -179,6 +222,7 @@ instance ToJSON ZenithResponse where
   toJSON (NewItemResponse i ix) = packRpcResponse i ix
   toJSON (NewAddrResponse i a) = packRpcResponse i a
   toJSON (OpResponse i u) = packRpcResponse i u
+  toJSON (SendResponse i o) = packRpcResponse i o
 
 instance FromJSON ZenithResponse where
   parseJSON =
@@ -258,6 +302,10 @@ instance FromJSON ZenithResponse where
                       case floatingOrInteger k of
                         Left _e -> fail "Unknown value"
                         Right k' -> pure $ NewItemResponse i k'
+                    String s -> do
+                      case U.fromText s of
+                        Nothing -> fail "Unknown value"
+                        Just u -> pure $ SendResponse i u
                     _anyOther -> fail "Malformed JSON"
             Just e1 -> pure $ ErrorResponse i (ecode e1) (emessage e1)
 
@@ -416,6 +464,30 @@ instance FromJSON RpcCall where
                     Nothing -> pure $ RpcCall v i GetOperationStatus BadParams
                 else pure $ RpcCall v i GetOperationStatus BadParams
             _anyOther -> pure $ RpcCall v i GetOperationStatus BadParams
+        SendMany -> do
+          p <- obj .: "params"
+          case p of
+            Array a ->
+              if V.length a >= 2
+                then do
+                  acc <- parseJSON $ a V.! 0
+                  x <- parseJSON $ a V.! 1
+                  case x of
+                    String _ -> do
+                      x' <- parseJSON $ a V.! 1
+                      y <- parseJSON $ a V.! 2
+                      if not (null y)
+                        then pure $ RpcCall v i SendMany (SendParams acc y x')
+                        else pure $ RpcCall v i SendMany BadParams
+                    Array _ -> do
+                      x' <- parseJSON $ a V.! 1
+                      if not (null x')
+                        then pure $
+                             RpcCall v i SendMany (SendParams acc x' Full)
+                        else pure $ RpcCall v i SendMany BadParams
+                    _anyOther -> pure $ RpcCall v i SendMany BadParams
+                else pure $ RpcCall v i SendMany BadParams
+            _anyOther -> pure $ RpcCall v i SendMany BadParams
 
 type ZenithRPC
   = "status" :> Get '[ JSON] Value :<|> BasicAuth "zenith-realm" Bool :> ReqBody
@@ -573,27 +645,35 @@ zenithServer state = getinfo :<|> handleRPC
           case parameters req of
             NameParams t -> do
               let dbPath = w_dbPath state
-              sP <- liftIO generateWalletSeedPhrase
               pool <- liftIO $ runNoLoggingT $ initPool dbPath
-              r <-
+              syncChk <- liftIO $ isSyncing pool
-                liftIO $
+              if syncChk
-                saveWallet pool $
+                then return $
-                ZcashWallet
+                     ErrorResponse
-                  t
+                       (callId req)
-                  (ZcashNetDB $ w_network state)
+                       (-32012)
-                  (PhraseDB sP)
+                       "The Zenith server is syncing, please try again later."
-                  (w_startBlock state)
+                else do
-                  0
+                  sP <- liftIO generateWalletSeedPhrase
-              case r of
+                  r <-
-                Nothing ->
+                    liftIO $
-                  return $
+                    saveWallet pool $
-                  ErrorResponse
+                    ZcashWallet
-                    (callId req)
+                      t
-                    (-32007)
+                      (ZcashNetDB $ w_network state)
-                    "Entity with that name already exists."
+                      (PhraseDB sP)
-                Just r' ->
+                      (w_startBlock state)
-                  return $
+                      0
-                  NewItemResponse (callId req) $ fromSqlKey $ entityKey r'
+                  case r of
+                    Nothing ->
+                      return $
+                      ErrorResponse
+                        (callId req)
+                        (-32007)
+                        "Entity with that name already exists."
+                    Just r' ->
+                      return $
+                      NewItemResponse (callId req) $ fromSqlKey $ entityKey r'
             _anyOtherParams ->
               return $ ErrorResponse (callId req) (-32602) "Invalid params"
         GetNewAccount ->
@@ -601,34 +681,45 @@ zenithServer state = getinfo :<|> handleRPC
             NameIdParams t i -> do
               let dbPath = w_dbPath state
               pool <- liftIO $ runNoLoggingT $ initPool dbPath
-              w <- liftIO $ walletExists pool i
+              syncChk <- liftIO $ isSyncing pool
-              case w of
+              if syncChk
-                Just w' -> do
+                then return $
-                  aIdx <- liftIO $ getMaxAccount pool $ entityKey w'
+                     ErrorResponse
-                  nAcc <-
+                       (callId req)
-                    liftIO
+                       (-32012)
-                      (try $ createZcashAccount t (aIdx + 1) w' :: IO
+                       "The Zenith server is syncing, please try again later."
-                         (Either IOError ZcashAccount))
+                else do
-                  case nAcc of
+                  w <- liftIO $ walletExists pool i
-                    Left e ->
+                  case w of
+                    Just w' -> do
+                      aIdx <- liftIO $ getMaxAccount pool $ entityKey w'
+                      nAcc <-
+                        liftIO
+                          (try $ createZcashAccount t (aIdx + 1) w' :: IO
+                             (Either IOError ZcashAccount))
+                      case nAcc of
+                        Left e ->
+                          return $
+                          ErrorResponse (callId req) (-32010) $ T.pack $ show e
+                        Right nAcc' -> do
+                          r <- liftIO $ saveAccount pool nAcc'
+                          case r of
+                            Nothing ->
+                              return $
+                              ErrorResponse
+                                (callId req)
+                                (-32007)
+                                "Entity with that name already exists."
+                            Just x ->
+                              return $
+                              NewItemResponse (callId req) $
+                              fromSqlKey $ entityKey x
+                    Nothing ->
                       return $
-                      ErrorResponse (callId req) (-32010) $ T.pack $ show e
+                      ErrorResponse
-                    Right nAcc' -> do
+                        (callId req)
-                      r <- liftIO $ saveAccount pool nAcc'
+                        (-32008)
-                      case r of
+                        "Wallet does not exist."
-                        Nothing ->
-                          return $
-                          ErrorResponse
-                            (callId req)
-                            (-32007)
-                            "Entity with that name already exists."
-                        Just x ->
-                          return $
-                          NewItemResponse (callId req) $
-                          fromSqlKey $ entityKey x
-                Nothing ->
-                  return $
-                  ErrorResponse (callId req) (-32008) "Wallet does not exist."
             _anyOtherParams ->
               return $ ErrorResponse (callId req) (-32602) "Invalid params"
         GetNewAddress ->
@@ -637,35 +728,49 @@ zenithServer state = getinfo :<|> handleRPC
               let dbPath = w_dbPath state
               let net = w_network state
               pool <- liftIO $ runNoLoggingT $ initPool dbPath
-              acc <- liftIO $ getAccountById pool $ toSqlKey $ fromIntegral i
+              syncChk <- liftIO $ isSyncing pool
-              case acc of
+              if syncChk
-                Just acc' -> do
+                then return $
-                  maxAddr <-
+                     ErrorResponse
-                    liftIO $ getMaxAddress pool (entityKey acc') External
+                       (callId req)
-                  newAddr <-
+                       (-32012)
-                    liftIO $
+                       "The Zenith server is syncing, please try again later."
-                    createCustomWalletAddress
+                else do
-                      n
+                  acc <-
-                      (maxAddr + 1)
+                    liftIO $ getAccountById pool $ toSqlKey $ fromIntegral i
-                      net
+                  case acc of
-                      External
+                    Just acc' -> do
-                      acc'
+                      maxAddr <-
-                      s
+                        liftIO $ getMaxAddress pool (entityKey acc') External
-                      t
+                      newAddr <-
-                  dbAddr <- liftIO $ saveAddress pool newAddr
+                        liftIO $
-                  case dbAddr of
+                        createCustomWalletAddress
-                    Just nAddr -> do
+                          n
-                      return $
+                          (maxAddr + 1)
-                        NewAddrResponse (callId req) (toZcashAddressAPI nAddr)
+                          net
+                          External
+                          acc'
+                          s
+                          t
+                      dbAddr <- liftIO $ saveAddress pool newAddr
+                      case dbAddr of
+                        Just nAddr -> do
+                          return $
+                            NewAddrResponse
+                              (callId req)
+                              (toZcashAddressAPI nAddr)
+                        Nothing ->
+                          return $
+                          ErrorResponse
+                            (callId req)
+                            (-32007)
+                            "Entity with that name already exists."
                     Nothing ->
                       return $
                       ErrorResponse
                         (callId req)
-                        (-32007)
+                        (-32006)
-                        "Entity with that name already exists."
+                        "Account does not exist."
-                Nothing ->
-                  return $
-                  ErrorResponse (callId req) (-32006) "Account does not exist."
             _anyOtherParams ->
               return $ ErrorResponse (callId req) (-32602) "Invalid params"
         GetOperationStatus ->
@@ -682,6 +787,89 @@ zenithServer state = getinfo :<|> handleRPC
                   ErrorResponse (callId req) (-32009) "Operation ID not found"
             _anyOtherParams ->
               return $ ErrorResponse (callId req) (-32602) "Invalid params"
+        SendMany ->
+          case parameters req of
+            SendParams a ns p -> do
+              let dbPath = w_dbPath state
+              let zHost = w_host state
+              let zPort = w_port state
+              let znet = w_network state
+              pool <- liftIO $ runNoLoggingT $ initPool dbPath
+              syncChk <- liftIO $ isSyncing pool
+              if syncChk
+                then return $
+                     ErrorResponse
+                       (callId req)
+                       (-32012)
+                       "The Zenith server is syncing, please try again later."
+                else do
+                  opid <- liftIO nextRandom
+                  startTime <- liftIO getCurrentTime
+                  opkey <-
+                    liftIO $
+                    saveOperation pool $
+                    Operation
+                      (ZenithUuid opid)
+                      startTime
+                      Nothing
+                      Processing
+                      Nothing
+                  case opkey of
+                    Nothing ->
+                      return $
+                      ErrorResponse (callId req) (-32010) "Internal Error"
+                    Just opkey' -> do
+                      acc <-
+                        liftIO $ getAccountById pool $ toSqlKey $ fromIntegral a
+                      case acc of
+                        Just acc' -> do
+                          bl <-
+                            liftIO $
+                            getLastSyncBlock
+                              pool
+                              (zcashAccountWalletId $ entityVal acc')
+                          _ <-
+                            liftIO $
+                            forkIO $ do
+                              res <-
+                                liftIO $
+                                runNoLoggingT $
+                                prepareTxV2
+                                  pool
+                                  zHost
+                                  zPort
+                                  znet
+                                  (entityKey acc')
+                                  bl
+                                  ns
+                                  p
+                              case res of
+                                Left e ->
+                                  finalizeOperation pool opkey' Failed $
+                                  T.pack $ show e
+                                Right rawTx -> do
+                                  zebraRes <-
+                                    makeZebraCall
+                                      zHost
+                                      zPort
+                                      "sendrawtransaction"
+                                      [Data.Aeson.String $ H.toText rawTx]
+                                  case zebraRes of
+                                    Left e1 ->
+                                      finalizeOperation pool opkey' Failed $
+                                      T.pack $ show e1
+                                    Right txId ->
+                                      finalizeOperation pool opkey' Successful $
+                                      "Tx ID: " <> H.toText txId
+                          return $ SendResponse (callId req) opid
+                        Nothing ->
+                          return $
+                          ErrorResponse
+                            (callId req)
+                            (-32006)
+                            "Account does not exist."
+            _anyOtherParams ->
+              return $ ErrorResponse (callId req) (-32602) "Invalid params"
 
 authenticate :: Config -> BasicAuthCheck Bool
 authenticate config = BasicAuthCheck check
@@ -694,3 +882,67 @@ authenticate config = BasicAuthCheck check
 packRpcResponse :: ToJSON a => T.Text -> a -> Value
 packRpcResponse i x =
   object ["jsonrpc" .= ("2.0" :: String), "id" .= i, "result" .= x]
+
+scanZebra :: T.Text -> T.Text -> Int -> ZcashNet -> IO ()
+scanZebra dbPath zHost zPort net = do
+  bStatus <- checkBlockChain zHost zPort
+  pool <- runNoLoggingT $ initPool dbPath
+  b <- getMinBirthdayHeight pool
+  dbBlock <- getMaxBlock pool $ ZcashNetDB net
+  chkBlock <- checkIntegrity dbPath zHost zPort dbBlock 1
+  syncChk <- isSyncing pool
+  unless syncChk $ do
+    unless (chkBlock == dbBlock) $ rewindWalletData pool chkBlock
+    let sb =
+          if chkBlock == dbBlock
+            then max dbBlock b
+            else max chkBlock b
+    unless (sb > zgb_blocks bStatus || sb < 1) $ do
+      let bList = [(sb + 1) .. (zgb_blocks bStatus)]
+      unless (null bList) $ do
+        _ <- startSync pool
+        mapM_ (processBlock pool) bList
+        confUp <- try $ updateConfs zHost zPort pool :: IO (Either IOError ())
+        case confUp of
+          Left _e0 -> do
+            _ <- completeSync pool Failed
+            return ()
+          Right _ -> do
+            wals <- getWallets pool net
+            runNoLoggingT $
+              mapM_
+                (syncWallet (Config dbPath zHost zPort "user" "pwd" 8080))
+                wals
+            _ <- completeSync pool Successful
+            return ()
+  where
+    processBlock :: ConnectionPool -> Int -> IO ()
+    processBlock pool bl = do
+      r <-
+        makeZebraCall
+          zHost
+          zPort
+          "getblock"
+          [Data.Aeson.String $ T.pack (show bl), jsonNumber 1]
+      case r of
+        Left _ -> completeSync pool Failed
+        Right blk -> do
+          r2 <-
+            makeZebraCall
+              zHost
+              zPort
+              "getblock"
+              [Data.Aeson.String $ T.pack (show bl), jsonNumber 0]
+          case r2 of
+            Left _ -> completeSync pool Failed
+            Right hb -> do
+              let blockTime = getBlockTime hb
+              bi <-
+                saveBlock pool $
+                ZcashBlock
+                  (fromIntegral $ bl_height blk)
+                  (HexStringDB $ bl_hash blk)
+                  (fromIntegral $ bl_confirmations blk)
+                  blockTime
+                  (ZcashNetDB net)
+              mapM_ (processTx zHost zPort bi pool) $ bl_txs blk

src/Zenith/Scanner.hs

@@ -37,6 +37,7 @@ import Zenith.DB
   , ZcashBlockId
   , clearWalletData
   , clearWalletTransactions
+  , completeSync
   , getBlock
   , getMaxBlock
   , getMinBirthdayHeight
@@ -47,10 +48,16 @@ import Zenith.DB
   , saveBlock
   , saveConfs
   , saveTransaction
+  , startSync
   , updateWalletSync
   , upgradeQrTable
   )
-import Zenith.Types (Config(..), HexStringDB(..), ZcashNetDB(..))
+import Zenith.Types
+  ( Config(..)
+  , HexStringDB(..)
+  , ZcashNetDB(..)
+  , ZenithStatus(..)
+  )
 import Zenith.Utils (jsonNumber)
 
 -- | Function to scan the Zcash blockchain through the Zebra node and populate the Zenith database
@@ -74,6 +81,7 @@ rescanZebra host port dbFilePath = do
       upgradeQrTable pool1
       clearWalletTransactions pool1
       clearWalletData pool1
+      _ <- startSync pool1
       dbBlock <- getMaxBlock pool1 znet
       b <- liftIO $ getMinBirthdayHeight pool1
       let sb = max dbBlock b
@@ -99,6 +107,7 @@ rescanZebra host port dbFilePath = do
                 {-mapM_ (processBlock host port pool2 pg2 znet) bl2 `concurrently_`-}
                 {-mapM_ (processBlock host port pool3 pg3 znet) bl3-}
               print "Please wait..."
+          _ <- completeSync pool1 Successful
           print "Rescan complete"
 
 -- | Function to process a raw block and extract the transaction information
@@ -119,7 +128,9 @@ processBlock host port pool pg net b = do
       "getblock"
       [Data.Aeson.String $ T.pack $ show b, jsonNumber 1]
   case r of
-    Left e -> liftIO $ throwIO $ userError e
+    Left e -> do
+      _ <- completeSync pool Failed
+      liftIO $ throwIO $ userError e
     Right blk -> do
       r2 <-
         liftIO $
@@ -129,7 +140,9 @@ processBlock host port pool pg net b = do
           "getblock"
           [Data.Aeson.String $ T.pack $ show b, jsonNumber 0]
       case r2 of
-        Left e2 -> liftIO $ throwIO $ userError e2
+        Left e2 -> do
+          _ <- completeSync pool Failed
+          liftIO $ throwIO $ userError e2
         Right hb -> do
           let blockTime = getBlockTime hb
           bi <-
@@ -160,7 +173,9 @@ processTx host port bt pool t = do
       "getrawtransaction"
       [Data.Aeson.String $ toText t, jsonNumber 1]
   case r of
-    Left e -> liftIO $ throwIO $ userError e
+    Left e -> do
+      _ <- completeSync pool Failed
+      liftIO $ throwIO $ userError e
     Right rawTx -> do
       case readZebraTransaction (ztr_hex rawTx) of
         Nothing -> return ()
@@ -223,7 +238,7 @@ clearSync config = do
           w <- getWallets pool $ zgb_net chainInfo
           liftIO $ mapM_ (updateWalletSync pool 0 . entityKey) w
           w' <- liftIO $ getWallets pool $ zgb_net chainInfo
-          r <- runFileLoggingT "zenith.log" $ mapM (syncWallet config) w'
+          r <- runNoLoggingT $ mapM (syncWallet config) w'
           liftIO $ print r
 
 -- | Detect chain re-orgs

src/Zenith/Types.hs

@@ -23,13 +23,23 @@ import Data.Text.Encoding.Error (lenientDecode)
 import qualified Data.UUID as U
 import Database.Persist.TH
 import GHC.Generics
+import ZcashHaskell.Orchard (encodeUnifiedAddress, parseAddress)
+import ZcashHaskell.Sapling (encodeSaplingAddress)
+import ZcashHaskell.Transparent
+  ( encodeExchangeAddress
+  , encodeTransparentReceiver
+  )
 import ZcashHaskell.Types
-  ( OrchardSpendingKey(..)
+  ( ExchangeAddress(..)
+  , OrchardSpendingKey(..)
   , Phrase(..)
   , Rseed(..)
+  , SaplingAddress(..)
   , SaplingSpendingKey(..)
   , Scope(..)
+  , TransparentAddress(..)
   , TransparentSpendingKey
+  , ValidAddress(..)
   , ZcashNet(..)
   )
 
@@ -207,6 +217,51 @@ data PrivacyPolicy
 
 $(deriveJSON defaultOptions ''PrivacyPolicy)
 
+newtype ValidAddressAPI = ValidAddressAPI
+  { getVA :: ValidAddress
+  } deriving newtype (Eq, Show)
+
+instance ToJSON ValidAddressAPI where
+  toJSON (ValidAddressAPI va) =
+    case va of
+      Unified ua -> Data.Aeson.String $ encodeUnifiedAddress ua
+      Sapling sa ->
+        maybe
+          Data.Aeson.Null
+          Data.Aeson.String
+          (encodeSaplingAddress (net_type sa) (sa_receiver sa))
+      Transparent ta ->
+        Data.Aeson.String $
+        encodeTransparentReceiver (ta_network ta) (ta_receiver ta)
+      Exchange ea ->
+        maybe
+          Data.Aeson.Null
+          Data.Aeson.String
+          (encodeExchangeAddress (ex_network ea) (ex_address ea))
+
+data ProposedNote = ProposedNote
+  { pn_addr :: !ValidAddressAPI
+  , pn_amt :: !Float
+  , pn_memo :: !(Maybe T.Text)
+  } deriving (Eq, Prelude.Show)
+
+instance FromJSON ProposedNote where
+  parseJSON =
+    withObject "ProposedNote" $ \obj -> do
+      a <- obj .: "address"
+      n <- obj .: "amount"
+      m <- obj .:? "memo"
+      case parseAddress (E.encodeUtf8 a) of
+        Nothing -> fail "Invalid address"
+        Just a' ->
+          if n > 0 && n < 21000000
+            then pure $ ProposedNote (ValidAddressAPI a') n m
+            else fail "Invalid amount"
+
+instance ToJSON ProposedNote where
+  toJSON (ProposedNote a n m) =
+    object ["address" .= a, "amount" .= n, "memo" .= m]
+
 data ShieldDeshieldOp
   = Shield
   | Deshield

test/ServerSpec.hs

@@ -7,7 +7,7 @@ import Control.Monad.Logger (runNoLoggingT)
 import Data.Aeson
 import qualified Data.ByteString as BS
 import Data.Configurator
-import Data.Maybe (fromMaybe)
+import Data.Maybe (fromJust, fromMaybe)
 import qualified Data.Text as T
 import qualified Data.Text.Encoding as E
 import Data.Time.Clock (getCurrentTime)
@@ -18,7 +18,7 @@ import Servant
 import System.Directory
 import Test.HUnit hiding (State)
 import Test.Hspec
-import ZcashHaskell.Orchard (isValidUnifiedAddress)
+import ZcashHaskell.Orchard (isValidUnifiedAddress, parseAddress)
 import ZcashHaskell.Types
   ( ZcashNet(..)
   , ZebraGetBlockChainInfo(..)
@@ -39,6 +39,9 @@ import Zenith.RPC
   )
 import Zenith.Types
   ( Config(..)
+  , PrivacyPolicy(..)
+  , ProposedNote(..)
+  , ValidAddressAPI(..)
   , ZcashAccountAPI(..)
   , ZcashAddressAPI(..)
   , ZcashWalletAPI(..)
@@ -572,6 +575,107 @@ main = do
                   Left e -> assertFailure e
                   Right (ErrorResponse i c m) -> c `shouldBe` (-32009)
                   Right _ -> assertFailure "unexpected response"
+        describe "Send tx" $ do
+          describe "sendmany" $ do
+            it "bad credentials" $ do
+              res <-
+                makeZenithCall
+                  "127.0.0.1"
+                  nodePort
+                  "baduser"
+                  "idontknow"
+                  SendMany
+                  BlankParams
+              res `shouldBe` Left "Invalid credentials"
+            describe "correct credentials" $ do
+              it "invalid account" $ do
+                let uaRead =
+                      parseAddress
+                        "utest1dl54utt6prjj5e0dnlknwumnxq9hycdjpkfr0sy6e6h522remqee8axe9zax0wsjrwpj76v555pdhvj9rnargpfyycs0vpkapq98xcdhem99gc4wchzn0ggepq3y6nz3a9sscwgqxgsh9vzhcad402y3x9szfregck5gslkya3c79d86xx0l33tpk8gnn7ew9vw37w43zh22u8dgdax"
+                res <-
+                  makeZenithCall
+                    "127.0.0.1"
+                    nodePort
+                    nodeUser
+                    nodePwd
+                    SendMany
+                    (SendParams
+                       17
+                       [ ProposedNote
+                           (ValidAddressAPI $ fromJust uaRead)
+                           0.005
+                           (Just "A cool memo")
+                       ]
+                       Full)
+                case res of
+                  Left e -> assertFailure e
+                  Right (ErrorResponse i c m) -> c `shouldBe` (-32006)
+              it "valid account, empty notes" $ do
+                let uaRead =
+                      parseAddress
+                        "utest1dl54utt6prjj5e0dnlknwumnxq9hycdjpkfr0sy6e6h522remqee8axe9zax0wsjrwpj76v555pdhvj9rnargpfyycs0vpkapq98xcdhem99gc4wchzn0ggepq3y6nz3a9sscwgqxgsh9vzhcad402y3x9szfregck5gslkya3c79d86xx0l33tpk8gnn7ew9vw37w43zh22u8dgdax"
+                res <-
+                  makeZenithCall
+                    "127.0.0.1"
+                    nodePort
+                    nodeUser
+                    nodePwd
+                    SendMany
+                    (SendParams 1 [] Full)
+                case res of
+                  Left e -> assertFailure e
+                  Right (ErrorResponse i c m) -> c `shouldBe` (-32602)
+              it "valid account, single output" $ do
+                let uaRead =
+                      parseAddress
+                        "utest1dl54utt6prjj5e0dnlknwumnxq9hycdjpkfr0sy6e6h522remqee8axe9zax0wsjrwpj76v555pdhvj9rnargpfyycs0vpkapq98xcdhem99gc4wchzn0ggepq3y6nz3a9sscwgqxgsh9vzhcad402y3x9szfregck5gslkya3c79d86xx0l33tpk8gnn7ew9vw37w43zh22u8dgdax"
+                res <-
+                  makeZenithCall
+                    "127.0.0.1"
+                    nodePort
+                    nodeUser
+                    nodePwd
+                    SendMany
+                    (SendParams
+                       1
+                       [ ProposedNote
+                           (ValidAddressAPI $ fromJust uaRead)
+                           5.0
+                           (Just "A cool memo")
+                       ]
+                       Full)
+                case res of
+                  Left e -> assertFailure e
+                  Right (SendResponse i o) -> o `shouldNotBe` U.nil
+              it "valid account, multiple outputs" $ do
+                let uaRead =
+                      parseAddress
+                        "utest1dl54utt6prjj5e0dnlknwumnxq9hycdjpkfr0sy6e6h522remqee8axe9zax0wsjrwpj76v555pdhvj9rnargpfyycs0vpkapq98xcdhem99gc4wchzn0ggepq3y6nz3a9sscwgqxgsh9vzhcad402y3x9szfregck5gslkya3c79d86xx0l33tpk8gnn7ew9vw37w43zh22u8dgdax"
+                let uaRead2 =
+                      parseAddress
+                        "ztestsapling136jp8z89v2jh6kqd5rs4dtvlxym90m43svzdwzxaplyvc5ttzppytpvx80ncllcsqzpmukxjl3y"
+                res <-
+                  makeZenithCall
+                    "127.0.0.1"
+                    nodePort
+                    nodeUser
+                    nodePwd
+                    SendMany
+                    (SendParams
+                       1
+                       [ ProposedNote
+                           (ValidAddressAPI $ fromJust uaRead)
+                           5.0
+                           (Just "A cool memo")
+                       , ProposedNote
+                           (ValidAddressAPI $ fromJust uaRead2)
+                           1.0
+                           (Just "Not so cool memo")
+                       ]
+                       Full)
+                case res of
+                  Left e -> assertFailure e
+                  Right (SendResponse i o) -> o `shouldNotBe` U.nil
 
 startAPI :: Config -> IO ()
 startAPI config = do

test/Spec.hs

@@ -123,55 +123,6 @@ main = do
           let ua =
                 "utest1mvlny48qd4x94w8vz5u2lrxx0enuquajt72yekgq24p6pjaky3czk6m7x358h7g900ex6gzvdehaekl96qnakjzw8yaasp8y0u3j5jnlfd33trduznh6k3fcn5ek9qc857fgz8ehm37etx94sj58nrkc0k5hurxnuxpcpms3j8uy2t8kt2vy6vetvsfxxdhtjq0yqulqprvh7mf2u3x"
           isValidUnifiedAddress ua `shouldNotBe` Nothing
-      describe "Function tests" $ do
-        describe "Sapling Decoding" $ do
-          let sk =
-                SaplingSpendingKey
-                  "\ETX}\195.\SUB\NUL\NUL\NUL\128\NUL\203\"\229IL\CANJ*\209\EM\145\228m\172\&4\SYNNl\DC3\161\147\SO\157\238H\192\147eQ\143L\201\216\163\180\147\145\156Zs+\146>8\176`ta\161\223\SO\140\177\b;\161\SO\236\151W\148<\STX\171|\DC2\172U\195(I\140\146\214\182\137\211\228\159\128~bV\STXy{m'\224\175\221\219\180!\ENQ_\161\132\240?\255\236\"6\133\181\170t\181\139\143\207\170\211\ENQ\167a\184\163\243\246\140\158t\155\133\138X\a\241\200\140\EMT\GS~\175\249&z\250\214\231\239mi\223\206\STX\t\EM<{V~J\253FB"
-          let tree =
-                SaplingCommitmentTree $
-                hexString
-                  "01818f2bd58b1e392334d0565181cc7843ae09e3533b2a50a8f1131af657340a5c001001161f962245812ba5e1804fd0a336bc78fa4ee4441a8e0f1525ca5da1b285d35101120f45afa700b8c1854aa8b9c8fe8ed92118ef790584bfcb926078812a10c83a00000000012f4f72c03f8c937a94919a01a07f21165cc8394295291cb888ca91ed003810390107114fe4bb4cd08b47f6ae47477c182d5da9fe5c189061808c1091e9bf3b4524000001447d6b9100cddd5f80c8cf4ddee2b87eba053bd987465aec2293bd0514e68b0d015f6c95e75f4601a0a31670a7deb970fc8988c611685161d2e1629d0a1a0ebd07015f8b9205e0514fa235d75c150b87e23866b882b39786852d1ab42aab11d31a4a0117ddeb3a5f8d2f6b2d0a07f28f01ab25e03a05a9319275bb86d72fcaef6fc01501f08f39275112dd8905b854170b7f247cf2df18454d4fa94e6e4f9320cca05f24011f8322ef806eb2430dc4a7a41c1b344bea5be946efc7b4349c1c9edb14ff9d39"
-          let nextTree =
-                SaplingCommitmentTree $
-                hexString
-                  "01bd8a3f3cfc964332a2ada8c09a0da9dfc24174befb938abb086b9be5ca049e4900100000019f0d7efb00169bb2202152d3266059d208ab17d14642c3339f9075e997160657000000012f4f72c03f8c937a94919a01a07f21165cc8394295291cb888ca91ed003810390107114fe4bb4cd08b47f6ae47477c182d5da9fe5c189061808c1091e9bf3b4524000001447d6b9100cddd5f80c8cf4ddee2b87eba053bd987465aec2293bd0514e68b0d015f6c95e75f4601a0a31670a7deb970fc8988c611685161d2e1629d0a1a0ebd07015f8b9205e0514fa235d75c150b87e23866b882b39786852d1ab42aab11d31a4a0117ddeb3a5f8d2f6b2d0a07f28f01ab25e03a05a9319275bb86d72fcaef6fc01501f08f39275112dd8905b854170b7f247cf2df18454d4fa94e6e4f9320cca05f24011f8322ef806eb2430dc4a7a41c1b344bea5be946efc7b4349c1c9edb14ff9d39"
-          it "Sapling is decoded correctly" $ do
-            so <-
-              runSqlite "zenith.db" $
-              selectList [ShieldOutputTx ==. toSqlKey 38318] []
-            let cmus = map (getHex . shieldOutputCmu . entityVal) so
-            let pos =
-                  getSaplingNotePosition <$>
-                  (getSaplingWitness =<<
-                   updateSaplingCommitmentTree tree (head cmus))
-            let pos1 = getSaplingNotePosition <$> getSaplingWitness tree
-            let pos2 = getSaplingNotePosition <$> getSaplingWitness nextTree
-            case pos of
-              Nothing -> assertFailure "couldn't get note position"
-              Just p -> do
-                print p
-                print pos1
-                print pos2
-                let dn =
-                      decodeSaplingOutputEsk
-                        sk
-                        (ShieldedOutput
-                           (getHex $ shieldOutputCv $ entityVal $ head so)
-                           (getHex $ shieldOutputCmu $ entityVal $ head so)
-                           (getHex $ shieldOutputEphKey $ entityVal $ head so)
-                           (getHex $ shieldOutputEncCipher $ entityVal $ head so)
-                           (getHex $ shieldOutputOutCipher $ entityVal $ head so)
-                           (getHex $ shieldOutputProof $ entityVal $ head so))
-                        TestNet
-                        External
-                        p
-                case dn of
-                  Nothing -> assertFailure "couldn't decode Sap output"
-                  Just d ->
-                    a_nullifier d `shouldBe`
-                    hexString
-                      "6c5d1413c63a9a88db71c3f41dc12cd60197ee742fc75b217215e7144db48bd3"
       describe "Note selection for Tx" $ do
         it "Value less than balance" $ do
           pool <- runNoLoggingT $ initPool "/home/rav/Zenith/zenith.db"
@@ -181,10 +132,6 @@ main = do
           pool <- runNoLoggingT $ initPool "/home/rav/Zenith/zenith.db"
           let res = selectUnspentNotes pool (toSqlKey 1) 84000000
           res `shouldThrow` anyIOException
-        it "Fee calculation" $ do
-          pool <- runNoLoggingT $ initPool "/home/rav/Zenith/zenith.db"
-          res <- selectUnspentNotes pool (toSqlKey 1) 14000000
-          calculateTxFee res 3 `shouldBe` 20000
       describe "Testing validation" $ do
         it "Unified" $ do
           let a =
@@ -267,9 +214,11 @@ main = do
                     TestNet
                     (toSqlKey 1)
                     3001331
-                    0.005
+                    [ ProposedNote
-                    (fromJust uaRead)
+                        (ValidAddressAPI $ fromJust uaRead)
-                    "Sending memo to orchard"
+                        0.005
+                        (Just "Sending memo to orchard")
+                    ]
                     Full
                 case tx of
                   Left e -> assertFailure $ show e
@@ -291,9 +240,11 @@ main = do
                     TestNet
                     (toSqlKey 4)
                     3001331
-                    0.005
+                    [ ProposedNote
-                    (fromJust uaRead)
+                        (ValidAddressAPI $ fromJust uaRead)
-                    "Sending memo to sapling"
+                        0.005
+                        (Just "Sending memo to sapling")
+                    ]
                     Full
                 case tx of
                   Left e -> assertFailure $ show e
@@ -313,13 +264,49 @@ main = do
                     TestNet
                     (toSqlKey 4)
                     3001331
-                    0.005
+                    [ ProposedNote
-                    (fromJust uaRead)
+                        (ValidAddressAPI $ fromJust uaRead)
-                    ""
+                        0.005
+                        Nothing
+                    ]
                     Full
                 tx `shouldBe`
                   Left
                     (PrivacyPolicyError "Receiver not capable of Full privacy")
+          it "To mixed shielded receivers" $ do
+            let uaRead =
+                  parseAddress
+                    "utest1dl54utt6prjj5e0dnlknwumnxq9hycdjpkfr0sy6e6h522remqee8axe9zax0wsjrwpj76v555pdhvj9rnargpfyycs0vpkapq98xcdhem99gc4wchzn0ggepq3y6nz3a9sscwgqxgsh9vzhcad402y3x9szfregck5gslkya3c79d86xx0l33tpk8gnn7ew9vw37w43zh22u8dgdax"
+            let uaRead2 =
+                  parseAddress
+                    "ztestsapling136jp8z89v2jh6kqd5rs4dtvlxym90m43svzdwzxaplyvc5ttzppytpvx80ncllcsqzpmukxjl3y"
+            case uaRead of
+              Nothing -> assertFailure "wrong address"
+              Just ua -> do
+                pool <- runNoLoggingT $ initPool "/home/rav/Zenith/zenith.db"
+                tx <-
+                  runFileLoggingT "zenith.log" $
+                  prepareTxV2
+                    pool
+                    "localhost"
+                    18232
+                    TestNet
+                    (toSqlKey 1)
+                    3001331
+                    [ ProposedNote
+                        (ValidAddressAPI $ fromJust uaRead)
+                        0.005
+                        (Just "Sending memo to orchard")
+                    , ProposedNote
+                        (ValidAddressAPI $ fromJust uaRead2)
+                        0.004
+                        Nothing
+                    ]
+                    Full
+                tx `shouldBe`
+                  Left
+                    (PrivacyPolicyError
+                       "Combination of receivers not allowed for Full privacy")
         describe "Medium" $ do
           it "To Orchard" $ do
             let uaRead =
@@ -338,9 +325,11 @@ main = do
                     TestNet
                     (toSqlKey 1)
                     3001372
-                    0.005
+                    [ ProposedNote
-                    (fromJust uaRead)
+                        (ValidAddressAPI $ fromJust uaRead)
-                    "Sending memo to orchard"
+                        0.005
+                        (Just "Sending memo to orchard")
+                    ]
                     Medium
                 case tx of
                   Left e -> assertFailure $ show e
@@ -362,9 +351,11 @@ main = do
                     TestNet
                     (toSqlKey 1)
                     3001372
-                    0.005
+                    [ ProposedNote
-                    (fromJust uaRead)
+                        (ValidAddressAPI $ fromJust uaRead)
-                    "Sending memo to orchard"
+                        0.005
+                        (Just "Sending memo to sapling")
+                    ]
                     Medium
                 case tx of
                   Left e -> assertFailure $ show e
@@ -384,13 +375,48 @@ main = do
                     TestNet
                     (toSqlKey 4)
                     3001331
-                    0.005
+                    [ ProposedNote
-                    (fromJust uaRead)
+                        (ValidAddressAPI $ fromJust uaRead)
-                    ""
+                        0.005
+                        Nothing
+                    ]
                     Medium
                 tx `shouldBe`
                   Left
                     (PrivacyPolicyError "Receiver not capable of Medium privacy")
+          it "To mixed shielded receivers" $ do
+            let uaRead =
+                  parseAddress
+                    "utest1dl54utt6prjj5e0dnlknwumnxq9hycdjpkfr0sy6e6h522remqee8axe9zax0wsjrwpj76v555pdhvj9rnargpfyycs0vpkapq98xcdhem99gc4wchzn0ggepq3y6nz3a9sscwgqxgsh9vzhcad402y3x9szfregck5gslkya3c79d86xx0l33tpk8gnn7ew9vw37w43zh22u8dgdax"
+            let uaRead2 =
+                  parseAddress
+                    "ztestsapling136jp8z89v2jh6kqd5rs4dtvlxym90m43svzdwzxaplyvc5ttzppytpvx80ncllcsqzpmukxjl3y"
+            case uaRead of
+              Nothing -> assertFailure "wrong address"
+              Just ua -> do
+                pool <- runNoLoggingT $ initPool "/home/rav/Zenith/zenith.db"
+                tx <-
+                  runFileLoggingT "zenith.log" $
+                  prepareTxV2
+                    pool
+                    "localhost"
+                    18232
+                    TestNet
+                    (toSqlKey 1)
+                    3001331
+                    [ ProposedNote
+                        (ValidAddressAPI $ fromJust uaRead)
+                        0.005
+                        (Just "Sending memo to orchard")
+                    , ProposedNote
+                        (ValidAddressAPI $ fromJust uaRead2)
+                        0.004
+                        Nothing
+                    ]
+                    Medium
+                case tx of
+                  Left e -> assertFailure $ show e
+                  Right h -> h `shouldNotBe` (hexString "deadbeef")
         describe "Low" $ do
           it "To Orchard" $ do
             let uaRead =
@@ -409,9 +435,11 @@ main = do
                     TestNet
                     (toSqlKey 1)
                     3001372
-                    0.005
+                    [ ProposedNote
-                    (fromJust uaRead)
+                        (ValidAddressAPI $ fromJust uaRead)
-                    "Sending memo to orchard"
+                        0.005
+                        Nothing
+                    ]
                     Low
                 case tx of
                   Left e -> assertFailure $ show e
@@ -433,9 +461,11 @@ main = do
                     TestNet
                     (toSqlKey 1)
                     3001372
-                    0.005
+                    [ ProposedNote
-                    (fromJust uaRead)
+                        (ValidAddressAPI $ fromJust uaRead)
-                    "Sending memo to orchard"
+                        0.005
+                        Nothing
+                    ]
                     Low
                 case tx of
                   Left e -> assertFailure $ show e
@@ -455,9 +485,11 @@ main = do
                     TestNet
                     (toSqlKey 1)
                     3001372
-                    0.005
+                    [ ProposedNote
-                    (fromJust uaRead)
+                        (ValidAddressAPI $ fromJust uaRead)
-                    ""
+                        0.005
+                        Nothing
+                    ]
                     Low
                 case tx of
                   Left e -> assertFailure $ show e
@@ -480,14 +512,16 @@ main = do
                     TestNet
                     (toSqlKey 1)
                     3001372
-                    0.005
+                    [ ProposedNote
-                    (fromJust uaRead)
+                        (ValidAddressAPI $ fromJust uaRead)
-                    "Sending memo to orchard"
+                        0.005
+                        Nothing
+                    ]
                     None
                 tx `shouldBe`
                   Left
                     (PrivacyPolicyError
-                       "Receiver not compatible with privacy policy")
+                       "Shielded recipients not compatible with privacy policy.")
           it "To Sapling" $ do
             let uaRead =
                   parseAddress
@@ -505,14 +539,16 @@ main = do
                     TestNet
                     (toSqlKey 1)
                     3001372
-                    0.005
+                    [ ProposedNote
-                    (fromJust uaRead)
+                        (ValidAddressAPI $ fromJust uaRead)
-                    "Sending memo to orchard"
+                        0.005
+                        Nothing
+                    ]
                     None
                 tx `shouldBe`
                   Left
                     (PrivacyPolicyError
-                       "Receiver not compatible with privacy policy")
+                       "Shielded recipients not compatible with privacy policy.")
           it "To Transparent" $ do
             let uaRead = parseAddress "tmAmSa4AauSFuJieeanRBjkfnah45ysGtgZ"
             case uaRead of
@@ -528,9 +564,11 @@ main = do
                     TestNet
                     (toSqlKey 1)
                     3001372
-                    0.005
+                    [ ProposedNote
-                    (fromJust uaRead)
+                        (ValidAddressAPI $ fromJust uaRead)
-                    ""
+                        0.005
+                        Nothing
+                    ]
                     None
                 case tx of
                   Left e -> assertFailure $ show e

zenith-openrpc.json

@@ -132,6 +132,7 @@
       ],
       "errors": [
         { "$ref": "#/components/errors/ZebraNotAvailable" },
+        { "$ref": "#/components/errors/ZenithBusy" },
         { "$ref": "#/components/errors/DuplicateName" }
       ]
     },
@@ -228,6 +229,7 @@
       "errors": [
         { "$ref": "#/components/errors/ZebraNotAvailable" },
         { "$ref": "#/components/errors/DuplicateName" },
+        { "$ref": "#/components/errors/ZenithBusy" },
         { "$ref": "#/components/errors/InvalidWallet" }
       ]
     },
@@ -444,6 +446,7 @@
       ],
       "errors": [
         { "$ref": "#/components/errors/InvalidAccount" },
+        { "$ref": "#/components/errors/ZenithBusy" },
         { "$ref": "#/components/errors/DuplicateName" }
       ]
     },
@@ -593,10 +596,11 @@
     {
       "name": "sendmany",
       "summary": "Send transaction(s)",
-      "description": "Send one or more transactions by specifying the source account, the recipient address, the amount, the shielded memo (optional) and the privacy policy (optional).",
+      "description": "Send one transaction by specifying the source account, the privacy policy (optional, default 'Full') and an array of proposed outputs. Each output needs a recipient address, an amount and an optional shielded memo.",
-      "tags": [{"$ref": "#/components/tags/draft"},{"$ref": "#/components/tags/wip"}],
+      "tags": [],
       "params": [
         { "$ref": "#/components/contentDescriptors/AccountId"},
+        { "$ref": "#/components/contentDescriptors/PrivacyPolicy"},
         { "$ref": "#/components/contentDescriptors/TxRequestArray"}
       ],
       "paramStructure": "by-position",
@@ -610,14 +614,19 @@
       "examples": [
         {
           "name": "Send a transaction",
-          "summary": "Send one transaction",
+          "summary": "Send a transaction",
-          "description": "Send a single transaction",
+          "description": "Send a transaction with one output",
           "params": [
             {
               "name": "Account index", 
               "summary": "The index for the account to use",
               "value": "1"
             },
+            {
+              "name": "Privacy Policy",
+              "summary": "The selected privacy policy",
+              "value": "Full"
+            },
             {
               "name": "Transaction request",
               "summary": "The transaction to attempt",
@@ -640,7 +649,7 @@
       ],
       "errors": [
         { "$ref": "#/components/errors/ZebraNotAvailable" },
-        { "$ref": "#/components/errors/InvalidRecipient" },
+        { "$ref": "#/components/errors/ZenithBusy" },
         { "$ref": "#/components/errors/InvalidAccount" }
       ]
     },
@@ -736,6 +745,16 @@
           "type": "array",
           "items": { "$ref": "#/components/schemas/TxRequest"}
         }
+      },
+      "PrivacyPolicy": { 
+        "name": "Privacy Policy",
+        "summary": "The chosen privacy policy to use for the transaction",
+        "description": "The privacy policy to use for the transaction. `Full` policy allows shielded funds to be transferred within their shielded pools. `Medium` policy allows shielded funds to cross shielded pools. `Low` allows deshielding transactions into transparent receivers but not to exchange addresses. `None` allows for transparent funds to be spent to transparent addresses and exchange addresses.",
+        "required": false,
+        "schema": {
+          "type": "string", 
+          "enum": ["None", "Low", "Medium", "Full"]
+        }
       }
     },
 	  "schemas": {
@@ -814,8 +833,7 @@
         "properties": {
           "address": { "type": "string", "description": "Recipient's address (unified, Sapling or transparent)" },
           "amount": { "type": "number", "description": "The amount to send in ZEC"},
-          "memo": { "type": "string", "description": "The shielded memo to include, if applicable"},
+          "memo": { "type": "string", "description": "The shielded memo to include, if applicable"}
-          "privacy": { "type": "string", "enum": ["None", "Low", "Medium", "Full"], "description": "The privacy policy to use for the transaction. `Full` policy allows shielded funds to be transferred within their shielded pools. `Medium` policy allows shielded funds to cross shielded pools and deshielding transactions. `Low` allows to spend transparent funds into shielded pools. `None` allows for transparent funds to be spent to transparent addresses."}
         }
       }
     },
@@ -872,6 +890,10 @@
       "InvalidRecipient": {
         "code": -32011,
         "message": "The provided recipient address is not valid."
+      },
+      "ZenithBusy": {
+        "code": -32012,
+        "message": "The Zenith server is syncing, please try again later."
       }
     }
   }