Compare commits
No commits in common. "0d5161cdb284d9a12593c57e7e4764d9575d363d" and "abe30db2feff23c2fdcaaadc312acff9cad08fb3" have entirely different histories.
0d5161cdb2
...
abe30db2fe
12 changed files with 385 additions and 992 deletions
|
@ -24,8 +24,6 @@ and this project adheres to [Semantic Versioning](https://semver.org/spec/v2.0.0
|
||||||
### Changed
|
### Changed
|
||||||
|
|
||||||
- Detection of changes in database schema for automatic re-scan
|
- Detection of changes in database schema for automatic re-scan
|
||||||
- Block tracking for chain re-org detection
|
|
||||||
- Refactored `ZcashPool`
|
|
||||||
|
|
||||||
## [0.6.0.0-beta]
|
## [0.6.0.0-beta]
|
||||||
|
|
||||||
|
|
|
@ -230,7 +230,6 @@ main = do
|
||||||
"gui" -> runZenithGUI myConfig
|
"gui" -> runZenithGUI myConfig
|
||||||
"tui" -> runZenithTUI myConfig
|
"tui" -> runZenithTUI myConfig
|
||||||
"rescan" -> rescanZebra zebraHost zebraPort dbFilePath
|
"rescan" -> rescanZebra zebraHost zebraPort dbFilePath
|
||||||
"resync" -> clearSync myConfig
|
|
||||||
_ -> printUsage
|
_ -> printUsage
|
||||||
else printUsage
|
else printUsage
|
||||||
|
|
||||||
|
|
|
@ -62,14 +62,9 @@ import qualified Brick.Widgets.List as L
|
||||||
import qualified Brick.Widgets.ProgressBar as P
|
import qualified Brick.Widgets.ProgressBar as P
|
||||||
import Control.Concurrent (forkIO, threadDelay)
|
import Control.Concurrent (forkIO, threadDelay)
|
||||||
import Control.Exception (throw, throwIO, try)
|
import Control.Exception (throw, throwIO, try)
|
||||||
import Control.Monad (forever, unless, void, when)
|
import Control.Monad (forever, void, when)
|
||||||
import Control.Monad.IO.Class (liftIO)
|
import Control.Monad.IO.Class (liftIO)
|
||||||
import Control.Monad.Logger
|
import Control.Monad.Logger (runFileLoggingT, runNoLoggingT)
|
||||||
( LoggingT
|
|
||||||
, logDebugN
|
|
||||||
, runFileLoggingT
|
|
||||||
, runNoLoggingT
|
|
||||||
)
|
|
||||||
import Data.Aeson
|
import Data.Aeson
|
||||||
import Data.HexString (HexString(..), toText)
|
import Data.HexString (HexString(..), toText)
|
||||||
import Data.Maybe
|
import Data.Maybe
|
||||||
|
@ -94,10 +89,9 @@ import ZcashHaskell.Types
|
||||||
import ZcashHaskell.Utils (getBlockTime, makeZebraCall)
|
import ZcashHaskell.Utils (getBlockTime, makeZebraCall)
|
||||||
import Zenith.Core
|
import Zenith.Core
|
||||||
import Zenith.DB
|
import Zenith.DB
|
||||||
import Zenith.Scanner (checkIntegrity, processTx, rescanZebra, updateConfs)
|
import Zenith.Scanner (processTx, rescanZebra, updateConfs)
|
||||||
import Zenith.Types
|
import Zenith.Types
|
||||||
( Config(..)
|
( Config(..)
|
||||||
, HexStringDB(..)
|
|
||||||
, PhraseDB(..)
|
, PhraseDB(..)
|
||||||
, UnifiedAddressDB(..)
|
, UnifiedAddressDB(..)
|
||||||
, ZcashNetDB(..)
|
, ZcashNetDB(..)
|
||||||
|
@ -108,7 +102,7 @@ import Zenith.Utils
|
||||||
, displayZec
|
, displayZec
|
||||||
, isRecipientValid
|
, isRecipientValid
|
||||||
, jsonNumber
|
, jsonNumber
|
||||||
, parseAddressUA
|
, parseAddress
|
||||||
, showAddress
|
, showAddress
|
||||||
, validBarValue
|
, validBarValue
|
||||||
)
|
)
|
||||||
|
@ -618,16 +612,16 @@ mkInputForm =
|
||||||
mkSendForm :: Integer -> SendInput -> Form SendInput e Name
|
mkSendForm :: Integer -> SendInput -> Form SendInput e Name
|
||||||
mkSendForm bal =
|
mkSendForm bal =
|
||||||
newForm
|
newForm
|
||||||
[ label "Privacy Level :" @@=
|
[ label "To: " @@= editTextField sendTo RecField (Just 1)
|
||||||
radioField policyField [ (Full, PrivacyFullField, "Full")
|
|
||||||
, (Medium, PrivacyMediumField, "Medium")
|
|
||||||
, (Low, PrivacyLowField, "Low")
|
|
||||||
, (None, PrivacyNoneField, "None")
|
|
||||||
]
|
|
||||||
, label "To: " @@= editTextField sendTo RecField (Just 1)
|
|
||||||
, label "Amount: " @@=
|
, label "Amount: " @@=
|
||||||
editShowableFieldWithValidate sendAmt AmtField (isAmountValid bal)
|
editShowableFieldWithValidate sendAmt AmtField (isAmountValid bal)
|
||||||
, label "Memo: " @@= editTextField sendMemo MemoField (Just 1)
|
, label "Memo: " @@= editTextField sendMemo MemoField (Just 1)
|
||||||
|
, label "Privacy Level :" @@=
|
||||||
|
radioField policyField [ (None, PrivacyNoneField, "None")
|
||||||
|
, (Low, PrivacyLowField, "Low")
|
||||||
|
, (Medium, PrivacyMediumField, "Medium")
|
||||||
|
, (Full, PrivacyFullField, "Full")
|
||||||
|
]
|
||||||
]
|
]
|
||||||
where
|
where
|
||||||
isAmountValid :: Integer -> Float -> Bool
|
isAmountValid :: Integer -> Float -> Bool
|
||||||
|
@ -737,42 +731,31 @@ abMBarAttr :: A.AttrName
|
||||||
abMBarAttr = A.attrName "menubar"
|
abMBarAttr = A.attrName "menubar"
|
||||||
|
|
||||||
scanZebra ::
|
scanZebra ::
|
||||||
T.Text
|
T.Text -> T.Text -> Int -> Int -> BC.BChan Tick -> ZcashNet -> IO ()
|
||||||
-> T.Text
|
|
||||||
-> Int
|
|
||||||
-> Int
|
|
||||||
-> BC.BChan Tick
|
|
||||||
-> ZcashNet
|
|
||||||
-> LoggingT IO ()
|
|
||||||
scanZebra dbP zHost zPort b eChan znet = do
|
scanZebra dbP zHost zPort b eChan znet = do
|
||||||
bStatus <- liftIO $ checkBlockChain zHost zPort
|
bStatus <- liftIO $ checkBlockChain zHost zPort
|
||||||
pool <- liftIO $ runNoLoggingT $ initPool dbP
|
pool <- runNoLoggingT $ initPool dbP
|
||||||
dbBlock <- liftIO $ getMaxBlock pool $ ZcashNetDB znet
|
dbBlock <- getMaxBlock pool $ ZcashNetDB znet
|
||||||
chkBlock <- liftIO $ checkIntegrity dbP zHost zPort dbBlock 1
|
confUp <- try $ updateConfs zHost zPort pool :: IO (Either IOError ())
|
||||||
logDebugN $
|
case confUp of
|
||||||
"dbBlock: " <>
|
Left _e0 ->
|
||||||
T.pack (show dbBlock) <> " chkBlock: " <> T.pack (show chkBlock)
|
liftIO $
|
||||||
|
BC.writeBChan eChan $ TickMsg "Failed to update unconfirmed transactions"
|
||||||
|
Right _ -> do
|
||||||
let sb = max dbBlock b
|
let sb = max dbBlock 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"
|
||||||
else do
|
else do
|
||||||
let bList = [(sb + 1) .. (zgb_blocks bStatus)]
|
let bList = [(sb + 1) .. (zgb_blocks bStatus)]
|
||||||
if not (null bList)
|
if not (null bList)
|
||||||
then do
|
then do
|
||||||
let step =
|
let step =
|
||||||
(1.0 :: Float) / fromIntegral (zgb_blocks bStatus - (sb + 1))
|
(1.0 :: Float) /
|
||||||
mapM_ (liftIO . processBlock pool step) bList
|
fromIntegral (zgb_blocks bStatus - (sb + 1))
|
||||||
|
mapM_ (processBlock pool step) bList
|
||||||
else liftIO $ BC.writeBChan eChan $ TickVal 1.0
|
else liftIO $ BC.writeBChan eChan $ TickVal 1.0
|
||||||
confUp <-
|
|
||||||
liftIO $ try $ updateConfs zHost zPort pool :: LoggingT
|
|
||||||
IO
|
|
||||||
(Either IOError ())
|
|
||||||
case confUp of
|
|
||||||
Left _e0 ->
|
|
||||||
liftIO $
|
|
||||||
BC.writeBChan eChan $ TickMsg "Failed to update unconfirmed transactions"
|
|
||||||
Right _ -> return ()
|
|
||||||
where
|
where
|
||||||
processBlock :: ConnectionPool -> Float -> Int -> IO ()
|
processBlock :: ConnectionPool -> Float -> Int -> IO ()
|
||||||
processBlock pool step bl = do
|
processBlock pool step bl = do
|
||||||
|
@ -797,16 +780,16 @@ scanZebra dbP zHost zPort b eChan znet = do
|
||||||
Left e2 -> liftIO $ BC.writeBChan eChan $ TickMsg e2
|
Left e2 -> liftIO $ BC.writeBChan eChan $ TickMsg e2
|
||||||
Right hb -> do
|
Right hb -> do
|
||||||
let blockTime = getBlockTime hb
|
let blockTime = getBlockTime hb
|
||||||
bi <-
|
mapM_ (processTx zHost zPort blockTime pool (ZcashNetDB znet)) $
|
||||||
saveBlock pool $
|
bl_txs $ addTime blk blockTime
|
||||||
ZcashBlock
|
|
||||||
(fromIntegral $ bl_height blk)
|
|
||||||
(HexStringDB $ bl_hash blk)
|
|
||||||
(fromIntegral $ bl_confirmations blk)
|
|
||||||
blockTime
|
|
||||||
(ZcashNetDB znet)
|
|
||||||
mapM_ (processTx zHost zPort bi pool) $ bl_txs blk
|
|
||||||
liftIO $ BC.writeBChan eChan $ TickVal step
|
liftIO $ BC.writeBChan eChan $ TickVal step
|
||||||
|
addTime :: BlockResponse -> Int -> BlockResponse
|
||||||
|
addTime bl t =
|
||||||
|
BlockResponse
|
||||||
|
(bl_confirmations bl)
|
||||||
|
(bl_height bl)
|
||||||
|
(fromIntegral t)
|
||||||
|
(bl_txs bl)
|
||||||
|
|
||||||
appEvent :: BT.BrickEvent Name Tick -> BT.EventM Name State ()
|
appEvent :: BT.BrickEvent Name Tick -> BT.EventM Name State ()
|
||||||
appEvent (BT.AppEvent t) = do
|
appEvent (BT.AppEvent t) = do
|
||||||
|
@ -851,7 +834,6 @@ appEvent (BT.AppEvent t) = do
|
||||||
Just (_k, w) -> return w
|
Just (_k, w) -> return w
|
||||||
_ <-
|
_ <-
|
||||||
liftIO $
|
liftIO $
|
||||||
runFileLoggingT "zenith.log" $
|
|
||||||
syncWallet
|
syncWallet
|
||||||
(Config
|
(Config
|
||||||
(s ^. dbPath)
|
(s ^. dbPath)
|
||||||
|
@ -888,7 +870,6 @@ appEvent (BT.AppEvent t) = do
|
||||||
_ <-
|
_ <-
|
||||||
liftIO $
|
liftIO $
|
||||||
forkIO $
|
forkIO $
|
||||||
runFileLoggingT "zenith.log" $
|
|
||||||
scanZebra
|
scanZebra
|
||||||
(s ^. dbPath)
|
(s ^. dbPath)
|
||||||
(s ^. zebraHost)
|
(s ^. zebraHost)
|
||||||
|
@ -1160,7 +1141,7 @@ appEvent (BT.VtyEvent e) = do
|
||||||
(addressBookAbaddress (entityVal a))
|
(addressBookAbaddress (entityVal a))
|
||||||
0.0
|
0.0
|
||||||
""
|
""
|
||||||
Full)
|
None)
|
||||||
BT.modify $ set dialogBox SendTx
|
BT.modify $ set dialogBox SendTx
|
||||||
_ -> do
|
_ -> do
|
||||||
BT.modify $
|
BT.modify $
|
||||||
|
@ -1332,7 +1313,7 @@ appEvent (BT.VtyEvent e) = do
|
||||||
V.EvKey (V.KChar 's') [] -> do
|
V.EvKey (V.KChar 's') [] -> do
|
||||||
BT.modify $
|
BT.modify $
|
||||||
set txForm $
|
set txForm $
|
||||||
mkSendForm (s ^. balance) (SendInput "" 0.0 "" Full)
|
mkSendForm (s ^. balance) (SendInput "" 0.0 "" None)
|
||||||
BT.modify $ set dialogBox SendTx
|
BT.modify $ set dialogBox SendTx
|
||||||
V.EvKey (V.KChar 'b') [] ->
|
V.EvKey (V.KChar 'b') [] ->
|
||||||
BT.modify $ set dialogBox AdrBook
|
BT.modify $ set dialogBox AdrBook
|
||||||
|
@ -1467,7 +1448,7 @@ runZenithTUI config = do
|
||||||
1.0
|
1.0
|
||||||
eventChan
|
eventChan
|
||||||
0
|
0
|
||||||
(mkSendForm 0 $ SendInput "" 0.0 "" Full)
|
(mkSendForm 0 $ SendInput "" 0.0 "" None)
|
||||||
(L.list ABList (Vec.fromList abookList) 1)
|
(L.list ABList (Vec.fromList abookList) 1)
|
||||||
(mkNewABForm (AdrBookEntry "" ""))
|
(mkNewABForm (AdrBookEntry "" ""))
|
||||||
""
|
""
|
||||||
|
@ -1689,7 +1670,7 @@ sendTransaction ::
|
||||||
-> IO ()
|
-> IO ()
|
||||||
sendTransaction pool chan zHost zPort znet accId bl amt ua memo = do
|
sendTransaction pool chan zHost zPort znet accId bl amt ua memo = do
|
||||||
BC.writeBChan chan $ TickMsg "Preparing transaction..."
|
BC.writeBChan chan $ TickMsg "Preparing transaction..."
|
||||||
case parseAddressUA ua znet of
|
case parseAddress ua znet of
|
||||||
Nothing -> BC.writeBChan chan $ TickMsg "Incorrect address"
|
Nothing -> BC.writeBChan chan $ TickMsg "Incorrect address"
|
||||||
Just outUA -> do
|
Just outUA -> do
|
||||||
res <-
|
res <-
|
||||||
|
|
|
@ -772,11 +772,7 @@ prepareTxV2 pool zebraHost zebraPort zn za bh amt va memo policy = do
|
||||||
{-firstPass <- liftIO $ selectUnspentNotes pool za zats-}
|
{-firstPass <- liftIO $ selectUnspentNotes pool za zats-}
|
||||||
--let fee = calculateTxFee firstPass $ fst recipient
|
--let fee = calculateTxFee firstPass $ fst recipient
|
||||||
--logDebugN $ T.pack $ "calculated fee " ++ show fee
|
--logDebugN $ T.pack $ "calculated fee " ++ show fee
|
||||||
notePlan <-
|
(tList, sList, oList) <- liftIO $ selectUnspentNotes pool za (zats + 5000)
|
||||||
liftIO $
|
|
||||||
selectUnspentNotesV2 pool za (zats + 10000) (fst recipient) policy
|
|
||||||
case notePlan of
|
|
||||||
Right (tList, sList, oList) -> do
|
|
||||||
logDebugN "selected notes"
|
logDebugN "selected notes"
|
||||||
logDebugN $ T.pack $ show tList
|
logDebugN $ T.pack $ show tList
|
||||||
logDebugN $ T.pack $ show sList
|
logDebugN $ T.pack $ show sList
|
||||||
|
@ -784,28 +780,18 @@ prepareTxV2 pool zebraHost zebraPort zn za bh amt va memo policy = do
|
||||||
let noteTotal = getTotalAmount (tList, sList, oList)
|
let noteTotal = getTotalAmount (tList, sList, oList)
|
||||||
tSpends <-
|
tSpends <-
|
||||||
liftIO $
|
liftIO $
|
||||||
prepTSpends
|
prepTSpends (getTranSK $ zcashAccountTPrivateKey $ entityVal acc) tList
|
||||||
(getTranSK $ zcashAccountTPrivateKey $ entityVal acc)
|
|
||||||
tList
|
|
||||||
--print tSpends
|
--print tSpends
|
||||||
sSpends <-
|
sSpends <-
|
||||||
liftIO $
|
liftIO $
|
||||||
prepSSpends
|
prepSSpends (getSapSK $ zcashAccountSapSpendKey $ entityVal acc) sList
|
||||||
(getSapSK $ zcashAccountSapSpendKey $ entityVal acc)
|
|
||||||
sList
|
|
||||||
--print sSpends
|
--print sSpends
|
||||||
oSpends <-
|
oSpends <-
|
||||||
liftIO $
|
liftIO $
|
||||||
prepOSpends
|
prepOSpends (getOrchSK $ zcashAccountOrchSpendKey $ entityVal acc) oList
|
||||||
(getOrchSK $ zcashAccountOrchSpendKey $ entityVal acc)
|
|
||||||
oList
|
|
||||||
--print oSpends
|
--print oSpends
|
||||||
dummy' <-
|
dummy <-
|
||||||
liftIO $
|
liftIO $ makeOutgoing acc recipient zats (noteTotal - 5000 - zats)
|
||||||
makeOutgoing acc recipient zats (noteTotal - 5000 - zats) policy
|
|
||||||
case dummy' of
|
|
||||||
Left e -> return $ Left e
|
|
||||||
Right dummy -> do
|
|
||||||
logDebugN "Calculating fee"
|
logDebugN "Calculating fee"
|
||||||
let feeResponse =
|
let feeResponse =
|
||||||
createTransaction
|
createTransaction
|
||||||
|
@ -822,204 +808,62 @@ prepareTxV2 pool zebraHost zebraPort zn za bh amt va memo policy = do
|
||||||
Left e1 -> return $ Left Fee
|
Left e1 -> return $ Left Fee
|
||||||
Right fee -> do
|
Right fee -> do
|
||||||
let feeAmt =
|
let feeAmt =
|
||||||
fromIntegral
|
fromIntegral (runGet getInt64le $ LBS.fromStrict $ toBytes fee)
|
||||||
(runGet getInt64le $ LBS.fromStrict $ toBytes fee)
|
(tList1, sList1, oList1) <-
|
||||||
finalNotePlan <-
|
liftIO $ selectUnspentNotes pool za (zats + feeAmt)
|
||||||
liftIO $
|
logDebugN $ T.pack $ "selected notes with fee" ++ show feeAmt
|
||||||
selectUnspentNotesV2
|
logDebugN $ T.pack $ show tList
|
||||||
pool
|
logDebugN $ T.pack $ show sList
|
||||||
za
|
logDebugN $ T.pack $ show oList
|
||||||
(zats + feeAmt)
|
outgoing <-
|
||||||
(fst recipient)
|
liftIO $ makeOutgoing acc recipient zats (noteTotal - feeAmt - zats)
|
||||||
policy
|
logDebugN $ T.pack $ show outgoing
|
||||||
case finalNotePlan of
|
|
||||||
Right (tList1, sList1, oList1) -> do
|
|
||||||
logDebugN $
|
|
||||||
T.pack $ "selected notes with fee" ++ show feeAmt
|
|
||||||
logDebugN $ T.pack $ show tList1
|
|
||||||
logDebugN $ T.pack $ show sList1
|
|
||||||
logDebugN $ T.pack $ show oList1
|
|
||||||
tSpends1 <-
|
|
||||||
liftIO $
|
|
||||||
prepTSpends
|
|
||||||
(getTranSK $ zcashAccountTPrivateKey $ entityVal acc)
|
|
||||||
tList1
|
|
||||||
sSpends1 <-
|
|
||||||
liftIO $
|
|
||||||
prepSSpends
|
|
||||||
(getSapSK $ zcashAccountSapSpendKey $ entityVal acc)
|
|
||||||
sList1
|
|
||||||
oSpends1 <-
|
|
||||||
liftIO $
|
|
||||||
prepOSpends
|
|
||||||
(getOrchSK $ zcashAccountOrchSpendKey $ entityVal acc)
|
|
||||||
oList1
|
|
||||||
let noteTotal1 = getTotalAmount (tList1, sList1, oList1)
|
|
||||||
outgoing' <-
|
|
||||||
liftIO $
|
|
||||||
makeOutgoing
|
|
||||||
acc
|
|
||||||
recipient
|
|
||||||
zats
|
|
||||||
(noteTotal1 - feeAmt - zats)
|
|
||||||
policy
|
|
||||||
logDebugN $ T.pack $ show outgoing'
|
|
||||||
case outgoing' of
|
|
||||||
Left e -> return $ Left e
|
|
||||||
Right outgoing -> do
|
|
||||||
let tx =
|
let tx =
|
||||||
createTransaction
|
createTransaction
|
||||||
(Just sT)
|
(Just sT)
|
||||||
(Just oT)
|
(Just oT)
|
||||||
tSpends1
|
tSpends
|
||||||
sSpends1
|
sSpends
|
||||||
oSpends1
|
oSpends
|
||||||
outgoing
|
outgoing
|
||||||
zn
|
zn
|
||||||
(bh + 3)
|
(bh + 3)
|
||||||
True
|
True
|
||||||
logDebugN $ T.pack $ show tx
|
logDebugN $ T.pack $ show tx
|
||||||
return tx
|
return tx
|
||||||
Left e -> return $ Left e
|
|
||||||
Left e -> do
|
|
||||||
logErrorN $ T.pack $ show e
|
|
||||||
return $ Left e
|
|
||||||
where
|
where
|
||||||
makeOutgoing ::
|
makeOutgoing ::
|
||||||
Entity ZcashAccount
|
Entity ZcashAccount
|
||||||
-> (Int, BS.ByteString)
|
-> (Int, BS.ByteString)
|
||||||
-> Integer
|
-> Integer
|
||||||
-> Integer
|
-> Integer
|
||||||
-> PrivacyPolicy
|
-> IO [OutgoingNote]
|
||||||
-> IO (Either TxError [OutgoingNote])
|
makeOutgoing acc (k, recvr) zats chg = do
|
||||||
makeOutgoing acc (k, recvr) zats chg policy = do
|
|
||||||
chgAddr <- runNoLoggingT $ getInternalAddresses pool $ entityKey acc
|
chgAddr <- runNoLoggingT $ getInternalAddresses pool $ entityKey acc
|
||||||
let internalUA = getUA $ walletAddressUAddress $ entityVal $ head chgAddr
|
let internalUA = getUA $ walletAddressUAddress $ entityVal $ head chgAddr
|
||||||
case k of
|
let chgRcvr =
|
||||||
|
fromJust $ o_rec =<< isValidUnifiedAddress (E.encodeUtf8 internalUA)
|
||||||
|
return
|
||||||
|
[ OutgoingNote
|
||||||
|
4
|
||||||
|
(getBytes $ getOrchSK $ zcashAccountOrchSpendKey $ entityVal acc)
|
||||||
|
(getBytes chgRcvr)
|
||||||
|
(fromIntegral chg)
|
||||||
|
""
|
||||||
|
True
|
||||||
|
, OutgoingNote
|
||||||
|
(fromIntegral k)
|
||||||
|
(case k of
|
||||||
4 ->
|
4 ->
|
||||||
case policy of
|
getBytes $ getOrchSK $ zcashAccountOrchSpendKey $ entityVal acc
|
||||||
None ->
|
|
||||||
return $
|
|
||||||
Left $
|
|
||||||
PrivacyPolicyError "Recipient not allowed by privacy policy"
|
|
||||||
_anyOther -> do
|
|
||||||
let chgRcvr =
|
|
||||||
fromJust $
|
|
||||||
o_rec =<< isValidUnifiedAddress (E.encodeUtf8 internalUA)
|
|
||||||
return $
|
|
||||||
Right
|
|
||||||
[ OutgoingNote
|
|
||||||
4
|
|
||||||
(getBytes $
|
|
||||||
getOrchSK $ zcashAccountOrchSpendKey $ entityVal acc)
|
|
||||||
(getBytes chgRcvr)
|
|
||||||
(fromIntegral chg)
|
|
||||||
""
|
|
||||||
True
|
|
||||||
, OutgoingNote
|
|
||||||
4
|
|
||||||
(getBytes $
|
|
||||||
getOrchSK $ zcashAccountOrchSpendKey $ entityVal acc)
|
|
||||||
recvr
|
|
||||||
(fromIntegral zats)
|
|
||||||
(E.encodeUtf8 memo)
|
|
||||||
False
|
|
||||||
]
|
|
||||||
3 ->
|
3 ->
|
||||||
case policy of
|
getBytes $ getSapSK $ zcashAccountSapSpendKey $ entityVal acc
|
||||||
None ->
|
_ -> "")
|
||||||
return $
|
|
||||||
Left $
|
|
||||||
PrivacyPolicyError "Receiver not compatible with privacy policy"
|
|
||||||
Full -> do
|
|
||||||
let chgRcvr =
|
|
||||||
fromJust $
|
|
||||||
s_rec =<< isValidUnifiedAddress (E.encodeUtf8 internalUA)
|
|
||||||
return $
|
|
||||||
Right
|
|
||||||
[ OutgoingNote
|
|
||||||
3
|
|
||||||
(getBytes $
|
|
||||||
getSapSK $ zcashAccountSapSpendKey $ entityVal acc)
|
|
||||||
(getBytes chgRcvr)
|
|
||||||
(fromIntegral chg)
|
|
||||||
""
|
|
||||||
True
|
|
||||||
, OutgoingNote
|
|
||||||
3
|
|
||||||
(getBytes $
|
|
||||||
getSapSK $ zcashAccountSapSpendKey $ entityVal acc)
|
|
||||||
recvr
|
recvr
|
||||||
(fromIntegral zats)
|
(fromIntegral zats)
|
||||||
(E.encodeUtf8 memo)
|
(E.encodeUtf8 memo)
|
||||||
False
|
False
|
||||||
]
|
]
|
||||||
_anyOther -> do
|
|
||||||
let chgRcvr =
|
|
||||||
fromJust $
|
|
||||||
o_rec =<< isValidUnifiedAddress (E.encodeUtf8 internalUA)
|
|
||||||
return $
|
|
||||||
Right
|
|
||||||
[ OutgoingNote
|
|
||||||
4
|
|
||||||
(getBytes $
|
|
||||||
getOrchSK $ zcashAccountOrchSpendKey $ entityVal acc)
|
|
||||||
(getBytes chgRcvr)
|
|
||||||
(fromIntegral chg)
|
|
||||||
""
|
|
||||||
True
|
|
||||||
, OutgoingNote
|
|
||||||
3
|
|
||||||
(getBytes $
|
|
||||||
getSapSK $ zcashAccountSapSpendKey $ entityVal acc)
|
|
||||||
recvr
|
|
||||||
(fromIntegral zats)
|
|
||||||
(E.encodeUtf8 memo)
|
|
||||||
False
|
|
||||||
]
|
|
||||||
2 ->
|
|
||||||
if policy <= Low
|
|
||||||
then do
|
|
||||||
let chgRcvr =
|
|
||||||
fromJust $
|
|
||||||
t_rec =<< isValidUnifiedAddress (E.encodeUtf8 internalUA)
|
|
||||||
return $
|
|
||||||
Right
|
|
||||||
[ OutgoingNote
|
|
||||||
1
|
|
||||||
BS.empty
|
|
||||||
(toBytes $ tr_bytes chgRcvr)
|
|
||||||
(fromIntegral chg)
|
|
||||||
""
|
|
||||||
True
|
|
||||||
, OutgoingNote 2 BS.empty recvr (fromIntegral zats) "" False
|
|
||||||
]
|
|
||||||
else return $
|
|
||||||
Left $
|
|
||||||
PrivacyPolicyError
|
|
||||||
"Receiver not compatible with privacy policy"
|
|
||||||
1 ->
|
|
||||||
if policy <= Low
|
|
||||||
then do
|
|
||||||
let chgRcvr =
|
|
||||||
fromJust $
|
|
||||||
t_rec =<< isValidUnifiedAddress (E.encodeUtf8 internalUA)
|
|
||||||
return $
|
|
||||||
Right
|
|
||||||
[ OutgoingNote
|
|
||||||
1
|
|
||||||
BS.empty
|
|
||||||
(toBytes $ tr_bytes chgRcvr)
|
|
||||||
(fromIntegral chg)
|
|
||||||
""
|
|
||||||
True
|
|
||||||
, OutgoingNote 1 BS.empty recvr (fromIntegral zats) "" False
|
|
||||||
]
|
|
||||||
else return $
|
|
||||||
Left $
|
|
||||||
PrivacyPolicyError
|
|
||||||
"Receiver not compatible with privacy policy"
|
|
||||||
_anyOther -> return $ Left ZHError
|
|
||||||
getTotalAmount ::
|
getTotalAmount ::
|
||||||
( [Entity WalletTrNote]
|
( [Entity WalletTrNote]
|
||||||
, [Entity WalletSapNote]
|
, [Entity WalletSapNote]
|
||||||
|
@ -1107,30 +951,22 @@ prepareTxV2 pool zebraHost zebraPort zn za bh amt va memo policy = do
|
||||||
syncWallet ::
|
syncWallet ::
|
||||||
Config -- ^ configuration parameters
|
Config -- ^ configuration parameters
|
||||||
-> Entity ZcashWallet
|
-> Entity ZcashWallet
|
||||||
-> LoggingT IO ()
|
-> IO ()
|
||||||
syncWallet config w = do
|
syncWallet config w = do
|
||||||
startTime <- liftIO getCurrentTime
|
startTime <- liftIO getCurrentTime
|
||||||
let walletDb = c_dbPath config
|
let walletDb = c_dbPath config
|
||||||
let znet = zcashWalletNetwork $ entityVal w
|
let znet = zcashWalletNetwork $ entityVal w
|
||||||
pool <- liftIO $ runNoLoggingT $ initPool walletDb
|
pool <- runNoLoggingT $ initPool walletDb
|
||||||
accs <- liftIO $ runNoLoggingT $ getAccounts pool $ entityKey w
|
accs <- runNoLoggingT $ getAccounts pool $ entityKey w
|
||||||
logDebugN $ "Accounts: " <> T.pack (show accs)
|
addrs <- concat <$> mapM (runNoLoggingT . getAddresses pool . entityKey) accs
|
||||||
addrs <-
|
|
||||||
concat <$>
|
|
||||||
mapM (liftIO . runNoLoggingT . getAddresses pool . entityKey) accs
|
|
||||||
logDebugN $ "addrs: " <> T.pack (show addrs)
|
|
||||||
intAddrs <-
|
intAddrs <-
|
||||||
concat <$>
|
concat <$> mapM (runNoLoggingT . getInternalAddresses pool . entityKey) accs
|
||||||
mapM (liftIO . runNoLoggingT . getInternalAddresses pool . entityKey) accs
|
chainTip <- getMaxBlock pool znet
|
||||||
chainTip <- liftIO $ getMaxBlock pool znet
|
|
||||||
logDebugN $ "chain tip: " <> T.pack (show chainTip)
|
|
||||||
let lastBlock = zcashWalletLastSync $ entityVal w
|
let lastBlock = zcashWalletLastSync $ entityVal w
|
||||||
logDebugN $ "last block: " <> T.pack (show lastBlock)
|
|
||||||
let startBlock =
|
let startBlock =
|
||||||
if lastBlock > 0
|
if lastBlock > 0
|
||||||
then lastBlock
|
then lastBlock
|
||||||
else zcashWalletBirthdayHeight $ entityVal w
|
else zcashWalletBirthdayHeight $ entityVal w
|
||||||
logDebugN $ "start block: " <> T.pack (show startBlock)
|
|
||||||
mapM_ (liftIO . findTransparentNotes pool startBlock znet) addrs
|
mapM_ (liftIO . findTransparentNotes pool startBlock znet) addrs
|
||||||
mapM_ (liftIO . findTransparentNotes pool startBlock znet) intAddrs
|
mapM_ (liftIO . findTransparentNotes pool startBlock znet) intAddrs
|
||||||
mapM_ (liftIO . findTransparentSpends pool . entityKey) accs
|
mapM_ (liftIO . findTransparentSpends pool . entityKey) accs
|
||||||
|
@ -1144,7 +980,7 @@ syncWallet config w = do
|
||||||
mapM
|
mapM
|
||||||
(findOrchardActions config startBlock (zcashWalletNetwork $ entityVal w))
|
(findOrchardActions config startBlock (zcashWalletNetwork $ entityVal w))
|
||||||
accs
|
accs
|
||||||
_ <- liftIO $ updateSaplingWitnesses pool
|
_ <- updateSaplingWitnesses pool
|
||||||
_ <- liftIO $ updateOrchardWitnesses pool
|
_ <- updateOrchardWitnesses pool
|
||||||
_ <- liftIO $ updateWalletSync pool chainTip (entityKey w)
|
_ <- liftIO $ updateWalletSync pool chainTip (entityKey w)
|
||||||
mapM_ (liftIO . runNoLoggingT . getWalletTransactions pool) addrs
|
mapM_ (runNoLoggingT . getWalletTransactions pool) addrs
|
||||||
|
|
326
src/Zenith/DB.hs
326
src/Zenith/DB.hs
|
@ -18,7 +18,7 @@
|
||||||
|
|
||||||
module Zenith.DB where
|
module Zenith.DB where
|
||||||
|
|
||||||
import Control.Exception (SomeException(..), throw, throwIO, try)
|
import Control.Exception (SomeException(..), throwIO, try)
|
||||||
import Control.Monad (when)
|
import Control.Monad (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)
|
||||||
|
@ -69,7 +69,6 @@ import ZcashHaskell.Types
|
||||||
, TransparentAddress(..)
|
, TransparentAddress(..)
|
||||||
, TransparentBundle(..)
|
, TransparentBundle(..)
|
||||||
, TransparentReceiver(..)
|
, TransparentReceiver(..)
|
||||||
, TxError(..)
|
|
||||||
, UnifiedAddress(..)
|
, UnifiedAddress(..)
|
||||||
, ValidAddress(..)
|
, ValidAddress(..)
|
||||||
, ZcashNet(..)
|
, ZcashNet(..)
|
||||||
|
@ -79,7 +78,6 @@ import Zenith.Types
|
||||||
, HexStringDB(..)
|
, HexStringDB(..)
|
||||||
, OrchardSpendingKeyDB(..)
|
, OrchardSpendingKeyDB(..)
|
||||||
, PhraseDB(..)
|
, PhraseDB(..)
|
||||||
, PrivacyPolicy(..)
|
|
||||||
, RseedDB(..)
|
, RseedDB(..)
|
||||||
, SaplingSpendingKeyDB(..)
|
, SaplingSpendingKeyDB(..)
|
||||||
, ScopeDB(..)
|
, ScopeDB(..)
|
||||||
|
@ -204,28 +202,23 @@ share
|
||||||
value Int64
|
value Int64
|
||||||
UniqueOrchSpend tx accId
|
UniqueOrchSpend tx accId
|
||||||
deriving Show Eq
|
deriving Show Eq
|
||||||
ZcashBlock
|
ZcashTransaction
|
||||||
height Int
|
block Int
|
||||||
hash HexStringDB
|
txId HexStringDB
|
||||||
conf Int
|
conf Int
|
||||||
time Int
|
time Int
|
||||||
network ZcashNetDB
|
network ZcashNetDB
|
||||||
UniqueBlock height network
|
UniqueTx block txId network
|
||||||
deriving Show Eq
|
|
||||||
ZcashTransaction
|
|
||||||
blockId ZcashBlockId OnDeleteCascade OnUpdateCascade
|
|
||||||
txId HexStringDB
|
|
||||||
UniqueTx blockId txId
|
|
||||||
deriving Show Eq
|
deriving Show Eq
|
||||||
TransparentNote
|
TransparentNote
|
||||||
tx ZcashTransactionId OnDeleteCascade OnUpdateCascade
|
tx ZcashTransactionId
|
||||||
value Int64
|
value Int64
|
||||||
script BS.ByteString
|
script BS.ByteString
|
||||||
position Int
|
position Int
|
||||||
UniqueTNPos tx position
|
UniqueTNPos tx position
|
||||||
deriving Show Eq
|
deriving Show Eq
|
||||||
TransparentSpend
|
TransparentSpend
|
||||||
tx ZcashTransactionId OnDeleteCascade OnUpdateCascade
|
tx ZcashTransactionId
|
||||||
outPointHash HexStringDB
|
outPointHash HexStringDB
|
||||||
outPointIndex Word64
|
outPointIndex Word64
|
||||||
script BS.ByteString
|
script BS.ByteString
|
||||||
|
@ -234,7 +227,7 @@ share
|
||||||
UniqueTSPos tx position
|
UniqueTSPos tx position
|
||||||
deriving Show Eq
|
deriving Show Eq
|
||||||
OrchAction
|
OrchAction
|
||||||
tx ZcashTransactionId OnDeleteCascade OnUpdateCascade
|
tx ZcashTransactionId
|
||||||
nf HexStringDB
|
nf HexStringDB
|
||||||
rk HexStringDB
|
rk HexStringDB
|
||||||
cmx HexStringDB
|
cmx HexStringDB
|
||||||
|
@ -247,7 +240,7 @@ share
|
||||||
UniqueOAPos tx position
|
UniqueOAPos tx position
|
||||||
deriving Show Eq
|
deriving Show Eq
|
||||||
ShieldOutput
|
ShieldOutput
|
||||||
tx ZcashTransactionId OnDeleteCascade OnUpdateCascade
|
tx ZcashTransactionId
|
||||||
cv HexStringDB
|
cv HexStringDB
|
||||||
cmu HexStringDB
|
cmu HexStringDB
|
||||||
ephKey HexStringDB
|
ephKey HexStringDB
|
||||||
|
@ -258,7 +251,7 @@ share
|
||||||
UniqueSOPos tx position
|
UniqueSOPos tx position
|
||||||
deriving Show Eq
|
deriving Show Eq
|
||||||
ShieldSpend
|
ShieldSpend
|
||||||
tx ZcashTransactionId OnDeleteCascade OnUpdateCascade
|
tx ZcashTransactionId
|
||||||
cv HexStringDB
|
cv HexStringDB
|
||||||
anchor HexStringDB
|
anchor HexStringDB
|
||||||
nullifier HexStringDB
|
nullifier HexStringDB
|
||||||
|
@ -347,7 +340,7 @@ trToZcashNoteAPI pool n = do
|
||||||
return $
|
return $
|
||||||
ZcashNoteAPI
|
ZcashNoteAPI
|
||||||
(getHex $ walletTransactionTxId $ entityVal t') -- tx ID
|
(getHex $ walletTransactionTxId $ entityVal t') -- tx ID
|
||||||
Zenith.Types.TransparentPool -- pool
|
Zenith.Types.Transparent -- pool
|
||||||
(fromIntegral (walletTrNoteValue (entityVal n)) / 100000000.0) -- zec
|
(fromIntegral (walletTrNoteValue (entityVal n)) / 100000000.0) -- zec
|
||||||
(walletTrNoteValue $ entityVal n) -- zats
|
(walletTrNoteValue $ entityVal n) -- zats
|
||||||
"" -- memo
|
"" -- memo
|
||||||
|
@ -368,7 +361,7 @@ sapToZcashNoteAPI pool n = do
|
||||||
return $
|
return $
|
||||||
ZcashNoteAPI
|
ZcashNoteAPI
|
||||||
(getHex $ walletTransactionTxId $ entityVal t') -- tx ID
|
(getHex $ walletTransactionTxId $ entityVal t') -- tx ID
|
||||||
Zenith.Types.SaplingPool -- pool
|
Zenith.Types.Sapling -- pool
|
||||||
(fromIntegral (walletSapNoteValue (entityVal n)) / 100000000.0) -- zec
|
(fromIntegral (walletSapNoteValue (entityVal n)) / 100000000.0) -- zec
|
||||||
(walletSapNoteValue $ entityVal n) -- zats
|
(walletSapNoteValue $ entityVal n) -- zats
|
||||||
(walletSapNoteMemo $ entityVal n) -- memo
|
(walletSapNoteMemo $ entityVal n) -- memo
|
||||||
|
@ -389,7 +382,7 @@ orchToZcashNoteAPI pool n = do
|
||||||
return $
|
return $
|
||||||
ZcashNoteAPI
|
ZcashNoteAPI
|
||||||
(getHex $ walletTransactionTxId $ entityVal t') -- tx ID
|
(getHex $ walletTransactionTxId $ entityVal t') -- tx ID
|
||||||
OrchardPool
|
Orchard
|
||||||
(fromIntegral (walletOrchNoteValue (entityVal n)) / 100000000.0) -- zec
|
(fromIntegral (walletOrchNoteValue (entityVal n)) / 100000000.0) -- zec
|
||||||
(walletOrchNoteValue $ entityVal n) -- zats
|
(walletOrchNoteValue $ entityVal n) -- zats
|
||||||
(walletOrchNoteMemo $ entityVal n) -- memo
|
(walletOrchNoteMemo $ entityVal n) -- memo
|
||||||
|
@ -444,10 +437,10 @@ initDb dbName = do
|
||||||
clearWalletTransactions pool
|
clearWalletTransactions pool
|
||||||
clearWalletData pool
|
clearWalletData pool
|
||||||
m <-
|
m <-
|
||||||
try $ PS.runSqlite dbName $ runMigrationUnsafeQuiet migrateAll :: IO
|
try $ PS.runSqlite dbName $ runMigrationQuiet migrateAll :: IO
|
||||||
(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"
|
||||||
Right _ -> return $ Right True
|
Right _ -> return $ Right True
|
||||||
Right _ -> return $ Right False
|
Right _ -> return $ Right False
|
||||||
|
|
||||||
|
@ -586,13 +579,14 @@ getMaxBlock pool net = do
|
||||||
PS.retryOnBusy $
|
PS.retryOnBusy $
|
||||||
flip PS.runSqlPool pool $ do
|
flip PS.runSqlPool pool $ do
|
||||||
selectOne $ do
|
selectOne $ do
|
||||||
bls <- from $ table @ZcashBlock
|
txs <- from $ table @ZcashTransaction
|
||||||
where_ (bls ^. ZcashBlockNetwork ==. val net)
|
where_ (txs ^. ZcashTransactionBlock >. val 0)
|
||||||
orderBy [desc $ bls ^. ZcashBlockHeight]
|
where_ (txs ^. ZcashTransactionNetwork ==. val net)
|
||||||
pure bls
|
orderBy [desc $ txs ^. ZcashTransactionBlock]
|
||||||
|
pure txs
|
||||||
case b of
|
case b of
|
||||||
Nothing -> return $ -1
|
Nothing -> return $ -1
|
||||||
Just x -> return $ zcashBlockHeight $ entityVal x
|
Just x -> return $ zcashTransactionBlock $ entityVal x
|
||||||
|
|
||||||
-- | Returns a list of addresses associated with the given account
|
-- | Returns a list of addresses associated with the given account
|
||||||
getAddresses ::
|
getAddresses ::
|
||||||
|
@ -683,33 +677,20 @@ saveAddress pool w =
|
||||||
runNoLoggingT $
|
runNoLoggingT $
|
||||||
PS.retryOnBusy $ flip PS.runSqlPool pool $ insertUniqueEntity w
|
PS.retryOnBusy $ flip PS.runSqlPool pool $ insertUniqueEntity w
|
||||||
|
|
||||||
-- | 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 =
|
|
||||||
runNoLoggingT $
|
|
||||||
PS.retryOnBusy $
|
|
||||||
flip PS.runSqlPool pool $ do
|
|
||||||
selectOne $ do
|
|
||||||
bl <- from $ table @ZcashBlock
|
|
||||||
where_ $ bl ^. ZcashBlockHeight ==. val b
|
|
||||||
pure bl
|
|
||||||
|
|
||||||
-- | Save a transaction to the data model
|
-- | Save a transaction to the data model
|
||||||
saveTransaction ::
|
saveTransaction ::
|
||||||
ConnectionPool -- ^ the database path
|
ConnectionPool -- ^ the database path
|
||||||
-> ZcashBlockId -- ^ The block the transaction is in
|
-> Int -- ^ block time
|
||||||
|
-> ZcashNetDB -- ^ the network
|
||||||
-> Transaction -- ^ The transaction to save
|
-> Transaction -- ^ The transaction to save
|
||||||
-> NoLoggingT IO (Key ZcashTransaction)
|
-> NoLoggingT IO (Key ZcashTransaction)
|
||||||
saveTransaction pool bi wt =
|
saveTransaction pool t n wt =
|
||||||
PS.retryOnBusy $
|
PS.retryOnBusy $
|
||||||
flip PS.runSqlPool pool $ do
|
flip PS.runSqlPool pool $ do
|
||||||
let ix = [0 ..]
|
let ix = [0 ..]
|
||||||
w <- insert $ ZcashTransaction bi (HexStringDB $ tx_id wt)
|
w <-
|
||||||
|
insert $
|
||||||
|
ZcashTransaction (tx_height wt) (HexStringDB $ tx_id wt) (tx_conf wt) t n
|
||||||
when (isJust $ tx_transpBundle wt) $ do
|
when (isJust $ tx_transpBundle wt) $ do
|
||||||
_ <-
|
_ <-
|
||||||
insertMany_ $
|
insertMany_ $
|
||||||
|
@ -795,13 +776,10 @@ getZcashTransactions pool b net =
|
||||||
PS.retryOnBusy $
|
PS.retryOnBusy $
|
||||||
flip PS.runSqlPool pool $ do
|
flip PS.runSqlPool pool $ do
|
||||||
select $ do
|
select $ do
|
||||||
(blks :& txs) <-
|
txs <- from $ table @ZcashTransaction
|
||||||
from $ table @ZcashBlock `innerJoin` table @ZcashTransaction `on`
|
where_ (txs ^. ZcashTransactionBlock >. val b)
|
||||||
(\(blks :& txs) ->
|
where_ (txs ^. ZcashTransactionNetwork ==. val (ZcashNetDB net))
|
||||||
blks ^. ZcashBlockId ==. txs ^. ZcashTransactionBlockId)
|
orderBy [asc $ txs ^. ZcashTransactionBlock]
|
||||||
where_ (blks ^. ZcashBlockHeight >. val b)
|
|
||||||
where_ (blks ^. ZcashBlockNetwork ==. val (ZcashNetDB net))
|
|
||||||
orderBy [asc $ blks ^. ZcashBlockHeight]
|
|
||||||
return txs
|
return txs
|
||||||
|
|
||||||
-- ** QR codes
|
-- ** QR codes
|
||||||
|
@ -898,23 +876,14 @@ saveWalletTransaction pool za zt = do
|
||||||
runNoLoggingT $
|
runNoLoggingT $
|
||||||
PS.retryOnBusy $
|
PS.retryOnBusy $
|
||||||
flip PS.runSqlPool pool $ do
|
flip PS.runSqlPool pool $ do
|
||||||
b <-
|
|
||||||
selectOne $ do
|
|
||||||
blks <- from $ table @ZcashBlock
|
|
||||||
where_ (blks ^. ZcashBlockId ==. val (zcashTransactionBlockId zT'))
|
|
||||||
pure blks
|
|
||||||
case b of
|
|
||||||
Nothing ->
|
|
||||||
throw $ userError "invalid block for saving wallet transaction"
|
|
||||||
Just blk -> do
|
|
||||||
t <-
|
t <-
|
||||||
upsert
|
upsert
|
||||||
(WalletTransaction
|
(WalletTransaction
|
||||||
(zcashTransactionTxId zT')
|
(zcashTransactionTxId zT')
|
||||||
za
|
za
|
||||||
(zcashBlockHeight $ entityVal blk)
|
(zcashTransactionBlock zT')
|
||||||
(zcashBlockConf $ entityVal blk)
|
(zcashTransactionConf zT')
|
||||||
(zcashBlockTime $ entityVal blk))
|
(zcashTransactionTime zT'))
|
||||||
[]
|
[]
|
||||||
return $ entityKey t
|
return $ entityKey t
|
||||||
|
|
||||||
|
@ -1007,17 +976,14 @@ findTransparentNotes pool b net t = do
|
||||||
PS.retryOnBusy $
|
PS.retryOnBusy $
|
||||||
flip PS.runSqlPool pool $ do
|
flip PS.runSqlPool pool $ do
|
||||||
select $ do
|
select $ do
|
||||||
(blks :& txs :& tNotes) <-
|
(txs :& tNotes) <-
|
||||||
from $ table @ZcashBlock `innerJoin` table @ZcashTransaction `on`
|
from $ table @ZcashTransaction `innerJoin` table @TransparentNote `on`
|
||||||
(\(blks :& txs) ->
|
(\(txs :& tNotes) ->
|
||||||
blks ^. ZcashBlockId ==. txs ^. ZcashTransactionBlockId) `innerJoin`
|
|
||||||
table @TransparentNote `on`
|
|
||||||
(\(_ :& txs :& tNotes) ->
|
|
||||||
txs ^. ZcashTransactionId ==. tNotes ^. TransparentNoteTx)
|
txs ^. ZcashTransactionId ==. tNotes ^. TransparentNoteTx)
|
||||||
where_ (blks ^. ZcashBlockHeight >. val b)
|
where_ (txs ^. ZcashTransactionBlock >. val b)
|
||||||
where_ (blks ^. ZcashBlockNetwork ==. val net)
|
where_ (txs ^. ZcashTransactionNetwork ==. val net)
|
||||||
where_ (tNotes ^. TransparentNoteScript ==. val s)
|
where_ (tNotes ^. TransparentNoteScript ==. val s)
|
||||||
pure (blks, txs, tNotes)
|
pure (txs, tNotes)
|
||||||
mapM_
|
mapM_
|
||||||
(saveWalletTrNote
|
(saveWalletTrNote
|
||||||
pool
|
pool
|
||||||
|
@ -1033,11 +999,10 @@ saveWalletTrNote ::
|
||||||
-> Scope
|
-> Scope
|
||||||
-> ZcashAccountId
|
-> ZcashAccountId
|
||||||
-> WalletAddressId
|
-> WalletAddressId
|
||||||
-> (Entity ZcashBlock, Entity ZcashTransaction, Entity TransparentNote)
|
-> (Entity ZcashTransaction, Entity TransparentNote)
|
||||||
-> IO ()
|
-> IO ()
|
||||||
saveWalletTrNote pool ch za wa (blk, zt, tn) = do
|
saveWalletTrNote pool ch za wa (zt, tn) = do
|
||||||
let zT' = entityVal zt
|
let zT' = entityVal zt
|
||||||
let b = entityVal blk
|
|
||||||
runNoLoggingT $
|
runNoLoggingT $
|
||||||
PS.retryOnBusy $
|
PS.retryOnBusy $
|
||||||
flip PS.runSqlPool pool $ do
|
flip PS.runSqlPool pool $ do
|
||||||
|
@ -1046,9 +1011,9 @@ saveWalletTrNote pool ch za wa (blk, zt, tn) = do
|
||||||
(WalletTransaction
|
(WalletTransaction
|
||||||
(zcashTransactionTxId zT')
|
(zcashTransactionTxId zT')
|
||||||
za
|
za
|
||||||
(zcashBlockHeight b)
|
(zcashTransactionBlock zT')
|
||||||
(zcashBlockConf b)
|
(zcashTransactionConf zT')
|
||||||
(zcashBlockTime b))
|
(zcashTransactionTime zT'))
|
||||||
[]
|
[]
|
||||||
insert_ $
|
insert_ $
|
||||||
WalletTrNote
|
WalletTrNote
|
||||||
|
@ -1077,15 +1042,12 @@ getShieldedOutputs pool b net =
|
||||||
PS.retryOnBusy $
|
PS.retryOnBusy $
|
||||||
flip PS.runSqlPool pool $ do
|
flip PS.runSqlPool pool $ do
|
||||||
select $ do
|
select $ do
|
||||||
(blks :& txs :& sOutputs) <-
|
(txs :& sOutputs) <-
|
||||||
from $ table @ZcashBlock `innerJoin` table @ZcashTransaction `on`
|
from $ table @ZcashTransaction `innerJoin` table @ShieldOutput `on`
|
||||||
(\(blks :& txs) ->
|
(\(txs :& sOutputs) ->
|
||||||
blks ^. ZcashBlockId ==. txs ^. ZcashTransactionBlockId) `innerJoin`
|
|
||||||
table @ShieldOutput `on`
|
|
||||||
(\(_ :& txs :& sOutputs) ->
|
|
||||||
txs ^. ZcashTransactionId ==. sOutputs ^. ShieldOutputTx)
|
txs ^. ZcashTransactionId ==. sOutputs ^. ShieldOutputTx)
|
||||||
where_ (blks ^. ZcashBlockHeight >=. val b)
|
where_ (txs ^. ZcashTransactionBlock >=. val b)
|
||||||
where_ (blks ^. ZcashBlockNetwork ==. val net)
|
where_ (txs ^. ZcashTransactionNetwork ==. val net)
|
||||||
orderBy
|
orderBy
|
||||||
[ asc $ txs ^. ZcashTransactionId
|
[ asc $ txs ^. ZcashTransactionId
|
||||||
, asc $ sOutputs ^. ShieldOutputPosition
|
, asc $ sOutputs ^. ShieldOutputPosition
|
||||||
|
@ -1103,15 +1065,12 @@ getOrchardActions pool b net =
|
||||||
PS.retryOnBusy $
|
PS.retryOnBusy $
|
||||||
flip PS.runSqlPool pool $ do
|
flip PS.runSqlPool pool $ do
|
||||||
select $ do
|
select $ do
|
||||||
(blks :& txs :& oActions) <-
|
(txs :& oActions) <-
|
||||||
from $ table @ZcashBlock `innerJoin` table @ZcashTransaction `on`
|
from $ table @ZcashTransaction `innerJoin` table @OrchAction `on`
|
||||||
(\(blks :& txs) ->
|
(\(txs :& oActions) ->
|
||||||
blks ^. ZcashBlockId ==. txs ^. ZcashTransactionBlockId) `innerJoin`
|
|
||||||
table @OrchAction `on`
|
|
||||||
(\(_ :& txs :& oActions) ->
|
|
||||||
txs ^. ZcashTransactionId ==. oActions ^. OrchActionTx)
|
txs ^. ZcashTransactionId ==. oActions ^. OrchActionTx)
|
||||||
where_ (blks ^. ZcashBlockHeight >=. val b)
|
where_ (txs ^. ZcashTransactionBlock >=. val b)
|
||||||
where_ (blks ^. ZcashBlockNetwork ==. val net)
|
where_ (txs ^. ZcashTransactionNetwork ==. val net)
|
||||||
orderBy
|
orderBy
|
||||||
[asc $ txs ^. ZcashTransactionId, asc $ oActions ^. OrchActionPosition]
|
[asc $ txs ^. ZcashTransactionId, asc $ oActions ^. OrchActionPosition]
|
||||||
pure (txs, oActions)
|
pure (txs, oActions)
|
||||||
|
@ -1611,24 +1570,10 @@ getOrchardCmxs pool zt = do
|
||||||
getMaxOrchardNote :: Pool SqlBackend -> IO OrchActionId
|
getMaxOrchardNote :: Pool SqlBackend -> IO OrchActionId
|
||||||
getMaxOrchardNote pool = do
|
getMaxOrchardNote pool = do
|
||||||
flip PS.runSqlPool pool $ do
|
flip PS.runSqlPool pool $ do
|
||||||
maxBlock <-
|
|
||||||
selectOne $ do
|
|
||||||
blks <- from $ table @ZcashBlock
|
|
||||||
where_ $ blks ^. ZcashBlockHeight >. val 0
|
|
||||||
pure $ blks ^. ZcashBlockHeight
|
|
||||||
case maxBlock of
|
|
||||||
Nothing -> return $ toSqlKey 0
|
|
||||||
Just (Value mb) -> do
|
|
||||||
x <-
|
x <-
|
||||||
selectOne $ do
|
selectOne $ do
|
||||||
(blks :& txs :& n) <-
|
n <- from $ table @OrchAction
|
||||||
from $ table @ZcashBlock `innerJoin` table @ZcashTransaction `on`
|
where_ (n ^. OrchActionId >. val (toSqlKey 0))
|
||||||
(\(blks :& txs) ->
|
|
||||||
blks ^. ZcashBlockId ==. txs ^. ZcashTransactionBlockId) `innerJoin`
|
|
||||||
table @OrchAction `on`
|
|
||||||
(\(_ :& txs :& n) ->
|
|
||||||
txs ^. ZcashTransactionId ==. n ^. OrchActionTx)
|
|
||||||
where_ (blks ^. ZcashBlockHeight <=. val (mb - 5))
|
|
||||||
orderBy [desc $ n ^. OrchActionId]
|
orderBy [desc $ n ^. OrchActionId]
|
||||||
pure (n ^. OrchActionId)
|
pure (n ^. OrchActionId)
|
||||||
case x of
|
case x of
|
||||||
|
@ -1695,22 +1640,14 @@ upsertWalTx ::
|
||||||
=> ZcashTransaction
|
=> ZcashTransaction
|
||||||
-> ZcashAccountId
|
-> ZcashAccountId
|
||||||
-> SqlPersistT m (Entity WalletTransaction)
|
-> SqlPersistT m (Entity WalletTransaction)
|
||||||
upsertWalTx zt za = do
|
upsertWalTx zt za =
|
||||||
blk <-
|
|
||||||
selectOne $ do
|
|
||||||
blks <- from $ table @ZcashBlock
|
|
||||||
where_ (blks ^. ZcashBlockId ==. val (zcashTransactionBlockId zt))
|
|
||||||
pure blks
|
|
||||||
case blk of
|
|
||||||
Nothing -> throw $ userError "Invalid block for transaction"
|
|
||||||
Just b ->
|
|
||||||
upsert
|
upsert
|
||||||
(WalletTransaction
|
(WalletTransaction
|
||||||
(zcashTransactionTxId zt)
|
(zcashTransactionTxId zt)
|
||||||
za
|
za
|
||||||
(zcashBlockHeight $ entityVal b)
|
(zcashTransactionBlock zt)
|
||||||
(zcashBlockConf $ entityVal b)
|
(zcashTransactionConf zt)
|
||||||
(zcashBlockTime $ entityVal b))
|
(zcashTransactionTime zt))
|
||||||
[]
|
[]
|
||||||
|
|
||||||
getSaplingOutIndex :: ConnectionPool -> ShieldOutputId -> IO Int
|
getSaplingOutIndex :: ConnectionPool -> ShieldOutputId -> IO Int
|
||||||
|
@ -1864,9 +1801,6 @@ clearWalletData pool = do
|
||||||
delete $ do
|
delete $ do
|
||||||
_ <- from $ table @ZcashTransaction
|
_ <- from $ table @ZcashTransaction
|
||||||
return ()
|
return ()
|
||||||
delete $ do
|
|
||||||
_ <- from $ table @ZcashBlock
|
|
||||||
return ()
|
|
||||||
|
|
||||||
getWalletUnspentTrNotes ::
|
getWalletUnspentTrNotes ::
|
||||||
ConnectionPool -> ZcashAccountId -> IO [Entity WalletTrNote]
|
ConnectionPool -> ZcashAccountId -> IO [Entity WalletTrNote]
|
||||||
|
@ -2048,130 +1982,6 @@ selectUnspentNotes pool za amt = do
|
||||||
, n : snd (checkOrchard (x - walletOrchNoteValue (entityVal n)) ns))
|
, n : snd (checkOrchard (x - walletOrchNoteValue (entityVal n)) ns))
|
||||||
else (0, [n])
|
else (0, [n])
|
||||||
|
|
||||||
selectUnspentNotesV2 ::
|
|
||||||
ConnectionPool
|
|
||||||
-> ZcashAccountId
|
|
||||||
-> Integer
|
|
||||||
-> Int
|
|
||||||
-> PrivacyPolicy
|
|
||||||
-> IO
|
|
||||||
(Either
|
|
||||||
TxError
|
|
||||||
( [Entity WalletTrNote]
|
|
||||||
, [Entity WalletSapNote]
|
|
||||||
, [Entity WalletOrchNote]))
|
|
||||||
selectUnspentNotesV2 pool za amt recv policy = do
|
|
||||||
case policy of
|
|
||||||
Full ->
|
|
||||||
case recv of
|
|
||||||
4 -> do
|
|
||||||
orchNotes <- getWalletUnspentOrchNotes pool za
|
|
||||||
let (a1, oList) = checkOrchard (fromIntegral amt) orchNotes
|
|
||||||
if a1 > 0
|
|
||||||
then return $
|
|
||||||
Left $ PrivacyPolicyError "Not enough notes for Full privacy"
|
|
||||||
else return $ Right ([], [], oList)
|
|
||||||
3 -> do
|
|
||||||
sapNotes <- getWalletUnspentSapNotes pool za
|
|
||||||
let (a2, sList) = checkSapling (fromIntegral amt) sapNotes
|
|
||||||
if a2 > 0
|
|
||||||
then return $
|
|
||||||
Left $ PrivacyPolicyError "Not enough notes for Full privacy"
|
|
||||||
else return $ Right ([], sList, [])
|
|
||||||
_anyOther ->
|
|
||||||
return $
|
|
||||||
Left $ PrivacyPolicyError "Receiver not capable of Full privacy"
|
|
||||||
Medium ->
|
|
||||||
if recv > 2
|
|
||||||
then do
|
|
||||||
orchNotes <- getWalletUnspentOrchNotes pool za
|
|
||||||
let (a1, oList) = checkOrchard (fromIntegral amt) orchNotes
|
|
||||||
if a1 > 0
|
|
||||||
then do
|
|
||||||
sapNotes <- getWalletUnspentSapNotes pool za
|
|
||||||
let (a2, sList) = checkSapling a1 sapNotes
|
|
||||||
if a2 > 0
|
|
||||||
then return $
|
|
||||||
Left $
|
|
||||||
PrivacyPolicyError "Not enough notes for Medium privacy"
|
|
||||||
else return $ Right ([], sList, oList)
|
|
||||||
else return $ Right ([], [], oList)
|
|
||||||
else return $
|
|
||||||
Left $ PrivacyPolicyError "Receiver not capable of Medium privacy"
|
|
||||||
Low ->
|
|
||||||
if recv == 0
|
|
||||||
then return $ Left ZHError
|
|
||||||
else do
|
|
||||||
case recv of
|
|
||||||
3 -> do
|
|
||||||
sapNotes <- getWalletUnspentSapNotes pool za
|
|
||||||
let (a1, sList) = checkSapling (fromIntegral amt) sapNotes
|
|
||||||
if a1 > 0
|
|
||||||
then do
|
|
||||||
orchNotes <- getWalletUnspentOrchNotes pool za
|
|
||||||
let (a2, oList) = checkOrchard a1 orchNotes
|
|
||||||
if a2 > 0
|
|
||||||
then return $
|
|
||||||
Left $
|
|
||||||
PrivacyPolicyError "Not enough notes for Low privacy"
|
|
||||||
else return $ Right ([], sList, oList)
|
|
||||||
else return $ Right ([], sList, [])
|
|
||||||
_anyOther -> do
|
|
||||||
orchNotes <- getWalletUnspentOrchNotes pool za
|
|
||||||
let (a1, oList) = checkOrchard (fromIntegral amt) orchNotes
|
|
||||||
if a1 > 0
|
|
||||||
then do
|
|
||||||
sapNotes <- getWalletUnspentSapNotes pool za
|
|
||||||
let (a2, sList) = checkSapling a1 sapNotes
|
|
||||||
if a2 > 0
|
|
||||||
then return $
|
|
||||||
Left $
|
|
||||||
PrivacyPolicyError "Not enough notes for Low privacy"
|
|
||||||
else return $ Right ([], sList, oList)
|
|
||||||
else return $ Right ([], [], oList)
|
|
||||||
None -> do
|
|
||||||
orchNotes <- getWalletUnspentOrchNotes pool za
|
|
||||||
let (a1, oList) = checkOrchard (fromIntegral amt) orchNotes
|
|
||||||
if a1 > 0
|
|
||||||
then do
|
|
||||||
sapNotes <- getWalletUnspentSapNotes pool za
|
|
||||||
let (a2, sList) = checkSapling a1 sapNotes
|
|
||||||
if a2 > 0
|
|
||||||
then do
|
|
||||||
trNotes <- getWalletUnspentTrNotes pool za
|
|
||||||
let (a3, tList) = checkTransparent a2 trNotes
|
|
||||||
if a3 > 0
|
|
||||||
then return $ Left InsufficientFunds
|
|
||||||
else return $ Right (tList, sList, oList)
|
|
||||||
else return $ Right ([], sList, oList)
|
|
||||||
else return $ Right ([], [], oList)
|
|
||||||
where
|
|
||||||
checkTransparent ::
|
|
||||||
Int64 -> [Entity WalletTrNote] -> (Int64, [Entity WalletTrNote])
|
|
||||||
checkTransparent x [] = (x, [])
|
|
||||||
checkTransparent x (n:ns) =
|
|
||||||
if walletTrNoteValue (entityVal n) < x
|
|
||||||
then ( fst (checkTransparent (x - walletTrNoteValue (entityVal n)) ns)
|
|
||||||
, n :
|
|
||||||
snd (checkTransparent (x - walletTrNoteValue (entityVal n)) ns))
|
|
||||||
else (0, [n])
|
|
||||||
checkSapling ::
|
|
||||||
Int64 -> [Entity WalletSapNote] -> (Int64, [Entity WalletSapNote])
|
|
||||||
checkSapling x [] = (x, [])
|
|
||||||
checkSapling x (n:ns) =
|
|
||||||
if walletSapNoteValue (entityVal n) < x
|
|
||||||
then ( fst (checkSapling (x - walletSapNoteValue (entityVal n)) ns)
|
|
||||||
, n : snd (checkSapling (x - walletSapNoteValue (entityVal n)) ns))
|
|
||||||
else (0, [n])
|
|
||||||
checkOrchard ::
|
|
||||||
Int64 -> [Entity WalletOrchNote] -> (Int64, [Entity WalletOrchNote])
|
|
||||||
checkOrchard x [] = (x, [])
|
|
||||||
checkOrchard x (n:ns) =
|
|
||||||
if walletOrchNoteValue (entityVal n) < x
|
|
||||||
then ( fst (checkOrchard (x - walletOrchNoteValue (entityVal n)) ns)
|
|
||||||
, n : snd (checkOrchard (x - walletOrchNoteValue (entityVal n)) ns))
|
|
||||||
else (0, [n])
|
|
||||||
|
|
||||||
getWalletTxId ::
|
getWalletTxId ::
|
||||||
ConnectionPool -> WalletTransactionId -> IO (Maybe (Value HexStringDB))
|
ConnectionPool -> WalletTransactionId -> IO (Maybe (Value HexStringDB))
|
||||||
getWalletTxId pool wId = do
|
getWalletTxId pool wId = do
|
||||||
|
@ -2203,9 +2013,6 @@ saveConfs pool b c = do
|
||||||
update $ \t -> do
|
update $ \t -> do
|
||||||
set t [WalletTransactionConf =. val c]
|
set t [WalletTransactionConf =. val c]
|
||||||
where_ $ t ^. WalletTransactionBlock ==. val b
|
where_ $ t ^. WalletTransactionBlock ==. val b
|
||||||
update $ \bl -> do
|
|
||||||
set bl [ZcashBlockConf =. val c]
|
|
||||||
where_ $ bl ^. ZcashBlockHeight ==. val b
|
|
||||||
|
|
||||||
-- | Helper function to extract a Unified Address from the database
|
-- | Helper function to extract a Unified Address from the database
|
||||||
readUnifiedAddressDB :: WalletAddress -> Maybe UnifiedAddress
|
readUnifiedAddressDB :: WalletAddress -> Maybe UnifiedAddress
|
||||||
|
@ -2298,14 +2105,3 @@ finalizeOperation pool op status result = do
|
||||||
, OperationResult =. val (Just result)
|
, OperationResult =. val (Just result)
|
||||||
]
|
]
|
||||||
where_ (ops ^. OperationId ==. val op)
|
where_ (ops ^. OperationId ==. val op)
|
||||||
|
|
||||||
-- | Rewind the data store to a given block height
|
|
||||||
rewindWalletData :: ConnectionPool -> Int -> IO ()
|
|
||||||
rewindWalletData pool b = do
|
|
||||||
runNoLoggingT $
|
|
||||||
PS.retryOnBusy $
|
|
||||||
flip PS.runSqlPool pool $
|
|
||||||
delete $ do
|
|
||||||
blk <- from $ table @ZcashBlock
|
|
||||||
where_ $ blk ^. ZcashBlockHeight >=. val b
|
|
||||||
clearWalletTransactions pool
|
|
||||||
|
|
|
@ -10,7 +10,7 @@ import Codec.QRCode
|
||||||
import Codec.QRCode.JuicyPixels
|
import Codec.QRCode.JuicyPixels
|
||||||
import Control.Concurrent (threadDelay)
|
import Control.Concurrent (threadDelay)
|
||||||
import Control.Exception (throwIO, try)
|
import Control.Exception (throwIO, try)
|
||||||
import Control.Monad (unless, when)
|
import Control.Monad (when)
|
||||||
import Control.Monad.IO.Class (liftIO)
|
import Control.Monad.IO.Class (liftIO)
|
||||||
import Control.Monad.Logger (runFileLoggingT, runNoLoggingT)
|
import Control.Monad.Logger (runFileLoggingT, runNoLoggingT)
|
||||||
import Data.Aeson
|
import Data.Aeson
|
||||||
|
@ -47,19 +47,20 @@ import ZcashHaskell.Utils (getBlockTime, makeZebraCall)
|
||||||
import Zenith.Core
|
import Zenith.Core
|
||||||
import Zenith.DB
|
import Zenith.DB
|
||||||
import Zenith.GUI.Theme
|
import Zenith.GUI.Theme
|
||||||
import Zenith.Scanner (checkIntegrity, processTx, rescanZebra, updateConfs)
|
import Zenith.Scanner (processTx, rescanZebra, updateConfs)
|
||||||
import Zenith.Types hiding (ZcashAddress(..))
|
import Zenith.Types hiding (ZcashAddress(..))
|
||||||
import Zenith.Utils
|
import Zenith.Utils
|
||||||
( displayAmount
|
( displayAmount
|
||||||
|
, getZenithPath
|
||||||
|
, isEmpty
|
||||||
, isRecipientValid
|
, isRecipientValid
|
||||||
, isRecipientValidGUI
|
|
||||||
, isZecAddressValid
|
|
||||||
, isValidString
|
, isValidString
|
||||||
, jsonNumber
|
, jsonNumber
|
||||||
, padWithZero
|
, padWithZero
|
||||||
, parseAddressUA
|
, parseAddress
|
||||||
, showAddress
|
, showAddress
|
||||||
, validBarValue
|
, validBarValue
|
||||||
|
, validateAddressBool
|
||||||
)
|
)
|
||||||
|
|
||||||
data AppEvent
|
data AppEvent
|
||||||
|
@ -115,6 +116,7 @@ data AppEvent
|
||||||
| CheckValidAddress !T.Text
|
| CheckValidAddress !T.Text
|
||||||
| CheckValidDescrip !T.Text
|
| CheckValidDescrip !T.Text
|
||||||
| SaveNewABEntry
|
| SaveNewABEntry
|
||||||
|
| SaveABDescription !T.Text
|
||||||
| UpdateABEntry !T.Text !T.Text
|
| UpdateABEntry !T.Text !T.Text
|
||||||
| CloseUpdABEntry
|
| CloseUpdABEntry
|
||||||
| ShowMessage !T.Text
|
| ShowMessage !T.Text
|
||||||
|
@ -123,7 +125,6 @@ data AppEvent
|
||||||
| CopyABAdress !T.Text
|
| CopyABAdress !T.Text
|
||||||
| DeleteABEntry !T.Text
|
| DeleteABEntry !T.Text
|
||||||
| UpdateABDescrip !T.Text !T.Text
|
| UpdateABDescrip !T.Text !T.Text
|
||||||
| ResetRecipientValid
|
|
||||||
deriving (Eq, Show)
|
deriving (Eq, Show)
|
||||||
|
|
||||||
data AppModel = AppModel
|
data AppModel = AppModel
|
||||||
|
@ -417,43 +418,43 @@ buildUI wenv model = widgetTree
|
||||||
[ vstack
|
[ vstack
|
||||||
[ tooltip "Unified" $
|
[ tooltip "Unified" $
|
||||||
box_
|
box_
|
||||||
[onClick (SetPool OrchardPool)]
|
[onClick (SetPool Orchard)]
|
||||||
(remixIcon remixShieldCheckFill `styleBasic`
|
(remixIcon remixShieldCheckFill `styleBasic`
|
||||||
[ textSize 14
|
[ textSize 14
|
||||||
, padding 4
|
, padding 4
|
||||||
, styleIf
|
, styleIf
|
||||||
(model ^. selPool == OrchardPool)
|
(model ^. selPool == Orchard)
|
||||||
(bgColor btnColor)
|
(bgColor btnColor)
|
||||||
, styleIf
|
, styleIf
|
||||||
(model ^. selPool == OrchardPool)
|
(model ^. selPool == Orchard)
|
||||||
(textColor white)
|
(textColor white)
|
||||||
])
|
])
|
||||||
, filler
|
, filler
|
||||||
, tooltip "Legacy Shielded" $
|
, tooltip "Legacy Shielded" $
|
||||||
box_
|
box_
|
||||||
[onClick (SetPool SaplingPool)]
|
[onClick (SetPool Sapling)]
|
||||||
(remixIcon remixShieldLine `styleBasic`
|
(remixIcon remixShieldLine `styleBasic`
|
||||||
[ textSize 14
|
[ textSize 14
|
||||||
, padding 4
|
, padding 4
|
||||||
, styleIf
|
, styleIf
|
||||||
(model ^. selPool == SaplingPool)
|
(model ^. selPool == Sapling)
|
||||||
(bgColor btnColor)
|
(bgColor btnColor)
|
||||||
, styleIf
|
, styleIf
|
||||||
(model ^. selPool == SaplingPool)
|
(model ^. selPool == Sapling)
|
||||||
(textColor white)
|
(textColor white)
|
||||||
])
|
])
|
||||||
, filler
|
, filler
|
||||||
, tooltip "Transparent" $
|
, tooltip "Transparent" $
|
||||||
box_
|
box_
|
||||||
[onClick (SetPool TransparentPool)]
|
[onClick (SetPool Transparent)]
|
||||||
(remixIcon remixEyeLine `styleBasic`
|
(remixIcon remixEyeLine `styleBasic`
|
||||||
[ textSize 14
|
[ textSize 14
|
||||||
, padding 4
|
, padding 4
|
||||||
, styleIf
|
, styleIf
|
||||||
(model ^. selPool == TransparentPool)
|
(model ^. selPool == Transparent)
|
||||||
(bgColor btnColor)
|
(bgColor btnColor)
|
||||||
, styleIf
|
, styleIf
|
||||||
(model ^. selPool == TransparentPool)
|
(model ^. selPool == Transparent)
|
||||||
(textColor white)
|
(textColor white)
|
||||||
])
|
])
|
||||||
] `styleBasic`
|
] `styleBasic`
|
||||||
|
@ -466,10 +467,10 @@ buildUI wenv model = widgetTree
|
||||||
(hstack
|
(hstack
|
||||||
[ label
|
[ label
|
||||||
(case model ^. selPool of
|
(case model ^. selPool of
|
||||||
OrchardPool -> "Unified"
|
Orchard -> "Unified"
|
||||||
SaplingPool -> "Legacy Shielded"
|
Sapling -> "Legacy Shielded"
|
||||||
TransparentPool -> "Transparent"
|
Transparent -> "Transparent"
|
||||||
SproutPool -> "Unknown") `styleBasic`
|
Sprout -> "Unknown") `styleBasic`
|
||||||
[textColor white]
|
[textColor white]
|
||||||
, remixIcon remixFileCopyFill `styleBasic`
|
, remixIcon remixFileCopyFill `styleBasic`
|
||||||
[textSize 14, padding 4, textColor white]
|
[textSize 14, padding 4, textColor white]
|
||||||
|
@ -605,28 +606,7 @@ buildUI wenv model = widgetTree
|
||||||
, separatorLine `styleBasic` [fgColor btnColor]
|
, separatorLine `styleBasic` [fgColor btnColor]
|
||||||
, spacer
|
, spacer
|
||||||
, hstack
|
, hstack
|
||||||
[
|
[ label "To:" `styleBasic` [width 50]
|
||||||
label "Privacy Level:" `styleBasic` [width 70, textFont "Bold"]
|
|
||||||
, spacer
|
|
||||||
, label "Full " `styleBasic` [width 40]
|
|
||||||
, radio Full privacyChoice
|
|
||||||
, spacer
|
|
||||||
, label "Medium " `styleBasic` [width 40]
|
|
||||||
, radio Medium privacyChoice
|
|
||||||
]
|
|
||||||
, hstack
|
|
||||||
[
|
|
||||||
label " " `styleBasic` [width 70, textFont "Bold"]
|
|
||||||
, spacer
|
|
||||||
, label "Low " `styleBasic` [width 40]
|
|
||||||
, radio Low privacyChoice
|
|
||||||
, spacer
|
|
||||||
, label "None " `styleBasic` [width 40]
|
|
||||||
, radio None privacyChoice
|
|
||||||
]
|
|
||||||
, spacer
|
|
||||||
, hstack
|
|
||||||
[ label "To:" `styleBasic` [width 50, textFont "Bold"]
|
|
||||||
, spacer
|
, spacer
|
||||||
, textField_ sendRecipient [onChange CheckRecipient] `styleBasic`
|
, textField_ sendRecipient [onChange CheckRecipient] `styleBasic`
|
||||||
[ width 150
|
[ width 150
|
||||||
|
@ -636,7 +616,7 @@ buildUI wenv model = widgetTree
|
||||||
]
|
]
|
||||||
]
|
]
|
||||||
, hstack
|
, hstack
|
||||||
[ label "Amount:" `styleBasic` [width 50, textFont "Bold"]
|
[ label "Amount:" `styleBasic` [width 50]
|
||||||
, spacer
|
, spacer
|
||||||
, numericField_
|
, numericField_
|
||||||
sendAmount
|
sendAmount
|
||||||
|
@ -654,13 +634,35 @@ buildUI wenv model = widgetTree
|
||||||
]
|
]
|
||||||
]
|
]
|
||||||
, hstack
|
, hstack
|
||||||
[ label "Memo:" `styleBasic` [width 50, textFont "Bold"]
|
[ label "Memo:" `styleBasic` [width 50]
|
||||||
, spacer
|
, spacer
|
||||||
, textArea sendMemo `styleBasic`
|
, textArea sendMemo `styleBasic`
|
||||||
[width 150, height 40]
|
[width 150, height 40]
|
||||||
]
|
]
|
||||||
, spacer
|
, spacer
|
||||||
-- Radio button group for privacy level
|
-- Radio button group for privacy level
|
||||||
|
, hstack
|
||||||
|
[
|
||||||
|
label "Privacy Level:" `styleBasic` [width 70]
|
||||||
|
, spacer
|
||||||
|
, label "None " `styleBasic` [width 40]
|
||||||
|
, radio None privacyChoice
|
||||||
|
, spacer
|
||||||
|
, label "Low " `styleBasic` [width 40]
|
||||||
|
, radio Low privacyChoice
|
||||||
|
|
||||||
|
]
|
||||||
|
, hstack
|
||||||
|
[
|
||||||
|
label " " `styleBasic` [width 70]
|
||||||
|
, spacer
|
||||||
|
, label "Medium " `styleBasic` [width 40]
|
||||||
|
, radio Medium privacyChoice
|
||||||
|
, spacer
|
||||||
|
, label "Full " `styleBasic` [width 40]
|
||||||
|
, radio Full privacyChoice
|
||||||
|
]
|
||||||
|
, spacer
|
||||||
, box_
|
, box_
|
||||||
[alignMiddle]
|
[alignMiddle]
|
||||||
(hstack
|
(hstack
|
||||||
|
@ -970,9 +972,9 @@ generateQRCodes config = do
|
||||||
if not (null s)
|
if not (null s)
|
||||||
then return ()
|
then return ()
|
||||||
else do
|
else do
|
||||||
generateOneQr pool OrchardPool wAddr
|
generateOneQr pool Orchard wAddr
|
||||||
generateOneQr pool SaplingPool wAddr
|
generateOneQr pool Sapling wAddr
|
||||||
generateOneQr pool TransparentPool wAddr
|
generateOneQr pool Transparent wAddr
|
||||||
generateOneQr ::
|
generateOneQr ::
|
||||||
ConnectionPool -> ZcashPool -> Entity WalletAddress -> IO ()
|
ConnectionPool -> ZcashPool -> Entity WalletAddress -> IO ()
|
||||||
generateOneQr p zp wAddr =
|
generateOneQr p zp wAddr =
|
||||||
|
@ -1007,7 +1009,7 @@ generateQRCodes config = do
|
||||||
dispAddr :: ZcashPool -> WalletAddress -> Maybe T.Text
|
dispAddr :: ZcashPool -> WalletAddress -> Maybe T.Text
|
||||||
dispAddr zp w =
|
dispAddr zp w =
|
||||||
case zp of
|
case zp of
|
||||||
TransparentPool ->
|
Transparent ->
|
||||||
T.append "zcash:" .
|
T.append "zcash:" .
|
||||||
encodeTransparentReceiver
|
encodeTransparentReceiver
|
||||||
(maybe
|
(maybe
|
||||||
|
@ -1019,12 +1021,11 @@ generateQRCodes config = do
|
||||||
(t_rec =<<
|
(t_rec =<<
|
||||||
(isValidUnifiedAddress . E.encodeUtf8 . getUA . walletAddressUAddress)
|
(isValidUnifiedAddress . E.encodeUtf8 . getUA . walletAddressUAddress)
|
||||||
w)
|
w)
|
||||||
SaplingPool ->
|
Sapling ->
|
||||||
T.append "zcash:" <$>
|
T.append "zcash:" <$>
|
||||||
(getSaplingFromUA . E.encodeUtf8 . getUA . walletAddressUAddress) w
|
(getSaplingFromUA . E.encodeUtf8 . getUA . walletAddressUAddress) w
|
||||||
OrchardPool ->
|
Orchard -> Just $ (T.append "zcash:" . getUA . walletAddressUAddress) w
|
||||||
Just $ (T.append "zcash:" . getUA . walletAddressUAddress) w
|
Sprout -> Nothing
|
||||||
SproutPool -> Nothing
|
|
||||||
|
|
||||||
handleEvent ::
|
handleEvent ::
|
||||||
WidgetEnv AppModel AppEvent
|
WidgetEnv AppModel AppEvent
|
||||||
|
@ -1079,7 +1080,7 @@ 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]
|
||||||
SendTx ->
|
SendTx ->
|
||||||
case currentAccount of
|
case currentAccount of
|
||||||
Nothing -> [Event $ ShowError "No account available", Event CancelSend]
|
Nothing -> [Event $ ShowError "No account available", Event CancelSend]
|
||||||
|
@ -1138,7 +1139,7 @@ handleEvent wenv node model evt =
|
||||||
Just wAddr -> getUserTx dbPool $ entityKey wAddr
|
Just wAddr -> getUserTx dbPool $ entityKey wAddr
|
||||||
]
|
]
|
||||||
SwitchQr q -> [Model $ model & qrCodeWidget .~ q]
|
SwitchQr q -> [Model $ model & qrCodeWidget .~ q]
|
||||||
SwitchAddr i -> [Model $ model & selAddr .~ i, Event $ SetPool OrchardPool]
|
SwitchAddr i -> [Model $ model & selAddr .~ i, Event $ SetPool Orchard]
|
||||||
SwitchAcc i ->
|
SwitchAcc i ->
|
||||||
[ Model $ model & selAcc .~ i
|
[ Model $ model & selAcc .~ i
|
||||||
, Task $
|
, Task $
|
||||||
|
@ -1156,7 +1157,7 @@ handleEvent wenv node model evt =
|
||||||
b <- getBalance dbPool $ entityKey acc
|
b <- getBalance dbPool $ entityKey acc
|
||||||
u <- getUnconfirmedBalance dbPool $ entityKey acc
|
u <- getUnconfirmedBalance dbPool $ entityKey acc
|
||||||
return (b, u)
|
return (b, u)
|
||||||
, Event $ SetPool OrchardPool
|
, Event $ SetPool Orchard
|
||||||
]
|
]
|
||||||
SwitchWal i ->
|
SwitchWal i ->
|
||||||
[ Model $ model & selWallet .~ i & selAcc .~ 0 & selAddr .~ 0
|
[ Model $ model & selWallet .~ i & selAcc .~ 0 & selAddr .~ 0
|
||||||
|
@ -1179,15 +1180,14 @@ handleEvent wenv node model evt =
|
||||||
, setClipboardData $
|
, setClipboardData $
|
||||||
ClipboardText $
|
ClipboardText $
|
||||||
case model ^. selPool of
|
case model ^. selPool of
|
||||||
OrchardPool ->
|
Orchard -> maybe "None" (getUA . walletAddressUAddress . entityVal) a
|
||||||
maybe "None" (getUA . walletAddressUAddress . entityVal) a
|
Sapling ->
|
||||||
SaplingPool ->
|
|
||||||
fromMaybe "None" $
|
fromMaybe "None" $
|
||||||
(getSaplingFromUA .
|
(getSaplingFromUA .
|
||||||
E.encodeUtf8 . getUA . walletAddressUAddress . entityVal) =<<
|
E.encodeUtf8 . getUA . walletAddressUAddress . entityVal) =<<
|
||||||
a
|
a
|
||||||
SproutPool -> "None"
|
Sprout -> "None"
|
||||||
TransparentPool ->
|
Transparent ->
|
||||||
maybe "None" (encodeTransparentReceiver (model ^. network)) $
|
maybe "None" (encodeTransparentReceiver (model ^. network)) $
|
||||||
t_rec =<<
|
t_rec =<<
|
||||||
(isValidUnifiedAddress .
|
(isValidUnifiedAddress .
|
||||||
|
@ -1210,7 +1210,7 @@ handleEvent wenv node model evt =
|
||||||
if not (null a)
|
if not (null a)
|
||||||
then [ Model $ model & addresses .~ a
|
then [ Model $ model & addresses .~ a
|
||||||
, Event $ SwitchAddr $ model ^. selAddr
|
, Event $ SwitchAddr $ model ^. selAddr
|
||||||
, Event $ SetPool OrchardPool
|
, Event $ SetPool Orchard
|
||||||
]
|
]
|
||||||
else [Event $ NewAddress currentAccount]
|
else [Event $ NewAddress currentAccount]
|
||||||
LoadAccs a ->
|
LoadAccs a ->
|
||||||
|
@ -1248,7 +1248,6 @@ handleEvent wenv node model evt =
|
||||||
case currentWallet of
|
case currentWallet of
|
||||||
Nothing -> return $ ShowError "No wallet available"
|
Nothing -> return $ ShowError "No wallet available"
|
||||||
Just cW -> do
|
Just cW -> do
|
||||||
runFileLoggingT "zenith.log" $
|
|
||||||
syncWallet (model ^. configuration) cW
|
syncWallet (model ^. configuration) cW
|
||||||
pool <-
|
pool <-
|
||||||
runNoLoggingT $
|
runNoLoggingT $
|
||||||
|
@ -1262,10 +1261,7 @@ handleEvent wenv node model evt =
|
||||||
("Wallet Sync: " <>
|
("Wallet Sync: " <>
|
||||||
T.pack (printf "%.2f%%" (model ^. barValue * 100)))
|
T.pack (printf "%.2f%%" (model ^. barValue * 100)))
|
||||||
]
|
]
|
||||||
ResetRecipientValid -> [Model $ model & recipientValid .~ False]
|
CheckRecipient a -> [Model $ model & recipientValid .~ isRecipientValid a]
|
||||||
CheckRecipient a -> [Model $
|
|
||||||
model & recipientValid .~ isRecipientValidGUI (model ^.privacyChoice) a ]
|
|
||||||
-- model & recipientValid .~ ((model ^. privacyChoice) == Low) ]
|
|
||||||
CheckAmount i ->
|
CheckAmount i ->
|
||||||
[ Model $
|
[ Model $
|
||||||
model & amountValid .~
|
model & amountValid .~
|
||||||
|
@ -1276,7 +1272,7 @@ handleEvent wenv node model evt =
|
||||||
-- | Address Book Events
|
-- | Address Book Events
|
||||||
-- |
|
-- |
|
||||||
CheckValidAddress a ->
|
CheckValidAddress a ->
|
||||||
[Model $ model & abAddressValid .~ isZecAddressValid a]
|
[Model $ model & abAddressValid .~ isRecipientValid a]
|
||||||
CheckValidDescrip a -> [Model $ model & abDescripValid .~ isValidString a]
|
CheckValidDescrip a -> [Model $ model & abDescripValid .~ isValidString a]
|
||||||
ShowAdrBook ->
|
ShowAdrBook ->
|
||||||
if null (model ^. abaddressList)
|
if null (model ^. abaddressList)
|
||||||
|
@ -1471,12 +1467,11 @@ 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
|
let sb = max dbBlock b
|
||||||
unless (chkBlock == dbBlock) $ rewindWalletData pool chkBlock
|
confUp <- try $ updateConfs zHost zPort pool :: IO (Either IOError ())
|
||||||
let sb =
|
case confUp of
|
||||||
if chkBlock == dbBlock
|
Left _e0 -> sendMsg (ShowError "Failed to update unconfirmed transactions")
|
||||||
then max dbBlock b
|
Right _ -> do
|
||||||
else max chkBlock b
|
|
||||||
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
|
||||||
|
@ -1486,10 +1481,6 @@ scanZebra dbPath zHost zPort net sendMsg = do
|
||||||
let step = (1.0 :: Float) / fromIntegral (length bList)
|
let step = (1.0 :: Float) / fromIntegral (length bList)
|
||||||
mapM_ (processBlock pool step) bList
|
mapM_ (processBlock pool step) bList
|
||||||
else sendMsg (SyncVal 1.0)
|
else sendMsg (SyncVal 1.0)
|
||||||
confUp <- try $ updateConfs zHost zPort pool :: IO (Either IOError ())
|
|
||||||
case confUp of
|
|
||||||
Left _e0 -> sendMsg (ShowError "Failed to update unconfirmed transactions")
|
|
||||||
Right _ -> return ()
|
|
||||||
where
|
where
|
||||||
processBlock :: ConnectionPool -> Float -> Int -> IO ()
|
processBlock :: ConnectionPool -> Float -> Int -> IO ()
|
||||||
processBlock pool step bl = do
|
processBlock pool step bl = do
|
||||||
|
@ -1514,16 +1505,16 @@ scanZebra dbPath zHost zPort net sendMsg = do
|
||||||
Left e2 -> sendMsg (ShowError $ showt e2)
|
Left e2 -> sendMsg (ShowError $ showt e2)
|
||||||
Right hb -> do
|
Right hb -> do
|
||||||
let blockTime = getBlockTime hb
|
let blockTime = getBlockTime hb
|
||||||
bi <-
|
mapM_ (processTx zHost zPort blockTime pool (ZcashNetDB net)) $
|
||||||
saveBlock pool $
|
bl_txs $ addTime blk blockTime
|
||||||
ZcashBlock
|
|
||||||
(fromIntegral $ bl_height blk)
|
|
||||||
(HexStringDB $ bl_hash blk)
|
|
||||||
(fromIntegral $ bl_confirmations blk)
|
|
||||||
blockTime
|
|
||||||
(ZcashNetDB net)
|
|
||||||
mapM_ (processTx zHost zPort bi pool) $ bl_txs blk
|
|
||||||
sendMsg (SyncVal step)
|
sendMsg (SyncVal step)
|
||||||
|
addTime :: BlockResponse -> Int -> BlockResponse
|
||||||
|
addTime bl t =
|
||||||
|
BlockResponse
|
||||||
|
(bl_confirmations bl)
|
||||||
|
(bl_height bl)
|
||||||
|
(fromIntegral t)
|
||||||
|
(bl_txs bl)
|
||||||
|
|
||||||
sendTransaction ::
|
sendTransaction ::
|
||||||
Config
|
Config
|
||||||
|
@ -1537,7 +1528,7 @@ sendTransaction ::
|
||||||
-> IO ()
|
-> IO ()
|
||||||
sendTransaction config znet accId bl amt ua memo sendMsg = do
|
sendTransaction config znet accId bl amt ua memo sendMsg = do
|
||||||
sendMsg $ ShowModal "Preparing transaction..."
|
sendMsg $ ShowModal "Preparing transaction..."
|
||||||
case parseAddressUA ua znet of
|
case parseAddress ua znet of
|
||||||
Nothing -> sendMsg $ ShowError "Incorrect address"
|
Nothing -> sendMsg $ ShowError "Incorrect address"
|
||||||
Just outUA -> do
|
Just outUA -> do
|
||||||
let dbPath = c_dbPath config
|
let dbPath = c_dbPath config
|
||||||
|
@ -1615,8 +1606,7 @@ runZenithGUI config = do
|
||||||
else return []
|
else return []
|
||||||
qr <-
|
qr <-
|
||||||
if not (null addrList)
|
if not (null addrList)
|
||||||
then getQrCode pool OrchardPool $
|
then getQrCode pool Orchard $ entityKey $ head addrList
|
||||||
entityKey $ head addrList
|
|
||||||
else return Nothing
|
else return Nothing
|
||||||
bal <-
|
bal <-
|
||||||
if not (null accList)
|
if not (null accList)
|
||||||
|
@ -1645,7 +1635,7 @@ runZenithGUI config = do
|
||||||
(if unconfBal == 0
|
(if unconfBal == 0
|
||||||
then Nothing
|
then Nothing
|
||||||
else Just unconfBal)
|
else Just unconfBal)
|
||||||
OrchardPool
|
Orchard
|
||||||
qr
|
qr
|
||||||
False
|
False
|
||||||
False
|
False
|
||||||
|
@ -1683,7 +1673,7 @@ runZenithGUI config = do
|
||||||
Nothing
|
Nothing
|
||||||
False
|
False
|
||||||
False
|
False
|
||||||
Full
|
None
|
||||||
startApp model handleEvent buildUI (params hD)
|
startApp model handleEvent buildUI (params hD)
|
||||||
Left _e -> print "Zebra not available"
|
Left _e -> print "Zebra not available"
|
||||||
where
|
where
|
||||||
|
|
|
@ -6,13 +6,7 @@ import Control.Concurrent.Async (concurrently_, withAsync)
|
||||||
import Control.Exception (throwIO, try)
|
import Control.Exception (throwIO, try)
|
||||||
import Control.Monad (when)
|
import Control.Monad (when)
|
||||||
import Control.Monad.IO.Class (liftIO)
|
import Control.Monad.IO.Class (liftIO)
|
||||||
import Control.Monad.Logger
|
import Control.Monad.Logger (NoLoggingT, logErrorN, logInfoN, runNoLoggingT)
|
||||||
( NoLoggingT
|
|
||||||
, logErrorN
|
|
||||||
, logInfoN
|
|
||||||
, runFileLoggingT
|
|
||||||
, runNoLoggingT
|
|
||||||
)
|
|
||||||
import Data.Aeson
|
import Data.Aeson
|
||||||
import Data.HexString
|
import Data.HexString
|
||||||
import qualified Data.Text as T
|
import qualified Data.Text as T
|
||||||
|
@ -33,23 +27,19 @@ import ZcashHaskell.Types
|
||||||
import ZcashHaskell.Utils (getBlockTime, makeZebraCall, readZebraTransaction)
|
import ZcashHaskell.Utils (getBlockTime, makeZebraCall, readZebraTransaction)
|
||||||
import Zenith.Core (checkBlockChain, syncWallet)
|
import Zenith.Core (checkBlockChain, syncWallet)
|
||||||
import Zenith.DB
|
import Zenith.DB
|
||||||
( ZcashBlock(..)
|
( clearWalletData
|
||||||
, ZcashBlockId
|
|
||||||
, clearWalletData
|
|
||||||
, clearWalletTransactions
|
, clearWalletTransactions
|
||||||
, getBlock
|
|
||||||
, getMaxBlock
|
, getMaxBlock
|
||||||
, getMinBirthdayHeight
|
, getMinBirthdayHeight
|
||||||
, getUnconfirmedBlocks
|
, getUnconfirmedBlocks
|
||||||
, getWallets
|
, getWallets
|
||||||
, initDb
|
, initDb
|
||||||
, initPool
|
, initPool
|
||||||
, saveBlock
|
|
||||||
, saveConfs
|
, saveConfs
|
||||||
, saveTransaction
|
, saveTransaction
|
||||||
, updateWalletSync
|
, updateWalletSync
|
||||||
)
|
)
|
||||||
import Zenith.Types (Config(..), HexStringDB(..), ZcashNetDB(..))
|
import Zenith.Types (Config(..), ZcashNetDB(..))
|
||||||
import Zenith.Utils (jsonNumber)
|
import Zenith.Utils (jsonNumber)
|
||||||
|
|
||||||
-- | Function to scan the Zcash blockchain through the Zebra node and populate the Zenith database
|
-- | Function to scan the Zcash blockchain through the Zebra node and populate the Zenith database
|
||||||
|
@ -67,8 +57,8 @@ rescanZebra host port dbFilePath = do
|
||||||
Right bStatus -> do
|
Right bStatus -> do
|
||||||
let znet = ZcashNetDB $ zgb_net bStatus
|
let znet = ZcashNetDB $ zgb_net bStatus
|
||||||
pool1 <- runNoLoggingT $ initPool dbFilePath
|
pool1 <- runNoLoggingT $ initPool dbFilePath
|
||||||
{-pool2 <- runNoLoggingT $ initPool dbFilePath-}
|
pool2 <- runNoLoggingT $ initPool dbFilePath
|
||||||
{-pool3 <- runNoLoggingT $ initPool dbFilePath-}
|
pool3 <- runNoLoggingT $ initPool dbFilePath
|
||||||
clearWalletTransactions pool1
|
clearWalletTransactions pool1
|
||||||
clearWalletData pool1
|
clearWalletData pool1
|
||||||
dbBlock <- getMaxBlock pool1 znet
|
dbBlock <- getMaxBlock pool1 znet
|
||||||
|
@ -129,26 +119,28 @@ processBlock host port pool pg net b = do
|
||||||
Left e2 -> liftIO $ throwIO $ userError e2
|
Left e2 -> liftIO $ throwIO $ userError e2
|
||||||
Right hb -> do
|
Right hb -> do
|
||||||
let blockTime = getBlockTime hb
|
let blockTime = getBlockTime hb
|
||||||
bi <-
|
mapM_ (processTx host port blockTime pool net) $
|
||||||
saveBlock pool $
|
bl_txs $ addTime blk blockTime
|
||||||
ZcashBlock
|
|
||||||
(fromIntegral $ bl_height blk)
|
|
||||||
(HexStringDB $ bl_hash blk)
|
|
||||||
(fromIntegral $ bl_confirmations blk)
|
|
||||||
blockTime
|
|
||||||
net
|
|
||||||
mapM_ (processTx host port bi pool) $ bl_txs blk
|
|
||||||
liftIO $ tick pg
|
liftIO $ tick pg
|
||||||
|
where
|
||||||
|
addTime :: BlockResponse -> Int -> BlockResponse
|
||||||
|
addTime bl t =
|
||||||
|
BlockResponse
|
||||||
|
(bl_confirmations bl)
|
||||||
|
(bl_height bl)
|
||||||
|
(fromIntegral t)
|
||||||
|
(bl_txs bl)
|
||||||
|
|
||||||
-- | Function to process a raw transaction
|
-- | Function to process a raw transaction
|
||||||
processTx ::
|
processTx ::
|
||||||
T.Text -- ^ Host name for `zebrad`
|
T.Text -- ^ Host name for `zebrad`
|
||||||
-> Int -- ^ Port for `zebrad`
|
-> Int -- ^ Port for `zebrad`
|
||||||
-> ZcashBlockId -- ^ Block ID
|
-> Int -- ^ Block time
|
||||||
-> ConnectionPool -- ^ DB file path
|
-> ConnectionPool -- ^ DB file path
|
||||||
|
-> ZcashNetDB -- ^ the network
|
||||||
-> HexString -- ^ transaction id
|
-> HexString -- ^ transaction id
|
||||||
-> IO ()
|
-> IO ()
|
||||||
processTx host port bt pool t = do
|
processTx host port bt pool net t = do
|
||||||
r <-
|
r <-
|
||||||
liftIO $
|
liftIO $
|
||||||
makeZebraCall
|
makeZebraCall
|
||||||
|
@ -164,7 +156,7 @@ processTx host port bt pool t = do
|
||||||
Just rzt -> do
|
Just rzt -> do
|
||||||
_ <-
|
_ <-
|
||||||
runNoLoggingT $
|
runNoLoggingT $
|
||||||
saveTransaction pool bt $
|
saveTransaction pool bt net $
|
||||||
Transaction
|
Transaction
|
||||||
t
|
t
|
||||||
(ztr_blockheight rawTx)
|
(ztr_blockheight rawTx)
|
||||||
|
@ -219,35 +211,5 @@ clearSync config = do
|
||||||
w <- getWallets pool $ zgb_net chainInfo
|
w <- getWallets pool $ zgb_net chainInfo
|
||||||
liftIO $ mapM_ (updateWalletSync pool 0 . entityKey) w
|
liftIO $ mapM_ (updateWalletSync pool 0 . entityKey) w
|
||||||
w' <- liftIO $ getWallets pool $ zgb_net chainInfo
|
w' <- liftIO $ getWallets pool $ zgb_net chainInfo
|
||||||
r <- runFileLoggingT "zenith.log" $ mapM (syncWallet config) w'
|
r <- mapM (syncWallet config) w'
|
||||||
liftIO $ print r
|
liftIO $ print r
|
||||||
|
|
||||||
-- | Detect chain re-orgs
|
|
||||||
checkIntegrity ::
|
|
||||||
T.Text -- ^ Database path
|
|
||||||
-> T.Text -- ^ Zebra host
|
|
||||||
-> Int -- ^ Zebra port
|
|
||||||
-> Int -- ^ The block to start the check
|
|
||||||
-> Int -- ^ depth
|
|
||||||
-> IO Int
|
|
||||||
checkIntegrity dbP zHost zPort b d =
|
|
||||||
if b < 1
|
|
||||||
then return 1
|
|
||||||
else do
|
|
||||||
r <-
|
|
||||||
makeZebraCall
|
|
||||||
zHost
|
|
||||||
zPort
|
|
||||||
"getblock"
|
|
||||||
[Data.Aeson.String $ T.pack $ show b, jsonNumber 1]
|
|
||||||
case r of
|
|
||||||
Left e -> throwIO $ userError e
|
|
||||||
Right blk -> do
|
|
||||||
pool <- runNoLoggingT $ initPool dbP
|
|
||||||
dbBlk <- getBlock pool b
|
|
||||||
case dbBlk of
|
|
||||||
Nothing -> throwIO $ userError "Block mismatch, rescan needed"
|
|
||||||
Just dbBlk' ->
|
|
||||||
if bl_hash blk == getHex (zcashBlockHash $ entityVal dbBlk')
|
|
||||||
then return b
|
|
||||||
else checkIntegrity dbP zHost zPort (b - 5 * d) (d + 1)
|
|
||||||
|
|
|
@ -104,10 +104,10 @@ data Config = Config
|
||||||
} deriving (Eq, Prelude.Show)
|
} deriving (Eq, Prelude.Show)
|
||||||
|
|
||||||
data ZcashPool
|
data ZcashPool
|
||||||
= TransparentPool
|
= Transparent
|
||||||
| SproutPool
|
| Sprout
|
||||||
| SaplingPool
|
| Sapling
|
||||||
| OrchardPool
|
| Orchard
|
||||||
deriving (Show, Read, Eq)
|
deriving (Show, Read, Eq)
|
||||||
|
|
||||||
derivePersistField "ZcashPool"
|
derivePersistField "ZcashPool"
|
||||||
|
@ -115,18 +115,18 @@ derivePersistField "ZcashPool"
|
||||||
instance ToJSON ZcashPool where
|
instance ToJSON ZcashPool where
|
||||||
toJSON zp =
|
toJSON zp =
|
||||||
case zp of
|
case zp of
|
||||||
TransparentPool -> Data.Aeson.String "p2pkh"
|
Transparent -> Data.Aeson.String "p2pkh"
|
||||||
SproutPool -> Data.Aeson.String "sprout"
|
Sprout -> Data.Aeson.String "sprout"
|
||||||
SaplingPool -> Data.Aeson.String "sapling"
|
Sapling -> Data.Aeson.String "sapling"
|
||||||
OrchardPool -> Data.Aeson.String "orchard"
|
Orchard -> Data.Aeson.String "orchard"
|
||||||
|
|
||||||
instance FromJSON ZcashPool where
|
instance FromJSON ZcashPool where
|
||||||
parseJSON =
|
parseJSON =
|
||||||
withText "ZcashPool" $ \case
|
withText "ZcashPool" $ \case
|
||||||
"p2pkh" -> return TransparentPool
|
"p2pkh" -> return Transparent
|
||||||
"sprout" -> return SproutPool
|
"sprout" -> return Sprout
|
||||||
"sapling" -> return SaplingPool
|
"sapling" -> return Sapling
|
||||||
"orchard" -> return OrchardPool
|
"orchard" -> return Orchard
|
||||||
_ -> fail "Not a known Zcash pool"
|
_ -> fail "Not a known Zcash pool"
|
||||||
|
|
||||||
newtype ZenithUuid = ZenithUuid
|
newtype ZenithUuid = ZenithUuid
|
||||||
|
@ -199,10 +199,10 @@ $(deriveJSON defaultOptions ''ZenithStatus)
|
||||||
derivePersistField "ZenithStatus"
|
derivePersistField "ZenithStatus"
|
||||||
|
|
||||||
data PrivacyPolicy
|
data PrivacyPolicy
|
||||||
= None
|
= Full
|
||||||
| Low
|
|
||||||
| Medium
|
| Medium
|
||||||
| Full
|
| Low
|
||||||
|
| None
|
||||||
deriving (Eq, Show, Read, Ord)
|
deriving (Eq, Show, Read, Ord)
|
||||||
|
|
||||||
$(deriveJSON defaultOptions ''PrivacyPolicy)
|
$(deriveJSON defaultOptions ''PrivacyPolicy)
|
||||||
|
@ -298,8 +298,7 @@ instance FromJSON AddressGroup where
|
||||||
Nothing -> return []
|
Nothing -> return []
|
||||||
Just x -> do
|
Just x -> do
|
||||||
x' <- x .:? "addresses"
|
x' <- x .:? "addresses"
|
||||||
return $
|
return $ maybe [] (map (ZcashAddress s1 [Transparent] Nothing)) x'
|
||||||
maybe [] (map (ZcashAddress s1 [TransparentPool] Nothing)) x'
|
|
||||||
processSapling k s2 =
|
processSapling k s2 =
|
||||||
case k of
|
case k of
|
||||||
Nothing -> return []
|
Nothing -> return []
|
||||||
|
@ -307,7 +306,7 @@ instance FromJSON AddressGroup where
|
||||||
where processOneSapling sx =
|
where processOneSapling sx =
|
||||||
withObject "Sapling" $ \oS -> do
|
withObject "Sapling" $ \oS -> do
|
||||||
oS' <- oS .: "addresses"
|
oS' <- oS .: "addresses"
|
||||||
return $ map (ZcashAddress sx [SaplingPool] Nothing) oS'
|
return $ map (ZcashAddress sx [Sapling] Nothing) oS'
|
||||||
processUnified u =
|
processUnified u =
|
||||||
case u of
|
case u of
|
||||||
Nothing -> return []
|
Nothing -> return []
|
||||||
|
|
|
@ -3,17 +3,17 @@
|
||||||
module Zenith.Utils where
|
module Zenith.Utils where
|
||||||
|
|
||||||
import Data.Aeson
|
import Data.Aeson
|
||||||
import Data.Char (isAlphaNum, isSpace)
|
|
||||||
import Data.Functor (void)
|
import Data.Functor (void)
|
||||||
import Data.Maybe
|
import Data.Maybe
|
||||||
import Data.Ord (clamp)
|
import Data.Ord (clamp)
|
||||||
import Data.Scientific (Scientific(..), scientific)
|
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.Char (isAlphaNum, isSpace)
|
||||||
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)
|
||||||
import ZcashHaskell.Sapling (decodeSaplingAddress, isValidShieldedAddress)
|
import ZcashHaskell.Sapling (decodeSaplingAddress, isValidShieldedAddress)
|
||||||
import ZcashHaskell.Transparent
|
import ZcashHaskell.Transparent
|
||||||
( decodeExchangeAddress
|
( decodeExchangeAddress
|
||||||
|
@ -24,15 +24,12 @@ import ZcashHaskell.Types
|
||||||
, TransparentAddress(..)
|
, TransparentAddress(..)
|
||||||
, UnifiedAddress(..)
|
, UnifiedAddress(..)
|
||||||
, ZcashNet(..)
|
, ZcashNet(..)
|
||||||
, ValidAddress(..)
|
|
||||||
, ExchangeAddress(..)
|
|
||||||
)
|
)
|
||||||
import Zenith.Types
|
import Zenith.Types
|
||||||
( AddressGroup(..)
|
( AddressGroup(..)
|
||||||
, UnifiedAddressDB(..)
|
, UnifiedAddressDB(..)
|
||||||
, ZcashAddress(..)
|
, ZcashAddress(..)
|
||||||
, ZcashPool(..)
|
, ZcashPool(..)
|
||||||
, PrivacyPolicy(..)
|
|
||||||
)
|
)
|
||||||
|
|
||||||
-- | Helper function to convert numbers into JSON
|
-- | Helper function to convert numbers into JSON
|
||||||
|
@ -74,9 +71,9 @@ getAddresses ag = agtransparent ag <> agsapling ag <> agunified ag
|
||||||
-- | Helper function to validate potential Zcash addresses
|
-- | Helper function to validate potential Zcash addresses
|
||||||
validateAddress :: T.Text -> Maybe ZcashPool
|
validateAddress :: T.Text -> Maybe ZcashPool
|
||||||
validateAddress txt --(tReg || sReg && isJust chk) || (uReg && isJust chk)
|
validateAddress txt --(tReg || sReg && isJust chk) || (uReg && isJust chk)
|
||||||
| tReg = Just TransparentPool
|
| tReg = Just Transparent
|
||||||
| sReg && chkS = Just SaplingPool
|
| sReg && chkS = Just Sapling
|
||||||
| uReg && chk = Just OrchardPool
|
| uReg && chk = Just Orchard
|
||||||
| otherwise = Nothing
|
| otherwise = Nothing
|
||||||
where
|
where
|
||||||
transparentRegex = "^t1[a-zA-Z0-9]{33}$" :: String
|
transparentRegex = "^t1[a-zA-Z0-9]{33}$" :: String
|
||||||
|
@ -113,7 +110,7 @@ validBarValue :: Float -> Float
|
||||||
validBarValue = clamp (0, 1)
|
validBarValue = clamp (0, 1)
|
||||||
|
|
||||||
isRecipientValid :: T.Text -> Bool
|
isRecipientValid :: T.Text -> Bool
|
||||||
isRecipientValid a = do
|
isRecipientValid a =
|
||||||
case isValidUnifiedAddress (E.encodeUtf8 a) of
|
case isValidUnifiedAddress (E.encodeUtf8 a) of
|
||||||
Just _a1 -> True
|
Just _a1 -> True
|
||||||
Nothing ->
|
Nothing ->
|
||||||
|
@ -125,78 +122,8 @@ isRecipientValid a = do
|
||||||
Just _a4 -> True
|
Just _a4 -> True
|
||||||
Nothing -> False)
|
Nothing -> False)
|
||||||
|
|
||||||
isUnifiedAddressValid :: T.Text -> Bool
|
parseAddress :: T.Text -> ZcashNet -> Maybe UnifiedAddress
|
||||||
isUnifiedAddressValid ua =
|
parseAddress a znet =
|
||||||
case isValidUnifiedAddress (E.encodeUtf8 ua) of
|
|
||||||
Just _a1 -> True
|
|
||||||
Nothing -> False
|
|
||||||
|
|
||||||
isSaplingAddressValid :: T.Text -> Bool
|
|
||||||
isSaplingAddressValid sa = isValidShieldedAddress (E.encodeUtf8 sa)
|
|
||||||
|
|
||||||
isTransparentAddressValid :: T.Text -> Bool
|
|
||||||
isTransparentAddressValid ta =
|
|
||||||
case decodeTransparentAddress (E.encodeUtf8 ta) of
|
|
||||||
Just _a3 -> True
|
|
||||||
Nothing -> False
|
|
||||||
|
|
||||||
isExchangeAddressValid :: T.Text -> Bool
|
|
||||||
isExchangeAddressValid xa =
|
|
||||||
case decodeExchangeAddress (E.encodeUtf8 xa) of
|
|
||||||
Just _a4 -> True
|
|
||||||
Nothing -> False
|
|
||||||
|
|
||||||
isRecipientValidGUI :: PrivacyPolicy -> T.Text -> Bool
|
|
||||||
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
|
|
||||||
Exchange ea -> 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 a = do
|
|
||||||
case isValidUnifiedAddress (E.encodeUtf8 a) of
|
|
||||||
Just _a1 -> True
|
|
||||||
Nothing ->
|
|
||||||
isValidShieldedAddress (E.encodeUtf8 a) ||
|
|
||||||
(case decodeTransparentAddress (E.encodeUtf8 a) of
|
|
||||||
Just _a3 -> True
|
|
||||||
Nothing ->
|
|
||||||
case decodeExchangeAddress (E.encodeUtf8 a) of
|
|
||||||
Just _a4 -> True
|
|
||||||
Nothing -> False)
|
|
||||||
|
|
||||||
parseAddressUA :: T.Text -> ZcashNet -> Maybe UnifiedAddress
|
|
||||||
parseAddressUA a znet =
|
|
||||||
case isValidUnifiedAddress (E.encodeUtf8 a) of
|
case isValidUnifiedAddress (E.encodeUtf8 a) of
|
||||||
Just a1 -> Just a1
|
Just a1 -> Just a1
|
||||||
Nothing ->
|
Nothing ->
|
||||||
|
@ -212,7 +139,7 @@ parseAddressUA a znet =
|
||||||
isValidContent :: String -> Bool
|
isValidContent :: String -> Bool
|
||||||
isValidContent [] = False -- an empty string is invalid
|
isValidContent [] = False -- an empty string is invalid
|
||||||
isValidContent (x:xs)
|
isValidContent (x:xs)
|
||||||
| not (isAlphaNum x) = False -- string must start with an alphanumeric character
|
| not (isAlphaNum x ) = False -- string must start with an alphanumeric character
|
||||||
| otherwise = allValidChars xs -- process the rest of the string
|
| otherwise = allValidChars xs -- process the rest of the string
|
||||||
where
|
where
|
||||||
allValidChars :: String -> Bool
|
allValidChars :: String -> Bool
|
||||||
|
@ -234,3 +161,4 @@ padWithZero n s
|
||||||
isEmpty :: [a] -> Bool
|
isEmpty :: [a] -> Bool
|
||||||
isEmpty [] = True
|
isEmpty [] = True
|
||||||
isEmpty _ = False
|
isEmpty _ = False
|
||||||
|
|
||||||
|
|
|
@ -123,10 +123,9 @@ sendTx user pwd fromAddy toAddy amount memo = do
|
||||||
if source fromAddy /= ImportedWatchOnly
|
if source fromAddy /= ImportedWatchOnly
|
||||||
then do
|
then do
|
||||||
let privacyPolicy
|
let privacyPolicy
|
||||||
| valAdd == Just TransparentPool = "AllowRevealedRecipients"
|
| valAdd == Just Transparent = "AllowRevealedRecipients"
|
||||||
| isNothing (account fromAddy) &&
|
| isNothing (account fromAddy) &&
|
||||||
elem TransparentPool (pool fromAddy) =
|
elem Transparent (pool fromAddy) = "AllowRevealedSenders"
|
||||||
"AllowRevealedSenders"
|
|
||||||
| otherwise = "AllowRevealedAmounts"
|
| otherwise = "AllowRevealedAmounts"
|
||||||
let pd =
|
let pd =
|
||||||
case memo of
|
case memo of
|
||||||
|
@ -302,7 +301,7 @@ sendWithUri user pwd fromAddy uri repTo = do
|
||||||
let addType = validateAddress $ T.pack parsedAddress
|
let addType = validateAddress $ T.pack parsedAddress
|
||||||
case addType of
|
case addType of
|
||||||
Nothing -> putStrLn " Invalid address"
|
Nothing -> putStrLn " Invalid address"
|
||||||
Just TransparentPool -> do
|
Just Transparent -> do
|
||||||
putStrLn $ " Address is valid: " ++ parsedAddress
|
putStrLn $ " Address is valid: " ++ parsedAddress
|
||||||
case (readMaybe parsedAmount :: Maybe Double) of
|
case (readMaybe parsedAmount :: Maybe Double) of
|
||||||
Nothing -> putStrLn " Invalid amount."
|
Nothing -> putStrLn " Invalid amount."
|
||||||
|
|
143
test/Spec.hs
143
test/Spec.hs
|
@ -1,16 +1,15 @@
|
||||||
{-# LANGUAGE OverloadedStrings #-}
|
{-# LANGUAGE OverloadedStrings #-}
|
||||||
|
|
||||||
import Control.Monad (when)
|
import Control.Monad (when)
|
||||||
import Control.Monad.Logger (runFileLoggingT, runNoLoggingT)
|
import Control.Monad.Logger (runNoLoggingT)
|
||||||
import Data.HexString
|
import Data.HexString
|
||||||
import Data.Maybe (fromJust)
|
|
||||||
import qualified Data.Text.Encoding as E
|
import qualified Data.Text.Encoding as E
|
||||||
import Database.Persist
|
import Database.Persist
|
||||||
import Database.Persist.Sqlite
|
import Database.Persist.Sqlite
|
||||||
import System.Directory
|
import System.Directory
|
||||||
import Test.HUnit
|
import Test.HUnit
|
||||||
import Test.Hspec
|
import Test.Hspec
|
||||||
import ZcashHaskell.Orchard (isValidUnifiedAddress, parseAddress)
|
import ZcashHaskell.Orchard (isValidUnifiedAddress)
|
||||||
import ZcashHaskell.Sapling
|
import ZcashHaskell.Sapling
|
||||||
( decodeSaplingOutputEsk
|
( decodeSaplingOutputEsk
|
||||||
, encodeSaplingAddress
|
, encodeSaplingAddress
|
||||||
|
@ -173,15 +172,15 @@ main = do
|
||||||
"6c5d1413c63a9a88db71c3f41dc12cd60197ee742fc75b217215e7144db48bd3"
|
"6c5d1413c63a9a88db71c3f41dc12cd60197ee742fc75b217215e7144db48bd3"
|
||||||
describe "Note selection for Tx" $ do
|
describe "Note selection for Tx" $ do
|
||||||
it "Value less than balance" $ do
|
it "Value less than balance" $ do
|
||||||
pool <- runNoLoggingT $ initPool "/home/rav/Zenith/zenith.db"
|
pool <- runNoLoggingT $ initPool "zenith.db"
|
||||||
res <- selectUnspentNotes pool (toSqlKey 1) 14000000
|
res <- selectUnspentNotes pool (toSqlKey 1) 14000000
|
||||||
res `shouldNotBe` ([], [], [])
|
res `shouldNotBe` ([], [], [])
|
||||||
it "Value greater than balance" $ do
|
it "Value greater than balance" $ do
|
||||||
pool <- runNoLoggingT $ initPool "/home/rav/Zenith/zenith.db"
|
pool <- runNoLoggingT $ initPool "zenith.db"
|
||||||
let res = selectUnspentNotes pool (toSqlKey 1) 84000000
|
let res = selectUnspentNotes pool (toSqlKey 1) 84000000
|
||||||
res `shouldThrow` anyIOException
|
res `shouldThrow` anyIOException
|
||||||
it "Fee calculation" $ do
|
it "Fee calculation" $ do
|
||||||
pool <- runNoLoggingT $ initPool "/home/rav/Zenith/zenith.db"
|
pool <- runNoLoggingT $ initPool "zenith.db"
|
||||||
res <- selectUnspentNotes pool (toSqlKey 1) 14000000
|
res <- selectUnspentNotes pool (toSqlKey 1) 14000000
|
||||||
calculateTxFee res 3 `shouldBe` 20000
|
calculateTxFee res 3 `shouldBe` 20000
|
||||||
describe "Testing validation" $ do
|
describe "Testing validation" $ do
|
||||||
|
@ -210,7 +209,7 @@ main = do
|
||||||
(case decodeTransparentAddress (E.encodeUtf8 a) of
|
(case decodeTransparentAddress (E.encodeUtf8 a) of
|
||||||
Just _a3 -> True
|
Just _a3 -> True
|
||||||
Nothing ->
|
Nothing ->
|
||||||
case decodeExchangeAddress (E.encodeUtf8 a) of
|
case decodeExchangeAddress (En.encodeUtf8 a) of
|
||||||
Just _a4 -> True
|
Just _a4 -> True
|
||||||
Nothing -> False))
|
Nothing -> False))
|
||||||
it "Transparent" $ do
|
it "Transparent" $ do
|
||||||
|
@ -234,115 +233,21 @@ main = do
|
||||||
a `shouldBe`
|
a `shouldBe`
|
||||||
Just
|
Just
|
||||||
"ztestsapling1tgjr4zppwk4ne8xy6gdq4z2gwq7dmf5jq8z2ctpn8nlmtse0a74fa5z0m8z383gmpgqz6q6duu4"
|
"ztestsapling1tgjr4zppwk4ne8xy6gdq4z2gwq7dmf5jq8z2ctpn8nlmtse0a74fa5z0m8z383gmpgqz6q6duu4"
|
||||||
describe "Notes" $ do
|
{-describe "Creating Tx" $ do-}
|
||||||
it "Check Orchard notes" $ do
|
{-xit "To Orchard" $ do-}
|
||||||
pool <- runNoLoggingT $ initPool "/home/rav/Zenith/zenith.db"
|
{-let uaRead =-}
|
||||||
oNotes <- getWalletUnspentOrchNotes pool (toSqlKey 1)
|
{-isValidUnifiedAddress-}
|
||||||
oNotes `shouldBe` []
|
{-"utest1dl54utt6prjj5e0dnlknwumnxq9hycdjpkfr0sy6e6h522remqee8axe9zax0wsjrwpj76v555pdhvj9rnargpfyycs0vpkapq98xcdhem99gc4wchzn0ggepq3y6nz3a9sscwgqxgsh9vzhcad402y3x9szfregck5gslkya3c79d86xx0l33tpk8gnn7ew9vw37w43zh22u8dgdax"-}
|
||||||
it "Check Sapling notes" $ do
|
{-case uaRead of-}
|
||||||
pool <- runNoLoggingT $ initPool "/home/rav/Zenith/zenith.db"
|
{-Nothing -> assertFailure "wrong address"-}
|
||||||
oNotes <- getWalletUnspentSapNotes pool (toSqlKey 4)
|
{-Just ua -> do-}
|
||||||
oNotes `shouldBe` []
|
{-tx <--}
|
||||||
it "Check transparent notes" $ do
|
{-prepareTx-}
|
||||||
pool <- runNoLoggingT $ initPool "/home/rav/Zenith/zenith.db"
|
{-"zenith.db"-}
|
||||||
oNotes <- getWalletUnspentTrNotes pool (toSqlKey 1)
|
{-TestNet-}
|
||||||
oNotes `shouldBe` []
|
{-(toSqlKey 1)-}
|
||||||
describe "Creating Tx" $ do
|
{-2819811-}
|
||||||
describe "Full" $ do
|
{-0.04-}
|
||||||
it "To Orchard" $ do
|
{-ua-}
|
||||||
let uaRead =
|
{-"sent with Zenith, test"-}
|
||||||
parseAddress
|
{-tx `shouldBe` Right (hexString "deadbeef")-}
|
||||||
"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)
|
|
||||||
3001230
|
|
||||||
0.005
|
|
||||||
(fromJust uaRead)
|
|
||||||
"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)
|
|
||||||
3001230
|
|
||||||
0.005
|
|
||||||
(fromJust uaRead)
|
|
||||||
"Sending memo to sapling"
|
|
||||||
Full
|
|
||||||
case tx of
|
|
||||||
Left e -> assertFailure $ show e
|
|
||||||
Right h -> h `shouldNotBe` (hexString "deadbeef")
|
|
||||||
describe "Medium" $ do
|
|
||||||
xit "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)
|
|
||||||
3000789
|
|
||||||
0.005
|
|
||||||
(fromJust uaRead)
|
|
||||||
"Sending memo to orchard"
|
|
||||||
Medium
|
|
||||||
case tx of
|
|
||||||
Left e -> assertFailure $ show e
|
|
||||||
Right h -> h `shouldNotBe` (hexString "deadbeef")
|
|
||||||
xit "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)
|
|
||||||
3000789
|
|
||||||
0.005
|
|
||||||
(fromJust uaRead)
|
|
||||||
"Sending memo to orchard"
|
|
||||||
Medium
|
|
||||||
case tx of
|
|
||||||
Left e -> assertFailure $ show e
|
|
||||||
Right h -> h `shouldNotBe` (hexString "deadbeef")
|
|
||||||
|
|
|
@ -1 +1 @@
|
||||||
Subproject commit 12296026a0ebb9a5afe0904b251c5d31080eab18
|
Subproject commit 7965dc38c48da348f503a52ee10042fffc43f32c
|
Loading…
Reference in a new issue