fraport/fradrive
3
0
Fork 0
Code Issues Pull Requests Actions Packages Projects Releases Wiki Activity

feat(study-features): cache study features term relevance

Browse Source
This commit is contained in:
Gregor Kleen 2020-10-06 12:31:32 +02:00
parent beef9ee6a6
commit 8f6d54d012
7 changed files with 117 additions and 55 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

58
models/study-features.model Normal file
View File

@ -0,0 +1,58 @@
StudyFeatures -- multiple entries possible for students pursuing several degrees at once, usually created upon LDAP login
user UserId
degree StudyDegreeId -- Abschluss, i.e. Master, Bachelor, etc.
field StudyTermsId -- Fach, i.e. Informatics, Philosophy, etc.
superField StudyTermsId Maybe
type StudyFieldType -- Major or minor, i.e. Haupt-/Nebenfach
semester Int
firstObserved UTCTime Maybe
lastObserved UTCTime default=now() -- last update from LDAP
valid Bool default=true
relevanceCached Bool default=false
UniqueStudyFeatures user degree field type semester
deriving Eq Show
-- UniqueUserSubject ubuser degree field -- There exists a counterexample
RelevantStudyFeatures
term TermId
studyFeatures StudyFeaturesId
UniqueRelevantStudyFeatures term studyFeatures
StudyDegree -- Studienabschluss
key Int -- LMU-internal key
shorthand Text Maybe -- admin determined shorthand
name Text Maybe -- description given by LDAP
Primary key -- column key is used as actual DB row key
-- newtype Key StudyDegree = StudyDegreeKey' { unStudyDegreeKey :: Int }
deriving Eq Show
StudyTerms -- Studiengang
key Int -- standardised key
shorthand Text Maybe -- admin determined shorthand
name Text Maybe -- description given by LDAP
defaultDegree StudyDegreeId Maybe
defaultType StudyFieldType Maybe
Primary key -- column key is used as actual DB row key
-- newtype Key StudyTerms = StudyTermsKey' { unStudyTermsKey :: Int }
deriving Eq Ord Show
StudySubTerms
child StudyTermsId
parent StudyTermsId
UniqueStudySubTerms child parent
StudyTermNameCandidate -- No one at LMU is willing and able to tell us the meaning of the keys for StudyDegrees and StudyTerms.
-- Each LDAP login provides an unordered set of keys and an unordered set of plain text description with an unknown 1-1 correspondence.
-- This table helps us to infer which key belongs to which plain text by recording possible combinations at login.
-- If a login provides n keys and n plan texts, then n^2 rows with the same incidence are created, storing all combinations
incidence TermCandidateIncidence -- random id, generated once per login to associate matching pairs
key Int -- a possible key for the studyTermName or studySubTermName
name Text -- studyTermName as plain text from LDAP
deriving Show Eq Ord
StudySubTermParentCandidate
incidence TermCandidateIncidence
key Int
parent Int
deriving Show Eq Ord
StudyTermStandaloneCandidate
incidence TermCandidateIncidence
key Int
deriving Show Eq Ord

51
models/users.model
View File

@ -38,6 +38,7 @@ User json -- Each Uni2work user has a corresponding row in this table; create
UniqueAuthentication ident -- Column 'ident' can be used as a row-key in this table
UniqueEmail email -- Column 'email' can be used as a row-key in this table
deriving Show Eq Ord Generic -- Haskell-specific settings for runtime-value representing a row in memory
UserFunction -- Administratively assigned functions (lecturer, admin, evaluation, ...)
user UserId
school SchoolId
@ -58,56 +59,6 @@ UserSchool -- Managed by users themselves, encodes "schools of interest"
school SchoolId
isOptOut Bool -- true if this a marker, that the user manually deleted this entry; it should not be recreated automatically
UniqueUserSchool user school
StudyFeatures -- multiple entries possible for students pursuing several degrees at once, usually created upon LDAP login
user UserId
degree StudyDegreeId -- Abschluss, i.e. Master, Bachelor, etc.
field StudyTermsId -- Fach, i.e. Informatics, Philosophy, etc.
superField StudyTermsId Maybe
type StudyFieldType -- Major or minor, i.e. Haupt-/Nebenfach
semester Int
firstObserved UTCTime Maybe
lastObserved UTCTime default=now() -- last update from LDAP
valid Bool default=true
UniqueStudyFeatures user degree field type semester
deriving Eq Show
-- UniqueUserSubject ubuser degree field -- There exists a counterexample
StudyDegree -- Studienabschluss
key Int -- LMU-internal key
shorthand Text Maybe -- admin determined shorthand
name Text Maybe -- description given by LDAP
Primary key -- column key is used as actual DB row key
-- newtype Key StudyDegree = StudyDegreeKey' { unStudyDegreeKey :: Int }
deriving Eq Show
StudyTerms -- Studiengang
key Int -- standardised key
shorthand Text Maybe -- admin determined shorthand
name Text Maybe -- description given by LDAP
defaultDegree StudyDegreeId Maybe
defaultType StudyFieldType Maybe
Primary key -- column key is used as actual DB row key
-- newtype Key StudyTerms = StudyTermsKey' { unStudyTermsKey :: Int }
deriving Eq Ord Show
StudySubTerms
child StudyTermsId
parent StudyTermsId
UniqueStudySubTerms child parent
StudyTermNameCandidate -- No one at LMU is willing and able to tell us the meaning of the keys for StudyDegrees and StudyTerms.
-- Each LDAP login provides an unordered set of keys and an unordered set of plain text description with an unknown 1-1 correspondence.
-- This table helps us to infer which key belongs to which plain text by recording possible combinations at login.
-- If a login provides n keys and n plan texts, then n^2 rows with the same incidence are created, storing all combinations
incidence TermCandidateIncidence -- random id, generated once per login to associate matching pairs
key Int -- a possible key for the studyTermName or studySubTermName
name Text -- studyTermName as plain text from LDAP
deriving Show Eq Ord
StudySubTermParentCandidate
incidence TermCandidateIncidence
key Int
parent Int
deriving Show Eq Ord
StudyTermStandaloneCandidate
incidence TermCandidateIncidence
key Int
deriving Show Eq Ord
UserGroupMember
group UserGroupName

2
shell.nix
View File

@ -45,7 +45,7 @@ let
pgSockDir=$(mktemp -d)
pgLogFile=$(mktemp)
initdb --no-locale -D ''${pgDir}
pg_ctl start -D ''${pgDir} -l ''${pgLogFile} -w -o "-k ''${pgSockDir} -c listen_addresses=''' -c hba_file='${postgresHba}' -c unix_socket_permissions=0700 -c max_connections=9990"
pg_ctl start -D ''${pgDir} -l ''${pgLogFile} -w -o "-k ''${pgSockDir} -c listen_addresses=''' -c hba_file='${postgresHba}' -c unix_socket_permissions=0700 -c max_connections=9990 -c shared_preload_libraries=pg_stat_statements -c auto_explain.log_min_duration=100ms"
export PGHOST=''${pgSockDir} PGLOG=''${pgLogFile}
psql -f ${postgresSchema} postgres
printf "Postgres logfile is %s\nPostgres socket directory is %s\n" ''${pgLogFile} ''${pgSockDir}

16
src/Foundation/Yesod/Auth.hs
View File

@ -343,7 +343,19 @@ upsertCampusUser upsertMode ldapData = do
, Just defType <- studyTermsDefaultType
-> do
$logDebugS "Campus" [st|Applying default for standalone study term “#{tshow subterm}”|]
(:) (StudyFeatures userId defDegree subterm Nothing defType subSemester (Just now) now True) <$> assimilateSubTerms subterms unusedFeats
let sf = StudyFeatures
{ studyFeaturesUser = userId
, studyFeaturesDegree = defDegree
, studyFeaturesField = subterm
, studyFeaturesSuperField = Nothing
, studyFeaturesType = defType
, studyFeaturesSemester = subSemester
, studyFeaturesFirstObserved = Just now
, studyFeaturesLastObserved = now
, studyFeaturesValid = True
, studyFeaturesRelevanceCached = False
}
(sf :) <$> assimilateSubTerms subterms unusedFeats
Nothing
| [] <- unusedFeats -> do
$logDebugS "Campus" [st|Saw subterm “#{tshow subterm}” when no fos-terms remain|]
@ -418,6 +430,8 @@ upsertCampusUser upsertMode ldapData = do
]
associateUserSchoolsByTerms userId
cacheStudyFeatureRelevance $ \studyFeatures -> studyFeatures E.^. StudyFeaturesUser E.==. E.val userId
let
userAssociatedSchools = concat <$> forM userAssociatedSchools' parseLdapSchools
userAssociatedSchools' = do

38
src/Handler/Utils/StudyFeatures.hs
View File

@ -4,7 +4,8 @@ module Handler.Utils.StudyFeatures
, _userTableField, _userTableDegree, _userTableSemester, _userTableFieldType
, UserTableStudyFeatures(..)
, _UserTableStudyFeatures
, isRelevantStudyFeature
, isRelevantStudyFeature, isRelevantStudyFeatureCached
, cacheStudyFeatureRelevance
, isCourseStudyFeature, courseUserStudyFeatures
, isExternalExamStudyFeature, externalExamUserStudyFeatures
) where
@ -24,6 +25,7 @@ import qualified Data.Set as Set
import Data.RFC5051 (compareUnicode)
import qualified Database.Esqueleto as E
import qualified Database.Esqueleto.PostgreSQL as E
import qualified Database.Esqueleto.Utils as E
@ -109,8 +111,38 @@ isRelevantStudyFeature termField record studyFeatures
E.where_ $ E.abs (studyFeatures' E.^. StudyFeaturesSemester E.-. studyFeatures E.^. StudyFeaturesSemester) E.==. E.val 1
E.&&. overlap studyFeatures' E.>. overlap studyFeatures
isRelevantStudyFeatureCached :: PersistEntity record
=> EntityField record TermId
-> E.SqlExpr (Entity record)
-> E.SqlExpr (Entity StudyFeatures)
-> E.SqlExpr (E.Value Bool)
isRelevantStudyFeatureCached termField record studyFeatures
= E.bool calcNow useCache $ studyFeatures E.^. StudyFeaturesRelevanceCached
where
useCache
= E.exists . E.from $ \relevantStudyFeatures ->
E.where_ $ relevantStudyFeatures E.^. RelevantStudyFeaturesTerm E.==. record E.^. termField
E.&&. relevantStudyFeatures E.^. RelevantStudyFeaturesStudyFeatures E.==. studyFeatures E.^. StudyFeaturesId
calcNow = isRelevantStudyFeature termField record studyFeatures
cacheStudyFeatureRelevance :: MonadIO m
=> (E.SqlExpr (Entity StudyFeatures) -> E.SqlExpr (E.Value Bool))
-> SqlPersistT m ()
cacheStudyFeatureRelevance fFilter = do
E.insertSelectWithConflict UniqueRelevantStudyFeatures
( E.from $ \(studyFeatures `E.InnerJoin` term) -> do
E.on E.true
E.where_ $ fFilter studyFeatures
E.where_ $ isRelevantStudyFeature TermId term studyFeatures
return $ RelevantStudyFeatures E.<# (term E.^. TermId) E.<&> (studyFeatures E.^. StudyFeaturesId)
)
( \_current _excluded -> [] )
E.update $ \studyFeatures -> do
E.set studyFeatures [ StudyFeaturesRelevanceCached E.=. E.true ]
E.where_ $ fFilter studyFeatures
isCourseStudyFeature :: E.SqlExpr (Entity Course) -> E.SqlExpr (Entity StudyFeatures) -> E.SqlExpr (E.Value Bool)
isCourseStudyFeature = isRelevantStudyFeature CourseTerm
isCourseStudyFeature = isRelevantStudyFeatureCached CourseTerm
courseUserStudyFeatures :: MonadIO m => CourseId -> UserId -> SqlPersistT m UserTableStudyFeatures
courseUserStudyFeatures cId uid = do
@ -130,7 +162,7 @@ courseUserStudyFeatures cId uid = do
}
isExternalExamStudyFeature :: E.SqlExpr (Entity ExternalExam) -> E.SqlExpr (Entity StudyFeatures) -> E.SqlExpr (E.Value Bool)
isExternalExamStudyFeature = isRelevantStudyFeature ExternalExamTerm
isExternalExamStudyFeature = isRelevantStudyFeatureCached ExternalExamTerm
externalExamUserStudyFeatures :: MonadIO m => ExternalExamId -> UserId -> SqlPersistT m UserTableStudyFeatures
externalExamUserStudyFeatures eeId uid = do

1
src/Handler/Utils/StudyFeatures/Parse.hs
View File

@ -43,6 +43,7 @@ pStudyFeatures studyFeaturesUser now = do
studyFeaturesSuperField = Nothing
studyFeaturesFirstObserved = Just now
studyFeaturesLastObserved = now
studyFeaturesRelevanceCached = False
return StudyFeatures{..}
pStudyFeature `sepBy1` char '#'

6
test/Database/Fill.hs
View File

@ -491,6 +491,7 @@ fillDb = do
(Just now)
now
True
False
insert_ $ StudyFeatures
maxMuster
sdBsc
@ -501,6 +502,7 @@ fillDb = do
(Just now)
now
True
False
insert_ $ StudyFeatures
tinaTester
sdBsc
@ -511,6 +513,7 @@ fillDb = do
(Just now)
now
False
False
insert_ $ StudyFeatures
tinaTester
sdLAG
@ -521,6 +524,7 @@ fillDb = do
(Just now)
now
True
False
insert_ $ StudyFeatures
tinaTester
sdLAR
@ -531,6 +535,7 @@ fillDb = do
(Just now)
now
True
False
insert_ $ StudyFeatures
tinaTester
sdMst
@ -541,6 +546,7 @@ fillDb = do
(Just now)
now
True
False
-- FFP
let nbrs :: [Int]