Implement payment URIs
This commit is contained in:
parent
1462df9cf9
commit
bfdbe971f9
5 changed files with 103 additions and 10 deletions
11
CHANGELOG.md
11
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
|
||||
|
|
40
app/Main.hs
40
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"]
|
||||
|
|
|
@ -34,9 +34,12 @@ library:
|
|||
- vector
|
||||
- regex-base
|
||||
- regex-posix
|
||||
- regex-compat
|
||||
- Clipboard
|
||||
- process
|
||||
- http-types
|
||||
- array
|
||||
- base64-bytestring
|
||||
|
||||
executables:
|
||||
zenith:
|
||||
|
|
|
@ -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"
|
||||
|
|
|
@ -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
|
||||
|
|
Loading…
Reference in a new issue