Auth.hs 1.83 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
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
import           Import
import           Network.Google
import           Network.Google.AppsCalendar
import           Network.Google.Auth
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"]
39
40

authorizeMain :: IO ()
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
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."