{-# language DeriveGeneric, GeneralizedNewtypeDeriving, DerivingStrategies #-}
{-# LANGUAGE QuasiQuotes, RecordWildCards #-}
{-# language OverloadedStrings #-}
{-# language DataKinds, TypeFamilies, TypeApplications #-}
{-# LANGUAGE DuplicateRecordFields #-}
{-# options_ghc -Wno-ambiguous-fields #-}
module Network.OAuth2.Provider.AzureAD (
AzureAD
, azureADApp
, OAuthCfg(..)
, AzureADUser
, azureOAuthADApp
) where
import Data.Aeson
import qualified Data.Map.Strict as Map
import qualified Data.Set as Set
import Network.OAuth.OAuth2 (ClientAuthenticationMethod(..), authGetJSON)
import Network.OAuth2.Experiment (IdpApplication(..), Idp(..), IdpUserInfo, GrantTypeFlow(..), ClientId(..), ClientSecret, Scope, AuthorizeState)
import qualified Data.Text as T (Text)
import qualified Data.Text.Lazy as TL (Text)
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)
azureADApp :: TL.Text
-> ClientId -> ClientSecret
-> [Scope]
-> IdpApplication 'ClientCredentials AzureAD
azureADApp :: Text
-> ClientId
-> ClientSecret
-> [Scope]
-> IdpApplication 'ClientCredentials AzureAD
azureADApp Text
appname ClientId
clid ClientSecret
sec [Scope]
scopes = 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"]
, $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
}
type instance IdpUserInfo AzureAD = AzureADUser
data OAuthCfg = OAuthCfg {
OAuthCfg -> Text
oacAppName :: TL.Text
, OAuthCfg -> ClientId
oacClientId :: ClientId
, OAuthCfg -> ClientSecret
oacClientSecret :: ClientSecret
, OAuthCfg -> [Scope]
oacScopes :: [Scope]
, OAuthCfg -> AuthorizeState
oacAuthState :: AuthorizeState
, OAuthCfg -> URI
oacRedirectURI :: URI
}
azureOAuthADApp :: OAuthCfg
-> IdpApplication 'AuthorizationCode AzureAD
azureOAuthADApp :: OAuthCfg -> IdpApplication 'AuthorizationCode AzureAD
azureOAuthADApp (OAuthCfg Text
appname ClientId
clid ClientSecret
sec [Scope]
scopes AuthorizeState
authstate URI
reduri) = 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"]
, $sel:idpAppAuthorizeState:AuthorizationCodeIdpApplication :: AuthorizeState
idpAppAuthorizeState = AuthorizeState
"CHANGE_ME"
, $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
"default-azure-app"
, $sel:idpAppTokenRequestAuthenticationMethod:AuthorizationCodeIdpApplication :: ClientAuthenticationMethod
idpAppTokenRequestAuthenticationMethod = ClientAuthenticationMethod
ClientSecretBasic
, $sel:idp:AuthorizationCodeIdpApplication :: Idp AzureAD
idp = Idp AzureAD
defaultAzureADIdp
}
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|]
}
data AzureADUser = AzureADUser
{ AzureADUser -> Text
sub :: T.Text
, AzureADUser -> Maybe Text
email :: Maybe T.Text
, AzureADUser -> Maybe Text
familyName :: Maybe T.Text
, 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"