Merge branch 'rav001' into rvv001
- Fix sync process
This commit is contained in:
commit
d71d98a822
8 changed files with 451 additions and 320 deletions
|
|
@ -75,6 +75,7 @@ import Control.Monad.Logger
|
|||
import Data.Aeson
|
||||
import Data.HexString (HexString(..), toText)
|
||||
import Data.Maybe
|
||||
import Data.Scientific (Scientific, scientific)
|
||||
import qualified Data.Text as T
|
||||
import qualified Data.Text.Encoding as E
|
||||
import Data.Time.Clock.POSIX (posixSecondsToUTCTime)
|
||||
|
|
@ -119,10 +120,10 @@ import Zenith.Types
|
|||
import Zenith.Utils
|
||||
( displayTaz
|
||||
, displayZec
|
||||
, getChainTip
|
||||
, isRecipientValid
|
||||
, isRecipientValidGUI
|
||||
, jsonNumber
|
||||
, parseAddressUA
|
||||
, showAddress
|
||||
, validBarValue
|
||||
)
|
||||
|
|
@ -159,7 +160,7 @@ makeLenses ''DialogInput
|
|||
|
||||
data SendInput = SendInput
|
||||
{ _sendTo :: !T.Text
|
||||
, _sendAmt :: !Float
|
||||
, _sendAmt :: !Scientific
|
||||
, _sendMemo :: !T.Text
|
||||
, _policyField :: !PrivacyPolicy
|
||||
} deriving (Show)
|
||||
|
|
@ -174,7 +175,7 @@ data AdrBookEntry = AdrBookEntry
|
|||
makeLenses ''AdrBookEntry
|
||||
|
||||
newtype ShDshEntry = ShDshEntry
|
||||
{ _shAmt :: Float
|
||||
{ _shAmt :: Scientific
|
||||
} deriving (Show)
|
||||
|
||||
makeLenses ''ShDshEntry
|
||||
|
|
@ -701,8 +702,8 @@ mkSendForm bal =
|
|||
, label "Memo: " @@= editTextField sendMemo MemoField (Just 1)
|
||||
]
|
||||
where
|
||||
isAmountValid :: Integer -> Float -> Bool
|
||||
isAmountValid b i = (fromIntegral b / 100000000.0) >= i
|
||||
isAmountValid :: Integer -> Scientific -> Bool
|
||||
isAmountValid b i = fromIntegral b >= (i * scientific 1 8)
|
||||
label s w =
|
||||
padBottom (Pad 1) $ vLimit 1 (hLimit 15 $ str s <+> fill ' ') <+> w
|
||||
|
||||
|
|
@ -713,8 +714,8 @@ mkDeshieldForm tbal =
|
|||
editShowableFieldWithValidate shAmt AmtField (isAmountValid tbal)
|
||||
]
|
||||
where
|
||||
isAmountValid :: Integer -> Float -> Bool
|
||||
isAmountValid b i = (fromIntegral b / 100000000.0) >= i
|
||||
isAmountValid :: Integer -> Scientific -> Bool
|
||||
isAmountValid b i = fromIntegral b >= (i * scientific 1 8)
|
||||
label s w =
|
||||
padBottom (Pad 1) $ vLimit 1 (hLimit 15 $ str s <+> fill ' ') <+> w
|
||||
|
||||
|
|
@ -839,11 +840,11 @@ scanZebra dbP zHost zPort b eChan znet = do
|
|||
logDebugN $
|
||||
"dbBlock: " <>
|
||||
T.pack (show dbBlock) <> " chkBlock: " <> T.pack (show chkBlock)
|
||||
when (chkBlock /= dbBlock) $ rewindWalletData pool chkBlock
|
||||
let sb =
|
||||
if chkBlock == dbBlock
|
||||
then max dbBlock b
|
||||
else max chkBlock b
|
||||
when (chkBlock /= dbBlock && chkBlock /= 1) $ rewindWalletData pool sb
|
||||
if sb > zgb_blocks bStatus || sb < 1
|
||||
then do
|
||||
liftIO $
|
||||
|
|
@ -1201,7 +1202,8 @@ appEvent (BT.VtyEvent e) = do
|
|||
Just (_k, w) -> return w
|
||||
fs1 <- BT.zoom txForm $ BT.gets formState
|
||||
bl <-
|
||||
liftIO $ getLastSyncBlock pool $ entityKey selWal
|
||||
liftIO $
|
||||
getChainTip (s ^. zebraHost) (s ^. zebraPort)
|
||||
_ <-
|
||||
liftIO $
|
||||
forkIO $
|
||||
|
|
@ -1212,7 +1214,7 @@ appEvent (BT.VtyEvent e) = do
|
|||
(s ^. zebraPort)
|
||||
(s ^. network)
|
||||
(entityKey selAcc)
|
||||
bl
|
||||
(bl + 5)
|
||||
(fs1 ^. sendAmt)
|
||||
(fs1 ^. sendTo)
|
||||
(fs1 ^. sendMemo)
|
||||
|
|
@ -1292,7 +1294,8 @@ appEvent (BT.VtyEvent e) = do
|
|||
getUA . walletAddressUAddress)
|
||||
(entityVal selAddr)))
|
||||
bl <-
|
||||
liftIO $ getLastSyncBlock pool $ entityKey selWal
|
||||
liftIO $
|
||||
getChainTip (s ^. zebraHost) (s ^. zebraPort)
|
||||
case tAddrMaybe of
|
||||
Nothing -> do
|
||||
BT.modify $
|
||||
|
|
@ -1994,7 +1997,7 @@ sendTransaction ::
|
|||
-> ZcashNet
|
||||
-> ZcashAccountId
|
||||
-> Int
|
||||
-> Float
|
||||
-> Scientific
|
||||
-> T.Text
|
||||
-> T.Text
|
||||
-> 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"
|
||||
Just outUA -> do
|
||||
res <-
|
||||
runNoLoggingT $
|
||||
runStderrLoggingT $
|
||||
prepareTxV2
|
||||
pool
|
||||
zHost
|
||||
|
|
@ -2021,10 +2024,10 @@ sendTransaction pool chan zHost zPort znet accId bl amt ua memo policy = do
|
|||
else Just memo)
|
||||
]
|
||||
policy
|
||||
BC.writeBChan chan $ TickMsg "Transaction ready, sending to Zebra..."
|
||||
case res of
|
||||
Left e -> BC.writeBChan chan $ TickMsg $ show e
|
||||
Right rawTx -> do
|
||||
BC.writeBChan chan $ TickMsg "Transaction ready, sending to Zebra..."
|
||||
resp <-
|
||||
makeZebraCall
|
||||
zHost
|
||||
|
|
@ -2073,7 +2076,7 @@ deshieldTransaction ::
|
|||
-> IO ()
|
||||
deshieldTransaction pool chan zHost zPort znet accId bl pnote = do
|
||||
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
|
||||
Left e -> BC.writeBChan chan $ TickMsg $ show e
|
||||
Right rawTx -> do
|
||||
|
|
|
|||
|
|
@ -23,11 +23,11 @@ import Data.Aeson
|
|||
import Data.Binary.Get hiding (getBytes)
|
||||
import qualified Data.ByteString as BS
|
||||
import qualified Data.ByteString.Lazy as LBS
|
||||
import Data.Digest.Pure.MD5
|
||||
import Data.HexString (HexString, hexString, toBytes, toText)
|
||||
import Data.HexString (HexString, toBytes, toText)
|
||||
import Data.Int (Int64)
|
||||
import Data.List
|
||||
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.Encoding as E
|
||||
import Data.Time
|
||||
|
|
@ -116,20 +116,25 @@ checkBlockChain nodeHost nodePort = do
|
|||
|
||||
-- | Get commitment trees from Zebra
|
||||
getCommitmentTrees ::
|
||||
T.Text -- ^ Host where `zebrad` is avaiable
|
||||
ConnectionPool
|
||||
-> T.Text -- ^ Host where `zebrad` is avaiable
|
||||
-> Int -- ^ Port where `zebrad` is available
|
||||
-> Int -- ^ Block height
|
||||
-> IO ZebraTreeInfo
|
||||
getCommitmentTrees nodeHost nodePort block = do
|
||||
r <-
|
||||
makeZebraCall
|
||||
nodeHost
|
||||
nodePort
|
||||
"z_gettreestate"
|
||||
[Data.Aeson.String $ T.pack $ show block]
|
||||
case r of
|
||||
Left e -> throwIO $ userError e
|
||||
Right zti -> return zti
|
||||
getCommitmentTrees pool nodeHost nodePort block = do
|
||||
bh' <- getBlockHash pool block
|
||||
case bh' of
|
||||
Nothing -> throwIO $ userError "couldn't get block hash"
|
||||
Just bh -> do
|
||||
r <-
|
||||
makeZebraCall
|
||||
nodeHost
|
||||
nodePort
|
||||
"z_gettreestate"
|
||||
[Data.Aeson.String $ toText bh]
|
||||
case r of
|
||||
Left e -> throwIO $ userError e
|
||||
Right zti -> return zti
|
||||
|
||||
-- * Spending Keys
|
||||
-- | Create an Orchard Spending Key for the given wallet and account index
|
||||
|
|
@ -280,7 +285,7 @@ findSaplingOutputs ::
|
|||
-> Int -- ^ the starting block
|
||||
-> ZcashNetDB -- ^ The network
|
||||
-> Entity ZcashAccount -- ^ The account to use
|
||||
-> LoggingT IO ()
|
||||
-> NoLoggingT IO ()
|
||||
findSaplingOutputs config b znet za = do
|
||||
let dbPath = c_dbPath config
|
||||
let zebraHost = c_zebraHost config
|
||||
|
|
@ -288,7 +293,7 @@ findSaplingOutputs config b znet za = do
|
|||
let zn = getNet znet
|
||||
pool <- liftIO $ runNoLoggingT $ initPool dbPath
|
||||
tList <- liftIO $ getShieldedOutputs pool b znet
|
||||
trees <- liftIO $ getCommitmentTrees zebraHost zebraPort (b - 1)
|
||||
trees <- liftIO $ getCommitmentTrees pool zebraHost zebraPort (b - 1)
|
||||
logDebugN "getting Sapling frontier"
|
||||
let sT = getSaplingFrontier $ SaplingCommitmentTree $ ztiSapling trees
|
||||
case sT of
|
||||
|
|
@ -307,7 +312,7 @@ findSaplingOutputs config b znet za = do
|
|||
-> ZcashNet
|
||||
-> ConnectionPool
|
||||
-> [(Entity ZcashTransaction, Entity ShieldOutput)]
|
||||
-> LoggingT IO ()
|
||||
-> NoLoggingT IO ()
|
||||
decryptNotes _ _ _ [] = return ()
|
||||
decryptNotes st n pool ((zt, o):txs) = do
|
||||
let updatedTree =
|
||||
|
|
@ -395,7 +400,7 @@ findOrchardActions config b znet za = do
|
|||
let zn = getNet znet
|
||||
pool <- runNoLoggingT $ initPool dbPath
|
||||
tList <- getOrchardActions pool b znet
|
||||
trees <- getCommitmentTrees zebraHost zebraPort (b - 1)
|
||||
trees <- getCommitmentTrees pool zebraHost zebraPort (b - 1)
|
||||
let sT = getOrchardFrontier $ OrchardCommitmentTree $ ztiOrchard trees
|
||||
case sT of
|
||||
Nothing -> throwIO $ userError "Failed to read Orchard commitment tree"
|
||||
|
|
@ -478,7 +483,7 @@ updateSaplingWitnesses pool = do
|
|||
updateOneNote maxId n = do
|
||||
let noteSync = walletSapNoteWitPos $ entityVal n
|
||||
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 newWitness =
|
||||
updateSaplingWitness
|
||||
|
|
@ -496,7 +501,7 @@ updateOrchardWitnesses pool = do
|
|||
updateOneNote maxId n = do
|
||||
let noteSync = walletOrchNoteWitPos $ entityVal n
|
||||
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 newWitness =
|
||||
updateOrchardWitness
|
||||
|
|
@ -534,7 +539,7 @@ prepareTx ::
|
|||
-> ZcashNet
|
||||
-> ZcashAccountId
|
||||
-> Int
|
||||
-> Float
|
||||
-> Scientific
|
||||
-> UnifiedAddress
|
||||
-> T.Text
|
||||
-> LoggingT IO (Either TxError HexString)
|
||||
|
|
@ -555,7 +560,7 @@ prepareTx pool zebraHost zebraPort zn za bh amt ua memo = do
|
|||
Just r1 -> (4, getBytes r1)
|
||||
logDebugN $ T.pack $ show recipient
|
||||
logDebugN $ T.pack $ "Target block: " ++ show bh
|
||||
trees <- liftIO $ getCommitmentTrees zebraHost zebraPort bh
|
||||
trees <- liftIO $ getCommitmentTrees pool zebraHost zebraPort bh
|
||||
let sT = SaplingCommitmentTree $ ztiSapling trees
|
||||
let oT = OrchardCommitmentTree $ ztiOrchard trees
|
||||
case accRead of
|
||||
|
|
@ -564,76 +569,97 @@ prepareTx pool zebraHost zebraPort zn za bh amt ua memo = do
|
|||
return $ Left ZHError
|
||||
Just acc -> do
|
||||
logDebugN $ T.pack $ show acc
|
||||
let zats = floorFloatInteger $ amt * (10 ^ 8)
|
||||
logDebugN $ T.pack $ show zats
|
||||
{-firstPass <- liftIO $ selectUnspentNotes pool za zats-}
|
||||
--let fee = calculateTxFee firstPass $ fst recipient
|
||||
--logDebugN $ T.pack $ "calculated fee " ++ show fee
|
||||
(tList, sList, oList) <- liftIO $ selectUnspentNotes pool za (zats + 5000)
|
||||
logDebugN "selected notes"
|
||||
logDebugN $ T.pack $ show tList
|
||||
logDebugN $ T.pack $ show sList
|
||||
logDebugN $ T.pack $ show oList
|
||||
let noteTotal = getTotalAmount (tList, sList, oList)
|
||||
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
|
||||
let zats' = toBoundedInteger $ amt * scientific 1 8
|
||||
case zats' of
|
||||
Nothing -> return $ Left ZHError
|
||||
Just zats -> do
|
||||
logDebugN $ T.pack $ show (zats :: Int64)
|
||||
{-firstPass <- liftIO $ selectUnspentNotes pool za zats-}
|
||||
--let fee = calculateTxFee firstPass $ fst recipient
|
||||
--logDebugN $ T.pack $ "calculated fee " ++ show fee
|
||||
(tList, sList, oList) <-
|
||||
liftIO $ selectUnspentNotes pool za (fromIntegral $ zats + 5000)
|
||||
logDebugN "selected notes"
|
||||
logDebugN $ T.pack $ show tList
|
||||
logDebugN $ T.pack $ show sList
|
||||
logDebugN $ T.pack $ show oList
|
||||
outgoing <-
|
||||
liftIO $ makeOutgoing acc recipient zats (noteTotal - feeAmt - zats)
|
||||
logDebugN $ T.pack $ show outgoing
|
||||
let tx =
|
||||
let noteTotal = getTotalAmount (tList, sList, oList)
|
||||
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
|
||||
(fromInteger noteTotal - 5000 - zats)
|
||||
logDebugN "Calculating fee"
|
||||
let feeResponse =
|
||||
createTransaction
|
||||
(Just sT)
|
||||
(Just oT)
|
||||
tSpends
|
||||
sSpends
|
||||
oSpends
|
||||
outgoing
|
||||
dummy
|
||||
zn
|
||||
(bh + 3)
|
||||
True
|
||||
logDebugN $ T.pack $ show tx
|
||||
return tx
|
||||
bh
|
||||
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 (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
|
||||
makeOutgoing ::
|
||||
Entity ZcashAccount
|
||||
-> (Int, BS.ByteString)
|
||||
-> Integer
|
||||
-> Integer
|
||||
-> Int64
|
||||
-> Int64
|
||||
-> IO [OutgoingNote]
|
||||
makeOutgoing acc (k, recvr) zats chg = do
|
||||
chgAddr <- runNoLoggingT $ getInternalAddresses pool $ entityKey acc
|
||||
|
|
@ -752,11 +778,11 @@ deshieldNotes ::
|
|||
-> ZcashAccountId
|
||||
-> Int
|
||||
-> ProposedNote
|
||||
-> NoLoggingT IO (Either TxError HexString)
|
||||
-> LoggingT IO (Either TxError HexString)
|
||||
deshieldNotes pool zebraHost zebraPort znet za bh pnote = do
|
||||
bal <- liftIO $ getShieldedBalance pool za
|
||||
let zats = ceilingFloatInteger $ pn_amt pnote * (10 ^ 8)
|
||||
if bal > (20000 + zats)
|
||||
let zats = pn_amt pnote * scientific 1 8
|
||||
if fromInteger bal > (scientific 2 4 + zats)
|
||||
then prepareTxV2 pool zebraHost zebraPort znet za bh [pnote] Low
|
||||
else return $ Left InsufficientFunds
|
||||
|
||||
|
|
@ -771,9 +797,11 @@ shieldTransparentNotes ::
|
|||
shieldTransparentNotes pool zebraHost zebraPort znet za bh = do
|
||||
accRead <- liftIO $ getAccountById pool za
|
||||
logDebugN $ T.pack $ "Target block: " ++ show bh
|
||||
trees <- liftIO $ getCommitmentTrees zebraHost zebraPort bh
|
||||
let sT = SaplingCommitmentTree $ ztiSapling trees
|
||||
let oT = OrchardCommitmentTree $ ztiOrchard trees
|
||||
{-
|
||||
-trees <- liftIO $ getCommitmentTrees zebraHost zebraPort bh
|
||||
-let sT = SaplingCommitmentTree $ ztiSapling trees
|
||||
-let oT = OrchardCommitmentTree $ ztiOrchard trees
|
||||
-}
|
||||
case accRead of
|
||||
Nothing -> do
|
||||
logErrorN "Can't find Account"
|
||||
|
|
@ -810,8 +838,8 @@ shieldTransparentNotes pool zebraHost zebraPort znet za bh = do
|
|||
True
|
||||
let tx =
|
||||
createTransaction
|
||||
(Just sT)
|
||||
(Just oT)
|
||||
Nothing
|
||||
Nothing
|
||||
tSpends
|
||||
[]
|
||||
[]
|
||||
|
|
@ -871,15 +899,17 @@ prepareTxV2 ::
|
|||
-> Int
|
||||
-> [ProposedNote]
|
||||
-> PrivacyPolicy
|
||||
-> NoLoggingT IO (Either TxError HexString)
|
||||
-> LoggingT IO (Either TxError HexString)
|
||||
prepareTxV2 pool zebraHost zebraPort zn za bh pnotes policy = do
|
||||
accRead <- liftIO $ getAccountById pool za
|
||||
let recipients = map extractReceiver pnotes
|
||||
logDebugN $ T.pack $ show recipients
|
||||
logDebugN $ T.pack $ "Target block: " ++ show bh
|
||||
trees <- liftIO $ getCommitmentTrees zebraHost zebraPort bh
|
||||
let sT = SaplingCommitmentTree $ ztiSapling trees
|
||||
let oT = OrchardCommitmentTree $ ztiOrchard trees
|
||||
{-
|
||||
-trees <- liftIO $ getCommitmentTrees zebraHost zebraPort bh
|
||||
-let sT = SaplingCommitmentTree $ ztiSapling trees
|
||||
-let oT = OrchardCommitmentTree $ ztiOrchard trees
|
||||
-}
|
||||
case accRead of
|
||||
Nothing -> do
|
||||
logErrorN "Can't find Account"
|
||||
|
|
@ -887,164 +917,199 @@ prepareTxV2 pool zebraHost zebraPort zn za bh pnotes policy = do
|
|||
Just acc -> do
|
||||
logDebugN $ T.pack $ show acc
|
||||
let amt = foldl' (\x y -> x + pn_amt y) 0 pnotes
|
||||
let zats = ceilingFloatInteger $ amt * (10 ^ 8)
|
||||
logDebugN $ "amt: " <> T.pack (show amt)
|
||||
logDebugN $ "zats: " <> T.pack (show zats)
|
||||
{-firstPass <- liftIO $ selectUnspentNotes pool za zats-}
|
||||
--let fee = calculateTxFee firstPass $ fst recipient
|
||||
--logDebugN $ T.pack $ "calculated fee " ++ show fee
|
||||
notePlan <-
|
||||
liftIO $
|
||||
selectUnspentNotesV2
|
||||
pool
|
||||
za
|
||||
(zats + 10000)
|
||||
(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 <-
|
||||
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 $ "zats: " <> T.pack (show zats)
|
||||
{-firstPass <- liftIO $ selectUnspentNotes pool za zats-}
|
||||
--let fee = calculateTxFee firstPass $ fst recipient
|
||||
--logDebugN $ T.pack $ "calculated fee " ++ show fee
|
||||
notePlan <-
|
||||
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 recipients (noteTotal - 5000 - zats) policy
|
||||
case dummy' of
|
||||
Left e -> return $ Left e
|
||||
Right dummy -> do
|
||||
logDebugN "Calculating fee"
|
||||
let feeResponse =
|
||||
createTransaction
|
||||
(Just sT)
|
||||
(Just oT)
|
||||
tSpends
|
||||
sSpends
|
||||
oSpends
|
||||
dummy
|
||||
zn
|
||||
bh
|
||||
False
|
||||
case feeResponse of
|
||||
Left e1 -> return $ Left Fee
|
||||
Right fee -> do
|
||||
let feeAmt =
|
||||
fromIntegral
|
||||
(runGet getInt64le $ LBS.fromStrict $ toBytes fee)
|
||||
finalNotePlan <-
|
||||
liftIO $
|
||||
selectUnspentNotesV2
|
||||
pool
|
||||
za
|
||||
(zats + feeAmt)
|
||||
(map (\(x, _, _, _) -> x) recipients)
|
||||
policy
|
||||
case finalNotePlan 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 <-
|
||||
selectUnspentNotesV2
|
||||
pool
|
||||
za
|
||||
(zats + 10000)
|
||||
(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 $
|
||||
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
|
||||
recipients
|
||||
(noteTotal - 5000 - fromIntegral zats)
|
||||
policy
|
||||
case dummy' of
|
||||
Left e -> return $ Left e
|
||||
Right dummy -> do
|
||||
logDebugN "Calculating fee"
|
||||
let feeResponse =
|
||||
createTransaction
|
||||
Nothing
|
||||
Nothing
|
||||
tSpends
|
||||
sSpends
|
||||
oSpends
|
||||
dummy
|
||||
zn
|
||||
bh
|
||||
False
|
||||
case feeResponse of
|
||||
Left e1 -> return $ Left Fee
|
||||
Right fee -> do
|
||||
let feeAmt =
|
||||
fromIntegral
|
||||
(runGet getInt64le $ LBS.fromStrict $ toBytes fee)
|
||||
finalNotePlan <-
|
||||
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 - zats)
|
||||
selectUnspentNotesV2
|
||||
pool
|
||||
za
|
||||
(fromIntegral zats + feeAmt)
|
||||
(map (\(x, _, _, _) -> x) recipients)
|
||||
policy
|
||||
logDebugN $ T.pack $ show outgoing'
|
||||
case outgoing' of
|
||||
case finalNotePlan 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
|
||||
Right outgoing -> do
|
||||
let tx =
|
||||
createTransaction
|
||||
(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
|
||||
Left e -> do
|
||||
logErrorN $ T.pack $ show e
|
||||
return $ Left e
|
||||
where
|
||||
extractReceiver :: ProposedNote -> (Int, BS.ByteString, Int, T.Text)
|
||||
extractReceiver :: ProposedNote -> (Int, BS.ByteString, Int64, T.Text)
|
||||
extractReceiver (ProposedNote (ValidAddressAPI va) amt m) =
|
||||
let zats = fromIntegral $ floorFloatInteger $ amt * (10 ^ 8)
|
||||
in case va of
|
||||
Unified ua ->
|
||||
case o_rec ua of
|
||||
Nothing ->
|
||||
case s_rec ua of
|
||||
let zats' = toBoundedInteger $ amt * scientific 1 8
|
||||
in case zats' of
|
||||
Nothing -> (0, "", 0, "")
|
||||
Just zats ->
|
||||
case va of
|
||||
Unified ua ->
|
||||
case o_rec ua of
|
||||
Nothing ->
|
||||
case t_rec ua of
|
||||
Nothing -> (0, "", 0, "")
|
||||
Just r3 ->
|
||||
case tr_type r3 of
|
||||
P2PKH ->
|
||||
(1, toBytes $ tr_bytes r3, zats, fromMaybe "" m)
|
||||
P2SH ->
|
||||
(2, toBytes $ tr_bytes r3, zats, fromMaybe "" m)
|
||||
Just r2 -> (3, getBytes r2, zats, fromMaybe "" m)
|
||||
Just r1 -> (4, getBytes r1, zats, fromMaybe "" m)
|
||||
Sapling sa -> (3, getBytes $ sa_receiver sa, zats, fromMaybe "" m)
|
||||
Transparent ta ->
|
||||
case tr_type (ta_receiver ta) of
|
||||
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)
|
||||
case s_rec ua of
|
||||
Nothing ->
|
||||
case t_rec ua of
|
||||
Nothing -> (0, "", 0, "")
|
||||
Just r3 ->
|
||||
case tr_type r3 of
|
||||
P2PKH ->
|
||||
( 1
|
||||
, toBytes $ tr_bytes r3
|
||||
, zats
|
||||
, fromMaybe "" m)
|
||||
P2SH ->
|
||||
( 2
|
||||
, toBytes $ tr_bytes r3
|
||||
, zats
|
||||
, fromMaybe "" m)
|
||||
Just r2 -> (3, getBytes r2, zats, fromMaybe "" m)
|
||||
Just r1 -> (4, getBytes r1, zats, fromMaybe "" m)
|
||||
Sapling sa ->
|
||||
(3, getBytes $ sa_receiver sa, zats, fromMaybe "" m)
|
||||
Transparent ta ->
|
||||
case tr_type (ta_receiver ta) of
|
||||
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 ::
|
||||
ZcashAccount -> (Int, BS.ByteString, Int, T.Text) -> OutgoingNote
|
||||
ZcashAccount -> (Int, BS.ByteString, Int64, T.Text) -> OutgoingNote
|
||||
prepareOutgoingNote zac (k, r, a, m) =
|
||||
OutgoingNote
|
||||
(if k == 5
|
||||
|
|
@ -1062,8 +1127,8 @@ prepareTxV2 pool zebraHost zebraPort zn za bh pnotes policy = do
|
|||
False
|
||||
makeOutgoing ::
|
||||
Entity ZcashAccount
|
||||
-> [(Int, BS.ByteString, Int, T.Text)]
|
||||
-> Integer
|
||||
-> [(Int, BS.ByteString, Int64, T.Text)]
|
||||
-> Int64
|
||||
-> PrivacyPolicy
|
||||
-> IO (Either TxError [OutgoingNote])
|
||||
makeOutgoing acc recvs chg pol = do
|
||||
|
|
@ -1195,7 +1260,7 @@ prepareTxV2 pool zebraHost zebraPort zn za bh pnotes policy = do
|
|||
( [Entity WalletTrNote]
|
||||
, [Entity WalletSapNote]
|
||||
, [Entity WalletOrchNote])
|
||||
-> Integer
|
||||
-> Int64
|
||||
getTotalAmount (t, s, o) =
|
||||
sum (map (fromIntegral . walletTrNoteValue . entityVal) t) +
|
||||
sum (map (fromIntegral . walletSapNoteValue . entityVal) s) +
|
||||
|
|
@ -1300,16 +1365,18 @@ syncWallet config w = do
|
|||
let startBlock =
|
||||
if lastBlock > 0
|
||||
then lastBlock
|
||||
else zcashWalletBirthdayHeight $ entityVal w
|
||||
else 1 + zcashWalletBirthdayHeight (entityVal w)
|
||||
logDebugN $ "start block: " <> T.pack (show startBlock)
|
||||
mapM_ (liftIO . findTransparentNotes pool startBlock znet) addrs
|
||||
mapM_ (liftIO . findTransparentNotes pool startBlock znet) intAddrs
|
||||
logDebugN "processed transparent notes"
|
||||
mapM_ (liftIO . findTransparentSpends pool . entityKey) accs
|
||||
logDebugN "processed transparent spends"
|
||||
mapM_
|
||||
(findSaplingOutputs config startBlock (zcashWalletNetwork $ entityVal w))
|
||||
accs
|
||||
liftIO $
|
||||
runNoLoggingT $
|
||||
mapM_
|
||||
(findSaplingOutputs config startBlock (zcashWalletNetwork $ entityVal w))
|
||||
accs
|
||||
logDebugN "processed sapling outputs"
|
||||
liftIO $
|
||||
mapM_
|
||||
|
|
|
|||
|
|
@ -698,6 +698,7 @@ saveAddress pool w =
|
|||
runNoLoggingT $
|
||||
PS.retryOnBusy $ flip PS.runSqlPool pool $ insertUniqueEntity w
|
||||
|
||||
-- * Block
|
||||
-- | Save a block to the database
|
||||
saveBlock :: ConnectionPool -> ZcashBlock -> IO (Key ZcashBlock)
|
||||
saveBlock pool b =
|
||||
|
|
@ -714,6 +715,20 @@ getBlock pool b =
|
|||
where_ $ bl ^. ZcashBlockHeight ==. val b
|
||||
pure bl
|
||||
|
||||
getBlockHash :: ConnectionPool -> Int -> IO (Maybe HexString)
|
||||
getBlockHash pool b = do
|
||||
r <-
|
||||
runNoLoggingT $
|
||||
PS.retryOnBusy $
|
||||
flip PS.runSqlPool pool $ do
|
||||
selectOne $ do
|
||||
bl <- from $ table @ZcashBlock
|
||||
where_ $ bl ^. ZcashBlockHeight ==. val b
|
||||
pure $ bl ^. ZcashBlockHash
|
||||
case r of
|
||||
Nothing -> return Nothing
|
||||
Just (Value h) -> return $ Just $ getHex h
|
||||
|
||||
-- | Save a transaction to the data model
|
||||
saveTransaction ::
|
||||
ConnectionPool -- ^ the database path
|
||||
|
|
@ -1776,12 +1791,16 @@ getUnspentSapNotes pool = do
|
|||
where_ (n ^. WalletSapNoteSpent ==. val False)
|
||||
pure n
|
||||
|
||||
getSaplingCmus :: Pool SqlBackend -> ShieldOutputId -> IO [Value HexStringDB]
|
||||
getSaplingCmus pool zt = do
|
||||
getSaplingCmus ::
|
||||
ConnectionPool
|
||||
-> ShieldOutputId
|
||||
-> ShieldOutputId
|
||||
-> IO [Value HexStringDB]
|
||||
getSaplingCmus pool zt m = do
|
||||
PS.runSqlPool
|
||||
(select $ do
|
||||
n <- from $ table @ShieldOutput
|
||||
where_ (n ^. ShieldOutputId >. val zt)
|
||||
where_ (n ^. ShieldOutputId >. val zt &&. n ^. ShieldOutputId <=. val m)
|
||||
orderBy [asc $ n ^. ShieldOutputId]
|
||||
pure $ n ^. ShieldOutputCmu)
|
||||
pool
|
||||
|
|
@ -1840,12 +1859,13 @@ getUnspentOrchNotes pool = do
|
|||
where_ (n ^. WalletOrchNoteSpent ==. val False)
|
||||
pure n
|
||||
|
||||
getOrchardCmxs :: Pool SqlBackend -> OrchActionId -> IO [Value HexStringDB]
|
||||
getOrchardCmxs pool zt = do
|
||||
getOrchardCmxs ::
|
||||
ConnectionPool -> OrchActionId -> OrchActionId -> IO [Value HexStringDB]
|
||||
getOrchardCmxs pool zt m = do
|
||||
PS.runSqlPool
|
||||
(select $ do
|
||||
n <- from $ table @OrchAction
|
||||
where_ (n ^. OrchActionId >. val zt)
|
||||
where_ (n ^. OrchActionId >. val zt &&. n ^. OrchActionId <=. val m)
|
||||
orderBy [asc $ n ^. OrchActionId]
|
||||
pure $ n ^. OrchActionCmx)
|
||||
pool
|
||||
|
|
@ -2339,7 +2359,7 @@ selectUnspentNotes pool za amt = do
|
|||
selectUnspentNotesV2 ::
|
||||
ConnectionPool
|
||||
-> ZcashAccountId
|
||||
-> Integer
|
||||
-> Int64
|
||||
-> [Int]
|
||||
-> PrivacyPolicy
|
||||
-> IO
|
||||
|
|
|
|||
|
|
@ -17,6 +17,7 @@ import Data.Aeson
|
|||
import qualified Data.ByteString as BS
|
||||
import Data.HexString (toText)
|
||||
import Data.Maybe (fromMaybe, isJust, isNothing)
|
||||
import Data.Scientific (Scientific, fromFloatDigits)
|
||||
import qualified Data.Text as T
|
||||
import qualified Data.Text.Encoding as E
|
||||
import Data.Time.Clock.POSIX (posixSecondsToUTCTime)
|
||||
|
|
@ -1244,7 +1245,7 @@ handleEvent wenv node model evt =
|
|||
(model ^. network)
|
||||
(entityKey acc)
|
||||
(zcashWalletLastSync $ entityVal wal)
|
||||
(model ^. sendAmount)
|
||||
(fromFloatDigits $ model ^. sendAmount)
|
||||
(model ^. sendRecipient)
|
||||
(model ^. sendMemo)
|
||||
(model ^. privacyChoice)
|
||||
|
|
@ -1631,12 +1632,12 @@ scanZebra dbPath zHost zPort net sendMsg = do
|
|||
if syncChk
|
||||
then sendMsg (ShowError "Sync already in progress")
|
||||
else do
|
||||
unless (chkBlock == dbBlock) $
|
||||
runStderrLoggingT $ rewindWalletData pool chkBlock
|
||||
let sb =
|
||||
if chkBlock == dbBlock
|
||||
then max dbBlock b
|
||||
else max chkBlock b
|
||||
unless (chkBlock == dbBlock || chkBlock == 1) $
|
||||
runStderrLoggingT $ rewindWalletData pool sb
|
||||
if sb > zgb_blocks bStatus || sb < 1
|
||||
then sendMsg (ShowError "Invalid starting block for scan")
|
||||
else do
|
||||
|
|
@ -1701,7 +1702,7 @@ sendTransaction ::
|
|||
-> ZcashNet
|
||||
-> ZcashAccountId
|
||||
-> Int
|
||||
-> Float
|
||||
-> Scientific
|
||||
-> T.Text
|
||||
-> T.Text
|
||||
-> PrivacyPolicy
|
||||
|
|
@ -1717,7 +1718,7 @@ sendTransaction config znet accId bl amt ua memo policy sendMsg = do
|
|||
let zPort = c_zebraPort config
|
||||
pool <- runNoLoggingT $ initPool dbPath
|
||||
res <-
|
||||
runNoLoggingT $
|
||||
runStderrLoggingT $
|
||||
prepareTxV2
|
||||
pool
|
||||
zHost
|
||||
|
|
|
|||
|
|
@ -833,7 +833,7 @@ zenithServer state = getinfo :<|> handleRPC
|
|||
forkIO $ do
|
||||
res <-
|
||||
liftIO $
|
||||
runNoLoggingT $
|
||||
runStderrLoggingT $
|
||||
prepareTxV2
|
||||
pool
|
||||
zHost
|
||||
|
|
@ -892,12 +892,12 @@ scanZebra dbPath zHost zPort net = do
|
|||
chkBlock <- checkIntegrity dbPath zHost zPort dbBlock 1
|
||||
syncChk <- isSyncing pool
|
||||
unless syncChk $ do
|
||||
unless (chkBlock == dbBlock) $
|
||||
runStderrLoggingT $ rewindWalletData pool chkBlock
|
||||
let sb =
|
||||
if chkBlock == dbBlock
|
||||
then max dbBlock b
|
||||
else max chkBlock b
|
||||
unless (chkBlock == dbBlock || chkBlock == 1) $
|
||||
runStderrLoggingT $ rewindWalletData pool sb
|
||||
unless (sb > zgb_blocks bStatus || sb < 1) $ do
|
||||
let bList = [(sb + 1) .. (zgb_blocks bStatus)]
|
||||
unless (null bList) $ do
|
||||
|
|
|
|||
|
|
@ -17,6 +17,7 @@ import qualified Data.ByteString.Char8 as C
|
|||
import Data.HexString
|
||||
import Data.Int (Int64)
|
||||
import Data.Maybe (fromMaybe)
|
||||
import Data.Scientific (Scientific)
|
||||
import qualified Data.Text as T
|
||||
import qualified Data.Text.Encoding as E
|
||||
import Data.Text.Encoding.Error (lenientDecode)
|
||||
|
|
@ -241,7 +242,7 @@ instance ToJSON ValidAddressAPI where
|
|||
|
||||
data ProposedNote = ProposedNote
|
||||
{ pn_addr :: !ValidAddressAPI
|
||||
, pn_amt :: !Float
|
||||
, pn_amt :: !Scientific
|
||||
, pn_memo :: !(Maybe T.Text)
|
||||
} deriving (Eq, Prelude.Show)
|
||||
|
||||
|
|
|
|||
|
|
@ -13,26 +13,31 @@ import qualified Data.Text.Encoding as E
|
|||
import System.Directory
|
||||
import System.Process (createProcess_, shell)
|
||||
import Text.Regex.Posix
|
||||
import ZcashHaskell.Orchard (encodeUnifiedAddress, isValidUnifiedAddress, parseAddress)
|
||||
import ZcashHaskell.Orchard
|
||||
( encodeUnifiedAddress
|
||||
, isValidUnifiedAddress
|
||||
, parseAddress
|
||||
)
|
||||
import ZcashHaskell.Sapling (decodeSaplingAddress, isValidShieldedAddress)
|
||||
import ZcashHaskell.Transparent
|
||||
( decodeExchangeAddress
|
||||
, decodeTransparentAddress
|
||||
)
|
||||
import ZcashHaskell.Types
|
||||
( SaplingAddress(..)
|
||||
( ExchangeAddress(..)
|
||||
, SaplingAddress(..)
|
||||
, TransparentAddress(..)
|
||||
, UnifiedAddress(..)
|
||||
, ZcashNet(..)
|
||||
, ValidAddress(..)
|
||||
, ExchangeAddress(..)
|
||||
, ZcashNet(..)
|
||||
)
|
||||
import ZcashHaskell.Utils (makeZebraCall)
|
||||
import Zenith.Types
|
||||
( AddressGroup(..)
|
||||
, PrivacyPolicy(..)
|
||||
, UnifiedAddressDB(..)
|
||||
, ZcashAddress(..)
|
||||
, ZcashPool(..)
|
||||
, PrivacyPolicy(..)
|
||||
)
|
||||
|
||||
-- | Helper function to convert numbers into JSON
|
||||
|
|
@ -127,9 +132,9 @@ isRecipientValid a = do
|
|||
|
||||
isUnifiedAddressValid :: T.Text -> Bool
|
||||
isUnifiedAddressValid ua =
|
||||
case isValidUnifiedAddress (E.encodeUtf8 ua) of
|
||||
Just _a1 -> True
|
||||
Nothing -> False
|
||||
case isValidUnifiedAddress (E.encodeUtf8 ua) of
|
||||
Just _a1 -> True
|
||||
Nothing -> False
|
||||
|
||||
isSaplingAddressValid :: T.Text -> Bool
|
||||
isSaplingAddressValid sa = isValidShieldedAddress (E.encodeUtf8 sa)
|
||||
|
|
@ -137,8 +142,8 @@ isSaplingAddressValid sa = isValidShieldedAddress (E.encodeUtf8 sa)
|
|||
isTransparentAddressValid :: T.Text -> Bool
|
||||
isTransparentAddressValid ta =
|
||||
case decodeTransparentAddress (E.encodeUtf8 ta) of
|
||||
Just _a3 -> True
|
||||
Nothing -> False
|
||||
Just _a3 -> True
|
||||
Nothing -> False
|
||||
|
||||
isExchangeAddressValid :: T.Text -> Bool
|
||||
isExchangeAddressValid xa =
|
||||
|
|
@ -147,40 +152,44 @@ isExchangeAddressValid xa =
|
|||
Nothing -> False
|
||||
|
||||
isRecipientValidGUI :: PrivacyPolicy -> T.Text -> Bool
|
||||
isRecipientValidGUI p a = do
|
||||
isRecipientValidGUI p a = do
|
||||
let adr = parseAddress (E.encodeUtf8 a)
|
||||
case p of
|
||||
Full -> case adr of
|
||||
Just a ->
|
||||
case a of
|
||||
Unified ua -> True
|
||||
Sapling sa -> True
|
||||
_ -> False
|
||||
Nothing -> False
|
||||
Medium -> case adr of
|
||||
Just a ->
|
||||
case a of
|
||||
Unified ua -> True
|
||||
Sapling sa -> True
|
||||
_ -> False
|
||||
Nothing -> False
|
||||
Low -> case adr of
|
||||
Just a ->
|
||||
case a of
|
||||
Unified ua -> True
|
||||
Sapling sa -> True
|
||||
Transparent ta -> True
|
||||
_ -> False
|
||||
Nothing -> False
|
||||
None -> case adr of
|
||||
Just a ->
|
||||
case a of
|
||||
Transparent ta -> True
|
||||
Exchange ea -> True
|
||||
_ -> False
|
||||
Nothing -> False
|
||||
case p of
|
||||
Full ->
|
||||
case adr of
|
||||
Just a ->
|
||||
case a of
|
||||
Unified ua -> True
|
||||
Sapling sa -> True
|
||||
_ -> False
|
||||
Nothing -> False
|
||||
Medium ->
|
||||
case adr of
|
||||
Just a ->
|
||||
case a of
|
||||
Unified ua -> True
|
||||
Sapling sa -> True
|
||||
_ -> False
|
||||
Nothing -> False
|
||||
Low ->
|
||||
case adr of
|
||||
Just a ->
|
||||
case a of
|
||||
Unified ua -> True
|
||||
Sapling sa -> True
|
||||
Transparent ta -> True
|
||||
_ -> False
|
||||
Nothing -> False
|
||||
None ->
|
||||
case adr of
|
||||
Just a ->
|
||||
case a of
|
||||
Transparent ta -> True
|
||||
Exchange ea -> True
|
||||
_ -> False
|
||||
Nothing -> False
|
||||
|
||||
isZecAddressValid :: T.Text -> Bool
|
||||
isZecAddressValid :: T.Text -> Bool
|
||||
isZecAddressValid a = do
|
||||
case isValidUnifiedAddress (E.encodeUtf8 a) of
|
||||
Just _a1 -> True
|
||||
|
|
@ -232,3 +241,10 @@ padWithZero n s
|
|||
isEmpty :: [a] -> Bool
|
||||
isEmpty [] = True
|
||||
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
|
||||
|
|
|
|||
23
test/Spec.hs
23
test/Spec.hs
|
|
@ -2,6 +2,7 @@
|
|||
|
||||
import Control.Monad (when)
|
||||
import Control.Monad.Logger (runFileLoggingT, runNoLoggingT)
|
||||
import Data.Aeson
|
||||
import Data.HexString
|
||||
import Data.Maybe (fromJust)
|
||||
import qualified Data.Text.Encoding as E
|
||||
|
|
@ -33,8 +34,10 @@ import ZcashHaskell.Types
|
|||
, Scope(..)
|
||||
, ShieldedOutput(..)
|
||||
, TxError(..)
|
||||
, ValidAddress(..)
|
||||
, ZcashNet(..)
|
||||
)
|
||||
import ZcashHaskell.Utils (makeZebraCall, readZebraTransaction)
|
||||
import Zenith.Core
|
||||
import Zenith.DB
|
||||
import Zenith.Types
|
||||
|
|
@ -182,6 +185,12 @@ main = do
|
|||
a `shouldBe`
|
||||
Just
|
||||
"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
|
||||
xit "Check Orchard notes" $ do
|
||||
pool <- runNoLoggingT $ initPool "/home/rav/Zenith/zenith.db"
|
||||
|
|
@ -573,3 +582,17 @@ main = do
|
|||
case tx of
|
||||
Left e -> assertFailure $ show e
|
||||
Right h -> h `shouldNotBe` (hexString "deadbeef")
|
||||
describe "Quick tests" $ do
|
||||
it "validate comm trees" $ do
|
||||
blockTree <- getCommitmentTrees "localhost" 18232 3034848
|
||||
hashTree <-
|
||||
makeZebraCall
|
||||
"localhost"
|
||||
18232
|
||||
"z_gettreestate"
|
||||
[ Data.Aeson.String
|
||||
"000f8a912c6c5caf476e70fa0616c17ab4e7e8c1f42e24bddeacda275d545473"
|
||||
]
|
||||
case hashTree of
|
||||
Left e -> assertFailure e
|
||||
Right hT -> blockTree `shouldBe` hT
|
||||
|
|
|
|||
Loading…
Reference in a new issue