rvv001 - Issue 0122 - Generate Viewing Keys

The Viewing Keys deriving functions are now
                      integrated to the GUI module.
This commit is contained in:
Rene V. Vergara 2025-01-07 12:02:21 -05:00
parent ff6168b45e
commit d8457eceb6
2 changed files with 58 additions and 25 deletions

View file

@ -40,7 +40,7 @@ import System.FilePath ((</>))
import Text.Printf (printf) import Text.Printf (printf)
import Text.Wrap (FillScope(..), FillStrategy(..), WrapSettings(..), wrapText) import Text.Wrap (FillScope(..), FillStrategy(..), WrapSettings(..), wrapText)
import TextShow hiding (toText) import TextShow hiding (toText)
import ZcashHaskell.Keys (generateWalletSeedPhrase) import ZcashHaskell.Keys (generateWalletSeedPhrase, deriveUfvk, deriveUivk)
import ZcashHaskell.Orchard import ZcashHaskell.Orchard
( getSaplingFromUA ( getSaplingFromUA
, isValidUnifiedAddress , isValidUnifiedAddress
@ -160,6 +160,7 @@ data AppEvent
| ShowFIATBalance | ShowFIATBalance
| DisplayFIATBalance Double Double | DisplayFIATBalance Double Double
| CloseFIATBalance | CloseFIATBalance
| PrepareViewingKey !VkTypeDef !(Maybe (Entity ZcashAccount))
| ShowViewingKey !VkTypeDef !T.Text | ShowViewingKey !VkTypeDef !T.Text
| CopyViewingKey !T.Text !T.Text | CopyViewingKey !T.Text !T.Text
| CloseShowVK | CloseShowVK
@ -416,18 +417,20 @@ buildUI wenv model = widgetTree
[ box_ [ box_
[ alignLeft [ alignLeft
, onClick , onClick
(ShowViewingKey (PrepareViewingKey
VkFull VkFull
"VKFull->ztestsapling1tgjr4zppwk4ne8xy6gdq4z2gwq7dmf5jq8z2ctpn8nlmtse0a74fa5z0m8z383gmpgqz6q6duu4") currentAccount
)
] ]
(hstack [label "Full VK", filler]) `styleBasic` (hstack [label "Full VK", filler]) `styleBasic`
[bgColor white, borderB 1 gray, padding 3] [bgColor white, borderB 1 gray, padding 3]
, box_ , box_
[ alignLeft [ alignLeft
, onClick $ , onClick
(ShowViewingKey (PrepareViewingKey
VkIncoming VkIncoming
"VKIncoming->ztestsapling1tgjr4zppwk4ne8xy6gdq4z2gwq7dmf5jq8z2ctpn8nlmtse0a74fa5z0m8z383gmpgqz6q6duu4") currentAccount
)
] ]
(hstack [label "Incoming VK", filler]) `styleBasic` (hstack [label "Incoming VK", filler]) `styleBasic`
[bgColor white, borderB 1 gray, padding 3] [bgColor white, borderB 1 gray, padding 3]
@ -1767,24 +1770,28 @@ handleEvent wenv node model evt =
] ]
CloseFIATBalance -> [Model $ model & displayFIATBalance .~ False] CloseFIATBalance -> [Model $ model & displayFIATBalance .~ False]
-- --
-- Prepare Viewing Keys
--
PrepareViewingKey vkType cAcc ->
case vkType of
VkFull -> [ Task $ getFullVk (model ^. network) cAcc ]
VkIncoming -> [ Task $ getIncomingVk (model ^. network) cAcc ]
--
-- Show Viewing Keys -- Show Viewing Keys
-- --
ShowViewingKey vkType vkText -> ShowViewingKey vkType vkText ->
case vkType of case vkType of
VkFull -> VkFull -> [ Model $
[ Model $ model & vkTypeName .~ "Full"
model & vkTypeName .~ "Full" & vkData .~ vkText & viewingKeyDisplay .~ & vkData .~ vkText
True & & viewingKeyDisplay .~ True
menuPopup .~ & menuPopup .~ False
False
] ]
VkIncoming -> VkIncoming -> [ Model $
[ Model $ model & vkTypeName .~ "Incoming"
model & vkTypeName .~ "Incoming" & vkData .~ vkText & & vkData .~ vkText
viewingKeyDisplay .~ & viewingKeyDisplay .~ True
True & & menuPopup .~ False
menuPopup .~
False
] ]
-- --
-- Display PaymentURI Form -- Display PaymentURI Form
@ -2011,6 +2018,32 @@ handleEvent wenv node model evt =
procIfValidURI :: T.Text -> IO AppEvent procIfValidURI :: T.Text -> IO AppEvent
procIfValidURI ustr = do procIfValidURI ustr = do
return $ ShowSend return $ ShowSend
--
-- Get Full Viewing Key
--
getFullVk :: ZcashNet -> Maybe (Entity ZcashAccount) -> IO AppEvent
getFullVk n cAcc = do
case cAcc of
Nothing -> return $ ShowMessage "Viewing Key Error: No account selected!"
Just acc -> do
let osk = getOrchSK $ zcashAccountOrchSpendKey $ entityVal acc
let ssk = getSapSK $ zcashAccountSapSpendKey $ entityVal acc
let tsk = getTranSK $ zcashAccountTPrivateKey $ entityVal acc
fvk <- deriveUfvk n osk ssk tsk
return $ ShowViewingKey VkFull fvk
--
-- Get Incoming Viewing Key
--
getIncomingVk :: ZcashNet -> Maybe (Entity ZcashAccount) -> IO AppEvent
getIncomingVk n cAcc = do
case cAcc of
Nothing -> return $ ShowMessage "Viewing Key Error: No account selected!"
Just acc -> do
let osk = getOrchSK $ zcashAccountOrchSpendKey $ entityVal acc
let ssk = getSapSK $ zcashAccountSapSpendKey $ entityVal acc
let tsk = getTranSK $ zcashAccountTPrivateKey $ entityVal acc
ivk <- deriveUivk n osk ssk tsk
return $ ShowViewingKey VkIncoming ivk
scanZebra :: scanZebra ::
T.Text T.Text

View file

@ -16,8 +16,8 @@ import Data.Char (isAlphaNum, isSpace)
import Data.Functor (void) import Data.Functor (void)
import Data.Maybe import Data.Maybe
import Data.Ord (clamp) import Data.Ord (clamp)
import Data.Scientific (Scientific(..), scientific) import Data.Scientific (Scientific(..), scientific, Scientific, toRealFloat)
import Data.Scientific (Scientific, toRealFloat) --import Data.Scientific (Scientific, toRealFloat)
import qualified Data.Text as T import qualified Data.Text as T
import qualified Data.Text.Encoding as E import qualified Data.Text.Encoding as E
import qualified Data.Text.Encoding as TE import qualified Data.Text.Encoding as TE