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
- 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

View file

@ -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"]

View file

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

View file

@ -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"

View file

@ -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