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

WIP on SQL migration

Browse Source
This commit is contained in:
Daniel J. Summers 2022-08-12 19:28:49 -04:00
parent eb947a48af
commit 37dcf41c98
8 changed files with 270 additions and 37 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

214
src/PrayerTracker.Data/Access.fs Normal file
View File

@ -0,0 +1,214 @@
namespace PrayerTracker.Data
open NodaTime
open Npgsql
open Npgsql.FSharp
open PrayerTracker.Entities
/// Helper functions for the PostgreSQL data implementation
[<AutoOpen>]
module private Helpers =
/// Map a row to a Church instance
let mapToChurch (row : RowReader) =
{ Id = ChurchId (row.uuid "id")
Name = row.string "name"
City = row.string "city"
State = row.string "state"
HasVpsInterface = row.bool "has_vps_interface"
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"
RequestSort = RequestSort.fromCode (row.string "request_sort")
GroupPassword = row.string "group_password"
DefaultEmailType = EmailFormat.fromCode (row.string "default_email_type")
IsPublic = row.bool "is_public"
TimeZoneId = TimeZoneId (row.string "time_zone_id")
PageSize = row.int "page_size"
AsOfDateDisplay = AsOfDateDisplay.fromCode (row.string "as_of_date_display")
TimeZone = TimeZone.empty
}
/// 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
Church = Church.empty
Members = ResizeArray ()
PrayerRequests = ResizeArray ()
Users = ResizeArray ()
}
/// Map a row to a Small Group instance with populated list preferences
let mapToSmallGroupWithPreferences (row : RowReader) =
{ mapToSmallGroup row with
Preferences = mapToListPreferences row
}
/// Map a row to a User instance
let mapToUser (row : RowReader) =
{ Id = UserId (row.uuid "id")
FirstName = row.string "first_name"
LastName = row.string "last_name"
Email = row.string "email"
IsAdmin = row.bool "is_admin"
PasswordHash = row.string "password_hash"
Salt = None
LastSeen = row.fieldValueOrNone<Instant> "last_seen"
SmallGroups = ResizeArray ()
}
module Churches =
let tryById (churchId : ChurchId) conn = backgroundTask {
let! church =
conn
|> Sql.existingConnection
|> Sql.query "SELECT * FROM pt.church WHERE id = @id"
|> Sql.parameters [ "@id", Sql.uuid churchId.Value ]
|> Sql.executeAsync mapToChurch
return List.tryHead church
}
/// Functions to retrieve small group information
module SmallGroups =
/// Get a list of small group IDs along with a description that includes the church name
let listAll conn =
conn
|> Sql.existingConnection
|> Sql.query """
SELECT g.group_name, g.id, c.church_name
FROM pt.small_group g
INNER JOIN pt.church c ON c.id = g.church_id
ORDER BY c.church_name, g.group_name"""
|> Sql.executeAsync (fun row ->
Giraffe.ShortGuid.fromGuid (row.uuid "id"), $"""{row.string "church_name"} | {row.string "group_name"}""")
let tryByIdWithPreferences (groupId : SmallGroupId) conn = backgroundTask {
let! group =
conn
|> Sql.existingConnection
|> Sql.query """
SELECT sg.*, lp.*
FROM pt.small_group sg
INNER JOIN list_preference lp ON lp.small_group_id = sg.id
WHERE sg.id = @id"""
|> Sql.parameters [ "@id", Sql.uuid groupId.Value ]
|> Sql.executeAsync mapToSmallGroupWithPreferences
return List.tryHead group
}
/// Functions to manipulate users
module Users =
/// Retrieve all PrayerTracker users
let all conn =
conn
|> Sql.existingConnection
|> Sql.query "SELECT * FROM pt.pt_user ORDER BY last_name, first_name"
|> Sql.executeAsync mapToUser
/// Delete a user by its database ID
let deleteById (userId : UserId) conn = backgroundTask {
let! _ =
conn
|> Sql.existingConnection
|> Sql.query "DELETE FROM pt.pt_user WHERE id = @id"
|> Sql.parameters [ "@id", Sql.uuid userId.Value ]
|> Sql.executeNonQueryAsync
return ()
}
/// Save a user's information
let save user conn = backgroundTask {
let! _ =
conn
|> Sql.existingConnection
|> Sql.query """
INSERT INTO pt.pt_user (
id, first_name, last_name, email, is_admin, password_hash
) VALUES (
@id, @firstName, @lastName, @email, @isAdmin, @passwordHash
) ON CONFLICT (id) DO UPDATE
SET first_name = EXCLUDED.first_name,
last_name = EXCLUDED.last_name,
email = EXCLUDED.email,
is_admin = EXCLUDED.is_admin,
password_hash = EXCLUDED.password_hash"""
|> Sql.parameters
[ "@id", Sql.uuid user.Id.Value
"@firstName", Sql.string user.FirstName
"@lastName", Sql.string user.LastName
"@email", Sql.string user.Email
"@isAdmin", Sql.bool user.IsAdmin
"@passwordHash", Sql.string user.PasswordHash
]
|> Sql.executeNonQueryAsync
return ()
}
/// Find a user by its e-mail address and authorized small group
let tryByEmailAndGroup email (groupId : SmallGroupId) conn = backgroundTask {
let! user =
conn
|> Sql.existingConnection
|> Sql.query """
SELECT u.*
FROM pt.pt_user u
INNER JOIN pt.user_small_group usg ON usg.user_id = u.id AND usg.small_group_id = @groupId
WHERE u.email = @email"""
|> Sql.parameters [ "@email", Sql.string email; "@groupId", Sql.uuid groupId.Value ]
|> Sql.executeAsync mapToUser
return List.tryHead user
}
/// Find a user by their database ID
let tryById (userId : UserId) conn = backgroundTask {
let! user =
conn
|> Sql.existingConnection
|> Sql.query "SELECT * FROM pt.pt_user WHERE id = @id"
|> Sql.parameters [ "@id", Sql.uuid userId.Value ]
|> Sql.executeAsync mapToUser
return List.tryHead user
}
/// Update a user's last seen date/time
let updateLastSeen (userId : UserId) (now : Instant) conn = backgroundTask {
let! _ =
conn
|> Sql.existingConnection
|> Sql.query "UPDATE pt.pt_user SET last_seen = @now WHERE id = @id"
|> Sql.parameters [ "@id", Sql.uuid userId.Value; "@now", Sql.parameter (NpgsqlParameter ("@now", now)) ]
|> Sql.executeNonQueryAsync
return ()
}
/// Update a user's password hash
let updatePassword user conn = backgroundTask {
let! _ =
conn
|> Sql.existingConnection
|> Sql.query "UPDATE pt.pt_user SET password_hash = @passwordHash WHERE id = @id"
|> Sql.parameters [ "@id", Sql.uuid user.Id.Value; "@passwordHash", Sql.string user.PasswordHash ]
|> Sql.executeNonQueryAsync
return ()
}

4
src/PrayerTracker.Data/Entities.fs
View File

@ -396,9 +396,6 @@ type [<CLIMutable; NoComparison; NoEquality>] Church =
/// The address for the interface
InterfaceAddress : string option
/// Small groups for this church
SmallGroups : ResizeArray<SmallGroup>
}
with
/// An empty church
@ -410,7 +407,6 @@ with
State = ""
HasVpsInterface = false
InterfaceAddress = None
SmallGroups = ResizeArray<SmallGroup> ()
}
/// Configure EF for this entity

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

@ -6,6 +6,7 @@
<ItemGroup>
<Compile Include="Entities.fs" />
<Compile Include="Access.fs" />
<Compile Include="AppDbContext.fs" />
<Compile Include="DataAccess.fs" />
<Compile Include="Migrations\20161217153124_InitialDatabase.fs" />
@ -19,6 +20,8 @@
<PackageReference Include="NodaTime" Version="3.1.0" />
<PackageReference Include="Npgsql.EntityFrameworkCore.PostgreSQL" Version="6.0.6" />
<PackageReference Update="FSharp.Core" Version="6.0.5" />
<PackageReference Include="Npgsql.FSharp" Version="5.3.0" />
<PackageReference Include="Npgsql.NodaTime" Version="6.0.6" />
</ItemGroup>
</Project>

2
src/PrayerTracker.Tests/Data/EntitiesTests.fs
View File

@ -43,8 +43,6 @@ let churchTests =
Expect.equal mt.State "" "The state should have been blank"
Expect.isFalse mt.HasVpsInterface "The church should not show that it has an interface"
Expect.isNone mt.InterfaceAddress "The interface address should not exist"
Expect.isNotNull mt.SmallGroups "The small groups navigation property should not be null"
Expect.isEmpty mt.SmallGroups "There should be no small groups for an empty church"
}
]

1
src/PrayerTracker/App.fs
View File

@ -71,7 +71,6 @@ module Configure =
let _ = svc.AddSingleton<IClock> SystemClock.Instance
let config = svc.BuildServiceProvider().GetRequiredService<IConfiguration> ()
//NpgsqlConnection.GlobalTypeMapper.
let _ =
svc.AddDbContext<AppDbContext> (
(fun options ->

9
src/PrayerTracker/Church.fs
View File

@ -16,7 +16,8 @@ let private findStats (db : AppDbContext) churchId = task {
/// POST /church/[church-id]/delete
let delete chId : HttpHandler = requireAccess [ Admin ] >=> validateCsrf >=> fun next ctx -> task {
let churchId = ChurchId chId
match! ctx.Db.TryChurchById churchId with
use! conn = ctx.Conn
match! Data.Churches.tryById churchId conn with
| Some church ->
let! _, stats = findStats ctx.Db churchId
ctx.Db.RemoveEntry church
@ -39,7 +40,8 @@ let edit churchId : HttpHandler = requireAccess [ Admin ] >=> fun next ctx -> ta
|> Views.Church.edit EditChurch.empty ctx
|> renderHtml next ctx
else
match! ctx.Db.TryChurchById (ChurchId churchId) with
use! conn = ctx.Conn
match! Data.Churches.tryById (ChurchId churchId) conn with
| Some church ->
return!
viewInfo ctx
@ -65,9 +67,10 @@ open System.Threading.Tasks
let save : HttpHandler = requireAccess [ Admin ] >=> validateCsrf >=> fun next ctx -> task {
match! ctx.TryBindFormAsync<EditChurch> () with
| Ok model ->
let! conn = ctx.Conn
let! church =
if model.IsNew then Task.FromResult (Some { Church.empty with Id = (Guid.NewGuid >> ChurchId) () })
else ctx.Db.TryChurchById (idFromShort ChurchId model.ChurchId)
else Data.Churches.tryById (idFromShort ChurchId model.ChurchId) conn
match church with
| Some ch ->
model.PopulateChurch ch

16
src/PrayerTracker/Extensions.fs
View File

@ -69,15 +69,31 @@ type ClaimsPrincipal with
else None
open System.Threading.Tasks
open Giraffe
open Microsoft.Extensions.Configuration
open Npgsql
open PrayerTracker
/// Extensions on the ASP.NET Core HTTP context
type HttpContext with
// TODO: is this disposed?
member private this.LazyConn : Lazy<Task<NpgsqlConnection>> = lazy (backgroundTask {
let cfg = this.GetService<IConfiguration> ()
let conn = new NpgsqlConnection (cfg.GetConnectionString "PrayerTracker")
do! conn.OpenAsync ()
return conn
})
/// The EF Core database context (via DI)
member this.Db = this.GetService<AppDbContext> ()
/// The PostgreSQL connection (configured via DI)
member this.Conn = backgroundTask {
return! this.LazyConn.Force ()
}
/// The system clock (via DI)
member this.Clock = this.GetService<IClock> ()

46
src/PrayerTracker/User.fs
View File

@ -5,6 +5,7 @@ open Giraffe
open Microsoft.AspNetCore.Http
open Microsoft.AspNetCore.Identity
open PrayerTracker
open PrayerTracker.Data
open PrayerTracker.Entities
open PrayerTracker.ViewModels
@ -52,16 +53,15 @@ module Hashing =
/// Retrieve a user from the database by password, upgrading password hashes if required
let private findUserByPassword model (db : AppDbContext) = task {
match! db.TryUserByEmailAndGroup model.Email (idFromShort SmallGroupId model.SmallGroupId) with
let private findUserByPassword model conn = task {
match! Users.tryByEmailAndGroup model.Email (idFromShort SmallGroupId model.SmallGroupId) conn with
| Some user ->
let hasher = PrayerTrackerPasswordHasher ()
match hasher.VerifyHashedPassword (user, user.PasswordHash, model.Password) with
| PasswordVerificationResult.Success -> return Some user
| PasswordVerificationResult.SuccessRehashNeeded ->
let upgraded = { user with PasswordHash = hasher.HashPassword (user, model.Password) }
db.UpdateEntry upgraded
let! _ = db.SaveChangesAsync ()
do! Users.updatePassword upgraded conn
return Some upgraded
| _ -> return None
| None -> return None
@ -81,8 +81,9 @@ let changePassword : HttpHandler = requireAccess [ User ] >=> validateCsrf >=> f
let s = Views.I18N.localizer.Force ()
let curUsr = ctx.Session.CurrentUser.Value
let hasher = PrayerTrackerPasswordHasher ()
let! conn = ctx.Conn
let! user = task {
match! ctx.Db.TryUserById curUsr.Id with
match! Users.tryById curUsr.Id conn with
| Some usr ->
if hasher.VerifyHashedPassword (usr, usr.PasswordHash, model.OldPassword)
= PasswordVerificationResult.Success then
@ -92,8 +93,7 @@ let changePassword : HttpHandler = requireAccess [ User ] >=> validateCsrf >=> f
}
match user with
| Some usr when model.NewPassword = model.NewPasswordConfirm ->
ctx.Db.UpdateEntry { usr with PasswordHash = hasher.HashPassword (usr, model.NewPassword) }
let! _ = ctx.Db.SaveChangesAsync ()
do! Users.updatePassword { usr with PasswordHash = hasher.HashPassword (usr, model.NewPassword) } conn
addInfo ctx s["Your password was changed successfully"]
return! redirectTo false "/" next ctx
| Some _ ->
@ -108,10 +108,10 @@ let changePassword : HttpHandler = requireAccess [ User ] >=> validateCsrf >=> f
/// POST /user/[user-id]/delete
let delete usrId : HttpHandler = requireAccess [ Admin ] >=> validateCsrf >=> fun next ctx -> task {
let userId = UserId usrId
match! ctx.Db.TryUserById userId with
let! conn = ctx.Conn
match! Users.tryById userId conn with
| Some user ->
ctx.Db.RemoveEntry user
let! _ = ctx.Db.SaveChangesAsync ()
do! Users.deleteById userId conn
let s = Views.I18N.localizer.Force ()
addInfo ctx s["Successfully deleted user {0}", user.Name]
return! redirectTo false "/users" next ctx
@ -129,9 +129,10 @@ let doLogOn : HttpHandler = requireAccess [ AccessLevel.Public ] >=> validateCsr
match! ctx.TryBindFormAsync<UserLogOn> () with
| Ok model ->
let s = Views.I18N.localizer.Force ()
match! findUserByPassword model ctx.Db with
let! conn = ctx.Conn
match! findUserByPassword model conn with
| Some user ->
match! ctx.Db.TryGroupById (idFromShort SmallGroupId model.SmallGroupId) with
match! SmallGroups.tryByIdWithPreferences (idFromShort SmallGroupId model.SmallGroupId) conn with
| Some group ->
ctx.Session.CurrentUser <- Some user
ctx.Session.CurrentGroup <- Some group
@ -145,8 +146,7 @@ let doLogOn : HttpHandler = requireAccess [ AccessLevel.Public ] >=> validateCsr
AuthenticationProperties (
IssuedUtc = DateTimeOffset.UtcNow,
IsPersistent = defaultArg model.RememberMe false))
ctx.Db.UpdateEntry { user with LastSeen = Some ctx.Now }
let! _ = ctx.Db.SaveChangesAsync ()
do! Users.updateLastSeen user.Id ctx.Now conn
addHtmlInfo ctx s["Log On Successful • Welcome to {0}", s["PrayerTracker"]]
return! redirectTo false (sanitizeUrl model.RedirectUrl "/small-group") next ctx
| None -> return! fourOhFour ctx
@ -177,7 +177,8 @@ let edit usrId : HttpHandler = requireAccess [ Admin ] >=> fun next ctx -> task
|> Views.User.edit EditUser.empty ctx
|> renderHtml next ctx
else
match! ctx.Db.TryUserById userId with
let! conn = ctx.Conn
match! Users.tryById userId conn with
| Some user ->
return!
viewInfo ctx
@ -189,7 +190,8 @@ let edit usrId : HttpHandler = requireAccess [ Admin ] >=> fun next ctx -> task
/// GET /user/log-on
let logOn : HttpHandler = requireAccess [ AccessLevel.Public ] >=> fun next ctx -> task {
let s = Views.I18N.localizer.Force ()
let! groups = ctx.Db.GroupList ()
let! conn = ctx.Conn
let! groups = SmallGroups.listAll conn
let url = Option.ofObj <| ctx.Session.GetString Key.Session.redirectUrl
match url with
| Some _ ->
@ -204,7 +206,8 @@ let logOn : HttpHandler = requireAccess [ AccessLevel.Public ] >=> fun next ctx
/// GET /users
let maintain : HttpHandler = requireAccess [ Admin ] >=> fun next ctx -> task {
let! users = ctx.Db.AllUsers ()
let! conn = ctx.Conn
let! users = Users.all conn
return!
viewInfo ctx
|> Views.User.maintain users ctx
@ -223,15 +226,15 @@ open System.Threading.Tasks
let save : HttpHandler = requireAccess [ Admin ] >=> validateCsrf >=> fun next ctx -> task {
match! ctx.TryBindFormAsync<EditUser> () with
| Ok model ->
let! conn = ctx.Conn
let! user =
if model.IsNew then Task.FromResult (Some { User.empty with Id = (Guid.NewGuid >> UserId) () })
else ctx.Db.TryUserById (idFromShort UserId model.UserId)
else Users.tryById (idFromShort UserId model.UserId) conn
match user with
| Some usr ->
let hasher = PrayerTrackerPasswordHasher ()
let updatedUser = model.PopulateUser usr (fun pw -> hasher.HashPassword (usr, pw))
updatedUser |> if model.IsNew then ctx.Db.AddEntry else ctx.Db.UpdateEntry
let! _ = ctx.Db.SaveChangesAsync ()
do! Users.save updatedUser conn
let s = Views.I18N.localizer.Force ()
if model.IsNew then
let h = CommonFunctions.htmlString
@ -284,10 +287,11 @@ let saveGroups : HttpHandler = requireAccess [ Admin ] >=> validateCsrf >=> fun
/// GET /user/[user-id]/small-groups
let smallGroups usrId : HttpHandler = requireAccess [ Admin ] >=> fun next ctx -> task {
let! conn = ctx.Conn
let userId = UserId usrId
match! ctx.Db.TryUserByIdWithGroups userId with
| Some user ->
let! groups = ctx.Db.GroupList ()
let! groups = SmallGroups.listAll conn
let curGroups = user.SmallGroups |> Seq.map (fun g -> shortGuid g.SmallGroupId.Value) |> List.ofSeq
return!
viewInfo ctx