Fix #6

src/ZGoBackend.hs

@@ -431,11 +431,15 @@ sendPin nodeUser nodePwd nodeAddress addr pin = do
                    ]
                ])
         ]
-  r <- makeZcashCall nodeUser nodePwd "z_sendmany" pd
+  r <- liftIO $ try $ makeZcashCall nodeUser nodePwd "z_sendmany" pd --  IO (Either HttpException (Response Object))
-  let sCode = getResponseStatus (r :: Response Object)
+  case r of
-  if sCode == ok200
+    Right res -> do
-    then return "Pin sent!"
+      let sCode = getResponseStatus (res :: Response Object)
-    else return "Pin sending failed :("
+      if sCode == ok200
+        then return "Pin sent!"
+        else return "Pin sending failed :("
+    Left ex ->
+      return $ "Failed to send tx to node :(" ++ show (ex :: HttpException)
 
 -- | Function to create user from ZGoTx
 addUser ::
@@ -854,7 +858,8 @@ routes pipe config = do
       else status noContent204
   --Get current blockheight from Zcash node
   get "/api/blockheight" $ do
-    blockInfo <- makeZcashCall nodeUser nodePwd "getblock" ["-1"]
+    blockInfo <-
+      liftAndCatchIO $ makeZcashCall nodeUser nodePwd "getblock" ["-1"]
     let content = getResponseBody blockInfo :: RpcResponse Block
     if isNothing (err content)
       then do
@@ -1121,17 +1126,21 @@ listTxs ::
   -> IO (Either T.Text [ZcashTx])
 listTxs user pwd a confs = do
   res <-
-    liftIO $
+    try $
     makeZcashCall
       user
       pwd
       "z_listreceivedbyaddress"
-      [Data.Aeson.String a, Data.Aeson.Number $ Scientific.scientific confs 0]
+      [Data.Aeson.String a, Data.Aeson.Number $ Scientific.scientific confs 0] :: IO (Either HttpException (Response (RpcResponse [ZcashTx])))
-  let content = getResponseBody res :: RpcResponse [ZcashTx]
+  case res of
-  case err content of
+    Right txList -> do
-    Nothing ->
+      let content = getResponseBody txList :: RpcResponse [ZcashTx]
-      return $ Right $ filter (not . zchange) $ fromMaybe [] $ result content
+      case err content of
-    Just e -> return $ Left $ "Error reading transactions: " <> emessage e
+        Nothing ->
+          return $
+          Right $ filter (not . zchange) $ fromMaybe [] $ result content
+        Just e -> return $ Left $ "Error reading transactions: " <> emessage e
+    Left ex -> return $ Left $ (T.pack . show) ex
 
 -- | Function to check the ZGo full node for new txs
 scanZcash :: Config -> Pipe -> IO ()
@@ -1262,14 +1271,15 @@ scanPayments config pipe = do
 -- | List addresses with viewing keys loaded
 listAddresses :: BS.ByteString -> BS.ByteString -> IO [ZcashAddress]
 listAddresses user pwd = do
-  response <- makeZcashCall user pwd "listaddresses" []
+  response <-
-  let rpcResp = getResponseBody response
+    try $ makeZcashCall user pwd "listaddresses" [] :: IO (Either HttpException (Response (RpcResponse [AddressGroup])))
-  case rpcResp of
+  case response of
-    Nothing -> fail "Couldn't parse node response"
+    Right addrList -> do
-    Just res -> do
+      let rpcResp = getResponseBody addrList
-      let addys = fromMaybe [] $ result res :: [AddressGroup]
+      let addys = fromMaybe [] $ result rpcResp :: [AddressGroup]
       let addList = concatMap getAddresses addys
       return $ filter (\a -> source a == ImportedWatchOnly) addList
+    Left ex -> fail $ show ex
 
 -- | Helper function to extract addresses from AddressGroups
 getAddresses :: AddressGroup -> [ZcashAddress]
@@ -1351,6 +1361,16 @@ payOwner p d x =
                                    (pblocktime pmt)
                                ]
                              ])
+                      let proS =
+                            ZGoProSession
+                              Nothing
+                              (oaddress fOwn)
+                              (calculateExpiration
+                                 fOwn
+                                 (pdelta pmt - 90000000)
+                                 (pblocktime pmt))
+                              False
+                      access pipe master db $ upsertProSession proS
                       markPaymentDone pipe db pmt
                     else do
                       _ <-

zgo-backend.cabal

@@ -1,11 +1,11 @@
 cabal-version: 1.12
 
--- This file has been generated from package.yaml by hpack version 0.35.0.
+-- This file has been generated from package.yaml by hpack version 0.35.1.
 --
 -- see: https://github.com/sol/hpack
 
 name:           zgo-backend
-version:        1.3.0
+version:        1.4.0
 synopsis:       Haskell Back-end for the ZGo point-of-sale application
 description:    Please see the README at <https://git.vergara.tech/Vergara_Tech//zgo-backend#readme>
 category:       Web