Compare commits
No commits in common. "772025e31780d9d96dfe4ce36773df767cb91643" and "0b70bbb8dedd948b1c526aa3dbfa90d2cd537f16" have entirely different histories.
772025e317
...
0b70bbb8de
2 changed files with 40 additions and 39 deletions
|
@ -2,7 +2,7 @@
|
||||||
{-# LANGUAGE TypeApplications #-}
|
{-# LANGUAGE TypeApplications #-}
|
||||||
{-# LANGUAGE OverloadedStrings #-}
|
{-# LANGUAGE OverloadedStrings #-}
|
||||||
{-# LANGUAGE ScopedTypeVariables #-}
|
{-# LANGUAGE ScopedTypeVariables #-}
|
||||||
|
{-# LANGUAGE BlockArguments #-}
|
||||||
|
|
||||||
module Zenith.CLI where
|
module Zenith.CLI where
|
||||||
|
|
||||||
|
@ -192,10 +192,10 @@ data State = State
|
||||||
, _eventDispatch :: !(BC.BChan Tick)
|
, _eventDispatch :: !(BC.BChan Tick)
|
||||||
, _timer :: !Int
|
, _timer :: !Int
|
||||||
, _txForm :: !(Form SendInput () Name)
|
, _txForm :: !(Form SendInput () Name)
|
||||||
, _abAddresses :: !(L.List Name (Entity AddressBook))
|
, _abaddresses :: !(L.List Name (Entity AddressBook))
|
||||||
, _abForm :: !(Form AdrBookEntry () Name)
|
, _abForm :: !(Form AdrBookEntry () Name)
|
||||||
, _abCurAdrs :: !T.Text -- used for address book CRUD operations
|
, _abCurAdrs :: !T.Text
|
||||||
, _abTxt :: !T.Text -- Holds the Address Book entry data to show
|
, _abTxt :: !T.Text
|
||||||
}
|
}
|
||||||
|
|
||||||
makeLenses ''State
|
makeLenses ''State
|
||||||
|
@ -379,7 +379,7 @@ drawUI s = [splashDialog s, helpDialog s, displayDialog s, inputDialog s, ui s]
|
||||||
hLimit 50 $
|
hLimit 50 $
|
||||||
vBox [vLimit 16 $
|
vBox [vLimit 16 $
|
||||||
hLimit 50 $
|
hLimit 50 $
|
||||||
vBox $ [ L.renderList listDrawAB True (s ^. abAddresses) ],
|
vBox $ [ L.renderList listDrawAB True (s ^. abaddresses) ],
|
||||||
padTop Max $
|
padTop Max $
|
||||||
vLimit 4 $
|
vLimit 4 $
|
||||||
hLimit 50 $
|
hLimit 50 $
|
||||||
|
@ -1046,50 +1046,50 @@ appEvent (BT.VtyEvent e) = do
|
||||||
BT.modify $ set dialogBox Blank
|
BT.modify $ set dialogBox Blank
|
||||||
V.EvKey (V.KChar 'c') [] -> do
|
V.EvKey (V.KChar 'c') [] -> do
|
||||||
-- Copy Address to Clipboard
|
-- Copy Address to Clipboard
|
||||||
case L.listSelectedElement $ s ^. abAddresses of
|
case L.listSelectedElement $ s ^. abaddresses of
|
||||||
Just (_, a) -> do
|
Just (_, a) -> do
|
||||||
liftIO $
|
liftIO $
|
||||||
setClipboard $
|
setClipboard $
|
||||||
T.unpack $ addressBookAbaddress (entityVal a)
|
T.unpack $ addressBookAddress (entityVal a)
|
||||||
BT.modify $
|
BT.modify $
|
||||||
set msg $
|
set msg $
|
||||||
"Address copied to Clipboard from >>\n" ++
|
"Address copied to Clipboard from >>\n" ++
|
||||||
T.unpack (addressBookDescrip (entityVal a)) ++ "->\n" ++
|
T.unpack (addressBookDescrip (entityVal a)) ++ "->\n" ++
|
||||||
T.unpack (addressBookAbaddress (entityVal a)) ++ "!"
|
T.unpack (addressBookAddress (entityVal a)) ++ "!"
|
||||||
BT.modify $ set displayBox MsgDisplay
|
BT.modify $ set displayBox MsgDisplay
|
||||||
_ -> do
|
_ -> do
|
||||||
BT.modify $ set msg "Error while copying the address!!"
|
BT.modify $ set msg "Error while copying the address!!"
|
||||||
BT.modify $ set displayBox MsgDisplay
|
BT.modify $ set displayBox MsgDisplay
|
||||||
-- Send Zcash transaction
|
-- Send Zcash transaction
|
||||||
V.EvKey (V.KChar 's') [] -> do
|
V.EvKey (V.KChar 's') [] -> do
|
||||||
case L.listSelectedElement $ s ^. abAddresses of
|
case L.listSelectedElement $ s ^. abaddresses of
|
||||||
Just (_, a) -> do
|
Just (_, a) -> do
|
||||||
BT.modify $
|
BT.modify $
|
||||||
set txForm $
|
set txForm $
|
||||||
mkSendForm (s ^. balance) (SendInput (addressBookAbaddress (entityVal a)) 0.0 "")
|
mkSendForm (s ^. balance) (SendInput (addressBookAddress (entityVal a)) 0.0 "")
|
||||||
BT.modify $ set dialogBox SendTx
|
BT.modify $ set dialogBox SendTx
|
||||||
_ -> do
|
_ -> do
|
||||||
BT.modify $ set msg "No receiver address available!!"
|
BT.modify $ set msg "No receiver address available!!"
|
||||||
BT.modify $ set displayBox MsgDisplay
|
BT.modify $ set displayBox MsgDisplay
|
||||||
-- Edit an entry in Address Book
|
-- Edit an entry in Address Book
|
||||||
V.EvKey (V.KChar 'e') [] -> do
|
V.EvKey (V.KChar 'e') [] -> do
|
||||||
case L.listSelectedElement $ s ^. abAddresses of
|
case L.listSelectedElement $ s ^. abaddresses of
|
||||||
Just (_, a) -> do
|
Just (_, a) -> do
|
||||||
BT.modify $ set abCurAdrs (addressBookAbaddress (entityVal a))
|
BT.modify $ set abCurAdrs (addressBookAddress (entityVal a))
|
||||||
BT.modify $
|
BT.modify $
|
||||||
set abForm $
|
set abForm $
|
||||||
mkNewABForm (AdrBookEntry (addressBookDescrip (entityVal a)) (addressBookAbaddress (entityVal a)))
|
mkNewABForm (AdrBookEntry (addressBookDescrip (entityVal a)) (addressBookAddress (entityVal a)))
|
||||||
BT.modify $ set dialogBox AdrBookUpdForm
|
BT.modify $ set dialogBox AdrBookUpdForm
|
||||||
_ -> do
|
_ -> do
|
||||||
BT.modify $ set dialogBox Blank
|
BT.modify $ set dialogBox Blank
|
||||||
-- Delete an entry from Address Book
|
-- Delete an entry from Address Book
|
||||||
V.EvKey (V.KChar 'd') [] -> do
|
V.EvKey (V.KChar 'd') [] -> do
|
||||||
case L.listSelectedElement $ s ^. abAddresses of
|
case L.listSelectedElement $ s ^. abaddresses of
|
||||||
Just (_, a) -> do
|
Just (_, a) -> do
|
||||||
BT.modify $ set abCurAdrs (addressBookAbaddress (entityVal a))
|
BT.modify $ set abCurAdrs (addressBookAddress (entityVal a))
|
||||||
BT.modify $
|
BT.modify $
|
||||||
set abForm $
|
set abForm $
|
||||||
mkNewABForm (AdrBookEntry (addressBookDescrip (entityVal a)) (addressBookAbaddress (entityVal a)))
|
mkNewABForm (AdrBookEntry (addressBookDescrip (entityVal a)) (addressBookAddress (entityVal a)))
|
||||||
BT.modify $ set dialogBox AdrBookDelForm
|
BT.modify $ set dialogBox AdrBookDelForm
|
||||||
_ -> do
|
_ -> do
|
||||||
BT.modify $ set dialogBox Blank
|
BT.modify $ set dialogBox Blank
|
||||||
|
@ -1099,18 +1099,18 @@ appEvent (BT.VtyEvent e) = do
|
||||||
BT.modify $ set dialogBox AdrBookForm
|
BT.modify $ set dialogBox AdrBookForm
|
||||||
-- Show AddressBook entry data
|
-- Show AddressBook entry data
|
||||||
V.EvKey V.KEnter [] -> do
|
V.EvKey V.KEnter [] -> do
|
||||||
case L.listSelectedElement $ s ^. abAddresses of
|
case L.listSelectedElement $ s ^. abaddresses of
|
||||||
Just (_, a) -> do
|
Just (_, a) -> do
|
||||||
BT.modify $ set abTxt $ T.pack $
|
BT.modify $ set abTxt $ T.pack $
|
||||||
" Descr: " ++
|
" Descr: " ++
|
||||||
T.unpack (addressBookDescrip (entityVal a)) ++
|
T.unpack (addressBookDescrip (entityVal a)) ++
|
||||||
"\n Address: " ++
|
"\n Address: " ++
|
||||||
T.unpack (addressBookAbaddress (entityVal a))
|
T.unpack (addressBookAddress (entityVal a))
|
||||||
BT.modify $ set displayBox AdrBookEntryDisplay
|
BT.modify $ set displayBox AdrBookEntryDisplay
|
||||||
_ -> do
|
_ -> do
|
||||||
BT.modify $ set dialogBox Blank
|
BT.modify $ set dialogBox Blank
|
||||||
-- Process any other event
|
-- Process any other event
|
||||||
ev -> BT.zoom abAddresses $ L.handleListEvent ev
|
ev -> BT.zoom abaddresses $ L.handleListEvent ev
|
||||||
-- Process new address book entry
|
-- Process new address book entry
|
||||||
AdrBookForm -> do
|
AdrBookForm -> do
|
||||||
case e of
|
case e of
|
||||||
|
@ -1218,7 +1218,7 @@ appEvent (BT.VtyEvent e) = do
|
||||||
Just TList ->
|
Just TList ->
|
||||||
BT.zoom transactions $ L.handleListEvent ev
|
BT.zoom transactions $ L.handleListEvent ev
|
||||||
Just ABList ->
|
Just ABList ->
|
||||||
BT.zoom abAddresses $ L.handleListEvent ev
|
BT.zoom abaddresses $ L.handleListEvent ev
|
||||||
_anyName -> return ()
|
_anyName -> return ()
|
||||||
where
|
where
|
||||||
printMsg :: String -> BT.EventM Name State ()
|
printMsg :: String -> BT.EventM Name State ()
|
||||||
|
@ -1322,7 +1322,7 @@ runZenithCLI config = do
|
||||||
else Blank)
|
else Blank)
|
||||||
True
|
True
|
||||||
(mkInputForm $ DialogInput "Main")
|
(mkInputForm $ DialogInput "Main")
|
||||||
(F.focusRing [AList, TList])
|
(F.focusRing [AList, TList,ABList])
|
||||||
(zgb_blocks chainInfo)
|
(zgb_blocks chainInfo)
|
||||||
dbFilePath
|
dbFilePath
|
||||||
host
|
host
|
||||||
|
@ -1485,18 +1485,18 @@ refreshAddressBook :: State -> IO State
|
||||||
refreshAddressBook s = do
|
refreshAddressBook s = do
|
||||||
pool <- runNoLoggingT $ initPool $ s ^. dbPath
|
pool <- runNoLoggingT $ initPool $ s ^. dbPath
|
||||||
selAddress <-
|
selAddress <-
|
||||||
do case L.listSelectedElement $ s ^. abAddresses of
|
do case L.listSelectedElement $ s ^. abaddresses of
|
||||||
Nothing -> do
|
Nothing -> do
|
||||||
let fAdd =
|
let fAdd =
|
||||||
L.listSelectedElement $ L.listMoveToBeginning $ s ^. abAddresses
|
L.listSelectedElement $ L.listMoveToBeginning $ s ^. abaddresses
|
||||||
return fAdd
|
return fAdd
|
||||||
Just a2 -> return $ Just a2
|
Just a2 -> return $ Just a2
|
||||||
case selAddress of
|
case selAddress of
|
||||||
Nothing -> return s
|
Nothing -> return s
|
||||||
Just (_i, a) -> do
|
Just (_i, a) -> do
|
||||||
abookList <- getAdrBook pool (s ^. network)
|
abookList <- getAdrBook pool (s ^. network)
|
||||||
let tL' = L.listReplace (Vec.fromList abookList) (Just 0) (s ^. abAddresses)
|
let tL' = L.listReplace (Vec.fromList abookList) (Just 0) (s ^. abaddresses)
|
||||||
return $ s & abAddresses .~ tL'
|
return $ s & abaddresses .~ tL'
|
||||||
|
|
||||||
addNewAddress :: T.Text -> Scope -> State -> IO State
|
addNewAddress :: T.Text -> Scope -> State -> IO State
|
||||||
addNewAddress n scope s = do
|
addNewAddress n scope s = do
|
||||||
|
|
|
@ -15,6 +15,7 @@
|
||||||
{-# LANGUAGE FlexibleInstances #-}
|
{-# LANGUAGE FlexibleInstances #-}
|
||||||
{-# LANGUAGE TypeOperators #-}
|
{-# LANGUAGE TypeOperators #-}
|
||||||
{-# LANGUAGE TypeApplications #-}
|
{-# LANGUAGE TypeApplications #-}
|
||||||
|
{-# LANGUAGE BlockArguments #-}
|
||||||
|
|
||||||
module Zenith.DB where
|
module Zenith.DB where
|
||||||
|
|
||||||
|
@ -249,8 +250,8 @@ share
|
||||||
AddressBook
|
AddressBook
|
||||||
network ZcashNetDB
|
network ZcashNetDB
|
||||||
descrip T.Text
|
descrip T.Text
|
||||||
abaddress T.Text
|
address T.Text
|
||||||
UniqueABA abaddress
|
UniqueABA address
|
||||||
deriving Show Eq
|
deriving Show Eq
|
||||||
|]
|
|]
|
||||||
|
|
||||||
|
@ -1500,19 +1501,19 @@ updateAdrsInAdrBook pool d a ia = do
|
||||||
PS.retryOnBusy $
|
PS.retryOnBusy $
|
||||||
flip PS.runSqlPool pool $ do
|
flip PS.runSqlPool pool $ do
|
||||||
update $ \ab -> do
|
update $ \ab -> do
|
||||||
set ab [AddressBookDescrip =. val d, AddressBookAbaddress =. val a]
|
set ab [AddressBookDescrip =. val d, AddressBookAddress =. val a]
|
||||||
where_ $ ab ^. AddressBookAbaddress ==. val ia
|
where_ $ ab ^. AddressBookAddress ==. val ia
|
||||||
|
|
||||||
-- | Get one AddrssBook record using the Address as a key
|
-- | Get one AddrssBook record using the Address as a key
|
||||||
-- getABookRec :: ConnectionPool -> T.Tex t -> IO (Maybe (Entity AddressBook))
|
getABookRec :: ConnectionPool -> T.Text -> IO [Entity AddressBook]
|
||||||
-- getABookRec pool a = do
|
getABookRec pool a = do
|
||||||
-- runNoLoggingT $
|
runNoLoggingT $
|
||||||
-- PS.retryOnBusy $
|
PS.retryOnBusy $
|
||||||
-- flip PS.runSqlPool pool $
|
flip PS.runSqlPool pool $
|
||||||
-- select $ do
|
select $ do
|
||||||
-- adrbook <- from $ table @AddressBook
|
adrbook <- from $ table @AddressBook
|
||||||
-- where_ ((adrbook ^. AddressBookAbaddress) ==. val a)
|
where_ ((adrbook ^. AddressBookAddress) ==. val a)
|
||||||
-- return adrbook
|
return adrbook
|
||||||
|
|
||||||
-- | delete an existing address from AddressBook
|
-- | delete an existing address from AddressBook
|
||||||
deleteAdrsFromAB :: ConnectionPool -> T.Text -> IO ()
|
deleteAdrsFromAB :: ConnectionPool -> T.Text -> IO ()
|
||||||
|
@ -1522,7 +1523,7 @@ deleteAdrsFromAB pool ia = do
|
||||||
flip PS.runSqlPool pool $ do
|
flip PS.runSqlPool pool $ do
|
||||||
delete $ do
|
delete $ do
|
||||||
ab <- from $ table @AddressBook
|
ab <- from $ table @AddressBook
|
||||||
where_ (ab ^. AddressBookAbaddress ==. val ia)
|
where_ (ab ^. AddressBookAddress ==. val ia)
|
||||||
|
|
||||||
rmdups :: Ord a => [a] -> [a]
|
rmdups :: Ord a => [a] -> [a]
|
||||||
rmdups = map head . group . sort
|
rmdups = map head . group . sort
|
||||||
|
|
Loading…
Reference in a new issue