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

Format code per F# suggestions

Browse Source
This commit is contained in:
Daniel J. Summers 2022-07-11 17:02:13 -04:00
parent 6e52688622
commit b591bf746c
8 changed files with 1317 additions and 1388 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

1
.gitignore vendored
View File

@ -4,3 +4,4 @@ src/**/bin
src/**/obj
src/**/appsettings.*.json
src/.vs
src/.idea

118
src/JobsJobsJobs/Domain/Modules.fs
View File

@ -7,97 +7,93 @@ open System
open Types
/// Format a GUID as a Short GUID
let private toShortGuid guid =
let convert (g : Guid) =
Convert.ToBase64String (g.ToByteArray ())
|> String.map (fun x -> match x with '/' -> '_' | '+' -> '-' | _ -> x)
(convert guid).Substring (0, 22)
let private toShortGuid (guid : Guid) =
Convert.ToBase64String(guid.ToByteArray ()).Replace('/', '_').Replace('+', '-')[0..21]
/// Turn a Short GUID back into a GUID
let private fromShortGuid x =
let unBase64 = x |> String.map (fun x -> match x with '_' -> '/' | '-' -> '+' | _ -> x)
(Convert.FromBase64String >> Guid) $"{unBase64}=="
let private fromShortGuid (it : string) =
(Convert.FromBase64String >> Guid) $"{it.Replace('_', '/').Replace('-', '+')}=="
/// Support functions for citizen IDs
module CitizenId =
/// Create a new citizen ID
let create () = (Guid.NewGuid >> CitizenId) ()
/// A string representation of a citizen ID
let toString = function (CitizenId it) -> toShortGuid it
/// Parse a string into a citizen ID
let ofString = fromShortGuid >> CitizenId
/// Create a new citizen ID
let create () = (Guid.NewGuid >> CitizenId) ()
/// A string representation of a citizen ID
let toString = function CitizenId it -> toShortGuid it
/// Parse a string into a citizen ID
let ofString = fromShortGuid >> CitizenId
/// Support functions for citizens
module Citizen =
/// Get the name of the citizen (the first of real name, display name, or handle that is filled in)
let name x =
[ x.realName; x.displayName; Some x.mastodonUser ]
|> List.find Option.isSome
|> Option.get
/// Get the name of the citizen (the first of real name, display name, or handle that is filled in)
let name x =
[ x.realName; x.displayName; Some x.mastodonUser ]
|> List.find Option.isSome
|> Option.get
/// Support functions for continent IDs
module ContinentId =
/// Create a new continent ID
let create () = (Guid.NewGuid >> ContinentId) ()
/// A string representation of a continent ID
let toString = function (ContinentId it) -> toShortGuid it
/// Parse a string into a continent ID
let ofString = fromShortGuid >> ContinentId
/// Create a new continent ID
let create () = (Guid.NewGuid >> ContinentId) ()
/// A string representation of a continent ID
let toString = function ContinentId it -> toShortGuid it
/// Parse a string into a continent ID
let ofString = fromShortGuid >> ContinentId
/// Support functions for listing IDs
module ListingId =
/// Create a new job listing ID
let create () = (Guid.NewGuid >> ListingId) ()
/// A string representation of a listing ID
let toString = function (ListingId it) -> toShortGuid it
/// Parse a string into a listing ID
let ofString = fromShortGuid >> ListingId
/// Create a new job listing ID
let create () = (Guid.NewGuid >> ListingId) ()
/// A string representation of a listing ID
let toString = function ListingId it -> toShortGuid it
/// Parse a string into a listing ID
let ofString = fromShortGuid >> ListingId
/// Support functions for Markdown strings
module MarkdownString =
/// The Markdown conversion pipeline (enables all advanced features)
let private pipeline = MarkdownPipelineBuilder().UseAdvancedExtensions().Build ()
/// Convert this Markdown string to HTML
let toHtml = function (Text text) -> Markdown.ToHtml (text, pipeline)
/// The Markdown conversion pipeline (enables all advanced features)
let private pipeline = MarkdownPipelineBuilder().UseAdvancedExtensions().Build ()
/// Convert this Markdown string to HTML
let toHtml = function Text text -> Markdown.ToHtml (text, pipeline)
/// Support functions for Profiles
module Profile =
// An empty profile
let empty =
{ id = CitizenId Guid.Empty
seekingEmployment = false
isPublic = false
continentId = ContinentId Guid.Empty
region = ""
remoteWork = false
fullTime = false
biography = Text ""
lastUpdatedOn = NodaTime.Instant.MinValue
experience = None
skills = []
}
// An empty profile
let empty =
{ id = CitizenId Guid.Empty
seekingEmployment = false
isPublic = false
continentId = ContinentId Guid.Empty
region = ""
remoteWork = false
fullTime = false
biography = Text ""
lastUpdatedOn = NodaTime.Instant.MinValue
experience = None
skills = []
}
/// Support functions for skill IDs
module SkillId =
/// Create a new skill ID
let create () = (Guid.NewGuid >> SkillId) ()
/// A string representation of a skill ID
let toString = function (SkillId it) -> toShortGuid it
/// Parse a string into a skill ID
let ofString = fromShortGuid >> SkillId
/// Create a new skill ID
let create () = (Guid.NewGuid >> SkillId) ()
/// A string representation of a skill ID
let toString = function SkillId it -> toShortGuid it
/// Parse a string into a skill ID
let ofString = fromShortGuid >> SkillId
/// Support functions for success report IDs
module SuccessId =
/// Create a new success report ID
let create () = (Guid.NewGuid >> SuccessId) ()
/// A string representation of a success report ID
let toString = function (SuccessId it) -> toShortGuid it
/// Parse a string into a success report ID
let ofString = fromShortGuid >> SuccessId
/// Create a new success report ID
let create () = (Guid.NewGuid >> SuccessId) ()
/// A string representation of a success report ID
let toString = function SuccessId it -> toShortGuid it
/// Parse a string into a success report ID
let ofString = fromShortGuid >> SuccessId

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

@ -8,272 +8,272 @@ open NodaTime
// fsharplint:disable FieldNames
/// The data required to add or edit a job listing
type ListingForm = {
/// The ID of the listing
id : string
/// The listing title
title : string
/// The ID of the continent on which this opportunity exists
continentId : string
/// The region in which this opportunity exists
region : string
/// Whether this is a remote work opportunity
remoteWork : bool
/// The text of the job listing
text : string
/// The date by which this job listing is needed
neededBy : string option
}
type ListingForm =
{ /// The ID of the listing
id : string
/// The listing title
title : string
/// The ID of the continent on which this opportunity exists
continentId : string
/// The region in which this opportunity exists
region : string
/// Whether this is a remote work opportunity
remoteWork : bool
/// The text of the job listing
text : string
/// The date by which this job listing is needed
neededBy : string option
}
/// The data needed to display a listing
type ListingForView = {
/// The listing itself
listing : Listing
/// The continent for that listing
continent : Continent
}
type ListingForView =
{ /// The listing itself
listing : Listing
/// The continent for that listing
continent : Continent
}
/// The form submitted to expire a listing
type ListingExpireForm = {
/// Whether the job was filled from here
fromHere : bool
/// The success story written by the user
successStory : string option
}
type ListingExpireForm =
{ /// Whether the job was filled from here
fromHere : bool
/// The success story written by the user
successStory : string option
}
/// The various ways job listings can be searched
[<CLIMutable>]
type ListingSearch = {
/// Retrieve job listings for this continent
continentId : string option
/// Text for a search within a region
region : string option
/// Whether to retrieve job listings for remote work
remoteWork : string
/// Text for a search with the job listing description
text : string option
}
type ListingSearch =
{ /// Retrieve job listings for this continent
continentId : string option
/// Text for a search within a region
region : string option
/// Whether to retrieve job listings for remote work
remoteWork : string
/// Text for a search with the job listing description
text : string option
}
/// A successful logon
type LogOnSuccess = {
/// The JSON Web Token (JWT) to use for API access
jwt : string
/// The ID of the logged-in citizen (as a string)
citizenId : string
/// The name of the logged-in citizen
name : string
}
type LogOnSuccess =
{ /// The JSON Web Token (JWT) to use for API access
jwt : string
/// The ID of the logged-in citizen (as a string)
citizenId : string
/// The name of the logged-in citizen
name : string
}
/// A count
type Count = {
// The count being returned
count : int64
}
type Count =
{ // The count being returned
count : int64
}
/// An instance of a Mastodon server which is configured to work with Jobs, Jobs, Jobs
type MastodonInstance () =
/// The name of the instance
member val Name = "" with get, set
/// The URL for this instance
member val Url = "" with get, set
/// The abbreviation used in the URL to distinguish this instance's return codes
member val Abbr = "" with get, set
/// The client ID (assigned by the Mastodon server)
member val ClientId = "" with get, set
/// The cryptographic secret (provided by the Mastodon server)
member val Secret = "" with get, set
/// The name of the instance
member val Name = "" with get, set
/// The URL for this instance
member val Url = "" with get, set
/// The abbreviation used in the URL to distinguish this instance's return codes
member val Abbr = "" with get, set
/// The client ID (assigned by the Mastodon server)
member val ClientId = "" with get, set
/// The cryptographic secret (provided by the Mastodon server)
member val Secret = "" with get, set
/// The authorization options for Jobs, Jobs, Jobs
type AuthOptions () =
/// The host for the return URL for Mastodoon verification
member val ReturnHost = "" with get, set
/// The secret with which the server signs the JWTs for auth once we've verified with Mastodon
member val ServerSecret = "" with get, set
/// The instances configured for use
member val Instances = Array.empty<MastodonInstance> with get, set
interface IOptions<AuthOptions> with
override this.Value = this
/// The host for the return URL for Mastodon verification
member val ReturnHost = "" with get, set
/// The secret with which the server signs the JWTs for auth once we've verified with Mastodon
member val ServerSecret = "" with get, set
/// The instances configured for use
member val Instances = Array.empty<MastodonInstance> with get, set
interface IOptions<AuthOptions> with
override this.Value = this
/// The Mastodon instance data provided via the Jobs, Jobs, Jobs API
type Instance = {
/// The name of the instance
name : string
/// The URL for this instance
url : string
/// The abbreviation used in the URL to distinguish this instance's return codes
abbr : string
/// The client ID (assigned by the Mastodon server)
clientId : string
}
type Instance =
{ /// The name of the instance
name : string
/// The URL for this instance
url : string
/// The abbreviation used in the URL to distinguish this instance's return codes
abbr : string
/// The client ID (assigned by the Mastodon server)
clientId : string
}
/// The fields required for a skill
type SkillForm = {
/// The ID of this skill
id : string
/// The description of the skill
description : string
/// Notes regarding the skill
notes : string option
}
type SkillForm =
{ /// The ID of this skill
id : string
/// The description of the skill
description : string
/// Notes regarding the skill
notes : string option
}
/// The data required to update a profile
[<CLIMutable; NoComparison; NoEquality>]
type ProfileForm = {
/// Whether the citizen to whom this profile belongs is actively seeking employment
isSeekingEmployment : bool
/// Whether this profile should appear in the public search
isPublic : bool
/// The user's real name
realName : string
/// The ID of the continent on which the citizen is located
continentId : string
/// The area within that continent where the citizen is located
region : string
/// If the citizen is available for remote work
remoteWork : bool
/// If the citizen is seeking full-time employment
fullTime : bool
/// The user's professional biography
biography : string
/// The user's past experience
experience : string option
/// The skills for the user
skills : SkillForm list
}
type ProfileForm =
{ /// Whether the citizen to whom this profile belongs is actively seeking employment
isSeekingEmployment : bool
/// Whether this profile should appear in the public search
isPublic : bool
/// The user's real name
realName : string
/// The ID of the continent on which the citizen is located
continentId : string
/// The area within that continent where the citizen is located
region : string
/// If the citizen is available for remote work
remoteWork : bool
/// If the citizen is seeking full-time employment
fullTime : bool
/// The user's professional biography
biography : string
/// The user's past experience
experience : string option
/// The skills for the user
skills : SkillForm list
}
/// Support functions for the ProfileForm type
module ProfileForm =
/// Create an instance of this form from the given profile
let fromProfile (profile : Types.Profile) =
{ isSeekingEmployment = profile.seekingEmployment
isPublic = profile.isPublic
realName = ""
continentId = string profile.continentId
region = profile.region
remoteWork = profile.remoteWork
fullTime = profile.fullTime
biography = match profile.biography with Text bio -> bio
experience = profile.experience |> Option.map (fun x -> match x with Text exp -> exp)
skills = profile.skills
|> List.map (fun s ->
{ id = string s.id
description = s.description
notes = s.notes
})
}
{ isSeekingEmployment = profile.seekingEmployment
isPublic = profile.isPublic
realName = ""
continentId = string profile.continentId
region = profile.region
remoteWork = profile.remoteWork
fullTime = profile.fullTime
biography = match profile.biography with Text bio -> bio
experience = profile.experience |> Option.map (fun x -> match x with Text exp -> exp)
skills = profile.skills
|> List.map (fun s ->
{ id = string s.id
description = s.description
notes = s.notes
})
}
/// The various ways profiles can be searched
[<CLIMutable>]
type ProfileSearch = {
/// Retrieve citizens from this continent
continentId : string option
/// Text for a search within a citizen's skills
skill : string option
/// Text for a search with a citizen's professional biography and experience fields
bioExperience : string option
/// Whether to retrieve citizens who do or do not want remote work
remoteWork : string
}
type ProfileSearch =
{ /// Retrieve citizens from this continent
continentId : string option
/// Text for a search within a citizen's skills
skill : string option
/// Text for a search with a citizen's professional biography and experience fields
bioExperience : string option
/// Whether to retrieve citizens who do or do not want remote work
remoteWork : string
}
/// A user matching the profile search
type ProfileSearchResult = {
/// The ID of the citizen
citizenId : CitizenId
/// The citizen's display name
displayName : string
/// Whether this citizen is currently seeking employment
seekingEmployment : bool
/// Whether this citizen is looking for remote work
remoteWork : bool
/// Whether this citizen is looking for full-time work
fullTime : bool
/// When this profile was last updated
lastUpdatedOn : Instant
}
type ProfileSearchResult =
{ /// The ID of the citizen
citizenId : CitizenId
/// The citizen's display name
displayName : string
/// Whether this citizen is currently seeking employment
seekingEmployment : bool
/// Whether this citizen is looking for remote work
remoteWork : bool
/// Whether this citizen is looking for full-time work
fullTime : bool
/// When this profile was last updated
lastUpdatedOn : Instant
}
/// The data required to show a viewable profile
type ProfileForView = {
/// The profile itself
profile : Profile
/// The citizen to whom the profile belongs
citizen : Citizen
/// The continent for the profile
continent : Continent
}
type ProfileForView =
{ /// The profile itself
profile : Profile
/// The citizen to whom the profile belongs
citizen : Citizen
/// The continent for the profile
continent : Continent
}
/// The parameters for a public job search
[<CLIMutable>]
type PublicSearch = {
/// Retrieve citizens from this continent
continentId : string option
/// Retrieve citizens from this region
region : string option
/// Text for a search within a citizen's skills
skill : string option
/// Whether to retrieve citizens who do or do not want remote work
remoteWork : string
}
type PublicSearch =
{ /// Retrieve citizens from this continent
continentId : string option
/// Retrieve citizens from this region
region : string option
/// Text for a search within a citizen's skills
skill : string option
/// Whether to retrieve citizens who do or do not want remote work
remoteWork : string
}
/// Support functions for pblic searches
/// Support functions for public searches
module PublicSearch =
/// Is the search empty?
let isEmptySearch (srch : PublicSearch) =
[ srch.continentId
srch.skill
match srch.remoteWork with "" -> Some srch.remoteWork | _ -> None
]
|> List.exists Option.isSome
/// Is the search empty?
let isEmptySearch (search : PublicSearch) =
[ search.continentId
search.skill
match search.remoteWork with "" -> Some search.remoteWork | _ -> None
]
|> List.exists Option.isSome
/// A public profile search result
type PublicSearchResult = {
/// The name of the continent on which the citizen resides
continent : string
/// The region in which the citizen resides
region : string
/// Whether this citizen is seeking remote work
remoteWork : bool
/// The skills this citizen has identified
skills : string list
}
type PublicSearchResult =
{ /// The name of the continent on which the citizen resides
continent : string
/// The region in which the citizen resides
region : string
/// Whether this citizen is seeking remote work
remoteWork : bool
/// The skills this citizen has identified
skills : string list
}
/// The data required to provide a success story
type StoryForm = {
/// The ID of this story
id : string
/// Whether the employment was obtained from Jobs, Jobs, Jobs
fromHere : bool
/// The success story
story : string
}
type StoryForm =
{ /// The ID of this story
id : string
/// Whether the employment was obtained from Jobs, Jobs, Jobs
fromHere : bool
/// The success story
story : string
}
/// An entry in the list of success stories
type StoryEntry = {
/// The ID of this success story
id : SuccessId
/// The ID of the citizen who recorded this story
citizenId : CitizenId
/// The name of the citizen who recorded this story
citizenName : string
/// When this story was recorded
recordedOn : Instant
/// Whether this story involves an opportunity that arose due to Jobs, Jobs, Jobs
fromHere : bool
/// Whether this report has a further story, or if it is simply a "found work" entry
hasStory : bool
}
type StoryEntry =
{ /// The ID of this success story
id : SuccessId
/// The ID of the citizen who recorded this story
citizenId : CitizenId
/// The name of the citizen who recorded this story
citizenName : string
/// When this story was recorded
recordedOn : Instant
/// Whether this story involves an opportunity that arose due to Jobs, Jobs, Jobs
fromHere : bool
/// Whether this report has a further story, or if it is simply a "found work" entry
hasStory : bool
}

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

@ -11,24 +11,24 @@ type CitizenId = CitizenId of Guid
/// A user of Jobs, Jobs, Jobs
[<CLIMutable; NoComparison; NoEquality>]
type Citizen = {
/// The ID of the user
id : CitizenId
/// The Mastodon instance abbreviation from which this citizen is authorized
instance : string
/// The handle by which the user is known on Mastodon
mastodonUser : string
/// The user's display name from Mastodon (updated every login)
displayName : string option
/// The user's real name
realName : string option
/// The URL for the user's Mastodon profile
profileUrl : string
/// When the user joined Jobs, Jobs, Jobs
joinedOn : Instant
/// When the user last logged in
lastSeenOn : Instant
}
type Citizen =
{ /// The ID of the user
id : CitizenId
/// The Mastodon instance abbreviation from which this citizen is authorized
instance : string
/// The handle by which the user is known on Mastodon
mastodonUser : string
/// The user's display name from Mastodon (updated every login)
displayName : string option
/// The user's real name
realName : string option
/// The URL for the user's Mastodon profile
profileUrl : string
/// When the user joined Jobs, Jobs, Jobs
joinedOn : Instant
/// When the user last logged in
lastSeenOn : Instant
}
/// The ID of a continent
@ -36,12 +36,12 @@ type ContinentId = ContinentId of Guid
/// A continent
[<CLIMutable; NoComparison; NoEquality>]
type Continent = {
/// The ID of the continent
id : ContinentId
/// The name of the continent
name : string
}
type Continent =
{ /// The ID of the continent
id : ContinentId
/// The name of the continent
name : string
}
/// A string of Markdown text
@ -53,91 +53,91 @@ type ListingId = ListingId of Guid
/// A job listing
[<CLIMutable; NoComparison; NoEquality>]
type Listing = {
/// The ID of the job listing
id : ListingId
/// The ID of the citizen who posted the job listing
citizenId : CitizenId
/// When this job listing was created
createdOn : Instant
/// The short title of the job listing
title : string
/// The ID of the continent on which the job is located
continentId : ContinentId
/// The region in which the job is located
region : string
/// Whether this listing is for remote work
remoteWork : bool
/// Whether this listing has expired
isExpired : bool
/// When this listing was last updated
updatedOn : Instant
/// The details of this job
text : MarkdownString
/// When this job needs to be filled
neededBy : LocalDate option
/// Was this job filled as part of its appearance on Jobs, Jobs, Jobs?
wasFilledHere : bool option
}
type Listing =
{ /// The ID of the job listing
id : ListingId
/// The ID of the citizen who posted the job listing
citizenId : CitizenId
/// When this job listing was created
createdOn : Instant
/// The short title of the job listing
title : string
/// The ID of the continent on which the job is located
continentId : ContinentId
/// The region in which the job is located
region : string
/// Whether this listing is for remote work
remoteWork : bool
/// Whether this listing has expired
isExpired : bool
/// When this listing was last updated
updatedOn : Instant
/// The details of this job
text : MarkdownString
/// When this job needs to be filled
neededBy : LocalDate option
/// Was this job filled as part of its appearance on Jobs, Jobs, Jobs?
wasFilledHere : bool option
}
/// The ID of a skill
type SkillId = SkillId of Guid
/// A skill the job seeker possesses
type Skill = {
/// The ID of the skill
id : SkillId
/// A description of the skill
description : string
/// Notes regarding this skill (level, duration, etc.)
notes : string option
}
type Skill =
{ /// The ID of the skill
id : SkillId
/// A description of the skill
description : string
/// Notes regarding this skill (level, duration, etc.)
notes : string option
}
/// A job seeker profile
[<CLIMutable; NoComparison; NoEquality>]
type Profile = {
/// The ID of the citizen to whom this profile belongs
id : CitizenId
/// Whether this citizen is actively seeking employment
seekingEmployment : bool
/// Whether this citizen allows their profile to be a part of the publicly-viewable, anonymous data
isPublic : bool
/// The ID of the continent on which the citizen resides
continentId : ContinentId
/// The region in which the citizen resides
region : string
/// Whether the citizen is looking for remote work
remoteWork : bool
/// Whether the citizen is looking for full-time work
fullTime : bool
/// The citizen's professional biography
biography : MarkdownString
/// When the citizen last updated their profile
lastUpdatedOn : Instant
/// The citizen's experience (topical / chronological)
experience : MarkdownString option
/// Skills this citizen possesses
skills : Skill list
}
type Profile =
{ /// The ID of the citizen to whom this profile belongs
id : CitizenId
/// Whether this citizen is actively seeking employment
seekingEmployment : bool
/// Whether this citizen allows their profile to be a part of the publicly-viewable, anonymous data
isPublic : bool
/// The ID of the continent on which the citizen resides
continentId : ContinentId
/// The region in which the citizen resides
region : string
/// Whether the citizen is looking for remote work
remoteWork : bool
/// Whether the citizen is looking for full-time work
fullTime : bool
/// The citizen's professional biography
biography : MarkdownString
/// When the citizen last updated their profile
lastUpdatedOn : Instant
/// The citizen's experience (topical / chronological)
experience : MarkdownString option
/// Skills this citizen possesses
skills : Skill list
}
/// The ID of a success report
type SuccessId = SuccessId of Guid
/// A record of success finding employment
[<CLIMutable; NoComparison; NoEquality>]
type Success = {
/// The ID of the success report
id : SuccessId
/// The ID of the citizen who wrote this success report
citizenId : CitizenId
/// When this success report was recorded
recordedOn : Instant
/// Whether the success was due, at least in part, to Jobs, Jobs, Jobs
fromHere : bool
/// The source of this success (listing or profile)
source : string
/// The success story
story : MarkdownString option
}
type Success =
{ /// The ID of the success report
id : SuccessId
/// The ID of the citizen who wrote this success report
citizenId : CitizenId
/// When this success report was recorded
recordedOn : Instant
/// Whether the success was due, at least in part, to Jobs, Jobs, Jobs
fromHere : bool
/// The source of this success (listing or profile)
source : string
/// The success story
story : MarkdownString option
}

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

@ -11,17 +11,16 @@ open Giraffe.EndpointRouting
/// Configure the ASP.NET Core pipeline to use Giraffe
let configureApp (app : IApplicationBuilder) =
app
.UseCors(fun p -> p.AllowAnyOrigin().AllowAnyHeader() |> ignore)
.UseStaticFiles()
.UseRouting()
.UseAuthentication()
.UseAuthorization()
.UseGiraffeErrorHandler(Handlers.Error.unexpectedError)
.UseEndpoints(fun e ->
e.MapGiraffeEndpoints Handlers.allEndpoints
e.MapFallbackToFile "index.html" |> ignore)
|> ignore
app.UseCors(fun p -> p.AllowAnyOrigin().AllowAnyHeader() |> ignore)
.UseStaticFiles()
.UseRouting()
.UseAuthentication()
.UseAuthorization()
.UseGiraffeErrorHandler(Handlers.Error.unexpectedError)
.UseEndpoints(fun e ->
e.MapGiraffeEndpoints Handlers.allEndpoints
e.MapFallbackToFile "index.html" |> ignore)
|> ignore
open Newtonsoft.Json
open NodaTime
@ -34,50 +33,49 @@ open JobsJobsJobs.Domain.SharedTypes
/// Configure dependency injection
let configureServices (svc : IServiceCollection) =
svc.AddGiraffe () |> ignore
svc.AddSingleton<IClock> SystemClock.Instance |> ignore
svc.AddLogging () |> ignore
svc.AddCors () |> ignore
let jsonCfg = JsonSerializerSettings ()
Data.Converters.all () |> List.iter jsonCfg.Converters.Add
svc.AddSingleton<Json.ISerializer> (NewtonsoftJson.Serializer jsonCfg) |> ignore
svc.AddGiraffe () |> ignore
svc.AddSingleton<IClock> SystemClock.Instance |> ignore
svc.AddLogging () |> ignore
svc.AddCors () |> ignore
let jsonCfg = JsonSerializerSettings ()
Data.Converters.all () |> List.iter jsonCfg.Converters.Add
svc.AddSingleton<Json.ISerializer> (NewtonsoftJson.Serializer jsonCfg) |> ignore
let svcs = svc.BuildServiceProvider ()
let cfg = svcs.GetRequiredService<IConfiguration> ()
svc.AddAuthentication(fun o ->
o.DefaultAuthenticateScheme <- JwtBearerDefaults.AuthenticationScheme
o.DefaultChallengeScheme <- JwtBearerDefaults.AuthenticationScheme
o.DefaultScheme <- JwtBearerDefaults.AuthenticationScheme)
.AddJwtBearer(fun o ->
o.RequireHttpsMetadata <- false
o.TokenValidationParameters <- TokenValidationParameters (
ValidateIssuer = true,
ValidateAudience = true,
ValidAudience = "https://noagendacareers.com",
ValidIssuer = "https://noagendacareers.com",
IssuerSigningKey = SymmetricSecurityKey (
Encoding.UTF8.GetBytes (cfg.GetSection "Auth").["ServerSecret"])))
let svcs = svc.BuildServiceProvider ()
let cfg = svcs.GetRequiredService<IConfiguration> ()
svc.AddAuthentication(fun o ->
o.DefaultAuthenticateScheme <- JwtBearerDefaults.AuthenticationScheme
o.DefaultChallengeScheme <- JwtBearerDefaults.AuthenticationScheme
o.DefaultScheme <- JwtBearerDefaults.AuthenticationScheme)
.AddJwtBearer(fun o ->
o.RequireHttpsMetadata <- false
o.TokenValidationParameters <- TokenValidationParameters (
ValidateIssuer = true,
ValidateAudience = true,
ValidAudience = "https://noagendacareers.com",
ValidIssuer = "https://noagendacareers.com",
IssuerSigningKey = SymmetricSecurityKey (
Encoding.UTF8.GetBytes (cfg.GetSection "Auth").["ServerSecret"])))
|> ignore
svc.AddAuthorization () |> ignore
svc.Configure<AuthOptions> (cfg.GetSection "Auth") |> ignore
let dbCfg = cfg.GetSection "Rethink"
let log = svcs.GetRequiredService<ILoggerFactory>().CreateLogger (nameof Data.Startup)
let conn = Data.Startup.createConnection dbCfg log
svc.AddSingleton conn |> ignore
Data.Startup.establishEnvironment dbCfg log conn |> Data.awaitIgnore
svc.AddAuthorization () |> ignore
svc.Configure<AuthOptions> (cfg.GetSection "Auth") |> ignore
let dbCfg = cfg.GetSection "Rethink"
let log = svcs.GetRequiredService<ILoggerFactory>().CreateLogger (nameof Data.Startup)
let conn = Data.Startup.createConnection dbCfg log
svc.AddSingleton conn |> ignore
Data.Startup.establishEnvironment dbCfg log conn |> Data.awaitIgnore
[<EntryPoint>]
let main _ =
Host.CreateDefaultBuilder()
.ConfigureWebHostDefaults(
fun webHostBuilder ->
webHostBuilder
.Configure(configureApp)
.ConfigureServices(configureServices)
|> ignore)
.Build()
.Run ()
0
Host.CreateDefaultBuilder()
.ConfigureWebHostDefaults(fun webHostBuilder ->
webHostBuilder
.Configure(configureApp)
.ConfigureServices(configureServices)
|> ignore)
.Build()
.Run ()
0

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

@ -6,18 +6,18 @@ open System.Text.Json.Serialization
/// The variables we need from the account information we get from Mastodon
[<NoComparison; NoEquality; AllowNullLiteral>]
type MastodonAccount () =
/// The user name (what we store as mastodonUser)
[<JsonPropertyName "username">]
member val Username = "" with get, set
/// The account name; will generally be the same as username for local accounts, which is all we can verify
[<JsonPropertyName "acct">]
member val AccountName = "" with get, set
/// The user's display name as it currently shows on Mastodon
[<JsonPropertyName "display_name">]
member val DisplayName = "" with get, set
/// The user's profile URL
[<JsonPropertyName "url">]
member val Url = "" with get, set
/// The user name (what we store as mastodonUser)
[<JsonPropertyName "username">]
member val Username = "" with get, set
/// The account name; will generally be the same as username for local accounts, which is all we can verify
[<JsonPropertyName "acct">]
member val AccountName = "" with get, set
/// The user's display name as it currently shows on Mastodon
[<JsonPropertyName "display_name">]
member val DisplayName = "" with get, set
/// The user's profile URL
[<JsonPropertyName "url">]
member val Url = "" with get, set
open Microsoft.Extensions.Logging
@ -30,50 +30,50 @@ open JobsJobsJobs.Domain.SharedTypes
/// HTTP client to use to communication with Mastodon
let private http =
let h = new HttpClient ()
h.Timeout <- TimeSpan.FromSeconds 30.
h
let h = new HttpClient ()
h.Timeout <- TimeSpan.FromSeconds 30.
h
/// Verify the authorization code with Mastodon and get the user's profile
let verifyWithMastodon (authCode : string) (inst : MastodonInstance) rtnHost (log : ILogger) = task {
// Function to create a URL for the given instance
let apiUrl = sprintf "%s/api/v1/%s" inst.Url
// Function to create a URL for the given instance
let apiUrl = sprintf "%s/api/v1/%s" inst.Url
// Use authorization code to get an access token from Mastodon
use! codeResult =
http.PostAsJsonAsync($"{inst.Url}/oauth/token",
{| client_id = inst.ClientId
client_secret = inst.Secret
redirect_uri = $"{rtnHost}/citizen/{inst.Abbr}/authorized"
grant_type = "authorization_code"
code = authCode
scope = "read"
|})
match codeResult.IsSuccessStatusCode with
| true ->
let! responseBytes = codeResult.Content.ReadAsByteArrayAsync ()
use tokenResponse = JsonSerializer.Deserialize<JsonDocument> (ReadOnlySpan<byte> responseBytes)
match tokenResponse with
| null -> return Error "Could not parse authorization code result"
| _ ->
// Use access token to get profile from NAS
use req = new HttpRequestMessage (HttpMethod.Get, apiUrl "accounts/verify_credentials")
req.Headers.Authorization <- AuthenticationHeaderValue
("Bearer", tokenResponse.RootElement.GetProperty("access_token").GetString ())
use! profileResult = http.SendAsync req
// Use authorization code to get an access token from Mastodon
use! codeResult =
http.PostAsJsonAsync ($"{inst.Url}/oauth/token",
{| client_id = inst.ClientId
client_secret = inst.Secret
redirect_uri = $"{rtnHost}/citizen/{inst.Abbr}/authorized"
grant_type = "authorization_code"
code = authCode
scope = "read"
|})
match codeResult.IsSuccessStatusCode with
| true ->
let! responseBytes = codeResult.Content.ReadAsByteArrayAsync ()
use tokenResponse = JsonSerializer.Deserialize<JsonDocument> (ReadOnlySpan<byte> responseBytes)
match tokenResponse with
| null -> return Error "Could not parse authorization code result"
| _ ->
// Use access token to get profile from NAS
use req = new HttpRequestMessage (HttpMethod.Get, apiUrl "accounts/verify_credentials")
req.Headers.Authorization <- AuthenticationHeaderValue
("Bearer", tokenResponse.RootElement.GetProperty("access_token").GetString ())
use! profileResult = http.SendAsync req
match profileResult.IsSuccessStatusCode with
| true ->
let! profileBytes = profileResult.Content.ReadAsByteArrayAsync ()
match JsonSerializer.Deserialize<MastodonAccount>(ReadOnlySpan<byte> profileBytes) with
| null -> return Error "Could not parse profile result"
| profile -> return Ok profile
| false -> return Error $"Could not get profile ({profileResult.StatusCode:D}: {profileResult.ReasonPhrase})"
| false ->
let! err = codeResult.Content.ReadAsStringAsync ()
log.LogError $"Could not get token result from Mastodon:\n {err}"
return Error $"Could not get token ({codeResult.StatusCode:D}: {codeResult.ReasonPhrase})"
match profileResult.IsSuccessStatusCode with
| true ->
let! profileBytes = profileResult.Content.ReadAsByteArrayAsync ()
match JsonSerializer.Deserialize<MastodonAccount>(ReadOnlySpan<byte> profileBytes) with
| null -> return Error "Could not parse profile result"
| profile -> return Ok profile
| false -> return Error $"Could not get profile ({profileResult.StatusCode:D}: {profileResult.ReasonPhrase})"
| false ->
let! err = codeResult.Content.ReadAsStringAsync ()
log.LogError $"Could not get token result from Mastodon:\n {err}"
return Error $"Could not get token ({codeResult.StatusCode:D}: {codeResult.ReasonPhrase})"
}
@ -87,20 +87,21 @@ open System.Text
/// Create a JSON Web Token for this citizen to use for further requests to this API
let createJwt (citizen : Citizen) (cfg : AuthOptions) =
let tokenHandler = JwtSecurityTokenHandler ()
let token =
tokenHandler.CreateToken (
SecurityTokenDescriptor (
Subject = ClaimsIdentity [|
Claim (ClaimTypes.NameIdentifier, CitizenId.toString citizen.id)
Claim (ClaimTypes.Name, Citizen.name citizen)
|],
Expires = DateTime.UtcNow.AddHours 2.,
Issuer = "https://noagendacareers.com",
Audience = "https://noagendacareers.com",
SigningCredentials = SigningCredentials (
SymmetricSecurityKey (Encoding.UTF8.GetBytes cfg.ServerSecret), SecurityAlgorithms.HmacSha256Signature)
let tokenHandler = JwtSecurityTokenHandler ()
let token =
tokenHandler.CreateToken (
SecurityTokenDescriptor (
Subject = ClaimsIdentity [|
Claim (ClaimTypes.NameIdentifier, CitizenId.toString citizen.id)
Claim (ClaimTypes.Name, Citizen.name citizen)
|],
Expires = DateTime.UtcNow.AddHours 2.,
Issuer = "https://noagendacareers.com",
Audience = "https://noagendacareers.com",
SigningCredentials = SigningCredentials (
SymmetricSecurityKey (
Encoding.UTF8.GetBytes cfg.ServerSecret), SecurityAlgorithms.HmacSha256Signature)
)
)
)
tokenHandler.WriteToken token
tokenHandler.WriteToken token

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

@ -17,169 +17,169 @@ let awaitIgnore x = x |> Async.AwaitTask |> Async.RunSynchronously |> ignore
/// JSON converters used with RethinkDB persistence
module Converters =
open JobsJobsJobs.Domain
open Microsoft.FSharpLu.Json
open Newtonsoft.Json
open System
open JobsJobsJobs.Domain
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 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) =
let (Text text) = value
writer.WriteValue text
override __.ReadJson(reader: JsonReader, _ : Type, _ : MarkdownString, _ : bool, _ : JsonSerializer) =
(string >> Text) reader.Value
/// JSON converter for Markdown strings
type MarkdownStringJsonConverter() =
inherit JsonConverter<MarkdownString>()
override _.WriteJson(writer : JsonWriter, value : MarkdownString, _ : JsonSerializer) =
let (Text text) = value
writer.WriteValue text
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 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 () = [
CitizenIdJsonConverter () :> JsonConverter
upcast ContinentIdJsonConverter ()
upcast MarkdownStringJsonConverter ()
upcast ListingIdJsonConverter ()
upcast SkillIdJsonConverter ()
upcast SuccessIdJsonConverter ()
upcast CompactUnionJsonConverter ()
]
/// 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 job listing table
let Listing = "listing"
/// The citizen employment profile table
let Profile = "profile"
/// The success story table
let Success = "success"
/// All tables
let all () = [ Citizen; Continent; Listing; Profile; Success ]
/// The user (citizen of Gitmo Nation) table
let Citizen = "citizen"
/// The continent table
let Continent = "continent"
/// The job listing table
let Listing = "listing"
/// The citizen employment profile table
let Profile = "profile"
/// The success story table
let Success = "success"
/// All tables
let all () = [ Citizen; Continent; Listing; Profile; Success ]
/// Functions run at startup
[<RequireQualifiedAccess>]
module Startup =
open Microsoft.Extensions.Configuration
open Microsoft.Extensions.Logging
open NodaTime
open NodaTime.Serialization.JsonNet
open Microsoft.Extensions.Configuration
open Microsoft.Extensions.Logging
open NodaTime
open NodaTime.Serialization.JsonNet
/// Create a RethinkDB connection
let createConnection (cfg : IConfigurationSection) (log : ILogger) =
/// 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
// Read the configuration and create a connection
let bldr =
seq<Connection.Builder -> Connection.Builder> {
yield fun b -> match cfg.["Hostname"] with null -> b | host -> b.Hostname host
yield fun b -> match cfg.["Port"] with null -> b | port -> (int >> b.Port) port
yield fun b -> match cfg.["AuthKey"] with null -> b | key -> b.AuthKey key
yield fun b -> match cfg.["Db"] with null -> b | db -> b.Db db
yield fun b -> match cfg.["Timeout"] with null -> b | time -> (int >> b.Timeout) time
}
|> Seq.fold (fun b step -> step b) (r.Connection ())
match log.IsEnabled LogLevel.Debug with
| true -> log.LogDebug $"RethinkDB: Connecting to {bldr.Hostname}:{bldr.Port}, database {bldr.Db}"
| false -> ()
bldr.Connect () :> IConnection
// Add all required JSON converters
Converter.Serializer.ConfigureForNodaTime DateTimeZoneProviders.Tzdb |> ignore
Converters.all ()
|> List.iter Converter.Serializer.Converters.Add
// Read the configuration and create a connection
let bldr =
seq<Connection.Builder -> Connection.Builder> {
yield fun b -> match cfg["Hostname"] with null -> b | host -> b.Hostname host
yield fun b -> match cfg["Port"] with null -> b | port -> (int >> b.Port) port
yield fun b -> match cfg["AuthKey"] with null -> b | key -> b.AuthKey key
yield fun b -> match cfg["Db"] with null -> b | db -> b.Db db
yield fun b -> match cfg["Timeout"] with null -> b | time -> (int >> b.Timeout) time
}
|> Seq.fold (fun b step -> step b) (r.Connection ())
match log.IsEnabled LogLevel.Debug with
| true -> log.LogDebug $"RethinkDB: Connecting to {bldr.Hostname}:{bldr.Port}, database {bldr.Db}"
| false -> ()
bldr.Connect () :> IConnection
/// Ensure the data, tables, and indexes that are required exist
let establishEnvironment (cfg : IConfigurationSection) (log : ILogger) conn = task {
// Ensure the database exists
match cfg.["Db"] |> Option.ofObj with
| Some database ->
let! dbs = r.DbList().RunResultAsync<string list> conn
match dbs |> List.contains database with
| true -> ()
| false ->
log.LogInformation $"Creating database {database}..."
let! _ = r.DbCreate(database).RunWriteAsync conn
()
| None -> ()
// Ensure the tables exist
let! tables = r.TableList().RunResultAsync<string list> conn
Table.all ()
|> List.iter (
fun tbl ->
match tables |> List.contains tbl with
/// Ensure the data, tables, and indexes that are required exist
let establishEnvironment (cfg : IConfigurationSection) (log : ILogger) conn = task {
// Ensure the database exists
match cfg["Db"] |> Option.ofObj with
| Some database ->
let! dbs = r.DbList().RunResultAsync<string list> conn
match dbs |> List.contains database with
| true -> ()
| false ->
log.LogInformation $"Creating {tbl} table..."
r.TableCreate(tbl).RunWriteAsync conn |> awaitIgnore)
// Ensure the indexes exist
let ensureIndexes table indexes = task {
let! tblIdxs = r.Table(table).IndexList().RunResultAsync<string list> conn
indexes
|> List.iter (
fun idx ->
match tblIdxs |> List.contains idx with
| true -> ()
| false ->
log.LogInformation $"Creating \"{idx}\" index on {table}"
r.Table(table).IndexCreate(idx).RunWriteAsync conn |> awaitIgnore)
}
do! ensureIndexes Table.Listing [ "citizenId"; "continentId"; "isExpired" ]
do! ensureIndexes Table.Profile [ "continentId" ]
do! ensureIndexes Table.Success [ "citizenId" ]
// The instance/user is a compound index
let! userIdx = r.Table(Table.Citizen).IndexList().RunResultAsync<string list> conn
match userIdx |> List.contains "instanceUser" with
| true -> ()
| false ->
let! _ =
r.Table(Table.Citizen)
.IndexCreate("instanceUser",
ReqlFunction1 (fun row -> upcast r.Array (row.G "instance", row.G "mastodonUser")))
.RunWriteAsync conn
()
log.LogInformation $"Creating database {database}..."
let! _ = r.DbCreate(database).RunWriteAsync conn
()
| None -> ()
// Ensure the tables exist
let! tables = r.TableList().RunResultAsync<string list> conn
Table.all ()
|> List.iter (
fun tbl ->
match tables |> List.contains tbl with
| true -> ()
| false ->
log.LogInformation $"Creating {tbl} table..."
r.TableCreate(tbl).RunWriteAsync conn |> awaitIgnore)
// Ensure the indexes exist
let ensureIndexes table indexes = task {
let! tblIdxs = r.Table(table).IndexList().RunResultAsync<string list> conn
indexes
|> List.iter (
fun idx ->
match tblIdxs |> List.contains idx with
| true -> ()
| false ->
log.LogInformation $"Creating \"{idx}\" index on {table}"
r.Table(table).IndexCreate(idx).RunWriteAsync conn |> awaitIgnore)
}
do! ensureIndexes Table.Listing [ "citizenId"; "continentId"; "isExpired" ]
do! ensureIndexes Table.Profile [ "continentId" ]
do! ensureIndexes Table.Success [ "citizenId" ]
// The instance/user is a compound index
let! userIdx = r.Table(Table.Citizen).IndexList().RunResultAsync<string list> conn
match userIdx |> List.contains "instanceUser" with
| true -> ()
| false ->
let! _ =
r.Table(Table.Citizen)
.IndexCreate("instanceUser",
ReqlFunction1 (fun row -> upcast r.Array (row.G "instance", row.G "mastodonUser")))
.RunWriteAsync conn
()
}
@ -189,36 +189,36 @@ let toOption x = match x |> box |> isNull with true -> None | false -> Some x
[<AutoOpen>]
module private Reconnect =
open System.Threading.Tasks
open System.Threading.Tasks
/// Execute a query with a retry policy that will reconnect to RethinkDB if it has gone away
let withReconn (conn : IConnection) (f : IConnection -> Task<'T>) =
Policy
.Handle<ReqlDriverError>()
.RetryAsync(System.Action<exn, int> (fun ex _ ->
printf "Encountered RethinkDB exception: %s" ex.Message
match ex.Message.Contains "socket" with
| true ->
printf "Reconnecting to RethinkDB"
(conn :?> Connection).Reconnect false
| false -> ()))
.ExecuteAsync(fun () -> f conn)
/// Execute a query with a retry policy that will reconnect to RethinkDB if it has gone away
let withReconn (conn : IConnection) (f : IConnection -> Task<'T>) =
Policy
.Handle<ReqlDriverError>()
.RetryAsync(System.Action<exn, int> (fun ex _ ->
printf "Encountered RethinkDB exception: %s" ex.Message
match ex.Message.Contains "socket" with
| true ->
printf "Reconnecting to RethinkDB"
(conn :?> Connection).Reconnect false
| false -> ()))
.ExecuteAsync(fun () -> f conn)
/// Execute a query that returns one or none item, using the reconnect logic
let withReconnOption (conn : IConnection) (f : IConnection -> Task<'T>) =
fun c -> task {
let! it = f c
return toOption it
}
|> withReconn conn
/// Execute a query that returns one or none item, using the reconnect logic
let withReconnOption (conn : IConnection) (f : IConnection -> Task<'T>) =
fun c -> task {
let! it = f c
return toOption it
}
|> withReconn conn
/// Execute a query that does not return a result, using the above reconnect logic
let withReconnIgnore (conn : IConnection) (f : IConnection -> Task<'T>) =
fun c -> task {
let! _ = f c
()
}
|> withReconn conn
/// Execute a query that does not return a result, using the above reconnect logic
let withReconnIgnore (conn : IConnection) (f : IConnection -> Task<'T>) =
fun c -> task {
let! _ = f c
()
}
|> withReconn conn
/// Sanitize user input, and create a "contains" pattern for use with RethinkDB queries
let regexContains = System.Text.RegularExpressions.Regex.Escape >> sprintf "(?i)%s"
@ -230,338 +230,322 @@ open JobsJobsJobs.Domain.SharedTypes
[<RequireQualifiedAccess>]
module Profile =
let count conn =
r.Table(Table.Profile)
.Count()
.RunResultAsync<int64>
|> withReconn conn
let count conn =
r.Table(Table.Profile)
.Count()
.RunResultAsync<int64>
|> withReconn conn
/// Find a profile by citizen ID
let findById (citizenId : CitizenId) conn =
r.Table(Table.Profile)
.Get(citizenId)
.RunResultAsync<Profile>
|> withReconnOption conn
/// Find a profile by citizen ID
let findById (citizenId : CitizenId) conn =
r.Table(Table.Profile)
.Get(citizenId)
.RunResultAsync<Profile>
|> withReconnOption conn
/// Insert or update a profile
let save (profile : Profile) conn =
r.Table(Table.Profile)
.Get(profile.id)
.Replace(profile)
.RunWriteAsync
|> withReconnIgnore conn
/// Insert or update a profile
let save (profile : Profile) conn =
r.Table(Table.Profile)
.Get(profile.id)
.Replace(profile)
.RunWriteAsync
|> withReconnIgnore conn
/// Delete a citizen's profile
let delete (citizenId : CitizenId) conn =
r.Table(Table.Profile)
.Get(citizenId)
.Delete()
.RunWriteAsync
|> withReconnIgnore conn
/// Delete a citizen's profile
let delete (citizenId : CitizenId) conn =
r.Table(Table.Profile)
.Get(citizenId)
.Delete()
.RunWriteAsync
|> withReconnIgnore conn
/// Search profiles (logged-on users)
let search (srch : ProfileSearch) conn =
fun c ->
(seq {
match srch.continentId with
| Some conId ->
yield (fun (q : ReqlExpr) ->
q.Filter (r.HashMap (nameof srch.continentId, ContinentId.ofString conId)) :> ReqlExpr)
| None -> ()
match srch.remoteWork with
| "" -> ()
| _ -> yield (fun q -> q.Filter (r.HashMap (nameof srch.remoteWork, srch.remoteWork = "yes")) :> ReqlExpr)
match srch.skill with
| Some skl ->
yield (fun q -> q.Filter (ReqlFunction1(fun it ->
upcast it.G("skills").Contains (ReqlFunction1(fun s ->
upcast s.G("description").Match (regexContains skl))))) :> ReqlExpr)
| None -> ()
match srch.bioExperience with
| Some text ->
let txt = regexContains text
yield (fun q -> q.Filter (ReqlFunction1(fun it ->
upcast it.G("biography").Match(txt).Or (it.G("experience").Match txt))) :> ReqlExpr)
| None -> ()
}
/// Search profiles (logged-on users)
let search (search : ProfileSearch) conn =
(seq<ReqlExpr -> ReqlExpr> {
match search.continentId with
| Some cId -> yield (fun q -> q.Filter (r.HashMap (nameof search.continentId, ContinentId.ofString cId)))
| None -> ()
match search.remoteWork with
| "" -> ()
| _ -> yield (fun q -> q.Filter (r.HashMap (nameof search.remoteWork, search.remoteWork = "yes")))
match search.skill with
| Some skl ->
yield (fun q -> q.Filter (ReqlFunction1(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 (fun q -> q.Filter (ReqlFunction1(fun it ->
it.G("biography").Match(txt).Or (it.G("experience").Match txt))))
| None -> ()
}
|> Seq.toList
|> List.fold
(fun q f -> f q)
(r.Table(Table.Profile)
.EqJoin("id", r.Table Table.Citizen)
.Without(r.HashMap ("right", "id"))
.Zip () :> ReqlExpr))
.Merge(ReqlFunction1 (fun it ->
upcast r
.HashMap("displayName",
r.Branch (it.G("realName" ).Default_("").Ne "", it.G "realName",
it.G("displayName").Default_("").Ne "", it.G "displayName",
it.G "mastodonUser"))
.With ("citizenId", it.G "id")))
.Pluck("citizenId", "displayName", "seekingEmployment", "remoteWork", "fullTime", "lastUpdatedOn")
.OrderBy(ReqlFunction1 (fun it -> upcast it.G("displayName").Downcase ()))
.RunResultAsync<ProfileSearchResult list> c
|> withReconn conn
.EqJoin("id", r.Table Table.Citizen)
.Without(r.HashMap ("right", "id"))
.Zip () :> ReqlExpr))
.Merge(ReqlFunction1 (fun it ->
upcast r
.HashMap("displayName",
r.Branch (it.G("realName" ).Default_("").Ne "", it.G "realName",
it.G("displayName").Default_("").Ne "", it.G "displayName",
it.G "mastodonUser"))
.With ("citizenId", it.G "id")))
.Pluck("citizenId", "displayName", "seekingEmployment", "remoteWork", "fullTime", "lastUpdatedOn")
.OrderBy(ReqlFunction1 (fun it -> upcast it.G("displayName").Downcase ()))
.RunResultAsync<ProfileSearchResult list>
|> withReconn conn
// Search profiles (public)
let publicSearch (srch : PublicSearch) conn =
fun c ->
(seq {
match srch.continentId with
| Some conId ->
yield (fun (q : ReqlExpr) ->
q.Filter (r.HashMap (nameof srch.continentId, ContinentId.ofString conId)) :> ReqlExpr)
| None -> ()
match srch.region with
| Some reg ->
yield (fun q ->
q.Filter (ReqlFunction1 (fun it -> upcast it.G("region").Match (regexContains reg))) :> ReqlExpr)
| None -> ()
match srch.remoteWork with
| "" -> ()
| _ -> yield (fun q -> q.Filter (r.HashMap (nameof srch.remoteWork, srch.remoteWork = "yes")) :> ReqlExpr)
match srch.skill with
| Some skl ->
yield (fun q -> q.Filter (ReqlFunction1 (fun it ->
upcast it.G("skills").Contains (ReqlFunction1(fun s ->
upcast s.G("description").Match (regexContains skl))))) :> ReqlExpr)
| None -> ()
}
// Search profiles (public)
let publicSearch (srch : PublicSearch) conn =
(seq<ReqlExpr -> ReqlExpr> {
match srch.continentId with
| Some cId -> yield (fun q -> q.Filter (r.HashMap (nameof srch.continentId, ContinentId.ofString cId)))
| None -> ()
match srch.region with
| Some reg ->
yield (fun q -> q.Filter (ReqlFunction1 (fun it -> upcast it.G("region").Match (regexContains reg))))
| None -> ()
match srch.remoteWork with
| "" -> ()
| _ -> yield (fun q -> q.Filter (r.HashMap (nameof srch.remoteWork, srch.remoteWork = "yes")))
match srch.skill with
| Some skl ->
yield (fun q -> q.Filter (ReqlFunction1 (fun it ->
it.G("skills").Contains (ReqlFunction1(fun s -> s.G("description").Match (regexContains skl))))))
| None -> ()
}
|> Seq.toList
|> List.fold
(fun q f -> f q)
(r.Table(Table.Profile)
.EqJoin("continentId", r.Table Table.Continent)
.Without(r.HashMap ("right", "id"))
.Zip()
.Filter(r.HashMap ("isPublic", true)) :> ReqlExpr))
.Merge(ReqlFunction1 (fun it ->
upcast r
.HashMap("skills",
it.G("skills").Map (ReqlFunction1 (fun skill ->
upcast r.Branch(skill.G("notes").Default_("").Eq "", skill.G "description",
skill.G("description").Add(" (").Add(skill.G("notes")).Add ")"))))
.With("continent", it.G "name")))
.Pluck("continent", "region", "skills", "remoteWork")
.RunResultAsync<PublicSearchResult list> c
|> withReconn conn
.EqJoin("continentId", r.Table Table.Continent)
.Without(r.HashMap ("right", "id"))
.Zip()
.Filter(r.HashMap ("isPublic", true))))
.Merge(ReqlFunction1 (fun it ->
upcast r
.HashMap("skills",
it.G("skills").Map (ReqlFunction1 (fun skill ->
upcast r.Branch(skill.G("notes").Default_("").Eq "", skill.G "description",
skill.G("description").Add(" (").Add(skill.G("notes")).Add ")"))))
.With("continent", it.G "name")))
.Pluck("continent", "region", "skills", "remoteWork")
.RunResultAsync<PublicSearchResult list>
|> withReconn conn
/// Citizen data access functions
[<RequireQualifiedAccess>]
module Citizen =
/// Find a citizen by their ID
let findById (citizenId : CitizenId) conn =
r.Table(Table.Citizen)
.Get(citizenId)
.RunResultAsync<Citizen>
|> withReconnOption conn
/// Find a citizen by their Mastodon username
let findByMastodonUser (instance : string) (mastodonUser : string) conn =
fun c -> task {
let! u =
/// Find a citizen by their ID
let findById (citizenId : CitizenId) conn =
r.Table(Table.Citizen)
.GetAll(r.Array (instance, mastodonUser)).OptArg("index", "instanceUser").Limit(1)
.RunResultAsync<Citizen list> c
return u |> List.tryHead
}
|> withReconn conn
/// Add a citizen
let add (citizen : Citizen) conn =
r.Table(Table.Citizen)
.Insert(citizen)
.RunWriteAsync
|> withReconnIgnore conn
/// Update the display name and last seen on date for a citizen
let logOnUpdate (citizen : Citizen) conn =
r.Table(Table.Citizen)
.Get(citizen.id)
.Update(r.HashMap( nameof citizen.displayName, citizen.displayName)
.With (nameof citizen.lastSeenOn, citizen.lastSeenOn))
.RunWriteAsync
|> withReconnIgnore conn
/// Delete a citizen
let delete citizenId conn =
fun c -> task {
do! Profile.delete citizenId c
let! _ =
r.Table(Table.Success)
.GetAll(citizenId).OptArg("index", "citizenId")
.Delete()
.RunWriteAsync c
let! _ =
r.Table(Table.Listing)
.GetAll(citizenId).OptArg("index", "citizenId")
.Delete()
.RunWriteAsync c
let! _ =
r.Table(Table.Citizen)
.Get(citizenId)
.Delete()
.RunWriteAsync c
()
}
|> withReconnIgnore conn
.RunResultAsync<Citizen>
|> withReconnOption conn
/// Find a citizen by their Mastodon username
let findByMastodonUser (instance : string) (mastodonUser : string) conn =
fun c -> task {
let! u =
r.Table(Table.Citizen)
.GetAll(r.Array (instance, mastodonUser)).OptArg("index", "instanceUser").Limit(1)
.RunResultAsync<Citizen list> c
return u |> List.tryHead
}
|> withReconn conn
/// Update a citizen's real name
let realNameUpdate (citizenId : CitizenId) (realName : string option) conn =
r.Table(Table.Citizen)
.Get(citizenId)
.Update(r.HashMap (nameof realName, realName))
.RunWriteAsync
|> withReconnIgnore conn
/// Add a citizen
let add (citizen : Citizen) conn =
r.Table(Table.Citizen)
.Insert(citizen)
.RunWriteAsync
|> withReconnIgnore conn
/// Update the display name and last seen on date for a citizen
let logOnUpdate (citizen : Citizen) conn =
r.Table(Table.Citizen)
.Get(citizen.id)
.Update(r.HashMap( nameof citizen.displayName, citizen.displayName)
.With (nameof citizen.lastSeenOn, citizen.lastSeenOn))
.RunWriteAsync
|> withReconnIgnore conn
/// Delete a citizen
let delete citizenId conn =
fun c -> task {
do! Profile.delete citizenId c
let! _ =
r.Table(Table.Success)
.GetAll(citizenId).OptArg("index", "citizenId")
.Delete()
.RunWriteAsync c
let! _ =
r.Table(Table.Listing)
.GetAll(citizenId).OptArg("index", "citizenId")
.Delete()
.RunWriteAsync c
let! _ =
r.Table(Table.Citizen)
.Get(citizenId)
.Delete()
.RunWriteAsync c
()
}
|> withReconnIgnore conn
/// Update a citizen's real name
let realNameUpdate (citizenId : CitizenId) (realName : string option) conn =
r.Table(Table.Citizen)
.Get(citizenId)
.Update(r.HashMap (nameof realName, realName))
.RunWriteAsync
|> withReconnIgnore conn
/// Continent data access functions
[<RequireQualifiedAccess>]
module Continent =
/// Get all continents
let all conn =
r.Table(Table.Continent)
.RunResultAsync<Continent list>
|> withReconn conn
/// Get all continents
let all conn =
r.Table(Table.Continent)
.RunResultAsync<Continent list>
|> withReconn conn
/// Get a continent by its ID
let findById (contId : ContinentId) conn =
r.Table(Table.Continent)
.Get(contId)
.RunResultAsync<Continent>
|> withReconnOption conn
/// Get a continent by its ID
let findById (contId : ContinentId) conn =
r.Table(Table.Continent)
.Get(contId)
.RunResultAsync<Continent>
|> withReconnOption conn
/// Job listing data access functions
[<RequireQualifiedAccess>]
module Listing =
open NodaTime
open NodaTime
/// Find all job listings posted by the given citizen
let findByCitizen (citizenId : CitizenId) conn =
r.Table(Table.Listing)
.GetAll(citizenId).OptArg("index", nameof citizenId)
.EqJoin("continentId", r.Table Table.Continent)
.Map(ReqlFunction1 (fun it -> upcast r.HashMap("listing", it.G "left").With ("continent", it.G "right")))
.RunResultAsync<ListingForView list>
|> withReconn conn
/// Find a listing by its ID
let findById (listingId : ListingId) conn =
r.Table(Table.Listing)
.Get(listingId)
.RunResultAsync<Listing>
|> withReconnOption conn
/// Find a listing by its ID for viewing (includes continent information)
let findByIdForView (listingId : ListingId) conn =
fun c -> task {
let! listing =
r.Table(Table.Listing)
.Filter(r.HashMap ("id", listingId))
/// Find all job listings posted by the given citizen
let findByCitizen (citizenId : CitizenId) conn =
r.Table(Table.Listing)
.GetAll(citizenId).OptArg("index", nameof citizenId)
.EqJoin("continentId", r.Table Table.Continent)
.Map(ReqlFunction1 (fun it -> upcast r.HashMap("listing", it.G "left").With ("continent", it.G "right")))
.RunResultAsync<ListingForView list> c
return List.tryHead listing
}
|> withReconn conn
.Map(ReqlFunction1 (fun it -> r.HashMap("listing", it.G "left").With ("continent", it.G "right")))
.RunResultAsync<ListingForView list>
|> withReconn conn
/// Add a listing
let add (listing : Listing) conn =
r.Table(Table.Listing)
.Insert(listing)
.RunWriteAsync
|> withReconnIgnore conn
/// Find a listing by its ID
let findById (listingId : ListingId) conn =
r.Table(Table.Listing)
.Get(listingId)
.RunResultAsync<Listing>
|> withReconnOption conn
/// Update a listing
let update (listing : Listing) conn =
r.Table(Table.Listing)
.Get(listing.id)
.Replace(listing)
.RunWriteAsync
|> withReconnIgnore conn
/// Find a listing by its ID for viewing (includes continent information)
let findByIdForView (listingId : ListingId) conn =
fun c -> task {
let! listing =
r.Table(Table.Listing)
.Filter(r.HashMap ("id", listingId))
.EqJoin("continentId", r.Table Table.Continent)
.Map(ReqlFunction1 (fun it -> r.HashMap("listing", it.G "left").With ("continent", it.G "right")))
.RunResultAsync<ListingForView list> c
return List.tryHead listing
}
|> withReconn conn
/// Add a listing
let add (listing : Listing) conn =
r.Table(Table.Listing)
.Insert(listing)
.RunWriteAsync
|> withReconnIgnore conn
/// Update a listing
let update (listing : Listing) conn =
r.Table(Table.Listing)
.Get(listing.id)
.Replace(listing)
.RunWriteAsync
|> withReconnIgnore conn
/// Expire a listing
let expire (listingId : ListingId) (fromHere : bool) (now : Instant) conn =
r.Table(Table.Listing)
.Get(listingId)
.Update(r.HashMap("isExpired", true).With("wasFilledHere", fromHere).With ("updatedOn", now))
.RunWriteAsync
|> withReconnIgnore conn
/// Expire a listing
let expire (listingId : ListingId) (fromHere : bool) (now : Instant) conn =
r.Table(Table.Listing)
.Get(listingId)
.Update(r.HashMap("isExpired", true).With("wasFilledHere", fromHere).With ("updatedOn", now))
.RunWriteAsync
|> withReconnIgnore conn
/// Search job listings
let search (srch : ListingSearch) conn =
fun c ->
(seq {
match srch.continentId with
| Some conId ->
yield (fun (q : ReqlExpr) ->
q.Filter (r.HashMap (nameof srch.continentId, ContinentId.ofString conId)) :> ReqlExpr)
| None -> ()
match srch.region with
| Some rgn ->
yield (fun q ->
q.Filter (ReqlFunction1 (fun it ->
upcast it.G(nameof srch.region).Match (regexContains rgn))) :> ReqlExpr)
| None -> ()
match srch.remoteWork with
| "" -> ()
| _ ->
yield (fun q -> q.Filter (r.HashMap (nameof srch.remoteWork, srch.remoteWork = "yes")) :> ReqlExpr)
match srch.text with
| Some text ->
yield (fun q ->
q.Filter (ReqlFunction1 (fun it ->
upcast it.G(nameof srch.text).Match (regexContains text))) :> ReqlExpr)
| None -> ()
}
/// Search job listings
let search (search : ListingSearch) conn =
(seq<ReqlExpr -> ReqlExpr> {
match search.continentId with
| Some cId -> yield (fun q -> q.Filter (r.HashMap (nameof search.continentId, ContinentId.ofString cId)))
| None -> ()
match search.region with
| Some rgn ->
yield (fun q ->
q.Filter (ReqlFunction1 (fun it -> it.G(nameof search.region).Match (regexContains rgn))))
| None -> ()
match search.remoteWork with
| "" -> ()
| _ -> yield (fun q -> q.Filter (r.HashMap (nameof search.remoteWork, search.remoteWork = "yes")))
match search.text with
| Some text ->
yield (fun q ->
q.Filter (ReqlFunction1 (fun it -> it.G(nameof search.text).Match (regexContains text))))
| None -> ()
}
|> Seq.toList
|> List.fold
(fun q f -> f q)
(r.Table(Table.Listing)
.GetAll(false).OptArg ("index", "isExpired") :> ReqlExpr))
.EqJoin("continentId", r.Table Table.Continent)
.Map(ReqlFunction1 (fun it -> upcast r.HashMap("listing", it.G "left").With ("continent", it.G "right")))
.RunResultAsync<ListingForView list> c
|> withReconn conn
.GetAll(false).OptArg ("index", "isExpired")))
.EqJoin("continentId", r.Table Table.Continent)
.Map(ReqlFunction1 (fun it -> r.HashMap("listing", it.G "left").With ("continent", it.G "right")))
.RunResultAsync<ListingForView list>
|> withReconn conn
/// Success story data access functions
[<RequireQualifiedAccess>]
module Success =
/// Find a success report by its ID
let findById (successId : SuccessId) conn =
r.Table(Table.Success)
.Get(successId)
.RunResultAsync<Success>
|> withReconnOption conn
/// Find a success report by its ID
let findById (successId : SuccessId) conn =
r.Table(Table.Success)
.Get(successId)
.RunResultAsync<Success>
|> withReconnOption conn
/// Insert or update a success story
let save (success : Success) conn =
r.Table(Table.Success)
.Get(success.id)
.Replace(success)
.RunWriteAsync
|> withReconnIgnore conn
/// Insert or update a success story
let save (success : Success) conn =
r.Table(Table.Success)
.Get(success.id)
.Replace(success)
.RunWriteAsync
|> withReconnIgnore conn
// Retrieve all success stories
let all conn =
r.Table(Table.Success)
.EqJoin("citizenId", r.Table Table.Citizen)
.Without(r.HashMap ("right", "id"))
.Zip()
.Merge(ReqlFunction1 (fun it ->
upcast r
.HashMap("citizenName",
r.Branch(it.G("realName" ).Default_("").Ne "", it.G "realName",
it.G("displayName").Default_("").Ne "", it.G "displayName",
it.G "mastodonUser"))
.With ("hasStory", it.G("story").Default_("").Gt "")))
.Pluck("id", "citizenId", "citizenName", "recordedOn", "fromHere", "hasStory")
.OrderBy(r.Desc "recordedOn")
.RunResultAsync<StoryEntry list>
|> withReconn conn
// Retrieve all success stories
let all conn =
r.Table(Table.Success)
.EqJoin("citizenId", r.Table Table.Citizen)
.Without(r.HashMap ("right", "id"))
.Zip()
.Merge(ReqlFunction1 (fun it ->
r.HashMap("citizenName",
r.Branch(it.G("realName" ).Default_("").Ne "", it.G "realName",
it.G("displayName").Default_("").Ne "", it.G "displayName",
it.G "mastodonUser"))
.With ("hasStory", it.G("story").Default_("").Gt "")))
.Pluck("id", "citizenId", "citizenName", "recordedOn", "fromHere", "hasStory")
.OrderBy(r.Desc "recordedOn")
.RunResultAsync<StoryEntry list>
|> withReconn conn

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

@ -11,94 +11,93 @@ open Microsoft.Extensions.Logging
/// Handler to return the files required for the Vue client app
module Vue =
/// Handler that returns index.html (the Vue client app)
let app = htmlFile "wwwroot/index.html"
/// Handler that returns index.html (the Vue client app)
let app = htmlFile "wwwroot/index.html"
/// Handlers for error conditions
module Error =
open System.Threading.Tasks
open System.Threading.Tasks
/// URL prefixes for the Vue app
let vueUrls = [
"/how-it-works"; "/privacy-policy"; "/terms-of-service"; "/citizen"; "/help-wanted"; "/listing"; "/profile"
"/so-long"; "/success-story"
]
/// URL prefixes for the Vue app
let vueUrls =
[ "/how-it-works"; "/privacy-policy"; "/terms-of-service"; "/citizen"; "/help-wanted"; "/listing"; "/profile"
"/so-long"; "/success-story"
]
/// Handler that will return a status code 404 and the text "Not Found"
let notFound : HttpHandler =
fun next ctx -> task {
let fac = ctx.GetService<ILoggerFactory> ()
let log = fac.CreateLogger "Handler"
let path = string ctx.Request.Path
match [ "GET"; "HEAD" ] |> List.contains ctx.Request.Method with
| true when path = "/" || vueUrls |> List.exists path.StartsWith ->
log.LogInformation "Returning Vue app"
return! Vue.app next ctx
| _ ->
log.LogInformation "Returning 404"
return! RequestErrors.NOT_FOUND $"The URL {path} was not recognized as a valid URL" next ctx
}
/// Handler that will return a status code 404 and the text "Not Found"
let notFound : HttpHandler = fun next ctx -> task {
let fac = ctx.GetService<ILoggerFactory> ()
let log = fac.CreateLogger "Handler"
let path = string ctx.Request.Path
match [ "GET"; "HEAD" ] |> List.contains ctx.Request.Method with
| true when path = "/" || vueUrls |> List.exists path.StartsWith ->
log.LogInformation "Returning Vue app"
return! Vue.app next ctx
| _ ->
log.LogInformation "Returning 404"
return! RequestErrors.NOT_FOUND $"The URL {path} was not recognized as a valid URL" next ctx
}
/// Handler that returns a 403 NOT AUTHORIZED response
let notAuthorized : HttpHandler =
setStatusCode 403 >=> fun _ _ -> Task.FromResult<HttpContext option> None
/// Handler that returns a 403 NOT AUTHORIZED response
let notAuthorized : HttpHandler =
setStatusCode 403 >=> fun _ _ -> Task.FromResult<HttpContext option> None
/// Handler to log 500s and return a message we can display in the application
let unexpectedError (ex: exn) (log : ILogger) =
log.LogError(ex, "An unexpected error occurred")
clearResponse >=> ServerErrors.INTERNAL_ERROR ex.Message
/// Handler to log 500s and return a message we can display in the application
let unexpectedError (ex: exn) (log : ILogger) =
log.LogError(ex, "An unexpected error occurred")
clearResponse >=> ServerErrors.INTERNAL_ERROR ex.Message
/// Helper functions
[<AutoOpen>]
module Helpers =
open NodaTime
open Microsoft.Extensions.Configuration
open Microsoft.Extensions.Options
open RethinkDb.Driver.Net
open System.Security.Claims
open NodaTime
open Microsoft.Extensions.Configuration
open Microsoft.Extensions.Options
open RethinkDb.Driver.Net
open System.Security.Claims
/// Get the NodaTime clock from the request context
let clock (ctx : HttpContext) = ctx.GetService<IClock> ()
/// Get the NodaTime clock from the request context
let clock (ctx : HttpContext) = ctx.GetService<IClock> ()
/// Get the application configuration from the request context
let config (ctx : HttpContext) = ctx.GetService<IConfiguration> ()
/// Get the application configuration from the request context
let config (ctx : HttpContext) = ctx.GetService<IConfiguration> ()
/// Get the authorization configuration from the request context
let authConfig (ctx : HttpContext) = (ctx.GetService<IOptions<AuthOptions>> ()).Value
/// Get the authorization configuration from the request context
let authConfig (ctx : HttpContext) = (ctx.GetService<IOptions<AuthOptions>> ()).Value
/// Get the logger factory from the request context
let logger (ctx : HttpContext) = ctx.GetService<ILoggerFactory> ()
/// 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 the RethinkDB connection from the request context
let conn (ctx : HttpContext) = ctx.GetService<IConnection> ()
/// `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
/// `None` if a `string` is null, empty, or whitespace; otherwise, `Some` and the trimmed string
let noneIfEmpty = Option.ofObj >> noneIfBlank
/// Try to get the current user
let tryUser (ctx : HttpContext) =
ctx.User.FindFirst ClaimTypes.NameIdentifier
|> Option.ofObj
|> Option.map (fun x -> x.Value)
/// `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
/// `None` if a `string` is null, empty, or whitespace; otherwise, `Some` and the trimmed string
let noneIfEmpty = Option.ofObj >> noneIfBlank
/// Try to get the current user
let tryUser (ctx : HttpContext) =
ctx.User.FindFirst ClaimTypes.NameIdentifier
|> Option.ofObj
|> Option.map (fun x -> x.Value)
/// Require a user to be logged in
let authorize : HttpHandler =
fun next ctx -> match tryUser ctx with Some _ -> next ctx | None -> Error.notAuthorized next ctx
/// Require a user to be logged in
let authorize : HttpHandler =
fun next ctx -> match tryUser ctx with Some _ -> next ctx | None -> Error.notAuthorized next ctx
/// Get the ID of the currently logged in citizen
// NOTE: if no one is logged in, this will raise an exception
let currentCitizenId = tryUser >> Option.get >> CitizenId.ofString
/// Get the ID of the currently logged in citizen
// NOTE: if no one is logged in, this will raise an exception
let currentCitizenId = tryUser >> Option.get >> CitizenId.ofString
/// Return an empty OK response
let ok : HttpHandler = Successful.OK ""
/// Return an empty OK response
let ok : HttpHandler = Successful.OK ""
@ -106,456 +105,406 @@ module Helpers =
[<RequireQualifiedAccess>]
module Citizen =
// GET: /api/citizen/log-on/[code]
let logOn (abbr, authCode) : HttpHandler =
fun next ctx -> task {
// 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
}
// GET: /api/citizen/[id]
let get citizenId : HttpHandler =
authorize
>=> fun next ctx -> task {
match! Data.Citizen.findById (CitizenId citizenId) (conn ctx) with
| Some citizen -> return! json citizen next ctx
| None -> return! Error.notFound next ctx
}
// GET: /api/citizen/log-on/[code]
let logOn (abbr, authCode) : HttpHandler = fun next ctx -> task {
// 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
}
// GET: /api/citizen/[id]
let get citizenId : HttpHandler = authorize >=> fun next ctx -> task {
match! Data.Citizen.findById (CitizenId citizenId) (conn ctx) with
| Some citizen -> return! json citizen next ctx
| None -> return! Error.notFound next ctx
}
// DELETE: /api/citizen
let delete : HttpHandler =
authorize
>=> fun next ctx -> task {
do! Data.Citizen.delete (currentCitizenId ctx) (conn ctx)
return! ok next ctx
}
// DELETE: /api/citizen
let delete : HttpHandler = authorize >=> fun next ctx -> task {
do! Data.Citizen.delete (currentCitizenId ctx) (conn ctx)
return! ok next ctx
}
/// Handlers for /api/continent routes
[<RequireQualifiedAccess>]
module Continent =
// GET: /api/continent/all
let all : HttpHandler =
fun next ctx -> task {
let! continents = Data.Continent.all (conn ctx)
return! json continents next ctx
}
// GET: /api/continent/all
let all : HttpHandler = fun next ctx -> task {
let! continents = Data.Continent.all (conn ctx)
return! json continents next ctx
}
/// Handlers for /api/instances routes
[<RequireQualifiedAccess>]
module Instances =
/// Convert a Masotodon instance to the one we use in the API
let private toInstance (inst : MastodonInstance) =
{ name = inst.Name
url = inst.Url
abbr = inst.Abbr
clientId = inst.ClientId
}
/// Convert a Mastodon instance to the one we use in the API
let private toInstance (inst : MastodonInstance) =
{ name = inst.Name
url = inst.Url
abbr = inst.Abbr
clientId = inst.ClientId
}
// GET: /api/instances
let all : HttpHandler =
fun next ctx -> task {
return! json ((authConfig ctx).Instances |> Array.map toInstance) next ctx
}
// GET: /api/instances
let all : HttpHandler = fun next ctx -> task {
return! json ((authConfig ctx).Instances |> Array.map toInstance) next ctx
}
/// Handlers for /api/listing[s] routes
[<RequireQualifiedAccess>]
module Listing =
open NodaTime
open System
open NodaTime
open System
/// Parse the string we receive from JSON into a NodaTime local date
let private parseDate = DateTime.Parse >> LocalDate.FromDateTime
/// Parse the string we receive from JSON into a NodaTime local date
let private parseDate = DateTime.Parse >> LocalDate.FromDateTime
// GET: /api/listings/mine
let mine : HttpHandler =
authorize
>=> fun next ctx -> task {
let! listings = Data.Listing.findByCitizen (currentCitizenId ctx) (conn ctx)
return! json listings next ctx
}
// GET: /api/listings/mine
let mine : HttpHandler = authorize >=> fun next ctx -> task {
let! listings = Data.Listing.findByCitizen (currentCitizenId ctx) (conn ctx)
return! json listings next ctx
}
// GET: /api/listing/[id]
let get listingId : HttpHandler =
authorize
>=> fun next ctx -> task {
match! Data.Listing.findById (ListingId listingId) (conn ctx) with
| Some listing -> return! json listing next ctx
| None -> return! Error.notFound next ctx
// GET: /api/listing/[id]
let get listingId : HttpHandler = authorize >=> fun next ctx -> task {
match! Data.Listing.findById (ListingId listingId) (conn ctx) with
| Some listing -> return! json listing next ctx
| None -> return! Error.notFound next ctx
}
// GET: /api/listing/view/[id]
let view listingId : HttpHandler = authorize >=> fun next ctx -> task {
match! Data.Listing.findByIdForView (ListingId listingId) (conn ctx) with
| Some listing -> return! json listing next ctx
| None -> return! Error.notFound next ctx
}
// POST: /listings
let add : HttpHandler = authorize >=> fun next ctx -> task {
let! form = ctx.BindJsonAsync<ListingForm> ()
let now = (clock ctx).GetCurrentInstant ()
do! Data.Listing.add
{ id = ListingId.create ()
citizenId = currentCitizenId ctx
createdOn = now
title = form.title
continentId = ContinentId.ofString form.continentId
region = form.region
remoteWork = form.remoteWork
isExpired = false
updatedOn = now
text = Text form.text
neededBy = (form.neededBy |> Option.map parseDate)
wasFilledHere = None
} (conn ctx)
return! ok next ctx
}
// PUT: /api/listing/[id]
let update listingId : HttpHandler = authorize >=> fun next ctx -> task {
let dbConn = conn ctx
match! Data.Listing.findById (ListingId listingId) dbConn with
| Some listing when listing.citizenId <> (currentCitizenId ctx) -> return! Error.notAuthorized next ctx
| Some listing ->
let! form = ctx.BindJsonAsync<ListingForm> ()
do! Data.Listing.update
{ listing with
title = form.title
continentId = ContinentId.ofString form.continentId
region = form.region
remoteWork = form.remoteWork
text = Text form.text
neededBy = form.neededBy |> Option.map parseDate
updatedOn = (clock ctx).GetCurrentInstant ()
} dbConn
return! ok next ctx
| None -> return! Error.notFound next ctx
}
// GET: /api/listing/view/[id]
let view listingId : HttpHandler =
authorize
>=> fun next ctx -> task {
match! Data.Listing.findByIdForView (ListingId listingId) (conn ctx) with
| Some listing -> return! json listing next ctx
| None -> return! Error.notFound next ctx
}
// PATCH: /api/listing/[id]
let expire listingId : HttpHandler = authorize >=> fun next ctx -> task {
let dbConn = conn ctx
let now = clock(ctx).GetCurrentInstant ()
match! Data.Listing.findById (ListingId listingId) dbConn with
| Some listing when listing.citizenId <> (currentCitizenId ctx) -> return! Error.notAuthorized next ctx
| Some listing ->
let! form = ctx.BindJsonAsync<ListingExpireForm> ()
do! Data.Listing.expire listing.id form.fromHere now dbConn
match form.successStory with
| Some storyText ->
do! Data.Success.save
{ id = SuccessId.create()
citizenId = currentCitizenId ctx
recordedOn = now
fromHere = form.fromHere
source = "listing"
story = (Text >> Some) storyText
} dbConn
| None -> ()
return! ok next ctx
| None -> return! Error.notFound next ctx
}
// POST: /listings
let add : HttpHandler =
authorize
>=> fun next ctx -> task {
let! form = ctx.BindJsonAsync<ListingForm> ()
let now = (clock ctx).GetCurrentInstant ()
do! Data.Listing.add
{ id = ListingId.create ()
citizenId = currentCitizenId ctx
createdOn = now
title = form.title
continentId = ContinentId.ofString form.continentId
region = form.region
remoteWork = form.remoteWork
isExpired = false
updatedOn = now
text = Text form.text
neededBy = (form.neededBy |> Option.map parseDate)
wasFilledHere = None
} (conn ctx)
return! ok next ctx
}
// PUT: /api/listing/[id]
let update listingId : HttpHandler =
authorize
>=> fun next ctx -> task {
let dbConn = conn ctx
match! Data.Listing.findById (ListingId listingId) dbConn with
| Some listing when listing.citizenId <> (currentCitizenId ctx) -> return! Error.notAuthorized next ctx
| Some listing ->
let! form = ctx.BindJsonAsync<ListingForm> ()
do! Data.Listing.update
{ listing with
title = form.title
continentId = ContinentId.ofString form.continentId
region = form.region
remoteWork = form.remoteWork
text = Text form.text
neededBy = form.neededBy |> Option.map parseDate
updatedOn = (clock ctx).GetCurrentInstant ()
} dbConn
return! ok next ctx
| None -> return! Error.notFound next ctx
}
// PATCH: /api/listing/[id]
let expire listingId : HttpHandler =
authorize
>=> fun next ctx -> FSharp.Control.Tasks.Affine.task {
let dbConn = conn ctx
let now = clock(ctx).GetCurrentInstant ()
match! Data.Listing.findById (ListingId listingId) dbConn with
| Some listing when listing.citizenId <> (currentCitizenId ctx) -> return! Error.notAuthorized next ctx
| Some listing ->
let! form = ctx.BindJsonAsync<ListingExpireForm> ()
do! Data.Listing.expire listing.id form.fromHere now dbConn
match form.successStory with
| Some storyText ->
do! Data.Success.save
{ id = SuccessId.create()
citizenId = currentCitizenId ctx
recordedOn = now
fromHere = form.fromHere
source = "listing"
story = (Text >> Some) storyText
} dbConn
| None -> ()
return! ok next ctx
| None -> return! Error.notFound next ctx
}
// GET: /api/listing/search
let search : HttpHandler =
authorize
>=> fun next ctx -> task {
let search = ctx.BindQueryString<ListingSearch> ()
let! results = Data.Listing.search search (conn ctx)
return! json results next ctx
}
// GET: /api/listing/search
let search : HttpHandler = authorize >=> fun next ctx -> task {
let search = ctx.BindQueryString<ListingSearch> ()
let! results = Data.Listing.search search (conn ctx)
return! json results next ctx
}
/// Handlers for /api/profile routes
[<RequireQualifiedAccess>]
module Profile =
// GET: /api/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
| Some profile -> return! json profile next ctx
| None -> return! Successful.NO_CONTENT next ctx
}
// GET: /api/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
| 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
| Some profile -> return! json profile next ctx
| None -> return! Error.notFound 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
| 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
| 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
| 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)
return! json { count = theCount } next ctx
}
// GET: /api/profile/count
let count : HttpHandler = authorize >=> fun next ctx -> task {
let! theCount = Data.Profile.count (conn ctx)
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
| Some p -> return p
| None -> return { Profile.empty with id = citizenId }
// 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
| Some p -> return p
| None -> return { Profile.empty with id = citizenId }
}
do! Data.Profile.save
{ profile with
seekingEmployment = form.isSeekingEmployment
isPublic = form.isPublic
continentId = ContinentId.ofString form.continentId
region = form.region
remoteWork = form.remoteWork
fullTime = form.fullTime
biography = Text form.biography
lastUpdatedOn = (clock ctx).GetCurrentInstant ()
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
return! ok next ctx
}
do! Data.Profile.save
{ profile with
seekingEmployment = form.isSeekingEmployment
isPublic = form.isPublic
continentId = ContinentId.ofString form.continentId
region = form.region
remoteWork = form.remoteWork
fullTime = form.fullTime
biography = Text form.biography
lastUpdatedOn = (clock ctx).GetCurrentInstant ()
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
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
| Some profile ->
do! Data.Profile.save { profile with seekingEmployment = false } dbConn
return! ok next ctx
| None -> return! Error.notFound 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
| Some profile ->
do! Data.Profile.save { profile with seekingEmployment = false } dbConn
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)
return! ok next ctx
}
// DELETE: /api/profile
let delete : HttpHandler = authorize >=> fun next ctx -> task {
do! Data.Profile.delete (currentCitizenId ctx) (conn 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)
return! json results 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)
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)
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)
return! json results next ctx
}
/// Handlers for /api/success routes
[<RequireQualifiedAccess>]
module Success =
open System
open System
// GET: /api/success/[id]
let get successId : HttpHandler =
authorize
>=> fun next ctx -> task {
match! Data.Success.findById (SuccessId successId) (conn ctx) with
| Some story -> return! json story next ctx
| None -> return! Error.notFound next ctx
}
// GET: /api/success/[id]
let get successId : HttpHandler = authorize >=> fun next ctx -> task {
match! Data.Success.findById (SuccessId successId) (conn ctx) 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)
return! json stories next ctx
}
// GET: /api/success/list
let all : HttpHandler = authorize >=> fun next ctx -> task {
let! stories = Data.Success.all (conn ctx)
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
fromHere = form.fromHere
source = "profile"
story = noneIfEmpty form.story |> Option.map Text
}
| successId ->
match! Data.Success.findById (SuccessId.ofString successId) dbConn with
| Some story when story.citizenId = citizenId ->
return Some { story with
fromHere = form.fromHere
story = noneIfEmpty form.story |> Option.map Text
// 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
fromHere = form.fromHere
source = "profile"
story = noneIfEmpty form.story |> Option.map Text
}
| Some _ | None -> return None
| successId ->
match! Data.Success.findById (SuccessId.ofString successId) dbConn with
| Some story when story.citizenId = citizenId ->
return Some { story with
fromHere = form.fromHere
story = noneIfEmpty form.story |> Option.map Text
}
| Some _ | None -> return None
}
match success with
| Some story ->
do! Data.Success.save story dbConn
return! ok next ctx
| None -> return! Error.notFound next ctx
}
match success with
| Some story ->
do! Data.Success.save story dbConn
return! ok next ctx
| None -> return! Error.notFound next ctx
}
open Giraffe.EndpointRouting
/// All available endpoints for the application
let allEndpoints = [
subRoute "/api" [
subRoute "/citizen" [
GET_HEAD [
routef "/log-on/%s/%s" Citizen.logOn
routef "/%O" Citizen.get
subRoute "/api" [
subRoute "/citizen" [
GET_HEAD [
routef "/log-on/%s/%s" Citizen.logOn
routef "/%O" Citizen.get
]
DELETE [ route "" Citizen.delete ]
]
DELETE [ route "" Citizen.delete ]
]
GET_HEAD [ route "/continents" Continent.all ]
GET_HEAD [ route "/instances" Instances.all ]
subRoute "/listing" [
GET_HEAD [
routef "/%O" Listing.get
route "/search" Listing.search
routef "/%O/view" Listing.view
route "s/mine" Listing.mine
GET_HEAD [ route "/continents" Continent.all ]
GET_HEAD [ route "/instances" Instances.all ]
subRoute "/listing" [
GET_HEAD [
routef "/%O" Listing.get
route "/search" Listing.search
routef "/%O/view" Listing.view
route "s/mine" Listing.mine
]
PATCH [ routef "/%O" Listing.expire ]
POST [ route "s" Listing.add ]
PUT [ routef "/%O" Listing.update ]
]
PATCH [
routef "/%O" Listing.expire
subRoute "/profile" [
GET_HEAD [
route "" Profile.current
route "/count" Profile.count
routef "/%O" Profile.get
routef "/%O/view" Profile.view
route "/public-search" Profile.publicSearch
route "/search" Profile.search
]
PATCH [ route "/employment-found" Profile.employmentFound ]
POST [ route "" Profile.save ]
]
POST [
route "s" Listing.add
subRoute "/success" [
GET_HEAD [
routef "/%O" Success.get
route "es" Success.all
]
POST [ route "" Success.save ]
]
PUT [
routef "/%O" Listing.update
]
]
subRoute "/profile" [
GET_HEAD [
route "" Profile.current
route "/count" Profile.count
routef "/%O" Profile.get
routef "/%O/view" Profile.view
route "/public-search" Profile.publicSearch
route "/search" Profile.search
]
PATCH [ route "/employment-found" Profile.employmentFound ]
POST [ route "" Profile.save ]
]
subRoute "/success" [
GET_HEAD [
routef "/%O" Success.get
route "es" Success.all
]
POST [ route "" Success.save ]
]
]
]
]