Remove Marten; implement own doc storage

- Begin work on migration

src/JobsJobsJobs.V3Migration/JobsJobsJobs.V3Migration.fsproj

@@ -0,0 +1,12 @@
+<Project Sdk="Microsoft.NET.Sdk">
+
+    <PropertyGroup>
+        <OutputType>Exe</OutputType>
+        <TargetFramework>net6.0</TargetFramework>
+    </PropertyGroup>
+
+    <ItemGroup>
+        <Compile Include="Program.fs"/>
+    </ItemGroup>
+
+</Project>

src/JobsJobsJobs.V3Migration/Program.fs

@@ -0,0 +1,4 @@
+
+
+// For more information see https://aka.ms/fsharp-console-apps
+printfn "Hello from F#"

src/JobsJobsJobs.sln

@@ -19,6 +19,8 @@ Project("{F2A71F9B-5D33-465A-A702-920D77279786}") = "Api", "JobsJobsJobs\Server\
 EndProject
 Project("{F2A71F9B-5D33-465A-A702-920D77279786}") = "JobsJobsJobs.Data", "JobsJobsJobs\JobsJobsJobs.Data\JobsJobsJobs.Data.fsproj", "{30CC1E7C-A843-4DAC-9058-E7C6ACBCE85D}"
 EndProject
+Project("{F2A71F9B-5D33-465A-A702-920D77279786}") = "JobsJobsJobs.V3Migration", "JobsJobsJobs\JobsJobsJobs.V3Migration\JobsJobsJobs.V3Migration.fsproj", "{DC3E225D-9720-44E8-86AE-DEE71262C9F0}"
+EndProject
 Global
 	GlobalSection(SolutionConfigurationPlatforms) = preSolution
 		Debug|Any CPU = Debug|Any CPU
@@ -37,6 +39,10 @@ Global
 		{30CC1E7C-A843-4DAC-9058-E7C6ACBCE85D}.Debug|Any CPU.Build.0 = Debug|Any CPU
 		{30CC1E7C-A843-4DAC-9058-E7C6ACBCE85D}.Release|Any CPU.ActiveCfg = Release|Any CPU
 		{30CC1E7C-A843-4DAC-9058-E7C6ACBCE85D}.Release|Any CPU.Build.0 = Release|Any CPU
+		{DC3E225D-9720-44E8-86AE-DEE71262C9F0}.Debug|Any CPU.ActiveCfg = Debug|Any CPU
+		{DC3E225D-9720-44E8-86AE-DEE71262C9F0}.Debug|Any CPU.Build.0 = Debug|Any CPU
+		{DC3E225D-9720-44E8-86AE-DEE71262C9F0}.Release|Any CPU.ActiveCfg = Release|Any CPU
+		{DC3E225D-9720-44E8-86AE-DEE71262C9F0}.Release|Any CPU.Build.0 = Release|Any CPU
 	EndGlobalSection
 	GlobalSection(SolutionProperties) = preSolution
 		HideSolutionNode = FALSE
@@ -48,5 +54,6 @@ Global
 		{C81278DA-DA97-4E55-AB39-4B88565B615D} = {FA833B24-B8F6-4CE6-A044-99257EAC02FF}
 		{8F5A3D1E-562B-4F27-9787-6CB14B35E69E} = {FA833B24-B8F6-4CE6-A044-99257EAC02FF}
 		{30CC1E7C-A843-4DAC-9058-E7C6ACBCE85D} = {FA833B24-B8F6-4CE6-A044-99257EAC02FF}
+		{DC3E225D-9720-44E8-86AE-DEE71262C9F0} = {FA833B24-B8F6-4CE6-A044-99257EAC02FF}
 	EndGlobalSection
 EndGlobal

src/JobsJobsJobs/Domain/Types.fs

@@ -38,9 +38,6 @@ type Citizen =
         /// Whether this is a legacy citizen
         isLegacy : bool
     }
-with
-    /// Unwrapped ID for database PK use
-    member this.DbId = CitizenId.value this.id
 
 /// Support functions for citizens
 module Citizen =
@@ -72,9 +69,6 @@ type Continent =
         /// The name of the continent
         name : string
     }
-with
-    /// Unwrapped ID for database PK use
-    member this.DbId = ContinentId.value this.id
 
 /// Support functions for continents
 module Continent =
@@ -170,9 +164,6 @@ type SecurityInfo =
         /// When the token expires
         TokenExpires : Instant option
     }
-with
-    /// Unwrapped ID for database PK use
-    member this.DbId = CitizenId.value this.Id
 
 /// Functions to support security info
 module SecurityInfo =

src/JobsJobsJobs/JobsJobsJobs.Data/Data.fs

@@ -1,137 +1,124 @@
 namespace JobsJobsJobs.Data
 
-open System
+/// Constants for tables used by Jobs, Jobs, Jobs
-open JobsJobsJobs.Domain
+module Table =
-
-/// Wrapper documents for our record types
-module Documents =
     
-    /// A generic type that keeps its ID in sync with the ID value for its content
+    /// Citizens
-    [<AllowNullLiteral>]
+    [<Literal>]
-    type Document<'T> (initialValue : 'T, toId : 'T -> Guid) =
+    let Citizen = "citizen"
-        
-        /// The current value for this document
-        let mutable value = initialValue
-        
-        /// The ID for this document
-        member val Id = toId initialValue with get, set
-        
-        /// The value for this document
-        member this.Value
-          with get () = value
-           and set (v : 'T) =
-               value   <- v
-               this.Id <- toId v
-        
-        /// Convert a document to its value
-        static member ToValue (doc : Document<'T>) =
-            doc.Value
-        
-        /// Convert a document to its value, or None if the document is null
-        static member TryValue (doc : Document<'T>) =
-            if isNull doc then None else Some doc.Value
     
-    /// A citizen document
+    /// Continents
-    [<AllowNullLiteral>]
+    [<Literal>]
-    type CitizenDocument (citizen : Citizen) =
+    let Continent = "continent"
-        inherit Document<Citizen> (citizen, fun c -> CitizenId.value c.id)
-        new() = CitizenDocument Citizen.empty
     
-    /// A continent document
+    /// Job Listings
-    [<AllowNullLiteral>]
+    [<Literal>]
-    type ContinentDocument (continent : Continent) =
+    let Listing = "listing"
-        inherit Document<Continent> (continent, fun c -> ContinentId.value c.id)
-        new () = ContinentDocument Continent.empty
     
-    /// A job listing document
+    /// Employment Profiles
-    [<AllowNullLiteral>]
+    [<Literal>]
-    type ListingDocument (listing : Listing) =
+    let Profile = "profile"
-        inherit Document<Listing> (listing, fun l -> ListingId.value l.id)
-        new () = ListingDocument Listing.empty
     
-    /// A profile document
+    /// User Security Information
-    [<AllowNullLiteral>]
+    [<Literal>]
-    type ProfileDocument (profile : Profile) =
+    let SecurityInfo = "security_info"
-        inherit Document<Profile> (profile, fun p -> CitizenId.value p.id)
-        new () = ProfileDocument Profile.empty
     
-    /// A security information document
+    /// Success Stories
-    [<AllowNullLiteral>]
+    [<Literal>]
-    type SecurityInfoDocument (securityInfo : SecurityInfo) =
+    let Success = "success"
-        inherit Document<SecurityInfo> (securityInfo, fun si -> CitizenId.value si.Id)
-        new () = SecurityInfoDocument SecurityInfo.empty
-    
-    /// A success story document
-    [<AllowNullLiteral>]
-    type SuccessDocument (success : Success) =
-        inherit Document<Success> (success, fun s -> SuccessId.value s.id)
-        new () = SuccessDocument Success.empty
 
 
-open Documents
+open Npgsql.FSharp
-open Marten
 
 /// Connection management for the Marten document store
-module Connection =
+module DataConnection =
     
-    open Marten.NodaTime
     open Microsoft.Extensions.Configuration
-    open Weasel.Core
     
     /// The configuration from which a document store will be created
     let mutable private config : IConfiguration option = None
     
-    /// Lazy initialization for the Marten document store, constructed when setUp() is called
+    /// Get the connection string
-    let private lazyStore = lazy (task {
+    let connection () =
         match config with
-        | Some cfg ->
+        | Some cfg -> Sql.connect (cfg.GetConnectionString "PostgreSQL")
-            let store =
+        | None -> invalidOp "Connection.setUp() must be called before accessing the database"
-                DocumentStore.For(fun opts ->
+    
-                    opts.Connection (cfg.GetConnectionString "PostgreSQL")
+    /// Create tables
-                    opts.RegisterDocumentTypes [
+    let private createTables () = backgroundTask {
-                        typeof<CitizenDocument>; typeof<ContinentDocument>;    typeof<ListingDocument>
+        let sql =
-                        typeof<ProfileDocument>; typeof<SecurityInfoDocument>; typeof<SuccessDocument>
+            [ Table.Citizen; Table.Continent; Table.Listing; Table.Profile; Table.SecurityInfo; Table.Success ]
-                    ]
+            |> List.map (fun table ->
-                    opts.DatabaseSchemaName      <- "jjj"
+                $"CREATE TABLE IF NOT EXISTS jjj.{table} (id TEXT NOT NULL PRIMARY KEY, data JSONB NOT NULL)")
-                    opts.AutoCreateSchemaObjects <- AutoCreate.CreateOrUpdate
+            |> String.concat "; "
-                    opts.UseNodaTime ()
+        let! _ =
-                    
+            connection ()
-                    let _ = opts.Schema.For<CitizenDocument>().DocumentAlias      "citizen"
+            |> Sql.executeTransactionAsync [ sql, [ [] ] ]
-                    let _ = opts.Schema.For<ContinentDocument>().DocumentAlias    "continent"
+        // TODO: prudent indexes
-                    let _ = opts.Schema.For<ListingDocument>().DocumentAlias      "listing"
+        ()
-                    let _ = opts.Schema.For<ProfileDocument>().DocumentAlias      "profile"
+    }
-                    let _ = opts.Schema.For<SecurityInfoDocument>().DocumentAlias "security_info"
+    
-                    let _ = opts.Schema.For<SuccessDocument>().DocumentAlias      "success"
-                    ())
-            do! store.Storage.ApplyAllConfiguredChangesToDatabaseAsync ()
-            return Ok store
-        | None -> return Error "Connection.setUp() must be called before accessing a document session"
-    })
-
     /// Set up the data connection from the given configuration
-    let setUp (cfg : IConfiguration) =
+    let setUp (cfg : IConfiguration) = backgroundTask {
         config <- Some cfg
-        lazyStore.Force ()
+        do! createTables ()
+    }
+
+
+open DataConnection
+
+/// Helper functions for data manipulation
+[<AutoOpen>]
+module private Helpers =
     
-    /// A read-only document session
+    open System.Text.Json
-    let querySession () =
+    open System.Threading.Tasks
-        match lazyStore.Force().Result with
-        | Ok store -> store.QuerySession ()
-        | Error msg -> raise (invalidOp msg)
     
-    /// A read/write document session
+    /// Map the data field to the requested document type
-    let docSession () =
+    let toDocumentFrom<'T> fieldName (row : RowReader) =
-        match lazyStore.Force().Result with
+        JsonSerializer.Deserialize<'T> (row.string fieldName, Json.options)
-        | Ok store -> store.LightweightSession ()
+    
-        | Error msg -> raise (invalidOp msg)
+    /// Map the data field to the requested document type
+    let toDocument<'T> (row : RowReader) = toDocumentFrom<'T> "data" row
+    
+    /// Get a document
+    let getDocument<'T> table docId sqlProps : Task<'T option> = backgroundTask {
+        let! doc =
+            Sql.query $"SELECT * FROM jjj.%s{table} where id = @id" sqlProps
+            |> Sql.parameters [ "@id", Sql.string docId ]
+            |> Sql.executeAsync toDocument
+        return List.tryHead doc
+    }
+    
+    /// Save a document
+    let saveDocument<'T> table docId (doc : 'T) sqlProps = backgroundTask {
+        let! _ =
+            Sql.query
+                $"INSERT INTO jjj.%s{table} (id, data) VALUES (@id, @data)
+                  ON CONFLICT (id) DO UPDATE SET data = EXCLUDED.data"
+                sqlProps
+            |> Sql.parameters
+                   [ "@id",   Sql.string docId
+                     "@data", Sql.jsonb (JsonSerializer.Serialize (doc, Json.options)) ]
+            |> Sql.executeNonQueryAsync
+        ()
+    }
+    
+    /// Create a match-anywhere clause for a LIKE or ILIKE clause
+    let like value =
+        Sql.string $"%%%s{value}%%"
+    
+    /// The JSON access operator ->> makes values text; this makes a parameter that will compare the properly
+    let jsonBool value =
+        Sql.string (if value then "true" else "false")
+    
+    /// Get the SQL for a search WHERE clause
+    let searchSql criteria =
+        let sql = criteria |> List.map fst |> String.concat " AND "
+        if sql = "" then "" else $"AND {sql}"
 
 
-/// Shorthand for the generic dictionary
+open JobsJobsJobs.Domain
-type Dict<'TKey, 'TValue> = System.Collections.Generic.Dictionary<'TKey, 'TValue>
-
-
-open System.Linq
-open Connection
 
 /// Citizen data access functions
 [<RequireQualifiedAccess>]
@@ -139,67 +126,61 @@ module Citizens =
 
     /// Delete a citizen by their ID
     let deleteById citizenId = backgroundTask {
-        use session = docSession ()
+        let! _ =
-        session.DeleteWhere<SuccessDocument>(fun s -> s.Value.citizenId = citizenId)
+            connection ()
-        session.DeleteWhere<ListingDocument>(fun l -> l.Value.citizenId = citizenId)
+            |> Sql.executeTransactionAsync [
-        let docId = CitizenId.value citizenId
+                "DELETE FROM jjj.success       WHERE data->>'citizenId' = @id;
-        session.Delete<ProfileDocument>      docId
+                 DELETE FROM jjj.listing       WHERE data->>'citizenId' = @id;
-        session.Delete<SecurityInfoDocument> docId
+                 DELETE FROM jjj.profile       WHERE id                 = @id;
-        session.Delete<CitizenDocument>      docId
+                 DELETE FROM jjj.security_info WHERE id                 = @id;
-        do! session.SaveChangesAsync ()
+                 DELETE FROM jjj.citizen       WHERE id                 = @id",
+                [ [ "@id", Sql.string (CitizenId.toString citizenId) ] ]
+            ]
+        ()
     }
     
     /// Find a citizen by their ID
     let findById citizenId = backgroundTask {
-        use session = querySession ()
+        match! connection () |> getDocument<Citizen> Table.Citizen (CitizenId.toString citizenId) with
-        let! citizen = session.LoadAsync<CitizenDocument> (CitizenId.value citizenId)
+        | Some c when not c.isLegacy -> return Some c
-        return
+        | Some _
-            match Document.TryValue citizen with
+        | None -> return None
-            | Some c when not c.isLegacy -> Some c
-            | Some _
-            | None -> None
     }
     
     /// Save a citizen
-    let save (citizen : Citizen) = backgroundTask {
+    let save (citizen : Citizen) =
-        use session = docSession ()
+        connection () |> saveDocument Table.Citizen (CitizenId.toString citizen.id) citizen
-        session.Store (CitizenDocument citizen)
-        do! session.SaveChangesAsync ()
-    }
     
     /// Attempt a user log on
     let tryLogOn email (pwCheck : string -> bool) now = backgroundTask {
-        use session = docSession ()
+        let  connProps  = connection ()
         let! tryCitizen =
-            session.Query<CitizenDocument>()
+            connProps
-                .Where(fun c -> c.Value.email = email && not c.Value.isLegacy)
+            |> Sql.query $"SELECT * FROM jjj.{Table.Citizen} WHERE data->>email = @email AND data->>isValue <> 'true'"
-                .SingleOrDefaultAsync ()
+            |> Sql.parameters [ "@email", Sql.string email ]
-        match Document.TryValue tryCitizen with
+            |> Sql.executeAsync toDocument<Citizen>
+        match List.tryHead tryCitizen with
         | Some citizen ->
-            let! tryInfo = session.LoadAsync<SecurityInfoDocument> (CitizenId.value citizen.id)
+            let citizenId = CitizenId.toString citizen.id
+            let! tryInfo = getDocument<SecurityInfo> Table.SecurityInfo citizenId connProps
             let! info = backgroundTask {
-                match Document.TryValue tryInfo with
+                match tryInfo with
                 | Some it -> return it
                 | None ->
                     let it = { SecurityInfo.empty with Id = citizen.id }
-                    session.Store (SecurityInfoDocument it)
+                    do! saveDocument Table.SecurityInfo citizenId it connProps
-                    do! session.SaveChangesAsync ()
                     return it
             }
             if info.AccountLocked then return Error "Log on unsuccessful (Account Locked)"
             elif pwCheck citizen.passwordHash then
-                session.Store (SecurityInfoDocument { info with FailedLogOnAttempts = 0})
+                do! saveDocument Table.SecurityInfo citizenId { info    with FailedLogOnAttempts = 0   } connProps
-                session.Store (CitizenDocument { citizen with lastSeenOn = now})
+                do! saveDocument Table.Citizen      citizenId { citizen with lastSeenOn          = now } connProps
-                do! session.SaveChangesAsync ()
                 return Ok { citizen with lastSeenOn = now }
             else
                 let locked = info.FailedLogOnAttempts >= 4
-                session.Store (SecurityInfoDocument {
+                do! saveDocument Table.SecurityInfo citizenId
-                    info with
+                        { info with FailedLogOnAttempts = info.FailedLogOnAttempts + 1; AccountLocked = locked }
-                        FailedLogOnAttempts = info.FailedLogOnAttempts + 1
+                        connProps
-                        AccountLocked       = locked
-                })
-                do! session.SaveChangesAsync ()
                 return Error $"""Log on unsuccessful{if locked then " - Account is now locked" else ""}"""
         | None -> return Error "Log on unsuccessful"
     }
@@ -210,18 +191,14 @@ module Citizens =
 module Continents =
     
     /// Retrieve all continents
-    let all () = backgroundTask {
+    let all () =
-        use session = querySession ()
+        connection ()
-        let! it = session.Query<ContinentDocument>().AsQueryable().ToListAsync ()
+        |> Sql.query $"SELECT * FROM jjj.{Table.Continent}"
-        return it |> Seq.map Document.ToValue |> List.ofSeq
+        |> Sql.executeAsync toDocument<Continent>
-    }
     
     /// Retrieve a continent by its ID
-    let findById continentId = backgroundTask {
+    let findById continentId =
-        use session = querySession ()
+        connection () |> getDocument<Continent> Table.Continent (ContinentId.toString continentId)
-        let! tryContinent = session.LoadAsync<ContinentDocument> (ContinentId.value continentId)
-        return Document.TryValue tryContinent
-    }
 
 
 open JobsJobsJobs.Domain.SharedTypes
@@ -230,29 +207,26 @@ open JobsJobsJobs.Domain.SharedTypes
 [<RequireQualifiedAccess>]
 module Listings =
     
+    /// The SQL to select a listing view
+    let viewSql =
+        $"SELECT l.*, c.data AS cont_data
+            FROM jjj.{Table.Listing} l
+                 INNER JOIN jjj.{Table.Continent} c ON c.id = l.data->>'continentId'"
+    
+    /// Map a result for a listing view
+    let private toListingForView row =
+        { listing = toDocument<Listing> row; continent = toDocumentFrom<Continent> "cont_data" row }
+    
     /// Find all job listings posted by the given citizen
-    let findByCitizen citizenId = backgroundTask {
+    let findByCitizen citizenId =
-        use  session    = querySession ()
+        connection ()
-        let  continents = Dict<Guid, ContinentDocument> ()
+        |> Sql.query $"{viewSql} WHERE l.data->>'citizenId' = @citizenId AND l.data->>'isLegacy' <> 'true'"
-        let! listings   =
+        |> Sql.parameters [ "@citizenId", Sql.string (CitizenId.toString citizenId) ]
-            session.Query<ListingDocument>()
+        |> Sql.executeAsync toListingForView
-                .Include((fun l -> l.Value.continentId :> obj), continents)
-                .Where(fun l -> l.Value.citizenId = citizenId && not l.Value.isLegacy)
-                .ToListAsync ()
-        return
-            listings
-            |> Seq.map (fun l -> {
-                listing   = l.Value
-                continent = continents[ContinentId.value l.Value.continentId].Value
-            })
-            |> List.ofSeq
-    }
     
     /// Find a listing by its ID
     let findById listingId = backgroundTask {
-        use  session    = querySession ()
+        match! connection () |> getDocument<Listing> Table.Listing (ListingId.toString listingId) with
-        let! tryListing = session.LoadAsync<ListingDocument> (ListingId.value listingId)
-        match Document.TryValue tryListing with
         | Some listing when not listing.isLegacy -> return Some listing
         | Some _
         | None -> return None
@@ -260,60 +234,40 @@ module Listings =
     
     /// Find a listing by its ID for viewing (includes continent information)
     let findByIdForView listingId = backgroundTask {
-        use session = querySession ()
-        let mutable continent : ContinentDocument = null
         let! tryListing =
-            session.Query<ListingDocument>()
+            connection ()
-                .Include((fun l -> l.Value.continentId :> obj), fun c -> continent <- c)
+            |> Sql.query $"{viewSql} WHERE id = @id AND l.data->>'isLegacy' <> 'true'"
-                .Where(fun l -> l.Id = ListingId.value listingId && not l.Value.isLegacy)
+            |> Sql.parameters [ "@id", Sql.string (ListingId.toString listingId) ]
-                .SingleOrDefaultAsync ()
+            |> Sql.executeAsync toListingForView
-        match Document.TryValue tryListing with
+        return List.tryHead tryListing
-        | Some listing when not (isNull continent) -> return Some { listing = listing; continent = continent.Value }
-        | Some _
-        | None -> return None
     }
     
     /// Save a listing
-    let save (listing : Listing) = backgroundTask {
+    let save (listing : Listing) =
-        use session = docSession ()
+        connection () |> saveDocument Table.Listing (ListingId.toString listing.id) listing
-        session.Store (ListingDocument listing)
-        do! session.SaveChangesAsync ()
-    }
     
     /// Search job listings
-    let search (search : ListingSearch) = backgroundTask {
+    let search (search : ListingSearch) =
-        use session     = querySession ()
+        let searches = [
-        let continents  = Dict<Guid, ContinentDocument> ()
+            match search.continentId with
-        let searchQuery =
+            | Some contId -> "l.data->>'continentId' = @continentId", [ "@continentId", Sql.string contId ]
-            seq<ListingDocument -> bool> {
+            | None -> ()
-                match search.continentId with
+            match search.region with
-                | Some contId ->
+            | Some region -> "l.data->>'region' ILIKE @region", [ "@region", like region ]
-                    fun (l : ListingDocument) -> l.Value.continentId = (ContinentId.ofString contId)
+            | None -> ()
-                | None -> ()
+            if search.remoteWork <> "" then
-                match search.region with
+                "l.data->>'remoteWork' = @remote", [ "@remote", jsonBool (search.remoteWork = "yes") ]
-                | Some region ->
+            match search.text with
-                    fun (l : ListingDocument) -> l.Value.region.Contains (region, StringComparison.OrdinalIgnoreCase)
+            | Some text -> "l.data->>'text' ILIKE @text", [ "@text", like text ]
-                | None -> ()
+            | None -> ()
-                if search.remoteWork <> "" then
+        ]
-                    fun (l : ListingDocument) -> l.Value.remoteWork = (search.remoteWork = "yes")
+        connection ()
-                // match search.text with
+        |> Sql.query $"
-                // | Some text -> fun (l : Listing) -> l.text.Contains (text, StringComparison.OrdinalIgnoreCase)
+            {viewSql}
-                // | None -> ()
+             WHERE l.data->>'isExpired' = 'false' AND l.data->>'isLegacy' = 'false'
-            }
+               {searchSql searches}"
-            |> Seq.fold
+        |> Sql.parameters (searches |> List.collect snd)
-                   (fun q filter -> Queryable.Where(q, filter))
+        |> Sql.executeAsync toListingForView
-                   (session.Query<ListingDocument>()
-                        .Include((fun l -> l.Value.continentId :> obj), continents)
-                        .Where(fun l -> not l.Value.isExpired && not l.Value.isLegacy))
-        let! results = searchQuery.ToListAsync ()
-        return
-            results
-            |> Seq.map (fun l -> {
-                listing   = l.Value
-                continent = continents[ContinentId.value l.Value.continentId].Value
-            })
-            |> List.ofSeq
-    }
 
 
 /// Profile data access functions
@@ -322,174 +276,154 @@ module Profiles =
     
     /// Count the current profiles
     let count () =
-        use session = querySession ()
+        connection ()
-        session.Query<ProfileDocument>().Where(fun p -> not p.Value.isLegacy).LongCountAsync ()
+        |> Sql.query $"SELECT COUNT(id) AS the_count FROM jjj.{Table.Profile} WHERE data->>'isLegacy' <> 'true'"
+        |> Sql.executeRowAsync (fun row -> row.int64 "the_count")
     
     /// Delete a profile by its ID
     let deleteById citizenId = backgroundTask {
-        use session = docSession ()
+        let! _ =
-        session.Delete<ProfileDocument> (CitizenId.value citizenId)
+            connection ()
-        do! session.SaveChangesAsync ()
+            |> Sql.query $"DELETE FROM jjj.{Table.Profile} WHERE id = @id"
-    }
+            |> Sql.parameters [ "@id", Sql.string (CitizenId.toString citizenId) ]
-    /// Find a profile by citizen ID
+            |> Sql.executeNonQueryAsync
-    let findById citizenId = backgroundTask {
+        ()
-        use  session = querySession ()
-        let! profile = session.LoadAsync<ProfileDocument> (CitizenId.value citizenId)
-        return
-            match Document.TryValue profile with
-            | Some p when not p.isLegacy -> Some p
-            | Some _
-            | None -> None
     }
     
-    /// Find a profile by citizen ID for viewing (includes citizen and continent information)
+    /// Find a profile by citizen ID
-    let findByIdForView citizenId = backgroundTask {
+    let findById citizenId = backgroundTask {
-        use session = querySession ()
+        match! connection () |> getDocument<Profile> Table.Profile (CitizenId.toString citizenId) with
-        let mutable citizen   : CitizenDocument   = null
+        | Some profile when not profile.isLegacy -> return Some profile
-        let mutable continent : ContinentDocument = null
-        let! tryProfile =
-            session.Query<ProfileDocument>()
-                .Include<CitizenDocument>((fun p -> p.Id :> obj), fun c -> citizen <- c)
-                .Include<ContinentDocument>((fun p -> p.Value.continentId :> obj), fun c -> continent <- c)
-                .Where(fun p -> p.Id = CitizenId.value citizenId && not p.Value.isLegacy)
-                .SingleOrDefaultAsync ()
-        match Document.TryValue tryProfile with
-        | Some profile when not (isNull citizen) && not (isNull continent) ->
-            return Some { profile = profile; citizen = citizen.Value; continent = continent.Value }
         | Some _
         | None -> return None
     }
     
-    /// Save a profile
+    /// Find a profile by citizen ID for viewing (includes citizen and continent information)
-    let save (profile : Profile) = backgroundTask {
+    let findByIdForView citizenId = backgroundTask {
-        use session = docSession ()
+        let! tryCitizen =
-        session.Store (ProfileDocument profile)
+            connection ()
-        do! session.SaveChangesAsync ()
+            |> Sql.query $"
+                SELECT p.*, c.data AS cit_data, o.data AS cont_data
+                  FROM jjj.{Table.Profile} p
+                       INNER JOIN jjj.{Table.Citizen}   c ON c.id = p.id
+                       INNER JOIN jjj.{Table.Continent} o ON o.id = p.data->>'continentId'
+                 WHERE p.id                = @id
+                   AND p.data->>'isLegacy' = 'false'"
+            |> Sql.parameters [ "@id", Sql.string (CitizenId.toString citizenId) ]
+            |> Sql.executeAsync (fun row ->
+                {   profile   = toDocument<Profile> row
+                    citizen   = toDocumentFrom<Citizen>   "cit_data"  row
+                    continent = toDocumentFrom<Continent> "cont_data" row
+                })
+        return List.tryHead tryCitizen
     }
     
+    /// Save a profile
+    let save (profile : Profile) =
+        connection () |> saveDocument Table.Profile (CitizenId.toString profile.id) profile
+    
     /// Search profiles (logged-on users)
     let search (search : ProfileSearch) = backgroundTask {
-        use session     = querySession ()
+        let searches = [
-        let citizens    = Dict<Guid, CitizenDocument> ()
+            match search.continentId with
-        let searchQuery =
+            | Some contId -> "p.data ->>'continentId' = @continentId", [ "@continentId", Sql.string contId ]
-            seq<ProfileDocument -> bool> {
+            | None -> ()
-                match search.continentId with
+            if search.remoteWork <> "" then
-                | Some contId -> fun (p : ProfileDocument) -> p.Value.continentId = ContinentId.ofString contId
+                "p.data->>'remoteWork' = @remote", [ "@remote", jsonBool (search.remoteWork = "yes") ]
-                | None -> ()
+            match search.skill with
-                if search.remoteWork <> "" then
+            | Some skl -> "p.data->'skills'->>'description' ILIKE @description", [ "@description", like skl ]
-                    fun (p : ProfileDocument) -> p.Value.remoteWork = (search.remoteWork = "yes")
+            | None -> ()
-                match search.skill with
+            match search.bioExperience with
-                | Some skl ->
+            | Some text ->
-                    fun (p : ProfileDocument) ->
+                "(p.data->>'biography' ILIKE @text OR p.data->>'experience' ILIKE @text)", [ "@text", Sql.string text ]
-                        p.Value.skills.Any(fun s -> s.description.Contains (skl, StringComparison.OrdinalIgnoreCase))
+            | None -> ()
-                | None -> ()
+        ]
-                // match search.bioExperience with
+        let! results =
-                // | Some text ->
+            connection ()
-                //     let txt = regexContains text
+            |> Sql.query $"
-                //     yield filterFunc (fun it -> it.G("biography").Match(txt).Or (it.G("experience").Match txt))
+                SELECT p.*, c.data AS cit_data
-                // | None -> ()
+                  FROM jjj.{Table.Profile} p
-            }
+                       INNER JOIN jjj.{Table.Citizen} c ON c.id = p.id
-            |> Seq.fold
+                 WHERE p.data->>'isLegacy' = 'false'
-                (fun q filter -> Queryable.Where(q, filter))
+                   {searchSql searches}"
-                (session.Query<ProfileDocument>()
+            |> Sql.parameters (searches |> List.collect snd)
-                    .Include((fun p -> p.Id :> obj), citizens)
+            |> Sql.executeAsync (fun row ->
-                    .Where(fun p -> not p.Value.isLegacy))
+                let profile = toDocument<Profile> row
-        let! results = searchQuery.ToListAsync ()
+                let citizen = toDocumentFrom<Citizen> "cit_data" row
-        return
+                {   citizenId         = profile.id
-            results
+                    displayName       = Citizen.name citizen
-            |> Seq.map (fun profileDoc ->
+                    seekingEmployment = profile.seekingEmployment
-                let p = profileDoc.Value
+                    remoteWork        = profile.remoteWork
-                {   citizenId         = p.id
+                    fullTime          = profile.fullTime
-                    displayName       = Citizen.name citizens[CitizenId.value p.id].Value
+                    lastUpdatedOn     = profile.lastUpdatedOn
-                    seekingEmployment = p.seekingEmployment
-                    remoteWork        = p.remoteWork
-                    fullTime          = p.fullTime
-                    lastUpdatedOn     = p.lastUpdatedOn
                 })
-            |> Seq.sortBy (fun psr -> psr.displayName.ToLowerInvariant ())
+        return results |> List.sortBy (fun psr -> psr.displayName.ToLowerInvariant ())
-            |> List.ofSeq
     }
 
     // Search profiles (public)
-    let publicSearch (search : PublicSearch) = backgroundTask {
+    let publicSearch (search : PublicSearch) =
-        use session     = querySession ()
+        let searches = [
-        let continents  = Dict<Guid, ContinentDocument> ()
+            match search.continentId with
-        let searchQuery =
+            | Some contId -> "p.data->>'continentId' = @continentId", [ "@continentId", Sql.string contId ]
-            seq<ProfileDocument -> bool> {
+            | None -> ()
-                match search.continentId with
+            match search.region with
-                | Some contId -> fun (p : ProfileDocument) -> p.Value.continentId = ContinentId.ofString contId
+            | Some region -> "p.data->>'region' ILIKE @region", [ "@region", like region ]
-                | None -> ()
+            | None -> ()
-                match search.region with
+            if search.remoteWork <> "" then
-                | Some region ->
+                "p.data->>'remoteWork' = @remote", [ "@remote", jsonBool (search.remoteWork = "yes") ]
-                    fun (p : ProfileDocument) -> p.Value.region.Contains (region, StringComparison.OrdinalIgnoreCase)
+            match search.skill with
-                | None -> ()
+            | Some skl ->
-                if search.remoteWork <> "" then
+                "p.data->'skills'->>'description' ILIKE @description", [ "@description", like skl ]
-                    fun (p : ProfileDocument) -> p.Value.remoteWork = (search.remoteWork = "yes")
+            | None -> ()
-                match search.skill with
+        ]
-                | Some skl ->
+        connection ()
-                    fun (p : ProfileDocument) ->
+        |> Sql.query $"
-                        p.Value.skills.Any(fun s -> s.description.Contains (skl, StringComparison.OrdinalIgnoreCase))
+            SELECT p.*, c.data AS cont_data
-                | None -> ()
+              FROM jjj.{Table.Profile} p
-            }
+                   INNER JOIN jjj.{Table.Continent} c ON c.id = p.data->>'continentId'
-            |> Seq.fold
+             WHERE p.data->>'isPublic' = 'true'
-                (fun q filter -> Queryable.Where(q, filter))
+               AND p.data->>'isLegacy' = 'false'
-                (session.Query<ProfileDocument>()
+               {searchSql searches}"
-                    .Include((fun p -> p.Value.continentId :> obj), continents)
+        |> Sql.executeAsync (fun row ->
-                    .Where(fun p -> p.Value.isPublic && not p.Value.isLegacy))
+            let profile = toDocument<Profile> row
-        let! results = searchQuery.ToListAsync ()
+            let continent = toDocumentFrom<Continent> "cont_data" row
-        return
+            {   continent  = continent.name
-            results
+                region     = profile.region
-            |> Seq.map (fun profileDoc ->
+                remoteWork = profile.remoteWork
-                let p = profileDoc.Value
+                skills     = profile.skills
-                {   continent         = continents[ContinentId.value p.continentId].Value.name
+                             |> List.map (fun s ->
-                    region            = p.region
+                                 let notes = match s.notes with Some n -> $" ({n})" | None -> ""
-                    remoteWork        = p.remoteWork
+                                 $"{s.description}{notes}")
-                    skills            = p.skills
+            })
-                                        |> List.map (fun s ->
-                                            let notes = match s.notes with Some n -> $" ({n})" | None -> ""
-                                            $"{s.description}{notes}")
-                })
-            |> List.ofSeq
-    }
 
 /// Success story data access functions
 [<RequireQualifiedAccess>]
 module Successes =
     
     // Retrieve all success stories  
-    let all () = backgroundTask {
+    let all () =
-        use  session  = querySession ()
+        connection ()
-        let  citizens = Dict<Guid, CitizenDocument> ()
+        |> Sql.query $"
-        let! stories  =
+            SELECT s.*, c.data AS cit_data
-            session.Query<SuccessDocument>()
+              FROM jjj.{Table.Success} s
-                .Include((fun s -> s.Value.citizenId :> obj), citizens)
+                   INNER JOIN jjj.{Table.Citizen} c ON c.id = s.data->>'citizenId'
-                .OrderByDescending(fun s -> s.Value.recordedOn)
+             ORDER BY s.data->>'recordedOn' DESC"
-                .ToListAsync ()
+        |> Sql.executeAsync (fun row ->
-        return
+            let success = toDocument<Success> row
-            stories
+            let citizen = toDocumentFrom<Citizen> "cit_data" row
-            |> Seq.map (fun storyDoc ->
+            {   id          = success.id
-                let s = storyDoc.Value
+                citizenId   = success.citizenId
-                {   id          = s.id
+                citizenName = Citizen.name citizen
-                    citizenId   = s.citizenId
+                recordedOn  = success.recordedOn
-                    citizenName = Citizen.name citizens[CitizenId.value s.citizenId].Value
+                fromHere    = success.fromHere
-                    recordedOn  = s.recordedOn
+                hasStory    = Option.isSome success.story
-                    fromHere    = s.fromHere
+            })
-                    hasStory    = Option.isSome s.story
-                })
-            |> List.ofSeq
-    }
     
     /// Find a success story by its ID
-    let findById successId = backgroundTask {
+    let findById successId =
-        use  session = querySession ()
+        connection () |> getDocument<Success> Table.Success (SuccessId.toString successId)
-        let! success = session.LoadAsync<SuccessDocument> (SuccessId.value successId)
-        return Document.TryValue success
-    }
     
     /// Save a success story
-    let save (success : Success) = backgroundTask {
+    let save (success : Success) =
-        use session = docSession ()
+        connection () |> saveDocument Table.Success (SuccessId.toString success.id) success
-        session.Store (SuccessDocument success)
-        do! session.SaveChangesAsync ()
-    }
     

src/JobsJobsJobs/JobsJobsJobs.Data/JobsJobsJobs.Data.fsproj

@@ -20,6 +20,7 @@
       <PackageReference Include="Marten.NodaTime" Version="5.8.0" />
       <PackageReference Update="FSharp.Core" Version="6.0.5" />
       <PackageReference Include="Npgsql" Version="6.0.6" />
+      <PackageReference Include="Npgsql.FSharp" Version="5.3.0" />
       <PackageReference Include="Npgsql.NodaTime" Version="6.0.6" />
     </ItemGroup>
 

src/JobsJobsJobs/JobsJobsJobs.Data/Json.fs

@@ -1,6 +1,5 @@
 module JobsJobsJobs.Data.Json
 
-open System
 open System.Text.Json
 open System.Text.Json.Serialization
 open JobsJobsJobs.Domain
@@ -13,24 +12,15 @@ type WrappedJsonConverter<'T> (wrap : string -> 'T, unwrap : 'T -> string) =
     override _.Write(writer, value, _) =
         writer.WriteStringValue (unwrap value)
 
-/// Convert a wrapped GUID to/from its string representation
-type WrappedIdJsonConverter<'T> (wrap : Guid -> 'T, unwrap : 'T -> Guid) =
-    inherit JsonConverter<'T> ()
-    override _.Read(reader, _, _) =
-        wrap (Guid.Parse (reader.GetString ())) 
-    override _.Write(writer, value, _) =
-        writer.WriteStringValue ((unwrap value).ToString ())
-
-
 /// JsonSerializer options that use the custom converters
 let options =
     let opts = JsonSerializerOptions ()
-    [   WrappedIdJsonConverter (CitizenId,   CitizenId.value) :> JsonConverter
+    [   WrappedJsonConverter (CitizenId.ofString,   CitizenId.toString) :> JsonConverter
-        WrappedIdJsonConverter (ContinentId, ContinentId.value)
+        WrappedJsonConverter (ContinentId.ofString, ContinentId.toString)
-        WrappedIdJsonConverter (ListingId,   ListingId.value)
+        WrappedJsonConverter (ListingId.ofString,   ListingId.toString)
-        WrappedJsonConverter   (Text,        MarkdownString.toString)
+        WrappedJsonConverter (Text,                 MarkdownString.toString)
-        WrappedIdJsonConverter (SkillId,     SkillId.value)
+        WrappedJsonConverter (SkillId.ofString,     SkillId.toString)
-        WrappedIdJsonConverter (SuccessId,   SuccessId.value)
+        WrappedJsonConverter (SuccessId.ofString,   SuccessId.toString)
         JsonFSharpConverter    ()
     ]
     |> List.iter opts.Converters.Add

src/JobsJobsJobs/JobsJobsJobs.V3Migration/JobsJobsJobs.V3Migration.fsproj

@@ -0,0 +1,23 @@
+<Project Sdk="Microsoft.NET.Sdk">
+
+    <PropertyGroup>
+        <OutputType>Exe</OutputType>
+        <TargetFramework>net6.0</TargetFramework>
+    </PropertyGroup>
+
+    <ItemGroup>
+        <Compile Include="Program.fs" />
+        <Content Include="appsettings.json" CopyToOutputDirectory="Always" />
+    </ItemGroup>
+
+    <ItemGroup>
+      <PackageReference Include="NodaTime.Serialization.JsonNet" Version="3.0.0" />
+      <PackageReference Include="RethinkDb.Driver.FSharp" Version="0.9.0-beta-07" />
+      <PackageReference Update="FSharp.Core" Version="6.0.5" />
+    </ItemGroup>
+
+    <ItemGroup>
+      <ProjectReference Include="..\JobsJobsJobs.Data\JobsJobsJobs.Data.fsproj" />
+    </ItemGroup>
+
+</Project>

src/JobsJobsJobs/JobsJobsJobs.V3Migration/Program.fs

@@ -0,0 +1,93 @@
+
+open Microsoft.Extensions.Configuration
+
+/// Data access for v2 Jobs, Jobs, Jobs
+module Rethink =
+
+    /// Table names
+    [<RequireQualifiedAccess>]
+    module Table =
+        /// The user (citizen of Gitmo Nation) table
+        let Citizen = "citizen"
+        /// The continent table
+        let Continent = "continent"
+        /// The job listing table
+        let Listing = "listing"
+        /// The citizen employment profile table
+        let Profile = "profile"
+        /// The success story table
+        let Success = "success"
+        /// All tables
+        let all () = [ Citizen; Continent; Listing; Profile; Success ]
+
+    open RethinkDb.Driver.Net
+
+    /// Functions run at startup
+    [<RequireQualifiedAccess>]
+    module Startup =
+      
+        open NodaTime
+        open NodaTime.Serialization.JsonNet
+        open RethinkDb.Driver.FSharp
+        
+        /// Create a RethinkDB connection
+        let createConnection (connStr : string) =
+            // Add all required JSON converters
+            Converter.Serializer.ConfigureForNodaTime DateTimeZoneProviders.Tzdb |> ignore
+            // Connect to the database
+            let config = DataConfig.FromUri connStr
+            config.CreateConnection ()
+
+/// Shorthand for the RethinkDB R variable (how every command starts)
+let r = RethinkDb.Driver.RethinkDB.R
+
+open JobsJobsJobs.Data
+open JobsJobsJobs.Domain
+open Newtonsoft.Json.Linq
+open NodaTime
+open NodaTime.Text
+open RethinkDb.Driver.FSharp.Functions
+
+/// Retrieve an instant from a JObject field
+let getInstant (doc : JObject) name =
+    let text = doc[name].Value<string> ()
+    match InstantPattern.General.Parse text with
+    | it when it.Success -> it.Value
+    | _ ->
+        match InstantPattern.ExtendedIso.Parse text with
+        | it when it.Success -> it.Value
+        | it -> raise it.Exception
+
+task {
+    // Establish database connections
+    let cfg = ConfigurationBuilder().AddJsonFile("appsettings.json").Build ()
+    use rethinkConn = Rethink.Startup.createConnection (cfg.GetConnectionString "RethinkDB")
+    match! DataConnection.setUp cfg with
+    | Ok _ -> ()
+    | Error msg -> failwith msg
+    
+    // Migrate citizens
+    let! oldCitizens =
+        fromTable Rethink.Table.Citizen
+        |> runResult<JObject list>
+        |> withRetryOnce
+        |> withConn rethinkConn
+    let newCitizens =
+        oldCitizens
+        |> List.map (fun c ->
+            let user = c["mastodonUser"].Value<string> ()
+            { Citizen.empty with
+                id         = CitizenId.ofString (c["id"].Value<string> ())
+                joinedOn   = getInstant c "joinedOn"
+                lastSeenOn = getInstant c "lastSeenOn"
+                email      = $"""{user}@{c["instance"].Value<string> ()}"""
+                firstName  = user
+                lastName   = user
+                isLegacy   = true
+            })
+    for citizen in newCitizens do
+        do! Citizens.save citizen
+    printfn $"** Migrated {List.length newCitizens} citizen(s)"
+    ()
+} |> Async.AwaitTask |> Async.RunSynchronously
+

src/JobsJobsJobs/JobsJobsJobs.V3Migration/appsettings.json

@@ -0,0 +1,13 @@
+{
+    "ConnectionStrings": {
+        "RethinkDB": "rethinkdb://data02.bitbadger.solutions/jobsjobsjobs_dev",
+        "PostgreSQL": "Host=localhost;Username=jobsjobsjobs;Password=devpassword;Database=jobsjobsjobs"
+    },
+    "Logging": {
+        "LogLevel": {
+            "Default": "Debug",
+            "System": "Information",
+            "Microsoft": "Information"
+        }
+    }
+}

src/JobsJobsJobs/Server/App.fs

@@ -60,7 +60,7 @@ let configureServices (svc : IServiceCollection) =
     let _ = svc.Configure<AuthOptions> (cfg.GetSection "Auth")
     
     // Set up the Marten data store
-    match Connection.setUp cfg |> Async.AwaitTask |> Async.RunSynchronously with
+    match DataConnection.setUp cfg |> Async.AwaitTask |> Async.RunSynchronously with
     | Ok _ -> ()
     | Error msg -> failwith $"Error initializing data store: {msg}"