{-# 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 (
  -- * OAuth2 configuration
  OAuthCfg(..)
  , AzureAD
  , AzureADUser
  , azureADApp) where

-- import Data.String (IsString(..))
-- import GHC.Generics

-- 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)
-- 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)

type instance IdpUserInfo AzureAD = AzureADUser

data OAuthCfg = OAuthCfg {
  OAuthCfg -> Text
oacAppName :: TL.Text -- ^ application name
  , OAuthCfg -> ClientId
oacClientId :: ClientId -- ^ app client ID : see https://stackoverflow.com/a/70670961
  , OAuthCfg -> ClientSecret
oacClientSecret :: ClientSecret -- ^ app client secret "
  , 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
                         }

-- | NB : OIDC scopes @openid@ and @offline_access@ are ALWAYS requested since the library assumes we have access to refresh tokens and ID tokens
azureADApp :: OAuthCfg -- ^ OAuth configuration
           -> 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
  }

-- 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 :: 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"] -- 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
"default-azure-app" --
    , $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 '_'}