diff --git a/build.fsx.lock b/build.fsx.lock index 3d3a148..36b916f 100644 --- a/build.fsx.lock +++ b/build.fsx.lock @@ -5,95 +5,95 @@ NUGET BlackFox.VsWhere (1.1) FSharp.Core (>= 4.2.3) Microsoft.Win32.Registry (>= 4.7) - Fake.Core.CommandLineParsing (5.22) + Fake.Core.CommandLineParsing (5.23) FParsec (>= 1.1.1) FSharp.Core (>= 6.0) - Fake.Core.Context (5.22) + Fake.Core.Context (5.23) FSharp.Core (>= 6.0) - Fake.Core.Environment (5.22) + Fake.Core.Environment (5.23) FSharp.Core (>= 6.0) - Fake.Core.FakeVar (5.22) - Fake.Core.Context (>= 5.22) + Fake.Core.FakeVar (5.23) + Fake.Core.Context (>= 5.23) FSharp.Core (>= 6.0) - Fake.Core.Process (5.22) - Fake.Core.Environment (>= 5.22) - Fake.Core.FakeVar (>= 5.22) - Fake.Core.String (>= 5.22) - Fake.Core.Trace (>= 5.22) - Fake.IO.FileSystem (>= 5.22) + Fake.Core.Process (5.23) + Fake.Core.Environment (>= 5.23) + Fake.Core.FakeVar (>= 5.23) + Fake.Core.String (>= 5.23) + Fake.Core.Trace (>= 5.23) + Fake.IO.FileSystem (>= 5.23) FSharp.Core (>= 6.0) System.Collections.Immutable (>= 5.0) - Fake.Core.SemVer (5.22) + Fake.Core.SemVer (5.23) FSharp.Core (>= 6.0) - Fake.Core.String (5.22) + Fake.Core.String (5.23) FSharp.Core (>= 6.0) - Fake.Core.Target (5.22) - Fake.Core.CommandLineParsing (>= 5.22) - Fake.Core.Context (>= 5.22) - Fake.Core.Environment (>= 5.22) - Fake.Core.FakeVar (>= 5.22) - Fake.Core.Process (>= 5.22) - Fake.Core.String (>= 5.22) - Fake.Core.Trace (>= 5.22) + Fake.Core.Target (5.23) + Fake.Core.CommandLineParsing (>= 5.23) + Fake.Core.Context (>= 5.23) + Fake.Core.Environment (>= 5.23) + Fake.Core.FakeVar (>= 5.23) + Fake.Core.Process (>= 5.23) + Fake.Core.String (>= 5.23) + Fake.Core.Trace (>= 5.23) FSharp.Control.Reactive (>= 5.0.2) FSharp.Core (>= 6.0) - Fake.Core.Tasks (5.22) - Fake.Core.Trace (>= 5.22) + Fake.Core.Tasks (5.23) + Fake.Core.Trace (>= 5.23) FSharp.Core (>= 6.0) - Fake.Core.Trace (5.22) - Fake.Core.Environment (>= 5.22) - Fake.Core.FakeVar (>= 5.22) + Fake.Core.Trace (5.23) + Fake.Core.Environment (>= 5.23) + Fake.Core.FakeVar (>= 5.23) FSharp.Core (>= 6.0) - Fake.Core.Xml (5.22) - Fake.Core.String (>= 5.22) + Fake.Core.Xml (5.23) + Fake.Core.String (>= 5.23) FSharp.Core (>= 6.0) - Fake.DotNet.Cli (5.22) - Fake.Core.Environment (>= 5.22) - Fake.Core.Process (>= 5.22) - Fake.Core.String (>= 5.22) - Fake.Core.Trace (>= 5.22) - Fake.DotNet.MSBuild (>= 5.22) - Fake.DotNet.NuGet (>= 5.22) - Fake.IO.FileSystem (>= 5.22) + Fake.DotNet.Cli (5.23) + Fake.Core.Environment (>= 5.23) + Fake.Core.Process (>= 5.23) + Fake.Core.String (>= 5.23) + Fake.Core.Trace (>= 5.23) + Fake.DotNet.MSBuild (>= 5.23) + Fake.DotNet.NuGet (>= 5.23) + Fake.IO.FileSystem (>= 5.23) FSharp.Core (>= 6.0) Mono.Posix.NETStandard (>= 1.0) Newtonsoft.Json (>= 13.0.1) - Fake.DotNet.MSBuild (5.22) + Fake.DotNet.MSBuild (5.23) BlackFox.VsWhere (>= 1.1) - Fake.Core.Environment (>= 5.22) - Fake.Core.Process (>= 5.22) - Fake.Core.String (>= 5.22) - Fake.Core.Trace (>= 5.22) - Fake.IO.FileSystem (>= 5.22) + Fake.Core.Environment (>= 5.23) + Fake.Core.Process (>= 5.23) + Fake.Core.String (>= 5.23) + Fake.Core.Trace (>= 5.23) + Fake.IO.FileSystem (>= 5.23) FSharp.Core (>= 6.0) MSBuild.StructuredLogger (>= 2.1.545) - Fake.DotNet.NuGet (5.22) - Fake.Core.Environment (>= 5.22) - Fake.Core.Process (>= 5.22) - Fake.Core.SemVer (>= 5.22) - Fake.Core.String (>= 5.22) - Fake.Core.Tasks (>= 5.22) - Fake.Core.Trace (>= 5.22) - Fake.Core.Xml (>= 5.22) - Fake.IO.FileSystem (>= 5.22) - Fake.Net.Http (>= 5.22) + Fake.DotNet.NuGet (5.23) + Fake.Core.Environment (>= 5.23) + Fake.Core.Process (>= 5.23) + Fake.Core.SemVer (>= 5.23) + Fake.Core.String (>= 5.23) + Fake.Core.Tasks (>= 5.23) + Fake.Core.Trace (>= 5.23) + Fake.Core.Xml (>= 5.23) + Fake.IO.FileSystem (>= 5.23) + Fake.Net.Http (>= 5.23) FSharp.Core (>= 6.0) Newtonsoft.Json (>= 13.0.1) NuGet.Protocol (>= 5.11) - Fake.IO.FileSystem (5.22) - Fake.Core.String (>= 5.22) + Fake.IO.FileSystem (5.23) + Fake.Core.String (>= 5.23) FSharp.Core (>= 6.0) - Fake.JavaScript.Npm (5.22) - Fake.Core.Environment (>= 5.22) - Fake.Core.Process (>= 5.22) - Fake.IO.FileSystem (>= 5.22) - Fake.Testing.Common (>= 5.22) + Fake.JavaScript.Npm (5.23) + Fake.Core.Environment (>= 5.23) + Fake.Core.Process (>= 5.23) + Fake.IO.FileSystem (>= 5.23) + Fake.Testing.Common (>= 5.23) FSharp.Core (>= 6.0) - Fake.Net.Http (5.22) - Fake.Core.Trace (>= 5.22) + Fake.Net.Http (5.23) + Fake.Core.Trace (>= 5.23) FSharp.Core (>= 6.0) - Fake.Testing.Common (5.22) - Fake.Core.Trace (>= 5.22) + Fake.Testing.Common (5.23) + Fake.Core.Trace (>= 5.23) FSharp.Core (>= 6.0) FParsec (1.1.1) FSharp.Core (>= 4.3.4) @@ -112,9 +112,8 @@ NUGET System.Text.Encoding.CodePages (>= 4.0.1) - restriction: || (== net6.0) (&& (== netstandard2.0) (>= net6.0)) System.Text.Json (>= 6.0) - restriction: || (== net6.0) (&& (== netstandard2.0) (>= net472)) (&& (== netstandard2.0) (>= net6.0)) System.Threading.Tasks.Dataflow (>= 6.0) - restriction: || (== net6.0) (&& (== netstandard2.0) (>= net472)) (&& (== netstandard2.0) (>= net6.0)) - Microsoft.Build.Framework (17.2) - Microsoft.Win32.Registry (>= 4.3) - System.Security.Permissions (>= 4.7) + Microsoft.Build.Framework (17.3.1) + System.Security.Permissions (>= 6.0) Microsoft.Build.Tasks.Core (17.2) Microsoft.Build.Framework (>= 17.2) Microsoft.Build.Utilities.Core (>= 17.2) @@ -139,7 +138,7 @@ NUGET Microsoft.NET.StringTools (1.0) System.Memory (>= 4.5.4) System.Runtime.CompilerServices.Unsafe (>= 5.0) - Microsoft.NETCore.Platforms (6.0.4) - restriction: || (&& (== net6.0) (< netcoreapp3.1)) (&& (== net6.0) (< netstandard1.2)) (&& (== net6.0) (< netstandard1.3)) (&& (== net6.0) (< netstandard1.5)) (== netstandard2.0) + Microsoft.NETCore.Platforms (6.0.5) - restriction: || (&& (== net6.0) (< netcoreapp3.1)) (&& (== net6.0) (< netstandard1.2)) (&& (== net6.0) (< netstandard1.3)) (&& (== net6.0) (< netstandard1.5)) (== netstandard2.0) Microsoft.NETCore.Targets (5.0) - restriction: || (&& (== net6.0) (< netcoreapp3.1)) (&& (== net6.0) (< netstandard1.2)) (&& (== net6.0) (< netstandard1.3)) (&& (== net6.0) (< netstandard1.5)) (== netstandard2.0) Microsoft.Win32.Registry (5.0) System.Buffers (>= 4.5.1) - restriction: || (&& (== net6.0) (>= monoandroid) (< netstandard1.3)) (&& (== net6.0) (>= monotouch)) (&& (== net6.0) (< netcoreapp2.0)) (&& (== net6.0) (>= xamarinios)) (&& (== net6.0) (>= xamarinmac)) (&& (== net6.0) (>= xamarintvos)) (&& (== net6.0) (>= xamarinwatchos)) (== netstandard2.0) @@ -154,21 +153,21 @@ NUGET Microsoft.Build.Tasks.Core (>= 16.10) Microsoft.Build.Utilities.Core (>= 16.10) Newtonsoft.Json (13.0.1) - NuGet.Common (6.2.1) - NuGet.Frameworks (>= 6.2.1) - NuGet.Configuration (6.2.1) - NuGet.Common (>= 6.2.1) + NuGet.Common (6.3) + NuGet.Frameworks (>= 6.3) + NuGet.Configuration (6.3) + NuGet.Common (>= 6.3) System.Security.Cryptography.ProtectedData (>= 4.4) - NuGet.Frameworks (6.2.1) - NuGet.Packaging (6.2.1) + NuGet.Frameworks (6.3) + NuGet.Packaging (6.3) Newtonsoft.Json (>= 13.0.1) - NuGet.Configuration (>= 6.2.1) - NuGet.Versioning (>= 6.2.1) + NuGet.Configuration (>= 6.3) + NuGet.Versioning (>= 6.3) System.Security.Cryptography.Cng (>= 5.0) System.Security.Cryptography.Pkcs (>= 5.0) - NuGet.Protocol (6.2.1) - NuGet.Packaging (>= 6.2.1) - NuGet.Versioning (6.2.1) + NuGet.Protocol (6.3) + NuGet.Packaging (>= 6.3) + NuGet.Versioning (6.3) System.Buffers (4.5.1) - restriction: || (&& (== net6.0) (>= monoandroid) (< netstandard1.3)) (&& (== net6.0) (>= monotouch)) (&& (== net6.0) (< netcoreapp2.0)) (&& (== net6.0) (>= xamarinios)) (&& (== net6.0) (>= xamarinmac)) (&& (== net6.0) (>= xamarintvos)) (&& (== net6.0) (>= xamarinwatchos)) (== netstandard2.0) System.CodeDom (6.0) System.Collections.Immutable (6.0) @@ -210,10 +209,10 @@ NUGET System.Memory (>= 4.5.4) - restriction: || (&& (== net6.0) (< netstandard2.1)) (== netstandard2.0) System.Security.Cryptography.Cng (>= 5.0) - restriction: || (&& (== net6.0) (< netcoreapp3.1)) (&& (== net6.0) (< netstandard2.1)) (== netstandard2.0) System.Security.Cryptography.ProtectedData (6.0) - System.Security.Cryptography.Xml (6.0) + System.Security.Cryptography.Xml (6.0.1) System.Memory (>= 4.5.4) - restriction: == netstandard2.0 System.Security.AccessControl (>= 6.0) - System.Security.Cryptography.Pkcs (>= 6.0) + System.Security.Cryptography.Pkcs (>= 6.0.1) System.Security.Permissions (6.0) System.Security.AccessControl (>= 6.0) System.Windows.Extensions (>= 6.0) - restriction: || (== net6.0) (&& (== netstandard2.0) (>= netcoreapp3.1)) diff --git a/src/JobsJobsJobs/Domain/JobsJobsJobs.Domain.fsproj b/src/JobsJobsJobs/Domain/JobsJobsJobs.Domain.fsproj index ee4d625..6c6db14 100644 --- a/src/JobsJobsJobs/Domain/JobsJobsJobs.Domain.fsproj +++ b/src/JobsJobsJobs/Domain/JobsJobsJobs.Domain.fsproj @@ -13,9 +13,9 @@ - + - + diff --git a/src/JobsJobsJobs/Domain/SharedTypes.fs b/src/JobsJobsJobs/Domain/SharedTypes.fs index d52a101..649f7bf 100644 --- a/src/JobsJobsJobs/Domain/SharedTypes.fs +++ b/src/JobsJobsJobs/Domain/SharedTypes.fs @@ -1,7 +1,7 @@ /// Types intended to be shared between the API and the client application module JobsJobsJobs.Domain.SharedTypes -open JobsJobsJobs.Domain.Types +open JobsJobsJobs.Domain open Microsoft.Extensions.Options open NodaTime @@ -202,7 +202,7 @@ type ProfileForm = module ProfileForm = /// Create an instance of this form from the given profile - let fromProfile (profile : Types.Profile) = + let fromProfile (profile : Profile) = { isSeekingEmployment = profile.seekingEmployment isPublic = profile.isPublic realName = "" diff --git a/src/JobsJobsJobs/Domain/Types.fs b/src/JobsJobsJobs/Domain/Types.fs index c1deb1b..a24354a 100644 --- a/src/JobsJobsJobs/Domain/Types.fs +++ b/src/JobsJobsJobs/Domain/Types.fs @@ -45,6 +45,19 @@ with /// Support functions for citizens module Citizen = + /// An empty citizen + let empty = + { id = CitizenId Guid.Empty + joinedOn = Instant.MinValue + lastSeenOn = Instant.MinValue + email = "" + firstName = "" + lastName = "" + passwordHash = "" + displayName = None + otherContacts = [] + isLegacy = false + } /// Get the name of the citizen (either their preferred display name or first/last names) let name x = match x.displayName with Some it -> it | None -> $"{x.firstName} {x.lastName}" @@ -116,6 +129,26 @@ type Listing = isLegacy : bool } +/// Support functions for job listings +module Listing = + + /// An empty job listing + let empty = + { id = ListingId Guid.Empty + citizenId = CitizenId Guid.Empty + createdOn = Instant.MinValue + title = "" + continentId = ContinentId Guid.Empty + region = "" + remoteWork = false + isExpired = false + updatedOn = Instant.MinValue + text = Text "" + neededBy = None + wasFilledHere = None + isLegacy = false + } + /// Security settings for a user type SecurityInfo = @@ -253,3 +286,16 @@ type Success = /// The success story story : MarkdownString option } + +/// Support functions for success stories +module Success = + + /// An empty success story + let empty = + { id = SuccessId Guid.Empty + citizenId = CitizenId Guid.Empty + recordedOn = Instant.MinValue + fromHere = false + source = "" + story = None + } diff --git a/src/JobsJobsJobs/JobsJobsJobs.Data/Data.fs b/src/JobsJobsJobs/JobsJobsJobs.Data/Data.fs index 69cb3c0..bcd8bba 100644 --- a/src/JobsJobsJobs/JobsJobsJobs.Data/Data.fs +++ b/src/JobsJobsJobs/JobsJobsJobs.Data/Data.fs @@ -1,13 +1,81 @@ namespace JobsJobsJobs.Data +open System open JobsJobsJobs.Domain + +/// Wrapper documents for our record types +module Documents = + + /// A generic type that keeps its ID in sync with the ID value for its content + [] + type Document<'T> (initialValue : 'T, toId : 'T -> Guid) = + + /// The current value for this document + let mutable value = initialValue + + /// The ID for this document + member val Id = toId initialValue with get, set + + /// The value for this document + member this.Value + with get () = value + and set (v : 'T) = + value <- v + this.Id <- toId v + + /// Convert a document to its value + static member ToValue (doc : Document<'T>) = + doc.Value + + /// Convert a document to its value, or None if the document is null + static member TryValue (doc : Document<'T>) = + if isNull doc then None else Some doc.Value + + /// A citizen document + [] + type CitizenDocument (citizen : Citizen) = + inherit Document (citizen, fun c -> CitizenId.value c.id) + new() = CitizenDocument Citizen.empty + + /// A continent document + [] + type ContinentDocument (continent : Continent) = + inherit Document (continent, fun c -> ContinentId.value c.id) + new () = ContinentDocument Continent.empty + + /// A job listing document + [] + type ListingDocument (listing : Listing) = + inherit Document (listing, fun l -> ListingId.value l.id) + new () = ListingDocument Listing.empty + + /// A profile document + [] + type ProfileDocument (profile : Profile) = + inherit Document (profile, fun p -> CitizenId.value p.id) + new () = ProfileDocument Profile.empty + + /// A security information document + [] + type SecurityInfoDocument (securityInfo : SecurityInfo) = + inherit Document (securityInfo, fun si -> CitizenId.value si.Id) + new () = SecurityInfoDocument SecurityInfo.empty + + /// A success story document + [] + type SuccessDocument (success : Success) = + inherit Document (success, fun s -> SuccessId.value s.id) + new () = SuccessDocument Success.empty + + +open Documents open Marten -open Marten.PLv8 -open Microsoft.Extensions.Configuration /// Connection management for the Marten document store module Connection = + open Marten.NodaTime + open Microsoft.Extensions.Configuration open Weasel.Core /// The configuration from which a document store will be created @@ -21,14 +89,19 @@ module Connection = DocumentStore.For(fun opts -> opts.Connection (cfg.GetConnectionString "PostgreSQL") opts.RegisterDocumentTypes [ - typeof; typeof; typeof; typeof; typeof - typeof + typeof; typeof; typeof + typeof; typeof; typeof ] + opts.DatabaseSchemaName <- "jjj" opts.AutoCreateSchemaObjects <- AutoCreate.CreateOrUpdate - opts.UseJavascriptTransformsAndPatching () + opts.UseNodaTime () - let _ = opts.Schema.For().Identity (fun c -> c.DbId) - let _ = opts.Schema.For().Identity (fun si -> si.DbId) + let _ = opts.Schema.For().DocumentAlias "citizen" + let _ = opts.Schema.For().DocumentAlias "continent" + let _ = opts.Schema.For().DocumentAlias "listing" + let _ = opts.Schema.For().DocumentAlias "profile" + let _ = opts.Schema.For().DocumentAlias "security_info" + let _ = opts.Schema.For().DocumentAlias "success" ()) do! store.Storage.ApplyAllConfiguredChangesToDatabaseAsync () return Ok store @@ -38,7 +111,7 @@ module Connection = /// Set up the data connection from the given configuration let setUp (cfg : IConfiguration) = config <- Some cfg - ignore (lazyStore.Force ()) + lazyStore.Force () /// A read-only document session let querySession () = @@ -53,22 +126,12 @@ module Connection = | Error msg -> raise (invalidOp msg) -/// Helper functions for data retrieval -[] -module private Helpers = - - open System.Threading - - /// Convert a possibly-null record type to an option - let optional<'T> (value : 'T) = if isNull (box value) then None else Some value - - /// Shorthand for no cancellation token - let noCnx = CancellationToken.None +/// Shorthand for the generic dictionary +type Dict<'TKey, 'TValue> = System.Collections.Generic.Dictionary<'TKey, 'TValue> open System.Linq open Connection -open Marten.PLv8.Patching /// Citizen data access functions [] @@ -77,16 +140,21 @@ module Citizens = /// Delete a citizen by their ID let deleteById citizenId = backgroundTask { use session = docSession () - session.Delete (CitizenId.value citizenId) + session.DeleteWhere(fun s -> s.Value.citizenId = citizenId) + session.DeleteWhere(fun l -> l.Value.citizenId = citizenId) + let docId = CitizenId.value citizenId + session.Delete docId + session.Delete docId + session.Delete docId do! session.SaveChangesAsync () } /// Find a citizen by their ID let findById citizenId = backgroundTask { use session = querySession () - let! citizen = session.LoadAsync (CitizenId.value citizenId) + let! citizen = session.LoadAsync (CitizenId.value citizenId) return - match optional citizen with + match Document.TryValue citizen with | Some c when not c.isLegacy -> Some c | Some _ | None -> None @@ -95,7 +163,7 @@ module Citizens = /// Save a citizen let save (citizen : Citizen) = backgroundTask { use session = docSession () - session.Store citizen + session.Store (CitizenDocument citizen) do! session.SaveChangesAsync () } @@ -103,29 +171,34 @@ module Citizens = let tryLogOn email (pwCheck : string -> bool) now = backgroundTask { use session = docSession () let! tryCitizen = - session.Query().Where(fun c -> c.email = email && not c.isLegacy).SingleOrDefaultAsync () - match optional tryCitizen with + session.Query() + .Where(fun c -> c.Value.email = email && not c.Value.isLegacy) + .SingleOrDefaultAsync () + match Document.TryValue tryCitizen with | Some citizen -> - let! tryInfo = session.LoadAsync citizen.DbId + let! tryInfo = session.LoadAsync (CitizenId.value citizen.id) let! info = backgroundTask { - match optional tryInfo with + match Document.TryValue tryInfo with | Some it -> return it | None -> let it = { SecurityInfo.empty with Id = citizen.id } - session.Store it + session.Store (SecurityInfoDocument it) do! session.SaveChangesAsync () return it } if info.AccountLocked then return Error "Log on unsuccessful (Account Locked)" elif pwCheck citizen.passwordHash then - session.Patch(citizen.DbId).Set((fun si -> si.FailedLogOnAttempts), 0) - session.Patch(citizen.DbId).Set((fun c -> c.lastSeenOn), now) + session.Store (SecurityInfoDocument { info with FailedLogOnAttempts = 0}) + session.Store (CitizenDocument { citizen with lastSeenOn = now}) do! session.SaveChangesAsync () return Ok { citizen with lastSeenOn = now } else let locked = info.FailedLogOnAttempts >= 4 - session.Patch(citizen.DbId).Increment(fun si -> si.FailedLogOnAttempts) - if locked then session.Patch(citizen.DbId).Set((fun si -> si.AccountLocked), true) + session.Store (SecurityInfoDocument { + info with + FailedLogOnAttempts = info.FailedLogOnAttempts + 1 + AccountLocked = locked + }) do! session.SaveChangesAsync () return Error $"""Log on unsuccessful{if locked then " - Account is now locked" else ""}""" | None -> return Error "Log on unsuccessful" @@ -139,47 +212,47 @@ module Continents = /// Retrieve all continents let all () = backgroundTask { use session = querySession () - let! it = session.Query().ToListAsync noCnx - return List.ofSeq it + let! it = session.Query().AsQueryable().ToListAsync () + return it |> Seq.map Document.ToValue |> List.ofSeq } /// Retrieve a continent by its ID let findById continentId = backgroundTask { use session = querySession () - let! tryContinent = session.LoadAsync (ContinentId.value continentId) - return optional tryContinent + let! tryContinent = session.LoadAsync (ContinentId.value continentId) + return Document.TryValue tryContinent } -open System open JobsJobsJobs.Domain.SharedTypes /// Job listing access functions [] module Listings = - open System.Collections.Generic - /// Find all job listings posted by the given citizen let findByCitizen citizenId = backgroundTask { use session = querySession () - let continents = Dictionary () + let continents = Dict () let! listings = - session.Query() - .Include((fun l -> l.continentId :> obj), continents) - .Where(fun l -> l.citizenId = citizenId && not l.isLegacy) + session.Query() + .Include((fun l -> l.Value.continentId :> obj), continents) + .Where(fun l -> l.Value.citizenId = citizenId && not l.Value.isLegacy) .ToListAsync () return listings - |> Seq.map (fun l -> { listing = l; continent = continents[l.continentId] }) + |> Seq.map (fun l -> { + listing = l.Value + continent = continents[ContinentId.value l.Value.continentId].Value + }) |> List.ofSeq } /// Find a listing by its ID let findById listingId = backgroundTask { use session = querySession () - let! tryListing = session.LoadAsync (ListingId.value listingId) - match optional tryListing with + let! tryListing = session.LoadAsync (ListingId.value listingId) + match Document.TryValue tryListing with | Some listing when not listing.isLegacy -> return Some listing | Some _ | None -> return None @@ -188,52 +261,194 @@ module Listings = /// Find a listing by its ID for viewing (includes continent information) let findByIdForView listingId = backgroundTask { use session = querySession () - let mutable continent = Continent.empty + let mutable continent : ContinentDocument = null let! tryListing = - session.Query() - .Include((fun l -> l.continentId :> obj), fun c -> continent <- c) - .Where(fun l -> l.id = listingId && not l.isLegacy) + session.Query() + .Include((fun l -> l.Value.continentId :> obj), fun c -> continent <- c) + .Where(fun l -> l.Id = ListingId.value listingId && not l.Value.isLegacy) .SingleOrDefaultAsync () - match optional tryListing with - | Some listing -> return Some { listing = listing; continent = continent } + match Document.TryValue tryListing with + | Some listing when not (isNull continent) -> return Some { listing = listing; continent = continent.Value } + | Some _ | None -> return None } /// Save a listing let save (listing : Listing) = backgroundTask { use session = docSession () - session.Store listing + session.Store (ListingDocument listing) do! session.SaveChangesAsync () } /// Search job listings let search (search : ListingSearch) = backgroundTask { use session = querySession () - let continents = Dictionary () + let continents = Dict () let searchQuery = - seq bool> { + seq bool> { match search.continentId with | Some contId -> - fun (l : Listing) -> l.continentId = (ContinentId.ofString contId) + fun (l : ListingDocument) -> l.Value.continentId = (ContinentId.ofString contId) | None -> () match search.region with - | Some region -> fun (l : Listing) -> l.region.Contains (region, StringComparison.OrdinalIgnoreCase) + | Some region -> + fun (l : ListingDocument) -> l.Value.region.Contains (region, StringComparison.OrdinalIgnoreCase) | None -> () if search.remoteWork <> "" then - fun (l : Listing) -> l.remoteWork = (search.remoteWork = "yes") + fun (l : ListingDocument) -> l.Value.remoteWork = (search.remoteWork = "yes") // match search.text with // | Some text -> fun (l : Listing) -> l.text.Contains (text, StringComparison.OrdinalIgnoreCase) // | None -> () } |> Seq.fold (fun q filter -> Queryable.Where(q, filter)) - (session.Query() - .Include((fun l -> l.continentId :> obj), continents) - .Where(fun l -> not l.isExpired && not l.isLegacy)) + (session.Query() + .Include((fun l -> l.Value.continentId :> obj), continents) + .Where(fun l -> not l.Value.isExpired && not l.Value.isLegacy)) let! results = searchQuery.ToListAsync () return results - |> Seq.map (fun l -> { listing = l; continent = continents[l.continentId] }) + |> Seq.map (fun l -> { + listing = l.Value + continent = continents[ContinentId.value l.Value.continentId].Value + }) + |> List.ofSeq + } + + +/// Profile data access functions +[] +module Profiles = + + /// Count the current profiles + let count () = + use session = querySession () + session.Query().Where(fun p -> not p.Value.isLegacy).LongCountAsync () + + /// Delete a profile by its ID + let deleteById citizenId = backgroundTask { + use session = docSession () + session.Delete (CitizenId.value citizenId) + do! session.SaveChangesAsync () + } + /// Find a profile by citizen ID + let findById citizenId = backgroundTask { + use session = querySession () + let! profile = session.LoadAsync (CitizenId.value citizenId) + return + match Document.TryValue profile with + | Some p when not p.isLegacy -> Some p + | Some _ + | None -> None + } + + /// Find a profile by citizen ID for viewing (includes citizen and continent information) + let findByIdForView citizenId = backgroundTask { + use session = querySession () + let mutable citizen : CitizenDocument = null + let mutable continent : ContinentDocument = null + let! tryProfile = + session.Query() + .Include((fun p -> p.Id :> obj), fun c -> citizen <- c) + .Include((fun p -> p.Value.continentId :> obj), fun c -> continent <- c) + .Where(fun p -> p.Id = CitizenId.value citizenId && not p.Value.isLegacy) + .SingleOrDefaultAsync () + match Document.TryValue tryProfile with + | Some profile when not (isNull citizen) && not (isNull continent) -> + return Some { profile = profile; citizen = citizen.Value; continent = continent.Value } + | Some _ + | None -> return None + } + + /// Save a profile + let save (profile : Profile) = backgroundTask { + use session = docSession () + session.Store (ProfileDocument profile) + do! session.SaveChangesAsync () + } + + /// Search profiles (logged-on users) + let search (search : ProfileSearch) = backgroundTask { + use session = querySession () + let citizens = Dict () + let searchQuery = + seq bool> { + match search.continentId with + | Some contId -> fun (p : ProfileDocument) -> p.Value.continentId = ContinentId.ofString contId + | None -> () + if search.remoteWork <> "" then + fun (p : ProfileDocument) -> p.Value.remoteWork = (search.remoteWork = "yes") + match search.skill with + | Some skl -> + fun (p : ProfileDocument) -> + p.Value.skills.Any(fun s -> s.description.Contains (skl, StringComparison.OrdinalIgnoreCase)) + | None -> () + // match search.bioExperience with + // | Some text -> + // let txt = regexContains text + // yield filterFunc (fun it -> it.G("biography").Match(txt).Or (it.G("experience").Match txt)) + // | None -> () + } + |> Seq.fold + (fun q filter -> Queryable.Where(q, filter)) + (session.Query() + .Include((fun p -> p.Id :> obj), citizens) + .Where(fun p -> not p.Value.isLegacy)) + let! results = searchQuery.ToListAsync () + return + results + |> Seq.map (fun profileDoc -> + let p = profileDoc.Value + { citizenId = p.id + displayName = Citizen.name citizens[CitizenId.value p.id].Value + seekingEmployment = p.seekingEmployment + remoteWork = p.remoteWork + fullTime = p.fullTime + lastUpdatedOn = p.lastUpdatedOn + }) + |> Seq.sortBy (fun psr -> psr.displayName.ToLowerInvariant ()) + |> List.ofSeq + } + + // Search profiles (public) + let publicSearch (search : PublicSearch) = backgroundTask { + use session = querySession () + let continents = Dict () + let searchQuery = + seq bool> { + match search.continentId with + | Some contId -> fun (p : ProfileDocument) -> p.Value.continentId = ContinentId.ofString contId + | None -> () + match search.region with + | Some region -> + fun (p : ProfileDocument) -> p.Value.region.Contains (region, StringComparison.OrdinalIgnoreCase) + | None -> () + if search.remoteWork <> "" then + fun (p : ProfileDocument) -> p.Value.remoteWork = (search.remoteWork = "yes") + match search.skill with + | Some skl -> + fun (p : ProfileDocument) -> + p.Value.skills.Any(fun s -> s.description.Contains (skl, StringComparison.OrdinalIgnoreCase)) + | None -> () + } + |> Seq.fold + (fun q filter -> Queryable.Where(q, filter)) + (session.Query() + .Include((fun p -> p.Value.continentId :> obj), continents) + .Where(fun p -> p.Value.isPublic && not p.Value.isLegacy)) + let! results = searchQuery.ToListAsync () + return + results + |> Seq.map (fun profileDoc -> + let p = profileDoc.Value + { continent = continents[ContinentId.value p.continentId].Value.name + region = p.region + remoteWork = p.remoteWork + skills = p.skills + |> List.map (fun s -> + let notes = match s.notes with Some n -> $" ({n})" | None -> "" + $"{s.description}{notes}") + }) |> List.ofSeq } @@ -241,10 +456,40 @@ module Listings = [] module Successes = + // Retrieve all success stories + let all () = backgroundTask { + use session = querySession () + let citizens = Dict () + let! stories = + session.Query() + .Include((fun s -> s.Value.citizenId :> obj), citizens) + .OrderByDescending(fun s -> s.Value.recordedOn) + .ToListAsync () + return + stories + |> Seq.map (fun storyDoc -> + let s = storyDoc.Value + { id = s.id + citizenId = s.citizenId + citizenName = Citizen.name citizens[CitizenId.value s.citizenId].Value + recordedOn = s.recordedOn + fromHere = s.fromHere + hasStory = Option.isSome s.story + }) + |> List.ofSeq + } + + /// Find a success story by its ID + let findById successId = backgroundTask { + use session = querySession () + let! success = session.LoadAsync (SuccessId.value successId) + return Document.TryValue success + } + /// Save a success story let save (success : Success) = backgroundTask { use session = docSession () - session.Store success + session.Store (SuccessDocument success) do! session.SaveChangesAsync () } \ No newline at end of file diff --git a/src/JobsJobsJobs/JobsJobsJobs.Data/JobsJobsJobs.Data.fsproj b/src/JobsJobsJobs/JobsJobsJobs.Data/JobsJobsJobs.Data.fsproj index c7191ec..b0f2602 100644 --- a/src/JobsJobsJobs/JobsJobsJobs.Data/JobsJobsJobs.Data.fsproj +++ b/src/JobsJobsJobs/JobsJobsJobs.Data/JobsJobsJobs.Data.fsproj @@ -18,7 +18,9 @@ - + + + diff --git a/src/JobsJobsJobs/JobsJobsJobs.Data/Json.fs b/src/JobsJobsJobs/JobsJobsJobs.Data/Json.fs index de761d0..4f83795 100644 --- a/src/JobsJobsJobs/JobsJobsJobs.Data/Json.fs +++ b/src/JobsJobsJobs/JobsJobsJobs.Data/Json.fs @@ -5,19 +5,32 @@ open System.Text.Json open System.Text.Json.Serialization open JobsJobsJobs.Domain -/// Convert citizen IDs to their string-GUID representation -type CitizenIdJsonConverter () = - inherit JsonConverter () - override this.Read(reader, _, _) = - CitizenId (Guid.Parse (reader.GetString ())) - override this.Write(writer, value, _) = - writer.WriteStringValue ((CitizenId.value value).ToString ()) +/// Convert a wrapped GUID to/from its string representation +type WrappedJsonConverter<'T> (wrap : string -> 'T, unwrap : 'T -> string) = + inherit JsonConverter<'T> () + override _.Read(reader, _, _) = + wrap (reader.GetString ()) + override _.Write(writer, value, _) = + writer.WriteStringValue (unwrap value) + +/// Convert a wrapped GUID to/from its string representation +type WrappedIdJsonConverter<'T> (wrap : Guid -> 'T, unwrap : 'T -> Guid) = + inherit JsonConverter<'T> () + override _.Read(reader, _, _) = + wrap (Guid.Parse (reader.GetString ())) + override _.Write(writer, value, _) = + writer.WriteStringValue ((unwrap value).ToString ()) /// JsonSerializer options that use the custom converters let options = let opts = JsonSerializerOptions () - [ CitizenIdJsonConverter () :> JsonConverter + [ WrappedIdJsonConverter (CitizenId, CitizenId.value) :> JsonConverter + WrappedIdJsonConverter (ContinentId, ContinentId.value) + WrappedIdJsonConverter (ListingId, ListingId.value) + WrappedJsonConverter (Text, MarkdownString.toString) + WrappedIdJsonConverter (SkillId, SkillId.value) + WrappedIdJsonConverter (SuccessId, SuccessId.value) JsonFSharpConverter () ] |> List.iter opts.Converters.Add diff --git a/src/JobsJobsJobs/Server/App.fs b/src/JobsJobsJobs/Server/App.fs index fc88566..e4d213e 100644 --- a/src/JobsJobsJobs/Server/App.fs +++ b/src/JobsJobsJobs/Server/App.fs @@ -8,7 +8,6 @@ open Microsoft.Extensions.Hosting open Giraffe open Giraffe.EndpointRouting - /// Configure the ASP.NET Core pipeline to use Giraffe let configureApp (app : IApplicationBuilder) = app.UseCors(fun p -> p.AllowAnyOrigin().AllowAnyHeader() |> ignore) @@ -22,13 +21,11 @@ let configureApp (app : IApplicationBuilder) = e.MapFallbackToFile "index.html" |> ignore) |> ignore -open Newtonsoft.Json -open NodaTime +open System.Text open Microsoft.AspNetCore.Authentication.JwtBearer open Microsoft.Extensions.Configuration -open Microsoft.Extensions.Logging open Microsoft.IdentityModel.Tokens -open System.Text +open NodaTime open JobsJobsJobs.Data open JobsJobsJobs.Domain.SharedTypes @@ -39,9 +36,7 @@ let configureServices (svc : IServiceCollection) = let _ = svc.AddLogging () let _ = svc.AddCors () - let jsonCfg = JsonSerializerSettings () - Data.Converters.all () |> List.iter jsonCfg.Converters.Add - let _ = svc.AddSingleton (NewtonsoftJson.Serializer jsonCfg) + let _ = svc.AddSingleton (SystemTextJson.Serializer Json.options) let svcs = svc.BuildServiceProvider () let cfg = svcs.GetRequiredService () @@ -64,13 +59,11 @@ let configureServices (svc : IServiceCollection) = let _ = svc.AddAuthorization () let _ = svc.Configure (cfg.GetSection "Auth") - let dbCfg = cfg.GetSection "Rethink" - let log = svcs.GetRequiredService().CreateLogger "JobsJobsJobs.Api.Data.Startup" - let conn = Data.Startup.createConnection dbCfg log - let _ = svc.AddSingleton conn |> ignore // Set up the Marten data store - let _ = Connection.setUp cfg - () + match Connection.setUp cfg |> Async.AwaitTask |> Async.RunSynchronously with + | Ok _ -> () + | Error msg -> failwith $"Error initializing data store: {msg}" + [] let main _ = diff --git a/src/JobsJobsJobs/Server/Auth.fs b/src/JobsJobsJobs/Server/Auth.fs index e2b8b2a..8ea26e3 100644 --- a/src/JobsJobsJobs/Server/Auth.fs +++ b/src/JobsJobsJobs/Server/Auth.fs @@ -78,7 +78,6 @@ let verifyWithMastodon (authCode : string) (inst : MastodonInstance) rtnHost (lo open JobsJobsJobs.Domain -open JobsJobsJobs.Domain.Types open Microsoft.IdentityModel.Tokens open System.IdentityModel.Tokens.Jwt open System.Security.Claims diff --git a/src/JobsJobsJobs/Server/Data.fs b/src/JobsJobsJobs/Server/Data.fs deleted file mode 100644 index 094335b..0000000 --- a/src/JobsJobsJobs/Server/Data.fs +++ /dev/null @@ -1,745 +0,0 @@ -/// Data access functions for Jobs, Jobs, Jobs -module JobsJobsJobs.Api.Data - -open JobsJobsJobs.Domain - -/// JSON converters used with RethinkDB persistence -module Converters = - - open Microsoft.FSharpLu.Json - open Newtonsoft.Json - open System - - /// JSON converter for citizen IDs - type CitizenIdJsonConverter() = - inherit JsonConverter() - override _.WriteJson(writer : JsonWriter, value : CitizenId, _ : JsonSerializer) = - writer.WriteValue (CitizenId.toString value) - override _.ReadJson(reader: JsonReader, _ : Type, _ : CitizenId, _ : bool, _ : JsonSerializer) = - (string >> CitizenId.ofString) reader.Value - - /// JSON converter for continent IDs - type ContinentIdJsonConverter() = - inherit JsonConverter() - override _.WriteJson(writer : JsonWriter, value : ContinentId, _ : JsonSerializer) = - writer.WriteValue (ContinentId.toString value) - override _.ReadJson(reader: JsonReader, _ : Type, _ : ContinentId, _ : bool, _ : JsonSerializer) = - (string >> ContinentId.ofString) reader.Value - - /// JSON converter for Markdown strings - type MarkdownStringJsonConverter() = - inherit JsonConverter() - override _.WriteJson(writer : JsonWriter, value : MarkdownString, _ : JsonSerializer) = - writer.WriteValue (MarkdownString.toString value) - override _.ReadJson(reader: JsonReader, _ : Type, _ : MarkdownString, _ : bool, _ : JsonSerializer) = - (string >> Text) reader.Value - - /// JSON converter for listing IDs - type ListingIdJsonConverter() = - inherit JsonConverter() - override _.WriteJson(writer : JsonWriter, value : ListingId, _ : JsonSerializer) = - writer.WriteValue (ListingId.toString value) - override _.ReadJson(reader: JsonReader, _ : Type, _ : ListingId, _ : bool, _ : JsonSerializer) = - (string >> ListingId.ofString) reader.Value - - /// JSON converter for skill IDs - type SkillIdJsonConverter() = - inherit JsonConverter() - override _.WriteJson(writer : JsonWriter, value : SkillId, _ : JsonSerializer) = - writer.WriteValue (SkillId.toString value) - override _.ReadJson(reader: JsonReader, _ : Type, _ : SkillId, _ : bool, _ : JsonSerializer) = - (string >> SkillId.ofString) reader.Value - - /// JSON converter for success report IDs - type SuccessIdJsonConverter() = - inherit JsonConverter() - override _.WriteJson(writer : JsonWriter, value : SuccessId, _ : JsonSerializer) = - writer.WriteValue (SuccessId.toString value) - override _.ReadJson(reader: JsonReader, _ : Type, _ : SuccessId, _ : bool, _ : JsonSerializer) = - (string >> SuccessId.ofString) reader.Value - - /// All JSON converters needed for the application - let all () : JsonConverter list = - [ CitizenIdJsonConverter () - ContinentIdJsonConverter () - MarkdownStringJsonConverter () - ListingIdJsonConverter () - SkillIdJsonConverter () - SuccessIdJsonConverter () - CompactUnionJsonConverter () - ] - - -/// Table names -[] -module Table = - - /// The user (citizen of Gitmo Nation) table - let Citizen = "citizen" - - /// The continent table - let Continent = "continent" - - /// The citizen employment profile table - let Profile = "profile" - - /// The success story table - let Success = "success" - - /// All tables - let all () = [ Citizen; Continent; Profile; Success ] - -open NodaTime -open Npgsql -open Npgsql.FSharp - - - -open RethinkDb.Driver.FSharp.Functions -open RethinkDb.Driver.Net - -/// Reconnection functions (if the RethinkDB driver has a network error, it will not reconnect on its own) -[] -module private Reconnect = - - /// Retrieve a result using the F# driver's default retry policy - let result<'T> conn expr = runResult<'T> expr |> withRetryDefault |> withConn conn - - /// Retrieve an optional result using the F# driver's default retry policy - let resultOption<'T> conn expr = runResult<'T> expr |> withRetryDefault |> asOption |> withConn conn - - /// Write a query using the F# driver's default retry policy, ignoring the result - let write conn expr = runWrite expr |> withRetryDefault |> ignoreResult |> withConn conn - - -open RethinkDb.Driver.Ast -open Marten - -/// Shorthand for the RethinkDB R variable (how every command starts) -let private r = RethinkDb.Driver.RethinkDB.R - -/// Functions run at startup -[] -module Startup = - - open Microsoft.Extensions.Configuration - open Microsoft.Extensions.Logging - open NodaTime.Serialization.JsonNet - open RethinkDb.Driver.FSharp - - /// Create a RethinkDB connection - let createConnection (cfg : IConfigurationSection) (log : ILogger) = - // Add all required JSON converters - Converter.Serializer.ConfigureForNodaTime DateTimeZoneProviders.Tzdb |> ignore - Converters.all () - |> List.iter Converter.Serializer.Converters.Add - // Connect to the database - let config = DataConfig.FromConfiguration cfg - log.LogInformation $"Connecting to rethinkdb://{config.Hostname}:{config.Port}/{config.Database}" - config.CreateConnection () - - /// Ensure the tables and indexes that are required exist - let establishEnvironment (log : ILogger) conn = task { - - let! tables = - Sql.existingConnection conn - |> Sql.query "SELECT tablename FROM pg_tables WHERE schemaname = 'jjj'" - |> Sql.executeAsync (fun row -> row.string "tablename") - let needsTable table = not (List.contains table tables) - - let sql = seq { - if needsTable "continent" then - "CREATE TABLE jjj.continent ( - id UUID NOT NULL PRIMARY KEY, - name TEXT NOT NULL)" - if needsTable "citizen" then - "CREATE TABLE jjj.citizen ( - id UUID NOT NULL PRIMARY KEY, - joined_on TIMESTAMPTZ NOT NULL, - last_seen_on TIMESTAMPTZ NOT NULL, - email TEXT NOT NULL UNIQUE, - first_name TEXT NOT NULL, - last_name TEXT NOT NULL, - password_hash TEXT NOT NULL, - is_legacy BOOLEAN NOT NULL, - display_name TEXT, - other_contacts TEXT)" - if needsTable "listing" then - "CREATE TABLE jjj.listing ( - id UUID NOT NULL PRIMARY KEY, - citizen_id UUID NOT NULL, - created_on TIMESTAMPTZ NOT NULL, - title TEXT NOT NULL, - continent_id UUID NOT NULL, - region TEXT NOT NULL, - is_remote BOOLEAN NOT NULL, - is_expired BOOLEAN NOT NULL, - updated_on TIMESTAMPTZ NOT NULL, - listing_text TEXT NOT NULL, - needed_by DATE, - was_filled_here BOOLEAN, - FOREIGN KEY fk_listing_citizen (citizen_id) REFERENCES jjj.citizen (id) ON DELETE CASCADE, - FOREIGN KEY fk_listing_continent (continent_id) REFERENCES jjj.continent (id))" - "CREATE INDEX idx_listing_citizen ON jjj.listing (citizen_id)" - "CREATE INDEX idx_listing_continent ON jjj.listing (continent_id)" - if needsTable "profile" then - "CREATE TABLE jjj.profile ( - citizen_id UUID NOT NULL PRIMARY KEY, - is_seeking BOOLEAN NOT NULL, - is_public_searchable BOOLEAN NOT NULL, - is_public_linkable BOOLEAN NOT NULL, - continent_id UUID NOT NULL, - region TEXT NOT NULL, - is_available_remotely BOOLEAN NOT NULL, - is_available_full_time BOOLEAN NOT NULL, - biography TEXT NOT NULL, - last_updated_on TIMESTAMPTZ NOT NULL, - experience TEXT, - FOREIGN KEY fk_profile_citizen (citizen_id) REFERENCES jjj.citizen (id) ON DELETE CASCADE, - FOREIGN KEY fk_profile_continent (continent_id) REFERENCES jjj.continent (id))" - "CREATE INDEX idx_profile_citizen ON jjj.profile (citizen_id)" - "CREATE INDEX idx_profile_continent ON jjj.profile (continent_id)" - "CREATE TABLE jjj.profile_skill ( - id UUID NOT NULL PRIMARY KEY, - citizen_id UUID NOT NULL, - description TEXT NOT NULL, - notes TEXT, - FOREIGN KEY fk_profile_skill_profile (citizen_id) REFERENCES jjj.profile (citizen_id) - ON DELETE CASCADE)" - "CREATE INDEX idx_profile_skill_profile ON jjj.profile_skill (citizen_id)" - if needsTable "security_info" then - "CREATE TABLE jjj.security_info ( - id UUID NOT NULL PRIMARY KEY, - failed_attempts SMALLINT NOT NULL, - is_locked BOOLEAN NOT NULL, - token TEXT, - token_usage TEXT, - token_expires TIMESTAMPTZ, - FOREIGN KEY fk_security_info_citizen (id) REFERENCES jjj.citizen (id) ON DELETE CASCADE)" - "CREATE INDEX idx_security_info_expires ON jjj.security_info (token_expires)" - if needsTable "success" then - "CREATE TABLE jjj.success ( - id UUID NOT NULL PRIMARY KEY, - citizen_id UUID NOT NULL, - recorded_on TIMESTAMPTZ NOT NULL, - was_from_here BOOLEAN NOT NULL, - source TEXT NOT NULL, - story TEXT, - FOREIGN KEY fk_success_citizen (citizen_id) REFERENCES jjj.citizen (id) ON DELETE CASCADE)" - "CREATE INDEX idx_success_citizen ON jjj.success (citizen_id)" - } - if not (Seq.isEmpty sql) then - let! _ = - Sql.existingConnection conn - |> Sql.executeTransactionAsync - (sql - |> Seq.map (fun it -> - let parts = it.Split ' ' - log.LogInformation $"Creating {parts[2]} {parts[1].ToLowerInvariant ()}..." - it, [ [] ]) - |> List.ofSeq) - () - } - - -open JobsJobsJobs.Domain.SharedTypes - -/// Sanitize user input, and create a "contains" pattern for use with RethinkDB queries -let private regexContains = System.Text.RegularExpressions.Regex.Escape >> sprintf "(?i)%s" - -/// Apply filters to a query, ensuring that types all match up -let private applyFilters (filters : (ReqlExpr -> Filter) list) query : ReqlExpr = - if List.isEmpty filters then - query - else - let first = List.head filters query - List.fold (fun q (f : ReqlExpr -> Filter) -> f q) first (List.tail filters) - -/// Derive a user's display name from real name, display name, or handle (in that order) -let private deriveDisplayName (it : ReqlExpr) = - r.Branch (it.G("realName" ).Default_("").Ne "", it.G "realName", - it.G("displayName").Default_("").Ne "", it.G "displayName", - it.G "mastodonUser") - -/// Custom SQL parameter functions -module Sql = - - /// Create a citizen ID parameter - let citizenId = CitizenId.value >> Sql.uuid - - /// Create a continent ID parameter - let continentId = ContinentId.value >> Sql.uuid - - /// Create a listing ID parameter - let listingId = ListingId.value >> Sql.uuid - - /// Create a Markdown string parameter - let markdown = MarkdownString.toString >> Sql.string - - /// Create a parameter for the given value - let param<'T> name (value : 'T) = - name, Sql.parameter (NpgsqlParameter (name, value)) - - /// Create a parameter for a possibly-missing value - let paramOrNone<'T> name (value : 'T option) = - name, Sql.parameter (NpgsqlParameter (name, if Option.isSome value then box value else System.DBNull.Value)) - - /// Create a skill ID parameter - let skillId = SkillId.value >> Sql.uuid - - /// Create a success ID parameter - let successId = SuccessId.value >> Sql.uuid - - -/// Map data results to domain types -module Map = - - /// Create a citizen from a data row - let toCitizen (row : RowReader) : Citizen = - { id = (row.uuid >> CitizenId) "id" - joinedOn = row.fieldValue "joined_on" - lastSeenOn = row.fieldValue "last_seen_on" - email = row.string "email" - firstName = row.string "first_name" - lastName = row.string "last_name" - passwordHash = row.string "password_hash" - displayName = row.stringOrNone "display_name" - // TODO: deserialize from JSON - otherContacts = [] // row.stringOrNone "other_contacts" - isLegacy = false - } - - /// Create a continent from a data row - let toContinent (row : RowReader) : Continent = - { id = (row.uuid >> ContinentId) "continent_id" - name = row.string "continent_name" - } - - /// Extract a count from a row - let toCount (row : RowReader) = - row.int64 "the_count" - - /// Create a job listing from a data row - let toListing (row : RowReader) : Listing = - { id = (row.uuid >> ListingId) "id" - citizenId = (row.uuid >> CitizenId) "citizen_id" - createdOn = row.fieldValue "created_on" - title = row.string "title" - continentId = (row.uuid >> ContinentId) "continent_id" - region = row.string "region" - remoteWork = row.bool "is_remote" - isExpired = row.bool "is_expired" - updatedOn = row.fieldValue "updated_on" - text = (row.string >> Text) "listing_text" - neededBy = row.fieldValueOrNone "needed_by" - wasFilledHere = row.boolOrNone "was_filled_here" - isLegacy = false - } - - /// Create a job listing for viewing from a data row - let toListingForView (row : RowReader) : ListingForView = - { listing = toListing row - continent = toContinent row - } - - /// Create a profile from a data row - let toProfile (row : RowReader) : Profile = - { id = (row.uuid >> CitizenId) "citizen_id" - seekingEmployment = row.bool "is_seeking" - isPublic = row.bool "is_public_searchable" - isPublicLinkable = row.bool "is_public_linkable" - continentId = (row.uuid >> ContinentId) "continent_id" - region = row.string "region" - remoteWork = row.bool "is_available_remotely" - fullTime = row.bool "is_available_full_time" - biography = (row.string >> Text) "biography" - lastUpdatedOn = row.fieldValue "last_updated_on" - experience = row.stringOrNone "experience" |> Option.map Text - skills = [] - isLegacy = false - } - - /// Create a skill from a data row - let toSkill (row : RowReader) : Skill = - { id = (row.uuid >> SkillId) "id" - description = row.string "description" - notes = row.stringOrNone "notes" - } - - /// Create a success story from a data row - let toSuccess (row : RowReader) : Success = - { id = (row.uuid >> SuccessId) "id" - citizenId = (row.uuid >> CitizenId) "citizen_id" - recordedOn = row.fieldValue "recorded_on" - fromHere = row.bool "was_from_here" - source = row.string "source" - story = row.stringOrNone "story" |> Option.map Text - } - - -/// Convert a possibly-null record type to an option -let optional<'T> (value : 'T) = if isNull (box value) then None else Some value - -open System -open System.Linq - -/// Profile data access functions -[] -module Profile = - - /// Count the current profiles - let count (session : IQuerySession) = - session.Query().Where(fun p -> not p.isLegacy).LongCountAsync () - - /// Find a profile by citizen ID - let findById citizenId (session : IQuerySession) = backgroundTask { - let! profile = session.LoadAsync (CitizenId.value citizenId) - return - match optional profile with - | Some p when not p.isLegacy -> Some p - | Some _ - | None -> None - } - - /// Insert or update a profile - [] - let save (profile : Profile) (session : IDocumentSession) = - session.Store profile - - /// Delete a citizen's profile - let delete citizenId conn = backgroundTask { - let! _ = - Sql.existingConnection conn - |> Sql.query "DELETE FROM jjj.profile WHERE citizen_id = @id" - |> Sql.parameters [ "@id", Sql.citizenId citizenId ] - |> Sql.executeNonQueryAsync - () - } - - /// Search profiles (logged-on users) - let search (search : ProfileSearch) conn = - fromTable Table.Profile - |> eqJoin "id" (fromTable Table.Citizen) - |> without [ "right.id" ] - |> zip - |> applyFilters - [ match search.continentId with - | Some contId -> yield filter {| continentId = ContinentId.ofString contId |} - | None -> () - match search.remoteWork with - | "" -> () - | _ -> yield filter {| remoteWork = search.remoteWork = "yes" |} - match search.skill with - | Some skl -> - yield filterFunc (fun it -> - it.G("skills").Contains (ReqlFunction1 (fun s -> s.G("description").Match (regexContains skl)))) - | None -> () - match search.bioExperience with - | Some text -> - let txt = regexContains text - yield filterFunc (fun it -> it.G("biography").Match(txt).Or (it.G("experience").Match txt)) - | None -> () - ] - |> mergeFunc (fun it -> {| displayName = deriveDisplayName it; citizenId = it.G "id" |}) - |> pluck [ "citizenId"; "displayName"; "seekingEmployment"; "remoteWork"; "fullTime"; "lastUpdatedOn" ] - |> orderByFunc (fun it -> it.G("displayName").Downcase ()) - |> result conn - - // Search profiles (public) - let publicSearch (search : PublicSearch) conn = - fromTable Table.Profile - |> eqJoin "continentId" (fromTable Table.Continent) - |> without [ "right.id" ] - |> zip - |> applyFilters - [ yield filter {| isPublic = true |} - match search.continentId with - | Some contId -> yield filter {| continentId = ContinentId.ofString contId |} - | None -> () - match search.region with - | Some reg -> yield filterFunc (fun it -> it.G("region").Match (regexContains reg)) - | None -> () - match search.remoteWork with - | "" -> () - | _ -> yield filter {| remoteWork = search.remoteWork = "yes" |} - match search.skill with - | Some skl -> - yield filterFunc (fun it -> - it.G("skills").Contains (ReqlFunction1 (fun s -> s.G("description").Match (regexContains skl)))) - | None -> () - ] - |> mergeFunc (fun it -> - {| skills = it.G("skills").Map (ReqlFunction1 (fun skill -> - r.Branch(skill.G("notes").Default_("").Eq "", skill.G "description", - skill.G("description").Add(" (").Add(skill.G("notes")).Add ")"))) - continent = it.G "name" - |}) - |> pluck [ "continent"; "region"; "skills"; "remoteWork" ] - |> result conn - -/// Citizen data access functions -[] -module Citizen = - - /// Find a citizen by their ID - let findById citizenId (session : IQuerySession) = backgroundTask { - let! citizen = session.LoadAsync (CitizenId.value citizenId) - return - match optional citizen with - | Some c when not c.isLegacy -> Some c - | Some _ - | None -> None - } - - /// Find a citizen by their e-mail address - let findByEmail email conn = backgroundTask { - let! citizen = - Sql.existingConnection conn - |> Sql.query "SELECT * FROM jjj.citizen WHERE email = @email AND is_legacy = FALSE" - |> Sql.parameters [ "@email", Sql.string email ] - |> Sql.executeAsync Map.toCitizen - return List.tryHead citizen - } - - /// Add or update a citizen - let save (citizen : Citizen) conn = backgroundTask { - let! _ = - Sql.existingConnection conn - |> Sql.query - "INSERT INTO jjj.citizen ( - id, joined_on, last_seen_on, email, first_name, last_name, password_hash, display_name, - other_contacts, is_legacy - ) VALUES ( - @id, @joinedOn, @lastSeenOn, @email, @firstName, @lastName, @passwordHash, @displayName, - @otherContacts, FALSE - ) ON CONFLICT (id) DO UPDATE - SET email = EXCLUDED.email, - first_name = EXCLUDED.first_name, - last_name = EXCLUDED.last_name, - password_hash = EXCLUDED.password_hash, - display_name = EXCLUDED.display_name, - other_contacts = EXCLUDED.other_contacts" - |> Sql.parameters - [ "@id", Sql.citizenId citizen.id - "@joinedOn" |>Sql.param<| citizen.joinedOn - "@lastSeenOn" |>Sql.param<| citizen.lastSeenOn - "@email", Sql.string citizen.email - "@firstName", Sql.string citizen.firstName - "@lastName", Sql.string citizen.lastName - "@passwordHash", Sql.string citizen.passwordHash - "@displayName", Sql.stringOrNone citizen.displayName - "@otherContacts", Sql.stringOrNone (if List.isEmpty citizen.otherContacts then None else Some "") - ] - |> Sql.executeNonQueryAsync - () - } - - /// Update the last seen on date for a citizen - let logOnUpdate (citizen : Citizen) conn = backgroundTask { - let! _ = - Sql.existingConnection conn - |> Sql.query "UPDATE jjj.citizen SET last_seen_on = @lastSeenOn WHERE id = @id" - |> Sql.parameters [ "@id", Sql.citizenId citizen.id; "@lastSeenOn" |>Sql.param<| citizen.lastSeenOn ] - |> Sql.executeNonQueryAsync - () - } - - /// Delete a citizen - let delete citizenId conn = backgroundTask { - let! _ = - Sql.existingConnection conn - |> Sql.query "DELETE FROM citizen WHERE id = @id" - |> Sql.parameters [ "@id", Sql.citizenId citizenId ] - |> Sql.executeNonQueryAsync - () - } - - -/// Continent data access functions -[] -module Continent = - - /// Get all continents - let all conn = - Sql.existingConnection conn - |> Sql.query "SELECT id AS continent_id, name AS continent_name FROM jjj.continent" - |> Sql.executeAsync Map.toContinent - - /// Get a continent by its ID - let findById contId conn = backgroundTask { - let! continent = - Sql.existingConnection conn - |> Sql.query "SELECT id AS continent_id, name AS continent_name FROM jjj.continent WHERE id = @id" - |> Sql.parameters [ "@id", Sql.continentId contId ] - |> Sql.executeAsync Map.toContinent - return List.tryHead continent - } - - -/// Job listing data access functions -[] -module Listing = - - /// The SQL to select the listing and continent fields - let private forViewSql = - "SELECT l.*, c.name AS continent_name - FROM jjj.listing l - INNER JOIN jjj.continent c ON c.id = l.continent_id" - - /// Find all job listings posted by the given citizen - let findByCitizen citizenId conn = - Sql.existingConnection conn - |> Sql.query $"{forViewSql} WHERE l.citizen_id = @citizenId" - |> Sql.parameters [ "@citizenId", Sql.citizenId citizenId ] - |> Sql.executeAsync Map.toListingForView - - /// Find a listing by its ID - let findById listingId conn = backgroundTask { - let! listing = - Sql.existingConnection conn - |> Sql.query "SELECT * FROM jjj.listing WHERE id = @id" - |> Sql.parameters [ "@id", Sql.listingId listingId ] - |> Sql.executeAsync Map.toListing - return List.tryHead listing - } - - /// Find a listing by its ID for viewing (includes continent information) - let findByIdForView (listingId : ListingId) conn = backgroundTask { - let! listing = - Sql.existingConnection conn - |> Sql.query $"{forViewSql} WHERE l.id = @id" - |> Sql.parameters [ "@id", Sql.listingId listingId ] - |> Sql.executeAsync Map.toListingForView - return List.tryHead listing - } - - /// Add or update a listing - let save (listing : Listing) conn = backgroundTask { - let! _ = - Sql.existingConnection conn - |> Sql.query - "INSERT INTO jjj.listing ( - id, citizen_id, created_on, title, continent_id, region, is_remote, is_expired, updated_on, - listing_text, needed_by, was_filled_here - ) VALUES ( - @id, @citizenId, @createdOn, @title, @continentId, @region, @isRemote, @isExpired, @updatedOn, - @text, @neededBy, @wasFilledHere - ) ON CONFLICT (id) DO UPDATE - SET title = EXCLUDED.title, - continent_id = EXCLUDED.continent_id, - region = EXCLUDED.region, - is_remote = EXCLUDED.is_remote, - is_expired = EXCLUDED.is_expired, - updated_on = EXCLUDED.updated_on, - listing_text = EXCLUDED.listing_text, - needed_by = EXCLUDED.needed_by, - was_filled_here = EXCLUDED.was_filled_here" - |> Sql.parameters - [ "@id", Sql.listingId listing.id - "@citizenId", Sql.citizenId listing.citizenId - "@createdOn" |>Sql.param<| listing.createdOn - "@title", Sql.string listing.title - "@continentId", Sql.continentId listing.continentId - "@region", Sql.string listing.region - "@isRemote", Sql.bool listing.remoteWork - "@isExpired", Sql.bool listing.isExpired - "@updatedOn" |>Sql.param<| listing.updatedOn - "@text", Sql.markdown listing.text - "@neededBy" |>Sql.paramOrNone<| listing.neededBy - "@wasFilledHere", Sql.boolOrNone listing.wasFilledHere - - ] - |> Sql.executeNonQueryAsync - () - } - - /// Expire a listing - let expire listingId fromHere (now : Instant) conn = backgroundTask { - let! _ = - Sql.existingConnection conn - |> Sql.query - "UPDATE jjj.listing - SET is_expired = TRUE, - was_filled_here = @wasFilledHere, - updated_on = @updatedOn - WHERE id = @id" - |> Sql.parameters - [ "@wasFilledHere", Sql.bool fromHere - "@updatedOn" |>Sql.param<| now - "@id", Sql.listingId listingId - ] - |> Sql.executeNonQueryAsync - () - } - - /// Search job listings - let search (search : ListingSearch) conn = - let filters = seq { - match search.continentId with - | Some contId -> - "l.continent = @continentId", [ "@continentId", Sql.continentId (ContinentId.ofString contId) ] - | None -> () - match search.region with - | Some region -> "l.region ILIKE '%@region%'", [ "@region", Sql.string region ] - | None -> () - if search.remoteWork <> "" then - "l.is_remote = @isRemote", ["@isRemote", Sql.bool (search.remoteWork = "yes") ] - match search.text with - | Some text -> "l.listing_text ILIKE '%@text%'", [ "@text", Sql.string text ] - | None -> () - } - let filterSql = filters |> Seq.map fst |> String.concat " AND " - Sql.existingConnection conn - |> Sql.query $"{forViewSql} WHERE l.is_expired = FALSE{filterSql}" - |> Sql.parameters (filters |> Seq.collect snd |> List.ofSeq) - |> Sql.executeAsync Map.toListingForView - - -/// Success story data access functions -[] -module Success = - - /// Find a success report by its ID - let findById successId conn = backgroundTask { - let! success = - Sql.existingConnection conn - |> Sql.query "SELECT * FROM jjj.success WHERE id = @id" - |> Sql.parameters [ "@id", Sql.successId successId ] - |> Sql.executeAsync Map.toSuccess - return List.tryHead success - } - - /// Insert or update a success story - let save (success : Success) conn = backgroundTask { - let! _ = - Sql.existingConnection conn - |> Sql.query - "INSERT INTO jjj.success ( - id, citizen_id, recorded_on, was_from_here, source, story - ) VALUES ( - @id, @citizenId, @recordedOn, @wasFromHere, @source, @story - ) ON CONFLICT (id) DO UPDATE - SET was_from_here = EXCLUDED.was_from_here, - story = EXCLUDED.story" - |> Sql.parameters - [ "@id", Sql.successId success.id - "@citizenId", Sql.citizenId success.citizenId - "@recordedOn" |>Sql.param<| success.recordedOn - "@wasFromHere", Sql.bool success.fromHere - "@source", Sql.string success.source - "@story", Sql.stringOrNone (Option.map MarkdownString.toString success.story) - ] - |> Sql.executeNonQueryAsync - () - } - - // Retrieve all success stories - let all conn = - fromTable Table.Success - |> eqJoin "citizenId" (fromTable Table.Citizen) - |> without [ "right.id" ] - |> zip - |> mergeFunc (fun it -> {| citizenName = deriveDisplayName it; hasStory = it.G("story").Default_("").Gt "" |}) - |> pluck [ "id"; "citizenId"; "citizenName"; "recordedOn"; "fromHere"; "hasStory" ] - |> orderByDescending "recordedOn" - |> result conn diff --git a/src/JobsJobsJobs/Server/Handlers.fs b/src/JobsJobsJobs/Server/Handlers.fs index 2f910ee..ecd51ab 100644 --- a/src/JobsJobsJobs/Server/Handlers.fs +++ b/src/JobsJobsJobs/Server/Handlers.fs @@ -1,7 +1,6 @@ /// Route handlers for Giraffe endpoints module JobsJobsJobs.Api.Handlers -open System.Threading open Giraffe open JobsJobsJobs.Domain open JobsJobsJobs.Domain.SharedTypes @@ -55,15 +54,12 @@ module Error = module Helpers = open System.Security.Claims - open System.Threading.Tasks open NodaTime - open Marten open Microsoft.Extensions.Configuration open Microsoft.Extensions.Options - open RethinkDb.Driver.Net /// Get the NodaTime clock from the request context - let clock (ctx : HttpContext) = ctx.GetService () + let now (ctx : HttpContext) = ctx.GetService().GetCurrentInstant () /// Get the application configuration from the request context let config (ctx : HttpContext) = ctx.GetService () @@ -74,15 +70,6 @@ module Helpers = /// Get the logger factory from the request context let logger (ctx : HttpContext) = ctx.GetService () - /// Get the RethinkDB connection from the request context - let conn (ctx : HttpContext) = ctx.GetService () - - /// Get a query session - let querySession (ctx : HttpContext) = ctx.GetService () - - /// Get a full document session - let docSession (ctx : HttpContext) = ctx.GetService () - /// `None` if a `string option` is `None`, whitespace, or empty let noneIfBlank (s : string option) = s |> Option.map (fun x -> match x.Trim () with "" -> None | _ -> Some x) |> Option.flatten @@ -106,16 +93,6 @@ module Helpers = /// Return an empty OK response let ok : HttpHandler = Successful.OK "" - - /// Convert a potentially-null record type to an option - let opt<'T> (it : Task<'T>) = task { - match! it with - | x when isNull (box x) -> return None - | x -> return Some x - } - - /// Shorthand for no cancellation token - let noCnx = CancellationToken.None open System @@ -127,48 +104,59 @@ module Citizen = // GET: /api/citizen/log-on/[code] let logOn (abbr, authCode) : HttpHandler = fun next ctx -> task { + match! Citizens.tryLogOn "to@do.com" (fun _ -> false) (now ctx) with + | Ok citizen -> + return! + json + { jwt = Auth.createJwt citizen (authConfig ctx) + citizenId = CitizenId.toString citizen.id + name = Citizen.name citizen + } next ctx + | Error msg -> + // TODO: return error message + return! RequestErrors.BAD_REQUEST msg next ctx // Step 1 - Verify with Mastodon - let cfg = authConfig ctx - - match cfg.Instances |> Array.tryFind (fun it -> it.Abbr = abbr) with - | Some instance -> - let log = (logger ctx).CreateLogger (nameof JobsJobsJobs.Api.Auth) - - match! Auth.verifyWithMastodon authCode instance cfg.ReturnHost log with - | Ok account -> - // Step 2 - Find / establish Jobs, Jobs, Jobs account - let now = (clock ctx).GetCurrentInstant () - let dbConn = conn ctx - let! citizen = task { - match! Data.Citizen.findByMastodonUser instance.Abbr account.Username dbConn with - | None -> - let it : Citizen = - { id = CitizenId.create () - instance = instance.Abbr - mastodonUser = account.Username - displayName = noneIfEmpty account.DisplayName - realName = None - profileUrl = account.Url - joinedOn = now - lastSeenOn = now - } - do! Data.Citizen.add it dbConn - return it - | Some citizen -> - let it = { citizen with displayName = noneIfEmpty account.DisplayName; lastSeenOn = now } - do! Data.Citizen.logOnUpdate it dbConn - return it - } - - // Step 3 - Generate JWT - return! - json - { jwt = Auth.createJwt citizen cfg - citizenId = CitizenId.toString citizen.id - name = Citizen.name citizen - } next ctx - | Error err -> return! RequestErrors.BAD_REQUEST err next ctx - | None -> return! Error.notFound next ctx + // let cfg = authConfig ctx + // + // match cfg.Instances |> Array.tryFind (fun it -> it.Abbr = abbr) with + // | Some instance -> + // let log = (logger ctx).CreateLogger (nameof JobsJobsJobs.Api.Auth) + // + // match! Auth.verifyWithMastodon authCode instance cfg.ReturnHost log with + // | Ok account -> + // // Step 2 - Find / establish Jobs, Jobs, Jobs account + // let now = (clock ctx).GetCurrentInstant () + // let dbConn = conn ctx + // let! citizen = task { + // match! Data.Citizen.findByMastodonUser instance.Abbr account.Username dbConn with + // | None -> + // let it : Citizen = + // { id = CitizenId.create () + // instance = instance.Abbr + // mastodonUser = account.Username + // displayName = noneIfEmpty account.DisplayName + // realName = None + // profileUrl = account.Url + // joinedOn = now + // lastSeenOn = now + // } + // do! Data.Citizen.add it dbConn + // return it + // | Some citizen -> + // let it = { citizen with displayName = noneIfEmpty account.DisplayName; lastSeenOn = now } + // do! Data.Citizen.logOnUpdate it dbConn + // return it + // } + // + // // Step 3 - Generate JWT + // return! + // json + // { jwt = Auth.createJwt citizen cfg + // citizenId = CitizenId.toString citizen.id + // name = Citizen.name citizen + // } next ctx + // | Error err -> return! RequestErrors.BAD_REQUEST err next ctx + // | None -> return! Error.notFound next ctx } // GET: /api/citizen/[id] @@ -248,7 +236,7 @@ module Listing = // POST: /listings let add : HttpHandler = authorize >=> fun next ctx -> task { let! form = ctx.BindJsonAsync () - let now = (clock ctx).GetCurrentInstant () + let now = now ctx do! Listings.save { id = ListingId.create () citizenId = currentCitizenId ctx @@ -269,7 +257,6 @@ module Listing = // PUT: /api/listing/[id] let update listingId : HttpHandler = authorize >=> fun next ctx -> task { - let dbConn = conn ctx match! Listings.findById (ListingId listingId) with | Some listing when listing.citizenId <> (currentCitizenId ctx) -> return! Error.notAuthorized next ctx | Some listing -> @@ -282,7 +269,7 @@ module Listing = remoteWork = form.remoteWork text = Text form.text neededBy = form.neededBy |> Option.map parseDate - updatedOn = (clock ctx).GetCurrentInstant () + updatedOn = now ctx } return! ok next ctx | None -> return! Error.notFound next ctx @@ -290,8 +277,7 @@ module Listing = // PATCH: /api/listing/[id] let expire listingId : HttpHandler = authorize >=> fun next ctx -> task { - let dbConn = conn ctx - let now = clock(ctx).GetCurrentInstant () + let now = now ctx match! Listings.findById (ListingId listingId) with | Some listing when listing.citizenId <> (currentCitizenId ctx) -> return! Error.notAuthorized next ctx | Some listing -> @@ -333,56 +319,41 @@ module Profile = // This returns the current citizen's profile, or a 204 if it is not found (a citizen not having a profile yet // is not an error). The "get" handler returns a 404 if a profile is not found. let current : HttpHandler = authorize >=> fun next ctx -> task { - match! Data.Profile.findById (currentCitizenId ctx) (conn ctx) with + match! Profiles.findById (currentCitizenId ctx) with | Some profile -> return! json profile next ctx | None -> return! Successful.NO_CONTENT next ctx } // GET: /api/profile/get/[id] let get citizenId : HttpHandler = authorize >=> fun next ctx -> task { - match! Data.Profile.findById (CitizenId citizenId) (conn ctx) with + match! Profiles.findById (CitizenId citizenId) with | Some profile -> return! json profile next ctx | None -> return! Error.notFound next ctx } // GET: /api/profile/view/[id] let view citizenId : HttpHandler = authorize >=> fun next ctx -> task { - let citId = CitizenId citizenId - let dbConn = conn ctx - match! Data.Profile.findById citId dbConn with - | Some profile -> - match! Data.Citizen.findById citId dbConn with - | Some citizen -> - match! Data.Continent.findById profile.continentId dbConn with - | Some continent -> - return! - json - { profile = profile - citizen = citizen - continent = continent - } next ctx - | None -> return! Error.notFound next ctx - | None -> return! Error.notFound next ctx + match! Profiles.findByIdForView (CitizenId citizenId) with + | Some profile -> return! json profile next ctx | None -> return! Error.notFound next ctx } // GET: /api/profile/count let count : HttpHandler = authorize >=> fun next ctx -> task { - let! theCount = Data.Profile.count (conn ctx) + let! theCount = Profiles.count () return! json { count = theCount } next ctx } // POST: /api/profile/save let save : HttpHandler = authorize >=> fun next ctx -> task { let citizenId = currentCitizenId ctx - let dbConn = conn ctx let! form = ctx.BindJsonAsync() let! profile = task { - match! Data.Profile.findById citizenId dbConn with + match! Profiles.findById citizenId with | Some p -> return p | None -> return { Profile.empty with id = citizenId } } - do! Data.Profile.save + do! Profiles.save { profile with seekingEmployment = form.isSeekingEmployment isPublic = form.isPublic @@ -391,48 +362,45 @@ module Profile = remoteWork = form.remoteWork fullTime = form.fullTime biography = Text form.biography - lastUpdatedOn = (clock ctx).GetCurrentInstant () + lastUpdatedOn = now ctx experience = noneIfBlank form.experience |> Option.map Text skills = form.skills |> List.map (fun s -> - { id = match s.id.StartsWith "new" with - | true -> SkillId.create () - | false -> SkillId.ofString s.id - description = s.description - notes = noneIfBlank s.notes - }) - } dbConn - do! Data.Citizen.realNameUpdate citizenId (noneIfBlank (Some form.realName)) dbConn + { id = if s.id.StartsWith "new" then SkillId.create () + else SkillId.ofString s.id + description = s.description + notes = noneIfBlank s.notes + }) + } return! ok next ctx } // PATCH: /api/profile/employment-found let employmentFound : HttpHandler = authorize >=> fun next ctx -> task { - let dbConn = conn ctx - match! Data.Profile.findById (currentCitizenId ctx) dbConn with + match! Profiles.findById (currentCitizenId ctx) with | Some profile -> - do! Data.Profile.save { profile with seekingEmployment = false } dbConn + do! Profiles.save { profile with seekingEmployment = false } return! ok next ctx | None -> return! Error.notFound next ctx } // DELETE: /api/profile let delete : HttpHandler = authorize >=> fun next ctx -> task { - do! Data.Profile.delete (currentCitizenId ctx) (conn ctx) + do! Profiles.deleteById (currentCitizenId ctx) return! ok next ctx } // GET: /api/profile/search let search : HttpHandler = authorize >=> fun next ctx -> task { let search = ctx.BindQueryString () - let! results = Data.Profile.search search (conn ctx) + let! results = Profiles.search search return! json results next ctx } // GET: /api/profile/public-search let publicSearch : HttpHandler = fun next ctx -> task { let search = ctx.BindQueryString () - let! results = Data.Profile.publicSearch search (conn ctx) + let! results = Profiles.publicSearch search return! json results next ctx } @@ -441,39 +409,35 @@ module Profile = [] module Success = - open System - // GET: /api/success/[id] let get successId : HttpHandler = authorize >=> fun next ctx -> task { - match! Data.Success.findById (SuccessId successId) (conn ctx) with + match! Successes.findById (SuccessId successId) with | Some story -> return! json story next ctx | None -> return! Error.notFound next ctx } // GET: /api/success/list let all : HttpHandler = authorize >=> fun next ctx -> task { - let! stories = Data.Success.all (conn ctx) + let! stories = Successes.all () return! json stories next ctx } // POST: /api/success/save let save : HttpHandler = authorize >=> fun next ctx -> task { let citizenId = currentCitizenId ctx - let dbConn = conn ctx - let now = (clock ctx).GetCurrentInstant () let! form = ctx.BindJsonAsync () let! success = task { match form.id with | "new" -> return Some { id = SuccessId.create () citizenId = citizenId - recordedOn = now + recordedOn = now ctx fromHere = form.fromHere source = "profile" story = noneIfEmpty form.story |> Option.map Text } | successId -> - match! Data.Success.findById (SuccessId.ofString successId) dbConn with + match! Successes.findById (SuccessId.ofString successId) with | Some story when story.citizenId = citizenId -> return Some { story with fromHere = form.fromHere @@ -483,7 +447,7 @@ module Success = } match success with | Some story -> - do! Data.Success.save story dbConn + do! Successes.save story return! ok next ctx | None -> return! Error.notFound next ctx } diff --git a/src/JobsJobsJobs/Server/JobsJobsJobs.Server.fsproj b/src/JobsJobsJobs/Server/JobsJobsJobs.Server.fsproj index 4dc6bbd..10807ec 100644 --- a/src/JobsJobsJobs/Server/JobsJobsJobs.Server.fsproj +++ b/src/JobsJobsJobs/Server/JobsJobsJobs.Server.fsproj @@ -8,7 +8,6 @@ - @@ -25,15 +24,10 @@ - + - - - - - - +