Vergara_Tech/zenith
Vergara_Tech/zenith
2
0
Fork 0
Code Issues 21 Pull requests Projects Releases 7 Packages Wiki Activity

Compare commits

base: Vergara_Tech:117a4fa2eaaaa2354e2451e306135089934562fc
Branches Tags
Vergara_Tech:master
Vergara_Tech:milestone3
Vergara_Tech:rav001
Vergara_Tech:rvv001
Vergara_Tech:zrpc-docker
Vergara_Tech:rvv041
Vergara_Tech:zenith-install
Vergara_Tech:milestone2
Vergara_Tech:dev041
Vergara_Tech:legacy
Vergara_Tech:0.7.0.0-beta
Vergara_Tech:0.6.0.0-beta
Vergara_Tech:0.5.3.1-beta
Vergara_Tech:0.5.3.0-beta
Vergara_Tech:0.5.2.0-beta
Vergara_Tech:0.5.1.0-beta.1
Vergara_Tech:0.5.1.0-beta
Vergara_Tech:0.4.0
Vergara_Tech:0.3.4
Vergara_Tech:0.3.2
Vergara_Tech:0.3.1.0
Vergara_Tech:0.3.0.0
Vergara_Tech:0.2.0.0
Vergara_Tech:0.1.0.0
..
compare: Vergara_Tech:8a54f8fda997830621214abad118d3ee597b72ba
Branches Tags
Vergara_Tech:master
Vergara_Tech:milestone3
Vergara_Tech:rav001
Vergara_Tech:rvv001
Vergara_Tech:zrpc-docker
Vergara_Tech:rvv041
Vergara_Tech:zenith-install
Vergara_Tech:milestone2
Vergara_Tech:dev041
Vergara_Tech:legacy
Vergara_Tech:0.7.0.0-beta
Vergara_Tech:0.6.0.0-beta
Vergara_Tech:0.5.3.1-beta
Vergara_Tech:0.5.3.0-beta
Vergara_Tech:0.5.2.0-beta
Vergara_Tech:0.5.1.0-beta.1
Vergara_Tech:0.5.1.0-beta
Vergara_Tech:0.4.0
Vergara_Tech:0.3.4
Vergara_Tech:0.3.2
Vergara_Tech:0.3.1.0
Vergara_Tech:0.3.0.0
Vergara_Tech:0.2.0.0
Vergara_Tech:0.1.0.0

No commits in common. "117a4fa2eaaaa2354e2451e306135089934562fc" and "8a54f8fda997830621214abad118d3ee597b72ba" have entirely different histories.
117a4fa2ea ... 8a54f8fda9

12 changed files with 864 additions and 1009 deletions
Show stats Expand all files Collapse all files

2
CHANGELOG.md
View file

@ -22,8 +22,6 @@ and this project adheres to [Semantic Versioning](https://semver.org/spec/v2.0.0
- `getoperationstatus` RPC method - `getoperationstatus` RPC method
- `sendmany` RPC method - `sendmany` RPC method
- Function `prepareTxV2` implementing `PrivacyPolicy` - Function `prepareTxV2` implementing `PrivacyPolicy`
- Functionality to shield transparent balance
- Functionality to de-shield shielded notes
### Changed ### Changed

36
src/Zenith/CLI.hs
View file

@ -75,7 +75,6 @@ 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)
@ -120,10 +119,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
) )
@ -160,7 +159,7 @@ makeLenses ''DialogInput
data SendInput = SendInput data SendInput = SendInput
{ _sendTo :: !T.Text { _sendTo :: !T.Text
, _sendAmt :: !Scientific , _sendAmt :: !Float
, _sendMemo :: !T.Text , _sendMemo :: !T.Text
, _policyField :: !PrivacyPolicy , _policyField :: !PrivacyPolicy
} deriving (Show) } deriving (Show)
@ -175,7 +174,7 @@ data AdrBookEntry = AdrBookEntry
makeLenses ''AdrBookEntry makeLenses ''AdrBookEntry
newtype ShDshEntry = ShDshEntry newtype ShDshEntry = ShDshEntry
{ _shAmt :: Scientific { _shAmt :: Float
} deriving (Show) } deriving (Show)
makeLenses ''ShDshEntry makeLenses ''ShDshEntry
@ -702,8 +701,8 @@ mkSendForm bal =
, label "Memo: " @@= editTextField sendMemo MemoField (Just 1) , label "Memo: " @@= editTextField sendMemo MemoField (Just 1)
] ]
where where
isAmountValid :: Integer -> Scientific -> Bool isAmountValid :: Integer -> Float -> Bool
isAmountValid b i = fromIntegral b >= (i * scientific 1 8) isAmountValid b i = (fromIntegral b / 100000000.0) >= i
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
@ -714,8 +713,8 @@ mkDeshieldForm tbal =
editShowableFieldWithValidate shAmt AmtField (isAmountValid tbal) editShowableFieldWithValidate shAmt AmtField (isAmountValid tbal)
] ]
where where
isAmountValid :: Integer -> Scientific -> Bool isAmountValid :: Integer -> Float -> Bool
isAmountValid b i = fromIntegral b >= (i * scientific 1 8) isAmountValid b i = (fromIntegral b / 100000000.0) >= i
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
@ -832,7 +831,7 @@ scanZebra dbP zHost zPort b eChan znet = do
bStatus <- liftIO $ checkBlockChain zHost zPort bStatus <- liftIO $ checkBlockChain zHost zPort
pool <- liftIO $ runNoLoggingT $ initPool dbP pool <- liftIO $ runNoLoggingT $ initPool dbP
dbBlock <- liftIO $ getMaxBlock pool $ ZcashNetDB znet dbBlock <- liftIO $ getMaxBlock pool $ ZcashNetDB znet
chkBlock <- liftIO $ checkIntegrity dbP zHost zPort znet dbBlock 1 chkBlock <- liftIO $ checkIntegrity dbP zHost zPort dbBlock 1
syncChk <- liftIO $ isSyncing pool syncChk <- liftIO $ isSyncing pool
if syncChk if syncChk
then liftIO $ BC.writeBChan eChan $ TickMsg "Sync alread in progress" then liftIO $ BC.writeBChan eChan $ TickMsg "Sync alread in progress"
@ -840,12 +839,11 @@ scanZebra dbP zHost zPort b eChan znet = do
logDebugN $ logDebugN $
"dbBlock: " <> "dbBlock: " <>
T.pack (show dbBlock) <> " chkBlock: " <> T.pack (show chkBlock) T.pack (show dbBlock) <> " chkBlock: " <> T.pack (show chkBlock)
when (chkBlock /= dbBlock) $ rewindWalletData pool chkBlock
let sb = let sb =
if chkBlock == dbBlock if chkBlock == dbBlock
then max dbBlock b then max dbBlock b
else max chkBlock b else max chkBlock b
when (chkBlock /= dbBlock && chkBlock /= 1) $
rewindWalletData pool sb $ ZcashNetDB znet
if sb > zgb_blocks bStatus || sb < 1 if sb > zgb_blocks bStatus || sb < 1
then do then do
liftIO $ liftIO $
@ -1203,8 +1201,7 @@ 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 $ liftIO $ getLastSyncBlock pool $ entityKey selWal
getChainTip (s ^. zebraHost) (s ^. zebraPort)
_ <- _ <-
liftIO $ liftIO $
forkIO $ forkIO $
@ -1215,7 +1212,7 @@ appEvent (BT.VtyEvent e) = do
(s ^. zebraPort) (s ^. zebraPort)
(s ^. network) (s ^. network)
(entityKey selAcc) (entityKey selAcc)
(bl + 5) bl
(fs1 ^. sendAmt) (fs1 ^. sendAmt)
(fs1 ^. sendTo) (fs1 ^. sendTo)
(fs1 ^. sendMemo) (fs1 ^. sendMemo)
@ -1295,8 +1292,7 @@ appEvent (BT.VtyEvent e) = do
getUA . walletAddressUAddress) getUA . walletAddressUAddress)
(entityVal selAddr))) (entityVal selAddr)))
bl <- bl <-
liftIO $ liftIO $ getLastSyncBlock pool $ entityKey selWal
getChainTip (s ^. zebraHost) (s ^. zebraPort)
case tAddrMaybe of case tAddrMaybe of
Nothing -> do Nothing -> do
BT.modify $ BT.modify $
@ -1998,7 +1994,7 @@ sendTransaction ::
-> ZcashNet -> ZcashNet
-> ZcashAccountId -> ZcashAccountId
-> Int -> Int
-> Scientific -> Float
-> T.Text -> T.Text
-> T.Text -> T.Text
-> PrivacyPolicy -> PrivacyPolicy
@ -2009,7 +2005,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 <-
runStderrLoggingT $ runNoLoggingT $
prepareTxV2 prepareTxV2
pool pool
zHost zHost
@ -2025,10 +2021,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
@ -2077,7 +2073,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 <- runStderrLoggingT $ deshieldNotes pool zHost zPort znet accId bl pnote res <- runNoLoggingT $ 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

674
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.HexString (HexString, hexBytes, hexString, toBytes, toText) import Data.Digest.Pure.MD5
import Data.Int (Int64) import Data.HexString (HexString, hexString, toBytes, toText)
import Data.List import Data.List
import Data.Maybe (fromJust, fromMaybe) import Data.Maybe (fromJust, fromMaybe)
import Data.Scientific (Scientific, scientific, toBoundedInteger) import Data.Pool (Pool)
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
@ -116,16 +116,11 @@ checkBlockChain nodeHost nodePort = do
-- | Get commitment trees from Zebra -- | Get commitment trees from Zebra
getCommitmentTrees :: getCommitmentTrees ::
ConnectionPool T.Text -- ^ Host where `zebrad` is avaiable
-> T.Text -- ^ Host where `zebrad` is avaiable
-> Int -- ^ Port where `zebrad` is available -> Int -- ^ Port where `zebrad` is available
-> ZcashNetDB
-> Int -- ^ Block height -> Int -- ^ Block height
-> IO ZebraTreeInfo -> IO ZebraTreeInfo
getCommitmentTrees pool nodeHost nodePort znet block = do getCommitmentTrees nodeHost nodePort block = do
bh' <- getBlockHash pool block znet
case bh' of
Nothing -> do
r <- r <-
makeZebraCall makeZebraCall
nodeHost nodeHost
@ -135,16 +130,6 @@ getCommitmentTrees pool nodeHost nodePort znet block = do
case r of case r of
Left e -> throwIO $ userError e Left e -> throwIO $ userError e
Right zti -> return zti Right zti -> return zti
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 -- * Spending Keys
-- | Create an Orchard Spending Key for the given wallet and account index -- | Create an Orchard Spending Key for the given wallet and account index
@ -295,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
-> NoLoggingT IO () -> LoggingT 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
@ -303,7 +288,7 @@ findSaplingOutputs config b znet za = do
let zn = getNet znet let zn = getNet znet
pool <- liftIO $ runNoLoggingT $ initPool dbPath pool <- liftIO $ runNoLoggingT $ initPool dbPath
tList <- liftIO $ getShieldedOutputs pool b znet tList <- liftIO $ getShieldedOutputs pool b znet
trees <- liftIO $ getCommitmentTrees pool zebraHost zebraPort znet (b - 1) trees <- liftIO $ getCommitmentTrees zebraHost zebraPort (b - 1)
logDebugN "getting Sapling frontier" logDebugN "getting Sapling frontier"
let sT = getSaplingFrontier $ SaplingCommitmentTree $ ztiSapling trees let sT = getSaplingFrontier $ SaplingCommitmentTree $ ztiSapling trees
case sT of case sT of
@ -322,7 +307,7 @@ findSaplingOutputs config b znet za = do
-> ZcashNet -> ZcashNet
-> ConnectionPool -> ConnectionPool
-> [(Entity ZcashTransaction, Entity ShieldOutput)] -> [(Entity ZcashTransaction, Entity ShieldOutput)]
-> NoLoggingT IO () -> LoggingT 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 =
@ -410,7 +395,7 @@ findOrchardActions config b znet za = do
let zn = getNet znet let zn = getNet znet
pool <- runNoLoggingT $ initPool dbPath pool <- runNoLoggingT $ initPool dbPath
tList <- getOrchardActions pool b znet tList <- getOrchardActions pool b znet
trees <- getCommitmentTrees pool zebraHost zebraPort znet (b - 1) trees <- getCommitmentTrees zebraHost zebraPort (b - 1)
let sT = getOrchardFrontier $ OrchardCommitmentTree $ ztiOrchard trees let sT = getOrchardFrontier $ OrchardCommitmentTree $ ztiOrchard trees
case sT of case sT of
Nothing -> throwIO $ userError "Failed to read Orchard commitment tree" Nothing -> throwIO $ userError "Failed to read Orchard commitment tree"
@ -493,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 noteSync maxId cmus <- liftIO $ getSaplingCmus pool $ walletSapNoteWitPos $ entityVal n
let cmuList = map (\(ESQ.Value x) -> getHex x) cmus let cmuList = map (\(ESQ.Value x) -> getHex x) cmus
let newWitness = let newWitness =
updateSaplingWitness updateSaplingWitness
@ -511,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 maxId cmxs <- liftIO $ getOrchardCmxs pool noteSync
let cmxList = map (\(ESQ.Value x) -> getHex x) cmxs let cmxList = map (\(ESQ.Value x) -> getHex x) cmxs
let newWitness = let newWitness =
updateOrchardWitness updateOrchardWitness
@ -522,271 +507,243 @@ updateOrchardWitnesses pool = do
-- | Calculate fee per ZIP-317 -- | Calculate fee per ZIP-317
calculateTxFee :: calculateTxFee ::
([Entity WalletTrNote], [Entity WalletSapNote], [Entity WalletOrchNote]) ([Entity WalletTrNote], [Entity WalletSapNote], [Entity WalletOrchNote])
-> [OutgoingNote] -> Int
-> Int64 -> Integer
calculateTxFee (t, s, o) nout = calculateTxFee (t, s, o) i =
fromIntegral $ 5000 * (tcount + saction + oaction) fromIntegral
(5000 * (max (length t) tout + max (length s) sout + length o + oout))
where where
tout = tout =
length $ if i == 1 || i == 2
filter then 1
(\(OutgoingNote x _ _ _ _ _) -> x == 1 || x == 2 || x == 5 || x == 6) else 0
nout sout =
sout = length $ filter (\(OutgoingNote x _ _ _ _ _) -> x == 3) nout if i == 3
oout = length $ filter (\(OutgoingNote x _ _ _ _ _) -> x == 4) nout then 1
tcount = max (length t) tout else 0
scount = max (length s) sout oout =
ocount = max (length o) oout if i == 4
saction = then 1
if scount == 1 else 0
then 2
else scount
oaction =
if ocount == 1
then 2
else ocount
-- | Prepare a transaction for sending -- | Prepare a transaction for sending
{- prepareTx ::
-prepareTx :: ConnectionPool
- ConnectionPool -> T.Text
- -> T.Text -> Int
- -> Int -> ZcashNet
- -> ZcashNet -> ZcashAccountId
- -> ZcashAccountId -> Int
- -> Int -> Float
- -> Scientific -> UnifiedAddress
- -> UnifiedAddress -> T.Text
- -> T.Text -> LoggingT IO (Either TxError HexString)
- -> LoggingT IO (Either TxError HexString) prepareTx pool zebraHost zebraPort zn za bh amt ua memo = do
-prepareTx pool zebraHost zebraPort zn za bh amt ua memo = do accRead <- liftIO $ getAccountById pool za
- accRead <- liftIO $ getAccountById pool za let recipient =
- let recipient = case o_rec ua of
- case o_rec ua of Nothing ->
- Nothing -> case s_rec ua of
- case s_rec ua of Nothing ->
- Nothing -> case t_rec ua of
- case t_rec ua of Nothing -> (0, "")
- Nothing -> (0, "") Just r3 ->
- Just r3 -> case tr_type r3 of
- case tr_type r3 of P2PKH -> (1, toBytes $ tr_bytes r3)
- P2PKH -> (1, toBytes $ tr_bytes r3) P2SH -> (2, toBytes $ tr_bytes r3)
- P2SH -> (2, toBytes $ tr_bytes r3) Just r2 -> (3, getBytes r2)
- Just r2 -> (3, getBytes r2) Just r1 -> (4, getBytes r1)
- Just r1 -> (4, getBytes r1) logDebugN $ T.pack $ show recipient
- logDebugN $ T.pack $ show recipient logDebugN $ T.pack $ "Target block: " ++ show bh
- logDebugN $ T.pack $ "Target block: " ++ show bh trees <- liftIO $ getCommitmentTrees zebraHost zebraPort bh
- trees <- let sT = SaplingCommitmentTree $ ztiSapling trees
- liftIO $ getCommitmentTrees pool zebraHost zebraPort (ZcashNetDB zn) bh let oT = OrchardCommitmentTree $ ztiOrchard trees
- let sT = SaplingCommitmentTree $ ztiSapling trees case accRead of
- let oT = OrchardCommitmentTree $ ztiOrchard trees Nothing -> do
- case accRead of logErrorN "Can't find Account"
- Nothing -> do return $ Left ZHError
- logErrorN "Can't find Account" Just acc -> do
- return $ Left ZHError logDebugN $ T.pack $ show acc
- Just acc -> do let zats = floorFloatInteger $ amt * (10 ^ 8)
- logDebugN $ T.pack $ show acc logDebugN $ T.pack $ show zats
- let zats' = toBoundedInteger $ amt * scientific 1 8 {-firstPass <- liftIO $ selectUnspentNotes pool za zats-}
- case zats' of --let fee = calculateTxFee firstPass $ fst recipient
- Nothing -> return $ Left ZHError --logDebugN $ T.pack $ "calculated fee " ++ show fee
- Just zats -> do (tList, sList, oList) <- liftIO $ selectUnspentNotes pool za (zats + 5000)
- logDebugN $ T.pack $ show (zats :: Int64) logDebugN "selected notes"
- {-firstPass <- liftIO $ selectUnspentNotes pool za zats-} logDebugN $ T.pack $ show tList
- --let fee = calculateTxFee firstPass $ fst recipient logDebugN $ T.pack $ show sList
- --logDebugN $ T.pack $ "calculated fee " ++ show fee logDebugN $ T.pack $ show oList
- (tList, sList, oList) <- let noteTotal = getTotalAmount (tList, sList, oList)
- liftIO $ selectUnspentNotes pool za (fromIntegral $ zats + 5000) tSpends <-
- logDebugN "selected notes" liftIO $
- logDebugN $ T.pack $ show tList prepTSpends (getTranSK $ zcashAccountTPrivateKey $ entityVal acc) tList
- logDebugN $ T.pack $ show sList --print tSpends
- logDebugN $ T.pack $ show oList sSpends <-
- let noteTotal = getTotalAmount (tList, sList, oList) liftIO $
- tSpends <- prepSSpends (getSapSK $ zcashAccountSapSpendKey $ entityVal acc) sList
- liftIO $ --print sSpends
- prepTSpends oSpends <-
- (getTranSK $ zcashAccountTPrivateKey $ entityVal acc) liftIO $
- tList prepOSpends (getOrchSK $ zcashAccountOrchSpendKey $ entityVal acc) oList
- --print tSpends --print oSpends
- sSpends <- dummy <-
- liftIO $ liftIO $ makeOutgoing acc recipient zats (noteTotal - 5000 - zats)
- prepSSpends logDebugN "Calculating fee"
- (getSapSK $ zcashAccountSapSpendKey $ entityVal acc) let feeResponse =
- sList createTransaction
- --print sSpends (Just sT)
- oSpends <- (Just oT)
- liftIO $ tSpends
- prepOSpends sSpends
- (getOrchSK $ zcashAccountOrchSpendKey $ entityVal acc) oSpends
- oList dummy
- --print oSpends zn
- dummy <- (bh + 3)
- liftIO $ False
- makeOutgoing case feeResponse of
- acc Left e1 -> return $ Left Fee
- recipient Right fee -> do
- zats let feeAmt =
- (fromInteger noteTotal - 5000 - zats) fromIntegral (runGet getInt64le $ LBS.fromStrict $ toBytes fee)
- logDebugN "Calculating fee" (tList1, sList1, oList1) <-
- let feeResponse = liftIO $ selectUnspentNotes pool za (zats + feeAmt)
- createTransaction logDebugN $ T.pack $ "selected notes with fee" ++ show feeAmt
- (Just sT) logDebugN $ T.pack $ show tList
- (Just oT) logDebugN $ T.pack $ show sList
- tSpends logDebugN $ T.pack $ show oList
- sSpends outgoing <-
- oSpends liftIO $ makeOutgoing acc recipient zats (noteTotal - feeAmt - zats)
- dummy logDebugN $ T.pack $ show outgoing
- zn let tx =
- bh createTransaction
- False (Just sT)
- case feeResponse of (Just oT)
- Left e1 -> return $ Left Fee tSpends
- Right fee -> do sSpends
- let feeAmt = oSpends
- fromIntegral outgoing
- (runGet getInt64le $ LBS.fromStrict $ toBytes fee) zn
- (tList1, sList1, oList1) <- (bh + 3)
- liftIO $ selectUnspentNotes pool za (fromIntegral zats + feeAmt) True
- logDebugN $ T.pack $ "selected notes with fee" ++ show feeAmt logDebugN $ T.pack $ show tx
- logDebugN $ T.pack $ show tList return tx
- logDebugN $ T.pack $ show sList where
- logDebugN $ T.pack $ show oList makeOutgoing ::
- outgoing <- Entity ZcashAccount
- liftIO $ -> (Int, BS.ByteString)
- makeOutgoing -> Integer
- acc -> Integer
- recipient -> IO [OutgoingNote]
- zats makeOutgoing acc (k, recvr) zats chg = do
- (fromInteger noteTotal - fromInteger feeAmt - zats) chgAddr <- runNoLoggingT $ getInternalAddresses pool $ entityKey acc
- logDebugN $ T.pack $ show outgoing let internalUA = getUA $ walletAddressUAddress $ entityVal $ head chgAddr
- let tx = let chgRcvr =
- createTransaction fromJust $ o_rec =<< isValidUnifiedAddress (E.encodeUtf8 internalUA)
- (Just sT) return
- (Just oT) [ OutgoingNote
- tSpends 4
- sSpends (getBytes $ getOrchSK $ zcashAccountOrchSpendKey $ entityVal acc)
- oSpends (getBytes chgRcvr)
- outgoing (fromIntegral chg)
- zn ""
- bh True
- True , OutgoingNote
- logDebugN $ T.pack $ show tx (fromIntegral k)
- return tx (case k of
- where 4 ->
- makeOutgoing :: getBytes $ getOrchSK $ zcashAccountOrchSpendKey $ entityVal acc
- Entity ZcashAccount 3 ->
- -> (Int, BS.ByteString) getBytes $ getSapSK $ zcashAccountSapSpendKey $ entityVal acc
- -> Int64 _ -> "")
- -> Int64 recvr
- -> IO [OutgoingNote] (fromIntegral zats)
- makeOutgoing acc (k, recvr) zats chg = do (E.encodeUtf8 memo)
- chgAddr <- runNoLoggingT $ getInternalAddresses pool $ entityKey acc False
- let internalUA = getUA $ walletAddressUAddress $ entityVal $ head chgAddr ]
- let chgRcvr = getTotalAmount ::
- fromJust $ o_rec =<< isValidUnifiedAddress (E.encodeUtf8 internalUA) ( [Entity WalletTrNote]
- return , [Entity WalletSapNote]
- [ OutgoingNote , [Entity WalletOrchNote])
- 4 -> Integer
- (getBytes $ getOrchSK $ zcashAccountOrchSpendKey $ entityVal acc) getTotalAmount (t, s, o) =
- (getBytes chgRcvr) sum (map (fromIntegral . walletTrNoteValue . entityVal) t) +
- (fromIntegral chg) sum (map (fromIntegral . walletSapNoteValue . entityVal) s) +
- "" sum (map (fromIntegral . walletOrchNoteValue . entityVal) o)
- True prepTSpends ::
- , OutgoingNote TransparentSpendingKey
- (fromIntegral k) -> [Entity WalletTrNote]
- (case k of -> IO [TransparentTxSpend]
- 4 -> prepTSpends sk notes = do
- getBytes $ getOrchSK $ zcashAccountOrchSpendKey $ entityVal acc forM notes $ \n -> do
- 3 -> tAddRead <- getAddressById pool $ walletTrNoteAddress $ entityVal n
- getBytes $ getSapSK $ zcashAccountSapSpendKey $ entityVal acc case tAddRead of
- _ -> "") Nothing -> throwIO $ userError "Couldn't read t-address"
- recvr Just tAdd -> do
- (fromIntegral zats) (XPrvKey _ _ _ _ (SecKey xp_key)) <-
- (E.encodeUtf8 memo) genTransparentSecretKey
- False (walletAddressIndex $ entityVal tAdd)
- ] (getScope $ walletAddressScope $ entityVal tAdd)
- getTotalAmount :: sk
- ( [Entity WalletTrNote] mReverseTxId <- getWalletTxId pool $ walletTrNoteTx $ entityVal n
- , [Entity WalletSapNote] case mReverseTxId of
- , [Entity WalletOrchNote]) Nothing -> throwIO $ userError "failed to get tx ID"
- -> Integer Just (ESQ.Value reverseTxId) -> do
- getTotalAmount (t, s, o) = let flipTxId = BS.reverse $ toBytes $ getHex reverseTxId
- sum (map (fromIntegral . walletTrNoteValue . entityVal) t) + return $
- sum (map (fromIntegral . walletSapNoteValue . entityVal) s) + TransparentTxSpend
- sum (map (fromIntegral . walletOrchNoteValue . entityVal) o) xp_key
- prepTSpends :: (RawOutPoint
- TransparentSpendingKey flipTxId
- -> [Entity WalletTrNote] (fromIntegral $ walletTrNotePosition $ entityVal n))
- -> IO [TransparentTxSpend] (RawTxOut
- prepTSpends sk notes = do (fromIntegral $ walletTrNoteValue $ entityVal n)
- forM notes $ \n -> do (walletTrNoteScript $ entityVal n))
- tAddRead <- getAddressById pool $ walletTrNoteAddress $ entityVal n prepSSpends ::
- case tAddRead of SaplingSpendingKey -> [Entity WalletSapNote] -> IO [SaplingTxSpend]
- Nothing -> throwIO $ userError "Couldn't read t-address" prepSSpends sk notes = do
- Just tAdd -> do forM notes $ \n -> do
- (XPrvKey _ _ _ _ (SecKey xp_key)) <- return $
- genTransparentSecretKey SaplingTxSpend
- (walletAddressIndex $ entityVal tAdd) (getBytes sk)
- (getScope $ walletAddressScope $ entityVal tAdd) (DecodedNote
- sk (fromIntegral $ walletSapNoteValue $ entityVal n)
- mReverseTxId <- getWalletTxId pool $ walletTrNoteTx $ entityVal n (walletSapNoteRecipient $ entityVal n)
- case mReverseTxId of (E.encodeUtf8 $ walletSapNoteMemo $ entityVal n)
- Nothing -> throwIO $ userError "failed to get tx ID" (getHex $ walletSapNoteNullifier $ entityVal n)
- Just (ESQ.Value reverseTxId) -> do ""
- let flipTxId = BS.reverse $ toBytes $ getHex reverseTxId (getRseed $ walletSapNoteRseed $ entityVal n))
- return $ (toBytes $ getHex $ walletSapNoteWitness $ entityVal n)
- TransparentTxSpend prepOSpends ::
- xp_key OrchardSpendingKey -> [Entity WalletOrchNote] -> IO [OrchardTxSpend]
- (RawOutPoint prepOSpends sk notes = do
- flipTxId forM notes $ \n -> do
- (fromIntegral $ walletTrNotePosition $ entityVal n)) return $
- (RawTxOut OrchardTxSpend
- (fromIntegral $ walletTrNoteValue $ entityVal n) (getBytes sk)
- (walletTrNoteScript $ entityVal n)) (DecodedNote
- prepSSpends :: (fromIntegral $ walletOrchNoteValue $ entityVal n)
- SaplingSpendingKey -> [Entity WalletSapNote] -> IO [SaplingTxSpend] (walletOrchNoteRecipient $ entityVal n)
- prepSSpends sk notes = do (E.encodeUtf8 $ walletOrchNoteMemo $ entityVal n)
- forM notes $ \n -> do (getHex $ walletOrchNoteNullifier $ entityVal n)
- return $ (walletOrchNoteRho $ entityVal n)
- SaplingTxSpend (getRseed $ walletOrchNoteRseed $ entityVal n))
- (getBytes sk) (toBytes $ getHex $ walletOrchNoteWitness $ entityVal n)
- (DecodedNote sapAnchor :: [Entity WalletSapNote] -> Maybe SaplingWitness
- (fromIntegral $ walletSapNoteValue $ entityVal n) sapAnchor notes =
- (walletSapNoteRecipient $ entityVal n) if not (null notes)
- (E.encodeUtf8 $ walletSapNoteMemo $ entityVal n) then Just $
- (getHex $ walletSapNoteNullifier $ entityVal n) SaplingWitness $
- "" getHex $ walletSapNoteWitness $ entityVal $ head notes
- (getRseed $ walletSapNoteRseed $ entityVal n)) else Nothing
- (toBytes $ getHex $ walletSapNoteWitness $ entityVal n) orchAnchor :: [Entity WalletOrchNote] -> Maybe OrchardWitness
- prepOSpends :: orchAnchor notes =
- OrchardSpendingKey -> [Entity WalletOrchNote] -> IO [OrchardTxSpend] if not (null notes)
- prepOSpends sk notes = do then Just $
- forM notes $ \n -> do OrchardWitness $
- return $ getHex $ walletOrchNoteWitness $ entityVal $ head notes
- OrchardTxSpend else Nothing
- (getBytes sk)
- (DecodedNote
- (fromIntegral $ walletOrchNoteValue $ entityVal n)
- (walletOrchNoteRecipient $ entityVal n)
- (E.encodeUtf8 $ walletOrchNoteMemo $ entityVal n)
- (getHex $ walletOrchNoteNullifier $ entityVal n)
- (walletOrchNoteRho $ entityVal n)
- (getRseed $ walletOrchNoteRseed $ entityVal n))
- (toBytes $ getHex $ walletOrchNoteWitness $ entityVal n)
- sapAnchor :: [Entity WalletSapNote] -> Maybe SaplingWitness
- sapAnchor notes =
- if not (null notes)
- then Just $
- SaplingWitness $
- getHex $ walletSapNoteWitness $ entityVal $ head notes
- else Nothing
- orchAnchor :: [Entity WalletOrchNote] -> Maybe OrchardWitness
- orchAnchor notes =
- if not (null notes)
- then Just $
- OrchardWitness $
- getHex $ walletOrchNoteWitness $ entityVal $ head notes
- else Nothing
-}
deshieldNotes :: deshieldNotes ::
ConnectionPool ConnectionPool
-> T.Text -> T.Text
@ -795,11 +752,11 @@ deshieldNotes ::
-> ZcashAccountId -> ZcashAccountId
-> Int -> Int
-> ProposedNote -> ProposedNote
-> LoggingT IO (Either TxError HexString) -> NoLoggingT 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 = pn_amt pnote * scientific 1 8 let zats = ceilingFloatInteger $ pn_amt pnote * (10 ^ 8)
if fromInteger bal > (scientific 2 4 + zats) if bal > (20000 + 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
@ -814,11 +771,9 @@ 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
-trees <- liftIO $ getCommitmentTrees zebraHost zebraPort bh let sT = SaplingCommitmentTree $ ztiSapling trees
-let sT = SaplingCommitmentTree $ ztiSapling trees let oT = OrchardCommitmentTree $ ztiOrchard 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"
@ -833,6 +788,7 @@ shieldTransparentNotes pool zebraHost zebraPort znet za bh = do
dRecvs dRecvs
forM fNotes $ \trNotes -> do forM fNotes $ \trNotes -> do
let noteTotal = getTotalAmount (trNotes, [], []) let noteTotal = getTotalAmount (trNotes, [], [])
let fee = calculateTxFee (trNotes, [], []) 4
tSpends <- tSpends <-
liftIO $ liftIO $
prepTSpends prepTSpends
@ -844,28 +800,18 @@ shieldTransparentNotes pool zebraHost zebraPort znet za bh = do
let oRcvr = let oRcvr =
fromJust $ fromJust $
o_rec =<< isValidUnifiedAddress (E.encodeUtf8 internalUA) o_rec =<< isValidUnifiedAddress (E.encodeUtf8 internalUA)
let dummy =
OutgoingNote
4
(getBytes $ getOrchSK $ zcashAccountOrchSpendKey $ entityVal acc)
(getBytes oRcvr)
(fromIntegral $ noteTotal - 500)
""
True
let feeAmt = calculateTxFee (trNotes, [], []) [dummy]
let snote = let snote =
OutgoingNote OutgoingNote
4 4
(getBytes $ getOrchSK $ zcashAccountOrchSpendKey $ entityVal acc) (getBytes $ getOrchSK $ zcashAccountOrchSpendKey $ entityVal acc)
(getBytes oRcvr) (getBytes oRcvr)
(fromIntegral $ noteTotal - fromIntegral feeAmt) (fromIntegral $ noteTotal - fee)
"" ""
True True
tx <- let tx =
liftIO $
createTransaction createTransaction
Nothing (Just sT)
Nothing (Just oT)
tSpends tSpends
[] []
[] []
@ -925,14 +871,13 @@ prepareTxV2 ::
-> Int -> Int
-> [ProposedNote] -> [ProposedNote]
-> PrivacyPolicy -> PrivacyPolicy
-> LoggingT IO (Either TxError HexString) -> NoLoggingT 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 <- trees <- liftIO $ getCommitmentTrees zebraHost zebraPort bh
liftIO $ getCommitmentTrees pool zebraHost zebraPort (ZcashNetDB zn) bh
let sT = SaplingCommitmentTree $ ztiSapling trees let sT = SaplingCommitmentTree $ ztiSapling trees
let oT = OrchardCommitmentTree $ ztiOrchard trees let oT = OrchardCommitmentTree $ ztiOrchard trees
case accRead of case accRead of
@ -942,12 +887,7 @@ 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' = toBoundedInteger $ amt * scientific 1 8 let zats = ceilingFloatInteger $ amt * (10 ^ 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-}
@ -958,7 +898,7 @@ prepareTxV2 pool zebraHost zebraPort zn za bh pnotes policy = do
selectUnspentNotesV2 selectUnspentNotesV2
pool pool
za za
(zats + 20000) (zats + 10000)
(map (\(x, _, _, _) -> x) recipients) (map (\(x, _, _, _) -> x) recipients)
policy policy
case notePlan of case notePlan of
@ -987,29 +927,42 @@ prepareTxV2 pool zebraHost zebraPort zn za bh pnotes policy = do
(getOrchSK $ zcashAccountOrchSpendKey $ entityVal acc) (getOrchSK $ zcashAccountOrchSpendKey $ entityVal acc)
oList oList
--print oSpends --print oSpends
draft <- dummy' <-
liftIO $ liftIO $
makeOutgoing makeOutgoing acc recipients (noteTotal - 5000 - zats) policy
acc case dummy' of
recipients
(noteTotal - 5000 - fromIntegral zats)
policy
case draft of
Left e -> return $ Left e Left e -> return $ Left e
Right draftOut -> do Right dummy -> do
let fee = calculateTxFee (tList, sList, oList) draftOut logDebugN "Calculating fee"
logDebugN $ T.pack $ "calculated fee " ++ show 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 <- finalNotePlan <-
liftIO $ liftIO $
selectUnspentNotesV2 selectUnspentNotesV2
pool pool
za za
(zats + fee) (zats + feeAmt)
(map (\(x, _, _, _) -> x) recipients) (map (\(x, _, _, _) -> x) recipients)
policy policy
case finalNotePlan of case finalNotePlan of
Right (tList1, sList1, oList1) -> do Right (tList1, sList1, oList1) -> do
logDebugN $ T.pack $ "selected notes with fee" ++ show fee logDebugN $
T.pack $ "selected notes with fee" ++ show feeAmt
logDebugN $ T.pack $ show tList1 logDebugN $ T.pack $ show tList1
logDebugN $ T.pack $ show sList1 logDebugN $ T.pack $ show sList1
logDebugN $ T.pack $ show oList1 logDebugN $ T.pack $ show oList1
@ -1034,14 +987,13 @@ prepareTxV2 pool zebraHost zebraPort zn za bh pnotes policy = do
makeOutgoing makeOutgoing
acc acc
recipients recipients
(noteTotal1 - fee - fromIntegral zats) (noteTotal1 - feeAmt - zats)
policy policy
logDebugN $ T.pack $ show outgoing' logDebugN $ T.pack $ show outgoing'
case outgoing' of case outgoing' of
Left e -> return $ Left e Left e -> return $ Left e
Right outgoing -> do Right outgoing -> do
tx <- let tx =
liftIO $
createTransaction createTransaction
(Just sT) (Just sT)
(Just oT) (Just oT)
@ -1059,13 +1011,10 @@ 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, Int64, T.Text) extractReceiver :: ProposedNote -> (Int, BS.ByteString, Int, T.Text)
extractReceiver (ProposedNote (ValidAddressAPI va) amt m) = extractReceiver (ProposedNote (ValidAddressAPI va) amt m) =
let zats' = toBoundedInteger $ amt * scientific 1 8 let zats = fromIntegral $ floorFloatInteger $ amt * (10 ^ 8)
in case zats' of in case va 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 ->
@ -1076,45 +1025,26 @@ 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 (1, toBytes $ tr_bytes r3, zats, fromMaybe "" m)
, toBytes $ tr_bytes r3
, zats
, fromMaybe "" m)
P2SH -> P2SH ->
( 2 (2, toBytes $ tr_bytes r3, zats, fromMaybe "" m)
, 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 -> Sapling sa -> (3, getBytes $ sa_receiver sa, zats, fromMaybe "" m)
(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 (1, toBytes $ tr_bytes (ta_receiver ta), zats, fromMaybe "" m)
, toBytes $ tr_bytes (ta_receiver ta)
, zats
, fromMaybe "" m)
P2SH -> P2SH ->
( 2 (2, toBytes $ tr_bytes (ta_receiver ta), zats, fromMaybe "" m)
, 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 (5, toBytes $ tr_bytes (ex_address ea), zats, fromMaybe "" m)
, toBytes $ tr_bytes (ex_address ea)
, zats
, fromMaybe "" m)
P2SH -> P2SH ->
( 6 (6, toBytes $ tr_bytes (ex_address ea), zats, fromMaybe "" m)
, toBytes $ tr_bytes (ex_address ea)
, zats
, fromMaybe "" m)
prepareOutgoingNote :: prepareOutgoingNote ::
ZcashAccount -> (Int, BS.ByteString, Int64, T.Text) -> OutgoingNote ZcashAccount -> (Int, BS.ByteString, Int, T.Text) -> OutgoingNote
prepareOutgoingNote zac (k, r, a, m) = prepareOutgoingNote zac (k, r, a, m) =
OutgoingNote OutgoingNote
(if k == 5 (if k == 5
@ -1132,8 +1062,8 @@ prepareTxV2 pool zebraHost zebraPort zn za bh pnotes policy = do
False False
makeOutgoing :: makeOutgoing ::
Entity ZcashAccount Entity ZcashAccount
-> [(Int, BS.ByteString, Int64, T.Text)] -> [(Int, BS.ByteString, Int, T.Text)]
-> Int64 -> Integer
-> PrivacyPolicy -> PrivacyPolicy
-> IO (Either TxError [OutgoingNote]) -> IO (Either TxError [OutgoingNote])
makeOutgoing acc recvs chg pol = do makeOutgoing acc recvs chg pol = do
@ -1265,7 +1195,7 @@ prepareTxV2 pool zebraHost zebraPort zn za bh pnotes policy = do
( [Entity WalletTrNote] ( [Entity WalletTrNote]
, [Entity WalletSapNote] , [Entity WalletSapNote]
, [Entity WalletOrchNote]) , [Entity WalletOrchNote])
-> Int64 -> Integer
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) +
@ -1370,15 +1300,13 @@ syncWallet config w = do
let startBlock = let startBlock =
if lastBlock > 0 if lastBlock > 0
then lastBlock then lastBlock
else 1 + zcashWalletBirthdayHeight (entityVal w) else zcashWalletBirthdayHeight $ entityVal w
logDebugN $ "start block: " <> T.pack (show startBlock) logDebugN $ "start block: " <> T.pack (show startBlock)
mapM_ (liftIO . findTransparentNotes pool startBlock znet) addrs mapM_ (liftIO . findTransparentNotes pool startBlock znet) addrs
mapM_ (liftIO . findTransparentNotes pool startBlock znet) intAddrs mapM_ (liftIO . findTransparentNotes pool startBlock znet) intAddrs
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

77
src/Zenith/DB.hs
View file

@ -698,42 +698,22 @@ saveAddress pool w =
runNoLoggingT $ runNoLoggingT $
PS.retryOnBusy $ flip PS.runSqlPool pool $ insertUniqueEntity w PS.retryOnBusy $ flip PS.runSqlPool pool $ insertUniqueEntity w
-- * Block
-- | Save a block to the database -- | Save a block to the database
saveBlock :: ConnectionPool -> ZcashBlock -> IO (Key ZcashBlock) saveBlock :: ConnectionPool -> ZcashBlock -> IO (Key ZcashBlock)
saveBlock pool b = saveBlock pool b =
runNoLoggingT $ PS.retryOnBusy $ flip PS.runSqlPool pool $ do insert b runNoLoggingT $ PS.retryOnBusy $ flip PS.runSqlPool pool $ do insert b
-- | Read a block by height -- | Read a block by height
getBlock :: getBlock :: ConnectionPool -> Int -> IO (Maybe (Entity ZcashBlock))
ConnectionPool -> Int -> ZcashNetDB -> IO (Maybe (Entity ZcashBlock)) getBlock pool b =
getBlock pool b znet =
runNoLoggingT $ runNoLoggingT $
PS.retryOnBusy $ PS.retryOnBusy $
flip PS.runSqlPool pool $ do flip PS.runSqlPool pool $ do
selectOne $ do selectOne $ do
bl <- from $ table @ZcashBlock bl <- from $ table @ZcashBlock
where_ $ where_ $ bl ^. ZcashBlockHeight ==. val b
bl ^. ZcashBlockHeight ==. val b &&. bl ^. ZcashBlockNetwork ==.
val znet
pure bl pure bl
getBlockHash :: ConnectionPool -> Int -> ZcashNetDB -> IO (Maybe HexString)
getBlockHash pool b znet = do
r <-
runNoLoggingT $
PS.retryOnBusy $
flip PS.runSqlPool pool $ do
selectOne $ do
bl <- from $ table @ZcashBlock
where_ $
bl ^. ZcashBlockHeight ==. val b &&. bl ^. ZcashBlockNetwork ==.
val znet
pure $ bl ^. ZcashBlockHash
case r of
Nothing -> return Nothing
Just (Value h) -> return $ Just $ getHex h
-- | Save a transaction to the data model -- | Save a transaction to the data model
saveTransaction :: saveTransaction ::
ConnectionPool -- ^ the database path ConnectionPool -- ^ the database path
@ -1796,16 +1776,12 @@ getUnspentSapNotes pool = do
where_ (n ^. WalletSapNoteSpent ==. val False) where_ (n ^. WalletSapNoteSpent ==. val False)
pure n pure n
getSaplingCmus :: getSaplingCmus :: Pool SqlBackend -> ShieldOutputId -> IO [Value HexStringDB]
ConnectionPool getSaplingCmus pool zt = do
-> 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 &&. n ^. ShieldOutputId <=. val m) where_ (n ^. ShieldOutputId >. val zt)
orderBy [asc $ n ^. ShieldOutputId] orderBy [asc $ n ^. ShieldOutputId]
pure $ n ^. ShieldOutputCmu) pure $ n ^. ShieldOutputCmu)
pool pool
@ -1864,13 +1840,12 @@ getUnspentOrchNotes pool = do
where_ (n ^. WalletOrchNoteSpent ==. val False) where_ (n ^. WalletOrchNoteSpent ==. val False)
pure n pure n
getOrchardCmxs :: getOrchardCmxs :: Pool SqlBackend -> OrchActionId -> IO [Value HexStringDB]
ConnectionPool -> OrchActionId -> OrchActionId -> IO [Value HexStringDB] getOrchardCmxs pool zt = do
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 &&. n ^. OrchActionId <=. val m) where_ (n ^. OrchActionId >. val zt)
orderBy [asc $ n ^. OrchActionId] orderBy [asc $ n ^. OrchActionId]
pure $ n ^. OrchActionCmx) pure $ n ^. OrchActionCmx)
pool pool
@ -2364,7 +2339,7 @@ selectUnspentNotes pool za amt = do
selectUnspentNotesV2 :: selectUnspentNotesV2 ::
ConnectionPool ConnectionPool
-> ZcashAccountId -> ZcashAccountId
-> Int64 -> Integer
-> [Int] -> [Int]
-> PrivacyPolicy -> PrivacyPolicy
-> IO -> IO
@ -2668,8 +2643,8 @@ completeSync pool st = do
return () return ()
-- | Rewind the data store to a given block height -- | Rewind the data store to a given block height
rewindWalletData :: ConnectionPool -> Int -> ZcashNetDB -> LoggingT IO () rewindWalletData :: ConnectionPool -> Int -> LoggingT IO ()
rewindWalletData pool b net = do rewindWalletData pool b = do
logDebugN "Starting transaction rewind" logDebugN "Starting transaction rewind"
liftIO $ clearWalletTransactions pool liftIO $ clearWalletTransactions pool
logDebugN "Completed transaction rewind" logDebugN "Completed transaction rewind"
@ -2681,9 +2656,7 @@ rewindWalletData pool b net = do
oldBlocks <- oldBlocks <-
select $ do select $ do
blk <- from $ table @ZcashBlock blk <- from $ table @ZcashBlock
where_ where_ $ blk ^. ZcashBlockHeight >. val b
(blk ^. ZcashBlockHeight >. val b &&. blk ^. ZcashBlockNetwork ==.
val net)
pure blk pure blk
let oldBlkKeys = map entityKey oldBlocks let oldBlkKeys = map entityKey oldBlocks
oldTxs <- oldTxs <-
@ -2703,9 +2676,7 @@ rewindWalletData pool b net = do
oldBlocks <- oldBlocks <-
select $ do select $ do
blk <- from $ table @ZcashBlock blk <- from $ table @ZcashBlock
where_ where_ $ blk ^. ZcashBlockHeight >. val b
(blk ^. ZcashBlockHeight >. val b &&. blk ^. ZcashBlockNetwork ==.
val net)
pure blk pure blk
let oldBlkKeys = map entityKey oldBlocks let oldBlkKeys = map entityKey oldBlocks
oldTxs <- oldTxs <-
@ -2725,9 +2696,7 @@ rewindWalletData pool b net = do
oldBlocks <- oldBlocks <-
select $ do select $ do
blk <- from $ table @ZcashBlock blk <- from $ table @ZcashBlock
where_ where_ $ blk ^. ZcashBlockHeight >. val b
(blk ^. ZcashBlockHeight >. val b &&. blk ^. ZcashBlockNetwork ==.
val net)
pure blk pure blk
let oldBlkKeys = map entityKey oldBlocks let oldBlkKeys = map entityKey oldBlocks
oldTxs <- oldTxs <-
@ -2747,9 +2716,7 @@ rewindWalletData pool b net = do
oldBlocks <- oldBlocks <-
select $ do select $ do
blk <- from $ table @ZcashBlock blk <- from $ table @ZcashBlock
where_ where_ $ blk ^. ZcashBlockHeight >. val b
(blk ^. ZcashBlockHeight >. val b &&. blk ^. ZcashBlockNetwork ==.
val net)
pure blk pure blk
let oldBlkKeys = map entityKey oldBlocks let oldBlkKeys = map entityKey oldBlocks
oldTxs <- oldTxs <-
@ -2769,9 +2736,7 @@ rewindWalletData pool b net = do
oldBlocks <- oldBlocks <-
select $ do select $ do
blk <- from $ table @ZcashBlock blk <- from $ table @ZcashBlock
where_ where_ $ blk ^. ZcashBlockHeight >. val b
(blk ^. ZcashBlockHeight >. val b &&. blk ^. ZcashBlockNetwork ==.
val net)
pure blk pure blk
let oldBlkKeys = map entityKey oldBlocks let oldBlkKeys = map entityKey oldBlocks
oldTxs <- oldTxs <-
@ -2791,9 +2756,7 @@ rewindWalletData pool b net = do
oldBlocks <- oldBlocks <-
select $ do select $ do
blk <- from $ table @ZcashBlock blk <- from $ table @ZcashBlock
where_ where_ $ blk ^. ZcashBlockHeight >. val b
(blk ^. ZcashBlockHeight >. val b &&. blk ^. ZcashBlockNetwork ==.
val net)
pure blk pure blk
let oldBlkKeys = map entityKey oldBlocks let oldBlkKeys = map entityKey oldBlocks
oldTxs <- oldTxs <-
@ -2812,7 +2775,5 @@ rewindWalletData pool b net = do
flip PS.runSqlPool pool $ do flip PS.runSqlPool pool $ do
delete $ do delete $ do
blk <- from $ table @ZcashBlock blk <- from $ table @ZcashBlock
where_ where_ $ blk ^. ZcashBlockHeight >. val b
(blk ^. ZcashBlockHeight >. val b &&. blk ^. ZcashBlockNetwork ==.
val net)
logDebugN "Completed data store rewind" logDebugN "Completed data store rewind"

13
src/Zenith/GUI.hs
View file

@ -17,7 +17,6 @@ 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)
@ -1245,7 +1244,7 @@ handleEvent wenv node model evt =
(model ^. network) (model ^. network)
(entityKey acc) (entityKey acc)
(zcashWalletLastSync $ entityVal wal) (zcashWalletLastSync $ entityVal wal)
(fromFloatDigits $ model ^. sendAmount) (model ^. sendAmount)
(model ^. sendRecipient) (model ^. sendRecipient)
(model ^. sendMemo) (model ^. sendMemo)
(model ^. privacyChoice) (model ^. privacyChoice)
@ -1627,17 +1626,17 @@ scanZebra dbPath zHost zPort net sendMsg = do
pool <- runNoLoggingT $ initPool dbPath pool <- runNoLoggingT $ initPool dbPath
b <- liftIO $ getMinBirthdayHeight pool b <- liftIO $ getMinBirthdayHeight pool
dbBlock <- getMaxBlock pool $ ZcashNetDB net dbBlock <- getMaxBlock pool $ ZcashNetDB net
chkBlock <- checkIntegrity dbPath zHost zPort net dbBlock 1 chkBlock <- checkIntegrity dbPath zHost zPort dbBlock 1
syncChk <- isSyncing pool syncChk <- isSyncing pool
if syncChk if syncChk
then sendMsg (ShowError "Sync already in progress") then sendMsg (ShowError "Sync already in progress")
else do else do
unless (chkBlock == dbBlock) $
runStderrLoggingT $ rewindWalletData pool chkBlock
let sb = let sb =
if chkBlock == dbBlock if chkBlock == dbBlock
then max dbBlock b then max dbBlock b
else max chkBlock b else max chkBlock b
unless (chkBlock == dbBlock || chkBlock == 1) $
runStderrLoggingT $ rewindWalletData pool sb $ ZcashNetDB net
if sb > zgb_blocks bStatus || sb < 1 if sb > zgb_blocks bStatus || sb < 1
then sendMsg (ShowError "Invalid starting block for scan") then sendMsg (ShowError "Invalid starting block for scan")
else do else do
@ -1702,7 +1701,7 @@ sendTransaction ::
-> ZcashNet -> ZcashNet
-> ZcashAccountId -> ZcashAccountId
-> Int -> Int
-> Scientific -> Float
-> T.Text -> T.Text
-> T.Text -> T.Text
-> PrivacyPolicy -> PrivacyPolicy
@ -1718,7 +1717,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 <-
runStderrLoggingT $ runNoLoggingT $
prepareTxV2 prepareTxV2
pool pool
zHost zHost

8
src/Zenith/RPC.hs
View file

@ -833,7 +833,7 @@ zenithServer state = getinfo :<|> handleRPC
forkIO $ do forkIO $ do
res <- res <-
liftIO $ liftIO $
runStderrLoggingT $ runNoLoggingT $
prepareTxV2 prepareTxV2
pool pool
zHost zHost
@ -889,15 +889,15 @@ scanZebra dbPath zHost zPort net = do
pool <- runNoLoggingT $ initPool dbPath pool <- runNoLoggingT $ initPool dbPath
b <- getMinBirthdayHeight pool b <- getMinBirthdayHeight pool
dbBlock <- getMaxBlock pool $ ZcashNetDB net dbBlock <- getMaxBlock pool $ ZcashNetDB net
chkBlock <- checkIntegrity dbPath zHost zPort net dbBlock 1 chkBlock <- checkIntegrity dbPath zHost zPort dbBlock 1
syncChk <- isSyncing pool syncChk <- isSyncing pool
unless syncChk $ do unless syncChk $ do
unless (chkBlock == dbBlock) $
runStderrLoggingT $ rewindWalletData pool chkBlock
let sb = let sb =
if chkBlock == dbBlock if chkBlock == dbBlock
then max dbBlock b then max dbBlock b
else max chkBlock b else max chkBlock b
unless (chkBlock == dbBlock || chkBlock == 1) $
runStderrLoggingT $ rewindWalletData pool sb $ ZcashNetDB net
unless (sb > zgb_blocks bStatus || sb < 1) $ do unless (sb > zgb_blocks bStatus || sb < 1) $ do
let bList = [(sb + 1) .. (zgb_blocks bStatus)] let bList = [(sb + 1) .. (zgb_blocks bStatus)]
unless (null bList) $ do unless (null bList) $ do

9
src/Zenith/Scanner.hs
View file

@ -246,11 +246,10 @@ checkIntegrity ::
T.Text -- ^ Database path T.Text -- ^ Database path
-> T.Text -- ^ Zebra host -> T.Text -- ^ Zebra host
-> Int -- ^ Zebra port -> Int -- ^ Zebra port
-> ZcashNet -- ^ the network to scan
-> Int -- ^ The block to start the check -> Int -- ^ The block to start the check
-> Int -- ^ depth -> Int -- ^ depth
-> IO Int -> IO Int
checkIntegrity dbP zHost zPort znet b d = checkIntegrity dbP zHost zPort b d =
if b < 1 if b < 1
then return 1 then return 1
else do else do
@ -264,10 +263,10 @@ checkIntegrity dbP zHost zPort znet b d =
Left e -> throwIO $ userError e Left e -> throwIO $ userError e
Right blk -> do Right blk -> do
pool <- runNoLoggingT $ initPool dbP pool <- runNoLoggingT $ initPool dbP
dbBlk <- getBlock pool b $ ZcashNetDB znet dbBlk <- getBlock pool b
case dbBlk of case dbBlk of
Nothing -> return 1 Nothing -> throwIO $ userError "Block mismatch, rescan needed"
Just dbBlk' -> Just dbBlk' ->
if bl_hash blk == getHex (zcashBlockHash $ entityVal dbBlk') if bl_hash blk == getHex (zcashBlockHash $ entityVal dbBlk')
then return b then return b
else checkIntegrity dbP zHost zPort znet (b - 5 * d) (d + 1) else checkIntegrity dbP zHost zPort (b - 5 * d) (d + 1)

3
src/Zenith/Types.hs
View file

@ -17,7 +17,6 @@ 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)
@ -242,7 +241,7 @@ instance ToJSON ValidAddressAPI where
data ProposedNote = ProposedNote data ProposedNote = ProposedNote
{ pn_addr :: !ValidAddressAPI { pn_addr :: !ValidAddressAPI
, pn_amt :: !Scientific , pn_amt :: !Float
, 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,31 +13,26 @@ 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 import ZcashHaskell.Orchard (encodeUnifiedAddress, isValidUnifiedAddress, parseAddress)
( 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
( ExchangeAddress(..) ( SaplingAddress(..)
, SaplingAddress(..)
, TransparentAddress(..) , TransparentAddress(..)
, UnifiedAddress(..) , UnifiedAddress(..)
, ValidAddress(..)
, ZcashNet(..) , ZcashNet(..)
, ValidAddress(..)
, ExchangeAddress(..)
) )
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
@ -155,24 +150,21 @@ 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 -> Full -> case adr of
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 -> Medium -> case adr of
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 -> Low -> case adr of
case adr of
Just a -> Just a ->
case a of case a of
Unified ua -> True Unified ua -> True
@ -180,8 +172,7 @@ isRecipientValidGUI p a = do
Transparent ta -> True Transparent ta -> True
_ -> False _ -> False
Nothing -> False Nothing -> False
None -> None -> case adr of
case adr of
Just a -> Just a ->
case a of case a of
Transparent ta -> True Transparent ta -> True
@ -241,10 +232,3 @@ 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

22
test/Spec.hs
View file

@ -2,7 +2,6 @@
import Control.Monad (when) import Control.Monad (when)
import Control.Monad.Logger (runFileLoggingT, runNoLoggingT) import Control.Monad.Logger (runFileLoggingT, runNoLoggingT)
import Data.Aeson
import Data.HexString import Data.HexString
import Data.Maybe (fromJust) import Data.Maybe (fromJust)
import qualified Data.Text.Encoding as E import qualified Data.Text.Encoding as E
@ -34,10 +33,8 @@ import ZcashHaskell.Types
, Scope(..) , Scope(..)
, ShieldedOutput(..) , ShieldedOutput(..)
, TxError(..) , TxError(..)
, ValidAddress(..)
, ZcashNet(..) , ZcashNet(..)
) )
import ZcashHaskell.Utils (f4Jumble, makeZebraCall, readZebraTransaction)
import Zenith.Core import Zenith.Core
import Zenith.DB import Zenith.DB
import Zenith.Types import Zenith.Types
@ -185,12 +182,6 @@ 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"
@ -231,7 +222,7 @@ main = do
Full Full
case tx of case tx of
Left e -> assertFailure $ show e Left e -> assertFailure $ show e
Right h -> h `shouldNotBe` hexString "deadbeef" Right h -> h `shouldBe` (hexString "deadbeef")
it "To Sapling" $ do it "To Sapling" $ do
let uaRead = let uaRead =
parseAddress parseAddress
@ -257,7 +248,7 @@ main = do
Full Full
case tx of case tx of
Left e -> assertFailure $ show e Left e -> assertFailure $ show e
Right h -> h `shouldNotBe` hexString "deadbeef" Right h -> h `shouldNotBe` (hexString "deadbeef")
it "To Transparent" $ do it "To Transparent" $ do
let uaRead = parseAddress "tmAmSa4AauSFuJieeanRBjkfnah45ysGtgZ" let uaRead = parseAddress "tmAmSa4AauSFuJieeanRBjkfnah45ysGtgZ"
case uaRead of case uaRead of
@ -280,7 +271,8 @@ main = do
] ]
Full Full
tx `shouldBe` tx `shouldBe`
Left (PrivacyPolicyError "Receiver not capable of Full privacy") Left
(PrivacyPolicyError "Receiver not capable of Full privacy")
it "To mixed shielded receivers" $ do it "To mixed shielded receivers" $ do
let uaRead = let uaRead =
parseAddress parseAddress
@ -341,7 +333,7 @@ main = do
Medium Medium
case tx of case tx of
Left e -> assertFailure $ show e Left e -> assertFailure $ show e
Right h -> h `shouldNotBe` hexString "deadbeef" Right h -> h `shouldNotBe` (hexString "deadbeef")
it "To Sapling" $ do it "To Sapling" $ do
let uaRead = let uaRead =
parseAddress parseAddress
@ -367,7 +359,7 @@ main = do
Medium Medium
case tx of case tx of
Left e -> assertFailure $ show e Left e -> assertFailure $ show e
Right h -> h `shouldNotBe` (hexString "00") Right h -> h `shouldNotBe` (hexString "deadbeef")
it "To Transparent" $ do it "To Transparent" $ do
let uaRead = parseAddress "tmAmSa4AauSFuJieeanRBjkfnah45ysGtgZ" let uaRead = parseAddress "tmAmSa4AauSFuJieeanRBjkfnah45ysGtgZ"
case uaRead of case uaRead of
@ -580,4 +572,4 @@ main = do
None None
case tx of case tx of
Left e -> assertFailure $ show e Left e -> assertFailure $ show e
Right h -> h `shouldNotBe` hexString "deadbeef" Right h -> h `shouldNotBe` (hexString "deadbeef")

2
zcash-haskell

@ -1 +1 @@
Subproject commit 6d4b6840d30fe1631902acd0388bef0040fee9e8 Subproject commit 662a0d1148d3f52e2683157a4c9280bb8e81b0cb

1
zenith.cabal
View file

@ -141,7 +141,6 @@ test-suite zenith-tests
build-depends: build-depends:
base >=4.12 && <5 base >=4.12 && <5
, bytestring , bytestring
, aeson
, configurator , configurator
, monad-logger , monad-logger
, data-default , data-default