mirror of
https://github.com/freckle/yesod-auth-oauth2.git
synced 2026-01-12 04:08:30 +01:00
Restyled by brittany
This commit is contained in:
Restyled.io
parent
0d8b1b0ecc
commit
23b73d590d
@ -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 <https://github.com/thoughtbot/yesod-auth-oauth2/pull/129>
|
||||
--
|
||||
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|<a href=@{tm $ oauth2Url name}>^{widget}|]
|
||||
name
|
||||
(dispatchAuthRequest name oauth getToken getCreds)
|
||||
login
|
||||
where login tm = [whamlet|<a href=@{tm $ oauth2Url name}>^{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
|
||||
|
||||
@ -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
|
||||
}
|
||||
|
||||
@ -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" #-}
|
||||
|
||||
@ -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
|
||||
}
|
||||
|
||||
@ -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
|
||||
}
|
||||
|
||||
@ -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
|
||||
|
||||
@ -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|<img src="https://images.contentful.com/idjq7aai9ylm/4PTzeiAshqiM8osU2giO0Y/5cc4cb60bac52422da2e45db87b6819c/EVE_SSO_Login_Buttons_Large_White.png?w=270&h=45">|]
|
||||
[whamlet|<img src="https://images.contentful.com/idjq7aai9ylm/4PTzeiAshqiM8osU2giO0Y/5cc4cb60bac52422da2e45db87b6819c/EVE_SSO_Login_Buttons_Large_White.png?w=270&h=45">|]
|
||||
asWidget BigBlack
|
||||
= [whamlet|<img src="https://images.contentful.com/idjq7aai9ylm/4fSjj56uD6CYwYyus4KmES/4f6385c91e6de56274d99496e6adebab/EVE_SSO_Login_Buttons_Large_Black.png?w=270&h=45">|]
|
||||
= [whamlet|<img src="https://images.contentful.com/idjq7aai9ylm/4fSjj56uD6CYwYyus4KmES/4f6385c91e6de56274d99496e6adebab/EVE_SSO_Login_Buttons_Large_Black.png?w=270&h=45">|]
|
||||
asWidget SmallWhite
|
||||
= [whamlet|<img src="https://images.contentful.com/idjq7aai9ylm/18BxKSXCymyqY4QKo8KwKe/c2bdded6118472dd587c8107f24104d7/EVE_SSO_Login_Buttons_Small_White.png?w=195&h=30">|]
|
||||
= [whamlet|<img src="https://images.contentful.com/idjq7aai9ylm/18BxKSXCymyqY4QKo8KwKe/c2bdded6118472dd587c8107f24104d7/EVE_SSO_Login_Buttons_Small_White.png?w=195&h=30">|]
|
||||
asWidget SmallBlack
|
||||
= [whamlet|<img src="https://images.contentful.com/idjq7aai9ylm/12vrPsIMBQi28QwCGOAqGk/33234da7672c6b0cdca394fc8e0b1c2b/EVE_SSO_Login_Buttons_Small_Black.png?w=195&h=30">|]
|
||||
= [whamlet|<img src="https://images.contentful.com/idjq7aai9ylm/12vrPsIMBQi28QwCGOAqGk/33234da7672c6b0cdca394fc8e0b1c2b/EVE_SSO_Login_Buttons_Small_Black.png?w=195&h=30">|]
|
||||
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
|
||||
}
|
||||
|
||||
@ -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
|
||||
}
|
||||
|
||||
@ -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
|
||||
}
|
||||
|
||||
@ -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
|
||||
}
|
||||
|
||||
@ -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
|
||||
}
|
||||
|
||||
@ -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)
|
||||
|
||||
@ -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
|
||||
}
|
||||
|
||||
@ -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
|
||||
}
|
||||
|
||||
@ -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
|
||||
}
|
||||
|
||||
@ -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
|
||||
}
|
||||
|
||||
@ -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
|
||||
}
|
||||
|
||||
Loading…
Reference in New Issue
Block a user