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 as T
|
||||||
import qualified Data.Text.Encoding as E
|
import qualified Data.Text.Encoding as E
|
||||||
import Data.Time.Clock.POSIX (posixSecondsToUTCTime)
|
import Data.Time.Clock.POSIX (posixSecondsToUTCTime)
|
||||||
|
import qualified Data.UUID as U
|
||||||
import qualified Data.Vector as Vec
|
import qualified Data.Vector as Vec
|
||||||
import Database.Persist
|
import Database.Persist
|
||||||
import Database.Persist.Sqlite
|
import Database.Persist.Sqlite
|
||||||
|
@ -116,6 +117,7 @@ import Zenith.Types
|
||||||
, ValidAddressAPI(..)
|
, ValidAddressAPI(..)
|
||||||
, ZcashNetDB(..)
|
, ZcashNetDB(..)
|
||||||
, ZenithStatus(..)
|
, ZenithStatus(..)
|
||||||
|
, ZenithUuid(..)
|
||||||
)
|
)
|
||||||
import Zenith.Utils
|
import Zenith.Utils
|
||||||
( displayTaz
|
( displayTaz
|
||||||
|
@ -2063,19 +2065,20 @@ shieldTransaction ::
|
||||||
shieldTransaction pool chan zHost zPort znet accId bl = do
|
shieldTransaction pool chan zHost zPort znet accId bl = do
|
||||||
BC.writeBChan chan $ TickMsg "Preparing shielding transaction..."
|
BC.writeBChan chan $ TickMsg "Preparing shielding transaction..."
|
||||||
res <- runNoLoggingT $ shieldTransparentNotes pool zHost zPort znet accId bl
|
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 ::
|
deshieldTransaction ::
|
||||||
ConnectionPool
|
ConnectionPool
|
||||||
|
|
|
@ -3,6 +3,7 @@
|
||||||
-- | Core wallet functionality for Zenith
|
-- | Core wallet functionality for Zenith
|
||||||
module Zenith.Core where
|
module Zenith.Core where
|
||||||
|
|
||||||
|
import Control.Concurrent (forkIO)
|
||||||
import Control.Exception (throwIO, try)
|
import Control.Exception (throwIO, try)
|
||||||
import Control.Monad (forM, unless, when)
|
import Control.Monad (forM, unless, when)
|
||||||
import Control.Monad.IO.Class (liftIO)
|
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 as T
|
||||||
import qualified Data.Text.Encoding as E
|
import qualified Data.Text.Encoding as E
|
||||||
import Data.Time
|
import Data.Time
|
||||||
|
import qualified Data.UUID as U
|
||||||
|
import Data.UUID.V4 (nextRandom)
|
||||||
import qualified Database.Esqueleto.Experimental as ESQ
|
import qualified Database.Esqueleto.Experimental as ESQ
|
||||||
import Database.Persist
|
import Database.Persist
|
||||||
import Database.Persist.Sqlite
|
import Database.Persist.Sqlite
|
||||||
|
@ -80,6 +83,8 @@ import Zenith.Types
|
||||||
, ValidAddressAPI(..)
|
, ValidAddressAPI(..)
|
||||||
, ZcashNetDB(..)
|
, ZcashNetDB(..)
|
||||||
, ZebraTreeInfo(..)
|
, ZebraTreeInfo(..)
|
||||||
|
, ZenithStatus(..)
|
||||||
|
, ZenithUuid(..)
|
||||||
)
|
)
|
||||||
|
|
||||||
-- * Zebra Node interaction
|
-- * Zebra Node interaction
|
||||||
|
@ -762,8 +767,8 @@ shieldTransparentNotes ::
|
||||||
-> ZcashNet
|
-> ZcashNet
|
||||||
-> ZcashAccountId
|
-> ZcashAccountId
|
||||||
-> Int
|
-> 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
|
accRead <- liftIO $ getAccountById pool za
|
||||||
logDebugN $ T.pack $ "Target block: " ++ show bh
|
logDebugN $ T.pack $ "Target block: " ++ show bh
|
||||||
case accRead of
|
case accRead of
|
||||||
|
@ -781,6 +786,15 @@ shieldTransparentNotes pool zebraHost zebraPort znet za bh = do
|
||||||
sTree <- liftIO $ getSaplingTree pool
|
sTree <- liftIO $ getSaplingTree pool
|
||||||
oTree <- liftIO $ getOrchardTree pool
|
oTree <- liftIO $ getOrchardTree pool
|
||||||
forM fNotes $ \trNotes -> do
|
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, [], [])
|
let noteTotal = getTotalAmount (trNotes, [], [])
|
||||||
tSpends <-
|
tSpends <-
|
||||||
liftIO $
|
liftIO $
|
||||||
|
@ -796,7 +810,8 @@ shieldTransparentNotes pool zebraHost zebraPort znet za bh = do
|
||||||
let dummy =
|
let dummy =
|
||||||
OutgoingNote
|
OutgoingNote
|
||||||
4
|
4
|
||||||
(getBytes $ getOrchSK $ zcashAccountOrchSpendKey $ entityVal acc)
|
(getBytes $
|
||||||
|
getOrchSK $ zcashAccountOrchSpendKey $ entityVal acc)
|
||||||
(getBytes oRcvr)
|
(getBytes oRcvr)
|
||||||
(fromIntegral $ noteTotal - 500)
|
(fromIntegral $ noteTotal - 500)
|
||||||
""
|
""
|
||||||
|
@ -805,11 +820,15 @@ shieldTransparentNotes pool zebraHost zebraPort znet za bh = do
|
||||||
let snote =
|
let snote =
|
||||||
OutgoingNote
|
OutgoingNote
|
||||||
4
|
4
|
||||||
(getBytes $ getOrchSK $ zcashAccountOrchSpendKey $ entityVal acc)
|
(getBytes $
|
||||||
|
getOrchSK $ zcashAccountOrchSpendKey $ entityVal acc)
|
||||||
(getBytes oRcvr)
|
(getBytes oRcvr)
|
||||||
(fromIntegral $ noteTotal - fromIntegral feeAmt)
|
(fromIntegral $ noteTotal - fromIntegral feeAmt)
|
||||||
""
|
""
|
||||||
True
|
True
|
||||||
|
_ <-
|
||||||
|
liftIO $
|
||||||
|
forkIO $ do
|
||||||
tx <-
|
tx <-
|
||||||
liftIO $
|
liftIO $
|
||||||
createTransaction
|
createTransaction
|
||||||
|
@ -822,8 +841,24 @@ shieldTransparentNotes pool zebraHost zebraPort znet za bh = do
|
||||||
znet
|
znet
|
||||||
(bh + 3)
|
(bh + 3)
|
||||||
True
|
True
|
||||||
logDebugN $ T.pack $ show tx
|
case tx of
|
||||||
return tx
|
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
|
where
|
||||||
getTotalAmount ::
|
getTotalAmount ::
|
||||||
( [Entity WalletTrNote]
|
( [Entity WalletTrNote]
|
||||||
|
|
|
@ -28,6 +28,7 @@ import Data.Scientific (Scientific, fromFloatDigits)
|
||||||
import qualified Data.Text as T
|
import qualified Data.Text as T
|
||||||
import qualified Data.Text.Encoding as E
|
import qualified Data.Text.Encoding as E
|
||||||
import Data.Time.Clock.POSIX (posixSecondsToUTCTime)
|
import Data.Time.Clock.POSIX (posixSecondsToUTCTime)
|
||||||
|
import qualified Data.UUID as U
|
||||||
import Database.Esqueleto.Experimental (ConnectionPool, fromSqlKey)
|
import Database.Esqueleto.Experimental (ConnectionPool, fromSqlKey)
|
||||||
import Database.Persist
|
import Database.Persist
|
||||||
import Lens.Micro ((&), (+~), (.~), (?~), (^.), set)
|
import Lens.Micro ((&), (+~), (.~), (?~), (^.), set)
|
||||||
|
@ -1763,19 +1764,20 @@ shieldTransaction config znet accId sendMsg = do
|
||||||
pool <- runNoLoggingT $ initPool dbPath
|
pool <- runNoLoggingT $ initPool dbPath
|
||||||
bl <- getChainTip zHost zPort
|
bl <- getChainTip zHost zPort
|
||||||
res <- runNoLoggingT $ shieldTransparentNotes pool zHost zPort znet accId bl
|
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 ::
|
deshieldTransaction ::
|
||||||
Config
|
Config
|
||||||
|
|
|
@ -51,6 +51,7 @@ import Zenith.Core
|
||||||
, createCustomWalletAddress
|
, createCustomWalletAddress
|
||||||
, createZcashAccount
|
, createZcashAccount
|
||||||
, prepareTxV2
|
, prepareTxV2
|
||||||
|
, shieldTransparentNotes
|
||||||
, syncWallet
|
, syncWallet
|
||||||
, updateCommitmentTrees
|
, updateCommitmentTrees
|
||||||
)
|
)
|
||||||
|
@ -121,6 +122,7 @@ data ZenithMethod
|
||||||
| GetNewAddress
|
| GetNewAddress
|
||||||
| GetOperationStatus
|
| GetOperationStatus
|
||||||
| SendMany
|
| SendMany
|
||||||
|
| ShieldNotes
|
||||||
| UnknownMethod
|
| UnknownMethod
|
||||||
deriving (Eq, Prelude.Show)
|
deriving (Eq, Prelude.Show)
|
||||||
|
|
||||||
|
@ -136,6 +138,7 @@ instance ToJSON ZenithMethod where
|
||||||
toJSON GetNewAddress = Data.Aeson.String "getnewaddress"
|
toJSON GetNewAddress = Data.Aeson.String "getnewaddress"
|
||||||
toJSON GetOperationStatus = Data.Aeson.String "getoperationstatus"
|
toJSON GetOperationStatus = Data.Aeson.String "getoperationstatus"
|
||||||
toJSON SendMany = Data.Aeson.String "sendmany"
|
toJSON SendMany = Data.Aeson.String "sendmany"
|
||||||
|
toJSON ShieldNotes = Data.Aeson.String "shieldnotes"
|
||||||
toJSON UnknownMethod = Data.Aeson.Null
|
toJSON UnknownMethod = Data.Aeson.Null
|
||||||
|
|
||||||
instance FromJSON ZenithMethod where
|
instance FromJSON ZenithMethod where
|
||||||
|
@ -152,6 +155,7 @@ instance FromJSON ZenithMethod where
|
||||||
"getnewaddress" -> pure GetNewAddress
|
"getnewaddress" -> pure GetNewAddress
|
||||||
"getoperationstatus" -> pure GetOperationStatus
|
"getoperationstatus" -> pure GetOperationStatus
|
||||||
"sendmany" -> pure SendMany
|
"sendmany" -> pure SendMany
|
||||||
|
"shieldnotes" -> pure ShieldNotes
|
||||||
_ -> pure UnknownMethod
|
_ -> pure UnknownMethod
|
||||||
|
|
||||||
data ZenithParams
|
data ZenithParams
|
||||||
|
@ -167,6 +171,7 @@ data ZenithParams
|
||||||
| OpParams !ZenithUuid
|
| OpParams !ZenithUuid
|
||||||
| SendParams !Int ![ProposedNote] !PrivacyPolicy
|
| SendParams !Int ![ProposedNote] !PrivacyPolicy
|
||||||
| TestParams !T.Text
|
| TestParams !T.Text
|
||||||
|
| ShieldNotesParams !Int
|
||||||
deriving (Eq, Prelude.Show)
|
deriving (Eq, Prelude.Show)
|
||||||
|
|
||||||
instance ToJSON ZenithParams where
|
instance ToJSON ZenithParams where
|
||||||
|
@ -191,6 +196,7 @@ instance ToJSON ZenithParams where
|
||||||
Data.Aeson.Array $ V.fromList [Data.Aeson.String $ U.toText $ getUuid i]
|
Data.Aeson.Array $ V.fromList [Data.Aeson.String $ U.toText $ getUuid i]
|
||||||
toJSON (SendParams i ns p) =
|
toJSON (SendParams i ns p) =
|
||||||
Data.Aeson.Array $ V.fromList [jsonNumber i, toJSON ns, toJSON p]
|
Data.Aeson.Array $ V.fromList [jsonNumber i, toJSON ns, toJSON p]
|
||||||
|
toJSON (ShieldNotesParams i) = Data.Aeson.Array $ V.fromList [jsonNumber i]
|
||||||
|
|
||||||
data ZenithResponse
|
data ZenithResponse
|
||||||
= InfoResponse !T.Text !ZenithInfo
|
= InfoResponse !T.Text !ZenithInfo
|
||||||
|
@ -203,6 +209,7 @@ data ZenithResponse
|
||||||
| NewAddrResponse !T.Text !ZcashAddressAPI
|
| NewAddrResponse !T.Text !ZcashAddressAPI
|
||||||
| OpResponse !T.Text !Operation
|
| OpResponse !T.Text !Operation
|
||||||
| SendResponse !T.Text !U.UUID
|
| SendResponse !T.Text !U.UUID
|
||||||
|
| MultiOpResponse !T.Text ![T.Text]
|
||||||
| ErrorResponse !T.Text !Double !T.Text
|
| ErrorResponse !T.Text !Double !T.Text
|
||||||
deriving (Eq, Prelude.Show)
|
deriving (Eq, Prelude.Show)
|
||||||
|
|
||||||
|
@ -224,6 +231,7 @@ instance ToJSON ZenithResponse where
|
||||||
toJSON (NewAddrResponse i a) = packRpcResponse i a
|
toJSON (NewAddrResponse i a) = packRpcResponse i a
|
||||||
toJSON (OpResponse i u) = packRpcResponse i u
|
toJSON (OpResponse i u) = packRpcResponse i u
|
||||||
toJSON (SendResponse i o) = packRpcResponse i o
|
toJSON (SendResponse i o) = packRpcResponse i o
|
||||||
|
toJSON (MultiOpResponse i o) = packRpcResponse i o
|
||||||
|
|
||||||
instance FromJSON ZenithResponse where
|
instance FromJSON ZenithResponse where
|
||||||
parseJSON =
|
parseJSON =
|
||||||
|
@ -298,6 +306,12 @@ instance FromJSON ZenithResponse where
|
||||||
k5 <- parseJSON r1
|
k5 <- parseJSON r1
|
||||||
pure $ NoteListResponse i k5
|
pure $ NoteListResponse i k5
|
||||||
Nothing -> fail "Unknown object"
|
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"
|
_anyOther -> fail "Malformed JSON"
|
||||||
Number k -> do
|
Number k -> do
|
||||||
case floatingOrInteger k of
|
case floatingOrInteger k of
|
||||||
|
@ -489,6 +503,16 @@ instance FromJSON RpcCall where
|
||||||
_anyOther -> pure $ RpcCall v i SendMany BadParams
|
_anyOther -> pure $ RpcCall v i SendMany BadParams
|
||||||
else pure $ RpcCall v i SendMany BadParams
|
else pure $ RpcCall v i SendMany BadParams
|
||||||
_anyOther -> 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
|
type ZenithRPC
|
||||||
= "status" :> Get '[ JSON] Value :<|> BasicAuth "zenith-realm" Bool :> ReqBody
|
= "status" :> Get '[ JSON] Value :<|> BasicAuth "zenith-realm" Bool :> ReqBody
|
||||||
|
@ -871,6 +895,56 @@ zenithServer state = getinfo :<|> handleRPC
|
||||||
"Account does not exist."
|
"Account does not exist."
|
||||||
_anyOtherParams ->
|
_anyOtherParams ->
|
||||||
return $ ErrorResponse (callId req) (-32602) "Invalid params"
|
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 Bool
|
||||||
authenticate config = BasicAuthCheck check
|
authenticate config = BasicAuthCheck check
|
||||||
|
|
Loading…
Reference in a new issue