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

Version 3 #40

Merged
danieljsummers merged 67 commits from version-2-3 into main 2023-02-02 23:47:28 +00:00
Conversation 0 Commits 67 Files Changed 126 +551 -1041
12 changed files with 551 additions and 1041 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files
Showing only changes of commit 6896b0e60e - Show all commits

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>