From a3d8a6cdd572b881f0e267e3cbb6baad2f0b7d8f Mon Sep 17 00:00:00 2001 From: patrick brisbin Date: Mon, 29 Jun 2015 10:42:11 -0400 Subject: [PATCH 1/5] 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/5] 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/5] 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" From 5dcfbea1a0424e80bb6239a8aa1e7fdd5af45789 Mon Sep 17 00:00:00 2001 From: Stefan Dresselhaus Date: Sun, 12 Jul 2015 18:27:02 +0200 Subject: [PATCH 4/5] Add accessToken to credsExtra --- Yesod/Auth/OAuth2/EveOnline.hs | 7 ++++--- 1 file changed, 4 insertions(+), 3 deletions(-) diff --git a/Yesod/Auth/OAuth2/EveOnline.hs b/Yesod/Auth/OAuth2/EveOnline.hs index b96b8c4..111bb12 100644 --- a/Yesod/Auth/OAuth2/EveOnline.hs +++ b/Yesod/Auth/OAuth2/EveOnline.hs @@ -7,7 +7,7 @@ -- -- * Authenticates against eveonline -- * Uses EVEs unique account-user-char-hash as credentials identifier --- * Returns charName, tokenType and expires as extras +-- * Returns charName, tokenType, accessToken and expires as extras -- module Yesod.Auth.OAuth2.EveOnline ( oauth2Eve @@ -25,7 +25,7 @@ import Control.Monad (mzero) import Data.Aeson import Data.Monoid ((<>)) import Data.Text (Text) -import Data.Text.Encoding (encodeUtf8) +import Data.Text.Encoding (encodeUtf8, decodeUtf8) import Network.HTTP.Conduit (Manager) import Yesod.Auth import Yesod.Auth.OAuth2 @@ -100,12 +100,13 @@ fetchEveProfile manager token = do Left err-> throwIO $ InvalidProfileResponse "eveonline" err toCreds :: EveUser -> AccessToken -> Creds m -toCreds user _ = Creds +toCreds user token = Creds { credsPlugin = "eveonline" , credsIdent = T.pack $ show $ eveCharOwnerHash user , credsExtra = [ ("charName", eveUserName user) , ("tokenType", eveTokenType user) , ("expires", eveUserExpire user) + , ("accessToken", decodeUtf8 . accessToken $ token) ] } From a6fc5ab03d93a78d7beab7a8aa75df5481cc3ba5 Mon Sep 17 00:00:00 2001 From: Stefan Dresselhaus Date: Sun, 12 Jul 2015 19:16:53 +0200 Subject: [PATCH 5/5] Add charId to credsExtra --- Yesod/Auth/OAuth2/EveOnline.hs | 5 ++++- 1 file changed, 4 insertions(+), 1 deletion(-) diff --git a/Yesod/Auth/OAuth2/EveOnline.hs b/Yesod/Auth/OAuth2/EveOnline.hs index 111bb12..09d0413 100644 --- a/Yesod/Auth/OAuth2/EveOnline.hs +++ b/Yesod/Auth/OAuth2/EveOnline.hs @@ -7,7 +7,7 @@ -- -- * Authenticates against eveonline -- * Uses EVEs unique account-user-char-hash as credentials identifier --- * Returns charName, tokenType, accessToken and expires as extras +-- * Returns charName, charId, tokenType, accessToken and expires as extras -- module Yesod.Auth.OAuth2.EveOnline ( oauth2Eve @@ -46,6 +46,7 @@ data EveUser = EveUser , eveUserExpire :: Text , eveTokenType :: Text , eveCharOwnerHash :: Text + , eveCharId :: Integer } instance FromJSON EveUser where @@ -54,6 +55,7 @@ instance FromJSON EveUser where <*> o .: "ExpiresOn" <*> o .: "TokenType" <*> o .: "CharacterOwnerHash" + <*> o .: "CharacterID" parseJSON _ = mzero @@ -105,6 +107,7 @@ toCreds user token = Creds , credsIdent = T.pack $ show $ eveCharOwnerHash user , credsExtra = [ ("charName", eveUserName user) + , ("charId", T.pack . show . eveCharId $ user) , ("tokenType", eveTokenType user) , ("expires", eveUserExpire user) , ("accessToken", decodeUtf8 . accessToken $ token)