src/Zenith/GUI.hs

@@ -33,6 +33,7 @@ import Database.Persist
 import Lens.Micro ((&), (+~), (.~), (?~), (^.), set)
 import Lens.Micro.TH
 import Monomer
+
 import qualified Monomer.Lens as L
 import System.Directory (getHomeDirectory)
 import System.FilePath ((</>))
@@ -68,16 +69,15 @@ import Zenith.Types hiding (ZcashAddress(..))
 import Zenith.Utils
   ( displayAmount
   , getChainTip
+  , getZcashPrice
   , isRecipientValidGUI
   , isValidString
   , isZecAddressValid
   , jsonNumber
   , padWithZero
+  , parseZcashPayment
   , showAddress
   , validBarValue
-  , parseZcashPayment
-  , getZcashPrice
-  , createZip321
   )
 
 data VkTypeDef
@@ -96,6 +96,7 @@ data AppEvent
   | AccountClicked
   | MenuClicked
   | NewClicked
+  | ViewingKeysClicked
   | NewAddress !(Maybe (Entity ZcashAccount))
   | NewInternalAddress !(Maybe (Entity ZcashAccount))
   | NewAccount !(Maybe (Entity ZcashWallet))
@@ -161,21 +162,15 @@ data AppEvent
   | ShowFIATBalance
   | DisplayFIATBalance Double Double
   | CloseFIATBalance
-  | ViewingKeysClicked
   | PrepareViewingKey !VkTypeDef !(Maybe (Entity ZcashAccount))
   | ShowViewingKey !VkTypeDef !T.Text
   | CopyViewingKey !T.Text !T.Text
   | CloseShowVK
-  | DisplayPaymentURIForm !T.Text
+  | DisplayPaymentURI
-  | ClosePaymentURIForm
+  | ClosePaymentURI
-  | PrepareURIString
-  | CloseShowURIOverlay
-  | ShowURIOverlay !T.Text
-  | CopyURIString !T.Text
   | DisplayPayUsingURI
   | ClosePayUsingURI
   | ProcIfValidURI
-  | PreparePaymentURIForm
   deriving (Eq, Show)
 
 data AppModel = AppModel
@@ -243,10 +238,8 @@ data AppModel = AppModel
   , _vkTypeName :: !T.Text
   , _vkData :: !T.Text
   , _paymentURIDisplay :: !Bool
-  , _showURIDisplay :: !Bool
   , _usepmtURIOverlay :: !Bool
   , _uriString :: !T.Text
-  , _uriAddr :: !T.Text
   } deriving (Eq, Show)
 
 makeLenses ''AppModel
@@ -290,19 +283,18 @@ buildUI wenv model = widgetTree
         , modalOverlay `nodeVisible` isJust (model ^. modalMsg)
         , adrbookOverlay `nodeVisible` model ^. showAdrBook
         , newAdrBkOverlay `nodeVisible` model ^. newAdrBkEntry
+        , dfBalOverlay `nodeVisible` model ^. displayFIATBalance
         , showABAddressOverlay (model ^. abdescrip) (model ^. abaddress) `nodeVisible`
           model ^.
           showABAddress
         , updateABAddressOverlay (model ^. abdescrip) (model ^. abaddress) `nodeVisible`
           model ^.
           updateABAddress
-        , shieldOverlay `nodeVisible` model ^. shieldZec
-        , deShieldOverlay `nodeVisible` model ^. deShieldZec
-        , dfBalOverlay `nodeVisible` model ^. displayFIATBalance
         , showVKOverlay `nodeVisible` model ^. viewingKeyDisplay
         , paymentURIOverlay `nodeVisible` model ^. paymentURIDisplay
-        , showURIOverlay `nodeVisible` model ^. showURIDisplay
         , pmtUsingURIOverlay `nodeVisible` model ^. usepmtURIOverlay
+        , shieldOverlay `nodeVisible` model ^. shieldZec
+        , deShieldOverlay `nodeVisible` model ^. deShieldZec
         , msgAdrBookOverlay `nodeVisible` isJust (model ^. msgAB)
         ]
     mainWindow =
@@ -395,7 +387,7 @@ buildUI wenv model = widgetTree
                   ("Balance in " <>
                    T.toUpper (c_currencyCode (model ^. configuration)))) `styleBasic`
              [bgColor white, borderB 1 gray, padding 3]
-           , box_ [alignLeft, onClick PreparePaymentURIForm] (label "Create URI") `styleBasic`
+           , box_ [alignLeft, onClick DisplayPaymentURI] (label "Create URI") `styleBasic`
              [bgColor white, borderB 1 gray, padding 3]
            , box_
                [alignLeft, onClick DisplayPayUsingURI]
@@ -1249,68 +1241,66 @@ buildUI wenv model = widgetTree
            , filler
            ]) `styleBasic`
       [bgColor (white & L.a .~ 0.5)]
-    --
     paymentURIOverlay =
-      alert ClosePaymentURIForm $
+      box
-      vstack
+        (vstack
-        [ box_
+           [ filler
-            []
+           , hstack
-            (label "Create a Payment URI" `styleBasic`
+               [ filler
-             [textFont "Bold", textColor white, textSize 10, padding 3]) `styleBasic`
+               , box_
-          [bgColor btnColor, radius 2, padding 3]
+                   []
-        , spacer
+                   (vstack
-        , hstack
+                      [ box_
-            [ filler
+                          [alignMiddle]
-            , label "Current Address:" `styleBasic` [textFont "Bold"]
+                          (label "Create URI" `styleBasic`
-            , spacer
+                           [textColor white, textFont "Bold", textSize 12]) `styleBasic`
-            , label_ (txtWrapN (model ^. uriAddr) 64) [multiline]
+                        [bgColor btnColor]
-            , filler
+                      , separatorLine `styleBasic` [fgColor btnColor]
-            ]
+                      , spacer
-        , spacer
+                      , hstack
-        , hstack
+                          [ label "Amount:" `styleBasic`
-            [ label "Amount : " `styleBasic` [textFont "Bold"]
+                            [width 50, textFont "Bold"]
-            , numericField_ sendAmount
+                          , spacer
-              [ decimals 8 ]
+                          , numericField_
-                `nodeKey` "floatInput"
+                              sendAmount
-                `styleBasic`
+                              [ decimals 8
-                   [ width 150
+                              , minValue 0.0
-                   , styleIf (model ^. sendAmount <= 0.0) (textColor red)
+                              , maxValue
-                   ]
+                                  (fromIntegral (model ^. balance) / 100000000.0)
-            ]
+                              , validInput amountValid
-        , spacer
+                              , onChange CheckAmount
-        , hstack
+                              ] `styleBasic`
-            [ label "Memo: "  `styleBasic` [textFont "Bold"]
+                            [ width 150
-            , spacer
+                            , styleIf
-            , textField_ sendMemo [] `styleBasic` [width 300]
+                                (not $ model ^. amountValid)
-            ]
+                                (textColor red)
-        , spacer
+                            ]
-        , hstack
+                          ]
-            [ filler
+                      , hstack
-            , mainButton "Create URI" PrepareURIString `nodeEnabled`
+                          [ label "Memo:" `styleBasic`
-                  (model ^. sendAmount > 0.0)
+                            [width 50, textFont "Bold"]
-            , filler
+                          , spacer
-            ]
+                          , textArea sendMemo `styleBasic`
-        ]  `styleBasic`  [bgColor (white & L.a .~ 0.5)]
+                            [width 150, height 40]
-    --      
+                          ]
-    showURIOverlay =
+                      , spacer
-      alert CloseShowURIOverlay $
+                      , box_
-      vstack
+                          [alignMiddle]
-        [ box_
+                          (hstack
-            []
+                             [ spacer
-            (label "Payment URI" `styleBasic`
+                             , mainButton "Create URI" NotImplemented `nodeEnabled`
-             [textFont "Bold", textColor white, textSize 12, padding 3]) `styleBasic`
+                               True
-          [bgColor btnColor, radius 2, padding 3]
+                             , spacer
-        , spacer
+                             , button "Cancel" ClosePaymentURI
-        , hstack
+                             , spacer
-            [filler, label_ (txtWrapN (model ^. uriString ) 64) [multiline], filler]
+                             ])
-        , spacer
+                      ]) `styleBasic`
-        , hstack
+                 [radius 4, border 2 btnColor, bgColor white, padding 4]
-            [ filler
+               , filler
-            , button "Copy to Clipboard" $
+               ]
-              CopyURIString (model ^. uriString)
+           , filler
-            , filler
+           ]) `styleBasic`
-            ]
+      [bgColor (white & L.a .~ 0.5)]
-        ]
     pmtUsingURIOverlay =
       box
         (vstack
@@ -1704,7 +1694,6 @@ handleEvent wenv node model evt =
         model & amountValid .~
         (i < (fromIntegral (model ^. balance) / 100000000.0))
       ]
-    -- 
     ShowTxId tx -> [Model $ model & showId ?~ tx & modalMsg .~ Nothing]
     -- |
     -- | Address Book Events
@@ -1763,11 +1752,6 @@ handleEvent wenv node model evt =
       , 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 ->
       [ Task $ deleteAdrBook (model ^. configuration) a
       , Model $
@@ -1815,46 +1799,26 @@ handleEvent wenv node model evt =
     --
     ShowViewingKey vkType vkText ->
       case vkType of
-        VkFull -> [ Model $
+        VkFull -> [ Model $ 
                     model & vkTypeName .~ "Full"
                           & vkData .~ vkText
                           & viewingKeyDisplay .~ True
                           & menuPopup .~ False
                   ]
         VkIncoming -> [ Model $
-                        model & vkTypeName .~ "Incoming"
+                        model & vkTypeName .~ "Incoming" 
                               & vkData .~ vkText
-                              & viewingKeyDisplay .~ True
+                              & viewingKeyDisplay .~ True 
                               & menuPopup .~ False
                       ]
     --
     -- Display PaymentURI Form
     --
-    PreparePaymentURIForm ->
+    DisplayPaymentURI ->
-      [ Task $ getCurrentAddress currentAddress ]
-    -- 
-    DisplayPaymentURIForm ua->
       [ Model $
-        model & uriString .~ ""
+        model & paymentURIDisplay .~ True & uriString .~ "" & menuPopup .~ False
-              & uriAddr .~ ua
-              & amountValid .~ False
-              & sendAmount .~ 0.0
-              & sendMemo .~ ""
-              & paymentURIDisplay .~ True
-              & menuPopup .~ False
       ]
-    ClosePaymentURIForm -> [Model $ model & paymentURIDisplay .~ False]
+    ClosePaymentURI -> [Model $ model & paymentURIDisplay .~ False]
-    --
-    -- Generate URI 
-    --
-    PrepareURIString -> [ Task $ genURIString (model ^. uriAddr) (model ^. sendAmount) (model ^. sendMemo) ]
-    ShowURIOverlay uStr ->
-      [ Model $
-        model & uriString .~ uStr 
-              & paymentURIDisplay .~ False
-              & showURIDisplay .~ True
-      ]
-    CloseShowURIOverlay -> [ Model $ model & showURIDisplay .~ False & uriString .~ "" ]
     --
     -- Display Pay using URI Form
     --
@@ -1877,8 +1841,9 @@ handleEvent wenv node model evt =
                 T.pack (uriAddress p) &
                 sendAmount .~
                 realToFrac a &
-                sendMemo .~ (uriMemo p)
+                sendMemo .~
-              , Event $ ClosePaymentURIForm
+                (uriMemo p)
+              , Event $ ClosePaymentURI
               ]
             Nothing ->
               [ Model $
@@ -2081,9 +2046,9 @@ handleEvent wenv node model evt =
         Just acc -> do
             let osk = getOrchSK $ zcashAccountOrchSpendKey $ entityVal acc
             let ssk = getSapSK $ zcashAccountSapSpendKey $ entityVal acc
-            let tsk = getTranSK $ zcashAccountTPrivateKey $ entityVal acc
+            let tsk = getTranSK $ zcashAccountTPrivateKey $ entityVal acc        
-            fvk <- deriveUfvk n osk ssk tsk
+            fvk <- deriveUfvk n osk ssk tsk 
-            return $ ShowViewingKey VkFull fvk
+            return $ ShowViewingKey VkFull fvk 
     --
     -- Get Incoming Viewing Key  
     --
@@ -2094,31 +2059,9 @@ handleEvent wenv node model evt =
         Just acc -> do
             let osk = getOrchSK $ zcashAccountOrchSpendKey $ entityVal acc
             let ssk = getSapSK $ zcashAccountSapSpendKey $ entityVal acc
-            let tsk = getTranSK $ zcashAccountTPrivateKey $ entityVal acc
+            let tsk = getTranSK $ zcashAccountTPrivateKey $ entityVal acc        
-            ivk <- deriveUivk n osk ssk tsk
+            ivk <- deriveUivk n osk ssk tsk 
-            return $ ShowViewingKey VkIncoming ivk
+            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  
-    --
-    -- 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 (T.pack uriSt)
 
 scanZebra ::
      T.Text
@@ -2472,8 +2415,6 @@ runZenithGUI config = do
                           ""
                           False
                           False
-                          False
-                          ""
                           ""
                   startApp model handleEvent buildUI (params hD)
         Left _e -> print "Zebra not available"

src/Zenith/Utils.hs

@@ -22,7 +22,6 @@ import qualified Data.Text as T
 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.Process (createProcess_, shell)
 import Text.Printf (printf)
@@ -335,22 +334,3 @@ padBase64 bs = bs <> BC.replicate paddingLength '='
 -- 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

test/Spec.hs

@@ -1138,11 +1138,3 @@ main = 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"

zenith.cabal

@@ -97,7 +97,6 @@ library
     , word-wrap
     , zcash-haskell
     , unordered-containers
-    , network-uri
   --pkgconfig-depends: rustzcash_wrapper
   default-language: Haskell2010