Milestone 3: RPC server, ZIP-320 #104
3 changed files with 105 additions and 46 deletions
|
@ -66,6 +66,7 @@ import Control.Monad (forever, unless, void, when)
|
||||||
import Control.Monad.IO.Class (liftIO)
|
import Control.Monad.IO.Class (liftIO)
|
||||||
import Control.Monad.Logger
|
import Control.Monad.Logger
|
||||||
( LoggingT
|
( LoggingT
|
||||||
|
, NoLoggingT
|
||||||
, logDebugN
|
, logDebugN
|
||||||
, runFileLoggingT
|
, runFileLoggingT
|
||||||
, runNoLoggingT
|
, runNoLoggingT
|
||||||
|
@ -88,7 +89,11 @@ import System.Hclip
|
||||||
import Text.Printf
|
import Text.Printf
|
||||||
import Text.Wrap (FillScope(..), FillStrategy(..), WrapSettings(..))
|
import Text.Wrap (FillScope(..), FillStrategy(..), WrapSettings(..))
|
||||||
import ZcashHaskell.Keys (generateWalletSeedPhrase)
|
import ZcashHaskell.Keys (generateWalletSeedPhrase)
|
||||||
import ZcashHaskell.Orchard (getSaplingFromUA, isValidUnifiedAddress)
|
import ZcashHaskell.Orchard
|
||||||
|
( getSaplingFromUA
|
||||||
|
, isValidUnifiedAddress
|
||||||
|
, parseAddress
|
||||||
|
)
|
||||||
import ZcashHaskell.Transparent (encodeTransparentReceiver)
|
import ZcashHaskell.Transparent (encodeTransparentReceiver)
|
||||||
import ZcashHaskell.Types
|
import ZcashHaskell.Types
|
||||||
import ZcashHaskell.Utils (getBlockTime, makeZebraCall)
|
import ZcashHaskell.Utils (getBlockTime, makeZebraCall)
|
||||||
|
@ -100,8 +105,10 @@ import Zenith.Types
|
||||||
, HexStringDB(..)
|
, HexStringDB(..)
|
||||||
, PhraseDB(..)
|
, PhraseDB(..)
|
||||||
, PrivacyPolicy(..)
|
, PrivacyPolicy(..)
|
||||||
|
, ProposedNote(..)
|
||||||
, ShieldDeshieldOp(..)
|
, ShieldDeshieldOp(..)
|
||||||
, UnifiedAddressDB(..)
|
, UnifiedAddressDB(..)
|
||||||
|
, ValidAddressAPI(..)
|
||||||
, ZcashNetDB(..)
|
, ZcashNetDB(..)
|
||||||
, ZenithStatus(..)
|
, ZenithStatus(..)
|
||||||
)
|
)
|
||||||
|
@ -805,7 +812,7 @@ scanZebra ::
|
||||||
-> Int
|
-> Int
|
||||||
-> BC.BChan Tick
|
-> BC.BChan Tick
|
||||||
-> ZcashNet
|
-> ZcashNet
|
||||||
-> LoggingT IO ()
|
-> NoLoggingT IO ()
|
||||||
scanZebra dbP zHost zPort b eChan znet = do
|
scanZebra dbP zHost zPort b eChan znet = do
|
||||||
bStatus <- liftIO $ checkBlockChain zHost zPort
|
bStatus <- liftIO $ checkBlockChain zHost zPort
|
||||||
pool <- liftIO $ runNoLoggingT $ initPool dbP
|
pool <- liftIO $ runNoLoggingT $ initPool dbP
|
||||||
|
@ -837,7 +844,7 @@ scanZebra dbP zHost zPort b eChan znet = do
|
||||||
_ <- liftIO $ startSync pool
|
_ <- liftIO $ startSync pool
|
||||||
mapM_ (liftIO . processBlock pool step) bList
|
mapM_ (liftIO . processBlock pool step) bList
|
||||||
confUp <-
|
confUp <-
|
||||||
liftIO $ try $ updateConfs zHost zPort pool :: LoggingT
|
liftIO $ try $ updateConfs zHost zPort pool :: NoLoggingT
|
||||||
IO
|
IO
|
||||||
(Either IOError ())
|
(Either IOError ())
|
||||||
case confUp of
|
case confUp of
|
||||||
|
@ -932,7 +939,7 @@ appEvent (BT.AppEvent t) = do
|
||||||
Just (_k, w) -> return w
|
Just (_k, w) -> return w
|
||||||
_ <-
|
_ <-
|
||||||
liftIO $
|
liftIO $
|
||||||
runFileLoggingT "zenith.log" $
|
runNoLoggingT $
|
||||||
syncWallet
|
syncWallet
|
||||||
(Config
|
(Config
|
||||||
(s ^. dbPath)
|
(s ^. dbPath)
|
||||||
|
@ -970,7 +977,7 @@ appEvent (BT.AppEvent t) = do
|
||||||
_ <-
|
_ <-
|
||||||
liftIO $
|
liftIO $
|
||||||
forkIO $
|
forkIO $
|
||||||
runFileLoggingT "zenith.log" $
|
runNoLoggingT $
|
||||||
scanZebra
|
scanZebra
|
||||||
(s ^. dbPath)
|
(s ^. dbPath)
|
||||||
(s ^. zebraHost)
|
(s ^. zebraHost)
|
||||||
|
@ -1194,6 +1201,7 @@ appEvent (BT.VtyEvent e) = do
|
||||||
(fs1 ^. sendAmt)
|
(fs1 ^. sendAmt)
|
||||||
(fs1 ^. sendTo)
|
(fs1 ^. sendTo)
|
||||||
(fs1 ^. sendMemo)
|
(fs1 ^. sendMemo)
|
||||||
|
(fs1 ^. policyField)
|
||||||
BT.modify $ set msg "Preparing transaction..."
|
BT.modify $ set msg "Preparing transaction..."
|
||||||
BT.modify $ set displayBox SendDisplay
|
BT.modify $ set displayBox SendDisplay
|
||||||
BT.modify $ set dialogBox Blank
|
BT.modify $ set dialogBox Blank
|
||||||
|
@ -1233,7 +1241,7 @@ appEvent (BT.VtyEvent e) = do
|
||||||
"Address copied to Clipboard from >>\n" ++
|
"Address copied to Clipboard from >>\n" ++
|
||||||
T.unpack (addressBookAbdescrip (entityVal a))
|
T.unpack (addressBookAbdescrip (entityVal a))
|
||||||
BT.modify $ set displayBox MsgDisplay
|
BT.modify $ set displayBox MsgDisplay
|
||||||
_ -> do
|
_any -> do
|
||||||
BT.modify $
|
BT.modify $
|
||||||
set msg "Error while copying the address!!"
|
set msg "Error while copying the address!!"
|
||||||
BT.modify $ set displayBox MsgDisplay
|
BT.modify $ set displayBox MsgDisplay
|
||||||
|
@ -1425,7 +1433,21 @@ appEvent (BT.VtyEvent e) = do
|
||||||
BT.modify $ set dialogBox SendTx
|
BT.modify $ set dialogBox SendTx
|
||||||
V.EvKey (V.KChar 'b') [] ->
|
V.EvKey (V.KChar 'b') [] ->
|
||||||
BT.modify $ set dialogBox AdrBook
|
BT.modify $ set dialogBox AdrBook
|
||||||
V.EvKey (V.KChar 'd') [] ->
|
V.EvKey (V.KChar 'd') [] -> do
|
||||||
|
pool <- liftIO $ runNoLoggingT $ initPool $ s ^. dbPath
|
||||||
|
selAcc <-
|
||||||
|
do case L.listSelectedElement $ s ^. accounts of
|
||||||
|
Nothing -> do
|
||||||
|
let fAcc =
|
||||||
|
L.listSelectedElement $
|
||||||
|
L.listMoveToBeginning $ s ^. accounts
|
||||||
|
case fAcc of
|
||||||
|
Nothing ->
|
||||||
|
throw $
|
||||||
|
userError "Failed to select wallet"
|
||||||
|
Just (_j, w1) -> return w1
|
||||||
|
Just (_k, w) -> return w
|
||||||
|
c <- liftIO $ getPoolBalance pool $ entityKey selAcc
|
||||||
BT.modify $ set dialogBox ShieldDeshieldForm
|
BT.modify $ set dialogBox ShieldDeshieldForm
|
||||||
ev ->
|
ev ->
|
||||||
case r of
|
case r of
|
||||||
|
@ -1781,15 +1803,30 @@ sendTransaction ::
|
||||||
-> Float
|
-> Float
|
||||||
-> T.Text
|
-> T.Text
|
||||||
-> T.Text
|
-> T.Text
|
||||||
|
-> PrivacyPolicy
|
||||||
-> IO ()
|
-> IO ()
|
||||||
sendTransaction pool chan zHost zPort znet accId bl amt ua memo = do
|
sendTransaction pool chan zHost zPort znet accId bl amt ua memo policy = do
|
||||||
BC.writeBChan chan $ TickMsg "Preparing transaction..."
|
BC.writeBChan chan $ TickMsg "Preparing transaction..."
|
||||||
case parseAddressUA ua znet of
|
case parseAddress (E.encodeUtf8 ua) of
|
||||||
Nothing -> BC.writeBChan chan $ TickMsg "Incorrect address"
|
Nothing -> BC.writeBChan chan $ TickMsg "Incorrect address"
|
||||||
Just outUA -> do
|
Just outUA -> do
|
||||||
res <-
|
res <-
|
||||||
runFileLoggingT "zenith.log" $
|
runNoLoggingT $
|
||||||
prepareTx pool zHost zPort znet accId bl amt outUA memo
|
prepareTxV2
|
||||||
|
pool
|
||||||
|
zHost
|
||||||
|
zPort
|
||||||
|
znet
|
||||||
|
accId
|
||||||
|
bl
|
||||||
|
[ ProposedNote
|
||||||
|
(ValidAddressAPI outUA)
|
||||||
|
amt
|
||||||
|
(if memo == ""
|
||||||
|
then Nothing
|
||||||
|
else Just memo)
|
||||||
|
]
|
||||||
|
policy
|
||||||
BC.writeBChan chan $ TickMsg "Transaction ready, sending to Zebra..."
|
BC.writeBChan chan $ TickMsg "Transaction ready, sending to Zebra..."
|
||||||
case res of
|
case res of
|
||||||
Left e -> BC.writeBChan chan $ TickMsg $ show e
|
Left e -> BC.writeBChan chan $ TickMsg $ show e
|
||||||
|
|
|
@ -750,7 +750,7 @@ shieldTransparentNotes ::
|
||||||
-> ZcashNet
|
-> ZcashNet
|
||||||
-> ZcashAccountId
|
-> ZcashAccountId
|
||||||
-> Int
|
-> Int
|
||||||
-> NoLoggingT IO (Either TxError HexString)
|
-> NoLoggingT IO [Either TxError HexString]
|
||||||
shieldTransparentNotes pool zebraHost zebraPort znet za bh = do
|
shieldTransparentNotes pool zebraHost zebraPort 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
|
||||||
|
@ -760,9 +760,16 @@ shieldTransparentNotes pool zebraHost zebraPort znet za bh = do
|
||||||
case accRead of
|
case accRead of
|
||||||
Nothing -> do
|
Nothing -> do
|
||||||
logErrorN "Can't find Account"
|
logErrorN "Can't find Account"
|
||||||
return $ Left ZHError
|
return [Left ZHError]
|
||||||
Just acc -> do
|
Just acc -> do
|
||||||
trNotes <- liftIO $ getWalletUnspentTrNotes pool za
|
trNotes' <- liftIO $ getWalletUnspentTrNotes pool za
|
||||||
|
dRecvs <- liftIO $ getReceivers pool trNotes'
|
||||||
|
let fNotes =
|
||||||
|
map
|
||||||
|
(\x ->
|
||||||
|
filter (\y -> walletTrNoteAddress (entityVal y) == x) trNotes')
|
||||||
|
dRecvs
|
||||||
|
forM fNotes $ \trNotes -> do
|
||||||
let noteTotal = getTotalAmount (trNotes, [], [])
|
let noteTotal = getTotalAmount (trNotes, [], [])
|
||||||
let fee = calculateTxFee (trNotes, [], []) 4
|
let fee = calculateTxFee (trNotes, [], []) 4
|
||||||
tSpends <-
|
tSpends <-
|
||||||
|
@ -771,9 +778,11 @@ shieldTransparentNotes pool zebraHost zebraPort znet za bh = do
|
||||||
(getTranSK $ zcashAccountTPrivateKey $ entityVal acc)
|
(getTranSK $ zcashAccountTPrivateKey $ entityVal acc)
|
||||||
trNotes
|
trNotes
|
||||||
chgAddr <- getInternalAddresses pool $ entityKey acc
|
chgAddr <- getInternalAddresses pool $ entityKey acc
|
||||||
let internalUA = getUA $ walletAddressUAddress $ entityVal $ head chgAddr
|
let internalUA =
|
||||||
|
getUA $ walletAddressUAddress $ entityVal $ head chgAddr
|
||||||
let oRcvr =
|
let oRcvr =
|
||||||
fromJust $ o_rec =<< isValidUnifiedAddress (E.encodeUtf8 internalUA)
|
fromJust $
|
||||||
|
o_rec =<< isValidUnifiedAddress (E.encodeUtf8 internalUA)
|
||||||
let snote =
|
let snote =
|
||||||
OutgoingNote
|
OutgoingNote
|
||||||
4
|
4
|
||||||
|
|
|
@ -2430,6 +2430,19 @@ saveConfs pool b c = do
|
||||||
set bl [ZcashBlockConf =. val c]
|
set bl [ZcashBlockConf =. val c]
|
||||||
where_ $ bl ^. ZcashBlockHeight ==. val b
|
where_ $ bl ^. ZcashBlockHeight ==. val b
|
||||||
|
|
||||||
|
getReceivers :: ConnectionPool -> [Entity WalletTrNote] -> IO [WalletAddressId]
|
||||||
|
getReceivers pool ns = do
|
||||||
|
r <-
|
||||||
|
runNoLoggingT $
|
||||||
|
PS.retryOnBusy $
|
||||||
|
flip PS.runSqlPool pool $ do
|
||||||
|
select $
|
||||||
|
distinct $ do
|
||||||
|
t <- from $ table @WalletTrNote
|
||||||
|
where_ (t ^. WalletTrNoteId `in_` valList (map entityKey ns))
|
||||||
|
return (t ^. WalletTrNoteAddress)
|
||||||
|
return $ map (\(Value x) -> x) r
|
||||||
|
|
||||||
-- | Helper function to extract a Unified Address from the database
|
-- | Helper function to extract a Unified Address from the database
|
||||||
readUnifiedAddressDB :: WalletAddress -> Maybe UnifiedAddress
|
readUnifiedAddressDB :: WalletAddress -> Maybe UnifiedAddress
|
||||||
readUnifiedAddressDB =
|
readUnifiedAddressDB =
|
||||||
|
|
Loading…
Reference in a new issue