|
| 1 | +{-# LANGUAGE OverloadedStrings #-} |
| 2 | +-- |
| 3 | +-- OAuth2 plugin for https://slack.com/ |
| 4 | +-- |
| 5 | +-- * Authenticates against slack |
| 6 | +-- * Uses slack user id as credentials identifier |
| 7 | +-- * Returns name, access_token, email, avatar, team_id, and team_name as extras |
| 8 | +-- |
| 9 | +module Yesod.Auth.OAuth2.Slack |
| 10 | + ( SlackScope(..) |
| 11 | + , oauth2Slack |
| 12 | + , oauth2SlackScoped |
| 13 | + ) where |
| 14 | + |
| 15 | +import Data.Aeson |
| 16 | +import Yesod.Auth |
| 17 | +import Yesod.Auth.OAuth2 |
| 18 | + |
| 19 | +import Control.Exception.Lifted (throwIO) |
| 20 | +import Data.Maybe (catMaybes) |
| 21 | +import Data.Monoid ((<>)) |
| 22 | +import Data.Text (Text) |
| 23 | +import Data.Text.Encoding (decodeUtf8, encodeUtf8) |
| 24 | +import Network.HTTP.Conduit (Manager) |
| 25 | + |
| 26 | +import qualified Data.Text as Text |
| 27 | +import qualified Network.HTTP.Conduit as HTTP |
| 28 | + |
| 29 | +data SlackScope |
| 30 | + = SlackEmailScope |
| 31 | + | SlackTeamScope |
| 32 | + | SlackAvatarScope |
| 33 | + |
| 34 | +data SlackUser = SlackUser |
| 35 | + { slackUserId :: Text |
| 36 | + , slackUserName :: Text |
| 37 | + , slackUserEmail :: Maybe Text |
| 38 | + , slackUserAvatarUrl :: Maybe Text |
| 39 | + , slackUserTeam :: Maybe SlackTeam |
| 40 | + } |
| 41 | + |
| 42 | +data SlackTeam = SlackTeam |
| 43 | + { slackTeamId :: Text |
| 44 | + , slackTeamName :: Text |
| 45 | + } |
| 46 | + |
| 47 | +instance FromJSON SlackUser where |
| 48 | + parseJSON = withObject "root" $ \root -> do |
| 49 | + user <- root .: "user" |
| 50 | + |
| 51 | + SlackUser |
| 52 | + <$> user .: "id" |
| 53 | + <*> user .: "name" |
| 54 | + <*> user .:? "email" |
| 55 | + <*> user .:? "image_512" |
| 56 | + <*> root .:? "team" |
| 57 | + |
| 58 | +instance FromJSON SlackTeam where |
| 59 | + parseJSON = withObject "team" $ \team -> |
| 60 | + SlackTeam |
| 61 | + <$> team .: "id" |
| 62 | + <*> team .: "name" |
| 63 | + |
| 64 | +-- | Auth with Slack |
| 65 | +-- |
| 66 | +-- Requests @identity.basic@ scopes and uses the user's Slack ID as the @'Creds'@ |
| 67 | +-- identifier. |
| 68 | +-- |
| 69 | +oauth2Slack :: YesodAuth m |
| 70 | + => Text -- ^ Client ID |
| 71 | + -> Text -- ^ Client Secret |
| 72 | + -> AuthPlugin m |
| 73 | +oauth2Slack clientId clientSecret = oauth2SlackScoped clientId clientSecret [] |
| 74 | + |
| 75 | +-- | Auth with Slack |
| 76 | +-- |
| 77 | +-- Requests custom scopes and uses the user's Slack ID as the @'Creds'@ |
| 78 | +-- identifier. |
| 79 | +-- |
| 80 | +oauth2SlackScoped :: YesodAuth m |
| 81 | + => Text -- ^ Client ID |
| 82 | + -> Text -- ^ Client Secret |
| 83 | + -> [SlackScope] |
| 84 | + -> AuthPlugin m |
| 85 | +oauth2SlackScoped clientId clientSecret scopes = |
| 86 | + authOAuth2 "slack" oauth fetchSlackProfile |
| 87 | + where |
| 88 | + oauth = OAuth2 |
| 89 | + { oauthClientId = encodeUtf8 clientId |
| 90 | + , oauthClientSecret = encodeUtf8 clientSecret |
| 91 | + , oauthOAuthorizeEndpoint = |
| 92 | + encodeUtf8 |
| 93 | + $ "https://slack.com/oauth/authorize?scope=" |
| 94 | + <> Text.intercalate "," scopeTexts |
| 95 | + , oauthAccessTokenEndpoint = "https://slack.com/api/oauth.access" |
| 96 | + , oauthCallback = Nothing |
| 97 | + } |
| 98 | + scopeTexts = "identity.basic":map scopeText scopes |
| 99 | + |
| 100 | +scopeText :: SlackScope -> Text |
| 101 | +scopeText SlackEmailScope = "identity.email" |
| 102 | +scopeText SlackTeamScope = "identity.team" |
| 103 | +scopeText SlackAvatarScope = "identity.avatar" |
| 104 | + |
| 105 | +fetchSlackProfile :: Manager -> AccessToken -> IO (Creds m) |
| 106 | +fetchSlackProfile manager token = do |
| 107 | + request |
| 108 | + <- HTTP.setQueryString [("token", Just $ accessToken token)] |
| 109 | + <$> HTTP.parseUrl "https://slack.com/api/users.identity" |
| 110 | + body <- HTTP.responseBody <$> HTTP.httpLbs request manager |
| 111 | + case eitherDecode body of |
| 112 | + Left _ -> throwIO $ InvalidProfileResponse "slack" body |
| 113 | + Right u -> return $ toCreds u token |
| 114 | + |
| 115 | +toCreds :: SlackUser -> AccessToken -> Creds m |
| 116 | +toCreds user token = Creds |
| 117 | + { credsPlugin = "slack" |
| 118 | + , credsIdent = slackUserId user |
| 119 | + , credsExtra = catMaybes |
| 120 | + [ Just ("name", slackUserName user) |
| 121 | + , Just ("access_token", decodeUtf8 $ accessToken token) |
| 122 | + , (,) <$> pure "email" <*> slackUserEmail user |
| 123 | + , (,) <$> pure "avatar" <*> slackUserAvatarUrl user |
| 124 | + , (,) <$> pure "team_name" <*> (slackTeamName <$> slackUserTeam user) |
| 125 | + , (,) <$> pure "team_id" <*> (slackTeamId <$> slackUserTeam user) |
| 126 | + ] |
| 127 | + } |
0 commit comments