diff --git a/src/JobsJobsJobs/Data/Data.fs b/src/JobsJobsJobs/Data/Data.fs deleted file mode 100644 index daaddab..0000000 --- a/src/JobsJobsJobs/Data/Data.fs +++ /dev/null @@ -1,583 +0,0 @@ -namespace JobsJobsJobs.Data - -/// Constants for tables used by Jobs, Jobs, Jobs -module Table = - - /// Citizens - [] - let Citizen = "jjj.citizen" - - /// Continents - [] - let Continent = "jjj.continent" - - /// Job Listings - [] - let Listing = "jjj.listing" - - /// Employment Profiles - [] - let Profile = "jjj.profile" - - /// User Security Information - [] - let SecurityInfo = "jjj.security_info" - - /// Success Stories - [] - 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 -[] -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 -[] -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 - 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 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 - 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 - match List.tryHead tryCitizen with - | Some citizen -> - let citizenId = CitizenId.toString citizen.Id - let! tryInfo = getDocument 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 row, toDocumentFrom "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 - return List.tryHead results - } - - -/// Continent data access functions -[] -module Continents = - - /// Retrieve all continents - let all () = - dataSource () - |> Sql.query $"SELECT * FROM {Table.Continent} ORDER BY data ->> 'name'" - |> Sql.executeAsync toDocument - - /// Retrieve a continent by its ID - let findById continentId = - dataSource () |> getDocument Table.Continent (ContinentId.toString continentId) - - -open JobsJobsJobs.Domain.SharedTypes - -/// Job listing access functions -[] -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 row - ContinentName = row.string "continent_name" - Citizen = toDocumentFrom "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 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 -[] -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 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 row - Citizen = toDocumentFrom "cit_data" row - Continent = toDocumentFrom "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 row - let citizen = toDocumentFrom "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 row - let continent = toDocumentFrom "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 -[] -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 row - let citizen = toDocumentFrom "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 Table.Success (SuccessId.toString successId) - - /// Save a success story - let save (success : Success) = - dataSource () |> saveDocument Table.Success (SuccessId.toString success.Id) <| mkDoc success - \ No newline at end of file diff --git a/src/JobsJobsJobs/Data/JobsJobsJobs.Data.fsproj b/src/JobsJobsJobs/Data/JobsJobsJobs.Data.fsproj deleted file mode 100644 index f9e4636..0000000 --- a/src/JobsJobsJobs/Data/JobsJobsJobs.Data.fsproj +++ /dev/null @@ -1,24 +0,0 @@ - - - - true - - - - - - - - - - - - - - - - - - - - diff --git a/src/JobsJobsJobs/Domain/.gitignore b/src/JobsJobsJobs/Domain/.gitignore deleted file mode 100644 index 4c43fe6..0000000 --- a/src/JobsJobsJobs/Domain/.gitignore +++ /dev/null @@ -1 +0,0 @@ -*.js \ No newline at end of file diff --git a/src/JobsJobsJobs/Domain/JobsJobsJobs.Domain.fsproj b/src/JobsJobsJobs/Domain/JobsJobsJobs.Domain.fsproj deleted file mode 100644 index a3e6e03..0000000 --- a/src/JobsJobsJobs/Domain/JobsJobsJobs.Domain.fsproj +++ /dev/null @@ -1,21 +0,0 @@ - - - - true - 3390;$(WarnOn) - - - - - - - - - - - - - - - - diff --git a/src/JobsJobsJobs/Domain/SharedTypes.fs b/src/JobsJobsJobs/Domain/SharedTypes.fs deleted file mode 100644 index fe052a5..0000000 --- a/src/JobsJobsJobs/Domain/SharedTypes.fs +++ /dev/null @@ -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 -[] -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 -[] -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 -[] -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 -[] -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 -[] -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 -[] -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 -[] -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 - } diff --git a/src/JobsJobsJobs/Domain/SupportTypes.fs b/src/JobsJobsJobs/Domain/SupportTypes.fs deleted file mode 100644 index f824960..0000000 --- a/src/JobsJobsJobs/Domain/SupportTypes.fs +++ /dev/null @@ -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 diff --git a/src/JobsJobsJobs/JobsJobsJobs.V3Migration/Program.fs b/src/JobsJobsJobs/JobsJobsJobs.V3Migration/Program.fs index 7fee02c..d79562d 100644 --- a/src/JobsJobsJobs/JobsJobsJobs.V3Migration/Program.fs +++ b/src/JobsJobsJobs/JobsJobsJobs.V3Migration/Program.fs @@ -64,7 +64,7 @@ task { let cfg = ConfigurationBuilder().AddJsonFile("appsettings.json").Build () use rethinkConn = Rethink.Startup.createConnection (cfg.GetConnectionString "RethinkDB") do! DataConnection.setUp cfg - let pgConn = DataConnection.connection () + let pgConn = DataConnection.dataSource () let getOld table = fromTable table diff --git a/src/JobsJobsJobs/Server/ApiHandlers.fs b/src/JobsJobsJobs/Server/ApiHandlers.fs new file mode 100644 index 0000000..f3e05f4 --- /dev/null +++ b/src/JobsJobsJobs/Server/ApiHandlers.fs @@ -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 ] + ] diff --git a/src/JobsJobsJobs/Server/App.fs b/src/JobsJobsJobs/Server/App.fs index a1d5547..53da5e5 100644 --- a/src/JobsJobsJobs/Server/App.fs +++ b/src/JobsJobsJobs/Server/App.fs @@ -1,11 +1,11 @@ /// The main web server application for Jobs, Jobs, Jobs -module JobsJobsJobs.Server.App +module JobsJobsJobs.App open System open System.Text open Giraffe open Giraffe.EndpointRouting -open JobsJobsJobs.Data +open JobsJobsJobs.Common.Data open Microsoft.AspNetCore.Authentication.Cookies open Microsoft.AspNetCore.Builder open Microsoft.AspNetCore.Http @@ -50,7 +50,7 @@ let main args = // Set up the data store let cfg = svc.BuildServiceProvider().GetRequiredService () - let _ = DataConnection.setUp cfg |> Async.AwaitTask |> Async.RunSynchronously + let _ = setUp cfg |> Async.AwaitTask |> Async.RunSynchronously let _ = svc.AddSingleton (fun _ -> DistributedCache () :> IDistributedCache) let _ = svc.AddSession(fun opts -> opts.IdleTimeout <- TimeSpan.FromMinutes 60 @@ -59,6 +59,16 @@ let main args = 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.UseCookiePolicy (CookiePolicyOptions (MinimumSameSitePolicy = SameSiteMode.Strict)) let _ = app.UseStaticFiles () @@ -67,8 +77,8 @@ let main args = let _ = app.UseAuthentication () let _ = app.UseAuthorization () let _ = app.UseSession () - let _ = app.UseGiraffeErrorHandler Handlers.Error.unexpectedError - let _ = app.UseEndpoints (fun e -> e.MapGiraffeEndpoints Handlers.allEndpoints |> ignore) + let _ = app.UseGiraffeErrorHandler Common.Handlers.Error.unexpectedError + let _ = app.UseEndpoints (fun e -> e.MapGiraffeEndpoints endpoints |> ignore) app.Run () diff --git a/src/JobsJobsJobs/Server/Auth.fs b/src/JobsJobsJobs/Server/Auth.fs deleted file mode 100644 index 40b0023..0000000 --- a/src/JobsJobsJobs/Server/Auth.fs +++ /dev/null @@ -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 () - - /// 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 diff --git a/src/JobsJobsJobs/Data/Cache.fs b/src/JobsJobsJobs/Server/Cache.fs similarity index 99% rename from src/JobsJobsJobs/Data/Cache.fs rename to src/JobsJobsJobs/Server/Cache.fs index f4335b4..fabeca6 100644 --- a/src/JobsJobsJobs/Data/Cache.fs +++ b/src/JobsJobsJobs/Server/Cache.fs @@ -1,8 +1,5 @@ -namespace JobsJobsJobs.Data +namespace JobsJobsJobs -open System.Threading -open System.Threading.Tasks -open Microsoft.Extensions.Caching.Distributed open NodaTime open Npgsql.FSharp @@ -11,6 +8,7 @@ open Npgsql.FSharp module private CacheHelpers = open System + open System.Threading.Tasks open Npgsql /// The cache entry @@ -56,7 +54,10 @@ module private CacheHelpers = let expireParam = 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 type DistributedCache () = diff --git a/src/JobsJobsJobs/Server/Citizens/Data.fs b/src/JobsJobsJobs/Server/Citizens/Data.fs new file mode 100644 index 0000000..ddee086 --- /dev/null +++ b/src/JobsJobsJobs/Server/Citizens/Data.fs @@ -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 + 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 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 + 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 + match List.tryHead tryCitizen with + | Some citizen -> + let citizenId = CitizenId.toString citizen.Id + let! tryInfo = getDocument 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 row, toDocumentFrom "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 + return List.tryHead results +} diff --git a/src/JobsJobsJobs/Server/Citizens/Domain.fs b/src/JobsJobsJobs/Server/Citizens/Domain.fs new file mode 100644 index 0000000..9e9921e --- /dev/null +++ b/src/JobsJobsJobs/Server/Citizens/Domain.fs @@ -0,0 +1,153 @@ +module JobsJobsJobs.Citizens.Domain + +open JobsJobsJobs.Domain + +/// The data to add or update an other contact +[] +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 +[] +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 +[] +type ForgotPasswordForm = + { /// The e-mail address for the account wishing to reset their password + Email : string + } + + +/// Form for the log on page +[] +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 +[] +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 +[] +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 + } diff --git a/src/JobsJobsJobs/Server/Citizens/Handlers.fs b/src/JobsJobsJobs/Server/Citizens/Handlers.fs new file mode 100644 index 0000000..bc892b0 --- /dev/null +++ b/src/JobsJobsJobs/Server/Citizens/Handlers.fs @@ -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 () + + /// 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 () + 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 () + 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 () + 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 () + 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 () + 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 + ] + ] diff --git a/src/JobsJobsJobs/Server/Views/Citizen.fs b/src/JobsJobsJobs/Server/Citizens/Views.fs similarity index 98% rename from src/JobsJobsJobs/Server/Views/Citizen.fs rename to src/JobsJobsJobs/Server/Citizens/Views.fs index a96e042..8330ac5 100644 --- a/src/JobsJobsJobs/Server/Views/Citizen.fs +++ b/src/JobsJobsJobs/Server/Citizens/Views.fs @@ -1,11 +1,11 @@ /// Views for URLs beginning with /citizen -[] -module JobsJobsJobs.Views.Citizen +module JobsJobsJobs.Citizens.Views open Giraffe.ViewEngine open Giraffe.ViewEngine.Htmx +open JobsJobsJobs.Citizens.Domain +open JobsJobsJobs.Common.Views open JobsJobsJobs.Domain -open JobsJobsJobs.ViewModels /// The form to add or edit a means of contact let contactEdit (contacts : OtherContactForm array) = @@ -264,14 +264,14 @@ let forgotPassword csrf = let forgotPasswordSent (m : ForgotPasswordForm) = pageWithTitle "Reset Request Processed" [ p [] [ - txt "The reset link request has been processed. If the e-mail address matched an account, further " - txt "instructions were sent to that address." + txt $"The reset link request has been processed. If the e-mail address {m.Email} matched an account, " + txt "further instructions were sent to that address." ] ] /// The log on page -let logOn (m : LogOnViewModel) csrf = +let logOn (m : LogOnForm) csrf = pageWithTitle "Log On" [ match m.ErrorMessage with | Some msg -> @@ -305,7 +305,7 @@ let logOn (m : LogOnViewModel) csrf = ] /// The registration page -let register q1 q2 (m : RegisterViewModel) csrf = +let register q1 q2 (m : RegisterForm) csrf = pageWithTitle "Register" [ form [ _class "row g-3"; _hxPost "/citizen/register" ] [ antiForgery csrf diff --git a/src/JobsJobsJobs/Server/Common/Data.fs b/src/JobsJobsJobs/Server/Common/Data.fs new file mode 100644 index 0000000..476fcc3 --- /dev/null +++ b/src/JobsJobsJobs/Server/Common/Data.fs @@ -0,0 +1,151 @@ +module JobsJobsJobs.Common.Data + +/// Constants for tables used by Jobs, Jobs, Jobs +[] +module Table = + + /// Citizens + [] + let Citizen = "jjj.citizen" + + /// Continents + [] + let Continent = "jjj.continent" + + /// Job Listings + [] + let Listing = "jjj.listing" + + /// Employment Profiles + [] + let Profile = "jjj.profile" + + /// User Security Information + [] + let SecurityInfo = "jjj.security_info" + + /// Success Stories + [] + 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 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 +[] +module Continents = + + open JobsJobsJobs.Domain + + /// Retrieve all continents + let all () = + dataSource () + |> Sql.query $"SELECT * FROM {Table.Continent} ORDER BY data ->> 'name'" + |> Sql.executeAsync toDocument + + /// Retrieve a continent by its ID + let findById continentId = + dataSource () |> getDocument Table.Continent (ContinentId.toString continentId) diff --git a/src/JobsJobsJobs/Server/Common/Handlers.fs b/src/JobsJobsJobs/Server/Common/Handlers.fs new file mode 100644 index 0000000..1c7ee5e --- /dev/null +++ b/src/JobsJobsJobs/Server/Common/Handlers.fs @@ -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 + +[] +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 () + 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().GetCurrentInstant () + +/// Get the application configuration from the request context +let config (ctx : HttpContext) = ctx.GetService () + +/// Get the logger factory from the request context +let logger (ctx : HttpContext) = ctx.GetService () + +/// `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 () + +/// 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 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 ("
  • ", errors) + do! addError $"Please correct the following errors:
    • {errMsg}
    " 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 +} diff --git a/src/JobsJobsJobs/Data/Json.fs b/src/JobsJobsJobs/Server/Common/Json.fs similarity index 95% rename from src/JobsJobsJobs/Data/Json.fs rename to src/JobsJobsJobs/Server/Common/Json.fs index 81c5e4d..b519c13 100644 --- a/src/JobsJobsJobs/Data/Json.fs +++ b/src/JobsJobsJobs/Server/Common/Json.fs @@ -1,4 +1,5 @@ -module JobsJobsJobs.Data.Json +/// JSON serializer options +module JobsJobsJobs.Json open System.Text.Json open System.Text.Json.Serialization diff --git a/src/JobsJobsJobs/Server/Common/Views.fs b/src/JobsJobsJobs/Server/Common/Views.fs new file mode 100644 index 0000000..cf99086 --- /dev/null +++ b/src/JobsJobsJobs/Server/Common/Views.fs @@ -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 $"""– {defaultArg emptyLabel "Select"} –""" ] + :: (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 $"  %s{text}" ] + +/// An empty paragraph +let emptyP = + p [] [ txt " " ] + +/// 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 "   " + 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 +[] +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 " " ] + span [ _class "navbar-text" ] [ + txt "(…and Jobs – "; audioClip "pelosi-jobs" (txt "Let’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} • " + a [ _href "/privacy-policy" ] [ txt "Privacy Policy" ]; txt " • " + 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 + ] + ] + ] diff --git a/src/JobsJobsJobs/Domain/Types.fs b/src/JobsJobsJobs/Server/Domain.fs similarity index 63% rename from src/JobsJobsJobs/Domain/Types.fs rename to src/JobsJobsJobs/Server/Domain.fs index e331f97..858c57f 100644 --- a/src/JobsJobsJobs/Domain/Types.fs +++ b/src/JobsJobsJobs/Server/Domain.fs @@ -1,278 +1,433 @@ -namespace JobsJobsJobs.Domain - -open NodaTime -open System - -/// A user of Jobs, Jobs, Jobs; a citizen of Gitmo Nation -[] -type Citizen = - { /// The ID of the user - Id : CitizenId - - /// When the user joined Jobs, Jobs, Jobs - JoinedOn : Instant - - /// When the user last logged in - LastSeenOn : Instant - - /// The user's e-mail address - Email : string - - /// The user's first name - FirstName : string - - /// The user's last name - LastName : string - - /// The hash of the user's password - PasswordHash : string - - /// The name displayed for this user throughout the site - DisplayName : string option - - /// The other contacts for this user - OtherContacts : OtherContact list - - /// Whether this is a legacy citizen - IsLegacy : bool - } - -/// Support functions for citizens -module Citizen = - - /// An empty citizen - let empty = { - Id = CitizenId Guid.Empty - JoinedOn = Instant.MinValue - LastSeenOn = Instant.MinValue - Email = "" - FirstName = "" - LastName = "" - PasswordHash = "" - DisplayName = None - OtherContacts = [] - IsLegacy = false - } - - /// Get the name of the citizen (either their preferred display name or first/last names) - let name x = - match x.DisplayName with Some it -> it | None -> $"{x.FirstName} {x.LastName}" - - -/// A continent -[] -type Continent = - { /// The ID of the continent - Id : ContinentId - - /// The name of the continent - Name : string - } - -/// Support functions for continents -module Continent = - - /// An empty continent - let empty ={ - Id = ContinentId Guid.Empty - Name = "" - } - - -/// A job listing -[] -type Listing = - { /// The ID of the job listing - Id : ListingId - - /// The ID of the citizen who posted the job listing - CitizenId : CitizenId - - /// When this job listing was created - CreatedOn : Instant - - /// The short title of the job listing - Title : string - - /// The ID of the continent on which the job is located - ContinentId : ContinentId - - /// The region in which the job is located - Region : string - - /// Whether this listing is for remote work - IsRemote : bool - - /// Whether this listing has expired - IsExpired : bool - - /// When this listing was last updated - UpdatedOn : Instant - - /// The details of this job - Text : MarkdownString - - /// When this job needs to be filled - NeededBy : LocalDate option - - /// Was this job filled as part of its appearance on Jobs, Jobs, Jobs? - WasFilledHere : bool option - - /// Whether this is a legacy listing - IsLegacy : bool - } - -/// Support functions for job listings -module Listing = - - /// An empty job listing - let empty = { - Id = ListingId Guid.Empty - CitizenId = CitizenId Guid.Empty - CreatedOn = Instant.MinValue - Title = "" - ContinentId = ContinentId Guid.Empty - Region = "" - IsRemote = false - IsExpired = false - UpdatedOn = Instant.MinValue - Text = Text "" - NeededBy = None - WasFilledHere = None - IsLegacy = false - } - - -/// Security settings for a user -type SecurityInfo = - { /// The ID of the citizen to whom these settings apply - Id : CitizenId - - /// The number of failed log on attempts (reset to 0 on successful log on) - FailedLogOnAttempts : int - - /// Whether the account is locked - AccountLocked : bool - - /// The token the user must provide to take their desired action - Token : string option - - /// The action to which the token applies - TokenUsage : string option - - /// When the token expires - TokenExpires : Instant option - } - -/// Functions to support security info -module SecurityInfo = - - /// An empty set of security info - let empty = { - Id = CitizenId Guid.Empty - FailedLogOnAttempts = 0 - AccountLocked = false - Token = None - TokenUsage = None - TokenExpires = None - } - - -/// A job seeker profile -[] -type Profile = - { /// The ID of the citizen to whom this profile belongs - Id : CitizenId - - /// Whether this citizen is actively seeking employment - IsSeekingEmployment : bool - - /// Whether this citizen allows their profile to be a part of the publicly-viewable, anonymous data - IsPubliclySearchable : bool - - /// Whether this citizen allows their profile to be viewed via a public link - IsPubliclyLinkable : bool - - /// The ID of the continent on which the citizen resides - ContinentId : ContinentId - - /// The region in which the citizen resides - Region : string - - /// Whether the citizen is looking for remote work - IsRemote : bool - - /// Whether the citizen is looking for full-time work - IsFullTime : bool - - /// The citizen's professional biography - Biography : MarkdownString - - /// When the citizen last updated their profile - LastUpdatedOn : Instant - - /// The citizen's experience (topical / chronological) - Experience : MarkdownString option - - /// Skills this citizen possesses - Skills : Skill list - - /// Whether this is a legacy profile - IsLegacy : bool - } - -/// Support functions for Profiles -module Profile = - - // An empty profile - let empty = { - Id = CitizenId Guid.Empty - IsSeekingEmployment = false - IsPubliclySearchable = false - IsPubliclyLinkable = false - ContinentId = ContinentId Guid.Empty - Region = "" - IsRemote = false - IsFullTime = false - Biography = Text "" - LastUpdatedOn = Instant.MinValue - Experience = None - Skills = [] - IsLegacy = false - } - - -/// A record of success finding employment -[] -type Success = - { /// The ID of the success report - Id : SuccessId - - /// The ID of the citizen who wrote this success report - CitizenId : CitizenId - - /// When this success report was recorded - RecordedOn : Instant - - /// Whether the success was due, at least in part, to Jobs, Jobs, Jobs - IsFromHere : bool - - /// The source of this success (listing or profile) - Source : string - - /// The success story - Story : MarkdownString option - } - -/// Support functions for success stories -module Success = - - /// An empty success story - let empty = { - Id = SuccessId Guid.Empty - CitizenId = CitizenId Guid.Empty - RecordedOn = Instant.MinValue - IsFromHere = false - Source = "" - Story = None - } +namespace JobsJobsJobs.Domain + +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 +[] +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 + +// ~~~ DOCUMENT TYPES ~~~ // + +/// A user of Jobs, Jobs, Jobs; a citizen of Gitmo Nation +[] +type Citizen = + { /// The ID of the user + Id : CitizenId + + /// When the user joined Jobs, Jobs, Jobs + JoinedOn : Instant + + /// When the user last logged in + LastSeenOn : Instant + + /// The user's e-mail address + Email : string + + /// The user's first name + FirstName : string + + /// The user's last name + LastName : string + + /// The hash of the user's password + PasswordHash : string + + /// The name displayed for this user throughout the site + DisplayName : string option + + /// The other contacts for this user + OtherContacts : OtherContact list + + /// Whether this is a legacy citizen + IsLegacy : bool + } + +/// Support functions for citizens +module Citizen = + + /// An empty citizen + let empty = { + Id = CitizenId Guid.Empty + JoinedOn = Instant.MinValue + LastSeenOn = Instant.MinValue + Email = "" + FirstName = "" + LastName = "" + PasswordHash = "" + DisplayName = None + OtherContacts = [] + IsLegacy = false + } + + /// Get the name of the citizen (either their preferred display name or first/last names) + let name x = + match x.DisplayName with Some it -> it | None -> $"{x.FirstName} {x.LastName}" + + +/// A continent +[] +type Continent = + { /// The ID of the continent + Id : ContinentId + + /// The name of the continent + Name : string + } + +/// Support functions for continents +module Continent = + + /// An empty continent + let empty ={ + Id = ContinentId Guid.Empty + Name = "" + } + + +/// A job listing +[] +type Listing = + { /// The ID of the job listing + Id : ListingId + + /// The ID of the citizen who posted the job listing + CitizenId : CitizenId + + /// When this job listing was created + CreatedOn : Instant + + /// The short title of the job listing + Title : string + + /// The ID of the continent on which the job is located + ContinentId : ContinentId + + /// The region in which the job is located + Region : string + + /// Whether this listing is for remote work + IsRemote : bool + + /// Whether this listing has expired + IsExpired : bool + + /// When this listing was last updated + UpdatedOn : Instant + + /// The details of this job + Text : MarkdownString + + /// When this job needs to be filled + NeededBy : LocalDate option + + /// Was this job filled as part of its appearance on Jobs, Jobs, Jobs? + WasFilledHere : bool option + + /// Whether this is a legacy listing + IsLegacy : bool + } + +/// Support functions for job listings +module Listing = + + /// An empty job listing + let empty = { + Id = ListingId Guid.Empty + CitizenId = CitizenId Guid.Empty + CreatedOn = Instant.MinValue + Title = "" + ContinentId = ContinentId Guid.Empty + Region = "" + IsRemote = false + IsExpired = false + UpdatedOn = Instant.MinValue + Text = Text "" + NeededBy = None + WasFilledHere = None + IsLegacy = false + } + + +/// Security settings for a user +[] +type SecurityInfo = + { /// The ID of the citizen to whom these settings apply + Id : CitizenId + + /// The number of failed log on attempts (reset to 0 on successful log on) + FailedLogOnAttempts : int + + /// Whether the account is locked + AccountLocked : bool + + /// The token the user must provide to take their desired action + Token : string option + + /// The action to which the token applies + TokenUsage : string option + + /// When the token expires + TokenExpires : Instant option + } + +/// Functions to support security info +module SecurityInfo = + + /// An empty set of security info + let empty = { + Id = CitizenId Guid.Empty + FailedLogOnAttempts = 0 + AccountLocked = false + Token = None + TokenUsage = None + TokenExpires = None + } + + +/// A job seeker profile +[] +type Profile = + { /// The ID of the citizen to whom this profile belongs + Id : CitizenId + + /// Whether this citizen is actively seeking employment + IsSeekingEmployment : bool + + /// Whether this citizen allows their profile to be a part of the publicly-viewable, anonymous data + IsPubliclySearchable : bool + + /// Whether this citizen allows their profile to be viewed via a public link + IsPubliclyLinkable : bool + + /// The ID of the continent on which the citizen resides + ContinentId : ContinentId + + /// The region in which the citizen resides + Region : string + + /// Whether the citizen is looking for remote work + IsRemote : bool + + /// Whether the citizen is looking for full-time work + IsFullTime : bool + + /// The citizen's professional biography + Biography : MarkdownString + + /// When the citizen last updated their profile + LastUpdatedOn : Instant + + /// The citizen's experience (topical / chronological) + Experience : MarkdownString option + + /// Skills this citizen possesses + Skills : Skill list + + /// Whether this is a legacy profile + IsLegacy : bool + } + +/// Support functions for Profiles +module Profile = + + // An empty profile + let empty = { + Id = CitizenId Guid.Empty + IsSeekingEmployment = false + IsPubliclySearchable = false + IsPubliclyLinkable = false + ContinentId = ContinentId Guid.Empty + Region = "" + IsRemote = false + IsFullTime = false + Biography = Text "" + LastUpdatedOn = Instant.MinValue + Experience = None + Skills = [] + IsLegacy = false + } + + +/// A record of success finding employment +[] +type Success = + { /// The ID of the success report + Id : SuccessId + + /// The ID of the citizen who wrote this success report + CitizenId : CitizenId + + /// When this success report was recorded + RecordedOn : Instant + + /// Whether the success was due, at least in part, to Jobs, Jobs, Jobs + IsFromHere : bool + + /// The source of this success (listing or profile) + Source : string + + /// The success story + Story : MarkdownString option + } + +/// Support functions for success stories +module Success = + + /// An empty success story + let empty = { + Id = SuccessId Guid.Empty + CitizenId = CitizenId Guid.Empty + RecordedOn = Instant.MinValue + IsFromHere = false + Source = "" + Story = None + } diff --git a/src/JobsJobsJobs/Server/Email.fs b/src/JobsJobsJobs/Server/Email.fs index a2f1286..d62b31f 100644 --- a/src/JobsJobsJobs/Server/Email.fs +++ b/src/JobsJobsJobs/Server/Email.fs @@ -1,4 +1,4 @@ -module JobsJobsJobs.Server.Email +module JobsJobsJobs.Email open System.Net open JobsJobsJobs.Domain diff --git a/src/JobsJobsJobs/Server/Handlers.fs b/src/JobsJobsJobs/Server/Handlers.fs deleted file mode 100644 index 74330f7..0000000 --- a/src/JobsJobsJobs/Server/Handlers.fs +++ /dev/null @@ -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 - - -[] -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 () - 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 -[] -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().GetCurrentInstant () - - /// Get the application configuration from the request context - let config (ctx : HttpContext) = ctx.GetService () - - /// Get the logger factory from the request context - let logger (ctx : HttpContext) = ctx.GetService () - - /// `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 () - - /// 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 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 ("
  • ", errors) - do! addError $"Please correct the following errors:
    • {errMsg}
    " 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 -[] -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 -[] -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 () - 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 () - 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 () - 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 () - 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 () - 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 -[] -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) -[] -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 “{listing.Title}” 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 () - 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 () - 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 () 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 -[] -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 () - 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 () 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 () 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 -[] -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 () - 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 ] - ] -] diff --git a/src/JobsJobsJobs/Server/Home/Handlers.fs b/src/JobsJobsJobs/Server/Home/Handlers.fs new file mode 100644 index 0000000..e6341c2 --- /dev/null +++ b/src/JobsJobsJobs/Server/Home/Handlers.fs @@ -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 + ] diff --git a/src/JobsJobsJobs/Server/Views/Home.fs b/src/JobsJobsJobs/Server/Home/Views.fs similarity index 99% rename from src/JobsJobsJobs/Server/Views/Home.fs rename to src/JobsJobsJobs/Server/Home/Views.fs index 4be5439..58a8d49 100644 --- a/src/JobsJobsJobs/Server/Views/Home.fs +++ b/src/JobsJobsJobs/Server/Home/Views.fs @@ -1,6 +1,7 @@ -module JobsJobsJobs.Views.Home +module JobsJobsJobs.Home.Views open Giraffe.ViewEngine +open JobsJobsJobs.Common.Views /// The home page let home = diff --git a/src/JobsJobsJobs/Server/JobsJobsJobs.Server.fsproj b/src/JobsJobsJobs/Server/JobsJobsJobs.Server.fsproj index f15a1ac..dd3e195 100644 --- a/src/JobsJobsJobs/Server/JobsJobsJobs.Server.fsproj +++ b/src/JobsJobsJobs/Server/JobsJobsJobs.Server.fsproj @@ -8,39 +8,51 @@ - + - - - - - - - - - + + + + + + + + + + + + + + + + + + + + + + + + - - - - - + - - + - + + + diff --git a/src/JobsJobsJobs/Server/Listings/Data.fs b/src/JobsJobsJobs/Server/Listings/Data.fs new file mode 100644 index 0000000..f7f0529 --- /dev/null +++ b/src/JobsJobsJobs/Server/Listings/Data.fs @@ -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 row + ContinentName = row.string "continent_name" + Citizen = toDocumentFrom "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 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 diff --git a/src/JobsJobsJobs/Server/Listings/Domain.fs b/src/JobsJobsJobs/Server/Listings/Domain.fs new file mode 100644 index 0000000..a69d2ad --- /dev/null +++ b/src/JobsJobsJobs/Server/Listings/Domain.fs @@ -0,0 +1,94 @@ +module JobsJobsJobs.Listings.Domain + +open JobsJobsJobs.Domain + +/// The data required to add or edit a job listing +[] +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 +[] +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 +[] +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 +[] +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 + } + diff --git a/src/JobsJobsJobs/Server/Listings/Handlers.fs b/src/JobsJobsJobs/Server/Listings/Handlers.fs new file mode 100644 index 0000000..03b3c68 --- /dev/null +++ b/src/JobsJobsJobs/Server/Listings/Handlers.fs @@ -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 “{listing.Title}” 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 () + 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 () + 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 () 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 + ] + ] +] diff --git a/src/JobsJobsJobs/Server/Views/Listing.fs b/src/JobsJobsJobs/Server/Listings/Views.fs similarity index 98% rename from src/JobsJobsJobs/Server/Views/Listing.fs rename to src/JobsJobsJobs/Server/Listings/Views.fs index ddc0c0b..5f602bc 100644 --- a/src/JobsJobsJobs/Server/Views/Listing.fs +++ b/src/JobsJobsJobs/Server/Listings/Views.fs @@ -1,11 +1,10 @@ /// Views for /profile URLs -[] -module JobsJobsJobs.Views.Listing +module JobsJobsJobs.Listings.Views open Giraffe.ViewEngine +open JobsJobsJobs.Common.Views open JobsJobsJobs.Domain -open JobsJobsJobs.Domain.SharedTypes -open JobsJobsJobs.ViewModels +open JobsJobsJobs.Listings.Domain /// Job listing edit page diff --git a/src/JobsJobsJobs/Server/Profiles/Data.fs b/src/JobsJobsJobs/Server/Profiles/Data.fs new file mode 100644 index 0000000..4f28308 --- /dev/null +++ b/src/JobsJobsJobs/Server/Profiles/Data.fs @@ -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 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 row + Citizen = toDocumentFrom "cit_data" row + Continent = toDocumentFrom "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 row + let citizen = toDocumentFrom "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 row + let continent = toDocumentFrom "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}") + }) diff --git a/src/JobsJobsJobs/Server/Profiles/Domain.fs b/src/JobsJobsJobs/Server/Profiles/Domain.fs new file mode 100644 index 0000000..988bf27 --- /dev/null +++ b/src/JobsJobsJobs/Server/Profiles/Domain.fs @@ -0,0 +1,178 @@ +module JobsJobsJobs.Profiles.Domain + +open JobsJobsJobs.Domain +open NodaTime + +/// The fields required for a skill +[] +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 +[] +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 +[] +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 +[] +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 +[] +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 +[] +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 + } + diff --git a/src/JobsJobsJobs/Server/Profiles/Handlers.fs b/src/JobsJobsJobs/Server/Profiles/Handlers.fs new file mode 100644 index 0000000..8a32e05 --- /dev/null +++ b/src/JobsJobsJobs/Server/Profiles/Handlers.fs @@ -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 () + 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 () 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 () 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 + ] + ] diff --git a/src/JobsJobsJobs/Server/Views/Profile.fs b/src/JobsJobsJobs/Server/Profiles/Views.fs similarity index 94% rename from src/JobsJobsJobs/Server/Views/Profile.fs rename to src/JobsJobsJobs/Server/Profiles/Views.fs index 4703821..4937f95 100644 --- a/src/JobsJobsJobs/Server/Views/Profile.fs +++ b/src/JobsJobsJobs/Server/Profiles/Views.fs @@ -1,12 +1,11 @@ /// Views for /profile URLs -[] -module JobsJobsJobs.Views.Profile +module JobsJobsJobs.Profiles.Views open Giraffe.ViewEngine open Giraffe.ViewEngine.Htmx +open JobsJobsJobs.Common.Views open JobsJobsJobs.Domain -open JobsJobsJobs.Domain.SharedTypes -open JobsJobsJobs.ViewModels +open JobsJobsJobs.Profiles.Domain /// Render the skill edit template and existing skills let skillEdit (skills : SkillForm array) = @@ -39,7 +38,7 @@ let skillEdit (skills : SkillForm array) = :: (skills |> Array.mapi mapToInputs |> List.ofArray) /// The profile edit page -let edit (m : EditProfileViewModel) continents isNew citizenId csrf = +let edit (m : EditProfileForm) continents isNew citizenId csrf = pageWithTitle "My Employment Profile" [ form [ _class "row g-3"; _action "/profile/save"; _hxPost "/profile/save" ] [ antiForgery csrf @@ -276,38 +275,38 @@ let search (m : ProfileSearchForm) continents tz (results : ProfileSearchResult /// Profile view template -let view (citizen : Citizen) (profile : Profile) (continentName : string) currentId = +let view (it : ProfileForView) currentId = article [] [ h2 [] [ - str (Citizen.name citizen) - if profile.IsSeekingEmployment then + str (Citizen.name it.Citizen) + if it.Profile.IsSeekingEmployment then span [ _class "jjj-heading-label" ] [ txt "   "; span [ _class "badge bg-dark" ] [ txt "Currently Seeking Employment" ] ] ] - h4 [] [ str $"{continentName}, {profile.Region}" ] - contactInfo citizen (Option.isNone currentId) + h4 [] [ str $"{it.Continent.Name}, {it.Profile.Region}" ] + contactInfo it.Citizen (Option.isNone currentId) |> div [ _class "pb-3" ] p [] [ - txt (if profile.IsFullTime then "I" else "Not i"); txt "nterested in full-time employment • " - txt (if profile.IsRemote then "I" else "Not i"); txt "nterested in remote opportunities" + txt (if it.Profile.IsFullTime then "I" else "Not i"); txt "nterested in full-time employment • " + txt (if it.Profile.IsRemote then "I" else "Not i"); txt "nterested in remote opportunities" ] hr [] - div [] [ md2html profile.Biography ] - if not (List.isEmpty profile.Skills) then + div [] [ md2html it.Profile.Biography ] + if not (List.isEmpty it.Profile.Skills) then hr [] h4 [ _class "pb-3" ] [ txt "Skills" ] - profile.Skills + it.Profile.Skills |> List.map (fun skill -> li [] [ str skill.Description match skill.Notes with Some notes -> txt "  ("; str notes; txt ")" | None -> () ]) |> ul [] - match profile.Experience with + match it.Profile.Experience with | Some exp -> hr []; h4 [ _class "pb-3" ] [ txt "Experience / Employment History" ]; div [] [ md2html exp ] | None -> () - if Option.isSome currentId && currentId.Value = citizen.Id then + if Option.isSome currentId && currentId.Value = it.Citizen.Id then br []; br [] a [ _href "/profile/edit"; _class "btn btn-primary" ] [ i [ _class "mdi mdi-pencil" ] []; txt "  Edit Your Profile" diff --git a/src/JobsJobsJobs/Server/SuccessStories/Data.fs b/src/JobsJobsJobs/Server/SuccessStories/Data.fs new file mode 100644 index 0000000..67cb200 --- /dev/null +++ b/src/JobsJobsJobs/Server/SuccessStories/Data.fs @@ -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 row + let citizen = toDocumentFrom "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 Table.Success (SuccessId.toString successId) + +/// Save a success story +let save (success : Success) = + dataSource () |> saveDocument Table.Success (SuccessId.toString success.Id) <| mkDoc success diff --git a/src/JobsJobsJobs/Server/SuccessStories/Domain.fs b/src/JobsJobsJobs/Server/SuccessStories/Domain.fs new file mode 100644 index 0000000..a2a2d96 --- /dev/null +++ b/src/JobsJobsJobs/Server/SuccessStories/Domain.fs @@ -0,0 +1,50 @@ +module JobsJobsJobs.SuccessStories.Domain + +open JobsJobsJobs.Domain +open NodaTime + +/// The data required to provide a success story +[] +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 +[] +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 + } diff --git a/src/JobsJobsJobs/Server/SuccessStories/Handlers.fs b/src/JobsJobsJobs/Server/SuccessStories/Handlers.fs new file mode 100644 index 0000000..54618e9 --- /dev/null +++ b/src/JobsJobsJobs/Server/SuccessStories/Handlers.fs @@ -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 () + 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 ] + ] diff --git a/src/JobsJobsJobs/Server/Views/Success.fs b/src/JobsJobsJobs/Server/SuccessStories/Views.fs similarity index 96% rename from src/JobsJobsJobs/Server/Views/Success.fs rename to src/JobsJobsJobs/Server/SuccessStories/Views.fs index 7dee224..03b115a 100644 --- a/src/JobsJobsJobs/Server/Views/Success.fs +++ b/src/JobsJobsJobs/Server/SuccessStories/Views.fs @@ -1,11 +1,10 @@ /// Views for /success-stor[y|ies] URLs -[] -module JobsJobsJobs.Views.Success +module JobsJobsJobs.SuccessStories.Views open Giraffe.ViewEngine +open JobsJobsJobs.Common.Views open JobsJobsJobs.Domain -open JobsJobsJobs.Domain.SharedTypes -open JobsJobsJobs.ViewModels +open JobsJobsJobs.SuccessStories.Domain /// The add/edit success story page let edit (m : EditSuccessForm) isNew pgTitle csrf = diff --git a/src/JobsJobsJobs/Server/ViewModels.fs b/src/JobsJobsJobs/Server/ViewModels.fs deleted file mode 100644 index 6b6f415..0000000 --- a/src/JobsJobsJobs/Server/ViewModels.fs +++ /dev/null @@ -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 -[] -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 -[] -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 -[] -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 -[] -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 -[] -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 -[] -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 -[] -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 -[] -type ForgotPasswordForm = - { /// The e-mail address for the account wishing to reset their password - Email : string - } - - -/// View model for the log on page -[] -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 -[] -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 -[] -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 - } diff --git a/src/JobsJobsJobs/Server/Views/Common.fs b/src/JobsJobsJobs/Server/Views/Common.fs deleted file mode 100644 index 454fdec..0000000 --- a/src/JobsJobsJobs/Server/Views/Common.fs +++ /dev/null @@ -1,156 +0,0 @@ -[] -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 $"""– {defaultArg emptyLabel "Select"} –""" ] - :: (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 $"  %s{text}" ] - -/// An empty paragraph -let emptyP = - p [] [ txt " " ] - -/// 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 "   " - 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()}" diff --git a/src/JobsJobsJobs/Server/Views/Layout.fs b/src/JobsJobsJobs/Server/Views/Layout.fs deleted file mode 100644 index 072dba5..0000000 --- a/src/JobsJobsJobs/Server/Views/Layout.fs +++ /dev/null @@ -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 " " ] - span [ _class "navbar-text" ] [ - txt "(…and Jobs – "; audioClip "pelosi-jobs" (txt "Let’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} • " - a [ _href "/privacy-policy" ] [ txt "Privacy Policy" ]; txt " • " - 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 - ] - ] - ]