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
|
- `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
|
||||||
|
|
||||||
|
|
|
||||||
|
|
@ -75,6 +75,7 @@ import Control.Monad.Logger
|
||||||
import Data.Aeson
|
import Data.Aeson
|
||||||
import Data.HexString (HexString(..), toText)
|
import Data.HexString (HexString(..), toText)
|
||||||
import Data.Maybe
|
import Data.Maybe
|
||||||
|
import Data.Scientific (Scientific, scientific)
|
||||||
import qualified Data.Text as T
|
import qualified Data.Text as T
|
||||||
import qualified Data.Text.Encoding as E
|
import qualified Data.Text.Encoding as E
|
||||||
import Data.Time.Clock.POSIX (posixSecondsToUTCTime)
|
import Data.Time.Clock.POSIX (posixSecondsToUTCTime)
|
||||||
|
|
@ -119,10 +120,10 @@ import Zenith.Types
|
||||||
import Zenith.Utils
|
import Zenith.Utils
|
||||||
( displayTaz
|
( displayTaz
|
||||||
, displayZec
|
, displayZec
|
||||||
|
, getChainTip
|
||||||
, isRecipientValid
|
, isRecipientValid
|
||||||
, isRecipientValidGUI
|
, isRecipientValidGUI
|
||||||
, jsonNumber
|
, jsonNumber
|
||||||
, parseAddressUA
|
|
||||||
, showAddress
|
, showAddress
|
||||||
, validBarValue
|
, validBarValue
|
||||||
)
|
)
|
||||||
|
|
@ -159,7 +160,7 @@ makeLenses ''DialogInput
|
||||||
|
|
||||||
data SendInput = SendInput
|
data SendInput = SendInput
|
||||||
{ _sendTo :: !T.Text
|
{ _sendTo :: !T.Text
|
||||||
, _sendAmt :: !Float
|
, _sendAmt :: !Scientific
|
||||||
, _sendMemo :: !T.Text
|
, _sendMemo :: !T.Text
|
||||||
, _policyField :: !PrivacyPolicy
|
, _policyField :: !PrivacyPolicy
|
||||||
} deriving (Show)
|
} deriving (Show)
|
||||||
|
|
@ -174,7 +175,7 @@ data AdrBookEntry = AdrBookEntry
|
||||||
makeLenses ''AdrBookEntry
|
makeLenses ''AdrBookEntry
|
||||||
|
|
||||||
newtype ShDshEntry = ShDshEntry
|
newtype ShDshEntry = ShDshEntry
|
||||||
{ _shAmt :: Float
|
{ _shAmt :: Scientific
|
||||||
} deriving (Show)
|
} deriving (Show)
|
||||||
|
|
||||||
makeLenses ''ShDshEntry
|
makeLenses ''ShDshEntry
|
||||||
|
|
@ -701,8 +702,8 @@ mkSendForm bal =
|
||||||
, label "Memo: " @@= editTextField sendMemo MemoField (Just 1)
|
, label "Memo: " @@= editTextField sendMemo MemoField (Just 1)
|
||||||
]
|
]
|
||||||
where
|
where
|
||||||
isAmountValid :: Integer -> Float -> Bool
|
isAmountValid :: Integer -> Scientific -> Bool
|
||||||
isAmountValid b i = (fromIntegral b / 100000000.0) >= i
|
isAmountValid b i = fromIntegral b >= (i * scientific 1 8)
|
||||||
label s w =
|
label s w =
|
||||||
padBottom (Pad 1) $ vLimit 1 (hLimit 15 $ str s <+> fill ' ') <+> w
|
padBottom (Pad 1) $ vLimit 1 (hLimit 15 $ str s <+> fill ' ') <+> w
|
||||||
|
|
||||||
|
|
@ -713,8 +714,8 @@ mkDeshieldForm tbal =
|
||||||
editShowableFieldWithValidate shAmt AmtField (isAmountValid tbal)
|
editShowableFieldWithValidate shAmt AmtField (isAmountValid tbal)
|
||||||
]
|
]
|
||||||
where
|
where
|
||||||
isAmountValid :: Integer -> Float -> Bool
|
isAmountValid :: Integer -> Scientific -> Bool
|
||||||
isAmountValid b i = (fromIntegral b / 100000000.0) >= i
|
isAmountValid b i = fromIntegral b >= (i * scientific 1 8)
|
||||||
label s w =
|
label s w =
|
||||||
padBottom (Pad 1) $ vLimit 1 (hLimit 15 $ str s <+> fill ' ') <+> w
|
padBottom (Pad 1) $ vLimit 1 (hLimit 15 $ str s <+> fill ' ') <+> w
|
||||||
|
|
||||||
|
|
@ -831,7 +832,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 dbBlock 1
|
chkBlock <- liftIO $ checkIntegrity dbP zHost zPort znet 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"
|
||||||
|
|
@ -839,11 +840,12 @@ 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 $
|
||||||
|
|
@ -1201,7 +1203,8 @@ appEvent (BT.VtyEvent e) = do
|
||||||
Just (_k, w) -> return w
|
Just (_k, w) -> return w
|
||||||
fs1 <- BT.zoom txForm $ BT.gets formState
|
fs1 <- BT.zoom txForm $ BT.gets formState
|
||||||
bl <-
|
bl <-
|
||||||
liftIO $ getLastSyncBlock pool $ entityKey selWal
|
liftIO $
|
||||||
|
getChainTip (s ^. zebraHost) (s ^. zebraPort)
|
||||||
_ <-
|
_ <-
|
||||||
liftIO $
|
liftIO $
|
||||||
forkIO $
|
forkIO $
|
||||||
|
|
@ -1212,7 +1215,7 @@ appEvent (BT.VtyEvent e) = do
|
||||||
(s ^. zebraPort)
|
(s ^. zebraPort)
|
||||||
(s ^. network)
|
(s ^. network)
|
||||||
(entityKey selAcc)
|
(entityKey selAcc)
|
||||||
bl
|
(bl + 5)
|
||||||
(fs1 ^. sendAmt)
|
(fs1 ^. sendAmt)
|
||||||
(fs1 ^. sendTo)
|
(fs1 ^. sendTo)
|
||||||
(fs1 ^. sendMemo)
|
(fs1 ^. sendMemo)
|
||||||
|
|
@ -1292,7 +1295,8 @@ appEvent (BT.VtyEvent e) = do
|
||||||
getUA . walletAddressUAddress)
|
getUA . walletAddressUAddress)
|
||||||
(entityVal selAddr)))
|
(entityVal selAddr)))
|
||||||
bl <-
|
bl <-
|
||||||
liftIO $ getLastSyncBlock pool $ entityKey selWal
|
liftIO $
|
||||||
|
getChainTip (s ^. zebraHost) (s ^. zebraPort)
|
||||||
case tAddrMaybe of
|
case tAddrMaybe of
|
||||||
Nothing -> do
|
Nothing -> do
|
||||||
BT.modify $
|
BT.modify $
|
||||||
|
|
@ -1994,7 +1998,7 @@ sendTransaction ::
|
||||||
-> ZcashNet
|
-> ZcashNet
|
||||||
-> ZcashAccountId
|
-> ZcashAccountId
|
||||||
-> Int
|
-> Int
|
||||||
-> Float
|
-> Scientific
|
||||||
-> T.Text
|
-> T.Text
|
||||||
-> T.Text
|
-> T.Text
|
||||||
-> PrivacyPolicy
|
-> 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"
|
Nothing -> BC.writeBChan chan $ TickMsg "Incorrect address"
|
||||||
Just outUA -> do
|
Just outUA -> do
|
||||||
res <-
|
res <-
|
||||||
runNoLoggingT $
|
runStderrLoggingT $
|
||||||
prepareTxV2
|
prepareTxV2
|
||||||
pool
|
pool
|
||||||
zHost
|
zHost
|
||||||
|
|
@ -2021,10 +2025,10 @@ sendTransaction pool chan zHost zPort znet accId bl amt ua memo policy = do
|
||||||
else Just memo)
|
else Just memo)
|
||||||
]
|
]
|
||||||
policy
|
policy
|
||||||
BC.writeBChan chan $ TickMsg "Transaction ready, sending to Zebra..."
|
|
||||||
case res of
|
case res of
|
||||||
Left e -> BC.writeBChan chan $ TickMsg $ show e
|
Left e -> BC.writeBChan chan $ TickMsg $ show e
|
||||||
Right rawTx -> do
|
Right rawTx -> do
|
||||||
|
BC.writeBChan chan $ TickMsg "Transaction ready, sending to Zebra..."
|
||||||
resp <-
|
resp <-
|
||||||
makeZebraCall
|
makeZebraCall
|
||||||
zHost
|
zHost
|
||||||
|
|
@ -2073,7 +2077,7 @@ deshieldTransaction ::
|
||||||
-> IO ()
|
-> IO ()
|
||||||
deshieldTransaction pool chan zHost zPort znet accId bl pnote = do
|
deshieldTransaction pool chan zHost zPort znet accId bl pnote = do
|
||||||
BC.writeBChan chan $ TickMsg "Deshielding funds..."
|
BC.writeBChan chan $ TickMsg "Deshielding funds..."
|
||||||
res <- runNoLoggingT $ deshieldNotes pool zHost zPort znet accId bl pnote
|
res <- runStderrLoggingT $ deshieldNotes pool zHost zPort znet accId bl pnote
|
||||||
case res of
|
case res of
|
||||||
Left e -> BC.writeBChan chan $ TickMsg $ show e
|
Left e -> BC.writeBChan chan $ TickMsg $ show e
|
||||||
Right rawTx -> do
|
Right rawTx -> do
|
||||||
|
|
|
||||||
File diff suppressed because it is too large
Load diff
|
|
@ -698,22 +698,42 @@ 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 :: ConnectionPool -> Int -> IO (Maybe (Entity ZcashBlock))
|
getBlock ::
|
||||||
getBlock pool b =
|
ConnectionPool -> Int -> ZcashNetDB -> IO (Maybe (Entity ZcashBlock))
|
||||||
|
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_ $ bl ^. ZcashBlockHeight ==. val b
|
where_ $
|
||||||
|
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
|
||||||
|
|
@ -1776,12 +1796,16 @@ getUnspentSapNotes pool = do
|
||||||
where_ (n ^. WalletSapNoteSpent ==. val False)
|
where_ (n ^. WalletSapNoteSpent ==. val False)
|
||||||
pure n
|
pure n
|
||||||
|
|
||||||
getSaplingCmus :: Pool SqlBackend -> ShieldOutputId -> IO [Value HexStringDB]
|
getSaplingCmus ::
|
||||||
getSaplingCmus pool zt = do
|
ConnectionPool
|
||||||
|
-> ShieldOutputId
|
||||||
|
-> ShieldOutputId
|
||||||
|
-> IO [Value HexStringDB]
|
||||||
|
getSaplingCmus pool zt m = do
|
||||||
PS.runSqlPool
|
PS.runSqlPool
|
||||||
(select $ do
|
(select $ do
|
||||||
n <- from $ table @ShieldOutput
|
n <- from $ table @ShieldOutput
|
||||||
where_ (n ^. ShieldOutputId >. val zt)
|
where_ (n ^. ShieldOutputId >. val zt &&. n ^. ShieldOutputId <=. val m)
|
||||||
orderBy [asc $ n ^. ShieldOutputId]
|
orderBy [asc $ n ^. ShieldOutputId]
|
||||||
pure $ n ^. ShieldOutputCmu)
|
pure $ n ^. ShieldOutputCmu)
|
||||||
pool
|
pool
|
||||||
|
|
@ -1840,12 +1864,13 @@ getUnspentOrchNotes pool = do
|
||||||
where_ (n ^. WalletOrchNoteSpent ==. val False)
|
where_ (n ^. WalletOrchNoteSpent ==. val False)
|
||||||
pure n
|
pure n
|
||||||
|
|
||||||
getOrchardCmxs :: Pool SqlBackend -> OrchActionId -> IO [Value HexStringDB]
|
getOrchardCmxs ::
|
||||||
getOrchardCmxs pool zt = do
|
ConnectionPool -> OrchActionId -> OrchActionId -> IO [Value HexStringDB]
|
||||||
|
getOrchardCmxs pool zt m = do
|
||||||
PS.runSqlPool
|
PS.runSqlPool
|
||||||
(select $ do
|
(select $ do
|
||||||
n <- from $ table @OrchAction
|
n <- from $ table @OrchAction
|
||||||
where_ (n ^. OrchActionId >. val zt)
|
where_ (n ^. OrchActionId >. val zt &&. n ^. OrchActionId <=. val m)
|
||||||
orderBy [asc $ n ^. OrchActionId]
|
orderBy [asc $ n ^. OrchActionId]
|
||||||
pure $ n ^. OrchActionCmx)
|
pure $ n ^. OrchActionCmx)
|
||||||
pool
|
pool
|
||||||
|
|
@ -2339,7 +2364,7 @@ selectUnspentNotes pool za amt = do
|
||||||
selectUnspentNotesV2 ::
|
selectUnspentNotesV2 ::
|
||||||
ConnectionPool
|
ConnectionPool
|
||||||
-> ZcashAccountId
|
-> ZcashAccountId
|
||||||
-> Integer
|
-> Int64
|
||||||
-> [Int]
|
-> [Int]
|
||||||
-> PrivacyPolicy
|
-> PrivacyPolicy
|
||||||
-> IO
|
-> IO
|
||||||
|
|
@ -2643,8 +2668,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 -> LoggingT IO ()
|
rewindWalletData :: ConnectionPool -> Int -> ZcashNetDB -> LoggingT IO ()
|
||||||
rewindWalletData pool b = do
|
rewindWalletData pool b net = do
|
||||||
logDebugN "Starting transaction rewind"
|
logDebugN "Starting transaction rewind"
|
||||||
liftIO $ clearWalletTransactions pool
|
liftIO $ clearWalletTransactions pool
|
||||||
logDebugN "Completed transaction rewind"
|
logDebugN "Completed transaction rewind"
|
||||||
|
|
@ -2656,7 +2681,9 @@ rewindWalletData pool b = do
|
||||||
oldBlocks <-
|
oldBlocks <-
|
||||||
select $ do
|
select $ do
|
||||||
blk <- from $ table @ZcashBlock
|
blk <- from $ table @ZcashBlock
|
||||||
where_ $ blk ^. ZcashBlockHeight >. val b
|
where_
|
||||||
|
(blk ^. ZcashBlockHeight >. val b &&. blk ^. ZcashBlockNetwork ==.
|
||||||
|
val net)
|
||||||
pure blk
|
pure blk
|
||||||
let oldBlkKeys = map entityKey oldBlocks
|
let oldBlkKeys = map entityKey oldBlocks
|
||||||
oldTxs <-
|
oldTxs <-
|
||||||
|
|
@ -2676,7 +2703,9 @@ rewindWalletData pool b = do
|
||||||
oldBlocks <-
|
oldBlocks <-
|
||||||
select $ do
|
select $ do
|
||||||
blk <- from $ table @ZcashBlock
|
blk <- from $ table @ZcashBlock
|
||||||
where_ $ blk ^. ZcashBlockHeight >. val b
|
where_
|
||||||
|
(blk ^. ZcashBlockHeight >. val b &&. blk ^. ZcashBlockNetwork ==.
|
||||||
|
val net)
|
||||||
pure blk
|
pure blk
|
||||||
let oldBlkKeys = map entityKey oldBlocks
|
let oldBlkKeys = map entityKey oldBlocks
|
||||||
oldTxs <-
|
oldTxs <-
|
||||||
|
|
@ -2696,7 +2725,9 @@ rewindWalletData pool b = do
|
||||||
oldBlocks <-
|
oldBlocks <-
|
||||||
select $ do
|
select $ do
|
||||||
blk <- from $ table @ZcashBlock
|
blk <- from $ table @ZcashBlock
|
||||||
where_ $ blk ^. ZcashBlockHeight >. val b
|
where_
|
||||||
|
(blk ^. ZcashBlockHeight >. val b &&. blk ^. ZcashBlockNetwork ==.
|
||||||
|
val net)
|
||||||
pure blk
|
pure blk
|
||||||
let oldBlkKeys = map entityKey oldBlocks
|
let oldBlkKeys = map entityKey oldBlocks
|
||||||
oldTxs <-
|
oldTxs <-
|
||||||
|
|
@ -2716,7 +2747,9 @@ rewindWalletData pool b = do
|
||||||
oldBlocks <-
|
oldBlocks <-
|
||||||
select $ do
|
select $ do
|
||||||
blk <- from $ table @ZcashBlock
|
blk <- from $ table @ZcashBlock
|
||||||
where_ $ blk ^. ZcashBlockHeight >. val b
|
where_
|
||||||
|
(blk ^. ZcashBlockHeight >. val b &&. blk ^. ZcashBlockNetwork ==.
|
||||||
|
val net)
|
||||||
pure blk
|
pure blk
|
||||||
let oldBlkKeys = map entityKey oldBlocks
|
let oldBlkKeys = map entityKey oldBlocks
|
||||||
oldTxs <-
|
oldTxs <-
|
||||||
|
|
@ -2736,7 +2769,9 @@ rewindWalletData pool b = do
|
||||||
oldBlocks <-
|
oldBlocks <-
|
||||||
select $ do
|
select $ do
|
||||||
blk <- from $ table @ZcashBlock
|
blk <- from $ table @ZcashBlock
|
||||||
where_ $ blk ^. ZcashBlockHeight >. val b
|
where_
|
||||||
|
(blk ^. ZcashBlockHeight >. val b &&. blk ^. ZcashBlockNetwork ==.
|
||||||
|
val net)
|
||||||
pure blk
|
pure blk
|
||||||
let oldBlkKeys = map entityKey oldBlocks
|
let oldBlkKeys = map entityKey oldBlocks
|
||||||
oldTxs <-
|
oldTxs <-
|
||||||
|
|
@ -2756,7 +2791,9 @@ rewindWalletData pool b = do
|
||||||
oldBlocks <-
|
oldBlocks <-
|
||||||
select $ do
|
select $ do
|
||||||
blk <- from $ table @ZcashBlock
|
blk <- from $ table @ZcashBlock
|
||||||
where_ $ blk ^. ZcashBlockHeight >. val b
|
where_
|
||||||
|
(blk ^. ZcashBlockHeight >. val b &&. blk ^. ZcashBlockNetwork ==.
|
||||||
|
val net)
|
||||||
pure blk
|
pure blk
|
||||||
let oldBlkKeys = map entityKey oldBlocks
|
let oldBlkKeys = map entityKey oldBlocks
|
||||||
oldTxs <-
|
oldTxs <-
|
||||||
|
|
@ -2775,5 +2812,7 @@ rewindWalletData pool b = do
|
||||||
flip PS.runSqlPool pool $ do
|
flip PS.runSqlPool pool $ do
|
||||||
delete $ do
|
delete $ do
|
||||||
blk <- from $ table @ZcashBlock
|
blk <- from $ table @ZcashBlock
|
||||||
where_ $ blk ^. ZcashBlockHeight >. val b
|
where_
|
||||||
|
(blk ^. ZcashBlockHeight >. val b &&. blk ^. ZcashBlockNetwork ==.
|
||||||
|
val net)
|
||||||
logDebugN "Completed data store rewind"
|
logDebugN "Completed data store rewind"
|
||||||
|
|
|
||||||
|
|
@ -17,6 +17,7 @@ import Data.Aeson
|
||||||
import qualified Data.ByteString as BS
|
import qualified Data.ByteString as BS
|
||||||
import Data.HexString (toText)
|
import Data.HexString (toText)
|
||||||
import Data.Maybe (fromMaybe, isJust, isNothing)
|
import Data.Maybe (fromMaybe, isJust, isNothing)
|
||||||
|
import Data.Scientific (Scientific, fromFloatDigits)
|
||||||
import qualified Data.Text as T
|
import qualified Data.Text as T
|
||||||
import qualified Data.Text.Encoding as E
|
import qualified Data.Text.Encoding as E
|
||||||
import Data.Time.Clock.POSIX (posixSecondsToUTCTime)
|
import Data.Time.Clock.POSIX (posixSecondsToUTCTime)
|
||||||
|
|
@ -1244,7 +1245,7 @@ handleEvent wenv node model evt =
|
||||||
(model ^. network)
|
(model ^. network)
|
||||||
(entityKey acc)
|
(entityKey acc)
|
||||||
(zcashWalletLastSync $ entityVal wal)
|
(zcashWalletLastSync $ entityVal wal)
|
||||||
(model ^. sendAmount)
|
(fromFloatDigits $ model ^. sendAmount)
|
||||||
(model ^. sendRecipient)
|
(model ^. sendRecipient)
|
||||||
(model ^. sendMemo)
|
(model ^. sendMemo)
|
||||||
(model ^. privacyChoice)
|
(model ^. privacyChoice)
|
||||||
|
|
@ -1626,17 +1627,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 dbBlock 1
|
chkBlock <- checkIntegrity dbPath zHost zPort net 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
|
||||||
|
|
@ -1701,7 +1702,7 @@ sendTransaction ::
|
||||||
-> ZcashNet
|
-> ZcashNet
|
||||||
-> ZcashAccountId
|
-> ZcashAccountId
|
||||||
-> Int
|
-> Int
|
||||||
-> Float
|
-> Scientific
|
||||||
-> T.Text
|
-> T.Text
|
||||||
-> T.Text
|
-> T.Text
|
||||||
-> PrivacyPolicy
|
-> PrivacyPolicy
|
||||||
|
|
@ -1717,7 +1718,7 @@ sendTransaction config znet accId bl amt ua memo policy sendMsg = do
|
||||||
let zPort = c_zebraPort config
|
let zPort = c_zebraPort config
|
||||||
pool <- runNoLoggingT $ initPool dbPath
|
pool <- runNoLoggingT $ initPool dbPath
|
||||||
res <-
|
res <-
|
||||||
runNoLoggingT $
|
runStderrLoggingT $
|
||||||
prepareTxV2
|
prepareTxV2
|
||||||
pool
|
pool
|
||||||
zHost
|
zHost
|
||||||
|
|
|
||||||
|
|
@ -833,7 +833,7 @@ zenithServer state = getinfo :<|> handleRPC
|
||||||
forkIO $ do
|
forkIO $ do
|
||||||
res <-
|
res <-
|
||||||
liftIO $
|
liftIO $
|
||||||
runNoLoggingT $
|
runStderrLoggingT $
|
||||||
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 dbBlock 1
|
chkBlock <- checkIntegrity dbPath zHost zPort net 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
|
||||||
|
|
|
||||||
|
|
@ -246,10 +246,11 @@ 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 b d =
|
checkIntegrity dbP zHost zPort znet b d =
|
||||||
if b < 1
|
if b < 1
|
||||||
then return 1
|
then return 1
|
||||||
else do
|
else do
|
||||||
|
|
@ -263,10 +264,10 @@ checkIntegrity dbP zHost zPort 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
|
dbBlk <- getBlock pool b $ ZcashNetDB znet
|
||||||
case dbBlk of
|
case dbBlk of
|
||||||
Nothing -> throwIO $ userError "Block mismatch, rescan needed"
|
Nothing -> return 1
|
||||||
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 (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.HexString
|
||||||
import Data.Int (Int64)
|
import Data.Int (Int64)
|
||||||
import Data.Maybe (fromMaybe)
|
import Data.Maybe (fromMaybe)
|
||||||
|
import Data.Scientific (Scientific)
|
||||||
import qualified Data.Text as T
|
import qualified Data.Text as T
|
||||||
import qualified Data.Text.Encoding as E
|
import qualified Data.Text.Encoding as E
|
||||||
import Data.Text.Encoding.Error (lenientDecode)
|
import Data.Text.Encoding.Error (lenientDecode)
|
||||||
|
|
@ -241,7 +242,7 @@ instance ToJSON ValidAddressAPI where
|
||||||
|
|
||||||
data ProposedNote = ProposedNote
|
data ProposedNote = ProposedNote
|
||||||
{ pn_addr :: !ValidAddressAPI
|
{ pn_addr :: !ValidAddressAPI
|
||||||
, pn_amt :: !Float
|
, pn_amt :: !Scientific
|
||||||
, pn_memo :: !(Maybe T.Text)
|
, pn_memo :: !(Maybe T.Text)
|
||||||
} deriving (Eq, Prelude.Show)
|
} deriving (Eq, Prelude.Show)
|
||||||
|
|
||||||
|
|
|
||||||
|
|
@ -13,26 +13,31 @@ import qualified Data.Text.Encoding as E
|
||||||
import System.Directory
|
import System.Directory
|
||||||
import System.Process (createProcess_, shell)
|
import System.Process (createProcess_, shell)
|
||||||
import Text.Regex.Posix
|
import Text.Regex.Posix
|
||||||
import ZcashHaskell.Orchard (encodeUnifiedAddress, isValidUnifiedAddress, parseAddress)
|
import ZcashHaskell.Orchard
|
||||||
|
( encodeUnifiedAddress
|
||||||
|
, isValidUnifiedAddress
|
||||||
|
, parseAddress
|
||||||
|
)
|
||||||
import ZcashHaskell.Sapling (decodeSaplingAddress, isValidShieldedAddress)
|
import ZcashHaskell.Sapling (decodeSaplingAddress, isValidShieldedAddress)
|
||||||
import ZcashHaskell.Transparent
|
import ZcashHaskell.Transparent
|
||||||
( decodeExchangeAddress
|
( decodeExchangeAddress
|
||||||
, decodeTransparentAddress
|
, decodeTransparentAddress
|
||||||
)
|
)
|
||||||
import ZcashHaskell.Types
|
import ZcashHaskell.Types
|
||||||
( SaplingAddress(..)
|
( ExchangeAddress(..)
|
||||||
|
, SaplingAddress(..)
|
||||||
, TransparentAddress(..)
|
, TransparentAddress(..)
|
||||||
, UnifiedAddress(..)
|
, UnifiedAddress(..)
|
||||||
, ZcashNet(..)
|
|
||||||
, ValidAddress(..)
|
, ValidAddress(..)
|
||||||
, ExchangeAddress(..)
|
, ZcashNet(..)
|
||||||
)
|
)
|
||||||
|
import ZcashHaskell.Utils (makeZebraCall)
|
||||||
import Zenith.Types
|
import Zenith.Types
|
||||||
( AddressGroup(..)
|
( AddressGroup(..)
|
||||||
|
, PrivacyPolicy(..)
|
||||||
, UnifiedAddressDB(..)
|
, UnifiedAddressDB(..)
|
||||||
, ZcashAddress(..)
|
, ZcashAddress(..)
|
||||||
, ZcashPool(..)
|
, ZcashPool(..)
|
||||||
, PrivacyPolicy(..)
|
|
||||||
)
|
)
|
||||||
|
|
||||||
-- | Helper function to convert numbers into JSON
|
-- | Helper function to convert numbers into JSON
|
||||||
|
|
@ -127,9 +132,9 @@ isRecipientValid a = do
|
||||||
|
|
||||||
isUnifiedAddressValid :: T.Text -> Bool
|
isUnifiedAddressValid :: T.Text -> Bool
|
||||||
isUnifiedAddressValid ua =
|
isUnifiedAddressValid ua =
|
||||||
case isValidUnifiedAddress (E.encodeUtf8 ua) of
|
case isValidUnifiedAddress (E.encodeUtf8 ua) of
|
||||||
Just _a1 -> True
|
Just _a1 -> True
|
||||||
Nothing -> False
|
Nothing -> False
|
||||||
|
|
||||||
isSaplingAddressValid :: T.Text -> Bool
|
isSaplingAddressValid :: T.Text -> Bool
|
||||||
isSaplingAddressValid sa = isValidShieldedAddress (E.encodeUtf8 sa)
|
isSaplingAddressValid sa = isValidShieldedAddress (E.encodeUtf8 sa)
|
||||||
|
|
@ -137,8 +142,8 @@ isSaplingAddressValid sa = isValidShieldedAddress (E.encodeUtf8 sa)
|
||||||
isTransparentAddressValid :: T.Text -> Bool
|
isTransparentAddressValid :: T.Text -> Bool
|
||||||
isTransparentAddressValid ta =
|
isTransparentAddressValid ta =
|
||||||
case decodeTransparentAddress (E.encodeUtf8 ta) of
|
case decodeTransparentAddress (E.encodeUtf8 ta) of
|
||||||
Just _a3 -> True
|
Just _a3 -> True
|
||||||
Nothing -> False
|
Nothing -> False
|
||||||
|
|
||||||
isExchangeAddressValid :: T.Text -> Bool
|
isExchangeAddressValid :: T.Text -> Bool
|
||||||
isExchangeAddressValid xa =
|
isExchangeAddressValid xa =
|
||||||
|
|
@ -147,40 +152,44 @@ isExchangeAddressValid xa =
|
||||||
Nothing -> False
|
Nothing -> False
|
||||||
|
|
||||||
isRecipientValidGUI :: PrivacyPolicy -> T.Text -> Bool
|
isRecipientValidGUI :: PrivacyPolicy -> T.Text -> Bool
|
||||||
isRecipientValidGUI p a = do
|
isRecipientValidGUI p a = do
|
||||||
let adr = parseAddress (E.encodeUtf8 a)
|
let adr = parseAddress (E.encodeUtf8 a)
|
||||||
case p of
|
case p of
|
||||||
Full -> case adr of
|
Full ->
|
||||||
Just a ->
|
case adr of
|
||||||
case a of
|
Just a ->
|
||||||
Unified ua -> True
|
case a of
|
||||||
Sapling sa -> True
|
Unified ua -> True
|
||||||
_ -> False
|
Sapling sa -> True
|
||||||
Nothing -> False
|
_ -> False
|
||||||
Medium -> case adr of
|
Nothing -> False
|
||||||
Just a ->
|
Medium ->
|
||||||
case a of
|
case adr of
|
||||||
Unified ua -> True
|
Just a ->
|
||||||
Sapling sa -> True
|
case a of
|
||||||
_ -> False
|
Unified ua -> True
|
||||||
Nothing -> False
|
Sapling sa -> True
|
||||||
Low -> case adr of
|
_ -> False
|
||||||
Just a ->
|
Nothing -> False
|
||||||
case a of
|
Low ->
|
||||||
Unified ua -> True
|
case adr of
|
||||||
Sapling sa -> True
|
Just a ->
|
||||||
Transparent ta -> True
|
case a of
|
||||||
_ -> False
|
Unified ua -> True
|
||||||
Nothing -> False
|
Sapling sa -> True
|
||||||
None -> case adr of
|
Transparent ta -> True
|
||||||
Just a ->
|
_ -> False
|
||||||
case a of
|
Nothing -> False
|
||||||
Transparent ta -> True
|
None ->
|
||||||
Exchange ea -> True
|
case adr of
|
||||||
_ -> False
|
Just a ->
|
||||||
Nothing -> False
|
case a of
|
||||||
|
Transparent ta -> True
|
||||||
|
Exchange ea -> True
|
||||||
|
_ -> False
|
||||||
|
Nothing -> False
|
||||||
|
|
||||||
isZecAddressValid :: T.Text -> Bool
|
isZecAddressValid :: T.Text -> Bool
|
||||||
isZecAddressValid a = do
|
isZecAddressValid a = do
|
||||||
case isValidUnifiedAddress (E.encodeUtf8 a) of
|
case isValidUnifiedAddress (E.encodeUtf8 a) of
|
||||||
Just _a1 -> True
|
Just _a1 -> True
|
||||||
|
|
@ -232,3 +241,10 @@ padWithZero n s
|
||||||
isEmpty :: [a] -> Bool
|
isEmpty :: [a] -> Bool
|
||||||
isEmpty [] = True
|
isEmpty [] = True
|
||||||
isEmpty _ = False
|
isEmpty _ = False
|
||||||
|
|
||||||
|
getChainTip :: T.Text -> Int -> IO Int
|
||||||
|
getChainTip zHost zPort = do
|
||||||
|
r <- makeZebraCall zHost zPort "getblockcount" []
|
||||||
|
case r of
|
||||||
|
Left e1 -> pure 0
|
||||||
|
Right i -> pure i
|
||||||
|
|
|
||||||
764
test/Spec.hs
764
test/Spec.hs
|
|
@ -2,6 +2,7 @@
|
||||||
|
|
||||||
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
|
||||||
|
|
@ -33,8 +34,10 @@ 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
|
||||||
|
|
@ -182,6 +185,12 @@ main = do
|
||||||
a `shouldBe`
|
a `shouldBe`
|
||||||
Just
|
Just
|
||||||
"ztestsapling1tgjr4zppwk4ne8xy6gdq4z2gwq7dmf5jq8z2ctpn8nlmtse0a74fa5z0m8z383gmpgqz6q6duu4"
|
"ztestsapling1tgjr4zppwk4ne8xy6gdq4z2gwq7dmf5jq8z2ctpn8nlmtse0a74fa5z0m8z383gmpgqz6q6duu4"
|
||||||
|
describe "Witnesses" $ do
|
||||||
|
describe "Sapling" $ do
|
||||||
|
it "max output id" $ do
|
||||||
|
pool <- runNoLoggingT $ initPool "/home/rav/Zenith/zenith.db"
|
||||||
|
sId <- getMaxSaplingNote pool
|
||||||
|
sId `shouldBe` toSqlKey 0
|
||||||
describe "Notes" $ do
|
describe "Notes" $ do
|
||||||
xit "Check Orchard notes" $ do
|
xit "Check Orchard notes" $ do
|
||||||
pool <- runNoLoggingT $ initPool "/home/rav/Zenith/zenith.db"
|
pool <- runNoLoggingT $ initPool "/home/rav/Zenith/zenith.db"
|
||||||
|
|
@ -195,381 +204,380 @@ 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 `shouldBe` (hexString "deadbeef")
|
Right h -> h `shouldNotBe` 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
|
Left (PrivacyPolicyError "Receiver not capable of Full privacy")
|
||||||
(PrivacyPolicyError "Receiver not capable of Full privacy")
|
it "To mixed shielded receivers" $ do
|
||||||
it "To mixed shielded receivers" $ do
|
let uaRead =
|
||||||
let uaRead =
|
parseAddress
|
||||||
parseAddress
|
"utest1dl54utt6prjj5e0dnlknwumnxq9hycdjpkfr0sy6e6h522remqee8axe9zax0wsjrwpj76v555pdhvj9rnargpfyycs0vpkapq98xcdhem99gc4wchzn0ggepq3y6nz3a9sscwgqxgsh9vzhcad402y3x9szfregck5gslkya3c79d86xx0l33tpk8gnn7ew9vw37w43zh22u8dgdax"
|
||||||
"utest1dl54utt6prjj5e0dnlknwumnxq9hycdjpkfr0sy6e6h522remqee8axe9zax0wsjrwpj76v555pdhvj9rnargpfyycs0vpkapq98xcdhem99gc4wchzn0ggepq3y6nz3a9sscwgqxgsh9vzhcad402y3x9szfregck5gslkya3c79d86xx0l33tpk8gnn7ew9vw37w43zh22u8dgdax"
|
let uaRead2 =
|
||||||
let uaRead2 =
|
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 1)
|
||||||
(toSqlKey 1)
|
3001331
|
||||||
3001331
|
[ ProposedNote
|
||||||
[ ProposedNote
|
(ValidAddressAPI $ fromJust uaRead)
|
||||||
(ValidAddressAPI $ fromJust uaRead)
|
0.005
|
||||||
0.005
|
(Just "Sending memo to orchard")
|
||||||
(Just "Sending memo to orchard")
|
, ProposedNote
|
||||||
, ProposedNote
|
(ValidAddressAPI $ fromJust uaRead2)
|
||||||
(ValidAddressAPI $ fromJust uaRead2)
|
0.004
|
||||||
0.004
|
Nothing
|
||||||
Nothing
|
]
|
||||||
]
|
Full
|
||||||
Full
|
tx `shouldBe`
|
||||||
tx `shouldBe`
|
Left
|
||||||
Left
|
(PrivacyPolicyError
|
||||||
(PrivacyPolicyError
|
"Combination of receivers not allowed for Full privacy")
|
||||||
"Combination of receivers not allowed for Full privacy")
|
describe "Medium" $ do
|
||||||
describe "Medium" $ 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 1)
|
||||||
(toSqlKey 1)
|
3001372
|
||||||
3001372
|
[ ProposedNote
|
||||||
[ ProposedNote
|
(ValidAddressAPI $ fromJust uaRead)
|
||||||
(ValidAddressAPI $ fromJust uaRead)
|
0.005
|
||||||
0.005
|
(Just "Sending memo to orchard")
|
||||||
(Just "Sending memo to orchard")
|
]
|
||||||
]
|
Medium
|
||||||
Medium
|
case tx of
|
||||||
case tx of
|
Left e -> assertFailure $ show e
|
||||||
Left e -> assertFailure $ show e
|
Right h -> h `shouldNotBe` hexString "deadbeef"
|
||||||
Right h -> h `shouldNotBe` (hexString "deadbeef")
|
it "To Sapling" $ do
|
||||||
it "To Sapling" $ do
|
let uaRead =
|
||||||
let uaRead =
|
parseAddress
|
||||||
parseAddress
|
"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 1)
|
||||||
(toSqlKey 1)
|
3001372
|
||||||
3001372
|
[ ProposedNote
|
||||||
[ ProposedNote
|
(ValidAddressAPI $ fromJust uaRead)
|
||||||
(ValidAddressAPI $ fromJust uaRead)
|
0.005
|
||||||
0.005
|
(Just "Sending memo to sapling")
|
||||||
(Just "Sending memo to sapling")
|
]
|
||||||
]
|
Medium
|
||||||
Medium
|
case tx of
|
||||||
case tx of
|
Left e -> assertFailure $ show e
|
||||||
Left e -> assertFailure $ show e
|
Right h -> h `shouldNotBe` (hexString "00")
|
||||||
Right h -> h `shouldNotBe` (hexString "deadbeef")
|
it "To Transparent" $ do
|
||||||
it "To Transparent" $ do
|
let uaRead = parseAddress "tmAmSa4AauSFuJieeanRBjkfnah45ysGtgZ"
|
||||||
let uaRead = parseAddress "tmAmSa4AauSFuJieeanRBjkfnah45ysGtgZ"
|
case uaRead of
|
||||||
case uaRead of
|
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
|
]
|
||||||
]
|
Medium
|
||||||
Medium
|
tx `shouldBe`
|
||||||
tx `shouldBe`
|
Left
|
||||||
Left
|
(PrivacyPolicyError "Receiver not capable of Medium privacy")
|
||||||
(PrivacyPolicyError "Receiver not capable of Medium privacy")
|
it "To mixed shielded receivers" $ do
|
||||||
it "To mixed shielded receivers" $ do
|
let uaRead =
|
||||||
let uaRead =
|
parseAddress
|
||||||
parseAddress
|
"utest1dl54utt6prjj5e0dnlknwumnxq9hycdjpkfr0sy6e6h522remqee8axe9zax0wsjrwpj76v555pdhvj9rnargpfyycs0vpkapq98xcdhem99gc4wchzn0ggepq3y6nz3a9sscwgqxgsh9vzhcad402y3x9szfregck5gslkya3c79d86xx0l33tpk8gnn7ew9vw37w43zh22u8dgdax"
|
||||||
"utest1dl54utt6prjj5e0dnlknwumnxq9hycdjpkfr0sy6e6h522remqee8axe9zax0wsjrwpj76v555pdhvj9rnargpfyycs0vpkapq98xcdhem99gc4wchzn0ggepq3y6nz3a9sscwgqxgsh9vzhcad402y3x9szfregck5gslkya3c79d86xx0l33tpk8gnn7ew9vw37w43zh22u8dgdax"
|
let uaRead2 =
|
||||||
let uaRead2 =
|
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 1)
|
||||||
(toSqlKey 1)
|
3001331
|
||||||
3001331
|
[ ProposedNote
|
||||||
[ ProposedNote
|
(ValidAddressAPI $ fromJust uaRead)
|
||||||
(ValidAddressAPI $ fromJust uaRead)
|
0.005
|
||||||
0.005
|
(Just "Sending memo to orchard")
|
||||||
(Just "Sending memo to orchard")
|
, ProposedNote
|
||||||
, ProposedNote
|
(ValidAddressAPI $ fromJust uaRead2)
|
||||||
(ValidAddressAPI $ fromJust uaRead2)
|
0.004
|
||||||
0.004
|
Nothing
|
||||||
Nothing
|
]
|
||||||
]
|
Medium
|
||||||
Medium
|
case tx of
|
||||||
case tx of
|
Left e -> assertFailure $ show e
|
||||||
Left e -> assertFailure $ show e
|
Right h -> h `shouldNotBe` (hexString "deadbeef")
|
||||||
Right h -> h `shouldNotBe` (hexString "deadbeef")
|
describe "Low" $ do
|
||||||
describe "Low" $ 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 1)
|
||||||
(toSqlKey 1)
|
3001372
|
||||||
3001372
|
[ ProposedNote
|
||||||
[ ProposedNote
|
(ValidAddressAPI $ fromJust uaRead)
|
||||||
(ValidAddressAPI $ fromJust uaRead)
|
0.005
|
||||||
0.005
|
Nothing
|
||||||
Nothing
|
]
|
||||||
]
|
Low
|
||||||
Low
|
case tx of
|
||||||
case tx of
|
Left e -> assertFailure $ show e
|
||||||
Left e -> assertFailure $ show e
|
Right h -> h `shouldNotBe` (hexString "deadbeef")
|
||||||
Right h -> h `shouldNotBe` (hexString "deadbeef")
|
it "To Sapling" $ do
|
||||||
it "To Sapling" $ do
|
let uaRead =
|
||||||
let uaRead =
|
parseAddress
|
||||||
parseAddress
|
"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 1)
|
||||||
(toSqlKey 1)
|
3001372
|
||||||
3001372
|
[ ProposedNote
|
||||||
[ ProposedNote
|
(ValidAddressAPI $ fromJust uaRead)
|
||||||
(ValidAddressAPI $ fromJust uaRead)
|
0.005
|
||||||
0.005
|
Nothing
|
||||||
Nothing
|
]
|
||||||
]
|
Low
|
||||||
Low
|
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 1)
|
||||||
(toSqlKey 1)
|
3001372
|
||||||
3001372
|
[ ProposedNote
|
||||||
[ ProposedNote
|
(ValidAddressAPI $ fromJust uaRead)
|
||||||
(ValidAddressAPI $ fromJust uaRead)
|
0.005
|
||||||
0.005
|
Nothing
|
||||||
Nothing
|
]
|
||||||
]
|
Low
|
||||||
Low
|
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")
|
describe "None" $ do
|
||||||
describe "None" $ 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 1)
|
||||||
(toSqlKey 1)
|
3001372
|
||||||
3001372
|
[ ProposedNote
|
||||||
[ ProposedNote
|
(ValidAddressAPI $ fromJust uaRead)
|
||||||
(ValidAddressAPI $ fromJust uaRead)
|
0.005
|
||||||
0.005
|
Nothing
|
||||||
Nothing
|
]
|
||||||
]
|
None
|
||||||
None
|
tx `shouldBe`
|
||||||
tx `shouldBe`
|
Left
|
||||||
Left
|
(PrivacyPolicyError
|
||||||
(PrivacyPolicyError
|
"Shielded recipients not compatible with privacy policy.")
|
||||||
"Shielded recipients not compatible with privacy policy.")
|
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 1)
|
||||||
(toSqlKey 1)
|
3001372
|
||||||
3001372
|
[ ProposedNote
|
||||||
[ ProposedNote
|
(ValidAddressAPI $ fromJust uaRead)
|
||||||
(ValidAddressAPI $ fromJust uaRead)
|
0.005
|
||||||
0.005
|
Nothing
|
||||||
Nothing
|
]
|
||||||
]
|
None
|
||||||
None
|
tx `shouldBe`
|
||||||
tx `shouldBe`
|
Left
|
||||||
Left
|
(PrivacyPolicyError
|
||||||
(PrivacyPolicyError
|
"Shielded recipients not compatible with privacy policy.")
|
||||||
"Shielded recipients not compatible with privacy policy.")
|
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 1)
|
||||||
(toSqlKey 1)
|
3001372
|
||||||
3001372
|
[ ProposedNote
|
||||||
[ ProposedNote
|
(ValidAddressAPI $ fromJust uaRead)
|
||||||
(ValidAddressAPI $ fromJust uaRead)
|
0.005
|
||||||
0.005
|
Nothing
|
||||||
Nothing
|
]
|
||||||
]
|
None
|
||||||
None
|
case tx of
|
||||||
case tx of
|
Left e -> assertFailure $ show e
|
||||||
Left e -> assertFailure $ show e
|
Right h -> h `shouldNotBe` hexString "deadbeef"
|
||||||
Right h -> h `shouldNotBe` (hexString "deadbeef")
|
|
||||||
|
|
|
||||||
|
|
@ -1 +1 @@
|
||||||
Subproject commit 662a0d1148d3f52e2683157a4c9280bb8e81b0cb
|
Subproject commit 6d4b6840d30fe1631902acd0388bef0040fee9e8
|
||||||
|
|
@ -141,6 +141,7 @@ 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
|
||||||
|
|
|
||||||
Loading…
Reference in a new issue