Remove extra fields from Slack

src/Yesod/Auth/OAuth2/Slack.hs

@@ -4,7 +4,6 @@
 --
 -- * 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(..)
@@ -14,103 +13,61 @@ module Yesod.Auth.OAuth2.Slack
 
 import Yesod.Auth.OAuth2.Prelude
 
-import Data.Maybe (catMaybes)
+import Network.HTTP.Client
-import qualified Network.HTTP.Conduit as HTTP
+    (httpLbs, parseUrlThrow, responseBody, setQueryString)
 
 data SlackScope
-    = SlackEmailScope
+    = SlackBasicScope
+    | 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 = clientId
-        , oauthClientSecret = clientSecret
-        , oauthOAuthorizeEndpoint = "https://slack.com/oauth/authorize" `withQuery`
-            [ scopeParam "," $ "identity.basic" : map scopeText scopes
-            ]
-        , oauthAccessTokenEndpoint = "https://slack.com/api/oauth.access"
-        , oauthCallback = Nothing
-        }
-
 scopeText :: SlackScope -> Text
+scopeText SlackBasicScope = "identity.basic"
 scopeText SlackEmailScope = "identity.email"
 scopeText SlackTeamScope = "identity.team"
 scopeText SlackAvatarScope = "identity.avatar"
 
-fetchSlackProfile :: Manager -> OAuth2Token -> IO (Creds m)
+newtype User = User Text
-fetchSlackProfile manager token = do
-    request
-        <- HTTP.setQueryString [("token", Just $ encodeUtf8 $ atoken $ accessToken token)]
-        <$> HTTP.parseUrlThrow "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 -> OAuth2Token -> Creds m
+instance FromJSON User where
-toCreds user token = Creds
+    parseJSON = withObject "User" $ \root -> do
-    { credsPlugin = "slack"
+        o <- root .: "user"
-    , credsIdent = slackUserId user
+        User <$> o .: "id"
-    , credsExtra = catMaybes
+
-        [ Just ("name", slackUserName user)
+pluginName :: Text
-        , Just ("access_token", atoken $ accessToken token)
+pluginName = "slack"
-        , (,) <$> pure "email" <*> slackUserEmail user
+
-        , (,) <$> pure "avatar" <*> slackUserAvatarUrl user
+defaultScopes :: [SlackScope]
-        , (,) <$> pure "team_name" <*> (slackTeamName <$> slackUserTeam user)
+defaultScopes = [SlackBasicScope]
-        , (,) <$> pure "team_id" <*> (slackTeamId <$> slackUserTeam user)
+
-        ]
+oauth2Slack :: YesodAuth m => Text -> Text -> AuthPlugin m
-    }
+oauth2Slack = oauth2SlackScoped defaultScopes
+
+oauth2SlackScoped :: YesodAuth m => [SlackScope] -> Text -> Text -> AuthPlugin m
+oauth2SlackScoped scopes clientId clientSecret =
+    authOAuth2 pluginName oauth2 $ \manager token -> do
+        let param = encodeUtf8 $ atoken $ accessToken token
+        req <- setQueryString [("token", Just param)]
+            <$> parseUrlThrow "https://slack.com/api/users.identity"
+        userResponseJSON <- responseBody <$> httpLbs req manager
+
+        either
+            (const $ throwIO $ InvalidProfileResponse pluginName userResponseJSON)
+            (\(User userId) -> pure Creds
+                { credsPlugin = pluginName
+                , credsIdent = userId
+                , credsExtra = setExtra token userResponseJSON
+                }
+            )
+            $ eitherDecode userResponseJSON
+  where
+    oauth2 = OAuth2
+        { oauthClientId = clientId
+        , oauthClientSecret = clientSecret
+        , oauthOAuthorizeEndpoint = "https://slack.com/oauth/authorize" `withQuery`
+            [ scopeParam "," $ map scopeText scopes
+            ]
+        , oauthAccessTokenEndpoint = "https://slack.com/api/oauth.access"
+        , oauthCallback = Nothing
+        }