chore(qualifications): use blocking mechanism (WIP)

messages/uniworx/categories/avs/de-de-formal.msg

@@ -22,10 +22,11 @@ AvsImportAmbiguous n@Int: Import für #{show n} uneindeutige AVS IDs fehlgeschla
 AvsImportUnknowns n@Int: Import für #{show n} unbekannte AVS IDs fehlgeschlagen
 AvsSetLicences alic@AvsLicence n@Int m@Int: _{alic} im AVS gesetzt: #{show n}/#{show m}
 SetFraDriveLicences q@String n@Int: #{q} in FRADrive gewährt für #{show n} Benutzer
-RevokeFraDriveLicences alic@AvsLicence n@Int: _{alic} in FRADrive zum Vortag beendet für #{show n} Fahrer
+RevokeFraDriveLicencesError alic@AvsLicence: Entzug der _{alic} Lizenzen komplett fehlgeschlagen
+RevokeFraDriveLicences alic@AvsLicence n@Int: _{alic} in FRADrive entzogen für #{show n} Fahrer
 RevokeUnknownLicencesOk: AVS Fahrberechtigungen unbekannter Fahrer wurden gesperrt
 RevokeUnknownLicencesFail: Nicht alle AVS Fahrberechtigungen unbekannter Fahrer konnten entzogen werden, siehe Log für Details
 AvsCommunicationError: AVS Schnittstelle lieferte einen unerwarteten Fehler.
 LicenceTableChangeAvs: Im AVS ändern
 LicenceTableGrantFDrive: In FRADrive erteilen
-LicenceTableRevokeFDrive: In FRADrive zum Vortag entziehen
+LicenceTableRevokeFDrive: In FRADrive entziehen

messages/uniworx/categories/avs/en-eu.msg

@@ -22,10 +22,11 @@ AvsImportAmbiguous n@Int: Import failed for #{show n} ambiguous AVS Ids
 AvsImportUnknowns n@Int: Import failed for #{show n} unknown AVS Ids
 AvsSetLicences alic n m: _{alic} set in AVS: #{show n}/#{show m}
 SetFraDriveLicences q@String n@Int: #{q} granted in FRADrive for #{show n} users
-RevokeFraDriveLicences alic@AvsLicence n@Int: _{alic} now ended yesterday in FRADrive for #{show n} drivers
+RevokeFraDriveLicencesError alic@AvsLicence: Revoking licences _{alic} failed entirely
+RevokeFraDriveLicences alic@AvsLicence n@Int: _{alic} revoked in FRADrive for #{show n} drivers
 RevokeUnknownLicencesOk: AVS driving licences of unknown drivers revoked
 RevokeUnknownLicencesFail: Not all AVS driving licences of unknown drivers could be revoked, see log for details
 AvsCommunicationError: AVS interface returned an unexpected error.
 LicenceTableChangeAvs: Change in AVS
 LicenceTableGrantFDrive: Grant in FRADrive
-LicenceTableRevokeFDrive: Revoke yesterday in FRADrive
+LicenceTableRevokeFDrive: Revoke in FRADrive

messages/uniworx/categories/qualification/de-de-formal.msg

@@ -20,13 +20,14 @@ TableQualificationSapExportTooltip: Wird die Qualifikation an das SAP übermitte
 LmsQualificationValidUntil: Gültig bis
 TableQualificationLastRefresh: Zuletzt erneuert
 TableQualificationFirstHeld: Erstmalig
-TableQualificationBlockedDue: Suspendiert
+TableQualificationBlockedDue: Entzogen
 TableQualificationBlockedTooltip: Wann wurde die Qualifikation vorübergehend außer Kraft gesetzt und warum wurde dies veranlasst?
 TableQualificationBlockedTooltipSimple: Wann wurde die Qualifikation aus besonderem Grund wiederrufen?
 TableQualificationNoRenewal: Storniert
 TableQualificationNoRenewalTooltip: Es wird keine Benachrichtigung mehr versendet, wenn diese Qualifikation ablaufen sollte. Die Qualifikation kann noch gültig sein.
 QualificationUserNoRenewal: Läuft ohne Benachrichtigung aus
 QualificationUserNone: Für diese Person sind keine Qualifikationen registriert.
+QualificationBlockReason: Entzugsbegründung
 LmsUser: Inhaber
 TableLmsEmail: E-Mail
 TableLmsIdent: LMS Identifikation
@@ -70,10 +71,13 @@ MailSubjectQualificationExpired qname@Text: Qualifikation #{qname} ist ab sofort
 MailBodyQualificationRenewal qname@Text: Sie müssen die Qualifikation #{qname} demnächst durch einen E-Learning Kurs erneuern, siehe Anhang.
 MailBodyQualificationExpiry: Diese Qualifikation läuft bald ab. Tätigkeiten, welche diese Qualifikation voraussetzen dürfen dann nicht länger ausgeübt werden!
 MailBodyQualificationExpired: Diese Qualifikation is nun abgelaufen. Tätigkeiten, welche diese Qualifikation voraussetzen dürfen ab sofort nicht länger ausgeübt werden! Es ist möglich, dass die Qualifikation vorzeit ungültig wurde, z.B. wegen erfolgloser Teilnahme an einem verpflichtendem E-Learning.
-QualificationActExpire: Qualifikation ohne Benachrichtigung auslaufen lassen
+QualificationActExpire: Stornieren - Qualifikation läuft ohne Benachrichtigung ab
-QualificationActUnexpire: Benachrichtigung bei anstehender Erneuerung senden
+QualificationActUnexpire: Stornierung aufheben - Benachrichtigung bei anstehender Erneuerung senden
 QualificationSetExpire n@Int64: Benachrichtigung bei anstehender Erneuerung und E-Learning abgeschaltet für #{n} #{pluralDE n "Person" "Personen"}
 QualificationSetUnexpire n@Int64: Benachrichtigung bei anstehender Erneuerung und E-Learning aktiviert für #{n} #{pluralDE n "Person" "Personen"}
+QualificationActBlockSupervisor: Dauerhaft zurückgeben
+QualificationActBlock: Entziehen
+QualificationActUnblock: Entzug löschen
 LmsRenewalInstructions: Anweisungen zur Verlängerung finden Sie im angehängten PDF. Um Missbrauch zu verhindern wurde das PDF dem von Ihnen in FRADrive hinterlegten PDF-Passwort verschlüsselt. Falls kein PDF-Passwort manuell hinterlegt wurde, ist das PDF-Passwort Ihre Flughafen Ausweisnummer, inklusive Punkt und der Ziffer danach.
 LmsNoRenewal: Leider kann diese Qualifikation nicht alleine durch E-Learning verlängert werden.
 LmsActNotify: Benachrichtigung E-Learning erneut per Post oder E-Mail versenden

messages/uniworx/categories/qualification/en-eu.msg

@@ -20,13 +20,14 @@ TableQualificationSapExportTooltip: Is this qualification transmitted to SAP? On
 LmsQualificationValidUntil: Valid until
 TableQualificationLastRefresh: Last renewed
 TableQualificationFirstHeld: First held
-TableQualificationBlockedDue: Suspended
+TableQualificationBlockedDue: Revoked
 TableQualificationBlockedTooltip: Why and when was this qualification temporarily suspended?
 TableQualificationBlockedTooltipSimple: When was this qualification revoked due to extraordinary reasons?
-TableQualificationNoRenewal: Canceled
+TableQualificationNoRenewal: Cancelled
 TableQualificationNoRenewalTooltip: No renewal notifications will be send for this qualification upon expiry. The qualification may still be valid.
 QualificationUserNoRenewal: Expires without further notification
 QualificationUserNone: No registered qualifications for this person.
+QualificationBlockReason: Reason for revoking
 LmsUser: Licensee
 TableLmsEmail: Email
 TableLmsIdent: LMS Identifier
@@ -70,10 +71,13 @@ MailSubjectQualificationExpired qname: Qualification #{qname} is no longer valid
 MailBodyQualificationRenewal qname: You will soon need to renew qualification #{qname} by completing an e-learning course. For details see attachment.
 MailBodyQualificationExpiry: This qualification expires soon. You may then no longer execute any duties that require this qualification as a precondition!
 MailBodyQualificationExpired: This qualification is now expired. You may no longer execute any duties that require this qualification as a precondition! It is possible that the qualification expired prematurely, e.g. due to a failed compulsory e-learning.
-QualificationActExpire: Qualification shall expire silently
+QualificationActExpire: Cancel - qualification expires silently
-QualificationActUnexpire: Notify upon due renewal
+QualificationActUnexpire: Uncancel - notify upon due renewal
 QualificationSetExpire n: Expiry notification and e-learning deactivated for #{n} #{pluralENs n "person"}
 QualificationSetUnexpire n: Expiry notification and e-learning activated for #{n} #{pluralENs n "person"}
+QualificationActBlockSupervisor: Waive permanently
+QualificationActBlock: Revoke
+QualificationActUnblock: Clear revocation
 LmsRenewalInstructions: Instruction on how to accomplish the renewal are enclosed in the attached PDF. In order to avoid misuse, the PDF is encrypted with your chosen FRADrive PDF-Password. If you have not yet chosen a PDF-Password yet, then the password is your Fraport id card number, inkluding the punctuation mark and the Digit thereafter.
 LmsNoRenewal: Unfortunately, this particular qualification cannot be renewed through E-learning only. 
 LmsActNotify: Resend e-learning notification by post or email

src/Audit/Types.hs

@@ -197,20 +197,24 @@ data Transaction
     , transactionNote          :: Maybe Text
     , transactionReceived      :: UTCTime -- when was the csv file received?
     }
-
+  | TransactionQualificationUserEdit  -- Note that a renewal always entails unblocking as well!
-  | TransactionQualificationUserEdit
+    { transactionUser                         :: UserId                 -- qualification holder that is updated
-    { transactionQualificationUser            :: QualificationUserId
+    , transactionQualificationUser            :: QualificationUserId
     , transactionQualification                :: QualificationId    
-    , transactionUser                         :: UserId                 -- qualification holder that is updated
     , transactionQualificationValidUntil      :: Day
     , transactionQualificationScheduleRenewal :: Maybe Bool -- Maybe, because some update may leave it unchanged (also avoids DB Migration)
     }
   | TransactionQualificationUserDelete
-    { transactionQualificationUser :: QualificationUserId
+    { transactionUser               :: UserId
-    , transactionQualification     :: QualificationId
+    , transactionQualificationUser  :: QualificationUserId
-    , transactionUser              :: UserId
+    , transactionQualification      :: QualificationId
+    }
+  | TransactionQualificationUserBlocking
+    { transactionUser               :: UserId                         -- qualification holder that is updated
+      -- , transactionQualificationUser  :: QualificationUserId         -- not neccessary due to UniqueQualificationUser
+    , transactionQualification      :: QualificationId
+    , transactionQualificationBlock :: Maybe QualificationBlocked     -- Nothing indicates unblocking    
     }
-
   deriving (Eq, Ord, Read, Show, Generic)
 
 deriveJSON defaultOptions

src/Handler/Admin/Avs.hs

@@ -309,11 +309,15 @@ nullaryPathPiece ''LicenceTableAction $ camelToPathPiece' 2
 embedRenderMessage ''UniWorX ''LicenceTableAction id
 
 data LicenceTableActionData =  LicenceTableChangeAvsData
-                            |  LicenceTableRevokeFDriveData --TODO: add { licenceTableChangeFDriveQId :: QualificationId to avoid lookup later
+                            |  LicenceTableRevokeFDriveData 
-                            |  LicenceTableGrantFDriveData { licenceTableChangeFDriveQId    :: QualificationId
+                              { licenceTableChangeFDriveQId     :: QualificationId
-                                                           , licenceTableChangeFDriveEnd    :: Day
+                              , licenceTableChangeFDriveReason  :: Text
-                                                           , licenceTableChangeFDriveRenew  :: Maybe Bool
+                              }
-                                                           }
+                            |  LicenceTableGrantFDriveData 
+                              { licenceTableChangeFDriveQId     :: QualificationId
+                              , licenceTableChangeFDriveEnd     :: Day
+                              , licenceTableChangeFDriveRenew   :: Maybe Bool
+                              }
   deriving (Eq, Ord, Read, Show, Generic)
 
 
@@ -393,19 +397,26 @@ getProblemAvsSynchR = do
         addMessageI mkind $ MsgAvsSetLicences aLic oks no_req                  
         redirect ProblemAvsSynchR -- reload to update all tables
 
-      procRes alic (LicenceTableRevokeFDriveData, apids) = do 
+      procRes alic (LicenceTableRevokeFDriveData{..}, apids) = do 
-        nups <- runDB $ do
+        oks <- runDB $ do
           qId <- getKeyBy404 $ UniqueQualificationAvsLicence $ Just alic
-          selectedUsers <- view _userAvsUser <<$>> selectList [UserAvsPersonId <-. Set.toList apids] []
+          if qId /= licenceTableChangeFDriveQId 
-          forM_ selectedUsers $ upsertQualificationUser qId nowaday (pred nowaday) Nothing
+            then return (-1)
-          return $ length selectedUsers
+            else do
-        addMessageI Success $ MsgRevokeFraDriveLicences alic nups
+              uids <- view _userAvsUser <<$>> selectList [UserAvsPersonId <-. Set.toList apids] []
+              qualificationUserBlocking licenceTableChangeFDriveQId uids $
+                    Just $ QualificationBlocked 
+                    { qualificationBlockedDay     = nowaday
+                    , qualificationBlockedReason  = licenceTableChangeFDriveReason
+                    }               
+        if | oks < 0              -> addMessageI Error   $ MsgRevokeFraDriveLicencesError alic
+           | oks == length apids  -> addMessageI Success $ MsgRevokeFraDriveLicences      alic oks
+           | otherwise            -> addMessageI Warning $ MsgRevokeFraDriveLicences      alic oks
         redirect ProblemAvsSynchR -- must be outside runDB 
 
       procRes _alic (LicenceTableGrantFDriveData{..}, apids ) = do
         (n, Qualification{qualificationShorthand}) <- runDB $ do 
-          uas <- selectList [UserAvsPersonId <-. Set.toList apids] []
+          uids <- view _userAvsUser <<$>> selectList [UserAvsPersonId <-. Set.toList apids] []          
-          let uids = view _userAvsUser <$> uas
           -- addMessage Info $ text2Html $ "UIDs: " <> tshow uids -- DEBUG
           forM_ uids $ upsertQualificationUser licenceTableChangeFDriveQId nowaday licenceTableChangeFDriveEnd licenceTableChangeFDriveRenew
           (length uids,) <$> get404 licenceTableChangeFDriveQId
@@ -547,7 +558,9 @@ mkLicenceTable dbtIdent aLic apids = do
       acts = mconcat
           [ singletonMap LicenceTableChangeAvs    $ pure LicenceTableChangeAvsData
           , if aLic == AvsNoLicence
-              then singletonMap LicenceTableRevokeFDrive $ pure LicenceTableRevokeFDriveData
+              then singletonMap LicenceTableRevokeFDrive $ LicenceTableRevokeFDriveData
+                    <$> apreq (selectField . fmap mkOptionList $ mapM qualOpt avsQualifications) (fslI MsgQualificationName) aLicQid
+                    <*> apreq textField (fslI MsgQualificationBlockReason) Nothing
               else singletonMap LicenceTableGrantFDrive  $ LicenceTableGrantFDriveData 
                     <$> apreq (selectField . fmap mkOptionList $ mapM qualOpt avsQualifications) (fslI MsgQualificationName) aLicQid
                     <*> apreq dayField (fslI MsgLmsQualificationValidUntil) Nothing -- apreq?!

src/Handler/Qualification.hs

@@ -236,7 +236,12 @@ instance HasEntity QualificationTableData User where
 instance HasUser QualificationTableData where
   hasUser = resultUser . _entityVal
 
-data QualificationTableAction = QualificationActExpire | QualificationActUnexpire
+data QualificationTableAction 
+  = QualificationActExpire 
+  | QualificationActUnexpire
+  | QualificationActBlockSupervisor
+  | QualificationActBlock
+  | QualificationActUnblock
   deriving (Eq, Ord, Enum, Bounded, Read, Show, Generic)
 
 instance Universe QualificationTableAction
@@ -245,12 +250,24 @@ nullaryPathPiece ''QualificationTableAction $ camelToPathPiece' 2
 embedRenderMessage ''UniWorX ''QualificationTableAction id
 
 -- Not yet needed, since there is no additional data for now:
-data QualificationTableActionData = QualificationActExpireData | QualificationActUnexpireData
+data QualificationTableActionData 
+  = QualificationActExpireData 
+  | QualificationActUnexpireData  
+  | QualificationActBlockSupervisorData
+  | QualificationActBlockData   { qualTableActBlockReason :: Text}
+  | QualificationActUnblockData
   deriving (Eq, Ord, Read, Show, Generic)
 
-isExpiryAct :: QualificationTableActionData -> Bool -- const true, but this may change in the future
+isExpiryAct :: QualificationTableActionData -> Bool
 isExpiryAct QualificationActExpireData    = True
 isExpiryAct QualificationActUnexpireData  = True
+isExpiryAct _ = False
+
+isBlockAct :: QualificationTableActionData -> Bool
+isBlockAct QualificationActBlockSupervisorData  = True
+isBlockAct QualificationActBlockData{}          = True
+isBlockAct QualificationActUnblockData          = True
+isBlockAct _ = False
 
 qualificationTableQuery :: QualificationId -> (_ -> E.SqlExpr (E.Value Bool)) -> QualificationTableExpr
   -> E.SqlQuery ( E.SqlExpr (Entity QualificationUser)
@@ -400,10 +417,15 @@ postQualificationR sid qsh = do
   ((lmsRes, qualificationTable), Entity qid quali) <- runDB $ do
     qent@Entity{entityVal=Qualification{qualificationAuditDuration=auditMonths}} <- getBy404 $ SchoolQualificationShort sid qsh
     let acts :: Map QualificationTableAction (AForm Handler QualificationTableActionData)
-        acts = mconcat
+        acts = mconcat $
           [ singletonMap QualificationActExpire   $ pure QualificationActExpireData
           , singletonMap QualificationActUnexpire $ pure QualificationActUnexpireData          
-          ]
+          ] ++ bool 
+          [ singletonMap QualificationActBlockSupervisor $ pure QualificationActBlockSupervisorData ] -- nonAdmin Supervisor
+          [ singletonMap QualificationActUnblock         $ pure QualificationActUnblockData
+          , singletonMap QualificationActBlock           $      QualificationActBlockData 
+              <$> apreq textField (fslI MsgQualificationBlockReason) Nothing
+          ] isAdmin
         linkLmsUser = toMaybe isAdmin LmsUserR
         colChoices = mconcat
           [ dbSelect (applying _2) id (return . view (resultUser . _entityKey))
@@ -426,6 +448,7 @@ postQualificationR sid qsh = do
     return (tbl, qent)
   
   formResult lmsRes $ \case
+    -- TODO: continue here
     _ | not isAdmin -> addMessageI Error MsgUnauthorized -- only admins can use the form on this page for now
     (action, selectedUsers) | isExpiryAct action -> do 
       let isUnexpire = action == QualificationActUnexpireData
@@ -436,7 +459,7 @@ postQualificationR sid qsh = do
           msgVal  = upd & if isUnexpire then MsgQualificationSetUnexpire else MsgQualificationSetExpire
       addMessageI msgKind msgVal
       redirect currentRoute
-    _ -> return ()
+    _ -> addMessageI Error MsgUnauthorized -- TODO continue here
 
   let heading = citext2widget $ qualificationName quali
   siteLayout heading $ do

src/Handler/Utils/Qualification.hs

@@ -10,6 +10,7 @@ module Handler.Utils.Qualification
 import Import
 
 -- import Data.Time.Calendar (CalendarDiffDays(..))
+import Database.Persist.Sql (updateWhereCount)
 import qualified Database.Esqueleto.Experimental as E   -- might need TypeApplications Lang-Pragma
 import qualified Database.Esqueleto.Utils as E
 
@@ -101,3 +102,39 @@ renewValidQualificationUsers qid uids =
           }
       return $ length quEnts
     _ -> return (-1) -- qualificationId not found, isNothing qualificationValidDuration, etc.
+
+
+-- qualificationUserBlocking :: QualificationId -> [UserId] -> Maybe QualificationBlocked -> DB Int64
+qualificationUserBlocking :: 
+  ( AuthId (HandlerSite m) ~ Key User
+  , IsPersistBackend (YesodPersistBackend (HandlerSite m))
+  , BaseBackend (YesodPersistBackend (HandlerSite m)) ~ SqlBackend
+  , BackendCompatible SqlBackend (YesodPersistBackend (HandlerSite m))
+  , PersistQueryWrite (YesodPersistBackend (HandlerSite m))
+  , PersistUniqueWrite (YesodPersistBackend (HandlerSite m))
+  , HasInstanceID (HandlerSite m) InstanceId
+  , YesodAuthPersist (HandlerSite m)
+  , HasAppSettings (HandlerSite m)
+  , MonadHandler m
+  , MonadCatch m
+  , Num n
+  ) => QualificationId -> [UserId] -> Maybe QualificationBlocked -> ReaderT (YesodPersistBackend (HandlerSite m)) m n
+
+qualificationUserBlocking qid uids qb = do
+  oks <- updateWhereCount -- prevents storage of transactionQualificatioUser 
+    ( [ QualificationUserBlockedDue     !=. Nothing  |  isNothing qb  -- only unblock blocked qualification; allow overwrite for existing blocks
+      ] ++  
+      [ QualificationUserQualification  ==. qid
+      , QualificationUserUser           <-. uids    
+      ]
+    )
+    [   QualificationUserBlockedDue =. qb
+    ]
+  forM_ uids $ \uid -> do     
+    audit TransactionQualificationUserBlocking 
+      { -- transactionQualificationUser  = quid
+        transactionQualification      = qid
+      , transactionUser               = uid
+      , transactionQualificationBlock = qb
+      }
+  return $ fromIntegral oks

src/Jobs/Handler/LMS.hs

@@ -28,13 +28,11 @@ import qualified Data.Set as Set
 import qualified Data.Time.Zones as TZ
 import Handler.Utils.DateTime
 import Handler.Utils.LMS (randomLMSIdentBut, randomLMSpw, maxLmsUserIdentRetries)
+import Handler.Utils.Qualification
 
 import qualified Data.CaseInsensitive as CI
 
 
-blockedByElearning :: Text 
-blockedByElearning = "E-Learning durchgefallen"
-
 dispatchJobLmsQualificationsEnqueue :: JobHandler UniWorX
 dispatchJobLmsQualificationsEnqueue = JobHandlerAtomic $ fetchRefreshQualifications JobLmsEnqueue
 
@@ -219,7 +217,7 @@ dispatchJobLmsResults qid = JobHandlerAtomic act
                           , QualificationUserLastRefresh =. lmsResultSuccess
                           ]
               -- WORKAROUND LMS-Bug: sometimes we receive success and failure simultaneously; success is correct, hence we must unblock if the reason was e-learning
-              when (Just blockedByElearning == qUsr ^? _qualificationUserBlockedDue . _Just . _qualificationBlockedReason) $
+              when (Just (qualificationBlockedReasonText QualificationBlockFailedELearning) == qUsr ^? _qualificationUserBlockedDue . _Just . _qualificationBlockedReason) $
                 update quid [ QualificationUserBlockedDue =. Nothing ]              
               update luid [ LmsUserStatus   =. Just newStatus
                           , LmsUserReceived =. Just lmsResultTimestamp
@@ -295,9 +293,7 @@ dispatchJobLmsUserlist  qid = JobHandlerAtomic act
               , transactionReceived      = lReceived
               }
             update luid [LmsUserStatus =. (oldStatus <> Just newStatus)]
-            updateBy (UniqueQualificationUser qid (lmsUserUser luser)) 
+            void $ qualificationUserBlocking qid [lmsUserUser luser] $ Just $ mkQualificationBlocked QualificationBlockFailedELearning blockedDay                                                                        
-              [QualificationUserBlockedDue =. Just (QualificationBlocked { qualificationBlockedDay = blockedDay
-                                                                         , qualificationBlockedReason = blockedByElearning } )]
             queueDBJob JobSendNotification
               { jRecipient    = lmsUserUser luser
               , jNotification = NotificationQualificationExpired { nQualification = qid, nExpiry = blockedDay }

src/Model/Types/Lms.hs

@@ -11,6 +11,8 @@ module Model.Types.Lms
   ) where
 
 import Import.NoModel
+import qualified Data.Map as Map
+import Data.Map ((!))
 import Database.Persist.Sql 
 import qualified Database.Esqueleto.Experimental as E
 import qualified Data.Csv as Csv
@@ -87,6 +89,25 @@ instance Csv.ToField QualificationBlocked  where
 -- instance ToMessage QualificationBlocked where -- no longer used
 --   toMessage QualificationBlocked{..} = qualificationBlockedReason
 
+data QualificationBlockStandardReason
+      = QualificationBlockFailedELearning
+      | QualificationBlockReturnedByCompany
+  deriving (Eq, Ord, Enum, Bounded, Universe, Finite)
+
+instance Show QualificationBlockStandardReason where
+  show QualificationBlockFailedELearning    = "E-Learning durchgefallen"
+  show QualificationBlockReturnedByCompany  = "Zurückgebeben durch Firma"
+
+qualificationBlockedReasonText :: QualificationBlockStandardReason -> Text
+qualificationBlockedReasonText = 
+  let dictionary :: Map.Map QualificationBlockStandardReason Text = Map.fromList [(r, tshow r) | r <- universeF]
+  in (dictionary !) -- cannot fail due to universeF
+
+mkQualificationBlocked :: QualificationBlockStandardReason -> Day -> QualificationBlocked
+mkQualificationBlocked reason qualificationBlockedDay = QualificationBlocked{..}
+  where 
+    qualificationBlockedReason = qualificationBlockedReasonText reason
+
 -- | LMS interface requires Bool to be encoded by 0 or 1 only
 newtype LmsBool = LmsBool { lms2bool :: Bool }
   deriving (Eq, Ord, Read, Show, Generic)

templates/letter/din5008.latex

@@ -145,7 +145,7 @@ $endif$
 
         \begin{textblock}{65}(84,232)%hpos,vpos
             \textcolor{black!39}{ 
-              \begin{labeling}{Password:}
+              \begin{labeling}{Password:}%Achtung! Die Position des Logins muss sprachunabhängig immer an der gleichen Position sein, sonst kannn die Rückmeldung der Druckerei den Ident nicht mehr identifizieren!
                 $if(is-de)$
                   \item[Benutzer:]  \texttt{$login$}
                   \item[Passwort:]  \texttt{$pin$}