diff --git a/Yesod/Auth/OAuth2/BattleNet.hs b/Yesod/Auth/OAuth2/BattleNet.hs new file mode 100644 index 0000000..1f6fb42 --- /dev/null +++ b/Yesod/Auth/OAuth2/BattleNet.hs @@ -0,0 +1,82 @@ +{-# LANGUAGE CPP #-} +{-# LANGUAGE OverloadedStrings #-} + +-- | +-- +-- OAuth2 plugin for Battle.Net +-- +-- * Authenticates against battle.net. +-- * Uses user's id as credentials identifier. +-- * Returns user's battletag in extras. +-- + +module Yesod.Auth.OAuth2.BattleNet + ( oAuth2BattleNet ) + where + +#if __GLASGOW_HASKELL__ < 710 +import Control.Applicative ((<$>), (<*>)) +#endif + +import Control.Exception (throwIO) +import Control.Monad (mzero) + +import Yesod.Auth +import Yesod.Auth.OAuth2 + +import Data.Monoid ((<>)) +import Network.HTTP.Conduit (Manager) + +import Data.Aeson +import Data.Text (Text) +import qualified Data.Text as T (pack, toLower) +import qualified Data.Text.Encoding as E (encodeUtf8) +import Prelude +import Yesod.Core.Widget + +data BattleNetUser = BattleNetUser + { userId :: Int + , battleTag :: Text + } + +instance FromJSON BattleNetUser where + parseJSON (Object o) = BattleNetUser + <$> o .: "id" + <*> o .: "battletag" + parseJSON _ = mzero + +oAuth2BattleNet :: YesodAuth m + => Text -- ^ Client ID + -> Text -- ^ Client Secret + -> Text -- ^ User region (e.g. "eu", "cn", "us") + -> WidgetT m IO () -- ^ Login widget + -> AuthPlugin m +oAuth2BattleNet clientId clientSecret region widget = authOAuth2Widget widget "battle.net" oAuthData (makeCredentials region) + where oAuthData = OAuth2 { oauthClientId = E.encodeUtf8 clientId + , oauthClientSecret = E.encodeUtf8 clientSecret + , oauthOAuthorizeEndpoint = E.encodeUtf8 ("https://" <> host <> "/oauth/authorize") + , oauthAccessTokenEndpoint = E.encodeUtf8 ("https://" <> host <> "/oauth/token") + , oauthCallback = Nothing + } + host = let r = T.toLower region in + case r of + "cn" -> "www.battlenet.com.cn" + _ -> r <> ".battle.net" + +makeCredentials :: Text -> Manager -> AccessToken -> IO (Creds m) +makeCredentials region manager token = do + userResult <- authGetJSON manager token ("https://" <> host <> "/account/user") :: IO (OAuth2Result BattleNetUser) + case userResult of + Left err -> throwIO $ InvalidProfileResponse "battle.net" err + Right user -> return Creds + { credsPlugin = "battle.net" + , credsIdent = T.pack $ show $ userId user + , credsExtra = [("battletag", battleTag user)] + } + where host :: URI + host = let r = T.toLower region in + case r of + "cn" -> "api.battlenet.com.cn" + _ -> E.encodeUtf8 r <> ".api.battle.net" + + diff --git a/yesod-auth-oauth2.cabal b/yesod-auth-oauth2.cabal index 677aae9..2a31d30 100644 --- a/yesod-auth-oauth2.cabal +++ b/yesod-auth-oauth2.cabal @@ -53,6 +53,7 @@ library Yesod.Auth.OAuth2.Slack Yesod.Auth.OAuth2.Salesforce Yesod.Auth.OAuth2.Bitbucket + Yesod.Auth.OAuth2.BattleNet ghc-options: -Wall