diff --git a/src/Zenith/CLI.hs b/src/Zenith/CLI.hs index 10868f1..4dabde1 100644 --- a/src/Zenith/CLI.hs +++ b/src/Zenith/CLI.hs @@ -11,11 +11,15 @@ import qualified Brick.Focus as F import Brick.Forms ( Form(..) , (@@=) + , allFieldsValid + , editShowableFieldWithValidate , editTextField , focusedFormInputAttr , handleFormEvent + , invalidFormInputAttr , newForm , renderForm + , setFieldValid , updateFormState ) import qualified Brick.Main as M @@ -49,6 +53,7 @@ import Brick.Widgets.Core , withBorderStyle ) 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.ProgressBar as P import Control.Concurrent (forkIO, threadDelay) @@ -57,6 +62,7 @@ import Control.Monad (forever, void) import Control.Monad.IO.Class (liftIO) import Control.Monad.Logger (LoggingT, runFileLoggingT, runNoLoggingT) import Data.Aeson +import Data.HexString (toText) import Data.Maybe import qualified Data.Text as T import qualified Data.Text.Encoding as E @@ -73,7 +79,12 @@ import System.Hclip import Text.Wrap (FillScope(..), FillStrategy(..), WrapSettings(..), wrapText) import ZcashHaskell.Keys (generateWalletSeedPhrase, getWalletSeed) 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.Utils (getBlockTime, makeZebraCall) import Zenith.Core @@ -94,6 +105,9 @@ data Name | TList | HelpDialog | DialogInputField + | RecField + | AmtField + | MemoField deriving (Eq, Show, Ord) data DialogInput = DialogInput @@ -102,12 +116,21 @@ data DialogInput = DialogInput makeLenses ''DialogInput +data SendInput = SendInput + { _sendTo :: !T.Text + , _sendAmt :: !Float + , _sendMemo :: !T.Text + } deriving (Show) + +makeLenses ''SendInput + data DialogType = WName | AName | AdName | WSelect | ASelect + | SendTx | Blank data DisplayType @@ -116,6 +139,7 @@ data DisplayType | PhraseDisplay | TxDisplay | SyncDisplay + | SendDisplay | BlankDisplay data Tick @@ -144,6 +168,7 @@ data State = State , _barValue :: !Float , _eventDispatch :: !(BC.BChan Tick) , _timer :: !Int + , _txForm :: !(Form SendInput () Name) } makeLenses ''State @@ -182,7 +207,7 @@ drawUI s = [splashDialog s, helpDialog s, displayDialog s, inputDialog s, ui s] listAddressBox "Addresses" (st ^. addresses) <+> B.vBorder <+> (C.hCenter (str ("Last block seen: " ++ show (st ^. syncBlock))) <=> - listTxBox "Transactions" (st ^. transactions))) <=> + listTxBox "Transactions" (st ^. network) (st ^. transactions))) <=> C.hCenter (hBox [ capCommand "W" "allets" @@ -230,13 +255,14 @@ drawUI s = [splashDialog s, helpDialog s, displayDialog s, inputDialog s, ui s] , capCommand "Tab " "->" ]) ] - listTxBox :: String -> L.List Name (Entity UserTx) -> Widget Name - listTxBox titleLabel tx = + listTxBox :: + String -> ZcashNet -> L.List Name (Entity UserTx) -> Widget Name + listTxBox titleLabel znet tx = C.vCenter $ vBox [ C.hCenter (B.borderWithLabel (str titleLabel) $ - hLimit 40 $ vLimit 15 $ L.renderList listDrawTx True tx) + hLimit 50 $ vLimit 15 $ L.renderList (listDrawTx znet) True tx) , str " " , C.hCenter (hBox @@ -303,6 +329,12 @@ drawUI s = [splashDialog s, helpDialog s, displayDialog s, inputDialog s, ui s] , capCommand "N" "ew" , xCommand ])) + SendTx -> + D.renderDialog + (D.dialog (Just (str "Send Transaction")) Nothing 50) + (renderForm (st ^. txForm) <=> + C.hCenter + (hBox [capCommand "↲ " "Send", capCommand " " "Cancel"])) Blank -> emptyWidget splashDialog :: State -> Widget Name splashDialog st = @@ -421,6 +453,11 @@ drawUI s = [splashDialog s, helpDialog s, displayDialog s, inputDialog s, ui s] (P.progressBar (Just $ show (st ^. barValue * 100)) (_barValue st)))) + SendDisplay -> + withBorderStyle unicodeBold $ + D.renderDialog + (D.dialog (Just $ txt "Sending Transaction") Nothing 50) + (padAll 1 (str $ st ^. msg)) BlankDisplay -> emptyWidget mkInputForm :: DialogInput -> Form DialogInput e Name @@ -431,6 +468,33 @@ mkInputForm = label s 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 sel a = let selStr s = @@ -466,18 +530,22 @@ listDrawAddress sel w = walletAddressName (entityVal w) <> ": " <> showAddress (walletAddressUAddress (entityVal w)) -listDrawTx :: Bool -> Entity UserTx -> Widget Name -listDrawTx sel tx = +listDrawTx :: ZcashNet -> Bool -> Entity UserTx -> Widget Name +listDrawTx znet sel tx = selStr $ T.pack (show $ posixSecondsToUTCTime (fromIntegral (userTxTime $ entityVal tx))) <> - " " <> fmtAmt + " " <> T.pack fmtAmt where - amt = fromIntegral (userTxAmount $ entityVal tx) / 100000000 + amt = fromIntegral $ userTxAmount $ entityVal tx + dispAmount = + if znet == MainNet + then displayZec amt + else displayTaz amt fmtAmt = if amt > 0 - then "↘" <> T.pack (show amt) <> " " - else " " <> T.pack (show amt) <> "↗" + then "↘" <> dispAmount <> " " + else " " <> dispAmount <> "↗" selStr s = if sel then withAttr customAttr (txt $ "> " <> s) @@ -561,14 +629,22 @@ appEvent (BT.AppEvent t) = do pool <- liftIO $ runNoLoggingT $ initPool $ s ^. dbPath case t of TickMsg m -> do - BT.modify $ set msg m - BT.modify $ set displayBox MsgDisplay + case s ^. displayBox of + AddrDisplay -> return () + MsgDisplay -> return () + PhraseDisplay -> return () + TxDisplay -> return () + SyncDisplay -> return () + SendDisplay -> do + BT.modify $ set msg m + BlankDisplay -> return () TickVal v -> do case s ^. displayBox of AddrDisplay -> return () MsgDisplay -> return () PhraseDisplay -> return () TxDisplay -> return () + SendDisplay -> return () SyncDisplay -> do if s ^. barValue == 1.0 then do @@ -600,6 +676,7 @@ appEvent (BT.AppEvent t) = do WName -> return () WSelect -> return () ASelect -> return () + SendTx -> return () Blank -> do if s ^. timer == 90 then do @@ -643,6 +720,11 @@ appEvent (BT.VtyEvent e) = do setClipboard $ T.unpack $ getUA $ walletAddressUAddress $ entityVal a + BT.modify $ + set msg $ + "Copied Unified Address <" ++ + T.unpack (walletAddressName (entityVal a)) ++ ">!" + BT.modify $ set displayBox MsgDisplay Nothing -> return () V.EvKey (V.KChar 's') [] -> do case L.listSelectedElement $ s ^. addresses of @@ -653,6 +735,11 @@ appEvent (BT.VtyEvent e) = do getSaplingFromUA $ E.encodeUtf8 $ getUA $ walletAddressUAddress $ entityVal a + BT.modify $ + set msg $ + "Copied Sapling Address <" ++ + T.unpack (walletAddressName (entityVal a)) ++ ">!" + BT.modify $ set displayBox MsgDisplay Nothing -> return () V.EvKey (V.KChar 't') [] -> do case L.listSelectedElement $ s ^. addresses of @@ -667,11 +754,17 @@ appEvent (BT.VtyEvent e) = do (isValidUnifiedAddress . E.encodeUtf8 . getUA . walletAddressUAddress) (entityVal a) + BT.modify $ + set msg $ + "Copied Transparent Address <" ++ + T.unpack (walletAddressName (entityVal a)) ++ ">!" + BT.modify $ set displayBox MsgDisplay Nothing -> return () _ev -> return () MsgDisplay -> BT.modify $ set displayBox BlankDisplay PhraseDisplay -> BT.modify $ set displayBox BlankDisplay TxDisplay -> BT.modify $ set displayBox BlankDisplay + SendDisplay -> BT.modify $ set displayBox BlankDisplay SyncDisplay -> BT.modify $ set displayBox BlankDisplay BlankDisplay -> do case s ^. dialogBox of @@ -756,6 +849,71 @@ appEvent (BT.VtyEvent e) = do s ^. inputForm BT.modify $ set dialogBox AName 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 case e of V.EvKey (V.KChar '\t') [] -> focusRing %= F.focusNext @@ -774,6 +932,11 @@ appEvent (BT.VtyEvent e) = do BT.modify $ set displayBox TxDisplay V.EvKey (V.KChar 'a') [] -> 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 -> case r of Just AList -> @@ -798,6 +961,9 @@ theMap = , (titleAttr, V.withStyle (fg V.brightGreen) V.bold) , (blinkAttr, style V.blink) , (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) , (barDoneAttr, V.white `on` V.blue) , (barToDoAttr, V.white `on` V.black) @@ -885,6 +1051,7 @@ runZenithCLI config = do 1.0 eventChan 0 + (mkSendForm 0 $ SendInput "" 0.0 "") Left e -> do print $ "No Zebra node available on port " <> @@ -1063,3 +1230,51 @@ addNewAddress n scope s = do T.unpack n ++ "(" ++ 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" diff --git a/src/Zenith/Core.hs b/src/Zenith/Core.hs index 8122f5a..a8dc6f2 100644 --- a/src/Zenith/Core.hs +++ b/src/Zenith/Core.hs @@ -10,6 +10,8 @@ import Control.Monad.Logger ( LoggingT , MonadLoggerIO , NoLoggingT + , logDebugN + , logErrorN , logInfoN , logWarnN , runFileLoggingT @@ -18,6 +20,7 @@ import Control.Monad.Logger ) import Crypto.Secp256k1 (SecKey(..)) import Data.Aeson +import Data.Binary.Get hiding (getBytes) import qualified Data.ByteString as BS import qualified Data.ByteString.Lazy as LBS 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)) where tout = - if i == 1 + if i == 1 || i == 2 then 1 else 0 sout = - if i == 2 + if i == 3 then 1 else 0 oout = - if i == 3 - then 2 - else 1 + if i == 4 + then 1 + else 0 -- | Prepare a transaction for sending prepareTx :: @@ -465,9 +468,9 @@ prepareTx :: -> Float -> UnifiedAddress -> T.Text - -> IO (Either TxError HexString) + -> LoggingT IO (Either TxError HexString) prepareTx pool zebraHost zebraPort zn za bh amt ua memo = do - accRead <- getAccountById pool za + accRead <- liftIO $ getAccountById pool za let recipient = case o_rec ua of Nothing -> @@ -481,63 +484,97 @@ prepareTx pool zebraHost zebraPort zn za bh amt ua memo = do P2SH -> (2, toBytes $ tr_bytes r3) Just r2 -> (3, getBytes r2) Just r1 -> (4, getBytes r1) - print recipient - trees <- getCommitmentTrees zebraHost zebraPort bh + logDebugN $ T.pack $ show recipient + logDebugN $ T.pack $ "Target block: " ++ show bh + trees <- liftIO $ getCommitmentTrees zebraHost zebraPort bh let sT = SaplingCommitmentTree $ ztiSapling trees let oT = OrchardCommitmentTree $ ztiOrchard trees case accRead of - Nothing -> throwIO $ userError "Can't find Account" + Nothing -> do + logErrorN "Can't find Account" + return $ Left ZHError Just acc -> do - print acc - spParams <- BS.readFile "sapling-spend.params" - outParams <- BS.readFile "sapling-output.params" + logDebugN $ T.pack $ show acc + spParams <- liftIO $ BS.readFile "sapling-spend.params" + outParams <- liftIO $ BS.readFile "sapling-output.params" if show (md5 $ LBS.fromStrict spParams) /= "0f44c12ef115ae019decf18ade583b20" - then throwIO $ userError "Can't validate sapling parameters" - else print "Valid Sapling spend params" + then logErrorN "Can't validate sapling parameters" + else logInfoN "Valid Sapling spend params" if show (md5 $ LBS.fromStrict outParams) /= "924daf81b87a81bbbb9c7d18562046c8" - then throwIO $ userError "Can't validate sapling parameters" - else print "Valid Sapling output params" - print $ BS.length spParams - print $ BS.length outParams - print "Read Sapling params" + then logErrorN "Can't validate sapling parameters" + else logInfoN "Valid Sapling output params" + --print $ BS.length spParams + --print $ BS.length outParams + logDebugN "Read Sapling params" let zats = fromIntegral $ floorFloatInteger $ amt * (10 ^ 8) - firstPass <- selectUnspentNotes pool za zats - let fee = calculateTxFee firstPass 3 - print "calculated fee" - print fee - (tList, sList, oList) <- selectUnspentNotes pool za (zats + fee) - print "selected notes" - print tList - print sList - print oList + logDebugN $ T.pack $ show zats + {-firstPass <- liftIO $ selectUnspentNotes pool za zats-} + --let fee = calculateTxFee firstPass $ fst recipient + --logDebugN $ T.pack $ "calculated fee " ++ show fee + (tList, sList, oList) <- liftIO $ selectUnspentNotes pool za (zats + 5000) + logDebugN "selected notes" + logDebugN $ T.pack $ show tList + logDebugN $ T.pack $ show sList + logDebugN $ T.pack $ show oList let noteTotal = getTotalAmount (tList, sList, oList) - print noteTotal tSpends <- + liftIO $ prepTSpends (getTranSK $ zcashAccountTPrivateKey $ entityVal acc) tList - print tSpends + --print tSpends sSpends <- + liftIO $ prepSSpends (getSapSK $ zcashAccountSapSpendKey $ entityVal acc) sList - print sSpends + --print sSpends oSpends <- + liftIO $ prepOSpends (getOrchSK $ zcashAccountOrchSpendKey $ entityVal acc) oList - print oSpends - outgoing <- makeOutgoing acc recipient zats (noteTotal - fee - zats) - print outgoing - let tx = + --print oSpends + dummy <- + liftIO $ makeOutgoing acc recipient zats (noteTotal - 5000 - zats) + logDebugN "Calculating fee" + let feeResponse = createTransaction (Just sT) (Just oT) tSpends sSpends oSpends - outgoing + dummy (SaplingSpendParams spParams) (SaplingOutputParams outParams) zn (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 makeOutgoing :: Entity ZcashAccount @@ -587,7 +624,6 @@ prepareTx pool zebraHost zebraPort zn za bh amt ua memo = do prepTSpends sk notes = do forM notes $ \n -> do tAddRead <- getAddressById pool $ walletTrNoteAddress $ entityVal n - print n case tAddRead of Nothing -> throwIO $ userError "Couldn't read t-address" Just tAdd -> do @@ -614,7 +650,6 @@ prepareTx pool zebraHost zebraPort zn za bh amt ua memo = do SaplingSpendingKey -> [Entity WalletSapNote] -> IO [SaplingTxSpend] prepSSpends sk notes = do forM notes $ \n -> do - print n return $ SaplingTxSpend (getBytes sk) @@ -630,7 +665,6 @@ prepareTx pool zebraHost zebraPort zn za bh amt ua memo = do OrchardSpendingKey -> [Entity WalletOrchNote] -> IO [OrchardTxSpend] prepOSpends sk notes = do forM notes $ \n -> do - print n return $ OrchardTxSpend (getBytes sk) diff --git a/src/Zenith/DB.hs b/src/Zenith/DB.hs index 67d9527..a48151d 100644 --- a/src/Zenith/DB.hs +++ b/src/Zenith/DB.hs @@ -119,7 +119,7 @@ share deriving Show Eq UserTx hex HexStringDB - address WalletAddressId + address WalletAddressId OnDeleteCascade OnUpdateCascade time Int amount Int memo T.Text @@ -127,8 +127,8 @@ share deriving Show Eq WalletTrNote tx WalletTransactionId OnDeleteCascade OnUpdateCascade - accId ZcashAccountId - address WalletAddressId + accId ZcashAccountId OnDeleteCascade OnUpdateCascade + address WalletAddressId OnDeleteCascade OnUpdateCascade value Word64 spent Bool script BS.ByteString @@ -138,13 +138,14 @@ share deriving Show Eq WalletTrSpend tx WalletTransactionId OnDeleteCascade OnUpdateCascade - note WalletTrNoteId - accId ZcashAccountId + note WalletTrNoteId OnDeleteCascade OnUpdateCascade + accId ZcashAccountId OnDeleteCascade OnUpdateCascade value Word64 + UniqueTrSpend tx accId deriving Show Eq WalletSapNote tx WalletTransactionId OnDeleteCascade OnUpdateCascade - accId ZcashAccountId + accId ZcashAccountId OnDeleteCascade OnUpdateCascade value Word64 recipient BS.ByteString memo T.Text @@ -159,13 +160,14 @@ share deriving Show Eq WalletSapSpend tx WalletTransactionId OnDeleteCascade OnUpdateCascade - note WalletSapNoteId - accId ZcashAccountId + note WalletSapNoteId OnDeleteCascade OnUpdateCascade + accId ZcashAccountId OnDeleteCascade OnUpdateCascade value Word64 + UniqueSapSepnd tx accId deriving Show Eq WalletOrchNote tx WalletTransactionId OnDeleteCascade OnUpdateCascade - accId ZcashAccountId + accId ZcashAccountId OnDeleteCascade OnUpdateCascade value Word64 recipient BS.ByteString memo T.Text @@ -181,9 +183,10 @@ share deriving Show Eq WalletOrchSpend tx WalletTransactionId OnDeleteCascade OnUpdateCascade - note WalletOrchNoteId - accId ZcashAccountId + note WalletOrchNoteId OnDeleteCascade OnUpdateCascade + accId ZcashAccountId OnDeleteCascade OnUpdateCascade value Word64 + UniqueOrchSpend tx accId deriving Show Eq ZcashTransaction block Int @@ -579,6 +582,20 @@ getMinBirthdayHeight pool = do Nothing -> return 0 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@ saveWalletTransaction :: ConnectionPool @@ -1083,12 +1100,15 @@ findTransparentSpends pool za = do set w [WalletTrNoteSpent =. val True] where_ $ w ^. WalletTrNoteId ==. val (entityKey n) t' <- upsertWalTx (entityVal $ fst $ head s) za - insert_ $ - WalletTrSpend - (entityKey t') - (entityKey n) - za - (walletTrNoteValue $ entityVal n) + _ <- + upsert + (WalletTrSpend + (entityKey t') + (entityKey n) + za + (walletTrNoteValue $ entityVal n)) + [] + return () getWalletSapNotes :: ConnectionPool -> ZcashAccountId -> IO [Entity WalletSapNote] @@ -1130,12 +1150,15 @@ findSapSpends pool za (n:notes) = do set w [WalletSapNoteSpent =. val True] where_ $ w ^. WalletSapNoteId ==. val (entityKey n) t' <- upsertWalTx (entityVal $ fst $ head s) za - insert_ $ - WalletSapSpend - (entityKey t') - (entityKey n) - za - (walletSapNoteValue $ entityVal n) + _ <- + upsert + (WalletSapSpend + (entityKey t') + (entityKey n) + za + (walletSapNoteValue $ entityVal n)) + [] + return () findSapSpends pool za notes getWalletOrchNotes :: @@ -1275,12 +1298,15 @@ findOrchSpends pool za (n:notes) = do set w [WalletOrchNoteSpent =. val True] where_ $ w ^. WalletOrchNoteId ==. val (entityKey n) t' <- upsertWalTx (entityVal $ fst $ head s) za - insert_ $ - WalletOrchSpend - (entityKey t') - (entityKey n) - za - (walletOrchNoteValue $ entityVal n) + _ <- + upsert + (WalletOrchSpend + (entityKey t') + (entityKey n) + za + (walletOrchNoteValue $ entityVal n)) + [] + return () findOrchSpends pool za notes upsertWalTx :: @@ -1316,6 +1342,9 @@ clearWalletTransactions pool = do runNoLoggingT $ PS.retryOnBusy $ flip PS.runSqlPool pool $ do + delete $ do + _ <- from $ table @UserTx + return () delete $ do _ <- from $ table @WalletOrchSpend return () @@ -1337,9 +1366,6 @@ clearWalletTransactions pool = do delete $ do _ <- from $ table @WalletTransaction return () - delete $ do - _ <- from $ table @UserTx - return () getWalletUnspentTrNotes :: ConnectionPool -> ZcashAccountId -> IO [Entity WalletTrNote] diff --git a/src/Zenith/Utils.hs b/src/Zenith/Utils.hs index 0f013e8..96ca8dd 100644 --- a/src/Zenith/Utils.hs +++ b/src/Zenith/Utils.hs @@ -26,17 +26,17 @@ jsonNumber i = Number $ scientific (fromIntegral i) 0 -- | Helper function to display small amounts of ZEC displayZec :: Integer -> String displayZec s - | s < 100 = show s ++ " zats " - | s < 100000 = show (fromIntegral s / 100) ++ " μZEC " - | s < 100000000 = show (fromIntegral s / 100000) ++ " mZEC " + | abs s < 100 = show s ++ " zats " + | abs s < 100000 = show (fromIntegral s / 100) ++ " μZEC " + | abs s < 100000000 = show (fromIntegral s / 100000) ++ " mZEC " | otherwise = show (fromIntegral s / 100000000) ++ " ZEC " -- | Helper function to display small amounts of ZEC displayTaz :: Integer -> String displayTaz s - | s < 100 = show s ++ " tazs " - | s < 100000 = show (fromIntegral s / 100) ++ " μTAZ " - | s < 100000000 = show (fromIntegral s / 100000) ++ " mTAZ " + | abs s < 100 = show s ++ " tazs " + | abs s < 100000 = show (fromIntegral s / 100) ++ " μTAZ " + | abs s < 100000000 = show (fromIntegral s / 100000) ++ " mTAZ " | otherwise = show (fromIntegral s / 100000000) ++ " TAZ " -- | Helper function to display abbreviated Unified Address diff --git a/test/Spec.hs b/test/Spec.hs index 941ada8..35fb3a1 100644 --- a/test/Spec.hs +++ b/test/Spec.hs @@ -1,7 +1,9 @@ {-# LANGUAGE OverloadedStrings #-} import Control.Monad (when) +import Control.Monad.Logger (runNoLoggingT) import Data.HexString +import qualified Data.Text.Encoding as E import Database.Persist import Database.Persist.Sqlite import System.Directory @@ -10,15 +12,22 @@ import Test.Hspec import ZcashHaskell.Orchard (isValidUnifiedAddress) import ZcashHaskell.Sapling ( decodeSaplingOutputEsk + , encodeSaplingAddress , getSaplingNotePosition , getSaplingWitness + , isValidShieldedAddress , updateSaplingCommitmentTree ) +import ZcashHaskell.Transparent + ( decodeExchangeAddress + , decodeTransparentAddress + ) import ZcashHaskell.Types ( DecodedNote(..) , OrchardSpendingKey(..) , Phrase(..) , SaplingCommitmentTree(..) + , SaplingReceiver(..) , SaplingSpendingKey(..) , Scope(..) , ShieldedOutput(..) @@ -72,8 +81,9 @@ main = do "None" `shouldBe` maybe "None" zcashWalletName s describe "Wallet function tests:" $ do it "Save Wallet:" $ do + pool <- runNoLoggingT $ initPool "test.db" zw <- - saveWallet "test.db" $ + saveWallet pool $ ZcashWallet "Testing" (ZcashNetDB MainNet) @@ -84,19 +94,19 @@ main = do 0 zw `shouldNotBe` Nothing it "Save Account:" $ do + pool <- runNoLoggingT $ initPool "test.db" s <- runSqlite "test.db" $ do selectList [ZcashWalletName ==. "Testing"] [] - za <- - saveAccount "test.db" =<< - createZcashAccount "TestAccount" 0 (head s) + za <- saveAccount pool =<< createZcashAccount "TestAccount" 0 (head s) za `shouldNotBe` Nothing it "Save address:" $ do + pool <- runNoLoggingT $ initPool "test.db" acList <- runSqlite "test.db" $ selectList [ZcashAccountName ==. "TestAccount"] [] zAdd <- - saveAddress "test.db" =<< + saveAddress pool =<< createWalletAddress "Personal123" 0 MainNet External (head acList) addList <- runSqlite "test.db" $ @@ -162,29 +172,82 @@ main = do "6c5d1413c63a9a88db71c3f41dc12cd60197ee742fc75b217215e7144db48bd3" describe "Note selection for Tx" $ 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` ([], [], []) 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 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 - 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") + describe "Testing validation" $ do + it "Unified" $ do + let a = + "utest1zfnw84xuxg0ytzqc008gz0qntr8cvwu4qjsccgtxwdrjywra7uj85x8ldymjc2jd3jvvvhyj3xwsunyvwkr5084t6p5gmvzwdgvwpflrpd6a3squ2dp8vt7cxngmwk30l44wkmvyfegypqmezxfnqj572lr779gkqj5xekp66uv4jga58alnc5j7tuank758zd96ap4f09udg6y6pxu" + 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 "Sapling" $ do + let a = + "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")-} diff --git a/zcash-haskell b/zcash-haskell index 22c0fe3..9dddb42 160000 --- a/zcash-haskell +++ b/zcash-haskell @@ -1 +1 @@ -Subproject commit 22c0fe374976d9f2323a8b7cd42f941423d45111 +Subproject commit 9dddb42bb3ab78ed0c4d44efb00960ac112c2ce6 diff --git a/zenith.cabal b/zenith.cabal index 41d11ff..12e0b6c 100644 --- a/zenith.cabal +++ b/zenith.cabal @@ -46,6 +46,7 @@ library , bytestring , esqueleto , resource-pool + , binary , exceptions , monad-logger , vty-crossplatform @@ -122,6 +123,7 @@ test-suite zenith-tests base >=4.12 && <5 , bytestring , configurator + , monad-logger , data-default , sort , text