diff --git a/Yesod/Auth/OAuth2.hs b/Yesod/Auth/OAuth2.hs index 0f203d0..7a9145d 100644 --- a/Yesod/Auth/OAuth2.hs +++ b/Yesod/Auth/OAuth2.hs @@ -48,6 +48,10 @@ instance Exception YesodOAuth2Exception oauth2Url :: Text -> AuthRoute oauth2Url name = PluginR name ["forward"] +-- | Create an @'AuthPlugin'@ for the given OAuth2 provider +-- +-- Presents a generic @"Login via name"@ link +-- authOAuth2 :: YesodAuth m => Text -- ^ Service name -> OAuth2 -- ^ Service details @@ -59,21 +63,20 @@ authOAuth2 :: YesodAuth m -- -- See @'fromProfileURL'@ for an example. -> AuthPlugin m -authOAuth2 name oauth getCreds = authOAuth2Widget name oauth getCreds [whamlet|Login via #{name}|] +authOAuth2 name = authOAuth2Widget [whamlet|Login via #{name}|] name +-- | Create an @'AuthPlugin'@ for the given OAuth2 provider +-- +-- Allows passing a custom widget for the login link. See @'oauth2Eve'@ for an +-- example. +-- authOAuth2Widget :: YesodAuth m - => Text -- ^ Service name - -> OAuth2 -- ^ Service details + => WidgetT m IO () + -> Text + -> OAuth2 -> (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 +authOAuth2Widget widget name oauth getCreds = AuthPlugin name dispatch login where url = PluginR name ["callback"] @@ -118,12 +121,9 @@ authOAuth2Widget name oauth getCreds widget = AuthPlugin name dispatch login tokenSessionKey :: Text tokenSessionKey = "_yesod_oauth2_" <> name - login tm = [whamlet| - - ^{widget} - |] + login tm = [whamlet|^{widget}|] --- | Handle the common case of fetching Profile information a JSON endpoint +-- | Handle the common case of fetching Profile information from a JSON endpoint -- -- Throws @'InvalidProfileResponse'@ if JSON parsing fails -- diff --git a/Yesod/Auth/OAuth2/EveOnline.hs b/Yesod/Auth/OAuth2/EveOnline.hs index 29683af..b96b8c4 100644 --- a/Yesod/Auth/OAuth2/EveOnline.hs +++ b/Yesod/Auth/OAuth2/EveOnline.hs @@ -11,7 +11,6 @@ -- module Yesod.Auth.OAuth2.EveOnline ( oauth2Eve - , oauth2EveWidget , oauth2EveScoped , WidgetType(..) , module Yesod.Auth.OAuth2 @@ -25,9 +24,8 @@ 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 Data.Text (Text) +import Data.Text.Encoding (encodeUtf8) import Network.HTTP.Conduit (Manager) import Yesod.Auth import Yesod.Auth.OAuth2 @@ -35,28 +33,25 @@ import Yesod.Core.Widget import qualified Data.Text as T -data YesodAuth m => WidgetType m - = BigWhite +data WidgetType m + = Plain -- ^ Simple "Login via eveonline" text + | BigWhite | SmallWhite | BigBlack | SmallBlack | Custom (WidgetT m IO ()) data EveUser = EveUser - { eveUserId :: Int - , eveUserName :: Text + { eveUserName :: Text , eveUserExpire :: Text - , eveScopes :: [Text] , eveTokenType :: Text , eveCharOwnerHash :: Text } instance FromJSON EveUser where parseJSON (Object o) = EveUser - <$> o .: "CharacterID" - <*> o .: "CharacterName" + <$> o .: "CharacterName" <*> o .: "ExpiresOn" - <*> (T.words <$> o .: "Scopes") <*> o .: "TokenType" <*> o .: "CharacterOwnerHash" @@ -65,33 +60,28 @@ instance FromJSON EveUser where oauth2Eve :: YesodAuth m => Text -- ^ Client ID -> Text -- ^ Client Secret + -> WidgetType m -> AuthPlugin m -oauth2Eve clientId clientSecret = oauth2EveScoped clientId clientSecret ["publicData"] Nothing +oauth2Eve clientId clientSecret = oauth2EveScoped clientId clientSecret ["publicData"] . asWidget -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 + asWidget :: YesodAuth m => WidgetType m -> WidgetT m IO () + asWidget Plain = [whamlet|Login via eveonline|] + asWidget BigWhite = [whamlet||] + asWidget BigBlack = [whamlet||] + asWidget SmallWhite = [whamlet||] + asWidget SmallBlack = [whamlet||] + asWidget (Custom a) = a oauth2EveScoped :: YesodAuth m => Text -- ^ Client ID -> Text -- ^ Client Secret -> [Text] -- ^ List of scopes to request - -> Maybe (WidgetT m IO ()) -- ^ Login-Widget + -> 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 + authOAuth2Widget widget "eveonline" oauth fetchEveProfile + where oauth = OAuth2 { oauthClientId = encodeUtf8 clientId @@ -110,7 +100,7 @@ fetchEveProfile manager token = do Left err-> throwIO $ InvalidProfileResponse "eveonline" err toCreds :: EveUser -> AccessToken -> Creds m -toCreds user token = Creds +toCreds user _ = Creds { credsPlugin = "eveonline" , credsIdent = T.pack $ show $ eveCharOwnerHash user , credsExtra =