Compare commits
3 commits
0d5161cdb2
...
b6b586f9bf
Author | SHA1 | Date | |
---|---|---|---|
b6b586f9bf | |||
adfaed6753 | |||
28c05a66fe |
8 changed files with 313 additions and 65 deletions
|
@ -20,6 +20,7 @@ and this project adheres to [Semantic Versioning](https://semver.org/spec/v2.0.0
|
||||||
- `getnewaccount` RPC method
|
- `getnewaccount` RPC method
|
||||||
- `getnewaddress` RPC method
|
- `getnewaddress` RPC method
|
||||||
- `getoperationstatus` RPC method
|
- `getoperationstatus` RPC method
|
||||||
|
- Function `prepareTxV2` implementing `PrivacyPolicy`
|
||||||
|
|
||||||
### Changed
|
### Changed
|
||||||
|
|
||||||
|
@ -27,6 +28,7 @@ and this project adheres to [Semantic Versioning](https://semver.org/spec/v2.0.0
|
||||||
- Block tracking for chain re-org detection
|
- Block tracking for chain re-org detection
|
||||||
- Refactored `ZcashPool`
|
- Refactored `ZcashPool`
|
||||||
|
|
||||||
|
|
||||||
## [0.6.0.0-beta]
|
## [0.6.0.0-beta]
|
||||||
|
|
||||||
### Added
|
### Added
|
||||||
|
|
|
@ -10,7 +10,7 @@ import qualified Brick.BChan as BC
|
||||||
import qualified Brick.Focus as F
|
import qualified Brick.Focus as F
|
||||||
import Brick.Forms
|
import Brick.Forms
|
||||||
( Form(..)
|
( Form(..)
|
||||||
, radioField
|
, (@@=)
|
||||||
, allFieldsValid
|
, allFieldsValid
|
||||||
, editShowableFieldWithValidate
|
, editShowableFieldWithValidate
|
||||||
, editTextField
|
, editTextField
|
||||||
|
@ -18,10 +18,10 @@ import Brick.Forms
|
||||||
, handleFormEvent
|
, handleFormEvent
|
||||||
, invalidFormInputAttr
|
, invalidFormInputAttr
|
||||||
, newForm
|
, newForm
|
||||||
|
, radioField
|
||||||
, renderForm
|
, renderForm
|
||||||
, setFieldValid
|
, setFieldValid
|
||||||
, updateFormState
|
, updateFormState
|
||||||
, (@@=)
|
|
||||||
)
|
)
|
||||||
import qualified Brick.Main as M
|
import qualified Brick.Main as M
|
||||||
import qualified Brick.Types as BT
|
import qualified Brick.Types as BT
|
||||||
|
@ -99,9 +99,9 @@ import Zenith.Types
|
||||||
( Config(..)
|
( Config(..)
|
||||||
, HexStringDB(..)
|
, HexStringDB(..)
|
||||||
, PhraseDB(..)
|
, PhraseDB(..)
|
||||||
|
, PrivacyPolicy(..)
|
||||||
, UnifiedAddressDB(..)
|
, UnifiedAddressDB(..)
|
||||||
, ZcashNetDB(..)
|
, ZcashNetDB(..)
|
||||||
, PrivacyPolicy(..)
|
|
||||||
)
|
)
|
||||||
import Zenith.Utils
|
import Zenith.Utils
|
||||||
( displayTaz
|
( displayTaz
|
||||||
|
@ -184,7 +184,8 @@ data Tick
|
||||||
| TickMsg !String
|
| TickMsg !String
|
||||||
| TickTx !HexString
|
| TickTx !HexString
|
||||||
|
|
||||||
data DropDownItem = DropdownItem String
|
data DropDownItem =
|
||||||
|
DropdownItem String
|
||||||
|
|
||||||
data State = State
|
data State = State
|
||||||
{ _network :: !ZcashNet
|
{ _network :: !ZcashNet
|
||||||
|
@ -619,7 +620,9 @@ mkSendForm :: Integer -> SendInput -> Form SendInput e Name
|
||||||
mkSendForm bal =
|
mkSendForm bal =
|
||||||
newForm
|
newForm
|
||||||
[ label "Privacy Level :" @@=
|
[ label "Privacy Level :" @@=
|
||||||
radioField policyField [ (Full, PrivacyFullField, "Full")
|
radioField
|
||||||
|
policyField
|
||||||
|
[ (Full, PrivacyFullField, "Full")
|
||||||
, (Medium, PrivacyMediumField, "Medium")
|
, (Medium, PrivacyMediumField, "Medium")
|
||||||
, (Low, PrivacyLowField, "Low")
|
, (Low, PrivacyLowField, "Low")
|
||||||
, (None, PrivacyNoneField, "None")
|
, (None, PrivacyNoneField, "None")
|
||||||
|
@ -752,7 +755,11 @@ scanZebra dbP zHost zPort b eChan znet = do
|
||||||
logDebugN $
|
logDebugN $
|
||||||
"dbBlock: " <>
|
"dbBlock: " <>
|
||||||
T.pack (show dbBlock) <> " chkBlock: " <> T.pack (show chkBlock)
|
T.pack (show dbBlock) <> " chkBlock: " <> T.pack (show chkBlock)
|
||||||
let sb = max dbBlock b
|
when (chkBlock /= dbBlock) $ liftIO $ rewindWalletData pool chkBlock
|
||||||
|
let sb =
|
||||||
|
if chkBlock == dbBlock
|
||||||
|
then max dbBlock b
|
||||||
|
else max chkBlock b
|
||||||
if sb > zgb_blocks bStatus || sb < 1
|
if sb > zgb_blocks bStatus || sb < 1
|
||||||
then do
|
then do
|
||||||
liftIO $ BC.writeBChan eChan $ TickMsg "Invalid starting block for scan"
|
liftIO $ BC.writeBChan eChan $ TickMsg "Invalid starting block for scan"
|
||||||
|
@ -1399,6 +1406,7 @@ runZenithTUI config = do
|
||||||
Left e1 -> throwIO e1
|
Left e1 -> throwIO e1
|
||||||
Right chainInfo -> do
|
Right chainInfo -> do
|
||||||
x <- initDb dbFilePath
|
x <- initDb dbFilePath
|
||||||
|
_ <- upgradeQrTable pool
|
||||||
case x of
|
case x of
|
||||||
Left e2 -> throwIO $ userError e2
|
Left e2 -> throwIO $ userError e2
|
||||||
Right x' -> do
|
Right x' -> do
|
||||||
|
|
|
@ -44,6 +44,7 @@ import ZcashHaskell.Orchard
|
||||||
, encodeUnifiedAddress
|
, encodeUnifiedAddress
|
||||||
, genOrchardReceiver
|
, genOrchardReceiver
|
||||||
, genOrchardSpendingKey
|
, genOrchardSpendingKey
|
||||||
|
, getOrchardFrontier
|
||||||
, getOrchardNotePosition
|
, getOrchardNotePosition
|
||||||
, getOrchardWitness
|
, getOrchardWitness
|
||||||
, isValidUnifiedAddress
|
, isValidUnifiedAddress
|
||||||
|
@ -372,13 +373,16 @@ findOrchardActions config b znet za = do
|
||||||
pool <- runNoLoggingT $ initPool dbPath
|
pool <- runNoLoggingT $ initPool dbPath
|
||||||
tList <- getOrchardActions pool b znet
|
tList <- getOrchardActions pool b znet
|
||||||
trees <- getCommitmentTrees zebraHost zebraPort (b - 1)
|
trees <- getCommitmentTrees zebraHost zebraPort (b - 1)
|
||||||
let sT = OrchardCommitmentTree $ ztiOrchard trees
|
let sT = getOrchardFrontier $ OrchardCommitmentTree $ ztiOrchard trees
|
||||||
decryptNotes sT zn pool tList
|
case sT of
|
||||||
|
Nothing -> throwIO $ userError "Failed to read Orchard commitment tree"
|
||||||
|
Just sT' -> do
|
||||||
|
decryptNotes sT' zn pool tList
|
||||||
orchNotes <- getWalletOrchNotes pool (entityKey za)
|
orchNotes <- getWalletOrchNotes pool (entityKey za)
|
||||||
findOrchSpends pool (entityKey za) orchNotes
|
findOrchSpends pool (entityKey za) orchNotes
|
||||||
where
|
where
|
||||||
decryptNotes ::
|
decryptNotes ::
|
||||||
OrchardCommitmentTree
|
OrchardFrontier
|
||||||
-> ZcashNet
|
-> ZcashNet
|
||||||
-> ConnectionPool
|
-> ConnectionPool
|
||||||
-> [(Entity ZcashTransaction, Entity OrchAction)]
|
-> [(Entity ZcashTransaction, Entity OrchAction)]
|
||||||
|
@ -901,7 +905,7 @@ prepareTxV2 pool zebraHost zebraPort zn za bh amt va memo policy = do
|
||||||
None ->
|
None ->
|
||||||
return $
|
return $
|
||||||
Left $
|
Left $
|
||||||
PrivacyPolicyError "Recipient not allowed by privacy policy"
|
PrivacyPolicyError "Receiver not compatible with privacy policy"
|
||||||
_anyOther -> do
|
_anyOther -> do
|
||||||
let chgRcvr =
|
let chgRcvr =
|
||||||
fromJust $
|
fromJust $
|
||||||
|
|
|
@ -19,7 +19,7 @@
|
||||||
module Zenith.DB where
|
module Zenith.DB where
|
||||||
|
|
||||||
import Control.Exception (SomeException(..), throw, throwIO, try)
|
import Control.Exception (SomeException(..), throw, throwIO, try)
|
||||||
import Control.Monad (when)
|
import Control.Monad (unless, when)
|
||||||
import Control.Monad.IO.Class (MonadIO, liftIO)
|
import Control.Monad.IO.Class (MonadIO, liftIO)
|
||||||
import Control.Monad.Logger (NoLoggingT, runNoLoggingT)
|
import Control.Monad.Logger (NoLoggingT, runNoLoggingT)
|
||||||
import qualified Data.ByteString as BS
|
import qualified Data.ByteString as BS
|
||||||
|
@ -448,8 +448,10 @@ initDb dbName = do
|
||||||
(Either SomeException [T.Text])
|
(Either SomeException [T.Text])
|
||||||
case m of
|
case m of
|
||||||
Left e2 -> return $ Left $ "Failed to migrate data tables" ++ show e2
|
Left e2 -> return $ Left $ "Failed to migrate data tables" ++ show e2
|
||||||
Right _ -> return $ Right True
|
Right _ -> do
|
||||||
Right _ -> return $ Right False
|
return $ Right True
|
||||||
|
Right _ -> do
|
||||||
|
return $ Right False
|
||||||
|
|
||||||
initPool :: T.Text -> NoLoggingT IO ConnectionPool
|
initPool :: T.Text -> NoLoggingT IO ConnectionPool
|
||||||
initPool dbPath = do
|
initPool dbPath = do
|
||||||
|
@ -839,6 +841,32 @@ getQrCode pool zp wId = do
|
||||||
return qrs
|
return qrs
|
||||||
return $ entityVal <$> r
|
return $ entityVal <$> r
|
||||||
|
|
||||||
|
upgradeQrTable :: ConnectionPool -> IO ()
|
||||||
|
upgradeQrTable pool = do
|
||||||
|
r <-
|
||||||
|
runNoLoggingT $
|
||||||
|
PS.retryOnBusy $
|
||||||
|
flip PS.runSqlPool pool $
|
||||||
|
selectOne $ do
|
||||||
|
qrs <- from $ table @QrCode
|
||||||
|
where_ $ qrs ^. QrCodeVersion ==. val OrchardPool
|
||||||
|
return countRows
|
||||||
|
unless (maybe 0 (\(Value x) -> x) r > (0 :: Int)) $ do
|
||||||
|
_ <-
|
||||||
|
runNoLoggingT $
|
||||||
|
PS.retryOnBusy $
|
||||||
|
flip PS.runSqlPool pool $ do
|
||||||
|
rawExecute
|
||||||
|
"update qr_code set version = ? where version = ?"
|
||||||
|
[PersistText "OrchardPool", PersistText "Orchard"]
|
||||||
|
rawExecute
|
||||||
|
"update qr_code set version = ? where version = ?"
|
||||||
|
[PersistText "SaplingPool", PersistText "Sapling"]
|
||||||
|
rawExecute
|
||||||
|
"update qr_code set version = ? where version = ?"
|
||||||
|
[PersistText "TransparentPool", PersistText "Transparent"]
|
||||||
|
return ()
|
||||||
|
|
||||||
-- * Wallet
|
-- * Wallet
|
||||||
-- | Get the block of the last transaction known to the wallet
|
-- | Get the block of the last transaction known to the wallet
|
||||||
getMaxWalletBlock ::
|
getMaxWalletBlock ::
|
||||||
|
|
|
@ -32,7 +32,11 @@ import Text.Printf
|
||||||
import Text.Wrap (FillScope(..), FillStrategy(..), WrapSettings(..), wrapText)
|
import Text.Wrap (FillScope(..), FillStrategy(..), WrapSettings(..), wrapText)
|
||||||
import TextShow hiding (toText)
|
import TextShow hiding (toText)
|
||||||
import ZcashHaskell.Keys (generateWalletSeedPhrase)
|
import ZcashHaskell.Keys (generateWalletSeedPhrase)
|
||||||
import ZcashHaskell.Orchard (getSaplingFromUA, isValidUnifiedAddress)
|
import ZcashHaskell.Orchard
|
||||||
|
( getSaplingFromUA
|
||||||
|
, isValidUnifiedAddress
|
||||||
|
, parseAddress
|
||||||
|
)
|
||||||
import ZcashHaskell.Transparent (encodeTransparentReceiver)
|
import ZcashHaskell.Transparent (encodeTransparentReceiver)
|
||||||
import ZcashHaskell.Types
|
import ZcashHaskell.Types
|
||||||
( BlockResponse(..)
|
( BlockResponse(..)
|
||||||
|
@ -51,13 +55,11 @@ import Zenith.Scanner (checkIntegrity, processTx, rescanZebra, updateConfs)
|
||||||
import Zenith.Types hiding (ZcashAddress(..))
|
import Zenith.Types hiding (ZcashAddress(..))
|
||||||
import Zenith.Utils
|
import Zenith.Utils
|
||||||
( displayAmount
|
( displayAmount
|
||||||
, isRecipientValid
|
|
||||||
, isRecipientValidGUI
|
, isRecipientValidGUI
|
||||||
, isZecAddressValid
|
|
||||||
, isValidString
|
, isValidString
|
||||||
|
, isZecAddressValid
|
||||||
, jsonNumber
|
, jsonNumber
|
||||||
, padWithZero
|
, padWithZero
|
||||||
, parseAddressUA
|
|
||||||
, showAddress
|
, showAddress
|
||||||
, validBarValue
|
, validBarValue
|
||||||
)
|
)
|
||||||
|
@ -605,8 +607,8 @@ buildUI wenv model = widgetTree
|
||||||
, separatorLine `styleBasic` [fgColor btnColor]
|
, separatorLine `styleBasic` [fgColor btnColor]
|
||||||
, spacer
|
, spacer
|
||||||
, hstack
|
, hstack
|
||||||
[
|
[ label "Privacy Level:" `styleBasic`
|
||||||
label "Privacy Level:" `styleBasic` [width 70, textFont "Bold"]
|
[width 70, textFont "Bold"]
|
||||||
, spacer
|
, spacer
|
||||||
, label "Full " `styleBasic` [width 40]
|
, label "Full " `styleBasic` [width 40]
|
||||||
, radio Full privacyChoice
|
, radio Full privacyChoice
|
||||||
|
@ -615,8 +617,8 @@ buildUI wenv model = widgetTree
|
||||||
, radio Medium privacyChoice
|
, radio Medium privacyChoice
|
||||||
]
|
]
|
||||||
, hstack
|
, hstack
|
||||||
[
|
[ label " " `styleBasic`
|
||||||
label " " `styleBasic` [width 70, textFont "Bold"]
|
[width 70, textFont "Bold"]
|
||||||
, spacer
|
, spacer
|
||||||
, label "Low " `styleBasic` [width 40]
|
, label "Low " `styleBasic` [width 40]
|
||||||
, radio Low privacyChoice
|
, radio Low privacyChoice
|
||||||
|
@ -636,7 +638,8 @@ buildUI wenv model = widgetTree
|
||||||
]
|
]
|
||||||
]
|
]
|
||||||
, hstack
|
, hstack
|
||||||
[ label "Amount:" `styleBasic` [width 50, textFont "Bold"]
|
[ label "Amount:" `styleBasic`
|
||||||
|
[width 50, textFont "Bold"]
|
||||||
, spacer
|
, spacer
|
||||||
, numericField_
|
, numericField_
|
||||||
sendAmount
|
sendAmount
|
||||||
|
@ -654,7 +657,8 @@ buildUI wenv model = widgetTree
|
||||||
]
|
]
|
||||||
]
|
]
|
||||||
, hstack
|
, hstack
|
||||||
[ label "Memo:" `styleBasic` [width 50, textFont "Bold"]
|
[ label "Memo:" `styleBasic`
|
||||||
|
[width 50, textFont "Bold"]
|
||||||
, spacer
|
, spacer
|
||||||
, textArea sendMemo `styleBasic`
|
, textArea sendMemo `styleBasic`
|
||||||
[width 150, height 40]
|
[width 150, height 40]
|
||||||
|
@ -1079,7 +1083,11 @@ handleEvent wenv node model evt =
|
||||||
]
|
]
|
||||||
ConfirmCancel -> [Model $ model & confirmTitle .~ Nothing & mainInput .~ ""]
|
ConfirmCancel -> [Model $ model & confirmTitle .~ Nothing & mainInput .~ ""]
|
||||||
ShowSeed -> [Model $ model & showSeed .~ True & menuPopup .~ False]
|
ShowSeed -> [Model $ model & showSeed .~ True & menuPopup .~ False]
|
||||||
ShowSend -> [Model $ model & openSend .~ True & privacyChoice .~ Full & recipientValid .~ False]
|
ShowSend ->
|
||||||
|
[ Model $
|
||||||
|
model & openSend .~ True & privacyChoice .~ Full & recipientValid .~
|
||||||
|
False
|
||||||
|
]
|
||||||
SendTx ->
|
SendTx ->
|
||||||
case currentAccount of
|
case currentAccount of
|
||||||
Nothing -> [Event $ ShowError "No account available", Event CancelSend]
|
Nothing -> [Event $ ShowError "No account available", Event CancelSend]
|
||||||
|
@ -1097,6 +1105,7 @@ handleEvent wenv node model evt =
|
||||||
(model ^. sendAmount)
|
(model ^. sendAmount)
|
||||||
(model ^. sendRecipient)
|
(model ^. sendRecipient)
|
||||||
(model ^. sendMemo)
|
(model ^. sendMemo)
|
||||||
|
(model ^. privacyChoice)
|
||||||
, Event CancelSend
|
, Event CancelSend
|
||||||
]
|
]
|
||||||
CancelSend ->
|
CancelSend ->
|
||||||
|
@ -1263,9 +1272,10 @@ handleEvent wenv node model evt =
|
||||||
T.pack (printf "%.2f%%" (model ^. barValue * 100)))
|
T.pack (printf "%.2f%%" (model ^. barValue * 100)))
|
||||||
]
|
]
|
||||||
ResetRecipientValid -> [Model $ model & recipientValid .~ False]
|
ResetRecipientValid -> [Model $ model & recipientValid .~ False]
|
||||||
CheckRecipient a -> [Model $
|
CheckRecipient a ->
|
||||||
model & recipientValid .~ isRecipientValidGUI (model ^.privacyChoice) a ]
|
[ Model $
|
||||||
-- model & recipientValid .~ ((model ^. privacyChoice) == Low) ]
|
model & recipientValid .~ isRecipientValidGUI (model ^. privacyChoice) a
|
||||||
|
]
|
||||||
CheckAmount i ->
|
CheckAmount i ->
|
||||||
[ Model $
|
[ Model $
|
||||||
model & amountValid .~
|
model & amountValid .~
|
||||||
|
@ -1465,6 +1475,7 @@ handleEvent wenv node model evt =
|
||||||
res <- liftIO $ updateAdrsInAdrBook pool d a a
|
res <- liftIO $ updateAdrsInAdrBook pool d a a
|
||||||
return $ ShowMessage "Address Book entry updated!!"
|
return $ ShowMessage "Address Book entry updated!!"
|
||||||
|
|
||||||
|
-- model & recipientValid .~ ((model ^. privacyChoice) == Low) ]
|
||||||
scanZebra :: T.Text -> T.Text -> Int -> ZcashNet -> (AppEvent -> IO ()) -> IO ()
|
scanZebra :: T.Text -> T.Text -> Int -> ZcashNet -> (AppEvent -> IO ()) -> IO ()
|
||||||
scanZebra dbPath zHost zPort net sendMsg = do
|
scanZebra dbPath zHost zPort net sendMsg = do
|
||||||
bStatus <- liftIO $ checkBlockChain zHost zPort
|
bStatus <- liftIO $ checkBlockChain zHost zPort
|
||||||
|
@ -1533,20 +1544,21 @@ sendTransaction ::
|
||||||
-> Float
|
-> Float
|
||||||
-> T.Text
|
-> T.Text
|
||||||
-> T.Text
|
-> T.Text
|
||||||
|
-> PrivacyPolicy
|
||||||
-> (AppEvent -> IO ())
|
-> (AppEvent -> IO ())
|
||||||
-> IO ()
|
-> IO ()
|
||||||
sendTransaction config znet accId bl amt ua memo sendMsg = do
|
sendTransaction config znet accId bl amt ua memo policy sendMsg = do
|
||||||
sendMsg $ ShowModal "Preparing transaction..."
|
sendMsg $ ShowModal "Preparing transaction..."
|
||||||
case parseAddressUA ua znet of
|
case parseAddress (E.encodeUtf8 ua) of
|
||||||
Nothing -> sendMsg $ ShowError "Incorrect address"
|
Nothing -> sendMsg $ ShowError "Incorrect address"
|
||||||
Just outUA -> do
|
Just addr -> do
|
||||||
let dbPath = c_dbPath config
|
let dbPath = c_dbPath config
|
||||||
let zHost = c_zebraHost config
|
let zHost = c_zebraHost config
|
||||||
let zPort = c_zebraPort config
|
let zPort = c_zebraPort config
|
||||||
pool <- runNoLoggingT $ initPool dbPath
|
pool <- runNoLoggingT $ initPool dbPath
|
||||||
res <-
|
res <-
|
||||||
runFileLoggingT "zenith.log" $
|
runFileLoggingT "zenith.log" $
|
||||||
prepareTx pool zHost zPort znet accId bl amt outUA memo
|
prepareTxV2 pool zHost zPort znet accId bl amt addr memo policy
|
||||||
case res of
|
case res of
|
||||||
Left e -> sendMsg $ ShowError $ T.pack $ show e
|
Left e -> sendMsg $ ShowError $ T.pack $ show e
|
||||||
Right rawTx -> do
|
Right rawTx -> do
|
||||||
|
@ -1593,6 +1605,7 @@ runZenithGUI config = do
|
||||||
Left e1 -> throwIO e1
|
Left e1 -> throwIO e1
|
||||||
Right chainInfo -> do
|
Right chainInfo -> do
|
||||||
x <- initDb dbFilePath
|
x <- initDb dbFilePath
|
||||||
|
_ <- upgradeQrTable pool
|
||||||
case x of
|
case x of
|
||||||
Left e2 -> throwIO $ userError e2
|
Left e2 -> throwIO $ userError e2
|
||||||
Right x' -> do
|
Right x' -> do
|
||||||
|
|
|
@ -48,6 +48,7 @@ import Zenith.DB
|
||||||
, saveConfs
|
, saveConfs
|
||||||
, saveTransaction
|
, saveTransaction
|
||||||
, updateWalletSync
|
, updateWalletSync
|
||||||
|
, upgradeQrTable
|
||||||
)
|
)
|
||||||
import Zenith.Types (Config(..), HexStringDB(..), ZcashNetDB(..))
|
import Zenith.Types (Config(..), HexStringDB(..), ZcashNetDB(..))
|
||||||
import Zenith.Utils (jsonNumber)
|
import Zenith.Utils (jsonNumber)
|
||||||
|
@ -69,6 +70,8 @@ rescanZebra host port dbFilePath = do
|
||||||
pool1 <- runNoLoggingT $ initPool dbFilePath
|
pool1 <- runNoLoggingT $ initPool dbFilePath
|
||||||
{-pool2 <- runNoLoggingT $ initPool dbFilePath-}
|
{-pool2 <- runNoLoggingT $ initPool dbFilePath-}
|
||||||
{-pool3 <- runNoLoggingT $ initPool dbFilePath-}
|
{-pool3 <- runNoLoggingT $ initPool dbFilePath-}
|
||||||
|
_ <- initDb dbFilePath
|
||||||
|
upgradeQrTable pool1
|
||||||
clearWalletTransactions pool1
|
clearWalletTransactions pool1
|
||||||
clearWalletData pool1
|
clearWalletData pool1
|
||||||
dbBlock <- getMaxBlock pool1 znet
|
dbBlock <- getMaxBlock pool1 znet
|
||||||
|
@ -211,6 +214,7 @@ clearSync config = do
|
||||||
Left e1 -> throwIO e1
|
Left e1 -> throwIO e1
|
||||||
Right chainInfo -> do
|
Right chainInfo -> do
|
||||||
x <- initDb dbPath
|
x <- initDb dbPath
|
||||||
|
_ <- upgradeQrTable pool
|
||||||
case x of
|
case x of
|
||||||
Left e2 -> throwIO $ userError e2
|
Left e2 -> throwIO $ userError e2
|
||||||
Right x' -> do
|
Right x' -> do
|
||||||
|
|
207
test/Spec.hs
207
test/Spec.hs
|
@ -32,6 +32,7 @@ import ZcashHaskell.Types
|
||||||
, SaplingSpendingKey(..)
|
, SaplingSpendingKey(..)
|
||||||
, Scope(..)
|
, Scope(..)
|
||||||
, ShieldedOutput(..)
|
, ShieldedOutput(..)
|
||||||
|
, TxError(..)
|
||||||
, ZcashNet(..)
|
, ZcashNet(..)
|
||||||
)
|
)
|
||||||
import Zenith.Core
|
import Zenith.Core
|
||||||
|
@ -235,15 +236,15 @@ main = do
|
||||||
Just
|
Just
|
||||||
"ztestsapling1tgjr4zppwk4ne8xy6gdq4z2gwq7dmf5jq8z2ctpn8nlmtse0a74fa5z0m8z383gmpgqz6q6duu4"
|
"ztestsapling1tgjr4zppwk4ne8xy6gdq4z2gwq7dmf5jq8z2ctpn8nlmtse0a74fa5z0m8z383gmpgqz6q6duu4"
|
||||||
describe "Notes" $ do
|
describe "Notes" $ do
|
||||||
it "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"
|
||||||
oNotes <- getWalletUnspentOrchNotes pool (toSqlKey 1)
|
oNotes <- getWalletUnspentOrchNotes pool (toSqlKey 1)
|
||||||
oNotes `shouldBe` []
|
oNotes `shouldBe` []
|
||||||
it "Check Sapling notes" $ do
|
xit "Check Sapling notes" $ do
|
||||||
pool <- runNoLoggingT $ initPool "/home/rav/Zenith/zenith.db"
|
pool <- runNoLoggingT $ initPool "/home/rav/Zenith/zenith.db"
|
||||||
oNotes <- getWalletUnspentSapNotes pool (toSqlKey 4)
|
oNotes <- getWalletUnspentSapNotes pool (toSqlKey 4)
|
||||||
oNotes `shouldBe` []
|
oNotes `shouldBe` []
|
||||||
it "Check transparent notes" $ do
|
xit "Check transparent notes" $ 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` []
|
||||||
|
@ -265,7 +266,7 @@ main = do
|
||||||
18232
|
18232
|
||||||
TestNet
|
TestNet
|
||||||
(toSqlKey 1)
|
(toSqlKey 1)
|
||||||
3001230
|
3001331
|
||||||
0.005
|
0.005
|
||||||
(fromJust uaRead)
|
(fromJust uaRead)
|
||||||
"Sending memo to orchard"
|
"Sending memo to orchard"
|
||||||
|
@ -289,7 +290,7 @@ main = do
|
||||||
18232
|
18232
|
||||||
TestNet
|
TestNet
|
||||||
(toSqlKey 4)
|
(toSqlKey 4)
|
||||||
3001230
|
3001331
|
||||||
0.005
|
0.005
|
||||||
(fromJust uaRead)
|
(fromJust uaRead)
|
||||||
"Sending memo to sapling"
|
"Sending memo to sapling"
|
||||||
|
@ -297,8 +298,30 @@ main = do
|
||||||
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
|
||||||
|
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
|
||||||
|
0.005
|
||||||
|
(fromJust uaRead)
|
||||||
|
""
|
||||||
|
Full
|
||||||
|
tx `shouldBe`
|
||||||
|
Left
|
||||||
|
(PrivacyPolicyError "Receiver not capable of Full privacy")
|
||||||
describe "Medium" $ do
|
describe "Medium" $ do
|
||||||
xit "To Orchard" $ do
|
it "To Orchard" $ do
|
||||||
let uaRead =
|
let uaRead =
|
||||||
parseAddress
|
parseAddress
|
||||||
"utest1dl54utt6prjj5e0dnlknwumnxq9hycdjpkfr0sy6e6h522remqee8axe9zax0wsjrwpj76v555pdhvj9rnargpfyycs0vpkapq98xcdhem99gc4wchzn0ggepq3y6nz3a9sscwgqxgsh9vzhcad402y3x9szfregck5gslkya3c79d86xx0l33tpk8gnn7ew9vw37w43zh22u8dgdax"
|
"utest1dl54utt6prjj5e0dnlknwumnxq9hycdjpkfr0sy6e6h522remqee8axe9zax0wsjrwpj76v555pdhvj9rnargpfyycs0vpkapq98xcdhem99gc4wchzn0ggepq3y6nz3a9sscwgqxgsh9vzhcad402y3x9szfregck5gslkya3c79d86xx0l33tpk8gnn7ew9vw37w43zh22u8dgdax"
|
||||||
|
@ -314,7 +337,7 @@ main = do
|
||||||
18232
|
18232
|
||||||
TestNet
|
TestNet
|
||||||
(toSqlKey 1)
|
(toSqlKey 1)
|
||||||
3000789
|
3001372
|
||||||
0.005
|
0.005
|
||||||
(fromJust uaRead)
|
(fromJust uaRead)
|
||||||
"Sending memo to orchard"
|
"Sending memo to orchard"
|
||||||
|
@ -322,7 +345,7 @@ main = do
|
||||||
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")
|
||||||
xit "To Sapling" $ do
|
it "To Sapling" $ do
|
||||||
let uaRead =
|
let uaRead =
|
||||||
parseAddress
|
parseAddress
|
||||||
"ztestsapling136jp8z89v2jh6kqd5rs4dtvlxym90m43svzdwzxaplyvc5ttzppytpvx80ncllcsqzpmukxjl3y"
|
"ztestsapling136jp8z89v2jh6kqd5rs4dtvlxym90m43svzdwzxaplyvc5ttzppytpvx80ncllcsqzpmukxjl3y"
|
||||||
|
@ -338,7 +361,7 @@ main = do
|
||||||
18232
|
18232
|
||||||
TestNet
|
TestNet
|
||||||
(toSqlKey 1)
|
(toSqlKey 1)
|
||||||
3000789
|
3001372
|
||||||
0.005
|
0.005
|
||||||
(fromJust uaRead)
|
(fromJust uaRead)
|
||||||
"Sending memo to orchard"
|
"Sending memo to orchard"
|
||||||
|
@ -346,3 +369,169 @@ main = do
|
||||||
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
|
||||||
|
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
|
||||||
|
0.005
|
||||||
|
(fromJust uaRead)
|
||||||
|
""
|
||||||
|
Medium
|
||||||
|
tx `shouldBe`
|
||||||
|
Left
|
||||||
|
(PrivacyPolicyError "Receiver not capable of Medium privacy")
|
||||||
|
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
|
||||||
|
0.005
|
||||||
|
(fromJust uaRead)
|
||||||
|
"Sending memo to orchard"
|
||||||
|
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
|
||||||
|
0.005
|
||||||
|
(fromJust uaRead)
|
||||||
|
"Sending memo to orchard"
|
||||||
|
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
|
||||||
|
0.005
|
||||||
|
(fromJust uaRead)
|
||||||
|
""
|
||||||
|
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
|
||||||
|
0.005
|
||||||
|
(fromJust uaRead)
|
||||||
|
"Sending memo to orchard"
|
||||||
|
None
|
||||||
|
tx `shouldBe`
|
||||||
|
Left
|
||||||
|
(PrivacyPolicyError
|
||||||
|
"Receiver 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
|
||||||
|
0.005
|
||||||
|
(fromJust uaRead)
|
||||||
|
"Sending memo to orchard"
|
||||||
|
None
|
||||||
|
tx `shouldBe`
|
||||||
|
Left
|
||||||
|
(PrivacyPolicyError
|
||||||
|
"Receiver 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
|
||||||
|
0.005
|
||||||
|
(fromJust uaRead)
|
||||||
|
""
|
||||||
|
None
|
||||||
|
case tx of
|
||||||
|
Left e -> assertFailure $ show e
|
||||||
|
Right h -> h `shouldNotBe` (hexString "deadbeef")
|
||||||
|
|
|
@ -1 +1 @@
|
||||||
Subproject commit 12296026a0ebb9a5afe0904b251c5d31080eab18
|
Subproject commit 003293cc3f978c146824d0695c5c458cf2cc9bb5
|
Loading…
Reference in a new issue