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{..}