diff --git a/src/Zenith/CLI.hs b/src/Zenith/CLI.hs index c2fa1a7..9c18a00 100644 --- a/src/Zenith/CLI.hs +++ b/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 - 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 + ops <- + mapM + (\case + Left e -> return $ T.pack $ show e + Right x -> do + thisOp <- getOperation pool x + case thisOp of + Nothing -> return "" + Just o -> + return $ + (U.toText . getUuid . operationUuid $ entityVal o) <> + ": " <> (T.pack . show . operationStatus $ entityVal o)) + res + BC.writeBChan chan $ TickMsg $ T.unpack $ T.intercalate "\n" ops deshieldTransaction :: ConnectionPool diff --git a/src/Zenith/Core.hs b/src/Zenith/Core.hs index 835a00d..67d132c 100644 --- a/src/Zenith/Core.hs +++ b/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] -shieldTransparentNotes pool zebraHost zebraPort znet za bh = do + -> NoLoggingT IO [Either TxError U.UUID] +shieldTransparentNotes pool zHost zPort znet za bh = do accRead <- liftIO $ getAccountById pool za logDebugN $ T.pack $ "Target block: " ++ show bh case accRead of @@ -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, [], []) - tSpends <- + opid <- liftIO nextRandom + startTime <- liftIO getCurrentTime + opkey <- 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 dummy = - OutgoingNote - 4 - (getBytes $ getOrchSK $ zcashAccountOrchSpendKey $ entityVal acc) - (getBytes oRcvr) - (fromIntegral $ noteTotal - 500) - "" - True - let feeAmt = calculateTxFee (trNotes, [], []) [dummy] - let snote = - OutgoingNote - 4 - (getBytes $ getOrchSK $ zcashAccountOrchSpendKey $ entityVal acc) - (getBytes oRcvr) - (fromIntegral $ noteTotal - fromIntegral feeAmt) - "" - True - tx <- - liftIO $ - createTransaction - (maybe (hexString "00") (getHash . value . fst) sTree) - (maybe (hexString "00") (getHash . value . fst) oTree) - tSpends - [] - [] - [snote] - znet - (bh + 3) - True - logDebugN $ T.pack $ show tx - return tx + saveOperation pool $ + Operation (ZenithUuid opid) startTime Nothing Processing Nothing + case opkey of + Nothing -> return $ Left ZHError + Just opkey' -> do + let noteTotal = getTotalAmount (trNotes, [], []) + tSpends <- + liftIO $ + prepTSpends + (getTranSK $ zcashAccountTPrivateKey $ entityVal acc) + trNotes + chgAddr <- getInternalAddresses pool $ entityKey acc + let internalUA = + getUA $ walletAddressUAddress $ entityVal $ head chgAddr + let oRcvr = + fromJust $ + o_rec =<< isValidUnifiedAddress (E.encodeUtf8 internalUA) + let dummy = + OutgoingNote + 4 + (getBytes $ + getOrchSK $ zcashAccountOrchSpendKey $ entityVal acc) + (getBytes oRcvr) + (fromIntegral $ noteTotal - 500) + "" + True + let feeAmt = calculateTxFee (trNotes, [], []) [dummy] + let snote = + OutgoingNote + 4 + (getBytes $ + getOrchSK $ zcashAccountOrchSpendKey $ entityVal acc) + (getBytes oRcvr) + (fromIntegral $ noteTotal - fromIntegral feeAmt) + "" + True + _ <- + liftIO $ + forkIO $ do + tx <- + liftIO $ + createTransaction + (maybe (hexString "00") (getHash . value . fst) sTree) + (maybe (hexString "00") (getHash . value . fst) oTree) + tSpends + [] + [] + [snote] + znet + (bh + 3) + True + case tx of + Left e -> + finalizeOperation pool opkey' Failed $ T.pack $ show e + Right rawTx -> do + zebraRes <- + makeZebraCall + zHost + zPort + "sendrawtransaction" + [Data.Aeson.String $ toText rawTx] + case zebraRes of + Left e1 -> + finalizeOperation pool opkey' Failed $ T.pack $ show e1 + Right txId -> + finalizeOperation pool opkey' Successful $ + "Tx ID: " <> toText txId + logDebugN $ T.pack $ show opid + return $ Right opid where getTotalAmount :: ( [Entity WalletTrNote] diff --git a/src/Zenith/GUI.hs b/src/Zenith/GUI.hs index 304d960..d858c5d 100644 --- a/src/Zenith/GUI.hs +++ b/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 - Left e -> sendMsg $ ShowError $ T.pack (show e) - Right rawTx -> do - sendMsg $ ShowMsg "Transaction ready, sending to Zebra..." - resp <- - makeZebraCall - zHost - zPort - "sendrawtransaction" - [Data.Aeson.String $ toText rawTx] - case resp of - Left e1 -> sendMsg $ ShowError $ "Zebra error: " <> T.pack (show e1) - Right txId -> sendMsg $ ShowTxId txId + ops <- + mapM + (\case + Left e -> return $ T.pack $ show e + Right x -> do + thisOp <- getOperation pool x + case thisOp of + Nothing -> return "" + Just o -> + return $ + (U.toText . getUuid . operationUuid $ entityVal o) <> + ": " <> (T.pack . show . operationStatus $ entityVal o)) + res + sendMsg $ ShowMsg $ T.intercalate "\n" ops deshieldTransaction :: Config diff --git a/src/Zenith/RPC.hs b/src/Zenith/RPC.hs index a32fb8f..6e318a8 100644 --- a/src/Zenith/RPC.hs +++ b/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