haskell/yesod-auth-oauth2
1
0
Fork 0
mirror of https://github.com/freckle/yesod-auth-oauth2.git synced 2026-04-25 12:17:45 +02:00
Code Issues Actions Packages Projects Releases Wiki Activity

Fix line-endings in Battle plugin

Browse Source
This commit is contained in:
patrick brisbin 2018-01-23 08:48:08 -05:00
parent 400111f9a0
commit ed58922727
1 changed files with 83 additions and 83 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

166
src/Yesod/Auth/OAuth2/BattleNet.hs
View File

@ -1,83 +1,83 @@
{-# LANGUAGE CPP #-} {-# LANGUAGE CPP #-}
{-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE OverloadedStrings #-}
-- | -- |
-- --
-- OAuth2 plugin for Battle.Net -- OAuth2 plugin for Battle.Net
-- --
-- * Authenticates against battle.net. -- * Authenticates against battle.net.
-- * Uses user's id as credentials identifier. -- * Uses user's id as credentials identifier.
-- * Returns user's battletag in extras. -- * Returns user's battletag in extras.
-- --
module Yesod.Auth.OAuth2.BattleNet module Yesod.Auth.OAuth2.BattleNet
( oAuth2BattleNet ) ( oAuth2BattleNet )
where where
#if __GLASGOW_HASKELL__ < 710 #if __GLASGOW_HASKELL__ < 710
import Control.Applicative ((<$>), (<*>)) import Control.Applicative ((<$>), (<*>))
#endif #endif
import Control.Exception (throwIO) import Control.Exception (throwIO)
import Control.Monad (mzero) import Control.Monad (mzero)
import Yesod.Auth import Yesod.Auth
import Yesod.Auth.OAuth2 import Yesod.Auth.OAuth2
import Data.Monoid ((<>)) import Data.Monoid ((<>))
import Network.HTTP.Conduit (Manager) import Network.HTTP.Conduit (Manager)
import Data.Aeson import Data.Aeson
import Data.Text (Text) import Data.Text (Text)
import qualified Data.Text as T (pack, toLower) import qualified Data.Text as T (pack, toLower)
import qualified Data.Text.Encoding as E (encodeUtf8) import qualified Data.Text.Encoding as E (encodeUtf8)
import Prelude import Prelude
import Yesod.Core.Widget import Yesod.Core.Widget
data BattleNetUser = BattleNetUser data BattleNetUser = BattleNetUser
{ userId :: Int { userId :: Int
, battleTag :: Text , battleTag :: Text
} }
instance FromJSON BattleNetUser where instance FromJSON BattleNetUser where
parseJSON (Object o) = BattleNetUser parseJSON (Object o) = BattleNetUser
<$> o .: "id" <$> o .: "id"
<*> o .: "battletag" <*> o .: "battletag"
parseJSON _ = mzero parseJSON _ = mzero
oAuth2BattleNet :: YesodAuth m oAuth2BattleNet :: YesodAuth m
=> Text -- ^ Client ID => Text -- ^ Client ID
-> Text -- ^ Client Secret -> Text -- ^ Client Secret
-> Text -- ^ User region (e.g. "eu", "cn", "us") -> Text -- ^ User region (e.g. "eu", "cn", "us")
-> WidgetT m IO () -- ^ Login widget -> WidgetT m IO () -- ^ Login widget
-> AuthPlugin m -> AuthPlugin m
oAuth2BattleNet clientId clientSecret region widget = authOAuth2Widget widget "battle.net" oAuthData $ makeCredentials region oAuth2BattleNet clientId clientSecret region widget = authOAuth2Widget widget "battle.net" oAuthData $ makeCredentials region
where oAuthData = OAuth2 { oauthClientId = clientId where oAuthData = OAuth2 { oauthClientId = clientId
, oauthClientSecret = clientSecret , oauthClientSecret = clientSecret
, oauthOAuthorizeEndpoint = fromRelative "https" host "/oauth/authorize" , oauthOAuthorizeEndpoint = fromRelative "https" host "/oauth/authorize"
, oauthAccessTokenEndpoint = fromRelative "https" host "/oauth/token" , oauthAccessTokenEndpoint = fromRelative "https" host "/oauth/token"
, oauthCallback = Nothing , oauthCallback = Nothing
} }
host = wwwHost $ T.toLower region host = wwwHost $ T.toLower region
makeCredentials :: Text -> Manager -> OAuth2Token -> IO (Creds m) makeCredentials :: Text -> Manager -> OAuth2Token -> IO (Creds m)
makeCredentials region manager token = do makeCredentials region manager token = do
userResult <- authGetJSON manager (accessToken token) userResult <- authGetJSON manager (accessToken token)
$ fromRelative "https" (apiHost $ T.toLower region) "/account/user" $ fromRelative "https" (apiHost $ T.toLower region) "/account/user"
case userResult of case userResult of
Left err -> throwIO $ invalidProfileResponse "battle.net" err Left err -> throwIO $ invalidProfileResponse "battle.net" err
Right user -> return Creds Right user -> return Creds
{ credsPlugin = "battle.net" { credsPlugin = "battle.net"
, credsIdent = T.pack $ show $ userId user , credsIdent = T.pack $ show $ userId user
, credsExtra = [("battletag", battleTag user)] , credsExtra = [("battletag", battleTag user)]
} }
apiHost :: Text -> Host apiHost :: Text -> Host
apiHost "cn" = "api.battlenet.com.cn" apiHost "cn" = "api.battlenet.com.cn"
apiHost region = Host $ E.encodeUtf8 $ region <> ".api.battle.net" apiHost region = Host $ E.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 $ E.encodeUtf8 $ region <> ".battle.net" wwwHost region = Host $ E.encodeUtf8 $ region <> ".battle.net"