diff --git a/messages/uniworx/categories/courses/tutorial/de-de-formal.msg b/messages/uniworx/categories/courses/tutorial/de-de-formal.msg index d9a9b7493..601183d85 100644 --- a/messages/uniworx/categories/courses/tutorial/de-de-formal.msg +++ b/messages/uniworx/categories/courses/tutorial/de-de-formal.msg @@ -45,5 +45,7 @@ TutorialUsersDeregistered count@Int64: #{show count} #{pluralDE count "-Tutorium TutorialUserDeregister: Vom Tutorium Abmelden TutorialUserSendMail: Mitteilung verschicken TutorialUserGrantQualification: Qualifikation vergeben +TutorialUserRenewQualification: Qualifikation regulär verlängern +TutorialUserRenewedQualification n@Int: Qualifikation für #{tshow n} Tutoriums-#{pluralDE n "Teilnehmer:in" "Teilnehmer:innen"} regulär verlängert TutorialUserGrantedQualification n@Int: Qualifikation erfolgreich an #{tshow n} Tutoriums-#{pluralDE n "Teilnehmer:in" "Teilnehmer:innen"} vergeben CommTutorial: Tutorium-Mitteilung \ No newline at end of file diff --git a/messages/uniworx/categories/courses/tutorial/en-eu.msg b/messages/uniworx/categories/courses/tutorial/en-eu.msg index 0c889b3f1..4ecbb64e1 100644 --- a/messages/uniworx/categories/courses/tutorial/en-eu.msg +++ b/messages/uniworx/categories/courses/tutorial/en-eu.msg @@ -46,5 +46,7 @@ TutorialUsersDeregistered count: Successfully deregistered #{show count} partici TutorialUserDeregister: Deregister from tutorial TutorialUserSendMail: Send mail TutorialUserGrantQualification: Grant Qualification +TutorialUserRenewQualification: Renew Qualification +TutorialUserRenewedQualification n@Int: Successfully renewed qualification #{tshow n} tutorial #{pluralEN n "user" "users"} TutorialUserGrantedQualification n: Successfully granted qualification #{tshow n} tutorial #{pluralEN n "user" "users"} CommTutorial: Tutorial message diff --git a/src/Database/Esqueleto/Utils.hs b/src/Database/Esqueleto/Utils.hs index 041af20f7..7614eff58 100644 --- a/src/Database/Esqueleto/Utils.hs +++ b/src/Database/Esqueleto/Utils.hs @@ -38,7 +38,7 @@ module Database.Esqueleto.Utils , unKey , selectCountRows, selectCountDistinct , selectMaybe - , day, diffDays, diffTimes + , day, interval, diffDays, diffTimes , exprLift , explicitUnsafeCoerceSqlExprValue , module Database.Esqueleto.Utils.TH @@ -65,6 +65,8 @@ import Crypto.Hash (Digest, SHA256) import Data.Coerce (Coercible) import Data.Time.Clock (NominalDiffTime) +import Data.Time.Calendar (CalendarDiffDays) +import Data.Time.Format.ISO8601 (iso8601Show) import qualified Data.Text.Lazy.Builder as Text.Builder @@ -525,6 +527,14 @@ selectMaybe = fmap listToMaybe . E.select . (<* E.limit 1) day :: E.SqlExpr (E.Value UTCTime) -> E.SqlExpr (E.Value Day) day = E.unsafeSqlCastAs "date" +interval :: CalendarDiffDays -> E.SqlExpr (E.Value Day) -- E.+=. requires both types to be the same, so we use Day +-- interval _ = E.unsafeSqlCastAs "interval" $ E.unsafeSqlValue "'P2Y'" -- tested working example +interval = E.unsafeSqlCastAs "interval". E.unsafeSqlValue . wrapSqlString . Text.Builder.fromString . iso8601Show + where + singleQuote = Text.Builder.singleton '\'' + wrapSqlString b = singleQuote <> b <> singleQuote + + infixl 6 `diffDays`, `diffTimes` diffDays :: E.SqlExpr (E.Value Day) -> E.SqlExpr (E.Value Day) -> E.SqlExpr (E.Value Int) diff --git a/src/Handler/Tutorial/Users.hs b/src/Handler/Tutorial/Users.hs index 912d0c886..e51d7e064 100644 --- a/src/Handler/Tutorial/Users.hs +++ b/src/Handler/Tutorial/Users.hs @@ -26,10 +26,11 @@ import Handler.Course.Users data TutorialUserAction - = TutorialUserGrantQualification - | TutorialUserSendMail - | TutorialUserDeregister - deriving (Eq, Ord, Enum, Bounded, Read, Show, Generic) + = TutorialUserRenewQualification + | TutorialUserGrantQualification + | TutorialUserSendMail + | TutorialUserDeregister + deriving (Eq, Ord, Enum, Bounded, Read, Show, Generic) instance Universe TutorialUserAction instance Finite TutorialUserAction @@ -37,13 +38,15 @@ nullaryPathPiece ''TutorialUserAction $ camelToPathPiece' 2 embedRenderMessage ''UniWorX ''TutorialUserAction id data TutorialUserActionData - = TutorialUserGrantQualificationData - { tuQualification :: QualificationId - , tuValidUntil :: Day - } - | TutorialUserSendMailData - | TutorialUserDeregisterData{} - deriving (Eq, Ord, Read, Show, Generic) + = TutorialUserRenewQualificationData + { tuQualification :: QualificationId } + | TutorialUserGrantQualificationData + { tuQualification :: QualificationId + , tuValidUntil :: Day + } + | TutorialUserSendMailData + | TutorialUserDeregisterData{} + deriving (Eq, Ord, Read, Show, Generic) getTUsersR, postTUsersR :: TermId -> SchoolId -> CourseShorthand -> TutorialName -> Handler Html @@ -85,7 +88,11 @@ postTUsersR tid ssh csh tutn = do } acts :: Map TutorialUserAction (AForm Handler TutorialUserActionData) acts = Map.fromList - [ ( TutorialUserGrantQualification + [ ( TutorialUserRenewQualification + , TutorialUserRenewQualificationData + <$> apopt (selectField . fmap mkOptionList $ mapM qualOpt qualifications) (fslI MsgQualificationName) Nothing + ) + , ( TutorialUserGrantQualification , TutorialUserGrantQualificationData <$> apopt (selectField . fmap mkOptionList $ mapM qualOpt qualifications) (fslI MsgQualificationName) Nothing <*> apopt dayField (fslI MsgLmsQualificationValidUntil) dayExpiry @@ -103,6 +110,10 @@ postTUsersR tid ssh csh tutn = do runDB . forM_ selectedUsers $ upsertQualificationUser tuQualification today tuValidUntil Nothing addMessageI Success . MsgTutorialUserGrantedQualification $ Set.size selectedUsers redirect $ CTutorialR tid ssh csh tutn TUsersR + (TutorialUserRenewQualificationData{..}, selectedUsers) -> do + noks <- runDB $ renewQualificationUsers tuQualification $ Set.toList selectedUsers + addMessageI (if 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] redirect (CTutorialR tid ssh csh tutn TCommR, [(toPathPiece GetRecipient, toPathPiece cID) | cID <- cids]) diff --git a/src/Handler/Utils/Qualification.hs b/src/Handler/Utils/Qualification.hs index cb9700ad1..4cba8c11f 100644 --- a/src/Handler/Utils/Qualification.hs +++ b/src/Handler/Utils/Qualification.hs @@ -3,16 +3,18 @@ -- SPDX-License-Identifier: AGPL-3.0-or-later - -module Handler.Utils.Qualification +module Handler.Utils.Qualification ( module Handler.Utils.Qualification - ) where + ) where import Import +-- import Data.Time.Calendar (CalendarDiffDays(..)) +import qualified Database.Esqueleto.Experimental as E -- might need TypeApplications Lang-Pragma +import qualified Database.Esqueleto.Utils as E upsertQualificationUser :: QualificationId -> Day -> Day -> Maybe Bool -> UserId -> DB () -upsertQualificationUser qualificationUserQualification qualificationUserLastRefresh qualificationUserValidUntil mbScheduleRenewal qualificationUserUser = do +upsertQualificationUser qualificationUserQualification qualificationUserLastRefresh qualificationUserValidUntil mbScheduleRenewal qualificationUserUser = do Entity quid _ <- upsert QualificationUser { qualificationUserFirstHeld = qualificationUserLastRefresh @@ -20,18 +22,29 @@ upsertQualificationUser qualificationUserQualification qualificationUserLastRef , qualificationUserScheduleRenewal = fromMaybe True mbScheduleRenewal , .. } - ( + ( [ QualificationUserScheduleRenewal =. scheduleRenewal | Just scheduleRenewal <- [mbScheduleRenewal] ] ++ [ QualificationUserValidUntil =. qualificationUserValidUntil , QualificationUserLastRefresh =. qualificationUserLastRefresh , QualificationUserBlockedDue =. Nothing ] - ) + ) audit TransactionQualificationUserEdit { transactionQualificationUser = quid , transactionQualification = qualificationUserQualification , transactionUser = qualificationUserUser , transactionQualificationValidUntil = qualificationUserValidUntil , transactionQualificationScheduleRenewal = mbScheduleRenewal - } \ No newline at end of file + } + +renewQualificationUsers :: QualificationId -> [UserId] -> DB Int +renewQualificationUsers qid uids = do + --TODO: user updateWhere Count instead + E.update $ \qu -> do + E.set qu [ QualificationUserValidUntil E.+=. E.interval (CalendarDiffDays 2 0) ] -- TODO: for Testing only + E.where_ $ (qu E.^. QualificationUserQualification E.==. E.val qid ) + E.&&. (qu E.^. QualificationUserUser `E.in_` E.valList uids) + -- TODO: AUDIT LOG!!! + -- forM_ uids $ \quid -> audit + return (-1) \ No newline at end of file