diff --git a/src/Yesod/Auth/OAuth2.hs b/src/Yesod/Auth/OAuth2.hs index 5bed58a..fd472c4 100644 --- a/src/Yesod/Auth/OAuth2.hs +++ b/src/Yesod/Auth/OAuth2.hs @@ -8,37 +8,41 @@ -- See @"Yesod.Auth.OAuth2.GitHub"@ for example usage. -- module Yesod.Auth.OAuth2 - ( OAuth2(..) - , FetchCreds - , Manager - , OAuth2Token(..) - , Creds(..) - , oauth2Url - , authOAuth2 - , authOAuth2Widget + ( OAuth2(..) + , FetchCreds + , Manager + , OAuth2Token(..) + , Creds(..) + , oauth2Url + , authOAuth2 + , authOAuth2Widget -- * Alternatives that use 'fetchAccessToken2' - , authOAuth2' - , authOAuth2Widget' + , authOAuth2' + , authOAuth2Widget' -- * Reading our @'credsExtra'@ keys - , getAccessToken - , getRefreshToken - , getUserResponse - , getUserResponseJSON - ) where + , getAccessToken + , getRefreshToken + , getUserResponse + , getUserResponseJSON + ) where -import Control.Error.Util (note) -import Control.Monad ((<=<)) -import Data.Aeson (FromJSON, eitherDecode) -import Data.ByteString.Lazy (ByteString, fromStrict) -import Data.Text (Text) -import Data.Text.Encoding (encodeUtf8) -import Network.HTTP.Conduit (Manager) -import Network.OAuth.OAuth2.Compat -import Yesod.Auth -import Yesod.Auth.OAuth2.Dispatch -import Yesod.Core.Widget +import Control.Error.Util ( note ) +import Control.Monad ( (<=<) ) +import Data.Aeson ( FromJSON + , eitherDecode + ) +import Data.ByteString.Lazy ( ByteString + , fromStrict + ) +import Data.Text ( Text ) +import Data.Text.Encoding ( encodeUtf8 ) +import Network.HTTP.Conduit ( Manager ) +import Network.OAuth.OAuth2.Compat +import Yesod.Auth +import Yesod.Auth.OAuth2.Dispatch +import Yesod.Core.Widget oauth2Url :: Text -> AuthRoute oauth2Url name = PluginR name ["forward"] @@ -63,12 +67,12 @@ authOAuth2' name = authOAuth2Widget' [whamlet|Login via #{name}|] name -- example. -- authOAuth2Widget - :: YesodAuth m - => WidgetFor m () - -> Text - -> OAuth2 - -> FetchCreds m - -> AuthPlugin m + :: YesodAuth m + => WidgetFor m () + -> Text + -> OAuth2 + -> FetchCreds m + -> AuthPlugin m authOAuth2Widget = buildPlugin fetchAccessToken -- | A version of 'authOAuth2Widget' that uses 'fetchAccessToken2' @@ -76,27 +80,27 @@ authOAuth2Widget = buildPlugin fetchAccessToken -- See -- authOAuth2Widget' - :: YesodAuth m - => WidgetFor m () - -> Text - -> OAuth2 - -> FetchCreds m - -> AuthPlugin m + :: YesodAuth m + => WidgetFor m () + -> Text + -> OAuth2 + -> FetchCreds m + -> AuthPlugin m authOAuth2Widget' = buildPlugin fetchAccessToken2 buildPlugin - :: YesodAuth m - => FetchToken - -> WidgetFor m () - -> Text - -> OAuth2 - -> FetchCreds m - -> AuthPlugin m + :: YesodAuth m + => FetchToken + -> WidgetFor m () + -> Text + -> OAuth2 + -> FetchCreds m + -> AuthPlugin m buildPlugin getToken widget name oauth getCreds = AuthPlugin - name - (dispatchAuthRequest name oauth getToken getCreds) - login - where login tm = [whamlet|^{widget}|] + name + (dispatchAuthRequest name oauth getToken getCreds) + login + where login tm = [whamlet|^{widget}|] -- | Read the @'AccessToken'@ from the values set via @'setExtra'@ getAccessToken :: Creds m -> Maybe AccessToken @@ -112,9 +116,9 @@ getRefreshToken = (RefreshToken <$>) . lookup "refreshToken" . credsExtra -- | Read the original profile response from the values set via @'setExtra'@ getUserResponse :: Creds m -> Maybe ByteString getUserResponse = - (fromStrict . encodeUtf8 <$>) . lookup "userResponse" . credsExtra + (fromStrict . encodeUtf8 <$>) . lookup "userResponse" . credsExtra -- | @'getUserResponse'@, and decode as JSON getUserResponseJSON :: FromJSON a => Creds m -> Either String a getUserResponseJSON = - eitherDecode <=< note "userResponse key not present" . getUserResponse + eitherDecode <=< note "userResponse key not present" . getUserResponse diff --git a/src/Yesod/Auth/OAuth2/AzureAD.hs b/src/Yesod/Auth/OAuth2/AzureAD.hs index cc9b27e..050434e 100644 --- a/src/Yesod/Auth/OAuth2/AzureAD.hs +++ b/src/Yesod/Auth/OAuth2/AzureAD.hs @@ -7,18 +7,17 @@ -- * Uses email as credentials identifier -- module Yesod.Auth.OAuth2.AzureAD - ( oauth2AzureAD - , oauth2AzureADScoped - ) -where + ( oauth2AzureAD + , oauth2AzureADScoped + ) where -import Prelude -import Yesod.Auth.OAuth2.Prelude +import Prelude +import Yesod.Auth.OAuth2.Prelude newtype User = User Text instance FromJSON User where - parseJSON = withObject "User" $ \o -> User <$> o .: "mail" + parseJSON = withObject "User" $ \o -> User <$> o .: "mail" pluginName :: Text pluginName = "azuread" @@ -31,28 +30,26 @@ oauth2AzureAD = oauth2AzureADScoped defaultScopes oauth2AzureADScoped :: YesodAuth m => [Text] -> Text -> Text -> AuthPlugin m oauth2AzureADScoped scopes clientId clientSecret = - authOAuth2 pluginName oauth2 $ \manager token -> do - (User userId, userResponse) <- authGetProfile - pluginName - manager - token - "https://graph.microsoft.com/v1.0/me" + authOAuth2 pluginName oauth2 $ \manager token -> do + (User userId, userResponse) <- authGetProfile + pluginName + manager + token + "https://graph.microsoft.com/v1.0/me" - pure Creds - { credsPlugin = pluginName - , credsIdent = userId - , credsExtra = setExtra token userResponse - } - where - oauth2 = OAuth2 - { oauth2ClientId = clientId - , oauth2ClientSecret = Just clientSecret - , oauth2AuthorizeEndpoint = - "https://login.windows.net/common/oauth2/authorize" - `withQuery` [ scopeParam "," scopes - , ("resource", "https://graph.microsoft.com") - ] - , oauth2TokenEndpoint = - "https://login.windows.net/common/oauth2/token" - , oauth2RedirectUri = Nothing - } + pure Creds { credsPlugin = pluginName + , credsIdent = userId + , credsExtra = setExtra token userResponse + } + where + oauth2 = OAuth2 + { oauth2ClientId = clientId + , oauth2ClientSecret = Just clientSecret + , oauth2AuthorizeEndpoint = + "https://login.windows.net/common/oauth2/authorize" + `withQuery` [ scopeParam "," scopes + , ("resource", "https://graph.microsoft.com") + ] + , oauth2TokenEndpoint = "https://login.windows.net/common/oauth2/token" + , oauth2RedirectUri = Nothing + } diff --git a/src/Yesod/Auth/OAuth2/BattleNet.hs b/src/Yesod/Auth/OAuth2/BattleNet.hs index fd89b95..68cfe2e 100644 --- a/src/Yesod/Auth/OAuth2/BattleNet.hs +++ b/src/Yesod/Auth/OAuth2/BattleNet.hs @@ -9,65 +9,63 @@ -- * Returns user's battletag in extras. -- module Yesod.Auth.OAuth2.BattleNet - ( oauth2BattleNet - , oAuth2BattleNet - ) -where + ( oauth2BattleNet + , oAuth2BattleNet + ) where -import Yesod.Auth.OAuth2.Prelude +import Yesod.Auth.OAuth2.Prelude -import qualified Data.Text as T (pack, toLower) -import Yesod.Core.Widget +import qualified Data.Text as T + ( pack + , toLower + ) +import Yesod.Core.Widget newtype User = User Int instance FromJSON User where - parseJSON = withObject "User" $ \o -> User <$> o .: "id" + parseJSON = withObject "User" $ \o -> User <$> o .: "id" pluginName :: Text pluginName = "battle.net" oauth2BattleNet - :: YesodAuth m - => WidgetFor m () -- ^ Login widget - -> Text -- ^ User region (e.g. "eu", "cn", "us") - -> Text -- ^ Client ID - -> Text -- ^ Client Secret - -> AuthPlugin m + :: YesodAuth m + => WidgetFor m () -- ^ Login widget + -> Text -- ^ User region (e.g. "eu", "cn", "us") + -> Text -- ^ Client ID + -> Text -- ^ Client Secret + -> AuthPlugin m oauth2BattleNet widget region clientId clientSecret = - authOAuth2Widget widget pluginName oauth2 $ \manager token -> do - (User userId, userResponse) <- - authGetProfile pluginName manager token - $ fromRelative - "https" - (apiHost $ T.toLower region) - "/account/user" + authOAuth2Widget widget pluginName oauth2 $ \manager token -> do + (User userId, userResponse) <- + authGetProfile pluginName manager token + $ fromRelative "https" (apiHost $ T.toLower region) "/account/user" - pure Creds - { credsPlugin = pluginName - , credsIdent = T.pack $ show userId - , credsExtra = setExtra token userResponse - } - where - host = wwwHost $ T.toLower region - oauth2 = OAuth2 - { oauth2ClientId = clientId - , oauth2ClientSecret = Just clientSecret - , oauth2AuthorizeEndpoint = fromRelative "https" host "/oauth/authorize" - , oauth2TokenEndpoint = fromRelative "https" host "/oauth/token" - , oauth2RedirectUri = Nothing - } + pure Creds { credsPlugin = pluginName + , credsIdent = T.pack $ show userId + , credsExtra = setExtra token userResponse + } + where + host = wwwHost $ T.toLower region + oauth2 = OAuth2 + { oauth2ClientId = clientId + , oauth2ClientSecret = Just clientSecret + , oauth2AuthorizeEndpoint = fromRelative "https" host "/oauth/authorize" + , oauth2TokenEndpoint = fromRelative "https" host "/oauth/token" + , oauth2RedirectUri = Nothing + } apiHost :: Text -> Host -apiHost "cn" = "api.battlenet.com.cn" +apiHost "cn" = "api.battlenet.com.cn" apiHost region = Host $ encodeUtf8 $ region <> ".api.battle.net" wwwHost :: Text -> Host -wwwHost "cn" = "www.battlenet.com.cn" +wwwHost "cn" = "www.battlenet.com.cn" wwwHost region = Host $ encodeUtf8 $ region <> ".battle.net" oAuth2BattleNet - :: YesodAuth m => Text -> Text -> Text -> WidgetFor m () -> AuthPlugin m + :: YesodAuth m => Text -> Text -> Text -> WidgetFor m () -> AuthPlugin m oAuth2BattleNet i s r w = oauth2BattleNet w r i s {-# DEPRECATED oAuth2BattleNet "Use oauth2BattleNet" #-} diff --git a/src/Yesod/Auth/OAuth2/Bitbucket.hs b/src/Yesod/Auth/OAuth2/Bitbucket.hs index c485fee..1ed28f4 100644 --- a/src/Yesod/Auth/OAuth2/Bitbucket.hs +++ b/src/Yesod/Auth/OAuth2/Bitbucket.hs @@ -7,19 +7,18 @@ -- * Uses bitbucket uuid as credentials identifier -- module Yesod.Auth.OAuth2.Bitbucket - ( oauth2Bitbucket - , oauth2BitbucketScoped - ) -where + ( oauth2Bitbucket + , oauth2BitbucketScoped + ) where -import Yesod.Auth.OAuth2.Prelude +import Yesod.Auth.OAuth2.Prelude -import qualified Data.Text as T +import qualified Data.Text as T newtype User = User Text instance FromJSON User where - parseJSON = withObject "User" $ \o -> User <$> o .: "uuid" + parseJSON = withObject "User" $ \o -> User <$> o .: "uuid" pluginName :: Text pluginName = "bitbucket" @@ -32,32 +31,29 @@ oauth2Bitbucket = oauth2BitbucketScoped defaultScopes oauth2BitbucketScoped :: YesodAuth m => [Text] -> Text -> Text -> AuthPlugin m oauth2BitbucketScoped scopes clientId clientSecret = - authOAuth2 pluginName oauth2 $ \manager token -> do - (User userId, userResponse) <- authGetProfile - pluginName - manager - token - "https://api.bitbucket.com/2.0/user" + authOAuth2 pluginName oauth2 $ \manager token -> do + (User userId, userResponse) <- authGetProfile + pluginName + manager + token + "https://api.bitbucket.com/2.0/user" - pure Creds - { credsPlugin = pluginName - -- FIXME: Preserved bug. This should just be userId (it's already - -- a Text), but because this code was shipped, folks likely have - -- Idents in their database like @"\"...\""@, and if we fixed this - -- they would need migrating. We're keeping it for now as it's a - -- minor wart. Breaking typed APIs is one thing, causing data to go - -- invalid is another. - , credsIdent = T.pack $ show userId - , credsExtra = setExtra token userResponse - } - where - oauth2 = OAuth2 - { oauth2ClientId = clientId - , oauth2ClientSecret = Just clientSecret - , oauth2AuthorizeEndpoint = - "https://bitbucket.com/site/oauth2/authorize" - `withQuery` [scopeParam "," scopes] - , oauth2TokenEndpoint = - "https://bitbucket.com/site/oauth2/access_token" - , oauth2RedirectUri = Nothing - } + pure Creds { credsPlugin = pluginName + -- FIXME: Preserved bug. This should just be userId (it's already + -- a Text), but because this code was shipped, folks likely have + -- Idents in their database like @"\"...\""@, and if we fixed this + -- they would need migrating. We're keeping it for now as it's a + -- minor wart. Breaking typed APIs is one thing, causing data to go + -- invalid is another. + , credsIdent = T.pack $ show userId + , credsExtra = setExtra token userResponse + } + where + oauth2 = OAuth2 + { oauth2ClientId = clientId + , oauth2ClientSecret = Just clientSecret + , oauth2AuthorizeEndpoint = "https://bitbucket.com/site/oauth2/authorize" + `withQuery` [scopeParam "," scopes] + , oauth2TokenEndpoint = "https://bitbucket.com/site/oauth2/access_token" + , oauth2RedirectUri = Nothing + } diff --git a/src/Yesod/Auth/OAuth2/ClassLink.hs b/src/Yesod/Auth/OAuth2/ClassLink.hs index 1127d2f..7bb1ff6 100644 --- a/src/Yesod/Auth/OAuth2/ClassLink.hs +++ b/src/Yesod/Auth/OAuth2/ClassLink.hs @@ -1,19 +1,18 @@ {-# LANGUAGE OverloadedStrings #-} module Yesod.Auth.OAuth2.ClassLink - ( oauth2ClassLink - , oauth2ClassLinkScoped - ) -where + ( oauth2ClassLink + , oauth2ClassLinkScoped + ) where -import Yesod.Auth.OAuth2.Prelude +import Yesod.Auth.OAuth2.Prelude -import qualified Data.Text as T +import qualified Data.Text as T newtype User = User Int instance FromJSON User where - parseJSON = withObject "User" $ \o -> User <$> o .: "UserId" + parseJSON = withObject "User" $ \o -> User <$> o .: "UserId" pluginName :: Text pluginName = "classlink" @@ -26,26 +25,23 @@ oauth2ClassLink = oauth2ClassLinkScoped defaultScopes oauth2ClassLinkScoped :: YesodAuth m => [Text] -> Text -> Text -> AuthPlugin m oauth2ClassLinkScoped scopes clientId clientSecret = - authOAuth2 pluginName oauth2 $ \manager token -> do - (User userId, userResponse) <- authGetProfile - pluginName - manager - token - "https://nodeapi.classlink.com/v2/my/info" + authOAuth2 pluginName oauth2 $ \manager token -> do + (User userId, userResponse) <- authGetProfile + pluginName + manager + token + "https://nodeapi.classlink.com/v2/my/info" - pure Creds - { credsPlugin = pluginName - , credsIdent = T.pack $ show userId - , credsExtra = setExtra token userResponse - } - where - oauth2 = OAuth2 - { oauth2ClientId = clientId - , oauth2ClientSecret = Just clientSecret - , oauth2AuthorizeEndpoint = - "https://launchpad.classlink.com/oauth2/v2/auth" - `withQuery` [scopeParam "," scopes] - , oauth2TokenEndpoint = - "https://launchpad.classlink.com/oauth2/v2/token" - , oauth2RedirectUri = Nothing - } + pure Creds { credsPlugin = pluginName + , credsIdent = T.pack $ show userId + , credsExtra = setExtra token userResponse + } + where + oauth2 = OAuth2 + { oauth2ClientId = clientId + , oauth2ClientSecret = Just clientSecret + , oauth2AuthorizeEndpoint = "https://launchpad.classlink.com/oauth2/v2/auth" + `withQuery` [scopeParam "," scopes] + , oauth2TokenEndpoint = "https://launchpad.classlink.com/oauth2/v2/token" + , oauth2RedirectUri = Nothing + } diff --git a/src/Yesod/Auth/OAuth2/Dispatch.hs b/src/Yesod/Auth/OAuth2/Dispatch.hs index e470030..744bfd0 100644 --- a/src/Yesod/Auth/OAuth2/Dispatch.hs +++ b/src/Yesod/Auth/OAuth2/Dispatch.hs @@ -5,51 +5,52 @@ {-# LANGUAGE TypeFamilies #-} module Yesod.Auth.OAuth2.Dispatch - ( FetchToken - , fetchAccessToken - , fetchAccessToken2 - , FetchCreds - , dispatchAuthRequest - ) where + ( FetchToken + , fetchAccessToken + , fetchAccessToken2 + , FetchCreds + , dispatchAuthRequest + ) where -import Control.Monad.Except -import Data.Text (Text) -import qualified Data.Text as T -import Data.Text.Encoding (encodeUtf8) -import Network.HTTP.Conduit (Manager) -import Network.OAuth.OAuth2.Compat -import Network.OAuth.OAuth2.TokenRequest (Errors) -import URI.ByteString.Extension -import UnliftIO.Exception -import Yesod.Auth hiding (ServerError) -import Yesod.Auth.OAuth2.DispatchError -import Yesod.Auth.OAuth2.ErrorResponse -import Yesod.Auth.OAuth2.Random -import Yesod.Core hiding (ErrorResponse) +import Control.Monad.Except +import Data.Text ( Text ) +import qualified Data.Text as T +import Data.Text.Encoding ( encodeUtf8 ) +import Network.HTTP.Conduit ( Manager ) +import Network.OAuth.OAuth2.Compat +import Network.OAuth.OAuth2.TokenRequest + ( Errors ) +import URI.ByteString.Extension +import UnliftIO.Exception +import Yesod.Auth hiding ( ServerError ) +import Yesod.Auth.OAuth2.DispatchError +import Yesod.Auth.OAuth2.ErrorResponse +import Yesod.Auth.OAuth2.Random +import Yesod.Core hiding ( ErrorResponse ) -- | How to fetch an @'OAuth2Token'@ -- -- This will be 'fetchAccessToken' or 'fetchAccessToken2' -- type FetchToken - = Manager -> OAuth2 -> ExchangeToken -> IO (OAuth2Result Errors OAuth2Token) + = Manager -> OAuth2 -> ExchangeToken -> IO (OAuth2Result Errors OAuth2Token) -- | How to take an @'OAuth2Token'@ and retrieve user credentials type FetchCreds m = Manager -> OAuth2Token -> IO (Creds m) -- | Dispatch the various OAuth2 handshake routes dispatchAuthRequest - :: Text -- ^ Name - -> OAuth2 -- ^ Service details - -> FetchToken -- ^ How to get a token - -> FetchCreds m -- ^ How to get credentials - -> Text -- ^ Method - -> [Text] -- ^ Path pieces - -> AuthHandler m TypedContent + :: Text -- ^ Name + -> OAuth2 -- ^ Service details + -> FetchToken -- ^ How to get a token + -> FetchCreds m -- ^ How to get credentials + -> Text -- ^ Method + -> [Text] -- ^ Path pieces + -> AuthHandler m TypedContent dispatchAuthRequest name oauth2 _ _ "GET" ["forward"] = - handleDispatchError $ dispatchForward name oauth2 + handleDispatchError $ dispatchForward name oauth2 dispatchAuthRequest name oauth2 getToken getCreds "GET" ["callback"] = - handleDispatchError $ dispatchCallback name oauth2 getToken getCreds + handleDispatchError $ dispatchCallback name oauth2 getToken getCreds dispatchAuthRequest _ _ _ _ _ _ = notFound -- | Handle @GET \/forward@ @@ -58,14 +59,14 @@ dispatchAuthRequest _ _ _ _ _ _ = notFound -- 2. Redirect to the Provider's authorization URL -- dispatchForward - :: (MonadError DispatchError m, MonadAuthHandler site m) - => Text - -> OAuth2 - -> m TypedContent + :: (MonadError DispatchError m, MonadAuthHandler site m) + => Text + -> OAuth2 + -> m TypedContent dispatchForward name oauth2 = do - csrf <- setSessionCSRF $ tokenSessionKey name - oauth2' <- withCallbackAndState name oauth2 csrf - redirect $ toText $ authorizationUrl oauth2' + csrf <- setSessionCSRF $ tokenSessionKey name + oauth2' <- withCallbackAndState name oauth2 csrf + redirect $ toText $ authorizationUrl oauth2' -- | Handle @GET \/callback@ -- @@ -74,41 +75,40 @@ dispatchForward name oauth2 = do -- 3. Use the AccessToken to construct a @'Creds'@ value for the Provider -- dispatchCallback - :: (MonadError DispatchError m, MonadAuthHandler site m) - => Text - -> OAuth2 - -> FetchToken - -> FetchCreds site - -> m TypedContent + :: (MonadError DispatchError m, MonadAuthHandler site m) + => Text + -> OAuth2 + -> FetchToken + -> FetchCreds site + -> m TypedContent dispatchCallback name oauth2 getToken getCreds = do - onErrorResponse $ throwError . OAuth2HandshakeError - csrf <- verifySessionCSRF $ tokenSessionKey name - code <- requireGetParam "code" - manager <- authHttpManager - oauth2' <- withCallbackAndState name oauth2 csrf - token <- either (throwError . OAuth2ResultError) pure - =<< liftIO (getToken manager oauth2' $ ExchangeToken code) - creds <- - liftIO (getCreds manager token) - `catch` (throwError . FetchCredsIOException) - `catch` (throwError . FetchCredsYesodOAuth2Exception) - setCredsRedirect creds + onErrorResponse $ throwError . OAuth2HandshakeError + csrf <- verifySessionCSRF $ tokenSessionKey name + code <- requireGetParam "code" + manager <- authHttpManager + oauth2' <- withCallbackAndState name oauth2 csrf + token <- either (throwError . OAuth2ResultError) pure + =<< liftIO (getToken manager oauth2' $ ExchangeToken code) + creds <- + liftIO (getCreds manager token) + `catch` (throwError . FetchCredsIOException) + `catch` (throwError . FetchCredsYesodOAuth2Exception) + setCredsRedirect creds withCallbackAndState - :: (MonadError DispatchError m, MonadAuthHandler site m) - => Text - -> OAuth2 - -> Text - -> m OAuth2 + :: (MonadError DispatchError m, MonadAuthHandler site m) + => Text + -> OAuth2 + -> Text + -> m OAuth2 withCallbackAndState name oauth2 csrf = do - uri <- ($ PluginR name ["callback"]) <$> getParentUrlRender - callback <- maybe (throwError $ InvalidCallbackUri uri) pure $ fromText uri - pure oauth2 - { oauth2RedirectUri = Just callback - , oauth2AuthorizeEndpoint = - oauth2AuthorizeEndpoint oauth2 - `withQuery` [("state", encodeUtf8 csrf)] - } + uri <- ($ PluginR name ["callback"]) <$> getParentUrlRender + callback <- maybe (throwError $ InvalidCallbackUri uri) pure $ fromText uri + pure oauth2 + { oauth2RedirectUri = Just callback + , oauth2AuthorizeEndpoint = oauth2AuthorizeEndpoint oauth2 + `withQuery` [("state", encodeUtf8 csrf)] + } getParentUrlRender :: MonadHandler m => m (Route (SubHandlerSite m) -> Text) getParentUrlRender = (.) <$> getUrlRender <*> getRouteToParent @@ -124,25 +124,24 @@ getParentUrlRender = (.) <$> getUrlRender <*> getRouteToParent -- setSessionCSRF :: MonadHandler m => Text -> m Text setSessionCSRF sessionKey = do - csrfToken <- liftIO randomToken - csrfToken <$ setSession sessionKey csrfToken - where randomToken = T.filter (/= '+') <$> randomText 64 + csrfToken <- liftIO randomToken + csrfToken <$ setSession sessionKey csrfToken + where randomToken = T.filter (/= '+') <$> randomText 64 -- | Verify the callback provided the same CSRF token as in our session verifySessionCSRF - :: (MonadError DispatchError m, MonadHandler m) => Text -> m Text + :: (MonadError DispatchError m, MonadHandler m) => Text -> m Text verifySessionCSRF sessionKey = do - token <- requireGetParam "state" - sessionToken <- lookupSession sessionKey - deleteSession sessionKey - token <$ unless - (sessionToken == Just token) - (throwError $ InvalidStateToken sessionToken token) + token <- requireGetParam "state" + sessionToken <- lookupSession sessionKey + deleteSession sessionKey + token <$ unless (sessionToken == Just token) + (throwError $ InvalidStateToken sessionToken token) requireGetParam - :: (MonadError DispatchError m, MonadHandler m) => Text -> m Text + :: (MonadError DispatchError m, MonadHandler m) => Text -> m Text requireGetParam key = - maybe (throwError $ MissingParameter key) pure =<< lookupGetParam key + maybe (throwError $ MissingParameter key) pure =<< lookupGetParam key tokenSessionKey :: Text -> Text tokenSessionKey name = "_yesod_oauth2_" <> name diff --git a/src/Yesod/Auth/OAuth2/EveOnline.hs b/src/Yesod/Auth/OAuth2/EveOnline.hs index 165a910..53b5add 100644 --- a/src/Yesod/Auth/OAuth2/EveOnline.hs +++ b/src/Yesod/Auth/OAuth2/EveOnline.hs @@ -8,21 +8,20 @@ -- * Uses EVEs unique account-user-char-hash as credentials identifier -- module Yesod.Auth.OAuth2.EveOnline - ( oauth2Eve - , oauth2EveScoped - , WidgetType(..) - ) -where + ( oauth2Eve + , oauth2EveScoped + , WidgetType(..) + ) where -import Yesod.Auth.OAuth2.Prelude +import Yesod.Auth.OAuth2.Prelude -import qualified Data.Text as T -import Yesod.Core.Widget +import qualified Data.Text as T +import Yesod.Core.Widget newtype User = User Text instance FromJSON User where - parseJSON = withObject "User" $ \o -> User <$> o .: "CharacterOwnerHash" + parseJSON = withObject "User" $ \o -> User <$> o .: "CharacterOwnerHash" data WidgetType m = Plain -- ^ Simple "Login via eveonline" text @@ -35,13 +34,13 @@ data WidgetType m asWidget :: YesodAuth m => WidgetType m -> WidgetFor m () asWidget Plain = [whamlet|Login via eveonline|] asWidget BigWhite = - [whamlet||] + [whamlet||] asWidget BigBlack - = [whamlet||] + = [whamlet||] asWidget SmallWhite - = [whamlet||] + = [whamlet||] asWidget SmallBlack - = [whamlet||] + = [whamlet||] asWidget (Custom a) = a pluginName :: Text @@ -54,29 +53,29 @@ oauth2Eve :: YesodAuth m => WidgetType m -> Text -> Text -> AuthPlugin m oauth2Eve = oauth2EveScoped defaultScopes oauth2EveScoped - :: YesodAuth m => [Text] -> WidgetType m -> Text -> Text -> AuthPlugin m + :: YesodAuth m => [Text] -> WidgetType m -> Text -> Text -> AuthPlugin m oauth2EveScoped scopes widgetType clientId clientSecret = - authOAuth2Widget (asWidget widgetType) pluginName oauth2 - $ \manager token -> do - (User userId, userResponse) <- authGetProfile - pluginName - manager - token - "https://login.eveonline.com/oauth/verify" + authOAuth2Widget (asWidget widgetType) pluginName oauth2 $ \manager token -> + do + (User userId, userResponse) <- authGetProfile + pluginName + manager + token + "https://login.eveonline.com/oauth/verify" - pure Creds - { credsPlugin = "eveonline" - -- FIXME: Preserved bug. See similar comment in Bitbucket provider. - , credsIdent = T.pack $ show userId - , credsExtra = setExtra token userResponse - } - where - oauth2 = OAuth2 - { oauth2ClientId = clientId - , oauth2ClientSecret = Just clientSecret - , oauth2AuthorizeEndpoint = - "https://login.eveonline.com/oauth/authorize" - `withQuery` [("response_type", "code"), scopeParam " " scopes] - , oauth2TokenEndpoint = "https://login.eveonline.com/oauth/token" - , oauth2RedirectUri = Nothing - } + pure Creds { credsPlugin = "eveonline" + -- FIXME: Preserved bug. See similar comment in Bitbucket provider. + , credsIdent = T.pack $ show userId + , credsExtra = setExtra token userResponse + } + where + oauth2 = OAuth2 + { oauth2ClientId = clientId + , oauth2ClientSecret = Just clientSecret + , oauth2AuthorizeEndpoint = "https://login.eveonline.com/oauth/authorize" + `withQuery` [ ("response_type", "code") + , scopeParam " " scopes + ] + , oauth2TokenEndpoint = "https://login.eveonline.com/oauth/token" + , oauth2RedirectUri = Nothing + } diff --git a/src/Yesod/Auth/OAuth2/GitHub.hs b/src/Yesod/Auth/OAuth2/GitHub.hs index d5bd7f0..ae220d5 100644 --- a/src/Yesod/Auth/OAuth2/GitHub.hs +++ b/src/Yesod/Auth/OAuth2/GitHub.hs @@ -7,19 +7,18 @@ -- * Uses github user id as credentials identifier -- module Yesod.Auth.OAuth2.GitHub - ( oauth2GitHub - , oauth2GitHubScoped - ) -where + ( oauth2GitHub + , oauth2GitHubScoped + ) where -import Yesod.Auth.OAuth2.Prelude +import Yesod.Auth.OAuth2.Prelude -import qualified Data.Text as T +import qualified Data.Text as T newtype User = User Int instance FromJSON User where - parseJSON = withObject "User" $ \o -> User <$> o .: "id" + parseJSON = withObject "User" $ \o -> User <$> o .: "id" pluginName :: Text pluginName = "github" @@ -32,26 +31,23 @@ oauth2GitHub = oauth2GitHubScoped defaultScopes oauth2GitHubScoped :: YesodAuth m => [Text] -> Text -> Text -> AuthPlugin m oauth2GitHubScoped scopes clientId clientSecret = - authOAuth2 pluginName oauth2 $ \manager token -> do - (User userId, userResponse) <- authGetProfile - pluginName - manager - token - "https://api.github.com/user" + authOAuth2 pluginName oauth2 $ \manager token -> do + (User userId, userResponse) <- authGetProfile + pluginName + manager + token + "https://api.github.com/user" - pure Creds - { credsPlugin = pluginName - , credsIdent = T.pack $ show userId - , credsExtra = setExtra token userResponse - } - where - oauth2 = OAuth2 - { oauth2ClientId = clientId - , oauth2ClientSecret = Just clientSecret - , oauth2AuthorizeEndpoint = - "https://github.com/login/oauth/authorize" - `withQuery` [scopeParam "," scopes] - , oauth2TokenEndpoint = - "https://github.com/login/oauth/access_token" - , oauth2RedirectUri = Nothing - } + pure Creds { credsPlugin = pluginName + , credsIdent = T.pack $ show userId + , credsExtra = setExtra token userResponse + } + where + oauth2 = OAuth2 + { oauth2ClientId = clientId + , oauth2ClientSecret = Just clientSecret + , oauth2AuthorizeEndpoint = "https://github.com/login/oauth/authorize" + `withQuery` [scopeParam "," scopes] + , oauth2TokenEndpoint = "https://github.com/login/oauth/access_token" + , oauth2RedirectUri = Nothing + } diff --git a/src/Yesod/Auth/OAuth2/GitLab.hs b/src/Yesod/Auth/OAuth2/GitLab.hs index 2910253..f538b04 100644 --- a/src/Yesod/Auth/OAuth2/GitLab.hs +++ b/src/Yesod/Auth/OAuth2/GitLab.hs @@ -1,20 +1,19 @@ {-# LANGUAGE OverloadedStrings #-} module Yesod.Auth.OAuth2.GitLab - ( oauth2GitLab - , oauth2GitLabHostScopes - , defaultHost - , defaultScopes - ) -where + ( oauth2GitLab + , oauth2GitLabHostScopes + , defaultHost + , defaultScopes + ) where -import Yesod.Auth.OAuth2.Prelude +import Yesod.Auth.OAuth2.Prelude -import qualified Data.Text as T +import qualified Data.Text as T newtype User = User Int instance FromJSON User where - parseJSON = withObject "User" $ \o -> User <$> o .: "id" + parseJSON = withObject "User" $ \o -> User <$> o .: "id" pluginName :: Text pluginName = "gitlab" @@ -38,27 +37,23 @@ oauth2GitLab :: YesodAuth m => Text -> Text -> AuthPlugin m oauth2GitLab = oauth2GitLabHostScopes defaultHost defaultScopes oauth2GitLabHostScopes - :: YesodAuth m => URI -> [Text] -> Text -> Text -> AuthPlugin m + :: YesodAuth m => URI -> [Text] -> Text -> Text -> AuthPlugin m oauth2GitLabHostScopes host scopes clientId clientSecret = - authOAuth2 pluginName oauth2 $ \manager token -> do - (User userId, userResponse) <- - authGetProfile pluginName manager token - $ host - `withPath` "/api/v4/user" + authOAuth2 pluginName oauth2 $ \manager token -> do + (User userId, userResponse) <- + authGetProfile pluginName manager token $ host `withPath` "/api/v4/user" - pure Creds - { credsPlugin = pluginName - , credsIdent = T.pack $ show userId - , credsExtra = setExtra token userResponse - } - where - oauth2 = OAuth2 - { oauth2ClientId = clientId - , oauth2ClientSecret = Just clientSecret - , oauth2AuthorizeEndpoint = - host - `withPath` "/oauth/authorize" - `withQuery` [scopeParam " " scopes] - , oauth2TokenEndpoint = host `withPath` "/oauth/token" - , oauth2RedirectUri = Nothing - } + pure Creds { credsPlugin = pluginName + , credsIdent = T.pack $ show userId + , credsExtra = setExtra token userResponse + } + where + oauth2 = OAuth2 + { oauth2ClientId = clientId + , oauth2ClientSecret = Just clientSecret + , oauth2AuthorizeEndpoint = host + `withPath` "/oauth/authorize" + `withQuery` [scopeParam " " scopes] + , oauth2TokenEndpoint = host `withPath` "/oauth/token" + , oauth2RedirectUri = Nothing + } diff --git a/src/Yesod/Auth/OAuth2/Google.hs b/src/Yesod/Auth/OAuth2/Google.hs index 68baaff..8646cc0 100644 --- a/src/Yesod/Auth/OAuth2/Google.hs +++ b/src/Yesod/Auth/OAuth2/Google.hs @@ -25,23 +25,24 @@ -- > -- continue normally with updatedCreds -- module Yesod.Auth.OAuth2.Google - ( oauth2Google - , oauth2GoogleWidget - , oauth2GoogleScoped - , oauth2GoogleScopedWidget - ) -where + ( oauth2Google + , oauth2GoogleWidget + , oauth2GoogleScoped + , oauth2GoogleScopedWidget + ) where -import Yesod.Auth.OAuth2.Prelude -import Yesod.Core (WidgetFor, whamlet) +import Yesod.Auth.OAuth2.Prelude +import Yesod.Core ( WidgetFor + , whamlet + ) newtype User = User Text instance FromJSON User where - parseJSON = - withObject "User" $ \o -> User - -- Required for data backwards-compatibility - <$> (("google-uid:" <>) <$> o .: "sub") + parseJSON = + withObject "User" $ \o -> User + -- Required for data backwards-compatibility + <$> (("google-uid:" <>) <$> o .: "sub") pluginName :: Text pluginName = "google" @@ -52,34 +53,34 @@ defaultScopes = ["openid", "email"] oauth2Google :: YesodAuth m => Text -> Text -> AuthPlugin m oauth2Google = oauth2GoogleScoped defaultScopes -oauth2GoogleWidget :: YesodAuth m => WidgetFor m () -> Text -> Text -> AuthPlugin m +oauth2GoogleWidget + :: YesodAuth m => WidgetFor m () -> Text -> Text -> AuthPlugin m oauth2GoogleWidget widget = oauth2GoogleScopedWidget widget defaultScopes oauth2GoogleScoped :: YesodAuth m => [Text] -> Text -> Text -> AuthPlugin m -oauth2GoogleScoped = oauth2GoogleScopedWidget [whamlet|Login via #{pluginName}|] +oauth2GoogleScoped = + oauth2GoogleScopedWidget [whamlet|Login via #{pluginName}|] -oauth2GoogleScopedWidget :: YesodAuth m => WidgetFor m () -> [Text] -> Text -> Text -> AuthPlugin m +oauth2GoogleScopedWidget + :: YesodAuth m => WidgetFor m () -> [Text] -> Text -> Text -> AuthPlugin m oauth2GoogleScopedWidget widget scopes clientId clientSecret = - authOAuth2Widget widget pluginName oauth2 $ \manager token -> do - (User userId, userResponse) <- authGetProfile - pluginName - manager - token - "https://www.googleapis.com/oauth2/v3/userinfo" + authOAuth2Widget widget pluginName oauth2 $ \manager token -> do + (User userId, userResponse) <- authGetProfile + pluginName + manager + token + "https://www.googleapis.com/oauth2/v3/userinfo" - pure Creds - { credsPlugin = pluginName - , credsIdent = userId - , credsExtra = setExtra token userResponse - } - where - oauth2 = OAuth2 - { oauth2ClientId = clientId - , oauth2ClientSecret = Just clientSecret - , oauth2AuthorizeEndpoint = - "https://accounts.google.com/o/oauth2/auth" - `withQuery` [scopeParam " " scopes] - , oauth2TokenEndpoint = - "https://www.googleapis.com/oauth2/v3/token" - , oauth2RedirectUri = Nothing - } + pure Creds { credsPlugin = pluginName + , credsIdent = userId + , credsExtra = setExtra token userResponse + } + where + oauth2 = OAuth2 + { oauth2ClientId = clientId + , oauth2ClientSecret = Just clientSecret + , oauth2AuthorizeEndpoint = "https://accounts.google.com/o/oauth2/auth" + `withQuery` [scopeParam " " scopes] + , oauth2TokenEndpoint = "https://www.googleapis.com/oauth2/v3/token" + , oauth2RedirectUri = Nothing + } diff --git a/src/Yesod/Auth/OAuth2/Nylas.hs b/src/Yesod/Auth/OAuth2/Nylas.hs index edc729c..160347b 100644 --- a/src/Yesod/Auth/OAuth2/Nylas.hs +++ b/src/Yesod/Auth/OAuth2/Nylas.hs @@ -1,22 +1,21 @@ {-# LANGUAGE OverloadedStrings #-} module Yesod.Auth.OAuth2.Nylas - ( oauth2Nylas - ) -where + ( oauth2Nylas + ) where -import Yesod.Auth.OAuth2.Prelude +import Yesod.Auth.OAuth2.Prelude -import Control.Monad (unless) -import qualified Data.ByteString.Lazy.Char8 as BL8 -import Network.HTTP.Client -import qualified Network.HTTP.Types as HT -import qualified Yesod.Auth.OAuth2.Exception as YesodOAuth2Exception +import Control.Monad ( unless ) +import qualified Data.ByteString.Lazy.Char8 as BL8 +import Network.HTTP.Client +import qualified Network.HTTP.Types as HT +import qualified Yesod.Auth.OAuth2.Exception as YesodOAuth2Exception newtype User = User Text instance FromJSON User where - parseJSON = withObject "User" $ \o -> User <$> o .: "id" + parseJSON = withObject "User" $ \o -> User <$> o .: "id" pluginName :: Text pluginName = "nylas" @@ -26,44 +25,42 @@ defaultScopes = ["email"] oauth2Nylas :: YesodAuth m => Text -> Text -> AuthPlugin m oauth2Nylas clientId clientSecret = - authOAuth2 pluginName oauth $ \manager token -> do - req <- applyBasicAuth (encodeUtf8 $ atoken $ accessToken token) "" - <$> parseRequest "https://api.nylas.com/account" - resp <- httpLbs req manager - let userResponse = responseBody resp + authOAuth2 pluginName oauth $ \manager token -> do + req <- applyBasicAuth (encodeUtf8 $ atoken $ accessToken token) "" + <$> parseRequest "https://api.nylas.com/account" + resp <- httpLbs req manager + let userResponse = responseBody resp - -- FIXME: was this working? I'm 95% sure that the client will throw its - -- own exception on unsuccessful status codes. - unless (HT.statusIsSuccessful $ responseStatus resp) - $ throwIO - $ YesodOAuth2Exception.GenericError pluginName - $ "Unsuccessful HTTP response: " - <> BL8.unpack userResponse + -- FIXME: was this working? I'm 95% sure that the client will throw its + -- own exception on unsuccessful status codes. + unless (HT.statusIsSuccessful $ responseStatus resp) + $ throwIO + $ YesodOAuth2Exception.GenericError pluginName + $ "Unsuccessful HTTP response: " + <> BL8.unpack userResponse - either - (throwIO . YesodOAuth2Exception.JSONDecodingError pluginName) - (\(User userId) -> pure Creds - { credsPlugin = pluginName - , credsIdent = userId - , credsExtra = setExtra token userResponse - } - ) - $ eitherDecode userResponse - where - oauth = OAuth2 - { oauth2ClientId = clientId - , oauth2ClientSecret = Just clientSecret - , oauth2AuthorizeEndpoint = - "https://api.nylas.com/oauth/authorize" - `withQuery` [ ("response_type", "code") - , ( "client_id" - , encodeUtf8 clientId - ) - -- N.B. The scopes delimeter is unknown/untested. Verify that before - -- extracting this to an argument and offering a Scoped function. In - -- its current state, it doesn't matter because it's only one scope. - , scopeParam "," defaultScopes - ] - , oauth2TokenEndpoint = "https://api.nylas.com/oauth/token" - , oauth2RedirectUri = Nothing - } + either + (throwIO . YesodOAuth2Exception.JSONDecodingError pluginName) + (\(User userId) -> pure Creds { credsPlugin = pluginName + , credsIdent = userId + , credsExtra = setExtra token userResponse + } + ) + $ eitherDecode userResponse + where + oauth = OAuth2 + { oauth2ClientId = clientId + , oauth2ClientSecret = Just clientSecret + , oauth2AuthorizeEndpoint = "https://api.nylas.com/oauth/authorize" + `withQuery` [ ("response_type", "code") + , ( "client_id" + , encodeUtf8 clientId + ) + -- N.B. The scopes delimeter is unknown/untested. Verify that before + -- extracting this to an argument and offering a Scoped function. In + -- its current state, it doesn't matter because it's only one scope. + , scopeParam "," defaultScopes + ] + , oauth2TokenEndpoint = "https://api.nylas.com/oauth/token" + , oauth2RedirectUri = Nothing + } diff --git a/src/Yesod/Auth/OAuth2/Prelude.hs b/src/Yesod/Auth/OAuth2/Prelude.hs index 5256da7..c879457 100644 --- a/src/Yesod/Auth/OAuth2/Prelude.hs +++ b/src/Yesod/Auth/OAuth2/Prelude.hs @@ -6,70 +6,70 @@ -- implementations. May also be useful for writing local providers. -- module Yesod.Auth.OAuth2.Prelude - ( + ( -- * Provider helpers - authGetProfile - , scopeParam - , setExtra + authGetProfile + , scopeParam + , setExtra -- * Text - , Text - , decodeUtf8 - , encodeUtf8 + , Text + , decodeUtf8 + , encodeUtf8 -- * JSON - , (.:) - , (.:?) - , (.=) - , (<>) - , FromJSON(..) - , ToJSON(..) - , eitherDecode - , withObject + , (.:) + , (.:?) + , (.=) + , (<>) + , FromJSON(..) + , ToJSON(..) + , eitherDecode + , withObject -- * Exceptions - , throwIO + , throwIO -- * OAuth2 - , OAuth2(..) - , OAuth2Token(..) - , AccessToken(..) - , RefreshToken(..) + , OAuth2(..) + , OAuth2Token(..) + , AccessToken(..) + , RefreshToken(..) -- * HTTP - , Manager + , Manager -- * Yesod - , YesodAuth(..) - , AuthPlugin(..) - , Creds(..) + , YesodAuth(..) + , AuthPlugin(..) + , Creds(..) -- * Bytestring URI types - , URI - , Host(..) + , URI + , Host(..) -- * Bytestring URI extensions - , module URI.ByteString.Extension + , module URI.ByteString.Extension -- * Temporary, until I finish re-structuring modules - , authOAuth2 - , authOAuth2Widget - ) where + , authOAuth2 + , authOAuth2Widget + ) where -import Control.Exception.Safe -import Data.Aeson -import Data.ByteString (ByteString) -import qualified Data.ByteString.Lazy as BL -import Data.Text (Text) -import qualified Data.Text as T -import Data.Text.Encoding -import Network.HTTP.Conduit -import Network.OAuth.OAuth2.Compat -import URI.ByteString -import URI.ByteString.Extension -import Yesod.Auth -import Yesod.Auth.OAuth2 -import qualified Yesod.Auth.OAuth2.Exception as YesodOAuth2Exception +import Control.Exception.Safe +import Data.Aeson +import Data.ByteString ( ByteString ) +import qualified Data.ByteString.Lazy as BL +import Data.Text ( Text ) +import qualified Data.Text as T +import Data.Text.Encoding +import Network.HTTP.Conduit +import Network.OAuth.OAuth2.Compat +import URI.ByteString +import URI.ByteString.Extension +import Yesod.Auth +import Yesod.Auth.OAuth2 +import qualified Yesod.Auth.OAuth2.Exception as YesodOAuth2Exception -- | Retrieve a user's profile as JSON -- @@ -78,28 +78,28 @@ import qualified Yesod.Auth.OAuth2.Exception as YesodOAuth2Exception -- fetched via additional requests by consumers. -- authGetProfile - :: FromJSON a - => Text - -> Manager - -> OAuth2Token - -> URI - -> IO (a, BL.ByteString) + :: FromJSON a + => Text + -> Manager + -> OAuth2Token + -> URI + -> IO (a, BL.ByteString) authGetProfile name manager token url = do - resp <- fromAuthGet name =<< authGetBS manager (accessToken token) url - decoded <- fromAuthJSON name resp - pure (decoded, resp) + resp <- fromAuthGet name =<< authGetBS manager (accessToken token) url + decoded <- fromAuthJSON name resp + pure (decoded, resp) -- | Throws a @Left@ result as an @'YesodOAuth2Exception'@ fromAuthGet :: Text -> Either BL.ByteString BL.ByteString -> IO BL.ByteString fromAuthGet _ (Right bs) = pure bs -- nice fromAuthGet name (Left err) = - throwIO $ YesodOAuth2Exception.OAuth2Error name err + throwIO $ YesodOAuth2Exception.OAuth2Error name err -- | Throws a decoding error as an @'YesodOAuth2Exception'@ fromAuthJSON :: FromJSON a => Text -> BL.ByteString -> IO a fromAuthJSON name = - either (throwIO . YesodOAuth2Exception.JSONDecodingError name) pure - . eitherDecode + either (throwIO . YesodOAuth2Exception.JSONDecodingError name) pure + . eitherDecode -- | A tuple of @\"scope\"@ and the given scopes separated by a delimiter scopeParam :: Text -> [Text] -> (ByteString, ByteString) diff --git a/src/Yesod/Auth/OAuth2/Salesforce.hs b/src/Yesod/Auth/OAuth2/Salesforce.hs index 5543eba..ef7b11d 100644 --- a/src/Yesod/Auth/OAuth2/Salesforce.hs +++ b/src/Yesod/Auth/OAuth2/Salesforce.hs @@ -7,19 +7,18 @@ -- * Uses Salesforce user id as credentials identifier -- module Yesod.Auth.OAuth2.Salesforce - ( oauth2Salesforce - , oauth2SalesforceScoped - , oauth2SalesforceSandbox - , oauth2SalesforceSandboxScoped - ) -where + ( oauth2Salesforce + , oauth2SalesforceScoped + , oauth2SalesforceSandbox + , oauth2SalesforceSandboxScoped + ) where -import Yesod.Auth.OAuth2.Prelude +import Yesod.Auth.OAuth2.Prelude newtype User = User Text instance FromJSON User where - parseJSON = withObject "User" $ \o -> User <$> o .: "user_id" + parseJSON = withObject "User" $ \o -> User <$> o .: "user_id" pluginName :: Text pluginName = "salesforce" @@ -32,51 +31,45 @@ oauth2Salesforce = oauth2SalesforceScoped defaultScopes oauth2SalesforceScoped :: YesodAuth m => [Text] -> Text -> Text -> AuthPlugin m oauth2SalesforceScoped = salesforceHelper - pluginName - "https://login.salesforce.com/services/oauth2/userinfo" - "https://login.salesforce.com/services/oauth2/authorize" - "https://login.salesforce.com/services/oauth2/token" + pluginName + "https://login.salesforce.com/services/oauth2/userinfo" + "https://login.salesforce.com/services/oauth2/authorize" + "https://login.salesforce.com/services/oauth2/token" oauth2SalesforceSandbox :: YesodAuth m => Text -> Text -> AuthPlugin m oauth2SalesforceSandbox = oauth2SalesforceSandboxScoped defaultScopes oauth2SalesforceSandboxScoped - :: YesodAuth m => [Text] -> Text -> Text -> AuthPlugin m + :: YesodAuth m => [Text] -> Text -> Text -> AuthPlugin m oauth2SalesforceSandboxScoped = salesforceHelper - (pluginName <> "-sandbox") - "https://test.salesforce.com/services/oauth2/userinfo" - "https://test.salesforce.com/services/oauth2/authorize" - "https://test.salesforce.com/services/oauth2/token" + (pluginName <> "-sandbox") + "https://test.salesforce.com/services/oauth2/userinfo" + "https://test.salesforce.com/services/oauth2/authorize" + "https://test.salesforce.com/services/oauth2/token" salesforceHelper - :: YesodAuth m - => Text - -> URI -- ^ User profile - -> URI -- ^ Authorize - -> URI -- ^ Token - -> [Text] - -> Text - -> Text - -> AuthPlugin m + :: YesodAuth m + => Text + -> URI -- ^ User profile + -> URI -- ^ Authorize + -> URI -- ^ Token + -> [Text] + -> Text + -> Text + -> AuthPlugin m salesforceHelper name profileUri authorizeUri tokenUri scopes clientId clientSecret - = authOAuth2 name oauth2 $ \manager token -> do - (User userId, userResponse) <- authGetProfile - name - manager - token - profileUri + = authOAuth2 name oauth2 $ \manager token -> do + (User userId, userResponse) <- authGetProfile name manager token profileUri - pure Creds - { credsPlugin = pluginName - , credsIdent = userId - , credsExtra = setExtra token userResponse - } - where - oauth2 = OAuth2 - { oauth2ClientId = clientId - , oauth2ClientSecret = Just clientSecret - , oauth2AuthorizeEndpoint = - authorizeUri `withQuery` [scopeParam " " scopes] - , oauth2TokenEndpoint = tokenUri - , oauth2RedirectUri = Nothing - } + pure Creds { credsPlugin = pluginName + , credsIdent = userId + , credsExtra = setExtra token userResponse + } + where + oauth2 = OAuth2 + { oauth2ClientId = clientId + , oauth2ClientSecret = Just clientSecret + , oauth2AuthorizeEndpoint = authorizeUri `withQuery` [scopeParam " " scopes] + , oauth2TokenEndpoint = tokenUri + , oauth2RedirectUri = Nothing + } diff --git a/src/Yesod/Auth/OAuth2/Slack.hs b/src/Yesod/Auth/OAuth2/Slack.hs index 65f211a..593644e 100644 --- a/src/Yesod/Auth/OAuth2/Slack.hs +++ b/src/Yesod/Auth/OAuth2/Slack.hs @@ -6,17 +6,19 @@ -- * Uses slack user id as credentials identifier -- module Yesod.Auth.OAuth2.Slack - ( SlackScope(..) - , oauth2Slack - , oauth2SlackScoped - ) -where + ( SlackScope(..) + , oauth2Slack + , oauth2SlackScoped + ) where -import Yesod.Auth.OAuth2.Prelude +import Yesod.Auth.OAuth2.Prelude -import Network.HTTP.Client - (httpLbs, parseUrlThrow, responseBody, setQueryString) -import Yesod.Auth.OAuth2.Exception as YesodOAuth2Exception +import Network.HTTP.Client ( httpLbs + , parseUrlThrow + , responseBody + , setQueryString + ) +import Yesod.Auth.OAuth2.Exception as YesodOAuth2Exception data SlackScope = SlackBasicScope @@ -25,17 +27,17 @@ data SlackScope | SlackAvatarScope scopeText :: SlackScope -> Text -scopeText SlackBasicScope = "identity.basic" -scopeText SlackEmailScope = "identity.email" -scopeText SlackTeamScope = "identity.team" +scopeText SlackBasicScope = "identity.basic" +scopeText SlackEmailScope = "identity.email" +scopeText SlackTeamScope = "identity.team" scopeText SlackAvatarScope = "identity.avatar" newtype User = User Text instance FromJSON User where - parseJSON = withObject "User" $ \root -> do - o <- root .: "user" - User <$> o .: "id" + parseJSON = withObject "User" $ \root -> do + o <- root .: "user" + User <$> o .: "id" pluginName :: Text pluginName = "slack" @@ -46,30 +48,31 @@ defaultScopes = [SlackBasicScope] oauth2Slack :: YesodAuth m => Text -> Text -> AuthPlugin m oauth2Slack = oauth2SlackScoped defaultScopes -oauth2SlackScoped :: YesodAuth m => [SlackScope] -> Text -> Text -> AuthPlugin m +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" - userResponse <- responseBody <$> httpLbs req manager + authOAuth2 pluginName oauth2 $ \manager token -> do + let param = encodeUtf8 $ atoken $ accessToken token + req <- setQueryString [("token", Just param)] + <$> parseUrlThrow "https://slack.com/api/users.identity" + userResponse <- responseBody <$> httpLbs req manager - either - (throwIO . YesodOAuth2Exception.JSONDecodingError pluginName) - (\(User userId) -> pure Creds - { credsPlugin = pluginName - , credsIdent = userId - , credsExtra = setExtra token userResponse - } - ) - $ eitherDecode userResponse - where - oauth2 = OAuth2 - { oauth2ClientId = clientId - , oauth2ClientSecret = Just clientSecret - , oauth2AuthorizeEndpoint = - "https://slack.com/oauth/authorize" - `withQuery` [scopeParam "," $ map scopeText scopes] - , oauth2TokenEndpoint = "https://slack.com/api/oauth.access" - , oauth2RedirectUri = Nothing - } + either + (throwIO . YesodOAuth2Exception.JSONDecodingError pluginName) + (\(User userId) -> pure Creds { credsPlugin = pluginName + , credsIdent = userId + , credsExtra = setExtra token userResponse + } + ) + $ eitherDecode userResponse + where + oauth2 = OAuth2 + { oauth2ClientId = clientId + , oauth2ClientSecret = Just clientSecret + , oauth2AuthorizeEndpoint = "https://slack.com/oauth/authorize" + `withQuery` [ scopeParam "," + $ map scopeText scopes + ] + , oauth2TokenEndpoint = "https://slack.com/api/oauth.access" + , oauth2RedirectUri = Nothing + } diff --git a/src/Yesod/Auth/OAuth2/Spotify.hs b/src/Yesod/Auth/OAuth2/Spotify.hs index 498aa47..f85a77c 100644 --- a/src/Yesod/Auth/OAuth2/Spotify.hs +++ b/src/Yesod/Auth/OAuth2/Spotify.hs @@ -4,41 +4,38 @@ -- OAuth2 plugin for http://spotify.com -- module Yesod.Auth.OAuth2.Spotify - ( oauth2Spotify - ) -where + ( oauth2Spotify + ) where -import Yesod.Auth.OAuth2.Prelude +import Yesod.Auth.OAuth2.Prelude newtype User = User Text instance FromJSON User where - parseJSON = withObject "User" $ \o -> User <$> o .: "id" + parseJSON = withObject "User" $ \o -> User <$> o .: "id" pluginName :: Text pluginName = "spotify" oauth2Spotify :: YesodAuth m => [Text] -> Text -> Text -> AuthPlugin m oauth2Spotify scopes clientId clientSecret = - authOAuth2 pluginName oauth2 $ \manager token -> do - (User userId, userResponse) <- authGetProfile - pluginName - manager - token - "https://api.spotify.com/v1/me" + authOAuth2 pluginName oauth2 $ \manager token -> do + (User userId, userResponse) <- authGetProfile + pluginName + manager + token + "https://api.spotify.com/v1/me" - pure Creds - { credsPlugin = pluginName - , credsIdent = userId - , credsExtra = setExtra token userResponse - } - where - oauth2 = OAuth2 - { oauth2ClientId = clientId - , oauth2ClientSecret = Just clientSecret - , oauth2AuthorizeEndpoint = - "https://accounts.spotify.com/authorize" - `withQuery` [scopeParam " " scopes] - , oauth2TokenEndpoint = "https://accounts.spotify.com/api/token" - , oauth2RedirectUri = Nothing - } + pure Creds { credsPlugin = pluginName + , credsIdent = userId + , credsExtra = setExtra token userResponse + } + where + oauth2 = OAuth2 + { oauth2ClientId = clientId + , oauth2ClientSecret = Just clientSecret + , oauth2AuthorizeEndpoint = "https://accounts.spotify.com/authorize" + `withQuery` [scopeParam " " scopes] + , oauth2TokenEndpoint = "https://accounts.spotify.com/api/token" + , oauth2RedirectUri = Nothing + } diff --git a/src/Yesod/Auth/OAuth2/Upcase.hs b/src/Yesod/Auth/OAuth2/Upcase.hs index 8da9e25..9332bf6 100644 --- a/src/Yesod/Auth/OAuth2/Upcase.hs +++ b/src/Yesod/Auth/OAuth2/Upcase.hs @@ -7,43 +7,41 @@ -- * Uses upcase user id as credentials identifier -- module Yesod.Auth.OAuth2.Upcase - ( oauth2Upcase - ) -where + ( oauth2Upcase + ) where -import Yesod.Auth.OAuth2.Prelude +import Yesod.Auth.OAuth2.Prelude -import qualified Data.Text as T +import qualified Data.Text as T newtype User = User Int instance FromJSON User where - parseJSON = withObject "User" $ \root -> do - o <- root .: "user" - User <$> o .: "id" + parseJSON = withObject "User" $ \root -> do + o <- root .: "user" + User <$> o .: "id" pluginName :: Text pluginName = "upcase" oauth2Upcase :: YesodAuth m => Text -> Text -> AuthPlugin m oauth2Upcase clientId clientSecret = - authOAuth2 pluginName oauth2 $ \manager token -> do - (User userId, userResponse) <- authGetProfile - pluginName - manager - token - "http://upcase.com/api/v1/me.json" + authOAuth2 pluginName oauth2 $ \manager token -> do + (User userId, userResponse) <- authGetProfile + pluginName + manager + token + "http://upcase.com/api/v1/me.json" - pure Creds - { credsPlugin = pluginName - , credsIdent = T.pack $ show userId - , credsExtra = setExtra token userResponse - } - where - oauth2 = OAuth2 - { oauth2ClientId = clientId - , oauth2ClientSecret = Just clientSecret - , oauth2AuthorizeEndpoint = "http://upcase.com/oauth/authorize" - , oauth2TokenEndpoint = "http://upcase.com/oauth/token" - , oauth2RedirectUri = Nothing - } + pure Creds { credsPlugin = pluginName + , credsIdent = T.pack $ show userId + , credsExtra = setExtra token userResponse + } + where + oauth2 = OAuth2 + { oauth2ClientId = clientId + , oauth2ClientSecret = Just clientSecret + , oauth2AuthorizeEndpoint = "http://upcase.com/oauth/authorize" + , oauth2TokenEndpoint = "http://upcase.com/oauth/token" + , oauth2RedirectUri = Nothing + } diff --git a/src/Yesod/Auth/OAuth2/WordPressDotCom.hs b/src/Yesod/Auth/OAuth2/WordPressDotCom.hs index adf825a..8cf3798 100644 --- a/src/Yesod/Auth/OAuth2/WordPressDotCom.hs +++ b/src/Yesod/Auth/OAuth2/WordPressDotCom.hs @@ -1,12 +1,11 @@ {-# LANGUAGE OverloadedStrings #-} module Yesod.Auth.OAuth2.WordPressDotCom - ( oauth2WordPressDotCom - ) -where + ( oauth2WordPressDotCom + ) where -import qualified Data.Text as T -import Yesod.Auth.OAuth2.Prelude +import qualified Data.Text as T +import Yesod.Auth.OAuth2.Prelude pluginName :: Text pluginName = "WordPress.com" @@ -14,35 +13,33 @@ pluginName = "WordPress.com" newtype WpUser = WpUser Int instance FromJSON WpUser where - parseJSON = withObject "WpUser" $ \o -> WpUser <$> o .: "ID" + parseJSON = withObject "WpUser" $ \o -> WpUser <$> o .: "ID" oauth2WordPressDotCom - :: (YesodAuth m) - => Text -- ^ Client Id - -> Text -- ^ Client Secret - -> AuthPlugin m + :: (YesodAuth m) + => Text -- ^ Client Id + -> Text -- ^ Client Secret + -> AuthPlugin m oauth2WordPressDotCom clientId clientSecret = - authOAuth2 pluginName oauth2 $ \manager token -> do - (WpUser userId, userResponse) <- authGetProfile - pluginName - manager - token - "https://public-api.wordpress.com/rest/v1/me/" + authOAuth2 pluginName oauth2 $ \manager token -> do + (WpUser userId, userResponse) <- authGetProfile + pluginName + manager + token + "https://public-api.wordpress.com/rest/v1/me/" - pure Creds - { credsPlugin = pluginName - , credsIdent = T.pack $ show userId - , credsExtra = setExtra token userResponse - } + pure Creds { credsPlugin = pluginName + , credsIdent = T.pack $ show userId + , credsExtra = setExtra token userResponse + } - where - oauth2 = OAuth2 - { oauth2ClientId = clientId - , oauth2ClientSecret = Just clientSecret - , oauth2AuthorizeEndpoint = - "https://public-api.wordpress.com/oauth2/authorize" - `withQuery` [scopeParam "," ["auth"]] - , oauth2TokenEndpoint = - "https://public-api.wordpress.com/oauth2/token" - , oauth2RedirectUri = Nothing - } + where + oauth2 = OAuth2 + { oauth2ClientId = clientId + , oauth2ClientSecret = Just clientSecret + , oauth2AuthorizeEndpoint = + "https://public-api.wordpress.com/oauth2/authorize" + `withQuery` [scopeParam "," ["auth"]] + , oauth2TokenEndpoint = "https://public-api.wordpress.com/oauth2/token" + , oauth2RedirectUri = Nothing + }