diff --git a/src/ZGoBackend.hs b/src/ZGoBackend.hs index dc4228f..a983725 100644 --- a/src/ZGoBackend.hs +++ b/src/ZGoBackend.hs @@ -431,11 +431,15 @@ sendPin nodeUser nodePwd nodeAddress addr pin = do ] ]) ] - r <- makeZcashCall nodeUser nodePwd "z_sendmany" pd - let sCode = getResponseStatus (r :: Response Object) - if sCode == ok200 - then return "Pin sent!" - else return "Pin sending failed :(" + r <- liftIO $ try $ makeZcashCall nodeUser nodePwd "z_sendmany" pd -- IO (Either HttpException (Response Object)) + case r of + Right res -> do + let sCode = getResponseStatus (res :: Response Object) + 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] - let content = getResponseBody res :: RpcResponse [ZcashTx] - case err content of - Nothing -> - return $ Right $ filter (not . zchange) $ fromMaybe [] $ result content - Just e -> return $ Left $ "Error reading transactions: " <> emessage e + [Data.Aeson.String a, Data.Aeson.Number $ Scientific.scientific confs 0] :: IO (Either HttpException (Response (RpcResponse [ZcashTx]))) + case res of + Right txList -> do + let content = getResponseBody txList :: RpcResponse [ZcashTx] + case err content of + 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" [] - let rpcResp = getResponseBody response - case rpcResp of - Nothing -> fail "Couldn't parse node response" - Just res -> do - let addys = fromMaybe [] $ result res :: [AddressGroup] + response <- + try $ makeZcashCall user pwd "listaddresses" [] :: IO (Either HttpException (Response (RpcResponse [AddressGroup]))) + case response of + Right addrList -> do + let rpcResp = getResponseBody addrList + 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 _ <- diff --git a/zgo-backend.cabal b/zgo-backend.cabal index 270d63d..6671448 100644 --- a/zgo-backend.cabal +++ b/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 category: Web