feat(rpc): implement shieldnotes
This commit is contained in:
parent
e91fe22473
commit
d737680a01
4 changed files with 184 additions and 70 deletions
|
@ -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
|
||||
|
|
|
@ -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,6 +786,15 @@ shieldTransparentNotes pool zebraHost zebraPort znet za bh = do
|
|||
sTree <- liftIO $ getSaplingTree pool
|
||||
oTree <- liftIO $ getOrchardTree pool
|
||||
forM fNotes $ \trNotes -> do
|
||||
opid <- liftIO nextRandom
|
||||
startTime <- liftIO getCurrentTime
|
||||
opkey <-
|
||||
liftIO $
|
||||
saveOperation pool $
|
||||
Operation (ZenithUuid opid) startTime Nothing Processing Nothing
|
||||
case opkey of
|
||||
Nothing -> return $ Left ZHError
|
||||
Just opkey' -> do
|
||||
let noteTotal = getTotalAmount (trNotes, [], [])
|
||||
tSpends <-
|
||||
liftIO $
|
||||
|
@ -796,7 +810,8 @@ shieldTransparentNotes pool zebraHost zebraPort znet za bh = do
|
|||
let dummy =
|
||||
OutgoingNote
|
||||
4
|
||||
(getBytes $ getOrchSK $ zcashAccountOrchSpendKey $ entityVal acc)
|
||||
(getBytes $
|
||||
getOrchSK $ zcashAccountOrchSpendKey $ entityVal acc)
|
||||
(getBytes oRcvr)
|
||||
(fromIntegral $ noteTotal - 500)
|
||||
""
|
||||
|
@ -805,11 +820,15 @@ shieldTransparentNotes pool zebraHost zebraPort znet za bh = do
|
|||
let snote =
|
||||
OutgoingNote
|
||||
4
|
||||
(getBytes $ getOrchSK $ zcashAccountOrchSpendKey $ entityVal acc)
|
||||
(getBytes $
|
||||
getOrchSK $ zcashAccountOrchSpendKey $ entityVal acc)
|
||||
(getBytes oRcvr)
|
||||
(fromIntegral $ noteTotal - fromIntegral feeAmt)
|
||||
""
|
||||
True
|
||||
_ <-
|
||||
liftIO $
|
||||
forkIO $ do
|
||||
tx <-
|
||||
liftIO $
|
||||
createTransaction
|
||||
|
@ -822,8 +841,24 @@ shieldTransparentNotes pool zebraHost zebraPort znet za bh = do
|
|||
znet
|
||||
(bh + 3)
|
||||
True
|
||||
logDebugN $ T.pack $ show tx
|
||||
return tx
|
||||
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]
|
||||
|
|
|
@ -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
|
||||
|
|
|
@ -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
|
||||
|
|
Loading…
Reference in a new issue