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
@@ -729,38 +735,13 @@ prepareTxV2 ::
   -> ZcashNet
   -> ZcashAccountId
   -> Int
-  -> Float
+  -> [ProposedNote]
-  -> ValidAddress
-  -> T.Text
   -> PrivacyPolicy
   -> LoggingT 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 +752,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 +774,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 +795,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 +823,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 +852,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 +877,135 @@ 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
       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 pulls 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 +1013,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 +1034,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]

src/Zenith/DB.hs

@@ -2080,7 +2080,7 @@ selectUnspentNotesV2 ::
      ConnectionPool
   -> ZcashAccountId
   -> Integer
-  -> Int
+  -> [Int]
   -> PrivacyPolicy
   -> IO
        (Either
@@ -2091,27 +2091,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 +2137,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 +2154,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])

src/Zenith/GUI.hs

@@ -1558,7 +1558,15 @@ sendTransaction config znet accId bl amt ua memo policy sendMsg = do
       pool <- runNoLoggingT $ initPool dbPath
       res <-
         runFileLoggingT "zenith.log" $
-        prepareTxV2 pool zHost zPort znet accId bl amt addr memo policy
+        prepareTxV2
+          pool
+          zHost
+          zPort
+          znet
+          accId
+          bl
+          [ProposedNote (ValidAddressAPI addr) amt (Just memo)]
+          policy
       case res of
         Left e -> sendMsg $ ShowError $ T.pack $ show e
         Right rawTx -> do

src/Zenith/RPC.hs

@@ -8,6 +8,8 @@
 {-# LANGUAGE TypeFamilies #-}
 {-# LANGUAGE UndecidableInstances #-}
 {-# LANGUAGE LambdaCase #-}
+{-# LANGUAGE DerivingStrategies #-}
+{-# LANGUAGE GeneralisedNewtypeDeriving #-}
 
 module Zenith.RPC where
 
@@ -30,8 +32,21 @@ import Database.Esqueleto.Experimental
 import Servant
 import Text.Read (readMaybe)
 import ZcashHaskell.Keys (generateWalletSeedPhrase)
-import ZcashHaskell.Orchard (parseAddress)
+import ZcashHaskell.Orchard (encodeUnifiedAddress, parseAddress)
-import ZcashHaskell.Types (RpcError(..), Scope(..), ZcashNet(..))
+import ZcashHaskell.Sapling (encodeSaplingAddress)
+import ZcashHaskell.Transparent
+  ( encodeExchangeAddress
+  , encodeTransparentReceiver
+  )
+import ZcashHaskell.Types
+  ( ExchangeAddress(..)
+  , RpcError(..)
+  , SaplingAddress(..)
+  , Scope(..)
+  , TransparentAddress(..)
+  , ValidAddress(..)
+  , ZcashNet(..)
+  )
 import Zenith.Core (createCustomWalletAddress, createZcashAccount)
 import Zenith.DB
   ( Operation(..)
@@ -63,6 +78,9 @@ import Zenith.Types
   ( AccountBalance(..)
   , Config(..)
   , PhraseDB(..)
+  , PrivacyPolicy(..)
+  , ProposedNote(..)
+  , ValidAddressAPI(..)
   , ZcashAccountAPI(..)
   , ZcashAddressAPI(..)
   , ZcashNetDB(..)
@@ -83,6 +101,7 @@ data ZenithMethod
   | GetNewAccount
   | GetNewAddress
   | GetOperationStatus
+  | SendMany
   | UnknownMethod
   deriving (Eq, Prelude.Show)
 
@@ -97,6 +116,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 +132,7 @@ instance FromJSON ZenithMethod where
       "getnewaccount" -> pure GetNewAccount
       "getnewaddress" -> pure GetNewAddress
       "getoperationstatus" -> pure GetOperationStatus
+      "sendmany" -> pure SendMany
       _ -> pure UnknownMethod
 
 data ZenithParams
@@ -125,6 +146,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 +170,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 +183,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 +204,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 +284,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 +446,25 @@ 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
+                      pure $ RpcCall v i SendMany (SendParams acc y x')
+                    Array _ -> do
+                      x' <- parseJSON $ a V.! 1
+                      pure $ RpcCall v i SendMany (SendParams acc x' Full)
+                    _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
@@ -682,6 +731,14 @@ 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
+              pool <- liftIO $ runNoLoggingT $ initPool dbPath
+              undefined
+            _anyOtherParams ->
+              return $ ErrorResponse (callId req) (-32602) "Invalid params"
 
 authenticate :: Config -> BasicAuthCheck Bool
 authenticate config = BasicAuthCheck check

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]
+
 -- ** `zebrad`
 -- | Type for modeling the tree state response
 data ZebraTreeInfo = ZebraTreeInfo

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

@@ -746,7 +746,7 @@
       "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. `None` allows for transparent funds to be spent to transparent addresses.",
+        "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",