Improve error handling for Xero calls
This commit is contained in:
parent
7240dd1b87
commit
a7a868ac2c
2 changed files with 12 additions and 5 deletions
14
src/Xero.hs
14
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
|
||||
|
|
|
@ -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
|
||||
|
|
Loading…
Reference in a new issue