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

Version 2.2.2 #35

Merged
danieljsummers merged 6 commits from version-2-2-2 into main 2022-07-12 02:11:42 +00:00
Conversation 0 Commits 6 Files Changed 23 +1317 -1388
8 changed files with 1317 additions and 1388 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files
Showing only changes of commit b591bf746c - Show all commits

1
.gitignore vendored
View File

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

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

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

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

@ -8,272 +8,272 @@ open NodaTime
// fsharplint:disable FieldNames // fsharplint:disable FieldNames
/// The data required to add or edit a job listing /// The data required to add or edit a job listing
type ListingForm = { type ListingForm =
/// The ID of the listing { /// The ID of the listing
id : string id : string
/// The listing title /// The listing title
title : string title : string
/// The ID of the continent on which this opportunity exists /// The ID of the continent on which this opportunity exists
continentId : string continentId : string
/// The region in which this opportunity exists /// The region in which this opportunity exists
region : string region : string
/// Whether this is a remote work opportunity /// Whether this is a remote work opportunity
remoteWork : bool remoteWork : bool
/// The text of the job listing /// The text of the job listing
text : string text : string
/// The date by which this job listing is needed /// The date by which this job listing is needed
neededBy : string option neededBy : string option
} }
/// The data needed to display a listing /// The data needed to display a listing
type ListingForView = { type ListingForView =
/// The listing itself { /// The listing itself
listing : Listing listing : Listing
/// The continent for that listing /// The continent for that listing
continent : Continent continent : Continent
} }
/// The form submitted to expire a listing /// The form submitted to expire a listing
type ListingExpireForm = { type ListingExpireForm =
/// Whether the job was filled from here { /// Whether the job was filled from here
fromHere : bool fromHere : bool
/// The success story written by the user /// The success story written by the user
successStory : string option successStory : string option
} }
/// The various ways job listings can be searched /// The various ways job listings can be searched
[<CLIMutable>] [<CLIMutable>]
type ListingSearch = { type ListingSearch =
/// Retrieve job listings for this continent { /// Retrieve job listings for this continent
continentId : string option continentId : string option
/// Text for a search within a region /// Text for a search within a region
region : string option region : string option
/// Whether to retrieve job listings for remote work /// Whether to retrieve job listings for remote work
remoteWork : string remoteWork : string
/// Text for a search with the job listing description /// Text for a search with the job listing description
text : string option text : string option
} }
/// A successful logon /// A successful logon
type LogOnSuccess = { type LogOnSuccess =
/// The JSON Web Token (JWT) to use for API access { /// The JSON Web Token (JWT) to use for API access
jwt : string jwt : string
/// The ID of the logged-in citizen (as a string) /// The ID of the logged-in citizen (as a string)
citizenId : string citizenId : string
/// The name of the logged-in citizen /// The name of the logged-in citizen
name : string name : string
} }
/// A count /// A count
type Count = { type Count =
// The count being returned { // The count being returned
count : int64 count : int64
} }
/// An instance of a Mastodon server which is configured to work with Jobs, Jobs, Jobs /// An instance of a Mastodon server which is configured to work with Jobs, Jobs, Jobs
type MastodonInstance () = type MastodonInstance () =
/// The name of the instance /// The name of the instance
member val Name = "" with get, set member val Name = "" with get, set
/// The URL for this instance /// The URL for this instance
member val Url = "" with get, set member val Url = "" with get, set
/// The abbreviation used in the URL to distinguish this instance's return codes /// The abbreviation used in the URL to distinguish this instance's return codes
member val Abbr = "" with get, set member val Abbr = "" with get, set
/// The client ID (assigned by the Mastodon server) /// The client ID (assigned by the Mastodon server)
member val ClientId = "" with get, set member val ClientId = "" with get, set
/// The cryptographic secret (provided by the Mastodon server) /// The cryptographic secret (provided by the Mastodon server)
member val Secret = "" with get, set member val Secret = "" with get, set
/// The authorization options for Jobs, Jobs, Jobs /// The authorization options for Jobs, Jobs, Jobs
type AuthOptions () = type AuthOptions () =
/// The host for the return URL for Mastodoon verification /// The host for the return URL for Mastodon verification
member val ReturnHost = "" with get, set member val ReturnHost = "" with get, set
/// The secret with which the server signs the JWTs for auth once we've verified with Mastodon /// The secret with which the server signs the JWTs for auth once we've verified with Mastodon
member val ServerSecret = "" with get, set member val ServerSecret = "" with get, set
/// The instances configured for use /// The instances configured for use
member val Instances = Array.empty<MastodonInstance> with get, set member val Instances = Array.empty<MastodonInstance> with get, set
interface IOptions<AuthOptions> with interface IOptions<AuthOptions> with
override this.Value = this override this.Value = this
/// The Mastodon instance data provided via the Jobs, Jobs, Jobs API /// The Mastodon instance data provided via the Jobs, Jobs, Jobs API
type Instance = { type Instance =
/// The name of the instance { /// The name of the instance
name : string name : string
/// The URL for this instance /// The URL for this instance
url : string url : string
/// The abbreviation used in the URL to distinguish this instance's return codes /// The abbreviation used in the URL to distinguish this instance's return codes
abbr : string abbr : string
/// The client ID (assigned by the Mastodon server) /// The client ID (assigned by the Mastodon server)
clientId : string clientId : string
} }
/// The fields required for a skill /// The fields required for a skill
type SkillForm = { type SkillForm =
/// The ID of this skill { /// The ID of this skill
id : string id : string
/// The description of the skill /// The description of the skill
description : string description : string
/// Notes regarding the skill /// Notes regarding the skill
notes : string option notes : string option
} }
/// The data required to update a profile /// The data required to update a profile
[<CLIMutable; NoComparison; NoEquality>] [<CLIMutable; NoComparison; NoEquality>]
type ProfileForm = { type ProfileForm =
/// Whether the citizen to whom this profile belongs is actively seeking employment { /// Whether the citizen to whom this profile belongs is actively seeking employment
isSeekingEmployment : bool isSeekingEmployment : bool
/// Whether this profile should appear in the public search /// Whether this profile should appear in the public search
isPublic : bool isPublic : bool
/// The user's real name /// The user's real name
realName : string realName : string
/// The ID of the continent on which the citizen is located /// The ID of the continent on which the citizen is located
continentId : string continentId : string
/// The area within that continent where the citizen is located /// The area within that continent where the citizen is located
region : string region : string
/// If the citizen is available for remote work /// If the citizen is available for remote work
remoteWork : bool remoteWork : bool
/// If the citizen is seeking full-time employment /// If the citizen is seeking full-time employment
fullTime : bool fullTime : bool
/// The user's professional biography /// The user's professional biography
biography : string biography : string
/// The user's past experience /// The user's past experience
experience : string option experience : string option
/// The skills for the user /// The skills for the user
skills : SkillForm list skills : SkillForm list
} }
/// Support functions for the ProfileForm type /// Support functions for the ProfileForm type
module ProfileForm = module ProfileForm =
/// Create an instance of this form from the given profile /// Create an instance of this form from the given profile
let fromProfile (profile : Types.Profile) = let fromProfile (profile : Types.Profile) =
{ isSeekingEmployment = profile.seekingEmployment { isSeekingEmployment = profile.seekingEmployment
isPublic = profile.isPublic isPublic = profile.isPublic
realName = "" realName = ""
continentId = string profile.continentId continentId = string profile.continentId
region = profile.region region = profile.region
remoteWork = profile.remoteWork remoteWork = profile.remoteWork
fullTime = profile.fullTime fullTime = profile.fullTime
biography = match profile.biography with Text bio -> bio biography = match profile.biography with Text bio -> bio
experience = profile.experience |> Option.map (fun x -> match x with Text exp -> exp) experience = profile.experience |> Option.map (fun x -> match x with Text exp -> exp)
skills = profile.skills skills = profile.skills
|> List.map (fun s -> |> List.map (fun s ->
{ id = string s.id { id = string s.id
description = s.description description = s.description
notes = s.notes notes = s.notes
}) })
} }
/// The various ways profiles can be searched /// The various ways profiles can be searched
[<CLIMutable>] [<CLIMutable>]
type ProfileSearch = { type ProfileSearch =
/// Retrieve citizens from this continent { /// Retrieve citizens from this continent
continentId : string option continentId : string option
/// Text for a search within a citizen's skills /// Text for a search within a citizen's skills
skill : string option skill : string option
/// Text for a search with a citizen's professional biography and experience fields /// Text for a search with a citizen's professional biography and experience fields
bioExperience : string option bioExperience : string option
/// Whether to retrieve citizens who do or do not want remote work /// Whether to retrieve citizens who do or do not want remote work
remoteWork : string remoteWork : string
} }
/// A user matching the profile search /// A user matching the profile search
type ProfileSearchResult = { type ProfileSearchResult =
/// The ID of the citizen { /// The ID of the citizen
citizenId : CitizenId citizenId : CitizenId
/// The citizen's display name /// The citizen's display name
displayName : string displayName : string
/// Whether this citizen is currently seeking employment /// Whether this citizen is currently seeking employment
seekingEmployment : bool seekingEmployment : bool
/// Whether this citizen is looking for remote work /// Whether this citizen is looking for remote work
remoteWork : bool remoteWork : bool
/// Whether this citizen is looking for full-time work /// Whether this citizen is looking for full-time work
fullTime : bool fullTime : bool
/// When this profile was last updated /// When this profile was last updated
lastUpdatedOn : Instant lastUpdatedOn : Instant
} }
/// The data required to show a viewable profile /// The data required to show a viewable profile
type ProfileForView = { type ProfileForView =
/// The profile itself { /// The profile itself
profile : Profile profile : Profile
/// The citizen to whom the profile belongs /// The citizen to whom the profile belongs
citizen : Citizen citizen : Citizen
/// The continent for the profile /// The continent for the profile
continent : Continent continent : Continent
} }
/// The parameters for a public job search /// The parameters for a public job search
[<CLIMutable>] [<CLIMutable>]
type PublicSearch = { type PublicSearch =
/// Retrieve citizens from this continent { /// Retrieve citizens from this continent
continentId : string option continentId : string option
/// Retrieve citizens from this region /// Retrieve citizens from this region
region : string option region : string option
/// Text for a search within a citizen's skills /// Text for a search within a citizen's skills
skill : string option skill : string option
/// Whether to retrieve citizens who do or do not want remote work /// Whether to retrieve citizens who do or do not want remote work
remoteWork : string remoteWork : string
} }
/// Support functions for pblic searches /// Support functions for public searches
module PublicSearch = module PublicSearch =
/// Is the search empty? /// Is the search empty?
let isEmptySearch (srch : PublicSearch) = let isEmptySearch (search : PublicSearch) =
[ srch.continentId [ search.continentId
srch.skill search.skill
match srch.remoteWork with "" -> Some srch.remoteWork | _ -> None match search.remoteWork with "" -> Some search.remoteWork | _ -> None
] ]
|> List.exists Option.isSome |> List.exists Option.isSome
/// A public profile search result /// A public profile search result
type PublicSearchResult = { type PublicSearchResult =
/// The name of the continent on which the citizen resides { /// The name of the continent on which the citizen resides
continent : string continent : string
/// The region in which the citizen resides /// The region in which the citizen resides
region : string region : string
/// Whether this citizen is seeking remote work /// Whether this citizen is seeking remote work
remoteWork : bool remoteWork : bool
/// The skills this citizen has identified /// The skills this citizen has identified
skills : string list skills : string list
} }
/// The data required to provide a success story /// The data required to provide a success story
type StoryForm = { type StoryForm =
/// The ID of this story { /// The ID of this story
id : string id : string
/// Whether the employment was obtained from Jobs, Jobs, Jobs /// Whether the employment was obtained from Jobs, Jobs, Jobs
fromHere : bool fromHere : bool
/// The success story /// The success story
story : string story : string
} }
/// An entry in the list of success stories /// An entry in the list of success stories
type StoryEntry = { type StoryEntry =
/// The ID of this success story { /// The ID of this success story
id : SuccessId id : SuccessId
/// The ID of the citizen who recorded this story /// The ID of the citizen who recorded this story
citizenId : CitizenId citizenId : CitizenId
/// The name of the citizen who recorded this story /// The name of the citizen who recorded this story
citizenName : string citizenName : string
/// When this story was recorded /// When this story was recorded
recordedOn : Instant recordedOn : Instant
/// Whether this story involves an opportunity that arose due to Jobs, Jobs, Jobs /// Whether this story involves an opportunity that arose due to Jobs, Jobs, Jobs
fromHere : bool fromHere : bool
/// Whether this report has a further story, or if it is simply a "found work" entry /// Whether this report has a further story, or if it is simply a "found work" entry
hasStory : bool 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 /// A user of Jobs, Jobs, Jobs
[<CLIMutable; NoComparison; NoEquality>] [<CLIMutable; NoComparison; NoEquality>]
type Citizen = { type Citizen =
/// The ID of the user { /// The ID of the user
id : CitizenId id : CitizenId
/// The Mastodon instance abbreviation from which this citizen is authorized /// The Mastodon instance abbreviation from which this citizen is authorized
instance : string instance : string
/// The handle by which the user is known on Mastodon /// The handle by which the user is known on Mastodon
mastodonUser : string mastodonUser : string
/// The user's display name from Mastodon (updated every login) /// The user's display name from Mastodon (updated every login)
displayName : string option displayName : string option
/// The user's real name /// The user's real name
realName : string option realName : string option
/// The URL for the user's Mastodon profile /// The URL for the user's Mastodon profile
profileUrl : string profileUrl : string
/// When the user joined Jobs, Jobs, Jobs /// When the user joined Jobs, Jobs, Jobs
joinedOn : Instant joinedOn : Instant
/// When the user last logged in /// When the user last logged in
lastSeenOn : Instant lastSeenOn : Instant
} }
/// The ID of a continent /// The ID of a continent
@ -36,12 +36,12 @@ type ContinentId = ContinentId of Guid
/// A continent /// A continent
[<CLIMutable; NoComparison; NoEquality>] [<CLIMutable; NoComparison; NoEquality>]
type Continent = { type Continent =
/// The ID of the continent { /// The ID of the continent
id : ContinentId id : ContinentId
/// The name of the continent /// The name of the continent
name : string name : string
} }
/// A string of Markdown text /// A string of Markdown text
@ -53,91 +53,91 @@ type ListingId = ListingId of Guid
/// A job listing /// A job listing
[<CLIMutable; NoComparison; NoEquality>] [<CLIMutable; NoComparison; NoEquality>]
type Listing = { type Listing =
/// The ID of the job listing { /// The ID of the job listing
id : ListingId id : ListingId
/// The ID of the citizen who posted the job listing /// The ID of the citizen who posted the job listing
citizenId : CitizenId citizenId : CitizenId
/// When this job listing was created /// When this job listing was created
createdOn : Instant createdOn : Instant
/// The short title of the job listing /// The short title of the job listing
title : string title : string
/// The ID of the continent on which the job is located /// The ID of the continent on which the job is located
continentId : ContinentId continentId : ContinentId
/// The region in which the job is located /// The region in which the job is located
region : string region : string
/// Whether this listing is for remote work /// Whether this listing is for remote work
remoteWork : bool remoteWork : bool
/// Whether this listing has expired /// Whether this listing has expired
isExpired : bool isExpired : bool
/// When this listing was last updated /// When this listing was last updated
updatedOn : Instant updatedOn : Instant
/// The details of this job /// The details of this job
text : MarkdownString text : MarkdownString
/// When this job needs to be filled /// When this job needs to be filled
neededBy : LocalDate option neededBy : LocalDate option
/// Was this job filled as part of its appearance on Jobs, Jobs, Jobs? /// Was this job filled as part of its appearance on Jobs, Jobs, Jobs?
wasFilledHere : bool option wasFilledHere : bool option
} }
/// The ID of a skill /// The ID of a skill
type SkillId = SkillId of Guid type SkillId = SkillId of Guid
/// A skill the job seeker possesses /// A skill the job seeker possesses
type Skill = { type Skill =
/// The ID of the skill { /// The ID of the skill
id : SkillId id : SkillId
/// A description of the skill /// A description of the skill
description : string description : string
/// Notes regarding this skill (level, duration, etc.) /// Notes regarding this skill (level, duration, etc.)
notes : string option notes : string option
} }
/// A job seeker profile /// A job seeker profile
[<CLIMutable; NoComparison; NoEquality>] [<CLIMutable; NoComparison; NoEquality>]
type Profile = { type Profile =
/// The ID of the citizen to whom this profile belongs { /// The ID of the citizen to whom this profile belongs
id : CitizenId id : CitizenId
/// Whether this citizen is actively seeking employment /// Whether this citizen is actively seeking employment
seekingEmployment : bool seekingEmployment : bool
/// Whether this citizen allows their profile to be a part of the publicly-viewable, anonymous data /// Whether this citizen allows their profile to be a part of the publicly-viewable, anonymous data
isPublic : bool isPublic : bool
/// The ID of the continent on which the citizen resides /// The ID of the continent on which the citizen resides
continentId : ContinentId continentId : ContinentId
/// The region in which the citizen resides /// The region in which the citizen resides
region : string region : string
/// Whether the citizen is looking for remote work /// Whether the citizen is looking for remote work
remoteWork : bool remoteWork : bool
/// Whether the citizen is looking for full-time work /// Whether the citizen is looking for full-time work
fullTime : bool fullTime : bool
/// The citizen's professional biography /// The citizen's professional biography
biography : MarkdownString biography : MarkdownString
/// When the citizen last updated their profile /// When the citizen last updated their profile
lastUpdatedOn : Instant lastUpdatedOn : Instant
/// The citizen's experience (topical / chronological) /// The citizen's experience (topical / chronological)
experience : MarkdownString option experience : MarkdownString option
/// Skills this citizen possesses /// Skills this citizen possesses
skills : Skill list skills : Skill list
} }
/// The ID of a success report /// The ID of a success report
type SuccessId = SuccessId of Guid type SuccessId = SuccessId of Guid
/// A record of success finding employment /// A record of success finding employment
[<CLIMutable; NoComparison; NoEquality>] [<CLIMutable; NoComparison; NoEquality>]
type Success = { type Success =
/// The ID of the success report { /// The ID of the success report
id : SuccessId id : SuccessId
/// The ID of the citizen who wrote this success report /// The ID of the citizen who wrote this success report
citizenId : CitizenId citizenId : CitizenId
/// When this success report was recorded /// When this success report was recorded
recordedOn : Instant recordedOn : Instant
/// Whether the success was due, at least in part, to Jobs, Jobs, Jobs /// Whether the success was due, at least in part, to Jobs, Jobs, Jobs
fromHere : bool fromHere : bool
/// The source of this success (listing or profile) /// The source of this success (listing or profile)
source : string source : string
/// The success story /// The success story
story : MarkdownString option 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 /// Configure the ASP.NET Core pipeline to use Giraffe
let configureApp (app : IApplicationBuilder) = let configureApp (app : IApplicationBuilder) =
app app.UseCors(fun p -> p.AllowAnyOrigin().AllowAnyHeader() |> ignore)
.UseCors(fun p -> p.AllowAnyOrigin().AllowAnyHeader() |> ignore) .UseStaticFiles()
.UseStaticFiles() .UseRouting()
.UseRouting() .UseAuthentication()
.UseAuthentication() .UseAuthorization()
.UseAuthorization() .UseGiraffeErrorHandler(Handlers.Error.unexpectedError)
.UseGiraffeErrorHandler(Handlers.Error.unexpectedError) .UseEndpoints(fun e ->
.UseEndpoints(fun e -> e.MapGiraffeEndpoints Handlers.allEndpoints
e.MapGiraffeEndpoints Handlers.allEndpoints e.MapFallbackToFile "index.html" |> ignore)
e.MapFallbackToFile "index.html" |> ignore) |> ignore
|> ignore
open Newtonsoft.Json open Newtonsoft.Json
open NodaTime open NodaTime
@ -34,50 +33,49 @@ open JobsJobsJobs.Domain.SharedTypes
/// Configure dependency injection /// Configure dependency injection
let configureServices (svc : IServiceCollection) = let configureServices (svc : IServiceCollection) =
svc.AddGiraffe () |> ignore svc.AddGiraffe () |> ignore
svc.AddSingleton<IClock> SystemClock.Instance |> ignore svc.AddSingleton<IClock> SystemClock.Instance |> ignore
svc.AddLogging () |> ignore svc.AddLogging () |> ignore
svc.AddCors () |> ignore svc.AddCors () |> ignore
let jsonCfg = JsonSerializerSettings () let jsonCfg = JsonSerializerSettings ()
Data.Converters.all () |> List.iter jsonCfg.Converters.Add Data.Converters.all () |> List.iter jsonCfg.Converters.Add
svc.AddSingleton<Json.ISerializer> (NewtonsoftJson.Serializer jsonCfg) |> ignore svc.AddSingleton<Json.ISerializer> (NewtonsoftJson.Serializer jsonCfg) |> ignore
let svcs = svc.BuildServiceProvider () let svcs = svc.BuildServiceProvider ()
let cfg = svcs.GetRequiredService<IConfiguration> () let cfg = svcs.GetRequiredService<IConfiguration> ()
svc.AddAuthentication(fun o -> svc.AddAuthentication(fun o ->
o.DefaultAuthenticateScheme <- JwtBearerDefaults.AuthenticationScheme o.DefaultAuthenticateScheme <- JwtBearerDefaults.AuthenticationScheme
o.DefaultChallengeScheme <- JwtBearerDefaults.AuthenticationScheme o.DefaultChallengeScheme <- JwtBearerDefaults.AuthenticationScheme
o.DefaultScheme <- JwtBearerDefaults.AuthenticationScheme) o.DefaultScheme <- JwtBearerDefaults.AuthenticationScheme)
.AddJwtBearer(fun o -> .AddJwtBearer(fun o ->
o.RequireHttpsMetadata <- false o.RequireHttpsMetadata <- false
o.TokenValidationParameters <- TokenValidationParameters ( o.TokenValidationParameters <- TokenValidationParameters (
ValidateIssuer = true, ValidateIssuer = true,
ValidateAudience = true, ValidateAudience = true,
ValidAudience = "https://noagendacareers.com", ValidAudience = "https://noagendacareers.com",
ValidIssuer = "https://noagendacareers.com", ValidIssuer = "https://noagendacareers.com",
IssuerSigningKey = SymmetricSecurityKey ( IssuerSigningKey = SymmetricSecurityKey (
Encoding.UTF8.GetBytes (cfg.GetSection "Auth").["ServerSecret"]))) Encoding.UTF8.GetBytes (cfg.GetSection "Auth").["ServerSecret"])))
|> ignore |> ignore
svc.AddAuthorization () |> ignore svc.AddAuthorization () |> ignore
svc.Configure<AuthOptions> (cfg.GetSection "Auth") |> ignore svc.Configure<AuthOptions> (cfg.GetSection "Auth") |> ignore
let dbCfg = cfg.GetSection "Rethink" let dbCfg = cfg.GetSection "Rethink"
let log = svcs.GetRequiredService<ILoggerFactory>().CreateLogger (nameof Data.Startup) let log = svcs.GetRequiredService<ILoggerFactory>().CreateLogger (nameof Data.Startup)
let conn = Data.Startup.createConnection dbCfg log let conn = Data.Startup.createConnection dbCfg log
svc.AddSingleton conn |> ignore svc.AddSingleton conn |> ignore
Data.Startup.establishEnvironment dbCfg log conn |> Data.awaitIgnore Data.Startup.establishEnvironment dbCfg log conn |> Data.awaitIgnore
[<EntryPoint>] [<EntryPoint>]
let main _ = let main _ =
Host.CreateDefaultBuilder() Host.CreateDefaultBuilder()
.ConfigureWebHostDefaults( .ConfigureWebHostDefaults(fun webHostBuilder ->
fun webHostBuilder -> webHostBuilder
webHostBuilder .Configure(configureApp)
.Configure(configureApp) .ConfigureServices(configureServices)
.ConfigureServices(configureServices) |> ignore)
|> ignore) .Build()
.Build() .Run ()
.Run () 0
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 /// The variables we need from the account information we get from Mastodon
[<NoComparison; NoEquality; AllowNullLiteral>] [<NoComparison; NoEquality; AllowNullLiteral>]
type MastodonAccount () = type MastodonAccount () =
/// The user name (what we store as mastodonUser) /// The user name (what we store as mastodonUser)
[<JsonPropertyName "username">] [<JsonPropertyName "username">]
member val Username = "" with get, set 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 /// The account name; will generally be the same as username for local accounts, which is all we can verify
[<JsonPropertyName "acct">] [<JsonPropertyName "acct">]
member val AccountName = "" with get, set member val AccountName = "" with get, set
/// The user's display name as it currently shows on Mastodon /// The user's display name as it currently shows on Mastodon
[<JsonPropertyName "display_name">] [<JsonPropertyName "display_name">]
member val DisplayName = "" with get, set member val DisplayName = "" with get, set
/// The user's profile URL /// The user's profile URL
[<JsonPropertyName "url">] [<JsonPropertyName "url">]
member val Url = "" with get, set member val Url = "" with get, set
open Microsoft.Extensions.Logging open Microsoft.Extensions.Logging
@ -30,50 +30,50 @@ open JobsJobsJobs.Domain.SharedTypes
/// HTTP client to use to communication with Mastodon /// HTTP client to use to communication with Mastodon
let private http = let private http =
let h = new HttpClient () let h = new HttpClient ()
h.Timeout <- TimeSpan.FromSeconds 30. h.Timeout <- TimeSpan.FromSeconds 30.
h h
/// Verify the authorization code with Mastodon and get the user's profile /// Verify the authorization code with Mastodon and get the user's profile
let verifyWithMastodon (authCode : string) (inst : MastodonInstance) rtnHost (log : ILogger) = task { let verifyWithMastodon (authCode : string) (inst : MastodonInstance) rtnHost (log : ILogger) = task {
// Function to create a URL for the given instance // Function to create a URL for the given instance
let apiUrl = sprintf "%s/api/v1/%s" inst.Url let apiUrl = sprintf "%s/api/v1/%s" inst.Url
// Use authorization code to get an access token from Mastodon // Use authorization code to get an access token from Mastodon
use! codeResult = use! codeResult =
http.PostAsJsonAsync($"{inst.Url}/oauth/token", http.PostAsJsonAsync ($"{inst.Url}/oauth/token",
{| client_id = inst.ClientId {| client_id = inst.ClientId
client_secret = inst.Secret client_secret = inst.Secret
redirect_uri = $"{rtnHost}/citizen/{inst.Abbr}/authorized" redirect_uri = $"{rtnHost}/citizen/{inst.Abbr}/authorized"
grant_type = "authorization_code" grant_type = "authorization_code"
code = authCode code = authCode
scope = "read" scope = "read"
|}) |})
match codeResult.IsSuccessStatusCode with match codeResult.IsSuccessStatusCode with
| true -> | true ->
let! responseBytes = codeResult.Content.ReadAsByteArrayAsync () let! responseBytes = codeResult.Content.ReadAsByteArrayAsync ()
use tokenResponse = JsonSerializer.Deserialize<JsonDocument> (ReadOnlySpan<byte> responseBytes) use tokenResponse = JsonSerializer.Deserialize<JsonDocument> (ReadOnlySpan<byte> responseBytes)
match tokenResponse with match tokenResponse with
| null -> return Error "Could not parse authorization code result" | null -> return Error "Could not parse authorization code result"
| _ -> | _ ->
// Use access token to get profile from NAS // Use access token to get profile from NAS
use req = new HttpRequestMessage (HttpMethod.Get, apiUrl "accounts/verify_credentials") use req = new HttpRequestMessage (HttpMethod.Get, apiUrl "accounts/verify_credentials")
req.Headers.Authorization <- AuthenticationHeaderValue req.Headers.Authorization <- AuthenticationHeaderValue
("Bearer", tokenResponse.RootElement.GetProperty("access_token").GetString ()) ("Bearer", tokenResponse.RootElement.GetProperty("access_token").GetString ())
use! profileResult = http.SendAsync req use! profileResult = http.SendAsync req
match profileResult.IsSuccessStatusCode with match profileResult.IsSuccessStatusCode with
| true -> | true ->
let! profileBytes = profileResult.Content.ReadAsByteArrayAsync () let! profileBytes = profileResult.Content.ReadAsByteArrayAsync ()
match JsonSerializer.Deserialize<MastodonAccount>(ReadOnlySpan<byte> profileBytes) with match JsonSerializer.Deserialize<MastodonAccount>(ReadOnlySpan<byte> profileBytes) with
| null -> return Error "Could not parse profile result" | null -> return Error "Could not parse profile result"
| profile -> return Ok profile | profile -> return Ok profile
| false -> return Error $"Could not get profile ({profileResult.StatusCode:D}: {profileResult.ReasonPhrase})" | false -> return Error $"Could not get profile ({profileResult.StatusCode:D}: {profileResult.ReasonPhrase})"
| false -> | false ->
let! err = codeResult.Content.ReadAsStringAsync () let! err = codeResult.Content.ReadAsStringAsync ()
log.LogError $"Could not get token result from Mastodon:\n {err}" log.LogError $"Could not get token result from Mastodon:\n {err}"
return Error $"Could not get token ({codeResult.StatusCode:D}: {codeResult.ReasonPhrase})" 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 /// Create a JSON Web Token for this citizen to use for further requests to this API
let createJwt (citizen : Citizen) (cfg : AuthOptions) = let createJwt (citizen : Citizen) (cfg : AuthOptions) =
let tokenHandler = JwtSecurityTokenHandler () let tokenHandler = JwtSecurityTokenHandler ()
let token = let token =
tokenHandler.CreateToken ( tokenHandler.CreateToken (
SecurityTokenDescriptor ( SecurityTokenDescriptor (
Subject = ClaimsIdentity [| Subject = ClaimsIdentity [|
Claim (ClaimTypes.NameIdentifier, CitizenId.toString citizen.id) Claim (ClaimTypes.NameIdentifier, CitizenId.toString citizen.id)
Claim (ClaimTypes.Name, Citizen.name citizen) Claim (ClaimTypes.Name, Citizen.name citizen)
|], |],
Expires = DateTime.UtcNow.AddHours 2., Expires = DateTime.UtcNow.AddHours 2.,
Issuer = "https://noagendacareers.com", Issuer = "https://noagendacareers.com",
Audience = "https://noagendacareers.com", Audience = "https://noagendacareers.com",
SigningCredentials = SigningCredentials ( SigningCredentials = SigningCredentials (
SymmetricSecurityKey (Encoding.UTF8.GetBytes cfg.ServerSecret), SecurityAlgorithms.HmacSha256Signature) 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 /// JSON converters used with RethinkDB persistence
module Converters = module Converters =
open JobsJobsJobs.Domain open JobsJobsJobs.Domain
open Microsoft.FSharpLu.Json open Microsoft.FSharpLu.Json
open Newtonsoft.Json open Newtonsoft.Json
open System open System
/// JSON converter for citizen IDs /// JSON converter for citizen IDs
type CitizenIdJsonConverter() = type CitizenIdJsonConverter() =
inherit JsonConverter<CitizenId>() inherit JsonConverter<CitizenId>()
override __.WriteJson(writer : JsonWriter, value : CitizenId, _ : JsonSerializer) = override _.WriteJson(writer : JsonWriter, value : CitizenId, _ : JsonSerializer) =
writer.WriteValue (CitizenId.toString value) writer.WriteValue (CitizenId.toString value)
override __.ReadJson(reader: JsonReader, _ : Type, _ : CitizenId, _ : bool, _ : JsonSerializer) = override _.ReadJson(reader: JsonReader, _ : Type, _ : CitizenId, _ : bool, _ : JsonSerializer) =
(string >> CitizenId.ofString) reader.Value (string >> CitizenId.ofString) reader.Value
/// JSON converter for continent IDs /// JSON converter for continent IDs
type ContinentIdJsonConverter() = type ContinentIdJsonConverter() =
inherit JsonConverter<ContinentId>() inherit JsonConverter<ContinentId>()
override __.WriteJson(writer : JsonWriter, value : ContinentId, _ : JsonSerializer) = override _.WriteJson(writer : JsonWriter, value : ContinentId, _ : JsonSerializer) =
writer.WriteValue (ContinentId.toString value) writer.WriteValue (ContinentId.toString value)
override __.ReadJson(reader: JsonReader, _ : Type, _ : ContinentId, _ : bool, _ : JsonSerializer) = override _.ReadJson(reader: JsonReader, _ : Type, _ : ContinentId, _ : bool, _ : JsonSerializer) =
(string >> ContinentId.ofString) reader.Value (string >> ContinentId.ofString) reader.Value
/// JSON converter for Markdown strings /// JSON converter for Markdown strings
type MarkdownStringJsonConverter() = type MarkdownStringJsonConverter() =
inherit JsonConverter<MarkdownString>() inherit JsonConverter<MarkdownString>()
override __.WriteJson(writer : JsonWriter, value : MarkdownString, _ : JsonSerializer) = override _.WriteJson(writer : JsonWriter, value : MarkdownString, _ : JsonSerializer) =
let (Text text) = value let (Text text) = value
writer.WriteValue text writer.WriteValue text
override __.ReadJson(reader: JsonReader, _ : Type, _ : MarkdownString, _ : bool, _ : JsonSerializer) = override _.ReadJson(reader: JsonReader, _ : Type, _ : MarkdownString, _ : bool, _ : JsonSerializer) =
(string >> Text) reader.Value (string >> Text) reader.Value
/// JSON converter for listing IDs /// JSON converter for listing IDs
type ListingIdJsonConverter() = type ListingIdJsonConverter() =
inherit JsonConverter<ListingId>() inherit JsonConverter<ListingId>()
override __.WriteJson(writer : JsonWriter, value : ListingId, _ : JsonSerializer) = override _.WriteJson(writer : JsonWriter, value : ListingId, _ : JsonSerializer) =
writer.WriteValue (ListingId.toString value) writer.WriteValue (ListingId.toString value)
override __.ReadJson(reader: JsonReader, _ : Type, _ : ListingId, _ : bool, _ : JsonSerializer) = override _.ReadJson(reader: JsonReader, _ : Type, _ : ListingId, _ : bool, _ : JsonSerializer) =
(string >> ListingId.ofString) reader.Value (string >> ListingId.ofString) reader.Value
/// JSON converter for skill IDs /// JSON converter for skill IDs
type SkillIdJsonConverter() = type SkillIdJsonConverter() =
inherit JsonConverter<SkillId>() inherit JsonConverter<SkillId>()
override __.WriteJson(writer : JsonWriter, value : SkillId, _ : JsonSerializer) = override _.WriteJson(writer : JsonWriter, value : SkillId, _ : JsonSerializer) =
writer.WriteValue (SkillId.toString value) writer.WriteValue (SkillId.toString value)
override __.ReadJson(reader: JsonReader, _ : Type, _ : SkillId, _ : bool, _ : JsonSerializer) = override _.ReadJson(reader: JsonReader, _ : Type, _ : SkillId, _ : bool, _ : JsonSerializer) =
(string >> SkillId.ofString) reader.Value (string >> SkillId.ofString) reader.Value
/// JSON converter for success report IDs /// JSON converter for success report IDs
type SuccessIdJsonConverter() = type SuccessIdJsonConverter() =
inherit JsonConverter<SuccessId>() inherit JsonConverter<SuccessId>()
override __.WriteJson(writer : JsonWriter, value : SuccessId, _ : JsonSerializer) = override _.WriteJson(writer : JsonWriter, value : SuccessId, _ : JsonSerializer) =
writer.WriteValue (SuccessId.toString value) writer.WriteValue (SuccessId.toString value)
override __.ReadJson(reader: JsonReader, _ : Type, _ : SuccessId, _ : bool, _ : JsonSerializer) = override _.ReadJson(reader: JsonReader, _ : Type, _ : SuccessId, _ : bool, _ : JsonSerializer) =
(string >> SuccessId.ofString) reader.Value (string >> SuccessId.ofString) reader.Value
/// All JSON converters needed for the application /// All JSON converters needed for the application
let all () = [ let all () : JsonConverter list =
CitizenIdJsonConverter () :> JsonConverter [ CitizenIdJsonConverter ()
upcast ContinentIdJsonConverter () ContinentIdJsonConverter ()
upcast MarkdownStringJsonConverter () MarkdownStringJsonConverter ()
upcast ListingIdJsonConverter () ListingIdJsonConverter ()
upcast SkillIdJsonConverter () SkillIdJsonConverter ()
upcast SuccessIdJsonConverter () SuccessIdJsonConverter ()
upcast CompactUnionJsonConverter () CompactUnionJsonConverter ()
] ]
/// Table names /// Table names
[<RequireQualifiedAccess>] [<RequireQualifiedAccess>]
module Table = module Table =
/// The user (citizen of Gitmo Nation) table /// The user (citizen of Gitmo Nation) table
let Citizen = "citizen" let Citizen = "citizen"
/// The continent table /// The continent table
let Continent = "continent" let Continent = "continent"
/// The job listing table /// The job listing table
let Listing = "listing" let Listing = "listing"
/// The citizen employment profile table /// The citizen employment profile table
let Profile = "profile" let Profile = "profile"
/// The success story table /// The success story table
let Success = "success" let Success = "success"
/// All tables /// All tables
let all () = [ Citizen; Continent; Listing; Profile; Success ] let all () = [ Citizen; Continent; Listing; Profile; Success ]
/// Functions run at startup /// Functions run at startup
[<RequireQualifiedAccess>] [<RequireQualifiedAccess>]
module Startup = module Startup =
open Microsoft.Extensions.Configuration open Microsoft.Extensions.Configuration
open Microsoft.Extensions.Logging open Microsoft.Extensions.Logging
open NodaTime open NodaTime
open NodaTime.Serialization.JsonNet open NodaTime.Serialization.JsonNet
/// Create a RethinkDB connection /// Create a RethinkDB connection
let createConnection (cfg : IConfigurationSection) (log : ILogger) = let createConnection (cfg : IConfigurationSection) (log : ILogger) =
// Add all required JSON converters // Add all required JSON converters
Converter.Serializer.ConfigureForNodaTime DateTimeZoneProviders.Tzdb |> ignore Converter.Serializer.ConfigureForNodaTime DateTimeZoneProviders.Tzdb |> ignore
Converters.all () Converters.all ()
|> List.iter Converter.Serializer.Converters.Add |> List.iter Converter.Serializer.Converters.Add
// Read the configuration and create a connection // Read the configuration and create a connection
let bldr = let bldr =
seq<Connection.Builder -> Connection.Builder> { seq<Connection.Builder -> Connection.Builder> {
yield fun b -> match cfg.["Hostname"] with null -> b | host -> b.Hostname host 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["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["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["Db"] with null -> b | db -> b.Db db
yield fun b -> match cfg.["Timeout"] with null -> b | time -> (int >> b.Timeout) time yield fun b -> match cfg["Timeout"] with null -> b | time -> (int >> b.Timeout) time
} }
|> Seq.fold (fun b step -> step b) (r.Connection ()) |> Seq.fold (fun b step -> step b) (r.Connection ())
match log.IsEnabled LogLevel.Debug with match log.IsEnabled LogLevel.Debug with
| true -> log.LogDebug $"RethinkDB: Connecting to {bldr.Hostname}:{bldr.Port}, database {bldr.Db}" | true -> log.LogDebug $"RethinkDB: Connecting to {bldr.Hostname}:{bldr.Port}, database {bldr.Db}"
| false -> () | false -> ()
bldr.Connect () :> IConnection bldr.Connect () :> IConnection
/// Ensure the data, tables, and indexes that are required exist /// Ensure the data, tables, and indexes that are required exist
let establishEnvironment (cfg : IConfigurationSection) (log : ILogger) conn = task { let establishEnvironment (cfg : IConfigurationSection) (log : ILogger) conn = task {
// Ensure the database exists // Ensure the database exists
match cfg.["Db"] |> Option.ofObj with match cfg["Db"] |> Option.ofObj with
| Some database -> | Some database ->
let! dbs = r.DbList().RunResultAsync<string list> conn let! dbs = r.DbList().RunResultAsync<string list> conn
match dbs |> List.contains database with 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
| true -> () | true -> ()
| false -> | false ->
log.LogInformation $"Creating {tbl} table..." log.LogInformation $"Creating database {database}..."
r.TableCreate(tbl).RunWriteAsync conn |> awaitIgnore) let! _ = r.DbCreate(database).RunWriteAsync conn
// Ensure the indexes exist ()
let ensureIndexes table indexes = task { | None -> ()
let! tblIdxs = r.Table(table).IndexList().RunResultAsync<string list> conn // Ensure the tables exist
indexes let! tables = r.TableList().RunResultAsync<string list> conn
|> List.iter ( Table.all ()
fun idx -> |> List.iter (
match tblIdxs |> List.contains idx with fun tbl ->
| true -> () match tables |> List.contains tbl with
| false -> | true -> ()
log.LogInformation $"Creating \"{idx}\" index on {table}" | false ->
r.Table(table).IndexCreate(idx).RunWriteAsync conn |> awaitIgnore) log.LogInformation $"Creating {tbl} table..."
} r.TableCreate(tbl).RunWriteAsync conn |> awaitIgnore)
do! ensureIndexes Table.Listing [ "citizenId"; "continentId"; "isExpired" ] // Ensure the indexes exist
do! ensureIndexes Table.Profile [ "continentId" ] let ensureIndexes table indexes = task {
do! ensureIndexes Table.Success [ "citizenId" ] let! tblIdxs = r.Table(table).IndexList().RunResultAsync<string list> conn
// The instance/user is a compound index indexes
let! userIdx = r.Table(Table.Citizen).IndexList().RunResultAsync<string list> conn |> List.iter (
match userIdx |> List.contains "instanceUser" with fun idx ->
| true -> () match tblIdxs |> List.contains idx with
| false -> | true -> ()
let! _ = | false ->
r.Table(Table.Citizen) log.LogInformation $"Creating \"{idx}\" index on {table}"
.IndexCreate("instanceUser", r.Table(table).IndexCreate(idx).RunWriteAsync conn |> awaitIgnore)
ReqlFunction1 (fun row -> upcast r.Array (row.G "instance", row.G "mastodonUser"))) }
.RunWriteAsync conn 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>] [<AutoOpen>]
module private Reconnect = 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 /// 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>) = let withReconn (conn : IConnection) (f : IConnection -> Task<'T>) =
Policy Policy
.Handle<ReqlDriverError>() .Handle<ReqlDriverError>()
.RetryAsync(System.Action<exn, int> (fun ex _ -> .RetryAsync(System.Action<exn, int> (fun ex _ ->
printf "Encountered RethinkDB exception: %s" ex.Message printf "Encountered RethinkDB exception: %s" ex.Message
match ex.Message.Contains "socket" with match ex.Message.Contains "socket" with
| true -> | true ->
printf "Reconnecting to RethinkDB" printf "Reconnecting to RethinkDB"
(conn :?> Connection).Reconnect false (conn :?> Connection).Reconnect false
| false -> ())) | false -> ()))
.ExecuteAsync(fun () -> f conn) .ExecuteAsync(fun () -> f conn)
/// Execute a query that returns one or none item, using the reconnect logic /// Execute a query that returns one or none item, using the reconnect logic
let withReconnOption (conn : IConnection) (f : IConnection -> Task<'T>) = let withReconnOption (conn : IConnection) (f : IConnection -> Task<'T>) =
fun c -> task { fun c -> task {
let! it = f c let! it = f c
return toOption it return toOption it
} }
|> withReconn conn |> withReconn conn
/// Execute a query that does not return a result, using the above reconnect logic /// Execute a query that does not return a result, using the above reconnect logic
let withReconnIgnore (conn : IConnection) (f : IConnection -> Task<'T>) = let withReconnIgnore (conn : IConnection) (f : IConnection -> Task<'T>) =
fun c -> task { fun c -> task {
let! _ = f c let! _ = f c
() ()
} }
|> withReconn conn |> withReconn conn
/// Sanitize user input, and create a "contains" pattern for use with RethinkDB queries /// Sanitize user input, and create a "contains" pattern for use with RethinkDB queries
let regexContains = System.Text.RegularExpressions.Regex.Escape >> sprintf "(?i)%s" let regexContains = System.Text.RegularExpressions.Regex.Escape >> sprintf "(?i)%s"
@ -230,338 +230,322 @@ open JobsJobsJobs.Domain.SharedTypes
[<RequireQualifiedAccess>] [<RequireQualifiedAccess>]
module Profile = module Profile =
let count conn = let count conn =
r.Table(Table.Profile) r.Table(Table.Profile)
.Count() .Count()
.RunResultAsync<int64> .RunResultAsync<int64>
|> withReconn conn |> withReconn conn
/// Find a profile by citizen ID /// Find a profile by citizen ID
let findById (citizenId : CitizenId) conn = let findById (citizenId : CitizenId) conn =
r.Table(Table.Profile) r.Table(Table.Profile)
.Get(citizenId) .Get(citizenId)
.RunResultAsync<Profile> .RunResultAsync<Profile>
|> withReconnOption conn |> withReconnOption conn
/// Insert or update a profile /// Insert or update a profile
let save (profile : Profile) conn = let save (profile : Profile) conn =
r.Table(Table.Profile) r.Table(Table.Profile)
.Get(profile.id) .Get(profile.id)
.Replace(profile) .Replace(profile)
.RunWriteAsync .RunWriteAsync
|> withReconnIgnore conn |> withReconnIgnore conn
/// Delete a citizen's profile /// Delete a citizen's profile
let delete (citizenId : CitizenId) conn = let delete (citizenId : CitizenId) conn =
r.Table(Table.Profile) r.Table(Table.Profile)
.Get(citizenId) .Get(citizenId)
.Delete() .Delete()
.RunWriteAsync .RunWriteAsync
|> withReconnIgnore conn |> withReconnIgnore conn
/// Search profiles (logged-on users) /// Search profiles (logged-on users)
let search (srch : ProfileSearch) conn = let search (search : ProfileSearch) conn =
fun c -> (seq<ReqlExpr -> ReqlExpr> {
(seq { match search.continentId with
match srch.continentId with | Some cId -> yield (fun q -> q.Filter (r.HashMap (nameof search.continentId, ContinentId.ofString cId)))
| Some conId -> | None -> ()
yield (fun (q : ReqlExpr) -> match search.remoteWork with
q.Filter (r.HashMap (nameof srch.continentId, ContinentId.ofString conId)) :> ReqlExpr) | "" -> ()
| None -> () | _ -> yield (fun q -> q.Filter (r.HashMap (nameof search.remoteWork, search.remoteWork = "yes")))
match srch.remoteWork with match search.skill with
| "" -> () | Some skl ->
| _ -> yield (fun q -> q.Filter (r.HashMap (nameof srch.remoteWork, srch.remoteWork = "yes")) :> ReqlExpr) yield (fun q -> q.Filter (ReqlFunction1(fun it ->
match srch.skill with it.G("skills").Contains (ReqlFunction1(fun s -> s.G("description").Match (regexContains skl))))))
| Some skl -> | None -> ()
yield (fun q -> q.Filter (ReqlFunction1(fun it -> match search.bioExperience with
upcast it.G("skills").Contains (ReqlFunction1(fun s -> | Some text ->
upcast s.G("description").Match (regexContains skl))))) :> ReqlExpr) let txt = regexContains text
| None -> () yield (fun q -> q.Filter (ReqlFunction1(fun it ->
match srch.bioExperience with it.G("biography").Match(txt).Or (it.G("experience").Match txt))))
| Some text -> | None -> ()
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 -> ()
}
|> Seq.toList |> Seq.toList
|> List.fold |> List.fold
(fun q f -> f q) (fun q f -> f q)
(r.Table(Table.Profile) (r.Table(Table.Profile)
.EqJoin("id", r.Table Table.Citizen) .EqJoin("id", r.Table Table.Citizen)
.Without(r.HashMap ("right", "id")) .Without(r.HashMap ("right", "id"))
.Zip () :> ReqlExpr)) .Zip () :> ReqlExpr))
.Merge(ReqlFunction1 (fun it -> .Merge(ReqlFunction1 (fun it ->
upcast r upcast r
.HashMap("displayName", .HashMap("displayName",
r.Branch (it.G("realName" ).Default_("").Ne "", it.G "realName", r.Branch (it.G("realName" ).Default_("").Ne "", it.G "realName",
it.G("displayName").Default_("").Ne "", it.G "displayName", it.G("displayName").Default_("").Ne "", it.G "displayName",
it.G "mastodonUser")) it.G "mastodonUser"))
.With ("citizenId", it.G "id"))) .With ("citizenId", it.G "id")))
.Pluck("citizenId", "displayName", "seekingEmployment", "remoteWork", "fullTime", "lastUpdatedOn") .Pluck("citizenId", "displayName", "seekingEmployment", "remoteWork", "fullTime", "lastUpdatedOn")
.OrderBy(ReqlFunction1 (fun it -> upcast it.G("displayName").Downcase ())) .OrderBy(ReqlFunction1 (fun it -> upcast it.G("displayName").Downcase ()))
.RunResultAsync<ProfileSearchResult list> c .RunResultAsync<ProfileSearchResult list>
|> withReconn conn |> withReconn conn
// Search profiles (public) // Search profiles (public)
let publicSearch (srch : PublicSearch) conn = let publicSearch (srch : PublicSearch) conn =
fun c -> (seq<ReqlExpr -> ReqlExpr> {
(seq { match srch.continentId with
match srch.continentId with | Some cId -> yield (fun q -> q.Filter (r.HashMap (nameof srch.continentId, ContinentId.ofString cId)))
| Some conId -> | None -> ()
yield (fun (q : ReqlExpr) -> match srch.region with
q.Filter (r.HashMap (nameof srch.continentId, ContinentId.ofString conId)) :> ReqlExpr) | Some reg ->
| None -> () yield (fun q -> q.Filter (ReqlFunction1 (fun it -> upcast it.G("region").Match (regexContains reg))))
match srch.region with | None -> ()
| Some reg -> match srch.remoteWork with
yield (fun q -> | "" -> ()
q.Filter (ReqlFunction1 (fun it -> upcast it.G("region").Match (regexContains reg))) :> ReqlExpr) | _ -> yield (fun q -> q.Filter (r.HashMap (nameof srch.remoteWork, srch.remoteWork = "yes")))
| None -> () match srch.skill with
match srch.remoteWork with | Some skl ->
| "" -> () yield (fun q -> q.Filter (ReqlFunction1 (fun it ->
| _ -> yield (fun q -> q.Filter (r.HashMap (nameof srch.remoteWork, srch.remoteWork = "yes")) :> ReqlExpr) it.G("skills").Contains (ReqlFunction1(fun s -> s.G("description").Match (regexContains skl))))))
match srch.skill with | None -> ()
| 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 -> ()
}
|> Seq.toList |> Seq.toList
|> List.fold |> List.fold
(fun q f -> f q) (fun q f -> f q)
(r.Table(Table.Profile) (r.Table(Table.Profile)
.EqJoin("continentId", r.Table Table.Continent) .EqJoin("continentId", r.Table Table.Continent)
.Without(r.HashMap ("right", "id")) .Without(r.HashMap ("right", "id"))
.Zip() .Zip()
.Filter(r.HashMap ("isPublic", true)) :> ReqlExpr)) .Filter(r.HashMap ("isPublic", true))))
.Merge(ReqlFunction1 (fun it -> .Merge(ReqlFunction1 (fun it ->
upcast r upcast r
.HashMap("skills", .HashMap("skills",
it.G("skills").Map (ReqlFunction1 (fun skill -> it.G("skills").Map (ReqlFunction1 (fun skill ->
upcast r.Branch(skill.G("notes").Default_("").Eq "", skill.G "description", upcast r.Branch(skill.G("notes").Default_("").Eq "", skill.G "description",
skill.G("description").Add(" (").Add(skill.G("notes")).Add ")")))) skill.G("description").Add(" (").Add(skill.G("notes")).Add ")"))))
.With("continent", it.G "name"))) .With("continent", it.G "name")))
.Pluck("continent", "region", "skills", "remoteWork") .Pluck("continent", "region", "skills", "remoteWork")
.RunResultAsync<PublicSearchResult list> c .RunResultAsync<PublicSearchResult list>
|> withReconn conn |> withReconn conn
/// Citizen data access functions /// Citizen data access functions
[<RequireQualifiedAccess>] [<RequireQualifiedAccess>]
module Citizen = module Citizen =
/// Find a citizen by their ID /// Find a citizen by their ID
let findById (citizenId : CitizenId) conn = 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 =
r.Table(Table.Citizen) 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) .Get(citizenId)
.Delete() .RunResultAsync<Citizen>
.RunWriteAsync c |> withReconnOption conn
()
} /// Find a citizen by their Mastodon username
|> withReconnIgnore conn 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 /// Add a citizen
let realNameUpdate (citizenId : CitizenId) (realName : string option) conn = let add (citizen : Citizen) conn =
r.Table(Table.Citizen) r.Table(Table.Citizen)
.Get(citizenId) .Insert(citizen)
.Update(r.HashMap (nameof realName, realName)) .RunWriteAsync
.RunWriteAsync |> withReconnIgnore conn
|> 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 /// Continent data access functions
[<RequireQualifiedAccess>] [<RequireQualifiedAccess>]
module Continent = module Continent =
/// Get all continents /// Get all continents
let all conn = let all conn =
r.Table(Table.Continent) r.Table(Table.Continent)
.RunResultAsync<Continent list> .RunResultAsync<Continent list>
|> withReconn conn |> withReconn conn
/// Get a continent by its ID /// Get a continent by its ID
let findById (contId : ContinentId) conn = let findById (contId : ContinentId) conn =
r.Table(Table.Continent) r.Table(Table.Continent)
.Get(contId) .Get(contId)
.RunResultAsync<Continent> .RunResultAsync<Continent>
|> withReconnOption conn |> withReconnOption conn
/// Job listing data access functions /// Job listing data access functions
[<RequireQualifiedAccess>] [<RequireQualifiedAccess>]
module Listing = module Listing =
open NodaTime open NodaTime
/// Find all job listings posted by the given citizen /// Find all job listings posted by the given citizen
let findByCitizen (citizenId : CitizenId) conn = let findByCitizen (citizenId : CitizenId) conn =
r.Table(Table.Listing) r.Table(Table.Listing)
.GetAll(citizenId).OptArg("index", nameof citizenId) .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))
.EqJoin("continentId", r.Table Table.Continent) .EqJoin("continentId", r.Table Table.Continent)
.Map(ReqlFunction1 (fun it -> upcast r.HashMap("listing", it.G "left").With ("continent", it.G "right"))) .Map(ReqlFunction1 (fun it -> r.HashMap("listing", it.G "left").With ("continent", it.G "right")))
.RunResultAsync<ListingForView list> c .RunResultAsync<ListingForView list>
return List.tryHead listing |> withReconn conn
}
|> withReconn conn
/// Add a listing /// Find a listing by its ID
let add (listing : Listing) conn = let findById (listingId : ListingId) conn =
r.Table(Table.Listing) r.Table(Table.Listing)
.Insert(listing) .Get(listingId)
.RunWriteAsync .RunResultAsync<Listing>
|> withReconnIgnore conn |> withReconnOption conn
/// Update a listing /// Find a listing by its ID for viewing (includes continent information)
let update (listing : Listing) conn = let findByIdForView (listingId : ListingId) conn =
r.Table(Table.Listing) fun c -> task {
.Get(listing.id) let! listing =
.Replace(listing) r.Table(Table.Listing)
.RunWriteAsync .Filter(r.HashMap ("id", listingId))
|> withReconnIgnore conn .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 /// Expire a listing
let expire (listingId : ListingId) (fromHere : bool) (now : Instant) conn = let expire (listingId : ListingId) (fromHere : bool) (now : Instant) conn =
r.Table(Table.Listing) r.Table(Table.Listing)
.Get(listingId) .Get(listingId)
.Update(r.HashMap("isExpired", true).With("wasFilledHere", fromHere).With ("updatedOn", now)) .Update(r.HashMap("isExpired", true).With("wasFilledHere", fromHere).With ("updatedOn", now))
.RunWriteAsync .RunWriteAsync
|> withReconnIgnore conn |> withReconnIgnore conn
/// Search job listings /// Search job listings
let search (srch : ListingSearch) conn = let search (search : ListingSearch) conn =
fun c -> (seq<ReqlExpr -> ReqlExpr> {
(seq { match search.continentId with
match srch.continentId with | Some cId -> yield (fun q -> q.Filter (r.HashMap (nameof search.continentId, ContinentId.ofString cId)))
| Some conId -> | None -> ()
yield (fun (q : ReqlExpr) -> match search.region with
q.Filter (r.HashMap (nameof srch.continentId, ContinentId.ofString conId)) :> ReqlExpr) | Some rgn ->
| None -> () yield (fun q ->
match srch.region with q.Filter (ReqlFunction1 (fun it -> it.G(nameof search.region).Match (regexContains rgn))))
| Some rgn -> | None -> ()
yield (fun q -> match search.remoteWork with
q.Filter (ReqlFunction1 (fun it -> | "" -> ()
upcast it.G(nameof srch.region).Match (regexContains rgn))) :> ReqlExpr) | _ -> yield (fun q -> q.Filter (r.HashMap (nameof search.remoteWork, search.remoteWork = "yes")))
| None -> () match search.text with
match srch.remoteWork with | Some text ->
| "" -> () yield (fun q ->
| _ -> q.Filter (ReqlFunction1 (fun it -> it.G(nameof search.text).Match (regexContains text))))
yield (fun q -> q.Filter (r.HashMap (nameof srch.remoteWork, srch.remoteWork = "yes")) :> ReqlExpr) | None -> ()
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 -> ()
}
|> Seq.toList |> Seq.toList
|> List.fold |> List.fold
(fun q f -> f q) (fun q f -> f q)
(r.Table(Table.Listing) (r.Table(Table.Listing)
.GetAll(false).OptArg ("index", "isExpired") :> ReqlExpr)) .GetAll(false).OptArg ("index", "isExpired")))
.EqJoin("continentId", r.Table Table.Continent) .EqJoin("continentId", r.Table Table.Continent)
.Map(ReqlFunction1 (fun it -> upcast r.HashMap("listing", it.G "left").With ("continent", it.G "right"))) .Map(ReqlFunction1 (fun it -> r.HashMap("listing", it.G "left").With ("continent", it.G "right")))
.RunResultAsync<ListingForView list> c .RunResultAsync<ListingForView list>
|> withReconn conn |> withReconn conn
/// Success story data access functions /// Success story data access functions
[<RequireQualifiedAccess>] [<RequireQualifiedAccess>]
module Success = module Success =
/// Find a success report by its ID /// Find a success report by its ID
let findById (successId : SuccessId) conn = let findById (successId : SuccessId) conn =
r.Table(Table.Success) r.Table(Table.Success)
.Get(successId) .Get(successId)
.RunResultAsync<Success> .RunResultAsync<Success>
|> withReconnOption conn |> withReconnOption conn
/// Insert or update a success story /// Insert or update a success story
let save (success : Success) conn = let save (success : Success) conn =
r.Table(Table.Success) r.Table(Table.Success)
.Get(success.id) .Get(success.id)
.Replace(success) .Replace(success)
.RunWriteAsync .RunWriteAsync
|> withReconnIgnore conn |> withReconnIgnore conn
// Retrieve all success stories // Retrieve all success stories
let all conn = let all conn =
r.Table(Table.Success) r.Table(Table.Success)
.EqJoin("citizenId", r.Table Table.Citizen) .EqJoin("citizenId", r.Table Table.Citizen)
.Without(r.HashMap ("right", "id")) .Without(r.HashMap ("right", "id"))
.Zip() .Zip()
.Merge(ReqlFunction1 (fun it -> .Merge(ReqlFunction1 (fun it ->
upcast r r.HashMap("citizenName",
.HashMap("citizenName", r.Branch(it.G("realName" ).Default_("").Ne "", it.G "realName",
r.Branch(it.G("realName" ).Default_("").Ne "", it.G "realName", it.G("displayName").Default_("").Ne "", it.G "displayName",
it.G("displayName").Default_("").Ne "", it.G "displayName", it.G "mastodonUser"))
it.G "mastodonUser")) .With ("hasStory", it.G("story").Default_("").Gt "")))
.With ("hasStory", it.G("story").Default_("").Gt ""))) .Pluck("id", "citizenId", "citizenName", "recordedOn", "fromHere", "hasStory")
.Pluck("id", "citizenId", "citizenName", "recordedOn", "fromHere", "hasStory") .OrderBy(r.Desc "recordedOn")
.OrderBy(r.Desc "recordedOn") .RunResultAsync<StoryEntry list>
.RunResultAsync<StoryEntry list> |> withReconn conn
|> 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 /// Handler to return the files required for the Vue client app
module Vue = module Vue =
/// Handler that returns index.html (the Vue client app) /// Handler that returns index.html (the Vue client app)
let app = htmlFile "wwwroot/index.html" let app = htmlFile "wwwroot/index.html"
/// Handlers for error conditions /// Handlers for error conditions
module Error = module Error =
open System.Threading.Tasks open System.Threading.Tasks
/// URL prefixes for the Vue app /// URL prefixes for the Vue app
let vueUrls = [ let vueUrls =
"/how-it-works"; "/privacy-policy"; "/terms-of-service"; "/citizen"; "/help-wanted"; "/listing"; "/profile" [ "/how-it-works"; "/privacy-policy"; "/terms-of-service"; "/citizen"; "/help-wanted"; "/listing"; "/profile"
"/so-long"; "/success-story" "/so-long"; "/success-story"
] ]
/// Handler that will return a status code 404 and the text "Not Found" /// Handler that will return a status code 404 and the text "Not Found"
let notFound : HttpHandler = let notFound : HttpHandler = fun next ctx -> task {
fun next ctx -> task { let fac = ctx.GetService<ILoggerFactory> ()
let fac = ctx.GetService<ILoggerFactory> () let log = fac.CreateLogger "Handler"
let log = fac.CreateLogger "Handler" let path = string ctx.Request.Path
let path = string ctx.Request.Path match [ "GET"; "HEAD" ] |> List.contains ctx.Request.Method with
match [ "GET"; "HEAD" ] |> List.contains ctx.Request.Method with | true when path = "/" || vueUrls |> List.exists path.StartsWith ->
| true when path = "/" || vueUrls |> List.exists path.StartsWith -> log.LogInformation "Returning Vue app"
log.LogInformation "Returning Vue app" return! Vue.app next ctx
return! Vue.app next ctx | _ ->
| _ -> log.LogInformation "Returning 404"
log.LogInformation "Returning 404" return! RequestErrors.NOT_FOUND $"The URL {path} was not recognized as a valid URL" next ctx
return! RequestErrors.NOT_FOUND $"The URL {path} was not recognized as a valid URL" next ctx }
}
/// Handler that returns a 403 NOT AUTHORIZED response /// Handler that returns a 403 NOT AUTHORIZED response
let notAuthorized : HttpHandler = let notAuthorized : HttpHandler =
setStatusCode 403 >=> fun _ _ -> Task.FromResult<HttpContext option> None setStatusCode 403 >=> fun _ _ -> Task.FromResult<HttpContext option> None
/// Handler to log 500s and return a message we can display in the application /// Handler to log 500s and return a message we can display in the application
let unexpectedError (ex: exn) (log : ILogger) = let unexpectedError (ex: exn) (log : ILogger) =
log.LogError(ex, "An unexpected error occurred") log.LogError(ex, "An unexpected error occurred")
clearResponse >=> ServerErrors.INTERNAL_ERROR ex.Message clearResponse >=> ServerErrors.INTERNAL_ERROR ex.Message
/// Helper functions /// Helper functions
[<AutoOpen>] [<AutoOpen>]
module Helpers = module Helpers =
open NodaTime open NodaTime
open Microsoft.Extensions.Configuration open Microsoft.Extensions.Configuration
open Microsoft.Extensions.Options open Microsoft.Extensions.Options
open RethinkDb.Driver.Net open RethinkDb.Driver.Net
open System.Security.Claims open System.Security.Claims
/// Get the NodaTime clock from the request context /// Get the NodaTime clock from the request context
let clock (ctx : HttpContext) = ctx.GetService<IClock> () let clock (ctx : HttpContext) = ctx.GetService<IClock> ()
/// Get the application configuration from the request context /// Get the application configuration from the request context
let config (ctx : HttpContext) = ctx.GetService<IConfiguration> () let config (ctx : HttpContext) = ctx.GetService<IConfiguration> ()
/// Get the authorization configuration from the request context /// Get the authorization configuration from the request context
let authConfig (ctx : HttpContext) = (ctx.GetService<IOptions<AuthOptions>> ()).Value let authConfig (ctx : HttpContext) = (ctx.GetService<IOptions<AuthOptions>> ()).Value
/// Get the logger factory from the request context /// Get the logger factory from the request context
let logger (ctx : HttpContext) = ctx.GetService<ILoggerFactory> () let logger (ctx : HttpContext) = ctx.GetService<ILoggerFactory> ()
/// Get the RethinkDB connection from the request context /// Get the RethinkDB connection from the request context
let conn (ctx : HttpContext) = ctx.GetService<IConnection> () let conn (ctx : HttpContext) = ctx.GetService<IConnection> ()
/// `None` if a `string option` is `None`, whitespace, or empty /// `None` if a `string option` is `None`, whitespace, or empty
let noneIfBlank (s : string option) = let noneIfBlank (s : string option) =
s |> Option.map (fun x -> match x.Trim () with "" -> None | _ -> Some x) |> Option.flatten s |> Option.map (fun x -> match x.Trim () with "" -> None | _ -> Some x) |> Option.flatten
/// `None` if a `string` is null, empty, or whitespace; otherwise, `Some` and the trimmed string /// `None` if a `string` is null, empty, or whitespace; otherwise, `Some` and the trimmed string
let noneIfEmpty = Option.ofObj >> noneIfBlank let noneIfEmpty = Option.ofObj >> noneIfBlank
/// Try to get the current user /// Try to get the current user
let tryUser (ctx : HttpContext) = let tryUser (ctx : HttpContext) =
ctx.User.FindFirst ClaimTypes.NameIdentifier ctx.User.FindFirst ClaimTypes.NameIdentifier
|> Option.ofObj |> Option.ofObj
|> Option.map (fun x -> x.Value) |> Option.map (fun x -> x.Value)
/// Require a user to be logged in /// Require a user to be logged in
let authorize : HttpHandler = let authorize : HttpHandler =
fun next ctx -> match tryUser ctx with Some _ -> next ctx | None -> Error.notAuthorized next ctx fun next ctx -> match tryUser ctx with Some _ -> next ctx | None -> Error.notAuthorized next ctx
/// Get the ID of the currently logged in citizen /// Get the ID of the currently logged in citizen
// NOTE: if no one is logged in, this will raise an exception // NOTE: if no one is logged in, this will raise an exception
let currentCitizenId = tryUser >> Option.get >> CitizenId.ofString let currentCitizenId = tryUser >> Option.get >> CitizenId.ofString
/// Return an empty OK response /// Return an empty OK response
let ok : HttpHandler = Successful.OK "" let ok : HttpHandler = Successful.OK ""
@ -106,456 +105,406 @@ module Helpers =
[<RequireQualifiedAccess>] [<RequireQualifiedAccess>]
module Citizen = module Citizen =
// GET: /api/citizen/log-on/[code] // GET: /api/citizen/log-on/[code]
let logOn (abbr, authCode) : HttpHandler = let logOn (abbr, authCode) : HttpHandler = fun next ctx -> task {
fun next ctx -> task { // Step 1 - Verify with Mastodon
// Step 1 - Verify with Mastodon let cfg = authConfig ctx
let cfg = authConfig ctx
match cfg.Instances |> Array.tryFind (fun it -> it.Abbr = abbr) with
match cfg.Instances |> Array.tryFind (fun it -> it.Abbr = abbr) with | Some instance ->
| Some instance -> let log = (logger ctx).CreateLogger (nameof JobsJobsJobs.Api.Auth)
let log = (logger ctx).CreateLogger (nameof JobsJobsJobs.Api.Auth)
match! Auth.verifyWithMastodon authCode instance cfg.ReturnHost log with
match! Auth.verifyWithMastodon authCode instance cfg.ReturnHost log with | Ok account ->
| Ok account -> // Step 2 - Find / establish Jobs, Jobs, Jobs account
// Step 2 - Find / establish Jobs, Jobs, Jobs account let now = (clock ctx).GetCurrentInstant ()
let now = (clock ctx).GetCurrentInstant () let dbConn = conn ctx
let dbConn = conn ctx let! citizen = task {
let! citizen = task { match! Data.Citizen.findByMastodonUser instance.Abbr account.Username dbConn with
match! Data.Citizen.findByMastodonUser instance.Abbr account.Username dbConn with | None ->
| None -> let it : Citizen =
let it : Citizen = { id = CitizenId.create ()
{ id = CitizenId.create () instance = instance.Abbr
instance = instance.Abbr mastodonUser = account.Username
mastodonUser = account.Username displayName = noneIfEmpty account.DisplayName
displayName = noneIfEmpty account.DisplayName realName = None
realName = None profileUrl = account.Url
profileUrl = account.Url joinedOn = now
joinedOn = now lastSeenOn = now
lastSeenOn = now }
} do! Data.Citizen.add it dbConn
do! Data.Citizen.add it dbConn return it
return it | Some citizen ->
| Some citizen -> let it = { citizen with displayName = noneIfEmpty account.DisplayName; lastSeenOn = now }
let it = { citizen with displayName = noneIfEmpty account.DisplayName; lastSeenOn = now } do! Data.Citizen.logOnUpdate it dbConn
do! Data.Citizen.logOnUpdate it dbConn return it
return it }
}
// Step 3 - Generate JWT
// Step 3 - Generate JWT return!
return! json
json { jwt = Auth.createJwt citizen cfg
{ jwt = Auth.createJwt citizen cfg citizenId = CitizenId.toString citizen.id
citizenId = CitizenId.toString citizen.id name = Citizen.name citizen
name = Citizen.name citizen } next ctx
} next ctx | Error err -> return! RequestErrors.BAD_REQUEST err next ctx
| Error err -> return! RequestErrors.BAD_REQUEST err next ctx | None -> return! Error.notFound next ctx
| None -> return! Error.notFound next ctx }
}
// GET: /api/citizen/[id]
// GET: /api/citizen/[id] let get citizenId : HttpHandler = authorize >=> fun next ctx -> task {
let get citizenId : HttpHandler = match! Data.Citizen.findById (CitizenId citizenId) (conn ctx) with
authorize | Some citizen -> return! json citizen next ctx
>=> fun next ctx -> task { | None -> return! Error.notFound next ctx
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 // DELETE: /api/citizen
let delete : HttpHandler = let delete : HttpHandler = authorize >=> fun next ctx -> task {
authorize do! Data.Citizen.delete (currentCitizenId ctx) (conn ctx)
>=> fun next ctx -> task { return! ok next ctx
do! Data.Citizen.delete (currentCitizenId ctx) (conn ctx) }
return! ok next ctx
}
/// Handlers for /api/continent routes /// Handlers for /api/continent routes
[<RequireQualifiedAccess>] [<RequireQualifiedAccess>]
module Continent = module Continent =
// GET: /api/continent/all // GET: /api/continent/all
let all : HttpHandler = let all : HttpHandler = fun next ctx -> task {
fun next ctx -> task { let! continents = Data.Continent.all (conn ctx)
let! continents = Data.Continent.all (conn ctx) return! json continents next ctx
return! json continents next ctx }
}
/// Handlers for /api/instances routes /// Handlers for /api/instances routes
[<RequireQualifiedAccess>] [<RequireQualifiedAccess>]
module Instances = module Instances =
/// Convert a Masotodon instance to the one we use in the API /// Convert a Mastodon instance to the one we use in the API
let private toInstance (inst : MastodonInstance) = let private toInstance (inst : MastodonInstance) =
{ name = inst.Name { name = inst.Name
url = inst.Url url = inst.Url
abbr = inst.Abbr abbr = inst.Abbr
clientId = inst.ClientId clientId = inst.ClientId
} }
// GET: /api/instances // GET: /api/instances
let all : HttpHandler = let all : HttpHandler = fun next ctx -> task {
fun next ctx -> task { return! json ((authConfig ctx).Instances |> Array.map toInstance) next ctx
return! json ((authConfig ctx).Instances |> Array.map toInstance) next ctx }
}
/// Handlers for /api/listing[s] routes /// Handlers for /api/listing[s] routes
[<RequireQualifiedAccess>] [<RequireQualifiedAccess>]
module Listing = module Listing =
open NodaTime open NodaTime
open System open System
/// Parse the string we receive from JSON into a NodaTime local date /// Parse the string we receive from JSON into a NodaTime local date
let private parseDate = DateTime.Parse >> LocalDate.FromDateTime let private parseDate = DateTime.Parse >> LocalDate.FromDateTime
// GET: /api/listings/mine // GET: /api/listings/mine
let mine : HttpHandler = let mine : HttpHandler = authorize >=> fun next ctx -> task {
authorize let! listings = Data.Listing.findByCitizen (currentCitizenId ctx) (conn ctx)
>=> fun next ctx -> task { return! json listings next ctx
let! listings = Data.Listing.findByCitizen (currentCitizenId ctx) (conn ctx) }
return! json listings next ctx
}
// GET: /api/listing/[id] // GET: /api/listing/[id]
let get listingId : HttpHandler = let get listingId : HttpHandler = authorize >=> fun next ctx -> task {
authorize match! Data.Listing.findById (ListingId listingId) (conn ctx) with
>=> fun next ctx -> task { | Some listing -> return! json listing next ctx
match! Data.Listing.findById (ListingId listingId) (conn ctx) with | None -> return! Error.notFound next ctx
| 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] // PATCH: /api/listing/[id]
let view listingId : HttpHandler = let expire listingId : HttpHandler = authorize >=> fun next ctx -> task {
authorize let dbConn = conn ctx
>=> fun next ctx -> task { let now = clock(ctx).GetCurrentInstant ()
match! Data.Listing.findByIdForView (ListingId listingId) (conn ctx) with match! Data.Listing.findById (ListingId listingId) dbConn with
| Some listing -> return! json listing next ctx | Some listing when listing.citizenId <> (currentCitizenId ctx) -> return! Error.notAuthorized next ctx
| None -> return! Error.notFound 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 // GET: /api/listing/search
let add : HttpHandler = let search : HttpHandler = authorize >=> fun next ctx -> task {
authorize let search = ctx.BindQueryString<ListingSearch> ()
>=> fun next ctx -> task { let! results = Data.Listing.search search (conn ctx)
let! form = ctx.BindJsonAsync<ListingForm> () return! json results next ctx
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
}
/// Handlers for /api/profile routes /// Handlers for /api/profile routes
[<RequireQualifiedAccess>] [<RequireQualifiedAccess>]
module Profile = module Profile =
// GET: /api/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 // This returns the current citizen's profile, or a 204 if it is not found (a citizen not having a profile yet
// is not an error). The "get" handler returns a 404 if a profile is not found. // is not an error). The "get" handler returns a 404 if a profile is not found.
let current : HttpHandler = let current : HttpHandler = authorize >=> fun next ctx -> task {
authorize match! Data.Profile.findById (currentCitizenId ctx) (conn ctx) with
>=> fun next ctx -> task { | Some profile -> return! json profile next ctx
match! Data.Profile.findById (currentCitizenId ctx) (conn ctx) with | None -> return! Successful.NO_CONTENT next ctx
| Some profile -> return! json profile next ctx }
| None -> return! Successful.NO_CONTENT next ctx
}
// GET: /api/profile/get/[id] // GET: /api/profile/get/[id]
let get citizenId : HttpHandler = let get citizenId : HttpHandler = authorize >=> fun next ctx -> task {
authorize match! Data.Profile.findById (CitizenId citizenId) (conn ctx) with
>=> fun next ctx -> task { | Some profile -> return! json profile next ctx
match! Data.Profile.findById (CitizenId citizenId) (conn ctx) with | None -> return! Error.notFound next ctx
| Some profile -> return! json profile next ctx }
| None -> return! Error.notFound next ctx
}
// GET: /api/profile/view/[id] // GET: /api/profile/view/[id]
let view citizenId : HttpHandler = let view citizenId : HttpHandler = authorize >=> fun next ctx -> task {
authorize let citId = CitizenId citizenId
>=> fun next ctx -> task { let dbConn = conn ctx
let citId = CitizenId citizenId match! Data.Profile.findById citId dbConn with
let dbConn = conn ctx | Some profile ->
match! Data.Profile.findById citId dbConn with match! Data.Citizen.findById citId dbConn with
| Some profile -> | Some citizen ->
match! Data.Citizen.findById citId dbConn with match! Data.Continent.findById profile.continentId dbConn with
| Some citizen -> | Some continent ->
match! Data.Continent.findById profile.continentId dbConn with return!
| Some continent -> json
return! { profile = profile
json { citizen = citizen
profile = profile continent = continent
citizen = citizen } next ctx
continent = continent | None -> return! Error.notFound next ctx
} next ctx | None -> return! Error.notFound next ctx
| None -> return! Error.notFound next ctx | None -> return! Error.notFound next ctx
| None -> return! Error.notFound next ctx }
| None -> return! Error.notFound next ctx
}
// GET: /api/profile/count // GET: /api/profile/count
let count : HttpHandler = let count : HttpHandler = authorize >=> fun next ctx -> task {
authorize let! theCount = Data.Profile.count (conn ctx)
>=> fun next ctx -> task { return! json { count = theCount } next ctx
let! theCount = Data.Profile.count (conn ctx) }
return! json { count = theCount } next ctx
}
// POST: /api/profile/save // POST: /api/profile/save
let save : HttpHandler = let save : HttpHandler = authorize >=> fun next ctx -> task {
authorize let citizenId = currentCitizenId ctx
>=> fun next ctx -> task { let dbConn = conn ctx
let citizenId = currentCitizenId ctx let! form = ctx.BindJsonAsync<ProfileForm>()
let dbConn = conn ctx let! profile = task {
let! form = ctx.BindJsonAsync<ProfileForm>() match! Data.Profile.findById citizenId dbConn with
let! profile = task { | Some p -> return p
match! Data.Profile.findById citizenId dbConn with | None -> return { Profile.empty with id = citizenId }
| Some p -> return p
| None -> return { Profile.empty with id = citizenId }
} }
do! Data.Profile.save do! Data.Profile.save
{ profile with { profile with
seekingEmployment = form.isSeekingEmployment seekingEmployment = form.isSeekingEmployment
isPublic = form.isPublic isPublic = form.isPublic
continentId = ContinentId.ofString form.continentId continentId = ContinentId.ofString form.continentId
region = form.region region = form.region
remoteWork = form.remoteWork remoteWork = form.remoteWork
fullTime = form.fullTime fullTime = form.fullTime
biography = Text form.biography biography = Text form.biography
lastUpdatedOn = (clock ctx).GetCurrentInstant () lastUpdatedOn = (clock ctx).GetCurrentInstant ()
experience = noneIfBlank form.experience |> Option.map Text experience = noneIfBlank form.experience |> Option.map Text
skills = form.skills skills = form.skills
|> List.map (fun s -> |> List.map (fun s ->
{ id = match s.id.StartsWith "new" with { id = match s.id.StartsWith "new" with
| true -> SkillId.create () | true -> SkillId.create ()
| false -> SkillId.ofString s.id | false -> SkillId.ofString s.id
description = s.description description = s.description
notes = noneIfBlank s.notes notes = noneIfBlank s.notes
}) })
} dbConn } dbConn
do! Data.Citizen.realNameUpdate citizenId (noneIfBlank (Some form.realName)) dbConn do! Data.Citizen.realNameUpdate citizenId (noneIfBlank (Some form.realName)) dbConn
return! ok next ctx return! ok next ctx
} }
// PATCH: /api/profile/employment-found // PATCH: /api/profile/employment-found
let employmentFound : HttpHandler = let employmentFound : HttpHandler = authorize >=> fun next ctx -> task {
authorize let dbConn = conn ctx
>=> fun next ctx -> task { match! Data.Profile.findById (currentCitizenId ctx) dbConn with
let dbConn = conn ctx | Some profile ->
match! Data.Profile.findById (currentCitizenId ctx) dbConn with do! Data.Profile.save { profile with seekingEmployment = false } dbConn
| Some profile -> return! ok next ctx
do! Data.Profile.save { profile with seekingEmployment = false } dbConn | None -> return! Error.notFound next ctx
return! ok next ctx }
| None -> return! Error.notFound next ctx
}
// DELETE: /api/profile // DELETE: /api/profile
let delete : HttpHandler = let delete : HttpHandler = authorize >=> fun next ctx -> task {
authorize do! Data.Profile.delete (currentCitizenId ctx) (conn ctx)
>=> fun next ctx -> task { return! ok next ctx
do! Data.Profile.delete (currentCitizenId ctx) (conn ctx) }
return! ok next ctx
}
// GET: /api/profile/search // GET: /api/profile/search
let search : HttpHandler = let search : HttpHandler = authorize >=> fun next ctx -> task {
authorize let search = ctx.BindQueryString<ProfileSearch> ()
>=> fun next ctx -> task { let! results = Data.Profile.search search (conn ctx)
let search = ctx.BindQueryString<ProfileSearch> () return! json results next ctx
let! results = Data.Profile.search search (conn ctx) }
return! json results next ctx
}
// GET: /api/profile/public-search // GET: /api/profile/public-search
let publicSearch : HttpHandler = let publicSearch : HttpHandler = fun next ctx -> task {
fun next ctx -> task { let search = ctx.BindQueryString<PublicSearch> ()
let search = ctx.BindQueryString<PublicSearch> () let! results = Data.Profile.publicSearch search (conn ctx)
let! results = Data.Profile.publicSearch search (conn ctx) return! json results next ctx
return! json results next ctx }
}
/// Handlers for /api/success routes /// Handlers for /api/success routes
[<RequireQualifiedAccess>] [<RequireQualifiedAccess>]
module Success = module Success =
open System open System
// GET: /api/success/[id] // GET: /api/success/[id]
let get successId : HttpHandler = let get successId : HttpHandler = authorize >=> fun next ctx -> task {
authorize match! Data.Success.findById (SuccessId successId) (conn ctx) with
>=> fun next ctx -> task { | Some story -> return! json story next ctx
match! Data.Success.findById (SuccessId successId) (conn ctx) with | None -> return! Error.notFound next ctx
| Some story -> return! json story next ctx }
| None -> return! Error.notFound next ctx
}
// GET: /api/success/list // GET: /api/success/list
let all : HttpHandler = let all : HttpHandler = authorize >=> fun next ctx -> task {
authorize let! stories = Data.Success.all (conn ctx)
>=> fun next ctx -> task { return! json stories next ctx
let! stories = Data.Success.all (conn ctx) }
return! json stories next ctx
}
// POST: /api/success/save // POST: /api/success/save
let save : HttpHandler = let save : HttpHandler = authorize >=> fun next ctx -> task {
authorize let citizenId = currentCitizenId ctx
>=> fun next ctx -> task { let dbConn = conn ctx
let citizenId = currentCitizenId ctx let now = (clock ctx).GetCurrentInstant ()
let dbConn = conn ctx let! form = ctx.BindJsonAsync<StoryForm> ()
let now = (clock ctx).GetCurrentInstant () let! success = task {
let! form = ctx.BindJsonAsync<StoryForm> () match form.id with
let! success = task { | "new" ->
match form.id with return Some { id = SuccessId.create ()
| "new" -> citizenId = citizenId
return Some { id = SuccessId.create () recordedOn = now
citizenId = citizenId fromHere = form.fromHere
recordedOn = now source = "profile"
fromHere = form.fromHere story = noneIfEmpty form.story |> Option.map Text
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
} }
| 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 match success with
| Some story -> | Some story ->
do! Data.Success.save story dbConn do! Data.Success.save story dbConn
return! ok next ctx return! ok next ctx
| None -> return! Error.notFound next ctx | None -> return! Error.notFound next ctx
} }
open Giraffe.EndpointRouting open Giraffe.EndpointRouting
/// All available endpoints for the application /// All available endpoints for the application
let allEndpoints = [ let allEndpoints = [
subRoute "/api" [ subRoute "/api" [
subRoute "/citizen" [ subRoute "/citizen" [
GET_HEAD [ GET_HEAD [
routef "/log-on/%s/%s" Citizen.logOn routef "/log-on/%s/%s" Citizen.logOn
routef "/%O" Citizen.get routef "/%O" Citizen.get
]
DELETE [ route "" Citizen.delete ]
] ]
DELETE [ route "" Citizen.delete ] GET_HEAD [ route "/continents" Continent.all ]
] GET_HEAD [ route "/instances" Instances.all ]
GET_HEAD [ route "/continents" Continent.all ] subRoute "/listing" [
GET_HEAD [ route "/instances" Instances.all ] GET_HEAD [
subRoute "/listing" [ routef "/%O" Listing.get
GET_HEAD [ route "/search" Listing.search
routef "/%O" Listing.get routef "/%O/view" Listing.view
route "/search" Listing.search route "s/mine" Listing.mine
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 [ subRoute "/profile" [
routef "/%O" Listing.expire 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 [ subRoute "/success" [
route "s" Listing.add 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 ]
]
] ]
] ]