chore(tutorial): actions on 0 users are marked as warning

src/Handler/Admin/Avs.hs

@@ -15,6 +15,7 @@ module Handler.Admin.Avs
 import Import
 import qualified Control.Monad.State.Class as State
 -- import Data.Aeson (encode)
+import qualified Data.Aeson.Encode.Pretty as Pretty
 import qualified Data.Text as Text
 import qualified Data.CaseInsensitive as CI
 import qualified Data.Set  as Set
@@ -181,7 +182,7 @@ postAdminAvsR = do
               Right (AvsResponseContact pns) -> return $ Just [whamlet|
                   <ul>
                     $forall p <- pns 
-                      <li>#{tshow p}
+                      <li>#{Pretty.encodePretty (toJSON p)}
                 |]
       mbContact <- formResultMaybe cresult procFormContact
 
@@ -427,7 +428,7 @@ getProblemAvsSynchR = do
       procRes aLic (LicenceTableChangeAvsData       , apids) = do 
         oks <- catchAllAvs $ setLicencesAvs $ Set.map (AvsPersonLicence aLic) apids
         let no_req = Set.size apids
-            mkind = if oks < no_req then Warning else Success
+            mkind = if oks < no_req || no_req < 0 then Warning else Success
         addMessageI mkind $ MsgAvsSetLicences aLic oks no_req                  
         redirect ProblemAvsSynchR -- reload to update all tables
 
@@ -442,10 +443,11 @@ getProblemAvsSynchR = do
                     Just $ QualificationBlocked 
                     { qualificationBlockedDay     = nowaday
                     , qualificationBlockedReason  = licenceTableChangeFDriveReason
-                    }               
+                    }
-        if | oks < 0              -> addMessageI Error   $ MsgRevokeFraDriveLicencesError alic
+        let lReq = length apids                        
-           | oks == length apids  -> addMessageI Success $ MsgRevokeFraDriveLicences      alic oks
+        if | oks < 0                 -> addMessageI Error   $ MsgRevokeFraDriveLicencesError alic
-           | otherwise            -> addMessageI Warning $ MsgRevokeFraDriveLicences      alic oks
+           | oks == lreq && lreq > 0 -> addMessageI Success $ MsgRevokeFraDriveLicences      alic oks
+           | otherwise               -> addMessageI Warning $ MsgRevokeFraDriveLicences      alic oks
         redirect ProblemAvsSynchR -- must be outside runDB 
 
       procRes _alic (LicenceTableGrantFDriveData{..}, apids ) = do
@@ -454,7 +456,7 @@ getProblemAvsSynchR = do
           -- addMessage Info $ text2Html $ "UIDs: " <> tshow uids -- DEBUG
           forM_ uids $ upsertQualificationUser licenceTableChangeFDriveQId nowaday licenceTableChangeFDriveEnd licenceTableChangeFDriveRenew
           (length uids,) <$> get404 licenceTableChangeFDriveQId
-        addMessageI Success $ MsgSetFraDriveLicences (citext2string qualificationShorthand) n
+        addMessageI (bool Success Warning $ null apids) $ MsgSetFraDriveLicences (citext2string qualificationShorthand) n
         redirect ProblemAvsSynchR -- must be outside runDB 
       
   formResult tres2      $ procRes AvsLicenceRollfeld

src/Handler/Tutorial/Users.hs

@@ -130,12 +130,12 @@ postTUsersR tid ssh csh tutn = do
         -- today <- localDay . TZ.utcToLocalTimeTZ appTZ <$> liftIO getCurrentTime
         today <- utctDay <$> liftIO getCurrentTime
         runDB . forM_ selectedUsers $ upsertQualificationUser tuQualification today tuValidUntil Nothing
-        addMessageI Success . MsgTutorialUserGrantedQualification $ Set.size selectedUsers
+        addMessageI  (if 0 < Set.size selectedUsers then Success else Warning) . MsgTutorialUserGrantedQualification $ Set.size selectedUsers
         redirect $ CTutorialR tid ssh csh tutn TUsersR
     (TutorialUserRenewQualificationData{..}, selectedUsers)
       | tuQualification `Set.member` courseQids -> do
         noks <- runDB $ renewValidQualificationUsers tuQualification $ Set.toList selectedUsers      
-        addMessageI (if noks == Set.size selectedUsers then Success else Warning) $ MsgTutorialUserRenewedQualification noks
+        addMessageI (if noks > 0 && noks == Set.size selectedUsers then Success else Warning) $ MsgTutorialUserRenewedQualification noks
         redirect $ CTutorialR tid ssh csh tutn TUsersR
     (TutorialUserSendMailData{}, selectedUsers) -> do
         cids <- traverse encrypt $ Set.toList selectedUsers :: Handler [CryptoUUIDUser]