diff --git a/src/Handler/Admin/Avs.hs b/src/Handler/Admin/Avs.hs
index 886ffa010..1c0af28fd 100644
--- a/src/Handler/Admin/Avs.hs
+++ b/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|
$forall p <- pns
- - #{tshow p}
+
- #{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
- | oks == length apids -> addMessageI Success $ MsgRevokeFraDriveLicences alic oks
- | otherwise -> addMessageI Warning $ MsgRevokeFraDriveLicences alic oks
+ }
+ let lReq = length apids
+ if | oks < 0 -> addMessageI Error $ MsgRevokeFraDriveLicencesError alic
+ | 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
diff --git a/src/Handler/Tutorial/Users.hs b/src/Handler/Tutorial/Users.hs
index f3438d599..32cc780c3 100644
--- a/src/Handler/Tutorial/Users.hs
+++ b/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]