Version 3 #40

Merged
danieljsummers merged 67 commits from version-2-3 into main 2023-02-02 23:47:28 +00:00
11 changed files with 461 additions and 393 deletions
Showing only changes of commit 1a91f10da2 - Show all commits

View File

@ -0,0 +1,12 @@
<Project Sdk="Microsoft.NET.Sdk">
<PropertyGroup>
<OutputType>Exe</OutputType>
<TargetFramework>net6.0</TargetFramework>
</PropertyGroup>
<ItemGroup>
<Compile Include="Program.fs"/>
</ItemGroup>
</Project>

View File

@ -0,0 +1,4 @@

// For more information see https://aka.ms/fsharp-console-apps
printfn "Hello from F#"

View File

@ -19,6 +19,8 @@ Project("{F2A71F9B-5D33-465A-A702-920D77279786}") = "Api", "JobsJobsJobs\Server\
EndProject EndProject
Project("{F2A71F9B-5D33-465A-A702-920D77279786}") = "JobsJobsJobs.Data", "JobsJobsJobs\JobsJobsJobs.Data\JobsJobsJobs.Data.fsproj", "{30CC1E7C-A843-4DAC-9058-E7C6ACBCE85D}" Project("{F2A71F9B-5D33-465A-A702-920D77279786}") = "JobsJobsJobs.Data", "JobsJobsJobs\JobsJobsJobs.Data\JobsJobsJobs.Data.fsproj", "{30CC1E7C-A843-4DAC-9058-E7C6ACBCE85D}"
EndProject EndProject
Project("{F2A71F9B-5D33-465A-A702-920D77279786}") = "JobsJobsJobs.V3Migration", "JobsJobsJobs\JobsJobsJobs.V3Migration\JobsJobsJobs.V3Migration.fsproj", "{DC3E225D-9720-44E8-86AE-DEE71262C9F0}"
EndProject
Global Global
GlobalSection(SolutionConfigurationPlatforms) = preSolution GlobalSection(SolutionConfigurationPlatforms) = preSolution
Debug|Any CPU = Debug|Any CPU 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}.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.ActiveCfg = Release|Any CPU
{30CC1E7C-A843-4DAC-9058-E7C6ACBCE85D}.Release|Any CPU.Build.0 = 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 EndGlobalSection
GlobalSection(SolutionProperties) = preSolution GlobalSection(SolutionProperties) = preSolution
HideSolutionNode = FALSE HideSolutionNode = FALSE
@ -48,5 +54,6 @@ Global
{C81278DA-DA97-4E55-AB39-4B88565B615D} = {FA833B24-B8F6-4CE6-A044-99257EAC02FF} {C81278DA-DA97-4E55-AB39-4B88565B615D} = {FA833B24-B8F6-4CE6-A044-99257EAC02FF}
{8F5A3D1E-562B-4F27-9787-6CB14B35E69E} = {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} {30CC1E7C-A843-4DAC-9058-E7C6ACBCE85D} = {FA833B24-B8F6-4CE6-A044-99257EAC02FF}
{DC3E225D-9720-44E8-86AE-DEE71262C9F0} = {FA833B24-B8F6-4CE6-A044-99257EAC02FF}
EndGlobalSection EndGlobalSection
EndGlobal EndGlobal

View File

@ -38,9 +38,6 @@ type Citizen =
/// Whether this is a legacy citizen /// Whether this is a legacy citizen
isLegacy : bool isLegacy : bool
} }
with
/// Unwrapped ID for database PK use
member this.DbId = CitizenId.value this.id
/// Support functions for citizens /// Support functions for citizens
module Citizen = module Citizen =
@ -72,9 +69,6 @@ type Continent =
/// The name of the continent /// The name of the continent
name : string name : string
} }
with
/// Unwrapped ID for database PK use
member this.DbId = ContinentId.value this.id
/// Support functions for continents /// Support functions for continents
module Continent = module Continent =
@ -170,9 +164,6 @@ type SecurityInfo =
/// When the token expires /// When the token expires
TokenExpires : Instant option TokenExpires : Instant option
} }
with
/// Unwrapped ID for database PK use
member this.DbId = CitizenId.value this.Id
/// Functions to support security info /// Functions to support security info
module SecurityInfo = module SecurityInfo =

View File

@ -1,137 +1,124 @@
namespace JobsJobsJobs.Data namespace JobsJobsJobs.Data
open System /// Constants for tables used by Jobs, Jobs, Jobs
open JobsJobsJobs.Domain module Table =
/// Wrapper documents for our record types /// Citizens
module Documents = [<Literal>]
let Citizen = "citizen"
/// A generic type that keeps its ID in sync with the ID value for its content /// Continents
[<AllowNullLiteral>] [<Literal>]
type Document<'T> (initialValue : 'T, toId : 'T -> Guid) = let Continent = "continent"
/// The current value for this document /// Job Listings
let mutable value = initialValue [<Literal>]
let Listing = "listing"
/// The ID for this document /// Employment Profiles
member val Id = toId initialValue with get, set [<Literal>]
let Profile = "profile"
/// The value for this document /// User Security Information
member this.Value [<Literal>]
with get () = value let SecurityInfo = "security_info"
and set (v : 'T) =
value <- v
this.Id <- toId v
/// Convert a document to its value /// Success Stories
static member ToValue (doc : Document<'T>) = [<Literal>]
doc.Value let Success = "success"
/// 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
[<AllowNullLiteral>]
type CitizenDocument (citizen : Citizen) =
inherit Document<Citizen> (citizen, fun c -> CitizenId.value c.id)
new() = CitizenDocument Citizen.empty
/// A continent document
[<AllowNullLiteral>]
type ContinentDocument (continent : Continent) =
inherit Document<Continent> (continent, fun c -> ContinentId.value c.id)
new () = ContinentDocument Continent.empty
/// A job listing document
[<AllowNullLiteral>]
type ListingDocument (listing : Listing) =
inherit Document<Listing> (listing, fun l -> ListingId.value l.id)
new () = ListingDocument Listing.empty
/// A profile document
[<AllowNullLiteral>]
type ProfileDocument (profile : Profile) =
inherit Document<Profile> (profile, fun p -> CitizenId.value p.id)
new () = ProfileDocument Profile.empty
/// A security information document
[<AllowNullLiteral>]
type SecurityInfoDocument (securityInfo : SecurityInfo) =
inherit Document<SecurityInfo> (securityInfo, fun si -> CitizenId.value si.Id)
new () = SecurityInfoDocument SecurityInfo.empty
/// A success story document
[<AllowNullLiteral>]
type SuccessDocument (success : Success) =
inherit Document<Success> (success, fun s -> SuccessId.value s.id)
new () = SuccessDocument Success.empty
open Documents open Npgsql.FSharp
open Marten
/// Connection management for the Marten document store /// Connection management for the Marten document store
module Connection = module DataConnection =
open Marten.NodaTime
open Microsoft.Extensions.Configuration open Microsoft.Extensions.Configuration
open Weasel.Core
/// The configuration from which a document store will be created /// The configuration from which a document store will be created
let mutable private config : IConfiguration option = None let mutable private config : IConfiguration option = None
/// Lazy initialization for the Marten document store, constructed when setUp() is called /// Get the connection string
let private lazyStore = lazy (task { let connection () =
match config with match config with
| Some cfg -> | Some cfg -> Sql.connect (cfg.GetConnectionString "PostgreSQL")
let store = | None -> invalidOp "Connection.setUp() must be called before accessing the database"
DocumentStore.For(fun opts ->
opts.Connection (cfg.GetConnectionString "PostgreSQL")
opts.RegisterDocumentTypes [
typeof<CitizenDocument>; typeof<ContinentDocument>; typeof<ListingDocument>
typeof<ProfileDocument>; typeof<SecurityInfoDocument>; typeof<SuccessDocument>
]
opts.DatabaseSchemaName <- "jjj"
opts.AutoCreateSchemaObjects <- AutoCreate.CreateOrUpdate
opts.UseNodaTime ()
let _ = opts.Schema.For<CitizenDocument>().DocumentAlias "citizen" /// Create tables
let _ = opts.Schema.For<ContinentDocument>().DocumentAlias "continent" let private createTables () = backgroundTask {
let _ = opts.Schema.For<ListingDocument>().DocumentAlias "listing" let sql =
let _ = opts.Schema.For<ProfileDocument>().DocumentAlias "profile" [ Table.Citizen; Table.Continent; Table.Listing; Table.Profile; Table.SecurityInfo; Table.Success ]
let _ = opts.Schema.For<SecurityInfoDocument>().DocumentAlias "security_info" |> List.map (fun table ->
let _ = opts.Schema.For<SuccessDocument>().DocumentAlias "success" $"CREATE TABLE IF NOT EXISTS jjj.{table} (id TEXT NOT NULL PRIMARY KEY, data JSONB NOT NULL)")
()) |> String.concat "; "
do! store.Storage.ApplyAllConfiguredChangesToDatabaseAsync () let! _ =
return Ok store connection ()
| None -> return Error "Connection.setUp() must be called before accessing a document session" |> Sql.executeTransactionAsync [ sql, [ [] ] ]
}) // TODO: prudent indexes
()
}
/// Set up the data connection from the given configuration /// Set up the data connection from the given configuration
let setUp (cfg : IConfiguration) = let setUp (cfg : IConfiguration) = backgroundTask {
config <- Some cfg config <- Some cfg
lazyStore.Force () do! createTables ()
}
/// 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)
/// Shorthand for the generic dictionary open DataConnection
type Dict<'TKey, 'TValue> = System.Collections.Generic.Dictionary<'TKey, 'TValue>
/// Helper functions for data manipulation
[<AutoOpen>]
module private Helpers =
open System.Text.Json
open System.Threading.Tasks
/// Map the data field to the requested document type
let toDocumentFrom<'T> fieldName (row : RowReader) =
JsonSerializer.Deserialize<'T> (row.string fieldName, Json.options)
/// Map the data field to the requested document type
let toDocument<'T> (row : RowReader) = toDocumentFrom<'T> "data" row
/// Get a document
let getDocument<'T> table docId sqlProps : Task<'T option> = backgroundTask {
let! doc =
Sql.query $"SELECT * FROM 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}"
open System.Linq open JobsJobsJobs.Domain
open Connection
/// Citizen data access functions /// Citizen data access functions
[<RequireQualifiedAccess>] [<RequireQualifiedAccess>]
@ -139,67 +126,61 @@ module Citizens =
/// Delete a citizen by their ID /// Delete a citizen by their ID
let deleteById citizenId = backgroundTask { let deleteById citizenId = backgroundTask {
use session = docSession () let! _ =
session.DeleteWhere<SuccessDocument>(fun s -> s.Value.citizenId = citizenId) connection ()
session.DeleteWhere<ListingDocument>(fun l -> l.Value.citizenId = citizenId) |> Sql.executeTransactionAsync [
let docId = CitizenId.value citizenId "DELETE FROM jjj.success WHERE data->>'citizenId' = @id;
session.Delete<ProfileDocument> docId DELETE FROM jjj.listing WHERE data->>'citizenId' = @id;
session.Delete<SecurityInfoDocument> docId DELETE FROM jjj.profile WHERE id = @id;
session.Delete<CitizenDocument> docId DELETE FROM jjj.security_info WHERE id = @id;
do! session.SaveChangesAsync () DELETE FROM jjj.citizen WHERE id = @id",
[ [ "@id", Sql.string (CitizenId.toString citizenId) ] ]
]
()
} }
/// Find a citizen by their ID /// Find a citizen by their ID
let findById citizenId = backgroundTask { let findById citizenId = backgroundTask {
use session = querySession () match! connection () |> getDocument<Citizen> Table.Citizen (CitizenId.toString citizenId) with
let! citizen = session.LoadAsync<CitizenDocument> (CitizenId.value citizenId) | Some c when not c.isLegacy -> return Some c
return
match Document.TryValue citizen with
| Some c when not c.isLegacy -> Some c
| Some _ | Some _
| None -> None | None -> return None
} }
/// Save a citizen /// Save a citizen
let save (citizen : Citizen) = backgroundTask { let save (citizen : Citizen) =
use session = docSession () connection () |> saveDocument Table.Citizen (CitizenId.toString citizen.id) citizen
session.Store (CitizenDocument citizen)
do! session.SaveChangesAsync ()
}
/// Attempt a user log on /// Attempt a user log on
let tryLogOn email (pwCheck : string -> bool) now = backgroundTask { let tryLogOn email (pwCheck : string -> bool) now = backgroundTask {
use session = docSession () let connProps = connection ()
let! tryCitizen = let! tryCitizen =
session.Query<CitizenDocument>() connProps
.Where(fun c -> c.Value.email = email && not c.Value.isLegacy) |> Sql.query $"SELECT * FROM jjj.{Table.Citizen} WHERE data->>email = @email AND data->>isValue <> 'true'"
.SingleOrDefaultAsync () |> Sql.parameters [ "@email", Sql.string email ]
match Document.TryValue tryCitizen with |> Sql.executeAsync toDocument<Citizen>
match List.tryHead tryCitizen with
| Some citizen -> | Some citizen ->
let! tryInfo = session.LoadAsync<SecurityInfoDocument> (CitizenId.value citizen.id) let citizenId = CitizenId.toString citizen.id
let! tryInfo = getDocument<SecurityInfo> Table.SecurityInfo citizenId connProps
let! info = backgroundTask { let! info = backgroundTask {
match Document.TryValue tryInfo with match tryInfo with
| Some it -> return it | Some it -> return it
| None -> | None ->
let it = { SecurityInfo.empty with Id = citizen.id } let it = { SecurityInfo.empty with Id = citizen.id }
session.Store (SecurityInfoDocument it) do! saveDocument Table.SecurityInfo citizenId it connProps
do! session.SaveChangesAsync ()
return it return it
} }
if info.AccountLocked then return Error "Log on unsuccessful (Account Locked)" if info.AccountLocked then return Error "Log on unsuccessful (Account Locked)"
elif pwCheck citizen.passwordHash then elif pwCheck citizen.passwordHash then
session.Store (SecurityInfoDocument { info with FailedLogOnAttempts = 0}) do! saveDocument Table.SecurityInfo citizenId { info with FailedLogOnAttempts = 0 } connProps
session.Store (CitizenDocument { citizen with lastSeenOn = now}) do! saveDocument Table.Citizen citizenId { citizen with lastSeenOn = now } connProps
do! session.SaveChangesAsync ()
return Ok { citizen with lastSeenOn = now } return Ok { citizen with lastSeenOn = now }
else else
let locked = info.FailedLogOnAttempts >= 4 let locked = info.FailedLogOnAttempts >= 4
session.Store (SecurityInfoDocument { do! saveDocument Table.SecurityInfo citizenId
info with { info with FailedLogOnAttempts = info.FailedLogOnAttempts + 1; AccountLocked = locked }
FailedLogOnAttempts = info.FailedLogOnAttempts + 1 connProps
AccountLocked = locked
})
do! session.SaveChangesAsync ()
return Error $"""Log on unsuccessful{if locked then " - Account is now locked" else ""}""" return Error $"""Log on unsuccessful{if locked then " - Account is now locked" else ""}"""
| None -> return Error "Log on unsuccessful" | None -> return Error "Log on unsuccessful"
} }
@ -210,18 +191,14 @@ module Citizens =
module Continents = module Continents =
/// Retrieve all continents /// Retrieve all continents
let all () = backgroundTask { let all () =
use session = querySession () connection ()
let! it = session.Query<ContinentDocument>().AsQueryable().ToListAsync () |> Sql.query $"SELECT * FROM jjj.{Table.Continent}"
return it |> Seq.map Document.ToValue |> List.ofSeq |> Sql.executeAsync toDocument<Continent>
}
/// Retrieve a continent by its ID /// Retrieve a continent by its ID
let findById continentId = backgroundTask { let findById continentId =
use session = querySession () connection () |> getDocument<Continent> Table.Continent (ContinentId.toString continentId)
let! tryContinent = session.LoadAsync<ContinentDocument> (ContinentId.value continentId)
return Document.TryValue tryContinent
}
open JobsJobsJobs.Domain.SharedTypes open JobsJobsJobs.Domain.SharedTypes
@ -230,29 +207,26 @@ open JobsJobsJobs.Domain.SharedTypes
[<RequireQualifiedAccess>] [<RequireQualifiedAccess>]
module Listings = 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<Listing> row; continent = toDocumentFrom<Continent> "cont_data" row }
/// Find all job listings posted by the given citizen /// Find all job listings posted by the given citizen
let findByCitizen citizenId = backgroundTask { let findByCitizen citizenId =
use session = querySession () connection ()
let continents = Dict<Guid, ContinentDocument> () |> Sql.query $"{viewSql} WHERE l.data->>'citizenId' = @citizenId AND l.data->>'isLegacy' <> 'true'"
let! listings = |> Sql.parameters [ "@citizenId", Sql.string (CitizenId.toString citizenId) ]
session.Query<ListingDocument>() |> Sql.executeAsync toListingForView
.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
}
/// Find a listing by its ID /// Find a listing by its ID
let findById listingId = backgroundTask { let findById listingId = backgroundTask {
use session = querySession () match! connection () |> getDocument<Listing> Table.Listing (ListingId.toString listingId) with
let! tryListing = session.LoadAsync<ListingDocument> (ListingId.value listingId)
match Document.TryValue tryListing with
| Some listing when not listing.isLegacy -> return Some listing | Some listing when not listing.isLegacy -> return Some listing
| Some _ | Some _
| None -> return None | None -> return None
@ -260,60 +234,40 @@ module Listings =
/// Find a listing by its ID for viewing (includes continent information) /// Find a listing by its ID for viewing (includes continent information)
let findByIdForView listingId = backgroundTask { let findByIdForView listingId = backgroundTask {
use session = querySession ()
let mutable continent : ContinentDocument = null
let! tryListing = let! tryListing =
session.Query<ListingDocument>() connection ()
.Include((fun l -> l.Value.continentId :> obj), fun c -> continent <- c) |> Sql.query $"{viewSql} WHERE id = @id AND l.data->>'isLegacy' <> 'true'"
.Where(fun l -> l.Id = ListingId.value listingId && not l.Value.isLegacy) |> Sql.parameters [ "@id", Sql.string (ListingId.toString listingId) ]
.SingleOrDefaultAsync () |> Sql.executeAsync toListingForView
match Document.TryValue tryListing with return List.tryHead tryListing
| Some listing when not (isNull continent) -> return Some { listing = listing; continent = continent.Value }
| Some _
| None -> return None
} }
/// Save a listing /// Save a listing
let save (listing : Listing) = backgroundTask { let save (listing : Listing) =
use session = docSession () connection () |> saveDocument Table.Listing (ListingId.toString listing.id) listing
session.Store (ListingDocument listing)
do! session.SaveChangesAsync ()
}
/// Search job listings /// Search job listings
let search (search : ListingSearch) = backgroundTask { let search (search : ListingSearch) =
use session = querySession () let searches = [
let continents = Dict<Guid, ContinentDocument> ()
let searchQuery =
seq<ListingDocument -> bool> {
match search.continentId with match search.continentId with
| Some contId -> | Some contId -> "l.data->>'continentId' = @continentId", [ "@continentId", Sql.string contId ]
fun (l : ListingDocument) -> l.Value.continentId = (ContinentId.ofString contId)
| None -> () | None -> ()
match search.region with match search.region with
| Some region -> | Some region -> "l.data->>'region' ILIKE @region", [ "@region", like region ]
fun (l : ListingDocument) -> l.Value.region.Contains (region, StringComparison.OrdinalIgnoreCase)
| None -> () | None -> ()
if search.remoteWork <> "" then if search.remoteWork <> "" then
fun (l : ListingDocument) -> l.Value.remoteWork = (search.remoteWork = "yes") "l.data->>'remoteWork' = @remote", [ "@remote", jsonBool (search.remoteWork = "yes") ]
// match search.text with match search.text with
// | Some text -> fun (l : Listing) -> l.text.Contains (text, StringComparison.OrdinalIgnoreCase) | Some text -> "l.data->>'text' ILIKE @text", [ "@text", like text ]
// | None -> () | None -> ()
} ]
|> Seq.fold connection ()
(fun q filter -> Queryable.Where(q, filter)) |> Sql.query $"
(session.Query<ListingDocument>() {viewSql}
.Include((fun l -> l.Value.continentId :> obj), continents) WHERE l.data->>'isExpired' = 'false' AND l.data->>'isLegacy' = 'false'
.Where(fun l -> not l.Value.isExpired && not l.Value.isLegacy)) {searchSql searches}"
let! results = searchQuery.ToListAsync () |> Sql.parameters (searches |> List.collect snd)
return |> Sql.executeAsync toListingForView
results
|> Seq.map (fun l -> {
listing = l.Value
continent = continents[ContinentId.value l.Value.continentId].Value
})
|> List.ofSeq
}
/// Profile data access functions /// Profile data access functions
@ -322,174 +276,154 @@ module Profiles =
/// Count the current profiles /// Count the current profiles
let count () = let count () =
use session = querySession () connection ()
session.Query<ProfileDocument>().Where(fun p -> not p.Value.isLegacy).LongCountAsync () |> 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 /// Delete a profile by its ID
let deleteById citizenId = backgroundTask { let deleteById citizenId = backgroundTask {
use session = docSession () let! _ =
session.Delete<ProfileDocument> (CitizenId.value citizenId) connection ()
do! session.SaveChangesAsync () |> Sql.query $"DELETE FROM jjj.{Table.Profile} WHERE id = @id"
} |> Sql.parameters [ "@id", Sql.string (CitizenId.toString citizenId) ]
/// Find a profile by citizen ID |> Sql.executeNonQueryAsync
let findById citizenId = backgroundTask { ()
use session = querySession ()
let! profile = session.LoadAsync<ProfileDocument> (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) /// Find a profile by citizen ID
let findByIdForView citizenId = backgroundTask { let findById citizenId = backgroundTask {
use session = querySession () match! connection () |> getDocument<Profile> Table.Profile (CitizenId.toString citizenId) with
let mutable citizen : CitizenDocument = null | Some profile when not profile.isLegacy -> return Some profile
let mutable continent : ContinentDocument = null
let! tryProfile =
session.Query<ProfileDocument>()
.Include<CitizenDocument>((fun p -> p.Id :> obj), fun c -> citizen <- c)
.Include<ContinentDocument>((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 _ | Some _
| None -> return None | None -> return None
} }
/// Save a profile /// Find a profile by citizen ID for viewing (includes citizen and continent information)
let save (profile : Profile) = backgroundTask { let findByIdForView citizenId = backgroundTask {
use session = docSession () let! tryCitizen =
session.Store (ProfileDocument profile) connection ()
do! session.SaveChangesAsync () |> 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<Profile> row
citizen = toDocumentFrom<Citizen> "cit_data" row
continent = toDocumentFrom<Continent> "cont_data" row
})
return List.tryHead tryCitizen
} }
/// Save a profile
let save (profile : Profile) =
connection () |> saveDocument Table.Profile (CitizenId.toString profile.id) profile
/// Search profiles (logged-on users) /// Search profiles (logged-on users)
let search (search : ProfileSearch) = backgroundTask { let search (search : ProfileSearch) = backgroundTask {
use session = querySession () let searches = [
let citizens = Dict<Guid, CitizenDocument> ()
let searchQuery =
seq<ProfileDocument -> bool> {
match search.continentId with match search.continentId with
| Some contId -> fun (p : ProfileDocument) -> p.Value.continentId = ContinentId.ofString contId | Some contId -> "p.data ->>'continentId' = @continentId", [ "@continentId", Sql.string contId ]
| None -> () | None -> ()
if search.remoteWork <> "" then if search.remoteWork <> "" then
fun (p : ProfileDocument) -> p.Value.remoteWork = (search.remoteWork = "yes") "p.data->>'remoteWork' = @remote", [ "@remote", jsonBool (search.remoteWork = "yes") ]
match search.skill with match search.skill with
| Some skl -> | Some skl -> "p.data->'skills'->>'description' ILIKE @description", [ "@description", like skl ]
fun (p : ProfileDocument) ->
p.Value.skills.Any(fun s -> s.description.Contains (skl, StringComparison.OrdinalIgnoreCase))
| None -> () | None -> ()
// match search.bioExperience with match search.bioExperience with
// | Some text -> | Some text ->
// let txt = regexContains text "(p.data->>'biography' ILIKE @text OR p.data->>'experience' ILIKE @text)", [ "@text", Sql.string text ]
// yield filterFunc (fun it -> it.G("biography").Match(txt).Or (it.G("experience").Match txt)) | None -> ()
// | None -> () ]
} let! results =
|> Seq.fold connection ()
(fun q filter -> Queryable.Where(q, filter)) |> Sql.query $"
(session.Query<ProfileDocument>() SELECT p.*, c.data AS cit_data
.Include((fun p -> p.Id :> obj), citizens) FROM jjj.{Table.Profile} p
.Where(fun p -> not p.Value.isLegacy)) INNER JOIN jjj.{Table.Citizen} c ON c.id = p.id
let! results = searchQuery.ToListAsync () WHERE p.data->>'isLegacy' = 'false'
return {searchSql searches}"
results |> Sql.parameters (searches |> List.collect snd)
|> Seq.map (fun profileDoc -> |> Sql.executeAsync (fun row ->
let p = profileDoc.Value let profile = toDocument<Profile> row
{ citizenId = p.id let citizen = toDocumentFrom<Citizen> "cit_data" row
displayName = Citizen.name citizens[CitizenId.value p.id].Value { citizenId = profile.id
seekingEmployment = p.seekingEmployment displayName = Citizen.name citizen
remoteWork = p.remoteWork seekingEmployment = profile.seekingEmployment
fullTime = p.fullTime remoteWork = profile.remoteWork
lastUpdatedOn = p.lastUpdatedOn fullTime = profile.fullTime
lastUpdatedOn = profile.lastUpdatedOn
}) })
|> Seq.sortBy (fun psr -> psr.displayName.ToLowerInvariant ()) return results |> List.sortBy (fun psr -> psr.displayName.ToLowerInvariant ())
|> List.ofSeq
} }
// Search profiles (public) // Search profiles (public)
let publicSearch (search : PublicSearch) = backgroundTask { let publicSearch (search : PublicSearch) =
use session = querySession () let searches = [
let continents = Dict<Guid, ContinentDocument> ()
let searchQuery =
seq<ProfileDocument -> bool> {
match search.continentId with match search.continentId with
| Some contId -> fun (p : ProfileDocument) -> p.Value.continentId = ContinentId.ofString contId | Some contId -> "p.data->>'continentId' = @continentId", [ "@continentId", Sql.string contId ]
| None -> () | None -> ()
match search.region with match search.region with
| Some region -> | Some region -> "p.data->>'region' ILIKE @region", [ "@region", like region ]
fun (p : ProfileDocument) -> p.Value.region.Contains (region, StringComparison.OrdinalIgnoreCase)
| None -> () | None -> ()
if search.remoteWork <> "" then if search.remoteWork <> "" then
fun (p : ProfileDocument) -> p.Value.remoteWork = (search.remoteWork = "yes") "p.data->>'remoteWork' = @remote", [ "@remote", jsonBool (search.remoteWork = "yes") ]
match search.skill with match search.skill with
| Some skl -> | Some skl ->
fun (p : ProfileDocument) -> "p.data->'skills'->>'description' ILIKE @description", [ "@description", like skl ]
p.Value.skills.Any(fun s -> s.description.Contains (skl, StringComparison.OrdinalIgnoreCase))
| None -> () | None -> ()
} ]
|> Seq.fold connection ()
(fun q filter -> Queryable.Where(q, filter)) |> Sql.query $"
(session.Query<ProfileDocument>() SELECT p.*, c.data AS cont_data
.Include((fun p -> p.Value.continentId :> obj), continents) FROM jjj.{Table.Profile} p
.Where(fun p -> p.Value.isPublic && not p.Value.isLegacy)) INNER JOIN jjj.{Table.Continent} c ON c.id = p.data->>'continentId'
let! results = searchQuery.ToListAsync () WHERE p.data->>'isPublic' = 'true'
return AND p.data->>'isLegacy' = 'false'
results {searchSql searches}"
|> Seq.map (fun profileDoc -> |> Sql.executeAsync (fun row ->
let p = profileDoc.Value let profile = toDocument<Profile> row
{ continent = continents[ContinentId.value p.continentId].Value.name let continent = toDocumentFrom<Continent> "cont_data" row
region = p.region { continent = continent.name
remoteWork = p.remoteWork region = profile.region
skills = p.skills remoteWork = profile.remoteWork
skills = profile.skills
|> List.map (fun s -> |> List.map (fun s ->
let notes = match s.notes with Some n -> $" ({n})" | None -> "" let notes = match s.notes with Some n -> $" ({n})" | None -> ""
$"{s.description}{notes}") $"{s.description}{notes}")
}) })
|> List.ofSeq
}
/// Success story data access functions /// Success story data access functions
[<RequireQualifiedAccess>] [<RequireQualifiedAccess>]
module Successes = module Successes =
// Retrieve all success stories // Retrieve all success stories
let all () = backgroundTask { let all () =
use session = querySession () connection ()
let citizens = Dict<Guid, CitizenDocument> () |> Sql.query $"
let! stories = SELECT s.*, c.data AS cit_data
session.Query<SuccessDocument>() FROM jjj.{Table.Success} s
.Include((fun s -> s.Value.citizenId :> obj), citizens) INNER JOIN jjj.{Table.Citizen} c ON c.id = s.data->>'citizenId'
.OrderByDescending(fun s -> s.Value.recordedOn) ORDER BY s.data->>'recordedOn' DESC"
.ToListAsync () |> Sql.executeAsync (fun row ->
return let success = toDocument<Success> row
stories let citizen = toDocumentFrom<Citizen> "cit_data" row
|> Seq.map (fun storyDoc -> { id = success.id
let s = storyDoc.Value citizenId = success.citizenId
{ id = s.id citizenName = Citizen.name citizen
citizenId = s.citizenId recordedOn = success.recordedOn
citizenName = Citizen.name citizens[CitizenId.value s.citizenId].Value fromHere = success.fromHere
recordedOn = s.recordedOn hasStory = Option.isSome success.story
fromHere = s.fromHere
hasStory = Option.isSome s.story
}) })
|> List.ofSeq
}
/// Find a success story by its ID /// Find a success story by its ID
let findById successId = backgroundTask { let findById successId =
use session = querySession () connection () |> getDocument<Success> Table.Success (SuccessId.toString successId)
let! success = session.LoadAsync<SuccessDocument> (SuccessId.value successId)
return Document.TryValue success
}
/// Save a success story /// Save a success story
let save (success : Success) = backgroundTask { let save (success : Success) =
use session = docSession () connection () |> saveDocument Table.Success (SuccessId.toString success.id) success
session.Store (SuccessDocument success)
do! session.SaveChangesAsync ()
}

View File

@ -20,6 +20,7 @@
<PackageReference Include="Marten.NodaTime" Version="5.8.0" /> <PackageReference Include="Marten.NodaTime" Version="5.8.0" />
<PackageReference Update="FSharp.Core" Version="6.0.5" /> <PackageReference Update="FSharp.Core" Version="6.0.5" />
<PackageReference Include="Npgsql" Version="6.0.6" /> <PackageReference Include="Npgsql" Version="6.0.6" />
<PackageReference Include="Npgsql.FSharp" Version="5.3.0" />
<PackageReference Include="Npgsql.NodaTime" Version="6.0.6" /> <PackageReference Include="Npgsql.NodaTime" Version="6.0.6" />
</ItemGroup> </ItemGroup>

View File

@ -1,6 +1,5 @@
module JobsJobsJobs.Data.Json module JobsJobsJobs.Data.Json
open System
open System.Text.Json open System.Text.Json
open System.Text.Json.Serialization open System.Text.Json.Serialization
open JobsJobsJobs.Domain open JobsJobsJobs.Domain
@ -13,24 +12,15 @@ type WrappedJsonConverter<'T> (wrap : string -> 'T, unwrap : 'T -> string) =
override _.Write(writer, value, _) = override _.Write(writer, value, _) =
writer.WriteStringValue (unwrap 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 /// JsonSerializer options that use the custom converters
let options = let options =
let opts = JsonSerializerOptions () let opts = JsonSerializerOptions ()
[ WrappedIdJsonConverter (CitizenId, CitizenId.value) :> JsonConverter [ WrappedJsonConverter (CitizenId.ofString, CitizenId.toString) :> JsonConverter
WrappedIdJsonConverter (ContinentId, ContinentId.value) WrappedJsonConverter (ContinentId.ofString, ContinentId.toString)
WrappedIdJsonConverter (ListingId, ListingId.value) WrappedJsonConverter (ListingId.ofString, ListingId.toString)
WrappedJsonConverter (Text, MarkdownString.toString) WrappedJsonConverter (Text, MarkdownString.toString)
WrappedIdJsonConverter (SkillId, SkillId.value) WrappedJsonConverter (SkillId.ofString, SkillId.toString)
WrappedIdJsonConverter (SuccessId, SuccessId.value) WrappedJsonConverter (SuccessId.ofString, SuccessId.toString)
JsonFSharpConverter () JsonFSharpConverter ()
] ]
|> List.iter opts.Converters.Add |> List.iter opts.Converters.Add

View File

@ -0,0 +1,23 @@
<Project Sdk="Microsoft.NET.Sdk">
<PropertyGroup>
<OutputType>Exe</OutputType>
<TargetFramework>net6.0</TargetFramework>
</PropertyGroup>
<ItemGroup>
<Compile Include="Program.fs" />
<Content Include="appsettings.json" CopyToOutputDirectory="Always" />
</ItemGroup>
<ItemGroup>
<PackageReference Include="NodaTime.Serialization.JsonNet" Version="3.0.0" />
<PackageReference Include="RethinkDb.Driver.FSharp" Version="0.9.0-beta-07" />
<PackageReference Update="FSharp.Core" Version="6.0.5" />
</ItemGroup>
<ItemGroup>
<ProjectReference Include="..\JobsJobsJobs.Data\JobsJobsJobs.Data.fsproj" />
</ItemGroup>
</Project>

View File

@ -0,0 +1,93 @@

open Microsoft.Extensions.Configuration
/// Data access for v2 Jobs, Jobs, Jobs
module Rethink =
/// Table names
[<RequireQualifiedAccess>]
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
[<RequireQualifiedAccess>]
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<string> ()
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<JObject list>
|> withRetryOnce
|> withConn rethinkConn
let newCitizens =
oldCitizens
|> List.map (fun c ->
let user = c["mastodonUser"].Value<string> ()
{ Citizen.empty with
id = CitizenId.ofString (c["id"].Value<string> ())
joinedOn = getInstant c "joinedOn"
lastSeenOn = getInstant c "lastSeenOn"
email = $"""{user}@{c["instance"].Value<string> ()}"""
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

View File

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

View File

@ -60,7 +60,7 @@ let configureServices (svc : IServiceCollection) =
let _ = svc.Configure<AuthOptions> (cfg.GetSection "Auth") let _ = svc.Configure<AuthOptions> (cfg.GetSection "Auth")
// Set up the Marten data store // 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 _ -> () | Ok _ -> ()
| Error msg -> failwith $"Error initializing data store: {msg}" | Error msg -> failwith $"Error initializing data store: {msg}"