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}"