From bfdbe971f99cc01fd18f924b94adcd8582a8b098 Mon Sep 17 00:00:00 2001 From: Rene Vergara Date: Thu, 23 Jun 2022 10:29:33 -0500 Subject: [PATCH] Implement payment URIs --- CHANGELOG.md | 11 ++++++++++ app/Main.hs | 40 ++++++++++++++++++++++++++++++++++-- package.yaml | 3 +++ src/Zenith.hs | 56 +++++++++++++++++++++++++++++++++++++++++++-------- zenith.cabal | 3 +++ 5 files changed, 103 insertions(+), 10 deletions(-) diff --git a/CHANGELOG.md b/CHANGELOG.md index 4db212e..eb41417 100644 --- a/CHANGELOG.md +++ b/CHANGELOG.md @@ -9,6 +9,17 @@ and this project adheres to [Semantic Versioning](https://semver.org/spec/v2.0.0 ### Added +- Adds `uri` CLI command to send funds using a [ZIP-321](https://zips.z.cash/zip-0321) URI +- Adds `sendWithUri` function to support [ZIP-321 URIs](https://zips.z.cash/zip-0321) + +### Changed + +- Changes the use of `checkOpResult` to be recursive until the transaction either fails or succeeds. + +## [0.1.0.0] + +### Added + - CHANGELOG.md - README.md - List node addresses diff --git a/app/Main.hs b/app/Main.hs index 5bee76b..96b2034 100644 --- a/app/Main.hs +++ b/app/Main.hs @@ -29,6 +29,7 @@ root user pwd = do sendZec user pwd copyAdd user pwd createUA user pwd + processUri user pwd command "exit" "exit app" exitSuccess copyAdd :: B.ByteString -> B.ByteString -> Commands () @@ -98,7 +99,23 @@ sendZec user pwd = case (readMaybe a :: Maybe Double) of Just amt -> do m <- liftIO . prompt $ " > Enter memo: " - liftIO $ sendTx user pwd (addList !! (idx - 1)) (T.pack t) amt m + rt <- liftIO . prompt $ " > Include reply-to? (Y/N): " + let repTo = + case T.toLower (T.pack rt) of + "y" -> True + _ -> False + liftIO $ + sendTx + user + pwd + (addList !! (idx - 1)) + (T.pack t) + amt + (if repTo + then m ++ + "\nReply-To:\n" ++ + T.unpack (addy (addList !! (idx - 1))) + else m) Nothing -> liftIO . putStrLn $ " Invalid amount" else liftIO . putStrLn $ " Invalid address, cancelling." return NoAction @@ -138,9 +155,28 @@ displayTx t = do putStr "Zats: " print $ zamountZat t putStr "Memo: " - print $ zmemo t + putStrLn $ T.unpack $ zmemo t putStrLn "-----" +processUri :: B.ByteString -> B.ByteString -> Commands () +processUri user pwd = + command "uri" "send ZEC reading details from URI" $ do + liftIO . putStrLn $ "Please select the source address:" + addList <- listAddresses user pwd + let idList = zip [1 ..] addList + liftIO $ mapM_ (displayZcashAddress user pwd) idList + s <- liftIO . prompt $ " > Enter ID (0 to cancel): " + let idx = read s + if idx == 0 + then do + liftIO . putStrLn $ " Cancelled!" + return NoAction + else do + liftIO . putStrLn $ " Sending from " ++ show (addList !! (idx - 1)) + u <- liftIO . prompt $ " > Enter URI: " + _ <- liftIO $ sendWithUri user pwd (addList !! (idx - 1)) u + return NoAction + main :: IO () main = do config <- load ["zenith.cfg"] diff --git a/package.yaml b/package.yaml index 30cf6d8..8e9eab9 100644 --- a/package.yaml +++ b/package.yaml @@ -34,9 +34,12 @@ library: - vector - regex-base - regex-posix + - regex-compat - Clipboard - process - http-types + - array + - base64-bytestring executables: zenith: diff --git a/src/Zenith.hs b/src/Zenith.hs index 9aa2b73..900d540 100644 --- a/src/Zenith.hs +++ b/src/Zenith.hs @@ -9,7 +9,10 @@ import Control.Concurrent (threadDelay) import Control.Monad import Data.Aeson import Data.Aeson.Types +import qualified Data.Array as A import qualified Data.ByteString as B +import qualified Data.ByteString.Base64 as B64 +import qualified Data.ByteString.Char8 as C import qualified Data.ByteString.Lazy as LB import Data.Char import Data.Functor (void) @@ -24,7 +27,11 @@ import Network.HTTP.Types import Numeric import System.Clipboard import System.Exit +import System.IO import System.Process (createProcess_, shell) +import Text.Read (readMaybe) +import Text.Regex +import Text.Regex.Base import Text.Regex.Posix -- | A type to model Zcash RPC calls @@ -258,7 +265,7 @@ instance FromJSON UABalance where -- | Type for Operation Result data OpResult = OpResult - { opsuccess :: Bool + { opsuccess :: T.Text , opmessage :: Maybe T.Text , optxid :: Maybe T.Text } @@ -268,7 +275,6 @@ instance FromJSON OpResult where parseJSON = withObject "OpResult" $ \obj -> do s <- obj .: "status" - let s' = s == ("success" :: String) r <- obj .:? "result" e <- obj .:? "error" t <- @@ -279,7 +285,7 @@ instance FromJSON OpResult where case e of Nothing -> return Nothing Just m' -> m' .: "message" - pure $ OpResult s' m t + pure $ OpResult s m t -- | Helper function to turn a hex-encoded memo strings to readable text decodeHexText :: String -> String @@ -412,8 +418,8 @@ sendTx user pwd fromAddy toAddy amount memo = do case rpcResp of Nothing -> fail "Couldn't parse node response" Just res -> do - putStrLn " Sending...." - threadDelay 10000000 >> checkOpResult user pwd (result res) + putStr " Sending." + checkOpResult user pwd (result res) else putStrLn "Error: Source address is view-only." else putStrLn "Error: Insufficient balance in source address." @@ -478,9 +484,14 @@ checkOpResult user pwd opid = do mapM_ showResult r where showResult t = - if opsuccess t - then putStrLn $ " Success! Tx ID: " ++ maybe "" T.unpack (optxid t) - else putStrLn $ " Failed :( " ++ maybe "" T.unpack (opmessage t) + case opsuccess t of + "success" -> + putStrLn $ " Success! Tx ID: " ++ maybe "" T.unpack (optxid t) + "executing" -> do + putStr "." + hFlush stdout + threadDelay 1000000 >> checkOpResult user pwd opid + _ -> putStrLn $ " Failed :( " ++ maybe "" T.unpack (opmessage t) -- | Check for accounts checkAccounts :: B.ByteString -> B.ByteString -> IO Bool @@ -548,3 +559,32 @@ checkServer user pwd = do putStrLn "Deprecated Zcash Full Node version found. Exiting" exitFailure where isNodeValid (NodeVersion i) = i >= 5000000 + +-- | Read ZIP-321 URI +sendWithUri :: B.ByteString -> B.ByteString -> ZcashAddress -> String -> IO () +sendWithUri user pwd fromAddy uri = do + let uriRegex = mkRegex "^zcash:(\\w+)\\?amount=(.*)\\&memo=(.*)$" + if matchTest uriRegex uri + then do + let reg = matchAllText uriRegex uri + let parsedAddress = fst $ head reg A.! 1 + let parsedAmount = fst $ head reg A.! 2 + let parsedEncodedMemo = fst $ head reg A.! 3 + if validateAddress $ T.pack parsedAddress + then do + putStrLn $ " Address is valid: " ++ parsedAddress + case (readMaybe parsedAmount :: Maybe Double) of + Nothing -> putStrLn " Invalid amount." + Just amt -> do + putStrLn $ " Valid ZEC amount: " ++ show amt + let decodedMemo = B64.decodeLenient $ C.pack parsedEncodedMemo + putStrLn $ " Memo: " ++ show decodedMemo + sendTx + user + pwd + fromAddy + (T.pack parsedAddress) + amt + (show decodedMemo) + else putStrLn " Invalid address" + else putStrLn "URI is not compliant with ZIP-321" diff --git a/zenith.cabal b/zenith.cabal index 4c5cbbe..07be6ec 100644 --- a/zenith.cabal +++ b/zenith.cabal @@ -33,13 +33,16 @@ library build-depends: Clipboard , aeson + , array , base >=4.7 && <5 + , base64-bytestring , bytestring , haskoin-core , http-conduit , http-types , process , regex-base + , regex-compat , regex-posix , scientific , text