Implement UI elements for sending transactions

CHANGELOG.md

@@ -20,7 +20,12 @@ and this project adheres to [Semantic Versioning](https://semver.org/spec/v2.0.0
 - Dialog to add new account
 - Dialog to add new wallet
 - Dialog to display transaction details and copy TX ID
+- Dialog to send a new transaction
+- Dialog to display Tx ID after successful broadcast
 
+### Fixed
+
+- Validation of input of amount for sending in TUI
 
 ## [0.5.3.0-beta]
 

src/Zenith/CLI.hs

@@ -25,7 +25,7 @@ import Brick.Forms
 import qualified Brick.Main as M
 import qualified Brick.Types as BT
 import Brick.Types (Widget)
-import Brick.Util (bg, clamp, fg, on, style)
+import Brick.Util (bg, fg, on, style)
 import qualified Brick.Widgets.Border as B
 import Brick.Widgets.Border.Style (unicode, unicodeBold)
 import qualified Brick.Widgets.Center as C
@@ -82,8 +82,7 @@ import ZcashHaskell.Keys (generateWalletSeedPhrase, getWalletSeed)
 import ZcashHaskell.Orchard (getSaplingFromUA, isValidUnifiedAddress)
 import ZcashHaskell.Sapling (decodeSaplingAddress, isValidShieldedAddress)
 import ZcashHaskell.Transparent
-  ( decodeExchangeAddress
+  ( decodeTransparentAddress
-  , decodeTransparentAddress
   , encodeTransparentReceiver
   )
 import ZcashHaskell.Types
@@ -97,7 +96,15 @@ import Zenith.Types
   , UnifiedAddressDB(..)
   , ZcashNetDB(..)
   )
-import Zenith.Utils (displayTaz, displayZec, jsonNumber, showAddress)
+import Zenith.Utils
+  ( displayTaz
+  , displayZec
+  , isRecipientValid
+  , jsonNumber
+  , parseAddress
+  , showAddress
+  , validBarValue
+  )
 
 data Name
   = WList
@@ -498,23 +505,10 @@ mkSendForm bal =
     ]
   where
     isAmountValid :: Integer -> Float -> Bool
-    isAmountValid b i = (fromIntegral b * 100000000.0) >= i
+    isAmountValid b i = (fromIntegral b / 100000000.0) >= i
     label s w =
       padBottom (Pad 1) $ vLimit 1 (hLimit 15 $ str s <+> fill ' ') <+> w
 
-isRecipientValid :: T.Text -> Bool
-isRecipientValid a =
-  case isValidUnifiedAddress (E.encodeUtf8 a) of
-    Just _a1 -> True
-    Nothing ->
-      isValidShieldedAddress (E.encodeUtf8 a) ||
-      (case decodeTransparentAddress (E.encodeUtf8 a) of
-         Just _a3 -> True
-         Nothing ->
-           case decodeExchangeAddress a of
-             Just _a4 -> True
-             Nothing -> False)
-
 listDrawElement :: (Show a) => Bool -> a -> Widget Name
 listDrawElement sel a =
   let selStr s =
@@ -589,9 +583,6 @@ barDoneAttr = A.attrName "done"
 barToDoAttr :: A.AttrName
 barToDoAttr = A.attrName "remaining"
 
-validBarValue :: Float -> Float
-validBarValue = clamp 0 1
-
 scanZebra :: T.Text -> T.Text -> Int -> Int -> BC.BChan Tick -> IO ()
 scanZebra dbP zHost zPort b eChan = do
   _ <- liftIO $ initDb dbP
@@ -1285,36 +1276,22 @@ sendTransaction ::
   -> IO ()
 sendTransaction pool chan zHost zPort znet accId bl amt ua memo = do
   BC.writeBChan chan $ TickMsg "Preparing transaction..."
-  outUA <- parseAddress ua
+  case parseAddress ua znet of
-  res <-
+    Nothing -> BC.writeBChan chan $ TickMsg "Incorrect address"
-    runFileLoggingT "zenith.log" $
+    Just outUA -> do
-    prepareTx pool zHost zPort znet accId bl amt outUA memo
+      res <-
-  BC.writeBChan chan $ TickMsg "Transaction ready, sending to Zebra..."
+        runFileLoggingT "zenith.log" $
-  case res of
+        prepareTx pool zHost zPort znet accId bl amt outUA memo
-    Left e -> BC.writeBChan chan $ TickMsg $ show e
+      BC.writeBChan chan $ TickMsg "Transaction ready, sending to Zebra..."
-    Right rawTx -> do
+      case res of
-      resp <-
+        Left e -> BC.writeBChan chan $ TickMsg $ show e
-        makeZebraCall
+        Right rawTx -> do
-          zHost
+          resp <-
-          zPort
+            makeZebraCall
-          "sendrawtransaction"
+              zHost
-          [Data.Aeson.String $ toText rawTx]
+              zPort
-      case resp of
+              "sendrawtransaction"
-        Left e1 -> BC.writeBChan chan $ TickMsg $ "Zebra error: " ++ show e1
+              [Data.Aeson.String $ toText rawTx]
-        Right txId -> BC.writeBChan chan $ TickTx txId
+          case resp of
-  where
+            Left e1 -> BC.writeBChan chan $ TickMsg $ "Zebra error: " ++ show e1
-    parseAddress :: T.Text -> IO UnifiedAddress
+            Right txId -> BC.writeBChan chan $ TickTx txId
-    parseAddress a =
-      case isValidUnifiedAddress (E.encodeUtf8 a) of
-        Just a1 -> return a1
-        Nothing ->
-          case decodeSaplingAddress (E.encodeUtf8 a) of
-            Just a2 ->
-              return $
-              UnifiedAddress znet Nothing (Just $ sa_receiver a2) Nothing
-            Nothing ->
-              case decodeTransparentAddress (E.encodeUtf8 a) of
-                Just a3 ->
-                  return $
-                  UnifiedAddress znet Nothing Nothing (Just $ ta_receiver a3)
-                Nothing -> throwIO $ userError "Incorrect address"

src/Zenith/GUI.hs

@@ -7,8 +7,11 @@ import Codec.Picture
 import Codec.Picture.Types (pixelFold, promoteImage)
 import Codec.QRCode
 import Codec.QRCode.JuicyPixels
+import Control.Concurrent (threadDelay)
 import Control.Exception (throwIO, try)
-import Control.Monad.Logger (runNoLoggingT)
+import Control.Monad.IO.Class (liftIO)
+import Control.Monad.Logger (runFileLoggingT, runNoLoggingT)
+import Data.Aeson
 import qualified Data.ByteString as BS
 import qualified Data.ByteString.Lazy as LBS
 import Data.HexString (toText)
@@ -23,13 +26,15 @@ import Lens.Micro.TH
 import Monomer
 import qualified Monomer.Lens as L
 import System.Hclip
+import Text.Printf
 import Text.Wrap (FillScope(..), FillStrategy(..), WrapSettings(..), wrapText)
 import TextShow hiding (toText)
 import ZcashHaskell.Keys (generateWalletSeedPhrase)
 import ZcashHaskell.Orchard (getSaplingFromUA, isValidUnifiedAddress)
 import ZcashHaskell.Transparent (encodeTransparentReceiver)
 import ZcashHaskell.Types
-  ( Phrase(..)
+  ( BlockResponse(..)
+  , Phrase(..)
   , Scope(..)
   , ToBytes(..)
   , UnifiedAddress(..)
@@ -37,11 +42,20 @@ import ZcashHaskell.Types
   , ZebraGetBlockChainInfo(..)
   , ZebraGetInfo(..)
   )
+import ZcashHaskell.Utils (getBlockTime, makeZebraCall)
 import Zenith.Core
 import Zenith.DB
 import Zenith.GUI.Theme
+import Zenith.Scanner (processTx)
 import Zenith.Types hiding (ZcashAddress(..))
-import Zenith.Utils (displayAmount, showAddress)
+import Zenith.Utils
+  ( displayAmount
+  , isRecipientValid
+  , jsonNumber
+  , parseAddress
+  , showAddress
+  , validBarValue
+  )
 
 data AppEvent
   = AppInit
@@ -71,11 +85,20 @@ data AppEvent
   | SaveAccount !(Maybe (Entity ZcashWallet))
   | SaveWallet
   | CloseSeed
+  | CloseTxId
   | ShowSeed
   | CopySeed !T.Text
   | CopyTx !T.Text
   | CloseTx
   | ShowTx !Int
+  | TickUp
+  | SyncVal !Float
+  | SendTx
+  | ShowSend
+  | CancelSend
+  | CheckRecipient !T.Text
+  | CheckAmount !Float
+  | ShowTxId !T.Text
   deriving (Eq, Show)
 
 data AppModel = AppModel
@@ -108,6 +131,15 @@ data AppModel = AppModel
   , _showSeed :: !Bool
   , _modalMsg :: !(Maybe T.Text)
   , _showTx :: !(Maybe Int)
+  , _timer :: !Int
+  , _barValue :: !Float
+  , _openSend :: !Bool
+  , _sendRecipient :: !T.Text
+  , _sendAmount :: !Float
+  , _sendMemo :: !T.Text
+  , _recipientValid :: !Bool
+  , _amountValid :: !Bool
+  , _showId :: !(Maybe T.Text)
   } deriving (Eq, Show)
 
 makeLenses ''AppModel
@@ -145,6 +177,8 @@ buildUI wenv model = widgetTree
         , confirmOverlay `nodeVisible` isJust (model ^. confirmTitle)
         , seedOverlay `nodeVisible` model ^. showSeed
         , txOverlay `nodeVisible` isJust (model ^. showTx)
+        , sendTxOverlay `nodeVisible` model ^. openSend
+        , txIdOverlay `nodeVisible` isJust (model ^. showId)
         , msgOverlay `nodeVisible` isJust (model ^. msg)
         , modalOverlay `nodeVisible` isJust (model ^. modalMsg)
         ]
@@ -275,7 +309,12 @@ buildUI wenv model = widgetTree
     mainPane =
       box_ [alignMiddle] $
       hstack
-        [addressBox, txBox `nodeVisible` not (null $ model ^. transactions)]
+        [ addressBox
+        , vstack
+            [ mainButton "Send" ShowSend
+            , txBox `nodeVisible` not (null $ model ^. transactions)
+            ]
+        ]
     balanceBox =
       hstack
         [ filler
@@ -456,6 +495,8 @@ buildUI wenv model = widgetTree
             ("Last block sync: " <>
              maybe "N/A" (showt . zcashWalletLastSync . entityVal) currentWallet) `styleBasic`
           [padding 3, textSize 8]
+        , spacer
+        , label (showt $ model ^. timer) `styleBasic` [padding 3, textSize 8]
         , filler
         , image_ "./assets/1F993.png" [fitHeight] `styleBasic`
           [height 24, width 24] `nodeVisible`
@@ -489,6 +530,73 @@ buildUI wenv model = widgetTree
         , cancelCaption $ model ^. confirmCancel
         ]
         (hstack [label "Name:", filler, textField_ mainInput [maxLength 25]])
+    sendTxOverlay =
+      box
+        (vstack
+           [ filler
+           , hstack
+               [ filler
+               , box_
+                   []
+                   (vstack
+                      [ box_
+                          [alignMiddle]
+                          (label "Send Zcash" `styleBasic`
+                           [textFont "Bold", textSize 12])
+                      , separatorLine `styleBasic` [fgColor btnColor]
+                      , spacer
+                      , hstack
+                          [ label "To:" `styleBasic` [width 50]
+                          , spacer
+                          , textField_ sendRecipient [onChange CheckRecipient] `styleBasic`
+                            [ width 150
+                            , styleIf
+                                (not $ model ^. recipientValid)
+                                (textColor red)
+                            ]
+                          ]
+                      , hstack
+                          [ label "Amount:" `styleBasic` [width 50]
+                          , spacer
+                          , numericField_
+                              sendAmount
+                              [ decimals 8
+                              , minValue 0.0
+                              , maxValue
+                                  (fromIntegral (model ^. balance) / 100000000.0)
+                              , validInput amountValid
+                              , onChange CheckAmount
+                              ] `styleBasic`
+                            [ width 150
+                            , styleIf
+                                (not $ model ^. amountValid)
+                                (textColor red)
+                            ]
+                          ]
+                      , hstack
+                          [ label "Memo:" `styleBasic` [width 50]
+                          , spacer
+                          , textArea sendMemo `styleBasic`
+                            [width 150, height 40]
+                          ]
+                      , spacer
+                      , box_
+                          [alignMiddle]
+                          (hstack
+                             [ spacer
+                             , button "Cancel" CancelSend
+                             , spacer
+                             , mainButton "Send" SendTx `nodeEnabled`
+                               (model ^. amountValid && model ^. recipientValid)
+                             , spacer
+                             ])
+                      ]) `styleBasic`
+                 [radius 4, border 2 btnColor, bgColor white, padding 4]
+               , filler
+               ]
+           , filler
+           ]) `styleBasic`
+      [bgColor (white & L.a .~ 0.5)]
     seedOverlay =
       alert CloseSeed $
       vstack
@@ -602,6 +710,31 @@ buildUI wenv model = widgetTree
                    ]) `styleBasic`
               [padding 2, bgColor white, width 280, borderB 1 gray]
             ]
+    txIdOverlay =
+      case model ^. showId of
+        Nothing -> alert CloseTxId $ label "N/A"
+        Just t ->
+          alert CloseTxId $
+          box_
+            [alignLeft]
+            (vstack
+               [ box_ [alignMiddle] $
+                 label "Transaction Sent!" `styleBasic` [textFont "Bold"]
+               , spacer
+               , hstack
+                   [ label "Tx ID " `styleBasic` [width 60, textFont "Bold"]
+                   , separatorLine `styleBasic` [fgColor btnColor]
+                   , spacer
+                   , label_ (txtWrap t) [multiline]
+                   , spacer
+                   , box_
+                       [onClick $ CopyTx t]
+                       (remixIcon remixFileCopyFill `styleBasic`
+                        [textColor white]) `styleBasic`
+                     [cursorHand, bgColor btnColor, radius 2, padding 2]
+                   ]
+               ]) `styleBasic`
+          [padding 2, bgColor white, width 280, borderB 1 gray, borderT 1 gray]
 
 generateQRCodes :: Config -> IO ()
 generateQRCodes config = do
@@ -679,10 +812,14 @@ handleEvent ::
   -> [AppEventResponse AppModel AppEvent]
 handleEvent wenv node model evt =
   case evt of
-    AppInit -> [Event NewWallet | isNothing currentWallet]
+    AppInit ->
+      [Event NewWallet | isNothing currentWallet] <> [Producer timeTicker]
     ShowMsg t -> [Model $ model & msg ?~ t & menuPopup .~ False]
     ShowError t ->
-      [Model $ model & msg ?~ t & menuPopup .~ False & inError .~ True]
+      [ Model $
+        model & msg ?~ t & menuPopup .~ False & inError .~ True & modalMsg .~
+        Nothing
+      ]
     ShowModal t -> [Model $ model & modalMsg ?~ t]
     WalletClicked -> [Model $ model & walPopup .~ True]
     AccountClicked -> [Model $ model & accPopup .~ True]
@@ -720,6 +857,30 @@ handleEvent wenv node model evt =
       ]
     ConfirmCancel -> [Model $ model & confirmTitle .~ Nothing & mainInput .~ ""]
     ShowSeed -> [Model $ model & showSeed .~ True & menuPopup .~ False]
+    ShowSend -> [Model $ model & openSend .~ True]
+    SendTx ->
+      case currentAccount of
+        Nothing -> [Event $ ShowError "No account available"]
+        Just acc ->
+          case currentWallet of
+            Nothing -> [Event $ ShowError "No wallet available"]
+            Just wal ->
+              [ Producer $
+                sendTransaction
+                  (model ^. configuration)
+                  (model ^. network)
+                  (entityKey acc)
+                  (zcashWalletLastSync $ entityVal wal)
+                  (model ^. sendAmount)
+                  (model ^. sendRecipient)
+                  (model ^. sendMemo)
+              ]
+    CancelSend ->
+      [ Model $
+        model & openSend .~ False & sendRecipient .~ "" & sendAmount .~ 0.0 &
+        sendMemo .~
+        ""
+      ]
     SaveAddress acc ->
       if T.length (model ^. mainInput) > 1
         then [ Task $ addNewAddress (model ^. mainInput) External acc
@@ -817,12 +978,55 @@ handleEvent wenv node model evt =
         else [Event $ NewAccount currentWallet]
     LoadWallets a ->
       if not (null a)
-        then [Model $ model & wallets .~ a, Event $ SwitchWal 0]
+        then [ Model $ model & wallets .~ a
+             , Event $ SwitchWal $ model ^. selWallet
+             ]
         else [Event NewWallet]
     CloseMsg -> [Model $ model & msg .~ Nothing & inError .~ False]
     CloseSeed -> [Model $ model & showSeed .~ False]
     CloseTx -> [Model $ model & showTx .~ Nothing]
+    CloseTxId -> [Model $ model & showId .~ Nothing]
     ShowTx i -> [Model $ model & showTx ?~ i]
+    TickUp ->
+      if (model ^. timer) < 90
+        then [Model $ model & timer .~ (1 + model ^. timer)]
+        else if (model ^. barValue) == 1.0
+               then [ Model $ model & timer .~ 0 & barValue .~ 0.0
+                    , Producer $
+                      scanZebra
+                        (c_dbPath $ model ^. configuration)
+                        (c_zebraHost $ model ^. configuration)
+                        (c_zebraPort $ model ^. configuration)
+                    ]
+               else [Model $ model & timer .~ 0]
+    SyncVal i ->
+      if (i + model ^. barValue) >= 0.999
+        then [ Model $ model & barValue .~ 1.0 & modalMsg .~ Nothing
+             , Task $ do
+                 case currentWallet of
+                   Nothing -> return $ ShowError "No wallet available"
+                   Just cW -> do
+                     syncWallet (model ^. configuration) cW
+                     return $ SwitchAddr (model ^. selAddr)
+             , Task $ do
+                 pool <-
+                   runNoLoggingT $ initPool $ c_dbPath $ model ^. configuration
+                 wL <- getWallets pool (model ^. network)
+                 return $ LoadWallets wL
+             ]
+        else [ Model $
+               model & barValue .~ validBarValue (i + model ^. barValue) &
+               modalMsg ?~
+               ("Wallet Sync: " <>
+                T.pack (printf "%.2f%%" (model ^. barValue * 100)))
+             ]
+    CheckRecipient a -> [Model $ model & recipientValid .~ isRecipientValid a]
+    CheckAmount i ->
+      [ Model $
+        model & amountValid .~
+        (i < (fromIntegral (model ^. balance) / 100000000.0))
+      ]
+    ShowTxId tx -> [Model $ model & showId ?~ tx & modalMsg .~ Nothing]
   where
     currentWallet =
       if null (model ^. wallets)
@@ -911,6 +1115,100 @@ handleEvent wenv node model evt =
               wL <- getWallets pool (model ^. network)
               return $ LoadWallets wL
 
+scanZebra :: T.Text -> T.Text -> Int -> (AppEvent -> IO ()) -> IO ()
+scanZebra dbPath zHost zPort sendMsg = do
+  _ <- liftIO $ initDb dbPath
+  bStatus <- liftIO $ checkBlockChain zHost zPort
+  pool <- runNoLoggingT $ initPool dbPath
+  b <- liftIO $ getMinBirthdayHeight pool
+  dbBlock <- runNoLoggingT $ getMaxBlock pool
+  let sb = max dbBlock b
+  if sb > zgb_blocks bStatus || sb < 1
+    then sendMsg (ShowError "Invalid starting block for scan")
+    else do
+      let bList = [(sb + 1) .. (zgb_blocks bStatus)]
+      if not (null bList)
+        then do
+          let step = (1.0 :: Float) / fromIntegral (length bList)
+          mapM_ (processBlock pool step) bList
+        else sendMsg (SyncVal 1.0)
+  where
+    processBlock :: ConnectionPool -> Float -> Int -> IO ()
+    processBlock pool step bl = do
+      r <-
+        liftIO $
+        makeZebraCall
+          zHost
+          zPort
+          "getblock"
+          [Data.Aeson.String $ showt bl, jsonNumber 1]
+      case r of
+        Left e1 -> sendMsg (ShowError $ showt e1)
+        Right blk -> do
+          r2 <-
+            liftIO $
+            makeZebraCall
+              zHost
+              zPort
+              "getblock"
+              [Data.Aeson.String $ showt bl, jsonNumber 0]
+          case r2 of
+            Left e2 -> sendMsg (ShowError $ showt e2)
+            Right hb -> do
+              let blockTime = getBlockTime hb
+              mapM_ (runNoLoggingT . processTx zHost zPort blockTime pool) $
+                bl_txs $ addTime blk blockTime
+              sendMsg (SyncVal step)
+    addTime :: BlockResponse -> Int -> BlockResponse
+    addTime bl t =
+      BlockResponse
+        (bl_confirmations bl)
+        (bl_height bl)
+        (fromIntegral t)
+        (bl_txs bl)
+
+sendTransaction ::
+     Config
+  -> ZcashNet
+  -> ZcashAccountId
+  -> Int
+  -> Float
+  -> T.Text
+  -> T.Text
+  -> (AppEvent -> IO ())
+  -> IO ()
+sendTransaction config znet accId bl amt ua memo sendMsg = do
+  sendMsg $ ShowModal "Preparing transaction..."
+  case parseAddress ua znet of
+    Nothing -> sendMsg $ ShowError "Incorrect address"
+    Just outUA -> do
+      let dbPath = c_dbPath config
+      let zHost = c_zebraHost config
+      let zPort = c_zebraPort config
+      pool <- runNoLoggingT $ initPool dbPath
+      res <-
+        runFileLoggingT "zenith.log" $
+        prepareTx pool zHost zPort znet accId bl amt outUA memo
+      case res of
+        Left e -> sendMsg $ ShowError $ T.pack $ show e
+        Right rawTx -> do
+          sendMsg $ ShowModal "Transaction ready, sending to Zebra..."
+          resp <-
+            makeZebraCall
+              zHost
+              zPort
+              "sendrawtransaction"
+              [Data.Aeson.String $ toText rawTx]
+          case resp of
+            Left e1 -> sendMsg $ ShowError $ "Zebra error: " <> showt e1
+            Right txId -> sendMsg $ ShowTxId txId
+
+timeTicker :: (AppEvent -> IO ()) -> IO ()
+timeTicker sendMsg = do
+  sendMsg TickUp
+  threadDelay $ 1000 * 1000
+  timeTicker sendMsg
+
 txtWrap :: T.Text -> T.Text
 txtWrap = wrapText (WrapSettings False True NoFill FillAfterFirst) 32
 
@@ -982,6 +1280,15 @@ runZenithGUI config = do
                   False
                   Nothing
                   Nothing
+                  0
+                  1.0
+                  False
+                  ""
+                  0.0
+                  ""
+                  False
+                  False
+                  Nothing
           startApp model handleEvent buildUI params
     Left e -> do
       initDb dbFilePath
@@ -1018,6 +1325,15 @@ runZenithGUI config = do
               False
               Nothing
               Nothing
+              0
+              1.0
+              False
+              ""
+              0.0
+              ""
+              False
+              False
+              Nothing
       startApp model handleEvent buildUI params
   where
     params =

src/Zenith/GUI/Theme.hs

@@ -64,6 +64,12 @@ zenithTheme =
   L.active .
   L.btnMainStyle . L.text ?~
   hiliteTextStyle &
+  L.disabled .
+  L.btnMainStyle . L.text ?~
+  hiliteTextStyle &
+  L.disabled .
+  L.btnMainStyle . L.bgColor ?~
+  gray07c &
   L.basic .
   L.textFieldStyle . L.text ?~
   baseTextStyle &
@@ -78,6 +84,36 @@ zenithTheme =
   baseTextStyle &
   L.focusHover .
   L.textFieldStyle . L.text ?~
+  baseTextStyle &
+  L.basic .
+  L.numericFieldStyle . L.text ?~
+  baseTextStyle &
+  L.hover .
+  L.numericFieldStyle . L.text ?~
+  baseTextStyle &
+  L.focus .
+  L.numericFieldStyle . L.text ?~
+  baseTextStyle &
+  L.active .
+  L.numericFieldStyle . L.text ?~
+  baseTextStyle &
+  L.focusHover .
+  L.numericFieldStyle . L.text ?~
+  baseTextStyle &
+  L.basic .
+  L.textAreaStyle . L.text ?~
+  baseTextStyle &
+  L.hover .
+  L.textAreaStyle . L.text ?~
+  baseTextStyle &
+  L.focus .
+  L.textAreaStyle . L.text ?~
+  baseTextStyle &
+  L.active .
+  L.textAreaStyle . L.text ?~
+  baseTextStyle &
+  L.focusHover .
+  L.textAreaStyle . L.text ?~
   baseTextStyle
 
 zenithThemeColors :: BaseThemeColors

src/Zenith/Utils.hs

@@ -5,14 +5,24 @@ module Zenith.Utils where
 import Data.Aeson
 import Data.Functor (void)
 import Data.Maybe
+import Data.Ord (clamp)
 import Data.Scientific (Scientific(..), scientific)
 import qualified Data.Text as T
 import qualified Data.Text.Encoding as E
 import System.Process (createProcess_, shell)
 import Text.Regex.Posix
 import ZcashHaskell.Orchard (encodeUnifiedAddress, isValidUnifiedAddress)
-import ZcashHaskell.Sapling (isValidShieldedAddress)
+import ZcashHaskell.Sapling (decodeSaplingAddress, isValidShieldedAddress)
-import ZcashHaskell.Types (ZcashNet(..))
+import ZcashHaskell.Transparent
+  ( decodeExchangeAddress
+  , decodeTransparentAddress
+  )
+import ZcashHaskell.Types
+  ( SaplingAddress(..)
+  , TransparentAddress(..)
+  , UnifiedAddress(..)
+  , ZcashNet(..)
+  )
 import Zenith.Types
   ( AddressGroup(..)
   , UnifiedAddressDB(..)
@@ -79,3 +89,34 @@ copyAddress a =
   void $
   createProcess_ "toClipboard" $
   shell $ "echo " ++ T.unpack (addy a) ++ " | xclip -r -selection clipboard"
+
+-- | Bound a value to the 0..1 range, used for progress reporting on UIs
+validBarValue :: Float -> Float
+validBarValue = clamp (0, 1)
+
+isRecipientValid :: T.Text -> Bool
+isRecipientValid a =
+  case isValidUnifiedAddress (E.encodeUtf8 a) of
+    Just _a1 -> True
+    Nothing ->
+      isValidShieldedAddress (E.encodeUtf8 a) ||
+      (case decodeTransparentAddress (E.encodeUtf8 a) of
+         Just _a3 -> True
+         Nothing ->
+           case decodeExchangeAddress a of
+             Just _a4 -> True
+             Nothing -> False)
+
+parseAddress :: T.Text -> ZcashNet -> Maybe UnifiedAddress
+parseAddress a znet =
+  case isValidUnifiedAddress (E.encodeUtf8 a) of
+    Just a1 -> Just a1
+    Nothing ->
+      case decodeSaplingAddress (E.encodeUtf8 a) of
+        Just a2 ->
+          Just $ UnifiedAddress znet Nothing (Just $ sa_receiver a2) Nothing
+        Nothing ->
+          case decodeTransparentAddress (E.encodeUtf8 a) of
+            Just a3 ->
+              Just $ UnifiedAddress znet Nothing Nothing (Just $ ta_receiver a3)
+            Nothing -> Nothing