fraport/fradrive
3
0
Fork 0
Code Issues Pull Requests Actions Packages Projects Releases Wiki Activity

feat(exam-correct): request refactor and handling of sent uuids

Browse Source
This commit is contained in:
Sarah Vaupel 2020-01-21 16:45:47 +01:00
parent d8a080d74d
commit 4a36a010f4
1 changed files with 32 additions and 22 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

54
src/Handler/Exam/Correct.hs
View File

@ -5,7 +5,8 @@ module Handler.Exam.Correct
import Import
import qualified Data.Set as Set
import qualified Data.CaseInsensitive as CI (original)
import qualified Data.CaseInsensitive as CI
import qualified Data.Aeson as JSON
import qualified Database.Esqueleto as E
import qualified Database.Esqueleto.Utils as E
@ -46,19 +47,20 @@ deriveJSON defaultOptions
, fieldLabelModifier = camelToPathPiece' 1
, sumEncoding = TaggedObject "status" "results"
} ''CorrectInterfaceResponse
-- E.g.: { "status": "success", "user-ident": "Max Musterstudent", "user-matrikelnummer": "123", "results": { "1a": null, "2a": 7, "2c3.5": 12 } }
data CorrectInterfaceRequest
= CorrectInterfaceRequest
{ ciqName :: Text
, ciqResults :: Map ExamPartNumber (Maybe Points)
, ciqOp :: Bool -- not no-op
{ ciqUser :: Either Text (CryptoID UUID (Key User))
, ciqResults :: Maybe (NonNull (Map ExamPartNumber (Maybe Points)))
}
deriveJSON defaultOptions
{ fieldLabelModifier = camelToPathPiece' 1
} ''CorrectInterfaceRequest
-- E.g.: { "name": "max", "results": { "1a": null, "2c3.5": 9001.2 }}
instance FromJSON CorrectInterfaceRequest where
parseJSON = JSON.withObject "CorrectInterfaceRequest" $ \o -> do
ciqUser <- Right <$> o JSON..: "user" <|> Left <$> o JSON..: "user"
results <- o JSON..:? "results"
ciqResults <- for results $ maybe (fail "Results may not be nullable") return . fromNullable
return CorrectInterfaceRequest{..}
getECorrectR :: TermId -> SchoolId -> CourseShorthand -> ExamName -> Handler Html
getECorrectR tid ssh csh examn = do
@ -90,22 +92,30 @@ postECorrectR :: TermId -> SchoolId -> CourseShorthand -> ExamName -> Handler Vo
postECorrectR tid ssh csh examn = do
MsgRenderer mr <- getMsgRenderer
CorrectInterfaceRequest{ciqName,ciqResults,ciqOp} <- requireCheckJsonBody
CorrectInterfaceRequest{ciqUser,ciqResults} <- requireCheckJsonBody
response <- runDB $ do
Entity eId _ <- fetchExam tid ssh csh examn
euid <- traverse decrypt ciqUser
participantMatches <- E.select . E.from $ \(examRegistration `E.InnerJoin` user) -> do
E.on $ examRegistration E.^. ExamRegistrationUser E.==. user E.^. UserId
E.where_ $ examRegistration E.^. ExamRegistrationExam E.==. E.val eId
E.where_ $ user E.^. UserMatrikelnummer E.==. E.val (Just ciqName)
E.||. user E.^. UserMatrikelnummer `E.hasInfix` E.val (Just 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
let
uidMatch = either (const $ E.val False) (\uid -> user E.^. UserId E.==. E.val uid) euid
mUserIdent = euid ^? _Left
E.where_ $ uidMatch
E.||. user E.^. UserMatrikelnummer E.==. E.val mUserIdent
E.||. user E.^. UserMatrikelnummer `E.hasInfix` E.val mUserIdent
E.||. (case mUserIdent of
Just userIdent -> (user E.^. UserSurname E.==. E.val userIdent
E.||. user E.^. UserSurname `E.hasInfix` E.val userIdent
E.||. user E.^. UserFirstName E.==. E.val userIdent
E.||. user E.^. UserFirstName `E.hasInfix` E.val userIdent
E.||. user E.^. UserDisplayName E.==. E.val userIdent
E.||. user E.^. UserDisplayName `E.hasInfix` E.val userIdent)
Nothing -> E.val False)
return user
let
@ -120,16 +130,16 @@ postECorrectR tid ssh csh examn = do
if
-- on no-op request, answer with 200 and a set of all participant matches
| not ciqOp -> do
| is _Nothing ciqResults -> do
users <- traverse userToResponse participantMatches
return CorrectInterfaceResponseNoOp
{ cirnUsers = Set.fromList users
}
-- on match with exactly one exam participant, insert results and answer with 200
| [match@(Entity uid _)] <- participantMatches -> do
| [match@(Entity uid _)] <- participantMatches, Just results <- ciqResults -> do
now <- liftIO getCurrentTime
newExamPartResults <- iforM ciqResults $ \partNumber mPartResult -> do
newExamPartResults <- iforM (toNullable results) $ \partNumber mPartResult -> do
examPartId <- getKeyBy404 $ UniqueExamPartNumber eId partNumber
mOldResult <- getBy $ UniqueExamPartResult examPartId uid
if