bit-badger/jobs-jobs-jobs
1
0
Fork 0
Code Issues 1 Pull Requests Packages Projects Releases 19 Activity

v 3.1 (#42)

Browse Source 
- Use PostgreSQL document library
- Remove `isLegacy` property from profiles and listings
- Update Docker image parameters (v 3.1 is deployed as a container)
- Update dependencies
This commit is contained in:
Daniel J. Summers 2023-07-02 20:00:16 -04:00 committed by GitHub
parent f289bee79d
commit a89eff2363
No known key found for this signature in database
GPG Key ID: 4AEE18F83AFDEB23
23 changed files with 255 additions and 553 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

2
.gitignore vendored
View File

@ -5,3 +5,5 @@ src/**/obj
src/**/appsettings.*.json src/**/appsettings.*.json
src/.vs src/.vs
src/.idea src/.idea
.fake

31
src/Dockerfile
View File

@ -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 WORKDIR /jjj
COPY . ./ COPY ./JobsJobsJobs.sln ./
WORKDIR /jjj/JobsJobsJobs/Server COPY ./JobsJobsJobs/Directory.Build.props ./JobsJobsJobs/
RUN dotnet publish JobsJobsJobs.Server.csproj -c Release /p:PublishProfile=Properties/PublishProfiles/FolderProfile.xml 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 COPY . ./
WORKDIR /jjj WORKDIR /jjj/JobsJobsJobs/Application
COPY --from=build /jjj/JobsJobsJobs/Server/bin/Release/net5.0/linux-x64/publish/ ./ RUN dotnet publish -c Release -r linux-x64
ENTRYPOINT [ "/jjj/JobsJobsJobs.Server" ]
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" ]

1
src/JobsJobsJobs/Application/App.fs
View File

@ -30,6 +30,7 @@ type BufferedBodyMiddleware (next : RequestDelegate) =
let main args = let main args =
let builder = WebApplication.CreateBuilder args let builder = WebApplication.CreateBuilder args
let _ = builder.Configuration.AddEnvironmentVariables "JJJ_"
let svc = builder.Services let svc = builder.Services
let _ = svc.AddGiraffe () let _ = svc.AddGiraffe ()

6
src/JobsJobsJobs/Application/JobsJobsJobs.Application.fsproj
View File

@ -2,7 +2,7 @@
<PropertyGroup> <PropertyGroup>
<OutputType>Exe</OutputType> <OutputType>Exe</OutputType>
<PublishSingleFile>true</PublishSingleFile> <PublishSingleFile>false</PublishSingleFile>
<SelfContained>false</SelfContained> <SelfContained>false</SelfContained>
<WarnOn>3390;$(WarnOn)</WarnOn> <WarnOn>3390;$(WarnOn)</WarnOn>
</PropertyGroup> </PropertyGroup>
@ -25,4 +25,8 @@
<ProjectReference Include="..\SuccessStories\JobsJobsJobs.SuccessStories.fsproj" /> <ProjectReference Include="..\SuccessStories\JobsJobsJobs.SuccessStories.fsproj" />
</ItemGroup> </ItemGroup>
<ItemGroup>
<PackageReference Update="FSharp.Core" Version="7.0.300" />
</ItemGroup>
</Project> </Project>

7
src/JobsJobsJobs/Application/appsettings.json
View File

@ -4,5 +4,12 @@
"JobsJobsJobs.Api.Handlers.Citizen": "Information", "JobsJobsJobs.Api.Handlers.Citizen": "Information",
"Microsoft.AspNetCore.StaticFiles": "Warning" "Microsoft.AspNetCore.StaticFiles": "Warning"
} }
},
"Kestrel": {
"EndPoints": {
"Http": {
"Url": "http://0.0.0.0:80"
}
}
} }
} }

227
src/JobsJobsJobs/Citizens/Data.fs
View File

@ -1,5 +1,6 @@
module JobsJobsJobs.Citizens.Data module JobsJobsJobs.Citizens.Data
open BitBadger.Npgsql.FSharp.Documents
open JobsJobsJobs.Common.Data open JobsJobsJobs.Common.Data
open JobsJobsJobs.Domain open JobsJobsJobs.Domain
open NodaTime open NodaTime
@ -11,45 +12,36 @@ let mutable private lastPurge = Instant.MinValue
/// Lock access to the above /// Lock access to the above
let private locker = obj () let private locker = obj ()
/// Delete a citizen by their ID using the given connection properties /// Delete a citizen by their ID
let private doDeleteById citizenId connProps = backgroundTask { let deleteById citizenId = backgroundTask {
let citId = CitizenId.toString citizenId let citId = CitizenId.toString citizenId
let! _ = do! Custom.nonQuery
connProps $"{Query.Delete.byContains Table.Success};
|> Sql.query $" {Query.Delete.byContains Table.Listing};
DELETE FROM {Table.Success} WHERE data @> @criteria; {Query.Delete.byId Table.Citizen}"
DELETE FROM {Table.Listing} WHERE data @> @criteria; [ "@criteria", Query.jsonbDocParam {| citizenId = citId |}; "@id", Sql.string citId ]
DELETE FROM {Table.Citizen} WHERE id = @id"
|> Sql.parameters [ "@criteria", Sql.jsonb (mkDoc {| citizenId = citId |}); "@id", Sql.string citId ]
|> Sql.executeNonQueryAsync
()
} }
/// Delete a citizen by their ID
let deleteById citizenId =
doDeleteById citizenId (dataSource ())
/// Save a citizen /// Save a citizen
let private saveCitizen (citizen : Citizen) connProps = let private saveCitizen (citizen : Citizen) =
saveDocument Table.Citizen (CitizenId.toString citizen.Id) connProps (mkDoc citizen) save Table.Citizen (CitizenId.toString citizen.Id) citizen
/// Save security information for a citizen /// Save security information for a citizen
let private saveSecurity (security : SecurityInfo) connProps = let saveSecurityInfo (security : SecurityInfo) =
saveDocument Table.SecurityInfo (CitizenId.toString security.Id) connProps (mkDoc security) save Table.SecurityInfo (CitizenId.toString security.Id) security
/// Purge expired tokens /// Purge expired tokens
let private purgeExpiredTokens now = backgroundTask { let private purgeExpiredTokens now = backgroundTask {
let connProps = dataSource ()
let! info = let! info =
Sql.query $"SELECT * FROM {Table.SecurityInfo} WHERE data ->> 'tokenExpires' IS NOT NULL" connProps Custom.list $"{Query.selectFromTable Table.SecurityInfo} WHERE data ->> 'tokenExpires' IS NOT NULL" []
|> Sql.executeAsync toDocument<SecurityInfo> fromData<SecurityInfo>
for expired in info |> List.filter (fun it -> it.TokenExpires.Value < now) do for expired in info |> List.filter (fun it -> it.TokenExpires.Value < now) do
if expired.TokenUsage.Value = "confirm" then if expired.TokenUsage.Value = "confirm" then
// Unconfirmed account; delete the entire thing // Unconfirmed account; delete the entire thing
do! doDeleteById expired.Id connProps do! deleteById expired.Id
else else
// Some other use; just clear the token // 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 /// Check for tokens to purge if it's been more than 10 minutes since we last checked
@ -62,51 +54,39 @@ let private checkForPurge skipCheck =
}) })
/// Find a citizen by their ID /// Find a citizen by their ID
let findById citizenId = backgroundTask { let findById citizenId =
match! dataSource () |> getDocument<Citizen> Table.Citizen (CitizenId.toString citizenId) with Find.byId Table.Citizen (CitizenId.toString citizenId)
| Some c when not c.IsLegacy -> return Some c
| Some _
| None -> return None
}
/// Save a citizen /// Save a citizen
let save 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 /// Register a citizen (saves citizen and security settings); returns false if the e-mail is already taken
let register citizen (security : SecurityInfo) = backgroundTask { let register (citizen : Citizen) (security : SecurityInfo) = backgroundTask {
let connProps = dataSource ()
use conn = Sql.createConnection connProps
use! txn = conn.BeginTransactionAsync ()
try try
do! saveCitizen citizen connProps let! _ =
do! saveSecurity security connProps Configuration.dataSource ()
do! txn.CommitAsync () |> Sql.fromDataSource
|> 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 return true
with with
| :? Npgsql.PostgresException as ex when ex.SqlState = "23505" && ex.ConstraintName = "uk_citizen_email" -> | :? Npgsql.PostgresException as ex when ex.SqlState = "23505" && ex.ConstraintName = "uk_citizen_email" ->
do! txn.RollbackAsync ()
return false return false
} }
/// Try to find the security information matching a confirmation token /// Try to find the security information matching a confirmation token
let private tryConfirmToken (token : string) connProps = backgroundTask { let private tryConfirmToken (token : string) =
let! tryInfo = Find.firstByContains<SecurityInfo> Table.SecurityInfo {| token = token; tokenUsage = "confirm" |}
connProps
|> Sql.query $" SELECT * FROM {Table.SecurityInfo} WHERE data @> @criteria"
|> Sql.parameters [ "criteria", Sql.jsonb (mkDoc {| token = token; tokenUsage = "confirm" |}) ]
|> Sql.executeAsync toDocument<SecurityInfo>
return List.tryHead tryInfo
}
/// Confirm a citizen's account /// Confirm a citizen's account
let confirmAccount token = backgroundTask { let confirmAccount token = backgroundTask {
do! checkForPurge true do! checkForPurge true
let connProps = dataSource () match! tryConfirmToken token with
match! tryConfirmToken token connProps with
| Some info -> | Some info ->
do! saveSecurity { info with AccountLocked = false; Token = None; TokenUsage = None; TokenExpires = None } do! saveSecurityInfo { info with AccountLocked = false; Token = None; TokenUsage = None; TokenExpires = None }
connProps
return true return true
| None -> return false | None -> return false
} }
@ -114,34 +94,27 @@ let confirmAccount token = backgroundTask {
/// Deny a citizen's account (user-initiated; used if someone used their e-mail address without their consent) /// Deny a citizen's account (user-initiated; used if someone used their e-mail address without their consent)
let denyAccount token = backgroundTask { let denyAccount token = backgroundTask {
do! checkForPurge true do! checkForPurge true
let connProps = dataSource () match! tryConfirmToken token with
match! tryConfirmToken token connProps with
| Some info -> | Some info ->
do! doDeleteById info.Id connProps do! deleteById info.Id
return true return true
| None -> return false | None -> return false
} }
/// Attempt a user log on /// Attempt a user log on
let tryLogOn email password (pwVerify : Citizen -> string -> bool option) (pwHash : Citizen -> string -> string) let tryLogOn (email : string) password (pwVerify : Citizen -> string -> bool option)
now = backgroundTask { (pwHash : Citizen -> string -> string) now = backgroundTask {
do! checkForPurge false do! checkForPurge false
let connProps = dataSource () match! Find.firstByContains<Citizen> Table.Citizen {| email = email |} with
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<Citizen>
match List.tryHead tryCitizen with
| Some citizen -> | Some citizen ->
let citizenId = CitizenId.toString citizen.Id let citizenId = CitizenId.toString citizen.Id
let! tryInfo = getDocument<SecurityInfo> Table.SecurityInfo citizenId connProps let! tryInfo = Find.byId<SecurityInfo> Table.SecurityInfo citizenId
let! info = backgroundTask { let! info = backgroundTask {
match 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 }
do! saveSecurity it connProps do! saveSecurityInfo it
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)"
@ -149,129 +122,29 @@ let tryLogOn email password (pwVerify : Citizen -> string -> bool option) (pwHas
match pwVerify citizen password with match pwVerify citizen password with
| Some rehash -> | Some rehash ->
let hash = if rehash then pwHash citizen password else citizen.PasswordHash let hash = if rehash then pwHash citizen password else citizen.PasswordHash
do! saveSecurity { info with FailedLogOnAttempts = 0 } connProps do! saveSecurityInfo { info with FailedLogOnAttempts = 0 }
do! saveCitizen { citizen with LastSeenOn = now; PasswordHash = hash } connProps do! saveCitizen { citizen with LastSeenOn = now; PasswordHash = hash }
return Ok { citizen with LastSeenOn = now } return Ok { citizen with LastSeenOn = now }
| None -> | None ->
let locked = info.FailedLogOnAttempts >= 4 let locked = info.FailedLogOnAttempts >= 4
do! { info with FailedLogOnAttempts = info.FailedLogOnAttempts + 1; AccountLocked = locked } 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 ""}""" 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"
} }
/// Try to retrieve a citizen and their security information by their e-mail address /// Try to retrieve a citizen and their security information by their e-mail address
let tryByEmailWithSecurity email = backgroundTask { let tryByEmailWithSecurity email =
let toCitizenSecurityPair row = (toDocument<Citizen> row, toDocumentFrom<SecurityInfo> "sec_data" row) Custom.single
let! results = $"SELECT c.*, s.data AS sec_data
dataSource () FROM {Table.Citizen} c
|> Sql.query $" INNER JOIN {Table.SecurityInfo} s ON s.id = c.id
SELECT c.*, s.data AS sec_data WHERE c.data @> @criteria"
FROM {Table.Citizen} c [ "@criteria", Query.jsonbDocParam {| email = email |} ]
INNER JOIN {Table.SecurityInfo} s ON s.id = c.id (fun row -> (fromData<Citizen> row, fromDocument<SecurityInfo> "sec_data" row))
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 ())
}
/// Try to retrieve security information by the given token /// Try to retrieve security information by the given token
let trySecurityByToken (token : string) = backgroundTask { let trySecurityByToken (token : string) = backgroundTask {
do! checkForPurge false do! checkForPurge false
let! results = return! Find.firstByContains<SecurityInfo> Table.SecurityInfo {| token = token |}
dataSource ()
|> Sql.query $"SELECT * FROM {Table.SecurityInfo} WHERE data @> @criteria"
|> Sql.parameters [ "@criteria", Sql.jsonb (mkDoc {| token = token |}) ]
|> Sql.executeAsync toDocument<SecurityInfo>
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<Citizen>
}
/// 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<Citizen>
}
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<Profile>
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<Listing>
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<Success>
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
} }

11
src/JobsJobsJobs/Citizens/Domain.fs
View File

@ -151,14 +151,3 @@ type ResetPasswordForm =
/// The new password for the account /// The new password for the account
Password : string Password : string
} }
// ~~~ LEGACY MIGRATION ~~ //
[<CLIMutable; NoComparison; NoEquality>]
type LegacyMigrationForm =
{ /// The ID of the current citizen
Id : string
/// The ID of the legacy citizen to be migrated
LegacyId : string
}

28
src/JobsJobsJobs/Citizens/Handlers.fs
View File

@ -59,13 +59,6 @@ module private Auth =
| PasswordVerificationResult.SuccessRehashNeeded -> Some true | PasswordVerificationResult.SuccessRehashNeeded -> Some true
| _ -> None | _ -> 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 // GET: /citizen/account
let account : HttpHandler = fun next ctx -> task { 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 -> let soLong : HttpHandler = requireUser >=> fun next ctx ->
Views.deletionOptions (csrf ctx) |> render "Account Deletion Options" 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<LegacyMigrationForm> ()
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 open Giraffe.EndpointRouting
@ -369,7 +343,6 @@ let endpoints =
route "/register" register route "/register" register
routef "/reset-password/%s" resetPassword routef "/reset-password/%s" resetPassword
route "/so-long" soLong route "/so-long" soLong
route "/legacy" legacy
] ]
POST [ POST [
route "/delete" delete route "/delete" delete
@ -378,6 +351,5 @@ let endpoints =
route "/register" doRegistration route "/register" doRegistration
route "/reset-password" doResetPassword route "/reset-password" doResetPassword
route "/save-account" saveAccount route "/save-account" saveAccount
route "/legacy/migrate" migrateLegacy
] ]
] ]

4
src/JobsJobsJobs/Citizens/JobsJobsJobs.Citizens.fsproj
View File

@ -16,4 +16,8 @@
<ProjectReference Include="..\Profiles\JobsJobsJobs.Profiles.fsproj" /> <ProjectReference Include="..\Profiles\JobsJobsJobs.Profiles.fsproj" />
</ItemGroup> </ItemGroup>
<ItemGroup>
<PackageReference Update="FSharp.Core" Version="7.0.300" />
</ItemGroup>
</Project> </Project>

51
src/JobsJobsJobs/Citizens/Views.fs
View File

@ -393,54 +393,3 @@ let resetPassword (m : ResetPasswordForm) isHtmx csrf =
jsOnLoad $"jjj.citizen.validatePasswords('{nameof m.Password}', 'ConfirmPassword', true)" isHtmx 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 "&ndash; Select &ndash;" ]
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 "&nbsp;"
]
td [] [ label [ _for $"legacy_{theId}" ] [ str it.Email ] ]
])
|> tbody []
]
]
]
submitButton "content-save-outline" "Migrate Account"
]
|> List.singleton
|> pageWithTitle "Migrate Legacy Account"

75
src/JobsJobsJobs/Common/Cache.fs
View File

@ -35,12 +35,6 @@ module private CacheHelpers =
/// Get the current instant /// Get the current instant
let getNow () = SystemClock.Instance.GetCurrentInstant () let getNow () = SystemClock.Instance.GetCurrentInstant ()
/// Get the first result of the given query
let tryHead<'T> (query : Task<'T list>) = backgroundTask {
let! results = query
return List.tryHead results
}
/// Create a parameter for a non-standard type /// Create a parameter for a non-standard type
let typedParam<'T> name (it : 'T) = let typedParam<'T> name (it : 'T) =
$"@%s{name}", Sql.parameter (NpgsqlParameter ($"@{name}", it)) $"@%s{name}", Sql.parameter (NpgsqlParameter ($"@{name}", it))
@ -56,6 +50,7 @@ module private CacheHelpers =
open System.Threading open System.Threading
open BitBadger.Npgsql.FSharp.Documents
open JobsJobsJobs.Common.Data open JobsJobsJobs.Common.Data
open Microsoft.Extensions.Caching.Distributed open Microsoft.Extensions.Caching.Distributed
@ -69,46 +64,38 @@ type DistributedCache () =
do do
task { task {
let dataSource = dataSource ()
let! exists = let! exists =
dataSource Custom.scalar
|> Sql.query $" $"SELECT EXISTS
SELECT EXISTS
(SELECT 1 FROM pg_tables WHERE schemaname = 'jjj' AND tablename = 'session') (SELECT 1 FROM pg_tables WHERE schemaname = 'jjj' AND tablename = 'session')
AS does_exist" AS does_exist"
|> Sql.executeRowAsync (fun row -> row.bool "does_exist") [] (fun row -> row.bool "does_exist")
if not exists then if not exists then
let! _ = do! Custom.nonQuery
dataSource
|> Sql.query
"CREATE TABLE jjj.session ( "CREATE TABLE jjj.session (
id TEXT NOT NULL PRIMARY KEY, id TEXT NOT NULL PRIMARY KEY,
payload BYTEA NOT NULL, payload BYTEA NOT NULL,
expire_at TIMESTAMPTZ NOT NULL, expire_at TIMESTAMPTZ NOT NULL,
sliding_expiration INTERVAL, sliding_expiration INTERVAL,
absolute_expiration TIMESTAMPTZ); absolute_expiration TIMESTAMPTZ);
CREATE INDEX idx_session_expiration ON jjj.session (expire_at)" CREATE INDEX idx_session_expiration ON jjj.session (expire_at)" []
|> Sql.executeNonQueryAsync
()
} |> sync } |> sync
// ~~~ SUPPORT FUNCTIONS ~~~ // ~~~ SUPPORT FUNCTIONS ~~~
/// Get an entry, updating it for sliding expiration /// Get an entry, updating it for sliding expiration
let getEntry key = backgroundTask { let getEntry key = backgroundTask {
let dataSource = dataSource ()
let idParam = "@id", Sql.string key let idParam = "@id", Sql.string key
let! tryEntry = let! tryEntry =
dataSource Custom.single
|> Sql.query "SELECT * FROM jjj.session WHERE id = @id" "SELECT * FROM jjj.session WHERE id = @id" [ idParam ]
|> Sql.parameters [ idParam ] (fun row ->
|> Sql.executeAsync (fun row -> { Id = row.string "id"
{ Id = row.string "id" Payload = row.bytea "payload"
Payload = row.bytea "payload" ExpireAt = row.fieldValue<Instant> "expire_at"
ExpireAt = row.fieldValue<Instant> "expire_at" SlidingExpiration = row.fieldValueOrNone<Duration> "sliding_expiration"
SlidingExpiration = row.fieldValueOrNone<Duration> "sliding_expiration" AbsoluteExpiration = row.fieldValueOrNone<Instant> "absolute_expiration"
AbsoluteExpiration = row.fieldValueOrNone<Instant> "absolute_expiration" }) })
|> tryHead
match tryEntry with match tryEntry with
| Some entry -> | Some entry ->
let now = getNow () let now = getNow ()
@ -121,12 +108,9 @@ type DistributedCache () =
true, { entry with ExpireAt = absExp } true, { entry with ExpireAt = absExp }
else true, { entry with ExpireAt = now.Plus slideExp } else true, { entry with ExpireAt = now.Plus slideExp }
if needsRefresh then if needsRefresh then
let! _ = do! Custom.nonQuery
dataSource "UPDATE jjj.session SET expire_at = @expireAt WHERE id = @id"
|> Sql.query "UPDATE jjj.session SET expire_at = @expireAt WHERE id = @id" [ expireParam item.ExpireAt; idParam ]
|> Sql.parameters [ expireParam item.ExpireAt; idParam ]
|> Sql.executeNonQueryAsync
()
return if item.ExpireAt > now then Some entry else None return if item.ExpireAt > now then Some entry else None
| None -> return None | None -> return None
} }
@ -138,23 +122,13 @@ type DistributedCache () =
let purge () = backgroundTask { let purge () = backgroundTask {
let now = getNow () let now = getNow ()
if lastPurge.Plus (Duration.FromMinutes 30L) < now then if lastPurge.Plus (Duration.FromMinutes 30L) < now then
let! _ = do! Custom.nonQuery "DELETE FROM jjj.session WHERE expire_at < @expireAt" [ expireParam now ]
dataSource ()
|> Sql.query "DELETE FROM jjj.session WHERE expire_at < @expireAt"
|> Sql.parameters [ expireParam now ]
|> Sql.executeNonQueryAsync
lastPurge <- now lastPurge <- now
} }
/// Remove a cache entry /// Remove a cache entry
let removeEntry key = backgroundTask { let removeEntry key =
let! _ = Custom.nonQuery "DELETE FROM jjj.session WHERE id = @id" [ "@id", Sql.string key ]
dataSource ()
|> Sql.query "DELETE FROM jjj.session WHERE id = @id"
|> Sql.parameters [ "@id", Sql.string key ]
|> Sql.executeNonQueryAsync
()
}
/// Save an entry /// Save an entry
let saveEntry (opts : DistributedCacheEntryOptions) key payload = backgroundTask { let saveEntry (opts : DistributedCacheEntryOptions) key payload = backgroundTask {
@ -173,9 +147,7 @@ type DistributedCache () =
// Default to 1 hour sliding expiration // Default to 1 hour sliding expiration
let slide = Duration.FromHours 1 let slide = Duration.FromHours 1
now.Plus slide, Some slide, None now.Plus slide, Some slide, None
let! _ = do! Custom.nonQuery
dataSource ()
|> Sql.query
"INSERT INTO jjj.session ( "INSERT INTO jjj.session (
id, payload, expire_at, sliding_expiration, absolute_expiration id, payload, expire_at, sliding_expiration, absolute_expiration
) VALUES ( ) VALUES (
@ -185,14 +157,11 @@ type DistributedCache () =
expire_at = EXCLUDED.expire_at, expire_at = EXCLUDED.expire_at,
sliding_expiration = EXCLUDED.sliding_expiration, sliding_expiration = EXCLUDED.sliding_expiration,
absolute_expiration = EXCLUDED.absolute_expiration" absolute_expiration = EXCLUDED.absolute_expiration"
|> Sql.parameters
[ "@id", Sql.string key [ "@id", Sql.string key
"@payload", Sql.bytea payload "@payload", Sql.bytea payload
expireParam expireAt expireParam expireAt
optParam "slideExp" slideExp optParam "slideExp" slideExp
optParam "absExp" absExp ] optParam "absExp" absExp ]
|> Sql.executeNonQueryAsync
()
} }
// ~~~ IMPLEMENTATION FUNCTIONS ~~~ // ~~~ IMPLEMENTATION FUNCTIONS ~~~

143
src/JobsJobsJobs/Common/Data.fs
View File

@ -29,80 +29,63 @@ module Table =
let Success = "jjj.success" let Success = "jjj.success"
open BitBadger.Npgsql.FSharp.Documents
open Npgsql.FSharp open Npgsql.FSharp
/// Connection management for the document store /// Connection management for the document store
[<AutoOpen>] [<AutoOpen>]
module DataConnection = module DataConnection =
open System.Text.Json
open BitBadger.Npgsql.Documents
open JobsJobsJobs
open Microsoft.Extensions.Configuration open Microsoft.Extensions.Configuration
open Npgsql 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"
/// Create tables /// Create tables
let private createTables () = backgroundTask { let private createTables () = backgroundTask {
let sql = [ do! Custom.nonQuery "CREATE SCHEMA IF NOT EXISTS jjj" []
"CREATE SCHEMA IF NOT EXISTS jjj" do! Definition.ensureTable Table.Citizen
// Tables do! Definition.ensureTable Table.Continent
$"CREATE TABLE IF NOT EXISTS {Table.Citizen} (id TEXT NOT NULL PRIMARY KEY, data JSONB NOT NULL)" do! Definition.ensureTable Table.Listing
$"CREATE TABLE IF NOT EXISTS {Table.Continent} (id TEXT NOT NULL PRIMARY KEY, data JSONB NOT NULL)" do! Definition.ensureTable Table.Success
$"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, key indexes, and text search index
$"CREATE TABLE IF NOT EXISTS {Table.Profile} (id TEXT NOT NULL PRIMARY KEY, data JSONB NOT NULL, do! Custom.nonQuery
text_search TSVECTOR NOT NULL, $"CREATE TABLE IF NOT EXISTS {Table.Profile}
CONSTRAINT fk_profile_citizen FOREIGN KEY (id) REFERENCES {Table.Citizen} (id) ON DELETE CASCADE)" (id TEXT NOT NULL PRIMARY KEY, data JSONB NOT NULL, text_search TSVECTOR NOT NULL,
$"CREATE TABLE IF NOT EXISTS {Table.SecurityInfo} (id TEXT NOT NULL PRIMARY KEY, data JSONB NOT NULL, CONSTRAINT fk_profile_citizen FOREIGN KEY (id) REFERENCES {Table.Citizen} (id) ON DELETE CASCADE);
CONSTRAINT fk_security_info_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,
$"CREATE TABLE IF NOT EXISTS {Table.Success} (id TEXT NOT NULL PRIMARY KEY, data JSONB NOT NULL)" CONSTRAINT fk_security_info_citizen
// Key indexes FOREIGN KEY (id) REFERENCES {Table.Citizen} (id) ON DELETE CASCADE);
$"CREATE UNIQUE INDEX IF NOT EXISTS uk_citizen_email ON {Table.Citizen} ((data -> 'email'))" CREATE UNIQUE INDEX IF NOT EXISTS uk_citizen_email ON {Table.Citizen} ((data -> 'email'));
$"CREATE INDEX IF NOT EXISTS idx_listing_citizen ON {Table.Listing} ((data -> 'citizenId'))" CREATE INDEX IF NOT EXISTS idx_listing_citizen ON {Table.Listing} ((data -> 'citizenId'));
$"CREATE INDEX IF NOT EXISTS idx_listing_continent ON {Table.Listing} ((data -> 'continentId'))" CREATE INDEX IF NOT EXISTS idx_listing_continent ON {Table.Listing} ((data -> 'continentId'));
$"CREATE INDEX IF NOT EXISTS idx_profile_continent ON {Table.Profile} ((data -> 'continentId'))" CREATE INDEX IF NOT EXISTS idx_profile_continent ON {Table.Profile} ((data -> 'continentId'));
$"CREATE INDEX IF NOT EXISTS idx_success_citizen ON {Table.Success} ((data -> 'citizenId'))" CREATE INDEX IF NOT EXISTS idx_success_citizen ON {Table.Success} ((data -> 'citizenId'));
// Profile text search index CREATE INDEX IF NOT EXISTS idx_profile_search ON {Table.Profile} USING GIN(text_search)"
$"CREATE INDEX IF NOT EXISTS idx_profile_search ON {Table.Profile} USING GIN(text_search)" []
]
let! _ =
dataSource ()
|> Sql.executeTransactionAsync (sql |> List.map (fun sql -> sql, [ [] ]))
()
} }
/// Create functions and triggers required to /// Create functions and triggers required to keep the search index current
let createTriggers () = backgroundTask { let private createTriggers () = backgroundTask {
let! functions = let! functions =
dataSource () Custom.list
|> Sql.query
"SELECT p.proname "SELECT p.proname
FROM pg_catalog.pg_proc p FROM pg_catalog.pg_proc p
LEFT JOIN pg_catalog.pg_namespace n ON n.oid = p.pronamespace LEFT JOIN pg_catalog.pg_namespace n ON n.oid = p.pronamespace
WHERE n.nspname = 'jjj'" WHERE n.nspname = 'jjj'"
|> Sql.executeAsync (fun row -> row.string "proname") [] (fun row -> row.string "proname")
if not (functions |> List.contains "indexable_array_string") then if not (functions |> List.contains "indexable_array_string") then
let! _ = do! Custom.nonQuery
dataSource () """CREATE FUNCTION jjj.indexable_array_string(target jsonb, path jsonpath) RETURNS text AS $$
|> Sql.query """
CREATE FUNCTION jjj.indexable_array_string(target jsonb, path jsonpath) RETURNS text AS $$
BEGIN BEGIN
RETURN REPLACE(REPLACE(REPLACE(REPLACE(jsonb_path_query_array(target, path)::text, RETURN REPLACE(REPLACE(REPLACE(REPLACE(jsonb_path_query_array(target, path)::text,
'["', ''), '", "', ' '), '"]', ''), '[]', ''); '["', ''), '", "', ' '), '"]', ''), '[]', '');
END; END;
$$ LANGUAGE plpgsql;""" $$ LANGUAGE plpgsql;""" []
|> Sql.executeNonQueryAsync
()
if not (functions |> List.contains "set_text_search") then if not (functions |> List.contains "set_text_search") then
let! _ = do! Custom.nonQuery
dataSource () $"CREATE FUNCTION jjj.set_text_search() RETURNS trigger AS $$
|> Sql.query $"
CREATE FUNCTION jjj.set_text_search() RETURNS trigger AS $$
BEGIN BEGIN
NEW.text_search := to_tsvector('english', NEW.text_search := to_tsvector('english',
COALESCE(NEW.data ->> 'region', '') || ' ' COALESCE(NEW.data ->> 'region', '') || ' '
@ -116,73 +99,33 @@ module DataConnection =
END; END;
$$ LANGUAGE plpgsql; $$ LANGUAGE plpgsql;
CREATE TRIGGER set_text_search BEFORE INSERT OR UPDATE ON {Table.Profile} CREATE TRIGGER set_text_search BEFORE INSERT OR UPDATE ON {Table.Profile}
FOR EACH ROW EXECUTE FUNCTION jjj.set_text_search();" FOR EACH ROW EXECUTE FUNCTION jjj.set_text_search();" []
|> Sql.executeNonQueryAsync
()
} }
/// Set up the data connection from the given configuration /// Set up the data connection from the given configuration
let setUp (cfg : IConfiguration) = backgroundTask { let setUp (cfg : IConfiguration) = backgroundTask {
let builder = NpgsqlDataSourceBuilder (cfg.GetConnectionString "PostgreSQL") let builder = NpgsqlDataSourceBuilder (cfg.GetConnectionString "PostgreSQL")
let _ = builder.UseNodaTime () let _ = builder.UseNodaTime ()
theDataSource <- Some (builder.Build ()) Configuration.useDataSource (builder.Build ())
Configuration.useSerializer
{ new IDocumentSerializer with
member _.Serialize<'T> (it : 'T) = JsonSerializer.Serialize (it, Json.options)
member _.Deserialize<'T> (it : string) = JsonSerializer.Deserialize<'T> (it, Json.options)
}
do! createTables () do! createTables ()
do! createTriggers () 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 /// Create a match-anywhere clause for a LIKE or ILIKE clause
let like value = let like value =
Sql.string $"%%%s{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 /// Get the SQL for a search WHERE clause
let searchSql criteria = let searchSql criteria =
let sql = criteria |> List.map fst |> String.concat " AND " let sql = criteria |> List.map fst |> String.concat " AND "
if sql = "" then "" else $"AND {sql}" if sql = "" then "" else $"AND {sql}"
/// Continent data access functions /// Continent data access functions
[<RequireQualifiedAccess>] [<RequireQualifiedAccess>]
module Continents = module Continents =
@ -191,10 +134,8 @@ module Continents =
/// Retrieve all continents /// Retrieve all continents
let all () = let all () =
dataSource () Custom.list $"{Query.selectFromTable Table.Continent} ORDER BY data ->> 'name'" [] fromData<Continent>
|> Sql.query $"SELECT * FROM {Table.Continent} ORDER BY data ->> 'name'"
|> Sql.executeAsync toDocument<Continent>
/// Retrieve a continent by its ID /// Retrieve a continent by its ID
let findById continentId = let findById continentId =
dataSource () |> getDocument<Continent> Table.Continent (ContinentId.toString continentId) Find.byId<Continent> Table.Continent (ContinentId.toString continentId)

12
src/JobsJobsJobs/Common/Domain.fs
View File

@ -249,9 +249,6 @@ type Citizen =
/// The other contacts for this user /// The other contacts for this user
OtherContacts : OtherContact list OtherContacts : OtherContact list
/// Whether this is a legacy citizen
IsLegacy : bool
} }
/// Support functions for citizens /// Support functions for citizens
@ -268,7 +265,6 @@ module Citizen =
PasswordHash = "" PasswordHash = ""
DisplayName = None DisplayName = None
OtherContacts = [] OtherContacts = []
IsLegacy = false
} }
/// Get the name of the citizen (either their preferred display name or first/last names) /// 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? /// Was this job filled as part of its appearance on Jobs, Jobs, Jobs?
WasFilledHere : bool option WasFilledHere : bool option
/// Whether this is a legacy listing
IsLegacy : bool
} }
/// Support functions for job listings /// Support functions for job listings
@ -356,7 +349,6 @@ module Listing =
Text = Text "" Text = Text ""
NeededBy = None NeededBy = None
WasFilledHere = None WasFilledHere = None
IsLegacy = false
} }
@ -434,9 +426,6 @@ type Profile =
/// When the citizen last updated their profile /// When the citizen last updated their profile
LastUpdatedOn : Instant LastUpdatedOn : Instant
/// Whether this is a legacy profile
IsLegacy : bool
} }
/// Support functions for Profiles /// Support functions for Profiles
@ -456,7 +445,6 @@ module Profile =
Experience = None Experience = None
Visibility = Private Visibility = Private
LastUpdatedOn = Instant.MinValue LastUpdatedOn = Instant.MinValue
IsLegacy = false
} }

16
src/JobsJobsJobs/Common/JobsJobsJobs.Common.fsproj
View File

@ -15,17 +15,19 @@
</ItemGroup> </ItemGroup>
<ItemGroup> <ItemGroup>
<PackageReference Include="FSharp.SystemTextJson" Version="1.0.7" /> <PackageReference Include="BitBadger.Npgsql.FSharp.Documents" Version="1.0.0-beta3" />
<PackageReference Include="FSharp.SystemTextJson" Version="1.1.23" />
<PackageReference Include="Giraffe" Version="6.0.0" /> <PackageReference Include="Giraffe" Version="6.0.0" />
<PackageReference Include="Giraffe.Htmx" Version="1.8.5" /> <PackageReference Include="Giraffe.Htmx" Version="1.9.2" />
<PackageReference Include="Giraffe.ViewEngine" Version="1.4.0" /> <PackageReference Include="Giraffe.ViewEngine" Version="1.4.0" />
<PackageReference Include="Giraffe.ViewEngine.Htmx" Version="1.8.5" /> <PackageReference Include="Giraffe.ViewEngine.Htmx" Version="1.9.2" />
<PackageReference Include="MailKit" Version="3.3.0" /> <PackageReference Include="MailKit" Version="4.1.0" />
<PackageReference Include="Markdig" Version="0.30.4" /> <PackageReference Include="Markdig" Version="0.31.0" />
<PackageReference Include="NodaTime.Serialization.JsonNet" Version="3.0.0" /> <PackageReference Include="NodaTime.Serialization.JsonNet" Version="3.0.0" />
<PackageReference Include="NodaTime.Serialization.SystemTextJson" Version="1.0.0" /> <PackageReference Include="NodaTime.Serialization.SystemTextJson" Version="1.0.0" />
<PackageReference Include="Npgsql.FSharp" Version="5.6.0" /> <PackageReference Include="Npgsql.FSharp" Version="5.7.0" />
<PackageReference Include="Npgsql.NodaTime" Version="7.0.1" /> <PackageReference Include="Npgsql.NodaTime" Version="7.0.4" />
<PackageReference Update="FSharp.Core" Version="7.0.300" />
</ItemGroup> </ItemGroup>
</Project> </Project>

4
src/JobsJobsJobs/Directory.Build.props
View File

@ -4,7 +4,7 @@
<Nullable>enable</Nullable> <Nullable>enable</Nullable>
<DebugType>embedded</DebugType> <DebugType>embedded</DebugType>
<GenerateDocumentationFile>false</GenerateDocumentationFile> <GenerateDocumentationFile>false</GenerateDocumentationFile>
<AssemblyVersion>3.0.2.0</AssemblyVersion> <AssemblyVersion>3.1.0.0</AssemblyVersion>
<FileVersion>3.0.2.0</FileVersion> <FileVersion>3.1.0.0</FileVersion>
</PropertyGroup> </PropertyGroup>
</Project> </Project>

4
src/JobsJobsJobs/Home/JobsJobsJobs.Home.fsproj
View File

@ -13,4 +13,8 @@
<ProjectReference Include="..\Common\JobsJobsJobs.Common.fsproj" /> <ProjectReference Include="..\Common\JobsJobsJobs.Common.fsproj" />
</ItemGroup> </ItemGroup>
<ItemGroup>
<PackageReference Update="FSharp.Core" Version="7.0.300" />
</ItemGroup>
</Project> </Project>

52
src/JobsJobsJobs/Listings/Data.fs
View File

@ -1,5 +1,6 @@
module JobsJobsJobs.Listings.Data module JobsJobsJobs.Listings.Data
open BitBadger.Npgsql.FSharp.Documents
open JobsJobsJobs.Common.Data open JobsJobsJobs.Common.Data
open JobsJobsJobs.Domain open JobsJobsJobs.Domain
open JobsJobsJobs.Listings.Domain open JobsJobsJobs.Listings.Domain
@ -14,57 +15,46 @@ let viewSql =
/// Map a result for a listing view /// Map a result for a listing view
let private toListingForView row = let private toListingForView row =
{ Listing = toDocument<Listing> row { Listing = fromData<Listing> row
ContinentName = row.string "continent_name" ContinentName = row.string "continent_name"
Citizen = toDocumentFrom<Citizen> "cit_data" row Citizen = fromDocument<Citizen> "cit_data" row
} }
/// Find all job listings posted by the given citizen /// Find all job listings posted by the given citizen
let findByCitizen citizenId = let findByCitizen citizenId =
dataSource () Custom.list<ListingForView>
|> Sql.query $"{viewSql} WHERE l.data @> @criteria" $"{viewSql} WHERE l.data @> @criteria"
|> Sql.parameters [ "@criteria", Query.jsonbDocParam {| citizenId = CitizenId.toString citizenId |} ]
[ "@criteria", Sql.jsonb (mkDoc {| citizenId = CitizenId.toString citizenId; isLegacy = false |}) ] toListingForView
|> Sql.executeAsync toListingForView
/// Find a listing by its ID /// Find a listing by its ID
let findById listingId = backgroundTask { let findById listingId =
match! dataSource () |> getDocument<Listing> Table.Listing (ListingId.toString listingId) with Find.byId<Listing> Table.Listing (ListingId.toString listingId)
| Some listing when not listing.IsLegacy -> return Some listing
| Some _
| None -> return None
}
/// 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 =
let! tryListing = Custom.single<ListingForView>
dataSource () $"{viewSql} WHERE l.id = @id" [ "@id", Sql.string (ListingId.toString listingId) ] toListingForView
|> 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
}
/// Save a listing /// Save a listing
let save (listing : 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 /// Search job listings
let search (search : ListingSearchForm) = let search (search : ListingSearchForm) =
let searches = [ let searches = [
if search.ContinentId <> "" then 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 if search.Region <> "" then
"l.data ->> 'region' ILIKE @region", [ "@region", like search.Region ] "l.data ->> 'region' ILIKE @region", [ "@region", like search.Region ]
if search.RemoteWork <> "" then 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 if search.Text <> "" then
"l.data ->> 'text' ILIKE @text", [ "@text", like search.Text ] "l.data ->> 'text' ILIKE @text", [ "@text", like search.Text ]
] ]
dataSource () Custom.list<ListingForView>
|> Sql.query $""" $"""{viewSql}
{viewSql} WHERE l.data @> '{{ "isExpired": false }}'::jsonb
WHERE l.data @> '{{ "isExpired": false, "isLegacy": false }}'::jsonb {searchSql searches}"""
{searchSql searches}""" (searches |> List.collect snd)
|> Sql.parameters (searches |> List.collect snd) toListingForView
|> Sql.executeAsync toListingForView

1
src/JobsJobsJobs/Listings/Handlers.fs
View File

@ -96,7 +96,6 @@ let save : HttpHandler = requireUser >=> validateCsrf >=> fun next ctx -> task {
CreatedOn = now CreatedOn = now
IsExpired = false IsExpired = false
WasFilledHere = None WasFilledHere = None
IsLegacy = false
} }
| _ -> return! Data.findById (ListingId.ofString form.Id) | _ -> return! Data.findById (ListingId.ofString form.Id)
} }

4
src/JobsJobsJobs/Listings/JobsJobsJobs.Listings.fsproj
View File

@ -16,4 +16,8 @@
<ProjectReference Include="..\SuccessStories\JobsJobsJobs.SuccessStories.fsproj" /> <ProjectReference Include="..\SuccessStories\JobsJobsJobs.SuccessStories.fsproj" />
</ItemGroup> </ItemGroup>
<ItemGroup>
<PackageReference Update="FSharp.Core" Version="7.0.300" />
</ItemGroup>
</Project> </Project>

83
src/JobsJobsJobs/Profiles/Data.fs
View File

@ -1,5 +1,6 @@
module JobsJobsJobs.Profiles.Data module JobsJobsJobs.Profiles.Data
open BitBadger.Npgsql.FSharp.Documents
open JobsJobsJobs.Common.Data open JobsJobsJobs.Common.Data
open JobsJobsJobs.Domain open JobsJobsJobs.Domain
open JobsJobsJobs.Profiles.Domain open JobsJobsJobs.Profiles.Domain
@ -7,83 +8,63 @@ open Npgsql.FSharp
/// Count the current profiles /// Count the current profiles
let count () = let count () =
dataSource () Count.all Table.Profile
|> Sql.query
$"""SELECT COUNT(id) AS the_count FROM {Table.Profile} WHERE data @> '{{ "isLegacy": false }}'::jsonb"""
|> 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 =
let! _ = Delete.byId Table.Profile (CitizenId.toString citizenId)
dataSource ()
|> Sql.query $"DELETE FROM {Table.Profile} WHERE id = @id"
|> Sql.parameters [ "@id", Sql.string (CitizenId.toString citizenId) ]
|> Sql.executeNonQueryAsync
()
}
/// Find a profile by citizen ID /// Find a profile by citizen ID
let findById citizenId = backgroundTask { let findById citizenId =
match! dataSource () |> getDocument<Profile> Table.Profile (CitizenId.toString citizenId) with Find.byId<Profile> Table.Profile (CitizenId.toString citizenId)
| Some profile when not profile.IsLegacy -> return Some profile
| Some _
| None -> return None
}
/// Convert a data row to a profile for viewing /// Convert a data row to a profile for viewing
let private toProfileForView row = let private toProfileForView row =
{ Profile = toDocument<Profile> row { Profile = fromData<Profile> row
Citizen = toDocumentFrom<Citizen> "cit_data" row Citizen = fromDocument<Citizen> "cit_data" row
Continent = toDocumentFrom<Continent> "cont_data" row Continent = fromDocument<Continent> "cont_data" row
} }
/// Find a profile by citizen ID for viewing (includes citizen and continent information) /// Find a profile by citizen ID for viewing (includes citizen and continent information)
let findByIdForView citizenId = backgroundTask { let findByIdForView citizenId =
let! tryCitizen = Custom.single<ProfileForView>
dataSource () $"SELECT p.*, c.data AS cit_data, o.data AS cont_data
|> Sql.query $""" FROM {Table.Profile} p
SELECT p.*, c.data AS cit_data, o.data AS cont_data INNER JOIN {Table.Citizen} c ON c.id = p.id
FROM {Table.Profile} p INNER JOIN {Table.Continent} o ON o.id = p.data ->> 'continentId'
INNER JOIN {Table.Citizen} c ON c.id = p.id WHERE p.id = @id"
INNER JOIN {Table.Continent} o ON o.id = p.data ->> 'continentId' [ "@id", Sql.string (CitizenId.toString citizenId) ]
WHERE p.id = @id toProfileForView
AND p.data @> '{{ "isLegacy": false }}'::jsonb"""
|> Sql.parameters [ "@id", Sql.string (CitizenId.toString citizenId) ]
|> Sql.executeAsync toProfileForView
return List.tryHead tryCitizen
}
/// Save a profile /// Save a profile
let save (profile : 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 /// Search profiles
let search (search : ProfileSearchForm) isPublic = backgroundTask { let search (search : ProfileSearchForm) isPublic = backgroundTask {
let searches = [ let searches = [
if search.ContinentId <> "" then 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 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 if search.Text <> "" then
"p.text_search @@ plainto_tsquery(@text_search)", [ "@text_search", Sql.string search.Text ] "p.text_search @@ plainto_tsquery(@text_search)", [ "@text_search", Sql.string search.Text ]
] ]
let vizSql = let vizSql =
if isPublic then if isPublic then
sprintf "(p.data @> '%s'::jsonb OR p.data @> '%s'::jsonb)" sprintf "(p.data @> '%s'::jsonb OR p.data @> '%s'::jsonb)"
(mkDoc {| visibility = ProfileVisibility.toString Public |}) (Configuration.serializer().Serialize {| visibility = ProfileVisibility.toString Public |})
(mkDoc {| visibility = ProfileVisibility.toString Anonymous |}) (Configuration.serializer().Serialize {| visibility = ProfileVisibility.toString Anonymous |})
else sprintf "p.data ->> 'visibility' <> '%s'" (ProfileVisibility.toString Hidden) else sprintf "p.data ->> 'visibility' <> '%s'" (ProfileVisibility.toString Hidden)
let! results = let! results =
dataSource () Custom.list<ProfileForView>
|> Sql.query $""" $" SELECT p.*, c.data AS cit_data, o.data AS cont_data
SELECT p.*, c.data AS cit_data, o.data AS cont_data FROM {Table.Profile} p
FROM {Table.Profile} p INNER JOIN {Table.Citizen} c ON c.id = p.id
INNER JOIN {Table.Citizen} c ON c.id = p.id INNER JOIN {Table.Continent} o ON o.id = p.data ->> 'continentId'
INNER JOIN {Table.Continent} o ON o.id = p.data ->> 'continentId' WHERE {vizSql}
WHERE p.data @> '{{ "isLegacy": false }}'::jsonb {searchSql searches}"
AND {vizSql} (searches |> List.collect snd)
{searchSql searches}""" toProfileForView
|> Sql.parameters (searches |> List.collect snd)
|> Sql.executeAsync toProfileForView
return results |> List.sortBy (fun pfv -> (Citizen.name pfv.Citizen).ToLowerInvariant ()) return results |> List.sortBy (fun pfv -> (Citizen.name pfv.Citizen).ToLowerInvariant ())
} }

4
src/JobsJobsJobs/Profiles/JobsJobsJobs.Profiles.fsproj
View File

@ -15,4 +15,8 @@
<ProjectReference Include="..\Common\JobsJobsJobs.Common.fsproj" /> <ProjectReference Include="..\Common\JobsJobsJobs.Common.fsproj" />
</ItemGroup> </ItemGroup>
<ItemGroup>
<PackageReference Update="FSharp.Core" Version="7.0.300" />
</ItemGroup>
</Project> </Project>

38
src/JobsJobsJobs/SuccessStories/Data.fs
View File

@ -1,33 +1,33 @@
module JobsJobsJobs.SuccessStories.Data module JobsJobsJobs.SuccessStories.Data
open BitBadger.Npgsql.FSharp.Documents
open JobsJobsJobs.Common.Data open JobsJobsJobs.Common.Data
open JobsJobsJobs.Domain open JobsJobsJobs.Domain
open JobsJobsJobs.SuccessStories.Domain open JobsJobsJobs.SuccessStories.Domain
open Npgsql.FSharp
// Retrieve all success stories // Retrieve all success stories
let all () = let all () =
dataSource () Custom.list<StoryEntry>
|> Sql.query $" $" SELECT s.*, c.data AS cit_data
SELECT s.*, c.data AS cit_data FROM {Table.Success} s
FROM {Table.Success} s INNER JOIN {Table.Citizen} c ON c.id = s.data ->> 'citizenId'
INNER JOIN {Table.Citizen} c ON c.id = s.data ->> 'citizenId' ORDER BY s.data ->> 'recordedOn' DESC"
ORDER BY s.data ->> 'recordedOn' DESC" []
|> Sql.executeAsync (fun row -> (fun row ->
let success = toDocument<Success> row let success = fromData<Success> row
let citizen = toDocumentFrom<Citizen> "cit_data" row let citizen = fromDocument<Citizen> "cit_data" row
{ Id = success.Id { Id = success.Id
CitizenId = success.CitizenId CitizenId = success.CitizenId
CitizenName = Citizen.name citizen CitizenName = Citizen.name citizen
RecordedOn = success.RecordedOn RecordedOn = success.RecordedOn
FromHere = success.IsFromHere FromHere = success.IsFromHere
HasStory = Option.isSome success.Story HasStory = Option.isSome success.Story
}) })
/// Find a success story by its ID /// Find a success story by its ID
let findById successId = let findById successId =
dataSource () |> getDocument<Success> Table.Success (SuccessId.toString successId) Find.byId<Success> Table.Success (SuccessId.toString successId)
/// Save a success story /// Save a success story
let save (success : Success) = let save (success : Success) =
(dataSource (), mkDoc success) ||> saveDocument Table.Success (SuccessId.toString success.Id) save Table.Success (SuccessId.toString success.Id) success

4
src/JobsJobsJobs/SuccessStories/JobsJobsJobs.SuccessStories.fsproj
View File

@ -17,4 +17,8 @@
<ProjectReference Include="..\Profiles\JobsJobsJobs.Profiles.fsproj" /> <ProjectReference Include="..\Profiles\JobsJobsJobs.Profiles.fsproj" />
</ItemGroup> </ItemGroup>
<ItemGroup>
<PackageReference Update="FSharp.Core" Version="7.0.300" />
</ItemGroup>
</Project> </Project>