feat(rpc): implement shieldnotes

src/Zenith/CLI.hs

@@ -79,6 +79,7 @@ import Data.Scientific (Scientific, scientific)
 import qualified Data.Text as T
 import qualified Data.Text.Encoding as E
 import Data.Time.Clock.POSIX (posixSecondsToUTCTime)
+import qualified Data.UUID as U
 import qualified Data.Vector as Vec
 import Database.Persist
 import Database.Persist.Sqlite
@@ -116,6 +117,7 @@ import Zenith.Types
   , ValidAddressAPI(..)
   , ZcashNetDB(..)
   , ZenithStatus(..)
+  , ZenithUuid(..)
   )
 import Zenith.Utils
   ( displayTaz
@@ -2063,19 +2065,20 @@ shieldTransaction ::
 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
+  ops <-
-    Left e -> BC.writeBChan chan $ TickMsg $ show e
+    mapM
-    Right rawTx -> do
+      (\case
-      BC.writeBChan chan $ TickMsg "Transaction ready, sending to Zebra..."
+         Left e -> return $ T.pack $ show e
-      resp <-
+         Right x -> do
-        makeZebraCall
+           thisOp <- getOperation pool x
-          zHost
+           case thisOp of
-          zPort
+             Nothing -> return ""
-          "sendrawtransaction"
+             Just o ->
-          [Data.Aeson.String $ toText rawTx]
+               return $
-      case resp of
+               (U.toText . getUuid . operationUuid $ entityVal o) <>
-        Left e1 -> BC.writeBChan chan $ TickMsg $ "Zebra error: " ++ show e1
+               ": " <> (T.pack . show . operationStatus $ entityVal o))
-        Right txId -> BC.writeBChan chan $ TickTx txId
+      res
+  BC.writeBChan chan $ TickMsg $ T.unpack $ T.intercalate "\n" ops
 
 deshieldTransaction ::
      ConnectionPool

src/Zenith/Core.hs

@@ -3,6 +3,7 @@
 -- | Core wallet functionality for Zenith
 module Zenith.Core where
 
+import Control.Concurrent (forkIO)
 import Control.Exception (throwIO, try)
 import Control.Monad (forM, unless, when)
 import Control.Monad.IO.Class (liftIO)
@@ -25,6 +26,8 @@ import Data.Scientific (Scientific, scientific, toBoundedInteger)
 import qualified Data.Text as T
 import qualified Data.Text.Encoding as E
 import Data.Time
+import qualified Data.UUID as U
+import Data.UUID.V4 (nextRandom)
 import qualified Database.Esqueleto.Experimental as ESQ
 import Database.Persist
 import Database.Persist.Sqlite
@@ -80,6 +83,8 @@ import Zenith.Types
   , ValidAddressAPI(..)
   , ZcashNetDB(..)
   , ZebraTreeInfo(..)
+  , ZenithStatus(..)
+  , ZenithUuid(..)
   )
 
 -- * Zebra Node interaction
@@ -762,8 +767,8 @@ shieldTransparentNotes ::
   -> ZcashNet
   -> ZcashAccountId
   -> Int
-  -> NoLoggingT IO [Either TxError HexString]
+  -> NoLoggingT IO [Either TxError U.UUID]
-shieldTransparentNotes pool zebraHost zebraPort znet za bh = do
+shieldTransparentNotes pool zHost zPort znet za bh = do
   accRead <- liftIO $ getAccountById pool za
   logDebugN $ T.pack $ "Target block: " ++ show bh
   case accRead of
@@ -781,49 +786,79 @@ shieldTransparentNotes pool zebraHost zebraPort znet za bh = do
       sTree <- liftIO $ getSaplingTree pool
       oTree <- liftIO $ getOrchardTree pool
       forM fNotes $ \trNotes -> do
-        let noteTotal = getTotalAmount (trNotes, [], [])
+        opid <- liftIO nextRandom
-        tSpends <-
+        startTime <- liftIO getCurrentTime
+        opkey <-
           liftIO $
-          prepTSpends
+          saveOperation pool $
-            (getTranSK $ zcashAccountTPrivateKey $ entityVal acc)
+          Operation (ZenithUuid opid) startTime Nothing Processing Nothing
-            trNotes
+        case opkey of
-        chgAddr <- getInternalAddresses pool $ entityKey acc
+          Nothing -> return $ Left ZHError
-        let internalUA =
+          Just opkey' -> do
-              getUA $ walletAddressUAddress $ entityVal $ head chgAddr
+            let noteTotal = getTotalAmount (trNotes, [], [])
-        let oRcvr =
+            tSpends <-
-              fromJust $
+              liftIO $
-              o_rec =<< isValidUnifiedAddress (E.encodeUtf8 internalUA)
+              prepTSpends
-        let dummy =
+                (getTranSK $ zcashAccountTPrivateKey $ entityVal acc)
-              OutgoingNote
+                trNotes
-                4
+            chgAddr <- getInternalAddresses pool $ entityKey acc
-                (getBytes $ getOrchSK $ zcashAccountOrchSpendKey $ entityVal acc)
+            let internalUA =
-                (getBytes oRcvr)
+                  getUA $ walletAddressUAddress $ entityVal $ head chgAddr
-                (fromIntegral $ noteTotal - 500)
+            let oRcvr =
-                ""
+                  fromJust $
-                True
+                  o_rec =<< isValidUnifiedAddress (E.encodeUtf8 internalUA)
-        let feeAmt = calculateTxFee (trNotes, [], []) [dummy]
+            let dummy =
-        let snote =
+                  OutgoingNote
-              OutgoingNote
+                    4
-                4
+                    (getBytes $
-                (getBytes $ getOrchSK $ zcashAccountOrchSpendKey $ entityVal acc)
+                     getOrchSK $ zcashAccountOrchSpendKey $ entityVal acc)
-                (getBytes oRcvr)
+                    (getBytes oRcvr)
-                (fromIntegral $ noteTotal - fromIntegral feeAmt)
+                    (fromIntegral $ noteTotal - 500)
-                ""
+                    ""
-                True
+                    True
-        tx <-
+            let feeAmt = calculateTxFee (trNotes, [], []) [dummy]
-          liftIO $
+            let snote =
-          createTransaction
+                  OutgoingNote
-            (maybe (hexString "00") (getHash . value . fst) sTree)
+                    4
-            (maybe (hexString "00") (getHash . value . fst) oTree)
+                    (getBytes $
-            tSpends
+                     getOrchSK $ zcashAccountOrchSpendKey $ entityVal acc)
-            []
+                    (getBytes oRcvr)
-            []
+                    (fromIntegral $ noteTotal - fromIntegral feeAmt)
-            [snote]
+                    ""
-            znet
+                    True
-            (bh + 3)
+            _ <-
-            True
+              liftIO $
-        logDebugN $ T.pack $ show tx
+              forkIO $ do
-        return tx
+                tx <-
+                  liftIO $
+                  createTransaction
+                    (maybe (hexString "00") (getHash . value . fst) sTree)
+                    (maybe (hexString "00") (getHash . value . fst) oTree)
+                    tSpends
+                    []
+                    []
+                    [snote]
+                    znet
+                    (bh + 3)
+                    True
+                case tx of
+                  Left e ->
+                    finalizeOperation pool opkey' Failed $ T.pack $ show e
+                  Right rawTx -> do
+                    zebraRes <-
+                      makeZebraCall
+                        zHost
+                        zPort
+                        "sendrawtransaction"
+                        [Data.Aeson.String $ toText rawTx]
+                    case zebraRes of
+                      Left e1 ->
+                        finalizeOperation pool opkey' Failed $ T.pack $ show e1
+                      Right txId ->
+                        finalizeOperation pool opkey' Successful $
+                        "Tx ID: " <> toText txId
+            logDebugN $ T.pack $ show opid
+            return $ Right opid
   where
     getTotalAmount ::
          ( [Entity WalletTrNote]

src/Zenith/GUI.hs

@@ -28,6 +28,7 @@ import Data.Scientific (Scientific, fromFloatDigits)
 import qualified Data.Text as T
 import qualified Data.Text.Encoding as E
 import Data.Time.Clock.POSIX (posixSecondsToUTCTime)
+import qualified Data.UUID as U
 import Database.Esqueleto.Experimental (ConnectionPool, fromSqlKey)
 import Database.Persist
 import Lens.Micro ((&), (+~), (.~), (?~), (^.), set)
@@ -1763,19 +1764,20 @@ shieldTransaction config znet accId sendMsg = do
   pool <- runNoLoggingT $ initPool dbPath
   bl <- getChainTip zHost zPort
   res <- runNoLoggingT $ shieldTransparentNotes pool zHost zPort znet accId bl
-  forM_ res $ \case
+  ops <-
-    Left e -> sendMsg $ ShowError $ T.pack (show e)
+    mapM
-    Right rawTx -> do
+      (\case
-      sendMsg $ ShowMsg "Transaction ready, sending to Zebra..."
+         Left e -> return $ T.pack $ show e
-      resp <-
+         Right x -> do
-        makeZebraCall
+           thisOp <- getOperation pool x
-          zHost
+           case thisOp of
-          zPort
+             Nothing -> return ""
-          "sendrawtransaction"
+             Just o ->
-          [Data.Aeson.String $ toText rawTx]
+               return $
-      case resp of
+               (U.toText . getUuid . operationUuid $ entityVal o) <>
-        Left e1 -> sendMsg $ ShowError $ "Zebra error: " <> T.pack (show e1)
+               ": " <> (T.pack . show . operationStatus $ entityVal o))
-        Right txId -> sendMsg $ ShowTxId txId
+      res
+  sendMsg $ ShowMsg $ T.intercalate "\n" ops
 
 deshieldTransaction ::
      Config

src/Zenith/RPC.hs

@@ -51,6 +51,7 @@ import Zenith.Core
   , createCustomWalletAddress
   , createZcashAccount
   , prepareTxV2
+  , shieldTransparentNotes
   , syncWallet
   , updateCommitmentTrees
   )
@@ -121,6 +122,7 @@ data ZenithMethod
   | GetNewAddress
   | GetOperationStatus
   | SendMany
+  | ShieldNotes
   | UnknownMethod
   deriving (Eq, Prelude.Show)
 
@@ -136,6 +138,7 @@ instance ToJSON ZenithMethod where
   toJSON GetNewAddress = Data.Aeson.String "getnewaddress"
   toJSON GetOperationStatus = Data.Aeson.String "getoperationstatus"
   toJSON SendMany = Data.Aeson.String "sendmany"
+  toJSON ShieldNotes = Data.Aeson.String "shieldnotes"
   toJSON UnknownMethod = Data.Aeson.Null
 
 instance FromJSON ZenithMethod where
@@ -152,6 +155,7 @@ instance FromJSON ZenithMethod where
       "getnewaddress" -> pure GetNewAddress
       "getoperationstatus" -> pure GetOperationStatus
       "sendmany" -> pure SendMany
+      "shieldnotes" -> pure ShieldNotes
       _ -> pure UnknownMethod
 
 data ZenithParams
@@ -167,6 +171,7 @@ data ZenithParams
   | OpParams !ZenithUuid
   | SendParams !Int ![ProposedNote] !PrivacyPolicy
   | TestParams !T.Text
+  | ShieldNotesParams !Int
   deriving (Eq, Prelude.Show)
 
 instance ToJSON ZenithParams where
@@ -191,6 +196,7 @@ instance ToJSON ZenithParams where
     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]
+  toJSON (ShieldNotesParams i) = Data.Aeson.Array $ V.fromList [jsonNumber i]
 
 data ZenithResponse
   = InfoResponse !T.Text !ZenithInfo
@@ -203,6 +209,7 @@ data ZenithResponse
   | NewAddrResponse !T.Text !ZcashAddressAPI
   | OpResponse !T.Text !Operation
   | SendResponse !T.Text !U.UUID
+  | MultiOpResponse !T.Text ![T.Text]
   | ErrorResponse !T.Text !Double !T.Text
   deriving (Eq, Prelude.Show)
 
@@ -224,6 +231,7 @@ instance ToJSON ZenithResponse where
   toJSON (NewAddrResponse i a) = packRpcResponse i a
   toJSON (OpResponse i u) = packRpcResponse i u
   toJSON (SendResponse i o) = packRpcResponse i o
+  toJSON (MultiOpResponse i o) = packRpcResponse i o
 
 instance FromJSON ZenithResponse where
   parseJSON =
@@ -298,6 +306,12 @@ instance FromJSON ZenithResponse where
                                               k5 <- parseJSON r1
                                               pure $ NoteListResponse i k5
                                             Nothing -> fail "Unknown object"
+                            String s -> do
+                              case U.fromText s of
+                                Nothing -> fail "Unknown value"
+                                Just _u -> do
+                                  k7 <- parseJSON r1
+                                  pure $ MultiOpResponse i k7
                             _anyOther -> fail "Malformed JSON"
                     Number k -> do
                       case floatingOrInteger k of
@@ -489,6 +503,16 @@ instance FromJSON RpcCall where
                     _anyOther -> pure $ RpcCall v i SendMany BadParams
                 else pure $ RpcCall v i SendMany BadParams
             _anyOther -> pure $ RpcCall v i SendMany BadParams
+        ShieldNotes -> do
+          p <- obj .: "params"
+          case p of
+            Array a ->
+              if V.length a == 1
+                then do
+                  x <- parseJSON $ a V.! 0
+                  pure $ RpcCall v i ShieldNotes (ShieldNotesParams x)
+                else pure $ RpcCall v i ShieldNotes BadParams
+            _anyOther -> pure $ RpcCall v i ShieldNotes BadParams
 
 type ZenithRPC
   = "status" :> Get '[ JSON] Value :<|> BasicAuth "zenith-realm" Bool :> ReqBody
@@ -871,6 +895,56 @@ zenithServer state = getinfo :<|> handleRPC
                             "Account does not exist."
             _anyOtherParams ->
               return $ ErrorResponse (callId req) (-32602) "Invalid params"
+        ShieldNotes -> do
+          case parameters req of
+            ShieldNotesParams i -> do
+              let dbPath = w_dbPath state
+              let net = w_network state
+              let zHost = w_host state
+              let zPort = w_port 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
+                  acc <-
+                    liftIO $ getAccountById pool $ toSqlKey $ fromIntegral i
+                  case acc of
+                    Just acc' -> do
+                      bl <-
+                        liftIO $
+                        getLastSyncBlock
+                          pool
+                          (zcashAccountWalletId $ entityVal acc')
+                      opids <-
+                        liftIO $
+                        runNoLoggingT $
+                        shieldTransparentNotes
+                          pool
+                          zHost
+                          zPort
+                          net
+                          (entityKey acc')
+                          bl
+                      let ops =
+                            map
+                              (\case
+                                 Left e -> T.pack $ show e
+                                 Right op -> U.toText op)
+                              opids
+                      return $ MultiOpResponse (callId req) ops
+                    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