bit-badger/PrayerTracker
1
0
Fork 0
Code Issues 2 Pull Requests Packages Projects Releases 16 Activity

Config conns for migration (#55)

Browse Source 
- Update deps
This commit is contained in:
Daniel J. Summers 2025-01-31 07:02:10 -05:00
parent d86249c18e
commit 2b5ec692f2
7 changed files with 271 additions and 228 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

37
src/PrayerTracker.Data/Access.fs
View File

@ -67,15 +67,24 @@ module Json =
opts.DefaultIgnoreCondition <- JsonIgnoreCondition.WhenWritingNull opts.DefaultIgnoreCondition <- JsonIgnoreCondition.WhenWritingNull
opts opts
open BitBadger.Documents
open BitBadger.Documents.Sqlite open BitBadger.Documents.Sqlite
/// Establish the required data environment /// Establish the required data environment
[<RequireQualifiedAccess>] [<RequireQualifiedAccess>]
module Environment = module Connection =
open System.Text.Json
/// Ensure tables and indexes are defined /// Ensure tables and indexes are defined
let setUp () = backgroundTask { let setUp () = backgroundTask {
Configuration.useIdField "id"
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)
}
let! tables = Custom.list<string> "SELECT table_name FROM sqlite_master" [] _.GetString(0) let! tables = Custom.list<string> "SELECT table_name FROM sqlite_master" [] _.GetString(0)
if not (List.contains Table.Church tables) then if not (List.contains Table.Church tables) then
do! Definition.ensureTable Table.Church do! Definition.ensureTable Table.Church
@ -310,17 +319,17 @@ module SmallGroups =
Count.byFields Table.Group All [ Field.Equal "churchId" churchId ] Count.byFields Table.Group All [ Field.Equal "churchId" churchId ]
/// Delete a small group by its ID /// Delete a small group by its ID
let deleteById (groupId : SmallGroupId) = backgroundTask { let deleteById (groupId: SmallGroupId) = backgroundTask {
let idParam = [ [ "@groupId", Sql.uuid groupId.Value ] ] use conn = Configuration.dbConn ()
let! _ = use txn = conn.BeginTransaction()
BitBadger.Documents.Postgres.Configuration.dataSource ()
|> Sql.fromDataSource let! users = Find.byFields<User> Table.User All [ Field.InArray "smallGroups" Table.User [ groupId ] ]
|> Sql.executeTransactionAsync for user in users do
[ "DELETE FROM pt.prayer_request WHERE small_group_id = @groupId", idParam do! Patch.byId Table.User user.Id {| SmallGroups = user.SmallGroups |> List.except [ groupId ] |}
"DELETE FROM pt.user_small_group WHERE small_group_id = @groupId", idParam do! conn.deleteByFields Table.Request All [ Field.Equal "smallGroupId" groupId ]
"DELETE FROM pt.list_preference WHERE small_group_id = @groupId", idParam do! conn.deleteById Table.Group groupId
"DELETE FROM pt.small_group WHERE id = @groupId", idParam ]
() do! txn.CommitAsync()
} }
/// Get information for all small groups /// Get information for all small groups

2
src/PrayerTracker.Data/PrayerTracker.Data.fsproj
View File

@ -14,7 +14,7 @@
<PackageReference Include="NodaTime.Serialization.SystemTextJson" Version="1.3.0" /> <PackageReference Include="NodaTime.Serialization.SystemTextJson" Version="1.3.0" />
<PackageReference Include="Npgsql.FSharp" Version="5.7.0" /> <PackageReference Include="Npgsql.FSharp" Version="5.7.0" />
<PackageReference Include="Npgsql.NodaTime" Version="8.0.3" /> <PackageReference Include="Npgsql.NodaTime" Version="8.0.3" />
<PackageReference Update="FSharp.Core" Version="9.0.100" /> <PackageReference Update="FSharp.Core" Version="9.0.101" />
</ItemGroup> </ItemGroup>
</Project> </Project>

155
src/PrayerTracker.MigrateV9/Program.fs
View File

@ -1,112 +1,103 @@
 
open NodaTime open NodaTime
open Npgsql.FSharp
open PrayerTracker.Data
open PrayerTracker.Entities open PrayerTracker.Entities
module PgMappings = module PgMappings =
/// Map a row to a Church instance /// Map a row to a Church instance
let mapToChurch (row : RowReader) = let mapToChurch (row: RowReader) =
{ Id = ChurchId (row.uuid "id") { Id = ChurchId (row.uuid "id")
Name = row.string "church_name" Name = row.string "church_name"
City = row.string "city" City = row.string "city"
State = row.string "state" State = row.string "state"
HasVpsInterface = row.bool "has_vps_interface" HasVpsInterface = row.bool "has_vps_interface"
InterfaceAddress = row.stringOrNone "interface_address" InterfaceAddress = row.stringOrNone "interface_address" }
}
/// Map a row to a ListPreferences instance
let mapToListPreferences (row : RowReader) =
{ SmallGroupId = SmallGroupId (row.uuid "small_group_id")
DaysToKeepNew = row.int "days_to_keep_new"
DaysToExpire = row.int "days_to_expire"
LongTermUpdateWeeks = row.int "long_term_update_weeks"
EmailFromName = row.string "email_from_name"
EmailFromAddress = row.string "email_from_address"
Fonts = row.string "fonts"
HeadingColor = row.string "heading_color"
LineColor = row.string "line_color"
HeadingFontSize = row.int "heading_font_size"
TextFontSize = row.int "text_font_size"
GroupPassword = row.string "group_password"
IsPublic = row.bool "is_public"
PageSize = row.int "page_size"
TimeZoneId = TimeZoneId (row.string "time_zone_id")
RequestSort = RequestSort.Parse (row.string "request_sort")
DefaultEmailType = EmailFormat.Parse (row.string "default_email_type")
AsOfDateDisplay = AsOfDateDisplay.Parse (row.string "as_of_date_display")
}
/// Map a row to a Member instance /// Map a row to a Member instance
let mapToMember (row : RowReader) = let mapToMember (row: RowReader) =
{ Id = MemberId (row.uuid "id") { Id = MemberId (row.uuid "id")
SmallGroupId = SmallGroupId (row.uuid "small_group_id") SmallGroupId = SmallGroupId (row.uuid "small_group_id")
Name = row.string "member_name" Name = row.string "member_name"
Email = row.string "email" Email = row.string "email"
Format = row.stringOrNone "email_format" |> Option.map EmailFormat.Parse Format = row.stringOrNone "email_format" |> Option.map EmailFormat.Parse }
}
/// Map a row to a Prayer Request instance /// Map a row to a Prayer Request instance
let mapToPrayerRequest (row : RowReader) = let mapToPrayerRequest (row: RowReader) =
{ Id = PrayerRequestId (row.uuid "id") { Id = PrayerRequestId (row.uuid "id")
UserId = UserId (row.uuid "user_id") UserId = UserId (row.uuid "user_id")
SmallGroupId = SmallGroupId (row.uuid "small_group_id") SmallGroupId = SmallGroupId (row.uuid "small_group_id")
EnteredDate = row.fieldValue<Instant> "entered_date" EnteredDate = row.fieldValue<Instant> "entered_date"
UpdatedDate = row.fieldValue<Instant> "updated_date" UpdatedDate = row.fieldValue<Instant> "updated_date"
Requestor = row.stringOrNone "requestor" Requestor = row.stringOrNone "requestor"
Text = row.string "request_text" Text = row.string "request_text"
NotifyChaplain = row.bool "notify_chaplain" NotifyChaplain = row.bool "notify_chaplain"
RequestType = PrayerRequestType.Parse (row.string "request_type") RequestType = PrayerRequestType.Parse (row.string "request_type")
Expiration = Expiration.Parse (row.string "expiration") Expiration = Expiration.Parse (row.string "expiration") }
}
/// Map a row to a Small Group instance /// Map a row to a Small Group instance
let mapToSmallGroup (row : RowReader) = let mapToSmallGroup (row: RowReader) =
{ Id = SmallGroupId (row.uuid "id") { Id = SmallGroupId (row.uuid "id")
ChurchId = ChurchId (row.uuid "church_id") ChurchId = ChurchId (row.uuid "church_id")
Name = row.string "group_name" Name = row.string "group_name"
Preferences = ListPreferences.Empty Preferences =
} { SmallGroupId = SmallGroupId (row.uuid "small_group_id")
DaysToKeepNew = row.int "days_to_keep_new"
/// Map a row to a Small Group instance with populated list preferences DaysToExpire = row.int "days_to_expire"
let mapToSmallGroupWithPreferences (row : RowReader) = LongTermUpdateWeeks = row.int "long_term_update_weeks"
{ mapToSmallGroup row with EmailFromName = row.string "email_from_name"
Preferences = mapToListPreferences row EmailFromAddress = row.string "email_from_address"
} Fonts = row.string "fonts"
HeadingColor = row.string "heading_color"
LineColor = row.string "line_color"
HeadingFontSize = row.int "heading_font_size"
TextFontSize = row.int "text_font_size"
GroupPassword = row.string "group_password"
IsPublic = row.bool "is_public"
PageSize = row.int "page_size"
TimeZoneId = TimeZoneId (row.string "time_zone_id")
RequestSort = RequestSort.Parse (row.string "request_sort")
DefaultEmailType = EmailFormat.Parse (row.string "default_email_type")
AsOfDateDisplay = AsOfDateDisplay.Parse (row.string "as_of_date_display") } }
/// Map a row to a User instance /// Map a row to a User instance
let mapToUser (row : RowReader) = let mapToUser (row: RowReader) =
{ Id = UserId (row.uuid "id") { Id = UserId (row.uuid "id")
FirstName = row.string "first_name" FirstName = row.string "first_name"
LastName = row.string "last_name" LastName = row.string "last_name"
Email = row.string "email" Email = row.string "email"
IsAdmin = row.bool "is_admin" IsAdmin = row.bool "is_admin"
PasswordHash = row.string "password_hash" PasswordHash = row.string "password_hash"
LastSeen = row.fieldValueOrNone<Instant> "last_seen" LastSeen = row.fieldValueOrNone<Instant> "last_seen"
SmallGroups = [] SmallGroups = [] }
}
// TODO: Configure PostgreSQL and SQLite connections
open System
open BitBadger.Documents.Sqlite
open Npgsql
open Npgsql.FSharp
open PrayerTracker.Data
task { task {
let source = BitBadger.Documents.Postgres.Configuration.dataSource () Configuration.useConnectionString (Environment.GetEnvironmentVariable "PT_SQLITE_CONN")
do! Connection.setUp ()
use source = NpgsqlDataSourceBuilder(Environment.GetEnvironmentVariable "PT_PG_CONN").Build()
let! churches = let! churches =
Sql.fromDataSource source Sql.fromDataSource source
|> Sql.query "SELECT * FROM pt.church" |> Sql.query "SELECT * FROM pt.church"
|> Sql.executeAsync PgMappings.mapToChurch |> Sql.executeAsync PgMappings.mapToChurch
for church in churches do for church in churches do
do! BitBadger.Documents.Sqlite.Document.insert Table.Church church do! Churches.save church
printfn "Migrated %d churches" churches.Length printfn "Migrated %d churches" churches.Length
let! groups = let! groups =
Sql.fromDataSource source Sql.fromDataSource source
|> Sql.query "SELECT sg.*, lp.* FROM pt.small_group sg |> Sql.query "SELECT sg.*, lp.* FROM pt.small_group sg
INNER JOIN pt.list_preference lp ON lp.small_group_id = sg.id" INNER JOIN pt.list_preference lp ON lp.small_group_id = sg.id"
|> Sql.executeAsync PgMappings.mapToSmallGroupWithPreferences |> Sql.executeAsync PgMappings.mapToSmallGroup
for group in groups do for group in groups do
do! BitBadger.Documents.Sqlite.Document.insert Table.Group group do! SmallGroups.save group
printfn "Migrated %d groups" groups.Length printfn "Migrated %d groups" groups.Length
let! members = let! members =
@ -114,7 +105,7 @@ task {
|> Sql.query "SELECT * from pt.member" |> Sql.query "SELECT * from pt.member"
|> Sql.executeAsync PgMappings.mapToMember |> Sql.executeAsync PgMappings.mapToMember
for mbr in members do for mbr in members do
do! BitBadger.Documents.Sqlite.Document.insert Table.Member mbr do! Members.save mbr
printfn "Migrated %d members" members.Length printfn "Migrated %d members" members.Length
let! requests = let! requests =
@ -122,7 +113,7 @@ task {
|> Sql.query "SELECT * from pt.prayer_request" |> Sql.query "SELECT * from pt.prayer_request"
|> Sql.executeAsync PgMappings.mapToPrayerRequest |> Sql.executeAsync PgMappings.mapToPrayerRequest
for request in requests do for request in requests do
do! BitBadger.Documents.Sqlite.Document.insert Table.Request request do! PrayerRequests.save request
printfn "Migrated %d requests" requests.Length printfn "Migrated %d requests" requests.Length
let! users = let! users =
@ -135,7 +126,7 @@ task {
|> Sql.query "SELECT small_group_id FROM pt.user_small_group WHERE user_id = :user_id" |> Sql.query "SELECT small_group_id FROM pt.user_small_group WHERE user_id = :user_id"
|> Sql.parameters [ ":user_id", Sql.uuid user.Id.Value ] |> Sql.parameters [ ":user_id", Sql.uuid user.Id.Value ]
|> Sql.executeAsync (fun row -> (row.uuid >> SmallGroupId) "small_group_id") |> Sql.executeAsync (fun row -> (row.uuid >> SmallGroupId) "small_group_id")
do! BitBadger.Documents.Sqlite.Document.insert Table.User { user with SmallGroups = groups } do! Users.save { user with SmallGroups = groups }
printfn "Migrated %d users" users.Length printfn "Migrated %d users" users.Length
} |> Async.AwaitTask |> Async.RunSynchronously } |> Async.AwaitTask |> Async.RunSynchronously

4
src/PrayerTracker.Tests/PrayerTracker.Tests.fsproj
View File

@ -15,8 +15,8 @@
<ItemGroup> <ItemGroup>
<PackageReference Include="Expecto" Version="10.2.1" /> <PackageReference Include="Expecto" Version="10.2.1" />
<PackageReference Include="NodaTime.Testing" Version="3.2.0" /> <PackageReference Include="NodaTime.Testing" Version="3.2.1" />
<PackageReference Update="FSharp.Core" Version="9.0.100" /> <PackageReference Update="FSharp.Core" Version="9.0.101" />
</ItemGroup> </ItemGroup>
<ItemGroup> <ItemGroup>

12
src/PrayerTracker.UI/PrayerTracker.UI.fsproj
View File

@ -18,13 +18,13 @@
<PackageReference Include="Giraffe.Fixi" Version="0.5.7" /> <PackageReference Include="Giraffe.Fixi" Version="0.5.7" />
<PackageReference Include="Giraffe.ViewEngine" Version="1.4.0" /> <PackageReference Include="Giraffe.ViewEngine" Version="1.4.0" />
<PackageReference Include="Giraffe.ViewEngine.Htmx" Version="2.0.4" /> <PackageReference Include="Giraffe.ViewEngine.Htmx" Version="2.0.4" />
<PackageReference Include="MailKit" Version="4.9.0" /> <PackageReference Include="MailKit" Version="4.10.0" />
<PackageReference Include="Microsoft.AspNetCore.Html.Abstractions" Version="2.2.0" /> <PackageReference Include="Microsoft.AspNetCore.Html.Abstractions" Version="2.3.0" />
<PackageReference Include="Microsoft.AspNetCore.Http" Version="2.2.2" /> <PackageReference Include="Microsoft.AspNetCore.Http" Version="2.3.0" />
<PackageReference Include="Microsoft.AspNetCore.Http.Extensions" Version="2.2.0" /> <PackageReference Include="Microsoft.AspNetCore.Http.Extensions" Version="2.3.0" />
<PackageReference Include="Microsoft.AspNetCore.Mvc" Version="2.2.0" /> <PackageReference Include="Microsoft.AspNetCore.Mvc" Version="2.3.0" />
<PackageReference Include="Newtonsoft.Json" Version="13.0.3" /> <PackageReference Include="Newtonsoft.Json" Version="13.0.3" />
<PackageReference Update="FSharp.Core" Version="9.0.100" /> <PackageReference Update="FSharp.Core" Version="9.0.101" />
</ItemGroup> </ItemGroup>
<ItemGroup> <ItemGroup>

287
src/PrayerTracker/App.fs
View File

@ -3,12 +3,13 @@ namespace PrayerTracker
open Microsoft.AspNetCore.Http open Microsoft.AspNetCore.Http
/// Middleware to add the starting ticks for the request /// Middleware to add the starting ticks for the request
type RequestStartMiddleware (next: RequestDelegate) = type RequestStartMiddleware(next: RequestDelegate) =
member this.InvokeAsync(ctx: HttpContext) = task { member this.InvokeAsync(ctx: HttpContext) =
ctx.Items[Key.startTime] <- ctx.Now task {
return! next.Invoke ctx ctx.Items[Key.startTime] <- ctx.Now
} return! next.Invoke ctx
}
open System open System
@ -19,23 +20,24 @@ open Microsoft.Extensions.Configuration
/// Module to hold configuration for the web app /// Module to hold configuration for the web app
[<RequireQualifiedAccess>] [<RequireQualifiedAccess>]
module Configure = module Configure =
/// Set up the configuration for the app /// Set up the configuration for the app
let configuration (ctx: WebHostBuilderContext) (cfg: IConfigurationBuilder) = let configuration (ctx: WebHostBuilderContext) (cfg: IConfigurationBuilder) =
cfg.SetBasePath(ctx.HostingEnvironment.ContentRootPath) cfg
.SetBasePath(ctx.HostingEnvironment.ContentRootPath)
.AddJsonFile("appsettings.json", optional = true, reloadOnChange = true) .AddJsonFile("appsettings.json", optional = true, reloadOnChange = true)
.AddJsonFile($"appsettings.{ctx.HostingEnvironment.EnvironmentName}.json", optional = true) .AddJsonFile($"appsettings.{ctx.HostingEnvironment.EnvironmentName}.json", optional = true)
.AddEnvironmentVariables() .AddEnvironmentVariables()
|> ignore |> ignore
open Microsoft.AspNetCore.Server.Kestrel.Core open Microsoft.AspNetCore.Server.Kestrel.Core
/// Configure Kestrel from appsettings.json /// Configure Kestrel from appsettings.json
let kestrel (ctx: WebHostBuilderContext) (opts: KestrelServerOptions) = let kestrel (ctx: WebHostBuilderContext) (opts: KestrelServerOptions) =
(ctx.Configuration.GetSection >> opts.Configure >> ignore) "Kestrel" (ctx.Configuration.GetSection >> opts.Configure >> ignore) "Kestrel"
open System.Globalization open System.Globalization
open BitBadger.Documents.Postgres open BitBadger.Documents.Sqlite
open Microsoft.AspNetCore.Authentication.Cookies open Microsoft.AspNetCore.Authentication.Cookies
open Microsoft.AspNetCore.Localization open Microsoft.AspNetCore.Localization
open Microsoft.Extensions.Caching.Distributed open Microsoft.Extensions.Caching.Distributed
@ -43,131 +45,153 @@ module Configure =
open NodaTime open NodaTime
open Npgsql open Npgsql
open PrayerTracker.Data open PrayerTracker.Data
/// Configure ASP.NET Core's service collection (dependency injection container) /// Configure ASP.NET Core's service collection (dependency injection container)
let services (svc: IServiceCollection) = let services (svc: IServiceCollection) =
let _ = svc.AddOptions() let _ = svc.AddOptions()
let _ = svc.AddLocalization(fun options -> options.ResourcesPath <- "Resources") let _ = svc.AddLocalization(fun options -> options.ResourcesPath <- "Resources")
let _ = let _ =
svc.Configure<RequestLocalizationOptions>(fun (opts: RequestLocalizationOptions) -> svc.Configure<RequestLocalizationOptions>(fun (opts: RequestLocalizationOptions) ->
let supportedCultures = let supportedCultures =
[| CultureInfo "en-US"; CultureInfo "en-GB"; CultureInfo "en-AU"; CultureInfo "en" [| CultureInfo "en-US"
CultureInfo "es-MX"; CultureInfo "es-ES"; CultureInfo "es" |] CultureInfo "en-GB"
CultureInfo "en-AU"
CultureInfo "en"
CultureInfo "es-MX"
CultureInfo "es-ES"
CultureInfo "es" |]
opts.DefaultRequestCulture <- RequestCulture("en-US", "en-US") opts.DefaultRequestCulture <- RequestCulture("en-US", "en-US")
opts.SupportedCultures <- supportedCultures opts.SupportedCultures <- supportedCultures
opts.SupportedUICultures <- supportedCultures) opts.SupportedUICultures <- supportedCultures)
let _ = let _ =
svc.AddAuthentication(CookieAuthenticationDefaults.AuthenticationScheme) svc
.AddAuthentication(CookieAuthenticationDefaults.AuthenticationScheme)
.AddCookie(fun opts -> .AddCookie(fun opts ->
opts.ExpireTimeSpan <- TimeSpan.FromMinutes 120. opts.ExpireTimeSpan <- TimeSpan.FromMinutes 120.
opts.SlidingExpiration <- true opts.SlidingExpiration <- true
opts.AccessDeniedPath <- "/error/403") opts.AccessDeniedPath <- "/error/403")
let _ = svc.AddAuthorization() let _ = svc.AddAuthorization()
let cfg = svc.BuildServiceProvider().GetService<IConfiguration>() let cfg = svc.BuildServiceProvider().GetService<IConfiguration>()
let dsb = NpgsqlDataSourceBuilder(cfg.GetConnectionString "PrayerTracker") Configuration.useConnectionString (cfg.GetConnectionString "PrayerTracker")
let _ = dsb.UseNodaTime() Connection.setUp () |> Async.AwaitTask |> Async.RunSynchronously
dsb.Build() |> Configuration.useDataSource
let emailCfg = cfg.GetSection "Email" let emailCfg = cfg.GetSection "Email"
if (emailCfg.GetChildren >> Seq.isEmpty >> not) () then ConfigurationBinder.Bind(emailCfg, Email.smtpOptions)
if (emailCfg.GetChildren >> Seq.isEmpty >> not) () then
ConfigurationBinder.Bind(emailCfg, Email.smtpOptions)
let _ = svc.AddSingleton<IDistributedCache, DistributedCache>() let _ = svc.AddSingleton<IDistributedCache, DistributedCache>()
let _ = svc.AddSession() let _ = svc.AddSession()
let _ = svc.AddAntiforgery() let _ = svc.AddAntiforgery()
let _ = svc.AddRouting() let _ = svc.AddRouting()
let _ = svc.AddSingleton<IClock> SystemClock.Instance let _ = svc.AddSingleton<IClock> SystemClock.Instance
() ()
open Giraffe open Giraffe
let noWeb : HttpHandler = fun next ctx -> /// <summary>Endpoint to redirect URLs starting with <c>/web</c> to their non-web equivalent</summary>
redirectTo true $"""/{string ctx.Request.RouteValues["path"]}""" next ctx let noWeb: HttpHandler =
fun next ctx -> redirectTo true $"""/{string ctx.Request.RouteValues["path"]}""" next ctx
open Giraffe.EndpointRouting open Giraffe.EndpointRouting
/// Routes for PrayerTracker /// Routes for PrayerTracker
let routes = [ let routes =
route "/web/{**path}" noWeb [ route "/web/{**path}" noWeb
GET_HEAD [ GET_HEAD
subRoute "/church" [ [ subRoute "/church" [ route "es" Handlers.Church.maintain; routef "/%O/edit" Handlers.Church.edit ]
route "es" Handlers.Church.maintain route "/class/logon" (redirectTo true "/small-group/log-on")
routef "/%O/edit" Handlers.Church.edit ] routef "/error/%s" Handlers.Home.error
route "/class/logon" (redirectTo true "/small-group/log-on") subRoute
routef "/error/%s" Handlers.Home.error "/help"
subRoute "/help" [ [ route "" Handlers.Help.index
route "" Handlers.Help.index subRoute
subRoute "/requests" [ "/requests"
route "/edit" Handlers.Help.Requests.edit [ route "/edit" Handlers.Help.Requests.edit
route "/maintain" Handlers.Help.Requests.maintain route "/maintain" Handlers.Help.Requests.maintain
route "/view" Handlers.Help.Requests.view ] route "/view" Handlers.Help.Requests.view ]
subRoute "/small-group" [ subRoute
route "/announcement" Handlers.Help.SmallGroup.announcement "/small-group"
route "/members" Handlers.Help.SmallGroup.members [ route "/announcement" Handlers.Help.SmallGroup.announcement
route "/preferences" Handlers.Help.SmallGroup.preferences ] route "/members" Handlers.Help.SmallGroup.members
subRoute "/user" [ route "/preferences" Handlers.Help.SmallGroup.preferences ]
route "/log-on" Handlers.Help.User.logOn subRoute
route "/password" Handlers.Help.User.password ] ] "/user"
routef "/language/%s" Handlers.Home.language [ route "/log-on" Handlers.Help.User.logOn
subRoute "/legal" [ route "/password" Handlers.Help.User.password ] ]
route "/privacy-policy" Handlers.Home.privacyPolicy routef "/language/%s" Handlers.Home.language
route "/terms-of-service" Handlers.Home.tos ] subRoute
route "/log-off" Handlers.Home.logOff "/legal"
subRoute "/prayer-request" [ [ route "/privacy-policy" Handlers.Home.privacyPolicy
route "s" (Handlers.PrayerRequest.maintain true) route "/terms-of-service" Handlers.Home.tos ]
routef "s/email/%s" Handlers.PrayerRequest.email route "/log-off" Handlers.Home.logOff
route "s/inactive" (Handlers.PrayerRequest.maintain false) subRoute
route "s/lists" Handlers.PrayerRequest.lists "/prayer-request"
routef "s/%O/list" Handlers.PrayerRequest.list [ route "s" (Handlers.PrayerRequest.maintain true)
route "s/maintain" (redirectTo true "/prayer-requests") routef "s/email/%s" Handlers.PrayerRequest.email
routef "s/print/%s" Handlers.PrayerRequest.print route "s/inactive" (Handlers.PrayerRequest.maintain false)
route "s/view" (Handlers.PrayerRequest.view None) route "s/lists" Handlers.PrayerRequest.lists
routef "s/view/%s" (Some >> Handlers.PrayerRequest.view) routef "s/%O/list" Handlers.PrayerRequest.list
routef "/%O/edit" Handlers.PrayerRequest.edit route "s/maintain" (redirectTo true "/prayer-requests")
routef "/%O/expire" Handlers.PrayerRequest.expire routef "s/print/%s" Handlers.PrayerRequest.print
routef "/%O/restore" Handlers.PrayerRequest.restore ] route "s/view" (Handlers.PrayerRequest.view None)
subRoute "/small-group" [ routef "s/view/%s" (Some >> Handlers.PrayerRequest.view)
route "" Handlers.SmallGroup.overview routef "/%O/edit" Handlers.PrayerRequest.edit
route "s" Handlers.SmallGroup.maintain routef "/%O/expire" Handlers.PrayerRequest.expire
route "/announcement" Handlers.SmallGroup.announcement routef "/%O/restore" Handlers.PrayerRequest.restore ]
routef "/%O/edit" Handlers.SmallGroup.edit subRoute
route "/log-on" (Handlers.SmallGroup.logOn None) "/small-group"
routef "/log-on/%O" (Some >> Handlers.SmallGroup.logOn) [ route "" Handlers.SmallGroup.overview
route "/logon" (redirectTo true "/small-group/log-on") route "s" Handlers.SmallGroup.maintain
routef "/member/%O/edit" Handlers.SmallGroup.editMember route "/announcement" Handlers.SmallGroup.announcement
route "/members" Handlers.SmallGroup.members routef "/%O/edit" Handlers.SmallGroup.edit
route "/preferences" Handlers.SmallGroup.preferences ] route "/log-on" (Handlers.SmallGroup.logOn None)
route "/unauthorized" Handlers.Home.unauthorized routef "/log-on/%O" (Some >> Handlers.SmallGroup.logOn)
subRoute "/user" [ route "/logon" (redirectTo true "/small-group/log-on")
route "s" Handlers.User.maintain routef "/member/%O/edit" Handlers.SmallGroup.editMember
routef "/%O/edit" Handlers.User.edit route "/members" Handlers.SmallGroup.members
routef "/%O/small-groups" Handlers.User.smallGroups route "/preferences" Handlers.SmallGroup.preferences ]
route "/log-on" Handlers.User.logOn route "/unauthorized" Handlers.Home.unauthorized
route "/logon" (redirectTo true "/user/log-on") subRoute
route "/password" Handlers.User.password ] "/user"
route "/" Handlers.Home.homePage ] [ route "s" Handlers.User.maintain
POST [ routef "/%O/edit" Handlers.User.edit
subRoute "/church" [ routef "/%O/small-groups" Handlers.User.smallGroups
routef "/%O/delete" Handlers.Church.delete route "/log-on" Handlers.User.logOn
route "/save" Handlers.Church.save ] route "/logon" (redirectTo true "/user/log-on")
subRoute "/prayer-request" [ route "/password" Handlers.User.password ]
routef "/%O/delete" Handlers.PrayerRequest.delete route "/" Handlers.Home.homePage ]
route "/save" Handlers.PrayerRequest.save ] POST
subRoute "/small-group" [ [ subRoute
route "/announcement/send" Handlers.SmallGroup.sendAnnouncement "/church"
routef "/%O/delete" Handlers.SmallGroup.delete [ routef "/%O/delete" Handlers.Church.delete
route "/log-on/submit" Handlers.SmallGroup.logOnSubmit route "/save" Handlers.Church.save ]
routef "/member/%O/delete" Handlers.SmallGroup.deleteMember subRoute
route "/member/save" Handlers.SmallGroup.saveMember "/prayer-request"
route "/preferences/save" Handlers.SmallGroup.savePreferences [ routef "/%O/delete" Handlers.PrayerRequest.delete
route "/save" Handlers.SmallGroup.save ] route "/save" Handlers.PrayerRequest.save ]
subRoute "/user" [ subRoute
routef "/%O/delete" Handlers.User.delete "/small-group"
route "/edit/save" Handlers.User.save [ route "/announcement/send" Handlers.SmallGroup.sendAnnouncement
route "/log-on" Handlers.User.doLogOn routef "/%O/delete" Handlers.SmallGroup.delete
route "/password/change" Handlers.User.changePassword route "/log-on/submit" Handlers.SmallGroup.logOnSubmit
route "/small-groups/save" Handlers.User.saveGroups ] ] ] routef "/member/%O/delete" Handlers.SmallGroup.deleteMember
route "/member/save" Handlers.SmallGroup.saveMember
route "/preferences/save" Handlers.SmallGroup.savePreferences
route "/save" Handlers.SmallGroup.save ]
subRoute
"/user"
[ routef "/%O/delete" Handlers.User.delete
route "/edit/save" Handlers.User.save
route "/log-on" Handlers.User.doLogOn
route "/password/change" Handlers.User.changePassword
route "/small-groups/save" Handlers.User.saveGroups ] ] ]
open Microsoft.Extensions.Logging open Microsoft.Extensions.Logging
@ -175,53 +199,67 @@ module Configure =
let errorHandler (ex: exn) (logger: ILogger) = let errorHandler (ex: exn) (logger: ILogger) =
logger.LogError(EventId(), ex, "An unhandled exception has occurred while executing the request.") logger.LogError(EventId(), ex, "An unhandled exception has occurred while executing the request.")
clearResponse >=> setStatusCode 500 >=> text ex.Message clearResponse >=> setStatusCode 500 >=> text ex.Message
open Microsoft.Extensions.Hosting open Microsoft.Extensions.Hosting
/// Configure logging /// Configure logging
let logging (log: ILoggingBuilder) = let logging (log: ILoggingBuilder) =
let env = log.Services.BuildServiceProvider().GetService<IWebHostEnvironment>() let env = log.Services.BuildServiceProvider().GetService<IWebHostEnvironment>()
if env.IsDevelopment() then log else log.AddFilter(fun l -> l > LogLevel.Information)
|> function l -> l.AddConsole().AddDebug() if env.IsDevelopment() then
log
else
log.AddFilter(fun l -> l > LogLevel.Information)
|> function
| l -> l.AddConsole().AddDebug()
|> ignore |> ignore
open BitBadger.AspNetCore.CanonicalDomains open BitBadger.AspNetCore.CanonicalDomains
open Microsoft.Extensions.Localization open Microsoft.Extensions.Localization
open Microsoft.Extensions.Options open Microsoft.Extensions.Options
/// Configure the application /// Configure the application
let app (app: IApplicationBuilder) = let app (app: IApplicationBuilder) =
let env = app.ApplicationServices.GetRequiredService<IWebHostEnvironment>() let env = app.ApplicationServices.GetRequiredService<IWebHostEnvironment>()
if env.IsDevelopment() then if env.IsDevelopment() then
app.UseDeveloperExceptionPage() app.UseDeveloperExceptionPage()
else else
app.UseGiraffeErrorHandler errorHandler app.UseGiraffeErrorHandler errorHandler
|> ignore |> ignore
let _ = app.UseForwardedHeaders() let _ = app.UseForwardedHeaders()
let _ = app.UseCanonicalDomains() let _ = app.UseCanonicalDomains()
let _ = app.UseStatusCodePagesWithReExecute "/error/{0}" let _ = app.UseStatusCodePagesWithReExecute "/error/{0}"
let _ = app.UseStaticFiles() let _ = app.UseStaticFiles()
let _ = app.UseCookiePolicy(CookiePolicyOptions(MinimumSameSitePolicy = SameSiteMode.Strict))
let _ =
app.UseCookiePolicy(CookiePolicyOptions(MinimumSameSitePolicy = SameSiteMode.Strict))
let _ = app.UseMiddleware<RequestStartMiddleware>() let _ = app.UseMiddleware<RequestStartMiddleware>()
let _ = app.UseRouting() let _ = app.UseRouting()
let _ = app.UseSession() let _ = app.UseSession()
let _ = app.UseRequestLocalization(
app.ApplicationServices.GetService<IOptions<RequestLocalizationOptions>>().Value) let _ =
app.UseRequestLocalization(app.ApplicationServices.GetService<IOptions<RequestLocalizationOptions>>().Value)
let _ = app.UseAuthentication() let _ = app.UseAuthentication()
let _ = app.UseAuthorization() let _ = app.UseAuthorization()
let _ = app.UseEndpoints(fun e -> e.MapGiraffeEndpoints routes) let _ = app.UseEndpoints(fun e -> e.MapGiraffeEndpoints routes)
app.ApplicationServices.GetRequiredService<IStringLocalizerFactory>() |> Views.I18N.setUpFactories
app.ApplicationServices.GetRequiredService<IStringLocalizerFactory>()
|> Views.I18N.setUpFactories
/// The web application /// The web application
module App = module App =
open System.IO open System.IO
[<EntryPoint>] [<EntryPoint>]
let main args = let main args =
let contentRoot = Directory.GetCurrentDirectory() let contentRoot = Directory.GetCurrentDirectory()
let app = let app =
WebHostBuilder() WebHostBuilder()
.UseContentRoot(contentRoot) .UseContentRoot(contentRoot)
@ -232,5 +270,10 @@ module App =
.ConfigureLogging(Configure.logging) .ConfigureLogging(Configure.logging)
.Configure(System.Action<IApplicationBuilder> Configure.app) .Configure(System.Action<IApplicationBuilder> Configure.app)
.Build() .Build()
if args.Length > 0 then printfn $"Unrecognized option {args[0]}" else app.Run()
if args.Length > 0 then
printfn $"Unrecognized option {args[0]}"
else
app.Run()
0 0

2
src/PrayerTracker/PrayerTracker.fsproj
View File

@ -28,7 +28,7 @@
<PackageReference Include="BitBadger.AspNetCore.CanonicalDomains" Version="1.1.0" /> <PackageReference Include="BitBadger.AspNetCore.CanonicalDomains" Version="1.1.0" />
<PackageReference Include="Giraffe.Htmx" Version="2.0.4" /> <PackageReference Include="Giraffe.Htmx" Version="2.0.4" />
<PackageReference Include="NodaTime.Serialization.JsonNet" Version="3.1.0" /> <PackageReference Include="NodaTime.Serialization.JsonNet" Version="3.1.0" />
<PackageReference Update="FSharp.Core" Version="9.0.100" /> <PackageReference Update="FSharp.Core" Version="9.0.101" />
</ItemGroup> </ItemGroup>
<ItemGroup> <ItemGroup>