add app-only flow

.github/workflows/haskell.yml

@@ -28,10 +28,10 @@ jobs:
       - name: (ms-azure-api) Setup compiler, build and test
         working-directory: ./ms-azure-api
         run: |
-          stack build --resolver ${{ matrix.stack-resolver }}
+          stack build --no-install-ghc
           stack test
       - name: (ms-auth) Setup compiler, build and test
         working-directory: ./ms-auth
         run: |
-          stack build --resolver ${{ matrix.stack-resolver }}
+          stack build --no-install-ghc
           stack test

ms-auth/CHANGELOG.md

@@ -8,4 +8,6 @@ and this project adheres to the
 
 ## Unreleased
 
-## 0.1.0.0 - YYYY-MM-DD
+## 0.1.0.0
+
+Network.OAuth2.Session : Add App-only functionality

ms-auth/src/Network/OAuth2/Provider/AzureAD.hs

@@ -5,11 +5,14 @@
 {-# LANGUAGE DuplicateRecordFields #-}
 {-# options_ghc -Wno-ambiguous-fields #-}
 module Network.OAuth2.Provider.AzureAD (
-  -- * OAuth2 configuration
-  OAuthCfg(..)
-  , AzureAD
+    AzureAD
+    -- * App flow
+    , azureADApp
+  -- * OAuth2 flow
+  , OAuthCfg(..)
   , AzureADUser
-  , azureADApp) where
+  , azureOAuthADApp
+  ) where
 
 -- import Data.String (IsString(..))
 -- import GHC.Generics
@@ -32,6 +35,36 @@ import URI.ByteString.QQ (uri)
 
 data AzureAD = AzureAD deriving (Eq, Show)
 
+
+-- * App-only flow
+
+-- | create app at https://go.microsoft.com/fwlink/?linkid=2083908
+--
+-- also be aware to find the right client id.
+-- see https://stackoverflow.com/a/70670961
+azureADApp :: TL.Text -> ClientId -> ClientSecret -> [Scope] -> IdpApplication 'ClientCredentials AzureAD
+azureADApp appname clid sec scopes = defaultAzureADApp{
+  idpAppName = appname
+  , idpAppClientId = clid
+  , idpAppClientSecret = sec
+  , idpAppScope = Set.fromList (scopes <> ["offline_access"])
+  }
+
+defaultAzureADApp :: IdpApplication 'ClientCredentials AzureAD
+defaultAzureADApp =
+  ClientCredentialsIDPAppConfig
+    { idpAppClientId = ""
+    , idpAppClientSecret = ""
+    , idpAppScope = Set.fromList ["openid", "offline_access", "profile", "email"] -- https://learn.microsoft.com/EN-US/azure/active-directory/develop/scopes-oidc#openid-connect-scopes
+    , idpAppTokenRequestExtraParams = Map.empty
+    , idpAppName = "default-azure-app" --
+    , idp = defaultAzureADIdp
+    }
+
+
+-- * OAuth flow
+
+
 type instance IdpUserInfo AzureAD = AzureADUser
 
 -- | Configuration object of the OAuth2 application
@@ -44,12 +77,19 @@ data OAuthCfg = OAuthCfg {
   , oacRedirectURI :: URI -- ^ OAuth2 redirect URI
                          }
 
--- | NB : scopes @openid@ and @offline_access@ are ALWAYS requested since the library assumes we have access to refresh tokens and ID tokens
+-- | Azure OAuth application (i.e. with user consent screen)
+--
+-- NB : scopes @openid@ and @offline_access@ are ALWAYS requested since the library assumes we have access to refresh tokens and ID tokens
 --
 -- Reference on Microsoft Graph permissions : https://learn.microsoft.com/en-us/graph/permissions-reference
-azureADApp :: OAuthCfg -- ^ OAuth configuration
-           -> IdpApplication 'AuthorizationCode AzureAD
-azureADApp (OAuthCfg appname clid sec scopes authstate reduri) = defaultAzureADApp{
+--
+-- | create app at https://go.microsoft.com/fwlink/?linkid=2083908
+--
+-- also be aware to find the right client id.
+-- see https://stackoverflow.com/a/70670961
+azureOAuthADApp :: OAuthCfg -- ^ OAuth configuration
+                -> IdpApplication 'AuthorizationCode AzureAD
+azureOAuthADApp (OAuthCfg appname clid sec scopes authstate reduri) = defaultAzureOAuthADApp{
   idpAppName = appname
   , idpAppClientId = clid
   , idpAppClientSecret = sec
@@ -58,12 +98,8 @@ azureADApp (OAuthCfg appname clid sec scopes authstate reduri) = defaultAzureADA
   , idpAppRedirectUri = reduri
   }
 
--- create app at https://go.microsoft.com/fwlink/?linkid=2083908
---
--- also be aware to find the right client id.
--- see https://stackoverflow.com/a/70670961
-defaultAzureADApp :: IdpApplication 'AuthorizationCode AzureAD
-defaultAzureADApp =
+defaultAzureOAuthADApp :: IdpApplication 'AuthorizationCode AzureAD
+defaultAzureOAuthADApp =
   AuthorizationCodeIdpApplication
     { idpAppClientId = ""
     , idpAppClientSecret = ""

ms-auth/src/Network/OAuth2/Session.hs

@@ -1,16 +1,25 @@
 {-# LANGUAGE LambdaCase #-}
-{-# LANGUAGE DataKinds #-}
+{-# LANGUAGE DataKinds, TypeFamilies #-}
 {-# language DeriveGeneric, GeneralizedNewtypeDeriving, DerivingStrategies, DeriveDataTypeable  #-}
 {-# language OverloadedStrings #-}
 {-# options_ghc -Wno-unused-imports #-}
--- | OAuth user session
+-- | 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)
 module Network.OAuth2.Session (
   -- * Azure App Service
   withAADUser
-  -- * OAuth2 endpoints
+  -- * App-only flow
+  , Token
+  , newNoToken
+  , expireToken
+  , readToken
+  , fetchUpdateToken
+  -- * Delegated permissions flow
+  -- ** OAuth endpoints
   , loginEndpoint
   , replyEndpoint
-  -- * In-memory user session
+  -- ** In-memory user session
   , Tokens
   , newTokens
   , UserSub
@@ -24,6 +33,7 @@ module Network.OAuth2.Session (
 
 import Control.Exception (Exception(..), SomeException(..))
 import Control.Monad.IO.Class (MonadIO(..))
+import Data.Functor (void)
 import Data.List.NonEmpty (NonEmpty)
 import Data.Maybe (fromMaybe)
 import Data.String (IsString(..))
@@ -120,7 +130,58 @@ withAADUser ts loginURI act = aadHeaderIdToken $ \usub -> do
       redirect loginURI
 
 
--- * OAuth flow
+-- * App-only authorization scenarios (i.e via automation accounts. Human users not involved)
+
+
+-- app has 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 ts = atomically $ modifyTVar ts (const Nothing)
+readToken :: MonadIO m => Token t -> m (Maybe t)
+readToken ts = atomically $ readTVar ts
+
+-- | Fetch an OAuth token and keep it updated. Should be called as a first thing in the app
+--
+-- NB : forks a thread in the background
+--
+-- https://learn.microsoft.com/en-us/azure/active-directory/develop/v2-oauth2-client-creds-grant-flow
+fetchUpdateToken :: MonadIO m =>
+                    Token OAuth2Token
+                 -> IdpApplication 'ClientCredentials AzureAD
+                 -> Manager
+                 -> m ()
+fetchUpdateToken ts idpApp mgr = liftIO $ void $ forkFinally loop cleanup
+  where
+    cleanup = \case
+      Left e -> throwIO e
+      Right _ -> pure ()
+    loop = do
+      tokenResp <- runExceptT $ conduitTokenRequest idpApp mgr -- OAuth2 token
+      case tokenResp of
+        Left es -> throwIO (OASEOAuth2Errors es)
+        Right oat -> do
+          ein <- updateToken ts oat
+          let
+            dtSecs = (round ein - 30) -- 30 seconds before expiry
+          threadDelay (dtSecs * 1000000) -- pause thread
+          loop
+
+updateToken :: (MonadIO m) =>
+               Token OAuth2Token -> OAuth2Token -> m NominalDiffTime
+updateToken ts oat = do
+  let
+    ein = fromIntegral $ fromMaybe 3600 (expiresIn oat) -- expires in [sec]
+  atomically $ do
+    writeTVar ts (Just oat)
+  pure ein
+
+
+
+
+-- * Delegated permission flow (i.e. human user involved)
 
 -- | Login endpoint
 --
@@ -141,7 +202,7 @@ loginH idpApp = do
 
 -- | The identity provider redirects the client to the 'reply' endpoint as part of the OAuth flow : https://learn.microsoft.com/en-us/graph/auth-v2-user?view=graph-rest-1.0&tabs=http#authorization-response
 --
--- see 'azureADApp'
+-- NB : forks a thread per logged in user to keep their tokens up to date
 replyEndpoint :: MonadIO m =>
                  IdpApplication 'AuthorizationCode AzureAD
               -> Tokens UserSub OAuth2Token
@@ -163,7 +224,7 @@ replyH idpApp ts mgr = do
          Just codeP -> do
            let
              etoken = ExchangeToken $ TL.toStrict codeP
-           _ <- fetchUpdateToken ts idpApp mgr etoken
+           _ <- fetchUpdateTokenDeleg ts idpApp mgr etoken
            pure ()
          Nothing -> throwE OASEExchangeTokenNotFound
 
@@ -178,13 +239,13 @@ replyH idpApp ts mgr = do
 
 -- | 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
-fetchUpdateToken :: MonadUnliftIO m =>
-                    Tokens UserSub OAuth2Token
-                 -> IdpApplication 'AuthorizationCode AzureAD
-                 -> Manager
-                 -> ExchangeToken -- ^ also called 'code'. Expires in 10 minutes
-                 -> ExceptT OAuthSessionError m OAuth2Token
-fetchUpdateToken ts idpApp mgr etoken = ExceptT $ do
+fetchUpdateTokenDeleg :: 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
   tokenResp <- runExceptT $ conduitTokenRequest idpApp mgr etoken -- OAuth2 token
   case tokenResp of
     Right oat -> case idToken oat of
@@ -193,27 +254,27 @@ fetchUpdateToken ts idpApp mgr etoken = ExceptT $ do
         idtClaimsE <- decValidIdToken idt -- decode and validate ID token
         case idtClaimsE of
           Right uid -> do
-            _ <- refreshLoop ts idpApp mgr uid oat -- fork a thread and start refresh loop for this user
+            _ <- refreshLoopDeleg 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@
-refreshLoop :: (MonadUnliftIO m, Ord uid, HasRefreshTokenRequest a) =>
-               Tokens uid OAuth2Token
-            -> IdpApplication a i
-            -> Manager
-            -> uid -- ^ user ID
-            -> OAuth2Token
-            -> m ThreadId
-refreshLoop ts idpApp mgr uid oaToken = forkFinally (act oaToken) cleanup
+refreshLoopDeleg :: (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
   where
     cleanup = \case
       Left _ -> do
         expireUser ts uid -- auth error(s), remove user from memory
       Right _ -> pure ()
     act oat = do
-      ein <- updateToken ts uid oat -- replace new token in memory
+      ein <- upsertToken ts uid oat -- replace new token for user uid in memory
       let
         dtSecs = (round ein - 30) -- 30 seconds before expiry
       threadDelay (dtSecs * 1000000) -- pause thread
@@ -245,12 +306,12 @@ instance Show OAuthSessionError where
     OASENoOpenID -> unwords ["No ID token found. Ensure 'openid' scope appears in token request"]
 
 -- | Insert or update a token in the 'Tokens' object
-updateToken :: (MonadIO m, Ord uid) =>
+upsertToken :: (MonadIO m, Ord uid) =>
                Tokens uid OAuth2Token
             -> uid -- ^ user id
             -> OAuth2Token -- ^ new token
             -> m NominalDiffTime -- ^ token expires in
-updateToken ts uid oat = do
+upsertToken ts uid oat = do
   let
     ein = fromIntegral $ fromMaybe 3600 (expiresIn oat) -- expires in [sec]
   atomically $ do