Error handling improvements

CHANGELOG.md

@@ -23,6 +23,10 @@ and this project adheres to [Semantic Versioning](https://semver.org/spec/v2.0.0
 - Field `crmToken` for `Owner`
 - Field `externalInvoice` and `shortCode` for `Order`
 
+### Changed
+
+- Improved error handling for API server
+- CoinGecko price feed to include New Zealand dollar (NZD)
 
 ## [1.0.0] - 2022-07-27
 

src/ZGoBackend.hs

@@ -510,7 +510,7 @@ routes pipe config = do
       "ZGo Backend"
   --Get list of countries for UI
   get "/api/countries" $ do
-    countries <- liftIO $ run listCountries
+    countries <- liftAndCatchIO $ run listCountries
     case countries of
       [] -> do
         status noContent204
@@ -522,7 +522,7 @@ routes pipe config = do
              ])
   --Get Xero credentials
   get "/api/xero" $ do
-    xeroConfig <- liftIO $ run findXero
+    xeroConfig <- liftAndCatchIO $ run findXero
     case xeroConfig of
       Nothing -> status noContent204
       Just x -> do
@@ -539,7 +539,7 @@ routes pipe config = do
   get "/api/xerotoken" $ do
     code <- param "code"
     address <- param "address"
-    xeroConfig <- liftIO $ run findXero
+    xeroConfig <- liftAndCatchIO $ run findXero
     case xeroConfig of
       Nothing -> status noContent204
       Just x -> do
@@ -556,7 +556,7 @@ routes pipe config = do
   get "/api/invdata" $ do
     inv <- param "inv"
     oAddress <- param "address"
-    xeroConfig <- liftIO $ run findXero
+    xeroConfig <- liftAndCatchIO $ run findXero
     case xeroConfig of
       Nothing -> do
         status noContent204
@@ -587,7 +587,7 @@ routes pipe config = do
   -- Get the xeroaccount code
   get "/api/xeroaccount" $ do
     oAdd <- param "address"
-    res <- liftIO $ run (findToken oAdd)
+    res <- liftAndCatchIO $ run (findToken oAdd)
     let c = cast' . Doc =<< res
     case c of
       Nothing -> status noContent204
@@ -607,7 +607,7 @@ routes pipe config = do
   --Get user associated with session
   get "/api/user" $ do
     sess <- param "session"
-    user <- liftIO $ run (findUser sess)
+    user <- liftAndCatchIO $ run (findUser sess)
     case user of
       Nothing -> status noContent204
       Just u ->
@@ -620,7 +620,7 @@ routes pipe config = do
   post "/api/validateuser" $ do
     providedPin <- param "pin"
     sess <- param "session"
-    user <- liftIO $ run (findUser sess)
+    user <- liftAndCatchIO $ run (findUser sess)
     case user of
       Nothing -> status noContent204 --`debug` "No user match"
       Just u -> do
@@ -631,7 +631,7 @@ routes pipe config = do
             let ans = upin pUser == T.pack providedPin
             if ans
               then do
-                liftIO $ run (validateUser sess)
+                liftAndCatchIO $ run (validateUser sess)
                 status accepted202
               else status noContent204 --`debug` ("Pins didn't match: " ++ providedPin ++ " " ++ T.unpack (upin pUser))
     --Delete user
@@ -640,7 +640,7 @@ routes pipe config = do
     let r = mkRegex "^[a-f0-9]{24}$"
     if matchTest r userId
       then do
-        liftIO $ run (deleteUser userId)
+        liftAndCatchIO $ run (deleteUser userId)
         status ok200
       else status noContent204
   --Get current blockheight from Zcash node
@@ -658,7 +658,7 @@ routes pipe config = do
   --Get owner by address
   get "/api/owner" $ do
     addr <- param "address"
-    owner <- liftIO $ run (findOwner addr)
+    owner <- liftAndCatchIO $ run (findOwner addr)
     case owner of
       Nothing -> status noContent204
       Just o -> do
@@ -674,7 +674,7 @@ routes pipe config = do
                  ])
   get "/api/ownerid" $ do
     id <- param "id"
-    owner <- liftIO $ run (findOwnerById id)
+    owner <- liftAndCatchIO $ run (findOwnerById id)
     case owner of
       Nothing -> status noContent204
       Just o -> do
@@ -692,15 +692,15 @@ routes pipe config = do
   post "/api/owner" $ do
     o <- jsonData
     let q = payload (o :: Payload Owner)
-    known <- liftIO $ listAddresses nodeUser nodePwd
+    known <- liftAndCatchIO $ listAddresses nodeUser nodePwd
     if not (opayconf q)
       then do
-        _ <- liftIO $ run (upsertOwner q)
+        _ <- liftAndCatchIO $ run (upsertOwner q)
         status created201
       else do
         if oaddress q `elem` map addy known
           then do
-            _ <- liftIO $ run (upsertOwner q)
+            _ <- liftAndCatchIO $ run (upsertOwner q)
             status created201
           else do
             vkInfo <-
@@ -712,14 +712,14 @@ routes pipe config = do
             let content = getResponseBody vkInfo :: RpcResponse Object
             if isNothing (err content)
               then do
-                _ <- liftIO $ run (upsertOwner q)
+                _ <- liftAndCatchIO $ run (upsertOwner q)
                 status created201
               else do
                 status internalServerError500
     --Get items associated with the given address
   get "/api/items" $ do
     addr <- param "address"
-    items <- liftIO $ run (findItems addr)
+    items <- liftAndCatchIO $ run (findItems addr)
     case items of
       [] -> status noContent204
       _ -> do
@@ -732,7 +732,7 @@ routes pipe config = do
   post "/api/item" $ do
     i <- jsonData
     let q = payload (i :: Payload Item)
-    _ <- liftIO $ run (upsertItem q)
+    _ <- liftAndCatchIO $ run (upsertItem q)
     status created201
     --Delete item
   Web.Scotty.delete "/api/item/:id" $ do
@@ -740,13 +740,13 @@ routes pipe config = do
     let r = mkRegex "^[a-f0-9]{24}$"
     if matchTest r oId
       then do
-        liftIO $ run (deleteItem oId)
+        liftAndCatchIO $ run (deleteItem oId)
         status ok200
       else status noContent204
     --Get price for Zcash
   get "/api/price" $ do
     curr <- param "currency"
-    pr <- liftIO $ run (findPrice curr)
+    pr <- liftAndCatchIO $ run (findPrice curr)
     case pr of
       Nothing -> do
         status noContent204
@@ -759,7 +759,7 @@ routes pipe config = do
     --Get all closed orders for the address
   get "/api/allorders" $ do
     addr <- param "address"
-    myOrders <- liftIO $ run (findAllOrders addr)
+    myOrders <- liftAndCatchIO $ run (findAllOrders addr)
     case myOrders of
       [] -> status noContent204
       _ -> do
@@ -776,7 +776,7 @@ routes pipe config = do
     let r = mkRegex "^[a-f0-9]{24}$"
     if matchTest r oId
       then do
-        myOrder <- liftIO $ run (findOrderById oId)
+        myOrder <- liftAndCatchIO $ run (findOrderById oId)
         case myOrder of
           Nothing -> status noContent204
           Just o -> do
@@ -794,7 +794,7 @@ routes pipe config = do
     --Get order by session
   get "/api/order" $ do
     sess <- param "session"
-    myOrder <- liftIO $ run (findOrder sess)
+    myOrder <- liftAndCatchIO $ run (findOrder sess)
     case myOrder of
       Nothing -> status noContent204
       Just o -> do
@@ -814,7 +814,7 @@ routes pipe config = do
     let q = payload (newOrder :: Payload ZGoOrder)
     _ <- liftIO $ run (upsertXeroOrder q)
     myOrder <-
-      liftIO $
+      liftAndCatchIO $
       run (findXeroOrder (qaddress q) (qexternalInvoice q) (qshortCode q))
     case myOrder of
       Nothing -> status noContent204
@@ -833,12 +833,12 @@ routes pipe config = do
   post "/api/order" $ do
     newOrder <- jsonData
     let q = payload (newOrder :: Payload ZGoOrder)
-    _ <- liftIO $ run (upsertOrder q)
+    _ <- liftAndCatchIO $ run (upsertOrder q)
     status created201
     --Delete order
   Web.Scotty.delete "/api/order/:id" $ do
     oId <- param "id"
-    liftIO $ run (deleteOrder oId)
+    liftAndCatchIO $ run (deleteOrder oId)
     status ok200
 
 -- | Make a Zcash RPC call