Vergara_Tech
/
zenith
2
0
Fork 0
Code Issues 38 Pull Requests Packages Projects Releases 5 Wiki Activity

Implement internal change addresses

This commit is contained in:
Rene Vergara 2024-03-17 07:17:52 -05:00
parent 2d119d24f1
commit bd32eb4f38
Signed by: pitmutt
GPG Key ID: 65122AD495A7F5B2
9 changed files with 262 additions and 89 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

2
cabal.project
View File

@ -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

53
src/Zenith/CLI.hs
View File

@ -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)

95
src/Zenith/Core.hs
View File

@ -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)

48
src/Zenith/DB.hs
View File

@ -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

55
src/Zenith/Types.hs
View File

@ -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

9
src/Zenith/Utils.hs
View File

@ -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]

74
test/Spec.hs
View File

@ -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

2
zcash-haskell

@ -1 +1 @@
Subproject commit 4963eea68bd1e3b38cbc14a64888d3f5aaef3f85
Subproject commit f228eff367c776469455adc4d443102cc53e5538

13
zenith.cabal
View File

@ -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