87 lines
2.8 KiB
Haskell
87 lines
2.8 KiB
Haskell
module Utils.Exam
|
|
( CorrectInterfaceRequest(..)
|
|
, CorrectInterfaceResponse(..), ciResponseStatus
|
|
, CorrectInterfaceUser(..), userToResponse
|
|
) where
|
|
|
|
import Import.NoFoundation
|
|
|
|
import qualified Data.Aeson as JSON
|
|
import qualified Data.HashMap.Strict as HashMap
|
|
|
|
|
|
data CorrectInterfaceUser
|
|
= CorrectInterfaceUser
|
|
{ ciuSurname :: Text
|
|
, ciuDisplayName :: Text
|
|
, ciuMatNr :: Maybe UserMatriculation
|
|
, ciuId :: CryptoUUIDUser
|
|
} deriving (Eq,Ord)
|
|
|
|
deriveJSON defaultOptions
|
|
{ fieldLabelModifier = camelToPathPiece' 1
|
|
} ''CorrectInterfaceUser
|
|
|
|
userToResponse :: (MonadHandler m, MonadCrypto m, MonadCryptoKey m ~ CryptoIDKey) => Entity User -> m CorrectInterfaceUser
|
|
userToResponse (Entity uid User{..}) = do
|
|
uuid <- encrypt uid
|
|
return CorrectInterfaceUser
|
|
{ ciuSurname = userSurname
|
|
, ciuDisplayName = userDisplayName
|
|
, ciuMatNr = userMatrikelnummer
|
|
, ciuId = uuid
|
|
}
|
|
|
|
|
|
data CorrectInterfaceResponse
|
|
= CorrectInterfaceResponseSuccess
|
|
{ cirsUser :: CorrectInterfaceUser
|
|
, cirsResults :: Map ExamPartNumber (Maybe ExamResultPoints)
|
|
, cirsGrade :: Maybe (Maybe ExamResultPassedGrade)
|
|
, cirsTime :: UTCTime
|
|
}
|
|
| CorrectInterfaceResponseAmbiguous
|
|
{ ciraUsers :: Set CorrectInterfaceUser
|
|
, ciraHasMore :: Bool
|
|
, ciraMessage :: Text
|
|
}
|
|
| CorrectInterfaceResponseFailure
|
|
{ cirfUser :: Maybe CorrectInterfaceUser
|
|
, cirfMessage :: Text
|
|
}
|
|
| CorrectInterfaceResponseNoOp
|
|
{ cirnUsers :: Set CorrectInterfaceUser
|
|
}
|
|
|
|
deriveToJSON defaultOptions
|
|
{ constructorTagModifier = camelToPathPiece' 3
|
|
, fieldLabelModifier = camelToPathPiece' 1
|
|
, sumEncoding = TaggedObject "status" "results"
|
|
, omitNothingFields = True
|
|
} ''CorrectInterfaceResponse
|
|
|
|
ciResponseStatus :: CorrectInterfaceResponse -> Status
|
|
ciResponseStatus CorrectInterfaceResponseSuccess{} = ok200
|
|
ciResponseStatus CorrectInterfaceResponseNoOp{} = ok200
|
|
ciResponseStatus _ = badRequest400
|
|
|
|
|
|
data CorrectInterfaceRequest
|
|
= CorrectInterfaceRequest
|
|
{ ciqUser :: Either Text (CryptoID UUID (Key User))
|
|
, ciqResults :: Maybe (NonNull (Map ExamPartNumber (Maybe Points)))
|
|
, ciqGrade :: Maybe (Maybe ExamResultPassedGrade)
|
|
}
|
|
|
|
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
|
|
ciqGrade <- if
|
|
| "grade" `HashMap.member` o
|
|
-> Just <$> o JSON..: "grade"
|
|
| otherwise
|
|
-> pure Nothing
|
|
return CorrectInterfaceRequest{..}
|