feat: refactor ZcashPool type
This commit is contained in:
parent
302cfb0b76
commit
b95213ae5c
GPG key ID:
65122AD495A7F5B2
6 changed files with 72 additions and 67 deletions
|
|
@ -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
|
||||
- Block tracking for chain re-org detection
|
||||
- Refactored `ZcashPool`
|
||||
|
||||
## [0.6.0.0-beta]
|
||||
|
||||
|
|
|
|||
|
|
@ -347,7 +347,7 @@ trToZcashNoteAPI pool n = do
|
|||
return $
|
||||
ZcashNoteAPI
|
||||
(getHex $ walletTransactionTxId $ entityVal t') -- tx ID
|
||||
Zenith.Types.Transparent -- pool
|
||||
Zenith.Types.TransparentPool -- pool
|
||||
(fromIntegral (walletTrNoteValue (entityVal n)) / 100000000.0) -- zec
|
||||
(walletTrNoteValue $ entityVal n) -- zats
|
||||
"" -- memo
|
||||
|
|
@ -368,7 +368,7 @@ sapToZcashNoteAPI pool n = do
|
|||
return $
|
||||
ZcashNoteAPI
|
||||
(getHex $ walletTransactionTxId $ entityVal t') -- tx ID
|
||||
Zenith.Types.Sapling -- pool
|
||||
Zenith.Types.SaplingPool -- pool
|
||||
(fromIntegral (walletSapNoteValue (entityVal n)) / 100000000.0) -- zec
|
||||
(walletSapNoteValue $ entityVal n) -- zats
|
||||
(walletSapNoteMemo $ entityVal n) -- memo
|
||||
|
|
@ -389,7 +389,7 @@ orchToZcashNoteAPI pool n = do
|
|||
return $
|
||||
ZcashNoteAPI
|
||||
(getHex $ walletTransactionTxId $ entityVal t') -- tx ID
|
||||
Orchard
|
||||
OrchardPool
|
||||
(fromIntegral (walletOrchNoteValue (entityVal n)) / 100000000.0) -- zec
|
||||
(walletOrchNoteValue $ entityVal n) -- zats
|
||||
(walletOrchNoteMemo $ entityVal n) -- memo
|
||||
|
|
|
|||
|
|
@ -413,43 +413,43 @@ buildUI wenv model = widgetTree
|
|||
[ vstack
|
||||
[ tooltip "Unified" $
|
||||
box_
|
||||
[onClick (SetPool Orchard)]
|
||||
[onClick (SetPool OrchardPool)]
|
||||
(remixIcon remixShieldCheckFill `styleBasic`
|
||||
[ textSize 14
|
||||
, padding 4
|
||||
, styleIf
|
||||
(model ^. selPool == Orchard)
|
||||
(model ^. selPool == OrchardPool)
|
||||
(bgColor btnColor)
|
||||
, styleIf
|
||||
(model ^. selPool == Orchard)
|
||||
(model ^. selPool == OrchardPool)
|
||||
(textColor white)
|
||||
])
|
||||
, filler
|
||||
, tooltip "Legacy Shielded" $
|
||||
box_
|
||||
[onClick (SetPool Sapling)]
|
||||
[onClick (SetPool SaplingPool)]
|
||||
(remixIcon remixShieldLine `styleBasic`
|
||||
[ textSize 14
|
||||
, padding 4
|
||||
, styleIf
|
||||
(model ^. selPool == Sapling)
|
||||
(model ^. selPool == SaplingPool)
|
||||
(bgColor btnColor)
|
||||
, styleIf
|
||||
(model ^. selPool == Sapling)
|
||||
(model ^. selPool == SaplingPool)
|
||||
(textColor white)
|
||||
])
|
||||
, filler
|
||||
, tooltip "Transparent" $
|
||||
box_
|
||||
[onClick (SetPool Transparent)]
|
||||
[onClick (SetPool TransparentPool)]
|
||||
(remixIcon remixEyeLine `styleBasic`
|
||||
[ textSize 14
|
||||
, padding 4
|
||||
, styleIf
|
||||
(model ^. selPool == Transparent)
|
||||
(model ^. selPool == TransparentPool)
|
||||
(bgColor btnColor)
|
||||
, styleIf
|
||||
(model ^. selPool == Transparent)
|
||||
(model ^. selPool == TransparentPool)
|
||||
(textColor white)
|
||||
])
|
||||
] `styleBasic`
|
||||
|
|
@ -462,10 +462,10 @@ buildUI wenv model = widgetTree
|
|||
(hstack
|
||||
[ label
|
||||
(case model ^. selPool of
|
||||
Orchard -> "Unified"
|
||||
Sapling -> "Legacy Shielded"
|
||||
Transparent -> "Transparent"
|
||||
Sprout -> "Unknown") `styleBasic`
|
||||
OrchardPool -> "Unified"
|
||||
SaplingPool -> "Legacy Shielded"
|
||||
TransparentPool -> "Transparent"
|
||||
SproutPool -> "Unknown") `styleBasic`
|
||||
[textColor white]
|
||||
, remixIcon remixFileCopyFill `styleBasic`
|
||||
[textSize 14, padding 4, textColor white]
|
||||
|
|
@ -944,9 +944,9 @@ generateQRCodes config = do
|
|||
if not (null s)
|
||||
then return ()
|
||||
else do
|
||||
generateOneQr pool Orchard wAddr
|
||||
generateOneQr pool Sapling wAddr
|
||||
generateOneQr pool Transparent wAddr
|
||||
generateOneQr pool OrchardPool wAddr
|
||||
generateOneQr pool SaplingPool wAddr
|
||||
generateOneQr pool TransparentPool wAddr
|
||||
generateOneQr ::
|
||||
ConnectionPool -> ZcashPool -> Entity WalletAddress -> IO ()
|
||||
generateOneQr p zp wAddr =
|
||||
|
|
@ -981,7 +981,7 @@ generateQRCodes config = do
|
|||
dispAddr :: ZcashPool -> WalletAddress -> Maybe T.Text
|
||||
dispAddr zp w =
|
||||
case zp of
|
||||
Transparent ->
|
||||
TransparentPool ->
|
||||
T.append "zcash:" .
|
||||
encodeTransparentReceiver
|
||||
(maybe
|
||||
|
|
@ -993,11 +993,12 @@ generateQRCodes config = do
|
|||
(t_rec =<<
|
||||
(isValidUnifiedAddress . E.encodeUtf8 . getUA . walletAddressUAddress)
|
||||
w)
|
||||
Sapling ->
|
||||
SaplingPool ->
|
||||
T.append "zcash:" <$>
|
||||
(getSaplingFromUA . E.encodeUtf8 . getUA . walletAddressUAddress) w
|
||||
Orchard -> Just $ (T.append "zcash:" . getUA . walletAddressUAddress) w
|
||||
Sprout -> Nothing
|
||||
OrchardPool ->
|
||||
Just $ (T.append "zcash:" . getUA . walletAddressUAddress) w
|
||||
SproutPool -> Nothing
|
||||
|
||||
handleEvent ::
|
||||
WidgetEnv AppModel AppEvent
|
||||
|
|
@ -1111,7 +1112,7 @@ handleEvent wenv node model evt =
|
|||
Just wAddr -> getUserTx dbPool $ entityKey wAddr
|
||||
]
|
||||
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 ->
|
||||
[ Model $ model & selAcc .~ i
|
||||
, Task $
|
||||
|
|
@ -1129,7 +1130,7 @@ handleEvent wenv node model evt =
|
|||
b <- getBalance dbPool $ entityKey acc
|
||||
u <- getUnconfirmedBalance dbPool $ entityKey acc
|
||||
return (b, u)
|
||||
, Event $ SetPool Orchard
|
||||
, Event $ SetPool OrchardPool
|
||||
]
|
||||
SwitchWal i ->
|
||||
[ Model $ model & selWallet .~ i & selAcc .~ 0 & selAddr .~ 0
|
||||
|
|
@ -1152,14 +1153,15 @@ handleEvent wenv node model evt =
|
|||
, setClipboardData $
|
||||
ClipboardText $
|
||||
case model ^. selPool of
|
||||
Orchard -> maybe "None" (getUA . walletAddressUAddress . entityVal) a
|
||||
Sapling ->
|
||||
OrchardPool ->
|
||||
maybe "None" (getUA . walletAddressUAddress . entityVal) a
|
||||
SaplingPool ->
|
||||
fromMaybe "None" $
|
||||
(getSaplingFromUA .
|
||||
E.encodeUtf8 . getUA . walletAddressUAddress . entityVal) =<<
|
||||
a
|
||||
Sprout -> "None"
|
||||
Transparent ->
|
||||
SproutPool -> "None"
|
||||
TransparentPool ->
|
||||
maybe "None" (encodeTransparentReceiver (model ^. network)) $
|
||||
t_rec =<<
|
||||
(isValidUnifiedAddress .
|
||||
|
|
@ -1182,7 +1184,7 @@ handleEvent wenv node model evt =
|
|||
if not (null a)
|
||||
then [ Model $ model & addresses .~ a
|
||||
, Event $ SwitchAddr $ model ^. selAddr
|
||||
, Event $ SetPool Orchard
|
||||
, Event $ SetPool OrchardPool
|
||||
]
|
||||
else [Event $ NewAddress currentAccount]
|
||||
LoadAccs a ->
|
||||
|
|
@ -1584,7 +1586,8 @@ runZenithGUI config = do
|
|||
else return []
|
||||
qr <-
|
||||
if not (null addrList)
|
||||
then getQrCode pool Orchard $ entityKey $ head addrList
|
||||
then getQrCode pool OrchardPool $
|
||||
entityKey $ head addrList
|
||||
else return Nothing
|
||||
bal <-
|
||||
if not (null accList)
|
||||
|
|
@ -1613,7 +1616,7 @@ runZenithGUI config = do
|
|||
(if unconfBal == 0
|
||||
then Nothing
|
||||
else Just unconfBal)
|
||||
Orchard
|
||||
OrchardPool
|
||||
qr
|
||||
False
|
||||
False
|
||||
|
|
|
|||
|
|
@ -104,10 +104,10 @@ data Config = Config
|
|||
} deriving (Eq, Prelude.Show)
|
||||
|
||||
data ZcashPool
|
||||
= Transparent
|
||||
| Sprout
|
||||
| Sapling
|
||||
| Orchard
|
||||
= TransparentPool
|
||||
| SproutPool
|
||||
| SaplingPool
|
||||
| OrchardPool
|
||||
deriving (Show, Read, Eq)
|
||||
|
||||
derivePersistField "ZcashPool"
|
||||
|
|
@ -115,18 +115,18 @@ derivePersistField "ZcashPool"
|
|||
instance ToJSON ZcashPool where
|
||||
toJSON zp =
|
||||
case zp of
|
||||
Transparent -> Data.Aeson.String "p2pkh"
|
||||
Sprout -> Data.Aeson.String "sprout"
|
||||
Sapling -> Data.Aeson.String "sapling"
|
||||
Orchard -> Data.Aeson.String "orchard"
|
||||
TransparentPool -> Data.Aeson.String "p2pkh"
|
||||
SproutPool -> Data.Aeson.String "sprout"
|
||||
SaplingPool -> Data.Aeson.String "sapling"
|
||||
OrchardPool -> Data.Aeson.String "orchard"
|
||||
|
||||
instance FromJSON ZcashPool where
|
||||
parseJSON =
|
||||
withText "ZcashPool" $ \case
|
||||
"p2pkh" -> return Transparent
|
||||
"sprout" -> return Sprout
|
||||
"sapling" -> return Sapling
|
||||
"orchard" -> return Orchard
|
||||
"p2pkh" -> return TransparentPool
|
||||
"sprout" -> return SproutPool
|
||||
"sapling" -> return SaplingPool
|
||||
"orchard" -> return OrchardPool
|
||||
_ -> fail "Not a known Zcash pool"
|
||||
|
||||
newtype ZenithUuid = ZenithUuid
|
||||
|
|
@ -298,7 +298,8 @@ instance FromJSON AddressGroup where
|
|||
Nothing -> return []
|
||||
Just x -> do
|
||||
x' <- x .:? "addresses"
|
||||
return $ maybe [] (map (ZcashAddress s1 [Transparent] Nothing)) x'
|
||||
return $
|
||||
maybe [] (map (ZcashAddress s1 [TransparentPool] Nothing)) x'
|
||||
processSapling k s2 =
|
||||
case k of
|
||||
Nothing -> return []
|
||||
|
|
@ -306,7 +307,7 @@ instance FromJSON AddressGroup where
|
|||
where processOneSapling sx =
|
||||
withObject "Sapling" $ \oS -> do
|
||||
oS' <- oS .: "addresses"
|
||||
return $ map (ZcashAddress sx [Sapling] Nothing) oS'
|
||||
return $ map (ZcashAddress sx [SaplingPool] Nothing) oS'
|
||||
processUnified u =
|
||||
case u of
|
||||
Nothing -> return []
|
||||
|
|
|
|||
|
|
@ -3,13 +3,13 @@
|
|||
module Zenith.Utils where
|
||||
|
||||
import Data.Aeson
|
||||
import Data.Char (isAlphaNum, isSpace)
|
||||
import Data.Functor (void)
|
||||
import Data.Maybe
|
||||
import Data.Ord (clamp)
|
||||
import Data.Scientific (Scientific(..), scientific)
|
||||
import qualified Data.Text as T
|
||||
import qualified Data.Text.Encoding as E
|
||||
import Data.Char (isAlphaNum, isSpace)
|
||||
import System.Directory
|
||||
import System.Process (createProcess_, shell)
|
||||
import Text.Regex.Posix
|
||||
|
|
@ -71,9 +71,9 @@ getAddresses ag = agtransparent ag <> agsapling ag <> agunified ag
|
|||
-- | Helper function to validate potential Zcash addresses
|
||||
validateAddress :: T.Text -> Maybe ZcashPool
|
||||
validateAddress txt --(tReg || sReg && isJust chk) || (uReg && isJust chk)
|
||||
| tReg = Just Transparent
|
||||
| sReg && chkS = Just Sapling
|
||||
| uReg && chk = Just Orchard
|
||||
| tReg = Just TransparentPool
|
||||
| sReg && chkS = Just SaplingPool
|
||||
| uReg && chk = Just OrchardPool
|
||||
| otherwise = Nothing
|
||||
where
|
||||
transparentRegex = "^t1[a-zA-Z0-9]{33}$" :: String
|
||||
|
|
@ -137,28 +137,27 @@ parseAddress a znet =
|
|||
Nothing -> Nothing
|
||||
|
||||
isValidContent :: String -> Bool
|
||||
isValidContent [] = False -- an empty string is invalid
|
||||
isValidContent (x:xs)
|
||||
| not (isAlphaNum x ) = False -- string must start with an alphanumeric character
|
||||
| otherwise = allValidChars xs -- process the rest of the string
|
||||
isValidContent [] = False -- an empty string is invalid
|
||||
isValidContent (x:xs)
|
||||
| not (isAlphaNum x) = False -- string must start with an alphanumeric character
|
||||
| otherwise = allValidChars xs -- process the rest of the string
|
||||
where
|
||||
allValidChars :: String -> Bool
|
||||
allValidChars [] = True -- if we got here, string is valid
|
||||
allValidChars (y:ys)
|
||||
allValidChars :: String -> Bool
|
||||
allValidChars [] = True -- if we got here, string is valid
|
||||
allValidChars (y:ys)
|
||||
| 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 c = do
|
||||
isValidString c = do
|
||||
let a = T.unpack c
|
||||
isValidContent a
|
||||
|
||||
padWithZero :: Int -> String -> String
|
||||
padWithZero n s
|
||||
| (length s) >= n = s
|
||||
| otherwise = padWithZero n ("0" ++ s)
|
||||
padWithZero n s
|
||||
| (length s) >= n = s
|
||||
| otherwise = padWithZero n ("0" ++ s)
|
||||
|
||||
isEmpty :: [a] -> Bool
|
||||
isEmpty [] = True
|
||||
isEmpty _ = False
|
||||
|
||||
isEmpty _ = False
|
||||
|
|
|
|||
|
|
@ -123,9 +123,10 @@ sendTx user pwd fromAddy toAddy amount memo = do
|
|||
if source fromAddy /= ImportedWatchOnly
|
||||
then do
|
||||
let privacyPolicy
|
||||
| valAdd == Just Transparent = "AllowRevealedRecipients"
|
||||
| valAdd == Just TransparentPool = "AllowRevealedRecipients"
|
||||
| isNothing (account fromAddy) &&
|
||||
elem Transparent (pool fromAddy) = "AllowRevealedSenders"
|
||||
elem TransparentPool (pool fromAddy) =
|
||||
"AllowRevealedSenders"
|
||||
| otherwise = "AllowRevealedAmounts"
|
||||
let pd =
|
||||
case memo of
|
||||
|
|
@ -301,7 +302,7 @@ sendWithUri user pwd fromAddy uri repTo = do
|
|||
let addType = validateAddress $ T.pack parsedAddress
|
||||
case addType of
|
||||
Nothing -> putStrLn " Invalid address"
|
||||
Just Transparent -> do
|
||||
Just TransparentPool -> do
|
||||
putStrLn $ " Address is valid: " ++ parsedAddress
|
||||
case (readMaybe parsedAmount :: Maybe Double) of
|
||||
Nothing -> putStrLn " Invalid amount."
|
||||
|
|
|
|||
Loading…
Reference in a new issue