ms-auth 0.1.0.0 → 0.2.0.0
raw patch · 3 files changed
+54/−21 lines, 3 files
Files
- README.md +30/−2
- ms-auth.cabal +2/−2
- src/Network/OAuth2/Session.hs +22/−17
README.md view
@@ -1,5 +1,33 @@ # ms-auth -[](https://travis-ci.org/githubuser/ms-auth)+Haskell client bindings to the [Microsoft Identity / Active Directory API]().+ +[](https://hackage.haskell.org/package/ms-auth) -TODO Description.++++## Introduction++This library provides helpers for building token-based authentication flows within server-based web apps e.g. ++* [Client Credentials](https://learn.microsoft.com/en-us/azure/active-directory/develop/v2-oauth2-client-creds-grant-flow) (server/server or automation accounts)+* [Authorization Code](https://learn.microsoft.com/en-us/azure/active-directory/develop/v2-oauth2-auth-code-flow) (with human users being prompted to delegate some access rights to the app)++, as well as for keeping tokens up to date in the background.+++## Status++This library is functional but still in development.++## Evolution of the library++Some breaking changes might also be introduced as the library matures.++We adhere to a simplified version of the [Package Versioning Policy](https://pvp.haskell.org/): breaking changes are signaled by increasing the major version number (e.g. 0.x -> 1.x ).+++## Copyright++(c) 2023-, Marco Zocca, UnfoldML AB
ms-auth.cabal view
@@ -1,8 +1,8 @@ name: ms-auth-version: 0.1.0.0+version: 0.2.0.0 synopsis: Microsoft Authentication API description: Bindings to the Microsoft Identity API / Active Directory (AD) for building applications that use either Delegated or App-only permissions. Helper functions are provided for building OAuth2 authentication flows and keep tokens transactionally secure and up to date.-homepage: https://github.com/unfoldml/ms-auth+homepage: https://github.com/unfoldml/ms-api license: BSD3 license-file: LICENSE author: Marco Zocca
src/Network/OAuth2/Session.hs view
@@ -5,17 +5,21 @@ {-# options_ghc -Wno-unused-imports #-} -- | MS Identity user session based on OAuth tokens ----- provides both Delegated permission flow (user-based) and App-only (e.g. server-server and automation accounts)+-- The library supports the following authentication scenarios :+--+-- * [Client Credentials](https://learn.microsoft.com/en-us/azure/active-directory/develop/v2-oauth2-client-creds-grant-flow) (server/server or automation accounts)+--+-- * [Authorization Code](https://learn.microsoft.com/en-us/azure/active-directory/develop/v2-oauth2-auth-code-flow) (with human users being prompted to delegate some access rights to the app)+--+-- and provides functions to keep tokens up to date in the background. module Network.OAuth2.Session (- -- * Azure App Service- withAADUser -- * App-only flow- , Token+ Token , newNoToken , expireToken , readToken , fetchUpdateToken- -- * Delegated permissions flow+ -- * Auth code grant flow -- ** OAuth endpoints , loginEndpoint , replyEndpoint@@ -27,6 +31,8 @@ , expireUser , tokensToList -- * Scotty misc+ -- ** Azure App Service+ , withAADUser , Scotty , Action ) where@@ -132,13 +138,12 @@ -- * App-only authorization scenarios (i.e via automation accounts. Human users not involved) ---- app has one token at a time+-- | App has (at most) one token at a time type Token t = TVar (Maybe t) newNoToken :: MonadIO m => m (Token t) newNoToken = newTVarIO Nothing-expireToken :: MonadIO m => TVar (Maybe a) -> m ()+expireToken :: MonadIO m => Token t -> m () expireToken ts = atomically $ modifyTVar ts (const Nothing) readToken :: MonadIO m => Token t -> m (Maybe t) readToken ts = atomically $ readTVar ts@@ -150,7 +155,7 @@ -- https://learn.microsoft.com/en-us/azure/active-directory/develop/v2-oauth2-client-creds-grant-flow fetchUpdateToken :: MonadIO m => IdpApplication 'ClientCredentials AzureAD- -> Token OAuth2Token+ -> Token OAuth2Token -- ^ token TVar -> Manager -> m () fetchUpdateToken idpApp ts mgr = liftIO $ void $ forkFinally loop cleanup@@ -181,7 +186,7 @@ --- * Delegated permission flow (i.e. human user involved)+-- * Auth code grant flow (i.e. human user involved) -- | Login endpoint --@@ -205,7 +210,7 @@ -- NB : forks a thread per logged in user to keep their tokens up to date replyEndpoint :: MonadIO m => IdpApplication 'AuthorizationCode AzureAD- -> Tokens UserSub OAuth2Token+ -> Tokens UserSub OAuth2Token -- ^ token TVar -> Manager -> RoutePattern -- ^ e.g. @"/oauth\/reply"@ -> Scotty m ()@@ -224,7 +229,7 @@ Just codeP -> do let etoken = ExchangeToken $ TL.toStrict codeP- _ <- fetchUpdateTokenDeleg ts idpApp mgr etoken+ _ <- fetchUpdateTokenACG ts idpApp mgr etoken pure () Nothing -> throwE OASEExchangeTokenNotFound @@ -239,13 +244,13 @@ -- | 1) the ExchangeToken arrives with the redirect once the user has approved the scopes in the browser -- https://learn.microsoft.com/en-us/graph/auth-v2-user?view=graph-rest-1.0&tabs=http#authorization-response-fetchUpdateTokenDeleg :: MonadIO m =>+fetchUpdateTokenACG :: MonadIO m => Tokens UserSub OAuth2Token -> IdpApplication 'AuthorizationCode AzureAD -> Manager -> ExchangeToken -- ^ also called 'code'. Expires in 10 minutes -> ExceptT OAuthSessionError m OAuth2Token-fetchUpdateTokenDeleg ts idpApp mgr etoken = ExceptT $ do+fetchUpdateTokenACG ts idpApp mgr etoken = ExceptT $ do tokenResp <- runExceptT $ conduitTokenRequest idpApp mgr etoken -- OAuth2 token case tokenResp of Right oat -> case idToken oat of@@ -254,20 +259,20 @@ idtClaimsE <- decValidIdToken idt -- decode and validate ID token case idtClaimsE of Right uid -> do- _ <- refreshLoopDeleg ts idpApp mgr uid oat -- fork a thread and start refresh loop for this user+ _ <- refreshLoopACG ts idpApp mgr uid oat -- fork a thread and start refresh loop for this user pure $ Right oat Left es -> pure $ Left (OASEJWTException es) -- id token validation failed Left es -> pure $ Left (OASEOAuth2Errors es) -- | 2) fork a thread and start token refresh loop for user @uid@-refreshLoopDeleg :: (MonadIO m, Ord uid, HasRefreshTokenRequest a) =>+refreshLoopACG :: (MonadIO m, Ord uid, HasRefreshTokenRequest a) => Tokens uid OAuth2Token -> IdpApplication a i -> Manager -> uid -- ^ user ID -> OAuth2Token -> m ThreadId-refreshLoopDeleg ts idpApp mgr uid oaToken = liftIO $ forkFinally (act oaToken) cleanup+refreshLoopACG ts idpApp mgr uid oaToken = liftIO $ forkFinally (act oaToken) cleanup where cleanup = \case Left _ -> do