Log on / log off works

- Messages are not showing
- Add sessions
This commit is contained in:
Daniel J. Summers 2023-01-08 21:41:29 -05:00
parent c7bda8eb28
commit f778df8e1d
12 changed files with 457 additions and 111 deletions

View File

@ -0,0 +1,231 @@
namespace JobsJobsJobs.Data
open System.Threading
open System.Threading.Tasks
open Microsoft.Extensions.Caching.Distributed
open NodaTime
open Npgsql.FSharp
/// Helper types and functions for the cache
[<AutoOpen>]
module private CacheHelpers =
open System
open Npgsql
/// The cache entry
type Entry =
{ /// The ID of the cache entry
Id : string
/// The value to be cached
Payload : byte[]
/// When this entry will expire
ExpireAt : Instant
/// The duration by which the expiration should be pushed out when being refreshed
SlidingExpiration : Duration option
/// The must-expire-by date/time for the cache entry
AbsoluteExpiration : Instant option
}
/// Run a task synchronously
let sync<'T> (it : Task<'T>) = it |> (Async.AwaitTask >> Async.RunSynchronously)
/// Get the current instant
let getNow () = SystemClock.Instance.GetCurrentInstant ()
/// Get the first result of the given query
let tryHead<'T> (query : Task<'T list>) = backgroundTask {
let! results = query
return List.tryHead results
}
/// Create a parameter for a non-standard type
let typedParam<'T> name (it : 'T) =
$"@%s{name}", Sql.parameter (NpgsqlParameter ($"@{name}", it))
/// Create a parameter for a possibly-missing non-standard type
let optParam<'T> name (it : 'T option) =
let p = NpgsqlParameter ($"@%s{name}", if Option.isSome it then box it.Value else DBNull.Value)
p.ParameterName, Sql.parameter p
/// Create a parameter for the expire-at time
let expireParam =
typedParam "expireAt"
open DataConnection
/// A distributed cache implementation in PostgreSQL used to handle sessions for myWebLog
type DistributedCache () =
// ~~~ INITIALIZATION ~~~
do
task {
let conn = connection ()
let! exists =
conn
|> Sql.query $"
SELECT EXISTS
(SELECT 1 FROM pg_tables WHERE schemaname = 'public' AND tablename = 'session')
AS does_exist"
|> Sql.executeRowAsync (fun row -> row.bool "does_exist")
if not exists then
let! _ =
conn
|> Sql.query
"CREATE TABLE session (
id TEXT NOT NULL PRIMARY KEY,
payload BYTEA NOT NULL,
expire_at TIMESTAMPTZ NOT NULL,
sliding_expiration INTERVAL,
absolute_expiration TIMESTAMPTZ);
CREATE INDEX idx_session_expiration ON session (expire_at)"
|> Sql.executeNonQueryAsync
()
} |> sync
// ~~~ SUPPORT FUNCTIONS ~~~
/// Get an entry, updating it for sliding expiration
let getEntry key = backgroundTask {
let conn = connection ()
let idParam = "@id", Sql.string key
let! tryEntry =
conn
|> Sql.query "SELECT * FROM session WHERE id = @id"
|> Sql.parameters [ idParam ]
|> Sql.executeAsync (fun row ->
{ Id = row.string "id"
Payload = row.bytea "payload"
ExpireAt = row.fieldValue<Instant> "expire_at"
SlidingExpiration = row.fieldValueOrNone<Duration> "sliding_expiration"
AbsoluteExpiration = row.fieldValueOrNone<Instant> "absolute_expiration" })
|> tryHead
match tryEntry with
| Some entry ->
let now = getNow ()
let slideExp = defaultArg entry.SlidingExpiration Duration.MinValue
let absExp = defaultArg entry.AbsoluteExpiration Instant.MinValue
let needsRefresh, item =
if entry.ExpireAt = absExp then false, entry
elif slideExp = Duration.MinValue && absExp = Instant.MinValue then false, entry
elif absExp > Instant.MinValue && entry.ExpireAt.Plus slideExp > absExp then
true, { entry with ExpireAt = absExp }
else true, { entry with ExpireAt = now.Plus slideExp }
if needsRefresh then
let! _ =
conn
|> Sql.query "UPDATE session SET expire_at = @expireAt WHERE id = @id"
|> Sql.parameters [ expireParam item.ExpireAt; idParam ]
|> Sql.executeNonQueryAsync
()
return if item.ExpireAt > now then Some entry else None
| None -> return None
}
/// The last time expired entries were purged (runs every 30 minutes)
let mutable lastPurge = Instant.MinValue
/// Purge expired entries every 30 minutes
let purge () = backgroundTask {
let now = getNow ()
if lastPurge.Plus (Duration.FromMinutes 30L) < now then
let! _ =
connection ()
|> Sql.query "DELETE FROM session WHERE expire_at < @expireAt"
|> Sql.parameters [ expireParam now ]
|> Sql.executeNonQueryAsync
lastPurge <- now
}
/// Remove a cache entry
let removeEntry key = backgroundTask {
let! _ =
connection ()
|> Sql.query "DELETE FROM session WHERE id = @id"
|> Sql.parameters [ "@id", Sql.string key ]
|> Sql.executeNonQueryAsync
()
}
/// Save an entry
let saveEntry (opts : DistributedCacheEntryOptions) key payload = backgroundTask {
let now = getNow ()
let expireAt, slideExp, absExp =
if opts.SlidingExpiration.HasValue then
let slide = Duration.FromTimeSpan opts.SlidingExpiration.Value
now.Plus slide, Some slide, None
elif opts.AbsoluteExpiration.HasValue then
let exp = Instant.FromDateTimeOffset opts.AbsoluteExpiration.Value
exp, None, Some exp
elif opts.AbsoluteExpirationRelativeToNow.HasValue then
let exp = now.Plus (Duration.FromTimeSpan opts.AbsoluteExpirationRelativeToNow.Value)
exp, None, Some exp
else
// Default to 1 hour sliding expiration
let slide = Duration.FromHours 1
now.Plus slide, Some slide, None
let! _ =
connection ()
|> Sql.query
"INSERT INTO session (
id, payload, expire_at, sliding_expiration, absolute_expiration
) VALUES (
@id, @payload, @expireAt, @slideExp, @absExp
) ON CONFLICT (id) DO UPDATE
SET payload = EXCLUDED.payload,
expire_at = EXCLUDED.expire_at,
sliding_expiration = EXCLUDED.sliding_expiration,
absolute_expiration = EXCLUDED.absolute_expiration"
|> Sql.parameters
[ "@id", Sql.string key
"@payload", Sql.bytea payload
expireParam expireAt
optParam "slideExp" slideExp
optParam "absExp" absExp ]
|> Sql.executeNonQueryAsync
()
}
// ~~~ IMPLEMENTATION FUNCTIONS ~~~
/// Retrieve the data for a cache entry
let get key (_ : CancellationToken) = backgroundTask {
match! getEntry key with
| Some entry ->
do! purge ()
return entry.Payload
| None -> return null
}
/// Refresh an entry
let refresh key (cancelToken : CancellationToken) = backgroundTask {
let! _ = get key cancelToken
()
}
/// Remove an entry
let remove key (_ : CancellationToken) = backgroundTask {
do! removeEntry key
do! purge ()
}
/// Set an entry
let set key value options (_ : CancellationToken) = backgroundTask {
do! saveEntry options key value
do! purge ()
}
interface IDistributedCache with
member _.Get key = get key CancellationToken.None |> sync
member _.GetAsync (key, token) = get key token
member _.Refresh key = refresh key CancellationToken.None |> sync
member _.RefreshAsync (key, token) = refresh key token
member _.Remove key = remove key CancellationToken.None |> sync
member _.RemoveAsync (key, token) = remove key token
member _.Set (key, value, options) = set key value options CancellationToken.None |> sync
member _.SetAsync (key, value, options, token) = set key value options token

View File

@ -73,7 +73,9 @@ module DataConnection =
/// Set up the data connection from the given configuration /// Set up the data connection from the given configuration
let setUp (cfg : IConfiguration) = backgroundTask { let setUp (cfg : IConfiguration) = backgroundTask {
dataSource <- Some (NpgsqlDataSource.Create (cfg.GetConnectionString "PostgreSQL")) let builder = NpgsqlDataSourceBuilder (cfg.GetConnectionString "PostgreSQL")
let _ = builder.UseNodaTime ()
dataSource <- Some (builder.Build ())
do! createTables () do! createTables ()
} }

View File

@ -7,6 +7,7 @@
<ItemGroup> <ItemGroup>
<Compile Include="Json.fs" /> <Compile Include="Json.fs" />
<Compile Include="Data.fs" /> <Compile Include="Data.fs" />
<Compile Include="Cache.fs" />
</ItemGroup> </ItemGroup>
<ItemGroup> <ItemGroup>

View File

@ -1,74 +1,68 @@
/// The main API application for Jobs, Jobs, Jobs /// The main web server application for Jobs, Jobs, Jobs
module JobsJobsJobs.Api.App module JobsJobsJobs.Server.App
open Microsoft.AspNetCore.Builder open System
open Microsoft.AspNetCore.Hosting open System.Text
open Microsoft.Extensions.DependencyInjection
open Microsoft.Extensions.Hosting
open Giraffe open Giraffe
open Giraffe.EndpointRouting open Giraffe.EndpointRouting
/// Configure the ASP.NET Core pipeline to use Giraffe
let configureApp (app : IApplicationBuilder) =
app.UseCors(fun p -> p.AllowAnyOrigin().AllowAnyHeader() |> ignore)
.UseStaticFiles()
.UseRouting()
.UseAuthentication()
.UseAuthorization()
.UseGiraffeErrorHandler(Handlers.Error.unexpectedError)
.UseEndpoints(fun e ->
e.MapGiraffeEndpoints Handlers.allEndpoints
e.MapFallbackToFile "index.html" |> ignore)
|> ignore
open System.Text
open Microsoft.AspNetCore.Authentication.JwtBearer
open Microsoft.Extensions.Configuration
open Microsoft.IdentityModel.Tokens
open NodaTime
open JobsJobsJobs.Data open JobsJobsJobs.Data
open JobsJobsJobs.Domain.SharedTypes open Microsoft.AspNetCore.Authentication.Cookies
open Microsoft.AspNetCore.Builder
open Microsoft.AspNetCore.Http
open Microsoft.AspNetCore.HttpOverrides
open Microsoft.Extensions.Caching.Distributed
open Microsoft.Extensions.Configuration
open Microsoft.Extensions.DependencyInjection
open Microsoft.Extensions.Hosting
open NodaTime
[<EntryPoint>]
let main args =
let builder = WebApplication.CreateBuilder args
let svc = builder.Services
/// Configure dependency injection
let configureServices (svc : IServiceCollection) =
let _ = svc.AddGiraffe () let _ = svc.AddGiraffe ()
let _ = svc.AddSingleton<IClock> SystemClock.Instance let _ = svc.AddSingleton<IClock> SystemClock.Instance
let _ = svc.AddLogging () let _ = svc.AddLogging ()
let _ = svc.AddCors () let _ = svc.AddCors ()
let _ = svc.AddSingleton<Json.ISerializer> (SystemTextJson.Serializer Json.options) let _ = svc.AddSingleton<Json.ISerializer> (SystemTextJson.Serializer Json.options)
let cfg = svc.BuildServiceProvider().GetRequiredService<IConfiguration> () let _ = svc.Configure<ForwardedHeadersOptions>(fun (opts : ForwardedHeadersOptions) ->
opts.ForwardedHeaders <- ForwardedHeaders.XForwardedFor ||| ForwardedHeaders.XForwardedProto)
// Set up JWTs for API access let _ = svc.AddAuthentication(CookieAuthenticationDefaults.AuthenticationScheme)
let _ = .AddCookie(fun o ->
svc.AddAuthentication(fun o -> o.ExpireTimeSpan <- TimeSpan.FromMinutes 60
o.DefaultAuthenticateScheme <- JwtBearerDefaults.AuthenticationScheme o.SlidingExpiration <- true
o.DefaultChallengeScheme <- JwtBearerDefaults.AuthenticationScheme o.AccessDeniedPath <- "/error/not-authorized"
o.DefaultScheme <- JwtBearerDefaults.AuthenticationScheme) o.ClaimsIssuer <- "https://noagendacareers.com")
.AddJwtBearer(fun opt ->
opt.RequireHttpsMetadata <- false
opt.TokenValidationParameters <- TokenValidationParameters (
ValidateIssuer = true,
ValidateAudience = true,
ValidAudience = "https://noagendacareers.com",
ValidIssuer = "https://noagendacareers.com",
IssuerSigningKey = SymmetricSecurityKey (
Encoding.UTF8.GetBytes (cfg.GetSection "Auth").["ServerSecret"])))
let _ = svc.AddAuthorization () let _ = svc.AddAuthorization ()
let _ = svc.Configure<AuthOptions> (cfg.GetSection "Auth") let _ = svc.AddAntiforgery ()
// Set up the data store // Set up the data store
let cfg = svc.BuildServiceProvider().GetRequiredService<IConfiguration> ()
let _ = DataConnection.setUp cfg |> Async.AwaitTask |> Async.RunSynchronously let _ = DataConnection.setUp cfg |> Async.AwaitTask |> Async.RunSynchronously
() let _ = svc.AddSingleton<IDistributedCache> (fun _ -> DistributedCache () :> IDistributedCache)
let _ = svc.AddSession(fun opts ->
opts.IdleTimeout <- TimeSpan.FromMinutes 60
opts.Cookie.HttpOnly <- true
opts.Cookie.IsEssential <- true)
let app = builder.Build ()
let _ = app.UseForwardedHeaders ()
let _ = app.UseCookiePolicy (CookiePolicyOptions (MinimumSameSitePolicy = SameSiteMode.Strict))
let _ = app.UseStaticFiles ()
let _ = app.UseRouting ()
let _ = app.UseAuthentication ()
let _ = app.UseAuthorization ()
let _ = app.UseSession ()
let _ = app.UseGiraffeErrorHandler Handlers.Error.unexpectedError
let _ = app.UseEndpoints (
fun e ->
e.MapGiraffeEndpoints Handlers.allEndpoints
e.MapFallbackToFile "index.html" |> ignore)
app.Run ()
[<EntryPoint>]
let main _ =
Host.CreateDefaultBuilder()
.ConfigureWebHostDefaults(fun webHostBuilder ->
webHostBuilder
.Configure(configureApp)
.ConfigureServices(configureServices)
|> ignore)
.Build()
.Run ()
0 0

View File

@ -1,5 +1,5 @@
/// Authorization / authentication functions /// Authorization / authentication functions
module JobsJobsJobs.Api.Auth module JobsJobsJobs.Server.Auth
open System open System
open System.Text open System.Text

View File

@ -1,4 +1,4 @@
module JobsJobsJobs.Api.Email module JobsJobsJobs.Server.Email
open System.Net open System.Net
open JobsJobsJobs.Domain open JobsJobsJobs.Domain

View File

@ -1,5 +1,5 @@
/// Route handlers for Giraffe endpoints /// Route handlers for Giraffe endpoints
module JobsJobsJobs.Api.Handlers module JobsJobsJobs.Server.Handlers
open Giraffe open Giraffe
open JobsJobsJobs.Domain open JobsJobsJobs.Domain
@ -15,9 +15,12 @@ module Vue =
let app = htmlFile "wwwroot/index.html" let app = htmlFile "wwwroot/index.html"
open Giraffe.Htmx
/// Handlers for error conditions /// Handlers for error conditions
module Error = module Error =
open System.Net
open System.Threading.Tasks open System.Threading.Tasks
/// URL prefixes for the Vue app /// URL prefixes for the Vue app
@ -39,10 +42,22 @@ module Error =
log.LogInformation "Returning 404" log.LogInformation "Returning 404"
return! RequestErrors.NOT_FOUND $"The URL {path} was not recognized as a valid URL" next ctx return! RequestErrors.NOT_FOUND $"The URL {path} was not recognized as a valid URL" next ctx
} }
/// Handler that returns a 403 NOT AUTHORIZED response /// Is the request from htmx?
let notAuthorized : HttpHandler = let isHtmx (ctx : HttpContext) =
setStatusCode 403 >=> fun _ _ -> Task.FromResult<HttpContext option> None ctx.Request.IsHtmx && not ctx.Request.IsHtmxRefresh
/// Handle unauthorized actions, redirecting to log on for GETs, otherwise returning a 401 Not Authorized response
let notAuthorized : HttpHandler = fun next ctx ->
if ctx.Request.Method = "GET" then
let redirectUrl = $"/user/log-on?returnUrl={WebUtility.UrlEncode ctx.Request.Path}"
if isHtmx ctx then (withHxRedirect redirectUrl >=> redirectTo false redirectUrl) next ctx
else redirectTo false redirectUrl next ctx
else
if isHtmx ctx then
(setHttpHeader "X-Toast" $"error|||You are not authorized to access the URL {ctx.Request.Path.Value}"
>=> setStatusCode 401) earlyReturn ctx
else setStatusCode 401 earlyReturn ctx
/// Handler to log 500s and return a message we can display in the application /// Handler to log 500s and return a message we can display in the application
let unexpectedError (ex: exn) (log : ILogger) = let unexpectedError (ex: exn) (log : ILogger) =
@ -57,7 +72,7 @@ open NodaTime
module Helpers = module Helpers =
open System.Security.Claims open System.Security.Claims
open Giraffe.Htmx open System.Text.Json
open Microsoft.AspNetCore.Antiforgery open Microsoft.AspNetCore.Antiforgery
open Microsoft.Extensions.Configuration open Microsoft.Extensions.Configuration
open Microsoft.Extensions.DependencyInjection open Microsoft.Extensions.DependencyInjection
@ -108,16 +123,51 @@ module Helpers =
let csrf ctx = let csrf ctx =
(antiForgery ctx).GetAndStoreTokens ctx (antiForgery ctx).GetAndStoreTokens ctx
/// The key to use to indicate if we have loaded the session
let private sessionLoadedKey = "session-loaded"
/// Load the session if we have not yet
let private loadSession (ctx : HttpContext) = task {
if not (ctx.Items.ContainsKey sessionLoadedKey) then
do! ctx.Session.LoadAsync ()
ctx.Items.Add (sessionLoadedKey, "yes")
}
/// Save the session if we have loaded it
let private saveSession (ctx : HttpContext) = task {
if ctx.Items.ContainsKey sessionLoadedKey then do! ctx.Session.CommitAsync ()
}
/// Get the messages from the session (destructively)
let messages ctx = task {
do! loadSession ctx
let msgs =
match ctx.Session.GetString "messages" with
| null -> []
| m -> JsonSerializer.Deserialize<string list> m
if not (List.isEmpty msgs) then ctx.Session.Remove "messages"
return List.rev msgs
}
/// Add a message to the response /// Add a message to the response
let sendMessage (msg : string) : HttpHandler = let addMessage (level : string) (msg : string) ctx = task {
setHttpHeader "X-Message" msg do! loadSession ctx
let! msgs = messages ctx
ctx.Session.SetString ("messages", JsonSerializer.Serialize ($"{level}|||{msg}" :: msgs))
}
/// Add a success message to the response
let addSuccess msg ctx = task {
do! addMessage "success" msg ctx
}
/// Add an error message to the response /// Add an error message to the response
let sendError (msg : string) : HttpHandler = let addError msg ctx = task {
sendMessage $"error|||{msg}" do! addMessage "error" msg ctx
}
/// Render a page-level view /// Render a page-level view
let render pageTitle content : HttpHandler = fun _ ctx -> task { let render pageTitle (next : HttpFunc) (ctx : HttpContext) content = task {
let renderFunc = if ctx.Request.IsHtmx && not ctx.Request.IsHtmxRefresh then Layout.partial else Layout.full let renderFunc = if ctx.Request.IsHtmx && not ctx.Request.IsHtmxRefresh then Layout.partial else Layout.full
let renderCtx : Layout.PageRenderContext = { let renderCtx : Layout.PageRenderContext = {
IsLoggedOn = Option.isSome (tryUser ctx) IsLoggedOn = Option.isSome (tryUser ctx)
@ -125,9 +175,18 @@ module Helpers =
PageTitle = pageTitle PageTitle = pageTitle
Content = content Content = content
} }
return! ctx.WriteHtmlViewAsync (renderFunc renderCtx) let! msgs = messages ctx
let! newCtx = task {
if List.isEmpty msgs then return Some ctx
else return! (msgs |> List.map (fun m -> setHttpHeader "X-Toast" m) |> List.reduce (>=>)) next ctx
}
return! newCtx.Value.WriteHtmlViewAsync (renderFunc renderCtx)
} }
/// Render as a composable HttpHandler
let renderHandler pageTitle content : HttpHandler = fun next ctx ->
render pageTitle next ctx content
/// Validate the anti cross-site request forgery token in the current request /// Validate the anti cross-site request forgery token in the current request
let validateCsrf : HttpHandler = fun next ctx -> task { let validateCsrf : HttpHandler = fun next ctx -> task {
match! (antiForgery ctx).IsRequestValidAsync ctx with match! (antiForgery ctx).IsRequestValidAsync ctx with
@ -135,16 +194,42 @@ module Helpers =
| false -> return! RequestErrors.BAD_REQUEST "CSRF token invalid" earlyReturn ctx | false -> return! RequestErrors.BAD_REQUEST "CSRF token invalid" earlyReturn ctx
} }
/// Require a user to be logged on for a route
let requireUser = requiresAuthentication Error.notAuthorized
/// Is the request from htmx?
// TODO: need to only define this once
let isHtmx (ctx : HttpContext) =
ctx.Request.IsHtmx && not ctx.Request.IsHtmxRefresh
/// Redirect to another page, saving the session before redirecting
let redirectToGet (url : string) next ctx = task {
do! saveSession ctx
let action =
if not (isNull url)
&& not (url = "")
// "/" or "/foo" but not "//" or "/\"
&& ( (url[0] = '/' && (url.Length = 1 || (url[1] <> '/' && url[1] <> '\\')))
// "~/" or "~/foo"
|| (url.Length > 1 && url[0] = '~' && url[1] = '/')) then
if isHtmx ctx then withHxRedirect url else redirectTo false url
else RequestErrors.BAD_REQUEST ""
return! action next ctx
}
open System open System
open JobsJobsJobs.Data open JobsJobsJobs.Data
open JobsJobsJobs.ViewModels open JobsJobsJobs.ViewModels
/// Handlers for /citizen routes /// Handlers for /citizen routes
[<RequireQualifiedAccess>] [<RequireQualifiedAccess>]
module Citizen = module Citizen =
open Microsoft.Extensions.Configuration open Microsoft.AspNetCore.Authentication
open Microsoft.AspNetCore.Authentication.Cookies
open System.Security.Claims
/// Support module for /citizen routes /// Support module for /citizen routes
module private Support = module private Support =
@ -169,49 +254,71 @@ module Citizen =
qAndA qAndA
// GET: /citizen/confirm/[token] // GET: /citizen/confirm/[token]
let confirm token = fun next ctx -> task { let confirm token next ctx = task {
let! isConfirmed = Citizens.confirmAccount token let! isConfirmed = Citizens.confirmAccount token
return! render "Account Confirmation" (Citizen.confirmAccount isConfirmed) next ctx return! Citizen.confirmAccount isConfirmed |> render "Account Confirmation" next ctx
}
// GET: /citizen/dashboard
let dashboard = requireUser >=> fun next ctx -> task {
let citizenId = CitizenId.ofString (tryUser ctx).Value
let! citizen = Citizens.findById citizenId
let! profile = Profiles.findById citizenId
let! prfCount = Profiles.count ()
return! Citizen.dashboard citizen.Value profile prfCount |> render "Dashboard" next ctx
} }
// GET: /citizen/deny/[token] // GET: /citizen/deny/[token]
let deny token = fun next ctx -> task { let deny token next ctx = task {
let! wasDeleted = Citizens.denyAccount token let! wasDeleted = Citizens.denyAccount token
return! render "Account Deletion" (Citizen.denyAccount wasDeleted) next ctx return! Citizen.denyAccount wasDeleted |> render "Account Deletion" next ctx
}
// GET: /citizen/log-off
let logOff = requireUser >=> fun next ctx -> task {
do! ctx.SignOutAsync CookieAuthenticationDefaults.AuthenticationScheme
do! addSuccess "Log off successful" ctx
return! redirectToGet "/" next ctx
} }
// GET: /citizen/log-on // GET: /citizen/log-on
let logOn : HttpHandler = fun next ctx -> let logOn : HttpHandler = fun next ctx ->
render "Log On" (Citizen.logOn { ErrorMessage = None; Email = ""; Password = "" } (csrf ctx)) next ctx let returnTo =
if ctx.Request.Query.ContainsKey "returnUrl" then Some ctx.Request.Query["returnUrl"].[0] else None
Citizen.logOn { ErrorMessage = None; Email = ""; Password = ""; ReturnTo = returnTo } (csrf ctx)
|> render "Log On" next ctx
// POST: /citizen/log-on // POST: /citizen/log-on
// TODO: convert
let doLogOn = validateCsrf >=> fun next ctx -> task { let doLogOn = validateCsrf >=> fun next ctx -> task {
let! form = ctx.BindJsonAsync<LogOnForm> () let! form = ctx.BindFormAsync<LogOnViewModel> ()
match! Citizens.tryLogOn form.Email form.Password Auth.Passwords.verify Auth.Passwords.hash (now ctx) with match! Citizens.tryLogOn form.Email form.Password Auth.Passwords.verify Auth.Passwords.hash (now ctx) with
| Ok citizen -> | Ok citizen ->
return! let claims = seq {
json Claim (ClaimTypes.NameIdentifier, CitizenId.toString citizen.Id)
{ Jwt = Auth.createJwt citizen (authConfig ctx) Claim (ClaimTypes.Name, Citizen.name citizen)
CitizenId = CitizenId.toString citizen.Id }
Name = Citizen.name citizen let identity = ClaimsIdentity (claims, CookieAuthenticationDefaults.AuthenticationScheme)
} next ctx
| Error msg -> return! RequestErrors.BAD_REQUEST msg next ctx do! ctx.SignInAsync (identity.AuthenticationType, ClaimsPrincipal identity,
AuthenticationProperties (IssuedUtc = DateTimeOffset.UtcNow))
do! addSuccess "Log on successful" ctx
return! redirectToGet (defaultArg form.ReturnTo "/citizen/dashboard") next ctx
| Error msg ->
do! addError msg ctx
return! Citizen.logOn { form with Password = "" } (csrf ctx) |> render "Log On" next ctx
} }
// GET: /citizen/register // GET: /citizen/register
let register : HttpHandler = fun next ctx -> let register next ctx =
// Get two different indexes for NA-knowledge challenge questions // Get two different indexes for NA-knowledge challenge questions
let q1Index = System.Random.Shared.Next(0, 5) let q1Index = System.Random.Shared.Next(0, 5)
let mutable q2Index = System.Random.Shared.Next(0, 5) let mutable q2Index = System.Random.Shared.Next(0, 5)
while q1Index = q2Index do while q1Index = q2Index do
q2Index <- System.Random.Shared.Next(0, 5) q2Index <- System.Random.Shared.Next(0, 5)
let qAndA = Support.questions ctx let qAndA = Support.questions ctx
render "Register" Citizen.register (fst qAndA[q1Index]) (fst qAndA[q2Index])
(Citizen.register (fst qAndA[q1Index]) (fst qAndA[q2Index]) { RegisterViewModel.empty with Question1Index = q1Index; Question2Index = q2Index } (csrf ctx)
{ RegisterViewModel.empty with Question1Index = q1Index; Question2Index = q2Index } (csrf ctx)) next ctx |> render "Register" next ctx
// POST: /citizen/register // POST: /citizen/register
let doRegistration = validateCsrf >=> fun next ctx -> task { let doRegistration = validateCsrf >=> fun next ctx -> task {
@ -232,12 +339,12 @@ module Citizen =
"Question answers are incorrect" "Question answers are incorrect"
] ]
let refreshPage () = let refreshPage () =
render "Register" Citizen.register (fst qAndA[form.Question1Index]) (fst qAndA[form.Question2Index])
(Citizen.register (fst qAndA[form.Question1Index]) (fst qAndA[form.Question2Index]) { form with Password = "" } (csrf ctx) |> renderHandler "Register"
{ form with Password = "" } (csrf ctx))
if badForm then if badForm then
let handle = sendError "The form posted was invalid; please complete it again" >=> register do! addError "The form posted was invalid; please complete it again" ctx
return! handle next ctx return! register next ctx
else if List.isEmpty errors then else if List.isEmpty errors then
let now = now ctx let now = now ctx
let noPass = let noPass =
@ -265,16 +372,17 @@ module Citizen =
let logFac = logger ctx let logFac = logger ctx
let log = logFac.CreateLogger "JobsJobsJobs.Handlers.Citizen" let log = logFac.CreateLogger "JobsJobsJobs.Handlers.Citizen"
log.LogInformation $"Confirmation e-mail for {citizen.Email} received {emailResponse}" log.LogInformation $"Confirmation e-mail for {citizen.Email} received {emailResponse}"
return! render "Registration Successful" Citizen.registered next ctx return! Citizen.registered |> render "Registration Successful" next ctx
else else
return! (sendError "There is already an account registered to the e-mail address provided" do! addError "There is already an account registered to the e-mail address provided" ctx
>=> refreshPage ()) next ctx return! refreshPage () next ctx
else else
let errMsg = String.Join ("</li><li>", errors) let errMsg = String.Join ("</li><li>", errors)
return! (sendError $"Please correct the following errors:<ul><li>{errMsg}</li></ul>" >=> refreshPage ()) do! addError $"Please correct the following errors:<ul><li>{errMsg}</li></ul>" ctx
next ctx return! refreshPage () next ctx
} }
/// Handlers for /api/citizen routes /// Handlers for /api/citizen routes
[<RequireQualifiedAccess>] [<RequireQualifiedAccess>]
module CitizenApi = module CitizenApi =
@ -338,19 +446,19 @@ module Home =
// GET: / // GET: /
let home : HttpHandler = let home : HttpHandler =
render "Welcome" Home.home renderHandler "Welcome" Home.home
// GET: /how-it-works // GET: /how-it-works
let howItWorks : HttpHandler = let howItWorks : HttpHandler =
render "How It Works" Home.howItWorks renderHandler "How It Works" Home.howItWorks
// GET: /privacy-policy // GET: /privacy-policy
let privacyPolicy : HttpHandler = let privacyPolicy : HttpHandler =
render "Privacy Policy" Home.privacyPolicy renderHandler "Privacy Policy" Home.privacyPolicy
// GET: /terms-of-service // GET: /terms-of-service
let termsOfService : HttpHandler = let termsOfService : HttpHandler =
render "Terms of Service" Home.termsOfService renderHandler "Terms of Service" Home.termsOfService
/// Handlers for /api/listing[s] routes /// Handlers for /api/listing[s] routes
@ -608,7 +716,9 @@ let allEndpoints = [
subRoute "/citizen" [ subRoute "/citizen" [
GET_HEAD [ GET_HEAD [
routef "/confirm/%s" Citizen.confirm routef "/confirm/%s" Citizen.confirm
route "/dashboard" Citizen.dashboard
routef "/deny/%s" Citizen.deny routef "/deny/%s" Citizen.deny
route "/log-off" Citizen.logOff
route "/log-on" Citizen.logOn route "/log-on" Citizen.logOn
route "/register" Citizen.register route "/register" Citizen.register
] ]

View File

@ -2,6 +2,7 @@
module JobsJobsJobs.ViewModels module JobsJobsJobs.ViewModels
/// View model for the log on page /// View model for the log on page
[<CLIMutable>]
type LogOnViewModel = type LogOnViewModel =
{ /// A message regarding an error encountered during a log on attempt { /// A message regarding an error encountered during a log on attempt
ErrorMessage : string option ErrorMessage : string option
@ -11,6 +12,9 @@ type LogOnViewModel =
/// The password of the user attempting to log on /// The password of the user attempting to log on
Password : string Password : string
/// The URL where the user should be redirected after logging on
ReturnTo : string option
} }

View File

@ -68,7 +68,7 @@ let dashboard (citizen : Citizen) (profile : Profile option) profileCount =
h5 [ _class "card-header" ] [ rawText "Other Citizens" ] h5 [ _class "card-header" ] [ rawText "Other Citizens" ]
div [ _class "card-body" ] [ div [ _class "card-body" ] [
h6 [ _class "card-subtitle mb-3 text-muted fst-italic" ] [ h6 [ _class "card-subtitle mb-3 text-muted fst-italic" ] [
rawText (if profileCount = 0 then "No" else $"{profileCount} Total") rawText (if profileCount = 0L then "No" else $"{profileCount} Total")
rawText " Employment Profile"; rawText (if profileCount <> 1 then "s" else "") rawText " Employment Profile"; rawText (if profileCount <> 1 then "s" else "")
] ]
p [ _class "card-text" ] [ p [ _class "card-text" ] [
@ -123,6 +123,9 @@ let logOn (m : LogOnViewModel) csrf =
| None -> () | None -> ()
form [ _class "row g-3 pb-3"; _hxPost "/citizen/log-on" ] [ form [ _class "row g-3 pb-3"; _hxPost "/citizen/log-on" ] [
antiForgery csrf antiForgery csrf
match m.ReturnTo with
| Some returnTo -> input [ _type "hidden"; _name (nameof m.ReturnTo); _value returnTo ]
| None -> ()
div [ _class "col-12 col-md-6" ] [ div [ _class "col-12 col-md-6" ] [
div [ _class "form-floating" ] [ div [ _class "form-floating" ] [
input [ _type "email" input [ _type "email"

View File

@ -63,7 +63,7 @@ let private links ctx =
navLink "/listings/mine" "sign-text" "My Job Listings" navLink "/listings/mine" "sign-text" "My Job Listings"
navLink "/profile/edit" "pencil" "My Employment Profile" navLink "/profile/edit" "pencil" "My Employment Profile"
div [ _class "separator" ] [] div [ _class "separator" ] []
navLink "/citizen/log-off" "mdiLogoutVariant" "Log Off" navLink "/citizen/log-off" "logout-variant" "Log Off"
else else
navLink "/" "home" "Home" navLink "/" "home" "Home"
navLink "/profile/seeking" "view-list-outline" "Job Seekers" navLink "/profile/seeking" "view-list-outline" "Job Seekers"

View File

@ -76,6 +76,7 @@ this.jjj = {
htmx.on("htmx:afterOnLoad", function (evt) { htmx.on("htmx:afterOnLoad", function (evt) {
const hdrs = evt.detail.xhr.getAllResponseHeaders() const hdrs = evt.detail.xhr.getAllResponseHeaders()
// Show a message if there was one in the response // Show a message if there was one in the response
console.info(`Here are the headers: ${hdrs}`)
if (hdrs.indexOf("x-toast") >= 0) { if (hdrs.indexOf("x-toast") >= 0) {
jjj.showToast(evt.detail.xhr.getResponseHeader("x-toast")) jjj.showToast(evt.detail.xhr.getResponseHeader("x-toast"))
} }

View File

@ -155,7 +155,7 @@ nav.jjj-nav > a {
} }
nav.jjj-nav > a > i { nav.jjj-nav > a > i {
vertical-align: top; vertical-align: top;
margin-right: 1rem; margin-right: .25rem;
} }
nav.jjj-nav > a > i.mdi::before { nav.jjj-nav > a > i.mdi::before {
line-height: 24px; line-height: 24px;