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

858
src/Zenith/Core.hs
View file

File diff suppressed because it is too large Load diff

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)

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

764
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"
@ -204,380 +195,381 @@ main = do
pool <- runNoLoggingT $ initPool "/home/rav/Zenith/zenith.db" pool <- runNoLoggingT $ initPool "/home/rav/Zenith/zenith.db"
oNotes <- getWalletUnspentTrNotes pool (toSqlKey 1) oNotes <- getWalletUnspentTrNotes pool (toSqlKey 1)
oNotes `shouldBe` [] oNotes `shouldBe` []
describe "Creating Tx" $ do describe "Creating Tx" $ do
describe "Full" $ do describe "Full" $ do
it "To Orchard" $ do it "To Orchard" $ do
let uaRead = let uaRead =
parseAddress parseAddress
"utest1dl54utt6prjj5e0dnlknwumnxq9hycdjpkfr0sy6e6h522remqee8axe9zax0wsjrwpj76v555pdhvj9rnargpfyycs0vpkapq98xcdhem99gc4wchzn0ggepq3y6nz3a9sscwgqxgsh9vzhcad402y3x9szfregck5gslkya3c79d86xx0l33tpk8gnn7ew9vw37w43zh22u8dgdax" "utest1dl54utt6prjj5e0dnlknwumnxq9hycdjpkfr0sy6e6h522remqee8axe9zax0wsjrwpj76v555pdhvj9rnargpfyycs0vpkapq98xcdhem99gc4wchzn0ggepq3y6nz3a9sscwgqxgsh9vzhcad402y3x9szfregck5gslkya3c79d86xx0l33tpk8gnn7ew9vw37w43zh22u8dgdax"
case uaRead of case uaRead of
Nothing -> assertFailure "wrong address" Nothing -> assertFailure "wrong address"
Just ua -> do Just ua -> do
pool <- runNoLoggingT $ initPool "/home/rav/Zenith/zenith.db" pool <- runNoLoggingT $ initPool "/home/rav/Zenith/zenith.db"
tx <- tx <-
runFileLoggingT "zenith.log" $ runFileLoggingT "zenith.log" $
prepareTxV2 prepareTxV2
pool pool
"localhost" "localhost"
18232 18232
TestNet TestNet
(toSqlKey 3) (toSqlKey 3)
3026170 3026170
[ ProposedNote [ ProposedNote
(ValidAddressAPI $ fromJust uaRead) (ValidAddressAPI $ fromJust uaRead)
0.005 0.005
(Just "Sending memo to orchard") (Just "Sending memo to orchard")
] ]
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
"ztestsapling136jp8z89v2jh6kqd5rs4dtvlxym90m43svzdwzxaplyvc5ttzppytpvx80ncllcsqzpmukxjl3y" "ztestsapling136jp8z89v2jh6kqd5rs4dtvlxym90m43svzdwzxaplyvc5ttzppytpvx80ncllcsqzpmukxjl3y"
case uaRead of case uaRead of
Nothing -> assertFailure "wrong address" Nothing -> assertFailure "wrong address"
Just ua -> do Just ua -> do
pool <- runNoLoggingT $ initPool "/home/rav/Zenith/zenith.db" pool <- runNoLoggingT $ initPool "/home/rav/Zenith/zenith.db"
tx <- tx <-
runFileLoggingT "zenith.log" $ runFileLoggingT "zenith.log" $
prepareTxV2 prepareTxV2
pool pool
"localhost" "localhost"
18232 18232
TestNet TestNet
(toSqlKey 4) (toSqlKey 4)
3001331 3001331
[ ProposedNote [ ProposedNote
(ValidAddressAPI $ fromJust uaRead) (ValidAddressAPI $ fromJust uaRead)
0.005 0.005
(Just "Sending memo to sapling") (Just "Sending memo to sapling")
] ]
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
Nothing -> assertFailure "wrong address" Nothing -> assertFailure "wrong address"
Just ua -> do Just ua -> do
pool <- runNoLoggingT $ initPool "/home/rav/Zenith/zenith.db" pool <- runNoLoggingT $ initPool "/home/rav/Zenith/zenith.db"
tx <- tx <-
runFileLoggingT "zenith.log" $ runFileLoggingT "zenith.log" $
prepareTxV2 prepareTxV2
pool pool
"localhost" "localhost"
18232 18232
TestNet TestNet
(toSqlKey 4) (toSqlKey 4)
3001331 3001331
[ ProposedNote [ ProposedNote
(ValidAddressAPI $ fromJust uaRead) (ValidAddressAPI $ fromJust uaRead)
0.005 0.005
Nothing Nothing
] ]
Full Full
tx `shouldBe` tx `shouldBe`
Left (PrivacyPolicyError "Receiver not capable of Full privacy") Left
it "To mixed shielded receivers" $ do (PrivacyPolicyError "Receiver not capable of Full privacy")
let uaRead = it "To mixed shielded receivers" $ do
parseAddress let uaRead =
"utest1dl54utt6prjj5e0dnlknwumnxq9hycdjpkfr0sy6e6h522remqee8axe9zax0wsjrwpj76v555pdhvj9rnargpfyycs0vpkapq98xcdhem99gc4wchzn0ggepq3y6nz3a9sscwgqxgsh9vzhcad402y3x9szfregck5gslkya3c79d86xx0l33tpk8gnn7ew9vw37w43zh22u8dgdax" parseAddress
let uaRead2 = "utest1dl54utt6prjj5e0dnlknwumnxq9hycdjpkfr0sy6e6h522remqee8axe9zax0wsjrwpj76v555pdhvj9rnargpfyycs0vpkapq98xcdhem99gc4wchzn0ggepq3y6nz3a9sscwgqxgsh9vzhcad402y3x9szfregck5gslkya3c79d86xx0l33tpk8gnn7ew9vw37w43zh22u8dgdax"
parseAddress let uaRead2 =
"ztestsapling136jp8z89v2jh6kqd5rs4dtvlxym90m43svzdwzxaplyvc5ttzppytpvx80ncllcsqzpmukxjl3y" parseAddress
case uaRead of "ztestsapling136jp8z89v2jh6kqd5rs4dtvlxym90m43svzdwzxaplyvc5ttzppytpvx80ncllcsqzpmukxjl3y"
Nothing -> assertFailure "wrong address" case uaRead of
Just ua -> do Nothing -> assertFailure "wrong address"
pool <- runNoLoggingT $ initPool "/home/rav/Zenith/zenith.db" Just ua -> do
tx <- pool <- runNoLoggingT $ initPool "/home/rav/Zenith/zenith.db"
runFileLoggingT "zenith.log" $ tx <-
prepareTxV2 runFileLoggingT "zenith.log" $
pool prepareTxV2
"localhost" pool
18232 "localhost"
TestNet 18232
(toSqlKey 1) TestNet
3001331 (toSqlKey 1)
[ ProposedNote 3001331
(ValidAddressAPI $ fromJust uaRead) [ ProposedNote
0.005 (ValidAddressAPI $ fromJust uaRead)
(Just "Sending memo to orchard") 0.005
, ProposedNote (Just "Sending memo to orchard")
(ValidAddressAPI $ fromJust uaRead2) , ProposedNote
0.004 (ValidAddressAPI $ fromJust uaRead2)
Nothing 0.004
] Nothing
Full ]
tx `shouldBe` Full
Left tx `shouldBe`
(PrivacyPolicyError Left
"Combination of receivers not allowed for Full privacy") (PrivacyPolicyError
describe "Medium" $ do "Combination of receivers not allowed for Full privacy")
it "To Orchard" $ do describe "Medium" $ do
let uaRead = it "To Orchard" $ do
parseAddress let uaRead =
"utest1dl54utt6prjj5e0dnlknwumnxq9hycdjpkfr0sy6e6h522remqee8axe9zax0wsjrwpj76v555pdhvj9rnargpfyycs0vpkapq98xcdhem99gc4wchzn0ggepq3y6nz3a9sscwgqxgsh9vzhcad402y3x9szfregck5gslkya3c79d86xx0l33tpk8gnn7ew9vw37w43zh22u8dgdax" parseAddress
case uaRead of "utest1dl54utt6prjj5e0dnlknwumnxq9hycdjpkfr0sy6e6h522remqee8axe9zax0wsjrwpj76v555pdhvj9rnargpfyycs0vpkapq98xcdhem99gc4wchzn0ggepq3y6nz3a9sscwgqxgsh9vzhcad402y3x9szfregck5gslkya3c79d86xx0l33tpk8gnn7ew9vw37w43zh22u8dgdax"
Nothing -> assertFailure "wrong address" case uaRead of
Just ua -> do Nothing -> assertFailure "wrong address"
pool <- runNoLoggingT $ initPool "/home/rav/Zenith/zenith.db" Just ua -> do
tx <- pool <- runNoLoggingT $ initPool "/home/rav/Zenith/zenith.db"
runFileLoggingT "zenith.log" $ tx <-
prepareTxV2 runFileLoggingT "zenith.log" $
pool prepareTxV2
"localhost" pool
18232 "localhost"
TestNet 18232
(toSqlKey 1) TestNet
3001372 (toSqlKey 1)
[ ProposedNote 3001372
(ValidAddressAPI $ fromJust uaRead) [ ProposedNote
0.005 (ValidAddressAPI $ fromJust uaRead)
(Just "Sending memo to orchard") 0.005
] (Just "Sending memo to orchard")
Medium ]
case tx of Medium
Left e -> assertFailure $ show e case tx of
Right h -> h `shouldNotBe` hexString "deadbeef" Left e -> assertFailure $ show e
it "To Sapling" $ do Right h -> h `shouldNotBe` (hexString "deadbeef")
let uaRead = it "To Sapling" $ do
parseAddress let uaRead =
"ztestsapling136jp8z89v2jh6kqd5rs4dtvlxym90m43svzdwzxaplyvc5ttzppytpvx80ncllcsqzpmukxjl3y" parseAddress
case uaRead of "ztestsapling136jp8z89v2jh6kqd5rs4dtvlxym90m43svzdwzxaplyvc5ttzppytpvx80ncllcsqzpmukxjl3y"
Nothing -> assertFailure "wrong address" case uaRead of
Just ua -> do Nothing -> assertFailure "wrong address"
pool <- runNoLoggingT $ initPool "/home/rav/Zenith/zenith.db" Just ua -> do
tx <- pool <- runNoLoggingT $ initPool "/home/rav/Zenith/zenith.db"
runFileLoggingT "zenith.log" $ tx <-
prepareTxV2 runFileLoggingT "zenith.log" $
pool prepareTxV2
"localhost" pool
18232 "localhost"
TestNet 18232
(toSqlKey 1) TestNet
3001372 (toSqlKey 1)
[ ProposedNote 3001372
(ValidAddressAPI $ fromJust uaRead) [ ProposedNote
0.005 (ValidAddressAPI $ fromJust uaRead)
(Just "Sending memo to sapling") 0.005
] (Just "Sending memo to sapling")
Medium ]
case tx of Medium
Left e -> assertFailure $ show e case tx of
Right h -> h `shouldNotBe` (hexString "00") Left e -> assertFailure $ show e
it "To Transparent" $ do Right h -> h `shouldNotBe` (hexString "deadbeef")
let uaRead = parseAddress "tmAmSa4AauSFuJieeanRBjkfnah45ysGtgZ" it "To Transparent" $ do
case uaRead of let uaRead = parseAddress "tmAmSa4AauSFuJieeanRBjkfnah45ysGtgZ"
Nothing -> assertFailure "wrong address" case uaRead of
Just ua -> do Nothing -> assertFailure "wrong address"
pool <- runNoLoggingT $ initPool "/home/rav/Zenith/zenith.db" Just ua -> do
tx <- pool <- runNoLoggingT $ initPool "/home/rav/Zenith/zenith.db"
runFileLoggingT "zenith.log" $ tx <-
prepareTxV2 runFileLoggingT "zenith.log" $
pool prepareTxV2
"localhost" pool
18232 "localhost"
TestNet 18232
(toSqlKey 4) TestNet
3001331 (toSqlKey 4)
[ ProposedNote 3001331
(ValidAddressAPI $ fromJust uaRead) [ ProposedNote
0.005 (ValidAddressAPI $ fromJust uaRead)
Nothing 0.005
] Nothing
Medium ]
tx `shouldBe` Medium
Left tx `shouldBe`
(PrivacyPolicyError "Receiver not capable of Medium privacy") Left
it "To mixed shielded receivers" $ do (PrivacyPolicyError "Receiver not capable of Medium privacy")
let uaRead = it "To mixed shielded receivers" $ do
parseAddress let uaRead =
"utest1dl54utt6prjj5e0dnlknwumnxq9hycdjpkfr0sy6e6h522remqee8axe9zax0wsjrwpj76v555pdhvj9rnargpfyycs0vpkapq98xcdhem99gc4wchzn0ggepq3y6nz3a9sscwgqxgsh9vzhcad402y3x9szfregck5gslkya3c79d86xx0l33tpk8gnn7ew9vw37w43zh22u8dgdax" parseAddress
let uaRead2 = "utest1dl54utt6prjj5e0dnlknwumnxq9hycdjpkfr0sy6e6h522remqee8axe9zax0wsjrwpj76v555pdhvj9rnargpfyycs0vpkapq98xcdhem99gc4wchzn0ggepq3y6nz3a9sscwgqxgsh9vzhcad402y3x9szfregck5gslkya3c79d86xx0l33tpk8gnn7ew9vw37w43zh22u8dgdax"
parseAddress let uaRead2 =
"ztestsapling136jp8z89v2jh6kqd5rs4dtvlxym90m43svzdwzxaplyvc5ttzppytpvx80ncllcsqzpmukxjl3y" parseAddress
case uaRead of "ztestsapling136jp8z89v2jh6kqd5rs4dtvlxym90m43svzdwzxaplyvc5ttzppytpvx80ncllcsqzpmukxjl3y"
Nothing -> assertFailure "wrong address" case uaRead of
Just ua -> do Nothing -> assertFailure "wrong address"
pool <- runNoLoggingT $ initPool "/home/rav/Zenith/zenith.db" Just ua -> do
tx <- pool <- runNoLoggingT $ initPool "/home/rav/Zenith/zenith.db"
runFileLoggingT "zenith.log" $ tx <-
prepareTxV2 runFileLoggingT "zenith.log" $
pool prepareTxV2
"localhost" pool
18232 "localhost"
TestNet 18232
(toSqlKey 1) TestNet
3001331 (toSqlKey 1)
[ ProposedNote 3001331
(ValidAddressAPI $ fromJust uaRead) [ ProposedNote
0.005 (ValidAddressAPI $ fromJust uaRead)
(Just "Sending memo to orchard") 0.005
, ProposedNote (Just "Sending memo to orchard")
(ValidAddressAPI $ fromJust uaRead2) , ProposedNote
0.004 (ValidAddressAPI $ fromJust uaRead2)
Nothing 0.004
] Nothing
Medium ]
case tx of Medium
Left e -> assertFailure $ show e case tx of
Right h -> h `shouldNotBe` (hexString "deadbeef") Left e -> assertFailure $ show e
describe "Low" $ do Right h -> h `shouldNotBe` (hexString "deadbeef")
it "To Orchard" $ do describe "Low" $ do
let uaRead = it "To Orchard" $ do
parseAddress let uaRead =
"utest1dl54utt6prjj5e0dnlknwumnxq9hycdjpkfr0sy6e6h522remqee8axe9zax0wsjrwpj76v555pdhvj9rnargpfyycs0vpkapq98xcdhem99gc4wchzn0ggepq3y6nz3a9sscwgqxgsh9vzhcad402y3x9szfregck5gslkya3c79d86xx0l33tpk8gnn7ew9vw37w43zh22u8dgdax" parseAddress
case uaRead of "utest1dl54utt6prjj5e0dnlknwumnxq9hycdjpkfr0sy6e6h522remqee8axe9zax0wsjrwpj76v555pdhvj9rnargpfyycs0vpkapq98xcdhem99gc4wchzn0ggepq3y6nz3a9sscwgqxgsh9vzhcad402y3x9szfregck5gslkya3c79d86xx0l33tpk8gnn7ew9vw37w43zh22u8dgdax"
Nothing -> assertFailure "wrong address" case uaRead of
Just ua -> do Nothing -> assertFailure "wrong address"
pool <- runNoLoggingT $ initPool "/home/rav/Zenith/zenith.db" Just ua -> do
tx <- pool <- runNoLoggingT $ initPool "/home/rav/Zenith/zenith.db"
runFileLoggingT "zenith.log" $ tx <-
prepareTxV2 runFileLoggingT "zenith.log" $
pool prepareTxV2
"localhost" pool
18232 "localhost"
TestNet 18232
(toSqlKey 1) TestNet
3001372 (toSqlKey 1)
[ ProposedNote 3001372
(ValidAddressAPI $ fromJust uaRead) [ ProposedNote
0.005 (ValidAddressAPI $ fromJust uaRead)
Nothing 0.005
] Nothing
Low ]
case tx of Low
Left e -> assertFailure $ show e case tx of
Right h -> h `shouldNotBe` (hexString "deadbeef") Left e -> assertFailure $ show e
it "To Sapling" $ do Right h -> h `shouldNotBe` (hexString "deadbeef")
let uaRead = it "To Sapling" $ do
parseAddress let uaRead =
"ztestsapling136jp8z89v2jh6kqd5rs4dtvlxym90m43svzdwzxaplyvc5ttzppytpvx80ncllcsqzpmukxjl3y" parseAddress
case uaRead of "ztestsapling136jp8z89v2jh6kqd5rs4dtvlxym90m43svzdwzxaplyvc5ttzppytpvx80ncllcsqzpmukxjl3y"
Nothing -> assertFailure "wrong address" case uaRead of
Just ua -> do Nothing -> assertFailure "wrong address"
pool <- runNoLoggingT $ initPool "/home/rav/Zenith/zenith.db" Just ua -> do
tx <- pool <- runNoLoggingT $ initPool "/home/rav/Zenith/zenith.db"
runFileLoggingT "zenith.log" $ tx <-
prepareTxV2 runFileLoggingT "zenith.log" $
pool prepareTxV2
"localhost" pool
18232 "localhost"
TestNet 18232
(toSqlKey 1) TestNet
3001372 (toSqlKey 1)
[ ProposedNote 3001372
(ValidAddressAPI $ fromJust uaRead) [ ProposedNote
0.005 (ValidAddressAPI $ fromJust uaRead)
Nothing 0.005
] Nothing
Low ]
case tx of Low
Left e -> assertFailure $ show e case tx of
Right h -> h `shouldNotBe` (hexString "deadbeef") Left e -> assertFailure $ show e
it "To Transparent" $ do Right h -> h `shouldNotBe` (hexString "deadbeef")
let uaRead = parseAddress "tmAmSa4AauSFuJieeanRBjkfnah45ysGtgZ" it "To Transparent" $ do
case uaRead of let uaRead = parseAddress "tmAmSa4AauSFuJieeanRBjkfnah45ysGtgZ"
Nothing -> assertFailure "wrong address" case uaRead of
Just ua -> do Nothing -> assertFailure "wrong address"
pool <- runNoLoggingT $ initPool "/home/rav/Zenith/zenith.db" Just ua -> do
tx <- pool <- runNoLoggingT $ initPool "/home/rav/Zenith/zenith.db"
runFileLoggingT "zenith.log" $ tx <-
prepareTxV2 runFileLoggingT "zenith.log" $
pool prepareTxV2
"localhost" pool
18232 "localhost"
TestNet 18232
(toSqlKey 1) TestNet
3001372 (toSqlKey 1)
[ ProposedNote 3001372
(ValidAddressAPI $ fromJust uaRead) [ ProposedNote
0.005 (ValidAddressAPI $ fromJust uaRead)
Nothing 0.005
] Nothing
Low ]
case tx of Low
Left e -> assertFailure $ show e case tx of
Right h -> h `shouldNotBe` (hexString "deadbeef") Left e -> assertFailure $ show e
describe "None" $ do Right h -> h `shouldNotBe` (hexString "deadbeef")
it "To Orchard" $ do describe "None" $ do
let uaRead = it "To Orchard" $ do
parseAddress let uaRead =
"utest1dl54utt6prjj5e0dnlknwumnxq9hycdjpkfr0sy6e6h522remqee8axe9zax0wsjrwpj76v555pdhvj9rnargpfyycs0vpkapq98xcdhem99gc4wchzn0ggepq3y6nz3a9sscwgqxgsh9vzhcad402y3x9szfregck5gslkya3c79d86xx0l33tpk8gnn7ew9vw37w43zh22u8dgdax" parseAddress
case uaRead of "utest1dl54utt6prjj5e0dnlknwumnxq9hycdjpkfr0sy6e6h522remqee8axe9zax0wsjrwpj76v555pdhvj9rnargpfyycs0vpkapq98xcdhem99gc4wchzn0ggepq3y6nz3a9sscwgqxgsh9vzhcad402y3x9szfregck5gslkya3c79d86xx0l33tpk8gnn7ew9vw37w43zh22u8dgdax"
Nothing -> assertFailure "wrong address" case uaRead of
Just ua -> do Nothing -> assertFailure "wrong address"
pool <- runNoLoggingT $ initPool "/home/rav/Zenith/zenith.db" Just ua -> do
tx <- pool <- runNoLoggingT $ initPool "/home/rav/Zenith/zenith.db"
runFileLoggingT "zenith.log" $ tx <-
prepareTxV2 runFileLoggingT "zenith.log" $
pool prepareTxV2
"localhost" pool
18232 "localhost"
TestNet 18232
(toSqlKey 1) TestNet
3001372 (toSqlKey 1)
[ ProposedNote 3001372
(ValidAddressAPI $ fromJust uaRead) [ ProposedNote
0.005 (ValidAddressAPI $ fromJust uaRead)
Nothing 0.005
] Nothing
None ]
tx `shouldBe` None
Left tx `shouldBe`
(PrivacyPolicyError Left
"Shielded recipients not compatible with privacy policy.") (PrivacyPolicyError
it "To Sapling" $ do "Shielded recipients not compatible with privacy policy.")
let uaRead = it "To Sapling" $ do
parseAddress let uaRead =
"ztestsapling136jp8z89v2jh6kqd5rs4dtvlxym90m43svzdwzxaplyvc5ttzppytpvx80ncllcsqzpmukxjl3y" parseAddress
case uaRead of "ztestsapling136jp8z89v2jh6kqd5rs4dtvlxym90m43svzdwzxaplyvc5ttzppytpvx80ncllcsqzpmukxjl3y"
Nothing -> assertFailure "wrong address" case uaRead of
Just ua -> do Nothing -> assertFailure "wrong address"
pool <- runNoLoggingT $ initPool "/home/rav/Zenith/zenith.db" Just ua -> do
tx <- pool <- runNoLoggingT $ initPool "/home/rav/Zenith/zenith.db"
runFileLoggingT "zenith.log" $ tx <-
prepareTxV2 runFileLoggingT "zenith.log" $
pool prepareTxV2
"localhost" pool
18232 "localhost"
TestNet 18232
(toSqlKey 1) TestNet
3001372 (toSqlKey 1)
[ ProposedNote 3001372
(ValidAddressAPI $ fromJust uaRead) [ ProposedNote
0.005 (ValidAddressAPI $ fromJust uaRead)
Nothing 0.005
] Nothing
None ]
tx `shouldBe` None
Left tx `shouldBe`
(PrivacyPolicyError Left
"Shielded recipients not compatible with privacy policy.") (PrivacyPolicyError
it "To Transparent" $ do "Shielded recipients not compatible with privacy policy.")
let uaRead = parseAddress "tmAmSa4AauSFuJieeanRBjkfnah45ysGtgZ" it "To Transparent" $ do
case uaRead of let uaRead = parseAddress "tmAmSa4AauSFuJieeanRBjkfnah45ysGtgZ"
Nothing -> assertFailure "wrong address" case uaRead of
Just ua -> do Nothing -> assertFailure "wrong address"
pool <- runNoLoggingT $ initPool "/home/rav/Zenith/zenith.db" Just ua -> do
tx <- pool <- runNoLoggingT $ initPool "/home/rav/Zenith/zenith.db"
runFileLoggingT "zenith.log" $ tx <-
prepareTxV2 runFileLoggingT "zenith.log" $
pool prepareTxV2
"localhost" pool
18232 "localhost"
TestNet 18232
(toSqlKey 1) TestNet
3001372 (toSqlKey 1)
[ ProposedNote 3001372
(ValidAddressAPI $ fromJust uaRead) [ ProposedNote
0.005 (ValidAddressAPI $ fromJust uaRead)
Nothing 0.005
] Nothing
None ]
case tx of None
Left e -> assertFailure $ show e case tx of
Right h -> h `shouldNotBe` hexString "deadbeef" Left e -> assertFailure $ show e
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