bit-badger/jobs-jobs-jobs
1
0
Fork 0
Code Issues 1 Pull Requests Packages Projects Releases 19 Activity

Log on / log off works

Browse Source 
- 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
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

231
src/JobsJobsJobs/Data/Cache.fs Normal file
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

4
src/JobsJobsJobs/Data/Data.fs
View File

@ -73,7 +73,9 @@ module DataConnection =
/// Set up the data connection from the given configuration
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 ()
}

1
src/JobsJobsJobs/Data/JobsJobsJobs.Data.fsproj
View File

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

110
src/JobsJobsJobs/Server/App.fs
View File

@ -1,74 +1,68 @@
/// The main API application for Jobs, Jobs, Jobs
module JobsJobsJobs.Api.App
/// The main web server application for Jobs, Jobs, Jobs
module JobsJobsJobs.Server.App
open Microsoft.AspNetCore.Builder
open Microsoft.AspNetCore.Hosting
open Microsoft.Extensions.DependencyInjection
open Microsoft.Extensions.Hosting
open System
open System.Text
open Giraffe
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.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.AddSingleton<IClock> SystemClock.Instance
let _ = svc.AddLogging ()
let _ = svc.AddCors ()
let _ = svc.AddSingleton<Json.ISerializer> (SystemTextJson.Serializer Json.options)
let cfg = svc.BuildServiceProvider().GetRequiredService<IConfiguration> ()
// Set up JWTs for API access
let _ =
svc.AddAuthentication(fun o ->
o.DefaultAuthenticateScheme <- JwtBearerDefaults.AuthenticationScheme
o.DefaultChallengeScheme <- JwtBearerDefaults.AuthenticationScheme
o.DefaultScheme <- JwtBearerDefaults.AuthenticationScheme)
.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.Configure<ForwardedHeadersOptions>(fun (opts : ForwardedHeadersOptions) ->
opts.ForwardedHeaders <- ForwardedHeaders.XForwardedFor ||| ForwardedHeaders.XForwardedProto)
let _ = svc.AddAuthentication(CookieAuthenticationDefaults.AuthenticationScheme)
.AddCookie(fun o ->
o.ExpireTimeSpan <- TimeSpan.FromMinutes 60
o.SlidingExpiration <- true
o.AccessDeniedPath <- "/error/not-authorized"
o.ClaimsIssuer <- "https://noagendacareers.com")
let _ = svc.AddAuthorization ()
let _ = svc.Configure<AuthOptions> (cfg.GetSection "Auth")
let _ = svc.AddAntiforgery ()
// Set up the data store
let cfg = svc.BuildServiceProvider().GetRequiredService<IConfiguration> ()
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

2
src/JobsJobsJobs/Server/Auth.fs
View File

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

2
src/JobsJobsJobs/Server/Email.fs
View File

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

204
src/JobsJobsJobs/Server/Handlers.fs
View File

@ -1,5 +1,5 @@
/// Route handlers for Giraffe endpoints
module JobsJobsJobs.Api.Handlers
module JobsJobsJobs.Server.Handlers
open Giraffe
open JobsJobsJobs.Domain
@ -15,9 +15,12 @@ module Vue =
let app = htmlFile "wwwroot/index.html"
open Giraffe.Htmx
/// Handlers for error conditions
module Error =
open System.Net
open System.Threading.Tasks
/// URL prefixes for the Vue app
@ -39,10 +42,22 @@ module Error =
log.LogInformation "Returning 404"
return! RequestErrors.NOT_FOUND $"The URL {path} was not recognized as a valid URL" next ctx
}
/// Handler that returns a 403 NOT AUTHORIZED response
let notAuthorized : HttpHandler =
setStatusCode 403 >=> fun _ _ -> Task.FromResult<HttpContext option> None
/// Is the request from htmx?
let isHtmx (ctx : HttpContext) =
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
let unexpectedError (ex: exn) (log : ILogger) =
@ -57,7 +72,7 @@ open NodaTime
module Helpers =
open System.Security.Claims
open Giraffe.Htmx
open System.Text.Json
open Microsoft.AspNetCore.Antiforgery
open Microsoft.Extensions.Configuration
open Microsoft.Extensions.DependencyInjection
@ -108,16 +123,51 @@ module Helpers =
let csrf 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
let sendMessage (msg : string) : HttpHandler =
setHttpHeader "X-Message" msg
let addMessage (level : string) (msg : string) ctx = task {
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
let sendError (msg : string) : HttpHandler =
sendMessage $"error|||{msg}"
let addError msg ctx = task {
do! addMessage "error" msg ctx
}
/// 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 renderCtx : Layout.PageRenderContext = {
IsLoggedOn = Option.isSome (tryUser ctx)
@ -125,9 +175,18 @@ module Helpers =
PageTitle = pageTitle
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
let validateCsrf : HttpHandler = fun next ctx -> task {
match! (antiForgery ctx).IsRequestValidAsync ctx with
@ -135,16 +194,42 @@ module Helpers =
| 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 JobsJobsJobs.Data
open JobsJobsJobs.ViewModels
/// Handlers for /citizen routes
[<RequireQualifiedAccess>]
module Citizen =
open Microsoft.Extensions.Configuration
open Microsoft.AspNetCore.Authentication
open Microsoft.AspNetCore.Authentication.Cookies
open System.Security.Claims
/// Support module for /citizen routes
module private Support =
@ -169,49 +254,71 @@ module Citizen =
qAndA
// GET: /citizen/confirm/[token]
let confirm token = fun next ctx -> task {
let confirm token next ctx = task {
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]
let deny token = fun next ctx -> task {
let deny token next ctx = task {
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
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
// TODO: convert
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
| Ok citizen ->
return!
json
{ Jwt = Auth.createJwt citizen (authConfig ctx)
CitizenId = CitizenId.toString citizen.Id
Name = Citizen.name citizen
} next ctx
| Error msg -> return! RequestErrors.BAD_REQUEST msg next ctx
let claims = seq {
Claim (ClaimTypes.NameIdentifier, CitizenId.toString citizen.Id)
Claim (ClaimTypes.Name, Citizen.name citizen)
}
let identity = ClaimsIdentity (claims, CookieAuthenticationDefaults.AuthenticationScheme)
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
let register : HttpHandler = fun next ctx ->
let register next ctx =
// Get two different indexes for NA-knowledge challenge questions
let q1Index = System.Random.Shared.Next(0, 5)
let mutable q2Index = System.Random.Shared.Next(0, 5)
while q1Index = q2Index do
q2Index <- System.Random.Shared.Next(0, 5)
let qAndA = Support.questions ctx
render "Register"
(Citizen.register (fst qAndA[q1Index]) (fst qAndA[q2Index])
{ RegisterViewModel.empty with Question1Index = q1Index; Question2Index = q2Index } (csrf ctx)) next ctx
Citizen.register (fst qAndA[q1Index]) (fst qAndA[q2Index])
{ RegisterViewModel.empty with Question1Index = q1Index; Question2Index = q2Index } (csrf ctx)
|> render "Register" next ctx
// POST: /citizen/register
let doRegistration = validateCsrf >=> fun next ctx -> task {
@ -232,12 +339,12 @@ module Citizen =
"Question answers are incorrect"
]
let refreshPage () =
render "Register"
(Citizen.register (fst qAndA[form.Question1Index]) (fst qAndA[form.Question2Index])
{ form with Password = "" } (csrf ctx))
Citizen.register (fst qAndA[form.Question1Index]) (fst qAndA[form.Question2Index])
{ form with Password = "" } (csrf ctx) |> renderHandler "Register"
if badForm then
let handle = sendError "The form posted was invalid; please complete it again" >=> register
return! handle next ctx
do! addError "The form posted was invalid; please complete it again" ctx
return! register next ctx
else if List.isEmpty errors then
let now = now ctx
let noPass =
@ -265,16 +372,17 @@ module Citizen =
let logFac = logger ctx
let log = logFac.CreateLogger "JobsJobsJobs.Handlers.Citizen"
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
return! (sendError "There is already an account registered to the e-mail address provided"
>=> refreshPage ()) next ctx
do! addError "There is already an account registered to the e-mail address provided" ctx
return! refreshPage () next ctx
else
let errMsg = String.Join ("</li><li>", errors)
return! (sendError $"Please correct the following errors:<ul><li>{errMsg}</li></ul>" >=> refreshPage ())
next ctx
do! addError $"Please correct the following errors:<ul><li>{errMsg}</li></ul>" ctx
return! refreshPage () next ctx
}
/// Handlers for /api/citizen routes
[<RequireQualifiedAccess>]
module CitizenApi =
@ -338,19 +446,19 @@ module Home =
// GET: /
let home : HttpHandler =
render "Welcome" Home.home
renderHandler "Welcome" Home.home
// GET: /how-it-works
let howItWorks : HttpHandler =
render "How It Works" Home.howItWorks
renderHandler "How It Works" Home.howItWorks
// GET: /privacy-policy
let privacyPolicy : HttpHandler =
render "Privacy Policy" Home.privacyPolicy
renderHandler "Privacy Policy" Home.privacyPolicy
// GET: /terms-of-service
let termsOfService : HttpHandler =
render "Terms of Service" Home.termsOfService
renderHandler "Terms of Service" Home.termsOfService
/// Handlers for /api/listing[s] routes
@ -608,7 +716,9 @@ let allEndpoints = [
subRoute "/citizen" [
GET_HEAD [
routef "/confirm/%s" Citizen.confirm
route "/dashboard" Citizen.dashboard
routef "/deny/%s" Citizen.deny
route "/log-off" Citizen.logOff
route "/log-on" Citizen.logOn
route "/register" Citizen.register
]

4
src/JobsJobsJobs/Server/ViewModels.fs
View File

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

5
src/JobsJobsJobs/Server/Views/Citizen.fs
View File

@ -68,7 +68,7 @@ let dashboard (citizen : Citizen) (profile : Profile option) profileCount =
h5 [ _class "card-header" ] [ rawText "Other Citizens" ]
div [ _class "card-body" ] [
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 "")
]
p [ _class "card-text" ] [
@ -123,6 +123,9 @@ let logOn (m : LogOnViewModel) csrf =
| None -> ()
form [ _class "row g-3 pb-3"; _hxPost "/citizen/log-on" ] [
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 "form-floating" ] [
input [ _type "email"

2
src/JobsJobsJobs/Server/Views/Layout.fs
View File

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

1
src/JobsJobsJobs/Server/wwwroot/script.js
View File

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

2
src/JobsJobsJobs/Server/wwwroot/style.css
View File

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