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

WIP on Marten data store

Browse Source
This commit is contained in:
Daniel J. Summers 2022-08-24 23:25:55 -04:00
parent 74f9709f82
commit ba6d20c7db
8 changed files with 365 additions and 40 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

7
src/JobsJobsJobs.sln
View File

@ -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

33
src/JobsJobsJobs/Domain/Types.fs
View File

@ -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

250
src/JobsJobsJobs/JobsJobsJobs.Data/Data.fs Normal file
View File

@ -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<Citizen>; typeof<Continent>; typeof<Listing>; typeof<Profile>; typeof<SecurityInfo>
typeof<Success>
]
opts.AutoCreateSchemaObjects <- AutoCreate.CreateOrUpdate
opts.UseJavascriptTransformsAndPatching ()
let _ = opts.Schema.For<Citizen>().Identity (fun c -> c.DbId)
let _ = opts.Schema.For<SecurityInfo>().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
[<AutoOpen>]
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
[<RequireQualifiedAccess>]
module Citizens =
/// Delete a citizen by their ID
let deleteById citizenId = backgroundTask {
use session = docSession ()
session.Delete<Citizen> (CitizenId.value citizenId)
do! session.SaveChangesAsync ()
}
/// Find a citizen by their ID
let findById citizenId = backgroundTask {
use session = querySession ()
let! citizen = session.LoadAsync<Citizen> (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> citizen
do! session.SaveChangesAsync ()
}
/// Attempt a user log on
let tryLogOn email (pwCheck : string -> bool) now = backgroundTask {
use session = docSession ()
let! tryCitizen =
session.Query<Citizen>().Where(fun c -> c.email = email && not c.isLegacy).SingleOrDefaultAsync ()
match optional tryCitizen with
| Some citizen ->
let! tryInfo = session.LoadAsync<SecurityInfo> citizen.DbId
let! info = backgroundTask {
match optional tryInfo with
| Some it -> return it
| None ->
let it = { SecurityInfo.empty with Id = citizen.id }
session.Store<SecurityInfo> it
do! session.SaveChangesAsync ()
return it
}
if info.AccountLocked then return Error "Log on unsuccessful (Account Locked)"
elif pwCheck citizen.passwordHash then
session.Patch<SecurityInfo>(citizen.DbId).Set((fun si -> si.FailedLogOnAttempts), 0)
session.Patch<Citizen>(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<SecurityInfo>(citizen.DbId).Increment(fun si -> si.FailedLogOnAttempts)
if locked then session.Patch<SecurityInfo>(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
[<RequireQualifiedAccess>]
module Continents =
/// Retrieve all continents
let all () = backgroundTask {
use session = querySession ()
let! it = session.Query<Continent>().ToListAsync<Continent> noCnx
return List.ofSeq it
}
/// Retrieve a continent by its ID
let findById continentId = backgroundTask {
use session = querySession ()
let! tryContinent = session.LoadAsync<Continent> (ContinentId.value continentId)
return optional tryContinent
}
open System
open JobsJobsJobs.Domain.SharedTypes
/// Job listing access functions
[<RequireQualifiedAccess>]
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<ContinentId, Continent> ()
let! listings =
session.Query<Listing>()
.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<Listing> (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<Listing>()
.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<ContinentId, Continent> ()
let searchQuery =
seq<Listing -> 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<Listing>()
.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
[<RequireQualifiedAccess>]
module Successes =
/// Save a success story
let save (success : Success) = backgroundTask {
use session = docSession ()
session.Store<Success> success
do! session.SaveChangesAsync ()
}

24
src/JobsJobsJobs/JobsJobsJobs.Data/JobsJobsJobs.Data.fsproj Normal file
View File

@ -0,0 +1,24 @@
<Project Sdk="Microsoft.NET.Sdk">
<PropertyGroup>
<TargetFramework>net6.0</TargetFramework>
<GenerateDocumentationFile>true</GenerateDocumentationFile>
</PropertyGroup>
<ItemGroup>
<Compile Include="Json.fs" />
<Compile Include="Data.fs" />
</ItemGroup>
<ItemGroup>
<ProjectReference Include="..\Domain\JobsJobsJobs.Domain.fsproj" />
</ItemGroup>
<ItemGroup>
<PackageReference Include="FSharp.SystemTextJson" Version="0.19.13" />
<PackageReference Include="Marten" Version="5.8.0" />
<PackageReference Include="Marten.NodaTime" Version="5.8.0" />
<PackageReference Include="Marten.PLv8" Version="5.8.0" />
</ItemGroup>
</Project>

24
src/JobsJobsJobs/JobsJobsJobs.Data/Json.fs Normal file
View File

@ -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<CitizenId> ()
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

16
src/JobsJobsJobs/Server/App.fs
View File

@ -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<IConfiguration> ()
// 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<ILoggerFactory>().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<Citizen>; typeof<Continent>; typeof<Listing>; typeof<Profile>; typeof<SecurityInfo>
typeof<Success>
])
.UseLightweightSessions()
// Set up the Marten data store
let _ = Connection.setUp cfg
()
[<EntryPoint>]

47
src/JobsJobsJobs/Server/Handlers.fs
View File

@ -119,6 +119,7 @@ module Helpers =
open System
open JobsJobsJobs.Data
/// Handlers for /api/citizen routes
[<RequireQualifiedAccess>]
@ -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<Citizen> 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<Citizen> (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<Continent>().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<ListingForm> ()
let now = (clock ctx).GetCurrentInstant ()
use session = docSession ctx
session.Store<Listing>({
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<ListingForm> ()
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<ListingExpireForm> ()
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<ListingSearch> ()
let! results = Data.Listing.search search (conn ctx)
let! results = Listings.search search
return! json results next ctx
}

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

@ -16,6 +16,7 @@
<ItemGroup>
<ProjectReference Include="..\Domain\JobsJobsJobs.Domain.fsproj" />
<ProjectReference Include="..\JobsJobsJobs.Data\JobsJobsJobs.Data.fsproj" />
</ItemGroup>
<ItemGroup>
@ -24,9 +25,6 @@
<ItemGroup>
<PackageReference Include="Giraffe" Version="6.0.0" />
<PackageReference Include="Marten" Version="5.8.0" />
<PackageReference Include="Marten.NodaTime" Version="5.8.0" />
<PackageReference Include="Marten.PLv8" Version="5.8.0" />
<PackageReference Include="Microsoft.AspNetCore.Authentication.JwtBearer" Version="6.0.6" />
<PackageReference Include="Microsoft.FSharpLu.Json" Version="0.11.7" />
<PackageReference Include="NodaTime.Serialization.JsonNet" Version="3.0.0" />