Implement payment URIs

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

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

package.yaml

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

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...."
+              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: Insufficient balance in source address."
 
@@ -478,9 +484,14 @@ checkOpResult user pwd opid = do
       mapM_ showResult r
   where
     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
 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"

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