fix(user): add new user failed due to AuthNoLogin not treated in notification template

messages/uniworx/categories/send/send_notifications/de-de-formal.msg

@@ -75,8 +75,9 @@ NotPassed: Nicht bestanden
 
 #userAuthModeUpdate.hs + templates
 MailSubjectUserAuthModeUpdate: Ihr FRADrive-Login
-UserAuthModePWHashChangedToLDAP: Sie können sich nun mit Ihrer Fraport AG Kennung (Büko) in FRADrive einloggen
+UserAuthModeChangedToLDAP: Sie können sich nun mit Ihrer Fraport AG Kennung (Büko) in FRADrive einloggen.
-UserAuthModeLDAPChangedToPWHash: Sie können sich nun mit einer FRADrive-internen Kennung einloggen
+UserAuthModeChangedToPWHash: Sie können sich nun mit einer FRADrive-internen Kennung einloggen.
+UserAuthModeChangedToNoLogin: Ihr Login auf der FRADrive Webseite wurde deaktiviert, aber ihr FRADrive Konto besteht weiterhin. Gültigkeit und Verlängerungen Ihrer Qualifikationen sind dadurch nicht beeinträchtigt. Wenden Sie sich an die Fahrschuladmins, wenn der Login auf der FRADrive Webseite benötigt werden sollte.
 AuthPWHashTip: Sie müssen nun das mit "FRADrive-Login" beschriftete Login-Formular verwenden. Stellen Sie bitte sicher, dass Sie ein Passwort gesetzt haben, bevor Sie versuchen sich anzumelden.
 PasswordResetEmailIncoming: Einen Link um ihr Passwort zu setzen bzw. zu ändern bekommen Sie, aus Sicherheitsgründen, in einer separaten E-Mail.
 MailFradrive !ident-ok: FRADrive

messages/uniworx/categories/send/send_notifications/en-eu.msg

@@ -75,8 +75,9 @@ NotPassed: Failed
 
 #userAuthModeUpdate.hs + templates
 MailSubjectUserAuthModeUpdate: Your FRADrive login
-UserAuthModePWHashChangedToLDAP: You can now log in to FRADrive using your Fraport AG account (Büko)
+UserAuthModeChangedToLDAP: You can now log in to FRADrive using your Fraport AG account (Büko)
-UserAuthModeLDAPChangedToPWHash: You can now log in using your FRADrive-internal account
+UserAuthModeChangedToPWHash: You can now log in using your FRADrive-internal account
+UserAuthModeChangedToNoLogin: Your login for the FRADrive website has been deactivated, but you FRADrive account persists. This has no effect on you qualifications. Please contact the driving school admins, if you need new login credentials for the FRADrive website.
 AuthPWHashTip: You now need to use the login form labeled "FRADrive login". Please ensure that you have already set a password when you try to log in.
 PasswordResetEmailIncoming: For security reasons you will receive a link to the page on which you can set and later change your password in a separate email.
 MailFradrive: FRADrive

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

@@ -87,6 +87,8 @@ UserAccountDeleteWarning: Achtung, dies löscht den kompletten Benutzer/die komp
 UserLdapSync: LDAP-Synchronisieren
 AllUsersLdapSync: Alle LDAP-Synchronisieren
 UserHijack: Sitzung übernehmen
+UserAddSupervisor: Ansprechpartner hinzufügen
+UserSetSupervisor: Ansprechpartner ersetzen
 AuthKindLDAP: Fraport AG Kennung
 AuthKindPWHash: FRADrive Kennung
 AuthKindNoLogin: Kein Login möglich

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

@@ -87,6 +87,8 @@ UserAccountDeleteWarning: Caution, this permanently deletes users and all of the
 UserLdapSync: Synchronise with LDAP
 AllUsersLdapSync: Synchronise all with LDAP
 UserHijack: Hijack session
+UserAddSupervisor: Add supervisor
+UserSetSupervisor: Replace supervisors
 AuthKindLDAP: Fraport AG account
 AuthKindPWHash: FRADrive account
 AuthKindNoLogin: No login

src/Handler/Admin/Avs.hs

@@ -289,9 +289,8 @@ data LicenceTableAction =  LicenceTableChangeAvs
                         |  LicenceTableRevokeFDrive
                         |  LicenceTableGrantFDrive
   deriving (Eq, Ord, Enum, Bounded, Read, Show, Generic, Typeable)
+  deriving anyclass (Universe, Finite)
 
-instance Universe LicenceTableAction
-instance Finite   LicenceTableAction
 nullaryPathPiece ''LicenceTableAction $ camelToPathPiece' 2
 embedRenderMessage ''UniWorX ''LicenceTableAction id
 

src/Handler/Users.hs

@@ -54,13 +54,19 @@ hijackUserForm csrf = do
 -- instance HasUser   (DBRow (Entity USer)) where
 --    hasUser = _entityVal
 
-data UserAction = UserLdapSync | UserHijack
+data UserAction = UserLdapSync | UserAddSupervisor | UserSetSupervisor
   deriving (Eq, Ord, Enum, Bounded, Read, Show, Generic, Typeable)
   deriving anyclass (Universe, Finite)
 
 nullaryPathPiece ''UserAction $ camelToPathPiece' 1
 embedRenderMessage ''UniWorX ''UserAction id
 
+data UserActionData = UserLdapSyncData 
+                    | UserHijack
+                    | UserAddSupervisorData
+                    | UserSetSupervisorData
+  deriving (Eq, Ord, Read, Show, Generic, Typeable)
+  
 
 data AllUsersAction = AllUsersLdapSync
   deriving (Eq, Ord, Enum, Bounded, Read, Show, Generic, Typeable)
@@ -143,7 +149,7 @@ postUsersR = do
                 , Just uid /= myUid
                   -> lift $ do
                        let
-                         postprocess :: FormResult () -> FormResult (First UserAction, DBFormResult UserId Bool (DBRow (Entity User)))
+                         postprocess :: FormResult () -> FormResult (First UserActionData, DBFormResult UserId Bool (DBRow (Entity User)))
                          postprocess (FormSuccess ())   = FormSuccess (First $ Just UserHijack, DBFormResult $ Map.singleton uid (inp, const True))
                          postprocess  FormMissing       = FormSuccess mempty
                          postprocess (FormFailure errs) = FormFailure errs
@@ -161,12 +167,19 @@ postUsersR = do
       <$> selectList [] [Asc SchoolName]
 
     let
-      postprocess :: FormResult (First UserAction, DBFormResult UserId Bool (DBRow (Entity User))) -> FormResult (UserAction, Set UserId)
+      postprocess :: FormResult (First UserActionData, DBFormResult UserId Bool (DBRow (Entity User))) -> FormResult (UserActionData, Set UserId)
       postprocess inp = do
         (First (Just act), usrMap) <- inp
         let usrSet = Map.keysSet . Map.filter id $ getDBFormResult (const False) usrMap
         return (act, usrSet)
 
+      acts :: Map UserAction (AForm Handler UserActionData)
+      acts = mconcat 
+        [ singletonMap UserLdapSync $ pure UserLdapSyncData
+        , singletonMap UserAddSupervisor $ pure UserAddSupervisorData
+        , singletonMap UserSetSupervisor $ pure UserSetSupervisorData
+        ]
+
     over _1 postprocess <$> dbTable psValidator DBTable
       { dbtSQLQuery  = return :: E.SqlExpr (Entity User) -> E.SqlQuery (E.SqlExpr (Entity User))
       , dbtRowKey = (E.^. UserId)
@@ -290,7 +303,7 @@ postUsersR = do
         , dbParamsFormAdditional
             = renderAForm FormStandard
                  $  (, mempty) . First . Just
-                <$> areq (selectField $ optionsF [UserLdapSync]) (fslI MsgTableAction) Nothing
+                <$> multiActionA acts (fslI MsgTableAction) Nothing
         , dbParamsFormEvaluate = liftHandler . runFormPost
         , dbParamsFormResult   = id
         , dbParamsFormIdent    = def
@@ -306,7 +319,7 @@ postUsersR = do
       | Set.null usersSet -> do
           addMessageI Info MsgActionNoUsersSelected
           redirect UsersR
-    (UserLdapSync, userSet) -> do
+    (UserLdapSyncData, userSet) -> do
       runDBJobs . forM_ userSet $ \uid -> queueDBJob $ JobSynchroniseLdapUser uid
       addMessageI Success . MsgSynchroniseLdapUserQueued $ Set.size userSet
       redirect UsersR

src/Handler/Users/Add.hs

@@ -5,7 +5,7 @@
 module Handler.Users.Add
   ( getAdminUserAddR, postAdminUserAddR
   , AdminUserForm(..), AuthenticationKind(..)
-  , addNewUser
+  , addNewUser, addNewUserNoNotfication
   --, adminUserForm , classifyAuth, mkAuthMode -- no longer needed elsewhere   
   ) where
 
@@ -76,7 +76,13 @@ adminUserForm template = renderAForm FormStandard
   <*> areq (selectField optionsFinite)  (fslI MsgAdminUserAuth) (aufAuth <$> template <|> Just AuthKindLDAP)
   
 addNewUser :: AdminUserForm -> Handler (Maybe UserId)    
-addNewUser AdminUserForm{..} = do 
+addNewUser = addNewUser' True
+
+addNewUserNoNotfication :: AdminUserForm -> Handler (Maybe UserId)    
+addNewUserNoNotfication = addNewUser' False
+
+addNewUser' :: Bool -> AdminUserForm -> Handler (Maybe UserId)
+addNewUser' notifyusr AdminUserForm{..} = do 
   now <- liftIO getCurrentTime
   UserDefaultConf{..} <- getsYesod $ view _appUserDefaults
   let 
@@ -121,7 +127,8 @@ addNewUser AdminUserForm{..} = do
   runDBJobs . runMaybeT $ do
     uid <- MaybeT $ insertUnique newUser
     lift . queueDBJob $ JobSynchroniseLdapUser uid
-    lift . queueDBJob . JobQueueNotification $ NotificationUserAuthModeUpdate uid (newUser ^. _userAuthentication)
+    when notifyusr $
+      lift . queueDBJob . JobQueueNotification $ NotificationUserAuthModeUpdate uid (newUser ^. _userAuthentication)
     when (aufAuth == AuthKindPWHash) $
       lift . queueDBJob $ JobSendPasswordReset uid
     return uid

src/Handler/Utils/Avs.hs

@@ -375,7 +375,7 @@ upsertAvsUserById api = do
             , aufIdent = fakeIdent -- use AvsPersonId instead
             , aufAuth  = maybe AuthKindNoLogin (const AuthKindLDAP) avsPersonInternalPersonalNo -- FUTURE TODO: if email is known, use AuthKinfPWHash for email invite, if no internal personal number is known
             }
-      mbUid <- addNewUser newUsr -- triggers JobSynchroniseLdapUser, JobSendPasswordReset and NotificationUserAutoModeUpdate -- TODO: check if these are failsafe
+      mbUid <- addNewUserNoNotfication newUsr -- triggers JobSynchroniseLdapUser, JobSendPasswordReset and NotificationUserAutoModeUpdate -- TODO: check if these are failsafe
       whenIsJust mbUid $ \uid -> runDB $ do
         now <- liftIO getCurrentTime
         insert_ $ UserAvs avsPersonPersonID uid avsPersonPersonNo

templates/mail/userAuthModeUpdate.hamlet

@@ -21,9 +21,11 @@ $# SPDX-License-Identifier: AGPL-3.0-or-later
     <h1>
       $case userAuthentication
         $of AuthLDAP
-          _{SomeMessage MsgUserAuthModePWHashChangedToLDAP}
+          _{SomeMessage MsgUserAuthModeChangedToLDAP}
         $of AuthPWHash _
-          _{SomeMessage MsgUserAuthModeLDAPChangedToPWHash}
+          _{SomeMessage MsgUserAuthModeChangedToPWHash}
+        $of AuthNoLogin
+          _{SomeMessage MsgUserAuthModeChangedToNoLogin}
     <p>
       <a href=@{NewsR}>
         _{SomeMessage MsgMailFradrive} #