AuthMethods + Template Haskell experiment #1918
There are no files selected for viewing
This file contains bidirectional Unicode text that may be interpreted or compiled differently than what appears below. To review, open the file in an editor that reveals hidden Unicode characters.
Learn more about bidirectional Unicode characters
This file contains bidirectional Unicode text that may be interpreted or compiled differently than what appears below. To review, open the file in an editor that reveals hidden Unicode characters.
Learn more about bidirectional Unicode characters
This file contains bidirectional Unicode text that may be interpreted or compiled differently than what appears below. To review, open the file in an editor that reveals hidden Unicode characters.
Learn more about bidirectional Unicode characters
| Original file line number | Diff line number | Diff line change |
|---|---|---|
| @@ -0,0 +1,105 @@ | ||
| {-# LANGUAGE DeriveDataTypeable #-} | ||
| {-# LANGUAGE DuplicateRecordFields #-} | ||
| {-# LANGUAGE TemplateHaskell #-} | ||
|
|
||
| module Wasp.AppSpec.App.Auth.AuthMethods | ||
| ( generateAuthMethods, | ||
| userSignupFieldsForEmailAuth, | ||
| userSignupFieldsForUsernameAuth, | ||
| userSignupFieldsForExternalAuth, | ||
| isAuthMethodExternal, | ||
| AuthMethod (..), | ||
| UsernameAndPasswordConfig (..), | ||
| ExternalAuthConfig (..), | ||
| EmailAuthConfig (..), | ||
| ) | ||
| where | ||
|
|
||
| import Data.Data (Data) | ||
| import Language.Haskell.TH | ||
|
There was a problem hiding this comment. Unqalified, unlisted import -> not a good practice! |
||
| import Language.Haskell.TH.Syntax (VarBangType) | ||
| import Wasp.AppSpec.App.Auth.EmailVerification (EmailVerificationConfig) | ||
| import Wasp.AppSpec.App.Auth.PasswordReset (PasswordResetConfig) | ||
| import Wasp.AppSpec.App.EmailSender (EmailFromField) | ||
| import Wasp.AppSpec.ExtImport (ExtImport) | ||
| import Wasp.Util (toLowerFirst) | ||
|
|
||
| data AuthMethod = UsernameAndPassword | Email | Google | Keycloak | GitHub deriving (Show, Enum, Bounded) | ||
|
|
||
| data UsernameAndPasswordConfig = UsernameAndPasswordConfig | ||
| { userSignupFields :: Maybe ExtImport | ||
| } | ||
| deriving (Show, Eq, Data) | ||
|
|
||
| data ExternalAuthConfig = ExternalAuthConfig | ||
| { configFn :: Maybe ExtImport, | ||
| userSignupFields :: Maybe ExtImport | ||
| } | ||
| deriving (Show, Eq, Data) | ||
|
|
||
| data EmailAuthConfig = EmailAuthConfig | ||
| { userSignupFields :: Maybe ExtImport, | ||
| fromField :: EmailFromField, | ||
| emailVerification :: EmailVerificationConfig, | ||
| passwordReset :: PasswordResetConfig | ||
| } | ||
| deriving (Show, Eq, Data) | ||
|
|
||
| configType :: AuthMethod -> Name | ||
| configType UsernameAndPassword = ''UsernameAndPasswordConfig | ||
| configType Email = ''EmailAuthConfig | ||
| configType Google = ''ExternalAuthConfig | ||
| configType Keycloak = ''ExternalAuthConfig | ||
| configType GitHub = ''ExternalAuthConfig | ||
|
|
||
| -- Generate the AuthMethods data type | ||
| -- data AuthMethods = AuthMethods | ||
|
There was a problem hiding this comment. Seems to me like you ended up defining this relationship anyway above! Becauwe you defined it via |
||
| -- { usernameAndPassword :: Maybe UsernameAndPasswordConfig, | ||
| -- google :: Maybe ExternalAuthConfig, | ||
| -- gitHub :: Maybe ExternalAuthConfig, | ||
| -- keycloak :: Maybe ExternalAuthConfig, | ||
| -- email :: Maybe EmailAuthConfig | ||
| -- ... | ||
| -- } deriving (Show, Eq, Data) | ||
| generateAuthMethods :: Q [Dec] | ||
| generateAuthMethods = do | ||
| let authMethodsName = mkName "AuthMethods" | ||
| let authMethodsCtorName = mkName "AuthMethods" | ||
| let fields = generateField <$> [UsernameAndPassword .. GitHub] | ||
| -- data AuthMethods | ||
| let authMethods = | ||
| dataD | ||
| (cxt []) | ||
| authMethodsName | ||
| [] | ||
| Nothing | ||
| [recC authMethodsCtorName fields] | ||
| [derivClause Nothing [[t|Show|], [t|Eq|], [t|Data|]]] | ||
| sequence [authMethods] | ||
| where | ||
| -- usernameAndPassword :: Maybe UsernameAndPasswordConfig | ||
| generateField :: AuthMethod -> Q VarBangType | ||
| generateField authMethod = do | ||
| let fieldName = mkName (toLowerFirst (show authMethod)) | ||
| let fieldConfigType = configType authMethod | ||
| let fieldType = appT (conT ''Maybe) (conT fieldConfigType) | ||
| let fieldStrictness = bang noSourceUnpackedness noSourceStrictness | ||
| varBangType fieldName $ bangType fieldStrictness fieldType | ||
|
|
||
| -- These helper functions are used to avoid ambiguity when using the | ||
| -- `userSignupFields` function (otherwise we need to use the DuplicateRecordFields | ||
| -- extension in each module that uses them). | ||
| userSignupFieldsForEmailAuth :: EmailAuthConfig -> Maybe ExtImport | ||
| userSignupFieldsForEmailAuth = userSignupFields | ||
|
|
||
| userSignupFieldsForUsernameAuth :: UsernameAndPasswordConfig -> Maybe ExtImport | ||
| userSignupFieldsForUsernameAuth = userSignupFields | ||
|
|
||
| userSignupFieldsForExternalAuth :: ExternalAuthConfig -> Maybe ExtImport | ||
| userSignupFieldsForExternalAuth = userSignupFields | ||
|
Comment on lines
+92
to
+99
There was a problem hiding this comment. What you can do, if you want is, use typeclass for something like this, which has a method |
||
|
|
||
| isAuthMethodExternal :: AuthMethod -> Bool | ||
| isAuthMethodExternal Google = True | ||
| isAuthMethodExternal Keycloak = True | ||
| isAuthMethodExternal GitHub = True | ||
| isAuthMethodExternal _ = False | ||
This file contains bidirectional Unicode text that may be interpreted or compiled differently than what appears below. To review, open the file in an editor that reveals hidden Unicode characters.
Learn more about bidirectional Unicode characters
| Original file line number | Diff line number | Diff line change |
|---|---|---|
| @@ -0,0 +1,12 @@ | ||
| module Wasp.AppSpec.App.Auth.IsEnabled where | ||
|
|
||
| import Language.Haskell.TH | ||
| import Wasp.AppSpec.App.Auth (Auth (..), AuthMethods (..), generateIsAuthMethodEnabled) | ||
| import Wasp.AppSpec.App.Auth.AuthMethods (AuthMethod(..), isAuthMethodExternal) | ||
|
|
||
| $(generateIsAuthMethodEnabled) | ||
|
|
||
| isExternalAuthEnabled :: Auth -> Bool | ||
| isExternalAuthEnabled auth = any check [minBound .. maxBound :: AuthMethod] | ||
| where | ||
| check method = isAuthMethodExternal method && isAuthMethodEnabled method auth |
This file contains bidirectional Unicode text that may be interpreted or compiled differently than what appears below. To review, open the file in an editor that reveals hidden Unicode characters.
Learn more about bidirectional Unicode characters
Oops, something went wrong.
Oops, something went wrong.
Add this suggestion to a batch that can be applied as a single commit.
This suggestion is invalid because no changes were made to the code.
Suggestions cannot be applied while the pull request is closed.
Suggestions cannot be applied while viewing a subset of changes.
Only one suggestion per line can be applied in a batch.
Add this suggestion to a batch that can be applied as a single commit.
Applying suggestions on deleted lines is not supported.
You must change the existing code in this line in order to create a valid suggestion.
Outdated suggestions cannot be applied.
This suggestion has been applied or marked resolved.
Suggestions cannot be applied from pending reviews.
Suggestions cannot be applied on multi-line comments.
Suggestions cannot be applied while the pull request is queued to merge.
Suggestion cannot be applied right now. Please check back later.
There was a problem hiding this comment.
Choose a reason for hiding this comment
The reason will be displayed to describe this comment to others. Learn more.
Since TH can be hard to undrsatnd, and here it certainly is a bit ahrd to read, it would be good if you could document here, in a comment above it, what does this TH generate.