diff --git a/.gitignore b/.gitignore index ab9fa3c..f364ba6 100644 --- a/.gitignore +++ b/.gitignore @@ -5,3 +5,5 @@ src/**/obj src/**/appsettings.*.json src/.vs src/.idea + +.fake \ No newline at end of file diff --git a/src/Dockerfile b/src/Dockerfile index 888d39a..b4fe45f 100644 --- a/src/Dockerfile +++ b/src/Dockerfile @@ -1,10 +1,25 @@ -FROM mcr.microsoft.com/dotnet/sdk:5.0 AS build +FROM mcr.microsoft.com/dotnet/sdk:7.0-alpine AS build WORKDIR /jjj -COPY . ./ -WORKDIR /jjj/JobsJobsJobs/Server -RUN dotnet publish JobsJobsJobs.Server.csproj -c Release /p:PublishProfile=Properties/PublishProfiles/FolderProfile.xml +COPY ./JobsJobsJobs.sln ./ +COPY ./JobsJobsJobs/Directory.Build.props ./JobsJobsJobs/ +COPY ./JobsJobsJobs/Application/JobsJobsJobs.Application.fsproj ./JobsJobsJobs/Application/ +COPY ./JobsJobsJobs/Citizens/JobsJobsJobs.Citizens.fsproj ./JobsJobsJobs/Citizens/ +COPY ./JobsJobsJobs/Common/JobsJobsJobs.Common.fsproj ./JobsJobsJobs/Common/ +COPY ./JobsJobsJobs/Home/JobsJobsJobs.Home.fsproj ./JobsJobsJobs/Home/ +COPY ./JobsJobsJobs/Listings/JobsJobsJobs.Listings.fsproj ./JobsJobsJobs/Listings/ +COPY ./JobsJobsJobs/Profiles/JobsJobsJobs.Profiles.fsproj ./JobsJobsJobs/Profiles/ +COPY ./JobsJobsJobs/SuccessStories/JobsJobsJobs.SuccessStories.fsproj ./JobsJobsJobs/SuccessStories/ +RUN dotnet restore -FROM mcr.microsoft.com/dotnet/aspnet:5.0 -WORKDIR /jjj -COPY --from=build /jjj/JobsJobsJobs/Server/bin/Release/net5.0/linux-x64/publish/ ./ -ENTRYPOINT [ "/jjj/JobsJobsJobs.Server" ] +COPY . ./ +WORKDIR /jjj/JobsJobsJobs/Application +RUN dotnet publish -c Release -r linux-x64 + +FROM mcr.microsoft.com/dotnet/aspnet:7.0-alpine as final +WORKDIR /app +RUN apk add --no-cache icu-libs +ENV DOTNET_SYSTEM_GLOBALIZATION_INVARIANT=false +COPY --from=build /jjj/JobsJobsJobs/Application/bin/Release/net7.0/linux-x64/publish/ ./ + +EXPOSE 80 +CMD [ "dotnet", "/app/JobsJobsJobs.Application.dll" ] diff --git a/src/JobsJobsJobs/Application/App.fs b/src/JobsJobsJobs/Application/App.fs index 3b42186..0109a62 100644 --- a/src/JobsJobsJobs/Application/App.fs +++ b/src/JobsJobsJobs/Application/App.fs @@ -30,6 +30,7 @@ type BufferedBodyMiddleware (next : RequestDelegate) = let main args = let builder = WebApplication.CreateBuilder args + let _ = builder.Configuration.AddEnvironmentVariables "JJJ_" let svc = builder.Services let _ = svc.AddGiraffe () diff --git a/src/JobsJobsJobs/Application/JobsJobsJobs.Application.fsproj b/src/JobsJobsJobs/Application/JobsJobsJobs.Application.fsproj index 7c4da7f..ce78571 100644 --- a/src/JobsJobsJobs/Application/JobsJobsJobs.Application.fsproj +++ b/src/JobsJobsJobs/Application/JobsJobsJobs.Application.fsproj @@ -2,7 +2,7 @@ Exe - true + false false 3390;$(WarnOn) diff --git a/src/JobsJobsJobs/Application/appsettings.json b/src/JobsJobsJobs/Application/appsettings.json index 241bae4..db81b97 100644 --- a/src/JobsJobsJobs/Application/appsettings.json +++ b/src/JobsJobsJobs/Application/appsettings.json @@ -4,5 +4,12 @@ "JobsJobsJobs.Api.Handlers.Citizen": "Information", "Microsoft.AspNetCore.StaticFiles": "Warning" } + }, + "Kestrel": { + "EndPoints": { + "Http": { + "Url": "http://0.0.0.0:80" + } + } } } diff --git a/src/JobsJobsJobs/Citizens/Data.fs b/src/JobsJobsJobs/Citizens/Data.fs index 3c78ce5..4e2aae0 100644 --- a/src/JobsJobsJobs/Citizens/Data.fs +++ b/src/JobsJobsJobs/Citizens/Data.fs @@ -1,5 +1,6 @@ module JobsJobsJobs.Citizens.Data +open BitBadger.Npgsql.FSharp.Documents open JobsJobsJobs.Common.Data open JobsJobsJobs.Domain open NodaTime @@ -11,45 +12,37 @@ let mutable private lastPurge = Instant.MinValue /// Lock access to the above let private locker = obj () -/// Delete a citizen by their ID using the given connection properties -let private doDeleteById citizenId connProps = backgroundTask { +/// Delete a citizen by their ID +let deleteById citizenId = backgroundTask { let citId = CitizenId.toString citizenId - let! _ = - connProps - |> Sql.query $" - DELETE FROM {Table.Success} WHERE data @> @criteria; - DELETE FROM {Table.Listing} WHERE data @> @criteria; - DELETE FROM {Table.Citizen} WHERE id = @id" - |> Sql.parameters [ "@criteria", Sql.jsonb (mkDoc {| citizenId = citId |}); "@id", Sql.string citId ] - |> Sql.executeNonQueryAsync - () + do! Custom.nonQuery + $"{Query.Delete.byContains Table.Success}; + {Query.Delete.byContains Table.Listing}; + {Query.Delete.byId Table.Citizen}" + [ "@criteria", Query.jsonbDocParam {| citizenId = citId |}; "@id", Sql.string citId ] } -/// Delete a citizen by their ID -let deleteById citizenId = - doDeleteById citizenId (dataSource ()) - /// Save a citizen -let private saveCitizen (citizen : Citizen) connProps = - saveDocument Table.Citizen (CitizenId.toString citizen.Id) connProps (mkDoc citizen) +let private saveCitizen (citizen : Citizen) = + save Table.Citizen (CitizenId.toString citizen.Id) citizen /// Save security information for a citizen -let private saveSecurity (security : SecurityInfo) connProps = - saveDocument Table.SecurityInfo (CitizenId.toString security.Id) connProps (mkDoc security) +let saveSecurityInfo (security : SecurityInfo) = + save Table.SecurityInfo (CitizenId.toString security.Id) security /// Purge expired tokens let private purgeExpiredTokens now = backgroundTask { - let connProps = dataSource () let! info = - Sql.query $"SELECT * FROM {Table.SecurityInfo} WHERE data ->> 'tokenExpires' IS NOT NULL" connProps - |> Sql.executeAsync toDocument + dataSource () + |> Sql.query $"{Query.selectFromTable Table.SecurityInfo} WHERE data ->> 'tokenExpires' IS NOT NULL" + |> Sql.executeAsync fromData for expired in info |> List.filter (fun it -> it.TokenExpires.Value < now) do if expired.TokenUsage.Value = "confirm" then // Unconfirmed account; delete the entire thing - do! doDeleteById expired.Id connProps + do! deleteById expired.Id else // Some other use; just clear the token - do! saveSecurity { expired with Token = None; TokenUsage = None; TokenExpires = None } connProps + do! saveSecurityInfo { expired with Token = None; TokenUsage = None; TokenExpires = None } } /// Check for tokens to purge if it's been more than 10 minutes since we last checked @@ -62,51 +55,40 @@ let private checkForPurge skipCheck = }) /// Find a citizen by their ID -let findById citizenId = backgroundTask { - match! dataSource () |> getDocument Table.Citizen (CitizenId.toString citizenId) with - | Some c when not c.IsLegacy -> return Some c - | Some _ - | None -> return None -} +let findById citizenId = + Find.byId Table.Citizen (CitizenId.toString citizenId) /// Save a citizen let save citizen = - saveCitizen citizen (dataSource ()) + saveCitizen citizen /// Register a citizen (saves citizen and security settings); returns false if the e-mail is already taken -let register citizen (security : SecurityInfo) = backgroundTask { - let connProps = dataSource () - use conn = Sql.createConnection connProps - use! txn = conn.BeginTransactionAsync () +let register (citizen : Citizen) (security : SecurityInfo) = backgroundTask { try - do! saveCitizen citizen connProps - do! saveSecurity security connProps - do! txn.CommitAsync () + let! _ = + dataSource () + |> Sql.executeTransactionAsync + [ Query.save Table.Citizen, [ Query.docParameters (CitizenId.toString citizen.Id) citizen ] + Query.save Table.SecurityInfo, [ Query.docParameters (CitizenId.toString citizen.Id) security ] + ] return true with | :? Npgsql.PostgresException as ex when ex.SqlState = "23505" && ex.ConstraintName = "uk_citizen_email" -> - do! txn.RollbackAsync () return false } /// Try to find the security information matching a confirmation token -let private tryConfirmToken (token : string) connProps = backgroundTask { - let! tryInfo = - connProps - |> Sql.query $" SELECT * FROM {Table.SecurityInfo} WHERE data @> @criteria" - |> Sql.parameters [ "criteria", Sql.jsonb (mkDoc {| token = token; tokenUsage = "confirm" |}) ] - |> Sql.executeAsync toDocument +let private tryConfirmToken (token : string) = backgroundTask { + let! tryInfo = Find.byContains Table.SecurityInfo {| token = token; tokenUsage = "confirm" |} return List.tryHead tryInfo } /// Confirm a citizen's account let confirmAccount token = backgroundTask { do! checkForPurge true - let connProps = dataSource () - match! tryConfirmToken token connProps with + match! tryConfirmToken token with | Some info -> - do! saveSecurity { info with AccountLocked = false; Token = None; TokenUsage = None; TokenExpires = None } - connProps + do! saveSecurityInfo { info with AccountLocked = false; Token = None; TokenUsage = None; TokenExpires = None } return true | None -> return false } @@ -114,10 +96,9 @@ let confirmAccount token = backgroundTask { /// Deny a citizen's account (user-initiated; used if someone used their e-mail address without their consent) let denyAccount token = backgroundTask { do! checkForPurge true - let connProps = dataSource () - match! tryConfirmToken token connProps with + match! tryConfirmToken token with | Some info -> - do! doDeleteById info.Id connProps + do! deleteById info.Id return true | None -> return false } @@ -126,22 +107,17 @@ let denyAccount token = backgroundTask { let tryLogOn email password (pwVerify : Citizen -> string -> bool option) (pwHash : Citizen -> string -> string) now = backgroundTask { do! checkForPurge false - let connProps = dataSource () - let! tryCitizen = - connProps - |> Sql.query $"SELECT * FROM {Table.Citizen} WHERE data @> @criteria" - |> Sql.parameters [ "@criteria", Sql.jsonb (mkDoc {| email = email; isLegacy = false |}) ] - |> Sql.executeAsync toDocument + let! tryCitizen = Find.byContains Table.Citizen {| email = email |} match List.tryHead tryCitizen with | Some citizen -> let citizenId = CitizenId.toString citizen.Id - let! tryInfo = getDocument Table.SecurityInfo citizenId connProps + let! tryInfo = Find.byId Table.SecurityInfo citizenId let! info = backgroundTask { match tryInfo with | Some it -> return it | None -> let it = { SecurityInfo.empty with Id = citizen.Id } - do! saveSecurity it connProps + do! saveSecurityInfo it return it } if info.AccountLocked then return Error "Log on unsuccessful (Account Locked)" @@ -149,129 +125,30 @@ let tryLogOn email password (pwVerify : Citizen -> string -> bool option) (pwHas match pwVerify citizen password with | Some rehash -> let hash = if rehash then pwHash citizen password else citizen.PasswordHash - do! saveSecurity { info with FailedLogOnAttempts = 0 } connProps - do! saveCitizen { citizen with LastSeenOn = now; PasswordHash = hash } connProps + do! saveSecurityInfo { info with FailedLogOnAttempts = 0 } + do! saveCitizen { citizen with LastSeenOn = now; PasswordHash = hash } return Ok { citizen with LastSeenOn = now } | None -> let locked = info.FailedLogOnAttempts >= 4 do! { info with FailedLogOnAttempts = info.FailedLogOnAttempts + 1; AccountLocked = locked } - |> saveSecurity <| connProps + |> saveSecurityInfo return Error $"""Log on unsuccessful{if locked then " - Account is now locked" else ""}""" | None -> return Error "Log on unsuccessful" } /// Try to retrieve a citizen and their security information by their e-mail address -let tryByEmailWithSecurity email = backgroundTask { - let toCitizenSecurityPair row = (toDocument row, toDocumentFrom "sec_data" row) - let! results = - dataSource () - |> Sql.query $" - SELECT c.*, s.data AS sec_data - FROM {Table.Citizen} c - INNER JOIN {Table.SecurityInfo} s ON s.id = c.id - WHERE c.data @> @criteria" - |> Sql.parameters [ "@criteria", Sql.jsonb (mkDoc {| email = email |}) ] - |> Sql.executeAsync toCitizenSecurityPair - return List.tryHead results -} - -/// Save an updated security information document -let saveSecurityInfo security = backgroundTask { - do! saveSecurity security (dataSource ()) -} +let tryByEmailWithSecurity email = + Custom.single + $"SELECT c.*, s.data AS sec_data + FROM {Table.Citizen} c + INNER JOIN {Table.SecurityInfo} s ON s.id = c.id + WHERE c.data @> @criteria" + [ "@criteria", Query.jsonbDocParam {| email = email |} ] + (fun row -> (fromData row, fromDocument "sec_data" row)) /// Try to retrieve security information by the given token let trySecurityByToken (token : string) = backgroundTask { do! checkForPurge false - let! results = - dataSource () - |> Sql.query $"SELECT * FROM {Table.SecurityInfo} WHERE data @> @criteria" - |> Sql.parameters [ "@criteria", Sql.jsonb (mkDoc {| token = token |}) ] - |> Sql.executeAsync toDocument + let! results = Find.byContains Table.SecurityInfo {| token = token |} return List.tryHead results } - -// ~~~ LEGACY MIGRATION ~~~ // - -/// Get all legacy citizens -let legacy () = backgroundTask { - return! - dataSource () - |> Sql.query $""" - SELECT * - FROM {Table.Citizen} - WHERE data @> '{{ "isLegacy": true }}'::jsonb - ORDER BY data ->> 'firstName'""" - |> Sql.executeAsync toDocument -} - -/// Get all current citizens with verified accounts but without a profile -let current () = backgroundTask { - return! - dataSource () - |> Sql.query $""" - SELECT c.* - FROM {Table.Citizen} c - INNER JOIN {Table.SecurityInfo} si ON si.id = c.id - WHERE c.data @> '{{ "isLegacy": false }}'::jsonb - AND si.data @> '{{ "accountLocked": false }}'::jsonb - AND NOT EXISTS (SELECT 1 FROM {Table.Profile} p WHERE p.id = c.id)""" - |> Sql.executeAsync toDocument -} - -let migrateLegacy currentId legacyId = backgroundTask { - let oldId = CitizenId.toString legacyId - let connProps = dataSource () - use conn = Sql.createConnection connProps - use! txn = conn.BeginTransactionAsync () - try - // Add legacy data to current user - let! profiles = - conn - |> Sql.existingConnection - |> Sql.query $"SELECT * FROM {Table.Profile} WHERE id = @oldId" - |> Sql.parameters [ "@oldId", Sql.string oldId ] - |> Sql.executeAsync toDocument - match List.tryHead profiles with - | Some profile -> - do! saveDocument - Table.Profile (CitizenId.toString currentId) (Sql.existingConnection conn) - (mkDoc { profile with Id = currentId; IsLegacy = false }) - | None -> () - let oldCriteria = mkDoc {| citizenId = oldId |} - let! listings = - conn - |> Sql.existingConnection - |> Sql.query $"SELECT * FROM {Table.Listing} WHERE data @> @criteria" - |> Sql.parameters [ "@criteria", Sql.jsonb oldCriteria ] - |> Sql.executeAsync toDocument- for listing in listings do - let newListing = { listing with Id = ListingId.create (); CitizenId = currentId; IsLegacy = false } - do! saveDocument - Table.Listing (ListingId.toString newListing.Id) (Sql.existingConnection conn) (mkDoc newListing) - let! successes = - conn - |> Sql.existingConnection - |> Sql.query $"SELECT * FROM {Table.Success} WHERE data @> @criteria" - |> Sql.parameters [ "@criteria", Sql.jsonb oldCriteria ] - |> Sql.executeAsync toDocument - for success in successes do - let newSuccess = { success with Id = SuccessId.create (); CitizenId = currentId } - do! saveDocument - Table.Success (SuccessId.toString newSuccess.Id) (Sql.existingConnection conn) (mkDoc newSuccess) - // Delete legacy data - let! _ = - conn - |> Sql.existingConnection - |> Sql.query $" - DELETE FROM {Table.Success} WHERE data @> @criteria; - DELETE FROM {Table.Listing} WHERE data @> @criteria; - DELETE FROM {Table.Citizen} WHERE id = @oldId" - |> Sql.parameters [ "@criteria", Sql.jsonb oldCriteria; "@oldId", Sql.string oldId ] - |> Sql.executeNonQueryAsync - do! txn.CommitAsync () - return Ok "" - with :? Npgsql.PostgresException as ex -> - do! txn.RollbackAsync () - return Error ex.MessageText -} diff --git a/src/JobsJobsJobs/Citizens/Domain.fs b/src/JobsJobsJobs/Citizens/Domain.fs index c4d32e2..9e9921e 100644 --- a/src/JobsJobsJobs/Citizens/Domain.fs +++ b/src/JobsJobsJobs/Citizens/Domain.fs @@ -151,14 +151,3 @@ type ResetPasswordForm = /// The new password for the account Password : string } - -// ~~~ LEGACY MIGRATION ~~ // - -[] -type LegacyMigrationForm = - { /// The ID of the current citizen - Id : string - - /// The ID of the legacy citizen to be migrated - LegacyId : string - } diff --git a/src/JobsJobsJobs/Citizens/Handlers.fs b/src/JobsJobsJobs/Citizens/Handlers.fs index de23fc6..0e4750f 100644 --- a/src/JobsJobsJobs/Citizens/Handlers.fs +++ b/src/JobsJobsJobs/Citizens/Handlers.fs @@ -59,13 +59,6 @@ module private Auth = | PasswordVerificationResult.SuccessRehashNeeded -> Some true | _ -> None - /// Require an administrative user (used for legacy migration endpoints) - let requireAdmin : HttpHandler = requireUser >=> fun next ctx -> task { - let adminUser = (config ctx)["AdminUser"] - if adminUser = defaultArg (tryUser ctx) "" then return! next ctx - else return! Error.notAuthorized next ctx - } - // GET: /citizen/account let account : HttpHandler = fun next ctx -> task { @@ -332,25 +325,6 @@ let saveAccount : HttpHandler = requireUser >=> validateCsrf >=> fun next ctx -> let soLong : HttpHandler = requireUser >=> fun next ctx -> Views.deletionOptions (csrf ctx) |> render "Account Deletion Options" next ctx -// ~~~ LEGACY MIGRATION ~~~ // - -// GET: /citizen/legacy -let legacy : HttpHandler = Auth.requireAdmin >=> fun next ctx -> task { - let! currentUsers = Data.current () - let! legacyUsers = Data.legacy () - return! Views.legacy currentUsers legacyUsers (csrf ctx) |> render "Migrate Legacy Account" next ctx -} - -// POST: /citizen/legacy/migrate -let migrateLegacy : HttpHandler = Auth.requireAdmin >=> validateCsrf >=> fun next ctx -> task { - let! form = ctx.BindFormAsync () - let currentId = CitizenId.ofString form.Id - let legacyId = CitizenId.ofString form.LegacyId - match! Data.migrateLegacy currentId legacyId with - | Ok _ -> do! addSuccess "Migration successful" ctx - | Error err -> do! addError err ctx - return! redirectToGet "/citizen/legacy" next ctx -} open Giraffe.EndpointRouting @@ -369,7 +343,6 @@ let endpoints = route "/register" register routef "/reset-password/%s" resetPassword route "/so-long" soLong - route "/legacy" legacy ] POST [ route "/delete" delete @@ -378,6 +351,5 @@ let endpoints = route "/register" doRegistration route "/reset-password" doResetPassword route "/save-account" saveAccount - route "/legacy/migrate" migrateLegacy ] ] diff --git a/src/JobsJobsJobs/Citizens/Views.fs b/src/JobsJobsJobs/Citizens/Views.fs index 06f77f2..6e6eb8d 100644 --- a/src/JobsJobsJobs/Citizens/Views.fs +++ b/src/JobsJobsJobs/Citizens/Views.fs @@ -393,54 +393,3 @@ let resetPassword (m : ResetPasswordForm) isHtmx csrf = jsOnLoad $"jjj.citizen.validatePasswords('{nameof m.Password}', 'ConfirmPassword', true)" isHtmx ] ] - -// ~~~ LEGACY MIGRATION ~~~ // - -let legacy (current : Citizen list) (legacy : Citizen list) csrf = - form [ _class "container"; _hxPost "/citizen/legacy/migrate" ] [ - antiForgery csrf - let canProcess = not (List.isEmpty current) - div [ _class "row" ] [ - if canProcess then - div [ _class "col-12 col-lg-6 col-xxl-4" ] [ - div [ _class "form-floating" ] [ - select [ _id "current"; _name "Id"; _class "form-control" ] [ - option [ _value "" ] [ txt "– Select –" ] - yield! - current - |> List.sortBy Citizen.name - |> List.map (fun it -> - option [ _value (CitizenId.toString it.Id) ] [ - str (Citizen.name it); txt " ("; str it.Email; txt ")" - ]) - ] - label [ _for "current" ] [ txt "Current User" ] - ] - ] - else p [] [ txt "There are no current accounts to which legacy accounts can be migrated" ] - div [ _class "col-12 col-lg-6 offset-xxl-2"] [ - table [ _class "table table-sm table-hover" ] [ - thead [] [ - tr [] [ - th [ _scope "col" ] [ txt "Select" ] - th [ _scope "col" ] [ txt "NAS Profile" ] - ] - ] - legacy |> List.map (fun it -> - let theId = CitizenId.toString it.Id - tr [] [ - td [] [ - if canProcess then - input [ _type "radio"; _id $"legacy_{theId}"; _name "LegacyId"; _value theId ] - else txt " " - ] - td [] [ label [ _for $"legacy_{theId}" ] [ str it.Email ] ] - ]) - |> tbody [] - ] - ] - ] - submitButton "content-save-outline" "Migrate Account" - ] - |> List.singleton - |> pageWithTitle "Migrate Legacy Account" diff --git a/src/JobsJobsJobs/Common/Data.fs b/src/JobsJobsJobs/Common/Data.fs index aaa2145..fdbad61 100644 --- a/src/JobsJobsJobs/Common/Data.fs +++ b/src/JobsJobsJobs/Common/Data.fs @@ -29,6 +29,7 @@ module Table = let Success = "jjj.success" +open BitBadger.Npgsql.FSharp.Documents open Npgsql.FSharp /// Connection management for the document store @@ -38,29 +39,27 @@ module DataConnection = open Microsoft.Extensions.Configuration open Npgsql - /// The data source for the document store - let mutable private theDataSource : NpgsqlDataSource option = None - /// Get the data source as the start of a SQL statement - let dataSource () = - match theDataSource with - | Some ds -> Sql.fromDataSource ds - | None -> invalidOp "DataConnection.setUp() must be called before accessing the database" + let dataSource = + Configuration.dataSource >> Sql.fromDataSource /// Create tables let private createTables () = backgroundTask { + let! _ = + dataSource () + |> Sql.query "CREATE SCHEMA IF NOT EXISTS jjj" + |> Sql.executeNonQueryAsync + do! Definition.ensureTable Table.Citizen + do! Definition.ensureTable Table.Continent + do! Definition.ensureTable Table.Listing + do! Definition.ensureTable Table.Success let sql = [ - "CREATE SCHEMA IF NOT EXISTS jjj" - // Tables - $"CREATE TABLE IF NOT EXISTS {Table.Citizen} (id TEXT NOT NULL PRIMARY KEY, data JSONB NOT NULL)" - $"CREATE TABLE IF NOT EXISTS {Table.Continent} (id TEXT NOT NULL PRIMARY KEY, data JSONB NOT NULL)" - $"CREATE TABLE IF NOT EXISTS {Table.Listing} (id TEXT NOT NULL PRIMARY KEY, data JSONB NOT NULL)" + // Tables that use more than the default document configuration $"CREATE TABLE IF NOT EXISTS {Table.Profile} (id TEXT NOT NULL PRIMARY KEY, data JSONB NOT NULL, text_search TSVECTOR NOT NULL, CONSTRAINT fk_profile_citizen FOREIGN KEY (id) REFERENCES {Table.Citizen} (id) ON DELETE CASCADE)" $"CREATE TABLE IF NOT EXISTS {Table.SecurityInfo} (id TEXT NOT NULL PRIMARY KEY, data JSONB NOT NULL, CONSTRAINT fk_security_info_citizen FOREIGN KEY (id) REFERENCES {Table.Citizen} (id) ON DELETE CASCADE)" - $"CREATE TABLE IF NOT EXISTS {Table.Success} (id TEXT NOT NULL PRIMARY KEY, data JSONB NOT NULL)" // Key indexes $"CREATE UNIQUE INDEX IF NOT EXISTS uk_citizen_email ON {Table.Citizen} ((data -> 'email'))" $"CREATE INDEX IF NOT EXISTS idx_listing_citizen ON {Table.Listing} ((data -> 'citizenId'))" @@ -125,64 +124,21 @@ module DataConnection = let setUp (cfg : IConfiguration) = backgroundTask { let builder = NpgsqlDataSourceBuilder (cfg.GetConnectionString "PostgreSQL") let _ = builder.UseNodaTime () - theDataSource <- Some (builder.Build ()) + Configuration.useDataSource (builder.Build ()) do! createTables () do! createTriggers () } -open System.Text.Json -open System.Threading.Tasks -open JobsJobsJobs - -/// Map the data field to the requested document type -let toDocumentFrom<'T> fieldName (row : RowReader) = - JsonSerializer.Deserialize<'T> (row.string fieldName, Json.options) - -/// Map the data field to the requested document type -let toDocument<'T> (row : RowReader) = toDocumentFrom<'T> "data" row - -/// Get a document -let getDocument<'T> table docId sqlProps : Task<'T option> = backgroundTask { - let! doc = - Sql.query $"SELECT * FROM %s{table} where id = @id" sqlProps - |> Sql.parameters [ "@id", Sql.string docId ] - |> Sql.executeAsync toDocument - return List.tryHead doc -} - -/// Serialize a document to JSON -let mkDoc<'T> (doc : 'T) = - JsonSerializer.Serialize<'T> (doc, Json.options) - -/// Save a document -let saveDocument table docId sqlProps doc = backgroundTask { - let! _ = - Sql.query - $"INSERT INTO %s{table} (id, data) VALUES (@id, @data) - ON CONFLICT (id) DO UPDATE SET data = EXCLUDED.data" - sqlProps - |> Sql.parameters - [ "@id", Sql.string docId - "@data", Sql.jsonb doc ] - |> Sql.executeNonQueryAsync - () -} - /// Create a match-anywhere clause for a LIKE or ILIKE clause let like value = Sql.string $"%%%s{value}%%" -/// The JSON access operator ->> makes values text; this makes a parameter that will compare the properly -let jsonBool value = - Sql.string (if value then "true" else "false") - /// Get the SQL for a search WHERE clause let searchSql criteria = let sql = criteria |> List.map fst |> String.concat " AND " if sql = "" then "" else $"AND {sql}" - /// Continent data access functions [] module Continents = @@ -191,10 +147,8 @@ module Continents = /// Retrieve all continents let all () = - dataSource () - |> Sql.query $"SELECT * FROM {Table.Continent} ORDER BY data ->> 'name'" - |> Sql.executeAsync toDocument + Custom.list $"{Query.selectFromTable Table.Continent} ORDER BY data ->> 'name'" [] fromData /// Retrieve a continent by its ID let findById continentId = - dataSource () |> getDocument Table.Continent (ContinentId.toString continentId) + Find.byId Table.Continent (ContinentId.toString continentId) diff --git a/src/JobsJobsJobs/Common/Domain.fs b/src/JobsJobsJobs/Common/Domain.fs index 601019c..c149d73 100644 --- a/src/JobsJobsJobs/Common/Domain.fs +++ b/src/JobsJobsJobs/Common/Domain.fs @@ -249,9 +249,6 @@ type Citizen = /// The other contacts for this user OtherContacts : OtherContact list - - /// Whether this is a legacy citizen - IsLegacy : bool } /// Support functions for citizens @@ -268,7 +265,6 @@ module Citizen = PasswordHash = "" DisplayName = None OtherContacts = [] - IsLegacy = false } /// Get the name of the citizen (either their preferred display name or first/last names) @@ -334,9 +330,6 @@ 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 } /// Support functions for job listings @@ -356,7 +349,6 @@ module Listing = Text = Text "" NeededBy = None WasFilledHere = None - IsLegacy = false } @@ -434,9 +426,6 @@ type Profile = /// When the citizen last updated their profile LastUpdatedOn : Instant - - /// Whether this is a legacy profile - IsLegacy : bool } /// Support functions for Profiles @@ -456,7 +445,6 @@ module Profile = Experience = None Visibility = Private LastUpdatedOn = Instant.MinValue - IsLegacy = false } diff --git a/src/JobsJobsJobs/Common/JobsJobsJobs.Common.fsproj b/src/JobsJobsJobs/Common/JobsJobsJobs.Common.fsproj index 777bb87..50111ed 100644 --- a/src/JobsJobsJobs/Common/JobsJobsJobs.Common.fsproj +++ b/src/JobsJobsJobs/Common/JobsJobsJobs.Common.fsproj @@ -15,7 +15,8 @@ - + + diff --git a/src/JobsJobsJobs/Directory.Build.props b/src/JobsJobsJobs/Directory.Build.props index d4a5fc7..2ef9e4b 100644 --- a/src/JobsJobsJobs/Directory.Build.props +++ b/src/JobsJobsJobs/Directory.Build.props @@ -4,7 +4,7 @@ enable embedded false - 3.0.2.0 - 3.0.2.0 + 3.1.0.0 + 3.1.0.0 diff --git a/src/JobsJobsJobs/Listings/Data.fs b/src/JobsJobsJobs/Listings/Data.fs index ea0d82d..d1ebed0 100644 --- a/src/JobsJobsJobs/Listings/Data.fs +++ b/src/JobsJobsJobs/Listings/Data.fs @@ -1,5 +1,6 @@ module JobsJobsJobs.Listings.Data +open BitBadger.Npgsql.FSharp.Documents open JobsJobsJobs.Common.Data open JobsJobsJobs.Domain open JobsJobsJobs.Listings.Domain @@ -14,57 +15,46 @@ let viewSql = /// Map a result for a listing view let private toListingForView row = - { Listing = toDocument row + { Listing = fromData row ContinentName = row.string "continent_name" - Citizen = toDocumentFrom "cit_data" row + Citizen = fromDocument "cit_data" row } /// Find all job listings posted by the given citizen let findByCitizen citizenId = - dataSource () - |> Sql.query $"{viewSql} WHERE l.data @> @criteria" - |> Sql.parameters - [ "@criteria", Sql.jsonb (mkDoc {| citizenId = CitizenId.toString citizenId; isLegacy = false |}) ] - |> Sql.executeAsync toListingForView + Custom.list + $"{viewSql} WHERE l.data @> @criteria" + [ "@criteria", Query.jsonbDocParam {| citizenId = CitizenId.toString citizenId |} ] + toListingForView /// Find a listing by its ID -let findById listingId = backgroundTask { - match! dataSource () |> getDocument Table.Listing (ListingId.toString listingId) with - | Some listing when not listing.IsLegacy -> return Some listing - | Some _ - | None -> return None -} +let findById listingId = + Find.byId Table.Listing (ListingId.toString listingId) /// Find a listing by its ID for viewing (includes continent information) -let findByIdForView listingId = backgroundTask { - let! tryListing = - dataSource () - |> Sql.query $"""{viewSql} WHERE l.id = @id AND l.data @> '{{ "isLegacy": false }}'::jsonb""" - |> Sql.parameters [ "@id", Sql.string (ListingId.toString listingId) ] - |> Sql.executeAsync toListingForView - return List.tryHead tryListing -} +let findByIdForView listingId = + Custom.single + $"{viewSql} WHERE l.id = @id" [ "@id", Sql.string (ListingId.toString listingId) ] toListingForView /// Save a listing let save (listing : Listing) = - dataSource () |> saveDocument Table.Listing (ListingId.toString listing.Id) <| mkDoc listing + save Table.Listing (ListingId.toString listing.Id) listing /// Search job listings let search (search : ListingSearchForm) = let searches = [ if search.ContinentId <> "" then - "l.data @> @continent", [ "@continent", Sql.jsonb (mkDoc {| continentId = search.ContinentId |}) ] + "l.data @> @continent", [ "@continent", Query.jsonbDocParam {| continentId = search.ContinentId |} ] if search.Region <> "" then "l.data ->> 'region' ILIKE @region", [ "@region", like search.Region ] if search.RemoteWork <> "" then - "l.data @> @remote", [ "@remote", Sql.jsonb (mkDoc {| isRemote = search.RemoteWork = "yes" |}) ] + "l.data @> @remote", [ "@remote", Query.jsonbDocParam {| isRemote = search.RemoteWork = "yes" |} ] if search.Text <> "" then "l.data ->> 'text' ILIKE @text", [ "@text", like search.Text ] ] - dataSource () - |> Sql.query $""" - {viewSql} - WHERE l.data @> '{{ "isExpired": false, "isLegacy": false }}'::jsonb - {searchSql searches}""" - |> Sql.parameters (searches |> List.collect snd) - |> Sql.executeAsync toListingForView + Custom.list + $"""{viewSql} + WHERE l.data @> '{{ "isExpired": false }}'::jsonb + {searchSql searches}""" + (searches |> List.collect snd) + toListingForView diff --git a/src/JobsJobsJobs/Listings/Handlers.fs b/src/JobsJobsJobs/Listings/Handlers.fs index 5ed3422..d7da66e 100644 --- a/src/JobsJobsJobs/Listings/Handlers.fs +++ b/src/JobsJobsJobs/Listings/Handlers.fs @@ -96,7 +96,6 @@ let save : HttpHandler = requireUser >=> validateCsrf >=> fun next ctx -> task { CreatedOn = now IsExpired = false WasFilledHere = None - IsLegacy = false } | _ -> return! Data.findById (ListingId.ofString form.Id) } diff --git a/src/JobsJobsJobs/Profiles/Data.fs b/src/JobsJobsJobs/Profiles/Data.fs index 1dff246..380916c 100644 --- a/src/JobsJobsJobs/Profiles/Data.fs +++ b/src/JobsJobsJobs/Profiles/Data.fs @@ -1,5 +1,6 @@ module JobsJobsJobs.Profiles.Data +open BitBadger.Npgsql.FSharp.Documents open JobsJobsJobs.Common.Data open JobsJobsJobs.Domain open JobsJobsJobs.Profiles.Domain @@ -7,83 +8,63 @@ open Npgsql.FSharp /// Count the current profiles let count () = - dataSource () - |> Sql.query - $"""SELECT COUNT(id) AS the_count FROM {Table.Profile} WHERE data @> '{{ "isLegacy": false }}'::jsonb""" - |> Sql.executeRowAsync (fun row -> row.int64 "the_count") + Count.all Table.Profile /// Delete a profile by its ID -let deleteById citizenId = backgroundTask { - let! _ = - dataSource () - |> Sql.query $"DELETE FROM {Table.Profile} WHERE id = @id" - |> Sql.parameters [ "@id", Sql.string (CitizenId.toString citizenId) ] - |> Sql.executeNonQueryAsync - () -} +let deleteById citizenId = + Delete.byId Table.Profile (CitizenId.toString citizenId) /// Find a profile by citizen ID -let findById citizenId = backgroundTask { - match! dataSource () |> getDocument Table.Profile (CitizenId.toString citizenId) with - | Some profile when not profile.IsLegacy -> return Some profile - | Some _ - | None -> return None -} +let findById citizenId = + Find.byId Table.Profile (CitizenId.toString citizenId) /// Convert a data row to a profile for viewing let private toProfileForView row = - { Profile = toDocument row - Citizen = toDocumentFrom "cit_data" row - Continent = toDocumentFrom "cont_data" row + { Profile = fromData row + Citizen = fromDocument "cit_data" row + Continent = fromDocument "cont_data" row } /// Find a profile by citizen ID for viewing (includes citizen and continent information) -let findByIdForView citizenId = backgroundTask { - let! tryCitizen = - dataSource () - |> Sql.query $""" - SELECT p.*, c.data AS cit_data, o.data AS cont_data - FROM {Table.Profile} p - INNER JOIN {Table.Citizen} c ON c.id = p.id - INNER JOIN {Table.Continent} o ON o.id = p.data ->> 'continentId' - WHERE p.id = @id - AND p.data @> '{{ "isLegacy": false }}'::jsonb""" - |> Sql.parameters [ "@id", Sql.string (CitizenId.toString citizenId) ] - |> Sql.executeAsync toProfileForView - return List.tryHead tryCitizen -} +let findByIdForView citizenId = + Custom.single + $"SELECT p.*, c.data AS cit_data, o.data AS cont_data + FROM {Table.Profile} p + INNER JOIN {Table.Citizen} c ON c.id = p.id + INNER JOIN {Table.Continent} o ON o.id = p.data ->> 'continentId' + WHERE p.id = @id" + [ "@id", Sql.string (CitizenId.toString citizenId) ] + toProfileForView /// Save a profile let save (profile : Profile) = - dataSource () |> saveDocument Table.Profile (CitizenId.toString profile.Id) <| mkDoc profile + save Table.Profile (CitizenId.toString profile.Id) profile /// Search profiles let search (search : ProfileSearchForm) isPublic = backgroundTask { let searches = [ if search.ContinentId <> "" then - "p.data @> @continent", [ "@continent", Sql.jsonb (mkDoc {| continentId = search.ContinentId |}) ] + "p.data @> @continent", [ "@continent", Query.jsonbDocParam {| continentId = search.ContinentId |} ] if search.RemoteWork <> "" then - "p.data @> @remote", [ "@remote", Sql.jsonb (mkDoc {| isRemote = search.RemoteWork = "yes" |}) ] + "p.data @> @remote", [ "@remote", Query.jsonbDocParam {| isRemote = search.RemoteWork = "yes" |} ] if search.Text <> "" then "p.text_search @@ plainto_tsquery(@text_search)", [ "@text_search", Sql.string search.Text ] ] let vizSql = if isPublic then sprintf "(p.data @> '%s'::jsonb OR p.data @> '%s'::jsonb)" - (mkDoc {| visibility = ProfileVisibility.toString Public |}) - (mkDoc {| visibility = ProfileVisibility.toString Anonymous |}) + (Configuration.serializer().Serialize {| visibility = ProfileVisibility.toString Public |}) + (Configuration.serializer().Serialize {| visibility = ProfileVisibility.toString Anonymous |}) else sprintf "p.data ->> 'visibility' <> '%s'" (ProfileVisibility.toString Hidden) let! results = - dataSource () - |> Sql.query $""" - SELECT p.*, c.data AS cit_data, o.data AS cont_data - FROM {Table.Profile} p - INNER JOIN {Table.Citizen} c ON c.id = p.id - INNER JOIN {Table.Continent} o ON o.id = p.data ->> 'continentId' - WHERE p.data @> '{{ "isLegacy": false }}'::jsonb - AND {vizSql} - {searchSql searches}""" - |> Sql.parameters (searches |> List.collect snd) - |> Sql.executeAsync toProfileForView + Custom.list + $" SELECT p.*, c.data AS cit_data, o.data AS cont_data + FROM {Table.Profile} p + INNER JOIN {Table.Citizen} c ON c.id = p.id + INNER JOIN {Table.Continent} o ON o.id = p.data ->> 'continentId' + WHERE {vizSql} + {searchSql searches}" + (searches |> List.collect snd) + toProfileForView return results |> List.sortBy (fun pfv -> (Citizen.name pfv.Citizen).ToLowerInvariant ()) } diff --git a/src/JobsJobsJobs/SuccessStories/Data.fs b/src/JobsJobsJobs/SuccessStories/Data.fs index f179529..0e6fd45 100644 --- a/src/JobsJobsJobs/SuccessStories/Data.fs +++ b/src/JobsJobsJobs/SuccessStories/Data.fs @@ -1,5 +1,6 @@ module JobsJobsJobs.SuccessStories.Data +open BitBadger.Npgsql.FSharp.Documents open JobsJobsJobs.Common.Data open JobsJobsJobs.Domain open JobsJobsJobs.SuccessStories.Domain @@ -7,27 +8,27 @@ open Npgsql.FSharp // Retrieve all success stories let all () = - dataSource () - |> Sql.query $" - SELECT s.*, c.data AS cit_data - FROM {Table.Success} s - INNER JOIN {Table.Citizen} c ON c.id = s.data ->> 'citizenId' - ORDER BY s.data ->> 'recordedOn' DESC" - |> Sql.executeAsync (fun row -> - let success = toDocument row - let citizen = toDocumentFrom "cit_data" row - { Id = success.Id - CitizenId = success.CitizenId - CitizenName = Citizen.name citizen - RecordedOn = success.RecordedOn - FromHere = success.IsFromHere - HasStory = Option.isSome success.Story - }) + Custom.list + $" SELECT s.*, c.data AS cit_data + FROM {Table.Success} s + INNER JOIN {Table.Citizen} c ON c.id = s.data ->> 'citizenId' + ORDER BY s.data ->> 'recordedOn' DESC" + [] + (fun row -> + let success = fromData row + let citizen = fromDocument "cit_data" row + { Id = success.Id + CitizenId = success.CitizenId + CitizenName = Citizen.name citizen + RecordedOn = success.RecordedOn + FromHere = success.IsFromHere + HasStory = Option.isSome success.Story + }) /// Find a success story by its ID let findById successId = - dataSource () |> getDocument Table.Success (SuccessId.toString successId) + Find.byId Table.Success (SuccessId.toString successId) /// Save a success story let save (success : Success) = - (dataSource (), mkDoc success) ||> saveDocument Table.Success (SuccessId.toString success.Id) + save Table.Success (SuccessId.toString success.Id) success