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