{-# LANGUAGE LambdaCase #-}
{-# language DeriveGeneric, GeneralizedNewtypeDeriving, DerivingStrategies #-}
{-# LANGUAGE QuasiQuotes, RecordWildCards #-}
{-# language OverloadedStrings #-}
{-# language DataKinds, TypeFamilies, TypeApplications #-}
{-# LANGUAGE DuplicateRecordFields #-}
{-# options_ghc -Wno-ambiguous-fields #-}
-- | Settings for using Azure Active Directory as OAuth identity provider
--
-- Both @Auth Code Grant@ (i.e. with browser client interaction) and @Client Credentials Grant@ 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.
--
-- Azure Bot Framework is supported since v 0.4
module Network.OAuth2.Provider.AzureAD (
    AzureAD
    -- * Environment variables
    , envClientId
    , envClientSecret
    , envTenantId
    -- * Client Credentials auth flow
    , azureADApp
    , azureBotFrameworkADApp
    -- * Auth Code Grant auth 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)
-- text
import qualified Data.Text as T (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 (AzureAD -> AzureAD -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: AzureAD -> AzureAD -> Bool
$c/= :: AzureAD -> AzureAD -> Bool
== :: AzureAD -> AzureAD -> Bool
$c== :: AzureAD -> AzureAD -> Bool
Eq, Int -> AzureAD -> ShowS
[AzureAD] -> ShowS
AzureAD -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [AzureAD] -> ShowS
$cshowList :: [AzureAD] -> ShowS
show :: AzureAD -> String
$cshow :: AzureAD -> String
showsPrec :: Int -> AzureAD -> ShowS
$cshowsPrec :: Int -> AzureAD -> ShowS
Show)

-- | @AZURE_CLIENT_ID@
envClientId :: MonadIO f => f ClientId
envClientId :: forall (f :: * -> *). MonadIO f => f ClientId
envClientId = forall (m :: * -> *) b. MonadIO m => (Text -> b) -> String -> m b
env Text -> ClientId
ClientId String
"AZURE_CLIENT_ID"
-- | @AZURE_TENANT_ID@
envTenantId :: MonadIO f => f TL.Text
envTenantId :: forall (f :: * -> *). MonadIO f => f Text
envTenantId = forall (m :: * -> *) b. MonadIO m => (Text -> b) -> String -> m b
env forall a. a -> a
id String
"AZURE_TENANT_ID"
-- | @AZURE_CLIENT_SECRET@
envClientSecret :: MonadIO f => f ClientSecret
envClientSecret :: forall (f :: * -> *). MonadIO f => f ClientSecret
envClientSecret = forall (m :: * -> *) b. MonadIO m => (Text -> b) -> String -> m b
env Text -> ClientSecret
ClientSecret String
"AZURE_CLIENT_SECRET"


env :: MonadIO m => (TL.Text -> b) -> String -> m b
env :: forall (m :: * -> *) b. MonadIO m => (Text -> b) -> String -> m b
env Text -> b
mk String
e = do
  Maybe String
me <- forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall a b. (a -> b) -> a -> b
$ String -> IO (Maybe String)
lookupEnv String
e
  case Maybe String
me of
    Maybe String
Nothing -> forall (m :: * -> *) e a. (MonadIO m, Exception e) => e -> m a
throwIO forall a b. (a -> b) -> a -> b
$ String -> AzureADException
AADNoEnvVar String
e
    Just String
x -> forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ (Text -> b
mk forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Text
TL.pack) String
x

data AzureADException = AADNoEnvVar String deriving (Typeable)
instance Exception AzureADException
instance Show AzureADException where
  show :: AzureADException -> String
show = \case
    AADNoEnvVar String
e -> [String] -> String
unwords [String
"Env var", String
e, String
"not found"]

-- * Client Credentials Grant flow

-- | Azure OAuth application
--
-- NB : scope @offline_access@ is ALWAYS requested
--
-- 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
--
--
-- 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
           -> m (IdpApplication 'ClientCredentials AzureAD)
azureADApp :: forall (m :: * -> *).
MonadIO m =>
Text -> [Scope] -> m (IdpApplication 'ClientCredentials AzureAD)
azureADApp Text
appname [Scope]
scopes = do
  ClientId
clid <- forall (f :: * -> *). MonadIO f => f ClientId
envClientId
  ClientSecret
sec <- forall (f :: * -> *). MonadIO f => f ClientSecret
envClientSecret
  forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ IdpApplication 'ClientCredentials AzureAD
defaultAzureADApp{
    $sel:idpAppName:ClientCredentialsIDPAppConfig :: Text
idpAppName = Text
appname
    , $sel:idpAppClientId:ClientCredentialsIDPAppConfig :: ClientId
idpAppClientId = ClientId
clid
    , $sel:idpAppClientSecret:ClientCredentialsIDPAppConfig :: ClientSecret
idpAppClientSecret = ClientSecret
sec
    , $sel:idpAppScope:ClientCredentialsIDPAppConfig :: Set Scope
idpAppScope = forall a. Ord a => [a] -> Set a
Set.fromList ([Scope]
scopes forall a. Semigroup a => a -> a -> a
<> [Scope
"offline_access"])
    }

defaultAzureADApp :: IdpApplication 'ClientCredentials AzureAD
defaultAzureADApp :: IdpApplication 'ClientCredentials AzureAD
defaultAzureADApp =
  ClientCredentialsIDPAppConfig
    { $sel:idpAppClientId:ClientCredentialsIDPAppConfig :: ClientId
idpAppClientId = ClientId
""
    , $sel:idpAppClientSecret:ClientCredentialsIDPAppConfig :: ClientSecret
idpAppClientSecret = ClientSecret
""
    , $sel:idpAppScope:ClientCredentialsIDPAppConfig :: Set Scope
idpAppScope = forall a. Ord a => [a] -> Set a
Set.fromList [Scope
"offline_access"] -- https://learn.microsoft.com/EN-US/azure/active-directory/develop/scopes-oidc#openid-connect-scopes
    , $sel:idpAppTokenRequestExtraParams:ClientCredentialsIDPAppConfig :: Map Text Text
idpAppTokenRequestExtraParams = forall k a. Map k a
Map.empty
    , $sel:idpAppName:ClientCredentialsIDPAppConfig :: Text
idpAppName = Text
"default-azure-app" --
    , $sel:idp:ClientCredentialsIDPAppConfig :: Idp AzureAD
idp = Idp AzureAD
defaultAzureADIdp
    }

-- | Initialize an Client Credentials token exchange application for the Bot Framework
--
--
-- Throws 'AzureADException' if @AZURE_CLIENT_ID@ and/or @AZURE_CLIENT_SECRET@ credentials are not found in the environment
azureBotFrameworkADApp :: MonadIO m =>
                          TL.Text -- ^ app name
                       -> m (IdpApplication 'ClientCredentials AzureAD)
azureBotFrameworkADApp :: forall (m :: * -> *).
MonadIO m =>
Text -> m (IdpApplication 'ClientCredentials AzureAD)
azureBotFrameworkADApp Text
appname = do
    ClientId
clid <- forall (f :: * -> *). MonadIO f => f ClientId
envClientId
    ClientSecret
sec <- forall (f :: * -> *). MonadIO f => f ClientSecret
envClientSecret
    forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ ClientCredentialsIDPAppConfig {$sel:idpAppClientId:ClientCredentialsIDPAppConfig :: ClientId
idpAppClientId = ClientId
clid,
                                          $sel:idpAppClientSecret:ClientCredentialsIDPAppConfig :: ClientSecret
idpAppClientSecret = ClientSecret
sec,
                                          $sel:idpAppName:ClientCredentialsIDPAppConfig :: Text
idpAppName = Text
appname,
                                          $sel:idpAppScope:ClientCredentialsIDPAppConfig :: Set Scope
idpAppScope = forall a. Ord a => [a] -> Set a
Set.fromList [Scope
"https://api.botframework.com/.default"],
                                          $sel:idpAppTokenRequestExtraParams:ClientCredentialsIDPAppConfig :: Map Text Text
idpAppTokenRequestExtraParams = forall a. Monoid a => a
mempty,
                                          $sel:idp:ClientCredentialsIDPAppConfig :: Idp AzureAD
idp = Idp AzureAD
defaultAzureBotFrameworkIdp
                                         }


-- data AzureBotFramework = AzureBotFramework deriving (Eq, Show)

defaultAzureBotFrameworkIdp :: Idp AzureAD
defaultAzureBotFrameworkIdp :: Idp AzureAD
defaultAzureBotFrameworkIdp = Idp {
  $sel:idpFetchUserInfo:Idp :: forall (m :: * -> *).
(FromJSON (IdpUserInfo AzureAD), MonadIO m) =>
Manager
-> AccessToken -> URI -> ExceptT ByteString m (IdpUserInfo AzureAD)
idpFetchUserInfo = forall a (m :: * -> *).
(FromJSON a, MonadIO m) =>
Manager -> AccessToken -> URI -> ExceptT ByteString m a
authGetJSON @(IdpUserInfo AzureAD)
  , $sel:idpTokenEndpoint:Idp :: URI
idpTokenEndpoint = [uri|https://login.microsoftonline.com/botframework.com/oauth2/v2.0/token|]
  , $sel:idpUserInfoEndpoint:Idp :: URI
idpUserInfoEndpoint = forall a. HasCallStack => String -> a
error forall a b. (a -> b) -> a -> b
$ [String] -> String
unwords [String
"Azure Bot Framework Idp:", String
"OAuth user info endpoint is not defined"]
  , $sel:idpAuthorizeEndpoint:Idp :: URI
idpAuthorizeEndpoint = forall a. HasCallStack => String -> a
error forall a b. (a -> b) -> a -> b
$ [String] -> String
unwords [String
"Azure Bot Framework Idp:", String
"OAuth authorize endpoint is not defined"]
                                  }







-- * Authorization Code Grant flow

type instance IdpUserInfo AzureAD = AzureADUser

-- | Configuration object of the OAuth2 application
data OAuthCfg = OAuthCfg {
  OAuthCfg -> Text
oacAppName :: TL.Text -- ^ application name
  , OAuthCfg -> [Scope]
oacScopes :: [Scope]  -- ^ OAuth2 and OIDC scopes
  , OAuthCfg -> AuthorizeState
oacAuthState :: AuthorizeState -- ^ OAuth2 'state' (a random string, https://www.rfc-editor.org/rfc/rfc6749#section-10.12 )
  , OAuthCfg -> URI
oacRedirectURI :: URI -- ^ OAuth2 redirect URI
                         }

-- | 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
--
-- 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
--
--
-- 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 :: forall (m :: * -> *).
MonadIO m =>
OAuthCfg -> m (IdpApplication 'AuthorizationCode AzureAD)
azureOAuthADApp (OAuthCfg Text
appname [Scope]
scopes AuthorizeState
authstate URI
reduri) = do
  ClientId
clid <- forall (f :: * -> *). MonadIO f => f ClientId
envClientId
  ClientSecret
sec <- forall (f :: * -> *). MonadIO f => f ClientSecret
envClientSecret
  forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ IdpApplication 'AuthorizationCode AzureAD
defaultAzureOAuthADApp{
    $sel:idpAppName:AuthorizationCodeIdpApplication :: Text
idpAppName = Text
appname
    , $sel:idpAppClientId:AuthorizationCodeIdpApplication :: ClientId
idpAppClientId = ClientId
clid
    , $sel:idpAppClientSecret:AuthorizationCodeIdpApplication :: ClientSecret
idpAppClientSecret = ClientSecret
sec
    , $sel:idpAppScope:AuthorizationCodeIdpApplication :: Set Scope
idpAppScope = forall a. Ord a => [a] -> Set a
Set.fromList ([Scope]
scopes forall a. Semigroup a => a -> a -> a
<> [Scope
"openid", Scope
"offline_access"])
    , $sel:idpAppAuthorizeState:AuthorizationCodeIdpApplication :: AuthorizeState
idpAppAuthorizeState = AuthorizeState
authstate
    , $sel:idpAppRedirectUri:AuthorizationCodeIdpApplication :: URI
idpAppRedirectUri = URI
reduri
    }

defaultAzureOAuthADApp :: IdpApplication 'AuthorizationCode AzureAD
defaultAzureOAuthADApp :: IdpApplication 'AuthorizationCode AzureAD
defaultAzureOAuthADApp =
  AuthorizationCodeIdpApplication
    { $sel:idpAppClientId:AuthorizationCodeIdpApplication :: ClientId
idpAppClientId = ClientId
""
    , $sel:idpAppClientSecret:AuthorizationCodeIdpApplication :: ClientSecret
idpAppClientSecret = ClientSecret
""
    , $sel:idpAppScope:AuthorizationCodeIdpApplication :: Set Scope
idpAppScope = forall a. Ord a => [a] -> Set a
Set.fromList [Scope
"openid", Scope
"offline_access", Scope
"profile", Scope
"email"] -- https://learn.microsoft.com/EN-US/azure/active-directory/develop/scopes-oidc#openid-connect-scopes
    , $sel:idpAppAuthorizeState:AuthorizationCodeIdpApplication :: AuthorizeState
idpAppAuthorizeState = AuthorizeState
"CHANGE_ME" -- https://stackoverflow.com/questions/26132066/what-is-the-purpose-of-the-state-parameter-in-oauth-authorization-request
    , $sel:idpAppAuthorizeExtraParams:AuthorizationCodeIdpApplication :: Map Text Text
idpAppAuthorizeExtraParams = forall k a. Map k a
Map.empty
    , $sel:idpAppRedirectUri:AuthorizationCodeIdpApplication :: URI
idpAppRedirectUri = [uri|http://localhost|] --
    , $sel:idpAppName:AuthorizationCodeIdpApplication :: Text
idpAppName = Text
"" --
    , $sel:idpAppTokenRequestAuthenticationMethod:AuthorizationCodeIdpApplication :: ClientAuthenticationMethod
idpAppTokenRequestAuthenticationMethod = ClientAuthenticationMethod
ClientSecretBasic
    , $sel:idp:AuthorizationCodeIdpApplication :: Idp AzureAD
idp = Idp AzureAD
defaultAzureADIdp
    }

-- | https://login.microsoftonline.com/common/v2.0/.well-known/openid-configuration
defaultAzureADIdp :: Idp AzureAD
defaultAzureADIdp :: Idp AzureAD
defaultAzureADIdp =
  Idp
    { $sel:idpFetchUserInfo:Idp :: forall (m :: * -> *).
(FromJSON (IdpUserInfo AzureAD), MonadIO m) =>
Manager
-> AccessToken -> URI -> ExceptT ByteString m (IdpUserInfo AzureAD)
idpFetchUserInfo = forall a (m :: * -> *).
(FromJSON a, MonadIO m) =>
Manager -> AccessToken -> URI -> ExceptT ByteString m a
authGetJSON @(IdpUserInfo AzureAD)
    , $sel:idpUserInfoEndpoint:Idp :: URI
idpUserInfoEndpoint = [uri|https://graph.microsoft.com/oidc/userinfo|]
    , $sel:idpAuthorizeEndpoint:Idp :: URI
idpAuthorizeEndpoint = [uri|https://login.microsoftonline.com/common/oauth2/v2.0/authorize|]
    , $sel:idpTokenEndpoint:Idp :: URI
idpTokenEndpoint = [uri|https://login.microsoftonline.com/common/oauth2/v2.0/token|]
    }



-- | https://learn.microsoft.com/en-us/azure/active-directory/develop/userinfo
data AzureADUser = AzureADUser
  { AzureADUser -> Text
sub :: T.Text
  , AzureADUser -> Maybe Text
email :: Maybe T.Text -- requires the “email” OIDC scope.
  , AzureADUser -> Maybe Text
familyName :: Maybe T.Text -- all names require the “profile” OIDC scope.
  , AzureADUser -> Maybe Text
givenName :: Maybe T.Text
  , AzureADUser -> Maybe Text
name :: Maybe T.Text
  }
  deriving (AzureADUser -> AzureADUser -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: AzureADUser -> AzureADUser -> Bool
$c/= :: AzureADUser -> AzureADUser -> Bool
== :: AzureADUser -> AzureADUser -> Bool
$c== :: AzureADUser -> AzureADUser -> Bool
Eq, Eq AzureADUser
AzureADUser -> AzureADUser -> Bool
AzureADUser -> AzureADUser -> Ordering
AzureADUser -> AzureADUser -> AzureADUser
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: AzureADUser -> AzureADUser -> AzureADUser
$cmin :: AzureADUser -> AzureADUser -> AzureADUser
max :: AzureADUser -> AzureADUser -> AzureADUser
$cmax :: AzureADUser -> AzureADUser -> AzureADUser
>= :: AzureADUser -> AzureADUser -> Bool
$c>= :: AzureADUser -> AzureADUser -> Bool
> :: AzureADUser -> AzureADUser -> Bool
$c> :: AzureADUser -> AzureADUser -> Bool
<= :: AzureADUser -> AzureADUser -> Bool
$c<= :: AzureADUser -> AzureADUser -> Bool
< :: AzureADUser -> AzureADUser -> Bool
$c< :: AzureADUser -> AzureADUser -> Bool
compare :: AzureADUser -> AzureADUser -> Ordering
$ccompare :: AzureADUser -> AzureADUser -> Ordering
Ord, Int -> AzureADUser -> ShowS
[AzureADUser] -> ShowS
AzureADUser -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [AzureADUser] -> ShowS
$cshowList :: [AzureADUser] -> ShowS
show :: AzureADUser -> String
$cshow :: AzureADUser -> String
showsPrec :: Int -> AzureADUser -> ShowS
$cshowsPrec :: Int -> AzureADUser -> ShowS
Show)

instance FromJSON AzureADUser where
  parseJSON :: Value -> Parser AzureADUser
parseJSON = forall a. String -> (Object -> Parser a) -> Value -> Parser a
withObject String
"AzureADUser" forall a b. (a -> b) -> a -> b
$ \Object
o -> Text
-> Maybe Text
-> Maybe Text
-> Maybe Text
-> Maybe Text
-> AzureADUser
AzureADUser forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$>
    Object
o forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"sub" forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*>
    Object
o forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"email" forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*>
    Object
o forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"family_name" forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*>
    Object
o forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"given_name" forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*>
    Object
o forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"name"

--   parseJSON = genericParseJSON defaultOptions {fieldLabelModifier = camelTo2 '_'}