diff --git a/src/PrayerTracker.Data/Access.fs b/src/PrayerTracker.Data/Access.fs new file mode 100644 index 0000000..8c38286 --- /dev/null +++ b/src/PrayerTracker.Data/Access.fs @@ -0,0 +1,214 @@ +namespace PrayerTracker.Data + +open NodaTime +open Npgsql +open Npgsql.FSharp +open PrayerTracker.Entities + +/// Helper functions for the PostgreSQL data implementation +[] +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 "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 () + } diff --git a/src/PrayerTracker.Data/Entities.fs b/src/PrayerTracker.Data/Entities.fs index 60f9588..9215eb1 100644 --- a/src/PrayerTracker.Data/Entities.fs +++ b/src/PrayerTracker.Data/Entities.fs @@ -396,9 +396,6 @@ type [] Church = /// The address for the interface InterfaceAddress : string option - - /// Small groups for this church - SmallGroups : ResizeArray } with /// An empty church @@ -410,7 +407,6 @@ with State = "" HasVpsInterface = false InterfaceAddress = None - SmallGroups = ResizeArray () } /// Configure EF for this entity diff --git a/src/PrayerTracker.Data/PrayerTracker.Data.fsproj b/src/PrayerTracker.Data/PrayerTracker.Data.fsproj index 09642d4..fc50a81 100644 --- a/src/PrayerTracker.Data/PrayerTracker.Data.fsproj +++ b/src/PrayerTracker.Data/PrayerTracker.Data.fsproj @@ -6,6 +6,7 @@ + @@ -19,6 +20,8 @@ + + diff --git a/src/PrayerTracker.Tests/Data/EntitiesTests.fs b/src/PrayerTracker.Tests/Data/EntitiesTests.fs index 89fa5e0..bce039f 100644 --- a/src/PrayerTracker.Tests/Data/EntitiesTests.fs +++ b/src/PrayerTracker.Tests/Data/EntitiesTests.fs @@ -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" } ] diff --git a/src/PrayerTracker/App.fs b/src/PrayerTracker/App.fs index 9013eca..007be90 100644 --- a/src/PrayerTracker/App.fs +++ b/src/PrayerTracker/App.fs @@ -71,7 +71,6 @@ module Configure = let _ = svc.AddSingleton SystemClock.Instance let config = svc.BuildServiceProvider().GetRequiredService () - //NpgsqlConnection.GlobalTypeMapper. let _ = svc.AddDbContext ( (fun options -> diff --git a/src/PrayerTracker/Church.fs b/src/PrayerTracker/Church.fs index baf6302..16f14d7 100644 --- a/src/PrayerTracker/Church.fs +++ b/src/PrayerTracker/Church.fs @@ -15,8 +15,9 @@ 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 + let churchId = ChurchId chId + 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 () 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 diff --git a/src/PrayerTracker/Extensions.fs b/src/PrayerTracker/Extensions.fs index 6c04a4b..668e042 100644 --- a/src/PrayerTracker/Extensions.fs +++ b/src/PrayerTracker/Extensions.fs @@ -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> = lazy (backgroundTask { + let cfg = this.GetService () + let conn = new NpgsqlConnection (cfg.GetConnectionString "PrayerTracker") + do! conn.OpenAsync () + return conn + }) + /// The EF Core database context (via DI) member this.Db = this.GetService () + /// The PostgreSQL connection (configured via DI) + member this.Conn = backgroundTask { + return! this.LazyConn.Force () + } + /// The system clock (via DI) member this.Clock = this.GetService () diff --git a/src/PrayerTracker/User.fs b/src/PrayerTracker/User.fs index 2c7e3a6..56b46e8 100644 --- a/src/PrayerTracker/User.fs +++ b/src/PrayerTracker/User.fs @@ -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 _ -> @@ -107,12 +107,12 @@ 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 userId = UserId usrId + let! conn = ctx.Conn + match! Users.tryById userId conn with | Some user -> - ctx.Db.RemoveEntry user - let! _ = ctx.Db.SaveChangesAsync () - let s = Views.I18N.localizer.Force () + 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 | _ -> return! fourOhFour ctx @@ -128,10 +128,11 @@ open Microsoft.AspNetCore.Html let doLogOn : HttpHandler = requireAccess [ AccessLevel.Public ] >=> validateCsrf >=> fun next ctx -> task { match! ctx.TryBindFormAsync () with | Ok model -> - let s = Views.I18N.localizer.Force () - match! findUserByPassword model ctx.Db with + let s = Views.I18N.localizer.Force () + 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,16 +226,16 @@ open System.Threading.Tasks let save : HttpHandler = requireAccess [ Admin ] >=> validateCsrf >=> fun next ctx -> task { match! ctx.TryBindFormAsync () 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 () - let s = Views.I18N.localizer.Force () + do! Users.save updatedUser conn + let s = Views.I18N.localizer.Force () if model.IsNew then let h = CommonFunctions.htmlString { UserMessage.info with @@ -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 userId = UserId usrId + 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