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

526
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,76 +564,97 @@ 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
{-firstPass <- liftIO $ selectUnspentNotes pool za zats-} Nothing -> return $ Left ZHError
--let fee = calculateTxFee firstPass $ fst recipient Just zats -> do
--logDebugN $ T.pack $ "calculated fee " ++ show fee logDebugN $ T.pack $ show (zats :: Int64)
(tList, sList, oList) <- liftIO $ selectUnspentNotes pool za (zats + 5000) {-firstPass <- liftIO $ selectUnspentNotes pool za zats-}
logDebugN "selected notes" --let fee = calculateTxFee firstPass $ fst recipient
logDebugN $ T.pack $ show tList --logDebugN $ T.pack $ "calculated fee " ++ show fee
logDebugN $ T.pack $ show sList (tList, sList, oList) <-
logDebugN $ T.pack $ show oList liftIO $ selectUnspentNotes pool za (fromIntegral $ zats + 5000)
let noteTotal = getTotalAmount (tList, sList, oList) logDebugN "selected notes"
tSpends <-
liftIO $
prepTSpends (getTranSK $ zcashAccountTPrivateKey $ entityVal acc) tList
--print tSpends
sSpends <-
liftIO $
prepSSpends (getSapSK $ zcashAccountSapSpendKey $ entityVal acc) sList
--print sSpends
oSpends <-
liftIO $
prepOSpends (getOrchSK $ zcashAccountOrchSpendKey $ entityVal acc) oList
--print oSpends
dummy <-
liftIO $ makeOutgoing acc recipient zats (noteTotal - 5000 - zats)
logDebugN "Calculating fee"
let feeResponse =
createTransaction
(Just sT)
(Just oT)
tSpends
sSpends
oSpends
dummy
zn
(bh + 3)
False
case feeResponse of
Left e1 -> return $ Left Fee
Right fee -> do
let feeAmt =
fromIntegral (runGet getInt64le $ LBS.fromStrict $ toBytes fee)
(tList1, sList1, oList1) <-
liftIO $ selectUnspentNotes pool za (zats + 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 <- let noteTotal = getTotalAmount (tList, sList, oList)
liftIO $ makeOutgoing acc recipient zats (noteTotal - feeAmt - zats) tSpends <-
logDebugN $ T.pack $ show outgoing liftIO $
let tx = prepTSpends
(getTranSK $ zcashAccountTPrivateKey $ entityVal acc)
tList
--print tSpends
sSpends <-
liftIO $
prepSSpends
(getSapSK $ zcashAccountSapSpendKey $ entityVal acc)
sList
--print sSpends
oSpends <-
liftIO $
prepOSpends
(getOrchSK $ zcashAccountOrchSpendKey $ entityVal acc)
oList
--print oSpends
dummy <-
liftIO $
makeOutgoing
acc
recipient
zats
(fromInteger noteTotal - 5000 - zats)
logDebugN "Calculating fee"
let feeResponse =
createTransaction createTransaction
(Just sT) (Just sT)
(Just oT) (Just oT)
tSpends tSpends
sSpends sSpends
oSpends oSpends
outgoing dummy
zn zn
(bh + 3) bh
True False
logDebugN $ T.pack $ show tx case feeResponse of
return tx Left e1 -> return $ Left Fee
Right fee -> do
let feeAmt =
fromIntegral
(runGet getInt64le $ LBS.fromStrict $ toBytes fee)
(tList1, sList1, oList1) <-
liftIO $ selectUnspentNotes pool za (fromIntegral zats + feeAmt)
logDebugN $ T.pack $ "selected notes with fee" ++ show feeAmt
logDebugN $ T.pack $ show tList
logDebugN $ T.pack $ show sList
logDebugN $ T.pack $ show oList
outgoing <-
liftIO $
makeOutgoing
acc
recipient
zats
(fromInteger noteTotal - fromInteger feeAmt - zats)
logDebugN $ T.pack $ show outgoing
let tx =
createTransaction
(Just sT)
(Just oT)
tSpends
sSpends
oSpends
outgoing
zn
bh
True
logDebugN $ T.pack $ show tx
return tx
where where
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,164 +912,199 @@ 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
logDebugN $ "amt: " <> T.pack (show amt) case zats' of
logDebugN $ "zats: " <> T.pack (show zats) Nothing -> do
{-firstPass <- liftIO $ selectUnspentNotes pool za zats-} logErrorN "Failed to parse amount into zats"
--let fee = calculateTxFee firstPass $ fst recipient return $ Left ZHError
--logDebugN $ T.pack $ "calculated fee " ++ show fee Just zats -> do
notePlan <- logDebugN $ "amt: " <> T.pack (show amt)
liftIO $ logDebugN $ "zats: " <> T.pack (show zats)
selectUnspentNotesV2 {-firstPass <- liftIO $ selectUnspentNotes pool za zats-}
pool --let fee = calculateTxFee firstPass $ fst recipient
za --logDebugN $ T.pack $ "calculated fee " ++ show fee
(zats + 10000) notePlan <-
(map (\(x, _, _, _) -> x) recipients)
policy
case notePlan of
Right (tList, sList, oList) -> do
logDebugN "selected notes"
logDebugN $ T.pack $ show tList
logDebugN $ T.pack $ show sList
logDebugN $ T.pack $ show oList
let noteTotal = getTotalAmount (tList, sList, oList)
logDebugN $ "noteTotal: " <> T.pack (show noteTotal)
tSpends <-
liftIO $ liftIO $
prepTSpends selectUnspentNotesV2
(getTranSK $ zcashAccountTPrivateKey $ entityVal acc) pool
tList za
--print tSpends (zats + 10000)
sSpends <- (map (\(x, _, _, _) -> x) recipients)
liftIO $ policy
prepSSpends case notePlan of
(getSapSK $ zcashAccountSapSpendKey $ entityVal acc) Right (tList, sList, oList) -> do
sList logDebugN "selected notes"
--print sSpends logDebugN $ T.pack $ show tList
oSpends <- logDebugN $ T.pack $ show sList
liftIO $ logDebugN $ T.pack $ show oList
prepOSpends let noteTotal = getTotalAmount (tList, sList, oList)
(getOrchSK $ zcashAccountOrchSpendKey $ entityVal acc) logDebugN $ "noteTotal: " <> T.pack (show noteTotal)
oList tSpends <-
--print oSpends liftIO $
dummy' <- prepTSpends
liftIO $ (getTranSK $ zcashAccountTPrivateKey $ entityVal acc)
makeOutgoing acc recipients (noteTotal - 5000 - zats) policy tList
case dummy' of --print tSpends
Left e -> return $ Left e sSpends <-
Right dummy -> do liftIO $
logDebugN "Calculating fee" prepSSpends
let feeResponse = (getSapSK $ zcashAccountSapSpendKey $ entityVal acc)
createTransaction sList
(Just sT) --print sSpends
(Just oT) oSpends <-
tSpends liftIO $
sSpends prepOSpends
oSpends (getOrchSK $ zcashAccountOrchSpendKey $ entityVal acc)
dummy oList
zn --print oSpends
bh dummy' <-
False liftIO $
case feeResponse of makeOutgoing
Left e1 -> return $ Left Fee acc
Right fee -> do recipients
let feeAmt = (noteTotal - 5000 - fromIntegral zats)
fromIntegral policy
(runGet getInt64le $ LBS.fromStrict $ toBytes fee) case dummy' of
finalNotePlan <- Left e -> return $ Left e
liftIO $ Right dummy -> do
selectUnspentNotesV2 logDebugN "Calculating fee"
pool let feeResponse =
za createTransaction
(zats + feeAmt) Nothing
(map (\(x, _, _, _) -> x) recipients) Nothing
policy tSpends
case finalNotePlan of sSpends
Right (tList1, sList1, oList1) -> do oSpends
logDebugN $ dummy
T.pack $ "selected notes with fee" ++ show feeAmt zn
logDebugN $ T.pack $ show tList1 bh
logDebugN $ T.pack $ show sList1 False
logDebugN $ T.pack $ show oList1 case feeResponse of
tSpends1 <- Left e1 -> return $ Left Fee
Right fee -> do
let feeAmt =
fromIntegral
(runGet getInt64le $ LBS.fromStrict $ toBytes fee)
finalNotePlan <-
liftIO $ liftIO $
prepTSpends selectUnspentNotesV2
(getTranSK $ zcashAccountTPrivateKey $ entityVal acc) pool
tList1 za
sSpends1 <- (fromIntegral zats + feeAmt)
liftIO $ (map (\(x, _, _, _) -> x) recipients)
prepSSpends
(getSapSK $ zcashAccountSapSpendKey $ entityVal acc)
sList1
oSpends1 <-
liftIO $
prepOSpends
(getOrchSK $ zcashAccountOrchSpendKey $ entityVal acc)
oList1
let noteTotal1 = getTotalAmount (tList1, sList1, oList1)
outgoing' <-
liftIO $
makeOutgoing
acc
recipients
(noteTotal1 - feeAmt - zats)
policy policy
logDebugN $ T.pack $ show outgoing' case finalNotePlan of
case outgoing' of Right (tList1, sList1, oList1) -> do
logDebugN $
T.pack $ "selected notes with fee" ++ show feeAmt
logDebugN $ T.pack $ show tList1
logDebugN $ T.pack $ show sList1
logDebugN $ T.pack $ show oList1
tSpends1 <-
liftIO $
prepTSpends
(getTranSK $
zcashAccountTPrivateKey $ entityVal acc)
tList1
sSpends1 <-
liftIO $
prepSSpends
(getSapSK $
zcashAccountSapSpendKey $ entityVal acc)
sList1
oSpends1 <-
liftIO $
prepOSpends
(getOrchSK $
zcashAccountOrchSpendKey $ entityVal acc)
oList1
let noteTotal1 =
getTotalAmount (tList1, sList1, oList1)
outgoing' <-
liftIO $
makeOutgoing
acc
recipients
(noteTotal1 - feeAmt - fromIntegral zats)
policy
logDebugN $ T.pack $ show outgoing'
case outgoing' of
Left e -> return $ Left e
Right outgoing -> do
let tx =
createTransaction
Nothing
Nothing
tSpends1
sSpends1
oSpends1
outgoing
zn
bh
True
logDebugN $ T.pack $ show tx
return tx
Left e -> return $ Left e Left e -> return $ Left e
Right outgoing -> do Left e -> do
let tx = logErrorN $ T.pack $ show e
createTransaction return $ Left e
(Just sT)
(Just oT)
tSpends1
sSpends1
oSpends1
outgoing
zn
bh
True
logDebugN $ T.pack $ show tx
return tx
Left e -> return $ Left e
Left e -> do
logErrorN $ T.pack $ show 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
Unified ua -> Nothing -> (0, "", 0, "")
case o_rec ua of Just zats ->
Nothing -> case va of
case s_rec ua of Unified ua ->
case o_rec ua of
Nothing -> Nothing ->
case t_rec ua of case s_rec ua of
Nothing -> (0, "", 0, "") Nothing ->
Just r3 -> case t_rec ua of
case tr_type r3 of Nothing -> (0, "", 0, "")
P2PKH -> Just r3 ->
(1, toBytes $ tr_bytes r3, zats, fromMaybe "" m) case tr_type r3 of
P2SH -> P2PKH ->
(2, toBytes $ tr_bytes r3, zats, fromMaybe "" m) ( 1
Just r2 -> (3, getBytes r2, zats, fromMaybe "" m) , toBytes $ tr_bytes r3
Just r1 -> (4, getBytes r1, zats, fromMaybe "" m) , zats
Sapling sa -> (3, getBytes $ sa_receiver sa, zats, fromMaybe "" m) , fromMaybe "" m)
Transparent ta -> P2SH ->
case tr_type (ta_receiver ta) of ( 2
P2PKH -> , toBytes $ tr_bytes r3
(1, toBytes $ tr_bytes (ta_receiver ta), zats, fromMaybe "" m) , zats
P2SH -> , fromMaybe "" m)
(2, toBytes $ tr_bytes (ta_receiver ta), zats, fromMaybe "" m) Just r2 -> (3, getBytes r2, zats, fromMaybe "" m)
Exchange ea -> Just r1 -> (4, getBytes r1, zats, fromMaybe "" m)
case tr_type (ex_address ea) of Sapling sa ->
P2PKH -> (3, getBytes $ sa_receiver sa, zats, fromMaybe "" m)
(5, toBytes $ tr_bytes (ex_address ea), zats, fromMaybe "" m) Transparent ta ->
P2SH -> case tr_type (ta_receiver ta) of
(6, toBytes $ tr_bytes (ex_address ea), zats, fromMaybe "" m) P2PKH ->
( 1
, toBytes $ tr_bytes (ta_receiver ta)
, zats
, fromMaybe "" m)
P2SH ->
( 2
, toBytes $ tr_bytes (ta_receiver ta)
, zats
, fromMaybe "" m)
Exchange ea ->
case tr_type (ex_address ea) of
P2PKH ->
( 5
, toBytes $ tr_bytes (ex_address ea)
, zats
, fromMaybe "" m)
P2SH ->
( 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,9 +1367,11 @@ 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"
mapM_ liftIO $
(findSaplingOutputs config startBlock (zcashWalletNetwork $ entityVal w)) runNoLoggingT $
accs mapM_
(findSaplingOutputs config startBlock (zcashWalletNetwork $ entityVal w))
accs
logDebugN "processed sapling outputs" logDebugN "processed sapling outputs"
liftIO $ liftIO $
mapM_ mapM_

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)

100
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
@ -127,9 +132,9 @@ isRecipientValid a = do
isUnifiedAddressValid :: T.Text -> Bool isUnifiedAddressValid :: T.Text -> Bool
isUnifiedAddressValid ua = isUnifiedAddressValid ua =
case isValidUnifiedAddress (E.encodeUtf8 ua) of case isValidUnifiedAddress (E.encodeUtf8 ua) of
Just _a1 -> True Just _a1 -> True
Nothing -> False Nothing -> False
isSaplingAddressValid :: T.Text -> Bool isSaplingAddressValid :: T.Text -> Bool
isSaplingAddressValid sa = isValidShieldedAddress (E.encodeUtf8 sa) isSaplingAddressValid sa = isValidShieldedAddress (E.encodeUtf8 sa)
@ -137,8 +142,8 @@ isSaplingAddressValid sa = isValidShieldedAddress (E.encodeUtf8 sa)
isTransparentAddressValid :: T.Text -> Bool isTransparentAddressValid :: T.Text -> Bool
isTransparentAddressValid ta = isTransparentAddressValid ta =
case decodeTransparentAddress (E.encodeUtf8 ta) of case decodeTransparentAddress (E.encodeUtf8 ta) of
Just _a3 -> True Just _a3 -> True
Nothing -> False Nothing -> False
isExchangeAddressValid :: T.Text -> Bool isExchangeAddressValid :: T.Text -> Bool
isExchangeAddressValid xa = isExchangeAddressValid xa =
@ -147,40 +152,44 @@ isExchangeAddressValid xa =
Nothing -> False Nothing -> False
isRecipientValidGUI :: PrivacyPolicy -> T.Text -> Bool 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 ->
Just a -> case adr of
case a of Just a ->
Unified ua -> True case a of
Sapling sa -> True Unified ua -> True
_ -> False Sapling sa -> True
Nothing -> False _ -> False
Medium -> case adr of Nothing -> False
Just a -> Medium ->
case a of case adr of
Unified ua -> True Just a ->
Sapling sa -> True case a of
_ -> False Unified ua -> True
Nothing -> False Sapling sa -> True
Low -> case adr of _ -> False
Just a -> Nothing -> False
case a of Low ->
Unified ua -> True case adr of
Sapling sa -> True Just a ->
Transparent ta -> True case a of
_ -> False Unified ua -> True
Nothing -> False Sapling sa -> True
None -> case adr of Transparent ta -> True
Just a -> _ -> False
case a of Nothing -> False
Transparent ta -> True None ->
Exchange ea -> True case adr of
_ -> False Just a ->
Nothing -> False case a of
Transparent ta -> True
Exchange ea -> True
_ -> False
Nothing -> False
isZecAddressValid :: T.Text -> Bool isZecAddressValid :: T.Text -> Bool
isZecAddressValid a = do isZecAddressValid a = do
case isValidUnifiedAddress (E.encodeUtf8 a) of case isValidUnifiedAddress (E.encodeUtf8 a) of
Just _a1 -> True Just _a1 -> 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"