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