From 942dfc9c1a7a893d2a4dd70a61a3f53517454335 Mon Sep 17 00:00:00 2001 From: danamir Date: Thu, 6 Aug 2026 12:36:16 +0300 Subject: [PATCH] Initial commit: standalone quiz-testing system Full-stack F# (Domain/Server/Client via Fable+Elmish+Feliz), PostgreSQL persistence via Dapper, Docker Compose deployment. Student quiz-taking flow with time-limit enforcement and focus-loss tracking, Teacher question bank and quiz builder with results analytics, Admin user management. --- .config/dotnet-tools.json | 13 + .dockerignore | 14 + .env.example | 8 + .gitignore | 9 + RuVdsTests.sln | 86 ++ docker-compose.yml | 47 + docs/DESIGN.md | 501 ++++++++ docs/PLAN.md | 187 +++ docs/SETUP.md | 118 ++ package-lock.json | 1059 +++++++++++++++++ package.json | 16 + src/Client/App/State.fs | 66 + src/Client/App/Types.fs | 21 + src/Client/App/View.fs | 47 + src/Client/Client.fsproj | 60 + src/Client/Dockerfile | 25 + src/Client/Features/Admin/Users/Api.fs | 63 + src/Client/Features/Admin/Users/State.fs | 121 ++ src/Client/Features/Admin/Users/Types.fs | 74 ++ src/Client/Features/Admin/Users/View.fs | 199 ++++ src/Client/Features/Auth/Login/Api.fs | 18 + src/Client/Features/Auth/Login/State.fs | 28 + src/Client/Features/Auth/Login/Types.fs | 22 + src/Client/Features/Auth/Login/View.fs | 49 + src/Client/Features/Quizzes/Browse/Api.fs | 73 ++ src/Client/Features/Quizzes/Browse/State.fs | 49 + src/Client/Features/Quizzes/Browse/Types.fs | 37 + src/Client/Features/Quizzes/Browse/View.fs | 143 +++ src/Client/Features/Quizzes/TakeQuiz/Api.fs | 47 + src/Client/Features/Quizzes/TakeQuiz/State.fs | 111 ++ src/Client/Features/Quizzes/TakeQuiz/Types.fs | 48 + src/Client/Features/Quizzes/TakeQuiz/View.fs | 159 +++ .../Features/Quizzes/ViewResult/View.fs | 24 + src/Client/Features/Teacher/Home/State.fs | 50 + src/Client/Features/Teacher/Home/Types.fs | 22 + src/Client/Features/Teacher/Home/View.fs | 33 + src/Client/Features/Teacher/Questions/Api.fs | 136 +++ .../Features/Teacher/Questions/State.fs | 265 +++++ .../Features/Teacher/Questions/Types.fs | 147 +++ src/Client/Features/Teacher/Questions/View.fs | 292 +++++ src/Client/Features/Teacher/Tests/Api.fs | 205 ++++ src/Client/Features/Teacher/Tests/State.fs | 368 ++++++ src/Client/Features/Teacher/Tests/Types.fs | 182 +++ src/Client/Features/Teacher/Tests/View.fs | 484 ++++++++ src/Client/Program.fs | 10 + src/Client/Shared/Format.fs | 12 + src/Client/Shared/JsonWire.fs | 71 ++ src/Client/Shared/SessionStorage.fs | 46 + src/Client/index.html | 20 + src/Client/nginx.conf | 8 + src/Client/style.css | 880 ++++++++++++++ src/Domain/Core/Attempts.fs | 77 ++ src/Domain/Core/Grading.fs | 89 ++ src/Domain/Core/Ids.fs | 29 + src/Domain/Core/Questions.fs | 22 + src/Domain/Core/Quizzes.fs | 54 + src/Domain/Core/Topics.fs | 4 + src/Domain/Core/Users.fs | 14 + src/Domain/Core/Validation.fs | 79 ++ src/Domain/Domain.fsproj | 39 + src/Domain/Features/AdminUsers.fs | 26 + src/Domain/Features/AssignStudents.fs | 8 + src/Domain/Features/CreateQuestion.fs | 9 + src/Domain/Features/CreateQuiz.fs | 18 + src/Domain/Features/CreateTopic.fs | 3 + src/Domain/Features/DeleteQuestion.fs | 5 + src/Domain/Features/DeleteQuiz.fs | 5 + src/Domain/Features/FinishAttempt.fs | 11 + src/Domain/Features/GetAvailableQuizzes.fs | 21 + src/Domain/Features/GetMyAttempts.fs | 15 + src/Domain/Features/GetQuizResults.fs | 29 + src/Domain/Features/ListMyQuizzes.fs | 33 + src/Domain/Features/ListQuestions.fs | 29 + src/Domain/Features/ListStudents.fs | 5 + src/Domain/Features/Login.fs | 11 + src/Domain/Features/ReportFocusLoss.fs | 10 + src/Domain/Features/StartAttempt.fs | 31 + src/Domain/Features/SubmitAnswer.fs | 8 + src/Domain/Features/UpdateQuestion.fs | 9 + src/Domain/Features/UpdateQuiz.fs | 14 + src/Server/Auth.fs | 79 ++ src/Server/Db/AttemptRepository.fs | 343 ++++++ src/Server/Db/Connection.fs | 8 + src/Server/Db/Migrator.fs | 35 + src/Server/Db/QuestionRepository.fs | 309 +++++ src/Server/Db/QuizRepository.fs | 214 ++++ src/Server/Db/TopicRepository.fs | 28 + src/Server/Db/TypeHandlers.fs | 111 ++ src/Server/Db/UserRepository.fs | 44 + src/Server/Dockerfile | 17 + src/Server/ExpirySweeper.fs | 33 + src/Server/Features/Admin/CreateUser.fs | 39 + src/Server/Features/Admin/ListUsers.fs | 23 + src/Server/Features/Admin/ResetPassword.fs | 26 + src/Server/Features/Admin/SetUserActive.fs | 28 + src/Server/Features/Admin/UpdateUser.fs | 38 + src/Server/Features/Attempts/AutoFinish.fs | 17 + src/Server/Features/Attempts/FinishAttempt.fs | 40 + .../Features/Attempts/ReportFocusLoss.fs | 29 + src/Server/Features/Attempts/SubmitAnswer.fs | 39 + src/Server/Features/Auth/Login.fs | 28 + .../Features/Quizzes/GetAvailableQuizzes.fs | 53 + src/Server/Features/Quizzes/GetMyAttempts.fs | 40 + src/Server/Features/Quizzes/StartAttempt.fs | 96 ++ src/Server/Features/Teacher/AssignStudents.fs | 34 + src/Server/Features/Teacher/CreateQuestion.fs | 83 ++ src/Server/Features/Teacher/CreateQuiz.fs | 94 ++ src/Server/Features/Teacher/CreateTopic.fs | 24 + src/Server/Features/Teacher/DeleteQuestion.fs | 29 + src/Server/Features/Teacher/DeleteQuiz.fs | 27 + src/Server/Features/Teacher/GetQuizResults.fs | 66 + src/Server/Features/Teacher/ListMyQuizzes.fs | 35 + src/Server/Features/Teacher/ListQuestions.fs | 23 + src/Server/Features/Teacher/ListStudents.fs | 20 + src/Server/Features/Teacher/ListTopics.fs | 12 + src/Server/Features/Teacher/UpdateQuestion.fs | 36 + src/Server/Features/Teacher/UpdateQuiz.fs | 44 + src/Server/Json.fs | 18 + src/Server/Migrations/0001_initial_schema.sql | 243 ++++ .../Migrations/0002_add_user_is_active.sql | 4 + .../0003_add_attempt_focus_loss.sql | 4 + src/Server/Program.fs | 92 ++ src/Server/Properties/launchSettings.json | 23 + src/Server/Routes.fs | 36 + src/Server/Seed.fs | 95 ++ src/Server/Server.fsproj | 69 ++ src/Server/Store.fs | 63 + src/Server/appsettings.Development.json | 14 + src/Server/appsettings.json | 9 + tests/Domain.Tests/Domain.Tests.fsproj | 26 + tests/Domain.Tests/GradingTests.fs | 182 +++ tests/Domain.Tests/Program.fs | 4 + tests/Domain.Tests/ValidationTests.fs | 98 ++ vite.config.js | 8 + 134 files changed, 10712 insertions(+) create mode 100644 .config/dotnet-tools.json create mode 100644 .dockerignore create mode 100644 .env.example create mode 100644 .gitignore create mode 100644 RuVdsTests.sln create mode 100644 docker-compose.yml create mode 100644 docs/DESIGN.md create mode 100644 docs/PLAN.md create mode 100644 docs/SETUP.md create mode 100644 package-lock.json create mode 100644 package.json create mode 100644 src/Client/App/State.fs create mode 100644 src/Client/App/Types.fs create mode 100644 src/Client/App/View.fs create mode 100644 src/Client/Client.fsproj create mode 100644 src/Client/Dockerfile create mode 100644 src/Client/Features/Admin/Users/Api.fs create mode 100644 src/Client/Features/Admin/Users/State.fs create mode 100644 src/Client/Features/Admin/Users/Types.fs create mode 100644 src/Client/Features/Admin/Users/View.fs create mode 100644 src/Client/Features/Auth/Login/Api.fs create mode 100644 src/Client/Features/Auth/Login/State.fs create mode 100644 src/Client/Features/Auth/Login/Types.fs create mode 100644 src/Client/Features/Auth/Login/View.fs create mode 100644 src/Client/Features/Quizzes/Browse/Api.fs create mode 100644 src/Client/Features/Quizzes/Browse/State.fs create mode 100644 src/Client/Features/Quizzes/Browse/Types.fs create mode 100644 src/Client/Features/Quizzes/Browse/View.fs create mode 100644 src/Client/Features/Quizzes/TakeQuiz/Api.fs create mode 100644 src/Client/Features/Quizzes/TakeQuiz/State.fs create mode 100644 src/Client/Features/Quizzes/TakeQuiz/Types.fs create mode 100644 src/Client/Features/Quizzes/TakeQuiz/View.fs create mode 100644 src/Client/Features/Quizzes/ViewResult/View.fs create mode 100644 src/Client/Features/Teacher/Home/State.fs create mode 100644 src/Client/Features/Teacher/Home/Types.fs create mode 100644 src/Client/Features/Teacher/Home/View.fs create mode 100644 src/Client/Features/Teacher/Questions/Api.fs create mode 100644 src/Client/Features/Teacher/Questions/State.fs create mode 100644 src/Client/Features/Teacher/Questions/Types.fs create mode 100644 src/Client/Features/Teacher/Questions/View.fs create mode 100644 src/Client/Features/Teacher/Tests/Api.fs create mode 100644 src/Client/Features/Teacher/Tests/State.fs create mode 100644 src/Client/Features/Teacher/Tests/Types.fs create mode 100644 src/Client/Features/Teacher/Tests/View.fs create mode 100644 src/Client/Program.fs create mode 100644 src/Client/Shared/Format.fs create mode 100644 src/Client/Shared/JsonWire.fs create mode 100644 src/Client/Shared/SessionStorage.fs create mode 100644 src/Client/index.html create mode 100644 src/Client/nginx.conf create mode 100644 src/Client/style.css create mode 100644 src/Domain/Core/Attempts.fs create mode 100644 src/Domain/Core/Grading.fs create mode 100644 src/Domain/Core/Ids.fs create mode 100644 src/Domain/Core/Questions.fs create mode 100644 src/Domain/Core/Quizzes.fs create mode 100644 src/Domain/Core/Topics.fs create mode 100644 src/Domain/Core/Users.fs create mode 100644 src/Domain/Core/Validation.fs create mode 100644 src/Domain/Domain.fsproj create mode 100644 src/Domain/Features/AdminUsers.fs create mode 100644 src/Domain/Features/AssignStudents.fs create mode 100644 src/Domain/Features/CreateQuestion.fs create mode 100644 src/Domain/Features/CreateQuiz.fs create mode 100644 src/Domain/Features/CreateTopic.fs create mode 100644 src/Domain/Features/DeleteQuestion.fs create mode 100644 src/Domain/Features/DeleteQuiz.fs create mode 100644 src/Domain/Features/FinishAttempt.fs create mode 100644 src/Domain/Features/GetAvailableQuizzes.fs create mode 100644 src/Domain/Features/GetMyAttempts.fs create mode 100644 src/Domain/Features/GetQuizResults.fs create mode 100644 src/Domain/Features/ListMyQuizzes.fs create mode 100644 src/Domain/Features/ListQuestions.fs create mode 100644 src/Domain/Features/ListStudents.fs create mode 100644 src/Domain/Features/Login.fs create mode 100644 src/Domain/Features/ReportFocusLoss.fs create mode 100644 src/Domain/Features/StartAttempt.fs create mode 100644 src/Domain/Features/SubmitAnswer.fs create mode 100644 src/Domain/Features/UpdateQuestion.fs create mode 100644 src/Domain/Features/UpdateQuiz.fs create mode 100644 src/Server/Auth.fs create mode 100644 src/Server/Db/AttemptRepository.fs create mode 100644 src/Server/Db/Connection.fs create mode 100644 src/Server/Db/Migrator.fs create mode 100644 src/Server/Db/QuestionRepository.fs create mode 100644 src/Server/Db/QuizRepository.fs create mode 100644 src/Server/Db/TopicRepository.fs create mode 100644 src/Server/Db/TypeHandlers.fs create mode 100644 src/Server/Db/UserRepository.fs create mode 100644 src/Server/Dockerfile create mode 100644 src/Server/ExpirySweeper.fs create mode 100644 src/Server/Features/Admin/CreateUser.fs create mode 100644 src/Server/Features/Admin/ListUsers.fs create mode 100644 src/Server/Features/Admin/ResetPassword.fs create mode 100644 src/Server/Features/Admin/SetUserActive.fs create mode 100644 src/Server/Features/Admin/UpdateUser.fs create mode 100644 src/Server/Features/Attempts/AutoFinish.fs create mode 100644 src/Server/Features/Attempts/FinishAttempt.fs create mode 100644 src/Server/Features/Attempts/ReportFocusLoss.fs create mode 100644 src/Server/Features/Attempts/SubmitAnswer.fs create mode 100644 src/Server/Features/Auth/Login.fs create mode 100644 src/Server/Features/Quizzes/GetAvailableQuizzes.fs create mode 100644 src/Server/Features/Quizzes/GetMyAttempts.fs create mode 100644 src/Server/Features/Quizzes/StartAttempt.fs create mode 100644 src/Server/Features/Teacher/AssignStudents.fs create mode 100644 src/Server/Features/Teacher/CreateQuestion.fs create mode 100644 src/Server/Features/Teacher/CreateQuiz.fs create mode 100644 src/Server/Features/Teacher/CreateTopic.fs create mode 100644 src/Server/Features/Teacher/DeleteQuestion.fs create mode 100644 src/Server/Features/Teacher/DeleteQuiz.fs create mode 100644 src/Server/Features/Teacher/GetQuizResults.fs create mode 100644 src/Server/Features/Teacher/ListMyQuizzes.fs create mode 100644 src/Server/Features/Teacher/ListQuestions.fs create mode 100644 src/Server/Features/Teacher/ListStudents.fs create mode 100644 src/Server/Features/Teacher/ListTopics.fs create mode 100644 src/Server/Features/Teacher/UpdateQuestion.fs create mode 100644 src/Server/Features/Teacher/UpdateQuiz.fs create mode 100644 src/Server/Json.fs create mode 100644 src/Server/Migrations/0001_initial_schema.sql create mode 100644 src/Server/Migrations/0002_add_user_is_active.sql create mode 100644 src/Server/Migrations/0003_add_attempt_focus_loss.sql create mode 100644 src/Server/Program.fs create mode 100644 src/Server/Properties/launchSettings.json create mode 100644 src/Server/Routes.fs create mode 100644 src/Server/Seed.fs create mode 100644 src/Server/Server.fsproj create mode 100644 src/Server/Store.fs create mode 100644 src/Server/appsettings.Development.json create mode 100644 src/Server/appsettings.json create mode 100644 tests/Domain.Tests/Domain.Tests.fsproj create mode 100644 tests/Domain.Tests/GradingTests.fs create mode 100644 tests/Domain.Tests/Program.fs create mode 100644 tests/Domain.Tests/ValidationTests.fs create mode 100644 vite.config.js diff --git a/.config/dotnet-tools.json b/.config/dotnet-tools.json new file mode 100644 index 0000000..8c334ca --- /dev/null +++ b/.config/dotnet-tools.json @@ -0,0 +1,13 @@ +{ + "version": 1, + "isRoot": true, + "tools": { + "fable": { + "version": "5.13.0", + "commands": [ + "fable" + ], + "rollForward": false + } + } +} \ No newline at end of file diff --git a/.dockerignore b/.dockerignore new file mode 100644 index 0000000..9aa436b --- /dev/null +++ b/.dockerignore @@ -0,0 +1,14 @@ +bin/ +obj/ +**/bin/ +**/obj/ +node_modules/ +fable_modules/ +src/Client/**/*.js +src/Client/**/*.js.map +src/Client/dist/ +.vs/ +*.user +.env +.git/ +docs/ diff --git a/.env.example b/.env.example new file mode 100644 index 0000000..5c9fa30 --- /dev/null +++ b/.env.example @@ -0,0 +1,8 @@ +# Copy to .env (gitignored) and fill in before running `docker-compose up`. + +# Any string works for local dev; use a long random value for anything +# beyond that. +JWT_SECRET=dev-secret-change-me-please-32-chars-min + +# Optional — defaults to "devpassword" if unset. +POSTGRES_PASSWORD=devpassword diff --git a/.gitignore b/.gitignore new file mode 100644 index 0000000..b1da713 --- /dev/null +++ b/.gitignore @@ -0,0 +1,9 @@ +bin/ +obj/ +node_modules/ +fable_modules/ +src/Client/**/*.js +src/Client/**/*.js.map +.vs/ +*.user +.env diff --git a/RuVdsTests.sln b/RuVdsTests.sln new file mode 100644 index 0000000..9c8a0b8 --- /dev/null +++ b/RuVdsTests.sln @@ -0,0 +1,86 @@ + +Microsoft Visual Studio Solution File, Format Version 12.00 +# Visual Studio Version 17 +VisualStudioVersion = 17.0.31903.59 +MinimumVisualStudioVersion = 10.0.40219.1 +Project("{2150E333-8FDC-42A3-9474-1A3956D46DE8}") = "src", "src", "{827E0CD3-B72D-47B6-A68D-7590B98EB39B}" +EndProject +Project("{F2A71F9B-5D33-465A-A702-920D77279786}") = "Domain", "src\Domain\Domain.fsproj", "{3F7A3C04-B488-478D-8B1A-36EFA1532AAC}" +EndProject +Project("{F2A71F9B-5D33-465A-A702-920D77279786}") = "Server", "src\Server\Server.fsproj", "{F7816033-6699-4C1B-AD25-08CABD9A5950}" +EndProject +Project("{F2A71F9B-5D33-465A-A702-920D77279786}") = "Client", "src\Client\Client.fsproj", "{C7CDAB67-4C65-4782-97E9-41C27CF7F163}" +EndProject +Project("{2150E333-8FDC-42A3-9474-1A3956D46DE8}") = "tests", "tests", "{0AB3BF05-4346-4AA6-1389-037BE0695223}" +EndProject +Project("{F2A71F9B-5D33-465A-A702-920D77279786}") = "Domain.Tests", "tests\Domain.Tests\Domain.Tests.fsproj", "{6662C4B5-5AB7-49E5-85B7-23BA59B2433A}" +EndProject +Global + GlobalSection(SolutionConfigurationPlatforms) = preSolution + Debug|Any CPU = Debug|Any CPU + Debug|x64 = Debug|x64 + Debug|x86 = Debug|x86 + Release|Any CPU = Release|Any CPU + Release|x64 = Release|x64 + Release|x86 = Release|x86 + EndGlobalSection + GlobalSection(ProjectConfigurationPlatforms) = postSolution + {3F7A3C04-B488-478D-8B1A-36EFA1532AAC}.Debug|Any CPU.ActiveCfg = Debug|Any CPU + {3F7A3C04-B488-478D-8B1A-36EFA1532AAC}.Debug|Any CPU.Build.0 = Debug|Any CPU + {3F7A3C04-B488-478D-8B1A-36EFA1532AAC}.Debug|x64.ActiveCfg = Debug|Any CPU + {3F7A3C04-B488-478D-8B1A-36EFA1532AAC}.Debug|x64.Build.0 = Debug|Any CPU + {3F7A3C04-B488-478D-8B1A-36EFA1532AAC}.Debug|x86.ActiveCfg = Debug|Any CPU + {3F7A3C04-B488-478D-8B1A-36EFA1532AAC}.Debug|x86.Build.0 = Debug|Any CPU + {3F7A3C04-B488-478D-8B1A-36EFA1532AAC}.Release|Any CPU.ActiveCfg = Release|Any CPU + {3F7A3C04-B488-478D-8B1A-36EFA1532AAC}.Release|Any CPU.Build.0 = Release|Any CPU + {3F7A3C04-B488-478D-8B1A-36EFA1532AAC}.Release|x64.ActiveCfg = Release|Any CPU + {3F7A3C04-B488-478D-8B1A-36EFA1532AAC}.Release|x64.Build.0 = Release|Any CPU + {3F7A3C04-B488-478D-8B1A-36EFA1532AAC}.Release|x86.ActiveCfg = Release|Any CPU + {3F7A3C04-B488-478D-8B1A-36EFA1532AAC}.Release|x86.Build.0 = Release|Any CPU + {F7816033-6699-4C1B-AD25-08CABD9A5950}.Debug|Any CPU.ActiveCfg = Debug|Any CPU + {F7816033-6699-4C1B-AD25-08CABD9A5950}.Debug|Any CPU.Build.0 = Debug|Any CPU + {F7816033-6699-4C1B-AD25-08CABD9A5950}.Debug|x64.ActiveCfg = Debug|Any CPU + {F7816033-6699-4C1B-AD25-08CABD9A5950}.Debug|x64.Build.0 = Debug|Any CPU + {F7816033-6699-4C1B-AD25-08CABD9A5950}.Debug|x86.ActiveCfg = Debug|Any CPU + {F7816033-6699-4C1B-AD25-08CABD9A5950}.Debug|x86.Build.0 = Debug|Any CPU + {F7816033-6699-4C1B-AD25-08CABD9A5950}.Release|Any CPU.ActiveCfg = Release|Any CPU + {F7816033-6699-4C1B-AD25-08CABD9A5950}.Release|Any CPU.Build.0 = Release|Any CPU + {F7816033-6699-4C1B-AD25-08CABD9A5950}.Release|x64.ActiveCfg = Release|Any CPU + {F7816033-6699-4C1B-AD25-08CABD9A5950}.Release|x64.Build.0 = Release|Any CPU + {F7816033-6699-4C1B-AD25-08CABD9A5950}.Release|x86.ActiveCfg = Release|Any CPU + {F7816033-6699-4C1B-AD25-08CABD9A5950}.Release|x86.Build.0 = Release|Any CPU + {C7CDAB67-4C65-4782-97E9-41C27CF7F163}.Debug|Any CPU.ActiveCfg = Debug|Any CPU + {C7CDAB67-4C65-4782-97E9-41C27CF7F163}.Debug|Any CPU.Build.0 = Debug|Any CPU + {C7CDAB67-4C65-4782-97E9-41C27CF7F163}.Debug|x64.ActiveCfg = Debug|Any CPU + {C7CDAB67-4C65-4782-97E9-41C27CF7F163}.Debug|x64.Build.0 = Debug|Any CPU + {C7CDAB67-4C65-4782-97E9-41C27CF7F163}.Debug|x86.ActiveCfg = Debug|Any CPU + {C7CDAB67-4C65-4782-97E9-41C27CF7F163}.Debug|x86.Build.0 = Debug|Any CPU + {C7CDAB67-4C65-4782-97E9-41C27CF7F163}.Release|Any CPU.ActiveCfg = Release|Any CPU + {C7CDAB67-4C65-4782-97E9-41C27CF7F163}.Release|Any CPU.Build.0 = Release|Any CPU + {C7CDAB67-4C65-4782-97E9-41C27CF7F163}.Release|x64.ActiveCfg = Release|Any CPU + {C7CDAB67-4C65-4782-97E9-41C27CF7F163}.Release|x64.Build.0 = Release|Any CPU + {C7CDAB67-4C65-4782-97E9-41C27CF7F163}.Release|x86.ActiveCfg = Release|Any CPU + {C7CDAB67-4C65-4782-97E9-41C27CF7F163}.Release|x86.Build.0 = Release|Any CPU + {6662C4B5-5AB7-49E5-85B7-23BA59B2433A}.Debug|Any CPU.ActiveCfg = Debug|Any CPU + {6662C4B5-5AB7-49E5-85B7-23BA59B2433A}.Debug|Any CPU.Build.0 = Debug|Any CPU + {6662C4B5-5AB7-49E5-85B7-23BA59B2433A}.Debug|x64.ActiveCfg = Debug|Any CPU + {6662C4B5-5AB7-49E5-85B7-23BA59B2433A}.Debug|x64.Build.0 = Debug|Any CPU + {6662C4B5-5AB7-49E5-85B7-23BA59B2433A}.Debug|x86.ActiveCfg = Debug|Any CPU + {6662C4B5-5AB7-49E5-85B7-23BA59B2433A}.Debug|x86.Build.0 = Debug|Any CPU + {6662C4B5-5AB7-49E5-85B7-23BA59B2433A}.Release|Any CPU.ActiveCfg = Release|Any CPU + {6662C4B5-5AB7-49E5-85B7-23BA59B2433A}.Release|Any CPU.Build.0 = Release|Any CPU + {6662C4B5-5AB7-49E5-85B7-23BA59B2433A}.Release|x64.ActiveCfg = Release|Any CPU + {6662C4B5-5AB7-49E5-85B7-23BA59B2433A}.Release|x64.Build.0 = Release|Any CPU + {6662C4B5-5AB7-49E5-85B7-23BA59B2433A}.Release|x86.ActiveCfg = Release|Any CPU + {6662C4B5-5AB7-49E5-85B7-23BA59B2433A}.Release|x86.Build.0 = Release|Any CPU + EndGlobalSection + GlobalSection(SolutionProperties) = preSolution + HideSolutionNode = FALSE + EndGlobalSection + GlobalSection(NestedProjects) = preSolution + {3F7A3C04-B488-478D-8B1A-36EFA1532AAC} = {827E0CD3-B72D-47B6-A68D-7590B98EB39B} + {F7816033-6699-4C1B-AD25-08CABD9A5950} = {827E0CD3-B72D-47B6-A68D-7590B98EB39B} + {C7CDAB67-4C65-4782-97E9-41C27CF7F163} = {827E0CD3-B72D-47B6-A68D-7590B98EB39B} + {6662C4B5-5AB7-49E5-85B7-23BA59B2433A} = {0AB3BF05-4346-4AA6-1389-037BE0695223} + EndGlobalSection +EndGlobal diff --git a/docker-compose.yml b/docker-compose.yml new file mode 100644 index 0000000..0520588 --- /dev/null +++ b/docker-compose.yml @@ -0,0 +1,47 @@ +services: + postgres: + image: postgres:16-alpine + environment: + POSTGRES_DB: quizsystem + POSTGRES_USER: quizsystem + POSTGRES_PASSWORD: ${POSTGRES_PASSWORD:-devpassword} + volumes: + - pgdata:/var/lib/postgresql/data + healthcheck: + test: ["CMD-SHELL", "pg_isready -U quizsystem -d quizsystem"] + interval: 5s + timeout: 5s + retries: 10 + networks: [quizsystem] + + server: + build: + context: . + dockerfile: src/Server/Dockerfile + environment: + ConnectionStrings__Postgres: "Host=postgres;Port=5432;Database=quizsystem;Username=quizsystem;Password=${POSTGRES_PASSWORD:-devpassword}" + Jwt__Secret: ${JWT_SECRET:?Set JWT_SECRET in .env — see .env.example} + Client__Origin: "http://localhost:8081" + ASPNETCORE_ENVIRONMENT: Production + depends_on: + postgres: + condition: service_healthy + # Mapped to the same host port the client's hardcoded + # Client/Shared/JsonWire.fs `serverUrl` already expects — the browser + # (not any container) is what resolves "localhost:5144", so this keeps + # that working unmodified for local/dev use of the compose stack. + ports: ["5144:8080"] + networks: [quizsystem] + + client: + build: + context: . + dockerfile: src/Client/Dockerfile + ports: ["8081:80"] + networks: [quizsystem] + +volumes: + pgdata: + +networks: + quizsystem: diff --git a/docs/DESIGN.md b/docs/DESIGN.md new file mode 100644 index 0000000..933fd2f --- /dev/null +++ b/docs/DESIGN.md @@ -0,0 +1,501 @@ +# Дизайн системы + +Дата: 2026-08-03. Статус: проектирование, реализация не начата (кроме уже существующего студенческого MVP). + +## 1. Идея и границы системы + +Standalone-система проверки знаний — аналог модуля «Тест» в Moodle, без остальной части LMS +(без курсов как оргединицы, без контента/форумов). Три роли: **Admin**, **Teacher**, **Student**. + +Ключевые решения, зафиксированные в разговоре с пользователем: + +| Вопрос | Решение | +|---|---| +| Курсы | Не нужны. Убираем `Course`/`Enrollment` из домена. | +| Банк вопросов | Приватный у каждого преподавателя (темы = топики, без общего пространства). | +| «Итоговый» тест со случайными вопросами | Случайный набор вопросов формируется **заново при каждой попытке** (как в Moodle). | +| Кому виден тест | Преподаватель явно назначает тест конкретным студентам (нет курсов/групп). | +| Регистрация | Открытой регистрации нет — все аккаунты создаёт Admin вручную. | +| Роль Admin | Admin = Teacher + управление пользователями (создание/удаление учителей и студентов). | +| Персистентность | PostgreSQL (уже предусмотрено комментарием в `Store.fs`), доступ через Dapper. | +| Аналитика | Нужна сразу: % правильных ответов и сложность по каждому вопросу, не только список попыток. | +| Анти-списывание | В аналитике попытки нужно видеть число потерь фокуса окна теста. | +| Лимит времени | Настраивается преподавателем (уже есть `TimeLimit`), но должен реально принуждаться, а не только отображаться. | +| Что происходит по истечении времени | Авто-сдача текущих ответов на сервере, как в Moodle. | +| Публикация теста | Отдельный флаг `IsPublished` — преподаватель готовит тест и назначения заранее, студенты не видят его, пока он явно не опубликован. | +| Ручная коррекция автооценки | Не нужна для v1 — полагаемся только на автопроверку (`Grading.gradeResponse`). | + +## 2. Роли и права + +- **Student** — видит только тесты, на которые его явно назначили; проходит попытки; видит свои результаты. +- **Teacher** — управляет **своими** темами, вопросами и тестами; назначает на тест студентов из общего + справочника пользователей (справочник read-only для Teacher — юзеров создаёт только Admin); + видит попытки и аналитику только по **своим** тестам. +- **Admin** — всё, что может Teacher (свой банк вопросов и свои тесты — то есть Admin тоже может быть + автором тестов), плюс CRUD пользователей (создание/деактивация/сброс пароля, назначение ролей). + +Авторизация как сейчас: JWT с claim роли, выдаётся при `login`. Каждый серверный хендлер +проверяет роль/владельца сам (единообразный `Result`-based шаблон ошибок, без ASP.NET `[Authorize(Roles=...)]`, +чтобы не расходиться со стилем существующего `QuizApi.fs`). + +## 3. Доменная модель (изменения к текущей) + +Убираем: `Course`, `Enrollment`, `CourseId`, `EnrollmentRole` (полностью, не используются без курсов). + +### 3.1 Пользователь + +Текущий `User` (`Domain/Users.fs`) не несёт признака активности, хотя возможность деактивации +уже решена (§2, Admin) и уже присутствует в схеме БД (§5) — это пробел, закрываем явно. +`CreatedAt` — практическая необходимость для сортировки списков в UI (Admin увидит, когда +заведён аккаунт; Teacher — когда создана тема/вопрос/тест). + +```fsharp +type User = + { Id: UserId + Name: string + Email: string + PasswordHash: string + Role: Role + IsActive: bool // NEW — деактивированный пользователь не может login'иться + CreatedAt: DateTimeOffset } // NEW +``` + +`login` дополнительно проверяет `IsActive`; при `false` — тот же `Error "Неверный email или пароль"`, +что и при неверном пароле (не раскрываем факт существования/деактивации аккаунта в тексте ошибки). + +### 3.2 Темы и вопросы + +`QuestionCategory` переименовывается в `Topic` и переподвешивается на преподавателя вместо курса: + +```fsharp +[] type TopicId = TopicId of Guid + +type Topic = + { Id: TopicId + OwnerId: UserId // преподаватель-владелец + Name: string + CreatedAt: DateTimeOffset } // NEW + +type Question = + { Id: QuestionId + TopicId: TopicId + Text: string + Points: float // дефолтные баллы вопроса в банке + Type: QuestionType // без изменений: SingleChoice/MultipleChoice/TrueFalse/ShortAnswer/Numeric + IsArchived: bool // NEW — см. врезку про удаление ниже + CreatedAt: DateTimeOffset } // NEW +``` + +**Удаление при наличии истории.** Вопрос может быть частью `Quiz.Composition` (`FixedQuestions`) +и/или уже фигурировать в чьих-то `Attempt.ResolvedQuestions`/`attempt_grades` — жёсткое удаление +сломало бы ссылочную целостность и обнулило бы прошлые результаты. Поэтому `deleteQuestion`: +если вопрос нигде не используется — удаляет по-настоящему; если используется хоть где-то — +выставляет `IsArchived = true` вместо удаления. Архивные вопросы не показываются в списке для +добавления в новый тест и не участвуют в пуле `RandomFromTopics` (§3.4), но остаются видны в +уже прошедших попытках и в `getQuestionStats` (§3.5) — история не должна исчезать. +Тема (`deleteTopic`) удаляется только если в ней **нет вопросов** (архивных в том числе — сначала +перенести/удалить вопросы); отдельного `IsArchived` для темы не вводим, это не то, на что +что-либо ссылается напрямую после удаления вопросов. + +### 3.3 Состав теста: fixed vs random-from-topics + +Главное новое понятие — тест может либо содержать явный список вопросов, либо описывать правило +случайного набора по темам: + +```fsharp +type QuizQuestionRef = + { QuestionId: QuestionId + Points: float // баллы именно в этом тесте, может отличаться от дефолта вопроса + Order: int } + +/// Правило "N случайных вопросов из темы X, каждый на Y баллов" +type RandomTopicRule = + { TopicId: TopicId + Count: int + PointsPerQuestion: float } + +type QuizComposition = + | FixedQuestions of QuizQuestionRef list + | RandomFromTopics of RandomTopicRule list + +type Quiz = + { Id: QuizId + OwnerId: UserId + Title: string + Description: string + Composition: QuizComposition + TimeLimit: TimeSpan option + MaxAttempts: int option + GradingMethod: GradingMethod + ShuffleQuestions: bool + ShuffleAnswers: bool + OpenFrom: DateTimeOffset option + OpenTo: DateTimeOffset option + PassingScore: float option + AssignedStudentIds: Set + IsPublished: bool // NEW — по умолчанию false, см. таблицу решений в §1 + IsArchived: bool // NEW — аналогично Question.IsArchived: мягкое удаление, если есть попытки + CreatedAt: DateTimeOffset } // NEW +``` + +`IsPublished` отделяет подготовку теста от его показа студентам: пока флаг не выставлен явно +(`publishQuiz`, см. §4.2), тест не появляется в `getAvailableQuizzes` даже у уже назначенных +студентов — независимо от `OpenFrom`/`OpenTo`. `deleteQuiz` — то же правило мягкого удаления, +что и для `Question` (§3.2): если по тесту уже есть хоть одна попытка, `deleteQuiz` архивирует +(`IsArchived = true`) вместо удаления, чтобы не потерять историю в `getQuizResults`/`getQuestionStats`. + +`Quiz.totalPoints` считается без резолва вопросов (важно, чтобы студент видел максимум баллов +ещё до начала попытки): +- `FixedQuestions refs` → `sum refs.Points` +- `RandomFromTopics rules` → `sum (rule.Count * rule.PointsPerQuestion)` + +"Тест по теме" из требования пользователя — это `RandomFromTopics` с одним правилом +(например, все/N вопросов из одной темы), а "итоговый" тест — `RandomFromTopics` с несколькими +правилами (по одному на каждую выбранную тему). Отдельный домена не нужен — это два случая одного +и того же режима. + +### 3.4 Резолв случайного набора и попытка + +Ключевая проблема: раз набор вопросов случаен, конкретная попытка должна **зафиксировать**, какие +именно вопросы были показаны студенту — иначе нечего будет ни оценивать, ни показывать в ревью. +Резолв случается **один раз при `startAttempt`** и сохраняется на самой попытке: + +```fsharp +type AttemptFinishReason = + | ManualSubmit + | TimedOut + +type Attempt = + { Id: AttemptId + QuizId: QuizId + UserId: UserId + AttemptNumber: int // NEW — 1, 2, 3... в рамках (QuizId, UserId), для UI и MaxAttempts + StartedAt: DateTimeOffset + SubmittedAt: DateTimeOffset option + State: AttemptState + FinishReason: AttemptFinishReason option // NEW — None пока InProgress; см. §3.6 + ResolvedQuestions: QuizQuestionRef list // NEW — конкретные вопросы именно этой попытки + Responses: Map + Grades: Map + Score: float option + FocusLossCount: int } // NEW — см. §3.6 +``` + +`AttemptNumber` считается при `startAttempt` как `(существующие попытки этого студента по этому +тесту).Length + 1` — избавляет UI/аналитику от пересчёта каждый раз. `Attempt.submit` принимает +`AttemptFinishReason` параметром (`ManualSubmit` из ручного `finishAttempt`, `TimedOut` из +принудительного завершения по лимиту времени, см. §3.6) — сигнатура меняется с +`submit (now: DateTimeOffset) (attempt: Attempt)` на +`submit (reason: AttemptFinishReason) (now: DateTimeOffset) (attempt: Attempt)`. + +Чистая (без I/O) функция резолва в `Domain`, рандом и доступ к вопросам передаются снаружи: + +```fsharp +module Quiz = + /// shuffle — инжектируемая функция перемешивания (использует ShuffleQuestions квиза сам вызывающий код). + /// topicQuestions — вопросы каждой темы, уже загруженные вызывающим кодом из Store. + let resolveComposition + (shuffle: 'a list -> 'a list) + (topicQuestions: Map) + (quiz: Quiz) + : Result = + match quiz.Composition with + | FixedQuestions refs -> Ok(if quiz.ShuffleQuestions then shuffle refs else refs) + | RandomFromTopics rules -> + rules + |> List.fold (fun acc rule -> + acc |> Result.bind (fun picked -> + match Map.tryFind rule.TopicId topicQuestions with + | Some pool when pool.Length >= rule.Count -> + let chosen = pool |> shuffle |> List.truncate rule.Count + let refs = chosen |> List.map (fun q -> { QuestionId = q.Id; Points = rule.PointsPerQuestion; Order = 0 }) + Ok(picked @ refs) + | _ -> Error "В одной из тем недостаточно вопросов для случайного набора")) + (Ok []) + |> Result.map (fun refs -> + let ordered = if quiz.ShuffleQuestions then shuffle refs else refs + ordered |> List.mapi (fun i r -> { r with Order = i })) +``` + +`Grading.gradeAttempt` переключается на `attempt.ResolvedQuestions` вместо `quiz.Questions` как +единый источник правды для обоих режимов — это же упрощает `startAttempt`/`finishAttempt`, им больше +не нужно различать fixed/random после резолва. + +### 3.5 Аналитика по вопросам + +Отдельная нормализованная таблица (см. §5) `attempt_grades` (attempt_id, question_id, points_awarded, +max_points, is_correct) пишется при `finishAttempt` вместе с `Grades`. По ней считается: + +```fsharp +type QuestionStat = + { QuestionId: QuestionId + QuestionText: string + TimesAsked: int + TimesCorrect: int + PercentCorrect: float + AvgPointsAwarded: float } +``` + +Агрегация — обычный SQL `GROUP BY question_id`, без DU-хитростей. + +### 3.6 Анти-списывание: потери фокуса окна и жёсткий лимит времени + +**Потери фокуса.** Клиент слушает `document.visibilitychange` (переключение вкладки, сворачивание) +и `window.blur` (переключение на другое окно/приложение поверх той же вкладки) с момента получения +ответа от `startAttempt` — то есть с самого начала попытки, а не с первого отвеченного вопроса +(студент может уйти листать шпаргалку ещё до того, как ответит хоть на один вопрос, и это тоже +должно засчитаться). При переходе в состояние "не в фокусе" клиент дёргает новый метод API, который **инкрементит** +счётчик на сервере (не принимает готовое число от клиента — так его нельзя подделать в свою пользу, +разве что заспамить в меньшую сторону невозможно, а накрутить больше нет смысла жулику): + +```fsharp +// добавляется в IQuizApi (§4.1) +reportFocusLoss: AttemptId -> Async> +``` + +Дребезг (несколько событий подряд при одном уходе) гасится на клиенте — считаем один "уход", +пока пользователь не вернулся (`visibilitychange` обратно в `visible` сбрасывает флаг "уже считали"). +`FocusLossCount` попадает в `AttemptSummary`/`AttemptDetail` (§3.7), преподаватель видит число +рядом с баллом и сам решает, похоже это на списывание или нет — автоматических санкций система +не применяет. + +**Жёсткий лимит времени.** Два уровня принуждения: + +1. **Активная сессия.** `submitAnswer` и `finishAttempt` перед выполнением проверяют + `Attempt.isExpired quiz now attempt` (функция уже есть в `Attempts.fs`, просто не вызывается). + Если время вышло — сервер сам переводит попытку в `Graded` (те же шаги, что и ручной + `finishAttempt`: `Attempt.submit TimedOut` → `Grading.gradeAttempt`, `FinishReason = Some TimedOut`) + и возвращает `Error "Время вышло, тест завершён автоматически"`, + а не проваливает исходное действие молча. Клиент по такому ответу показывает экран результата. +2. **Заброшенная сессия.** Если студент закрыл вкладку и больше не прислал ни одного запроса, + пункт 1 не сработает — некому вызвать `submitAnswer`. Поэтому на сервере нужен фоновый + `IHostedService` ("expiry sweeper"), который каждые ~30 сек находит `InProgress`-попытки с + `started_at + time_limit < now` в Postgres и точно так же принудительно завершает и оценивает их + (`Attempt.submit TimedOut` → `Grading.gradeAttempt`). + Это и есть источник истины по лимиту — клиентский таймер в UI (обратный отсчёт) только для + удобства студента, не для принуждения. + +Обычное ручное завершение (`finishAttempt` без истечения лимита) ставит `FinishReason = Some ManualSubmit`. +Вопросы, на которые студент не успел ответить к моменту авто-сдачи, никак специально не +обрабатываются — они и так остаются без записи в `attempt.Responses`, а `Grading.gradeAttempt` +уже сегодня трактует отсутствующий ответ через `emptyResponseFor` как нулевой/неверный +(см. `Grading.fs:59-64`). Отдельной логики "пропущенный вопрос" вводить не нужно. + +### 3.7 Финальная оценка по нескольким попыткам и история + +Пробел в более ранней версии этого документа: типы `AttemptSummary`/`AttemptDetail`/`StudentQuizResult` +упоминались в §4 по имени, но нигде не были определены. Плюс — в домене уже есть +`Grading.applyGradingMethod`, который сводит несколько попыток студента в одну итоговую оценку по +`Quiz.GradingMethod` (`HighestAttempt`/`AverageAttempt`/`FirstAttempt`/`LastAttempt`), но раньше +эта функция никуда не была подключена: ни в одном API-методе результат её работы не отдавался ни +преподавателю, ни самому студенту. Закрываем оба пробела одним набором типов: + +```fsharp +type AttemptSummary = + { AttemptId: AttemptId + StudentId: UserId + StudentName: string + AttemptNumber: int + State: AttemptState + StartedAt: DateTimeOffset + SubmittedAt: DateTimeOffset option + FinishReason: AttemptFinishReason option + Score: float option + MaxScore: float + FocusLossCount: int } + +type AttemptDetail = + { Summary: AttemptSummary + Questions: QuestionView list // как показывались студенту, из ResolvedQuestions + Responses: Map + Grades: Map } + +/// Итог по тесту для одного студента, с учётом Quiz.GradingMethod. +type StudentQuizResult = + { StudentId: UserId + StudentName: string + Attempts: AttemptSummary list + FinalScore: float option // Grading.applyGradingMethod по всем Attempts + MaxScore: float + Passed: bool option } +``` + +Два инварианта, которые эти типы предполагают: +- **Оценка — снимок на момент `finishAttempt`/sweeper'а.** Если преподаватель потом отредактирует + `Question` (текст, правильный ответ) или состав теста, уже выставленные `Grades`/`Score` задним + числом не пересчитываются — иначе история результатов "плыла" бы вместе с правками банка вопросов. + Это и есть причина, почему `Question`/`Quiz` архивируются, а не пересчитываются на лету (§3.2, §3.3). +- **`ShuffleAnswers`** (порядок вариантов ответа внутри вопроса) не требует отдельного состояния — + в отличие от `ShuffleQuestions`/`ResolvedQuestions`, порядок вариантов не влияет на то, что именно + засчитывается (ответ кодируется через стабильный `OptionId`), поэтому просто перемешивается на + сервере при формировании `QuestionView` в `startAttempt`, без сохранения куда-либо. + +## 4. API (Fable.Remoting-style, вручную через fetch — см. комментарий в `Api.fs`) + +Три интерфейса вместо одного, каждый — отдельный роут-неймспейс (`/api//`), +роль проверяется на сервере в каждом хендлере. + +### 4.1 `IQuizApi` (Student) — правки существующего + +- `login` — дополнительно проверяет `User.IsActive` (§3.1). +- `getAvailableQuizzes` — теперь фильтрует по `IsPublished = true`, `AssignedStudentIds` (только + тесты, куда назначен текущий студент), `not IsArchived` и по окну `OpenFrom`/`OpenTo`, как сейчас. +- `startAttempt`, `submitAnswer`, `finishAttempt` — логика резолва встраивается в `startAttempt` + (см. §3.4), наружу для клиента ничего не меняется; `submitAnswer`/`finishAttempt` дополнительно + проверяют истечение времени (см. §3.6). +- `reportFocusLoss: AttemptId -> Async>` — новый метод, см. §3.6. +- `getMyResults: QuizId -> Async>` — новый метод: студент видит + свою историю попыток по тесту и итоговую оценку по `Quiz.GradingMethod` (§3.7) — без него у + студента с `MaxAttempts > 1` нет способа посмотреть, как считался финальный балл. + +### 4.2 `ITeacherApi` (Teacher и Admin) + +```fsharp +type ITeacherApi = + { listTopics: unit -> Async + createTopic: string -> Async> + renameTopic: TopicId * string -> Async> + deleteTopic: TopicId -> Async> + + listQuestions: TopicId -> Async + createQuestion: CreateQuestionRequest -> Async> + updateQuestion: UpdateQuestionRequest -> Async> + deleteQuestion: QuestionId -> Async> + + listMyQuizzes: unit -> Async + getQuiz: QuizId -> Async> + createQuiz: CreateQuizRequest -> Async> + updateQuiz: UpdateQuizRequest -> Async> + publishQuiz: QuizId -> Async> // NEW — см. §3.3 + unpublishQuiz: QuizId -> Async> // NEW — снять с публикации (уже стартовавших попыток не отменяет) + deleteQuiz: QuizId -> Async> // архивирует, если есть попытки — см. §3.3 + + listStudents: unit -> Async // справочник для назначения, read-only + assignStudents: QuizId * UserId list -> Async> + unassignStudent: QuizId * UserId -> Async> + + getQuizAttempts: QuizId -> Async // сырой список попыток, см. §3.7 + getAttemptDetail: AttemptId -> Async> + getQuizResults: QuizId -> Async // NEW — сводка по студентам, см. §3.7 + getQuestionStats: QuizId -> Async } +``` + +`getQuizAttempts` и `getQuizResults` отвечают на разные вопросы: первый — "кто, когда и как проходил +тест" (нужен для анти-читерского ревью каждой отдельной попытки — `FocusLossCount`, `FinishReason`, +длительность), второй — "какая у студента итоговая оценка по тесту с учётом `GradingMethod`" +(журнал-ведомость). Оба используют типы из §3.7. + +Владение проверяется всюду: Teacher видит/меняет только темы/вопросы/тесты со своим `OwnerId` +(Admin — тоже, но плюс видит вообще всех через `IAdminApi`, не через `ITeacherApi`). + +### 4.3 `IAdminApi` (только Admin) + +```fsharp +type IAdminApi = + { listUsers: unit -> Async + createUser: CreateUserRequest -> Async> // задаёт Role: Teacher | Student | Admin + updateUser: UpdateUserRequest -> Async> + deactivateUser: UserId -> Async> + resetPassword: UserId * string -> Async> } +``` + +## 5. Персистентность (PostgreSQL + Dapper) + +DU-тяжёлые части (`QuestionType`, `QuizComposition`, `Responses`) храним как `jsonb` — реляционных +join-таблиц под каждый вариант DU не оправдано на этом масштабе, а Dapper + `System.Text.Json` (с тем же +подходом к конвертерам, что уже применён для Fable.Remoting.Json на сервере) сериализует их напрямую. + +```sql +users ( + id uuid pk, name text, email text unique, password_hash text, role text, + is_active bool not null default true, created_at timestamptz not null default now() +) + +topics (id uuid pk, owner_id uuid references users, name text, created_at timestamptz not null default now()) + +questions ( + id uuid pk, topic_id uuid references topics, text text, points double precision, type_json jsonb, + is_archived bool not null default false, created_at timestamptz not null default now() +) + +quizzes ( + id uuid pk, owner_id uuid references users, title text, description text, + composition_json jsonb, time_limit_minutes int null, max_attempts int null, + grading_method text, shuffle_questions bool, shuffle_answers bool, + open_from timestamptz null, open_to timestamptz null, passing_score double precision null, + is_published bool not null default false, is_archived bool not null default false, + created_at timestamptz not null default now() +) + +quiz_assignments (quiz_id uuid references quizzes, student_id uuid references users, primary key (quiz_id, student_id)) + +attempts ( + id uuid pk, quiz_id uuid references quizzes, user_id uuid references users, + attempt_number int not null, started_at timestamptz, submitted_at timestamptz null, state text, + finish_reason text null, resolved_questions_json jsonb, responses_json jsonb, score double precision null, + focus_loss_count int not null default 0 +) + +attempt_grades ( + attempt_id uuid references attempts, question_id uuid references questions, + points_awarded double precision, max_points double precision, is_correct bool, + primary key (attempt_id, question_id) +) +``` + +`Store.fs` заменяется на модуль с Dapper-запросами за тем же member-интерфейсом (там уже есть +комментарий это предвосхищающий) — сигнатуры методов остаются похожими, чтобы `QuizApi.fs` и новые +`TeacherApi.fs`/`AdminApi.fs` менялись минимально. + +Миграции — лёгкий инструмент поверх Dapper (например DbUp: пронумерованные `.sql`-файлы, применяются +при старте сервера), без EF Core, чтобы не тащить лишний ORM-слой. + +## 6. UX прохождения теста + +Список вопросов остаётся одним непрерывно прокручиваемым блоком, как сейчас (`View.fs:226`) — +без пагинации/пошагового визарда «один вопрос за раз». Студент должен иметь возможность свободно +скроллить вверх-вниз по всем вопросам в любом порядке и с любой скоростью, без ограничений. + +Кнопка «Завершить тест» физически выносится из области прокрутки. Сейчас (`View.fs:227-231`) она +рендерится прямо под последним вопросом внутри того же `taking-quiz-page`-контейнера — при быстрой +прокрутке длинного списка случайный клик в момент остановки скролла может преждевременно завершить +попытку. Нужен отдельный зафиксированный блок (sticky-хедер сверху или боковая панель), где живут +общие элементы управления попыткой — обратный отсчёт времени (§3.6) и кнопка «Завершить тест», — и +который не участвует в скролле списка вопросов, чтобы моторика "долистать до конца" и "нажать +завершить" были физически разными жестами. + +## 7. Фазы реализации + +1. **Домен**: `User.IsActive`/`CreatedAt`, переименование Category→Topic + `Topic.CreatedAt`, + `Question.IsArchived`/`CreatedAt`, `QuizComposition`, `Quiz.IsPublished`/`IsArchived`/`CreatedAt`, + `Attempt.ResolvedQuestions`/`AttemptNumber`/`FinishReason`/`FocusLossCount`, включение проверки + `Attempt.isExpired` в поток завершения попытки, удаление Course/Enrollment, обновление + `Grading`/`Attempt`/`Quiz` модулей + юнит-тесты (`tests/Domain.Tests`) на резолв случайного + набора, на `totalPoints` для обоих режимов и на сведение попыток через `applyGradingMethod`. +2. **PostgreSQL**: схема (§5), Dapper-репозиторий взамен `Store.fs`, миграции, конфиг строки подключения, + фоновый `IHostedService`-sweeper для заброшенных просроченных попыток (§3.6). +3. **Admin API + мини-UI**: CRUD пользователей (с учётом `IsActive`). +4. **Teacher API + UI**: темы → вопросы (с архивированием вместо жёсткого удаления, §3.2) → тесты + (fixed/random, включая настройку `TimeLimit`, `publishQuiz`/`unpublishQuiz`) → назначение студентов. +5. **Результаты и аналитика**: список попыток по тесту (`getQuizAttempts`, с `FocusLossCount`, + `FinishReason` и длительностью), сводка по студентам с учётом `GradingMethod` (`getQuizResults`), + детальный просмотр попытки, `QuestionStat`. +6. **Student UI**: уже работает end-to-end, донастройка — reflect only assigned+open quizzes, + обратный отсчёт времени в UI, слушатели `visibilitychange`/`blur` → `reportFocusLoss`, + вынос кнопки «Завершить тест» в отдельный зафиксированный блок (§6). +7. **Деплой на RuVDS**: systemd-юнит для Kestrel, nginx как reverse proxy + TLS, прод-конфиг + `Jwt:Secret`/`Client:Origin`/строка подключения к Postgres (сейчас в `appsettings.Development.json` + захардкожен dev-секрет и dev-порт клиента — см. память проекта про CORS-баг 2026-08-03). + +## 8. Открытые вопросы (не решены, всплывут по ходу реализации) + +- Нужен ли предпросмотр/тестовый прогон теста преподавателем без сохранения попытки в статистику? +- Что показывать студенту при просмотре своего результата — только баллы, или также его ответы + с правильными (риск слива вопросов в банк для будущих попыток при `MaxAttempts > 1`)? +- Лимит на минимальное число вопросов в теме, чтобы `RandomFromTopics` не падал в самый ответственный + момент («недостаточно вопросов») — валидировать при создании теста или только при старте попытки? +- Нужен ли визуальный порог/бейдж «подозрительно» при большом `FocusLossCount`, или преподаватель + просто смотрит на число сам без автоматической оценки? +- ~~С какого момента считать потери фокуса~~ — решено: с ответа `startAttempt`, см. §3.6. +- Показывать ли преподавателю архивные (`IsArchived`) вопросы/тесты в общих списках приглушённым + цветом с фильтром, или полностью прятать и доставать только через карточку конкретной попытки? diff --git a/docs/PLAN.md b/docs/PLAN.md new file mode 100644 index 0000000..12a47e0 --- /dev/null +++ b/docs/PLAN.md @@ -0,0 +1,187 @@ +# План реализации + +Живой чек-лист по `docs/DESIGN.md`. Отмечайте пункты по мере реализации (`[ ]` → `[x]`); статусы +ниже соответствуют фактическому состоянию кода на 2026-08-03. Фазы и нумерация разделов совпадают +с `docs/DESIGN.md` §7 — там же обоснование каждого пункта, здесь только чек-лист. + +## Базовое состояние на сегодня + +- [x] Студенческий флоу целиком на **старой** доменной модели (`Course`/`CategoryId`/без + `Composition`) работает end-to-end через in-memory `Store`: `login` → `getAvailableQuizzes` → + `startAttempt` → `submitAnswer` → `finishAttempt` — проверено в браузере. +- [x] CORS для dev настроен верно (`Client:Origin = http://localhost:5173`), баг с портом 5174 исправлен. +- [x] `Grading.applyGradingMethod` уже реализован и покрыт тестами (`HighestAttempt`, пустой список) — + но никуда не подключён (нет API-метода, который бы его вызывал). +- [x] `Attempt.isExpired` уже реализован — но нигде не вызывается, лимит времени сейчас не принуждается. + +Все пункты ниже — то, чего в коде пока нет. + +## Архитектурный рефакторинг: организация кода по вертикальным срезам + +Отдельный от фаз 1–7 вопрос — не про функциональность, а про то, как раскладывать код по файлам +по мере роста Server/Client. Возник из обсуждения 2026-08-03: сейчас архитектура классическая +слоистая (3 проекта = 3 слоя), а не по фиче. + +**Текущее состояние.** `Domain` (чистые типы и бизнес-логика) → `Server` (`Store.fs` + `Auth.fs` + +один `QuizApi.fs` на все хендлеры, роутинг через Fable.Remoting.Giraffe по единому интерфейсу +`IQuizApi`) → `Client` (Elmish MVU: один общий `Model` в `Types.fs`, один общий `Msg`-DU, один +`update` в `State.fs`, один `View.fs`). Срез идёт по техническому слою (типы / состояние / +отображение / API), а не по фиче — ровно то, что архитектура вертикальных срезов (VSA) устраняет. + +**Почему не полный переход на VSA.** Два места будут этому сопротивляться: +1. Контракт `IQuizApi`/`ITeacherApi`/`IAdminApi` в `Domain.Contracts` (DESIGN.md §4) — это по сути + RPC-интерфейс "один record на роль", а не роутинг по фиче. Fable.Remoting-style клиент + (`Api.fs`) уже завязан на паттерн `/api//` по этим record'ам. +2. Elmish с одним `Model`/`Msg` на всё приложение — тоже принципиально центральный паттерн; + срез по фиче потребовал бы отдельного рефакторинга на суб-модели (паттерн "Elmish page"), + не связанного с серверным вопросом. + +**Компромиссное решение.** Не ломать контракт и Elmish целиком, а **реализацию** каждого метода +интерфейса выносить в свой файл/папку по фиче, а не копить всё в одном `TeacherApi.fs`/`View.fs`. +Даёт большую часть пользы VSA (не лазить по всему файлу ради одной фичи, фича = один файл со всем +необходимым) без переписывания транспорта и стейт-менеджмента. + +**Почему сейчас удобный момент.** Из нового дизайна пока не реализовано практически ничего (см. +«Базовое состояние» выше) — так что переход дешевле всего до того, как `TeacherApi.fs`/`View.fs` +разрастутся под Teacher/Admin функциональность. + +### Server: организация по фиче +- [ ] Вместо одного `TeacherApi.fs`/`AdminApi.fs` — папка `Server/Features//.fs` + (например `Server/Features/Teacher/CreateQuiz.fs`, `.../PublishQuiz.fs`), каждый файл содержит + маппинг запроса/ответа и логику ровно одного метода интерфейса. +- [ ] Сборка `ITeacherApi`/`IAdminApi` в одном месте (аналог текущего `QuizApi.build`) остаётся + тонкой композицией — record просто ссылается на функции из `Features/*`, сам не содержит логики. +- [ ] Тот же принцип для уже существующего `QuizApi.fs` — постепенно разнести на + `Server/Features/Student/*.fs`, но не отдельным рывком, а по мере следующих правок этого файла. + +### Client: частичная декомпозиция Elmish +- [ ] Общий `Model`/`Msg`/`update` в `Types.fs`/`State.fs` остаётся корнем (сессия, роутинг между + страницами), но крупные разделы (кабинет Teacher, кабинет Admin) выносятся в под-модели по + паттерну "Elmish page" — свои Model/Msg/update/view на страницу — вместо бесконечного + расширения единых `Types.fs`/`State.fs`/`View.fs`. +- [ ] Не переписывать существующий студенческий флоу (`Types.fs`/`State.fs`/`View.fs`) ради этого — + он маленький и рабочий; применять паттерн к новым разделам (Teacher/Admin UI, фазы 3–4). + +### Когда применять +- [ ] Не блокирует фазы 1–2 (домен/БД) — там организация по типу файла (`Users.fs`/`Quizzes.fs`/..., + `Store.fs`) уже естественна и менять её не нужно. +- [ ] Применяется как соглашение **начиная с фазы 3** (Admin API) — новый код сразу пишется в + `Features/`-структуре; уже написанный `QuizApi.fs` не рефакторится превентивно, только когда + до него дойдёт очередная правка (рефакторинг не ради рефакторинга). + +## Фаза 1 — Домен (DESIGN.md §3) + +### 1.1 Пользователь (§3.1) +- [ ] `User.IsActive` +- [ ] `User.CreatedAt` +- [ ] `login` проверяет `IsActive`, отказывает тем же текстом ошибки, что и неверный пароль + +### 1.2 Темы и вопросы (§3.2) +- [ ] `QuestionCategory` → `Topic`, `CategoryId` → `TopicId` +- [ ] `Topic.OwnerId` (вместо `CourseId`), `Topic.CreatedAt` +- [ ] `Question.TopicId` (вместо `CategoryId`) +- [ ] `Question.IsArchived`, `Question.CreatedAt` +- [ ] Правило мягкого удаления вопроса (архивировать вместо удаления, если используется) — сама + флаг-логика в домене; серверная проверка "используется ли где-то" — фаза 4 + +### 1.3 Состав теста (§3.3) +- [ ] `RandomTopicRule` +- [ ] `QuizComposition` (`FixedQuestions` / `RandomFromTopics`) +- [ ] `Quiz.OwnerId` (вместо `CourseId`) +- [ ] `Quiz.AssignedStudentIds` +- [ ] `Quiz.IsPublished`, `Quiz.IsArchived`, `Quiz.CreatedAt` +- [ ] `Quiz.totalPoints` пересчитан под `Composition` (сумма по `FixedQuestions` или + `Count * PointsPerQuestion` по `RandomFromTopics`) +- [ ] Удалены `Course`, `Enrollment`, `CourseId`, `EnrollmentRole` + +### 1.4 Резолв и попытка (§3.4, §3.6) +- [ ] `AttemptFinishReason` (`ManualSubmit` / `TimedOut`) +- [ ] `Attempt.AttemptNumber` +- [ ] `Attempt.FinishReason` +- [ ] `Attempt.ResolvedQuestions` +- [ ] `Attempt.FocusLossCount` +- [ ] `Quiz.resolveComposition` (чистая функция, shuffle и вопросы темы — параметрами) +- [ ] `Attempt.submit` принимает `AttemptFinishReason` +- [ ] `Grading.gradeAttempt` переключён на `attempt.ResolvedQuestions` вместо `quiz.Questions` +- [ ] Проверка `Attempt.isExpired` встроена в поток `submitAnswer`/`finishAttempt` (авто-завершение + с `FinishReason = TimedOut`) + +### 1.5 Типы аналитики и валидация (§3.5, §3.7) +- [ ] `QuestionStat` +- [ ] `AttemptSummary`, `AttemptDetail`, `StudentQuizResult` +- [ ] `Validation.fs`: `QuizValidation` переработан под `QuizComposition` (сейчас требует + непустой `quiz.Questions`, нужно — непустой `FixedQuestions` **или** хотя бы одно правило + с `Count > 0` в `RandomFromTopics`) + +### 1.6 Юнит-тесты (`tests/Domain.Tests`) +- [ ] `resolveComposition`: `FixedQuestions` (с шаффлом и без), `RandomFromTopics` (успешный набор, + ошибка при нехватке вопросов в теме) +- [ ] `totalPoints` для обоих режимов `Composition` +- [ ] `applyGradingMethod`: добавить `AverageAttempt`/`FirstAttempt`/`LastAttempt` (сейчас покрыт + только `HighestAttempt`) +- [ ] Существующие `GradingTests.fs`/`ValidationTests.fs` обновлены под новую форму + `Question`/`Quiz` (`TopicId` вместо `CategoryId`, `Composition` вместо `Questions`) + +## Фаза 2 — PostgreSQL (§5) + +- [ ] SQL-схема: `users`, `topics`, `questions`, `quizzes`, `quiz_assignments`, `attempts`, `attempt_grades` +- [ ] Миграции (DbUp, пронумерованные `.sql`, применяются при старте сервера) +- [ ] Dapper-репозиторий взамен `Store.fs` (тот же member-интерфейс) +- [ ] Строка подключения к Postgres в конфиге (`appsettings.*.json`) +- [ ] `IHostedService` — "expiry sweeper" для заброшенных просроченных попыток (§3.6) + +## Фаза 3 — Admin API + UI (§2, §4.3) + +- [ ] `IAdminApi.listUsers` +- [ ] `IAdminApi.createUser` (с выбором `Role`) +- [ ] `IAdminApi.updateUser` +- [ ] `IAdminApi.deactivateUser` +- [ ] `IAdminApi.resetPassword` +- [ ] Проверка роли `Admin` на сервере для всех методов `IAdminApi` +- [ ] UI: список пользователей, создание/деактивация/сброс пароля + +## Фаза 4 — Teacher API + UI (§4.2) + +- [ ] `ITeacherApi`: `listTopics`/`createTopic`/`renameTopic`/`deleteTopic` +- [ ] `ITeacherApi`: `listQuestions`/`createQuestion`/`updateQuestion`/`deleteQuestion` + (с архивированием вместо удаления, если вопрос используется — §3.2) +- [ ] `ITeacherApi`: `listMyQuizzes`/`getQuiz`/`createQuiz`/`updateQuiz` +- [ ] `ITeacherApi`: `publishQuiz`/`unpublishQuiz` +- [ ] `ITeacherApi`: `deleteQuiz` (архивирование, если есть попытки — §3.3) +- [ ] `ITeacherApi`: `listStudents`/`assignStudents`/`unassignStudent` +- [ ] Проверка владения (`OwnerId`) на каждом хендлере, кроме `listStudents` +- [ ] UI: темы → вопросы → конструктор теста (fixed-список / random-по-темам) → назначение студентов + +## Фаза 5 — Результаты и аналитика (§3.5, §3.7, §4.2) + +- [ ] Запись в `attempt_grades` при `finishAttempt`/авто-завершении +- [ ] `ITeacherApi.getQuizAttempts` +- [ ] `ITeacherApi.getAttemptDetail` +- [ ] `ITeacherApi.getQuizResults` (сводка по студентам с учётом `GradingMethod`) +- [ ] `ITeacherApi.getQuestionStats` +- [ ] UI: список попыток (с `FocusLossCount`/`FinishReason`/длительностью), карточка попытки, + сводная ведомость по студентам, аналитика по вопросам + +## Фаза 6 — Student UI (§4.1, §6) + +- [ ] `getAvailableQuizzes`: фильтр по `IsPublished`, `AssignedStudentIds`, `not IsArchived`, окну дат +- [ ] `IQuizApi.getMyResults` + экран истории попыток студента +- [ ] `IQuizApi.reportFocusLoss` + клиентские слушатели `visibilitychange`/`blur` +- [ ] Обратный отсчёт времени в UI прохождения теста +- [ ] Кнопка «Завершить тест» вынесена в отдельный зафиксированный блок, не участвующий в + скролле списка вопросов (§6) + +## Фаза 7 — Деплой на RuVDS (§1, §7) + +- [ ] systemd-юнит для Kestrel +- [ ] nginx как reverse proxy + TLS +- [ ] Прод-конфиг: `Jwt:Secret`, `Client:Origin`, строка подключения к Postgres + (сейчас в `appsettings.Development.json` — dev-значения, включая исправленный порт 5173) + +## Открытые вопросы (DESIGN.md §8) — решить по ходу соответствующей фазы + +- [ ] Нужен ли предпросмотр/тестовый прогон теста преподавателем без сохранения попытки в статистику? (фаза 4) +- [ ] Показывать ли студенту его ответы с правильными при просмотре результата, или только баллы? (фаза 5/6) +- [ ] Валидировать нехватку вопросов в теме для `RandomFromTopics` при создании теста или только при старте попытки? (фаза 1/4) +- [ ] Нужен ли визуальный порог/бейдж «подозрительно» при большом `FocusLossCount`? (фаза 5) +- [ ] Показывать ли преподавателю архивные вопросы/тесты в общих списках (приглушённо+фильтр) или полностью прятать? (фаза 4) diff --git a/docs/SETUP.md b/docs/SETUP.md new file mode 100644 index 0000000..96380a2 --- /dev/null +++ b/docs/SETUP.md @@ -0,0 +1,118 @@ +# Развёртывание проекта для разработки (Windows 11) + +Два варианта: **нативная разработка** (быстрый цикл правки-проверки, рекомендуется для повседневной +работы) и **Docker Compose** (весь стек одной командой, полезно для быстрой проверки/демо). Для +обоих нужен Postgres — с этой сессии сервер больше не хранит данные в памяти. + +## Предварительные требования + +| Инструмент | Версия | Зачем | +|---|---|---| +| [Git](https://git-scm.com/) | любая современная | клонировать репозиторий | +| [.NET SDK](https://dotnet.microsoft.com/download) | 9.0 или новее | сборка Domain/Server/Client (Fable компилирует F# в JS поверх .NET SDK) | +| [Node.js](https://nodejs.org/) | 20 LTS или новее | Vite (сборка/дев-сервер клиента) | +| [Docker Desktop](https://www.docker.com/products/docker-desktop/) | любая современная | Postgres (в обоих вариантах) и опционально весь стек | + +Проверить, что всё установлено: + +```powershell +git --version +dotnet --version +node --version +docker --version +``` + +## 1. Клонировать репозиторий + +```powershell +git clone +cd RuVdsTests +``` + +## 2. Поставить зависимости + +```powershell +# Fable (F# → JS компилятор) — версия закреплена в .config/dotnet-tools.json +dotnet tool restore + +# npm-пакеты клиента (react, vite и т.д.) +npm install +``` + +## 3. Поднять Postgres + +Серверу нужна база `quizsystem` с пользователем `quizsystem`/паролем `devpassword` на порту `5432` +localhost — это то, что уже прописано по умолчанию в +`src/Server/appsettings.Development.json`, менять ничего не нужно, если использовать эти же значения. + +Самый быстрый способ — разовый контейнер: + +```powershell +docker run -d --name quizsystem-postgres -p 5432:5432 ` + -e POSTGRES_DB=quizsystem -e POSTGRES_USER=quizsystem -e POSTGRES_PASSWORD=devpassword ` + postgres:16-alpine +``` + +Схема и демо-данные создаются автоматически при первом запуске сервера (миграции — через DbUp, +сид — через `Seed.fs`, оба идемпотентны, безопасно перезапускать). + +Если 5432 на хосте уже занят другим Postgres — либо остановите его, либо смените порт в команде выше +и в `ConnectionStrings:Postgres` в `appsettings.Development.json` соответственно. + +## 4. Запустить сервер и клиент + +Два процесса, в двух отдельных терминалах: + +```powershell +# Терминал 1 — сервер (ASP.NET/Giraffe, порт 5144) +dotnet run --project src/Server/Server.fsproj +``` + +```powershell +# Терминал 2 — клиент (Fable watch + Vite dev-сервер, порт 5173) +npm run dev +``` + +Открыть **http://localhost:5173**. Демо-доступы (создаются сидом при первом запуске сервера): + +| Роль | Email | Пароль | +|---|---|---| +| Преподаватель | `teacher@example.com` | `teacher123` | +| Студент | `student@example.com` | `student123` | +| Администратор | `admin@example.com` | `admin123` | + +## Альтернатива: всё через Docker Compose + +Вместо шагов 3–4 можно поднять весь стек (Postgres + Server + Client) одной командой — не нужен ни +локальный .NET SDK, ни Node, только Docker. + +```powershell +cp .env.example .env +# при желании отредактировать .env (JWT_SECRET/POSTGRES_PASSWORD) + +docker compose up --build +``` + +Клиент — **http://localhost:8081**, сервер — **http://localhost:5144** (тот же порт, что и при +нативном запуске: клиент обращается к серверу по захардкоженному `http://localhost:5144`, поэтому +адрес совпадает независимо от способа запуска). + +```powershell +docker compose down # остановить, данные в volume сохраняются +docker compose down -v # остановить и стереть все данные Postgres +``` + +## Типичные проблемы + +- **"Domain.dll используется другим процессом" при пересборке.** Где-то в фоне остался запущенный + `dotnet run`/`dotnet watch` от прошлой сессии — найти и завершить процесс + (`Get-Process dotnet | Stop-Process`, либо точечно по PID из текста ошибки) и пересобрать заново. +- **Логин не проходит / CORS-ошибка в консоли браузера.** Обычно значит, что сервер или клиент не + запущены, либо запущены не на портах 5144/5173 — `Client:Origin` в `appsettings.Development.json` + жёстко указывает на `http://localhost:5173`. +- **Сервер падает при старте с ошибкой подключения к Postgres.** Убедиться, что контейнер/сервис + Postgres реально поднят и слушает порт 5432 (`docker ps`), и что `ConnectionStrings:Postgres` + в `appsettings.Development.json` соответствует реальным логину/паролю/порту. +- **`docker compose build` падает с сетевой ошибкой (не может достучаться до nuget.org/registry).** + Обычно временная проблема DNS/VPN на хосте — попробовать пересобрать ещё раз + (`docker compose build --no-cache`). diff --git a/package-lock.json b/package-lock.json new file mode 100644 index 0000000..0535f14 --- /dev/null +++ b/package-lock.json @@ -0,0 +1,1059 @@ +{ + "name": "ruvdstests-client", + "lockfileVersion": 3, + "requires": true, + "packages": { + "": { + "name": "ruvdstests-client", + "dependencies": { + "react": "^18.3.1", + "react-dom": "^18.3.1" + }, + "devDependencies": { + "vite": "^5.4.10" + } + }, + "node_modules/@esbuild/aix-ppc64": { + "version": "0.21.5", + "resolved": "https://registry.npmjs.org/@esbuild/aix-ppc64/-/aix-ppc64-0.21.5.tgz", + "integrity": "sha512-1SDgH6ZSPTlggy1yI6+Dbkiz8xzpHJEVAlF/AM1tHPLsf5STom9rwtjE4hKAF20FfXXNTFqEYXyJNWh1GiZedQ==", + "cpu": [ + "ppc64" + ], + "dev": true, + "license": "MIT", + "optional": true, + "os": [ + "aix" + ], + "engines": { + "node": ">=12" + } + }, + "node_modules/@esbuild/android-arm": { + "version": "0.21.5", + "resolved": "https://registry.npmjs.org/@esbuild/android-arm/-/android-arm-0.21.5.tgz", + "integrity": "sha512-vCPvzSjpPHEi1siZdlvAlsPxXl7WbOVUBBAowWug4rJHb68Ox8KualB+1ocNvT5fjv6wpkX6o/iEpbDrf68zcg==", + "cpu": [ + "arm" + ], + "dev": true, + "license": "MIT", + "optional": true, + "os": [ + "android" + ], + "engines": { + "node": ">=12" + } + }, + "node_modules/@esbuild/android-arm64": { + "version": "0.21.5", + "resolved": "https://registry.npmjs.org/@esbuild/android-arm64/-/android-arm64-0.21.5.tgz", + "integrity": "sha512-c0uX9VAUBQ7dTDCjq+wdyGLowMdtR/GoC2U5IYk/7D1H1JYC0qseD7+11iMP2mRLN9RcCMRcjC4YMclCzGwS/A==", + "cpu": [ + "arm64" + ], + "dev": true, + "license": "MIT", + "optional": true, + "os": [ + "android" + ], + "engines": { + "node": ">=12" + } + }, + "node_modules/@esbuild/android-x64": { + "version": "0.21.5", + "resolved": "https://registry.npmjs.org/@esbuild/android-x64/-/android-x64-0.21.5.tgz", + "integrity": "sha512-D7aPRUUNHRBwHxzxRvp856rjUHRFW1SdQATKXH2hqA0kAZb1hKmi02OpYRacl0TxIGz/ZmXWlbZgjwWYaCakTA==", + "cpu": [ + "x64" + ], + "dev": true, + "license": "MIT", + "optional": true, + "os": [ + "android" + ], + "engines": { + "node": ">=12" + } + }, + "node_modules/@esbuild/darwin-arm64": { + "version": "0.21.5", + "resolved": "https://registry.npmjs.org/@esbuild/darwin-arm64/-/darwin-arm64-0.21.5.tgz", + "integrity": "sha512-DwqXqZyuk5AiWWf3UfLiRDJ5EDd49zg6O9wclZ7kUMv2WRFr4HKjXp/5t8JZ11QbQfUS6/cRCKGwYhtNAY88kQ==", + "cpu": [ + "arm64" + ], + "dev": true, + "license": "MIT", + "optional": true, + "os": [ + "darwin" + ], + "engines": { + "node": ">=12" + } + }, + "node_modules/@esbuild/darwin-x64": { + "version": "0.21.5", + "resolved": "https://registry.npmjs.org/@esbuild/darwin-x64/-/darwin-x64-0.21.5.tgz", + "integrity": "sha512-se/JjF8NlmKVG4kNIuyWMV/22ZaerB+qaSi5MdrXtd6R08kvs2qCN4C09miupktDitvh8jRFflwGFBQcxZRjbw==", + "cpu": [ + "x64" + ], + "dev": true, + "license": "MIT", + "optional": true, + "os": [ + "darwin" + ], + "engines": { + "node": ">=12" + } + }, + "node_modules/@esbuild/freebsd-arm64": { + "version": "0.21.5", + "resolved": "https://registry.npmjs.org/@esbuild/freebsd-arm64/-/freebsd-arm64-0.21.5.tgz", + "integrity": "sha512-5JcRxxRDUJLX8JXp/wcBCy3pENnCgBR9bN6JsY4OmhfUtIHe3ZW0mawA7+RDAcMLrMIZaf03NlQiX9DGyB8h4g==", + "cpu": [ + "arm64" + ], + "dev": true, + "license": "MIT", + "optional": true, + "os": [ + "freebsd" + ], + "engines": { + "node": ">=12" + } + }, + "node_modules/@esbuild/freebsd-x64": { + "version": "0.21.5", + "resolved": "https://registry.npmjs.org/@esbuild/freebsd-x64/-/freebsd-x64-0.21.5.tgz", + "integrity": "sha512-J95kNBj1zkbMXtHVH29bBriQygMXqoVQOQYA+ISs0/2l3T9/kj42ow2mpqerRBxDJnmkUDCaQT/dfNXWX/ZZCQ==", + "cpu": [ + "x64" + ], + "dev": true, + "license": "MIT", + "optional": true, + "os": [ + "freebsd" + ], + "engines": { + "node": ">=12" + } + }, + "node_modules/@esbuild/linux-arm": { + "version": "0.21.5", + "resolved": "https://registry.npmjs.org/@esbuild/linux-arm/-/linux-arm-0.21.5.tgz", + "integrity": "sha512-bPb5AHZtbeNGjCKVZ9UGqGwo8EUu4cLq68E95A53KlxAPRmUyYv2D6F0uUI65XisGOL1hBP5mTronbgo+0bFcA==", + "cpu": [ + "arm" + ], + "dev": true, + "license": "MIT", + "optional": true, + "os": [ + "linux" + ], + "engines": { + "node": ">=12" + } + }, + "node_modules/@esbuild/linux-arm64": { + "version": "0.21.5", + "resolved": "https://registry.npmjs.org/@esbuild/linux-arm64/-/linux-arm64-0.21.5.tgz", + "integrity": "sha512-ibKvmyYzKsBeX8d8I7MH/TMfWDXBF3db4qM6sy+7re0YXya+K1cem3on9XgdT2EQGMu4hQyZhan7TeQ8XkGp4Q==", + "cpu": [ + "arm64" + ], + "dev": true, + "license": "MIT", + "optional": true, + "os": [ + "linux" + ], + "engines": { + "node": ">=12" + } + }, + "node_modules/@esbuild/linux-ia32": { + "version": "0.21.5", + "resolved": "https://registry.npmjs.org/@esbuild/linux-ia32/-/linux-ia32-0.21.5.tgz", + "integrity": "sha512-YvjXDqLRqPDl2dvRODYmmhz4rPeVKYvppfGYKSNGdyZkA01046pLWyRKKI3ax8fbJoK5QbxblURkwK/MWY18Tg==", + "cpu": [ + "ia32" + ], + "dev": true, + "license": "MIT", + "optional": true, + "os": [ + "linux" + ], + "engines": { + "node": ">=12" + } + }, + "node_modules/@esbuild/linux-loong64": { + "version": "0.21.5", + "resolved": "https://registry.npmjs.org/@esbuild/linux-loong64/-/linux-loong64-0.21.5.tgz", + "integrity": "sha512-uHf1BmMG8qEvzdrzAqg2SIG/02+4/DHB6a9Kbya0XDvwDEKCoC8ZRWI5JJvNdUjtciBGFQ5PuBlpEOXQj+JQSg==", + "cpu": [ + "loong64" + ], + "dev": true, + "license": "MIT", + "optional": true, + "os": [ + "linux" + ], + "engines": { + "node": ">=12" + } + }, + "node_modules/@esbuild/linux-mips64el": { + "version": "0.21.5", + "resolved": "https://registry.npmjs.org/@esbuild/linux-mips64el/-/linux-mips64el-0.21.5.tgz", + "integrity": "sha512-IajOmO+KJK23bj52dFSNCMsz1QP1DqM6cwLUv3W1QwyxkyIWecfafnI555fvSGqEKwjMXVLokcV5ygHW5b3Jbg==", + "cpu": [ + "mips64el" + ], + "dev": true, + "license": "MIT", + "optional": true, + "os": [ + "linux" + ], + "engines": { + "node": ">=12" + } + }, + "node_modules/@esbuild/linux-ppc64": { + "version": "0.21.5", + "resolved": "https://registry.npmjs.org/@esbuild/linux-ppc64/-/linux-ppc64-0.21.5.tgz", + "integrity": "sha512-1hHV/Z4OEfMwpLO8rp7CvlhBDnjsC3CttJXIhBi+5Aj5r+MBvy4egg7wCbe//hSsT+RvDAG7s81tAvpL2XAE4w==", + "cpu": [ + "ppc64" + ], + "dev": true, + "license": "MIT", + "optional": true, + "os": [ + "linux" + ], + "engines": { + "node": ">=12" + } + }, + "node_modules/@esbuild/linux-riscv64": { + "version": "0.21.5", + "resolved": "https://registry.npmjs.org/@esbuild/linux-riscv64/-/linux-riscv64-0.21.5.tgz", + "integrity": "sha512-2HdXDMd9GMgTGrPWnJzP2ALSokE/0O5HhTUvWIbD3YdjME8JwvSCnNGBnTThKGEB91OZhzrJ4qIIxk/SBmyDDA==", + "cpu": [ + "riscv64" + ], + "dev": true, + "license": "MIT", + "optional": true, + "os": [ + "linux" + ], + "engines": { + "node": ">=12" + } + }, + "node_modules/@esbuild/linux-s390x": { + "version": "0.21.5", + "resolved": "https://registry.npmjs.org/@esbuild/linux-s390x/-/linux-s390x-0.21.5.tgz", + "integrity": "sha512-zus5sxzqBJD3eXxwvjN1yQkRepANgxE9lgOW2qLnmr8ikMTphkjgXu1HR01K4FJg8h1kEEDAqDcZQtbrRnB41A==", + "cpu": [ + "s390x" + ], + "dev": true, + "license": "MIT", + "optional": true, + "os": [ + "linux" + ], + "engines": { + "node": ">=12" + } + }, + "node_modules/@esbuild/linux-x64": { + "version": "0.21.5", + "resolved": "https://registry.npmjs.org/@esbuild/linux-x64/-/linux-x64-0.21.5.tgz", + "integrity": "sha512-1rYdTpyv03iycF1+BhzrzQJCdOuAOtaqHTWJZCWvijKD2N5Xu0TtVC8/+1faWqcP9iBCWOmjmhoH94dH82BxPQ==", + "cpu": [ + "x64" + ], + "dev": true, + "license": "MIT", + "optional": true, + "os": [ + "linux" + ], + "engines": { + "node": ">=12" + } + }, + "node_modules/@esbuild/netbsd-x64": { + "version": "0.21.5", + "resolved": "https://registry.npmjs.org/@esbuild/netbsd-x64/-/netbsd-x64-0.21.5.tgz", + "integrity": "sha512-Woi2MXzXjMULccIwMnLciyZH4nCIMpWQAs049KEeMvOcNADVxo0UBIQPfSmxB3CWKedngg7sWZdLvLczpe0tLg==", + "cpu": [ + "x64" + ], + "dev": true, + "license": "MIT", + "optional": true, + "os": [ + "netbsd" + ], + "engines": { + "node": ">=12" + } + }, + "node_modules/@esbuild/openbsd-x64": { + "version": "0.21.5", + "resolved": "https://registry.npmjs.org/@esbuild/openbsd-x64/-/openbsd-x64-0.21.5.tgz", + "integrity": "sha512-HLNNw99xsvx12lFBUwoT8EVCsSvRNDVxNpjZ7bPn947b8gJPzeHWyNVhFsaerc0n3TsbOINvRP2byTZ5LKezow==", + "cpu": [ + "x64" + ], + "dev": true, + "license": "MIT", + "optional": true, + "os": [ + "openbsd" + ], + "engines": { + "node": ">=12" + } + }, + "node_modules/@esbuild/sunos-x64": { + "version": "0.21.5", + "resolved": "https://registry.npmjs.org/@esbuild/sunos-x64/-/sunos-x64-0.21.5.tgz", + "integrity": "sha512-6+gjmFpfy0BHU5Tpptkuh8+uw3mnrvgs+dSPQXQOv3ekbordwnzTVEb4qnIvQcYXq6gzkyTnoZ9dZG+D4garKg==", + "cpu": [ + "x64" + ], + "dev": true, + "license": "MIT", + "optional": true, + "os": [ + "sunos" + ], + "engines": { + "node": ">=12" + } + }, + "node_modules/@esbuild/win32-arm64": { + "version": "0.21.5", + "resolved": "https://registry.npmjs.org/@esbuild/win32-arm64/-/win32-arm64-0.21.5.tgz", + "integrity": "sha512-Z0gOTd75VvXqyq7nsl93zwahcTROgqvuAcYDUr+vOv8uHhNSKROyU961kgtCD1e95IqPKSQKH7tBTslnS3tA8A==", + "cpu": [ + "arm64" + ], + "dev": true, + "license": "MIT", + "optional": true, + "os": [ + "win32" + ], + "engines": { + "node": ">=12" + } + }, + "node_modules/@esbuild/win32-ia32": { + "version": "0.21.5", + "resolved": "https://registry.npmjs.org/@esbuild/win32-ia32/-/win32-ia32-0.21.5.tgz", + "integrity": "sha512-SWXFF1CL2RVNMaVs+BBClwtfZSvDgtL//G/smwAc5oVK/UPu2Gu9tIaRgFmYFFKrmg3SyAjSrElf0TiJ1v8fYA==", + "cpu": [ + "ia32" + ], + "dev": true, + "license": "MIT", + "optional": true, + "os": [ + "win32" + ], + "engines": { + "node": ">=12" + } + }, + "node_modules/@esbuild/win32-x64": { + "version": "0.21.5", + "resolved": "https://registry.npmjs.org/@esbuild/win32-x64/-/win32-x64-0.21.5.tgz", + "integrity": "sha512-tQd/1efJuzPC6rCFwEvLtci/xNFcTZknmXs98FYDfGE4wP9ClFV98nyKrzJKVPMhdDnjzLhdUyMX4PsQAPjwIw==", + "cpu": [ + "x64" + ], + "dev": true, + "license": "MIT", + "optional": true, + "os": [ + "win32" + ], + "engines": { + "node": ">=12" + } + }, + "node_modules/@napi-rs/lzma-linux-x64-gnu": { + "version": "1.5.1", + "resolved": "https://registry.npmjs.org/@napi-rs/lzma-linux-x64-gnu/-/lzma-linux-x64-gnu-1.5.1.tgz", + "integrity": "sha512-oTXEIha4SsuXdTA4Iyskj0kpdx2yVXdhd75c2v3xGrHFfVMsbhTPZU/nMPL4sWKo4pBHm3aucLaqGlF696dTyQ==", + "cpu": [ + "x64" + ], + "dev": true, + "license": "MIT", + "optional": true, + "os": [ + "linux" + ], + "engines": { + "node": "^22.20 || ^24.12 || >=25" + } + }, + "node_modules/@rollup/rollup-android-arm-eabi": { + "version": "4.62.4", + "resolved": "https://registry.npmjs.org/@rollup/rollup-android-arm-eabi/-/rollup-android-arm-eabi-4.62.4.tgz", + "integrity": "sha512-RrPokAb7dmbxFoeO3TloqHyOjgye8RkBhSqmp4aJMIex4c9r46ZstPnleDQOq1t46VOVjwIuwNogIqbodV1Vvg==", + "cpu": [ + "arm" + ], + "dev": true, + "license": "MIT", + "optional": true, + "os": [ + "android" + ] + }, + "node_modules/@rollup/rollup-android-arm64": { + "version": "4.62.4", + "resolved": "https://registry.npmjs.org/@rollup/rollup-android-arm64/-/rollup-android-arm64-4.62.4.tgz", + "integrity": "sha512-JKuJc+pnpks2pjy7L/N3v/cAkZxYlnmuZoD840ldbMI5KDbC4iO9NKwPKYdjYFCMAIIlBzYSFHxIJVYzRo2/8A==", + "cpu": [ + "arm64" + ], + "dev": true, + "license": "MIT", + "optional": true, + "os": [ + "android" + ] + }, + "node_modules/@rollup/rollup-darwin-arm64": { + "version": "4.62.4", + "resolved": "https://registry.npmjs.org/@rollup/rollup-darwin-arm64/-/rollup-darwin-arm64-4.62.4.tgz", + "integrity": "sha512-krw5uS2STmvJ02x0uTXHbqQNuz+9eZ1iw+qXk9dmW2gvV4jV7O2hEoOnuhFrpOPiel1mBFtqbxYZZtC46hXLOw==", + "cpu": [ + "arm64" + ], + "dev": true, + "license": "MIT", + "optional": true, + "os": [ + "darwin" + ] + }, + "node_modules/@rollup/rollup-darwin-x64": { + "version": "4.62.4", + "resolved": "https://registry.npmjs.org/@rollup/rollup-darwin-x64/-/rollup-darwin-x64-4.62.4.tgz", + "integrity": "sha512-wsTxtgApb4PrOsNJIm0FZ1h3WvCC+k9uxLJ4ad75hgoS4NiRes2SoJFlDAyMwiUY8IssDqGcHbXuN0sx1tfF1A==", + "cpu": [ + "x64" + ], + "dev": true, + "license": "MIT", + "optional": true, + "os": [ + "darwin" + ] + }, + "node_modules/@rollup/rollup-freebsd-arm64": { + "version": "4.62.4", + "resolved": "https://registry.npmjs.org/@rollup/rollup-freebsd-arm64/-/rollup-freebsd-arm64-4.62.4.tgz", + "integrity": "sha512-GUOnQlyZe3yAXhWOtOMsn5Qkrv5E5mZXa0thbARWi5Ei2szlVXJFQhddZ4HbAzh8q92w5twp+CQvs/eFanz9YQ==", + "cpu": [ + "arm64" + ], + "dev": true, + "license": "MIT", + "optional": true, + "os": [ + "freebsd" + ] + }, + "node_modules/@rollup/rollup-freebsd-x64": { + "version": "4.62.4", + "resolved": "https://registry.npmjs.org/@rollup/rollup-freebsd-x64/-/rollup-freebsd-x64-4.62.4.tgz", + "integrity": "sha512-/Y7f3QuxjzPKsjA/rfEDa3+0vXqyjmJ50Ln8dPpCmWkKTrUoWHG1cWhTqaAMLob2m2nESWuC7yGrREz019Ztqg==", + "cpu": [ + "x64" + ], + "dev": true, + "license": "MIT", + "optional": true, + "os": [ + "freebsd" + ] + }, + "node_modules/@rollup/rollup-linux-arm-gnueabihf": { + "version": "4.62.4", + "resolved": "https://registry.npmjs.org/@rollup/rollup-linux-arm-gnueabihf/-/rollup-linux-arm-gnueabihf-4.62.4.tgz", + "integrity": "sha512-81wiiX3v7aqy+T+bT61TJ78yJjRquqFFTTbAPt08imfQQzkPIW8t6aJbkTagtCCrXMNc9D66+geqlK7ydLPNqA==", + "cpu": [ + "arm" + ], + "dev": true, + "license": "MIT", + "optional": true, + "os": [ + "linux" + ] + }, + "node_modules/@rollup/rollup-linux-arm-musleabihf": { + "version": "4.62.4", + "resolved": "https://registry.npmjs.org/@rollup/rollup-linux-arm-musleabihf/-/rollup-linux-arm-musleabihf-4.62.4.tgz", + "integrity": "sha512-9kmDIvNZqdoHOBZgNtpTBeLWYO/LVipM3H/j62P8848/l/VPEQL6N3uxU9pvP1oZAsXyC2MEnFP3ovRjo7WYNQ==", + "cpu": [ + "arm" + ], + "dev": true, + "license": "MIT", + "optional": true, + "os": [ + "linux" + ] + }, + "node_modules/@rollup/rollup-linux-arm64-gnu": { + "version": "4.62.4", + "resolved": "https://registry.npmjs.org/@rollup/rollup-linux-arm64-gnu/-/rollup-linux-arm64-gnu-4.62.4.tgz", + "integrity": "sha512-CcnXHWnXg69g+DX5VWL3FHts3qMRN2uVEHX+BZvGLdd07/gXkn3ePjYtO1LDJvxkGKVHMclKBRa1QUTH+6toYQ==", + "cpu": [ + "arm64" + ], + "dev": true, + "license": "MIT", + "optional": true, + "os": [ + "linux" + ] + }, + "node_modules/@rollup/rollup-linux-arm64-musl": { + "version": "4.62.4", + "resolved": "https://registry.npmjs.org/@rollup/rollup-linux-arm64-musl/-/rollup-linux-arm64-musl-4.62.4.tgz", + "integrity": "sha512-iFOibiHnTRuhrWLlRsOQFdZJJIa7S8OwkneJr4ocALP16u5yk6lWLINFwhHaEqBFMsKDUZofLkGos7+CPzGB3g==", + "cpu": [ + "arm64" + ], + "dev": true, + "license": "MIT", + "optional": true, + "os": [ + "linux" + ] + }, + "node_modules/@rollup/rollup-linux-loong64-gnu": { + "version": "4.62.4", + "resolved": "https://registry.npmjs.org/@rollup/rollup-linux-loong64-gnu/-/rollup-linux-loong64-gnu-4.62.4.tgz", + "integrity": "sha512-XnWYMI7euHlb5a871xPja+Gm7DRCFU+FGRrtS2sMq9N8FvqtpagUy6gD4YOemC5MRk9xbh8+jYMEJbigFQwsgA==", + "cpu": [ + "loong64" + ], + "dev": true, + "license": "MIT", + "optional": true, + "os": [ + "linux" + ] + }, + "node_modules/@rollup/rollup-linux-loong64-musl": { + "version": "4.62.4", + "resolved": "https://registry.npmjs.org/@rollup/rollup-linux-loong64-musl/-/rollup-linux-loong64-musl-4.62.4.tgz", + "integrity": "sha512-qGDAlO0U8xedCcsdRm9oaoQY8DAx/QT7uIxJWhCdx0ceIWX783UC9QSYkdpzAe29wNiVfp24+bZdQmn49o45SQ==", + "cpu": [ + "loong64" + ], + "dev": true, + "license": "MIT", + "optional": true, + "os": [ + "linux" + ] + }, + "node_modules/@rollup/rollup-linux-ppc64-gnu": { + "version": "4.62.4", + "resolved": "https://registry.npmjs.org/@rollup/rollup-linux-ppc64-gnu/-/rollup-linux-ppc64-gnu-4.62.4.tgz", + "integrity": "sha512-ru4H6ezD7ysA5EiEK6qkkaEb4modH8CTej6kUy/gQi20u3kB3G7Zn8snXXkeJSCOFKG/rbPPtM/+9Wgas1961w==", + "cpu": [ + "ppc64" + ], + "dev": true, + "license": "MIT", + "optional": true, + "os": [ + "linux" + ] + }, + "node_modules/@rollup/rollup-linux-ppc64-musl": { + "version": "4.62.4", + "resolved": "https://registry.npmjs.org/@rollup/rollup-linux-ppc64-musl/-/rollup-linux-ppc64-musl-4.62.4.tgz", + "integrity": "sha512-2W4MO5WQVJnbJaZdvDb9rhBDuFU1nKIepPFpJUBsTh2k1YY2g+ODViaWuyOAjQ5cOP7NvrvLzt3wvHOoiAvc7w==", + "cpu": [ + "ppc64" + ], + "dev": true, + "license": "MIT", + "optional": true, + "os": [ + "linux" + ] + }, + "node_modules/@rollup/rollup-linux-riscv64-gnu": { + "version": "4.62.4", + "resolved": "https://registry.npmjs.org/@rollup/rollup-linux-riscv64-gnu/-/rollup-linux-riscv64-gnu-4.62.4.tgz", + "integrity": "sha512-+fxjfuoAmVMCYV5QyjoIpu0cp5DOiOTeqYFk1AVaxGr+/ravWLX89XfQmptsoWcaVy/TGf2hexzbUOrCQIL1CQ==", + "cpu": [ + "riscv64" + ], + "dev": true, + "license": "MIT", + "optional": true, + "os": [ + "linux" + ] + }, + "node_modules/@rollup/rollup-linux-riscv64-musl": { + "version": "4.62.4", + "resolved": "https://registry.npmjs.org/@rollup/rollup-linux-riscv64-musl/-/rollup-linux-riscv64-musl-4.62.4.tgz", + "integrity": "sha512-jTn8JfHGL4djjFxPuM06LmNUJDsst2jeVlsd9OmIH6zc5sC9K6rIuO4YajXatLUpBmBKl6b35ro1QZocLi+tcA==", + "cpu": [ + "riscv64" + ], + "dev": true, + "license": "MIT", + "optional": true, + "os": [ + "linux" + ] + }, + "node_modules/@rollup/rollup-linux-s390x-gnu": { + "version": "4.62.4", + "resolved": "https://registry.npmjs.org/@rollup/rollup-linux-s390x-gnu/-/rollup-linux-s390x-gnu-4.62.4.tgz", + "integrity": "sha512-oCJCJL4pXsoDcP2QZ+JVlPTIRc6266zsIaeJJsWImmF7HO0W8nb6HuSgZlMWxJwaPf8ehbSw8yo0EUw925hKsA==", + "cpu": [ + "s390x" + ], + "dev": true, + "license": "MIT", + "optional": true, + "os": [ + "linux" + ] + }, + "node_modules/@rollup/rollup-linux-x64-gnu": { + "version": "4.62.4", + "resolved": "https://registry.npmjs.org/@rollup/rollup-linux-x64-gnu/-/rollup-linux-x64-gnu-4.62.4.tgz", + "integrity": "sha512-W69hukhZ3KKNRCaMIEzKvcFye42hh0FE1+YoYaf5+Ikacuftoco6yO/xouz0hc5d5W/s3yBro5jRiuEE/Q5vUw==", + "cpu": [ + "x64" + ], + "dev": true, + "license": "MIT", + "optional": true, + "os": [ + "linux" + ] + }, + "node_modules/@rollup/rollup-linux-x64-musl": { + "version": "4.62.4", + "resolved": "https://registry.npmjs.org/@rollup/rollup-linux-x64-musl/-/rollup-linux-x64-musl-4.62.4.tgz", + "integrity": "sha512-qiXbGG2jkjXhzXpsFZSR2Xpb8DN/UaxYsbb/STbuR/6fpaDgRmmaq1B/LmtF2wQFOFOSsK2jdE0RZ3a0zHn4QA==", + "cpu": [ + "x64" + ], + "dev": true, + "license": "MIT", + "optional": true, + "os": [ + "linux" + ] + }, + "node_modules/@rollup/rollup-openbsd-x64": { + "version": "4.62.4", + "resolved": "https://registry.npmjs.org/@rollup/rollup-openbsd-x64/-/rollup-openbsd-x64-4.62.4.tgz", + "integrity": "sha512-nWeM//hxv8mIo6jD7Hu4o48DVmV9pbV6gsKaWU+4NFyqHoPKwrkRiZGLKUhOBk8qNmDmpwFtPKg80Bo/Tn4xiQ==", + "cpu": [ + "x64" + ], + "dev": true, + "license": "MIT", + "optional": true, + "os": [ + "openbsd" + ] + }, + "node_modules/@rollup/rollup-openharmony-arm64": { + "version": "4.62.4", + "resolved": "https://registry.npmjs.org/@rollup/rollup-openharmony-arm64/-/rollup-openharmony-arm64-4.62.4.tgz", + "integrity": "sha512-s62SQ/vgsRSvMwDkOEfTqfgASF0f26ZNaQuTA6Aok5lrikf89yI2W0gFHvZb2Jpgc6N8JnOKZgCK2iciO3CsxQ==", + "cpu": [ + "arm64" + ], + "dev": true, + "license": "MIT", + "optional": true, + "os": [ + "openharmony" + ] + }, + "node_modules/@rollup/rollup-win32-arm64-msvc": { + "version": "4.62.4", + "resolved": "https://registry.npmjs.org/@rollup/rollup-win32-arm64-msvc/-/rollup-win32-arm64-msvc-4.62.4.tgz", + "integrity": "sha512-J6wGf8TVGbXJq+HH+ttTvrcfNKPbuZecV6KT1B8I18BC5IURUh5kl4Yl5OEP5eFIUoI5BWxCsyYMhFsDx8kekw==", + "cpu": [ + "arm64" + ], + "dev": true, + "license": "MIT", + "optional": true, + "os": [ + "win32" + ] + }, + "node_modules/@rollup/rollup-win32-ia32-msvc": { + "version": "4.62.4", + "resolved": "https://registry.npmjs.org/@rollup/rollup-win32-ia32-msvc/-/rollup-win32-ia32-msvc-4.62.4.tgz", + "integrity": "sha512-zmfrQd/0wu6oJs8Vq8KwY/YtsKSsLtKe/HwAP4Wqy8LhWjeT55fHRAkOhYQ12wI3ayS4Tt12d5CDRD7N96SAYQ==", + "cpu": [ + "ia32" + ], + "dev": true, + "license": "MIT", + "optional": true, + "os": [ + "win32" + ] + }, + "node_modules/@rollup/rollup-win32-x64-gnu": { + "version": "4.62.4", + "resolved": "https://registry.npmjs.org/@rollup/rollup-win32-x64-gnu/-/rollup-win32-x64-gnu-4.62.4.tgz", + "integrity": "sha512-qPzHqdj9rfUD+w79dtE07zi/kFwKyCJqplp5K5ygeLTp7jLpAoc16OAH39HSmRC9UpozaecsleI8uAdEj6v2yw==", + "cpu": [ + "x64" + ], + "dev": true, + "license": "MIT", + "optional": true, + "os": [ + "win32" + ] + }, + "node_modules/@rollup/rollup-win32-x64-msvc": { + "version": "4.62.4", + "resolved": "https://registry.npmjs.org/@rollup/rollup-win32-x64-msvc/-/rollup-win32-x64-msvc-4.62.4.tgz", + "integrity": "sha512-zD6NdeWEByGE9QF9vCrlJ5YQB4oq9q91kPZS37Jwj5hOkvR1lTBSpsKhKDw4IJtbQ35LsTS1HD9DZYGKIshU1Q==", + "cpu": [ + "x64" + ], + "dev": true, + "license": "MIT", + "optional": true, + "os": [ + "win32" + ] + }, + "node_modules/@types/estree": { + "version": "1.0.9", + "resolved": "https://registry.npmjs.org/@types/estree/-/estree-1.0.9.tgz", + "integrity": "sha512-GhdPgy1el4/ImP05X05Uw4cw2/M93BCUmnEvWZNStlCzEKME4Fkk+YpoA5OiHNQmoS7Cafb8Xa3Pya8m1Qrzeg==", + "dev": true, + "license": "MIT" + }, + "node_modules/esbuild": { + "version": "0.21.5", + "resolved": "https://registry.npmjs.org/esbuild/-/esbuild-0.21.5.tgz", + "integrity": "sha512-mg3OPMV4hXywwpoDxu3Qda5xCKQi+vCTZq8S9J/EpkhB2HzKXq4SNFZE3+NK93JYxc8VMSep+lOUSC/RVKaBqw==", + "dev": true, + "hasInstallScript": true, + "license": "MIT", + "bin": { + "esbuild": "bin/esbuild" + }, + "engines": { + "node": ">=12" + }, + "optionalDependencies": { + "@esbuild/aix-ppc64": "0.21.5", + "@esbuild/android-arm": "0.21.5", + "@esbuild/android-arm64": "0.21.5", + "@esbuild/android-x64": "0.21.5", + "@esbuild/darwin-arm64": "0.21.5", + "@esbuild/darwin-x64": "0.21.5", + "@esbuild/freebsd-arm64": "0.21.5", + "@esbuild/freebsd-x64": "0.21.5", + "@esbuild/linux-arm": "0.21.5", + "@esbuild/linux-arm64": "0.21.5", + "@esbuild/linux-ia32": "0.21.5", + "@esbuild/linux-loong64": "0.21.5", + "@esbuild/linux-mips64el": "0.21.5", + "@esbuild/linux-ppc64": "0.21.5", + "@esbuild/linux-riscv64": "0.21.5", + "@esbuild/linux-s390x": "0.21.5", + "@esbuild/linux-x64": "0.21.5", + "@esbuild/netbsd-x64": "0.21.5", + "@esbuild/openbsd-x64": "0.21.5", + "@esbuild/sunos-x64": "0.21.5", + "@esbuild/win32-arm64": "0.21.5", + "@esbuild/win32-ia32": "0.21.5", + "@esbuild/win32-x64": "0.21.5" + } + }, + "node_modules/fsevents": { + "version": "2.3.3", + "resolved": "https://registry.npmjs.org/fsevents/-/fsevents-2.3.3.tgz", + "integrity": "sha512-5xoDfX+fL7faATnagmWPpbFtwh/R77WmMMqqHGS65C3vvB0YHrgF+B1YmZ3441tMj5n63k0212XNoJwzlhffQw==", + "dev": true, + "hasInstallScript": true, + "license": "MIT", + "optional": true, + "os": [ + "darwin" + ], + "engines": { + "node": "^8.16.0 || ^10.6.0 || >=11.0.0" + } + }, + "node_modules/js-tokens": { + "version": "4.0.0", + "resolved": "https://registry.npmjs.org/js-tokens/-/js-tokens-4.0.0.tgz", + "integrity": "sha512-RdJUflcE3cUzKiMqQgsCu06FPu9UdIJO0beYbPhHN4k6apgJtifcoCtT9bcxOpYBtpD2kCM6Sbzg4CausW/PKQ==", + "license": "MIT" + }, + "node_modules/loose-envify": { + "version": "1.4.0", + "resolved": "https://registry.npmjs.org/loose-envify/-/loose-envify-1.4.0.tgz", + "integrity": "sha512-lyuxPGr/Wfhrlem2CL/UcnUc1zcqKAImBDzukY7Y5F/yQiNdko6+fRLevlw1HgMySw7f611UIY408EtxRSoK3Q==", + "license": "MIT", + "dependencies": { + "js-tokens": "^3.0.0 || ^4.0.0" + }, + "bin": { + "loose-envify": "cli.js" + } + }, + "node_modules/nanoid": { + "version": "3.3.16", + "resolved": "https://registry.npmjs.org/nanoid/-/nanoid-3.3.16.tgz", + "integrity": "sha512-bzlKTyNJ7+LdGIIwy8ijFpIqEQIvafahV7eYykJ8Cvh42EdJeODoJ6gUJXpQJvej1BddH8OqTXZNE/KfbWAu8Q==", + "dev": true, + "funding": [ + { + "type": "github", + "url": "https://github.com/sponsors/ai" + } + ], + "license": "MIT", + "bin": { + "nanoid": "bin/nanoid.cjs" + }, + "engines": { + "node": "^10 || ^12 || ^13.7 || ^14 || >=15.0.1" + } + }, + "node_modules/picocolors": { + "version": "1.1.1", + "resolved": "https://registry.npmjs.org/picocolors/-/picocolors-1.1.1.tgz", + "integrity": "sha512-xceH2snhtb5M9liqDsmEw56le376mTZkEX/jEb/RxNFyegNul7eNslCXP9FDj/Lcu0X8KEyMceP2ntpaHrDEVA==", + "dev": true, + "license": "ISC" + }, + "node_modules/postcss": { + "version": "8.5.25", + "resolved": "https://registry.npmjs.org/postcss/-/postcss-8.5.25.tgz", + "integrity": "sha512-DTPx3RWSSnWyzLxQnlH0rJP+EW5ekl16ZU4/psbIhA0e53kJfdgaN5vKM+xP7yJtXVu+nfdVFmlgFDEKAe4Pyw==", + "dev": true, + "funding": [ + { + "type": "opencollective", + "url": "https://opencollective.com/postcss/" + }, + { + "type": "tidelift", + "url": "https://tidelift.com/funding/github/npm/postcss" + }, + { + "type": "github", + "url": "https://github.com/sponsors/ai" + } + ], + "license": "MIT", + "dependencies": { + "nanoid": "^3.3.16", + "picocolors": "^1.1.1", + "source-map-js": "^1.2.1" + }, + "engines": { + "node": "^10 || ^12 || >=14" + } + }, + "node_modules/react": { + "version": "18.3.1", + "resolved": "https://registry.npmjs.org/react/-/react-18.3.1.tgz", + "integrity": "sha512-wS+hAgJShR0KhEvPJArfuPVN1+Hz1t0Y6n5jLrGQbkb4urgPE/0Rve+1kMB1v/oWgHgm4WIcV+i7F2pTVj+2iQ==", + "license": "MIT", + "dependencies": { + "loose-envify": "^1.1.0" + }, + "engines": { + "node": ">=0.10.0" + } + }, + "node_modules/react-dom": { + "version": "18.3.1", + "resolved": "https://registry.npmjs.org/react-dom/-/react-dom-18.3.1.tgz", + "integrity": "sha512-5m4nQKp+rZRb09LNH59GM4BxTh9251/ylbKIbpe7TpGxfJ+9kv6BLkLBXIjjspbgbnIBNqlI23tRnTWT0snUIw==", + "license": "MIT", + "dependencies": { + "loose-envify": "^1.1.0", + "scheduler": "^0.23.2" + }, + "peerDependencies": { + "react": "^18.3.1" + } + }, + "node_modules/rollup": { + "version": "4.62.4", + "resolved": "https://registry.npmjs.org/rollup/-/rollup-4.62.4.tgz", + "integrity": "sha512-RXOqwaPsBGjMNMa4sQjDjHieHEZDFoj/Rdr46l2MU5DfEs16wHJPC2RPTPHWhNl+M3aI472LLqFkFKut4SblOg==", + "dev": true, + "license": "MIT", + "dependencies": { + "@types/estree": "1.0.9" + }, + "bin": { + "rollup": "dist/bin/rollup" + }, + "engines": { + "node": ">=18.0.0", + "npm": ">=8.0.0" + }, + "optionalDependencies": { + "@napi-rs/lzma-linux-x64-gnu": "1.5.1", + "@rollup/rollup-android-arm-eabi": "4.62.4", + "@rollup/rollup-android-arm64": "4.62.4", + "@rollup/rollup-darwin-arm64": "4.62.4", + "@rollup/rollup-darwin-x64": "4.62.4", + "@rollup/rollup-freebsd-arm64": "4.62.4", + "@rollup/rollup-freebsd-x64": "4.62.4", + "@rollup/rollup-linux-arm-gnueabihf": "4.62.4", + "@rollup/rollup-linux-arm-musleabihf": "4.62.4", + "@rollup/rollup-linux-arm64-gnu": "4.62.4", + "@rollup/rollup-linux-arm64-musl": "4.62.4", + "@rollup/rollup-linux-loong64-gnu": "4.62.4", + "@rollup/rollup-linux-loong64-musl": "4.62.4", + "@rollup/rollup-linux-ppc64-gnu": "4.62.4", + "@rollup/rollup-linux-ppc64-musl": "4.62.4", + "@rollup/rollup-linux-riscv64-gnu": "4.62.4", + "@rollup/rollup-linux-riscv64-musl": "4.62.4", + "@rollup/rollup-linux-s390x-gnu": "4.62.4", + "@rollup/rollup-linux-x64-gnu": "4.62.4", + "@rollup/rollup-linux-x64-musl": "4.62.4", + "@rollup/rollup-openbsd-x64": "4.62.4", + "@rollup/rollup-openharmony-arm64": "4.62.4", + "@rollup/rollup-win32-arm64-msvc": "4.62.4", + "@rollup/rollup-win32-ia32-msvc": "4.62.4", + "@rollup/rollup-win32-x64-gnu": "4.62.4", + "@rollup/rollup-win32-x64-msvc": "4.62.4", + "fsevents": "~2.3.2" + } + }, + "node_modules/scheduler": { + "version": "0.23.2", + "resolved": "https://registry.npmjs.org/scheduler/-/scheduler-0.23.2.tgz", + "integrity": "sha512-UOShsPwz7NrMUqhR6t0hWjFduvOzbtv7toDH1/hIrfRNIDBnnBWd0CwJTGvTpngVlmwGCdP9/Zl/tVrDqcuYzQ==", + "license": "MIT", + "dependencies": { + "loose-envify": "^1.1.0" + } + }, + "node_modules/source-map-js": { + "version": "1.2.1", + "resolved": "https://registry.npmjs.org/source-map-js/-/source-map-js-1.2.1.tgz", + "integrity": "sha512-UXWMKhLOwVKb728IUtQPXxfYU+usdybtUrK/8uGE8CQMvrhOpwvzDBwj0QhSL7MQc7vIsISBG8VQ8+IDQxpfQA==", + "dev": true, + "license": "BSD-3-Clause", + "engines": { + "node": ">=0.10.0" + } + }, + "node_modules/vite": { + "version": "5.4.21", + "resolved": "https://registry.npmjs.org/vite/-/vite-5.4.21.tgz", + "integrity": "sha512-o5a9xKjbtuhY6Bi5S3+HvbRERmouabWbyUcpXXUA1u+GNUKoROi9byOJ8M0nHbHYHkYICiMlqxkg1KkYmm25Sw==", + "dev": true, + "license": "MIT", + "dependencies": { + "esbuild": "^0.21.3", + "postcss": "^8.4.43", + "rollup": "^4.20.0" + }, + "bin": { + "vite": "bin/vite.js" + }, + "engines": { + "node": "^18.0.0 || >=20.0.0" + }, + "funding": { + "url": "https://github.com/vitejs/vite?sponsor=1" + }, + "optionalDependencies": { + "fsevents": "~2.3.3" + }, + "peerDependencies": { + "@types/node": "^18.0.0 || >=20.0.0", + "less": "*", + "lightningcss": "^1.21.0", + "sass": "*", + "sass-embedded": "*", + "stylus": "*", + "sugarss": "*", + "terser": "^5.4.0" + }, + "peerDependenciesMeta": { + "@types/node": { + "optional": true + }, + "less": { + "optional": true + }, + "lightningcss": { + "optional": true + }, + "sass": { + "optional": true + }, + "sass-embedded": { + "optional": true + }, + "stylus": { + "optional": true + }, + "sugarss": { + "optional": true + }, + "terser": { + "optional": true + } + } + } + } +} diff --git a/package.json b/package.json new file mode 100644 index 0000000..fb2f3e0 --- /dev/null +++ b/package.json @@ -0,0 +1,16 @@ +{ + "name": "ruvdstests-client", + "private": true, + "type": "module", + "scripts": { + "dev": "dotnet fable watch src/Client -o src/Client --run node node_modules/vite/bin/vite.js", + "build": "dotnet fable src/Client -o src/Client && node node_modules/vite/bin/vite.js build" + }, + "dependencies": { + "react": "^18.3.1", + "react-dom": "^18.3.1" + }, + "devDependencies": { + "vite": "^5.4.10" + } +} diff --git a/src/Client/App/State.fs b/src/Client/App/State.fs new file mode 100644 index 0000000..153abb7 --- /dev/null +++ b/src/Client/App/State.fs @@ -0,0 +1,66 @@ +module Client.App.State + +open Elmish +open Domain +open Domain.Contracts +open Client.Features +open Client.Shared.SessionStorage +open Client.App.Types + +/// Shared by `init` (restoring a persisted session) and the login-success +/// transition below, so a page refresh lands on the same role-appropriate +/// home page a fresh login would. +let private pageForSession (session: LoginResponse) : Page * Cmd = + match session.Role with + | Student -> + let browseModel, browseCmd = Quizzes.Browse.State.init () + Browse browseModel, Cmd.map BrowseMsg browseCmd + | Teacher + | Admin -> + let teacherModel, teacherCmd = Teacher.Home.State.init session.Role + TeacherHome teacherModel, Cmd.map TeacherMsg teacherCmd + +let init () : Model * Cmd = + match tryLoad () with + | Some session -> + let page, cmd = pageForSession session + { Session = Some session; Page = page }, cmd + | None -> { Session = None; Page = Login(Auth.Login.State.init ()) }, Cmd.none + +let private token (model: Model) = model.Session |> Option.map (fun s -> s.Token) + +/// Parent inspects specific child messages to handle page transitions (login +/// success, quiz started, quiz finished) and otherwise delegates to the +/// active page's own `update`, per the standard Elm "component" composition +/// pattern — no separate ExternalMsg type needed for an app this size. +let update (msg: Msg) (model: Model) : Model * Cmd = + match msg, model.Page with + | LoginMsg(Auth.Login.Types.Succeeded session), _ -> + save session + let page, cmd = pageForSession session + { Session = Some session; Page = page }, cmd + | LoginMsg subMsg, Login loginModel -> + let m, cmd = Auth.Login.State.update subMsg loginModel + { model with Page = Login m }, Cmd.map LoginMsg cmd + | BrowseMsg(Quizzes.Browse.Types.Started data), _ -> + { model with Page = TakeQuiz(Quizzes.TakeQuiz.Types.init data) }, + Cmd.map + TakeQuizMsg + (Cmd.batch [ Quizzes.TakeQuiz.State.startTicking (); Quizzes.TakeQuiz.State.attachFocusTracking () ]) + | BrowseMsg subMsg, Browse browseModel -> + let m, cmd = Quizzes.Browse.State.update (token model) subMsg browseModel + { model with Page = Browse m }, Cmd.map BrowseMsg cmd + | TakeQuizMsg(Quizzes.TakeQuiz.Types.Finished result), _ -> { model with Page = ViewResult result }, Cmd.none + | TakeQuizMsg subMsg, TakeQuiz takeQuizModel -> + let m, cmd = Quizzes.TakeQuiz.State.update (token model) subMsg takeQuizModel + { model with Page = TakeQuiz m }, Cmd.map TakeQuizMsg cmd + | TeacherMsg subMsg, TeacherHome teacherModel -> + let m, cmd = Teacher.Home.State.update (token model) subMsg teacherModel + { model with Page = TeacherHome m }, Cmd.map TeacherMsg cmd + | Logout, _ -> + clear () + { Session = None; Page = Login(Auth.Login.State.init ()) }, Cmd.none + | BackToQuizList, _ -> + let browseModel, browseCmd = Quizzes.Browse.State.init () + { model with Page = Browse browseModel }, Cmd.map BrowseMsg browseCmd + | _ -> model, Cmd.none diff --git a/src/Client/App/Types.fs b/src/Client/App/Types.fs new file mode 100644 index 0000000..f2c6d87 --- /dev/null +++ b/src/Client/App/Types.fs @@ -0,0 +1,21 @@ +module Client.App.Types + +open Domain.Contracts +open Client.Features + +type Page = + | Login of Auth.Login.Types.Model + | Browse of Quizzes.Browse.Types.Model + | TakeQuiz of Quizzes.TakeQuiz.Types.Model + | ViewResult of AttemptResult + | TeacherHome of Teacher.Home.Types.Model + +type Model = { Session: LoginResponse option; Page: Page } + +type Msg = + | LoginMsg of Auth.Login.Types.Msg + | BrowseMsg of Quizzes.Browse.Types.Msg + | TakeQuizMsg of Quizzes.TakeQuiz.Types.Msg + | TeacherMsg of Teacher.Home.Types.Msg + | Logout + | BackToQuizList diff --git a/src/Client/App/View.fs b/src/Client/App/View.fs new file mode 100644 index 0000000..76dd715 --- /dev/null +++ b/src/Client/App/View.fs @@ -0,0 +1,47 @@ +module Client.App.View + +open Feliz +open Domain +open Client.Features +open Client.App.Types + +let private roleLabel (role: Role) = + match role with + | Admin -> "Администратор" + | Teacher -> "Преподаватель" + | Student -> "Студент" + +let private withTopbar (model: Model) (dispatch: Msg -> unit) (page: ReactElement) = + Html.div [ + Html.div [ + prop.className "topbar" + prop.children [ + Html.span [ prop.className "wordmark"; prop.text "Экзамен" ] + Html.div [ + prop.className "topbar-identity" + prop.children [ + yield! + match model.Session with + | Some s -> + [ Html.span [ prop.className "topbar-name"; prop.text s.Name ] + Html.span [ prop.className "role-badge"; prop.text (roleLabel s.Role) ] ] + | None -> [] + Html.button [ prop.onClick (fun _ -> dispatch Logout); prop.text "Выйти" ] + ] + ] + ] + ] + page + ] + +let view (model: Model) (dispatch: Msg -> unit) = + match model.Page with + | Login loginModel -> Auth.Login.View.view loginModel (LoginMsg >> dispatch) + | Browse browseModel -> + withTopbar model dispatch (Quizzes.Browse.View.view browseModel (BrowseMsg >> dispatch)) + | TakeQuiz takeQuizModel -> + withTopbar model dispatch (Quizzes.TakeQuiz.View.view takeQuizModel (TakeQuizMsg >> dispatch)) + | ViewResult result -> + withTopbar model dispatch (Quizzes.ViewResult.View.view result (fun () -> dispatch BackToQuizList)) + | TeacherHome teacherModel -> + withTopbar model dispatch (Teacher.Home.View.view teacherModel (TeacherMsg >> dispatch)) diff --git a/src/Client/Client.fsproj b/src/Client/Client.fsproj new file mode 100644 index 0000000..cc7cdcc --- /dev/null +++ b/src/Client/Client.fsproj @@ -0,0 +1,60 @@ + + + + Exe + net9.0 + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + diff --git a/src/Client/Dockerfile b/src/Client/Dockerfile new file mode 100644 index 0000000..1fcc9e9 --- /dev/null +++ b/src/Client/Dockerfile @@ -0,0 +1,25 @@ +# `npm run build` shells out to `dotnet fable` before `vite build`, so this +# stage needs both Node and the .NET SDK — simplest to install Node into the +# SDK image and run the existing script unmodified, rather than hand-split it. +# Build context is the repo root (see docker-compose.yml). +# Uses the SDK 10 image (not 9, even though the project targets net9.0): +# the NuGet client in SDK 9.0.x fails to restore the `fable` dotnet-tool +# package ("Settings file 'DotnetToolSettings.xml' was not found in the +# package", right after signature verification succeeds) — SDK 10's newer +# NuGet client reads the same package fine, and building a net9.0 project +# with a newer SDK is otherwise unaffected. +FROM mcr.microsoft.com/dotnet/sdk:10.0 AS build +WORKDIR /src +RUN apt-get update && apt-get install -y --no-install-recommends nodejs npm && rm -rf /var/lib/apt/lists/* +COPY package.json package-lock.json ./ +COPY .config/ .config/ +RUN npm ci && dotnet tool restore +COPY src/Domain/ src/Domain/ +COPY src/Client/ src/Client/ +COPY vite.config.js ./ +RUN npm run build + +FROM nginx:1.27-alpine AS runtime +COPY --from=build /src/src/Client/dist /usr/share/nginx/html +COPY src/Client/nginx.conf /etc/nginx/conf.d/default.conf +EXPOSE 80 diff --git a/src/Client/Features/Admin/Users/Api.fs b/src/Client/Features/Admin/Users/Api.fs new file mode 100644 index 0000000..4ec39f3 --- /dev/null +++ b/src/Client/Features/Admin/Users/Api.fs @@ -0,0 +1,63 @@ +module Client.Features.Admin.Users.Api + +open Fable.Core.JsInterop +open Domain +open Domain.Contracts +open Client.Shared.JsonWire + +let private encRole (role: Role) : obj = box (string role) + +let private decodeUserSummary (raw: obj) : UserSummary = + { Id = decUserId raw?Id + Name = raw?Name + Email = raw?Email + Role = decodeRole raw?Role + IsActive = unbox raw?IsActive } + +let listUsers (token: string option) : Async> = + async { + let! raw = callApi token "GET" "/api/admin/users" None + return decodeResult (fun r -> (unbox r) |> Array.toList |> List.map decodeUserSummary) raw + } + +let createUser (token: string option) (req: CreateUserRequest) : Async> = + async { + let body = + createObj [ + "Name" ==> box req.Name + "Email" ==> box req.Email + "Password" ==> box req.Password + "Role" ==> encRole req.Role + ] + + let! raw = callApi token "POST" "/api/admin/users/create" (Some body) + return decodeResult decodeUserSummary raw + } + +let updateUser (token: string option) (req: UpdateUserRequest) : Async> = + async { + let body = + createObj [ + "Id" ==> encUserId req.Id + "Name" ==> box req.Name + "Email" ==> box req.Email + "Role" ==> encRole req.Role + ] + + let! raw = callApi token "POST" "/api/admin/users/update" (Some body) + return decodeResult decodeUserSummary raw + } + +let setUserActive (token: string option) ((userId, isActive): UserId * bool) : Async> = + async { + let body = createObj [ "Id" ==> encUserId userId; "IsActive" ==> box isActive ] + let! raw = callApi token "POST" "/api/admin/users/set-active" (Some body) + return decodeResult decodeUserSummary raw + } + +let resetPassword (token: string option) ((userId, newPassword): UserId * string) : Async> = + async { + let body = createObj [ "Id" ==> encUserId userId; "NewPassword" ==> box newPassword ] + let! raw = callApi token "POST" "/api/admin/users/reset-password" (Some body) + return decodeResult (fun _ -> ()) raw + } diff --git a/src/Client/Features/Admin/Users/State.fs b/src/Client/Features/Admin/Users/State.fs new file mode 100644 index 0000000..24c9b98 --- /dev/null +++ b/src/Client/Features/Admin/Users/State.fs @@ -0,0 +1,121 @@ +module Client.Features.Admin.Users.State + +open Elmish +open Domain.Contracts +open Client.Features.Admin.Users.Types + +let init () : Model * Cmd = empty, Cmd.ofMsg LoadUsers + +let update (token: string option) (msg: Msg) (model: Model) : Model * Cmd = + match msg with + | LoadUsers -> + let cmd = + Cmd.OfAsync.either + Api.listUsers + token + (function + | Ok users -> UsersLoaded users + | Error err -> UsersLoadFailed err) + (fun ex -> UsersLoadFailed ex.Message) + + { model with Loading = true; Error = None }, cmd + | UsersLoaded users -> { model with Users = users; Loading = false }, Cmd.none + | UsersLoadFailed err -> { model with Loading = false; Error = Some err }, Cmd.none + | StartNewUser -> + { model with ShowUserForm = true; EditingUserId = None; UserForm = emptyUserForm }, Cmd.none + | StartEditUser userId -> + match model.Users |> List.tryFind (fun u -> u.Id = userId) with + | None -> model, Cmd.none + | Some u -> + let form = { emptyUserForm with Name = u.Name; Email = u.Email; Role = u.Role } + { model with ShowUserForm = true; EditingUserId = Some userId; UserForm = form }, Cmd.none + | CancelUserForm -> { model with ShowUserForm = false; EditingUserId = None }, Cmd.none + | SetUserName text -> { model with UserForm = { model.UserForm with Name = text } }, Cmd.none + | SetUserEmail text -> { model with UserForm = { model.UserForm with Email = text } }, Cmd.none + | SetUserPassword text -> { model with UserForm = { model.UserForm with Password = text } }, Cmd.none + | SetUserRole role -> { model with UserForm = { model.UserForm with Role = role } }, Cmd.none + | SubmitUserForm -> + let form = model.UserForm + + if System.String.IsNullOrWhiteSpace form.Name || System.String.IsNullOrWhiteSpace form.Email then + { model with UserForm = { form with Error = Some "Имя и email обязательны" } }, Cmd.none + elif model.EditingUserId.IsNone && form.Password.Length < 6 then + { model with UserForm = { form with Error = Some "Пароль должен быть не короче 6 символов" } }, Cmd.none + else + let submitting = { form with IsSubmitting = true; Error = None } + + let cmd = + match model.EditingUserId with + | None -> + let req: CreateUserRequest = + { Name = form.Name; Email = form.Email; Password = form.Password; Role = form.Role } + + Cmd.OfAsync.either + (Api.createUser token) + req + (function + | Ok u -> UserSaved u + | Error err -> UserSaveFailed err) + (fun ex -> UserSaveFailed ex.Message) + | Some userId -> + let req: UpdateUserRequest = + { Id = userId; Name = form.Name; Email = form.Email; Role = form.Role } + + Cmd.OfAsync.either + (Api.updateUser token) + req + (function + | Ok u -> UserSaved u + | Error err -> UserSaveFailed err) + (fun ex -> UserSaveFailed ex.Message) + + { model with UserForm = submitting }, cmd + | UserSaved u -> + let exists = model.Users |> List.exists (fun x -> x.Id = u.Id) + + { model with + Users = if exists then model.Users |> List.map (fun x -> if x.Id = u.Id then u else x) else model.Users @ [ u ] + ShowUserForm = false + EditingUserId = None }, + Cmd.none + | UserSaveFailed err -> { model with UserForm = { model.UserForm with IsSubmitting = false; Error = Some err } }, Cmd.none + | ToggleActive(userId, isActive) -> + let cmd = + Cmd.OfAsync.either + (Api.setUserActive token) + (userId, isActive) + (function + | Ok u -> ActiveToggled u + | Error err -> ActiveToggleFailed err) + (fun ex -> ActiveToggleFailed ex.Message) + + { model with Error = None }, cmd + | ActiveToggled u -> + { model with Users = model.Users |> List.map (fun x -> if x.Id = u.Id then u else x) }, Cmd.none + | ActiveToggleFailed err -> { model with Error = Some err }, Cmd.none + | StartResetPassword userId -> + { model with ResetPasswordUserId = Some userId; PasswordForm = emptyPasswordForm }, Cmd.none + | CancelResetPassword -> { model with ResetPasswordUserId = None }, Cmd.none + | SetNewPassword text -> { model with PasswordForm = { model.PasswordForm with NewPassword = text } }, Cmd.none + | SubmitResetPassword -> + match model.ResetPasswordUserId with + | None -> model, Cmd.none + | Some userId -> + if model.PasswordForm.NewPassword.Length < 6 then + { model with + PasswordForm = { model.PasswordForm with Error = Some "Пароль должен быть не короче 6 символов" } }, + Cmd.none + else + let cmd = + Cmd.OfAsync.either + (Api.resetPassword token) + (userId, model.PasswordForm.NewPassword) + (function + | Ok() -> PasswordReset + | Error err -> PasswordResetFailed err) + (fun ex -> PasswordResetFailed ex.Message) + + { model with PasswordForm = { model.PasswordForm with IsSubmitting = true; Error = None } }, cmd + | PasswordReset -> { model with ResetPasswordUserId = None }, Cmd.none + | PasswordResetFailed err -> + { model with PasswordForm = { model.PasswordForm with IsSubmitting = false; Error = Some err } }, Cmd.none diff --git a/src/Client/Features/Admin/Users/Types.fs b/src/Client/Features/Admin/Users/Types.fs new file mode 100644 index 0000000..1e4dbe9 --- /dev/null +++ b/src/Client/Features/Admin/Users/Types.fs @@ -0,0 +1,74 @@ +module Client.Features.Admin.Users.Types + +open Domain +open Domain.Contracts + +type UserForm = + { Name: string + Email: string + Password: string + Role: Role + Error: string option + IsSubmitting: bool } + +let emptyUserForm = + { Name = "" + Email = "" + Password = "" + Role = Student + Error = None + IsSubmitting = false } + +type PasswordForm = + { NewPassword: string + Error: string option + IsSubmitting: bool } + +let emptyPasswordForm = { NewPassword = ""; Error = None; IsSubmitting = false } + +type Model = + { Users: UserSummary list + Loading: bool + Error: string option + /// `None` = the form creates a new user; `Some id` = it edits that + /// existing user instead (in which case the password field is hidden — + /// password changes go through the separate reset-password form). + EditingUserId: UserId option + ShowUserForm: bool + UserForm: UserForm + ResetPasswordUserId: UserId option + PasswordForm: PasswordForm } + +let empty = + { Users = [] + Loading = false + Error = None + EditingUserId = None + ShowUserForm = false + UserForm = emptyUserForm + ResetPasswordUserId = None + PasswordForm = emptyPasswordForm } + +type Msg = + | LoadUsers + | UsersLoaded of UserSummary list + | UsersLoadFailed of string + | StartNewUser + | StartEditUser of UserId + | CancelUserForm + | SetUserName of string + | SetUserEmail of string + | SetUserPassword of string + | SetUserRole of Role + | SubmitUserForm + | UserSaved of UserSummary + | UserSaveFailed of string + | ToggleActive of UserId * bool + | ActiveToggled of UserSummary + | ActiveToggleFailed of string + | StartResetPassword of UserId + | CancelResetPassword + | SetNewPassword of string + | SubmitResetPassword + | PasswordReset + | PasswordResetFailed of string diff --git a/src/Client/Features/Admin/Users/View.fs b/src/Client/Features/Admin/Users/View.fs new file mode 100644 index 0000000..c291cdb --- /dev/null +++ b/src/Client/Features/Admin/Users/View.fs @@ -0,0 +1,199 @@ +module Client.Features.Admin.Users.View + +open Feliz +open Domain +open Client.Features.Admin.Users.Types + +let private roleLabel (role: Role) = + match role with + | Admin -> "Администратор" + | Teacher -> "Преподаватель" + | Student -> "Студент" + +let private roleOptions = [ Student; Teacher; Admin ] + +let private userFormView (isEditing: bool) (model: Model) dispatch = + let form = model.UserForm + + Html.form [ + prop.className "new-question-form" + prop.onSubmit (fun e -> + e.preventDefault () + dispatch SubmitUserForm) + prop.children [ + Html.h3 (if isEditing then "Редактирование пользователя" else "Новый пользователь") + Html.label [ prop.text "Имя" ] + Html.input [ prop.type'.text; prop.value form.Name; prop.onChange (SetUserName >> dispatch) ] + Html.label [ prop.text "Email" ] + Html.input [ prop.type'.email; prop.value form.Email; prop.onChange (SetUserEmail >> dispatch) ] + if not isEditing then + Html.label [ prop.text "Пароль" ] + Html.input [ + prop.type'.password + prop.value form.Password + prop.onChange (SetUserPassword >> dispatch) + ] + Html.label [ prop.text "Роль" ] + Html.select [ + prop.value (string form.Role) + prop.onChange (fun (v: string) -> + roleOptions |> List.tryFind (fun r -> string r = v) |> Option.iter (SetUserRole >> dispatch)) + prop.children [ + for r in roleOptions -> + Html.option [ prop.key (string r); prop.value (string r); prop.text (roleLabel r) ] + ] + ] + match form.Error with + | Some err -> Html.p [ prop.className "error"; prop.text err ] + | None -> Html.none + Html.button [ + prop.type'.submit + prop.disabled form.IsSubmitting + prop.text ( + if form.IsSubmitting then "Сохранение…" + elif isEditing then "Сохранить изменения" + else "Создать пользователя" + ) + ] + Html.button [ + prop.type'.button + prop.onClick (fun _ -> dispatch CancelUserForm) + prop.text "Отмена" + ] + ] + ] + +let private passwordFormView (model: Model) dispatch = + let form = model.PasswordForm + + Html.form [ + prop.className "new-question-form" + prop.onSubmit (fun e -> + e.preventDefault () + dispatch SubmitResetPassword) + prop.children [ + Html.h3 "Сброс пароля" + Html.label [ prop.text "Новый пароль" ] + Html.input [ + prop.type'.password + prop.value form.NewPassword + prop.onChange (SetNewPassword >> dispatch) + ] + match form.Error with + | Some err -> Html.p [ prop.className "error"; prop.text err ] + | None -> Html.none + Html.button [ + prop.type'.submit + prop.disabled form.IsSubmitting + prop.text (if form.IsSubmitting then "Сохранение…" else "Сбросить пароль") + ] + Html.button [ + prop.type'.button + prop.onClick (fun _ -> dispatch CancelResetPassword) + prop.text "Отмена" + ] + ] + ] + +let view (model: Model) (dispatch: Msg -> unit) = + Html.div [ + prop.className "users-page" + prop.children [ + Html.div [ + prop.className "page-header" + prop.children [ + Html.h1 "Пользователи" + Html.button [ + prop.type'.button + prop.onClick (fun _ -> dispatch StartNewUser) + prop.text "Добавить пользователя" + ] + ] + ] + match model.Error with + | Some err -> Html.p [ prop.className "error"; prop.text err ] + | None -> Html.none + if model.Loading then + Html.p "Загрузка…" + elif model.Users.IsEmpty then + Html.p "Пользователей пока нет" + else + Html.ul [ + prop.className "users-list" + prop.children [ + for u in model.Users -> + Html.li [ + prop.key (string u.Id) + prop.className "user-row" + prop.children [ + Html.div [ + prop.className "user-row-info" + prop.children [ + Html.span [ prop.className "user-row-name"; prop.text u.Name ] + Html.span [ prop.className "tag-mono"; prop.text u.Email ] + Html.div [ + prop.className "user-row-badges" + prop.children [ + Html.span [ prop.className "role-badge"; prop.text (roleLabel u.Role) ] + Html.span [ + prop.className ( + if u.IsActive then "status-badge active" else "status-badge inactive" + ) + prop.text (if u.IsActive then "Активен" else "Отключён") + ] + ] + ] + ] + ] + Html.div [ + prop.className "user-row-actions" + prop.children [ + Html.button [ + prop.type'.button + prop.onClick (fun _ -> dispatch (StartEditUser u.Id)) + prop.text "Изменить" + ] + Html.button [ + prop.type'.button + prop.onClick (fun _ -> dispatch (StartResetPassword u.Id)) + prop.text "Сбросить пароль" + ] + Html.button [ + prop.type'.button + prop.onClick (fun _ -> dispatch (ToggleActive(u.Id, not u.IsActive))) + prop.text (if u.IsActive then "Деактивировать" else "Активировать") + ] + ] + ] + ] + ] + ] + ] + if model.ShowUserForm then + Html.div [ + prop.className "modal-backdrop" + prop.onClick (fun _ -> dispatch CancelUserForm) + prop.children [ + Html.div [ + prop.className "modal-dialog" + prop.onClick (fun e -> e.stopPropagation ()) + prop.children [ userFormView model.EditingUserId.IsSome model dispatch ] + ] + ] + ] + match model.ResetPasswordUserId with + | Some _ -> + Html.div [ + prop.className "modal-backdrop" + prop.onClick (fun _ -> dispatch CancelResetPassword) + prop.children [ + Html.div [ + prop.className "modal-dialog" + prop.onClick (fun e -> e.stopPropagation ()) + prop.children [ passwordFormView model dispatch ] + ] + ] + ] + | None -> Html.none + ] + ] diff --git a/src/Client/Features/Auth/Login/Api.fs b/src/Client/Features/Auth/Login/Api.fs new file mode 100644 index 0000000..9aacf04 --- /dev/null +++ b/src/Client/Features/Auth/Login/Api.fs @@ -0,0 +1,18 @@ +module Client.Features.Auth.Login.Api + +open Fable.Core.JsInterop +open Domain.Contracts +open Client.Shared.JsonWire + +let private decodeLoginResponse (raw: obj) : LoginResponse = + { Token = raw?Token + UserId = decUserId raw?UserId + Name = raw?Name + Role = decodeRole raw?Role } + +let login (req: LoginRequest) : Async> = + async { + let body = createObj [ "Email" ==> req.Email; "Password" ==> req.Password ] + let! raw = callApi None "POST" "/api/login" (Some body) + return decodeResult decodeLoginResponse raw + } diff --git a/src/Client/Features/Auth/Login/State.fs b/src/Client/Features/Auth/Login/State.fs new file mode 100644 index 0000000..498033d --- /dev/null +++ b/src/Client/Features/Auth/Login/State.fs @@ -0,0 +1,28 @@ +module Client.Features.Auth.Login.State + +open Elmish +open Domain.Contracts +open Client.Features.Auth.Login.Types + +let init () : Model = empty + +let update (msg: Msg) (model: Model) : Model * Cmd = + match msg with + | SetEmail email -> { model with Email = email }, Cmd.none + | SetPassword password -> { model with Password = password }, Cmd.none + | Submit -> + let model = { model with IsSubmitting = true; Error = None } + let request: LoginRequest = { Email = model.Email; Password = model.Password } + + let cmd = + Cmd.OfAsync.either + Api.login + request + (function + | Ok response -> Succeeded response + | Error err -> Failed err) + (fun ex -> Failed ex.Message) + + model, cmd + | Succeeded _ -> model, Cmd.none // handled by the parent, which switches pages + | Failed err -> { model with IsSubmitting = false; Error = Some err }, Cmd.none diff --git a/src/Client/Features/Auth/Login/Types.fs b/src/Client/Features/Auth/Login/Types.fs new file mode 100644 index 0000000..899159e --- /dev/null +++ b/src/Client/Features/Auth/Login/Types.fs @@ -0,0 +1,22 @@ +module Client.Features.Auth.Login.Types + +open Domain.Contracts + +type Model = + { Email: string + Password: string + Error: string option + IsSubmitting: bool } + +let empty = + { Email = "" + Password = "" + Error = None + IsSubmitting = false } + +type Msg = + | SetEmail of string + | SetPassword of string + | Submit + | Succeeded of LoginResponse + | Failed of string diff --git a/src/Client/Features/Auth/Login/View.fs b/src/Client/Features/Auth/Login/View.fs new file mode 100644 index 0000000..a730d4d --- /dev/null +++ b/src/Client/Features/Auth/Login/View.fs @@ -0,0 +1,49 @@ +module Client.Features.Auth.Login.View + +open Feliz +open Client.Features.Auth.Login.Types + +let view (model: Model) (dispatch: Msg -> unit) = + Html.div [ + prop.className "login-page" + prop.children [ + Html.h1 [ prop.className "wordmark"; prop.text "Экзамен" ] + Html.p [ prop.className "hint"; prop.text "Система тестирования" ] + Html.div [ + prop.className "login-card" + prop.children [ + Html.form [ + prop.onSubmit (fun e -> + e.preventDefault () + dispatch Submit) + prop.children [ + Html.label [ prop.text "Email" ] + Html.input [ + prop.type'.email + prop.value model.Email + prop.onChange (SetEmail >> dispatch) + ] + Html.label [ prop.text "Пароль" ] + Html.input [ + prop.type'.password + prop.value model.Password + prop.onChange (SetPassword >> dispatch) + ] + match model.Error with + | Some err -> Html.p [ prop.className "error"; prop.text err ] + | None -> Html.none + Html.button [ + prop.type'.submit + prop.disabled model.IsSubmitting + prop.text (if model.IsSubmitting then "Вход…" else "Войти") + ] + ] + ] + ] + ] + Html.p [ + prop.className "hint" + prop.text "Демо: teacher@example.com / teacher123 или student@example.com / student123" + ] + ] + ] diff --git a/src/Client/Features/Quizzes/Browse/Api.fs b/src/Client/Features/Quizzes/Browse/Api.fs new file mode 100644 index 0000000..0ab8b97 --- /dev/null +++ b/src/Client/Features/Quizzes/Browse/Api.fs @@ -0,0 +1,73 @@ +module Client.Features.Quizzes.Browse.Api + +open Fable.Core.JsInterop +open Domain +open Domain.Contracts +open Client.Shared.JsonWire + +let private decodeQuizSummary (raw: obj) : QuizSummary = + { Id = decQuizId raw?Id + Title = raw?Title + Description = raw?Description + TotalPoints = raw?TotalPoints + TimeLimitMinutes = raw?TimeLimitMinutes |> optDec unbox + MaxAttempts = raw?MaxAttempts |> optDec unbox + AttemptsCount = raw?AttemptsCount + AlreadyPassed = raw?AlreadyPassed } + +let private decodeMyAttemptSummary (raw: obj) : MyAttemptSummary = + { AttemptId = decAttemptId raw?AttemptId + StartedAt = System.DateTimeOffset.Parse(raw?StartedAt: string) + Score = raw?Score + MaxScore = raw?MaxScore + Passed = raw?Passed |> optDec unbox } + +let private decodeQuestionViewKind (raw: obj) : QuestionViewKind = + match box raw with + | :? string as caseName -> + match caseName with + | "TrueFalseView" -> TrueFalseView + | "ShortAnswerView" -> ShortAnswerView + | "NumericView" -> NumericView + | other -> failwithf "Неизвестный тип вопроса: %s" other + | _ -> + if not (isNullOrUndefined raw?SingleChoiceView) then + let options: (obj * string)[] = raw?SingleChoiceView + SingleChoiceView(options |> Array.toList |> List.map (fun (idRaw, text) -> decOptionId idRaw, text)) + elif not (isNullOrUndefined raw?MultipleChoiceView) then + let options: (obj * string)[] = raw?MultipleChoiceView + MultipleChoiceView(options |> Array.toList |> List.map (fun (idRaw, text) -> decOptionId idRaw, text)) + else + failwith "Неизвестный тип вопроса" + +let private decodeQuestionView (raw: obj) : QuestionView = + { Id = decQuestionId raw?Id + Text = raw?Text + Points = raw?Points + Kind = decodeQuestionViewKind raw?Kind } + +let private decodeQuizForAttempt (raw: obj) : QuizForAttempt = + { AttemptId = decAttemptId raw?AttemptId + Quiz = decodeQuizSummary raw?Quiz + StartedAt = System.DateTimeOffset.Parse(raw?StartedAt: string) + Questions = (unbox raw?Questions) |> Array.toList |> List.map decodeQuestionView } + +let getAvailableQuizzes (token: string option) : Async = + async { + let! raw = callApi token "GET" "/api/quizzes" None + return (unbox raw) |> Array.toList |> List.map decodeQuizSummary + } + +let startAttempt (token: string option) (quizId: QuizId) : Async> = + async { + let body = createObj [ "QuizId" ==> encQuizId quizId ] + let! raw = callApi token "POST" "/api/quizzes/start" (Some body) + return decodeResult decodeQuizForAttempt raw + } + +let getMyAttempts (token: string option) (quizId: QuizId) : Async> = + async { + let body = createObj [ "QuizId" ==> encQuizId quizId ] + let! raw = callApi token "POST" "/api/quizzes/my-attempts" (Some body) + return decodeResult (fun r -> (unbox r) |> Array.toList |> List.map decodeMyAttemptSummary) raw + } diff --git a/src/Client/Features/Quizzes/Browse/State.fs b/src/Client/Features/Quizzes/Browse/State.fs new file mode 100644 index 0000000..46143cb --- /dev/null +++ b/src/Client/Features/Quizzes/Browse/State.fs @@ -0,0 +1,49 @@ +module Client.Features.Quizzes.Browse.State + +open Elmish +open Client.Features.Quizzes.Browse.Types + +let init () : Model * Cmd = empty, Cmd.ofMsg Load + +let private loadCmd (token: string option) = + Cmd.OfAsync.either Api.getAvailableQuizzes token Loaded (fun ex -> LoadFailed ex.Message) + +let update (token: string option) (msg: Msg) (model: Model) : Model * Cmd = + match msg with + | Load -> { model with Loading = true; Error = None }, loadCmd token + | Loaded quizzes -> { model with Quizzes = quizzes; Loading = false }, Cmd.none + | LoadFailed err -> { model with Loading = false; Error = Some err }, Cmd.none + | Start quizId -> + let cmd = + Cmd.OfAsync.either + (Api.startAttempt token) + quizId + (function + | Ok data -> Started data + | Error err -> StartFailed err) + (fun ex -> StartFailed ex.Message) + + { model with StartingQuizId = Some quizId; Error = None }, cmd + | Started _ -> { model with StartingQuizId = None }, Cmd.none // handled by the parent, which switches pages + | StartFailed err -> { model with StartingQuizId = None; Error = Some err }, Cmd.none + | ToggleResults quizId -> + if model.ExpandedResultsFor = Some quizId then + { model with ExpandedResultsFor = None }, Cmd.none + else + let cmd = + Cmd.OfAsync.either + (Api.getMyAttempts token) + quizId + (function + | Ok results -> ResultsLoaded results + | Error err -> ResultsLoadFailed err) + (fun ex -> ResultsLoadFailed ex.Message) + + { model with + ExpandedResultsFor = Some quizId + ResultsLoading = true + ResultsError = None + Results = [] }, + cmd + | ResultsLoaded results -> { model with Results = results; ResultsLoading = false }, Cmd.none + | ResultsLoadFailed err -> { model with ResultsLoading = false; ResultsError = Some err }, Cmd.none diff --git a/src/Client/Features/Quizzes/Browse/Types.fs b/src/Client/Features/Quizzes/Browse/Types.fs new file mode 100644 index 0000000..e996daf --- /dev/null +++ b/src/Client/Features/Quizzes/Browse/Types.fs @@ -0,0 +1,37 @@ +module Client.Features.Quizzes.Browse.Types + +open Domain +open Domain.Contracts + +type Model = + { Quizzes: QuizSummary list + Loading: bool + Error: string option + StartingQuizId: QuizId option + /// Which quiz's past-attempts panel is currently expanded, if any — + /// only one at a time, closing on a second click of the same button. + ExpandedResultsFor: QuizId option + ResultsLoading: bool + ResultsError: string option + Results: MyAttemptSummary list } + +let empty = + { Quizzes = [] + Loading = false + Error = None + StartingQuizId = None + ExpandedResultsFor = None + ResultsLoading = false + ResultsError = None + Results = [] } + +type Msg = + | Load + | Loaded of QuizSummary list + | LoadFailed of string + | Start of QuizId + | Started of QuizForAttempt + | StartFailed of string + | ToggleResults of QuizId + | ResultsLoaded of MyAttemptSummary list + | ResultsLoadFailed of string diff --git a/src/Client/Features/Quizzes/Browse/View.fs b/src/Client/Features/Quizzes/Browse/View.fs new file mode 100644 index 0000000..fa7636f --- /dev/null +++ b/src/Client/Features/Quizzes/Browse/View.fs @@ -0,0 +1,143 @@ +module Client.Features.Quizzes.Browse.View + +open Feliz +open Domain.Contracts +open Client.Shared +open Client.Features.Quizzes.Browse.Types + +let private attemptRow (a: MyAttemptSummary) = + Html.li [ + prop.key (string a.AttemptId) + prop.className "attempt-row" + prop.children [ + Html.span [ + prop.className "tag-mono" + prop.text (a.StartedAt.ToLocalTime().ToString("dd.MM.yyyy HH:mm")) + ] + Html.span [ + prop.className "score-value" + prop.text (sprintf "%s / %s" (Format.points a.Score) (Format.points a.MaxScore)) + ] + match a.Passed with + | Some true -> Html.span [ prop.className "grade-stamp passed"; prop.text "Пройден" ] + | Some false -> Html.span [ prop.className "grade-stamp failed"; prop.text "Не пройден" ] + | None -> Html.none + ] + ] + +let private resultsPanel (model: Model) = + Html.div [ + prop.className "results-panel" + prop.children [ + match model.ResultsError with + | Some err -> Html.p [ prop.className "error"; prop.text err ] + | None -> Html.none + if model.ResultsLoading then + Html.p "Загрузка…" + elif model.Results.IsEmpty then + Html.p "Нет завершённых попыток" + else + Html.ul [ prop.children [ for a in model.Results -> attemptRow a ] ] + ] + ] + +let view (model: Model) (dispatch: Msg -> unit) = + Html.div [ + prop.className "quiz-list-page" + prop.children [ + Html.h2 "Доступные тесты" + match model.Error with + | Some err -> Html.p [ prop.className "error"; prop.text err ] + | None -> Html.none + if model.Loading then + Html.p "Загрузка…" + elif model.Quizzes.IsEmpty then + Html.p "Тесты недоступны" + else + Html.ul [ + prop.children [ + for quiz in model.Quizzes -> + let remainingAttempts = + quiz.MaxAttempts |> Option.map (fun m -> System.Math.Max(0, m - quiz.AttemptsCount)) + + Html.li [ + prop.key (string quiz.Id) + prop.className "quiz-card" + prop.children [ + Html.h3 quiz.Title + Html.p quiz.Description + Html.div [ + prop.className "meta-row" + prop.children [ + Html.div [ + prop.className "meta-item" + prop.children [ + Html.span [ prop.className "meta-label"; prop.text "Баллов" ] + Html.span [ + prop.className "meta-value" + prop.text (Format.points quiz.TotalPoints) + ] + ] + ] + match quiz.TimeLimitMinutes with + | Some minutes -> + Html.div [ + prop.className "meta-item" + prop.children [ + Html.span [ prop.className "meta-label"; prop.text "Лимит времени" ] + Html.span [ + prop.className "meta-value" + prop.text (sprintf "%d мин" minutes) + ] + ] + ] + | None -> Html.none + match quiz.MaxAttempts, remainingAttempts with + | Some maxAttempts, Some remaining -> + Html.div [ + prop.className "meta-item" + prop.children [ + Html.span [ prop.className "meta-label"; prop.text "Осталось попыток" ] + Html.span [ + prop.className "meta-value" + prop.text (sprintf "%d из %d" remaining maxAttempts) + ] + ] + ] + | _ -> Html.none + ] + ] + if quiz.AlreadyPassed then + Html.span [ prop.className "status-badge active"; prop.text "Тест пройден успешно" ] + elif remainingAttempts = Some 0 then + Html.p [ prop.className "hint"; prop.text "Попытки исчерпаны" ] + else + Html.button [ + prop.disabled (model.StartingQuizId = Some quiz.Id) + prop.onClick (fun _ -> dispatch (Start quiz.Id)) + prop.text ( + if model.StartingQuizId = Some quiz.Id then + "Запуск…" + else + "Начать тест" + ) + ] + if quiz.AttemptsCount > 0 then + Html.button [ + prop.type'.button + prop.onClick (fun _ -> dispatch (ToggleResults quiz.Id)) + prop.text ( + if model.ExpandedResultsFor = Some quiz.Id then + "Скрыть результаты" + else + sprintf "Посмотреть результаты (%d)" quiz.AttemptsCount + ) + ] + if model.ExpandedResultsFor = Some quiz.Id then + resultsPanel model + ] + ] + ] + ] + ] + ] diff --git a/src/Client/Features/Quizzes/TakeQuiz/Api.fs b/src/Client/Features/Quizzes/TakeQuiz/Api.fs new file mode 100644 index 0000000..040ab00 --- /dev/null +++ b/src/Client/Features/Quizzes/TakeQuiz/Api.fs @@ -0,0 +1,47 @@ +module Client.Features.Quizzes.TakeQuiz.Api + +open Fable.Core.JsInterop +open Domain +open Domain.Contracts +open Client.Shared.JsonWire + +let private encResponse (response: StudentResponse) : obj = + match response with + | SingleChoiceResponse opt -> createObj [ "SingleChoiceResponse" ==> optToJs encOptionId opt ] + | MultipleChoiceResponse opts -> createObj [ "MultipleChoiceResponse" ==> (opts |> Set.toArray |> Array.map encOptionId) ] + | TrueFalseResponse opt -> createObj [ "TrueFalseResponse" ==> optToJs box opt ] + | ShortAnswerResponse text -> createObj [ "ShortAnswerResponse" ==> box text ] + | NumericResponse opt -> createObj [ "NumericResponse" ==> optToJs box opt ] + +let private decodeAttemptResult (raw: obj) : AttemptResult = + { AttemptId = decAttemptId raw?AttemptId + Score = raw?Score + MaxScore = raw?MaxScore + Passed = raw?Passed |> optDec unbox } + +let submitAnswer (token: string option) (req: SubmitAnswerRequest) : Async> = + async { + let body = + createObj [ + "AttemptId" ==> encAttemptId req.AttemptId + "QuestionId" ==> encQuestionId req.QuestionId + "Response" ==> encResponse req.Response + ] + + let! raw = callApi token "POST" "/api/attempts/answer" (Some body) + return decodeResult (fun _ -> ()) raw + } + +let finishAttempt (token: string option) (attemptId: AttemptId) : Async> = + async { + let body = createObj [ "AttemptId" ==> encAttemptId attemptId ] + let! raw = callApi token "POST" "/api/attempts/finish" (Some body) + return decodeResult decodeAttemptResult raw + } + +let reportFocusLoss (token: string option) (attemptId: AttemptId) : Async> = + async { + let body = createObj [ "AttemptId" ==> encAttemptId attemptId ] + let! raw = callApi token "POST" "/api/attempts/focus-loss" (Some body) + return decodeResult (fun _ -> ()) raw + } diff --git a/src/Client/Features/Quizzes/TakeQuiz/State.fs b/src/Client/Features/Quizzes/TakeQuiz/State.fs new file mode 100644 index 0000000..1f329c2 --- /dev/null +++ b/src/Client/Features/Quizzes/TakeQuiz/State.fs @@ -0,0 +1,111 @@ +module Client.Features.Quizzes.TakeQuiz.State + +open System +open Elmish +open Fable.Core +open Browser.Dom +open Domain.Contracts +open Client.Features.Quizzes.TakeQuiz.Types + +/// Ticks once a second for as long as the browser tab showing this page is +/// open. Nothing ever cancels the underlying `setInterval` (there's no page +/// lifecycle hook to hang it off in this app's minimal Elmish wiring) — once +/// the student finishes and the parent switches away from this page, these +/// dispatches just stop matching any case in `App.State.update` and are +/// silently dropped, so the only cost is a harmless once-a-second no-op. +let startTicking () : Cmd = Cmd.ofEffect (fun dispatch -> JS.setInterval (fun () -> dispatch Tick) 1000 |> ignore) + +/// Listens from the moment the attempt page mounts (matching DESIGN.md §3.6 — +/// a student who wanders off before answering anything still counts). +/// `blur`/`focus` catch switching to another window over the same tab; +/// `visibilitychange` catches switching tabs or minimizing. Both can fire for +/// the same departure, so `FocusLost`/`FocusRegained` in `update` de-dupe via +/// `AwayFromFocus` rather than reporting on every event. +let attachFocusTracking () : Cmd = + Cmd.ofEffect (fun dispatch -> + document.addEventListener ( + "visibilitychange", + fun _ -> dispatch (if document.hidden then FocusLost else FocusRegained) + ) + + window.addEventListener ("blur", fun _ -> dispatch FocusLost) + window.addEventListener ("focus", fun _ -> dispatch FocusRegained)) + +let rec update (token: string option) (msg: Msg) (model: Model) : Model * Cmd = + match msg with + | AnswerChanged(questionId, response) -> + let updated = { model with Answers = model.Answers |> Map.add questionId response } + + let request: SubmitAnswerRequest = + { AttemptId = model.Data.AttemptId + QuestionId = questionId + Response = response } + + let cmd = + Cmd.OfAsync.either + (Api.submitAnswer token) + request + (function + | Ok() -> AnswerSaved questionId + | Error err -> AnswerSaveFailed(questionId, err)) + (fun ex -> AnswerSaveFailed(questionId, ex.Message)) + + updated, cmd + | AnswerSaved _ -> { model with Error = None }, Cmd.none + | AnswerSaveFailed(_, err) -> { model with Error = Some err }, Cmd.none + | Tick -> + let updated = { model with RemainingSeconds = remainingSeconds model.Data DateTimeOffset.UtcNow } + // The server is the actual authority (it now rejects any answer + // submitted past the deadline — see `SubmitAnswer.fs`); this just + // saves the student a click once their own countdown reaches zero, + // instead of leaving them stuck looking at a page that silently + // stopped accepting changes. + if updated.RemainingSeconds = Some 0 && not updated.IsFinishing then + update token Finish updated + // Backstop for `FocusLost`/`FocusRegained` below: `blur` and + // `visibilitychange` are supposed to fire on every departure, but in + // practice they can be unreliable — e.g. switching windows inside a + // remote-desktop session doesn't always deliver them to the page. + // `document.hasFocus()` is a direct, synchronous ground-truth check + // that doesn't depend on any event actually being dispatched, so + // piggybacking it onto the once-a-second tick catches a departure + // within ~1s even when the events themselves go missing. + elif not (document.hasFocus ()) && not updated.AwayFromFocus then + update token FocusLost updated + elif document.hasFocus () && updated.AwayFromFocus then + update token FocusRegained updated + else + updated, Cmd.none + | FocusLost -> + if model.AwayFromFocus then + model, Cmd.none + else + // Best-effort: whether this ping succeeds or fails, the student + // shouldn't see an error banner over something that isn't their + // action — the teacher-facing count is server-side and this is + // just one report of it. + let cmd = + Cmd.OfAsync.either + (Api.reportFocusLoss token) + model.Data.AttemptId + (fun _ -> FocusLossReported) + (fun _ -> FocusLossReported) + + { model with AwayFromFocus = true }, cmd + | FocusRegained -> { model with AwayFromFocus = false }, Cmd.none + | FocusLossReported -> model, Cmd.none + | Finish -> + let updated = { model with IsFinishing = true } + + let cmd = + Cmd.OfAsync.either + (Api.finishAttempt token) + model.Data.AttemptId + (function + | Ok result -> Finished result + | Error err -> FinishFailed err) + (fun ex -> FinishFailed ex.Message) + + updated, cmd + | Finished _ -> model, Cmd.none // handled by the parent, which switches pages + | FinishFailed err -> { model with Error = Some err; IsFinishing = false }, Cmd.none diff --git a/src/Client/Features/Quizzes/TakeQuiz/Types.fs b/src/Client/Features/Quizzes/TakeQuiz/Types.fs new file mode 100644 index 0000000..55b4e74 --- /dev/null +++ b/src/Client/Features/Quizzes/TakeQuiz/Types.fs @@ -0,0 +1,48 @@ +module Client.Features.Quizzes.TakeQuiz.Types + +open System +open Domain +open Domain.Contracts + +/// Seconds left until `data.Quiz.TimeLimitMinutes` runs out, as of `now` — +/// `None` when the quiz has no time limit at all. The server is the actual +/// authority on the deadline (`SubmitAnswer.fs` rejects late answers, the +/// background sweeper grades abandoned attempts) — this is purely a display +/// convenience so the student doesn't need to guess. +let remainingSeconds (data: QuizForAttempt) (now: DateTimeOffset) : int option = + data.Quiz.TimeLimitMinutes + |> Option.map (fun minutes -> + let deadline = data.StartedAt.AddMinutes(float minutes) + max 0 (int (ceil (deadline - now).TotalSeconds))) + +type Model = + { Data: QuizForAttempt + Answers: Map + Error: string option + IsFinishing: bool + RemainingSeconds: int option + /// True for as long as the tab has been away (hidden or unfocused) + /// since the last time it came back — guards against counting the same + /// departure twice from `blur` and `visibilitychange` both firing, and + /// against re-reporting every tick while the student is still away. + AwayFromFocus: bool } + +let init (data: QuizForAttempt) : Model = + { Data = data + Answers = Map.empty + Error = None + IsFinishing = false + RemainingSeconds = remainingSeconds data DateTimeOffset.UtcNow + AwayFromFocus = false } + +type Msg = + | AnswerChanged of QuestionId * StudentResponse + | AnswerSaved of QuestionId + | AnswerSaveFailed of QuestionId * string + | Tick + | FocusLost + | FocusRegained + | FocusLossReported + | Finish + | Finished of AttemptResult + | FinishFailed of string diff --git a/src/Client/Features/Quizzes/TakeQuiz/View.fs b/src/Client/Features/Quizzes/TakeQuiz/View.fs new file mode 100644 index 0000000..2e9d083 --- /dev/null +++ b/src/Client/Features/Quizzes/TakeQuiz/View.fs @@ -0,0 +1,159 @@ +module Client.Features.Quizzes.TakeQuiz.View + +open Feliz +open Domain +open Domain.Contracts +open Client.Features.Quizzes.TakeQuiz.Types + +let private questionView (answers: Map) dispatch (index: int) (question: QuestionView) = + let groupName = string question.Id + + let body = + match question.Kind with + | SingleChoiceView options -> + let selected = + match answers.TryFind question.Id with + | Some(SingleChoiceResponse opt) -> opt + | _ -> None + + Html.div [ + for optionId, text in options -> + let isSelected = selected = Some optionId + + Html.label [ + prop.className "option" + prop.children [ + Html.input [ + prop.type'.radio + prop.name groupName + prop.isChecked isSelected + prop.onChange (fun (_: bool) -> + dispatch (AnswerChanged(question.Id, SingleChoiceResponse(Some optionId)))) + ] + Html.text text + ] + ] + ] + | MultipleChoiceView options -> + let selected = + match answers.TryFind question.Id with + | Some(MultipleChoiceResponse opts) -> opts + | _ -> Set.empty + + Html.div [ + for optionId, text in options -> + Html.label [ + prop.className "option" + prop.children [ + Html.input [ + prop.type'.checkbox + prop.isChecked (selected.Contains optionId) + prop.onChange (fun (checked': bool) -> + let next = + if checked' then selected.Add optionId else selected.Remove optionId + + dispatch (AnswerChanged(question.Id, MultipleChoiceResponse next))) + ] + Html.text text + ] + ] + ] + | TrueFalseView -> + let selected = + match answers.TryFind question.Id with + | Some(TrueFalseResponse v) -> v + | _ -> None + + Html.div [ + for value, text in [ true, "Верно"; false, "Неверно" ] -> + let isSelected = selected = Some value + + Html.label [ + prop.className "option" + prop.children [ + Html.input [ + prop.type'.radio + prop.name groupName + prop.isChecked isSelected + prop.onChange (fun (_: bool) -> + dispatch (AnswerChanged(question.Id, TrueFalseResponse(Some value)))) + ] + Html.text text + ] + ] + ] + | ShortAnswerView -> + let text = + match answers.TryFind question.Id with + | Some(ShortAnswerResponse t) -> t + | _ -> "" + + Html.input [ + prop.type'.text + prop.value text + prop.onChange (fun (v: string) -> dispatch (AnswerChanged(question.Id, ShortAnswerResponse v))) + ] + | NumericView -> + let text = + match answers.TryFind question.Id with + | Some(NumericResponse(Some v)) -> string v + | _ -> "" + + Html.input [ + prop.type'.number + prop.value text + prop.onChange (fun (v: string) -> + let parsed = + match System.Double.TryParse v with + | true, n -> Some n + | false, _ -> None + + dispatch (AnswerChanged(question.Id, NumericResponse parsed))) + ] + + Html.div [ + prop.key (string question.Id) + prop.className "question" + prop.children [ + Html.span [ prop.className "question-number"; prop.text (sprintf "№ %02d" (index + 1)) ] + Html.div [ + prop.className "question-body" + prop.children [ Html.p [ prop.className "question-text"; prop.text question.Text ]; body ] + ] + ] + ] + +let private timeRemainingBadge (seconds: int) = + Html.span [ + prop.className (if seconds <= 60 then "time-remaining low" else "time-remaining") + prop.text (sprintf "Осталось времени: %02d:%02d" (seconds / 60) (seconds % 60)) + ] + +let view (model: Model) (dispatch: Msg -> unit) = + Html.div [ + prop.className "taking-quiz-page" + prop.children [ + Html.h2 model.Data.Quiz.Title + match model.Error with + | Some err -> Html.p [ prop.className "error"; prop.text err ] + | None -> Html.none + Html.div [ + prop.children (model.Data.Questions |> List.mapi (questionView model.Answers dispatch)) + ] + Html.div [ + prop.className "quiz-actions" + prop.children [ + match model.RemainingSeconds with + | Some seconds when seconds = 0 -> + Html.span [ prop.className "time-remaining low"; prop.text "Время вышло" ] + | Some seconds -> timeRemainingBadge seconds + | None -> Html.none + Html.button [ + prop.disabled model.IsFinishing + prop.onClick (fun _ -> dispatch Finish) + prop.text (if model.IsFinishing then "Завершение…" else "Завершить тест") + ] + ] + ] + ] + ] diff --git a/src/Client/Features/Quizzes/ViewResult/View.fs b/src/Client/Features/Quizzes/ViewResult/View.fs new file mode 100644 index 0000000..534fa75 --- /dev/null +++ b/src/Client/Features/Quizzes/ViewResult/View.fs @@ -0,0 +1,24 @@ +module Client.Features.Quizzes.ViewResult.View + +open Feliz +open Domain.Contracts +open Client.Shared + +/// Small enough that it doesn't need its own Types/State — it only ever +/// dispatches the parent's "go back to the quiz list" message. +let view (result: AttemptResult) (onBackToQuizList: unit -> unit) = + Html.div [ + prop.className "result-page" + prop.children [ + Html.h2 "Результат" + match result.Passed with + | Some true -> Html.div [ prop.className "grade-stamp passed"; prop.text "Тест пройден" ] + | Some false -> Html.div [ prop.className "grade-stamp failed"; prop.text "Тест не пройден" ] + | None -> Html.none + Html.span [ + prop.className "score-value" + prop.text (sprintf "%s / %s" (Format.points result.Score) (Format.points result.MaxScore)) + ] + Html.button [ prop.onClick (fun _ -> onBackToQuizList ()); prop.text "К списку тестов" ] + ] + ] diff --git a/src/Client/Features/Teacher/Home/State.fs b/src/Client/Features/Teacher/Home/State.fs new file mode 100644 index 0000000..8251833 --- /dev/null +++ b/src/Client/Features/Teacher/Home/State.fs @@ -0,0 +1,50 @@ +module Client.Features.Teacher.Home.State + +open Elmish +open Domain +open Client.Features +open Client.Features.Teacher.Home.Types + +/// `role` decides whether the Admin-only "Пользователи" tab is shown/loaded — +/// Teacher and Admin otherwise share this exact same page (see DESIGN.md §2: +/// Admin = Teacher + user management). +let init (role: Role) : Model * Cmd = + let questionsModel, questionsCmd = Teacher.Questions.State.init () + let testsModel, testsCmd = Teacher.Tests.State.init () + + let usersCmd = + match role with + | Admin -> Cmd.map UsersMsg (Cmd.ofMsg Admin.Users.Types.LoadUsers) + | Teacher + | Student -> Cmd.none + + { Tab = QuestionsTab + Role = role + Questions = questionsModel + Tests = testsModel + Users = Admin.Users.Types.empty }, + Cmd.batch [ Cmd.map QuestionsMsg questionsCmd; Cmd.map TestsMsg testsCmd; usersCmd ] + +let update (token: string option) (msg: Msg) (model: Model) : Model * Cmd = + match msg with + | SwitchTab tab -> { model with Tab = tab }, Cmd.none + | QuestionsMsg(Teacher.Questions.Types.TopicCreated topic as subMsg) -> + let m, cmd = Teacher.Questions.State.update token subMsg model.Questions + + { model with + Questions = m + // Questions and Tests keep independent `Topics` lists (own VSA + // slices, own `LoadTopics` on init) — a topic created in one + // must be mirrored into the other, or the quiz question-picker + // never sees topics added after the page first loaded. + Tests = { model.Tests with Topics = model.Tests.Topics @ [ topic ] } }, + Cmd.map QuestionsMsg cmd + | QuestionsMsg subMsg -> + let m, cmd = Teacher.Questions.State.update token subMsg model.Questions + { model with Questions = m }, Cmd.map QuestionsMsg cmd + | TestsMsg subMsg -> + let m, cmd = Teacher.Tests.State.update token subMsg model.Tests + { model with Tests = m }, Cmd.map TestsMsg cmd + | UsersMsg subMsg -> + let m, cmd = Admin.Users.State.update token subMsg model.Users + { model with Users = m }, Cmd.map UsersMsg cmd diff --git a/src/Client/Features/Teacher/Home/Types.fs b/src/Client/Features/Teacher/Home/Types.fs new file mode 100644 index 0000000..592909e --- /dev/null +++ b/src/Client/Features/Teacher/Home/Types.fs @@ -0,0 +1,22 @@ +module Client.Features.Teacher.Home.Types + +open Domain +open Client.Features + +type Tab = + | QuestionsTab + | TestsTab + | UsersTab + +type Model = + { Tab: Tab + Role: Role + Questions: Teacher.Questions.Types.Model + Tests: Teacher.Tests.Types.Model + Users: Admin.Users.Types.Model } + +type Msg = + | SwitchTab of Tab + | QuestionsMsg of Teacher.Questions.Types.Msg + | TestsMsg of Teacher.Tests.Types.Msg + | UsersMsg of Admin.Users.Types.Msg diff --git a/src/Client/Features/Teacher/Home/View.fs b/src/Client/Features/Teacher/Home/View.fs new file mode 100644 index 0000000..e3c8754 --- /dev/null +++ b/src/Client/Features/Teacher/Home/View.fs @@ -0,0 +1,33 @@ +module Client.Features.Teacher.Home.View + +open Feliz +open Domain +open Client.Features +open Client.Features.Teacher.Home.Types + +let private tabButton (current: Tab) (tab: Tab) (label: string) dispatch = + Html.button [ + prop.className (if current = tab then "tab-button active" else "tab-button") + prop.onClick (fun _ -> dispatch (SwitchTab tab)) + prop.text label + ] + +let view (model: Model) (dispatch: Msg -> unit) = + Html.div [ + prop.className "teacher-home" + prop.children [ + Html.div [ + prop.className "tabs" + prop.children [ + tabButton model.Tab QuestionsTab "Вопросы" dispatch + tabButton model.Tab TestsTab "Тесты" dispatch + if model.Role = Admin then + tabButton model.Tab UsersTab "Пользователи" dispatch + ] + ] + match model.Tab with + | QuestionsTab -> Teacher.Questions.View.view model.Questions (QuestionsMsg >> dispatch) + | TestsTab -> Teacher.Tests.View.view model.Tests (TestsMsg >> dispatch) + | UsersTab -> Admin.Users.View.view model.Users (UsersMsg >> dispatch) + ] + ] diff --git a/src/Client/Features/Teacher/Questions/Api.fs b/src/Client/Features/Teacher/Questions/Api.fs new file mode 100644 index 0000000..5d1a16e --- /dev/null +++ b/src/Client/Features/Teacher/Questions/Api.fs @@ -0,0 +1,136 @@ +module Client.Features.Teacher.Questions.Api + +open Fable.Core.JsInterop +open Domain +open Domain.Contracts +open Client.Shared.JsonWire + +let private decodeTopic (raw: obj) : Topic = + { Id = decTopicId raw?Id + OwnerId = decUserId raw?OwnerId + Name = raw?Name } + +let private encQuestionOption (o: QuestionOption) : obj = + createObj [ "Id" ==> encOptionId o.Id; "Text" ==> box o.Text ] + +let private decQuestionOption (raw: obj) : QuestionOption = + { Id = decOptionId raw?Id; Text = raw?Text } + +let private encQuestionTypeView (t: QuestionTypeView) : obj = + match t with + | SingleChoiceT d -> + createObj [ + "SingleChoiceT" + ==> createObj [ + "Options" ==> (d.Options |> List.map encQuestionOption |> List.toArray) + "CorrectOptionId" ==> encOptionId d.CorrectOptionId + ] + ] + | MultipleChoiceT d -> + createObj [ + "MultipleChoiceT" + ==> createObj [ + "Options" ==> (d.Options |> List.map encQuestionOption |> List.toArray) + "CorrectOptionIds" ==> (d.CorrectOptionIds |> List.map encOptionId |> List.toArray) + ] + ] + | TrueFalseT b -> createObj [ "TrueFalseT" ==> box b ] + | ShortAnswerT d -> + createObj [ + "ShortAnswerT" + ==> createObj [ + "AcceptedAnswers" ==> (d.AcceptedAnswers |> List.toArray) + "CaseSensitive" ==> box d.CaseSensitive + ] + ] + | NumericT d -> + createObj [ "NumericT" ==> createObj [ "CorrectValue" ==> box d.CorrectValue; "Tolerance" ==> box d.Tolerance ] ] + +let private decodeQuestionTypeView (raw: obj) : QuestionTypeView = + if not (isNullOrUndefined raw?SingleChoiceT) then + let d = raw?SingleChoiceT + + SingleChoiceT + { Options = (unbox d?Options) |> Array.toList |> List.map decQuestionOption + CorrectOptionId = decOptionId d?CorrectOptionId } + elif not (isNullOrUndefined raw?MultipleChoiceT) then + let d = raw?MultipleChoiceT + + MultipleChoiceT + { Options = (unbox d?Options) |> Array.toList |> List.map decQuestionOption + CorrectOptionIds = (unbox d?CorrectOptionIds) |> Array.toList |> List.map decOptionId } + elif not (isNullOrUndefined raw?TrueFalseT) then + TrueFalseT(unbox raw?TrueFalseT) + elif not (isNullOrUndefined raw?ShortAnswerT) then + let d = raw?ShortAnswerT + + ShortAnswerT + { AcceptedAnswers = (unbox d?AcceptedAnswers) |> Array.toList |> List.map unbox + CaseSensitive = unbox d?CaseSensitive } + elif not (isNullOrUndefined raw?NumericT) then + let d = raw?NumericT + NumericT { CorrectValue = d?CorrectValue; Tolerance = d?Tolerance } + else + failwith "Неизвестный тип вопроса" + +let private decodeQuestionSummary (raw: obj) : QuestionSummary = + { Id = decQuestionId raw?Id + TopicId = decTopicId raw?TopicId + Text = raw?Text + Points = raw?Points + Type = decodeQuestionTypeView raw?Type } + +let listTopics (token: string option) : Async> = + async { + let! raw = callApi token "GET" "/api/teacher/topics" None + return decodeResult (fun r -> (unbox r) |> Array.toList |> List.map decodeTopic) raw + } + +let createTopic (token: string option) (name: string) : Async> = + async { + let body = createObj [ "Name" ==> box name ] + let! raw = callApi token "POST" "/api/teacher/topics" (Some body) + return decodeResult decodeTopic raw + } + +let listQuestions (token: string option) (topicId: TopicId) : Async> = + async { + let body = createObj [ "TopicId" ==> encTopicId topicId ] + let! raw = callApi token "POST" "/api/teacher/questions/list" (Some body) + return decodeResult (fun r -> (unbox r) |> Array.toList |> List.map decodeQuestionSummary) raw + } + +let createQuestion (token: string option) (req: CreateQuestionRequest) : Async> = + async { + let body = + createObj [ + "TopicId" ==> encTopicId req.TopicId + "Text" ==> box req.Text + "Points" ==> box req.Points + "Type" ==> encQuestionTypeView req.Type + ] + + let! raw = callApi token "POST" "/api/teacher/questions" (Some body) + return decodeResult decodeQuestionSummary raw + } + +let updateQuestion (token: string option) (req: UpdateQuestionRequest) : Async> = + async { + let body = + createObj [ + "QuestionId" ==> encQuestionId req.QuestionId + "Text" ==> box req.Text + "Points" ==> box req.Points + "Type" ==> encQuestionTypeView req.Type + ] + + let! raw = callApi token "POST" "/api/teacher/questions/update" (Some body) + return decodeResult decodeQuestionSummary raw + } + +let deleteQuestion (token: string option) (questionId: QuestionId) : Async> = + async { + let body = createObj [ "QuestionId" ==> encQuestionId questionId ] + let! raw = callApi token "POST" "/api/teacher/questions/delete" (Some body) + return decodeResult (fun _ -> ()) raw + } diff --git a/src/Client/Features/Teacher/Questions/State.fs b/src/Client/Features/Teacher/Questions/State.fs new file mode 100644 index 0000000..20ad50d --- /dev/null +++ b/src/Client/Features/Teacher/Questions/State.fs @@ -0,0 +1,265 @@ +module Client.Features.Teacher.Questions.State + +open Elmish +open Domain +open Domain.Contracts +open Client.Features.Teacher.Questions.Types + +let init () : Model * Cmd = empty, Cmd.ofMsg LoadTopics + +let private buildRequest (topicId: TopicId) (form: NewQuestionForm) : Result = + match System.Double.TryParse form.Points with + | false, _ -> Error "Баллы должны быть числом" + | true, points -> + let nonEmptyOptions () = + form.Options + |> List.filter (fun o -> not (System.String.IsNullOrWhiteSpace o.Text)) + |> List.map (fun o -> { Id = o.Id; Text = o.Text }: QuestionOption) + + match form.Kind with + | KSingleChoice -> + let options = nonEmptyOptions () + + match form.CorrectSingle with + | Some correctId when options |> List.exists (fun o -> o.Id = correctId) -> + Ok + { TopicId = topicId + Text = form.Text + Points = points + Type = SingleChoiceT { Options = options; CorrectOptionId = correctId } } + | _ -> Error "Выберите правильный вариант ответа" + | KMultipleChoice -> + let options = nonEmptyOptions () + + if form.CorrectMultiple.IsEmpty then + Error "Выберите хотя бы один правильный вариант" + else + Ok + { TopicId = topicId + Text = form.Text + Points = points + Type = MultipleChoiceT { Options = options; CorrectOptionIds = Set.toList form.CorrectMultiple } } + | KTrueFalse -> + Ok { TopicId = topicId; Text = form.Text; Points = points; Type = TrueFalseT form.CorrectBool } + | KShortAnswer -> + let accepted = + form.AcceptedAnswersText.Split(',') + |> Array.map (fun s -> s.Trim()) + |> Array.filter (fun s -> s <> "") + |> Array.toList + + if accepted.IsEmpty then + Error "Укажите хотя бы один допустимый ответ" + else + Ok + { TopicId = topicId + Text = form.Text + Points = points + Type = ShortAnswerT { AcceptedAnswers = accepted; CaseSensitive = form.CaseSensitive } } + | KNumeric -> + match System.Double.TryParse form.CorrectValueText, System.Double.TryParse form.ToleranceText with + | (true, value), (true, tolerance) -> + Ok + { TopicId = topicId + Text = form.Text + Points = points + Type = NumericT { CorrectValue = value; Tolerance = tolerance } } + | _ -> Error "Введите корректные числовые значения" + +let private loadQuestionsCmd (token: string option) (topicId: TopicId) = + Cmd.OfAsync.either + (Api.listQuestions token) + topicId + (function + | Ok questions -> QuestionsLoaded questions + | Error err -> QuestionsLoadFailed err) + (fun ex -> QuestionsLoadFailed ex.Message) + +let update (token: string option) (msg: Msg) (model: Model) : Model * Cmd = + match msg with + | LoadTopics -> + let cmd = + Cmd.OfAsync.either + Api.listTopics + token + (function + | Ok topics -> TopicsLoaded topics + | Error err -> TopicsLoadFailed err) + (fun ex -> TopicsLoadFailed ex.Message) + + { model with TopicsLoading = true; TopicsError = None }, cmd + | TopicsLoaded topics -> { model with Topics = topics; TopicsLoading = false }, Cmd.none + | TopicsLoadFailed err -> { model with TopicsLoading = false; TopicsError = Some err }, Cmd.none + | SetNewTopicName name -> { model with NewTopicForm = { model.NewTopicForm with Name = name } }, Cmd.none + | SubmitNewTopic -> + let form = { model.NewTopicForm with IsSubmitting = true; Error = None } + + let cmd = + Cmd.OfAsync.either + (Api.createTopic token) + form.Name + (function + | Ok topic -> TopicCreated topic + | Error err -> TopicCreateFailed err) + (fun ex -> TopicCreateFailed ex.Message) + + { model with NewTopicForm = form }, cmd + | TopicCreated topic -> + { model with + Topics = model.Topics @ [ topic ] + NewTopicForm = emptyNewTopicForm }, + Cmd.none + | TopicCreateFailed err -> + { model with + NewTopicForm = { model.NewTopicForm with IsSubmitting = false; Error = Some err } }, + Cmd.none + | SelectTopic topicId -> + { model with + SelectedTopicId = Some topicId + Questions = [] + QuestionsLoading = true + QuestionsError = None + NewQuestionForm = emptyNewQuestionForm + EditingQuestionId = None }, + loadQuestionsCmd token topicId + | QuestionsLoaded questions -> { model with Questions = questions; QuestionsLoading = false }, Cmd.none + | QuestionsLoadFailed err -> { model with QuestionsLoading = false; QuestionsError = Some err }, Cmd.none + | SetQuestionText text -> { model with NewQuestionForm = { model.NewQuestionForm with Text = text } }, Cmd.none + | SetQuestionPoints points -> + { model with NewQuestionForm = { model.NewQuestionForm with Points = points } }, Cmd.none + | SetQuestionKind kind -> { model with NewQuestionForm = { model.NewQuestionForm with Kind = kind } }, Cmd.none + | AddOption -> + let form = model.NewQuestionForm + + { model with NewQuestionForm = { form with Options = form.Options @ [ newOptionDraft () ] } }, Cmd.none + | RemoveOption optionId -> + let form = model.NewQuestionForm + + if form.Options.Length <= 2 then + model, Cmd.none + else + { model with + NewQuestionForm = + { form with + Options = form.Options |> List.filter (fun o -> o.Id <> optionId) + CorrectSingle = if form.CorrectSingle = Some optionId then None else form.CorrectSingle + CorrectMultiple = form.CorrectMultiple |> Set.remove optionId } }, + Cmd.none + | SetOptionText(optionId, text) -> + let form = model.NewQuestionForm + + { model with + NewQuestionForm = + { form with + Options = form.Options |> List.map (fun o -> if o.Id = optionId then { o with Text = text } else o) } }, + Cmd.none + | SetCorrectSingle optionId -> + { model with NewQuestionForm = { model.NewQuestionForm with CorrectSingle = Some optionId } }, Cmd.none + | ToggleCorrectMultiple optionId -> + let form = model.NewQuestionForm + + let next = + if form.CorrectMultiple.Contains optionId then + form.CorrectMultiple.Remove optionId + else + form.CorrectMultiple.Add optionId + + { model with NewQuestionForm = { form with CorrectMultiple = next } }, Cmd.none + | SetCorrectBool value -> { model with NewQuestionForm = { model.NewQuestionForm with CorrectBool = value } }, Cmd.none + | SetAcceptedAnswersText text -> + { model with NewQuestionForm = { model.NewQuestionForm with AcceptedAnswersText = text } }, Cmd.none + | SetCaseSensitive value -> + { model with NewQuestionForm = { model.NewQuestionForm with CaseSensitive = value } }, Cmd.none + | SetCorrectValueText text -> + { model with NewQuestionForm = { model.NewQuestionForm with CorrectValueText = text } }, Cmd.none + | SetToleranceText text -> + { model with NewQuestionForm = { model.NewQuestionForm with ToleranceText = text } }, Cmd.none + | SubmitNewQuestion when model.NewQuestionForm.IsSubmitting -> + // Guards against a double-click/double-Enter firing this message + // twice before React re-renders the disabled submit button — without + // this, two requests reuse the same client-generated `OptionId`s for + // what the server treats as two different questions, and the second + // insert collides with the first on `question_options`'s primary key. + model, Cmd.none + | SubmitNewQuestion -> + match model.SelectedTopicId with + | None -> model, Cmd.none + | Some topicId -> + match buildRequest topicId model.NewQuestionForm with + | Error err -> + { model with NewQuestionForm = { model.NewQuestionForm with Error = Some err } }, Cmd.none + | Ok req -> + let form = { model.NewQuestionForm with IsSubmitting = true; Error = None } + + let cmd = + match model.EditingQuestionId with + | None -> + Cmd.OfAsync.either + (Api.createQuestion token) + req + (function + | Ok summary -> QuestionCreated summary + | Error err -> QuestionCreateFailed err) + (fun ex -> QuestionCreateFailed ex.Message) + | Some questionId -> + let updateReq: UpdateQuestionRequest = + { QuestionId = questionId; Text = req.Text; Points = req.Points; Type = req.Type } + + Cmd.OfAsync.either + (Api.updateQuestion token) + updateReq + (function + | Ok summary -> QuestionUpdated summary + | Error err -> QuestionUpdateFailed err) + (fun ex -> QuestionUpdateFailed ex.Message) + + { model with NewQuestionForm = form }, cmd + | QuestionCreated summary -> + { model with + Questions = model.Questions @ [ summary ] + NewQuestionForm = emptyNewQuestionForm }, + Cmd.none + | QuestionCreateFailed err -> + { model with + NewQuestionForm = { model.NewQuestionForm with IsSubmitting = false; Error = Some err } }, + Cmd.none + | StartEditQuestion questionId -> + match model.Questions |> List.tryFind (fun q -> q.Id = questionId) with + | None -> model, Cmd.none + | Some summary -> + { model with + EditingQuestionId = Some questionId + NewQuestionForm = formFromSummary summary }, + Cmd.none + | CancelEditQuestion -> + { model with EditingQuestionId = None; NewQuestionForm = emptyNewQuestionForm }, Cmd.none + | QuestionUpdated summary -> + { model with + Questions = model.Questions |> List.map (fun q -> if q.Id = summary.Id then summary else q) + NewQuestionForm = emptyNewQuestionForm + EditingQuestionId = None }, + Cmd.none + | QuestionUpdateFailed err -> + { model with + NewQuestionForm = { model.NewQuestionForm with IsSubmitting = false; Error = Some err } }, + Cmd.none + | RequestDeleteQuestion questionId -> + let cmd = + Cmd.OfAsync.either + (Api.deleteQuestion token) + questionId + (function + | Ok() -> QuestionDeleted questionId + | Error err -> QuestionDeleteFailed err) + (fun ex -> QuestionDeleteFailed ex.Message) + + model, cmd + | QuestionDeleted questionId -> + let wasEditing = model.EditingQuestionId = Some questionId + + { model with + Questions = model.Questions |> List.filter (fun q -> q.Id <> questionId) + EditingQuestionId = if wasEditing then None else model.EditingQuestionId + NewQuestionForm = if wasEditing then emptyNewQuestionForm else model.NewQuestionForm }, + Cmd.none + | QuestionDeleteFailed err -> { model with QuestionsError = Some err }, Cmd.none diff --git a/src/Client/Features/Teacher/Questions/Types.fs b/src/Client/Features/Teacher/Questions/Types.fs new file mode 100644 index 0000000..24468e9 --- /dev/null +++ b/src/Client/Features/Teacher/Questions/Types.fs @@ -0,0 +1,147 @@ +module Client.Features.Teacher.Questions.Types + +open System +open Domain +open Domain.Contracts + +type NewTopicForm = + { Name: string + Error: string option + IsSubmitting: bool } + +let emptyNewTopicForm = { Name = ""; Error = None; IsSubmitting = false } + +/// A draft option row in the question-authoring form; `Id` is generated +/// client-side so radio/checkbox selection has something stable to key on +/// before the question is ever sent to the server. +type OptionDraft = { Id: OptionId; Text: string } + +let newOptionDraft () : OptionDraft = { Id = OptionId(Guid.NewGuid()); Text = "" } + +type QuestionKind = + | KSingleChoice + | KMultipleChoice + | KTrueFalse + | KShortAnswer + | KNumeric + +type NewQuestionForm = + { Text: string + Points: string + Kind: QuestionKind + Options: OptionDraft list // SingleChoice / MultipleChoice + CorrectSingle: OptionId option // SingleChoice + CorrectMultiple: Set // MultipleChoice + CorrectBool: bool // TrueFalse + AcceptedAnswersText: string // ShortAnswer, comma-separated + CaseSensitive: bool // ShortAnswer + CorrectValueText: string // Numeric + ToleranceText: string // Numeric + Error: string option + IsSubmitting: bool } + +let emptyNewQuestionForm = + { Text = "" + Points = "1" + Kind = KSingleChoice + Options = [ newOptionDraft (); newOptionDraft () ] + CorrectSingle = None + CorrectMultiple = Set.empty + CorrectBool = true + AcceptedAnswersText = "" + CaseSensitive = false + CorrectValueText = "" + ToleranceText = "0" + Error = None + IsSubmitting = false } + +type Model = + { Topics: Topic list + TopicsLoading: bool + TopicsError: string option + NewTopicForm: NewTopicForm + SelectedTopicId: TopicId option + Questions: QuestionSummary list + QuestionsLoading: bool + QuestionsError: string option + NewQuestionForm: NewQuestionForm + /// `None` = the form creates a new question; `Some id` = it edits + /// that existing question instead. + EditingQuestionId: QuestionId option } + +let empty = + { Topics = [] + TopicsLoading = false + TopicsError = None + NewTopicForm = emptyNewTopicForm + SelectedTopicId = None + Questions = [] + QuestionsLoading = false + QuestionsError = None + NewQuestionForm = emptyNewQuestionForm + EditingQuestionId = None } + +type Msg = + | LoadTopics + | TopicsLoaded of Topic list + | TopicsLoadFailed of string + | SetNewTopicName of string + | SubmitNewTopic + | TopicCreated of Topic + | TopicCreateFailed of string + | SelectTopic of TopicId + | QuestionsLoaded of QuestionSummary list + | QuestionsLoadFailed of string + | SetQuestionText of string + | SetQuestionPoints of string + | SetQuestionKind of QuestionKind + | AddOption + | RemoveOption of OptionId + | SetOptionText of OptionId * string + | SetCorrectSingle of OptionId + | ToggleCorrectMultiple of OptionId + | SetCorrectBool of bool + | SetAcceptedAnswersText of string + | SetCaseSensitive of bool + | SetCorrectValueText of string + | SetToleranceText of string + | SubmitNewQuestion + | QuestionCreated of QuestionSummary + | QuestionCreateFailed of string + | StartEditQuestion of QuestionId + | CancelEditQuestion + | QuestionUpdated of QuestionSummary + | QuestionUpdateFailed of string + | RequestDeleteQuestion of QuestionId + | QuestionDeleted of QuestionId + | QuestionDeleteFailed of string + +/// Reverse of `State.buildRequest` — rebuilds a form from an existing +/// question so "Изменить" can prefill it. Reuses the question's existing +/// `OptionId`s (doesn't regenerate them) so editing doesn't orphan any +/// student responses already recorded against those option ids. +let formFromSummary (q: QuestionSummary) : NewQuestionForm = + let baseForm = { emptyNewQuestionForm with Text = q.Text; Points = string q.Points } + + match q.Type with + | SingleChoiceT d -> + { baseForm with + Kind = KSingleChoice + Options = d.Options |> List.map (fun o -> { Id = o.Id; Text = o.Text }) + CorrectSingle = Some d.CorrectOptionId } + | MultipleChoiceT d -> + { baseForm with + Kind = KMultipleChoice + Options = d.Options |> List.map (fun o -> { Id = o.Id; Text = o.Text }) + CorrectMultiple = Set.ofList d.CorrectOptionIds } + | TrueFalseT b -> { baseForm with Kind = KTrueFalse; CorrectBool = b } + | ShortAnswerT d -> + { baseForm with + Kind = KShortAnswer + AcceptedAnswersText = String.concat ", " d.AcceptedAnswers + CaseSensitive = d.CaseSensitive } + | NumericT d -> + { baseForm with + Kind = KNumeric + CorrectValueText = string d.CorrectValue + ToleranceText = string d.Tolerance } diff --git a/src/Client/Features/Teacher/Questions/View.fs b/src/Client/Features/Teacher/Questions/View.fs new file mode 100644 index 0000000..49e4dac --- /dev/null +++ b/src/Client/Features/Teacher/Questions/View.fs @@ -0,0 +1,292 @@ +module Client.Features.Teacher.Questions.View + +open Feliz +open Domain +open Domain.Contracts +open Client.Shared +open Client.Features.Teacher.Questions.Types + +let private topicsView (model: Model) dispatch = + Html.div [ + prop.className "topics-panel" + prop.children [ + Html.h2 "Темы" + match model.TopicsError with + | Some err -> Html.p [ prop.className "error"; prop.text err ] + | None -> Html.none + if model.TopicsLoading then + Html.p "Загрузка…" + else + Html.ul [ + prop.children [ + for topic in model.Topics -> + Html.li [ + prop.key (string topic.Id) + prop.className ( + if model.SelectedTopicId = Some topic.Id then + "topic-item selected" + else + "topic-item" + ) + prop.onClick (fun _ -> dispatch (SelectTopic topic.Id)) + prop.text topic.Name + ] + ] + ] + Html.form [ + prop.onSubmit (fun e -> + e.preventDefault () + dispatch SubmitNewTopic) + prop.children [ + Html.input [ + prop.type'.text + prop.placeholder "Название новой темы" + prop.value model.NewTopicForm.Name + prop.onChange (SetNewTopicName >> dispatch) + ] + Html.button [ + prop.type'.submit + prop.disabled model.NewTopicForm.IsSubmitting + prop.text "Добавить тему" + ] + match model.NewTopicForm.Error with + | Some err -> Html.p [ prop.className "error"; prop.text err ] + | None -> Html.none + ] + ] + ] + ] + +let private kindLabel (t: QuestionTypeView) = + match t with + | SingleChoiceT _ -> "Один вариант" + | MultipleChoiceT _ -> "Несколько вариантов" + | TrueFalseT _ -> "Верно/неверно" + | ShortAnswerT _ -> "Короткий ответ" + | NumericT _ -> "Числовой" + +let private questionsListView (model: Model) dispatch = + Html.div [ + prop.className "questions-list" + prop.children [ + Html.h3 "Вопросы в теме" + match model.QuestionsError with + | Some err -> Html.p [ prop.className "error"; prop.text err ] + | None -> Html.none + if model.QuestionsLoading then + Html.p "Загрузка…" + elif model.Questions.IsEmpty then + Html.p "В этой теме пока нет вопросов" + else + Html.ul [ + prop.children [ + for q in model.Questions -> + Html.li [ + prop.key (string q.Id) + prop.children [ + Html.span [ prop.className "question-kind"; prop.text (kindLabel q.Type) ] + Html.text (sprintf " %s " q.Text) + Html.span [ + prop.className "tag-mono" + prop.text (sprintf "%s б." (Format.points q.Points)) + ] + Html.button [ + prop.type'.button + prop.onClick (fun _ -> dispatch (StartEditQuestion q.Id)) + prop.text "Изменить" + ] + Html.button [ + prop.type'.button + prop.onClick (fun _ -> dispatch (RequestDeleteQuestion q.Id)) + prop.text "Удалить" + ] + ] + ] + ] + ] + ] + ] + +let private optionsEditor (form: NewQuestionForm) dispatch (multi: bool) = + Html.div [ + prop.className "options-editor" + prop.children [ + for opt in form.Options do + Html.div [ + prop.key (string opt.Id) + prop.className "option-row" + prop.children [ + Html.input [ + prop.type'.radio + prop.name "correct-option" + prop.isChecked (not multi && form.CorrectSingle = Some opt.Id) + prop.style [ if multi then style.display.none ] + prop.onChange (fun (_: bool) -> dispatch (SetCorrectSingle opt.Id)) + ] + Html.input [ + prop.type'.checkbox + prop.isChecked (form.CorrectMultiple.Contains opt.Id) + prop.style [ if not multi then style.display.none ] + prop.onChange (fun (_: bool) -> dispatch (ToggleCorrectMultiple opt.Id)) + ] + Html.input [ + prop.type'.text + prop.placeholder "Текст варианта" + prop.value opt.Text + prop.onChange (fun v -> dispatch (SetOptionText(opt.Id, v))) + ] + Html.button [ + prop.type'.button + prop.disabled (form.Options.Length <= 2) + prop.onClick (fun _ -> dispatch (RemoveOption opt.Id)) + prop.text "Удалить" + ] + ] + ] + Html.button [ prop.type'.button; prop.onClick (fun _ -> dispatch AddOption); prop.text "Добавить вариант" ] + ] + ] + +let private newQuestionFormView (isEditing: bool) (form: NewQuestionForm) dispatch = + Html.form [ + prop.className "new-question-form" + prop.onSubmit (fun e -> + e.preventDefault () + dispatch SubmitNewQuestion) + prop.children [ + Html.h3 (if isEditing then "Редактирование вопроса" else "Новый вопрос") + Html.label [ prop.text "Текст вопроса" ] + Html.input [ + prop.type'.text + prop.value form.Text + prop.onChange (SetQuestionText >> dispatch) + ] + Html.label [ prop.text "Баллы" ] + Html.input [ + prop.type'.number + prop.value form.Points + prop.onChange (SetQuestionPoints >> dispatch) + ] + Html.label [ prop.text "Тип вопроса" ] + Html.select [ + prop.value ( + match form.Kind with + | KSingleChoice -> "single" + | KMultipleChoice -> "multiple" + | KTrueFalse -> "truefalse" + | KShortAnswer -> "short" + | KNumeric -> "numeric" + ) + prop.onChange (fun (v: string) -> + let kind = + match v with + | "single" -> KSingleChoice + | "multiple" -> KMultipleChoice + | "truefalse" -> KTrueFalse + | "short" -> KShortAnswer + | _ -> KNumeric + + dispatch (SetQuestionKind kind)) + prop.children [ + Html.option [ prop.value "single"; prop.text "Один вариант" ] + Html.option [ prop.value "multiple"; prop.text "Несколько вариантов" ] + Html.option [ prop.value "truefalse"; prop.text "Верно/неверно" ] + Html.option [ prop.value "short"; prop.text "Короткий ответ" ] + Html.option [ prop.value "numeric"; prop.text "Числовой" ] + ] + ] + + match form.Kind with + | KSingleChoice -> optionsEditor form dispatch false + | KMultipleChoice -> optionsEditor form dispatch true + | KTrueFalse -> + Html.div [ + for value, text in [ true, "Верно"; false, "Неверно" ] -> + Html.label [ + prop.children [ + Html.input [ + prop.type'.radio + prop.name "correct-bool" + prop.isChecked (form.CorrectBool = value) + prop.onChange (fun (_: bool) -> dispatch (SetCorrectBool value)) + ] + Html.text text + ] + ] + ] + | KShortAnswer -> + Html.div [ + Html.label [ prop.text "Допустимые ответы (через запятую)" ] + Html.input [ + prop.type'.text + prop.value form.AcceptedAnswersText + prop.onChange (SetAcceptedAnswersText >> dispatch) + ] + Html.label [ + prop.children [ + Html.input [ + prop.type'.checkbox + prop.isChecked form.CaseSensitive + prop.onChange (SetCaseSensitive >> dispatch) + ] + Html.text "Учитывать регистр" + ] + ] + ] + | KNumeric -> + Html.div [ + Html.label [ prop.text "Правильное значение" ] + Html.input [ + prop.type'.text + prop.value form.CorrectValueText + prop.onChange (SetCorrectValueText >> dispatch) + ] + Html.label [ prop.text "Допустимая погрешность" ] + Html.input [ + prop.type'.text + prop.value form.ToleranceText + prop.onChange (SetToleranceText >> dispatch) + ] + ] + + match form.Error with + | Some err -> Html.p [ prop.className "error"; prop.text err ] + | None -> Html.none + Html.button [ + prop.type'.submit + prop.disabled form.IsSubmitting + prop.text ( + if form.IsSubmitting then "Сохранение…" + elif isEditing then "Сохранить изменения" + else "Добавить вопрос" + ) + ] + if isEditing then + Html.button [ + prop.type'.button + prop.onClick (fun _ -> dispatch CancelEditQuestion) + prop.text "Отмена" + ] + ] + ] + +let view (model: Model) (dispatch: Msg -> unit) = + Html.div [ + prop.className "teacher-questions-page" + prop.children [ + Html.h1 "Банк вопросов" + Html.div [ + prop.className "teacher-layout" + prop.children [ + topicsView model dispatch + match model.SelectedTopicId with + | None -> Html.p "Выберите или создайте тему слева" + | Some _ -> + Html.div [ + questionsListView model dispatch + newQuestionFormView model.EditingQuestionId.IsSome model.NewQuestionForm dispatch + ] + ] + ] + ] + ] diff --git a/src/Client/Features/Teacher/Tests/Api.fs b/src/Client/Features/Teacher/Tests/Api.fs new file mode 100644 index 0000000..fe1d5f9 --- /dev/null +++ b/src/Client/Features/Teacher/Tests/Api.fs @@ -0,0 +1,205 @@ +module Client.Features.Teacher.Tests.Api + +open Fable.Core.JsInterop +open Domain +open Domain.Contracts +open Client.Shared.JsonWire + +let private encQuizSource (source: QuizQuestionSourceInput) : obj = + match source with + | FixedQuestionInput qid -> createObj [ "FixedQuestionInput" ==> encQuestionId qid ] + | RandomPoolInput rule -> + createObj [ + "RandomPoolInput" ==> createObj [ "TopicId" ==> encTopicId rule.TopicId; "Count" ==> box rule.Count ] + ] + +let private decQuizSource (raw: obj) : QuizQuestionSourceInput = + if not (isNullOrUndefined raw?FixedQuestionInput) then + FixedQuestionInput(decQuestionId raw?FixedQuestionInput) + elif not (isNullOrUndefined raw?RandomPoolInput) then + let d = raw?RandomPoolInput + RandomPoolInput { TopicId = decTopicId d?TopicId; Count = unbox d?Count } + else + failwith "Неизвестный источник вопросов теста" + +let private decodeQuizAdminSummary (raw: obj) : QuizAdminSummary = + { Id = decQuizId raw?Id + Title = raw?Title + Description = raw?Description + TimeLimitMinutes = raw?TimeLimitMinutes |> optDec unbox + MaxAttempts = raw?MaxAttempts |> optDec unbox + PassingScore = raw?PassingScore |> optDec unbox + ShuffleQuestions = raw?ShuffleQuestions + ShuffleAnswers = raw?ShuffleAnswers + Sources = (unbox raw?Sources) |> Array.toList |> List.map decQuizSource + AssignedStudentIds = (unbox raw?AssignedStudentIds) |> Array.toList |> List.map decUserId } + +let private decodeStudentSummary (raw: obj) : StudentSummary = + { Id = decUserId raw?Id; Name = raw?Name; Email = raw?Email } + +let private decodeStudentQuizResult (raw: obj) : StudentQuizResult = + { StudentId = decUserId raw?StudentId + StudentName = raw?StudentName + StudentEmail = raw?StudentEmail + AttemptsCount = raw?AttemptsCount + BestScore = raw?BestScore |> optDec unbox + MaxScore = raw?MaxScore |> optDec unbox + Passed = raw?Passed |> optDec unbox + LastSuccessfulAttemptAt = raw?LastSuccessfulAttemptAt |> optDec (fun v -> System.DateTimeOffset.Parse(unbox v)) + LastAttemptFocusLossCount = raw?LastAttemptFocusLossCount } + +let private decodeTopic (raw: obj) : Topic = + { Id = decTopicId raw?Id + OwnerId = decUserId raw?OwnerId + Name = raw?Name } + +let private encQuestionOption (o: QuestionOption) : obj = + createObj [ "Id" ==> encOptionId o.Id; "Text" ==> box o.Text ] + +let private decQuestionOption (raw: obj) : QuestionOption = + { Id = decOptionId raw?Id; Text = raw?Text } + +let private decodeQuestionTypeView (raw: obj) : QuestionTypeView = + if not (isNullOrUndefined raw?SingleChoiceT) then + let d = raw?SingleChoiceT + + SingleChoiceT + { Options = (unbox d?Options) |> Array.toList |> List.map decQuestionOption + CorrectOptionId = decOptionId d?CorrectOptionId } + elif not (isNullOrUndefined raw?MultipleChoiceT) then + let d = raw?MultipleChoiceT + + MultipleChoiceT + { Options = (unbox d?Options) |> Array.toList |> List.map decQuestionOption + CorrectOptionIds = (unbox d?CorrectOptionIds) |> Array.toList |> List.map decOptionId } + elif not (isNullOrUndefined raw?TrueFalseT) then + TrueFalseT(unbox raw?TrueFalseT) + elif not (isNullOrUndefined raw?ShortAnswerT) then + let d = raw?ShortAnswerT + + ShortAnswerT + { AcceptedAnswers = (unbox d?AcceptedAnswers) |> Array.toList |> List.map unbox + CaseSensitive = unbox d?CaseSensitive } + elif not (isNullOrUndefined raw?NumericT) then + let d = raw?NumericT + NumericT { CorrectValue = d?CorrectValue; Tolerance = d?Tolerance } + else + failwith "Неизвестный тип вопроса" + +let private decodeQuestionSummary (raw: obj) : QuestionSummary = + { Id = decQuestionId raw?Id + TopicId = decTopicId raw?TopicId + Text = raw?Text + Points = raw?Points + Type = decodeQuestionTypeView raw?Type } + +let listMyQuizzes (token: string option) : Async> = + async { + let! raw = callApi token "GET" "/api/teacher/quizzes" None + return decodeResult (fun r -> (unbox r) |> Array.toList |> List.map decodeQuizAdminSummary) raw + } + +let listStudents (token: string option) : Async> = + async { + let! raw = callApi token "GET" "/api/teacher/students" None + return decodeResult (fun r -> (unbox r) |> Array.toList |> List.map decodeStudentSummary) raw + } + +let assignStudents (token: string option) (req: AssignStudentsRequest) : Async> = + async { + let body = + createObj [ + "QuizId" ==> encQuizId req.QuizId + "StudentIds" ==> (req.StudentIds |> List.map encUserId |> List.toArray) + ] + + let! raw = callApi token "POST" "/api/teacher/quizzes/assign" (Some body) + return decodeResult decodeQuizAdminSummary raw + } + +/// Same route as `Teacher/Questions/Api.fs.listTopics` — small, deliberate +/// duplication between independent VSA slices instead of a shared module. +let listTopics (token: string option) : Async> = + async { + let! raw = callApi token "GET" "/api/teacher/topics" None + return decodeResult (fun r -> (unbox r) |> Array.toList |> List.map decodeTopic) raw + } + +let listQuestionsInTopic (token: string option) (topicId: TopicId) : Async> = + async { + let body = createObj [ "TopicId" ==> encTopicId topicId ] + let! raw = callApi token "POST" "/api/teacher/questions/list" (Some body) + return decodeResult (fun r -> (unbox r) |> Array.toList |> List.map decodeQuestionSummary) raw + } + +let private encQuizFields + (title: string) + (description: string) + (timeLimitMinutes: int option) + (maxAttempts: int option) + (passingScore: float option) + (shuffleQuestions: bool) + (shuffleAnswers: bool) + (sources: QuizQuestionSourceInput list) + : (string * obj) list = + [ "Title" ==> box title + "Description" ==> box description + "TimeLimitMinutes" ==> optToJs box timeLimitMinutes + "MaxAttempts" ==> optToJs box maxAttempts + "PassingScore" ==> optToJs box passingScore + "ShuffleQuestions" ==> box shuffleQuestions + "ShuffleAnswers" ==> box shuffleAnswers + "Sources" ==> (sources |> List.map encQuizSource |> List.toArray) ] + +let createQuiz (token: string option) (req: CreateQuizRequest) : Async> = + async { + let body = + createObj ( + encQuizFields + req.Title + req.Description + req.TimeLimitMinutes + req.MaxAttempts + req.PassingScore + req.ShuffleQuestions + req.ShuffleAnswers + req.Sources + ) + + let! raw = callApi token "POST" "/api/teacher/quizzes/create" (Some body) + return decodeResult decodeQuizAdminSummary raw + } + +let updateQuiz (token: string option) (req: UpdateQuizRequest) : Async> = + async { + let body = + createObj ( + ("QuizId" ==> encQuizId req.QuizId) + :: encQuizFields + req.Title + req.Description + req.TimeLimitMinutes + req.MaxAttempts + req.PassingScore + req.ShuffleQuestions + req.ShuffleAnswers + req.Sources + ) + + let! raw = callApi token "POST" "/api/teacher/quizzes/update" (Some body) + return decodeResult decodeQuizAdminSummary raw + } + +let deleteQuiz (token: string option) (quizId: QuizId) : Async> = + async { + let body = createObj [ "QuizId" ==> encQuizId quizId ] + let! raw = callApi token "POST" "/api/teacher/quizzes/delete" (Some body) + return decodeResult (fun _ -> ()) raw + } + +let getQuizResults (token: string option) (quizId: QuizId) : Async> = + async { + let body = createObj [ "QuizId" ==> encQuizId quizId ] + let! raw = callApi token "POST" "/api/teacher/quizzes/results" (Some body) + return decodeResult (fun r -> (unbox r) |> Array.toList |> List.map decodeStudentQuizResult) raw + } diff --git a/src/Client/Features/Teacher/Tests/State.fs b/src/Client/Features/Teacher/Tests/State.fs new file mode 100644 index 0000000..81d69f0 --- /dev/null +++ b/src/Client/Features/Teacher/Tests/State.fs @@ -0,0 +1,368 @@ +module Client.Features.Teacher.Tests.State + +open Elmish +open Domain.Contracts +open Client.Features.Teacher.Tests.Types + +let init () : Model * Cmd = + empty, Cmd.batch [ Cmd.ofMsg LoadQuizzes; Cmd.ofMsg LoadStudents; Cmd.ofMsg LoadTopics ] + +/// Empty string means "not set" for these optional numeric fields; a +/// non-empty string that fails to parse is a validation error. +let private parseOptionalInt (text: string) : Result = + if System.String.IsNullOrWhiteSpace text then + Ok None + else + match System.Int32.TryParse text with + | true, v -> Ok(Some v) + | false, _ -> Error "Ожидалось целое число" + +let private parseOptionalFloat (text: string) : Result = + if System.String.IsNullOrWhiteSpace text then + Ok None + else + match System.Double.TryParse text with + | true, v -> Ok(Some v) + | false, _ -> Error "Ожидалось число" + +let private buildQuizFields (form: QuizForm) = + match parseOptionalInt form.TimeLimitText, parseOptionalInt form.MaxAttemptsText, parseOptionalFloat form.PassingScoreText with + | Error err, _, _ + | _, Error err, _ + | _, _, Error err -> Error err + | Ok timeLimit, Ok maxAttempts, Ok passingScore -> + if System.String.IsNullOrWhiteSpace form.Title then + Error "Название теста не может быть пустым" + elif form.Sources.IsEmpty then + Error "Выберите хотя бы один вопрос" + else + Ok(timeLimit, maxAttempts, passingScore) + +let private toDraft (source: QuizQuestionSourceInput) : QuizSourceDraft = + match source with + | FixedQuestionInput qid -> FixedDraft qid + | RandomPoolInput rule -> PoolDraft(rule.TopicId, rule.Count) + +let private toSourceInput (draft: QuizSourceDraft) : QuizQuestionSourceInput = + match draft with + | FixedDraft qid -> FixedQuestionInput qid + | PoolDraft(topicId, count) -> RandomPoolInput { TopicId = topicId; Count = count } + +let update (token: string option) (msg: Msg) (model: Model) : Model * Cmd = + match msg with + | LoadQuizzes -> + let cmd = + Cmd.OfAsync.either + Api.listMyQuizzes + token + (function + | Ok quizzes -> QuizzesLoaded quizzes + | Error err -> QuizzesLoadFailed err) + (fun ex -> QuizzesLoadFailed ex.Message) + + { model with QuizzesLoading = true; QuizzesError = None }, cmd + | QuizzesLoaded quizzes -> { model with Quizzes = quizzes; QuizzesLoading = false }, Cmd.none + | QuizzesLoadFailed err -> { model with QuizzesLoading = false; QuizzesError = Some err }, Cmd.none + | LoadStudents -> + let cmd = + Cmd.OfAsync.either + Api.listStudents + token + (function + | Ok students -> StudentsLoaded students + | Error err -> StudentsLoadFailed err) + (fun ex -> StudentsLoadFailed ex.Message) + + { model with StudentsLoading = true; StudentsError = None }, cmd + | StudentsLoaded students -> { model with Students = students; StudentsLoading = false }, Cmd.none + | StudentsLoadFailed err -> { model with StudentsLoading = false; StudentsError = Some err }, Cmd.none + | SelectQuiz quizId -> + let assigned = + model.Quizzes + |> List.tryFind (fun q -> q.Id = quizId) + |> Option.map (fun q -> Set.ofList q.AssignedStudentIds) + |> Option.defaultValue Set.empty + + { model with + SelectedQuizId = Some quizId + SelectedStudentIds = assigned + SaveError = None + ShowQuizForm = false + ResultsQuizId = None }, + Cmd.none + | ToggleStudent studentId -> + let next = + if model.SelectedStudentIds.Contains studentId then + model.SelectedStudentIds.Remove studentId + else + model.SelectedStudentIds.Add studentId + + { model with SelectedStudentIds = next }, Cmd.none + | SaveAssignments -> + match model.SelectedQuizId with + | None -> model, Cmd.none + | Some quizId -> + let request: AssignStudentsRequest = + { QuizId = quizId + StudentIds = Set.toList model.SelectedStudentIds } + + let cmd = + Cmd.OfAsync.either + (Api.assignStudents token) + request + (function + | Ok summary -> AssignmentsSaved summary + | Error err -> SaveFailed err) + (fun ex -> SaveFailed ex.Message) + + { model with IsSaving = true; SaveError = None }, cmd + | AssignmentsSaved summary -> + { model with + Quizzes = model.Quizzes |> List.map (fun q -> if q.Id = summary.Id then summary else q) + IsSaving = false }, + Cmd.none + | SaveFailed err -> { model with IsSaving = false; SaveError = Some err }, Cmd.none + | LoadTopics -> + let cmd = + Cmd.OfAsync.either + Api.listTopics + token + (function + | Ok topics -> TopicsLoaded topics + | Error err -> TopicsLoadFailed err) + (fun ex -> TopicsLoadFailed ex.Message) + + { model with TopicsLoading = true; TopicsError = None }, cmd + | TopicsLoaded topics -> { model with Topics = topics; TopicsLoading = false }, Cmd.none + | TopicsLoadFailed err -> { model with TopicsLoading = false; TopicsError = Some err }, Cmd.none + | StartNewQuiz -> + { model with + ShowQuizForm = true + EditingQuizId = None + QuizForm = emptyQuizForm + SelectedQuizId = None + ResultsQuizId = None }, + Cmd.none + | StartEditQuiz quizId -> + match model.Quizzes |> List.tryFind (fun q -> q.Id = quizId) with + | None -> model, Cmd.none + | Some quiz -> + let form = + { emptyQuizForm with + Title = quiz.Title + Description = quiz.Description + TimeLimitText = quiz.TimeLimitMinutes |> Option.map string |> Option.defaultValue "" + MaxAttemptsText = quiz.MaxAttempts |> Option.map string |> Option.defaultValue "" + PassingScoreText = quiz.PassingScore |> Option.map string |> Option.defaultValue "" + ShuffleQuestions = quiz.ShuffleQuestions + ShuffleAnswers = quiz.ShuffleAnswers + Sources = quiz.Sources |> List.map toDraft } + + { model with + ShowQuizForm = true + EditingQuizId = Some quizId + QuizForm = form }, + Cmd.none + | CancelQuizForm -> { model with ShowQuizForm = false; EditingQuizId = None }, Cmd.none + | SetQuizTitle text -> { model with QuizForm = { model.QuizForm with Title = text } }, Cmd.none + | SetQuizDescription text -> { model with QuizForm = { model.QuizForm with Description = text } }, Cmd.none + | SetQuizTimeLimitText text -> { model with QuizForm = { model.QuizForm with TimeLimitText = text } }, Cmd.none + | SetQuizMaxAttemptsText text -> + { model with QuizForm = { model.QuizForm with MaxAttemptsText = text } }, Cmd.none + | SetQuizPassingScoreText text -> + { model with QuizForm = { model.QuizForm with PassingScoreText = text } }, Cmd.none + | SetQuizShuffleQuestions value -> + { model with QuizForm = { model.QuizForm with ShuffleQuestions = value } }, Cmd.none + | SetQuizShuffleAnswers value -> + { model with QuizForm = { model.QuizForm with ShuffleAnswers = value } }, Cmd.none + | SelectPickerTopic topicId -> + let cmd = + Cmd.OfAsync.either + (Api.listQuestionsInTopic token) + topicId + (function + | Ok questions -> PickerQuestionsLoaded questions + | Error err -> PickerQuestionsLoadFailed err) + (fun ex -> PickerQuestionsLoadFailed ex.Message) + + let existingPoolCount = + model.QuizForm.Sources + |> List.tryPick (function + | PoolDraft(tid, count) when tid = topicId -> Some count + | _ -> None) + + { model with + QuizForm = + { model.QuizForm with + PickerTopicId = Some topicId + PickerLoading = true + PickerQuestions = [] + PoolCountText = existingPoolCount |> Option.map string |> Option.defaultValue "" } }, + cmd + | PickerQuestionsLoaded questions -> + { model with QuizForm = { model.QuizForm with PickerQuestions = questions; PickerLoading = false } }, Cmd.none + | PickerQuestionsLoadFailed err -> + { model with QuizForm = { model.QuizForm with PickerLoading = false; Error = Some err } }, Cmd.none + | ToggleQuestionPick questionId -> + let form = model.QuizForm + + let next = + if form.Sources |> List.exists (function FixedDraft qid -> qid = questionId | _ -> false) then + form.Sources + |> List.filter (function + | FixedDraft qid -> qid <> questionId + | _ -> true) + else + form.Sources @ [ FixedDraft questionId ] + + { model with QuizForm = { form with Sources = next } }, Cmd.none + | SelectAllInTopic -> + let form = model.QuizForm + + let alreadySelected = + form.Sources + |> List.choose (function + | FixedDraft qid -> Some qid + | _ -> None) + |> Set.ofList + + let toAdd = + form.PickerQuestions + |> List.map (fun q -> q.Id) + |> List.filter (alreadySelected.Contains >> not) + |> List.map FixedDraft + + { model with QuizForm = { form with Sources = form.Sources @ toAdd } }, Cmd.none + | SetPoolCountText text -> { model with QuizForm = { model.QuizForm with PoolCountText = text } }, Cmd.none + | AddRandomPool -> + let form = model.QuizForm + + match form.PickerTopicId with + | None -> model, Cmd.none + | Some topicId -> + match System.Int32.TryParse form.PoolCountText with + | true, count when count > 0 -> + let withoutOldPool = + form.Sources + |> List.filter (function + | PoolDraft(tid, _) -> tid <> topicId + | _ -> true) + + { model with QuizForm = { form with Sources = withoutOldPool @ [ PoolDraft(topicId, count) ]; Error = None } }, + Cmd.none + | _ -> + { model with QuizForm = { form with Error = Some "Количество случайных вопросов должно быть положительным числом" } }, + Cmd.none + | RemoveRandomPool topicId -> + let form = model.QuizForm + + let next = + form.Sources + |> List.filter (function + | PoolDraft(tid, _) -> tid <> topicId + | _ -> true) + + let poolCountText = if form.PickerTopicId = Some topicId then "" else form.PoolCountText + + { model with QuizForm = { form with Sources = next; PoolCountText = poolCountText } }, Cmd.none + | SubmitQuizForm -> + match buildQuizFields model.QuizForm with + | Error err -> { model with QuizForm = { model.QuizForm with Error = Some err } }, Cmd.none + | Ok(timeLimit, maxAttempts, passingScore) -> + let form = { model.QuizForm with IsSubmitting = true; Error = None } + let sources = form.Sources |> List.map toSourceInput + + let cmd = + match model.EditingQuizId with + | None -> + let req: CreateQuizRequest = + { Title = form.Title + Description = form.Description + TimeLimitMinutes = timeLimit + MaxAttempts = maxAttempts + PassingScore = passingScore + ShuffleQuestions = form.ShuffleQuestions + ShuffleAnswers = form.ShuffleAnswers + Sources = sources } + + Cmd.OfAsync.either + (Api.createQuiz token) + req + (function + | Ok summary -> QuizSaved summary + | Error err -> QuizSaveFailed err) + (fun ex -> QuizSaveFailed ex.Message) + | Some quizId -> + let req: UpdateQuizRequest = + { QuizId = quizId + Title = form.Title + Description = form.Description + TimeLimitMinutes = timeLimit + MaxAttempts = maxAttempts + PassingScore = passingScore + ShuffleQuestions = form.ShuffleQuestions + ShuffleAnswers = form.ShuffleAnswers + Sources = sources } + + Cmd.OfAsync.either + (Api.updateQuiz token) + req + (function + | Ok summary -> QuizSaved summary + | Error err -> QuizSaveFailed err) + (fun ex -> QuizSaveFailed ex.Message) + + { model with QuizForm = form }, cmd + | QuizSaved summary -> + let alreadyExists = model.Quizzes |> List.exists (fun q -> q.Id = summary.Id) + + { model with + Quizzes = + if alreadyExists then + model.Quizzes |> List.map (fun q -> if q.Id = summary.Id then summary else q) + else + model.Quizzes @ [ summary ] + ShowQuizForm = false + EditingQuizId = None }, + Cmd.none + | QuizSaveFailed err -> { model with QuizForm = { model.QuizForm with IsSubmitting = false; Error = Some err } }, Cmd.none + | RequestDeleteQuiz quizId -> + let cmd = + Cmd.OfAsync.either + (Api.deleteQuiz token) + quizId + (function + | Ok() -> QuizDeleted quizId + | Error err -> QuizDeleteFailed err) + (fun ex -> QuizDeleteFailed ex.Message) + + model, cmd + | QuizDeleted quizId -> + { model with + Quizzes = model.Quizzes |> List.filter (fun q -> q.Id <> quizId) + SelectedQuizId = if model.SelectedQuizId = Some quizId then None else model.SelectedQuizId + EditingQuizId = if model.EditingQuizId = Some quizId then None else model.EditingQuizId + ShowQuizForm = if model.EditingQuizId = Some quizId then false else model.ShowQuizForm }, + Cmd.none + | QuizDeleteFailed err -> { model with QuizzesError = Some err }, Cmd.none + | ShowResults quizId -> + let cmd = + Cmd.OfAsync.either + (Api.getQuizResults token) + quizId + (function + | Ok results -> ResultsLoaded results + | Error err -> ResultsLoadFailed err) + (fun ex -> ResultsLoadFailed ex.Message) + + { model with + ResultsQuizId = Some quizId + ResultsLoading = true + ResultsError = None + Results = [] + SelectedQuizId = None + ShowQuizForm = false }, + cmd + | ResultsLoaded results -> { model with Results = results; ResultsLoading = false }, Cmd.none + | ResultsLoadFailed err -> { model with ResultsLoading = false; ResultsError = Some err }, Cmd.none + | CancelResults -> { model with ResultsQuizId = None }, Cmd.none diff --git a/src/Client/Features/Teacher/Tests/Types.fs b/src/Client/Features/Teacher/Tests/Types.fs new file mode 100644 index 0000000..da0d57d --- /dev/null +++ b/src/Client/Features/Teacher/Tests/Types.fs @@ -0,0 +1,182 @@ +module Client.Features.Teacher.Tests.Types + +open Domain +open Domain.Contracts + +/// One entry of the quiz-being-built's question source list, in the same +/// "either fixed or random-pool" shape as the wire contract +/// `QuizQuestionSourceInput` — kept as a separate client type only because +/// the picker needs to reason about it per-topic (e.g. "does topic X already +/// have a pool rule?"), which is easier against a plain DU than re-deriving +/// it from the wire shape every render. +type QuizSourceDraft = + | FixedDraft of QuestionId + | PoolDraft of TopicId: TopicId * Count: int + +type QuizForm = + { Title: string + Description: string + TimeLimitText: string // minutes, empty = None + MaxAttemptsText: string // empty = None + PassingScoreText: string // empty = None + ShuffleQuestions: bool + ShuffleAnswers: bool + /// Accumulates across topic switches in the picker below — membership + /// alone decides the checkbox state, regardless of which topic's + /// questions are currently displayed. + Sources: QuizSourceDraft list + PickerTopicId: TopicId option + PickerQuestions: QuestionSummary list + PickerLoading: bool + /// Draft text for "N случайных вопросов" of the topic currently open + /// in the picker — reset whenever the picker's topic changes. + PoolCountText: string + Error: string option + IsSubmitting: bool } + +let emptyQuizForm = + { Title = "" + Description = "" + TimeLimitText = "" + MaxAttemptsText = "" + PassingScoreText = "" + ShuffleQuestions = false + ShuffleAnswers = false + Sources = [] + PickerTopicId = None + PickerQuestions = [] + PickerLoading = false + PoolCountText = "" + Error = None + IsSubmitting = false } + +/// Ids of `form.PickerQuestions` (the topic currently open in the picker) +/// that are individually fixed-selected — used to enforce "fixed selection +/// XOR random pool" per topic, one topic at a time. +let fixedIdsInCurrentTopic (form: QuizForm) : QuestionId list = + let topicIds = form.PickerQuestions |> List.map (fun q -> q.Id) |> Set.ofList + + form.Sources + |> List.choose (function + | FixedDraft qid when topicIds.Contains qid -> Some qid + | _ -> None) + +/// The random-pool count configured for the topic currently open in the +/// picker, if any. +let poolCountForCurrentTopic (form: QuizForm) : int option = + match form.PickerTopicId with + | None -> None + | Some topicId -> + form.Sources + |> List.tryPick (function + | PoolDraft(tid, count) when tid = topicId -> Some count + | _ -> None) + +/// Total number of questions the quiz will actually have: one per fixed +/// selection, plus each pool rule's `Count`. +let totalSelectedCount (form: QuizForm) : int = + form.Sources + |> List.sumBy (function + | FixedDraft _ -> 1 + | PoolDraft(_, count) -> count) + +let randomPoolCount (form: QuizForm) : int = + form.Sources + |> List.sumBy (function + | PoolDraft(_, count) -> count + | FixedDraft _ -> 0) + +type Model = + { Quizzes: QuizAdminSummary list + QuizzesLoading: bool + QuizzesError: string option + Students: StudentSummary list + StudentsLoading: bool + StudentsError: string option + SelectedQuizId: QuizId option + /// Working draft of the checkbox list for `SelectedQuizId`, seeded from + /// that quiz's `AssignedStudentIds` when selected. + SelectedStudentIds: Set + SaveError: string option + IsSaving: bool + Topics: Topic list + TopicsLoading: bool + TopicsError: string option + /// `None` = the quiz form creates a new quiz; `Some id` = it edits + /// that existing quiz instead. + EditingQuizId: QuizId option + ShowQuizForm: bool + QuizForm: QuizForm + /// The quiz whose per-student results panel is open, if any — mutually + /// exclusive with `SelectedQuizId` (assignment panel); opening one + /// closes the other. + ResultsQuizId: QuizId option + ResultsLoading: bool + ResultsError: string option + Results: StudentQuizResult list } + +let empty = + { Quizzes = [] + QuizzesLoading = false + QuizzesError = None + Students = [] + StudentsLoading = false + StudentsError = None + SelectedQuizId = None + SelectedStudentIds = Set.empty + SaveError = None + IsSaving = false + Topics = [] + TopicsLoading = false + TopicsError = None + EditingQuizId = None + ShowQuizForm = false + QuizForm = emptyQuizForm + ResultsQuizId = None + ResultsLoading = false + ResultsError = None + Results = [] } + +type Msg = + | LoadQuizzes + | QuizzesLoaded of QuizAdminSummary list + | QuizzesLoadFailed of string + | LoadStudents + | StudentsLoaded of StudentSummary list + | StudentsLoadFailed of string + | SelectQuiz of QuizId + | ToggleStudent of UserId + | SaveAssignments + | AssignmentsSaved of QuizAdminSummary + | SaveFailed of string + | LoadTopics + | TopicsLoaded of Topic list + | TopicsLoadFailed of string + | StartNewQuiz + | StartEditQuiz of QuizId + | CancelQuizForm + | SetQuizTitle of string + | SetQuizDescription of string + | SetQuizTimeLimitText of string + | SetQuizMaxAttemptsText of string + | SetQuizPassingScoreText of string + | SetQuizShuffleQuestions of bool + | SetQuizShuffleAnswers of bool + | SelectPickerTopic of TopicId + | PickerQuestionsLoaded of QuestionSummary list + | PickerQuestionsLoadFailed of string + | ToggleQuestionPick of QuestionId + | SelectAllInTopic + | SetPoolCountText of string + | AddRandomPool + | RemoveRandomPool of TopicId + | SubmitQuizForm + | QuizSaved of QuizAdminSummary + | QuizSaveFailed of string + | RequestDeleteQuiz of QuizId + | QuizDeleted of QuizId + | QuizDeleteFailed of string + | ShowResults of QuizId + | ResultsLoaded of StudentQuizResult list + | ResultsLoadFailed of string + | CancelResults diff --git a/src/Client/Features/Teacher/Tests/View.fs b/src/Client/Features/Teacher/Tests/View.fs new file mode 100644 index 0000000..d578f22 --- /dev/null +++ b/src/Client/Features/Teacher/Tests/View.fs @@ -0,0 +1,484 @@ +module Client.Features.Teacher.Tests.View + +open Feliz +open Domain.Contracts +open Client.Shared +open Client.Features.Teacher.Tests.Types + +let private sourceQuestionCount (source: QuizQuestionSourceInput) : int = + match source with + | FixedQuestionInput _ -> 1 + | RandomPoolInput rule -> rule.Count + +let private quizzesView (model: Model) dispatch = + Html.div [ + prop.className "quizzes-panel" + prop.children [ + Html.h2 "Мои тесты" + match model.QuizzesError with + | Some err -> Html.p [ prop.className "error"; prop.text err ] + | None -> Html.none + if model.QuizzesLoading then + Html.p "Загрузка…" + elif model.Quizzes.IsEmpty then + Html.p "У вас пока нет тестов" + else + Html.div [ + prop.className "quiz-cards" + prop.children [ + for quiz in model.Quizzes -> + Html.div [ + prop.key (string quiz.Id) + prop.className ( + if model.SelectedQuizId = Some quiz.Id || model.ResultsQuizId = Some quiz.Id then + "quiz-manage-card selected" + else + "quiz-manage-card" + ) + prop.onClick (fun _ -> dispatch (SelectQuiz quiz.Id)) + prop.children [ + Html.h3 [ prop.className "quiz-manage-card-title"; prop.text quiz.Title ] + Html.span [ + prop.className "tag-mono" + prop.text ( + sprintf + "вопросов: %d, назначено: %d" + (quiz.Sources |> List.sumBy sourceQuestionCount) + quiz.AssignedStudentIds.Length + ) + ] + Html.div [ + prop.className "quiz-manage-card-actions" + prop.children [ + Html.button [ + prop.type'.button + prop.onClick (fun e -> + e.stopPropagation () + dispatch (SelectQuiz quiz.Id)) + prop.text "Назначить студентов" + ] + Html.button [ + prop.type'.button + prop.onClick (fun e -> + e.stopPropagation () + dispatch (ShowResults quiz.Id)) + prop.text "Результаты" + ] + Html.button [ + prop.type'.button + prop.onClick (fun e -> + e.stopPropagation () + dispatch (StartEditQuiz quiz.Id)) + prop.text "Изменить" + ] + Html.button [ + prop.type'.button + prop.onClick (fun e -> + e.stopPropagation () + dispatch (RequestDeleteQuiz quiz.Id)) + prop.text "Удалить" + ] + ] + ] + ] + ] + ] + ] + ] + ] + +let private assignmentView (model: Model) dispatch = + Html.div [ + prop.className "assignment-panel" + prop.children [ + Html.h3 "Назначенные студенты" + match model.StudentsError with + | Some err -> Html.p [ prop.className "error"; prop.text err ] + | None -> Html.none + if model.StudentsLoading then + Html.p "Загрузка…" + elif model.Students.IsEmpty then + Html.p "Студентов пока нет" + else + Html.div [ + prop.children [ + for student in model.Students -> + Html.label [ + prop.key (string student.Id) + prop.className "student-row" + prop.children [ + Html.input [ + prop.type'.checkbox + prop.isChecked (model.SelectedStudentIds.Contains student.Id) + prop.onChange (fun (_: bool) -> dispatch (ToggleStudent student.Id)) + ] + Html.text (sprintf "%s (%s)" student.Name student.Email) + ] + ] + ] + ] + match model.SaveError with + | Some err -> Html.p [ prop.className "error"; prop.text err ] + | None -> Html.none + Html.button [ + prop.disabled model.IsSaving + prop.onClick (fun _ -> dispatch SaveAssignments) + prop.text (if model.IsSaving then "Сохранение…" else "Сохранить назначения") + ] + ] + ] + +let private formatAttemptTime (t: System.DateTimeOffset) = t.ToLocalTime().ToString("dd.MM.yyyy HH:mm") + +let private resultsView (model: Model) dispatch = + Html.div [ + prop.className "assignment-panel" + prop.children [ + Html.div [ + prop.className "page-header" + prop.children [ + Html.h3 "Результаты студентов" + Html.button [ + prop.type'.button + prop.onClick (fun _ -> dispatch CancelResults) + prop.text "Закрыть" + ] + ] + ] + match model.ResultsError with + | Some err -> Html.p [ prop.className "error"; prop.text err ] + | None -> Html.none + if model.ResultsLoading then + Html.p "Загрузка…" + elif model.Results.IsEmpty then + Html.p "На этот тест ещё не назначено ни одного студента" + else + Html.table [ + prop.className "results-table" + prop.children [ + Html.thead [ + Html.tr [ + Html.th [ prop.text "ФИО" ] + Html.th [ prop.text "Результат" ] + Html.th [ prop.text "Попыток" ] + Html.th [ prop.text "Последняя успешная попытка" ] + Html.th [ prop.text "Потери фокуса" ] + ] + ] + Html.tbody [ + for r in model.Results -> + Html.tr [ + prop.key (string r.StudentId) + prop.children [ + Html.td [ prop.text (sprintf "%s (%s)" r.StudentName r.StudentEmail) ] + Html.td [ + match r.Passed with + | Some true -> Html.span [ prop.className "grade-stamp passed"; prop.text "Пройден" ] + | Some false -> Html.span [ prop.className "grade-stamp failed"; prop.text "Не пройден" ] + | None -> Html.span [ prop.className "hint"; prop.text "—" ] + ] + Html.td [ prop.text (string r.AttemptsCount) ] + Html.td [ + prop.className "tag-mono" + prop.text ( + match r.LastSuccessfulAttemptAt with + | Some t -> formatAttemptTime t + | None -> "—" + ) + ] + Html.td [ + prop.className ( + if r.LastAttemptFocusLossCount > 0 then + "focus-loss-value warn" + else + "focus-loss-value" + ) + prop.text (string r.LastAttemptFocusLossCount) + ] + ] + ] + ] + ] + ] + ] + ] + +/// Summary of every configured random-pool rule, across all topics — needed +/// because the picker below only shows one topic's questions at a time, so +/// without this list, switching the topic dropdown away would make an +/// already-configured pool rule invisible. +let private poolRulesSummary (model: Model) dispatch = + let pools = + model.QuizForm.Sources + |> List.choose (function + | PoolDraft(topicId, count) -> Some(topicId, count) + | FixedDraft _ -> None) + + if pools.IsEmpty then + Html.none + else + Html.ul [ + prop.className "pool-rules-summary" + prop.children [ + for (topicId, count) in pools -> + let topicName = + model.Topics + |> List.tryFind (fun t -> t.Id = topicId) + |> Option.map (fun t -> t.Name) + |> Option.defaultValue "?" + + Html.li [ + prop.key (string topicId) + prop.children [ + Html.span [ prop.text (sprintf "%s — случайных вопросов: %d" topicName count) ] + Html.button [ + prop.type'.button + prop.onClick (fun _ -> dispatch (RemoveRandomPool topicId)) + prop.text "Убрать" + ] + ] + ] + ] + ] + +let private questionPicker (model: Model) dispatch = + let form = model.QuizForm + let poolForTopic = poolCountForCurrentTopic form + let fixedInTopic = fixedIdsInCurrentTopic form + + Html.div [ + prop.className "question-picker" + prop.children [ + Html.label [ prop.text "Тема" ] + Html.select [ + prop.value (form.PickerTopicId |> Option.map string |> Option.defaultValue "") + prop.onChange (fun (v: string) -> + model.Topics + |> List.tryFind (fun t -> string t.Id = v) + |> Option.iter (fun t -> dispatch (SelectPickerTopic t.Id))) + prop.children [ + Html.option [ prop.value ""; prop.text "— выберите тему —" ] + for topic in model.Topics do + Html.option [ prop.key (string topic.Id); prop.value (string topic.Id); prop.text topic.Name ] + ] + ] + if form.PickerLoading then + Html.p "Загрузка вопросов…" + elif form.PickerTopicId.IsSome && form.PickerQuestions.IsEmpty then + Html.p "В этой теме нет вопросов" + elif form.PickerTopicId.IsSome then + match poolForTopic with + | Some count -> + Html.div [ + prop.className "pool-picker" + prop.children [ + Html.p ( + sprintf + "Для этой темы используется случайный набор — на каждую попытку студенту достаётся %d случайных вопросов из неё." + count + ) + Html.input [ + prop.type'.text + prop.className "pool-count-input" + prop.value form.PoolCountText + prop.onChange (SetPoolCountText >> dispatch) + ] + Html.button [ + prop.type'.button + prop.onClick (fun _ -> dispatch AddRandomPool) + prop.text "Обновить количество" + ] + Html.button [ + prop.type'.button + prop.onClick (fun _ -> + form.PickerTopicId |> Option.iter (RemoveRandomPool >> dispatch)) + prop.text "Убрать случайный набор, выбирать вручную" + ] + ] + ] + | None -> + Html.div [ + prop.children [ + Html.div [ + prop.children [ + for q in form.PickerQuestions -> + Html.label [ + prop.key (string q.Id) + prop.className "student-row" + prop.children [ + Html.input [ + prop.type'.checkbox + prop.isChecked (fixedInTopic |> List.contains q.Id) + prop.onChange (fun (_: bool) -> dispatch (ToggleQuestionPick q.Id)) + ] + Html.text q.Text + ] + ] + ] + ] + Html.button [ + prop.type'.button + prop.onClick (fun _ -> dispatch SelectAllInTopic) + prop.text "Выбрать все вопросы темы" + ] + Html.p "или задать случайный набор вместо ручного выбора:" + Html.input [ + prop.type'.text + prop.className "pool-count-input" + prop.placeholder "Число вопросов" + prop.value form.PoolCountText + prop.onChange (SetPoolCountText >> dispatch) + ] + Html.button [ + prop.type'.button + prop.disabled (not fixedInTopic.IsEmpty) + prop.onClick (fun _ -> dispatch AddRandomPool) + prop.text "Добавить случайный набор из этой темы" + ] + if not fixedInTopic.IsEmpty then + Html.p [ + prop.className "hint" + prop.text "Снимите ручной выбор вопросов этой темы, чтобы вместо него задать случайный набор." + ] + ] + ] + else + Html.none + poolRulesSummary model dispatch + Html.span [ + prop.className "tag-mono" + prop.text ( + let total = totalSelectedCount form + let pool = randomPoolCount form + + if pool > 0 then + sprintf "Выбрано вопросов: %d (из них случайных: %d)" total pool + else + sprintf "Выбрано вопросов: %d" total + ) + ] + ] + ] + +let private quizFormView (isEditing: bool) (model: Model) dispatch = + let form = model.QuizForm + + Html.form [ + prop.className "new-question-form" + prop.onSubmit (fun e -> + e.preventDefault () + dispatch SubmitQuizForm) + prop.children [ + Html.h3 (if isEditing then "Редактирование теста" else "Новый тест") + Html.label [ prop.text "Название" ] + Html.input [ prop.type'.text; prop.value form.Title; prop.onChange (SetQuizTitle >> dispatch) ] + Html.label [ prop.text "Описание" ] + Html.input [ + prop.type'.text + prop.value form.Description + prop.onChange (SetQuizDescription >> dispatch) + ] + Html.label [ prop.text "Лимит времени, мин (необязательно)" ] + Html.input [ + prop.type'.text + prop.value form.TimeLimitText + prop.onChange (SetQuizTimeLimitText >> dispatch) + ] + Html.label [ prop.text "Максимум попыток (необязательно)" ] + Html.input [ + prop.type'.text + prop.value form.MaxAttemptsText + prop.onChange (SetQuizMaxAttemptsText >> dispatch) + ] + Html.label [ prop.text "Проходной балл (необязательно)" ] + Html.input [ + prop.type'.text + prop.value form.PassingScoreText + prop.onChange (SetQuizPassingScoreText >> dispatch) + ] + Html.label [ + prop.children [ + Html.input [ + prop.type'.checkbox + prop.isChecked form.ShuffleQuestions + prop.onChange (SetQuizShuffleQuestions >> dispatch) + ] + Html.text "Перемешивать вопросы" + ] + ] + Html.label [ + prop.children [ + Html.input [ + prop.type'.checkbox + prop.isChecked form.ShuffleAnswers + prop.onChange (SetQuizShuffleAnswers >> dispatch) + ] + Html.text "Перемешивать варианты ответов" + ] + ] + questionPicker model dispatch + match form.Error with + | Some err -> Html.p [ prop.className "error"; prop.text err ] + | None -> Html.none + Html.button [ + prop.type'.submit + prop.disabled form.IsSubmitting + prop.text ( + if form.IsSubmitting then "Сохранение…" + elif isEditing then "Сохранить изменения" + else "Создать тест" + ) + ] + Html.button [ + prop.type'.button + prop.onClick (fun _ -> dispatch CancelQuizForm) + prop.text "Отмена" + ] + ] + ] + +let view (model: Model) (dispatch: Msg -> unit) = + Html.div [ + prop.className "teacher-tests-page" + prop.children [ + Html.div [ + prop.className "page-header" + prop.children [ + Html.h1 "Тесты и назначения" + Html.button [ + prop.type'.button + prop.onClick (fun _ -> dispatch StartNewQuiz) + prop.text "Создать тест" + ] + ] + ] + match model.ResultsQuizId, model.ShowQuizForm with + | Some _, false -> + // The card list shifts into a narrow left column to make + // room for the results table, instead of the table stacking + // below the full-width cards like the assignment panel does. + Html.div [ + prop.className "results-layout" + prop.children [ quizzesView model dispatch; resultsView model dispatch ] + ] + | _ -> + quizzesView model dispatch + + if not model.ShowQuizForm then + match model.SelectedQuizId with + | Some _ -> assignmentView model dispatch + | None -> Html.none + if model.ShowQuizForm then + Html.div [ + prop.className "modal-backdrop" + prop.onClick (fun _ -> dispatch CancelQuizForm) + prop.children [ + Html.div [ + prop.className "modal-dialog" + prop.onClick (fun e -> e.stopPropagation ()) + prop.children [ quizFormView model.EditingQuizId.IsSome model dispatch ] + ] + ] + ] + ] + ] diff --git a/src/Client/Program.fs b/src/Client/Program.fs new file mode 100644 index 0000000..51a8bd1 --- /dev/null +++ b/src/Client/Program.fs @@ -0,0 +1,10 @@ +module Client.Program + +open Elmish +open Elmish.React +open Client.App.State +open Client.App.View + +Program.mkProgram init update view +|> Program.withReactSynchronous "elmish-app" +|> Program.run diff --git a/src/Client/Shared/Format.fs b/src/Client/Shared/Format.fs new file mode 100644 index 0000000..b7e1466 --- /dev/null +++ b/src/Client/Shared/Format.fs @@ -0,0 +1,12 @@ +module Client.Shared.Format + +/// Whole-numbered points render without a decimal point ("3"); anything with +/// a fractional part renders with one decimal place ("2.5") — points are +/// usually whole in this app, but `AverageAttempt` grading or a partial-point +/// question config can produce a fractional value that a blanket "%.0f" +/// would otherwise silently round away. +let points (value: float) : string = + if value = System.Math.Round value then + sprintf "%.0f" value + else + sprintf "%.1f" value diff --git a/src/Client/Shared/JsonWire.fs b/src/Client/Shared/JsonWire.fs new file mode 100644 index 0000000..358d415 --- /dev/null +++ b/src/Client/Shared/JsonWire.fs @@ -0,0 +1,71 @@ +module Client.Shared.JsonWire + +// Fable.Remoting.Client pulls in Fable.Remoting.MsgPack, whose `inline` +// helpers reference private functions in a way the current Fable compiler +// rejects at build time. Until that's fixed upstream, each feature's `Api.fs` +// talks to its own plain Giraffe route by hand, using the helpers below to +// POST/GET JSON and decode the {"Ok": ...} / {"Error": ...} shape +// Fable.Remoting.Json already produces on the server (see `Server/Json.fs`). +open Fable.Core +open Fable.Core.JsInterop +open Domain + +let private serverUrl = "http://localhost:5144" + +[] +let hasKey (_o: obj) (_key: string) : bool = jsNative + +[ r.json())")>] +let private fetchJson (_url: string) (_init: obj) : JS.Promise = jsNative + +/// `body = None` for GET-style calls with no request payload. +let callApi (token: string option) (httpMethod: string) (path: string) (body: obj option) : Async = + async { + let headers = + match token with + | Some t -> createObj [ "Content-Type" ==> "application/json"; "Authorization" ==> ("Bearer " + t) ] + | None -> createObj [ "Content-Type" ==> "application/json" ] + + let baseFields = [ "method" ==> httpMethod; "headers" ==> headers ] + + let fields = + match body with + | Some b -> baseFields @ [ "body" ==> JS.JSON.stringify b ] + | None -> baseFields + + return! fetchJson (serverUrl + path) (createObj fields) |> Async.AwaitPromise + } + +// ---- Id encode/decode: wire shape is {"CaseName": ""} ---- + +let encQuizId (QuizId g) : obj = createObj [ "QuizId" ==> string g ] +let encTopicId (TopicId g) : obj = createObj [ "TopicId" ==> string g ] +let encUserId (UserId g) : obj = createObj [ "UserId" ==> string g ] +let encAttemptId (AttemptId g) : obj = createObj [ "AttemptId" ==> string g ] +let encQuestionId (QuestionId g) : obj = createObj [ "QuestionId" ==> string g ] +let encOptionId (OptionId g) : obj = createObj [ "OptionId" ==> string g ] + +let decUserId (o: obj) : UserId = UserId(System.Guid.Parse(o?UserId: string)) +let decTopicId (o: obj) : TopicId = TopicId(System.Guid.Parse(o?TopicId: string)) +let decQuizId (o: obj) : QuizId = QuizId(System.Guid.Parse(o?QuizId: string)) +let decQuestionId (o: obj) : QuestionId = QuestionId(System.Guid.Parse(o?QuestionId: string)) +let decOptionId (o: obj) : OptionId = OptionId(System.Guid.Parse(o?OptionId: string)) +let decAttemptId (o: obj) : AttemptId = AttemptId(System.Guid.Parse(o?AttemptId: string)) + +let optToJs (mapper: 'a -> obj) (opt: 'a option) : obj = + match opt with + | Some x -> mapper x + | None -> null + +let optDec (mapper: obj -> 'a) (raw: obj) : 'a option = + if isNullOrUndefined raw then None else Some(mapper raw) + +let decodeRole (raw: obj) : Role = + match unbox raw with + | "Admin" -> Admin + | "Teacher" -> Teacher + | "Student" -> Student + | other -> failwithf "Неизвестная роль: %s" other + +let decodeResult (decodeOk: obj -> 'a) (raw: obj) : Result<'a, string> = + if hasKey raw "Ok" then Ok(decodeOk raw?Ok) else Error(unbox raw?Error) diff --git a/src/Client/Shared/SessionStorage.fs b/src/Client/Shared/SessionStorage.fs new file mode 100644 index 0000000..b15d20d --- /dev/null +++ b/src/Client/Shared/SessionStorage.fs @@ -0,0 +1,46 @@ +module Client.Shared.SessionStorage + +// Without this, the whole session lives only in the in-memory Elmish Model — +// any page refresh (F5, or reopening the tab) resets `Model.Session` to +// `None` and drops the user back to the login screen, no matter which page +// they were on. Persisting the JWT to localStorage and restoring it on +// `App.State.init` fixes that for every page, not just one. +open Fable.Core +open Fable.Core.JsInterop +open Browser.WebStorage +open Domain.Contracts +open Client.Shared.JsonWire + +let private storageKey = "quizsystem.session" + +let save (session: LoginResponse) : unit = + let raw = + createObj [ + "Token" ==> session.Token + "UserId" ==> encUserId session.UserId + "Name" ==> session.Name + "Role" ==> box (string session.Role) + ] + + localStorage.setItem (storageKey, JS.JSON.stringify raw) + +let clear () : unit = localStorage.removeItem storageKey + +/// `None` on a first visit, a cleared/missing entry, or anything that fails +/// to parse (e.g. a stale shape from a previous version of this app) — any +/// of those should just fall through to the login page, not crash the app +/// on load. +let tryLoad () : LoginResponse option = + match localStorage.getItem storageKey with + | null -> None + | json -> + try + let raw = JS.JSON.parse json + + Some + { Token = raw?Token + UserId = decUserId raw?UserId + Name = raw?Name + Role = decodeRole raw?Role } + with _ -> + None diff --git a/src/Client/index.html b/src/Client/index.html new file mode 100644 index 0000000..26d7b77 --- /dev/null +++ b/src/Client/index.html @@ -0,0 +1,20 @@ + + + + + + + Система тестирования + + + + + + +
+ + + diff --git a/src/Client/nginx.conf b/src/Client/nginx.conf new file mode 100644 index 0000000..73ade1e --- /dev/null +++ b/src/Client/nginx.conf @@ -0,0 +1,8 @@ +server { + listen 80; + root /usr/share/nginx/html; + + location / { + try_files $uri $uri/ /index.html; + } +} diff --git a/src/Client/style.css b/src/Client/style.css new file mode 100644 index 0000000..1a3529f --- /dev/null +++ b/src/Client/style.css @@ -0,0 +1,880 @@ +/* ============================================================ + Tokens + ============================================================ */ +:root { + --paper: #ece9e1; + --surface: #fbfaf6; + --ink: #1d2333; + --ink-soft: #565f70; + --line: #d6d0c0; + --brass: #8c6a28; + --brass-soft: #eee3cd; + --pass: #1f6f45; + --pass-bg: #e4efe7; + --fail: #a32b20; + --fail-bg: #f6e6e3; + + --font-display: "IBM Plex Serif", Georgia, serif; + --font-body: "IBM Plex Sans", system-ui, sans-serif; + --font-mono: "IBM Plex Mono", ui-monospace, monospace; + + --radius: 3px; +} + +/* ============================================================ + Reset & base + ============================================================ */ +* { + box-sizing: border-box; +} + +body { + font-family: var(--font-body); + background: var(--paper); + color: var(--ink); + margin: 0; + line-height: 1.5; + -webkit-font-smoothing: antialiased; +} + +h1, +h2, +h3 { + font-family: var(--font-display); + font-weight: 600; + margin: 0 0 0.6em; + line-height: 1.2; + letter-spacing: -0.01em; +} + +h1 { + font-size: 1.75rem; +} +h2 { + font-size: 1.3rem; +} +h3 { + font-size: 1.05rem; +} + +p { + margin: 0 0 0.75em; +} + +ul { + list-style: none; + padding: 0; + margin: 0; +} + +button { + font-family: var(--font-body); + font-size: 0.95rem; + font-weight: 500; + background: var(--ink); + color: var(--surface); + border: 1px solid var(--ink); + border-radius: var(--radius); + padding: 0.55rem 1.1rem; + cursor: pointer; + transition: background-color 150ms ease, transform 100ms ease; +} + +button:hover:not(:disabled) { + background: #323a52; +} + +button:active:not(:disabled) { + transform: translateY(1px); +} + +button:disabled { + cursor: not-allowed; + opacity: 0.55; +} + +/* Secondary / utility buttons — outline instead of filled */ +.option-row button, +button[type="button"] { + background: transparent; + color: var(--ink); +} + +.option-row button:hover:not(:disabled), +button[type="button"]:hover:not(:disabled) { + background: var(--brass-soft); +} + +input, +select, +textarea { + font-family: var(--font-body); + font-size: 0.95rem; + color: var(--ink); + background: var(--surface); + border: 1px solid var(--line); + border-radius: var(--radius); + padding: 0.5rem 0.6rem; +} + +label { + display: block; + font-weight: 500; + font-size: 0.85rem; + color: var(--ink-soft); + margin-top: 0.85rem; + margin-bottom: 0.25rem; +} + +/* Full-width block inputs — explicitly excludes radio/checkbox, which must + keep their native size wherever they appear inside a
(option + editors, true/false pickers, student checklists). */ +form input:not([type="radio"]):not([type="checkbox"]), +form select { + display: block; + width: 100%; +} + +.option-row input[type="radio"], +.option-row input[type="checkbox"] { + width: auto; + flex: none; +} + +a { + color: var(--brass); +} + +:focus-visible { + outline: 2px solid var(--brass); + outline-offset: 2px; +} + +.error { + color: var(--fail); + background: var(--fail-bg); + border-left: 3px solid var(--fail); + padding: 0.5rem 0.75rem; + border-radius: 0 var(--radius) var(--radius) 0; + font-size: 0.9rem; +} + +.hint { + color: var(--ink-soft); + font-size: 0.85rem; + font-family: var(--font-mono); +} + +/* ============================================================ + Shell: topbar, page container + ============================================================ */ +.topbar { + position: sticky; + top: 0; + z-index: 10; + display: flex; + justify-content: space-between; + align-items: center; + background: var(--paper); + border-bottom: 1px solid var(--line); + padding: 0.9rem 1.5rem; +} + +.topbar-identity { + display: flex; + align-items: baseline; + gap: 0.6rem; +} + +.topbar-name { + font-weight: 500; +} + +.role-badge { + font-family: var(--font-mono); + font-size: 0.72rem; + letter-spacing: 0.04em; + text-transform: uppercase; + color: var(--brass); + background: var(--brass-soft); + border-radius: var(--radius); + padding: 0.15rem 0.5rem; +} + +.wordmark { + font-family: var(--font-display); + font-weight: 600; +} + +/* Every page under the topbar gets consistent horizontal rhythm */ +.quiz-list-page, +.taking-quiz-page, +.result-page, +.teacher-home { + max-width: 880px; + margin: 0 auto; + padding: 1.75rem 1.5rem 3rem; +} + +.login-page { + max-width: 420px; + margin: 4rem auto; + padding: 0 1.5rem; +} + +/* ============================================================ + Login + ============================================================ */ +.login-page .wordmark { + font-size: 2rem; + margin-bottom: 0.25rem; +} + +.login-card { + background: var(--surface); + border: 1px solid var(--line); + border-radius: var(--radius); + padding: 1.75rem; + margin-top: 1.5rem; +} + +.login-card button[type="submit"] { + width: 100%; + margin-top: 1.25rem; +} + +.login-page .hint { + margin-top: 1rem; + text-align: center; +} + +/* ============================================================ + Quiz list (student) + ============================================================ */ +.quiz-card { + background: var(--surface); + border: 1px solid var(--line); + border-radius: var(--radius); + padding: 1.25rem 1.5rem; + margin-bottom: 1rem; +} + +.meta-row { + display: flex; + flex-wrap: wrap; + gap: 1.5rem; + margin: 1rem 0; + padding-top: 0.85rem; + border-top: 1px solid var(--line); +} + +.meta-item { + display: flex; + flex-direction: column; + gap: 0.15rem; +} + +.meta-label { + font-size: 0.72rem; + letter-spacing: 0.04em; + text-transform: uppercase; + color: var(--ink-soft); +} + +.meta-value { + font-family: var(--font-mono); + font-size: 1.05rem; +} + +/* Smaller inline mono tag — inherits color so it stays readable both in + normal rows and on the dark `.selected` background of topic/quiz items. */ +.tag-mono { + font-family: var(--font-mono); + font-size: 0.8rem; + opacity: 0.72; +} + +/* ============================================================ + Taking a quiz + ============================================================ */ +.question { + display: flex; + gap: 1rem; + border-top: 1px solid var(--line); + padding: 1.25rem 0; +} + +.question:first-of-type { + border-top: none; +} + +.question-number { + font-family: var(--font-mono); + font-size: 0.85rem; + color: var(--brass); + flex-shrink: 0; + padding-top: 0.15rem; +} + +.question-body { + flex: 1; + min-width: 0; +} + +.question-text { + font-weight: 500; + margin-bottom: 0.6rem; +} + +.option { + display: flex; + align-items: center; + gap: 0.5rem; + font-weight: normal; + margin: 0 0 0.35rem; +} + +.option input { + width: auto; +} + +.quiz-actions { + position: sticky; + bottom: 0; + background: var(--paper); + border-top: 1px solid var(--line); + margin: 0 -1.5rem; + padding: 1rem 1.5rem; + box-shadow: 0 -6px 12px -8px rgba(29, 35, 51, 0.15); +} + +.quiz-actions button { + width: 100%; +} + +.time-remaining { + display: block; + text-align: center; + font-family: var(--font-mono); + font-size: 0.95rem; + color: var(--ink-soft); + margin-bottom: 0.6rem; +} + +.time-remaining.low { + color: var(--fail); + font-weight: 600; +} + +/* ============================================================ + Result + ============================================================ */ +.result-page { + text-align: center; +} + +.grade-stamp { + display: inline-block; + font-family: var(--font-display); + font-weight: 600; + font-size: 1.4rem; + text-transform: uppercase; + letter-spacing: 0.05em; + border: 3px solid currentColor; + border-radius: var(--radius); + padding: 0.6rem 1.5rem; + margin: 1rem 0 1.5rem; + transform: rotate(-4deg); + animation: stamp-down 260ms ease-out; +} + +.grade-stamp.passed { + color: var(--pass); + background: var(--pass-bg); +} + +.grade-stamp.failed { + color: var(--fail); + background: var(--fail-bg); +} + +@keyframes stamp-down { + from { + opacity: 0; + transform: rotate(-4deg) scale(1.4); + } + to { + opacity: 1; + transform: rotate(-4deg) scale(1); + } +} + +.score-value { + display: block; + font-family: var(--font-mono); + font-size: 1.5rem; + margin-bottom: 0.5rem; +} + +.results-panel { + margin-top: 1rem; + padding-top: 0.85rem; + border-top: 1px solid var(--line); +} + +.attempt-row { + display: flex; + flex-wrap: wrap; + align-items: center; + gap: 0.75rem; + padding: 0.4rem 0; +} + +/* Compact, non-animated variant of the big result-page stamp/score, sized + for a list row instead of a standalone celebratory screen. */ +.attempt-row .score-value { + display: inline; + font-size: 0.95rem; + margin-bottom: 0; +} + +.attempt-row .grade-stamp { + font-size: 0.75rem; + border-width: 1px; + padding: 0.15rem 0.5rem; + margin: 0; + transform: none; + animation: none; +} + +/* ============================================================ + Teacher admin + ============================================================ */ +.tabs { + display: flex; + gap: 0.5rem; + margin-bottom: 1.5rem; + border-bottom: 1px solid var(--line); +} + +.tab-button { + background: transparent; + color: var(--ink-soft); + border: none; + border-bottom: 2px solid transparent; + border-radius: 0; + padding: 0.6rem 0.25rem; + margin-bottom: -1px; + margin-right: 1.25rem; +} + +.tab-button:hover:not(:disabled) { + background: transparent; + color: var(--ink); +} + +.tab-button.active { + color: var(--ink); + border-bottom-color: var(--brass); + font-weight: 600; +} + +.teacher-layout { + display: grid; + grid-template-columns: 260px 1fr; + gap: 2rem; + align-items: start; + margin-top: 1rem; +} + +.topics-panel, +.quizzes-panel { + background: var(--surface); + border: 1px solid var(--line); + border-radius: var(--radius); + padding: 1.25rem; +} + +.topics-panel form { + display: flex; + flex-wrap: wrap; + align-items: center; + gap: 0.5rem; + margin-top: 0.75rem; +} + +.topic-item { + padding: 0.5rem 0.6rem; + border-radius: var(--radius); + cursor: pointer; + font-size: 0.92rem; +} + +.topic-item:hover { + background: var(--brass-soft); +} + +.topic-item.selected { + background: var(--ink); + color: var(--surface); +} + +/* Outline buttons default to ink-on-transparent, which is invisible against + the dark background above — flip them to light-on-transparent here. */ +.topic-item.selected button[type="button"] { + color: var(--surface); + border-color: var(--surface); +} + +.topic-item.selected button[type="button"]:hover:not(:disabled) { + background: rgba(251, 250, 246, 0.15); +} + +/* ---- Tests page: page-level header + quiz card grid ---- */ + +.page-header { + display: flex; + align-items: center; + justify-content: space-between; + gap: 1rem; + margin-bottom: 1.5rem; +} + +.page-header h1 { + margin: 0; +} + +.quiz-cards { + display: grid; + grid-template-columns: repeat(auto-fill, minmax(240px, 1fr)); + gap: 1rem; +} + +/* Named `-manage-` to avoid colliding with the unrelated `.quiz-card` class + used by the student-facing Browse page (Quizzes/Browse/View.fs). */ +.quiz-manage-card { + display: flex; + flex-direction: column; + gap: 0.6rem; + background: var(--surface); + border: 1px solid var(--line); + border-radius: var(--radius); + padding: 1rem 1.25rem; + cursor: pointer; +} + +.quiz-manage-card:hover { + border-color: var(--brass); +} + +.quiz-manage-card.selected { + background: var(--ink); + color: var(--surface); + border-color: var(--ink); +} + +.quiz-manage-card-title { + margin: 0; +} + +.quiz-manage-card-actions { + display: flex; + flex-wrap: wrap; + gap: 0.5rem; + margin-top: auto; + padding-top: 0.4rem; +} + +.quiz-manage-card-actions button { + flex: 1 1 auto; +} + +/* Outline buttons default to ink-on-transparent, which is invisible against + the dark background of a selected card — flip them to light-on-transparent. */ +.quiz-manage-card.selected button[type="button"] { + color: var(--surface); + border-color: var(--surface); +} + +.quiz-manage-card.selected button[type="button"]:hover:not(:disabled) { + background: rgba(251, 250, 246, 0.15); +} + +/* ---- Tests page: results view (quiz cards shift into a narrow left + column, results table takes the rest) ---- */ + +.results-layout { + display: grid; + grid-template-columns: 320px 1fr; + gap: 2rem; + align-items: start; +} + +.results-table { + width: 100%; + border-collapse: collapse; + font-size: 0.9rem; +} + +.results-table th, +.results-table td { + text-align: left; + padding: 0.55rem 0.75rem; + border-bottom: 1px solid var(--line); +} + +.results-table th { + font-family: var(--font-mono); + font-size: 0.7rem; + letter-spacing: 0.04em; + text-transform: uppercase; + color: var(--ink-soft); +} + +.results-table tbody tr:hover { + background: var(--brass-soft); +} + +.focus-loss-value { + font-family: var(--font-mono); +} + +.focus-loss-value.warn { + color: var(--fail); + font-weight: 600; +} + +/* Compact, non-animated variant for the "Результат" column — the default + `.grade-stamp` is sized/rotated for the standalone result screen and + would overflow a table cell. */ +.results-table .grade-stamp { + font-size: 0.75rem; + border-width: 1px; + padding: 0.15rem 0.5rem; + margin: 0; + transform: none; + animation: none; +} + +.questions-list, +.assignment-panel { + background: var(--surface); + border: 1px solid var(--line); + border-radius: var(--radius); + padding: 1.25rem 1.5rem; + margin-bottom: 1.25rem; +} + +.questions-list li { + display: flex; + flex-wrap: wrap; + align-items: center; + gap: 0.5rem; + border-top: 1px solid var(--line); + padding: 0.6rem 0; +} + +.questions-list li:first-child { + border-top: none; +} + +.question-kind { + font-family: var(--font-mono); + font-size: 0.75rem; + color: var(--brass); + text-transform: uppercase; + letter-spacing: 0.03em; + margin-right: 0.5rem; +} + +.new-question-form { + background: var(--surface); + border: 1px solid var(--line); + border-radius: var(--radius); + padding: 1.25rem 1.5rem; +} + +.new-question-form > button + button { + margin-left: 0.5rem; +} + +.pool-picker { + display: flex; + flex-wrap: wrap; + align-items: center; + gap: 0.5rem; +} + +.pool-picker p { + flex-basis: 100%; + margin-bottom: 0; +} + +.question-picker input[type="text"] + button { + margin-left: 0.5rem; +} + +/* The global `form input:not([type=radio]):not([type=checkbox]) { width: + 100% }` rule outweighs a single class here, so this needs !important to + keep the field beside its button instead of stacking under it. */ +.pool-count-input { + display: inline-block !important; + width: 6rem !important; +} + +.pool-rules-summary li { + display: flex; + align-items: center; + justify-content: space-between; + gap: 0.75rem; + padding: 0.3rem 0; +} + +/* ---- Modal overlay (quiz create/edit form) ---- */ + +.modal-backdrop { + position: fixed; + inset: 0; + background: rgba(29, 35, 51, 0.55); + display: flex; + justify-content: center; + align-items: flex-start; + padding: 3rem 1.5rem; + overflow-y: auto; + z-index: 100; +} + +.modal-dialog { + width: 100%; + max-width: 560px; +} + +.modal-backdrop .new-question-form { + box-shadow: 0 20px 48px rgba(29, 35, 51, 0.3); +} + +.options-editor { + margin: 0.5rem 0 1rem; +} + +.option-row { + display: flex; + align-items: center; + gap: 0.5rem; + margin-bottom: 0.5rem; +} + +.option-row input[type="text"] { + flex: 1; +} + +.student-row { + display: flex; + align-items: center; + gap: 0.6rem; + padding: 0.4rem 0; + font-size: 0.92rem; + cursor: pointer; +} + +.student-row input { + width: auto; +} + +/* ---- Admin: users list ---- */ + +.users-list li { + display: flex; + flex-wrap: wrap; + align-items: center; + gap: 0.75rem; + border-top: 1px solid var(--line); + padding: 0.6rem 0; +} + +.users-list li:first-child { + border-top: none; +} + +.user-row-info { + display: flex; + flex-direction: column; + gap: 0.1rem; + flex: 1 1 200px; +} + +.user-row-name { + font-weight: 500; +} + +.user-row-badges { + display: flex; + flex-wrap: wrap; + gap: 0.4rem; + margin-top: 0.3rem; +} + +.user-row-actions { + display: flex; + flex-wrap: wrap; + gap: 0.5rem; + margin-left: auto; +} + +.status-badge { + font-family: var(--font-mono); + font-size: 0.72rem; + letter-spacing: 0.04em; + text-transform: uppercase; + border-radius: var(--radius); + padding: 0.15rem 0.5rem; +} + +.status-badge.active { + color: var(--pass); + background: var(--pass-bg); +} + +.status-badge.inactive { + color: var(--fail); + background: var(--fail-bg); +} + +/* ============================================================ + Accessibility & motion + ============================================================ */ +@media (prefers-reduced-motion: reduce) { + *, + *::before, + *::after { + animation-duration: 0.001ms !important; + animation-iteration-count: 1 !important; + transition-duration: 0.001ms !important; + } +} + +/* ============================================================ + Responsive + ============================================================ */ +@media (max-width: 640px) { + .teacher-layout, + .results-layout { + grid-template-columns: 1fr; + } + + .topbar { + padding: 0.75rem 1rem; + } + + .quiz-list-page, + .taking-quiz-page, + .result-page, + .teacher-home { + padding: 1.25rem 1rem 3rem; + } + + .quiz-actions { + margin: 0 -1rem; + padding: 1rem; + } +} diff --git a/src/Domain/Core/Attempts.fs b/src/Domain/Core/Attempts.fs new file mode 100644 index 0000000..90d4a1b --- /dev/null +++ b/src/Domain/Core/Attempts.fs @@ -0,0 +1,77 @@ +namespace Domain + +open System + +/// A student's raw answer to one question, shaped to match its QuestionType. +type StudentResponse = + | SingleChoiceResponse of OptionId option + | MultipleChoiceResponse of Set + | TrueFalseResponse of bool option + | ShortAnswerResponse of string + | NumericResponse of float option + +type AttemptState = + | InProgress + | Submitted + | Graded + +type QuestionGrade = + { QuestionId: QuestionId + PointsAwarded: float + MaxPoints: float + IsCorrect: bool } + +type Attempt = + { Id: AttemptId + QuizId: QuizId + UserId: UserId + StartedAt: DateTimeOffset + SubmittedAt: DateTimeOffset option + State: AttemptState + /// Snapshot of the specific questions dealt to this attempt, resolved + /// from the quiz's sources when it started — fixed questions pass + /// through as-is, random-pool sources are drawn fresh per attempt, so + /// this can differ between attempts of the same quiz. Grading always + /// reads this, never the quiz's sources directly. + Questions: QuizQuestionRef list + Responses: Map + Grades: Map + Score: float option + /// How many times the student's browser tab lost focus (switched tab, + /// minimized, alt-tabbed away) while this attempt was `InProgress` — + /// incremented server-side only (`reportFocusLoss`), never trusted from + /// the client directly, so it can't be gamed downward. Purely + /// informational for the teacher; the system takes no automatic action + /// on it. + FocusLossCount: int } + +module Attempt = + let start + (attemptId: AttemptId) + (quiz: Quiz) + (questions: QuizQuestionRef list) + (userId: UserId) + (now: DateTimeOffset) + : Attempt = + { Id = attemptId + QuizId = quiz.Id + UserId = userId + StartedAt = now + SubmittedAt = None + State = InProgress + Questions = questions + Responses = Map.empty + Grades = Map.empty + Score = None + FocusLossCount = 0 } + + let recordResponse (questionId: QuestionId) (response: StudentResponse) (attempt: Attempt) : Attempt = + { attempt with Responses = attempt.Responses |> Map.add questionId response } + + let submit (now: DateTimeOffset) (attempt: Attempt) : Attempt = + { attempt with State = Submitted; SubmittedAt = Some now } + + let isExpired (quiz: Quiz) (now: DateTimeOffset) (attempt: Attempt) : bool = + match quiz.TimeLimit with + | None -> false + | Some limit -> now - attempt.StartedAt > limit diff --git a/src/Domain/Core/Grading.fs b/src/Domain/Core/Grading.fs new file mode 100644 index 0000000..e30dd03 --- /dev/null +++ b/src/Domain/Core/Grading.fs @@ -0,0 +1,89 @@ +namespace Domain + +/// Pure grading logic: no I/O, no mutable state. Given a question's +/// correctness data and a student's response, decide the awarded points. +module Grading = + + let private floatEquals (tolerance: float) (a: float) (b: float) = abs (a - b) <= tolerance + + let private textEquals (caseSensitive: bool) (accepted: string list) (answer: string) = + let normalize (s: string) = + let trimmed = s.Trim() + if caseSensitive then trimmed else trimmed.ToLowerInvariant() + + let answerNorm = normalize answer + accepted |> List.exists (fun a -> normalize a = answerNorm) + + /// The response value representing "not answered" for a given question type, + /// used to grade skipped questions as incorrect rather than crashing. + let emptyResponseFor (questionType: QuestionType) : StudentResponse = + match questionType with + | SingleChoice _ -> SingleChoiceResponse None + | MultipleChoice _ -> MultipleChoiceResponse Set.empty + | TrueFalse _ -> TrueFalseResponse None + | ShortAnswer _ -> ShortAnswerResponse "" + | Numeric _ -> NumericResponse None + + let gradeResponse + (questionId: QuestionId) + (questionType: QuestionType) + (maxPoints: float) + (response: StudentResponse) + : QuestionGrade = + let award isCorrect = + { QuestionId = questionId + PointsAwarded = (if isCorrect then maxPoints else 0.0) + MaxPoints = maxPoints + IsCorrect = isCorrect } + + match questionType, response with + | SingleChoice(_, correct), SingleChoiceResponse(Some chosen) -> award (chosen = correct) + | SingleChoice _, SingleChoiceResponse None -> award false + | MultipleChoice(_, correct), MultipleChoiceResponse chosen -> award (chosen = correct) + | TrueFalse correct, TrueFalseResponse(Some chosen) -> award (chosen = correct) + | TrueFalse _, TrueFalseResponse None -> award false + | ShortAnswer(accepted, caseSensitive), ShortAnswerResponse answer -> award (textEquals caseSensitive accepted answer) + | Numeric(correct, tolerance), NumericResponse(Some value) -> award (floatEquals tolerance value correct) + | Numeric _, NumericResponse None -> award false + | _ -> award false // response shape doesn't match the question type + + /// Grades every question dealt to this attempt (its own `Questions` + /// snapshot, not the quiz's sources — those may be random-pool rules + /// resolved differently per attempt), treating any question the student + /// never answered as an incorrect (zero-point) response. + let gradeAttempt (questions: Map) (attempt: Attempt) : Attempt = + let grades = + attempt.Questions + |> List.choose (fun qref -> + match Map.tryFind qref.QuestionId questions with + | None -> None + | Some q -> + let response = + attempt.Responses + |> Map.tryFind qref.QuestionId + |> Option.defaultValue (emptyResponseFor q.Type) + + Some(qref.QuestionId, gradeResponse qref.QuestionId q.Type qref.Points response)) + |> Map.ofList + + let score = grades |> Map.toList |> List.sumBy (fun (_, g) -> g.PointsAwarded) + + { attempt with + State = Graded + Grades = grades + Score = Some score } + + /// Picks (or synthesizes) the attempt that represents the student's final + /// grade for a quiz, per the quiz's configured grading method. + let applyGradingMethod (method: GradingMethod) (attempts: Attempt list) : Attempt option = + let graded = attempts |> List.filter (fun a -> a.State = Graded) + + match method, graded with + | _, [] -> None + | HighestAttempt, xs -> xs |> List.maxBy (fun a -> defaultArg a.Score 0.0) |> Some + | FirstAttempt, xs -> xs |> List.minBy (fun a -> a.StartedAt) |> Some + | LastAttempt, xs -> xs |> List.maxBy (fun a -> a.StartedAt) |> Some + | AverageAttempt, xs -> + let avg = xs |> List.averageBy (fun a -> defaultArg a.Score 0.0) + let mostRecent = xs |> List.maxBy (fun a -> a.StartedAt) + Some { mostRecent with Score = Some avg } diff --git a/src/Domain/Core/Ids.fs b/src/Domain/Core/Ids.fs new file mode 100644 index 0000000..5023f0f --- /dev/null +++ b/src/Domain/Core/Ids.fs @@ -0,0 +1,29 @@ +namespace Domain + +open System + +[] +type UserId = UserId of Guid + +[] +type TopicId = TopicId of Guid + +[] +type QuestionId = QuestionId of Guid + +[] +type OptionId = OptionId of Guid + +[] +type QuizId = QuizId of Guid + +[] +type AttemptId = AttemptId of Guid + +module Id = + let newUserId () = UserId(Guid.NewGuid()) + let newTopicId () = TopicId(Guid.NewGuid()) + let newQuestionId () = QuestionId(Guid.NewGuid()) + let newOptionId () = OptionId(Guid.NewGuid()) + let newQuizId () = QuizId(Guid.NewGuid()) + let newAttemptId () = AttemptId(Guid.NewGuid()) diff --git a/src/Domain/Core/Questions.fs b/src/Domain/Core/Questions.fs new file mode 100644 index 0000000..1008607 --- /dev/null +++ b/src/Domain/Core/Questions.fs @@ -0,0 +1,22 @@ +namespace Domain + +type QuestionOption = + { Id: OptionId + Text: string } + +/// Type-specific correctness data. Each case is self-contained so the +/// grading engine never has to guess how to check an answer. +type QuestionType = + | SingleChoice of options: QuestionOption list * correctOptionId: OptionId + | MultipleChoice of options: QuestionOption list * correctOptionIds: Set + | TrueFalse of correctAnswer: bool + | ShortAnswer of acceptedAnswers: string list * caseSensitive: bool + | Numeric of correctValue: float * tolerance: float + +type Question = + { Id: QuestionId + TopicId: TopicId + Text: string + /// Default point value when used in a quiz; a quiz may override this per-question. + Points: float + Type: QuestionType } diff --git a/src/Domain/Core/Quizzes.fs b/src/Domain/Core/Quizzes.fs new file mode 100644 index 0000000..500dcdc --- /dev/null +++ b/src/Domain/Core/Quizzes.fs @@ -0,0 +1,54 @@ +namespace Domain + +open System + +type GradingMethod = + | HighestAttempt + | AverageAttempt + | FirstAttempt + | LastAttempt + +type QuizQuestionRef = + { QuestionId: QuestionId + /// Points awarded for this question within this specific quiz + /// (may differ from the question bank's default Points). + Points: float + Order: int } + +/// One line item of a quiz's composition: a specific bank question snapshot +/// at creation time, or a rule that draws `Count` random questions from +/// `TopicId` fresh at each attempt. Because the random case isn't resolved +/// until an attempt starts (and can differ between attempts of the same +/// quiz), the concrete set of questions actually served is snapshotted onto +/// the `Attempt` itself (see `Attempt.Questions`), never read back off the +/// quiz during grading. +type QuizQuestionSource = + | FixedQuestion of QuizQuestionRef + | RandomFromTopic of TopicId: TopicId * Count: int * Order: int + +type Quiz = + { Id: QuizId + OwnerId: UserId + Title: string + Description: string + TimeLimit: TimeSpan option + MaxAttempts: int option + GradingMethod: GradingMethod + ShuffleQuestions: bool + ShuffleAnswers: bool + OpenFrom: DateTimeOffset option + OpenTo: DateTimeOffset option + PassingScore: float option + QuestionSources: QuizQuestionSource list + AssignedStudentIds: Set } + +module Quiz = + let sourceOrder (source: QuizQuestionSource) = + match source with + | FixedQuestion r -> r.Order + | RandomFromTopic(_, _, order) -> order + + let isOpenAt (now: DateTimeOffset) (quiz: Quiz) = + let afterOpen = quiz.OpenFrom |> Option.forall (fun t -> now >= t) + let beforeClose = quiz.OpenTo |> Option.forall (fun t -> now <= t) + afterOpen && beforeClose diff --git a/src/Domain/Core/Topics.fs b/src/Domain/Core/Topics.fs new file mode 100644 index 0000000..cbd6f96 --- /dev/null +++ b/src/Domain/Core/Topics.fs @@ -0,0 +1,4 @@ +namespace Domain + +/// A private question-bank grouping owned by one Teacher/Admin. +type Topic = { Id: TopicId; OwnerId: UserId; Name: string } diff --git a/src/Domain/Core/Users.fs b/src/Domain/Core/Users.fs new file mode 100644 index 0000000..424d772 --- /dev/null +++ b/src/Domain/Core/Users.fs @@ -0,0 +1,14 @@ +namespace Domain + +type Role = + | Admin + | Teacher + | Student + +type User = + { Id: UserId + Name: string + Email: string + PasswordHash: string + Role: Role + IsActive: bool } diff --git a/src/Domain/Core/Validation.fs b/src/Domain/Core/Validation.fs new file mode 100644 index 0000000..73eb80a --- /dev/null +++ b/src/Domain/Core/Validation.fs @@ -0,0 +1,79 @@ +namespace Domain + +type ValidationError = string + +module QuestionValidation = + + let validate (question: Question) : Result = + let errors = ResizeArray() + + if System.String.IsNullOrWhiteSpace question.Text then + errors.Add "Question text must not be empty" + + if question.Points <= 0.0 then + errors.Add "Question points must be positive" + + match question.Type with + | SingleChoice(options, correct) -> + if options.Length < 2 then + errors.Add "Single choice question must have at least 2 options" + + if not (options |> List.exists (fun o -> o.Id = correct)) then + errors.Add "Correct option must be one of the provided options" + | MultipleChoice(options, correct) -> + if options.Length < 2 then + errors.Add "Multiple choice question must have at least 2 options" + + if correct.IsEmpty then + errors.Add "At least one correct option must be selected" + + let optionIds = options |> List.map (fun o -> o.Id) |> Set.ofList + + if not (Set.isSubset correct optionIds) then + errors.Add "Correct options must be a subset of the provided options" + | TrueFalse _ -> () + | ShortAnswer(accepted, _) -> + if accepted.IsEmpty then + errors.Add "At least one accepted answer must be provided" + | Numeric(_, tolerance) -> + if tolerance < 0.0 then + errors.Add "Tolerance must not be negative" + + if errors.Count = 0 then Ok question else Error(List.ofSeq errors) + +module QuizValidation = + + let validate (quiz: Quiz) : Result = + let errors = ResizeArray() + + if System.String.IsNullOrWhiteSpace quiz.Title then + errors.Add "Quiz title must not be empty" + + if quiz.QuestionSources.IsEmpty then + errors.Add "Quiz must contain at least one question" + + if + quiz.QuestionSources + |> List.exists (function + | FixedQuestion r -> r.Points <= 0.0 + | RandomFromTopic _ -> false) + then + errors.Add "All question point values must be positive" + + if + quiz.QuestionSources + |> List.exists (function + | RandomFromTopic(_, count, _) -> count <= 0 + | FixedQuestion _ -> false) + then + errors.Add "Random pool count must be positive" + + match quiz.MaxAttempts with + | Some n when n <= 0 -> errors.Add "MaxAttempts must be positive when specified" + | _ -> () + + match quiz.OpenFrom, quiz.OpenTo with + | Some f, Some t when f > t -> errors.Add "OpenFrom must be before OpenTo" + | _ -> () + + if errors.Count = 0 then Ok quiz else Error(List.ofSeq errors) diff --git a/src/Domain/Domain.fsproj b/src/Domain/Domain.fsproj new file mode 100644 index 0000000..76f81ef --- /dev/null +++ b/src/Domain/Domain.fsproj @@ -0,0 +1,39 @@ + + + + net9.0 + true + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + diff --git a/src/Domain/Features/AdminUsers.fs b/src/Domain/Features/AdminUsers.fs new file mode 100644 index 0000000..e5f6d02 --- /dev/null +++ b/src/Domain/Features/AdminUsers.fs @@ -0,0 +1,26 @@ +namespace Domain.Contracts + +open Domain + +type UserSummary = + { Id: UserId + Name: string + Email: string + Role: Role + IsActive: bool } + +type CreateUserRequest = + { Name: string + Email: string + Password: string + Role: Role } + +type UpdateUserRequest = + { Id: UserId + Name: string + Email: string + Role: Role } + +type SetUserActiveRequest = { Id: UserId; IsActive: bool } + +type ResetPasswordRequest = { Id: UserId; NewPassword: string } diff --git a/src/Domain/Features/AssignStudents.fs b/src/Domain/Features/AssignStudents.fs new file mode 100644 index 0000000..3e549fd --- /dev/null +++ b/src/Domain/Features/AssignStudents.fs @@ -0,0 +1,8 @@ +namespace Domain.Contracts + +open Domain + +/// Replaces the quiz's whole assigned-student set with `StudentIds`, rather +/// than adding/removing one at a time — matches the "tick checkboxes, Save" +/// UI in the Teacher "Tests" tab. +type AssignStudentsRequest = { QuizId: QuizId; StudentIds: UserId list } diff --git a/src/Domain/Features/CreateQuestion.fs b/src/Domain/Features/CreateQuestion.fs new file mode 100644 index 0000000..e9376c9 --- /dev/null +++ b/src/Domain/Features/CreateQuestion.fs @@ -0,0 +1,9 @@ +namespace Domain.Contracts + +open Domain + +type CreateQuestionRequest = + { TopicId: TopicId + Text: string + Points: float + Type: QuestionTypeView } diff --git a/src/Domain/Features/CreateQuiz.fs b/src/Domain/Features/CreateQuiz.fs new file mode 100644 index 0000000..31b076c --- /dev/null +++ b/src/Domain/Features/CreateQuiz.fs @@ -0,0 +1,18 @@ +namespace Domain.Contracts + +open Domain + +/// `Sources` order becomes each entry's `Order` in the quiz. For a +/// `FixedQuestionInput`, points are taken from the question bank at save +/// time, not sent by the client — no per-quiz point override in this +/// version. A `RandomPoolInput` has no points of its own: the actual +/// questions (and their bank points) are drawn fresh at each attempt. +type CreateQuizRequest = + { Title: string + Description: string + TimeLimitMinutes: int option + MaxAttempts: int option + PassingScore: float option + ShuffleQuestions: bool + ShuffleAnswers: bool + Sources: QuizQuestionSourceInput list } diff --git a/src/Domain/Features/CreateTopic.fs b/src/Domain/Features/CreateTopic.fs new file mode 100644 index 0000000..7099c1c --- /dev/null +++ b/src/Domain/Features/CreateTopic.fs @@ -0,0 +1,3 @@ +namespace Domain.Contracts + +type CreateTopicRequest = { Name: string } diff --git a/src/Domain/Features/DeleteQuestion.fs b/src/Domain/Features/DeleteQuestion.fs new file mode 100644 index 0000000..10356e6 --- /dev/null +++ b/src/Domain/Features/DeleteQuestion.fs @@ -0,0 +1,5 @@ +namespace Domain.Contracts + +open Domain + +type DeleteQuestionRequest = { QuestionId: QuestionId } diff --git a/src/Domain/Features/DeleteQuiz.fs b/src/Domain/Features/DeleteQuiz.fs new file mode 100644 index 0000000..77b6f18 --- /dev/null +++ b/src/Domain/Features/DeleteQuiz.fs @@ -0,0 +1,5 @@ +namespace Domain.Contracts + +open Domain + +type DeleteQuizRequest = { QuizId: QuizId } diff --git a/src/Domain/Features/FinishAttempt.fs b/src/Domain/Features/FinishAttempt.fs new file mode 100644 index 0000000..a97b50f --- /dev/null +++ b/src/Domain/Features/FinishAttempt.fs @@ -0,0 +1,11 @@ +namespace Domain.Contracts + +open Domain + +type AttemptResult = + { AttemptId: AttemptId + Score: float + MaxScore: float + Passed: bool option } + +type FinishAttemptRequest = { AttemptId: AttemptId } diff --git a/src/Domain/Features/GetAvailableQuizzes.fs b/src/Domain/Features/GetAvailableQuizzes.fs new file mode 100644 index 0000000..be2e741 --- /dev/null +++ b/src/Domain/Features/GetAvailableQuizzes.fs @@ -0,0 +1,21 @@ +namespace Domain.Contracts + +open Domain + +type QuizSummary = + { Id: QuizId + Title: string + Description: string + TotalPoints: float + TimeLimitMinutes: int option + MaxAttempts: int option + /// How many of this student's own attempts have been graded — lets the + /// client show a "view results" entry point only when there's + /// something to show, without a separate round-trip per quiz. + AttemptsCount: int + /// True once any of this student's graded attempts cleared + /// `Quiz.PassingScore` — always `false` for a quiz with no passing + /// score set, since there's no bar to clear. `startAttempt` refuses to + /// start a new attempt once this is true, regardless of `MaxAttempts` + /// remaining (see `StartAttempt.fs`). + AlreadyPassed: bool } diff --git a/src/Domain/Features/GetMyAttempts.fs b/src/Domain/Features/GetMyAttempts.fs new file mode 100644 index 0000000..c94890f --- /dev/null +++ b/src/Domain/Features/GetMyAttempts.fs @@ -0,0 +1,15 @@ +namespace Domain.Contracts + +open System +open Domain + +/// One of the student's own past attempts at a quiz — only graded attempts +/// are ever returned (an abandoned in-progress attempt has nothing to show). +type MyAttemptSummary = + { AttemptId: AttemptId + StartedAt: DateTimeOffset + Score: float + MaxScore: float + Passed: bool option } + +type GetMyAttemptsRequest = { QuizId: QuizId } diff --git a/src/Domain/Features/GetQuizResults.fs b/src/Domain/Features/GetQuizResults.fs new file mode 100644 index 0000000..5b9f0e4 --- /dev/null +++ b/src/Domain/Features/GetQuizResults.fs @@ -0,0 +1,29 @@ +namespace Domain.Contracts + +open System +open Domain + +/// One assigned student's standing on a quiz. `BestScore`/`MaxScore`/`Passed` +/// describe whichever attempt the quiz's `GradingMethod` selects as official +/// (not necessarily the highest-scoring one, depending on that setting) — +/// they're `None` when the student has no graded attempts yet, which is +/// still worth showing the teacher, not just who has attempted it. +type StudentQuizResult = + { StudentId: UserId + StudentName: string + StudentEmail: string + AttemptsCount: int + BestScore: float option + MaxScore: float option + Passed: bool option + /// When the student's most recent *successful* attempt was submitted — + /// "successful" means passed `Quiz.PassingScore` if the quiz has one, + /// otherwise any graded attempt counts (there's no pass/fail bar to + /// clear). `None` when they have no attempt meeting that bar yet. + LastSuccessfulAttemptAt: DateTimeOffset option + /// `FocusLossCount` of the single most recent attempt (by submit time), + /// regardless of whether it passed — the anti-cheating signal is about + /// what just happened, not diluted by averaging across older attempts. + LastAttemptFocusLossCount: int } + +type GetQuizResultsRequest = { QuizId: QuizId } diff --git a/src/Domain/Features/ListMyQuizzes.fs b/src/Domain/Features/ListMyQuizzes.fs new file mode 100644 index 0000000..75c97a5 --- /dev/null +++ b/src/Domain/Features/ListMyQuizzes.fs @@ -0,0 +1,33 @@ +namespace Domain.Contracts + +open Domain + +/// A rule that draws `Count` random questions from `TopicId` at each +/// attempt, rather than a fixed question id. +type RandomPoolRule = { TopicId: TopicId; Count: int } + +/// One line item of a quiz's composition as seen over the wire — reused both +/// as the client's request when creating/updating a quiz (`CreateQuiz.fs`, +/// `UpdateQuiz.fs`) and as part of `QuizAdminSummary` below, since the shape +/// is identical in both directions. +type QuizQuestionSourceInput = + | FixedQuestionInput of QuestionId + | RandomPoolInput of RandomPoolRule + +/// `AssignedStudentIds` travels as a plain list, not `Set` — the same trick +/// already used for `CorrectOptionIds` in `QuestionTypeView` (`ListQuestions.fs`): +/// avoids relying on an unverified `Set` encoding in Fable.Remoting.Json. +type QuizAdminSummary = + { Id: QuizId + Title: string + Description: string + TimeLimitMinutes: int option + MaxAttempts: int option + PassingScore: float option + ShuffleQuestions: bool + ShuffleAnswers: bool + /// Ordered sources (fixed question ids or random-pool rules) — enough + /// to pre-check already-selected questions and already-configured pool + /// rules in the quiz edit form while browsing any topic in the picker. + Sources: QuizQuestionSourceInput list + AssignedStudentIds: UserId list } diff --git a/src/Domain/Features/ListQuestions.fs b/src/Domain/Features/ListQuestions.fs new file mode 100644 index 0000000..20729e7 --- /dev/null +++ b/src/Domain/Features/ListQuestions.fs @@ -0,0 +1,29 @@ +namespace Domain.Contracts + +open Domain + +/// Teacher-facing view of a question's type-specific data — like +/// `QuestionViewKind` (`StartAttempt.fs`), but correct-answer data isn't +/// hidden since the author is allowed to see it. Each case wraps exactly one +/// record field (never several positional fields) so it round-trips through +/// Fable.Remoting.Json the same way `QuestionViewKind` already does. +type SingleChoiceData = { Options: QuestionOption list; CorrectOptionId: OptionId } +type MultipleChoiceData = { Options: QuestionOption list; CorrectOptionIds: OptionId list } +type ShortAnswerData = { AcceptedAnswers: string list; CaseSensitive: bool } +type NumericData = { CorrectValue: float; Tolerance: float } + +type QuestionTypeView = + | SingleChoiceT of SingleChoiceData + | MultipleChoiceT of MultipleChoiceData + | TrueFalseT of bool + | ShortAnswerT of ShortAnswerData + | NumericT of NumericData + +type QuestionSummary = + { Id: QuestionId + TopicId: TopicId + Text: string + Points: float + Type: QuestionTypeView } + +type ListQuestionsRequest = { TopicId: TopicId } diff --git a/src/Domain/Features/ListStudents.fs b/src/Domain/Features/ListStudents.fs new file mode 100644 index 0000000..39a7193 --- /dev/null +++ b/src/Domain/Features/ListStudents.fs @@ -0,0 +1,5 @@ +namespace Domain.Contracts + +open Domain + +type StudentSummary = { Id: UserId; Name: string; Email: string } diff --git a/src/Domain/Features/Login.fs b/src/Domain/Features/Login.fs new file mode 100644 index 0000000..9bd05bf --- /dev/null +++ b/src/Domain/Features/Login.fs @@ -0,0 +1,11 @@ +namespace Domain.Contracts + +open Domain + +type LoginRequest = { Email: string; Password: string } + +type LoginResponse = + { Token: string + UserId: UserId + Name: string + Role: Role } diff --git a/src/Domain/Features/ReportFocusLoss.fs b/src/Domain/Features/ReportFocusLoss.fs new file mode 100644 index 0000000..974adee --- /dev/null +++ b/src/Domain/Features/ReportFocusLoss.fs @@ -0,0 +1,10 @@ +namespace Domain.Contracts + +open Domain + +/// No value carried besides which attempt — the server increments its own +/// counter rather than accepting a client-supplied number, so a student +/// can't report a lower count than actually happened (they can at most +/// under-report by not calling this at all, never claim fewer losses than +/// the server already counted). +type ReportFocusLossRequest = { AttemptId: AttemptId } diff --git a/src/Domain/Features/StartAttempt.fs b/src/Domain/Features/StartAttempt.fs new file mode 100644 index 0000000..1cdf5e8 --- /dev/null +++ b/src/Domain/Features/StartAttempt.fs @@ -0,0 +1,31 @@ +namespace Domain.Contracts + +open System +open Domain + +/// Question shape sent to a student taking a quiz — never includes the +/// correct-answer data that lives in the server-side QuestionType. +type QuestionViewKind = + | SingleChoiceView of options: (OptionId * string) list + | MultipleChoiceView of options: (OptionId * string) list + | TrueFalseView + | ShortAnswerView + | NumericView + +type QuestionView = + { Id: QuestionId + Text: string + Points: float + Kind: QuestionViewKind } + +type QuizForAttempt = + { AttemptId: AttemptId + Quiz: QuizSummary + /// When this attempt began, per the server clock — the client combines + /// this with `Quiz.TimeLimitMinutes` to show a countdown. This is a + /// display convenience only; the server does not yet enforce the time + /// limit itself (see DESIGN.md §3.6 on the still-unbuilt expiry check). + StartedAt: DateTimeOffset + Questions: QuestionView list } + +type StartAttemptRequest = { QuizId: QuizId } diff --git a/src/Domain/Features/SubmitAnswer.fs b/src/Domain/Features/SubmitAnswer.fs new file mode 100644 index 0000000..9be4b17 --- /dev/null +++ b/src/Domain/Features/SubmitAnswer.fs @@ -0,0 +1,8 @@ +namespace Domain.Contracts + +open Domain + +type SubmitAnswerRequest = + { AttemptId: AttemptId + QuestionId: QuestionId + Response: StudentResponse } diff --git a/src/Domain/Features/UpdateQuestion.fs b/src/Domain/Features/UpdateQuestion.fs new file mode 100644 index 0000000..1ad32b8 --- /dev/null +++ b/src/Domain/Features/UpdateQuestion.fs @@ -0,0 +1,9 @@ +namespace Domain.Contracts + +open Domain + +type UpdateQuestionRequest = + { QuestionId: QuestionId + Text: string + Points: float + Type: QuestionTypeView } diff --git a/src/Domain/Features/UpdateQuiz.fs b/src/Domain/Features/UpdateQuiz.fs new file mode 100644 index 0000000..6f5f63e --- /dev/null +++ b/src/Domain/Features/UpdateQuiz.fs @@ -0,0 +1,14 @@ +namespace Domain.Contracts + +open Domain + +type UpdateQuizRequest = + { QuizId: QuizId + Title: string + Description: string + TimeLimitMinutes: int option + MaxAttempts: int option + PassingScore: float option + ShuffleQuestions: bool + ShuffleAnswers: bool + Sources: QuizQuestionSourceInput list } diff --git a/src/Server/Auth.fs b/src/Server/Auth.fs new file mode 100644 index 0000000..4b71d72 --- /dev/null +++ b/src/Server/Auth.fs @@ -0,0 +1,79 @@ +module Server.Auth + +open System +open System.Security.Claims +open System.Text +open System.IdentityModel.Tokens.Jwt +open Microsoft.IdentityModel.Tokens +open Domain + +let private issuer = "quizsystem" +let private audience = "quizsystem-client" + +let private signingKey (secret: string) = SymmetricSecurityKey(Encoding.UTF8.GetBytes secret) + +let issueToken (secret: string) (user: User) : string = + let creds = SigningCredentials(signingKey secret, SecurityAlgorithms.HmacSha256) + let (UserId rawId) = user.Id + + let claims = + [| Claim(JwtRegisteredClaimNames.Sub, string rawId) + Claim(ClaimTypes.Name, user.Name) + Claim(ClaimTypes.Email, user.Email) + Claim(ClaimTypes.Role, string user.Role) |] + + let token = + JwtSecurityToken( + issuer = issuer, + audience = audience, + claims = claims, + expires = DateTime.UtcNow.AddHours 8.0, + signingCredentials = creds + ) + + JwtSecurityTokenHandler().WriteToken token + +let tokenValidationParameters (secret: string) = + TokenValidationParameters( + ValidateIssuer = true, + ValidIssuer = issuer, + ValidateAudience = true, + ValidAudience = audience, + ValidateIssuerSigningKey = true, + IssuerSigningKey = signingKey secret, + ValidateLifetime = true, + ClockSkew = TimeSpan.FromMinutes 1.0 + ) + +let tryGetUserId (principal: ClaimsPrincipal) : UserId option = + match principal.FindFirst(JwtRegisteredClaimNames.Sub) with + | null -> None + | claim -> + match Guid.TryParse claim.Value with + | true, guid -> Some(UserId guid) + | false, _ -> None + +/// Shared by every handler that requires a signed-in user, so each feature +/// doesn't repeat its own "Требуется авторизация" error text. +let requireUserId (principal: ClaimsPrincipal) : Result = + match tryGetUserId principal with + | Some uid -> Ok uid + | None -> Error "Требуется авторизация" + +let private tryGetRole (principal: ClaimsPrincipal) : Role option = + match principal.FindFirst(ClaimTypes.Role) with + | null -> None + | claim -> + match claim.Value with + | "Admin" -> Some Admin + | "Teacher" -> Some Teacher + | "Student" -> Some Student + | _ -> None + +/// Like `requireUserId`, but also checks the JWT's role claim is one of +/// `allowed` — used by Teacher/Admin-only handlers. +let requireRole (allowed: Role list) (principal: ClaimsPrincipal) : Result = + match tryGetUserId principal, tryGetRole principal with + | Some uid, Some role when List.contains role allowed -> Ok uid + | Some _, Some _ -> Error "Доступ запрещён" + | _ -> Error "Требуется авторизация" diff --git a/src/Server/Db/AttemptRepository.fs b/src/Server/Db/AttemptRepository.fs new file mode 100644 index 0000000..a24c4fb --- /dev/null +++ b/src/Server/Db/AttemptRepository.fs @@ -0,0 +1,343 @@ +module Server.Db.AttemptRepository + +open System +open Dapper +open Npgsql +open Domain +open Server.Db.Connection + +[] +type private AttemptRow = + { Id: AttemptId + QuizId: QuizId + UserId: UserId + StartedAt: DateTimeOffset + SubmittedAt: DateTimeOffset Nullable + State: AttemptState + Score: float Nullable + FocusLossCount: int } + +[] +type private AttemptQuestionRow = { QuestionId: QuestionId; Points: float; OrderIndex: int } + +[] +type private ResponseDiscriminatorRow = { QuestionId: QuestionId; ResponseType: string } + +// `SelectedOptionId` is nullable *and* custom-typed — stored as a raw Guid +// here and wrapped to OptionId manually, sidestepping any uncertainty about +// whether Dapper applies a TypeHandler through a Nullable property. +[] +type private SingleChoiceResponseRow = { QuestionId: QuestionId; SelectedOptionId: Guid Nullable } + +[] +type private MultipleChoiceResponseRow = { QuestionId: QuestionId; OptionId: OptionId } + +[] +type private TrueFalseResponseRow = { QuestionId: QuestionId; Answer: bool Nullable } + +[] +type private ShortAnswerResponseRow = { QuestionId: QuestionId; AnswerText: string } + +[] +type private NumericResponseRow = { QuestionId: QuestionId; Value: float Nullable } + +[] +type private GradeRow = + { QuestionId: QuestionId + PointsAwarded: float + MaxPoints: float + IsCorrect: bool } + +let private attemptSelectColumns = + "id AS Id, quiz_id AS QuizId, user_id AS UserId, started_at AS StartedAt, + submitted_at AS SubmittedAt, state AS State, score AS Score, focus_loss_count AS FocusLossCount" + +let private loadQuestions (conn: NpgsqlConnection) (attemptId: AttemptId) : QuizQuestionRef list = + conn.Query( + "SELECT question_id AS QuestionId, points AS Points, order_index AS OrderIndex FROM attempt_questions WHERE attempt_id = @AttemptId ORDER BY order_index", + {| AttemptId = attemptId |} + ) + |> Seq.map (fun r -> { QuestionId = r.QuestionId; Points = r.Points; Order = r.OrderIndex }) + |> List.ofSeq + +let private loadResponses (conn: NpgsqlConnection) (attemptId: AttemptId) : Map = + let discriminators = + conn.Query( + "SELECT question_id AS QuestionId, response_type AS ResponseType FROM attempt_responses WHERE attempt_id = @AttemptId", + {| AttemptId = attemptId |} + ) + |> List.ofSeq + + if discriminators.IsEmpty then + Map.empty + else + let singleChoice = + conn.Query( + "SELECT question_id AS QuestionId, selected_option_id AS SelectedOptionId FROM attempt_response_single_choice WHERE attempt_id = @AttemptId", + {| AttemptId = attemptId |} + ) + |> Seq.map (fun r -> r.QuestionId, r.SelectedOptionId |> Option.ofNullable |> Option.map OptionId) + |> dict + + let multipleChoice = + conn.Query( + "SELECT question_id AS QuestionId, option_id AS OptionId FROM attempt_response_multiple_choice WHERE attempt_id = @AttemptId", + {| AttemptId = attemptId |} + ) + |> Seq.groupBy (fun r -> r.QuestionId) + |> Seq.map (fun (qid, rs) -> qid, rs |> Seq.map (fun r -> r.OptionId) |> Set.ofSeq) + |> dict + + let trueFalse = + conn.Query( + "SELECT question_id AS QuestionId, answer AS Answer FROM attempt_response_true_false WHERE attempt_id = @AttemptId", + {| AttemptId = attemptId |} + ) + |> Seq.map (fun r -> r.QuestionId, r.Answer |> Option.ofNullable) + |> dict + + let shortAnswer = + conn.Query( + "SELECT question_id AS QuestionId, answer_text AS AnswerText FROM attempt_response_short_answer WHERE attempt_id = @AttemptId", + {| AttemptId = attemptId |} + ) + |> Seq.map (fun r -> r.QuestionId, r.AnswerText) + |> dict + + let numeric = + conn.Query( + "SELECT question_id AS QuestionId, value AS Value FROM attempt_response_numeric WHERE attempt_id = @AttemptId", + {| AttemptId = attemptId |} + ) + |> Seq.map (fun r -> r.QuestionId, r.Value |> Option.ofNullable) + |> dict + + discriminators + |> List.map (fun d -> + let response = + match d.ResponseType with + | "SingleChoiceResponse" -> SingleChoiceResponse singleChoice.[d.QuestionId] + | "MultipleChoiceResponse" -> + match multipleChoice.TryGetValue d.QuestionId with + | true, s -> MultipleChoiceResponse s + | false, _ -> MultipleChoiceResponse Set.empty + | "TrueFalseResponse" -> TrueFalseResponse trueFalse.[d.QuestionId] + | "ShortAnswerResponse" -> ShortAnswerResponse shortAnswer.[d.QuestionId] + | "NumericResponse" -> NumericResponse numeric.[d.QuestionId] + | other -> failwithf "Unknown response_type '%s'" other + + d.QuestionId, response) + |> Map.ofList + +let private loadGrades (conn: NpgsqlConnection) (attemptId: AttemptId) : Map = + conn.Query( + "SELECT question_id AS QuestionId, points_awarded AS PointsAwarded, max_points AS MaxPoints, is_correct AS IsCorrect FROM attempt_grades WHERE attempt_id = @AttemptId", + {| AttemptId = attemptId |} + ) + |> Seq.map (fun r -> + let grade: QuestionGrade = + { QuestionId = r.QuestionId + PointsAwarded = r.PointsAwarded + MaxPoints = r.MaxPoints + IsCorrect = r.IsCorrect } + + r.QuestionId, grade) + |> Map.ofSeq + +let private assembleAttempt (conn: NpgsqlConnection) (row: AttemptRow) : Attempt = + { Id = row.Id + QuizId = row.QuizId + UserId = row.UserId + StartedAt = row.StartedAt + SubmittedAt = row.SubmittedAt |> Option.ofNullable + State = row.State + Questions = loadQuestions conn row.Id + Responses = loadResponses conn row.Id + Grades = loadGrades conn row.Id + Score = row.Score |> Option.ofNullable + FocusLossCount = row.FocusLossCount } + +let private toResponseDiscriminator (r: StudentResponse) : string = + match r with + | SingleChoiceResponse _ -> "SingleChoiceResponse" + | MultipleChoiceResponse _ -> "MultipleChoiceResponse" + | TrueFalseResponse _ -> "TrueFalseResponse" + | ShortAnswerResponse _ -> "ShortAnswerResponse" + | NumericResponse _ -> "NumericResponse" + +/// Upserts the scalar `attempts` row, then delete-then-reinserts its question +/// snapshot, responses, and grades — same full-replace semantics the +/// in-memory Store already has (`SaveAttempt` is called after every answer +/// and again at finish/grade time, always with the complete attempt). +let saveAttempt (connString: string) (attempt: Attempt) : unit = + use conn = openConnection connString + use tx = conn.BeginTransaction() + + // `focus_loss_count` is set on INSERT (a fresh attempt always starts at + // 0) but deliberately left out of the `DO UPDATE SET` list below. + // `reportFocusLoss` writes that column with its own atomic + // `UPDATE ... SET focus_loss_count = focus_loss_count + 1`, outside this + // load-mutate-save round trip — if this upsert also overwrote the column + // from `attempt.FocusLossCount` (whatever value was in memory when this + // particular save started), a focus-loss reported concurrently with an + // answer submission could get silently clobbered back to a stale count. + conn.Execute( + """INSERT INTO attempts (id, quiz_id, user_id, started_at, submitted_at, state, score, focus_loss_count) + VALUES (@Id, @QuizId, @UserId, @StartedAt, @SubmittedAt, @State, @Score, @FocusLossCount) + ON CONFLICT (id) DO UPDATE SET + submitted_at = EXCLUDED.submitted_at, state = EXCLUDED.state, score = EXCLUDED.score""", + {| Id = attempt.Id + QuizId = attempt.QuizId + UserId = attempt.UserId + StartedAt = attempt.StartedAt + SubmittedAt = attempt.SubmittedAt |> Option.toNullable + State = attempt.State + Score = attempt.Score |> Option.toNullable + FocusLossCount = attempt.FocusLossCount |}, + tx + ) + |> ignore + + conn.Execute("DELETE FROM attempt_questions WHERE attempt_id = @Id", {| Id = attempt.Id |}, tx) + |> ignore + + attempt.Questions + |> List.iter (fun q -> + conn.Execute( + "INSERT INTO attempt_questions (attempt_id, question_id, points, order_index) VALUES (@AttemptId, @QuestionId, @Points, @OrderIndex)", + {| AttemptId = attempt.Id + QuestionId = q.QuestionId + Points = q.Points + OrderIndex = q.Order |}, + tx + ) + |> ignore) + + // The 5 attempt_response_* detail tables cascade from attempt_responses. + conn.Execute("DELETE FROM attempt_responses WHERE attempt_id = @Id", {| Id = attempt.Id |}, tx) + |> ignore + + attempt.Responses + |> Map.iter (fun questionId response -> + conn.Execute( + "INSERT INTO attempt_responses (attempt_id, question_id, response_type) VALUES (@AttemptId, @QuestionId, @ResponseType)", + {| AttemptId = attempt.Id + QuestionId = questionId + ResponseType = toResponseDiscriminator response |}, + tx + ) + |> ignore + + match response with + | SingleChoiceResponse optId -> + conn.Execute( + "INSERT INTO attempt_response_single_choice (attempt_id, question_id, selected_option_id) VALUES (@AttemptId, @QuestionId, @SelectedOptionId)", + {| AttemptId = attempt.Id + QuestionId = questionId + SelectedOptionId = optId |> Option.map (fun (OptionId g) -> g) |> Option.toNullable |}, + tx + ) + |> ignore + | MultipleChoiceResponse optIds -> + optIds + |> Set.iter (fun optId -> + conn.Execute( + "INSERT INTO attempt_response_multiple_choice (attempt_id, question_id, option_id) VALUES (@AttemptId, @QuestionId, @OptionId)", + {| AttemptId = attempt.Id; QuestionId = questionId; OptionId = optId |}, + tx + ) + |> ignore) + | TrueFalseResponse value -> + conn.Execute( + "INSERT INTO attempt_response_true_false (attempt_id, question_id, answer) VALUES (@AttemptId, @QuestionId, @Answer)", + {| AttemptId = attempt.Id + QuestionId = questionId + Answer = value |> Option.toNullable |}, + tx + ) + |> ignore + | ShortAnswerResponse text -> + conn.Execute( + "INSERT INTO attempt_response_short_answer (attempt_id, question_id, answer_text) VALUES (@AttemptId, @QuestionId, @AnswerText)", + {| AttemptId = attempt.Id; QuestionId = questionId; AnswerText = text |}, + tx + ) + |> ignore + | NumericResponse value -> + conn.Execute( + "INSERT INTO attempt_response_numeric (attempt_id, question_id, value) VALUES (@AttemptId, @QuestionId, @Value)", + {| AttemptId = attempt.Id + QuestionId = questionId + Value = value |> Option.toNullable |}, + tx + ) + |> ignore) + + conn.Execute("DELETE FROM attempt_grades WHERE attempt_id = @Id", {| Id = attempt.Id |}, tx) + |> ignore + + attempt.Grades + |> Map.iter (fun questionId grade -> + conn.Execute( + "INSERT INTO attempt_grades (attempt_id, question_id, points_awarded, max_points, is_correct) VALUES (@AttemptId, @QuestionId, @PointsAwarded, @MaxPoints, @IsCorrect)", + {| AttemptId = attempt.Id + QuestionId = questionId + PointsAwarded = grade.PointsAwarded + MaxPoints = grade.MaxPoints + IsCorrect = grade.IsCorrect |}, + tx + ) + |> ignore) + + tx.Commit() + +let tryGetAttempt (connString: string) (id: AttemptId) : Attempt option = + use conn = openConnection connString + + let row = + conn.QuerySingleOrDefault($"SELECT {attemptSelectColumns} FROM attempts WHERE id = @Id", {| Id = id |}) + + if box row = null then None else Some(assembleAttempt conn row) + +let attemptsForQuiz (connString: string) (quizId: QuizId) (userId: UserId) : Attempt list = + use conn = openConnection connString + + conn.Query( + $"SELECT {attemptSelectColumns} FROM attempts WHERE quiz_id = @QuizId AND user_id = @UserId", + {| QuizId = quizId; UserId = userId |} + ) + |> Seq.map (assembleAttempt conn) + |> List.ofSeq + +let anyAttemptsForQuiz (connString: string) (quizId: QuizId) : bool = + use conn = openConnection connString + conn.ExecuteScalar("SELECT EXISTS (SELECT 1 FROM attempts WHERE quiz_id = @QuizId)", {| QuizId = quizId |}) + +/// Ids of `InProgress` attempts whose quiz has a time limit that has already +/// passed — picked up by the background expiry sweeper (`ExpirySweeper.fs`) +/// for attempts nobody sent a follow-up request for (e.g. an abandoned tab). +let findExpiredInProgressAttemptIds (connString: string) : AttemptId list = + use conn = openConnection connString + + conn.Query( + """SELECT a.id + FROM attempts a + JOIN quizzes q ON q.id = a.quiz_id + WHERE a.state = 'InProgress' + AND q.time_limit IS NOT NULL + AND a.started_at + q.time_limit < now()""" + ) + |> List.ofSeq + +/// Atomic, so it can't race with `saveAttempt`'s full-record upsert (see the +/// comment there) or with itself under rapid-fire blur/visibilitychange +/// events. Scoped to `InProgress` so a request that arrives just after the +/// attempt was graded doesn't keep bumping the count. +let incrementFocusLoss (connString: string) (attemptId: AttemptId) : unit = + use conn = openConnection connString + + conn.Execute( + "UPDATE attempts SET focus_loss_count = focus_loss_count + 1 WHERE id = @Id AND state = 'InProgress'", + {| Id = attemptId |} + ) + |> ignore diff --git a/src/Server/Db/Connection.fs b/src/Server/Db/Connection.fs new file mode 100644 index 0000000..d09205f --- /dev/null +++ b/src/Server/Db/Connection.fs @@ -0,0 +1,8 @@ +module Server.Db.Connection + +open Npgsql + +let openConnection (connectionString: string) : NpgsqlConnection = + let conn = new NpgsqlConnection(connectionString) + conn.Open() + conn diff --git a/src/Server/Db/Migrator.fs b/src/Server/Db/Migrator.fs new file mode 100644 index 0000000..40ffc1a --- /dev/null +++ b/src/Server/Db/Migrator.fs @@ -0,0 +1,35 @@ +module Server.Db.Migrator + +open System +open System.Reflection +open System.Threading +open DbUp + +/// Applies every embedded `Migrations/*.sql` script against `connectionString`, +/// tracked in DbUp's own journal table so re-running is a no-op once a script +/// has been applied. Called at server startup, before the app starts serving, +/// so a broken migration fails fast instead of running against a stale schema. +/// Retries a few times with a short delay — only matters for the Docker +/// cold-start case, where Postgres can report "healthy" moments before it's +/// actually ready to accept connections. +let run (connectionString: string) = + let upgrader = + DeployChanges.To + .PostgresqlDatabase(connectionString) + .WithScriptsEmbeddedInAssembly(Assembly.GetExecutingAssembly()) + .LogToConsole() + .Build() + + let rec attempt triesLeft = + let result = upgrader.PerformUpgrade() + + if result.Successful then + () + elif triesLeft > 1 then + printfn "Migration attempt failed (%s), retrying…" result.Error.Message + Thread.Sleep(TimeSpan.FromSeconds 2.0) + attempt (triesLeft - 1) + else + failwithf "Migration failed: %s" (string result.Error) + + attempt 5 diff --git a/src/Server/Db/QuestionRepository.fs b/src/Server/Db/QuestionRepository.fs new file mode 100644 index 0000000..ed92493 --- /dev/null +++ b/src/Server/Db/QuestionRepository.fs @@ -0,0 +1,309 @@ +module Server.Db.QuestionRepository + +open Dapper +open Npgsql +open Domain +open Server.Db.Connection + +// [] throughout — see QuizRepository.fs for why (Dapper's +// constructor-matching materialization doesn't reliably handle `Nullable<'T>` +// columns; applying it uniformly avoids depending on which path Dapper picks). +[] +type private QuestionRow = + { Id: QuestionId + TopicId: TopicId + Text: string + Points: float + QuestionType: string } + +[] +type private OptionRow = { QuestionId: QuestionId; Id: OptionId; Text: string } + +[] +type private NumericRow = { QuestionId: QuestionId; CorrectValue: float; Tolerance: float } + +[] +type private SingleChoiceCorrectRow = { QuestionId: QuestionId; CorrectOptionId: OptionId } + +[] +type private MultipleChoiceCorrectRow = { QuestionId: QuestionId; OptionId: OptionId } + +[] +type private TrueFalseRow = { QuestionId: QuestionId; CorrectAnswer: bool } + +[] +type private ShortAnswerHeaderRow = { QuestionId: QuestionId; CaseSensitive: bool } + +[] +type private ShortAnswerAcceptedRow = { QuestionId: QuestionId; AnswerText: string } + +let private questionSelectColumns = + "id AS Id, topic_id AS TopicId, text AS Text, points AS Points, question_type AS QuestionType" + +/// Batch-assembles full `Question`s from their scalar rows — one query per +/// detail table (filtered to just the ids that need it), not one query per +/// question, so listing N questions costs a handful of queries, not ~2N. +let private assembleQuestions (conn: NpgsqlConnection) (rows: QuestionRow list) : Question list = + if rows.IsEmpty then + [] + else + let ids = rows |> List.map (fun r -> r.Id) + + let optionsByQuestion = + conn.Query( + "SELECT question_id AS QuestionId, id AS Id, text AS Text FROM question_options WHERE question_id = ANY(@Ids) ORDER BY question_id, position", + {| Ids = ids |> List.map (fun (QuestionId g) -> g) |> List.toArray |} + ) + |> Seq.groupBy (fun o -> o.QuestionId) + |> Seq.map (fun (qid, opts) -> qid, opts |> Seq.map (fun o -> { Id = o.Id; Text = o.Text }) |> List.ofSeq) + |> dict + + let optionsFor qid = + match optionsByQuestion.TryGetValue qid with + | true, opts -> opts + | false, _ -> [] + + let singleChoiceCorrect = + conn.Query( + "SELECT question_id AS QuestionId, correct_option_id AS CorrectOptionId FROM question_single_choice WHERE question_id = ANY(@Ids)", + {| Ids = ids |> List.map (fun (QuestionId g) -> g) |> List.toArray |} + ) + |> Seq.map (fun r -> r.QuestionId, r.CorrectOptionId) + |> dict + + let multipleChoiceCorrect = + conn.Query( + "SELECT question_id AS QuestionId, option_id AS OptionId FROM question_multiple_choice_correct WHERE question_id = ANY(@Ids)", + {| Ids = ids |> List.map (fun (QuestionId g) -> g) |> List.toArray |} + ) + |> Seq.groupBy (fun r -> r.QuestionId) + |> Seq.map (fun (qid, rs) -> qid, rs |> Seq.map (fun r -> r.OptionId) |> Set.ofSeq) + |> dict + + let trueFalse = + conn.Query( + "SELECT question_id AS QuestionId, correct_answer AS CorrectAnswer FROM question_true_false WHERE question_id = ANY(@Ids)", + {| Ids = ids |> List.map (fun (QuestionId g) -> g) |> List.toArray |} + ) + |> Seq.map (fun r -> r.QuestionId, r.CorrectAnswer) + |> dict + + let shortAnswerCaseSensitive = + conn.Query( + "SELECT question_id AS QuestionId, case_sensitive AS CaseSensitive FROM question_short_answer WHERE question_id = ANY(@Ids)", + {| Ids = ids |> List.map (fun (QuestionId g) -> g) |> List.toArray |} + ) + |> Seq.map (fun r -> r.QuestionId, r.CaseSensitive) + |> dict + + let shortAnswerAccepted = + conn.Query( + "SELECT question_id AS QuestionId, answer_text AS AnswerText FROM question_short_answer_accepted WHERE question_id = ANY(@Ids) ORDER BY question_id, position", + {| Ids = ids |> List.map (fun (QuestionId g) -> g) |> List.toArray |} + ) + |> Seq.groupBy (fun r -> r.QuestionId) + |> Seq.map (fun (qid, rs) -> qid, rs |> Seq.map (fun r -> r.AnswerText) |> List.ofSeq) + |> dict + + let numeric = + conn.Query( + "SELECT question_id AS QuestionId, correct_value AS CorrectValue, tolerance AS Tolerance FROM question_numeric WHERE question_id = ANY(@Ids)", + {| Ids = ids |> List.map (fun (QuestionId g) -> g) |> List.toArray |} + ) + |> Seq.map (fun r -> r.QuestionId, r) + |> dict + + rows + |> List.map (fun row -> + let questionType = + match row.QuestionType with + | "SingleChoice" -> SingleChoice(optionsFor row.Id, singleChoiceCorrect.[row.Id]) + | "MultipleChoice" -> + let correct = + match multipleChoiceCorrect.TryGetValue row.Id with + | true, s -> s + | false, _ -> Set.empty + + MultipleChoice(optionsFor row.Id, correct) + | "TrueFalse" -> TrueFalse trueFalse.[row.Id] + | "ShortAnswer" -> + let accepted = + match shortAnswerAccepted.TryGetValue row.Id with + | true, a -> a + | false, _ -> [] + + ShortAnswer(accepted, shortAnswerCaseSensitive.[row.Id]) + | "Numeric" -> + let n = numeric.[row.Id] + Numeric(n.CorrectValue, n.Tolerance) + | other -> failwithf "Unknown question_type '%s'" other + + { Id = row.Id + TopicId = row.TopicId + Text = row.Text + Points = row.Points + Type = questionType }) + +let private toDiscriminator (t: QuestionType) : string = + match t with + | SingleChoice _ -> "SingleChoice" + | MultipleChoice _ -> "MultipleChoice" + | TrueFalse _ -> "TrueFalse" + | ShortAnswer _ -> "ShortAnswer" + | Numeric _ -> "Numeric" + +/// Upserts the scalar `questions` row, then delete-then-reinserts every +/// detail table for this question — matches the in-memory Store's existing +/// "always a full replace" semantics (no partial-update member exists today). +let addQuestion (connString: string) (question: Question) : unit = + use conn = openConnection connString + use tx = conn.BeginTransaction() + + conn.Execute( + """INSERT INTO questions (id, topic_id, text, points, question_type) + VALUES (@Id, @TopicId, @Text, @Points, @QuestionType) + ON CONFLICT (id) DO UPDATE SET + topic_id = EXCLUDED.topic_id, text = EXCLUDED.text, + points = EXCLUDED.points, question_type = EXCLUDED.question_type""", + {| Id = question.Id + TopicId = question.TopicId + Text = question.Text + Points = question.Points + QuestionType = toDiscriminator question.Type |}, + tx + ) + |> ignore + + // question_single_choice / question_multiple_choice_correct reference + // question_options rows (no ON DELETE CASCADE on that FK), so they must + // be cleared *before* question_options itself, not after. + conn.Execute("DELETE FROM question_single_choice WHERE question_id = @Id", {| Id = question.Id |}, tx) + |> ignore + + conn.Execute("DELETE FROM question_multiple_choice_correct WHERE question_id = @Id", {| Id = question.Id |}, tx) + |> ignore + + conn.Execute("DELETE FROM question_options WHERE question_id = @Id", {| Id = question.Id |}, tx) + |> ignore + + conn.Execute("DELETE FROM question_true_false WHERE question_id = @Id", {| Id = question.Id |}, tx) + |> ignore + // question_short_answer_accepted cascades from question_short_answer. + conn.Execute("DELETE FROM question_short_answer WHERE question_id = @Id", {| Id = question.Id |}, tx) + |> ignore + + conn.Execute("DELETE FROM question_numeric WHERE question_id = @Id", {| Id = question.Id |}, tx) + |> ignore + + let insertOptions (options: QuestionOption list) = + options + |> List.iteri (fun i opt -> + conn.Execute( + "INSERT INTO question_options (id, question_id, text, position) VALUES (@Id, @QuestionId, @Text, @Position)", + {| Id = opt.Id; QuestionId = question.Id; Text = opt.Text; Position = i |}, + tx + ) + |> ignore) + + match question.Type with + | SingleChoice(options, correctId) -> + insertOptions options + + conn.Execute( + "INSERT INTO question_single_choice (question_id, correct_option_id) VALUES (@QuestionId, @CorrectOptionId)", + {| QuestionId = question.Id; CorrectOptionId = correctId |}, + tx + ) + |> ignore + | MultipleChoice(options, correctIds) -> + insertOptions options + + correctIds + |> Set.iter (fun optId -> + conn.Execute( + "INSERT INTO question_multiple_choice_correct (question_id, option_id) VALUES (@QuestionId, @OptionId)", + {| QuestionId = question.Id; OptionId = optId |}, + tx + ) + |> ignore) + | TrueFalse value -> + conn.Execute( + "INSERT INTO question_true_false (question_id, correct_answer) VALUES (@QuestionId, @Value)", + {| QuestionId = question.Id; Value = value |}, + tx + ) + |> ignore + | ShortAnswer(accepted, caseSensitive) -> + conn.Execute( + "INSERT INTO question_short_answer (question_id, case_sensitive) VALUES (@QuestionId, @CaseSensitive)", + {| QuestionId = question.Id; CaseSensitive = caseSensitive |}, + tx + ) + |> ignore + + accepted + |> List.iteri (fun i text -> + conn.Execute( + "INSERT INTO question_short_answer_accepted (question_id, answer_text, position) VALUES (@QuestionId, @Text, @Position)", + {| QuestionId = question.Id; Text = text; Position = i |}, + tx + ) + |> ignore) + | Numeric(correctValue, tolerance) -> + conn.Execute( + "INSERT INTO question_numeric (question_id, correct_value, tolerance) VALUES (@QuestionId, @CorrectValue, @Tolerance)", + {| QuestionId = question.Id; CorrectValue = correctValue; Tolerance = tolerance |}, + tx + ) + |> ignore + + tx.Commit() + +let tryGetQuestion (connString: string) (id: QuestionId) : Question option = + use conn = openConnection connString + + let row = + conn.QuerySingleOrDefault($"SELECT {questionSelectColumns} FROM questions WHERE id = @Id", {| Id = id |}) + + if box row = null then None else assembleQuestions conn [ row ] |> List.tryHead + +let removeQuestion (connString: string) (id: QuestionId) : unit = + use conn = openConnection connString + conn.Execute("DELETE FROM questions WHERE id = @Id", {| Id = id |}) |> ignore + +let questionsByIds (connString: string) (ids: QuestionId seq) : Map = + let idList = ids |> List.ofSeq + + if idList.IsEmpty then + Map.empty + else + use conn = openConnection connString + + let rows = + conn.Query( + $"SELECT {questionSelectColumns} FROM questions WHERE id = ANY(@Ids)", + {| Ids = idList |> List.map (fun (QuestionId g) -> g) |> List.toArray |} + ) + |> List.ofSeq + + assembleQuestions conn rows |> List.map (fun q -> q.Id, q) |> Map.ofList + +let questionsByTopic (connString: string) (topicId: TopicId) : Question list = + use conn = openConnection connString + + let rows = + conn.Query($"SELECT {questionSelectColumns} FROM questions WHERE topic_id = @TopicId", {| TopicId = topicId |}) + |> List.ofSeq + + assembleQuestions conn rows + +/// Whether `questionId` is referenced by any quiz's fixed question sources. +/// Random-pool sources reference a topic, not a specific question, so they +/// never block a delete here even if the question lives in that topic. +let isQuestionUsed (connString: string) (questionId: QuestionId) : bool = + use conn = openConnection connString + + conn.ExecuteScalar( + "SELECT EXISTS (SELECT 1 FROM quiz_question_source_fixed WHERE question_id = @QuestionId)", + {| QuestionId = questionId |} + ) diff --git a/src/Server/Db/QuizRepository.fs b/src/Server/Db/QuizRepository.fs new file mode 100644 index 0000000..c21fe66 --- /dev/null +++ b/src/Server/Db/QuizRepository.fs @@ -0,0 +1,214 @@ +module Server.Db.QuizRepository + +open System +open Dapper +open Npgsql +open Domain +open Server.Db.Connection + +// [] gives these a parameterless constructor + settable +// properties, so Dapper materializes them via property-setting instead of +// constructor-matching — the latter doesn't reliably handle `Nullable<'T>` +// fields (confirmed by hand: it fails asking for the *non*-nullable +// signature instead of binding the nulls it just read). +[] +type private QuizRow = + { Id: QuizId + OwnerId: UserId + Title: string + Description: string + TimeLimit: TimeSpan Nullable + MaxAttempts: int Nullable + GradingMethod: GradingMethod + ShuffleQuestions: bool + ShuffleAnswers: bool + OpenFrom: DateTimeOffset Nullable + OpenTo: DateTimeOffset Nullable + PassingScore: float Nullable } + +[] +type private SourceHeaderRow = { Id: Guid; SourceType: string; OrderIndex: int } + +[] +type private FixedSourceRow = { SourceId: Guid; QuestionId: QuestionId; Points: float } + +[] +type private RandomSourceRow = { SourceId: Guid; TopicId: TopicId; Count: int } + +let private quizSelectColumns = + "id AS Id, owner_id AS OwnerId, title AS Title, description AS Description, time_limit AS TimeLimit, + max_attempts AS MaxAttempts, grading_method AS GradingMethod, shuffle_questions AS ShuffleQuestions, + shuffle_answers AS ShuffleAnswers, open_from AS OpenFrom, open_to AS OpenTo, passing_score AS PassingScore" + +/// Loads the ordered `QuizQuestionSource` list for one quiz: the header rows +/// first (id/type/order — no custom-typed nullable columns involved), then +/// one filtered query per detail table, merged in F#. Deliberately avoids a +/// single LEFT-JOIN-both-detail-tables query, since that would require +/// binding `Nullable`/`Nullable` through the custom +/// Dapper type handlers — untested territory not worth the risk here. +let private loadSources (conn: NpgsqlConnection) (quizId: QuizId) : QuizQuestionSource list = + let headers = + conn.Query( + "SELECT id AS Id, source_type AS SourceType, order_index AS OrderIndex FROM quiz_question_sources WHERE quiz_id = @QuizId ORDER BY order_index", + {| QuizId = quizId |} + ) + |> List.ofSeq + + if headers.IsEmpty then + [] + else + let sourceIds = headers |> List.map (fun h -> h.Id) |> List.toArray + + let fixedById = + conn.Query( + "SELECT source_id AS SourceId, question_id AS QuestionId, points AS Points FROM quiz_question_source_fixed WHERE source_id = ANY(@Ids)", + {| Ids = sourceIds |} + ) + |> Seq.map (fun r -> r.SourceId, r) + |> dict + + let randomById = + conn.Query( + "SELECT source_id AS SourceId, topic_id AS TopicId, count AS Count FROM quiz_question_source_random WHERE source_id = ANY(@Ids)", + {| Ids = sourceIds |} + ) + |> Seq.map (fun r -> r.SourceId, r) + |> dict + + headers + |> List.map (fun h -> + match h.SourceType with + | "Fixed" -> + let f = fixedById.[h.Id] + FixedQuestion { QuestionId = f.QuestionId; Points = f.Points; Order = h.OrderIndex } + | "RandomFromTopic" -> + let r = randomById.[h.Id] + RandomFromTopic(r.TopicId, r.Count, h.OrderIndex) + | other -> failwithf "Unknown source_type '%s'" other) + +let private assembleQuiz (conn: NpgsqlConnection) (row: QuizRow) : Quiz = + let assigned = + conn.Query("SELECT user_id FROM quiz_assigned_students WHERE quiz_id = @Id", {| Id = row.Id |}) + |> Set.ofSeq + + { Id = row.Id + OwnerId = row.OwnerId + Title = row.Title + Description = row.Description + TimeLimit = row.TimeLimit |> Option.ofNullable + MaxAttempts = row.MaxAttempts |> Option.ofNullable + GradingMethod = row.GradingMethod + ShuffleQuestions = row.ShuffleQuestions + ShuffleAnswers = row.ShuffleAnswers + OpenFrom = row.OpenFrom |> Option.ofNullable + OpenTo = row.OpenTo |> Option.ofNullable + PassingScore = row.PassingScore |> Option.ofNullable + QuestionSources = loadSources conn row.Id + AssignedStudentIds = assigned } + +/// Upserts the scalar `quizzes` row, then delete-then-reinserts its sources +/// and assigned-students set — same "always a full replace" semantics the +/// in-memory Store already has (no partial-update member exists today). +let addQuiz (connString: string) (quiz: Quiz) : unit = + use conn = openConnection connString + use tx = conn.BeginTransaction() + + conn.Execute( + """INSERT INTO quizzes (id, owner_id, title, description, time_limit, max_attempts, + grading_method, shuffle_questions, shuffle_answers, + open_from, open_to, passing_score) + VALUES (@Id, @OwnerId, @Title, @Description, @TimeLimit, @MaxAttempts, + @GradingMethod, @ShuffleQuestions, @ShuffleAnswers, @OpenFrom, @OpenTo, @PassingScore) + ON CONFLICT (id) DO UPDATE SET + owner_id = EXCLUDED.owner_id, title = EXCLUDED.title, description = EXCLUDED.description, + time_limit = EXCLUDED.time_limit, max_attempts = EXCLUDED.max_attempts, + grading_method = EXCLUDED.grading_method, shuffle_questions = EXCLUDED.shuffle_questions, + shuffle_answers = EXCLUDED.shuffle_answers, open_from = EXCLUDED.open_from, + open_to = EXCLUDED.open_to, passing_score = EXCLUDED.passing_score""", + {| Id = quiz.Id + OwnerId = quiz.OwnerId + Title = quiz.Title + Description = quiz.Description + TimeLimit = quiz.TimeLimit |> Option.toNullable + MaxAttempts = quiz.MaxAttempts |> Option.toNullable + GradingMethod = quiz.GradingMethod + ShuffleQuestions = quiz.ShuffleQuestions + ShuffleAnswers = quiz.ShuffleAnswers + OpenFrom = quiz.OpenFrom |> Option.toNullable + OpenTo = quiz.OpenTo |> Option.toNullable + PassingScore = quiz.PassingScore |> Option.toNullable |}, + tx + ) + |> ignore + + // Cascades into quiz_question_source_fixed/random. + conn.Execute("DELETE FROM quiz_question_sources WHERE quiz_id = @Id", {| Id = quiz.Id |}, tx) + |> ignore + + quiz.QuestionSources + |> List.iter (fun source -> + let sourceId = Guid.NewGuid() + + match source with + | FixedQuestion r -> + conn.Execute( + "INSERT INTO quiz_question_sources (id, quiz_id, source_type, order_index) VALUES (@Id, @QuizId, 'Fixed', @Order)", + {| Id = sourceId; QuizId = quiz.Id; Order = r.Order |}, + tx + ) + |> ignore + + conn.Execute( + "INSERT INTO quiz_question_source_fixed (source_id, question_id, points) VALUES (@SourceId, @QuestionId, @Points)", + {| SourceId = sourceId; QuestionId = r.QuestionId; Points = r.Points |}, + tx + ) + |> ignore + | RandomFromTopic(topicId, count, order) -> + conn.Execute( + "INSERT INTO quiz_question_sources (id, quiz_id, source_type, order_index) VALUES (@Id, @QuizId, 'RandomFromTopic', @Order)", + {| Id = sourceId; QuizId = quiz.Id; Order = order |}, + tx + ) + |> ignore + + conn.Execute( + "INSERT INTO quiz_question_source_random (source_id, topic_id, count) VALUES (@SourceId, @TopicId, @Count)", + {| SourceId = sourceId; TopicId = topicId; Count = count |}, + tx + ) + |> ignore) + + conn.Execute("DELETE FROM quiz_assigned_students WHERE quiz_id = @Id", {| Id = quiz.Id |}, tx) + |> ignore + + quiz.AssignedStudentIds + |> Set.iter (fun uid -> + conn.Execute( + "INSERT INTO quiz_assigned_students (quiz_id, user_id) VALUES (@QuizId, @UserId)", + {| QuizId = quiz.Id; UserId = uid |}, + tx + ) + |> ignore) + + tx.Commit() + +let removeQuiz (connString: string) (id: QuizId) : unit = + use conn = openConnection connString + conn.Execute("DELETE FROM quizzes WHERE id = @Id", {| Id = id |}) |> ignore + +let allQuizzes (connString: string) : Quiz list = + use conn = openConnection connString + conn.Query($"SELECT {quizSelectColumns} FROM quizzes") |> Seq.map (assembleQuiz conn) |> List.ofSeq + +let quizzesByOwner (connString: string) (ownerId: UserId) : Quiz list = + use conn = openConnection connString + + conn.Query($"SELECT {quizSelectColumns} FROM quizzes WHERE owner_id = @OwnerId", {| OwnerId = ownerId |}) + |> Seq.map (assembleQuiz conn) + |> List.ofSeq + +let tryGetQuiz (connString: string) (id: QuizId) : Quiz option = + use conn = openConnection connString + let row = conn.QuerySingleOrDefault($"SELECT {quizSelectColumns} FROM quizzes WHERE id = @Id", {| Id = id |}) + if box row = null then None else Some(assembleQuiz conn row) diff --git a/src/Server/Db/TopicRepository.fs b/src/Server/Db/TopicRepository.fs new file mode 100644 index 0000000..fa2e87c --- /dev/null +++ b/src/Server/Db/TopicRepository.fs @@ -0,0 +1,28 @@ +module Server.Db.TopicRepository + +open Dapper +open Domain +open Server.Db.Connection + +let private selectColumns = "id AS Id, owner_id AS OwnerId, name AS Name" + +let addTopic (connString: string) (topic: Topic) : unit = + use conn = openConnection connString + + conn.Execute( + """INSERT INTO topics (id, owner_id, name) VALUES (@Id, @OwnerId, @Name) + ON CONFLICT (id) DO UPDATE SET owner_id = EXCLUDED.owner_id, name = EXCLUDED.name""", + topic + ) + |> ignore + +let tryGetTopic (connString: string) (id: TopicId) : Topic option = + use conn = openConnection connString + conn.QuerySingleOrDefault($"SELECT {selectColumns} FROM topics WHERE id = @Id", {| Id = id |}) + |> Option.ofObj + +let topicsByOwner (connString: string) (ownerId: UserId) : Topic list = + use conn = openConnection connString + + conn.Query($"SELECT {selectColumns} FROM topics WHERE owner_id = @OwnerId", {| OwnerId = ownerId |}) + |> List.ofSeq diff --git a/src/Server/Db/TypeHandlers.fs b/src/Server/Db/TypeHandlers.fs new file mode 100644 index 0000000..88a2e0b --- /dev/null +++ b/src/Server/Db/TypeHandlers.fs @@ -0,0 +1,111 @@ +/// Dapper has no built-in knowledge of the domain's single-case Guid-wrapper +/// id types, nor its payload-less enum unions (`Role`/`GradingMethod`/ +/// `AttemptState`, stored as plain TEXT columns) — every one of them needs an +/// explicit `SqlMapper.TypeHandler<'T>` registered once at startup, or the +/// first query touching that type throws at runtime. +module Server.Db.TypeHandlers + +open System +open System.Data +open Dapper +open Domain + +type private UserIdHandler() = + inherit SqlMapper.TypeHandler() + override _.SetValue(p: IDbDataParameter, UserId g) = p.Value <- box g + override _.Parse(v: obj) = UserId(v :?> Guid) + +type private TopicIdHandler() = + inherit SqlMapper.TypeHandler() + override _.SetValue(p: IDbDataParameter, TopicId g) = p.Value <- box g + override _.Parse(v: obj) = TopicId(v :?> Guid) + +type private QuestionIdHandler() = + inherit SqlMapper.TypeHandler() + override _.SetValue(p: IDbDataParameter, QuestionId g) = p.Value <- box g + override _.Parse(v: obj) = QuestionId(v :?> Guid) + +type private OptionIdHandler() = + inherit SqlMapper.TypeHandler() + override _.SetValue(p: IDbDataParameter, OptionId g) = p.Value <- box g + override _.Parse(v: obj) = OptionId(v :?> Guid) + +type private QuizIdHandler() = + inherit SqlMapper.TypeHandler() + override _.SetValue(p: IDbDataParameter, QuizId g) = p.Value <- box g + override _.Parse(v: obj) = QuizId(v :?> Guid) + +type private AttemptIdHandler() = + inherit SqlMapper.TypeHandler() + override _.SetValue(p: IDbDataParameter, AttemptId g) = p.Value <- box g + override _.Parse(v: obj) = AttemptId(v :?> Guid) + +type private RoleHandler() = + inherit SqlMapper.TypeHandler() + + override _.SetValue(p: IDbDataParameter, role) = + p.Value <- + box ( + match role with + | Admin -> "Admin" + | Teacher -> "Teacher" + | Student -> "Student" + ) + + override _.Parse(v: obj) = + match v :?> string with + | "Admin" -> Admin + | "Teacher" -> Teacher + | "Student" -> Student + | other -> failwithf "Unknown role '%s'" other + +type private GradingMethodHandler() = + inherit SqlMapper.TypeHandler() + + override _.SetValue(p: IDbDataParameter, method) = + p.Value <- + box ( + match method with + | HighestAttempt -> "HighestAttempt" + | AverageAttempt -> "AverageAttempt" + | FirstAttempt -> "FirstAttempt" + | LastAttempt -> "LastAttempt" + ) + + override _.Parse(v: obj) = + match v :?> string with + | "HighestAttempt" -> HighestAttempt + | "AverageAttempt" -> AverageAttempt + | "FirstAttempt" -> FirstAttempt + | "LastAttempt" -> LastAttempt + | other -> failwithf "Unknown grading method '%s'" other + +type private AttemptStateHandler() = + inherit SqlMapper.TypeHandler() + + override _.SetValue(p: IDbDataParameter, state) = + p.Value <- + box ( + match state with + | InProgress -> "InProgress" + | Submitted -> "Submitted" + | Graded -> "Graded" + ) + + override _.Parse(v: obj) = + match v :?> string with + | "InProgress" -> InProgress + | "Submitted" -> Submitted + | "Graded" -> Graded + | other -> failwithf "Unknown attempt state '%s'" other + +let register () = + SqlMapper.AddTypeHandler(UserIdHandler()) + SqlMapper.AddTypeHandler(TopicIdHandler()) + SqlMapper.AddTypeHandler(QuestionIdHandler()) + SqlMapper.AddTypeHandler(OptionIdHandler()) + SqlMapper.AddTypeHandler(QuizIdHandler()) + SqlMapper.AddTypeHandler(AttemptIdHandler()) + SqlMapper.AddTypeHandler(RoleHandler()) + SqlMapper.AddTypeHandler(GradingMethodHandler()) + SqlMapper.AddTypeHandler(AttemptStateHandler()) diff --git a/src/Server/Db/UserRepository.fs b/src/Server/Db/UserRepository.fs new file mode 100644 index 0000000..43cc820 --- /dev/null +++ b/src/Server/Db/UserRepository.fs @@ -0,0 +1,44 @@ +module Server.Db.UserRepository + +open Dapper +open Domain +open Server.Db.Connection + +let private selectColumns = + "id AS Id, name AS Name, email AS Email, password_hash AS PasswordHash, role AS Role, is_active AS IsActive" + +let addUser (connString: string) (user: User) : unit = + use conn = openConnection connString + + conn.Execute( + """INSERT INTO users (id, name, email, password_hash, role, is_active) + VALUES (@Id, @Name, @Email, @PasswordHash, @Role, @IsActive) + ON CONFLICT (id) DO UPDATE SET + name = EXCLUDED.name, email = EXCLUDED.email, + password_hash = EXCLUDED.password_hash, role = EXCLUDED.role, + is_active = EXCLUDED.is_active""", + user + ) + |> ignore + +let listUsers (connString: string) : User list = + use conn = openConnection connString + conn.Query($"SELECT {selectColumns} FROM users ORDER BY name") |> List.ofSeq + +let tryGetUserByEmail (connString: string) (email: string) : User option = + use conn = openConnection connString + + conn.QuerySingleOrDefault( + $"SELECT {selectColumns} FROM users WHERE lower(email) = lower(@Email)", + {| Email = email |} + ) + |> Option.ofObj + +let tryGetUser (connString: string) (id: UserId) : User option = + use conn = openConnection connString + conn.QuerySingleOrDefault($"SELECT {selectColumns} FROM users WHERE id = @Id", {| Id = id |}) + |> Option.ofObj + +let usersByRole (connString: string) (role: Role) : User list = + use conn = openConnection connString + conn.Query($"SELECT {selectColumns} FROM users WHERE role = @Role", {| Role = role |}) |> List.ofSeq diff --git a/src/Server/Dockerfile b/src/Server/Dockerfile new file mode 100644 index 0000000..a95462b --- /dev/null +++ b/src/Server/Dockerfile @@ -0,0 +1,17 @@ +# Build context is the repo root (see docker-compose.yml) so both src/Domain +# and src/Server are reachable. +FROM mcr.microsoft.com/dotnet/sdk:9.0 AS build +WORKDIR /src +COPY src/Domain/Domain.fsproj src/Domain/ +COPY src/Server/Server.fsproj src/Server/ +RUN dotnet restore src/Server/Server.fsproj +COPY src/Domain/ src/Domain/ +COPY src/Server/ src/Server/ +RUN dotnet publish src/Server/Server.fsproj -c Release -o /app/publish --no-restore + +FROM mcr.microsoft.com/dotnet/aspnet:9.0 AS runtime +WORKDIR /app +COPY --from=build /app/publish . +# The base image already sets ASPNETCORE_HTTP_PORTS=8080. +EXPOSE 8080 +ENTRYPOINT ["dotnet", "Server.dll"] diff --git a/src/Server/ExpirySweeper.fs b/src/Server/ExpirySweeper.fs new file mode 100644 index 0000000..ce12427 --- /dev/null +++ b/src/Server/ExpirySweeper.fs @@ -0,0 +1,33 @@ +module Server.ExpirySweeper + +open System +open System.Threading +open System.Threading.Tasks +open Microsoft.Extensions.Hosting +open Microsoft.Extensions.Logging +open Server.Store +open Server.Features.Attempts + +/// Catches `InProgress` attempts whose time limit has passed but nobody sent +/// a follow-up request for (e.g. the student just closed the tab) — +/// `SubmitAnswer.fs` only catches expiry on the *next* request against a +/// given attempt, so an abandoned one would otherwise sit "in progress" +/// forever without ever being graded. Polls every 30s per DESIGN.md §3.6. +type ExpirySweeperService(store: Store, logger: ILogger) = + inherit BackgroundService() + + override _.ExecuteAsync(stoppingToken: CancellationToken) = + task { + while not stoppingToken.IsCancellationRequested do + try + for attempt in store.ExpiredInProgressAttempts() do + AutoFinish.finishExpired store attempt |> ignore + with ex -> + logger.LogError(ex, "Expiry sweep failed") + + try + do! Task.Delay(TimeSpan.FromSeconds 30.0, stoppingToken) + with :? TaskCanceledException -> + () + } + :> Task diff --git a/src/Server/Features/Admin/CreateUser.fs b/src/Server/Features/Admin/CreateUser.fs new file mode 100644 index 0000000..154bbb6 --- /dev/null +++ b/src/Server/Features/Admin/CreateUser.fs @@ -0,0 +1,39 @@ +module Server.Features.Admin.CreateUser + +open Giraffe +open Domain +open Domain.Contracts +open Server.Store +open Server.Features.Admin.ListUsers + +let private create (store: Store) (req: CreateUserRequest) : Result = + if System.String.IsNullOrWhiteSpace req.Name then + Error "Имя не может быть пустым" + elif System.String.IsNullOrWhiteSpace req.Email then + Error "Email не может быть пустым" + elif req.Password.Length < 6 then + Error "Пароль должен быть не короче 6 символов" + else + match store.TryGetUserByEmail req.Email with + | Some _ -> Error "Пользователь с таким email уже существует" + | None -> + let user: User = + { Id = Id.newUserId () + Name = req.Name + Email = req.Email + PasswordHash = BCrypt.Net.BCrypt.HashPassword req.Password + Role = req.Role + IsActive = true } + + store.AddUser user + Ok(toSummary user) + +let handler (store: Store) : HttpHandler = + bindJson (fun req next ctx -> + task { + let result = + Server.Auth.requireRole [ Admin ] ctx.User + |> Result.bind (fun _ -> create store req) + + return! json result next ctx + }) diff --git a/src/Server/Features/Admin/ListUsers.fs b/src/Server/Features/Admin/ListUsers.fs new file mode 100644 index 0000000..c8a0c3e --- /dev/null +++ b/src/Server/Features/Admin/ListUsers.fs @@ -0,0 +1,23 @@ +module Server.Features.Admin.ListUsers + +open Giraffe +open Domain +open Domain.Contracts +open Server.Store + +let toSummary (u: User) : UserSummary = + { Id = u.Id + Name = u.Name + Email = u.Email + Role = u.Role + IsActive = u.IsActive } + +let handler (store: Store) : HttpHandler = + fun next ctx -> + task { + let result = + Server.Auth.requireRole [ Admin ] ctx.User + |> Result.map (fun _ -> store.AllUsers() |> List.map toSummary) + + return! json result next ctx + } diff --git a/src/Server/Features/Admin/ResetPassword.fs b/src/Server/Features/Admin/ResetPassword.fs new file mode 100644 index 0000000..41e44cb --- /dev/null +++ b/src/Server/Features/Admin/ResetPassword.fs @@ -0,0 +1,26 @@ +module Server.Features.Admin.ResetPassword + +open Giraffe +open Domain +open Domain.Contracts +open Server.Store + +let private reset (store: Store) (req: ResetPasswordRequest) : Result = + if req.NewPassword.Length < 6 then + Error "Пароль должен быть не короче 6 символов" + else + match store.TryGetUser req.Id with + | None -> Error "Пользователь не найден" + | Some existing -> + store.AddUser { existing with PasswordHash = BCrypt.Net.BCrypt.HashPassword req.NewPassword } + Ok() + +let handler (store: Store) : HttpHandler = + bindJson (fun req next ctx -> + task { + let result = + Server.Auth.requireRole [ Admin ] ctx.User + |> Result.bind (fun _ -> reset store req) + + return! json result next ctx + }) diff --git a/src/Server/Features/Admin/SetUserActive.fs b/src/Server/Features/Admin/SetUserActive.fs new file mode 100644 index 0000000..710b0a5 --- /dev/null +++ b/src/Server/Features/Admin/SetUserActive.fs @@ -0,0 +1,28 @@ +module Server.Features.Admin.SetUserActive + +open Giraffe +open Domain +open Domain.Contracts +open Server.Store +open Server.Features.Admin.ListUsers + +let private setActive (store: Store) (callerId: UserId) (req: SetUserActiveRequest) : Result = + if req.Id = callerId && not req.IsActive then + Error "Нельзя деактивировать свою учётную запись" + else + match store.TryGetUser req.Id with + | None -> Error "Пользователь не найден" + | Some existing -> + let updated = { existing with IsActive = req.IsActive } + store.AddUser updated + Ok(toSummary updated) + +let handler (store: Store) : HttpHandler = + bindJson (fun req next ctx -> + task { + let result = + Server.Auth.requireRole [ Admin ] ctx.User + |> Result.bind (fun uid -> setActive store uid req) + + return! json result next ctx + }) diff --git a/src/Server/Features/Admin/UpdateUser.fs b/src/Server/Features/Admin/UpdateUser.fs new file mode 100644 index 0000000..95edb6f --- /dev/null +++ b/src/Server/Features/Admin/UpdateUser.fs @@ -0,0 +1,38 @@ +module Server.Features.Admin.UpdateUser + +open Giraffe +open Domain +open Domain.Contracts +open Server.Store +open Server.Features.Admin.ListUsers + +let private update (store: Store) (req: UpdateUserRequest) : Result = + match store.TryGetUser req.Id with + | None -> Error "Пользователь не найден" + | Some existing -> + if System.String.IsNullOrWhiteSpace req.Name then + Error "Имя не может быть пустым" + elif System.String.IsNullOrWhiteSpace req.Email then + Error "Email не может быть пустым" + else + let emailTaken = + match store.TryGetUserByEmail req.Email with + | Some other -> other.Id <> req.Id + | None -> false + + if emailTaken then + Error "Пользователь с таким email уже существует" + else + let updated = { existing with Name = req.Name; Email = req.Email; Role = req.Role } + store.AddUser updated + Ok(toSummary updated) + +let handler (store: Store) : HttpHandler = + bindJson (fun req next ctx -> + task { + let result = + Server.Auth.requireRole [ Admin ] ctx.User + |> Result.bind (fun _ -> update store req) + + return! json result next ctx + }) diff --git a/src/Server/Features/Attempts/AutoFinish.fs b/src/Server/Features/Attempts/AutoFinish.fs new file mode 100644 index 0000000..fed4575 --- /dev/null +++ b/src/Server/Features/Attempts/AutoFinish.fs @@ -0,0 +1,17 @@ +module Server.Features.Attempts.AutoFinish + +open System +open Domain +open Server.Store + +/// Grades and saves an attempt whose time limit has already passed, +/// transitioning it out of `InProgress` exactly like a normal manual finish +/// would — shared by `SubmitAnswer.fs` (checked on every request against a +/// specific attempt) and `Server.ExpirySweeper` (catches attempts nobody +/// sent a follow-up request for, e.g. an abandoned tab). +let finishExpired (store: Store) (attempt: Attempt) : Attempt = + let questionMap = store.QuestionsByIds(attempt.Questions |> List.map (fun q -> q.QuestionId)) + let submitted = attempt |> Attempt.submit DateTimeOffset.UtcNow + let graded = Grading.gradeAttempt questionMap submitted + store.SaveAttempt graded + graded diff --git a/src/Server/Features/Attempts/FinishAttempt.fs b/src/Server/Features/Attempts/FinishAttempt.fs new file mode 100644 index 0000000..a20f37b --- /dev/null +++ b/src/Server/Features/Attempts/FinishAttempt.fs @@ -0,0 +1,40 @@ +module Server.Features.Attempts.FinishAttempt + +open System +open Giraffe +open Domain +open Domain.Contracts +open Server.Store + +let private finish (store: Store) (userId: UserId) (req: FinishAttemptRequest) : Result = + match store.TryGetAttempt req.AttemptId with + | None -> Error "Попытка не найдена" + | Some attempt when attempt.UserId <> userId -> Error "Доступ запрещён" + | Some attempt -> + match store.TryGetQuiz attempt.QuizId with + | None -> Error "Тест не найден" + | Some quiz -> + let submitted = attempt |> Attempt.submit DateTimeOffset.UtcNow + let questionMap = store.QuestionsByIds(attempt.Questions |> List.map (fun q -> q.QuestionId)) + let graded = Grading.gradeAttempt questionMap submitted + store.SaveAttempt graded + + let maxScore = attempt.Questions |> List.sumBy (fun q -> q.Points) + let score = defaultArg graded.Score 0.0 + let passed = quiz.PassingScore |> Option.map (fun p -> score >= p) + + Ok + { AttemptId = graded.Id + Score = score + MaxScore = maxScore + Passed = passed } + +let handler (store: Store) : HttpHandler = + bindJson (fun req next ctx -> + task { + let result = + Server.Auth.requireUserId ctx.User + |> Result.bind (fun userId -> finish store userId req) + + return! json result next ctx + }) diff --git a/src/Server/Features/Attempts/ReportFocusLoss.fs b/src/Server/Features/Attempts/ReportFocusLoss.fs new file mode 100644 index 0000000..afbfcca --- /dev/null +++ b/src/Server/Features/Attempts/ReportFocusLoss.fs @@ -0,0 +1,29 @@ +module Server.Features.Attempts.ReportFocusLoss + +open Giraffe +open Domain +open Domain.Contracts +open Server.Store + +let private report (store: Store) (userId: UserId) (req: ReportFocusLossRequest) : Result = + match store.TryGetAttempt req.AttemptId with + | None -> Error "Попытка не найдена" + | Some attempt when attempt.UserId <> userId -> Error "Доступ запрещён" + | Some attempt when attempt.State <> InProgress -> + // The attempt already ended (manual finish, expiry, ...) — a + // straggling event from a page the student hasn't closed yet isn't + // worth surfacing as an error, it just has nothing left to count. + Ok() + | Some _ -> + store.IncrementFocusLoss req.AttemptId + Ok() + +let handler (store: Store) : HttpHandler = + bindJson (fun req next ctx -> + task { + let result = + Server.Auth.requireUserId ctx.User + |> Result.bind (fun userId -> report store userId req) + + return! json result next ctx + }) diff --git a/src/Server/Features/Attempts/SubmitAnswer.fs b/src/Server/Features/Attempts/SubmitAnswer.fs new file mode 100644 index 0000000..1b84431 --- /dev/null +++ b/src/Server/Features/Attempts/SubmitAnswer.fs @@ -0,0 +1,39 @@ +module Server.Features.Attempts.SubmitAnswer + +open System +open Giraffe +open Domain +open Domain.Contracts +open Server.Store + +let private submit (store: Store) (userId: UserId) (req: SubmitAnswerRequest) : Result = + match store.TryGetAttempt req.AttemptId with + | None -> Error "Попытка не найдена" + | Some attempt when attempt.UserId <> userId -> Error "Доступ запрещён" + | Some attempt when attempt.State <> InProgress -> Error "Попытка уже завершена" + | Some attempt -> + match store.TryGetQuiz attempt.QuizId with + | None -> Error "Тест не найден" + | Some quiz when Attempt.isExpired quiz DateTimeOffset.UtcNow attempt -> + // The deadline already passed — grade whatever was answered so + // far instead of silently accepting one more change, and reject + // *this* answer. Reaching `InProgress` again after this is + // impossible, so every subsequent call (from this student + // clicking around a stale page) falls through to the + // "already finished" branch above instead of re-checking expiry. + Server.Features.Attempts.AutoFinish.finishExpired store attempt |> ignore + Error "Время вышло — тест завершён автоматически" + | Some _ -> + let updated = attempt |> Attempt.recordResponse req.QuestionId req.Response + store.SaveAttempt updated + Ok() + +let handler (store: Store) : HttpHandler = + bindJson (fun req next ctx -> + task { + let result = + Server.Auth.requireUserId ctx.User + |> Result.bind (fun userId -> submit store userId req) + + return! json result next ctx + }) diff --git a/src/Server/Features/Auth/Login.fs b/src/Server/Features/Auth/Login.fs new file mode 100644 index 0000000..8447625 --- /dev/null +++ b/src/Server/Features/Auth/Login.fs @@ -0,0 +1,28 @@ +module Server.Features.Auth.Login + +open Giraffe +open Domain.Contracts +open Server.Store + +let private authenticate (store: Store) (secret: string) (req: LoginRequest) : Async> = + async { + match store.TryGetUserByEmail req.Email with + | None -> return Error "Неверный email или пароль" + | Some user when not user.IsActive -> + // Same error text as a wrong password — don't reveal that the + // account exists but was deactivated by an Admin. + return Error "Неверный email или пароль" + | Some user -> + if BCrypt.Net.BCrypt.Verify(req.Password, user.PasswordHash) then + let token = Server.Auth.issueToken secret user + return Ok { Token = token; UserId = user.Id; Name = user.Name; Role = user.Role } + else + return Error "Неверный email или пароль" + } + +let handler (store: Store) (secret: string) : HttpHandler = + bindJson (fun req next ctx -> + task { + let! result = authenticate store secret req + return! json result next ctx + }) diff --git a/src/Server/Features/Quizzes/GetAvailableQuizzes.fs b/src/Server/Features/Quizzes/GetAvailableQuizzes.fs new file mode 100644 index 0000000..1806585 --- /dev/null +++ b/src/Server/Features/Quizzes/GetAvailableQuizzes.fs @@ -0,0 +1,53 @@ +module Server.Features.Quizzes.GetAvailableQuizzes + +open Giraffe +open Domain +open Domain.Contracts +open Server.Store + +let private estimateSourcePoints (store: Store) (source: QuizQuestionSource) : float = + match source with + | FixedQuestion qref -> qref.Points + | RandomFromTopic(topicId, count, _) -> + match store.QuestionsByTopic topicId with + | [] -> 0.0 + | qs -> (qs |> List.averageBy (fun q -> q.Points)) * float count + +/// Whether any of `attempts` already cleared `quiz.PassingScore` — shared by +/// `toQuizSummary` (so the student sees it's already passed) and +/// `StartAttempt.fs` (so a new attempt can't be started once it has). +let hasPassed (quiz: Quiz) (attempts: Attempt list) : bool = + match quiz.PassingScore with + | None -> false + | Some passing -> attempts |> List.exists (fun a -> a.State = Graded && (a.Score |> Option.defaultValue 0.0) >= passing) + +/// `TotalPoints` is exact when every source is a fixed question. When the +/// quiz has random-pool sources it's an estimate (average bank points for +/// that topic × the pool's count), since the actual questions aren't drawn +/// until the student starts an attempt. `AttemptsCount` counts only +/// `userId`'s own graded attempts, not attempts by other students. +let toQuizSummary (store: Store) (userId: UserId) (quiz: Quiz) : QuizSummary = + let attempts = store.AttemptsForQuiz(quiz.Id, userId) + + { Id = quiz.Id + Title = quiz.Title + Description = quiz.Description + TotalPoints = quiz.QuestionSources |> List.sumBy (estimateSourcePoints store) + TimeLimitMinutes = quiz.TimeLimit |> Option.map (fun t -> int t.TotalMinutes) + MaxAttempts = quiz.MaxAttempts + AttemptsCount = attempts |> List.filter (fun a -> a.State = Graded) |> List.length + AlreadyPassed = hasPassed quiz attempts } + +let handler (store: Store) : HttpHandler = + fun next ctx -> + task { + let quizzes = + match Server.Auth.tryGetUserId ctx.User with + | Some uid -> + store.AllQuizzes() + |> List.filter (fun q -> q.AssignedStudentIds.Contains uid) + |> List.map (toQuizSummary store uid) + | None -> [] + + return! json quizzes next ctx + } diff --git a/src/Server/Features/Quizzes/GetMyAttempts.fs b/src/Server/Features/Quizzes/GetMyAttempts.fs new file mode 100644 index 0000000..b6e232d --- /dev/null +++ b/src/Server/Features/Quizzes/GetMyAttempts.fs @@ -0,0 +1,40 @@ +module Server.Features.Quizzes.GetMyAttempts + +open Giraffe +open Domain +open Domain.Contracts +open Server.Store + +let private toSummary (quiz: Quiz) (attempt: Attempt) : MyAttemptSummary = + let score = attempt.Score |> Option.defaultValue 0.0 + let maxScore = attempt.Questions |> List.sumBy (fun q -> q.Points) + + { AttemptId = attempt.Id + StartedAt = attempt.StartedAt + Score = score + MaxScore = maxScore + Passed = quiz.PassingScore |> Option.map (fun p -> score >= p) } + +let private getMyAttempts + (store: Store) + (userId: UserId) + (req: GetMyAttemptsRequest) + : Result = + match store.TryGetQuiz req.QuizId with + | None -> Error "Тест не найден" + | Some quiz -> + store.AttemptsForQuiz(req.QuizId, userId) + |> List.filter (fun a -> a.State = Graded) + |> List.sortByDescending (fun a -> a.StartedAt) + |> List.map (toSummary quiz) + |> Ok + +let handler (store: Store) : HttpHandler = + bindJson (fun req next ctx -> + task { + let result = + Server.Auth.requireUserId ctx.User + |> Result.bind (fun userId -> getMyAttempts store userId req) + + return! json result next ctx + }) diff --git a/src/Server/Features/Quizzes/StartAttempt.fs b/src/Server/Features/Quizzes/StartAttempt.fs new file mode 100644 index 0000000..e5d89fb --- /dev/null +++ b/src/Server/Features/Quizzes/StartAttempt.fs @@ -0,0 +1,96 @@ +module Server.Features.Quizzes.StartAttempt + +open System +open Giraffe +open Domain +open Domain.Contracts +open Server.Store +open Server.Features.Quizzes.GetAvailableQuizzes + +let private toQuestionView (q: Question) : QuestionView = + let kind = + match q.Type with + | SingleChoice(options, _) -> SingleChoiceView(options |> List.map (fun o -> o.Id, o.Text)) + | MultipleChoice(options, _) -> MultipleChoiceView(options |> List.map (fun o -> o.Id, o.Text)) + | TrueFalse _ -> TrueFalseView + | ShortAnswer _ -> ShortAnswerView + | Numeric _ -> NumericView + + { Id = q.Id; Text = q.Text; Points = q.Points; Kind = kind } + +/// Materializes the quiz's sources into a concrete, sequentially-ordered +/// `QuizQuestionRef list` for one attempt — fixed refs pass through +/// unchanged; each random-pool rule draws up to `Count` questions at random +/// from its topic's *current* question bank, excluding any question already +/// pinned as a fixed source elsewhere in the quiz (otherwise a question that +/// is both fixed and a member of its own topic's pool could be dealt twice +/// in the same attempt). Fewer than `Count` are drawn if not enough +/// candidates remain. Called fresh per attempt, so random pools can differ +/// between attempts of the same quiz. +let resolveAttemptQuestions (store: Store) (rng: Random) (quiz: Quiz) : QuizQuestionRef list = + let fixedIds = + quiz.QuestionSources + |> List.choose (function + | FixedQuestion r -> Some r.QuestionId + | RandomFromTopic _ -> None) + |> Set.ofList + + quiz.QuestionSources + |> List.sortBy Quiz.sourceOrder + |> List.collect (function + | FixedQuestion qref -> [ qref ] + | RandomFromTopic(topicId, count, _) -> + store.QuestionsByTopic topicId + |> List.filter (fun q -> not (fixedIds.Contains q.Id)) + |> List.sortBy (fun _ -> rng.Next()) + |> List.truncate count + |> List.map (fun q -> { QuestionId = q.Id; Points = q.Points; Order = 0 })) + |> List.mapi (fun i qref -> { qref with Order = i }) + +let private start (store: Store) (userId: UserId) (req: StartAttemptRequest) : Result = + match store.TryGetQuiz req.QuizId with + | None -> Error "Тест не найден" + | Some quiz -> + if not (Quiz.isOpenAt DateTimeOffset.UtcNow quiz) then + Error "Тест сейчас недоступен" + else + let existingAttempts = store.AttemptsForQuiz(req.QuizId, userId) + + if hasPassed quiz existingAttempts then + Error "Тест уже пройден успешно — повторные попытки недоступны" + else + match quiz.MaxAttempts with + | Some maxAttempts when existingAttempts.Length >= maxAttempts -> Error "Достигнуто максимальное число попыток" + | _ -> + let resolvedQuestions = resolveAttemptQuestions store (Random()) quiz + + if resolvedQuestions.IsEmpty then + Error "В тесте нет доступных вопросов" + else + let attemptId = Id.newAttemptId () + let attempt = Attempt.start attemptId quiz resolvedQuestions userId DateTimeOffset.UtcNow + store.SaveAttempt attempt + + let questionMap = store.QuestionsByIds(resolvedQuestions |> List.map (fun q -> q.QuestionId)) + + let orderedQuestions = + resolvedQuestions + |> List.sortBy (fun q -> q.Order) + |> List.choose (fun qref -> Map.tryFind qref.QuestionId questionMap) + |> List.map toQuestionView + + Ok + { AttemptId = attemptId + Quiz = toQuizSummary store userId quiz + StartedAt = attempt.StartedAt + Questions = orderedQuestions } + +let handler (store: Store) : HttpHandler = + bindJson (fun req next ctx -> + task { + let result = + Server.Auth.requireUserId ctx.User + |> Result.bind (fun userId -> start store userId req) + + return! json result next ctx + }) diff --git a/src/Server/Features/Teacher/AssignStudents.fs b/src/Server/Features/Teacher/AssignStudents.fs new file mode 100644 index 0000000..3974a1f --- /dev/null +++ b/src/Server/Features/Teacher/AssignStudents.fs @@ -0,0 +1,34 @@ +module Server.Features.Teacher.AssignStudents + +open Giraffe +open Domain +open Domain.Contracts +open Server.Store +open Server.Features.Teacher.ListMyQuizzes + +let private assign (store: Store) (ownerId: UserId) (req: AssignStudentsRequest) : Result = + match store.TryGetQuiz req.QuizId with + | None -> Error "Тест не найден" + | Some quiz when quiz.OwnerId <> ownerId -> Error "Доступ запрещён" + | Some quiz -> + let validStudentIds = + req.StudentIds + |> List.filter (fun id -> + match store.TryGetUser id with + | Some u -> u.Role = Student + | None -> false) + |> Set.ofList + + let updated = { quiz with AssignedStudentIds = validStudentIds } + store.AddQuiz updated + Ok(toAdminSummary updated) + +let handler (store: Store) : HttpHandler = + bindJson (fun req next ctx -> + task { + let result = + Server.Auth.requireRole [ Teacher; Admin ] ctx.User + |> Result.bind (fun uid -> assign store uid req) + + return! json result next ctx + }) diff --git a/src/Server/Features/Teacher/CreateQuestion.fs b/src/Server/Features/Teacher/CreateQuestion.fs new file mode 100644 index 0000000..38c0f2a --- /dev/null +++ b/src/Server/Features/Teacher/CreateQuestion.fs @@ -0,0 +1,83 @@ +module Server.Features.Teacher.CreateQuestion + +open Giraffe +open Domain +open Domain.Contracts +open Server.Store + +/// Reused by `ListQuestions.fs`, mirroring how `StartAttempt.fs` reuses +/// `GetAvailableQuizzes.toQuizSummary`. +let toDomainType (view: QuestionTypeView) : QuestionType = + match view with + | SingleChoiceT d -> SingleChoice(d.Options, d.CorrectOptionId) + | MultipleChoiceT d -> MultipleChoice(d.Options, Set.ofList d.CorrectOptionIds) + | TrueFalseT b -> TrueFalse b + | ShortAnswerT d -> ShortAnswer(d.AcceptedAnswers, d.CaseSensitive) + | NumericT d -> Numeric(d.CorrectValue, d.Tolerance) + +let toSummary (q: Question) : QuestionSummary = + let view = + match q.Type with + | SingleChoice(options, correct) -> SingleChoiceT { Options = options; CorrectOptionId = correct } + | MultipleChoice(options, correct) -> MultipleChoiceT { Options = options; CorrectOptionIds = Set.toList correct } + | TrueFalse b -> TrueFalseT b + | ShortAnswer(accepted, caseSensitive) -> ShortAnswerT { AcceptedAnswers = accepted; CaseSensitive = caseSensitive } + | Numeric(value, tolerance) -> NumericT { CorrectValue = value; Tolerance = tolerance } + + { Id = q.Id; TopicId = q.TopicId; Text = q.Text; Points = q.Points; Type = view } + +/// `question_options.id` is a global primary key (not scoped per question), +/// but the client generates its own `OptionId`s just to give the in-progress +/// form's radio/checkbox rows something stable to key on — those ids are +/// meaningless once the question doesn't exist yet. Trusting them verbatim +/// on create meant a retried/duplicated create request (e.g. the user +/// clicking "Создать" again after a prior attempt already succeeded, or a +/// double-click race) reused the same ids for a brand-new question and hit +/// a duplicate-key violation. Minting fresh ids here makes every create +/// request idempotent-safe regardless of what the client sent. UPDATE is +/// deliberately different (see `Types.fs` `formFromSummary` on the client) — +/// it must keep the ids the client echoed back, since those already exist +/// and may be referenced by past attempt responses. +let private freshenOptionIds (t: QuestionType) : QuestionType = + let remap (options: QuestionOption list) = + let idMap = options |> List.map (fun o -> o.Id, Id.newOptionId ()) |> dict + (options |> List.map (fun o -> { o with Id = idMap.[o.Id] })), idMap + + match t with + | SingleChoice(options, correctId) -> + let newOptions, idMap = remap options + SingleChoice(newOptions, idMap.[correctId]) + | MultipleChoice(options, correctIds) -> + let newOptions, idMap = remap options + MultipleChoice(newOptions, correctIds |> Set.map (fun cid -> idMap.[cid])) + | TrueFalse _ + | ShortAnswer _ + | Numeric _ -> t + +let private create (store: Store) (ownerId: UserId) (req: CreateQuestionRequest) : Result = + match store.TryGetTopic req.TopicId with + | None -> Error "Тема не найдена" + | Some topic when topic.OwnerId <> ownerId -> Error "Доступ запрещён" + | Some _ -> + let question: Question = + { Id = Id.newQuestionId () + TopicId = req.TopicId + Text = req.Text + Points = req.Points + Type = toDomainType req.Type |> freshenOptionIds } + + match QuestionValidation.validate question with + | Error errors -> Error(String.concat "; " errors) + | Ok validQuestion -> + store.AddQuestion validQuestion + Ok(toSummary validQuestion) + +let handler (store: Store) : HttpHandler = + bindJson (fun req next ctx -> + task { + let result = + Server.Auth.requireRole [ Teacher; Admin ] ctx.User + |> Result.bind (fun uid -> create store uid req) + + return! json result next ctx + }) diff --git a/src/Server/Features/Teacher/CreateQuiz.fs b/src/Server/Features/Teacher/CreateQuiz.fs new file mode 100644 index 0000000..2f762e3 --- /dev/null +++ b/src/Server/Features/Teacher/CreateQuiz.fs @@ -0,0 +1,94 @@ +module Server.Features.Teacher.CreateQuiz + +open System +open Giraffe +open Domain +open Domain.Contracts +open Server.Store +open Server.Features.Teacher.ListMyQuizzes + +let private checkTopicOwned (store: Store) (ownerId: UserId) (topicId: TopicId) : Result = + match store.TryGetTopic topicId with + | Some t when t.OwnerId = ownerId -> Ok() + | Some _ -> Error "Доступ запрещён" + | None -> Error "Тема не найдена" + +/// Resolves the client's requested sources into the quiz's stored +/// `QuizQuestionSource list`. A fixed question is checked against the bank +/// and its owning topic, and its points snapshot from the bank (no per-quiz +/// override). A random-pool rule is checked against its own topic only — +/// the actual questions aren't picked until each attempt starts, so there's +/// nothing else to validate against the bank here. Reused by `UpdateQuiz.fs`. +let resolveSources + (store: Store) + (ownerId: UserId) + (sources: QuizQuestionSourceInput list) + : Result = + let fixedIds = + sources + |> List.choose (function + | FixedQuestionInput qid -> Some qid + | RandomPoolInput _ -> None) + + let found = store.QuestionsByIds fixedIds + + let resolveOne (order: int) (source: QuizQuestionSourceInput) : Result = + match source with + | FixedQuestionInput qid -> + match Map.tryFind qid found with + | None -> Error "Один из выбранных вопросов не найден" + | Some q -> + checkTopicOwned store ownerId q.TopicId + |> Result.map (fun () -> FixedQuestion { QuestionId = qid; Points = q.Points; Order = order }) + | RandomPoolInput rule -> + if rule.Count <= 0 then + Error "Количество случайных вопросов должно быть положительным" + else + checkTopicOwned store ownerId rule.TopicId + |> Result.map (fun () -> RandomFromTopic(rule.TopicId, rule.Count, order)) + + let rec resolveAll (order: int) (remaining: QuizQuestionSourceInput list) (acc: QuizQuestionSource list) = + match remaining with + | [] -> Ok(List.rev acc) + | source :: rest -> + match resolveOne order source with + | Error err -> Error err + | Ok resolved -> resolveAll (order + 1) rest (resolved :: acc) + + resolveAll 0 sources [] + +let private create (store: Store) (ownerId: UserId) (req: CreateQuizRequest) : Result = + match resolveSources store ownerId req.Sources with + | Error err -> Error err + | Ok sources -> + let quiz: Quiz = + { Id = Id.newQuizId () + OwnerId = ownerId + Title = req.Title + Description = req.Description + TimeLimit = req.TimeLimitMinutes |> Option.map (float >> TimeSpan.FromMinutes) + MaxAttempts = req.MaxAttempts + GradingMethod = HighestAttempt + ShuffleQuestions = req.ShuffleQuestions + ShuffleAnswers = req.ShuffleAnswers + OpenFrom = None + OpenTo = None + PassingScore = req.PassingScore + QuestionSources = sources + AssignedStudentIds = Set.empty } + + match QuizValidation.validate quiz with + | Error errors -> Error(String.concat "; " errors) + | Ok validQuiz -> + store.AddQuiz validQuiz + Ok(toAdminSummary validQuiz) + +let handler (store: Store) : HttpHandler = + bindJson (fun req next ctx -> + task { + let result = + Server.Auth.requireRole [ Teacher; Admin ] ctx.User + |> Result.bind (fun uid -> create store uid req) + + return! json result next ctx + }) diff --git a/src/Server/Features/Teacher/CreateTopic.fs b/src/Server/Features/Teacher/CreateTopic.fs new file mode 100644 index 0000000..581fb58 --- /dev/null +++ b/src/Server/Features/Teacher/CreateTopic.fs @@ -0,0 +1,24 @@ +module Server.Features.Teacher.CreateTopic + +open Giraffe +open Domain +open Domain.Contracts +open Server.Store + +let private create (store: Store) (ownerId: UserId) (req: CreateTopicRequest) : Result = + if System.String.IsNullOrWhiteSpace req.Name then + Error "Название темы не может быть пустым" + else + let topic: Topic = { Id = Id.newTopicId (); OwnerId = ownerId; Name = req.Name } + store.AddTopic topic + Ok topic + +let handler (store: Store) : HttpHandler = + bindJson (fun req next ctx -> + task { + let result = + Server.Auth.requireRole [ Teacher; Admin ] ctx.User + |> Result.bind (fun uid -> create store uid req) + + return! json result next ctx + }) diff --git a/src/Server/Features/Teacher/DeleteQuestion.fs b/src/Server/Features/Teacher/DeleteQuestion.fs new file mode 100644 index 0000000..fcf445c --- /dev/null +++ b/src/Server/Features/Teacher/DeleteQuestion.fs @@ -0,0 +1,29 @@ +module Server.Features.Teacher.DeleteQuestion + +open Giraffe +open Domain +open Domain.Contracts +open Server.Store + +let private delete (store: Store) (ownerId: UserId) (req: DeleteQuestionRequest) : Result = + match store.TryGetQuestion req.QuestionId with + | None -> Error "Вопрос не найден" + | Some question -> + match store.TryGetTopic question.TopicId with + | Some topic when topic.OwnerId = ownerId -> + if store.IsQuestionUsed req.QuestionId then + Error "Вопрос используется в тесте, удаление невозможно" + else + store.RemoveQuestion req.QuestionId + Ok() + | _ -> Error "Доступ запрещён" + +let handler (store: Store) : HttpHandler = + bindJson (fun req next ctx -> + task { + let result = + Server.Auth.requireRole [ Teacher; Admin ] ctx.User + |> Result.bind (fun uid -> delete store uid req) + + return! json result next ctx + }) diff --git a/src/Server/Features/Teacher/DeleteQuiz.fs b/src/Server/Features/Teacher/DeleteQuiz.fs new file mode 100644 index 0000000..d4fc5ae --- /dev/null +++ b/src/Server/Features/Teacher/DeleteQuiz.fs @@ -0,0 +1,27 @@ +module Server.Features.Teacher.DeleteQuiz + +open Giraffe +open Domain +open Domain.Contracts +open Server.Store + +let private delete (store: Store) (ownerId: UserId) (req: DeleteQuizRequest) : Result = + match store.TryGetQuiz req.QuizId with + | None -> Error "Тест не найден" + | Some quiz when quiz.OwnerId <> ownerId -> Error "Доступ запрещён" + | Some _ -> + if store.AnyAttemptsForQuiz req.QuizId then + Error "Тест уже проходили, удаление невозможно" + else + store.RemoveQuiz req.QuizId + Ok() + +let handler (store: Store) : HttpHandler = + bindJson (fun req next ctx -> + task { + let result = + Server.Auth.requireRole [ Teacher; Admin ] ctx.User + |> Result.bind (fun uid -> delete store uid req) + + return! json result next ctx + }) diff --git a/src/Server/Features/Teacher/GetQuizResults.fs b/src/Server/Features/Teacher/GetQuizResults.fs new file mode 100644 index 0000000..8dc7b60 --- /dev/null +++ b/src/Server/Features/Teacher/GetQuizResults.fs @@ -0,0 +1,66 @@ +module Server.Features.Teacher.GetQuizResults + +open System +open Giraffe +open Domain +open Domain.Contracts +open Server.Store + +/// When a graded attempt "happened", for recency ordering/display — falls +/// back to `StartedAt` only in the (practically unreachable) case a `Graded` +/// row somehow has no `SubmittedAt`, so this never throws. +let private attemptTime (a: Attempt) : DateTimeOffset = a.SubmittedAt |> Option.defaultValue a.StartedAt + +let private toStudentResult (store: Store) (quiz: Quiz) (student: User) : StudentQuizResult = + let attempts = + store.AttemptsForQuiz(quiz.Id, student.Id) + |> List.filter (fun a -> a.State = Graded) + |> List.sortByDescending attemptTime + + let bestScore, maxScore, passed = + match Grading.applyGradingMethod quiz.GradingMethod attempts with + | None -> None, None, None + | Some official -> + let score = official.Score |> Option.defaultValue 0.0 + let maxScore = official.Questions |> List.sumBy (fun q -> q.Points) + Some score, Some maxScore, quiz.PassingScore |> Option.map (fun p -> score >= p) + + // "Successful" means cleared `PassingScore` when the quiz has one; + // without a passing bar to clear, any graded attempt counts, so the most + // recent attempt overall is shown. + let successfulAttempts = + match quiz.PassingScore with + | Some passing -> attempts |> List.filter (fun a -> (a.Score |> Option.defaultValue 0.0) >= passing) + | None -> attempts + + { StudentId = student.Id + StudentName = student.Name + StudentEmail = student.Email + AttemptsCount = attempts.Length + BestScore = bestScore + MaxScore = maxScore + Passed = passed + LastSuccessfulAttemptAt = successfulAttempts |> List.tryHead |> Option.map attemptTime + LastAttemptFocusLossCount = attempts |> List.tryHead |> Option.map (fun a -> a.FocusLossCount) |> Option.defaultValue 0 } + +let private getResults (store: Store) (ownerId: UserId) (req: GetQuizResultsRequest) : Result = + match store.TryGetQuiz req.QuizId with + | None -> Error "Тест не найден" + | Some quiz when quiz.OwnerId <> ownerId -> Error "Доступ запрещён" + | Some quiz -> + quiz.AssignedStudentIds + |> Set.toList + |> List.choose store.TryGetUser + |> List.sortBy (fun s -> s.Name) + |> List.map (toStudentResult store quiz) + |> Ok + +let handler (store: Store) : HttpHandler = + bindJson (fun req next ctx -> + task { + let result = + Server.Auth.requireRole [ Teacher; Admin ] ctx.User + |> Result.bind (fun uid -> getResults store uid req) + + return! json result next ctx + }) diff --git a/src/Server/Features/Teacher/ListMyQuizzes.fs b/src/Server/Features/Teacher/ListMyQuizzes.fs new file mode 100644 index 0000000..54a53a2 --- /dev/null +++ b/src/Server/Features/Teacher/ListMyQuizzes.fs @@ -0,0 +1,35 @@ +module Server.Features.Teacher.ListMyQuizzes + +open Giraffe +open Domain +open Domain.Contracts +open Server.Store + +let private toSourceInput (source: QuizQuestionSource) : QuizQuestionSourceInput = + match source with + | FixedQuestion r -> FixedQuestionInput r.QuestionId + | RandomFromTopic(topicId, count, _) -> RandomPoolInput { TopicId = topicId; Count = count } + +/// Reused by `AssignStudents.fs`, mirroring how `CreateQuestion.toSummary` is +/// reused from `ListQuestions.fs`. +let toAdminSummary (quiz: Quiz) : QuizAdminSummary = + { Id = quiz.Id + Title = quiz.Title + Description = quiz.Description + TimeLimitMinutes = quiz.TimeLimit |> Option.map (fun t -> int t.TotalMinutes) + MaxAttempts = quiz.MaxAttempts + PassingScore = quiz.PassingScore + ShuffleQuestions = quiz.ShuffleQuestions + ShuffleAnswers = quiz.ShuffleAnswers + Sources = quiz.QuestionSources |> List.sortBy Quiz.sourceOrder |> List.map toSourceInput + AssignedStudentIds = Set.toList quiz.AssignedStudentIds } + +let handler (store: Store) : HttpHandler = + fun next ctx -> + task { + let result = + Server.Auth.requireRole [ Teacher; Admin ] ctx.User + |> Result.map (fun uid -> store.QuizzesByOwner uid |> List.map toAdminSummary) + + return! json result next ctx + } diff --git a/src/Server/Features/Teacher/ListQuestions.fs b/src/Server/Features/Teacher/ListQuestions.fs new file mode 100644 index 0000000..434502e --- /dev/null +++ b/src/Server/Features/Teacher/ListQuestions.fs @@ -0,0 +1,23 @@ +module Server.Features.Teacher.ListQuestions + +open Giraffe +open Domain +open Domain.Contracts +open Server.Store +open Server.Features.Teacher.CreateQuestion + +let private list (store: Store) (ownerId: UserId) (req: ListQuestionsRequest) : Result = + match store.TryGetTopic req.TopicId with + | None -> Error "Тема не найдена" + | Some topic when topic.OwnerId <> ownerId -> Error "Доступ запрещён" + | Some _ -> Ok(store.QuestionsByTopic req.TopicId |> List.map toSummary) + +let handler (store: Store) : HttpHandler = + bindJson (fun req next ctx -> + task { + let result = + Server.Auth.requireRole [ Teacher; Admin ] ctx.User + |> Result.bind (fun uid -> list store uid req) + + return! json result next ctx + }) diff --git a/src/Server/Features/Teacher/ListStudents.fs b/src/Server/Features/Teacher/ListStudents.fs new file mode 100644 index 0000000..16c8b1b --- /dev/null +++ b/src/Server/Features/Teacher/ListStudents.fs @@ -0,0 +1,20 @@ +module Server.Features.Teacher.ListStudents + +open Giraffe +open Domain +open Domain.Contracts +open Server.Store + +let private toStudentSummary (u: User) : StudentSummary = { Id = u.Id; Name = u.Name; Email = u.Email } + +/// Shared read-only directory — any Teacher/Admin can assign any student, +/// there's no "owns the student" concept (see DESIGN.md §4.2). +let handler (store: Store) : HttpHandler = + fun next ctx -> + task { + let result = + Server.Auth.requireRole [ Teacher; Admin ] ctx.User + |> Result.map (fun _ -> store.UsersByRole Student |> List.map toStudentSummary) + + return! json result next ctx + } diff --git a/src/Server/Features/Teacher/ListTopics.fs b/src/Server/Features/Teacher/ListTopics.fs new file mode 100644 index 0000000..9bf0a9a --- /dev/null +++ b/src/Server/Features/Teacher/ListTopics.fs @@ -0,0 +1,12 @@ +module Server.Features.Teacher.ListTopics + +open Giraffe +open Domain +open Server.Store + +let handler (store: Store) : HttpHandler = + fun next ctx -> + task { + let result = Server.Auth.requireRole [ Teacher; Admin ] ctx.User |> Result.map store.TopicsByOwner + return! json result next ctx + } diff --git a/src/Server/Features/Teacher/UpdateQuestion.fs b/src/Server/Features/Teacher/UpdateQuestion.fs new file mode 100644 index 0000000..fcf0996 --- /dev/null +++ b/src/Server/Features/Teacher/UpdateQuestion.fs @@ -0,0 +1,36 @@ +module Server.Features.Teacher.UpdateQuestion + +open Giraffe +open Domain +open Domain.Contracts +open Server.Store +open Server.Features.Teacher.CreateQuestion + +let private update (store: Store) (ownerId: UserId) (req: UpdateQuestionRequest) : Result = + match store.TryGetQuestion req.QuestionId with + | None -> Error "Вопрос не найден" + | Some existing -> + match store.TryGetTopic existing.TopicId with + | Some topic when topic.OwnerId = ownerId -> + let updated = + { existing with + Text = req.Text + Points = req.Points + Type = toDomainType req.Type } + + match QuestionValidation.validate updated with + | Error errors -> Error(String.concat "; " errors) + | Ok validQuestion -> + store.AddQuestion validQuestion + Ok(toSummary validQuestion) + | _ -> Error "Доступ запрещён" + +let handler (store: Store) : HttpHandler = + bindJson (fun req next ctx -> + task { + let result = + Server.Auth.requireRole [ Teacher; Admin ] ctx.User + |> Result.bind (fun uid -> update store uid req) + + return! json result next ctx + }) diff --git a/src/Server/Features/Teacher/UpdateQuiz.fs b/src/Server/Features/Teacher/UpdateQuiz.fs new file mode 100644 index 0000000..37ab999 --- /dev/null +++ b/src/Server/Features/Teacher/UpdateQuiz.fs @@ -0,0 +1,44 @@ +module Server.Features.Teacher.UpdateQuiz + +open System +open Giraffe +open Domain +open Domain.Contracts +open Server.Store +open Server.Features.Teacher.ListMyQuizzes +open Server.Features.Teacher.CreateQuiz + +let private update (store: Store) (ownerId: UserId) (req: UpdateQuizRequest) : Result = + match store.TryGetQuiz req.QuizId with + | None -> Error "Тест не найден" + | Some existing when existing.OwnerId <> ownerId -> Error "Доступ запрещён" + | Some existing -> + match resolveSources store ownerId req.Sources with + | Error err -> Error err + | Ok sources -> + let updated = + { existing with + Title = req.Title + Description = req.Description + TimeLimit = req.TimeLimitMinutes |> Option.map (float >> TimeSpan.FromMinutes) + MaxAttempts = req.MaxAttempts + ShuffleQuestions = req.ShuffleQuestions + ShuffleAnswers = req.ShuffleAnswers + PassingScore = req.PassingScore + QuestionSources = sources } + + match QuizValidation.validate updated with + | Error errors -> Error(String.concat "; " errors) + | Ok validQuiz -> + store.AddQuiz validQuiz + Ok(toAdminSummary validQuiz) + +let handler (store: Store) : HttpHandler = + bindJson (fun req next ctx -> + task { + let result = + Server.Auth.requireRole [ Teacher; Admin ] ctx.User + |> Result.bind (fun uid -> update store uid req) + + return! json result next ctx + }) diff --git a/src/Server/Json.fs b/src/Server/Json.fs new file mode 100644 index 0000000..c1b8aa7 --- /dev/null +++ b/src/Server/Json.fs @@ -0,0 +1,18 @@ +module Server.Json + +open Newtonsoft.Json +open Fable.Remoting.Json + +/// Newtonsoft settings using Fable.Remoting.Json's converter, so F# unions +/// (Result, Option, DU-wrapped ids, QuestionType, ...) serialize to the same +/// wire shape the client already knows how to decode +/// ({"Ok": ...}/{"Error": ...}, {"CaseName": ""}, etc.), independent of +/// the Fable.Remoting routing machinery this project no longer uses. +let settings = + let s = JsonSerializerSettings() + s.Converters.Add(FableJsonConverter()) + s + +/// Giraffe's registered Json.ISerializer, used by `Giraffe.HttpContextExtensions` +/// (`ctx.BindJsonAsync`, `Giraffe.json`) throughout `Server.Features.*`. +let serializer = Giraffe.NewtonsoftJson.Serializer(settings) diff --git a/src/Server/Migrations/0001_initial_schema.sql b/src/Server/Migrations/0001_initial_schema.sql new file mode 100644 index 0000000..96cd84f --- /dev/null +++ b/src/Server/Migrations/0001_initial_schema.sql @@ -0,0 +1,243 @@ +-- Initial schema for the quiz system. +-- Every primary key is a Guid already generated by the application (Id.newXxxId()), +-- so no DEFAULT gen_random_uuid() anywhere. Plain enums without payload data +-- (Role, GradingMethod, AttemptState) are TEXT + CHECK; DU cases that carry +-- their own data get a dedicated detail table, per the full-normalization +-- decision for this project. + +-- ============================================================ +-- Users +-- ============================================================ +CREATE TABLE users ( + id uuid PRIMARY KEY, + name text NOT NULL, + email text NOT NULL, + password_hash text NOT NULL, + role text NOT NULL CHECK (role IN ('Admin', 'Teacher', 'Student')) +); + +CREATE UNIQUE INDEX users_email_lower_idx ON users (lower(email)); +CREATE INDEX users_role_idx ON users (role); + +-- ============================================================ +-- Topics +-- ============================================================ +CREATE TABLE topics ( + id uuid PRIMARY KEY, + owner_id uuid NOT NULL REFERENCES users (id), + name text NOT NULL +); + +CREATE INDEX topics_owner_idx ON topics (owner_id); + +-- ============================================================ +-- Questions (QuestionType: SingleChoice | MultipleChoice | TrueFalse | ShortAnswer | Numeric) +-- ============================================================ +CREATE TABLE questions ( + id uuid PRIMARY KEY, + topic_id uuid NOT NULL REFERENCES topics (id), + text text NOT NULL, + points double precision NOT NULL, + question_type text NOT NULL + CHECK (question_type IN ('SingleChoice', 'MultipleChoice', 'TrueFalse', 'ShortAnswer', 'Numeric')) +); + +CREATE INDEX questions_topic_idx ON questions (topic_id); + +-- Shared ordered option list for SingleChoice / MultipleChoice. `position` is +-- synthetic (the domain's QuestionOption has no explicit Order field) — it +-- only exists so the DB preserves the list order the app re-supplies on write. +CREATE TABLE question_options ( + id uuid PRIMARY KEY, + question_id uuid NOT NULL REFERENCES questions (id) ON DELETE CASCADE, + text text NOT NULL, + position int NOT NULL +); + +CREATE INDEX question_options_question_idx ON question_options (question_id, position); + +-- SingleChoice: exactly one correct option. +CREATE TABLE question_single_choice ( + question_id uuid PRIMARY KEY REFERENCES questions (id) ON DELETE CASCADE, + correct_option_id uuid NOT NULL REFERENCES question_options (id) +); + +-- MultipleChoice: correct-options set. No separate "detail" table needed — +-- its only payload beyond the shared options list is this junction table. +CREATE TABLE question_multiple_choice_correct ( + question_id uuid NOT NULL REFERENCES questions (id) ON DELETE CASCADE, + option_id uuid NOT NULL REFERENCES question_options (id), + PRIMARY KEY (question_id, option_id) +); + +-- TrueFalse: single bool. +CREATE TABLE question_true_false ( + question_id uuid PRIMARY KEY REFERENCES questions (id) ON DELETE CASCADE, + correct_answer boolean NOT NULL +); + +-- ShortAnswer: case-sensitivity flag + ordered list of accepted answers. +CREATE TABLE question_short_answer ( + question_id uuid PRIMARY KEY REFERENCES questions (id) ON DELETE CASCADE, + case_sensitive boolean NOT NULL +); + +CREATE TABLE question_short_answer_accepted ( + question_id uuid NOT NULL REFERENCES question_short_answer (question_id) ON DELETE CASCADE, + answer_text text NOT NULL, + position int NOT NULL, + PRIMARY KEY (question_id, position) +); + +-- Numeric: correct value + tolerance. +CREATE TABLE question_numeric ( + question_id uuid PRIMARY KEY REFERENCES questions (id) ON DELETE CASCADE, + correct_value double precision NOT NULL, + tolerance double precision NOT NULL +); + +-- ============================================================ +-- Quizzes (QuizQuestionSource: FixedQuestion | RandomFromTopic) +-- ============================================================ +CREATE TABLE quizzes ( + id uuid PRIMARY KEY, + owner_id uuid NOT NULL REFERENCES users (id), + title text NOT NULL, + description text NOT NULL, + time_limit interval, + max_attempts int, + grading_method text NOT NULL + CHECK (grading_method IN ('HighestAttempt', 'AverageAttempt', 'FirstAttempt', 'LastAttempt')), + shuffle_questions boolean NOT NULL, + shuffle_answers boolean NOT NULL, + open_from timestamptz, + open_to timestamptz, + passing_score double precision +); + +CREATE INDEX quizzes_owner_idx ON quizzes (owner_id); + +-- One row per QuizQuestionSource list entry; order_index mirrors the domain's +-- own `Order` field on that DU case. +CREATE TABLE quiz_question_sources ( + id uuid PRIMARY KEY, + quiz_id uuid NOT NULL REFERENCES quizzes (id) ON DELETE CASCADE, + source_type text NOT NULL CHECK (source_type IN ('Fixed', 'RandomFromTopic')), + order_index int NOT NULL +); + +CREATE INDEX quiz_question_sources_quiz_idx ON quiz_question_sources (quiz_id, order_index); + +CREATE TABLE quiz_question_source_fixed ( + source_id uuid PRIMARY KEY REFERENCES quiz_question_sources (id) ON DELETE CASCADE, + question_id uuid NOT NULL REFERENCES questions (id), + points double precision NOT NULL +); + +CREATE TABLE quiz_question_source_random ( + source_id uuid PRIMARY KEY REFERENCES quiz_question_sources (id) ON DELETE CASCADE, + topic_id uuid NOT NULL REFERENCES topics (id), + count int NOT NULL +); + +CREATE TABLE quiz_assigned_students ( + quiz_id uuid NOT NULL REFERENCES quizzes (id) ON DELETE CASCADE, + user_id uuid NOT NULL REFERENCES users (id), + PRIMARY KEY (quiz_id, user_id) +); + +-- ============================================================ +-- Attempts (StudentResponse: SingleChoiceResponse | MultipleChoiceResponse | +-- TrueFalseResponse | ShortAnswerResponse | NumericResponse) +-- ============================================================ +CREATE TABLE attempts ( + id uuid PRIMARY KEY, + quiz_id uuid NOT NULL REFERENCES quizzes (id), + user_id uuid NOT NULL REFERENCES users (id), + started_at timestamptz NOT NULL, + submitted_at timestamptz, + state text NOT NULL CHECK (state IN ('InProgress', 'Submitted', 'Graded')), + score double precision +); + +CREATE INDEX attempts_quiz_user_idx ON attempts (quiz_id, user_id); + +-- The resolved per-attempt question snapshot (Attempt.Questions). For +-- RandomFromTopic sources each attempt draws its own random subset at start +-- time, so this table — not quiz_question_sources — is the only source of +-- truth for what a given attempt actually contained; grading and max-score +-- always read this. +CREATE TABLE attempt_questions ( + attempt_id uuid NOT NULL REFERENCES attempts (id) ON DELETE CASCADE, + question_id uuid NOT NULL REFERENCES questions (id), + points double precision NOT NULL, + order_index int NOT NULL, + PRIMARY KEY (attempt_id, question_id) +); + +-- Discriminator row per Attempt.Responses map entry. +CREATE TABLE attempt_responses ( + attempt_id uuid NOT NULL REFERENCES attempts (id) ON DELETE CASCADE, + question_id uuid NOT NULL REFERENCES questions (id), + response_type text NOT NULL + CHECK (response_type IN + ('SingleChoiceResponse', 'MultipleChoiceResponse', 'TrueFalseResponse', + 'ShortAnswerResponse', 'NumericResponse')), + PRIMARY KEY (attempt_id, question_id) +); + +CREATE TABLE attempt_response_single_choice ( + attempt_id uuid NOT NULL, + question_id uuid NOT NULL, + selected_option_id uuid REFERENCES question_options (id), + PRIMARY KEY (attempt_id, question_id), + FOREIGN KEY (attempt_id, question_id) + REFERENCES attempt_responses (attempt_id, question_id) ON DELETE CASCADE +); + +-- MultipleChoiceResponse's Set — a junction table; absence of rows +-- for a given (attempt_id, question_id) simply means an empty set. +CREATE TABLE attempt_response_multiple_choice ( + attempt_id uuid NOT NULL, + question_id uuid NOT NULL, + option_id uuid NOT NULL REFERENCES question_options (id), + PRIMARY KEY (attempt_id, question_id, option_id), + FOREIGN KEY (attempt_id, question_id) + REFERENCES attempt_responses (attempt_id, question_id) ON DELETE CASCADE +); + +CREATE TABLE attempt_response_true_false ( + attempt_id uuid NOT NULL, + question_id uuid NOT NULL, + answer boolean, + PRIMARY KEY (attempt_id, question_id), + FOREIGN KEY (attempt_id, question_id) + REFERENCES attempt_responses (attempt_id, question_id) ON DELETE CASCADE +); + +CREATE TABLE attempt_response_short_answer ( + attempt_id uuid NOT NULL, + question_id uuid NOT NULL, + answer_text text NOT NULL, + PRIMARY KEY (attempt_id, question_id), + FOREIGN KEY (attempt_id, question_id) + REFERENCES attempt_responses (attempt_id, question_id) ON DELETE CASCADE +); + +CREATE TABLE attempt_response_numeric ( + attempt_id uuid NOT NULL, + question_id uuid NOT NULL, + value double precision, + PRIMARY KEY (attempt_id, question_id), + FOREIGN KEY (attempt_id, question_id) + REFERENCES attempt_responses (attempt_id, question_id) ON DELETE CASCADE +); + +CREATE TABLE attempt_grades ( + attempt_id uuid NOT NULL REFERENCES attempts (id) ON DELETE CASCADE, + question_id uuid NOT NULL REFERENCES questions (id), + points_awarded double precision NOT NULL, + max_points double precision NOT NULL, + is_correct boolean NOT NULL, + PRIMARY KEY (attempt_id, question_id) +); diff --git a/src/Server/Migrations/0002_add_user_is_active.sql b/src/Server/Migrations/0002_add_user_is_active.sql new file mode 100644 index 0000000..732dbfb --- /dev/null +++ b/src/Server/Migrations/0002_add_user_is_active.sql @@ -0,0 +1,4 @@ +-- Adds the ability for Admin to deactivate a user's account (login blocked) +-- instead of a hard delete, consistent with the soft-delete pattern already +-- used for questions/quizzes when they have attached history. +ALTER TABLE users ADD COLUMN is_active boolean NOT NULL DEFAULT true; diff --git a/src/Server/Migrations/0003_add_attempt_focus_loss.sql b/src/Server/Migrations/0003_add_attempt_focus_loss.sql new file mode 100644 index 0000000..980b5ff --- /dev/null +++ b/src/Server/Migrations/0003_add_attempt_focus_loss.sql @@ -0,0 +1,4 @@ +-- Tracks how many times a student's browser tab lost focus during an +-- attempt (anti-cheating signal shown to the teacher). Incremented only +-- server-side, in a single atomic UPDATE — see AttemptRepository.incrementFocusLoss. +ALTER TABLE attempts ADD COLUMN focus_loss_count integer NOT NULL DEFAULT 0; diff --git a/src/Server/Program.fs b/src/Server/Program.fs new file mode 100644 index 0000000..5aca4ad --- /dev/null +++ b/src/Server/Program.fs @@ -0,0 +1,92 @@ +module Server.Program + +open Microsoft.AspNetCore.Authentication.JwtBearer +open Microsoft.AspNetCore.Builder +open Microsoft.Extensions.Configuration +open Microsoft.Extensions.DependencyInjection +open Microsoft.Extensions.Logging +open Giraffe +open Server.Db +open Server.Store + +/// Every handler already returns `Result<_, string>` as its wire shape, so an +/// *unexpected* exception (e.g. a Postgres constraint violation from a +/// double-submitted request) should degrade to that same `{"Error": ...}` +/// JSON shape instead of the framework's default empty 500 body — an empty +/// body makes the client's `response.json()` throw a confusing +/// "unexpected end of data" parse error instead of a readable message. +let private errorHandler (ex: exn) (logger: ILogger) : HttpHandler = + logger.LogError(ex, "Unhandled exception while handling request") + let result: Result = Error "Внутренняя ошибка сервера, попробуйте ещё раз" + setStatusCode 500 >=> json result + +[] +let main args = + let builder = WebApplication.CreateBuilder(args) + + let jwtSecret = + match builder.Configuration.["Jwt:Secret"] with + | null + | "" -> "dev-secret-change-me-please-32-chars-min" + | secret -> secret + + let clientOrigin = + match builder.Configuration.["Client:Origin"] with + | null + | "" -> "http://localhost:5173" + | origin -> origin + + let connectionString = + match builder.Configuration.GetConnectionString("Postgres") with + | null + | "" -> failwith "ConnectionStrings:Postgres is not configured" + | cs -> cs + + Db.TypeHandlers.register () + Db.Migrator.run connectionString + + let store = Store(connectionString) + + // Postgres persists across restarts, unlike the old in-memory Store — + // re-running Seed.run unconditionally on every boot would either violate + // the unique email index or duplicate demo data, so only seed once. + if (store.TryGetUserByEmail "teacher@example.com").IsNone then + Seed.run store + + builder.Services + .AddAuthentication(fun opts -> + opts.DefaultAuthenticateScheme <- JwtBearerDefaults.AuthenticationScheme + opts.DefaultChallengeScheme <- JwtBearerDefaults.AuthenticationScheme) + .AddJwtBearer(fun opts -> + opts.MapInboundClaims <- false + opts.TokenValidationParameters <- Auth.tokenValidationParameters jwtSecret) + |> ignore + + builder.Services.AddAuthorization() |> ignore + + builder.Services.AddCors(fun opts -> + opts.AddDefaultPolicy(fun policy -> policy.WithOrigins(clientOrigin).AllowAnyHeader().AllowAnyMethod() |> ignore)) + |> ignore + + // Reuses Fable.Remoting.Json's converter (via Server.Json) so the wire + // format (Result/Option/DU-id shapes) matches what Client/Shared/JsonWire.fs + // already decodes, without pulling in Fable.Remoting's routing layer. + builder.Services.AddSingleton(Server.Json.serializer) |> ignore + + // Registered so ExpirySweeperService (below) can receive it via DI — + // Routes.build still gets `store` passed directly, unrelated to this. + builder.Services.AddSingleton(store) |> ignore + builder.Services.AddHostedService() |> ignore + + let app = builder.Build() + + app.UseGiraffeErrorHandler(errorHandler) |> ignore + app.UseCors() |> ignore + app.UseAuthentication() |> ignore + app.UseAuthorization() |> ignore + + app.UseGiraffe(Routes.build store jwtSecret) + + app.Run() + 0 + diff --git a/src/Server/Properties/launchSettings.json b/src/Server/Properties/launchSettings.json new file mode 100644 index 0000000..940b30b --- /dev/null +++ b/src/Server/Properties/launchSettings.json @@ -0,0 +1,23 @@ +{ + "$schema": "https://json.schemastore.org/launchsettings.json", + "profiles": { + "http": { + "commandName": "Project", + "dotnetRunMessages": true, + "launchBrowser": true, + "applicationUrl": "http://localhost:5144", + "environmentVariables": { + "ASPNETCORE_ENVIRONMENT": "Development" + } + }, + "https": { + "commandName": "Project", + "dotnetRunMessages": true, + "launchBrowser": true, + "applicationUrl": "https://localhost:7174;http://localhost:5144", + "environmentVariables": { + "ASPNETCORE_ENVIRONMENT": "Development" + } + } + } +} diff --git a/src/Server/Routes.fs b/src/Server/Routes.fs new file mode 100644 index 0000000..bfa2516 --- /dev/null +++ b/src/Server/Routes.fs @@ -0,0 +1,36 @@ +module Server.Routes + +open Giraffe +open Server.Store +open Server.Features + +/// Thin composition root: lists each feature's already self-contained +/// HttpHandler under its route, no logic of its own. +let build (store: Store) (jwtSecret: string) : HttpHandler = + choose [ + POST >=> route "/api/login" >=> Auth.Login.handler store jwtSecret + GET >=> route "/api/quizzes" >=> Quizzes.GetAvailableQuizzes.handler store + POST >=> route "/api/quizzes/start" >=> Quizzes.StartAttempt.handler store + POST >=> route "/api/quizzes/my-attempts" >=> Quizzes.GetMyAttempts.handler store + POST >=> route "/api/attempts/answer" >=> Attempts.SubmitAnswer.handler store + POST >=> route "/api/attempts/finish" >=> Attempts.FinishAttempt.handler store + POST >=> route "/api/attempts/focus-loss" >=> Attempts.ReportFocusLoss.handler store + POST >=> route "/api/teacher/topics" >=> Teacher.CreateTopic.handler store + GET >=> route "/api/teacher/topics" >=> Teacher.ListTopics.handler store + POST >=> route "/api/teacher/questions" >=> Teacher.CreateQuestion.handler store + POST >=> route "/api/teacher/questions/list" >=> Teacher.ListQuestions.handler store + POST >=> route "/api/teacher/questions/update" >=> Teacher.UpdateQuestion.handler store + POST >=> route "/api/teacher/questions/delete" >=> Teacher.DeleteQuestion.handler store + GET >=> route "/api/teacher/quizzes" >=> Teacher.ListMyQuizzes.handler store + GET >=> route "/api/teacher/students" >=> Teacher.ListStudents.handler store + POST >=> route "/api/teacher/quizzes/assign" >=> Teacher.AssignStudents.handler store + POST >=> route "/api/teacher/quizzes/create" >=> Teacher.CreateQuiz.handler store + POST >=> route "/api/teacher/quizzes/update" >=> Teacher.UpdateQuiz.handler store + POST >=> route "/api/teacher/quizzes/delete" >=> Teacher.DeleteQuiz.handler store + POST >=> route "/api/teacher/quizzes/results" >=> Teacher.GetQuizResults.handler store + GET >=> route "/api/admin/users" >=> Admin.ListUsers.handler store + POST >=> route "/api/admin/users/create" >=> Admin.CreateUser.handler store + POST >=> route "/api/admin/users/update" >=> Admin.UpdateUser.handler store + POST >=> route "/api/admin/users/set-active" >=> Admin.SetUserActive.handler store + POST >=> route "/api/admin/users/reset-password" >=> Admin.ResetPassword.handler store + ] diff --git a/src/Server/Seed.fs b/src/Server/Seed.fs new file mode 100644 index 0000000..e12e417 --- /dev/null +++ b/src/Server/Seed.fs @@ -0,0 +1,95 @@ +module Server.Seed + +open System +open Domain +open Server.Store + +/// Demo data so the system can be exercised end-to-end before real +/// question-authoring tools exist: one teacher, one admin, one student, one quiz. +let run (store: Store) = + let teacherId = Id.newUserId () + let studentId = Id.newUserId () + let adminId = Id.newUserId () + + store.AddUser + { Id = teacherId + Name = "Мария Иванова" + Email = "teacher@example.com" + PasswordHash = BCrypt.Net.BCrypt.HashPassword "teacher123" + Role = Teacher + IsActive = true } + + store.AddUser + { Id = studentId + Name = "Пётр Смирнов" + Email = "student@example.com" + PasswordHash = BCrypt.Net.BCrypt.HashPassword "student123" + Role = Student + IsActive = true } + + store.AddUser + { Id = adminId + Name = "Администратор" + Email = "admin@example.com" + PasswordHash = BCrypt.Net.BCrypt.HashPassword "admin123" + Role = Admin + IsActive = true } + + let topicId = Id.newTopicId () + store.AddTopic { Id = topicId; OwnerId = teacherId; Name = "Общие вопросы" } + + let optImmutable = { Id = Id.newOptionId (); Text = "Неизменяемый (immutable)" } + let optMutable = { Id = Id.newOptionId (); Text = "Изменяемый (mutable)" } + + let q1: Question = + { Id = Id.newQuestionId () + TopicId = topicId + Text = "Каким по умолчанию является let-байндинг в F#?" + Points = 1.0 + Type = SingleChoice([ optImmutable; optMutable ], optImmutable.Id) } + + store.AddQuestion q1 + + let q2: Question = + { Id = Id.newQuestionId () + TopicId = topicId + Text = "F# — функциональный язык программирования." + Points = 1.0 + Type = TrueFalse true } + + store.AddQuestion q2 + + let q3: Question = + { Id = Id.newQuestionId () + TopicId = topicId + Text = "Сколько будет 7 + 5?" + Points = 1.0 + Type = Numeric(12.0, 0.0) } + + store.AddQuestion q3 + + let quizId = Id.newQuizId () + + let quiz: Quiz = + { Id = quizId + OwnerId = teacherId + Title = "Тест: Основы F#" + Description = "Проверьте базовые знания языка F#" + TimeLimit = Some(TimeSpan.FromMinutes 15.0) + MaxAttempts = Some 3 + GradingMethod = HighestAttempt + ShuffleQuestions = false + ShuffleAnswers = false + OpenFrom = None + OpenTo = None + PassingScore = Some 2.0 + QuestionSources = + [ FixedQuestion { QuestionId = q1.Id; Points = 1.0; Order = 0 } + FixedQuestion { QuestionId = q2.Id; Points = 1.0; Order = 1 } + FixedQuestion { QuestionId = q3.Id; Points = 1.0; Order = 2 } ] + AssignedStudentIds = Set.ofList [ studentId ] } + + store.AddQuiz quiz + + printfn + "Demo users: teacher@example.com / teacher123, student@example.com / student123, admin@example.com / admin123" diff --git a/src/Server/Server.fsproj b/src/Server/Server.fsproj new file mode 100644 index 0000000..2fb8bd8 --- /dev/null +++ b/src/Server/Server.fsproj @@ -0,0 +1,69 @@ + + + + net9.0 + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + diff --git a/src/Server/Store.fs b/src/Server/Store.fs new file mode 100644 index 0000000..dc5783e --- /dev/null +++ b/src/Server/Store.fs @@ -0,0 +1,63 @@ +module Server.Store + +open Domain +open Server.Db + +/// PostgreSQL-backed repository facade — every member is a one-line delegate +/// into the matching `Server/Db/*Repository.fs` module, behind the exact +/// member surface the in-memory `ConcurrentDictionary` version had (so none +/// of the ~30 `Server/Features/**/*.fs` handlers needed to change). +type Store(connectionString: string) = + + member _.AddUser(user: User) = UserRepository.addUser connectionString user + member _.TryGetUserByEmail(email: string) = UserRepository.tryGetUserByEmail connectionString email + member _.TryGetUser(id: UserId) = UserRepository.tryGetUser connectionString id + member _.UsersByRole(role: Role) : User list = UserRepository.usersByRole connectionString role + member _.AllUsers() : User list = UserRepository.listUsers connectionString + + member _.AddTopic(topic: Topic) = TopicRepository.addTopic connectionString topic + member _.TryGetTopic(id: TopicId) = TopicRepository.tryGetTopic connectionString id + member _.TopicsByOwner(ownerId: UserId) : Topic list = TopicRepository.topicsByOwner connectionString ownerId + + member _.AddQuestion(question: Question) = QuestionRepository.addQuestion connectionString question + member _.TryGetQuestion(id: QuestionId) = QuestionRepository.tryGetQuestion connectionString id + member _.RemoveQuestion(id: QuestionId) = QuestionRepository.removeQuestion connectionString id + + member _.QuestionsByIds(ids: QuestionId seq) : Map = + QuestionRepository.questionsByIds connectionString ids + + member _.QuestionsByTopic(topicId: TopicId) : Question list = + QuestionRepository.questionsByTopic connectionString topicId + + /// Whether `questionId` appears in any quiz's fixed question list — + /// checked before allowing a bank question to be deleted. Random-pool + /// sources don't reference a specific question id, so they never block + /// a delete here even if the question happens to live in that topic. + member _.IsQuestionUsed(questionId: QuestionId) : bool = + QuestionRepository.isQuestionUsed connectionString questionId + + member _.AddQuiz(quiz: Quiz) = QuizRepository.addQuiz connectionString quiz + member _.RemoveQuiz(id: QuizId) = QuizRepository.removeQuiz connectionString id + member _.AllQuizzes() : Quiz list = QuizRepository.allQuizzes connectionString + member _.QuizzesByOwner(ownerId: UserId) : Quiz list = QuizRepository.quizzesByOwner connectionString ownerId + member _.TryGetQuiz(id: QuizId) = QuizRepository.tryGetQuiz connectionString id + + member _.SaveAttempt(attempt: Attempt) = AttemptRepository.saveAttempt connectionString attempt + member _.TryGetAttempt(id: AttemptId) = AttemptRepository.tryGetAttempt connectionString id + + member _.AttemptsForQuiz(quizId: QuizId, userId: UserId) : Attempt list = + AttemptRepository.attemptsForQuiz connectionString quizId userId + + /// Whether any student (not just one) has ever attempted this quiz — + /// checked before allowing it to be deleted. + member _.AnyAttemptsForQuiz(quizId: QuizId) : bool = + AttemptRepository.anyAttemptsForQuiz connectionString quizId + + /// `InProgress` attempts whose quiz's time limit has already elapsed — + /// polled by the background expiry sweeper. + member _.ExpiredInProgressAttempts() : Attempt list = + AttemptRepository.findExpiredInProgressAttemptIds connectionString + |> List.choose (AttemptRepository.tryGetAttempt connectionString) + + member _.IncrementFocusLoss(attemptId: AttemptId) = + AttemptRepository.incrementFocusLoss connectionString attemptId diff --git a/src/Server/appsettings.Development.json b/src/Server/appsettings.Development.json new file mode 100644 index 0000000..c7240c8 --- /dev/null +++ b/src/Server/appsettings.Development.json @@ -0,0 +1,14 @@ +{ + "Logging": { + "LogLevel": { + "Default": "Information", + "Microsoft.AspNetCore": "Warning" + } + }, + "Client": { + "Origin": "http://localhost:5173" + }, + "ConnectionStrings": { + "Postgres": "Host=localhost;Port=5432;Database=quizsystem;Username=quizsystem;Password=devpassword" + } +} diff --git a/src/Server/appsettings.json b/src/Server/appsettings.json new file mode 100644 index 0000000..10f68b8 --- /dev/null +++ b/src/Server/appsettings.json @@ -0,0 +1,9 @@ +{ + "Logging": { + "LogLevel": { + "Default": "Information", + "Microsoft.AspNetCore": "Warning" + } + }, + "AllowedHosts": "*" +} diff --git a/tests/Domain.Tests/Domain.Tests.fsproj b/tests/Domain.Tests/Domain.Tests.fsproj new file mode 100644 index 0000000..b36d1dd --- /dev/null +++ b/tests/Domain.Tests/Domain.Tests.fsproj @@ -0,0 +1,26 @@ + + + + net9.0 + false + false + + + + + + + + + + + + + + + + + + + + diff --git a/tests/Domain.Tests/GradingTests.fs b/tests/Domain.Tests/GradingTests.fs new file mode 100644 index 0000000..fe68ca0 --- /dev/null +++ b/tests/Domain.Tests/GradingTests.fs @@ -0,0 +1,182 @@ +module Domain.Tests.GradingTests + +open System +open Xunit +open Domain + +let private optA = { Id = OptionId(Guid.NewGuid()); Text = "A" } +let private optB = { Id = OptionId(Guid.NewGuid()); Text = "B" } +let private optC = { Id = OptionId(Guid.NewGuid()); Text = "C" } + +let private newQuestionId () = QuestionId(Guid.NewGuid()) + +[] +let ``single choice: correct option awards full points`` () = + let qId = newQuestionId () + let qType = SingleChoice([ optA; optB; optC ], optB.Id) + let grade = Grading.gradeResponse qId qType 10.0 (SingleChoiceResponse(Some optB.Id)) + Assert.True grade.IsCorrect + Assert.Equal(10.0, grade.PointsAwarded) + +[] +let ``single choice: wrong option awards zero`` () = + let qId = newQuestionId () + let qType = SingleChoice([ optA; optB; optC ], optB.Id) + let grade = Grading.gradeResponse qId qType 10.0 (SingleChoiceResponse(Some optA.Id)) + Assert.False grade.IsCorrect + Assert.Equal(0.0, grade.PointsAwarded) + +[] +let ``single choice: unanswered awards zero`` () = + let qId = newQuestionId () + let qType = SingleChoice([ optA; optB ], optB.Id) + let grade = Grading.gradeResponse qId qType 10.0 (SingleChoiceResponse None) + Assert.False grade.IsCorrect + +[] +let ``multiple choice: exact set match is correct`` () = + let qId = newQuestionId () + let correct = Set.ofList [ optA.Id; optC.Id ] + let qType = MultipleChoice([ optA; optB; optC ], correct) + let grade = Grading.gradeResponse qId qType 5.0 (MultipleChoiceResponse(Set.ofList [ optA.Id; optC.Id ])) + Assert.True grade.IsCorrect + +[] +let ``multiple choice: partial selection is incorrect`` () = + let qId = newQuestionId () + let correct = Set.ofList [ optA.Id; optC.Id ] + let qType = MultipleChoice([ optA; optB; optC ], correct) + let grade = Grading.gradeResponse qId qType 5.0 (MultipleChoiceResponse(Set.ofList [ optA.Id ])) + Assert.False grade.IsCorrect + +[] +let ``true false: matching answer is correct`` () = + let qId = newQuestionId () + let grade = Grading.gradeResponse qId (TrueFalse true) 2.0 (TrueFalseResponse(Some true)) + Assert.True grade.IsCorrect + +[] +let ``short answer: case-insensitive match by default`` () = + let qId = newQuestionId () + let qType = ShortAnswer([ "Paris" ], caseSensitive = false) + let grade = Grading.gradeResponse qId qType 3.0 (ShortAnswerResponse " paris ") + Assert.True grade.IsCorrect + +[] +let ``short answer: case-sensitive rejects mismatched case`` () = + let qId = newQuestionId () + let qType = ShortAnswer([ "Paris" ], caseSensitive = true) + let grade = Grading.gradeResponse qId qType 3.0 (ShortAnswerResponse "paris") + Assert.False grade.IsCorrect + +[] +let ``numeric: within tolerance is correct`` () = + let qId = newQuestionId () + let qType = Numeric(3.14, 0.01) + let grade = Grading.gradeResponse qId qType 4.0 (NumericResponse(Some 3.145)) + Assert.True grade.IsCorrect + +[] +let ``numeric: outside tolerance is incorrect`` () = + let qId = newQuestionId () + let qType = Numeric(3.14, 0.01) + let grade = Grading.gradeResponse qId qType 4.0 (NumericResponse(Some 3.2)) + Assert.False grade.IsCorrect + +let private sampleQuiz (questionRefs: QuizQuestionRef list) : Quiz = + { Id = QuizId(Guid.NewGuid()) + OwnerId = UserId(Guid.NewGuid()) + Title = "Sample quiz" + Description = "" + TimeLimit = None + MaxAttempts = None + GradingMethod = HighestAttempt + ShuffleQuestions = false + ShuffleAnswers = false + OpenFrom = None + OpenTo = None + PassingScore = None + QuestionSources = questionRefs |> List.map FixedQuestion + AssignedStudentIds = Set.empty } + +[] +let ``gradeAttempt: unanswered questions score zero without crashing`` () = + let qId = newQuestionId () + let question = + { Id = qId + TopicId = TopicId(Guid.NewGuid()) + Text = "2 + 2 = ?" + Points = 5.0 + Type = Numeric(4.0, 0.0) } + + let refs = [ { QuestionId = qId; Points = 5.0; Order = 0 } ] + let quiz = sampleQuiz refs + let questions = Map.ofList [ qId, question ] + + let attempt = + Attempt.start (AttemptId(Guid.NewGuid())) quiz refs (UserId(Guid.NewGuid())) DateTimeOffset.UtcNow + + let graded = Grading.gradeAttempt questions attempt + + Assert.Equal(Some 0.0, graded.Score) + Assert.Equal(Graded, graded.State) + +[] +let ``gradeAttempt: sums points across multiple questions`` () = + let q1Id, q2Id = newQuestionId (), newQuestionId () + + let q1 = + { Id = q1Id + TopicId = TopicId(Guid.NewGuid()) + Text = "Is the sky blue?" + Points = 1.0 + Type = TrueFalse true } + + let q2 = + { Id = q2Id + TopicId = TopicId(Guid.NewGuid()) + Text = "Capital of France?" + Points = 1.0 + Type = ShortAnswer([ "Paris" ], false) } + + let refs = + [ { QuestionId = q1Id; Points = 3.0; Order = 0 } + { QuestionId = q2Id; Points = 7.0; Order = 1 } ] + + let quiz = sampleQuiz refs + let questions = Map.ofList [ q1Id, q1; q2Id, q2 ] + + let attempt = + Attempt.start (AttemptId(Guid.NewGuid())) quiz refs (UserId(Guid.NewGuid())) DateTimeOffset.UtcNow + |> Attempt.recordResponse q1Id (TrueFalseResponse(Some true)) + |> Attempt.recordResponse q2Id (ShortAnswerResponse "paris") + + let graded = Grading.gradeAttempt questions attempt + + Assert.Equal(Some 10.0, graded.Score) + +[] +let ``applyGradingMethod: HighestAttempt picks the best score`` () = + let mkAttempt score started = + { Id = AttemptId(Guid.NewGuid()) + QuizId = QuizId(Guid.NewGuid()) + UserId = UserId(Guid.NewGuid()) + StartedAt = started + SubmittedAt = Some started + State = Graded + Questions = [] + Responses = Map.empty + Grades = Map.empty + Score = Some score + FocusLossCount = 0 } + + let now = DateTimeOffset.UtcNow + let attempts = [ mkAttempt 4.0 now; mkAttempt 9.0 (now.AddMinutes 1.0); mkAttempt 6.0 (now.AddMinutes 2.0) ] + + let result = Grading.applyGradingMethod HighestAttempt attempts + Assert.Equal(Some 9.0, result |> Option.bind (fun a -> a.Score)) + +[] +let ``applyGradingMethod: no graded attempts returns None`` () = + let result = Grading.applyGradingMethod HighestAttempt [] + Assert.Equal(None, result) diff --git a/tests/Domain.Tests/Program.fs b/tests/Domain.Tests/Program.fs new file mode 100644 index 0000000..31dc4f7 --- /dev/null +++ b/tests/Domain.Tests/Program.fs @@ -0,0 +1,4 @@ +module Program + +[] +let main _ = 0 diff --git a/tests/Domain.Tests/ValidationTests.fs b/tests/Domain.Tests/ValidationTests.fs new file mode 100644 index 0000000..bdfbc00 --- /dev/null +++ b/tests/Domain.Tests/ValidationTests.fs @@ -0,0 +1,98 @@ +module Domain.Tests.ValidationTests + +open System +open Xunit +open Domain + +let private newQuestion (qType: QuestionType) : Question = + { Id = QuestionId(Guid.NewGuid()) + TopicId = TopicId(Guid.NewGuid()) + Text = "Sample?" + Points = 1.0 + Type = qType } + +[] +let ``single choice: correct option must be among the listed options`` () = + let optA = { Id = OptionId(Guid.NewGuid()); Text = "A" } + let optB = { Id = OptionId(Guid.NewGuid()); Text = "B" } + let foreignId = OptionId(Guid.NewGuid()) + let question = newQuestion (SingleChoice([ optA; optB ], foreignId)) + + match QuestionValidation.validate question with + | Error errors -> Assert.Contains("Correct option must be one of the provided options", errors) + | Ok _ -> Assert.Fail "expected validation error" + +[] +let ``multiple choice: correct set must be subset of options`` () = + let optA = { Id = OptionId(Guid.NewGuid()); Text = "A" } + let optB = { Id = OptionId(Guid.NewGuid()); Text = "B" } + let foreignId = OptionId(Guid.NewGuid()) + let question = newQuestion (MultipleChoice([ optA; optB ], Set.ofList [ optA.Id; foreignId ])) + + match QuestionValidation.validate question with + | Error errors -> Assert.Contains("Correct options must be a subset of the provided options", errors) + | Ok _ -> Assert.Fail "expected validation error" + +[] +let ``numeric: negative tolerance is invalid`` () = + let question = newQuestion (Numeric(1.0, -0.5)) + + match QuestionValidation.validate question with + | Error errors -> Assert.Contains("Tolerance must not be negative", errors) + | Ok _ -> Assert.Fail "expected validation error" + +[] +let ``valid question passes validation`` () = + let optA = { Id = OptionId(Guid.NewGuid()); Text = "A" } + let optB = { Id = OptionId(Guid.NewGuid()); Text = "B" } + let question = newQuestion (SingleChoice([ optA; optB ], optA.Id)) + + match QuestionValidation.validate question with + | Ok _ -> () + | Error errors -> Assert.Fail(String.concat "; " errors) + +[] +let ``quiz: must contain at least one question`` () = + let quiz: Quiz = + { Id = QuizId(Guid.NewGuid()) + OwnerId = UserId(Guid.NewGuid()) + Title = "Empty quiz" + Description = "" + TimeLimit = None + MaxAttempts = None + GradingMethod = HighestAttempt + ShuffleQuestions = false + ShuffleAnswers = false + OpenFrom = None + OpenTo = None + PassingScore = None + QuestionSources = [] + AssignedStudentIds = Set.empty } + + match QuizValidation.validate quiz with + | Error errors -> Assert.Contains("Quiz must contain at least one question", errors) + | Ok _ -> Assert.Fail "expected validation error" + +[] +let ``quiz: OpenFrom must precede OpenTo`` () = + let now = DateTimeOffset.UtcNow + + let quiz: Quiz = + { Id = QuizId(Guid.NewGuid()) + OwnerId = UserId(Guid.NewGuid()) + Title = "Backwards window" + Description = "" + TimeLimit = None + MaxAttempts = None + GradingMethod = HighestAttempt + ShuffleQuestions = false + ShuffleAnswers = false + OpenFrom = Some(now.AddDays 1.0) + OpenTo = Some now + PassingScore = None + QuestionSources = [ FixedQuestion { QuestionId = QuestionId(Guid.NewGuid()); Points = 1.0; Order = 0 } ] + AssignedStudentIds = Set.empty } + + match QuizValidation.validate quiz with + | Error errors -> Assert.Contains("OpenFrom must be before OpenTo", errors) + | Ok _ -> Assert.Fail "expected validation error" diff --git a/vite.config.js b/vite.config.js new file mode 100644 index 0000000..d5deae5 --- /dev/null +++ b/vite.config.js @@ -0,0 +1,8 @@ +import { defineConfig } from "vite"; + +export default defineConfig({ + root: "src/Client", + server: { + port: 5173, + }, +});