Merge remote-tracking branch 'origin/fradrive/localmaster'
This commit is contained in:
commit
ac22ab2942
@ -107,7 +107,6 @@ CampusUserInvalidDisplayName: Konnte anhand des Fraport Büko-Logins keinen voll
|
|||||||
CampusUserInvalidGivenName: Konnte anhand des Fraport Büko-Logins keinen Vornamen ermitteln
|
CampusUserInvalidGivenName: Konnte anhand des Fraport Büko-Logins keinen Vornamen ermitteln
|
||||||
CampusUserInvalidSurname: Konnte anhand des Fraport Büko-Logins keinen Nachname ermitteln
|
CampusUserInvalidSurname: Konnte anhand des Fraport Büko-Logins keinen Nachname ermitteln
|
||||||
CampusUserInvalidTitle: Konnte anhand des Fraport Büko-Logins keinen akademischen Titel ermitteln
|
CampusUserInvalidTitle: Konnte anhand des Fraport Büko-Logins keinen akademischen Titel ermitteln
|
||||||
CampusUserInvalidMatriculation: Konnte anhand des Fraport Büko-Logins keine Matrikelnummer ermitteln
|
|
||||||
CampusUserInvalidFeaturesOfStudy parseErr@Text: Konnte anhand des Fraport Büko-Logins keine Studiengänge ermitteln
|
CampusUserInvalidFeaturesOfStudy parseErr@Text: Konnte anhand des Fraport Büko-Logins keine Studiengänge ermitteln
|
||||||
CampusUserInvalidAssociatedSchools parseErr@Text: Konnte anhand des Fraport Büko-Logins keine Institute ermitteln
|
CampusUserInvalidAssociatedSchools parseErr@Text: Konnte anhand des Fraport Büko-Logins keine Institute ermitteln
|
||||||
InvalidCredentialsADNoSuchObject: Benutzereintrag existiert nicht
|
InvalidCredentialsADNoSuchObject: Benutzereintrag existiert nicht
|
||||||
|
|||||||
@ -108,7 +108,6 @@ CampusUserInvalidDisplayName: Could not determine display name during Fraport B
|
|||||||
CampusUserInvalidGivenName: Could not determine given name during Fraport Büko login
|
CampusUserInvalidGivenName: Could not determine given name during Fraport Büko login
|
||||||
CampusUserInvalidSurname: Could not determine surname during Fraport Büko login
|
CampusUserInvalidSurname: Could not determine surname during Fraport Büko login
|
||||||
CampusUserInvalidTitle: Could not determine title during Fraport Büko login
|
CampusUserInvalidTitle: Could not determine title during Fraport Büko login
|
||||||
CampusUserInvalidMatriculation: Could not determine matriculation during Fraport Büko login
|
|
||||||
CampusUserInvalidFeaturesOfStudy parseErr: Could not determine features of study during Fraport Büko login
|
CampusUserInvalidFeaturesOfStudy parseErr: Could not determine features of study during Fraport Büko login
|
||||||
CampusUserInvalidAssociatedSchools parseErr: Could not determine associated departments during Fraport Büko login
|
CampusUserInvalidAssociatedSchools parseErr: Could not determine associated departments during Fraport Büko login
|
||||||
InvalidCredentialsADNoSuchObject: User entry does not exist
|
InvalidCredentialsADNoSuchObject: User entry does not exist
|
||||||
|
|||||||
@ -132,7 +132,7 @@ CourseUserTutorials: Angemeldete Tutorien
|
|||||||
CourseUserExams: Angemeldete Prüfungen
|
CourseUserExams: Angemeldete Prüfungen
|
||||||
CourseUserSheets: Übungsblätter
|
CourseUserSheets: Übungsblätter
|
||||||
CsvColumnUserName: Voller Name des/der Teilnehmers/Teilnehmerin
|
CsvColumnUserName: Voller Name des/der Teilnehmers/Teilnehmerin
|
||||||
CsvColumnUserMatriculation: Matrikelnummer des/der Teilnehmers/Teilnehmerin
|
CsvColumnUserMatriculation: AVS Nummer des/der Teilnehmers/Teilnehmerin
|
||||||
CsvColumnUserSex: Geschlecht
|
CsvColumnUserSex: Geschlecht
|
||||||
CsvColumnUserBirthday: Geburtstag
|
CsvColumnUserBirthday: Geburtstag
|
||||||
CsvColumnUserEmail: E-Mail-Adresse des/der Teilnehmers/Teilnehmerin
|
CsvColumnUserEmail: E-Mail-Adresse des/der Teilnehmers/Teilnehmerin
|
||||||
|
|||||||
@ -132,7 +132,7 @@ CourseUserTutorials: Registered tutorials
|
|||||||
CourseUserExams: Registered exams
|
CourseUserExams: Registered exams
|
||||||
CourseUserSheets: Exercise sheets
|
CourseUserSheets: Exercise sheets
|
||||||
CsvColumnUserName: Participant's full name
|
CsvColumnUserName: Participant's full name
|
||||||
CsvColumnUserMatriculation: Participant's matriculation
|
CsvColumnUserMatriculation: Participant's AVS number
|
||||||
CsvColumnUserSex: Participant's sex
|
CsvColumnUserSex: Participant's sex
|
||||||
CsvColumnUserBirthday: Birthday
|
CsvColumnUserBirthday: Birthday
|
||||||
CsvColumnUserEmail: Participant's email address
|
CsvColumnUserEmail: Participant's email address
|
||||||
|
|||||||
@ -11,7 +11,7 @@ AdminUserDisplayEmail: E-Mail-Adresse
|
|||||||
AdminUserIdent: Identifikation
|
AdminUserIdent: Identifikation
|
||||||
AdminUserAuth: Authentifizierung
|
AdminUserAuth: Authentifizierung
|
||||||
AdminUserAuthTooltip: Abhängig von der Auswahl werden neue Benutzer über ihr neues FRADrive Konto benachrichtigt.
|
AdminUserAuthTooltip: Abhängig von der Auswahl werden neue Benutzer über ihr neues FRADrive Konto benachrichtigt.
|
||||||
AdminUserMatriculation: Matrikelnummer
|
AdminUserMatriculation: AVS Nummer
|
||||||
AdminUserSex: Geschlecht
|
AdminUserSex: Geschlecht
|
||||||
AdminUserBirthday: Geburtsdatum
|
AdminUserBirthday: Geburtsdatum
|
||||||
AdminUserTelephone: Telefonnummer
|
AdminUserTelephone: Telefonnummer
|
||||||
|
|||||||
@ -11,7 +11,7 @@ AdminUserDisplayEmail: Email address
|
|||||||
AdminUserIdent: Identification
|
AdminUserIdent: Identification
|
||||||
AdminUserAuth: Authentication
|
AdminUserAuth: Authentication
|
||||||
AdminUserAuthTooltip: New users may be notified about their FRADrive account depending on this choice.
|
AdminUserAuthTooltip: New users may be notified about their FRADrive account depending on this choice.
|
||||||
AdminUserMatriculation: Matriculation
|
AdminUserMatriculation: AVS number
|
||||||
AdminUserSex: Sex
|
AdminUserSex: Sex
|
||||||
AdminUserBirthday: Date of Birth
|
AdminUserBirthday: Date of Birth
|
||||||
AdminUserTelephone: Phone
|
AdminUserTelephone: Phone
|
||||||
|
|||||||
@ -56,7 +56,7 @@ TableTutorialDeregisterUntil: Deregister until
|
|||||||
TableActionsHead: Actions
|
TableActionsHead: Actions
|
||||||
TableTutorialTime: Time
|
TableTutorialTime: Time
|
||||||
TableNoFilter: No restriction
|
TableNoFilter: No restriction
|
||||||
TableUserMatriculation: AVS Number
|
TableUserMatriculation: AVS number
|
||||||
TableColumnStudyFeatures: Features of study
|
TableColumnStudyFeatures: Features of study
|
||||||
TableSchoolShort: Shorthand
|
TableSchoolShort: Shorthand
|
||||||
TableSchoolName: Name
|
TableSchoolName: Name
|
||||||
|
|||||||
@ -127,7 +127,7 @@ data CampusUserConversionException
|
|||||||
| CampusUserInvalidGivenName
|
| CampusUserInvalidGivenName
|
||||||
| CampusUserInvalidSurname
|
| CampusUserInvalidSurname
|
||||||
| CampusUserInvalidTitle
|
| CampusUserInvalidTitle
|
||||||
| CampusUserInvalidMatriculation
|
-- | CampusUserInvalidMatriculation
|
||||||
| CampusUserInvalidFeaturesOfStudy Text
|
| CampusUserInvalidFeaturesOfStudy Text
|
||||||
| CampusUserInvalidAssociatedSchools Text
|
| CampusUserInvalidAssociatedSchools Text
|
||||||
deriving (Eq, Ord, Read, Show, Generic)
|
deriving (Eq, Ord, Read, Show, Generic)
|
||||||
|
|||||||
@ -367,7 +367,6 @@ getProblemAvsSynchR = do
|
|||||||
let catchAllAvs' r = flip catch (\err -> addMessageModal Error (i18n MsgAvsCommunicationError) (Right (text2widget $ tshow (err :: SomeException))) >> redirect r)
|
let catchAllAvs' r = flip catch (\err -> addMessageModal Error (i18n MsgAvsCommunicationError) (Right (text2widget $ tshow (err :: SomeException))) >> redirect r)
|
||||||
catchAllAvs = catchAllAvs' ProblemAvsSynchR -- == current route; use only in conditions that are not repeated upon reload; do not call redirect within catchAllAvs actions!
|
catchAllAvs = catchAllAvs' ProblemAvsSynchR -- == current route; use only in conditions that are not repeated upon reload; do not call redirect within catchAllAvs actions!
|
||||||
(AvsLicenceDifferences{..}, apidStatus) <- catchAllAvs' AdminR retrieveDifferingLicencesStatus
|
(AvsLicenceDifferences{..}, apidStatus) <- catchAllAvs' AdminR retrieveDifferingLicencesStatus
|
||||||
-- TODO: for all ids, uery PersonStatus and create a Map from AvsId to a List of all valid Cards
|
|
||||||
|
|
||||||
--
|
--
|
||||||
unknownLicenceOwners' <- whenNonEmpty avsLicenceDiffRevokeAll $ \neZeros ->
|
unknownLicenceOwners' <- whenNonEmpty avsLicenceDiffRevokeAll $ \neZeros ->
|
||||||
|
|||||||
@ -13,6 +13,7 @@ import Import
|
|||||||
|
|
||||||
import Handler.Utils
|
import Handler.Utils
|
||||||
import Handler.Utils.Csv
|
import Handler.Utils.Csv
|
||||||
|
import Handler.Utils.Profile
|
||||||
|
|
||||||
-- import qualified Data.CaseInsensitive as CI
|
-- import qualified Data.CaseInsensitive as CI
|
||||||
import qualified Data.Csv as Csv
|
import qualified Data.Csv as Csv
|
||||||
@ -56,11 +57,11 @@ instance ToNamedRecord SapUserTableCsv where
|
|||||||
-- | Removes all personalNummer which are not numbers between 10000 and 99999 (also excludes E-Accounts), which should not be returned by the query anyway (only qualfications with sap id and users with internal personnel number must be transmitted)
|
-- | Removes all personalNummer which are not numbers between 10000 and 99999 (also excludes E-Accounts), which should not be returned by the query anyway (only qualfications with sap id and users with internal personnel number must be transmitted)
|
||||||
-- TODO: once temporary suspensions are implemented, a user must be transmitted to SAP in two rows: firstheld->suspensionFrom & suspensionTo->validTo
|
-- TODO: once temporary suspensions are implemented, a user must be transmitted to SAP in two rows: firstheld->suspensionFrom & suspensionTo->validTo
|
||||||
sapRes2csv :: [(Ex.Value (Maybe Text), Ex.Value Day, Ex.Value Day, Ex.Value (Maybe Text))] -> [SapUserTableCsv]
|
sapRes2csv :: [(Ex.Value (Maybe Text), Ex.Value Day, Ex.Value Day, Ex.Value (Maybe Text))] -> [SapUserTableCsv]
|
||||||
sapRes2csv l = [ res | (Ex.Value (Just persNo), Ex.Value firstHeld, Ex.Value validUntil, Ex.Value (Just sapId)) <- l
|
sapRes2csv l = [ res | (Ex.Value pn@(Just persNo), Ex.Value firstHeld, Ex.Value validUntil, Ex.Value (Just sapId)) <- l
|
||||||
, let persNoAsInt = readMay persNo
|
-- , let persNoAsInt = readMay =<< persNo -- also see Handler.Utils.Profile.validFraportPersonalNumber
|
||||||
, persNoAsInt >= Just (10000::Int) -- filter E-accounts for SAP export
|
-- , persNoAsInt >= Just (10000::Int) -- filter E-accounts for SAP export
|
||||||
, persNoAsInt <= Just (99999::Int) -- filter E-accounts for SAP export
|
-- , persNoAsInt <= Just (99999::Int) -- filter E-accounts for SAP export
|
||||||
, let res = SapUserTableCsv
|
, let res = SapUserTableCsv
|
||||||
{ csvSUTpersonalNummer = persNo
|
{ csvSUTpersonalNummer = persNo
|
||||||
, csvSUTqualifikation = sapId
|
, csvSUTqualifikation = sapId
|
||||||
, csvSUTgültigVon = firstHeld
|
, csvSUTgültigVon = firstHeld
|
||||||
@ -68,6 +69,7 @@ sapRes2csv l = [ res | (Ex.Value (Just persNo), Ex.Value firstHeld, Ex.Value val
|
|||||||
-- , csvSUTsupendiertBis = blocked
|
-- , csvSUTsupendiertBis = blocked
|
||||||
, csvSUTausprägung = "J"
|
, csvSUTausprägung = "J"
|
||||||
}
|
}
|
||||||
|
, validFraportPersonalNumber pn
|
||||||
]
|
]
|
||||||
|
|
||||||
-- | Deliver all employess with a successful LDAP synch within the last 3 months
|
-- | Deliver all employess with a successful LDAP synch within the last 3 months
|
||||||
|
|||||||
@ -11,6 +11,7 @@ module Handler.Tutorial.Users
|
|||||||
import Import
|
import Import
|
||||||
|
|
||||||
import Utils.Form
|
import Utils.Form
|
||||||
|
import Utils.Print
|
||||||
import Handler.Utils
|
import Handler.Utils
|
||||||
import Handler.Utils.Course
|
import Handler.Utils.Course
|
||||||
import Handler.Utils.Tutorial
|
import Handler.Utils.Tutorial
|
||||||
@ -20,7 +21,7 @@ import qualified Data.CaseInsensitive as CI
|
|||||||
|
|
||||||
import qualified Data.Set as Set
|
import qualified Data.Set as Set
|
||||||
import qualified Data.Map as Map
|
import qualified Data.Map as Map
|
||||||
|
import qualified Data.ByteString.Lazy as LBS
|
||||||
-- import qualified Data.Time.Zones as TZ
|
-- import qualified Data.Time.Zones as TZ
|
||||||
|
|
||||||
import Database.Esqueleto.Experimental ((:&)(..))
|
import Database.Esqueleto.Experimental ((:&)(..))
|
||||||
@ -57,13 +58,12 @@ data TutorialUserActionData
|
|||||||
deriving (Eq, Ord, Read, Show, Generic)
|
deriving (Eq, Ord, Read, Show, Generic)
|
||||||
|
|
||||||
|
|
||||||
getTUsersR, postTUsersR :: TermId -> SchoolId -> CourseShorthand -> TutorialName -> Handler Html
|
getTUsersR, postTUsersR :: TermId -> SchoolId -> CourseShorthand -> TutorialName -> Handler TypedContent
|
||||||
getTUsersR = postTUsersR
|
getTUsersR = postTUsersR
|
||||||
postTUsersR tid ssh csh tutn = do
|
postTUsersR tid ssh csh tutn = do
|
||||||
showSex <- getShowSex
|
(Entity tutid tut@Tutorial{..}, (participantRes, participantTable), qualifications) <- runDB $ do
|
||||||
(Entity tutid Tutorial{..}, (participantRes, participantTable), qualifications) <- runDB $ do
|
|
||||||
cid <- getKeyBy404 $ TermSchoolCourseShort tid ssh csh
|
cid <- getKeyBy404 $ TermSchoolCourseShort tid ssh csh
|
||||||
tut@(Entity tutid _) <- fetchTutorial tid ssh csh tutn
|
tutEnt@(Entity tutid _) <- fetchTutorial tid ssh csh tutn
|
||||||
qualifications <- getCourseQualifications cid
|
qualifications <- getCourseQualifications cid
|
||||||
now <- liftIO getCurrentTime
|
now <- liftIO getCurrentTime
|
||||||
let minDur :: Maybe Int = minimumMaybe $ catMaybes (view _qualificationValidDuration <$> qualifications) -- no instance Ord CalendarDiffDays
|
let minDur :: Maybe Int = minimumMaybe $ catMaybes (view _qualificationValidDuration <$> qualifications) -- no instance Ord CalendarDiffDays
|
||||||
@ -71,7 +71,6 @@ postTUsersR tid ssh csh tutn = do
|
|||||||
colChoices = mconcat $ catMaybes
|
colChoices = mconcat $ catMaybes
|
||||||
[ pure $ dbSelect (applying _2) id (return . view (hasEntity . _entityKey))
|
[ pure $ dbSelect (applying _2) id (return . view (hasEntity . _entityKey))
|
||||||
, pure $ colUserNameModalHdr MsgTableCourseMembers ForProfileDataR
|
, pure $ colUserNameModalHdr MsgTableCourseMembers ForProfileDataR
|
||||||
, guardOn showSex colUserSex'
|
|
||||||
, pure colUserEmail
|
, pure colUserEmail
|
||||||
, pure colUserMatriclenr
|
, pure colUserMatriclenr
|
||||||
, pure colUserQualifications
|
, pure colUserQualifications
|
||||||
@ -118,14 +117,29 @@ postTUsersR tid ssh csh tutn = do
|
|||||||
, ( TutorialUserDeregister, pure TutorialUserDeregisterData )
|
, ( TutorialUserDeregister, pure TutorialUserDeregisterData )
|
||||||
]
|
]
|
||||||
table <- makeCourseUserTable cid acts isInTut colChoices psValidator (Just csvColChoices)
|
table <- makeCourseUserTable cid acts isInTut colChoices psValidator (Just csvColChoices)
|
||||||
return (tut, table, qualifications)
|
return (tutEnt, table, qualifications)
|
||||||
|
|
||||||
let courseQids = Set.fromList (entityKey <$> qualifications)
|
let courseQids = Set.fromList (entityKey <$> qualifications)
|
||||||
formResult participantRes $ \case
|
tcontent <- formResultMaybe participantRes $ \case
|
||||||
(TutorialUserPrintQualificationData{..}, _selectedUsers)
|
(TutorialUserPrintQualificationData{..}, selectedUsers)
|
||||||
| tuQualification `Set.member` courseQids -> do
|
| tuQualification `Set.member` courseQids -> do
|
||||||
-- TODO Continue here
|
rcvr <- requireAuth
|
||||||
addMessageI Error MsgErrorUnknownFormAction
|
encRcvr <- encrypt $ entityKey rcvr
|
||||||
|
letters <- runDB $ makeCourseCertificates tut Nothing $ toList selectedUsers
|
||||||
|
let mbAletter = anyone letters
|
||||||
|
case mbAletter of
|
||||||
|
Nothing -> addMessageI Error MsgErrorUnknownFormAction >> return Nothing -- TODO: better error message
|
||||||
|
Just aletter -> do
|
||||||
|
now <- liftIO getCurrentTime
|
||||||
|
apcIdent <- letterApcIdent aletter encRcvr now
|
||||||
|
let fName = letterFileName aletter
|
||||||
|
renderLetters rcvr letters apcIdent >>= \case
|
||||||
|
Left err -> sendResponseStatus internalServerError500 $ "PDF generation failed: \n" <> err
|
||||||
|
Right pdf -> Just <$> sendByteStringAsFile fName (LBS.toStrict pdf) now
|
||||||
|
-- sendResponseByteStringFile "demoPDF.pdf" (LBS.toStrict pdf)
|
||||||
|
-- let typePDF :: ContentType
|
||||||
|
-- typePDF = "application/pdf"
|
||||||
|
-- sendResponse (typePDF, toContent pdf)
|
||||||
(TutorialUserGrantQualificationData{..}, selectedUsers)
|
(TutorialUserGrantQualificationData{..}, selectedUsers)
|
||||||
| tuQualification `Set.member` courseQids -> do
|
| tuQualification `Set.member` courseQids -> do
|
||||||
-- today <- localDay . TZ.utcToLocalTimeTZ appTZ <$> liftIO getCurrentTime
|
-- today <- localDay . TZ.utcToLocalTimeTZ appTZ <$> liftIO getCurrentTime
|
||||||
@ -148,16 +162,19 @@ postTUsersR tid ssh csh tutn = do
|
|||||||
]
|
]
|
||||||
addMessageI Success $ MsgTutorialUsersDeregistered nrDel
|
addMessageI Success $ MsgTutorialUsersDeregistered nrDel
|
||||||
redirect $ CTutorialR tid ssh csh tutn TUsersR
|
redirect $ CTutorialR tid ssh csh tutn TUsersR
|
||||||
_other ->
|
_other -> addMessageI Error MsgErrorUnknownFormAction >> return Nothing
|
||||||
addMessageI Error MsgErrorUnknownFormAction
|
|
||||||
|
|
||||||
tutors <- runDB $ E.select $ do
|
case tcontent of
|
||||||
(tutor :& user) <- E.from $ E.table @Tutor `E.innerJoin` E.table @User
|
Just content -> return content -- abort and return produced content
|
||||||
`E.on` (\(tutor :& user) -> tutor E.^. TutorUser E.==. user E.^. UserId)
|
Nothing -> do
|
||||||
E.where_ $ tutor E.^. TutorTutorial E.==. E.val tutid
|
tutors <- runDB $ E.select $ do
|
||||||
return user
|
(tutor :& user) <- E.from $ E.table @Tutor `E.innerJoin` E.table @User
|
||||||
|
`E.on` (\(tutor :& user) -> tutor E.^. TutorUser E.==. user E.^. UserId)
|
||||||
|
E.where_ $ tutor E.^. TutorTutorial E.==. E.val tutid
|
||||||
|
return user
|
||||||
|
|
||||||
let heading = prependCourseTitle tid ssh csh $ CI.original tutorialName
|
let heading = prependCourseTitle tid ssh csh $ CI.original tutorialName
|
||||||
siteLayoutMsg heading $ do
|
html <- siteLayoutMsg heading $ do
|
||||||
setTitleI heading
|
setTitleI heading
|
||||||
$(widgetFile "tutorial-participants")
|
$(widgetFile "tutorial-participants")
|
||||||
|
return $ toTypedContent html
|
||||||
|
|||||||
@ -241,7 +241,14 @@ retrieveDifferingLicences' getStatus = do
|
|||||||
[ AvsStatusPerson avsid $ Set.singleton $ mkAdpc (even $ avsPersonId avsid) AvsCardColorGelb | Entity _ UserAvs{userAvsPersonId = avsid} <- avsUsrs ]
|
[ AvsStatusPerson avsid $ Set.singleton $ mkAdpc (even $ avsPersonId avsid) AvsCardColorGelb | Entity _ UserAvs{userAvsPersonId = avsid} <- avsUsrs ]
|
||||||
#else
|
#else
|
||||||
let statQry = avsLicenceDifferences2LicenceIds lDiff
|
let statQry = avsLicenceDifferences2LicenceIds lDiff
|
||||||
lStat <- if getStatus && notNull statQry then throwLeftM $ avsQueryStatus $ AvsQueryStatus statQry else return $ AvsResponseStatus mempty -- avoid unnecessary avs calls
|
lStat <- if getStatus && notNull statQry
|
||||||
|
then -- throwLeftM $ avsQueryStatus $ AvsQueryStatus statQry -- don't throw up here, licence differences are too important! TODO: Warn in Problem-Handler
|
||||||
|
avsQueryStatus (AvsQueryStatus statQry) >>= \case
|
||||||
|
Left err -> do
|
||||||
|
addMessage Error $ toHtml $ "avsQueryStatus failed for " <> tshow (length statQry) <> " requests with: \n" <> tshow err <> "\nREQUEST:\n" <> tshow statQry
|
||||||
|
return $ AvsResponseStatus mempty
|
||||||
|
Right res -> return res
|
||||||
|
else return $ AvsResponseStatus mempty -- avoid unnecessary avs calls
|
||||||
#endif
|
#endif
|
||||||
return (lDiff, avsResponseStatusMap lStat)
|
return (lDiff, avsResponseStatusMap lStat)
|
||||||
|
|
||||||
|
|||||||
@ -4,7 +4,8 @@
|
|||||||
|
|
||||||
module Handler.Utils.Download
|
module Handler.Utils.Download
|
||||||
( sendThisFile
|
( sendThisFile
|
||||||
, sendByteStringAsFile
|
, sendByteStringAsFile --, sendByteStringAsFileAndExit
|
||||||
|
, sendResponseByteStringFile
|
||||||
, sendFileReference
|
, sendFileReference
|
||||||
, serveOneFile
|
, serveOneFile
|
||||||
, serveSomeFiles
|
, serveSomeFiles
|
||||||
@ -176,6 +177,37 @@ sendByteStringAsFile fileTitle content fileModified =
|
|||||||
| null content = Nothing
|
| null content = Nothing
|
||||||
| otherwise = Just $ yield content
|
| otherwise = Just $ yield content
|
||||||
|
|
||||||
|
-- THIS DOES NOT WORK:
|
||||||
|
-- sendByteStringAsFileAndExit :: ( YesodAuthPersist UniWorX
|
||||||
|
-- , AuthEntity UniWorX ~ User
|
||||||
|
-- , AuthId UniWorX ~ UserId
|
||||||
|
-- , YesodPersistRunner UniWorX
|
||||||
|
-- , MonadCrypto (HandlerFor UniWorX), MonadCryptoKey (HandlerFor UniWorX) ~ CryptoIDKey
|
||||||
|
-- ) => FilePath -> ByteString -> UTCTime -> HandlerFor UniWorX a
|
||||||
|
-- sendByteStringAsFileAndExit fileTitle content fileModified= do
|
||||||
|
-- void $ sendByteStringAsFile fileTitle content fileModified
|
||||||
|
-- sendResponse ()
|
||||||
|
|
||||||
|
|
||||||
|
-- | like sendByteStringAsFile, but uses sendResponse instead of respondSourceDB, ensuring that
|
||||||
|
-- remaining handler code is bybassed
|
||||||
|
sendResponseByteStringFile :: -- ( YesodAuthPersist UniWorX
|
||||||
|
-- , AuthEntity UniWorX ~ User
|
||||||
|
-- , AuthId UniWorX ~ UserId
|
||||||
|
-- , MonadCrypto (HandlerFor UniWorX), MonadCryptoKey (HandlerFor UniWorX) ~ CryptoIDKey
|
||||||
|
-- ) =>
|
||||||
|
FilePath -> ByteString -> HandlerFor UniWorX a
|
||||||
|
sendResponseByteStringFile fileTitle fileContent = do
|
||||||
|
-- ensureApprootUserGeneratedMaybe' Nothing
|
||||||
|
when (null fileContent) $ sendResponseStatus noContent204 ()
|
||||||
|
let cType = simpleContentType (mimeLookup $ pack fileTitle) <> "; charset=utf-8"
|
||||||
|
content = (cType, toContent fileContent)
|
||||||
|
-- setCSPSandbox
|
||||||
|
setContentDisposition ContentInline $ Just $ takeFileName fileTitle -- just displays, but cannot save
|
||||||
|
-- setContentDisposition ContentAttachment $ Just $ takeFileName fileTitle -- saves file pnly, no display
|
||||||
|
-- setContentDisposition' . Just $ takeFileName fileTitle
|
||||||
|
sendResponse content
|
||||||
|
|
||||||
sendFileReference :: forall file a.
|
sendFileReference :: forall file a.
|
||||||
( HasFileReference file
|
( HasFileReference file
|
||||||
, BearerAuthSite UniWorX
|
, BearerAuthSite UniWorX
|
||||||
|
|||||||
@ -5,12 +5,10 @@
|
|||||||
-- TODO: why is this Handler.Utils.Profile instead of Utils.Profile?
|
-- TODO: why is this Handler.Utils.Profile instead of Utils.Profile?
|
||||||
-- TODO: consider merging with Handler.Utils.Users?
|
-- TODO: consider merging with Handler.Utils.Users?
|
||||||
module Handler.Utils.Profile
|
module Handler.Utils.Profile
|
||||||
( checkDisplayName
|
( validDisplayName, checkDisplayName, fixDisplayName
|
||||||
, validDisplayName
|
|
||||||
, fixDisplayName
|
|
||||||
, validPostAddress
|
, validPostAddress
|
||||||
, validEmail, validEmail'
|
, validEmail, validEmail', pickValidEmail, pickValidEmail'
|
||||||
, pickValidEmail, pickValidEmail'
|
, validFraportPersonalNumber
|
||||||
) where
|
) where
|
||||||
|
|
||||||
import Import.NoFoundation
|
import Import.NoFoundation
|
||||||
@ -104,3 +102,10 @@ pickValidEmail' x y
|
|||||||
| validEmail' x = Just x
|
| validEmail' x = Just x
|
||||||
| validEmail' y = Just y
|
| validEmail' y = Just y
|
||||||
| otherwise = Nothing
|
| otherwise = Nothing
|
||||||
|
|
||||||
|
validFraportPersonalNumber :: Maybe Text -> Bool
|
||||||
|
validFraportPersonalNumber Nothing = False
|
||||||
|
validFraportPersonalNumber (Just t)
|
||||||
|
| (Just pn) <- readMay t
|
||||||
|
= pn >= (10000::Int) && pn <= (99999::Int) -- used to filter for SAP export
|
||||||
|
| otherwise = False
|
||||||
|
|||||||
@ -15,6 +15,7 @@ module Model.Types.DateTime
|
|||||||
|
|
||||||
import Import.NoModel
|
import Import.NoModel
|
||||||
|
|
||||||
|
import qualified Data.Set as Set
|
||||||
import Data.Ratio ((%))
|
import Data.Ratio ((%))
|
||||||
import qualified Data.Text as Text
|
import qualified Data.Text as Text
|
||||||
-- import Data.Either.Combinators (maybeToRight, mapLeft)
|
-- import Data.Either.Combinators (maybeToRight, mapLeft)
|
||||||
@ -206,3 +207,16 @@ derivePersistFieldJSON ''Occurrences
|
|||||||
|
|
||||||
|
|
||||||
nullaryPathPiece ''DayOfWeek camelToPathPiece
|
nullaryPathPiece ''DayOfWeek camelToPathPiece
|
||||||
|
|
||||||
|
|
||||||
|
-- | Get bounds for an Occurrences
|
||||||
|
-- TODO: unfinished function, only works for a few selected cases yet
|
||||||
|
occurrencesBounds :: Occurrences -> (Maybe Day, Maybe Day)
|
||||||
|
occurrencesBounds Occurrences{occurrencesScheduled=scd} | notNull scd = (Nothing, Nothing) -- TODO: case is not yet implemented
|
||||||
|
occurrencesBounds Occurrences{occurrencesExceptions=exc} = (Set.lookupMin occDays, Set.lookupMax occDays)
|
||||||
|
where
|
||||||
|
occDays = Set.foldr getOccDays mempty exc
|
||||||
|
|
||||||
|
getOccDays :: OccurrenceException -> Set Day -> Set Day
|
||||||
|
getOccDays ExceptNoOccur{} acc = acc -- TODO: this case ignores ExceptNoOccur for now!
|
||||||
|
getOccDays ExceptOccur{exceptDay} acc = Set.insert exceptDay acc
|
||||||
|
|||||||
11
src/Utils.hs
11
src/Utils.hs
@ -845,6 +845,11 @@ toNothing = const Nothing
|
|||||||
toNothingS :: String -> Maybe b
|
toNothingS :: String -> Maybe b
|
||||||
toNothingS = const Nothing
|
toNothingS = const Nothing
|
||||||
|
|
||||||
|
-- | change second of maybe pair to Nothing, if both are Just and equal
|
||||||
|
eq2nothing :: Eq a => (Maybe a, Maybe a) -> (Maybe a, Maybe a)
|
||||||
|
eq2nothing (mx@(Just x), Just y) | x==y = (mx, Nothing)
|
||||||
|
eq2nothing p = p
|
||||||
|
|
||||||
-- replaced by a more general formulation, see canonical
|
-- replaced by a more general formulation, see canonical
|
||||||
-- null2nothing :: MonoFoldable a => Maybe a -> Maybe a
|
-- null2nothing :: MonoFoldable a => Maybe a -> Maybe a
|
||||||
-- null2nothing (Just x) | null x = Nothing
|
-- null2nothing (Just x) | null x = Nothing
|
||||||
@ -1297,6 +1302,12 @@ maxLength :: ( Integral n
|
|||||||
-- ^ @maxLegth n xs = length xs <= n@
|
-- ^ @maxLegth n xs = length xs <= n@
|
||||||
maxLength l = not . minLength (succ l)
|
maxLength l = not . minLength (succ l)
|
||||||
|
|
||||||
|
-- anyone :: (Foldable t) => t a -> Maybe a
|
||||||
|
-- | return any single element from a foldable, if it is not null
|
||||||
|
anyone :: (Foldable t, Alternative f) => t a -> f a
|
||||||
|
anyone = Fold.foldr ((<|>).pure) empty
|
||||||
|
|
||||||
|
|
||||||
------------
|
------------
|
||||||
-- Writer --
|
-- Writer --
|
||||||
------------
|
------------
|
||||||
|
|||||||
@ -128,6 +128,9 @@ makeClassyFor_ ''LmsResult
|
|||||||
makeClassyFor_ ''UserAvs
|
makeClassyFor_ ''UserAvs
|
||||||
makeClassyFor_ ''UserAvsCard
|
makeClassyFor_ ''UserAvsCard
|
||||||
|
|
||||||
|
makeClassyFor_ ''UserCompany
|
||||||
|
makeLenses_ ''Company
|
||||||
|
|
||||||
_entityKey :: Getter (Entity record) (Key record)
|
_entityKey :: Getter (Entity record) (Key record)
|
||||||
-- ^ Not a `Lens'` for safety
|
-- ^ Not a `Lens'` for safety
|
||||||
_entityKey = to entityKey
|
_entityKey = to entityKey
|
||||||
|
|||||||
@ -6,16 +6,20 @@
|
|||||||
|
|
||||||
module Utils.Print
|
module Utils.Print
|
||||||
( renderLetter -- used for generating letter pdfs
|
( renderLetter -- used for generating letter pdfs
|
||||||
|
, renderLetters
|
||||||
, sendEmailOrLetter -- directly print or sends by email
|
, sendEmailOrLetter -- directly print or sends by email
|
||||||
, printLetter -- always send a letter
|
, printLetter -- always send a letter
|
||||||
, letterApcIdent -- create acknowledge string for APC
|
, letterApcIdent -- create acknowledge string for APC
|
||||||
|
, letterFileName -- default filename
|
||||||
, encryptPDF
|
, encryptPDF
|
||||||
, sanitizeCmdArg, validCmdArgument
|
, sanitizeCmdArg, sanitizeCmdArg', validCmdArgument
|
||||||
-- , compileTemplate, makePDF
|
-- , compileTemplate, makePDF
|
||||||
, _Meta, addMeta
|
, _Meta, addMeta
|
||||||
, toMeta, mbMeta -- single values
|
, toMeta, mbMeta -- single values
|
||||||
, mkMeta, appMeta, applyMetas -- multiple values
|
, mkMeta, appMeta, applyMetas -- multiple values
|
||||||
, LetterRenewQualificationF(..)
|
, LetterRenewQualificationF(..)
|
||||||
|
-- , LetterCourseCertificate()
|
||||||
|
, makeCourseCertificates
|
||||||
) where
|
) where
|
||||||
|
|
||||||
-- import Import.NoModel
|
-- import Import.NoModel
|
||||||
@ -47,6 +51,7 @@ import Jobs.Handler.SendNotification.Utils
|
|||||||
|
|
||||||
import Utils.Print.Letters
|
import Utils.Print.Letters
|
||||||
import Utils.Print.RenewQualification
|
import Utils.Print.RenewQualification
|
||||||
|
import Utils.Print.CourseCertificate
|
||||||
|
|
||||||
|
|
||||||
-- import Model.Types.Markup -- TODO-QSV: should this module be moved accordingly?
|
-- import Model.Types.Markup -- TODO-QSV: should this module be moved accordingly?
|
||||||
@ -103,7 +108,7 @@ import Utils.Print.RenewQualification
|
|||||||
|
|
||||||
|
|
||||||
-- | read and writes markdown, applying it as its own template to apply meta
|
-- | read and writes markdown, applying it as its own template to apply meta
|
||||||
mdTemplating :: Text -> P.Meta -> HandlerFor UniWorX (Either P.PandocError Text)
|
mdTemplating :: Text -> P.Meta -> HandlerFor UniWorX (Either P.PandocError P.Pandoc)
|
||||||
mdTemplating template meta = runExceptT $ do
|
mdTemplating template meta = runExceptT $ do
|
||||||
let readerOpts = def { P.readerExtensions = P.pandocExtensions
|
let readerOpts = def { P.readerExtensions = P.pandocExtensions
|
||||||
, P.readerStripComments = True
|
, P.readerStripComments = True
|
||||||
@ -113,21 +118,20 @@ mdTemplating template meta = runExceptT $ do
|
|||||||
let writerOpts = def { P.writerExtensions = P.pandocExtensions
|
let writerOpts = def { P.writerExtensions = P.pandocExtensions
|
||||||
, P.writerTemplate = Just tmpl
|
, P.writerTemplate = Just tmpl
|
||||||
}
|
}
|
||||||
ExceptT . pure . P.runPure $ P.writeMarkdown writerOpts $ appMeta setIsDeFromLang
|
ExceptT . pure . P.runPure $ do
|
||||||
$ addMeta meta doc
|
md_txt <- P.writeMarkdown writerOpts $ appMeta setIsDeFromLang $ addMeta meta doc
|
||||||
|
P.readMarkdown readerOpts md_txt
|
||||||
|
|
||||||
|
|
||||||
-- | creates a PDF using a LaTeX template
|
-- | creates a PDF using a LaTeX template
|
||||||
pdfLaTeX :: LetterKind -> P.Meta -> Text -> HandlerFor UniWorX (Either P.PandocError LBS.ByteString)
|
pdfLaTeX :: LetterKind -> P.Pandoc -> HandlerFor UniWorX (Either P.PandocError LBS.ByteString)
|
||||||
pdfLaTeX lk meta md = do
|
pdfLaTeX lk doc = do
|
||||||
e_tmpl <- $cachedHereBinary ("LetterKind:" <> tshow lk) (liftIO . P.runIO $ compileTemplate $ templateLatex lk)
|
e_tmpl <- $cachedHereBinary ("LetterKind:" <> tshow lk) (liftIO . P.runIO $ compileTemplate $ templateLatex lk)
|
||||||
actRight e_tmpl $ \tmpl -> liftIO . P.runIO $ do
|
actRight e_tmpl $ \tmpl -> liftIO . P.runIO $ do
|
||||||
let readerOpts = def { P.readerExtensions = P.pandocExtensions }
|
let writerOpts = def { P.writerExtensions = P.pandocExtensions
|
||||||
writerOpts = def { P.writerExtensions = P.pandocExtensions
|
|
||||||
, P.writerTemplate = Just tmpl }
|
, P.writerTemplate = Just tmpl }
|
||||||
doc <- P.readMarkdown readerOpts md
|
makePDF writerOpts $ appMeta setIsDeFromLang doc
|
||||||
makePDF writerOpts
|
|
||||||
$ appMeta setIsDeFromLang
|
|
||||||
$ addMeta meta doc
|
|
||||||
|
|
||||||
|
|
||||||
renderLetter :: (MDLetter l) => Entity User -> l -> Text -> Handler (Either Text LBS.ByteString)
|
renderLetter :: (MDLetter l) => Entity User -> l -> Text -> Handler (Either Text LBS.ByteString)
|
||||||
@ -136,20 +140,49 @@ renderLetter rcvrEnt@Entity{entityVal=rcvr} mdl apcIdent = do
|
|||||||
formatter@DateTimeFormatter{ format } <- getDateTimeFormatterUser' rcvr
|
formatter@DateTimeFormatter{ format } <- getDateTimeFormatterUser' rcvr
|
||||||
let lang = selectDeEn $ rcvr & userLanguages -- select either German or English only, default de; see Utils.Lang
|
let lang = selectDeEn $ rcvr & userLanguages -- select either German or English only, default de; see Utils.Lang
|
||||||
kind = getLetterKind $ pure mdl
|
kind = getLetterKind $ pure mdl
|
||||||
tmpl = getTemplate $ pure mdl
|
tmpl = getTemplate mdl
|
||||||
meta = addApcIdent apcIdent
|
meta = addApcIdent apcIdent
|
||||||
<> letterMeta mdl formatter lang rcvrEnt
|
<> letterMeta mdl formatter lang rcvrEnt
|
||||||
<> mkMeta
|
<> mkMeta
|
||||||
[ toMeta "lang" lang
|
[ -- toMeta "lang" lang -- receiver language is decided in MDLetter instance, since some letters have fixed languages
|
||||||
, toMeta "date" $ format SelFormatDate now
|
toMeta "date" $ format SelFormatDate now
|
||||||
, toMeta "rcvr-name" $ rcvr & userDisplayName
|
, toMeta "rcvr-name" $ rcvr & userDisplayName
|
||||||
, toMeta "address" $ fromMaybe [rcvr & userDisplayName] $ getPostalAddress rcvr
|
, toMeta "address" $ fromMaybe [rcvr & userDisplayName] $ getPostalAddress rcvr
|
||||||
--, toMeta "rcvr-email" $ rcvr & userDisplayEmail -- note that some templates use "email" already otherwise
|
--, toMeta "rcvr-email" $ rcvr & userDisplayEmail -- note that some templates use "email" already otherwise
|
||||||
]
|
]
|
||||||
e_md <- mdTemplating tmpl meta
|
e_md <- mdTemplating tmpl meta
|
||||||
result <- actRight e_md $ pdfLaTeX kind meta
|
result <- actRight e_md $ pdfLaTeX kind
|
||||||
return $ over _Left P.renderError result
|
return $ over _Left P.renderError result
|
||||||
|
|
||||||
|
-- TODO: apcIdent does not make sense for multiple letters
|
||||||
|
renderLetters :: (MDLetter l, Foldable f) => Entity User -> f l -> Text -> Handler (Either Text LBS.ByteString)
|
||||||
|
renderLetters rcvrEnt@Entity{entityVal=rcvr} mdls apcIdent
|
||||||
|
| Just l <- anyone mdls = do
|
||||||
|
now <- liftIO getCurrentTime
|
||||||
|
formatter@DateTimeFormatter{ format } <- getDateTimeFormatterUser' rcvr
|
||||||
|
let lang = selectDeEn $ rcvr & userLanguages -- select either German or English only, default de; see Utils.Lang
|
||||||
|
kind = getLetterKind $ pure l
|
||||||
|
|
||||||
|
templateCombine _ err@Left{} = pure err
|
||||||
|
templateCombine mdl (Right doc1) =
|
||||||
|
let tmpl = getTemplate mdl
|
||||||
|
meta = addApcIdent apcIdent
|
||||||
|
<> letterMeta mdl formatter lang rcvrEnt
|
||||||
|
<> mkMeta
|
||||||
|
[ -- toMeta "lang" lang -- receiver language is decided in MDLetter instance, since some letters have fixed languages
|
||||||
|
toMeta "date" $ format SelFormatDate now
|
||||||
|
, toMeta "rcvr-name" $ rcvr & userDisplayName
|
||||||
|
, toMeta "address" $ fromMaybe [rcvr & userDisplayName] $ getPostalAddress rcvr
|
||||||
|
--, toMeta "rcvr-email" $ rcvr & userDisplayEmail -- note that some templates use "email" already otherwise
|
||||||
|
]
|
||||||
|
in mdTemplating tmpl meta >>= \case
|
||||||
|
err@Left{} -> pure err
|
||||||
|
Right doc2 -> pure $ Right $ doc1 <> doc2
|
||||||
|
|
||||||
|
doc <- foldrM templateCombine (Right mempty) mdls
|
||||||
|
result <- actRight doc $ pdfLaTeX kind
|
||||||
|
return $ over _Left P.renderError result
|
||||||
|
| otherwise = return $ Left "renderLetters received empty set of letters"
|
||||||
|
|
||||||
|
|
||||||
---------------
|
---------------
|
||||||
@ -183,22 +216,13 @@ printLetter' pji pdf = do
|
|||||||
, pjiCourse = printJobCourse
|
, pjiCourse = printJobCourse
|
||||||
, pjiQualification = printJobQualification
|
, pjiQualification = printJobQualification
|
||||||
, pjiLmsUser = printJobLmsUser
|
, pjiLmsUser = printJobLmsUser
|
||||||
|
, pjiFileName = fName
|
||||||
} = pji
|
} = pji
|
||||||
recipient <- join <$> mapM get printJobRecipient
|
printJobFilename = T.unpack $ text2asciiAlphaNum fName <> ".pdf"
|
||||||
sender <- join <$> mapM get printJobSender
|
|
||||||
course <- join <$> mapM get printJobCourse
|
|
||||||
quali <- join <$> mapM get printJobQualification
|
|
||||||
let nameRecipient = abbrvName <$> recipient
|
|
||||||
nameSender = abbrvName <$> sender
|
|
||||||
nameCourse = CI.original . courseShorthand <$> course
|
|
||||||
nameQuali = CI.original . qualificationShorthand <$> quali
|
|
||||||
let jobFullName = text2asciiAlphaNum $
|
|
||||||
T.replace " " "-" (T.intercalate "_" . catMaybes $ [Just printJobName, nameQuali, nameCourse, nameSender, nameRecipient])
|
|
||||||
printJobFilename = T.unpack $ jobFullName <> ".pdf"
|
|
||||||
-- printJobFile <- sinkFileDB True $ yield $ LBS.toStrict pdf -- for PrintJobFile :: FileContentReference use this code
|
-- printJobFile <- sinkFileDB True $ yield $ LBS.toStrict pdf -- for PrintJobFile :: FileContentReference use this code
|
||||||
printJobFile = LBS.toStrict pdf
|
printJobFile = LBS.toStrict pdf
|
||||||
printJobAcknowledged = Nothing
|
printJobAcknowledged = Nothing
|
||||||
lprPDF jobFullName pdf >>= \case
|
lprPDF printJobFilename pdf >>= \case
|
||||||
Left err -> do
|
Left err -> do
|
||||||
return $ Left err
|
return $ Left err
|
||||||
Right ok -> do
|
Right ok -> do
|
||||||
@ -217,11 +241,12 @@ printLetter'' _ = do
|
|||||||
}
|
}
|
||||||
-}
|
-}
|
||||||
|
|
||||||
sendEmailOrLetter :: (MDLetter l) => UserId -> l -> Handler Bool
|
sendEmailOrLetter :: (MDLetter l, MDMail l) => UserId -> l -> Handler Bool
|
||||||
sendEmailOrLetter recipient letter = do
|
sendEmailOrLetter recipient letter = do
|
||||||
(underling, receivers, undercopy) <- updateReceivers recipient -- TODO: check to avoid this almost circular dependency
|
(underling, receivers, undercopy) <- updateReceivers recipient -- TODO: check to avoid this almost circular dependency
|
||||||
now <- liftIO getCurrentTime
|
now <- liftIO getCurrentTime
|
||||||
let pjid = getPJId letter
|
let pjid = getPJId letter
|
||||||
|
fName = letterFileName letter
|
||||||
mailSubject = getMailSubject letter -- these are only needed if sent by email, but we're lazy anyway
|
mailSubject = getMailSubject letter -- these are only needed if sent by email, but we're lazy anyway
|
||||||
undername = underling ^. _userDisplayName -- nameHtml' underling
|
undername = underling ^. _userDisplayName -- nameHtml' underling
|
||||||
undermail = CI.original $ underling ^. _userEmail
|
undermail = CI.original $ underling ^. _userEmail
|
||||||
@ -272,7 +297,7 @@ sendEmailOrLetter recipient letter = do
|
|||||||
setSubjectI mailSubject
|
setSubjectI mailSubject
|
||||||
editNotifications <- mkEditNotifications svr
|
editNotifications <- mkEditNotifications svr
|
||||||
addHtmlMarkdownAlternatives $(ihamletFile "templates/mail/genericMailLetter.hamlet")
|
addHtmlMarkdownAlternatives $(ihamletFile "templates/mail/genericMailLetter.hamlet")
|
||||||
addPart (File { fileTitle = T.unpack $ pjiName pjid <> ".pdf"
|
addPart (File { fileTitle = fName
|
||||||
, fileModified = now
|
, fileModified = now
|
||||||
, fileContent = Just $ yield $ LBS.toStrict attachment
|
, fileContent = Just $ yield $ LBS.toStrict attachment
|
||||||
} :: PureFile)
|
} :: PureFile)
|
||||||
@ -302,6 +327,10 @@ readProcess' pc = do
|
|||||||
|
|
||||||
sanitizeCmdArg :: Text -> Text
|
sanitizeCmdArg :: Text -> Text
|
||||||
sanitizeCmdArg = T.filter (\c -> c /= '\'' && c /= '"' && c/= '\\' && not (isSeparator c))
|
sanitizeCmdArg = T.filter (\c -> c /= '\'' && c /= '"' && c/= '\\' && not (isSeparator c))
|
||||||
|
|
||||||
|
sanitizeCmdArg' :: String -> String
|
||||||
|
sanitizeCmdArg' = filter (\c -> c /= '\'' && c /= '"' && c/= '\\' && not (isSeparator c))
|
||||||
|
|
||||||
-- | Returns Nothing if ok, otherwise the first mismatching character
|
-- | Returns Nothing if ok, otherwise the first mismatching character
|
||||||
-- Pin Password is used as a commandline argument in Utils.Print.encryptPDF and hence poses a security risk
|
-- Pin Password is used as a commandline argument in Utils.Print.encryptPDF and hence poses a security risk
|
||||||
validCmdArgument :: Text -> Maybe Char
|
validCmdArgument :: Text -> Maybe Char
|
||||||
@ -346,8 +375,8 @@ encryptPDF pw bs = over _Left (decodeUtf8 . LBS.toStrict) . exit2either <$> read
|
|||||||
-- > lpr -P fradrive -H fravm017173.fra.fraport.de:515 -T printJobName -
|
-- > lpr -P fradrive -H fravm017173.fra.fraport.de:515 -T printJobName -
|
||||||
|
|
||||||
-- | Internal only, use `printLetter` instead
|
-- | Internal only, use `printLetter` instead
|
||||||
lprPDF :: (MonadHandler m, HasAppSettings (HandlerSite m)) => Text -> LBS.ByteString -> m (Either Text Text)
|
lprPDF :: (MonadHandler m, HasAppSettings (HandlerSite m)) => FilePath -> LBS.ByteString -> m (Either Text Text)
|
||||||
lprPDF jb bs = do
|
lprPDF (sanitizeCmdArg' -> jb) bs = do
|
||||||
mbLprServerArg <- $cachedHereBinary ("lprServer"::Text) getLprServerArg
|
mbLprServerArg <- $cachedHereBinary ("lprServer"::Text) getLprServerArg
|
||||||
case mbLprServerArg of
|
case mbLprServerArg of
|
||||||
Nothing -> return $ Right "Print command ignored due to setting 'mail-reroute-to' being set."
|
Nothing -> return $ Right "Print command ignored due to setting 'mail-reroute-to' being set."
|
||||||
@ -359,8 +388,7 @@ lprPDF jb bs = do
|
|||||||
, "-" -- read from stdin
|
, "-" -- read from stdin
|
||||||
]
|
]
|
||||||
jobname | null jb = []
|
jobname | null jb = []
|
||||||
| otherwise = ["-J " <> jb']
|
| otherwise = ["-J " <> jb]
|
||||||
jb' = T.unpack $ sanitizeCmdArg jb
|
|
||||||
exit2either <$> readProcess' pc
|
exit2either <$> readProcess' pc
|
||||||
where
|
where
|
||||||
getLprServerArg = do
|
getLprServerArg = do
|
||||||
|
|||||||
95
src/Utils/Print/CourseCertificate.hs
Normal file
95
src/Utils/Print/CourseCertificate.hs
Normal file
@ -0,0 +1,95 @@
|
|||||||
|
-- SPDX-FileCopyrightText: 2023 Steffen Jost <jost@tcs.ifi.lmu.de>
|
||||||
|
--
|
||||||
|
-- SPDX-License-Identifier: AGPL-3.0-or-later
|
||||||
|
|
||||||
|
{-# OPTIONS_GHC -fno-warn-unused-top-binds #-}
|
||||||
|
|
||||||
|
module Utils.Print.CourseCertificate where
|
||||||
|
|
||||||
|
import Import
|
||||||
|
|
||||||
|
-- import Data.Char as Char
|
||||||
|
import qualified Data.Text as Text
|
||||||
|
import qualified Data.CaseInsensitive as CI
|
||||||
|
|
||||||
|
import Data.FileEmbed (embedFile)
|
||||||
|
|
||||||
|
import Utils.Print.Letters
|
||||||
|
import Handler.Utils.Profile
|
||||||
|
|
||||||
|
data LetterCourseCertificate = LetterCourseCertificate
|
||||||
|
{ ccCourseId :: CourseId
|
||||||
|
, ccCourseName :: Text
|
||||||
|
, ccCourseShorthand :: Text
|
||||||
|
, ccCourseSchool :: Text
|
||||||
|
, ccTutorialName :: Text
|
||||||
|
, ccCourseContent :: Maybe [Text]
|
||||||
|
, ccCourseBegin :: Maybe Day
|
||||||
|
, ccCourseEnd :: Maybe Day
|
||||||
|
, ccCourseLang :: Maybe Lang -- maybe fix language to fit course content language
|
||||||
|
, ccParticipant :: UserDisplayName
|
||||||
|
, ccFraNumber :: Maybe Text
|
||||||
|
, ccFraDepartment :: Maybe Text
|
||||||
|
, ccCompany :: Maybe Text
|
||||||
|
}
|
||||||
|
deriving (Eq, Show)
|
||||||
|
|
||||||
|
|
||||||
|
instance MDLetter LetterCourseCertificate where
|
||||||
|
encrypPDFfor _ = NoPassword
|
||||||
|
getLetterKind _ = Plain
|
||||||
|
getLetterEnvelope _ = 'c'
|
||||||
|
getTemplate LetterCourseCertificate{ccCourseContent = Just ccc} =
|
||||||
|
Text.replace "%%%course-content%%%" (unlines ccc) $
|
||||||
|
decodeUtf8 $(Data.FileEmbed.embedFile "templates/letter/fraport_qualification.md")
|
||||||
|
getTemplate _ = decodeUtf8 $(Data.FileEmbed.embedFile "templates/letter/fraport_qualification.md")
|
||||||
|
|
||||||
|
letterMeta LetterCourseCertificate{..} DateTimeFormatter{ format } lang _rcvrEnt =
|
||||||
|
mkMeta
|
||||||
|
[ toMeta "participant" ccParticipant
|
||||||
|
, mbMeta "fra-number" ccFraNumber
|
||||||
|
, mbMeta "fra-department" ccFraDepartment
|
||||||
|
, mbMeta "company" ccCompany
|
||||||
|
, toMeta "course-name" ccCourseName
|
||||||
|
, mbMeta "course-content" ccCourseContent
|
||||||
|
, mbMeta "course-begin" (format SelFormatDate <$> ccCourseBegin)
|
||||||
|
, mbMeta "course-end" (format SelFormatDate <$> ccCourseEnd)
|
||||||
|
, toMeta "lang" (fromMaybe lang ccCourseLang)
|
||||||
|
]
|
||||||
|
|
||||||
|
getPJId LetterCourseCertificate{..} =
|
||||||
|
PrintJobIdentification
|
||||||
|
{ pjiName = "Certificate"
|
||||||
|
, pjiApcAcknowledge = "cc-" <> ccCourseName
|
||||||
|
, pjiRecipient = Nothing
|
||||||
|
, pjiSender = Nothing
|
||||||
|
, pjiCourse = Just ccCourseId
|
||||||
|
, pjiQualification = Nothing
|
||||||
|
, pjiLmsUser = Nothing
|
||||||
|
, pjiFileName = "cert_" <> ccCourseSchool <> "-" <> ccCourseShorthand <> "-" <> ccTutorialName
|
||||||
|
}
|
||||||
|
|
||||||
|
|
||||||
|
makeCourseCertificates :: Traversable t => Tutorial -> Maybe Lang -> t UserId -> DB (t LetterCourseCertificate)
|
||||||
|
makeCourseCertificates Tutorial{ tutorialName = CI.original -> ccTutorialName
|
||||||
|
, tutorialCourse = ccCourseId
|
||||||
|
, tutorialTime = occurrences
|
||||||
|
} ccCourseLang participants = do
|
||||||
|
Course{ courseName = CI.original -> ccCourseName
|
||||||
|
, courseShorthand = CI.original -> ccCourseShorthand
|
||||||
|
, courseSchool = CI.original . unSchoolKey -> ccCourseSchool
|
||||||
|
, courseDescription = fmap html2textlines -> ccCourseContent
|
||||||
|
} <- get404 ccCourseId
|
||||||
|
let (ccCourseBegin, ccCourseEnd) = eq2nothing $ occurrencesBounds occurrences
|
||||||
|
forM participants $ \uid -> do
|
||||||
|
User{userDisplayName=ccParticipant, userCompanyDepartment, userCompanyPersonalNumber} <- get404 uid
|
||||||
|
(ccFraNumber, ccFraDepartment, ccCompany) <-
|
||||||
|
if isJust userCompanyDepartment && validFraportPersonalNumber userCompanyPersonalNumber
|
||||||
|
then
|
||||||
|
return (userCompanyPersonalNumber, userCompanyDepartment, Nothing)
|
||||||
|
else do
|
||||||
|
usrComp <- selectFirst [UserCompanyUser ==. uid] [Desc UserCompanyId]
|
||||||
|
comp <- forM usrComp (get . userCompanyCompany . entityVal)
|
||||||
|
let res = (comp ^? _Just . _Just . _companyName . _CI) <|> userCompanyDepartment -- if there is no company, use the department as fallback, if possible
|
||||||
|
return (Nothing, Nothing, res)
|
||||||
|
return LetterCourseCertificate{..}
|
||||||
@ -36,6 +36,8 @@ import Handler.Utils.DateTime
|
|||||||
-- import Model.Types.Markup -- TODO-QSV: should this module be moved accordingly?
|
-- import Model.Types.Markup -- TODO-QSV: should this module be moved accordingly?
|
||||||
|
|
||||||
|
|
||||||
|
-- instance P.ToMetaValue (CI Text) where
|
||||||
|
-- toMetaValue = P.MetaString . CI.original
|
||||||
|
|
||||||
----------------------
|
----------------------
|
||||||
-- Pandoc Functions --
|
-- Pandoc Functions --
|
||||||
@ -172,6 +174,7 @@ data PrintJobIdentification = PrintJobIdentification
|
|||||||
, pjiCourse :: Maybe CourseId
|
, pjiCourse :: Maybe CourseId
|
||||||
, pjiQualification :: Maybe QualificationId
|
, pjiQualification :: Maybe QualificationId
|
||||||
, pjiLmsUser :: Maybe LmsIdent
|
, pjiLmsUser :: Maybe LmsIdent
|
||||||
|
, pjiFileName :: Text -- suggested filename, without suffix ".pdf"
|
||||||
}
|
}
|
||||||
deriving (Eq, Show)
|
deriving (Eq, Show)
|
||||||
|
|
||||||
@ -218,13 +221,12 @@ data EncryptPDFfor = NoPassword | PasswordSupervisor | PasswordUnderling
|
|||||||
deriving (Eq, Show)
|
deriving (Eq, Show)
|
||||||
|
|
||||||
class MDLetter l where
|
class MDLetter l where
|
||||||
getMailSubject :: l -> SomeMessage UniWorX -- only used if letter is sent by email as pdf attachment
|
letterMeta :: l -> DateTimeFormatter -> Lang -> Entity User -> P.Meta -- formatter/lang for individual receiver, set Meta "lang" for individually translated letters
|
||||||
getMailBody :: l -> DateTimeFormatter -> HtmlUrlI18n (SomeMessage UniWorX) (Route UniWorX) -- only used if letter is sent by email as pdf attachment
|
-- NOTE: METAs "date", "rcvr-name", "address" are set automatically by renderLetter for each receiver
|
||||||
letterMeta :: l -> DateTimeFormatter -> Lang -> Entity User -> P.Meta
|
|
||||||
getPJId :: l -> PrintJobIdentification
|
getPJId :: l -> PrintJobIdentification
|
||||||
getLetterEnvelope :: l -> Char
|
getLetterEnvelope :: l -> Char
|
||||||
getLetterKind :: Proxy l -> LetterKind
|
getLetterKind :: Proxy l -> LetterKind
|
||||||
getTemplate :: Proxy l -> Text
|
getTemplate :: l -> Text
|
||||||
encrypPDFfor :: Proxy l -> EncryptPDFfor
|
encrypPDFfor :: Proxy l -> EncryptPDFfor
|
||||||
|
|
||||||
letterApcIdent :: (MDLetter l, MonadHandler m) => l -> CryptoUUIDUser -> UTCTime -> m Text
|
letterApcIdent :: (MDLetter l, MonadHandler m) => l -> CryptoUUIDUser -> UTCTime -> m Text
|
||||||
@ -233,9 +235,23 @@ letterApcIdent l uuid now = do
|
|||||||
tnow <- formatTime' "%y%m%d-%H" now
|
tnow <- formatTime' "%y%m%d-%H" now
|
||||||
return $ mkApcIdent uuid (getLetterEnvelope l) (getLetterKind $ pure l) tnow (pjiApcAcknowledge $ getPJId l)
|
return $ mkApcIdent uuid (getLetterEnvelope l) (getLetterKind $ pure l) tnow (pjiApcAcknowledge $ getPJId l)
|
||||||
|
|
||||||
|
letterFileName :: (MDLetter l) => l -> FilePath
|
||||||
|
letterFileName = Text.unpack . (<> ".pdf") . text2asciiAlphaNum . pjiFileName . getPJId
|
||||||
|
|
||||||
addApcIdent :: Text -> P.Meta
|
addApcIdent :: Text -> P.Meta
|
||||||
addApcIdent = P.Meta . toMeta "apc-ident"
|
addApcIdent = P.Meta . toMeta "apc-ident"
|
||||||
|
|
||||||
getApcIdent :: P.Meta -> Maybe Text
|
getApcIdent :: P.Meta -> Maybe Text
|
||||||
getApcIdent (P.lookupMeta "apc-ident" -> Just (P.MetaString t)) = Just t
|
getApcIdent (P.lookupMeta "apc-ident" -> Just (P.MetaString t)) = Just t
|
||||||
getApcIdent _ = Nothing
|
getApcIdent _ = Nothing
|
||||||
|
|
||||||
|
|
||||||
|
----------------
|
||||||
|
-- Mail Class --
|
||||||
|
----------------
|
||||||
|
|
||||||
|
-- this is for letters that may alternatively be sent as attachments to emails
|
||||||
|
|
||||||
|
class MDMail l where --
|
||||||
|
getMailSubject :: l -> SomeMessage UniWorX -- only used if letter is sent by email as pdf attachment
|
||||||
|
getMailBody :: l -> DateTimeFormatter -> HtmlUrlI18n (SomeMessage UniWorX) (Route UniWorX) -- only used if letter is sent by email as pdf attachment
|
||||||
|
|||||||
@ -1,4 +1,4 @@
|
|||||||
-- SPDX-FileCopyrightText: 2022 Steffen Jost <jost@tcs.ifi.lmu.de>
|
-- SPDX-FileCopyrightText: 2023 Steffen Jost <jost@tcs.ifi.lmu.de>
|
||||||
--
|
--
|
||||||
-- SPDX-License-Identifier: AGPL-3.0-or-later
|
-- SPDX-License-Identifier: AGPL-3.0-or-later
|
||||||
|
|
||||||
@ -46,17 +46,19 @@ letterRenewalQualificationFData LetterRenewQualificationF{lmsLogin} = LetterRene
|
|||||||
lmsUrlLogin = lmsUrl <> "/?login=" <> lmsIdent
|
lmsUrlLogin = lmsUrl <> "/?login=" <> lmsIdent
|
||||||
lmsIdent = getLmsIdent lmsLogin
|
lmsIdent = getLmsIdent lmsLogin
|
||||||
|
|
||||||
instance MDLetter LetterRenewQualificationF where
|
instance MDMail LetterRenewQualificationF where
|
||||||
encrypPDFfor _ = PasswordUnderling
|
|
||||||
getLetterKind _ = PinLetter
|
|
||||||
getLetterEnvelope l = maybe 'q' (Char.toLower . fst) $ Text.uncons (qualShort l)
|
|
||||||
getTemplate _ = decodeUtf8 $(Data.FileEmbed.embedFile "templates/letter/fraport_renewal.md")
|
|
||||||
getMailSubject l = SomeMessage $ MsgMailSubjectQualificationRenewal $ qualShort l
|
getMailSubject l = SomeMessage $ MsgMailSubjectQualificationRenewal $ qualShort l
|
||||||
getMailBody l@LetterRenewQualificationF{..} DateTimeFormatter{ format } =
|
getMailBody l@LetterRenewQualificationF{..} DateTimeFormatter{ format } =
|
||||||
let LetterRenewQualificationFData{..} = letterRenewalQualificationFData l
|
let LetterRenewQualificationFData{..} = letterRenewalQualificationFData l
|
||||||
in $(ihamletFile "templates/mail/body/qualificationRenewal.hamlet")
|
in $(ihamletFile "templates/mail/body/qualificationRenewal.hamlet")
|
||||||
|
|
||||||
letterMeta l@LetterRenewQualificationF{..} DateTimeFormatter{ format } _lang Entity{entityKey=rcvrId, entityVal=User{userDisplayName}} =
|
instance MDLetter LetterRenewQualificationF where
|
||||||
|
encrypPDFfor _ = PasswordUnderling
|
||||||
|
getLetterKind _ = PinLetter
|
||||||
|
getLetterEnvelope l = maybe 'q' (Char.toLower . fst) $ Text.uncons (qualShort l)
|
||||||
|
getTemplate _ = decodeUtf8 $(Data.FileEmbed.embedFile "templates/letter/fraport_renewal.md")
|
||||||
|
|
||||||
|
letterMeta l@LetterRenewQualificationF{..} DateTimeFormatter{ format } lang Entity{entityKey=rcvrId, entityVal=User{userDisplayName}} =
|
||||||
let LetterRenewQualificationFData{..} = letterRenewalQualificationFData l
|
let LetterRenewQualificationFData{..} = letterRenewalQualificationFData l
|
||||||
isSupervised = rcvrId /= qualHolderID
|
isSupervised = rcvrId /= qualHolderID
|
||||||
in mkMeta $
|
in mkMeta $
|
||||||
@ -65,7 +67,8 @@ instance MDLetter LetterRenewQualificationF where
|
|||||||
, toMeta "de-opening" ("Sehr geehrte Damen und Herren,"::Text)
|
, toMeta "de-opening" ("Sehr geehrte Damen und Herren,"::Text)
|
||||||
, toMeta "en-opening" ("Dear Sir or Madam,"::Text)
|
, toMeta "en-opening" ("Dear Sir or Madam,"::Text)
|
||||||
] <>
|
] <>
|
||||||
[ toMeta "login" lmsIdent
|
[ toMeta "lang" lang
|
||||||
|
, toMeta "login" lmsIdent
|
||||||
, toMeta "pin" lmsPin
|
, toMeta "pin" lmsPin
|
||||||
, toMeta "examinee" qualHolderDN
|
, toMeta "examinee" qualHolderDN
|
||||||
, toMeta "expiry" (format SelFormatDate qualExpiry)
|
, toMeta "expiry" (format SelFormatDate qualExpiry)
|
||||||
@ -83,4 +86,10 @@ instance MDLetter LetterRenewQualificationF where
|
|||||||
, pjiCourse = Nothing
|
, pjiCourse = Nothing
|
||||||
, pjiQualification = Just qualId
|
, pjiQualification = Just qualId
|
||||||
, pjiLmsUser = Just lmsLogin
|
, pjiLmsUser = Just lmsLogin
|
||||||
|
, pjiFileName = "renew_" <> CI.original (unSchoolKey qualSchool) <> "-" <> qualShort <> "_" <> qualHolderSN
|
||||||
|
-- let nameRecipient = abbrvName <$> recipient
|
||||||
|
-- nameSender = abbrvName <$> sender
|
||||||
|
-- nameCourse = CI.original . courseShorthand <$> course
|
||||||
|
-- nameQuali = CI.original . qualificationShorthand <$> quali
|
||||||
|
-- in .. = T.replace " " "-" (T.intercalate "_" . catMaybes $ [Just printJobName, nameQuali, nameCourse, nameSender, nameRecipient])
|
||||||
}
|
}
|
||||||
@ -1,15 +1,84 @@
|
|||||||
---
|
---
|
||||||
### Metaddaten, welche hier eingestellt werden:
|
### Metaddaten, welche hier eingestellt werden:
|
||||||
|
# keine
|
||||||
### Metadaten, welche automatisch ersetzt werden:
|
### Metadaten, welche automatisch ersetzt werden:
|
||||||
lang: de-de
|
lang: de-de
|
||||||
is-de: true
|
is-de: true
|
||||||
date: 11.11.1111
|
date: 11.11.1111
|
||||||
|
test1: this **is really** a test
|
||||||
|
test2: 'this **is another** test'
|
||||||
|
test3: |
|
||||||
|
<h1>First</h1>
|
||||||
|
<p>Here is some text with <em>emphasis</em> to see.
|
||||||
...
|
...
|
||||||
|
\renewcommand{\familydefault}{\sfdefault}
|
||||||
$if(is-de)$
|
$if(is-de)$
|
||||||
|
|
||||||
|
\medskip
|
||||||
|
|
||||||
|
\begin{huge}\sffamily\textbf{Teilnahmebescheinigung}\end{huge}
|
||||||
|
|
||||||
|
\vspace{\fill}
|
||||||
|
|
||||||
|
# $participant$ {-}
|
||||||
|
$if(fra-number)$
|
||||||
|
## $fra-number$ $fra-department$ {-}
|
||||||
|
$endif$
|
||||||
|
$if(company)$
|
||||||
|
## $company$ {-}
|
||||||
|
$endif$
|
||||||
|
hat
|
||||||
|
$if(course-begin)$
|
||||||
|
$if(course-end)$
|
||||||
|
von $course-begin$ bis $course-end$
|
||||||
|
$else$
|
||||||
|
am $course-begin$
|
||||||
|
$endif$
|
||||||
|
$endif$
|
||||||
|
an der Veranstaltung
|
||||||
|
\centerline{\sffamily\LARGE{$course-name$}}
|
||||||
|
der Fahrerausbildung der Fraport AG teilgenommen.
|
||||||
|
|
||||||
|
\vspace{\fill}
|
||||||
|
\vspace{\fill}
|
||||||
|
|
||||||
|
$if(course-content)$
|
||||||
|
## Inhalte: {-}
|
||||||
|
|
||||||
|
|
||||||
|
%%%course-content%%%
|
||||||
|
|
||||||
|
|
||||||
|
$endif$
|
||||||
|
|
||||||
|
\vspace{\fill}
|
||||||
|
\vspace{\fill}
|
||||||
|
|
||||||
|
Mit Aushändigung der Teilnahmebescheinigung wird der erfolgreiche Abschluss des Kurses bestätigt.
|
||||||
|
Dieses Zertifikat wurde maschinell erstellt.
|
||||||
|
|
||||||
|
\medskip
|
||||||
|
|
||||||
|
Frankfurt am Main, $date$
|
||||||
|
Fraport College
|
||||||
|
|
||||||
|
\vspace{\fill}
|
||||||
|
\vspace{\fill}
|
||||||
|
\vspace{\fill}
|
||||||
|
\vspace{\fill}
|
||||||
|
\vspace{\fill}
|
||||||
|
|
||||||
<!-- deutsche version -->
|
<!-- deutsche version -->
|
||||||
|
|
||||||
$else$
|
$else$
|
||||||
|
|
||||||
<!-- english version -->
|
<!-- english version -->
|
||||||
|
|
||||||
|
# Certificate of attendance
|
||||||
|
|
||||||
|
**English version is not yet implemened.**
|
||||||
|
TODO
|
||||||
|
|
||||||
|
$endif$
|
||||||
|
|
||||||
|
\clearpage
|
||||||
@ -1,8 +1,9 @@
|
|||||||
%Based upon https://github.com/benedictdudel/pandoc-letter-din5008
|
%Based upon https://github.com/benedictdudel/pandoc-letter-din5008
|
||||||
\documentclass[
|
\documentclass[
|
||||||
paper=A4,
|
paper=A4,
|
||||||
|
version=last,
|
||||||
firstfoot=false % first-page footer
|
firstfoot=false % first-page footer
|
||||||
]{scrlttr2}
|
]{scrartcl}
|
||||||
|
|
||||||
\PassOptionsToPackage{hyphens}{url}
|
\PassOptionsToPackage{hyphens}{url}
|
||||||
\PassOptionsToPackage{unicode$for(hyperrefoptions)$,$hyperrefoptions$$endfor$}{hyperref}
|
\PassOptionsToPackage{unicode$for(hyperrefoptions)$,$hyperrefoptions$$endfor$}{hyperref}
|
||||||
@ -58,6 +59,7 @@ $endif$
|
|||||||
% if luatex or xetex
|
% if luatex or xetex
|
||||||
\usepackage{fontspec}
|
\usepackage{fontspec}
|
||||||
\setmonofont{DejaVu Sans Mono}
|
\setmonofont{DejaVu Sans Mono}
|
||||||
|
%\renewcommand{\familydefault}{\sfdefault}
|
||||||
\fi
|
\fi
|
||||||
|
|
||||||
$if(mathspec)$
|
$if(mathspec)$
|
||||||
@ -84,9 +86,9 @@ $endif$
|
|||||||
|
|
||||||
\usepackage{enumitem}
|
\usepackage{enumitem}
|
||||||
|
|
||||||
\setlength{\oddsidemargin}{\useplength{toaddrhpos}}
|
%\setlength{\oddsidemargin}{\useplength{toaddrhpos}}
|
||||||
\addtolength{\oddsidemargin}{-1in}
|
%\addtolength{\oddsidemargin}{-1in}
|
||||||
\setlength{\textwidth}{\useplength{firstheadwidth}}
|
%\setlength{\textwidth}{\useplength{firstheadwidth}}
|
||||||
|
|
||||||
\usepackage[absolute,quiet,overlay]{textpos}%,showboxes
|
\usepackage[absolute,quiet,overlay]{textpos}%,showboxes
|
||||||
\setlength{\TPHorizModule}{1mm}
|
\setlength{\TPHorizModule}{1mm}
|
||||||
@ -95,6 +97,8 @@ $endif$
|
|||||||
\providecommand{\tightlist}{%
|
\providecommand{\tightlist}{%
|
||||||
\setlength{\itemsep}{0pt}\setlength{\parskip}{0pt}}
|
\setlength{\itemsep}{0pt}\setlength{\parskip}{0pt}}
|
||||||
|
|
||||||
|
\pagestyle{empty}
|
||||||
|
|
||||||
\begin{document}%
|
\begin{document}%
|
||||||
$if(apc-ident)$
|
$if(apc-ident)$
|
||||||
\begin{textblock}{200}(5,5)%hpos,vpos
|
\begin{textblock}{200}(5,5)%hpos,vpos
|
||||||
|
|||||||
@ -942,11 +942,11 @@ fillDb = do
|
|||||||
, courseTerm = tk
|
, courseTerm = tk
|
||||||
, courseSchool = avn
|
, courseSchool = avn
|
||||||
, courseCapacity = capacity
|
, courseCapacity = capacity
|
||||||
, courseVisibleFrom = jtt TermDayStart 0 Nothing toMidnight
|
, courseVisibleFrom = jtt TermDayStart 1 Nothing toMidnight
|
||||||
, courseVisibleTo = jtt TermDayEnd 0 Nothing beforeMidnight
|
, courseVisibleTo = jtt TermDayEnd 10 Nothing beforeMidnight
|
||||||
, courseRegisterFrom = jtt TermDayStart 0 Nothing toMidnight
|
, courseRegisterFrom = jtt TermDayLectureStart 0 Nothing toMidnight
|
||||||
, courseRegisterTo = jtt TermDayLectureStart (-1) Nothing toMidnight
|
, courseRegisterTo = jtt TermDayLectureStart 1 Nothing toMidnight
|
||||||
, courseDeregisterUntil = jtt TermDayLectureStart (-5) (Just Monday) toMidnight
|
, courseDeregisterUntil = jtt TermDayLectureStart 5 (Just Monday) toMidnight
|
||||||
, courseRegisterSecret = Nothing
|
, courseRegisterSecret = Nothing
|
||||||
, courseMaterialFree = True
|
, courseMaterialFree = True
|
||||||
}
|
}
|
||||||
|
|||||||
Reference in New Issue
Block a user