Vergara_Tech/zenith
Vergara_Tech/zenith
2
0
Fork 0
Code Issues 24 Pull requests Projects Releases 6 Packages Wiki Activity

feat: update amount reading to Scientific

Browse source
This commit is contained in:
Rene Vergara 2024-10-22 07:21:12 -05:00
parent c0031e91fd
commit d72f355981
Signed by: pitmutt
GPG key ID: 65122AD495A7F5B2
8 changed files with 396 additions and 300 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

31
src/Zenith/CLI.hs
View file

@ -75,6 +75,7 @@ import Control.Monad.Logger
import Data.Aeson import Data.Aeson
import Data.HexString (HexString(..), toText) import Data.HexString (HexString(..), toText)
import Data.Maybe import Data.Maybe
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)
@ -119,10 +120,10 @@ import Zenith.Types
import Zenith.Utils import Zenith.Utils
( displayTaz ( displayTaz
, displayZec , displayZec
, getChainTip
, isRecipientValid , isRecipientValid
, isRecipientValidGUI , isRecipientValidGUI
, jsonNumber , jsonNumber
, parseAddressUA
, showAddress , showAddress
, validBarValue , validBarValue
) )
@ -159,7 +160,7 @@ makeLenses ''DialogInput
data SendInput = SendInput data SendInput = SendInput
{ _sendTo :: !T.Text { _sendTo :: !T.Text
, _sendAmt :: !Float , _sendAmt :: !Scientific
, _sendMemo :: !T.Text , _sendMemo :: !T.Text
, _policyField :: !PrivacyPolicy , _policyField :: !PrivacyPolicy
} deriving (Show) } deriving (Show)
@ -174,7 +175,7 @@ data AdrBookEntry = AdrBookEntry
makeLenses ''AdrBookEntry makeLenses ''AdrBookEntry
newtype ShDshEntry = ShDshEntry newtype ShDshEntry = ShDshEntry
{ _shAmt :: Float { _shAmt :: Scientific
} deriving (Show) } deriving (Show)
makeLenses ''ShDshEntry makeLenses ''ShDshEntry
@ -701,8 +702,8 @@ mkSendForm bal =
, label "Memo: " @@= editTextField sendMemo MemoField (Just 1) , label "Memo: " @@= editTextField sendMemo MemoField (Just 1)
] ]
where where
isAmountValid :: Integer -> Float -> Bool isAmountValid :: Integer -> Scientific -> Bool
isAmountValid b i = (fromIntegral b / 100000000.0) >= i isAmountValid b i = fromIntegral b >= (i * scientific 1 8)
label s w = label s w =
padBottom (Pad 1) $ vLimit 1 (hLimit 15 $ str s <+> fill ' ') <+> w padBottom (Pad 1) $ vLimit 1 (hLimit 15 $ str s <+> fill ' ') <+> w
@ -713,8 +714,8 @@ mkDeshieldForm tbal =
editShowableFieldWithValidate shAmt AmtField (isAmountValid tbal) editShowableFieldWithValidate shAmt AmtField (isAmountValid tbal)
] ]
where where
isAmountValid :: Integer -> Float -> Bool isAmountValid :: Integer -> Scientific -> Bool
isAmountValid b i = (fromIntegral b / 100000000.0) >= i isAmountValid b i = fromIntegral b >= (i * scientific 1 8)
label s w = label s w =
padBottom (Pad 1) $ vLimit 1 (hLimit 15 $ str s <+> fill ' ') <+> w padBottom (Pad 1) $ vLimit 1 (hLimit 15 $ str s <+> fill ' ') <+> w
@ -1201,7 +1202,8 @@ appEvent (BT.VtyEvent e) = do
Just (_k, w) -> return w Just (_k, w) -> return w
fs1 <- BT.zoom txForm $ BT.gets formState fs1 <- BT.zoom txForm $ BT.gets formState
bl <- bl <-
liftIO $ getLastSyncBlock pool $ entityKey selWal liftIO $
getChainTip (s ^. zebraHost) (s ^. zebraPort)
_ <- _ <-
liftIO $ liftIO $
forkIO $ forkIO $
@ -1212,7 +1214,7 @@ appEvent (BT.VtyEvent e) = do
(s ^. zebraPort) (s ^. zebraPort)
(s ^. network) (s ^. network)
(entityKey selAcc) (entityKey selAcc)
bl (bl + 5)
(fs1 ^. sendAmt) (fs1 ^. sendAmt)
(fs1 ^. sendTo) (fs1 ^. sendTo)
(fs1 ^. sendMemo) (fs1 ^. sendMemo)
@ -1292,7 +1294,8 @@ appEvent (BT.VtyEvent e) = do
getUA . walletAddressUAddress) getUA . walletAddressUAddress)
(entityVal selAddr))) (entityVal selAddr)))
bl <- bl <-
liftIO $ getLastSyncBlock pool $ entityKey selWal liftIO $
getChainTip (s ^. zebraHost) (s ^. zebraPort)
case tAddrMaybe of case tAddrMaybe of
Nothing -> do Nothing -> do
BT.modify $ BT.modify $
@ -1994,7 +1997,7 @@ sendTransaction ::
-> ZcashNet -> ZcashNet
-> ZcashAccountId -> ZcashAccountId
-> Int -> Int
-> Float -> Scientific
-> T.Text -> T.Text
-> T.Text -> T.Text
-> PrivacyPolicy -> PrivacyPolicy
@ -2005,7 +2008,7 @@ sendTransaction pool chan zHost zPort znet accId bl amt ua memo policy = do
Nothing -> BC.writeBChan chan $ TickMsg "Incorrect address" Nothing -> BC.writeBChan chan $ TickMsg "Incorrect address"
Just outUA -> do Just outUA -> do
res <- res <-
runNoLoggingT $ runStderrLoggingT $
prepareTxV2 prepareTxV2
pool pool
zHost zHost
@ -2021,10 +2024,10 @@ sendTransaction pool chan zHost zPort znet accId bl amt ua memo policy = do
else Just memo) else Just memo)
] ]
policy policy
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
Right rawTx -> do Right rawTx -> do
BC.writeBChan chan $ TickMsg "Transaction ready, sending to Zebra..."
resp <- resp <-
makeZebraCall makeZebraCall
zHost zHost
@ -2073,7 +2076,7 @@ deshieldTransaction ::
-> IO () -> IO ()
deshieldTransaction pool chan zHost zPort znet accId bl pnote = do deshieldTransaction pool chan zHost zPort znet accId bl pnote = do
BC.writeBChan chan $ TickMsg "Deshielding funds..." BC.writeBChan chan $ TickMsg "Deshielding funds..."
res <- runNoLoggingT $ deshieldNotes pool zHost zPort znet accId bl pnote res <- runStderrLoggingT $ deshieldNotes pool zHost zPort znet accId bl pnote
case res of case res of
Left e -> BC.writeBChan chan $ TickMsg $ show e Left e -> BC.writeBChan chan $ TickMsg $ show e
Right rawTx -> do Right rawTx -> do

182
src/Zenith/Core.hs
View file

@ -23,11 +23,11 @@ import Data.Aeson
import Data.Binary.Get hiding (getBytes) import Data.Binary.Get hiding (getBytes)
import qualified Data.ByteString as BS import qualified Data.ByteString as BS
import qualified Data.ByteString.Lazy as LBS import qualified Data.ByteString.Lazy as LBS
import Data.Digest.Pure.MD5 import Data.HexString (HexString, toBytes)
import Data.HexString (HexString, hexString, toBytes, toText) import Data.Int (Int64)
import Data.List import Data.List
import Data.Maybe (fromJust, fromMaybe) import Data.Maybe (fromJust, fromMaybe)
import Data.Pool (Pool) 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
@ -280,7 +280,7 @@ findSaplingOutputs ::
-> Int -- ^ the starting block -> Int -- ^ the starting block
-> ZcashNetDB -- ^ The network -> ZcashNetDB -- ^ The network
-> Entity ZcashAccount -- ^ The account to use -> Entity ZcashAccount -- ^ The account to use
-> LoggingT IO () -> NoLoggingT IO ()
findSaplingOutputs config b znet za = do findSaplingOutputs config b znet za = do
let dbPath = c_dbPath config let dbPath = c_dbPath config
let zebraHost = c_zebraHost config let zebraHost = c_zebraHost config
@ -307,7 +307,7 @@ findSaplingOutputs config b znet za = do
-> ZcashNet -> ZcashNet
-> ConnectionPool -> ConnectionPool
-> [(Entity ZcashTransaction, Entity ShieldOutput)] -> [(Entity ZcashTransaction, Entity ShieldOutput)]
-> LoggingT IO () -> NoLoggingT IO ()
decryptNotes _ _ _ [] = return () decryptNotes _ _ _ [] = return ()
decryptNotes st n pool ((zt, o):txs) = do decryptNotes st n pool ((zt, o):txs) = do
let updatedTree = let updatedTree =
@ -478,7 +478,7 @@ updateSaplingWitnesses pool = do
updateOneNote maxId n = do updateOneNote maxId n = do
let noteSync = walletSapNoteWitPos $ entityVal n let noteSync = walletSapNoteWitPos $ entityVal n
when (noteSync < maxId) $ do when (noteSync < maxId) $ do
cmus <- liftIO $ getSaplingCmus pool $ walletSapNoteWitPos $ entityVal n cmus <- liftIO $ getSaplingCmus pool noteSync maxId
let cmuList = map (\(ESQ.Value x) -> getHex x) cmus let cmuList = map (\(ESQ.Value x) -> getHex x) cmus
let newWitness = let newWitness =
updateSaplingWitness updateSaplingWitness
@ -496,7 +496,7 @@ updateOrchardWitnesses pool = do
updateOneNote maxId n = do updateOneNote maxId n = do
let noteSync = walletOrchNoteWitPos $ entityVal n let noteSync = walletOrchNoteWitPos $ entityVal n
when (noteSync < maxId) $ do when (noteSync < maxId) $ do
cmxs <- liftIO $ getOrchardCmxs pool noteSync cmxs <- liftIO $ getOrchardCmxs pool noteSync maxId
let cmxList = map (\(ESQ.Value x) -> getHex x) cmxs let cmxList = map (\(ESQ.Value x) -> getHex x) cmxs
let newWitness = let newWitness =
updateOrchardWitness updateOrchardWitness
@ -534,7 +534,7 @@ prepareTx ::
-> ZcashNet -> ZcashNet
-> ZcashAccountId -> ZcashAccountId
-> Int -> Int
-> Float -> Scientific
-> UnifiedAddress -> UnifiedAddress
-> T.Text -> T.Text
-> LoggingT IO (Either TxError HexString) -> LoggingT IO (Either TxError HexString)
@ -564,12 +564,16 @@ prepareTx pool zebraHost zebraPort zn za bh amt ua memo = do
return $ Left ZHError return $ Left ZHError
Just acc -> do Just acc -> do
logDebugN $ T.pack $ show acc logDebugN $ T.pack $ show acc
let zats = floorFloatInteger $ amt * (10 ^ 8) let zats' = toBoundedInteger $ amt * scientific 1 8
logDebugN $ T.pack $ show zats case zats' of
Nothing -> return $ Left ZHError
Just zats -> do
logDebugN $ T.pack $ show (zats :: Int64)
{-firstPass <- liftIO $ selectUnspentNotes pool za zats-} {-firstPass <- liftIO $ selectUnspentNotes pool za zats-}
--let fee = calculateTxFee firstPass $ fst recipient --let fee = calculateTxFee firstPass $ fst recipient
--logDebugN $ T.pack $ "calculated fee " ++ show fee --logDebugN $ T.pack $ "calculated fee " ++ show fee
(tList, sList, oList) <- liftIO $ selectUnspentNotes pool za (zats + 5000) (tList, sList, oList) <-
liftIO $ selectUnspentNotes pool za (fromIntegral $ zats + 5000)
logDebugN "selected notes" logDebugN "selected notes"
logDebugN $ T.pack $ show tList logDebugN $ T.pack $ show tList
logDebugN $ T.pack $ show sList logDebugN $ T.pack $ show sList
@ -577,18 +581,29 @@ prepareTx pool zebraHost zebraPort zn za bh amt ua memo = do
let noteTotal = getTotalAmount (tList, sList, oList) let noteTotal = getTotalAmount (tList, sList, oList)
tSpends <- tSpends <-
liftIO $ liftIO $
prepTSpends (getTranSK $ zcashAccountTPrivateKey $ entityVal acc) tList prepTSpends
(getTranSK $ zcashAccountTPrivateKey $ entityVal acc)
tList
--print tSpends --print tSpends
sSpends <- sSpends <-
liftIO $ liftIO $
prepSSpends (getSapSK $ zcashAccountSapSpendKey $ entityVal acc) sList prepSSpends
(getSapSK $ zcashAccountSapSpendKey $ entityVal acc)
sList
--print sSpends --print sSpends
oSpends <- oSpends <-
liftIO $ liftIO $
prepOSpends (getOrchSK $ zcashAccountOrchSpendKey $ entityVal acc) oList prepOSpends
(getOrchSK $ zcashAccountOrchSpendKey $ entityVal acc)
oList
--print oSpends --print oSpends
dummy <- dummy <-
liftIO $ makeOutgoing acc recipient zats (noteTotal - 5000 - zats) liftIO $
makeOutgoing
acc
recipient
zats
(fromInteger noteTotal - 5000 - zats)
logDebugN "Calculating fee" logDebugN "Calculating fee"
let feeResponse = let feeResponse =
createTransaction createTransaction
@ -599,21 +614,27 @@ prepareTx pool zebraHost zebraPort zn za bh amt ua memo = do
oSpends oSpends
dummy dummy
zn zn
(bh + 3) bh
False False
case feeResponse of case feeResponse of
Left e1 -> return $ Left Fee Left e1 -> return $ Left Fee
Right fee -> do Right fee -> do
let feeAmt = let feeAmt =
fromIntegral (runGet getInt64le $ LBS.fromStrict $ toBytes fee) fromIntegral
(runGet getInt64le $ LBS.fromStrict $ toBytes fee)
(tList1, sList1, oList1) <- (tList1, sList1, oList1) <-
liftIO $ selectUnspentNotes pool za (zats + feeAmt) liftIO $ selectUnspentNotes pool za (fromIntegral zats + feeAmt)
logDebugN $ T.pack $ "selected notes with fee" ++ show feeAmt logDebugN $ T.pack $ "selected notes with fee" ++ show feeAmt
logDebugN $ T.pack $ show tList logDebugN $ T.pack $ show tList
logDebugN $ T.pack $ show sList logDebugN $ T.pack $ show sList
logDebugN $ T.pack $ show oList logDebugN $ T.pack $ show oList
outgoing <- outgoing <-
liftIO $ makeOutgoing acc recipient zats (noteTotal - feeAmt - zats) liftIO $
makeOutgoing
acc
recipient
zats
(fromInteger noteTotal - fromInteger feeAmt - zats)
logDebugN $ T.pack $ show outgoing logDebugN $ T.pack $ show outgoing
let tx = let tx =
createTransaction createTransaction
@ -624,7 +645,7 @@ prepareTx pool zebraHost zebraPort zn za bh amt ua memo = do
oSpends oSpends
outgoing outgoing
zn zn
(bh + 3) bh
True True
logDebugN $ T.pack $ show tx logDebugN $ T.pack $ show tx
return tx return tx
@ -632,8 +653,8 @@ prepareTx pool zebraHost zebraPort zn za bh amt ua memo = do
makeOutgoing :: makeOutgoing ::
Entity ZcashAccount Entity ZcashAccount
-> (Int, BS.ByteString) -> (Int, BS.ByteString)
-> Integer -> Int64
-> Integer -> Int64
-> IO [OutgoingNote] -> IO [OutgoingNote]
makeOutgoing acc (k, recvr) zats chg = do makeOutgoing acc (k, recvr) zats chg = do
chgAddr <- runNoLoggingT $ getInternalAddresses pool $ entityKey acc chgAddr <- runNoLoggingT $ getInternalAddresses pool $ entityKey acc
@ -752,11 +773,11 @@ deshieldNotes ::
-> ZcashAccountId -> ZcashAccountId
-> Int -> Int
-> ProposedNote -> ProposedNote
-> NoLoggingT IO (Either TxError HexString) -> LoggingT IO (Either TxError HexString)
deshieldNotes pool zebraHost zebraPort znet za bh pnote = do deshieldNotes pool zebraHost zebraPort znet za bh pnote = do
bal <- liftIO $ getShieldedBalance pool za bal <- liftIO $ getShieldedBalance pool za
let zats = ceilingFloatInteger $ pn_amt pnote * (10 ^ 8) let zats = pn_amt pnote * scientific 1 8
if bal > (20000 + zats) if fromInteger bal > (scientific 2 4 + zats)
then prepareTxV2 pool zebraHost zebraPort znet za bh [pnote] Low then prepareTxV2 pool zebraHost zebraPort znet za bh [pnote] Low
else return $ Left InsufficientFunds else return $ Left InsufficientFunds
@ -771,9 +792,11 @@ shieldTransparentNotes ::
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
trees <- liftIO $ getCommitmentTrees zebraHost zebraPort bh {-
let sT = SaplingCommitmentTree $ ztiSapling trees -trees <- liftIO $ getCommitmentTrees zebraHost zebraPort bh
let oT = OrchardCommitmentTree $ ztiOrchard trees -let sT = SaplingCommitmentTree $ ztiSapling trees
-let oT = OrchardCommitmentTree $ ztiOrchard trees
-}
case accRead of case accRead of
Nothing -> do Nothing -> do
logErrorN "Can't find Account" logErrorN "Can't find Account"
@ -810,8 +833,8 @@ shieldTransparentNotes pool zebraHost zebraPort znet za bh = do
True True
let tx = let tx =
createTransaction createTransaction
(Just sT) Nothing
(Just oT) Nothing
tSpends tSpends
[] []
[] []
@ -871,15 +894,17 @@ prepareTxV2 ::
-> Int -> Int
-> [ProposedNote] -> [ProposedNote]
-> PrivacyPolicy -> PrivacyPolicy
-> NoLoggingT IO (Either TxError HexString) -> LoggingT IO (Either TxError HexString)
prepareTxV2 pool zebraHost zebraPort zn za bh pnotes policy = do prepareTxV2 pool zebraHost zebraPort zn za bh pnotes policy = do
accRead <- liftIO $ getAccountById pool za accRead <- liftIO $ getAccountById pool za
let recipients = map extractReceiver pnotes let recipients = map extractReceiver pnotes
logDebugN $ T.pack $ show recipients logDebugN $ T.pack $ show recipients
logDebugN $ T.pack $ "Target block: " ++ show bh logDebugN $ T.pack $ "Target block: " ++ show bh
trees <- liftIO $ getCommitmentTrees zebraHost zebraPort bh {-
let sT = SaplingCommitmentTree $ ztiSapling trees -trees <- liftIO $ getCommitmentTrees zebraHost zebraPort bh
let oT = OrchardCommitmentTree $ ztiOrchard trees -let sT = SaplingCommitmentTree $ ztiSapling trees
-let oT = OrchardCommitmentTree $ ztiOrchard trees
-}
case accRead of case accRead of
Nothing -> do Nothing -> do
logErrorN "Can't find Account" logErrorN "Can't find Account"
@ -887,7 +912,12 @@ prepareTxV2 pool zebraHost zebraPort zn za bh pnotes policy = do
Just acc -> do Just acc -> do
logDebugN $ T.pack $ show acc logDebugN $ T.pack $ show acc
let amt = foldl' (\x y -> x + pn_amt y) 0 pnotes let amt = foldl' (\x y -> x + pn_amt y) 0 pnotes
let zats = ceilingFloatInteger $ amt * (10 ^ 8) let zats' = toBoundedInteger $ amt * scientific 1 8
case zats' of
Nothing -> do
logErrorN "Failed to parse amount into zats"
return $ Left ZHError
Just zats -> do
logDebugN $ "amt: " <> T.pack (show amt) logDebugN $ "amt: " <> T.pack (show amt)
logDebugN $ "zats: " <> T.pack (show zats) logDebugN $ "zats: " <> T.pack (show zats)
{-firstPass <- liftIO $ selectUnspentNotes pool za zats-} {-firstPass <- liftIO $ selectUnspentNotes pool za zats-}
@ -929,15 +959,19 @@ prepareTxV2 pool zebraHost zebraPort zn za bh pnotes policy = do
--print oSpends --print oSpends
dummy' <- dummy' <-
liftIO $ liftIO $
makeOutgoing acc recipients (noteTotal - 5000 - zats) policy makeOutgoing
acc
recipients
(noteTotal - 5000 - fromIntegral zats)
policy
case dummy' of case dummy' of
Left e -> return $ Left e Left e -> return $ Left e
Right dummy -> do Right dummy -> do
logDebugN "Calculating fee" logDebugN "Calculating fee"
let feeResponse = let feeResponse =
createTransaction createTransaction
(Just sT) Nothing
(Just oT) Nothing
tSpends tSpends
sSpends sSpends
oSpends oSpends
@ -956,7 +990,7 @@ prepareTxV2 pool zebraHost zebraPort zn za bh pnotes policy = do
selectUnspentNotesV2 selectUnspentNotesV2
pool pool
za za
(zats + feeAmt) (fromIntegral zats + feeAmt)
(map (\(x, _, _, _) -> x) recipients) (map (\(x, _, _, _) -> x) recipients)
policy policy
case finalNotePlan of case finalNotePlan of
@ -969,25 +1003,29 @@ prepareTxV2 pool zebraHost zebraPort zn za bh pnotes policy = do
tSpends1 <- tSpends1 <-
liftIO $ liftIO $
prepTSpends prepTSpends
(getTranSK $ zcashAccountTPrivateKey $ entityVal acc) (getTranSK $
zcashAccountTPrivateKey $ entityVal acc)
tList1 tList1
sSpends1 <- sSpends1 <-
liftIO $ liftIO $
prepSSpends prepSSpends
(getSapSK $ zcashAccountSapSpendKey $ entityVal acc) (getSapSK $
zcashAccountSapSpendKey $ entityVal acc)
sList1 sList1
oSpends1 <- oSpends1 <-
liftIO $ liftIO $
prepOSpends prepOSpends
(getOrchSK $ zcashAccountOrchSpendKey $ entityVal acc) (getOrchSK $
zcashAccountOrchSpendKey $ entityVal acc)
oList1 oList1
let noteTotal1 = getTotalAmount (tList1, sList1, oList1) let noteTotal1 =
getTotalAmount (tList1, sList1, oList1)
outgoing' <- outgoing' <-
liftIO $ liftIO $
makeOutgoing makeOutgoing
acc acc
recipients recipients
(noteTotal1 - feeAmt - zats) (noteTotal1 - feeAmt - fromIntegral zats)
policy policy
logDebugN $ T.pack $ show outgoing' logDebugN $ T.pack $ show outgoing'
case outgoing' of case outgoing' of
@ -995,8 +1033,8 @@ prepareTxV2 pool zebraHost zebraPort zn za bh pnotes policy = do
Right outgoing -> do Right outgoing -> do
let tx = let tx =
createTransaction createTransaction
(Just sT) Nothing
(Just oT) Nothing
tSpends1 tSpends1
sSpends1 sSpends1
oSpends1 oSpends1
@ -1011,10 +1049,13 @@ prepareTxV2 pool zebraHost zebraPort zn za bh pnotes policy = do
logErrorN $ T.pack $ show e logErrorN $ T.pack $ show e
return $ Left e return $ Left e
where where
extractReceiver :: ProposedNote -> (Int, BS.ByteString, Int, T.Text) extractReceiver :: ProposedNote -> (Int, BS.ByteString, Int64, T.Text)
extractReceiver (ProposedNote (ValidAddressAPI va) amt m) = extractReceiver (ProposedNote (ValidAddressAPI va) amt m) =
let zats = fromIntegral $ floorFloatInteger $ amt * (10 ^ 8) let zats' = toBoundedInteger $ amt * scientific 1 8
in case va of in case zats' of
Nothing -> (0, "", 0, "")
Just zats ->
case va of
Unified ua -> Unified ua ->
case o_rec ua of case o_rec ua of
Nothing -> Nothing ->
@ -1025,26 +1066,45 @@ prepareTxV2 pool zebraHost zebraPort zn za bh pnotes policy = do
Just r3 -> Just r3 ->
case tr_type r3 of case tr_type r3 of
P2PKH -> P2PKH ->
(1, toBytes $ tr_bytes r3, zats, fromMaybe "" m) ( 1
, toBytes $ tr_bytes r3
, zats
, fromMaybe "" m)
P2SH -> P2SH ->
(2, toBytes $ tr_bytes r3, zats, fromMaybe "" m) ( 2
, toBytes $ tr_bytes r3
, zats
, fromMaybe "" m)
Just r2 -> (3, getBytes r2, zats, fromMaybe "" m) Just r2 -> (3, getBytes r2, zats, fromMaybe "" m)
Just r1 -> (4, getBytes r1, zats, fromMaybe "" m) Just r1 -> (4, getBytes r1, zats, fromMaybe "" m)
Sapling sa -> (3, getBytes $ sa_receiver sa, zats, fromMaybe "" m) Sapling sa ->
(3, getBytes $ sa_receiver sa, zats, fromMaybe "" m)
Transparent ta -> Transparent ta ->
case tr_type (ta_receiver ta) of case tr_type (ta_receiver ta) of
P2PKH -> P2PKH ->
(1, toBytes $ tr_bytes (ta_receiver ta), zats, fromMaybe "" m) ( 1
, toBytes $ tr_bytes (ta_receiver ta)
, zats
, fromMaybe "" m)
P2SH -> P2SH ->
(2, toBytes $ tr_bytes (ta_receiver ta), zats, fromMaybe "" m) ( 2
, toBytes $ tr_bytes (ta_receiver ta)
, zats
, fromMaybe "" m)
Exchange ea -> Exchange ea ->
case tr_type (ex_address ea) of case tr_type (ex_address ea) of
P2PKH -> P2PKH ->
(5, toBytes $ tr_bytes (ex_address ea), zats, fromMaybe "" m) ( 5
, toBytes $ tr_bytes (ex_address ea)
, zats
, fromMaybe "" m)
P2SH -> P2SH ->
(6, toBytes $ tr_bytes (ex_address ea), zats, fromMaybe "" m) ( 6
, toBytes $ tr_bytes (ex_address ea)
, zats
, fromMaybe "" m)
prepareOutgoingNote :: prepareOutgoingNote ::
ZcashAccount -> (Int, BS.ByteString, Int, T.Text) -> OutgoingNote ZcashAccount -> (Int, BS.ByteString, Int64, T.Text) -> OutgoingNote
prepareOutgoingNote zac (k, r, a, m) = prepareOutgoingNote zac (k, r, a, m) =
OutgoingNote OutgoingNote
(if k == 5 (if k == 5
@ -1062,8 +1122,8 @@ prepareTxV2 pool zebraHost zebraPort zn za bh pnotes policy = do
False False
makeOutgoing :: makeOutgoing ::
Entity ZcashAccount Entity ZcashAccount
-> [(Int, BS.ByteString, Int, T.Text)] -> [(Int, BS.ByteString, Int64, T.Text)]
-> Integer -> Int64
-> PrivacyPolicy -> PrivacyPolicy
-> IO (Either TxError [OutgoingNote]) -> IO (Either TxError [OutgoingNote])
makeOutgoing acc recvs chg pol = do makeOutgoing acc recvs chg pol = do
@ -1195,7 +1255,7 @@ prepareTxV2 pool zebraHost zebraPort zn za bh pnotes policy = do
( [Entity WalletTrNote] ( [Entity WalletTrNote]
, [Entity WalletSapNote] , [Entity WalletSapNote]
, [Entity WalletOrchNote]) , [Entity WalletOrchNote])
-> Integer -> Int64
getTotalAmount (t, s, o) = getTotalAmount (t, s, o) =
sum (map (fromIntegral . walletTrNoteValue . entityVal) t) + sum (map (fromIntegral . walletTrNoteValue . entityVal) t) +
sum (map (fromIntegral . walletSapNoteValue . entityVal) s) + sum (map (fromIntegral . walletSapNoteValue . entityVal) s) +
@ -1307,6 +1367,8 @@ syncWallet config w = do
logDebugN "processed transparent notes" logDebugN "processed transparent notes"
mapM_ (liftIO . findTransparentSpends pool . entityKey) accs mapM_ (liftIO . findTransparentSpends pool . entityKey) accs
logDebugN "processed transparent spends" logDebugN "processed transparent spends"
liftIO $
runNoLoggingT $
mapM_ mapM_
(findSaplingOutputs config startBlock (zcashWalletNetwork $ entityVal w)) (findSaplingOutputs config startBlock (zcashWalletNetwork $ entityVal w))
accs accs

19
src/Zenith/DB.hs
View file

@ -1776,12 +1776,16 @@ getUnspentSapNotes pool = do
where_ (n ^. WalletSapNoteSpent ==. val False) where_ (n ^. WalletSapNoteSpent ==. val False)
pure n pure n
getSaplingCmus :: Pool SqlBackend -> ShieldOutputId -> IO [Value HexStringDB] getSaplingCmus ::
getSaplingCmus pool zt = do ConnectionPool
-> ShieldOutputId
-> ShieldOutputId
-> IO [Value HexStringDB]
getSaplingCmus pool zt m = do
PS.runSqlPool PS.runSqlPool
(select $ do (select $ do
n <- from $ table @ShieldOutput n <- from $ table @ShieldOutput
where_ (n ^. ShieldOutputId >. val zt) where_ (n ^. ShieldOutputId >. val zt &&. n ^. ShieldOutputId <=. val m)
orderBy [asc $ n ^. ShieldOutputId] orderBy [asc $ n ^. ShieldOutputId]
pure $ n ^. ShieldOutputCmu) pure $ n ^. ShieldOutputCmu)
pool pool
@ -1840,12 +1844,13 @@ getUnspentOrchNotes pool = do
where_ (n ^. WalletOrchNoteSpent ==. val False) where_ (n ^. WalletOrchNoteSpent ==. val False)
pure n pure n
getOrchardCmxs :: Pool SqlBackend -> OrchActionId -> IO [Value HexStringDB] getOrchardCmxs ::
getOrchardCmxs pool zt = do ConnectionPool -> OrchActionId -> OrchActionId -> IO [Value HexStringDB]
getOrchardCmxs pool zt m = do
PS.runSqlPool PS.runSqlPool
(select $ do (select $ do
n <- from $ table @OrchAction n <- from $ table @OrchAction
where_ (n ^. OrchActionId >. val zt) where_ (n ^. OrchActionId >. val zt &&. n ^. OrchActionId <=. val m)
orderBy [asc $ n ^. OrchActionId] orderBy [asc $ n ^. OrchActionId]
pure $ n ^. OrchActionCmx) pure $ n ^. OrchActionCmx)
pool pool
@ -2339,7 +2344,7 @@ selectUnspentNotes pool za amt = do
selectUnspentNotesV2 :: selectUnspentNotesV2 ::
ConnectionPool ConnectionPool
-> ZcashAccountId -> ZcashAccountId
-> Integer -> Int64
-> [Int] -> [Int]
-> PrivacyPolicy -> PrivacyPolicy
-> IO -> IO

7
src/Zenith/GUI.hs
View file

@ -17,6 +17,7 @@ import Data.Aeson
import qualified Data.ByteString as BS import qualified Data.ByteString as BS
import Data.HexString (toText) import Data.HexString (toText)
import Data.Maybe (fromMaybe, isJust, isNothing) import Data.Maybe (fromMaybe, isJust, isNothing)
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)
@ -1244,7 +1245,7 @@ handleEvent wenv node model evt =
(model ^. network) (model ^. network)
(entityKey acc) (entityKey acc)
(zcashWalletLastSync $ entityVal wal) (zcashWalletLastSync $ entityVal wal)
(model ^. sendAmount) (fromFloatDigits $ model ^. sendAmount)
(model ^. sendRecipient) (model ^. sendRecipient)
(model ^. sendMemo) (model ^. sendMemo)
(model ^. privacyChoice) (model ^. privacyChoice)
@ -1701,7 +1702,7 @@ sendTransaction ::
-> ZcashNet -> ZcashNet
-> ZcashAccountId -> ZcashAccountId
-> Int -> Int
-> Float -> Scientific
-> T.Text -> T.Text
-> T.Text -> T.Text
-> PrivacyPolicy -> PrivacyPolicy
@ -1717,7 +1718,7 @@ sendTransaction config znet accId bl amt ua memo policy sendMsg = do
let zPort = c_zebraPort config let zPort = c_zebraPort config
pool <- runNoLoggingT $ initPool dbPath pool <- runNoLoggingT $ initPool dbPath
res <- res <-
runNoLoggingT $ runStderrLoggingT $
prepareTxV2 prepareTxV2
pool pool
zHost zHost

2
src/Zenith/RPC.hs
View file

@ -833,7 +833,7 @@ zenithServer state = getinfo :<|> handleRPC
forkIO $ do forkIO $ do
res <- res <-
liftIO $ liftIO $
runNoLoggingT $ runStderrLoggingT $
prepareTxV2 prepareTxV2
pool pool
zHost zHost

3
src/Zenith/Types.hs
View file

@ -17,6 +17,7 @@ import qualified Data.ByteString.Char8 as C
import Data.HexString import Data.HexString
import Data.Int (Int64) import Data.Int (Int64)
import Data.Maybe (fromMaybe) import Data.Maybe (fromMaybe)
import Data.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.Text.Encoding.Error (lenientDecode) import Data.Text.Encoding.Error (lenientDecode)
@ -241,7 +242,7 @@ instance ToJSON ValidAddressAPI where
data ProposedNote = ProposedNote data ProposedNote = ProposedNote
{ pn_addr :: !ValidAddressAPI { pn_addr :: !ValidAddressAPI
, pn_amt :: !Float , pn_amt :: !Scientific
, pn_memo :: !(Maybe T.Text) , pn_memo :: !(Maybe T.Text)
} deriving (Eq, Prelude.Show) } deriving (Eq, Prelude.Show)

34
src/Zenith/Utils.hs
View file

@ -13,26 +13,31 @@ import qualified Data.Text.Encoding as E
import System.Directory import System.Directory
import System.Process (createProcess_, shell) import System.Process (createProcess_, shell)
import Text.Regex.Posix import Text.Regex.Posix
import ZcashHaskell.Orchard (encodeUnifiedAddress, isValidUnifiedAddress, parseAddress) import ZcashHaskell.Orchard
( encodeUnifiedAddress
, isValidUnifiedAddress
, parseAddress
)
import ZcashHaskell.Sapling (decodeSaplingAddress, isValidShieldedAddress) import ZcashHaskell.Sapling (decodeSaplingAddress, isValidShieldedAddress)
import ZcashHaskell.Transparent import ZcashHaskell.Transparent
( decodeExchangeAddress ( decodeExchangeAddress
, decodeTransparentAddress , decodeTransparentAddress
) )
import ZcashHaskell.Types import ZcashHaskell.Types
( SaplingAddress(..) ( ExchangeAddress(..)
, SaplingAddress(..)
, TransparentAddress(..) , TransparentAddress(..)
, UnifiedAddress(..) , UnifiedAddress(..)
, ZcashNet(..)
, ValidAddress(..) , ValidAddress(..)
, ExchangeAddress(..) , ZcashNet(..)
) )
import ZcashHaskell.Utils (makeZebraCall)
import Zenith.Types import Zenith.Types
( AddressGroup(..) ( AddressGroup(..)
, PrivacyPolicy(..)
, UnifiedAddressDB(..) , UnifiedAddressDB(..)
, ZcashAddress(..) , ZcashAddress(..)
, ZcashPool(..) , ZcashPool(..)
, PrivacyPolicy(..)
) )
-- | Helper function to convert numbers into JSON -- | Helper function to convert numbers into JSON
@ -150,21 +155,24 @@ isRecipientValidGUI :: PrivacyPolicy -> T.Text -> Bool
isRecipientValidGUI p a = do isRecipientValidGUI p a = do
let adr = parseAddress (E.encodeUtf8 a) let adr = parseAddress (E.encodeUtf8 a)
case p of case p of
Full -> case adr of Full ->
case adr of
Just a -> Just a ->
case a of case a of
Unified ua -> True Unified ua -> True
Sapling sa -> True Sapling sa -> True
_ -> False _ -> False
Nothing -> False Nothing -> False
Medium -> case adr of Medium ->
case adr of
Just a -> Just a ->
case a of case a of
Unified ua -> True Unified ua -> True
Sapling sa -> True Sapling sa -> True
_ -> False _ -> False
Nothing -> False Nothing -> False
Low -> case adr of Low ->
case adr of
Just a -> Just a ->
case a of case a of
Unified ua -> True Unified ua -> True
@ -172,7 +180,8 @@ isRecipientValidGUI p a = do
Transparent ta -> True Transparent ta -> True
_ -> False _ -> False
Nothing -> False Nothing -> False
None -> case adr of None ->
case adr of
Just a -> Just a ->
case a of case a of
Transparent ta -> True Transparent ta -> True
@ -232,3 +241,10 @@ padWithZero n s
isEmpty :: [a] -> Bool isEmpty :: [a] -> Bool
isEmpty [] = True isEmpty [] = True
isEmpty _ = False isEmpty _ = False
getChainTip :: T.Text -> Int -> IO Int
getChainTip zHost zPort = do
r <- makeZebraCall zHost zPort "getblockcount" []
case r of
Left e1 -> pure 0
Right i -> pure i

8
test/Spec.hs
View file

@ -33,8 +33,10 @@ import ZcashHaskell.Types
, Scope(..) , Scope(..)
, ShieldedOutput(..) , ShieldedOutput(..)
, TxError(..) , TxError(..)
, ValidAddress(..)
, ZcashNet(..) , ZcashNet(..)
) )
import ZcashHaskell.Utils (readZebraTransaction)
import Zenith.Core import Zenith.Core
import Zenith.DB import Zenith.DB
import Zenith.Types import Zenith.Types
@ -182,6 +184,12 @@ main = do
a `shouldBe` a `shouldBe`
Just Just
"ztestsapling1tgjr4zppwk4ne8xy6gdq4z2gwq7dmf5jq8z2ctpn8nlmtse0a74fa5z0m8z383gmpgqz6q6duu4" "ztestsapling1tgjr4zppwk4ne8xy6gdq4z2gwq7dmf5jq8z2ctpn8nlmtse0a74fa5z0m8z383gmpgqz6q6duu4"
describe "Witnesses" $ do
describe "Sapling" $ do
it "max output id" $ do
pool <- runNoLoggingT $ initPool "/home/rav/Zenith/zenith.db"
sId <- getMaxSaplingNote pool
sId `shouldBe` toSqlKey 0
describe "Notes" $ do describe "Notes" $ do
xit "Check Orchard notes" $ do xit "Check Orchard notes" $ do
pool <- runNoLoggingT $ initPool "/home/rav/Zenith/zenith.db" pool <- runNoLoggingT $ initPool "/home/rav/Zenith/zenith.db"