Compare commits
No commits in common. "rvv001" and "master" have entirely different histories.
15 changed files with 47 additions and 1292 deletions
4
.gitignore
vendored
4
.gitignore
vendored
|
|
@ -5,7 +5,3 @@ zenith.db
|
||||||
zenith.log
|
zenith.log
|
||||||
zenith.db-shm
|
zenith.db-shm
|
||||||
zenith.db-wal
|
zenith.db-wal
|
||||||
test.db
|
|
||||||
test.db-shm
|
|
||||||
test.db-wal
|
|
||||||
|
|
||||||
|
|
|
||||||
11
app/Main.hs
11
app/Main.hs
|
|
@ -210,18 +210,9 @@ main = do
|
||||||
zebraPort <- require config "zebraPort"
|
zebraPort <- require config "zebraPort"
|
||||||
zebraHost <- require config "zebraHost"
|
zebraHost <- require config "zebraHost"
|
||||||
nodePort <- require config "nodePort"
|
nodePort <- require config "nodePort"
|
||||||
currencyCode <- require config "currencyCode"
|
|
||||||
dbFP <- getZenithPath
|
dbFP <- getZenithPath
|
||||||
let dbFilePath = T.pack $ dbFP ++ dbFileName
|
let dbFilePath = T.pack $ dbFP ++ dbFileName
|
||||||
let myConfig =
|
let myConfig = Config dbFilePath zebraHost zebraPort nodeUser nodePwd nodePort
|
||||||
Config
|
|
||||||
dbFilePath
|
|
||||||
zebraHost
|
|
||||||
zebraPort
|
|
||||||
nodeUser
|
|
||||||
nodePwd
|
|
||||||
nodePort
|
|
||||||
currencyCode
|
|
||||||
if not (null args)
|
if not (null args)
|
||||||
then do
|
then do
|
||||||
case head args
|
case head args
|
||||||
|
|
|
||||||
|
|
@ -35,18 +35,9 @@ main = do
|
||||||
zebraPort <- require config "zebraPort"
|
zebraPort <- require config "zebraPort"
|
||||||
zebraHost <- require config "zebraHost"
|
zebraHost <- require config "zebraHost"
|
||||||
nodePort <- require config "nodePort"
|
nodePort <- require config "nodePort"
|
||||||
currencyCode <- require config "currencyCode"
|
|
||||||
dbFP <- getZenithPath
|
dbFP <- getZenithPath
|
||||||
let dbFilePath = T.pack $ dbFP ++ dbFileName
|
let dbFilePath = T.pack $ dbFP ++ dbFileName
|
||||||
let myConfig =
|
let myConfig = Config dbFilePath zebraHost zebraPort nodeUser nodePwd nodePort
|
||||||
Config
|
|
||||||
dbFilePath
|
|
||||||
zebraHost
|
|
||||||
zebraPort
|
|
||||||
nodeUser
|
|
||||||
nodePwd
|
|
||||||
nodePort
|
|
||||||
currencyCode
|
|
||||||
let ctx = authenticate myConfig :. EmptyContext
|
let ctx = authenticate myConfig :. EmptyContext
|
||||||
w <- try $ checkZebra zebraHost zebraPort :: IO (Either IOError ZebraGetInfo)
|
w <- try $ checkZebra zebraHost zebraPort :: IO (Either IOError ZebraGetInfo)
|
||||||
case w of
|
case w of
|
||||||
|
|
|
||||||
BIN
sapling-output.params
Normal file
BIN
sapling-output.params
Normal file
Binary file not shown.
BIN
sapling-spend.params
Normal file
BIN
sapling-spend.params
Normal file
Binary file not shown.
|
|
@ -75,7 +75,7 @@ import Control.Monad.Logger
|
||||||
import Data.Aeson
|
import Data.Aeson
|
||||||
import Data.HexString (HexString(..), toText)
|
import Data.HexString (HexString(..), toText)
|
||||||
import Data.Maybe
|
import Data.Maybe
|
||||||
import Data.Scientific (Scientific, scientific, fromFloatDigits, toRealFloat)
|
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.Time.Clock.POSIX (posixSecondsToUTCTime)
|
import Data.Time.Clock.POSIX (posixSecondsToUTCTime)
|
||||||
|
|
@ -89,14 +89,8 @@ import Lens.Micro.Mtl
|
||||||
import Lens.Micro.TH
|
import Lens.Micro.TH
|
||||||
import System.Hclip
|
import System.Hclip
|
||||||
import Text.Printf
|
import Text.Printf
|
||||||
import Text.Wrap
|
import Text.Wrap (FillScope(..), FillStrategy(..), WrapSettings(..))
|
||||||
( FillScope(..)
|
import ZcashHaskell.Keys (generateWalletSeedPhrase)
|
||||||
, FillStrategy(..)
|
|
||||||
, WrapSettings(..)
|
|
||||||
, defaultWrapSettings
|
|
||||||
, wrapTextToLines
|
|
||||||
)
|
|
||||||
import ZcashHaskell.Keys (generateWalletSeedPhrase, deriveUfvk, deriveUivk)
|
|
||||||
import ZcashHaskell.Orchard
|
import ZcashHaskell.Orchard
|
||||||
( getSaplingFromUA
|
( getSaplingFromUA
|
||||||
, isValidUnifiedAddress
|
, isValidUnifiedAddress
|
||||||
|
|
@ -122,24 +116,16 @@ import Zenith.Types
|
||||||
, ValidAddressAPI(..)
|
, ValidAddressAPI(..)
|
||||||
, ZcashNetDB(..)
|
, ZcashNetDB(..)
|
||||||
, ZenithStatus(..)
|
, ZenithStatus(..)
|
||||||
, OrchardSpendingKeyDB(..)
|
|
||||||
, SaplingSpendingKeyDB(..)
|
|
||||||
, TransparentSpendingKeyDB(..)
|
|
||||||
, ZcashPaymentURI(..)
|
|
||||||
, ZcashPool(..)
|
|
||||||
)
|
)
|
||||||
import Zenith.Utils
|
import Zenith.Utils
|
||||||
( displayTaz
|
( displayTaz
|
||||||
, displayZec
|
, displayZec
|
||||||
, getChainTip
|
, getChainTip
|
||||||
, getZcashPrice
|
|
||||||
, isRecipientValid
|
, isRecipientValid
|
||||||
, isRecipientValidGUI
|
, isRecipientValidGUI
|
||||||
, jsonNumber
|
, jsonNumber
|
||||||
, showAddress
|
, showAddress
|
||||||
, validBarValue
|
, validBarValue
|
||||||
, parseZcashPayment
|
|
||||||
, createZip321
|
|
||||||
)
|
)
|
||||||
|
|
||||||
data Name
|
data Name
|
||||||
|
|
@ -164,10 +150,6 @@ data Name
|
||||||
| DeshieldField
|
| DeshieldField
|
||||||
| TotalTranspField
|
| TotalTranspField
|
||||||
| TotalShieldedField
|
| TotalShieldedField
|
||||||
| SFBViewPort
|
|
||||||
| URITransparentAddress
|
|
||||||
| URISaplingAddress
|
|
||||||
| URIUnifiedAddress
|
|
||||||
deriving (Eq, Show, Ord)
|
deriving (Eq, Show, Ord)
|
||||||
|
|
||||||
data DialogInput = DialogInput
|
data DialogInput = DialogInput
|
||||||
|
|
@ -198,21 +180,6 @@ newtype ShDshEntry = ShDshEntry
|
||||||
|
|
||||||
makeLenses ''ShDshEntry
|
makeLenses ''ShDshEntry
|
||||||
|
|
||||||
data PaymentInput = PaymentInput
|
|
||||||
{ _pmtAddressPool :: ZcashPool
|
|
||||||
, _pmtAmt :: !Scientific
|
|
||||||
, _pmtMemo :: !T.Text
|
|
||||||
} deriving (Show)
|
|
||||||
|
|
||||||
makeLenses ''PaymentInput
|
|
||||||
|
|
||||||
data URIText = URIText
|
|
||||||
{
|
|
||||||
_uriString :: !T.Text
|
|
||||||
} deriving (Show)
|
|
||||||
|
|
||||||
makeLenses ''URIText
|
|
||||||
|
|
||||||
data DialogType
|
data DialogType
|
||||||
= WName
|
= WName
|
||||||
| AName
|
| AName
|
||||||
|
|
@ -227,13 +194,6 @@ data DialogType
|
||||||
| AdrBookDelForm
|
| AdrBookDelForm
|
||||||
| DeshieldForm
|
| DeshieldForm
|
||||||
| ShieldForm
|
| ShieldForm
|
||||||
| ShowFIATBalance
|
|
||||||
| ViewingKeyMenu
|
|
||||||
| ViewingKeyShow
|
|
||||||
| PaymentURICreate
|
|
||||||
| PaymentURIShow
|
|
||||||
| PayUsingURIShow
|
|
||||||
| ProcessURIMenu
|
|
||||||
|
|
||||||
data DisplayType
|
data DisplayType
|
||||||
= AddrDisplay
|
= AddrDisplay
|
||||||
|
|
@ -251,7 +211,7 @@ data Tick
|
||||||
| TickMsg !String
|
| TickMsg !String
|
||||||
| TickTx !HexString
|
| TickTx !HexString
|
||||||
|
|
||||||
newtype DropDownItem =
|
data DropDownItem =
|
||||||
DropdownItem String
|
DropdownItem String
|
||||||
|
|
||||||
data State = State
|
data State = State
|
||||||
|
|
@ -285,37 +245,10 @@ data State = State
|
||||||
, _deshieldForm :: !(Form ShDshEntry () Name)
|
, _deshieldForm :: !(Form ShDshEntry () Name)
|
||||||
, _tBalance :: !Integer
|
, _tBalance :: !Integer
|
||||||
, _sBalance :: !Integer
|
, _sBalance :: !Integer
|
||||||
, _currencyCode :: !T.Text
|
|
||||||
, _zprice :: !Double
|
|
||||||
, _vkName :: !T.Text
|
|
||||||
, _vkData :: !T.Text
|
|
||||||
, _pmtURIForm :: !(Form PaymentInput () Name)
|
|
||||||
, _payUsingURIForm :: !(Form URIText () Name)
|
|
||||||
}
|
}
|
||||||
|
|
||||||
makeLenses ''State
|
makeLenses ''State
|
||||||
|
|
||||||
scientificToDouble :: Scientific -> Double
|
|
||||||
scientificToDouble = toRealFloat
|
|
||||||
|
|
||||||
zBalance :: State -> Double
|
|
||||||
zBalance st = (fromIntegral (st ^. balance)) / 100000000
|
|
||||||
|
|
||||||
-- Function to split text into fixed-size chunks
|
|
||||||
splitText :: Int -> T.Text -> [T.Text]
|
|
||||||
splitText chunkSize text =
|
|
||||||
let strippedText = T.filter (/= '\n') text -- Remove newlines
|
|
||||||
in if T.null strippedText
|
|
||||||
then []
|
|
||||||
else T.take chunkSize strippedText :
|
|
||||||
splitText chunkSize (T.drop chunkSize strippedText)
|
|
||||||
|
|
||||||
-- Create a widget to display the long text
|
|
||||||
renderLongText :: Int -> T.Text -> Widget Name
|
|
||||||
renderLongText lineLength longText =
|
|
||||||
let linesOfText = splitText lineLength longText
|
|
||||||
in vBox $ map txt linesOfText
|
|
||||||
|
|
||||||
drawUI :: State -> [Widget Name]
|
drawUI :: State -> [Widget Name]
|
||||||
drawUI s = [splashDialog s, helpDialog s, displayDialog s, inputDialog s, ui s]
|
drawUI s = [splashDialog s, helpDialog s, displayDialog s, inputDialog s, ui s]
|
||||||
where
|
where
|
||||||
|
|
@ -365,16 +298,13 @@ drawUI s = [splashDialog s, helpDialog s, displayDialog s, inputDialog s, ui s]
|
||||||
[ capCommand "W" "allets"
|
[ capCommand "W" "allets"
|
||||||
, capCommand "A" "ccounts"
|
, capCommand "A" "ccounts"
|
||||||
, capCommand "V" "iew address"
|
, capCommand "V" "iew address"
|
||||||
, capCommand "S" "end Tx"
|
, capCommand3 "" "S" "end Tx"
|
||||||
, capCommand "U" "RI Support"
|
|
||||||
, capCommand3 "ba" "L" ("ance (" ++ (T.unpack (st ^. currencyCode)) ++ ")")
|
|
||||||
])
|
])
|
||||||
, C.hCenter
|
, C.hCenter
|
||||||
(hBox
|
(hBox
|
||||||
[ capCommand2 "Address " "B" "ook"
|
[ capCommand2 "Address " "B" "ook"
|
||||||
, capCommand2 "s" "H" "ield"
|
, capCommand2 "s" "H" "ield"
|
||||||
, capCommand "D" "e-shield"
|
, capCommand "D" "e-shield"
|
||||||
, capCommand2 "Viewing " "K" "eys"
|
|
||||||
, capCommand "Q" "uit"
|
, capCommand "Q" "uit"
|
||||||
, capCommand "?" " Help"
|
, capCommand "?" " Help"
|
||||||
, str $ show (st ^. timer)
|
, str $ show (st ^. timer)
|
||||||
|
|
@ -445,9 +375,7 @@ drawUI s = [splashDialog s, helpDialog s, displayDialog s, inputDialog s, ui s]
|
||||||
else emptyWidget
|
else emptyWidget
|
||||||
where
|
where
|
||||||
keyList =
|
keyList =
|
||||||
map
|
map (C.hCenter . str) ["?", "Esc", "w", "a", "v", "s", "b", "d", "q"]
|
||||||
(C.hCenter . str)
|
|
||||||
["?", "Esc", "w", "a", "v", "s", "u", "b", "d", "k", "l", "q"]
|
|
||||||
actionList =
|
actionList =
|
||||||
map
|
map
|
||||||
(hLimit 40 . str)
|
(hLimit 40 . str)
|
||||||
|
|
@ -457,11 +385,8 @@ drawUI s = [splashDialog s, helpDialog s, displayDialog s, inputDialog s, ui s]
|
||||||
, "Switch accounts"
|
, "Switch accounts"
|
||||||
, "View address"
|
, "View address"
|
||||||
, "Send Tx"
|
, "Send Tx"
|
||||||
, "URI Menu"
|
|
||||||
, "Address Book"
|
, "Address Book"
|
||||||
, "Shield/De-Shield"
|
, "Shield/De-Shield"
|
||||||
, "Viewing Keys"
|
|
||||||
, "Balance in Fiat"
|
|
||||||
, "Quit"
|
, "Quit"
|
||||||
]
|
]
|
||||||
inputDialog :: State -> Widget Name
|
inputDialog :: State -> Widget Name
|
||||||
|
|
@ -507,40 +432,7 @@ drawUI s = [splashDialog s, helpDialog s, displayDialog s, inputDialog s, ui s]
|
||||||
(D.dialog (Just (str " Send Transaction ")) Nothing 50)
|
(D.dialog (Just (str " Send Transaction ")) Nothing 50)
|
||||||
(renderForm (st ^. txForm) <=>
|
(renderForm (st ^. txForm) <=>
|
||||||
C.hCenter
|
C.hCenter
|
||||||
(hBox [capCommand "↲ " "Send", capCommand3 " " "<esc> " "Cancel"]))
|
(hBox [capCommand "↲ " "Send", capCommand "<esc> " "Cancel"]))
|
||||||
--
|
|
||||||
-- URI Support
|
|
||||||
--
|
|
||||||
-- | Create a New payment URI
|
|
||||||
PaymentURICreate ->
|
|
||||||
D.renderDialog
|
|
||||||
(D.dialog (Just (str " Create Payment URI ")) Nothing 50)
|
|
||||||
(renderForm (st ^. pmtURIForm) <=>
|
|
||||||
C.hCenter
|
|
||||||
(hBox
|
|
||||||
[capCommand "↲ " "Process", capCommand3 " " "<esc> " "Cancel"]))
|
|
||||||
--
|
|
||||||
-- | Show Paument URI
|
|
||||||
PaymentURIShow ->
|
|
||||||
D.renderDialog
|
|
||||||
(D.dialog
|
|
||||||
(Just (str (" Payment URI ")))
|
|
||||||
Nothing
|
|
||||||
50)
|
|
||||||
(padAll 1 (C.hCenter (renderLongText 45 (st ^. vkData))) <=>
|
|
||||||
C.hCenter
|
|
||||||
(hBox
|
|
||||||
[capCommand "C" "opy to Clipoard", capCommand3 "" "E" "xit"]))
|
|
||||||
--
|
|
||||||
-- | Pay using a URI
|
|
||||||
PayUsingURIShow ->
|
|
||||||
D.renderDialog
|
|
||||||
(D.dialog (Just (str " Pay Using URI ")) Nothing 50)
|
|
||||||
(renderForm (st ^. payUsingURIForm) <=>
|
|
||||||
C.hCenter
|
|
||||||
(hBox
|
|
||||||
[capCommand "↲ " "Process", capCommand3 " " "<esc> " "Cancel"]))
|
|
||||||
--
|
|
||||||
DeshieldForm ->
|
DeshieldForm ->
|
||||||
D.renderDialog
|
D.renderDialog
|
||||||
(D.dialog (Just (str " De-Shield ZEC ")) Nothing 50)
|
(D.dialog (Just (str " De-Shield ZEC ")) Nothing 50)
|
||||||
|
|
@ -560,7 +452,7 @@ drawUI s = [splashDialog s, helpDialog s, displayDialog s, inputDialog s, ui s]
|
||||||
]) <=>
|
]) <=>
|
||||||
renderForm (st ^. deshieldForm) <=>
|
renderForm (st ^. deshieldForm) <=>
|
||||||
C.hCenter
|
C.hCenter
|
||||||
(hBox [capCommand "P" "roceed", capCommand3 "" "<esc> " "Cancel"]))
|
(hBox [capCommand "P" "roceed", capCommand "<esc> " "Cancel"]))
|
||||||
ShieldForm ->
|
ShieldForm ->
|
||||||
D.renderDialog
|
D.renderDialog
|
||||||
(D.dialog (Just (str " Shield ZEC ")) Nothing 50)
|
(D.dialog (Just (str " Shield ZEC ")) Nothing 50)
|
||||||
|
|
@ -571,35 +463,7 @@ drawUI s = [splashDialog s, helpDialog s, displayDialog s, inputDialog s, ui s]
|
||||||
then displayZec (st ^. tBalance)
|
then displayZec (st ^. tBalance)
|
||||||
else displayTaz (st ^. tBalance) ++ "?") <=>
|
else displayTaz (st ^. tBalance) ++ "?") <=>
|
||||||
C.hCenter
|
C.hCenter
|
||||||
(hBox [capCommand "P" "roceed", capCommand3 "" "<esc> " "Cancel"]))
|
(hBox [capCommand "P" "roceed", capCommand "<esc> " "Cancel"]))
|
||||||
ViewingKeyShow ->
|
|
||||||
D.renderDialog
|
|
||||||
(D.dialog
|
|
||||||
(Just (str (" " ++ (T.unpack (st ^. vkName)) ++ " Viewing Key ")))
|
|
||||||
Nothing
|
|
||||||
50)
|
|
||||||
(padAll 1 (C.hCenter (renderLongText 45 (st ^. vkData))) <=>
|
|
||||||
C.hCenter
|
|
||||||
(hBox
|
|
||||||
[capCommand "C" "opy to Clipoard", capCommand3 "" "E" "xit"]))
|
|
||||||
ViewingKeyMenu ->
|
|
||||||
D.renderDialog
|
|
||||||
(D.dialog (Just (str " Viewing Keys ")) Nothing 50)
|
|
||||||
(C.hCenter
|
|
||||||
(hBox
|
|
||||||
[ capCommand "F" "ull"
|
|
||||||
, capCommand "I" "ncoming"
|
|
||||||
, capCommand3 "" "E" "xit"
|
|
||||||
]))
|
|
||||||
ProcessURIMenu ->
|
|
||||||
D.renderDialog
|
|
||||||
(D.dialog (Just (str " URI Support ")) Nothing 50)
|
|
||||||
(C.hCenter
|
|
||||||
(hBox
|
|
||||||
[ capCommand "C" "reate Payment URI"
|
|
||||||
, capCommand "P" "ay using an URI"
|
|
||||||
, capCommand3 "" "E" "xit"
|
|
||||||
]))
|
|
||||||
Blank -> emptyWidget
|
Blank -> emptyWidget
|
||||||
-- Address Book List
|
-- Address Book List
|
||||||
AdrBook ->
|
AdrBook ->
|
||||||
|
|
@ -652,50 +516,6 @@ drawUI s = [splashDialog s, helpDialog s, displayDialog s, inputDialog s, ui s]
|
||||||
[ capCommand "C" "onfirm delete"
|
[ capCommand "C" "onfirm delete"
|
||||||
, capCommand3 "" "<Esc>" " Cancel"
|
, capCommand3 "" "<Esc>" " Cancel"
|
||||||
]))
|
]))
|
||||||
-- Show Balance in FIAT form
|
|
||||||
ShowFIATBalance ->
|
|
||||||
D.renderDialog
|
|
||||||
(D.dialog
|
|
||||||
(Just $
|
|
||||||
str
|
|
||||||
(" Account Balance (" ++
|
|
||||||
(T.unpack (st ^. currencyCode)) ++ ") "))
|
|
||||||
Nothing
|
|
||||||
60)
|
|
||||||
(withAttr abDefAttr $
|
|
||||||
setAvailableSize (50, 8) $
|
|
||||||
viewport SFBViewPort BT.Vertical $
|
|
||||||
vLimit 8 $
|
|
||||||
hLimit 50 $
|
|
||||||
vBox $
|
|
||||||
[ vLimit 4 $
|
|
||||||
hLimit 50 $
|
|
||||||
vBox $
|
|
||||||
[ C.hCenter (str $ " ")
|
|
||||||
, C.hCenter
|
|
||||||
(str $
|
|
||||||
"1 ZEC = " ++
|
|
||||||
(printf "%.2f" (s ^. zprice)) ++
|
|
||||||
" " ++ (T.unpack (s ^. currencyCode)))
|
|
||||||
, C.hCenter (str $ " ")
|
|
||||||
, C.hCenter
|
|
||||||
(str $
|
|
||||||
" Balance: " ++
|
|
||||||
(printf "%.8f" $ zBalance s) ++
|
|
||||||
" ZEC ==> " ++
|
|
||||||
(printf "%.2f" ((s ^. zprice) * (zBalance s)) ++
|
|
||||||
" " ++ (T.unpack (s ^. currencyCode))))
|
|
||||||
]
|
|
||||||
, padTop Max $
|
|
||||||
vLimit 4 $
|
|
||||||
hLimit 50 $
|
|
||||||
withAttr abMBarAttr $
|
|
||||||
vBox $
|
|
||||||
[ C.hCenter (str " ")
|
|
||||||
, C.hCenter $
|
|
||||||
(capCommand "R" "efresh" <+> capCommand3 "E" "x" "it")
|
|
||||||
]
|
|
||||||
])
|
|
||||||
--
|
--
|
||||||
splashDialog :: State -> Widget Name
|
splashDialog :: State -> Widget Name
|
||||||
splashDialog st =
|
splashDialog st =
|
||||||
|
|
@ -729,23 +549,23 @@ drawUI s = [splashDialog s, helpDialog s, displayDialog s, inputDialog s, ui s]
|
||||||
withBorderStyle unicodeBold $
|
withBorderStyle unicodeBold $
|
||||||
D.renderDialog
|
D.renderDialog
|
||||||
(D.dialog
|
(D.dialog
|
||||||
(Just $ txt (" Address: " <> walletAddressName (entityVal a) <> " "))
|
(Just $ txt ("Address: " <> walletAddressName (entityVal a)))
|
||||||
Nothing
|
Nothing
|
||||||
60)
|
60)
|
||||||
(padAll 1 $
|
(padAll 1 $
|
||||||
B.borderWithLabel
|
B.borderWithLabel
|
||||||
(str " Unified ")
|
(str "Unified")
|
||||||
(txtWrapWith (WrapSettings False True NoFill FillAfterFirst) $
|
(txtWrapWith (WrapSettings False True NoFill FillAfterFirst) $
|
||||||
getUA $ walletAddressUAddress $ entityVal a) <=>
|
getUA $ walletAddressUAddress $ entityVal a) <=>
|
||||||
B.borderWithLabel
|
B.borderWithLabel
|
||||||
(str " Legacy Shielded ")
|
(str "Legacy Shielded")
|
||||||
(txtWrapWith (WrapSettings False True NoFill FillAfterFirst) $
|
(txtWrapWith (WrapSettings False True NoFill FillAfterFirst) $
|
||||||
fromMaybe "None" $
|
fromMaybe "None" $
|
||||||
(getSaplingFromUA .
|
(getSaplingFromUA .
|
||||||
E.encodeUtf8 . getUA . walletAddressUAddress)
|
E.encodeUtf8 . getUA . walletAddressUAddress)
|
||||||
(entityVal a)) <=>
|
(entityVal a)) <=>
|
||||||
B.borderWithLabel
|
B.borderWithLabel
|
||||||
(str " Transparent ")
|
(str "Transparent")
|
||||||
(txtWrapWith (WrapSettings False True NoFill FillAfterFirst) $
|
(txtWrapWith (WrapSettings False True NoFill FillAfterFirst) $
|
||||||
maybe "None" (encodeTransparentReceiver (st ^. network)) $
|
maybe "None" (encodeTransparentReceiver (st ^. network)) $
|
||||||
t_rec =<<
|
t_rec =<<
|
||||||
|
|
@ -757,7 +577,7 @@ drawUI s = [splashDialog s, helpDialog s, displayDialog s, inputDialog s, ui s]
|
||||||
[ str "Copy: "
|
[ str "Copy: "
|
||||||
, capCommand "U" "nified"
|
, capCommand "U" "nified"
|
||||||
, capCommand "S" "apling"
|
, capCommand "S" "apling"
|
||||||
, capCommand3 " " "T" "ransparent"
|
, capCommand "T" "ransparent"
|
||||||
]) <=>
|
]) <=>
|
||||||
C.hCenter xCommand)
|
C.hCenter xCommand)
|
||||||
Nothing -> emptyWidget
|
Nothing -> emptyWidget
|
||||||
|
|
@ -887,35 +707,6 @@ mkSendForm bal =
|
||||||
label s w =
|
label s w =
|
||||||
padBottom (Pad 1) $ vLimit 1 (hLimit 15 $ str s <+> fill ' ') <+> w
|
padBottom (Pad 1) $ vLimit 1 (hLimit 15 $ str s <+> fill ' ') <+> w
|
||||||
|
|
||||||
mkPaymentURIForm :: PaymentInput -> Form PaymentInput e Name
|
|
||||||
mkPaymentURIForm =
|
|
||||||
newForm
|
|
||||||
[ label "Pmt. Address:" @@=
|
|
||||||
radioField
|
|
||||||
pmtAddressPool
|
|
||||||
[ (OrchardPool, URIUnifiedAddress, "Unified")
|
|
||||||
, (SaplingPool, URISaplingAddress, "Sapling")
|
|
||||||
, (TransparentPool, URITransparentAddress, "Transparent")
|
|
||||||
]
|
|
||||||
, label "Amount (Zec): " @@=
|
|
||||||
editShowableFieldWithValidate pmtAmt AmtField (isAmountValid )
|
|
||||||
, label "Memo: " @@= editTextField pmtMemo MemoField (Just 1)
|
|
||||||
]
|
|
||||||
where
|
|
||||||
isAmountValid :: Scientific -> Bool
|
|
||||||
isAmountValid i = i > 0.0
|
|
||||||
label s w =
|
|
||||||
padBottom (Pad 1) $ vLimit 1 (hLimit 20 $ str s <+> fill ' ') <+> w
|
|
||||||
|
|
||||||
mkPayUsingURIForm :: URIText -> Form URIText e Name
|
|
||||||
mkPayUsingURIForm =
|
|
||||||
newForm
|
|
||||||
[ label " URI: " @@= editTextField uriString MemoField (Just 1)
|
|
||||||
]
|
|
||||||
where
|
|
||||||
label s w =
|
|
||||||
padBottom (Pad 1) $ vLimit 1 (hLimit 15 $ str s <+> fill ' ') <+> w
|
|
||||||
|
|
||||||
mkDeshieldForm :: Integer -> ShDshEntry -> Form ShDshEntry e Name
|
mkDeshieldForm :: Integer -> ShDshEntry -> Form ShDshEntry e Name
|
||||||
mkDeshieldForm tbal =
|
mkDeshieldForm tbal =
|
||||||
newForm
|
newForm
|
||||||
|
|
@ -925,21 +716,9 @@ mkDeshieldForm tbal =
|
||||||
where
|
where
|
||||||
isAmountValid :: Integer -> Scientific -> Bool
|
isAmountValid :: Integer -> Scientific -> Bool
|
||||||
isAmountValid b i = fromIntegral b >= (i * scientific 1 8)
|
isAmountValid b i = fromIntegral b >= (i * scientific 1 8)
|
||||||
label s w =
|
|
||||||
padBottom (Pad 1) $ vLimit 1 (hLimit 25 $ str s <+> fill ' ') <+> w
|
|
||||||
{--
|
|
||||||
mkShieldForm :: Integer -> ShDshEntry -> Form ShDshEntry e Name
|
|
||||||
mkShieldForm bal =
|
|
||||||
newForm
|
|
||||||
[ label "Amount to Shield: " @@=
|
|
||||||
editShowableFieldWithValidate shAmt AmtField (isAmountValid bal)
|
|
||||||
]
|
|
||||||
where
|
|
||||||
isAmountValid :: Integer -> Scientific -> Bool
|
|
||||||
isAmountValid b i = (fromIntegral b / 100000000.0) >= i
|
|
||||||
label s w =
|
label s w =
|
||||||
padBottom (Pad 1) $ vLimit 1 (hLimit 15 $ str s <+> fill ' ') <+> w
|
padBottom (Pad 1) $ vLimit 1 (hLimit 15 $ str s <+> fill ' ') <+> w
|
||||||
--}
|
|
||||||
mkNewABForm :: AdrBookEntry -> Form AdrBookEntry e Name
|
mkNewABForm :: AdrBookEntry -> Form AdrBookEntry e Name
|
||||||
mkNewABForm =
|
mkNewABForm =
|
||||||
newForm
|
newForm
|
||||||
|
|
@ -1156,8 +935,7 @@ appEvent (BT.AppEvent t) = do
|
||||||
(s ^. zebraPort)
|
(s ^. zebraPort)
|
||||||
"user"
|
"user"
|
||||||
"pwd"
|
"pwd"
|
||||||
8080
|
8080)
|
||||||
(s ^. currencyCode))
|
|
||||||
selWallet
|
selWallet
|
||||||
updatedState <- BT.get
|
updatedState <- BT.get
|
||||||
ns <- liftIO $ refreshWallet updatedState
|
ns <- liftIO $ refreshWallet updatedState
|
||||||
|
|
@ -1204,13 +982,6 @@ appEvent (BT.AppEvent t) = do
|
||||||
AdrBookDelForm -> return ()
|
AdrBookDelForm -> return ()
|
||||||
DeshieldForm -> return ()
|
DeshieldForm -> return ()
|
||||||
ShieldForm -> return ()
|
ShieldForm -> return ()
|
||||||
ViewingKeyShow -> return ()
|
|
||||||
ViewingKeyMenu -> return ()
|
|
||||||
ProcessURIMenu -> return ()
|
|
||||||
ShowFIATBalance -> return ()
|
|
||||||
PaymentURICreate -> return ()
|
|
||||||
PaymentURIShow -> return ()
|
|
||||||
PayUsingURIShow -> return ()
|
|
||||||
Blank -> do
|
Blank -> do
|
||||||
if s ^. timer == 90
|
if s ^. timer == 90
|
||||||
then do
|
then do
|
||||||
|
|
@ -1788,198 +1559,7 @@ appEvent (BT.VtyEvent e) = do
|
||||||
ev ->
|
ev ->
|
||||||
BT.zoom deshieldForm $ do
|
BT.zoom deshieldForm $ do
|
||||||
handleFormEvent (BT.VtyEvent ev)
|
handleFormEvent (BT.VtyEvent ev)
|
||||||
--
|
|
||||||
-- Process ShowFIATBalance events
|
|
||||||
--
|
|
||||||
ShowFIATBalance -> do
|
|
||||||
case e of
|
|
||||||
V.EvKey (V.KChar 'x') [] ->
|
|
||||||
BT.modify $ set dialogBox Blank
|
|
||||||
V.EvKey (V.KChar 'r') [] -> do
|
|
||||||
BT.modify $ set dialogBox Blank
|
|
||||||
zpr <- liftIO $ getZcashPrice $ s ^. currencyCode
|
|
||||||
case zpr of
|
|
||||||
Just p -> do
|
|
||||||
BT.modify $ set zprice p
|
|
||||||
BT.modify $ set dialogBox ShowFIATBalance
|
|
||||||
Nothing -> do
|
|
||||||
BT.modify $
|
|
||||||
set msg ("CoinGecko is not responding!!!")
|
|
||||||
BT.modify $ set displayBox MsgDisplay
|
|
||||||
-- Process any other event
|
-- Process any other event
|
||||||
ev -> BT.zoom abAddresses $ L.handleListEvent ev
|
|
||||||
--
|
|
||||||
-- Viewing Key Display Support
|
|
||||||
--
|
|
||||||
ViewingKeyShow -> do
|
|
||||||
case e of
|
|
||||||
V.EvKey (V.KChar 'c') [] -> do
|
|
||||||
liftIO $ setClipboard $ T.unpack $ s ^. vkData
|
|
||||||
BT.modify $
|
|
||||||
set msg $
|
|
||||||
(T.unpack (s ^. vkName)) ++
|
|
||||||
" viewing key copied to Clipboard!!"
|
|
||||||
BT.modify $ set displayBox MsgDisplay
|
|
||||||
V.EvKey (V.KChar 'e') [] -> do
|
|
||||||
BT.modify $ set vkName ""
|
|
||||||
BT.modify $ set vkData ""
|
|
||||||
BT.modify $ set dialogBox ViewingKeyMenu
|
|
||||||
ev -> return ()
|
|
||||||
--
|
|
||||||
-- Open viewing key display form
|
|
||||||
--
|
|
||||||
ViewingKeyMenu -> do
|
|
||||||
case e of
|
|
||||||
--
|
|
||||||
-- Full viewing key display
|
|
||||||
--
|
|
||||||
V.EvKey (V.KChar 'f') [] -> do
|
|
||||||
selAccount <-
|
|
||||||
do case L.listSelectedElement $ s ^. accounts of
|
|
||||||
Nothing -> do
|
|
||||||
let fAcc =
|
|
||||||
L.listSelectedElement $ L.listMoveToBeginning $ s ^. accounts
|
|
||||||
case fAcc of
|
|
||||||
Nothing -> throw $ userError "Failed to select account"
|
|
||||||
Just (_j, w1) -> return w1
|
|
||||||
Just (_k, w) -> return w
|
|
||||||
let osk = getOrchSK $ zcashAccountOrchSpendKey $ entityVal selAccount
|
|
||||||
let ssk = getSapSK $ zcashAccountSapSpendKey $ entityVal selAccount
|
|
||||||
let tsk = getTranSK $ zcashAccountTPrivateKey $ entityVal selAccount
|
|
||||||
fvk <- liftIO $ deriveUfvk (s ^. network) osk ssk tsk
|
|
||||||
BT.modify $ set vkName "Full"
|
|
||||||
BT.modify $ set vkData fvk
|
|
||||||
BT.modify $ set dialogBox ViewingKeyShow
|
|
||||||
--
|
|
||||||
-- Incoming viewing key display
|
|
||||||
--
|
|
||||||
V.EvKey (V.KChar 'i') [] -> do
|
|
||||||
selAccount <-
|
|
||||||
do case L.listSelectedElement $ s ^. accounts of
|
|
||||||
Nothing -> do
|
|
||||||
let fAcc =
|
|
||||||
L.listSelectedElement $ L.listMoveToBeginning $ s ^. accounts
|
|
||||||
case fAcc of
|
|
||||||
Nothing -> throw $ userError "Failed to select account"
|
|
||||||
Just (_j, w1) -> return w1
|
|
||||||
Just (_k, w) -> return w
|
|
||||||
let osk = getOrchSK $ zcashAccountOrchSpendKey $ entityVal selAccount
|
|
||||||
let ssk = getSapSK $ zcashAccountSapSpendKey $ entityVal selAccount
|
|
||||||
let tsk = getTranSK $ zcashAccountTPrivateKey $ entityVal selAccount
|
|
||||||
ivk <- liftIO $ deriveUivk (s ^. network) osk ssk tsk
|
|
||||||
BT.modify $ set vkName "Incomming"
|
|
||||||
BT.modify $ set vkData ivk
|
|
||||||
BT.modify $ set dialogBox ViewingKeyShow
|
|
||||||
V.EvKey (V.KChar 'e') [] ->
|
|
||||||
BT.modify $ set dialogBox Blank
|
|
||||||
ev -> return ()
|
|
||||||
--
|
|
||||||
-- Create Payment URI Form Events
|
|
||||||
--
|
|
||||||
PaymentURICreate -> do
|
|
||||||
case e of
|
|
||||||
V.EvKey V.KEnter [] -> do
|
|
||||||
fs <- BT.zoom pmtURIForm $ BT.gets formState
|
|
||||||
case L.listSelectedElement $ s ^. addresses of
|
|
||||||
Just (_, a) -> do
|
|
||||||
let za = case (fs ^. pmtAddressPool) of
|
|
||||||
OrchardPool -> getUA $ walletAddressUAddress $ entityVal a
|
|
||||||
SaplingPool ->
|
|
||||||
case (getSaplingFromUA $ E.encodeUtf8 $ getUA $ walletAddressUAddress $ entityVal a) of
|
|
||||||
Just sa -> sa
|
|
||||||
_ -> ""
|
|
||||||
TransparentPool -> do
|
|
||||||
let trec = t_rec =<< (isValidUnifiedAddress . E.encodeUtf8 . getUA . walletAddressUAddress) (entityVal a)
|
|
||||||
case trec of
|
|
||||||
Just tr -> encodeTransparentReceiver (s ^. network) tr
|
|
||||||
_ -> ""
|
|
||||||
--
|
|
||||||
_ -> ""
|
|
||||||
let amt = scientificToDouble (fs ^. pmtAmt)
|
|
||||||
if amt > 0.0
|
|
||||||
then do
|
|
||||||
let mm = ( fs ^. pmtMemo )
|
|
||||||
BT.modify $ set vkData (T.pack (createZip321 (T.unpack za) (Just amt) (Just (T.unpack mm)) ))
|
|
||||||
BT.modify $ set dialogBox PaymentURIShow
|
|
||||||
else do
|
|
||||||
BT.modify $ set msg " Must provide an amount!! "
|
|
||||||
BT.modify $ set displayBox MsgDisplay
|
|
||||||
Nothing -> do
|
|
||||||
BT.modify $ set msg " No Zcash address available!! "
|
|
||||||
BT.modify $ set displayBox MsgDisplay
|
|
||||||
V.EvKey V.KEsc [] -> BT.modify $ set dialogBox Blank
|
|
||||||
ev -> do
|
|
||||||
BT.zoom pmtURIForm $ do
|
|
||||||
handleFormEvent (BT.VtyEvent ev)
|
|
||||||
--
|
|
||||||
-- Show Payment URI Form Events
|
|
||||||
--
|
|
||||||
PaymentURIShow -> do
|
|
||||||
case e of
|
|
||||||
V.EvKey (V.KChar 'c') [] -> do
|
|
||||||
liftIO $ setClipboard $ T.unpack $ s ^. vkData
|
|
||||||
BT.modify $ set msg " URI copied to Clipboard!!"
|
|
||||||
BT.modify $ set displayBox MsgDisplay
|
|
||||||
V.EvKey (V.KChar 'e') [] -> BT.modify $ set dialogBox Blank
|
|
||||||
ev -> do
|
|
||||||
BT.zoom pmtURIForm $ do
|
|
||||||
handleFormEvent (BT.VtyEvent ev)
|
|
||||||
--
|
|
||||||
-- Pay using URI Form Events
|
|
||||||
--
|
|
||||||
PayUsingURIShow -> do
|
|
||||||
case e of
|
|
||||||
V.EvKey V.KEnter [] -> do
|
|
||||||
fs <- BT.zoom payUsingURIForm $ BT.gets formState
|
|
||||||
let zp = parseZcashPayment $ T.unpack (fs ^. uriString)
|
|
||||||
case zp of
|
|
||||||
Right p -> do
|
|
||||||
case uriAmount p of
|
|
||||||
Just a -> do
|
|
||||||
BT.modify $
|
|
||||||
set txForm $
|
|
||||||
mkSendForm
|
|
||||||
(s ^. balance)
|
|
||||||
(SendInput
|
|
||||||
(T.pack (uriAddress p))
|
|
||||||
(fromFloatDigits a)
|
|
||||||
(uriMemo p)
|
|
||||||
Full)
|
|
||||||
BT.modify $ set dialogBox SendTx
|
|
||||||
Nothing -> do
|
|
||||||
BT.modify $
|
|
||||||
set
|
|
||||||
msg "URI error - Invalid value "
|
|
||||||
BT.modify $ set displayBox MsgDisplay
|
|
||||||
Left e -> do
|
|
||||||
BT.modify $
|
|
||||||
set msg e
|
|
||||||
BT.modify $ set displayBox MsgDisplay
|
|
||||||
V.EvKey V.KEsc [] -> BT.modify $ set dialogBox Blank
|
|
||||||
ev -> do
|
|
||||||
BT.zoom payUsingURIForm $ do
|
|
||||||
handleFormEvent (BT.VtyEvent ev)
|
|
||||||
--
|
|
||||||
-- Open URI process form
|
|
||||||
--
|
|
||||||
ProcessURIMenu -> do
|
|
||||||
case e of
|
|
||||||
V.EvKey (V.KChar 'c') [] -> do
|
|
||||||
BT.modify $
|
|
||||||
set pmtURIForm $
|
|
||||||
mkPaymentURIForm (PaymentInput OrchardPool 0.0 "")
|
|
||||||
BT.modify $ set dialogBox PaymentURICreate
|
|
||||||
V.EvKey (V.KChar 'p') [] -> do
|
|
||||||
BT.modify $
|
|
||||||
set payUsingURIForm $
|
|
||||||
mkPayUsingURIForm (URIText "")
|
|
||||||
BT.modify $ set dialogBox PayUsingURIShow
|
|
||||||
V.EvKey (V.KChar 'e') [] ->
|
|
||||||
BT.modify $ set dialogBox Blank
|
|
||||||
ev -> return ()
|
|
||||||
--
|
|
||||||
-- Process any other event
|
|
||||||
--
|
|
||||||
Blank -> do
|
Blank -> do
|
||||||
case e of
|
case e of
|
||||||
V.EvKey (V.KChar '\t') [] -> focusRing %= F.focusNext
|
V.EvKey (V.KChar '\t') [] -> focusRing %= F.focusNext
|
||||||
|
|
@ -2003,31 +1583,8 @@ appEvent (BT.VtyEvent e) = do
|
||||||
set txForm $
|
set txForm $
|
||||||
mkSendForm (s ^. balance) (SendInput "" 0.0 "" Full)
|
mkSendForm (s ^. balance) (SendInput "" 0.0 "" Full)
|
||||||
BT.modify $ set dialogBox SendTx
|
BT.modify $ set dialogBox SendTx
|
||||||
V.EvKey (V.KChar 'u') [] ->
|
|
||||||
BT.modify $ set dialogBox ProcessURIMenu
|
|
||||||
V.EvKey (V.KChar 'b') [] ->
|
V.EvKey (V.KChar 'b') [] ->
|
||||||
BT.modify $ set dialogBox AdrBook
|
BT.modify $ set dialogBox AdrBook
|
||||||
V.EvKey (V.KChar 'l') [] -> do
|
|
||||||
if s ^. network == MainNet
|
|
||||||
then do
|
|
||||||
zpr <- liftIO $ getZcashPrice $ s ^. currencyCode
|
|
||||||
case zpr of
|
|
||||||
Just p -> do
|
|
||||||
BT.modify $ set zprice p
|
|
||||||
BT.modify $ set dialogBox ShowFIATBalance
|
|
||||||
Nothing -> do
|
|
||||||
BT.modify $
|
|
||||||
set
|
|
||||||
msg
|
|
||||||
("Currency not supported (" ++
|
|
||||||
T.unpack (s ^. currencyCode) ++ ")!!!")
|
|
||||||
BT.modify $ set displayBox MsgDisplay
|
|
||||||
else do
|
|
||||||
BT.modify $
|
|
||||||
set
|
|
||||||
msg
|
|
||||||
"Balance conversion not available for TestNet"
|
|
||||||
BT.modify $ set displayBox MsgDisplay
|
|
||||||
V.EvKey (V.KChar 'd') [] -> do
|
V.EvKey (V.KChar 'd') [] -> do
|
||||||
pool <- liftIO $ runNoLoggingT $ initPool $ s ^. dbPath
|
pool <- liftIO $ runNoLoggingT $ initPool $ s ^. dbPath
|
||||||
selAcc <-
|
selAcc <-
|
||||||
|
|
@ -2079,10 +1636,6 @@ appEvent (BT.VtyEvent e) = do
|
||||||
msg
|
msg
|
||||||
"Not enough transparent funds in this account"
|
"Not enough transparent funds in this account"
|
||||||
BT.modify $ set displayBox MsgDisplay
|
BT.modify $ set displayBox MsgDisplay
|
||||||
V.EvKey (V.KChar 'k') [] -> do
|
|
||||||
BT.modify $ set dialogBox ViewingKeyMenu
|
|
||||||
V.EvKey (V.KChar 'u') [] -> do
|
|
||||||
BT.modify $ set dialogBox ViewingKeyMenu
|
|
||||||
ev ->
|
ev ->
|
||||||
case r of
|
case r of
|
||||||
Just AList ->
|
Just AList ->
|
||||||
|
|
@ -2097,8 +1650,8 @@ appEvent (BT.VtyEvent e) = do
|
||||||
printMsg s = BT.modify $ updateMsg s
|
printMsg s = BT.modify $ updateMsg s
|
||||||
updateMsg :: String -> State -> State
|
updateMsg :: String -> State -> State
|
||||||
updateMsg = set msg
|
updateMsg = set msg
|
||||||
--
|
-- fs <- BT.gets formState
|
||||||
--
|
-- ev -> BT.zoom shdshForm $ L.handleListEvent ev
|
||||||
appEvent _ = return ()
|
appEvent _ = return ()
|
||||||
|
|
||||||
theMap :: A.AttrMap
|
theMap :: A.AttrMap
|
||||||
|
|
@ -2137,7 +1690,6 @@ runZenithTUI config = do
|
||||||
let host = c_zebraHost config
|
let host = c_zebraHost config
|
||||||
let port = c_zebraPort config
|
let port = c_zebraPort config
|
||||||
let dbFilePath = c_dbPath config
|
let dbFilePath = c_dbPath config
|
||||||
let currencyCode = c_currencyCode config
|
|
||||||
pool <- runNoLoggingT $ initPool dbFilePath
|
pool <- runNoLoggingT $ initPool dbFilePath
|
||||||
w <- try $ checkZebra host port :: IO (Either IOError ZebraGetInfo)
|
w <- try $ checkZebra host port :: IO (Either IOError ZebraGetInfo)
|
||||||
case w of
|
case w of
|
||||||
|
|
@ -2235,12 +1787,6 @@ runZenithTUI config = do
|
||||||
(mkDeshieldForm 0 (ShDshEntry 0.0))
|
(mkDeshieldForm 0 (ShDshEntry 0.0))
|
||||||
tBal
|
tBal
|
||||||
sBal
|
sBal
|
||||||
currencyCode
|
|
||||||
0
|
|
||||||
""
|
|
||||||
""
|
|
||||||
(mkPaymentURIForm $ PaymentInput OrchardPool 0.0 "")
|
|
||||||
(mkPayUsingURIForm $ URIText "")
|
|
||||||
Left _e -> do
|
Left _e -> do
|
||||||
print $
|
print $
|
||||||
"No Zebra node available on port " <>
|
"No Zebra node available on port " <>
|
||||||
|
|
|
||||||
|
|
@ -22,15 +22,11 @@ import Control.Monad.Logger
|
||||||
)
|
)
|
||||||
import Data.Aeson
|
import Data.Aeson
|
||||||
import qualified Data.ByteString as BS
|
import qualified Data.ByteString as BS
|
||||||
import qualified Data.ByteString.Lazy as BL
|
|
||||||
import Data.HexString (toText)
|
import Data.HexString (toText)
|
||||||
import Data.Maybe (fromMaybe, isJust, isNothing)
|
import Data.Maybe (fromMaybe, isJust, isNothing)
|
||||||
import Data.Scientific (Scientific, fromFloatDigits)
|
import Data.Scientific (Scientific, fromFloatDigits)
|
||||||
import Data.Text (Text)
|
|
||||||
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.Lazy as TL
|
|
||||||
import qualified Data.Text.Lazy.Encoding as TLE
|
|
||||||
import Data.Time.Clock.POSIX (posixSecondsToUTCTime)
|
import Data.Time.Clock.POSIX (posixSecondsToUTCTime)
|
||||||
import Database.Esqueleto.Experimental (ConnectionPool, fromSqlKey)
|
import Database.Esqueleto.Experimental (ConnectionPool, fromSqlKey)
|
||||||
import Database.Persist
|
import Database.Persist
|
||||||
|
|
@ -40,10 +36,10 @@ import Monomer
|
||||||
import qualified Monomer.Lens as L
|
import qualified Monomer.Lens as L
|
||||||
import System.Directory (getHomeDirectory)
|
import System.Directory (getHomeDirectory)
|
||||||
import System.FilePath ((</>))
|
import System.FilePath ((</>))
|
||||||
import Text.Printf (printf)
|
import Text.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, deriveUfvk, deriveUivk)
|
import ZcashHaskell.Keys (generateWalletSeedPhrase)
|
||||||
import ZcashHaskell.Orchard
|
import ZcashHaskell.Orchard
|
||||||
( getSaplingFromUA
|
( getSaplingFromUA
|
||||||
, isValidUnifiedAddress
|
, isValidUnifiedAddress
|
||||||
|
|
@ -79,17 +75,8 @@ import Zenith.Utils
|
||||||
, padWithZero
|
, padWithZero
|
||||||
, showAddress
|
, showAddress
|
||||||
, validBarValue
|
, validBarValue
|
||||||
, parseZcashPayment
|
|
||||||
, getZcashPrice
|
|
||||||
, createZip321
|
|
||||||
)
|
)
|
||||||
|
|
||||||
data VkTypeDef
|
|
||||||
= VkNone
|
|
||||||
| VkFull
|
|
||||||
| VkIncoming
|
|
||||||
deriving (Eq, Show)
|
|
||||||
|
|
||||||
data AppEvent
|
data AppEvent
|
||||||
= AppInit
|
= AppInit
|
||||||
| ShowMsg !T.Text
|
| ShowMsg !T.Text
|
||||||
|
|
@ -162,25 +149,6 @@ data AppEvent
|
||||||
| SendShield
|
| SendShield
|
||||||
| StartSync
|
| StartSync
|
||||||
| TreeSync
|
| TreeSync
|
||||||
| ShowFIATBalance
|
|
||||||
| DisplayFIATBalance Double Double
|
|
||||||
| CloseFIATBalance
|
|
||||||
| ViewingKeysClicked
|
|
||||||
| PrepareViewingKey !VkTypeDef !(Maybe (Entity ZcashAccount))
|
|
||||||
| ShowViewingKey !VkTypeDef !T.Text
|
|
||||||
| CopyViewingKey !T.Text !T.Text
|
|
||||||
| CloseShowVK
|
|
||||||
| DisplayPaymentURIForm !T.Text
|
|
||||||
| ClosePaymentURIForm
|
|
||||||
| PrepareURIString
|
|
||||||
| CloseShowURIOverlay
|
|
||||||
| ShowURIOverlay !(Maybe URIQrCode) !T.Text
|
|
||||||
| QRImageLoaded
|
|
||||||
| CopyURIString !T.Text
|
|
||||||
| DisplayPayUsingURI
|
|
||||||
| ClosePayUsingURI
|
|
||||||
| ProcIfValidURI
|
|
||||||
| PreparePaymentURIForm
|
|
||||||
deriving (Eq, Show)
|
deriving (Eq, Show)
|
||||||
|
|
||||||
data AppModel = AppModel
|
data AppModel = AppModel
|
||||||
|
|
@ -240,20 +208,6 @@ data AppModel = AppModel
|
||||||
, _tBalanceValid :: !Bool
|
, _tBalanceValid :: !Bool
|
||||||
, _sBalance :: !Integer
|
, _sBalance :: !Integer
|
||||||
, _sBalanceValid :: !Bool
|
, _sBalanceValid :: !Bool
|
||||||
, _displayFIATBalance :: !Bool
|
|
||||||
, _zPrice :: !Double
|
|
||||||
, _aBal :: !Double
|
|
||||||
, _viewingKeyPopup :: !Bool
|
|
||||||
, _viewingKeyDisplay :: !Bool
|
|
||||||
, _vkTypeName :: !T.Text
|
|
||||||
, _vkData :: !T.Text
|
|
||||||
, _paymentURIDisplay :: !Bool
|
|
||||||
, _showURIDisplay :: !Bool
|
|
||||||
, _usepmtURIOverlay :: !Bool
|
|
||||||
, _uriString :: !T.Text
|
|
||||||
, _uriAddr :: !T.Text
|
|
||||||
, _uriQRImage :: !(Maybe URIQrCode)
|
|
||||||
, _uriQRInProgress :: !Bool
|
|
||||||
} deriving (Eq, Show)
|
} deriving (Eq, Show)
|
||||||
|
|
||||||
makeLenses ''AppModel
|
makeLenses ''AppModel
|
||||||
|
|
@ -267,18 +221,6 @@ remixHourglassFill = toGlyph 0xF338
|
||||||
remixIcon :: T.Text -> WidgetNode s e
|
remixIcon :: T.Text -> WidgetNode s e
|
||||||
remixIcon i = label i `styleBasic` [textFont "Remix", textMiddle]
|
remixIcon i = label i `styleBasic` [textFont "Remix", textMiddle]
|
||||||
|
|
||||||
getURIQRWidth :: Maybe URIQrCode -> Int
|
|
||||||
getURIQRWidth qr =
|
|
||||||
case qr of
|
|
||||||
Nothing -> 0
|
|
||||||
Just qr -> round (uriWidth qr)
|
|
||||||
|
|
||||||
getURIQRHeight :: Maybe URIQrCode -> Int
|
|
||||||
getURIQRHeight qr =
|
|
||||||
case qr of
|
|
||||||
Nothing -> 0
|
|
||||||
Just qr -> round (uriHeight qr)
|
|
||||||
|
|
||||||
buildUI ::
|
buildUI ::
|
||||||
WidgetEnv AppModel AppEvent -> AppModel -> WidgetNode AppModel AppEvent
|
WidgetEnv AppModel AppEvent -> AppModel -> WidgetNode AppModel AppEvent
|
||||||
buildUI wenv model = widgetTree
|
buildUI wenv model = widgetTree
|
||||||
|
|
@ -317,12 +259,6 @@ buildUI wenv model = widgetTree
|
||||||
updateABAddress
|
updateABAddress
|
||||||
, shieldOverlay `nodeVisible` model ^. shieldZec
|
, shieldOverlay `nodeVisible` model ^. shieldZec
|
||||||
, deShieldOverlay `nodeVisible` model ^. deShieldZec
|
, deShieldOverlay `nodeVisible` model ^. deShieldZec
|
||||||
, dfBalOverlay `nodeVisible` model ^. displayFIATBalance
|
|
||||||
, showVKOverlay `nodeVisible` model ^. viewingKeyDisplay
|
|
||||||
, paymentURIOverlay `nodeVisible` model ^. paymentURIDisplay
|
|
||||||
, showURIInProgress `nodeVisible` model ^. uriQRInProgress
|
|
||||||
, showURIOverlay `nodeVisible` model ^. showURIDisplay
|
|
||||||
, pmtUsingURIOverlay `nodeVisible` model ^. usepmtURIOverlay
|
|
||||||
, msgAdrBookOverlay `nodeVisible` isJust (model ^. msgAB)
|
, msgAdrBookOverlay `nodeVisible` isJust (model ^. msgAB)
|
||||||
]
|
]
|
||||||
mainWindow =
|
mainWindow =
|
||||||
|
|
@ -392,35 +328,6 @@ buildUI wenv model = widgetTree
|
||||||
[bgColor white, borderB 1 gray, padding 3]
|
[bgColor white, borderB 1 gray, padding 3]
|
||||||
, box_ [alignLeft, onClick ShowDeShield] (label "De-Shield ZEC") `styleBasic`
|
, box_ [alignLeft, onClick ShowDeShield] (label "De-Shield ZEC") `styleBasic`
|
||||||
[bgColor white, borderB 1 gray, padding 3]
|
[bgColor white, borderB 1 gray, padding 3]
|
||||||
, box_
|
|
||||||
[alignLeft]
|
|
||||||
(vstack
|
|
||||||
[ box_
|
|
||||||
[alignLeft, onClick ViewingKeysClicked]
|
|
||||||
(hstack
|
|
||||||
[ label "Viewing Keys"
|
|
||||||
, filler
|
|
||||||
, widgetIf (not $ model ^. viewingKeyPopup) $
|
|
||||||
remixIcon remixMenuUnfoldFill
|
|
||||||
, widgetIf (model ^. viewingKeyPopup) $
|
|
||||||
remixIcon remixMenuFoldFill
|
|
||||||
])
|
|
||||||
, widgetIf (model ^. viewingKeyPopup) $
|
|
||||||
animSlideIn viewingKeysBox
|
|
||||||
]) `styleBasic`
|
|
||||||
[bgColor white, borderB 1 gray, padding 3]
|
|
||||||
, box_
|
|
||||||
[alignLeft, onClick ShowFIATBalance]
|
|
||||||
(label
|
|
||||||
("Balance in " <>
|
|
||||||
T.toUpper (c_currencyCode (model ^. configuration)))) `styleBasic`
|
|
||||||
[bgColor white, borderB 1 gray, padding 3]
|
|
||||||
, box_ [alignLeft, onClick PreparePaymentURIForm] (label "Create URI") `styleBasic`
|
|
||||||
[bgColor white, borderB 1 gray, padding 3]
|
|
||||||
, box_
|
|
||||||
[alignLeft, onClick DisplayPayUsingURI]
|
|
||||||
(label "Pay using URI") `styleBasic`
|
|
||||||
[bgColor white, borderB 1 gray, padding 3]
|
|
||||||
]) `styleBasic`
|
]) `styleBasic`
|
||||||
[bgColor btnColor, padding 3]
|
[bgColor btnColor, padding 3]
|
||||||
newBox =
|
newBox =
|
||||||
|
|
@ -440,31 +347,6 @@ buildUI wenv model = widgetTree
|
||||||
(hstack [label "Wallet", filler]) `styleBasic`
|
(hstack [label "Wallet", filler]) `styleBasic`
|
||||||
[bgColor white, borderB 1 gray, padding 3]
|
[bgColor white, borderB 1 gray, padding 3]
|
||||||
])
|
])
|
||||||
viewingKeysBox =
|
|
||||||
box_
|
|
||||||
[alignMiddle]
|
|
||||||
(vstack
|
|
||||||
[ box_
|
|
||||||
[ alignLeft
|
|
||||||
, onClick
|
|
||||||
(PrepareViewingKey
|
|
||||||
VkFull
|
|
||||||
currentAccount
|
|
||||||
)
|
|
||||||
]
|
|
||||||
(hstack [label "Full VK", filler]) `styleBasic`
|
|
||||||
[bgColor white, borderB 1 gray, padding 3]
|
|
||||||
, box_
|
|
||||||
[ alignLeft
|
|
||||||
, onClick
|
|
||||||
(PrepareViewingKey
|
|
||||||
VkIncoming
|
|
||||||
currentAccount
|
|
||||||
)
|
|
||||||
]
|
|
||||||
(hstack [label "Incoming VK", filler]) `styleBasic`
|
|
||||||
[bgColor white, borderB 1 gray, padding 3]
|
|
||||||
])
|
|
||||||
walletButton =
|
walletButton =
|
||||||
hstack
|
hstack
|
||||||
[ label "Wallet: " `styleBasic` [textFont "Bold", textColor white]
|
[ label "Wallet: " `styleBasic` [textFont "Bold", textColor white]
|
||||||
|
|
@ -1111,49 +993,6 @@ buildUI wenv model = widgetTree
|
||||||
, label_ (txtWrapN (fromMaybe "" (model ^. msgAB)) 64) [multiline]
|
, label_ (txtWrapN (fromMaybe "" (model ^. msgAB)) 64) [multiline]
|
||||||
, filler
|
, filler
|
||||||
]
|
]
|
||||||
dfBalOverlay =
|
|
||||||
alert CloseFIATBalance $
|
|
||||||
vstack
|
|
||||||
[ box_
|
|
||||||
[]
|
|
||||||
(label
|
|
||||||
("Account Balance in " <>
|
|
||||||
(T.toUpper (c_currencyCode (model ^. configuration)))) `styleBasic`
|
|
||||||
[textFont "Bold", textSize 12, textColor white]) `styleBasic`
|
|
||||||
[bgColor btnColor, radius 2, padding 3]
|
|
||||||
, filler
|
|
||||||
, (label
|
|
||||||
("1 ZEC = " <>
|
|
||||||
(T.pack (printf "%.2f" (model ^. zPrice))) <>
|
|
||||||
" " <> (T.toUpper (c_currencyCode (model ^. configuration))))) `styleBasic`
|
|
||||||
[]
|
|
||||||
, filler
|
|
||||||
, (label
|
|
||||||
((T.pack (printf "%.8f" (model ^. aBal)) <>
|
|
||||||
" ZEC = " <>
|
|
||||||
(T.pack (printf "%.2f" ((model ^. zPrice) * (model ^. aBal)))) <>
|
|
||||||
" " <> (T.toUpper (c_currencyCode (model ^. configuration)))))) `styleBasic`
|
|
||||||
[]
|
|
||||||
]
|
|
||||||
showVKOverlay =
|
|
||||||
alert CloseShowVK $
|
|
||||||
vstack
|
|
||||||
[ box_
|
|
||||||
[]
|
|
||||||
(label ((model ^. vkTypeName) <> " Viewing Key") `styleBasic`
|
|
||||||
[textFont "Bold", textColor white, textSize 12, padding 3]) `styleBasic`
|
|
||||||
[bgColor btnColor, radius 2, padding 3]
|
|
||||||
, spacer
|
|
||||||
, hstack
|
|
||||||
[filler, label_ (txtWrapN (model ^. vkData) 64) [multiline], filler]
|
|
||||||
, spacer
|
|
||||||
, hstack
|
|
||||||
[ filler
|
|
||||||
, button "Copy to Clipboard" $
|
|
||||||
CopyViewingKey (model ^. vkTypeName) (model ^. vkData)
|
|
||||||
, filler
|
|
||||||
]
|
|
||||||
]
|
|
||||||
shieldOverlay =
|
shieldOverlay =
|
||||||
box
|
box
|
||||||
(vstack
|
(vstack
|
||||||
|
|
@ -1269,168 +1108,8 @@ buildUI wenv model = widgetTree
|
||||||
, filler
|
, filler
|
||||||
]) `styleBasic`
|
]) `styleBasic`
|
||||||
[bgColor (white & L.a .~ 0.5)]
|
[bgColor (white & L.a .~ 0.5)]
|
||||||
--
|
|
||||||
paymentURIOverlay =
|
notImplemented = NotImplemented
|
||||||
box
|
|
||||||
(vstack
|
|
||||||
[ filler
|
|
||||||
, hstack
|
|
||||||
[ filler
|
|
||||||
, box_
|
|
||||||
[]
|
|
||||||
(vstack
|
|
||||||
[ box_
|
|
||||||
[]
|
|
||||||
(label "Create a Payment URI" `styleBasic`
|
|
||||||
[textFont "Bold", textColor white, textSize 10, padding 3]) `styleBasic`
|
|
||||||
[bgColor btnColor, radius 2, padding 3]
|
|
||||||
, spacer
|
|
||||||
, hstack
|
|
||||||
[ filler
|
|
||||||
, label "Current Address:" `styleBasic` [textFont "Bold"]
|
|
||||||
, spacer
|
|
||||||
, label_ (txtWrapN (model ^. uriAddr) 64) [multiline]
|
|
||||||
, filler
|
|
||||||
]
|
|
||||||
, spacer
|
|
||||||
, hstack
|
|
||||||
[ label "Amount : " `styleBasic` [textFont "Bold"]
|
|
||||||
, numericField_ sendAmount
|
|
||||||
[ decimals 8 ]
|
|
||||||
`nodeKey` "floatInput"
|
|
||||||
`styleBasic`
|
|
||||||
[ width 150
|
|
||||||
, styleIf (model ^. sendAmount <= 0.0) (textColor red)
|
|
||||||
]
|
|
||||||
]
|
|
||||||
, spacer
|
|
||||||
, hstack
|
|
||||||
[ label "Memo: " `styleBasic` [textFont "Bold"]
|
|
||||||
, spacer
|
|
||||||
, textField_ sendMemo [] `styleBasic` [width 300]
|
|
||||||
]
|
|
||||||
, spacer
|
|
||||||
, hstack
|
|
||||||
[ filler
|
|
||||||
, mainButton "Create URI" PrepareURIString `nodeEnabled`
|
|
||||||
(model ^. sendAmount > 0.0)
|
|
||||||
, spacer
|
|
||||||
, button "Cancel" ClosePaymentURIForm
|
|
||||||
, filler
|
|
||||||
]
|
|
||||||
]) `styleBasic`
|
|
||||||
[radius 4, border 2 btnColor, bgColor white, padding 4]
|
|
||||||
, filler
|
|
||||||
]
|
|
||||||
, filler
|
|
||||||
]) `styleBasic`
|
|
||||||
[bgColor (white & L.a .~ 0.5)]
|
|
||||||
--
|
|
||||||
showURIInProgress =
|
|
||||||
box
|
|
||||||
(vstack
|
|
||||||
[ filler
|
|
||||||
, hstack
|
|
||||||
[ filler
|
|
||||||
, label "Processing Payment URI, it will take a moment ....."
|
|
||||||
`styleBasic` [textFont "Bold", textSize 14]
|
|
||||||
, filler
|
|
||||||
]
|
|
||||||
, filler
|
|
||||||
]) `styleBasic`
|
|
||||||
[bgColor (white & L.a .~ 0.5)]
|
|
||||||
--
|
|
||||||
showURIOverlay =
|
|
||||||
box
|
|
||||||
(vstack
|
|
||||||
[ filler
|
|
||||||
, hstack
|
|
||||||
[ filler
|
|
||||||
, box_
|
|
||||||
[]
|
|
||||||
(vstack
|
|
||||||
[ box_
|
|
||||||
[alignMiddle]
|
|
||||||
(label "Payment URI" `styleBasic`
|
|
||||||
[textFont "Bold", textColor white, textSize 11, padding 3]) `styleBasic`
|
|
||||||
[bgColor btnColor, radius 2, padding 3]
|
|
||||||
, spacer
|
|
||||||
, hstack
|
|
||||||
[filler, label_ (txtWrapN (model ^. uriString ) 64) [multiline], filler]
|
|
||||||
, spacer
|
|
||||||
, hstack
|
|
||||||
[ filler
|
|
||||||
, box_
|
|
||||||
[alignMiddle]
|
|
||||||
(case model ^. uriQRImage of
|
|
||||||
Just img -> imageMem_ "URIQRCode" (uriBytes img) (Size (uriWidth img) (uriHeight img) )
|
|
||||||
[fitWidth]
|
|
||||||
Nothing -> image_
|
|
||||||
(T.pack $ (model ^. home) </> "Zenith/assets/cracked_qr.png")
|
|
||||||
[fitHeight] )
|
|
||||||
`styleBasic` [ bgColor white
|
|
||||||
, height 120
|
|
||||||
, width 120
|
|
||||||
]
|
|
||||||
, filler
|
|
||||||
]
|
|
||||||
, spacer
|
|
||||||
, hstack
|
|
||||||
[ filler
|
|
||||||
, button "Copy to Clipboard" $
|
|
||||||
CopyURIString (model ^. uriString)
|
|
||||||
, spacer
|
|
||||||
, button "Cancel" CloseShowURIOverlay
|
|
||||||
, filler
|
|
||||||
]
|
|
||||||
]) `styleBasic`
|
|
||||||
[radius 4, border 2 btnColor, bgColor white, padding 4]
|
|
||||||
, filler
|
|
||||||
]
|
|
||||||
, filler
|
|
||||||
] ) `styleBasic`
|
|
||||||
[bgColor (white & L.a .~ 0.5)]
|
|
||||||
--
|
|
||||||
pmtUsingURIOverlay =
|
|
||||||
box
|
|
||||||
(vstack
|
|
||||||
[ filler
|
|
||||||
, hstack
|
|
||||||
[ filler
|
|
||||||
, box_
|
|
||||||
[]
|
|
||||||
(vstack
|
|
||||||
[ box_
|
|
||||||
[alignMiddle]
|
|
||||||
(label "Pay using URI" `styleBasic`
|
|
||||||
[textColor white, textFont "Bold", textSize 12]) `styleBasic`
|
|
||||||
[bgColor btnColor]
|
|
||||||
, separatorLine `styleBasic` [fgColor btnColor]
|
|
||||||
, spacer
|
|
||||||
, hstack
|
|
||||||
[ label "URI :" `styleBasic`
|
|
||||||
[width 30, textFont "Bold"]
|
|
||||||
, spacer
|
|
||||||
, textArea uriString `styleBasic`
|
|
||||||
[width 170, height 30]
|
|
||||||
]
|
|
||||||
, spacer
|
|
||||||
, box_
|
|
||||||
[alignMiddle]
|
|
||||||
(hstack
|
|
||||||
[ spacer
|
|
||||||
, button "Cancel" ClosePayUsingURI
|
|
||||||
, spacer
|
|
||||||
, mainButton "Process" ProcIfValidURI
|
|
||||||
, spacer
|
|
||||||
])
|
|
||||||
]) `styleBasic`
|
|
||||||
[radius 4, border 2 btnColor, bgColor white, padding 4]
|
|
||||||
, filler
|
|
||||||
]
|
|
||||||
, filler
|
|
||||||
]) `styleBasic`
|
|
||||||
[bgColor (white & L.a .~ 0.5)]
|
|
||||||
|
|
||||||
generateQRCodes :: Config -> IO ()
|
generateQRCodes :: Config -> IO ()
|
||||||
generateQRCodes config = do
|
generateQRCodes config = do
|
||||||
|
|
@ -1554,14 +1233,6 @@ handleEvent wenv node model evt =
|
||||||
False
|
False
|
||||||
]
|
]
|
||||||
ConfirmCancel -> [Model $ model & confirmTitle .~ Nothing & mainInput .~ ""]
|
ConfirmCancel -> [Model $ model & confirmTitle .~ Nothing & mainInput .~ ""]
|
||||||
ViewingKeysClicked ->
|
|
||||||
[Model $ model & viewingKeyPopup .~ not (model ^. viewingKeyPopup)]
|
|
||||||
NewAddress vk ->
|
|
||||||
[ Model $
|
|
||||||
model & confirmTitle ?~ "New Address" & confirmCancel .~ "Cancel" &
|
|
||||||
menuPopup .~
|
|
||||||
False
|
|
||||||
]
|
|
||||||
ShowSeed -> [Model $ model & showSeed .~ True & menuPopup .~ False]
|
ShowSeed -> [Model $ model & showSeed .~ True & menuPopup .~ False]
|
||||||
ShowSend ->
|
ShowSend ->
|
||||||
[ Model $
|
[ Model $
|
||||||
|
|
@ -1784,7 +1455,6 @@ handleEvent wenv node model evt =
|
||||||
model & amountValid .~
|
model & amountValid .~
|
||||||
(i < (fromIntegral (model ^. balance) / 100000000.0))
|
(i < (fromIntegral (model ^. balance) / 100000000.0))
|
||||||
]
|
]
|
||||||
--
|
|
||||||
ShowTxId tx -> [Model $ model & showId ?~ tx & modalMsg .~ Nothing]
|
ShowTxId tx -> [Model $ model & showId ?~ tx & modalMsg .~ Nothing]
|
||||||
-- |
|
-- |
|
||||||
-- | Address Book Events
|
-- | Address Book Events
|
||||||
|
|
@ -1838,16 +1508,6 @@ handleEvent wenv node model evt =
|
||||||
, setClipboardData $ ClipboardText a
|
, setClipboardData $ ClipboardText a
|
||||||
, Event $ ShowMessage "Address copied!!"
|
, Event $ ShowMessage "Address copied!!"
|
||||||
]
|
]
|
||||||
CopyViewingKey t v ->
|
|
||||||
[ setClipboardData ClipboardEmpty
|
|
||||||
, setClipboardData $ ClipboardText v
|
|
||||||
, Event $ ShowMessage (t <> " viewing key copied!!")
|
|
||||||
]
|
|
||||||
CopyURIString u ->
|
|
||||||
[ setClipboardData ClipboardEmpty
|
|
||||||
, setClipboardData $ ClipboardText u
|
|
||||||
, Event $ ShowMessage "URI string copied to clipboard!!"
|
|
||||||
]
|
|
||||||
DeleteABEntry a ->
|
DeleteABEntry a ->
|
||||||
[ Task $ deleteAdrBook (model ^. configuration) a
|
[ Task $ deleteAdrBook (model ^. configuration) a
|
||||||
, Model $
|
, Model $
|
||||||
|
|
@ -1863,124 +1523,6 @@ handleEvent wenv node model evt =
|
||||||
model & msgAB ?~ "Function not implemented..." & menuPopup .~ False
|
model & msgAB ?~ "Function not implemented..." & menuPopup .~ False
|
||||||
]
|
]
|
||||||
CloseMsgAB -> [Model $ model & msgAB .~ Nothing & inError .~ False]
|
CloseMsgAB -> [Model $ model & msgAB .~ Nothing & inError .~ False]
|
||||||
CloseShowVK ->
|
|
||||||
[ Model $
|
|
||||||
model & vkTypeName .~ "" & vkData .~ "" & viewingKeyDisplay .~ False
|
|
||||||
]
|
|
||||||
--
|
|
||||||
-- Show Balance in FIAT
|
|
||||||
--
|
|
||||||
DisplayFIATBalance zpr abal ->
|
|
||||||
[ Model $
|
|
||||||
model & zPrice .~ zpr & aBal .~ abal & displayFIATBalance .~ True &
|
|
||||||
menuPopup .~
|
|
||||||
False
|
|
||||||
]
|
|
||||||
ShowFIATBalance ->
|
|
||||||
if model ^. network == MainNet
|
|
||||||
then [ Task $ sfBalance (model ^. configuration) ]
|
|
||||||
else [ Model $ model & zPrice .~ 0.0 & aBal .~ 0.0
|
|
||||||
, Event $ ShowError "Balance conversion not available for TestNet"
|
|
||||||
]
|
|
||||||
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
|
|
||||||
--
|
|
||||||
ShowViewingKey vkType vkText ->
|
|
||||||
case vkType of
|
|
||||||
VkFull -> [ Model $
|
|
||||||
model & vkTypeName .~ "Full"
|
|
||||||
& vkData .~ vkText
|
|
||||||
& viewingKeyDisplay .~ True
|
|
||||||
& menuPopup .~ False
|
|
||||||
]
|
|
||||||
VkIncoming -> [ Model $
|
|
||||||
model & vkTypeName .~ "Incoming"
|
|
||||||
& vkData .~ vkText
|
|
||||||
& viewingKeyDisplay .~ True
|
|
||||||
& menuPopup .~ False
|
|
||||||
]
|
|
||||||
--
|
|
||||||
-- Display PaymentURI Form
|
|
||||||
--
|
|
||||||
PreparePaymentURIForm ->
|
|
||||||
[ Task $ getCurrentAddress currentAddress ]
|
|
||||||
--
|
|
||||||
DisplayPaymentURIForm ua->
|
|
||||||
[ Model $
|
|
||||||
model & uriString .~ ""
|
|
||||||
& uriAddr .~ ua
|
|
||||||
& amountValid .~ False
|
|
||||||
& sendAmount .~ 0.0
|
|
||||||
& sendMemo .~ ""
|
|
||||||
& paymentURIDisplay .~ True
|
|
||||||
& menuPopup .~ False
|
|
||||||
]
|
|
||||||
ClosePaymentURIForm -> [Model $ model & paymentURIDisplay .~ False]
|
|
||||||
--
|
|
||||||
-- Generate URI
|
|
||||||
--
|
|
||||||
PrepareURIString -> [ Task $ genURIString (model ^. uriAddr) (model ^. sendAmount) (model ^. sendMemo)
|
|
||||||
, Model $ model & uriQRInProgress .~ True
|
|
||||||
]
|
|
||||||
ShowURIOverlay qr uStr ->
|
|
||||||
[ Model $
|
|
||||||
model & uriString .~ uStr
|
|
||||||
& uriQRImage .~ qr
|
|
||||||
& uriQRInProgress .~ True
|
|
||||||
& paymentURIDisplay .~ False
|
|
||||||
& showURIDisplay .~ True
|
|
||||||
& uriQRInProgress .~ False
|
|
||||||
]
|
|
||||||
CloseShowURIOverlay -> [ Model $ model & showURIDisplay .~ False & uriString .~ "" & uriQRInProgress .~ False & uriQRImage .~ Nothing]
|
|
||||||
QRImageLoaded -> [ Model $ model & uriQRInProgress .~ False ]
|
|
||||||
--
|
|
||||||
-- Display Pay using URI Form
|
|
||||||
--
|
|
||||||
DisplayPayUsingURI ->
|
|
||||||
[Model $ model & usepmtURIOverlay .~ True & menuPopup .~ False]
|
|
||||||
ClosePayUsingURI -> [Model $ model & usepmtURIOverlay .~ False]
|
|
||||||
ProcIfValidURI -> do
|
|
||||||
let zp = parseZcashPayment $ T.unpack (model ^. uriString)
|
|
||||||
case zp of
|
|
||||||
Right p -> do
|
|
||||||
case uriAmount p of
|
|
||||||
Just a ->
|
|
||||||
[ Model $
|
|
||||||
model & usepmtURIOverlay .~ False & openSend .~ True &
|
|
||||||
privacyChoice .~
|
|
||||||
Full &
|
|
||||||
recipientValid .~
|
|
||||||
False &
|
|
||||||
sendRecipient .~
|
|
||||||
T.pack (uriAddress p) &
|
|
||||||
sendAmount .~
|
|
||||||
realToFrac a &
|
|
||||||
sendMemo .~ (uriMemo p)
|
|
||||||
, Event $ ClosePaymentURIForm
|
|
||||||
]
|
|
||||||
Nothing ->
|
|
||||||
[ Model $
|
|
||||||
model & usepmtURIOverlay .~ False & openSend .~ False &
|
|
||||||
uriString .~
|
|
||||||
""
|
|
||||||
, Event $ ShowError "Invalid URI"
|
|
||||||
]
|
|
||||||
Left e ->
|
|
||||||
[ Model $
|
|
||||||
model & usepmtURIOverlay .~ False & openSend .~ False & uriString .~
|
|
||||||
""
|
|
||||||
, Event $ ShowError "Invalid URI"
|
|
||||||
]
|
|
||||||
--
|
|
||||||
--
|
|
||||||
ShowShield ->
|
ShowShield ->
|
||||||
if model ^. tBalance > 0
|
if model ^. tBalance > 0
|
||||||
then [Model $ model & shieldZec .~ True & menuPopup .~ False]
|
then [Model $ model & shieldZec .~ True & menuPopup .~ False]
|
||||||
|
|
@ -2138,90 +1680,6 @@ handleEvent wenv node model evt =
|
||||||
pool <- runNoLoggingT $ initPool $ c_dbPath config
|
pool <- runNoLoggingT $ initPool $ c_dbPath config
|
||||||
res <- liftIO $ updateAdrsInAdrBook pool d a a
|
res <- liftIO $ updateAdrsInAdrBook pool d a a
|
||||||
return $ ShowMessage "Address Book entry updated!!"
|
return $ ShowMessage "Address Book entry updated!!"
|
||||||
--
|
|
||||||
dbal :: Integer -> Double
|
|
||||||
dbal a = fromIntegral a
|
|
||||||
--
|
|
||||||
sfBalance :: Config -> IO AppEvent
|
|
||||||
sfBalance config = do
|
|
||||||
zpr <- liftIO $ getZcashPrice $ c_currencyCode config
|
|
||||||
case zpr of
|
|
||||||
Just zp -> do
|
|
||||||
let zbal = (dbal (model ^. balance)) / 100000000
|
|
||||||
return $ DisplayFIATBalance zp zbal
|
|
||||||
Nothing ->
|
|
||||||
return $
|
|
||||||
ShowMessage
|
|
||||||
("Currency not supported [" <> c_currencyCode config <> "]")
|
|
||||||
--
|
|
||||||
procIfValidURI :: T.Text -> IO AppEvent
|
|
||||||
procIfValidURI ustr = do
|
|
||||||
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
|
|
||||||
--
|
|
||||||
-- Get curret zcash address
|
|
||||||
--
|
|
||||||
getCurrentAddress :: Maybe (Entity WalletAddress) -> IO AppEvent
|
|
||||||
getCurrentAddress a = do
|
|
||||||
let ua = case model ^. selPool of
|
|
||||||
OrchardPool -> maybe "None" (getUA . walletAddressUAddress . entityVal) a
|
|
||||||
SaplingPool -> fromMaybe "None" $ (getSaplingFromUA . E.encodeUtf8 . getUA . walletAddressUAddress . entityVal) =<< a
|
|
||||||
SproutPool -> "None"
|
|
||||||
TransparentPool -> maybe "None" (encodeTransparentReceiver (model ^. network)) $
|
|
||||||
t_rec =<< (isValidUnifiedAddress . E.encodeUtf8 . getUA . walletAddressUAddress . entityVal) =<< a
|
|
||||||
return $ DisplayPaymentURIForm ua
|
|
||||||
--
|
|
||||||
-- Generate a QR code for a String and save it as an PNG image
|
|
||||||
--
|
|
||||||
genURIStringQR :: Int -> T.Text -> Maybe URIQrCode
|
|
||||||
genURIStringQR scaleFactor uriStr = do
|
|
||||||
let qrOptions = defaultQRCodeOptions L
|
|
||||||
case encodeText qrOptions Utf8WithoutECI uriStr of
|
|
||||||
Nothing -> Nothing
|
|
||||||
Just qrCode -> do
|
|
||||||
let qri = promoteImage (toImage 4 scaleFactor qrCode)
|
|
||||||
let qrw = fromIntegral $ imageWidth qri
|
|
||||||
let qrh = fromIntegral $ imageHeight qri
|
|
||||||
let qrb = BS.pack $
|
|
||||||
pixelFold (\bs _ _ (PixelRGBA8 i j k l) -> bs <> [i, j, k, l])
|
|
||||||
[]
|
|
||||||
qri
|
|
||||||
Just URIQrCode { uriBytes=qrb, uriWidth=qrw, uriHeight=qrh }
|
|
||||||
--
|
|
||||||
-- Gen URI String
|
|
||||||
--
|
|
||||||
genURIString :: T.Text -> Float -> T.Text -> IO AppEvent
|
|
||||||
genURIString addr mAmt mMemo = do
|
|
||||||
let mM = case mMemo of
|
|
||||||
"" -> Nothing
|
|
||||||
_ -> Just (T.unpack mMemo)
|
|
||||||
let uriSt = createZip321 (T.unpack addr) (Just (realToFrac mAmt)) mM
|
|
||||||
return $ ShowURIOverlay (genURIStringQR 3 (T.pack uriSt)) (T.pack uriSt)
|
|
||||||
|
|
||||||
scanZebra ::
|
scanZebra ::
|
||||||
T.Text
|
T.Text
|
||||||
|
|
@ -2566,20 +2024,6 @@ runZenithGUI config = do
|
||||||
False
|
False
|
||||||
shieldBal
|
shieldBal
|
||||||
False
|
False
|
||||||
False
|
|
||||||
0.0
|
|
||||||
0.0
|
|
||||||
False
|
|
||||||
False
|
|
||||||
""
|
|
||||||
""
|
|
||||||
False
|
|
||||||
False
|
|
||||||
False
|
|
||||||
""
|
|
||||||
""
|
|
||||||
Nothing
|
|
||||||
False
|
|
||||||
startApp model handleEvent buildUI (params hD)
|
startApp model handleEvent buildUI (params hD)
|
||||||
Left _e -> print "Zebra not available"
|
Left _e -> print "Zebra not available"
|
||||||
where
|
where
|
||||||
|
|
|
||||||
|
|
@ -916,7 +916,7 @@ scanZebra dbPath zHost zPort net = do
|
||||||
updateCommitmentTrees pool zHost zPort $ ZcashNetDB net
|
updateCommitmentTrees pool zHost zPort $ ZcashNetDB net
|
||||||
runNoLoggingT $
|
runNoLoggingT $
|
||||||
mapM_
|
mapM_
|
||||||
(syncWallet (Config dbPath zHost zPort "user" "pwd" 8080 "usd"))
|
(syncWallet (Config dbPath zHost zPort "user" "pwd" 8080))
|
||||||
wals
|
wals
|
||||||
_ <- completeSync pool Successful
|
_ <- completeSync pool Successful
|
||||||
return ()
|
return ()
|
||||||
|
|
|
||||||
|
|
@ -10,7 +10,6 @@ import Control.Monad.Logger
|
||||||
( NoLoggingT
|
( NoLoggingT
|
||||||
, logErrorN
|
, logErrorN
|
||||||
, logInfoN
|
, logInfoN
|
||||||
, runFileLoggingT
|
|
||||||
, runNoLoggingT
|
, runNoLoggingT
|
||||||
, runStderrLoggingT
|
, runStderrLoggingT
|
||||||
)
|
)
|
||||||
|
|
@ -59,7 +58,6 @@ import Zenith.Types
|
||||||
, ZcashNetDB(..)
|
, ZcashNetDB(..)
|
||||||
, ZenithStatus(..)
|
, ZenithStatus(..)
|
||||||
)
|
)
|
||||||
import Zenith.Types (Config(..), HexStringDB(..), ZcashNetDB(..))
|
|
||||||
import Zenith.Utils (jsonNumber)
|
import Zenith.Utils (jsonNumber)
|
||||||
|
|
||||||
-- | Function to scan the Zcash blockchain through the Zebra node and populate the Zenith database
|
-- | Function to scan the Zcash blockchain through the Zebra node and populate the Zenith database
|
||||||
|
|
|
||||||
|
|
@ -112,7 +112,6 @@ data Config = Config
|
||||||
, c_zenithUser :: !BS.ByteString
|
, c_zenithUser :: !BS.ByteString
|
||||||
, c_zenithPwd :: !BS.ByteString
|
, c_zenithPwd :: !BS.ByteString
|
||||||
, c_zenithPort :: !Int
|
, c_zenithPort :: !Int
|
||||||
, c_currencyCode :: !T.Text
|
|
||||||
} deriving (Eq, Prelude.Show)
|
} deriving (Eq, Prelude.Show)
|
||||||
|
|
||||||
data ZcashPool
|
data ZcashPool
|
||||||
|
|
@ -508,20 +507,3 @@ encodeHexText' t =
|
||||||
if T.length t > 0
|
if T.length t > 0
|
||||||
then C.unpack . B64.encode $ E.encodeUtf8 t
|
then C.unpack . B64.encode $ E.encodeUtf8 t
|
||||||
else C.unpack . B64.encode $ E.encodeUtf8 "Sent from Zenith"
|
else C.unpack . B64.encode $ E.encodeUtf8 "Sent from Zenith"
|
||||||
|
|
||||||
-- | Define a data structure for the parsed components
|
|
||||||
data ZcashPaymentURI = ZcashPaymentURI
|
|
||||||
{ uriAddress :: String
|
|
||||||
, uriAmount :: Maybe Double
|
|
||||||
, uriMemo :: T.Text
|
|
||||||
, uriLabel :: Maybe String
|
|
||||||
, uriMessage :: Maybe String
|
|
||||||
} deriving (Show, Eq)
|
|
||||||
|
|
||||||
-- | Define a data structure for the URI QR image
|
|
||||||
data URIQrCode = URIQrCode
|
|
||||||
{
|
|
||||||
uriBytes :: BS.ByteString -- Image as ByteString
|
|
||||||
, uriWidth :: Double -- Number of columns in QR Image
|
|
||||||
, uriHeight :: Double -- Number of rows in a QR Image
|
|
||||||
} deriving (Show, Eq)
|
|
||||||
|
|
|
||||||
|
|
@ -2,31 +2,16 @@
|
||||||
|
|
||||||
module Zenith.Utils where
|
module Zenith.Utils where
|
||||||
|
|
||||||
import Control.Exception (SomeException, try)
|
|
||||||
import Control.Monad (when)
|
|
||||||
import Data.Aeson
|
import Data.Aeson
|
||||||
import qualified Data.Aeson.Key as K
|
|
||||||
import qualified Data.Aeson.KeyMap as KM
|
|
||||||
import Data.Aeson.Types (parseMaybe)
|
|
||||||
import qualified Data.ByteString as BS
|
|
||||||
import qualified Data.ByteString.Base64 as B64
|
|
||||||
import qualified Data.ByteString.Char8 as BC
|
|
||||||
import qualified Data.ByteString.Lazy as B
|
|
||||||
import qualified Data.ByteString.Lazy.Char8 as BL
|
|
||||||
import Data.Char (isAlphaNum, isSpace)
|
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, Scientific, toRealFloat)
|
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 qualified Data.Text.Encoding as TE
|
|
||||||
import Network.HTTP.Simple
|
|
||||||
import Network.URI (escapeURIString, isUnreserved)
|
|
||||||
import System.Directory
|
import System.Directory
|
||||||
import System.Process (createProcess_, shell)
|
import System.Process (createProcess_, shell)
|
||||||
import Text.Printf (printf)
|
|
||||||
import Text.Read (readMaybe)
|
|
||||||
import Text.Regex.Posix
|
import Text.Regex.Posix
|
||||||
import ZcashHaskell.Orchard
|
import ZcashHaskell.Orchard
|
||||||
( encodeUnifiedAddress
|
( encodeUnifiedAddress
|
||||||
|
|
@ -40,12 +25,10 @@ import ZcashHaskell.Transparent
|
||||||
)
|
)
|
||||||
import ZcashHaskell.Types
|
import ZcashHaskell.Types
|
||||||
( ExchangeAddress(..)
|
( ExchangeAddress(..)
|
||||||
, ExchangeAddress(..)
|
|
||||||
, SaplingAddress(..)
|
, SaplingAddress(..)
|
||||||
, TransparentAddress(..)
|
, TransparentAddress(..)
|
||||||
, UnifiedAddress(..)
|
, UnifiedAddress(..)
|
||||||
, ValidAddress(..)
|
, ValidAddress(..)
|
||||||
, ValidAddress(..)
|
|
||||||
, ZcashNet(..)
|
, ZcashNet(..)
|
||||||
)
|
)
|
||||||
import ZcashHaskell.Utils (makeZebraCall)
|
import ZcashHaskell.Utils (makeZebraCall)
|
||||||
|
|
@ -54,7 +37,6 @@ import Zenith.Types
|
||||||
, PrivacyPolicy(..)
|
, PrivacyPolicy(..)
|
||||||
, UnifiedAddressDB(..)
|
, UnifiedAddressDB(..)
|
||||||
, ZcashAddress(..)
|
, ZcashAddress(..)
|
||||||
, ZcashPaymentURI(..)
|
|
||||||
, ZcashPool(..)
|
, ZcashPool(..)
|
||||||
)
|
)
|
||||||
|
|
||||||
|
|
@ -70,7 +52,7 @@ displayZec s
|
||||||
| abs s < 100000000 = show (fromIntegral s / 100000) ++ " mZEC"
|
| abs s < 100000000 = show (fromIntegral s / 100000) ++ " mZEC"
|
||||||
| otherwise = show (fromIntegral s / 100000000) ++ " ZEC "
|
| otherwise = show (fromIntegral s / 100000000) ++ " ZEC "
|
||||||
|
|
||||||
-- | Helper function to display small amounts of TAZ
|
-- | Helper function to display small amounts of ZEC
|
||||||
displayTaz :: Integer -> String
|
displayTaz :: Integer -> String
|
||||||
displayTaz s
|
displayTaz s
|
||||||
| abs s < 100 = show s ++ " tazs"
|
| abs s < 100 = show s ++ " tazs"
|
||||||
|
|
@ -266,91 +248,3 @@ getChainTip zHost zPort = do
|
||||||
case r of
|
case r of
|
||||||
Left e1 -> pure 0
|
Left e1 -> pure 0
|
||||||
Right i -> pure i
|
Right i -> pure i
|
||||||
|
|
||||||
-- Function to fetch Zcash price from CoinGecko
|
|
||||||
getZcashPrice :: T.Text -> IO (Maybe Double)
|
|
||||||
getZcashPrice currency = do
|
|
||||||
let url =
|
|
||||||
"https://api.coingecko.com/api/v3/simple/price?ids=zcash&vs_currencies=" <>
|
|
||||||
T.unpack currency
|
|
||||||
response <- httpJSONEither (parseRequest_ url)
|
|
||||||
case getResponseBody response of
|
|
||||||
Right (Object obj)
|
|
||||||
-- Extract "zcash" object
|
|
||||||
-> do
|
|
||||||
case KM.lookup "zcash" obj of
|
|
||||||
Just (Object zcashObj)
|
|
||||||
-- Extract the currency price
|
|
||||||
->
|
|
||||||
case KM.lookup (K.fromText (T.toLower currency)) zcashObj of
|
|
||||||
Just (Number price) -> return (Just (toRealFloat price))
|
|
||||||
_ -> return Nothing
|
|
||||||
_ -> return Nothing
|
|
||||||
_ -> return Nothing
|
|
||||||
|
|
||||||
-- Parse memo result to convert it to a ByteString
|
|
||||||
processEither :: Either String BC.ByteString -> BC.ByteString
|
|
||||||
processEither (Right bs) = bs
|
|
||||||
processEither (Left e) = BC.pack e -- Returns the error message
|
|
||||||
|
|
||||||
-- Parse the query string into key-value pairs
|
|
||||||
parseQuery :: String -> [(String, String)]
|
|
||||||
parseQuery query = map (breakOn '=') (splitOn '&' query)
|
|
||||||
where
|
|
||||||
splitOn :: Char -> String -> [String]
|
|
||||||
splitOn _ [] = [""]
|
|
||||||
splitOn delim (c:cs)
|
|
||||||
| c == delim = "" : rest
|
|
||||||
| otherwise = (c : head rest) : tail rest
|
|
||||||
where
|
|
||||||
rest = splitOn delim cs
|
|
||||||
breakOn :: Char -> String -> (String, String)
|
|
||||||
breakOn delim str = (key, drop 1 value)
|
|
||||||
where
|
|
||||||
(key, value) = span (/= delim) str
|
|
||||||
|
|
||||||
-- Parse a ZIP-321 encoded string into a ZcashPayment structure
|
|
||||||
parseZcashPayment :: String -> Either String ZcashPaymentURI
|
|
||||||
parseZcashPayment input
|
|
||||||
| not (T.isPrefixOf "zcash:" (T.pack input)) = Left "Invalid scheme: must start with 'zcash:'"
|
|
||||||
| otherwise =
|
|
||||||
let (addrPart, queryPart) = break (== '?') (drop 6 input)
|
|
||||||
queryParams = parseQuery (drop 1 queryPart)
|
|
||||||
in Right ZcashPaymentURI
|
|
||||||
{ uriAddress = addrPart
|
|
||||||
, uriAmount = lookup "amount" queryParams >>= readMaybe
|
|
||||||
, uriMemo = case lookup "memo" queryParams of
|
|
||||||
Just m -> T.pack ( BC.unpack (processEither $ decodeBase64Unpadded (BC.pack m) ) )
|
|
||||||
_ -> ""
|
|
||||||
, uriLabel = lookup "label" queryParams
|
|
||||||
, uriMessage = lookup "message" queryParams
|
|
||||||
}
|
|
||||||
|
|
||||||
-- Function to pad a base64 string if it's not a multiple of 4
|
|
||||||
padBase64 :: BC.ByteString -> BC.ByteString
|
|
||||||
padBase64 bs = bs <> BC.replicate paddingLength '='
|
|
||||||
where
|
|
||||||
paddingLength = (4 - BC.length bs `mod` 4) `mod` 4
|
|
||||||
|
|
||||||
-- Function to decode a base64 un-padded string
|
|
||||||
decodeBase64Unpadded :: BC.ByteString -> Either String BC.ByteString
|
|
||||||
decodeBase64Unpadded = B64.decode . padBase64
|
|
||||||
|
|
||||||
-- Function to encode memo as un-padded Base64
|
|
||||||
encodeBase64Memo :: String -> String
|
|
||||||
encodeBase64Memo = BC.unpack . BC.takeWhile (/= '=') . B64.encode . BC.pack
|
|
||||||
|
|
||||||
-- Function to drop trailing zeros
|
|
||||||
dropTrailingZeros :: String -> String
|
|
||||||
dropTrailingZeros str =
|
|
||||||
let withoutZeros = reverse (dropWhile (== '0') (reverse str))
|
|
||||||
in if last withoutZeros == '.'
|
|
||||||
then withoutZeros ++ "0" -- Ensure at least one decimal place
|
|
||||||
else withoutZeros
|
|
||||||
|
|
||||||
-- Function to create a ZIP-321 URI
|
|
||||||
createZip321 :: String -> Maybe Double -> Maybe String -> String
|
|
||||||
createZip321 address mAmount mMemo =
|
|
||||||
"zcash:" ++ address
|
|
||||||
++ maybe "" (\amount -> "?amount=" ++ dropTrailingZeros (printf "%.8f" amount) ) mAmount
|
|
||||||
++ maybe "" (\memo -> "&memo=" ++ escapeURIString isUnreserved (encodeBase64Memo memo)) mMemo
|
|
||||||
|
|
|
||||||
|
|
@ -58,16 +58,7 @@ main = do
|
||||||
zebraPort <- require config "zebraPort"
|
zebraPort <- require config "zebraPort"
|
||||||
zebraHost <- require config "zebraHost"
|
zebraHost <- require config "zebraHost"
|
||||||
nodePort <- require config "nodePort"
|
nodePort <- require config "nodePort"
|
||||||
currencyCode <- require config "currencyCode"
|
let myConfig = Config dbFilePath zebraHost zebraPort nodeUser nodePwd nodePort
|
||||||
let myConfig =
|
|
||||||
Config
|
|
||||||
dbFilePath
|
|
||||||
zebraHost
|
|
||||||
zebraPort
|
|
||||||
nodeUser
|
|
||||||
nodePwd
|
|
||||||
nodePort
|
|
||||||
currencyCode
|
|
||||||
hspec $ do
|
hspec $ do
|
||||||
describe "RPC methods" $ do
|
describe "RPC methods" $ do
|
||||||
beforeAll_ (startAPI myConfig) $ do
|
beforeAll_ (startAPI myConfig) $ do
|
||||||
|
|
|
||||||
77
test/Spec.hs
77
test/Spec.hs
|
|
@ -2,14 +2,13 @@
|
||||||
|
|
||||||
import Codec.Borsh
|
import Codec.Borsh
|
||||||
import Control.Monad (when)
|
import Control.Monad (when)
|
||||||
import Control.Monad.Logger (runNoLoggingT, runNoLoggingT)
|
import Control.Monad.Logger (runFileLoggingT, runNoLoggingT)
|
||||||
import Data.Aeson
|
import Data.Aeson
|
||||||
import qualified Data.ByteString as BS
|
import qualified Data.ByteString as BS
|
||||||
import qualified Data.ByteString.Lazy as LBS
|
import qualified Data.ByteString.Lazy as LBS
|
||||||
import Data.HexString
|
import Data.HexString
|
||||||
import Data.List (foldl')
|
import Data.List (foldl')
|
||||||
import Data.Maybe (fromJust)
|
import Data.Maybe (fromJust)
|
||||||
import qualified Data.Text as T
|
|
||||||
import qualified Data.Text.Encoding as E
|
import qualified Data.Text.Encoding as E
|
||||||
import Database.Persist
|
import Database.Persist
|
||||||
import Database.Persist.Sqlite
|
import Database.Persist.Sqlite
|
||||||
|
|
@ -70,7 +69,6 @@ import Zenith.Core
|
||||||
import Zenith.DB
|
import Zenith.DB
|
||||||
import Zenith.Tree
|
import Zenith.Tree
|
||||||
import Zenith.Types
|
import Zenith.Types
|
||||||
import Zenith.Utils
|
|
||||||
|
|
||||||
main :: IO ()
|
main :: IO ()
|
||||||
main = do
|
main = do
|
||||||
|
|
@ -645,7 +643,8 @@ main = do
|
||||||
case ix of
|
case ix of
|
||||||
Nothing -> assertFailure "couldn't find index at block"
|
Nothing -> assertFailure "couldn't find index at block"
|
||||||
Just i -> do
|
Just i -> do
|
||||||
updatedTree <- runNoLoggingT $ truncateTree oTree i
|
updatedTree <-
|
||||||
|
runFileLoggingT "test.log" $ truncateTree oTree i
|
||||||
let finalAnchor =
|
let finalAnchor =
|
||||||
getOrchardTreeAnchor $
|
getOrchardTreeAnchor $
|
||||||
OrchardCommitmentTree $ ztiOrchard zebraTreesIn
|
OrchardCommitmentTree $ ztiOrchard zebraTreesIn
|
||||||
|
|
@ -738,7 +737,7 @@ main = do
|
||||||
Just ua -> do
|
Just ua -> do
|
||||||
pool <- runNoLoggingT $ initPool "/home/rav/Zenith/zenith.db"
|
pool <- runNoLoggingT $ initPool "/home/rav/Zenith/zenith.db"
|
||||||
tx <-
|
tx <-
|
||||||
runNoLoggingT $
|
runFileLoggingT "zenith.log" $
|
||||||
prepareTxV2
|
prepareTxV2
|
||||||
pool
|
pool
|
||||||
"localhost"
|
"localhost"
|
||||||
|
|
@ -764,7 +763,7 @@ main = do
|
||||||
Just ua -> do
|
Just ua -> do
|
||||||
pool <- runNoLoggingT $ initPool "/home/rav/Zenith/zenith.db"
|
pool <- runNoLoggingT $ initPool "/home/rav/Zenith/zenith.db"
|
||||||
tx <-
|
tx <-
|
||||||
runNoLoggingT $
|
runFileLoggingT "zenith.log" $
|
||||||
prepareTxV2
|
prepareTxV2
|
||||||
pool
|
pool
|
||||||
"localhost"
|
"localhost"
|
||||||
|
|
@ -788,7 +787,7 @@ main = do
|
||||||
Just ua -> do
|
Just ua -> do
|
||||||
pool <- runNoLoggingT $ initPool "/home/rav/Zenith/zenith.db"
|
pool <- runNoLoggingT $ initPool "/home/rav/Zenith/zenith.db"
|
||||||
tx <-
|
tx <-
|
||||||
runNoLoggingT $
|
runFileLoggingT "zenith.log" $
|
||||||
prepareTxV2
|
prepareTxV2
|
||||||
pool
|
pool
|
||||||
"localhost"
|
"localhost"
|
||||||
|
|
@ -816,7 +815,7 @@ main = do
|
||||||
Just ua -> do
|
Just ua -> do
|
||||||
pool <- runNoLoggingT $ initPool "/home/rav/Zenith/zenith.db"
|
pool <- runNoLoggingT $ initPool "/home/rav/Zenith/zenith.db"
|
||||||
tx <-
|
tx <-
|
||||||
runNoLoggingT $
|
runFileLoggingT "zenith.log" $
|
||||||
prepareTxV2
|
prepareTxV2
|
||||||
pool
|
pool
|
||||||
"localhost"
|
"localhost"
|
||||||
|
|
@ -848,7 +847,7 @@ main = do
|
||||||
Just ua -> do
|
Just ua -> do
|
||||||
pool <- runNoLoggingT $ initPool "/home/rav/Zenith/zenith.db"
|
pool <- runNoLoggingT $ initPool "/home/rav/Zenith/zenith.db"
|
||||||
tx <-
|
tx <-
|
||||||
runNoLoggingT $
|
runFileLoggingT "zenith.log" $
|
||||||
prepareTxV2
|
prepareTxV2
|
||||||
pool
|
pool
|
||||||
"localhost"
|
"localhost"
|
||||||
|
|
@ -874,7 +873,7 @@ main = do
|
||||||
Just ua -> do
|
Just ua -> do
|
||||||
pool <- runNoLoggingT $ initPool "/home/rav/Zenith/zenith.db"
|
pool <- runNoLoggingT $ initPool "/home/rav/Zenith/zenith.db"
|
||||||
tx <-
|
tx <-
|
||||||
runNoLoggingT $
|
runFileLoggingT "zenith.log" $
|
||||||
prepareTxV2
|
prepareTxV2
|
||||||
pool
|
pool
|
||||||
"localhost"
|
"localhost"
|
||||||
|
|
@ -898,7 +897,7 @@ main = do
|
||||||
Just ua -> do
|
Just ua -> do
|
||||||
pool <- runNoLoggingT $ initPool "/home/rav/Zenith/zenith.db"
|
pool <- runNoLoggingT $ initPool "/home/rav/Zenith/zenith.db"
|
||||||
tx <-
|
tx <-
|
||||||
runNoLoggingT $
|
runFileLoggingT "zenith.log" $
|
||||||
prepareTxV2
|
prepareTxV2
|
||||||
pool
|
pool
|
||||||
"localhost"
|
"localhost"
|
||||||
|
|
@ -927,7 +926,7 @@ main = do
|
||||||
Just ua -> do
|
Just ua -> do
|
||||||
pool <- runNoLoggingT $ initPool "/home/rav/Zenith/zenith.db"
|
pool <- runNoLoggingT $ initPool "/home/rav/Zenith/zenith.db"
|
||||||
tx <-
|
tx <-
|
||||||
runNoLoggingT $
|
runFileLoggingT "zenith.log" $
|
||||||
prepareTxV2
|
prepareTxV2
|
||||||
pool
|
pool
|
||||||
"localhost"
|
"localhost"
|
||||||
|
|
@ -958,7 +957,7 @@ main = do
|
||||||
Just ua -> do
|
Just ua -> do
|
||||||
pool <- runNoLoggingT $ initPool "/home/rav/Zenith/zenith.db"
|
pool <- runNoLoggingT $ initPool "/home/rav/Zenith/zenith.db"
|
||||||
tx <-
|
tx <-
|
||||||
runNoLoggingT $
|
runFileLoggingT "zenith.log" $
|
||||||
prepareTxV2
|
prepareTxV2
|
||||||
pool
|
pool
|
||||||
"localhost"
|
"localhost"
|
||||||
|
|
@ -984,7 +983,7 @@ main = do
|
||||||
Just ua -> do
|
Just ua -> do
|
||||||
pool <- runNoLoggingT $ initPool "/home/rav/Zenith/zenith.db"
|
pool <- runNoLoggingT $ initPool "/home/rav/Zenith/zenith.db"
|
||||||
tx <-
|
tx <-
|
||||||
runNoLoggingT $
|
runFileLoggingT "zenith.log" $
|
||||||
prepareTxV2
|
prepareTxV2
|
||||||
pool
|
pool
|
||||||
"localhost"
|
"localhost"
|
||||||
|
|
@ -1008,7 +1007,7 @@ main = do
|
||||||
Just ua -> do
|
Just ua -> do
|
||||||
pool <- runNoLoggingT $ initPool "/home/rav/Zenith/zenith.db"
|
pool <- runNoLoggingT $ initPool "/home/rav/Zenith/zenith.db"
|
||||||
tx <-
|
tx <-
|
||||||
runNoLoggingT $
|
runFileLoggingT "zenith.log" $
|
||||||
prepareTxV2
|
prepareTxV2
|
||||||
pool
|
pool
|
||||||
"localhost"
|
"localhost"
|
||||||
|
|
@ -1035,7 +1034,7 @@ main = do
|
||||||
Just ua -> do
|
Just ua -> do
|
||||||
pool <- runNoLoggingT $ initPool "/home/rav/Zenith/zenith.db"
|
pool <- runNoLoggingT $ initPool "/home/rav/Zenith/zenith.db"
|
||||||
tx <-
|
tx <-
|
||||||
runNoLoggingT $
|
runFileLoggingT "zenith.log" $
|
||||||
prepareTxV2
|
prepareTxV2
|
||||||
pool
|
pool
|
||||||
"localhost"
|
"localhost"
|
||||||
|
|
@ -1062,7 +1061,7 @@ main = do
|
||||||
Just ua -> do
|
Just ua -> do
|
||||||
pool <- runNoLoggingT $ initPool "/home/rav/Zenith/zenith.db"
|
pool <- runNoLoggingT $ initPool "/home/rav/Zenith/zenith.db"
|
||||||
tx <-
|
tx <-
|
||||||
runNoLoggingT $
|
runFileLoggingT "zenith.log" $
|
||||||
prepareTxV2
|
prepareTxV2
|
||||||
pool
|
pool
|
||||||
"localhost"
|
"localhost"
|
||||||
|
|
@ -1087,7 +1086,7 @@ main = do
|
||||||
Just ua -> do
|
Just ua -> do
|
||||||
pool <- runNoLoggingT $ initPool "/home/rav/Zenith/zenith.db"
|
pool <- runNoLoggingT $ initPool "/home/rav/Zenith/zenith.db"
|
||||||
tx <-
|
tx <-
|
||||||
runNoLoggingT $
|
runFileLoggingT "zenith.log" $
|
||||||
prepareTxV2
|
prepareTxV2
|
||||||
pool
|
pool
|
||||||
"localhost"
|
"localhost"
|
||||||
|
|
@ -1104,45 +1103,3 @@ main = do
|
||||||
case tx of
|
case tx of
|
||||||
Left e -> assertFailure $ show e
|
Left e -> assertFailure $ show e
|
||||||
Right h -> h `shouldNotBe` hexString "deadbeef"
|
Right h -> h `shouldNotBe` hexString "deadbeef"
|
||||||
describe "Call CoinGecko to get ZEC price" $ do
|
|
||||||
it "Testing for USD " $ do
|
|
||||||
price <- getZcashPrice $ T.pack "usd"
|
|
||||||
case price of
|
|
||||||
Just p -> p `shouldNotBe` 0.0
|
|
||||||
Nothing -> assertFailure "Failed to get ZEC price"
|
|
||||||
describe "Parse an URI payment string (all fields filled) " $ do
|
|
||||||
it ("Parsing URI -> " ++ "zcash:ztestsapling10yy2ex5....") $ do
|
|
||||||
let zcashURI2 =
|
|
||||||
"zcash:ztestsapling10yy2ex5dcqkclhc7z7yrnjq2z6feyjad56ptwlfgmy77dmaqqrl9gyhprdx59qgmsnyfska2kez?amount=100&memo=SGVsbG8sIFdvcmxkIQ==&message=Test"
|
|
||||||
case parseZcashPayment zcashURI2 of
|
|
||||||
Right p -> do
|
|
||||||
print p
|
|
||||||
(uriAmount p) `shouldBe` Just 100.0
|
|
||||||
Left e -> assertFailure $ "Error: " ++ e
|
|
||||||
describe
|
|
||||||
"Parse an URI payment string (just address and amount fields provided) " $ do
|
|
||||||
it ("Parsing URI -> " ++ "zcash:ztestsapling10yy2ex5....") $ do
|
|
||||||
let zcashURI3 =
|
|
||||||
"zcash:ztestsapling10yy2ex5dcqkclhc7z7yrnjq2z6feyjad56ptwlfgmy77dmaqqrl9gyhprdx59qgmsnyfska2kez?amount=100"
|
|
||||||
case parseZcashPayment zcashURI3 of
|
|
||||||
Right p -> do
|
|
||||||
print p
|
|
||||||
(uriAmount p) `shouldBe` Just 100.0
|
|
||||||
Left e -> assertFailure $ "Error: " ++ e
|
|
||||||
describe "Parse an URI payment string (invalid URI provided) " $ do
|
|
||||||
it ("Parsing URI -> " ++ "zcash:ztestsapling10yy2ex5....") $ do
|
|
||||||
let zcashURI3 =
|
|
||||||
"z:ztestsapling10yy2ex5dcqkclhc7z7yrnjq2z6feyjad56ptwlfgmy77dmaqqrl9gyhprdx59qgmsnyfska2kez?amount=100"
|
|
||||||
case parseZcashPayment zcashURI3 of
|
|
||||||
Right p -> do
|
|
||||||
print p
|
|
||||||
(uriAmount p) `shouldBe` Just 100.0
|
|
||||||
Left e -> assertFailure $ "Error: " ++ e
|
|
||||||
describe "Create a ZIP-321 URI payment string " $ do
|
|
||||||
it "Creating an URI using a valid Zcash address, an amount, and a memo " $ do
|
|
||||||
let address = "ztestsapling10yy2ex5dcqkclhc7z7yrnjq2z6feyjad56ptwlfgmy77dmaqqrl9gyhprdx59qgmsnyfska2kez"
|
|
||||||
let amount = Just 1.2345
|
|
||||||
let memo = Just "This is a simple memo."
|
|
||||||
let uriString = createZip321 address amount memo
|
|
||||||
print uriString
|
|
||||||
uriString `shouldBe` "zcash:ztestsapling10yy2ex5dcqkclhc7z7yrnjq2z6feyjad56ptwlfgmy77dmaqqrl9gyhprdx59qgmsnyfska2kez?amount=1.2345&memo=VGhpcyBpcyBhIHNpbXBsZSBtZW1vLg"
|
|
||||||
|
|
|
||||||
|
|
@ -96,8 +96,6 @@ library
|
||||||
, vty-crossplatform
|
, vty-crossplatform
|
||||||
, word-wrap
|
, word-wrap
|
||||||
, zcash-haskell
|
, zcash-haskell
|
||||||
, unordered-containers
|
|
||||||
, network-uri
|
|
||||||
--pkgconfig-depends: rustzcash_wrapper
|
--pkgconfig-depends: rustzcash_wrapper
|
||||||
default-language: Haskell2010
|
default-language: Haskell2010
|
||||||
|
|
||||||
|
|
|
||||||
35
zenith.cfg
35
zenith.cfg
|
|
@ -1,38 +1,5 @@
|
||||||
#
|
|
||||||
# Zenith Configuration File
|
|
||||||
#
|
|
||||||
# -------------------------------------------------------------
|
|
||||||
# nodeUser -
|
|
||||||
# -------------------------------------------------------------
|
|
||||||
nodeUser = "user"
|
nodeUser = "user"
|
||||||
# -------------------------------------------------------------
|
|
||||||
# nodePwd -
|
|
||||||
nodePwd = "superSecret"
|
nodePwd = "superSecret"
|
||||||
# -------------------------------------------------------------
|
dbFilePath = "zenith.db"
|
||||||
# dbFileName - contains the SQLite database name used for
|
|
||||||
# keeping all Zenith's data
|
|
||||||
# default = zenith.db
|
|
||||||
#
|
|
||||||
dbFileName = "zenith.db"
|
|
||||||
# -------------------------------------------------------------
|
|
||||||
# zebraHost - Zebra IP
|
|
||||||
# Default - "127.0.0.1"
|
|
||||||
zebraHost = "127.0.0.1"
|
zebraHost = "127.0.0.1"
|
||||||
# -------------------------------------------------------------
|
|
||||||
# zebraPort - Port used for access Zebra API endpoints
|
|
||||||
# must be the same port configured for your
|
|
||||||
# Zebra node
|
|
||||||
zebraPort = 18232
|
zebraPort = 18232
|
||||||
# -------------------------------------------------------------
|
|
||||||
# currencyCode - ISO 4217 currency code
|
|
||||||
#
|
|
||||||
# Example of currency codes are:
|
|
||||||
#
|
|
||||||
# United States -> currencyCode = "usd"
|
|
||||||
# Canada -> currencyCode = "cnd"
|
|
||||||
# Australia -> currencyCode = "aud"
|
|
||||||
# Euro Region -> currencyCode = "eur"
|
|
||||||
# Great Britain -> currencyCode = "gbp"
|
|
||||||
# Japan -> currencyCode = "jpy"
|
|
||||||
#
|
|
||||||
currencyCode = "usd"
|
|
||||||
|
|
|
||||||
Loading…
Reference in a new issue