From a3d8a6cdd572b881f0e267e3cbb6baad2f0b7d8f Mon Sep 17 00:00:00 2001 From: patrick brisbin Date: Mon, 29 Jun 2015 10:42:11 -0400 Subject: [PATCH 1/3] Add/fix documentation, change argument order - Document the difference between widget and non-widget functions - Pass the widget as the first argument to take advantage of partial application --- Yesod/Auth/OAuth2.hs | 32 ++++++++++++++++---------------- 1 file changed, 16 insertions(+), 16 deletions(-) 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 -- From a8396dddf06525621822566d72c35064cb77380a Mon Sep 17 00:00:00 2001 From: patrick brisbin Date: Mon, 29 Jun 2015 10:44:11 -0400 Subject: [PATCH 2/3] Fixes to EveOnline plugin - Fix invalid data declaration - Fix -Wall compilation warnings - Unused imports - Unused functions - Unused arguments - Shadowed function name - Incorporate plain link into WidgetType, remove Maybe - Use only one function, always accept WidgetType --- Yesod/Auth/OAuth2/EveOnline.hs | 46 +++++++++++++++------------------- 1 file changed, 20 insertions(+), 26 deletions(-) diff --git a/Yesod/Auth/OAuth2/EveOnline.hs b/Yesod/Auth/OAuth2/EveOnline.hs index 29683af..5c75615 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,18 +33,19 @@ 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 + { _eveUserId :: Int , eveUserName :: Text , eveUserExpire :: Text - , eveScopes :: [Text] + , _eveScopes :: [Text] , eveTokenType :: Text , eveCharOwnerHash :: Text } @@ -65,33 +64,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 +104,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 = From f3a74cd4b6b48aa07982d18ee5616bd299da535d Mon Sep 17 00:00:00 2001 From: patrick brisbin Date: Wed, 1 Jul 2015 11:46:48 -0400 Subject: [PATCH 3/3] Entirely remove unused fields --- Yesod/Auth/OAuth2/EveOnline.hs | 8 ++------ 1 file changed, 2 insertions(+), 6 deletions(-) diff --git a/Yesod/Auth/OAuth2/EveOnline.hs b/Yesod/Auth/OAuth2/EveOnline.hs index 5c75615..b96b8c4 100644 --- a/Yesod/Auth/OAuth2/EveOnline.hs +++ b/Yesod/Auth/OAuth2/EveOnline.hs @@ -42,20 +42,16 @@ data WidgetType m | 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"