version bump

.gitignore

@@ -2,4 +2,5 @@
 /.cabal-sandbox/
 /cabal.sandbox.config
 /.stack-work/
-.DS_Store
+.DS_Store
+.env

ms-auth/CHANGELOG.md

@@ -8,13 +8,18 @@ and this project adheres to the
 
 ## Unreleased
 
-defaultAzureCredential - to mimic the behaviour of the Microsoft Identity SDK
+## 0.3.0.0
 
-Breaking change:
+defaultAzureCredential - simplified version of the Microsoft Identity SDK
 
-module Network.OAuth2.JWT is not exposed anymore
+introduced MSAuth module that re-exports internal functions
 
-## 0.3.0.0
+Breaking changes:
+
+- module Network.OAuth2.JWT is not exposed anymore
+- OAuthCfg does not contain fields for client ID and secret anymore
+- client ID and client secret can only be loaded from environment variables
+- Network.OAuth2.Provider.AzureAD azureADApp and azureOAuthADApp return in MonadIO since they look up client ID and secret from the environment
 
 ## 0.1.0.0
 

ms-auth/ms-auth.cabal

@@ -18,14 +18,17 @@ tested-with: GHC == 9.2.8
 library
  default-language: Haskell2010
  hs-source-dirs: src
- exposed-modules: 
+ exposed-modules: MSAuth
  Network.OAuth2.Session
  Network.OAuth2.Provider.AzureAD
  other-modules: Network.OAuth2.JWT
- build-depends: base >= 4.7 && < 5
- , aeson
+ DotEnv
+ build-depends: aeson
+ , base >= 4.7 && < 5
  , bytestring
  , containers
+ , directory
+ , directory >= 1.3.6.2
  , hoauth2 == 2.6.0
  , http-client
  , http-types
@@ -35,9 +38,9 @@ library
  , text
  , time
  , transformers
+ , unliftio
  , uri-bytestring
  , validation-micro
- , unliftio
  ghc-options: -Wall
  -Wcompat
  -Widentities

ms-auth/src/DotEnv.hs

@@ -0,0 +1,67 @@
+module DotEnv (applyDotEnv) where
+
+import Control.Monad.IO.Class (MonadIO(..))
+import Data.Foldable (traverse_)
+import Data.Functor (void)
+import Data.List (sortOn)
+import Data.Maybe (listToMaybe, fromMaybe)
+import Data.Ord (Down(..))
+import System.Environment (setEnv)
+import qualified Text.ParserCombinators.ReadP as P (ReadP, readP_to_S, char, munch, sepBy1)
+
+-- directory
+import System.Directory (doesFileExist)
+
+-- | Load, parse and apply a @.env@ file
+--
+-- NB : overwrites any preexisting env vars
+--
+-- NB2 : if the @.env@ file is not found the program continues (i.e. this function is a no-op in that case)
+applyDotEnv :: MonadIO m =>
+ Maybe FilePath -- ^ defaults to @.env@ if Nothing
+ -> m ()
+applyDotEnv mfp = liftIO $ do
+ let
+ fpath = fromMaybe ".env" mfp
+ ok <- doesFileExist fpath
+ if ok
+ then
+ do
+ mp <- parseDotEnv <$> readFile fpath
+ case mp of
+ Just es -> setEnvs es
+ Nothing -> putStrLn $ unwords ["dotenv: cannot parse", fpath]
+ else
+ do
+ putStrLn $ unwords ["dotenv:", fpath, "not found"]
+
+setEnvs :: MonadIO m => [(String, String)] -> m ()
+setEnvs = traverse_ insf
+ where
+ insf (k, v) = liftIO $ do
+ setEnv k v
+ putStrLn $ unwords ["dotenv: set", k] -- DEBUG
+
+parseDotEnv :: String -- ^ contents of the @.env@ file
+ -> Maybe [(String, String)]
+parseDotEnv = parse1 keyValues
+
+keyValues :: P.ReadP [(String, String)]
+keyValues = P.sepBy1 keyValue (P.char '\n') <* P.char '\n'
+
+keyValue :: P.ReadP (String, String)
+keyValue = do
+ k <- keyP
+ void $ P.char '='
+ v <- valueP
+ pure (k, v)
+
+keyP, valueP :: P.ReadP String
+keyP = P.munch (/= '=')
+valueP = P.munch (/= '\n')
+
+-- parse :: P.ReadP b -> String -> Maybe b
+-- parse p str = fst <$> (listToMaybe $ P.readP_to_S p str)
+
+parse1 :: Foldable t => P.ReadP (t a) -> String -> Maybe (t a)
+parse1 p str = fmap fst $ listToMaybe $ sortOn (Down . length . fst) (P.readP_to_S p str)

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

@@ -1,3 +1,4 @@
+{-# LANGUAGE LambdaCase #-}
 {-# language DeriveGeneric, GeneralizedNewtypeDeriving, DerivingStrategies #-}
 {-# LANGUAGE QuasiQuotes, RecordWildCards #-}
 {-# language OverloadedStrings #-}
@@ -6,38 +7,73 @@
 {-# options_ghc -Wno-ambiguous-fields #-}
 -- | Settings for using Azure Active Directory as OAuth identity provider
 --
--- Both @Delegated@ (On-Behalf-Of) and @App-only@ (i.e. Client Credentials) authentication flows are supported. The former is useful when a user needs to login and delegate some permissions to the application (i.e. accessing personal data), whereas the second is for server processes and automation accounts.
+-- Both @Auth Code Grant@ (i.e. with browser client interaction) and @App-only@ (i.e. Client Credentials) authentication flows are supported. The former is useful when a user needs to login and delegate some permissions to the application (i.e. accessing personal data), whereas the second is for server processes and automation accounts.
 module Network.OAuth2.Provider.AzureAD (
  AzureAD
+ -- * Environment variables
+ , envClientId
+ , envClientSecret
+ , envTenantId
  -- * App flow
  , azureADApp
  -- * Delegated permissions OAuth2 flow
  , OAuthCfg(..)
  , AzureADUser
  , azureOAuthADApp
+ -- * Exceptions
+ , AzureADException(..)
  ) where
 
 -- import Data.String (IsString(..))
 -- import GHC.Generics
 
+import Control.Monad.IO.Class (MonadIO(..))
+import Control.Exception (Exception(..))
+import System.Environment (lookupEnv)
+
 -- aeson
 import Data.Aeson
 -- containers
 import qualified Data.Map.Strict as Map
 import qualified Data.Set as Set
 -- hoauth2
 import Network.OAuth.OAuth2 (ClientAuthenticationMethod(..), authGetJSON)
-import Network.OAuth2.Experiment (IdpApplication(..), Idp(..), IdpUserInfo, GrantTypeFlow(..), ClientId(..), ClientSecret, Scope, AuthorizeState)
+import Network.OAuth2.Experiment (IdpApplication(..), Idp(..), IdpUserInfo, GrantTypeFlow(..), ClientId(..), ClientSecret(..), Scope, AuthorizeState)
 -- text
 import qualified Data.Text as T (Text)
-import qualified Data.Text.Lazy as TL (Text)
+import qualified Data.Text.Lazy as TL (Text, pack)
+-- unliftio
+import UnliftIO.Exception (throwIO, Typeable)
 -- uri-bytestring
 import URI.ByteString (URI)
 import URI.ByteString.QQ (uri)
 
 
 data AzureAD = AzureAD deriving (Eq, Show)
 
+-- | @AZURE_CLIENT_ID@
+envClientId :: MonadIO f => f ClientId
+envClientId = env ClientId "AZURE_CLIENT_ID"
+-- | @AZURE_TENANT_ID@
+envTenantId :: MonadIO f => f TL.Text
+envTenantId = env id "AZURE_TENANT_ID"
+-- | @AZURE_CLIENT_SECRET@
+envClientSecret :: MonadIO f => f ClientSecret
+envClientSecret = env ClientSecret "AZURE_CLIENT_SECRET"
+
+
+env :: MonadIO m => (TL.Text -> b) -> String -> m b
+env mk e = do
+ me <- liftIO $ lookupEnv e
+ case me of
+ Nothing -> throwIO $ AADNoEnvVar e
+ Just x -> pure $ (mk . TL.pack) x
+
+data AzureADException = AADNoEnvVar String deriving (Typeable)
+instance Exception AzureADException
+instance Show AzureADException where
+ show = \case
+ AADNoEnvVar e -> unwords ["Env var", e, "not found"]
 
 -- * App-only flow
 
@@ -49,16 +85,22 @@ data AzureAD = AzureAD deriving (Eq, Show)
 --
 -- also be aware to find the right client id.
 -- see https://stackoverflow.com/a/70670961
-azureADApp :: TL.Text -- ^ application name
- -> ClientId -> ClientSecret
+--
+--
+-- Throws 'AzureADException' if @AZURE_CLIENT_ID@ and/or @AZURE_CLIENT_SECRET@ credentials are not found in the environment
+azureADApp :: MonadIO m =>
+ TL.Text -- ^ application name
  -> [Scope] -- ^ scopes
- -> IdpApplication 'ClientCredentials AzureAD
-azureADApp appname clid sec scopes = defaultAzureADApp{
- idpAppName = appname
- , idpAppClientId = clid
- , idpAppClientSecret = sec
- , idpAppScope = Set.fromList (scopes <> ["offline_access"])
- }
+ -> m (IdpApplication 'ClientCredentials AzureAD)
+azureADApp appname scopes = do
+ clid <- envClientId
+ sec <- envClientSecret
+ pure $ defaultAzureADApp{
+ idpAppName = appname
+ , idpAppClientId = clid
+ , idpAppClientSecret = sec
+ , idpAppScope = Set.fromList (scopes <> ["offline_access"])
+ }
 
 defaultAzureADApp :: IdpApplication 'ClientCredentials AzureAD
 defaultAzureADApp =
@@ -79,8 +121,6 @@ type instance IdpUserInfo AzureAD = AzureADUser
 -- | Configuration object of the OAuth2 application
 data OAuthCfg = OAuthCfg {
  oacAppName :: TL.Text -- ^ application name
- , oacClientId :: ClientId -- ^ app client ID : see https://stackoverflow.com/a/70670961
- , oacClientSecret :: ClientSecret -- ^ app client secret "
  , oacScopes :: [Scope] -- ^ OAuth2 and OIDC scopes
  , oacAuthState :: AuthorizeState -- ^ OAuth2 'state' (a random string, https://www.rfc-editor.org/rfc/rfc6749#section-10.12 )
  , oacRedirectURI :: URI -- ^ OAuth2 redirect URI
@@ -96,16 +136,23 @@ data OAuthCfg = OAuthCfg {
 --
 -- 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
- , idpAppScope = Set.fromList (scopes <> ["openid", "offline_access"])
- , idpAppAuthorizeState = authstate
- , idpAppRedirectUri = reduri
- }
+--
+--
+-- Throws 'AzureADException' if @AZURE_CLIENT_ID@ and/or @AZURE_CLIENT_SECRET@ credentials are not found in the environment
+azureOAuthADApp :: MonadIO m =>
+ OAuthCfg -- ^ OAuth configuration
+ -> m (IdpApplication 'AuthorizationCode AzureAD)
+azureOAuthADApp (OAuthCfg appname scopes authstate reduri) = do
+ clid <- envClientId
+ sec <- envClientSecret
+ pure $ defaultAzureOAuthADApp{
+ idpAppName = appname
+ , idpAppClientId = clid
+ , idpAppClientSecret = sec
+ , idpAppScope = Set.fromList (scopes <> ["openid", "offline_access"])
+ , idpAppAuthorizeState = authstate
+ , idpAppRedirectUri = reduri
+ }
 
 defaultAzureOAuthADApp :: IdpApplication 'AuthorizationCode AzureAD
 defaultAzureOAuthADApp =

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

@@ -21,7 +21,7 @@ module Network.OAuth2.Session (
  , fetchUpdateToken
  -- ** Default Azure Credential
  , defaultAzureCredential
- -- * B Auth code grant flow (with user in the loop)
+ -- * B Auth code grant flow (interactive)
  -- ** OAuth endpoints
  , loginEndpoint
  , replyEndpoint
@@ -37,7 +37,7 @@ module Network.OAuth2.Session (
  , withAADUser
  , Scotty
  , Action
-  ) where
+ ) where
 
 import Control.Applicative (Alternative(..))
 import Control.Exception (Exception(..), SomeException(..))
@@ -152,10 +152,13 @@ withAADUser ts loginURI act = aadHeaderIdToken $ \usub -> do
 -- | App has (at most) one token at a time
 type Token t = TVar (Maybe t)
 
+-- | Create an empty 'Token' store
 newNoToken :: MonadIO m => m (Token t)
 newNoToken = newTVarIO Nothing
+-- | Delete the current token
 expireToken :: MonadIO m => Token t -> m ()
 expireToken ts = atomically $ modifyTVar ts (const Nothing)
+-- | Read the current value of the token
 readToken :: MonadIO m => Token t -> m (Maybe t)
 readToken ts = atomically $ readTVar ts
 
@@ -178,25 +181,31 @@ fetchUpdateTokenWith f idpApp ts mgr = liftIO $ void $ forkFinally loop cleanup
  threadDelay (dtSecs * 1000000) -- pause thread
  loop
 
--- | DefaultUserCredential mechanism as in the Python SDK https://pypi.org/project/azure-identity/
+-- | DefaultAzureCredential mechanism as in the Python SDK https://pypi.org/project/azure-identity/
+--
+-- Order of authentication attempts:
+--
+-- 1) token request with client secret
+--
+-- 2) token request via managed identity (App Service and Azure Functions) https://learn.microsoft.com/en-us/azure/app-service/overview-managed-identity?tabs=portal%2Chttp#rest-endpoint-reference
 defaultAzureCredential :: MonadIO m =>
- String
- -> String
+ String -- ^ Client ID
+ -> String -- ^ Azure Resource URI (for @managed identity@ auth flow)
  -> IdpApplication 'ClientCredentials AzureAD
  -> Token OAuth2Token
  -> Manager
  -> m ()
 defaultAzureCredential clid resuri = fetchUpdateTokenWith (
- \idp mgr ->
- tokenRequestNoExchange idp mgr <|>
+ \ip mgr ->
+ tokenRequestNoExchange ip mgr <|>
  managedIdentity mgr clid resuri
  )
 
 tokenRequestNoExchange :: (MonadIO m) =>
  IdpApplication 'ClientCredentials AzureAD
  -> Manager
  -> ExceptT [String] m OAuth2Token
-tokenRequestNoExchange idp mgr = withExceptT (pure . show) (conduitTokenRequest idp mgr)
+tokenRequestNoExchange ip mgr = withExceptT (pure . show) (conduitTokenRequest ip mgr)
 
 -- | Fetch an OAuth token and keep it updated. Should be called as a first thing in the app
 --