Vergara_Tech/zgo-backend
Vergara_Tech/zgo-backend
2
1
Fork 0
Code Issues Pull requests Projects Releases 4 Packages Wiki Activity

Correct Xero token record in DB

Browse source
This commit is contained in:
Rene Vergara 2022-09-08 09:44:45 -05:00
parent 8e3bdadb08
commit 26b14246e1
Signed by: pitmutt
GPG key ID: 65122AD495A7F5B2
1 changed files with 6 additions and 5 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

11
src/Xero.hs
View file

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