Implement payment URIs

This commit is contained in:
Rene Vergara 2022-06-23 10:29:33 -05:00
parent 1462df9cf9
commit bfdbe971f9
Signed by: pitmutt
GPG key ID: 65122AD495A7F5B2
5 changed files with 103 additions and 10 deletions

View file

@ -9,6 +9,17 @@ and this project adheres to [Semantic Versioning](https://semver.org/spec/v2.0.0
### Added ### 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 - CHANGELOG.md
- README.md - README.md
- List node addresses - List node addresses

View file

@ -29,6 +29,7 @@ root user pwd = do
sendZec user pwd sendZec user pwd
copyAdd user pwd copyAdd user pwd
createUA user pwd createUA user pwd
processUri user pwd
command "exit" "exit app" exitSuccess command "exit" "exit app" exitSuccess
copyAdd :: B.ByteString -> B.ByteString -> Commands () copyAdd :: B.ByteString -> B.ByteString -> Commands ()
@ -98,7 +99,23 @@ sendZec user pwd =
case (readMaybe a :: Maybe Double) of case (readMaybe a :: Maybe Double) of
Just amt -> do Just amt -> do
m <- liftIO . prompt $ " > Enter memo: " 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" Nothing -> liftIO . putStrLn $ " Invalid amount"
else liftIO . putStrLn $ " Invalid address, cancelling." else liftIO . putStrLn $ " Invalid address, cancelling."
return NoAction return NoAction
@ -138,9 +155,28 @@ displayTx t = do
putStr "Zats: " putStr "Zats: "
print $ zamountZat t print $ zamountZat t
putStr "Memo: " putStr "Memo: "
print $ zmemo t putStrLn $ T.unpack $ zmemo t
putStrLn "-----" 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 :: IO ()
main = do main = do
config <- load ["zenith.cfg"] config <- load ["zenith.cfg"]

View file

@ -34,9 +34,12 @@ library:
- vector - vector
- regex-base - regex-base
- regex-posix - regex-posix
- regex-compat
- Clipboard - Clipboard
- process - process
- http-types - http-types
- array
- base64-bytestring
executables: executables:
zenith: zenith:

View file

@ -9,7 +9,10 @@ import Control.Concurrent (threadDelay)
import Control.Monad import Control.Monad
import Data.Aeson import Data.Aeson
import Data.Aeson.Types import Data.Aeson.Types
import qualified Data.Array as A
import qualified Data.ByteString as B 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 qualified Data.ByteString.Lazy as LB
import Data.Char import Data.Char
import Data.Functor (void) import Data.Functor (void)
@ -24,7 +27,11 @@ import Network.HTTP.Types
import Numeric import Numeric
import System.Clipboard import System.Clipboard
import System.Exit import System.Exit
import System.IO
import System.Process (createProcess_, shell) import System.Process (createProcess_, shell)
import Text.Read (readMaybe)
import Text.Regex
import Text.Regex.Base
import Text.Regex.Posix import Text.Regex.Posix
-- | A type to model Zcash RPC calls -- | A type to model Zcash RPC calls
@ -258,7 +265,7 @@ instance FromJSON UABalance where
-- | Type for Operation Result -- | Type for Operation Result
data OpResult = data OpResult =
OpResult OpResult
{ opsuccess :: Bool { opsuccess :: T.Text
, opmessage :: Maybe T.Text , opmessage :: Maybe T.Text
, optxid :: Maybe T.Text , optxid :: Maybe T.Text
} }
@ -268,7 +275,6 @@ instance FromJSON OpResult where
parseJSON = parseJSON =
withObject "OpResult" $ \obj -> do withObject "OpResult" $ \obj -> do
s <- obj .: "status" s <- obj .: "status"
let s' = s == ("success" :: String)
r <- obj .:? "result" r <- obj .:? "result"
e <- obj .:? "error" e <- obj .:? "error"
t <- t <-
@ -279,7 +285,7 @@ instance FromJSON OpResult where
case e of case e of
Nothing -> return Nothing Nothing -> return Nothing
Just m' -> m' .: "message" 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 -- | Helper function to turn a hex-encoded memo strings to readable text
decodeHexText :: String -> String decodeHexText :: String -> String
@ -412,8 +418,8 @@ sendTx user pwd fromAddy toAddy amount memo = do
case rpcResp of case rpcResp of
Nothing -> fail "Couldn't parse node response" Nothing -> fail "Couldn't parse node response"
Just res -> do Just res -> do
putStrLn " Sending...." putStr " Sending."
threadDelay 10000000 >> checkOpResult user pwd (result res) checkOpResult user pwd (result res)
else putStrLn "Error: Source address is view-only." else putStrLn "Error: Source address is view-only."
else putStrLn "Error: Insufficient balance in source address." else putStrLn "Error: Insufficient balance in source address."
@ -478,9 +484,14 @@ checkOpResult user pwd opid = do
mapM_ showResult r mapM_ showResult r
where where
showResult t = showResult t =
if opsuccess t case opsuccess t of
then putStrLn $ " Success! Tx ID: " ++ maybe "" T.unpack (optxid t) "success" ->
else putStrLn $ " Failed :( " ++ maybe "" T.unpack (opmessage t) 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 -- | Check for accounts
checkAccounts :: B.ByteString -> B.ByteString -> IO Bool checkAccounts :: B.ByteString -> B.ByteString -> IO Bool
@ -548,3 +559,32 @@ checkServer user pwd = do
putStrLn "Deprecated Zcash Full Node version found. Exiting" putStrLn "Deprecated Zcash Full Node version found. Exiting"
exitFailure exitFailure
where isNodeValid (NodeVersion i) = i >= 5000000 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"

View file

@ -33,13 +33,16 @@ library
build-depends: build-depends:
Clipboard Clipboard
, aeson , aeson
, array
, base >=4.7 && <5 , base >=4.7 && <5
, base64-bytestring
, bytestring , bytestring
, haskoin-core , haskoin-core
, http-conduit , http-conduit
, http-types , http-types
, process , process
, regex-base , regex-base
, regex-compat
, regex-posix , regex-posix
, scientific , scientific
, text , text