diff --git a/.gitignore b/.gitignore index 37f26ff..3df3440 100644 --- a/.gitignore +++ b/.gitignore @@ -254,3 +254,5 @@ paket-files/ # Ionide VSCode extension .ionide + +src/environment.txt diff --git a/src/Dockerfile b/src/Dockerfile new file mode 100644 index 0000000..1a5a49a --- /dev/null +++ b/src/Dockerfile @@ -0,0 +1,17 @@ +FROM mcr.microsoft.com/dotnet/sdk:7.0-alpine AS build +WORKDIR /mpj +COPY ./MyPrayerJournal/MyPrayerJournal.fsproj ./ +RUN dotnet restore + +COPY ./MyPrayerJournal ./ +RUN dotnet publish -c Release -r linux-x64 +RUN rm bin/Release/net7.0/linux-x64/publish/appsettings.*.json + +FROM mcr.microsoft.com/dotnet/aspnet:7.0-alpine as final +WORKDIR /app +RUN apk add --no-cache icu-libs +ENV DOTNET_SYSTEM_GLOBALIZATION_INVARIANT=false +COPY --from=build /mpj/bin/Release/net7.0/linux-x64/publish/ ./ + +EXPOSE 80 +CMD [ "dotnet", "/app/MyPrayerJournal.dll" ] \ No newline at end of file diff --git a/src/MyPrayerJournal.ConvertRecurrence/Program.fs b/src/MyPrayerJournal.ConvertRecurrence/Program.fs deleted file mode 100644 index 1be0e70..0000000 --- a/src/MyPrayerJournal.ConvertRecurrence/Program.fs +++ /dev/null @@ -1,114 +0,0 @@ -open MyPrayerJournal.Domain -open NodaTime - -/// The old definition of the history entry -[] -type OldHistory = - { /// The time when this history entry was made - asOf : int64 - /// The status for this history entry - status : RequestAction - /// The text of the update, if applicable - text : string option - } - -/// The old definition of of the note entry -[] -type OldNote = - { /// The time when this note was made - asOf : int64 - - /// The text of the notes - notes : string - } - -/// Request is the identifying record for a prayer request -[] -type OldRequest = - { /// The ID of the request - id : RequestId - - /// The time this request was initially entered - enteredOn : int64 - - /// The ID of the user to whom this request belongs ("sub" from the JWT) - userId : UserId - - /// The time at which this request should reappear in the user's journal by manual user choice - snoozedUntil : int64 - - /// The time at which this request should reappear in the user's journal by recurrence - showAfter : int64 - - /// The type of recurrence for this request - recurType : string - - /// How many of the recurrence intervals should occur between appearances in the journal - recurCount : int16 - - /// The history entries for this request - history : OldHistory[] - - /// The notes for this request - notes : OldNote[] - } - - -open LiteDB -open MyPrayerJournal.Data - -let db = new LiteDatabase ("Filename=./mpj.db") -Startup.ensureDb db - -/// Map the old recurrence to the new style -let mapRecurrence old = - match old.recurType with - | "Days" -> Days old.recurCount - | "Hours" -> Hours old.recurCount - | "Weeks" -> Weeks old.recurCount - | _ -> Immediate - -/// Convert an old history entry to the new form -let convertHistory (old : OldHistory) = - { AsOf = Instant.FromUnixTimeMilliseconds old.asOf - Status = old.status - Text = old.text - } - -/// Convert an old note to the new form -let convertNote (old : OldNote) = - { AsOf = Instant.FromUnixTimeMilliseconds old.asOf - Notes = old.notes - } - -/// Convert items that may be Instant.MinValue or Instant(0) to None -let noneIfOld ms = - match Instant.FromUnixTimeMilliseconds ms with - | instant when instant > Instant.FromUnixTimeMilliseconds 0 -> Some instant - | _ -> None - -/// Map the old request to the new request -let convert old = - { Id = old.id - EnteredOn = Instant.FromUnixTimeMilliseconds old.enteredOn - UserId = old.userId - SnoozedUntil = noneIfOld old.snoozedUntil - ShowAfter = noneIfOld old.showAfter - Recurrence = mapRecurrence old - History = old.history |> Array.map convertHistory |> List.ofArray - Notes = old.notes |> Array.map convertNote |> List.ofArray - } - -/// Remove the old request, add the converted one (removes recurType / recurCount fields) -let replace (req : Request) = - db.Requests.Delete (Mapping.RequestId.toBson req.Id) |> ignore - db.Requests.Insert req |> ignore - db.Checkpoint () - -db.GetCollection("request").FindAll () -|> Seq.map convert -|> List.ofSeq -|> List.iter replace - -// For more information see https://aka.ms/fsharp-console-apps -printfn "Done" diff --git a/src/MyPrayerJournal.ToPostgres/LiteData.fs b/src/MyPrayerJournal.ToPostgres/LiteData.fs new file mode 100644 index 0000000..c7277b2 --- /dev/null +++ b/src/MyPrayerJournal.ToPostgres/LiteData.fs @@ -0,0 +1,106 @@ +module MyPrayerJournal.LiteData + +open LiteDB +open MyPrayerJournal +open NodaTime + +/// Request is the identifying record for a prayer request +[] +type OldRequest = + { /// The ID of the request + Id : RequestId + + /// The time this request was initially entered + EnteredOn : Instant + + /// The ID of the user to whom this request belongs ("sub" from the JWT) + UserId : UserId + + /// The time at which this request should reappear in the user's journal by manual user choice + SnoozedUntil : Instant option + + /// The time at which this request should reappear in the user's journal by recurrence + ShowAfter : Instant option + + /// The recurrence for this request + Recurrence : Recurrence + + /// The history entries for this request + History : History[] + + /// The notes for this request + Notes : Note[] + } + + +/// LiteDB extensions +[] +module Extensions = + + /// Extensions on the LiteDatabase class + type LiteDatabase with + + /// The Request collection + member this.Requests = this.GetCollection "request" + + +/// Map domain to LiteDB +// It does mapping, but since we're so DU-heavy, this gives us control over the JSON representation +[] +module Mapping = + + open NodaTime.Text + + /// A NodaTime instant pattern to use for parsing instants from the database + let instantPattern = InstantPattern.CreateWithInvariantCulture "g" + + /// Mapping for NodaTime's Instant type + module Instant = + let fromBson (value : BsonValue) = (instantPattern.Parse value.AsString).Value + let toBson (value : Instant) : BsonValue = value.ToString ("g", null) + + /// Mapping for option types + module Option = + let instantFromBson (value : BsonValue) = if value.IsNull then None else Some (Instant.fromBson value) + let instantToBson (value : Instant option) = match value with Some it -> Instant.toBson it | None -> null + + let stringFromBson (value : BsonValue) = match value.AsString with "" -> None | x -> Some x + let stringToBson (value : string option) : BsonValue = match value with Some txt -> txt | None -> "" + + /// Mapping for Recurrence + module Recurrence = + let fromBson (value : BsonValue) = Recurrence.ofString value + let toBson (value : Recurrence) : BsonValue = Recurrence.toString value + + /// Mapping for RequestAction + module RequestAction = + let fromBson (value : BsonValue) = RequestAction.ofString value.AsString + let toBson (value : RequestAction) : BsonValue = RequestAction.toString value + + /// Mapping for RequestId + module RequestId = + let fromBson (value : BsonValue) = RequestId.ofString value.AsString + let toBson (value : RequestId) : BsonValue = RequestId.toString value + + /// Mapping for UserId + module UserId = + let fromBson (value : BsonValue) = UserId value.AsString + let toBson (value : UserId) : BsonValue = UserId.toString value + + /// Set up the mapping + let register () = + BsonMapper.Global.RegisterType(Instant.toBson, Instant.fromBson) + BsonMapper.Global.RegisterType(Option.instantToBson, Option.instantFromBson) + BsonMapper.Global.RegisterType(Recurrence.toBson, Recurrence.fromBson) + BsonMapper.Global.RegisterType(RequestAction.toBson, RequestAction.fromBson) + BsonMapper.Global.RegisterType(RequestId.toBson, RequestId.fromBson) + BsonMapper.Global.RegisterType(Option.stringToBson, Option.stringFromBson) + BsonMapper.Global.RegisterType(UserId.toBson, UserId.fromBson) + +/// Code to be run at startup +module Startup = + + /// Ensure the database is set up + let ensureDb (db : LiteDatabase) = + db.Requests.EnsureIndex (fun it -> it.UserId) |> ignore + Mapping.register () diff --git a/src/MyPrayerJournal.ConvertRecurrence/MyPrayerJournal.ConvertRecurrence.fsproj b/src/MyPrayerJournal.ToPostgres/MyPrayerJournal.ToPostgres.fsproj similarity index 52% rename from src/MyPrayerJournal.ConvertRecurrence/MyPrayerJournal.ConvertRecurrence.fsproj rename to src/MyPrayerJournal.ToPostgres/MyPrayerJournal.ToPostgres.fsproj index 88ac1e5..018a50c 100644 --- a/src/MyPrayerJournal.ConvertRecurrence/MyPrayerJournal.ConvertRecurrence.fsproj +++ b/src/MyPrayerJournal.ToPostgres/MyPrayerJournal.ToPostgres.fsproj @@ -2,10 +2,12 @@ Exe - net6.0 + net7.0 + 3391 + @@ -13,4 +15,9 @@ + + + + + diff --git a/src/MyPrayerJournal.ToPostgres/Program.fs b/src/MyPrayerJournal.ToPostgres/Program.fs new file mode 100644 index 0000000..fff4a16 --- /dev/null +++ b/src/MyPrayerJournal.ToPostgres/Program.fs @@ -0,0 +1,33 @@ +open LiteDB +open MyPrayerJournal.Data +open MyPrayerJournal.Domain +open MyPrayerJournal.LiteData +open Microsoft.Extensions.Configuration + + +let lite = new LiteDatabase "Filename=./mpj.db" +Startup.ensureDb lite + +let cfg = (ConfigurationBuilder().AddJsonFile "appsettings.json").Build () +Connection.setUp cfg |> Async.AwaitTask |> Async.RunSynchronously + +let reqs = lite.Requests.FindAll () + +reqs +|> Seq.map (fun old -> + { Request.empty with + Id = old.Id + EnteredOn = old.EnteredOn + UserId = old.UserId + SnoozedUntil = old.SnoozedUntil + ShowAfter = old.ShowAfter + Recurrence = old.Recurrence + History = old.History |> Array.sortByDescending (fun it -> it.AsOf) |> List.ofArray + Notes = old.Notes |> Array.sortByDescending (fun it -> it.AsOf) |> List.ofArray + }) +|> Seq.map Request.add +|> List.ofSeq +|> List.iter (Async.AwaitTask >> Async.RunSynchronously) + +System.Console.WriteLine $"Migration complete - {Seq.length reqs} requests migrated" + diff --git a/src/MyPrayerJournal.sln b/src/MyPrayerJournal.sln index 393866a..bac65a6 100644 --- a/src/MyPrayerJournal.sln +++ b/src/MyPrayerJournal.sln @@ -1,11 +1,11 @@ - + Microsoft Visual Studio Solution File, Format Version 12.00 # Visual Studio Version 16 VisualStudioVersion = 16.0.30114.105 MinimumVisualStudioVersion = 10.0.40219.1 Project("{F2A71F9B-5D33-465A-A702-920D77279786}") = "MyPrayerJournal", "MyPrayerJournal\MyPrayerJournal.fsproj", "{6BD5A3C8-F859-42A0-ACD7-A5819385E828}" EndProject -Project("{F2A71F9B-5D33-465A-A702-920D77279786}") = "MyPrayerJournal.ConvertRecurrence", "MyPrayerJournal.ConvertRecurrence\MyPrayerJournal.ConvertRecurrence.fsproj", "{72B57736-8721-4636-A309-49FA4222416E}" +Project("{F2A71F9B-5D33-465A-A702-920D77279786}") = "MyPrayerJournal.ToPostgres", "MyPrayerJournal.ToPostgres\MyPrayerJournal.ToPostgres.fsproj", "{3114B8F4-E388-4804-94D3-A2F4D42797C6}" EndProject Global GlobalSection(SolutionConfigurationPlatforms) = preSolution @@ -24,5 +24,9 @@ Global {72B57736-8721-4636-A309-49FA4222416E}.Debug|Any CPU.Build.0 = Debug|Any CPU {72B57736-8721-4636-A309-49FA4222416E}.Release|Any CPU.ActiveCfg = Release|Any CPU {72B57736-8721-4636-A309-49FA4222416E}.Release|Any CPU.Build.0 = Release|Any CPU + {3114B8F4-E388-4804-94D3-A2F4D42797C6}.Debug|Any CPU.ActiveCfg = Debug|Any CPU + {3114B8F4-E388-4804-94D3-A2F4D42797C6}.Debug|Any CPU.Build.0 = Debug|Any CPU + {3114B8F4-E388-4804-94D3-A2F4D42797C6}.Release|Any CPU.ActiveCfg = Release|Any CPU + {3114B8F4-E388-4804-94D3-A2F4D42797C6}.Release|Any CPU.Build.0 = Release|Any CPU EndGlobalSection EndGlobal diff --git a/src/MyPrayerJournal/.gitignore b/src/MyPrayerJournal/.gitignore index ee14a3f..090166d 100644 --- a/src/MyPrayerJournal/.gitignore +++ b/src/MyPrayerJournal/.gitignore @@ -1,5 +1,2 @@ -## LiteDB database file -*.db - ## Development settings appsettings.Development.json diff --git a/src/MyPrayerJournal/Data.fs b/src/MyPrayerJournal/Data.fs index 6af5797..f007339 100644 --- a/src/MyPrayerJournal/Data.fs +++ b/src/MyPrayerJournal/Data.fs @@ -1,199 +1,205 @@ -module MyPrayerJournal.Data +module MyPrayerJournal.Data -open LiteDB -open MyPrayerJournal -open System.Threading.Tasks +/// Table(!) used by myPrayerJournal +module Table = -/// LiteDB extensions -[] -module Extensions = - - /// Extensions on the LiteDatabase class - type LiteDatabase with - - /// The Request collection - member this.Requests = this.GetCollection "request" - - /// Async version of the checkpoint command (flushes log) - member this.SaveChanges () = - this.Checkpoint () - Task.CompletedTask + /// Requests + [] + let Request = "mpj.request" -/// Map domain to LiteDB -// It does mapping, but since we're so DU-heavy, this gives us control over the JSON representation +/// JSON serialization customizations [] -module Mapping = +module Json = + + open System.Text.Json.Serialization + + /// Convert a wrapped DU to/from its string representation + type WrappedJsonConverter<'T> (wrap : string -> 'T, unwrap : 'T -> string) = + inherit JsonConverter<'T> () + override _.Read(reader, _, _) = + wrap (reader.GetString ()) + override _.Write(writer, value, _) = + writer.WriteStringValue (unwrap value) + + open System.Text.Json + open NodaTime.Serialization.SystemTextJson + + /// JSON serializer options to support the target domain + let options = + let opts = JsonSerializerOptions () + [ WrappedJsonConverter (Recurrence.ofString, Recurrence.toString) :> JsonConverter + WrappedJsonConverter (RequestAction.ofString, RequestAction.toString) + WrappedJsonConverter (RequestId.ofString, RequestId.toString) + WrappedJsonConverter (UserId, UserId.toString) + JsonFSharpConverter () + ] + |> List.iter opts.Converters.Add + let _ = opts.ConfigureForNodaTime NodaTime.DateTimeZoneProviders.Tzdb + opts.PropertyNamingPolicy <- JsonNamingPolicy.CamelCase + opts.DefaultIgnoreCondition <- JsonIgnoreCondition.WhenWritingNull + opts + + +open BitBadger.Npgsql.FSharp.Documents + +/// Connection +[] +module Connection = + + open BitBadger.Npgsql.Documents + open Microsoft.Extensions.Configuration + open Npgsql + open System.Text.Json + + /// Ensure the database is ready to use + let private ensureDb () = backgroundTask { + do! Custom.nonQuery "CREATE SCHEMA IF NOT EXISTS mpj" [] + do! Definition.ensureTable Table.Request + do! Definition.ensureIndex Table.Request Optimized + } + + /// Set up the data environment + let setUp (cfg : IConfiguration) = backgroundTask { + let builder = NpgsqlDataSourceBuilder (cfg.GetConnectionString "mpj") + let _ = builder.UseNodaTime () + Configuration.useDataSource (builder.Build ()) + Configuration.useSerializer + { new IDocumentSerializer with + member _.Serialize<'T> (it : 'T) = JsonSerializer.Serialize (it, Json.options) + member _.Deserialize<'T> (it : string) = JsonSerializer.Deserialize<'T> (it, Json.options) + } + do! ensureDb () + } + + +/// Data access functions for requests +[] +module Request = open NodaTime - open NodaTime.Text + + /// Add a request + let add req = backgroundTask { + do! insert Table.Request (RequestId.toString req.Id) req + } + + /// Does a request exist for the given request ID and user ID? + let existsById (reqId : RequestId) (userId : UserId) = + Exists.byContains Table.Request {| Id = reqId; UserId = userId |} - /// A NodaTime instant pattern to use for parsing instants from the database - let instantPattern = InstantPattern.CreateWithInvariantCulture "g" + /// Retrieve a request by its ID and user ID + let tryById reqId userId = backgroundTask { + match! Find.byId Table.Request (RequestId.toString reqId) with + | Some req when req.UserId = userId -> return Some req + | _ -> return None + } - /// Mapping for NodaTime's Instant type - module Instant = - let fromBson (value : BsonValue) = (instantPattern.Parse value.AsString).Value - let toBson (value : Instant) : BsonValue = value.ToString ("g", null) - - /// Mapping for option types - module Option = - let instantFromBson (value : BsonValue) = if value.IsNull then None else Some (Instant.fromBson value) - let instantToBson (value : Instant option) = match value with Some it -> Instant.toBson it | None -> null - - let stringFromBson (value : BsonValue) = match value.AsString with "" -> None | x -> Some x - let stringToBson (value : string option) : BsonValue = match value with Some txt -> txt | None -> "" - - /// Mapping for Recurrence - module Recurrence = - let fromBson (value : BsonValue) = Recurrence.ofString value - let toBson (value : Recurrence) : BsonValue = Recurrence.toString value - - /// Mapping for RequestAction - module RequestAction = - let fromBson (value : BsonValue) = RequestAction.ofString value.AsString - let toBson (value : RequestAction) : BsonValue = RequestAction.toString value - - /// Mapping for RequestId - module RequestId = - let fromBson (value : BsonValue) = RequestId.ofString value.AsString - let toBson (value : RequestId) : BsonValue = RequestId.toString value - - /// Mapping for UserId - module UserId = - let fromBson (value : BsonValue) = UserId value.AsString - let toBson (value : UserId) : BsonValue = UserId.toString value - - /// Set up the mapping - let register () = - BsonMapper.Global.RegisterType(Instant.toBson, Instant.fromBson) - BsonMapper.Global.RegisterType(Option.instantToBson, Option.instantFromBson) - BsonMapper.Global.RegisterType(Recurrence.toBson, Recurrence.fromBson) - BsonMapper.Global.RegisterType(RequestAction.toBson, RequestAction.fromBson) - BsonMapper.Global.RegisterType(RequestId.toBson, RequestId.fromBson) - BsonMapper.Global.RegisterType(Option.stringToBson, Option.stringFromBson) - BsonMapper.Global.RegisterType(UserId.toBson, UserId.fromBson) + /// Update recurrence for a request + let updateRecurrence reqId userId (recurType : Recurrence) = backgroundTask { + let dbId = RequestId.toString reqId + match! existsById reqId userId with + | true -> do! Update.partialById Table.Request dbId {| Recurrence = recurType |} + | false -> invalidOp "Request ID {dbId} not found" + } -/// Code to be run at startup -module Startup = - - /// Ensure the database is set up - let ensureDb (db : LiteDatabase) = - db.Requests.EnsureIndex (fun it -> it.UserId) |> ignore - Mapping.register () + /// Update the show-after time for a request + let updateShowAfter reqId userId (showAfter : Instant option) = backgroundTask { + let dbId = RequestId.toString reqId + match! existsById reqId userId with + | true -> do! Update.partialById Table.Request dbId {| ShowAfter = showAfter |} + | false -> invalidOp "Request ID {dbId} not found" + } + + /// Update the snoozed and show-after values for a request + let updateSnoozed reqId userId (until : Instant option) = backgroundTask { + let dbId = RequestId.toString reqId + match! existsById reqId userId with + | true -> do! Update.partialById Table.Request dbId {| SnoozedUntil = until; ShowAfter = until |} + | false -> invalidOp "Request ID {dbId} not found" + } -/// Async wrappers for LiteDB, and request -> journal mappings -[] -module private Helpers = - - open System.Linq +/// Specific manipulation of history entries +[] +module History = - /// Convert a sequence to a list asynchronously (used for LiteDB IO) - let toListAsync<'T> (q : 'T seq) = - (q.ToList >> Task.FromResult) () - - /// Convert a sequence to a list asynchronously (used for LiteDB IO) - let firstAsync<'T> (q : 'T seq) = - q.FirstOrDefault () |> Task.FromResult - - /// Async wrapper around a request update - let doUpdate (db : LiteDatabase) (req : Request) = - db.Requests.Update req |> ignore - Task.CompletedTask + /// Add a history entry + let add reqId userId hist = backgroundTask { + let dbId = RequestId.toString reqId + match! Request.tryById reqId userId with + | Some req -> + do! Update.partialById Table.Request dbId + {| History = (hist :: req.History) |> List.sortByDescending (fun it -> it.AsOf) |} + | None -> invalidOp $"Request ID {dbId} not found" + } -/// Retrieve a request, including its history and notes, by its ID and user ID -let tryFullRequestById reqId userId (db : LiteDatabase) = backgroundTask { - let! req = db.Requests.Find (Query.EQ ("_id", RequestId.toString reqId)) |> firstAsync - return match box req with null -> None | _ when req.UserId = userId -> Some req | _ -> None -} +/// Data access functions for journal-style requests +[] +module Journal = -/// Add a history entry -let addHistory reqId userId hist db = backgroundTask { - match! tryFullRequestById reqId userId db with - | Some req -> do! doUpdate db { req with History = Array.append [| hist |] req.History } - | None -> invalidOp $"{RequestId.toString reqId} not found" -} + /// Retrieve a user's answered requests + let answered (userId : UserId) = backgroundTask { + let! reqs = + Custom.list + $"""{Query.Find.byContains Table.Request} AND {Query.whereJsonPathMatches "@stat"}""" + [ "@criteria", Query.jsonbDocParam {| UserId = userId |} + "@stat", Sql.string """$.history[0].status ? (@ == "Answered")""" + ] fromData + return + reqs + |> Seq.ofList + |> Seq.map JournalRequest.ofRequestLite + |> Seq.filter (fun it -> it.LastStatus = Answered) + |> Seq.sortByDescending (fun it -> it.AsOf) + |> List.ofSeq + } -/// Add a note -let addNote reqId userId note db = backgroundTask { - match! tryFullRequestById reqId userId db with - | Some req -> do! doUpdate db { req with Notes = Array.append [| note |] req.Notes } - | None -> invalidOp $"{RequestId.toString reqId} not found" -} + /// Retrieve a user's current prayer journal (includes snoozed and non-immediate recurrence) + let forUser (userId : UserId) = backgroundTask { + let! reqs = + Custom.list + $"""{Query.Find.byContains Table.Request} AND {Query.whereJsonPathMatches "@stat"}""" + [ "@criteria", Query.jsonbDocParam {| UserId = userId |} + "@stat", Sql.string """$.history[0].status ? (@ <> "Answered")""" + ] fromData + return + reqs + |> Seq.ofList + |> Seq.map JournalRequest.ofRequestLite + |> Seq.filter (fun it -> it.LastStatus <> Answered) + |> Seq.sortBy (fun it -> it.AsOf) + |> List.ofSeq + } -/// Add a request -let addRequest (req : Request) (db : LiteDatabase) = - db.Requests.Insert req |> ignore + /// Does the user's journal have any snoozed requests? + let hasSnoozed userId now = backgroundTask { + let! jrnl = forUser userId + return jrnl |> List.exists (fun r -> defaultArg (r.SnoozedUntil |> Option.map (fun it -> it > now)) false) + } -/// Find all requests for the given user -let private getRequestsForUser (userId : UserId) (db : LiteDatabase) = backgroundTask { - return! db.Requests.Find (Query.EQ (nameof Request.empty.UserId, Mapping.UserId.toBson userId)) |> toListAsync -} + let tryById reqId userId = backgroundTask { + let! req = Request.tryById reqId userId + return req |> Option.map JournalRequest.ofRequestLite + } -/// Retrieve all answered requests for the given user -let answeredRequests userId db = backgroundTask { - let! reqs = getRequestsForUser userId db - return - reqs - |> Seq.map JournalRequest.ofRequestFull - |> Seq.filter (fun it -> it.LastStatus = Answered) - |> Seq.sortByDescending (fun it -> it.AsOf) - |> List.ofSeq -} -/// Retrieve the user's current journal -let journalByUserId userId db = backgroundTask { - let! reqs = getRequestsForUser userId db - return - reqs - |> Seq.map JournalRequest.ofRequestLite - |> Seq.filter (fun it -> it.LastStatus <> Answered) - |> Seq.sortBy (fun it -> it.AsOf) - |> List.ofSeq -} +/// Specific manipulation of note entries +[] +module Note = -/// Does the user have any snoozed requests? -let hasSnoozed userId now (db : LiteDatabase) = backgroundTask { - let! jrnl = journalByUserId userId db - return jrnl |> List.exists (fun r -> defaultArg (r.SnoozedUntil |> Option.map (fun it -> it > now)) false) -} + /// Add a note + let add reqId userId note = backgroundTask { + let dbId = RequestId.toString reqId + match! Request.tryById reqId userId with + | Some req -> + do! Update.partialById Table.Request dbId + {| Notes = (note :: req.Notes) |> List.sortByDescending (fun it -> it.AsOf) |} + | None -> invalidOp $"Request ID {dbId} not found" + } -/// Retrieve a request by its ID and user ID (without notes and history) -let tryRequestById reqId userId db = backgroundTask { - let! req = tryFullRequestById reqId userId db - return req |> Option.map (fun r -> { r with History = [||]; Notes = [||] }) -} - -/// Retrieve notes for a request by its ID and user ID -let notesById reqId userId (db : LiteDatabase) = backgroundTask { - match! tryFullRequestById reqId userId db with | Some req -> return req.Notes | None -> return [||] -} - -/// Retrieve a journal request by its ID and user ID -let tryJournalById reqId userId (db : LiteDatabase) = backgroundTask { - let! req = tryFullRequestById reqId userId db - return req |> Option.map JournalRequest.ofRequestLite -} - -/// Update the recurrence for a request -let updateRecurrence reqId userId recurType db = backgroundTask { - match! tryFullRequestById reqId userId db with - | Some req -> do! doUpdate db { req with Recurrence = recurType } - | None -> invalidOp $"{RequestId.toString reqId} not found" -} - -/// Update a snoozed request -let updateSnoozed reqId userId until db = backgroundTask { - match! tryFullRequestById reqId userId db with - | Some req -> do! doUpdate db { req with SnoozedUntil = until; ShowAfter = until } - | None -> invalidOp $"{RequestId.toString reqId} not found" -} - -/// Update the "show after" timestamp for a request -let updateShowAfter reqId userId showAfter db = backgroundTask { - match! tryFullRequestById reqId userId db with - | Some req -> do! doUpdate db { req with ShowAfter = showAfter } - | None -> invalidOp $"{RequestId.toString reqId} not found" -} + /// Retrieve notes for a request by the request ID + let byRequestId reqId userId = backgroundTask { + match! Request.tryById reqId userId with Some req -> return req.Notes | None -> return [] + } diff --git a/src/MyPrayerJournal/Domain.fs b/src/MyPrayerJournal/Domain.fs index 4201135..de688ed 100644 --- a/src/MyPrayerJournal/Domain.fs +++ b/src/MyPrayerJournal/Domain.fs @@ -1,4 +1,4 @@ -/// The data model for myPrayerJournal +/// The data model for myPrayerJournal [] module MyPrayerJournal.Domain @@ -169,10 +169,10 @@ type Request = Recurrence : Recurrence /// The history entries for this request - History : History[] + History : History list /// The notes for this request - Notes : Note[] + Notes : Note list } /// Functions to support requests @@ -186,8 +186,8 @@ module Request = SnoozedUntil = None ShowAfter = None Recurrence = Immediate - History = [||] - Notes = [||] + History = [] + Notes = [] } @@ -234,7 +234,8 @@ module JournalRequest = /// Convert a request to the form used for the journal (precomputed values, no notes or history) let ofRequestLite (req : Request) = - let lastHistory = req.History |> Array.sortByDescending (fun it -> it.AsOf) |> Array.tryHead + let history = Seq.ofList req.History + let lastHistory = Seq.tryHead history // Requests are sorted by the "as of" field in this record; for sorting to work properly, we will put the // largest of the last prayed date, the "snoozed until". or the "show after" date; if none of those are filled, // we will use the last activity date. This will mean that: @@ -247,19 +248,17 @@ module JournalRequest = let showAfter = defaultArg req.ShowAfter Instant.MinValue let snoozedUntil = defaultArg req.SnoozedUntil Instant.MinValue let lastPrayed = - req.History - |> Array.sortByDescending (fun it -> it.AsOf) - |> Array.filter History.isPrayed - |> Array.tryHead + history + |> Seq.filter History.isPrayed + |> Seq.tryHead |> Option.map (fun it -> it.AsOf) |> Option.defaultValue Instant.MinValue let asOf = List.max [ lastPrayed; showAfter; snoozedUntil ] { RequestId = req.Id UserId = req.UserId - Text = req.History - |> Array.filter (fun it -> Option.isSome it.Text) - |> Array.sortByDescending (fun it -> it.AsOf) - |> Array.tryHead + Text = history + |> Seq.filter (fun it -> Option.isSome it.Text) + |> Seq.tryHead |> Option.map (fun h -> Option.get h.Text) |> Option.defaultValue "" AsOf = if asOf > Instant.MinValue then asOf else lastActivity @@ -275,6 +274,6 @@ module JournalRequest = /// Same as `ofRequestLite`, but with notes and history let ofRequestFull req = { ofRequestLite req with - History = List.ofArray req.History - Notes = List.ofArray req.Notes + History = req.History + Notes = req.Notes } diff --git a/src/MyPrayerJournal/Handlers.fs b/src/MyPrayerJournal/Handlers.fs index a214345..367b042 100644 --- a/src/MyPrayerJournal/Handlers.fs +++ b/src/MyPrayerJournal/Handlers.fs @@ -1,4 +1,4 @@ -/// HTTP handlers for the myPrayerJournal API +/// HTTP handlers for the myPrayerJournal API [] module MyPrayerJournal.Handlers @@ -45,16 +45,12 @@ module Error = open System.Security.Claims -open LiteDB open Microsoft.AspNetCore.Http open NodaTime /// Extensions on the HTTP context type HttpContext with - /// The LiteDB database - member this.Db = this.GetService () - /// The "sub" for the current user (None if no user is authenticated) member this.CurrentUser = this.User @@ -83,6 +79,8 @@ type HttpContext with | None -> DateTimeZone.Utc +open MyPrayerJournal.Data + /// Handler helpers [] module private Helpers = @@ -127,7 +125,7 @@ module private Helpers = let pageContext (ctx : HttpContext) pageTitle content = backgroundTask { let! hasSnoozed = match ctx.CurrentUser with - | Some _ -> Data.hasSnoozed ctx.UserId (ctx.Now ()) ctx.Db + | Some _ -> Journal.hasSnoozed ctx.UserId (ctx.Now ()) | None -> Task.FromResult false return { IsAuthenticated = Option.isSome ctx.CurrentUser @@ -155,17 +153,17 @@ module private Helpers = /// Push a new message into the list let push (ctx : HttpContext) message url = lock upd8 (fun () -> - messages <- messages.Add (ctx.UserId, (message, url))) + messages <- messages.Add (ctx.UserId, (message, url))) /// Add a success message header to the response let pushSuccess ctx message url = - push ctx $"success|||%s{message}" url + push ctx $"success|||%s{message}" url /// Pop the messages for the given user let pop userId = lock upd8 (fun () -> - let msg = messages.TryFind userId - msg |> Option.iter (fun _ -> messages <- messages.Remove userId) - msg) + let msg = messages.TryFind userId + msg |> Option.iter (fun _ -> messages <- messages.Remove userId) + msg) /// Send a partial result if this is not a full page load (does not append no-cache headers) let partialStatic (pageTitle : string) content : HttpHandler = fun next ctx -> task { @@ -238,7 +236,6 @@ module Models = } -open MyPrayerJournal.Data.Extensions open NodaTime.Text /// Handlers for less-than-full-page HTML requests @@ -254,14 +251,14 @@ module Components = | Some snooze, _ when snooze < now -> true | _, Some hide when hide < now -> true | _, _ -> false - let! journal = Data.journalByUserId ctx.UserId ctx.Db + let! journal = Journal.forUser ctx.UserId let shown = journal |> List.filter shouldBeShown return! renderComponent [ Views.Journal.journalItems now ctx.TimeZone shown ] next ctx } // GET /components/request-item/[req-id] let requestItem reqId : HttpHandler = requireUser >=> fun next ctx -> task { - match! Data.tryJournalById (RequestId.ofString reqId) ctx.UserId ctx.Db with + match! Journal.tryById (RequestId.ofString reqId) ctx.UserId with | Some req -> return! renderComponent [ Views.Request.reqListItem (ctx.Now ()) ctx.TimeZone req ] next ctx | None -> return! Error.notFound next ctx } @@ -272,8 +269,8 @@ module Components = // GET /components/request/[req-id]/notes let notes requestId : HttpHandler = requireUser >=> fun next ctx -> task { - let! notes = Data.notesById (RequestId.ofString requestId) ctx.UserId ctx.Db - return! renderComponent (Views.Request.notes (ctx.Now ()) ctx.TimeZone (List.ofArray notes)) next ctx + let! notes = Note.byRequestId (RequestId.ofString requestId) ctx.UserId + return! renderComponent (Views.Request.notes (ctx.Now ()) ctx.TimeZone notes) next ctx } // GET /components/request/[req-id]/snooze @@ -333,7 +330,7 @@ module Request = return! partial "Add Prayer Request" (Views.Request.edit (JournalRequest.ofRequestLite Request.empty) returnTo true) next ctx | _ -> - match! Data.tryJournalById (RequestId.ofString requestId) ctx.UserId ctx.Db with + match! Journal.tryById (RequestId.ofString requestId) ctx.UserId with | Some req -> debug ctx "Found - sending view" return! partial "Edit Prayer Request" (Views.Request.edit req returnTo false) next ctx @@ -344,46 +341,42 @@ module Request = // PATCH /request/[req-id]/prayed let prayed requestId : HttpHandler = requireUser >=> fun next ctx -> task { - let db = ctx.Db let userId = ctx.UserId let reqId = RequestId.ofString requestId - match! Data.tryRequestById reqId userId db with + match! Journal.tryById reqId userId with | Some req -> let now = ctx.Now () - do! Data.addHistory reqId userId { AsOf = now; Status = Prayed; Text = None } db + do! History.add reqId userId { AsOf = now; Status = Prayed; Text = None } let nextShow = match Recurrence.duration req.Recurrence with | 0L -> None | duration -> Some <| now.Plus (Duration.FromSeconds duration) - do! Data.updateShowAfter reqId userId nextShow db - do! db.SaveChanges () + do! Request.updateShowAfter reqId userId nextShow return! (withSuccessMessage "Request marked as prayed" >=> Components.journalItems) next ctx | None -> return! Error.notFound next ctx } - /// POST /request/[req-id]/note + // POST /request/[req-id]/note let addNote requestId : HttpHandler = requireUser >=> fun next ctx -> task { - let db = ctx.Db let userId = ctx.UserId let reqId = RequestId.ofString requestId - match! Data.tryRequestById reqId userId db with - | Some _ -> + match! Request.existsById reqId userId with + | true -> let! notes = ctx.BindFormAsync () - do! Data.addNote reqId userId { AsOf = ctx.Now (); Notes = notes.notes } db - do! db.SaveChanges () + do! Note.add reqId userId { AsOf = ctx.Now (); Notes = notes.notes } return! (withSuccessMessage "Added Notes" >=> hideModal "notes" >=> created) next ctx - | None -> return! Error.notFound next ctx + | false -> return! Error.notFound next ctx } // GET /requests/active let active : HttpHandler = requireUser >=> fun next ctx -> task { - let! reqs = Data.journalByUserId ctx.UserId ctx.Db + let! reqs = Journal.forUser ctx.UserId return! partial "Active Requests" (Views.Request.active (ctx.Now ()) ctx.TimeZone reqs) next ctx } // GET /requests/snoozed let snoozed : HttpHandler = requireUser >=> fun next ctx -> task { - let! reqs = Data.journalByUserId ctx.UserId ctx.Db + let! reqs = Journal.forUser ctx.UserId let now = ctx.Now () let snoozed = reqs |> List.filter (fun it -> defaultArg (it.SnoozedUntil |> Option.map (fun it -> it > now)) false) @@ -392,62 +385,56 @@ module Request = // GET /requests/answered let answered : HttpHandler = requireUser >=> fun next ctx -> task { - let! reqs = Data.answeredRequests ctx.UserId ctx.Db + let! reqs = Journal.answered ctx.UserId return! partial "Answered Requests" (Views.Request.answered (ctx.Now ()) ctx.TimeZone reqs) next ctx } // GET /request/[req-id]/full let getFull requestId : HttpHandler = requireUser >=> fun next ctx -> task { - match! Data.tryFullRequestById (RequestId.ofString requestId) ctx.UserId ctx.Db with + match! Request.tryById (RequestId.ofString requestId) ctx.UserId with | Some req -> return! partial "Prayer Request" (Views.Request.full ctx.Clock ctx.TimeZone req) next ctx | None -> return! Error.notFound next ctx } // PATCH /request/[req-id]/show let show requestId : HttpHandler = requireUser >=> fun next ctx -> task { - let db = ctx.Db let userId = ctx.UserId let reqId = RequestId.ofString requestId - match! Data.tryRequestById reqId userId db with - | Some _ -> - do! Data.updateShowAfter reqId userId None db - do! db.SaveChanges () + match! Request.existsById reqId userId with + | true -> + do! Request.updateShowAfter reqId userId None return! (withSuccessMessage "Request now shown" >=> Components.requestItem requestId) next ctx - | None -> return! Error.notFound next ctx + | false -> return! Error.notFound next ctx } // PATCH /request/[req-id]/snooze let snooze requestId : HttpHandler = requireUser >=> fun next ctx -> task { - let db = ctx.Db let userId = ctx.UserId let reqId = RequestId.ofString requestId - match! Data.tryRequestById reqId userId db with - | Some _ -> + match! Request.existsById reqId userId with + | true -> let! until = ctx.BindFormAsync () let date = LocalDatePattern.CreateWithInvariantCulture("yyyy-MM-dd").Parse(until.until).Value .AtStartOfDayInZone(DateTimeZone.Utc) .ToInstant () - do! Data.updateSnoozed reqId userId (Some date) db - do! db.SaveChanges () + do! Request.updateSnoozed reqId userId (Some date) return! (withSuccessMessage $"Request snoozed until {until.until}" >=> hideModal "snooze" >=> Components.journalItems) next ctx - | None -> return! Error.notFound next ctx + | false -> return! Error.notFound next ctx } // PATCH /request/[req-id]/cancel-snooze let cancelSnooze requestId : HttpHandler = requireUser >=> fun next ctx -> task { - let db = ctx.Db let userId = ctx.UserId let reqId = RequestId.ofString requestId - match! Data.tryRequestById reqId userId db with - | Some _ -> - do! Data.updateSnoozed reqId userId None db - do! db.SaveChanges () + match! Request.existsById reqId userId with + | true -> + do! Request.updateSnoozed reqId userId None return! (withSuccessMessage "Request unsnoozed" >=> Components.requestItem requestId) next ctx - | None -> return! Error.notFound next ctx + | false -> return! Error.notFound next ctx } /// Derive a recurrence from its representation in the form @@ -458,7 +445,6 @@ module Request = // POST /request let add : HttpHandler = requireUser >=> fun next ctx -> task { let! form = ctx.BindModelAsync () - let db = ctx.Db let userId = ctx.UserId let now = ctx.Now () let req = @@ -468,15 +454,14 @@ module Request = EnteredOn = now ShowAfter = None Recurrence = parseRecurrence form - History = [| + History = [ { AsOf = now Status = Created Text = Some form.requestText } - |] + ] } - Data.addRequest req db - do! db.SaveChanges () + do! Request.add req Messages.pushSuccess ctx "Added prayer request" "/journal" return! seeOther "/journal" next ctx } @@ -484,25 +469,24 @@ module Request = // PATCH /request let update : HttpHandler = requireUser >=> fun next ctx -> task { let! form = ctx.BindModelAsync () - let db = ctx.Db let userId = ctx.UserId - match! Data.tryJournalById (RequestId.ofString form.requestId) userId db with + // TODO: update the instance and save rather than all these little updates + match! Journal.tryById (RequestId.ofString form.requestId) userId with | Some req -> // update recurrence if changed let recur = parseRecurrence form match recur = req.Recurrence with | true -> () | false -> - do! Data.updateRecurrence req.RequestId userId recur db + do! Request.updateRecurrence req.RequestId userId recur match recur with - | Immediate -> do! Data.updateShowAfter req.RequestId userId None db + | Immediate -> do! Request.updateShowAfter req.RequestId userId None | _ -> () // append history let upd8Text = form.requestText.Trim () let text = if upd8Text = req.Text then None else Some upd8Text - do! Data.addHistory req.RequestId userId - { AsOf = ctx.Now (); Status = (Option.get >> RequestAction.ofString) form.status; Text = text } db - do! db.SaveChanges () + do! History.add req.RequestId userId + { AsOf = ctx.Now (); Status = (Option.get >> RequestAction.ofString) form.status; Text = text } let nextUrl = match form.returnTo with | "active" -> "/requests/active" diff --git a/src/MyPrayerJournal/MyPrayerJournal.fsproj b/src/MyPrayerJournal/MyPrayerJournal.fsproj index e0b999f..4ab242d 100644 --- a/src/MyPrayerJournal/MyPrayerJournal.fsproj +++ b/src/MyPrayerJournal/MyPrayerJournal.fsproj @@ -1,10 +1,11 @@ - + net7.0 - 3.2 + 3.3 embedded false - 3391 + false + false @@ -19,15 +20,16 @@ - + + - - - - - - - + + + + + + + diff --git a/src/MyPrayerJournal/Program.fs b/src/MyPrayerJournal/Program.fs index 134068d..38e46e0 100644 --- a/src/MyPrayerJournal/Program.fs +++ b/src/MyPrayerJournal/Program.fs @@ -1,169 +1,111 @@ module MyPrayerJournal.Api +open Microsoft.AspNetCore.Http + +let sameSite (opts : CookieOptions) = + match opts.SameSite, opts.Secure with + | SameSiteMode.None, false -> opts.SameSite <- SameSiteMode.Unspecified + | _, _ -> () + +open Giraffe +open Giraffe.EndpointRouting +open Microsoft.AspNetCore.Authentication.Cookies +open Microsoft.AspNetCore.Authentication.OpenIdConnect open Microsoft.AspNetCore.Builder -open Microsoft.AspNetCore.Hosting -open System.IO - -/// Configuration functions for the application -module Configure = - - /// Configure the content root - let contentRoot root = - WebApplicationOptions (ContentRootPath = root) |> WebApplication.CreateBuilder - - - open Microsoft.Extensions.Configuration - - /// Configure the application configuration - let appConfiguration (bldr : WebApplicationBuilder) = - bldr.Configuration - .SetBasePath(bldr.Environment.ContentRootPath) - .AddJsonFile("appsettings.json", optional = false, reloadOnChange = true) - .AddJsonFile($"appsettings.{bldr.Environment.EnvironmentName}.json", optional = true, reloadOnChange = true) - .AddEnvironmentVariables () - |> ignore - bldr - - - open Microsoft.AspNetCore.Server.Kestrel.Core - - /// Configure Kestrel from appsettings.json - let kestrel (bldr : WebApplicationBuilder) = - let kestrelOpts (ctx : WebHostBuilderContext) (opts : KestrelServerOptions) = - (ctx.Configuration.GetSection >> opts.Configure >> ignore) "Kestrel" - bldr.WebHost.UseKestrel().ConfigureKestrel kestrelOpts |> ignore - bldr - - - /// Configure the web root directory - let webRoot pathSegments (bldr : WebApplicationBuilder) = - Array.concat [ [| bldr.Environment.ContentRootPath |]; pathSegments ] - |> (Path.Combine >> bldr.WebHost.UseWebRoot >> ignore) - bldr - - - open Microsoft.Extensions.Logging - open Microsoft.Extensions.Hosting - - /// Configure logging - let logging (bldr : WebApplicationBuilder) = - if bldr.Environment.IsDevelopment () then bldr.Logging.AddFilter (fun l -> l > LogLevel.Information) |> ignore - bldr.Logging.AddConsole().AddDebug() |> ignore - bldr - - - open Giraffe - open LiteDB - open Microsoft.AspNetCore.Authentication.Cookies - open Microsoft.AspNetCore.Authentication.OpenIdConnect - open Microsoft.AspNetCore.Http - open Microsoft.Extensions.DependencyInjection - open Microsoft.IdentityModel.Protocols.OpenIdConnect - open NodaTime - open System - open System.Text.Json - open System.Text.Json.Serialization - open System.Threading.Tasks - - /// Configure dependency injection - let services (bldr : WebApplicationBuilder) = - let sameSite (opts : CookieOptions) = - match opts.SameSite, opts.Secure with - | SameSiteMode.None, false -> opts.SameSite <- SameSiteMode.Unspecified - | _, _ -> () - - let _ = bldr.Services.AddRouting () - let _ = bldr.Services.AddGiraffe () - let _ = bldr.Services.AddSingleton SystemClock.Instance - let _ = bldr.Services.AddSingleton DateTimeZoneProviders.Tzdb - - let _ = - bldr.Services.Configure(fun (opts : CookiePolicyOptions) -> - opts.MinimumSameSitePolicy <- SameSiteMode.Unspecified - opts.OnAppendCookie <- fun ctx -> sameSite ctx.CookieOptions - opts.OnDeleteCookie <- fun ctx -> sameSite ctx.CookieOptions) - let _ = - bldr.Services.AddAuthentication(fun opts -> - opts.DefaultAuthenticateScheme <- CookieAuthenticationDefaults.AuthenticationScheme - opts.DefaultSignInScheme <- CookieAuthenticationDefaults.AuthenticationScheme - opts.DefaultChallengeScheme <- CookieAuthenticationDefaults.AuthenticationScheme) - .AddCookie() - .AddOpenIdConnect("Auth0", fun opts -> - // Configure OIDC with Auth0 options from configuration - let cfg = bldr.Configuration.GetSection "Auth0" - opts.Authority <- $"""https://{cfg["Domain"]}/""" - opts.ClientId <- cfg["Id"] - opts.ClientSecret <- cfg["Secret"] - opts.ResponseType <- OpenIdConnectResponseType.Code - - opts.Scope.Clear () - opts.Scope.Add "openid" - opts.Scope.Add "profile" - - opts.CallbackPath <- PathString "/user/log-on/success" - opts.ClaimsIssuer <- "Auth0" - opts.SaveTokens <- true - - opts.Events <- OpenIdConnectEvents () - opts.Events.OnRedirectToIdentityProviderForSignOut <- fun ctx -> - let returnTo = - match ctx.Properties.RedirectUri with - | it when isNull it || it = "" -> "" - | redirUri -> - let finalRedirUri = - match redirUri.StartsWith "/" with - | true -> - // transform to absolute - let request = ctx.Request - $"{request.Scheme}://{request.Host.Value}{request.PathBase.Value}{redirUri}" - | false -> redirUri - Uri.EscapeDataString $"&returnTo={finalRedirUri}" - ctx.Response.Redirect $"""https://{cfg["Domain"]}/v2/logout?client_id={cfg["Id"]}{returnTo}""" - ctx.HandleResponse () - Task.CompletedTask - opts.Events.OnRedirectToIdentityProvider <- fun ctx -> - let bldr = UriBuilder ctx.ProtocolMessage.RedirectUri - bldr.Scheme <- cfg["Scheme"] - bldr.Port <- int cfg["Port"] - ctx.ProtocolMessage.RedirectUri <- string bldr - Task.CompletedTask) - - let jsonOptions = JsonSerializerOptions () - jsonOptions.Converters.Add (JsonFSharpConverter ()) - let db = new LiteDatabase (bldr.Configuration.GetConnectionString "db") - Data.Startup.ensureDb db - let _ = bldr.Services.AddSingleton jsonOptions - let _ = bldr.Services.AddSingleton () - let _ = bldr.Services.AddSingleton db - - bldr.Build () - - - open Giraffe.EndpointRouting - - /// Configure the web application - let application (app : WebApplication) = - let _ = app.UseStaticFiles () - let _ = app.UseCookiePolicy () - let _ = app.UseRouting () - let _ = app.UseAuthentication () - let _ = app.UseGiraffeErrorHandler Handlers.Error.error - let _ = app.UseEndpoints (fun e -> e.MapGiraffeEndpoints Handlers.routes) - app - - /// Compose all the configurations into one - let webHost pathSegments = - contentRoot - >> appConfiguration - >> kestrel - >> webRoot pathSegments - >> logging - >> services - >> application - +open Microsoft.AspNetCore.HttpOverrides +open Microsoft.Extensions.Configuration +open Microsoft.Extensions.DependencyInjection +open Microsoft.Extensions.Hosting +open Microsoft.Extensions.Logging +open Microsoft.IdentityModel.Protocols.OpenIdConnect +open MyPrayerJournal.Data +open NodaTime +open System +open System.Text.Json +open System.Threading.Tasks [] -let main _ = - use host = Configure.webHost [| "wwwroot" |] (Directory.GetCurrentDirectory ()) - host.Run () +let main args = + //use host = Configure.webHost [| "wwwroot" |] (Directory.GetCurrentDirectory ()) + //host.Run () + let builder = WebApplication.CreateBuilder args + let _ = builder.Configuration.AddEnvironmentVariables "MPJ_" + let svc = builder.Services + let cfg = svc.BuildServiceProvider().GetRequiredService () + + let _ = svc.AddRouting () + let _ = svc.AddGiraffe () + let _ = svc.AddSingleton SystemClock.Instance + let _ = svc.AddSingleton DateTimeZoneProviders.Tzdb + let _ = svc.Configure(fun (opts : ForwardedHeadersOptions) -> + opts.ForwardedHeaders <- ForwardedHeaders.XForwardedFor ||| ForwardedHeaders.XForwardedProto) + + let _ = + svc.Configure(fun (opts : CookiePolicyOptions) -> + opts.MinimumSameSitePolicy <- SameSiteMode.Unspecified + opts.OnAppendCookie <- fun ctx -> sameSite ctx.CookieOptions + opts.OnDeleteCookie <- fun ctx -> sameSite ctx.CookieOptions) + let _ = + svc.AddAuthentication(fun opts -> + opts.DefaultAuthenticateScheme <- CookieAuthenticationDefaults.AuthenticationScheme + opts.DefaultSignInScheme <- CookieAuthenticationDefaults.AuthenticationScheme + opts.DefaultChallengeScheme <- CookieAuthenticationDefaults.AuthenticationScheme) + .AddCookie() + .AddOpenIdConnect("Auth0", fun opts -> + // Configure OIDC with Auth0 options from configuration + let auth0 = cfg.GetSection "Auth0" + opts.Authority <- $"""https://{auth0["Domain"]}/""" + opts.ClientId <- auth0["Id"] + opts.ClientSecret <- auth0["Secret"] + opts.ResponseType <- OpenIdConnectResponseType.Code + + opts.Scope.Clear () + opts.Scope.Add "openid" + opts.Scope.Add "profile" + + opts.CallbackPath <- PathString "/user/log-on/success" + opts.ClaimsIssuer <- "Auth0" + opts.SaveTokens <- true + + opts.Events <- OpenIdConnectEvents () + opts.Events.OnRedirectToIdentityProviderForSignOut <- fun ctx -> + let returnTo = + match ctx.Properties.RedirectUri with + | it when isNull it || it = "" -> "" + | redirUri -> + let finalRedirUri = + match redirUri.StartsWith "/" with + | true -> + // transform to absolute + let request = ctx.Request + $"{request.Scheme}://{request.Host.Value}{request.PathBase.Value}{redirUri}" + | false -> redirUri + Uri.EscapeDataString $"&returnTo={finalRedirUri}" + ctx.Response.Redirect $"""https://{auth0["Domain"]}/v2/logout?client_id={auth0["Id"]}{returnTo}""" + ctx.HandleResponse () + Task.CompletedTask + opts.Events.OnRedirectToIdentityProvider <- fun ctx -> + let uri = UriBuilder ctx.ProtocolMessage.RedirectUri + uri.Scheme <- auth0["Scheme"] + uri.Port <- int auth0["Port"] + ctx.ProtocolMessage.RedirectUri <- string uri + Task.CompletedTask) + + let _ = svc.AddSingleton Json.options + let _ = svc.AddSingleton (SystemTextJson.Serializer Json.options) + let _ = Connection.setUp cfg |> Async.AwaitTask |> Async.RunSynchronously + + if builder.Environment.IsDevelopment () then builder.Logging.AddFilter (fun l -> l > LogLevel.Information) |> ignore + let _ = builder.Logging.AddConsole().AddDebug() |> ignore + + use app = builder.Build () + let _ = app.UseStaticFiles () + let _ = app.UseCookiePolicy () + let _ = app.UseRouting () + let _ = app.UseAuthentication () + let _ = app.UseGiraffeErrorHandler Handlers.Error.error + let _ = app.UseEndpoints (fun e -> e.MapGiraffeEndpoints Handlers.routes) + + app.Run () + 0 diff --git a/src/MyPrayerJournal/Views/Layout.fs b/src/MyPrayerJournal/Views/Layout.fs index b495980..cdd0022 100644 --- a/src/MyPrayerJournal/Views/Layout.fs +++ b/src/MyPrayerJournal/Views/Layout.fs @@ -77,9 +77,9 @@ let htmlHead ctx = meta [ _name "viewport"; _content "width=device-width, initial-scale=1" ] meta [ _name "description"; _content "Online prayer journal - free w/Google or Microsoft account" ] titleTag ctx - link [ _href "https://cdn.jsdelivr.net/npm/bootstrap@5.2.0/dist/css/bootstrap.min.css" + link [ _href "https://cdn.jsdelivr.net/npm/bootstrap@5.3.2/dist/css/bootstrap.min.css" _rel "stylesheet" - _integrity "sha384-gH2yIJqKdNHPEq0n4Mqa/HGKIhSkIHeL5AyhkYV8i59U5AR6csBvApHHNl/vI1Bx" + _integrity "sha384-T3c6CoIi6uLrA9TneNEoa7RxnatzjcDSCmG1MXxSR1GAsXEV/Dwwykc2MPK8M2HN" _crossorigin "anonymous" ] link [ _href "https://fonts.googleapis.com/icon?family=Material+Icons"; _rel "stylesheet" ] link [ _href "/style/style.css"; _rel "stylesheet" ] @@ -118,8 +118,8 @@ let htmlFoot = rawText "if (!htmx) document.write('