Config conns for migration (#55)

- 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

View File

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

View File

@ -14,7 +14,7 @@
<PackageReference Include="NodaTime.Serialization.SystemTextJson" Version="1.3.0" />
<PackageReference Include="Npgsql.FSharp" Version="5.7.0" />
<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>
</Project>

View File

@ -1,7 +1,5 @@

open NodaTime
open Npgsql.FSharp
open PrayerTracker.Data
open PrayerTracker.Entities
module PgMappings =
@ -12,11 +10,35 @@ module PgMappings =
City = row.string "city"
State = row.string "state"
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) =
/// Map a row to a Member instance
let mapToMember (row: RowReader) =
{ Id = MemberId (row.uuid "id")
SmallGroupId = SmallGroupId (row.uuid "small_group_id")
Name = row.string "member_name"
Email = row.string "email"
Format = row.stringOrNone "email_format" |> Option.map EmailFormat.Parse }
/// Map a row to a Prayer Request instance
let mapToPrayerRequest (row: RowReader) =
{ Id = PrayerRequestId (row.uuid "id")
UserId = UserId (row.uuid "user_id")
SmallGroupId = SmallGroupId (row.uuid "small_group_id")
EnteredDate = row.fieldValue<Instant> "entered_date"
UpdatedDate = row.fieldValue<Instant> "updated_date"
Requestor = row.stringOrNone "requestor"
Text = row.string "request_text"
NotifyChaplain = row.bool "notify_chaplain"
RequestType = PrayerRequestType.Parse (row.string "request_type")
Expiration = Expiration.Parse (row.string "expiration") }
/// Map a row to a Small Group instance
let mapToSmallGroup (row: RowReader) =
{ Id = SmallGroupId (row.uuid "id")
ChurchId = ChurchId (row.uuid "church_id")
Name = row.string "group_name"
Preferences =
{ SmallGroupId = SmallGroupId (row.uuid "small_group_id")
DaysToKeepNew = row.int "days_to_keep_new"
DaysToExpire = row.int "days_to_expire"
@ -34,45 +56,7 @@ module PgMappings =
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
let mapToMember (row : RowReader) =
{ Id = MemberId (row.uuid "id")
SmallGroupId = SmallGroupId (row.uuid "small_group_id")
Name = row.string "member_name"
Email = row.string "email"
Format = row.stringOrNone "email_format" |> Option.map EmailFormat.Parse
}
/// Map a row to a Prayer Request instance
let mapToPrayerRequest (row : RowReader) =
{ Id = PrayerRequestId (row.uuid "id")
UserId = UserId (row.uuid "user_id")
SmallGroupId = SmallGroupId (row.uuid "small_group_id")
EnteredDate = row.fieldValue<Instant> "entered_date"
UpdatedDate = row.fieldValue<Instant> "updated_date"
Requestor = row.stringOrNone "requestor"
Text = row.string "request_text"
NotifyChaplain = row.bool "notify_chaplain"
RequestType = PrayerRequestType.Parse (row.string "request_type")
Expiration = Expiration.Parse (row.string "expiration")
}
/// Map a row to a Small Group instance
let mapToSmallGroup (row : RowReader) =
{ Id = SmallGroupId (row.uuid "id")
ChurchId = ChurchId (row.uuid "church_id")
Name = row.string "group_name"
Preferences = ListPreferences.Empty
}
/// Map a row to a Small Group instance with populated list preferences
let mapToSmallGroupWithPreferences (row : RowReader) =
{ mapToSmallGroup row with
Preferences = mapToListPreferences row
}
AsOfDateDisplay = AsOfDateDisplay.Parse (row.string "as_of_date_display") } }
/// Map a row to a User instance
let mapToUser (row: RowReader) =
@ -83,30 +67,37 @@ module PgMappings =
IsAdmin = row.bool "is_admin"
PasswordHash = row.string "password_hash"
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 {
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 =
Sql.fromDataSource source
|> Sql.query "SELECT * FROM pt.church"
|> Sql.executeAsync PgMappings.mapToChurch
for church in churches do
do! BitBadger.Documents.Sqlite.Document.insert Table.Church church
do! Churches.save church
printfn "Migrated %d churches" churches.Length
let! groups =
Sql.fromDataSource source
|> Sql.query "SELECT sg.*, lp.* FROM pt.small_group sg
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
do! BitBadger.Documents.Sqlite.Document.insert Table.Group group
do! SmallGroups.save group
printfn "Migrated %d groups" groups.Length
let! members =
@ -114,7 +105,7 @@ task {
|> Sql.query "SELECT * from pt.member"
|> Sql.executeAsync PgMappings.mapToMember
for mbr in members do
do! BitBadger.Documents.Sqlite.Document.insert Table.Member mbr
do! Members.save mbr
printfn "Migrated %d members" members.Length
let! requests =
@ -122,7 +113,7 @@ task {
|> Sql.query "SELECT * from pt.prayer_request"
|> Sql.executeAsync PgMappings.mapToPrayerRequest
for request in requests do
do! BitBadger.Documents.Sqlite.Document.insert Table.Request request
do! PrayerRequests.save request
printfn "Migrated %d requests" requests.Length
let! users =
@ -135,7 +126,7 @@ task {
|> 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.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
} |> Async.AwaitTask |> Async.RunSynchronously

View File

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

View File

@ -18,13 +18,13 @@
<PackageReference Include="Giraffe.Fixi" Version="0.5.7" />
<PackageReference Include="Giraffe.ViewEngine" Version="1.4.0" />
<PackageReference Include="Giraffe.ViewEngine.Htmx" Version="2.0.4" />
<PackageReference Include="MailKit" Version="4.9.0" />
<PackageReference Include="Microsoft.AspNetCore.Html.Abstractions" Version="2.2.0" />
<PackageReference Include="Microsoft.AspNetCore.Http" Version="2.2.2" />
<PackageReference Include="Microsoft.AspNetCore.Http.Extensions" Version="2.2.0" />
<PackageReference Include="Microsoft.AspNetCore.Mvc" Version="2.2.0" />
<PackageReference Include="MailKit" Version="4.10.0" />
<PackageReference Include="Microsoft.AspNetCore.Html.Abstractions" Version="2.3.0" />
<PackageReference Include="Microsoft.AspNetCore.Http" Version="2.3.0" />
<PackageReference Include="Microsoft.AspNetCore.Http.Extensions" Version="2.3.0" />
<PackageReference Include="Microsoft.AspNetCore.Mvc" Version="2.3.0" />
<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>

View File

@ -5,7 +5,8 @@ open Microsoft.AspNetCore.Http
/// Middleware to add the starting ticks for the request
type RequestStartMiddleware(next: RequestDelegate) =
member this.InvokeAsync(ctx: HttpContext) = task {
member this.InvokeAsync(ctx: HttpContext) =
task {
ctx.Items[Key.startTime] <- ctx.Now
return! next.Invoke ctx
}
@ -22,7 +23,8 @@ module Configure =
/// Set up the configuration for the app
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.{ctx.HostingEnvironment.EnvironmentName}.json", optional = true)
.AddEnvironmentVariables()
@ -35,7 +37,7 @@ module Configure =
(ctx.Configuration.GetSection >> opts.Configure >> ignore) "Kestrel"
open System.Globalization
open BitBadger.Documents.Postgres
open BitBadger.Documents.Sqlite
open Microsoft.AspNetCore.Authentication.Cookies
open Microsoft.AspNetCore.Localization
open Microsoft.Extensions.Caching.Distributed
@ -48,29 +50,40 @@ module Configure =
let services (svc: IServiceCollection) =
let _ = svc.AddOptions()
let _ = svc.AddLocalization(fun options -> options.ResourcesPath <- "Resources")
let _ =
svc.Configure<RequestLocalizationOptions>(fun (opts: RequestLocalizationOptions) ->
let supportedCultures =
[| CultureInfo "en-US"; CultureInfo "en-GB"; CultureInfo "en-AU"; CultureInfo "en"
CultureInfo "es-MX"; CultureInfo "es-ES"; CultureInfo "es" |]
[| CultureInfo "en-US"
CultureInfo "en-GB"
CultureInfo "en-AU"
CultureInfo "en"
CultureInfo "es-MX"
CultureInfo "es-ES"
CultureInfo "es" |]
opts.DefaultRequestCulture <- RequestCulture("en-US", "en-US")
opts.SupportedCultures <- supportedCultures
opts.SupportedUICultures <- supportedCultures)
let _ =
svc.AddAuthentication(CookieAuthenticationDefaults.AuthenticationScheme)
svc
.AddAuthentication(CookieAuthenticationDefaults.AuthenticationScheme)
.AddCookie(fun opts ->
opts.ExpireTimeSpan <- TimeSpan.FromMinutes 120.
opts.SlidingExpiration <- true
opts.AccessDeniedPath <- "/error/403")
let _ = svc.AddAuthorization()
let cfg = svc.BuildServiceProvider().GetService<IConfiguration>()
let dsb = NpgsqlDataSourceBuilder(cfg.GetConnectionString "PrayerTracker")
let _ = dsb.UseNodaTime()
dsb.Build() |> Configuration.useDataSource
Configuration.useConnectionString (cfg.GetConnectionString "PrayerTracker")
Connection.setUp () |> Async.AwaitTask |> Async.RunSynchronously
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.AddSession()
@ -82,40 +95,45 @@ module Configure =
open Giraffe
let noWeb : HttpHandler = fun next ctx ->
redirectTo true $"""/{string ctx.Request.RouteValues["path"]}""" next ctx
/// <summary>Endpoint to redirect URLs starting with <c>/web</c> to their non-web equivalent</summary>
let noWeb: HttpHandler =
fun next ctx -> redirectTo true $"""/{string ctx.Request.RouteValues["path"]}""" next ctx
open Giraffe.EndpointRouting
/// Routes for PrayerTracker
let routes = [
route "/web/{**path}" noWeb
GET_HEAD [
subRoute "/church" [
route "es" Handlers.Church.maintain
routef "/%O/edit" Handlers.Church.edit ]
let routes =
[ route "/web/{**path}" noWeb
GET_HEAD
[ subRoute "/church" [ route "es" Handlers.Church.maintain; routef "/%O/edit" Handlers.Church.edit ]
route "/class/logon" (redirectTo true "/small-group/log-on")
routef "/error/%s" Handlers.Home.error
subRoute "/help" [
route "" Handlers.Help.index
subRoute "/requests" [
route "/edit" Handlers.Help.Requests.edit
subRoute
"/help"
[ route "" Handlers.Help.index
subRoute
"/requests"
[ route "/edit" Handlers.Help.Requests.edit
route "/maintain" Handlers.Help.Requests.maintain
route "/view" Handlers.Help.Requests.view ]
subRoute "/small-group" [
route "/announcement" Handlers.Help.SmallGroup.announcement
subRoute
"/small-group"
[ route "/announcement" Handlers.Help.SmallGroup.announcement
route "/members" Handlers.Help.SmallGroup.members
route "/preferences" Handlers.Help.SmallGroup.preferences ]
subRoute "/user" [
route "/log-on" Handlers.Help.User.logOn
subRoute
"/user"
[ route "/log-on" Handlers.Help.User.logOn
route "/password" Handlers.Help.User.password ] ]
routef "/language/%s" Handlers.Home.language
subRoute "/legal" [
route "/privacy-policy" Handlers.Home.privacyPolicy
subRoute
"/legal"
[ route "/privacy-policy" Handlers.Home.privacyPolicy
route "/terms-of-service" Handlers.Home.tos ]
route "/log-off" Handlers.Home.logOff
subRoute "/prayer-request" [
route "s" (Handlers.PrayerRequest.maintain true)
subRoute
"/prayer-request"
[ route "s" (Handlers.PrayerRequest.maintain true)
routef "s/email/%s" Handlers.PrayerRequest.email
route "s/inactive" (Handlers.PrayerRequest.maintain false)
route "s/lists" Handlers.PrayerRequest.lists
@ -127,8 +145,9 @@ module Configure =
routef "/%O/edit" Handlers.PrayerRequest.edit
routef "/%O/expire" Handlers.PrayerRequest.expire
routef "/%O/restore" Handlers.PrayerRequest.restore ]
subRoute "/small-group" [
route "" Handlers.SmallGroup.overview
subRoute
"/small-group"
[ route "" Handlers.SmallGroup.overview
route "s" Handlers.SmallGroup.maintain
route "/announcement" Handlers.SmallGroup.announcement
routef "/%O/edit" Handlers.SmallGroup.edit
@ -139,31 +158,36 @@ module Configure =
route "/members" Handlers.SmallGroup.members
route "/preferences" Handlers.SmallGroup.preferences ]
route "/unauthorized" Handlers.Home.unauthorized
subRoute "/user" [
route "s" Handlers.User.maintain
subRoute
"/user"
[ route "s" Handlers.User.maintain
routef "/%O/edit" Handlers.User.edit
routef "/%O/small-groups" Handlers.User.smallGroups
route "/log-on" Handlers.User.logOn
route "/logon" (redirectTo true "/user/log-on")
route "/password" Handlers.User.password ]
route "/" Handlers.Home.homePage ]
POST [
subRoute "/church" [
routef "/%O/delete" Handlers.Church.delete
POST
[ subRoute
"/church"
[ routef "/%O/delete" Handlers.Church.delete
route "/save" Handlers.Church.save ]
subRoute "/prayer-request" [
routef "/%O/delete" Handlers.PrayerRequest.delete
subRoute
"/prayer-request"
[ routef "/%O/delete" Handlers.PrayerRequest.delete
route "/save" Handlers.PrayerRequest.save ]
subRoute "/small-group" [
route "/announcement/send" Handlers.SmallGroup.sendAnnouncement
subRoute
"/small-group"
[ route "/announcement/send" Handlers.SmallGroup.sendAnnouncement
routef "/%O/delete" Handlers.SmallGroup.delete
route "/log-on/submit" Handlers.SmallGroup.logOnSubmit
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
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
@ -181,8 +205,13 @@ module Configure =
/// Configure logging
let logging (log: ILoggingBuilder) =
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
open BitBadger.AspNetCore.CanonicalDomains
@ -192,6 +221,7 @@ module Configure =
/// Configure the application
let app (app: IApplicationBuilder) =
let env = app.ApplicationServices.GetRequiredService<IWebHostEnvironment>()
if env.IsDevelopment() then
app.UseDeveloperExceptionPage()
else
@ -202,16 +232,23 @@ module Configure =
let _ = app.UseCanonicalDomains()
let _ = app.UseStatusCodePagesWithReExecute "/error/{0}"
let _ = app.UseStaticFiles()
let _ = app.UseCookiePolicy(CookiePolicyOptions(MinimumSameSitePolicy = SameSiteMode.Strict))
let _ =
app.UseCookiePolicy(CookiePolicyOptions(MinimumSameSitePolicy = SameSiteMode.Strict))
let _ = app.UseMiddleware<RequestStartMiddleware>()
let _ = app.UseRouting()
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.UseAuthorization()
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
@ -222,6 +259,7 @@ module App =
[<EntryPoint>]
let main args =
let contentRoot = Directory.GetCurrentDirectory()
let app =
WebHostBuilder()
.UseContentRoot(contentRoot)
@ -232,5 +270,10 @@ module App =
.ConfigureLogging(Configure.logging)
.Configure(System.Action<IApplicationBuilder> Configure.app)
.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

View File

@ -28,7 +28,7 @@
<PackageReference Include="BitBadger.AspNetCore.CanonicalDomains" Version="1.1.0" />
<PackageReference Include="Giraffe.Htmx" Version="2.0.4" />
<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>