From b14a5cfb8334b24f083e717f7de010ef530086f4 Mon Sep 17 00:00:00 2001
From: Rene Vergara <rene@vergara.network>
Date: Wed, 11 Oct 2023 07:51:16 -0500
Subject: [PATCH] Improve messaging for PIN send

---
 src/ZGoBackend.hs | 65 ++++++++++++++++++++++++++++++++++++++++++++---
 1 file changed, 61 insertions(+), 4 deletions(-)

diff --git a/src/ZGoBackend.hs b/src/ZGoBackend.hs
index 799de62..439c1e6 100644
--- a/src/ZGoBackend.hs
+++ b/src/ZGoBackend.hs
@@ -52,6 +52,7 @@ import Numeric
 import Order
 import Owner
 import Payment
+import System.IO
 import System.IO.Unsafe
 import System.Random
 import Test.QuickCheck
@@ -384,17 +385,73 @@ sendPin nodeUser nodePwd nodeAddress addr pin = do
                    , "memo" .= encodeHexText ("ZGo PIN: " <> pin)
                    ]
                ])
+        , Data.Aeson.Number $ SC.scientific 1 1
+        , Data.Aeson.Null
+        , Data.Aeson.String "AllowRevealedAmounts"
         ]
-  r <- liftIO $ try $ makeZcashCall nodeUser nodePwd "z_sendmany" pd --  IO (Either HttpException (Response Object))
+  r <- liftIO $ try $ makeZcashCall nodeUser nodePwd "z_sendmany" pd
   case r of
     Right res -> do
-      let sCode = getResponseStatus (res :: Response Object)
+      let sCode = getResponseStatus (res :: Response (RpcResponse T.Text))
+      let rBody = getResponseBody res
       if sCode == ok200
-        then return "Pin sent!"
+        then do
+          case result rBody of
+            Nothing -> return "Couldn't parse node response"
+            Just x -> do
+              putStr "  Sending."
+              checkOpResult nodeUser nodePwd x
+              return "Pin sent!"
         else return "Pin sending failed :("
     Left ex ->
       return $ "Failed to send tx to node :(" ++ show (ex :: HttpException)
 
+-- | Type for Operation Result
+data OpResult = OpResult
+  { opsuccess :: T.Text
+  , opmessage :: Maybe T.Text
+  , optxid :: Maybe T.Text
+  } deriving (Show, Eq)
+
+instance FromJSON OpResult where
+  parseJSON =
+    withObject "OpResult" $ \obj -> do
+      s <- obj .: "status"
+      r <- obj .:? "result"
+      e <- obj .:? "error"
+      t <-
+        case r of
+          Nothing -> return Nothing
+          Just r' -> r' .: "txid"
+      m <-
+        case e of
+          Nothing -> return Nothing
+          Just m' -> m' .: "message"
+      pure $ OpResult s m t
+
+checkOpResult :: BS.ByteString -> BS.ByteString -> T.Text -> IO ()
+checkOpResult user pwd opid = do
+  response <-
+    makeZcashCall
+      user
+      pwd
+      "z_getoperationstatus"
+      [Data.Aeson.Array (V.fromList [Data.Aeson.String opid])]
+  let rpcResp = getResponseBody response :: (RpcResponse [OpResult])
+  case result rpcResp of
+    Nothing -> putStrLn "Couldn't read response from node"
+    Just opCode -> mapM_ showResult opCode
+  where
+    showResult 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)
+
 -- | Function to create user from ZGoTx
 addUser ::
      BS.ByteString
@@ -1831,7 +1888,7 @@ scanTxNative pipe db nodeUser nodePwd = do
             blockList <-
               mapM
                 (getBlockInfo nodeUser nodePwd . T.pack . show)
-                [((bl_height lB) - 50) .. (bl_height lB)]
+                [(bl_height lB - 50) .. (bl_height lB)]
             print "filtering blocks..."
             let filteredBlockList = filter filterBlock blockList
             print "extracting txs from blocks..."