diff --git a/CHANGELOG.md b/CHANGELOG.md index 597328a..2ebaabf 100644 --- a/CHANGELOG.md +++ b/CHANGELOG.md @@ -5,6 +5,12 @@ All notable changes to this project will be documented in this file. The format is based on [Keep a Changelog](https://keepachangelog.com/en/1.0.0/), and this project adheres to [Semantic Versioning](https://semver.org/spec/v2.0.0.html). +## [0.5.0.0] + +### Added + +- Core functions for sending transactions + ## [0.4.6.0] ### Added diff --git a/app/Main.hs b/app/Main.hs index eb13ce7..39d5f30 100644 --- a/app/Main.hs +++ b/app/Main.hs @@ -18,7 +18,7 @@ import System.IO import Text.Read (readMaybe) import ZcashHaskell.Types import Zenith.CLI -import Zenith.Core (clearSync, testSync) +import Zenith.Core (clearSync, testSend, testSync) import Zenith.Types (Config(..), ZcashAddress(..), ZcashPool(..), ZcashTx(..)) import Zenith.Utils import Zenith.Zcashd @@ -223,6 +223,7 @@ main = do "cli" -> runZenithCLI myConfig "sync" -> testSync myConfig "rescan" -> clearSync myConfig + "testsend" -> testSend _ -> printUsage else printUsage diff --git a/sapling-output.params b/sapling-output.params new file mode 100644 index 0000000..01760fa Binary files /dev/null and b/sapling-output.params differ diff --git a/sapling-spend.params b/sapling-spend.params new file mode 100644 index 0000000..b91cd77 Binary files /dev/null and b/sapling-spend.params differ diff --git a/src/Zenith/CLI.hs b/src/Zenith/CLI.hs index 7b18b9a..f0d64be 100644 --- a/src/Zenith/CLI.hs +++ b/src/Zenith/CLI.hs @@ -6,6 +6,7 @@ module Zenith.CLI where import qualified Brick.AttrMap as A +import qualified Brick.BChan as BC import qualified Brick.Focus as F import Brick.Forms ( Form(..) @@ -20,7 +21,7 @@ import Brick.Forms import qualified Brick.Main as M import qualified Brick.Types as BT import Brick.Types (Widget) -import Brick.Util (fg, on, style) +import Brick.Util (bg, clamp, fg, on, style) import qualified Brick.Widgets.Border as B import Brick.Widgets.Border.Style (unicode, unicodeBold) import qualified Brick.Widgets.Center as C @@ -41,6 +42,7 @@ import Brick.Widgets.Core , txt , txtWrap , txtWrapWith + , updateAttrMap , vBox , vLimit , withAttr @@ -48,9 +50,13 @@ import Brick.Widgets.Core ) import qualified Brick.Widgets.Dialog as D import qualified Brick.Widgets.List as L +import qualified Brick.Widgets.ProgressBar as P +import Control.Concurrent (forkIO, threadDelay) import Control.Exception (catch, throw, throwIO, try) -import Control.Monad (void) +import Control.Monad (forever, void) import Control.Monad.IO.Class (liftIO) +import Control.Monad.Logger (runFileLoggingT) +import Data.Aeson import Data.Maybe import qualified Data.Text as T import qualified Data.Text.Encoding as E @@ -58,6 +64,7 @@ import Data.Time.Clock.POSIX (posixSecondsToUTCTime) import qualified Data.Vector as Vec import Database.Persist import qualified Graphics.Vty as V +import qualified Graphics.Vty.CrossPlatform as VC import Lens.Micro ((&), (.~), (^.), set) import Lens.Micro.Mtl import Lens.Micro.TH @@ -66,15 +73,17 @@ import ZcashHaskell.Keys (generateWalletSeedPhrase, getWalletSeed) import ZcashHaskell.Orchard (getSaplingFromUA, isValidUnifiedAddress) import ZcashHaskell.Transparent (encodeTransparentReceiver) import ZcashHaskell.Types +import ZcashHaskell.Utils (getBlockTime, makeZebraCall) import Zenith.Core import Zenith.DB +import Zenith.Scanner (processTx) import Zenith.Types ( Config(..) , PhraseDB(..) , UnifiedAddressDB(..) , ZcashNetDB(..) ) -import Zenith.Utils (displayTaz, displayZec, showAddress) +import Zenith.Utils (displayTaz, displayZec, jsonNumber, showAddress) data Name = WList @@ -104,8 +113,12 @@ data DisplayType | MsgDisplay | PhraseDisplay | TxDisplay + | SyncDisplay | BlankDisplay +data Tick = + Tick + data State = State { _network :: !ZcashNet , _wallets :: !(L.List Name (Entity ZcashWallet)) @@ -120,9 +133,13 @@ data State = State , _focusRing :: !(F.FocusRing Name) , _startBlock :: !Int , _dbPath :: !T.Text + , _zebraHost :: !T.Text + , _zebraPort :: !Int , _displayBox :: !DisplayType , _syncBlock :: !Int , _balance :: !Integer + , _barValue :: !Float + , _eventDispatch :: !(BC.BChan Tick) } makeLenses ''State @@ -282,7 +299,7 @@ drawUI s = [splashDialog s, helpDialog s, displayDialog s, inputDialog s, ui s] titleAttr (str " _____ _ _ _ \n|__ /___ _ __ (_) |_| |__\n / // _ \\ '_ \\| | __| '_ \\\n / /| __/ | | | | |_| | | |\n/____\\___|_| |_|_|\\__|_| |_|") <=> - C.hCenter (withAttr titleAttr (str "Zcash Wallet v0.4.6.0")) <=> + C.hCenter (withAttr titleAttr (str "Zcash Wallet v0.5.0.0")) <=> C.hCenter (withAttr blinkAttr $ str "Press any key...")) else emptyWidget capCommand :: String -> String -> Widget Name @@ -367,6 +384,20 @@ drawUI s = [splashDialog s, helpDialog s, displayDialog s, inputDialog s, ui s] txtWrapWith (WrapSettings False True NoFill FillAfterFirst) (userTxMemo (entityVal tx))))) + SyncDisplay -> + withBorderStyle unicodeBold $ + D.renderDialog + (D.dialog (Just $ txt "Sync") Nothing 50) + (padAll + 1 + (updateAttrMap + (A.mapAttrNames + [ (barDoneAttr, P.progressCompleteAttr) + , (barToDoAttr, P.progressIncompleteAttr) + ]) + (P.progressBar + (Just $ show (st ^. barValue * 100)) + (_barValue st)))) BlankDisplay -> emptyWidget mkInputForm :: DialogInput -> Form DialogInput e Name @@ -438,7 +469,89 @@ titleAttr = A.attrName "title" blinkAttr :: A.AttrName blinkAttr = A.attrName "blink" -appEvent :: BT.BrickEvent Name e -> BT.EventM Name State () +baseAttr :: A.AttrName +baseAttr = A.attrName "base" + +barDoneAttr :: A.AttrName +barDoneAttr = A.attrName "done" + +barToDoAttr :: A.AttrName +barToDoAttr = A.attrName "remaining" + +validBarValue :: Float -> Float +validBarValue = clamp 0 1 + +scanZebra :: Int -> BT.EventM Name State () +scanZebra b = do + s <- BT.get + _ <- liftIO $ initDb $ s ^. dbPath + bStatus <- liftIO $ checkBlockChain (s ^. zebraHost) (s ^. zebraPort) + dbBlock <- liftIO $ getMaxBlock $ s ^. dbPath + let sb = max dbBlock b + if sb > zgb_blocks bStatus || sb < 1 + then do + BT.modify $ set msg "Invalid starting block for scan" + BT.modify $ set displayBox MsgDisplay + else do + let bList = [(sb + 1) .. (zgb_blocks bStatus)] + let step = (1.0 :: Float) / fromIntegral (zgb_blocks bStatus - (sb + 1)) + mapM_ (processBlock step) bList + where + processBlock :: Float -> Int -> BT.EventM Name State () + processBlock step bl = do + s <- BT.get + r <- + liftIO $ + makeZebraCall + (s ^. zebraHost) + (s ^. zebraPort) + "getblock" + [Data.Aeson.String $ T.pack $ show bl, jsonNumber 1] + case r of + Left e1 -> do + BT.modify $ set msg e1 + BT.modify $ set displayBox MsgDisplay + Right blk -> do + r2 <- + liftIO $ + makeZebraCall + (s ^. zebraHost) + (s ^. zebraPort) + "getblock" + [Data.Aeson.String $ T.pack $ show bl, jsonNumber 0] + case r2 of + Left e2 -> do + BT.modify $ set msg e2 + BT.modify $ set displayBox MsgDisplay + Right hb -> do + let blockTime = getBlockTime hb + liftIO $ + mapM_ + (processTx + (s ^. zebraHost) + (s ^. zebraPort) + blockTime + (s ^. dbPath)) $ + bl_txs $ addTime blk blockTime + BT.modify $ set barValue $ validBarValue (s ^. barValue + step) + BT.modify $ set displayBox SyncDisplay + 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.AppEvent Tick) = do + s <- BT.get + case s ^. displayBox of + SyncDisplay -> do + if s ^. barValue == 1.0 + then BT.modify $ set displayBox BlankDisplay + else BT.modify $ set displayBox SyncDisplay + _ -> return () appEvent (BT.VtyEvent e) = do r <- F.focusGetCurrent <$> use focusRing s <- BT.get @@ -456,6 +569,29 @@ appEvent (BT.VtyEvent e) = do MsgDisplay -> BT.modify $ set displayBox BlankDisplay PhraseDisplay -> BT.modify $ set displayBox BlankDisplay TxDisplay -> BT.modify $ set displayBox BlankDisplay + SyncDisplay -> do + if s ^. barValue == 1.0 + then BT.modify $ set displayBox BlankDisplay + else do + sBlock <- liftIO $ getMinBirthdayHeight $ s ^. dbPath + selWallet <- + 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 + scanZebra sBlock + liftIO $ + runFileLoggingT "zenith.log" $ + syncWallet + (Config (s ^. dbPath) (s ^. zebraHost) (s ^. zebraPort)) + selWallet + BT.modify $ set displayBox SyncDisplay BlankDisplay -> do case s ^. dialogBox of WName -> do @@ -557,6 +693,9 @@ 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 barValue 0.0 + BT.modify $ set displayBox SyncDisplay ev -> case r of Just AList -> @@ -581,9 +720,12 @@ theMap = , (titleAttr, V.withStyle (fg V.brightGreen) V.bold) , (blinkAttr, style V.blink) , (focusedFormInputAttr, V.white `on` V.blue) + , (baseAttr, bg V.brightBlack) + , (barDoneAttr, V.white `on` V.blue) + , (barToDoAttr, V.white `on` V.black) ] -theApp :: M.App State e Name +theApp :: M.App State Tick Name theApp = M.App { M.appDraw = drawUI @@ -629,8 +771,11 @@ runZenithCLI config = do if not (null accList) then getBalance dbFilePath $ entityKey $ head accList else return 0 + eventChan <- BC.newBChan 10 + let buildVty = VC.mkVty V.defaultConfig + initialVty <- buildVty void $ - M.defaultMain theApp $ + M.customMain initialVty buildVty (Just eventChan) theApp $ State (zgb_net chainInfo) (L.list WList (Vec.fromList walList) 1) @@ -648,9 +793,13 @@ runZenithCLI config = do (F.focusRing [AList, TList]) (zgb_blocks chainInfo) dbFilePath + host + port MsgDisplay block bal + 1.0 + eventChan Left e -> do print $ "No Zebra node available on port " <> diff --git a/src/Zenith/Core.hs b/src/Zenith/Core.hs index 3d3ecbe..878ffba 100644 --- a/src/Zenith/Core.hs +++ b/src/Zenith/Core.hs @@ -4,13 +4,33 @@ module Zenith.Core where import Control.Exception (throwIO, try) +import Control.Monad (forM, when) +import Control.Monad.IO.Class (liftIO) +import Control.Monad.Logger + ( LoggingT + , MonadLoggerIO + , logInfoN + , logWarnN + , runFileLoggingT + , runStdoutLoggingT + ) +import Crypto.Secp256k1 (SecKey(..)) import Data.Aeson -import Data.HexString (hexString) +import qualified Data.ByteString as BS +import qualified Data.ByteString.Lazy as LBS +import Data.Digest.Pure.MD5 +import Data.HexString (HexString, hexString, toBytes) +import Data.List import Data.Maybe (fromJust) +import Data.Pool (Pool) import qualified Data.Text as T import qualified Data.Text.Encoding as E +import Data.Time +import qualified Database.Esqueleto.Experimental as ESQ import Database.Persist import Database.Persist.Sqlite +import GHC.Float.RealFracMethods (floorFloatInteger) +import Haskoin.Crypto.Keys (XPrvKey(..)) import Network.HTTP.Client import ZcashHaskell.Keys import ZcashHaskell.Orchard @@ -20,7 +40,9 @@ import ZcashHaskell.Orchard , genOrchardSpendingKey , getOrchardNotePosition , getOrchardWitness + , isValidUnifiedAddress , updateOrchardCommitmentTree + , updateOrchardWitness ) import ZcashHaskell.Sapling ( decodeSaplingOutputEsk @@ -30,8 +52,13 @@ import ZcashHaskell.Sapling , getSaplingNotePosition , getSaplingWitness , updateSaplingCommitmentTree + , updateSaplingWitness + ) +import ZcashHaskell.Transparent + ( genTransparentPrvKey + , genTransparentReceiver + , genTransparentSecretKey ) -import ZcashHaskell.Transparent (genTransparentPrvKey, genTransparentReceiver) import ZcashHaskell.Types import ZcashHaskell.Utils import Zenith.DB @@ -40,6 +67,7 @@ import Zenith.Types , HexStringDB(..) , OrchardSpendingKeyDB(..) , PhraseDB(..) + , RseedDB(..) , SaplingSpendingKeyDB(..) , ScopeDB(..) , TransparentSpendingKeyDB(..) @@ -236,7 +264,6 @@ findSaplingOutputs config b znet za = do Nothing -> do decryptNotes uT n txs Just dn1 -> do - print dn1 wId <- saveWalletTransaction (c_dbPath config) @@ -249,10 +276,10 @@ findSaplingOutputs config b znet za = do (fromJust noteWitness) True (entityKey za) + (entityKey o) dn1 decryptNotes uT n txs Just dn0 -> do - print dn0 wId <- saveWalletTransaction (c_dbPath config) (entityKey za) zt saveWalletSapNote @@ -262,6 +289,7 @@ findSaplingOutputs config b znet za = do (fromJust noteWitness) False (entityKey za) + (entityKey o) dn0 decryptNotes uT n txs decodeShOut :: @@ -327,7 +355,6 @@ findOrchardActions config b znet za = do case decodeOrchAction Internal nP o of Nothing -> decryptNotes uT n txs Just dn1 -> do - print dn1 wId <- saveWalletTransaction (c_dbPath config) @@ -340,10 +367,10 @@ findOrchardActions config b znet za = do (fromJust noteWitness) True (entityKey za) + (entityKey o) dn1 decryptNotes uT n txs Just dn -> do - print dn wId <- saveWalletTransaction (c_dbPath config) (entityKey za) zt saveWalletOrchNote @@ -353,6 +380,7 @@ findOrchardActions config b znet za = do (fromJust noteWitness) False (entityKey za) + (entityKey o) dn decryptNotes uT n txs sk :: OrchardSpendingKeyDB @@ -371,44 +399,350 @@ findOrchardActions config b znet za = do (getHex $ orchActionCv $ entityVal o) (getHex $ orchActionAuth $ entityVal o) +updateSaplingWitnesses :: T.Text -> LoggingT IO () +updateSaplingWitnesses dbPath = do + sapNotes <- liftIO $ getUnspentSapNotes dbPath + pool <- createSqlitePool dbPath 5 + maxId <- liftIO $ getMaxSaplingNote pool + mapM_ (updateOneNote pool maxId) sapNotes + where + updateOneNote :: + Pool SqlBackend + -> ShieldOutputId + -> Entity WalletSapNote + -> LoggingT IO () + updateOneNote pool maxId n = do + let noteSync = walletSapNoteWitPos $ entityVal n + if noteSync < maxId + then do + cmus <- + liftIO $ getSaplingCmus pool $ walletSapNoteWitPos $ entityVal n + let cmuList = map (\(ESQ.Value x) -> getHex x) cmus + let newWitness = + updateSaplingWitness + (SaplingWitness $ getHex $ walletSapNoteWitness $ entityVal n) + cmuList + liftIO $ updateSapNoteRecord pool (entityKey n) newWitness maxId + else logInfoN "Witness up to date" + +updateOrchardWitnesses :: T.Text -> LoggingT IO () +updateOrchardWitnesses dbPath = do + orchNotes <- liftIO $ getUnspentOrchNotes dbPath + pool <- createSqlitePool dbPath 5 + maxId <- liftIO $ getMaxOrchardNote pool + mapM_ (updateOneNote pool maxId) orchNotes + where + updateOneNote :: + Pool SqlBackend + -> OrchActionId + -> Entity WalletOrchNote + -> LoggingT IO () + updateOneNote pool maxId n = do + let noteSync = walletOrchNoteWitPos $ entityVal n + if noteSync < maxId + then do + cmxs <- liftIO $ getOrchardCmxs pool noteSync + let cmxList = map (\(ESQ.Value x) -> getHex x) cmxs + let newWitness = + updateOrchardWitness + (OrchardWitness $ getHex $ walletOrchNoteWitness $ entityVal n) + cmxList + liftIO $ updateOrchNoteRecord pool (entityKey n) newWitness maxId + else logInfoN "Witness up to date" + +-- | Calculate fee per ZIP-317 +calculateTxFee :: + ([Entity WalletTrNote], [Entity WalletSapNote], [Entity WalletOrchNote]) + -> Int + -> Integer +calculateTxFee (t, s, o) i = + fromIntegral + (5000 * (max (length t) tout + max (length s) sout + length o + oout)) + where + tout = + if i == 1 + then 1 + else 0 + sout = + if i == 2 + then 1 + else 0 + oout = + if i == 3 + then 2 + else 1 + +-- | Prepare a transaction for sending +prepareTx :: + T.Text + -> T.Text + -> Int + -> ZcashNet + -> ZcashAccountId + -> Int + -> Float + -> UnifiedAddress + -> T.Text + -> IO (Either TxError HexString) +prepareTx dbPath zebraHost zebraPort zn za bh amt ua memo = do + accRead <- getAccountById dbPath za + let recipient = + case o_rec ua of + Nothing -> + case s_rec ua of + Nothing -> + case t_rec ua of + Nothing -> (0, "") + Just r3 -> + case tr_type r3 of + P2PKH -> (1, toBytes $ tr_bytes r3) + P2SH -> (2, toBytes $ tr_bytes r3) + Just r2 -> (3, getBytes r2) + Just r1 -> (4, getBytes r1) + print recipient + trees <- getCommitmentTrees zebraHost zebraPort bh + let sT = SaplingCommitmentTree $ ztiSapling trees + let oT = OrchardCommitmentTree $ ztiOrchard trees + case accRead of + Nothing -> throwIO $ userError "Can't find Account" + Just acc -> do + print acc + spParams <- BS.readFile "sapling-spend.params" + outParams <- 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" + 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" + let zats = fromIntegral $ floorFloatInteger $ amt * (10 ^ 8) + firstPass <- selectUnspentNotes dbPath za zats + let fee = calculateTxFee firstPass 3 + print "calculated fee" + print fee + (tList, sList, oList) <- selectUnspentNotes dbPath za (zats + fee) + print "selected notes" + print tList + print sList + print oList + let noteTotal = getTotalAmount (tList, sList, oList) + print noteTotal + tSpends <- + prepTSpends (getTranSK $ zcashAccountTPrivateKey $ entityVal acc) tList + print tSpends + sSpends <- + prepSSpends (getSapSK $ zcashAccountSapSpendKey $ entityVal acc) sList + print sSpends + oSpends <- + prepOSpends (getOrchSK $ zcashAccountOrchSpendKey $ entityVal acc) oList + print oSpends + outgoing <- makeOutgoing acc recipient zats (noteTotal - fee - zats) + print outgoing + let tx = + createTransaction + (Just sT) + (Just oT) + tSpends + sSpends + oSpends + outgoing + (SaplingSpendParams spParams) + (SaplingOutputParams outParams) + zn + (bh + 3) + return tx + where + makeOutgoing :: + Entity ZcashAccount + -> (Int, BS.ByteString) + -> Integer + -> Integer + -> IO [OutgoingNote] + makeOutgoing acc (k, recvr) zats chg = do + chgAddr <- getInternalAddresses dbPath $ entityKey acc + let internalUA = getUA $ walletAddressUAddress $ entityVal $ head chgAddr + 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 -> + getBytes $ getOrchSK $ zcashAccountOrchSpendKey $ entityVal acc + 3 -> + getBytes $ getSapSK $ zcashAccountSapSpendKey $ entityVal acc + _ -> "") + recvr + (fromIntegral zats) + (E.encodeUtf8 memo) + False + ] + getTotalAmount :: + ( [Entity WalletTrNote] + , [Entity WalletSapNote] + , [Entity WalletOrchNote]) + -> Integer + getTotalAmount (t, s, o) = + sum (map (fromIntegral . walletTrNoteValue . entityVal) t) + + sum (map (fromIntegral . walletSapNoteValue . entityVal) s) + + sum (map (fromIntegral . walletOrchNoteValue . entityVal) o) + prepTSpends :: + TransparentSpendingKey + -> [Entity WalletTrNote] + -> IO [TransparentTxSpend] + prepTSpends sk notes = do + forM notes $ \n -> do + tAddRead <- getAddressById dbPath $ walletTrNoteAddress $ entityVal n + print n + case tAddRead of + Nothing -> throwIO $ userError "Couldn't read t-address" + Just tAdd -> do + (XPrvKey _ _ _ _ (SecKey xp_key)) <- + genTransparentSecretKey + (walletAddressIndex $ entityVal tAdd) + (getScope $ walletAddressScope $ entityVal tAdd) + sk + mReverseTxId <- getWalletTxId dbPath $ walletTrNoteTx $ entityVal n + case mReverseTxId of + Nothing -> throwIO $ userError "failed to get tx ID" + Just (ESQ.Value reverseTxId) -> do + let flipTxId = BS.reverse $ toBytes $ getHex reverseTxId + return $ + TransparentTxSpend + xp_key + (RawOutPoint + flipTxId + (fromIntegral $ walletTrNotePosition $ entityVal n)) + (RawTxOut + (walletTrNoteValue $ entityVal n) + (walletTrNoteScript $ entityVal n)) + prepSSpends :: + SaplingSpendingKey -> [Entity WalletSapNote] -> IO [SaplingTxSpend] + prepSSpends sk notes = do + forM notes $ \n -> do + print n + return $ + SaplingTxSpend + (getBytes sk) + (DecodedNote + (fromIntegral $ walletSapNoteValue $ entityVal n) + (walletSapNoteRecipient $ entityVal n) + (E.encodeUtf8 $ walletSapNoteMemo $ entityVal n) + (getHex $ walletSapNoteNullifier $ entityVal n) + "" + (getRseed $ walletSapNoteRseed $ entityVal n)) + (toBytes $ getHex $ walletSapNoteWitness $ entityVal n) + prepOSpends :: + OrchardSpendingKey -> [Entity WalletOrchNote] -> IO [OrchardTxSpend] + prepOSpends sk notes = do + forM notes $ \n -> do + print n + return $ + OrchardTxSpend + (getBytes sk) + (DecodedNote + (fromIntegral $ walletOrchNoteValue $ entityVal n) + (walletOrchNoteRecipient $ entityVal n) + (E.encodeUtf8 $ walletOrchNoteMemo $ entityVal n) + (getHex $ walletOrchNoteNullifier $ entityVal n) + (walletOrchNoteRho $ entityVal n) + (getRseed $ walletOrchNoteRseed $ entityVal n)) + (toBytes $ getHex $ walletOrchNoteWitness $ entityVal n) + sapAnchor :: [Entity WalletSapNote] -> Maybe SaplingWitness + sapAnchor notes = + if not (null notes) + then Just $ + SaplingWitness $ + getHex $ walletSapNoteWitness $ entityVal $ head notes + else Nothing + orchAnchor :: [Entity WalletOrchNote] -> Maybe OrchardWitness + orchAnchor notes = + if not (null notes) + then Just $ + OrchardWitness $ + getHex $ walletOrchNoteWitness $ entityVal $ head notes + else Nothing + -- | Sync the wallet with the data store syncWallet :: Config -- ^ configuration parameters -> Entity ZcashWallet - -> IO String + -> LoggingT IO () syncWallet config w = do let walletDb = c_dbPath config - accs <- getAccounts walletDb $ entityKey w - addrs <- concat <$> mapM (getAddresses walletDb . entityKey) accs - intAddrs <- concat <$> mapM (getInternalAddresses walletDb . entityKey) accs - chainTip <- getMaxBlock walletDb + accs <- liftIO $ getAccounts walletDb $ entityKey w + addrs <- liftIO $ concat <$> mapM (getAddresses walletDb . entityKey) accs + intAddrs <- + liftIO $ concat <$> mapM (getInternalAddresses walletDb . entityKey) accs + chainTip <- liftIO $ getMaxBlock walletDb let lastBlock = zcashWalletLastSync $ entityVal w let startBlock = if lastBlock > 0 then lastBlock else zcashWalletBirthdayHeight $ entityVal w - mapM_ (findTransparentNotes walletDb startBlock) addrs - mapM_ (findTransparentNotes walletDb startBlock) intAddrs - mapM_ (findTransparentSpends walletDb . entityKey) accs + mapM_ (liftIO . findTransparentNotes walletDb startBlock) addrs + mapM_ (liftIO . findTransparentNotes walletDb startBlock) intAddrs + mapM_ (liftIO . findTransparentSpends walletDb . entityKey) accs sapNotes <- + liftIO $ mapM (findSaplingOutputs config startBlock (zcashWalletNetwork $ entityVal w)) accs orchNotes <- + liftIO $ mapM (findOrchardActions config startBlock (zcashWalletNetwork $ entityVal w)) accs - updateWalletSync walletDb chainTip (entityKey w) - mapM_ (getWalletTransactions walletDb) addrs - return "Testing" + _ <- updateSaplingWitnesses walletDb + _ <- updateOrchardWitnesses walletDb + _ <- liftIO $ updateWalletSync walletDb chainTip (entityKey w) + _ <- liftIO $ mapM_ (getWalletTransactions walletDb) addrs + logInfoN "Synced wallet" testSync :: Config -> IO () testSync config = do let dbPath = c_dbPath config _ <- initDb dbPath w <- getWallets dbPath TestNet - r <- mapM (syncWallet config) w - print r + r <- runFileLoggingT "zenith.log" $ mapM (syncWallet config) w + liftIO $ print r + +testSend :: IO () +testSend = do + let uaRead = + isValidUnifiedAddress + "utest1dl54utt6prjj5e0dnlknwumnxq9hycdjpkfr0sy6e6h522remqee8axe9zax0wsjrwpj76v555pdhvj9rnargpfyycs0vpkapq98xcdhem99gc4wchzn0ggepq3y6nz3a9sscwgqxgsh9vzhcad402y3x9szfregck5gslkya3c79d86xx0l33tpk8gnn7ew9vw37w43zh22u8dgdax" + case uaRead of + Nothing -> print "wrong address" + Just ua -> do + startTime <- getCurrentTime + print startTime + tx <- + prepareTx + "zenith.db" + "127.0.0.1" + 18232 + TestNet + (toSqlKey 1) + 2820897 + 0.04 + ua + "sent with Zenith, test" + print tx + endTime <- getCurrentTime + print endTime clearSync :: Config -> IO () clearSync config = do @@ -416,7 +750,7 @@ clearSync config = do _ <- initDb dbPath _ <- clearWalletTransactions dbPath w <- getWallets dbPath TestNet - mapM_ (updateWalletSync dbPath 0 . entityKey) w - w' <- getWallets dbPath TestNet - r <- mapM (syncWallet config) w' - print r + liftIO $ mapM_ (updateWalletSync dbPath 0 . entityKey) w + w' <- liftIO $ getWallets dbPath TestNet + r <- runFileLoggingT "zenith.log" $ mapM (syncWallet config) w' + liftIO $ print r diff --git a/src/Zenith/DB.hs b/src/Zenith/DB.hs index a23ae67..6f352af 100644 --- a/src/Zenith/DB.hs +++ b/src/Zenith/DB.hs @@ -21,10 +21,12 @@ module Zenith.DB where import Control.Exception (throwIO) import Control.Monad (forM_, when) import Control.Monad.IO.Class (MonadIO, liftIO) +import Data.Bifunctor (bimap) import qualified Data.ByteString as BS import Data.HexString import Data.List (group, sort) import Data.Maybe (catMaybes, fromJust, isJust) +import Data.Pool (Pool) import qualified Data.Text as T import qualified Data.Text.Encoding as TE import Data.Word @@ -67,6 +69,7 @@ import Zenith.Types , HexStringDB(..) , OrchardSpendingKeyDB(..) , PhraseDB(..) + , RseedDB(..) , SaplingSpendingKeyDB(..) , ScopeDB(..) , TransparentSpendingKeyDB @@ -123,6 +126,7 @@ share WalletTrNote tx WalletTransactionId OnDeleteCascade OnUpdateCascade accId ZcashAccountId + address WalletAddressId value Word64 spent Bool script BS.ByteString @@ -147,6 +151,8 @@ share position Word64 witness HexStringDB change Bool + witPos ShieldOutputId OnDeleteIgnore OnUpdateIgnore + rseed RseedDB UniqueSapNote tx nullifier deriving Show Eq WalletSapSpend @@ -166,6 +172,9 @@ share position Word64 witness HexStringDB change Bool + witPos OrchActionId OnDeleteIgnore OnUpdateIgnore + rho BS.ByteString + rseed RseedDB UniqueOrchNote tx nullifier deriving Show Eq WalletOrchSpend @@ -285,6 +294,14 @@ getAccounts dbFp w = where_ (accs ^. ZcashAccountWalletId ==. val w) pure accs +getAccountById :: T.Text -> ZcashAccountId -> IO (Maybe (Entity ZcashAccount)) +getAccountById dbPath za = do + PS.runSqlite dbPath $ + selectOne $ do + accs <- from $ table @ZcashAccount + where_ (accs ^. ZcashAccountId ==. val za) + pure accs + -- | Returns the largest account index for the given wallet getMaxAccount :: T.Text -- ^ The database path @@ -338,6 +355,14 @@ getAddresses dbFp a = where_ (addrs ^. WalletAddressScope ==. val (ScopeDB External)) pure addrs +getAddressById :: T.Text -> WalletAddressId -> IO (Maybe (Entity WalletAddress)) +getAddressById dbPath a = do + PS.runSqlite dbPath $ + selectOne $ do + addr <- from $ table @WalletAddress + where_ (addr ^. WalletAddressId ==. val a) + pure addr + -- | Returns a list of change addresses associated with the given account getInternalAddresses :: T.Text -- ^ The database path @@ -503,6 +528,19 @@ getMaxWalletBlock dbPath = do Nothing -> return $ -1 Just x -> return $ walletTransactionBlock $ entityVal x +getMinBirthdayHeight :: T.Text -> IO Int +getMinBirthdayHeight dbPath = do + b <- + PS.runSqlite dbPath $ + selectOne $ do + w <- from $ table @ZcashWallet + where_ (w ^. ZcashWalletBirthdayHeight >. val 0) + orderBy [asc $ w ^. ZcashWalletBirthdayHeight] + pure w + case b of + Nothing -> return 0 + Just x -> return $ zcashWalletBirthdayHeight $ entityVal x + -- | Save a @WalletTransaction@ saveWalletTransaction :: T.Text @@ -531,9 +569,10 @@ saveWalletSapNote :: -> SaplingWitness -- ^ the Sapling incremental witness -> Bool -- ^ change flag -> ZcashAccountId + -> ShieldOutputId -> DecodedNote -- The decoded Sapling note -> IO () -saveWalletSapNote dbPath wId pos wit ch za dn = do +saveWalletSapNote dbPath wId pos wit ch za zt dn = do PS.runSqlite dbPath $ do _ <- upsert @@ -547,7 +586,9 @@ saveWalletSapNote dbPath wId pos wit ch za dn = do (HexStringDB $ a_nullifier dn) (fromIntegral pos) (HexStringDB $ sapWit wit) - ch) + ch + zt + (RseedDB $ a_rseed dn)) [] return () @@ -559,9 +600,10 @@ saveWalletOrchNote :: -> OrchardWitness -> Bool -> ZcashAccountId + -> OrchActionId -> DecodedNote -> IO () -saveWalletOrchNote dbPath wId pos wit ch za dn = do +saveWalletOrchNote dbPath wId pos wit ch za zt dn = do PS.runSqlite dbPath $ do _ <- upsert @@ -575,7 +617,10 @@ saveWalletOrchNote dbPath wId pos wit ch za dn = do (HexStringDB $ a_nullifier dn) (fromIntegral pos) (HexStringDB $ orchWit wit) - ch) + ch + zt + (a_rho dn) + (RseedDB $ a_rseed dn)) [] return () @@ -609,7 +654,8 @@ findTransparentNotes dbPath b t = do (saveWalletTrNote dbPath (getScope $ walletAddressScope $ entityVal t) - (walletAddressAccId $ entityVal t)) + (walletAddressAccId $ entityVal t) + (entityKey t)) tN Nothing -> return () @@ -618,9 +664,10 @@ saveWalletTrNote :: T.Text -- ^ the database path -> Scope -> ZcashAccountId + -> WalletAddressId -> (Entity ZcashTransaction, Entity TransparentNote) -> IO () -saveWalletTrNote dbPath ch za (zt, tn) = do +saveWalletTrNote dbPath ch za wa (zt, tn) = do let zT' = entityVal zt PS.runSqlite dbPath $ do t <- @@ -636,6 +683,7 @@ saveWalletTrNote dbPath ch za (zt, tn) = do WalletTrNote (entityKey t) za + wa (transparentNoteValue $ entityVal tn) False (transparentNoteScript $ entityVal tn) @@ -917,6 +965,9 @@ findTransparentSpends dbPath za = do case mReverseTxId of Nothing -> throwIO $ userError "failed to get tx ID" Just (Value reverseTxId) -> do + let flipTxId = + HexStringDB $ + HexString $ BS.reverse $ toBytes $ getHex reverseTxId s <- PS.runSqlite dbPath $ do select $ do @@ -926,7 +977,7 @@ findTransparentSpends dbPath za = do (\(tx :& trSpends) -> tx ^. ZcashTransactionId ==. trSpends ^. TransparentSpendTx) where_ - (trSpends ^. TransparentSpendOutPointHash ==. val reverseTxId) + (trSpends ^. TransparentSpendOutPointHash ==. val flipTxId) where_ (trSpends ^. TransparentSpendOutPointIndex ==. val (walletTrNotePosition $ entityVal n)) @@ -995,6 +1046,100 @@ getWalletOrchNotes dbPath za = do where_ (n ^. WalletOrchNoteAccId ==. val za) pure n +getUnspentSapNotes :: T.Text -> IO [Entity WalletSapNote] +getUnspentSapNotes dbPath = do + PS.runSqlite dbPath $ do + select $ do + n <- from $ table @WalletSapNote + where_ (n ^. WalletSapNoteSpent ==. val False) + pure n + +getSaplingCmus :: Pool SqlBackend -> ShieldOutputId -> IO [Value HexStringDB] +getSaplingCmus pool zt = do + PS.runSqlPool + (select $ do + n <- from $ table @ShieldOutput + where_ (n ^. ShieldOutputId >. val zt) + orderBy [asc $ n ^. ShieldOutputId] + pure $ n ^. ShieldOutputCmu) + pool + +getMaxSaplingNote :: Pool SqlBackend -> IO ShieldOutputId +getMaxSaplingNote pool = do + flip PS.runSqlPool pool $ do + x <- + selectOne $ do + n <- from $ table @ShieldOutput + where_ (n ^. ShieldOutputId >. val (toSqlKey 0)) + orderBy [desc $ n ^. ShieldOutputId] + pure (n ^. ShieldOutputId) + case x of + Nothing -> return $ toSqlKey 0 + Just (Value y) -> return y + +updateSapNoteRecord :: + Pool SqlBackend + -> WalletSapNoteId + -> SaplingWitness + -> ShieldOutputId + -> IO () +updateSapNoteRecord pool n w o = do + flip PS.runSqlPool pool $ do + update $ \x -> do + set + x + [ WalletSapNoteWitness =. val (HexStringDB $ sapWit w) + , WalletSapNoteWitPos =. val o + ] + where_ (x ^. WalletSapNoteId ==. val n) + +getUnspentOrchNotes :: T.Text -> IO [Entity WalletOrchNote] +getUnspentOrchNotes dbPath = do + PS.runSqlite dbPath $ do + select $ do + n <- from $ table @WalletOrchNote + where_ (n ^. WalletOrchNoteSpent ==. val False) + pure n + +getOrchardCmxs :: Pool SqlBackend -> OrchActionId -> IO [Value HexStringDB] +getOrchardCmxs pool zt = do + PS.runSqlPool + (select $ do + n <- from $ table @OrchAction + where_ (n ^. OrchActionId >. val zt) + orderBy [asc $ n ^. OrchActionId] + pure $ n ^. OrchActionCmx) + pool + +getMaxOrchardNote :: Pool SqlBackend -> IO OrchActionId +getMaxOrchardNote pool = do + flip PS.runSqlPool pool $ do + x <- + selectOne $ do + n <- from $ table @OrchAction + where_ (n ^. OrchActionId >. val (toSqlKey 0)) + orderBy [desc $ n ^. OrchActionId] + pure (n ^. OrchActionId) + case x of + Nothing -> return $ toSqlKey 0 + Just (Value y) -> return y + +updateOrchNoteRecord :: + Pool SqlBackend + -> WalletOrchNoteId + -> OrchardWitness + -> OrchActionId + -> IO () +updateOrchNoteRecord pool n w o = do + flip PS.runSqlPool pool $ do + update $ \x -> do + set + x + [ WalletOrchNoteWitness =. val (HexStringDB $ orchWit w) + , WalletOrchNoteWitPos =. val o + ] + where_ (x ^. WalletOrchNoteId ==. val n) + findOrchSpends :: T.Text -> ZcashAccountId -> [Entity WalletOrchNote] -> IO () findOrchSpends _ _ [] = return () findOrchSpends dbPath za (n:notes) = do @@ -1043,31 +1188,13 @@ upsertWalTx zt za = getBalance :: T.Text -> ZcashAccountId -> IO Integer getBalance dbPath za = do - trNotes <- - PS.runSqlite dbPath $ do - select $ do - n <- from $ table @WalletTrNote - where_ (n ^. WalletTrNoteAccId ==. val za) - where_ (n ^. WalletTrNoteSpent ==. val False) - pure n + trNotes <- getWalletUnspentTrNotes dbPath za let tAmts = map (walletTrNoteValue . entityVal) trNotes let tBal = sum tAmts - sapNotes <- - PS.runSqlite dbPath $ do - select $ do - n1 <- from $ table @WalletSapNote - where_ (n1 ^. WalletSapNoteAccId ==. val za) - where_ (n1 ^. WalletSapNoteSpent ==. val False) - pure n1 + sapNotes <- getWalletUnspentSapNotes dbPath za let sAmts = map (walletSapNoteValue . entityVal) sapNotes let sBal = sum sAmts - orchNotes <- - PS.runSqlite dbPath $ do - select $ do - n2 <- from $ table @WalletOrchNote - where_ (n2 ^. WalletOrchNoteAccId ==. val za) - where_ (n2 ^. WalletOrchNoteSpent ==. val False) - pure n2 + orchNotes <- getWalletUnspentOrchNotes dbPath za let oAmts = map (walletOrchNoteValue . entityVal) orchNotes let oBal = sum oAmts return . fromIntegral $ tBal + sBal + oBal @@ -1100,6 +1227,91 @@ clearWalletTransactions dbPath = do _ <- from $ table @UserTx return () +getWalletUnspentTrNotes :: T.Text -> ZcashAccountId -> IO [Entity WalletTrNote] +getWalletUnspentTrNotes dbPath za = do + PS.runSqlite dbPath $ do + select $ do + n <- from $ table @WalletTrNote + where_ (n ^. WalletTrNoteAccId ==. val za) + where_ (n ^. WalletTrNoteSpent ==. val False) + pure n + +getWalletUnspentSapNotes :: + T.Text -> ZcashAccountId -> IO [Entity WalletSapNote] +getWalletUnspentSapNotes dbPath za = do + PS.runSqlite dbPath $ do + select $ do + n1 <- from $ table @WalletSapNote + where_ (n1 ^. WalletSapNoteAccId ==. val za) + where_ (n1 ^. WalletSapNoteSpent ==. val False) + pure n1 + +getWalletUnspentOrchNotes :: + T.Text -> ZcashAccountId -> IO [Entity WalletOrchNote] +getWalletUnspentOrchNotes dbPath za = do + PS.runSqlite dbPath $ do + select $ do + n2 <- from $ table @WalletOrchNote + where_ (n2 ^. WalletOrchNoteAccId ==. val za) + where_ (n2 ^. WalletOrchNoteSpent ==. val False) + pure n2 + +selectUnspentNotes :: + T.Text + -> ZcashAccountId + -> Integer + -> IO ([Entity WalletTrNote], [Entity WalletSapNote], [Entity WalletOrchNote]) +selectUnspentNotes dbPath za amt = do + trNotes <- getWalletUnspentTrNotes dbPath za + let (a1, tList) = checkTransparent (fromIntegral amt) trNotes + if a1 > 0 + then do + sapNotes <- getWalletUnspentSapNotes dbPath za + let (a2, sList) = checkSapling a1 sapNotes + if a2 > 0 + then do + orchNotes <- getWalletUnspentOrchNotes dbPath za + let (a3, oList) = checkOrchard a2 orchNotes + if a3 > 0 + then throwIO $ userError "Not enough funds" + else return (tList, sList, oList) + else return (tList, sList, []) + else return (tList, [], []) + where + checkTransparent :: + Word64 -> [Entity WalletTrNote] -> (Word64, [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 :: + Word64 -> [Entity WalletSapNote] -> (Word64, [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 :: + Word64 -> [Entity WalletOrchNote] -> (Word64, [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 :: T.Text -> WalletTransactionId -> IO (Maybe (Value HexStringDB)) +getWalletTxId dbPath wId = do + PS.runSqlite dbPath $ do + selectOne $ do + wtx <- from $ table @WalletTransaction + where_ (wtx ^. WalletTransactionId ==. val wId) + pure $ wtx ^. WalletTransactionTxId + -- | Helper function to extract a Unified Address from the database readUnifiedAddressDB :: WalletAddress -> Maybe UnifiedAddress readUnifiedAddressDB = diff --git a/src/Zenith/Types.hs b/src/Zenith/Types.hs index 32c44ea..5526aa6 100644 --- a/src/Zenith/Types.hs +++ b/src/Zenith/Types.hs @@ -23,6 +23,7 @@ import GHC.Generics import ZcashHaskell.Types ( OrchardSpendingKey(..) , Phrase(..) + , Rseed(..) , SaplingSpendingKey(..) , Scope(..) , TransparentSpendingKey @@ -79,6 +80,12 @@ newtype TransparentSpendingKeyDB = TransparentSpendingKeyDB derivePersistField "TransparentSpendingKeyDB" +newtype RseedDB = RseedDB + { getRseed :: Rseed + } deriving newtype (Eq, Show, Read) + +derivePersistField "RseedDB" + -- * RPC -- | Type for Configuration parameters data Config = Config diff --git a/test/Spec.hs b/test/Spec.hs index af1f21f..941ada8 100644 --- a/test/Spec.hs +++ b/test/Spec.hs @@ -160,3 +160,31 @@ main = do a_nullifier d `shouldBe` hexString "6c5d1413c63a9a88db71c3f41dc12cd60197ee742fc75b217215e7144db48bd3" + describe "Note selection for Tx" $ do + it "Value less than balance" $ do + res <- selectUnspentNotes "zenith.db" (toSqlKey 1) 14000000 + res `shouldNotBe` ([], [], []) + it "Value greater than balance" $ do + let res = selectUnspentNotes "zenith.db" (toSqlKey 1) 84000000 + res `shouldThrow` anyIOException + it "Fee calculation" $ do + res <- selectUnspentNotes "zenith.db" (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") diff --git a/zcash-haskell b/zcash-haskell index 00400c4..22c0fe3 160000 --- a/zcash-haskell +++ b/zcash-haskell @@ -1 +1 @@ -Subproject commit 00400c433dd8a584ef19af58fcab7fdd108d4110 +Subproject commit 22c0fe374976d9f2323a8b7cd42f941423d45111 diff --git a/zenith.cabal b/zenith.cabal index 1b0ea04..df4e9fa 100644 --- a/zenith.cabal +++ b/zenith.cabal @@ -1,6 +1,6 @@ cabal-version: 3.0 name: zenith -version: 0.4.6.0 +version: 0.5.0.0 license: MIT license-file: LICENSE author: Rene Vergara @@ -45,6 +45,11 @@ library , brick , bytestring , esqueleto + , resource-pool + , monad-logger + , vty-crossplatform + , secp256k1-haskell + , pureMD5 , ghc , haskoin-core , hexstring