{-# 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 (
OAuthCfg(..)
, AzureAD
, AzureADUser
, azureADApp) 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)
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
}
azureADApp :: OAuthCfg
-> IdpApplication 'AuthorizationCode AzureAD
azureADApp :: OAuthCfg -> IdpApplication 'AuthorizationCode AzureAD
azureADApp (OAuthCfg Text
appname ClientId
clid ClientSecret
sec [Scope]
scopes AuthorizeState
authstate URI
reduri) = IdpApplication 'AuthorizationCode AzureAD
defaultAzureADApp{
$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
}
defaultAzureADApp :: IdpApplication 'AuthorizationCode AzureAD
defaultAzureADApp :: IdpApplication 'AuthorizationCode AzureAD
defaultAzureADApp =
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"