diff --git a/config/settings.yml b/config/settings.yml index d2833483b..0e45357f0 100644 --- a/config/settings.yml +++ b/config/settings.yml @@ -131,32 +131,33 @@ auto-db-migrate: '_env:AUTO_DB_MIGRATE:true' # External databases used for authentication and user data lookup # If the first user database in the list is unreachable, the application will perform a failover to the next list entry, etc. user-database: - - protocol: "oauth2" + mode: simple + config: + protocol: "oauth2" config: client-id: "_env:OAUTH2CLIENTID:" client-secret: "_env:OAUTH2CLIENTSECRET:" tenant-id: "_env:OAUTH2TENANTID:" - - protocol: "ldap" - config: - host: "_env:LDAPHOST:" - tls: "_env:LDAPTLS:" - port: "_env:LDAPPORT:389" - user: "_env:LDAPUSER:" - pass: "_env:LDAPPASS:" - baseDN: "_env:LDAPBASE:" - scope: "_env:LDAPSCOPE:WholeSubtree" - timeout: "_env:LDAPTIMEOUT:5" - search-timeout: "_env:LDAPSEARCHTIME:5" - pool: - stripes: "_env:LDAPSTRIPES:1" - timeout: "_env:LDAPTIMEOUT:20" - limit: "_env:LDAPLIMIT:10" + # protocol: "ldap" + # config: + # host: "_env:LDAPHOST:" + # tls: "_env:LDAPTLS:" + # port: "_env:LDAPPORT:389" + # user: "_env:LDAPUSER:" + # pass: "_env:LDAPPASS:" + # baseDN: "_env:LDAPBASE:" + # scope: "_env:LDAPSCOPE:WholeSubtree" + # timeout: "_env:LDAPTIMEOUT:5" + # search-timeout: "_env:LDAPSEARCHTIME:5" + # pool: + # stripes: "_env:LDAPSTRIPES:1" + # timeout: "_env:LDAPTIMEOUT:20" + # limit: "_env:LDAPLIMIT:10" userdb-retest-failover: 60 userdb-sync-within: "_env:USERDB_SYNC_WITHIN:1209600" # 14 Tage in Sekunden userdb-sync-interval: "_env:USERDB_SYNC_INTERVAL:3600" # jede Stunde - lms-direct: upload-header: "_env:LMSUPLOADHEADER:true" upload-delimiter: "_env:LMSUPLOADDELIMITER:" diff --git a/src/Jobs/Crontab.hs b/src/Jobs/Crontab.hs index f1f391f19..3f38e7724 100644 --- a/src/Jobs/Crontab.hs +++ b/src/Jobs/Crontab.hs @@ -311,9 +311,8 @@ determineCrontab = execWriterT $ do if -- TODO: generalize user sync job to oauth - | is _Just appUserDbConf - , Just syncWithin <- appUserdbSyncWithin - , Just cInterval <- appJobCronInterval + | Just syncWithin <- appUserdbSyncWithin + , Just cInterval <- appJobCronInterval -> do nextIntervals <- getNextIntervals syncWithin appUserdbSyncInterval cInterval diff --git a/src/Settings.hs b/src/Settings.hs index 2d811865c..177ae6611 100644 --- a/src/Settings.hs +++ b/src/Settings.hs @@ -48,7 +48,7 @@ import Data.Word (Word16) import qualified Data.Text as Text -import qualified Ldap.Client as Ldap +-- import qualified Ldap.Client as Ldap import qualified Network.HaskellNet.Auth as HaskellNet (UserName, Password, AuthType(..)) import qualified Network.Socket as HaskellNet @@ -79,7 +79,7 @@ import qualified Web.ServerSession.Core as ServerSession import Text.Show (showParen, showString) -import qualified Data.List.PointedList as P +-- import qualified Data.List.PointedList as P import qualified Network.Minio as Minio @@ -142,10 +142,22 @@ instance FromJSON PWHashConf where return PWHashConf{..} -data UserDbConf = UserDbLdap LdapConf | UserDbOAuth2 OAuth2Conf +data UserDbConf' = UserDbLdap LdapConf | UserDbOAuth2 OAuth2Conf deriving (Show) -makePrisms ''UserDbConf +data UserDbConf = + UserDbSimple -- ^ use only one specific source + { userdbSource :: UserDbConf' + } + -- TODO: other modes yet to be implemented + -- | UserDbFailover -- ^ use only one user source at a time, but failover to the next-best database if the current source is unavailable + -- { userdbFailoverSources :: PointedList UserDbConf + -- , userDbFailoverRetest :: NominalDiffTime + -- } + -- | UserDbMerge -- ^ Multiple coequal user sources + -- { userdbMergeSources :: Set UserDbConf + -- } + deriving (Show) data LmsConf = LmsConf { lmsUploadHeader :: Bool @@ -297,10 +309,23 @@ pathPieceJSONKey ''SettingBotMitigation makePrisms ''JobMode makeLenses_ ''JobMode +makePrisms ''UserDbConf' +makeLenses_ ''UserDbConf +makePrisms ''UserDbConf + deriveFromJSON defaultOptions { constructorTagModifier = toLower . dropPrefix "UserDb" , sumEncoding = TaggedObject "protocol" "config" - } ''UserDbConf + } ''UserDbConf' + +instance FromJSON UserDbConf where + parseJSON = withObject "UserDbConf" $ \o -> do + mode <- o .: "mode" + case mode of + "simple" -> do + userdbSource <- o .: "config" + return UserDbSimple{..} + other -> error $ "Unsupported user database mode: " <> other instance FromJSON HaskellNet.PortNumber where parseJSON = withScientific "PortNumber" $ \sciNum -> case Scientific.toBoundedInteger sciNum of @@ -428,7 +453,7 @@ data AppSettings = AppSettings , appDatabaseConf :: PostgresConf -- ^ Configuration settings for accessing the database. , appAutoDbMigrate :: Bool - , appUserDbConf :: Maybe (PointedList UserDbConf) + , appUserDbConf :: UserDbConf -- ^ Configuration settings for CSV export/import to LMS (= Learn Management System) , appLmsConf :: LmsConf -- ^ Configuration settings for accessing the LDAP-directory @@ -599,11 +624,12 @@ instance FromJSON AppSettings where appWebpackEntrypoints <- o .: "webpack-manifest" appDatabaseConf <- o .: "database" appAutoDbMigrate <- o .: "auto-db-migrate" - let nonEmptyHost (UserDbLdap LdapConf{..}) = case ldapHost of - Ldap.Tls host _ -> not $ null host - Ldap.Plain host -> not $ null host - nonEmptyHost (UserDbOAuth2 OAuth2Conf{..}) = not $ or [ null oauth2TenantId, null oauth2ClientId, null oauth2ClientSecret ] - appUserDbConf <- P.fromList . mapMaybe (assertM nonEmptyHost) <$> o .:? "user-database" .!= [] + -- let nonEmptyHost (UserDbLdap LdapConf{..}) = case ldapHost of + -- Ldap.Tls host _ -> not $ null host + -- Ldap.Plain host -> not $ null host + -- nonEmptyHost (UserDbOAuth2 OAuth2Conf{..}) = not $ or [ null oauth2TenantId, null oauth2ClientId, null oauth2ClientSecret ] + appUserDbConf <- o .: "user-database" + -- P.fromList . mapMaybe (assertM nonEmptyHost) <$> o .:? "user-database" .!= [] appLmsConf <- o .: "lms-direct" appAvsConf <- assertM (not . null . avsPass) <$> o .:? "avs" appLprConf <- o .: "lpr"