diff --git a/src/Handler/LMS.hs b/src/Handler/LMS.hs index 8deee987b..a96d005ee 100644 --- a/src/Handler/LMS.hs +++ b/src/Handler/LMS.hs @@ -449,7 +449,7 @@ postLmsR sid qsh = do where -- i18nLms :: (RenderMessage UniWorX msg, IsDBTable m a) => msg -> DBCell m a i18nLms msg = cell [whamlet|LMS #|] <> i18nCell msg - psValidator = def + psValidator = def -- TODO: hier einen Filter für Schützlinge einbauen tbl <- mkLmsTable qent acts (const E.true) colChoices psValidator return (tbl, qent) diff --git a/src/Handler/Utils/FakeUsers.hs b/src/Handler/Utils/FakeUsers.hs new file mode 100644 index 000000000..b97527ec8 --- /dev/null +++ b/src/Handler/Utils/FakeUsers.hs @@ -0,0 +1,115 @@ +module Handler.Utils.FakeUsers + ( fakeQualificationUsers + ) where + +import Import + +import qualified Data.CaseInsensitive as CI +import qualified Data.Text as Text +import qualified Data.Text.Encoding as TEnc +import qualified Yesod.Auth.Util.PasswordStore as PWStore +import Control.Applicative (ZipList(..), getZipList) + + +import Handler.Utils.DateTime + + +-- | indefinitely repeat a list, from Prelude +cycle :: [a] -> [a] +cycle [] = [] +cycle xs = xs' where xs' = xs ++ xs' + + +fakeQualificationUsers :: QualificationId -> Int -> (Day,Day) -> DB Int +fakeQualificationUsers qid usersPerDay (dfrom, dto) = do + now <- liftIO getCurrentTime + UserDefaultConf{..} <- getsYesod $ view _appUserDefaults + pwSimple <- do + let pw = "123.456" + PWHashConf{..} <- getsYesod $ view _appAuthPWHash + pwHash <- liftIO $ PWStore.makePasswordWith pwHashAlgorithm pw pwHashStrength + return $ AuthPWHash $ TEnc.decodeUtf8 pwHash + let expiryOffsets = concatMap (replicate usersPerDay) [0..(diffDays dfrom dto)] + + fakeUser :: ([Text], UserSurname, (Maybe Languages, DateTimeFormat, DateTimeFormat, DateTimeFormat), Bool) -> User + fakeUser (firstNames, userSurname, (userLanguages, userDateTimeFormat, userDateFormat, userTimeFormat), userPrefersPostal) = + let userIdent = CI.mk $ Text.intercalate "." (take 1 firstNames ++ [userSurname]) <> "@example.com" + userDisplayName = Text.unwords $ firstNames <> [userSurname] + userEmail = CI.mk "s.jost@fraport.de" -- test that email is truly recieved + userDisplayEmail = userIdent + userMatrikelnummer = Just "TESTUSER" + userAuthentication = pwSimple + userLastAuthentication = Nothing + userCreated = now + userLastLdapSynchronisation = Nothing + userLdapPrimaryKey = Nothing + userTokensIssuedAfter = Nothing + userFirstName = Text.unwords firstNames + userTitle = Nothing + userMaxFavourites = userDefaultMaxFavourites + userMaxFavouriteTerms = userDefaultMaxFavourites + userTheme = userDefaultTheme + userDownloadFiles = userDefaultDownloadFiles + userWarningDays = userDefaultWarningDays + userExamOfficeGetSynced = userDefaultExamOfficeGetSynced + userExamOfficeGetLabels = userDefaultExamOfficeGetLabels + userNotificationSettings = def + userCsvOptions = def + userSex = Nothing + userShowSex = userDefaultShowSex + userTelephone = Nothing + userMobile = Nothing + userCompanyPersonalNumber = Nothing + userCompanyDepartment = Nothing + userPostAddress = postalAddress + in User{..} + + valid <- forM (zip expiryOffsets names) $ \(expOffset, user) -> do + muid <- insertUnique $ fakeUser user + case muid of + Nothing -> return 0 + (Just uid) -> do + let qualificationUserUser = uid + qualificationUserQualification = qid + qualificationUserValidUntil = addDays expOffset dfrom + qualificationUserFirstHeld = setYear (getYear qualificationUserValidUntil - 2) qualificationUserValidUntil + qualificationUserLastRefresh = qualificationUserFirstHeld + ok <- insertUnique QualificationUser{..} + return $ maybe 0 (const 1) ok + return $ sum valid + + where + postalAddress = Just $ plaintextToStoredMarkup $ Text.unlines ["Kapazitätsmanagement Airside (AVN-AR2) - FDTest", "Flughafen Frankfurt Main", "60547 Frankfurt am Main"] + givenNames = [ "James", "John", "Robert", "Michael" + , "William", "David", "Mary", "Richard" + , "Joseph", "Thomas", "Charles", "Daniel" + , "Matthew", "Patricia", "Jennifer", "Linda" + , "Elizabeth", "Barbara", "Anthony", "Donald" + , "Mark", "Paul", "Steven", "Andrew" + , "Kenneth", "Joshua", "George", "Kevin" + , "Brian", "Edward", "Susan", "Ronald" + ] + middlenames = [ Nothing, Nothing, Just ["Tiberius"], Nothing, Just ["Jamesson", "Maria"], Nothing, Just ["Jörg"] ] + surnames = [ "Müller", "Smith", "Johnson", "Williams", "Brown" + , "Jones", "Miller", "Davis", "Garcia" + , "Rodriguez", "Wilson", "Martinez", "Anderson" + , "Taylor", "Thomas", "Hernandez", "Moore" + , "Martin", "Jackson", "Thompson", "White" + , "Lopez", "Lee", "Gonzalez", "Harris" + , "Clark", "Lewis", "Robinson", "Walker" + , "Perez", "Hall", "Young", "Allen" + ] + someLangs = [ (Just $ Languages ["de-de"] , DateTimeFormat "%a %d %b %Y %T", DateTimeFormat "%a %d.%m.%Y", DateTimeFormat "%T") + , (Nothing , DateTimeFormat "%d.%m.%y %R" , DateTimeFormat "%d.%m.%y" , DateTimeFormat "%R") + , (Just $ Languages ["en-eu","de"], DateTimeFormat "%a %d %b %Y %T", DateTimeFormat "%b %d %y" , DateTimeFormat "%I:%M %p") + , (Just $ Languages ["fr"] , DateTimeFormat "%d-%m-%Y %R" , DateTimeFormat "%d-%m-%Y" , DateTimeFormat "%R") + , (Just $ Languages ["fr","en"] , DateTimeFormat "%B %d %Y %R" , DateTimeFormat "%B %d %y" , DateTimeFormat "%I:%M:%S %p") + ] + postal = [False, True, False] + + names = getZipList $ (\f m s l p -> (f : concat m, s, l, p)) + <$> ZipList (cycle givenNames) + <*> ZipList (cycle middlenames) + <*> ZipList (cycle surnames) + <*> ZipList (cycle someLangs) + <*> ZipList (cycle postal) diff --git a/src/Model/Types/Avs.hs b/src/Model/Types/Avs.hs index 569403d5b..237803524 100644 --- a/src/Model/Types/Avs.hs +++ b/src/Model/Types/Avs.hs @@ -250,15 +250,15 @@ hasAddress AvsDataPersonCard{..} = isJust avsDataStreet && isJust avsDataCity && pickLicenceAddress :: AvsDataPersonCard -> AvsDataPersonCard -> AvsDataPersonCard pickLicenceAddress a b - | Just r <- pickBetter' hasAddress = r -- prefer card with complete address - | Just r <- pickBetter' avsDataValid = r -- prefer valid cards - | Just r <- pickBetter' (Set.member licenceRollfeld . avsDataCardAreas) = r -- prefer 'R' cards - | Just r <- pickBetter' (Set.member licenceVorfeld . avsDataCardAreas) = r -- prefer 'F' cards + | Just r <- pickBetter' hasAddress = r -- prefer card with complete address + | Just r <- pickBetter' avsDataValid = r -- prefer valid cards + | Just r <- pickBetter' (Set.member licenceRollfeld . avsDataCardAreas) = r -- prefer 'R' cards + | Just r <- pickBetter' (Set.member licenceVorfeld . avsDataCardAreas) = r -- prefer 'F' cards | avsDataIssueDate a > avsDataIssueDate b = a -- prefer later issue date | avsDataIssueDate a < avsDataIssueDate b = b | avsDataValidTo a > avsDataValidTo b = a -- prefer later validto date | avsDataValidTo a < avsDataValidTo b = b - | Just r <- pickBetter' (isJust . avsDataFirm) = r -- prefer having a firm + | Just r <- pickBetter' (isJust . avsDataFirm) = r -- prefer having a firm | a <= b = b -- respect natural Ord instance | otherwise = a where @@ -266,16 +266,12 @@ pickLicenceAddress a b pickBetter' = pickBetter a b {- Note: - -Since Ordering is a Semigroup that ignores the righthand side except for EQ, this can be conveniently be used like so - +For Semigroup Ordering, (<>) ignores the righthand side except for EQ; this can be conveniently be used like so bestAddress :: AvsDataPersonCard -> AvsDataPersonCard -> Ordering - compare a b = - compareBy avsDataValid - <> compareBy avsDataValidTo - <> compareBy avsDataIssueDate - + compare a b = compareBy avsDataValid + <> compareBy avsDataValidTo + <> compareBy avsDataIssueDate + ... where compareBy f = compare `on` f a b - -} \ No newline at end of file diff --git a/templates/letter/fraport_renewal.md b/templates/letter/fraport_renewal.md index 0d89eaafd..67467b034 100644 --- a/templates/letter/fraport_renewal.md +++ b/templates/letter/fraport_renewal.md @@ -6,7 +6,7 @@ en-subject: Renewal of apron driving License author: Fraport AG - Fahrerausbildung (AVN-AR) phone: +49 69 690-30306 email: fahrerausbildung@fraport.de -url: +url: place: Frankfurt/Main return-address: - 60547 Frankfurt