RPC Server #103
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.Logger
|
||||
( LoggingT
|
||||
, NoLoggingT
|
||||
, logDebugN
|
||||
, runFileLoggingT
|
||||
, runNoLoggingT
|
||||
|
|
@ -88,7 +89,11 @@ import System.Hclip
|
|||
import Text.Printf
|
||||
import Text.Wrap (FillScope(..), FillStrategy(..), WrapSettings(..))
|
||||
import ZcashHaskell.Keys (generateWalletSeedPhrase)
|
||||
import ZcashHaskell.Orchard (getSaplingFromUA, isValidUnifiedAddress)
|
||||
import ZcashHaskell.Orchard
|
||||
( getSaplingFromUA
|
||||
, isValidUnifiedAddress
|
||||
, parseAddress
|
||||
)
|
||||
import ZcashHaskell.Transparent (encodeTransparentReceiver)
|
||||
import ZcashHaskell.Types
|
||||
import ZcashHaskell.Utils (getBlockTime, makeZebraCall)
|
||||
|
|
@ -100,8 +105,10 @@ import Zenith.Types
|
|||
, HexStringDB(..)
|
||||
, PhraseDB(..)
|
||||
, PrivacyPolicy(..)
|
||||
, ProposedNote(..)
|
||||
, ShieldDeshieldOp(..)
|
||||
, UnifiedAddressDB(..)
|
||||
, ValidAddressAPI(..)
|
||||
, ZcashNetDB(..)
|
||||
, ZenithStatus(..)
|
||||
)
|
||||
|
|
@ -805,7 +812,7 @@ scanZebra ::
|
|||
-> Int
|
||||
-> BC.BChan Tick
|
||||
-> ZcashNet
|
||||
-> LoggingT IO ()
|
||||
-> NoLoggingT IO ()
|
||||
scanZebra dbP zHost zPort b eChan znet = do
|
||||
bStatus <- liftIO $ checkBlockChain zHost zPort
|
||||
pool <- liftIO $ runNoLoggingT $ initPool dbP
|
||||
|
|
@ -837,7 +844,7 @@ scanZebra dbP zHost zPort b eChan znet = do
|
|||
_ <- liftIO $ startSync pool
|
||||
mapM_ (liftIO . processBlock pool step) bList
|
||||
confUp <-
|
||||
liftIO $ try $ updateConfs zHost zPort pool :: LoggingT
|
||||
liftIO $ try $ updateConfs zHost zPort pool :: NoLoggingT
|
||||
IO
|
||||
(Either IOError ())
|
||||
case confUp of
|
||||
|
|
@ -932,7 +939,7 @@ appEvent (BT.AppEvent t) = do
|
|||
Just (_k, w) -> return w
|
||||
_ <-
|
||||
liftIO $
|
||||
runFileLoggingT "zenith.log" $
|
||||
runNoLoggingT $
|
||||
syncWallet
|
||||
(Config
|
||||
(s ^. dbPath)
|
||||
|
|
@ -970,7 +977,7 @@ appEvent (BT.AppEvent t) = do
|
|||
_ <-
|
||||
liftIO $
|
||||
forkIO $
|
||||
runFileLoggingT "zenith.log" $
|
||||
runNoLoggingT $
|
||||
scanZebra
|
||||
(s ^. dbPath)
|
||||
(s ^. zebraHost)
|
||||
|
|
@ -1194,6 +1201,7 @@ appEvent (BT.VtyEvent e) = do
|
|||
(fs1 ^. sendAmt)
|
||||
(fs1 ^. sendTo)
|
||||
(fs1 ^. sendMemo)
|
||||
(fs1 ^. policyField)
|
||||
BT.modify $ set msg "Preparing transaction..."
|
||||
BT.modify $ set displayBox SendDisplay
|
||||
BT.modify $ set dialogBox Blank
|
||||
|
|
@ -1233,7 +1241,7 @@ appEvent (BT.VtyEvent e) = do
|
|||
"Address copied to Clipboard from >>\n" ++
|
||||
T.unpack (addressBookAbdescrip (entityVal a))
|
||||
BT.modify $ set displayBox MsgDisplay
|
||||
_ -> do
|
||||
_any -> do
|
||||
BT.modify $
|
||||
set msg "Error while copying the address!!"
|
||||
BT.modify $ set displayBox MsgDisplay
|
||||
|
|
@ -1425,7 +1433,21 @@ appEvent (BT.VtyEvent e) = do
|
|||
BT.modify $ set dialogBox SendTx
|
||||
V.EvKey (V.KChar 'b') [] ->
|
||||
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
|
||||
ev ->
|
||||
case r of
|
||||
|
|
@ -1781,15 +1803,30 @@ sendTransaction ::
|
|||
-> Float
|
||||
-> T.Text
|
||||
-> T.Text
|
||||
-> PrivacyPolicy
|
||||
-> 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..."
|
||||
case parseAddressUA ua znet of
|
||||
case parseAddress (E.encodeUtf8 ua) of
|
||||
Nothing -> BC.writeBChan chan $ TickMsg "Incorrect address"
|
||||
Just outUA -> do
|
||||
res <-
|
||||
runFileLoggingT "zenith.log" $
|
||||
prepareTx pool zHost zPort znet accId bl amt outUA memo
|
||||
runNoLoggingT $
|
||||
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..."
|
||||
case res of
|
||||
Left e -> BC.writeBChan chan $ TickMsg $ show e
|
||||
|
|
|
|||
|
|
@ -750,7 +750,7 @@ shieldTransparentNotes ::
|
|||
-> ZcashNet
|
||||
-> ZcashAccountId
|
||||
-> Int
|
||||
-> NoLoggingT IO (Either TxError HexString)
|
||||
-> NoLoggingT IO [Either TxError HexString]
|
||||
shieldTransparentNotes pool zebraHost zebraPort znet za bh = do
|
||||
accRead <- liftIO $ getAccountById pool za
|
||||
logDebugN $ T.pack $ "Target block: " ++ show bh
|
||||
|
|
@ -760,41 +760,50 @@ shieldTransparentNotes pool zebraHost zebraPort znet za bh = do
|
|||
case accRead of
|
||||
Nothing -> do
|
||||
logErrorN "Can't find Account"
|
||||
return $ Left ZHError
|
||||
return [Left ZHError]
|
||||
Just acc -> do
|
||||
trNotes <- liftIO $ getWalletUnspentTrNotes pool za
|
||||
let noteTotal = getTotalAmount (trNotes, [], [])
|
||||
let fee = calculateTxFee (trNotes, [], []) 4
|
||||
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 snote =
|
||||
OutgoingNote
|
||||
4
|
||||
(getBytes $ getOrchSK $ zcashAccountOrchSpendKey $ entityVal acc)
|
||||
(getBytes oRcvr)
|
||||
(fromIntegral $ noteTotal - fee)
|
||||
""
|
||||
True
|
||||
let tx =
|
||||
createTransaction
|
||||
(Just sT)
|
||||
(Just oT)
|
||||
tSpends
|
||||
[]
|
||||
[]
|
||||
[snote]
|
||||
znet
|
||||
(bh + 3)
|
||||
True
|
||||
logDebugN $ T.pack $ show tx
|
||||
return tx
|
||||
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 fee = calculateTxFee (trNotes, [], []) 4
|
||||
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 snote =
|
||||
OutgoingNote
|
||||
4
|
||||
(getBytes $ getOrchSK $ zcashAccountOrchSpendKey $ entityVal acc)
|
||||
(getBytes oRcvr)
|
||||
(fromIntegral $ noteTotal - fee)
|
||||
""
|
||||
True
|
||||
let tx =
|
||||
createTransaction
|
||||
(Just sT)
|
||||
(Just oT)
|
||||
tSpends
|
||||
[]
|
||||
[]
|
||||
[snote]
|
||||
znet
|
||||
(bh + 3)
|
||||
True
|
||||
logDebugN $ T.pack $ show tx
|
||||
return tx
|
||||
where
|
||||
getTotalAmount ::
|
||||
( [Entity WalletTrNote]
|
||||
|
|
|
|||
|
|
@ -2430,6 +2430,19 @@ saveConfs pool b c = do
|
|||
set bl [ZcashBlockConf =. val c]
|
||||
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
|
||||
readUnifiedAddressDB :: WalletAddress -> Maybe UnifiedAddress
|
||||
readUnifiedAddressDB =
|
||||
|
|
|
|||
Loading…
Reference in a new issue