{-# LANGUAGE QuasiQuotes #-}

module Network.OAuth2.Provider.AzureAD where

import Data.Aeson
import Data.Map.Strict qualified as Map
import Data.Set qualified as Set
import Data.Text.Lazy (Text)
import GHC.Generics
import Network.OAuth.OAuth2
import Network.OAuth2.Experiment
import URI.ByteString.QQ

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

-- 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
"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
    }

-- | 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 :: Text
  , AzureADUser -> Text
email :: Text
  , AzureADUser -> Text
familyName :: Text
  , AzureADUser -> Text
givenName :: Text
  , AzureADUser -> Text
name :: Text
  }
  deriving (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, forall x. Rep AzureADUser x -> AzureADUser
forall x. AzureADUser -> Rep AzureADUser x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep AzureADUser x -> AzureADUser
$cfrom :: forall x. AzureADUser -> Rep AzureADUser x
Generic)

instance FromJSON AzureADUser where
  parseJSON :: Value -> Parser AzureADUser
parseJSON = forall a.
(Generic a, GFromJSON Zero (Rep a)) =>
Options -> Value -> Parser a
genericParseJSON Options
defaultOptions {fieldLabelModifier :: ShowS
fieldLabelModifier = Char -> ShowS
camelTo2 Char
'_'}