From ba6d20c7dbfe7f857b4165cb46a40e128544e29c Mon Sep 17 00:00:00 2001 From: "Daniel J. Summers" Date: Wed, 24 Aug 2022 23:25:55 -0400 Subject: [PATCH] WIP on Marten data store --- src/JobsJobsJobs.sln | 7 + src/JobsJobsJobs/Domain/Types.fs | 33 ++- src/JobsJobsJobs/JobsJobsJobs.Data/Data.fs | 250 ++++++++++++++++++ .../JobsJobsJobs.Data.fsproj | 24 ++ src/JobsJobsJobs/JobsJobsJobs.Data/Json.fs | 24 ++ src/JobsJobsJobs/Server/App.fs | 16 +- src/JobsJobsJobs/Server/Handlers.fs | 47 ++-- .../Server/JobsJobsJobs.Server.fsproj | 4 +- 8 files changed, 365 insertions(+), 40 deletions(-) create mode 100644 src/JobsJobsJobs/JobsJobsJobs.Data/Data.fs create mode 100644 src/JobsJobsJobs/JobsJobsJobs.Data/JobsJobsJobs.Data.fsproj create mode 100644 src/JobsJobsJobs/JobsJobsJobs.Data/Json.fs diff --git a/src/JobsJobsJobs.sln b/src/JobsJobsJobs.sln index b1398c3..c226a73 100644 --- a/src/JobsJobsJobs.sln +++ b/src/JobsJobsJobs.sln @@ -17,6 +17,8 @@ Project("{F2A71F9B-5D33-465A-A702-920D77279786}") = "Domain", "JobsJobsJobs\Doma EndProject Project("{F2A71F9B-5D33-465A-A702-920D77279786}") = "Api", "JobsJobsJobs\Server\JobsJobsJobs.Server.fsproj", "{8F5A3D1E-562B-4F27-9787-6CB14B35E69E}" EndProject +Project("{F2A71F9B-5D33-465A-A702-920D77279786}") = "JobsJobsJobs.Data", "JobsJobsJobs\JobsJobsJobs.Data\JobsJobsJobs.Data.fsproj", "{30CC1E7C-A843-4DAC-9058-E7C6ACBCE85D}" +EndProject Global GlobalSection(SolutionConfigurationPlatforms) = preSolution Debug|Any CPU = Debug|Any CPU @@ -31,6 +33,10 @@ Global {8F5A3D1E-562B-4F27-9787-6CB14B35E69E}.Debug|Any CPU.Build.0 = Debug|Any CPU {8F5A3D1E-562B-4F27-9787-6CB14B35E69E}.Release|Any CPU.ActiveCfg = Release|Any CPU {8F5A3D1E-562B-4F27-9787-6CB14B35E69E}.Release|Any CPU.Build.0 = Release|Any CPU + {30CC1E7C-A843-4DAC-9058-E7C6ACBCE85D}.Debug|Any CPU.ActiveCfg = Debug|Any CPU + {30CC1E7C-A843-4DAC-9058-E7C6ACBCE85D}.Debug|Any CPU.Build.0 = Debug|Any CPU + {30CC1E7C-A843-4DAC-9058-E7C6ACBCE85D}.Release|Any CPU.ActiveCfg = Release|Any CPU + {30CC1E7C-A843-4DAC-9058-E7C6ACBCE85D}.Release|Any CPU.Build.0 = Release|Any CPU EndGlobalSection GlobalSection(SolutionProperties) = preSolution HideSolutionNode = FALSE @@ -41,5 +47,6 @@ Global GlobalSection(NestedProjects) = preSolution {C81278DA-DA97-4E55-AB39-4B88565B615D} = {FA833B24-B8F6-4CE6-A044-99257EAC02FF} {8F5A3D1E-562B-4F27-9787-6CB14B35E69E} = {FA833B24-B8F6-4CE6-A044-99257EAC02FF} + {30CC1E7C-A843-4DAC-9058-E7C6ACBCE85D} = {FA833B24-B8F6-4CE6-A044-99257EAC02FF} EndGlobalSection EndGlobal diff --git a/src/JobsJobsJobs/Domain/Types.fs b/src/JobsJobsJobs/Domain/Types.fs index eb094a4..c1deb1b 100644 --- a/src/JobsJobsJobs/Domain/Types.fs +++ b/src/JobsJobsJobs/Domain/Types.fs @@ -38,6 +38,9 @@ type Citizen = /// Whether this is a legacy citizen isLegacy : bool } +with + /// Unwrapped ID for database PK use + member this.DbId = CitizenId.value this.id /// Support functions for citizens module Citizen = @@ -56,6 +59,18 @@ type Continent = /// The name of the continent name : string } +with + /// Unwrapped ID for database PK use + member this.DbId = ContinentId.value this.id + +/// Support functions for continents +module Continent = + + /// An empty continent + let empty = + { id = ContinentId Guid.Empty + name = "" + } /// A job listing @@ -108,7 +123,7 @@ type SecurityInfo = Id : CitizenId /// The number of failed log on attempts (reset to 0 on successful log on) - FailedLogOnAttempts : int16 + FailedLogOnAttempts : int /// Whether the account is locked AccountLocked : bool @@ -122,6 +137,22 @@ type SecurityInfo = /// When the token expires TokenExpires : Instant option } +with + /// Unwrapped ID for database PK use + member this.DbId = CitizenId.value this.Id + +/// Functions to support security info +module SecurityInfo = + + /// An empty set of security info + let empty = + { Id = CitizenId Guid.Empty + FailedLogOnAttempts = 0 + AccountLocked = false + Token = None + TokenUsage = None + TokenExpires = None + } /// A skill the job seeker possesses diff --git a/src/JobsJobsJobs/JobsJobsJobs.Data/Data.fs b/src/JobsJobsJobs/JobsJobsJobs.Data/Data.fs new file mode 100644 index 0000000..69cb3c0 --- /dev/null +++ b/src/JobsJobsJobs/JobsJobsJobs.Data/Data.fs @@ -0,0 +1,250 @@ +namespace JobsJobsJobs.Data + +open JobsJobsJobs.Domain +open Marten +open Marten.PLv8 +open Microsoft.Extensions.Configuration + +/// Connection management for the Marten document store +module Connection = + + open Weasel.Core + + /// The configuration from which a document store will be created + let mutable private config : IConfiguration option = None + + /// Lazy initialization for the Marten document store, constructed when setUp() is called + let private lazyStore = lazy (task { + match config with + | Some cfg -> + let store = + DocumentStore.For(fun opts -> + opts.Connection (cfg.GetConnectionString "PostgreSQL") + opts.RegisterDocumentTypes [ + typeof; typeof; typeof; typeof; typeof + typeof + ] + opts.AutoCreateSchemaObjects <- AutoCreate.CreateOrUpdate + opts.UseJavascriptTransformsAndPatching () + + let _ = opts.Schema.For().Identity (fun c -> c.DbId) + let _ = opts.Schema.For().Identity (fun si -> si.DbId) + ()) + do! store.Storage.ApplyAllConfiguredChangesToDatabaseAsync () + return Ok store + | None -> return Error "Connection.setUp() must be called before accessing a document session" + }) + + /// Set up the data connection from the given configuration + let setUp (cfg : IConfiguration) = + config <- Some cfg + ignore (lazyStore.Force ()) + + /// A read-only document session + let querySession () = + match lazyStore.Force().Result with + | Ok store -> store.QuerySession () + | Error msg -> raise (invalidOp msg) + + /// A read/write document session + let docSession () = + match lazyStore.Force().Result with + | Ok store -> store.LightweightSession () + | Error msg -> raise (invalidOp msg) + + +/// 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 + + +open System.Linq +open Connection +open Marten.PLv8.Patching + +/// Citizen data access functions +[] +module Citizens = + + /// Delete a citizen by their ID + let deleteById citizenId = backgroundTask { + use session = docSession () + session.Delete (CitizenId.value citizenId) + do! session.SaveChangesAsync () + } + + /// Find a citizen by their ID + let findById citizenId = backgroundTask { + use session = querySession () + let! citizen = session.LoadAsync (CitizenId.value citizenId) + return + match optional citizen with + | Some c when not c.isLegacy -> Some c + | Some _ + | None -> None + } + + /// Save a citizen + let save (citizen : Citizen) = backgroundTask { + use session = docSession () + session.Store citizen + do! session.SaveChangesAsync () + } + + /// Attempt a user log on + 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 + | Some citizen -> + let! tryInfo = session.LoadAsync citizen.DbId + let! info = backgroundTask { + match optional tryInfo with + | Some it -> return it + | None -> + let it = { SecurityInfo.empty with Id = citizen.id } + session.Store 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) + 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) + do! session.SaveChangesAsync () + return Error $"""Log on unsuccessful{if locked then " - Account is now locked" else ""}""" + | None -> return Error "Log on unsuccessful" + } + + +/// Continent data access functions +[] +module Continents = + + /// Retrieve all continents + let all () = backgroundTask { + use session = querySession () + let! it = session.Query().ToListAsync noCnx + return List.ofSeq it + } + + /// Retrieve a continent by its ID + let findById continentId = backgroundTask { + use session = querySession () + let! tryContinent = session.LoadAsync (ContinentId.value continentId) + return optional 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! listings = + session.Query() + .Include((fun l -> l.continentId :> obj), continents) + .Where(fun l -> l.citizenId = citizenId && not l.isLegacy) + .ToListAsync () + return + listings + |> Seq.map (fun l -> { listing = l; continent = continents[l.continentId] }) + |> 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 + | Some listing when not listing.isLegacy -> return Some listing + | Some _ + | None -> return None + } + + /// Find a listing by its ID for viewing (includes continent information) + let findByIdForView listingId = backgroundTask { + use session = querySession () + let mutable continent = Continent.empty + let! tryListing = + session.Query() + .Include((fun l -> l.continentId :> obj), fun c -> continent <- c) + .Where(fun l -> l.id = listingId && not l.isLegacy) + .SingleOrDefaultAsync () + match optional tryListing with + | Some listing -> return Some { listing = listing; continent = continent } + | None -> return None + } + + /// Save a listing + let save (listing : Listing) = backgroundTask { + use session = docSession () + session.Store listing + do! session.SaveChangesAsync () + } + + /// Search job listings + let search (search : ListingSearch) = backgroundTask { + use session = querySession () + let continents = Dictionary () + let searchQuery = + seq bool> { + match search.continentId with + | Some contId -> + fun (l : Listing) -> l.continentId = (ContinentId.ofString contId) + | None -> () + match search.region with + | Some region -> fun (l : Listing) -> l.region.Contains (region, StringComparison.OrdinalIgnoreCase) + | None -> () + if search.remoteWork <> "" then + fun (l : Listing) -> l.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)) + let! results = searchQuery.ToListAsync () + return + results + |> Seq.map (fun l -> { listing = l; continent = continents[l.continentId] }) + |> List.ofSeq + } + +/// Success story data access functions +[] +module Successes = + + /// Save a success story + let save (success : Success) = backgroundTask { + use session = docSession () + session.Store 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 new file mode 100644 index 0000000..c7191ec --- /dev/null +++ b/src/JobsJobsJobs/JobsJobsJobs.Data/JobsJobsJobs.Data.fsproj @@ -0,0 +1,24 @@ + + + + net6.0 + true + + + + + + + + + + + + + + + + + + + diff --git a/src/JobsJobsJobs/JobsJobsJobs.Data/Json.fs b/src/JobsJobsJobs/JobsJobsJobs.Data/Json.fs new file mode 100644 index 0000000..de761d0 --- /dev/null +++ b/src/JobsJobsJobs/JobsJobsJobs.Data/Json.fs @@ -0,0 +1,24 @@ +module JobsJobsJobs.Data.Json + +open System +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 ()) + + +/// JsonSerializer options that use the custom converters +let options = + let opts = JsonSerializerOptions () + [ CitizenIdJsonConverter () :> JsonConverter + JsonFSharpConverter () + ] + |> List.iter opts.Converters.Add + opts diff --git a/src/JobsJobsJobs/Server/App.fs b/src/JobsJobsJobs/Server/App.fs index 0de9c41..fc88566 100644 --- a/src/JobsJobsJobs/Server/App.fs +++ b/src/JobsJobsJobs/Server/App.fs @@ -24,13 +24,12 @@ let configureApp (app : IApplicationBuilder) = open Newtonsoft.Json open NodaTime -open Marten open Microsoft.AspNetCore.Authentication.JwtBearer open Microsoft.Extensions.Configuration open Microsoft.Extensions.Logging open Microsoft.IdentityModel.Tokens open System.Text -open JobsJobsJobs.Domain +open JobsJobsJobs.Data open JobsJobsJobs.Domain.SharedTypes /// Configure dependency injection @@ -47,6 +46,7 @@ let configureServices (svc : IServiceCollection) = let svcs = svc.BuildServiceProvider () let cfg = svcs.GetRequiredService () + // Set up JWTs for API access let _ = svc.AddAuthentication(fun o -> o.DefaultAuthenticateScheme <- JwtBearerDefaults.AuthenticationScheme @@ -68,16 +68,8 @@ let configureServices (svc : IServiceCollection) = let log = svcs.GetRequiredService().CreateLogger "JobsJobsJobs.Api.Data.Startup" let conn = Data.Startup.createConnection dbCfg log let _ = svc.AddSingleton conn |> ignore - //Data.Startup.establishEnvironment dbCfg log conn |> Async.AwaitTask |> Async.RunSynchronously - - let _ = - svc.AddMarten(fun (opts : StoreOptions) -> - opts.Connection (cfg.GetConnectionString "PostgreSQL") - opts.RegisterDocumentTypes [ - typeof; typeof; typeof; typeof; typeof - typeof - ]) - .UseLightweightSessions() + // Set up the Marten data store + let _ = Connection.setUp cfg () [] diff --git a/src/JobsJobsJobs/Server/Handlers.fs b/src/JobsJobsJobs/Server/Handlers.fs index 128de1f..2f910ee 100644 --- a/src/JobsJobsJobs/Server/Handlers.fs +++ b/src/JobsJobsJobs/Server/Handlers.fs @@ -119,6 +119,7 @@ module Helpers = open System +open JobsJobsJobs.Data /// Handlers for /api/citizen routes [] @@ -171,18 +172,15 @@ module Citizen = } // GET: /api/citizen/[id] - let get (citizenId : Guid) : HttpHandler = authorize >=> fun next ctx -> task { - use session = querySession ctx - match! session.LoadAsync citizenId |> opt with + let get citizenId : HttpHandler = authorize >=> fun next ctx -> task { + match! Citizens.findById (CitizenId citizenId) with | Some citizen -> return! json citizen next ctx | None -> return! Error.notFound next ctx } // DELETE: /api/citizen let delete : HttpHandler = authorize >=> fun next ctx -> task { - use session = docSession ctx - session.Delete (CitizenId.value (currentCitizenId ctx)) - do! session.SaveChangesAsync () + do! Citizens.deleteById (currentCitizenId ctx) return! ok next ctx } @@ -193,8 +191,7 @@ module Continent = // GET: /api/continent/all let all : HttpHandler = fun next ctx -> task { - use session = querySession ctx - let! continents = session.Query().ToListAsync noCnx + let! continents = Continents.all () return! json continents next ctx } @@ -224,27 +221,26 @@ module Instances = module Listing = open NodaTime - open System /// Parse the string we receive from JSON into a NodaTime local date let private parseDate = DateTime.Parse >> LocalDate.FromDateTime // GET: /api/listings/mine let mine : HttpHandler = authorize >=> fun next ctx -> task { - let! listings = Data.Listing.findByCitizen (currentCitizenId ctx) (conn ctx) + let! listings = Listings.findByCitizen (currentCitizenId ctx) return! json listings next ctx } // GET: /api/listing/[id] let get listingId : HttpHandler = authorize >=> fun next ctx -> task { - match! Data.Listing.findById (ListingId listingId) (conn ctx) with + match! Listings.findById (ListingId listingId) with | Some listing -> return! json listing next ctx | None -> return! Error.notFound next ctx } // GET: /api/listing/view/[id] let view listingId : HttpHandler = authorize >=> fun next ctx -> task { - match! Data.Listing.findByIdForView (ListingId listingId) (conn ctx) with + match! Listings.findByIdForView (ListingId listingId) with | Some listing -> return! json listing next ctx | None -> return! Error.notFound next ctx } @@ -253,8 +249,7 @@ module Listing = let add : HttpHandler = authorize >=> fun next ctx -> task { let! form = ctx.BindJsonAsync () let now = (clock ctx).GetCurrentInstant () - use session = docSession ctx - session.Store({ + do! Listings.save { id = ListingId.create () citizenId = currentCitizenId ctx createdOn = now @@ -268,19 +263,18 @@ module Listing = neededBy = (form.neededBy |> Option.map parseDate) wasFilledHere = None isLegacy = false - }) - do! session.SaveChangesAsync () + } return! ok next ctx } // PUT: /api/listing/[id] let update listingId : HttpHandler = authorize >=> fun next ctx -> task { let dbConn = conn ctx - match! Data.Listing.findById (ListingId listingId) dbConn with + match! Listings.findById (ListingId listingId) with | Some listing when listing.citizenId <> (currentCitizenId ctx) -> return! Error.notAuthorized next ctx | Some listing -> let! form = ctx.BindJsonAsync () - do! Data.Listing.update + do! Listings.save { listing with title = form.title continentId = ContinentId.ofString form.continentId @@ -289,7 +283,7 @@ module Listing = text = Text form.text neededBy = form.neededBy |> Option.map parseDate updatedOn = (clock ctx).GetCurrentInstant () - } dbConn + } return! ok next ctx | None -> return! Error.notFound next ctx } @@ -298,21 +292,26 @@ module Listing = let expire listingId : HttpHandler = authorize >=> fun next ctx -> task { let dbConn = conn ctx let now = clock(ctx).GetCurrentInstant () - match! Data.Listing.findById (ListingId listingId) dbConn with + match! Listings.findById (ListingId listingId) with | Some listing when listing.citizenId <> (currentCitizenId ctx) -> return! Error.notAuthorized next ctx | Some listing -> let! form = ctx.BindJsonAsync () - do! Data.Listing.expire listing.id form.fromHere now dbConn + do! Listings.save + { listing with + isExpired = true + wasFilledHere = Some form.fromHere + updatedOn = now + } match form.successStory with | Some storyText -> - do! Data.Success.save + do! Successes.save { id = SuccessId.create() citizenId = currentCitizenId ctx recordedOn = now fromHere = form.fromHere source = "listing" story = (Text >> Some) storyText - } dbConn + } | None -> () return! ok next ctx | None -> return! Error.notFound next ctx @@ -321,7 +320,7 @@ module Listing = // GET: /api/listing/search let search : HttpHandler = authorize >=> fun next ctx -> task { let search = ctx.BindQueryString () - let! results = Data.Listing.search search (conn ctx) + let! results = Listings.search search return! json results next ctx } diff --git a/src/JobsJobsJobs/Server/JobsJobsJobs.Server.fsproj b/src/JobsJobsJobs/Server/JobsJobsJobs.Server.fsproj index b9f515e..4dc6bbd 100644 --- a/src/JobsJobsJobs/Server/JobsJobsJobs.Server.fsproj +++ b/src/JobsJobsJobs/Server/JobsJobsJobs.Server.fsproj @@ -16,6 +16,7 @@ + @@ -24,9 +25,6 @@ - - -