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)
FSharp.Core (>= 4.2.3)
Microsoft.Win32.Registry (>= 4.7)
Fake.Core.CommandLineParsing (5.22)
Fake.Core.CommandLineParsing (5.23)
FParsec (>= 1.1.1)
FSharp.Core (>= 6.0)
Fake.Core.Context (5.22)
Fake.Core.Context (5.23)
FSharp.Core (>= 6.0)
Fake.Core.Environment (5.22)
Fake.Core.Environment (5.23)
FSharp.Core (>= 6.0)
Fake.Core.FakeVar (5.22)
Fake.Core.Context (>= 5.22)
Fake.Core.FakeVar (5.23)
Fake.Core.Context (>= 5.23)
FSharp.Core (>= 6.0)
Fake.Core.Process (5.22)
Fake.Core.Environment (>= 5.22)
Fake.Core.FakeVar (>= 5.22)
Fake.Core.String (>= 5.22)
Fake.Core.Trace (>= 5.22)
Fake.IO.FileSystem (>= 5.22)
Fake.Core.Process (5.23)
Fake.Core.Environment (>= 5.23)
Fake.Core.FakeVar (>= 5.23)
Fake.Core.String (>= 5.23)
Fake.Core.Trace (>= 5.23)
Fake.IO.FileSystem (>= 5.23)
FSharp.Core (>= 6.0)
System.Collections.Immutable (>= 5.0)
Fake.Core.SemVer (5.22)
Fake.Core.SemVer (5.23)
FSharp.Core (>= 6.0)
Fake.Core.String (5.22)
Fake.Core.String (5.23)
FSharp.Core (>= 6.0)
Fake.Core.Target (5.22)
Fake.Core.CommandLineParsing (>= 5.22)
Fake.Core.Context (>= 5.22)
Fake.Core.Environment (>= 5.22)
Fake.Core.FakeVar (>= 5.22)
Fake.Core.Process (>= 5.22)
Fake.Core.String (>= 5.22)
Fake.Core.Trace (>= 5.22)
Fake.Core.Target (5.23)
Fake.Core.CommandLineParsing (>= 5.23)
Fake.Core.Context (>= 5.23)
Fake.Core.Environment (>= 5.23)
Fake.Core.FakeVar (>= 5.23)
Fake.Core.Process (>= 5.23)
Fake.Core.String (>= 5.23)
Fake.Core.Trace (>= 5.23)
FSharp.Control.Reactive (>= 5.0.2)
FSharp.Core (>= 6.0)
Fake.Core.Tasks (5.22)
Fake.Core.Trace (>= 5.22)
Fake.Core.Tasks (5.23)
Fake.Core.Trace (>= 5.23)
FSharp.Core (>= 6.0)
Fake.Core.Trace (5.22)
Fake.Core.Environment (>= 5.22)
Fake.Core.FakeVar (>= 5.22)
Fake.Core.Trace (5.23)
Fake.Core.Environment (>= 5.23)
Fake.Core.FakeVar (>= 5.23)
FSharp.Core (>= 6.0)
Fake.Core.Xml (5.22)
Fake.Core.String (>= 5.22)
Fake.Core.Xml (5.23)
Fake.Core.String (>= 5.23)
FSharp.Core (>= 6.0)
Fake.DotNet.Cli (5.22)
Fake.Core.Environment (>= 5.22)
Fake.Core.Process (>= 5.22)
Fake.Core.String (>= 5.22)
Fake.Core.Trace (>= 5.22)
Fake.DotNet.MSBuild (>= 5.22)
Fake.DotNet.NuGet (>= 5.22)
Fake.IO.FileSystem (>= 5.22)
Fake.DotNet.Cli (5.23)
Fake.Core.Environment (>= 5.23)
Fake.Core.Process (>= 5.23)
Fake.Core.String (>= 5.23)
Fake.Core.Trace (>= 5.23)
Fake.DotNet.MSBuild (>= 5.23)
Fake.DotNet.NuGet (>= 5.23)
Fake.IO.FileSystem (>= 5.23)
FSharp.Core (>= 6.0)
Mono.Posix.NETStandard (>= 1.0)
Newtonsoft.Json (>= 13.0.1)
Fake.DotNet.MSBuild (5.22)
Fake.DotNet.MSBuild (5.23)
BlackFox.VsWhere (>= 1.1)
Fake.Core.Environment (>= 5.22)
Fake.Core.Process (>= 5.22)
Fake.Core.String (>= 5.22)
Fake.Core.Trace (>= 5.22)
Fake.IO.FileSystem (>= 5.22)
Fake.Core.Environment (>= 5.23)
Fake.Core.Process (>= 5.23)
Fake.Core.String (>= 5.23)
Fake.Core.Trace (>= 5.23)
Fake.IO.FileSystem (>= 5.23)
FSharp.Core (>= 6.0)
MSBuild.StructuredLogger (>= 2.1.545)
Fake.DotNet.NuGet (5.22)
Fake.Core.Environment (>= 5.22)
Fake.Core.Process (>= 5.22)
Fake.Core.SemVer (>= 5.22)
Fake.Core.String (>= 5.22)
Fake.Core.Tasks (>= 5.22)
Fake.Core.Trace (>= 5.22)
Fake.Core.Xml (>= 5.22)
Fake.IO.FileSystem (>= 5.22)
Fake.Net.Http (>= 5.22)
Fake.DotNet.NuGet (5.23)
Fake.Core.Environment (>= 5.23)
Fake.Core.Process (>= 5.23)
Fake.Core.SemVer (>= 5.23)
Fake.Core.String (>= 5.23)
Fake.Core.Tasks (>= 5.23)
Fake.Core.Trace (>= 5.23)
Fake.Core.Xml (>= 5.23)
Fake.IO.FileSystem (>= 5.23)
Fake.Net.Http (>= 5.23)
FSharp.Core (>= 6.0)
Newtonsoft.Json (>= 13.0.1)
NuGet.Protocol (>= 5.11)
Fake.IO.FileSystem (5.22)
Fake.Core.String (>= 5.22)
Fake.IO.FileSystem (5.23)
Fake.Core.String (>= 5.23)
FSharp.Core (>= 6.0)
Fake.JavaScript.Npm (5.22)
Fake.Core.Environment (>= 5.22)
Fake.Core.Process (>= 5.22)
Fake.IO.FileSystem (>= 5.22)
Fake.Testing.Common (>= 5.22)
Fake.JavaScript.Npm (5.23)
Fake.Core.Environment (>= 5.23)
Fake.Core.Process (>= 5.23)
Fake.IO.FileSystem (>= 5.23)
Fake.Testing.Common (>= 5.23)
FSharp.Core (>= 6.0)
Fake.Net.Http (5.22)
Fake.Core.Trace (>= 5.22)
Fake.Net.Http (5.23)
Fake.Core.Trace (>= 5.23)
FSharp.Core (>= 6.0)
Fake.Testing.Common (5.22)
Fake.Core.Trace (>= 5.22)
Fake.Testing.Common (5.23)
Fake.Core.Trace (>= 5.23)
FSharp.Core (>= 6.0)
FParsec (1.1.1)
FSharp.Core (>= 4.3.4)
@ -112,9 +112,8 @@ NUGET
System.Text.Encoding.CodePages (>= 4.0.1) - restriction: || (== net6.0) (&& (== netstandard2.0) (>= net6.0))
System.Text.Json (>= 6.0) - restriction: || (== net6.0) (&& (== netstandard2.0) (>= net472)) (&& (== netstandard2.0) (>= net6.0))
System.Threading.Tasks.Dataflow (>= 6.0) - restriction: || (== net6.0) (&& (== netstandard2.0) (>= net472)) (&& (== netstandard2.0) (>= net6.0))
Microsoft.Build.Framework (17.2)
Microsoft.Win32.Registry (>= 4.3)
System.Security.Permissions (>= 4.7)
Microsoft.Build.Framework (17.3.1)
System.Security.Permissions (>= 6.0)
Microsoft.Build.Tasks.Core (17.2)
Microsoft.Build.Framework (>= 17.2)
Microsoft.Build.Utilities.Core (>= 17.2)
@ -139,7 +138,7 @@ NUGET
Microsoft.NET.StringTools (1.0)
System.Memory (>= 4.5.4)
System.Runtime.CompilerServices.Unsafe (>= 5.0)
Microsoft.NETCore.Platforms (6.0.4) - restriction: || (&& (== net6.0) (< netcoreapp3.1)) (&& (== net6.0) (< netstandard1.2)) (&& (== net6.0) (< netstandard1.3)) (&& (== net6.0) (< netstandard1.5)) (== netstandard2.0)
Microsoft.NETCore.Platforms (6.0.5) - restriction: || (&& (== net6.0) (< netcoreapp3.1)) (&& (== net6.0) (< netstandard1.2)) (&& (== net6.0) (< netstandard1.3)) (&& (== net6.0) (< netstandard1.5)) (== netstandard2.0)
Microsoft.NETCore.Targets (5.0) - restriction: || (&& (== net6.0) (< netcoreapp3.1)) (&& (== net6.0) (< netstandard1.2)) (&& (== net6.0) (< netstandard1.3)) (&& (== net6.0) (< netstandard1.5)) (== netstandard2.0)
Microsoft.Win32.Registry (5.0)
System.Buffers (>= 4.5.1) - restriction: || (&& (== net6.0) (>= monoandroid) (< netstandard1.3)) (&& (== net6.0) (>= monotouch)) (&& (== net6.0) (< netcoreapp2.0)) (&& (== net6.0) (>= xamarinios)) (&& (== net6.0) (>= xamarinmac)) (&& (== net6.0) (>= xamarintvos)) (&& (== net6.0) (>= xamarinwatchos)) (== netstandard2.0)
@ -154,21 +153,21 @@ NUGET
Microsoft.Build.Tasks.Core (>= 16.10)
Microsoft.Build.Utilities.Core (>= 16.10)
Newtonsoft.Json (13.0.1)
NuGet.Common (6.2.1)
NuGet.Frameworks (>= 6.2.1)
NuGet.Configuration (6.2.1)
NuGet.Common (>= 6.2.1)
NuGet.Common (6.3)
NuGet.Frameworks (>= 6.3)
NuGet.Configuration (6.3)
NuGet.Common (>= 6.3)
System.Security.Cryptography.ProtectedData (>= 4.4)
NuGet.Frameworks (6.2.1)
NuGet.Packaging (6.2.1)
NuGet.Frameworks (6.3)
NuGet.Packaging (6.3)
Newtonsoft.Json (>= 13.0.1)
NuGet.Configuration (>= 6.2.1)
NuGet.Versioning (>= 6.2.1)
NuGet.Configuration (>= 6.3)
NuGet.Versioning (>= 6.3)
System.Security.Cryptography.Cng (>= 5.0)
System.Security.Cryptography.Pkcs (>= 5.0)
NuGet.Protocol (6.2.1)
NuGet.Packaging (>= 6.2.1)
NuGet.Versioning (6.2.1)
NuGet.Protocol (6.3)
NuGet.Packaging (>= 6.3)
NuGet.Versioning (6.3)
System.Buffers (4.5.1) - restriction: || (&& (== net6.0) (>= monoandroid) (< netstandard1.3)) (&& (== net6.0) (>= monotouch)) (&& (== net6.0) (< netcoreapp2.0)) (&& (== net6.0) (>= xamarinios)) (&& (== net6.0) (>= xamarinmac)) (&& (== net6.0) (>= xamarintvos)) (&& (== net6.0) (>= xamarinwatchos)) (== netstandard2.0)
System.CodeDom (6.0)
System.Collections.Immutable (6.0)
@ -210,10 +209,10 @@ NUGET
System.Memory (>= 4.5.4) - restriction: || (&& (== net6.0) (< netstandard2.1)) (== netstandard2.0)
System.Security.Cryptography.Cng (>= 5.0) - restriction: || (&& (== net6.0) (< netcoreapp3.1)) (&& (== net6.0) (< netstandard2.1)) (== netstandard2.0)
System.Security.Cryptography.ProtectedData (6.0)
System.Security.Cryptography.Xml (6.0)
System.Security.Cryptography.Xml (6.0.1)
System.Memory (>= 4.5.4) - restriction: == netstandard2.0
System.Security.AccessControl (>= 6.0)
System.Security.Cryptography.Pkcs (>= 6.0)
System.Security.Cryptography.Pkcs (>= 6.0.1)
System.Security.Permissions (6.0)
System.Security.AccessControl (>= 6.0)
System.Windows.Extensions (>= 6.0) - restriction: || (== net6.0) (&& (== netstandard2.0) (>= netcoreapp3.1))

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

@ -13,9 +13,9 @@
<ItemGroup>
<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="NodaTime" Version="3.1.0" />
<PackageReference Include="NodaTime" Version="3.1.2" />
<PackageReference Update="FSharp.Core" Version="6.0.5" />
</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
module JobsJobsJobs.Domain.SharedTypes
open JobsJobsJobs.Domain.Types
open JobsJobsJobs.Domain
open Microsoft.Extensions.Options
open NodaTime
@ -202,7 +202,7 @@ type ProfileForm =
module ProfileForm =
/// Create an instance of this form from the given profile
let fromProfile (profile : Types.Profile) =
let fromProfile (profile : Profile) =
{ isSeekingEmployment = profile.seekingEmployment
isPublic = profile.isPublic
realName = ""

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

@ -45,6 +45,19 @@ with
/// Support functions for citizens
module Citizen =
/// An empty citizen
let empty =
{ id = CitizenId Guid.Empty
joinedOn = Instant.MinValue
lastSeenOn = Instant.MinValue
email = ""
firstName = ""
lastName = ""
passwordHash = ""
displayName = None
otherContacts = []
isLegacy = false
}
/// Get the name of the citizen (either their preferred display name or first/last names)
let name x =
match x.displayName with Some it -> it | None -> $"{x.firstName} {x.lastName}"
@ -116,6 +129,26 @@ type Listing =
isLegacy : bool
}
/// Support functions for job listings
module Listing =
/// An empty job listing
let empty =
{ id = ListingId Guid.Empty
citizenId = CitizenId Guid.Empty
createdOn = Instant.MinValue
title = ""
continentId = ContinentId Guid.Empty
region = ""
remoteWork = false
isExpired = false
updatedOn = Instant.MinValue
text = Text ""
neededBy = None
wasFilledHere = None
isLegacy = false
}
/// Security settings for a user
type SecurityInfo =
@ -253,3 +286,16 @@ type Success =
/// The success story
story : MarkdownString option
}
/// Support functions for success stories
module Success =
/// An empty success story
let empty =
{ id = SuccessId Guid.Empty
citizenId = CitizenId Guid.Empty
recordedOn = Instant.MinValue
fromHere = false
source = ""
story = None
}

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

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

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

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

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

@ -8,7 +8,6 @@ open Microsoft.Extensions.Hosting
open Giraffe
open Giraffe.EndpointRouting
/// Configure the ASP.NET Core pipeline to use Giraffe
let configureApp (app : IApplicationBuilder) =
app.UseCors(fun p -> p.AllowAnyOrigin().AllowAnyHeader() |> ignore)
@ -22,13 +21,11 @@ let configureApp (app : IApplicationBuilder) =
e.MapFallbackToFile "index.html" |> ignore)
|> ignore
open Newtonsoft.Json
open NodaTime
open System.Text
open Microsoft.AspNetCore.Authentication.JwtBearer
open Microsoft.Extensions.Configuration
open Microsoft.Extensions.Logging
open Microsoft.IdentityModel.Tokens
open System.Text
open NodaTime
open JobsJobsJobs.Data
open JobsJobsJobs.Domain.SharedTypes
@ -39,9 +36,7 @@ let configureServices (svc : IServiceCollection) =
let _ = svc.AddLogging ()
let _ = svc.AddCors ()
let jsonCfg = JsonSerializerSettings ()
Data.Converters.all () |> List.iter jsonCfg.Converters.Add
let _ = svc.AddSingleton<Json.ISerializer> (NewtonsoftJson.Serializer jsonCfg)
let _ = svc.AddSingleton<Json.ISerializer> (SystemTextJson.Serializer Json.options)
let svcs = svc.BuildServiceProvider ()
let cfg = svcs.GetRequiredService<IConfiguration> ()
@ -64,13 +59,11 @@ let configureServices (svc : IServiceCollection) =
let _ = svc.AddAuthorization ()
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
let _ = Connection.setUp cfg
()
match Connection.setUp cfg |> Async.AwaitTask |> Async.RunSynchronously with
| Ok _ -> ()
| Error msg -> failwith $"Error initializing data store: {msg}"
[<EntryPoint>]
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.Types
open Microsoft.IdentityModel.Tokens
open System.IdentityModel.Tokens.Jwt
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
module JobsJobsJobs.Api.Handlers
open System.Threading
open Giraffe
open JobsJobsJobs.Domain
open JobsJobsJobs.Domain.SharedTypes
@ -55,15 +54,12 @@ module Error =
module Helpers =
open System.Security.Claims
open System.Threading.Tasks
open NodaTime
open Marten
open Microsoft.Extensions.Configuration
open Microsoft.Extensions.Options
open RethinkDb.Driver.Net
/// Get the NodaTime clock from the request context
let clock (ctx : HttpContext) = ctx.GetService<IClock> ()
let now (ctx : HttpContext) = ctx.GetService<IClock>().GetCurrentInstant ()
/// Get the application configuration from the request context
let config (ctx : HttpContext) = ctx.GetService<IConfiguration> ()
@ -74,15 +70,6 @@ module Helpers =
/// Get the logger factory from the request context
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
let noneIfBlank (s : string option) =
s |> Option.map (fun x -> match x.Trim () with "" -> None | _ -> Some x) |> Option.flatten
@ -106,16 +93,6 @@ module Helpers =
/// Return an empty OK response
let ok : HttpHandler = Successful.OK ""
/// Convert a potentially-null record type to an option
let opt<'T> (it : Task<'T>) = task {
match! it with
| x when isNull (box x) -> return None
| x -> return Some x
}
/// Shorthand for no cancellation token
let noCnx = CancellationToken.None
open System
@ -127,48 +104,59 @@ module Citizen =
// GET: /api/citizen/log-on/[code]
let logOn (abbr, authCode) : HttpHandler = fun next ctx -> task {
match! Citizens.tryLogOn "to@do.com" (fun _ -> false) (now ctx) with
| Ok citizen ->
return!
json
{ jwt = Auth.createJwt citizen (authConfig ctx)
citizenId = CitizenId.toString citizen.id
name = Citizen.name citizen
} next ctx
| Error msg ->
// TODO: return error message
return! RequestErrors.BAD_REQUEST msg next ctx
// Step 1 - Verify with Mastodon
let cfg = authConfig ctx
match cfg.Instances |> Array.tryFind (fun it -> it.Abbr = abbr) with
| Some instance ->
let log = (logger ctx).CreateLogger (nameof JobsJobsJobs.Api.Auth)
match! Auth.verifyWithMastodon authCode instance cfg.ReturnHost log with
| Ok account ->
// Step 2 - Find / establish Jobs, Jobs, Jobs account
let now = (clock ctx).GetCurrentInstant ()
let dbConn = conn ctx
let! citizen = task {
match! Data.Citizen.findByMastodonUser instance.Abbr account.Username dbConn with
| None ->
let it : Citizen =
{ id = CitizenId.create ()
instance = instance.Abbr
mastodonUser = account.Username
displayName = noneIfEmpty account.DisplayName
realName = None
profileUrl = account.Url
joinedOn = now
lastSeenOn = now
}
do! Data.Citizen.add it dbConn
return it
| Some citizen ->
let it = { citizen with displayName = noneIfEmpty account.DisplayName; lastSeenOn = now }
do! Data.Citizen.logOnUpdate it dbConn
return it
}
// Step 3 - Generate JWT
return!
json
{ jwt = Auth.createJwt citizen cfg
citizenId = CitizenId.toString citizen.id
name = Citizen.name citizen
} next ctx
| Error err -> return! RequestErrors.BAD_REQUEST err next ctx
| None -> return! Error.notFound next ctx
// let cfg = authConfig ctx
//
// match cfg.Instances |> Array.tryFind (fun it -> it.Abbr = abbr) with
// | Some instance ->
// let log = (logger ctx).CreateLogger (nameof JobsJobsJobs.Api.Auth)
//
// match! Auth.verifyWithMastodon authCode instance cfg.ReturnHost log with
// | Ok account ->
// // Step 2 - Find / establish Jobs, Jobs, Jobs account
// let now = (clock ctx).GetCurrentInstant ()
// let dbConn = conn ctx
// let! citizen = task {
// match! Data.Citizen.findByMastodonUser instance.Abbr account.Username dbConn with
// | None ->
// let it : Citizen =
// { id = CitizenId.create ()
// instance = instance.Abbr
// mastodonUser = account.Username
// displayName = noneIfEmpty account.DisplayName
// realName = None
// profileUrl = account.Url
// joinedOn = now
// lastSeenOn = now
// }
// do! Data.Citizen.add it dbConn
// return it
// | Some citizen ->
// let it = { citizen with displayName = noneIfEmpty account.DisplayName; lastSeenOn = now }
// do! Data.Citizen.logOnUpdate it dbConn
// return it
// }
//
// // Step 3 - Generate JWT
// return!
// json
// { jwt = Auth.createJwt citizen cfg
// citizenId = CitizenId.toString citizen.id
// name = Citizen.name citizen
// } next ctx
// | Error err -> return! RequestErrors.BAD_REQUEST err next ctx
// | None -> return! Error.notFound next ctx
}
// GET: /api/citizen/[id]
@ -248,7 +236,7 @@ module Listing =
// POST: /listings
let add : HttpHandler = authorize >=> fun next ctx -> task {
let! form = ctx.BindJsonAsync<ListingForm> ()
let now = (clock ctx).GetCurrentInstant ()
let now = now ctx
do! Listings.save {
id = ListingId.create ()
citizenId = currentCitizenId ctx
@ -269,7 +257,6 @@ module Listing =
// PUT: /api/listing/[id]
let update listingId : HttpHandler = authorize >=> fun next ctx -> task {
let dbConn = conn ctx
match! Listings.findById (ListingId listingId) with
| Some listing when listing.citizenId <> (currentCitizenId ctx) -> return! Error.notAuthorized next ctx
| Some listing ->
@ -282,7 +269,7 @@ module Listing =
remoteWork = form.remoteWork
text = Text form.text
neededBy = form.neededBy |> Option.map parseDate
updatedOn = (clock ctx).GetCurrentInstant ()
updatedOn = now ctx
}
return! ok next ctx
| None -> return! Error.notFound next ctx
@ -290,8 +277,7 @@ module Listing =
// PATCH: /api/listing/[id]
let expire listingId : HttpHandler = authorize >=> fun next ctx -> task {
let dbConn = conn ctx
let now = clock(ctx).GetCurrentInstant ()
let now = now ctx
match! Listings.findById (ListingId listingId) with
| Some listing when listing.citizenId <> (currentCitizenId ctx) -> return! Error.notAuthorized next ctx
| Some listing ->
@ -333,56 +319,41 @@ module Profile =
// This returns the current citizen's profile, or a 204 if it is not found (a citizen not having a profile yet
// is not an error). The "get" handler returns a 404 if a profile is not found.
let current : HttpHandler = authorize >=> fun next ctx -> task {
match! Data.Profile.findById (currentCitizenId ctx) (conn ctx) with
match! Profiles.findById (currentCitizenId ctx) with
| Some profile -> return! json profile next ctx
| None -> return! Successful.NO_CONTENT next ctx
}
// GET: /api/profile/get/[id]
let get citizenId : HttpHandler = authorize >=> fun next ctx -> task {
match! Data.Profile.findById (CitizenId citizenId) (conn ctx) with
match! Profiles.findById (CitizenId citizenId) with
| Some profile -> return! json profile next ctx
| None -> return! Error.notFound next ctx
}
// GET: /api/profile/view/[id]
let view citizenId : HttpHandler = authorize >=> fun next ctx -> task {
let citId = CitizenId citizenId
let dbConn = conn ctx
match! Data.Profile.findById citId dbConn with
| Some profile ->
match! Data.Citizen.findById citId dbConn with
| Some citizen ->
match! Data.Continent.findById profile.continentId dbConn with
| Some continent ->
return!
json
{ profile = profile
citizen = citizen
continent = continent
} next ctx
| None -> return! Error.notFound next ctx
| None -> return! Error.notFound next ctx
match! Profiles.findByIdForView (CitizenId citizenId) with
| Some profile -> return! json profile next ctx
| None -> return! Error.notFound next ctx
}
// GET: /api/profile/count
let count : HttpHandler = authorize >=> fun next ctx -> task {
let! theCount = Data.Profile.count (conn ctx)
let! theCount = Profiles.count ()
return! json { count = theCount } next ctx
}
// POST: /api/profile/save
let save : HttpHandler = authorize >=> fun next ctx -> task {
let citizenId = currentCitizenId ctx
let dbConn = conn ctx
let! form = ctx.BindJsonAsync<ProfileForm>()
let! profile = task {
match! Data.Profile.findById citizenId dbConn with
match! Profiles.findById citizenId with
| Some p -> return p
| None -> return { Profile.empty with id = citizenId }
}
do! Data.Profile.save
do! Profiles.save
{ profile with
seekingEmployment = form.isSeekingEmployment
isPublic = form.isPublic
@ -391,48 +362,45 @@ module Profile =
remoteWork = form.remoteWork
fullTime = form.fullTime
biography = Text form.biography
lastUpdatedOn = (clock ctx).GetCurrentInstant ()
lastUpdatedOn = now ctx
experience = noneIfBlank form.experience |> Option.map Text
skills = form.skills
|> List.map (fun s ->
{ id = match s.id.StartsWith "new" with
| true -> SkillId.create ()
| false -> SkillId.ofString s.id
description = s.description
notes = noneIfBlank s.notes
})
} dbConn
do! Data.Citizen.realNameUpdate citizenId (noneIfBlank (Some form.realName)) dbConn
{ id = if s.id.StartsWith "new" then SkillId.create ()
else SkillId.ofString s.id
description = s.description
notes = noneIfBlank s.notes
})
}
return! ok next ctx
}
// PATCH: /api/profile/employment-found
let employmentFound : HttpHandler = authorize >=> fun next ctx -> task {
let dbConn = conn ctx
match! Data.Profile.findById (currentCitizenId ctx) dbConn with
match! Profiles.findById (currentCitizenId ctx) with
| Some profile ->
do! Data.Profile.save { profile with seekingEmployment = false } dbConn
do! Profiles.save { profile with seekingEmployment = false }
return! ok next ctx
| None -> return! Error.notFound next ctx
}
// DELETE: /api/profile
let delete : HttpHandler = authorize >=> fun next ctx -> task {
do! Data.Profile.delete (currentCitizenId ctx) (conn ctx)
do! Profiles.deleteById (currentCitizenId ctx)
return! ok next ctx
}
// GET: /api/profile/search
let search : HttpHandler = authorize >=> fun next ctx -> task {
let search = ctx.BindQueryString<ProfileSearch> ()
let! results = Data.Profile.search search (conn ctx)
let! results = Profiles.search search
return! json results next ctx
}
// GET: /api/profile/public-search
let publicSearch : HttpHandler = fun next ctx -> task {
let search = ctx.BindQueryString<PublicSearch> ()
let! results = Data.Profile.publicSearch search (conn ctx)
let! results = Profiles.publicSearch search
return! json results next ctx
}
@ -441,39 +409,35 @@ module Profile =
[<RequireQualifiedAccess>]
module Success =
open System
// GET: /api/success/[id]
let get successId : HttpHandler = authorize >=> fun next ctx -> task {
match! Data.Success.findById (SuccessId successId) (conn ctx) with
match! Successes.findById (SuccessId successId) with
| Some story -> return! json story next ctx
| None -> return! Error.notFound next ctx
}
// GET: /api/success/list
let all : HttpHandler = authorize >=> fun next ctx -> task {
let! stories = Data.Success.all (conn ctx)
let! stories = Successes.all ()
return! json stories next ctx
}
// POST: /api/success/save
let save : HttpHandler = authorize >=> fun next ctx -> task {
let citizenId = currentCitizenId ctx
let dbConn = conn ctx
let now = (clock ctx).GetCurrentInstant ()
let! form = ctx.BindJsonAsync<StoryForm> ()
let! success = task {
match form.id with
| "new" ->
return Some { id = SuccessId.create ()
citizenId = citizenId
recordedOn = now
recordedOn = now ctx
fromHere = form.fromHere
source = "profile"
story = noneIfEmpty form.story |> Option.map Text
}
| successId ->
match! Data.Success.findById (SuccessId.ofString successId) dbConn with
match! Successes.findById (SuccessId.ofString successId) with
| Some story when story.citizenId = citizenId ->
return Some { story with
fromHere = form.fromHere
@ -483,7 +447,7 @@ module Success =
}
match success with
| Some story ->
do! Data.Success.save story dbConn
do! Successes.save story
return! ok next ctx
| None -> return! Error.notFound next ctx
}

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

@ -8,7 +8,6 @@
</PropertyGroup>
<ItemGroup>
<Compile Include="Data.fs" />
<Compile Include="Auth.fs" />
<Compile Include="Handlers.fs" />
<Compile Include="App.fs" />
@ -25,15 +24,10 @@
<ItemGroup>
<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="NodaTime.Serialization.JsonNet" Version="3.0.0" />
<PackageReference Include="Npgsql" Version="6.0.6" />
<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 Include="System.IdentityModel.Tokens.Jwt" Version="6.22.0" />
<PackageReference Update="FSharp.Core" Version="6.0.5" />
</ItemGroup>