115 lines
5.0 KiB
Diff
115 lines
5.0 KiB
Diff
diff --git a/src/StatusNotifier/Item/Notifications/Gmail.hs b/src/StatusNotifier/Item/Notifications/Gmail.hs
|
|
index 6b8206b..cd5834f 100644
|
|
--- a/src/StatusNotifier/Item/Notifications/Gmail.hs
|
|
+++ b/src/StatusNotifier/Item/Notifications/Gmail.hs
|
|
@@ -12,7 +12,7 @@ module StatusNotifier.Item.Notifications.Gmail
|
|
) where
|
|
|
|
import Control.Concurrent
|
|
-import Control.Concurrent.Async (race)
|
|
+import Control.Concurrent.Async (race, wait, withAsync)
|
|
import Control.Concurrent.MVar as MV
|
|
import Control.Exception (SomeException, bracket, try)
|
|
import Control.Monad
|
|
@@ -76,11 +76,13 @@ import Network.HTTP.Conduit (newManager, tlsManagerSettings)
|
|
import qualified Network.HTTP.Client as Client
|
|
import Network.Socket
|
|
import Network.Socket.ByteString (recv, sendAll)
|
|
+import Network.HTTP.Types.URI (urlDecode, urlEncode)
|
|
import StatusNotifier.Item.Notifications.Util
|
|
import System.Directory (createDirectoryIfMissing, doesFileExist, getXdgDirectory, XdgDirectory(..))
|
|
import System.FilePath ((</>))
|
|
import System.IO (hFlush, stdout)
|
|
import System.Log.Logger
|
|
+import qualified System.Process as P
|
|
import Text.Printf
|
|
|
|
-- | Configuration for the Gmail notifier.
|
|
@@ -130,14 +132,23 @@ loopbackAuthURL :: OAuthClient -> Int -> T.Text
|
|
loopbackAuthURL client port =
|
|
accountsURL
|
|
<> "?response_type=code"
|
|
- <> "&client_id=" <> toQueryParam (_clientId client)
|
|
- <> "&redirect_uri=" <> loopbackRedirectURI port
|
|
+ <> "&client_id=" <> urlEncodeText (toQueryParam (_clientId client))
|
|
+ <> "&redirect_uri=" <> urlEncodeText (loopbackRedirectURI port)
|
|
<> "&scope=" <> T.decodeUtf8 (queryEncodeScopes (scopeVals (Proxy :: Proxy '[Gmail'Modify])))
|
|
<> "&access_type=offline"
|
|
|
|
loopbackRedirectURI :: Int -> T.Text
|
|
loopbackRedirectURI port = "http://localhost:" <> T.pack (show port)
|
|
|
|
+urlEncodeText :: T.Text -> T.Text
|
|
+urlEncodeText = T.decodeUtf8 . urlEncode True . T.encodeUtf8
|
|
+
|
|
+urlDecodeText :: BS8.ByteString -> T.Text
|
|
+urlDecodeText = T.decodeUtf8 . urlDecode True
|
|
+
|
|
+formParam :: T.Text -> T.Text -> T.Text
|
|
+formParam key value = key <> "=" <> urlEncodeText value
|
|
+
|
|
-- | Exchange an authorization code for a token using the loopback redirect URI.
|
|
exchangeCodeLoopback
|
|
:: OAuthClient -> OAuthCode s -> Int
|
|
@@ -146,14 +157,31 @@ exchangeCodeLoopback
|
|
exchangeCodeLoopback client code port =
|
|
refreshRequest $
|
|
tokenRequest
|
|
- { Client.requestBody = textBody $
|
|
- "grant_type=authorization_code"
|
|
- <> "&client_id=" <> toQueryParam (_clientId client)
|
|
- <> "&client_secret=" <> toQueryParam (_clientSecret client)
|
|
- <> "&code=" <> toQueryParam code
|
|
- <> "&redirect_uri=" <> loopbackRedirectURI port
|
|
+ { Client.requestBody = textBody $ T.intercalate "&"
|
|
+ [ formParam "grant_type" "authorization_code"
|
|
+ , formParam "client_id" (toQueryParam (_clientId client))
|
|
+ , formParam "client_secret" (toQueryParam (_clientSecret client))
|
|
+ , formParam "code" (toQueryParam code)
|
|
+ , formParam "redirect_uri" (loopbackRedirectURI port)
|
|
+ ]
|
|
}
|
|
|
|
+-- | Open the authorization URL without waiting for the browser process.
|
|
+--
|
|
+-- xdg-open can remain parented to the browser on some desktop sessions. If we
|
|
+-- wait for it, the OAuth redirect listener never starts and Google redirects to
|
|
+-- a closed localhost port.
|
|
+openBrowserDetached :: T.Text -> IO ()
|
|
+openBrowserDetached url = do
|
|
+ let process =
|
|
+ (P.proc "/usr/bin/env" ["xdg-open", T.unpack url])
|
|
+ { P.std_in = P.NoStream
|
|
+ , P.std_out = P.NoStream
|
|
+ , P.std_err = P.NoStream
|
|
+ , P.close_fds = True
|
|
+ }
|
|
+ void $ P.createProcess process
|
|
+
|
|
-- | Start a temporary HTTP server, wait for the OAuth redirect, extract the code.
|
|
waitForOAuthRedirect :: Int -> IO T.Text
|
|
waitForOAuthRedirect port = do
|
|
@@ -200,7 +228,7 @@ extractCodeFromRequest req = do
|
|
-- | Parse query parameters from a query string like "code=xxx&scope=yyy"
|
|
parseQueryParams :: BS8.ByteString -> [(BS8.ByteString, T.Text)]
|
|
parseQueryParams qs =
|
|
- [ (key, T.decodeUtf8 val)
|
|
+ [ (key, urlDecodeText val)
|
|
| part <- BS8.split '&' qs
|
|
, let (key, rest) = BS8.break (== '=') part
|
|
val = BS8.drop 1 rest -- drop the '='
|
|
@@ -233,9 +261,11 @@ setupGmailEnv config@GmailConfig{..} = do
|
|
authUrl = loopbackAuthURL client port
|
|
gmailLog INFO "Starting OAuth2 loopback flow"
|
|
putStrLn "Opening browser for Gmail authorization..."
|
|
- void $ xdgOpen [T.unpack authUrl]
|
|
putStrLn $ "Waiting for authorization redirect on port " ++ show port ++ "..."
|
|
- code <- waitForOAuthRedirect port
|
|
+ code <- withAsync (waitForOAuthRedirect port) $ \redirectWaiter -> do
|
|
+ threadDelay 100000
|
|
+ openBrowserDetached authUrl
|
|
+ wait redirectWaiter
|
|
gmailLog INFO "Authorization code received"
|
|
|
|
-- Exchange the code ourselves (with matching loopback redirect_uri)
|