From aad8bd88eabf9fcf368d044e7003e5d323985837 Mon Sep 17 00:00:00 2001
From: Joe Ferris <jferris@thoughtbot.com>
Date: Thu, 26 May 2016 16:42:36 -0400
Subject: [PATCH] Sign in with Slack

https://api.slack.com/docs/sign-in-with-slack
---
 README.md                  |  22 +++++++
 Yesod/Auth/OAuth2/Slack.hs | 127 +++++++++++++++++++++++++++++++++++++
 yesod-auth-oauth2.cabal    |   1 +
 3 files changed, 150 insertions(+)
 create mode 100644 Yesod/Auth/OAuth2/Slack.hs

diff --git a/README.md b/README.md
index 8e7f4e9..fba6f58 100644
--- a/README.md
+++ b/README.md
@@ -22,6 +22,28 @@ clientSecret :: Text
 clientSecret = "..."
 ```
 
+Some plugins, such as GitHub and Slack, have scoped functions for requesting
+additional information:
+
+```haskell
+import Yesod.Auth
+import Yesod.Auth.OAuth2.Slack
+
+instance YesodAuth App where
+    -- ...
+
+    authPlugins _ =
+        [oauth2SlackScoped clientId clientSecret slackScopes]
+      where
+        slackScopes = [SlackEmailScope, SlackAvatarScope, ScopeSlackTeamScope]
+
+clientId :: Text
+clientId = "..."
+
+clientSecret :: Text
+clientSecret = "..."
+```
+
 ## Advanced Usage
 
 To use any other provider:
diff --git a/Yesod/Auth/OAuth2/Slack.hs b/Yesod/Auth/OAuth2/Slack.hs
new file mode 100644
index 0000000..d2d153f
--- /dev/null
+++ b/Yesod/Auth/OAuth2/Slack.hs
@@ -0,0 +1,127 @@
+{-# LANGUAGE OverloadedStrings #-}
+--
+-- OAuth2 plugin for https://slack.com/
+--
+-- * Authenticates against slack
+-- * Uses slack user id as credentials identifier
+-- * Returns name, access_token, email, avatar, team_id, and team_name as extras
+--
+module Yesod.Auth.OAuth2.Slack
+    ( SlackScope(..)
+    , oauth2Slack
+    , oauth2SlackScoped
+    ) where
+
+import Data.Aeson
+import Yesod.Auth
+import Yesod.Auth.OAuth2
+
+import Control.Exception.Lifted (throwIO)
+import Data.Maybe (catMaybes)
+import Data.Monoid ((<>))
+import Data.Text (Text)
+import Data.Text.Encoding (decodeUtf8, encodeUtf8)
+import Network.HTTP.Conduit (Manager)
+
+import qualified Data.Text as Text
+import qualified Network.HTTP.Conduit as HTTP
+
+data SlackScope
+    = SlackEmailScope
+    | SlackTeamScope
+    | SlackAvatarScope
+
+data SlackUser = SlackUser
+    { slackUserId :: Text
+    , slackUserName :: Text
+    , slackUserEmail :: Maybe Text
+    , slackUserAvatarUrl :: Maybe Text
+    , slackUserTeam :: Maybe SlackTeam
+    }
+
+data SlackTeam = SlackTeam
+    { slackTeamId :: Text
+    , slackTeamName :: Text
+    }
+
+instance FromJSON SlackUser where
+    parseJSON = withObject "root" $ \root -> do
+        user <- root .: "user"
+
+        SlackUser
+            <$> user .: "id"
+            <*> user .: "name"
+            <*> user .:? "email"
+            <*> user .:? "image_512"
+            <*> root .:? "team"
+
+instance FromJSON SlackTeam where
+    parseJSON = withObject "team" $ \team ->
+        SlackTeam
+            <$> team .: "id"
+            <*> team .: "name"
+
+-- | Auth with Slack
+--
+-- Requests @identity.basic@ scopes and uses the user's Slack ID as the @'Creds'@
+-- identifier.
+--
+oauth2Slack :: YesodAuth m
+             => Text -- ^ Client ID
+             -> Text -- ^ Client Secret
+             -> AuthPlugin m
+oauth2Slack clientId clientSecret = oauth2SlackScoped clientId clientSecret []
+
+-- | Auth with Slack
+--
+-- Requests custom scopes and uses the user's Slack ID as the @'Creds'@
+-- identifier.
+--
+oauth2SlackScoped :: YesodAuth m
+             => Text -- ^ Client ID
+             -> Text -- ^ Client Secret
+             -> [SlackScope]
+             -> AuthPlugin m
+oauth2SlackScoped clientId clientSecret scopes =
+    authOAuth2 "slack" oauth fetchSlackProfile
+  where
+    oauth = OAuth2
+        { oauthClientId = encodeUtf8 clientId
+        , oauthClientSecret = encodeUtf8 clientSecret
+        , oauthOAuthorizeEndpoint =
+            encodeUtf8
+            $ "https://slack.com/oauth/authorize?scope="
+            <> Text.intercalate "," scopeTexts
+        , oauthAccessTokenEndpoint = "https://slack.com/api/oauth.access"
+        , oauthCallback = Nothing
+        }
+    scopeTexts = "identity.basic":map scopeText scopes
+
+scopeText :: SlackScope -> Text
+scopeText SlackEmailScope = "identity.email"
+scopeText SlackTeamScope = "identity.team"
+scopeText SlackAvatarScope = "identity.avatar"
+
+fetchSlackProfile :: Manager -> AccessToken -> IO (Creds m)
+fetchSlackProfile manager token = do
+    request
+        <- HTTP.setQueryString [("token", Just $ accessToken token)]
+        <$> HTTP.parseUrl "https://slack.com/api/users.identity"
+    body <- HTTP.responseBody <$> HTTP.httpLbs request manager
+    case eitherDecode body of
+        Left _ -> throwIO $ InvalidProfileResponse "slack" body
+        Right u -> return $ toCreds u token
+
+toCreds :: SlackUser -> AccessToken -> Creds m
+toCreds user token = Creds
+    { credsPlugin = "slack"
+    , credsIdent = slackUserId user
+    , credsExtra = catMaybes
+        [ Just ("name", slackUserName user)
+        , Just ("access_token", decodeUtf8 $ accessToken token)
+        , (,) <$> pure "email" <*> slackUserEmail user
+        , (,) <$> pure "avatar" <*> slackUserAvatarUrl user
+        , (,) <$> pure "team_name" <*> (slackTeamName <$> slackUserTeam user)
+        , (,) <$> pure "team_id" <*> (slackTeamId <$> slackUserTeam user)
+        ]
+    }
diff --git a/yesod-auth-oauth2.cabal b/yesod-auth-oauth2.cabal
index 6470db2..6a30ba0 100644
--- a/yesod-auth-oauth2.cabal
+++ b/yesod-auth-oauth2.cabal
@@ -50,6 +50,7 @@ library
                      Yesod.Auth.OAuth2.Upcase
                      Yesod.Auth.OAuth2.EveOnline
                      Yesod.Auth.OAuth2.Nylas
+                     Yesod.Auth.OAuth2.Slack
 
     ghc-options:     -Wall