WIP on PostgreSQL (#37)

src/JobsJobsJobs/Domain/Modules.fs

@@ -26,6 +26,9 @@ module CitizenId =
     
     /// Parse a string into a citizen ID
     let ofString = fromShortGuid >> CitizenId
+    
+    /// Get the GUID value of a citizen ID
+    let value = function CitizenId guid -> guid
 
 
 /// Support functions for citizens
@@ -49,6 +52,9 @@ module ContinentId =
     
     /// Parse a string into a continent ID
     let ofString = fromShortGuid >> ContinentId
+    
+    /// Get the GUID value of a continent ID
+    let value = function ContinentId guid -> guid
 
 
 /// Support functions for listing IDs
@@ -62,6 +68,9 @@ module ListingId =
     
     /// Parse a string into a listing ID
     let ofString = fromShortGuid >> ListingId
+    
+    /// Get the GUID value of a listing ID
+    let value = function ListingId guid -> guid
 
 
 /// Support functions for Markdown strings
@@ -85,6 +94,7 @@ module Profile =
         { id                = CitizenId Guid.Empty
           seekingEmployment = false
           isPublic          = false
+          isPublicLinkable  = false
           continentId       = ContinentId Guid.Empty
           region            = ""
           remoteWork        = false
@@ -107,6 +117,9 @@ module SkillId =
     
     /// Parse a string into a skill ID
     let ofString = fromShortGuid >> SkillId
+    
+    /// Get the GUID value of a skill ID
+    let value = function SkillId guid -> guid
 
 
 /// Support functions for success report IDs
@@ -120,3 +133,6 @@ module SuccessId =
     
     /// Parse a string into a success report ID
     let ofString = fromShortGuid >> SuccessId
+    
+    /// Get the GUID value of a success ID
+    let value = function SuccessId guid -> guid

src/JobsJobsJobs/Domain/Types.fs

@@ -7,11 +7,7 @@ open System
 // fsharplint:disable FieldNames
 
 /// The ID of a user (a citizen of Gitmo Nation)
-type CitizenId =
+type CitizenId = CitizenId of Guid
-    CitizenId of Guid
-with
-    /// The GUID value of this citizen ID
-    member this.Value = this |> function CitizenId guid -> guid
 
 /// A user of Jobs, Jobs, Jobs
 [<CLIMutable; NoComparison; NoEquality>]
@@ -132,6 +128,9 @@ type Profile =
         /// Whether this citizen allows their profile to be a part of the publicly-viewable, anonymous data
         isPublic          : bool
         
+        /// Whether this citizen allows their profile to be viewed via a public link
+        isPublicLinkable  : bool
+        
         /// The ID of the continent on which the citizen resides
         continentId       : ContinentId
         

src/JobsJobsJobs/Server/Data.fs

@@ -1,7 +1,6 @@
 /// Data access functions for Jobs, Jobs, Jobs
 module JobsJobsJobs.Api.Data
 
-open CommonExtensionsAndTypesForNpgsqlFSharp
 open JobsJobsJobs.Domain.Types
 
 /// JSON converters used with RethinkDB persistence
@@ -82,20 +81,14 @@ module Table =
     /// The continent table
     let Continent = "continent"
     
-    /// The job listing table
-    let Listing = "listing"
-    
     /// The citizen employment profile table
     let Profile = "profile"
     
-    /// The profile / skill cross-reference
-    let ProfileSkill = "profile_skill"
-    
     /// The success story table
     let Success = "success"
     
     /// All tables
-    let all () = [ Citizen; Continent; Listing; Profile; Success ]
+    let all () = [ Citizen; Continent; Profile; Success ]
 
 open NodaTime
 open Npgsql
@@ -175,7 +168,7 @@ module Startup =
                     is_public_linkable     BOOLEAN     NOT NULL,
                     continent_id           UUID        NOT NULL,
                     region                 TEXT        NOT NULL,
-                    is_available_remote    BOOLEAN     NOT NULL,
+                    is_available_remotely  BOOLEAN     NOT NULL,
                     is_available_full_time BOOLEAN     NOT NULL,
                     biography              TEXT        NOT NULL,
                     last_updated_on        TIMESTAMPTZ NOT NULL,
@@ -255,33 +248,102 @@ let private deriveDisplayName (it : ReqlExpr) =
               it.G("displayName").Default_("").Ne "", it.G "displayName",
                                                       it.G "mastodonUser")
 
+/// Custom SQL parameter functions
+module Sql =
+    
+    /// Create a citizen ID parameter
+    let citizenId = CitizenId.value >> Sql.uuid
+    
+    /// Create a continent ID parameter
+    let continentId = ContinentId.value >> Sql.uuid
+    
+    /// Create a listing ID parameter
+    let listingId = ListingId.value >> Sql.uuid
+    
+    /// Create a Markdown string parameter
+    let markdown = MarkdownString.toString >> Sql.string
+    
+    /// Create a parameter for the given value
+    let param<'T> name (value : 'T) =
+        name, Sql.parameter (NpgsqlParameter (name, value))
+
+    /// Create a parameter for a possibly-missing value
+    let paramOrNone<'T> name (value : 'T option) =
+        name, Sql.parameter (NpgsqlParameter (name, if Option.isSome value then box value else System.DBNull.Value))
+    
+    /// Create a skill ID parameter
+    let skillId = SkillId.value >> Sql.uuid
+    
+    /// Create a success ID parameter
+    let successId = SuccessId.value >> Sql.uuid
+
+    
 /// Map data results to domain types
 module Map =
     
+    /// Create a continent from a data row
+    let toContinent (row : RowReader) : Continent =
+        {   id   = (row.uuid >> ContinentId) "continent_id"
+            name = row.string                "continent_name"
+        }
+    
     /// Extract a count from a row
     let toCount (row : RowReader) =
         row.int64 "the_count"
     
+    /// Create a job listing from a data row
+    let toListing (row : RowReader) : Listing =
+        {   id            = (row.uuid >> ListingId)         "id"
+            citizenId     = (row.uuid >> CitizenId)         "citizen_id"
+            createdOn     = row.fieldValue<Instant>         "created_on"
+            title         = row.string                      "title"
+            continentId   = (row.uuid >> ContinentId)       "continent_id"
+            region        = row.string                      "region"
+            remoteWork    = row.bool                        "is_remote"
+            isExpired     = row.bool                        "is_expired"
+            updatedOn     = row.fieldValue<Instant>         "updated_on"
+            text          = (row.string >> Text)            "listing_text"
+            neededBy      = row.fieldValueOrNone<LocalDate> "needed_by"
+            wasFilledHere = row.boolOrNone                  "was_filled_here"
+        }
+    
+    /// Create a job listing for viewing from a data row
+    let toListingForView (row : RowReader) : ListingForView =
+        {   listing   = toListing   row
+            continent = toContinent row
+        }
+    
     /// Create a profile from a data row
     let toProfile (row : RowReader) : Profile =
-        {   id                = CitizenId               (row.uuid "citizen_id")
+        {   id                = (row.uuid >> CitizenId)   "citizen_id"
-            seekingEmployment = row.bool                "is_seeking"
+            seekingEmployment = row.bool                  "is_seeking"
-            isPublic          = row.bool                "is_public_searchable"
+            isPublic          = row.bool                  "is_public_searchable"
-            continentId       = ContinentId             (row.uuid "continent_id")
+            isPublicLinkable  = row.bool                  "is_public_linkable"
-            region            = row.string              "region"
+            continentId       = (row.uuid >> ContinentId) "continent_id"
-            remoteWork        = row.bool                "is_available_remote"
+            region            = row.string                "region"
-            fullTime          = row.bool                "is_available_full_time"
+            remoteWork        = row.bool                  "is_available_remotely"
-            biography         = Text                    (row.string "biography")
+            fullTime          = row.bool                  "is_available_full_time"
-            lastUpdatedOn     = row.fieldValue<Instant> "last_updated_on"
+            biography         = (row.string >> Text)      "biography"
-            experience        = row.stringOrNone        "experience" |> Option.map Text
+            lastUpdatedOn     = row.fieldValue<Instant>   "last_updated_on"
+            experience        = row.stringOrNone          "experience" |> Option.map Text
             skills            = []
         }
     
     /// Create a skill from a data row
     let toSkill (row : RowReader) : Skill =
-        {   id          = SkillId          (row.uuid "id")
+        {   id          = (row.uuid >> SkillId) "id"
-            description = row.string       "description"
+            description = row.string            "description"
-            notes       = row.stringOrNone "notes"
+            notes       = row.stringOrNone      "notes"
+        }
+    
+    /// Create a success story from a data row
+    let toSuccess (row : RowReader) : Success =
+        {   id         = (row.uuid >> SuccessId) "id"
+            citizenId  = (row.uuid >> CitizenId) "citizen_id"
+            recordedOn = row.fieldValue<Instant> "recorded_on"
+            fromHere   = row.bool                "was_from_here"
+            source     = row.string              "source"
+            story      = row.stringOrNone        "story" |> Option.map Text
         }
 
 
@@ -300,7 +362,7 @@ module Profile =
         |> Sql.executeRowAsync Map.toCount
 
     /// Find a profile by citizen ID
-    let findById (citizenId : CitizenId) conn = backgroundTask {
+    let findById citizenId conn = backgroundTask {
         let! tryProfile =
             Sql.existingConnection conn
             |> Sql.query
@@ -309,31 +371,82 @@ module Profile =
                         INNER JOIN jjj.citizen ON c.id = p.citizen_id
                   WHERE p.citizen_id = @id
                     AND c.is_legacy  = FALSE"
-            |> Sql.parameters [ "@id", Sql.uuid citizenId.Value ]
+            |> Sql.parameters [ "@id", Sql.citizenId citizenId ]
             |> Sql.executeAsync Map.toProfile
         match List.tryHead tryProfile with
         | Some profile ->
             let! skills =
                 Sql.existingConnection conn
                 |> Sql.query "SELECT * FROM jjj.profile_skill WHERE citizen_id = @id"
-                |> Sql.parameters [ "@id", Sql.uuid citizenId.Value ]
+                |> Sql.parameters [ "@id", Sql.citizenId citizenId ]
                 |> Sql.executeAsync Map.toSkill
             return Some { profile with skills = skills }
         | None -> return None
     }
+    
     /// Insert or update a profile
-    let save (profile : Profile) conn =
+    let save (profile : Profile) conn = backgroundTask {
-        fromTable Table.Profile
+        let! _ =
-        |> get profile.id
+            Sql.existingConnection conn
-        |> replace profile
+            |> Sql.executeTransactionAsync [
-        |> write conn
+                "INSERT INTO jjj.profile (
-  
+                    citizen_id, is_seeking, is_public_searchable, is_public_linkable, continent_id, region,
+                    is_available_remotely, is_available_full_time, biography, last_updated_on, experience
+                ) VALUES (
+                    @citizenId, @isSeeking, @isPublicSearchable, @isPublicLinkable, @continentId, @region,
+                    @isAvailableRemotely, @isAvailableFullTime, @biography, @lastUpdatedOn, @experience
+                ) ON CONFLICT (citizen_id) DO UPDATE
+                SET is_seeking             = EXCLUDED.is_seeking,
+                    is_public_searchable   = EXCLUDED.is_public_searchable,
+                    is_public_linkable     = EXCLUDED.is_public_linkable,
+                    continent_id           = EXCLUDED.continent_id,
+                    region                 = EXCLUDED.region,
+                    is_available_remotely  = EXCLUDED.is_available_remotely,
+                    is_available_full_time = EXCLUDED.is_available_full_time,
+                    biography              = EXCLUDED.biography,
+                    last_updated_on        = EXCLUDED.last_updated_on,
+                    experience             = EXCLUDED.experience",
+                [ [ "@citizenId",           Sql.citizenId    profile.id
+                    "@isSeeking",           Sql.bool         profile.seekingEmployment
+                    "@isPublicSearchable",  Sql.bool         profile.isPublic
+                    "@isPublicLinkable",    Sql.bool         profile.isPublicLinkable
+                    "@continentId",         Sql.continentId  profile.continentId
+                    "@region",              Sql.string       profile.region
+                    "@isAvailableRemotely", Sql.bool         profile.remoteWork
+                    "@isAvailableFullTime", Sql.bool         profile.fullTime
+                    "@biography",           Sql.markdown     profile.biography
+                    "@lastUpdatedOn"        |>Sql.param<|    profile.lastUpdatedOn
+                    "@experience",          Sql.stringOrNone (Option.map MarkdownString.toString profile.experience)
+                ] ]
+                
+                "INSERT INTO jjj.profile (
+                    id, citizen_id, description, notes
+                ) VALUES (
+                    @id, @citizenId, @description, @notes
+                ) ON CONFLICT (id) DO UPDATE
+                SET description = EXCLUDED.description,
+                    notes       = EXCLUDED.notes",
+                profile.skills
+                |> List.map (fun skill -> [
+                    "@id",          Sql.skillId      skill.id
+                    "@citizenId",   Sql.citizenId    profile.id
+                    "@description", Sql.string       skill.description
+                    "@notes"      , Sql.stringOrNone skill.notes
+                ])
+                
+                $"""DELETE FROM jjj.profile
+                    WHERE id NOT IN ({profile.skills |> List.mapi (fun idx _ -> $"@id{idx}") |> String.concat ", "})""",
+                [   profile.skills |> List.mapi (fun idx skill -> $"@id{idx}", Sql.skillId skill.id) ]
+        ]
+        ()
+    }
+    
     /// Delete a citizen's profile
-    let delete (citizenId : CitizenId) conn = backgroundTask {
+    let delete citizenId conn = backgroundTask {
         let! _ =
             Sql.existingConnection conn
             |> Sql.query "DELETE FROM jjj.profile WHERE citizen_id = @id"
-            |> Sql.parameters [ "@id", Sql.uuid citizenId.Value ]
+            |> Sql.parameters [ "@id", Sql.citizenId citizenId ]
             |> Sql.executeNonQueryAsync
         ()
     }
@@ -433,11 +546,11 @@ module Citizen =
         |> write conn
   
     /// Delete a citizen
-    let delete (citizenId : CitizenId) conn = backgroundTask {
+    let delete citizenId conn = backgroundTask {
         let! _ =
             Sql.existingConnection conn
             |> Sql.query "DELETE FROM citizen WHERE id = @id"
-            |> Sql.parameters [ "@id", Sql.uuid citizenId.Value ]
+            |> Sql.parameters [ "@id", Sql.citizenId citizenId ]
             |> Sql.executeNonQueryAsync
         ()
     }
@@ -456,89 +569,138 @@ module Continent =
 
     /// Get all continents
     let all conn =
-        fromTable Table.Continent
+        Sql.existingConnection conn
-        |> result<Continent list> conn
+        |> Sql.query "SELECT id AS continent_id, name AS continent_name FROM jjj.continent"
+        |> Sql.executeAsync Map.toContinent
   
     /// Get a continent by its ID
-    let findById (contId : ContinentId) conn =
+    let findById contId conn = backgroundTask {
-        fromTable Table.Continent
+        let! continent =
-        |> get contId
+            Sql.existingConnection conn
-        |> resultOption<Continent> conn
+            |> Sql.query "SELECT id AS continent_id, name AS continent_name FROM jjj.continent WHERE id = @id"
+            |> Sql.parameters [ "@id", Sql.continentId contId ]
+            |> Sql.executeAsync Map.toContinent
+        return List.tryHead continent
+    }
 
 
 /// Job listing data access functions
 [<RequireQualifiedAccess>]
 module Listing =  
 
-    /// Convert a joined query to the form needed for ListingForView deserialization
+    /// The SQL to select the listing and continent fields
-    let private toListingForView (it : ReqlExpr) : obj = {| listing = it.G "left"; continent = it.G "right" |}
+    let private forViewSql =
+        "SELECT l.*, c.name AS continent_name
+           FROM jjj.listing l
+                INNER JOIN jjj.continent c ON c.id = l.continent_id"
     
     /// Find all job listings posted by the given citizen
-    let findByCitizen (citizenId : CitizenId) conn =
+    let findByCitizen citizenId conn =
-        fromTable Table.Listing
+        Sql.existingConnection conn
-        |> getAllWithIndex [ citizenId ] (nameof citizenId)
+        |> Sql.query $"{forViewSql} WHERE l.citizen_id = @citizenId"
-        |> eqJoin "continentId" (fromTable Table.Continent)
+        |> Sql.parameters [ "@citizenId", Sql.citizenId citizenId ]
-        |> mapFunc toListingForView
+        |> Sql.executeAsync Map.toListingForView
-        |> result<ListingForView list> conn
   
     /// Find a listing by its ID
-    let findById (listingId : ListingId) conn =
+    let findById listingId conn = backgroundTask {
-        fromTable Table.Listing
-        |> get listingId
-        |> resultOption<Listing> conn
-  
-    /// Find a listing by its ID for viewing (includes continent information)
-    let findByIdForView (listingId : ListingId) conn = task {
         let! listing =
-            fromTable Table.Listing
+            Sql.existingConnection conn
-            |> filter {| id = listingId |}
+            |> Sql.query "SELECT * FROM jjj.listing WHERE id = @id"
-            |> eqJoin "continentId" (fromTable Table.Continent)
+            |> Sql.parameters [ "@id", Sql.listingId listingId ]
-            |> mapFunc toListingForView
+            |> Sql.executeAsync Map.toListing
-            |> result<ListingForView list> conn
         return List.tryHead listing
     }
   
-    /// Add a listing
+    /// Find a listing by its ID for viewing (includes continent information)
-    let add (listing : Listing) conn =
+    let findByIdForView (listingId : ListingId) conn = backgroundTask {
-        fromTable Table.Listing
+        let! listing =
-        |> insert listing
+            Sql.existingConnection conn
-        |> write conn
+            |> Sql.query $"{forViewSql} WHERE l.id = @id"
+            |> Sql.parameters [ "@id", Sql.listingId listingId ]
+            |> Sql.executeAsync Map.toListingForView
+        return List.tryHead listing
+    }
+  
+    /// Add or update a listing
+    let save (listing : Listing) conn = backgroundTask {
+        let! _ =
+            Sql.existingConnection conn
+            |> Sql.query
+                "INSERT INTO jjj.listing (
+                    id, citizen_id, created_on, title, continent_id, region, is_remote, is_expired, updated_on,
+                    listing_text, needed_by, was_filled_here
+                ) VALUES (
+                    @id, @citizenId, @createdOn, @title, @continentId, @region, @isRemote, @isExpired, @updatedOn,
+                    @text, @neededBy, @wasFilledHere
+                ) ON CONFLICT (id) DO UPDATE
+                SET title           = EXCLUDED.title,
+                    continent_id    = EXCLUDED.continent_id,
+                    region          = EXCLUDED.region,
+                    is_remote       = EXCLUDED.is_remote,
+                    is_expired      = EXCLUDED.is_expired,
+                    updated_on      = EXCLUDED.updated_on,
+                    listing_text    = EXCLUDED.listing_text,
+                    needed_by       = EXCLUDED.needed_by,
+                    was_filled_here = EXCLUDED.was_filled_here"
+            |> Sql.parameters
+                [   "@id",            Sql.listingId       listing.id
+                    "@citizenId",     Sql.citizenId       listing.citizenId
+                    "@createdOn"      |>Sql.param<|       listing.createdOn
+                    "@title",         Sql.string          listing.title
+                    "@continentId",   Sql.continentId     listing.continentId
+                    "@region",        Sql.string          listing.region
+                    "@isRemote",      Sql.bool            listing.remoteWork
+                    "@isExpired",     Sql.bool            listing.isExpired
+                    "@updatedOn"      |>Sql.param<|       listing.updatedOn
+                    "@text",          Sql.markdown        listing.text
+                    "@neededBy"       |>Sql.paramOrNone<| listing.neededBy
+                    "@wasFilledHere", Sql.boolOrNone      listing.wasFilledHere
+                    
+                ]
+            |> Sql.executeNonQueryAsync
+        ()
+    }
   
-    /// Update a listing
-    let update (listing : Listing) conn =
-        fromTable Table.Listing
-        |> get listing.id
-        |> replace listing
-        |> write conn
-
     /// Expire a listing
-    let expire (listingId : ListingId) (fromHere : bool) (now : Instant) conn =
+    let expire listingId fromHere (now : Instant) conn = backgroundTask {
-        (fromTable Table.Listing
+        let! _ =
-         |> get listingId)
+            Sql.existingConnection conn
-            .Update {| isExpired = true; wasFilledHere = fromHere; updatedOn = now |}
+            |> Sql.query
-        |> write conn
+                "UPDATE jjj.listing
-
+                    SET is_expired      = TRUE,
+                        was_filled_here = @wasFilledHere,
+                        updated_on      = @updatedOn
+                  WHERE id = @id"
+            |> Sql.parameters
+                [   "@wasFilledHere", Sql.bool      fromHere
+                    "@updatedOn"      |>Sql.param<| now
+                    "@id",            Sql.listingId listingId
+                ]
+            |> Sql.executeNonQueryAsync
+        ()
+    }
+    
     /// Search job listings
     let search (search : ListingSearch) conn =
-        fromTable Table.Listing
+        let filters = seq {
-        |> getAllWithIndex [ false ] "isExpired"
+            match search.continentId with
-        |> applyFilters
+            | Some contId ->
-            [ match search.continentId with
+                "l.continent = @continentId", [ "@continentId", Sql.continentId (ContinentId.ofString contId) ]
-              | Some contId -> yield filter {| continentId = ContinentId.ofString contId |}
+            | None -> ()
-              | None -> ()
+            match search.region with
-              match search.region with
+            | Some region -> "l.region ILIKE '%@region%'", [ "@region", Sql.string region ]
-              | Some rgn -> yield filterFunc (fun it -> it.G(nameof search.region).Match (regexContains rgn))
+            | None -> ()
-              | None -> ()
+            if search.remoteWork <> "" then
-              match search.remoteWork with
+                "l.is_remote = @isRemote", ["@isRemote", Sql.bool (search.remoteWork = "yes") ]
-              | "" -> ()
+            match search.text with
-              | _ -> yield filter {| remoteWork = search.remoteWork = "yes" |}
+            | Some text -> "l.listing_text ILIKE '%@text%'", [ "@text", Sql.string text ]
-              match search.text with
+            | None -> ()
-              | Some text -> yield filterFunc (fun it -> it.G(nameof search.text).Match (regexContains text))
+        }
-              | None -> ()
+        let filterSql = filters |> Seq.map fst |> String.concat " AND "
-            ]
+        Sql.existingConnection conn
-        |> eqJoin "continentId" (fromTable Table.Continent)
+        |> Sql.query $"{forViewSql} WHERE l.is_expired = FALSE{filterSql}"
-        |> mapFunc toListingForView
+        |> Sql.parameters (filters |> Seq.collect snd |> List.ofSeq)
-        |> result<ListingForView list> conn
+        |> Sql.executeAsync Map.toListingForView
 
 
 /// Success story data access functions
@@ -546,18 +708,39 @@ module Listing =
 module Success =
 
     /// Find a success report by its ID
-    let findById (successId : SuccessId) conn =
+    let findById successId conn = backgroundTask {
-        fromTable Table.Success
+        let! success =
-        |> get successId
+            Sql.existingConnection conn
-        |> resultOption conn
+            |> Sql.query "SELECT * FROM jjj.success WHERE id = @id"
+            |> Sql.parameters [ "@id", Sql.successId successId ]
+            |> Sql.executeAsync Map.toSuccess
+        return List.tryHead success
+    }
 
     /// Insert or update a success story
-    let save (success : Success) conn =
+    let save (success : Success) conn = backgroundTask {
-        fromTable Table.Success
+        let! _ =
-        |> get success.id
+            Sql.existingConnection conn
-        |> replace success
+            |> Sql.query
-        |> write conn
+                "INSERT INTO jjj.success (
-
+                    id, citizen_id, recorded_on, was_from_here, source, story
+                ) VALUES (
+                    @id, @citizenId, @recordedOn, @wasFromHere, @source, @story
+                ) ON CONFLICT (id) DO UPDATE
+                SET was_from_here = EXCLUDED.was_from_here,
+                    story         = EXCLUDED.story"
+            |> Sql.parameters
+                [   "@id",          Sql.successId    success.id
+                    "@citizenId",   Sql.citizenId    success.citizenId
+                    "@recordedOn"   |>Sql.param<|    success.recordedOn
+                    "@wasFromHere", Sql.bool         success.fromHere
+                    "@source",      Sql.string       success.source
+                    "@story",       Sql.stringOrNone (Option.map MarkdownString.toString success.story)
+                ]
+            |> Sql.executeNonQueryAsync
+        ()
+    }
+    
     // Retrieve all success stories  
     let all conn =
         fromTable Table.Success