Compare commits
13 commits
8a54f8fda9
...
117a4fa2ea
Author | SHA1 | Date | |
---|---|---|---|
117a4fa2ea | |||
78437987bf | |||
0d03c3bffa | |||
723d1b4e1c | |||
0e5f476e28 | |||
9cee6e79cf | |||
28a75895f4 | |||
a9e7dad6af | |||
183b4adf91 | |||
d71d98a822 | |||
5f2859194b | |||
9d1416dd9d | |||
d72f355981 |
12 changed files with 1009 additions and 864 deletions
|
@ -22,6 +22,8 @@ and this project adheres to [Semantic Versioning](https://semver.org/spec/v2.0.0
|
|||
- `getoperationstatus` RPC method
|
||||
- `sendmany` RPC method
|
||||
- Function `prepareTxV2` implementing `PrivacyPolicy`
|
||||
- Functionality to shield transparent balance
|
||||
- Functionality to de-shield shielded notes
|
||||
|
||||
### Changed
|
||||
|
||||
|
|
|
@ -75,6 +75,7 @@ import Control.Monad.Logger
|
|||
import Data.Aeson
|
||||
import Data.HexString (HexString(..), toText)
|
||||
import Data.Maybe
|
||||
import Data.Scientific (Scientific, scientific)
|
||||
import qualified Data.Text as T
|
||||
import qualified Data.Text.Encoding as E
|
||||
import Data.Time.Clock.POSIX (posixSecondsToUTCTime)
|
||||
|
@ -119,10 +120,10 @@ import Zenith.Types
|
|||
import Zenith.Utils
|
||||
( displayTaz
|
||||
, displayZec
|
||||
, getChainTip
|
||||
, isRecipientValid
|
||||
, isRecipientValidGUI
|
||||
, jsonNumber
|
||||
, parseAddressUA
|
||||
, showAddress
|
||||
, validBarValue
|
||||
)
|
||||
|
@ -159,7 +160,7 @@ makeLenses ''DialogInput
|
|||
|
||||
data SendInput = SendInput
|
||||
{ _sendTo :: !T.Text
|
||||
, _sendAmt :: !Float
|
||||
, _sendAmt :: !Scientific
|
||||
, _sendMemo :: !T.Text
|
||||
, _policyField :: !PrivacyPolicy
|
||||
} deriving (Show)
|
||||
|
@ -174,7 +175,7 @@ data AdrBookEntry = AdrBookEntry
|
|||
makeLenses ''AdrBookEntry
|
||||
|
||||
newtype ShDshEntry = ShDshEntry
|
||||
{ _shAmt :: Float
|
||||
{ _shAmt :: Scientific
|
||||
} deriving (Show)
|
||||
|
||||
makeLenses ''ShDshEntry
|
||||
|
@ -701,8 +702,8 @@ mkSendForm bal =
|
|||
, label "Memo: " @@= editTextField sendMemo MemoField (Just 1)
|
||||
]
|
||||
where
|
||||
isAmountValid :: Integer -> Float -> Bool
|
||||
isAmountValid b i = (fromIntegral b / 100000000.0) >= i
|
||||
isAmountValid :: Integer -> Scientific -> Bool
|
||||
isAmountValid b i = fromIntegral b >= (i * scientific 1 8)
|
||||
label s w =
|
||||
padBottom (Pad 1) $ vLimit 1 (hLimit 15 $ str s <+> fill ' ') <+> w
|
||||
|
||||
|
@ -713,8 +714,8 @@ mkDeshieldForm tbal =
|
|||
editShowableFieldWithValidate shAmt AmtField (isAmountValid tbal)
|
||||
]
|
||||
where
|
||||
isAmountValid :: Integer -> Float -> Bool
|
||||
isAmountValid b i = (fromIntegral b / 100000000.0) >= i
|
||||
isAmountValid :: Integer -> Scientific -> Bool
|
||||
isAmountValid b i = fromIntegral b >= (i * scientific 1 8)
|
||||
label s w =
|
||||
padBottom (Pad 1) $ vLimit 1 (hLimit 15 $ str s <+> fill ' ') <+> w
|
||||
|
||||
|
@ -831,7 +832,7 @@ scanZebra dbP zHost zPort b eChan znet = do
|
|||
bStatus <- liftIO $ checkBlockChain zHost zPort
|
||||
pool <- liftIO $ runNoLoggingT $ initPool dbP
|
||||
dbBlock <- liftIO $ getMaxBlock pool $ ZcashNetDB znet
|
||||
chkBlock <- liftIO $ checkIntegrity dbP zHost zPort dbBlock 1
|
||||
chkBlock <- liftIO $ checkIntegrity dbP zHost zPort znet dbBlock 1
|
||||
syncChk <- liftIO $ isSyncing pool
|
||||
if syncChk
|
||||
then liftIO $ BC.writeBChan eChan $ TickMsg "Sync alread in progress"
|
||||
|
@ -839,11 +840,12 @@ scanZebra dbP zHost zPort b eChan znet = do
|
|||
logDebugN $
|
||||
"dbBlock: " <>
|
||||
T.pack (show dbBlock) <> " chkBlock: " <> T.pack (show chkBlock)
|
||||
when (chkBlock /= dbBlock) $ rewindWalletData pool chkBlock
|
||||
let sb =
|
||||
if chkBlock == dbBlock
|
||||
then max dbBlock b
|
||||
else max chkBlock b
|
||||
when (chkBlock /= dbBlock && chkBlock /= 1) $
|
||||
rewindWalletData pool sb $ ZcashNetDB znet
|
||||
if sb > zgb_blocks bStatus || sb < 1
|
||||
then do
|
||||
liftIO $
|
||||
|
@ -1201,7 +1203,8 @@ appEvent (BT.VtyEvent e) = do
|
|||
Just (_k, w) -> return w
|
||||
fs1 <- BT.zoom txForm $ BT.gets formState
|
||||
bl <-
|
||||
liftIO $ getLastSyncBlock pool $ entityKey selWal
|
||||
liftIO $
|
||||
getChainTip (s ^. zebraHost) (s ^. zebraPort)
|
||||
_ <-
|
||||
liftIO $
|
||||
forkIO $
|
||||
|
@ -1212,7 +1215,7 @@ appEvent (BT.VtyEvent e) = do
|
|||
(s ^. zebraPort)
|
||||
(s ^. network)
|
||||
(entityKey selAcc)
|
||||
bl
|
||||
(bl + 5)
|
||||
(fs1 ^. sendAmt)
|
||||
(fs1 ^. sendTo)
|
||||
(fs1 ^. sendMemo)
|
||||
|
@ -1292,7 +1295,8 @@ appEvent (BT.VtyEvent e) = do
|
|||
getUA . walletAddressUAddress)
|
||||
(entityVal selAddr)))
|
||||
bl <-
|
||||
liftIO $ getLastSyncBlock pool $ entityKey selWal
|
||||
liftIO $
|
||||
getChainTip (s ^. zebraHost) (s ^. zebraPort)
|
||||
case tAddrMaybe of
|
||||
Nothing -> do
|
||||
BT.modify $
|
||||
|
@ -1994,7 +1998,7 @@ sendTransaction ::
|
|||
-> ZcashNet
|
||||
-> ZcashAccountId
|
||||
-> Int
|
||||
-> Float
|
||||
-> Scientific
|
||||
-> T.Text
|
||||
-> T.Text
|
||||
-> PrivacyPolicy
|
||||
|
@ -2005,7 +2009,7 @@ sendTransaction pool chan zHost zPort znet accId bl amt ua memo policy = do
|
|||
Nothing -> BC.writeBChan chan $ TickMsg "Incorrect address"
|
||||
Just outUA -> do
|
||||
res <-
|
||||
runNoLoggingT $
|
||||
runStderrLoggingT $
|
||||
prepareTxV2
|
||||
pool
|
||||
zHost
|
||||
|
@ -2021,10 +2025,10 @@ sendTransaction pool chan zHost zPort znet accId bl amt ua memo policy = do
|
|||
else Just memo)
|
||||
]
|
||||
policy
|
||||
BC.writeBChan chan $ TickMsg "Transaction ready, sending to Zebra..."
|
||||
case res of
|
||||
Left e -> BC.writeBChan chan $ TickMsg $ show e
|
||||
Right rawTx -> do
|
||||
BC.writeBChan chan $ TickMsg "Transaction ready, sending to Zebra..."
|
||||
resp <-
|
||||
makeZebraCall
|
||||
zHost
|
||||
|
@ -2073,7 +2077,7 @@ deshieldTransaction ::
|
|||
-> IO ()
|
||||
deshieldTransaction pool chan zHost zPort znet accId bl pnote = do
|
||||
BC.writeBChan chan $ TickMsg "Deshielding funds..."
|
||||
res <- runNoLoggingT $ deshieldNotes pool zHost zPort znet accId bl pnote
|
||||
res <- runStderrLoggingT $ deshieldNotes pool zHost zPort znet accId bl pnote
|
||||
case res of
|
||||
Left e -> BC.writeBChan chan $ TickMsg $ show e
|
||||
Right rawTx -> do
|
||||
|
|
File diff suppressed because it is too large
Load diff
|
@ -698,22 +698,42 @@ saveAddress pool w =
|
|||
runNoLoggingT $
|
||||
PS.retryOnBusy $ flip PS.runSqlPool pool $ insertUniqueEntity w
|
||||
|
||||
-- * Block
|
||||
-- | Save a block to the database
|
||||
saveBlock :: ConnectionPool -> ZcashBlock -> IO (Key ZcashBlock)
|
||||
saveBlock pool b =
|
||||
runNoLoggingT $ PS.retryOnBusy $ flip PS.runSqlPool pool $ do insert b
|
||||
|
||||
-- | Read a block by height
|
||||
getBlock :: ConnectionPool -> Int -> IO (Maybe (Entity ZcashBlock))
|
||||
getBlock pool b =
|
||||
getBlock ::
|
||||
ConnectionPool -> Int -> ZcashNetDB -> IO (Maybe (Entity ZcashBlock))
|
||||
getBlock pool b znet =
|
||||
runNoLoggingT $
|
||||
PS.retryOnBusy $
|
||||
flip PS.runSqlPool pool $ do
|
||||
selectOne $ do
|
||||
bl <- from $ table @ZcashBlock
|
||||
where_ $ bl ^. ZcashBlockHeight ==. val b
|
||||
where_ $
|
||||
bl ^. ZcashBlockHeight ==. val b &&. bl ^. ZcashBlockNetwork ==.
|
||||
val znet
|
||||
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
|
||||
saveTransaction ::
|
||||
ConnectionPool -- ^ the database path
|
||||
|
@ -1776,12 +1796,16 @@ getUnspentSapNotes pool = do
|
|||
where_ (n ^. WalletSapNoteSpent ==. val False)
|
||||
pure n
|
||||
|
||||
getSaplingCmus :: Pool SqlBackend -> ShieldOutputId -> IO [Value HexStringDB]
|
||||
getSaplingCmus pool zt = do
|
||||
getSaplingCmus ::
|
||||
ConnectionPool
|
||||
-> ShieldOutputId
|
||||
-> ShieldOutputId
|
||||
-> IO [Value HexStringDB]
|
||||
getSaplingCmus pool zt m = do
|
||||
PS.runSqlPool
|
||||
(select $ do
|
||||
n <- from $ table @ShieldOutput
|
||||
where_ (n ^. ShieldOutputId >. val zt)
|
||||
where_ (n ^. ShieldOutputId >. val zt &&. n ^. ShieldOutputId <=. val m)
|
||||
orderBy [asc $ n ^. ShieldOutputId]
|
||||
pure $ n ^. ShieldOutputCmu)
|
||||
pool
|
||||
|
@ -1840,12 +1864,13 @@ getUnspentOrchNotes pool = do
|
|||
where_ (n ^. WalletOrchNoteSpent ==. val False)
|
||||
pure n
|
||||
|
||||
getOrchardCmxs :: Pool SqlBackend -> OrchActionId -> IO [Value HexStringDB]
|
||||
getOrchardCmxs pool zt = do
|
||||
getOrchardCmxs ::
|
||||
ConnectionPool -> OrchActionId -> OrchActionId -> IO [Value HexStringDB]
|
||||
getOrchardCmxs pool zt m = do
|
||||
PS.runSqlPool
|
||||
(select $ do
|
||||
n <- from $ table @OrchAction
|
||||
where_ (n ^. OrchActionId >. val zt)
|
||||
where_ (n ^. OrchActionId >. val zt &&. n ^. OrchActionId <=. val m)
|
||||
orderBy [asc $ n ^. OrchActionId]
|
||||
pure $ n ^. OrchActionCmx)
|
||||
pool
|
||||
|
@ -2339,7 +2364,7 @@ selectUnspentNotes pool za amt = do
|
|||
selectUnspentNotesV2 ::
|
||||
ConnectionPool
|
||||
-> ZcashAccountId
|
||||
-> Integer
|
||||
-> Int64
|
||||
-> [Int]
|
||||
-> PrivacyPolicy
|
||||
-> IO
|
||||
|
@ -2643,8 +2668,8 @@ completeSync pool st = do
|
|||
return ()
|
||||
|
||||
-- | Rewind the data store to a given block height
|
||||
rewindWalletData :: ConnectionPool -> Int -> LoggingT IO ()
|
||||
rewindWalletData pool b = do
|
||||
rewindWalletData :: ConnectionPool -> Int -> ZcashNetDB -> LoggingT IO ()
|
||||
rewindWalletData pool b net = do
|
||||
logDebugN "Starting transaction rewind"
|
||||
liftIO $ clearWalletTransactions pool
|
||||
logDebugN "Completed transaction rewind"
|
||||
|
@ -2656,7 +2681,9 @@ rewindWalletData pool b = do
|
|||
oldBlocks <-
|
||||
select $ do
|
||||
blk <- from $ table @ZcashBlock
|
||||
where_ $ blk ^. ZcashBlockHeight >. val b
|
||||
where_
|
||||
(blk ^. ZcashBlockHeight >. val b &&. blk ^. ZcashBlockNetwork ==.
|
||||
val net)
|
||||
pure blk
|
||||
let oldBlkKeys = map entityKey oldBlocks
|
||||
oldTxs <-
|
||||
|
@ -2676,7 +2703,9 @@ rewindWalletData pool b = do
|
|||
oldBlocks <-
|
||||
select $ do
|
||||
blk <- from $ table @ZcashBlock
|
||||
where_ $ blk ^. ZcashBlockHeight >. val b
|
||||
where_
|
||||
(blk ^. ZcashBlockHeight >. val b &&. blk ^. ZcashBlockNetwork ==.
|
||||
val net)
|
||||
pure blk
|
||||
let oldBlkKeys = map entityKey oldBlocks
|
||||
oldTxs <-
|
||||
|
@ -2696,7 +2725,9 @@ rewindWalletData pool b = do
|
|||
oldBlocks <-
|
||||
select $ do
|
||||
blk <- from $ table @ZcashBlock
|
||||
where_ $ blk ^. ZcashBlockHeight >. val b
|
||||
where_
|
||||
(blk ^. ZcashBlockHeight >. val b &&. blk ^. ZcashBlockNetwork ==.
|
||||
val net)
|
||||
pure blk
|
||||
let oldBlkKeys = map entityKey oldBlocks
|
||||
oldTxs <-
|
||||
|
@ -2716,7 +2747,9 @@ rewindWalletData pool b = do
|
|||
oldBlocks <-
|
||||
select $ do
|
||||
blk <- from $ table @ZcashBlock
|
||||
where_ $ blk ^. ZcashBlockHeight >. val b
|
||||
where_
|
||||
(blk ^. ZcashBlockHeight >. val b &&. blk ^. ZcashBlockNetwork ==.
|
||||
val net)
|
||||
pure blk
|
||||
let oldBlkKeys = map entityKey oldBlocks
|
||||
oldTxs <-
|
||||
|
@ -2736,7 +2769,9 @@ rewindWalletData pool b = do
|
|||
oldBlocks <-
|
||||
select $ do
|
||||
blk <- from $ table @ZcashBlock
|
||||
where_ $ blk ^. ZcashBlockHeight >. val b
|
||||
where_
|
||||
(blk ^. ZcashBlockHeight >. val b &&. blk ^. ZcashBlockNetwork ==.
|
||||
val net)
|
||||
pure blk
|
||||
let oldBlkKeys = map entityKey oldBlocks
|
||||
oldTxs <-
|
||||
|
@ -2756,7 +2791,9 @@ rewindWalletData pool b = do
|
|||
oldBlocks <-
|
||||
select $ do
|
||||
blk <- from $ table @ZcashBlock
|
||||
where_ $ blk ^. ZcashBlockHeight >. val b
|
||||
where_
|
||||
(blk ^. ZcashBlockHeight >. val b &&. blk ^. ZcashBlockNetwork ==.
|
||||
val net)
|
||||
pure blk
|
||||
let oldBlkKeys = map entityKey oldBlocks
|
||||
oldTxs <-
|
||||
|
@ -2775,5 +2812,7 @@ rewindWalletData pool b = do
|
|||
flip PS.runSqlPool pool $ do
|
||||
delete $ do
|
||||
blk <- from $ table @ZcashBlock
|
||||
where_ $ blk ^. ZcashBlockHeight >. val b
|
||||
where_
|
||||
(blk ^. ZcashBlockHeight >. val b &&. blk ^. ZcashBlockNetwork ==.
|
||||
val net)
|
||||
logDebugN "Completed data store rewind"
|
||||
|
|
|
@ -17,6 +17,7 @@ import Data.Aeson
|
|||
import qualified Data.ByteString as BS
|
||||
import Data.HexString (toText)
|
||||
import Data.Maybe (fromMaybe, isJust, isNothing)
|
||||
import Data.Scientific (Scientific, fromFloatDigits)
|
||||
import qualified Data.Text as T
|
||||
import qualified Data.Text.Encoding as E
|
||||
import Data.Time.Clock.POSIX (posixSecondsToUTCTime)
|
||||
|
@ -1244,7 +1245,7 @@ handleEvent wenv node model evt =
|
|||
(model ^. network)
|
||||
(entityKey acc)
|
||||
(zcashWalletLastSync $ entityVal wal)
|
||||
(model ^. sendAmount)
|
||||
(fromFloatDigits $ model ^. sendAmount)
|
||||
(model ^. sendRecipient)
|
||||
(model ^. sendMemo)
|
||||
(model ^. privacyChoice)
|
||||
|
@ -1626,17 +1627,17 @@ scanZebra dbPath zHost zPort net sendMsg = do
|
|||
pool <- runNoLoggingT $ initPool dbPath
|
||||
b <- liftIO $ getMinBirthdayHeight pool
|
||||
dbBlock <- getMaxBlock pool $ ZcashNetDB net
|
||||
chkBlock <- checkIntegrity dbPath zHost zPort dbBlock 1
|
||||
chkBlock <- checkIntegrity dbPath zHost zPort net dbBlock 1
|
||||
syncChk <- isSyncing pool
|
||||
if syncChk
|
||||
then sendMsg (ShowError "Sync already in progress")
|
||||
else do
|
||||
unless (chkBlock == dbBlock) $
|
||||
runStderrLoggingT $ rewindWalletData pool chkBlock
|
||||
let sb =
|
||||
if chkBlock == dbBlock
|
||||
then max dbBlock b
|
||||
else max chkBlock b
|
||||
unless (chkBlock == dbBlock || chkBlock == 1) $
|
||||
runStderrLoggingT $ rewindWalletData pool sb $ ZcashNetDB net
|
||||
if sb > zgb_blocks bStatus || sb < 1
|
||||
then sendMsg (ShowError "Invalid starting block for scan")
|
||||
else do
|
||||
|
@ -1701,7 +1702,7 @@ sendTransaction ::
|
|||
-> ZcashNet
|
||||
-> ZcashAccountId
|
||||
-> Int
|
||||
-> Float
|
||||
-> Scientific
|
||||
-> T.Text
|
||||
-> T.Text
|
||||
-> PrivacyPolicy
|
||||
|
@ -1717,7 +1718,7 @@ sendTransaction config znet accId bl amt ua memo policy sendMsg = do
|
|||
let zPort = c_zebraPort config
|
||||
pool <- runNoLoggingT $ initPool dbPath
|
||||
res <-
|
||||
runNoLoggingT $
|
||||
runStderrLoggingT $
|
||||
prepareTxV2
|
||||
pool
|
||||
zHost
|
||||
|
|
|
@ -833,7 +833,7 @@ zenithServer state = getinfo :<|> handleRPC
|
|||
forkIO $ do
|
||||
res <-
|
||||
liftIO $
|
||||
runNoLoggingT $
|
||||
runStderrLoggingT $
|
||||
prepareTxV2
|
||||
pool
|
||||
zHost
|
||||
|
@ -889,15 +889,15 @@ scanZebra dbPath zHost zPort net = do
|
|||
pool <- runNoLoggingT $ initPool dbPath
|
||||
b <- getMinBirthdayHeight pool
|
||||
dbBlock <- getMaxBlock pool $ ZcashNetDB net
|
||||
chkBlock <- checkIntegrity dbPath zHost zPort dbBlock 1
|
||||
chkBlock <- checkIntegrity dbPath zHost zPort net dbBlock 1
|
||||
syncChk <- isSyncing pool
|
||||
unless syncChk $ do
|
||||
unless (chkBlock == dbBlock) $
|
||||
runStderrLoggingT $ rewindWalletData pool chkBlock
|
||||
let sb =
|
||||
if chkBlock == dbBlock
|
||||
then max dbBlock b
|
||||
else max chkBlock b
|
||||
unless (chkBlock == dbBlock || chkBlock == 1) $
|
||||
runStderrLoggingT $ rewindWalletData pool sb $ ZcashNetDB net
|
||||
unless (sb > zgb_blocks bStatus || sb < 1) $ do
|
||||
let bList = [(sb + 1) .. (zgb_blocks bStatus)]
|
||||
unless (null bList) $ do
|
||||
|
|
|
@ -246,10 +246,11 @@ checkIntegrity ::
|
|||
T.Text -- ^ Database path
|
||||
-> T.Text -- ^ Zebra host
|
||||
-> Int -- ^ Zebra port
|
||||
-> ZcashNet -- ^ the network to scan
|
||||
-> Int -- ^ The block to start the check
|
||||
-> Int -- ^ depth
|
||||
-> IO Int
|
||||
checkIntegrity dbP zHost zPort b d =
|
||||
checkIntegrity dbP zHost zPort znet b d =
|
||||
if b < 1
|
||||
then return 1
|
||||
else do
|
||||
|
@ -263,10 +264,10 @@ checkIntegrity dbP zHost zPort b d =
|
|||
Left e -> throwIO $ userError e
|
||||
Right blk -> do
|
||||
pool <- runNoLoggingT $ initPool dbP
|
||||
dbBlk <- getBlock pool b
|
||||
dbBlk <- getBlock pool b $ ZcashNetDB znet
|
||||
case dbBlk of
|
||||
Nothing -> throwIO $ userError "Block mismatch, rescan needed"
|
||||
Nothing -> return 1
|
||||
Just dbBlk' ->
|
||||
if bl_hash blk == getHex (zcashBlockHash $ entityVal dbBlk')
|
||||
then return b
|
||||
else checkIntegrity dbP zHost zPort (b - 5 * d) (d + 1)
|
||||
else checkIntegrity dbP zHost zPort znet (b - 5 * d) (d + 1)
|
||||
|
|
|
@ -17,6 +17,7 @@ import qualified Data.ByteString.Char8 as C
|
|||
import Data.HexString
|
||||
import Data.Int (Int64)
|
||||
import Data.Maybe (fromMaybe)
|
||||
import Data.Scientific (Scientific)
|
||||
import qualified Data.Text as T
|
||||
import qualified Data.Text.Encoding as E
|
||||
import Data.Text.Encoding.Error (lenientDecode)
|
||||
|
@ -241,7 +242,7 @@ instance ToJSON ValidAddressAPI where
|
|||
|
||||
data ProposedNote = ProposedNote
|
||||
{ pn_addr :: !ValidAddressAPI
|
||||
, pn_amt :: !Float
|
||||
, pn_amt :: !Scientific
|
||||
, pn_memo :: !(Maybe T.Text)
|
||||
} deriving (Eq, Prelude.Show)
|
||||
|
||||
|
|
|
@ -13,26 +13,31 @@ import qualified Data.Text.Encoding as E
|
|||
import System.Directory
|
||||
import System.Process (createProcess_, shell)
|
||||
import Text.Regex.Posix
|
||||
import ZcashHaskell.Orchard (encodeUnifiedAddress, isValidUnifiedAddress, parseAddress)
|
||||
import ZcashHaskell.Orchard
|
||||
( encodeUnifiedAddress
|
||||
, isValidUnifiedAddress
|
||||
, parseAddress
|
||||
)
|
||||
import ZcashHaskell.Sapling (decodeSaplingAddress, isValidShieldedAddress)
|
||||
import ZcashHaskell.Transparent
|
||||
( decodeExchangeAddress
|
||||
, decodeTransparentAddress
|
||||
)
|
||||
import ZcashHaskell.Types
|
||||
( SaplingAddress(..)
|
||||
( ExchangeAddress(..)
|
||||
, SaplingAddress(..)
|
||||
, TransparentAddress(..)
|
||||
, UnifiedAddress(..)
|
||||
, ZcashNet(..)
|
||||
, ValidAddress(..)
|
||||
, ExchangeAddress(..)
|
||||
, ZcashNet(..)
|
||||
)
|
||||
import ZcashHaskell.Utils (makeZebraCall)
|
||||
import Zenith.Types
|
||||
( AddressGroup(..)
|
||||
, PrivacyPolicy(..)
|
||||
, UnifiedAddressDB(..)
|
||||
, ZcashAddress(..)
|
||||
, ZcashPool(..)
|
||||
, PrivacyPolicy(..)
|
||||
)
|
||||
|
||||
-- | Helper function to convert numbers into JSON
|
||||
|
@ -127,9 +132,9 @@ isRecipientValid a = do
|
|||
|
||||
isUnifiedAddressValid :: T.Text -> Bool
|
||||
isUnifiedAddressValid ua =
|
||||
case isValidUnifiedAddress (E.encodeUtf8 ua) of
|
||||
Just _a1 -> True
|
||||
Nothing -> False
|
||||
case isValidUnifiedAddress (E.encodeUtf8 ua) of
|
||||
Just _a1 -> True
|
||||
Nothing -> False
|
||||
|
||||
isSaplingAddressValid :: T.Text -> Bool
|
||||
isSaplingAddressValid sa = isValidShieldedAddress (E.encodeUtf8 sa)
|
||||
|
@ -137,8 +142,8 @@ isSaplingAddressValid sa = isValidShieldedAddress (E.encodeUtf8 sa)
|
|||
isTransparentAddressValid :: T.Text -> Bool
|
||||
isTransparentAddressValid ta =
|
||||
case decodeTransparentAddress (E.encodeUtf8 ta) of
|
||||
Just _a3 -> True
|
||||
Nothing -> False
|
||||
Just _a3 -> True
|
||||
Nothing -> False
|
||||
|
||||
isExchangeAddressValid :: T.Text -> Bool
|
||||
isExchangeAddressValid xa =
|
||||
|
@ -147,40 +152,44 @@ isExchangeAddressValid xa =
|
|||
Nothing -> False
|
||||
|
||||
isRecipientValidGUI :: PrivacyPolicy -> T.Text -> Bool
|
||||
isRecipientValidGUI p a = do
|
||||
isRecipientValidGUI p a = do
|
||||
let adr = parseAddress (E.encodeUtf8 a)
|
||||
case p of
|
||||
Full -> case adr of
|
||||
Just a ->
|
||||
case a of
|
||||
Unified ua -> True
|
||||
Sapling sa -> True
|
||||
_ -> False
|
||||
Nothing -> False
|
||||
Medium -> case adr of
|
||||
Just a ->
|
||||
case a of
|
||||
Unified ua -> True
|
||||
Sapling sa -> True
|
||||
_ -> False
|
||||
Nothing -> False
|
||||
Low -> case adr of
|
||||
Just a ->
|
||||
case a of
|
||||
Unified ua -> True
|
||||
Sapling sa -> True
|
||||
Transparent ta -> True
|
||||
_ -> False
|
||||
Nothing -> False
|
||||
None -> case adr of
|
||||
Just a ->
|
||||
case a of
|
||||
Transparent ta -> True
|
||||
Exchange ea -> True
|
||||
_ -> False
|
||||
Nothing -> False
|
||||
Full ->
|
||||
case adr of
|
||||
Just a ->
|
||||
case a of
|
||||
Unified ua -> True
|
||||
Sapling sa -> True
|
||||
_ -> False
|
||||
Nothing -> False
|
||||
Medium ->
|
||||
case adr of
|
||||
Just a ->
|
||||
case a of
|
||||
Unified ua -> True
|
||||
Sapling sa -> True
|
||||
_ -> False
|
||||
Nothing -> False
|
||||
Low ->
|
||||
case adr of
|
||||
Just a ->
|
||||
case a of
|
||||
Unified ua -> True
|
||||
Sapling sa -> True
|
||||
Transparent ta -> True
|
||||
_ -> False
|
||||
Nothing -> False
|
||||
None ->
|
||||
case adr of
|
||||
Just a ->
|
||||
case a of
|
||||
Transparent ta -> True
|
||||
Exchange ea -> True
|
||||
_ -> False
|
||||
Nothing -> False
|
||||
|
||||
isZecAddressValid :: T.Text -> Bool
|
||||
isZecAddressValid :: T.Text -> Bool
|
||||
isZecAddressValid a = do
|
||||
case isValidUnifiedAddress (E.encodeUtf8 a) of
|
||||
Just _a1 -> True
|
||||
|
@ -232,3 +241,10 @@ padWithZero n s
|
|||
isEmpty :: [a] -> Bool
|
||||
isEmpty [] = True
|
||||
isEmpty _ = False
|
||||
|
||||
getChainTip :: T.Text -> Int -> IO Int
|
||||
getChainTip zHost zPort = do
|
||||
r <- makeZebraCall zHost zPort "getblockcount" []
|
||||
case r of
|
||||
Left e1 -> pure 0
|
||||
Right i -> pure i
|
||||
|
|
764
test/Spec.hs
764
test/Spec.hs
|
@ -2,6 +2,7 @@
|
|||
|
||||
import Control.Monad (when)
|
||||
import Control.Monad.Logger (runFileLoggingT, runNoLoggingT)
|
||||
import Data.Aeson
|
||||
import Data.HexString
|
||||
import Data.Maybe (fromJust)
|
||||
import qualified Data.Text.Encoding as E
|
||||
|
@ -33,8 +34,10 @@ import ZcashHaskell.Types
|
|||
, Scope(..)
|
||||
, ShieldedOutput(..)
|
||||
, TxError(..)
|
||||
, ValidAddress(..)
|
||||
, ZcashNet(..)
|
||||
)
|
||||
import ZcashHaskell.Utils (f4Jumble, makeZebraCall, readZebraTransaction)
|
||||
import Zenith.Core
|
||||
import Zenith.DB
|
||||
import Zenith.Types
|
||||
|
@ -182,6 +185,12 @@ main = do
|
|||
a `shouldBe`
|
||||
Just
|
||||
"ztestsapling1tgjr4zppwk4ne8xy6gdq4z2gwq7dmf5jq8z2ctpn8nlmtse0a74fa5z0m8z383gmpgqz6q6duu4"
|
||||
describe "Witnesses" $ do
|
||||
describe "Sapling" $ do
|
||||
it "max output id" $ do
|
||||
pool <- runNoLoggingT $ initPool "/home/rav/Zenith/zenith.db"
|
||||
sId <- getMaxSaplingNote pool
|
||||
sId `shouldBe` toSqlKey 0
|
||||
describe "Notes" $ do
|
||||
xit "Check Orchard notes" $ do
|
||||
pool <- runNoLoggingT $ initPool "/home/rav/Zenith/zenith.db"
|
||||
|
@ -195,381 +204,380 @@ main = do
|
|||
pool <- runNoLoggingT $ initPool "/home/rav/Zenith/zenith.db"
|
||||
oNotes <- getWalletUnspentTrNotes pool (toSqlKey 1)
|
||||
oNotes `shouldBe` []
|
||||
describe "Creating Tx" $ do
|
||||
describe "Full" $ do
|
||||
it "To Orchard" $ do
|
||||
let uaRead =
|
||||
parseAddress
|
||||
"utest1dl54utt6prjj5e0dnlknwumnxq9hycdjpkfr0sy6e6h522remqee8axe9zax0wsjrwpj76v555pdhvj9rnargpfyycs0vpkapq98xcdhem99gc4wchzn0ggepq3y6nz3a9sscwgqxgsh9vzhcad402y3x9szfregck5gslkya3c79d86xx0l33tpk8gnn7ew9vw37w43zh22u8dgdax"
|
||||
case uaRead of
|
||||
Nothing -> assertFailure "wrong address"
|
||||
Just ua -> do
|
||||
pool <- runNoLoggingT $ initPool "/home/rav/Zenith/zenith.db"
|
||||
tx <-
|
||||
runFileLoggingT "zenith.log" $
|
||||
prepareTxV2
|
||||
pool
|
||||
"localhost"
|
||||
18232
|
||||
TestNet
|
||||
(toSqlKey 3)
|
||||
3026170
|
||||
[ ProposedNote
|
||||
(ValidAddressAPI $ fromJust uaRead)
|
||||
0.005
|
||||
(Just "Sending memo to orchard")
|
||||
]
|
||||
Full
|
||||
case tx of
|
||||
Left e -> assertFailure $ show e
|
||||
Right h -> h `shouldBe` (hexString "deadbeef")
|
||||
it "To Sapling" $ do
|
||||
let uaRead =
|
||||
parseAddress
|
||||
"ztestsapling136jp8z89v2jh6kqd5rs4dtvlxym90m43svzdwzxaplyvc5ttzppytpvx80ncllcsqzpmukxjl3y"
|
||||
case uaRead of
|
||||
Nothing -> assertFailure "wrong address"
|
||||
Just ua -> do
|
||||
pool <- runNoLoggingT $ initPool "/home/rav/Zenith/zenith.db"
|
||||
tx <-
|
||||
runFileLoggingT "zenith.log" $
|
||||
prepareTxV2
|
||||
pool
|
||||
"localhost"
|
||||
18232
|
||||
TestNet
|
||||
(toSqlKey 4)
|
||||
3001331
|
||||
[ ProposedNote
|
||||
(ValidAddressAPI $ fromJust uaRead)
|
||||
0.005
|
||||
(Just "Sending memo to sapling")
|
||||
]
|
||||
Full
|
||||
case tx of
|
||||
Left e -> assertFailure $ show e
|
||||
Right h -> h `shouldNotBe` (hexString "deadbeef")
|
||||
it "To Transparent" $ do
|
||||
let uaRead = parseAddress "tmAmSa4AauSFuJieeanRBjkfnah45ysGtgZ"
|
||||
case uaRead of
|
||||
Nothing -> assertFailure "wrong address"
|
||||
Just ua -> do
|
||||
pool <- runNoLoggingT $ initPool "/home/rav/Zenith/zenith.db"
|
||||
tx <-
|
||||
runFileLoggingT "zenith.log" $
|
||||
prepareTxV2
|
||||
pool
|
||||
"localhost"
|
||||
18232
|
||||
TestNet
|
||||
(toSqlKey 4)
|
||||
3001331
|
||||
[ ProposedNote
|
||||
(ValidAddressAPI $ fromJust uaRead)
|
||||
0.005
|
||||
Nothing
|
||||
]
|
||||
Full
|
||||
tx `shouldBe`
|
||||
Left
|
||||
(PrivacyPolicyError "Receiver not capable of Full privacy")
|
||||
it "To mixed shielded receivers" $ do
|
||||
let uaRead =
|
||||
parseAddress
|
||||
"utest1dl54utt6prjj5e0dnlknwumnxq9hycdjpkfr0sy6e6h522remqee8axe9zax0wsjrwpj76v555pdhvj9rnargpfyycs0vpkapq98xcdhem99gc4wchzn0ggepq3y6nz3a9sscwgqxgsh9vzhcad402y3x9szfregck5gslkya3c79d86xx0l33tpk8gnn7ew9vw37w43zh22u8dgdax"
|
||||
let uaRead2 =
|
||||
parseAddress
|
||||
"ztestsapling136jp8z89v2jh6kqd5rs4dtvlxym90m43svzdwzxaplyvc5ttzppytpvx80ncllcsqzpmukxjl3y"
|
||||
case uaRead of
|
||||
Nothing -> assertFailure "wrong address"
|
||||
Just ua -> do
|
||||
pool <- runNoLoggingT $ initPool "/home/rav/Zenith/zenith.db"
|
||||
tx <-
|
||||
runFileLoggingT "zenith.log" $
|
||||
prepareTxV2
|
||||
pool
|
||||
"localhost"
|
||||
18232
|
||||
TestNet
|
||||
(toSqlKey 1)
|
||||
3001331
|
||||
[ ProposedNote
|
||||
(ValidAddressAPI $ fromJust uaRead)
|
||||
0.005
|
||||
(Just "Sending memo to orchard")
|
||||
, ProposedNote
|
||||
(ValidAddressAPI $ fromJust uaRead2)
|
||||
0.004
|
||||
Nothing
|
||||
]
|
||||
Full
|
||||
tx `shouldBe`
|
||||
Left
|
||||
(PrivacyPolicyError
|
||||
"Combination of receivers not allowed for Full privacy")
|
||||
describe "Medium" $ do
|
||||
it "To Orchard" $ do
|
||||
let uaRead =
|
||||
parseAddress
|
||||
"utest1dl54utt6prjj5e0dnlknwumnxq9hycdjpkfr0sy6e6h522remqee8axe9zax0wsjrwpj76v555pdhvj9rnargpfyycs0vpkapq98xcdhem99gc4wchzn0ggepq3y6nz3a9sscwgqxgsh9vzhcad402y3x9szfregck5gslkya3c79d86xx0l33tpk8gnn7ew9vw37w43zh22u8dgdax"
|
||||
case uaRead of
|
||||
Nothing -> assertFailure "wrong address"
|
||||
Just ua -> do
|
||||
pool <- runNoLoggingT $ initPool "/home/rav/Zenith/zenith.db"
|
||||
tx <-
|
||||
runFileLoggingT "zenith.log" $
|
||||
prepareTxV2
|
||||
pool
|
||||
"localhost"
|
||||
18232
|
||||
TestNet
|
||||
(toSqlKey 1)
|
||||
3001372
|
||||
[ ProposedNote
|
||||
(ValidAddressAPI $ fromJust uaRead)
|
||||
0.005
|
||||
(Just "Sending memo to orchard")
|
||||
]
|
||||
Medium
|
||||
case tx of
|
||||
Left e -> assertFailure $ show e
|
||||
Right h -> h `shouldNotBe` (hexString "deadbeef")
|
||||
it "To Sapling" $ do
|
||||
let uaRead =
|
||||
parseAddress
|
||||
"ztestsapling136jp8z89v2jh6kqd5rs4dtvlxym90m43svzdwzxaplyvc5ttzppytpvx80ncllcsqzpmukxjl3y"
|
||||
case uaRead of
|
||||
Nothing -> assertFailure "wrong address"
|
||||
Just ua -> do
|
||||
pool <- runNoLoggingT $ initPool "/home/rav/Zenith/zenith.db"
|
||||
tx <-
|
||||
runFileLoggingT "zenith.log" $
|
||||
prepareTxV2
|
||||
pool
|
||||
"localhost"
|
||||
18232
|
||||
TestNet
|
||||
(toSqlKey 1)
|
||||
3001372
|
||||
[ ProposedNote
|
||||
(ValidAddressAPI $ fromJust uaRead)
|
||||
0.005
|
||||
(Just "Sending memo to sapling")
|
||||
]
|
||||
Medium
|
||||
case tx of
|
||||
Left e -> assertFailure $ show e
|
||||
Right h -> h `shouldNotBe` (hexString "deadbeef")
|
||||
it "To Transparent" $ do
|
||||
let uaRead = parseAddress "tmAmSa4AauSFuJieeanRBjkfnah45ysGtgZ"
|
||||
case uaRead of
|
||||
Nothing -> assertFailure "wrong address"
|
||||
Just ua -> do
|
||||
pool <- runNoLoggingT $ initPool "/home/rav/Zenith/zenith.db"
|
||||
tx <-
|
||||
runFileLoggingT "zenith.log" $
|
||||
prepareTxV2
|
||||
pool
|
||||
"localhost"
|
||||
18232
|
||||
TestNet
|
||||
(toSqlKey 4)
|
||||
3001331
|
||||
[ ProposedNote
|
||||
(ValidAddressAPI $ fromJust uaRead)
|
||||
0.005
|
||||
Nothing
|
||||
]
|
||||
Medium
|
||||
tx `shouldBe`
|
||||
Left
|
||||
(PrivacyPolicyError "Receiver not capable of Medium privacy")
|
||||
it "To mixed shielded receivers" $ do
|
||||
let uaRead =
|
||||
parseAddress
|
||||
"utest1dl54utt6prjj5e0dnlknwumnxq9hycdjpkfr0sy6e6h522remqee8axe9zax0wsjrwpj76v555pdhvj9rnargpfyycs0vpkapq98xcdhem99gc4wchzn0ggepq3y6nz3a9sscwgqxgsh9vzhcad402y3x9szfregck5gslkya3c79d86xx0l33tpk8gnn7ew9vw37w43zh22u8dgdax"
|
||||
let uaRead2 =
|
||||
parseAddress
|
||||
"ztestsapling136jp8z89v2jh6kqd5rs4dtvlxym90m43svzdwzxaplyvc5ttzppytpvx80ncllcsqzpmukxjl3y"
|
||||
case uaRead of
|
||||
Nothing -> assertFailure "wrong address"
|
||||
Just ua -> do
|
||||
pool <- runNoLoggingT $ initPool "/home/rav/Zenith/zenith.db"
|
||||
tx <-
|
||||
runFileLoggingT "zenith.log" $
|
||||
prepareTxV2
|
||||
pool
|
||||
"localhost"
|
||||
18232
|
||||
TestNet
|
||||
(toSqlKey 1)
|
||||
3001331
|
||||
[ ProposedNote
|
||||
(ValidAddressAPI $ fromJust uaRead)
|
||||
0.005
|
||||
(Just "Sending memo to orchard")
|
||||
, ProposedNote
|
||||
(ValidAddressAPI $ fromJust uaRead2)
|
||||
0.004
|
||||
Nothing
|
||||
]
|
||||
Medium
|
||||
case tx of
|
||||
Left e -> assertFailure $ show e
|
||||
Right h -> h `shouldNotBe` (hexString "deadbeef")
|
||||
describe "Low" $ do
|
||||
it "To Orchard" $ do
|
||||
let uaRead =
|
||||
parseAddress
|
||||
"utest1dl54utt6prjj5e0dnlknwumnxq9hycdjpkfr0sy6e6h522remqee8axe9zax0wsjrwpj76v555pdhvj9rnargpfyycs0vpkapq98xcdhem99gc4wchzn0ggepq3y6nz3a9sscwgqxgsh9vzhcad402y3x9szfregck5gslkya3c79d86xx0l33tpk8gnn7ew9vw37w43zh22u8dgdax"
|
||||
case uaRead of
|
||||
Nothing -> assertFailure "wrong address"
|
||||
Just ua -> do
|
||||
pool <- runNoLoggingT $ initPool "/home/rav/Zenith/zenith.db"
|
||||
tx <-
|
||||
runFileLoggingT "zenith.log" $
|
||||
prepareTxV2
|
||||
pool
|
||||
"localhost"
|
||||
18232
|
||||
TestNet
|
||||
(toSqlKey 1)
|
||||
3001372
|
||||
[ ProposedNote
|
||||
(ValidAddressAPI $ fromJust uaRead)
|
||||
0.005
|
||||
Nothing
|
||||
]
|
||||
Low
|
||||
case tx of
|
||||
Left e -> assertFailure $ show e
|
||||
Right h -> h `shouldNotBe` (hexString "deadbeef")
|
||||
it "To Sapling" $ do
|
||||
let uaRead =
|
||||
parseAddress
|
||||
"ztestsapling136jp8z89v2jh6kqd5rs4dtvlxym90m43svzdwzxaplyvc5ttzppytpvx80ncllcsqzpmukxjl3y"
|
||||
case uaRead of
|
||||
Nothing -> assertFailure "wrong address"
|
||||
Just ua -> do
|
||||
pool <- runNoLoggingT $ initPool "/home/rav/Zenith/zenith.db"
|
||||
tx <-
|
||||
runFileLoggingT "zenith.log" $
|
||||
prepareTxV2
|
||||
pool
|
||||
"localhost"
|
||||
18232
|
||||
TestNet
|
||||
(toSqlKey 1)
|
||||
3001372
|
||||
[ ProposedNote
|
||||
(ValidAddressAPI $ fromJust uaRead)
|
||||
0.005
|
||||
Nothing
|
||||
]
|
||||
Low
|
||||
case tx of
|
||||
Left e -> assertFailure $ show e
|
||||
Right h -> h `shouldNotBe` (hexString "deadbeef")
|
||||
it "To Transparent" $ do
|
||||
let uaRead = parseAddress "tmAmSa4AauSFuJieeanRBjkfnah45ysGtgZ"
|
||||
case uaRead of
|
||||
Nothing -> assertFailure "wrong address"
|
||||
Just ua -> do
|
||||
pool <- runNoLoggingT $ initPool "/home/rav/Zenith/zenith.db"
|
||||
tx <-
|
||||
runFileLoggingT "zenith.log" $
|
||||
prepareTxV2
|
||||
pool
|
||||
"localhost"
|
||||
18232
|
||||
TestNet
|
||||
(toSqlKey 1)
|
||||
3001372
|
||||
[ ProposedNote
|
||||
(ValidAddressAPI $ fromJust uaRead)
|
||||
0.005
|
||||
Nothing
|
||||
]
|
||||
Low
|
||||
case tx of
|
||||
Left e -> assertFailure $ show e
|
||||
Right h -> h `shouldNotBe` (hexString "deadbeef")
|
||||
describe "None" $ do
|
||||
it "To Orchard" $ do
|
||||
let uaRead =
|
||||
parseAddress
|
||||
"utest1dl54utt6prjj5e0dnlknwumnxq9hycdjpkfr0sy6e6h522remqee8axe9zax0wsjrwpj76v555pdhvj9rnargpfyycs0vpkapq98xcdhem99gc4wchzn0ggepq3y6nz3a9sscwgqxgsh9vzhcad402y3x9szfregck5gslkya3c79d86xx0l33tpk8gnn7ew9vw37w43zh22u8dgdax"
|
||||
case uaRead of
|
||||
Nothing -> assertFailure "wrong address"
|
||||
Just ua -> do
|
||||
pool <- runNoLoggingT $ initPool "/home/rav/Zenith/zenith.db"
|
||||
tx <-
|
||||
runFileLoggingT "zenith.log" $
|
||||
prepareTxV2
|
||||
pool
|
||||
"localhost"
|
||||
18232
|
||||
TestNet
|
||||
(toSqlKey 1)
|
||||
3001372
|
||||
[ ProposedNote
|
||||
(ValidAddressAPI $ fromJust uaRead)
|
||||
0.005
|
||||
Nothing
|
||||
]
|
||||
None
|
||||
tx `shouldBe`
|
||||
Left
|
||||
(PrivacyPolicyError
|
||||
"Shielded recipients not compatible with privacy policy.")
|
||||
it "To Sapling" $ do
|
||||
let uaRead =
|
||||
parseAddress
|
||||
"ztestsapling136jp8z89v2jh6kqd5rs4dtvlxym90m43svzdwzxaplyvc5ttzppytpvx80ncllcsqzpmukxjl3y"
|
||||
case uaRead of
|
||||
Nothing -> assertFailure "wrong address"
|
||||
Just ua -> do
|
||||
pool <- runNoLoggingT $ initPool "/home/rav/Zenith/zenith.db"
|
||||
tx <-
|
||||
runFileLoggingT "zenith.log" $
|
||||
prepareTxV2
|
||||
pool
|
||||
"localhost"
|
||||
18232
|
||||
TestNet
|
||||
(toSqlKey 1)
|
||||
3001372
|
||||
[ ProposedNote
|
||||
(ValidAddressAPI $ fromJust uaRead)
|
||||
0.005
|
||||
Nothing
|
||||
]
|
||||
None
|
||||
tx `shouldBe`
|
||||
Left
|
||||
(PrivacyPolicyError
|
||||
"Shielded recipients not compatible with privacy policy.")
|
||||
it "To Transparent" $ do
|
||||
let uaRead = parseAddress "tmAmSa4AauSFuJieeanRBjkfnah45ysGtgZ"
|
||||
case uaRead of
|
||||
Nothing -> assertFailure "wrong address"
|
||||
Just ua -> do
|
||||
pool <- runNoLoggingT $ initPool "/home/rav/Zenith/zenith.db"
|
||||
tx <-
|
||||
runFileLoggingT "zenith.log" $
|
||||
prepareTxV2
|
||||
pool
|
||||
"localhost"
|
||||
18232
|
||||
TestNet
|
||||
(toSqlKey 1)
|
||||
3001372
|
||||
[ ProposedNote
|
||||
(ValidAddressAPI $ fromJust uaRead)
|
||||
0.005
|
||||
Nothing
|
||||
]
|
||||
None
|
||||
case tx of
|
||||
Left e -> assertFailure $ show e
|
||||
Right h -> h `shouldNotBe` (hexString "deadbeef")
|
||||
describe "Creating Tx" $ do
|
||||
describe "Full" $ do
|
||||
it "To Orchard" $ do
|
||||
let uaRead =
|
||||
parseAddress
|
||||
"utest1dl54utt6prjj5e0dnlknwumnxq9hycdjpkfr0sy6e6h522remqee8axe9zax0wsjrwpj76v555pdhvj9rnargpfyycs0vpkapq98xcdhem99gc4wchzn0ggepq3y6nz3a9sscwgqxgsh9vzhcad402y3x9szfregck5gslkya3c79d86xx0l33tpk8gnn7ew9vw37w43zh22u8dgdax"
|
||||
case uaRead of
|
||||
Nothing -> assertFailure "wrong address"
|
||||
Just ua -> do
|
||||
pool <- runNoLoggingT $ initPool "/home/rav/Zenith/zenith.db"
|
||||
tx <-
|
||||
runFileLoggingT "zenith.log" $
|
||||
prepareTxV2
|
||||
pool
|
||||
"localhost"
|
||||
18232
|
||||
TestNet
|
||||
(toSqlKey 3)
|
||||
3026170
|
||||
[ ProposedNote
|
||||
(ValidAddressAPI $ fromJust uaRead)
|
||||
0.005
|
||||
(Just "Sending memo to orchard")
|
||||
]
|
||||
Full
|
||||
case tx of
|
||||
Left e -> assertFailure $ show e
|
||||
Right h -> h `shouldNotBe` hexString "deadbeef"
|
||||
it "To Sapling" $ do
|
||||
let uaRead =
|
||||
parseAddress
|
||||
"ztestsapling136jp8z89v2jh6kqd5rs4dtvlxym90m43svzdwzxaplyvc5ttzppytpvx80ncllcsqzpmukxjl3y"
|
||||
case uaRead of
|
||||
Nothing -> assertFailure "wrong address"
|
||||
Just ua -> do
|
||||
pool <- runNoLoggingT $ initPool "/home/rav/Zenith/zenith.db"
|
||||
tx <-
|
||||
runFileLoggingT "zenith.log" $
|
||||
prepareTxV2
|
||||
pool
|
||||
"localhost"
|
||||
18232
|
||||
TestNet
|
||||
(toSqlKey 4)
|
||||
3001331
|
||||
[ ProposedNote
|
||||
(ValidAddressAPI $ fromJust uaRead)
|
||||
0.005
|
||||
(Just "Sending memo to sapling")
|
||||
]
|
||||
Full
|
||||
case tx of
|
||||
Left e -> assertFailure $ show e
|
||||
Right h -> h `shouldNotBe` hexString "deadbeef"
|
||||
it "To Transparent" $ do
|
||||
let uaRead = parseAddress "tmAmSa4AauSFuJieeanRBjkfnah45ysGtgZ"
|
||||
case uaRead of
|
||||
Nothing -> assertFailure "wrong address"
|
||||
Just ua -> do
|
||||
pool <- runNoLoggingT $ initPool "/home/rav/Zenith/zenith.db"
|
||||
tx <-
|
||||
runFileLoggingT "zenith.log" $
|
||||
prepareTxV2
|
||||
pool
|
||||
"localhost"
|
||||
18232
|
||||
TestNet
|
||||
(toSqlKey 4)
|
||||
3001331
|
||||
[ ProposedNote
|
||||
(ValidAddressAPI $ fromJust uaRead)
|
||||
0.005
|
||||
Nothing
|
||||
]
|
||||
Full
|
||||
tx `shouldBe`
|
||||
Left (PrivacyPolicyError "Receiver not capable of Full privacy")
|
||||
it "To mixed shielded receivers" $ do
|
||||
let uaRead =
|
||||
parseAddress
|
||||
"utest1dl54utt6prjj5e0dnlknwumnxq9hycdjpkfr0sy6e6h522remqee8axe9zax0wsjrwpj76v555pdhvj9rnargpfyycs0vpkapq98xcdhem99gc4wchzn0ggepq3y6nz3a9sscwgqxgsh9vzhcad402y3x9szfregck5gslkya3c79d86xx0l33tpk8gnn7ew9vw37w43zh22u8dgdax"
|
||||
let uaRead2 =
|
||||
parseAddress
|
||||
"ztestsapling136jp8z89v2jh6kqd5rs4dtvlxym90m43svzdwzxaplyvc5ttzppytpvx80ncllcsqzpmukxjl3y"
|
||||
case uaRead of
|
||||
Nothing -> assertFailure "wrong address"
|
||||
Just ua -> do
|
||||
pool <- runNoLoggingT $ initPool "/home/rav/Zenith/zenith.db"
|
||||
tx <-
|
||||
runFileLoggingT "zenith.log" $
|
||||
prepareTxV2
|
||||
pool
|
||||
"localhost"
|
||||
18232
|
||||
TestNet
|
||||
(toSqlKey 1)
|
||||
3001331
|
||||
[ ProposedNote
|
||||
(ValidAddressAPI $ fromJust uaRead)
|
||||
0.005
|
||||
(Just "Sending memo to orchard")
|
||||
, ProposedNote
|
||||
(ValidAddressAPI $ fromJust uaRead2)
|
||||
0.004
|
||||
Nothing
|
||||
]
|
||||
Full
|
||||
tx `shouldBe`
|
||||
Left
|
||||
(PrivacyPolicyError
|
||||
"Combination of receivers not allowed for Full privacy")
|
||||
describe "Medium" $ do
|
||||
it "To Orchard" $ do
|
||||
let uaRead =
|
||||
parseAddress
|
||||
"utest1dl54utt6prjj5e0dnlknwumnxq9hycdjpkfr0sy6e6h522remqee8axe9zax0wsjrwpj76v555pdhvj9rnargpfyycs0vpkapq98xcdhem99gc4wchzn0ggepq3y6nz3a9sscwgqxgsh9vzhcad402y3x9szfregck5gslkya3c79d86xx0l33tpk8gnn7ew9vw37w43zh22u8dgdax"
|
||||
case uaRead of
|
||||
Nothing -> assertFailure "wrong address"
|
||||
Just ua -> do
|
||||
pool <- runNoLoggingT $ initPool "/home/rav/Zenith/zenith.db"
|
||||
tx <-
|
||||
runFileLoggingT "zenith.log" $
|
||||
prepareTxV2
|
||||
pool
|
||||
"localhost"
|
||||
18232
|
||||
TestNet
|
||||
(toSqlKey 1)
|
||||
3001372
|
||||
[ ProposedNote
|
||||
(ValidAddressAPI $ fromJust uaRead)
|
||||
0.005
|
||||
(Just "Sending memo to orchard")
|
||||
]
|
||||
Medium
|
||||
case tx of
|
||||
Left e -> assertFailure $ show e
|
||||
Right h -> h `shouldNotBe` hexString "deadbeef"
|
||||
it "To Sapling" $ do
|
||||
let uaRead =
|
||||
parseAddress
|
||||
"ztestsapling136jp8z89v2jh6kqd5rs4dtvlxym90m43svzdwzxaplyvc5ttzppytpvx80ncllcsqzpmukxjl3y"
|
||||
case uaRead of
|
||||
Nothing -> assertFailure "wrong address"
|
||||
Just ua -> do
|
||||
pool <- runNoLoggingT $ initPool "/home/rav/Zenith/zenith.db"
|
||||
tx <-
|
||||
runFileLoggingT "zenith.log" $
|
||||
prepareTxV2
|
||||
pool
|
||||
"localhost"
|
||||
18232
|
||||
TestNet
|
||||
(toSqlKey 1)
|
||||
3001372
|
||||
[ ProposedNote
|
||||
(ValidAddressAPI $ fromJust uaRead)
|
||||
0.005
|
||||
(Just "Sending memo to sapling")
|
||||
]
|
||||
Medium
|
||||
case tx of
|
||||
Left e -> assertFailure $ show e
|
||||
Right h -> h `shouldNotBe` (hexString "00")
|
||||
it "To Transparent" $ do
|
||||
let uaRead = parseAddress "tmAmSa4AauSFuJieeanRBjkfnah45ysGtgZ"
|
||||
case uaRead of
|
||||
Nothing -> assertFailure "wrong address"
|
||||
Just ua -> do
|
||||
pool <- runNoLoggingT $ initPool "/home/rav/Zenith/zenith.db"
|
||||
tx <-
|
||||
runFileLoggingT "zenith.log" $
|
||||
prepareTxV2
|
||||
pool
|
||||
"localhost"
|
||||
18232
|
||||
TestNet
|
||||
(toSqlKey 4)
|
||||
3001331
|
||||
[ ProposedNote
|
||||
(ValidAddressAPI $ fromJust uaRead)
|
||||
0.005
|
||||
Nothing
|
||||
]
|
||||
Medium
|
||||
tx `shouldBe`
|
||||
Left
|
||||
(PrivacyPolicyError "Receiver not capable of Medium privacy")
|
||||
it "To mixed shielded receivers" $ do
|
||||
let uaRead =
|
||||
parseAddress
|
||||
"utest1dl54utt6prjj5e0dnlknwumnxq9hycdjpkfr0sy6e6h522remqee8axe9zax0wsjrwpj76v555pdhvj9rnargpfyycs0vpkapq98xcdhem99gc4wchzn0ggepq3y6nz3a9sscwgqxgsh9vzhcad402y3x9szfregck5gslkya3c79d86xx0l33tpk8gnn7ew9vw37w43zh22u8dgdax"
|
||||
let uaRead2 =
|
||||
parseAddress
|
||||
"ztestsapling136jp8z89v2jh6kqd5rs4dtvlxym90m43svzdwzxaplyvc5ttzppytpvx80ncllcsqzpmukxjl3y"
|
||||
case uaRead of
|
||||
Nothing -> assertFailure "wrong address"
|
||||
Just ua -> do
|
||||
pool <- runNoLoggingT $ initPool "/home/rav/Zenith/zenith.db"
|
||||
tx <-
|
||||
runFileLoggingT "zenith.log" $
|
||||
prepareTxV2
|
||||
pool
|
||||
"localhost"
|
||||
18232
|
||||
TestNet
|
||||
(toSqlKey 1)
|
||||
3001331
|
||||
[ ProposedNote
|
||||
(ValidAddressAPI $ fromJust uaRead)
|
||||
0.005
|
||||
(Just "Sending memo to orchard")
|
||||
, ProposedNote
|
||||
(ValidAddressAPI $ fromJust uaRead2)
|
||||
0.004
|
||||
Nothing
|
||||
]
|
||||
Medium
|
||||
case tx of
|
||||
Left e -> assertFailure $ show e
|
||||
Right h -> h `shouldNotBe` (hexString "deadbeef")
|
||||
describe "Low" $ do
|
||||
it "To Orchard" $ do
|
||||
let uaRead =
|
||||
parseAddress
|
||||
"utest1dl54utt6prjj5e0dnlknwumnxq9hycdjpkfr0sy6e6h522remqee8axe9zax0wsjrwpj76v555pdhvj9rnargpfyycs0vpkapq98xcdhem99gc4wchzn0ggepq3y6nz3a9sscwgqxgsh9vzhcad402y3x9szfregck5gslkya3c79d86xx0l33tpk8gnn7ew9vw37w43zh22u8dgdax"
|
||||
case uaRead of
|
||||
Nothing -> assertFailure "wrong address"
|
||||
Just ua -> do
|
||||
pool <- runNoLoggingT $ initPool "/home/rav/Zenith/zenith.db"
|
||||
tx <-
|
||||
runFileLoggingT "zenith.log" $
|
||||
prepareTxV2
|
||||
pool
|
||||
"localhost"
|
||||
18232
|
||||
TestNet
|
||||
(toSqlKey 1)
|
||||
3001372
|
||||
[ ProposedNote
|
||||
(ValidAddressAPI $ fromJust uaRead)
|
||||
0.005
|
||||
Nothing
|
||||
]
|
||||
Low
|
||||
case tx of
|
||||
Left e -> assertFailure $ show e
|
||||
Right h -> h `shouldNotBe` (hexString "deadbeef")
|
||||
it "To Sapling" $ do
|
||||
let uaRead =
|
||||
parseAddress
|
||||
"ztestsapling136jp8z89v2jh6kqd5rs4dtvlxym90m43svzdwzxaplyvc5ttzppytpvx80ncllcsqzpmukxjl3y"
|
||||
case uaRead of
|
||||
Nothing -> assertFailure "wrong address"
|
||||
Just ua -> do
|
||||
pool <- runNoLoggingT $ initPool "/home/rav/Zenith/zenith.db"
|
||||
tx <-
|
||||
runFileLoggingT "zenith.log" $
|
||||
prepareTxV2
|
||||
pool
|
||||
"localhost"
|
||||
18232
|
||||
TestNet
|
||||
(toSqlKey 1)
|
||||
3001372
|
||||
[ ProposedNote
|
||||
(ValidAddressAPI $ fromJust uaRead)
|
||||
0.005
|
||||
Nothing
|
||||
]
|
||||
Low
|
||||
case tx of
|
||||
Left e -> assertFailure $ show e
|
||||
Right h -> h `shouldNotBe` (hexString "deadbeef")
|
||||
it "To Transparent" $ do
|
||||
let uaRead = parseAddress "tmAmSa4AauSFuJieeanRBjkfnah45ysGtgZ"
|
||||
case uaRead of
|
||||
Nothing -> assertFailure "wrong address"
|
||||
Just ua -> do
|
||||
pool <- runNoLoggingT $ initPool "/home/rav/Zenith/zenith.db"
|
||||
tx <-
|
||||
runFileLoggingT "zenith.log" $
|
||||
prepareTxV2
|
||||
pool
|
||||
"localhost"
|
||||
18232
|
||||
TestNet
|
||||
(toSqlKey 1)
|
||||
3001372
|
||||
[ ProposedNote
|
||||
(ValidAddressAPI $ fromJust uaRead)
|
||||
0.005
|
||||
Nothing
|
||||
]
|
||||
Low
|
||||
case tx of
|
||||
Left e -> assertFailure $ show e
|
||||
Right h -> h `shouldNotBe` (hexString "deadbeef")
|
||||
describe "None" $ do
|
||||
it "To Orchard" $ do
|
||||
let uaRead =
|
||||
parseAddress
|
||||
"utest1dl54utt6prjj5e0dnlknwumnxq9hycdjpkfr0sy6e6h522remqee8axe9zax0wsjrwpj76v555pdhvj9rnargpfyycs0vpkapq98xcdhem99gc4wchzn0ggepq3y6nz3a9sscwgqxgsh9vzhcad402y3x9szfregck5gslkya3c79d86xx0l33tpk8gnn7ew9vw37w43zh22u8dgdax"
|
||||
case uaRead of
|
||||
Nothing -> assertFailure "wrong address"
|
||||
Just ua -> do
|
||||
pool <- runNoLoggingT $ initPool "/home/rav/Zenith/zenith.db"
|
||||
tx <-
|
||||
runFileLoggingT "zenith.log" $
|
||||
prepareTxV2
|
||||
pool
|
||||
"localhost"
|
||||
18232
|
||||
TestNet
|
||||
(toSqlKey 1)
|
||||
3001372
|
||||
[ ProposedNote
|
||||
(ValidAddressAPI $ fromJust uaRead)
|
||||
0.005
|
||||
Nothing
|
||||
]
|
||||
None
|
||||
tx `shouldBe`
|
||||
Left
|
||||
(PrivacyPolicyError
|
||||
"Shielded recipients not compatible with privacy policy.")
|
||||
it "To Sapling" $ do
|
||||
let uaRead =
|
||||
parseAddress
|
||||
"ztestsapling136jp8z89v2jh6kqd5rs4dtvlxym90m43svzdwzxaplyvc5ttzppytpvx80ncllcsqzpmukxjl3y"
|
||||
case uaRead of
|
||||
Nothing -> assertFailure "wrong address"
|
||||
Just ua -> do
|
||||
pool <- runNoLoggingT $ initPool "/home/rav/Zenith/zenith.db"
|
||||
tx <-
|
||||
runFileLoggingT "zenith.log" $
|
||||
prepareTxV2
|
||||
pool
|
||||
"localhost"
|
||||
18232
|
||||
TestNet
|
||||
(toSqlKey 1)
|
||||
3001372
|
||||
[ ProposedNote
|
||||
(ValidAddressAPI $ fromJust uaRead)
|
||||
0.005
|
||||
Nothing
|
||||
]
|
||||
None
|
||||
tx `shouldBe`
|
||||
Left
|
||||
(PrivacyPolicyError
|
||||
"Shielded recipients not compatible with privacy policy.")
|
||||
it "To Transparent" $ do
|
||||
let uaRead = parseAddress "tmAmSa4AauSFuJieeanRBjkfnah45ysGtgZ"
|
||||
case uaRead of
|
||||
Nothing -> assertFailure "wrong address"
|
||||
Just ua -> do
|
||||
pool <- runNoLoggingT $ initPool "/home/rav/Zenith/zenith.db"
|
||||
tx <-
|
||||
runFileLoggingT "zenith.log" $
|
||||
prepareTxV2
|
||||
pool
|
||||
"localhost"
|
||||
18232
|
||||
TestNet
|
||||
(toSqlKey 1)
|
||||
3001372
|
||||
[ ProposedNote
|
||||
(ValidAddressAPI $ fromJust uaRead)
|
||||
0.005
|
||||
Nothing
|
||||
]
|
||||
None
|
||||
case tx of
|
||||
Left e -> assertFailure $ show e
|
||||
Right h -> h `shouldNotBe` hexString "deadbeef"
|
||||
|
|
|
@ -1 +1 @@
|
|||
Subproject commit 662a0d1148d3f52e2683157a4c9280bb8e81b0cb
|
||||
Subproject commit 6d4b6840d30fe1631902acd0388bef0040fee9e8
|
|
@ -141,6 +141,7 @@ test-suite zenith-tests
|
|||
build-depends:
|
||||
base >=4.12 && <5
|
||||
, bytestring
|
||||
, aeson
|
||||
, configurator
|
||||
, monad-logger
|
||||
, data-default
|
||||
|
|
Loading…
Reference in a new issue