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

Version 3 #40

Merged
danieljsummers merged 67 commits from version-2-3 into main 2023-02-02 23:47:28 +00:00
Conversation 0 Commits 67 Files Changed 126 +2918 -2911
40 changed files with 2918 additions and 2911 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files
Showing only changes of commit 6eaea09f31 - Show all commits

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

@ -1,583 +0,0 @@
namespace JobsJobsJobs.Data
/// Constants for tables used by Jobs, Jobs, Jobs
module Table =
/// Citizens
[<Literal>]
let Citizen = "jjj.citizen"
/// Continents
[<Literal>]
let Continent = "jjj.continent"
/// Job Listings
[<Literal>]
let Listing = "jjj.listing"
/// Employment Profiles
[<Literal>]
let Profile = "jjj.profile"
/// User Security Information
[<Literal>]
let SecurityInfo = "jjj.security_info"
/// Success Stories
[<Literal>]
let Success = "jjj.success"
open Npgsql.FSharp
/// Connection management for the document store
module DataConnection =
open Microsoft.Extensions.Configuration
open Npgsql
/// The data source for the document store
let mutable private theDataSource : NpgsqlDataSource option = None
/// Get the data source as the start of a SQL statement
let dataSource () =
match theDataSource with
| Some ds -> Sql.fromDataSource ds
| None -> invalidOp "Connection.setUp() must be called before accessing the database"
/// Create tables
let private createTables () = backgroundTask {
let sql = [
"CREATE SCHEMA IF NOT EXISTS jjj"
// Tables
$"CREATE TABLE IF NOT EXISTS {Table.Citizen} (id TEXT NOT NULL PRIMARY KEY, data JSONB NOT NULL)"
$"CREATE TABLE IF NOT EXISTS {Table.Continent} (id TEXT NOT NULL PRIMARY KEY, data JSONB NOT NULL)"
$"CREATE TABLE IF NOT EXISTS {Table.Listing} (id TEXT NOT NULL PRIMARY KEY, data JSONB NOT NULL)"
$"CREATE TABLE IF NOT EXISTS {Table.Profile} (id TEXT NOT NULL PRIMARY KEY, data JSONB NOT NULL,
CONSTRAINT fk_profile_citizen FOREIGN KEY (id) REFERENCES {Table.Citizen} (id) ON DELETE CASCADE)"
$"CREATE TABLE IF NOT EXISTS {Table.SecurityInfo} (id TEXT NOT NULL PRIMARY KEY, data JSONB NOT NULL,
CONSTRAINT fk_security_info_citizen FOREIGN KEY (id) REFERENCES {Table.Citizen} (id) ON DELETE CASCADE)"
$"CREATE TABLE IF NOT EXISTS {Table.Success} (id TEXT NOT NULL PRIMARY KEY, data JSONB NOT NULL)"
// Key indexes
$"CREATE UNIQUE INDEX IF NOT EXISTS uk_citizen_email ON {Table.Citizen} ((data -> 'email'))"
$"CREATE INDEX IF NOT EXISTS idx_listing_citizen ON {Table.Listing} ((data -> 'citizenId'))"
$"CREATE INDEX IF NOT EXISTS idx_listing_continent ON {Table.Listing} ((data -> 'continentId'))"
$"CREATE INDEX IF NOT EXISTS idx_profile_continent ON {Table.Profile} ((data -> 'continentId'))"
$"CREATE INDEX IF NOT EXISTS idx_success_citizen ON {Table.Success} ((data -> 'citizenId'))"
]
let! _ =
dataSource ()
|> Sql.executeTransactionAsync (sql |> List.map (fun sql -> sql, [ [] ]))
()
}
/// Set up the data connection from the given configuration
let setUp (cfg : IConfiguration) = backgroundTask {
let builder = NpgsqlDataSourceBuilder (cfg.GetConnectionString "PostgreSQL")
let _ = builder.UseNodaTime ()
theDataSource <- Some (builder.Build ())
do! createTables ()
}
open DataConnection
/// Helper functions for data manipulation
[<AutoOpen>]
module private Helpers =
open System.Text.Json
open System.Threading.Tasks
/// Map the data field to the requested document type
let toDocumentFrom<'T> fieldName (row : RowReader) =
JsonSerializer.Deserialize<'T> (row.string fieldName, Json.options)
/// Map the data field to the requested document type
let toDocument<'T> (row : RowReader) = toDocumentFrom<'T> "data" row
/// Get a document
let getDocument<'T> table docId sqlProps : Task<'T option> = backgroundTask {
let! doc =
Sql.query $"SELECT * FROM %s{table} where id = @id" sqlProps
|> Sql.parameters [ "@id", Sql.string docId ]
|> Sql.executeAsync toDocument
return List.tryHead doc
}
/// Serialize a document to JSON
let mkDoc<'T> (doc : 'T) =
JsonSerializer.Serialize<'T> (doc, Json.options)
/// Save a document
let saveDocument table docId sqlProps doc = backgroundTask {
let! _ =
Sql.query
$"INSERT INTO %s{table} (id, data) VALUES (@id, @data)
ON CONFLICT (id) DO UPDATE SET data = EXCLUDED.data"
sqlProps
|> Sql.parameters
[ "@id", Sql.string docId
"@data", Sql.jsonb doc ]
|> Sql.executeNonQueryAsync
()
}
/// Create a match-anywhere clause for a LIKE or ILIKE clause
let like value =
Sql.string $"%%%s{value}%%"
/// The JSON access operator ->> makes values text; this makes a parameter that will compare the properly
let jsonBool value =
Sql.string (if value then "true" else "false")
/// Get the SQL for a search WHERE clause
let searchSql criteria =
let sql = criteria |> List.map fst |> String.concat " AND "
if sql = "" then "" else $"AND {sql}"
open JobsJobsJobs.Domain
/// Citizen data access functions
[<RequireQualifiedAccess>]
module Citizens =
open NodaTime
/// The last time a token purge check was run
let mutable private lastPurge = Instant.MinValue
/// Lock access to the above
let private locker = obj ()
/// Delete a citizen by their ID using the given connection properties
let private doDeleteById citizenId connProps = backgroundTask {
let! _ =
connProps
|> Sql.query $"
DELETE FROM {Table.Success} WHERE data ->> 'citizenId' = @id;
DELETE FROM {Table.Listing} WHERE data ->> 'citizenId' = @id;
DELETE FROM {Table.Citizen} WHERE id = @id"
|> Sql.parameters [ "@id", Sql.string (CitizenId.toString citizenId) ]
|> Sql.executeNonQueryAsync
()
}
/// Delete a citizen by their ID
let deleteById citizenId =
doDeleteById citizenId (dataSource ())
/// Save a citizen
let private saveCitizen (citizen : Citizen) connProps =
saveDocument Table.Citizen (CitizenId.toString citizen.Id) connProps (mkDoc citizen)
/// Save security information for a citizen
let private saveSecurity (security : SecurityInfo) connProps =
saveDocument Table.SecurityInfo (CitizenId.toString security.Id) connProps (mkDoc security)
/// Purge expired tokens
let private purgeExpiredTokens now = backgroundTask {
let connProps = dataSource ()
let! info =
Sql.query $"SELECT * FROM {Table.SecurityInfo} WHERE data ->> 'tokenExpires' IS NOT NULL" connProps
|> Sql.executeAsync toDocument<SecurityInfo>
for expired in info |> List.filter (fun it -> it.TokenExpires.Value < now) do
if expired.TokenUsage.Value = "confirm" then
// Unconfirmed account; delete the entire thing
do! doDeleteById expired.Id connProps
else
// Some other use; just clear the token
do! saveSecurity { expired with Token = None; TokenUsage = None; TokenExpires = None } connProps
}
/// Check for tokens to purge if it's been more than 10 minutes since we last checked
let private checkForPurge skipCheck =
lock locker (fun () -> backgroundTask {
let now = SystemClock.Instance.GetCurrentInstant ()
if skipCheck || (now - lastPurge).TotalMinutes >= 10 then
do! purgeExpiredTokens now
lastPurge <- now
})
/// Find a citizen by their ID
let findById citizenId = backgroundTask {
match! dataSource () |> getDocument<Citizen> Table.Citizen (CitizenId.toString citizenId) with
| Some c when not c.IsLegacy -> return Some c
| Some _
| None -> return None
}
/// Save a citizen
let save citizen =
saveCitizen citizen (dataSource ())
/// Register a citizen (saves citizen and security settings); returns false if the e-mail is already taken
let register citizen (security : SecurityInfo) = backgroundTask {
let connProps = dataSource ()
use conn = Sql.createConnection connProps
use! txn = conn.BeginTransactionAsync ()
try
do! saveCitizen citizen connProps
do! saveSecurity security connProps
do! txn.CommitAsync ()
return true
with
| :? Npgsql.PostgresException as ex when ex.SqlState = "23505" && ex.ConstraintName = "uk_citizen_email" ->
do! txn.RollbackAsync ()
return false
}
/// Try to find the security information matching a confirmation token
let private tryConfirmToken token connProps = backgroundTask {
let! tryInfo =
connProps
|> Sql.query $"
SELECT *
FROM {Table.SecurityInfo}
WHERE data ->> 'token' = @token
AND data ->> 'tokenUsage' = 'confirm'"
|> Sql.parameters [ "@token", Sql.string token ]
|> Sql.executeAsync toDocument<SecurityInfo>
return List.tryHead tryInfo
}
/// Confirm a citizen's account
let confirmAccount token = backgroundTask {
do! checkForPurge true
let connProps = dataSource ()
match! tryConfirmToken token connProps with
| Some info ->
do! saveSecurity { info with AccountLocked = false; Token = None; TokenUsage = None; TokenExpires = None }
connProps
return true
| None -> return false
}
/// Deny a citizen's account (user-initiated; used if someone used their e-mail address without their consent)
let denyAccount token = backgroundTask {
do! checkForPurge true
let connProps = dataSource ()
match! tryConfirmToken token connProps with
| Some info ->
do! doDeleteById info.Id connProps
return true
| None -> return false
}
/// Attempt a user log on
let tryLogOn email password (pwVerify : Citizen -> string -> bool option) (pwHash : Citizen -> string -> string)
now = backgroundTask {
do! checkForPurge false
let connProps = dataSource ()
let! tryCitizen =
connProps
|> Sql.query $"
SELECT *
FROM {Table.Citizen}
WHERE data ->> 'email' = @email
AND data ->> 'isLegacy' = 'false'"
|> Sql.parameters [ "@email", Sql.string email ]
|> Sql.executeAsync toDocument<Citizen>
match List.tryHead tryCitizen with
| Some citizen ->
let citizenId = CitizenId.toString citizen.Id
let! tryInfo = getDocument<SecurityInfo> Table.SecurityInfo citizenId connProps
let! info = backgroundTask {
match tryInfo with
| Some it -> return it
| None ->
let it = { SecurityInfo.empty with Id = citizen.Id }
do! saveSecurity it connProps
return it
}
if info.AccountLocked then return Error "Log on unsuccessful (Account Locked)"
else
match pwVerify citizen password with
| Some rehash ->
let hash = if rehash then pwHash citizen password else citizen.PasswordHash
do! saveSecurity { info with FailedLogOnAttempts = 0 } connProps
do! saveCitizen { citizen with LastSeenOn = now; PasswordHash = hash } connProps
return Ok { citizen with LastSeenOn = now }
| None ->
let locked = info.FailedLogOnAttempts >= 4
do! { info with FailedLogOnAttempts = info.FailedLogOnAttempts + 1; AccountLocked = locked }
|> saveSecurity <| connProps
return Error $"""Log on unsuccessful{if locked then " - Account is now locked" else ""}"""
| None -> return Error "Log on unsuccessful"
}
/// Try to retrieve a citizen and their security information by their e-mail address
let tryByEmailWithSecurity email = backgroundTask {
let toCitizenSecurityPair row = (toDocument<Citizen> row, toDocumentFrom<SecurityInfo> "sec_data" row)
let! results =
dataSource ()
|> Sql.query $"
SELECT c.*, s.data AS sec_data
FROM {Table.Citizen} c
INNER JOIN {Table.SecurityInfo} s ON s.id = c.id
WHERE c.data ->> 'email' = @email"
|> Sql.parameters [ "@email", Sql.string email ]
|> Sql.executeAsync toCitizenSecurityPair
return List.tryHead results
}
/// Save an updated security information document
let saveSecurityInfo security = backgroundTask {
do! saveSecurity security (dataSource ())
}
/// Try to retrieve security information by the given token
let trySecurityByToken token = backgroundTask {
do! checkForPurge false
let! results =
dataSource ()
|> Sql.query $"SELECT * FROM {Table.SecurityInfo} WHERE data ->> 'token' = @token"
|> Sql.parameters [ "@token", Sql.string token ]
|> Sql.executeAsync toDocument<SecurityInfo>
return List.tryHead results
}
/// Continent data access functions
[<RequireQualifiedAccess>]
module Continents =
/// Retrieve all continents
let all () =
dataSource ()
|> Sql.query $"SELECT * FROM {Table.Continent} ORDER BY data ->> 'name'"
|> Sql.executeAsync toDocument<Continent>
/// Retrieve a continent by its ID
let findById continentId =
dataSource () |> getDocument<Continent> Table.Continent (ContinentId.toString continentId)
open JobsJobsJobs.Domain.SharedTypes
/// Job listing access functions
[<RequireQualifiedAccess>]
module Listings =
/// The SQL to select a listing view
let viewSql =
$"SELECT l.*, c.data ->> 'name' AS continent_name, u.data AS cit_data
FROM {Table.Listing} l
INNER JOIN {Table.Continent} c ON c.id = l.data ->> 'continentId'
INNER JOIN {Table.Citizen} u ON u.id = l.data ->> 'citizenId'"
/// Map a result for a listing view
let private toListingForView row =
{ Listing = toDocument<Listing> row
ContinentName = row.string "continent_name"
Citizen = toDocumentFrom<Citizen> "cit_data" row
}
/// Find all job listings posted by the given citizen
let findByCitizen citizenId =
dataSource ()
|> Sql.query $"{viewSql} WHERE l.data ->> 'citizenId' = @citizenId AND l.data ->> 'isLegacy' = 'false'"
|> Sql.parameters [ "@citizenId", Sql.string (CitizenId.toString citizenId) ]
|> Sql.executeAsync toListingForView
/// Find a listing by its ID
let findById listingId = backgroundTask {
match! dataSource () |> getDocument<Listing> Table.Listing (ListingId.toString listingId) with
| Some listing when not listing.IsLegacy -> return Some listing
| Some _
| None -> return None
}
/// Find a listing by its ID for viewing (includes continent information)
let findByIdForView listingId = backgroundTask {
let! tryListing =
dataSource ()
|> Sql.query $"{viewSql} WHERE l.id = @id AND l.data ->> 'isLegacy' = 'false'"
|> Sql.parameters [ "@id", Sql.string (ListingId.toString listingId) ]
|> Sql.executeAsync toListingForView
return List.tryHead tryListing
}
/// Save a listing
let save (listing : Listing) =
dataSource () |> saveDocument Table.Listing (ListingId.toString listing.Id) <| mkDoc listing
/// Search job listings
let search (search : ListingSearchForm) =
let searches = [
if search.ContinentId <> "" then
"l.data ->> 'continentId' = @continentId", [ "@continentId", Sql.string search.ContinentId ]
if search.Region <> "" then
"l.data ->> 'region' ILIKE @region", [ "@region", like search.Region ]
if search.RemoteWork <> "" then
"l.data ->> 'isRemote' = @remote", [ "@remote", jsonBool (search.RemoteWork = "yes") ]
if search.Text <> "" then
"l.data ->> 'text' ILIKE @text", [ "@text", like search.Text ]
]
dataSource ()
|> Sql.query $"
{viewSql}
WHERE l.data ->> 'isExpired' = 'false' AND l.data ->> 'isLegacy' = 'false'
{searchSql searches}"
|> Sql.parameters (searches |> List.collect snd)
|> Sql.executeAsync toListingForView
/// Profile data access functions
[<RequireQualifiedAccess>]
module Profiles =
/// Count the current profiles
let count () =
dataSource ()
|> Sql.query $"SELECT COUNT(id) AS the_count FROM {Table.Profile} WHERE data ->> 'isLegacy' = 'false'"
|> Sql.executeRowAsync (fun row -> row.int64 "the_count")
/// Delete a profile by its ID
let deleteById citizenId = backgroundTask {
let! _ =
dataSource ()
|> Sql.query $"DELETE FROM {Table.Profile} WHERE id = @id"
|> Sql.parameters [ "@id", Sql.string (CitizenId.toString citizenId) ]
|> Sql.executeNonQueryAsync
()
}
/// Find a profile by citizen ID
let findById citizenId = backgroundTask {
match! dataSource () |> getDocument<Profile> Table.Profile (CitizenId.toString citizenId) with
| Some profile when not profile.IsLegacy -> return Some profile
| Some _
| None -> return None
}
/// Find a profile by citizen ID for viewing (includes citizen and continent information)
let findByIdForView citizenId = backgroundTask {
let! tryCitizen =
dataSource ()
|> Sql.query $"
SELECT p.*, c.data AS cit_data, o.data AS cont_data
FROM {Table.Profile} p
INNER JOIN {Table.Citizen} c ON c.id = p.id
INNER JOIN {Table.Continent} o ON o.id = p.data ->> 'continentId'
WHERE p.id = @id
AND p.data ->> 'isLegacy' = 'false'"
|> Sql.parameters [ "@id", Sql.string (CitizenId.toString citizenId) ]
|> Sql.executeAsync (fun row ->
{ Profile = toDocument<Profile> row
Citizen = toDocumentFrom<Citizen> "cit_data" row
Continent = toDocumentFrom<Continent> "cont_data" row
})
return List.tryHead tryCitizen
}
/// Save a profile
let save (profile : Profile) =
dataSource () |> saveDocument Table.Profile (CitizenId.toString profile.Id) <| mkDoc profile
/// Search profiles (logged-on users)
let search (search : ProfileSearchForm) = backgroundTask {
let searches = [
if search.ContinentId <> "" then
"p.data ->> 'continentId' = @continentId", [ "@continentId", Sql.string search.ContinentId ]
if search.RemoteWork <> "" then
"p.data ->> 'isRemote' = @remote", [ "@remote", jsonBool (search.RemoteWork = "yes") ]
if search.Skill <> "" then
"EXISTS (
SELECT 1 FROM jsonb_array_elements(p.data['skills']) x(elt)
WHERE x ->> 'description' ILIKE @description)",
[ "@description", like search.Skill ]
if search.BioExperience <> "" then
"(p.data ->> 'biography' ILIKE @text OR p.data ->> 'experience' ILIKE @text)",
[ "@text", like search.BioExperience ]
]
let! results =
dataSource ()
|> Sql.query $"
SELECT p.*, c.data AS cit_data
FROM {Table.Profile} p
INNER JOIN {Table.Citizen} c ON c.id = p.id
WHERE p.data ->> 'isLegacy' = 'false'
{searchSql searches}"
|> Sql.parameters (searches |> List.collect snd)
|> Sql.executeAsync (fun row ->
let profile = toDocument<Profile> row
let citizen = toDocumentFrom<Citizen> "cit_data" row
{ CitizenId = profile.Id
DisplayName = Citizen.name citizen
SeekingEmployment = profile.IsSeekingEmployment
RemoteWork = profile.IsRemote
FullTime = profile.IsFullTime
LastUpdatedOn = profile.LastUpdatedOn
})
return results |> List.sortBy (fun psr -> psr.DisplayName.ToLowerInvariant ())
}
// Search profiles (public)
let publicSearch (search : PublicSearchForm) =
let searches = [
if search.ContinentId <> "" then
"p.data ->> 'continentId' = @continentId", [ "@continentId", Sql.string search.ContinentId ]
if search.Region <> "" then
"p.data ->> 'region' ILIKE @region", [ "@region", like search.Region ]
if search.RemoteWork <> "" then
"p.data ->> 'isRemote' = @remote", [ "@remote", jsonBool (search.RemoteWork = "yes") ]
if search.Skill <> "" then
"EXISTS (
SELECT 1 FROM jsonb_array_elements(p.data['skills']) x(elt)
WHERE x ->> 'description' ILIKE @description)",
[ "@description", like search.Skill ]
]
dataSource ()
|> Sql.query $"
SELECT p.*, c.data AS cont_data
FROM {Table.Profile} p
INNER JOIN {Table.Continent} c ON c.id = p.data ->> 'continentId'
WHERE p.data ->> 'isPubliclySearchable' = 'true'
AND p.data ->> 'isLegacy' = 'false'
{searchSql searches}"
|> Sql.parameters (searches |> List.collect snd)
|> Sql.executeAsync (fun row ->
let profile = toDocument<Profile> row
let continent = toDocumentFrom<Continent> "cont_data" row
{ Continent = continent.Name
Region = profile.Region
RemoteWork = profile.IsRemote
Skills = profile.Skills
|> List.map (fun s ->
let notes = match s.Notes with Some n -> $" ({n})" | None -> ""
$"{s.Description}{notes}")
})
/// Success story data access functions
[<RequireQualifiedAccess>]
module Successes =
// Retrieve all success stories
let all () =
dataSource ()
|> Sql.query $"
SELECT s.*, c.data AS cit_data
FROM {Table.Success} s
INNER JOIN {Table.Citizen} c ON c.id = s.data ->> 'citizenId'
ORDER BY s.data ->> 'recordedOn' DESC"
|> Sql.executeAsync (fun row ->
let success = toDocument<Success> row
let citizen = toDocumentFrom<Citizen> "cit_data" row
{ Id = success.Id
CitizenId = success.CitizenId
CitizenName = Citizen.name citizen
RecordedOn = success.RecordedOn
FromHere = success.IsFromHere
HasStory = Option.isSome success.Story
})
/// Find a success story by its ID
let findById successId =
dataSource () |> getDocument<Success> Table.Success (SuccessId.toString successId)
/// Save a success story
let save (success : Success) =
dataSource () |> saveDocument Table.Success (SuccessId.toString success.Id) <| mkDoc success

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

@ -1,24 +0,0 @@
<Project Sdk="Microsoft.NET.Sdk">
<PropertyGroup>
<GenerateDocumentationFile>true</GenerateDocumentationFile>
</PropertyGroup>
<ItemGroup>
<Compile Include="Json.fs" />
<Compile Include="Data.fs" />
<Compile Include="Cache.fs" />
</ItemGroup>
<ItemGroup>
<ProjectReference Include="..\Domain\JobsJobsJobs.Domain.fsproj" />
</ItemGroup>
<ItemGroup>
<PackageReference Include="FSharp.SystemTextJson" Version="0.19.13" />
<PackageReference Include="NodaTime.Serialization.SystemTextJson" Version="1.0.0" />
<PackageReference Include="Npgsql.FSharp" Version="5.6.0" />
<PackageReference Include="Npgsql.NodaTime" Version="7.0.0" />
</ItemGroup>
</Project>

1
src/JobsJobsJobs/Domain/.gitignore vendored
View File

@ -1 +0,0 @@
*.js

21
src/JobsJobsJobs/Domain/JobsJobsJobs.Domain.fsproj
View File

@ -1,21 +0,0 @@
<Project Sdk="Microsoft.NET.Sdk">
<PropertyGroup>
<GenerateDocumentationFile>true</GenerateDocumentationFile>
<WarnOn>3390;$(WarnOn)</WarnOn>
</PropertyGroup>
<ItemGroup>
<Compile Include="SupportTypes.fs" />
<Compile Include="Types.fs" />
<Compile Include="SharedTypes.fs" />
</ItemGroup>
<ItemGroup>
<PackageReference Include="Giraffe" Version="6.0.0" />
<PackageReference Include="Markdig" Version="0.30.3" />
<PackageReference Include="Microsoft.Extensions.Options" Version="7.0.0" />
<PackageReference Include="NodaTime" Version="3.1.2" />
</ItemGroup>
</Project>

145
src/JobsJobsJobs/Domain/SharedTypes.fs
View File

@ -1,145 +0,0 @@
/// Types intended to be shared between the API and the client application
module JobsJobsJobs.Domain.SharedTypes
open JobsJobsJobs.Domain
open NodaTime
/// The data needed to display a listing
[<NoComparison; NoEquality>]
type ListingForView =
{ /// The listing itself
Listing : Listing
/// The name of the continent for the listing
ContinentName : string
/// The citizen who owns the listing
Citizen : Citizen
}
/// The various ways job listings can be searched
[<CLIMutable; NoComparison; NoEquality>]
type ListingSearchForm =
{ /// Retrieve job listings for this continent
ContinentId : string
/// Text for a search within a region
Region : string
/// Whether to retrieve job listings for remote work
RemoteWork : string
/// Text for a search with the job listing description
Text : string
}
/// The various ways profiles can be searched
[<CLIMutable; NoComparison; NoEquality>]
type ProfileSearchForm =
{ /// Retrieve citizens from this continent
ContinentId : string
/// Text for a search within a citizen's skills
Skill : string
/// Text for a search with a citizen's professional biography and experience fields
BioExperience : string
/// Whether to retrieve citizens who do or do not want remote work
RemoteWork : string
}
/// A user matching the profile search
[<NoComparison; NoEquality>]
type ProfileSearchResult =
{ /// The ID of the citizen
CitizenId : CitizenId
/// The citizen's display name
DisplayName : string
/// Whether this citizen is currently seeking employment
SeekingEmployment : bool
/// Whether this citizen is looking for remote work
RemoteWork : bool
/// Whether this citizen is looking for full-time work
FullTime : bool
/// When this profile was last updated
LastUpdatedOn : Instant
}
/// The data required to show a viewable profile
type ProfileForView =
{ /// The profile itself
Profile : Profile
/// The citizen to whom the profile belongs
Citizen : Citizen
/// The continent for the profile
Continent : Continent
}
/// The parameters for a public job search
[<CLIMutable; NoComparison; NoEquality>]
type PublicSearchForm =
{ /// Retrieve citizens from this continent
ContinentId : string
/// Retrieve citizens from this region
Region : string
/// Text for a search within a citizen's skills
Skill : string
/// Whether to retrieve citizens who do or do not want remote work
RemoteWork : string
}
/// A public profile search result
[<NoComparison; NoEquality>]
type PublicSearchResult =
{ /// The name of the continent on which the citizen resides
Continent : string
/// The region in which the citizen resides
Region : string
/// Whether this citizen is seeking remote work
RemoteWork : bool
/// The skills this citizen has identified
Skills : string list
}
/// An entry in the list of success stories
[<NoComparison; NoEquality>]
type StoryEntry =
{ /// The ID of this success story
Id : SuccessId
/// The ID of the citizen who recorded this story
CitizenId : CitizenId
/// The name of the citizen who recorded this story
CitizenName : string
/// When this story was recorded
RecordedOn : Instant
/// Whether this story involves an opportunity that arose due to Jobs, Jobs, Jobs
FromHere : bool
/// Whether this report has a further story, or if it is simply a "found work" entry
HasStory : bool
}

151
src/JobsJobsJobs/Domain/SupportTypes.fs
View File

@ -1,151 +0,0 @@
namespace JobsJobsJobs.Domain
open System
open Giraffe
/// The ID of a user (a citizen of Gitmo Nation)
type CitizenId = CitizenId of Guid
/// Support functions for citizen IDs
module CitizenId =
/// Create a new citizen ID
let create () = (Guid.NewGuid >> CitizenId) ()
/// A string representation of a citizen ID
let toString = function CitizenId it -> ShortGuid.fromGuid it
/// Parse a string into a citizen ID
let ofString = ShortGuid.toGuid >> CitizenId
/// Get the GUID value of a citizen ID
let value = function CitizenId guid -> guid
/// The ID of a continent
type ContinentId = ContinentId of Guid
/// Support functions for continent IDs
module ContinentId =
/// Create a new continent ID
let create () = (Guid.NewGuid >> ContinentId) ()
/// A string representation of a continent ID
let toString = function ContinentId it -> ShortGuid.fromGuid it
/// Parse a string into a continent ID
let ofString = ShortGuid.toGuid >> ContinentId
/// Get the GUID value of a continent ID
let value = function ContinentId guid -> guid
/// The ID of a job listing
type ListingId = ListingId of Guid
/// Support functions for listing IDs
module ListingId =
/// Create a new job listing ID
let create () = (Guid.NewGuid >> ListingId) ()
/// A string representation of a listing ID
let toString = function ListingId it -> ShortGuid.fromGuid it
/// Parse a string into a listing ID
let ofString = ShortGuid.toGuid >> ListingId
/// Get the GUID value of a listing ID
let value = function ListingId guid -> guid
/// A string of Markdown text
type MarkdownString = Text of string
/// Support functions for Markdown strings
module MarkdownString =
open Markdig
/// The Markdown conversion pipeline (enables all advanced features)
let private pipeline = MarkdownPipelineBuilder().UseAdvancedExtensions().Build ()
/// Convert this Markdown string to HTML
let toHtml = function Text text -> Markdown.ToHtml (text, pipeline)
/// Convert a Markdown string to its string representation
let toString = function Text text -> text
/// Types of contacts supported by Jobs, Jobs, Jobs
type ContactType =
/// E-mail addresses
| Email
/// Phone numbers (home, work, cell, etc.)
| Phone
/// Websites (personal, social, etc.)
| Website
/// Functions to support contact types
module ContactType =
/// Parse a contact type from a string
let parse typ =
match typ with
| "Email" -> Email
| "Phone" -> Phone
| "Website" -> Website
| it -> invalidOp $"{it} is not a valid contact type"
/// Convert a contact type to its string representation
let toString =
function
| Email -> "Email"
| Phone -> "Phone"
| Website -> "Website"
/// Another way to contact a citizen from this site
type OtherContact =
{ /// The type of contact
ContactType : ContactType
/// The name of the contact (Email, No Agenda Social, LinkedIn, etc.)
Name : string option
/// The value for the contact (e-mail address, user name, URL, etc.)
Value : string
/// Whether this contact is visible in public employment profiles and job listings
IsPublic : bool
}
/// A skill the job seeker possesses
type Skill =
{ /// A description of the skill
Description : string
/// Notes regarding this skill (level, duration, etc.)
Notes : string option
}
/// The ID of a success report
type SuccessId = SuccessId of Guid
/// Support functions for success report IDs
module SuccessId =
/// Create a new success report ID
let create () = (Guid.NewGuid >> SuccessId) ()
/// A string representation of a success report ID
let toString = function SuccessId it -> ShortGuid.fromGuid it
/// Parse a string into a success report ID
let ofString = ShortGuid.toGuid >> SuccessId
/// Get the GUID value of a success ID
let value = function SuccessId guid -> guid

2
src/JobsJobsJobs/JobsJobsJobs.V3Migration/Program.fs
View File

@ -64,7 +64,7 @@ task {
let cfg = ConfigurationBuilder().AddJsonFile("appsettings.json").Build () let cfg = ConfigurationBuilder().AddJsonFile("appsettings.json").Build ()
use rethinkConn = Rethink.Startup.createConnection (cfg.GetConnectionString "RethinkDB") use rethinkConn = Rethink.Startup.createConnection (cfg.GetConnectionString "RethinkDB")
do! DataConnection.setUp cfg do! DataConnection.setUp cfg
let pgConn = DataConnection.connection () let pgConn = DataConnection.dataSource ()
let getOld table = let getOld table =
fromTable table fromTable table

24
src/JobsJobsJobs/Server/ApiHandlers.fs Normal file
View File

@ -0,0 +1,24 @@
/// Route handlers for Giraffe endpoints
module JobsJobsJobs.Api.Handlers
open System.IO
open Giraffe
open JobsJobsJobs.Common.Handlers
open JobsJobsJobs.Domain
// POST: /api/markdown-preview
let markdownPreview : HttpHandler = requireUser >=> fun next ctx -> task {
let _ = ctx.Request.Body.Seek(0L, SeekOrigin.Begin)
use reader = new StreamReader (ctx.Request.Body)
let! preview = reader.ReadToEndAsync ()
return! htmlString (MarkdownString.toHtml (Text preview)) next ctx
}
open Giraffe.EndpointRouting
/// All API endpoints
let endpoints =
subRoute "/api" [
POST [ route "/markdown-preview" markdownPreview ]
]

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

@ -1,11 +1,11 @@
/// The main web server application for Jobs, Jobs, Jobs /// The main web server application for Jobs, Jobs, Jobs
module JobsJobsJobs.Server.App module JobsJobsJobs.App
open System open System
open System.Text open System.Text
open Giraffe open Giraffe
open Giraffe.EndpointRouting open Giraffe.EndpointRouting
open JobsJobsJobs.Data open JobsJobsJobs.Common.Data
open Microsoft.AspNetCore.Authentication.Cookies open Microsoft.AspNetCore.Authentication.Cookies
open Microsoft.AspNetCore.Builder open Microsoft.AspNetCore.Builder
open Microsoft.AspNetCore.Http open Microsoft.AspNetCore.Http
@ -50,7 +50,7 @@ let main args =
// Set up the data store // Set up the data store
let cfg = svc.BuildServiceProvider().GetRequiredService<IConfiguration> () let cfg = svc.BuildServiceProvider().GetRequiredService<IConfiguration> ()
let _ = DataConnection.setUp cfg |> Async.AwaitTask |> Async.RunSynchronously let _ = setUp cfg |> Async.AwaitTask |> Async.RunSynchronously
let _ = svc.AddSingleton<IDistributedCache> (fun _ -> DistributedCache () :> IDistributedCache) let _ = svc.AddSingleton<IDistributedCache> (fun _ -> DistributedCache () :> IDistributedCache)
let _ = svc.AddSession(fun opts -> let _ = svc.AddSession(fun opts ->
opts.IdleTimeout <- TimeSpan.FromMinutes 60 opts.IdleTimeout <- TimeSpan.FromMinutes 60
@ -59,6 +59,16 @@ let main args =
let app = builder.Build () let app = builder.Build ()
// Unify the endpoints from all features
let endpoints = [
Citizens.Handlers.endpoints
Home.Handlers.endpoints
yield! Listings.Handlers.endpoints
Profiles.Handlers.endpoints
SuccessStories.Handlers.endpoints
Api.Handlers.endpoints
]
let _ = app.UseForwardedHeaders () let _ = app.UseForwardedHeaders ()
let _ = app.UseCookiePolicy (CookiePolicyOptions (MinimumSameSitePolicy = SameSiteMode.Strict)) let _ = app.UseCookiePolicy (CookiePolicyOptions (MinimumSameSitePolicy = SameSiteMode.Strict))
let _ = app.UseStaticFiles () let _ = app.UseStaticFiles ()
@ -67,8 +77,8 @@ let main args =
let _ = app.UseAuthentication () let _ = app.UseAuthentication ()
let _ = app.UseAuthorization () let _ = app.UseAuthorization ()
let _ = app.UseSession () let _ = app.UseSession ()
let _ = app.UseGiraffeErrorHandler Handlers.Error.unexpectedError let _ = app.UseGiraffeErrorHandler Common.Handlers.Error.unexpectedError
let _ = app.UseEndpoints (fun e -> e.MapGiraffeEndpoints Handlers.allEndpoints |> ignore) let _ = app.UseEndpoints (fun e -> e.MapGiraffeEndpoints endpoints |> ignore)
app.Run () app.Run ()

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

@ -1,30 +0,0 @@
/// Authorization / authentication functions
module JobsJobsJobs.Server.Auth
open System
open System.Text
open JobsJobsJobs.Domain
/// Create a confirmation or password reset token for a user
let createToken (citizen : Citizen) =
Convert.ToBase64String (Guid.NewGuid().ToByteArray () |> Array.append (Encoding.UTF8.GetBytes citizen.Email))
/// Password hashing and verification
module Passwords =
open Microsoft.AspNetCore.Identity
/// The password hasher to use for the application
let private hasher = PasswordHasher<Citizen> ()
/// Hash a password for a user
let hash citizen password =
hasher.HashPassword (citizen, password)
/// Verify a password (returns true if the password needs to be rehashed)
let verify citizen password =
match hasher.VerifyHashedPassword (citizen, citizen.PasswordHash, password) with
| PasswordVerificationResult.Success -> Some false
| PasswordVerificationResult.SuccessRehashNeeded -> Some true
| _ -> None

11
src/JobsJobsJobs/Data/Cache.fs → src/JobsJobsJobs/Server/Cache.fs
View File

@ -1,8 +1,5 @@
namespace JobsJobsJobs.Data namespace JobsJobsJobs
open System.Threading
open System.Threading.Tasks
open Microsoft.Extensions.Caching.Distributed
open NodaTime open NodaTime
open Npgsql.FSharp open Npgsql.FSharp
@ -11,6 +8,7 @@ open Npgsql.FSharp
module private CacheHelpers = module private CacheHelpers =
open System open System
open System.Threading.Tasks
open Npgsql open Npgsql
/// The cache entry /// The cache entry
@ -56,7 +54,10 @@ module private CacheHelpers =
let expireParam = let expireParam =
typedParam "expireAt" typedParam "expireAt"
open DataConnection
open System.Threading
open JobsJobsJobs.Common.Data
open Microsoft.Extensions.Caching.Distributed
/// A distributed cache implementation in PostgreSQL used to handle sessions for Jobs, Jobs, Jobs /// A distributed cache implementation in PostgreSQL used to handle sessions for Jobs, Jobs, Jobs
type DistributedCache () = type DistributedCache () =

199
src/JobsJobsJobs/Server/Citizens/Data.fs Normal file
View File

@ -0,0 +1,199 @@
module JobsJobsJobs.Citizens.Data
open JobsJobsJobs.Common.Data
open JobsJobsJobs.Domain
open NodaTime
open Npgsql.FSharp
/// The last time a token purge check was run
let mutable private lastPurge = Instant.MinValue
/// Lock access to the above
let private locker = obj ()
/// Delete a citizen by their ID using the given connection properties
let private doDeleteById citizenId connProps = backgroundTask {
let! _ =
connProps
|> Sql.query $"
DELETE FROM {Table.Success} WHERE data ->> 'citizenId' = @id;
DELETE FROM {Table.Listing} WHERE data ->> 'citizenId' = @id;
DELETE FROM {Table.Citizen} WHERE id = @id"
|> Sql.parameters [ "@id", Sql.string (CitizenId.toString citizenId) ]
|> Sql.executeNonQueryAsync
()
}
/// Delete a citizen by their ID
let deleteById citizenId =
doDeleteById citizenId (dataSource ())
/// Save a citizen
let private saveCitizen (citizen : Citizen) connProps =
saveDocument Table.Citizen (CitizenId.toString citizen.Id) connProps (mkDoc citizen)
/// Save security information for a citizen
let private saveSecurity (security : SecurityInfo) connProps =
saveDocument Table.SecurityInfo (CitizenId.toString security.Id) connProps (mkDoc security)
/// Purge expired tokens
let private purgeExpiredTokens now = backgroundTask {
let connProps = dataSource ()
let! info =
Sql.query $"SELECT * FROM {Table.SecurityInfo} WHERE data ->> 'tokenExpires' IS NOT NULL" connProps
|> Sql.executeAsync toDocument<SecurityInfo>
for expired in info |> List.filter (fun it -> it.TokenExpires.Value < now) do
if expired.TokenUsage.Value = "confirm" then
// Unconfirmed account; delete the entire thing
do! doDeleteById expired.Id connProps
else
// Some other use; just clear the token
do! saveSecurity { expired with Token = None; TokenUsage = None; TokenExpires = None } connProps
}
/// Check for tokens to purge if it's been more than 10 minutes since we last checked
let private checkForPurge skipCheck =
lock locker (fun () -> backgroundTask {
let now = SystemClock.Instance.GetCurrentInstant ()
if skipCheck || (now - lastPurge).TotalMinutes >= 10 then
do! purgeExpiredTokens now
lastPurge <- now
})
/// Find a citizen by their ID
let findById citizenId = backgroundTask {
match! dataSource () |> getDocument<Citizen> Table.Citizen (CitizenId.toString citizenId) with
| Some c when not c.IsLegacy -> return Some c
| Some _
| None -> return None
}
/// Save a citizen
let save citizen =
saveCitizen citizen (dataSource ())
/// Register a citizen (saves citizen and security settings); returns false if the e-mail is already taken
let register citizen (security : SecurityInfo) = backgroundTask {
let connProps = dataSource ()
use conn = Sql.createConnection connProps
use! txn = conn.BeginTransactionAsync ()
try
do! saveCitizen citizen connProps
do! saveSecurity security connProps
do! txn.CommitAsync ()
return true
with
| :? Npgsql.PostgresException as ex when ex.SqlState = "23505" && ex.ConstraintName = "uk_citizen_email" ->
do! txn.RollbackAsync ()
return false
}
/// Try to find the security information matching a confirmation token
let private tryConfirmToken token connProps = backgroundTask {
let! tryInfo =
connProps
|> Sql.query $"
SELECT *
FROM {Table.SecurityInfo}
WHERE data ->> 'token' = @token
AND data ->> 'tokenUsage' = 'confirm'"
|> Sql.parameters [ "@token", Sql.string token ]
|> Sql.executeAsync toDocument<SecurityInfo>
return List.tryHead tryInfo
}
/// Confirm a citizen's account
let confirmAccount token = backgroundTask {
do! checkForPurge true
let connProps = dataSource ()
match! tryConfirmToken token connProps with
| Some info ->
do! saveSecurity { info with AccountLocked = false; Token = None; TokenUsage = None; TokenExpires = None }
connProps
return true
| None -> return false
}
/// Deny a citizen's account (user-initiated; used if someone used their e-mail address without their consent)
let denyAccount token = backgroundTask {
do! checkForPurge true
let connProps = dataSource ()
match! tryConfirmToken token connProps with
| Some info ->
do! doDeleteById info.Id connProps
return true
| None -> return false
}
/// Attempt a user log on
let tryLogOn email password (pwVerify : Citizen -> string -> bool option) (pwHash : Citizen -> string -> string)
now = backgroundTask {
do! checkForPurge false
let connProps = dataSource ()
let! tryCitizen =
connProps
|> Sql.query $"
SELECT *
FROM {Table.Citizen}
WHERE data ->> 'email' = @email
AND data ->> 'isLegacy' = 'false'"
|> Sql.parameters [ "@email", Sql.string email ]
|> Sql.executeAsync toDocument<Citizen>
match List.tryHead tryCitizen with
| Some citizen ->
let citizenId = CitizenId.toString citizen.Id
let! tryInfo = getDocument<SecurityInfo> Table.SecurityInfo citizenId connProps
let! info = backgroundTask {
match tryInfo with
| Some it -> return it
| None ->
let it = { SecurityInfo.empty with Id = citizen.Id }
do! saveSecurity it connProps
return it
}
if info.AccountLocked then return Error "Log on unsuccessful (Account Locked)"
else
match pwVerify citizen password with
| Some rehash ->
let hash = if rehash then pwHash citizen password else citizen.PasswordHash
do! saveSecurity { info with FailedLogOnAttempts = 0 } connProps
do! saveCitizen { citizen with LastSeenOn = now; PasswordHash = hash } connProps
return Ok { citizen with LastSeenOn = now }
| None ->
let locked = info.FailedLogOnAttempts >= 4
do! { info with FailedLogOnAttempts = info.FailedLogOnAttempts + 1; AccountLocked = locked }
|> saveSecurity <| connProps
return Error $"""Log on unsuccessful{if locked then " - Account is now locked" else ""}"""
| None -> return Error "Log on unsuccessful"
}
/// Try to retrieve a citizen and their security information by their e-mail address
let tryByEmailWithSecurity email = backgroundTask {
let toCitizenSecurityPair row = (toDocument<Citizen> row, toDocumentFrom<SecurityInfo> "sec_data" row)
let! results =
dataSource ()
|> Sql.query $"
SELECT c.*, s.data AS sec_data
FROM {Table.Citizen} c
INNER JOIN {Table.SecurityInfo} s ON s.id = c.id
WHERE c.data ->> 'email' = @email"
|> Sql.parameters [ "@email", Sql.string email ]
|> Sql.executeAsync toCitizenSecurityPair
return List.tryHead results
}
/// Save an updated security information document
let saveSecurityInfo security = backgroundTask {
do! saveSecurity security (dataSource ())
}
/// Try to retrieve security information by the given token
let trySecurityByToken token = backgroundTask {
do! checkForPurge false
let! results =
dataSource ()
|> Sql.query $"SELECT * FROM {Table.SecurityInfo} WHERE data ->> 'token' = @token"
|> Sql.parameters [ "@token", Sql.string token ]
|> Sql.executeAsync toDocument<SecurityInfo>
return List.tryHead results
}

153
src/JobsJobsJobs/Server/Citizens/Domain.fs Normal file
View File

@ -0,0 +1,153 @@
module JobsJobsJobs.Citizens.Domain
open JobsJobsJobs.Domain
/// The data to add or update an other contact
[<CLIMutable; NoComparison; NoEquality>]
type OtherContactForm =
{ /// The type of the contact
ContactType : string
/// The name of the contact
Name : string
/// The value of the contact (URL, e-mail address, phone, etc.)
Value : string
/// Whether this contact is displayed for public employment profiles and job listings
IsPublic : bool
}
/// Support functions for the contact form
module OtherContactForm =
/// Create a contact form from a contact
let fromContact (contact : OtherContact) =
{ ContactType = ContactType.toString contact.ContactType
Name = defaultArg contact.Name ""
Value = contact.Value
IsPublic = contact.IsPublic
}
/// The data available to update an account profile
[<CLIMutable; NoComparison; NoEquality>]
type AccountProfileForm =
{ /// The first name of the citizen
FirstName : string
/// The last name of the citizen
LastName : string
/// The display name for the citizen
DisplayName : string
/// The citizen's new password
NewPassword : string
/// Confirmation of the citizen's new password
NewPasswordConfirm : string
/// The contacts for this profile
Contacts : OtherContactForm array
}
/// Support functions for the account profile form
module AccountProfileForm =
/// Create an account profile form from a citizen
let fromCitizen (citizen : Citizen) =
{ FirstName = citizen.FirstName
LastName = citizen.LastName
DisplayName = defaultArg citizen.DisplayName ""
NewPassword = ""
NewPasswordConfirm = ""
Contacts = citizen.OtherContacts |> List.map OtherContactForm.fromContact |> Array.ofList
}
/// Form for the forgot / reset password page
[<CLIMutable; NoComparison; NoEquality>]
type ForgotPasswordForm =
{ /// The e-mail address for the account wishing to reset their password
Email : string
}
/// Form for the log on page
[<CLIMutable; NoComparison; NoEquality>]
type LogOnForm =
{ /// A message regarding an error encountered during a log on attempt
ErrorMessage : string option
/// The e-mail address for the user attempting to log on
Email : string
/// 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
}
/// Form for the registration page
[<CLIMutable; NoComparison; NoEquality>]
type RegisterForm =
{ /// The user's first name
FirstName : string
/// The user's last name
LastName : string
/// The user's display name
DisplayName : string option
/// The user's e-mail address
Email : string
/// The user's desired password
Password : string
/// The index of the first question asked
Question1Index : int
/// The answer for the first question asked
Question1Answer : string
/// The index of the second question asked
Question2Index : int
/// The answer for the second question asked
Question2Answer : string
}
/// Support for the registration page view model
module RegisterForm =
/// An empty view model
let empty =
{ FirstName = ""
LastName = ""
DisplayName = None
Email = ""
Password = ""
Question1Index = 0
Question1Answer = ""
Question2Index = 0
Question2Answer = ""
}
/// The form for a user resetting their password
[<CLIMutable; NoComparison; NoEquality>]
type ResetPasswordForm =
{ /// The ID of the citizen whose password is being reset
Id : string
/// The verification token for the password reset
Token : string
/// The new password for the account
Password : string
}

351
src/JobsJobsJobs/Server/Citizens/Handlers.fs Normal file
View File

@ -0,0 +1,351 @@
module JobsJobsJobs.Citizens.Handlers
open System
open System.Security.Claims
open Giraffe
open JobsJobsJobs
open JobsJobsJobs.Citizens.Domain
open JobsJobsJobs.Common.Handlers
open JobsJobsJobs.Domain
open Microsoft.AspNetCore.Authentication
open Microsoft.AspNetCore.Authentication.Cookies
open Microsoft.Extensions.Logging
open NodaTime
/// Authorization functions
module private Auth =
open System.Text
/// Create a confirmation or password reset token for a user
let createToken (citizen : Citizen) =
Convert.ToBase64String (Guid.NewGuid().ToByteArray () |> Array.append (Encoding.UTF8.GetBytes citizen.Email))
/// The challenge questions and answers from the configuration
let mutable private challenges : (string * string)[] option = None
/// The challenge questions and answers
let questions ctx =
match challenges with
| Some it -> it
| None ->
let qs = (config ctx).GetSection "ChallengeQuestions"
let qAndA =
seq {
for idx in 0..4 do
let section = qs.GetSection(string idx)
yield section["Question"], (section["Answer"].ToLowerInvariant ())
}
|> Array.ofSeq
challenges <- Some qAndA
qAndA
/// Password hashing and verification
module Passwords =
open Microsoft.AspNetCore.Identity
/// The password hasher to use for the application
let private hasher = PasswordHasher<Citizen> ()
/// Hash a password for a user
let hash citizen password =
hasher.HashPassword (citizen, password)
/// Verify a password (returns true if the password needs to be rehashed)
let verify citizen password =
match hasher.VerifyHashedPassword (citizen, citizen.PasswordHash, password) with
| PasswordVerificationResult.Success -> Some false
| PasswordVerificationResult.SuccessRehashNeeded -> Some true
| _ -> None
// GET: /citizen/account
let account : HttpHandler = fun next ctx -> task {
match! Data.findById (currentCitizenId ctx) with
| Some citizen ->
return! Views.account (AccountProfileForm.fromCitizen citizen) (csrf ctx) |> render "Account Profile" next ctx
| None -> return! Error.notFound next ctx
}
// GET: /citizen/cancel-reset/[token]
let cancelReset token : HttpHandler = fun next ctx -> task {
let! wasCanceled = task {
match! Data.trySecurityByToken token with
| Some security ->
do! Data.saveSecurityInfo { security with Token = None; TokenUsage = None; TokenExpires = None }
return true
| None -> return false
}
return! Views.resetCanceled wasCanceled |> render "Password Reset Cancellation" next ctx
}
// GET: /citizen/confirm/[token]
let confirm token : HttpHandler = fun next ctx -> task {
let! isConfirmed = Data.confirmAccount token
return! Views.confirmAccount isConfirmed |> render "Account Confirmation" next ctx
}
// GET: /citizen/dashboard
let dashboard : HttpHandler = requireUser >=> fun next ctx -> task {
let citizenId = currentCitizenId ctx
let! citizen = Data.findById citizenId
let! profile = Profiles.Data.findById citizenId
let! prfCount = Profiles.Data.count ()
return! Views.dashboard citizen.Value profile prfCount (timeZone ctx) |> render "Dashboard" next ctx
}
// POST: /citizen/delete
let delete : HttpHandler = requireUser >=> validateCsrf >=> fun next ctx -> task {
do! Data.deleteById (currentCitizenId ctx)
do! ctx.SignOutAsync ()
return! render "Account Deleted Successfully" next ctx Views.deleted
}
// GET: /citizen/deny/[token]
let deny token : HttpHandler = fun next ctx -> task {
let! wasDeleted = Data.denyAccount token
return! Views.denyAccount wasDeleted |> render "Account Deletion" next ctx
}
// GET: /citizen/forgot-password
let forgotPassword : HttpHandler = fun next ctx ->
Views.forgotPassword (csrf ctx) |> render "Forgot Password" next ctx
// POST: /citizen/forgot-password
let doForgotPassword : HttpHandler = validateCsrf >=> fun next ctx -> task {
let! form = ctx.BindFormAsync<ForgotPasswordForm> ()
match! Data.tryByEmailWithSecurity form.Email with
| Some (citizen, security) ->
let withToken =
{ security with
Token = Some (Auth.createToken citizen)
TokenUsage = Some "reset"
TokenExpires = Some (now ctx + (Duration.FromDays 3))
}
do! Data.saveSecurityInfo withToken
let! emailResponse = Email.sendPasswordReset citizen withToken
let logFac = logger ctx
let log = logFac.CreateLogger "JobsJobsJobs.Handlers.Citizen"
log.LogInformation $"Password reset e-mail for {citizen.Email} received {emailResponse}"
| None -> ()
return! Views.forgotPasswordSent form |> render "Reset Request Processed" next ctx
}
// GET: /citizen/log-off
let logOff : HttpHandler = 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 ->
let returnTo =
if ctx.Request.Query.ContainsKey "returnUrl" then Some ctx.Request.Query["returnUrl"].[0] else None
Views.logOn { ErrorMessage = None; Email = ""; Password = ""; ReturnTo = returnTo } (csrf ctx)
|> render "Log On" next ctx
// POST: /citizen/log-on
let doLogOn : HttpHandler = validateCsrf >=> fun next ctx -> task {
let! form = ctx.BindFormAsync<LogOnForm> ()
match! Data.tryLogOn form.Email form.Password Auth.Passwords.verify Auth.Passwords.hash (now ctx) with
| Ok citizen ->
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! Views.logOn { form with Password = "" } (csrf ctx) |> render "Log On" next ctx
}
// GET: /citizen/register
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 = Auth.questions ctx
Views.register (fst qAndA[q1Index]) (fst qAndA[q2Index])
{ RegisterForm.empty with Question1Index = q1Index; Question2Index = q2Index } (csrf ctx)
|> render "Register" next ctx
// POST: /citizen/register
let doRegistration : HttpHandler = validateCsrf >=> fun next ctx -> task {
let! form = ctx.BindFormAsync<RegisterForm> ()
let qAndA = Auth.questions ctx
let mutable badForm = false
let errors = [
if form.FirstName.Length < 1 then "First name is required"
if form.LastName.Length < 1 then "Last name is required"
if form.Email.Length < 1 then "E-mail address is required"
if form.Password.Length < 8 then "Password is too short"
if form.Question1Index < 0 || form.Question1Index > 4
|| form.Question2Index < 0 || form.Question2Index > 4
|| form.Question1Index = form.Question2Index then
badForm <- true
else if (snd qAndA[form.Question1Index]) <> (form.Question1Answer.Trim().ToLowerInvariant ())
|| (snd qAndA[form.Question2Index]) <> (form.Question2Answer.Trim().ToLowerInvariant ()) then
"Question answers are incorrect"
]
let refreshPage () =
Views.register (fst qAndA[form.Question1Index]) (fst qAndA[form.Question2Index]) { form with Password = "" }
(csrf ctx)
|> renderHandler "Register"
if badForm then
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 =
{ Citizen.empty with
Id = CitizenId.create ()
Email = form.Email
FirstName = form.FirstName
LastName = form.LastName
DisplayName = noneIfBlank form.DisplayName
JoinedOn = now
LastSeenOn = now
}
let citizen = { noPass with PasswordHash = Auth.Passwords.hash noPass form.Password }
let security =
{ SecurityInfo.empty with
Id = citizen.Id
AccountLocked = true
Token = Some (Auth.createToken citizen)
TokenUsage = Some "confirm"
TokenExpires = Some (now + (Duration.FromDays 3))
}
let! success = Data.register citizen security
if success then
let! emailResponse = Email.sendAccountConfirmation citizen security
let logFac = logger ctx
let log = logFac.CreateLogger "JobsJobsJobs.Handlers.Citizen"
log.LogInformation $"Confirmation e-mail for {citizen.Email} received {emailResponse}"
return! Views.registered |> render "Registration Successful" next ctx
else
do! addError "There is already an account registered to the e-mail address provided" ctx
return! refreshPage () next ctx
else
do! addErrors errors ctx
return! refreshPage () next ctx
}
// GET: /citizen/reset-password/[token]
let resetPassword token : HttpHandler = fun next ctx -> task {
match! Data.trySecurityByToken token with
| Some security ->
return!
Views.resetPassword { Id = CitizenId.toString security.Id; Token = token; Password = "" } (csrf ctx)
|> render "Reset Password" next ctx
| None -> return! Error.notFound next ctx
}
// POST: /citizen/reset-password
let doResetPassword : HttpHandler = validateCsrf >=> fun next ctx -> task {
let! form = ctx.BindFormAsync<ResetPasswordForm> ()
let errors = [
if form.Id = "" then "Request invalid; please return to the link in your e-mail and try again"
if form.Token = "" then "Request invalid; please return to the link in your e-mail and try again"
if form.Password.Length < 8 then "Password too short"
]
if List.isEmpty errors then
match! Data.trySecurityByToken form.Token with
| Some security when security.Id = CitizenId.ofString form.Id ->
match! Data.findById security.Id with
| Some citizen ->
do! Data.saveSecurityInfo { security with Token = None; TokenUsage = None; TokenExpires = None }
do! Data.save { citizen with PasswordHash = Auth.Passwords.hash citizen form.Password }
do! addSuccess "Password reset successfully; you may log on with your new credentials" ctx
return! redirectToGet "/citizen/log-on" next ctx
| None -> return! Error.notFound next ctx
| Some _
| None -> return! Error.notFound next ctx
else
do! addErrors errors ctx
return! Views.resetPassword form (csrf ctx) |> render "Reset Password" next ctx
}
// POST: /citizen/save-account
let saveAccount : HttpHandler = requireUser >=> validateCsrf >=> fun next ctx -> task {
let! theForm = ctx.BindFormAsync<AccountProfileForm> ()
let form = { theForm with Contacts = theForm.Contacts |> Array.filter (box >> isNull >> not) }
let errors = [
if form.FirstName = "" then "First Name is required"
if form.LastName = "" then "Last Name is required"
if form.NewPassword <> form.NewPassword then "New passwords do not match"
if form.Contacts |> Array.exists (fun c -> c.ContactType = "") then "All Contact Types are required"
if form.Contacts |> Array.exists (fun c -> c.Value = "") then "All Contacts are required"
]
if List.isEmpty errors then
match! Data.findById (currentCitizenId ctx) with
| Some citizen ->
let password =
if form.NewPassword = "" then citizen.PasswordHash
else Auth.Passwords.hash citizen form.NewPassword
do! Data.save
{ citizen with
FirstName = form.FirstName
LastName = form.LastName
DisplayName = noneIfEmpty form.DisplayName
PasswordHash = password
OtherContacts = form.Contacts
|> Array.map (fun c ->
{ OtherContact.Name = noneIfEmpty c.Name
ContactType = ContactType.parse c.ContactType
Value = c.Value
IsPublic = c.IsPublic
})
|> List.ofArray
}
let extraMsg = if form.NewPassword = "" then "" else " and password changed"
do! addSuccess $"Account profile updated{extraMsg} successfully" ctx
return! redirectToGet "/citizen/account" next ctx
| None -> return! Error.notFound next ctx
else
do! addErrors errors ctx
return! Views.account form (csrf ctx) |> render "Account Profile" next ctx
}
// GET: /citizen/so-long
let soLong : HttpHandler = requireUser >=> fun next ctx ->
Views.deletionOptions (csrf ctx) |> render "Account Deletion Options" next ctx
open Giraffe.EndpointRouting
/// All endpoints for this feature
let endpoints =
subRoute "/citizen" [
GET_HEAD [
route "/account" account
routef "/cancel-reset/%s" cancelReset
routef "/confirm/%s" confirm
route "/dashboard" dashboard
routef "/deny/%s" deny
route "/forgot-password" forgotPassword
route "/log-off" logOff
route "/log-on" logOn
route "/register" register
routef "/reset-password/%s" resetPassword
route "/so-long" soLong
]
POST [
route "/delete" delete
route "/forgot-password" doForgotPassword
route "/log-on" doLogOn
route "/register" doRegistration
route "/reset-password" doResetPassword
route "/save-account" saveAccount
]
]

14
src/JobsJobsJobs/Server/Views/Citizen.fs → src/JobsJobsJobs/Server/Citizens/Views.fs
View File

@ -1,11 +1,11 @@
/// Views for URLs beginning with /citizen /// Views for URLs beginning with /citizen
[<RequireQualifiedAccess>] module JobsJobsJobs.Citizens.Views
module JobsJobsJobs.Views.Citizen
open Giraffe.ViewEngine open Giraffe.ViewEngine
open Giraffe.ViewEngine.Htmx open Giraffe.ViewEngine.Htmx
open JobsJobsJobs.Citizens.Domain
open JobsJobsJobs.Common.Views
open JobsJobsJobs.Domain open JobsJobsJobs.Domain
open JobsJobsJobs.ViewModels
/// The form to add or edit a means of contact /// The form to add or edit a means of contact
let contactEdit (contacts : OtherContactForm array) = let contactEdit (contacts : OtherContactForm array) =
@ -264,14 +264,14 @@ let forgotPassword csrf =
let forgotPasswordSent (m : ForgotPasswordForm) = let forgotPasswordSent (m : ForgotPasswordForm) =
pageWithTitle "Reset Request Processed" [ pageWithTitle "Reset Request Processed" [
p [] [ p [] [
txt "The reset link request has been processed. If the e-mail address matched an account, further " txt $"The reset link request has been processed. If the e-mail address {m.Email} matched an account, "
txt "instructions were sent to that address." txt "further instructions were sent to that address."
] ]
] ]
/// The log on page /// The log on page
let logOn (m : LogOnViewModel) csrf = let logOn (m : LogOnForm) csrf =
pageWithTitle "Log On" [ pageWithTitle "Log On" [
match m.ErrorMessage with match m.ErrorMessage with
| Some msg -> | Some msg ->
@ -305,7 +305,7 @@ let logOn (m : LogOnViewModel) csrf =
] ]
/// The registration page /// The registration page
let register q1 q2 (m : RegisterViewModel) csrf = let register q1 q2 (m : RegisterForm) csrf =
pageWithTitle "Register" [ pageWithTitle "Register" [
form [ _class "row g-3"; _hxPost "/citizen/register" ] [ form [ _class "row g-3"; _hxPost "/citizen/register" ] [
antiForgery csrf antiForgery csrf

151
src/JobsJobsJobs/Server/Common/Data.fs Normal file
View File

@ -0,0 +1,151 @@
module JobsJobsJobs.Common.Data
/// Constants for tables used by Jobs, Jobs, Jobs
[<RequireQualifiedAccess>]
module Table =
/// Citizens
[<Literal>]
let Citizen = "jjj.citizen"
/// Continents
[<Literal>]
let Continent = "jjj.continent"
/// Job Listings
[<Literal>]
let Listing = "jjj.listing"
/// Employment Profiles
[<Literal>]
let Profile = "jjj.profile"
/// User Security Information
[<Literal>]
let SecurityInfo = "jjj.security_info"
/// Success Stories
[<Literal>]
let Success = "jjj.success"
open Npgsql.FSharp
/// Connection management for the document store
[<AutoOpen>]
module DataConnection =
open Microsoft.Extensions.Configuration
open Npgsql
/// The data source for the document store
let mutable private theDataSource : NpgsqlDataSource option = None
/// Get the data source as the start of a SQL statement
let dataSource () =
match theDataSource with
| Some ds -> Sql.fromDataSource ds
| None -> invalidOp "Connection.setUp() must be called before accessing the database"
/// Create tables
let private createTables () = backgroundTask {
let sql = [
"CREATE SCHEMA IF NOT EXISTS jjj"
// Tables
$"CREATE TABLE IF NOT EXISTS {Table.Citizen} (id TEXT NOT NULL PRIMARY KEY, data JSONB NOT NULL)"
$"CREATE TABLE IF NOT EXISTS {Table.Continent} (id TEXT NOT NULL PRIMARY KEY, data JSONB NOT NULL)"
$"CREATE TABLE IF NOT EXISTS {Table.Listing} (id TEXT NOT NULL PRIMARY KEY, data JSONB NOT NULL)"
$"CREATE TABLE IF NOT EXISTS {Table.Profile} (id TEXT NOT NULL PRIMARY KEY, data JSONB NOT NULL,
CONSTRAINT fk_profile_citizen FOREIGN KEY (id) REFERENCES {Table.Citizen} (id) ON DELETE CASCADE)"
$"CREATE TABLE IF NOT EXISTS {Table.SecurityInfo} (id TEXT NOT NULL PRIMARY KEY, data JSONB NOT NULL,
CONSTRAINT fk_security_info_citizen FOREIGN KEY (id) REFERENCES {Table.Citizen} (id) ON DELETE CASCADE)"
$"CREATE TABLE IF NOT EXISTS {Table.Success} (id TEXT NOT NULL PRIMARY KEY, data JSONB NOT NULL)"
// Key indexes
$"CREATE UNIQUE INDEX IF NOT EXISTS uk_citizen_email ON {Table.Citizen} ((data -> 'email'))"
$"CREATE INDEX IF NOT EXISTS idx_listing_citizen ON {Table.Listing} ((data -> 'citizenId'))"
$"CREATE INDEX IF NOT EXISTS idx_listing_continent ON {Table.Listing} ((data -> 'continentId'))"
$"CREATE INDEX IF NOT EXISTS idx_profile_continent ON {Table.Profile} ((data -> 'continentId'))"
$"CREATE INDEX IF NOT EXISTS idx_success_citizen ON {Table.Success} ((data -> 'citizenId'))"
]
let! _ =
dataSource ()
|> Sql.executeTransactionAsync (sql |> List.map (fun sql -> sql, [ [] ]))
()
}
/// Set up the data connection from the given configuration
let setUp (cfg : IConfiguration) = backgroundTask {
let builder = NpgsqlDataSourceBuilder (cfg.GetConnectionString "PostgreSQL")
let _ = builder.UseNodaTime ()
theDataSource <- Some (builder.Build ())
do! createTables ()
}
open System.Text.Json
open System.Threading.Tasks
open JobsJobsJobs
/// Map the data field to the requested document type
let toDocumentFrom<'T> fieldName (row : RowReader) =
JsonSerializer.Deserialize<'T> (row.string fieldName, Json.options)
/// Map the data field to the requested document type
let toDocument<'T> (row : RowReader) = toDocumentFrom<'T> "data" row
/// Get a document
let getDocument<'T> table docId sqlProps : Task<'T option> = backgroundTask {
let! doc =
Sql.query $"SELECT * FROM %s{table} where id = @id" sqlProps
|> Sql.parameters [ "@id", Sql.string docId ]
|> Sql.executeAsync toDocument
return List.tryHead doc
}
/// Serialize a document to JSON
let mkDoc<'T> (doc : 'T) =
JsonSerializer.Serialize<'T> (doc, Json.options)
/// Save a document
let saveDocument table docId sqlProps doc = backgroundTask {
let! _ =
Sql.query
$"INSERT INTO %s{table} (id, data) VALUES (@id, @data)
ON CONFLICT (id) DO UPDATE SET data = EXCLUDED.data"
sqlProps
|> Sql.parameters
[ "@id", Sql.string docId
"@data", Sql.jsonb doc ]
|> Sql.executeNonQueryAsync
()
}
/// Create a match-anywhere clause for a LIKE or ILIKE clause
let like value =
Sql.string $"%%%s{value}%%"
/// The JSON access operator ->> makes values text; this makes a parameter that will compare the properly
let jsonBool value =
Sql.string (if value then "true" else "false")
/// Get the SQL for a search WHERE clause
let searchSql criteria =
let sql = criteria |> List.map fst |> String.concat " AND "
if sql = "" then "" else $"AND {sql}"
/// Continent data access functions
[<RequireQualifiedAccess>]
module Continents =
open JobsJobsJobs.Domain
/// Retrieve all continents
let all () =
dataSource ()
|> Sql.query $"SELECT * FROM {Table.Continent} ORDER BY data ->> 'name'"
|> Sql.executeAsync toDocument<Continent>
/// Retrieve a continent by its ID
let findById continentId =
dataSource () |> getDocument<Continent> Table.Continent (ContinentId.toString continentId)

196
src/JobsJobsJobs/Server/Common/Handlers.fs Normal file
View File

@ -0,0 +1,196 @@
/// Common helper functions for views
module JobsJobsJobs.Common.Handlers
open Giraffe
open Giraffe.Htmx
open Microsoft.AspNetCore.Http
open Microsoft.Extensions.Logging
[<AutoOpen>]
module private HtmxHelpers =
/// Is the request from htmx?
let isHtmx (ctx : HttpContext) =
ctx.Request.IsHtmx && not ctx.Request.IsHtmxRefresh
/// Handlers for error conditions
module Error =
open System.Net
/// Handler that will return a status code 404 and the text "Not Found"
let notFound : HttpHandler = fun next ctx ->
let fac = ctx.GetService<ILoggerFactory> ()
let log = fac.CreateLogger "Handler"
let path = string ctx.Request.Path
log.LogInformation "Returning 404"
RequestErrors.NOT_FOUND $"The URL {path} was not recognized as a valid URL" next ctx
/// 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 = $"/citizen/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) =
log.LogError(ex, "An unexpected error occurred")
clearResponse >=> ServerErrors.INTERNAL_ERROR ex.Message
open System
open System.Security.Claims
open System.Text.Json
open System.Text.RegularExpressions
open JobsJobsJobs.Domain
open Microsoft.AspNetCore.Antiforgery
open Microsoft.Extensions.Configuration
open Microsoft.Extensions.DependencyInjection
open NodaTime
/// Get the NodaTime clock from the request context
let now (ctx : HttpContext) = ctx.GetService<IClock>().GetCurrentInstant ()
/// Get the application configuration from the request context
let config (ctx : HttpContext) = ctx.GetService<IConfiguration> ()
/// Get the logger factory from the request context
let logger (ctx : HttpContext) = ctx.GetService<ILoggerFactory> ()
/// `None` if a `string option` is `None`, whitespace, or empty
let noneIfBlank (s : string option) =
s |> Option.map (fun x -> match x.Trim () with "" -> None | _ -> Some x) |> Option.flatten
/// `None` if a `string` is null, empty, or whitespace; otherwise, `Some` and the trimmed string
let noneIfEmpty = Option.ofObj >> noneIfBlank
/// Try to get the current user
let tryUser (ctx : HttpContext) =
ctx.User.FindFirst ClaimTypes.NameIdentifier
|> Option.ofObj
|> Option.map (fun x -> x.Value)
/// Require a user to be logged in
let authorize : HttpHandler =
fun next ctx -> match tryUser ctx with Some _ -> next ctx | None -> Error.notAuthorized next ctx
/// Get the ID of the currently logged in citizen
// NOTE: if no one is logged in, this will raise an exception
let currentCitizenId ctx = (tryUser >> Option.get >> CitizenId.ofString) ctx
/// Return an empty OK response
let ok : HttpHandler = Successful.OK ""
// -- NEW --
let antiForgerySvc (ctx : HttpContext) =
ctx.RequestServices.GetRequiredService<IAntiforgery> ()
/// Obtain an anti-forgery token set
let csrf ctx =
(antiForgerySvc ctx).GetAndStoreTokens ctx
/// Get the time zone from the citizen's browser
let timeZone (ctx : HttpContext) =
let tz = string ctx.Request.Headers["X-Time-Zone"]
defaultArg (noneIfEmpty tz) "Etc/UTC"
/// 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 popMessages 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 addMessage (level : string) (msg : string) ctx = task {
do! loadSession ctx
let! msgs = popMessages 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 addError msg ctx = task {
do! addMessage "error" msg ctx
}
/// Add a list of errors to the response
let addErrors (errors : string list) ctx = task {
let errMsg = String.Join ("</li><li>", errors)
do! addError $"Please correct the following errors:<ul><li>{errMsg}</li></ul>" ctx
}
open JobsJobsJobs.Common.Views
/// Render a page-level view
let render pageTitle (_ : HttpFunc) (ctx : HttpContext) content = task {
let! messages = popMessages ctx
let renderCtx : Layout.PageRenderContext = {
IsLoggedOn = Option.isSome (tryUser ctx)
CurrentUrl = ctx.Request.Path.Value
PageTitle = pageTitle
Content = content
Messages = messages
}
let renderFunc = if isHtmx ctx then Layout.partial else Layout.full
return! ctx.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! (antiForgerySvc ctx).IsRequestValidAsync ctx with
| true -> return! next ctx
| false -> return! RequestErrors.BAD_REQUEST "CSRF token invalid" earlyReturn ctx
}
/// Require a user to be logged on for a route
let requireUser : HttpHandler = requiresAuthentication Error.notAuthorized
/// Regular expression to validate that a URL is a local URL
let isLocal = Regex """^/[^\/\\].*"""
/// Redirect to another page, saving the session before redirecting
let redirectToGet (url : string) next ctx = task {
do! saveSession ctx
let action =
if Option.isSome (noneIfEmpty url) && isLocal.IsMatch url then
if isHtmx ctx then withHxRedirect url else redirectTo false url
else RequestErrors.BAD_REQUEST "Invalid redirect URL"
return! action next ctx
}

3
src/JobsJobsJobs/Data/Json.fs → src/JobsJobsJobs/Server/Common/Json.fs
View File

@ -1,4 +1,5 @@
module JobsJobsJobs.Data.Json /// JSON serializer options
module JobsJobsJobs.Json
open System.Text.Json open System.Text.Json
open System.Text.Json.Serialization open System.Text.Json.Serialization

354
src/JobsJobsJobs/Server/Common/Views.fs Normal file
View File

@ -0,0 +1,354 @@
/// Common functions for views
module JobsJobsJobs.Common.Views
open Giraffe.ViewEngine
open Giraffe.ViewEngine.Accessibility
open Microsoft.AspNetCore.Antiforgery
open JobsJobsJobs.Domain
/// Create an audio clip with the specified text node
let audioClip clip text =
span [ _class "jjj-audio-clip"; _onclick "jjj.playFile(this)" ] [
text; audio [ _id clip ] [ source [ _src $"/audio/{clip}.mp3" ] ]
]
/// Create an anti-forgery hidden input
let antiForgery (csrf : AntiforgeryTokenSet) =
input [ _type "hidden"; _name csrf.FormFieldName; _value csrf.RequestToken ]
/// Alias for rawText
let txt = rawText
/// Create a page with a title displayed on the page
let pageWithTitle title content =
article [] [
h3 [ _class "pb-3" ] [ txt title ]
yield! content
]
/// Create a floating-label text input box
let textBox attrs name value fieldLabel isRequired =
div [ _class "form-floating" ] [
List.append attrs [
_id name; _name name; _class "form-control"; _placeholder fieldLabel; _value value
if isRequired then _required
] |> input
label [ _class (if isRequired then "jjj-required" else "jjj-label"); _for name ] [ txt fieldLabel ]
]
/// Create a checkbox that will post "true" if checked
let checkBox attrs name isChecked checkLabel =
div [ _class "form-check" ] [
List.append attrs
[ _type "checkbox"; _id name; _name name; _class "form-check-input"; _value "true"
if isChecked then _checked ]
|> input
label [ _class "form-check-label"; _for name ] [ txt checkLabel ]
]
/// Create a select list of continents
let continentList attrs name (continents : Continent list) emptyLabel selectedValue isRequired =
div [ _class "form-floating" ] [
select (List.append attrs [ _id name; _name name; _class "form-select"; if isRequired then _required ]) (
option [ _value ""; if selectedValue = "" then _selected ] [
rawText $"""&ndash; {defaultArg emptyLabel "Select"} &ndash;""" ]
:: (continents
|> List.map (fun c ->
let theId = ContinentId.toString c.Id
option [ _value theId; if theId = selectedValue then _selected ] [ str c.Name ])))
label [ _class (if isRequired then "jjj-required" else "jjj-label"); _for name ] [ txt "Continent" ]
]
/// Create a submit button with the given icon and text
let submitButton icon text =
button [ _type "submit"; _class "btn btn-primary" ] [ i [ _class $"mdi mdi-%s{icon}" ] []; txt $"&nbsp; %s{text}" ]
/// An empty paragraph
let emptyP =
p [] [ txt "&nbsp;" ]
/// Register JavaScript code to run in the DOMContentLoaded event on the page
let jsOnLoad js =
script [] [ txt """document.addEventListener("DOMContentLoaded", function () { """; txt js; txt " })" ]
/// Create a Markdown editor
let markdownEditor attrs name value editorLabel =
div [ _class "col-12"; _id $"{name}EditRow" ] [
nav [ _class "nav nav-pills pb-1" ] [
button [ _type "button"; _id $"{name}EditButton"; _class "btn btn-primary btn-sm rounded-pill" ] [
txt "Markdown"
]
rawText " &nbsp; "
button [ _type "button"; _id $"{name}PreviewButton"
_class "btn btn-outline-secondary btn-sm rounded-pill" ] [
txt "Preview"
]
]
section [ _id $"{name}Preview"; _class "jjj-not-shown jjj-markdown-preview px-2 pt-2"
_ariaLabel "Rendered Markdown preview" ] []
div [ _id $"{name}Edit"; _class "form-floating jjj-shown" ] [
textarea (List.append attrs
[ _id name; _name name; _class "form-control jjj-markdown-editor"; _rows "10" ]) [
txt value
]
label [ _for name ] [ txt editorLabel ]
]
jsOnLoad $"jjj.markdownOnLoad('{name}')"
]
/// Wrap content in a collapsing panel
let collapsePanel header content =
div [ _class "card" ] [
div [ _class "card-body" ] [
h6 [ _class "card-title" ] [
// TODO: toggle collapse
//a [ _href "#"; _class "{ 'cp-c': collapsed, 'cp-o': !collapsed }"; @click.prevent="toggle">{{headerText}} ]
txt header
]
yield! content
]
]
/// "Yes" or "No" based on a boolean value
let yesOrNo value =
if value then "Yes" else "No"
/// Markdown as a raw HTML text node
let md2html value =
(MarkdownString.toHtml >> txt) value
/// Display a citizen's contact information
let contactInfo citizen isPublic =
citizen.OtherContacts
|> List.filter (fun it -> (isPublic && it.IsPublic) || not isPublic)
|> List.collect (fun contact ->
match contact.ContactType with
| Website ->
[ i [ _class "mdi mdi-sm mdi-web" ] []; rawText " "
a [ _href contact.Value; _target "_blank"; _rel "noopener"; _class "me-4" ] [
str (defaultArg contact.Name "Website")
]
]
| Email ->
[ i [ _class "mdi mdi-sm mdi-email-outline" ] []; rawText " "
a [ _href $"mailto:{contact.Value}"; _class "me-4" ] [ str (defaultArg contact.Name "E-mail") ]
]
| Phone ->
[ span [ _class "me-4" ] [
i [ _class "mdi mdi-sm mdi-phone" ] []; rawText " "; str contact.Value
match contact.Name with Some name -> str $" ({name})" | None -> ()
]
])
open NodaTime
open NodaTime.Text
/// Generate a full date in the citizen's local time zone
let fullDate (value : Instant) tz =
(ZonedDateTimePattern.CreateWithCurrentCulture ("MMMM d, yyyy", DateTimeZoneProviders.Tzdb))
.Format(value.InZone DateTimeZoneProviders.Tzdb[tz])
/// Generate a full date/time in the citizen's local time
let fullDateTime (value : Instant) tz =
let dtPattern = ZonedDateTimePattern.CreateWithCurrentCulture ("MMMM d, yyyy h:mm", DateTimeZoneProviders.Tzdb)
let amPmPattern = ZonedDateTimePattern.CreateWithCurrentCulture ("tt", DateTimeZoneProviders.Tzdb)
let tzValue = value.InZone DateTimeZoneProviders.Tzdb[tz]
$"{dtPattern.Format(tzValue)}{amPmPattern.Format(tzValue).ToLowerInvariant()}"
/// Layout generation functions
[<RequireQualifiedAccess>]
module Layout =
open Giraffe.ViewEngine.Htmx
/// Data items needed to render a view
type PageRenderContext =
{ /// Whether a user is logged on
IsLoggedOn : bool
/// The current URL
CurrentUrl : string
/// The title of this page
PageTitle : string
/// The page content
Content : XmlNode
/// User messages to be displayed
Messages : string list
}
/// Append the application name to the page title
let private constructTitle ctx =
seq {
if ctx.PageTitle <> "" then
ctx.PageTitle; " | "
"Jobs, Jobs, Jobs"
}
|> Seq.reduce (+)
|> str
|> List.singleton
|> title []
/// Generate the HTML head tag
let private htmlHead ctx =
head [] [
meta [ _name "viewport"; _content "width=device-width, initial-scale=1" ]
constructTitle ctx
link [ _href "https://cdn.jsdelivr.net/npm/bootstrap@5.2.0/dist/css/bootstrap.min.css"
_rel "stylesheet"
_integrity "sha384-gH2yIJqKdNHPEq0n4Mqa/HGKIhSkIHeL5AyhkYV8i59U5AR6csBvApHHNl/vI1Bx"
_crossorigin "anonymous" ]
link [ _href "https://cdn.jsdelivr.net/npm/@mdi/font@6.9.96/css/materialdesignicons.min.css"
_rel "stylesheet" ]
link [ _href "/style.css"; _rel "stylesheet" ]
]
/// Display the links available to the current user
let private links ctx =
let navLink url icon text =
a [ _href url
_onclick "jjj.hideMenu()"
if url = ctx.CurrentUrl then _class "jjj-current-page"
] [ i [ _class $"mdi mdi-{icon}"; _ariaHidden "true" ] []; txt text ]
nav [ _class "jjj-nav" ] [
if ctx.IsLoggedOn then
navLink "/citizen/dashboard" "view-dashboard-variant" "Dashboard"
navLink "/help-wanted" "newspaper-variant-multiple-outline" "Help Wanted!"
navLink "/profile/search" "view-list-outline" "Employment Profiles"
navLink "/success-stories" "thumb-up" "Success Stories"
div [ _class "separator" ] []
navLink "/citizen/account" "account-edit" "My Account"
navLink "/listings/mine" "sign-text" "My Job Listings"
navLink "/profile/edit" "pencil" "My Employment Profile"
div [ _class "separator" ] []
navLink "/citizen/log-off" "logout-variant" "Log Off"
else
navLink "/" "home" "Home"
navLink "/profile/seeking" "view-list-outline" "Job Seekers"
navLink "/citizen/log-on" "login-variant" "Log On"
navLink "/how-it-works" "help-circle-outline" "How It Works"
]
/// Generate mobile and desktop side navigation areas
let private sideNavs ctx = [
div [ _id "mobileMenu"; _class "jjj-mobile-menu offcanvas offcanvas-end"; _tabindex "-1"
_ariaLabelledBy "mobileMenuLabel" ] [
div [ _class "offcanvas-header" ] [
h5 [ _id "mobileMenuLabel" ] [ txt "Menu" ]
button [
_class "btn-close text-reset"; _type "button"; _data "bs-dismiss" "offcanvas"; _ariaLabel "Close"
] []
]
div [ _class "offcanvas-body" ] [ links ctx ]
]
aside [ _class "jjj-full-menu d-none d-md-block p-3" ] [
p [ _class "home-link pb-3" ] [ a [ _href "/" ] [ txt "Jobs, Jobs, Jobs" ] ]
emptyP
links ctx
]
]
/// Title bars for mobile and desktop
let private titleBars = [
nav [ _class "d-flex d-md-none navbar navbar-dark" ] [
span [ _class "navbar-text" ] [ a [ _href "/" ] [ txt "Jobs, Jobs, Jobs" ] ]
button [ _class "btn"; _data "bs-toggle" "offcanvas"; _data "bs-target" "#mobileMenu"
_ariaControls "mobileMenu" ] [ i [ _class "mdi mdi-menu" ] [] ]
]
nav [ _class "d-none d-md-flex navbar navbar-light bg-light"] [
span [] [ txt "&nbsp;" ]
span [ _class "navbar-text" ] [
txt "(&hellip;and Jobs &ndash; "; audioClip "pelosi-jobs" (txt "Let&rsquo;s Vote for Jobs!"); txt ")"
]
]
]
/// The HTML footer for the page
let private htmlFoot =
let v = System.Reflection.Assembly.GetExecutingAssembly().GetName().Version
let version =
seq {
string v.Major
if v.Minor > 0 then
"."; string v.Minor
if v.Build > 0 then
"."; string v.Build
} |> Seq.reduce (+)
footer [] [
p [ _class "text-muted" ] [
txt $"Jobs, Jobs, Jobs v{version} &bull; "
a [ _href "/privacy-policy" ] [ txt "Privacy Policy" ]; txt " &bull; "
a [ _href "/terms-of-service" ] [ txt "Terms of Service" ]
]
]
/// Render any messages
let private messages ctx =
ctx.Messages
|> List.map (fun msg ->
let parts = msg.Split "|||"
let level = if parts[0] = "error" then "danger" else parts[0]
let message = parts[1]
div [ _class $"alert alert-{level} alert-dismissable fade show d-flex justify-content-between p-2 mb-1 mt-1"
_roleAlert ] [
p [ _class "mb-0" ] [
if level <> "success" then strong [] [ txt $"{parts[0].ToUpperInvariant ()}: " ]
txt message
]
button [ _type "button"; _class "btn-close"; _data "bs-dismiss" "alert"; _ariaLabel "Close" ] []
])
|> div [ _id "alerts" ]
/// Create a full view
let full ctx =
html [ _lang "en" ] [
htmlHead ctx
body [] [
div [ _class "jjj-app"; _hxBoost; _hxTarget "this" ] [
yield! sideNavs ctx
div [ _class "jjj-main" ] [
yield! titleBars
main [ _class "jjj-content container-fluid" ] [
messages ctx
ctx.Content
]
htmlFoot
]
]
Script.minified
script [ _async
_src "https://cdn.jsdelivr.net/npm/bootstrap@5.2.0/dist/js/bootstrap.bundle.min.js"
_integrity "sha384-A3rJD856KowSb7dwlZdYEkO39Gagi7vIsF0jrRAoQmDKKtQBHUuLZ9AsSv4jD4Xa"
_crossorigin "anonymous" ] []
script [ _src "/script.js" ] []
template [ _id "alertTemplate" ] [
div [ _class $"alert alert-dismissable fade show d-flex justify-content-between p-2 mb-1 mt-1"
_roleAlert ] [
p [ _class "mb-0" ] []
button [ _type "button"; _class "btn-close"; _data "bs-dismiss" "alert"; _ariaLabel "Close" ] []
]
]
]
]
/// Create a partial (boosted response) view
let partial ctx =
html [ _lang "en" ] [
head [] [
constructTitle ctx
]
body [] [
yield! sideNavs ctx
div [ _class "jjj-main" ] [
yield! titleBars
main [ _class "jjj-content container-fluid" ] [
messages ctx
ctx.Content
]
htmlFoot
]
]
]

159
src/JobsJobsJobs/Domain/Types.fs → src/JobsJobsJobs/Server/Domain.fs
View File

@ -1,7 +1,161 @@
namespace JobsJobsJobs.Domain namespace JobsJobsJobs.Domain
open NodaTime
open System open System
open Giraffe
open NodaTime
// ~~~ SUPPORT TYPES ~~~ //
/// The ID of a user (a citizen of Gitmo Nation)
type CitizenId = CitizenId of Guid
/// Support functions for citizen IDs
module CitizenId =
/// Create a new citizen ID
let create () = (Guid.NewGuid >> CitizenId) ()
/// A string representation of a citizen ID
let toString = function CitizenId it -> ShortGuid.fromGuid it
/// Parse a string into a citizen ID
let ofString = ShortGuid.toGuid >> CitizenId
/// Get the GUID value of a citizen ID
let value = function CitizenId guid -> guid
/// The ID of a continent
type ContinentId = ContinentId of Guid
/// Support functions for continent IDs
module ContinentId =
/// Create a new continent ID
let create () = (Guid.NewGuid >> ContinentId) ()
/// A string representation of a continent ID
let toString = function ContinentId it -> ShortGuid.fromGuid it
/// Parse a string into a continent ID
let ofString = ShortGuid.toGuid >> ContinentId
/// Get the GUID value of a continent ID
let value = function ContinentId guid -> guid
/// The ID of a job listing
type ListingId = ListingId of Guid
/// Support functions for listing IDs
module ListingId =
/// Create a new job listing ID
let create () = (Guid.NewGuid >> ListingId) ()
/// A string representation of a listing ID
let toString = function ListingId it -> ShortGuid.fromGuid it
/// Parse a string into a listing ID
let ofString = ShortGuid.toGuid >> ListingId
/// Get the GUID value of a listing ID
let value = function ListingId guid -> guid
/// A string of Markdown text
type MarkdownString = Text of string
/// Support functions for Markdown strings
module MarkdownString =
open Markdig
/// The Markdown conversion pipeline (enables all advanced features)
let private pipeline = MarkdownPipelineBuilder().UseAdvancedExtensions().Build ()
/// Convert this Markdown string to HTML
let toHtml = function Text text -> Markdown.ToHtml (text, pipeline)
/// Convert a Markdown string to its string representation
let toString = function Text text -> text
/// Types of contacts supported by Jobs, Jobs, Jobs
type ContactType =
/// E-mail addresses
| Email
/// Phone numbers (home, work, cell, etc.)
| Phone
/// Websites (personal, social, etc.)
| Website
/// Functions to support contact types
module ContactType =
/// Parse a contact type from a string
let parse typ =
match typ with
| "Email" -> Email
| "Phone" -> Phone
| "Website" -> Website
| it -> invalidOp $"{it} is not a valid contact type"
/// Convert a contact type to its string representation
let toString =
function
| Email -> "Email"
| Phone -> "Phone"
| Website -> "Website"
/// Another way to contact a citizen from this site
[<NoComparison; NoEquality>]
type OtherContact =
{ /// The type of contact
ContactType : ContactType
/// The name of the contact (Email, No Agenda Social, LinkedIn, etc.)
Name : string option
/// The value for the contact (e-mail address, user name, URL, etc.)
Value : string
/// Whether this contact is visible in public employment profiles and job listings
IsPublic : bool
}
/// A skill the job seeker possesses
[<NoComparison; NoEquality>]
type Skill =
{ /// A description of the skill
Description : string
/// Notes regarding this skill (level, duration, etc.)
Notes : string option
}
/// The ID of a success report
type SuccessId = SuccessId of Guid
/// Support functions for success report IDs
module SuccessId =
/// Create a new success report ID
let create () = (Guid.NewGuid >> SuccessId) ()
/// A string representation of a success report ID
let toString = function SuccessId it -> ShortGuid.fromGuid it
/// Parse a string into a success report ID
let ofString = ShortGuid.toGuid >> SuccessId
/// Get the GUID value of a success ID
let value = function SuccessId guid -> guid
// ~~~ DOCUMENT TYPES ~~~ //
/// A user of Jobs, Jobs, Jobs; a citizen of Gitmo Nation /// A user of Jobs, Jobs, Jobs; a citizen of Gitmo Nation
[<NoComparison; NoEquality>] [<NoComparison; NoEquality>]
@ -144,6 +298,7 @@ module Listing =
/// Security settings for a user /// Security settings for a user
[<NoComparison; NoEquality>]
type SecurityInfo = type SecurityInfo =
{ /// The ID of the citizen to whom these settings apply { /// The ID of the citizen to whom these settings apply
Id : CitizenId Id : CitizenId

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

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

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

@ -1,937 +0,0 @@
/// Route handlers for Giraffe endpoints
module JobsJobsJobs.Server.Handlers
open Giraffe
open Giraffe.Htmx
open JobsJobsJobs.Domain
open JobsJobsJobs.Domain.SharedTypes
open JobsJobsJobs.Views
open Microsoft.AspNetCore.Http
open Microsoft.Extensions.Logging
[<AutoOpen>]
module private HtmxHelpers =
/// Is the request from htmx?
let isHtmx (ctx : HttpContext) =
ctx.Request.IsHtmx && not ctx.Request.IsHtmxRefresh
/// Handlers for error conditions
module Error =
open System.Net
/// Handler that will return a status code 404 and the text "Not Found"
let notFound : HttpHandler = fun next ctx ->
let fac = ctx.GetService<ILoggerFactory> ()
let log = fac.CreateLogger "Handler"
let path = string ctx.Request.Path
log.LogInformation "Returning 404"
RequestErrors.NOT_FOUND $"The URL {path} was not recognized as a valid URL" next ctx
/// 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 = $"/citizen/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) =
log.LogError(ex, "An unexpected error occurred")
clearResponse >=> ServerErrors.INTERNAL_ERROR ex.Message
open System
open NodaTime
/// Helper functions
[<AutoOpen>]
module Helpers =
open System.Security.Claims
open System.Text.Json
open System.Text.RegularExpressions
open Microsoft.AspNetCore.Antiforgery
open Microsoft.Extensions.Configuration
open Microsoft.Extensions.DependencyInjection
/// Get the NodaTime clock from the request context
let now (ctx : HttpContext) = ctx.GetService<IClock>().GetCurrentInstant ()
/// Get the application configuration from the request context
let config (ctx : HttpContext) = ctx.GetService<IConfiguration> ()
/// Get the logger factory from the request context
let logger (ctx : HttpContext) = ctx.GetService<ILoggerFactory> ()
/// `None` if a `string option` is `None`, whitespace, or empty
let noneIfBlank (s : string option) =
s |> Option.map (fun x -> match x.Trim () with "" -> None | _ -> Some x) |> Option.flatten
/// `None` if a `string` is null, empty, or whitespace; otherwise, `Some` and the trimmed string
let noneIfEmpty = Option.ofObj >> noneIfBlank
/// Try to get the current user
let tryUser (ctx : HttpContext) =
ctx.User.FindFirst ClaimTypes.NameIdentifier
|> Option.ofObj
|> Option.map (fun x -> x.Value)
/// Require a user to be logged in
let authorize : HttpHandler =
fun next ctx -> match tryUser ctx with Some _ -> next ctx | None -> Error.notAuthorized next ctx
/// Get the ID of the currently logged in citizen
// NOTE: if no one is logged in, this will raise an exception
let currentCitizenId = tryUser >> Option.get >> CitizenId.ofString
/// Return an empty OK response
let ok : HttpHandler = Successful.OK ""
// -- NEW --
let antiForgery (ctx : HttpContext) =
ctx.RequestServices.GetRequiredService<IAntiforgery> ()
/// Obtain an anti-forgery token set
let csrf ctx =
(antiForgery ctx).GetAndStoreTokens ctx
/// Get the time zone from the citizen's browser
let timeZone (ctx : HttpContext) =
let tz = string ctx.Request.Headers["X-Time-Zone"]
defaultArg (noneIfEmpty tz) "Etc/UTC"
/// 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 popMessages 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 addMessage (level : string) (msg : string) ctx = task {
do! loadSession ctx
let! msgs = popMessages 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 addError msg ctx = task {
do! addMessage "error" msg ctx
}
/// Add a list of errors to the response
let addErrors (errors : string list) ctx = task {
let errMsg = String.Join ("</li><li>", errors)
do! addError $"Please correct the following errors:<ul><li>{errMsg}</li></ul>" ctx
}
/// Render a page-level view
let render pageTitle (_ : HttpFunc) (ctx : HttpContext) content = task {
let! messages = popMessages ctx
let renderCtx : Layout.PageRenderContext = {
IsLoggedOn = Option.isSome (tryUser ctx)
CurrentUrl = ctx.Request.Path.Value
PageTitle = pageTitle
Content = content
Messages = messages
}
let renderFunc = if isHtmx ctx then Layout.partial else Layout.full
return! ctx.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
| true -> return! next 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
/// Regular expression to validate that a URL is a local URL
let isLocal = Regex """^/[^\/\\].*"""
/// Redirect to another page, saving the session before redirecting
let redirectToGet (url : string) next ctx = task {
do! saveSession ctx
let action =
if Option.isSome (noneIfEmpty url) && isLocal.IsMatch url then
if isHtmx ctx then withHxRedirect url else redirectTo false url
else RequestErrors.BAD_REQUEST "Invalid redirect URL"
return! action next ctx
}
open JobsJobsJobs.Data
open JobsJobsJobs.ViewModels
/// Handlers for /api routes
[<RequireQualifiedAccess>]
module Api =
open System.IO
// POST: /api/markdown-preview
let markdownPreview : HttpHandler = requireUser >=> fun next ctx -> task {
let _ = ctx.Request.Body.Seek(0L, SeekOrigin.Begin)
use reader = new StreamReader (ctx.Request.Body)
let! preview = reader.ReadToEndAsync ()
return! htmlString (MarkdownString.toHtml (Text preview)) next ctx
}
/// Handlers for /citizen routes
[<RequireQualifiedAccess>]
module Citizen =
open Microsoft.AspNetCore.Authentication
open Microsoft.AspNetCore.Authentication.Cookies
open System.Security.Claims
/// Support module for /citizen routes
module private Support =
/// The challenge questions and answers from the configuration
let mutable private challenges : (string * string)[] option = None
/// The challenge questions and answers
let questions ctx =
match challenges with
| Some it -> it
| None ->
let qs = (config ctx).GetSection "ChallengeQuestions"
let qAndA =
seq {
for idx in 0..4 do
let section = qs.GetSection(string idx)
yield section["Question"], (section["Answer"].ToLowerInvariant ())
}
|> Array.ofSeq
challenges <- Some qAndA
qAndA
// GET: /citizen/account
let account : HttpHandler = fun next ctx -> task {
match! Citizens.findById (currentCitizenId ctx) with
| Some citizen ->
return!
Citizen.account (AccountProfileForm.fromCitizen citizen) (csrf ctx) |> render "Account Profile" next ctx
| None -> return! Error.notFound next ctx
}
// GET: /citizen/cancel-reset/[token]
let cancelReset token : HttpHandler = fun next ctx -> task {
let! wasCanceled = task {
match! Citizens.trySecurityByToken token with
| Some security ->
do! Citizens.saveSecurityInfo { security with Token = None; TokenUsage = None; TokenExpires = None }
return true
| None -> return false
}
return! Citizen.resetCanceled wasCanceled |> render "Password Reset Cancellation" next ctx
}
// GET: /citizen/confirm/[token]
let confirm token : HttpHandler = fun next ctx -> task {
let! isConfirmed = Citizens.confirmAccount token
return! Citizen.confirmAccount isConfirmed |> render "Account Confirmation" next ctx
}
// GET: /citizen/dashboard
let dashboard : HttpHandler = requireUser >=> fun next ctx -> task {
let citizenId = currentCitizenId ctx
let! citizen = Citizens.findById citizenId
let! profile = Profiles.findById citizenId
let! prfCount = Profiles.count ()
return! Citizen.dashboard citizen.Value profile prfCount (timeZone ctx) |> render "Dashboard" next ctx
}
// POST: /citizen/delete
let delete : HttpHandler = requireUser >=> validateCsrf >=> fun next ctx -> task {
do! Citizens.deleteById (currentCitizenId ctx)
do! ctx.SignOutAsync ()
return! render "Account Deleted Successfully" next ctx Citizen.deleted
}
// GET: /citizen/deny/[token]
let deny token : HttpHandler = fun next ctx -> task {
let! wasDeleted = Citizens.denyAccount token
return! Citizen.denyAccount wasDeleted |> render "Account Deletion" next ctx
}
// GET: /citizen/forgot-password
let forgotPassword : HttpHandler = fun next ctx ->
Citizen.forgotPassword (csrf ctx) |> render "Forgot Password" next ctx
// POST: /citizen/forgot-password
let doForgotPassword : HttpHandler = validateCsrf >=> fun next ctx -> task {
let! form = ctx.BindFormAsync<ForgotPasswordForm> ()
match! Citizens.tryByEmailWithSecurity form.Email with
| Some (citizen, security) ->
let withToken =
{ security with
Token = Some (Auth.createToken citizen)
TokenUsage = Some "reset"
TokenExpires = Some (now ctx + (Duration.FromDays 3))
}
do! Citizens.saveSecurityInfo withToken
let! emailResponse = Email.sendPasswordReset citizen withToken
let logFac = logger ctx
let log = logFac.CreateLogger "JobsJobsJobs.Handlers.Citizen"
log.LogInformation $"Password reset e-mail for {citizen.Email} received {emailResponse}"
| None -> ()
// TODO: send link if it matches an account
return! Citizen.forgotPasswordSent form |> render "Reset Request Processed" next ctx
}
// GET: /citizen/log-off
let logOff : HttpHandler = 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 ->
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
let doLogOn = validateCsrf >=> fun next ctx -> task {
let! form = ctx.BindFormAsync<LogOnViewModel> ()
match! Citizens.tryLogOn form.Email form.Password Auth.Passwords.verify Auth.Passwords.hash (now ctx) with
| Ok citizen ->
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 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
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 {
let! form = ctx.BindFormAsync<RegisterViewModel> ()
let qAndA = Support.questions ctx
let mutable badForm = false
let errors = [
if form.FirstName.Length < 1 then "First name is required"
if form.LastName.Length < 1 then "Last name is required"
if form.Email.Length < 1 then "E-mail address is required"
if form.Password.Length < 8 then "Password is too short"
if form.Question1Index < 0 || form.Question1Index > 4
|| form.Question2Index < 0 || form.Question2Index > 4
|| form.Question1Index = form.Question2Index then
badForm <- true
else if (snd qAndA[form.Question1Index]) <> (form.Question1Answer.Trim().ToLowerInvariant ())
|| (snd qAndA[form.Question2Index]) <> (form.Question2Answer.Trim().ToLowerInvariant ()) then
"Question answers are incorrect"
]
let refreshPage () =
Citizen.register (fst qAndA[form.Question1Index]) (fst qAndA[form.Question2Index])
{ form with Password = "" } (csrf ctx) |> renderHandler "Register"
if badForm then
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 =
{ Citizen.empty with
Id = CitizenId.create ()
Email = form.Email
FirstName = form.FirstName
LastName = form.LastName
DisplayName = noneIfBlank form.DisplayName
JoinedOn = now
LastSeenOn = now
}
let citizen = { noPass with PasswordHash = Auth.Passwords.hash noPass form.Password }
let security =
{ SecurityInfo.empty with
Id = citizen.Id
AccountLocked = true
Token = Some (Auth.createToken citizen)
TokenUsage = Some "confirm"
TokenExpires = Some (now + (Duration.FromDays 3))
}
let! success = Citizens.register citizen security
if success then
let! emailResponse = Email.sendAccountConfirmation citizen security
let logFac = logger ctx
let log = logFac.CreateLogger "JobsJobsJobs.Handlers.Citizen"
log.LogInformation $"Confirmation e-mail for {citizen.Email} received {emailResponse}"
return! Citizen.registered |> render "Registration Successful" next ctx
else
do! addError "There is already an account registered to the e-mail address provided" ctx
return! refreshPage () next ctx
else
do! addErrors errors ctx
return! refreshPage () next ctx
}
// GET: /citizen/reset-password/[token]
let resetPassword token : HttpHandler = fun next ctx -> task {
match! Citizens.trySecurityByToken token with
| Some security ->
return!
Citizen.resetPassword { Id = CitizenId.toString security.Id; Token = token; Password = "" } (csrf ctx)
|> render "Reset Password" next ctx
| None -> return! Error.notFound next ctx
}
// POST: /citizen/reset-password
let doResetPassword : HttpHandler = validateCsrf >=> fun next ctx -> task {
let! form = ctx.BindFormAsync<ResetPasswordForm> ()
let errors = [
if form.Id = "" then "Request invalid; please return to the link in your e-mail and try again"
if form.Token = "" then "Request invalid; please return to the link in your e-mail and try again"
if form.Password.Length < 8 then "Password too short"
]
if List.isEmpty errors then
match! Citizens.trySecurityByToken form.Token with
| Some security when security.Id = CitizenId.ofString form.Id ->
match! Citizens.findById security.Id with
| Some citizen ->
do! Citizens.saveSecurityInfo { security with Token = None; TokenUsage = None; TokenExpires = None }
do! Citizens.save { citizen with PasswordHash = Auth.Passwords.hash citizen form.Password }
do! addSuccess "Password reset successfully; you may log on with your new credentials" ctx
return! redirectToGet "/citizen/log-on" next ctx
| None -> return! Error.notFound next ctx
| Some _
| None -> return! Error.notFound next ctx
else
do! addErrors errors ctx
return! Citizen.resetPassword form (csrf ctx) |> render "Reset Password" next ctx
}
// POST: /citizen/save-account
let saveAccount : HttpHandler = requireUser >=> validateCsrf >=> fun next ctx -> task {
let! theForm = ctx.BindFormAsync<AccountProfileForm> ()
let form = { theForm with Contacts = theForm.Contacts |> Array.filter (box >> isNull >> not) }
let errors = [
if form.FirstName = "" then "First Name is required"
if form.LastName = "" then "Last Name is required"
if form.NewPassword <> form.NewPassword then "New passwords do not match"
if form.Contacts |> Array.exists (fun c -> c.ContactType = "") then "All Contact Types are required"
if form.Contacts |> Array.exists (fun c -> c.Value = "") then "All Contacts are required"
]
if List.isEmpty errors then
match! Citizens.findById (currentCitizenId ctx) with
| Some citizen ->
let password =
if form.NewPassword = "" then citizen.PasswordHash
else Auth.Passwords.hash citizen form.NewPassword
do! Citizens.save
{ citizen with
FirstName = form.FirstName
LastName = form.LastName
DisplayName = noneIfEmpty form.DisplayName
PasswordHash = password
OtherContacts = form.Contacts
|> Array.map (fun c ->
{ OtherContact.Name = noneIfEmpty c.Name
ContactType = ContactType.parse c.ContactType
Value = c.Value
IsPublic = c.IsPublic
})
|> List.ofArray
}
let extraMsg = if form.NewPassword = "" then "" else " and password changed"
do! addSuccess $"Account profile updated{extraMsg} successfully" ctx
return! redirectToGet "/citizen/account" next ctx
| None -> return! Error.notFound next ctx
else
do! addErrors errors ctx
return! Citizen.account form (csrf ctx) |> render "Account Profile" next ctx
}
// GET: /citizen/so-long
let soLong : HttpHandler = requireUser >=> fun next ctx ->
Citizen.deletionOptions (csrf ctx) |> render "Account Deletion Options" next ctx
/// Handlers for the home page, legal stuff, and help
[<RequireQualifiedAccess>]
module Home =
// GET: /
let home =
renderHandler "Welcome" Home.home
// GET: /how-it-works
let howItWorks : HttpHandler =
renderHandler "How It Works" Home.howItWorks
// GET: /privacy-policy
let privacyPolicy : HttpHandler =
renderHandler "Privacy Policy" Home.privacyPolicy
// GET: /terms-of-service
let termsOfService : HttpHandler =
renderHandler "Terms of Service" Home.termsOfService
/// Handlers for /listing[s] routes (and /help-wanted)
[<RequireQualifiedAccess>]
module Listing =
/// Parse the string we receive from JSON into a NodaTime local date
let private parseDate = DateTime.Parse >> LocalDate.FromDateTime
// GET: /listing/[id]/edit
let edit listId : HttpHandler = requireUser >=> fun next ctx -> task {
let citizenId = currentCitizenId ctx
let! theListing = task {
match listId with
| "new" -> return Some { Listing.empty with CitizenId = citizenId }
| _ -> return! Listings.findById (ListingId.ofString listId)
}
match theListing with
| Some listing when listing.CitizenId = citizenId ->
let! continents = Continents.all ()
return!
Listing.edit (EditListingForm.fromListing listing listId) continents (listId = "new") (csrf ctx)
|> render $"""{if listId = "new" then "Add a" else "Edit"} Job Listing""" next ctx
| Some _ -> return! Error.notAuthorized next ctx
| None -> return! Error.notFound next ctx
}
// GET: /listing/[id]/expire
let expire listingId : HttpHandler = requireUser >=> fun next ctx -> task {
match! Listings.findById (ListingId listingId) with
| Some listing when listing.CitizenId = currentCitizenId ctx ->
if listing.IsExpired then
do! addError $"The listing &ldquo;{listing.Title}&rdquo; is already expired" ctx
return! redirectToGet "/listings/mine" next ctx
else
let form = { Id = ListingId.toString listing.Id; FromHere = false; SuccessStory = "" }
return! Listing.expire form listing (csrf ctx) |> render "Expire Job Listing" next ctx
| Some _ -> return! Error.notAuthorized next ctx
| None -> return! Error.notFound next ctx
}
// POST: /listing/expire
let doExpire : HttpHandler = requireUser >=> validateCsrf >=> fun next ctx -> task {
let citizenId = currentCitizenId ctx
let now = now ctx
let! form = ctx.BindFormAsync<ExpireListingForm> ()
match! Listings.findById (ListingId.ofString form.Id) with
| Some listing when listing.CitizenId = citizenId ->
if listing.IsExpired then
return! RequestErrors.BAD_REQUEST "Request is already expired" next ctx
else
do! Listings.save
{ listing with
IsExpired = true
WasFilledHere = Some form.FromHere
UpdatedOn = now
}
if form.SuccessStory <> "" then
do! Successes.save
{ Id = SuccessId.create()
CitizenId = citizenId
RecordedOn = now
IsFromHere = form.FromHere
Source = "listing"
Story = (Text >> Some) form.SuccessStory
}
let extraMsg = if form.SuccessStory <> "" then " and success story recorded" else ""
do! addSuccess $"Job listing expired{extraMsg} successfully" ctx
return! redirectToGet "/listings/mine" next ctx
| Some _ -> return! Error.notAuthorized next ctx
| None -> return! Error.notFound next ctx
}
// GET: /listings/mine
let mine : HttpHandler = requireUser >=> fun next ctx -> task {
let! listings = Listings.findByCitizen (currentCitizenId ctx)
return! Listing.mine listings (timeZone ctx) |> render "My Job Listings" next ctx
}
// POST: /listing/save
let save : HttpHandler = requireUser >=> validateCsrf >=> fun next ctx -> task {
let citizenId = currentCitizenId ctx
let now = now ctx
let! form = ctx.BindFormAsync<EditListingForm> ()
let! theListing = task {
match form.Id with
| "new" ->
return Some
{ Listing.empty with
Id = ListingId.create ()
CitizenId = currentCitizenId ctx
CreatedOn = now
IsExpired = false
WasFilledHere = None
IsLegacy = false
}
| _ -> return! Listings.findById (ListingId.ofString form.Id)
}
match theListing with
| Some listing when listing.CitizenId = citizenId ->
do! Listings.save
{ listing with
Title = form.Title
ContinentId = ContinentId.ofString form.ContinentId
Region = form.Region
IsRemote = form.RemoteWork
Text = Text form.Text
NeededBy = noneIfEmpty form.NeededBy |> Option.map parseDate
UpdatedOn = now
}
do! addSuccess $"""Job listing {if form.Id = "new" then "add" else "updat"}ed successfully""" ctx
return! redirectToGet $"/listing/{ListingId.toString listing.Id}/edit" next ctx
| Some _ -> return! Error.notAuthorized next ctx
| None -> return! Error.notFound next ctx
}
// GET: /help-wanted
let search : HttpHandler = requireUser >=> fun next ctx -> task {
let! continents = Continents.all ()
let form =
match ctx.TryBindQueryString<ListingSearchForm> () with
| Ok f -> f
| Error _ -> { ContinentId = ""; Region = ""; RemoteWork = ""; Text = "" }
let! results = task {
if string ctx.Request.Query["searched"] = "true" then
let! it = Listings.search form
return Some it
else return None
}
return! Listing.search form continents results |> render "Help Wanted" next ctx
}
// GET: /listing/[id]/view
let view listingId : HttpHandler = requireUser >=> fun next ctx -> task {
match! Listings.findByIdForView (ListingId listingId) with
| Some listing -> return! Listing.view listing |> render $"{listing.Listing.Title} | Job Listing" next ctx
| None -> return! Error.notFound next ctx
}
/// Handlers for /profile routes
[<RequireQualifiedAccess>]
module Profile =
// POST: /profile/delete
let delete : HttpHandler = requireUser >=> validateCsrf >=> fun next ctx -> task {
do! Profiles.deleteById (currentCitizenId ctx)
do! addSuccess "Profile deleted successfully" ctx
return! redirectToGet "/citizen/dashboard" next ctx
}
// GET: /profile/edit
let edit : HttpHandler = requireUser >=> fun next ctx -> task {
let citizenId = currentCitizenId ctx
let! profile = Profiles.findById citizenId
let! continents = Continents.all ()
let isNew = Option.isNone profile
let form = if isNew then EditProfileViewModel.empty else EditProfileViewModel.fromProfile profile.Value
let title = $"""{if isNew then "Create" else "Edit"} Profile"""
return! Profile.edit form continents isNew citizenId (csrf ctx) |> render title next ctx
}
// POST: /profile/save
let save : HttpHandler = requireUser >=> fun next ctx -> task {
let citizenId = currentCitizenId ctx
let! theForm = ctx.BindFormAsync<EditProfileViewModel> ()
let form = { theForm with Skills = theForm.Skills |> Array.filter (box >> isNull >> not) }
let errors = [
if form.ContinentId = "" then "Continent is required"
if form.Region = "" then "Region is required"
if form.Biography = "" then "Professional Biography is required"
if form.Skills |> Array.exists (fun s -> s.Description = "") then "All skill Descriptions are required"
]
let! profile = task {
match! Profiles.findById citizenId with
| Some p -> return p
| None -> return { Profile.empty with Id = citizenId }
}
let isNew = profile.Region = ""
if List.isEmpty errors then
do! Profiles.save
{ profile with
IsSeekingEmployment = form.IsSeekingEmployment
ContinentId = ContinentId.ofString form.ContinentId
Region = form.Region
IsRemote = form.RemoteWork
IsFullTime = form.FullTime
Biography = Text form.Biography
LastUpdatedOn = now ctx
Skills = form.Skills
|> Array.filter (fun s -> (box >> isNull >> not) s)
|> Array.map SkillForm.toSkill
|> List.ofArray
Experience = noneIfBlank form.Experience |> Option.map Text
IsPubliclySearchable = form.IsPubliclySearchable
IsPubliclyLinkable = form.IsPubliclyLinkable
}
let action = if isNew then "cre" else "upd"
do! addSuccess $"Employment Profile {action}ated successfully" ctx
return! redirectToGet "/profile/edit" next ctx
else
do! addErrors errors ctx
let! continents = Continents.all ()
return!
Profile.edit form continents isNew citizenId (csrf ctx)
|> render $"""{if isNew then "Create" else "Edit"} Profile""" next ctx
}
// GET: /profile/search
let search : HttpHandler = requireUser >=> fun next ctx -> task {
let! continents = Continents.all ()
let form =
match ctx.TryBindQueryString<ProfileSearchForm> () with
| Ok f -> f
| Error _ -> { ContinentId = ""; RemoteWork = ""; Skill = ""; BioExperience = "" }
let! results = task {
if string ctx.Request.Query["searched"] = "true" then
let! it = Profiles.search form
return Some it
else return None
}
return! Profile.search form continents (timeZone ctx) results |> render "Profile Search" next ctx
}
// GET: /profile/seeking
let seeking : HttpHandler = fun next ctx -> task {
let! continents = Continents.all ()
let form =
match ctx.TryBindQueryString<PublicSearchForm> () with
| Ok f -> f
| Error _ -> { ContinentId = ""; Region = ""; RemoteWork = ""; Skill = "" }
let! results = task {
if string ctx.Request.Query["searched"] = "true" then
let! it = Profiles.publicSearch form
return Some it
else return None
}
return! Profile.publicSearch form continents results |> render "Profile Search" next ctx
}
// GET: /profile/[id]/view
let view citizenId : HttpHandler = fun next ctx -> task {
let citId = CitizenId citizenId
match! Citizens.findById citId with
| Some citizen ->
match! Profiles.findById citId with
| Some profile ->
let currentCitizen = tryUser ctx |> Option.map CitizenId.ofString
if not profile.IsPubliclyLinkable && Option.isNone currentCitizen then
return! Error.notAuthorized next ctx
else
let! continent = Continents.findById profile.ContinentId
let continentName = match continent with Some c -> c.Name | None -> "not found"
let title = $"Employment Profile for {Citizen.name citizen}"
return! Profile.view citizen profile continentName currentCitizen |> render title next ctx
| None -> return! Error.notFound next ctx
| None -> return! Error.notFound next ctx
}
/// Handlers for /success-stor[y|ies] routes
[<RequireQualifiedAccess>]
module Success =
// GET: /success-story/[id]/edit
let edit successId : HttpHandler = requireUser >=> fun next ctx -> task {
let citizenId = currentCitizenId ctx
let isNew = successId = "new"
let! theSuccess = task {
if isNew then return Some { Success.empty with CitizenId = citizenId }
else return! Successes.findById (SuccessId.ofString successId)
}
match theSuccess with
| Some success when success.CitizenId = citizenId ->
let pgTitle = $"""{if isNew then "Tell Your" else "Edit"} Success Story"""
return!
Success.edit (EditSuccessForm.fromSuccess success) (success.Id = SuccessId Guid.Empty) pgTitle
(csrf ctx)
|> render pgTitle next ctx
| Some _ -> return! Error.notAuthorized next ctx
| None -> return! Error.notFound next ctx
}
// GET: /success-stories
let list : HttpHandler = requireUser >=> fun next ctx -> task {
let! stories = Successes.all ()
return! Success.list stories (currentCitizenId ctx) (timeZone ctx) |> render "Success Stories" next ctx
}
// GET: /success-story/[id]/view
let view successId : HttpHandler = requireUser >=> fun next ctx -> task {
match! Successes.findById (SuccessId successId) with
| Some success ->
match! Citizens.findById success.CitizenId with
| Some citizen ->
return! Success.view success (Citizen.name citizen) (timeZone ctx) |> render "Success Story" next ctx
| None -> return! Error.notFound next ctx
| None -> return! Error.notFound next ctx
}
// POST: /success-story/save
let save : HttpHandler = requireUser >=> validateCsrf >=> fun next ctx -> task {
let citizenId = currentCitizenId ctx
let! form = ctx.BindFormAsync<EditSuccessForm> ()
let isNew = form.Id = ShortGuid.fromGuid Guid.Empty
let! theSuccess = task {
if isNew then
return Some
{ Success.empty with
Id = SuccessId.create ()
CitizenId = citizenId
RecordedOn = now ctx
Source = "profile"
}
else return! Successes.findById (SuccessId.ofString form.Id)
}
match theSuccess with
| Some story when story.CitizenId = citizenId ->
do! Successes.save
{ story with IsFromHere = form.FromHere; Story = noneIfEmpty form.Story |> Option.map Text }
if isNew then
match! Profiles.findById citizenId with
| Some profile -> do! Profiles.save { profile with IsSeekingEmployment = false }
| None -> ()
let extraMsg = if isNew then " and seeking employment flag cleared" else ""
do! addSuccess $"Success story saved{extraMsg} successfully" ctx
return! redirectToGet "/success-stories" next ctx
| Some _ -> return! Error.notAuthorized next ctx
| None -> return! Error.notFound next ctx
}
open Giraffe.EndpointRouting
/// All available endpoints for the application
let allEndpoints = [
GET_HEAD [
route "/" Home.home
route "/help-wanted" Listing.search
route "/how-it-works" Home.howItWorks
route "/privacy-policy" Home.privacyPolicy
route "/terms-of-service" Home.termsOfService
]
subRoute "/citizen" [
GET_HEAD [
route "/account" Citizen.account
routef "/cancel-reset/%s" Citizen.cancelReset
routef "/confirm/%s" Citizen.confirm
route "/dashboard" Citizen.dashboard
routef "/deny/%s" Citizen.deny
route "/forgot-password" Citizen.forgotPassword
route "/log-off" Citizen.logOff
route "/log-on" Citizen.logOn
route "/register" Citizen.register
routef "/reset-password/%s" Citizen.resetPassword
route "/so-long" Citizen.soLong
]
POST [
route "/delete" Citizen.delete
route "/forgot-password" Citizen.doForgotPassword
route "/log-on" Citizen.doLogOn
route "/register" Citizen.doRegistration
route "/reset-password" Citizen.doResetPassword
route "/save-account" Citizen.saveAccount
]
]
subRoute "/listing" [
GET_HEAD [
route "s/mine" Listing.mine
routef "/%s/edit" Listing.edit
routef "/%O/expire" Listing.expire
routef "/%O/view" Listing.view
]
POST [
route "/expire" Listing.doExpire
route "/save" Listing.save
]
]
subRoute "/profile" [
GET_HEAD [
routef "/%O/view" Profile.view
route "/edit" Profile.edit
route "/search" Profile.search
route "/seeking" Profile.seeking
]
POST [
route "/delete" Profile.delete
route "/save" Profile.save
]
]
subRoute "/success-stor" [
GET_HEAD [
route "ies" Success.list
routef "y/%s/edit" Success.edit
routef "y/%O/view" Success.view
]
POST [ route "y/save" Success.save ]
]
subRoute "/api" [
POST [ route "/markdown-preview" Api.markdownPreview ]
]
]

33
src/JobsJobsJobs/Server/Home/Handlers.fs Normal file
View File

@ -0,0 +1,33 @@
/// Handlers for the home page, legal stuff, and help
module JobsJobsJobs.Home.Handlers
open Giraffe
open JobsJobsJobs.Common.Handlers
// GET: /
let home : HttpHandler =
renderHandler "Welcome" Views.home
// GET: /how-it-works
let howItWorks : HttpHandler =
renderHandler "How It Works" Views.howItWorks
// GET: /privacy-policy
let privacyPolicy : HttpHandler =
renderHandler "Privacy Policy" Views.privacyPolicy
// GET: /terms-of-service
let termsOfService : HttpHandler =
renderHandler "Terms of Service" Views.termsOfService
open Giraffe.EndpointRouting
/// All endpoints for this feature
let endpoints =
GET_HEAD [
route "/" home
route "/how-it-works" howItWorks
route "/privacy-policy" privacyPolicy
route "/terms-of-service" termsOfService
]

3
src/JobsJobsJobs/Server/Views/Home.fs → src/JobsJobsJobs/Server/Home/Views.fs
View File

@ -1,6 +1,7 @@
module JobsJobsJobs.Views.Home module JobsJobsJobs.Home.Views
open Giraffe.ViewEngine open Giraffe.ViewEngine
open JobsJobsJobs.Common.Views
/// The home page /// The home page
let home = let home =

48
src/JobsJobsJobs/Server/JobsJobsJobs.Server.fsproj
View File

@ -8,39 +8,51 @@
</PropertyGroup> </PropertyGroup>
<ItemGroup> <ItemGroup>
<Compile Include="Auth.fs" /> <Compile Include="Domain.fs" />
<Compile Include="Email.fs" /> <Compile Include="Email.fs" />
<Compile Include="ViewModels.fs" /> <Compile Include="Common\Json.fs" />
<Compile Include="Views\Common.fs" /> <Compile Include="Common\Data.fs" />
<Compile Include="Views\Layout.fs" /> <Compile Include="Common\Views.fs" />
<Compile Include="Views\Citizen.fs" /> <Compile Include="Common\Handlers.fs" />
<Compile Include="Views\Home.fs" /> <Compile Include="Profiles\Domain.fs" />
<Compile Include="Views\Listing.fs" /> <Compile Include="Profiles\Data.fs" />
<Compile Include="Views\Profile.fs" /> <Compile Include="Profiles\Views.fs" />
<Compile Include="Views\Success.fs" /> <Compile Include="Profiles\Handlers.fs" />
<Compile Include="Handlers.fs" /> <Compile Include="Citizens\Domain.fs" />
<Compile Include="Citizens\Data.fs" />
<Compile Include="Citizens\Views.fs" />
<Compile Include="Citizens\Handlers.fs" />
<Compile Include="SuccessStories\Domain.fs" />
<Compile Include="SuccessStories\Data.fs" />
<Compile Include="SuccessStories\Views.fs" />
<Compile Include="SuccessStories\Handlers.fs" />
<Compile Include="Listings\Domain.fs" />
<Compile Include="Listings\Data.fs" />
<Compile Include="Listings\Views.fs" />
<Compile Include="Listings\Handlers.fs" />
<Compile Include="Home\Views.fs" />
<Compile Include="Home\Handlers.fs" />
<Compile Include="ApiHandlers.fs" />
<Compile Include="Cache.fs" />
<Compile Include="App.fs" /> <Compile Include="App.fs" />
</ItemGroup> </ItemGroup>
<ItemGroup>
<ProjectReference Include="..\Data\JobsJobsJobs.Data.fsproj" />
<ProjectReference Include="..\Domain\JobsJobsJobs.Domain.fsproj" />
</ItemGroup>
<ItemGroup> <ItemGroup>
<Folder Include=".\wwwroot" /> <Folder Include=".\wwwroot" />
</ItemGroup> </ItemGroup>
<ItemGroup> <ItemGroup>
<PackageReference Include="FSharp.SystemTextJson" Version="1.0.7" />
<PackageReference Include="Giraffe" Version="6.0.0" /> <PackageReference Include="Giraffe" Version="6.0.0" />
<PackageReference Include="Giraffe.Htmx" Version="1.8.5" /> <PackageReference Include="Giraffe.Htmx" Version="1.8.5" />
<PackageReference Include="Giraffe.ViewEngine" Version="1.4.0" /> <PackageReference Include="Giraffe.ViewEngine" Version="1.4.0" />
<PackageReference Include="Giraffe.ViewEngine.Htmx" Version="1.8.5" /> <PackageReference Include="Giraffe.ViewEngine.Htmx" Version="1.8.5" />
<PackageReference Include="MailKit" Version="3.3.0" /> <PackageReference Include="MailKit" Version="3.3.0" />
<PackageReference Include="Microsoft.AspNetCore.Authentication.JwtBearer" Version="7.0.0" /> <PackageReference Include="Markdig" Version="0.30.4" />
<PackageReference Include="Microsoft.FSharpLu.Json" Version="0.11.7" />
<PackageReference Include="NodaTime.Serialization.JsonNet" Version="3.0.0" /> <PackageReference Include="NodaTime.Serialization.JsonNet" Version="3.0.0" />
<PackageReference Include="System.IdentityModel.Tokens.Jwt" Version="6.22.0" /> <PackageReference Include="NodaTime.Serialization.SystemTextJson" Version="1.0.0" />
<PackageReference Include="Npgsql.FSharp" Version="5.6.0" />
<PackageReference Include="Npgsql.NodaTime" Version="7.0.1" />
</ItemGroup> </ItemGroup>
</Project> </Project>

69
src/JobsJobsJobs/Server/Listings/Data.fs Normal file
View File

@ -0,0 +1,69 @@
module JobsJobsJobs.Listings.Data
open JobsJobsJobs.Common.Data
open JobsJobsJobs.Domain
open JobsJobsJobs.Listings.Domain
open Npgsql.FSharp
/// The SQL to select a listing view
let viewSql =
$"SELECT l.*, c.data ->> 'name' AS continent_name, u.data AS cit_data
FROM {Table.Listing} l
INNER JOIN {Table.Continent} c ON c.id = l.data ->> 'continentId'
INNER JOIN {Table.Citizen} u ON u.id = l.data ->> 'citizenId'"
/// Map a result for a listing view
let private toListingForView row =
{ Listing = toDocument<Listing> row
ContinentName = row.string "continent_name"
Citizen = toDocumentFrom<Citizen> "cit_data" row
}
/// Find all job listings posted by the given citizen
let findByCitizen citizenId =
dataSource ()
|> Sql.query $"{viewSql} WHERE l.data ->> 'citizenId' = @citizenId AND l.data ->> 'isLegacy' = 'false'"
|> Sql.parameters [ "@citizenId", Sql.string (CitizenId.toString citizenId) ]
|> Sql.executeAsync toListingForView
/// Find a listing by its ID
let findById listingId = backgroundTask {
match! dataSource () |> getDocument<Listing> Table.Listing (ListingId.toString listingId) with
| Some listing when not listing.IsLegacy -> return Some listing
| Some _
| None -> return None
}
/// Find a listing by its ID for viewing (includes continent information)
let findByIdForView listingId = backgroundTask {
let! tryListing =
dataSource ()
|> Sql.query $"{viewSql} WHERE l.id = @id AND l.data ->> 'isLegacy' = 'false'"
|> Sql.parameters [ "@id", Sql.string (ListingId.toString listingId) ]
|> Sql.executeAsync toListingForView
return List.tryHead tryListing
}
/// Save a listing
let save (listing : Listing) =
dataSource () |> saveDocument Table.Listing (ListingId.toString listing.Id) <| mkDoc listing
/// Search job listings
let search (search : ListingSearchForm) =
let searches = [
if search.ContinentId <> "" then
"l.data ->> 'continentId' = @continentId", [ "@continentId", Sql.string search.ContinentId ]
if search.Region <> "" then
"l.data ->> 'region' ILIKE @region", [ "@region", like search.Region ]
if search.RemoteWork <> "" then
"l.data ->> 'isRemote' = @remote", [ "@remote", jsonBool (search.RemoteWork = "yes") ]
if search.Text <> "" then
"l.data ->> 'text' ILIKE @text", [ "@text", like search.Text ]
]
dataSource ()
|> Sql.query $"
{viewSql}
WHERE l.data ->> 'isExpired' = 'false' AND l.data ->> 'isLegacy' = 'false'
{searchSql searches}"
|> Sql.parameters (searches |> List.collect snd)
|> Sql.executeAsync toListingForView

94
src/JobsJobsJobs/Server/Listings/Domain.fs Normal file
View File

@ -0,0 +1,94 @@
module JobsJobsJobs.Listings.Domain
open JobsJobsJobs.Domain
/// The data required to add or edit a job listing
[<CLIMutable; NoComparison; NoEquality>]
type EditListingForm =
{ /// The ID of the listing
Id : string
/// The listing title
Title : string
/// The ID of the continent on which this opportunity exists
ContinentId : string
/// The region in which this opportunity exists
Region : string
/// Whether this is a remote work opportunity
RemoteWork : bool
/// The text of the job listing
Text : string
/// The date by which this job listing is needed
NeededBy : string
}
/// Support functions to support listings
module EditListingForm =
open NodaTime.Text
/// Create a listing form from an existing listing
let fromListing (listing : Listing) theId =
let neededBy =
match listing.NeededBy with
| Some dt -> (LocalDatePattern.CreateWithCurrentCulture "yyyy-MM-dd").Format dt
| None -> ""
{ Id = theId
Title = listing.Title
ContinentId = ContinentId.toString listing.ContinentId
Region = listing.Region
RemoteWork = listing.IsRemote
Text = MarkdownString.toString listing.Text
NeededBy = neededBy
}
/// The form submitted to expire a listing
[<CLIMutable; NoComparison; NoEquality>]
type ExpireListingForm =
{ /// The ID of the listing to expire
Id : string
/// Whether the job was filled from here
FromHere : bool
/// The success story written by the user
SuccessStory : string
}
/// The data needed to display a listing
[<NoComparison; NoEquality>]
type ListingForView =
{ /// The listing itself
Listing : Listing
/// The name of the continent for the listing
ContinentName : string
/// The citizen who owns the listing
Citizen : Citizen
}
/// The various ways job listings can be searched
[<CLIMutable; NoComparison; NoEquality>]
type ListingSearchForm =
{ /// Retrieve job listings for this continent
ContinentId : string
/// Text for a search within a region
Region : string
/// Whether to retrieve job listings for remote work
RemoteWork : string
/// Text for a search with the job listing description
Text : string
}

163
src/JobsJobsJobs/Server/Listings/Handlers.fs Normal file
View File

@ -0,0 +1,163 @@
module JobsJobsJobs.Listings.Handlers
open System
open Giraffe
open JobsJobsJobs
open JobsJobsJobs.Common.Handlers
open JobsJobsJobs.Domain
open JobsJobsJobs.Listings.Domain
open NodaTime
/// Parse the string we receive from JSON into a NodaTime local date
let private parseDate = DateTime.Parse >> LocalDate.FromDateTime
// GET: /listing/[id]/edit
let edit listId : HttpHandler = requireUser >=> fun next ctx -> task {
let citizenId = currentCitizenId ctx
let! theListing = task {
match listId with
| "new" -> return Some { Listing.empty with CitizenId = citizenId }
| _ -> return! Data.findById (ListingId.ofString listId)
}
match theListing with
| Some listing when listing.CitizenId = citizenId ->
let! continents = Common.Data.Continents.all ()
return!
Views.edit (EditListingForm.fromListing listing listId) continents (listId = "new") (csrf ctx)
|> render $"""{if listId = "new" then "Add a" else "Edit"} Job Listing""" next ctx
| Some _ -> return! Error.notAuthorized next ctx
| None -> return! Error.notFound next ctx
}
// GET: /listing/[id]/expire
let expire listingId : HttpHandler = requireUser >=> fun next ctx -> task {
match! Data.findById (ListingId listingId) with
| Some listing when listing.CitizenId = currentCitizenId ctx ->
if listing.IsExpired then
do! addError $"The listing &ldquo;{listing.Title}&rdquo; is already expired" ctx
return! redirectToGet "/listings/mine" next ctx
else
let form = { Id = ListingId.toString listing.Id; FromHere = false; SuccessStory = "" }
return! Views.expire form listing (csrf ctx) |> render "Expire Job Listing" next ctx
| Some _ -> return! Error.notAuthorized next ctx
| None -> return! Error.notFound next ctx
}
// POST: /listing/expire
let doExpire : HttpHandler = requireUser >=> validateCsrf >=> fun next ctx -> task {
let citizenId = currentCitizenId ctx
let now = now ctx
let! form = ctx.BindFormAsync<ExpireListingForm> ()
match! Data.findById (ListingId.ofString form.Id) with
| Some listing when listing.CitizenId = citizenId ->
if listing.IsExpired then
return! RequestErrors.BAD_REQUEST "Request is already expired" next ctx
else
do! Data.save
{ listing with
IsExpired = true
WasFilledHere = Some form.FromHere
UpdatedOn = now
}
if form.SuccessStory <> "" then
do! SuccessStories.Data.save
{ Id = SuccessId.create()
CitizenId = citizenId
RecordedOn = now
IsFromHere = form.FromHere
Source = "listing"
Story = (Text >> Some) form.SuccessStory
}
let extraMsg = if form.SuccessStory <> "" then " and success story recorded" else ""
do! addSuccess $"Job listing expired{extraMsg} successfully" ctx
return! redirectToGet "/listings/mine" next ctx
| Some _ -> return! Error.notAuthorized next ctx
| None -> return! Error.notFound next ctx
}
// GET: /listings/mine
let mine : HttpHandler = requireUser >=> fun next ctx -> task {
let! listings = Data.findByCitizen (currentCitizenId ctx)
return! Views.mine listings (timeZone ctx) |> render "My Job Listings" next ctx
}
// POST: /listing/save
let save : HttpHandler = requireUser >=> validateCsrf >=> fun next ctx -> task {
let citizenId = currentCitizenId ctx
let now = now ctx
let! form = ctx.BindFormAsync<EditListingForm> ()
let! theListing = task {
match form.Id with
| "new" ->
return Some
{ Listing.empty with
Id = ListingId.create ()
CitizenId = currentCitizenId ctx
CreatedOn = now
IsExpired = false
WasFilledHere = None
IsLegacy = false
}
| _ -> return! Data.findById (ListingId.ofString form.Id)
}
match theListing with
| Some listing when listing.CitizenId = citizenId ->
do! Data.save
{ listing with
Title = form.Title
ContinentId = ContinentId.ofString form.ContinentId
Region = form.Region
IsRemote = form.RemoteWork
Text = Text form.Text
NeededBy = noneIfEmpty form.NeededBy |> Option.map parseDate
UpdatedOn = now
}
do! addSuccess $"""Job listing {if form.Id = "new" then "add" else "updat"}ed successfully""" ctx
return! redirectToGet $"/listing/{ListingId.toString listing.Id}/edit" next ctx
| Some _ -> return! Error.notAuthorized next ctx
| None -> return! Error.notFound next ctx
}
// GET: /help-wanted
let search : HttpHandler = requireUser >=> fun next ctx -> task {
let! continents = Common.Data.Continents.all ()
let form =
match ctx.TryBindQueryString<ListingSearchForm> () with
| Ok f -> f
| Error _ -> { ContinentId = ""; Region = ""; RemoteWork = ""; Text = "" }
let! results = task {
if string ctx.Request.Query["searched"] = "true" then
let! it = Data.search form
return Some it
else return None
}
return! Views.search form continents results |> render "Help Wanted" next ctx
}
// GET: /listing/[id]/view
let view listingId : HttpHandler = requireUser >=> fun next ctx -> task {
match! Data.findByIdForView (ListingId listingId) with
| Some listing -> return! Views.view listing |> render $"{listing.Listing.Title} | Job Listing" next ctx
| None -> return! Error.notFound next ctx
}
open Giraffe.EndpointRouting
/// All endpoints for this feature
let endpoints = [
GET_HEAD [ route "/help-wanted" search ]
subRoute "/listing" [
GET_HEAD [
route "s/mine" mine
routef "/%s/edit" edit
routef "/%O/expire" expire
routef "/%O/view" view
]
POST [
route "/expire" doExpire
route "/save" save
]
]
]

7
src/JobsJobsJobs/Server/Views/Listing.fs → src/JobsJobsJobs/Server/Listings/Views.fs
View File

@ -1,11 +1,10 @@
/// Views for /profile URLs /// Views for /profile URLs
[<RequireQualifiedAccess>] module JobsJobsJobs.Listings.Views
module JobsJobsJobs.Views.Listing
open Giraffe.ViewEngine open Giraffe.ViewEngine
open JobsJobsJobs.Common.Views
open JobsJobsJobs.Domain open JobsJobsJobs.Domain
open JobsJobsJobs.Domain.SharedTypes open JobsJobsJobs.Listings.Domain
open JobsJobsJobs.ViewModels
/// Job listing edit page /// Job listing edit page

128
src/JobsJobsJobs/Server/Profiles/Data.fs Normal file
View File

@ -0,0 +1,128 @@
module JobsJobsJobs.Profiles.Data
open JobsJobsJobs.Common.Data
open JobsJobsJobs.Domain
open JobsJobsJobs.Profiles.Domain
open Npgsql.FSharp
/// Count the current profiles
let count () =
dataSource ()
|> Sql.query $"SELECT COUNT(id) AS the_count FROM {Table.Profile} WHERE data ->> 'isLegacy' = 'false'"
|> Sql.executeRowAsync (fun row -> row.int64 "the_count")
/// Delete a profile by its ID
let deleteById citizenId = backgroundTask {
let! _ =
dataSource ()
|> Sql.query $"DELETE FROM {Table.Profile} WHERE id = @id"
|> Sql.parameters [ "@id", Sql.string (CitizenId.toString citizenId) ]
|> Sql.executeNonQueryAsync
()
}
/// Find a profile by citizen ID
let findById citizenId = backgroundTask {
match! dataSource () |> getDocument<Profile> Table.Profile (CitizenId.toString citizenId) with
| Some profile when not profile.IsLegacy -> return Some profile
| Some _
| None -> return None
}
/// Find a profile by citizen ID for viewing (includes citizen and continent information)
let findByIdForView citizenId = backgroundTask {
let! tryCitizen =
dataSource ()
|> Sql.query $"
SELECT p.*, c.data AS cit_data, o.data AS cont_data
FROM {Table.Profile} p
INNER JOIN {Table.Citizen} c ON c.id = p.id
INNER JOIN {Table.Continent} o ON o.id = p.data ->> 'continentId'
WHERE p.id = @id
AND p.data ->> 'isLegacy' = 'false'"
|> Sql.parameters [ "@id", Sql.string (CitizenId.toString citizenId) ]
|> Sql.executeAsync (fun row ->
{ Profile = toDocument<Profile> row
Citizen = toDocumentFrom<Citizen> "cit_data" row
Continent = toDocumentFrom<Continent> "cont_data" row
})
return List.tryHead tryCitizen
}
/// Save a profile
let save (profile : Profile) =
dataSource () |> saveDocument Table.Profile (CitizenId.toString profile.Id) <| mkDoc profile
/// Search profiles (logged-on users)
let search (search : ProfileSearchForm) = backgroundTask {
let searches = [
if search.ContinentId <> "" then
"p.data ->> 'continentId' = @continentId", [ "@continentId", Sql.string search.ContinentId ]
if search.RemoteWork <> "" then
"p.data ->> 'isRemote' = @remote", [ "@remote", jsonBool (search.RemoteWork = "yes") ]
if search.Skill <> "" then
"EXISTS (
SELECT 1 FROM jsonb_array_elements(p.data['skills']) x(elt)
WHERE x ->> 'description' ILIKE @description)",
[ "@description", like search.Skill ]
if search.BioExperience <> "" then
"(p.data ->> 'biography' ILIKE @text OR p.data ->> 'experience' ILIKE @text)",
[ "@text", like search.BioExperience ]
]
let! results =
dataSource ()
|> Sql.query $"
SELECT p.*, c.data AS cit_data
FROM {Table.Profile} p
INNER JOIN {Table.Citizen} c ON c.id = p.id
WHERE p.data ->> 'isLegacy' = 'false'
{searchSql searches}"
|> Sql.parameters (searches |> List.collect snd)
|> Sql.executeAsync (fun row ->
let profile = toDocument<Profile> row
let citizen = toDocumentFrom<Citizen> "cit_data" row
{ CitizenId = profile.Id
DisplayName = Citizen.name citizen
SeekingEmployment = profile.IsSeekingEmployment
RemoteWork = profile.IsRemote
FullTime = profile.IsFullTime
LastUpdatedOn = profile.LastUpdatedOn
})
return results |> List.sortBy (fun psr -> psr.DisplayName.ToLowerInvariant ())
}
// Search profiles (public)
let publicSearch (search : PublicSearchForm) =
let searches = [
if search.ContinentId <> "" then
"p.data ->> 'continentId' = @continentId", [ "@continentId", Sql.string search.ContinentId ]
if search.Region <> "" then
"p.data ->> 'region' ILIKE @region", [ "@region", like search.Region ]
if search.RemoteWork <> "" then
"p.data ->> 'isRemote' = @remote", [ "@remote", jsonBool (search.RemoteWork = "yes") ]
if search.Skill <> "" then
"EXISTS (
SELECT 1 FROM jsonb_array_elements(p.data['skills']) x(elt)
WHERE x ->> 'description' ILIKE @description)",
[ "@description", like search.Skill ]
]
dataSource ()
|> Sql.query $"
SELECT p.*, c.data AS cont_data
FROM {Table.Profile} p
INNER JOIN {Table.Continent} c ON c.id = p.data ->> 'continentId'
WHERE p.data ->> 'isPubliclySearchable' = 'true'
AND p.data ->> 'isLegacy' = 'false'
{searchSql searches}"
|> Sql.parameters (searches |> List.collect snd)
|> Sql.executeAsync (fun row ->
let profile = toDocument<Profile> row
let continent = toDocumentFrom<Continent> "cont_data" row
{ Continent = continent.Name
Region = profile.Region
RemoteWork = profile.IsRemote
Skills = profile.Skills
|> List.map (fun s ->
let notes = match s.Notes with Some n -> $" ({n})" | None -> ""
$"{s.Description}{notes}")
})

178
src/JobsJobsJobs/Server/Profiles/Domain.fs Normal file
View File

@ -0,0 +1,178 @@
module JobsJobsJobs.Profiles.Domain
open JobsJobsJobs.Domain
open NodaTime
/// The fields required for a skill
[<CLIMutable; NoComparison; NoEquality>]
type SkillForm =
{ Description : string
/// Notes regarding the skill
Notes : string
}
/// Functions to support skill forms
module SkillForm =
/// Create a skill form from a skill
let fromSkill (skill : Skill) =
{ SkillForm.Description = skill.Description; Notes = defaultArg skill.Notes "" }
/// Create a skill from a skill form
let toSkill (form : SkillForm) =
{ Skill.Description = form.Description; Notes = if form.Notes = "" then None else Some form.Notes }
/// The data required to update a profile
[<CLIMutable; NoComparison; NoEquality>]
type EditProfileForm =
{ /// Whether the citizen to whom this profile belongs is actively seeking employment
IsSeekingEmployment : bool
/// The ID of the continent on which the citizen is located
ContinentId : string
/// The area within that continent where the citizen is located
Region : string
/// If the citizen is available for remote work
RemoteWork : bool
/// If the citizen is seeking full-time employment
FullTime : bool
/// The user's professional biography
Biography : string
/// The skills for the user
Skills : SkillForm array
/// The user's past experience
Experience : string option
/// Whether this profile should appear in the public search
IsPubliclySearchable : bool
/// Whether this profile should be shown publicly
IsPubliclyLinkable : bool
}
/// Support functions for the ProfileForm type
module EditProfileForm =
/// An empty view model (used for new profiles)
let empty =
{ IsSeekingEmployment = false
ContinentId = ""
Region = ""
RemoteWork = false
FullTime = false
Biography = ""
Skills = [||]
Experience = None
IsPubliclySearchable = false
IsPubliclyLinkable = false
}
/// Create an instance of this form from the given profile
let fromProfile (profile : Profile) =
{ IsSeekingEmployment = profile.IsSeekingEmployment
ContinentId = ContinentId.toString profile.ContinentId
Region = profile.Region
RemoteWork = profile.IsRemote
FullTime = profile.IsFullTime
Biography = MarkdownString.toString profile.Biography
Skills = profile.Skills |> List.map SkillForm.fromSkill |> Array.ofList
Experience = profile.Experience |> Option.map MarkdownString.toString
IsPubliclySearchable = profile.IsPubliclySearchable
IsPubliclyLinkable = profile.IsPubliclyLinkable
}
/// The various ways profiles can be searched
[<CLIMutable; NoComparison; NoEquality>]
type ProfileSearchForm =
{ /// Retrieve citizens from this continent
ContinentId : string
/// Text for a search within a citizen's skills
Skill : string
/// Text for a search with a citizen's professional biography and experience fields
BioExperience : string
/// Whether to retrieve citizens who do or do not want remote work
RemoteWork : string
}
/// A user matching the profile search
[<NoComparison; NoEquality>]
type ProfileSearchResult =
{ /// The ID of the citizen
CitizenId : CitizenId
/// The citizen's display name
DisplayName : string
/// Whether this citizen is currently seeking employment
SeekingEmployment : bool
/// Whether this citizen is looking for remote work
RemoteWork : bool
/// Whether this citizen is looking for full-time work
FullTime : bool
/// When this profile was last updated
LastUpdatedOn : Instant
}
/// The data required to show a viewable profile
type ProfileForView =
{ /// The profile itself
Profile : Profile
/// The citizen to whom the profile belongs
Citizen : Citizen
/// The continent for the profile
Continent : Continent
}
/// The parameters for a public job search
[<CLIMutable; NoComparison; NoEquality>]
type PublicSearchForm =
{ /// Retrieve citizens from this continent
ContinentId : string
/// Retrieve citizens from this region
Region : string
/// Text for a search within a citizen's skills
Skill : string
/// Whether to retrieve citizens who do or do not want remote work
RemoteWork : string
}
/// A public profile search result
[<NoComparison; NoEquality>]
type PublicSearchResult =
{ /// The name of the continent on which the citizen resides
Continent : string
/// The region in which the citizen resides
Region : string
/// Whether this citizen is seeking remote work
RemoteWork : bool
/// The skills this citizen has identified
Skills : string list
}

135
src/JobsJobsJobs/Server/Profiles/Handlers.fs Normal file
View File

@ -0,0 +1,135 @@
module JobsJobsJobs.Profiles.Handlers
open Giraffe
open JobsJobsJobs
open JobsJobsJobs.Common.Handlers
open JobsJobsJobs.Domain
open JobsJobsJobs.Profiles.Domain
// POST: /profile/delete
let delete : HttpHandler = requireUser >=> validateCsrf >=> fun next ctx -> task {
do! Data.deleteById (currentCitizenId ctx)
do! addSuccess "Profile deleted successfully" ctx
return! redirectToGet "/citizen/dashboard" next ctx
}
// GET: /profile/edit
let edit : HttpHandler = requireUser >=> fun next ctx -> task {
let citizenId = currentCitizenId ctx
let! profile = Data.findById citizenId
let! continents = Common.Data.Continents.all ()
let isNew = Option.isNone profile
let form = if isNew then EditProfileForm.empty else EditProfileForm.fromProfile profile.Value
let title = $"""{if isNew then "Create" else "Edit"} Profile"""
return! Views.edit form continents isNew citizenId (csrf ctx) |> render title next ctx
}
// POST: /profile/save
let save : HttpHandler = requireUser >=> fun next ctx -> task {
let citizenId = currentCitizenId ctx
let! theForm = ctx.BindFormAsync<EditProfileForm> ()
let form = { theForm with Skills = theForm.Skills |> Array.filter (box >> isNull >> not) }
let errors = [
if form.ContinentId = "" then "Continent is required"
if form.Region = "" then "Region is required"
if form.Biography = "" then "Professional Biography is required"
if form.Skills |> Array.exists (fun s -> s.Description = "") then "All skill Descriptions are required"
]
let! profile = task {
match! Data.findById citizenId with
| Some p -> return p
| None -> return { Profile.empty with Id = citizenId }
}
let isNew = profile.Region = ""
if List.isEmpty errors then
do! Data.save
{ profile with
IsSeekingEmployment = form.IsSeekingEmployment
ContinentId = ContinentId.ofString form.ContinentId
Region = form.Region
IsRemote = form.RemoteWork
IsFullTime = form.FullTime
Biography = Text form.Biography
LastUpdatedOn = now ctx
Skills = form.Skills
|> Array.filter (fun s -> (box >> isNull >> not) s)
|> Array.map SkillForm.toSkill
|> List.ofArray
Experience = noneIfBlank form.Experience |> Option.map Text
IsPubliclySearchable = form.IsPubliclySearchable
IsPubliclyLinkable = form.IsPubliclyLinkable
}
let action = if isNew then "cre" else "upd"
do! addSuccess $"Employment Profile {action}ated successfully" ctx
return! redirectToGet "/profile/edit" next ctx
else
do! addErrors errors ctx
let! continents = Common.Data.Continents.all ()
return!
Views.edit form continents isNew citizenId (csrf ctx)
|> render $"""{if isNew then "Create" else "Edit"} Profile""" next ctx
}
// GET: /profile/search
let search : HttpHandler = requireUser >=> fun next ctx -> task {
let! continents = Common.Data.Continents.all ()
let form =
match ctx.TryBindQueryString<ProfileSearchForm> () with
| Ok f -> f
| Error _ -> { ContinentId = ""; RemoteWork = ""; Skill = ""; BioExperience = "" }
let! results = task {
if string ctx.Request.Query["searched"] = "true" then
let! it = Data.search form
return Some it
else return None
}
return! Views.search form continents (timeZone ctx) results |> render "Profile Search" next ctx
}
// GET: /profile/seeking
let seeking : HttpHandler = fun next ctx -> task {
let! continents = Common.Data.Continents.all ()
let form =
match ctx.TryBindQueryString<PublicSearchForm> () with
| Ok f -> f
| Error _ -> { ContinentId = ""; Region = ""; RemoteWork = ""; Skill = "" }
let! results = task {
if string ctx.Request.Query["searched"] = "true" then
let! it = Data.publicSearch form
return Some it
else return None
}
return! Views.publicSearch form continents results |> render "Profile Search" next ctx
}
// GET: /profile/[id]/view
let view citizenId : HttpHandler = fun next ctx -> task {
let citId = CitizenId citizenId
match! Data.findByIdForView citId with
| Some profile ->
let currentCitizen = tryUser ctx |> Option.map CitizenId.ofString
if not profile.Profile.IsPubliclyLinkable && Option.isNone currentCitizen then
return! Error.notAuthorized next ctx
else
let title = $"Employment Profile for {Citizen.name profile.Citizen}"
return! Views.view profile currentCitizen |> render title next ctx
| None -> return! Error.notFound next ctx
}
open Giraffe.EndpointRouting
/// All endpoints for this feature
let endpoints =
subRoute "/profile" [
GET_HEAD [
routef "/%O/view" view
route "/edit" edit
route "/search" search
route "/seeking" seeking
]
POST [
route "/delete" delete
route "/save" save
]
]

33
src/JobsJobsJobs/Server/Views/Profile.fs → src/JobsJobsJobs/Server/Profiles/Views.fs
View File

@ -1,12 +1,11 @@
/// Views for /profile URLs /// Views for /profile URLs
[<RequireQualifiedAccess>] module JobsJobsJobs.Profiles.Views
module JobsJobsJobs.Views.Profile
open Giraffe.ViewEngine open Giraffe.ViewEngine
open Giraffe.ViewEngine.Htmx open Giraffe.ViewEngine.Htmx
open JobsJobsJobs.Common.Views
open JobsJobsJobs.Domain open JobsJobsJobs.Domain
open JobsJobsJobs.Domain.SharedTypes open JobsJobsJobs.Profiles.Domain
open JobsJobsJobs.ViewModels
/// Render the skill edit template and existing skills /// Render the skill edit template and existing skills
let skillEdit (skills : SkillForm array) = let skillEdit (skills : SkillForm array) =
@ -39,7 +38,7 @@ let skillEdit (skills : SkillForm array) =
:: (skills |> Array.mapi mapToInputs |> List.ofArray) :: (skills |> Array.mapi mapToInputs |> List.ofArray)
/// The profile edit page /// The profile edit page
let edit (m : EditProfileViewModel) continents isNew citizenId csrf = let edit (m : EditProfileForm) continents isNew citizenId csrf =
pageWithTitle "My Employment Profile" [ pageWithTitle "My Employment Profile" [
form [ _class "row g-3"; _action "/profile/save"; _hxPost "/profile/save" ] [ form [ _class "row g-3"; _action "/profile/save"; _hxPost "/profile/save" ] [
antiForgery csrf antiForgery csrf
@ -276,38 +275,38 @@ let search (m : ProfileSearchForm) continents tz (results : ProfileSearchResult
/// Profile view template /// Profile view template
let view (citizen : Citizen) (profile : Profile) (continentName : string) currentId = let view (it : ProfileForView) currentId =
article [] [ article [] [
h2 [] [ h2 [] [
str (Citizen.name citizen) str (Citizen.name it.Citizen)
if profile.IsSeekingEmployment then if it.Profile.IsSeekingEmployment then
span [ _class "jjj-heading-label" ] [ span [ _class "jjj-heading-label" ] [
txt "&nbsp; &nbsp;"; span [ _class "badge bg-dark" ] [ txt "Currently Seeking Employment" ] txt "&nbsp; &nbsp;"; span [ _class "badge bg-dark" ] [ txt "Currently Seeking Employment" ]
] ]
] ]
h4 [] [ str $"{continentName}, {profile.Region}" ] h4 [] [ str $"{it.Continent.Name}, {it.Profile.Region}" ]
contactInfo citizen (Option.isNone currentId) contactInfo it.Citizen (Option.isNone currentId)
|> div [ _class "pb-3" ] |> div [ _class "pb-3" ]
p [] [ p [] [
txt (if profile.IsFullTime then "I" else "Not i"); txt "nterested in full-time employment &bull; " txt (if it.Profile.IsFullTime then "I" else "Not i"); txt "nterested in full-time employment &bull; "
txt (if profile.IsRemote then "I" else "Not i"); txt "nterested in remote opportunities" txt (if it.Profile.IsRemote then "I" else "Not i"); txt "nterested in remote opportunities"
] ]
hr [] hr []
div [] [ md2html profile.Biography ] div [] [ md2html it.Profile.Biography ]
if not (List.isEmpty profile.Skills) then if not (List.isEmpty it.Profile.Skills) then
hr [] hr []
h4 [ _class "pb-3" ] [ txt "Skills" ] h4 [ _class "pb-3" ] [ txt "Skills" ]
profile.Skills it.Profile.Skills
|> List.map (fun skill -> |> List.map (fun skill ->
li [] [ li [] [
str skill.Description str skill.Description
match skill.Notes with Some notes -> txt " &nbsp;("; str notes; txt ")" | None -> () match skill.Notes with Some notes -> txt " &nbsp;("; str notes; txt ")" | None -> ()
]) ])
|> ul [] |> ul []
match profile.Experience with match it.Profile.Experience with
| Some exp -> hr []; h4 [ _class "pb-3" ] [ txt "Experience / Employment History" ]; div [] [ md2html exp ] | Some exp -> hr []; h4 [ _class "pb-3" ] [ txt "Experience / Employment History" ]; div [] [ md2html exp ]
| None -> () | None -> ()
if Option.isSome currentId && currentId.Value = citizen.Id then if Option.isSome currentId && currentId.Value = it.Citizen.Id then
br []; br [] br []; br []
a [ _href "/profile/edit"; _class "btn btn-primary" ] [ a [ _href "/profile/edit"; _class "btn btn-primary" ] [
i [ _class "mdi mdi-pencil" ] []; txt "&nbsp; Edit Your Profile" i [ _class "mdi mdi-pencil" ] []; txt "&nbsp; Edit Your Profile"

33
src/JobsJobsJobs/Server/SuccessStories/Data.fs Normal file
View File

@ -0,0 +1,33 @@
module JobsJobsJobs.SuccessStories.Data
open JobsJobsJobs.Common.Data
open JobsJobsJobs.Domain
open JobsJobsJobs.SuccessStories.Domain
open Npgsql.FSharp
// Retrieve all success stories
let all () =
dataSource ()
|> Sql.query $"
SELECT s.*, c.data AS cit_data
FROM {Table.Success} s
INNER JOIN {Table.Citizen} c ON c.id = s.data ->> 'citizenId'
ORDER BY s.data ->> 'recordedOn' DESC"
|> Sql.executeAsync (fun row ->
let success = toDocument<Success> row
let citizen = toDocumentFrom<Citizen> "cit_data" row
{ Id = success.Id
CitizenId = success.CitizenId
CitizenName = Citizen.name citizen
RecordedOn = success.RecordedOn
FromHere = success.IsFromHere
HasStory = Option.isSome success.Story
})
/// Find a success story by its ID
let findById successId =
dataSource () |> getDocument<Success> Table.Success (SuccessId.toString successId)
/// Save a success story
let save (success : Success) =
dataSource () |> saveDocument Table.Success (SuccessId.toString success.Id) <| mkDoc success

50
src/JobsJobsJobs/Server/SuccessStories/Domain.fs Normal file
View File

@ -0,0 +1,50 @@
module JobsJobsJobs.SuccessStories.Domain
open JobsJobsJobs.Domain
open NodaTime
/// The data required to provide a success story
[<CLIMutable; NoComparison; NoEquality>]
type EditSuccessForm =
{ /// The ID of this success story
Id : string
/// Whether the employment was obtained from Jobs, Jobs, Jobs
FromHere : bool
/// The success story
Story : string
}
/// Support functions for success edit forms
module EditSuccessForm =
/// Create an edit form from a success story
let fromSuccess (success : Success) =
{ Id = SuccessId.toString success.Id
FromHere = success.IsFromHere
Story = success.Story |> Option.map MarkdownString.toString |> Option.defaultValue ""
}
/// An entry in the list of success stories
[<NoComparison; NoEquality>]
type StoryEntry =
{ /// The ID of this success story
Id : SuccessId
/// The ID of the citizen who recorded this story
CitizenId : CitizenId
/// The name of the citizen who recorded this story
CitizenName : string
/// When this story was recorded
RecordedOn : Instant
/// Whether this story involves an opportunity that arose due to Jobs, Jobs, Jobs
FromHere : bool
/// Whether this report has a further story, or if it is simply a "found work" entry
HasStory : bool
}

88
src/JobsJobsJobs/Server/SuccessStories/Handlers.fs Normal file
View File

@ -0,0 +1,88 @@
module JobsJobsJobs.SuccessStories.Handlers
open System
open Giraffe
open JobsJobsJobs
open JobsJobsJobs.Common.Handlers
open JobsJobsJobs.Domain
open JobsJobsJobs.SuccessStories.Domain
// GET: /success-story/[id]/edit
let edit successId : HttpHandler = requireUser >=> fun next ctx -> task {
let citizenId = currentCitizenId ctx
let isNew = successId = "new"
let! theSuccess = task {
if isNew then return Some { Success.empty with CitizenId = citizenId }
else return! Data.findById (SuccessId.ofString successId)
}
match theSuccess with
| Some success when success.CitizenId = citizenId ->
let pgTitle = $"""{if isNew then "Tell Your" else "Edit"} Success Story"""
return!
Views.edit (EditSuccessForm.fromSuccess success) (success.Id = SuccessId Guid.Empty) pgTitle (csrf ctx)
|> render pgTitle next ctx
| Some _ -> return! Error.notAuthorized next ctx
| None -> return! Error.notFound next ctx
}
// GET: /success-stories
let list : HttpHandler = requireUser >=> fun next ctx -> task {
let! stories = Data.all ()
return! Views.list stories (currentCitizenId ctx) (timeZone ctx) |> render "Success Stories" next ctx
}
// GET: /success-story/[id]/view
let view successId : HttpHandler = requireUser >=> fun next ctx -> task {
// FIXME: make this get both in one query
match! Data.findById (SuccessId successId) with
| Some success ->
match! Citizens.Data.findById success.CitizenId with
| Some citizen ->
return! Views.view success (Citizen.name citizen) (timeZone ctx) |> render "Success Story" next ctx
| None -> return! Error.notFound next ctx
| None -> return! Error.notFound next ctx
}
// POST: /success-story/save
let save : HttpHandler = requireUser >=> validateCsrf >=> fun next ctx -> task {
let citizenId = currentCitizenId ctx
let! form = ctx.BindFormAsync<EditSuccessForm> ()
let isNew = form.Id = ShortGuid.fromGuid Guid.Empty
let! theSuccess = task {
if isNew then
return Some
{ Success.empty with
Id = SuccessId.create ()
CitizenId = citizenId
RecordedOn = now ctx
Source = "profile"
}
else return! Data.findById (SuccessId.ofString form.Id)
}
match theSuccess with
| Some story when story.CitizenId = citizenId ->
do! Data.save { story with IsFromHere = form.FromHere; Story = noneIfEmpty form.Story |> Option.map Text }
if isNew then
match! Profiles.Data.findById citizenId with
| Some profile -> do! Profiles.Data.save { profile with IsSeekingEmployment = false }
| None -> ()
let extraMsg = if isNew then " and seeking employment flag cleared" else ""
do! addSuccess $"Success story saved{extraMsg} successfully" ctx
return! redirectToGet "/success-stories" next ctx
| Some _ -> return! Error.notAuthorized next ctx
| None -> return! Error.notFound next ctx
}
open Giraffe.EndpointRouting
/// All endpoints for this feature
let endpoints =
subRoute "/success-stor" [
GET_HEAD [
route "ies" list
routef "y/%s/edit" edit
routef "y/%O/view" view
]
POST [ route "y/save" save ]
]

7
src/JobsJobsJobs/Server/Views/Success.fs → src/JobsJobsJobs/Server/SuccessStories/Views.fs
View File

@ -1,11 +1,10 @@
/// Views for /success-stor[y|ies] URLs /// Views for /success-stor[y|ies] URLs
[<RequireQualifiedAccess>] module JobsJobsJobs.SuccessStories.Views
module JobsJobsJobs.Views.Success
open Giraffe.ViewEngine open Giraffe.ViewEngine
open JobsJobsJobs.Common.Views
open JobsJobsJobs.Domain open JobsJobsJobs.Domain
open JobsJobsJobs.Domain.SharedTypes open JobsJobsJobs.SuccessStories.Domain
open JobsJobsJobs.ViewModels
/// The add/edit success story page /// The add/edit success story page
let edit (m : EditSuccessForm) isNew pgTitle csrf = let edit (m : EditSuccessForm) isNew pgTitle csrf =

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

@ -1,325 +0,0 @@
/// View models for Jobs, Jobs, Jobs
module JobsJobsJobs.ViewModels
open JobsJobsJobs.Domain
/// The data to add or update an other contact
[<CLIMutable; NoComparison; NoEquality>]
type OtherContactForm =
{ /// The type of the contact
ContactType : string
/// The name of the contact
Name : string
/// The value of the contact (URL, e-mail address, phone, etc.)
Value : string
/// Whether this contact is displayed for public employment profiles and job listings
IsPublic : bool
}
/// Support functions for the contact form
module OtherContactForm =
/// Create a contact form from a contact
let fromContact (contact : OtherContact) =
{ ContactType = ContactType.toString contact.ContactType
Name = defaultArg contact.Name ""
Value = contact.Value
IsPublic = contact.IsPublic
}
/// The data available to update an account profile
[<CLIMutable; NoComparison; NoEquality>]
type AccountProfileForm =
{ /// The first name of the citizen
FirstName : string
/// The last name of the citizen
LastName : string
/// The display name for the citizen
DisplayName : string
/// The citizen's new password
NewPassword : string
/// Confirmation of the citizen's new password
NewPasswordConfirm : string
/// The contacts for this profile
Contacts : OtherContactForm array
}
/// Support functions for the account profile form
module AccountProfileForm =
/// Create an account profile form from a citizen
let fromCitizen (citizen : Citizen) =
{ FirstName = citizen.FirstName
LastName = citizen.LastName
DisplayName = defaultArg citizen.DisplayName ""
NewPassword = ""
NewPasswordConfirm = ""
Contacts = citizen.OtherContacts |> List.map OtherContactForm.fromContact |> Array.ofList
}
/// The fields required for a skill
[<CLIMutable; NoComparison; NoEquality>]
type SkillForm =
{ Description : string
/// Notes regarding the skill
Notes : string
}
/// Functions to support skill forms
module SkillForm =
/// Create a skill form from a skill
let fromSkill (skill : Skill) =
{ SkillForm.Description = skill.Description; Notes = defaultArg skill.Notes "" }
/// Create a skill from a skill form
let toSkill (form : SkillForm) =
{ Skill.Description = form.Description; Notes = if form.Notes = "" then None else Some form.Notes }
/// The data required to add or edit a job listing
[<CLIMutable; NoComparison; NoEquality>]
type EditListingForm =
{ /// The ID of the listing
Id : string
/// The listing title
Title : string
/// The ID of the continent on which this opportunity exists
ContinentId : string
/// The region in which this opportunity exists
Region : string
/// Whether this is a remote work opportunity
RemoteWork : bool
/// The text of the job listing
Text : string
/// The date by which this job listing is needed
NeededBy : string
}
/// Support functions to support listings
module EditListingForm =
open NodaTime.Text
/// Create a listing form from an existing listing
let fromListing (listing : Listing) theId =
let neededBy =
match listing.NeededBy with
| Some dt -> (LocalDatePattern.CreateWithCurrentCulture "yyyy-MM-dd").Format dt
| None -> ""
{ Id = theId
Title = listing.Title
ContinentId = ContinentId.toString listing.ContinentId
Region = listing.Region
RemoteWork = listing.IsRemote
Text = MarkdownString.toString listing.Text
NeededBy = neededBy
}
/// The data required to update a profile
[<CLIMutable; NoComparison; NoEquality>]
type EditProfileViewModel =
{ /// Whether the citizen to whom this profile belongs is actively seeking employment
IsSeekingEmployment : bool
/// The ID of the continent on which the citizen is located
ContinentId : string
/// The area within that continent where the citizen is located
Region : string
/// If the citizen is available for remote work
RemoteWork : bool
/// If the citizen is seeking full-time employment
FullTime : bool
/// The user's professional biography
Biography : string
/// The skills for the user
Skills : SkillForm array
/// The user's past experience
Experience : string option
/// Whether this profile should appear in the public search
IsPubliclySearchable : bool
/// Whether this profile should be shown publicly
IsPubliclyLinkable : bool
}
/// Support functions for the ProfileForm type
module EditProfileViewModel =
/// An empty view model (used for new profiles)
let empty =
{ IsSeekingEmployment = false
ContinentId = ""
Region = ""
RemoteWork = false
FullTime = false
Biography = ""
Skills = [||]
Experience = None
IsPubliclySearchable = false
IsPubliclyLinkable = false
}
/// Create an instance of this form from the given profile
let fromProfile (profile : Profile) =
{ IsSeekingEmployment = profile.IsSeekingEmployment
ContinentId = ContinentId.toString profile.ContinentId
Region = profile.Region
RemoteWork = profile.IsRemote
FullTime = profile.IsFullTime
Biography = MarkdownString.toString profile.Biography
Skills = profile.Skills |> List.map SkillForm.fromSkill |> Array.ofList
Experience = profile.Experience |> Option.map MarkdownString.toString
IsPubliclySearchable = profile.IsPubliclySearchable
IsPubliclyLinkable = profile.IsPubliclyLinkable
}
/// The data required to provide a success story
[<CLIMutable; NoComparison; NoEquality>]
type EditSuccessForm =
{ /// The ID of this success story
Id : string
/// Whether the employment was obtained from Jobs, Jobs, Jobs
FromHere : bool
/// The success story
Story : string
}
/// Support functions for success edit forms
module EditSuccessForm =
/// Create an edit form from a success story
let fromSuccess (success : Success) =
{ Id = SuccessId.toString success.Id
FromHere = success.IsFromHere
Story = success.Story |> Option.map MarkdownString.toString |> Option.defaultValue ""
}
/// The form submitted to expire a listing
[<CLIMutable; NoComparison; NoEquality>]
type ExpireListingForm =
{ /// The ID of the listing to expire
Id : string
/// Whether the job was filled from here
FromHere : bool
/// The success story written by the user
SuccessStory : string
}
/// Form for the forgot / reset password page
[<CLIMutable; NoComparison; NoEquality>]
type ForgotPasswordForm =
{ /// The e-mail address for the account wishing to reset their password
Email : string
}
/// View model for the log on page
[<CLIMutable; NoComparison; NoEquality>]
type LogOnViewModel =
{ /// A message regarding an error encountered during a log on attempt
ErrorMessage : string option
/// The e-mail address for the user attempting to log on
Email : string
/// 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
}
/// View model for the registration page
[<CLIMutable; NoComparison; NoEquality>]
type RegisterViewModel =
{ /// The user's first name
FirstName : string
/// The user's last name
LastName : string
/// The user's display name
DisplayName : string option
/// The user's e-mail address
Email : string
/// The user's desired password
Password : string
/// The index of the first question asked
Question1Index : int
/// The answer for the first question asked
Question1Answer : string
/// The index of the second question asked
Question2Index : int
/// The answer for the second question asked
Question2Answer : string
}
/// Support for the registration page view model
module RegisterViewModel =
/// An empty view model
let empty =
{ FirstName = ""
LastName = ""
DisplayName = None
Email = ""
Password = ""
Question1Index = 0
Question1Answer = ""
Question2Index = 0
Question2Answer = ""
}
/// The form for a user resetting their password
[<CLIMutable; NoComparison; NoEquality>]
type ResetPasswordForm =
{ /// The ID of the citizen whose password is being reset
Id : string
/// The verification token for the password reset
Token : string
/// The new password for the account
Password : string
}

156
src/JobsJobsJobs/Server/Views/Common.fs
View File

@ -1,156 +0,0 @@
[<AutoOpen>]
module JobsJobsJobs.Views.Common
open Giraffe.ViewEngine
open Giraffe.ViewEngine.Accessibility
open Microsoft.AspNetCore.Antiforgery
open JobsJobsJobs.Domain
/// Create an audio clip with the specified text node
let audioClip clip text =
span [ _class "jjj-audio-clip"; _onclick "jjj.playFile(this)" ] [
text; audio [ _id clip ] [ source [ _src $"/audio/{clip}.mp3" ] ]
]
/// Create an anti-forgery hidden input
let antiForgery (csrf : AntiforgeryTokenSet) =
input [ _type "hidden"; _name csrf.FormFieldName; _value csrf.RequestToken ]
/// Alias for rawText
let txt = rawText
/// Create a page with a title displayed on the page
let pageWithTitle title content =
article [] [
h3 [ _class "pb-3" ] [ txt title ]
yield! content
]
/// Create a floating-label text input box
let textBox attrs name value fieldLabel isRequired =
div [ _class "form-floating" ] [
List.append attrs [
_id name; _name name; _class "form-control"; _placeholder fieldLabel; _value value
if isRequired then _required
] |> input
label [ _class (if isRequired then "jjj-required" else "jjj-label"); _for name ] [ txt fieldLabel ]
]
/// Create a checkbox that will post "true" if checked
let checkBox attrs name isChecked checkLabel =
div [ _class "form-check" ] [
List.append attrs
[ _type "checkbox"; _id name; _name name; _class "form-check-input"; _value "true"
if isChecked then _checked ]
|> input
label [ _class "form-check-label"; _for name ] [ txt checkLabel ]
]
/// Create a select list of continents
let continentList attrs name (continents : Continent list) emptyLabel selectedValue isRequired =
div [ _class "form-floating" ] [
select (List.append attrs [ _id name; _name name; _class "form-select"; if isRequired then _required ]) (
option [ _value ""; if selectedValue = "" then _selected ] [
rawText $"""&ndash; {defaultArg emptyLabel "Select"} &ndash;""" ]
:: (continents
|> List.map (fun c ->
let theId = ContinentId.toString c.Id
option [ _value theId; if theId = selectedValue then _selected ] [ str c.Name ])))
label [ _class (if isRequired then "jjj-required" else "jjj-label"); _for name ] [ txt "Continent" ]
]
/// Create a submit button with the given icon and text
let submitButton icon text =
button [ _type "submit"; _class "btn btn-primary" ] [ i [ _class $"mdi mdi-%s{icon}" ] []; txt $"&nbsp; %s{text}" ]
/// An empty paragraph
let emptyP =
p [] [ txt "&nbsp;" ]
/// Register JavaScript code to run in the DOMContentLoaded event on the page
let jsOnLoad js =
script [] [ txt """document.addEventListener("DOMContentLoaded", function () { """; txt js; txt " })" ]
/// Create a Markdown editor
let markdownEditor attrs name value editorLabel =
div [ _class "col-12"; _id $"{name}EditRow" ] [
nav [ _class "nav nav-pills pb-1" ] [
button [ _type "button"; _id $"{name}EditButton"; _class "btn btn-primary btn-sm rounded-pill" ] [
txt "Markdown"
]
rawText " &nbsp; "
button [ _type "button"; _id $"{name}PreviewButton"
_class "btn btn-outline-secondary btn-sm rounded-pill" ] [
txt "Preview"
]
]
section [ _id $"{name}Preview"; _class "jjj-not-shown jjj-markdown-preview px-2 pt-2"
_ariaLabel "Rendered Markdown preview" ] []
div [ _id $"{name}Edit"; _class "form-floating jjj-shown" ] [
textarea (List.append attrs
[ _id name; _name name; _class "form-control jjj-markdown-editor"; _rows "10" ]) [
txt value
]
label [ _for name ] [ txt editorLabel ]
]
jsOnLoad $"jjj.markdownOnLoad('{name}')"
]
/// Wrap content in a collapsing panel
let collapsePanel header content =
div [ _class "card" ] [
div [ _class "card-body" ] [
h6 [ _class "card-title" ] [
// TODO: toggle collapse
//a [ _href "#"; _class "{ 'cp-c': collapsed, 'cp-o': !collapsed }"; @click.prevent="toggle">{{headerText}} ]
txt header
]
yield! content
]
]
/// "Yes" or "No" based on a boolean value
let yesOrNo value =
if value then "Yes" else "No"
/// Markdown as a raw HTML text node
let md2html value =
(MarkdownString.toHtml >> txt) value
/// Display a citizen's contact information
let contactInfo citizen isPublic =
citizen.OtherContacts
|> List.filter (fun it -> (isPublic && it.IsPublic) || not isPublic)
|> List.collect (fun contact ->
match contact.ContactType with
| Website ->
[ i [ _class "mdi mdi-sm mdi-web" ] []; rawText " "
a [ _href contact.Value; _target "_blank"; _rel "noopener"; _class "me-4" ] [
str (defaultArg contact.Name "Website")
]
]
| Email ->
[ i [ _class "mdi mdi-sm mdi-email-outline" ] []; rawText " "
a [ _href $"mailto:{contact.Value}"; _class "me-4" ] [ str (defaultArg contact.Name "E-mail") ]
]
| Phone ->
[ span [ _class "me-4" ] [
i [ _class "mdi mdi-sm mdi-phone" ] []; rawText " "; str contact.Value
match contact.Name with Some name -> str $" ({name})" | None -> ()
]
])
open NodaTime
open NodaTime.Text
/// Generate a full date in the citizen's local time zone
let fullDate (value : Instant) tz =
(ZonedDateTimePattern.CreateWithCurrentCulture ("MMMM d, yyyy", DateTimeZoneProviders.Tzdb))
.Format(value.InZone DateTimeZoneProviders.Tzdb[tz])
/// Generate a full date/time in the citizen's local time
let fullDateTime (value : Instant) tz =
let dtPattern = ZonedDateTimePattern.CreateWithCurrentCulture ("MMMM d, yyyy h:mm", DateTimeZoneProviders.Tzdb)
let amPmPattern = ZonedDateTimePattern.CreateWithCurrentCulture ("tt", DateTimeZoneProviders.Tzdb)
let tzValue = value.InZone DateTimeZoneProviders.Tzdb[tz]
$"{dtPattern.Format(tzValue)}{amPmPattern.Format(tzValue).ToLowerInvariant()}"

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

@ -1,196 +0,0 @@
module JobsJobsJobs.Views.Layout
open Giraffe.ViewEngine
open Giraffe.ViewEngine.Accessibility
open Giraffe.ViewEngine.Htmx
/// Data items needed to render a view
type PageRenderContext =
{ /// Whether a user is logged on
IsLoggedOn : bool
/// The current URL
CurrentUrl : string
/// The title of this page
PageTitle : string
/// The page content
Content : XmlNode
/// User messages to be displayed
Messages : string list
}
/// Append the application name to the page title
let private constructTitle ctx =
seq {
if ctx.PageTitle <> "" then
ctx.PageTitle; " | "
"Jobs, Jobs, Jobs"
}
|> Seq.reduce (+)
|> str
|> List.singleton
|> title []
/// Generate the HTML head tag
let private htmlHead ctx =
head [] [
meta [ _name "viewport"; _content "width=device-width, initial-scale=1" ]
constructTitle ctx
link [ _href "https://cdn.jsdelivr.net/npm/bootstrap@5.2.0/dist/css/bootstrap.min.css"
_rel "stylesheet"
_integrity "sha384-gH2yIJqKdNHPEq0n4Mqa/HGKIhSkIHeL5AyhkYV8i59U5AR6csBvApHHNl/vI1Bx"
_crossorigin "anonymous" ]
link [ _href "https://cdn.jsdelivr.net/npm/@mdi/font@6.9.96/css/materialdesignicons.min.css"
_rel "stylesheet" ]
link [ _href "/style.css"; _rel "stylesheet" ]
]
/// Display the links available to the current user
let private links ctx =
let navLink url icon text =
a [ _href url
_onclick "jjj.hideMenu()"
if url = ctx.CurrentUrl then _class "jjj-current-page"
] [ i [ _class $"mdi mdi-{icon}"; _ariaHidden "true" ] []; txt text ]
nav [ _class "jjj-nav" ] [
if ctx.IsLoggedOn then
navLink "/citizen/dashboard" "view-dashboard-variant" "Dashboard"
navLink "/help-wanted" "newspaper-variant-multiple-outline" "Help Wanted!"
navLink "/profile/search" "view-list-outline" "Employment Profiles"
navLink "/success-stories" "thumb-up" "Success Stories"
div [ _class "separator" ] []
navLink "/citizen/account" "account-edit" "My Account"
navLink "/listings/mine" "sign-text" "My Job Listings"
navLink "/profile/edit" "pencil" "My Employment Profile"
div [ _class "separator" ] []
navLink "/citizen/log-off" "logout-variant" "Log Off"
else
navLink "/" "home" "Home"
navLink "/profile/seeking" "view-list-outline" "Job Seekers"
navLink "/citizen/log-on" "login-variant" "Log On"
navLink "/how-it-works" "help-circle-outline" "How It Works"
]
/// Generate mobile and desktop side navigation areas
let private sideNavs ctx = [
div [ _id "mobileMenu"; _class "jjj-mobile-menu offcanvas offcanvas-end"; _tabindex "-1"
_ariaLabelledBy "mobileMenuLabel" ] [
div [ _class "offcanvas-header" ] [
h5 [ _id "mobileMenuLabel" ] [ txt "Menu" ]
button [
_class "btn-close text-reset"; _type "button"; _data "bs-dismiss" "offcanvas"; _ariaLabel "Close"
] []
]
div [ _class "offcanvas-body" ] [ links ctx ]
]
aside [ _class "jjj-full-menu d-none d-md-block p-3" ] [
p [ _class "home-link pb-3" ] [ a [ _href "/" ] [ txt "Jobs, Jobs, Jobs" ] ]
emptyP
links ctx
]
]
/// Title bars for mobile and desktop
let private titleBars = [
nav [ _class "d-flex d-md-none navbar navbar-dark" ] [
span [ _class "navbar-text" ] [ a [ _href "/" ] [ txt "Jobs, Jobs, Jobs" ] ]
button [ _class "btn"; _data "bs-toggle" "offcanvas"; _data "bs-target" "#mobileMenu"
_ariaControls "mobileMenu" ] [ i [ _class "mdi mdi-menu" ] [] ]
]
nav [ _class "d-none d-md-flex navbar navbar-light bg-light"] [
span [] [ txt "&nbsp;" ]
span [ _class "navbar-text" ] [
txt "(&hellip;and Jobs &ndash; "; audioClip "pelosi-jobs" (txt "Let&rsquo;s Vote for Jobs!"); txt ")"
]
]
]
/// The HTML footer for the page
let private htmlFoot =
let v = System.Reflection.Assembly.GetExecutingAssembly().GetName().Version
let version =
seq {
string v.Major
if v.Minor > 0 then
"."; string v.Minor
if v.Build > 0 then
"."; string v.Build
} |> Seq.reduce (+)
footer [] [
p [ _class "text-muted" ] [
txt $"Jobs, Jobs, Jobs v{version} &bull; "
a [ _href "/privacy-policy" ] [ txt "Privacy Policy" ]; txt " &bull; "
a [ _href "/terms-of-service" ] [ txt "Terms of Service" ]
]
]
/// Render any messages
let private messages ctx =
ctx.Messages
|> List.map (fun msg ->
let parts = msg.Split "|||"
let level = if parts[0] = "error" then "danger" else parts[0]
let message = parts[1]
div [ _class $"alert alert-{level} alert-dismissable fade show d-flex justify-content-between p-2 mb-1 mt-1"
_roleAlert ] [
p [ _class "mb-0" ] [
if level <> "success" then strong [] [ txt $"{parts[0].ToUpperInvariant ()}: " ]
txt message
]
button [ _type "button"; _class "btn-close"; _data "bs-dismiss" "alert"; _ariaLabel "Close" ] []
])
|> div [ _id "alerts" ]
/// Create a full view
let full ctx =
html [ _lang "en" ] [
htmlHead ctx
body [] [
div [ _class "jjj-app"; _hxBoost; _hxTarget "this" ] [
yield! sideNavs ctx
div [ _class "jjj-main" ] [
yield! titleBars
main [ _class "jjj-content container-fluid" ] [
messages ctx
ctx.Content
]
htmlFoot
]
]
Script.minified
script [ _async
_src "https://cdn.jsdelivr.net/npm/bootstrap@5.2.0/dist/js/bootstrap.bundle.min.js"
_integrity "sha384-A3rJD856KowSb7dwlZdYEkO39Gagi7vIsF0jrRAoQmDKKtQBHUuLZ9AsSv4jD4Xa"
_crossorigin "anonymous" ] []
script [ _src "/script.js" ] []
template [ _id "alertTemplate" ] [
div [ _class $"alert alert-dismissable fade show d-flex justify-content-between p-2 mb-1 mt-1"
_roleAlert ] [
p [ _class "mb-0" ] []
button [ _type "button"; _class "btn-close"; _data "bs-dismiss" "alert"; _ariaLabel "Close" ] []
]
]
]
]
/// Create a partial (boosted response) view
let partial ctx =
html [ _lang "en" ] [
head [] [
constructTitle ctx
]
body [] [
yield! sideNavs ctx
div [ _class "jjj-main" ] [
yield! titleBars
main [ _class "jjj-content container-fluid" ] [
messages ctx
ctx.Content
]
htmlFoot
]
]
]