Milestone 3: RPC server, ZIP-320 #104
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
|
- 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]
|
||||||
|
|
||||||
|
|
|
@ -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
|
||||||
|
|
|
@ -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
|
||||||
|
|
|
@ -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 []
|
||||||
|
|
|
@ -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
|
||||||
|
|
||||||
|
|
|
@ -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."
|
||||||
|
|
Loading…
Reference in a new issue