diff --git a/cabal.project b/cabal.project index cf9dbbc..217198a 100644 --- a/cabal.project +++ b/cabal.project @@ -7,7 +7,7 @@ with-compiler: ghc-9.4.8 source-repository-package type: git location: https://git.vergara.tech/Vergara_Tech/haskell-hexstring.git - tag: fd1ddce73c0ad18a2a4509a299c6e93f8c6c383d + tag: 39d8da7b11a80269454c2f134a5c834e0f3cb9a7 source-repository-package type: git diff --git a/src/Zenith/CLI.hs b/src/Zenith/CLI.hs index fa4d503..5ce1a69 100644 --- a/src/Zenith/CLI.hs +++ b/src/Zenith/CLI.hs @@ -3,16 +3,6 @@ module Zenith.CLI where -import Control.Exception (throw, try) -import Control.Monad (void) -import Control.Monad.IO.Class (liftIO) -import Data.Maybe -import qualified Data.Text as T -import qualified Graphics.Vty as V -import Lens.Micro ((&), (.~), (^.), set) -import Lens.Micro.Mtl -import Lens.Micro.TH - import qualified Brick.AttrMap as A import qualified Brick.Focus as F import Brick.Forms @@ -42,11 +32,10 @@ import Brick.Widgets.Core , joinBorders , padAll , padBottom - , padRight , str , strWrap , txt - , txtWrap + , txtWrapWith , vBox , vLimit , withAttr @@ -54,13 +43,23 @@ import Brick.Widgets.Core ) import qualified Brick.Widgets.Dialog as D import qualified Brick.Widgets.List as L +import Control.Exception (throw, throwIO, try) +import Control.Monad (void) +import Control.Monad.IO.Class (liftIO) +import Data.Maybe +import qualified Data.Text as T import qualified Data.Vector as Vec import Database.Persist +import qualified Graphics.Vty as V +import Lens.Micro ((&), (.~), (^.), set) +import Lens.Micro.Mtl +import Lens.Micro.TH +import Text.Wrap (FillScope(..), FillStrategy(..), WrapSettings(..), wrapText) import ZcashHaskell.Keys (generateWalletSeedPhrase, getWalletSeed) -import ZcashHaskell.Orchard (encodeUnifiedAddress, genOrchardSpendingKey) import ZcashHaskell.Types import Zenith.Core import Zenith.DB +import Zenith.Types (PhraseDB(..), UnifiedAddressDB(..), ZcashNetDB(..)) import Zenith.Utils (showAddress) data Name @@ -242,8 +241,8 @@ drawUI s = [splashDialog s, helpDialog s, displayDialog s, inputDialog s, ui s] Nothing 60) (padAll 1 $ - txtWrap $ - encodeUnifiedAddress $ walletAddressUAddress $ entityVal a) + txtWrapWith (WrapSettings False True NoFill FillAfterFirst) $ + getUA $ walletAddressUAddress $ entityVal a) Nothing -> emptyWidget MsgDisplay -> withBorderStyle unicodeBold $ @@ -344,8 +343,11 @@ appEvent (BT.VtyEvent e) = do V.EvKey V.KEsc [] -> BT.modify $ set dialogBox Blank V.EvKey V.KEnter [] -> do fs <- BT.zoom inputForm $ BT.gets formState - na <- liftIO $ addNewAccount (fs ^. dialogInput) s - ns <- liftIO $ refreshAccount na + ns <- + liftIO $ + refreshAccount =<< + addNewAddress "Change" Internal =<< + addNewAccount (fs ^. dialogInput) s BT.put ns addrL <- use addresses BT.modify $ set displayBox MsgDisplay @@ -361,7 +363,8 @@ appEvent (BT.VtyEvent e) = do V.EvKey V.KEsc [] -> BT.modify $ set dialogBox Blank V.EvKey V.KEnter [] -> do fs <- BT.zoom inputForm $ BT.gets formState - nAddr <- liftIO $ addNewAddress (fs ^. dialogInput) s + nAddr <- + liftIO $ addNewAddress (fs ^. dialogInput) External s BT.put nAddr BT.modify $ set displayBox MsgDisplay BT.modify $ set dialogBox Blank @@ -451,7 +454,7 @@ runZenithCLI host port dbFilePath = do Just zebra -> do bc <- checkBlockChain host port case (bc :: Maybe ZebraGetBlockChainInfo) of - Nothing -> print "Unable to determine blockchain status" + Nothing -> throwIO $ userError "Unable to determine blockchain status" Just chainInfo -> do initDb dbFilePath walList <- getWallets dbFilePath $ zgb_net chainInfo @@ -515,7 +518,9 @@ addNewWallet n s = do sP <- generateWalletSeedPhrase let bH = s ^. startBlock let netName = s ^. network - r <- saveWallet (s ^. dbPath) $ ZcashWallet n netName sP bH + r <- + saveWallet (s ^. dbPath) $ + ZcashWallet n (ZcashNetDB netName) (PhraseDB sP) bH case r of Nothing -> do return $ s & msg .~ ("Wallet already exists: " ++ T.unpack n) @@ -573,8 +578,8 @@ refreshAccount s = do s & addresses .~ aL' & msg .~ "Switched to account: " ++ T.unpack (zcashAccountName $ entityVal selAccount) -addNewAddress :: T.Text -> State -> IO State -addNewAddress n s = do +addNewAddress :: T.Text -> Scope -> State -> IO State +addNewAddress n scope s = do selAccount <- do case L.listSelectedElement $ s ^. accounts of Nothing -> do @@ -584,9 +589,9 @@ addNewAddress n s = do Nothing -> throw $ userError "Failed to select account" Just (_j, a1) -> return a1 Just (_k, a) -> return a - maxAddr <- getMaxAddress (s ^. dbPath) (entityKey selAccount) + maxAddr <- getMaxAddress (s ^. dbPath) (entityKey selAccount) scope uA <- - try $ createWalletAddress n (maxAddr + 1) (s ^. network) selAccount :: IO + try $ createWalletAddress n (maxAddr + 1) (s ^. network) scope selAccount :: IO (Either IOError WalletAddress) case uA of Left e -> return $ s & msg .~ ("Error: " ++ show e) diff --git a/src/Zenith/Core.hs b/src/Zenith/Core.hs index da73809..4e1d2c6 100644 --- a/src/Zenith/Core.hs +++ b/src/Zenith/Core.hs @@ -5,15 +5,34 @@ module Zenith.Core where import Control.Exception (throwIO) import Data.Aeson -import qualified Data.ByteString as BS +import Data.HexString (hexString) import qualified Data.Text as T import Database.Persist import Network.HTTP.Client import ZcashHaskell.Keys import ZcashHaskell.Orchard + ( encodeUnifiedAddress + , genOrchardReceiver + , genOrchardSpendingKey + ) +import ZcashHaskell.Sapling + ( genSaplingInternalAddress + , genSaplingPaymentAddress + , genSaplingSpendingKey + ) +import ZcashHaskell.Transparent (genTransparentPrvKey, genTransparentReceiver) import ZcashHaskell.Types import ZcashHaskell.Utils import Zenith.DB +import Zenith.Types + ( OrchardSpendingKeyDB(..) + , PhraseDB(..) + , SaplingSpendingKeyDB(..) + , ScopeDB(..) + , TransparentSpendingKeyDB(..) + , UnifiedAddressDB(..) + , ZcashNetDB(..) + ) -- * Zebra Node interaction -- | Checks the status of the `zebrad` node @@ -45,14 +64,14 @@ connectZebra nodeHost nodePort m params = do -- * Spending Keys -- | Create an Orchard Spending Key for the given wallet and account index -createOrchardSpendingKey :: ZcashWallet -> Int -> IO BS.ByteString +createOrchardSpendingKey :: ZcashWallet -> Int -> IO OrchardSpendingKey createOrchardSpendingKey zw i = do - let s = getWalletSeed $ zcashWalletSeedPhrase zw + let s = getWalletSeed $ getPhrase $ zcashWalletSeedPhrase zw case s of Nothing -> throwIO $ userError "Unable to generate seed" Just s' -> do let coinType = - case zcashWalletNetwork zw of + case getNet $ zcashWalletNetwork zw of MainNet -> MainNetCoin TestNet -> TestNetCoin RegTestNet -> RegTestNetCoin @@ -61,6 +80,36 @@ createOrchardSpendingKey zw i = do Nothing -> throwIO $ userError "Unable to generate Orchard spending key" Just sk -> return sk +-- | Create a Sapling spending key for the given wallet and account index +createSaplingSpendingKey :: ZcashWallet -> Int -> IO SaplingSpendingKey +createSaplingSpendingKey zw i = do + let s = getWalletSeed $ getPhrase $ zcashWalletSeedPhrase zw + case s of + Nothing -> throwIO $ userError "Unable to generate seed" + Just s' -> do + let coinType = + case getNet $ zcashWalletNetwork zw of + MainNet -> MainNetCoin + TestNet -> TestNetCoin + RegTestNet -> RegTestNetCoin + let r = genSaplingSpendingKey s' coinType i + case r of + Nothing -> throwIO $ userError "Unable to generate Sapling spending key" + Just sk -> return sk + +createTransparentSpendingKey :: ZcashWallet -> Int -> IO TransparentSpendingKey +createTransparentSpendingKey zw i = do + let s = getWalletSeed $ getPhrase $ zcashWalletSeedPhrase zw + case s of + Nothing -> throwIO $ userError "Unable to generate seed" + Just s' -> do + let coinType = + case getNet $ zcashWalletNetwork zw of + MainNet -> MainNetCoin + TestNet -> TestNetCoin + RegTestNet -> RegTestNetCoin + genTransparentPrvKey s' coinType i + -- * Accounts -- | Create an account for the given wallet and account index createZcashAccount :: @@ -70,24 +119,46 @@ createZcashAccount :: -> IO ZcashAccount createZcashAccount n i zw = do orSk <- createOrchardSpendingKey (entityVal zw) i - return $ ZcashAccount i (entityKey zw) n orSk "fakeSapKey" "fakeTkey" + sapSk <- createSaplingSpendingKey (entityVal zw) i + tSk <- createTransparentSpendingKey (entityVal zw) i + return $ + ZcashAccount + i + (entityKey zw) + n + (OrchardSpendingKeyDB orSk) + (SaplingSpendingKeyDB sapSk) + (TransparentSpendingKeyDB tSk) -- * Addresses --- | Create a unified address for the given account and index +-- | Create an external unified address for the given account and index createWalletAddress :: T.Text -- ^ The address nickname -> Int -- ^ The address' index -> ZcashNet -- ^ The network for this address + -> Scope -- ^ External or Internal -> Entity ZcashAccount -- ^ The Zcash account that the address will be attached to -> IO WalletAddress -createWalletAddress n i zNet za = do +createWalletAddress n i zNet scope za = do + let oRec = + genOrchardReceiver i scope $ + getOrchSK $ zcashAccountOrchSpendKey $ entityVal za + let sRec = + case scope of + External -> + genSaplingPaymentAddress i $ + getSapSK $ zcashAccountSapSpendKey $ entityVal za + Internal -> + genSaplingInternalAddress $ + getSapSK $ zcashAccountSapSpendKey $ entityVal za + tRec <- + genTransparentReceiver i scope $ + getTranSK $ zcashAccountTPrivateKey $ entityVal za return $ WalletAddress i (entityKey za) n - (UnifiedAddress - zNet - "fakeBString" - "fakeBString" - (Just $ TransparentAddress P2PKH zNet "fakeBString")) + (UnifiedAddressDB $ + encodeUnifiedAddress $ UnifiedAddress zNet oRec sRec (Just tRec)) + (ScopeDB scope) diff --git a/src/Zenith/DB.hs b/src/Zenith/DB.hs index 9ead0e7..8345aef 100644 --- a/src/Zenith/DB.hs +++ b/src/Zenith/DB.hs @@ -23,19 +23,24 @@ import qualified Data.Text as T import Database.Persist import Database.Persist.Sqlite import Database.Persist.TH -import ZcashHaskell.Types (Phrase, UnifiedAddress(..), ZcashNet) - -derivePersistField "ZcashNet" - -derivePersistField "UnifiedAddress" +import ZcashHaskell.Types (Scope(..), ZcashNet) +import Zenith.Types + ( OrchardSpendingKeyDB(..) + , PhraseDB(..) + , SaplingSpendingKeyDB(..) + , ScopeDB(..) + , TransparentSpendingKeyDB + , UnifiedAddressDB(..) + , ZcashNetDB(..) + ) share [mkPersist sqlSettings, mkMigrate "migrateAll"] [persistLowerCase| ZcashWallet name T.Text - network ZcashNet - seedPhrase Phrase + network ZcashNetDB + seedPhrase PhraseDB birthdayHeight Int UniqueWallet name network deriving Show Eq @@ -43,9 +48,9 @@ share index Int walletId ZcashWalletId name T.Text - orchSpendKey BS.ByteString - sapSpendKey BS.ByteString - tPrivateKey BS.ByteString + orchSpendKey OrchardSpendingKeyDB + sapSpendKey SaplingSpendingKeyDB + tPrivateKey TransparentSpendingKeyDB UniqueAccount index walletId UniqueAccName walletId name deriving Show Eq @@ -53,8 +58,9 @@ share index Int accId ZcashAccountId name T.Text - uAddress UnifiedAddress - UniqueAddress index accId + uAddress UnifiedAddressDB + scope ScopeDB + UniqueAddress index scope accId UniqueAddName accId name deriving Show Eq |] @@ -69,7 +75,8 @@ initDb dbName = do -- | Get existing wallets from database getWallets :: T.Text -> ZcashNet -> IO [Entity ZcashWallet] -getWallets dbFp n = runSqlite dbFp $ selectList [ZcashWalletNetwork ==. n] [] +getWallets dbFp n = + runSqlite dbFp $ selectList [ZcashWalletNetwork ==. ZcashNetDB n] [] -- | Save a new wallet to the database saveWallet :: @@ -110,17 +117,24 @@ getAddresses :: T.Text -- ^ The database path -> ZcashAccountId -- ^ The account ID to check -> IO [Entity WalletAddress] -getAddresses dbFp a = runSqlite dbFp $ selectList [WalletAddressAccId ==. a] [] +getAddresses dbFp a = + runSqlite dbFp $ + selectList + [WalletAddressAccId ==. a, WalletAddressScope ==. ScopeDB External] + [] -- | Returns the largest address index for the given account getMaxAddress :: T.Text -- ^ The database path - -> ZcashAccountId -- ^ The wallet ID to check + -> ZcashAccountId -- ^ The account ID to check + -> Scope -- ^ The scope of the address -> IO Int -getMaxAddress dbFp w = do +getMaxAddress dbFp aw s = do a <- runSqlite dbFp $ - selectFirst [WalletAddressAccId ==. w] [Desc WalletAddressIndex] + selectFirst + [WalletAddressAccId ==. aw, WalletAddressScope ==. ScopeDB s] + [Desc WalletAddressIndex] case a of Nothing -> return $ -1 Just x -> return $ walletAddressIndex $ entityVal x diff --git a/src/Zenith/Types.hs b/src/Zenith/Types.hs index 1ec4408..715e338 100644 --- a/src/Zenith/Types.hs +++ b/src/Zenith/Types.hs @@ -1,7 +1,11 @@ {-# LANGUAGE LambdaCase #-} +{-# LANGUAGE DerivingStrategies #-} +{-# LANGUAGE GeneralisedNewtypeDeriving #-} +{-# LANGUAGE TemplateHaskell #-} {-# LANGUAGE DeriveGeneric #-} {-# LANGUAGE DeriveAnyClass #-} {-# LANGUAGE OverloadedStrings #-} +{-# LANGUAGE StandaloneDeriving #-} module Zenith.Types where @@ -14,7 +18,58 @@ import Data.Maybe (fromMaybe) import qualified Data.Text as T import qualified Data.Text.Encoding as E import Data.Text.Encoding.Error (lenientDecode) +import Database.Persist.TH import GHC.Generics +import ZcashHaskell.Types + ( OrchardSpendingKey(..) + , Phrase(..) + , SaplingSpendingKey(..) + , Scope(..) + , TransparentSpendingKey + , ZcashNet(..) + ) + +newtype ZcashNetDB = ZcashNetDB + { getNet :: ZcashNet + } deriving newtype (Eq, Show, Read) + +derivePersistField "ZcashNetDB" + +newtype UnifiedAddressDB = UnifiedAddressDB + { getUA :: T.Text + } deriving newtype (Eq, Show, Read) + +derivePersistField "UnifiedAddressDB" + +newtype PhraseDB = PhraseDB + { getPhrase :: Phrase + } deriving newtype (Eq, Show, Read) + +derivePersistField "PhraseDB" + +newtype ScopeDB = ScopeDB + { getScope :: Scope + } deriving newtype (Eq, Show, Read) + +derivePersistField "ScopeDB" + +newtype OrchardSpendingKeyDB = OrchardSpendingKeyDB + { getOrchSK :: OrchardSpendingKey + } deriving newtype (Eq, Show, Read) + +derivePersistField "OrchardSpendingKeyDB" + +newtype SaplingSpendingKeyDB = SaplingSpendingKeyDB + { getSapSK :: SaplingSpendingKey + } deriving newtype (Eq, Show, Read) + +derivePersistField "SaplingSpendingKeyDB" + +newtype TransparentSpendingKeyDB = TransparentSpendingKeyDB + { getTranSK :: TransparentSpendingKey + } deriving newtype (Eq, Show, Read) + +derivePersistField "TransparentSpendingKeyDB" -- | A type to model Zcash RPC calls data RpcCall = RpcCall diff --git a/src/Zenith/Utils.hs b/src/Zenith/Utils.hs index 86a58ed..ed648a4 100644 --- a/src/Zenith/Utils.hs +++ b/src/Zenith/Utils.hs @@ -9,16 +9,13 @@ import Data.Functor (void) import Data.Maybe import qualified Data.Text as T import qualified Data.Text.Encoding as E -import qualified Data.Text.IO as TIO import System.Process (createProcess_, shell) -import Text.Read (readMaybe) import Text.Regex.Posix import ZcashHaskell.Orchard (encodeUnifiedAddress, isValidUnifiedAddress) import ZcashHaskell.Sapling (isValidShieldedAddress) -import ZcashHaskell.Types (UnifiedAddress(..)) import Zenith.Types ( AddressGroup(..) - , AddressSource(..) + , UnifiedAddressDB(..) , ZcashAddress(..) , ZcashPool(..) ) @@ -32,10 +29,10 @@ displayZec s | otherwise = show (fromIntegral s / 100000000) ++ " ZEC " -- | Helper function to display abbreviated Unified Address -showAddress :: UnifiedAddress -> T.Text +showAddress :: UnifiedAddressDB -> T.Text showAddress u = T.take 20 t <> "..." where - t = encodeUnifiedAddress u + t = getUA u -- | Helper function to extract addresses from AddressGroups getAddresses :: AddressGroup -> [ZcashAddress] diff --git a/test/Spec.hs b/test/Spec.hs index 03a2d20..bfc6f68 100644 --- a/test/Spec.hs +++ b/test/Spec.hs @@ -5,9 +5,17 @@ import Database.Persist import Database.Persist.Sqlite import System.Directory import Test.Hspec -import ZcashHaskell.Types (ZcashNet(..)) -import Zenith.Core (getAccounts) +import ZcashHaskell.Orchard (isValidUnifiedAddress) +import ZcashHaskell.Types + ( OrchardSpendingKey(..) + , Phrase(..) + , SaplingSpendingKey(..) + , Scope(..) + , ZcashNet(..) + ) +import Zenith.Core import Zenith.DB +import Zenith.Types main :: IO () main = do @@ -24,10 +32,12 @@ main = do runSqlite "test.db" $ do insert $ ZcashWallet - "one two three four five six seven eight nine ten eleven twelve" - 2000000 "Main Wallet" - MainNet + (ZcashNetDB MainNet) + (PhraseDB $ + Phrase + "one two three four five six seven eight nine ten eleven twelve") + 2000000 fromSqlKey s `shouldBe` 1 it "read wallet record" $ do s <- @@ -48,21 +58,43 @@ main = do delete recId get recId "None" `shouldBe` maybe "None" zcashWalletName s - describe "Account table" $ do - it "insert account" $ do + describe "Wallet function tests:" $ do + it "Save Wallet:" $ do + zw <- + saveWallet "test.db" $ + ZcashWallet + "Testing" + (ZcashNetDB MainNet) + (PhraseDB $ + Phrase + "cloth swing left trap random tornado have great onion element until make shy dad success art tuition canvas thunder apple decade elegant struggle invest") + 2200000 + zw `shouldNotBe` Nothing + it "Save Account:" $ do s <- runSqlite "test.db" $ do - insert $ - ZcashWallet - "one two three four five six seven eight nine ten eleven twelve" - 2000000 - "Main Wallet" - MainNet - t <- - runSqlite "test.db" $ do - insert $ ZcashAccount s 0 "132465798" "987654321" "739182462" - fromSqlKey t `shouldBe` 1 - it "read accounts for wallet" $ do - wList <- getWallets "test.db" MainNet - acc <- getAccounts "test.db" $ entityKey (head wList) - length acc `shouldBe` 1 + selectList [ZcashWalletName ==. "Testing"] [] + za <- + saveAccount "test.db" =<< + createZcashAccount "TestAccount" 0 (head s) + za `shouldNotBe` Nothing + it "Save address:" $ do + acList <- + runSqlite "test.db" $ + selectList [ZcashAccountName ==. "TestAccount"] [] + zAdd <- + saveAddress "test.db" =<< + createWalletAddress "Personal123" 0 MainNet External (head acList) + addList <- + runSqlite "test.db" $ + selectList + [ WalletAddressName ==. "Personal123" + , WalletAddressScope ==. ScopeDB External + ] + [] + getUA (walletAddressUAddress (entityVal $ head addList)) `shouldBe` + "u1trd8cvc6265ywwj4mmvuznsye5ghe2dhhn3zy8kcuyg4vx3svskw9r2dedp5hu6m740vylkqc34t4w9eqkl9fyu5uyzn3af72jg235440ke6tu5cf994eq85n97x69x9824hqejmwz3d8qqthtesrd6gerjupdymldhl9xccejjwfj0dhh9mt4rw4kytp325twlutsxd20rfqhzxu3m" + it "Address components are correct" $ do + let ua = + "utest1mvlny48qd4x94w8vz5u2lrxx0enuquajt72yekgq24p6pjaky3czk6m7x358h7g900ex6gzvdehaekl96qnakjzw8yaasp8y0u3j5jnlfd33trduznh6k3fcn5ek9qc857fgz8ehm37etx94sj58nrkc0k5hurxnuxpcpms3j8uy2t8kt2vy6vetvsfxxdhtjq0yqulqprvh7mf2u3x" + isValidUnifiedAddress ua `shouldNotBe` Nothing diff --git a/zcash-haskell b/zcash-haskell index 4963eea..f228eff 160000 --- a/zcash-haskell +++ b/zcash-haskell @@ -1 +1 @@ -Subproject commit 4963eea68bd1e3b38cbc14a64888d3f5aaef3f85 +Subproject commit f228eff367c776469455adc4d443102cc53e5538 diff --git a/zenith.cabal b/zenith.cabal index b14f4ea..cb291be 100644 --- a/zenith.cabal +++ b/zenith.cabal @@ -1,10 +1,10 @@ cabal-version: 3.0 name: zenith -version: 0.4.3.0 +version: 0.4.4.0 license: MIT license-file: LICENSE author: Rene Vergara -maintainer: pitmut@vergara.tech +maintainer: pitmutt@vergara.tech copyright: (c) 2022-2024 Vergara Technologies LLC build-type: Custom category: Blockchain @@ -13,8 +13,6 @@ extra-doc-files: CHANGELOG.md zenith.cfg -common warnings - ghc-options: -Wall -threaded -rtsopts -with-rtsopts=-N -Wunused-imports custom-setup setup-depends: @@ -26,7 +24,6 @@ custom-setup , regex-compat library - import: warnings ghc-options: -Wall -Wunused-imports exposed-modules: Zenith.CLI @@ -56,6 +53,7 @@ library , persistent-sqlite , persistent-template , process + , hexstring , regex-base , regex-compat , regex-posix @@ -63,12 +61,13 @@ library , text , vector , vty + , word-wrap , zcash-haskell --pkgconfig-depends: rustzcash_wrapper default-language: Haskell2010 executable zenith - import: warnings + ghc-options: -threaded -rtsopts -with-rtsopts=-N main-is: Main.hs hs-source-dirs: app @@ -88,8 +87,8 @@ executable zenith default-language: Haskell2010 test-suite zenith-tests - import: warnings type: exitcode-stdio-1.0 + ghc-options: -threaded -rtsopts -with-rtsopts=-N main-is: Spec.hs hs-source-dirs: test