Compare commits

..

No commits in common. "bd32eb4f38a55efa9aec9fcf4a736d223c744e04" and "856ade051e5e62c609a707874c7897231dd96c10" have entirely different histories.

9 changed files with 89 additions and 262 deletions

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: 39d8da7b11a80269454c2f134a5c834e0f3cb9a7
tag: fd1ddce73c0ad18a2a4509a299c6e93f8c6c383d
source-repository-package
type: git

View file

@ -3,6 +3,16 @@
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
@ -32,10 +42,11 @@ import Brick.Widgets.Core
, joinBorders
, padAll
, padBottom
, padRight
, str
, strWrap
, txt
, txtWrapWith
, txtWrap
, vBox
, vLimit
, withAttr
@ -43,23 +54,13 @@ 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
@ -241,8 +242,8 @@ drawUI s = [splashDialog s, helpDialog s, displayDialog s, inputDialog s, ui s]
Nothing
60)
(padAll 1 $
txtWrapWith (WrapSettings False True NoFill FillAfterFirst) $
getUA $ walletAddressUAddress $ entityVal a)
txtWrap $
encodeUnifiedAddress $ walletAddressUAddress $ entityVal a)
Nothing -> emptyWidget
MsgDisplay ->
withBorderStyle unicodeBold $
@ -343,11 +344,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
ns <-
liftIO $
refreshAccount =<<
addNewAddress "Change" Internal =<<
addNewAccount (fs ^. dialogInput) s
na <- liftIO $ addNewAccount (fs ^. dialogInput) s
ns <- liftIO $ refreshAccount na
BT.put ns
addrL <- use addresses
BT.modify $ set displayBox MsgDisplay
@ -363,8 +361,7 @@ 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) External s
nAddr <- liftIO $ addNewAddress (fs ^. dialogInput) s
BT.put nAddr
BT.modify $ set displayBox MsgDisplay
BT.modify $ set dialogBox Blank
@ -454,7 +451,7 @@ runZenithCLI host port dbFilePath = do
Just zebra -> do
bc <- checkBlockChain host port
case (bc :: Maybe ZebraGetBlockChainInfo) of
Nothing -> throwIO $ userError "Unable to determine blockchain status"
Nothing -> print "Unable to determine blockchain status"
Just chainInfo -> do
initDb dbFilePath
walList <- getWallets dbFilePath $ zgb_net chainInfo
@ -518,9 +515,7 @@ addNewWallet n s = do
sP <- generateWalletSeedPhrase
let bH = s ^. startBlock
let netName = s ^. network
r <-
saveWallet (s ^. dbPath) $
ZcashWallet n (ZcashNetDB netName) (PhraseDB sP) bH
r <- saveWallet (s ^. dbPath) $ ZcashWallet n netName sP bH
case r of
Nothing -> do
return $ s & msg .~ ("Wallet already exists: " ++ T.unpack n)
@ -578,8 +573,8 @@ refreshAccount s = do
s & addresses .~ aL' & msg .~ "Switched to account: " ++
T.unpack (zcashAccountName $ entityVal selAccount)
addNewAddress :: T.Text -> Scope -> State -> IO State
addNewAddress n scope s = do
addNewAddress :: T.Text -> State -> IO State
addNewAddress n s = do
selAccount <-
do case L.listSelectedElement $ s ^. accounts of
Nothing -> do
@ -589,9 +584,9 @@ addNewAddress n scope 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) scope
maxAddr <- getMaxAddress (s ^. dbPath) (entityKey selAccount)
uA <-
try $ createWalletAddress n (maxAddr + 1) (s ^. network) scope selAccount :: IO
try $ createWalletAddress n (maxAddr + 1) (s ^. network) selAccount :: IO
(Either IOError WalletAddress)
case uA of
Left e -> return $ s & msg .~ ("Error: " ++ show e)

View file

@ -5,34 +5,15 @@ module Zenith.Core where
import Control.Exception (throwIO)
import Data.Aeson
import Data.HexString (hexString)
import qualified Data.ByteString as BS
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
@ -64,14 +45,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 OrchardSpendingKey
createOrchardSpendingKey :: ZcashWallet -> Int -> IO BS.ByteString
createOrchardSpendingKey zw i = do
let s = getWalletSeed $ getPhrase $ zcashWalletSeedPhrase zw
let s = getWalletSeed $ zcashWalletSeedPhrase zw
case s of
Nothing -> throwIO $ userError "Unable to generate seed"
Just s' -> do
let coinType =
case getNet $ zcashWalletNetwork zw of
case zcashWalletNetwork zw of
MainNet -> MainNetCoin
TestNet -> TestNetCoin
RegTestNet -> RegTestNetCoin
@ -80,36 +61,6 @@ 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 ::
@ -119,46 +70,24 @@ createZcashAccount ::
-> IO ZcashAccount
createZcashAccount n i zw = do
orSk <- createOrchardSpendingKey (entityVal zw) i
sapSk <- createSaplingSpendingKey (entityVal zw) i
tSk <- createTransparentSpendingKey (entityVal zw) i
return $
ZcashAccount
i
(entityKey zw)
n
(OrchardSpendingKeyDB orSk)
(SaplingSpendingKeyDB sapSk)
(TransparentSpendingKeyDB tSk)
return $ ZcashAccount i (entityKey zw) n orSk "fakeSapKey" "fakeTkey"
-- * Addresses
-- | Create an external unified address for the given account and index
-- | Create a 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 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
createWalletAddress n i zNet za = do
return $
WalletAddress
i
(entityKey za)
n
(UnifiedAddressDB $
encodeUnifiedAddress $ UnifiedAddress zNet oRec sRec (Just tRec))
(ScopeDB scope)
(UnifiedAddress
zNet
"fakeBString"
"fakeBString"
(Just $ TransparentAddress P2PKH zNet "fakeBString"))

View file

@ -23,24 +23,19 @@ import qualified Data.Text as T
import Database.Persist
import Database.Persist.Sqlite
import Database.Persist.TH
import ZcashHaskell.Types (Scope(..), ZcashNet)
import Zenith.Types
( OrchardSpendingKeyDB(..)
, PhraseDB(..)
, SaplingSpendingKeyDB(..)
, ScopeDB(..)
, TransparentSpendingKeyDB
, UnifiedAddressDB(..)
, ZcashNetDB(..)
)
import ZcashHaskell.Types (Phrase, UnifiedAddress(..), ZcashNet)
derivePersistField "ZcashNet"
derivePersistField "UnifiedAddress"
share
[mkPersist sqlSettings, mkMigrate "migrateAll"]
[persistLowerCase|
ZcashWallet
name T.Text
network ZcashNetDB
seedPhrase PhraseDB
network ZcashNet
seedPhrase Phrase
birthdayHeight Int
UniqueWallet name network
deriving Show Eq
@ -48,9 +43,9 @@ share
index Int
walletId ZcashWalletId
name T.Text
orchSpendKey OrchardSpendingKeyDB
sapSpendKey SaplingSpendingKeyDB
tPrivateKey TransparentSpendingKeyDB
orchSpendKey BS.ByteString
sapSpendKey BS.ByteString
tPrivateKey BS.ByteString
UniqueAccount index walletId
UniqueAccName walletId name
deriving Show Eq
@ -58,9 +53,8 @@ share
index Int
accId ZcashAccountId
name T.Text
uAddress UnifiedAddressDB
scope ScopeDB
UniqueAddress index scope accId
uAddress UnifiedAddress
UniqueAddress index accId
UniqueAddName accId name
deriving Show Eq
|]
@ -75,8 +69,7 @@ initDb dbName = do
-- | Get existing wallets from database
getWallets :: T.Text -> ZcashNet -> IO [Entity ZcashWallet]
getWallets dbFp n =
runSqlite dbFp $ selectList [ZcashWalletNetwork ==. ZcashNetDB n] []
getWallets dbFp n = runSqlite dbFp $ selectList [ZcashWalletNetwork ==. n] []
-- | Save a new wallet to the database
saveWallet ::
@ -117,24 +110,17 @@ getAddresses ::
T.Text -- ^ The database path
-> ZcashAccountId -- ^ The account ID to check
-> IO [Entity WalletAddress]
getAddresses dbFp a =
runSqlite dbFp $
selectList
[WalletAddressAccId ==. a, WalletAddressScope ==. ScopeDB External]
[]
getAddresses dbFp a = runSqlite dbFp $ selectList [WalletAddressAccId ==. a] []
-- | Returns the largest address index for the given account
getMaxAddress ::
T.Text -- ^ The database path
-> ZcashAccountId -- ^ The account ID to check
-> Scope -- ^ The scope of the address
-> ZcashAccountId -- ^ The wallet ID to check
-> IO Int
getMaxAddress dbFp aw s = do
getMaxAddress dbFp w = do
a <-
runSqlite dbFp $
selectFirst
[WalletAddressAccId ==. aw, WalletAddressScope ==. ScopeDB s]
[Desc WalletAddressIndex]
selectFirst [WalletAddressAccId ==. w] [Desc WalletAddressIndex]
case a of
Nothing -> return $ -1
Just x -> return $ walletAddressIndex $ entityVal x

View file

@ -1,11 +1,7 @@
{-# LANGUAGE LambdaCase #-}
{-# LANGUAGE DerivingStrategies #-}
{-# LANGUAGE GeneralisedNewtypeDeriving #-}
{-# LANGUAGE TemplateHaskell #-}
{-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE DeriveAnyClass #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE StandaloneDeriving #-}
module Zenith.Types where
@ -18,58 +14,7 @@ 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

View file

@ -9,13 +9,16 @@ 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(..)
, UnifiedAddressDB(..)
, AddressSource(..)
, ZcashAddress(..)
, ZcashPool(..)
)
@ -29,10 +32,10 @@ displayZec s
| otherwise = show (fromIntegral s / 100000000) ++ " ZEC "
-- | Helper function to display abbreviated Unified Address
showAddress :: UnifiedAddressDB -> T.Text
showAddress :: UnifiedAddress -> T.Text
showAddress u = T.take 20 t <> "..."
where
t = getUA u
t = encodeUnifiedAddress u
-- | Helper function to extract addresses from AddressGroups
getAddresses :: AddressGroup -> [ZcashAddress]

View file

@ -5,17 +5,9 @@ import Database.Persist
import Database.Persist.Sqlite
import System.Directory
import Test.Hspec
import ZcashHaskell.Orchard (isValidUnifiedAddress)
import ZcashHaskell.Types
( OrchardSpendingKey(..)
, Phrase(..)
, SaplingSpendingKey(..)
, Scope(..)
, ZcashNet(..)
)
import Zenith.Core
import ZcashHaskell.Types (ZcashNet(..))
import Zenith.Core (getAccounts)
import Zenith.DB
import Zenith.Types
main :: IO ()
main = do
@ -32,12 +24,10 @@ main = do
runSqlite "test.db" $ do
insert $
ZcashWallet
"Main Wallet"
(ZcashNetDB MainNet)
(PhraseDB $
Phrase
"one two three four five six seven eight nine ten eleven twelve")
"one two three four five six seven eight nine ten eleven twelve"
2000000
"Main Wallet"
MainNet
fromSqlKey s `shouldBe` 1
it "read wallet record" $ do
s <-
@ -58,43 +48,21 @@ main = do
delete recId
get recId
"None" `shouldBe` maybe "None" zcashWalletName s
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
describe "Account table" $ do
it "insert account" $ do
s <-
runSqlite "test.db" $ do
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
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

@ -1 +1 @@
Subproject commit f228eff367c776469455adc4d443102cc53e5538
Subproject commit e371fcdb724686bfb51157911c5d4c0fda433c53

View file

@ -1,10 +1,10 @@
cabal-version: 3.0
name: zenith
version: 0.4.4.0
version: 0.4.3.0
license: MIT
license-file: LICENSE
author: Rene Vergara
maintainer: pitmutt@vergara.tech
maintainer: pitmut@vergara.tech
copyright: (c) 2022-2024 Vergara Technologies LLC
build-type: Custom
category: Blockchain
@ -13,6 +13,8 @@ extra-doc-files:
CHANGELOG.md
zenith.cfg
common warnings
ghc-options: -Wall -threaded -rtsopts -with-rtsopts=-N -Wunused-imports
custom-setup
setup-depends:
@ -24,6 +26,7 @@ custom-setup
, regex-compat
library
import: warnings
ghc-options: -Wall -Wunused-imports
exposed-modules:
Zenith.CLI
@ -53,7 +56,6 @@ library
, persistent-sqlite
, persistent-template
, process
, hexstring
, regex-base
, regex-compat
, regex-posix
@ -61,13 +63,12 @@ library
, text
, vector
, vty
, word-wrap
, zcash-haskell
--pkgconfig-depends: rustzcash_wrapper
default-language: Haskell2010
executable zenith
ghc-options: -threaded -rtsopts -with-rtsopts=-N
import: warnings
main-is: Main.hs
hs-source-dirs:
app
@ -87,8 +88,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