chore(qualifications): expiry letter for test sending created

src/Handler/PrintCenter.hs

@@ -2,7 +2,7 @@
 --
 -- SPDX-License-Identifier: AGPL-3.0-or-later
 
-{-# LANGUAGE TypeApplications #-}
+{-# LANGUAGE TypeApplications, ExistentialQuantification #-}
 {-# OPTIONS_GHC -fno-warn-orphans #-}
 
 module Handler.PrintCenter
@@ -25,6 +25,8 @@ import qualified Database.Esqueleto.Utils as E
 import Database.Esqueleto.Utils.TH
 
 import Utils.Print
+import Utils.Print.Letters (MDLetter)
+
 -- import Data.Aeson (encode)
 import qualified Data.Text as Text
 -- import qualified Data.Set  as Set
@@ -37,20 +39,24 @@ import Handler.Utils
 single :: (k,a) -> Map k a
 single = uncurry Map.singleton
 
+data SomeLetter = forall l . (MDLetter l) => SomeLetter l -- a record selector would be useless here due to the escaped type variable
+
 data LRQF = LRQF 
-    { lrqfUser  :: Either UserEmail UserId
+    { lrqfLetter  :: Text 
-    , lrqfSuper :: Maybe (Either UserEmail UserId)
+    , lrqfUser    :: Either UserEmail UserId
-    , lrqfQuali :: Entity Qualification 
+    , lrqfSuper   :: Maybe (Either UserEmail UserId)
-    , lrqfIdent :: LmsIdent
+    , lrqfQuali   :: Entity Qualification 
-    , lrqfPin   :: Text
+    , lrqfIdent   :: LmsIdent
-    , lrqfExpiry:: Day
+    , lrqfPin     :: Text
+    , lrqfExpiry  :: Day
     } deriving (Eq, Generic)
 
 makeRenewalForm :: Maybe LRQF -> Form LRQF
 makeRenewalForm tmpl = identifyForm FIDLmsLetter . validateForm validateLetterRenewQualificationF $ \html -> do
   -- now_day <- utctDay <$> liftIO getCurrentTime
   flip (renderAForm FormStandard) html $ LRQF
-    <$> areq (userField False Nothing)  (fslI MsgLmsUser)                      (lrqfUser   <$> tmpl)
+    <$> areq textField                  (fslI MsgLmsUser)                      (lrqfLetter <$> tmpl)
+    <*> areq (userField False Nothing)  (fslI MsgLmsUser)                      (lrqfUser   <$> tmpl)
     <*> aopt (userField False Nothing)  (fslI MsgTableSupervisor)              (lrqfSuper  <$> tmpl)
     <*> areq qualificationFieldEnt      (fslI MsgQualificationName)            (lrqfQuali  <$> tmpl)
     <*> areq lmsField                   (fslI MsgTableLmsIdent)                (lrqfIdent  <$> tmpl) 
@@ -64,8 +70,9 @@ validateLetterRenewQualificationF = -- do
   -- LRQF{..} <- State.get
   return ()
 
-lrqf2letter :: LRQF -> DB (Entity User, LetterRenewQualificationF)
+lrqf2letter :: LRQF -> DB (Entity User, SomeLetter)
-lrqf2letter LRQF{..} = do 
+lrqf2letter LRQF{..} 
+  | lrqfLetter == "r" = do 
     usr   <-      getUser lrqfUser
     rcvr  <- mapM getUser lrqfSuper
     let letter = LetterRenewQualificationF 
@@ -81,7 +88,24 @@ lrqf2letter LRQF{..} = do
           , qualSchool    = lrqfQuali ^. _qualificationSchool
           , qualDuration  = lrqfQuali ^. _qualificationValidDuration
           }
-    return (fromMaybe usr rcvr, letter)
+    return (fromMaybe usr rcvr, SomeLetter letter)
+  | lrqfLetter == "e" = do 
+    rcvr    <- mapM getUser lrqfSuper
+    usr     <-      getUser lrqfUser
+    usrUuid <- encrypt $ entityKey usr
+    let letter = LetterExpireQualificationF 
+          { leqfHolderUUID  = usrUuid
+          , leqfHolderID    = usr ^. _entityKey
+          , leqfHolderDN    = usr ^. _userDisplayName
+          , leqfHolderSN    = usr ^. _userSurname
+          , leqfExpiry      = lrqfExpiry
+          , leqfId          = lrqfQuali ^. _entityKey
+          , leqfName        = lrqfQuali ^. _qualificationName      . _CI
+          , leqfShort       = lrqfQuali ^. _qualificationShorthand . _CI
+          , leqfSchool      = lrqfQuali ^. _qualificationSchool          
+          }
+    return (fromMaybe usr rcvr, SomeLetter letter)
+  | otherwise = error "Unknown Letter Type encountered. Use 'e' or 'r' only."
   where 
     getUser :: Either UserEmail UserId -> DB (Entity User)
     getUser (Right uid) = getEntity404 uid
@@ -175,7 +199,7 @@ mkPJTable = do
       , sortable (Just "sender")       (i18nCell MsgPrintSender)           $ \(preview resultSender    -> u) -> maybeCell u $ cellHasUserLink AdminUserR
       , sortable (Just "course")       (i18nCell MsgPrintCourse)           $ \(preview $ resultCourse        . _entityVal -> c) -> maybeCell c courseCell
       , sortable (Just "qualification")(i18nCell MsgPrintQualification)    $ \(preview $ resultQualification . _entityVal -> q) -> maybeCell q qualificationCell
-      , sortable (Just "lmsid")        (i18nCell MsgPrintLmsUser)          $ \(   view $ resultPrintJob . _entityVal . _printJobLmsUser -> l) -> foldMap textCell (getLmsIdent <$> l)
+      , sortable (Just "lmsid")        (i18nCell MsgPrintLmsUser)          $ \(   view $ resultPrintJob . _entityVal . _printJobLmsUser -> l) -> foldMap (textCell . getLmsIdent) l
       ]
     dbtSorting = mconcat
       [ single ("name"         , SortColumn $ queryPrintJob      >>> (E.^. PrintJobName))
@@ -277,7 +301,8 @@ postPrintSendR = do
   let nowaday = utctDay now
       uid = usr ^. _entityKey
       mkLetter qual = LRQF
-        { lrqfUser      = Right uid
+        { lrqfLetter    = "r"
+        , lrqfUser      = Right uid
         , lrqfSuper     = Nothing
         , lrqfQuali     = qual
         , lrqfIdent     = LmsIdent  "stuvwxyz"
@@ -288,7 +313,9 @@ postPrintSendR = do
 
   ((sendResult, sendWidget), sendEnctype) <- runFormPost $ makeRenewalForm def_lrqf
   let procFormSend lrqf = do
-        ok <- (runDB (lrqf2letter lrqf) >>= printLetter (Just uid)) >>= \case 
+        ok <- (runDB (lrqf2letter lrqf) >>= \case
+                (entUsr, SomeLetter l) -> printLetter (Just uid) (entUsr, l)
+              ) >>= \case 
           Left err -> do
             let msg = "PDF printing failed with error: " <> err
             $logErrorS "LPR" msg

src/Utils/Print.hs

@@ -17,7 +17,10 @@ module Utils.Print
   , _Meta, addMeta
   , toMeta, mbMeta                           -- single values
   , mkMeta, appMeta, applyMetas              -- multiple values
+  -- , MDMail
+  -- , MDLetter
   , LetterRenewQualificationF(..)
+  , LetterExpireQualificationF(..)
   -- , LetterCourseCertificate()
   , makeCourseCertificates
   ) where
@@ -53,6 +56,7 @@ import Jobs.Handler.SendNotification.Utils
 import Utils.Print.Instances ()
 import Utils.Print.Letters
 import Utils.Print.RenewQualification
+import Utils.Print.ExpireQualification
 import Utils.Print.CourseCertificate
 
 

src/Utils/Print/ExpireQualification.hs

@@ -9,8 +9,8 @@ module Utils.Print.ExpireQualification where
 import Import 
 import Text.Hamlet
 
-import           Data.Char as Char
+-- import           Data.Char as Char
-import qualified Data.Text as Text
+-- import qualified Data.Text as Text
 import qualified Data.CaseInsensitive as CI
 
 import Data.FileEmbed (embedFile)
@@ -20,7 +20,8 @@ import Handler.Utils.Widgets (nameHtml) -- , nameHtml')
 
 
 data LetterExpireQualificationF = LetterExpireQualificationF
-    { leqfHolderID  :: UserId
+    { leqfHolderUUID:: CryptoUUIDUser
+    , leqfHolderID  :: UserId
     , leqfHolderDN  :: UserDisplayName
     , leqfHolderSN  :: UserSurname
     , leqfExpiry    :: Day
@@ -31,22 +32,29 @@ data LetterExpireQualificationF = LetterExpireQualificationF
     }
   deriving (Eq, Show)
 
--- TODO:
+-- TODO: use markdown to generate the Letter
--- instance MDMail LetterExpireQualificationF where 
+instance MDMail LetterExpireQualificationF where 
---   getMailSubject    l = SomeMessage $ MsgMailSubjectQualificationRenewal $ qualShort l  
+  getMailSubject    l = SomeMessage $ MsgMailSubjectQualificationExpired $ leqfShort l  
---   getMailBody l@LetterRenewQualificationF{..} DateTimeFormatter{ format } = 
+  getMailBody LetterExpireQualificationF{..} DateTimeFormatter{ format } = 
---     let LetterRenewQualificationFData{..} = letterRenewalQualificationFData l
+    let expiryDate              = format SelFormatDate leqfExpiry
---     in $(ihamletFile "templates/mail/body/qualificationRenewal.hamlet")
+        userDisplayName         = leqfHolderDN
+        userSurname             = leqfHolderSN        
+        qualificationName       = leqfName
+        qualificationShorthand  = CI.mk leqfShort  
+        qualificationSchool     = leqfSchool
+        qname                   = qualificationName
+        ihamletSomeMessage _ _ _ = (mempty :: Html)  -- TODO: use markdown for letter
+        editNotifications        = ()                -- TODO: use markdown for letter
+    in $(ihamletFile "templates/mail/qualificationExpired.hamlet")
 
 instance MDLetter LetterExpireQualificationF where  
   encrypPDFfor      _ = NoPassword
   getLetterKind     _ = Din5008
-  getLetterEnvelope l = 'e'
+  getLetterEnvelope _ = 'e'
-  getTemplate       _ = decodeUtf8 $(Data.FileEmbed.embedFile "templates/letter/fraport_renewal.md")
+  getTemplate       _ = decodeUtf8 $(Data.FileEmbed.embedFile "templates/letter/fraport_f_expiry.md")
 
-  letterMeta l@LetterRenewQualificationF{..} DateTimeFormatter{ format } lang Entity{entityKey=rcvrId, entityVal=User{userDisplayName}} = 
+  letterMeta LetterExpireQualificationF{..} DateTimeFormatter{ format } lang Entity{entityKey=rcvrId, entityVal=User{userDisplayName}} = 
-    let LetterRenewQualificationFData{..} = letterRenewalQualificationFData l 
+    let isSupervised = rcvrId /= leqfHolderID
-        isSupervised = rcvrId /= qualHolderID
     in mkMeta $
       guardMonoid isSupervised
       [ toMeta "supervisor" userDisplayName
@@ -54,25 +62,20 @@ instance MDLetter LetterExpireQualificationF where
       , toMeta "en-opening" ("Dear Sir or Madam,"::Text)
       ] <>
       [ toMeta "lang"           lang
-      , toMeta "login"          lmsIdent
+      , toMeta "licenceholder"  leqfHolderDN
-      , toMeta "pin"            lmsPin
+      , toMeta "expiry"         (format SelFormatDate leqfExpiry)
-      , toMeta "examinee"       qualHolderDN
-      , toMeta "expiry"         (format SelFormatDate qualExpiry)
-      , mbMeta "validduration"  (show <$> qualDuration)
-      , toMeta "url-text"       lmsUrl
-      , toMeta "url"            lmsUrlLogin
       ] 
 
-  getPJId LetterRenewQualificationF{..} =
+  getPJId LetterExpireQualificationF{..} =
     PrintJobIdentification
-      { pjiName             = "Renewal"
+      { pjiName             = "Expiry"
-      , pjiApcAcknowledge   = "lms-" <> getLmsIdent lmsLogin
+      , pjiApcAcknowledge   = "exp-" <> tshow (ciphertext leqfHolderUUID)
       , pjiRecipient        = Nothing       -- to be filled later
       , pjiSender           = Nothing
       , pjiCourse           = Nothing
-      , pjiQualification    = Just qualId
+      , pjiQualification    = Just leqfId
-      , pjiLmsUser          = Just lmsLogin
+      , pjiLmsUser          = Nothing
-      , pjiFileName         = "renew_" <> CI.original (unSchoolKey qualSchool) <> "-" <> qualShort <> "_" <> qualHolderSN 
+      , pjiFileName         = "expire_" <> CI.original (unSchoolKey leqfSchool) <> "-" <> leqfShort <> "_" <> leqfHolderSN 
         -- let nameRecipient = abbrvName <$> recipient
         --     nameSender    = abbrvName <$> sender
         --     nameCourse    = CI.original . courseShorthand        <$> course

src/Utils/Print/RenewQualification.hs

@@ -9,8 +9,8 @@ module Utils.Print.RenewQualification where
 import Import 
 import Text.Hamlet
 
-import           Data.Char as Char
+-- import           Data.Char as Char
-import qualified Data.Text as Text
+-- import qualified Data.Text as Text
 import qualified Data.CaseInsensitive as CI
 
 import Data.FileEmbed (embedFile)
@@ -55,7 +55,7 @@ instance MDMail LetterRenewQualificationF where
 instance MDLetter LetterRenewQualificationF where  
   encrypPDFfor      _ = PasswordUnderling
   getLetterKind     _ = PinLetter
-  getLetterEnvelope l = 'f' -- maybe 'q' (Char.toLower . fst) $ Text.uncons (qualShort l)
+  getLetterEnvelope _ = 'f' -- 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}} = 

templates/letter/fraport_f_expiry.md

@@ -0,0 +1,132 @@
+---
+### Metadaten, welche hier eingestellt werden:
+# Absender
+de-subject: 'Entzug "F" (Vorfeldführerschein)'
+en-subject: Revocation of apron driving license
+author: Fraport AG - Fahrerausbildung (AVN-AR)
+phone: +49 69 690-28467
+email: fahrerausbildung@fraport.de
+place: Frankfurt am Main
+return-address: 
+ - 60547 Frankfurt
+de-opening: Liebe Fahrberechtigungsinhaber,
+en-opening: Dear driver,
+de-closing: |
+  Mit freundlichen Grüßen,  
+    Ihre Fraport Fahrerausbildung
+en-closing: |
+  With kind regards,  
+    Your Fraport Driver Training
+encludes:
+hyperrefoptions: hidelinks
+
+### Metadaten, welche automatisch ersetzt werden:
+date: 11.11.1111
+expiry: 00.00.0000
+lang: de-de
+is-de: true
+# Emfpänger
+licenceholder: P. Rüfling
+address:
+ - E. M. Pfänger
+ - Musterfirma GmbH
+ - Musterstraße 11
+ - 12345 Musterstadt
+...
+$if(titleblock)$
+$titleblock$
+
+$endif$
+$for(header-includes)$
+$header-includes$
+        
+$endfor$
+$for(include-before)$
+$include-before$
+
+$endfor$
+
+$if(is-de)$
+
+<!-- deutsche Version des Briefes  -->
+$if(supervisor)$
+  leider hat $licenceholder$
+$else$
+  leider haben Sie
+$endif$
+den Wissenstest im Rahmen des Recurrent Trainings Vorfeldführerschein nicht bestanden 
+oder die Ablauffrist nicht eingehalten.  
+
+
+Die Qualifikation „Vorfeldführerschein“ ist somit nicht mehr gültig.  
+
+
+$if(supervisor)$
+**$licenceholder$** darf 
+$else$
+  Sie dürfen
+$endif$
+ab sofort keine Fahrzeuge mehr eigenständig auf dem Vorfeld des Frankfurter Flughafens führen.
+
+
+Um die Fahrberechtigung wiederzuerlangen, ist die Teilnahme an einem Grundkurs Vorfeldführerschein erforderlich.
+
+$if(supervisor)$
+Hierfür wenden Sie sich bitte an die Fahrerausbildung der Fraport AG unter:
+
+Telefon
+  
+  : $phone$
+
+Email
+  
+  : $email$
+
+$else$
+Hierfür wenden Sie sich bitte an Ihren Arbeitgeber.
+
+
+$else$
+
+<!-- englische Version des Briefes  -->
+we regret to inform you that 
+$if(supervisor)$
+  **$licenceholder$**
+$else$
+  you
+$endif$
+did not pass the required knowledge test within the alotted time
+for the renewal of the apron driving licence.
+
+
+The qualification „Vorfeldführerschein“ (apron driving lincence) is therefore invalid now.
+
+
+$if(supervisor)$
+  $licenceholder$
+$else$
+  You
+$endif$
+may no longer drive a vehicle on the apron of Frankfurt airport, effective immediately.
+
+
+In order to regain this apron driving licence, a full participation in a
+basic training course is required.
+
+$if(supervisor)$
+Please contact the Fraport driving school team, if you want to book a course:
+
+Phone
+  
+  : $phone$
+
+Email
+  
+  : $email$
+
+$else$
+Please contact you employer to book a course for you.
+
+
+$endif$
+

templates/letter/fraport_renewal.md

@@ -13,7 +13,7 @@ de-opening: Liebe Fahrberechtigungsinhaber,
 en-opening: Dear driver,
 de-closing: |
   Mit freundlichen Grüßen,  
-    Ihre Fahrerausbildung
+    Ihre Fraport Fahrerausbildung
 en-closing: |
   With kind regards,  
     Your Fraport Driver Training
@@ -133,7 +133,7 @@ $if(supervisor)$
   to regain the apron driving licence.
 $else$
   you have to participate in a basic training course again to regain
-  your apron driving licnece.
+  your apron driving licence.
 $endif$