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