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

First cut of Marten data implementation

Browse Source
This commit is contained in:
Daniel J. Summers 2022-08-26 16:34:39 -04:00
parent ba6d20c7db
commit 6896b0e60e
12 changed files with 551 additions and 1041 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

159
build.fsx.lock
View File

@ -5,95 +5,95 @@ NUGET
BlackFox.VsWhere (1.1) BlackFox.VsWhere (1.1)
FSharp.Core (>= 4.2.3) FSharp.Core (>= 4.2.3)
Microsoft.Win32.Registry (>= 4.7) Microsoft.Win32.Registry (>= 4.7)
Fake.Core.CommandLineParsing (5.22) Fake.Core.CommandLineParsing (5.23)
FParsec (>= 1.1.1) FParsec (>= 1.1.1)
FSharp.Core (>= 6.0) FSharp.Core (>= 6.0)
Fake.Core.Context (5.22) Fake.Core.Context (5.23)
FSharp.Core (>= 6.0) FSharp.Core (>= 6.0)
Fake.Core.Environment (5.22) Fake.Core.Environment (5.23)
FSharp.Core (>= 6.0) FSharp.Core (>= 6.0)
Fake.Core.FakeVar (5.22) Fake.Core.FakeVar (5.23)
Fake.Core.Context (>= 5.22) Fake.Core.Context (>= 5.23)
FSharp.Core (>= 6.0) FSharp.Core (>= 6.0)
Fake.Core.Process (5.22) Fake.Core.Process (5.23)
Fake.Core.Environment (>= 5.22) Fake.Core.Environment (>= 5.23)
Fake.Core.FakeVar (>= 5.22) Fake.Core.FakeVar (>= 5.23)
Fake.Core.String (>= 5.22) Fake.Core.String (>= 5.23)
Fake.Core.Trace (>= 5.22) Fake.Core.Trace (>= 5.23)
Fake.IO.FileSystem (>= 5.22) Fake.IO.FileSystem (>= 5.23)
FSharp.Core (>= 6.0) FSharp.Core (>= 6.0)
System.Collections.Immutable (>= 5.0) System.Collections.Immutable (>= 5.0)
Fake.Core.SemVer (5.22) Fake.Core.SemVer (5.23)
FSharp.Core (>= 6.0) FSharp.Core (>= 6.0)
Fake.Core.String (5.22) Fake.Core.String (5.23)
FSharp.Core (>= 6.0) FSharp.Core (>= 6.0)
Fake.Core.Target (5.22) Fake.Core.Target (5.23)
Fake.Core.CommandLineParsing (>= 5.22) Fake.Core.CommandLineParsing (>= 5.23)
Fake.Core.Context (>= 5.22) Fake.Core.Context (>= 5.23)
Fake.Core.Environment (>= 5.22) Fake.Core.Environment (>= 5.23)
Fake.Core.FakeVar (>= 5.22) Fake.Core.FakeVar (>= 5.23)
Fake.Core.Process (>= 5.22) Fake.Core.Process (>= 5.23)
Fake.Core.String (>= 5.22) Fake.Core.String (>= 5.23)
Fake.Core.Trace (>= 5.22) Fake.Core.Trace (>= 5.23)
FSharp.Control.Reactive (>= 5.0.2) FSharp.Control.Reactive (>= 5.0.2)
FSharp.Core (>= 6.0) FSharp.Core (>= 6.0)
Fake.Core.Tasks (5.22) Fake.Core.Tasks (5.23)
Fake.Core.Trace (>= 5.22) Fake.Core.Trace (>= 5.23)
FSharp.Core (>= 6.0) FSharp.Core (>= 6.0)
Fake.Core.Trace (5.22) Fake.Core.Trace (5.23)
Fake.Core.Environment (>= 5.22) Fake.Core.Environment (>= 5.23)
Fake.Core.FakeVar (>= 5.22) Fake.Core.FakeVar (>= 5.23)
FSharp.Core (>= 6.0) FSharp.Core (>= 6.0)
Fake.Core.Xml (5.22) Fake.Core.Xml (5.23)
Fake.Core.String (>= 5.22) Fake.Core.String (>= 5.23)
FSharp.Core (>= 6.0) FSharp.Core (>= 6.0)
Fake.DotNet.Cli (5.22) Fake.DotNet.Cli (5.23)
Fake.Core.Environment (>= 5.22) Fake.Core.Environment (>= 5.23)
Fake.Core.Process (>= 5.22) Fake.Core.Process (>= 5.23)
Fake.Core.String (>= 5.22) Fake.Core.String (>= 5.23)
Fake.Core.Trace (>= 5.22) Fake.Core.Trace (>= 5.23)
Fake.DotNet.MSBuild (>= 5.22) Fake.DotNet.MSBuild (>= 5.23)
Fake.DotNet.NuGet (>= 5.22) Fake.DotNet.NuGet (>= 5.23)
Fake.IO.FileSystem (>= 5.22) Fake.IO.FileSystem (>= 5.23)
FSharp.Core (>= 6.0) FSharp.Core (>= 6.0)
Mono.Posix.NETStandard (>= 1.0) Mono.Posix.NETStandard (>= 1.0)
Newtonsoft.Json (>= 13.0.1) Newtonsoft.Json (>= 13.0.1)
Fake.DotNet.MSBuild (5.22) Fake.DotNet.MSBuild (5.23)
BlackFox.VsWhere (>= 1.1) BlackFox.VsWhere (>= 1.1)
Fake.Core.Environment (>= 5.22) Fake.Core.Environment (>= 5.23)
Fake.Core.Process (>= 5.22) Fake.Core.Process (>= 5.23)
Fake.Core.String (>= 5.22) Fake.Core.String (>= 5.23)
Fake.Core.Trace (>= 5.22) Fake.Core.Trace (>= 5.23)
Fake.IO.FileSystem (>= 5.22) Fake.IO.FileSystem (>= 5.23)
FSharp.Core (>= 6.0) FSharp.Core (>= 6.0)
MSBuild.StructuredLogger (>= 2.1.545) MSBuild.StructuredLogger (>= 2.1.545)
Fake.DotNet.NuGet (5.22) Fake.DotNet.NuGet (5.23)
Fake.Core.Environment (>= 5.22) Fake.Core.Environment (>= 5.23)
Fake.Core.Process (>= 5.22) Fake.Core.Process (>= 5.23)
Fake.Core.SemVer (>= 5.22) Fake.Core.SemVer (>= 5.23)
Fake.Core.String (>= 5.22) Fake.Core.String (>= 5.23)
Fake.Core.Tasks (>= 5.22) Fake.Core.Tasks (>= 5.23)
Fake.Core.Trace (>= 5.22) Fake.Core.Trace (>= 5.23)
Fake.Core.Xml (>= 5.22) Fake.Core.Xml (>= 5.23)
Fake.IO.FileSystem (>= 5.22) Fake.IO.FileSystem (>= 5.23)
Fake.Net.Http (>= 5.22) Fake.Net.Http (>= 5.23)
FSharp.Core (>= 6.0) FSharp.Core (>= 6.0)
Newtonsoft.Json (>= 13.0.1) Newtonsoft.Json (>= 13.0.1)
NuGet.Protocol (>= 5.11) NuGet.Protocol (>= 5.11)
Fake.IO.FileSystem (5.22) Fake.IO.FileSystem (5.23)
Fake.Core.String (>= 5.22) Fake.Core.String (>= 5.23)
FSharp.Core (>= 6.0) FSharp.Core (>= 6.0)
Fake.JavaScript.Npm (5.22) Fake.JavaScript.Npm (5.23)
Fake.Core.Environment (>= 5.22) Fake.Core.Environment (>= 5.23)
Fake.Core.Process (>= 5.22) Fake.Core.Process (>= 5.23)
Fake.IO.FileSystem (>= 5.22) Fake.IO.FileSystem (>= 5.23)
Fake.Testing.Common (>= 5.22) Fake.Testing.Common (>= 5.23)
FSharp.Core (>= 6.0) FSharp.Core (>= 6.0)
Fake.Net.Http (5.22) Fake.Net.Http (5.23)
Fake.Core.Trace (>= 5.22) Fake.Core.Trace (>= 5.23)
FSharp.Core (>= 6.0) FSharp.Core (>= 6.0)
Fake.Testing.Common (5.22) Fake.Testing.Common (5.23)
Fake.Core.Trace (>= 5.22) Fake.Core.Trace (>= 5.23)
FSharp.Core (>= 6.0) FSharp.Core (>= 6.0)
FParsec (1.1.1) FParsec (1.1.1)
FSharp.Core (>= 4.3.4) 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.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.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)) System.Threading.Tasks.Dataflow (>= 6.0) - restriction: || (== net6.0) (&& (== netstandard2.0) (>= net472)) (&& (== netstandard2.0) (>= net6.0))
Microsoft.Build.Framework (17.2) Microsoft.Build.Framework (17.3.1)
Microsoft.Win32.Registry (>= 4.3) System.Security.Permissions (>= 6.0)
System.Security.Permissions (>= 4.7)
Microsoft.Build.Tasks.Core (17.2) Microsoft.Build.Tasks.Core (17.2)
Microsoft.Build.Framework (>= 17.2) Microsoft.Build.Framework (>= 17.2)
Microsoft.Build.Utilities.Core (>= 17.2) Microsoft.Build.Utilities.Core (>= 17.2)
@ -139,7 +138,7 @@ NUGET
Microsoft.NET.StringTools (1.0) Microsoft.NET.StringTools (1.0)
System.Memory (>= 4.5.4) System.Memory (>= 4.5.4)
System.Runtime.CompilerServices.Unsafe (>= 5.0) 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.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) 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) 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.Tasks.Core (>= 16.10)
Microsoft.Build.Utilities.Core (>= 16.10) Microsoft.Build.Utilities.Core (>= 16.10)
Newtonsoft.Json (13.0.1) Newtonsoft.Json (13.0.1)
NuGet.Common (6.2.1) NuGet.Common (6.3)
NuGet.Frameworks (>= 6.2.1) NuGet.Frameworks (>= 6.3)
NuGet.Configuration (6.2.1) NuGet.Configuration (6.3)
NuGet.Common (>= 6.2.1) NuGet.Common (>= 6.3)
System.Security.Cryptography.ProtectedData (>= 4.4) System.Security.Cryptography.ProtectedData (>= 4.4)
NuGet.Frameworks (6.2.1) NuGet.Frameworks (6.3)
NuGet.Packaging (6.2.1) NuGet.Packaging (6.3)
Newtonsoft.Json (>= 13.0.1) Newtonsoft.Json (>= 13.0.1)
NuGet.Configuration (>= 6.2.1) NuGet.Configuration (>= 6.3)
NuGet.Versioning (>= 6.2.1) NuGet.Versioning (>= 6.3)
System.Security.Cryptography.Cng (>= 5.0) System.Security.Cryptography.Cng (>= 5.0)
System.Security.Cryptography.Pkcs (>= 5.0) System.Security.Cryptography.Pkcs (>= 5.0)
NuGet.Protocol (6.2.1) NuGet.Protocol (6.3)
NuGet.Packaging (>= 6.2.1) NuGet.Packaging (>= 6.3)
NuGet.Versioning (6.2.1) 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.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.CodeDom (6.0)
System.Collections.Immutable (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.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.Cng (>= 5.0) - restriction: || (&& (== net6.0) (< netcoreapp3.1)) (&& (== net6.0) (< netstandard2.1)) (== netstandard2.0)
System.Security.Cryptography.ProtectedData (6.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.Memory (>= 4.5.4) - restriction: == netstandard2.0
System.Security.AccessControl (>= 6.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.Permissions (6.0)
System.Security.AccessControl (>= 6.0) System.Security.AccessControl (>= 6.0)
System.Windows.Extensions (>= 6.0) - restriction: || (== net6.0) (&& (== netstandard2.0) (>= netcoreapp3.1)) System.Windows.Extensions (>= 6.0) - restriction: || (== net6.0) (&& (== netstandard2.0) (>= netcoreapp3.1))

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

@ -13,9 +13,9 @@
<ItemGroup> <ItemGroup>
<PackageReference Include="Giraffe" Version="6.0.0" /> <PackageReference Include="Giraffe" Version="6.0.0" />
<PackageReference Include="Markdig" Version="0.30.2" /> <PackageReference Include="Markdig" Version="0.30.3" />
<PackageReference Include="Microsoft.Extensions.Options" Version="6.0.0" /> <PackageReference Include="Microsoft.Extensions.Options" Version="6.0.0" />
<PackageReference Include="NodaTime" Version="3.1.0" /> <PackageReference Include="NodaTime" Version="3.1.2" />
<PackageReference Update="FSharp.Core" Version="6.0.5" /> <PackageReference Update="FSharp.Core" Version="6.0.5" />
</ItemGroup> </ItemGroup>

4
src/JobsJobsJobs/Domain/SharedTypes.fs
View File

@ -1,7 +1,7 @@
/// Types intended to be shared between the API and the client application /// Types intended to be shared between the API and the client application
module JobsJobsJobs.Domain.SharedTypes module JobsJobsJobs.Domain.SharedTypes
open JobsJobsJobs.Domain.Types open JobsJobsJobs.Domain
open Microsoft.Extensions.Options open Microsoft.Extensions.Options
open NodaTime open NodaTime
@ -202,7 +202,7 @@ type ProfileForm =
module ProfileForm = module ProfileForm =
/// Create an instance of this form from the given profile /// Create an instance of this form from the given profile
let fromProfile (profile : Types.Profile) = let fromProfile (profile : Profile) =
{ isSeekingEmployment = profile.seekingEmployment { isSeekingEmployment = profile.seekingEmployment
isPublic = profile.isPublic isPublic = profile.isPublic
realName = "" realName = ""

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

@ -45,6 +45,19 @@ with
/// Support functions for citizens /// Support functions for citizens
module Citizen = 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) /// Get the name of the citizen (either their preferred display name or first/last names)
let name x = let name x =
match x.displayName with Some it -> it | None -> $"{x.firstName} {x.lastName}" match x.displayName with Some it -> it | None -> $"{x.firstName} {x.lastName}"
@ -116,6 +129,26 @@ type Listing =
isLegacy : bool 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 /// Security settings for a user
type SecurityInfo = type SecurityInfo =
@ -253,3 +286,16 @@ type Success =
/// The success story /// The success story
story : MarkdownString option 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
}

373
src/JobsJobsJobs/JobsJobsJobs.Data/Data.fs
View File

@ -1,13 +1,81 @@
namespace JobsJobsJobs.Data namespace JobsJobsJobs.Data
open System
open JobsJobsJobs.Domain 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
[<AllowNullLiteral>]
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
[<AllowNullLiteral>]
type CitizenDocument (citizen : Citizen) =
inherit Document<Citizen> (citizen, fun c -> CitizenId.value c.id)
new() = CitizenDocument Citizen.empty
/// A continent document
[<AllowNullLiteral>]
type ContinentDocument (continent : Continent) =
inherit Document<Continent> (continent, fun c -> ContinentId.value c.id)
new () = ContinentDocument Continent.empty
/// A job listing document
[<AllowNullLiteral>]
type ListingDocument (listing : Listing) =
inherit Document<Listing> (listing, fun l -> ListingId.value l.id)
new () = ListingDocument Listing.empty
/// A profile document
[<AllowNullLiteral>]
type ProfileDocument (profile : Profile) =
inherit Document<Profile> (profile, fun p -> CitizenId.value p.id)
new () = ProfileDocument Profile.empty
/// A security information document
[<AllowNullLiteral>]
type SecurityInfoDocument (securityInfo : SecurityInfo) =
inherit Document<SecurityInfo> (securityInfo, fun si -> CitizenId.value si.Id)
new () = SecurityInfoDocument SecurityInfo.empty
/// A success story document
[<AllowNullLiteral>]
type SuccessDocument (success : Success) =
inherit Document<Success> (success, fun s -> SuccessId.value s.id)
new () = SuccessDocument Success.empty
open Documents
open Marten open Marten
open Marten.PLv8
open Microsoft.Extensions.Configuration
/// Connection management for the Marten document store /// Connection management for the Marten document store
module Connection = module Connection =
open Marten.NodaTime
open Microsoft.Extensions.Configuration
open Weasel.Core open Weasel.Core
/// The configuration from which a document store will be created /// The configuration from which a document store will be created
@ -21,14 +89,19 @@ module Connection =
DocumentStore.For(fun opts -> DocumentStore.For(fun opts ->
opts.Connection (cfg.GetConnectionString "PostgreSQL") opts.Connection (cfg.GetConnectionString "PostgreSQL")
opts.RegisterDocumentTypes [ opts.RegisterDocumentTypes [
typeof<Citizen>; typeof<Continent>; typeof<Listing>; typeof<Profile>; typeof<SecurityInfo> typeof<CitizenDocument>; typeof<ContinentDocument>; typeof<ListingDocument>
typeof<Success> typeof<ProfileDocument>; typeof<SecurityInfoDocument>; typeof<SuccessDocument>
] ]
opts.DatabaseSchemaName <- "jjj"
opts.AutoCreateSchemaObjects <- AutoCreate.CreateOrUpdate opts.AutoCreateSchemaObjects <- AutoCreate.CreateOrUpdate
opts.UseJavascriptTransformsAndPatching () opts.UseNodaTime ()
let _ = opts.Schema.For<Citizen>().Identity (fun c -> c.DbId) let _ = opts.Schema.For<CitizenDocument>().DocumentAlias "citizen"
let _ = opts.Schema.For<SecurityInfo>().Identity (fun si -> si.DbId) let _ = opts.Schema.For<ContinentDocument>().DocumentAlias "continent"
let _ = opts.Schema.For<ListingDocument>().DocumentAlias "listing"
let _ = opts.Schema.For<ProfileDocument>().DocumentAlias "profile"
let _ = opts.Schema.For<SecurityInfoDocument>().DocumentAlias "security_info"
let _ = opts.Schema.For<SuccessDocument>().DocumentAlias "success"
()) ())
do! store.Storage.ApplyAllConfiguredChangesToDatabaseAsync () do! store.Storage.ApplyAllConfiguredChangesToDatabaseAsync ()
return Ok store return Ok store
@ -38,7 +111,7 @@ module Connection =
/// Set up the data connection from the given configuration /// Set up the data connection from the given configuration
let setUp (cfg : IConfiguration) = let setUp (cfg : IConfiguration) =
config <- Some cfg config <- Some cfg
ignore (lazyStore.Force ()) lazyStore.Force ()
/// A read-only document session /// A read-only document session
let querySession () = let querySession () =
@ -53,22 +126,12 @@ module Connection =
| Error msg -> raise (invalidOp msg) | Error msg -> raise (invalidOp msg)
/// Helper functions for data retrieval /// Shorthand for the generic dictionary
[<AutoOpen>] type Dict<'TKey, 'TValue> = System.Collections.Generic.Dictionary<'TKey, 'TValue>
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 System.Linq
open Connection open Connection
open Marten.PLv8.Patching
/// Citizen data access functions /// Citizen data access functions
[<RequireQualifiedAccess>] [<RequireQualifiedAccess>]
@ -77,16 +140,21 @@ module Citizens =
/// Delete a citizen by their ID /// Delete a citizen by their ID
let deleteById citizenId = backgroundTask { let deleteById citizenId = backgroundTask {
use session = docSession () use session = docSession ()
session.Delete<Citizen> (CitizenId.value citizenId) session.DeleteWhere<SuccessDocument>(fun s -> s.Value.citizenId = citizenId)
session.DeleteWhere<ListingDocument>(fun l -> l.Value.citizenId = citizenId)
let docId = CitizenId.value citizenId
session.Delete<ProfileDocument> docId
session.Delete<SecurityInfoDocument> docId
session.Delete<CitizenDocument> docId
do! session.SaveChangesAsync () do! session.SaveChangesAsync ()
} }
/// Find a citizen by their ID /// Find a citizen by their ID
let findById citizenId = backgroundTask { let findById citizenId = backgroundTask {
use session = querySession () use session = querySession ()
let! citizen = session.LoadAsync<Citizen> (CitizenId.value citizenId) let! citizen = session.LoadAsync<CitizenDocument> (CitizenId.value citizenId)
return return
match optional citizen with match Document.TryValue citizen with
| Some c when not c.isLegacy -> Some c | Some c when not c.isLegacy -> Some c
| Some _ | Some _
| None -> None | None -> None
@ -95,7 +163,7 @@ module Citizens =
/// Save a citizen /// Save a citizen
let save (citizen : Citizen) = backgroundTask { let save (citizen : Citizen) = backgroundTask {
use session = docSession () use session = docSession ()
session.Store<Citizen> citizen session.Store (CitizenDocument citizen)
do! session.SaveChangesAsync () do! session.SaveChangesAsync ()
} }
@ -103,29 +171,34 @@ module Citizens =
let tryLogOn email (pwCheck : string -> bool) now = backgroundTask { let tryLogOn email (pwCheck : string -> bool) now = backgroundTask {
use session = docSession () use session = docSession ()
let! tryCitizen = let! tryCitizen =
session.Query<Citizen>().Where(fun c -> c.email = email && not c.isLegacy).SingleOrDefaultAsync () session.Query<CitizenDocument>()
match optional tryCitizen with .Where(fun c -> c.Value.email = email && not c.Value.isLegacy)
.SingleOrDefaultAsync ()
match Document.TryValue tryCitizen with
| Some citizen -> | Some citizen ->
let! tryInfo = session.LoadAsync<SecurityInfo> citizen.DbId let! tryInfo = session.LoadAsync<SecurityInfoDocument> (CitizenId.value citizen.id)
let! info = backgroundTask { let! info = backgroundTask {
match optional tryInfo with match Document.TryValue tryInfo with
| Some it -> return it | Some it -> return it
| None -> | None ->
let it = { SecurityInfo.empty with Id = citizen.id } let it = { SecurityInfo.empty with Id = citizen.id }
session.Store<SecurityInfo> it session.Store (SecurityInfoDocument it)
do! session.SaveChangesAsync () do! session.SaveChangesAsync ()
return it return it
} }
if info.AccountLocked then return Error "Log on unsuccessful (Account Locked)" if info.AccountLocked then return Error "Log on unsuccessful (Account Locked)"
elif pwCheck citizen.passwordHash then elif pwCheck citizen.passwordHash then
session.Patch<SecurityInfo>(citizen.DbId).Set((fun si -> si.FailedLogOnAttempts), 0) session.Store (SecurityInfoDocument { info with FailedLogOnAttempts = 0})
session.Patch<Citizen>(citizen.DbId).Set((fun c -> c.lastSeenOn), now) session.Store (CitizenDocument { citizen with lastSeenOn = now})
do! session.SaveChangesAsync () do! session.SaveChangesAsync ()
return Ok { citizen with lastSeenOn = now } return Ok { citizen with lastSeenOn = now }
else else
let locked = info.FailedLogOnAttempts >= 4 let locked = info.FailedLogOnAttempts >= 4
session.Patch<SecurityInfo>(citizen.DbId).Increment(fun si -> si.FailedLogOnAttempts) session.Store (SecurityInfoDocument {
if locked then session.Patch<SecurityInfo>(citizen.DbId).Set((fun si -> si.AccountLocked), true) info with
FailedLogOnAttempts = info.FailedLogOnAttempts + 1
AccountLocked = locked
})
do! session.SaveChangesAsync () do! session.SaveChangesAsync ()
return Error $"""Log on unsuccessful{if locked then " - Account is now locked" else ""}""" return Error $"""Log on unsuccessful{if locked then " - Account is now locked" else ""}"""
| None -> return Error "Log on unsuccessful" | None -> return Error "Log on unsuccessful"
@ -139,47 +212,47 @@ module Continents =
/// Retrieve all continents /// Retrieve all continents
let all () = backgroundTask { let all () = backgroundTask {
use session = querySession () use session = querySession ()
let! it = session.Query<Continent>().ToListAsync<Continent> noCnx let! it = session.Query<ContinentDocument>().AsQueryable().ToListAsync ()
return List.ofSeq it return it |> Seq.map Document.ToValue |> List.ofSeq
} }
/// Retrieve a continent by its ID /// Retrieve a continent by its ID
let findById continentId = backgroundTask { let findById continentId = backgroundTask {
use session = querySession () use session = querySession ()
let! tryContinent = session.LoadAsync<Continent> (ContinentId.value continentId) let! tryContinent = session.LoadAsync<ContinentDocument> (ContinentId.value continentId)
return optional tryContinent return Document.TryValue tryContinent
} }
open System
open JobsJobsJobs.Domain.SharedTypes open JobsJobsJobs.Domain.SharedTypes
/// Job listing access functions /// Job listing access functions
[<RequireQualifiedAccess>] [<RequireQualifiedAccess>]
module Listings = module Listings =
open System.Collections.Generic
/// Find all job listings posted by the given citizen /// Find all job listings posted by the given citizen
let findByCitizen citizenId = backgroundTask { let findByCitizen citizenId = backgroundTask {
use session = querySession () use session = querySession ()
let continents = Dictionary<ContinentId, Continent> () let continents = Dict<Guid, ContinentDocument> ()
let! listings = let! listings =
session.Query<Listing>() session.Query<ListingDocument>()
.Include((fun l -> l.continentId :> obj), continents) .Include((fun l -> l.Value.continentId :> obj), continents)
.Where(fun l -> l.citizenId = citizenId && not l.isLegacy) .Where(fun l -> l.Value.citizenId = citizenId && not l.Value.isLegacy)
.ToListAsync () .ToListAsync ()
return return
listings 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 |> List.ofSeq
} }
/// Find a listing by its ID /// Find a listing by its ID
let findById listingId = backgroundTask { let findById listingId = backgroundTask {
use session = querySession () use session = querySession ()
let! tryListing = session.LoadAsync<Listing> (ListingId.value listingId) let! tryListing = session.LoadAsync<ListingDocument> (ListingId.value listingId)
match optional tryListing with match Document.TryValue tryListing with
| Some listing when not listing.isLegacy -> return Some listing | Some listing when not listing.isLegacy -> return Some listing
| Some _ | Some _
| None -> return None | None -> return None
@ -188,52 +261,194 @@ module Listings =
/// Find a listing by its ID for viewing (includes continent information) /// Find a listing by its ID for viewing (includes continent information)
let findByIdForView listingId = backgroundTask { let findByIdForView listingId = backgroundTask {
use session = querySession () use session = querySession ()
let mutable continent = Continent.empty let mutable continent : ContinentDocument = null
let! tryListing = let! tryListing =
session.Query<Listing>() session.Query<ListingDocument>()
.Include((fun l -> l.continentId :> obj), fun c -> continent <- c) .Include((fun l -> l.Value.continentId :> obj), fun c -> continent <- c)
.Where(fun l -> l.id = listingId && not l.isLegacy) .Where(fun l -> l.Id = ListingId.value listingId && not l.Value.isLegacy)
.SingleOrDefaultAsync () .SingleOrDefaultAsync ()
match optional tryListing with match Document.TryValue tryListing with
| Some listing -> return Some { listing = listing; continent = continent } | Some listing when not (isNull continent) -> return Some { listing = listing; continent = continent.Value }
| Some _
| None -> return None | None -> return None
} }
/// Save a listing /// Save a listing
let save (listing : Listing) = backgroundTask { let save (listing : Listing) = backgroundTask {
use session = docSession () use session = docSession ()
session.Store listing session.Store (ListingDocument listing)
do! session.SaveChangesAsync () do! session.SaveChangesAsync ()
} }
/// Search job listings /// Search job listings
let search (search : ListingSearch) = backgroundTask { let search (search : ListingSearch) = backgroundTask {
use session = querySession () use session = querySession ()
let continents = Dictionary<ContinentId, Continent> () let continents = Dict<Guid, ContinentDocument> ()
let searchQuery = let searchQuery =
seq<Listing -> bool> { seq<ListingDocument -> bool> {
match search.continentId with match search.continentId with
| Some contId -> | Some contId ->
fun (l : Listing) -> l.continentId = (ContinentId.ofString contId) fun (l : ListingDocument) -> l.Value.continentId = (ContinentId.ofString contId)
| None -> () | None -> ()
match search.region with 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 -> () | None -> ()
if search.remoteWork <> "" then 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 // match search.text with
// | Some text -> fun (l : Listing) -> l.text.Contains (text, StringComparison.OrdinalIgnoreCase) // | Some text -> fun (l : Listing) -> l.text.Contains (text, StringComparison.OrdinalIgnoreCase)
// | None -> () // | None -> ()
} }
|> Seq.fold |> Seq.fold
(fun q filter -> Queryable.Where(q, filter)) (fun q filter -> Queryable.Where(q, filter))
(session.Query<Listing>() (session.Query<ListingDocument>()
.Include((fun l -> l.continentId :> obj), continents) .Include((fun l -> l.Value.continentId :> obj), continents)
.Where(fun l -> not l.isExpired && not l.isLegacy)) .Where(fun l -> not l.Value.isExpired && not l.Value.isLegacy))
let! results = searchQuery.ToListAsync () let! results = searchQuery.ToListAsync ()
return return
results 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
[<RequireQualifiedAccess>]
module Profiles =
/// Count the current profiles
let count () =
use session = querySession ()
session.Query<ProfileDocument>().Where(fun p -> not p.Value.isLegacy).LongCountAsync ()
/// Delete a profile by its ID
let deleteById citizenId = backgroundTask {
use session = docSession ()
session.Delete<ProfileDocument> (CitizenId.value citizenId)
do! session.SaveChangesAsync ()
}
/// Find a profile by citizen ID
let findById citizenId = backgroundTask {
use session = querySession ()
let! profile = session.LoadAsync<ProfileDocument> (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<ProfileDocument>()
.Include<CitizenDocument>((fun p -> p.Id :> obj), fun c -> citizen <- c)
.Include<ContinentDocument>((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<Guid, CitizenDocument> ()
let searchQuery =
seq<ProfileDocument -> 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<ProfileDocument>()
.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<Guid, ContinentDocument> ()
let searchQuery =
seq<ProfileDocument -> 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<ProfileDocument>()
.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 |> List.ofSeq
} }
@ -241,10 +456,40 @@ module Listings =
[<RequireQualifiedAccess>] [<RequireQualifiedAccess>]
module Successes = module Successes =
// Retrieve all success stories
let all () = backgroundTask {
use session = querySession ()
let citizens = Dict<Guid, CitizenDocument> ()
let! stories =
session.Query<SuccessDocument>()
.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<SuccessDocument> (SuccessId.value successId)
return Document.TryValue success
}
/// Save a success story /// Save a success story
let save (success : Success) = backgroundTask { let save (success : Success) = backgroundTask {
use session = docSession () use session = docSession ()
session.Store<Success> success session.Store (SuccessDocument success)
do! session.SaveChangesAsync () do! session.SaveChangesAsync ()
} }

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

@ -18,7 +18,9 @@
<PackageReference Include="FSharp.SystemTextJson" Version="0.19.13" /> <PackageReference Include="FSharp.SystemTextJson" Version="0.19.13" />
<PackageReference Include="Marten" Version="5.8.0" /> <PackageReference Include="Marten" Version="5.8.0" />
<PackageReference Include="Marten.NodaTime" Version="5.8.0" /> <PackageReference Include="Marten.NodaTime" Version="5.8.0" />
<PackageReference Include="Marten.PLv8" Version="5.8.0" /> <PackageReference Update="FSharp.Core" Version="6.0.5" />
<PackageReference Include="Npgsql" Version="6.0.6" />
<PackageReference Include="Npgsql.NodaTime" Version="6.0.6" />
</ItemGroup> </ItemGroup>
</Project> </Project>

29
src/JobsJobsJobs/JobsJobsJobs.Data/Json.fs
View File

@ -5,19 +5,32 @@ open System.Text.Json
open System.Text.Json.Serialization open System.Text.Json.Serialization
open JobsJobsJobs.Domain open JobsJobsJobs.Domain
/// Convert citizen IDs to their string-GUID representation /// Convert a wrapped GUID to/from its string representation
type CitizenIdJsonConverter () = type WrappedJsonConverter<'T> (wrap : string -> 'T, unwrap : 'T -> string) =
inherit JsonConverter<CitizenId> () inherit JsonConverter<'T> ()
override this.Read(reader, _, _) = override _.Read(reader, _, _) =
CitizenId (Guid.Parse (reader.GetString ())) wrap (reader.GetString ())
override this.Write(writer, value, _) = override _.Write(writer, value, _) =
writer.WriteStringValue ((CitizenId.value value).ToString ()) 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 /// JsonSerializer options that use the custom converters
let options = let options =
let opts = JsonSerializerOptions () 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 () JsonFSharpConverter ()
] ]
|> List.iter opts.Converters.Add |> List.iter opts.Converters.Add

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

@ -8,7 +8,6 @@ open Microsoft.Extensions.Hosting
open Giraffe open Giraffe
open Giraffe.EndpointRouting open Giraffe.EndpointRouting
/// Configure the ASP.NET Core pipeline to use Giraffe /// Configure the ASP.NET Core pipeline to use Giraffe
let configureApp (app : IApplicationBuilder) = let configureApp (app : IApplicationBuilder) =
app.UseCors(fun p -> p.AllowAnyOrigin().AllowAnyHeader() |> ignore) app.UseCors(fun p -> p.AllowAnyOrigin().AllowAnyHeader() |> ignore)
@ -22,13 +21,11 @@ let configureApp (app : IApplicationBuilder) =
e.MapFallbackToFile "index.html" |> ignore) e.MapFallbackToFile "index.html" |> ignore)
|> ignore |> ignore
open Newtonsoft.Json open System.Text
open NodaTime
open Microsoft.AspNetCore.Authentication.JwtBearer open Microsoft.AspNetCore.Authentication.JwtBearer
open Microsoft.Extensions.Configuration open Microsoft.Extensions.Configuration
open Microsoft.Extensions.Logging
open Microsoft.IdentityModel.Tokens open Microsoft.IdentityModel.Tokens
open System.Text open NodaTime
open JobsJobsJobs.Data open JobsJobsJobs.Data
open JobsJobsJobs.Domain.SharedTypes open JobsJobsJobs.Domain.SharedTypes
@ -39,9 +36,7 @@ let configureServices (svc : IServiceCollection) =
let _ = svc.AddLogging () let _ = svc.AddLogging ()
let _ = svc.AddCors () let _ = svc.AddCors ()
let jsonCfg = JsonSerializerSettings () let _ = svc.AddSingleton<Json.ISerializer> (SystemTextJson.Serializer Json.options)
Data.Converters.all () |> List.iter jsonCfg.Converters.Add
let _ = svc.AddSingleton<Json.ISerializer> (NewtonsoftJson.Serializer jsonCfg)
let svcs = svc.BuildServiceProvider () let svcs = svc.BuildServiceProvider ()
let cfg = svcs.GetRequiredService<IConfiguration> () let cfg = svcs.GetRequiredService<IConfiguration> ()
@ -64,13 +59,11 @@ let configureServices (svc : IServiceCollection) =
let _ = svc.AddAuthorization () let _ = svc.AddAuthorization ()
let _ = svc.Configure<AuthOptions> (cfg.GetSection "Auth") let _ = svc.Configure<AuthOptions> (cfg.GetSection "Auth")
let dbCfg = cfg.GetSection "Rethink"
let log = svcs.GetRequiredService<ILoggerFactory>().CreateLogger "JobsJobsJobs.Api.Data.Startup"
let conn = Data.Startup.createConnection dbCfg log
let _ = svc.AddSingleton conn |> ignore
// Set up the Marten data store // 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}"
[<EntryPoint>] [<EntryPoint>]
let main _ = let main _ =

1
src/JobsJobsJobs/Server/Auth.fs
View File

@ -78,7 +78,6 @@ let verifyWithMastodon (authCode : string) (inst : MastodonInstance) rtnHost (lo
open JobsJobsJobs.Domain open JobsJobsJobs.Domain
open JobsJobsJobs.Domain.Types
open Microsoft.IdentityModel.Tokens open Microsoft.IdentityModel.Tokens
open System.IdentityModel.Tokens.Jwt open System.IdentityModel.Tokens.Jwt
open System.Security.Claims open System.Security.Claims

745
src/JobsJobsJobs/Server/Data.fs
View File

@ -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<CitizenId>()
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<ContinentId>()
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<MarkdownString>()
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<ListingId>()
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<SkillId>()
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<SuccessId>()
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
[<RequireQualifiedAccess>]
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)
[<AutoOpen>]
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
[<RequireQualifiedAccess>]
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<Instant> "joined_on"
lastSeenOn = row.fieldValue<Instant> "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<Instant> "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<Instant> "updated_on"
text = (row.string >> Text) "listing_text"
neededBy = row.fieldValueOrNone<LocalDate> "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<Instant> "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<Instant> "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
[<RequireQualifiedAccess>]
module Profile =
/// Count the current profiles
let count (session : IQuerySession) =
session.Query<Profile>().Where(fun p -> not p.isLegacy).LongCountAsync ()
/// Find a profile by citizen ID
let findById citizenId (session : IQuerySession) = backgroundTask {
let! profile = session.LoadAsync<Profile> (CitizenId.value citizenId)
return
match optional profile with
| Some p when not p.isLegacy -> Some p
| Some _
| None -> None
}
/// Insert or update a profile
[<Obsolete "Inline this">]
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<ProfileSearchResult list> 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<PublicSearchResult list> conn
/// Citizen data access functions
[<RequireQualifiedAccess>]
module Citizen =
/// Find a citizen by their ID
let findById citizenId (session : IQuerySession) = backgroundTask {
let! citizen = session.LoadAsync<Citizen> (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
[<RequireQualifiedAccess>]
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
[<RequireQualifiedAccess>]
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
[<RequireQualifiedAccess>]
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<StoryEntry list> conn

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

@ -1,7 +1,6 @@
/// Route handlers for Giraffe endpoints /// Route handlers for Giraffe endpoints
module JobsJobsJobs.Api.Handlers module JobsJobsJobs.Api.Handlers
open System.Threading
open Giraffe open Giraffe
open JobsJobsJobs.Domain open JobsJobsJobs.Domain
open JobsJobsJobs.Domain.SharedTypes open JobsJobsJobs.Domain.SharedTypes
@ -55,15 +54,12 @@ module Error =
module Helpers = module Helpers =
open System.Security.Claims open System.Security.Claims
open System.Threading.Tasks
open NodaTime open NodaTime
open Marten
open Microsoft.Extensions.Configuration open Microsoft.Extensions.Configuration
open Microsoft.Extensions.Options open Microsoft.Extensions.Options
open RethinkDb.Driver.Net
/// Get the NodaTime clock from the request context /// Get the NodaTime clock from the request context
let clock (ctx : HttpContext) = ctx.GetService<IClock> () let now (ctx : HttpContext) = ctx.GetService<IClock>().GetCurrentInstant ()
/// Get the application configuration from the request context /// Get the application configuration from the request context
let config (ctx : HttpContext) = ctx.GetService<IConfiguration> () let config (ctx : HttpContext) = ctx.GetService<IConfiguration> ()
@ -74,15 +70,6 @@ module Helpers =
/// Get the logger factory from the request context /// Get the logger factory from the request context
let logger (ctx : HttpContext) = ctx.GetService<ILoggerFactory> () let logger (ctx : HttpContext) = ctx.GetService<ILoggerFactory> ()
/// Get the RethinkDB connection from the request context
let conn (ctx : HttpContext) = ctx.GetService<IConnection> ()
/// Get a query session
let querySession (ctx : HttpContext) = ctx.GetService<IQuerySession> ()
/// Get a full document session
let docSession (ctx : HttpContext) = ctx.GetService<IDocumentSession> ()
/// `None` if a `string option` is `None`, whitespace, or empty /// `None` if a `string option` is `None`, whitespace, or empty
let noneIfBlank (s : string option) = let noneIfBlank (s : string option) =
s |> Option.map (fun x -> match x.Trim () with "" -> None | _ -> Some x) |> Option.flatten s |> Option.map (fun x -> match x.Trim () with "" -> None | _ -> Some x) |> Option.flatten
@ -107,16 +94,6 @@ module Helpers =
/// Return an empty OK response /// Return an empty OK response
let ok : HttpHandler = Successful.OK "" 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 open System
open JobsJobsJobs.Data open JobsJobsJobs.Data
@ -127,48 +104,59 @@ module Citizen =
// GET: /api/citizen/log-on/[code] // GET: /api/citizen/log-on/[code]
let logOn (abbr, authCode) : HttpHandler = fun next ctx -> task { 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 // Step 1 - Verify with Mastodon
let cfg = authConfig ctx // let cfg = authConfig ctx
//
match cfg.Instances |> Array.tryFind (fun it -> it.Abbr = abbr) with // match cfg.Instances |> Array.tryFind (fun it -> it.Abbr = abbr) with
| Some instance -> // | Some instance ->
let log = (logger ctx).CreateLogger (nameof JobsJobsJobs.Api.Auth) // let log = (logger ctx).CreateLogger (nameof JobsJobsJobs.Api.Auth)
//
match! Auth.verifyWithMastodon authCode instance cfg.ReturnHost log with // match! Auth.verifyWithMastodon authCode instance cfg.ReturnHost log with
| Ok account -> // | Ok account ->
// Step 2 - Find / establish Jobs, Jobs, Jobs account // // Step 2 - Find / establish Jobs, Jobs, Jobs account
let now = (clock ctx).GetCurrentInstant () // let now = (clock ctx).GetCurrentInstant ()
let dbConn = conn ctx // let dbConn = conn ctx
let! citizen = task { // let! citizen = task {
match! Data.Citizen.findByMastodonUser instance.Abbr account.Username dbConn with // match! Data.Citizen.findByMastodonUser instance.Abbr account.Username dbConn with
| None -> // | None ->
let it : Citizen = // let it : Citizen =
{ id = CitizenId.create () // { id = CitizenId.create ()
instance = instance.Abbr // instance = instance.Abbr
mastodonUser = account.Username // mastodonUser = account.Username
displayName = noneIfEmpty account.DisplayName // displayName = noneIfEmpty account.DisplayName
realName = None // realName = None
profileUrl = account.Url // profileUrl = account.Url
joinedOn = now // joinedOn = now
lastSeenOn = now // lastSeenOn = now
} // }
do! Data.Citizen.add it dbConn // do! Data.Citizen.add it dbConn
return it // return it
| Some citizen -> // | Some citizen ->
let it = { citizen with displayName = noneIfEmpty account.DisplayName; lastSeenOn = now } // let it = { citizen with displayName = noneIfEmpty account.DisplayName; lastSeenOn = now }
do! Data.Citizen.logOnUpdate it dbConn // do! Data.Citizen.logOnUpdate it dbConn
return it // return it
} // }
//
// Step 3 - Generate JWT // // Step 3 - Generate JWT
return! // return!
json // json
{ jwt = Auth.createJwt citizen cfg // { jwt = Auth.createJwt citizen cfg
citizenId = CitizenId.toString citizen.id // citizenId = CitizenId.toString citizen.id
name = Citizen.name citizen // name = Citizen.name citizen
} next ctx // } next ctx
| Error err -> return! RequestErrors.BAD_REQUEST err next ctx // | Error err -> return! RequestErrors.BAD_REQUEST err next ctx
| None -> return! Error.notFound next ctx // | None -> return! Error.notFound next ctx
} }
// GET: /api/citizen/[id] // GET: /api/citizen/[id]
@ -248,7 +236,7 @@ module Listing =
// POST: /listings // POST: /listings
let add : HttpHandler = authorize >=> fun next ctx -> task { let add : HttpHandler = authorize >=> fun next ctx -> task {
let! form = ctx.BindJsonAsync<ListingForm> () let! form = ctx.BindJsonAsync<ListingForm> ()
let now = (clock ctx).GetCurrentInstant () let now = now ctx
do! Listings.save { do! Listings.save {
id = ListingId.create () id = ListingId.create ()
citizenId = currentCitizenId ctx citizenId = currentCitizenId ctx
@ -269,7 +257,6 @@ module Listing =
// PUT: /api/listing/[id] // PUT: /api/listing/[id]
let update listingId : HttpHandler = authorize >=> fun next ctx -> task { let update listingId : HttpHandler = authorize >=> fun next ctx -> task {
let dbConn = conn ctx
match! Listings.findById (ListingId listingId) with match! Listings.findById (ListingId listingId) with
| Some listing when listing.citizenId <> (currentCitizenId ctx) -> return! Error.notAuthorized next ctx | Some listing when listing.citizenId <> (currentCitizenId ctx) -> return! Error.notAuthorized next ctx
| Some listing -> | Some listing ->
@ -282,7 +269,7 @@ module Listing =
remoteWork = form.remoteWork remoteWork = form.remoteWork
text = Text form.text text = Text form.text
neededBy = form.neededBy |> Option.map parseDate neededBy = form.neededBy |> Option.map parseDate
updatedOn = (clock ctx).GetCurrentInstant () updatedOn = now ctx
} }
return! ok next ctx return! ok next ctx
| None -> return! Error.notFound next ctx | None -> return! Error.notFound next ctx
@ -290,8 +277,7 @@ module Listing =
// PATCH: /api/listing/[id] // PATCH: /api/listing/[id]
let expire listingId : HttpHandler = authorize >=> fun next ctx -> task { let expire listingId : HttpHandler = authorize >=> fun next ctx -> task {
let dbConn = conn ctx let now = now ctx
let now = clock(ctx).GetCurrentInstant ()
match! Listings.findById (ListingId listingId) with match! Listings.findById (ListingId listingId) with
| Some listing when listing.citizenId <> (currentCitizenId ctx) -> return! Error.notAuthorized next ctx | Some listing when listing.citizenId <> (currentCitizenId ctx) -> return! Error.notAuthorized next ctx
| Some listing -> | 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 // 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. // is not an error). The "get" handler returns a 404 if a profile is not found.
let current : HttpHandler = authorize >=> fun next ctx -> task { 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 | Some profile -> return! json profile next ctx
| None -> return! Successful.NO_CONTENT next ctx | None -> return! Successful.NO_CONTENT next ctx
} }
// GET: /api/profile/get/[id] // GET: /api/profile/get/[id]
let get citizenId : HttpHandler = authorize >=> fun next ctx -> task { 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 | Some profile -> return! json profile next ctx
| None -> return! Error.notFound next ctx | None -> return! Error.notFound next ctx
} }
// GET: /api/profile/view/[id] // GET: /api/profile/view/[id]
let view citizenId : HttpHandler = authorize >=> fun next ctx -> task { let view citizenId : HttpHandler = authorize >=> fun next ctx -> task {
let citId = CitizenId citizenId match! Profiles.findByIdForView (CitizenId citizenId) with
let dbConn = conn ctx | Some profile -> return! json profile next 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
| None -> return! Error.notFound next ctx | None -> return! Error.notFound next ctx
} }
// GET: /api/profile/count // GET: /api/profile/count
let count : HttpHandler = authorize >=> fun next ctx -> task { 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 return! json { count = theCount } next ctx
} }
// POST: /api/profile/save // POST: /api/profile/save
let save : HttpHandler = authorize >=> fun next ctx -> task { let save : HttpHandler = authorize >=> fun next ctx -> task {
let citizenId = currentCitizenId ctx let citizenId = currentCitizenId ctx
let dbConn = conn ctx
let! form = ctx.BindJsonAsync<ProfileForm>() let! form = ctx.BindJsonAsync<ProfileForm>()
let! profile = task { let! profile = task {
match! Data.Profile.findById citizenId dbConn with match! Profiles.findById citizenId with
| Some p -> return p | Some p -> return p
| None -> return { Profile.empty with id = citizenId } | None -> return { Profile.empty with id = citizenId }
} }
do! Data.Profile.save do! Profiles.save
{ profile with { profile with
seekingEmployment = form.isSeekingEmployment seekingEmployment = form.isSeekingEmployment
isPublic = form.isPublic isPublic = form.isPublic
@ -391,48 +362,45 @@ module Profile =
remoteWork = form.remoteWork remoteWork = form.remoteWork
fullTime = form.fullTime fullTime = form.fullTime
biography = Text form.biography biography = Text form.biography
lastUpdatedOn = (clock ctx).GetCurrentInstant () lastUpdatedOn = now ctx
experience = noneIfBlank form.experience |> Option.map Text experience = noneIfBlank form.experience |> Option.map Text
skills = form.skills skills = form.skills
|> List.map (fun s -> |> List.map (fun s ->
{ id = match s.id.StartsWith "new" with { id = if s.id.StartsWith "new" then SkillId.create ()
| true -> SkillId.create () else SkillId.ofString s.id
| false -> SkillId.ofString s.id description = s.description
description = s.description notes = noneIfBlank s.notes
notes = noneIfBlank s.notes })
}) }
} dbConn
do! Data.Citizen.realNameUpdate citizenId (noneIfBlank (Some form.realName)) dbConn
return! ok next ctx return! ok next ctx
} }
// PATCH: /api/profile/employment-found // PATCH: /api/profile/employment-found
let employmentFound : HttpHandler = authorize >=> fun next ctx -> task { let employmentFound : HttpHandler = authorize >=> fun next ctx -> task {
let dbConn = conn ctx match! Profiles.findById (currentCitizenId ctx) with
match! Data.Profile.findById (currentCitizenId ctx) dbConn with
| Some profile -> | Some profile ->
do! Data.Profile.save { profile with seekingEmployment = false } dbConn do! Profiles.save { profile with seekingEmployment = false }
return! ok next ctx return! ok next ctx
| None -> return! Error.notFound next ctx | None -> return! Error.notFound next ctx
} }
// DELETE: /api/profile // DELETE: /api/profile
let delete : HttpHandler = authorize >=> fun next ctx -> task { 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 return! ok next ctx
} }
// GET: /api/profile/search // GET: /api/profile/search
let search : HttpHandler = authorize >=> fun next ctx -> task { let search : HttpHandler = authorize >=> fun next ctx -> task {
let search = ctx.BindQueryString<ProfileSearch> () let search = ctx.BindQueryString<ProfileSearch> ()
let! results = Data.Profile.search search (conn ctx) let! results = Profiles.search search
return! json results next ctx return! json results next ctx
} }
// GET: /api/profile/public-search // GET: /api/profile/public-search
let publicSearch : HttpHandler = fun next ctx -> task { let publicSearch : HttpHandler = fun next ctx -> task {
let search = ctx.BindQueryString<PublicSearch> () let search = ctx.BindQueryString<PublicSearch> ()
let! results = Data.Profile.publicSearch search (conn ctx) let! results = Profiles.publicSearch search
return! json results next ctx return! json results next ctx
} }
@ -441,39 +409,35 @@ module Profile =
[<RequireQualifiedAccess>] [<RequireQualifiedAccess>]
module Success = module Success =
open System
// GET: /api/success/[id] // GET: /api/success/[id]
let get successId : HttpHandler = authorize >=> fun next ctx -> task { 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 | Some story -> return! json story next ctx
| None -> return! Error.notFound next ctx | None -> return! Error.notFound next ctx
} }
// GET: /api/success/list // GET: /api/success/list
let all : HttpHandler = authorize >=> fun next ctx -> task { let all : HttpHandler = authorize >=> fun next ctx -> task {
let! stories = Data.Success.all (conn ctx) let! stories = Successes.all ()
return! json stories next ctx return! json stories next ctx
} }
// POST: /api/success/save // POST: /api/success/save
let save : HttpHandler = authorize >=> fun next ctx -> task { let save : HttpHandler = authorize >=> fun next ctx -> task {
let citizenId = currentCitizenId ctx let citizenId = currentCitizenId ctx
let dbConn = conn ctx
let now = (clock ctx).GetCurrentInstant ()
let! form = ctx.BindJsonAsync<StoryForm> () let! form = ctx.BindJsonAsync<StoryForm> ()
let! success = task { let! success = task {
match form.id with match form.id with
| "new" -> | "new" ->
return Some { id = SuccessId.create () return Some { id = SuccessId.create ()
citizenId = citizenId citizenId = citizenId
recordedOn = now recordedOn = now ctx
fromHere = form.fromHere fromHere = form.fromHere
source = "profile" source = "profile"
story = noneIfEmpty form.story |> Option.map Text story = noneIfEmpty form.story |> Option.map Text
} }
| successId -> | successId ->
match! Data.Success.findById (SuccessId.ofString successId) dbConn with match! Successes.findById (SuccessId.ofString successId) with
| Some story when story.citizenId = citizenId -> | Some story when story.citizenId = citizenId ->
return Some { story with return Some { story with
fromHere = form.fromHere fromHere = form.fromHere
@ -483,7 +447,7 @@ module Success =
} }
match success with match success with
| Some story -> | Some story ->
do! Data.Success.save story dbConn do! Successes.save story
return! ok next ctx return! ok next ctx
| None -> return! Error.notFound next ctx | None -> return! Error.notFound next ctx
} }

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

@ -8,7 +8,6 @@
</PropertyGroup> </PropertyGroup>
<ItemGroup> <ItemGroup>
<Compile Include="Data.fs" />
<Compile Include="Auth.fs" /> <Compile Include="Auth.fs" />
<Compile Include="Handlers.fs" /> <Compile Include="Handlers.fs" />
<Compile Include="App.fs" /> <Compile Include="App.fs" />
@ -25,15 +24,10 @@
<ItemGroup> <ItemGroup>
<PackageReference Include="Giraffe" Version="6.0.0" /> <PackageReference Include="Giraffe" Version="6.0.0" />
<PackageReference Include="Microsoft.AspNetCore.Authentication.JwtBearer" Version="6.0.6" /> <PackageReference Include="Microsoft.AspNetCore.Authentication.JwtBearer" Version="6.0.8" />
<PackageReference Include="Microsoft.FSharpLu.Json" Version="0.11.7" /> <PackageReference Include="Microsoft.FSharpLu.Json" Version="0.11.7" />
<PackageReference Include="NodaTime.Serialization.JsonNet" Version="3.0.0" /> <PackageReference Include="NodaTime.Serialization.JsonNet" Version="3.0.0" />
<PackageReference Include="Npgsql" Version="6.0.6" /> <PackageReference Include="System.IdentityModel.Tokens.Jwt" Version="6.22.0" />
<PackageReference Include="Npgsql.FSharp" Version="5.3.0" />
<PackageReference Include="Npgsql.NodaTime" Version="6.0.6" />
<PackageReference Include="RethinkDb.Driver" Version="2.3.150" />
<PackageReference Include="RethinkDb.Driver.FSharp" Version="0.9.0-beta-05" />
<PackageReference Include="System.IdentityModel.Tokens.Jwt" Version="6.21.0" />
<PackageReference Update="FSharp.Core" Version="6.0.5" /> <PackageReference Update="FSharp.Core" Version="6.0.5" />
</ItemGroup> </ItemGroup>