BattleNet.hs

{-# 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
  , oAuth2BattleNet
  ) where

import Yesod.Auth.OAuth2.Prelude

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"

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
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"

    pure
      Creds
        { credsPlugin = pluginName
        , credsIdent = T.pack $ show userId
        , credsExtra = setExtra token userResponse
        }
 where
  host = wwwHost $ T.toLower region
  oauth2 =
    OAuth2
      { oauth2ClientId = clientId
      , oauth2ClientSecret = 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 region = Host $ encodeUtf8 $ region <> ".api.battle.net"

wwwHost :: Text -> Host
wwwHost "cn" = "www.battlenet.com.cn"
wwwHost region = Host $ encodeUtf8 $ region <> ".battle.net"

oAuth2BattleNet
  :: YesodAuth m => Text -> Text -> Text -> WidgetFor m () -> AuthPlugin m
oAuth2BattleNet i s r w = oauth2BattleNet w r i s
{-# DEPRECATED oAuth2BattleNet "Use oauth2BattleNet" #-}