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

Display new user name (#26)

Browse Source 
Also did some refactoring to pull static members into modules
This commit is contained in:
Daniel J. Summers 2020-06-10 23:11:28 -05:00
parent cb8c2558e0
commit 7fd15a5cff
9 changed files with 254 additions and 278 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

2
.gitignore vendored
View File

@ -332,3 +332,5 @@ ASALocalRun/
### --- ###
src/PrayerTracker/appsettings.json
docs/_site
.ionide

6
src/PrayerTracker.Tests/UI/ViewModelsTests.fs
View File

@ -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"

263
src/PrayerTracker.UI/ViewModels.fs
View File

@ -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
[<NoComparison; NoEquality>]
@ -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
[<CLIMutable; NoComparison; NoEquality>]
@ -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

21
src/PrayerTracker/Church.fs
View File

@ -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<EditChurch> ()
match result with
match! ctx.TryBindFormAsync<EditChurch> () with
| Ok m ->
let db = ctx.dbContext ()
let! church =

8
src/PrayerTracker/CommonFunctions.fs
View File

@ -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

42
src/PrayerTracker/PrayerRequest.fs
View File

@ -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<IClock> ()
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

85
src/PrayerTracker/SmallGroup.fs
View File

@ -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 &ldquo;{0}&rdquo; was deleted successfully", m.memberName]
addHtmlInfo ctx s.["The group member &ldquo;{0}&rdquo; 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<GroupLogOn> ()
match result with
match! ctx.TryBindFormAsync<GroupLogOn> () 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<EditSmallGroup> ()
match result with
match! ctx.TryBindFormAsync<EditSmallGroup> () with
| Ok m ->
let db = ctx.dbContext ()
let! grp =
let! group =
match m.isNew () with
| true -> Task.FromResult<SmallGroup option>(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<EditMember> ()
match result with
match! ctx.TryBindFormAsync<EditMember> () 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<EditPreferences> ()
match result with
match! ctx.TryBindFormAsync<EditPreferences> () 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<Announcement> ()
match result with
match! ctx.TryBindFormAsync<Announcement> () with
| Ok m ->
let grp = currentGroup ctx
let usr = currentUser ctx

100
src/PrayerTracker/User.fs
View File

@ -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<UserSmallGroup>() }, 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<UserSmallGroup>() }, 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<UserSmallGroup>() }, 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<UserSmallGroup>() }, pwHash
| _ -> return None, ""
}
@ -56,8 +51,7 @@ let changePassword : HttpHandler =
>=> validateCSRF
>=> fun next ctx ->
task {
let! result = ctx.TryBindFormAsync<ChangePassword> ()
match result with
match! ctx.TryBindFormAsync<ChangePassword> () 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<UserLogOn> ()
match result with
match! ctx.TryBindFormAsync<UserLogOn> () 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<EditUser> ()
match result with
match! ctx.TryBindFormAsync<EditUser> () 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<AssignGroups> ()
match result with
match! ctx.TryBindFormAsync<AssignGroups> () 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
}

5
src/global.json
View File

@ -1,5 +0,0 @@
{
"sdk": {
"version": "3.1.101"
}
}