src/MyPrayerJournal.Api/Data.fs

@@ -9,65 +9,79 @@ open Raven.Client.Documents.Linq
 open System
 open System.Collections.Generic
 
-/// JSON converter for request IDs
+/// JSON converters for various DUs
-type RequestIdJsonConverter () =
+module Converters =
-  inherit JsonConverter<RequestId> ()
+  
-  override __.WriteJson(writer : JsonWriter, value : RequestId, _ : JsonSerializer) =
+  /// JSON converter for request IDs
-    (RequestId.toString >> writer.WriteValue) value
+  type RequestIdJsonConverter () =
-  override __.ReadJson(reader: JsonReader, _ : Type, _ : RequestId, _ : bool, _ : JsonSerializer) =
+    inherit JsonConverter<RequestId> ()
-    (string >> RequestId.fromIdString) reader.Value
+    override __.WriteJson(writer : JsonWriter, value : RequestId, _ : JsonSerializer) =
+      (RequestId.toString >> writer.WriteValue) value
+    override __.ReadJson(reader: JsonReader, _ : Type, _ : RequestId, _ : bool, _ : JsonSerializer) =
+      (string >> RequestId.fromIdString) reader.Value
 
+  /// JSON converter for user IDs
+  type UserIdJsonConverter () =
+    inherit JsonConverter<UserId> ()
+    override __.WriteJson(writer : JsonWriter, value : UserId, _ : JsonSerializer) =
+      (UserId.toString >> writer.WriteValue) value
+    override __.ReadJson(reader: JsonReader, _ : Type, _ : UserId, _ : bool, _ : JsonSerializer) =
+      (string >> UserId) reader.Value
 
-/// JSON converter for user IDs
+  /// JSON converter for Ticks
-type UserIdJsonConverter () =
+  type TicksJsonConverter () =
-  inherit JsonConverter<UserId> ()
+    inherit JsonConverter<Ticks> ()
-  override __.WriteJson(writer : JsonWriter, value : UserId, _ : JsonSerializer) =
+    override __.WriteJson(writer : JsonWriter, value : Ticks, _ : JsonSerializer) =
-    (UserId.toString >> writer.WriteValue) value
+      (Ticks.toLong >> writer.WriteValue) value
-  override __.ReadJson(reader: JsonReader, _ : Type, _ : UserId, _ : bool, _ : JsonSerializer) =
+    override __.ReadJson(reader: JsonReader, _ : Type, _ : Ticks, _ : bool, _ : JsonSerializer) =
-    (string >> UserId) reader.Value
+      (string >> int64 >> Ticks) reader.Value
 
+  /// A sequence of all custom converters for myPrayerJournal
+  let all : JsonConverter seq =
+    seq {
+      yield RequestIdJsonConverter ()
+      yield UserIdJsonConverter ()
+      yield TicksJsonConverter ()
+      }
 
-/// JSON converter for Ticks
+/// RavenDB index declarations
-type TicksJsonConverter () =
+module Indexes =
-  inherit JsonConverter<Ticks> ()
+  
-  override __.WriteJson(writer : JsonWriter, value : Ticks, _ : JsonSerializer) =
+  /// Index requests by user ID
-    (Ticks.toLong >> writer.WriteValue) value
+  type Requests_ByUserId () as this =
-  override __.ReadJson(reader: JsonReader, _ : Type, _ : Ticks, _ : bool, _ : JsonSerializer) =
+    inherit AbstractJavaScriptIndexCreationTask ()
-    (string >> int64 >> Ticks) reader.Value
+    do
+      this.Maps <- HashSet<string> [ "docs.Requests.Select(req => new { userId = req.userId })" ]
 
-/// Index requests by user ID
+  /// Index requests for a journal view
-type Requests_ByUserId () as this =
+  type Requests_AsJournal () as this =
-  inherit AbstractJavaScriptIndexCreationTask ()
+    inherit AbstractJavaScriptIndexCreationTask ()
-  do
+    do
-    this.Maps <- HashSet<string> [ "map('Requests', function (req) { return { userId : req.userId } })" ]
+      this.Maps <- HashSet<string> [
+        "docs.Requests.Select(req => new {
+            requestId = req.Id,
+            userId = req.userId,
+            text = req.history.Where(hist => hist.text != null).OrderByDescending(hist => hist.asOf).First().text,
+            asOf = req.history.OrderByDescending(hist => hist.asOf).First().asOf,
+            snoozedUntil = req.snoozedUntil,
+            showAfter = req.showAfter,
+            recurType = req.recurType,
+            recurCount = req.recurCount
+        })"
+        ]
+      this.Fields <-
+        [ "text", IndexFieldOptions (Storage = Nullable FieldStorage.Yes)
+          "asOf", IndexFieldOptions (Storage = Nullable FieldStorage.Yes)
+          ]
+        |> dict
+        |> Dictionary<string, IndexFieldOptions>
 
-/// Index requests for a journal view
-type Requests_AsJournal () as this =
-  inherit AbstractJavaScriptIndexCreationTask ()
-  do
-    this.Maps <- HashSet<string> [
-      "map('Requests', function (req) {
-        var hist = req.history
-          .filter(function (hist) { return hist.text !== null })
-          .sort(function (a, b) { return b - a })
-        return {
-          requestId    : req.Id,
-          userId       : req.userId,
-          text         : hist[0].text,
-          asOf         : req.history[req.history.length - 1].asOf,
-          snoozedUntil : req.snoozedUntil,
-          showAfter    : req.showAfter,
-          recurType    : req.recurType,
-          recurCount   : req.recurCount
-        }
-      })"
-      
-      ]
 
 /// Extensions on the IAsyncDocumentSession interface to support our data manipulation needs
 [<AutoOpen>]
 module Extensions =
   
+  open Indexes
   open Raven.Client.Documents.Commands.Batches
   open Raven.Client.Documents.Operations
   open Raven.Client.Documents.Session

src/MyPrayerJournal.Api/Program.fs

@@ -2,81 +2,110 @@ namespace MyPrayerJournal.Api
 
 open Microsoft.AspNetCore.Builder
 open Microsoft.AspNetCore.Hosting
+open System.IO
 
 /// Configuration functions for the application
 module Configure =
   
-  open Microsoft.Extensions.Configuration
+  /// Configure the content root
-  open Newtonsoft.Json
+  let contentRoot root (bldr : IWebHostBuilder) =
+    bldr.UseContentRoot root
 
-  /// Set up the configuration for the app
+  open Microsoft.Extensions.Configuration
-  let configuration (ctx : WebHostBuilderContext) (cfg : IConfigurationBuilder) =
+
-    cfg.SetBasePath(ctx.HostingEnvironment.ContentRootPath)
+  /// Configure the application configuration
-      .AddJsonFile("appsettings.json", optional = true, reloadOnChange = true)
+  let appConfiguration (bldr : IWebHostBuilder) =
-      .AddJsonFile(sprintf "appsettings.%s.json" ctx.HostingEnvironment.EnvironmentName)
+    let configuration (ctx : WebHostBuilderContext) (cfg : IConfigurationBuilder) =
-      .AddEnvironmentVariables ()
+      cfg.SetBasePath(ctx.HostingEnvironment.ContentRootPath)
-    |> ignore
+        .AddJsonFile("appsettings.json", optional = true, reloadOnChange = true)
+        .AddJsonFile(sprintf "appsettings.%s.json" ctx.HostingEnvironment.EnvironmentName)
+        .AddEnvironmentVariables ()
+      |> ignore
+    bldr.ConfigureAppConfiguration configuration
     
   open Microsoft.AspNetCore.Server.Kestrel.Core
 
   /// Configure Kestrel from appsettings.json
-  let kestrel (ctx : WebHostBuilderContext) (opts : KestrelServerOptions) =
+  let kestrel (bldr : IWebHostBuilder) =
-    (ctx.Configuration.GetSection >> opts.Configure >> ignore) "Kestrel"
+    let kestrel (ctx : WebHostBuilderContext) (opts : KestrelServerOptions) =
+      (ctx.Configuration.GetSection >> opts.Configure >> ignore) "Kestrel"
+    bldr.ConfigureKestrel kestrel
 
-  open Giraffe.Serialization
+  /// Configure the web root directory
-  open Microsoft.FSharpLu.Json
+  let webRoot pathSegments (bldr : IWebHostBuilder) =
-
+    (Path.Combine >> bldr.UseWebRoot) pathSegments
-  /// Custom settings for the JSON serializer (uses compact representation for options and DUs)
-  let jsonSettings =
-    let x = NewtonsoftJsonSerializer.DefaultSettings
-    x.Converters.Add (CompactUnionJsonConverter (true))
-    x.NullValueHandling     <- NullValueHandling.Ignore
-    x.MissingMemberHandling <- MissingMemberHandling.Error
-    x.Formatting            <- Formatting.Indented
-    x
 
   open Giraffe
+  open Giraffe.Serialization
   open Giraffe.TokenRouter
   open Microsoft.AspNetCore.Authentication.JwtBearer
   open Microsoft.Extensions.DependencyInjection
+  open Microsoft.FSharpLu.Json
   open MyPrayerJournal
+  open MyPrayerJournal.Indexes
+  open Newtonsoft.Json
   open Raven.Client.Documents
   open Raven.Client.Documents.Indexes
   open System.Security.Cryptography.X509Certificates
 
   /// Configure dependency injection
-  let services (sc : IServiceCollection) =
+  let services (bldr : IWebHostBuilder) =
-    use sp  = sc.BuildServiceProvider ()
+    let svcs (sc : IServiceCollection) =
-    let cfg = sp.GetRequiredService<IConfiguration> ()
+      /// A set of JSON converters used for both Giraffe's request serialization and RavenDB's storage
-    sc.AddGiraffe()
+      let jsonConverters : JsonConverter seq =
-      .AddAuthentication(
+        seq {
-        /// Use HTTP "Bearer" authentication with JWTs
+          yield! Converters.all
-        fun opts ->
+          yield CompactUnionJsonConverter true
-          opts.DefaultAuthenticateScheme <- JwtBearerDefaults.AuthenticationScheme
+        }
-          opts.DefaultChallengeScheme    <- JwtBearerDefaults.AuthenticationScheme)
+      /// Custom settings for the JSON serializer (uses compact representation for options and DUs)
-      .AddJwtBearer(
+      let jsonSettings =
-        /// Configure JWT options with Auth0 options from configuration
+        let x = NewtonsoftJsonSerializer.DefaultSettings
-        fun opts ->
+        jsonConverters |> List.ofSeq |> List.iter x.Converters.Add
-          let jwtCfg = cfg.GetSection "Auth0"
+        x.NullValueHandling     <- NullValueHandling.Ignore
-          opts.Authority <- sprintf "https://%s/" jwtCfg.["Domain"]
+        x.MissingMemberHandling <- MissingMemberHandling.Error
-          opts.Audience  <- jwtCfg.["Id"])
+        x.Formatting            <- Formatting.Indented
-    |> ignore
+        x
-    sc.AddSingleton<IJsonSerializer> (NewtonsoftJsonSerializer jsonSettings)
-    |> ignore
-    let config = sc.BuildServiceProvider().GetRequiredService<IConfiguration>().GetSection "RavenDB"
-    let store = new DocumentStore ()
-    store.Urls        <- [| config.["URLs"] |]
-    store.Database    <- config.["Database"]
-    store.Certificate <- new X509Certificate2 (config.["Certificate"], config.["Password"])
-    store.Conventions.CustomizeJsonSerializer <- (fun x ->
-        x.Converters.Add (RequestIdJsonConverter ())
-        x.Converters.Add (TicksJsonConverter ())
-        x.Converters.Add (UserIdJsonConverter ())
-        x.Converters.Add (CompactUnionJsonConverter true))
-    store.Initialize () |> sc.AddSingleton |> ignore
-    IndexCreation.CreateIndexes (typeof<Requests_ByUserId>.Assembly, store)
 
+      use sp  = sc.BuildServiceProvider ()
+      let cfg = sp.GetRequiredService<IConfiguration> ()
+      sc.AddGiraffe()
+        .AddAuthentication(
+          /// Use HTTP "Bearer" authentication with JWTs
+          fun opts ->
+            opts.DefaultAuthenticateScheme <- JwtBearerDefaults.AuthenticationScheme
+            opts.DefaultChallengeScheme    <- JwtBearerDefaults.AuthenticationScheme)
+        .AddJwtBearer(
+          /// Configure JWT options with Auth0 options from configuration
+          fun opts ->
+            let jwtCfg = cfg.GetSection "Auth0"
+            opts.Authority <- sprintf "https://%s/" jwtCfg.["Domain"]
+            opts.Audience  <- jwtCfg.["Id"])
+      |> ignore
+      sc.AddSingleton<IJsonSerializer> (NewtonsoftJsonSerializer jsonSettings)
+      |> ignore
+      let config = sc.BuildServiceProvider().GetRequiredService<IConfiguration>().GetSection "RavenDB"
+      let store = new DocumentStore ()
+      store.Urls        <- [| config.["URL"] |]
+      store.Database    <- config.["Database"]
+      // store.Certificate <- new X509Certificate2 (config.["Certificate"], config.["Password"])
+      store.Conventions.CustomizeJsonSerializer <- fun x -> jsonConverters |> List.ofSeq |> List.iter x.Converters.Add
+      store.Initialize () |> (sc.AddSingleton >> ignore)
+      IndexCreation.CreateIndexes (typeof<Requests_ByUserId>.Assembly, store)
+    bldr.ConfigureServices svcs
   
+  open Microsoft.Extensions.Logging
+
+  /// Configure logging
+  let logging (bldr : IWebHostBuilder) =
+    let logz (log : ILoggingBuilder) =
+      let env = log.Services.BuildServiceProvider().GetService<IHostingEnvironment> ()
+      match env.IsDevelopment () with
+      | true -> log
+      | false -> log.AddFilter(fun l -> l > LogLevel.Information)
+      |> function l -> l.AddConsole().AddDebug()
+      |> ignore
+    bldr.ConfigureLogging logz
+
   /// Routes for the available URLs within myPrayerJournal
   let webApp =
     router Handlers.Error.notFound [
@@ -108,50 +137,45 @@ module Configure =
         ]
       ]
 
+  open System
+
   /// Configure the web application
-  let application (app : IApplicationBuilder) =
+  let application (bldr : IWebHostBuilder) =
-    let env = app.ApplicationServices.GetService<IHostingEnvironment> ()
+    let appConfig =
-    match env.IsDevelopment () with
+      Action<IApplicationBuilder> (
-    | true -> app.UseDeveloperExceptionPage ()
+        fun (app : IApplicationBuilder) ->
-    | false -> app.UseGiraffeErrorHandler Handlers.Error.error
+            let env = app.ApplicationServices.GetService<IHostingEnvironment> ()
-    |> function
+            match env.IsDevelopment () with
-    | a ->
+            | true -> app.UseDeveloperExceptionPage ()
-        a.UseAuthentication()
+            | false -> app.UseGiraffeErrorHandler Handlers.Error.error
-          .UseStaticFiles()
+            |> function
-          .UseGiraffe webApp
+            | a ->
-    |> ignore
+                a.UseAuthentication()
+                  .UseStaticFiles()
+                  .UseGiraffe webApp
+            |> ignore)
+    bldr.Configure appConfig
 
-  open Microsoft.Extensions.Logging
+  /// Compose all the configurations into one
-
+  let webHost appRoot pathSegments =
-  /// Configure logging
+    contentRoot appRoot
-  let logging (log : ILoggingBuilder) =
+    >> appConfiguration
-    let env = log.Services.BuildServiceProvider().GetService<IHostingEnvironment> ()
+    >> kestrel
-    match env.IsDevelopment () with
+    >> webRoot (Array.concat [ [| appRoot |]; pathSegments ])
-    | true -> log
+    >> services
-    | false -> log.AddFilter(fun l -> l > LogLevel.Information)
+    >> logging
-    |> function l -> l.AddConsole().AddDebug()
+    >> application
-    |> ignore
 
+  /// Build the web host from the given configuration
+  let buildHost (bldr : IWebHostBuilder) = bldr.Build ()
 
 module Program =
   
-  open System
-  open System.IO
-
   let exitCode = 0
 
-  let CreateWebHostBuilder _ =
-    let contentRoot = Directory.GetCurrentDirectory ()
-    WebHostBuilder()
-      .UseContentRoot(contentRoot)
-      .ConfigureAppConfiguration(Configure.configuration)
-      .UseKestrel(Configure.kestrel)
-      .UseWebRoot(Path.Combine (contentRoot, "wwwroot"))
-      .ConfigureServices(Configure.services)
-      .ConfigureLogging(Configure.logging)
-      .Configure(Action<IApplicationBuilder> Configure.application)
-
   [<EntryPoint>]
-  let main args =
+  let main _ =
-    CreateWebHostBuilder(args).Build().Run()
+    let appRoot = Directory.GetCurrentDirectory ()
+    use host = WebHostBuilder () |> (Configure.webHost appRoot [| "wwwroot" |] >> Configure.buildHost)
+    host.Run ()
     exitCode