Commit 224aba22 authored by Christopher League's avatar Christopher League
Browse files

Load google credentials on startup

parent feb20b30
......@@ -23,7 +23,11 @@ import Control.Monad.Logger (liftLoc)
import Import
import Language.Haskell.TH.Syntax (qLocation)
import Network.HTTP.Client.TLS (getGlobalManager)
import Network.Google.Auth (OAuthClient(..))
import System.Environment (getEnv)
import Network.Google.Auth.ApplicationDefault (fromJSONCredentials)
import Network.Wai (Middleware)
import qualified Data.Aeson as Js
import Network.Wai.Handler.Warp (Settings, defaultSettings,
defaultShouldDisplayException,
runSettings, setHost,
......@@ -60,6 +64,12 @@ makeFoundation appSettings = do
(if appMutableStatic appSettings then staticDevel else static)
(appStaticDir appSettings)
OAuthClient{..} <- oauthClientFromEnv
token <- getEnv varGoogleRefreshToken
appGoogleCreds <- either throwString return $ fromJSONCredentials
$ Js.encode $ object ["client_id" .= _clientId, "client_secret" .= _clientSecret,
"refresh_token" .= token]
-- Return the foundation
return App {..}
......
{-# LANGUAGE DataKinds #-}
{-# LANGUAGE NoImplicitPrelude #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE TemplateHaskell #-}
......@@ -15,6 +16,7 @@ import Text.Jasmine (minifym)
import Yesod.Core.Types (Logger)
import Yesod.Default.Util (addStaticContentExternal)
import qualified Yesod.Core.Unsafe as Unsafe
import Network.Google.Auth (Credentials)
import qualified Data.CaseInsensitive as CI
import qualified Data.Text.Encoding as TE
......@@ -27,6 +29,7 @@ data App = App
, appStatic :: Static -- ^ Settings for static file serving.
, appHttpManager :: Manager
, appLogger :: Logger
, appGoogleCreds :: Credentials CalendarScope
}
data MenuItem = MenuItem
......
{-# LANGUAGE DataKinds #-}
{-# LANGUAGE CPP #-}
{-# LANGUAGE NoImplicitPrelude #-}
{-# LANGUAGE OverloadedStrings #-}
......@@ -17,6 +18,8 @@ import Data.Aeson (Result (..), fromJSON, withObject, (.!=),
import Data.FileEmbed (embedFile)
import Data.Yaml (decodeEither')
import Language.Haskell.TH.Syntax (Exp, Name, Q)
import Network.Google.Auth (OAuthClient(..), ClientId(..), Secret(..))
import System.Environment (getEnv)
import Network.Wai.Handler.Warp (HostPreference)
import Yesod.Default.Config2 (applyEnvValue, configSettingsYml)
import Yesod.Default.Util (WidgetFileSettings, widgetFileNoReload,
......@@ -137,3 +140,19 @@ combineScripts :: Name -> [Route Static] -> Q Exp
combineScripts = combineScripts'
(appSkipCombining compileTimeAppSettings)
combineSettings
varGoogleClientId :: IsString s => s
varGoogleClientId = "BOOKME_GOOGLE_ID"
varGoogleSecret :: IsString s => s
varGoogleSecret = "BOOKME_GOOGLE_SECRET"
varGoogleRefreshToken :: IsString s => s
varGoogleRefreshToken = "BOOKME_GOOGLE_REFRESH"
type CalendarScope = '[ "https://www.googleapis.com/auth/calendar"]
oauthClientFromEnv :: IO OAuthClient
oauthClientFromEnv =
OAuthClient <$> (ClientId . pack <$> getEnv varGoogleClientId) <*>
(Secret . pack <$> getEnv varGoogleSecret)
......@@ -15,27 +15,14 @@ module Settings.Auth
) where
import Import
import Network.Google
import Network.Google.AppsCalendar
import Network.Google.Auth
import Network.Google (LogLevel (Error), newLogger)
import Network.Google.AppsCalendar (calendarScope)
import Network.Google.Auth (Auth (..),
Credentials (FromClient),
OAuthCode (..), OAuthToken (..),
RefreshToken (..), exchange,
formURL)
import Network.HTTP.Client.TLS (tlsManagerSettings)
import System.Environment (getEnv)
varGoogleClientId :: IsString s => s
varGoogleClientId = "BOOKME_GOOGLE_ID"
varGoogleSecret :: IsString s => s
varGoogleSecret = "BOOKME_GOOGLE_SECRET"
varGoogleRefreshToken :: IsString s => s
varGoogleRefreshToken = "BOOKME_GOOGLE_REFRESH"
oauthClientFromEnv :: IO OAuthClient
oauthClientFromEnv =
OAuthClient <$> (ClientId . pack <$> getEnv varGoogleClientId) <*>
(Secret . pack <$> getEnv varGoogleSecret)
type CalendarScope = '[ "https://www.googleapis.com/auth/calendar"]
authorizeMain :: IO ()
authorizeMain = do
......
......@@ -47,6 +47,9 @@ extra-deps:
- gogol
- gogol-apps-calendar
nix:
enable: true
pure: false
# Override default flag values for local packages and extra-deps
# flags: {}
......
Markdown is supported
0% or .
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment