Merge pull request #33 from Drezil/master

Added EVE-Online SSO, support custom login widgets

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|
-        <a href=@{tm $ oauth2Url name}>Login via #{name}
+        <a href=@{tm $ oauth2Url name}>
+          ^{widget}
         |]
 
 -- | Handle the common case of fetching Profile information a JSON endpoint

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|<img src="https://images.contentful.com/idjq7aai9ylm/4PTzeiAshqiM8osU2giO0Y/5cc4cb60bac52422da2e45db87b6819c/EVE_SSO_Login_Buttons_Large_White.png?w=270&h=45">|]
+    toWidget BigBlack = [whamlet|<img src="https://images.contentful.com/idjq7aai9ylm/4fSjj56uD6CYwYyus4KmES/4f6385c91e6de56274d99496e6adebab/EVE_SSO_Login_Buttons_Large_Black.png?w=270&h=45">|]
+    toWidget SmallWhite = [whamlet|<img src="https://images.contentful.com/idjq7aai9ylm/18BxKSXCymyqY4QKo8KwKe/c2bdded6118472dd587c8107f24104d7/EVE_SSO_Login_Buttons_Small_White.png?w=195&h=30">|]
+    toWidget SmallBlack = [whamlet|<img src="https://images.contentful.com/idjq7aai9ylm/12vrPsIMBQi28QwCGOAqGk/33234da7672c6b0cdca394fc8e0b1c2b/EVE_SSO_Login_Buttons_Small_Black.png?w=195&h=30">|]
+    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)
+        ]
+    }

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