diff --git a/Yesod/Auth/OAuth2.hs b/Yesod/Auth/OAuth2.hs
index fe58afa..0f203d0 100644
--- a/Yesod/Auth/OAuth2.hs
+++ b/Yesod/Auth/OAuth2.hs
@@ -11,6 +11,7 @@
--
module Yesod.Auth.OAuth2
( authOAuth2
+ , authOAuth2Widget
, oauth2Url
, fromProfileURL
, YesodOAuth2Exception(..)
@@ -57,9 +58,22 @@ authOAuth2 :: YesodAuth m
-- second authorized request to @api/me.json@.
--
-- See @'fromProfileURL'@ for an example.
- --
-> AuthPlugin m
-authOAuth2 name oauth getCreds = AuthPlugin name dispatch login
+authOAuth2 name oauth getCreds = authOAuth2Widget name oauth getCreds [whamlet|Login via #{name}|]
+
+authOAuth2Widget :: YesodAuth m
+ => Text -- ^ Service name
+ -> OAuth2 -- ^ Service details
+ -> (Manager -> AccessToken -> IO (Creds m))
+ -- ^ This function defines how to take an @'AccessToken'@ and
+ -- retrieve additional information about the user, to be
+ -- set in the session as @'Creds'@. Usually this means a
+ -- second authorized request to @api/me.json@.
+ --
+ -- See @'fromProfileURL'@ for an example.
+ -> WidgetT m IO () -- ^ Widget to be shown instead of "Login with xxx"-Text
+ -> AuthPlugin m
+authOAuth2Widget name oauth getCreds widget = AuthPlugin name dispatch login
where
url = PluginR name ["callback"]
@@ -105,7 +119,8 @@ authOAuth2 name oauth getCreds = AuthPlugin name dispatch login
tokenSessionKey = "_yesod_oauth2_" <> name
login tm = [whamlet|
- Login via #{name}
+
+ ^{widget}
|]
-- | Handle the common case of fetching Profile information a JSON endpoint
diff --git a/Yesod/Auth/OAuth2/EveOnline.hs b/Yesod/Auth/OAuth2/EveOnline.hs
new file mode 100644
index 0000000..29683af
--- /dev/null
+++ b/Yesod/Auth/OAuth2/EveOnline.hs
@@ -0,0 +1,121 @@
+{-# LANGUAGE CPP #-}
+{-# LANGUAGE OverloadedStrings #-}
+{-# LANGUAGE QuasiQuotes #-}
+-- |
+--
+-- OAuth2 plugin for http://eveonline.com
+--
+-- * Authenticates against eveonline
+-- * Uses EVEs unique account-user-char-hash as credentials identifier
+-- * Returns charName, tokenType and expires as extras
+--
+module Yesod.Auth.OAuth2.EveOnline
+ ( oauth2Eve
+ , oauth2EveWidget
+ , oauth2EveScoped
+ , WidgetType(..)
+ , module Yesod.Auth.OAuth2
+ ) where
+
+#if __GLASGOW_HASKELL__ < 710
+import Control.Applicative ((<$>), (<*>))
+#endif
+
+import Control.Exception.Lifted
+import Control.Monad (mzero)
+import Data.Aeson
+import Data.Monoid ((<>))
+import Data.Text as T (Text,unwords)
+import Data.ByteString as B (ByteString)
+import Data.Text.Encoding (encodeUtf8, decodeUtf8)
+import Network.HTTP.Conduit (Manager)
+import Yesod.Auth
+import Yesod.Auth.OAuth2
+import Yesod.Core.Widget
+
+import qualified Data.Text as T
+
+data YesodAuth m => WidgetType m
+ = BigWhite
+ | SmallWhite
+ | BigBlack
+ | SmallBlack
+ | Custom (WidgetT m IO ())
+
+data EveUser = EveUser
+ { eveUserId :: Int
+ , eveUserName :: Text
+ , eveUserExpire :: Text
+ , eveScopes :: [Text]
+ , eveTokenType :: Text
+ , eveCharOwnerHash :: Text
+ }
+
+instance FromJSON EveUser where
+ parseJSON (Object o) = EveUser
+ <$> o .: "CharacterID"
+ <*> o .: "CharacterName"
+ <*> o .: "ExpiresOn"
+ <*> (T.words <$> o .: "Scopes")
+ <*> o .: "TokenType"
+ <*> o .: "CharacterOwnerHash"
+
+ parseJSON _ = mzero
+
+oauth2Eve :: YesodAuth m
+ => Text -- ^ Client ID
+ -> Text -- ^ Client Secret
+ -> AuthPlugin m
+oauth2Eve clientId clientSecret = oauth2EveScoped clientId clientSecret ["publicData"] Nothing
+
+oauth2EveWidget :: YesodAuth m
+ => Text -- ^ Client ID
+ -> Text -- ^ Client Secret
+ -> WidgetType m
+ -> AuthPlugin m
+oauth2EveWidget clientId clientSecret w = oauth2EveScoped clientId clientSecret ["publicData"] (Just . toWidget $ w)
+ where
+ toWidget :: YesodAuth m => WidgetType m -> WidgetT m IO ()
+ toWidget BigWhite = [whamlet|
|]
+ toWidget BigBlack = [whamlet|
|]
+ toWidget SmallWhite = [whamlet|
|]
+ toWidget SmallBlack = [whamlet|
|]
+ toWidget (Custom a) = a
+
+oauth2EveScoped :: YesodAuth m
+ => Text -- ^ Client ID
+ -> Text -- ^ Client Secret
+ -> [Text] -- ^ List of scopes to request
+ -> Maybe (WidgetT m IO ()) -- ^ Login-Widget
+ -> AuthPlugin m
+oauth2EveScoped clientId clientSecret scopes widget =
+ case widget of
+ Just w -> authOAuth2Widget "eveonline" oauth fetchEveProfile w
+ Nothing -> authOAuth2 "eveonline" oauth fetchEveProfile
+ where
+ oauth = OAuth2
+ { oauthClientId = encodeUtf8 clientId
+ , oauthClientSecret = encodeUtf8 clientSecret
+ , oauthOAuthorizeEndpoint = encodeUtf8 $ "https://login.eveonline.com/oauth/authorize?response_type=code&scope=" <> T.intercalate " " scopes
+ , oauthAccessTokenEndpoint = "https://login.eveonline.com/oauth/token"
+ , oauthCallback = Nothing
+ }
+
+fetchEveProfile :: Manager -> AccessToken -> IO (Creds m)
+fetchEveProfile manager token = do
+ userResult <- authGetJSON manager token "https://login.eveonline.com/oauth/verify"
+
+ case userResult of
+ Right user -> return $ toCreds user token
+ Left err-> throwIO $ InvalidProfileResponse "eveonline" err
+
+toCreds :: EveUser -> AccessToken -> Creds m
+toCreds user token = Creds
+ { credsPlugin = "eveonline"
+ , credsIdent = T.pack $ show $ eveCharOwnerHash user
+ , credsExtra =
+ [ ("charName", eveUserName user)
+ , ("tokenType", eveTokenType user)
+ , ("expires", eveUserExpire user)
+ ]
+ }
diff --git a/yesod-auth-oauth2.cabal b/yesod-auth-oauth2.cabal
index fa1a452..99f96e5 100644
--- a/yesod-auth-oauth2.cabal
+++ b/yesod-auth-oauth2.cabal
@@ -43,6 +43,7 @@ library
Yesod.Auth.OAuth2.Spotify
Yesod.Auth.OAuth2.Twitter
Yesod.Auth.OAuth2.Upcase
+ Yesod.Auth.OAuth2.EveOnline
ghc-options: -Wall