From 74f9709f82013fa36c2ed25110852b22a3dca163 Mon Sep 17 00:00:00 2001 From: "Daniel J. Summers" Date: Wed, 24 Aug 2022 19:47:20 -0400 Subject: [PATCH] WIP on Marten data --- src/JobsJobsJobs/Domain/Types.fs | 9 ++ src/JobsJobsJobs/Server/App.fs | 58 +++++---- src/JobsJobsJobs/Server/Data.fs | 119 +++++------------- src/JobsJobsJobs/Server/Handlers.fs | 66 +++++++--- .../Server/JobsJobsJobs.Server.fsproj | 3 + 5 files changed, 122 insertions(+), 133 deletions(-) diff --git a/src/JobsJobsJobs/Domain/Types.fs b/src/JobsJobsJobs/Domain/Types.fs index 063df14..eb094a4 100644 --- a/src/JobsJobsJobs/Domain/Types.fs +++ b/src/JobsJobsJobs/Domain/Types.fs @@ -35,6 +35,8 @@ type Citizen = /// The other contacts for this user otherContacts : OtherContact list + /// Whether this is a legacy citizen + isLegacy : bool } /// Support functions for citizens @@ -94,6 +96,9 @@ type Listing = /// Was this job filled as part of its appearance on Jobs, Jobs, Jobs? wasFilledHere : bool option + + /// Whether this is a legacy listing + isLegacy : bool } @@ -170,6 +175,9 @@ type Profile = /// Skills this citizen possesses skills : Skill list + + /// Whether this is a legacy profile + isLegacy : bool } /// Support functions for Profiles @@ -189,6 +197,7 @@ module Profile = lastUpdatedOn = Instant.MinValue experience = None skills = [] + isLegacy = false } diff --git a/src/JobsJobsJobs/Server/App.fs b/src/JobsJobsJobs/Server/App.fs index 6f685b4..0de9c41 100644 --- a/src/JobsJobsJobs/Server/App.fs +++ b/src/JobsJobsJobs/Server/App.fs @@ -24,49 +24,61 @@ 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.Domain.SharedTypes /// Configure dependency injection let configureServices (svc : IServiceCollection) = - svc.AddGiraffe () |> ignore - svc.AddSingleton SystemClock.Instance |> ignore - svc.AddLogging () |> ignore - svc.AddCors () |> ignore + let _ = svc.AddGiraffe () + let _ = svc.AddSingleton SystemClock.Instance + let _ = svc.AddLogging () + let _ = svc.AddCors () let jsonCfg = JsonSerializerSettings () Data.Converters.all () |> List.iter jsonCfg.Converters.Add - svc.AddSingleton (NewtonsoftJson.Serializer jsonCfg) |> ignore + let _ = svc.AddSingleton (NewtonsoftJson.Serializer jsonCfg) let svcs = svc.BuildServiceProvider () let cfg = svcs.GetRequiredService () - svc.AddAuthentication(fun o -> - o.DefaultAuthenticateScheme <- JwtBearerDefaults.AuthenticationScheme - o.DefaultChallengeScheme <- JwtBearerDefaults.AuthenticationScheme - o.DefaultScheme <- JwtBearerDefaults.AuthenticationScheme) - .AddJwtBearer(fun o -> - o.RequireHttpsMetadata <- false - o.TokenValidationParameters <- TokenValidationParameters ( - ValidateIssuer = true, - ValidateAudience = true, - ValidAudience = "https://noagendacareers.com", - ValidIssuer = "https://noagendacareers.com", - IssuerSigningKey = SymmetricSecurityKey ( - Encoding.UTF8.GetBytes (cfg.GetSection "Auth").["ServerSecret"]))) - |> ignore - svc.AddAuthorization () |> ignore - svc.Configure (cfg.GetSection "Auth") |> ignore + let _ = + svc.AddAuthentication(fun o -> + o.DefaultAuthenticateScheme <- JwtBearerDefaults.AuthenticationScheme + o.DefaultChallengeScheme <- JwtBearerDefaults.AuthenticationScheme + o.DefaultScheme <- JwtBearerDefaults.AuthenticationScheme) + .AddJwtBearer(fun opt -> + opt.RequireHttpsMetadata <- false + opt.TokenValidationParameters <- TokenValidationParameters ( + ValidateIssuer = true, + ValidateAudience = true, + ValidAudience = "https://noagendacareers.com", + ValidIssuer = "https://noagendacareers.com", + IssuerSigningKey = SymmetricSecurityKey ( + Encoding.UTF8.GetBytes (cfg.GetSection "Auth").["ServerSecret"]))) + 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 - svc.AddSingleton conn |> ignore - Data.Startup.establishEnvironment dbCfg log conn |> Async.AwaitTask |> Async.RunSynchronously + 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() + () [] let main _ = diff --git a/src/JobsJobsJobs/Server/Data.fs b/src/JobsJobsJobs/Server/Data.fs index 3c74b31..094335b 100644 --- a/src/JobsJobsJobs/Server/Data.fs +++ b/src/JobsJobsJobs/Server/Data.fs @@ -113,6 +113,7 @@ module private Reconnect = open RethinkDb.Driver.Ast +open Marten /// Shorthand for the RethinkDB R variable (how every command starts) let private r = RethinkDb.Driver.RethinkDB.R @@ -305,6 +306,7 @@ module Map = displayName = row.stringOrNone "display_name" // TODO: deserialize from JSON otherContacts = [] // row.stringOrNone "other_contacts" + isLegacy = false } /// Create a continent from a data row @@ -331,6 +333,7 @@ module Map = 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 @@ -353,6 +356,7 @@ module Map = lastUpdatedOn = row.fieldValue "last_updated_on" experience = row.stringOrNone "experience" |> Option.map Text skills = [] + isLegacy = false } /// Create a skill from a data row @@ -373,99 +377,34 @@ module Map = } +/// 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 conn = - Sql.existingConnection conn - |> Sql.query - "SELECT COUNT(p.citizen_id) - FROM jjj.profile p - INNER JOIN jjj.citizen c ON c.id = p.citizen_id - WHERE c.is_legacy = FALSE" - |> Sql.executeRowAsync Map.toCount + let count (session : IQuerySession) = + session.Query().Where(fun p -> not p.isLegacy).LongCountAsync () /// Find a profile by citizen ID - let findById citizenId conn = backgroundTask { - let! tryProfile = - Sql.existingConnection conn - |> Sql.query - "SELECT * - FROM jjj.profile p - INNER JOIN jjj.citizen ON c.id = p.citizen_id - WHERE p.citizen_id = @id - AND c.is_legacy = FALSE" - |> Sql.parameters [ "@id", Sql.citizenId citizenId ] - |> Sql.executeAsync Map.toProfile - match List.tryHead tryProfile with - | Some profile -> - let! skills = - Sql.existingConnection conn - |> Sql.query "SELECT * FROM jjj.profile_skill WHERE citizen_id = @id" - |> Sql.parameters [ "@id", Sql.citizenId citizenId ] - |> Sql.executeAsync Map.toSkill - return Some { profile with skills = skills } - | None -> return None + 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) conn = backgroundTask { - let! _ = - Sql.existingConnection conn - |> Sql.executeTransactionAsync [ - "INSERT INTO jjj.profile ( - citizen_id, is_seeking, is_public_searchable, is_public_linkable, continent_id, region, - is_available_remotely, is_available_full_time, biography, last_updated_on, experience - ) VALUES ( - @citizenId, @isSeeking, @isPublicSearchable, @isPublicLinkable, @continentId, @region, - @isAvailableRemotely, @isAvailableFullTime, @biography, @lastUpdatedOn, @experience - ) ON CONFLICT (citizen_id) DO UPDATE - SET is_seeking = EXCLUDED.is_seeking, - is_public_searchable = EXCLUDED.is_public_searchable, - is_public_linkable = EXCLUDED.is_public_linkable, - continent_id = EXCLUDED.continent_id, - region = EXCLUDED.region, - is_available_remotely = EXCLUDED.is_available_remotely, - is_available_full_time = EXCLUDED.is_available_full_time, - biography = EXCLUDED.biography, - last_updated_on = EXCLUDED.last_updated_on, - experience = EXCLUDED.experience", - [ [ "@citizenId", Sql.citizenId profile.id - "@isSeeking", Sql.bool profile.seekingEmployment - "@isPublicSearchable", Sql.bool profile.isPublic - "@isPublicLinkable", Sql.bool profile.isPublicLinkable - "@continentId", Sql.continentId profile.continentId - "@region", Sql.string profile.region - "@isAvailableRemotely", Sql.bool profile.remoteWork - "@isAvailableFullTime", Sql.bool profile.fullTime - "@biography", Sql.markdown profile.biography - "@lastUpdatedOn" |>Sql.param<| profile.lastUpdatedOn - "@experience", Sql.stringOrNone (Option.map MarkdownString.toString profile.experience) - ] ] - - "INSERT INTO jjj.profile ( - id, citizen_id, description, notes - ) VALUES ( - @id, @citizenId, @description, @notes - ) ON CONFLICT (id) DO UPDATE - SET description = EXCLUDED.description, - notes = EXCLUDED.notes", - profile.skills - |> List.map (fun skill -> [ - "@id", Sql.skillId skill.id - "@citizenId", Sql.citizenId profile.id - "@description", Sql.string skill.description - "@notes" , Sql.stringOrNone skill.notes - ]) - - $"""DELETE FROM jjj.profile - WHERE id NOT IN ({profile.skills |> List.mapi (fun idx _ -> $"@id{idx}") |> String.concat ", "})""", - [ profile.skills |> List.mapi (fun idx skill -> $"@id{idx}", Sql.skillId skill.id) ] - ] - () - } + [] + let save (profile : Profile) (session : IDocumentSession) = + session.Store profile /// Delete a citizen's profile let delete citizenId conn = backgroundTask { @@ -543,13 +482,13 @@ module Profile = module Citizen = /// Find a citizen by their ID - let findById citizenId conn = backgroundTask { - let! citizen = - Sql.existingConnection conn - |> Sql.query "SELECT * FROM jjj.citizen WHERE id = @id AND is_legacy = FALSE" - |> Sql.parameters [ "@id", Sql.citizenId citizenId ] - |> Sql.executeAsync Map.toCitizen - return List.tryHead citizen + 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 diff --git a/src/JobsJobsJobs/Server/Handlers.fs b/src/JobsJobsJobs/Server/Handlers.fs index 89617e3..128de1f 100644 --- a/src/JobsJobsJobs/Server/Handlers.fs +++ b/src/JobsJobsJobs/Server/Handlers.fs @@ -1,10 +1,10 @@ /// Route handlers for Giraffe endpoints module JobsJobsJobs.Api.Handlers +open System.Threading open Giraffe open JobsJobsJobs.Domain open JobsJobsJobs.Domain.SharedTypes -open JobsJobsJobs.Domain.Types open Microsoft.AspNetCore.Http open Microsoft.Extensions.Logging @@ -54,11 +54,13 @@ 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 - open System.Security.Claims /// Get the NodaTime clock from the request context let clock (ctx : HttpContext) = ctx.GetService () @@ -74,6 +76,12 @@ module Helpers = /// 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) = @@ -98,8 +106,19 @@ 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 /// Handlers for /api/citizen routes [] @@ -152,15 +171,18 @@ module Citizen = } // GET: /api/citizen/[id] - let get citizenId : HttpHandler = authorize >=> fun next ctx -> task { - match! Data.Citizen.findById (CitizenId citizenId) (conn ctx) with + let get (citizenId : Guid) : HttpHandler = authorize >=> fun next ctx -> task { + use session = querySession ctx + match! session.LoadAsync citizenId |> opt 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 { - do! Data.Citizen.delete (currentCitizenId ctx) (conn ctx) + use session = docSession ctx + session.Delete (CitizenId.value (currentCitizenId ctx)) + do! session.SaveChangesAsync () return! ok next ctx } @@ -171,7 +193,8 @@ module Continent = // GET: /api/continent/all let all : HttpHandler = fun next ctx -> task { - let! continents = Data.Continent.all (conn ctx) + use session = querySession ctx + let! continents = session.Query().ToListAsync noCnx return! json continents next ctx } @@ -230,20 +253,23 @@ module Listing = let add : HttpHandler = authorize >=> fun next ctx -> task { let! form = ctx.BindJsonAsync () let now = (clock ctx).GetCurrentInstant () - do! Data.Listing.add - { id = ListingId.create () - citizenId = currentCitizenId ctx - createdOn = now - title = form.title - continentId = ContinentId.ofString form.continentId - region = form.region - remoteWork = form.remoteWork - isExpired = false - updatedOn = now - text = Text form.text - neededBy = (form.neededBy |> Option.map parseDate) - wasFilledHere = None - } (conn ctx) + use session = docSession ctx + session.Store({ + id = ListingId.create () + citizenId = currentCitizenId ctx + createdOn = now + title = form.title + continentId = ContinentId.ofString form.continentId + region = form.region + remoteWork = form.remoteWork + isExpired = false + updatedOn = now + text = Text form.text + neededBy = (form.neededBy |> Option.map parseDate) + wasFilledHere = None + isLegacy = false + }) + do! session.SaveChangesAsync () return! ok next ctx } diff --git a/src/JobsJobsJobs/Server/JobsJobsJobs.Server.fsproj b/src/JobsJobsJobs/Server/JobsJobsJobs.Server.fsproj index f398460..b9f515e 100644 --- a/src/JobsJobsJobs/Server/JobsJobsJobs.Server.fsproj +++ b/src/JobsJobsJobs/Server/JobsJobsJobs.Server.fsproj @@ -24,6 +24,9 @@ + + +