chore: user sources
This commit is contained in:
parent
e9bbeffd7e
commit
d4a3459adf
@ -128,9 +128,9 @@ database:
|
||||
|
||||
auto-db-migrate: '_env:AUTO_DB_MIGRATE:true'
|
||||
|
||||
# External databases used for authentication and userdata lookups
|
||||
user-database:
|
||||
mode: single-source
|
||||
# External sources used for authentication and userdata lookups
|
||||
user-source:
|
||||
# mode: single-source
|
||||
protocol: azureadv2
|
||||
config:
|
||||
client-id: "_env:AZURECLIENTID:00000000-0000-0000-0000-000000000000"
|
||||
@ -149,14 +149,15 @@ user-database:
|
||||
# timeout: "_env:LDAPTIMEOUT:5"
|
||||
# search-timeout: "_env:LDAPSEARCHTIME:5"
|
||||
|
||||
# TODO: might move later
|
||||
ldap-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
|
||||
# user-retest-failover: 60
|
||||
user-sync-within: "_env:USER_SYNC_WITHIN:1209600" # 14 Tage in Sekunden
|
||||
user-sync-interval: "_env:USER_SYNC_INTERVAL:3600" # jede Stunde
|
||||
|
||||
lms-direct:
|
||||
upload-header: "_env:LMSUPLOADHEADER:true"
|
||||
|
||||
@ -246,7 +246,7 @@ makeFoundation appSettings''@AppSettings{..} = do
|
||||
(error "appSettings' forced in tempFoundation")
|
||||
(error "connPool forced in tempFoundation")
|
||||
(error "smtpPool forced in tempFoundation")
|
||||
(error "userdbPool forced in tempFoundation")
|
||||
(error "ldapPool forced in tempFoundation")
|
||||
(error "cryptoIDKey forced in tempFoundation")
|
||||
(error "sessionStore forced in tempFoundation")
|
||||
(error "secretBoxKey forced in tempFoundation")
|
||||
@ -314,8 +314,8 @@ makeFoundation appSettings''@AppSettings{..} = do
|
||||
|
||||
-- TODO: reintroduce failover once UserDbFailover is implemented (see above)
|
||||
ldapPool <- forOf (traverse . traverse) appLdapPoolConf $ \RessourcePoolConf{..} -> if
|
||||
| UserDbSingleSource{..} <- appUserDbConf
|
||||
, UserDbLdap LdapConf{..} <- userdbSingleSource
|
||||
| UserSourceConfSingleSource{..} <- appUserSourceConf
|
||||
, UserSourceLdap LdapConf{..} <- usersrcSingleSource
|
||||
-> do -- set up a singleton ldap pool with no failover
|
||||
let ldapLabel = case ldapHost of
|
||||
Ldap.Plain str -> pack str <> ":" <> tshow ldapPort
|
||||
@ -421,7 +421,7 @@ makeFoundation appSettings''@AppSettings{..} = do
|
||||
$logDebugS "Runtime configuration" $ tshowCrop appSettings'
|
||||
|
||||
-- TODO: reimplement user db failover
|
||||
let foundation = mkFoundation appSettings' sqlPool smtpPool userdbPool appCryptoIDKey appSessionStore appSecretBoxKey appWidgetMemcached appJSONWebKeySet appClusterID appMemcached appMemcachedLocal appUploadCache appVerpSecret appAuthKey appAuthPlugins appPersonalisedSheetFilesSeedKey appVolatileClusterSettingsCache appAvsQuery
|
||||
let foundation = mkFoundation appSettings' sqlPool smtpPool ldapPool appCryptoIDKey appSessionStore appSecretBoxKey appWidgetMemcached appJSONWebKeySet appClusterID appMemcached appMemcachedLocal appUploadCache appVerpSecret appAuthKey appAuthPlugins appPersonalisedSheetFilesSeedKey appVolatileClusterSettingsCache appAvsQuery
|
||||
|
||||
-- Return the foundation
|
||||
$logInfoS "setup" "*** DONE ***"
|
||||
|
||||
@ -101,14 +101,14 @@ authenticate creds@Creds{..} = liftHandler . runDB . withReaderT projectBackend
|
||||
|
||||
$logDebugS "auth" $ tshow Creds{..}
|
||||
|
||||
userdbConf <- getsYesod $ view _appUserDbConf
|
||||
flip catches excHandlers $ case userdbConf of
|
||||
UserDbSingleSource (UserDbAzureAdV2 azureConf)
|
||||
userSourceConf <- getsYesod $ view _appUserSourceConf
|
||||
flip catches excHandlers $ case userSourceConf of
|
||||
UserSourceConfSingleSource (UserSourceAzureAdV2 azureConf)
|
||||
| Just upsertMode' <- upsertMode -> do
|
||||
azureData <- oauth2User azureConf Creds{..}
|
||||
azureData <- azureUser azureConf Creds{..}
|
||||
$logDebugS "AuthAzure" $ "Successful Azure lookup: " <> tshow azureData
|
||||
Authenticated . entityKey <$> upsertAzureUser upsertMode' azureData
|
||||
UserDbSingleSource (UserDbLdap _)
|
||||
UserSourceConfSingleSource (UserSourceLdap _)
|
||||
| Just upsertMode' <- upsertMode -> do
|
||||
-- TODO WIP
|
||||
ldapPool <- fmap (fromMaybe $ error "No LDAP Pool") . getsYesod $ view _appLdapPool
|
||||
|
||||
@ -45,8 +45,8 @@ dispatchJobSynchroniseUserdb numIterations epoch iteration
|
||||
dispatchJobSynchroniseUserdbUser :: UserId -> JobHandler UniWorX
|
||||
dispatchJobSynchroniseUserdbUser jUser = JobHandlerException $ do
|
||||
UniWorX{..} <- getYesod
|
||||
case appUserDbConf of
|
||||
UserDbSingleSource (UserDbLdap ldapConf) ->
|
||||
case appUserSourceConf of
|
||||
UserSourceConfSingleSource (UserSourceLdap ldapConf) ->
|
||||
runDB . void . runMaybeT . handleExc $ do
|
||||
user@User{userIdent,userLdapPrimaryKey} <- MaybeT $ get jUser
|
||||
let upsertIdent = maybe userIdent CI.mk userLdapPrimaryKey
|
||||
@ -55,12 +55,12 @@ dispatchJobSynchroniseUserdbUser jUser = JobHandlerException $ do
|
||||
-- ldapAttrs <- MaybeT $ campusUserReTest' ldapConf ((>= reTestAfter) . realToFrac) FailoverUnlimited user
|
||||
ldapAttrs <- MaybeT $ campusUserReTest' ldapConf ((>= reTestAfter) . realToFrac) FailoverUnlimited user
|
||||
void . lift $ upsertLdapUser (UpsertLdapUserLdapSync upsertIdent) ldapAttrs
|
||||
UserDbSingleSource (UserDbOAuth2 oauth2Conf) ->
|
||||
UserSourceConfSingleSource (UserSourceAzure azureConf) ->
|
||||
runDB . void . runMaybeT . handleExc $ do
|
||||
user@User{userIdent,userAzurePrimaryKey} <- MaybeT $ get jUser
|
||||
let upsertIdent = maybe userIdent CI.mk userAzurePrimaryKey
|
||||
$logInfoS "SynchroniseUserdb" [st|Synchronising #{upsertIdent} with Azure|]
|
||||
void . lift $ upsertAzureUser (UpsertAzureUserSync upsertIdent) oauth2Conf
|
||||
void . lift $ upsertAzureUser (UpsertAzureUserSync upsertIdent) azureConf
|
||||
where
|
||||
handleExc :: MaybeT DB a -> MaybeT DB a
|
||||
handleExc
|
||||
|
||||
@ -142,20 +142,20 @@ instance FromJSON PWHashConf where
|
||||
return PWHashConf{..}
|
||||
|
||||
|
||||
data UserDbConf' = UserDbLdap LdapConf | UserDbAzureAdV2 AzureConf
|
||||
data UserSource = UserSourceLdap LdapConf | UserSourceAzureAdV2 AzureConf
|
||||
deriving (Show)
|
||||
|
||||
data UserDbConf =
|
||||
UserDbSingleSource -- ^ use only one specific source
|
||||
{ userdbSingleSource :: UserDbConf'
|
||||
data UserSourceConf =
|
||||
UserSourceConfSingleSource -- ^ use only one specific source
|
||||
{ usersrcSingleSource :: UserSource
|
||||
}
|
||||
-- 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
|
||||
-- | UserFailover -- ^ use only one user source at a time, but failover to the next-best database if the current source is unavailable
|
||||
-- { usersrcFailoverSources :: PointedList UserSource
|
||||
-- , usersrcFailoverRetest :: NominalDiffTime
|
||||
-- }
|
||||
-- | UserDbMultiSource -- ^ Multiple coequal user sources
|
||||
-- { userdbMultiSources :: Set UserDbConf
|
||||
-- | UserMultiSource -- ^ Multiple coequal user sources
|
||||
-- { usersrcMultiSources :: Set UserSource
|
||||
-- }
|
||||
deriving (Show)
|
||||
|
||||
@ -309,21 +309,21 @@ pathPieceJSONKey ''SettingBotMitigation
|
||||
makePrisms ''JobMode
|
||||
makeLenses_ ''JobMode
|
||||
|
||||
makePrisms ''UserDbConf'
|
||||
makeLenses_ ''UserDbConf
|
||||
makePrisms ''UserDbConf
|
||||
makePrisms ''UserSource
|
||||
makeLenses_ ''UserSourceConf
|
||||
makePrisms ''UserSourceConf
|
||||
|
||||
deriveFromJSON defaultOptions
|
||||
{ constructorTagModifier = toLower . dropPrefix "UserDb"
|
||||
{ constructorTagModifier = toLower . dropPrefix "UserSource"
|
||||
, sumEncoding = TaggedObject "protocol" "config"
|
||||
} ''UserDbConf'
|
||||
} ''UserSource
|
||||
|
||||
deriveFromJSON defaultOptions
|
||||
{ constructorTagModifier = camelToPathPiece' 1
|
||||
{ constructorTagModifier = camelToPathPiece' 3
|
||||
, fieldLabelModifier = camelToPathPiece' 1
|
||||
, sumEncoding = TaggedObject "mode" "config"
|
||||
, sumEncoding = UntaggedValue -- TaggedObject "mode" "config"
|
||||
, unwrapUnaryRecords = True
|
||||
} ''UserDbConf
|
||||
} ''UserSourceConf
|
||||
|
||||
instance FromJSON HaskellNet.PortNumber where
|
||||
parseJSON = withScientific "PortNumber" $ \sciNum -> case Scientific.toBoundedInteger sciNum of
|
||||
@ -451,7 +451,7 @@ data AppSettings = AppSettings
|
||||
, appDatabaseConf :: PostgresConf
|
||||
-- ^ Configuration settings for accessing the database.
|
||||
, appAutoDbMigrate :: Bool
|
||||
, appUserDbConf :: UserDbConf
|
||||
, appUserSourceConf :: UserSourceConf
|
||||
-- ^ Configuration settings for CSV export/import to LMS (= Learn Management System)
|
||||
, appLmsConf :: LmsConf
|
||||
-- ^ Configuration settings for accessing the LDAP-directory
|
||||
@ -517,9 +517,9 @@ data AppSettings = AppSettings
|
||||
, appHealthCheckHTTPReachableTimeout :: NominalDiffTime
|
||||
, appHealthCheckMatchingClusterConfigTimeout :: NominalDiffTime
|
||||
|
||||
-- , appUserdbRetestFailover :: DiffTime
|
||||
, appUserdbSyncWithin :: Maybe NominalDiffTime
|
||||
, appUserdbSyncInterval :: NominalDiffTime
|
||||
-- , appUserRetestFailover :: DiffTime
|
||||
, appUserSyncWithin :: Maybe NominalDiffTime
|
||||
, appUserSyncInterval :: NominalDiffTime
|
||||
|
||||
, appLdapPoolConf :: Maybe ResourcePoolConf
|
||||
|
||||
@ -628,7 +628,7 @@ instance FromJSON AppSettings where
|
||||
-- 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"
|
||||
appUserSourceConf <- o .: "user-source"
|
||||
-- P.fromList . mapMaybe (assertM nonEmptyHost) <$> o .:? "user-database" .!= []
|
||||
appLdapPoolConf <- o .:? "ldap-pool"
|
||||
appLmsConf <- o .: "lms-direct"
|
||||
@ -695,9 +695,9 @@ instance FromJSON AppSettings where
|
||||
|
||||
appSessionTimeout <- o .: "session-timeout"
|
||||
|
||||
-- appUserdbRetestFailover <- o .: "userdb-retest-failover"
|
||||
appUserdbSyncWithin <- o .:? "userdb-sync-within"
|
||||
appUserdbSyncInterval <- o .: "userdb-sync-interval"
|
||||
-- appUserRetestFailover <- o .: "userdb-retest-failover"
|
||||
appUserSyncWithin <- o .:? "user-sync-within"
|
||||
appUserSyncInterval <- o .: "user-sync-interval"
|
||||
|
||||
appSynchroniseAvsUsersWithin <- o .:? "synchronise-avs-users-within"
|
||||
appSynchroniseAvsUsersInterval <- o .: "synchronise-avs-users-interval"
|
||||
|
||||
Reference in New Issue
Block a user