InstalledApplication.hs

{-# LANGUAGE DataKinds #-}
{-# LANGUAGE KindSignatures #-}
{-# LANGUAGE OverloadedStrings #-}

-- |
-- Module      : Gogol.Auth.InstalledApplication
-- Copyright   : (c) 2015-2022 Brendan Hay
-- License     : Mozilla Public License, v. 2.0.
-- Maintainer  : Brendan Hay <brendan.g.hay@gmail.com>
-- Stability   : provisional
-- Portability : non-portable (GHC extensions)
--
-- Credentials for applications that are installed on devices such as
-- computers, cell phones, or a tablet. Installed apps are distributed to
-- individual machines, and it is assumed that these apps securely store secrets.
--
-- These apps might access a Google service while the user is present at the
-- application, or when the application is running in the background.
--
-- /See:/ <https://developers.google.com/identity/protocols/OAuth2InstalledApp Installed Application Documentation>.
module Gogol.Auth.InstalledApplication
  ( installedApplication,

    -- * Forming the URL
    AccessType (..),
    redirectURI,
    formURL,
    formAccessTypeURL,
    formURLWith,
    formAccessTypeURLWith,

    -- * Internal Exchange and Refresh
    exchangeCode,
    refreshToken,
  )
where

import Control.Monad.Catch (MonadCatch)
import Control.Monad.IO.Class (MonadIO)
import Data.Text qualified as Text
import Data.Text.Encoding qualified as Text
import GHC.TypeLits (Symbol)
import Gogol.Auth.Scope
  ( KnownScopes (..),
    queryEncodeScopes,
  )
import Gogol.Internal.Auth
import Gogol.Internal.Logger (Logger)
import Gogol.Prelude
import Network.HTTP.Conduit (Manager)
import Network.HTTP.Conduit qualified as Client

-- | Create new Installed Application credentials.
--
-- Since it is intended that the user opens the URL generated by 'formURL' in a browser
-- and the resulting 'OAuthCode' is then received out-of-band,
-- you must ensure that the scopes passed to 'formURL' and the type of 'OAuthCode'
-- correctly match, otherwise an authorization error will occur.
--
-- For example, doing this via 'getLine' and copy-paste:
--
-- > {-# LANGUAGE ScopedTypeVariables #-}
--
-- > import Data.Proxy     (Proxy (..))
-- > import Data.Text      as T
-- > import Data.Text.IO   as T
-- > import System.Exit    (exitFailure)
-- > import System.Info    (os)
-- > import System.Process (rawSystem)
--
-- > redirectPrompt :: KnownScopes (s :: [Symbol]) => OAuthClient -> proxy s -> IO (OAuthCode s)
-- > redirectPrompt c p = do
-- >   let url = formURL c p
-- >   T.putStrLn $ "Opening URL " `T.append` url
-- >   _ <- case os of
-- >     "darwin" -> rawSystem "open"     [unpack url]
-- >     "linux"  -> rawSystem "xdg-open" [unpack url]
-- >     _        -> T.putStrLn "Unsupported OS" >> exitFailure
-- >   T.putStrLn "Please input the authorisation code: "
-- >   OAuthCode <$> T.getLine
--
-- This ensures the scopes passed to 'formURL' and the type of 'OAuthCode' 's'
-- are correct.
installedApplication :: OAuthClient -> OAuthCode s -> Credentials s
installedApplication = FromClient

-- /See:/ <https://developers.google.com/identity/protocols/OAuth2WebServer#offline>
data AccessType = Online | Offline deriving (Show, Eq)

-- | The redirection URI used in 'formURL': @urn:ietf:wg:oauth:2.0:oob@.
redirectURI :: Text
redirectURI = "urn:ietf:wg:oauth:2.0:oob"

-- | Given an 'OAuthClient' and a list of scopes to authorize,
-- construct a URL that can be used to obtain the 'OAuthCode'.
--
-- /See:/ <https://developers.google.com/accounts/docs/OAuth2InstalledApp#formingtheurl Forming the URL>.
formURL :: (KnownScopes (s :: [Symbol])) => OAuthClient -> proxy s -> Text
formURL c = formURLWith c . scopeVals

-- | 'formURL' for 'AccessType'
--
-- /See:/ 'formUrl'.
formAccessTypeURL :: (KnownScopes (s :: [Symbol])) => OAuthClient -> AccessType -> proxy s -> Text
formAccessTypeURL c a = formAccessTypeURLWith c a . scopeVals

-- | Form a URL using 'OAuthScope' values.
--
-- /See:/ 'formURL'.
formURLWith :: OAuthClient -> [OAuthScope] -> Text
formURLWith c ss =
  accountsURL
    <> "?response_type=code"
    <> "&client_id="
    <> toQueryParam (_clientId c)
    <> "&redirect_uri="
    <> redirectURI
    <> "&scope="
    <> Text.decodeUtf8 (queryEncodeScopes ss)

-- | 'formURLWith' for 'AccessType'
--
-- /See:/ 'formURLWith'.
formAccessTypeURLWith :: OAuthClient -> AccessType -> [OAuthScope] -> Text
formAccessTypeURLWith c a ss =
  formURLWith c ss
    <> "&access_type="
    <> (Text.toLower . Text.pack $ show a)

-- | Exchange 'OAuthClient' details and the received 'OAuthCode' for a new
-- 'OAuthToken'.
--
-- /See:/ <https://developers.google.com/accounts/docs/OAuth2InstalledApp#handlingtheresponse Exchanging the code>.
exchangeCode ::
  (MonadIO m, MonadCatch m) =>
  OAuthClient ->
  (OAuthCode s) ->
  Logger ->
  Manager ->
  m (OAuthToken s)
exchangeCode c n =
  refreshRequest $
    tokenRequest
      { Client.requestBody =
          textBody $
            "grant_type=authorization_code"
              <> "&client_id="
              <> toQueryParam (_clientId c)
              <> "&client_secret="
              <> toQueryParam (_clientSecret c)
              <> "&code="
              <> toQueryParam n
              <> "&redirect_uri="
              <> redirectURI
      }

-- | Perform a refresh to obtain a valid 'OAuthToken' with a new expiry time.
--
-- /See:/ <https://developers.google.com/accounts/docs/OAuth2InstalledApp#offline Refreshing tokens>.
refreshToken ::
  (MonadIO m, MonadCatch m) =>
  OAuthClient ->
  (OAuthToken s) ->
  Logger ->
  Manager ->
  m (OAuthToken s)
refreshToken c t =
  refreshRequest $
    tokenRequest
      { Client.requestBody =
          textBody $
            "grant_type=refresh_token"
              <> "&client_id="
              <> toQueryParam (_clientId c)
              <> "&client_secret="
              <> toQueryParam (_clientSecret c)
              <> maybe mempty ("&refresh_token=" <>) (toQueryParam <$> _tokenRefresh t)
      }