yesod-auth-oauth2-0.6.1.1/example/0000755000000000000000000000000013415466355014774 5ustar0000000000000000yesod-auth-oauth2-0.6.1.1/src/0000755000000000000000000000000013214762746014130 5ustar0000000000000000yesod-auth-oauth2-0.6.1.1/src/URI/0000755000000000000000000000000013214762746014567 5ustar0000000000000000yesod-auth-oauth2-0.6.1.1/src/URI/ByteString/0000755000000000000000000000000013350175755016660 5ustar0000000000000000yesod-auth-oauth2-0.6.1.1/src/Yesod/0000755000000000000000000000000013214762746015213 5ustar0000000000000000yesod-auth-oauth2-0.6.1.1/src/Yesod/Auth/0000755000000000000000000000000013415466355016114 5ustar0000000000000000yesod-auth-oauth2-0.6.1.1/src/Yesod/Auth/OAuth2/0000755000000000000000000000000013440745145017211 5ustar0000000000000000yesod-auth-oauth2-0.6.1.1/test/0000755000000000000000000000000013231632146014305 5ustar0000000000000000yesod-auth-oauth2-0.6.1.1/test/URI/0000755000000000000000000000000013207014671014744 5ustar0000000000000000yesod-auth-oauth2-0.6.1.1/test/URI/ByteString/0000755000000000000000000000000013231652614017040 5ustar0000000000000000yesod-auth-oauth2-0.6.1.1/src/URI/ByteString/Extension.hs0000644000000000000000000000302413350175755021167 0ustar0000000000000000{-# LANGUAGE FlexibleInstances #-} {-# OPTIONS_GHC -fno-warn-orphans #-} module URI.ByteString.Extension where import Data.ByteString (ByteString) import Data.String (IsString(..)) import Data.Text (Text) import Data.Text.Encoding (decodeUtf8, encodeUtf8) import Lens.Micro import qualified Data.ByteString.Char8 as C8 import URI.ByteString instance IsString Scheme where fromString = Scheme . fromString instance IsString Host where fromString = Host . fromString instance IsString (URIRef Absolute) where fromString = either (error . show) id . parseURI strictURIParserOptions . C8.pack instance IsString (URIRef Relative) where fromString = either (error . show) id . parseRelativeRef strictURIParserOptions . C8.pack fromText :: Text -> Maybe URI fromText = either (const Nothing) Just . parseURI strictURIParserOptions . encodeUtf8 unsafeFromText :: Text -> URI unsafeFromText = either (error . show) id . parseURI strictURIParserOptions . encodeUtf8 toText :: URI -> Text toText = decodeUtf8 . serializeURIRef' fromRelative :: Scheme -> Host -> RelativeRef -> URI fromRelative s h = flip withHost h . toAbsolute s withHost :: URIRef a -> Host -> URIRef a withHost u h = u & authorityL %~ maybe (Just $ Authority Nothing h Nothing) (\a -> Just $ a & authorityHostL .~ h) withPath :: URIRef a -> ByteString -> URIRef a withPath u p = u & pathL .~ p withQuery :: URIRef a -> [(ByteString, ByteString)] -> URIRef a withQuery u q = u & (queryL . queryPairsL) %~ (++ q) yesod-auth-oauth2-0.6.1.1/src/Yesod/Auth/OAuth2.hs0000644000000000000000000000475713415466355017567 0ustar0000000000000000{-# LANGUAGE FlexibleContexts #-} {-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE QuasiQuotes #-} -- | -- -- Generic OAuth2 plugin for Yesod -- -- See @"Yesod.Auth.OAuth2.GitHub"@ for example usage. -- module Yesod.Auth.OAuth2 ( OAuth2(..) , FetchCreds , Manager , OAuth2Token(..) , Creds(..) , oauth2Url , authOAuth2 , authOAuth2Widget -- * Reading our @'credsExtra'@ keys , getAccessToken , getRefreshToken , getUserResponse , getUserResponseJSON ) where import Control.Error.Util (note) import Control.Monad ((<=<)) import Data.Aeson (FromJSON, eitherDecode) import Data.ByteString.Lazy (ByteString, fromStrict) import Data.Text (Text) import Data.Text.Encoding (encodeUtf8) import Network.HTTP.Conduit (Manager) import Network.OAuth.OAuth2 import Yesod.Auth import Yesod.Auth.OAuth2.Dispatch import Yesod.Core.Widget 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 -> OAuth2 -> FetchCreds m -> AuthPlugin m 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 => WidgetFor m () -> Text -> OAuth2 -> FetchCreds m -> AuthPlugin m authOAuth2Widget widget name oauth getCreds = AuthPlugin name (dispatchAuthRequest name oauth getCreds) login where login tm = [whamlet|^{widget}|] -- | Read the @'AccessToken'@ from the values set via @'setExtra'@ getAccessToken :: Creds m -> Maybe AccessToken getAccessToken = (AccessToken <$>) . lookup "accessToken" . credsExtra -- | Read the @'RefreshToken'@ from the values set via @'setExtra'@ -- -- N.B. not all providers supply this value. -- getRefreshToken :: Creds m -> Maybe RefreshToken getRefreshToken = (RefreshToken <$>) . lookup "refreshToken" . credsExtra -- | Read the original profile response from the values set via @'setExtra'@ getUserResponse :: Creds m -> Maybe ByteString getUserResponse = (fromStrict . encodeUtf8 <$>) . lookup "userResponse" . credsExtra -- | @'getUserResponse'@, and decode as JSON getUserResponseJSON :: FromJSON a => Creds m -> Either String a getUserResponseJSON = eitherDecode <=< note "userResponse key not present" . getUserResponse yesod-auth-oauth2-0.6.1.1/src/Yesod/Auth/OAuth2/AzureAD.hs0000644000000000000000000000303213440745145021036 0ustar0000000000000000{-# LANGUAGE OverloadedStrings #-} -- | -- -- OAuth2 plugin for Azure AD. -- -- * Authenticates against Azure AD -- * Uses email as credentials identifier -- module Yesod.Auth.OAuth2.AzureAD ( oauth2AzureAD , oauth2AzureADScoped ) where import Prelude import Yesod.Auth.OAuth2.Prelude newtype User = User Text instance FromJSON User where parseJSON = withObject "User" $ \o -> User <$> o .: "mail" pluginName :: Text pluginName = "azuread" defaultScopes :: [Text] defaultScopes = ["openid", "profile"] oauth2AzureAD :: YesodAuth m => Text -> Text -> AuthPlugin m oauth2AzureAD = oauth2AzureADScoped defaultScopes oauth2AzureADScoped :: YesodAuth m => [Text] -> Text -> Text -> AuthPlugin m oauth2AzureADScoped scopes clientId clientSecret = authOAuth2 pluginName oauth2 $ \manager token -> do (User userId, userResponse) <- authGetProfile pluginName manager token "https://graph.microsoft.com/v1.0/me" pure Creds { credsPlugin = pluginName , credsIdent = userId , credsExtra = setExtra token userResponse } where oauth2 = OAuth2 { oauthClientId = clientId , oauthClientSecret = clientSecret , oauthOAuthorizeEndpoint = "https://login.windows.net/common/oauth2/authorize" `withQuery` [ scopeParam "," scopes , ("resource", "https://graph.microsoft.com") ] , oauthAccessTokenEndpoint = "https://login.windows.net/common/oauth2/token" , oauthCallback = Nothing } yesod-auth-oauth2-0.6.1.1/src/Yesod/Auth/OAuth2/BattleNet.hs0000644000000000000000000000401013350175755021426 0ustar0000000000000000{-# LANGUAGE OverloadedStrings #-} -- | -- -- OAuth2 plugin for Battle.Net -- -- * Authenticates against battle.net. -- * Uses user's id as credentials identifier. -- * Returns user's battletag in extras. -- module Yesod.Auth.OAuth2.BattleNet ( oauth2BattleNet , oAuth2BattleNet ) where import Yesod.Auth.OAuth2.Prelude import qualified Data.Text as T (pack, toLower) import Yesod.Core.Widget newtype User = User Int instance FromJSON User where parseJSON = withObject "User" $ \o -> User <$> o .: "id" pluginName :: Text pluginName = "battle.net" oauth2BattleNet :: YesodAuth m => WidgetFor m () -- ^ Login widget -> Text -- ^ User region (e.g. "eu", "cn", "us") -> Text -- ^ Client ID -> Text -- ^ Client Secret -> AuthPlugin m oauth2BattleNet widget region clientId clientSecret = authOAuth2Widget widget pluginName oauth2 $ \manager token -> do (User userId, userResponse) <- authGetProfile pluginName manager token $ fromRelative "https" (apiHost $ T.toLower region) "/account/user" pure Creds { credsPlugin = pluginName , credsIdent = T.pack $ show userId , credsExtra = setExtra token userResponse } where host = wwwHost $ T.toLower region oauth2 = OAuth2 { oauthClientId = clientId , oauthClientSecret = clientSecret , oauthOAuthorizeEndpoint = fromRelative "https" host "/oauth/authorize" , oauthAccessTokenEndpoint = fromRelative "https" host "/oauth/token" , oauthCallback = Nothing } apiHost :: Text -> Host apiHost "cn" = "api.battlenet.com.cn" apiHost region = Host $ encodeUtf8 $ region <> ".api.battle.net" wwwHost :: Text -> Host wwwHost "cn" = "www.battlenet.com.cn" wwwHost region = Host $ encodeUtf8 $ region <> ".battle.net" oAuth2BattleNet :: YesodAuth m => Text -> Text -> Text -> WidgetFor m () -> AuthPlugin m oAuth2BattleNet i s r w = oauth2BattleNet w r i s {-# DEPRECATED oAuth2BattleNet "Use oauth2BattleNet" #-} yesod-auth-oauth2-0.6.1.1/src/Yesod/Auth/OAuth2/Bitbucket.hs0000644000000000000000000000370113240415367021460 0ustar0000000000000000{-# LANGUAGE OverloadedStrings #-} -- | -- -- OAuth2 plugin for http://bitbucket.com -- -- * Authenticates against bitbucket -- * Uses bitbucket uuid as credentials identifier -- module Yesod.Auth.OAuth2.Bitbucket ( oauth2Bitbucket , oauth2BitbucketScoped ) where import Yesod.Auth.OAuth2.Prelude import qualified Data.Text as T newtype User = User Text instance FromJSON User where parseJSON = withObject "User" $ \o -> User <$> o .: "uuid" pluginName :: Text pluginName = "bitbucket" defaultScopes :: [Text] defaultScopes = ["account"] oauth2Bitbucket :: YesodAuth m => Text -> Text -> AuthPlugin m oauth2Bitbucket = oauth2BitbucketScoped defaultScopes oauth2BitbucketScoped :: YesodAuth m => [Text] -> Text -> Text -> AuthPlugin m oauth2BitbucketScoped scopes clientId clientSecret = authOAuth2 pluginName oauth2 $ \manager token -> do (User userId, userResponse) <- authGetProfile pluginName manager token "https://api.bitbucket.com/2.0/user" pure Creds { credsPlugin = pluginName -- FIXME: Preserved bug. This should just be userId (it's already -- a Text), but because this code was shipped, folks likely have -- Idents in their database like @"\"...\""@, and if we fixed this -- they would need migrating. We're keeping it for now as it's a -- minor wart. Breaking typed APIs is one thing, causing data to go -- invalid is another. , credsIdent = T.pack $ show userId , credsExtra = setExtra token userResponse } where oauth2 = OAuth2 { oauthClientId = clientId , oauthClientSecret = clientSecret , oauthOAuthorizeEndpoint = "https://bitbucket.com/site/oauth2/authorize" `withQuery` [ scopeParam "," scopes ] , oauthAccessTokenEndpoint = "https://bitbucket.com/site/oauth2/access_token" , oauthCallback = Nothing } yesod-auth-oauth2-0.6.1.1/src/Yesod/Auth/OAuth2/Dispatch.hs0000644000000000000000000001227113415466355021314 0ustar0000000000000000{-# LANGUAGE FlexibleContexts #-} {-# LANGUAGE LambdaCase #-} {-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE RankNTypes #-} {-# LANGUAGE RecordWildCards #-} {-# LANGUAGE ScopedTypeVariables #-} {-# LANGUAGE TemplateHaskell #-} {-# LANGUAGE TypeFamilies #-} module Yesod.Auth.OAuth2.Dispatch ( FetchCreds , dispatchAuthRequest ) where import Control.Exception.Safe import Control.Monad (unless, (<=<)) import Data.Monoid ((<>)) import Data.Text (Text) import qualified Data.Text as T import Data.Text.Encoding (encodeUtf8) import Network.HTTP.Conduit (Manager) import Network.OAuth.OAuth2 import System.Random (newStdGen, randomRs) import URI.ByteString.Extension import Yesod.Auth hiding (ServerError) import Yesod.Auth.OAuth2.ErrorResponse import Yesod.Auth.OAuth2.Exception import Yesod.Core hiding (ErrorResponse) -- | How to take an @'OAuth2Token'@ and retrieve user credentials type FetchCreds m = Manager -> OAuth2Token -> IO (Creds m) -- | Dispatch the various OAuth2 handshake routes dispatchAuthRequest :: Text -- ^ Name -> OAuth2 -- ^ Service details -> FetchCreds m -- ^ How to get credentials -> Text -- ^ Method -> [Text] -- ^ Path pieces -> AuthHandler m TypedContent dispatchAuthRequest name oauth2 _ "GET" ["forward"] = dispatchForward name oauth2 dispatchAuthRequest name oauth2 getCreds "GET" ["callback"] = dispatchCallback name oauth2 getCreds dispatchAuthRequest _ _ _ _ _ = notFound -- | Handle @GET \/forward@ -- -- 1. Set a random CSRF token in our session -- 2. Redirect to the Provider's authorization URL -- dispatchForward :: Text -> OAuth2 -> AuthHandler m TypedContent dispatchForward name oauth2 = do csrf <- setSessionCSRF $ tokenSessionKey name oauth2' <- withCallbackAndState name oauth2 csrf redirect $ toText $ authorizationUrl oauth2' -- | Handle @GET \/callback@ -- -- 1. Verify the URL's CSRF token matches our session -- 2. Use the code parameter to fetch an AccessToken for the Provider -- 3. Use the AccessToken to construct a @'Creds'@ value for the Provider -- dispatchCallback :: Text -> OAuth2 -> FetchCreds m -> AuthHandler m TypedContent dispatchCallback name oauth2 getCreds = do csrf <- verifySessionCSRF $ tokenSessionKey name onErrorResponse errInvalidOAuth code <- requireGetParam "code" manager <- authHttpManager oauth2' <- withCallbackAndState name oauth2 csrf token <- errLeft $ fetchAccessToken manager oauth2' $ ExchangeToken code creds <- errLeft $ tryFetchCreds $ getCreds manager token setCredsRedirect creds where errLeft :: Show e => IO (Either e a) -> AuthHandler m a errLeft = either (errInvalidOAuth . unknownError . tshow) pure <=< liftIO errInvalidOAuth :: ErrorResponse -> AuthHandler m a errInvalidOAuth err = do $(logError) $ "OAuth2 error (" <> name <> "): " <> tshow err redirectMessage $ "Unable to log in with OAuth2: " <> erUserMessage err redirectMessage :: Text -> AuthHandler m a redirectMessage msg = do toParent <- getRouteToParent setMessage $ toHtml msg redirect $ toParent LoginR tryFetchCreds :: IO a -> IO (Either SomeException a) tryFetchCreds f = (Right <$> f) `catch` (\(ex :: IOException) -> pure $ Left $ toException ex) `catch` (\(ex :: YesodOAuth2Exception) -> pure $ Left $ toException ex) withCallbackAndState :: Text -> OAuth2 -> Text -> AuthHandler m OAuth2 withCallbackAndState name oauth2 csrf = do let url = PluginR name ["callback"] render <- getParentUrlRender let callbackText = render url callback <- maybe (liftIO $ throwString $ "Invalid callback URI: " <> T.unpack callbackText <> ". Not using an absolute Approot?" ) pure $ fromText callbackText pure oauth2 { oauthCallback = Just callback , oauthOAuthorizeEndpoint = oauthOAuthorizeEndpoint oauth2 `withQuery` [("state", encodeUtf8 csrf)] } getParentUrlRender :: MonadHandler m => m (Route (SubHandlerSite m) -> Text) getParentUrlRender = (.) <$> getUrlRender <*> getRouteToParent -- | Set a random, 30-character value in the session setSessionCSRF :: MonadHandler m => Text -> m Text setSessionCSRF sessionKey = do csrfToken <- liftIO randomToken csrfToken <$ setSession sessionKey csrfToken where randomToken = T.pack . take 30 . randomRs ('a', 'z') <$> newStdGen -- | Verify the callback provided the same CSRF token as in our session verifySessionCSRF :: MonadHandler m => Text -> m Text verifySessionCSRF sessionKey = do token <- requireGetParam "state" sessionToken <- lookupSession sessionKey deleteSession sessionKey unless (sessionToken == Just token) $ permissionDenied "Invalid OAuth2 state token" return token requireGetParam :: MonadHandler m => Text -> m Text requireGetParam key = do m <- lookupGetParam key maybe errInvalidArgs return m where errInvalidArgs = invalidArgs ["The '" <> key <> "' parameter is required"] tokenSessionKey :: Text -> Text tokenSessionKey name = "_yesod_oauth2_" <> name tshow :: Show a => a -> Text tshow = T.pack . show yesod-auth-oauth2-0.6.1.1/src/Yesod/Auth/OAuth2/ErrorResponse.hs0000644000000000000000000000463513415466355022372 0ustar0000000000000000{-# LANGUAGE OverloadedStrings #-} -- | OAuth callback error response -- -- -- module Yesod.Auth.OAuth2.ErrorResponse ( ErrorResponse(..) , erUserMessage , ErrorName(..) , onErrorResponse , unknownError ) where import Data.Foldable (traverse_) import Data.Text (Text) import Data.Traversable (for) import Yesod.Core (MonadHandler, lookupGetParam) data ErrorName = InvalidRequest | UnauthorizedClient | AccessDenied | UnsupportedResponseType | InvalidScope | ServerError | TemporarilyUnavailable | Unknown Text deriving Show data ErrorResponse = ErrorResponse { erName :: ErrorName , erDescription :: Maybe Text , erURI :: Maybe Text } deriving Show -- | Textual value suitable for display to a User erUserMessage :: ErrorResponse -> Text erUserMessage err = case erName err of InvalidRequest -> "Invalid request" UnauthorizedClient -> "Unauthorized client" AccessDenied -> "Access denied" UnsupportedResponseType -> "Unsupported response type" InvalidScope -> "Invalid scope" ServerError -> "Server error" TemporarilyUnavailable -> "Temporarily unavailable" Unknown _ -> "Unknown error" unknownError :: Text -> ErrorResponse unknownError x = ErrorResponse { erName = Unknown x , erDescription = Nothing , erURI = Nothing } -- | Check query parameters for an error, if found run the given action -- -- The action is expected to use a short-circuit response function like -- @'permissionDenied'@, hence this returning @()@. -- onErrorResponse :: MonadHandler m => (ErrorResponse -> m a) -> m () onErrorResponse f = traverse_ f =<< checkErrorResponse checkErrorResponse :: MonadHandler m => m (Maybe ErrorResponse) checkErrorResponse = do merror <- lookupGetParam "error" for merror $ \err -> ErrorResponse <$> pure (readErrorName err) <*> lookupGetParam "error_description" <*> lookupGetParam "error_uri" readErrorName :: Text -> ErrorName readErrorName "invalid_request" = InvalidRequest readErrorName "unauthorized_client" = UnauthorizedClient readErrorName "access_denied" = AccessDenied readErrorName "unsupported_response_type" = UnsupportedResponseType readErrorName "invalid_scope" = InvalidScope readErrorName "server_error" = ServerError readErrorName "temporarily_unavailable" = TemporarilyUnavailable readErrorName x = Unknown x yesod-auth-oauth2-0.6.1.1/src/Yesod/Auth/OAuth2/EveOnline.hs0000644000000000000000000000550313350175755021440 0ustar0000000000000000{-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE QuasiQuotes #-} -- | -- -- OAuth2 plugin for http://eveonline.com -- -- * Authenticates against eveonline -- * Uses EVEs unique account-user-char-hash as credentials identifier -- module Yesod.Auth.OAuth2.EveOnline ( oauth2Eve , oauth2EveScoped , WidgetType(..) ) where import Yesod.Auth.OAuth2.Prelude import qualified Data.Text as T import Yesod.Core.Widget newtype User = User Text instance FromJSON User where parseJSON = withObject "User" $ \o -> User <$> o .: "CharacterOwnerHash" data WidgetType m = Plain -- ^ Simple "Login via eveonline" text | BigWhite | SmallWhite | BigBlack | SmallBlack | Custom (WidgetFor m ()) asWidget :: YesodAuth m => WidgetType m -> WidgetFor m () asWidget Plain = [whamlet|Login via eveonline|] asWidget BigWhite = [whamlet||] asWidget BigBlack = [whamlet||] asWidget SmallWhite = [whamlet||] asWidget SmallBlack = [whamlet||] asWidget (Custom a) = a pluginName :: Text pluginName = "eveonline" defaultScopes :: [Text] defaultScopes = ["publicData"] oauth2Eve :: YesodAuth m => WidgetType m -> Text -> Text -> AuthPlugin m oauth2Eve = oauth2EveScoped defaultScopes oauth2EveScoped :: YesodAuth m => [Text] -> WidgetType m -> Text -> Text -> AuthPlugin m oauth2EveScoped scopes widgetType clientId clientSecret = authOAuth2Widget (asWidget widgetType) pluginName oauth2 $ \manager token -> do (User userId, userResponse) <- authGetProfile pluginName manager token "https://login.eveonline.com/oauth/verify" pure Creds { credsPlugin = "eveonline" -- FIXME: Preserved bug. See similar comment in Bitbucket provider. , credsIdent = T.pack $ show userId , credsExtra = setExtra token userResponse } where oauth2 = OAuth2 { oauthClientId = clientId , oauthClientSecret = clientSecret , oauthOAuthorizeEndpoint = "https://login.eveonline.com/oauth/authorize" `withQuery` [ ("response_type", "code") , scopeParam " " scopes ] , oauthAccessTokenEndpoint = "https://login.eveonline.com/oauth/token" , oauthCallback = Nothing } yesod-auth-oauth2-0.6.1.1/src/Yesod/Auth/OAuth2/Exception.hs0000644000000000000000000000132413415466355021510 0ustar0000000000000000{-# LANGUAGE DeriveDataTypeable #-} module Yesod.Auth.OAuth2.Exception ( YesodOAuth2Exception(..) ) where import Control.Exception.Safe import Data.ByteString.Lazy (ByteString) import Data.Text (Text) data YesodOAuth2Exception = OAuth2Error Text ByteString -- ^ HTTP error during OAuth2 handshake -- -- Plugin name and JSON-encoded @OAuth2Error@ from @hoauth2@. -- | JSONDecodingError Text String -- ^ User profile was not as expected -- -- Plugin name and Aeson parse error message. -- | GenericError Text String -- ^ Other error conditions -- -- Plugin name and error message. -- deriving (Show, Typeable) instance Exception YesodOAuth2Exception yesod-auth-oauth2-0.6.1.1/src/Yesod/Auth/OAuth2/GitHub.hs0000644000000000000000000000275113415466355020741 0ustar0000000000000000{-# LANGUAGE OverloadedStrings #-} -- | -- -- OAuth2 plugin for http://github.com -- -- * Authenticates against github -- * Uses github user id as credentials identifier -- module Yesod.Auth.OAuth2.GitHub ( oauth2GitHub , oauth2GitHubScoped ) where import Yesod.Auth.OAuth2.Prelude import qualified Data.Text as T newtype User = User Int instance FromJSON User where parseJSON = withObject "User" $ \o -> User <$> o .: "id" pluginName :: Text pluginName = "github" defaultScopes :: [Text] defaultScopes = ["user:email"] oauth2GitHub :: YesodAuth m => Text -> Text -> AuthPlugin m oauth2GitHub = oauth2GitHubScoped defaultScopes oauth2GitHubScoped :: YesodAuth m => [Text] -> Text -> Text -> AuthPlugin m oauth2GitHubScoped scopes clientId clientSecret = authOAuth2 pluginName oauth2 $ \manager token -> do (User userId, userResponse) <- authGetProfile pluginName manager token "https://api.github.com/user" pure Creds { credsPlugin = pluginName , credsIdent = T.pack $ show userId , credsExtra = setExtra token userResponse } where oauth2 = OAuth2 { oauthClientId = clientId , oauthClientSecret = clientSecret , oauthOAuthorizeEndpoint = "https://github.com/login/oauth/authorize" `withQuery` [ scopeParam "," scopes ] , oauthAccessTokenEndpoint = "https://github.com/login/oauth/access_token" , oauthCallback = Nothing } yesod-auth-oauth2-0.6.1.1/src/Yesod/Auth/OAuth2/GitLab.hs0000644000000000000000000000356513350175755020724 0ustar0000000000000000{-# LANGUAGE OverloadedStrings #-} module Yesod.Auth.OAuth2.GitLab ( oauth2GitLab , oauth2GitLabHostScopes , defaultHost , defaultScopes ) where import Yesod.Auth.OAuth2.Prelude import qualified Data.Text as T newtype User = User Int instance FromJSON User where parseJSON = withObject "User" $ \o -> User <$> o .: "id" pluginName :: Text pluginName = "gitlab" defaultHost :: URI defaultHost = "https://gitlab.com" defaultScopes :: [Text] defaultScopes = ["read_user"] -- | Authorize with @gitlab.com@ and @[\"read_user\"]@ -- -- To customize either of these values, use @'oauth2GitLabHostScopes'@ and pass -- the default for the argument not being customized. Note that we require at -- least @read_user@, so we can request the credentials identifier. -- -- > oauth2GitLabHostScopes defaultHost ["api", "read_user"] -- > oauth2GitLabHostScopes "https://gitlab.example.com" defaultScopes -- oauth2GitLab :: YesodAuth m => Text -> Text -> AuthPlugin m oauth2GitLab = oauth2GitLabHostScopes defaultHost defaultScopes oauth2GitLabHostScopes :: YesodAuth m => URI -> [Text] -> Text -> Text -> AuthPlugin m oauth2GitLabHostScopes host scopes clientId clientSecret = authOAuth2 pluginName oauth2 $ \manager token -> do (User userId, userResponse) <- authGetProfile pluginName manager token $ host `withPath` "/api/v4/user" pure Creds { credsPlugin = pluginName , credsIdent = T.pack $ show userId , credsExtra = setExtra token userResponse } where oauth2 = OAuth2 { oauthClientId = clientId , oauthClientSecret = clientSecret , oauthOAuthorizeEndpoint = host `withPath` "/oauth/authorize" `withQuery` [ scopeParam " " scopes ] , oauthAccessTokenEndpoint = host `withPath` "/oauth/token" , oauthCallback = Nothing } yesod-auth-oauth2-0.6.1.1/src/Yesod/Auth/OAuth2/Google.hs0000644000000000000000000000424413240567615020767 0ustar0000000000000000{-# LANGUAGE OverloadedStrings #-} -- | -- -- OAuth2 plugin for http://www.google.com -- -- * Authenticates against Google -- * Uses Google user id as credentials identifier -- -- If you were previously relying on email as the creds identifier, you can -- still do that (and more) by overriding it in the creds returned by the plugin -- with any value read out of the new @userResponse@ key in @'credsExtra'@. -- -- For example: -- -- > data User = User { userEmail :: Text } -- > -- > instance FromJSON User where -- you know... -- > -- > authenticate creds = do -- > -- 'getUserResponseJSON' provided by "Yesod.Auth.OAuth" module -- > let Right email = userEmail <$> getUserResponseJSON creds -- > updatedCreds = creds { credsIdent = email } -- > -- > -- continue normally with updatedCreds -- module Yesod.Auth.OAuth2.Google ( oauth2Google , oauth2GoogleScoped ) where import Yesod.Auth.OAuth2.Prelude newtype User = User Text instance FromJSON User where parseJSON = withObject "User" $ \o -> User -- Required for data backwards-compatibility <$> (("google-uid:" <>) <$> o .: "sub") pluginName :: Text pluginName = "google" defaultScopes :: [Text] defaultScopes = ["openid", "email"] oauth2Google :: YesodAuth m => Text -> Text -> AuthPlugin m oauth2Google = oauth2GoogleScoped defaultScopes oauth2GoogleScoped :: YesodAuth m => [Text] -> Text -> Text -> AuthPlugin m oauth2GoogleScoped scopes clientId clientSecret = authOAuth2 pluginName oauth2 $ \manager token -> do (User userId, userResponse) <- authGetProfile pluginName manager token "https://www.googleapis.com/oauth2/v3/userinfo" pure Creds { credsPlugin = pluginName , credsIdent = userId , credsExtra = setExtra token userResponse } where oauth2 = OAuth2 { oauthClientId = clientId , oauthClientSecret = clientSecret , oauthOAuthorizeEndpoint = "https://accounts.google.com/o/oauth2/auth" `withQuery` [ scopeParam " " scopes ] , oauthAccessTokenEndpoint = "https://www.googleapis.com/oauth2/v3/token" , oauthCallback = Nothing } yesod-auth-oauth2-0.6.1.1/src/Yesod/Auth/OAuth2/Nylas.hs0000644000000000000000000000463413415466355020647 0ustar0000000000000000{-# LANGUAGE OverloadedStrings #-} module Yesod.Auth.OAuth2.Nylas ( oauth2Nylas ) where import Yesod.Auth.OAuth2.Prelude import Control.Monad (unless) import qualified Data.ByteString.Lazy.Char8 as BL8 import Network.HTTP.Client import qualified Network.HTTP.Types as HT import qualified Yesod.Auth.OAuth2.Exception as YesodOAuth2Exception newtype User = User Text instance FromJSON User where parseJSON = withObject "User" $ \o -> User <$> o .: "id" pluginName :: Text pluginName = "nylas" defaultScopes :: [Text] defaultScopes = ["email"] oauth2Nylas :: YesodAuth m => Text -> Text -> AuthPlugin m oauth2Nylas clientId clientSecret = authOAuth2 pluginName oauth $ \manager token -> do req <- applyBasicAuth (encodeUtf8 $ atoken $ accessToken token) "" <$> parseRequest "https://api.nylas.com/account" resp <- httpLbs req manager let userResponse = responseBody resp -- FIXME: was this working? I'm 95% sure that the client will throw its -- own exception on unsuccessful status codes. unless (HT.statusIsSuccessful $ responseStatus resp) $ throwIO $ YesodOAuth2Exception.GenericError pluginName $ "Unsuccessful HTTP response: " <> BL8.unpack userResponse either (throwIO . YesodOAuth2Exception.JSONDecodingError pluginName) (\(User userId) -> pure Creds { credsPlugin = pluginName , credsIdent = userId , credsExtra = setExtra token userResponse } ) $ eitherDecode userResponse where oauth = OAuth2 { oauthClientId = clientId , oauthClientSecret = clientSecret , oauthOAuthorizeEndpoint = "https://api.nylas.com/oauth/authorize" `withQuery` [ ("response_type", "code") , ( "client_id" , encodeUtf8 clientId ) -- N.B. The scopes delimeter is unknown/untested. Verify that before -- extracting this to an argument and offering a Scoped function. In -- its current state, it doesn't matter because it's only one scope. , scopeParam "," defaultScopes ] , oauthAccessTokenEndpoint = "https://api.nylas.com/oauth/token" , oauthCallback = Nothing } yesod-auth-oauth2-0.6.1.1/src/Yesod/Auth/OAuth2/Prelude.hs0000644000000000000000000000640613415466355021160 0ustar0000000000000000{-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE TupleSections #-} -- | -- -- Modules and support functions required by most or all provider -- implementations. May also be useful for writing local providers. -- module Yesod.Auth.OAuth2.Prelude ( -- * Provider helpers authGetProfile , scopeParam , setExtra -- * Text , Text , decodeUtf8 , encodeUtf8 -- * JSON , (.:) , (.:?) , (.=) , (<>) , FromJSON(..) , ToJSON(..) , eitherDecode , withObject -- * Exceptions , throwIO -- * OAuth2 , OAuth2(..) , OAuth2Token(..) , AccessToken(..) , RefreshToken(..) -- * HTTP , Manager -- * Yesod , YesodAuth(..) , AuthPlugin(..) , Creds(..) -- * Bytestring URI types , URI , Host(..) -- * Bytestring URI extensions , module URI.ByteString.Extension -- * Temporary, until I finish re-structuring modules , authOAuth2 , authOAuth2Widget ) where import Control.Exception.Safe import Data.Aeson import Data.ByteString (ByteString) import qualified Data.ByteString.Lazy as BL import Data.Semigroup ((<>)) import Data.Text (Text) import qualified Data.Text as T import Data.Text.Encoding import Network.HTTP.Conduit import Network.OAuth.OAuth2 import URI.ByteString import URI.ByteString.Extension import Yesod.Auth import Yesod.Auth.OAuth2 import qualified Yesod.Auth.OAuth2.Exception as YesodOAuth2Exception -- | Retrieve a user's profile as JSON -- -- The response should be parsed only far enough to read the required -- @'credsIdent'@. Additional information should either be re-parsed by or -- fetched via additional requests by consumers. -- authGetProfile :: FromJSON a => Text -> Manager -> OAuth2Token -> URI -> IO (a, BL.ByteString) authGetProfile name manager token url = do resp <- fromAuthGet name =<< authGetBS manager (accessToken token) url decoded <- fromAuthJSON name resp pure (decoded, resp) -- | Throws a @Left@ result as an @'YesodOAuth2Exception'@ fromAuthGet :: Text -> Either (OAuth2Error Value) BL.ByteString -> IO BL.ByteString fromAuthGet _ (Right bs) = pure bs -- nice fromAuthGet name (Left err) = throwIO $ YesodOAuth2Exception.OAuth2Error name $ encode err -- | Throws a decoding error as an @'YesodOAuth2Exception'@ fromAuthJSON :: FromJSON a => Text -> BL.ByteString -> IO a fromAuthJSON name = either (throwIO . YesodOAuth2Exception.JSONDecodingError name) pure . eitherDecode -- | A tuple of @\"scope\"@ and the given scopes separated by a delimiter scopeParam :: Text -> [Text] -> (ByteString, ByteString) scopeParam d = ("scope", ) . encodeUtf8 . T.intercalate d -- brittany-disable-next-binding -- | Construct part of @'credsExtra'@ -- -- Always the following keys: -- -- - @accessToken@: to support follow-up requests -- - @userResponse@: to support getting additional information -- -- May set the following keys: -- -- - @refreshToken@: if the provider supports refreshing the @accessToken@ -- setExtra :: OAuth2Token -> BL.ByteString -> [(Text, Text)] setExtra token userResponse = [ ("accessToken", atoken $ accessToken token) , ("userResponse", decodeUtf8 $ BL.toStrict userResponse) ] <> maybe [] (pure . ("refreshToken", ) . rtoken) (refreshToken token) yesod-auth-oauth2-0.6.1.1/src/Yesod/Auth/OAuth2/Salesforce.hs0000644000000000000000000000455113240415367021636 0ustar0000000000000000{-# LANGUAGE OverloadedStrings #-} -- | -- -- OAuth2 plugin for http://login.salesforce.com -- -- * Authenticates against Salesforce (or sandbox) -- * Uses Salesforce user id as credentials identifier -- module Yesod.Auth.OAuth2.Salesforce ( oauth2Salesforce , oauth2SalesforceScoped , oauth2SalesforceSandbox , oauth2SalesforceSandboxScoped ) where import Yesod.Auth.OAuth2.Prelude newtype User = User Text instance FromJSON User where parseJSON = withObject "User" $ \o -> User <$> o .: "user_id" pluginName :: Text pluginName = "salesforce" defaultScopes :: [Text] defaultScopes = ["openid", "email", "api"] oauth2Salesforce :: YesodAuth m => Text -> Text -> AuthPlugin m oauth2Salesforce = oauth2SalesforceScoped defaultScopes oauth2SalesforceScoped :: YesodAuth m => [Text] -> Text -> Text -> AuthPlugin m oauth2SalesforceScoped = salesforceHelper pluginName "https://login.salesforce.com/services/oauth2/userinfo" "https://login.salesforce.com/services/oauth2/authorize" "https://login.salesforce.com/services/oauth2/token" oauth2SalesforceSandbox :: YesodAuth m => Text -> Text -> AuthPlugin m oauth2SalesforceSandbox = oauth2SalesforceSandboxScoped defaultScopes oauth2SalesforceSandboxScoped :: YesodAuth m => [Text] -> Text -> Text -> AuthPlugin m oauth2SalesforceSandboxScoped = salesforceHelper (pluginName <> "-sandbox") "https://test.salesforce.com/services/oauth2/userinfo" "https://test.salesforce.com/services/oauth2/authorize" "https://test.salesforce.com/services/oauth2/token" salesforceHelper :: YesodAuth m => Text -> URI -- ^ User profile -> URI -- ^ Authorize -> URI -- ^ Token -> [Text] -> Text -> Text -> AuthPlugin m salesforceHelper name profileUri authorizeUri tokenUri scopes clientId clientSecret = authOAuth2 name oauth2 $ \manager token -> do (User userId, userResponse) <- authGetProfile name manager token profileUri pure Creds { credsPlugin = pluginName , credsIdent = userId , credsExtra = setExtra token userResponse } where oauth2 = OAuth2 { oauthClientId = clientId , oauthClientSecret = clientSecret , oauthOAuthorizeEndpoint = authorizeUri `withQuery` [scopeParam " " scopes] , oauthAccessTokenEndpoint = tokenUri , oauthCallback = Nothing } yesod-auth-oauth2-0.6.1.1/src/Yesod/Auth/OAuth2/Slack.hs0000644000000000000000000000440313415466355020610 0ustar0000000000000000{-# LANGUAGE OverloadedStrings #-} -- | -- OAuth2 plugin for https://slack.com/ -- -- * Authenticates against slack -- * Uses slack user id as credentials identifier -- module Yesod.Auth.OAuth2.Slack ( SlackScope(..) , oauth2Slack , oauth2SlackScoped ) where import Yesod.Auth.OAuth2.Prelude import Network.HTTP.Client (httpLbs, parseUrlThrow, responseBody, setQueryString) import Yesod.Auth.OAuth2.Exception as YesodOAuth2Exception data SlackScope = SlackBasicScope | SlackEmailScope | SlackTeamScope | SlackAvatarScope scopeText :: SlackScope -> Text scopeText SlackBasicScope = "identity.basic" scopeText SlackEmailScope = "identity.email" scopeText SlackTeamScope = "identity.team" scopeText SlackAvatarScope = "identity.avatar" newtype User = User Text instance FromJSON User where parseJSON = withObject "User" $ \root -> do o <- root .: "user" User <$> o .: "id" pluginName :: Text pluginName = "slack" defaultScopes :: [SlackScope] defaultScopes = [SlackBasicScope] oauth2Slack :: YesodAuth m => Text -> Text -> AuthPlugin m oauth2Slack = oauth2SlackScoped defaultScopes oauth2SlackScoped :: YesodAuth m => [SlackScope] -> Text -> Text -> AuthPlugin m oauth2SlackScoped scopes clientId clientSecret = authOAuth2 pluginName oauth2 $ \manager token -> do let param = encodeUtf8 $ atoken $ accessToken token req <- setQueryString [("token", Just param)] <$> parseUrlThrow "https://slack.com/api/users.identity" userResponse <- responseBody <$> httpLbs req manager either (throwIO . YesodOAuth2Exception.JSONDecodingError pluginName) (\(User userId) -> pure Creds { credsPlugin = pluginName , credsIdent = userId , credsExtra = setExtra token userResponse } ) $ eitherDecode userResponse where oauth2 = OAuth2 { oauthClientId = clientId , oauthClientSecret = clientSecret , oauthOAuthorizeEndpoint = "https://slack.com/oauth/authorize" `withQuery` [scopeParam "," $ map scopeText scopes] , oauthAccessTokenEndpoint = "https://slack.com/api/oauth.access" , oauthCallback = Nothing } yesod-auth-oauth2-0.6.1.1/src/Yesod/Auth/OAuth2/Spotify.hs0000644000000000000000000000223213240415367021177 0ustar0000000000000000{-# LANGUAGE OverloadedStrings #-} -- | -- -- OAuth2 plugin for http://spotify.com -- module Yesod.Auth.OAuth2.Spotify ( oauth2Spotify ) where import Yesod.Auth.OAuth2.Prelude newtype User = User Text instance FromJSON User where parseJSON = withObject "User" $ \o -> User <$> o .: "id" pluginName :: Text pluginName = "spotify" oauth2Spotify :: YesodAuth m => [Text] -> Text -> Text -> AuthPlugin m oauth2Spotify scopes clientId clientSecret = authOAuth2 pluginName oauth2 $ \manager token -> do (User userId, userResponse) <- authGetProfile pluginName manager token "https://api.spotify.com/v1/me" pure Creds { credsPlugin = pluginName , credsIdent = userId , credsExtra = setExtra token userResponse } where oauth2 = OAuth2 { oauthClientId = clientId , oauthClientSecret = clientSecret , oauthOAuthorizeEndpoint = "https://accounts.spotify.com/authorize" `withQuery` [ scopeParam " " scopes ] , oauthAccessTokenEndpoint = "https://accounts.spotify.com/api/token" , oauthCallback = Nothing } yesod-auth-oauth2-0.6.1.1/src/Yesod/Auth/OAuth2/Upcase.hs0000644000000000000000000000234213240415367020764 0ustar0000000000000000{-# LANGUAGE OverloadedStrings #-} -- | -- -- OAuth2 plugin for http://upcase.com -- -- * Authenticates against upcase -- * Uses upcase user id as credentials identifier -- module Yesod.Auth.OAuth2.Upcase ( oauth2Upcase ) where import Yesod.Auth.OAuth2.Prelude import qualified Data.Text as T newtype User = User Int instance FromJSON User where parseJSON = withObject "User" $ \root -> do o <- root .: "user" User <$> o .: "id" pluginName :: Text pluginName = "upcase" oauth2Upcase :: YesodAuth m => Text -> Text -> AuthPlugin m oauth2Upcase clientId clientSecret = authOAuth2 pluginName oauth2 $ \manager token -> do (User userId, userResponse) <- authGetProfile pluginName manager token "http://upcase.com/api/v1/me.json" pure Creds { credsPlugin = pluginName , credsIdent = T.pack $ show userId , credsExtra = setExtra token userResponse } where oauth2 = OAuth2 { oauthClientId = clientId , oauthClientSecret = clientSecret , oauthOAuthorizeEndpoint = "http://upcase.com/oauth/authorize" , oauthAccessTokenEndpoint = "http://upcase.com/oauth/token" , oauthCallback = Nothing } yesod-auth-oauth2-0.6.1.1/example/Main.hs0000644000000000000000000001055613415466355016223 0ustar0000000000000000{-# LANGUAGE MultiParamTypeClasses #-} {-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE QuasiQuotes #-} {-# LANGUAGE RecordWildCards #-} {-# LANGUAGE TemplateHaskell #-} {-# LANGUAGE TypeApplications #-} {-# LANGUAGE TypeFamilies #-} -- | -- -- This single-file Yesod app uses all plugins defined within this site, as a -- means of manual verification that they work. When adding a new plugin, add -- usage of it here and verify locally that it works. -- -- To do so, see @.env.example@, then: -- -- > stack build --flag yesod-auth-oauth2:example -- > stack exec yesod-auth-oauth2-example -- > -- > $BROWSER http://localhost:3000 -- module Main where import Data.Aeson import Data.Aeson.Encode.Pretty import Data.ByteString.Lazy (fromStrict, toStrict) import qualified Data.Map as M import Data.Maybe (fromJust) import Data.Monoid ((<>)) import Data.Text (Text) import qualified Data.Text as T import Data.Text.Encoding (decodeUtf8) import LoadEnv import Network.HTTP.Conduit import Network.Wai.Handler.Warp (runEnv) import System.Environment (getEnv) import Yesod import Yesod.Auth import Yesod.Auth.OAuth2.BattleNet import Yesod.Auth.OAuth2.Bitbucket import Yesod.Auth.OAuth2.EveOnline import Yesod.Auth.OAuth2.GitHub import Yesod.Auth.OAuth2.GitLab import Yesod.Auth.OAuth2.Google import Yesod.Auth.OAuth2.Nylas import Yesod.Auth.OAuth2.Salesforce import Yesod.Auth.OAuth2.Slack import Yesod.Auth.OAuth2.Spotify import Yesod.Auth.OAuth2.Upcase data App = App { appHttpManager :: Manager , appAuthPlugins :: [AuthPlugin App] } mkYesod "App" [parseRoutes| / RootR GET /auth AuthR Auth getAuth |] instance Yesod App where -- see https://github.com/thoughtbot/yesod-auth-oauth2/issues/87 approot = ApprootStatic "http://localhost:3000" instance YesodAuth App where type AuthId App = Text loginDest _ = RootR logoutDest _ = RootR -- Disable any attempt to read persisted authenticated state maybeAuthId = return Nothing -- Copy the Creds response into the session for viewing after authenticate c = do mapM_ (uncurry setSession) $ [ ("credsIdent", credsIdent c) , ("credsPlugin", credsPlugin c) ] ++ credsExtra c return $ Authenticated "1" authPlugins = appAuthPlugins instance RenderMessage App FormMessage where renderMessage _ _ = defaultFormMessage getRootR :: Handler Html getRootR = do sess <- getSession let prettify = decodeUtf8 . toStrict . encodePretty . fromJust . decode @Value . fromStrict mCredsIdent = decodeUtf8 <$> M.lookup "credsIdent" sess mCredsPlugin = decodeUtf8 <$> M.lookup "credsPlugin" sess mAccessToken = decodeUtf8 <$> M.lookup "accessToken" sess mUserResponse = prettify <$> M.lookup "userResponse" sess defaultLayout [whamlet|

Yesod Auth OAuth2 Example

Log in

Credentials

Plugin / Ident

#{show mCredsPlugin} / #{show mCredsIdent}

Access Token

#{show mAccessToken}

User Response 
            $maybe userResponse <- mUserResponse
                #{userResponse}
    |]

mkFoundation :: IO App
mkFoundation = do
    loadEnv

    appHttpManager <- newManager tlsManagerSettings
    appAuthPlugins <- sequence
        -- When Providers are added, add them here and update .env.example.
        -- Nothing else should need changing.
        --
        -- FIXME: oauth2BattleNet is quite annoying!
        --
        [ loadPlugin (oauth2BattleNet [whamlet|TODO|] "en") "BATTLE_NET"
        , loadPlugin oauth2Bitbucket "BITBUCKET"
        , loadPlugin (oauth2Eve Plain) "EVE_ONLINE"
        , loadPlugin oauth2GitHub "GITHUB"
        , loadPlugin oauth2GitLab "GITLAB"
        , loadPlugin oauth2Google "GOOGLE"
        , loadPlugin oauth2Nylas "NYLAS"
        , loadPlugin oauth2Salesforce "SALES_FORCE"
        , loadPlugin oauth2Slack "SLACK"
        , loadPlugin (oauth2Spotify []) "SPOTIFY"
        , loadPlugin oauth2Upcase "UPCASE"
        ]

    return App{..}
  where
    loadPlugin f prefix = do
        clientId <- getEnv $ prefix <> "_CLIENT_ID"
        clientSecret <- getEnv $ prefix <> "_CLIENT_SECRET"
        pure $ f (T.pack clientId) (T.pack clientSecret)

main :: IO ()
main = runEnv 3000 =<< toWaiApp =<< mkFoundation
yesod-auth-oauth2-0.6.1.1/test/Spec.hs0000644000000000000000000000005413231632146015532 0ustar0000000000000000{-# OPTIONS_GHC -F -pgmF hspec-discover #-}
yesod-auth-oauth2-0.6.1.1/test/URI/ByteString/ExtensionSpec.hs0000644000000000000000000000563013231652614022167 0ustar0000000000000000{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE QuasiQuotes #-}
module URI.ByteString.ExtensionSpec
    ( spec
    ) where

import Test.Hspec

import Control.Exception (ErrorCall, evaluate)
import Data.List (isInfixOf)
import URI.ByteString
import URI.ByteString.Extension
import URI.ByteString.QQ

spec :: Spec
spec = do
    describe "IsString Scheme" $ it "works" $ do
        "https" `shouldBe` Scheme "https"

    describe "IsString Host" $ it "works" $ do
        "example.com" `shouldBe` Host "example.com"

    describe "IsString URIRef Relative" $ it "works" $ do
        "example.com/foo?bar=baz"
            `shouldBe` [relativeRef|example.com/foo?bar=baz|]

    describe "IsString URIRef Absolute" $ it "works" $ do
        "https://example.com/foo?bar=baz"
            `shouldBe` [uri|https://example.com/foo?bar=baz|]

    describe "fromText" $ do
        it "returns Just a URI for valid values, as the quasi-quoter would" $ do
            fromText "http://example.com/foo?bar=baz"
                `shouldBe` Just [uri|http://example.com/foo?bar=baz|]

        it "returns Nothing for invalid values" $ do
            fromText "Oh my, what did I do?" `shouldBe` Nothing

    describe "unsafeFromText" $ do
        it "returns a URI for valid values, as the quasi-quoter would" $ do
            unsafeFromText "http://example.com/foo?bar=baz"
                `shouldBe` [uri|http://example.com/foo?bar=baz|]

        it "raises for invalid values" $ do
            evaluate (unsafeFromText "Oh my, what did I do?")
                `shouldThrow` errorContaining "MissingColon"

    describe "toText" $ do
        it "serializes the URI to text" $ do
            toText [uri|https://example.com/foo?bar=baz|]
                `shouldBe` "https://example.com/foo?bar=baz"

    describe "fromRelative" $ do
        it "makes a URI absolute with a given host" $ do
            fromRelative "ftp" "foo.com" [relativeRef|/bar?baz=bat|]
                `shouldBe` [uri|ftp://foo.com/bar?baz=bat|]

    describe "withQuery" $ do
        it "appends a query to a URI" $ do
            let uriWithQuery = [uri|http://example.com|] `withQuery` [("foo", "bar")]

            uriWithQuery `shouldBe` [uri|http://example.com?foo=bar|]

        it "handles a URI with an existing query" $ do
            let uriWithQuery = [uri|http://example.com?foo=bar|] `withQuery` [("baz", "bat")]

            uriWithQuery `shouldBe` [uri|http://example.com?foo=bar&baz=bat|]

        -- This is arguably testing the internals of another package, but IMO
        -- it's worthwhile to show that you don't (and can't) pre-sanitize when
        -- using this function.
        it "handles santization of the query" $ do
            let uriWithQuery = [uri|http://example.com|] `withQuery` [("foo", "bar baz")]

            toText uriWithQuery `shouldBe` "http://example.com?foo=bar%20baz"

errorContaining :: String -> Selector ErrorCall
errorContaining msg = (msg `isInfixOf`) . show
yesod-auth-oauth2-0.6.1.1/LICENSE0000644000000000000000000000203713240415367014341 0ustar0000000000000000Copyright 2018 Patrick Brisbin

Permission is hereby granted, free of charge, to any person obtaining a copy of
this software and associated documentation files (the "Software"), to deal in
the Software without restriction, including without limitation the rights to
use, copy, modify, merge, publish, distribute, sublicense, and/or sell copies of
the Software, and to permit persons to whom the Software is furnished to do so,
subject to the following conditions:

The above copyright notice and this permission notice shall be included in all
copies or substantial portions of the Software.

THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR
IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY, FITNESS
FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE AUTHORS OR
COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER LIABILITY, WHETHER
IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM, OUT OF OR IN
CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE SOFTWARE.
yesod-auth-oauth2-0.6.1.1/Setup.lhs0000755000000000000000000000016213160317734015144 0ustar0000000000000000#!/usr/bin/env runhaskell

> module Main where
> import Distribution.Simple

> main :: IO ()
> main = defaultMain
yesod-auth-oauth2-0.6.1.1/yesod-auth-oauth2.cabal0000644000000000000000000000551313440745266017612 0ustar0000000000000000cabal-version: 1.12

-- This file has been generated from package.yaml by hpack version 0.31.1.
--
-- see: https://github.com/sol/hpack
--
-- hash: c1c011a70a950aa06a81581631093cff63155d27dfd919ee890ec488597e5bd0

name:           yesod-auth-oauth2
version:        0.6.1.1
synopsis:       OAuth 2.0 authentication plugins
description:    Library to authenticate with OAuth 2.0 for Yesod web applications.
category:       Web
homepage:       http://github.com/thoughtbot/yesod-auth-oauth2
bug-reports:    https://github.com/thoughtbot/yesod-auth-oauth2/issues
author:         Tom Streller
maintainer:     Pat Brisbin 
license:        MIT
license-file:   LICENSE
build-type:     Simple
extra-source-files:
    README.md
    CHANGELOG.md

source-repository head
  type: git
  location: https://github.com/thoughtbot/yesod-auth-oauth2

flag example
  description: Build the example application
  manual: False
  default: False

library
  hs-source-dirs:
      src
  ghc-options: -Wall
  build-depends:
      aeson >=0.6 && <1.5
    , base >=4.9.0.0 && <5
    , bytestring >=0.9.1.4
    , errors
    , hoauth2 >=1.3.0 && <1.9
    , http-client >=0.4.0 && <0.7
    , http-conduit >=2.0 && <3.0
    , http-types >=0.8 && <0.13
    , microlens
    , random
    , safe-exceptions
    , text >=0.7 && <2.0
    , uri-bytestring
    , yesod-auth >=1.6.0 && <1.7
    , yesod-core >=1.6.0 && <1.7
  exposed-modules:
      URI.ByteString.Extension
      Yesod.Auth.OAuth2
      Yesod.Auth.OAuth2.AzureAD
      Yesod.Auth.OAuth2.BattleNet
      Yesod.Auth.OAuth2.Bitbucket
      Yesod.Auth.OAuth2.Dispatch
      Yesod.Auth.OAuth2.ErrorResponse
      Yesod.Auth.OAuth2.EveOnline
      Yesod.Auth.OAuth2.Exception
      Yesod.Auth.OAuth2.GitHub
      Yesod.Auth.OAuth2.GitLab
      Yesod.Auth.OAuth2.Google
      Yesod.Auth.OAuth2.Nylas
      Yesod.Auth.OAuth2.Prelude
      Yesod.Auth.OAuth2.Salesforce
      Yesod.Auth.OAuth2.Slack
      Yesod.Auth.OAuth2.Spotify
      Yesod.Auth.OAuth2.Upcase
  other-modules:
      Paths_yesod_auth_oauth2
  default-language: Haskell2010

executable yesod-auth-oauth2-example
  main-is: Main.hs
  hs-source-dirs:
      example
  ghc-options: -Wall -threaded -rtsopts -with-rtsopts=-N
  build-depends:
      aeson
    , aeson-pretty
    , base >=4.9.0.0 && <5
    , bytestring
    , containers
    , http-conduit
    , load-env
    , text
    , warp
    , yesod
    , yesod-auth
    , yesod-auth-oauth2
  if !(flag(example))
    buildable: False
  other-modules:
      Paths_yesod_auth_oauth2
  default-language: Haskell2010

test-suite test
  type: exitcode-stdio-1.0
  main-is: Spec.hs
  hs-source-dirs:
      test
  ghc-options: -Wall
  build-depends:
      base >=4.9.0.0 && <5
    , hspec
    , uri-bytestring
    , yesod-auth-oauth2
  other-modules:
      URI.ByteString.ExtensionSpec
      Paths_yesod_auth_oauth2
  default-language: Haskell2010
yesod-auth-oauth2-0.6.1.1/README.md0000644000000000000000000000611313415466355014621 0ustar0000000000000000# Yesod.Auth.OAuth2

OAuth2 `AuthPlugin`s for Yesod.

## Usage

```hs
import Yesod.Auth
import Yesod.Auth.OAuth2.GitHub

instance YesodAuth App where
    -- ...

    authPlugins _ = [oauth2GitHub clientId clientSecret]

clientId :: Text
clientId = "..."

clientSecret :: Text
clientSecret = "..."
```

Some plugins, such as GitHub and Slack, have scoped functions for requesting
additional information:

```hs
oauth2SlackScoped [SlackBasicScope, SlackEmailScope] clientId clientSecret
```

## Working with Extra Data

We put the minimal amount of user data possible in `credsExtra` -- just enough
to support you parsing or fetching additional data yourself.

For example, if you work with GitHub and GitHub user profiles, you likely
already have a model and a way to parse the `/user` response. Rather than
duplicate all that in our library, we try to make it easy for you to re-use that
code yourself:

```hs
authenticate creds = do
    let
        -- You can run your own FromJSON parser on the response we already have
        eGitHubUser :: Either String GitHubUser
        eGitHubUser = getUserResponseJSON creds

        -- Avert your eyes, simplified example
        Just accessToken = getAccessToken creds
        Right githubUser = eGitHubUser

    -- Or make followup requests using our access token
    runGitHub accessToken $ userRepositories githubUser

    -- Or store it for later
    insert User
        { userIdent = credsIdent creds
        , userAccessToken = accessToken
        }
```

**NOTE**: Avoid looking up values in `credsExtra` yourself; prefer the provided
`get` functions. The data representation itself is no longer considered public
API.

## Local Providers

If we don't supply a "Provider" (e.g. GitHub, Google, etc) you need, you can
write your own using our provided `Prelude`:

```haskell
import Yesod.Auth.OAuth2.Prelude

pluginName :: Text
pluginName = "mysite"

oauth2MySite :: YesodAuth m => Text -> Text -> AuthPlugin m
oauth2MySite clientId clientSecret =
    authOAuth2 pluginName oauth2 $ \manager token -> do
        -- Fetch a profile using the manager and token, leave it a ByteString
        userResponse <- -- ...

        -- Parse it to your preferred identifier, e.g. with Data.Aeson
        userId <- -- ...

        -- See authGetProfile for the typical case

        pure Creds
            { credsPlugin = pluginName
            , credsIdent = userId
            , credsExtra = setExtra token userResponse
            }
  where
    oauth2 = OAuth2
        { oauthClientId = clientId
        , oauthClientSecret = clientSecret
        , oauthOAuthorizeEndpoint = "https://mysite.com/oauth/authorize"
        , oauthAccessTokenEndpoint = "https://mysite.com/oauth/token"
        , oauthCallback = Nothing
        }
```

The `Prelude` module is considered public API, though we may build something
higher-level that is more convenient for this use-case in the future.

## Development & Tests

```console
stack setup
stack build --dependencies-only
stack build --pedantic --test
```

Please also run HLint and Weeder before submitting PRs.

---

[CHANGELOG](./CHANGELOG.md) | [LICENSE](./LICENSE)
yesod-auth-oauth2-0.6.1.1/CHANGELOG.md0000644000000000000000000002031213440745253015143 0ustar0000000000000000## [*Unreleased*](https://github.com/thoughtbot/yesod-auth-oauth2/compare/v0.6.1.1...master)

None

## [v0.6.1.1](https://github.com/thoughtbot/yesod-auth-oauth2/compare/v0.6.1.0...v0.6.1.1)

- Added AzureAD provider
- COMPATIBILITY: Use `hoauth2-1.8.1`
- COMPATIBILITY: Test with GHC 8.6.3, and not 8.2

## [v0.6.1.0](https://github.com/thoughtbot/yesod-auth-oauth2/compare/v0.6.0.0...v0.6.1.0)

- Allow http-client-0.6

## [v0.6.0.0](https://github.com/thoughtbot/yesod-auth-oauth2/compare/v0.5.3.0...v0.6.0.0)

- Remove deprecated Github module

## [v0.5.3.0](https://github.com/thoughtbot/yesod-auth-oauth2/compare/v0.5.2.0...v0.5.3.0)

- Allow aeson-1.4 and hoauth2-1.8

## [v0.5.2.0](https://github.com/thoughtbot/yesod-auth-oauth2/compare/v0.5.1.0...v0.5.2.0)

- `InvalidProfileResponse` was replaced with different, situation-specific
  constructors; the exception type is considered internal API, but end-users may
  see them in logs, or if they (unexpectedly) escape our error-handling
- Errors during log-in no longer result in 4XX or 5XX responses; they now
  redirect to `LoginR` with the exception details logged and something
  user-appropriate displayed via `setMessage`

## [v0.5.1.0](https://github.com/thoughtbot/yesod-auth-oauth2/compare/v0.5.0.0...v0.5.1.0)

- Added GitLab provider
- Added properly-named `GitHub` module, deprecated `Github`
- Store `refreshToken` in `credsExtra`

## [v0.5.0.0](https://github.com/thoughtbot/yesod-auth-oauth2/compare/v0.4.1.0...v0.5.0.0)

- COMPATIBILITY: Allow and require yesod-1.6
- COMPATIBILITY: Stop testing GHC 8.0 on CI

## [v0.4.1.0](https://github.com/thoughtbot/yesod-auth-oauth2/compare/v0.4.0.1...v0.4.1.0)

- Check for `error`s in callback query params, as described in the
  [spec](https://tools.ietf.org/html/rfc6749#section-4.1.2.1)

## [v0.4.0.1](https://github.com/thoughtbot/yesod-auth-oauth2/compare/v0.4.0.0...v0.4.0.1)

- COMPATIBILITY: Allow `http-types-0.12`

## [v0.4.0.0](https://github.com/thoughtbot/yesod-auth-oauth2/compare/v0.3.1...v0.4.0.0)

- COMPATIBILITY: Allow `aeson-1.3`
- COMPATIBILITY: Dropped a lot of information from `credsExtra`:

  **TL;DR**: you'll no longer find things like `username` or `email` as keys in
  the `credsExtra` map. Instead, you'll find the encoded profile response we
  received and the OAuth access token. You can/should do your own decoding or
  make your own follow-up requests to get extra data about your users.

  This reduced a lot of complexity, likely duplication between our decoding and
  yours, and (I think) makes the library easier to use.

  - [Issue](https://github.com/thoughtbot/yesod-auth-oauth2/issues/71)
  - [PR](https://github.com/thoughtbot/yesod-auth-oauth2/pull/100)

- COMPATIBILITY: Support GHC-8.2
- COMPATIBILITY: Drop (claimed, but never tested) support for GHC-7.8 & 7.10
- LICENSE: fixed vague licensing (MIT now)

## [v0.3.1](https://github.com/thoughtbot/yesod-auth-oauth2/compare/v0.3.0...v0.3.1)

- Internal project cleanup

## [v0.3.0](https://github.com/thoughtbot/yesod-auth-oauth2/compare/v0.2.4...v0.3.0)

- COMPATIBILITY: Use `hoauth2-1.3`

## [v0.2.4](https://github.com/thoughtbot/yesod-auth-oauth2/compare/v0.2.1...v0.2.4)

- FIX: Update Nylas provider
- NEW: Battle.Net provider
- NEW: Bitbucket provider
- NEW: Salesforce provider

## [v0.2.1](https://github.com/thoughtbot/yesod-auth-oauth2/compare/v0.2.0...v0.2.1)

- FIX: Fix collision in GitHub `email` / `public_email` extras value

## [v0.2.0](https://github.com/thoughtbot/yesod-auth-oauth2/compare/v0.1.10...v0.2.0)

- NEW: Slack provider ([@jsteiner](https://github.com/thoughtbot/yesod-auth-oauth2/commit/aad8bd88eabf9fcf368d044e7003e5d323985837))

## [v0.1.10](https://github.com/thoughtbot/yesod-auth-oauth2/compare/v0.1.9...v0.1.10)

- FIX: `location` is optional in GitHub response

## [v0.1.9](https://github.com/thoughtbot/yesod-auth-oauth2/compare/v0.1.8...v0.1.9)

- COMPATIBILITY: Allow `transformers-0.5` ([@paul-rouse](https://github.com/thoughtbot/yesod-auth-oauth2/commit/120104b5348808f72877962c329a998434addace))

## [v0.1.8](https://github.com/thoughtbot/yesod-auth-oauth2/compare/v0.1.7...v0.1.8)

- COMPATIBILITY: Allow `aeson-0.11` ([@k-bx](https://github.com/thoughtbot/yesod-auth-oauth2/commit/6e940b19e2d56080c7a749aeb29e143a17dad65c))

## [v0.1.7](https://github.com/thoughtbot/yesod-auth-oauth2/compare/v0.1.6...v0.1.7)

- NEW: Prefer primary email in GitHub provider
- NEW: Include `public_email` in GitHub extras response
- REMOVED: Remove Twitter provider

## [v0.1.6](https://github.com/thoughtbot/yesod-auth-oauth2/compare/v0.1.5...v0.1.6)

- NEW: Nicer error message on invalid `code` ([@silky](https://github.com/thoughtbot/yesod-auth-oauth2/commit/7354c36e1326d298e543fa65cf226153ed4a8a0b))

## [v0.1.5](https://github.com/thoughtbot/yesod-auth-oauth2/compare/v0.1.4...v0.1.5)

- FIX: Incorrect `state` parameter handling

## [v0.1.4](https://github.com/thoughtbot/yesod-auth-oauth2/compare/v0.1.3...v0.1.4)

- FIX: Use newer Nylas endpoint

## [v0.1.3](https://github.com/thoughtbot/yesod-auth-oauth2/compare/v0.1.2...v0.1.3)

- NEW: EveOnline provider ([@Drezil](https://github.com/thoughtbot/yesod-auth-oauth2/pull/33))
- NEW: Nylas provider ([@bts](https://github.com/thoughtbot/yesod-auth-oauth2/commit/815d44346403af0052a48aa844f506211bdc2863))

## [v0.1.2](https://github.com/thoughtbot/yesod-auth-oauth2/compare/v0.1.1...v0.1.2)

- NEW: A more different Google provider ([@ssaavedra](https://github.com/thoughtbot/yesod-auth-oauth2/pull/32))

## [v0.1.1](https://github.com/thoughtbot/yesod-auth-oauth2/compare/v0.1.0...v0.1.1)

- NEW: Twitter provider

## [v0.1.0](https://github.com/thoughtbot/yesod-auth-oauth2/compare/v0.0.12...v0.1.0)

- REMOVED: Google provider, use `Yesod.Auth.GoogleEmail2`
- CHANGED: Learn was renamed to Upcase
- COMPATIBILITY: Drop support for GHC-6
- COMPATIBILITY: Support GHC-7.10

## [v0.0.12](https://github.com/thoughtbot/yesod-auth-oauth2/compare/v0.0.11...v0.0.12)

- COMPATIBILITY: Allow `transformers-0.4` ([@snoyberg](https://github.com/thoughtbot/yesod-auth-oauth2/pull/21))

## [v0.0.11](https://github.com/thoughtbot/yesod-auth-oauth2/compare/v0.0.10...v0.0.11)

- COMPATIBILITY: Allow `aeson-0.8` ([@gfontenot](https://github.com/thoughtbot/yesod-auth-oauth2/pull/15))

## [v0.0.10](https://github.com/thoughtbot/yesod-auth-oauth2/compare/v0.0.9...v0.0.10)

- COMPATIBILITY: Allow Yesod 1.4 ([@gregwebs](https://github.com/thoughtbot/yesod-auth-oauth2/pull/14))

## [v0.0.9](https://github.com/thoughtbot/yesod-auth-oauth2/compare/v0.0.8...v0.0.9)

- NEW: Spotify ([@benekastah](https://github.com/thoughtbot/yesod-auth-oauth2/pull/13))

## [v0.0.8](https://github.com/thoughtbot/yesod-auth-oauth2/compare/v0.0.7...v0.0.8)

- FIX: Username may be missing in GitHub responses ([@skade](https://github.com/thoughtbot/yesod-auth-oauth2/pull/12))

## [v0.0.7](https://github.com/thoughtbot/yesod-auth-oauth2/compare/v0.0.6...v0.0.7)

- NEW: Scope support in GitHub provider ([@skade](https://github.com/thoughtbot/yesod-auth-oauth2/pull/11))

## [v0.0.6](https://github.com/thoughtbot/yesod-auth-oauth2/compare/v0.0.5.1...v0.0.6)

- NEW: GitHub provider ([@freiric](https://github.com/thoughtbot/yesod-auth-oauth2/pull/10))
- COMPATIBILITY: flag-driven `network`/`network-uri` dependency

## [v0.0.5.1](https://github.com/thoughtbot/yesod-auth-oauth2/compare/v0.0.5...v0.0.5.1)

- DOCUMENTATION: fix data declaration, allows Haddocks to build

## [v0.0.5](https://github.com/thoughtbot/yesod-auth-oauth2/compare/v0.0.4...v0.0.5)

- COMPATIBILITY: Allow `yesod-core-1.3` and target `yesod-auth-1.3` ([@maxcan](https://github.com/thoughtbot/yesod-auth-oauth2/pull/7))
- COMPATIBILITY: Target `haouth2-0.4` ([@katyo](https://github.com/thoughtbot/yesod-auth-oauth2/pull/9))

## [v0.0.4](https://github.com/thoughtbot/yesod-auth-oauth2/compare/v0.0.3...v0.0.4)

- COMPATIBILITY: Allow `text-1.*`
- COMPATIBILITY: Allow `lifted-base-0.2.*`

## [v0.0.3](https://github.com/thoughtbot/yesod-auth-oauth2/compare/v0.0.2...v0.0.3)

- FIX: replace `error` crash with `throwIO` exception

## [v0.0.2](https://github.com/thoughtbot/yesod-auth-oauth2/compare/v0.0.1...v0.0.2)

- Various documentation fixes.

## [v0.0.1](https://github.com/thoughtbot/yesod-auth-oauth2/tree/v0.0.1)

Initial version. Maintainer-ship taken over by
[@pbrisbin](https://github.com/thoughtbot/yesod-auth-oauth2/pull/1).