hoauth2-demo-1.12.2: src/Types.hs

{-# LANGUAGE ExistentialQuantification #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE RankNTypes #-}
{-# LANGUAGE StandaloneDeriving #-}
{-# OPTIONS_GHC -fno-warn-orphans #-}

module Types where

import Control.Concurrent.MVar
import Data.Aeson
import Data.Default
import Data.Map.Strict qualified as Map
import Data.Maybe
import Data.Text.Lazy (Text)
import Data.Text.Lazy qualified as TL
import Env
import Network.OAuth2
import Network.OAuth2.Experiment
import Network.OAuth2.Provider
import Text.Mustache ((~>))
import Text.Mustache qualified as M
import User

-------------------------------------------------------------------------------
--                                  DemoIdp                                  --
-------------------------------------------------------------------------------

data DemoIdp
  = forall i.
    ( HasDemoLoginUser i
    , FromJSON (IdpUser i)
    ) =>
    DemoIdp (Idp i)

-------------------------------------------------------------------------------
--                                   AppEnv                                  --
-------------------------------------------------------------------------------
type TenantBasedIdps = (Idp Auth0, Idp Okta)

data AppEnv = AppEnv
  { oauthConfigs :: OAuthConfigs
  , oidcIdps :: TenantBasedIdps
  , findIdpByName :: IdpName -> DemoIdp
  , sessionStore :: AuthorizationGrantUserStore
  }

-------------------------------------------------------------------------------
--                                  Session                                  --
-------------------------------------------------------------------------------
newtype AuthorizationGrantUserStore = AuthorizationGrantUserStore (MVar (Map.Map IdpName IdpAuthorizationCodeAppSessionData))

data IdpAuthorizationCodeAppSessionData = IdpAuthorizationCodeAppSessionData
  { idpName :: IdpName
  , loginUser :: Maybe DemoLoginUser
  , tokenResponse :: Maybe TokenResponse
  , authorizePkceCodeVerifier :: Maybe CodeVerifier
  , authorizeAbsUri :: TL.Text
  }

instance Default IdpAuthorizationCodeAppSessionData where
  def =
    IdpAuthorizationCodeAppSessionData
      { idpName = Okta
      , loginUser = Nothing
      , tokenResponse = Nothing
      , authorizePkceCodeVerifier = Nothing
      , authorizeAbsUri = ""
      }

instance M.ToMustache IdpAuthorizationCodeAppSessionData where
  toMustache (IdpAuthorizationCodeAppSessionData {..}) = do
    let hasDeviceGrant = idpName `elem` [Okta, GitHub, Auth0, AzureAD, Google]
        hasClientCredentialsGrant = idpName `elem` [Okta, Auth0]
        hasPasswordGrant = idpName `elem` [Okta, Auth0]
    M.object
      [ "isLogin" ~> isJust loginUser
      , "user" ~> loginUser
      , "idpName" ~> idpName
      , "hasDeviceGrant" ~> hasDeviceGrant
      , "hasClientCredentialsGrant" ~> hasClientCredentialsGrant
      , "hasPasswordGrant" ~> hasPasswordGrant
      ]

-------------------------------------------------------------------------------
--                             IdpName extension                             --
-------------------------------------------------------------------------------

allIdpNames :: [IdpName]
allIdpNames = [minBound .. maxBound]

deriving instance Read IdpName

fromText :: Text -> IdpName
fromText = read . TL.unpack

toText :: IdpName -> Text
toText = TL.pack . show

instance M.ToMustache IdpName where
  toMustache idpName = M.toMustache (show idpName)