Auth.hs 1.65 KB
Newer Older
1
2
3
4
5
6
{-# LANGUAGE DataKinds           #-}
{-# LANGUAGE NoImplicitPrelude   #-}
{-# LANGUAGE OverloadedStrings   #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE TypeFamilies        #-}

7
8
9
10
11
12
13
14
15
16
{-|
Module: Settings.Auth
Description: TODO

TODO
-}
module Settings.Auth
  ( authorizeMain
  ) where

17
import           Import
18
19
20
21
22
23
24
import           Network.Google              (LogLevel (Error), newLogger)
import           Network.Google.AppsCalendar (calendarScope)
import           Network.Google.Auth         (Auth (..),
                                              Credentials (FromClient),
                                              OAuthCode (..), OAuthToken (..),
                                              RefreshToken (..), exchange,
                                              formURL)
25
import           Network.HTTP.Client.TLS     (tlsManagerSettings)
26
27

authorizeMain :: IO ()
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
authorizeMain = do
  oac <- oauthClientFromEnv
  codeOpt <- headMay <$> getArgs
  case codeOpt of
    Nothing ->
      putStr $
      "\nTo authorize w/Google, open the following URL:\n\n" <>
      formURL oac calendarScope <>
      "\n\nThen run again with code as first argument.\n"
    Just code -> do
      let creds = FromClient oac (OAuthCode code) :: Credentials CalendarScope
      mgr <- newManagerSettings tlsManagerSettings
      lgr <- newLogger Error stdout
      auth <- exchange creds lgr mgr
      case _tokenRefresh (_token auth) of
        Just (RefreshToken tok) ->
          putStr $
          "\nAdd this to your environment:\n\n" <> "export " <>
          varGoogleRefreshToken <>
          "=" <>
          tok <>
          "\n"
        Nothing -> putStrLn "Hmm, didn't get refresh token."