From 7d2a2a50eb1666a748652776fd07c66dbcac4e2b Mon Sep 17 00:00:00 2001 From: "Daniel J. Summers" Date: Tue, 12 Jul 2022 12:44:38 -0400 Subject: [PATCH 01/67] Complete RethinkDB F# driver implementation (#34) - Add toString for markdown strings --- src/JobsJobsJobs/Domain/Modules.fs | 23 +++ src/JobsJobsJobs/Domain/SharedTypes.fs | 72 ++++++++- src/JobsJobsJobs/Domain/Types.fs | 36 +++++ src/JobsJobsJobs/Server/Data.fs | 210 ++++++++++++------------- 4 files changed, 230 insertions(+), 111 deletions(-) diff --git a/src/JobsJobsJobs/Domain/Modules.fs b/src/JobsJobsJobs/Domain/Modules.fs index 5d062cf..2fc9f76 100644 --- a/src/JobsJobsJobs/Domain/Modules.fs +++ b/src/JobsJobsJobs/Domain/Modules.fs @@ -17,16 +17,20 @@ let private fromShortGuid (it : string) = /// 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 -> toShortGuid it + /// Parse a string into a citizen ID let ofString = fromShortGuid >> CitizenId /// Support functions for citizens module Citizen = + /// Get the name of the citizen (the first of real name, display name, or handle that is filled in) let name x = [ x.realName; x.displayName; Some x.mastodonUser ] @@ -36,34 +40,46 @@ module Citizen = /// 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 -> toShortGuid it + /// Parse a string into a continent ID let ofString = fromShortGuid >> ContinentId /// 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 -> toShortGuid it + /// Parse a string into a listing ID let ofString = fromShortGuid >> ListingId /// Support functions for Markdown strings module MarkdownString = + /// 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 /// Support functions for Profiles module Profile = + // An empty profile let empty = { id = CitizenId Guid.Empty @@ -79,21 +95,28 @@ module Profile = skills = [] } + /// Support functions for skill IDs module SkillId = + /// Create a new skill ID let create () = (Guid.NewGuid >> SkillId) () + /// A string representation of a skill ID let toString = function SkillId it -> toShortGuid it + /// Parse a string into a skill ID let ofString = fromShortGuid >> SkillId /// 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 -> toShortGuid it + /// Parse a string into a success report ID let ofString = fromShortGuid >> SuccessId diff --git a/src/JobsJobsJobs/Domain/SharedTypes.fs b/src/JobsJobsJobs/Domain/SharedTypes.fs index 81a60fa..d52a101 100644 --- a/src/JobsJobsJobs/Domain/SharedTypes.fs +++ b/src/JobsJobsJobs/Domain/SharedTypes.fs @@ -11,16 +11,22 @@ open NodaTime type ListingForm = { /// 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 option } @@ -30,6 +36,7 @@ type ListingForm = type ListingForView = { /// The listing itself listing : Listing + /// The continent for that listing continent : Continent } @@ -39,6 +46,7 @@ type ListingForView = type ListingExpireForm = { /// Whether the job was filled from here fromHere : bool + /// The success story written by the user successStory : string option } @@ -49,10 +57,13 @@ type ListingExpireForm = type ListingSearch = { /// Retrieve job listings for this continent continentId : string option + /// Text for a search within a region region : string option + /// Whether to retrieve job listings for remote work remoteWork : string + /// Text for a search with the job listing description text : string option } @@ -62,8 +73,10 @@ type ListingSearch = type LogOnSuccess = { /// The JSON Web Token (JWT) to use for API access jwt : string + /// The ID of the logged-in citizen (as a string) citizenId : string + /// The name of the logged-in citizen name : string } @@ -78,30 +91,41 @@ type Count = /// An instance of a Mastodon server which is configured to work with Jobs, Jobs, Jobs type MastodonInstance () = + /// The name of the instance member val Name = "" with get, set + /// The URL for this instance member val Url = "" with get, set + /// The abbreviation used in the URL to distinguish this instance's return codes member val Abbr = "" with get, set + /// The client ID (assigned by the Mastodon server) member val ClientId = "" with get, set + /// The cryptographic secret (provided by the Mastodon server) member val Secret = "" with get, set + /// Whether the instance is currently enabled member val IsEnabled = true with get, set + /// If an instance is disabled, the reason for it being disabled member val Reason = "" with get, set /// The authorization options for Jobs, Jobs, Jobs type AuthOptions () = + /// The host for the return URL for Mastodon verification member val ReturnHost = "" with get, set + /// The secret with which the server signs the JWTs for auth once we've verified with Mastodon member val ServerSecret = "" with get, set + /// The instances configured for use member val Instances = Array.empty with get, set + interface IOptions with override this.Value = this @@ -110,14 +134,19 @@ type AuthOptions () = type Instance = { /// The name of the instance name : string + /// The URL for this instance url : string + /// The abbreviation used in the URL to distinguish this instance's return codes abbr : string + /// The client ID (assigned by the Mastodon server) clientId : string + /// Whether this instance is currently enabled isEnabled : bool + /// If not enabled, the reason the instance is disabled reason : string } @@ -127,8 +156,10 @@ type Instance = type SkillForm = { /// The ID of this skill id : string + /// The description of the skill description : string + /// Notes regarding the skill notes : string option } @@ -138,30 +169,40 @@ type SkillForm = type ProfileForm = { /// Whether the citizen to whom this profile belongs is actively seeking employment isSeekingEmployment : bool + /// Whether this profile should appear in the public search isPublic : bool + /// The user's real name realName : string + /// 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 user's past experience experience : string option + /// The skills for the user skills : SkillForm list } /// Support functions for the ProfileForm type module ProfileForm = - /// Create an instance of this form from the given profile - let fromProfile (profile : Types.Profile) = + + /// Create an instance of this form from the given profile + let fromProfile (profile : Types.Profile) = { isSeekingEmployment = profile.seekingEmployment isPublic = profile.isPublic realName = "" @@ -169,8 +210,8 @@ module ProfileForm = region = profile.region remoteWork = profile.remoteWork fullTime = profile.fullTime - biography = match profile.biography with Text bio -> bio - experience = profile.experience |> Option.map (fun x -> match x with Text exp -> exp) + biography = MarkdownString.toString profile.biography + experience = profile.experience |> Option.map MarkdownString.toString skills = profile.skills |> List.map (fun s -> { id = string s.id @@ -185,10 +226,13 @@ module ProfileForm = type ProfileSearch = { /// Retrieve citizens from this continent continentId : string option + /// Text for a search within a citizen's skills skill : string option + /// Text for a search with a citizen's professional biography and experience fields bioExperience : string option + /// Whether to retrieve citizens who do or do not want remote work remoteWork : string } @@ -198,14 +242,19 @@ type ProfileSearch = 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 } @@ -215,8 +264,10 @@ type ProfileSearchResult = type ProfileForView = { /// The profile itself profile : Profile + /// The citizen to whom the profile belongs citizen : Citizen + /// The continent for the profile continent : Continent } @@ -227,10 +278,13 @@ type ProfileForView = type PublicSearch = { /// Retrieve citizens from this continent continentId : string option + /// Retrieve citizens from this region region : string option + /// Text for a search within a citizen's skills skill : string option + /// Whether to retrieve citizens who do or do not want remote work remoteWork : string } @@ -250,10 +304,13 @@ module PublicSearch = 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 } @@ -263,8 +320,10 @@ type PublicSearchResult = type StoryForm = { /// The ID of this story id : string + /// Whether the employment was obtained from Jobs, Jobs, Jobs fromHere : bool + /// The success story story : string } @@ -274,14 +333,19 @@ type StoryForm = 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/Types.fs b/src/JobsJobsJobs/Domain/Types.fs index eefae0d..e881233 100644 --- a/src/JobsJobsJobs/Domain/Types.fs +++ b/src/JobsJobsJobs/Domain/Types.fs @@ -14,18 +14,25 @@ type CitizenId = CitizenId of Guid type Citizen = { /// The ID of the user id : CitizenId + /// The Mastodon instance abbreviation from which this citizen is authorized instance : string + /// The handle by which the user is known on Mastodon mastodonUser : string + /// The user's display name from Mastodon (updated every login) displayName : string option + /// The user's real name realName : string option + /// The URL for the user's Mastodon profile profileUrl : string + /// When the user joined Jobs, Jobs, Jobs joinedOn : Instant + /// When the user last logged in lastSeenOn : Instant } @@ -39,6 +46,7 @@ type ContinentId = ContinentId of Guid type Continent = { /// The ID of the continent id : ContinentId + /// The name of the continent name : string } @@ -56,26 +64,37 @@ type ListingId = ListingId of Guid 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 remoteWork : 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 } @@ -88,8 +107,10 @@ type SkillId = SkillId of Guid type Skill = { /// The ID of the skill id : SkillId + /// A description of the skill description : string + /// Notes regarding this skill (level, duration, etc.) notes : string option } @@ -100,24 +121,34 @@ type Skill = type Profile = { /// The ID of the citizen to whom this profile belongs id : CitizenId + /// Whether this citizen is actively seeking employment seekingEmployment : bool + /// Whether this citizen allows their profile to be a part of the publicly-viewable, anonymous data isPublic : 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 remoteWork : bool + /// Whether the citizen is looking for full-time work fullTime : 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 } @@ -130,14 +161,19 @@ type SuccessId = SuccessId of Guid 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 fromHere : bool + /// The source of this success (listing or profile) source : string + /// The success story story : MarkdownString option } diff --git a/src/JobsJobsJobs/Server/Data.fs b/src/JobsJobsJobs/Server/Data.fs index 772e1b6..30fd8c4 100644 --- a/src/JobsJobsJobs/Server/Data.fs +++ b/src/JobsJobsJobs/Server/Data.fs @@ -31,8 +31,7 @@ module Converters = type MarkdownStringJsonConverter() = inherit JsonConverter() override _.WriteJson(writer : JsonWriter, value : MarkdownString, _ : JsonSerializer) = - let (Text text) = value - writer.WriteValue text + writer.WriteValue (MarkdownString.toString value) override _.ReadJson(reader: JsonReader, _ : Type, _ : MarkdownString, _ : bool, _ : JsonSerializer) = (string >> Text) reader.Value @@ -75,16 +74,22 @@ module Converters = /// Table names [] module Table = + /// The user (citizen of Gitmo Nation) table let Citizen = "citizen" + /// The continent table let Continent = "continent" + /// The job listing table let Listing = "listing" + /// The citizen employment profile table let Profile = "profile" + /// The success story table let Success = "success" + /// All tables let all () = [ Citizen; Continent; Listing; Profile; Success ] @@ -166,7 +171,7 @@ module Startup = let! userIdx = fromTable Table.Citizen |> indexList |> result conn if not (List.contains "instanceUser" userIdx) then do! fromTable Table.Citizen - |> indexCreateFunc "instanceUser" (fun row -> r.Array (row.G "instance", row.G "mastodonUser")) + |> indexCreateFunc "instanceUser" (fun row -> [| row.G "instance"; row.G "mastodonUser" |]) |> write conn } @@ -175,7 +180,21 @@ open JobsJobsJobs.Domain open JobsJobsJobs.Domain.SharedTypes /// Sanitize user input, and create a "contains" pattern for use with RethinkDB queries -let regexContains = System.Text.RegularExpressions.Regex.Escape >> sprintf "(?i)%s" +let private regexContains = System.Text.RegularExpressions.Regex.Escape >> sprintf "(?i)%s" + +/// Apply filters to a query, ensuring that types all match up +let private applyFilters (filters : (ReqlExpr -> Filter) list) query : ReqlExpr = + if List.isEmpty filters then + query + else + let first = List.head filters query + List.fold (fun q (f : ReqlExpr -> Filter) -> f q) first (List.tail filters) + +/// Derive a user's display name from real name, display name, or handle (in that order) +let private deriveDisplayName (it : ReqlExpr) = + r.Branch (it.G("realName" ).Default_("").Ne "", it.G "realName", + it.G("displayName").Default_("").Ne "", it.G "displayName", + it.G "mastodonUser") /// Profile data access functions [] @@ -209,75 +228,62 @@ module Profile = /// Search profiles (logged-on users) let search (search : ProfileSearch) conn = - (seq ReqlExpr> { - match search.continentId with - | Some cId -> yield (fun q -> q.Filter (r.HashMap (nameof search.continentId, ContinentId.ofString cId))) - | None -> () - match search.remoteWork with - | "" -> () - | _ -> yield (fun q -> q.Filter (r.HashMap (nameof search.remoteWork, search.remoteWork = "yes"))) - match search.skill with - | Some skl -> - yield (fun q -> q.Filter (ReqlFunction1(fun it -> - it.G("skills").Contains (ReqlFunction1(fun s -> s.G("description").Match (regexContains skl)))))) - | None -> () - match search.bioExperience with - | Some text -> - let txt = regexContains text - yield (fun q -> q.Filter (ReqlFunction1(fun it -> - it.G("biography").Match(txt).Or (it.G("experience").Match txt)))) - | None -> () - } - |> Seq.toList - |> List.fold - (fun q f -> f q) - (r.Table(Table.Profile) - .EqJoin("id", r.Table Table.Citizen) - .Without(r.HashMap ("right", "id")) - .Zip () :> ReqlExpr)) - |> mergeFunc (fun it -> - r.HashMap("displayName", - r.Branch (it.G("realName" ).Default_("").Ne "", it.G "realName", - it.G("displayName").Default_("").Ne "", it.G "displayName", - it.G "mastodonUser")) - .With ("citizenId", it.G "id")) + fromTable Table.Profile + |> eqJoin "id" (fromTable Table.Citizen) + |> without [ "right.id" ] + |> zip + |> applyFilters + [ match search.continentId with + | Some contId -> yield filter {| continentId = ContinentId.ofString contId |} + | None -> () + match search.remoteWork with + | "" -> () + | _ -> yield filter {| remoteWork = search.remoteWork = "yes" |} + match search.skill with + | Some skl -> + yield filterFunc (fun it -> + it.G("skills").Contains (ReqlFunction1 (fun s -> s.G("description").Match (regexContains skl)))) + | None -> () + match search.bioExperience with + | Some text -> + let txt = regexContains text + yield filterFunc (fun it -> it.G("biography").Match(txt).Or (it.G("experience").Match txt)) + | None -> () + ] + |> mergeFunc (fun it -> {| displayName = deriveDisplayName it; citizenId = it.G "id" |}) |> pluck [ "citizenId"; "displayName"; "seekingEmployment"; "remoteWork"; "fullTime"; "lastUpdatedOn" ] |> orderByFunc (fun it -> it.G("displayName").Downcase ()) |> result conn // Search profiles (public) let publicSearch (search : PublicSearch) conn = - (seq ReqlExpr> { - match search.continentId with - | Some cId -> yield (fun q -> q.Filter (r.HashMap (nameof search.continentId, ContinentId.ofString cId))) - | None -> () - match search.region with - | Some reg -> - yield (fun q -> q.Filter (ReqlFunction1 (fun it -> upcast it.G("region").Match (regexContains reg)))) - | None -> () - match search.remoteWork with - | "" -> () - | _ -> yield (fun q -> q.Filter (r.HashMap (nameof search.remoteWork, search.remoteWork = "yes"))) - match search.skill with - | Some skl -> - yield (fun q -> q.Filter (ReqlFunction1 (fun it -> - it.G("skills").Contains (ReqlFunction1(fun s -> s.G("description").Match (regexContains skl)))))) - | None -> () - } - |> Seq.toList - |> List.fold - (fun q f -> f q) - (r.Table(Table.Profile) - .EqJoin("continentId", r.Table Table.Continent) - .Without(r.HashMap ("right", "id")) - .Zip() - .Filter(r.HashMap ("isPublic", true)))) + fromTable Table.Profile + |> eqJoin "continentId" (fromTable Table.Continent) + |> without [ "right.id" ] + |> zip + |> applyFilters + [ yield filter {| isPublic = true |} + match search.continentId with + | Some contId -> yield filter {| continentId = ContinentId.ofString contId |} + | None -> () + match search.region with + | Some reg -> yield filterFunc (fun it -> it.G("region").Match (regexContains reg)) + | None -> () + match search.remoteWork with + | "" -> () + | _ -> yield filter {| remoteWork = search.remoteWork = "yes" |} + match search.skill with + | Some skl -> + yield filterFunc (fun it -> + it.G("skills").Contains (ReqlFunction1 (fun s -> s.G("description").Match (regexContains skl)))) + | None -> () + ] |> mergeFunc (fun it -> - r.HashMap("skills", - it.G("skills").Map (ReqlFunction1 (fun skill -> - r.Branch(skill.G("notes").Default_("").Eq "", skill.G "description", - skill.G("description").Add(" (").Add(skill.G("notes")).Add ")")))) - .With("continent", it.G "name")) + {| skills = it.G("skills").Map (ReqlFunction1 (fun skill -> + r.Branch(skill.G("notes").Default_("").Eq "", skill.G "description", + skill.G("description").Add(" (").Add(skill.G("notes")).Add ")"))) + continent = it.G "name" + |}) |> pluck [ "continent"; "region"; "skills"; "remoteWork" ] |> result conn @@ -295,7 +301,7 @@ module Citizen = let findByMastodonUser (instance : string) (mastodonUser : string) conn = task { let! u = fromTable Table.Citizen - |> getAllWithIndex [ r.Array (instance, mastodonUser) ] "instanceUser" + |> getAllWithIndex [ [| instance; mastodonUser |] ] "instanceUser" |> limit 1 |> result conn return List.tryHead u @@ -311,8 +317,7 @@ module Citizen = let logOnUpdate (citizen : Citizen) conn = fromTable Table.Citizen |> get citizen.id - |> update (r.HashMap( nameof citizen.displayName, citizen.displayName) - .With (nameof citizen.lastSeenOn, citizen.lastSeenOn)) + |> update {| displayName = citizen.displayName; lastSeenOn = citizen.lastSeenOn |} |> write conn /// Delete a citizen @@ -336,7 +341,7 @@ module Citizen = let realNameUpdate (citizenId : CitizenId) (realName : string option) conn = fromTable Table.Citizen |> get citizenId - |> update (r.HashMap (nameof realName, realName)) + |> update {| realName = realName |} |> write conn @@ -362,12 +367,15 @@ module Listing = open NodaTime + /// Convert a joined query to the form needed for ListingForView deserialization + let private toListingForView (it : ReqlExpr) : obj = {| listing = it.G "left"; continent = it.G "right" |} + /// Find all job listings posted by the given citizen let findByCitizen (citizenId : CitizenId) conn = fromTable Table.Listing |> getAllWithIndex [ citizenId ] (nameof citizenId) |> eqJoin "continentId" (fromTable Table.Continent) - |> mapFunc (fun it -> r.HashMap("listing", it.G "left").With ("continent", it.G "right")) + |> mapFunc toListingForView |> result conn /// Find a listing by its ID @@ -380,9 +388,9 @@ module Listing = let findByIdForView (listingId : ListingId) conn = task { let! listing = fromTable Table.Listing - |> filter (r.HashMap ("id", listingId)) + |> filter {| id = listingId |} |> eqJoin "continentId" (fromTable Table.Continent) - |> mapFunc (fun it -> r.HashMap("listing", it.G "left").With ("continent", it.G "right")) + |> mapFunc toListingForView |> result conn return List.tryHead listing } @@ -404,36 +412,29 @@ module Listing = let expire (listingId : ListingId) (fromHere : bool) (now : Instant) conn = (fromTable Table.Listing |> get listingId) - .Update (r.HashMap("isExpired", true).With("wasFilledHere", fromHere).With ("updatedOn", now)) + .Update {| isExpired = true; wasFilledHere = fromHere; updatedOn = now |} |> write conn /// Search job listings let search (search : ListingSearch) conn = - (seq ReqlExpr> { - match search.continentId with - | Some cId -> yield (fun q -> q.Filter (r.HashMap (nameof search.continentId, ContinentId.ofString cId))) - | None -> () - match search.region with - | Some rgn -> - yield (fun q -> - q.Filter (ReqlFunction1 (fun it -> it.G(nameof search.region).Match (regexContains rgn)))) - | None -> () - match search.remoteWork with - | "" -> () - | _ -> yield (fun q -> q.Filter (r.HashMap (nameof search.remoteWork, search.remoteWork = "yes"))) - match search.text with - | Some text -> - yield (fun q -> - q.Filter (ReqlFunction1 (fun it -> it.G(nameof search.text).Match (regexContains text)))) - | None -> () - } - |> Seq.toList - |> List.fold - (fun q f -> f q) - (fromTable Table.Listing - |> getAllWithIndex [ false ] "isExpired" :> ReqlExpr)) + fromTable Table.Listing + |> getAllWithIndex [ false ] "isExpired" + |> applyFilters + [ match search.continentId with + | Some contId -> yield filter {| continentId = ContinentId.ofString contId |} + | None -> () + match search.region with + | Some rgn -> yield filterFunc (fun it -> it.G(nameof search.region).Match (regexContains rgn)) + | None -> () + match search.remoteWork with + | "" -> () + | _ -> yield filter {| remoteWork = search.remoteWork = "yes" |} + match search.text with + | Some text -> yield filterFunc (fun it -> it.G(nameof search.text).Match (regexContains text)) + | None -> () + ] |> eqJoin "continentId" (fromTable Table.Continent) - |> mapFunc (fun it -> r.HashMap("listing", it.G "left").With ("continent", it.G "right")) + |> mapFunc toListingForView |> result conn @@ -456,16 +457,11 @@ module Success = // Retrieve all success stories let all conn = - (fromTable Table.Success - |> eqJoin "citizenId" (fromTable Table.Citizen)) - .Without(r.HashMap ("right", "id")) + fromTable Table.Success + |> eqJoin "citizenId" (fromTable Table.Citizen) + |> without [ "right.id" ] |> zip - |> mergeFunc (fun it -> - r.HashMap("citizenName", - r.Branch(it.G("realName" ).Default_("").Ne "", it.G "realName", - it.G("displayName").Default_("").Ne "", it.G "displayName", - it.G "mastodonUser")) - .With ("hasStory", it.G("story").Default_("").Gt "")) + |> mergeFunc (fun it -> {| citizenName = deriveDisplayName it; hasStory = it.G("story").Default_("").Gt "" |}) |> pluck [ "id"; "citizenId"; "citizenName"; "recordedOn"; "fromHere"; "hasStory" ] |> orderByDescending "recordedOn" |> result conn -- 2.45.1 From 55a835f9b39b63284c4e2b57f75f3a5da22ec5eb Mon Sep 17 00:00:00 2001 From: "Daniel J. Summers" Date: Sun, 21 Aug 2022 23:51:29 -0400 Subject: [PATCH 02/67] WIP on PostgreSQL (#37) --- .gitignore | 1 + src/JobsJobsJobs/Domain/Types.fs | 6 +- src/JobsJobsJobs/Server/Data.fs | 233 +++++++++++++----- .../Server/JobsJobsJobs.Server.fsproj | 3 + 4 files changed, 177 insertions(+), 66 deletions(-) diff --git a/.gitignore b/.gitignore index 504cdc7..2d0cfe8 100644 --- a/.gitignore +++ b/.gitignore @@ -1,5 +1,6 @@ .ionide .fake +.idea src/**/bin src/**/obj src/**/appsettings.*.json diff --git a/src/JobsJobsJobs/Domain/Types.fs b/src/JobsJobsJobs/Domain/Types.fs index e881233..304ec06 100644 --- a/src/JobsJobsJobs/Domain/Types.fs +++ b/src/JobsJobsJobs/Domain/Types.fs @@ -7,7 +7,11 @@ open System // fsharplint:disable FieldNames /// The ID of a user (a citizen of Gitmo Nation) -type CitizenId = CitizenId of Guid +type CitizenId = + CitizenId of Guid +with + /// The GUID value of this citizen ID + member this.Value = this |> function CitizenId guid -> guid /// A user of Jobs, Jobs, Jobs [] diff --git a/src/JobsJobsJobs/Server/Data.fs b/src/JobsJobsJobs/Server/Data.fs index 30fd8c4..92b034b 100644 --- a/src/JobsJobsJobs/Server/Data.fs +++ b/src/JobsJobsJobs/Server/Data.fs @@ -1,6 +1,7 @@ /// Data access functions for Jobs, Jobs, Jobs module JobsJobsJobs.Api.Data +open CommonExtensionsAndTypesForNpgsqlFSharp open JobsJobsJobs.Domain.Types /// JSON converters used with RethinkDB persistence @@ -87,12 +88,20 @@ module Table = /// The citizen employment profile table let Profile = "profile" + /// The profile / skill cross-reference + let ProfileSkill = "profile_skill" + /// The success story table let Success = "success" /// All tables let all () = [ Citizen; Continent; Listing; Profile; Success ] +open NodaTime +open Npgsql +open Npgsql.FSharp + + open RethinkDb.Driver.FSharp.Functions open RethinkDb.Driver.Net @@ -122,7 +131,6 @@ module Startup = open Microsoft.Extensions.Configuration open Microsoft.Extensions.Logging - open NodaTime open NodaTime.Serialization.JsonNet open RethinkDb.Driver.FSharp @@ -137,42 +145,93 @@ module Startup = log.LogInformation $"Connecting to rethinkdb://{config.Hostname}:{config.Port}/{config.Database}" config.CreateConnection () - /// Ensure the data, tables, and indexes that are required exist - let establishEnvironment (cfg : IConfigurationSection) (log : ILogger) conn = task { - // Ensure the database exists - match cfg["database"] |> Option.ofObj with - | Some database -> - let! dbs = dbList () |> result conn - match dbs |> List.contains database with - | true -> () - | false -> - log.LogInformation $"Creating database {database}..." - do! dbCreate database |> write conn - () - | None -> () - // Ensure the tables exist - let! tables = tableListFromDefault () |> result conn - for table in Table.all () do - if not (List.contains table tables) then - log.LogInformation $"Creating {table} table..." - do! tableCreateInDefault table |> write conn - // Ensure the indexes exist - let ensureIndexes table indexes = task { - let! tblIndexes = fromTable table |> indexList |> result conn - for index in indexes do - if not (List.contains index tblIndexes) then - log.LogInformation $"Creating \"{index}\" index on {table}" - do! fromTable table |> indexCreate index |> write conn + /// Ensure the tables and indexes that are required exist + let establishEnvironment (log : ILogger) conn = task { + + let! tables = + Sql.existingConnection conn + |> Sql.query "SELECT tablename FROM pg_tables WHERE schemaname = 'jjj'" + |> Sql.executeAsync (fun row -> row.string "tablename") + let needsTable table = not (List.contains table tables) + + let sql = seq { + if needsTable "continent" then + "CREATE TABLE jjj.continent ( + id UUID NOT NULL PRIMARY KEY, + name TEXT NOT NULL)" + if needsTable "citizen" then + "CREATE TABLE jjj.citizen ( + id UUID NOT NULL PRIMARY KEY, + display_name TEXT, + profile_urls TEXT[] NOT NULL DEFAULT '{}', + joined_on TIMESTAMPTZ NOT NULL, + last_seen_on TIMESTAMPTZ NOT NULL, + is_legacy BOOLEAN NOT NULL)" + if needsTable "profile" then + "CREATE TABLE jjj.profile ( + citizen_id UUID NOT NULL PRIMARY KEY, + is_seeking BOOLEAN NOT NULL, + is_public_searchable BOOLEAN NOT NULL, + is_public_linkable BOOLEAN NOT NULL, + continent_id UUID NOT NULL, + region TEXT NOT NULL, + is_available_remote BOOLEAN NOT NULL, + is_available_full_time BOOLEAN NOT NULL, + biography TEXT NOT NULL, + last_updated_on TIMESTAMPTZ NOT NULL, + experience TEXT, + FOREIGN KEY fk_profile_citizen (citizen_id) REFERENCES jjj.citizen (id) ON DELETE CASCADE, + FOREIGN KEY fk_profile_continent (continent_id) REFERENCES jjj.continent (id))" + "CREATE INDEX idx_profile_citizen ON jjj.profile (citizen_id)" + "CREATE INDEX idx_profile_continent ON jjj.profile (continent_id)" + "CREATE TABLE jjj.profile_skill ( + id UUID NOT NULL PRIMARY KEY, + citizen_id UUID NOT NULL, + description TEXT NOT NULL, + notes TEXT, + FOREIGN KEY fk_profile_skill_profile (citizen_id) REFERENCES jjj.profile (citizen_id) + ON DELETE CASCADE)" + "CREATE INDEX idx_profile_skill_profile ON jjj.profile_skill (citizen_id)" + if needsTable "listing" then + "CREATE TABLE jjj.listing ( + id UUID NOT NULL PRIMARY KEY, + citizen_id UUID NOT NULL, + created_on TIMESTAMPTZ NOT NULL, + title TEXT NOT NULL, + continent_id UUID NOT NULL, + region TEXT NOT NULL, + is_remote BOOLEAN NOT NULL, + is_expired BOOLEAN NOT NULL, + updated_on TIMESTAMPTZ NOT NULL, + listing_text TEXT NOT NULL, + needed_by DATE, + was_filled_here BOOLEAN, + FOREIGN KEY fk_listing_citizen (citizen_id) REFERENCES jjj.citizen (id) ON DELETE CASCADE, + FOREIGN KEY fk_listing_continent (continent_id) REFERENCES jjj.continent (id))" + "CREATE INDEX idx_listing_citizen ON jjj.listing (citizen_id)" + "CREATE INDEX idx_listing_continent ON jjj.listing (continent_id)" + if needsTable "success" then + "CREATE TABLE jjj.success ( + id UUID NOT NULL PRIMARY KEY, + citizen_id UUID NOT NULL, + recorded_on TIMESTAMPTZ NOT NULL, + was_from_here BOOLEAN NOT NULL, + source TEXT NOT NULL, + story TEXT, + FOREIGN KEY fk_success_citizen (citizen_id) REFERENCES jjj.citizen (id) ON DELETE CASCADE)" + "CREATE INDEX idx_success_citizen ON jjj.success (citizen_id)" } - do! ensureIndexes Table.Listing [ "citizenId"; "continentId"; "isExpired" ] - do! ensureIndexes Table.Profile [ "continentId" ] - do! ensureIndexes Table.Success [ "citizenId" ] - // The instance/user is a compound index - let! userIdx = fromTable Table.Citizen |> indexList |> result conn - if not (List.contains "instanceUser" userIdx) then - do! fromTable Table.Citizen - |> indexCreateFunc "instanceUser" (fun row -> [| row.G "instance"; row.G "mastodonUser" |]) - |> write conn + if not (Seq.isEmpty sql) then + let! _ = + Sql.existingConnection conn + |> Sql.executeTransactionAsync + (sql + |> Seq.map (fun it -> + let parts = it.Split ' ' + log.LogInformation $"Creating {parts[2]} {parts[1].ToLowerInvariant ()}..." + it, [ [] ]) + |> List.ofSeq) + () } @@ -196,22 +255,72 @@ let private deriveDisplayName (it : ReqlExpr) = it.G("displayName").Default_("").Ne "", it.G "displayName", it.G "mastodonUser") +/// Map data results to domain types +module Map = + + /// Extract a count from a row + let toCount (row : RowReader) = + row.int64 "the_count" + + /// Create a profile from a data row + let toProfile (row : RowReader) : Profile = + { id = CitizenId (row.uuid "citizen_id") + seekingEmployment = row.bool "is_seeking" + isPublic = row.bool "is_public_searchable" + continentId = ContinentId (row.uuid "continent_id") + region = row.string "region" + remoteWork = row.bool "is_available_remote" + fullTime = row.bool "is_available_full_time" + biography = Text (row.string "biography") + lastUpdatedOn = row.fieldValue "last_updated_on" + experience = row.stringOrNone "experience" |> Option.map Text + skills = [] + } + + /// Create a skill from a data row + let toSkill (row : RowReader) : Skill = + { id = SkillId (row.uuid "id") + description = row.string "description" + notes = row.stringOrNone "notes" + } + + /// Profile data access functions [] module Profile = /// Count the current profiles let count conn = - fromTable Table.Profile - |> count - |> result conn + Sql.existingConnection conn + |> Sql.query + "SELECT COUNT(p.citizen_id) + FROM jjj.profile p + INNER JOIN jjj.citizen c ON c.id = p.citizen_id + WHERE c.is_legacy = FALSE" + |> Sql.executeRowAsync Map.toCount /// Find a profile by citizen ID - let findById (citizenId : CitizenId) conn = - fromTable Table.Profile - |> get citizenId - |> resultOption conn - + let findById (citizenId : CitizenId) conn = backgroundTask { + let! tryProfile = + Sql.existingConnection conn + |> Sql.query + "SELECT * + FROM jjj.profile p + INNER JOIN jjj.citizen ON c.id = p.citizen_id + WHERE p.citizen_id = @id + AND c.is_legacy = FALSE" + |> Sql.parameters [ "@id", Sql.uuid citizenId.Value ] + |> Sql.executeAsync Map.toProfile + match List.tryHead tryProfile with + | Some profile -> + let! skills = + Sql.existingConnection conn + |> Sql.query "SELECT * FROM jjj.profile_skill WHERE citizen_id = @id" + |> Sql.parameters [ "@id", Sql.uuid citizenId.Value ] + |> Sql.executeAsync Map.toSkill + return Some { profile with skills = skills } + | None -> return None + } /// Insert or update a profile let save (profile : Profile) conn = fromTable Table.Profile @@ -220,11 +329,14 @@ module Profile = |> write conn /// Delete a citizen's profile - let delete (citizenId : CitizenId) conn = - fromTable Table.Profile - |> get citizenId - |> delete - |> write conn + let delete (citizenId : CitizenId) conn = backgroundTask { + let! _ = + Sql.existingConnection conn + |> Sql.query "DELETE FROM jjj.profile WHERE citizen_id = @id" + |> Sql.parameters [ "@id", Sql.uuid citizenId.Value ] + |> Sql.executeNonQueryAsync + () + } /// Search profiles (logged-on users) let search (search : ProfileSearch) conn = @@ -321,20 +433,13 @@ module Citizen = |> write conn /// Delete a citizen - let delete citizenId conn = task { - do! Profile.delete citizenId conn - do! fromTable Table.Success - |> getAllWithIndex [ citizenId ] "citizenId" - |> delete - |> write conn - do! fromTable Table.Listing - |> getAllWithIndex [ citizenId ] "citizenId" - |> delete - |> write conn - do! fromTable Table.Citizen - |> get citizenId - |> delete - |> write conn + let delete (citizenId : CitizenId) conn = backgroundTask { + let! _ = + Sql.existingConnection conn + |> Sql.query "DELETE FROM citizen WHERE id = @id" + |> Sql.parameters [ "@id", Sql.uuid citizenId.Value ] + |> Sql.executeNonQueryAsync + () } /// Update a citizen's real name @@ -365,8 +470,6 @@ module Continent = [] module Listing = - open NodaTime - /// Convert a joined query to the form needed for ListingForView deserialization let private toListingForView (it : ReqlExpr) : obj = {| listing = it.G "left"; continent = it.G "right" |} diff --git a/src/JobsJobsJobs/Server/JobsJobsJobs.Server.fsproj b/src/JobsJobsJobs/Server/JobsJobsJobs.Server.fsproj index 071dae9..f398460 100644 --- a/src/JobsJobsJobs/Server/JobsJobsJobs.Server.fsproj +++ b/src/JobsJobsJobs/Server/JobsJobsJobs.Server.fsproj @@ -27,6 +27,9 @@ + + + -- 2.45.1 From 1d928b631b5b068f4065a95c3d2857a0cc11fed4 Mon Sep 17 00:00:00 2001 From: "Daniel J. Summers" Date: Mon, 22 Aug 2022 22:50:50 -0400 Subject: [PATCH 03/67] WIP on PostgreSQL (#37) --- src/JobsJobsJobs/Domain/Modules.fs | 16 ++ src/JobsJobsJobs/Domain/Types.fs | 9 +- src/JobsJobsJobs/Server/Data.fs | 399 +++++++++++++++++++++-------- 3 files changed, 311 insertions(+), 113 deletions(-) diff --git a/src/JobsJobsJobs/Domain/Modules.fs b/src/JobsJobsJobs/Domain/Modules.fs index 2fc9f76..5e944d7 100644 --- a/src/JobsJobsJobs/Domain/Modules.fs +++ b/src/JobsJobsJobs/Domain/Modules.fs @@ -26,6 +26,9 @@ module CitizenId = /// Parse a string into a citizen ID let ofString = fromShortGuid >> CitizenId + + /// Get the GUID value of a citizen ID + let value = function CitizenId guid -> guid /// Support functions for citizens @@ -49,6 +52,9 @@ module ContinentId = /// Parse a string into a continent ID let ofString = fromShortGuid >> ContinentId + + /// Get the GUID value of a continent ID + let value = function ContinentId guid -> guid /// Support functions for listing IDs @@ -62,6 +68,9 @@ module ListingId = /// Parse a string into a listing ID let ofString = fromShortGuid >> ListingId + + /// Get the GUID value of a listing ID + let value = function ListingId guid -> guid /// Support functions for Markdown strings @@ -85,6 +94,7 @@ module Profile = { id = CitizenId Guid.Empty seekingEmployment = false isPublic = false + isPublicLinkable = false continentId = ContinentId Guid.Empty region = "" remoteWork = false @@ -107,6 +117,9 @@ module SkillId = /// Parse a string into a skill ID let ofString = fromShortGuid >> SkillId + + /// Get the GUID value of a skill ID + let value = function SkillId guid -> guid /// Support functions for success report IDs @@ -120,3 +133,6 @@ module SuccessId = /// Parse a string into a success report ID let ofString = fromShortGuid >> SuccessId + + /// Get the GUID value of a success ID + let value = function SuccessId guid -> guid diff --git a/src/JobsJobsJobs/Domain/Types.fs b/src/JobsJobsJobs/Domain/Types.fs index 304ec06..88b7e1f 100644 --- a/src/JobsJobsJobs/Domain/Types.fs +++ b/src/JobsJobsJobs/Domain/Types.fs @@ -7,11 +7,7 @@ open System // fsharplint:disable FieldNames /// The ID of a user (a citizen of Gitmo Nation) -type CitizenId = - CitizenId of Guid -with - /// The GUID value of this citizen ID - member this.Value = this |> function CitizenId guid -> guid +type CitizenId = CitizenId of Guid /// A user of Jobs, Jobs, Jobs [] @@ -132,6 +128,9 @@ type Profile = /// Whether this citizen allows their profile to be a part of the publicly-viewable, anonymous data isPublic : bool + /// Whether this citizen allows their profile to be viewed via a public link + isPublicLinkable : bool + /// The ID of the continent on which the citizen resides continentId : ContinentId diff --git a/src/JobsJobsJobs/Server/Data.fs b/src/JobsJobsJobs/Server/Data.fs index 92b034b..1f35c5d 100644 --- a/src/JobsJobsJobs/Server/Data.fs +++ b/src/JobsJobsJobs/Server/Data.fs @@ -1,7 +1,6 @@ /// Data access functions for Jobs, Jobs, Jobs module JobsJobsJobs.Api.Data -open CommonExtensionsAndTypesForNpgsqlFSharp open JobsJobsJobs.Domain.Types /// JSON converters used with RethinkDB persistence @@ -82,20 +81,14 @@ module Table = /// The continent table let Continent = "continent" - /// The job listing table - let Listing = "listing" - /// The citizen employment profile table let Profile = "profile" - /// The profile / skill cross-reference - let ProfileSkill = "profile_skill" - /// The success story table let Success = "success" /// All tables - let all () = [ Citizen; Continent; Listing; Profile; Success ] + let all () = [ Citizen; Continent; Profile; Success ] open NodaTime open Npgsql @@ -175,7 +168,7 @@ module Startup = is_public_linkable BOOLEAN NOT NULL, continent_id UUID NOT NULL, region TEXT NOT NULL, - is_available_remote BOOLEAN NOT NULL, + is_available_remotely BOOLEAN NOT NULL, is_available_full_time BOOLEAN NOT NULL, biography TEXT NOT NULL, last_updated_on TIMESTAMPTZ NOT NULL, @@ -255,33 +248,102 @@ let private deriveDisplayName (it : ReqlExpr) = it.G("displayName").Default_("").Ne "", it.G "displayName", it.G "mastodonUser") +/// Custom SQL parameter functions +module Sql = + + /// Create a citizen ID parameter + let citizenId = CitizenId.value >> Sql.uuid + + /// Create a continent ID parameter + let continentId = ContinentId.value >> Sql.uuid + + /// Create a listing ID parameter + let listingId = ListingId.value >> Sql.uuid + + /// Create a Markdown string parameter + let markdown = MarkdownString.toString >> Sql.string + + /// Create a parameter for the given value + let param<'T> name (value : 'T) = + name, Sql.parameter (NpgsqlParameter (name, value)) + + /// Create a parameter for a possibly-missing value + let paramOrNone<'T> name (value : 'T option) = + name, Sql.parameter (NpgsqlParameter (name, if Option.isSome value then box value else System.DBNull.Value)) + + /// Create a skill ID parameter + let skillId = SkillId.value >> Sql.uuid + + /// Create a success ID parameter + let successId = SuccessId.value >> Sql.uuid + + /// Map data results to domain types module Map = + /// Create a continent from a data row + let toContinent (row : RowReader) : Continent = + { id = (row.uuid >> ContinentId) "continent_id" + name = row.string "continent_name" + } + /// Extract a count from a row let toCount (row : RowReader) = row.int64 "the_count" + /// Create a job listing from a data row + let toListing (row : RowReader) : Listing = + { id = (row.uuid >> ListingId) "id" + citizenId = (row.uuid >> CitizenId) "citizen_id" + createdOn = row.fieldValue "created_on" + title = row.string "title" + continentId = (row.uuid >> ContinentId) "continent_id" + region = row.string "region" + remoteWork = row.bool "is_remote" + isExpired = row.bool "is_expired" + updatedOn = row.fieldValue "updated_on" + text = (row.string >> Text) "listing_text" + neededBy = row.fieldValueOrNone "needed_by" + wasFilledHere = row.boolOrNone "was_filled_here" + } + + /// Create a job listing for viewing from a data row + let toListingForView (row : RowReader) : ListingForView = + { listing = toListing row + continent = toContinent row + } + /// Create a profile from a data row let toProfile (row : RowReader) : Profile = - { id = CitizenId (row.uuid "citizen_id") - seekingEmployment = row.bool "is_seeking" - isPublic = row.bool "is_public_searchable" - continentId = ContinentId (row.uuid "continent_id") - region = row.string "region" - remoteWork = row.bool "is_available_remote" - fullTime = row.bool "is_available_full_time" - biography = Text (row.string "biography") - lastUpdatedOn = row.fieldValue "last_updated_on" - experience = row.stringOrNone "experience" |> Option.map Text + { id = (row.uuid >> CitizenId) "citizen_id" + seekingEmployment = row.bool "is_seeking" + isPublic = row.bool "is_public_searchable" + isPublicLinkable = row.bool "is_public_linkable" + continentId = (row.uuid >> ContinentId) "continent_id" + region = row.string "region" + remoteWork = row.bool "is_available_remotely" + fullTime = row.bool "is_available_full_time" + biography = (row.string >> Text) "biography" + lastUpdatedOn = row.fieldValue "last_updated_on" + experience = row.stringOrNone "experience" |> Option.map Text skills = [] } /// Create a skill from a data row let toSkill (row : RowReader) : Skill = - { id = SkillId (row.uuid "id") - description = row.string "description" - notes = row.stringOrNone "notes" + { id = (row.uuid >> SkillId) "id" + description = row.string "description" + notes = row.stringOrNone "notes" + } + + /// Create a success story from a data row + let toSuccess (row : RowReader) : Success = + { id = (row.uuid >> SuccessId) "id" + citizenId = (row.uuid >> CitizenId) "citizen_id" + recordedOn = row.fieldValue "recorded_on" + fromHere = row.bool "was_from_here" + source = row.string "source" + story = row.stringOrNone "story" |> Option.map Text } @@ -300,7 +362,7 @@ module Profile = |> Sql.executeRowAsync Map.toCount /// Find a profile by citizen ID - let findById (citizenId : CitizenId) conn = backgroundTask { + let findById citizenId conn = backgroundTask { let! tryProfile = Sql.existingConnection conn |> Sql.query @@ -309,31 +371,82 @@ module Profile = INNER JOIN jjj.citizen ON c.id = p.citizen_id WHERE p.citizen_id = @id AND c.is_legacy = FALSE" - |> Sql.parameters [ "@id", Sql.uuid citizenId.Value ] + |> Sql.parameters [ "@id", Sql.citizenId citizenId ] |> Sql.executeAsync Map.toProfile match List.tryHead tryProfile with | Some profile -> let! skills = Sql.existingConnection conn |> Sql.query "SELECT * FROM jjj.profile_skill WHERE citizen_id = @id" - |> Sql.parameters [ "@id", Sql.uuid citizenId.Value ] + |> Sql.parameters [ "@id", Sql.citizenId citizenId ] |> Sql.executeAsync Map.toSkill return Some { profile with skills = skills } | None -> return None } + /// Insert or update a profile - let save (profile : Profile) conn = - fromTable Table.Profile - |> get profile.id - |> replace profile - |> write conn - + let save (profile : Profile) conn = backgroundTask { + let! _ = + Sql.existingConnection conn + |> Sql.executeTransactionAsync [ + "INSERT INTO jjj.profile ( + citizen_id, is_seeking, is_public_searchable, is_public_linkable, continent_id, region, + is_available_remotely, is_available_full_time, biography, last_updated_on, experience + ) VALUES ( + @citizenId, @isSeeking, @isPublicSearchable, @isPublicLinkable, @continentId, @region, + @isAvailableRemotely, @isAvailableFullTime, @biography, @lastUpdatedOn, @experience + ) ON CONFLICT (citizen_id) DO UPDATE + SET is_seeking = EXCLUDED.is_seeking, + is_public_searchable = EXCLUDED.is_public_searchable, + is_public_linkable = EXCLUDED.is_public_linkable, + continent_id = EXCLUDED.continent_id, + region = EXCLUDED.region, + is_available_remotely = EXCLUDED.is_available_remotely, + is_available_full_time = EXCLUDED.is_available_full_time, + biography = EXCLUDED.biography, + last_updated_on = EXCLUDED.last_updated_on, + experience = EXCLUDED.experience", + [ [ "@citizenId", Sql.citizenId profile.id + "@isSeeking", Sql.bool profile.seekingEmployment + "@isPublicSearchable", Sql.bool profile.isPublic + "@isPublicLinkable", Sql.bool profile.isPublicLinkable + "@continentId", Sql.continentId profile.continentId + "@region", Sql.string profile.region + "@isAvailableRemotely", Sql.bool profile.remoteWork + "@isAvailableFullTime", Sql.bool profile.fullTime + "@biography", Sql.markdown profile.biography + "@lastUpdatedOn" |>Sql.param<| profile.lastUpdatedOn + "@experience", Sql.stringOrNone (Option.map MarkdownString.toString profile.experience) + ] ] + + "INSERT INTO jjj.profile ( + id, citizen_id, description, notes + ) VALUES ( + @id, @citizenId, @description, @notes + ) ON CONFLICT (id) DO UPDATE + SET description = EXCLUDED.description, + notes = EXCLUDED.notes", + profile.skills + |> List.map (fun skill -> [ + "@id", Sql.skillId skill.id + "@citizenId", Sql.citizenId profile.id + "@description", Sql.string skill.description + "@notes" , Sql.stringOrNone skill.notes + ]) + + $"""DELETE FROM jjj.profile + WHERE id NOT IN ({profile.skills |> List.mapi (fun idx _ -> $"@id{idx}") |> String.concat ", "})""", + [ profile.skills |> List.mapi (fun idx skill -> $"@id{idx}", Sql.skillId skill.id) ] + ] + () + } + /// Delete a citizen's profile - let delete (citizenId : CitizenId) conn = backgroundTask { + let delete citizenId conn = backgroundTask { let! _ = Sql.existingConnection conn |> Sql.query "DELETE FROM jjj.profile WHERE citizen_id = @id" - |> Sql.parameters [ "@id", Sql.uuid citizenId.Value ] + |> Sql.parameters [ "@id", Sql.citizenId citizenId ] |> Sql.executeNonQueryAsync () } @@ -433,11 +546,11 @@ module Citizen = |> write conn /// Delete a citizen - let delete (citizenId : CitizenId) conn = backgroundTask { + let delete citizenId conn = backgroundTask { let! _ = Sql.existingConnection conn |> Sql.query "DELETE FROM citizen WHERE id = @id" - |> Sql.parameters [ "@id", Sql.uuid citizenId.Value ] + |> Sql.parameters [ "@id", Sql.citizenId citizenId ] |> Sql.executeNonQueryAsync () } @@ -456,89 +569,138 @@ module Continent = /// Get all continents let all conn = - fromTable Table.Continent - |> result conn + Sql.existingConnection conn + |> Sql.query "SELECT id AS continent_id, name AS continent_name FROM jjj.continent" + |> Sql.executeAsync Map.toContinent /// Get a continent by its ID - let findById (contId : ContinentId) conn = - fromTable Table.Continent - |> get contId - |> resultOption conn + let findById contId conn = backgroundTask { + let! continent = + Sql.existingConnection conn + |> Sql.query "SELECT id AS continent_id, name AS continent_name FROM jjj.continent WHERE id = @id" + |> Sql.parameters [ "@id", Sql.continentId contId ] + |> Sql.executeAsync Map.toContinent + return List.tryHead continent + } /// Job listing data access functions [] module Listing = - /// Convert a joined query to the form needed for ListingForView deserialization - let private toListingForView (it : ReqlExpr) : obj = {| listing = it.G "left"; continent = it.G "right" |} + /// The SQL to select the listing and continent fields + let private forViewSql = + "SELECT l.*, c.name AS continent_name + FROM jjj.listing l + INNER JOIN jjj.continent c ON c.id = l.continent_id" /// Find all job listings posted by the given citizen - let findByCitizen (citizenId : CitizenId) conn = - fromTable Table.Listing - |> getAllWithIndex [ citizenId ] (nameof citizenId) - |> eqJoin "continentId" (fromTable Table.Continent) - |> mapFunc toListingForView - |> result conn + let findByCitizen citizenId conn = + Sql.existingConnection conn + |> Sql.query $"{forViewSql} WHERE l.citizen_id = @citizenId" + |> Sql.parameters [ "@citizenId", Sql.citizenId citizenId ] + |> Sql.executeAsync Map.toListingForView /// Find a listing by its ID - let findById (listingId : ListingId) conn = - fromTable Table.Listing - |> get listingId - |> resultOption conn - - /// Find a listing by its ID for viewing (includes continent information) - let findByIdForView (listingId : ListingId) conn = task { + let findById listingId conn = backgroundTask { let! listing = - fromTable Table.Listing - |> filter {| id = listingId |} - |> eqJoin "continentId" (fromTable Table.Continent) - |> mapFunc toListingForView - |> result conn + Sql.existingConnection conn + |> Sql.query "SELECT * FROM jjj.listing WHERE id = @id" + |> Sql.parameters [ "@id", Sql.listingId listingId ] + |> Sql.executeAsync Map.toListing return List.tryHead listing } - /// Add a listing - let add (listing : Listing) conn = - fromTable Table.Listing - |> insert listing - |> write conn + /// Find a listing by its ID for viewing (includes continent information) + let findByIdForView (listingId : ListingId) conn = backgroundTask { + let! listing = + Sql.existingConnection conn + |> Sql.query $"{forViewSql} WHERE l.id = @id" + |> Sql.parameters [ "@id", Sql.listingId listingId ] + |> Sql.executeAsync Map.toListingForView + return List.tryHead listing + } + + /// Add or update a listing + let save (listing : Listing) conn = backgroundTask { + let! _ = + Sql.existingConnection conn + |> Sql.query + "INSERT INTO jjj.listing ( + id, citizen_id, created_on, title, continent_id, region, is_remote, is_expired, updated_on, + listing_text, needed_by, was_filled_here + ) VALUES ( + @id, @citizenId, @createdOn, @title, @continentId, @region, @isRemote, @isExpired, @updatedOn, + @text, @neededBy, @wasFilledHere + ) ON CONFLICT (id) DO UPDATE + SET title = EXCLUDED.title, + continent_id = EXCLUDED.continent_id, + region = EXCLUDED.region, + is_remote = EXCLUDED.is_remote, + is_expired = EXCLUDED.is_expired, + updated_on = EXCLUDED.updated_on, + listing_text = EXCLUDED.listing_text, + needed_by = EXCLUDED.needed_by, + was_filled_here = EXCLUDED.was_filled_here" + |> Sql.parameters + [ "@id", Sql.listingId listing.id + "@citizenId", Sql.citizenId listing.citizenId + "@createdOn" |>Sql.param<| listing.createdOn + "@title", Sql.string listing.title + "@continentId", Sql.continentId listing.continentId + "@region", Sql.string listing.region + "@isRemote", Sql.bool listing.remoteWork + "@isExpired", Sql.bool listing.isExpired + "@updatedOn" |>Sql.param<| listing.updatedOn + "@text", Sql.markdown listing.text + "@neededBy" |>Sql.paramOrNone<| listing.neededBy + "@wasFilledHere", Sql.boolOrNone listing.wasFilledHere + + ] + |> Sql.executeNonQueryAsync + () + } - /// Update a listing - let update (listing : Listing) conn = - fromTable Table.Listing - |> get listing.id - |> replace listing - |> write conn - /// Expire a listing - let expire (listingId : ListingId) (fromHere : bool) (now : Instant) conn = - (fromTable Table.Listing - |> get listingId) - .Update {| isExpired = true; wasFilledHere = fromHere; updatedOn = now |} - |> write conn - + let expire listingId fromHere (now : Instant) conn = backgroundTask { + let! _ = + Sql.existingConnection conn + |> Sql.query + "UPDATE jjj.listing + SET is_expired = TRUE, + was_filled_here = @wasFilledHere, + updated_on = @updatedOn + WHERE id = @id" + |> Sql.parameters + [ "@wasFilledHere", Sql.bool fromHere + "@updatedOn" |>Sql.param<| now + "@id", Sql.listingId listingId + ] + |> Sql.executeNonQueryAsync + () + } + /// Search job listings let search (search : ListingSearch) conn = - fromTable Table.Listing - |> getAllWithIndex [ false ] "isExpired" - |> applyFilters - [ match search.continentId with - | Some contId -> yield filter {| continentId = ContinentId.ofString contId |} - | None -> () - match search.region with - | Some rgn -> yield filterFunc (fun it -> it.G(nameof search.region).Match (regexContains rgn)) - | None -> () - match search.remoteWork with - | "" -> () - | _ -> yield filter {| remoteWork = search.remoteWork = "yes" |} - match search.text with - | Some text -> yield filterFunc (fun it -> it.G(nameof search.text).Match (regexContains text)) - | None -> () - ] - |> eqJoin "continentId" (fromTable Table.Continent) - |> mapFunc toListingForView - |> result conn + let filters = seq { + match search.continentId with + | Some contId -> + "l.continent = @continentId", [ "@continentId", Sql.continentId (ContinentId.ofString contId) ] + | None -> () + match search.region with + | Some region -> "l.region ILIKE '%@region%'", [ "@region", Sql.string region ] + | None -> () + if search.remoteWork <> "" then + "l.is_remote = @isRemote", ["@isRemote", Sql.bool (search.remoteWork = "yes") ] + match search.text with + | Some text -> "l.listing_text ILIKE '%@text%'", [ "@text", Sql.string text ] + | None -> () + } + let filterSql = filters |> Seq.map fst |> String.concat " AND " + Sql.existingConnection conn + |> Sql.query $"{forViewSql} WHERE l.is_expired = FALSE{filterSql}" + |> Sql.parameters (filters |> Seq.collect snd |> List.ofSeq) + |> Sql.executeAsync Map.toListingForView /// Success story data access functions @@ -546,18 +708,39 @@ module Listing = module Success = /// Find a success report by its ID - let findById (successId : SuccessId) conn = - fromTable Table.Success - |> get successId - |> resultOption conn + let findById successId conn = backgroundTask { + let! success = + Sql.existingConnection conn + |> Sql.query "SELECT * FROM jjj.success WHERE id = @id" + |> Sql.parameters [ "@id", Sql.successId successId ] + |> Sql.executeAsync Map.toSuccess + return List.tryHead success + } /// Insert or update a success story - let save (success : Success) conn = - fromTable Table.Success - |> get success.id - |> replace success - |> write conn - + let save (success : Success) conn = backgroundTask { + let! _ = + Sql.existingConnection conn + |> Sql.query + "INSERT INTO jjj.success ( + id, citizen_id, recorded_on, was_from_here, source, story + ) VALUES ( + @id, @citizenId, @recordedOn, @wasFromHere, @source, @story + ) ON CONFLICT (id) DO UPDATE + SET was_from_here = EXCLUDED.was_from_here, + story = EXCLUDED.story" + |> Sql.parameters + [ "@id", Sql.successId success.id + "@citizenId", Sql.citizenId success.citizenId + "@recordedOn" |>Sql.param<| success.recordedOn + "@wasFromHere", Sql.bool success.fromHere + "@source", Sql.string success.source + "@story", Sql.stringOrNone (Option.map MarkdownString.toString success.story) + ] + |> Sql.executeNonQueryAsync + () + } + // Retrieve all success stories let all conn = fromTable Table.Success -- 2.45.1 From 93213099ac06b4d785f8d54504e0a5f5db68657b Mon Sep 17 00:00:00 2001 From: "Daniel J. Summers" Date: Tue, 23 Aug 2022 20:24:50 -0400 Subject: [PATCH 04/67] WIP on new citizen structure --- .../Domain/JobsJobsJobs.Domain.fsproj | 3 +- .../Domain/{Modules.fs => SupportTypes.fs} | 88 ++++++------- src/JobsJobsJobs/Domain/Types.fs | 87 +++++++------ src/JobsJobsJobs/Server/Data.fs | 121 ++++++++++++------ 4 files changed, 171 insertions(+), 128 deletions(-) rename src/JobsJobsJobs/Domain/{Modules.fs => SupportTypes.fs} (54%) diff --git a/src/JobsJobsJobs/Domain/JobsJobsJobs.Domain.fsproj b/src/JobsJobsJobs/Domain/JobsJobsJobs.Domain.fsproj index a005d97..ee4d625 100644 --- a/src/JobsJobsJobs/Domain/JobsJobsJobs.Domain.fsproj +++ b/src/JobsJobsJobs/Domain/JobsJobsJobs.Domain.fsproj @@ -6,12 +6,13 @@ + - + diff --git a/src/JobsJobsJobs/Domain/Modules.fs b/src/JobsJobsJobs/Domain/SupportTypes.fs similarity index 54% rename from src/JobsJobsJobs/Domain/Modules.fs rename to src/JobsJobsJobs/Domain/SupportTypes.fs index 5e944d7..b607fc3 100644 --- a/src/JobsJobsJobs/Domain/Modules.fs +++ b/src/JobsJobsJobs/Domain/SupportTypes.fs @@ -1,19 +1,10 @@ -/// Modules to provide support functions for types -[] -module JobsJobsJobs.Domain.Modules +namespace JobsJobsJobs.Domain -open Markdig open System -open Types - -/// Format a GUID as a Short GUID -let private toShortGuid (guid : Guid) = - Convert.ToBase64String(guid.ToByteArray ()).Replace('/', '_').Replace('+', '-')[0..21] - -/// Turn a Short GUID back into a GUID -let private fromShortGuid (it : string) = - (Convert.FromBase64String >> Guid) $"{it.Replace('_', '/').Replace('-', '+')}==" +open Giraffe +/// The ID of a user (a citizen of Gitmo Nation) +type CitizenId = CitizenId of Guid /// Support functions for citizen IDs module CitizenId = @@ -22,24 +13,17 @@ module CitizenId = let create () = (Guid.NewGuid >> CitizenId) () /// A string representation of a citizen ID - let toString = function CitizenId it -> toShortGuid it + let toString = function CitizenId it -> ShortGuid.fromGuid it /// Parse a string into a citizen ID - let ofString = fromShortGuid >> CitizenId + let ofString = ShortGuid.toGuid >> CitizenId /// Get the GUID value of a citizen ID let value = function CitizenId guid -> guid -/// Support functions for citizens -module Citizen = - - /// Get the name of the citizen (the first of real name, display name, or handle that is filled in) - let name x = - [ x.realName; x.displayName; Some x.mastodonUser ] - |> List.find Option.isSome - |> Option.get - +/// The ID of a continent +type ContinentId = ContinentId of Guid /// Support functions for continent IDs module ContinentId = @@ -48,15 +32,18 @@ module ContinentId = let create () = (Guid.NewGuid >> ContinentId) () /// A string representation of a continent ID - let toString = function ContinentId it -> toShortGuid it + let toString = function ContinentId it -> ShortGuid.fromGuid it /// Parse a string into a continent ID - let ofString = fromShortGuid >> ContinentId + 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 = @@ -64,18 +51,23 @@ module ListingId = let create () = (Guid.NewGuid >> ListingId) () /// A string representation of a listing ID - let toString = function ListingId it -> toShortGuid it + let toString = function ListingId it -> ShortGuid.fromGuid it /// Parse a string into a listing ID - let ofString = fromShortGuid >> ListingId + 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 () @@ -86,26 +78,19 @@ module MarkdownString = let toString = function Text text -> text -/// Support functions for Profiles -module Profile = - - // An empty profile - let empty = - { id = CitizenId Guid.Empty - seekingEmployment = false - isPublic = false - isPublicLinkable = false - continentId = ContinentId Guid.Empty - region = "" - remoteWork = false - fullTime = false - biography = Text "" - lastUpdatedOn = NodaTime.Instant.MinValue - experience = None - skills = [] - } +/// Another way to contact a citizen from this site +type OtherContact = + { /// The name of the contact (Email, No Agenda Social, LinkedIn, etc.) + Name : string + + /// The value for the contact (e-mail address, user name, URL, etc.) + Value : string + } +/// The ID of a skill +type SkillId = SkillId of Guid + /// Support functions for skill IDs module SkillId = @@ -113,15 +98,18 @@ module SkillId = let create () = (Guid.NewGuid >> SkillId) () /// A string representation of a skill ID - let toString = function SkillId it -> toShortGuid it + let toString = function SkillId it -> ShortGuid.fromGuid it /// Parse a string into a skill ID - let ofString = fromShortGuid >> SkillId + let ofString = ShortGuid.toGuid >> SkillId /// Get the GUID value of a skill ID let value = function SkillId guid -> guid +/// The ID of a success report +type SuccessId = SuccessId of Guid + /// Support functions for success report IDs module SuccessId = @@ -129,10 +117,10 @@ module SuccessId = let create () = (Guid.NewGuid >> SuccessId) () /// A string representation of a success report ID - let toString = function SuccessId it -> toShortGuid it + let toString = function SuccessId it -> ShortGuid.fromGuid it /// Parse a string into a success report ID - let ofString = fromShortGuid >> SuccessId + let ofString = ShortGuid.toGuid >> SuccessId /// Get the GUID value of a success ID let value = function SuccessId guid -> guid diff --git a/src/JobsJobsJobs/Domain/Types.fs b/src/JobsJobsJobs/Domain/Types.fs index 88b7e1f..3bf4dc3 100644 --- a/src/JobsJobsJobs/Domain/Types.fs +++ b/src/JobsJobsJobs/Domain/Types.fs @@ -1,45 +1,49 @@ -/// Types within Jobs, Jobs, Jobs -module JobsJobsJobs.Domain.Types +namespace JobsJobsJobs.Domain open NodaTime open System // fsharplint:disable FieldNames -/// The ID of a user (a citizen of Gitmo Nation) -type CitizenId = CitizenId of Guid - -/// A user of Jobs, Jobs, Jobs +/// A user of Jobs, Jobs, Jobs; a citizen of Gitmo Nation [] type Citizen = { /// The ID of the user - id : CitizenId - - /// The Mastodon instance abbreviation from which this citizen is authorized - instance : string - - /// The handle by which the user is known on Mastodon - mastodonUser : string - - /// The user's display name from Mastodon (updated every login) - displayName : string option - - /// The user's real name - realName : string option - - /// The URL for the user's Mastodon profile - profileUrl : string + id : CitizenId /// When the user joined Jobs, Jobs, Jobs - joinedOn : Instant + joinedOn : Instant /// When the user last logged in - lastSeenOn : Instant + 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 + } +/// Support functions for citizens +module Citizen = + + /// 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}" -/// The ID of a continent -type ContinentId = ContinentId of Guid /// A continent [] @@ -52,13 +56,6 @@ type Continent = } -/// A string of Markdown text -type MarkdownString = Text of string - - -/// The ID of a job listing -type ListingId = ListingId of Guid - /// A job listing [] type Listing = @@ -100,9 +97,6 @@ type Listing = } -/// The ID of a skill -type SkillId = SkillId of Guid - /// A skill the job seeker possesses type Skill = { /// The ID of the skill @@ -156,8 +150,25 @@ type Profile = skills : Skill list } -/// The ID of a success report -type SuccessId = SuccessId of Guid +/// Support functions for Profiles +module Profile = + + // An empty profile + let empty = + { id = CitizenId Guid.Empty + seekingEmployment = false + isPublic = false + isPublicLinkable = false + continentId = ContinentId Guid.Empty + region = "" + remoteWork = false + fullTime = false + biography = Text "" + lastUpdatedOn = Instant.MinValue + experience = None + skills = [] + } + /// A record of success finding employment [] diff --git a/src/JobsJobsJobs/Server/Data.fs b/src/JobsJobsJobs/Server/Data.fs index 1f35c5d..742bef0 100644 --- a/src/JobsJobsJobs/Server/Data.fs +++ b/src/JobsJobsJobs/Server/Data.fs @@ -1,12 +1,11 @@ /// Data access functions for Jobs, Jobs, Jobs module JobsJobsJobs.Api.Data -open JobsJobsJobs.Domain.Types +open JobsJobsJobs.Domain /// JSON converters used with RethinkDB persistence module Converters = - open JobsJobsJobs.Domain open Microsoft.FSharpLu.Json open Newtonsoft.Json open System @@ -154,12 +153,16 @@ module Startup = name TEXT NOT NULL)" if needsTable "citizen" then "CREATE TABLE jjj.citizen ( - id UUID NOT NULL PRIMARY KEY, - display_name TEXT, - profile_urls TEXT[] NOT NULL DEFAULT '{}', - joined_on TIMESTAMPTZ NOT NULL, - last_seen_on TIMESTAMPTZ NOT NULL, - is_legacy BOOLEAN NOT NULL)" + id UUID NOT NULL PRIMARY KEY, + joined_on TIMESTAMPTZ NOT NULL, + last_seen_on TIMESTAMPTZ NOT NULL, + email TEXT NOT NULL UNIQUE, + first_name TEXT NOT NULL, + last_name TEXT NOT NULL, + password_hash TEXT NOT NULL, + is_legacy BOOLEAN NOT NULL, + display_name TEXT, + other_contacts TEXT)" if needsTable "profile" then "CREATE TABLE jjj.profile ( citizen_id UUID NOT NULL PRIMARY KEY, @@ -228,7 +231,6 @@ module Startup = } -open JobsJobsJobs.Domain open JobsJobsJobs.Domain.SharedTypes /// Sanitize user input, and create a "contains" pattern for use with RethinkDB queries @@ -281,6 +283,20 @@ module Sql = /// Map data results to domain types module Map = + /// Create a citizen from a data row + let toCitizen (row : RowReader) : Citizen = + { id = (row.uuid >> CitizenId) "id" + joinedOn = row.fieldValue "joined_on" + lastSeenOn = row.fieldValue "last_seen_on" + email = row.string "email" + firstName = row.string "first_name" + lastName = row.string "last_name" + passwordHash = row.string "password_hash" + displayName = row.stringOrNone "display_name" + // TODO: deserialize from JSON + otherContacts = [] // row.stringOrNone "other_contacts" + } + /// Create a continent from a data row let toContinent (row : RowReader) : Continent = { id = (row.uuid >> ContinentId) "continent_id" @@ -517,33 +533,67 @@ module Profile = module Citizen = /// Find a citizen by their ID - let findById (citizenId : CitizenId) conn = - fromTable Table.Citizen - |> get citizenId - |> resultOption conn + let findById citizenId conn = backgroundTask { + let! citizen = + Sql.existingConnection conn + |> Sql.query "SELECT * FROM jjj.citizen WHERE id = @id AND is_legacy = FALSE" + |> Sql.parameters [ "@id", Sql.citizenId citizenId ] + |> Sql.executeAsync Map.toCitizen + return List.tryHead citizen + } - /// Find a citizen by their Mastodon username - let findByMastodonUser (instance : string) (mastodonUser : string) conn = task { - let! u = - fromTable Table.Citizen - |> getAllWithIndex [ [| instance; mastodonUser |] ] "instanceUser" - |> limit 1 - |> result conn - return List.tryHead u + /// Find a citizen by their e-mail address + let findByEmail email conn = backgroundTask { + let! citizen = + Sql.existingConnection conn + |> Sql.query "SELECT * FROM jjj.citizen WHERE email = @email AND is_legacy = FALSE" + |> Sql.parameters [ "@email", Sql.string email ] + |> Sql.executeAsync Map.toCitizen + return List.tryHead citizen } - /// Add a citizen - let add (citizen : Citizen) conn = - fromTable Table.Citizen - |> insert citizen - |> write conn + /// Add or update a citizen + let save (citizen : Citizen) conn = backgroundTask { + let! _ = + Sql.existingConnection conn + |> Sql.query + "INSERT INTO jjj.citizen ( + id, joined_on, last_seen_on, email, first_name, last_name, password_hash, display_name, + other_contacts, is_legacy + ) VALUES ( + @id, @joinedOn, @lastSeenOn, @email, @firstName, @lastName, @passwordHash, @displayName, + @otherContacts, FALSE + ) ON CONFLICT (id) DO UPDATE + SET email = EXCLUDED.email, + first_name = EXCLUDED.first_name, + last_name = EXCLUDED.last_name, + password_hash = EXCLUDED.password_hash, + display_name = EXCLUDED.display_name, + other_contacts = EXCLUDED.other_contacts" + |> Sql.parameters + [ "@id", Sql.citizenId citizen.id + "@joinedOn" |>Sql.param<| citizen.joinedOn + "@lastSeenOn" |>Sql.param<| citizen.lastSeenOn + "@email", Sql.string citizen.email + "@firstName", Sql.string citizen.firstName + "@lastName", Sql.string citizen.lastName + "@passwordHash", Sql.string citizen.passwordHash + "@displayName", Sql.stringOrNone citizen.displayName + "@otherContacts", Sql.stringOrNone (if List.isEmpty citizen.otherContacts then None else Some "") + ] + |> Sql.executeNonQueryAsync + () + } - /// Update the display name and last seen on date for a citizen - let logOnUpdate (citizen : Citizen) conn = - fromTable Table.Citizen - |> get citizen.id - |> update {| displayName = citizen.displayName; lastSeenOn = citizen.lastSeenOn |} - |> write conn + /// Update the last seen on date for a citizen + let logOnUpdate (citizen : Citizen) conn = backgroundTask { + let! _ = + Sql.existingConnection conn + |> Sql.query "UPDATE jjj.citizen SET last_seen_on = @lastSeenOn WHERE id = @id" + |> Sql.parameters [ "@id", Sql.citizenId citizen.id; "@lastSeenOn" |>Sql.param<| citizen.lastSeenOn ] + |> Sql.executeNonQueryAsync + () + } /// Delete a citizen let delete citizenId conn = backgroundTask { @@ -555,13 +605,6 @@ module Citizen = () } - /// Update a citizen's real name - let realNameUpdate (citizenId : CitizenId) (realName : string option) conn = - fromTable Table.Citizen - |> get citizenId - |> update {| realName = realName |} - |> write conn - /// Continent data access functions [] -- 2.45.1 From 5592d715d1881606ca38bc85cba14f4af995b6a8 Mon Sep 17 00:00:00 2001 From: "Daniel J. Summers" Date: Wed, 24 Aug 2022 06:40:11 -0400 Subject: [PATCH 05/67] WIP on security --- src/JobsJobsJobs/Domain/Types.fs | 22 +++++++++++++++ src/JobsJobsJobs/Server/Data.fs | 46 +++++++++++++++++++------------- 2 files changed, 50 insertions(+), 18 deletions(-) diff --git a/src/JobsJobsJobs/Domain/Types.fs b/src/JobsJobsJobs/Domain/Types.fs index 3bf4dc3..063df14 100644 --- a/src/JobsJobsJobs/Domain/Types.fs +++ b/src/JobsJobsJobs/Domain/Types.fs @@ -97,6 +97,28 @@ type Listing = } +/// 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 : int16 + + /// 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 + } + + /// A skill the job seeker possesses type Skill = { /// The ID of the skill diff --git a/src/JobsJobsJobs/Server/Data.fs b/src/JobsJobsJobs/Server/Data.fs index 742bef0..3c74b31 100644 --- a/src/JobsJobsJobs/Server/Data.fs +++ b/src/JobsJobsJobs/Server/Data.fs @@ -163,6 +163,24 @@ module Startup = is_legacy BOOLEAN NOT NULL, display_name TEXT, other_contacts TEXT)" + if needsTable "listing" then + "CREATE TABLE jjj.listing ( + id UUID NOT NULL PRIMARY KEY, + citizen_id UUID NOT NULL, + created_on TIMESTAMPTZ NOT NULL, + title TEXT NOT NULL, + continent_id UUID NOT NULL, + region TEXT NOT NULL, + is_remote BOOLEAN NOT NULL, + is_expired BOOLEAN NOT NULL, + updated_on TIMESTAMPTZ NOT NULL, + listing_text TEXT NOT NULL, + needed_by DATE, + was_filled_here BOOLEAN, + FOREIGN KEY fk_listing_citizen (citizen_id) REFERENCES jjj.citizen (id) ON DELETE CASCADE, + FOREIGN KEY fk_listing_continent (continent_id) REFERENCES jjj.continent (id))" + "CREATE INDEX idx_listing_citizen ON jjj.listing (citizen_id)" + "CREATE INDEX idx_listing_continent ON jjj.listing (continent_id)" if needsTable "profile" then "CREATE TABLE jjj.profile ( citizen_id UUID NOT NULL PRIMARY KEY, @@ -188,24 +206,16 @@ module Startup = FOREIGN KEY fk_profile_skill_profile (citizen_id) REFERENCES jjj.profile (citizen_id) ON DELETE CASCADE)" "CREATE INDEX idx_profile_skill_profile ON jjj.profile_skill (citizen_id)" - if needsTable "listing" then - "CREATE TABLE jjj.listing ( - id UUID NOT NULL PRIMARY KEY, - citizen_id UUID NOT NULL, - created_on TIMESTAMPTZ NOT NULL, - title TEXT NOT NULL, - continent_id UUID NOT NULL, - region TEXT NOT NULL, - is_remote BOOLEAN NOT NULL, - is_expired BOOLEAN NOT NULL, - updated_on TIMESTAMPTZ NOT NULL, - listing_text TEXT NOT NULL, - needed_by DATE, - was_filled_here BOOLEAN, - FOREIGN KEY fk_listing_citizen (citizen_id) REFERENCES jjj.citizen (id) ON DELETE CASCADE, - FOREIGN KEY fk_listing_continent (continent_id) REFERENCES jjj.continent (id))" - "CREATE INDEX idx_listing_citizen ON jjj.listing (citizen_id)" - "CREATE INDEX idx_listing_continent ON jjj.listing (continent_id)" + if needsTable "security_info" then + "CREATE TABLE jjj.security_info ( + id UUID NOT NULL PRIMARY KEY, + failed_attempts SMALLINT NOT NULL, + is_locked BOOLEAN NOT NULL, + token TEXT, + token_usage TEXT, + token_expires TIMESTAMPTZ, + FOREIGN KEY fk_security_info_citizen (id) REFERENCES jjj.citizen (id) ON DELETE CASCADE)" + "CREATE INDEX idx_security_info_expires ON jjj.security_info (token_expires)" if needsTable "success" then "CREATE TABLE jjj.success ( id UUID NOT NULL PRIMARY KEY, -- 2.45.1 From 74f9709f82013fa36c2ed25110852b22a3dca163 Mon Sep 17 00:00:00 2001 From: "Daniel J. Summers" Date: Wed, 24 Aug 2022 19:47:20 -0400 Subject: [PATCH 06/67] WIP on Marten data --- src/JobsJobsJobs/Domain/Types.fs | 9 ++ src/JobsJobsJobs/Server/App.fs | 58 +++++---- src/JobsJobsJobs/Server/Data.fs | 119 +++++------------- src/JobsJobsJobs/Server/Handlers.fs | 66 +++++++--- .../Server/JobsJobsJobs.Server.fsproj | 3 + 5 files changed, 122 insertions(+), 133 deletions(-) diff --git a/src/JobsJobsJobs/Domain/Types.fs b/src/JobsJobsJobs/Domain/Types.fs index 063df14..eb094a4 100644 --- a/src/JobsJobsJobs/Domain/Types.fs +++ b/src/JobsJobsJobs/Domain/Types.fs @@ -35,6 +35,8 @@ type Citizen = /// The other contacts for this user otherContacts : OtherContact list + /// Whether this is a legacy citizen + isLegacy : bool } /// Support functions for citizens @@ -94,6 +96,9 @@ type Listing = /// Was this job filled as part of its appearance on Jobs, Jobs, Jobs? wasFilledHere : bool option + + /// Whether this is a legacy listing + isLegacy : bool } @@ -170,6 +175,9 @@ type Profile = /// Skills this citizen possesses skills : Skill list + + /// Whether this is a legacy profile + isLegacy : bool } /// Support functions for Profiles @@ -189,6 +197,7 @@ module Profile = lastUpdatedOn = Instant.MinValue experience = None skills = [] + isLegacy = false } diff --git a/src/JobsJobsJobs/Server/App.fs b/src/JobsJobsJobs/Server/App.fs index 6f685b4..0de9c41 100644 --- a/src/JobsJobsJobs/Server/App.fs +++ b/src/JobsJobsJobs/Server/App.fs @@ -24,49 +24,61 @@ let configureApp (app : IApplicationBuilder) = open Newtonsoft.Json open NodaTime +open Marten open Microsoft.AspNetCore.Authentication.JwtBearer open Microsoft.Extensions.Configuration open Microsoft.Extensions.Logging open Microsoft.IdentityModel.Tokens open System.Text +open JobsJobsJobs.Domain open JobsJobsJobs.Domain.SharedTypes /// Configure dependency injection let configureServices (svc : IServiceCollection) = - svc.AddGiraffe () |> ignore - svc.AddSingleton SystemClock.Instance |> ignore - svc.AddLogging () |> ignore - svc.AddCors () |> ignore + let _ = svc.AddGiraffe () + let _ = svc.AddSingleton SystemClock.Instance + let _ = svc.AddLogging () + let _ = svc.AddCors () let jsonCfg = JsonSerializerSettings () Data.Converters.all () |> List.iter jsonCfg.Converters.Add - svc.AddSingleton (NewtonsoftJson.Serializer jsonCfg) |> ignore + let _ = svc.AddSingleton (NewtonsoftJson.Serializer jsonCfg) let svcs = svc.BuildServiceProvider () let cfg = svcs.GetRequiredService () - svc.AddAuthentication(fun o -> - o.DefaultAuthenticateScheme <- JwtBearerDefaults.AuthenticationScheme - o.DefaultChallengeScheme <- JwtBearerDefaults.AuthenticationScheme - o.DefaultScheme <- JwtBearerDefaults.AuthenticationScheme) - .AddJwtBearer(fun o -> - o.RequireHttpsMetadata <- false - o.TokenValidationParameters <- TokenValidationParameters ( - ValidateIssuer = true, - ValidateAudience = true, - ValidAudience = "https://noagendacareers.com", - ValidIssuer = "https://noagendacareers.com", - IssuerSigningKey = SymmetricSecurityKey ( - Encoding.UTF8.GetBytes (cfg.GetSection "Auth").["ServerSecret"]))) - |> ignore - svc.AddAuthorization () |> ignore - svc.Configure (cfg.GetSection "Auth") |> ignore + let _ = + svc.AddAuthentication(fun o -> + o.DefaultAuthenticateScheme <- JwtBearerDefaults.AuthenticationScheme + o.DefaultChallengeScheme <- JwtBearerDefaults.AuthenticationScheme + o.DefaultScheme <- JwtBearerDefaults.AuthenticationScheme) + .AddJwtBearer(fun opt -> + opt.RequireHttpsMetadata <- false + opt.TokenValidationParameters <- TokenValidationParameters ( + ValidateIssuer = true, + ValidateAudience = true, + ValidAudience = "https://noagendacareers.com", + ValidIssuer = "https://noagendacareers.com", + IssuerSigningKey = SymmetricSecurityKey ( + Encoding.UTF8.GetBytes (cfg.GetSection "Auth").["ServerSecret"]))) + let _ = svc.AddAuthorization () + let _ = svc.Configure (cfg.GetSection "Auth") let dbCfg = cfg.GetSection "Rethink" let log = svcs.GetRequiredService().CreateLogger "JobsJobsJobs.Api.Data.Startup" let conn = Data.Startup.createConnection dbCfg log - svc.AddSingleton conn |> ignore - Data.Startup.establishEnvironment dbCfg log conn |> Async.AwaitTask |> Async.RunSynchronously + let _ = svc.AddSingleton conn |> ignore + //Data.Startup.establishEnvironment dbCfg log conn |> Async.AwaitTask |> Async.RunSynchronously + + let _ = + svc.AddMarten(fun (opts : StoreOptions) -> + opts.Connection (cfg.GetConnectionString "PostgreSQL") + opts.RegisterDocumentTypes [ + typeof; typeof; typeof; typeof; typeof + typeof + ]) + .UseLightweightSessions() + () [] let main _ = diff --git a/src/JobsJobsJobs/Server/Data.fs b/src/JobsJobsJobs/Server/Data.fs index 3c74b31..094335b 100644 --- a/src/JobsJobsJobs/Server/Data.fs +++ b/src/JobsJobsJobs/Server/Data.fs @@ -113,6 +113,7 @@ module private Reconnect = open RethinkDb.Driver.Ast +open Marten /// Shorthand for the RethinkDB R variable (how every command starts) let private r = RethinkDb.Driver.RethinkDB.R @@ -305,6 +306,7 @@ module Map = displayName = row.stringOrNone "display_name" // TODO: deserialize from JSON otherContacts = [] // row.stringOrNone "other_contacts" + isLegacy = false } /// Create a continent from a data row @@ -331,6 +333,7 @@ module Map = text = (row.string >> Text) "listing_text" neededBy = row.fieldValueOrNone "needed_by" wasFilledHere = row.boolOrNone "was_filled_here" + isLegacy = false } /// Create a job listing for viewing from a data row @@ -353,6 +356,7 @@ module Map = lastUpdatedOn = row.fieldValue "last_updated_on" experience = row.stringOrNone "experience" |> Option.map Text skills = [] + isLegacy = false } /// Create a skill from a data row @@ -373,99 +377,34 @@ module Map = } +/// Convert a possibly-null record type to an option +let optional<'T> (value : 'T) = if isNull (box value) then None else Some value + +open System +open System.Linq + /// Profile data access functions [] module Profile = /// Count the current profiles - let count conn = - Sql.existingConnection conn - |> Sql.query - "SELECT COUNT(p.citizen_id) - FROM jjj.profile p - INNER JOIN jjj.citizen c ON c.id = p.citizen_id - WHERE c.is_legacy = FALSE" - |> Sql.executeRowAsync Map.toCount + let count (session : IQuerySession) = + session.Query().Where(fun p -> not p.isLegacy).LongCountAsync () /// Find a profile by citizen ID - let findById citizenId conn = backgroundTask { - let! tryProfile = - Sql.existingConnection conn - |> Sql.query - "SELECT * - FROM jjj.profile p - INNER JOIN jjj.citizen ON c.id = p.citizen_id - WHERE p.citizen_id = @id - AND c.is_legacy = FALSE" - |> Sql.parameters [ "@id", Sql.citizenId citizenId ] - |> Sql.executeAsync Map.toProfile - match List.tryHead tryProfile with - | Some profile -> - let! skills = - Sql.existingConnection conn - |> Sql.query "SELECT * FROM jjj.profile_skill WHERE citizen_id = @id" - |> Sql.parameters [ "@id", Sql.citizenId citizenId ] - |> Sql.executeAsync Map.toSkill - return Some { profile with skills = skills } - | None -> return None + let findById citizenId (session : IQuerySession) = backgroundTask { + let! profile = session.LoadAsync (CitizenId.value citizenId) + return + match optional profile with + | Some p when not p.isLegacy -> Some p + | Some _ + | None -> None } /// Insert or update a profile - let save (profile : Profile) conn = backgroundTask { - let! _ = - Sql.existingConnection conn - |> Sql.executeTransactionAsync [ - "INSERT INTO jjj.profile ( - citizen_id, is_seeking, is_public_searchable, is_public_linkable, continent_id, region, - is_available_remotely, is_available_full_time, biography, last_updated_on, experience - ) VALUES ( - @citizenId, @isSeeking, @isPublicSearchable, @isPublicLinkable, @continentId, @region, - @isAvailableRemotely, @isAvailableFullTime, @biography, @lastUpdatedOn, @experience - ) ON CONFLICT (citizen_id) DO UPDATE - SET is_seeking = EXCLUDED.is_seeking, - is_public_searchable = EXCLUDED.is_public_searchable, - is_public_linkable = EXCLUDED.is_public_linkable, - continent_id = EXCLUDED.continent_id, - region = EXCLUDED.region, - is_available_remotely = EXCLUDED.is_available_remotely, - is_available_full_time = EXCLUDED.is_available_full_time, - biography = EXCLUDED.biography, - last_updated_on = EXCLUDED.last_updated_on, - experience = EXCLUDED.experience", - [ [ "@citizenId", Sql.citizenId profile.id - "@isSeeking", Sql.bool profile.seekingEmployment - "@isPublicSearchable", Sql.bool profile.isPublic - "@isPublicLinkable", Sql.bool profile.isPublicLinkable - "@continentId", Sql.continentId profile.continentId - "@region", Sql.string profile.region - "@isAvailableRemotely", Sql.bool profile.remoteWork - "@isAvailableFullTime", Sql.bool profile.fullTime - "@biography", Sql.markdown profile.biography - "@lastUpdatedOn" |>Sql.param<| profile.lastUpdatedOn - "@experience", Sql.stringOrNone (Option.map MarkdownString.toString profile.experience) - ] ] - - "INSERT INTO jjj.profile ( - id, citizen_id, description, notes - ) VALUES ( - @id, @citizenId, @description, @notes - ) ON CONFLICT (id) DO UPDATE - SET description = EXCLUDED.description, - notes = EXCLUDED.notes", - profile.skills - |> List.map (fun skill -> [ - "@id", Sql.skillId skill.id - "@citizenId", Sql.citizenId profile.id - "@description", Sql.string skill.description - "@notes" , Sql.stringOrNone skill.notes - ]) - - $"""DELETE FROM jjj.profile - WHERE id NOT IN ({profile.skills |> List.mapi (fun idx _ -> $"@id{idx}") |> String.concat ", "})""", - [ profile.skills |> List.mapi (fun idx skill -> $"@id{idx}", Sql.skillId skill.id) ] - ] - () - } + [] + let save (profile : Profile) (session : IDocumentSession) = + session.Store profile /// Delete a citizen's profile let delete citizenId conn = backgroundTask { @@ -543,13 +482,13 @@ module Profile = module Citizen = /// Find a citizen by their ID - let findById citizenId conn = backgroundTask { - let! citizen = - Sql.existingConnection conn - |> Sql.query "SELECT * FROM jjj.citizen WHERE id = @id AND is_legacy = FALSE" - |> Sql.parameters [ "@id", Sql.citizenId citizenId ] - |> Sql.executeAsync Map.toCitizen - return List.tryHead citizen + let findById citizenId (session : IQuerySession) = backgroundTask { + let! citizen = session.LoadAsync (CitizenId.value citizenId) + return + match optional citizen with + | Some c when not c.isLegacy -> Some c + | Some _ + | None -> None } /// Find a citizen by their e-mail address diff --git a/src/JobsJobsJobs/Server/Handlers.fs b/src/JobsJobsJobs/Server/Handlers.fs index 89617e3..128de1f 100644 --- a/src/JobsJobsJobs/Server/Handlers.fs +++ b/src/JobsJobsJobs/Server/Handlers.fs @@ -1,10 +1,10 @@ /// Route handlers for Giraffe endpoints module JobsJobsJobs.Api.Handlers +open System.Threading open Giraffe open JobsJobsJobs.Domain open JobsJobsJobs.Domain.SharedTypes -open JobsJobsJobs.Domain.Types open Microsoft.AspNetCore.Http open Microsoft.Extensions.Logging @@ -54,11 +54,13 @@ module Error = [] module Helpers = + open System.Security.Claims + open System.Threading.Tasks open NodaTime + open Marten open Microsoft.Extensions.Configuration open Microsoft.Extensions.Options open RethinkDb.Driver.Net - open System.Security.Claims /// Get the NodaTime clock from the request context let clock (ctx : HttpContext) = ctx.GetService () @@ -74,6 +76,12 @@ module Helpers = /// Get the RethinkDB connection from the request context let conn (ctx : HttpContext) = ctx.GetService () + + /// Get a query session + let querySession (ctx : HttpContext) = ctx.GetService () + + /// Get a full document session + let docSession (ctx : HttpContext) = ctx.GetService () /// `None` if a `string option` is `None`, whitespace, or empty let noneIfBlank (s : string option) = @@ -98,8 +106,19 @@ module Helpers = /// Return an empty OK response let ok : HttpHandler = Successful.OK "" + + /// Convert a potentially-null record type to an option + let opt<'T> (it : Task<'T>) = task { + match! it with + | x when isNull (box x) -> return None + | x -> return Some x + } + + /// Shorthand for no cancellation token + let noCnx = CancellationToken.None +open System /// Handlers for /api/citizen routes [] @@ -152,15 +171,18 @@ module Citizen = } // GET: /api/citizen/[id] - let get citizenId : HttpHandler = authorize >=> fun next ctx -> task { - match! Data.Citizen.findById (CitizenId citizenId) (conn ctx) with + let get (citizenId : Guid) : HttpHandler = authorize >=> fun next ctx -> task { + use session = querySession ctx + match! session.LoadAsync citizenId |> opt with | Some citizen -> return! json citizen next ctx | None -> return! Error.notFound next ctx } // DELETE: /api/citizen let delete : HttpHandler = authorize >=> fun next ctx -> task { - do! Data.Citizen.delete (currentCitizenId ctx) (conn ctx) + use session = docSession ctx + session.Delete (CitizenId.value (currentCitizenId ctx)) + do! session.SaveChangesAsync () return! ok next ctx } @@ -171,7 +193,8 @@ module Continent = // GET: /api/continent/all let all : HttpHandler = fun next ctx -> task { - let! continents = Data.Continent.all (conn ctx) + use session = querySession ctx + let! continents = session.Query().ToListAsync noCnx return! json continents next ctx } @@ -230,20 +253,23 @@ module Listing = let add : HttpHandler = authorize >=> fun next ctx -> task { let! form = ctx.BindJsonAsync () let now = (clock ctx).GetCurrentInstant () - do! Data.Listing.add - { id = ListingId.create () - citizenId = currentCitizenId ctx - createdOn = now - title = form.title - continentId = ContinentId.ofString form.continentId - region = form.region - remoteWork = form.remoteWork - isExpired = false - updatedOn = now - text = Text form.text - neededBy = (form.neededBy |> Option.map parseDate) - wasFilledHere = None - } (conn ctx) + use session = docSession ctx + session.Store({ + id = ListingId.create () + citizenId = currentCitizenId ctx + createdOn = now + title = form.title + continentId = ContinentId.ofString form.continentId + region = form.region + remoteWork = form.remoteWork + isExpired = false + updatedOn = now + text = Text form.text + neededBy = (form.neededBy |> Option.map parseDate) + wasFilledHere = None + isLegacy = false + }) + do! session.SaveChangesAsync () return! ok next ctx } diff --git a/src/JobsJobsJobs/Server/JobsJobsJobs.Server.fsproj b/src/JobsJobsJobs/Server/JobsJobsJobs.Server.fsproj index f398460..b9f515e 100644 --- a/src/JobsJobsJobs/Server/JobsJobsJobs.Server.fsproj +++ b/src/JobsJobsJobs/Server/JobsJobsJobs.Server.fsproj @@ -24,6 +24,9 @@ + + + -- 2.45.1 From ba6d20c7dbfe7f857b4165cb46a40e128544e29c Mon Sep 17 00:00:00 2001 From: "Daniel J. Summers" Date: Wed, 24 Aug 2022 23:25:55 -0400 Subject: [PATCH 07/67] WIP on Marten data store --- src/JobsJobsJobs.sln | 7 + src/JobsJobsJobs/Domain/Types.fs | 33 ++- src/JobsJobsJobs/JobsJobsJobs.Data/Data.fs | 250 ++++++++++++++++++ .../JobsJobsJobs.Data.fsproj | 24 ++ src/JobsJobsJobs/JobsJobsJobs.Data/Json.fs | 24 ++ src/JobsJobsJobs/Server/App.fs | 16 +- src/JobsJobsJobs/Server/Handlers.fs | 47 ++-- .../Server/JobsJobsJobs.Server.fsproj | 4 +- 8 files changed, 365 insertions(+), 40 deletions(-) create mode 100644 src/JobsJobsJobs/JobsJobsJobs.Data/Data.fs create mode 100644 src/JobsJobsJobs/JobsJobsJobs.Data/JobsJobsJobs.Data.fsproj create mode 100644 src/JobsJobsJobs/JobsJobsJobs.Data/Json.fs diff --git a/src/JobsJobsJobs.sln b/src/JobsJobsJobs.sln index b1398c3..c226a73 100644 --- a/src/JobsJobsJobs.sln +++ b/src/JobsJobsJobs.sln @@ -17,6 +17,8 @@ Project("{F2A71F9B-5D33-465A-A702-920D77279786}") = "Domain", "JobsJobsJobs\Doma EndProject Project("{F2A71F9B-5D33-465A-A702-920D77279786}") = "Api", "JobsJobsJobs\Server\JobsJobsJobs.Server.fsproj", "{8F5A3D1E-562B-4F27-9787-6CB14B35E69E}" EndProject +Project("{F2A71F9B-5D33-465A-A702-920D77279786}") = "JobsJobsJobs.Data", "JobsJobsJobs\JobsJobsJobs.Data\JobsJobsJobs.Data.fsproj", "{30CC1E7C-A843-4DAC-9058-E7C6ACBCE85D}" +EndProject Global GlobalSection(SolutionConfigurationPlatforms) = preSolution Debug|Any CPU = Debug|Any CPU @@ -31,6 +33,10 @@ Global {8F5A3D1E-562B-4F27-9787-6CB14B35E69E}.Debug|Any CPU.Build.0 = Debug|Any CPU {8F5A3D1E-562B-4F27-9787-6CB14B35E69E}.Release|Any CPU.ActiveCfg = Release|Any CPU {8F5A3D1E-562B-4F27-9787-6CB14B35E69E}.Release|Any CPU.Build.0 = Release|Any CPU + {30CC1E7C-A843-4DAC-9058-E7C6ACBCE85D}.Debug|Any CPU.ActiveCfg = Debug|Any CPU + {30CC1E7C-A843-4DAC-9058-E7C6ACBCE85D}.Debug|Any CPU.Build.0 = Debug|Any CPU + {30CC1E7C-A843-4DAC-9058-E7C6ACBCE85D}.Release|Any CPU.ActiveCfg = Release|Any CPU + {30CC1E7C-A843-4DAC-9058-E7C6ACBCE85D}.Release|Any CPU.Build.0 = Release|Any CPU EndGlobalSection GlobalSection(SolutionProperties) = preSolution HideSolutionNode = FALSE @@ -41,5 +47,6 @@ Global GlobalSection(NestedProjects) = preSolution {C81278DA-DA97-4E55-AB39-4B88565B615D} = {FA833B24-B8F6-4CE6-A044-99257EAC02FF} {8F5A3D1E-562B-4F27-9787-6CB14B35E69E} = {FA833B24-B8F6-4CE6-A044-99257EAC02FF} + {30CC1E7C-A843-4DAC-9058-E7C6ACBCE85D} = {FA833B24-B8F6-4CE6-A044-99257EAC02FF} EndGlobalSection EndGlobal diff --git a/src/JobsJobsJobs/Domain/Types.fs b/src/JobsJobsJobs/Domain/Types.fs index eb094a4..c1deb1b 100644 --- a/src/JobsJobsJobs/Domain/Types.fs +++ b/src/JobsJobsJobs/Domain/Types.fs @@ -38,6 +38,9 @@ type Citizen = /// Whether this is a legacy citizen isLegacy : bool } +with + /// Unwrapped ID for database PK use + member this.DbId = CitizenId.value this.id /// Support functions for citizens module Citizen = @@ -56,6 +59,18 @@ type Continent = /// The name of the continent name : string } +with + /// Unwrapped ID for database PK use + member this.DbId = ContinentId.value this.id + +/// Support functions for continents +module Continent = + + /// An empty continent + let empty = + { id = ContinentId Guid.Empty + name = "" + } /// A job listing @@ -108,7 +123,7 @@ type SecurityInfo = Id : CitizenId /// The number of failed log on attempts (reset to 0 on successful log on) - FailedLogOnAttempts : int16 + FailedLogOnAttempts : int /// Whether the account is locked AccountLocked : bool @@ -122,6 +137,22 @@ type SecurityInfo = /// When the token expires TokenExpires : Instant option } +with + /// Unwrapped ID for database PK use + member this.DbId = CitizenId.value this.Id + +/// 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 skill the job seeker possesses diff --git a/src/JobsJobsJobs/JobsJobsJobs.Data/Data.fs b/src/JobsJobsJobs/JobsJobsJobs.Data/Data.fs new file mode 100644 index 0000000..69cb3c0 --- /dev/null +++ b/src/JobsJobsJobs/JobsJobsJobs.Data/Data.fs @@ -0,0 +1,250 @@ +namespace JobsJobsJobs.Data + +open JobsJobsJobs.Domain +open Marten +open Marten.PLv8 +open Microsoft.Extensions.Configuration + +/// Connection management for the Marten document store +module Connection = + + open Weasel.Core + + /// The configuration from which a document store will be created + let mutable private config : IConfiguration option = None + + /// Lazy initialization for the Marten document store, constructed when setUp() is called + let private lazyStore = lazy (task { + match config with + | Some cfg -> + let store = + DocumentStore.For(fun opts -> + opts.Connection (cfg.GetConnectionString "PostgreSQL") + opts.RegisterDocumentTypes [ + typeof; typeof; typeof; typeof; typeof + typeof + ] + opts.AutoCreateSchemaObjects <- AutoCreate.CreateOrUpdate + opts.UseJavascriptTransformsAndPatching () + + let _ = opts.Schema.For().Identity (fun c -> c.DbId) + let _ = opts.Schema.For().Identity (fun si -> si.DbId) + ()) + do! store.Storage.ApplyAllConfiguredChangesToDatabaseAsync () + return Ok store + | None -> return Error "Connection.setUp() must be called before accessing a document session" + }) + + /// Set up the data connection from the given configuration + let setUp (cfg : IConfiguration) = + config <- Some cfg + ignore (lazyStore.Force ()) + + /// A read-only document session + let querySession () = + match lazyStore.Force().Result with + | Ok store -> store.QuerySession () + | Error msg -> raise (invalidOp msg) + + /// A read/write document session + let docSession () = + match lazyStore.Force().Result with + | Ok store -> store.LightweightSession () + | Error msg -> raise (invalidOp msg) + + +/// Helper functions for data retrieval +[] +module private Helpers = + + open System.Threading + + /// Convert a possibly-null record type to an option + let optional<'T> (value : 'T) = if isNull (box value) then None else Some value + + /// Shorthand for no cancellation token + let noCnx = CancellationToken.None + + +open System.Linq +open Connection +open Marten.PLv8.Patching + +/// Citizen data access functions +[] +module Citizens = + + /// Delete a citizen by their ID + let deleteById citizenId = backgroundTask { + use session = docSession () + session.Delete (CitizenId.value citizenId) + do! session.SaveChangesAsync () + } + + /// Find a citizen by their ID + let findById citizenId = backgroundTask { + use session = querySession () + let! citizen = session.LoadAsync (CitizenId.value citizenId) + return + match optional citizen with + | Some c when not c.isLegacy -> Some c + | Some _ + | None -> None + } + + /// Save a citizen + let save (citizen : Citizen) = backgroundTask { + use session = docSession () + session.Store citizen + do! session.SaveChangesAsync () + } + + /// Attempt a user log on + let tryLogOn email (pwCheck : string -> bool) now = backgroundTask { + use session = docSession () + let! tryCitizen = + session.Query().Where(fun c -> c.email = email && not c.isLegacy).SingleOrDefaultAsync () + match optional tryCitizen with + | Some citizen -> + let! tryInfo = session.LoadAsync citizen.DbId + let! info = backgroundTask { + match optional tryInfo with + | Some it -> return it + | None -> + let it = { SecurityInfo.empty with Id = citizen.id } + session.Store it + do! session.SaveChangesAsync () + return it + } + if info.AccountLocked then return Error "Log on unsuccessful (Account Locked)" + elif pwCheck citizen.passwordHash then + session.Patch(citizen.DbId).Set((fun si -> si.FailedLogOnAttempts), 0) + session.Patch(citizen.DbId).Set((fun c -> c.lastSeenOn), now) + do! session.SaveChangesAsync () + return Ok { citizen with lastSeenOn = now } + else + let locked = info.FailedLogOnAttempts >= 4 + session.Patch(citizen.DbId).Increment(fun si -> si.FailedLogOnAttempts) + if locked then session.Patch(citizen.DbId).Set((fun si -> si.AccountLocked), true) + do! session.SaveChangesAsync () + return Error $"""Log on unsuccessful{if locked then " - Account is now locked" else ""}""" + | None -> return Error "Log on unsuccessful" + } + + +/// Continent data access functions +[] +module Continents = + + /// Retrieve all continents + let all () = backgroundTask { + use session = querySession () + let! it = session.Query().ToListAsync noCnx + return List.ofSeq it + } + + /// Retrieve a continent by its ID + let findById continentId = backgroundTask { + use session = querySession () + let! tryContinent = session.LoadAsync (ContinentId.value continentId) + return optional tryContinent + } + + +open System +open JobsJobsJobs.Domain.SharedTypes + +/// Job listing access functions +[] +module Listings = + + open System.Collections.Generic + + /// Find all job listings posted by the given citizen + let findByCitizen citizenId = backgroundTask { + use session = querySession () + let continents = Dictionary () + let! listings = + session.Query() + .Include((fun l -> l.continentId :> obj), continents) + .Where(fun l -> l.citizenId = citizenId && not l.isLegacy) + .ToListAsync () + return + listings + |> Seq.map (fun l -> { listing = l; continent = continents[l.continentId] }) + |> List.ofSeq + } + + /// Find a listing by its ID + let findById listingId = backgroundTask { + use session = querySession () + let! tryListing = session.LoadAsync (ListingId.value listingId) + match optional tryListing 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 { + use session = querySession () + let mutable continent = Continent.empty + let! tryListing = + session.Query() + .Include((fun l -> l.continentId :> obj), fun c -> continent <- c) + .Where(fun l -> l.id = listingId && not l.isLegacy) + .SingleOrDefaultAsync () + match optional tryListing with + | Some listing -> return Some { listing = listing; continent = continent } + | None -> return None + } + + /// Save a listing + let save (listing : Listing) = backgroundTask { + use session = docSession () + session.Store listing + do! session.SaveChangesAsync () + } + + /// Search job listings + let search (search : ListingSearch) = backgroundTask { + use session = querySession () + let continents = Dictionary () + let searchQuery = + seq bool> { + match search.continentId with + | Some contId -> + fun (l : Listing) -> l.continentId = (ContinentId.ofString contId) + | None -> () + match search.region with + | Some region -> fun (l : Listing) -> l.region.Contains (region, StringComparison.OrdinalIgnoreCase) + | None -> () + if search.remoteWork <> "" then + fun (l : Listing) -> l.remoteWork = (search.remoteWork = "yes") + // match search.text with + // | Some text -> fun (l : Listing) -> l.text.Contains (text, StringComparison.OrdinalIgnoreCase) + // | None -> () + } + |> Seq.fold + (fun q filter -> Queryable.Where(q, filter)) + (session.Query() + .Include((fun l -> l.continentId :> obj), continents) + .Where(fun l -> not l.isExpired && not l.isLegacy)) + let! results = searchQuery.ToListAsync () + return + results + |> Seq.map (fun l -> { listing = l; continent = continents[l.continentId] }) + |> List.ofSeq + } + +/// Success story data access functions +[] +module Successes = + + /// Save a success story + let save (success : Success) = backgroundTask { + use session = docSession () + session.Store success + do! session.SaveChangesAsync () + } + \ No newline at end of file diff --git a/src/JobsJobsJobs/JobsJobsJobs.Data/JobsJobsJobs.Data.fsproj b/src/JobsJobsJobs/JobsJobsJobs.Data/JobsJobsJobs.Data.fsproj new file mode 100644 index 0000000..c7191ec --- /dev/null +++ b/src/JobsJobsJobs/JobsJobsJobs.Data/JobsJobsJobs.Data.fsproj @@ -0,0 +1,24 @@ + + + + net6.0 + true + + + + + + + + + + + + + + + + + + + diff --git a/src/JobsJobsJobs/JobsJobsJobs.Data/Json.fs b/src/JobsJobsJobs/JobsJobsJobs.Data/Json.fs new file mode 100644 index 0000000..de761d0 --- /dev/null +++ b/src/JobsJobsJobs/JobsJobsJobs.Data/Json.fs @@ -0,0 +1,24 @@ +module JobsJobsJobs.Data.Json + +open System +open System.Text.Json +open System.Text.Json.Serialization +open JobsJobsJobs.Domain + +/// Convert citizen IDs to their string-GUID representation +type CitizenIdJsonConverter () = + inherit JsonConverter () + override this.Read(reader, _, _) = + CitizenId (Guid.Parse (reader.GetString ())) + override this.Write(writer, value, _) = + writer.WriteStringValue ((CitizenId.value value).ToString ()) + + +/// JsonSerializer options that use the custom converters +let options = + let opts = JsonSerializerOptions () + [ CitizenIdJsonConverter () :> JsonConverter + JsonFSharpConverter () + ] + |> List.iter opts.Converters.Add + opts diff --git a/src/JobsJobsJobs/Server/App.fs b/src/JobsJobsJobs/Server/App.fs index 0de9c41..fc88566 100644 --- a/src/JobsJobsJobs/Server/App.fs +++ b/src/JobsJobsJobs/Server/App.fs @@ -24,13 +24,12 @@ let configureApp (app : IApplicationBuilder) = open Newtonsoft.Json open NodaTime -open Marten open Microsoft.AspNetCore.Authentication.JwtBearer open Microsoft.Extensions.Configuration open Microsoft.Extensions.Logging open Microsoft.IdentityModel.Tokens open System.Text -open JobsJobsJobs.Domain +open JobsJobsJobs.Data open JobsJobsJobs.Domain.SharedTypes /// Configure dependency injection @@ -47,6 +46,7 @@ let configureServices (svc : IServiceCollection) = let svcs = svc.BuildServiceProvider () let cfg = svcs.GetRequiredService () + // Set up JWTs for API access let _ = svc.AddAuthentication(fun o -> o.DefaultAuthenticateScheme <- JwtBearerDefaults.AuthenticationScheme @@ -68,16 +68,8 @@ let configureServices (svc : IServiceCollection) = let log = svcs.GetRequiredService().CreateLogger "JobsJobsJobs.Api.Data.Startup" let conn = Data.Startup.createConnection dbCfg log let _ = svc.AddSingleton conn |> ignore - //Data.Startup.establishEnvironment dbCfg log conn |> Async.AwaitTask |> Async.RunSynchronously - - let _ = - svc.AddMarten(fun (opts : StoreOptions) -> - opts.Connection (cfg.GetConnectionString "PostgreSQL") - opts.RegisterDocumentTypes [ - typeof; typeof; typeof; typeof; typeof - typeof - ]) - .UseLightweightSessions() + // Set up the Marten data store + let _ = Connection.setUp cfg () [] diff --git a/src/JobsJobsJobs/Server/Handlers.fs b/src/JobsJobsJobs/Server/Handlers.fs index 128de1f..2f910ee 100644 --- a/src/JobsJobsJobs/Server/Handlers.fs +++ b/src/JobsJobsJobs/Server/Handlers.fs @@ -119,6 +119,7 @@ module Helpers = open System +open JobsJobsJobs.Data /// Handlers for /api/citizen routes [] @@ -171,18 +172,15 @@ module Citizen = } // GET: /api/citizen/[id] - let get (citizenId : Guid) : HttpHandler = authorize >=> fun next ctx -> task { - use session = querySession ctx - match! session.LoadAsync citizenId |> opt with + let get citizenId : HttpHandler = authorize >=> fun next ctx -> task { + match! Citizens.findById (CitizenId citizenId) with | Some citizen -> return! json citizen next ctx | None -> return! Error.notFound next ctx } // DELETE: /api/citizen let delete : HttpHandler = authorize >=> fun next ctx -> task { - use session = docSession ctx - session.Delete (CitizenId.value (currentCitizenId ctx)) - do! session.SaveChangesAsync () + do! Citizens.deleteById (currentCitizenId ctx) return! ok next ctx } @@ -193,8 +191,7 @@ module Continent = // GET: /api/continent/all let all : HttpHandler = fun next ctx -> task { - use session = querySession ctx - let! continents = session.Query().ToListAsync noCnx + let! continents = Continents.all () return! json continents next ctx } @@ -224,27 +221,26 @@ module Instances = module Listing = open NodaTime - open System /// Parse the string we receive from JSON into a NodaTime local date let private parseDate = DateTime.Parse >> LocalDate.FromDateTime // GET: /api/listings/mine let mine : HttpHandler = authorize >=> fun next ctx -> task { - let! listings = Data.Listing.findByCitizen (currentCitizenId ctx) (conn ctx) + let! listings = Listings.findByCitizen (currentCitizenId ctx) return! json listings next ctx } // GET: /api/listing/[id] let get listingId : HttpHandler = authorize >=> fun next ctx -> task { - match! Data.Listing.findById (ListingId listingId) (conn ctx) with + match! Listings.findById (ListingId listingId) with | Some listing -> return! json listing next ctx | None -> return! Error.notFound next ctx } // GET: /api/listing/view/[id] let view listingId : HttpHandler = authorize >=> fun next ctx -> task { - match! Data.Listing.findByIdForView (ListingId listingId) (conn ctx) with + match! Listings.findByIdForView (ListingId listingId) with | Some listing -> return! json listing next ctx | None -> return! Error.notFound next ctx } @@ -253,8 +249,7 @@ module Listing = let add : HttpHandler = authorize >=> fun next ctx -> task { let! form = ctx.BindJsonAsync () let now = (clock ctx).GetCurrentInstant () - use session = docSession ctx - session.Store({ + do! Listings.save { id = ListingId.create () citizenId = currentCitizenId ctx createdOn = now @@ -268,19 +263,18 @@ module Listing = neededBy = (form.neededBy |> Option.map parseDate) wasFilledHere = None isLegacy = false - }) - do! session.SaveChangesAsync () + } return! ok next ctx } // PUT: /api/listing/[id] let update listingId : HttpHandler = authorize >=> fun next ctx -> task { let dbConn = conn ctx - match! Data.Listing.findById (ListingId listingId) dbConn with + match! Listings.findById (ListingId listingId) with | Some listing when listing.citizenId <> (currentCitizenId ctx) -> return! Error.notAuthorized next ctx | Some listing -> let! form = ctx.BindJsonAsync () - do! Data.Listing.update + do! Listings.save { listing with title = form.title continentId = ContinentId.ofString form.continentId @@ -289,7 +283,7 @@ module Listing = text = Text form.text neededBy = form.neededBy |> Option.map parseDate updatedOn = (clock ctx).GetCurrentInstant () - } dbConn + } return! ok next ctx | None -> return! Error.notFound next ctx } @@ -298,21 +292,26 @@ module Listing = let expire listingId : HttpHandler = authorize >=> fun next ctx -> task { let dbConn = conn ctx let now = clock(ctx).GetCurrentInstant () - match! Data.Listing.findById (ListingId listingId) dbConn with + match! Listings.findById (ListingId listingId) with | Some listing when listing.citizenId <> (currentCitizenId ctx) -> return! Error.notAuthorized next ctx | Some listing -> let! form = ctx.BindJsonAsync () - do! Data.Listing.expire listing.id form.fromHere now dbConn + do! Listings.save + { listing with + isExpired = true + wasFilledHere = Some form.fromHere + updatedOn = now + } match form.successStory with | Some storyText -> - do! Data.Success.save + do! Successes.save { id = SuccessId.create() citizenId = currentCitizenId ctx recordedOn = now fromHere = form.fromHere source = "listing" story = (Text >> Some) storyText - } dbConn + } | None -> () return! ok next ctx | None -> return! Error.notFound next ctx @@ -321,7 +320,7 @@ module Listing = // GET: /api/listing/search let search : HttpHandler = authorize >=> fun next ctx -> task { let search = ctx.BindQueryString () - let! results = Data.Listing.search search (conn ctx) + let! results = Listings.search search return! json results next ctx } diff --git a/src/JobsJobsJobs/Server/JobsJobsJobs.Server.fsproj b/src/JobsJobsJobs/Server/JobsJobsJobs.Server.fsproj index b9f515e..4dc6bbd 100644 --- a/src/JobsJobsJobs/Server/JobsJobsJobs.Server.fsproj +++ b/src/JobsJobsJobs/Server/JobsJobsJobs.Server.fsproj @@ -16,6 +16,7 @@ + @@ -24,9 +25,6 @@ - - - -- 2.45.1 From 6896b0e60e981253147f9cd802f9d1b70dba6a12 Mon Sep 17 00:00:00 2001 From: "Daniel J. Summers" Date: Fri, 26 Aug 2022 16:34:39 -0400 Subject: [PATCH 08/67] First cut of Marten data implementation --- build.fsx.lock | 159 ++-- .../Domain/JobsJobsJobs.Domain.fsproj | 4 +- src/JobsJobsJobs/Domain/SharedTypes.fs | 4 +- src/JobsJobsJobs/Domain/Types.fs | 46 ++ src/JobsJobsJobs/JobsJobsJobs.Data/Data.fs | 373 +++++++-- .../JobsJobsJobs.Data.fsproj | 4 +- src/JobsJobsJobs/JobsJobsJobs.Data/Json.fs | 29 +- src/JobsJobsJobs/Server/App.fs | 21 +- src/JobsJobsJobs/Server/Auth.fs | 1 - src/JobsJobsJobs/Server/Data.fs | 745 ------------------ src/JobsJobsJobs/Server/Handlers.fs | 196 ++--- .../Server/JobsJobsJobs.Server.fsproj | 10 +- 12 files changed, 551 insertions(+), 1041 deletions(-) delete mode 100644 src/JobsJobsJobs/Server/Data.fs diff --git a/build.fsx.lock b/build.fsx.lock index 3d3a148..36b916f 100644 --- a/build.fsx.lock +++ b/build.fsx.lock @@ -5,95 +5,95 @@ NUGET BlackFox.VsWhere (1.1) FSharp.Core (>= 4.2.3) Microsoft.Win32.Registry (>= 4.7) - Fake.Core.CommandLineParsing (5.22) + Fake.Core.CommandLineParsing (5.23) FParsec (>= 1.1.1) FSharp.Core (>= 6.0) - Fake.Core.Context (5.22) + Fake.Core.Context (5.23) FSharp.Core (>= 6.0) - Fake.Core.Environment (5.22) + Fake.Core.Environment (5.23) FSharp.Core (>= 6.0) - Fake.Core.FakeVar (5.22) - Fake.Core.Context (>= 5.22) + Fake.Core.FakeVar (5.23) + Fake.Core.Context (>= 5.23) FSharp.Core (>= 6.0) - Fake.Core.Process (5.22) - Fake.Core.Environment (>= 5.22) - Fake.Core.FakeVar (>= 5.22) - Fake.Core.String (>= 5.22) - Fake.Core.Trace (>= 5.22) - Fake.IO.FileSystem (>= 5.22) + Fake.Core.Process (5.23) + Fake.Core.Environment (>= 5.23) + Fake.Core.FakeVar (>= 5.23) + Fake.Core.String (>= 5.23) + Fake.Core.Trace (>= 5.23) + Fake.IO.FileSystem (>= 5.23) FSharp.Core (>= 6.0) System.Collections.Immutable (>= 5.0) - Fake.Core.SemVer (5.22) + Fake.Core.SemVer (5.23) FSharp.Core (>= 6.0) - Fake.Core.String (5.22) + Fake.Core.String (5.23) FSharp.Core (>= 6.0) - Fake.Core.Target (5.22) - Fake.Core.CommandLineParsing (>= 5.22) - Fake.Core.Context (>= 5.22) - Fake.Core.Environment (>= 5.22) - Fake.Core.FakeVar (>= 5.22) - Fake.Core.Process (>= 5.22) - Fake.Core.String (>= 5.22) - Fake.Core.Trace (>= 5.22) + Fake.Core.Target (5.23) + Fake.Core.CommandLineParsing (>= 5.23) + Fake.Core.Context (>= 5.23) + Fake.Core.Environment (>= 5.23) + Fake.Core.FakeVar (>= 5.23) + Fake.Core.Process (>= 5.23) + Fake.Core.String (>= 5.23) + Fake.Core.Trace (>= 5.23) FSharp.Control.Reactive (>= 5.0.2) FSharp.Core (>= 6.0) - Fake.Core.Tasks (5.22) - Fake.Core.Trace (>= 5.22) + Fake.Core.Tasks (5.23) + Fake.Core.Trace (>= 5.23) FSharp.Core (>= 6.0) - Fake.Core.Trace (5.22) - Fake.Core.Environment (>= 5.22) - Fake.Core.FakeVar (>= 5.22) + Fake.Core.Trace (5.23) + Fake.Core.Environment (>= 5.23) + Fake.Core.FakeVar (>= 5.23) FSharp.Core (>= 6.0) - Fake.Core.Xml (5.22) - Fake.Core.String (>= 5.22) + Fake.Core.Xml (5.23) + Fake.Core.String (>= 5.23) FSharp.Core (>= 6.0) - Fake.DotNet.Cli (5.22) - Fake.Core.Environment (>= 5.22) - Fake.Core.Process (>= 5.22) - Fake.Core.String (>= 5.22) - Fake.Core.Trace (>= 5.22) - Fake.DotNet.MSBuild (>= 5.22) - Fake.DotNet.NuGet (>= 5.22) - Fake.IO.FileSystem (>= 5.22) + Fake.DotNet.Cli (5.23) + Fake.Core.Environment (>= 5.23) + Fake.Core.Process (>= 5.23) + Fake.Core.String (>= 5.23) + Fake.Core.Trace (>= 5.23) + Fake.DotNet.MSBuild (>= 5.23) + Fake.DotNet.NuGet (>= 5.23) + Fake.IO.FileSystem (>= 5.23) FSharp.Core (>= 6.0) Mono.Posix.NETStandard (>= 1.0) Newtonsoft.Json (>= 13.0.1) - Fake.DotNet.MSBuild (5.22) + Fake.DotNet.MSBuild (5.23) BlackFox.VsWhere (>= 1.1) - Fake.Core.Environment (>= 5.22) - Fake.Core.Process (>= 5.22) - Fake.Core.String (>= 5.22) - Fake.Core.Trace (>= 5.22) - Fake.IO.FileSystem (>= 5.22) + Fake.Core.Environment (>= 5.23) + Fake.Core.Process (>= 5.23) + Fake.Core.String (>= 5.23) + Fake.Core.Trace (>= 5.23) + Fake.IO.FileSystem (>= 5.23) FSharp.Core (>= 6.0) MSBuild.StructuredLogger (>= 2.1.545) - Fake.DotNet.NuGet (5.22) - Fake.Core.Environment (>= 5.22) - Fake.Core.Process (>= 5.22) - Fake.Core.SemVer (>= 5.22) - Fake.Core.String (>= 5.22) - Fake.Core.Tasks (>= 5.22) - Fake.Core.Trace (>= 5.22) - Fake.Core.Xml (>= 5.22) - Fake.IO.FileSystem (>= 5.22) - Fake.Net.Http (>= 5.22) + Fake.DotNet.NuGet (5.23) + Fake.Core.Environment (>= 5.23) + Fake.Core.Process (>= 5.23) + Fake.Core.SemVer (>= 5.23) + Fake.Core.String (>= 5.23) + Fake.Core.Tasks (>= 5.23) + Fake.Core.Trace (>= 5.23) + Fake.Core.Xml (>= 5.23) + Fake.IO.FileSystem (>= 5.23) + Fake.Net.Http (>= 5.23) FSharp.Core (>= 6.0) Newtonsoft.Json (>= 13.0.1) NuGet.Protocol (>= 5.11) - Fake.IO.FileSystem (5.22) - Fake.Core.String (>= 5.22) + Fake.IO.FileSystem (5.23) + Fake.Core.String (>= 5.23) FSharp.Core (>= 6.0) - Fake.JavaScript.Npm (5.22) - Fake.Core.Environment (>= 5.22) - Fake.Core.Process (>= 5.22) - Fake.IO.FileSystem (>= 5.22) - Fake.Testing.Common (>= 5.22) + Fake.JavaScript.Npm (5.23) + Fake.Core.Environment (>= 5.23) + Fake.Core.Process (>= 5.23) + Fake.IO.FileSystem (>= 5.23) + Fake.Testing.Common (>= 5.23) FSharp.Core (>= 6.0) - Fake.Net.Http (5.22) - Fake.Core.Trace (>= 5.22) + Fake.Net.Http (5.23) + Fake.Core.Trace (>= 5.23) FSharp.Core (>= 6.0) - Fake.Testing.Common (5.22) - Fake.Core.Trace (>= 5.22) + Fake.Testing.Common (5.23) + Fake.Core.Trace (>= 5.23) FSharp.Core (>= 6.0) FParsec (1.1.1) FSharp.Core (>= 4.3.4) @@ -112,9 +112,8 @@ NUGET System.Text.Encoding.CodePages (>= 4.0.1) - restriction: || (== net6.0) (&& (== netstandard2.0) (>= net6.0)) System.Text.Json (>= 6.0) - restriction: || (== net6.0) (&& (== netstandard2.0) (>= net472)) (&& (== netstandard2.0) (>= net6.0)) System.Threading.Tasks.Dataflow (>= 6.0) - restriction: || (== net6.0) (&& (== netstandard2.0) (>= net472)) (&& (== netstandard2.0) (>= net6.0)) - Microsoft.Build.Framework (17.2) - Microsoft.Win32.Registry (>= 4.3) - System.Security.Permissions (>= 4.7) + Microsoft.Build.Framework (17.3.1) + System.Security.Permissions (>= 6.0) Microsoft.Build.Tasks.Core (17.2) Microsoft.Build.Framework (>= 17.2) Microsoft.Build.Utilities.Core (>= 17.2) @@ -139,7 +138,7 @@ NUGET Microsoft.NET.StringTools (1.0) System.Memory (>= 4.5.4) System.Runtime.CompilerServices.Unsafe (>= 5.0) - Microsoft.NETCore.Platforms (6.0.4) - restriction: || (&& (== net6.0) (< netcoreapp3.1)) (&& (== net6.0) (< netstandard1.2)) (&& (== net6.0) (< netstandard1.3)) (&& (== net6.0) (< netstandard1.5)) (== netstandard2.0) + Microsoft.NETCore.Platforms (6.0.5) - restriction: || (&& (== net6.0) (< netcoreapp3.1)) (&& (== net6.0) (< netstandard1.2)) (&& (== net6.0) (< netstandard1.3)) (&& (== net6.0) (< netstandard1.5)) (== netstandard2.0) Microsoft.NETCore.Targets (5.0) - restriction: || (&& (== net6.0) (< netcoreapp3.1)) (&& (== net6.0) (< netstandard1.2)) (&& (== net6.0) (< netstandard1.3)) (&& (== net6.0) (< netstandard1.5)) (== netstandard2.0) Microsoft.Win32.Registry (5.0) System.Buffers (>= 4.5.1) - restriction: || (&& (== net6.0) (>= monoandroid) (< netstandard1.3)) (&& (== net6.0) (>= monotouch)) (&& (== net6.0) (< netcoreapp2.0)) (&& (== net6.0) (>= xamarinios)) (&& (== net6.0) (>= xamarinmac)) (&& (== net6.0) (>= xamarintvos)) (&& (== net6.0) (>= xamarinwatchos)) (== netstandard2.0) @@ -154,21 +153,21 @@ NUGET Microsoft.Build.Tasks.Core (>= 16.10) Microsoft.Build.Utilities.Core (>= 16.10) Newtonsoft.Json (13.0.1) - NuGet.Common (6.2.1) - NuGet.Frameworks (>= 6.2.1) - NuGet.Configuration (6.2.1) - NuGet.Common (>= 6.2.1) + NuGet.Common (6.3) + NuGet.Frameworks (>= 6.3) + NuGet.Configuration (6.3) + NuGet.Common (>= 6.3) System.Security.Cryptography.ProtectedData (>= 4.4) - NuGet.Frameworks (6.2.1) - NuGet.Packaging (6.2.1) + NuGet.Frameworks (6.3) + NuGet.Packaging (6.3) Newtonsoft.Json (>= 13.0.1) - NuGet.Configuration (>= 6.2.1) - NuGet.Versioning (>= 6.2.1) + NuGet.Configuration (>= 6.3) + NuGet.Versioning (>= 6.3) System.Security.Cryptography.Cng (>= 5.0) System.Security.Cryptography.Pkcs (>= 5.0) - NuGet.Protocol (6.2.1) - NuGet.Packaging (>= 6.2.1) - NuGet.Versioning (6.2.1) + NuGet.Protocol (6.3) + NuGet.Packaging (>= 6.3) + NuGet.Versioning (6.3) System.Buffers (4.5.1) - restriction: || (&& (== net6.0) (>= monoandroid) (< netstandard1.3)) (&& (== net6.0) (>= monotouch)) (&& (== net6.0) (< netcoreapp2.0)) (&& (== net6.0) (>= xamarinios)) (&& (== net6.0) (>= xamarinmac)) (&& (== net6.0) (>= xamarintvos)) (&& (== net6.0) (>= xamarinwatchos)) (== netstandard2.0) System.CodeDom (6.0) System.Collections.Immutable (6.0) @@ -210,10 +209,10 @@ NUGET System.Memory (>= 4.5.4) - restriction: || (&& (== net6.0) (< netstandard2.1)) (== netstandard2.0) System.Security.Cryptography.Cng (>= 5.0) - restriction: || (&& (== net6.0) (< netcoreapp3.1)) (&& (== net6.0) (< netstandard2.1)) (== netstandard2.0) System.Security.Cryptography.ProtectedData (6.0) - System.Security.Cryptography.Xml (6.0) + System.Security.Cryptography.Xml (6.0.1) System.Memory (>= 4.5.4) - restriction: == netstandard2.0 System.Security.AccessControl (>= 6.0) - System.Security.Cryptography.Pkcs (>= 6.0) + System.Security.Cryptography.Pkcs (>= 6.0.1) System.Security.Permissions (6.0) System.Security.AccessControl (>= 6.0) System.Windows.Extensions (>= 6.0) - restriction: || (== net6.0) (&& (== netstandard2.0) (>= netcoreapp3.1)) diff --git a/src/JobsJobsJobs/Domain/JobsJobsJobs.Domain.fsproj b/src/JobsJobsJobs/Domain/JobsJobsJobs.Domain.fsproj index ee4d625..6c6db14 100644 --- a/src/JobsJobsJobs/Domain/JobsJobsJobs.Domain.fsproj +++ b/src/JobsJobsJobs/Domain/JobsJobsJobs.Domain.fsproj @@ -13,9 +13,9 @@ - + - + diff --git a/src/JobsJobsJobs/Domain/SharedTypes.fs b/src/JobsJobsJobs/Domain/SharedTypes.fs index d52a101..649f7bf 100644 --- a/src/JobsJobsJobs/Domain/SharedTypes.fs +++ b/src/JobsJobsJobs/Domain/SharedTypes.fs @@ -1,7 +1,7 @@ /// Types intended to be shared between the API and the client application module JobsJobsJobs.Domain.SharedTypes -open JobsJobsJobs.Domain.Types +open JobsJobsJobs.Domain open Microsoft.Extensions.Options open NodaTime @@ -202,7 +202,7 @@ type ProfileForm = module ProfileForm = /// Create an instance of this form from the given profile - let fromProfile (profile : Types.Profile) = + let fromProfile (profile : Profile) = { isSeekingEmployment = profile.seekingEmployment isPublic = profile.isPublic realName = "" diff --git a/src/JobsJobsJobs/Domain/Types.fs b/src/JobsJobsJobs/Domain/Types.fs index c1deb1b..a24354a 100644 --- a/src/JobsJobsJobs/Domain/Types.fs +++ b/src/JobsJobsJobs/Domain/Types.fs @@ -45,6 +45,19 @@ with /// 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}" @@ -116,6 +129,26 @@ type 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 = "" + remoteWork = false + isExpired = false + updatedOn = Instant.MinValue + text = Text "" + neededBy = None + wasFilledHere = None + isLegacy = false + } + /// Security settings for a user type SecurityInfo = @@ -253,3 +286,16 @@ type Success = /// 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 + fromHere = false + source = "" + story = None + } diff --git a/src/JobsJobsJobs/JobsJobsJobs.Data/Data.fs b/src/JobsJobsJobs/JobsJobsJobs.Data/Data.fs index 69cb3c0..bcd8bba 100644 --- a/src/JobsJobsJobs/JobsJobsJobs.Data/Data.fs +++ b/src/JobsJobsJobs/JobsJobsJobs.Data/Data.fs @@ -1,13 +1,81 @@ namespace JobsJobsJobs.Data +open System open JobsJobsJobs.Domain + +/// Wrapper documents for our record types +module Documents = + + /// A generic type that keeps its ID in sync with the ID value for its content + [] + type Document<'T> (initialValue : 'T, toId : 'T -> Guid) = + + /// The current value for this document + let mutable value = initialValue + + /// The ID for this document + member val Id = toId initialValue with get, set + + /// The value for this document + member this.Value + with get () = value + and set (v : 'T) = + value <- v + this.Id <- toId v + + /// Convert a document to its value + static member ToValue (doc : Document<'T>) = + doc.Value + + /// Convert a document to its value, or None if the document is null + static member TryValue (doc : Document<'T>) = + if isNull doc then None else Some doc.Value + + /// A citizen document + [] + type CitizenDocument (citizen : Citizen) = + inherit Document (citizen, fun c -> CitizenId.value c.id) + new() = CitizenDocument Citizen.empty + + /// A continent document + [] + type ContinentDocument (continent : Continent) = + inherit Document (continent, fun c -> ContinentId.value c.id) + new () = ContinentDocument Continent.empty + + /// A job listing document + [] + type ListingDocument (listing : Listing) = + inherit Document (listing, fun l -> ListingId.value l.id) + new () = ListingDocument Listing.empty + + /// A profile document + [] + type ProfileDocument (profile : Profile) = + inherit Document (profile, fun p -> CitizenId.value p.id) + new () = ProfileDocument Profile.empty + + /// A security information document + [] + type SecurityInfoDocument (securityInfo : SecurityInfo) = + inherit Document (securityInfo, fun si -> CitizenId.value si.Id) + new () = SecurityInfoDocument SecurityInfo.empty + + /// A success story document + [] + type SuccessDocument (success : Success) = + inherit Document (success, fun s -> SuccessId.value s.id) + new () = SuccessDocument Success.empty + + +open Documents open Marten -open Marten.PLv8 -open Microsoft.Extensions.Configuration /// Connection management for the Marten document store module Connection = + open Marten.NodaTime + open Microsoft.Extensions.Configuration open Weasel.Core /// The configuration from which a document store will be created @@ -21,14 +89,19 @@ module Connection = DocumentStore.For(fun opts -> opts.Connection (cfg.GetConnectionString "PostgreSQL") opts.RegisterDocumentTypes [ - typeof; typeof; typeof; typeof; typeof - typeof + typeof; typeof; typeof + typeof; typeof; typeof ] + opts.DatabaseSchemaName <- "jjj" opts.AutoCreateSchemaObjects <- AutoCreate.CreateOrUpdate - opts.UseJavascriptTransformsAndPatching () + opts.UseNodaTime () - let _ = opts.Schema.For().Identity (fun c -> c.DbId) - let _ = opts.Schema.For().Identity (fun si -> si.DbId) + let _ = opts.Schema.For().DocumentAlias "citizen" + let _ = opts.Schema.For().DocumentAlias "continent" + let _ = opts.Schema.For().DocumentAlias "listing" + let _ = opts.Schema.For().DocumentAlias "profile" + let _ = opts.Schema.For().DocumentAlias "security_info" + let _ = opts.Schema.For().DocumentAlias "success" ()) do! store.Storage.ApplyAllConfiguredChangesToDatabaseAsync () return Ok store @@ -38,7 +111,7 @@ module Connection = /// Set up the data connection from the given configuration let setUp (cfg : IConfiguration) = config <- Some cfg - ignore (lazyStore.Force ()) + lazyStore.Force () /// A read-only document session let querySession () = @@ -53,22 +126,12 @@ module Connection = | Error msg -> raise (invalidOp msg) -/// Helper functions for data retrieval -[] -module private Helpers = - - open System.Threading - - /// Convert a possibly-null record type to an option - let optional<'T> (value : 'T) = if isNull (box value) then None else Some value - - /// Shorthand for no cancellation token - let noCnx = CancellationToken.None +/// Shorthand for the generic dictionary +type Dict<'TKey, 'TValue> = System.Collections.Generic.Dictionary<'TKey, 'TValue> open System.Linq open Connection -open Marten.PLv8.Patching /// Citizen data access functions [] @@ -77,16 +140,21 @@ module Citizens = /// Delete a citizen by their ID let deleteById citizenId = backgroundTask { use session = docSession () - session.Delete (CitizenId.value citizenId) + session.DeleteWhere(fun s -> s.Value.citizenId = citizenId) + session.DeleteWhere(fun l -> l.Value.citizenId = citizenId) + let docId = CitizenId.value citizenId + session.Delete docId + session.Delete docId + session.Delete docId do! session.SaveChangesAsync () } /// Find a citizen by their ID let findById citizenId = backgroundTask { use session = querySession () - let! citizen = session.LoadAsync (CitizenId.value citizenId) + let! citizen = session.LoadAsync (CitizenId.value citizenId) return - match optional citizen with + match Document.TryValue citizen with | Some c when not c.isLegacy -> Some c | Some _ | None -> None @@ -95,7 +163,7 @@ module Citizens = /// Save a citizen let save (citizen : Citizen) = backgroundTask { use session = docSession () - session.Store citizen + session.Store (CitizenDocument citizen) do! session.SaveChangesAsync () } @@ -103,29 +171,34 @@ module Citizens = let tryLogOn email (pwCheck : string -> bool) now = backgroundTask { use session = docSession () let! tryCitizen = - session.Query().Where(fun c -> c.email = email && not c.isLegacy).SingleOrDefaultAsync () - match optional tryCitizen with + session.Query() + .Where(fun c -> c.Value.email = email && not c.Value.isLegacy) + .SingleOrDefaultAsync () + match Document.TryValue tryCitizen with | Some citizen -> - let! tryInfo = session.LoadAsync citizen.DbId + let! tryInfo = session.LoadAsync (CitizenId.value citizen.id) let! info = backgroundTask { - match optional tryInfo with + match Document.TryValue tryInfo with | Some it -> return it | None -> let it = { SecurityInfo.empty with Id = citizen.id } - session.Store it + session.Store (SecurityInfoDocument it) do! session.SaveChangesAsync () return it } if info.AccountLocked then return Error "Log on unsuccessful (Account Locked)" elif pwCheck citizen.passwordHash then - session.Patch(citizen.DbId).Set((fun si -> si.FailedLogOnAttempts), 0) - session.Patch(citizen.DbId).Set((fun c -> c.lastSeenOn), now) + session.Store (SecurityInfoDocument { info with FailedLogOnAttempts = 0}) + session.Store (CitizenDocument { citizen with lastSeenOn = now}) do! session.SaveChangesAsync () return Ok { citizen with lastSeenOn = now } else let locked = info.FailedLogOnAttempts >= 4 - session.Patch(citizen.DbId).Increment(fun si -> si.FailedLogOnAttempts) - if locked then session.Patch(citizen.DbId).Set((fun si -> si.AccountLocked), true) + session.Store (SecurityInfoDocument { + info with + FailedLogOnAttempts = info.FailedLogOnAttempts + 1 + AccountLocked = locked + }) do! session.SaveChangesAsync () return Error $"""Log on unsuccessful{if locked then " - Account is now locked" else ""}""" | None -> return Error "Log on unsuccessful" @@ -139,47 +212,47 @@ module Continents = /// Retrieve all continents let all () = backgroundTask { use session = querySession () - let! it = session.Query().ToListAsync noCnx - return List.ofSeq it + let! it = session.Query().AsQueryable().ToListAsync () + return it |> Seq.map Document.ToValue |> List.ofSeq } /// Retrieve a continent by its ID let findById continentId = backgroundTask { use session = querySession () - let! tryContinent = session.LoadAsync (ContinentId.value continentId) - return optional tryContinent + let! tryContinent = session.LoadAsync (ContinentId.value continentId) + return Document.TryValue tryContinent } -open System open JobsJobsJobs.Domain.SharedTypes /// Job listing access functions [] module Listings = - open System.Collections.Generic - /// Find all job listings posted by the given citizen let findByCitizen citizenId = backgroundTask { use session = querySession () - let continents = Dictionary () + let continents = Dict () let! listings = - session.Query() - .Include((fun l -> l.continentId :> obj), continents) - .Where(fun l -> l.citizenId = citizenId && not l.isLegacy) + session.Query() + .Include((fun l -> l.Value.continentId :> obj), continents) + .Where(fun l -> l.Value.citizenId = citizenId && not l.Value.isLegacy) .ToListAsync () return listings - |> Seq.map (fun l -> { listing = l; continent = continents[l.continentId] }) + |> Seq.map (fun l -> { + listing = l.Value + continent = continents[ContinentId.value l.Value.continentId].Value + }) |> List.ofSeq } /// Find a listing by its ID let findById listingId = backgroundTask { use session = querySession () - let! tryListing = session.LoadAsync (ListingId.value listingId) - match optional tryListing with + let! tryListing = session.LoadAsync (ListingId.value listingId) + match Document.TryValue tryListing with | Some listing when not listing.isLegacy -> return Some listing | Some _ | None -> return None @@ -188,52 +261,194 @@ module Listings = /// Find a listing by its ID for viewing (includes continent information) let findByIdForView listingId = backgroundTask { use session = querySession () - let mutable continent = Continent.empty + let mutable continent : ContinentDocument = null let! tryListing = - session.Query() - .Include((fun l -> l.continentId :> obj), fun c -> continent <- c) - .Where(fun l -> l.id = listingId && not l.isLegacy) + session.Query() + .Include((fun l -> l.Value.continentId :> obj), fun c -> continent <- c) + .Where(fun l -> l.Id = ListingId.value listingId && not l.Value.isLegacy) .SingleOrDefaultAsync () - match optional tryListing with - | Some listing -> return Some { listing = listing; continent = continent } + match Document.TryValue tryListing with + | Some listing when not (isNull continent) -> return Some { listing = listing; continent = continent.Value } + | Some _ | None -> return None } /// Save a listing let save (listing : Listing) = backgroundTask { use session = docSession () - session.Store listing + session.Store (ListingDocument listing) do! session.SaveChangesAsync () } /// Search job listings let search (search : ListingSearch) = backgroundTask { use session = querySession () - let continents = Dictionary () + let continents = Dict () let searchQuery = - seq bool> { + seq bool> { match search.continentId with | Some contId -> - fun (l : Listing) -> l.continentId = (ContinentId.ofString contId) + fun (l : ListingDocument) -> l.Value.continentId = (ContinentId.ofString contId) | None -> () match search.region with - | Some region -> fun (l : Listing) -> l.region.Contains (region, StringComparison.OrdinalIgnoreCase) + | Some region -> + fun (l : ListingDocument) -> l.Value.region.Contains (region, StringComparison.OrdinalIgnoreCase) | None -> () if search.remoteWork <> "" then - fun (l : Listing) -> l.remoteWork = (search.remoteWork = "yes") + fun (l : ListingDocument) -> l.Value.remoteWork = (search.remoteWork = "yes") // match search.text with // | Some text -> fun (l : Listing) -> l.text.Contains (text, StringComparison.OrdinalIgnoreCase) // | None -> () } |> Seq.fold (fun q filter -> Queryable.Where(q, filter)) - (session.Query() - .Include((fun l -> l.continentId :> obj), continents) - .Where(fun l -> not l.isExpired && not l.isLegacy)) + (session.Query() + .Include((fun l -> l.Value.continentId :> obj), continents) + .Where(fun l -> not l.Value.isExpired && not l.Value.isLegacy)) let! results = searchQuery.ToListAsync () return results - |> Seq.map (fun l -> { listing = l; continent = continents[l.continentId] }) + |> Seq.map (fun l -> { + listing = l.Value + continent = continents[ContinentId.value l.Value.continentId].Value + }) + |> List.ofSeq + } + + +/// Profile data access functions +[] +module Profiles = + + /// Count the current profiles + let count () = + use session = querySession () + session.Query().Where(fun p -> not p.Value.isLegacy).LongCountAsync () + + /// Delete a profile by its ID + let deleteById citizenId = backgroundTask { + use session = docSession () + session.Delete (CitizenId.value citizenId) + do! session.SaveChangesAsync () + } + /// Find a profile by citizen ID + let findById citizenId = backgroundTask { + use session = querySession () + let! profile = session.LoadAsync (CitizenId.value citizenId) + return + match Document.TryValue profile with + | Some p when not p.isLegacy -> Some p + | Some _ + | None -> None + } + + /// Find a profile by citizen ID for viewing (includes citizen and continent information) + let findByIdForView citizenId = backgroundTask { + use session = querySession () + let mutable citizen : CitizenDocument = null + let mutable continent : ContinentDocument = null + let! tryProfile = + session.Query() + .Include((fun p -> p.Id :> obj), fun c -> citizen <- c) + .Include((fun p -> p.Value.continentId :> obj), fun c -> continent <- c) + .Where(fun p -> p.Id = CitizenId.value citizenId && not p.Value.isLegacy) + .SingleOrDefaultAsync () + match Document.TryValue tryProfile with + | Some profile when not (isNull citizen) && not (isNull continent) -> + return Some { profile = profile; citizen = citizen.Value; continent = continent.Value } + | Some _ + | None -> return None + } + + /// Save a profile + let save (profile : Profile) = backgroundTask { + use session = docSession () + session.Store (ProfileDocument profile) + do! session.SaveChangesAsync () + } + + /// Search profiles (logged-on users) + let search (search : ProfileSearch) = backgroundTask { + use session = querySession () + let citizens = Dict () + let searchQuery = + seq bool> { + match search.continentId with + | Some contId -> fun (p : ProfileDocument) -> p.Value.continentId = ContinentId.ofString contId + | None -> () + if search.remoteWork <> "" then + fun (p : ProfileDocument) -> p.Value.remoteWork = (search.remoteWork = "yes") + match search.skill with + | Some skl -> + fun (p : ProfileDocument) -> + p.Value.skills.Any(fun s -> s.description.Contains (skl, StringComparison.OrdinalIgnoreCase)) + | None -> () + // match search.bioExperience with + // | Some text -> + // let txt = regexContains text + // yield filterFunc (fun it -> it.G("biography").Match(txt).Or (it.G("experience").Match txt)) + // | None -> () + } + |> Seq.fold + (fun q filter -> Queryable.Where(q, filter)) + (session.Query() + .Include((fun p -> p.Id :> obj), citizens) + .Where(fun p -> not p.Value.isLegacy)) + let! results = searchQuery.ToListAsync () + return + results + |> Seq.map (fun profileDoc -> + let p = profileDoc.Value + { citizenId = p.id + displayName = Citizen.name citizens[CitizenId.value p.id].Value + seekingEmployment = p.seekingEmployment + remoteWork = p.remoteWork + fullTime = p.fullTime + lastUpdatedOn = p.lastUpdatedOn + }) + |> Seq.sortBy (fun psr -> psr.displayName.ToLowerInvariant ()) + |> List.ofSeq + } + + // Search profiles (public) + let publicSearch (search : PublicSearch) = backgroundTask { + use session = querySession () + let continents = Dict () + let searchQuery = + seq bool> { + match search.continentId with + | Some contId -> fun (p : ProfileDocument) -> p.Value.continentId = ContinentId.ofString contId + | None -> () + match search.region with + | Some region -> + fun (p : ProfileDocument) -> p.Value.region.Contains (region, StringComparison.OrdinalIgnoreCase) + | None -> () + if search.remoteWork <> "" then + fun (p : ProfileDocument) -> p.Value.remoteWork = (search.remoteWork = "yes") + match search.skill with + | Some skl -> + fun (p : ProfileDocument) -> + p.Value.skills.Any(fun s -> s.description.Contains (skl, StringComparison.OrdinalIgnoreCase)) + | None -> () + } + |> Seq.fold + (fun q filter -> Queryable.Where(q, filter)) + (session.Query() + .Include((fun p -> p.Value.continentId :> obj), continents) + .Where(fun p -> p.Value.isPublic && not p.Value.isLegacy)) + let! results = searchQuery.ToListAsync () + return + results + |> Seq.map (fun profileDoc -> + let p = profileDoc.Value + { continent = continents[ContinentId.value p.continentId].Value.name + region = p.region + remoteWork = p.remoteWork + skills = p.skills + |> List.map (fun s -> + let notes = match s.notes with Some n -> $" ({n})" | None -> "" + $"{s.description}{notes}") + }) |> List.ofSeq } @@ -241,10 +456,40 @@ module Listings = [] module Successes = + // Retrieve all success stories + let all () = backgroundTask { + use session = querySession () + let citizens = Dict () + let! stories = + session.Query() + .Include((fun s -> s.Value.citizenId :> obj), citizens) + .OrderByDescending(fun s -> s.Value.recordedOn) + .ToListAsync () + return + stories + |> Seq.map (fun storyDoc -> + let s = storyDoc.Value + { id = s.id + citizenId = s.citizenId + citizenName = Citizen.name citizens[CitizenId.value s.citizenId].Value + recordedOn = s.recordedOn + fromHere = s.fromHere + hasStory = Option.isSome s.story + }) + |> List.ofSeq + } + + /// Find a success story by its ID + let findById successId = backgroundTask { + use session = querySession () + let! success = session.LoadAsync (SuccessId.value successId) + return Document.TryValue success + } + /// Save a success story let save (success : Success) = backgroundTask { use session = docSession () - session.Store success + session.Store (SuccessDocument success) do! session.SaveChangesAsync () } \ No newline at end of file diff --git a/src/JobsJobsJobs/JobsJobsJobs.Data/JobsJobsJobs.Data.fsproj b/src/JobsJobsJobs/JobsJobsJobs.Data/JobsJobsJobs.Data.fsproj index c7191ec..b0f2602 100644 --- a/src/JobsJobsJobs/JobsJobsJobs.Data/JobsJobsJobs.Data.fsproj +++ b/src/JobsJobsJobs/JobsJobsJobs.Data/JobsJobsJobs.Data.fsproj @@ -18,7 +18,9 @@ - + + + diff --git a/src/JobsJobsJobs/JobsJobsJobs.Data/Json.fs b/src/JobsJobsJobs/JobsJobsJobs.Data/Json.fs index de761d0..4f83795 100644 --- a/src/JobsJobsJobs/JobsJobsJobs.Data/Json.fs +++ b/src/JobsJobsJobs/JobsJobsJobs.Data/Json.fs @@ -5,19 +5,32 @@ open System.Text.Json open System.Text.Json.Serialization open JobsJobsJobs.Domain -/// Convert citizen IDs to their string-GUID representation -type CitizenIdJsonConverter () = - inherit JsonConverter () - override this.Read(reader, _, _) = - CitizenId (Guid.Parse (reader.GetString ())) - override this.Write(writer, value, _) = - writer.WriteStringValue ((CitizenId.value value).ToString ()) +/// Convert a wrapped GUID to/from its string representation +type WrappedJsonConverter<'T> (wrap : string -> 'T, unwrap : 'T -> string) = + inherit JsonConverter<'T> () + override _.Read(reader, _, _) = + wrap (reader.GetString ()) + override _.Write(writer, value, _) = + writer.WriteStringValue (unwrap value) + +/// Convert a wrapped GUID to/from its string representation +type WrappedIdJsonConverter<'T> (wrap : Guid -> 'T, unwrap : 'T -> Guid) = + inherit JsonConverter<'T> () + override _.Read(reader, _, _) = + wrap (Guid.Parse (reader.GetString ())) + override _.Write(writer, value, _) = + writer.WriteStringValue ((unwrap value).ToString ()) /// JsonSerializer options that use the custom converters let options = let opts = JsonSerializerOptions () - [ CitizenIdJsonConverter () :> JsonConverter + [ WrappedIdJsonConverter (CitizenId, CitizenId.value) :> JsonConverter + WrappedIdJsonConverter (ContinentId, ContinentId.value) + WrappedIdJsonConverter (ListingId, ListingId.value) + WrappedJsonConverter (Text, MarkdownString.toString) + WrappedIdJsonConverter (SkillId, SkillId.value) + WrappedIdJsonConverter (SuccessId, SuccessId.value) JsonFSharpConverter () ] |> List.iter opts.Converters.Add diff --git a/src/JobsJobsJobs/Server/App.fs b/src/JobsJobsJobs/Server/App.fs index fc88566..e4d213e 100644 --- a/src/JobsJobsJobs/Server/App.fs +++ b/src/JobsJobsJobs/Server/App.fs @@ -8,7 +8,6 @@ open Microsoft.Extensions.Hosting open Giraffe open Giraffe.EndpointRouting - /// Configure the ASP.NET Core pipeline to use Giraffe let configureApp (app : IApplicationBuilder) = app.UseCors(fun p -> p.AllowAnyOrigin().AllowAnyHeader() |> ignore) @@ -22,13 +21,11 @@ let configureApp (app : IApplicationBuilder) = e.MapFallbackToFile "index.html" |> ignore) |> ignore -open Newtonsoft.Json -open NodaTime +open System.Text open Microsoft.AspNetCore.Authentication.JwtBearer open Microsoft.Extensions.Configuration -open Microsoft.Extensions.Logging open Microsoft.IdentityModel.Tokens -open System.Text +open NodaTime open JobsJobsJobs.Data open JobsJobsJobs.Domain.SharedTypes @@ -39,9 +36,7 @@ let configureServices (svc : IServiceCollection) = let _ = svc.AddLogging () let _ = svc.AddCors () - let jsonCfg = JsonSerializerSettings () - Data.Converters.all () |> List.iter jsonCfg.Converters.Add - let _ = svc.AddSingleton (NewtonsoftJson.Serializer jsonCfg) + let _ = svc.AddSingleton (SystemTextJson.Serializer Json.options) let svcs = svc.BuildServiceProvider () let cfg = svcs.GetRequiredService () @@ -64,13 +59,11 @@ let configureServices (svc : IServiceCollection) = let _ = svc.AddAuthorization () let _ = svc.Configure (cfg.GetSection "Auth") - let dbCfg = cfg.GetSection "Rethink" - let log = svcs.GetRequiredService().CreateLogger "JobsJobsJobs.Api.Data.Startup" - let conn = Data.Startup.createConnection dbCfg log - let _ = svc.AddSingleton conn |> ignore // Set up the Marten data store - let _ = Connection.setUp cfg - () + match Connection.setUp cfg |> Async.AwaitTask |> Async.RunSynchronously with + | Ok _ -> () + | Error msg -> failwith $"Error initializing data store: {msg}" + [] let main _ = diff --git a/src/JobsJobsJobs/Server/Auth.fs b/src/JobsJobsJobs/Server/Auth.fs index e2b8b2a..8ea26e3 100644 --- a/src/JobsJobsJobs/Server/Auth.fs +++ b/src/JobsJobsJobs/Server/Auth.fs @@ -78,7 +78,6 @@ let verifyWithMastodon (authCode : string) (inst : MastodonInstance) rtnHost (lo open JobsJobsJobs.Domain -open JobsJobsJobs.Domain.Types open Microsoft.IdentityModel.Tokens open System.IdentityModel.Tokens.Jwt open System.Security.Claims diff --git a/src/JobsJobsJobs/Server/Data.fs b/src/JobsJobsJobs/Server/Data.fs deleted file mode 100644 index 094335b..0000000 --- a/src/JobsJobsJobs/Server/Data.fs +++ /dev/null @@ -1,745 +0,0 @@ -/// Data access functions for Jobs, Jobs, Jobs -module JobsJobsJobs.Api.Data - -open JobsJobsJobs.Domain - -/// JSON converters used with RethinkDB persistence -module Converters = - - open Microsoft.FSharpLu.Json - open Newtonsoft.Json - open System - - /// JSON converter for citizen IDs - type CitizenIdJsonConverter() = - inherit JsonConverter() - override _.WriteJson(writer : JsonWriter, value : CitizenId, _ : JsonSerializer) = - writer.WriteValue (CitizenId.toString value) - override _.ReadJson(reader: JsonReader, _ : Type, _ : CitizenId, _ : bool, _ : JsonSerializer) = - (string >> CitizenId.ofString) reader.Value - - /// JSON converter for continent IDs - type ContinentIdJsonConverter() = - inherit JsonConverter() - override _.WriteJson(writer : JsonWriter, value : ContinentId, _ : JsonSerializer) = - writer.WriteValue (ContinentId.toString value) - override _.ReadJson(reader: JsonReader, _ : Type, _ : ContinentId, _ : bool, _ : JsonSerializer) = - (string >> ContinentId.ofString) reader.Value - - /// JSON converter for Markdown strings - type MarkdownStringJsonConverter() = - inherit JsonConverter() - override _.WriteJson(writer : JsonWriter, value : MarkdownString, _ : JsonSerializer) = - writer.WriteValue (MarkdownString.toString value) - override _.ReadJson(reader: JsonReader, _ : Type, _ : MarkdownString, _ : bool, _ : JsonSerializer) = - (string >> Text) reader.Value - - /// JSON converter for listing IDs - type ListingIdJsonConverter() = - inherit JsonConverter() - override _.WriteJson(writer : JsonWriter, value : ListingId, _ : JsonSerializer) = - writer.WriteValue (ListingId.toString value) - override _.ReadJson(reader: JsonReader, _ : Type, _ : ListingId, _ : bool, _ : JsonSerializer) = - (string >> ListingId.ofString) reader.Value - - /// JSON converter for skill IDs - type SkillIdJsonConverter() = - inherit JsonConverter() - override _.WriteJson(writer : JsonWriter, value : SkillId, _ : JsonSerializer) = - writer.WriteValue (SkillId.toString value) - override _.ReadJson(reader: JsonReader, _ : Type, _ : SkillId, _ : bool, _ : JsonSerializer) = - (string >> SkillId.ofString) reader.Value - - /// JSON converter for success report IDs - type SuccessIdJsonConverter() = - inherit JsonConverter() - override _.WriteJson(writer : JsonWriter, value : SuccessId, _ : JsonSerializer) = - writer.WriteValue (SuccessId.toString value) - override _.ReadJson(reader: JsonReader, _ : Type, _ : SuccessId, _ : bool, _ : JsonSerializer) = - (string >> SuccessId.ofString) reader.Value - - /// All JSON converters needed for the application - let all () : JsonConverter list = - [ CitizenIdJsonConverter () - ContinentIdJsonConverter () - MarkdownStringJsonConverter () - ListingIdJsonConverter () - SkillIdJsonConverter () - SuccessIdJsonConverter () - CompactUnionJsonConverter () - ] - - -/// Table names -[] -module Table = - - /// The user (citizen of Gitmo Nation) table - let Citizen = "citizen" - - /// The continent table - let Continent = "continent" - - /// The citizen employment profile table - let Profile = "profile" - - /// The success story table - let Success = "success" - - /// All tables - let all () = [ Citizen; Continent; Profile; Success ] - -open NodaTime -open Npgsql -open Npgsql.FSharp - - - -open RethinkDb.Driver.FSharp.Functions -open RethinkDb.Driver.Net - -/// Reconnection functions (if the RethinkDB driver has a network error, it will not reconnect on its own) -[] -module private Reconnect = - - /// Retrieve a result using the F# driver's default retry policy - let result<'T> conn expr = runResult<'T> expr |> withRetryDefault |> withConn conn - - /// Retrieve an optional result using the F# driver's default retry policy - let resultOption<'T> conn expr = runResult<'T> expr |> withRetryDefault |> asOption |> withConn conn - - /// Write a query using the F# driver's default retry policy, ignoring the result - let write conn expr = runWrite expr |> withRetryDefault |> ignoreResult |> withConn conn - - -open RethinkDb.Driver.Ast -open Marten - -/// Shorthand for the RethinkDB R variable (how every command starts) -let private r = RethinkDb.Driver.RethinkDB.R - -/// Functions run at startup -[] -module Startup = - - open Microsoft.Extensions.Configuration - open Microsoft.Extensions.Logging - open NodaTime.Serialization.JsonNet - open RethinkDb.Driver.FSharp - - /// Create a RethinkDB connection - let createConnection (cfg : IConfigurationSection) (log : ILogger) = - // Add all required JSON converters - Converter.Serializer.ConfigureForNodaTime DateTimeZoneProviders.Tzdb |> ignore - Converters.all () - |> List.iter Converter.Serializer.Converters.Add - // Connect to the database - let config = DataConfig.FromConfiguration cfg - log.LogInformation $"Connecting to rethinkdb://{config.Hostname}:{config.Port}/{config.Database}" - config.CreateConnection () - - /// Ensure the tables and indexes that are required exist - let establishEnvironment (log : ILogger) conn = task { - - let! tables = - Sql.existingConnection conn - |> Sql.query "SELECT tablename FROM pg_tables WHERE schemaname = 'jjj'" - |> Sql.executeAsync (fun row -> row.string "tablename") - let needsTable table = not (List.contains table tables) - - let sql = seq { - if needsTable "continent" then - "CREATE TABLE jjj.continent ( - id UUID NOT NULL PRIMARY KEY, - name TEXT NOT NULL)" - if needsTable "citizen" then - "CREATE TABLE jjj.citizen ( - id UUID NOT NULL PRIMARY KEY, - joined_on TIMESTAMPTZ NOT NULL, - last_seen_on TIMESTAMPTZ NOT NULL, - email TEXT NOT NULL UNIQUE, - first_name TEXT NOT NULL, - last_name TEXT NOT NULL, - password_hash TEXT NOT NULL, - is_legacy BOOLEAN NOT NULL, - display_name TEXT, - other_contacts TEXT)" - if needsTable "listing" then - "CREATE TABLE jjj.listing ( - id UUID NOT NULL PRIMARY KEY, - citizen_id UUID NOT NULL, - created_on TIMESTAMPTZ NOT NULL, - title TEXT NOT NULL, - continent_id UUID NOT NULL, - region TEXT NOT NULL, - is_remote BOOLEAN NOT NULL, - is_expired BOOLEAN NOT NULL, - updated_on TIMESTAMPTZ NOT NULL, - listing_text TEXT NOT NULL, - needed_by DATE, - was_filled_here BOOLEAN, - FOREIGN KEY fk_listing_citizen (citizen_id) REFERENCES jjj.citizen (id) ON DELETE CASCADE, - FOREIGN KEY fk_listing_continent (continent_id) REFERENCES jjj.continent (id))" - "CREATE INDEX idx_listing_citizen ON jjj.listing (citizen_id)" - "CREATE INDEX idx_listing_continent ON jjj.listing (continent_id)" - if needsTable "profile" then - "CREATE TABLE jjj.profile ( - citizen_id UUID NOT NULL PRIMARY KEY, - is_seeking BOOLEAN NOT NULL, - is_public_searchable BOOLEAN NOT NULL, - is_public_linkable BOOLEAN NOT NULL, - continent_id UUID NOT NULL, - region TEXT NOT NULL, - is_available_remotely BOOLEAN NOT NULL, - is_available_full_time BOOLEAN NOT NULL, - biography TEXT NOT NULL, - last_updated_on TIMESTAMPTZ NOT NULL, - experience TEXT, - FOREIGN KEY fk_profile_citizen (citizen_id) REFERENCES jjj.citizen (id) ON DELETE CASCADE, - FOREIGN KEY fk_profile_continent (continent_id) REFERENCES jjj.continent (id))" - "CREATE INDEX idx_profile_citizen ON jjj.profile (citizen_id)" - "CREATE INDEX idx_profile_continent ON jjj.profile (continent_id)" - "CREATE TABLE jjj.profile_skill ( - id UUID NOT NULL PRIMARY KEY, - citizen_id UUID NOT NULL, - description TEXT NOT NULL, - notes TEXT, - FOREIGN KEY fk_profile_skill_profile (citizen_id) REFERENCES jjj.profile (citizen_id) - ON DELETE CASCADE)" - "CREATE INDEX idx_profile_skill_profile ON jjj.profile_skill (citizen_id)" - if needsTable "security_info" then - "CREATE TABLE jjj.security_info ( - id UUID NOT NULL PRIMARY KEY, - failed_attempts SMALLINT NOT NULL, - is_locked BOOLEAN NOT NULL, - token TEXT, - token_usage TEXT, - token_expires TIMESTAMPTZ, - FOREIGN KEY fk_security_info_citizen (id) REFERENCES jjj.citizen (id) ON DELETE CASCADE)" - "CREATE INDEX idx_security_info_expires ON jjj.security_info (token_expires)" - if needsTable "success" then - "CREATE TABLE jjj.success ( - id UUID NOT NULL PRIMARY KEY, - citizen_id UUID NOT NULL, - recorded_on TIMESTAMPTZ NOT NULL, - was_from_here BOOLEAN NOT NULL, - source TEXT NOT NULL, - story TEXT, - FOREIGN KEY fk_success_citizen (citizen_id) REFERENCES jjj.citizen (id) ON DELETE CASCADE)" - "CREATE INDEX idx_success_citizen ON jjj.success (citizen_id)" - } - if not (Seq.isEmpty sql) then - let! _ = - Sql.existingConnection conn - |> Sql.executeTransactionAsync - (sql - |> Seq.map (fun it -> - let parts = it.Split ' ' - log.LogInformation $"Creating {parts[2]} {parts[1].ToLowerInvariant ()}..." - it, [ [] ]) - |> List.ofSeq) - () - } - - -open JobsJobsJobs.Domain.SharedTypes - -/// Sanitize user input, and create a "contains" pattern for use with RethinkDB queries -let private regexContains = System.Text.RegularExpressions.Regex.Escape >> sprintf "(?i)%s" - -/// Apply filters to a query, ensuring that types all match up -let private applyFilters (filters : (ReqlExpr -> Filter) list) query : ReqlExpr = - if List.isEmpty filters then - query - else - let first = List.head filters query - List.fold (fun q (f : ReqlExpr -> Filter) -> f q) first (List.tail filters) - -/// Derive a user's display name from real name, display name, or handle (in that order) -let private deriveDisplayName (it : ReqlExpr) = - r.Branch (it.G("realName" ).Default_("").Ne "", it.G "realName", - it.G("displayName").Default_("").Ne "", it.G "displayName", - it.G "mastodonUser") - -/// Custom SQL parameter functions -module Sql = - - /// Create a citizen ID parameter - let citizenId = CitizenId.value >> Sql.uuid - - /// Create a continent ID parameter - let continentId = ContinentId.value >> Sql.uuid - - /// Create a listing ID parameter - let listingId = ListingId.value >> Sql.uuid - - /// Create a Markdown string parameter - let markdown = MarkdownString.toString >> Sql.string - - /// Create a parameter for the given value - let param<'T> name (value : 'T) = - name, Sql.parameter (NpgsqlParameter (name, value)) - - /// Create a parameter for a possibly-missing value - let paramOrNone<'T> name (value : 'T option) = - name, Sql.parameter (NpgsqlParameter (name, if Option.isSome value then box value else System.DBNull.Value)) - - /// Create a skill ID parameter - let skillId = SkillId.value >> Sql.uuid - - /// Create a success ID parameter - let successId = SuccessId.value >> Sql.uuid - - -/// Map data results to domain types -module Map = - - /// Create a citizen from a data row - let toCitizen (row : RowReader) : Citizen = - { id = (row.uuid >> CitizenId) "id" - joinedOn = row.fieldValue "joined_on" - lastSeenOn = row.fieldValue "last_seen_on" - email = row.string "email" - firstName = row.string "first_name" - lastName = row.string "last_name" - passwordHash = row.string "password_hash" - displayName = row.stringOrNone "display_name" - // TODO: deserialize from JSON - otherContacts = [] // row.stringOrNone "other_contacts" - isLegacy = false - } - - /// Create a continent from a data row - let toContinent (row : RowReader) : Continent = - { id = (row.uuid >> ContinentId) "continent_id" - name = row.string "continent_name" - } - - /// Extract a count from a row - let toCount (row : RowReader) = - row.int64 "the_count" - - /// Create a job listing from a data row - let toListing (row : RowReader) : Listing = - { id = (row.uuid >> ListingId) "id" - citizenId = (row.uuid >> CitizenId) "citizen_id" - createdOn = row.fieldValue "created_on" - title = row.string "title" - continentId = (row.uuid >> ContinentId) "continent_id" - region = row.string "region" - remoteWork = row.bool "is_remote" - isExpired = row.bool "is_expired" - updatedOn = row.fieldValue "updated_on" - text = (row.string >> Text) "listing_text" - neededBy = row.fieldValueOrNone "needed_by" - wasFilledHere = row.boolOrNone "was_filled_here" - isLegacy = false - } - - /// Create a job listing for viewing from a data row - let toListingForView (row : RowReader) : ListingForView = - { listing = toListing row - continent = toContinent row - } - - /// Create a profile from a data row - let toProfile (row : RowReader) : Profile = - { id = (row.uuid >> CitizenId) "citizen_id" - seekingEmployment = row.bool "is_seeking" - isPublic = row.bool "is_public_searchable" - isPublicLinkable = row.bool "is_public_linkable" - continentId = (row.uuid >> ContinentId) "continent_id" - region = row.string "region" - remoteWork = row.bool "is_available_remotely" - fullTime = row.bool "is_available_full_time" - biography = (row.string >> Text) "biography" - lastUpdatedOn = row.fieldValue "last_updated_on" - experience = row.stringOrNone "experience" |> Option.map Text - skills = [] - isLegacy = false - } - - /// Create a skill from a data row - let toSkill (row : RowReader) : Skill = - { id = (row.uuid >> SkillId) "id" - description = row.string "description" - notes = row.stringOrNone "notes" - } - - /// Create a success story from a data row - let toSuccess (row : RowReader) : Success = - { id = (row.uuid >> SuccessId) "id" - citizenId = (row.uuid >> CitizenId) "citizen_id" - recordedOn = row.fieldValue "recorded_on" - fromHere = row.bool "was_from_here" - source = row.string "source" - story = row.stringOrNone "story" |> Option.map Text - } - - -/// Convert a possibly-null record type to an option -let optional<'T> (value : 'T) = if isNull (box value) then None else Some value - -open System -open System.Linq - -/// Profile data access functions -[] -module Profile = - - /// Count the current profiles - let count (session : IQuerySession) = - session.Query().Where(fun p -> not p.isLegacy).LongCountAsync () - - /// Find a profile by citizen ID - let findById citizenId (session : IQuerySession) = backgroundTask { - let! profile = session.LoadAsync (CitizenId.value citizenId) - return - match optional profile with - | Some p when not p.isLegacy -> Some p - | Some _ - | None -> None - } - - /// Insert or update a profile - [] - let save (profile : Profile) (session : IDocumentSession) = - session.Store profile - - /// Delete a citizen's profile - let delete citizenId conn = backgroundTask { - let! _ = - Sql.existingConnection conn - |> Sql.query "DELETE FROM jjj.profile WHERE citizen_id = @id" - |> Sql.parameters [ "@id", Sql.citizenId citizenId ] - |> Sql.executeNonQueryAsync - () - } - - /// Search profiles (logged-on users) - let search (search : ProfileSearch) conn = - fromTable Table.Profile - |> eqJoin "id" (fromTable Table.Citizen) - |> without [ "right.id" ] - |> zip - |> applyFilters - [ match search.continentId with - | Some contId -> yield filter {| continentId = ContinentId.ofString contId |} - | None -> () - match search.remoteWork with - | "" -> () - | _ -> yield filter {| remoteWork = search.remoteWork = "yes" |} - match search.skill with - | Some skl -> - yield filterFunc (fun it -> - it.G("skills").Contains (ReqlFunction1 (fun s -> s.G("description").Match (regexContains skl)))) - | None -> () - match search.bioExperience with - | Some text -> - let txt = regexContains text - yield filterFunc (fun it -> it.G("biography").Match(txt).Or (it.G("experience").Match txt)) - | None -> () - ] - |> mergeFunc (fun it -> {| displayName = deriveDisplayName it; citizenId = it.G "id" |}) - |> pluck [ "citizenId"; "displayName"; "seekingEmployment"; "remoteWork"; "fullTime"; "lastUpdatedOn" ] - |> orderByFunc (fun it -> it.G("displayName").Downcase ()) - |> result conn - - // Search profiles (public) - let publicSearch (search : PublicSearch) conn = - fromTable Table.Profile - |> eqJoin "continentId" (fromTable Table.Continent) - |> without [ "right.id" ] - |> zip - |> applyFilters - [ yield filter {| isPublic = true |} - match search.continentId with - | Some contId -> yield filter {| continentId = ContinentId.ofString contId |} - | None -> () - match search.region with - | Some reg -> yield filterFunc (fun it -> it.G("region").Match (regexContains reg)) - | None -> () - match search.remoteWork with - | "" -> () - | _ -> yield filter {| remoteWork = search.remoteWork = "yes" |} - match search.skill with - | Some skl -> - yield filterFunc (fun it -> - it.G("skills").Contains (ReqlFunction1 (fun s -> s.G("description").Match (regexContains skl)))) - | None -> () - ] - |> mergeFunc (fun it -> - {| skills = it.G("skills").Map (ReqlFunction1 (fun skill -> - r.Branch(skill.G("notes").Default_("").Eq "", skill.G "description", - skill.G("description").Add(" (").Add(skill.G("notes")).Add ")"))) - continent = it.G "name" - |}) - |> pluck [ "continent"; "region"; "skills"; "remoteWork" ] - |> result conn - -/// Citizen data access functions -[] -module Citizen = - - /// Find a citizen by their ID - let findById citizenId (session : IQuerySession) = backgroundTask { - let! citizen = session.LoadAsync (CitizenId.value citizenId) - return - match optional citizen with - | Some c when not c.isLegacy -> Some c - | Some _ - | None -> None - } - - /// Find a citizen by their e-mail address - let findByEmail email conn = backgroundTask { - let! citizen = - Sql.existingConnection conn - |> Sql.query "SELECT * FROM jjj.citizen WHERE email = @email AND is_legacy = FALSE" - |> Sql.parameters [ "@email", Sql.string email ] - |> Sql.executeAsync Map.toCitizen - return List.tryHead citizen - } - - /// Add or update a citizen - let save (citizen : Citizen) conn = backgroundTask { - let! _ = - Sql.existingConnection conn - |> Sql.query - "INSERT INTO jjj.citizen ( - id, joined_on, last_seen_on, email, first_name, last_name, password_hash, display_name, - other_contacts, is_legacy - ) VALUES ( - @id, @joinedOn, @lastSeenOn, @email, @firstName, @lastName, @passwordHash, @displayName, - @otherContacts, FALSE - ) ON CONFLICT (id) DO UPDATE - SET email = EXCLUDED.email, - first_name = EXCLUDED.first_name, - last_name = EXCLUDED.last_name, - password_hash = EXCLUDED.password_hash, - display_name = EXCLUDED.display_name, - other_contacts = EXCLUDED.other_contacts" - |> Sql.parameters - [ "@id", Sql.citizenId citizen.id - "@joinedOn" |>Sql.param<| citizen.joinedOn - "@lastSeenOn" |>Sql.param<| citizen.lastSeenOn - "@email", Sql.string citizen.email - "@firstName", Sql.string citizen.firstName - "@lastName", Sql.string citizen.lastName - "@passwordHash", Sql.string citizen.passwordHash - "@displayName", Sql.stringOrNone citizen.displayName - "@otherContacts", Sql.stringOrNone (if List.isEmpty citizen.otherContacts then None else Some "") - ] - |> Sql.executeNonQueryAsync - () - } - - /// Update the last seen on date for a citizen - let logOnUpdate (citizen : Citizen) conn = backgroundTask { - let! _ = - Sql.existingConnection conn - |> Sql.query "UPDATE jjj.citizen SET last_seen_on = @lastSeenOn WHERE id = @id" - |> Sql.parameters [ "@id", Sql.citizenId citizen.id; "@lastSeenOn" |>Sql.param<| citizen.lastSeenOn ] - |> Sql.executeNonQueryAsync - () - } - - /// Delete a citizen - let delete citizenId conn = backgroundTask { - let! _ = - Sql.existingConnection conn - |> Sql.query "DELETE FROM citizen WHERE id = @id" - |> Sql.parameters [ "@id", Sql.citizenId citizenId ] - |> Sql.executeNonQueryAsync - () - } - - -/// Continent data access functions -[] -module Continent = - - /// Get all continents - let all conn = - Sql.existingConnection conn - |> Sql.query "SELECT id AS continent_id, name AS continent_name FROM jjj.continent" - |> Sql.executeAsync Map.toContinent - - /// Get a continent by its ID - let findById contId conn = backgroundTask { - let! continent = - Sql.existingConnection conn - |> Sql.query "SELECT id AS continent_id, name AS continent_name FROM jjj.continent WHERE id = @id" - |> Sql.parameters [ "@id", Sql.continentId contId ] - |> Sql.executeAsync Map.toContinent - return List.tryHead continent - } - - -/// Job listing data access functions -[] -module Listing = - - /// The SQL to select the listing and continent fields - let private forViewSql = - "SELECT l.*, c.name AS continent_name - FROM jjj.listing l - INNER JOIN jjj.continent c ON c.id = l.continent_id" - - /// Find all job listings posted by the given citizen - let findByCitizen citizenId conn = - Sql.existingConnection conn - |> Sql.query $"{forViewSql} WHERE l.citizen_id = @citizenId" - |> Sql.parameters [ "@citizenId", Sql.citizenId citizenId ] - |> Sql.executeAsync Map.toListingForView - - /// Find a listing by its ID - let findById listingId conn = backgroundTask { - let! listing = - Sql.existingConnection conn - |> Sql.query "SELECT * FROM jjj.listing WHERE id = @id" - |> Sql.parameters [ "@id", Sql.listingId listingId ] - |> Sql.executeAsync Map.toListing - return List.tryHead listing - } - - /// Find a listing by its ID for viewing (includes continent information) - let findByIdForView (listingId : ListingId) conn = backgroundTask { - let! listing = - Sql.existingConnection conn - |> Sql.query $"{forViewSql} WHERE l.id = @id" - |> Sql.parameters [ "@id", Sql.listingId listingId ] - |> Sql.executeAsync Map.toListingForView - return List.tryHead listing - } - - /// Add or update a listing - let save (listing : Listing) conn = backgroundTask { - let! _ = - Sql.existingConnection conn - |> Sql.query - "INSERT INTO jjj.listing ( - id, citizen_id, created_on, title, continent_id, region, is_remote, is_expired, updated_on, - listing_text, needed_by, was_filled_here - ) VALUES ( - @id, @citizenId, @createdOn, @title, @continentId, @region, @isRemote, @isExpired, @updatedOn, - @text, @neededBy, @wasFilledHere - ) ON CONFLICT (id) DO UPDATE - SET title = EXCLUDED.title, - continent_id = EXCLUDED.continent_id, - region = EXCLUDED.region, - is_remote = EXCLUDED.is_remote, - is_expired = EXCLUDED.is_expired, - updated_on = EXCLUDED.updated_on, - listing_text = EXCLUDED.listing_text, - needed_by = EXCLUDED.needed_by, - was_filled_here = EXCLUDED.was_filled_here" - |> Sql.parameters - [ "@id", Sql.listingId listing.id - "@citizenId", Sql.citizenId listing.citizenId - "@createdOn" |>Sql.param<| listing.createdOn - "@title", Sql.string listing.title - "@continentId", Sql.continentId listing.continentId - "@region", Sql.string listing.region - "@isRemote", Sql.bool listing.remoteWork - "@isExpired", Sql.bool listing.isExpired - "@updatedOn" |>Sql.param<| listing.updatedOn - "@text", Sql.markdown listing.text - "@neededBy" |>Sql.paramOrNone<| listing.neededBy - "@wasFilledHere", Sql.boolOrNone listing.wasFilledHere - - ] - |> Sql.executeNonQueryAsync - () - } - - /// Expire a listing - let expire listingId fromHere (now : Instant) conn = backgroundTask { - let! _ = - Sql.existingConnection conn - |> Sql.query - "UPDATE jjj.listing - SET is_expired = TRUE, - was_filled_here = @wasFilledHere, - updated_on = @updatedOn - WHERE id = @id" - |> Sql.parameters - [ "@wasFilledHere", Sql.bool fromHere - "@updatedOn" |>Sql.param<| now - "@id", Sql.listingId listingId - ] - |> Sql.executeNonQueryAsync - () - } - - /// Search job listings - let search (search : ListingSearch) conn = - let filters = seq { - match search.continentId with - | Some contId -> - "l.continent = @continentId", [ "@continentId", Sql.continentId (ContinentId.ofString contId) ] - | None -> () - match search.region with - | Some region -> "l.region ILIKE '%@region%'", [ "@region", Sql.string region ] - | None -> () - if search.remoteWork <> "" then - "l.is_remote = @isRemote", ["@isRemote", Sql.bool (search.remoteWork = "yes") ] - match search.text with - | Some text -> "l.listing_text ILIKE '%@text%'", [ "@text", Sql.string text ] - | None -> () - } - let filterSql = filters |> Seq.map fst |> String.concat " AND " - Sql.existingConnection conn - |> Sql.query $"{forViewSql} WHERE l.is_expired = FALSE{filterSql}" - |> Sql.parameters (filters |> Seq.collect snd |> List.ofSeq) - |> Sql.executeAsync Map.toListingForView - - -/// Success story data access functions -[] -module Success = - - /// Find a success report by its ID - let findById successId conn = backgroundTask { - let! success = - Sql.existingConnection conn - |> Sql.query "SELECT * FROM jjj.success WHERE id = @id" - |> Sql.parameters [ "@id", Sql.successId successId ] - |> Sql.executeAsync Map.toSuccess - return List.tryHead success - } - - /// Insert or update a success story - let save (success : Success) conn = backgroundTask { - let! _ = - Sql.existingConnection conn - |> Sql.query - "INSERT INTO jjj.success ( - id, citizen_id, recorded_on, was_from_here, source, story - ) VALUES ( - @id, @citizenId, @recordedOn, @wasFromHere, @source, @story - ) ON CONFLICT (id) DO UPDATE - SET was_from_here = EXCLUDED.was_from_here, - story = EXCLUDED.story" - |> Sql.parameters - [ "@id", Sql.successId success.id - "@citizenId", Sql.citizenId success.citizenId - "@recordedOn" |>Sql.param<| success.recordedOn - "@wasFromHere", Sql.bool success.fromHere - "@source", Sql.string success.source - "@story", Sql.stringOrNone (Option.map MarkdownString.toString success.story) - ] - |> Sql.executeNonQueryAsync - () - } - - // Retrieve all success stories - let all conn = - fromTable Table.Success - |> eqJoin "citizenId" (fromTable Table.Citizen) - |> without [ "right.id" ] - |> zip - |> mergeFunc (fun it -> {| citizenName = deriveDisplayName it; hasStory = it.G("story").Default_("").Gt "" |}) - |> pluck [ "id"; "citizenId"; "citizenName"; "recordedOn"; "fromHere"; "hasStory" ] - |> orderByDescending "recordedOn" - |> result conn diff --git a/src/JobsJobsJobs/Server/Handlers.fs b/src/JobsJobsJobs/Server/Handlers.fs index 2f910ee..ecd51ab 100644 --- a/src/JobsJobsJobs/Server/Handlers.fs +++ b/src/JobsJobsJobs/Server/Handlers.fs @@ -1,7 +1,6 @@ /// Route handlers for Giraffe endpoints module JobsJobsJobs.Api.Handlers -open System.Threading open Giraffe open JobsJobsJobs.Domain open JobsJobsJobs.Domain.SharedTypes @@ -55,15 +54,12 @@ module Error = module Helpers = open System.Security.Claims - open System.Threading.Tasks open NodaTime - open Marten open Microsoft.Extensions.Configuration open Microsoft.Extensions.Options - open RethinkDb.Driver.Net /// Get the NodaTime clock from the request context - let clock (ctx : HttpContext) = ctx.GetService () + let now (ctx : HttpContext) = ctx.GetService().GetCurrentInstant () /// Get the application configuration from the request context let config (ctx : HttpContext) = ctx.GetService () @@ -74,15 +70,6 @@ module Helpers = /// Get the logger factory from the request context let logger (ctx : HttpContext) = ctx.GetService () - /// Get the RethinkDB connection from the request context - let conn (ctx : HttpContext) = ctx.GetService () - - /// Get a query session - let querySession (ctx : HttpContext) = ctx.GetService () - - /// Get a full document session - let docSession (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 @@ -106,16 +93,6 @@ module Helpers = /// Return an empty OK response let ok : HttpHandler = Successful.OK "" - - /// Convert a potentially-null record type to an option - let opt<'T> (it : Task<'T>) = task { - match! it with - | x when isNull (box x) -> return None - | x -> return Some x - } - - /// Shorthand for no cancellation token - let noCnx = CancellationToken.None open System @@ -127,48 +104,59 @@ module Citizen = // GET: /api/citizen/log-on/[code] let logOn (abbr, authCode) : HttpHandler = fun next ctx -> task { + match! Citizens.tryLogOn "to@do.com" (fun _ -> false) (now ctx) with + | Ok citizen -> + return! + json + { jwt = Auth.createJwt citizen (authConfig ctx) + citizenId = CitizenId.toString citizen.id + name = Citizen.name citizen + } next ctx + | Error msg -> + // TODO: return error message + return! RequestErrors.BAD_REQUEST msg next ctx // Step 1 - Verify with Mastodon - let cfg = authConfig ctx - - match cfg.Instances |> Array.tryFind (fun it -> it.Abbr = abbr) with - | Some instance -> - let log = (logger ctx).CreateLogger (nameof JobsJobsJobs.Api.Auth) - - match! Auth.verifyWithMastodon authCode instance cfg.ReturnHost log with - | Ok account -> - // Step 2 - Find / establish Jobs, Jobs, Jobs account - let now = (clock ctx).GetCurrentInstant () - let dbConn = conn ctx - let! citizen = task { - match! Data.Citizen.findByMastodonUser instance.Abbr account.Username dbConn with - | None -> - let it : Citizen = - { id = CitizenId.create () - instance = instance.Abbr - mastodonUser = account.Username - displayName = noneIfEmpty account.DisplayName - realName = None - profileUrl = account.Url - joinedOn = now - lastSeenOn = now - } - do! Data.Citizen.add it dbConn - return it - | Some citizen -> - let it = { citizen with displayName = noneIfEmpty account.DisplayName; lastSeenOn = now } - do! Data.Citizen.logOnUpdate it dbConn - return it - } - - // Step 3 - Generate JWT - return! - json - { jwt = Auth.createJwt citizen cfg - citizenId = CitizenId.toString citizen.id - name = Citizen.name citizen - } next ctx - | Error err -> return! RequestErrors.BAD_REQUEST err next ctx - | None -> return! Error.notFound next ctx + // let cfg = authConfig ctx + // + // match cfg.Instances |> Array.tryFind (fun it -> it.Abbr = abbr) with + // | Some instance -> + // let log = (logger ctx).CreateLogger (nameof JobsJobsJobs.Api.Auth) + // + // match! Auth.verifyWithMastodon authCode instance cfg.ReturnHost log with + // | Ok account -> + // // Step 2 - Find / establish Jobs, Jobs, Jobs account + // let now = (clock ctx).GetCurrentInstant () + // let dbConn = conn ctx + // let! citizen = task { + // match! Data.Citizen.findByMastodonUser instance.Abbr account.Username dbConn with + // | None -> + // let it : Citizen = + // { id = CitizenId.create () + // instance = instance.Abbr + // mastodonUser = account.Username + // displayName = noneIfEmpty account.DisplayName + // realName = None + // profileUrl = account.Url + // joinedOn = now + // lastSeenOn = now + // } + // do! Data.Citizen.add it dbConn + // return it + // | Some citizen -> + // let it = { citizen with displayName = noneIfEmpty account.DisplayName; lastSeenOn = now } + // do! Data.Citizen.logOnUpdate it dbConn + // return it + // } + // + // // Step 3 - Generate JWT + // return! + // json + // { jwt = Auth.createJwt citizen cfg + // citizenId = CitizenId.toString citizen.id + // name = Citizen.name citizen + // } next ctx + // | Error err -> return! RequestErrors.BAD_REQUEST err next ctx + // | None -> return! Error.notFound next ctx } // GET: /api/citizen/[id] @@ -248,7 +236,7 @@ module Listing = // POST: /listings let add : HttpHandler = authorize >=> fun next ctx -> task { let! form = ctx.BindJsonAsync () - let now = (clock ctx).GetCurrentInstant () + let now = now ctx do! Listings.save { id = ListingId.create () citizenId = currentCitizenId ctx @@ -269,7 +257,6 @@ module Listing = // PUT: /api/listing/[id] let update listingId : HttpHandler = authorize >=> fun next ctx -> task { - let dbConn = conn ctx match! Listings.findById (ListingId listingId) with | Some listing when listing.citizenId <> (currentCitizenId ctx) -> return! Error.notAuthorized next ctx | Some listing -> @@ -282,7 +269,7 @@ module Listing = remoteWork = form.remoteWork text = Text form.text neededBy = form.neededBy |> Option.map parseDate - updatedOn = (clock ctx).GetCurrentInstant () + updatedOn = now ctx } return! ok next ctx | None -> return! Error.notFound next ctx @@ -290,8 +277,7 @@ module Listing = // PATCH: /api/listing/[id] let expire listingId : HttpHandler = authorize >=> fun next ctx -> task { - let dbConn = conn ctx - let now = clock(ctx).GetCurrentInstant () + let now = now ctx match! Listings.findById (ListingId listingId) with | Some listing when listing.citizenId <> (currentCitizenId ctx) -> return! Error.notAuthorized next ctx | Some listing -> @@ -333,56 +319,41 @@ module Profile = // This returns the current citizen's profile, or a 204 if it is not found (a citizen not having a profile yet // is not an error). The "get" handler returns a 404 if a profile is not found. let current : HttpHandler = authorize >=> fun next ctx -> task { - match! Data.Profile.findById (currentCitizenId ctx) (conn ctx) with + match! Profiles.findById (currentCitizenId ctx) with | Some profile -> return! json profile next ctx | None -> return! Successful.NO_CONTENT next ctx } // GET: /api/profile/get/[id] let get citizenId : HttpHandler = authorize >=> fun next ctx -> task { - match! Data.Profile.findById (CitizenId citizenId) (conn ctx) with + match! Profiles.findById (CitizenId citizenId) with | Some profile -> return! json profile next ctx | None -> return! Error.notFound next ctx } // GET: /api/profile/view/[id] let view citizenId : HttpHandler = authorize >=> fun next ctx -> task { - let citId = CitizenId citizenId - let dbConn = conn ctx - match! Data.Profile.findById citId dbConn with - | Some profile -> - match! Data.Citizen.findById citId dbConn with - | Some citizen -> - match! Data.Continent.findById profile.continentId dbConn with - | Some continent -> - return! - json - { profile = profile - citizen = citizen - continent = continent - } next ctx - | None -> return! Error.notFound next ctx - | None -> return! Error.notFound next ctx + match! Profiles.findByIdForView (CitizenId citizenId) with + | Some profile -> return! json profile next ctx | None -> return! Error.notFound next ctx } // GET: /api/profile/count let count : HttpHandler = authorize >=> fun next ctx -> task { - let! theCount = Data.Profile.count (conn ctx) + let! theCount = Profiles.count () return! json { count = theCount } next ctx } // POST: /api/profile/save let save : HttpHandler = authorize >=> fun next ctx -> task { let citizenId = currentCitizenId ctx - let dbConn = conn ctx let! form = ctx.BindJsonAsync() let! profile = task { - match! Data.Profile.findById citizenId dbConn with + match! Profiles.findById citizenId with | Some p -> return p | None -> return { Profile.empty with id = citizenId } } - do! Data.Profile.save + do! Profiles.save { profile with seekingEmployment = form.isSeekingEmployment isPublic = form.isPublic @@ -391,48 +362,45 @@ module Profile = remoteWork = form.remoteWork fullTime = form.fullTime biography = Text form.biography - lastUpdatedOn = (clock ctx).GetCurrentInstant () + lastUpdatedOn = now ctx experience = noneIfBlank form.experience |> Option.map Text skills = form.skills |> List.map (fun s -> - { id = match s.id.StartsWith "new" with - | true -> SkillId.create () - | false -> SkillId.ofString s.id - description = s.description - notes = noneIfBlank s.notes - }) - } dbConn - do! Data.Citizen.realNameUpdate citizenId (noneIfBlank (Some form.realName)) dbConn + { id = if s.id.StartsWith "new" then SkillId.create () + else SkillId.ofString s.id + description = s.description + notes = noneIfBlank s.notes + }) + } return! ok next ctx } // PATCH: /api/profile/employment-found let employmentFound : HttpHandler = authorize >=> fun next ctx -> task { - let dbConn = conn ctx - match! Data.Profile.findById (currentCitizenId ctx) dbConn with + match! Profiles.findById (currentCitizenId ctx) with | Some profile -> - do! Data.Profile.save { profile with seekingEmployment = false } dbConn + do! Profiles.save { profile with seekingEmployment = false } return! ok next ctx | None -> return! Error.notFound next ctx } // DELETE: /api/profile let delete : HttpHandler = authorize >=> fun next ctx -> task { - do! Data.Profile.delete (currentCitizenId ctx) (conn ctx) + do! Profiles.deleteById (currentCitizenId ctx) return! ok next ctx } // GET: /api/profile/search let search : HttpHandler = authorize >=> fun next ctx -> task { let search = ctx.BindQueryString () - let! results = Data.Profile.search search (conn ctx) + let! results = Profiles.search search return! json results next ctx } // GET: /api/profile/public-search let publicSearch : HttpHandler = fun next ctx -> task { let search = ctx.BindQueryString () - let! results = Data.Profile.publicSearch search (conn ctx) + let! results = Profiles.publicSearch search return! json results next ctx } @@ -441,39 +409,35 @@ module Profile = [] module Success = - open System - // GET: /api/success/[id] let get successId : HttpHandler = authorize >=> fun next ctx -> task { - match! Data.Success.findById (SuccessId successId) (conn ctx) with + match! Successes.findById (SuccessId successId) with | Some story -> return! json story next ctx | None -> return! Error.notFound next ctx } // GET: /api/success/list let all : HttpHandler = authorize >=> fun next ctx -> task { - let! stories = Data.Success.all (conn ctx) + let! stories = Successes.all () return! json stories next ctx } // POST: /api/success/save let save : HttpHandler = authorize >=> fun next ctx -> task { let citizenId = currentCitizenId ctx - let dbConn = conn ctx - let now = (clock ctx).GetCurrentInstant () let! form = ctx.BindJsonAsync () let! success = task { match form.id with | "new" -> return Some { id = SuccessId.create () citizenId = citizenId - recordedOn = now + recordedOn = now ctx fromHere = form.fromHere source = "profile" story = noneIfEmpty form.story |> Option.map Text } | successId -> - match! Data.Success.findById (SuccessId.ofString successId) dbConn with + match! Successes.findById (SuccessId.ofString successId) with | Some story when story.citizenId = citizenId -> return Some { story with fromHere = form.fromHere @@ -483,7 +447,7 @@ module Success = } match success with | Some story -> - do! Data.Success.save story dbConn + do! Successes.save story return! ok next ctx | None -> return! Error.notFound next ctx } diff --git a/src/JobsJobsJobs/Server/JobsJobsJobs.Server.fsproj b/src/JobsJobsJobs/Server/JobsJobsJobs.Server.fsproj index 4dc6bbd..10807ec 100644 --- a/src/JobsJobsJobs/Server/JobsJobsJobs.Server.fsproj +++ b/src/JobsJobsJobs/Server/JobsJobsJobs.Server.fsproj @@ -8,7 +8,6 @@ - @@ -25,15 +24,10 @@ - + - - - - - - + -- 2.45.1 From 1a91f10da2198d4216bb7ed0fb907a117d32aa03 Mon Sep 17 00:00:00 2001 From: "Daniel J. Summers" Date: Sat, 27 Aug 2022 16:22:45 -0400 Subject: [PATCH 09/67] Remove Marten; implement own doc storage - Begin work on migration --- .../JobsJobsJobs.V3Migration.fsproj | 12 + src/JobsJobsJobs.V3Migration/Program.fs | 4 + src/JobsJobsJobs.sln | 7 + src/JobsJobsJobs/Domain/Types.fs | 9 - src/JobsJobsJobs/JobsJobsJobs.Data/Data.fs | 668 ++++++++---------- .../JobsJobsJobs.Data.fsproj | 1 + src/JobsJobsJobs/JobsJobsJobs.Data/Json.fs | 22 +- .../JobsJobsJobs.V3Migration.fsproj | 23 + .../JobsJobsJobs.V3Migration/Program.fs | 93 +++ .../JobsJobsJobs.V3Migration/appsettings.json | 13 + src/JobsJobsJobs/Server/App.fs | 2 +- 11 files changed, 461 insertions(+), 393 deletions(-) create mode 100644 src/JobsJobsJobs.V3Migration/JobsJobsJobs.V3Migration.fsproj create mode 100644 src/JobsJobsJobs.V3Migration/Program.fs create mode 100644 src/JobsJobsJobs/JobsJobsJobs.V3Migration/JobsJobsJobs.V3Migration.fsproj create mode 100644 src/JobsJobsJobs/JobsJobsJobs.V3Migration/Program.fs create mode 100644 src/JobsJobsJobs/JobsJobsJobs.V3Migration/appsettings.json diff --git a/src/JobsJobsJobs.V3Migration/JobsJobsJobs.V3Migration.fsproj b/src/JobsJobsJobs.V3Migration/JobsJobsJobs.V3Migration.fsproj new file mode 100644 index 0000000..7b4f671 --- /dev/null +++ b/src/JobsJobsJobs.V3Migration/JobsJobsJobs.V3Migration.fsproj @@ -0,0 +1,12 @@ + + + + Exe + net6.0 + + + + + + + diff --git a/src/JobsJobsJobs.V3Migration/Program.fs b/src/JobsJobsJobs.V3Migration/Program.fs new file mode 100644 index 0000000..103e536 --- /dev/null +++ b/src/JobsJobsJobs.V3Migration/Program.fs @@ -0,0 +1,4 @@ + + +// For more information see https://aka.ms/fsharp-console-apps +printfn "Hello from F#" \ No newline at end of file diff --git a/src/JobsJobsJobs.sln b/src/JobsJobsJobs.sln index c226a73..91622f2 100644 --- a/src/JobsJobsJobs.sln +++ b/src/JobsJobsJobs.sln @@ -19,6 +19,8 @@ Project("{F2A71F9B-5D33-465A-A702-920D77279786}") = "Api", "JobsJobsJobs\Server\ EndProject Project("{F2A71F9B-5D33-465A-A702-920D77279786}") = "JobsJobsJobs.Data", "JobsJobsJobs\JobsJobsJobs.Data\JobsJobsJobs.Data.fsproj", "{30CC1E7C-A843-4DAC-9058-E7C6ACBCE85D}" EndProject +Project("{F2A71F9B-5D33-465A-A702-920D77279786}") = "JobsJobsJobs.V3Migration", "JobsJobsJobs\JobsJobsJobs.V3Migration\JobsJobsJobs.V3Migration.fsproj", "{DC3E225D-9720-44E8-86AE-DEE71262C9F0}" +EndProject Global GlobalSection(SolutionConfigurationPlatforms) = preSolution Debug|Any CPU = Debug|Any CPU @@ -37,6 +39,10 @@ Global {30CC1E7C-A843-4DAC-9058-E7C6ACBCE85D}.Debug|Any CPU.Build.0 = Debug|Any CPU {30CC1E7C-A843-4DAC-9058-E7C6ACBCE85D}.Release|Any CPU.ActiveCfg = Release|Any CPU {30CC1E7C-A843-4DAC-9058-E7C6ACBCE85D}.Release|Any CPU.Build.0 = Release|Any CPU + {DC3E225D-9720-44E8-86AE-DEE71262C9F0}.Debug|Any CPU.ActiveCfg = Debug|Any CPU + {DC3E225D-9720-44E8-86AE-DEE71262C9F0}.Debug|Any CPU.Build.0 = Debug|Any CPU + {DC3E225D-9720-44E8-86AE-DEE71262C9F0}.Release|Any CPU.ActiveCfg = Release|Any CPU + {DC3E225D-9720-44E8-86AE-DEE71262C9F0}.Release|Any CPU.Build.0 = Release|Any CPU EndGlobalSection GlobalSection(SolutionProperties) = preSolution HideSolutionNode = FALSE @@ -48,5 +54,6 @@ Global {C81278DA-DA97-4E55-AB39-4B88565B615D} = {FA833B24-B8F6-4CE6-A044-99257EAC02FF} {8F5A3D1E-562B-4F27-9787-6CB14B35E69E} = {FA833B24-B8F6-4CE6-A044-99257EAC02FF} {30CC1E7C-A843-4DAC-9058-E7C6ACBCE85D} = {FA833B24-B8F6-4CE6-A044-99257EAC02FF} + {DC3E225D-9720-44E8-86AE-DEE71262C9F0} = {FA833B24-B8F6-4CE6-A044-99257EAC02FF} EndGlobalSection EndGlobal diff --git a/src/JobsJobsJobs/Domain/Types.fs b/src/JobsJobsJobs/Domain/Types.fs index a24354a..eab5d3c 100644 --- a/src/JobsJobsJobs/Domain/Types.fs +++ b/src/JobsJobsJobs/Domain/Types.fs @@ -38,9 +38,6 @@ type Citizen = /// Whether this is a legacy citizen isLegacy : bool } -with - /// Unwrapped ID for database PK use - member this.DbId = CitizenId.value this.id /// Support functions for citizens module Citizen = @@ -72,9 +69,6 @@ type Continent = /// The name of the continent name : string } -with - /// Unwrapped ID for database PK use - member this.DbId = ContinentId.value this.id /// Support functions for continents module Continent = @@ -170,9 +164,6 @@ type SecurityInfo = /// When the token expires TokenExpires : Instant option } -with - /// Unwrapped ID for database PK use - member this.DbId = CitizenId.value this.Id /// Functions to support security info module SecurityInfo = diff --git a/src/JobsJobsJobs/JobsJobsJobs.Data/Data.fs b/src/JobsJobsJobs/JobsJobsJobs.Data/Data.fs index bcd8bba..b8b645e 100644 --- a/src/JobsJobsJobs/JobsJobsJobs.Data/Data.fs +++ b/src/JobsJobsJobs/JobsJobsJobs.Data/Data.fs @@ -1,137 +1,124 @@ namespace JobsJobsJobs.Data -open System -open JobsJobsJobs.Domain - -/// Wrapper documents for our record types -module Documents = +/// Constants for tables used by Jobs, Jobs, Jobs +module Table = - /// A generic type that keeps its ID in sync with the ID value for its content - [] - type Document<'T> (initialValue : 'T, toId : 'T -> Guid) = - - /// The current value for this document - let mutable value = initialValue - - /// The ID for this document - member val Id = toId initialValue with get, set - - /// The value for this document - member this.Value - with get () = value - and set (v : 'T) = - value <- v - this.Id <- toId v - - /// Convert a document to its value - static member ToValue (doc : Document<'T>) = - doc.Value - - /// Convert a document to its value, or None if the document is null - static member TryValue (doc : Document<'T>) = - if isNull doc then None else Some doc.Value + /// Citizens + [] + let Citizen = "citizen" - /// A citizen document - [] - type CitizenDocument (citizen : Citizen) = - inherit Document (citizen, fun c -> CitizenId.value c.id) - new() = CitizenDocument Citizen.empty + /// Continents + [] + let Continent = "continent" - /// A continent document - [] - type ContinentDocument (continent : Continent) = - inherit Document (continent, fun c -> ContinentId.value c.id) - new () = ContinentDocument Continent.empty + /// Job Listings + [] + let Listing = "listing" - /// A job listing document - [] - type ListingDocument (listing : Listing) = - inherit Document (listing, fun l -> ListingId.value l.id) - new () = ListingDocument Listing.empty + /// Employment Profiles + [] + let Profile = "profile" - /// A profile document - [] - type ProfileDocument (profile : Profile) = - inherit Document (profile, fun p -> CitizenId.value p.id) - new () = ProfileDocument Profile.empty + /// User Security Information + [] + let SecurityInfo = "security_info" - /// A security information document - [] - type SecurityInfoDocument (securityInfo : SecurityInfo) = - inherit Document (securityInfo, fun si -> CitizenId.value si.Id) - new () = SecurityInfoDocument SecurityInfo.empty - - /// A success story document - [] - type SuccessDocument (success : Success) = - inherit Document (success, fun s -> SuccessId.value s.id) - new () = SuccessDocument Success.empty + /// Success Stories + [] + let Success = "success" -open Documents -open Marten +open Npgsql.FSharp /// Connection management for the Marten document store -module Connection = +module DataConnection = - open Marten.NodaTime open Microsoft.Extensions.Configuration - open Weasel.Core /// The configuration from which a document store will be created let mutable private config : IConfiguration option = None - /// Lazy initialization for the Marten document store, constructed when setUp() is called - let private lazyStore = lazy (task { + /// Get the connection string + let connection () = match config with - | Some cfg -> - let store = - DocumentStore.For(fun opts -> - opts.Connection (cfg.GetConnectionString "PostgreSQL") - opts.RegisterDocumentTypes [ - typeof; typeof; typeof - typeof; typeof; typeof - ] - opts.DatabaseSchemaName <- "jjj" - opts.AutoCreateSchemaObjects <- AutoCreate.CreateOrUpdate - opts.UseNodaTime () - - let _ = opts.Schema.For().DocumentAlias "citizen" - let _ = opts.Schema.For().DocumentAlias "continent" - let _ = opts.Schema.For().DocumentAlias "listing" - let _ = opts.Schema.For().DocumentAlias "profile" - let _ = opts.Schema.For().DocumentAlias "security_info" - let _ = opts.Schema.For().DocumentAlias "success" - ()) - do! store.Storage.ApplyAllConfiguredChangesToDatabaseAsync () - return Ok store - | None -> return Error "Connection.setUp() must be called before accessing a document session" - }) - + | Some cfg -> Sql.connect (cfg.GetConnectionString "PostgreSQL") + | None -> invalidOp "Connection.setUp() must be called before accessing the database" + + /// Create tables + let private createTables () = backgroundTask { + let sql = + [ Table.Citizen; Table.Continent; Table.Listing; Table.Profile; Table.SecurityInfo; Table.Success ] + |> List.map (fun table -> + $"CREATE TABLE IF NOT EXISTS jjj.{table} (id TEXT NOT NULL PRIMARY KEY, data JSONB NOT NULL)") + |> String.concat "; " + let! _ = + connection () + |> Sql.executeTransactionAsync [ sql, [ [] ] ] + // TODO: prudent indexes + () + } + /// Set up the data connection from the given configuration - let setUp (cfg : IConfiguration) = + let setUp (cfg : IConfiguration) = backgroundTask { config <- Some cfg - lazyStore.Force () + do! createTables () + } + + +open DataConnection + +/// Helper functions for data manipulation +[] +module private Helpers = - /// A read-only document session - let querySession () = - match lazyStore.Force().Result with - | Ok store -> store.QuerySession () - | Error msg -> raise (invalidOp msg) + open System.Text.Json + open System.Threading.Tasks - /// A read/write document session - let docSession () = - match lazyStore.Force().Result with - | Ok store -> store.LightweightSession () - | Error msg -> raise (invalidOp msg) + /// 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 jjj.%s{table} where id = @id" sqlProps + |> Sql.parameters [ "@id", Sql.string docId ] + |> Sql.executeAsync toDocument + return List.tryHead doc + } + + /// Save a document + let saveDocument<'T> table docId (doc : 'T) sqlProps = backgroundTask { + let! _ = + Sql.query + $"INSERT INTO jjj.%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 (JsonSerializer.Serialize (doc, Json.options)) ] + |> 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}" -/// Shorthand for the generic dictionary -type Dict<'TKey, 'TValue> = System.Collections.Generic.Dictionary<'TKey, 'TValue> - - -open System.Linq -open Connection +open JobsJobsJobs.Domain /// Citizen data access functions [] @@ -139,67 +126,61 @@ module Citizens = /// Delete a citizen by their ID let deleteById citizenId = backgroundTask { - use session = docSession () - session.DeleteWhere(fun s -> s.Value.citizenId = citizenId) - session.DeleteWhere(fun l -> l.Value.citizenId = citizenId) - let docId = CitizenId.value citizenId - session.Delete docId - session.Delete docId - session.Delete docId - do! session.SaveChangesAsync () + let! _ = + connection () + |> Sql.executeTransactionAsync [ + "DELETE FROM jjj.success WHERE data->>'citizenId' = @id; + DELETE FROM jjj.listing WHERE data->>'citizenId' = @id; + DELETE FROM jjj.profile WHERE id = @id; + DELETE FROM jjj.security_info WHERE id = @id; + DELETE FROM jjj.citizen WHERE id = @id", + [ [ "@id", Sql.string (CitizenId.toString citizenId) ] ] + ] + () } /// Find a citizen by their ID let findById citizenId = backgroundTask { - use session = querySession () - let! citizen = session.LoadAsync (CitizenId.value citizenId) - return - match Document.TryValue citizen with - | Some c when not c.isLegacy -> Some c - | Some _ - | None -> None + match! connection () |> 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 : Citizen) = backgroundTask { - use session = docSession () - session.Store (CitizenDocument citizen) - do! session.SaveChangesAsync () - } + let save (citizen : Citizen) = + connection () |> saveDocument Table.Citizen (CitizenId.toString citizen.id) citizen /// Attempt a user log on let tryLogOn email (pwCheck : string -> bool) now = backgroundTask { - use session = docSession () + let connProps = connection () let! tryCitizen = - session.Query() - .Where(fun c -> c.Value.email = email && not c.Value.isLegacy) - .SingleOrDefaultAsync () - match Document.TryValue tryCitizen with + connProps + |> Sql.query $"SELECT * FROM jjj.{Table.Citizen} WHERE data->>email = @email AND data->>isValue <> 'true'" + |> Sql.parameters [ "@email", Sql.string email ] + |> Sql.executeAsync toDocument + match List.tryHead tryCitizen with | Some citizen -> - let! tryInfo = session.LoadAsync (CitizenId.value citizen.id) + let citizenId = CitizenId.toString citizen.id + let! tryInfo = getDocument Table.SecurityInfo citizenId connProps let! info = backgroundTask { - match Document.TryValue tryInfo with + match tryInfo with | Some it -> return it | None -> let it = { SecurityInfo.empty with Id = citizen.id } - session.Store (SecurityInfoDocument it) - do! session.SaveChangesAsync () + do! saveDocument Table.SecurityInfo citizenId it connProps return it } if info.AccountLocked then return Error "Log on unsuccessful (Account Locked)" elif pwCheck citizen.passwordHash then - session.Store (SecurityInfoDocument { info with FailedLogOnAttempts = 0}) - session.Store (CitizenDocument { citizen with lastSeenOn = now}) - do! session.SaveChangesAsync () + do! saveDocument Table.SecurityInfo citizenId { info with FailedLogOnAttempts = 0 } connProps + do! saveDocument Table.Citizen citizenId { citizen with lastSeenOn = now } connProps return Ok { citizen with lastSeenOn = now } else let locked = info.FailedLogOnAttempts >= 4 - session.Store (SecurityInfoDocument { - info with - FailedLogOnAttempts = info.FailedLogOnAttempts + 1 - AccountLocked = locked - }) - do! session.SaveChangesAsync () + do! saveDocument Table.SecurityInfo citizenId + { info with FailedLogOnAttempts = info.FailedLogOnAttempts + 1; AccountLocked = locked } + connProps return Error $"""Log on unsuccessful{if locked then " - Account is now locked" else ""}""" | None -> return Error "Log on unsuccessful" } @@ -210,18 +191,14 @@ module Citizens = module Continents = /// Retrieve all continents - let all () = backgroundTask { - use session = querySession () - let! it = session.Query().AsQueryable().ToListAsync () - return it |> Seq.map Document.ToValue |> List.ofSeq - } + let all () = + connection () + |> Sql.query $"SELECT * FROM jjj.{Table.Continent}" + |> Sql.executeAsync toDocument /// Retrieve a continent by its ID - let findById continentId = backgroundTask { - use session = querySession () - let! tryContinent = session.LoadAsync (ContinentId.value continentId) - return Document.TryValue tryContinent - } + let findById continentId = + connection () |> getDocument Table.Continent (ContinentId.toString continentId) open JobsJobsJobs.Domain.SharedTypes @@ -230,29 +207,26 @@ open JobsJobsJobs.Domain.SharedTypes [] module Listings = + /// The SQL to select a listing view + let viewSql = + $"SELECT l.*, c.data AS cont_data + FROM jjj.{Table.Listing} l + INNER JOIN jjj.{Table.Continent} c ON c.id = l.data->>'continentId'" + + /// Map a result for a listing view + let private toListingForView row = + { listing = toDocument row; continent = toDocumentFrom "cont_data" row } + /// Find all job listings posted by the given citizen - let findByCitizen citizenId = backgroundTask { - use session = querySession () - let continents = Dict () - let! listings = - session.Query() - .Include((fun l -> l.Value.continentId :> obj), continents) - .Where(fun l -> l.Value.citizenId = citizenId && not l.Value.isLegacy) - .ToListAsync () - return - listings - |> Seq.map (fun l -> { - listing = l.Value - continent = continents[ContinentId.value l.Value.continentId].Value - }) - |> List.ofSeq - } + let findByCitizen citizenId = + connection () + |> Sql.query $"{viewSql} WHERE l.data->>'citizenId' = @citizenId AND l.data->>'isLegacy' <> 'true'" + |> Sql.parameters [ "@citizenId", Sql.string (CitizenId.toString citizenId) ] + |> Sql.executeAsync toListingForView /// Find a listing by its ID let findById listingId = backgroundTask { - use session = querySession () - let! tryListing = session.LoadAsync (ListingId.value listingId) - match Document.TryValue tryListing with + match! connection () |> getDocument Table.Listing (ListingId.toString listingId) with | Some listing when not listing.isLegacy -> return Some listing | Some _ | None -> return None @@ -260,60 +234,40 @@ module Listings = /// Find a listing by its ID for viewing (includes continent information) let findByIdForView listingId = backgroundTask { - use session = querySession () - let mutable continent : ContinentDocument = null let! tryListing = - session.Query() - .Include((fun l -> l.Value.continentId :> obj), fun c -> continent <- c) - .Where(fun l -> l.Id = ListingId.value listingId && not l.Value.isLegacy) - .SingleOrDefaultAsync () - match Document.TryValue tryListing with - | Some listing when not (isNull continent) -> return Some { listing = listing; continent = continent.Value } - | Some _ - | None -> return None + connection () + |> Sql.query $"{viewSql} WHERE id = @id AND l.data->>'isLegacy' <> 'true'" + |> Sql.parameters [ "@id", Sql.string (ListingId.toString listingId) ] + |> Sql.executeAsync toListingForView + return List.tryHead tryListing } /// Save a listing - let save (listing : Listing) = backgroundTask { - use session = docSession () - session.Store (ListingDocument listing) - do! session.SaveChangesAsync () - } + let save (listing : Listing) = + connection () |> saveDocument Table.Listing (ListingId.toString listing.id) listing /// Search job listings - let search (search : ListingSearch) = backgroundTask { - use session = querySession () - let continents = Dict () - let searchQuery = - seq bool> { - match search.continentId with - | Some contId -> - fun (l : ListingDocument) -> l.Value.continentId = (ContinentId.ofString contId) - | None -> () - match search.region with - | Some region -> - fun (l : ListingDocument) -> l.Value.region.Contains (region, StringComparison.OrdinalIgnoreCase) - | None -> () - if search.remoteWork <> "" then - fun (l : ListingDocument) -> l.Value.remoteWork = (search.remoteWork = "yes") - // match search.text with - // | Some text -> fun (l : Listing) -> l.text.Contains (text, StringComparison.OrdinalIgnoreCase) - // | None -> () - } - |> Seq.fold - (fun q filter -> Queryable.Where(q, filter)) - (session.Query() - .Include((fun l -> l.Value.continentId :> obj), continents) - .Where(fun l -> not l.Value.isExpired && not l.Value.isLegacy)) - let! results = searchQuery.ToListAsync () - return - results - |> Seq.map (fun l -> { - listing = l.Value - continent = continents[ContinentId.value l.Value.continentId].Value - }) - |> List.ofSeq - } + let search (search : ListingSearch) = + let searches = [ + match search.continentId with + | Some contId -> "l.data->>'continentId' = @continentId", [ "@continentId", Sql.string contId ] + | None -> () + match search.region with + | Some region -> "l.data->>'region' ILIKE @region", [ "@region", like region ] + | None -> () + if search.remoteWork <> "" then + "l.data->>'remoteWork' = @remote", [ "@remote", jsonBool (search.remoteWork = "yes") ] + match search.text with + | Some text -> "l.data->>'text' ILIKE @text", [ "@text", like text ] + | None -> () + ] + connection () + |> 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 @@ -322,174 +276,154 @@ module Profiles = /// Count the current profiles let count () = - use session = querySession () - session.Query().Where(fun p -> not p.Value.isLegacy).LongCountAsync () + connection () + |> Sql.query $"SELECT COUNT(id) AS the_count FROM jjj.{Table.Profile} WHERE data->>'isLegacy' <> 'true'" + |> Sql.executeRowAsync (fun row -> row.int64 "the_count") /// Delete a profile by its ID let deleteById citizenId = backgroundTask { - use session = docSession () - session.Delete (CitizenId.value citizenId) - do! session.SaveChangesAsync () - } - /// Find a profile by citizen ID - let findById citizenId = backgroundTask { - use session = querySession () - let! profile = session.LoadAsync (CitizenId.value citizenId) - return - match Document.TryValue profile with - | Some p when not p.isLegacy -> Some p - | Some _ - | None -> None + let! _ = + connection () + |> Sql.query $"DELETE FROM jjj.{Table.Profile} WHERE id = @id" + |> Sql.parameters [ "@id", Sql.string (CitizenId.toString citizenId) ] + |> Sql.executeNonQueryAsync + () } - /// Find a profile by citizen ID for viewing (includes citizen and continent information) - let findByIdForView citizenId = backgroundTask { - use session = querySession () - let mutable citizen : CitizenDocument = null - let mutable continent : ContinentDocument = null - let! tryProfile = - session.Query() - .Include((fun p -> p.Id :> obj), fun c -> citizen <- c) - .Include((fun p -> p.Value.continentId :> obj), fun c -> continent <- c) - .Where(fun p -> p.Id = CitizenId.value citizenId && not p.Value.isLegacy) - .SingleOrDefaultAsync () - match Document.TryValue tryProfile with - | Some profile when not (isNull citizen) && not (isNull continent) -> - return Some { profile = profile; citizen = citizen.Value; continent = continent.Value } + /// Find a profile by citizen ID + let findById citizenId = backgroundTask { + match! connection () |> getDocument Table.Profile (CitizenId.toString citizenId) with + | Some profile when not profile.isLegacy -> return Some profile | Some _ | None -> return None } - /// Save a profile - let save (profile : Profile) = backgroundTask { - use session = docSession () - session.Store (ProfileDocument profile) - do! session.SaveChangesAsync () + /// Find a profile by citizen ID for viewing (includes citizen and continent information) + let findByIdForView citizenId = backgroundTask { + let! tryCitizen = + connection () + |> Sql.query $" + SELECT p.*, c.data AS cit_data, o.data AS cont_data + FROM jjj.{Table.Profile} p + INNER JOIN jjj.{Table.Citizen} c ON c.id = p.id + INNER JOIN jjj.{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) = + connection () |> saveDocument Table.Profile (CitizenId.toString profile.id) profile + /// Search profiles (logged-on users) let search (search : ProfileSearch) = backgroundTask { - use session = querySession () - let citizens = Dict () - let searchQuery = - seq bool> { - match search.continentId with - | Some contId -> fun (p : ProfileDocument) -> p.Value.continentId = ContinentId.ofString contId - | None -> () - if search.remoteWork <> "" then - fun (p : ProfileDocument) -> p.Value.remoteWork = (search.remoteWork = "yes") - match search.skill with - | Some skl -> - fun (p : ProfileDocument) -> - p.Value.skills.Any(fun s -> s.description.Contains (skl, StringComparison.OrdinalIgnoreCase)) - | None -> () - // match search.bioExperience with - // | Some text -> - // let txt = regexContains text - // yield filterFunc (fun it -> it.G("biography").Match(txt).Or (it.G("experience").Match txt)) - // | None -> () - } - |> Seq.fold - (fun q filter -> Queryable.Where(q, filter)) - (session.Query() - .Include((fun p -> p.Id :> obj), citizens) - .Where(fun p -> not p.Value.isLegacy)) - let! results = searchQuery.ToListAsync () - return - results - |> Seq.map (fun profileDoc -> - let p = profileDoc.Value - { citizenId = p.id - displayName = Citizen.name citizens[CitizenId.value p.id].Value - seekingEmployment = p.seekingEmployment - remoteWork = p.remoteWork - fullTime = p.fullTime - lastUpdatedOn = p.lastUpdatedOn + let searches = [ + match search.continentId with + | Some contId -> "p.data ->>'continentId' = @continentId", [ "@continentId", Sql.string contId ] + | None -> () + if search.remoteWork <> "" then + "p.data->>'remoteWork' = @remote", [ "@remote", jsonBool (search.remoteWork = "yes") ] + match search.skill with + | Some skl -> "p.data->'skills'->>'description' ILIKE @description", [ "@description", like skl ] + | None -> () + match search.bioExperience with + | Some text -> + "(p.data->>'biography' ILIKE @text OR p.data->>'experience' ILIKE @text)", [ "@text", Sql.string text ] + | None -> () + ] + let! results = + connection () + |> Sql.query $" + SELECT p.*, c.data AS cit_data + FROM jjj.{Table.Profile} p + INNER JOIN jjj.{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.seekingEmployment + remoteWork = profile.remoteWork + fullTime = profile.fullTime + lastUpdatedOn = profile.lastUpdatedOn }) - |> Seq.sortBy (fun psr -> psr.displayName.ToLowerInvariant ()) - |> List.ofSeq + return results |> List.sortBy (fun psr -> psr.displayName.ToLowerInvariant ()) } // Search profiles (public) - let publicSearch (search : PublicSearch) = backgroundTask { - use session = querySession () - let continents = Dict () - let searchQuery = - seq bool> { - match search.continentId with - | Some contId -> fun (p : ProfileDocument) -> p.Value.continentId = ContinentId.ofString contId - | None -> () - match search.region with - | Some region -> - fun (p : ProfileDocument) -> p.Value.region.Contains (region, StringComparison.OrdinalIgnoreCase) - | None -> () - if search.remoteWork <> "" then - fun (p : ProfileDocument) -> p.Value.remoteWork = (search.remoteWork = "yes") - match search.skill with - | Some skl -> - fun (p : ProfileDocument) -> - p.Value.skills.Any(fun s -> s.description.Contains (skl, StringComparison.OrdinalIgnoreCase)) - | None -> () - } - |> Seq.fold - (fun q filter -> Queryable.Where(q, filter)) - (session.Query() - .Include((fun p -> p.Value.continentId :> obj), continents) - .Where(fun p -> p.Value.isPublic && not p.Value.isLegacy)) - let! results = searchQuery.ToListAsync () - return - results - |> Seq.map (fun profileDoc -> - let p = profileDoc.Value - { continent = continents[ContinentId.value p.continentId].Value.name - region = p.region - remoteWork = p.remoteWork - skills = p.skills - |> List.map (fun s -> - let notes = match s.notes with Some n -> $" ({n})" | None -> "" - $"{s.description}{notes}") - }) - |> List.ofSeq - } + let publicSearch (search : PublicSearch) = + let searches = [ + match search.continentId with + | Some contId -> "p.data->>'continentId' = @continentId", [ "@continentId", Sql.string contId ] + | None -> () + match search.region with + | Some region -> "p.data->>'region' ILIKE @region", [ "@region", like region ] + | None -> () + if search.remoteWork <> "" then + "p.data->>'remoteWork' = @remote", [ "@remote", jsonBool (search.remoteWork = "yes") ] + match search.skill with + | Some skl -> + "p.data->'skills'->>'description' ILIKE @description", [ "@description", like skl ] + | None -> () + ] + connection () + |> Sql.query $" + SELECT p.*, c.data AS cont_data + FROM jjj.{Table.Profile} p + INNER JOIN jjj.{Table.Continent} c ON c.id = p.data->>'continentId' + WHERE p.data->>'isPublic' = 'true' + AND p.data->>'isLegacy' = 'false' + {searchSql searches}" + |> Sql.executeAsync (fun row -> + let profile = toDocument row + let continent = toDocumentFrom "cont_data" row + { continent = continent.name + region = profile.region + remoteWork = profile.remoteWork + 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 () = backgroundTask { - use session = querySession () - let citizens = Dict () - let! stories = - session.Query() - .Include((fun s -> s.Value.citizenId :> obj), citizens) - .OrderByDescending(fun s -> s.Value.recordedOn) - .ToListAsync () - return - stories - |> Seq.map (fun storyDoc -> - let s = storyDoc.Value - { id = s.id - citizenId = s.citizenId - citizenName = Citizen.name citizens[CitizenId.value s.citizenId].Value - recordedOn = s.recordedOn - fromHere = s.fromHere - hasStory = Option.isSome s.story - }) - |> List.ofSeq - } + let all () = + connection () + |> Sql.query $" + SELECT s.*, c.data AS cit_data + FROM jjj.{Table.Success} s + INNER JOIN jjj.{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.fromHere + hasStory = Option.isSome success.story + }) /// Find a success story by its ID - let findById successId = backgroundTask { - use session = querySession () - let! success = session.LoadAsync (SuccessId.value successId) - return Document.TryValue success - } + let findById successId = + connection () |> getDocument Table.Success (SuccessId.toString successId) /// Save a success story - let save (success : Success) = backgroundTask { - use session = docSession () - session.Store (SuccessDocument success) - do! session.SaveChangesAsync () - } + let save (success : Success) = + connection () |> saveDocument Table.Success (SuccessId.toString success.id) success \ No newline at end of file diff --git a/src/JobsJobsJobs/JobsJobsJobs.Data/JobsJobsJobs.Data.fsproj b/src/JobsJobsJobs/JobsJobsJobs.Data/JobsJobsJobs.Data.fsproj index b0f2602..4cfa081 100644 --- a/src/JobsJobsJobs/JobsJobsJobs.Data/JobsJobsJobs.Data.fsproj +++ b/src/JobsJobsJobs/JobsJobsJobs.Data/JobsJobsJobs.Data.fsproj @@ -20,6 +20,7 @@ + diff --git a/src/JobsJobsJobs/JobsJobsJobs.Data/Json.fs b/src/JobsJobsJobs/JobsJobsJobs.Data/Json.fs index 4f83795..5c96745 100644 --- a/src/JobsJobsJobs/JobsJobsJobs.Data/Json.fs +++ b/src/JobsJobsJobs/JobsJobsJobs.Data/Json.fs @@ -1,6 +1,5 @@ module JobsJobsJobs.Data.Json -open System open System.Text.Json open System.Text.Json.Serialization open JobsJobsJobs.Domain @@ -13,24 +12,15 @@ type WrappedJsonConverter<'T> (wrap : string -> 'T, unwrap : 'T -> string) = override _.Write(writer, value, _) = writer.WriteStringValue (unwrap value) -/// Convert a wrapped GUID to/from its string representation -type WrappedIdJsonConverter<'T> (wrap : Guid -> 'T, unwrap : 'T -> Guid) = - inherit JsonConverter<'T> () - override _.Read(reader, _, _) = - wrap (Guid.Parse (reader.GetString ())) - override _.Write(writer, value, _) = - writer.WriteStringValue ((unwrap value).ToString ()) - - /// JsonSerializer options that use the custom converters let options = let opts = JsonSerializerOptions () - [ WrappedIdJsonConverter (CitizenId, CitizenId.value) :> JsonConverter - WrappedIdJsonConverter (ContinentId, ContinentId.value) - WrappedIdJsonConverter (ListingId, ListingId.value) - WrappedJsonConverter (Text, MarkdownString.toString) - WrappedIdJsonConverter (SkillId, SkillId.value) - WrappedIdJsonConverter (SuccessId, SuccessId.value) + [ WrappedJsonConverter (CitizenId.ofString, CitizenId.toString) :> JsonConverter + WrappedJsonConverter (ContinentId.ofString, ContinentId.toString) + WrappedJsonConverter (ListingId.ofString, ListingId.toString) + WrappedJsonConverter (Text, MarkdownString.toString) + WrappedJsonConverter (SkillId.ofString, SkillId.toString) + WrappedJsonConverter (SuccessId.ofString, SuccessId.toString) JsonFSharpConverter () ] |> List.iter opts.Converters.Add diff --git a/src/JobsJobsJobs/JobsJobsJobs.V3Migration/JobsJobsJobs.V3Migration.fsproj b/src/JobsJobsJobs/JobsJobsJobs.V3Migration/JobsJobsJobs.V3Migration.fsproj new file mode 100644 index 0000000..913550a --- /dev/null +++ b/src/JobsJobsJobs/JobsJobsJobs.V3Migration/JobsJobsJobs.V3Migration.fsproj @@ -0,0 +1,23 @@ + + + + Exe + net6.0 + + + + + + + + + + + + + + + + + + diff --git a/src/JobsJobsJobs/JobsJobsJobs.V3Migration/Program.fs b/src/JobsJobsJobs/JobsJobsJobs.V3Migration/Program.fs new file mode 100644 index 0000000..d96da5a --- /dev/null +++ b/src/JobsJobsJobs/JobsJobsJobs.V3Migration/Program.fs @@ -0,0 +1,93 @@ + +open Microsoft.Extensions.Configuration + +/// Data access for v2 Jobs, Jobs, Jobs +module Rethink = + + /// Table names + [] + module Table = + /// The user (citizen of Gitmo Nation) table + let Citizen = "citizen" + /// The continent table + let Continent = "continent" + /// The job listing table + let Listing = "listing" + /// The citizen employment profile table + let Profile = "profile" + /// The success story table + let Success = "success" + /// All tables + let all () = [ Citizen; Continent; Listing; Profile; Success ] + + open RethinkDb.Driver.Net + + /// Functions run at startup + [] + module Startup = + + open NodaTime + open NodaTime.Serialization.JsonNet + open RethinkDb.Driver.FSharp + + /// Create a RethinkDB connection + let createConnection (connStr : string) = + // Add all required JSON converters + Converter.Serializer.ConfigureForNodaTime DateTimeZoneProviders.Tzdb |> ignore + // Connect to the database + let config = DataConfig.FromUri connStr + config.CreateConnection () + +/// Shorthand for the RethinkDB R variable (how every command starts) +let r = RethinkDb.Driver.RethinkDB.R + +open JobsJobsJobs.Data +open JobsJobsJobs.Domain +open Newtonsoft.Json.Linq +open NodaTime +open NodaTime.Text +open RethinkDb.Driver.FSharp.Functions + +/// Retrieve an instant from a JObject field +let getInstant (doc : JObject) name = + let text = doc[name].Value () + match InstantPattern.General.Parse text with + | it when it.Success -> it.Value + | _ -> + match InstantPattern.ExtendedIso.Parse text with + | it when it.Success -> it.Value + | it -> raise it.Exception + +task { + // Establish database connections + let cfg = ConfigurationBuilder().AddJsonFile("appsettings.json").Build () + use rethinkConn = Rethink.Startup.createConnection (cfg.GetConnectionString "RethinkDB") + match! DataConnection.setUp cfg with + | Ok _ -> () + | Error msg -> failwith msg + + // Migrate citizens + let! oldCitizens = + fromTable Rethink.Table.Citizen + |> runResult + |> withRetryOnce + |> withConn rethinkConn + let newCitizens = + oldCitizens + |> List.map (fun c -> + let user = c["mastodonUser"].Value () + { Citizen.empty with + id = CitizenId.ofString (c["id"].Value ()) + joinedOn = getInstant c "joinedOn" + lastSeenOn = getInstant c "lastSeenOn" + email = $"""{user}@{c["instance"].Value ()}""" + firstName = user + lastName = user + isLegacy = true + }) + for citizen in newCitizens do + do! Citizens.save citizen + printfn $"** Migrated {List.length newCitizens} citizen(s)" + () +} |> Async.AwaitTask |> Async.RunSynchronously + diff --git a/src/JobsJobsJobs/JobsJobsJobs.V3Migration/appsettings.json b/src/JobsJobsJobs/JobsJobsJobs.V3Migration/appsettings.json new file mode 100644 index 0000000..30e1ffe --- /dev/null +++ b/src/JobsJobsJobs/JobsJobsJobs.V3Migration/appsettings.json @@ -0,0 +1,13 @@ +{ + "ConnectionStrings": { + "RethinkDB": "rethinkdb://data02.bitbadger.solutions/jobsjobsjobs_dev", + "PostgreSQL": "Host=localhost;Username=jobsjobsjobs;Password=devpassword;Database=jobsjobsjobs" + }, + "Logging": { + "LogLevel": { + "Default": "Debug", + "System": "Information", + "Microsoft": "Information" + } + } +} \ No newline at end of file diff --git a/src/JobsJobsJobs/Server/App.fs b/src/JobsJobsJobs/Server/App.fs index e4d213e..d1e1f82 100644 --- a/src/JobsJobsJobs/Server/App.fs +++ b/src/JobsJobsJobs/Server/App.fs @@ -60,7 +60,7 @@ let configureServices (svc : IServiceCollection) = let _ = svc.Configure (cfg.GetSection "Auth") // Set up the Marten data store - match Connection.setUp cfg |> Async.AwaitTask |> Async.RunSynchronously with + match DataConnection.setUp cfg |> Async.AwaitTask |> Async.RunSynchronously with | Ok _ -> () | Error msg -> failwith $"Error initializing data store: {msg}" -- 2.45.1 From 21957330feeb5a9f40795e4f67eb27387a7e3150 Mon Sep 17 00:00:00 2001 From: "Daniel J. Summers" Date: Sat, 27 Aug 2022 22:34:51 -0400 Subject: [PATCH 10/67] Migration to pg docs complete --- .gitignore | 1 + src/JobsJobsJobs/Domain/SharedTypes.fs | 24 +- src/JobsJobsJobs/Domain/Types.fs | 221 +++++++++--------- src/JobsJobsJobs/JobsJobsJobs.Data/Data.fs | 208 +++++++++-------- .../JobsJobsJobs.Data.fsproj | 3 +- src/JobsJobsJobs/JobsJobsJobs.Data/Json.fs | 5 + .../JobsJobsJobs.V3Migration/Program.fs | 156 +++++++++++-- src/JobsJobsJobs/Server/Auth.fs | 2 +- src/JobsJobsJobs/Server/Handlers.fs | 118 +++++----- 9 files changed, 442 insertions(+), 296 deletions(-) diff --git a/.gitignore b/.gitignore index 2d0cfe8..16bf782 100644 --- a/.gitignore +++ b/.gitignore @@ -6,3 +6,4 @@ src/**/obj src/**/appsettings.*.json src/.vs src/.idea +src/JobsJobsJobs/JobsJobsJobs.V3Migration/appsettings.json diff --git a/src/JobsJobsJobs/Domain/SharedTypes.fs b/src/JobsJobsJobs/Domain/SharedTypes.fs index 649f7bf..a2c714e 100644 --- a/src/JobsJobsJobs/Domain/SharedTypes.fs +++ b/src/JobsJobsJobs/Domain/SharedTypes.fs @@ -203,20 +203,20 @@ module ProfileForm = /// Create an instance of this form from the given profile let fromProfile (profile : Profile) = - { isSeekingEmployment = profile.seekingEmployment - isPublic = profile.isPublic + { isSeekingEmployment = profile.IsSeekingEmployment + isPublic = profile.IsPubliclySearchable realName = "" - continentId = string profile.continentId - region = profile.region - remoteWork = profile.remoteWork - fullTime = profile.fullTime - biography = MarkdownString.toString profile.biography - experience = profile.experience |> Option.map MarkdownString.toString - skills = profile.skills + continentId = string profile.ContinentId + region = profile.Region + remoteWork = profile.IsRemote + fullTime = profile.IsFullTime + biography = MarkdownString.toString profile.Biography + experience = profile.Experience |> Option.map MarkdownString.toString + skills = profile.Skills |> List.map (fun s -> - { id = string s.id - description = s.description - notes = s.notes + { id = string s.Id + description = s.Description + notes = s.Notes }) } diff --git a/src/JobsJobsJobs/Domain/Types.fs b/src/JobsJobsJobs/Domain/Types.fs index eab5d3c..52cab1c 100644 --- a/src/JobsJobsJobs/Domain/Types.fs +++ b/src/JobsJobsJobs/Domain/Types.fs @@ -9,139 +9,140 @@ open System [] type Citizen = { /// The ID of the user - id : CitizenId + Id : CitizenId /// When the user joined Jobs, Jobs, Jobs - joinedOn : Instant + JoinedOn : Instant /// When the user last logged in - lastSeenOn : Instant + LastSeenOn : Instant /// The user's e-mail address - email : string + Email : string /// The user's first name - firstName : string + FirstName : string /// The user's last name - lastName : string + LastName : string /// The hash of the user's password - passwordHash : string + PasswordHash : string /// The name displayed for this user throughout the site - displayName : string option + DisplayName : string option /// The other contacts for this user - otherContacts : OtherContact list + OtherContacts : OtherContact list /// Whether this is a legacy citizen - isLegacy : bool + 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 - } + 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}" + match x.DisplayName with Some it -> it | None -> $"{x.FirstName} {x.LastName}" /// A continent [] type Continent = { /// The ID of the continent - id : ContinentId + Id : ContinentId /// The name of the continent - name : string + Name : string } /// Support functions for continents module Continent = /// An empty continent - let empty = - { id = ContinentId Guid.Empty - name = "" - } + let empty ={ + Id = ContinentId Guid.Empty + Name = "" + } /// A job listing [] type Listing = { /// The ID of the job listing - id : ListingId + Id : ListingId /// The ID of the citizen who posted the job listing - citizenId : CitizenId + CitizenId : CitizenId /// When this job listing was created - createdOn : Instant + CreatedOn : Instant /// The short title of the job listing - title : string + Title : string /// The ID of the continent on which the job is located - continentId : ContinentId + ContinentId : ContinentId /// The region in which the job is located - region : string + Region : string /// Whether this listing is for remote work - remoteWork : bool + IsRemote : bool /// Whether this listing has expired - isExpired : bool + IsExpired : bool /// When this listing was last updated - updatedOn : Instant + UpdatedOn : Instant /// The details of this job - text : MarkdownString + Text : MarkdownString /// When this job needs to be filled - neededBy : LocalDate option + NeededBy : LocalDate option /// Was this job filled as part of its appearance on Jobs, Jobs, Jobs? - wasFilledHere : bool option + WasFilledHere : bool option /// Whether this is a legacy listing - isLegacy : bool + 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 = "" - remoteWork = false - isExpired = false - updatedOn = Instant.MinValue - text = Text "" - neededBy = None - wasFilledHere = None - isLegacy = false - } + 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 @@ -169,26 +170,26 @@ type SecurityInfo = module SecurityInfo = /// An empty set of security info - let empty = - { Id = CitizenId Guid.Empty - FailedLogOnAttempts = 0 - AccountLocked = false - Token = None - TokenUsage = None - TokenExpires = None - } + let empty = { + Id = CitizenId Guid.Empty + FailedLogOnAttempts = 0 + AccountLocked = false + Token = None + TokenUsage = None + TokenExpires = None + } /// A skill the job seeker possesses type Skill = { /// The ID of the skill - id : SkillId + Id : SkillId /// A description of the skill - description : string + Description : string /// Notes regarding this skill (level, duration, etc.) - notes : string option + Notes : string option } @@ -196,97 +197,97 @@ type Skill = [] type Profile = { /// The ID of the citizen to whom this profile belongs - id : CitizenId + Id : CitizenId /// Whether this citizen is actively seeking employment - seekingEmployment : bool + IsSeekingEmployment : bool /// Whether this citizen allows their profile to be a part of the publicly-viewable, anonymous data - isPublic : bool + IsPubliclySearchable : bool /// Whether this citizen allows their profile to be viewed via a public link - isPublicLinkable : bool + IsPubliclyLinkable : bool /// The ID of the continent on which the citizen resides - continentId : ContinentId + ContinentId : ContinentId /// The region in which the citizen resides - region : string + Region : string /// Whether the citizen is looking for remote work - remoteWork : bool + IsRemote : bool /// Whether the citizen is looking for full-time work - fullTime : bool + IsFullTime : bool /// The citizen's professional biography - biography : MarkdownString + Biography : MarkdownString /// When the citizen last updated their profile - lastUpdatedOn : Instant + LastUpdatedOn : Instant /// The citizen's experience (topical / chronological) - experience : MarkdownString option + Experience : MarkdownString option /// Skills this citizen possesses - skills : Skill list + Skills : Skill list /// Whether this is a legacy profile - isLegacy : bool + IsLegacy : bool } /// Support functions for Profiles module Profile = // An empty profile - let empty = - { id = CitizenId Guid.Empty - seekingEmployment = false - isPublic = false - isPublicLinkable = false - continentId = ContinentId Guid.Empty - region = "" - remoteWork = false - fullTime = false - biography = Text "" - lastUpdatedOn = Instant.MinValue - experience = None - skills = [] - isLegacy = false - } + 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 + Id : SuccessId /// The ID of the citizen who wrote this success report - citizenId : CitizenId + CitizenId : CitizenId /// When this success report was recorded - recordedOn : Instant + RecordedOn : Instant /// Whether the success was due, at least in part, to Jobs, Jobs, Jobs - fromHere : bool + IsFromHere : bool /// The source of this success (listing or profile) - source : string + Source : string /// The success story - story : MarkdownString option + 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 - fromHere = false - source = "" - story = None - } + let empty = { + Id = SuccessId Guid.Empty + CitizenId = CitizenId Guid.Empty + RecordedOn = Instant.MinValue + IsFromHere = false + Source = "" + Story = None + } diff --git a/src/JobsJobsJobs/JobsJobsJobs.Data/Data.fs b/src/JobsJobsJobs/JobsJobsJobs.Data/Data.fs index b8b645e..083d1c6 100644 --- a/src/JobsJobsJobs/JobsJobsJobs.Data/Data.fs +++ b/src/JobsJobsJobs/JobsJobsJobs.Data/Data.fs @@ -5,27 +5,27 @@ module Table = /// Citizens [] - let Citizen = "citizen" + let Citizen = "jjj.citizen" /// Continents [] - let Continent = "continent" + let Continent = "jjj.continent" /// Job Listings [] - let Listing = "listing" + let Listing = "jjj.listing" /// Employment Profiles [] - let Profile = "profile" + let Profile = "jjj.profile" /// User Security Information [] - let SecurityInfo = "security_info" + let SecurityInfo = "jjj.security_info" /// Success Stories [] - let Success = "success" + let Success = "jjj.success" open Npgsql.FSharp @@ -46,15 +46,25 @@ module DataConnection = /// Create tables let private createTables () = backgroundTask { - let sql = - [ Table.Citizen; Table.Continent; Table.Listing; Table.Profile; Table.SecurityInfo; Table.Success ] - |> List.map (fun table -> - $"CREATE TABLE IF NOT EXISTS jjj.{table} (id TEXT NOT NULL PRIMARY KEY, data JSONB NOT NULL)") - |> String.concat "; " + let sql = [ + $"CREATE SCHEMA IF NOT EXISTS jjj" + $"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)" + $"CREATE INDEX IF NOT EXISTS idx_citizen_email ON {Table.Citizen} USING GIN ((data -> 'email'))" + $"CREATE INDEX IF NOT EXISTS idx_listing_citizen ON {Table.Listing} USING GIN ((data -> 'citizenId'))" + $"CREATE INDEX IF NOT EXISTS idx_listing_continent ON {Table.Listing} USING GIN ((data -> 'continentId'))" + $"CREATE INDEX IF NOT EXISTS idx_profile_continent ON {Table.Profile} USING GIN ((data -> 'continentId'))" + $"CREATE INDEX IF NOT EXISTS idx_success_citizen ON {Table.Success} USING GIN ((data -> 'citizenId'))" + ] let! _ = connection () - |> Sql.executeTransactionAsync [ sql, [ [] ] ] - // TODO: prudent indexes + |> Sql.executeTransactionAsync (sql |> List.map (fun sql -> sql, [ [] ])) () } @@ -84,22 +94,26 @@ module private Helpers = /// Get a document let getDocument<'T> table docId sqlProps : Task<'T option> = backgroundTask { let! doc = - Sql.query $"SELECT * FROM jjj.%s{table} where id = @id" sqlProps + 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<'T> table docId (doc : 'T) sqlProps = backgroundTask { + let saveDocument table docId sqlProps doc = backgroundTask { let! _ = Sql.query - $"INSERT INTO jjj.%s{table} (id, data) VALUES (@id, @data) - ON CONFLICT (id) DO UPDATE SET data = EXCLUDED.data" + $"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 (JsonSerializer.Serialize (doc, Json.options)) ] + [ "@id", Sql.string docId + "@data", Sql.jsonb doc ] |> Sql.executeNonQueryAsync () } @@ -128,59 +142,60 @@ module Citizens = let deleteById citizenId = backgroundTask { let! _ = connection () - |> Sql.executeTransactionAsync [ - "DELETE FROM jjj.success WHERE data->>'citizenId' = @id; - DELETE FROM jjj.listing WHERE data->>'citizenId' = @id; - DELETE FROM jjj.profile WHERE id = @id; - DELETE FROM jjj.security_info WHERE id = @id; - DELETE FROM jjj.citizen WHERE id = @id", - [ [ "@id", Sql.string (CitizenId.toString citizenId) ] ] - ] + |> 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 () } /// Find a citizen by their ID let findById citizenId = backgroundTask { match! connection () |> getDocument Table.Citizen (CitizenId.toString citizenId) with - | Some c when not c.isLegacy -> return Some c + | Some c when not c.IsLegacy -> return Some c | Some _ | None -> return None } /// Save a citizen let save (citizen : Citizen) = - connection () |> saveDocument Table.Citizen (CitizenId.toString citizen.id) citizen + connection () |> saveDocument Table.Citizen (CitizenId.toString citizen.Id) <| mkDoc citizen /// Attempt a user log on let tryLogOn email (pwCheck : string -> bool) now = backgroundTask { let connProps = connection () let! tryCitizen = connProps - |> Sql.query $"SELECT * FROM jjj.{Table.Citizen} WHERE data->>email = @email AND data->>isValue <> 'true'" + |> 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 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! saveDocument Table.SecurityInfo citizenId it connProps + let it = { SecurityInfo.empty with Id = citizen.Id } + do! saveDocument Table.SecurityInfo citizenId connProps (mkDoc it) return it } if info.AccountLocked then return Error "Log on unsuccessful (Account Locked)" - elif pwCheck citizen.passwordHash then - do! saveDocument Table.SecurityInfo citizenId { info with FailedLogOnAttempts = 0 } connProps - do! saveDocument Table.Citizen citizenId { citizen with lastSeenOn = now } connProps - return Ok { citizen with lastSeenOn = now } + elif pwCheck citizen.PasswordHash then + do! saveDocument Table.SecurityInfo citizenId connProps (mkDoc { info with FailedLogOnAttempts = 0 }) + do! saveDocument Table.Citizen citizenId connProps (mkDoc { citizen with LastSeenOn = now }) + return Ok { citizen with LastSeenOn = now } else let locked = info.FailedLogOnAttempts >= 4 - do! saveDocument Table.SecurityInfo citizenId - { info with FailedLogOnAttempts = info.FailedLogOnAttempts + 1; AccountLocked = locked } - connProps + do! mkDoc { info with FailedLogOnAttempts = info.FailedLogOnAttempts + 1; AccountLocked = locked } + |> saveDocument Table.SecurityInfo citizenId connProps return Error $"""Log on unsuccessful{if locked then " - Account is now locked" else ""}""" | None -> return Error "Log on unsuccessful" } @@ -193,7 +208,7 @@ module Continents = /// Retrieve all continents let all () = connection () - |> Sql.query $"SELECT * FROM jjj.{Table.Continent}" + |> Sql.query $"SELECT * FROM {Table.Continent}" |> Sql.executeAsync toDocument /// Retrieve a continent by its ID @@ -210,8 +225,8 @@ module Listings = /// The SQL to select a listing view let viewSql = $"SELECT l.*, c.data AS cont_data - FROM jjj.{Table.Listing} l - INNER JOIN jjj.{Table.Continent} c ON c.id = l.data->>'continentId'" + FROM {Table.Listing} l + INNER JOIN {Table.Continent} c ON c.id = l.data ->> 'continentId'" /// Map a result for a listing view let private toListingForView row = @@ -220,14 +235,14 @@ module Listings = /// Find all job listings posted by the given citizen let findByCitizen citizenId = connection () - |> Sql.query $"{viewSql} WHERE l.data->>'citizenId' = @citizenId AND l.data->>'isLegacy' <> 'true'" + |> 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! connection () |> getDocument Table.Listing (ListingId.toString listingId) with - | Some listing when not listing.isLegacy -> return Some listing + | Some listing when not listing.IsLegacy -> return Some listing | Some _ | None -> return None } @@ -236,7 +251,7 @@ module Listings = let findByIdForView listingId = backgroundTask { let! tryListing = connection () - |> Sql.query $"{viewSql} WHERE id = @id AND l.data->>'isLegacy' <> 'true'" + |> Sql.query $"{viewSql} WHERE id = @id AND l.data ->> 'isLegacy' = 'false'" |> Sql.parameters [ "@id", Sql.string (ListingId.toString listingId) ] |> Sql.executeAsync toListingForView return List.tryHead tryListing @@ -244,27 +259,27 @@ module Listings = /// Save a listing let save (listing : Listing) = - connection () |> saveDocument Table.Listing (ListingId.toString listing.id) listing + connection () |> saveDocument Table.Listing (ListingId.toString listing.Id) <| mkDoc listing /// Search job listings let search (search : ListingSearch) = let searches = [ match search.continentId with - | Some contId -> "l.data->>'continentId' = @continentId", [ "@continentId", Sql.string contId ] + | Some contId -> "l.data ->> 'continentId' = @continentId", [ "@continentId", Sql.string contId ] | None -> () match search.region with - | Some region -> "l.data->>'region' ILIKE @region", [ "@region", like region ] + | Some region -> "l.data ->> 'region' ILIKE @region", [ "@region", like region ] | None -> () if search.remoteWork <> "" then - "l.data->>'remoteWork' = @remote", [ "@remote", jsonBool (search.remoteWork = "yes") ] + "l.data ->> 'isRemote' = @remote", [ "@remote", jsonBool (search.remoteWork = "yes") ] match search.text with - | Some text -> "l.data->>'text' ILIKE @text", [ "@text", like text ] + | Some text -> "l.data ->> 'text' ILIKE @text", [ "@text", like text ] | None -> () ] connection () |> Sql.query $" {viewSql} - WHERE l.data->>'isExpired' = 'false' AND l.data->>'isLegacy' = 'false' + WHERE l.data ->> 'isExpired' = 'false' AND l.data ->> 'isLegacy' = 'false' {searchSql searches}" |> Sql.parameters (searches |> List.collect snd) |> Sql.executeAsync toListingForView @@ -277,14 +292,14 @@ module Profiles = /// Count the current profiles let count () = connection () - |> Sql.query $"SELECT COUNT(id) AS the_count FROM jjj.{Table.Profile} WHERE data->>'isLegacy' <> 'true'" + |> 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! _ = connection () - |> Sql.query $"DELETE FROM jjj.{Table.Profile} WHERE id = @id" + |> Sql.query $"DELETE FROM {Table.Profile} WHERE id = @id" |> Sql.parameters [ "@id", Sql.string (CitizenId.toString citizenId) ] |> Sql.executeNonQueryAsync () @@ -293,7 +308,7 @@ module Profiles = /// Find a profile by citizen ID let findById citizenId = backgroundTask { match! connection () |> getDocument Table.Profile (CitizenId.toString citizenId) with - | Some profile when not profile.isLegacy -> return Some profile + | Some profile when not profile.IsLegacy -> return Some profile | Some _ | None -> return None } @@ -304,11 +319,11 @@ module Profiles = connection () |> Sql.query $" SELECT p.*, c.data AS cit_data, o.data AS cont_data - FROM jjj.{Table.Profile} p - INNER JOIN jjj.{Table.Citizen} c ON c.id = p.id - INNER JOIN jjj.{Table.Continent} o ON o.id = p.data->>'continentId' - WHERE p.id = @id - AND p.data->>'isLegacy' = 'false'" + 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 @@ -320,42 +335,43 @@ module Profiles = /// Save a profile let save (profile : Profile) = - connection () |> saveDocument Table.Profile (CitizenId.toString profile.id) profile + connection () |> saveDocument Table.Profile (CitizenId.toString profile.Id) <| mkDoc profile /// Search profiles (logged-on users) let search (search : ProfileSearch) = backgroundTask { let searches = [ match search.continentId with - | Some contId -> "p.data ->>'continentId' = @continentId", [ "@continentId", Sql.string contId ] + | Some contId -> "p.data ->> 'continentId' = @continentId", [ "@continentId", Sql.string contId ] | None -> () if search.remoteWork <> "" then - "p.data->>'remoteWork' = @remote", [ "@remote", jsonBool (search.remoteWork = "yes") ] + "p.data ->> 'remoteWork' = @remote", [ "@remote", jsonBool (search.remoteWork = "yes") ] match search.skill with - | Some skl -> "p.data->'skills'->>'description' ILIKE @description", [ "@description", like skl ] + | Some skl -> "p.data -> 'skills' ->> 'description' ILIKE @description", [ "@description", like skl ] | None -> () match search.bioExperience with | Some text -> - "(p.data->>'biography' ILIKE @text OR p.data->>'experience' ILIKE @text)", [ "@text", Sql.string text ] + "(p.data ->> 'biography' ILIKE @text OR p.data ->> 'experience' ILIKE @text)", + [ "@text", Sql.string text ] | None -> () ] let! results = connection () |> Sql.query $" SELECT p.*, c.data AS cit_data - FROM jjj.{Table.Profile} p - INNER JOIN jjj.{Table.Citizen} c ON c.id = p.id - WHERE p.data->>'isLegacy' = 'false' + 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 + { citizenId = profile.Id displayName = Citizen.name citizen - seekingEmployment = profile.seekingEmployment - remoteWork = profile.remoteWork - fullTime = profile.fullTime - lastUpdatedOn = profile.lastUpdatedOn + seekingEmployment = profile.IsSeekingEmployment + remoteWork = profile.IsRemote + fullTime = profile.IsFullTime + lastUpdatedOn = profile.LastUpdatedOn }) return results |> List.sortBy (fun psr -> psr.displayName.ToLowerInvariant ()) } @@ -364,36 +380,36 @@ module Profiles = let publicSearch (search : PublicSearch) = let searches = [ match search.continentId with - | Some contId -> "p.data->>'continentId' = @continentId", [ "@continentId", Sql.string contId ] + | Some contId -> "p.data ->> 'continentId' = @continentId", [ "@continentId", Sql.string contId ] | None -> () match search.region with - | Some region -> "p.data->>'region' ILIKE @region", [ "@region", like region ] + | Some region -> "p.data ->> 'region' ILIKE @region", [ "@region", like region ] | None -> () if search.remoteWork <> "" then - "p.data->>'remoteWork' = @remote", [ "@remote", jsonBool (search.remoteWork = "yes") ] + "p.data ->> 'remoteWork' = @remote", [ "@remote", jsonBool (search.remoteWork = "yes") ] match search.skill with | Some skl -> - "p.data->'skills'->>'description' ILIKE @description", [ "@description", like skl ] + "p.data -> 'skills' ->> 'description' ILIKE @description", [ "@description", like skl ] | None -> () ] connection () |> Sql.query $" SELECT p.*, c.data AS cont_data - FROM jjj.{Table.Profile} p - INNER JOIN jjj.{Table.Continent} c ON c.id = p.data->>'continentId' - WHERE p.data->>'isPublic' = 'true' - AND p.data->>'isLegacy' = 'false' + FROM {Table.Profile} p + INNER JOIN {Table.Continent} c ON c.id = p.data ->> 'continentId' + WHERE p.data ->> 'isPublic' = 'true' + AND p.data ->> 'isLegacy' = 'false' {searchSql searches}" |> Sql.executeAsync (fun row -> let profile = toDocument row let continent = toDocumentFrom "cont_data" row - { continent = continent.name - region = profile.region - remoteWork = profile.remoteWork - skills = profile.skills + { 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}") + let notes = match s.Notes with Some n -> $" ({n})" | None -> "" + $"{s.Description}{notes}") }) /// Success story data access functions @@ -405,18 +421,18 @@ module Successes = connection () |> Sql.query $" SELECT s.*, c.data AS cit_data - FROM jjj.{Table.Success} s - INNER JOIN jjj.{Table.Citizen} c ON c.id = s.data->>'citizenId' - ORDER BY s.data->>'recordedOn' DESC" + 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 + { id = success.Id + citizenId = success.CitizenId citizenName = Citizen.name citizen - recordedOn = success.recordedOn - fromHere = success.fromHere - hasStory = Option.isSome success.story + recordedOn = success.RecordedOn + fromHere = success.IsFromHere + hasStory = Option.isSome success.Story }) /// Find a success story by its ID @@ -425,5 +441,5 @@ module Successes = /// Save a success story let save (success : Success) = - connection () |> saveDocument Table.Success (SuccessId.toString success.id) success + connection () |> saveDocument Table.Success (SuccessId.toString success.Id) <| mkDoc success \ No newline at end of file diff --git a/src/JobsJobsJobs/JobsJobsJobs.Data/JobsJobsJobs.Data.fsproj b/src/JobsJobsJobs/JobsJobsJobs.Data/JobsJobsJobs.Data.fsproj index 4cfa081..153d84c 100644 --- a/src/JobsJobsJobs/JobsJobsJobs.Data/JobsJobsJobs.Data.fsproj +++ b/src/JobsJobsJobs/JobsJobsJobs.Data/JobsJobsJobs.Data.fsproj @@ -16,9 +16,8 @@ - - + diff --git a/src/JobsJobsJobs/JobsJobsJobs.Data/Json.fs b/src/JobsJobsJobs/JobsJobsJobs.Data/Json.fs index 5c96745..a7c58a9 100644 --- a/src/JobsJobsJobs/JobsJobsJobs.Data/Json.fs +++ b/src/JobsJobsJobs/JobsJobsJobs.Data/Json.fs @@ -12,6 +12,9 @@ type WrappedJsonConverter<'T> (wrap : string -> 'T, unwrap : 'T -> string) = override _.Write(writer, value, _) = writer.WriteStringValue (unwrap value) +open NodaTime +open NodaTime.Serialization.SystemTextJson + /// JsonSerializer options that use the custom converters let options = let opts = JsonSerializerOptions () @@ -24,4 +27,6 @@ let options = JsonFSharpConverter () ] |> List.iter opts.Converters.Add + let _ = opts.ConfigureForNodaTime DateTimeZoneProviders.Tzdb + opts.PropertyNamingPolicy <- JsonNamingPolicy.CamelCase opts diff --git a/src/JobsJobsJobs/JobsJobsJobs.V3Migration/Program.fs b/src/JobsJobsJobs/JobsJobsJobs.V3Migration/Program.fs index d96da5a..3c531f0 100644 --- a/src/JobsJobsJobs/JobsJobsJobs.V3Migration/Program.fs +++ b/src/JobsJobsJobs/JobsJobsJobs.V3Migration/Program.fs @@ -1,4 +1,5 @@  +open System.Text.Json open Microsoft.Extensions.Configuration /// Data access for v2 Jobs, Jobs, Jobs @@ -44,8 +45,8 @@ let r = RethinkDb.Driver.RethinkDB.R open JobsJobsJobs.Data open JobsJobsJobs.Domain open Newtonsoft.Json.Linq -open NodaTime open NodaTime.Text +open Npgsql.FSharp open RethinkDb.Driver.FSharp.Functions /// Retrieve an instant from a JObject field @@ -62,32 +63,155 @@ task { // Establish database connections let cfg = ConfigurationBuilder().AddJsonFile("appsettings.json").Build () use rethinkConn = Rethink.Startup.createConnection (cfg.GetConnectionString "RethinkDB") - match! DataConnection.setUp cfg with - | Ok _ -> () - | Error msg -> failwith msg + do! DataConnection.setUp cfg + let pgConn = DataConnection.connection () - // Migrate citizens - let! oldCitizens = - fromTable Rethink.Table.Citizen + let getOld table = + fromTable table |> runResult |> withRetryOnce |> withConn rethinkConn + + // Migrate citizens + let! oldCitizens = getOld Rethink.Table.Citizen let newCitizens = oldCitizens |> List.map (fun c -> let user = c["mastodonUser"].Value () { Citizen.empty with - id = CitizenId.ofString (c["id"].Value ()) - joinedOn = getInstant c "joinedOn" - lastSeenOn = getInstant c "lastSeenOn" - email = $"""{user}@{c["instance"].Value ()}""" - firstName = user - lastName = user - isLegacy = true + Id = CitizenId.ofString (c["id"].Value ()) + JoinedOn = getInstant c "joinedOn" + LastSeenOn = getInstant c "lastSeenOn" + Email = $"""{user}@{c["instance"].Value ()}""" + FirstName = user + LastName = user + IsLegacy = true }) for citizen in newCitizens do do! Citizens.save citizen - printfn $"** Migrated {List.length newCitizens} citizen(s)" - () + let! _ = + pgConn + |> Sql.executeTransactionAsync [ + $"INSERT INTO jjj.{Table.SecurityInfo} VALUES (@id, @data)", + newCitizens |> List.map (fun c -> + let info = { SecurityInfo.empty with Id = c.Id; AccountLocked = true } + [ "@id", Sql.string (CitizenId.toString c.Id) + "@data", Sql.jsonb (JsonSerializer.Serialize (info, Json.options)) + ]) + ] + printfn $"** Migrated {List.length newCitizens} citizens" + + // Migrate continents + let! oldContinents = getOld Rethink.Table.Continent + let newContinents = + oldContinents + |> List.map (fun c -> + { Continent.empty with + Id = ContinentId.ofString (c["id"].Value ()) + Name = c["name"].Value () + }) + let! _ = + pgConn + |> Sql.executeTransactionAsync [ + "INSERT INTO jjj.continent VALUES (@id, @data)", + newContinents |> List.map (fun c -> [ + "@id", Sql.string (ContinentId.toString c.Id) + "@data", Sql.jsonb (JsonSerializer.Serialize (c, Json.options)) + ]) + ] + printfn $"** Migrated {List.length newContinents} continents" + + // Migrate profiles + let! oldProfiles = getOld Rethink.Table.Profile + let newProfiles = + oldProfiles + |> List.map (fun p -> + let experience = p["experience"].Value () + { Profile.empty with + Id = CitizenId.ofString (p["id"].Value ()) + IsSeekingEmployment = p["seekingEmployment"].Value () + IsPubliclySearchable = p["isPublic"].Value () + ContinentId = ContinentId.ofString (p["continentId"].Value ()) + Region = p["region"].Value () + IsRemote = p["remoteWork"].Value () + IsFullTime = p["fullTime"].Value () + Biography = Text (p["biography"].Value ()) + LastUpdatedOn = getInstant p "lastUpdatedOn" + Experience = if isNull experience then None else Some (Text experience) + Skills = p["skills"].Children() + |> Seq.map (fun s -> + let notes = s["notes"].Value () + { Skill.Id = SkillId.ofString (s["id"].Value ()) + Description = s["description"].Value () + Notes = if isNull notes then None else Some notes + }) + |> List.ofSeq + IsLegacy = true + }) + for profile in newProfiles do + do! Profiles.save profile + printfn $"** Migrated {List.length newProfiles} profiles" + + // Migrate listings + let! oldListings = getOld Rethink.Table.Listing + let newListings = + oldListings + |> List.map (fun l -> + let neededBy = l["neededBy"].Value () + let wasFilledHere = l["wasFilledHere"].Value () + { Listing.empty with + Id = ListingId.ofString (l["id"].Value ()) + CitizenId = CitizenId.ofString (l["citizenId"].Value ()) + CreatedOn = getInstant l "createdOn" + Title = l["title"].Value () + ContinentId = ContinentId.ofString (l["continentId"].Value ()) + Region = l["region"].Value () + IsRemote = l["remoteWork"].Value () + IsExpired = l["isExpired"].Value () + UpdatedOn = getInstant l "updatedOn" + Text = Text (l["text"].Value ()) + NeededBy = if isNull neededBy then None else + match LocalDatePattern.Iso.Parse neededBy with + | it when it.Success -> Some it.Value + | it -> + eprintfn $"Error parsing date - {it.Exception.Message}" + None + WasFilledHere = if isNull wasFilledHere then None else Some (bool.Parse wasFilledHere) + IsLegacy = true + }) + for listing in newListings do + do! Listings.save listing + printfn $"** Migrated {List.length newListings} listings" + + // Migrate success stories + let! oldSuccesses = getOld Rethink.Table.Success + let newSuccesses = + oldSuccesses + |> List.map (fun s -> + let story = s["story"].Value () + { Success.empty with + Id = SuccessId.ofString (s["id"].Value ()) + CitizenId = CitizenId.ofString (s["citizenId"].Value ()) + RecordedOn = getInstant s "recordedOn" + Source = s["source"].Value () + Story = if isNull story then None else Some (Text story) + }) + for success in newSuccesses do + do! Successes.save success + printfn $"** Migrated {List.length newSuccesses} successes" + + // Delete any citizens who have no profile, no listing, and no success story recorded + let! deleted = + pgConn + |> Sql.query $" + DELETE FROM jjj.{Table.Citizen} + WHERE id NOT IN (SELECT id FROM jjj.{Table.Profile}) + AND id NOT IN (SELECT DISTINCT data->>'citizenId' FROM jjj.{Table.Listing}) + AND id NOT IN (SELECT DISTINCT data->>'citizenId' FROM jjj.{Table.Success})" + |> Sql.executeNonQueryAsync + printfn $"** Deleted {deleted} citizens who had no profile, listings, or success stories" + + printfn "" + printfn "Migration complete" } |> Async.AwaitTask |> Async.RunSynchronously diff --git a/src/JobsJobsJobs/Server/Auth.fs b/src/JobsJobsJobs/Server/Auth.fs index 8ea26e3..6d49875 100644 --- a/src/JobsJobsJobs/Server/Auth.fs +++ b/src/JobsJobsJobs/Server/Auth.fs @@ -91,7 +91,7 @@ let createJwt (citizen : Citizen) (cfg : AuthOptions) = tokenHandler.CreateToken ( SecurityTokenDescriptor ( Subject = ClaimsIdentity [| - Claim (ClaimTypes.NameIdentifier, CitizenId.toString citizen.id) + Claim (ClaimTypes.NameIdentifier, CitizenId.toString citizen.Id) Claim (ClaimTypes.Name, Citizen.name citizen) |], Expires = DateTime.UtcNow.AddHours 2., diff --git a/src/JobsJobsJobs/Server/Handlers.fs b/src/JobsJobsJobs/Server/Handlers.fs index ecd51ab..5918924 100644 --- a/src/JobsJobsJobs/Server/Handlers.fs +++ b/src/JobsJobsJobs/Server/Handlers.fs @@ -109,7 +109,7 @@ module Citizen = return! json { jwt = Auth.createJwt citizen (authConfig ctx) - citizenId = CitizenId.toString citizen.id + citizenId = CitizenId.toString citizen.Id name = Citizen.name citizen } next ctx | Error msg -> @@ -238,19 +238,19 @@ module Listing = let! form = ctx.BindJsonAsync () let now = now ctx do! Listings.save { - id = ListingId.create () - citizenId = currentCitizenId ctx - createdOn = now - title = form.title - continentId = ContinentId.ofString form.continentId - region = form.region - remoteWork = form.remoteWork - isExpired = false - updatedOn = now - text = Text form.text - neededBy = (form.neededBy |> Option.map parseDate) - wasFilledHere = None - isLegacy = false + Id = ListingId.create () + CitizenId = currentCitizenId ctx + CreatedOn = now + Title = form.title + ContinentId = ContinentId.ofString form.continentId + Region = form.region + IsRemote = form.remoteWork + IsExpired = false + UpdatedOn = now + Text = Text form.text + NeededBy = (form.neededBy |> Option.map parseDate) + WasFilledHere = None + IsLegacy = false } return! ok next ctx } @@ -258,18 +258,18 @@ module Listing = // PUT: /api/listing/[id] let update listingId : HttpHandler = authorize >=> fun next ctx -> task { match! Listings.findById (ListingId listingId) with - | Some listing when listing.citizenId <> (currentCitizenId ctx) -> return! Error.notAuthorized next ctx + | Some listing when listing.CitizenId <> (currentCitizenId ctx) -> return! Error.notAuthorized next ctx | Some listing -> let! form = ctx.BindJsonAsync () do! Listings.save { listing with - title = form.title - continentId = ContinentId.ofString form.continentId - region = form.region - remoteWork = form.remoteWork - text = Text form.text - neededBy = form.neededBy |> Option.map parseDate - updatedOn = now ctx + Title = form.title + ContinentId = ContinentId.ofString form.continentId + Region = form.region + IsRemote = form.remoteWork + Text = Text form.text + NeededBy = form.neededBy |> Option.map parseDate + UpdatedOn = now ctx } return! ok next ctx | None -> return! Error.notFound next ctx @@ -279,24 +279,24 @@ module Listing = let expire listingId : HttpHandler = authorize >=> fun next ctx -> task { let now = now ctx match! Listings.findById (ListingId listingId) with - | Some listing when listing.citizenId <> (currentCitizenId ctx) -> return! Error.notAuthorized next ctx + | Some listing when listing.CitizenId <> (currentCitizenId ctx) -> return! Error.notAuthorized next ctx | Some listing -> let! form = ctx.BindJsonAsync () do! Listings.save { listing with - isExpired = true - wasFilledHere = Some form.fromHere - updatedOn = now + IsExpired = true + WasFilledHere = Some form.fromHere + UpdatedOn = now } match form.successStory with | Some storyText -> do! Successes.save - { id = SuccessId.create() - citizenId = currentCitizenId ctx - recordedOn = now - fromHere = form.fromHere - source = "listing" - story = (Text >> Some) storyText + { Id = SuccessId.create() + CitizenId = currentCitizenId ctx + RecordedOn = now + IsFromHere = form.fromHere + Source = "listing" + Story = (Text >> Some) storyText } | None -> () return! ok next ctx @@ -351,26 +351,26 @@ module Profile = let! profile = task { match! Profiles.findById citizenId with | Some p -> return p - | None -> return { Profile.empty with id = citizenId } + | None -> return { Profile.empty with Id = citizenId } } do! Profiles.save { profile with - seekingEmployment = form.isSeekingEmployment - isPublic = form.isPublic - continentId = ContinentId.ofString form.continentId - region = form.region - remoteWork = form.remoteWork - fullTime = form.fullTime - biography = Text form.biography - lastUpdatedOn = now ctx - experience = noneIfBlank form.experience |> Option.map Text - skills = form.skills - |> List.map (fun s -> - { id = if s.id.StartsWith "new" then SkillId.create () - else SkillId.ofString s.id - description = s.description - notes = noneIfBlank s.notes - }) + IsSeekingEmployment = form.isSeekingEmployment + IsPubliclySearchable = form.isPublic + ContinentId = ContinentId.ofString form.continentId + Region = form.region + IsRemote = form.remoteWork + IsFullTime = form.fullTime + Biography = Text form.biography + LastUpdatedOn = now ctx + Experience = noneIfBlank form.experience |> Option.map Text + Skills = form.skills + |> List.map (fun s -> + { Id = if s.id.StartsWith "new" then SkillId.create () + else SkillId.ofString s.id + Description = s.description + Notes = noneIfBlank s.notes + }) } return! ok next ctx } @@ -379,7 +379,7 @@ module Profile = let employmentFound : HttpHandler = authorize >=> fun next ctx -> task { match! Profiles.findById (currentCitizenId ctx) with | Some profile -> - do! Profiles.save { profile with seekingEmployment = false } + do! Profiles.save { profile with IsSeekingEmployment = false } return! ok next ctx | None -> return! Error.notFound next ctx } @@ -429,19 +429,19 @@ module Success = let! success = task { match form.id with | "new" -> - return Some { id = SuccessId.create () - citizenId = citizenId - recordedOn = now ctx - fromHere = form.fromHere - source = "profile" - story = noneIfEmpty form.story |> Option.map Text + return Some { Id = SuccessId.create () + CitizenId = citizenId + RecordedOn = now ctx + IsFromHere = form.fromHere + Source = "profile" + Story = noneIfEmpty form.story |> Option.map Text } | successId -> match! Successes.findById (SuccessId.ofString successId) with - | Some story when story.citizenId = citizenId -> + | Some story when story.CitizenId = citizenId -> return Some { story with - fromHere = form.fromHere - story = noneIfEmpty form.story |> Option.map Text + IsFromHere = form.fromHere + Story = noneIfEmpty form.story |> Option.map Text } | Some _ | None -> return None } -- 2.45.1 From 97b23cf7d9ba2614ef74869b4e7916b00ee83fe6 Mon Sep 17 00:00:00 2001 From: "Daniel J. Summers" Date: Sun, 28 Aug 2022 16:32:35 -0400 Subject: [PATCH 11/67] WIP on registration page --- src/JobsJobsJobs/App/src/App.vue | 25 ++++-- src/JobsJobsJobs/App/src/api/types.ts | 16 ++++ .../App/src/views/citizen/LogOn.vue | 1 + .../App/src/views/citizen/Register.vue | 84 +++++++++++++++++++ 4 files changed, 117 insertions(+), 9 deletions(-) create mode 100644 src/JobsJobsJobs/App/src/views/citizen/Register.vue diff --git a/src/JobsJobsJobs/App/src/App.vue b/src/JobsJobsJobs/App/src/App.vue index 7b63736..402481f 100644 --- a/src/JobsJobsJobs/App/src/App.vue +++ b/src/JobsJobsJobs/App/src/App.vue @@ -1,12 +1,19 @@ -