diff --git a/src/Xero.hs b/src/Xero.hs index e675042..b14412f 100644 --- a/src/Xero.hs +++ b/src/Xero.hs @@ -2,6 +2,7 @@ module Xero where +import Control.Exception import Control.Monad.IO.Class import Data.Aeson import qualified Data.Bson as B @@ -15,7 +16,6 @@ import Data.Time.Clock import Database.MongoDB import GHC.Generics import Network.HTTP.Simple -import Network.HTTP.Simple (getResponseStatus) import Network.HTTP.Types.Header import Owner import Web.JWT @@ -381,7 +381,13 @@ getXeroInvoice pipe dbName inv address = do let sCode = getResponseStatusCode res case sCode of 200 -> do - let invData = - getResponseBody (res :: Response XeroInvResponse) - return $ Just (head $ xir_invs invData) + invData <- + try + (evaluate $ + getResponseBody (res :: Response XeroInvResponse)) :: IO (Either JSONException XeroInvResponse) + case invData of + Left ex -> do + putStrLn "Failed to parse JSON from Xero" + return Nothing + Right iData -> return $ Just (head $ xir_invs iData) _ -> return Nothing diff --git a/src/ZGoBackend.hs b/src/ZGoBackend.hs index e214732..6214127 100644 --- a/src/ZGoBackend.hs +++ b/src/ZGoBackend.hs @@ -535,7 +535,8 @@ routes pipe config = do if res then do resInv <- - liftIO $ getXeroInvoice pipe (c_dbName config) inv oAddress + liftAndCatchIO $ + getXeroInvoice pipe (c_dbName config) inv oAddress case resInv of Nothing -> do status noContent204