Sign in with Slack

https://api.slack.com/docs/sign-in-with-slack

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:

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)
+        ]
+    }

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