942dfc9c1a
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.
80 lines
2.8 KiB
Forth
80 lines
2.8 KiB
Forth
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<UserId, string> =
|
|
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<UserId, string> =
|
|
match tryGetUserId principal, tryGetRole principal with
|
|
| Some uid, Some role when List.contains role allowed -> Ok uid
|
|
| Some _, Some _ -> Error "Доступ запрещён"
|
|
| _ -> Error "Требуется авторизация"
|