From 7fd15a5cff91ec0ddf870d642d83876b1a3517d9 Mon Sep 17 00:00:00 2001 From: "Daniel J. Summers" Date: Wed, 10 Jun 2020 23:11:28 -0500 Subject: [PATCH] Display new user name (#26) Also did some refactoring to pull static members into modules --- .gitignore | 2 + src/PrayerTracker.Tests/UI/ViewModelsTests.fs | 6 +- src/PrayerTracker.UI/ViewModels.fs | 263 +++++++++--------- src/PrayerTracker/Church.fs | 21 +- src/PrayerTracker/CommonFunctions.fs | 8 +- src/PrayerTracker/PrayerRequest.fs | 42 ++- src/PrayerTracker/SmallGroup.fs | 85 +++--- src/PrayerTracker/User.fs | 100 +++---- src/global.json | 5 - 9 files changed, 254 insertions(+), 278 deletions(-) delete mode 100644 src/global.json diff --git a/.gitignore b/.gitignore index bba3633..72d666f 100644 --- a/.gitignore +++ b/.gitignore @@ -332,3 +332,5 @@ ASALocalRun/ ### --- ### src/PrayerTracker/appsettings.json docs/_site + +.ionide \ No newline at end of file diff --git a/src/PrayerTracker.Tests/UI/ViewModelsTests.fs b/src/PrayerTracker.Tests/UI/ViewModelsTests.fs index 64a783a..46d4ddc 100644 --- a/src/PrayerTracker.Tests/UI/ViewModelsTests.fs +++ b/src/PrayerTracker.Tests/UI/ViewModelsTests.fs @@ -660,19 +660,19 @@ let userLogOnTests = let userMessageTests = testList "UserMessage" [ test "Error is constructed properly" { - let msg = UserMessage.Error + let msg = UserMessage.error Expect.equal msg.level "ERROR" "Incorrect message level" Expect.equal msg.text HtmlString.Empty "Text should have been blank" Expect.isNone msg.description "Description should have been None" } test "Warning is constructed properly" { - let msg = UserMessage.Warning + let msg = UserMessage.warning Expect.equal msg.level "WARNING" "Incorrect message level" Expect.equal msg.text HtmlString.Empty "Text should have been blank" Expect.isNone msg.description "Description should have been None" } test "Info is constructed properly" { - let msg = UserMessage.Info + let msg = UserMessage.info Expect.equal msg.level "Info" "Incorrect message level" Expect.equal msg.text HtmlString.Empty "Text should have been blank" Expect.isNone msg.description "Description should have been None" diff --git a/src/PrayerTracker.UI/ViewModels.fs b/src/PrayerTracker.UI/ViewModels.fs index 24152c1..518e758 100644 --- a/src/PrayerTracker.UI/ViewModels.fs +++ b/src/PrayerTracker.UI/ViewModels.fs @@ -45,7 +45,8 @@ module ReferenceList = Expecting, s.["Expecting"] Announcement, s.["Announcements"] ] - + +// fsharplint:disable RecordFieldNames MemberNames /// This is used to create a message that is displayed to the user [] @@ -57,25 +58,25 @@ type UserMessage = /// The description (further information) description : HtmlString option } - with - /// Error message template - static member Error = - { level = "ERROR" - text = HtmlString.Empty - description = None - } - /// Warning message template - static member Warning = - { level = "WARNING" - text = HtmlString.Empty - description = None - } - /// Info message template - static member Info = - { level = "Info" - text = HtmlString.Empty - description = None - } +module UserMessage = + /// Error message template + let error = + { level = "ERROR" + text = HtmlString.Empty + description = None + } + /// Warning message template + let warning = + { level = "WARNING" + text = HtmlString.Empty + description = None + } + /// Info message template + let info = + { level = "Info" + text = HtmlString.Empty + description = None + } /// View model required by the layout template, given as first parameter for all pages in PrayerTracker @@ -98,18 +99,18 @@ type AppViewInfo = /// The currently logged on small group, if there is one group : SmallGroup option } - with - /// A fresh version that can be populated to process the current request - static member fresh = - { style = [] - script = [] - helpLink = None - messages = [] - version = "" - requestStart = DateTime.Now.Ticks - user = None - group = None - } +module AppViewInfo = + /// A fresh version that can be populated to process the current request + let fresh = + { style = [] + script = [] + helpLink = None + messages = [] + version = "" + requestStart = DateTime.Now.Ticks + user = None + group = None + } /// Form for sending a small group or system-wide announcement @@ -139,9 +140,9 @@ type AssignGroups = /// The Ids of the small groups to which the user is authorized smallGroups : string } -with +module AssignGroups = /// Create an instance of this form from an existing user - static member fromUser (u : User) = + let fromUser (u : User) = { userId = u.userId userName = u.fullName smallGroups = "" @@ -177,24 +178,6 @@ type EditChurch = interfaceAddress : string option } with - /// Create an instance from an existing church - static member fromChurch (ch : Church) = - { churchId = ch.churchId - name = ch.name - city = ch.city - st = ch.st - hasInterface = match ch.hasInterface with true -> Some true | false -> None - interfaceAddress = ch.interfaceAddress - } - /// An instance to use for adding churches - static member empty = - { churchId = Guid.Empty - name = "" - city = "" - st = "" - hasInterface = None - interfaceAddress = None - } /// Is this a new church? member this.isNew () = Guid.Empty = this.churchId /// Populate a church from this form @@ -206,7 +189,26 @@ with hasInterface = match this.hasInterface with Some x -> x | None -> false interfaceAddress = match this.hasInterface with Some x when x -> this.interfaceAddress | _ -> None } - +module EditChurch = + /// Create an instance from an existing church + let fromChurch (ch : Church) = + { churchId = ch.churchId + name = ch.name + city = ch.city + st = ch.st + hasInterface = match ch.hasInterface with true -> Some true | false -> None + interfaceAddress = ch.interfaceAddress + } + /// An instance to use for adding churches + let empty = + { churchId = Guid.Empty + name = "" + city = "" + st = "" + hasInterface = None + interfaceAddress = None + } + /// Form for adding/editing small group members [] @@ -221,22 +223,23 @@ type EditMember = emailType : string } with + /// Is this a new member? + member this.isNew () = Guid.Empty = this.memberId +module EditMember = /// Create an instance from an existing member - static member fromMember (m : Member) = + let fromMember (m : Member) = { memberId = m.memberId memberName = m.memberName emailAddress = m.email emailType = match m.format with Some f -> f | None -> "" } /// An empty instance - static member empty = + let empty = { memberId = Guid.Empty memberName = "" emailAddress = "" emailType = "" } - /// Is this a new member? - member this.isNew () = Guid.Empty = this.memberId /// This form allows the user to set class preferences @@ -282,32 +285,6 @@ type EditPreferences = asOfDate : string } with - static member fromPreferences (prefs : ListPreferences) = - let setType (x : string) = match x.StartsWith "#" with true -> "RGB" | false -> "Name" - { expireDays = prefs.daysToExpire - daysToKeepNew = prefs.daysToKeepNew - longTermUpdateWeeks = prefs.longTermUpdateWeeks - requestSort = prefs.requestSort.code - emailFromName = prefs.emailFromName - emailFromAddress = prefs.emailFromAddress - defaultEmailType = prefs.defaultEmailType.code - headingLineType = setType prefs.lineColor - headingLineColor = prefs.lineColor - headingTextType = setType prefs.headingColor - headingTextColor = prefs.headingColor - listFonts = prefs.listFonts - headingFontSize = prefs.headingFontSize - listFontSize = prefs.textFontSize - timeZone = prefs.timeZoneId - groupPassword = Some prefs.groupPassword - pageSize = prefs.pageSize - asOfDate = prefs.asOfDateDisplay.code - listVisibility = - match true with - | _ when prefs.isPublic -> RequestVisibility.``public`` - | _ when prefs.groupPassword = "" -> RequestVisibility.``private`` - | _ -> RequestVisibility.passwordProtected - } /// Set the properties of a small group based on the form's properties member this.populatePreferences (prefs : ListPreferences) = let isPublic, grpPw = @@ -335,6 +312,34 @@ with pageSize = this.pageSize asOfDateDisplay = AsOfDateDisplay.fromCode this.asOfDate } +module EditPreferences = + /// Populate an edit form from existing preferences + let fromPreferences (prefs : ListPreferences) = + let setType (x : string) = match x.StartsWith "#" with true -> "RGB" | false -> "Name" + { expireDays = prefs.daysToExpire + daysToKeepNew = prefs.daysToKeepNew + longTermUpdateWeeks = prefs.longTermUpdateWeeks + requestSort = prefs.requestSort.code + emailFromName = prefs.emailFromName + emailFromAddress = prefs.emailFromAddress + defaultEmailType = prefs.defaultEmailType.code + headingLineType = setType prefs.lineColor + headingLineColor = prefs.lineColor + headingTextType = setType prefs.headingColor + headingTextColor = prefs.headingColor + listFonts = prefs.listFonts + headingFontSize = prefs.headingFontSize + listFontSize = prefs.textFontSize + timeZone = prefs.timeZoneId + groupPassword = Some prefs.groupPassword + pageSize = prefs.pageSize + asOfDate = prefs.asOfDateDisplay.code + listVisibility = + match true with + | _ when prefs.isPublic -> RequestVisibility.``public`` + | _ when prefs.groupPassword = "" -> RequestVisibility.``private`` + | _ -> RequestVisibility.passwordProtected + } /// Form for adding or editing prayer requests @@ -357,8 +362,11 @@ type EditRequest = text : string } with + /// Is this a new request? + member this.isNew () = Guid.Empty = this.requestId +module EditRequest = /// An empty instance to use for new requests - static member empty = + let empty = { requestId = Guid.Empty requestType = CurrentRequest.code enteredDate = None @@ -368,16 +376,14 @@ with text = "" } /// Create an instance from an existing request - static member fromRequest req = - { EditRequest.empty with + let fromRequest req = + { empty with requestId = req.prayerRequestId requestType = req.requestType.code requestor = req.requestor expiration = req.expiration.code text = req.text } - /// Is this a new request? - member this.isNew () = Guid.Empty = this.requestId /// Form for the admin-level editing of small groups @@ -391,18 +397,6 @@ type EditSmallGroup = churchId : ChurchId } with - /// Create an instance from an existing small group - static member fromGroup (g : SmallGroup) = - { smallGroupId = g.smallGroupId - name = g.name - churchId = g.churchId - } - /// An empty instance (used when adding a new group) - static member empty = - { smallGroupId = Guid.Empty - name = "" - churchId = Guid.Empty - } /// Is this a new small group? member this.isNew () = Guid.Empty = this.smallGroupId /// Populate a small group from this form @@ -411,6 +405,19 @@ with name = this.name churchId = this.churchId } +module EditSmallGroup = + /// Create an instance from an existing small group + let fromGroup (g : SmallGroup) = + { smallGroupId = g.smallGroupId + name = g.name + churchId = g.churchId + } + /// An empty instance (used when adding a new group) + let empty = + { smallGroupId = Guid.Empty + name = "" + churchId = Guid.Empty + } /// Form for the user edit page @@ -432,25 +439,6 @@ type EditUser = isAdmin : bool option } with - /// An empty instance - static member empty = - { userId = Guid.Empty - firstName = "" - lastName = "" - emailAddress = "" - password = "" - passwordConfirm = "" - isAdmin = None - } - /// Create an instance from an existing user - static member fromUser (user : User) = - { EditUser.empty with - userId = user.userId - firstName = user.firstName - lastName = user.lastName - emailAddress = user.emailAddress - isAdmin = match user.isAdmin with true -> Some true | false -> None - } /// Is this a new user? member this.isNew () = Guid.Empty = this.userId /// Populate a user from the form @@ -462,8 +450,28 @@ with isAdmin = match this.isAdmin with Some x -> x | None -> false } |> function - | u when this.password = null || this.password = "" -> u + | u when isNull this.password || this.password = "" -> u | u -> { u with passwordHash = hasher this.password } +module EditUser = + /// An empty instance + let empty = + { userId = Guid.Empty + firstName = "" + lastName = "" + emailAddress = "" + password = "" + passwordConfirm = "" + isAdmin = None + } + /// Create an instance from an existing user + let fromUser (user : User) = + { empty with + userId = user.userId + firstName = user.firstName + lastName = user.lastName + emailAddress = user.emailAddress + isAdmin = match user.isAdmin with true -> Some true | false -> None + } /// Form for the small group log on page @@ -476,8 +484,9 @@ type GroupLogOn = /// Whether to remember the login rememberMe : bool option } -with - static member empty = +module GroupLogOn = + /// An empty instance + let empty = { smallGroupId = Guid.Empty password = "" rememberMe = None @@ -498,8 +507,9 @@ type MaintainRequests = /// The page number of the results pageNbr : int option } -with - static member empty = +module MaintainRequests = + /// An empty instance + let empty = { requests = Seq.empty smallGroup = SmallGroup.empty onlyActive = None @@ -536,8 +546,9 @@ type UserLogOn = /// The URL to which the user should be redirected once login is successful redirectUrl : string option } -with - static member empty = +module UserLogOn = + /// An empty instance + let empty = { emailAddress = "" password = "" smallGroupId = Guid.Empty diff --git a/src/PrayerTracker/Church.fs b/src/PrayerTracker/Church.fs index f1694f4..2832fef 100644 --- a/src/PrayerTracker/Church.fs +++ b/src/PrayerTracker/Church.fs @@ -26,16 +26,15 @@ let delete churchId : HttpHandler = >=> fun next ctx -> let db = ctx.dbContext () task { - let! church = db.TryChurchById churchId - match church with - | Some ch -> + match! db.TryChurchById churchId with + | Some church -> let! _, stats = findStats db churchId - db.RemoveEntry ch + db.RemoveEntry church let! _ = db.SaveChangesAsync () let s = Views.I18N.localizer.Force () addInfo ctx s.["The church {0} and its {1} small groups (with {2} prayer request(s)) were deleted successfully; revoked access from {3} user(s)", - ch.name, stats.smallGroups, stats.prayerRequests, stats.users] + church.name, stats.smallGroups, stats.prayerRequests, stats.users] return! redirectTo false "/web/churches" next ctx | None -> return! fourOhFour next ctx } @@ -54,13 +53,12 @@ let edit churchId : HttpHandler = |> Views.Church.edit EditChurch.empty ctx |> renderHtml next ctx | _ -> - let db = ctx.dbContext () - let! church = db.TryChurchById churchId - match church with - | Some ch -> + let db = ctx.dbContext () + match! db.TryChurchById churchId with + | Some church -> return! viewInfo ctx startTicks - |> Views.Church.edit (EditChurch.fromChurch ch) ctx + |> Views.Church.edit (EditChurch.fromChurch church) ctx |> renderHtml next ctx | None -> return! fourOhFour next ctx } @@ -89,8 +87,7 @@ let save : HttpHandler = >=> validateCSRF >=> fun next ctx -> task { - let! result = ctx.TryBindFormAsync () - match result with + match! ctx.TryBindFormAsync () with | Ok m -> let db = ctx.dbContext () let! church = diff --git a/src/PrayerTracker/CommonFunctions.fs b/src/PrayerTracker/CommonFunctions.fs index efb3ea0..eed53c7 100644 --- a/src/PrayerTracker/CommonFunctions.fs +++ b/src/PrayerTracker/CommonFunctions.fs @@ -142,19 +142,19 @@ let htmlString (x : LocalizedString) = /// Add an error message to the session let addError ctx msg = - addUserMessage ctx { UserMessage.Error with text = htmlLocString msg } + addUserMessage ctx { UserMessage.error with text = htmlLocString msg } /// Add an informational message to the session let addInfo ctx msg = - addUserMessage ctx { UserMessage.Info with text = htmlLocString msg } + addUserMessage ctx { UserMessage.info with text = htmlLocString msg } /// Add an informational HTML message to the session let addHtmlInfo ctx msg = - addUserMessage ctx { UserMessage.Info with text = htmlString msg } + addUserMessage ctx { UserMessage.info with text = htmlString msg } /// Add a warning message to the session let addWarning ctx msg = - addUserMessage ctx { UserMessage.Warning with text = htmlLocString msg } + addUserMessage ctx { UserMessage.warning with text = htmlLocString msg } /// A level of required access diff --git a/src/PrayerTracker/PrayerRequest.fs b/src/PrayerTracker/PrayerRequest.fs index ec0ba5c..f272c6a 100644 --- a/src/PrayerTracker/PrayerRequest.fs +++ b/src/PrayerTracker/PrayerRequest.fs @@ -13,9 +13,8 @@ open System.Threading.Tasks /// Retrieve a prayer request, and ensure that it belongs to the current class let private findRequest (ctx : HttpContext) reqId = task { - let! req = ctx.dbContext().TryRequestById reqId - match req with - | Some pr when pr.smallGroupId = (currentGroup ctx).smallGroupId -> return Ok pr + match! ctx.dbContext().TryRequestById reqId with + | Some req when req.smallGroupId = (currentGroup ctx).smallGroupId -> return Ok req | Some _ -> let s = Views.I18N.localizer.Force () addError ctx s.["The prayer request you tried to access is not assigned to your group"] @@ -62,13 +61,12 @@ let edit (reqId : PrayerRequestId) : HttpHandler = |> Views.PrayerRequest.edit EditRequest.empty (now.ToString "yyyy-MM-dd") ctx |> renderHtml next ctx | false -> - let! result = findRequest ctx reqId - match result with + match! findRequest ctx reqId with | Ok req -> let s = Views.I18N.localizer.Force () match req.isExpired now grp.preferences.daysToExpire with | true -> - { UserMessage.Warning with + { UserMessage.warning with text = htmlLocString s.["This request is expired."] description = s.["To make it active again, update it as necessary, leave “{0}” and “{1}” unchecked, and it will return as an active request.", @@ -113,12 +111,11 @@ let delete reqId : HttpHandler = >=> validateCSRF >=> fun next ctx -> task { - let! result = findRequest ctx reqId - match result with - | Ok r -> + match! findRequest ctx reqId with + | Ok req -> let db = ctx.dbContext () let s = Views.I18N.localizer.Force () - db.PrayerRequests.Remove r |> ignore + db.PrayerRequests.Remove req |> ignore let! _ = db.SaveChangesAsync () addInfo ctx s.["The prayer request was deleted successfully"] return! redirectTo false "/web/prayer-requests" next ctx @@ -131,12 +128,11 @@ let expire reqId : HttpHandler = requireAccess [ User ] >=> fun next ctx -> task { - let! result = findRequest ctx reqId - match result with - | Ok r -> + match! findRequest ctx reqId with + | Ok req -> let db = ctx.dbContext () let s = Views.I18N.localizer.Force () - db.UpdateEntry { r with expiration = Forced } + db.UpdateEntry { req with expiration = Forced } let! _ = db.SaveChangesAsync () addInfo ctx s.["Successfully {0} prayer request", s.["Expired"].Value.ToLower ()] return! redirectTo false "/web/prayer-requests" next ctx @@ -151,17 +147,16 @@ let list groupId : HttpHandler = let startTicks = DateTime.Now.Ticks let db = ctx.dbContext () task { - let! grp = db.TryGroupById groupId - match grp with - | Some g when g.preferences.isPublic -> + match! db.TryGroupById groupId with + | Some grp when grp.preferences.isPublic -> let clock = ctx.GetService () - let reqs = db.AllRequestsForSmallGroup g clock None true 0 + let reqs = db.AllRequestsForSmallGroup grp clock None true 0 return! viewInfo ctx startTicks |> Views.PrayerRequest.list { requests = List.ofSeq reqs - date = g.localDateNow clock - listGroup = g + date = grp.localDateNow clock + listGroup = grp showHeader = true canEmail = (tryCurrentUser >> Option.isSome) ctx recipients = [] @@ -242,12 +237,11 @@ let restore reqId : HttpHandler = requireAccess [ User ] >=> fun next ctx -> task { - let! result = findRequest ctx reqId - match result with - | Ok r -> + match! findRequest ctx reqId with + | Ok req -> let db = ctx.dbContext () let s = Views.I18N.localizer.Force () - db.UpdateEntry { r with expiration = Automatic; updatedDate = DateTime.Now } + db.UpdateEntry { req with expiration = Automatic; updatedDate = DateTime.Now } let! _ = db.SaveChangesAsync () addInfo ctx s.["Successfully {0} prayer request", s.["Restored"].Value.ToLower ()] return! redirectTo false "/web/prayer-requests" next ctx diff --git a/src/PrayerTracker/SmallGroup.fs b/src/PrayerTracker/SmallGroup.fs index 5663bc2..59a6a92 100644 --- a/src/PrayerTracker/SmallGroup.fs +++ b/src/PrayerTracker/SmallGroup.fs @@ -16,7 +16,7 @@ open System.Threading.Tasks /// Set a small group "Remember Me" cookie let private setGroupCookie (ctx : HttpContext) pwHash = ctx.Response.Cookies.Append - (Key.Cookie.group, { GroupId = (currentGroup ctx).smallGroupId; PasswordHash = pwHash }.toPayload(), autoRefresh) + (Key.Cookie.group, { GroupId = (currentGroup ctx).smallGroupId; PasswordHash = pwHash }.toPayload (), autoRefresh) /// GET /small-group/announcement @@ -37,16 +37,15 @@ let delete groupId : HttpHandler = let db = ctx.dbContext () let s = Views.I18N.localizer.Force () task { - let! grp = db.TryGroupById groupId - match grp with - | Some g -> + match! db.TryGroupById groupId with + | Some grp -> let! reqs = db.CountRequestsBySmallGroup groupId let! usrs = db.CountUsersBySmallGroup groupId - db.RemoveEntry g + db.RemoveEntry grp let! _ = db.SaveChangesAsync () addInfo ctx s.["The group {0} and its {1} prayer request(s) were deleted successfully; revoked access from {2} user(s)", - g.name, reqs, usrs] + grp.name, reqs, usrs] return! redirectTo false "/web/small-groups" next ctx | None -> return! fourOhFour next ctx } @@ -60,12 +59,11 @@ let deleteMember memberId : HttpHandler = let db = ctx.dbContext () let s = Views.I18N.localizer.Force () task { - let! mbr = db.TryMemberById memberId - match mbr with - | Some m when m.smallGroupId = (currentGroup ctx).smallGroupId -> - db.RemoveEntry m + match! db.TryMemberById memberId with + | Some mbr when mbr.smallGroupId = (currentGroup ctx).smallGroupId -> + db.RemoveEntry mbr let! _ = db.SaveChangesAsync () - addHtmlInfo ctx s.["The group member “{0}” was deleted successfully", m.memberName] + addHtmlInfo ctx s.["The group member “{0}” was deleted successfully", mbr.memberName] return! redirectTo false "/web/small-group/members" next ctx | Some _ | None -> return! fourOhFour next ctx @@ -87,12 +85,11 @@ let edit (groupId : SmallGroupId) : HttpHandler = |> Views.SmallGroup.edit EditSmallGroup.empty churches ctx |> renderHtml next ctx | false -> - let! grp = db.TryGroupById groupId - match grp with - | Some g -> + match! db.TryGroupById groupId with + | Some grp -> return! viewInfo ctx startTicks - |> Views.SmallGroup.edit (EditSmallGroup.fromGroup g) churches ctx + |> Views.SmallGroup.edit (EditSmallGroup.fromGroup grp) churches ctx |> renderHtml next ctx | None -> return! fourOhFour next ctx } @@ -115,12 +112,11 @@ let editMember (memberId : MemberId) : HttpHandler = |> Views.SmallGroup.editMember EditMember.empty typs ctx |> renderHtml next ctx | false -> - let! mbr = db.TryMemberById memberId - match mbr with - | Some m when m.smallGroupId = grp.smallGroupId -> + match! db.TryMemberById memberId with + | Some mbr when mbr.smallGroupId = grp.smallGroupId -> return! viewInfo ctx startTicks - |> Views.SmallGroup.editMember (EditMember.fromMember m) typs ctx + |> Views.SmallGroup.editMember (EditMember.fromMember mbr) typs ctx |> renderHtml next ctx | Some _ | None -> return! fourOhFour next ctx @@ -148,16 +144,14 @@ let logOnSubmit : HttpHandler = >=> validateCSRF >=> fun next ctx -> task { - let! result = ctx.TryBindFormAsync () - match result with + match! ctx.TryBindFormAsync () with | Ok m -> - let s = Views.I18N.localizer.Force () - let! grp = ctx.dbContext().TryGroupLogOnByPassword m.smallGroupId m.password - match grp with - | Some _ -> - ctx.Session.SetSmallGroup grp + let s = Views.I18N.localizer.Force () + match! ctx.dbContext().TryGroupLogOnByPassword m.smallGroupId m.password with + | Some grp -> + (Some >> ctx.Session.SetSmallGroup) grp match m.rememberMe with - | Some x when x -> (setGroupCookie ctx << Utils.sha1Hash) m.password + | Some x when x -> (setGroupCookie ctx << sha1Hash) m.password | _ -> () addInfo ctx s.["Log On Successful • Welcome to {0}", s.["PrayerTracker"]] return! redirectTo false "/web/prayer-requests/view" next ctx @@ -251,22 +245,21 @@ let save : HttpHandler = >=> fun next ctx -> let s = Views.I18N.localizer.Force () task { - let! result = ctx.TryBindFormAsync () - match result with + match! ctx.TryBindFormAsync () with | Ok m -> let db = ctx.dbContext () - let! grp = + let! group = match m.isNew () with | true -> Task.FromResult(Some { SmallGroup.empty with smallGroupId = Guid.NewGuid () }) | false -> db.TryGroupById m.smallGroupId - match grp with - | Some g -> - m.populateGroup g + match group with + | Some grp -> + m.populateGroup grp |> function - | g when m.isNew () -> - db.AddEntry g - db.AddEntry { g.preferences with smallGroupId = g.smallGroupId } - | g -> db.UpdateEntry g + | grp when m.isNew () -> + db.AddEntry grp + db.AddEntry { grp.preferences with smallGroupId = grp.smallGroupId } + | grp -> db.UpdateEntry grp let! _ = db.SaveChangesAsync () let act = s.[match m.isNew () with true -> "Added" | false -> "Updated"].Value.ToLower () addHtmlInfo ctx s.["Successfully {0} group “{1}”", act, m.name] @@ -282,8 +275,7 @@ let saveMember : HttpHandler = >=> validateCSRF >=> fun next ctx -> task { - let! result = ctx.TryBindFormAsync () - match result with + match! ctx.TryBindFormAsync () with | Ok m -> let grp = currentGroup ctx let db = ctx.dbContext () @@ -322,21 +314,19 @@ let savePreferences : HttpHandler = >=> validateCSRF >=> fun next ctx -> task { - let! result = ctx.TryBindFormAsync () - match result with + match! ctx.TryBindFormAsync () with | Ok m -> let db = ctx.dbContext () // Since the class is stored in the session, we'll use an intermediate instance to persist it; once that // works, we can repopulate the session instance. That way, if the update fails, the page should still show // the database values, not the then out-of-sync session ones. - let! grp = db.TryGroupById (currentGroup ctx).smallGroupId - match grp with - | Some g -> - let prefs = m.populatePreferences g.preferences + match! db.TryGroupById (currentGroup ctx).smallGroupId with + | Some grp -> + let prefs = m.populatePreferences grp.preferences db.UpdateEntry prefs let! _ = db.SaveChangesAsync () // Refresh session instance - ctx.Session.SetSmallGroup <| Some { g with preferences = prefs } + ctx.Session.SetSmallGroup <| Some { grp with preferences = prefs } let s = Views.I18N.localizer.Force () addInfo ctx s.["Group preferences updated successfully"] return! redirectTo false "/web/small-group/preferences" next ctx @@ -352,8 +342,7 @@ let sendAnnouncement : HttpHandler = >=> fun next ctx -> let startTicks = DateTime.Now.Ticks task { - let! result = ctx.TryBindFormAsync () - match result with + match! ctx.TryBindFormAsync () with | Ok m -> let grp = currentGroup ctx let usr = currentUser ctx diff --git a/src/PrayerTracker/User.fs b/src/PrayerTracker/User.fs index cb1bd9a..aab2fd2 100644 --- a/src/PrayerTracker/User.fs +++ b/src/PrayerTracker/User.fs @@ -18,7 +18,7 @@ open System.Threading.Tasks let private setUserCookie (ctx : HttpContext) pwHash = ctx.Response.Cookies.Append ( Key.Cookie.user, - { Id = (currentUser ctx).userId; GroupId = (currentGroup ctx).smallGroupId; PasswordHash = pwHash }.toPayload(), + { Id = (currentUser ctx).userId; GroupId = (currentGroup ctx).smallGroupId; PasswordHash = pwHash }.toPayload (), autoRefresh) /// Retrieve a user from the database by password @@ -26,26 +26,21 @@ let private setUserCookie (ctx : HttpContext) pwHash = let private findUserByPassword m (db : AppDbContext) = task { match! db.TryUserByEmailAndGroup m.emailAddress m.smallGroupId with - | Some u -> - match u.salt with - | Some salt -> - // Already upgraded; match = success - let pwHash = pbkdf2Hash salt m.password - match u.passwordHash = pwHash with - | true -> return Some { u with passwordHash = ""; salt = None; smallGroups = List() }, pwHash - | _ -> return None, "" - | _ -> - // Not upgraded; check against old hash - match u.passwordHash = sha1Hash m.password with - | true -> - // Upgrade 'em! - let salt = Guid.NewGuid () - let pwHash = pbkdf2Hash salt m.password - let upgraded = { u with salt = Some salt; passwordHash = pwHash } - db.UpdateEntry upgraded - let! _ = db.SaveChangesAsync () - return Some { u with passwordHash = ""; salt = None; smallGroups = List() }, pwHash - | _ -> return None, "" + | Some u when Option.isSome u.salt -> + // Already upgraded; match = success + let pwHash = pbkdf2Hash (Option.get u.salt) m.password + match u.passwordHash = pwHash with + | true -> return Some { u with passwordHash = ""; salt = None; smallGroups = List() }, pwHash + | _ -> return None, "" + | Some u when u.passwordHash = sha1Hash m.password -> + // Not upgraded, but password is good; upgrade 'em! + // Upgrade 'em! + let salt = Guid.NewGuid () + let pwHash = pbkdf2Hash salt m.password + let upgraded = { u with salt = Some salt; passwordHash = pwHash } + db.UpdateEntry upgraded + let! _ = db.SaveChangesAsync () + return Some { u with passwordHash = ""; salt = None; smallGroups = List() }, pwHash | _ -> return None, "" } @@ -56,8 +51,7 @@ let changePassword : HttpHandler = >=> validateCSRF >=> fun next ctx -> task { - let! result = ctx.TryBindFormAsync () - match result with + match! ctx.TryBindFormAsync () with | Ok m -> let s = Views.I18N.localizer.Force () let db = ctx.dbContext () @@ -101,14 +95,13 @@ let delete userId : HttpHandler = >=> validateCSRF >=> fun next ctx -> task { - let db = ctx.dbContext () - let! user = db.TryUserById userId - match user with - | Some u -> - db.RemoveEntry u + let db = ctx.dbContext () + match! db.TryUserById userId with + | Some user -> + db.RemoveEntry user let! _ = db.SaveChangesAsync () let s = Views.I18N.localizer.Force () - addInfo ctx s.["Successfully deleted user {0}", u.fullName] + addInfo ctx s.["Successfully deleted user {0}", user.fullName] return! redirectTo false "/web/users" next ctx | _ -> return! fourOhFour next ctx } @@ -120,8 +113,7 @@ let doLogOn : HttpHandler = >=> validateCSRF >=> fun next ctx -> task { - let! result = ctx.TryBindFormAsync () - match result with + match! ctx.TryBindFormAsync () with | Ok m -> let db = ctx.dbContext () let s = Views.I18N.localizer.Force () @@ -140,7 +132,7 @@ let doLogOn : HttpHandler = | Some x -> x | _ -> let grpName = match grp with Some g -> g.name | _ -> "N/A" - { UserMessage.Error with + { UserMessage.error with text = htmlLocString s.["Invalid credentials - log on unsuccessful"] description = [ s.["This is likely due to one of the following reasons"].Value @@ -175,12 +167,11 @@ let edit (userId : UserId) : HttpHandler = |> Views.User.edit EditUser.empty ctx |> renderHtml next ctx | false -> - let! user = ctx.dbContext().TryUserById userId - match user with - | Some u -> + match! ctx.dbContext().TryUserById userId with + | Some user -> return! viewInfo ctx startTicks - |> Views.User.edit (EditUser.fromUser u) ctx + |> Views.User.edit (EditUser.fromUser user) ctx |> renderHtml next ctx | _ -> return! fourOhFour next ctx } @@ -236,8 +227,7 @@ let save : HttpHandler = >=> validateCSRF >=> fun next ctx -> task { - let! result = ctx.TryBindFormAsync () - match result with + match! ctx.TryBindFormAsync () with | Ok m -> let db = ctx.dbContext () let! user = @@ -257,17 +247,18 @@ let save : HttpHandler = | _ -> user match saltedUser with | Some u -> - m.populateUser u (pbkdf2Hash (Option.get u.salt)) - |> (match m.isNew () with true -> db.AddEntry | false -> db.UpdateEntry) + let updatedUser = m.populateUser u (pbkdf2Hash (Option.get u.salt)) + updatedUser |> (match m.isNew () with true -> db.AddEntry | false -> db.UpdateEntry) let! _ = db.SaveChangesAsync () let s = Views.I18N.localizer.Force () match m.isNew () with | true -> let h = CommonFunctions.htmlString - { UserMessage.Info with + { UserMessage.info with text = h s.["Successfully {0} user", s.["Added"].Value.ToLower ()] description = - h s.[ "Please select at least one group for which this user ({0}) is authorized", u.fullName] + h s.["Please select at least one group for which this user ({0}) is authorized", + updatedUser.fullName] |> Some } |> addUserMessage ctx @@ -286,8 +277,7 @@ let saveGroups : HttpHandler = >=> validateCSRF >=> fun next ctx -> task { - let! result = ctx.TryBindFormAsync () - match result with + match! ctx.TryBindFormAsync () with | Ok m -> let s = Views.I18N.localizer.Force () match Seq.length m.smallGroups with @@ -295,21 +285,20 @@ let saveGroups : HttpHandler = addError ctx s.["You must select at least one group to assign"] return! redirectTo false (sprintf "/web/user/%s/small-groups" (flatGuid m.userId)) next ctx | _ -> - let db = ctx.dbContext () - let! user = db.TryUserByIdWithGroups m.userId - match user with - | Some u -> + let db = ctx.dbContext () + match! db.TryUserByIdWithGroups m.userId with + | Some user -> let grps = m.smallGroups.Split ',' |> Array.map Guid.Parse |> List.ofArray - u.smallGroups + user.smallGroups |> Seq.filter (fun x -> not (grps |> List.exists (fun y -> y = x.smallGroupId))) |> db.UserGroupXref.RemoveRange grps |> Seq.ofList - |> Seq.filter (fun x -> not (u.smallGroups |> Seq.exists (fun y -> y.smallGroupId = x))) - |> Seq.map (fun x -> { UserSmallGroup.empty with userId = u.userId; smallGroupId = x }) + |> Seq.filter (fun x -> not (user.smallGroups |> Seq.exists (fun y -> y.smallGroupId = x))) + |> Seq.map (fun x -> { UserSmallGroup.empty with userId = user.userId; smallGroupId = x }) |> List.ofSeq |> List.iter db.AddEntry let! _ = db.SaveChangesAsync () @@ -327,14 +316,13 @@ let smallGroups userId : HttpHandler = let startTicks = DateTime.Now.Ticks let db = ctx.dbContext () task { - let! user = db.TryUserByIdWithGroups userId - match user with - | Some u -> + match! db.TryUserByIdWithGroups userId with + | Some user -> let! grps = db.GroupList () - let curGroups = u.smallGroups |> Seq.map (fun g -> flatGuid g.smallGroupId) |> List.ofSeq + let curGroups = user.smallGroups |> Seq.map (fun g -> flatGuid g.smallGroupId) |> List.ofSeq return! viewInfo ctx startTicks - |> Views.User.assignGroups (AssignGroups.fromUser u) grps curGroups ctx + |> Views.User.assignGroups (AssignGroups.fromUser user) grps curGroups ctx |> renderHtml next ctx | None -> return! fourOhFour next ctx } diff --git a/src/global.json b/src/global.json deleted file mode 100644 index f1c2b2b..0000000 --- a/src/global.json +++ /dev/null @@ -1,5 +0,0 @@ -{ - "sdk": { - "version": "3.1.101" - } -} \ No newline at end of file