diff --git a/Yesod/Auth/OAuth2.hs b/Yesod/Auth/OAuth2.hs --- a/Yesod/Auth/OAuth2.hs +++ b/Yesod/Auth/OAuth2.hs @@ -11,6 +11,7 @@ -- module Yesod.Auth.OAuth2 ( authOAuth2 + , authOAuth2Widget , oauth2Url , fromProfileURL , YesodOAuth2Exception(..) @@ -47,6 +48,10 @@ 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 @@ -57,10 +62,22 @@ -- second authorized request to @api/me.json@. -- -- See @'fromProfileURL'@ for an example. - -- -> AuthPlugin m -authOAuth2 name oauth getCreds = AuthPlugin name dispatch login +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 + => WidgetT m IO () + -> Text + -> OAuth2 + -> (Manager -> AccessToken -> IO (Creds m)) + -> AuthPlugin m +authOAuth2Widget widget name oauth getCreds = AuthPlugin name dispatch login + where url = PluginR name ["callback"] @@ -104,11 +121,9 @@ tokenSessionKey :: Text tokenSessionKey = "_yesod_oauth2_" <> name - login tm = [whamlet| - Login via #{name} - |] + 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 new file mode 100644 --- /dev/null +++ b/Yesod/Auth/OAuth2/EveOnline.hs @@ -0,0 +1,115 @@ +{-# 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, charId, tokenType, accessToken and expires as extras +-- +module Yesod.Auth.OAuth2.EveOnline + ( oauth2Eve + , 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 (Text) +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 WidgetType m + = Plain -- ^ Simple "Login via eveonline" text + | BigWhite + | SmallWhite + | BigBlack + | SmallBlack + | Custom (WidgetT m IO ()) + +data EveUser = EveUser + { eveUserName :: Text + , eveUserExpire :: Text + , eveTokenType :: Text + , eveCharOwnerHash :: Text + , eveCharId :: Integer + } + +instance FromJSON EveUser where + parseJSON (Object o) = EveUser + <$> o .: "CharacterName" + <*> o .: "ExpiresOn" + <*> o .: "TokenType" + <*> o .: "CharacterOwnerHash" + <*> o .: "CharacterID" + + parseJSON _ = mzero + +oauth2Eve :: YesodAuth m + => Text -- ^ Client ID + -> Text -- ^ Client Secret + -> WidgetType m + -> AuthPlugin m +oauth2Eve clientId clientSecret = oauth2EveScoped clientId clientSecret ["publicData"] . asWidget + + where + 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 + -> WidgetT m IO () -- ^ Login widget + -> AuthPlugin m +oauth2EveScoped clientId clientSecret scopes widget = + authOAuth2Widget widget "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) + , ("charId", T.pack . show . eveCharId $ user) + , ("tokenType", eveTokenType user) + , ("expires", eveUserExpire user) + , ("accessToken", decodeUtf8 . accessToken $ token) + ] + } diff --git a/Yesod/Auth/OAuth2/Nylas.hs b/Yesod/Auth/OAuth2/Nylas.hs new file mode 100644 --- /dev/null +++ b/Yesod/Auth/OAuth2/Nylas.hs @@ -0,0 +1,104 @@ +{-# LANGUAGE CPP #-} +{-# LANGUAGE OverloadedStrings #-} + +module Yesod.Auth.OAuth2.Nylas + ( oauth2Nylas + , module Yesod.Auth.OAuth2 + ) where + +#if __GLASGOW_HASKELL__ < 710 +import Control.Applicative ((<$>), (<*>)) +#endif + +import Control.Monad (mzero) +import Control.Exception.Lifted (throwIO) +import Data.Aeson (FromJSON, Value(..), parseJSON, decode, (.:)) +import Data.Monoid ((<>)) +import Data.Text (Text) +import Data.Text.Encoding (encodeUtf8, decodeUtf8) +import Data.Vector ((!?)) +import Network.HTTP.Client (applyBasicAuth, parseUrl, httpLbs, responseStatus + , responseBody) +import Network.HTTP.Conduit (Manager) +import Yesod.Auth (Creds(..), YesodAuth, AuthPlugin) +import Yesod.Auth.OAuth2 (OAuth2(..), AccessToken(..) + , YesodOAuth2Exception(InvalidProfileResponse) + , authOAuth2) + +import qualified Data.Text as T +import qualified Network.HTTP.Types as HT + +data NylasNamespace = NylasNamespace + { nylasNamespaceId :: Text + , nylasNamespaceAccountId :: Text + , nylasNamespaceEmailAddress :: Text + , nylasNamespaceName :: Text + , nylasNamespaceProvider :: Text + , nylasNamespaceOrganizationUnit :: Text + } + +instance FromJSON NylasNamespace where + parseJSON (Array singleton) = case singleton !? 0 of + Just (Object o) -> NylasNamespace + <$> o .: "id" + <*> o .: "account_id" + <*> o .: "email_address" + <*> o .: "name" + <*> o .: "provider" + <*> o .: "organization_unit" + _ -> mzero + parseJSON _ = mzero + +oauth2Nylas :: YesodAuth m + => Text -- ^ Client ID + -> Text -- ^ Client Secret + -> AuthPlugin m +oauth2Nylas = oauth2NylasScoped ["email"] + +oauth2NylasScoped :: YesodAuth m + => [Text] -- ^ Scopes + -> Text -- ^ Client ID + -> Text -- ^ Client Secret + -> AuthPlugin m +oauth2NylasScoped scopes clientId clientSecret = + authOAuth2 "nylas" oauth fetchCreds + where + authorizeUrl = encodeUtf8 + $ "https://api.nylas.com/oauth/authorize?scope=" + <> T.intercalate "," scopes + tokenUrl = "https://api.nylas.com/oauth/token" + oauth = OAuth2 + { oauthClientId = encodeUtf8 clientId + , oauthClientSecret = encodeUtf8 clientSecret + , oauthOAuthorizeEndpoint = authorizeUrl + , oauthAccessTokenEndpoint = tokenUrl + , oauthCallback = Nothing + } + +fetchCreds :: Manager -> AccessToken -> IO (Creds a) +fetchCreds manager token = do + req <- authorize <$> parseUrl "https://api.nylas.com/n" + resp <- httpLbs req manager + if HT.statusIsSuccessful (responseStatus resp) + then case decode (responseBody resp) of + Just ns -> return $ toCreds ns token + Nothing -> throwIO parseFailure + else throwIO requestFailure + where + authorize = applyBasicAuth (accessToken token) "" + parseFailure = InvalidProfileResponse "nylas" "failed to parse namespace" + requestFailure = InvalidProfileResponse "nylas" "failed to get namespace" + +toCreds :: NylasNamespace -> AccessToken -> Creds a +toCreds ns token = Creds + { credsPlugin = "nylas" + , credsIdent = nylasNamespaceId ns + , credsExtra = + [ ("account_id", nylasNamespaceAccountId ns) + , ("email_address", nylasNamespaceEmailAddress ns) + , ("name", nylasNamespaceName ns) + , ("provider", nylasNamespaceProvider ns) + , ("organization_unit", nylasNamespaceOrganizationUnit ns) + , ("access_token", decodeUtf8 $ accessToken token) + ] + } diff --git a/yesod-auth-oauth2.cabal b/yesod-auth-oauth2.cabal --- a/yesod-auth-oauth2.cabal +++ b/yesod-auth-oauth2.cabal @@ -1,5 +1,5 @@ name: yesod-auth-oauth2 -version: 0.1.2 +version: 0.1.3 license: BSD3 license-file: LICENSE author: Tom Streller @@ -24,9 +24,10 @@ build-depends: base >= 4.5 && < 5 , bytestring >= 0.9.1.4 + , http-client >= 0.4.0 && < 0.5 , http-conduit >= 2.0 && < 3.0 , http-types >= 0.8 && < 0.9 - , aeson >= 0.6 && < 0.9 + , aeson >= 0.6 && < 0.10 , yesod-core >= 1.2 && < 1.5 , authenticate >= 1.3.2.7 && < 1.4 , random @@ -36,6 +37,7 @@ , transformers >= 0.2.2 && < 0.5 , hoauth2 >= 0.4.7 && < 0.5 , lifted-base >= 0.2 && < 0.4 + , vector >= 0.10 && < 0.11 exposed-modules: Yesod.Auth.OAuth2 Yesod.Auth.OAuth2.Github @@ -43,6 +45,8 @@ Yesod.Auth.OAuth2.Spotify Yesod.Auth.OAuth2.Twitter Yesod.Auth.OAuth2.Upcase + Yesod.Auth.OAuth2.EveOnline + Yesod.Auth.OAuth2.Nylas ghc-options: -Wall