yesod-auth-oidc 0.1.0 → 0.1.1
raw patch · 3 files changed
+88/−77 lines, 3 filesdep ~aesondep ~base64-bytestringdep ~containersnew-uploader
Dependency ranges changed: aeson, base64-bytestring, containers, cryptonite, fast-logger, hspec, http-client, lens, memory, persistent, persistent-sqlite, yesod-form
Files
- src/Yesod/Auth/OIDC.hs +41/−35
- test/ExampleApp.hs +32/−29
- yesod-auth-oidc.cabal +15/−13
src/Yesod/Auth/OIDC.hs view
@@ -60,8 +60,8 @@ import qualified "cryptonite" Crypto.Random as Crypto import qualified Data.Aeson as J import qualified Data.ByteString.Base64.URL as Base64Url-import qualified Data.HashMap.Strict as HM-import qualified Data.HashSet as HashSet+import qualified Data.Aeson.KeyMap as HM+import qualified Data.Set as HashSet import qualified Data.Text as T import Data.Time.Clock import Data.Time.Clock.POSIX@@ -71,6 +71,7 @@ import Web.OIDC.Client.Settings import qualified Web.OIDC.Client.Types as Scopes import Yesod.Auth+import qualified Data.Aeson.Key as Aes -- For re-export for mocking: import Jose.Jwa (JwsAlg(..))@@ -88,7 +89,7 @@ instance Exception YesodAuthOIDCException -- | Add this value to your YesodAuth instance's 'authPlugins' list-authOIDC :: YesodAuthOIDC site => AuthPlugin site+authOIDC :: forall site . YesodAuthOIDC site => AuthPlugin site authOIDC = AuthPlugin oidcPluginName dispatch loginW -- | The login hint is sent as the `login_hint` query parameter to the@@ -119,7 +120,7 @@ -- | (Optional) A callback to your app in case oidcForwardR is -- called without the login_hint query parameter. Default -- implementation throws a 'BadLoginHint' exception.- onBadLoginHint :: AuthHandler site TypedContent+ onBadLoginHint :: MonadAuthHandler site m => m TypedContent onBadLoginHint = throwIO BadLoginHint -- | Looks up configuration. If none can be found, you should handle@@ -137,8 +138,8 @@ -- -- Note that the 'Provider' is both the configuration and the result of -- retrieving the keyset from jwks_uri.- getProviderConfig ::- LoginHint -> AuthHandler site (Either Provider IssuerLocation, ClientId)+ getProviderConfig :: MonadAuthHandler site m =>+ LoginHint -> m (Either Provider IssuerLocation, ClientId) -- | (Optional). If the tenant is configured via a discovery URL, -- this function will be called with the discovered result and that@@ -147,8 +148,8 @@ -- library combines discovery with key retrieval, the given time is -- the minimum of the two remaining cache lifetimes returned by both -- http requests.- onProviderConfigDiscovered ::- Provider -> ClientId -> DiffTime -> AuthHandler site ()+ onProviderConfigDiscovered :: MonadAuthHandler site m =>+ Provider -> ClientId -> DiffTime -> m () onProviderConfigDiscovered _ _ _ = pure () -- | (Optional). Do something if the 'oidcCallbackR' was called with@@ -158,12 +159,12 @@ -- `code` query or post parameters. -- -- Defaults to a simple page showing the error (sans the error_uri).- onBadCallbackRequest ::+ onBadCallbackRequest :: MonadAuthHandler site m => Maybe OAuthErrorResponse -- ^ The OAuth Error Response if present (See RFC6749 §5.2 and -- OIDC §3.1.2.6). This will only be 'Just' if the "state" param -- (anti-CSRF token) is valid.- -> AuthHandler site a+ -> m a onBadCallbackRequest mError = do errHtml <- authLayout $ toWidget widg sendResponseStatus status400 errHtml@@ -184,19 +185,19 @@ -- | The printable-ASCII client_secret which you've set up with the -- provider ahead of time (this library does not support the dynamic -- registration spec).- getClientSecret :: ClientId -> Configuration -> AuthHandler site ClientSecret+ getClientSecret :: MonadAuthHandler site m => ClientId -> Configuration -> m ClientSecret -- | (Optional). The scopes that you are requesting. The "openid" -- scope will always be included in the eventual request whether or -- not you specify it here. Defaults to ["email"].- getScopes :: ClientId -> Configuration -> AuthHandler site [ScopeValue]+ getScopes :: MonadAuthHandler site m => ClientId -> Configuration -> m [ScopeValue] getScopes _ _ = pure [email] -- | (Optional). Configure the behaviour of when to request user -- information. The default behaviour is to only make this request -- if it's necessary satisfy the scopes in 'getScopes'.- getUserInfoPreference ::- LoginHint -> ClientId -> Configuration -> AuthHandler site UserInfoPreference+ getUserInfoPreference :: MonadAuthHandler site m =>+ LoginHint -> ClientId -> Configuration -> m UserInfoPreference getUserInfoPreference _ _ _ = pure GetUserInfoOnlyToSatisfyRequestedScopes -- | (Required). Should return a unique identifier for this user to@@ -208,7 +209,7 @@ -- If you are using the underlying OAuth spec for non-OIDC reasons, -- you can do extra work here, such as storing the access and -- refresh tokens.- onSuccessfulAuthentication ::+ onSuccessfulAuthentication :: MonadAuthHandler site m => LoginHint -- ^ *Warning*: This is original login hint (typically an email), -- does *not* assert anything about the user's identity. The user@@ -228,7 +229,7 @@ -- actually successful. For flexibility, any exceptions in the -- course of getting the UserInfo are caught by this library; -- such errors only manifest as an unexpected 'Nothing' here.- -> AuthHandler site Text+ -> m Text -- | Defaults to clearing the credentials from the session and -- redirecting to the site's logoutDest (if not currently there@@ -241,7 +242,7 @@ -- the HttpManager (as opposed to a lower-level mock of the 3 HTTP -- responses themselves). getHttpManagerForOidc ::- AuthHandler site (Either MockOidcProvider HTTP.Manager)+ MonadAuthHandler site m => m (Either MockOidcProvider HTTP.Manager) data MockOidcProvider = MockOidcProvider { mopDiscover :: Text -> Provider@@ -294,8 +295,8 @@ oidcCallbackR :: AuthRoute oidcCallbackR = PluginR oidcPluginName ["callback"] -dispatch :: forall site. YesodAuthOIDC site- => Text -> [Text] -> AuthHandler site TypedContent+dispatch :: forall site . (YesodAuthOIDC site)+ => Text -> [Text] -> (forall m . MonadAuthHandler site m => m TypedContent) dispatch httpMethod uriPath = case (httpMethod, uriPath) of ("GET", ["login"]) -> if enableLoginPage @site then getLoginR else notFound ("POST", ["forward"]) -> postForwardR@@ -321,13 +322,13 @@ <button type=submit aria-label="Sign in"> |] -getLoginR :: YesodAuthOIDC site => AuthHandler site TypedContent+getLoginR :: YesodAuthOIDC site => MonadAuthHandler site m => m TypedContent getLoginR = do rtp <- getRouteToParent selectRep . provideRep . authLayout $ toWidget $ loginW rtp -findProvider :: YesodAuthOIDC site- => LoginHint -> AuthHandler site (Provider, ClientId)+findProvider :: MonadAuthHandler site m => YesodAuthOIDC site+ => LoginHint -> m (Provider, ClientId) findProvider loginHint = getProviderConfig loginHint >>= \case (Left provider, clientId) -> pure (provider, clientId)@@ -344,8 +345,8 @@ pure (provider, clientId) -- | Expects 'email' and '_token' post params.-postForwardR :: YesodAuthOIDC site- => AuthHandler site TypedContent+postForwardR :: (YesodAuthOIDC site, MonadAuthHandler site m)+ => m TypedContent postForwardR = do checkCsrfParamNamed defaultCsrfParamName mLoginHint <- lookupPostParam "email"@@ -375,7 +376,7 @@ -- and take a `SessionStore m` argument. Handlers in Yesod do not -- implement MonadCatch, so we use m ~ IO, and then unliftIO to still -- use Handler calls in the 'SessionStore IO'-makeSessionStore :: AuthHandler site (SessionStore IO)+makeSessionStore :: MonadAuthHandler site m => m (SessionStore IO) makeSessionStore = do UnliftIO unlift <- askUnliftIO pure $ SessionStore@@ -398,11 +399,11 @@ instance Show ClientSecret where show _ = "<redacted-client-secret>" -makeOIDC ::+makeOIDC :: MonadAuthHandler site m => Provider -> ClientId -> ClientSecret- -> AuthHandler site OIDC+ -> m OIDC makeOIDC provider (ClientId clientId) (ClientSecret clientSecret) = do urlRender <- getUrlRender toParent <- getRouteToParent@@ -453,8 +454,8 @@ , oaeErrorUri :: Maybe Text } deriving Show -asTrustedState :: YesodAuthOIDC site- => SessionStore IO -> [Text] -> AuthHandler site Text+asTrustedState :: (YesodAuthOIDC site, MonadAuthHandler site m)+ => SessionStore IO -> [Text] -> m Text asTrustedState sessionStore = \case [untrustedState] -> do (mState, _) <- liftIO $ sessionStoreGet sessionStore@@ -463,8 +464,8 @@ else pure untrustedState _ -> onBadCallbackRequest Nothing -processCallbackInput :: YesodAuthOIDC site- => StdMethod -> SessionStore IO -> AuthHandler site CallbackInput+processCallbackInput :: (YesodAuthOIDC site, MonadAuthHandler site m)+ => StdMethod -> SessionStore IO -> m CallbackInput processCallbackInput reqMethod sessionStore = do validState <- params "state" >>= asTrustedState sessionStore codes <- params "code"@@ -484,11 +485,14 @@ then lookupGetParams else lookupPostParams +keySet :: J.Object -> Set Text+keySet = HashSet.fromList . fmap Aes.toText . HM.keys+ -- Providers may use GET or POST for the callback, so we -- handle both cases in this function handleCallback ::- YesodAuthOIDC site- => StdMethod -> AuthHandler site TypedContent+ (YesodAuthOIDC site, MonadAuthHandler site m)+ => StdMethod -> m TypedContent handleCallback reqMethod = do loginHint <- lookupSession loginHintSessionKey >>= maybe (onBadCallbackRequest Nothing) pure@@ -508,8 +512,10 @@ userInfoPref <- getUserInfoPreference loginHint clientId (configuration provider) requestedClaims <- HashSet.delete Scopes.openId . HashSet.fromList <$> getScopes clientId (configuration provider)- let missingClaims = requestedClaims- `HashSet.difference` HM.keysSet (otherClaims $ idToken tokens)+ let+ missingClaims :: Set Text+ missingClaims = requestedClaims+ `HashSet.difference` keySet (otherClaims $ idToken tokens) mUserInfo <- case (userInfoPref, userinfoEndpoint $ configuration provider) of (GetUserInfoIfAvailable, Just uri) -> liftIO $ handleAny (const (pure Nothing)) $ requestUserInfo eMgr tokens uri
test/ExampleApp.hs view
@@ -20,7 +20,7 @@ import ClassyPrelude.Yesod import qualified Data.Aeson as J-import qualified Data.HashMap.Strict as HM+import qualified Data.Aeson.KeyMap as HM import qualified Data.Text as T import Database.Persist.Sql import ExampleProviderOpts@@ -36,28 +36,7 @@ , appBrochClientId :: ClientId } -mkYesod "App" [parseRoutes|-/ HomeR GET-/auth AuthR Auth getAuth-/convenient-test-token CsrfTokenR GET-/protected/resource ProtectedResourceR GET-|] -getHomeR :: Handler ()-getHomeR = pure ()--getCsrfTokenR :: Handler Text-getCsrfTokenR = do- setCsrfCookie- reqToken <$> getRequest >>= \case- Nothing -> error "app unexpectedly started without session storage"- Just t -> pure t--getProtectedResourceR :: Handler J.Value-getProtectedResourceR = do- uid <- requireAuthId- pure $ J.String $ tshow uid- share [mkPersist sqlSettings, mkMigrate "migrateAll"] [persistLowerCase| OidcConfig clientId Text@@ -90,14 +69,14 @@ deriving Show |] -instance Yesod App where--instance YesodPersist App where- type YesodPersistBackend App = SqlBackend-- runDB :: SqlPersistT Handler a -> Handler a- runDB db = getsYesod appConnPool >>= runSqlPool db+mkYesod "App" [parseRoutes|+/ HomeR GET+/auth AuthR Auth getAuth+/convenient-test-token CsrfTokenR GET+/protected/resource ProtectedResourceR GET+|] +instance Yesod App where instance YesodAuth App where type AuthId App = Key User loginDest _ = HomeR@@ -105,6 +84,30 @@ authPlugins _ = [ authOIDC ] getAuthId = return . fromPathPiece . credsIdent maybeAuthId = defaultMaybeAuthId+++getHomeR :: Handler ()+getHomeR = pure ()++getCsrfTokenR :: Handler Text+getCsrfTokenR = do+ setCsrfCookie+ reqToken <$> getRequest >>= \case+ Nothing -> error "app unexpectedly started without session storage"+ Just t -> pure t++getProtectedResourceR :: Handler J.Value+getProtectedResourceR = do+ uid <- requireAuthId+ pure $ J.String $ tshow uid+++instance YesodPersist App where+ type YesodPersistBackend App = SqlBackend++ runDB :: SqlPersistT Handler a -> Handler a+ runDB db = getsYesod appConnPool >>= runSqlPool db+ addProvider :: ( PersistStoreWrite (YesodPersistBackend (HandlerSite f))
yesod-auth-oidc.cabal view
@@ -1,6 +1,6 @@ cabal-version: 2.2 name: yesod-auth-oidc-version: 0.1.0+version: 0.1.1 build-type: Simple category: Web, Yesod extra-source-files: README.md@@ -32,16 +32,16 @@ -Wcpp-undef -Wimplicit-prelude -fwarn-tabs build-depends: base >=4.9.1.0 && <5,- aeson >= 1.5.6 && < 1.6,+ aeson >= 2.0.0.0 && < 3.0, text >= 1.2.4 && < 1.3, time >= 1.9.3 && < 1.10, unordered-containers >= 0.2.13 && < 0.3,- base64-bytestring >= 1.1.0 && < 1.2,+ base64-bytestring >= 1.1.0 && < 1.3, classy-prelude-yesod >= 1.5.0 && < 1.6, - cryptonite >= 0.28 && < 0.29,+ cryptonite >= 0.28 && < 1, - http-client >= 0.6.4 && < 0.7,+ http-client >= 0.6.4 && < 1, jose-jwt >= 0.9.2 && < 0.10, oidc-client >= 0.6.0 && < 0.7,@@ -49,9 +49,11 @@ shakespeare >= 2.0.25 && < 2.1, yesod-core >= 1.6.19 && < 1.7,- yesod-form >= 1.6.7 && < 1.7,- yesod-auth >= 1.6.10 && < 1.7+ yesod-form >= 1.6.7 && < 2.0,+ yesod-auth >= 1.6.10 && < 1.7,+ containers + library import: common-options hs-source-dirs: src@@ -78,11 +80,11 @@ http-conduit >= 2.3.8 && < 2.4, http-client, http-types >= 0.12.3 && < 0.13,- memory >= 0.15.0 && < 0.16,+ memory >= 0.15.0 && < 1, cryptonite,- persistent >= 2.11.0 && <= 2.13.2,+ persistent >= 2.11.0 && <= 3.0.0, blaze-html >= 0.9.1 && < 0.10,- fast-logger >= 3.0.5 && < 3.1,+ fast-logger >= 3.0.5 && < 4.0, monad-logger >= 0.3.36 && < 0.4, resource-pool >= 0.2.3 && < 0.3, yesod >= 1.6.1 && < 1.7,@@ -101,10 +103,10 @@ postgresql-simple >= 0.6.4 && < 0.7, reroute >= 0.6.0 && < 0.7, sqlite-simple >= 0.4.18 && < 0.5,- hspec >= 2.7.10 && < 2.8,- lens >= 4.19.2 && < 4.20,+ hspec >= 2.7.10 && < 3.0,+ lens >= 4.19.2 && < 6.0, lens-regex-pcre >= 1.1.0 && < 1.2,- persistent-sqlite >= 2.11.1 && <= 2.13,+ persistent-sqlite >= 2.11.1 && <= 3.0, yesod-test >= 1.6.12 && < 1.7 Other-Modules: