From 26b14246e15f9b553167894239bb5b2bbe3239ea Mon Sep 17 00:00:00 2001
From: Rene Vergara <rene@vergara.network>
Date: Thu, 8 Sep 2022 09:44:45 -0500
Subject: [PATCH] Correct Xero token record in DB

---
 src/Xero.hs | 11 ++++++-----
 1 file changed, 6 insertions(+), 5 deletions(-)

diff --git a/src/Xero.hs b/src/Xero.hs
index 1b5b71b..9fe39a6 100644
--- a/src/Xero.hs
+++ b/src/Xero.hs
@@ -119,7 +119,7 @@ instance Val XeroToken where
              , "refreshToken" =: r
              , "accExpires" =: aD
              , "refExpires" =: d
-             --, "accCode" =: c
+             , "accCode" =: c
              ]
   cast' (Doc d) = do
     i <- B.lookup "_id" d
@@ -133,8 +133,8 @@ instance Val XeroToken where
     Just (XeroToken i a t e r aD dte c)
   cast' _ = Nothing
 
-processToken :: XeroToken -> T.Text -> IO XeroToken
-processToken t a = do
+processToken :: XeroToken -> T.Text -> T.Text -> IO XeroToken
+processToken t a c = do
   now <- getCurrentTime
   return $
     XeroToken
@@ -145,7 +145,7 @@ processToken t a = do
       (t_refresh t)
       (addUTCTime (fromIntegral $ t_expires t) now)
       (addUTCTime 5184000 now)
-      (t_code t)
+      c
 
 -- |Type to represent a Xero tenant
 data XeroTenant =
@@ -314,7 +314,8 @@ requestXeroToken pipe dbName cred code address = do
   case rCode of
     200 -> do
       let newToken = getResponseBody (res :: Response XeroToken)
-      pToken <- processToken newToken address
+      let accCode = t_code <$> (token >>= cast' . Doc)
+      pToken <- processToken newToken address (fromMaybe "" accCode)
       --print pToken
       _ <- access pipe master dbName $ upsertToken pToken
       _ <- getTenantId pipe dbName pToken