Sending transactions #78

Merged
pitmutt merged 2 commits from rav001 into dev041 2024-05-09 15:48:24 +00:00
7 changed files with 459 additions and 119 deletions
Showing only changes of commit e20f253cda - Show all commits

View file

@ -11,11 +11,15 @@ import qualified Brick.Focus as F
import Brick.Forms import Brick.Forms
( Form(..) ( Form(..)
, (@@=) , (@@=)
, allFieldsValid
, editShowableFieldWithValidate
, editTextField , editTextField
, focusedFormInputAttr , focusedFormInputAttr
, handleFormEvent , handleFormEvent
, invalidFormInputAttr
, newForm , newForm
, renderForm , renderForm
, setFieldValid
, updateFormState , updateFormState
) )
import qualified Brick.Main as M import qualified Brick.Main as M
@ -49,6 +53,7 @@ import Brick.Widgets.Core
, withBorderStyle , withBorderStyle
) )
import qualified Brick.Widgets.Dialog as D import qualified Brick.Widgets.Dialog as D
import qualified Brick.Widgets.Edit as E
import qualified Brick.Widgets.List as L 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)
@ -57,6 +62,7 @@ import Control.Monad (forever, void)
import Control.Monad.IO.Class (liftIO) import Control.Monad.IO.Class (liftIO)
import Control.Monad.Logger (LoggingT, runFileLoggingT, runNoLoggingT) import Control.Monad.Logger (LoggingT, runFileLoggingT, runNoLoggingT)
import Data.Aeson import Data.Aeson
import Data.HexString (toText)
import Data.Maybe import Data.Maybe
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
@ -73,7 +79,12 @@ import System.Hclip
import Text.Wrap (FillScope(..), FillStrategy(..), WrapSettings(..), wrapText) import Text.Wrap (FillScope(..), FillStrategy(..), WrapSettings(..), wrapText)
import ZcashHaskell.Keys (generateWalletSeedPhrase, getWalletSeed) import ZcashHaskell.Keys (generateWalletSeedPhrase, getWalletSeed)
import ZcashHaskell.Orchard (getSaplingFromUA, isValidUnifiedAddress) import ZcashHaskell.Orchard (getSaplingFromUA, isValidUnifiedAddress)
import ZcashHaskell.Transparent (encodeTransparentReceiver) import ZcashHaskell.Sapling (decodeSaplingAddress, isValidShieldedAddress)
import ZcashHaskell.Transparent
( decodeExchangeAddress
, decodeTransparentAddress
, encodeTransparentReceiver
)
import ZcashHaskell.Types import ZcashHaskell.Types
import ZcashHaskell.Utils (getBlockTime, makeZebraCall) import ZcashHaskell.Utils (getBlockTime, makeZebraCall)
import Zenith.Core import Zenith.Core
@ -94,6 +105,9 @@ data Name
| TList | TList
| HelpDialog | HelpDialog
| DialogInputField | DialogInputField
| RecField
| AmtField
| MemoField
deriving (Eq, Show, Ord) deriving (Eq, Show, Ord)
data DialogInput = DialogInput data DialogInput = DialogInput
@ -102,12 +116,21 @@ data DialogInput = DialogInput
makeLenses ''DialogInput makeLenses ''DialogInput
data SendInput = SendInput
{ _sendTo :: !T.Text
, _sendAmt :: !Float
, _sendMemo :: !T.Text
} deriving (Show)
makeLenses ''SendInput
data DialogType data DialogType
= WName = WName
| AName | AName
| AdName | AdName
| WSelect | WSelect
| ASelect | ASelect
| SendTx
| Blank | Blank
data DisplayType data DisplayType
@ -116,6 +139,7 @@ data DisplayType
| PhraseDisplay | PhraseDisplay
| TxDisplay | TxDisplay
| SyncDisplay | SyncDisplay
| SendDisplay
| BlankDisplay | BlankDisplay
data Tick data Tick
@ -144,6 +168,7 @@ data State = State
, _barValue :: !Float , _barValue :: !Float
, _eventDispatch :: !(BC.BChan Tick) , _eventDispatch :: !(BC.BChan Tick)
, _timer :: !Int , _timer :: !Int
, _txForm :: !(Form SendInput () Name)
} }
makeLenses ''State makeLenses ''State
@ -182,7 +207,7 @@ drawUI s = [splashDialog s, helpDialog s, displayDialog s, inputDialog s, ui s]
listAddressBox "Addresses" (st ^. addresses) <+> listAddressBox "Addresses" (st ^. addresses) <+>
B.vBorder <+> B.vBorder <+>
(C.hCenter (str ("Last block seen: " ++ show (st ^. syncBlock))) <=> (C.hCenter (str ("Last block seen: " ++ show (st ^. syncBlock))) <=>
listTxBox "Transactions" (st ^. transactions))) <=> listTxBox "Transactions" (st ^. network) (st ^. transactions))) <=>
C.hCenter C.hCenter
(hBox (hBox
[ capCommand "W" "allets" [ capCommand "W" "allets"
@ -230,13 +255,14 @@ drawUI s = [splashDialog s, helpDialog s, displayDialog s, inputDialog s, ui s]
, capCommand "Tab " "->" , capCommand "Tab " "->"
]) ])
] ]
listTxBox :: String -> L.List Name (Entity UserTx) -> Widget Name listTxBox ::
listTxBox titleLabel tx = String -> ZcashNet -> L.List Name (Entity UserTx) -> Widget Name
listTxBox titleLabel znet tx =
C.vCenter $ C.vCenter $
vBox vBox
[ C.hCenter [ C.hCenter
(B.borderWithLabel (str titleLabel) $ (B.borderWithLabel (str titleLabel) $
hLimit 40 $ vLimit 15 $ L.renderList listDrawTx True tx) hLimit 50 $ vLimit 15 $ L.renderList (listDrawTx znet) True tx)
, str " " , str " "
, C.hCenter , C.hCenter
(hBox (hBox
@ -303,6 +329,12 @@ drawUI s = [splashDialog s, helpDialog s, displayDialog s, inputDialog s, ui s]
, capCommand "N" "ew" , capCommand "N" "ew"
, xCommand , xCommand
])) ]))
SendTx ->
D.renderDialog
(D.dialog (Just (str "Send Transaction")) Nothing 50)
(renderForm (st ^. txForm) <=>
C.hCenter
(hBox [capCommand "" "Send", capCommand "<esc> " "Cancel"]))
Blank -> emptyWidget Blank -> emptyWidget
splashDialog :: State -> Widget Name splashDialog :: State -> Widget Name
splashDialog st = splashDialog st =
@ -421,6 +453,11 @@ drawUI s = [splashDialog s, helpDialog s, displayDialog s, inputDialog s, ui s]
(P.progressBar (P.progressBar
(Just $ show (st ^. barValue * 100)) (Just $ show (st ^. barValue * 100))
(_barValue st)))) (_barValue st))))
SendDisplay ->
withBorderStyle unicodeBold $
D.renderDialog
(D.dialog (Just $ txt "Sending Transaction") Nothing 50)
(padAll 1 (str $ st ^. msg))
BlankDisplay -> emptyWidget BlankDisplay -> emptyWidget
mkInputForm :: DialogInput -> Form DialogInput e Name mkInputForm :: DialogInput -> Form DialogInput e Name
@ -431,6 +468,33 @@ mkInputForm =
label s w = label s w =
padBottom (Pad 1) $ vLimit 1 (hLimit 15 $ str s <+> fill ' ') <+> w padBottom (Pad 1) $ vLimit 1 (hLimit 15 $ str s <+> fill ' ') <+> w
mkSendForm :: Integer -> SendInput -> Form SendInput e Name
mkSendForm bal =
newForm
[ label "To: " @@= editTextField sendTo RecField (Just 1)
, label "Amount: " @@=
editShowableFieldWithValidate sendAmt AmtField (isAmountValid bal)
, label "Memo: " @@= editTextField sendMemo MemoField (Just 1)
]
where
isAmountValid :: Integer -> Float -> Bool
isAmountValid b i = (fromIntegral b * 100000000.0) >= i
label s w =
padBottom (Pad 1) $ vLimit 1 (hLimit 15 $ str s <+> fill ' ') <+> w
isRecipientValid :: T.Text -> Bool
isRecipientValid a =
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 a of
Just _a4 -> True
Nothing -> False)
listDrawElement :: (Show a) => Bool -> a -> Widget Name listDrawElement :: (Show a) => Bool -> a -> Widget Name
listDrawElement sel a = listDrawElement sel a =
let selStr s = let selStr s =
@ -466,18 +530,22 @@ listDrawAddress sel w =
walletAddressName (entityVal w) <> walletAddressName (entityVal w) <>
": " <> showAddress (walletAddressUAddress (entityVal w)) ": " <> showAddress (walletAddressUAddress (entityVal w))
listDrawTx :: Bool -> Entity UserTx -> Widget Name listDrawTx :: ZcashNet -> Bool -> Entity UserTx -> Widget Name
listDrawTx sel tx = listDrawTx znet sel tx =
selStr $ selStr $
T.pack T.pack
(show $ posixSecondsToUTCTime (fromIntegral (userTxTime $ entityVal tx))) <> (show $ posixSecondsToUTCTime (fromIntegral (userTxTime $ entityVal tx))) <>
" " <> fmtAmt " " <> T.pack fmtAmt
where where
amt = fromIntegral (userTxAmount $ entityVal tx) / 100000000 amt = fromIntegral $ userTxAmount $ entityVal tx
dispAmount =
if znet == MainNet
then displayZec amt
else displayTaz amt
fmtAmt = fmtAmt =
if amt > 0 if amt > 0
then "" <> T.pack (show amt) <> " " then "" <> dispAmount <> " "
else " " <> T.pack (show amt) <> "" else " " <> dispAmount <> ""
selStr s = selStr s =
if sel if sel
then withAttr customAttr (txt $ "> " <> s) then withAttr customAttr (txt $ "> " <> s)
@ -561,14 +629,22 @@ appEvent (BT.AppEvent t) = do
pool <- liftIO $ runNoLoggingT $ initPool $ s ^. dbPath pool <- liftIO $ runNoLoggingT $ initPool $ s ^. dbPath
case t of case t of
TickMsg m -> do TickMsg m -> do
BT.modify $ set msg m case s ^. displayBox of
BT.modify $ set displayBox MsgDisplay AddrDisplay -> return ()
MsgDisplay -> return ()
PhraseDisplay -> return ()
TxDisplay -> return ()
SyncDisplay -> return ()
SendDisplay -> do
BT.modify $ set msg m
BlankDisplay -> return ()
TickVal v -> do TickVal v -> do
case s ^. displayBox of case s ^. displayBox of
AddrDisplay -> return () AddrDisplay -> return ()
MsgDisplay -> return () MsgDisplay -> return ()
PhraseDisplay -> return () PhraseDisplay -> return ()
TxDisplay -> return () TxDisplay -> return ()
SendDisplay -> return ()
SyncDisplay -> do SyncDisplay -> do
if s ^. barValue == 1.0 if s ^. barValue == 1.0
then do then do
@ -600,6 +676,7 @@ appEvent (BT.AppEvent t) = do
WName -> return () WName -> return ()
WSelect -> return () WSelect -> return ()
ASelect -> return () ASelect -> return ()
SendTx -> return ()
Blank -> do Blank -> do
if s ^. timer == 90 if s ^. timer == 90
then do then do
@ -643,6 +720,11 @@ appEvent (BT.VtyEvent e) = do
setClipboard $ setClipboard $
T.unpack $ T.unpack $
getUA $ walletAddressUAddress $ entityVal a getUA $ walletAddressUAddress $ entityVal a
BT.modify $
set msg $
"Copied Unified Address <" ++
T.unpack (walletAddressName (entityVal a)) ++ ">!"
BT.modify $ set displayBox MsgDisplay
Nothing -> return () Nothing -> return ()
V.EvKey (V.KChar 's') [] -> do V.EvKey (V.KChar 's') [] -> do
case L.listSelectedElement $ s ^. addresses of case L.listSelectedElement $ s ^. addresses of
@ -653,6 +735,11 @@ appEvent (BT.VtyEvent e) = do
getSaplingFromUA $ getSaplingFromUA $
E.encodeUtf8 $ E.encodeUtf8 $
getUA $ walletAddressUAddress $ entityVal a getUA $ walletAddressUAddress $ entityVal a
BT.modify $
set msg $
"Copied Sapling Address <" ++
T.unpack (walletAddressName (entityVal a)) ++ ">!"
BT.modify $ set displayBox MsgDisplay
Nothing -> return () Nothing -> return ()
V.EvKey (V.KChar 't') [] -> do V.EvKey (V.KChar 't') [] -> do
case L.listSelectedElement $ s ^. addresses of case L.listSelectedElement $ s ^. addresses of
@ -667,11 +754,17 @@ appEvent (BT.VtyEvent e) = do
(isValidUnifiedAddress . (isValidUnifiedAddress .
E.encodeUtf8 . getUA . walletAddressUAddress) E.encodeUtf8 . getUA . walletAddressUAddress)
(entityVal a) (entityVal a)
BT.modify $
set msg $
"Copied Transparent Address <" ++
T.unpack (walletAddressName (entityVal a)) ++ ">!"
BT.modify $ set displayBox MsgDisplay
Nothing -> return () Nothing -> return ()
_ev -> return () _ev -> return ()
MsgDisplay -> BT.modify $ set displayBox BlankDisplay MsgDisplay -> BT.modify $ set displayBox BlankDisplay
PhraseDisplay -> BT.modify $ set displayBox BlankDisplay PhraseDisplay -> BT.modify $ set displayBox BlankDisplay
TxDisplay -> BT.modify $ set displayBox BlankDisplay TxDisplay -> BT.modify $ set displayBox BlankDisplay
SendDisplay -> BT.modify $ set displayBox BlankDisplay
SyncDisplay -> BT.modify $ set displayBox BlankDisplay SyncDisplay -> BT.modify $ set displayBox BlankDisplay
BlankDisplay -> do BlankDisplay -> do
case s ^. dialogBox of case s ^. dialogBox of
@ -756,6 +849,71 @@ appEvent (BT.VtyEvent e) = do
s ^. inputForm s ^. inputForm
BT.modify $ set dialogBox AName BT.modify $ set dialogBox AName
ev -> BT.zoom accounts $ L.handleListEvent ev ev -> BT.zoom accounts $ L.handleListEvent ev
SendTx -> do
case e of
V.EvKey V.KEsc [] -> BT.modify $ set dialogBox Blank
V.EvKey V.KEnter [] -> do
if allFieldsValid (s ^. txForm)
then do
pool <-
liftIO $ runNoLoggingT $ initPool $ s ^. dbPath
selWal <-
do case L.listSelectedElement $ s ^. wallets of
Nothing -> do
let fWall =
L.listSelectedElement $
L.listMoveToBeginning $ s ^. wallets
case fWall of
Nothing ->
throw $
userError "Failed to select wallet"
Just (_j, w1) -> return w1
Just (_k, w) -> return w
selAcc <-
do case L.listSelectedElement $ s ^. accounts of
Nothing -> do
let fAcc =
L.listSelectedElement $
L.listMoveToBeginning $
s ^. accounts
case fAcc of
Nothing ->
throw $
userError "Failed to select wallet"
Just (_j, w1) -> return w1
Just (_k, w) -> return w
fs1 <- BT.zoom txForm $ BT.gets formState
bl <-
liftIO $ getLastSyncBlock pool $ entityKey selWal
_ <-
liftIO $
forkIO $
sendTransaction
pool
(s ^. eventDispatch)
(s ^. zebraHost)
(s ^. zebraPort)
(s ^. network)
(entityKey selAcc)
bl
(fs1 ^. sendAmt)
(fs1 ^. sendTo)
(fs1 ^. sendMemo)
BT.modify $ set msg "Preparing transaction..."
BT.modify $ set displayBox SendDisplay
BT.modify $ set dialogBox Blank
else do
BT.modify $ set msg "Invalid inputs"
BT.modify $ set displayBox MsgDisplay
BT.modify $ set dialogBox Blank
ev -> do
BT.zoom txForm $ do
handleFormEvent (BT.VtyEvent ev)
fs <- BT.gets formState
BT.modify $
setFieldValid
(isRecipientValid (fs ^. sendTo))
RecField
Blank -> do Blank -> do
case e of case e of
V.EvKey (V.KChar '\t') [] -> focusRing %= F.focusNext V.EvKey (V.KChar '\t') [] -> focusRing %= F.focusNext
@ -774,6 +932,11 @@ appEvent (BT.VtyEvent e) = do
BT.modify $ set displayBox TxDisplay BT.modify $ set displayBox TxDisplay
V.EvKey (V.KChar 'a') [] -> V.EvKey (V.KChar 'a') [] ->
BT.modify $ set dialogBox ASelect BT.modify $ set dialogBox ASelect
V.EvKey (V.KChar 's') [] -> do
BT.modify $
set txForm $
mkSendForm (s ^. balance) (SendInput "" 0.0 "")
BT.modify $ set dialogBox SendTx
ev -> ev ->
case r of case r of
Just AList -> Just AList ->
@ -798,6 +961,9 @@ theMap =
, (titleAttr, V.withStyle (fg V.brightGreen) V.bold) , (titleAttr, V.withStyle (fg V.brightGreen) V.bold)
, (blinkAttr, style V.blink) , (blinkAttr, style V.blink)
, (focusedFormInputAttr, V.white `on` V.blue) , (focusedFormInputAttr, V.white `on` V.blue)
, (invalidFormInputAttr, V.red `on` V.black)
, (E.editAttr, V.white `on` V.blue)
, (E.editFocusedAttr, V.blue `on` V.white)
, (baseAttr, bg V.brightBlack) , (baseAttr, bg V.brightBlack)
, (barDoneAttr, V.white `on` V.blue) , (barDoneAttr, V.white `on` V.blue)
, (barToDoAttr, V.white `on` V.black) , (barToDoAttr, V.white `on` V.black)
@ -885,6 +1051,7 @@ runZenithCLI config = do
1.0 1.0
eventChan eventChan
0 0
(mkSendForm 0 $ SendInput "" 0.0 "")
Left e -> do Left e -> do
print $ print $
"No Zebra node available on port " <> "No Zebra node available on port " <>
@ -1063,3 +1230,51 @@ addNewAddress n scope s = do
T.unpack n ++ T.unpack n ++
"(" ++ "(" ++
T.unpack (showAddress $ walletAddressUAddress $ entityVal x) ++ ")" T.unpack (showAddress $ walletAddressUAddress $ entityVal x) ++ ")"
sendTransaction ::
ConnectionPool
-> BC.BChan Tick
-> T.Text
-> Int
-> ZcashNet
-> ZcashAccountId
-> Int
-> Float
-> T.Text
-> T.Text
-> IO ()
sendTransaction pool chan zHost zPort znet accId bl amt ua memo = do
BC.writeBChan chan $ TickMsg "Preparing transaction..."
outUA <- parseAddress ua
res <-
runFileLoggingT "zenith.log" $
prepareTx pool zHost zPort znet accId bl amt outUA memo
BC.writeBChan chan $ TickMsg "Transaction ready, sending to Zebra..."
case res of
Left e -> BC.writeBChan chan $ TickMsg $ show e
Right rawTx -> do
resp <-
makeZebraCall
zHost
zPort
"sendrawtransaction"
[Data.Aeson.String $ toText rawTx]
case resp of
Left e1 -> BC.writeBChan chan $ TickMsg $ "Zebra error: " ++ show e1
Right txId -> BC.writeBChan chan $ TickMsg $ "Tx ID: " ++ txId
where
parseAddress :: T.Text -> IO UnifiedAddress
parseAddress a =
case isValidUnifiedAddress (E.encodeUtf8 a) of
Just a1 -> return a1
Nothing ->
case decodeSaplingAddress (E.encodeUtf8 a) of
Just a2 ->
return $
UnifiedAddress znet Nothing (Just $ sa_receiver a2) Nothing
Nothing ->
case decodeTransparentAddress (E.encodeUtf8 a) of
Just a3 ->
return $
UnifiedAddress znet Nothing Nothing (Just $ ta_receiver a3)
Nothing -> throwIO $ userError "Incorrect address"

View file

@ -10,6 +10,8 @@ import Control.Monad.Logger
( LoggingT ( LoggingT
, MonadLoggerIO , MonadLoggerIO
, NoLoggingT , NoLoggingT
, logDebugN
, logErrorN
, logInfoN , logInfoN
, logWarnN , logWarnN
, runFileLoggingT , runFileLoggingT
@ -18,6 +20,7 @@ import Control.Monad.Logger
) )
import Crypto.Secp256k1 (SecKey(..)) import Crypto.Secp256k1 (SecKey(..))
import Data.Aeson import Data.Aeson
import Data.Binary.Get hiding (getBytes)
import qualified Data.ByteString as BS import qualified Data.ByteString as BS
import qualified Data.ByteString.Lazy as LBS import qualified Data.ByteString.Lazy as LBS
import Data.Digest.Pure.MD5 import Data.Digest.Pure.MD5
@ -442,17 +445,17 @@ calculateTxFee (t, s, o) i =
(5000 * (max (length t) tout + max (length s) sout + length o + oout)) (5000 * (max (length t) tout + max (length s) sout + length o + oout))
where where
tout = tout =
if i == 1 if i == 1 || i == 2
then 1 then 1
else 0 else 0
sout = sout =
if i == 2 if i == 3
then 1 then 1
else 0 else 0
oout = oout =
if i == 3 if i == 4
then 2 then 1
else 1 else 0
-- | Prepare a transaction for sending -- | Prepare a transaction for sending
prepareTx :: prepareTx ::
@ -465,9 +468,9 @@ prepareTx ::
-> Float -> Float
-> UnifiedAddress -> UnifiedAddress
-> T.Text -> T.Text
-> IO (Either TxError HexString) -> LoggingT IO (Either TxError HexString)
prepareTx pool zebraHost zebraPort zn za bh amt ua memo = do prepareTx pool zebraHost zebraPort zn za bh amt ua memo = do
accRead <- getAccountById pool za accRead <- liftIO $ getAccountById pool za
let recipient = let recipient =
case o_rec ua of case o_rec ua of
Nothing -> Nothing ->
@ -481,63 +484,97 @@ prepareTx pool zebraHost zebraPort zn za bh amt ua memo = do
P2SH -> (2, toBytes $ tr_bytes r3) P2SH -> (2, toBytes $ tr_bytes r3)
Just r2 -> (3, getBytes r2) Just r2 -> (3, getBytes r2)
Just r1 -> (4, getBytes r1) Just r1 -> (4, getBytes r1)
print recipient logDebugN $ T.pack $ show recipient
trees <- getCommitmentTrees zebraHost zebraPort bh logDebugN $ T.pack $ "Target block: " ++ show bh
trees <- liftIO $ getCommitmentTrees zebraHost zebraPort bh
let sT = SaplingCommitmentTree $ ztiSapling trees let sT = SaplingCommitmentTree $ ztiSapling trees
let oT = OrchardCommitmentTree $ ztiOrchard trees let oT = OrchardCommitmentTree $ ztiOrchard trees
case accRead of case accRead of
Nothing -> throwIO $ userError "Can't find Account" Nothing -> do
logErrorN "Can't find Account"
return $ Left ZHError
Just acc -> do Just acc -> do
print acc logDebugN $ T.pack $ show acc
spParams <- BS.readFile "sapling-spend.params" spParams <- liftIO $ BS.readFile "sapling-spend.params"
outParams <- BS.readFile "sapling-output.params" outParams <- liftIO $ BS.readFile "sapling-output.params"
if show (md5 $ LBS.fromStrict spParams) /= if show (md5 $ LBS.fromStrict spParams) /=
"0f44c12ef115ae019decf18ade583b20" "0f44c12ef115ae019decf18ade583b20"
then throwIO $ userError "Can't validate sapling parameters" then logErrorN "Can't validate sapling parameters"
else print "Valid Sapling spend params" else logInfoN "Valid Sapling spend params"
if show (md5 $ LBS.fromStrict outParams) /= if show (md5 $ LBS.fromStrict outParams) /=
"924daf81b87a81bbbb9c7d18562046c8" "924daf81b87a81bbbb9c7d18562046c8"
then throwIO $ userError "Can't validate sapling parameters" then logErrorN "Can't validate sapling parameters"
else print "Valid Sapling output params" else logInfoN "Valid Sapling output params"
print $ BS.length spParams --print $ BS.length spParams
print $ BS.length outParams --print $ BS.length outParams
print "Read Sapling params" logDebugN "Read Sapling params"
let zats = fromIntegral $ floorFloatInteger $ amt * (10 ^ 8) let zats = fromIntegral $ floorFloatInteger $ amt * (10 ^ 8)
firstPass <- selectUnspentNotes pool za zats logDebugN $ T.pack $ show zats
let fee = calculateTxFee firstPass 3 {-firstPass <- liftIO $ selectUnspentNotes pool za zats-}
print "calculated fee" --let fee = calculateTxFee firstPass $ fst recipient
print fee --logDebugN $ T.pack $ "calculated fee " ++ show fee
(tList, sList, oList) <- selectUnspentNotes pool za (zats + fee) (tList, sList, oList) <- liftIO $ selectUnspentNotes pool za (zats + 5000)
print "selected notes" logDebugN "selected notes"
print tList logDebugN $ T.pack $ show tList
print sList logDebugN $ T.pack $ show sList
print oList logDebugN $ T.pack $ show oList
let noteTotal = getTotalAmount (tList, sList, oList) let noteTotal = getTotalAmount (tList, sList, oList)
print noteTotal
tSpends <- tSpends <-
liftIO $
prepTSpends (getTranSK $ zcashAccountTPrivateKey $ entityVal acc) tList prepTSpends (getTranSK $ zcashAccountTPrivateKey $ entityVal acc) tList
print tSpends --print tSpends
sSpends <- sSpends <-
liftIO $
prepSSpends (getSapSK $ zcashAccountSapSpendKey $ entityVal acc) sList prepSSpends (getSapSK $ zcashAccountSapSpendKey $ entityVal acc) sList
print sSpends --print sSpends
oSpends <- oSpends <-
liftIO $
prepOSpends (getOrchSK $ zcashAccountOrchSpendKey $ entityVal acc) oList prepOSpends (getOrchSK $ zcashAccountOrchSpendKey $ entityVal acc) oList
print oSpends --print oSpends
outgoing <- makeOutgoing acc recipient zats (noteTotal - fee - zats) dummy <-
print outgoing liftIO $ makeOutgoing acc recipient zats (noteTotal - 5000 - zats)
let tx = logDebugN "Calculating fee"
let feeResponse =
createTransaction createTransaction
(Just sT) (Just sT)
(Just oT) (Just oT)
tSpends tSpends
sSpends sSpends
oSpends oSpends
outgoing dummy
(SaplingSpendParams spParams) (SaplingSpendParams spParams)
(SaplingOutputParams outParams) (SaplingOutputParams outParams)
zn zn
(bh + 3) (bh + 3)
return tx False
case feeResponse of
Left e1 -> return $ Left Fee
Right fee -> do
let feeAmt =
fromIntegral (runGet getInt64le $ LBS.fromStrict $ toBytes fee)
(tList1, sList1, oList1) <-
liftIO $ selectUnspentNotes pool za (zats + feeAmt)
logDebugN $ T.pack $ "selected notes with fee" ++ show feeAmt
logDebugN $ T.pack $ show tList
logDebugN $ T.pack $ show sList
logDebugN $ T.pack $ show oList
outgoing <-
liftIO $ makeOutgoing acc recipient zats (noteTotal - feeAmt - zats)
logDebugN $ T.pack $ show outgoing
let tx =
createTransaction
(Just sT)
(Just oT)
tSpends
sSpends
oSpends
outgoing
(SaplingSpendParams spParams)
(SaplingOutputParams outParams)
zn
(bh + 3)
True
return tx
where where
makeOutgoing :: makeOutgoing ::
Entity ZcashAccount Entity ZcashAccount
@ -587,7 +624,6 @@ prepareTx pool zebraHost zebraPort zn za bh amt ua memo = do
prepTSpends sk notes = do prepTSpends sk notes = do
forM notes $ \n -> do forM notes $ \n -> do
tAddRead <- getAddressById pool $ walletTrNoteAddress $ entityVal n tAddRead <- getAddressById pool $ walletTrNoteAddress $ entityVal n
print n
case tAddRead of case tAddRead of
Nothing -> throwIO $ userError "Couldn't read t-address" Nothing -> throwIO $ userError "Couldn't read t-address"
Just tAdd -> do Just tAdd -> do
@ -614,7 +650,6 @@ prepareTx pool zebraHost zebraPort zn za bh amt ua memo = do
SaplingSpendingKey -> [Entity WalletSapNote] -> IO [SaplingTxSpend] SaplingSpendingKey -> [Entity WalletSapNote] -> IO [SaplingTxSpend]
prepSSpends sk notes = do prepSSpends sk notes = do
forM notes $ \n -> do forM notes $ \n -> do
print n
return $ return $
SaplingTxSpend SaplingTxSpend
(getBytes sk) (getBytes sk)
@ -630,7 +665,6 @@ prepareTx pool zebraHost zebraPort zn za bh amt ua memo = do
OrchardSpendingKey -> [Entity WalletOrchNote] -> IO [OrchardTxSpend] OrchardSpendingKey -> [Entity WalletOrchNote] -> IO [OrchardTxSpend]
prepOSpends sk notes = do prepOSpends sk notes = do
forM notes $ \n -> do forM notes $ \n -> do
print n
return $ return $
OrchardTxSpend OrchardTxSpend
(getBytes sk) (getBytes sk)

View file

@ -119,7 +119,7 @@ share
deriving Show Eq deriving Show Eq
UserTx UserTx
hex HexStringDB hex HexStringDB
address WalletAddressId address WalletAddressId OnDeleteCascade OnUpdateCascade
time Int time Int
amount Int amount Int
memo T.Text memo T.Text
@ -127,8 +127,8 @@ share
deriving Show Eq deriving Show Eq
WalletTrNote WalletTrNote
tx WalletTransactionId OnDeleteCascade OnUpdateCascade tx WalletTransactionId OnDeleteCascade OnUpdateCascade
accId ZcashAccountId accId ZcashAccountId OnDeleteCascade OnUpdateCascade
address WalletAddressId address WalletAddressId OnDeleteCascade OnUpdateCascade
value Word64 value Word64
spent Bool spent Bool
script BS.ByteString script BS.ByteString
@ -138,13 +138,14 @@ share
deriving Show Eq deriving Show Eq
WalletTrSpend WalletTrSpend
tx WalletTransactionId OnDeleteCascade OnUpdateCascade tx WalletTransactionId OnDeleteCascade OnUpdateCascade
note WalletTrNoteId note WalletTrNoteId OnDeleteCascade OnUpdateCascade
accId ZcashAccountId accId ZcashAccountId OnDeleteCascade OnUpdateCascade
value Word64 value Word64
UniqueTrSpend tx accId
deriving Show Eq deriving Show Eq
WalletSapNote WalletSapNote
tx WalletTransactionId OnDeleteCascade OnUpdateCascade tx WalletTransactionId OnDeleteCascade OnUpdateCascade
accId ZcashAccountId accId ZcashAccountId OnDeleteCascade OnUpdateCascade
value Word64 value Word64
recipient BS.ByteString recipient BS.ByteString
memo T.Text memo T.Text
@ -159,13 +160,14 @@ share
deriving Show Eq deriving Show Eq
WalletSapSpend WalletSapSpend
tx WalletTransactionId OnDeleteCascade OnUpdateCascade tx WalletTransactionId OnDeleteCascade OnUpdateCascade
note WalletSapNoteId note WalletSapNoteId OnDeleteCascade OnUpdateCascade
accId ZcashAccountId accId ZcashAccountId OnDeleteCascade OnUpdateCascade
value Word64 value Word64
UniqueSapSepnd tx accId
deriving Show Eq deriving Show Eq
WalletOrchNote WalletOrchNote
tx WalletTransactionId OnDeleteCascade OnUpdateCascade tx WalletTransactionId OnDeleteCascade OnUpdateCascade
accId ZcashAccountId accId ZcashAccountId OnDeleteCascade OnUpdateCascade
value Word64 value Word64
recipient BS.ByteString recipient BS.ByteString
memo T.Text memo T.Text
@ -181,9 +183,10 @@ share
deriving Show Eq deriving Show Eq
WalletOrchSpend WalletOrchSpend
tx WalletTransactionId OnDeleteCascade OnUpdateCascade tx WalletTransactionId OnDeleteCascade OnUpdateCascade
note WalletOrchNoteId note WalletOrchNoteId OnDeleteCascade OnUpdateCascade
accId ZcashAccountId accId ZcashAccountId OnDeleteCascade OnUpdateCascade
value Word64 value Word64
UniqueOrchSpend tx accId
deriving Show Eq deriving Show Eq
ZcashTransaction ZcashTransaction
block Int block Int
@ -579,6 +582,20 @@ getMinBirthdayHeight pool = do
Nothing -> return 0 Nothing -> return 0
Just x -> return $ zcashWalletBirthdayHeight $ entityVal x Just x -> return $ zcashWalletBirthdayHeight $ entityVal x
getLastSyncBlock :: ConnectionPool -> ZcashWalletId -> IO Int
getLastSyncBlock pool zw = do
b <-
runNoLoggingT $
PS.retryOnBusy $
flip PS.runSqlPool pool $ do
selectOne $ do
w <- from $ table @ZcashWallet
where_ (w ^. ZcashWalletId ==. val zw)
pure w
case b of
Nothing -> throwIO $ userError "Failed to retrieve wallet"
Just x -> return $ zcashWalletLastSync $ entityVal x
-- | Save a @WalletTransaction@ -- | Save a @WalletTransaction@
saveWalletTransaction :: saveWalletTransaction ::
ConnectionPool ConnectionPool
@ -1083,12 +1100,15 @@ findTransparentSpends pool za = do
set w [WalletTrNoteSpent =. val True] set w [WalletTrNoteSpent =. val True]
where_ $ w ^. WalletTrNoteId ==. val (entityKey n) where_ $ w ^. WalletTrNoteId ==. val (entityKey n)
t' <- upsertWalTx (entityVal $ fst $ head s) za t' <- upsertWalTx (entityVal $ fst $ head s) za
insert_ $ _ <-
WalletTrSpend upsert
(entityKey t') (WalletTrSpend
(entityKey n) (entityKey t')
za (entityKey n)
(walletTrNoteValue $ entityVal n) za
(walletTrNoteValue $ entityVal n))
[]
return ()
getWalletSapNotes :: getWalletSapNotes ::
ConnectionPool -> ZcashAccountId -> IO [Entity WalletSapNote] ConnectionPool -> ZcashAccountId -> IO [Entity WalletSapNote]
@ -1130,12 +1150,15 @@ findSapSpends pool za (n:notes) = do
set w [WalletSapNoteSpent =. val True] set w [WalletSapNoteSpent =. val True]
where_ $ w ^. WalletSapNoteId ==. val (entityKey n) where_ $ w ^. WalletSapNoteId ==. val (entityKey n)
t' <- upsertWalTx (entityVal $ fst $ head s) za t' <- upsertWalTx (entityVal $ fst $ head s) za
insert_ $ _ <-
WalletSapSpend upsert
(entityKey t') (WalletSapSpend
(entityKey n) (entityKey t')
za (entityKey n)
(walletSapNoteValue $ entityVal n) za
(walletSapNoteValue $ entityVal n))
[]
return ()
findSapSpends pool za notes findSapSpends pool za notes
getWalletOrchNotes :: getWalletOrchNotes ::
@ -1275,12 +1298,15 @@ findOrchSpends pool za (n:notes) = do
set w [WalletOrchNoteSpent =. val True] set w [WalletOrchNoteSpent =. val True]
where_ $ w ^. WalletOrchNoteId ==. val (entityKey n) where_ $ w ^. WalletOrchNoteId ==. val (entityKey n)
t' <- upsertWalTx (entityVal $ fst $ head s) za t' <- upsertWalTx (entityVal $ fst $ head s) za
insert_ $ _ <-
WalletOrchSpend upsert
(entityKey t') (WalletOrchSpend
(entityKey n) (entityKey t')
za (entityKey n)
(walletOrchNoteValue $ entityVal n) za
(walletOrchNoteValue $ entityVal n))
[]
return ()
findOrchSpends pool za notes findOrchSpends pool za notes
upsertWalTx :: upsertWalTx ::
@ -1316,6 +1342,9 @@ clearWalletTransactions pool = do
runNoLoggingT $ runNoLoggingT $
PS.retryOnBusy $ PS.retryOnBusy $
flip PS.runSqlPool pool $ do flip PS.runSqlPool pool $ do
delete $ do
_ <- from $ table @UserTx
return ()
delete $ do delete $ do
_ <- from $ table @WalletOrchSpend _ <- from $ table @WalletOrchSpend
return () return ()
@ -1337,9 +1366,6 @@ clearWalletTransactions pool = do
delete $ do delete $ do
_ <- from $ table @WalletTransaction _ <- from $ table @WalletTransaction
return () return ()
delete $ do
_ <- from $ table @UserTx
return ()
getWalletUnspentTrNotes :: getWalletUnspentTrNotes ::
ConnectionPool -> ZcashAccountId -> IO [Entity WalletTrNote] ConnectionPool -> ZcashAccountId -> IO [Entity WalletTrNote]

View file

@ -26,17 +26,17 @@ jsonNumber i = Number $ scientific (fromIntegral i) 0
-- | Helper function to display small amounts of ZEC -- | Helper function to display small amounts of ZEC
displayZec :: Integer -> String displayZec :: Integer -> String
displayZec s displayZec s
| s < 100 = show s ++ " zats " | abs s < 100 = show s ++ " zats "
| s < 100000 = show (fromIntegral s / 100) ++ " μZEC " | abs s < 100000 = show (fromIntegral s / 100) ++ " μZEC "
| s < 100000000 = show (fromIntegral s / 100000) ++ " mZEC " | abs s < 100000000 = show (fromIntegral s / 100000) ++ " mZEC "
| otherwise = show (fromIntegral s / 100000000) ++ " ZEC " | otherwise = show (fromIntegral s / 100000000) ++ " ZEC "
-- | Helper function to display small amounts of ZEC -- | Helper function to display small amounts of ZEC
displayTaz :: Integer -> String displayTaz :: Integer -> String
displayTaz s displayTaz s
| s < 100 = show s ++ " tazs " | abs s < 100 = show s ++ " tazs "
| s < 100000 = show (fromIntegral s / 100) ++ " μTAZ " | abs s < 100000 = show (fromIntegral s / 100) ++ " μTAZ "
| s < 100000000 = show (fromIntegral s / 100000) ++ " mTAZ " | abs s < 100000000 = show (fromIntegral s / 100000) ++ " mTAZ "
| otherwise = show (fromIntegral s / 100000000) ++ " TAZ " | otherwise = show (fromIntegral s / 100000000) ++ " TAZ "
-- | Helper function to display abbreviated Unified Address -- | Helper function to display abbreviated Unified Address

View file

@ -1,7 +1,9 @@
{-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE OverloadedStrings #-}
import Control.Monad (when) import Control.Monad (when)
import Control.Monad.Logger (runNoLoggingT)
import Data.HexString import Data.HexString
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
@ -10,15 +12,22 @@ import Test.Hspec
import ZcashHaskell.Orchard (isValidUnifiedAddress) import ZcashHaskell.Orchard (isValidUnifiedAddress)
import ZcashHaskell.Sapling import ZcashHaskell.Sapling
( decodeSaplingOutputEsk ( decodeSaplingOutputEsk
, encodeSaplingAddress
, getSaplingNotePosition , getSaplingNotePosition
, getSaplingWitness , getSaplingWitness
, isValidShieldedAddress
, updateSaplingCommitmentTree , updateSaplingCommitmentTree
) )
import ZcashHaskell.Transparent
( decodeExchangeAddress
, decodeTransparentAddress
)
import ZcashHaskell.Types import ZcashHaskell.Types
( DecodedNote(..) ( DecodedNote(..)
, OrchardSpendingKey(..) , OrchardSpendingKey(..)
, Phrase(..) , Phrase(..)
, SaplingCommitmentTree(..) , SaplingCommitmentTree(..)
, SaplingReceiver(..)
, SaplingSpendingKey(..) , SaplingSpendingKey(..)
, Scope(..) , Scope(..)
, ShieldedOutput(..) , ShieldedOutput(..)
@ -72,8 +81,9 @@ main = do
"None" `shouldBe` maybe "None" zcashWalletName s "None" `shouldBe` maybe "None" zcashWalletName s
describe "Wallet function tests:" $ do describe "Wallet function tests:" $ do
it "Save Wallet:" $ do it "Save Wallet:" $ do
pool <- runNoLoggingT $ initPool "test.db"
zw <- zw <-
saveWallet "test.db" $ saveWallet pool $
ZcashWallet ZcashWallet
"Testing" "Testing"
(ZcashNetDB MainNet) (ZcashNetDB MainNet)
@ -84,19 +94,19 @@ main = do
0 0
zw `shouldNotBe` Nothing zw `shouldNotBe` Nothing
it "Save Account:" $ do it "Save Account:" $ do
pool <- runNoLoggingT $ initPool "test.db"
s <- s <-
runSqlite "test.db" $ do runSqlite "test.db" $ do
selectList [ZcashWalletName ==. "Testing"] [] selectList [ZcashWalletName ==. "Testing"] []
za <- za <- saveAccount pool =<< createZcashAccount "TestAccount" 0 (head s)
saveAccount "test.db" =<<
createZcashAccount "TestAccount" 0 (head s)
za `shouldNotBe` Nothing za `shouldNotBe` Nothing
it "Save address:" $ do it "Save address:" $ do
pool <- runNoLoggingT $ initPool "test.db"
acList <- acList <-
runSqlite "test.db" $ runSqlite "test.db" $
selectList [ZcashAccountName ==. "TestAccount"] [] selectList [ZcashAccountName ==. "TestAccount"] []
zAdd <- zAdd <-
saveAddress "test.db" =<< saveAddress pool =<<
createWalletAddress "Personal123" 0 MainNet External (head acList) createWalletAddress "Personal123" 0 MainNet External (head acList)
addList <- addList <-
runSqlite "test.db" $ runSqlite "test.db" $
@ -162,29 +172,82 @@ 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
res <- selectUnspentNotes "zenith.db" (toSqlKey 1) 14000000 pool <- runNoLoggingT $ initPool "zenith.db"
res <- selectUnspentNotes pool (toSqlKey 1) 14000000
res `shouldNotBe` ([], [], []) res `shouldNotBe` ([], [], [])
it "Value greater than balance" $ do it "Value greater than balance" $ do
let res = selectUnspentNotes "zenith.db" (toSqlKey 1) 84000000 pool <- runNoLoggingT $ initPool "zenith.db"
let res = selectUnspentNotes pool (toSqlKey 1) 84000000
res `shouldThrow` anyIOException res `shouldThrow` anyIOException
it "Fee calculation" $ do it "Fee calculation" $ do
res <- selectUnspentNotes "zenith.db" (toSqlKey 1) 14000000 pool <- runNoLoggingT $ initPool "zenith.db"
res <- selectUnspentNotes pool (toSqlKey 1) 14000000
calculateTxFee res 3 `shouldBe` 20000 calculateTxFee res 3 `shouldBe` 20000
describe "Creating Tx" $ do describe "Testing validation" $ do
xit "To Orchard" $ do it "Unified" $ do
let uaRead = let a =
isValidUnifiedAddress "utest1zfnw84xuxg0ytzqc008gz0qntr8cvwu4qjsccgtxwdrjywra7uj85x8ldymjc2jd3jvvvhyj3xwsunyvwkr5084t6p5gmvzwdgvwpflrpd6a3squ2dp8vt7cxngmwk30l44wkmvyfegypqmezxfnqj572lr779gkqj5xekp66uv4jga58alnc5j7tuank758zd96ap4f09udg6y6pxu"
"utest1dl54utt6prjj5e0dnlknwumnxq9hycdjpkfr0sy6e6h522remqee8axe9zax0wsjrwpj76v555pdhvj9rnargpfyycs0vpkapq98xcdhem99gc4wchzn0ggepq3y6nz3a9sscwgqxgsh9vzhcad402y3x9szfregck5gslkya3c79d86xx0l33tpk8gnn7ew9vw37w43zh22u8dgdax" True `shouldBe`
case uaRead of (case isValidUnifiedAddress (E.encodeUtf8 a) of
Nothing -> assertFailure "wrong address" Just _a1 -> True
Just ua -> do Nothing ->
tx <- isValidShieldedAddress (E.encodeUtf8 a) ||
prepareTx (case decodeTransparentAddress (E.encodeUtf8 a) of
"zenith.db" Just _a3 -> True
TestNet Nothing ->
(toSqlKey 1) case decodeExchangeAddress a of
2819811 Just _a4 -> True
0.04 Nothing -> False))
ua it "Sapling" $ do
"sent with Zenith, test" let a =
tx `shouldBe` Right (hexString "deadbeef") "ztestsapling1tgjr4zppwk4ne8xy6gdq4z2gwq7dmf5jq8z2ctpn8nlmtse0a74fa5z0m8z383gmpgqz6q6duu4"
True `shouldBe`
(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 a of
Just _a4 -> True
Nothing -> False))
it "Transparent" $ do
let a = "tmGfVZHuGVJ5vcLAgBdkUU4w7fLTRE5nXm3"
True `shouldBe`
(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 a of
Just _a4 -> True
Nothing -> False))
it "Check Sapling Address" $ do
let a =
encodeSaplingAddress TestNet $
SaplingReceiver
"Z$:\136!u\171<\156\196\210\SUB\n\137Hp<\221\166\146\SOH\196\172,3<\255\181\195/\239\170\158\208O\217\197\DC3\197\ESC\n\NUL-"
a `shouldBe`
Just
"ztestsapling1tgjr4zppwk4ne8xy6gdq4z2gwq7dmf5jq8z2ctpn8nlmtse0a74fa5z0m8z383gmpgqz6q6duu4"
{-describe "Creating Tx" $ do-}
{-xit "To Orchard" $ do-}
{-let uaRead =-}
{-isValidUnifiedAddress-}
{-"utest1dl54utt6prjj5e0dnlknwumnxq9hycdjpkfr0sy6e6h522remqee8axe9zax0wsjrwpj76v555pdhvj9rnargpfyycs0vpkapq98xcdhem99gc4wchzn0ggepq3y6nz3a9sscwgqxgsh9vzhcad402y3x9szfregck5gslkya3c79d86xx0l33tpk8gnn7ew9vw37w43zh22u8dgdax"-}
{-case uaRead of-}
{-Nothing -> assertFailure "wrong address"-}
{-Just ua -> do-}
{-tx <--}
{-prepareTx-}
{-"zenith.db"-}
{-TestNet-}
{-(toSqlKey 1)-}
{-2819811-}
{-0.04-}
{-ua-}
{-"sent with Zenith, test"-}
{-tx `shouldBe` Right (hexString "deadbeef")-}

@ -1 +1 @@
Subproject commit 22c0fe374976d9f2323a8b7cd42f941423d45111 Subproject commit 9dddb42bb3ab78ed0c4d44efb00960ac112c2ce6

View file

@ -46,6 +46,7 @@ library
, bytestring , bytestring
, esqueleto , esqueleto
, resource-pool , resource-pool
, binary
, exceptions , exceptions
, monad-logger , monad-logger
, vty-crossplatform , vty-crossplatform
@ -122,6 +123,7 @@ test-suite zenith-tests
base >=4.12 && <5 base >=4.12 && <5
, bytestring , bytestring
, configurator , configurator
, monad-logger
, data-default , data-default
, sort , sort
, text , text