WIP on Marten data

src/JobsJobsJobs/Domain/Types.fs

@@ -35,6 +35,8 @@ type Citizen =
         /// The other contacts for this user
         otherContacts : OtherContact list
         
+        /// Whether this is a legacy citizen
+        isLegacy : bool
     }
 
 /// Support functions for citizens
@@ -94,6 +96,9 @@ type Listing =
         
         /// Was this job filled as part of its appearance on Jobs, Jobs, Jobs?
         wasFilledHere : bool option
+        
+        /// Whether this is a legacy listing
+        isLegacy : bool
     }
 
 
@@ -170,6 +175,9 @@ type Profile =
         
         /// Skills this citizen possesses
         skills            : Skill list
+        
+        /// Whether this is a legacy profile
+        isLegacy : bool
     }
 
 /// Support functions for Profiles
@@ -189,6 +197,7 @@ module Profile =
           lastUpdatedOn     = Instant.MinValue
           experience        = None
           skills            = []
+          isLegacy          = false
         }
 
 

src/JobsJobsJobs/Server/App.fs

@@ -24,49 +24,61 @@ let configureApp (app : IApplicationBuilder) =
 
 open Newtonsoft.Json
 open NodaTime
+open Marten
 open Microsoft.AspNetCore.Authentication.JwtBearer
 open Microsoft.Extensions.Configuration
 open Microsoft.Extensions.Logging
 open Microsoft.IdentityModel.Tokens
 open System.Text
+open JobsJobsJobs.Domain
 open JobsJobsJobs.Domain.SharedTypes
 
 /// Configure dependency injection
 let configureServices (svc : IServiceCollection) =
-    svc.AddGiraffe ()                             |> ignore
+    let _ = svc.AddGiraffe ()
-    svc.AddSingleton<IClock> SystemClock.Instance |> ignore
+    let _ = svc.AddSingleton<IClock> SystemClock.Instance
-    svc.AddLogging ()                             |> ignore
+    let _ = svc.AddLogging ()
-    svc.AddCors ()                                |> ignore
+    let _ = svc.AddCors ()
     
     let jsonCfg = JsonSerializerSettings ()
     Data.Converters.all () |> List.iter jsonCfg.Converters.Add
-    svc.AddSingleton<Json.ISerializer> (NewtonsoftJson.Serializer jsonCfg) |> ignore
+    let _ = svc.AddSingleton<Json.ISerializer> (NewtonsoftJson.Serializer jsonCfg)
 
     let svcs = svc.BuildServiceProvider ()
     let cfg  = svcs.GetRequiredService<IConfiguration> ()
     
-    svc.AddAuthentication(fun o ->
+    let _ =
-        o.DefaultAuthenticateScheme <- JwtBearerDefaults.AuthenticationScheme
+        svc.AddAuthentication(fun o ->
-        o.DefaultChallengeScheme    <- JwtBearerDefaults.AuthenticationScheme
+            o.DefaultAuthenticateScheme <- JwtBearerDefaults.AuthenticationScheme
-        o.DefaultScheme             <- JwtBearerDefaults.AuthenticationScheme)
+            o.DefaultChallengeScheme    <- JwtBearerDefaults.AuthenticationScheme
-        .AddJwtBearer(fun o ->
+            o.DefaultScheme             <- JwtBearerDefaults.AuthenticationScheme)
-            o.RequireHttpsMetadata      <- false
+            .AddJwtBearer(fun opt ->
-            o.TokenValidationParameters <- TokenValidationParameters (
+                opt.RequireHttpsMetadata      <- false
-                ValidateIssuer   = true,
+                opt.TokenValidationParameters <- TokenValidationParameters (
-                ValidateAudience = true,
+                    ValidateIssuer   = true,
-                ValidAudience    = "https://noagendacareers.com",
+                    ValidateAudience = true,
-                ValidIssuer      = "https://noagendacareers.com",
+                    ValidAudience    = "https://noagendacareers.com",
-                IssuerSigningKey = SymmetricSecurityKey (
+                    ValidIssuer      = "https://noagendacareers.com",
-                    Encoding.UTF8.GetBytes (cfg.GetSection "Auth").["ServerSecret"])))
+                    IssuerSigningKey = SymmetricSecurityKey (
-    |> ignore
+                        Encoding.UTF8.GetBytes (cfg.GetSection "Auth").["ServerSecret"])))
-    svc.AddAuthorization () |> ignore
+    let _ = svc.AddAuthorization ()
-    svc.Configure<AuthOptions> (cfg.GetSection "Auth") |> ignore
+    let _ = svc.Configure<AuthOptions> (cfg.GetSection "Auth")
     
     let dbCfg = cfg.GetSection "Rethink"
     let log   = svcs.GetRequiredService<ILoggerFactory>().CreateLogger "JobsJobsJobs.Api.Data.Startup"
     let conn  = Data.Startup.createConnection dbCfg log
-    svc.AddSingleton conn |> ignore
+    let _ = svc.AddSingleton conn |> ignore
-    Data.Startup.establishEnvironment dbCfg log conn |> Async.AwaitTask |> Async.RunSynchronously
+    //Data.Startup.establishEnvironment dbCfg log conn |> Async.AwaitTask |> Async.RunSynchronously
+    
+    let _ =
+        svc.AddMarten(fun (opts : StoreOptions) ->
+            opts.Connection (cfg.GetConnectionString "PostgreSQL")
+            opts.RegisterDocumentTypes [
+                typeof<Citizen>; typeof<Continent>; typeof<Listing>; typeof<Profile>; typeof<SecurityInfo>
+                typeof<Success>
+            ])
+            .UseLightweightSessions()
+    ()
 
 [<EntryPoint>]
 let main _ =

src/JobsJobsJobs/Server/Data.fs

@@ -113,6 +113,7 @@ module private Reconnect =
     
 
 open RethinkDb.Driver.Ast
+open Marten
 
 /// Shorthand for the RethinkDB R variable (how every command starts)
 let private r = RethinkDb.Driver.RethinkDB.R
@@ -305,6 +306,7 @@ module Map =
             displayName   = row.stringOrNone        "display_name"
             // TODO: deserialize from JSON
             otherContacts = [] // row.stringOrNone        "other_contacts"
+            isLegacy      = false
         }
         
     /// Create a continent from a data row
@@ -331,6 +333,7 @@ module Map =
             text          = (row.string >> Text)            "listing_text"
             neededBy      = row.fieldValueOrNone<LocalDate> "needed_by"
             wasFilledHere = row.boolOrNone                  "was_filled_here"
+            isLegacy      = false
         }
     
     /// Create a job listing for viewing from a data row
@@ -353,6 +356,7 @@ module Map =
             lastUpdatedOn     = row.fieldValue<Instant>   "last_updated_on"
             experience        = row.stringOrNone          "experience" |> Option.map Text
             skills            = []
+            isLegacy          = false
         }
     
     /// Create a skill from a data row
@@ -373,99 +377,34 @@ module Map =
         }
 
 
+/// Convert a possibly-null record type to an option
+let optional<'T> (value : 'T) = if isNull (box value) then None else Some value
+
+open System
+open System.Linq
+
 /// Profile data access functions
 [<RequireQualifiedAccess>]
 module Profile =
 
     /// Count the current profiles
-    let count conn =
+    let count (session : IQuerySession) =
-        Sql.existingConnection conn
+        session.Query<Profile>().Where(fun p -> not p.isLegacy).LongCountAsync ()
-        |> Sql.query
-               "SELECT COUNT(p.citizen_id)
-                  FROM jjj.profile p
-                       INNER JOIN jjj.citizen c ON c.id = p.citizen_id
-                 WHERE c.is_legacy = FALSE"
-        |> Sql.executeRowAsync Map.toCount
 
     /// Find a profile by citizen ID
-    let findById citizenId conn = backgroundTask {
+    let findById citizenId (session : IQuerySession) = backgroundTask {
-        let! tryProfile =
+        let! profile = session.LoadAsync<Profile> (CitizenId.value citizenId)
-            Sql.existingConnection conn
+        return
-            |> Sql.query
+            match optional profile with
-                "SELECT *
+            | Some p when not p.isLegacy -> Some p
-                   FROM jjj.profile p
+            | Some _
-                        INNER JOIN jjj.citizen ON c.id = p.citizen_id
+            | None -> None
-                  WHERE p.citizen_id = @id
-                    AND c.is_legacy  = FALSE"
-            |> 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.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 = backgroundTask {
+    [<Obsolete "Inline this">]
-        let! _ =
+    let save (profile : Profile) (session : IDocumentSession) =
-            Sql.existingConnection conn
+        session.Store profile
-            |> Sql.executeTransactionAsync [
-                "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 conn = backgroundTask {
@@ -543,13 +482,13 @@ module Profile =
 module Citizen =
   
     /// Find a citizen by their ID
-    let findById citizenId conn = backgroundTask {
+    let findById citizenId (session : IQuerySession) = backgroundTask {
-        let! citizen =
+        let! citizen = session.LoadAsync<Citizen> (CitizenId.value citizenId)
-            Sql.existingConnection conn
+        return
-            |> Sql.query "SELECT * FROM jjj.citizen WHERE id = @id AND is_legacy = FALSE"
+            match optional citizen with
-            |> Sql.parameters [ "@id", Sql.citizenId citizenId ]
+            | Some c when not c.isLegacy -> Some c
-            |> Sql.executeAsync Map.toCitizen
+            | Some _
-        return List.tryHead citizen
+            | None -> None
     }
 
     /// Find a citizen by their e-mail address

src/JobsJobsJobs/Server/Handlers.fs

@@ -1,10 +1,10 @@
 /// Route handlers for Giraffe endpoints
 module JobsJobsJobs.Api.Handlers
 
+open System.Threading
 open Giraffe
 open JobsJobsJobs.Domain
 open JobsJobsJobs.Domain.SharedTypes
-open JobsJobsJobs.Domain.Types
 open Microsoft.AspNetCore.Http
 open Microsoft.Extensions.Logging
 
@@ -54,11 +54,13 @@ module Error =
 [<AutoOpen>]
 module Helpers =
 
+    open System.Security.Claims
+    open System.Threading.Tasks
     open NodaTime
+    open Marten
     open Microsoft.Extensions.Configuration
     open Microsoft.Extensions.Options
     open RethinkDb.Driver.Net
-    open System.Security.Claims
 
     /// Get the NodaTime clock from the request context
     let clock (ctx : HttpContext) = ctx.GetService<IClock> ()
@@ -74,6 +76,12 @@ module Helpers =
 
     /// Get the RethinkDB connection from the request context
     let conn (ctx : HttpContext) = ctx.GetService<IConnection> ()
+    
+    /// Get a query session
+    let querySession (ctx : HttpContext) = ctx.GetService<IQuerySession> ()
+    
+    /// Get a full document session
+    let docSession (ctx : HttpContext) = ctx.GetService<IDocumentSession> ()
 
     /// `None` if a `string option` is `None`, whitespace, or empty
     let noneIfBlank (s : string option) =
@@ -98,8 +106,19 @@ module Helpers =
 
     /// Return an empty OK response
     let ok : HttpHandler = Successful.OK ""
+    
+    /// Convert a potentially-null record type to an option
+    let opt<'T> (it : Task<'T>) = task {
+        match! it with
+        | x when isNull (box x) -> return None
+        | x -> return Some x
+    }
+    
+    /// Shorthand for no cancellation token
+    let noCnx = CancellationToken.None
 
 
+open System
 
 /// Handlers for /api/citizen routes
 [<RequireQualifiedAccess>]
@@ -152,15 +171,18 @@ module Citizen =
     }
     
     // GET: /api/citizen/[id]
-    let get citizenId : HttpHandler = authorize >=> fun next ctx -> task {
+    let get (citizenId : Guid) : HttpHandler = authorize >=> fun next ctx -> task {
-        match! Data.Citizen.findById (CitizenId citizenId) (conn ctx) with
+        use session = querySession ctx
+        match! session.LoadAsync<Citizen> citizenId |> opt 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)
+        use session = docSession ctx
+        session.Delete<Citizen> (CitizenId.value (currentCitizenId ctx))
+        do! session.SaveChangesAsync ()
         return! ok next ctx
     }
 
@@ -171,7 +193,8 @@ module Continent =
   
     // GET: /api/continent/all
     let all : HttpHandler = fun next ctx -> task {
-        let! continents = Data.Continent.all (conn ctx)
+        use session = querySession ctx
+        let! continents = session.Query<Continent>().ToListAsync noCnx
         return! json continents next ctx
     }
 
@@ -230,20 +253,23 @@ module Listing =
     let add : HttpHandler = authorize >=> fun next ctx -> task {
         let! form = ctx.BindJsonAsync<ListingForm> ()
         let  now  = (clock ctx).GetCurrentInstant ()
-        do! Data.Listing.add
+        use  session = docSession ctx
-                { id            = ListingId.create ()
+        session.Store<Listing>({
-                  citizenId     = currentCitizenId ctx
+            id            = ListingId.create ()
-                  createdOn     = now
+            citizenId     = currentCitizenId ctx
-                  title         = form.title
+            createdOn     = now
-                  continentId   = ContinentId.ofString form.continentId
+            title         = form.title
-                  region        = form.region
+            continentId   = ContinentId.ofString form.continentId
-                  remoteWork    = form.remoteWork
+            region        = form.region
-                  isExpired     = false
+            remoteWork    = form.remoteWork
-                  updatedOn     = now
+            isExpired     = false
-                  text          = Text form.text
+            updatedOn     = now
-                  neededBy      = (form.neededBy |> Option.map parseDate)
+            text          = Text form.text
-                  wasFilledHere = None
+            neededBy      = (form.neededBy |> Option.map parseDate)
-                  } (conn ctx)
+            wasFilledHere = None
+            isLegacy      = false
+        })
+        do! session.SaveChangesAsync ()
         return! ok next ctx
     }
 

src/JobsJobsJobs/Server/JobsJobsJobs.Server.fsproj

@@ -24,6 +24,9 @@
   
   <ItemGroup>
     <PackageReference Include="Giraffe" Version="6.0.0" />
+    <PackageReference Include="Marten" Version="5.8.0" />
+    <PackageReference Include="Marten.NodaTime" Version="5.8.0" />
+    <PackageReference Include="Marten.PLv8" Version="5.8.0" />
     <PackageReference Include="Microsoft.AspNetCore.Authentication.JwtBearer" Version="6.0.6" />
     <PackageReference Include="Microsoft.FSharpLu.Json" Version="0.11.7" />
     <PackageReference Include="NodaTime.Serialization.JsonNet" Version="3.0.0" />