36 lines
924 B
Haskell
36 lines
924 B
Haskell
|
{-# LANGUAGE OverloadedStrings #-}
|
||
|
|
|
||
|
|
module TokenRefresh where
|
||
|
|
|
||
|
|
import Config
|
||
|
|
import Data.Time.Clock
|
||
|
|
import Database.MongoDB
|
||
|
|
import Xero
|
||
|
|
|
||
|
|
main :: IO ()
|
||
|
|
main = do
|
||
|
|
putStrLn "Reading config..."
|
||
|
|
now <- getCurrentTime
|
||
|
|
loadedConfig <- loadZGoConfig "zgo.cfg"
|
||
|
|
pipe <- connect $ host (c_dbHost loadedConfig)
|
||
|
|
let db = c_dbName loadedConfig
|
||
|
|
j <-
|
||
|
|
access
|
||
|
|
pipe
|
||
|
|
master
|
||
|
|
db
|
||
|
|
(auth (c_dbUser loadedConfig) (c_dbPassword loadedConfig))
|
||
|
|
if j
|
||
|
|
then putStrLn "Connected to MongoDB!"
|
||
|
|
else fail "MongoDB connection failed!"
|
||
|
|
credsData <- access pipe master db findXero
|
||
|
|
let creds = cast' . Doc =<< credsData
|
||
|
|
tokens <- access pipe master db (findExpiringTokens now)
|
||
|
|
if not (null tokens)
|
||
|
|
then do
|
||
|
|
let t = map (cast' . Doc) tokens
|
||
|
|
case creds of
|
||
|
|
Just c -> mapM_ (refreshToken pipe db c "") t
|
||
|
|
Nothing -> fail "No credentials"
|
||
|
|
else putStrLn "No tokens to refresh1"
|