Vergara_Tech/zenith
Vergara_Tech/zenith
2
0
Fork 0
Code Issues 24 Pull requests Projects Releases 6 Packages Wiki Activity

feat: refactor ZcashPool type

Browse source
This commit is contained in:
Rene Vergara 2024-09-29 17:11:06 -05:00
parent 302cfb0b76
commit b95213ae5c
Signed by: pitmutt
GPG key ID: 65122AD495A7F5B2
6 changed files with 72 additions and 67 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

1
CHANGELOG.md
View file

@ -25,6 +25,7 @@ and this project adheres to [Semantic Versioning](https://semver.org/spec/v2.0.0
- Detection of changes in database schema for automatic re-scan - Detection of changes in database schema for automatic re-scan
- Block tracking for chain re-org detection - Block tracking for chain re-org detection
- Refactored `ZcashPool`
## [0.6.0.0-beta] ## [0.6.0.0-beta]

6
src/Zenith/DB.hs
View file

@ -347,7 +347,7 @@ trToZcashNoteAPI pool n = do
return $ return $
ZcashNoteAPI ZcashNoteAPI
(getHex $ walletTransactionTxId $ entityVal t') -- tx ID (getHex $ walletTransactionTxId $ entityVal t') -- tx ID
Zenith.Types.Transparent -- pool Zenith.Types.TransparentPool -- pool
(fromIntegral (walletTrNoteValue (entityVal n)) / 100000000.0) -- zec (fromIntegral (walletTrNoteValue (entityVal n)) / 100000000.0) -- zec
(walletTrNoteValue $ entityVal n) -- zats (walletTrNoteValue $ entityVal n) -- zats
"" -- memo "" -- memo
@ -368,7 +368,7 @@ sapToZcashNoteAPI pool n = do
return $ return $
ZcashNoteAPI ZcashNoteAPI
(getHex $ walletTransactionTxId $ entityVal t') -- tx ID (getHex $ walletTransactionTxId $ entityVal t') -- tx ID
Zenith.Types.Sapling -- pool Zenith.Types.SaplingPool -- pool
(fromIntegral (walletSapNoteValue (entityVal n)) / 100000000.0) -- zec (fromIntegral (walletSapNoteValue (entityVal n)) / 100000000.0) -- zec
(walletSapNoteValue $ entityVal n) -- zats (walletSapNoteValue $ entityVal n) -- zats
(walletSapNoteMemo $ entityVal n) -- memo (walletSapNoteMemo $ entityVal n) -- memo
@ -389,7 +389,7 @@ orchToZcashNoteAPI pool n = do
return $ return $
ZcashNoteAPI ZcashNoteAPI
(getHex $ walletTransactionTxId $ entityVal t') -- tx ID (getHex $ walletTransactionTxId $ entityVal t') -- tx ID
Orchard OrchardPool
(fromIntegral (walletOrchNoteValue (entityVal n)) / 100000000.0) -- zec (fromIntegral (walletOrchNoteValue (entityVal n)) / 100000000.0) -- zec
(walletOrchNoteValue $ entityVal n) -- zats (walletOrchNoteValue $ entityVal n) -- zats
(walletOrchNoteMemo $ entityVal n) -- memo (walletOrchNoteMemo $ entityVal n) -- memo

61
src/Zenith/GUI.hs
View file

@ -413,43 +413,43 @@ buildUI wenv model = widgetTree
[ vstack [ vstack
[ tooltip "Unified" $ [ tooltip "Unified" $
box_ box_
[onClick (SetPool Orchard)] [onClick (SetPool OrchardPool)]
(remixIcon remixShieldCheckFill `styleBasic` (remixIcon remixShieldCheckFill `styleBasic`
[ textSize 14 [ textSize 14
, padding 4 , padding 4
, styleIf , styleIf
(model ^. selPool == Orchard) (model ^. selPool == OrchardPool)
(bgColor btnColor) (bgColor btnColor)
, styleIf , styleIf
(model ^. selPool == Orchard) (model ^. selPool == OrchardPool)
(textColor white) (textColor white)
]) ])
, filler , filler
, tooltip "Legacy Shielded" $ , tooltip "Legacy Shielded" $
box_ box_
[onClick (SetPool Sapling)] [onClick (SetPool SaplingPool)]
(remixIcon remixShieldLine `styleBasic` (remixIcon remixShieldLine `styleBasic`
[ textSize 14 [ textSize 14
, padding 4 , padding 4
, styleIf , styleIf
(model ^. selPool == Sapling) (model ^. selPool == SaplingPool)
(bgColor btnColor) (bgColor btnColor)
, styleIf , styleIf
(model ^. selPool == Sapling) (model ^. selPool == SaplingPool)
(textColor white) (textColor white)
]) ])
, filler , filler
, tooltip "Transparent" $ , tooltip "Transparent" $
box_ box_
[onClick (SetPool Transparent)] [onClick (SetPool TransparentPool)]
(remixIcon remixEyeLine `styleBasic` (remixIcon remixEyeLine `styleBasic`
[ textSize 14 [ textSize 14
, padding 4 , padding 4
, styleIf , styleIf
(model ^. selPool == Transparent) (model ^. selPool == TransparentPool)
(bgColor btnColor) (bgColor btnColor)
, styleIf , styleIf
(model ^. selPool == Transparent) (model ^. selPool == TransparentPool)
(textColor white) (textColor white)
]) ])
] `styleBasic` ] `styleBasic`
@ -462,10 +462,10 @@ buildUI wenv model = widgetTree
(hstack (hstack
[ label [ label
(case model ^. selPool of (case model ^. selPool of
Orchard -> "Unified" OrchardPool -> "Unified"
Sapling -> "Legacy Shielded" SaplingPool -> "Legacy Shielded"
Transparent -> "Transparent" TransparentPool -> "Transparent"
Sprout -> "Unknown") `styleBasic` SproutPool -> "Unknown") `styleBasic`
[textColor white] [textColor white]
, remixIcon remixFileCopyFill `styleBasic` , remixIcon remixFileCopyFill `styleBasic`
[textSize 14, padding 4, textColor white] [textSize 14, padding 4, textColor white]
@ -944,9 +944,9 @@ generateQRCodes config = do
if not (null s) if not (null s)
then return () then return ()
else do else do
generateOneQr pool Orchard wAddr generateOneQr pool OrchardPool wAddr
generateOneQr pool Sapling wAddr generateOneQr pool SaplingPool wAddr
generateOneQr pool Transparent wAddr generateOneQr pool TransparentPool wAddr
generateOneQr :: generateOneQr ::
ConnectionPool -> ZcashPool -> Entity WalletAddress -> IO () ConnectionPool -> ZcashPool -> Entity WalletAddress -> IO ()
generateOneQr p zp wAddr = generateOneQr p zp wAddr =
@ -981,7 +981,7 @@ generateQRCodes config = do
dispAddr :: ZcashPool -> WalletAddress -> Maybe T.Text dispAddr :: ZcashPool -> WalletAddress -> Maybe T.Text
dispAddr zp w = dispAddr zp w =
case zp of case zp of
Transparent -> TransparentPool ->
T.append "zcash:" . T.append "zcash:" .
encodeTransparentReceiver encodeTransparentReceiver
(maybe (maybe
@ -993,11 +993,12 @@ generateQRCodes config = do
(t_rec =<< (t_rec =<<
(isValidUnifiedAddress . E.encodeUtf8 . getUA . walletAddressUAddress) (isValidUnifiedAddress . E.encodeUtf8 . getUA . walletAddressUAddress)
w) w)
Sapling -> SaplingPool ->
T.append "zcash:" <$> T.append "zcash:" <$>
(getSaplingFromUA . E.encodeUtf8 . getUA . walletAddressUAddress) w (getSaplingFromUA . E.encodeUtf8 . getUA . walletAddressUAddress) w
Orchard -> Just $ (T.append "zcash:" . getUA . walletAddressUAddress) w OrchardPool ->
Sprout -> Nothing Just $ (T.append "zcash:" . getUA . walletAddressUAddress) w
SproutPool -> Nothing
handleEvent :: handleEvent ::
WidgetEnv AppModel AppEvent WidgetEnv AppModel AppEvent
@ -1111,7 +1112,7 @@ handleEvent wenv node model evt =
Just wAddr -> getUserTx dbPool $ entityKey wAddr Just wAddr -> getUserTx dbPool $ entityKey wAddr
] ]
SwitchQr q -> [Model $ model & qrCodeWidget .~ q] SwitchQr q -> [Model $ model & qrCodeWidget .~ q]
SwitchAddr i -> [Model $ model & selAddr .~ i, Event $ SetPool Orchard] SwitchAddr i -> [Model $ model & selAddr .~ i, Event $ SetPool OrchardPool]
SwitchAcc i -> SwitchAcc i ->
[ Model $ model & selAcc .~ i [ Model $ model & selAcc .~ i
, Task $ , Task $
@ -1129,7 +1130,7 @@ handleEvent wenv node model evt =
b <- getBalance dbPool $ entityKey acc b <- getBalance dbPool $ entityKey acc
u <- getUnconfirmedBalance dbPool $ entityKey acc u <- getUnconfirmedBalance dbPool $ entityKey acc
return (b, u) return (b, u)
, Event $ SetPool Orchard , Event $ SetPool OrchardPool
] ]
SwitchWal i -> SwitchWal i ->
[ Model $ model & selWallet .~ i & selAcc .~ 0 & selAddr .~ 0 [ Model $ model & selWallet .~ i & selAcc .~ 0 & selAddr .~ 0
@ -1152,14 +1153,15 @@ handleEvent wenv node model evt =
, setClipboardData $ , setClipboardData $
ClipboardText $ ClipboardText $
case model ^. selPool of case model ^. selPool of
Orchard -> maybe "None" (getUA . walletAddressUAddress . entityVal) a OrchardPool ->
Sapling -> maybe "None" (getUA . walletAddressUAddress . entityVal) a
SaplingPool ->
fromMaybe "None" $ fromMaybe "None" $
(getSaplingFromUA . (getSaplingFromUA .
E.encodeUtf8 . getUA . walletAddressUAddress . entityVal) =<< E.encodeUtf8 . getUA . walletAddressUAddress . entityVal) =<<
a a
Sprout -> "None" SproutPool -> "None"
Transparent -> TransparentPool ->
maybe "None" (encodeTransparentReceiver (model ^. network)) $ maybe "None" (encodeTransparentReceiver (model ^. network)) $
t_rec =<< t_rec =<<
(isValidUnifiedAddress . (isValidUnifiedAddress .
@ -1182,7 +1184,7 @@ handleEvent wenv node model evt =
if not (null a) if not (null a)
then [ Model $ model & addresses .~ a then [ Model $ model & addresses .~ a
, Event $ SwitchAddr $ model ^. selAddr , Event $ SwitchAddr $ model ^. selAddr
, Event $ SetPool Orchard , Event $ SetPool OrchardPool
] ]
else [Event $ NewAddress currentAccount] else [Event $ NewAddress currentAccount]
LoadAccs a -> LoadAccs a ->
@ -1584,7 +1586,8 @@ runZenithGUI config = do
else return [] else return []
qr <- qr <-
if not (null addrList) if not (null addrList)
then getQrCode pool Orchard $ entityKey $ head addrList then getQrCode pool OrchardPool $
entityKey $ head addrList
else return Nothing else return Nothing
bal <- bal <-
if not (null accList) if not (null accList)
@ -1613,7 +1616,7 @@ runZenithGUI config = do
(if unconfBal == 0 (if unconfBal == 0
then Nothing then Nothing
else Just unconfBal) else Just unconfBal)
Orchard OrchardPool
qr qr
False False
False False

29
src/Zenith/Types.hs
View file

@ -104,10 +104,10 @@ data Config = Config
} deriving (Eq, Prelude.Show) } deriving (Eq, Prelude.Show)
data ZcashPool data ZcashPool
= Transparent = TransparentPool
| Sprout | SproutPool
| Sapling | SaplingPool
| Orchard | OrchardPool
deriving (Show, Read, Eq) deriving (Show, Read, Eq)
derivePersistField "ZcashPool" derivePersistField "ZcashPool"
@ -115,18 +115,18 @@ derivePersistField "ZcashPool"
instance ToJSON ZcashPool where instance ToJSON ZcashPool where
toJSON zp = toJSON zp =
case zp of case zp of
Transparent -> Data.Aeson.String "p2pkh" TransparentPool -> Data.Aeson.String "p2pkh"
Sprout -> Data.Aeson.String "sprout" SproutPool -> Data.Aeson.String "sprout"
Sapling -> Data.Aeson.String "sapling" SaplingPool -> Data.Aeson.String "sapling"
Orchard -> Data.Aeson.String "orchard" OrchardPool -> Data.Aeson.String "orchard"
instance FromJSON ZcashPool where instance FromJSON ZcashPool where
parseJSON = parseJSON =
withText "ZcashPool" $ \case withText "ZcashPool" $ \case
"p2pkh" -> return Transparent "p2pkh" -> return TransparentPool
"sprout" -> return Sprout "sprout" -> return SproutPool
"sapling" -> return Sapling "sapling" -> return SaplingPool
"orchard" -> return Orchard "orchard" -> return OrchardPool
_ -> fail "Not a known Zcash pool" _ -> fail "Not a known Zcash pool"
newtype ZenithUuid = ZenithUuid newtype ZenithUuid = ZenithUuid
@ -298,7 +298,8 @@ instance FromJSON AddressGroup where
Nothing -> return [] Nothing -> return []
Just x -> do Just x -> do
x' <- x .:? "addresses" x' <- x .:? "addresses"
return $ maybe [] (map (ZcashAddress s1 [Transparent] Nothing)) x' return $
maybe [] (map (ZcashAddress s1 [TransparentPool] Nothing)) x'
processSapling k s2 = processSapling k s2 =
case k of case k of
Nothing -> return [] Nothing -> return []
@ -306,7 +307,7 @@ instance FromJSON AddressGroup where
where processOneSapling sx = where processOneSapling sx =
withObject "Sapling" $ \oS -> do withObject "Sapling" $ \oS -> do
oS' <- oS .: "addresses" oS' <- oS .: "addresses"
return $ map (ZcashAddress sx [Sapling] Nothing) oS' return $ map (ZcashAddress sx [SaplingPool] Nothing) oS'
processUnified u = processUnified u =
case u of case u of
Nothing -> return [] Nothing -> return []

35
src/Zenith/Utils.hs
View file

@ -3,13 +3,13 @@
module Zenith.Utils where module Zenith.Utils where
import Data.Aeson import Data.Aeson
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)
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 Data.Char (isAlphaNum, isSpace)
import System.Directory import System.Directory
import System.Process (createProcess_, shell) import System.Process (createProcess_, shell)
import Text.Regex.Posix import Text.Regex.Posix
@ -71,9 +71,9 @@ getAddresses ag = agtransparent ag <> agsapling ag <> agunified ag
-- | Helper function to validate potential Zcash addresses -- | Helper function to validate potential Zcash addresses
validateAddress :: T.Text -> Maybe ZcashPool validateAddress :: T.Text -> Maybe ZcashPool
validateAddress txt --(tReg || sReg && isJust chk) || (uReg && isJust chk) validateAddress txt --(tReg || sReg && isJust chk) || (uReg && isJust chk)
| tReg = Just Transparent | tReg = Just TransparentPool
| sReg && chkS = Just Sapling | sReg && chkS = Just SaplingPool
| uReg && chk = Just Orchard | uReg && chk = Just OrchardPool
| otherwise = Nothing | otherwise = Nothing
where where
transparentRegex = "^t1[a-zA-Z0-9]{33}$" :: String transparentRegex = "^t1[a-zA-Z0-9]{33}$" :: String
@ -137,28 +137,27 @@ parseAddress a znet =
Nothing -> Nothing Nothing -> Nothing
isValidContent :: String -> Bool isValidContent :: String -> Bool
isValidContent [] = False -- an empty string is invalid isValidContent [] = False -- an empty string is invalid
isValidContent (x:xs) isValidContent (x:xs)
| not (isAlphaNum x ) = False -- string must start with an alphanumeric character | not (isAlphaNum x) = False -- string must start with an alphanumeric character
| otherwise = allValidChars xs -- process the rest of the string | otherwise = allValidChars xs -- process the rest of the string
where where
allValidChars :: String -> Bool allValidChars :: String -> Bool
allValidChars [] = True -- if we got here, string is valid allValidChars [] = True -- if we got here, string is valid
allValidChars (y:ys) allValidChars (y:ys)
| isAlphaNum y || isSpace y = allValidChars ys -- char is valid, continue | isAlphaNum y || isSpace y = allValidChars ys -- char is valid, continue
| otherwise = False -- found an invalid character, return false | otherwise = False -- found an invalid character, return false
isValidString :: T.Text -> Bool isValidString :: T.Text -> Bool
isValidString c = do isValidString c = do
let a = T.unpack c let a = T.unpack c
isValidContent a isValidContent a
padWithZero :: Int -> String -> String padWithZero :: Int -> String -> String
padWithZero n s padWithZero n s
| (length s) >= n = s | (length s) >= n = s
| otherwise = padWithZero n ("0" ++ s) | otherwise = padWithZero n ("0" ++ s)
isEmpty :: [a] -> Bool isEmpty :: [a] -> Bool
isEmpty [] = True isEmpty [] = True
isEmpty _ = False isEmpty _ = False

7
src/Zenith/Zcashd.hs
View file

@ -123,9 +123,10 @@ sendTx user pwd fromAddy toAddy amount memo = do
if source fromAddy /= ImportedWatchOnly if source fromAddy /= ImportedWatchOnly
then do then do
let privacyPolicy let privacyPolicy
| valAdd == Just Transparent = "AllowRevealedRecipients" | valAdd == Just TransparentPool = "AllowRevealedRecipients"
| isNothing (account fromAddy) && | isNothing (account fromAddy) &&
elem Transparent (pool fromAddy) = "AllowRevealedSenders" elem TransparentPool (pool fromAddy) =
"AllowRevealedSenders"
| otherwise = "AllowRevealedAmounts" | otherwise = "AllowRevealedAmounts"
let pd = let pd =
case memo of case memo of
@ -301,7 +302,7 @@ sendWithUri user pwd fromAddy uri repTo = do
let addType = validateAddress $ T.pack parsedAddress let addType = validateAddress $ T.pack parsedAddress
case addType of case addType of
Nothing -> putStrLn " Invalid address" Nothing -> putStrLn " Invalid address"
Just Transparent -> do Just TransparentPool -> do
putStrLn $ " Address is valid: " ++ parsedAddress putStrLn $ " Address is valid: " ++ parsedAddress
case (readMaybe parsedAmount :: Maybe Double) of case (readMaybe parsedAmount :: Maybe Double) of
Nothing -> putStrLn " Invalid amount." Nothing -> putStrLn " Invalid amount."