From 5f9a176bc68116757237b499da26bb34e8aae32b Mon Sep 17 00:00:00 2001 From: Sarah Vaupel Date: Wed, 15 Jan 2020 13:54:04 +0100 Subject: [PATCH] feat(exam-correct): postECorrectR stub --- messages/uniworx/de-de-formal.msg | 3 + messages/uniworx/en-eu.msg | 3 + src/Handler/Exam/Correct.hs | 123 +++++++++++++++++++++++++----- 3 files changed, 109 insertions(+), 20 deletions(-) diff --git a/messages/uniworx/de-de-formal.msg b/messages/uniworx/de-de-formal.msg index 69f1002af..dac85ef6d 100644 --- a/messages/uniworx/de-de-formal.msg +++ b/messages/uniworx/de-de-formal.msg @@ -1404,6 +1404,9 @@ ExamCorrectHeadStatus: Status ExamCorrectButtonSend: Senden +ExamCorrectErrorMultipleMatchingParticipants: Dem Identifikator konnten mehrere Pruefungsteilnehmer zugeordnet werden. +ExamCorrectErrorNoMatchingParticipants: Dem Identifikator konnte kein Pruefungsteilnehmer zugeordnet werden. + SubmissionUserInvitationAccepted shn@SheetName: Sie wurden als Mitabgebende(r) für eine Abgabe zu #{shn} eingetragen SubmissionUserInvitationDeclined shn@SheetName: Sie haben die Einladung, Mitabgebende(r) für #{shn} zu werden, abgelehnt SubmissionUserInviteHeading shn@SheetName: Einladung zu einer Abgabe für #{shn} diff --git a/messages/uniworx/en-eu.msg b/messages/uniworx/en-eu.msg index e1c20ce35..4edcdce26 100644 --- a/messages/uniworx/en-eu.msg +++ b/messages/uniworx/en-eu.msg @@ -1402,6 +1402,9 @@ ExamCorrectHeadStatus: Status ExamCorrectButtonSend: Submit +ExamCorrectErrorMultipleMatchingParticipants: This identifier matches on multiple exam participants. +ExamCorrectErrorNoMatchingParticipants: This identifier does not match on any exam participant. + SubmissionUserInvitationAccepted shn: You now participate in a submission for #{shn} SubmissionUserInvitationDeclined shn: You have declined the invitation to participate in a submission for #{shn} SubmissionUserInviteHeading shn: Invitation to participate in a submission for #{shn} diff --git a/src/Handler/Exam/Correct.hs b/src/Handler/Exam/Correct.hs index 70fccd3de..8b157dbde 100644 --- a/src/Handler/Exam/Correct.hs +++ b/src/Handler/Exam/Correct.hs @@ -4,38 +4,58 @@ module Handler.Exam.Correct import Import +import qualified Data.Set as Set import qualified Data.CaseInsensitive as CI (original) +import qualified Database.Esqueleto as E +import qualified Database.Esqueleto.Utils as E + import Handler.Utils import Handler.Utils.Exam (fetchExam) -data CorrectInterfaceResponse - = CorrectInterfaceSuccess - { ciUserIdent :: CryptoUUIDUser - , ciUserDisplayName :: Text - , ciUserMatrikelnummer :: Maybe Text - , ciResults :: Map ExamPartNumber (Maybe Points) - } - | CorrectInterfaceFailure - { ciIcon :: Icon - , ciMessage :: Text +data CorrectInterfaceUser + = CorrectInterfaceUser + { ciuSurname :: Text + , ciuDisplayName :: Text + , ciuMatNr :: Maybe UserMatriculation + , ciuId :: CryptoUUIDUser } deriveJSON defaultOptions - { constructorTagModifier = camelToPathPiece' 2 - , fieldLabelModifier = camelToPathPiece' 1 - , sumEncoding = TaggedObject "status" "result" - } ''CorrectorInterfaceResponse + { fieldLabelModifier = camelToPathPiece' 1 + } ''CorrectInterfaceUser + +data CorrectInterfaceResponse + = CorrectInterfaceResponseSuccess + { cirsUser :: CorrectInterfaceUser + , cirsResults :: Map ExamPartNumber (Maybe Points) + } + | CorrectInterfaceResponseAmbiguous + { ciraUsers :: Set CorrectInterfaceUser + , ciraMessage :: Text + } + | CorrectInterfaceResponseFailure + { cirfMessage :: Text + } + | CorrectInterfaceResponseNoOp + { cirnUsers :: Set CorrectInterfaceUser + } +deriveJSON defaultOptions + { constructorTagModifier = camelToPathPiece' 3 + , fieldLabelModifier = camelToPathPiece' 1 + , sumEncoding = TaggedObject "status" "result" + } ''CorrectInterfaceResponse -- E.g.: { "status": "success", "user-ident": "Max Musterstudent", "user-matrikelnummer": "123", "results": { "1a": null, "2a": 7, "2c3.5": 12 } } data CorrectInterfaceRequest = CorrectInterfaceRequest - { cirName :: Text - , cirResults :: Map ExamPartNumber (Maybe Points) + { ciqName :: Text + , ciqResults :: Map ExamPartNumber (Maybe Points) + , ciqNoOp :: Bool } deriveJSON defaultOptions - { fieldLabelModifier = camelToPathPiece' 1 - } ''CorrectorInterfaceRequest + { fieldLabelModifier = camelToPathPiece' 1 + } ''CorrectInterfaceRequest -- E.g.: { "name": "max", "results": { "1a": null, "2c3.5": 9001.2 }} @@ -63,6 +83,69 @@ getECorrectR tid ssh csh examn = do siteLayoutMsg heading $ do setTitleI heading $(widgetFile "exam-correct") - + + postECorrectR :: TermId -> SchoolId -> CourseShorthand -> ExamName -> Handler Value -postECorrectR = error "ECorrectR not implemented" -- use returnJson & requireCheckJsonBody +postECorrectR tid ssh csh examn = do + now <- liftIO getCurrentTime + mUid <- maybeAuthId + MsgRenderer mr <- getMsgRenderer + + CorrectInterfaceRequest{ciqName,ciqResults,ciqNoOp} <- requireCheckJsonBody + + participantMatches <- runDB $ do + Entity eId _ <- fetchExam tid ssh csh examn + E.select . E.from $ \(examRegistration `E.InnerJoin` user) -> do + E.on $ examRegistration E.^. ExamRegistrationUser E.==. user + E.where_ $ examRegistration E.^. ExamRegistrationExam E.==. E.val eId + E.&&. ( user E.^. UserMatrikelnummer E.==. E.val ciqName + E.||. user E.^. UserMatrikelnummer `E.hasInfix` E.val ciqName + E.||. user E.^. UserSurname E.==. E.val ciqName + E.||. user E.^. UserSurname `E.hasInfix` E.val ciqName + E.||. user E.^. UserFirstName E.==. E.val ciqName + E.||. user E.^. UserFirstName `E.hasInfix` E.val ciqName + E.||. user E.^. UserDisplayName E.==. E.val ciqName + E.||. user E.^. UserDisplayName `E.hasInfix` E.val ciqName ) + return user + + let + usersToResponse = traverse $ \user@(Entity uid User{..}) -> do + uuid <- encrypt uid + return CorrectInterfaceUser + { ciuSurname = userSurname + , ciuDisplayName = userDisplayName + , ciuMatNr = userMatrikelnummer + , ciuId = uuid + } + + if + | ciqNoOp -> do + users <- usersToResponse participantMatches + returnJson $ CorrectInterfaceResponseNoOp + { cirnUsers = Set.fromList users + } + | [match] <- participantMatches -> do + -- TODO upsert results + -- TODO log to Transaction Log + [user] <- usersToResponse participantMatches + returnJson $ CorrectInterfaceResponseSuccess + { cirsUser = user + , cirsResults = ciqResults + } + | [] <- participantMatches -> returnJson $ CorrectInterfaceResponseFailure + { cirfMessage = mr MsgExamCorrectErrorNoMatchingParticipants + } + | otherwise -> do + users <- usersToResponse participantMatches + returnJson $ CorrectInterfaceResponseAmbiguous + { ciraMessage = mr MsgExamCorrectErrorMultipleMatchingParticipants + , ciraUsers = Set.fromList users + } + + -- TODO if the request is a noop, respond with a 200 and the matches + -- TODO if there is exactly one match, respond with a 200, a (Map ExamPartNumber ExamPartPoints) + -- and a single (surname,displayName,matrikelnummer) + + -- TODO if there are multiple matches, respond with a 400 and a set containing the matches (Ambiguous case) + + -- TODO if there are no matches, respond with a 400 and an error message (no matches, Failure case)