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 src/PrayerTracker/appsettings.json
docs/_site docs/_site
.ionide

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

@ -660,19 +660,19 @@ let userLogOnTests =
let userMessageTests = let userMessageTests =
testList "UserMessage" [ testList "UserMessage" [
test "Error is constructed properly" { test "Error is constructed properly" {
let msg = UserMessage.Error let msg = UserMessage.error
Expect.equal msg.level "ERROR" "Incorrect message level" Expect.equal msg.level "ERROR" "Incorrect message level"
Expect.equal msg.text HtmlString.Empty "Text should have been blank" Expect.equal msg.text HtmlString.Empty "Text should have been blank"
Expect.isNone msg.description "Description should have been None" Expect.isNone msg.description "Description should have been None"
} }
test "Warning is constructed properly" { test "Warning is constructed properly" {
let msg = UserMessage.Warning let msg = UserMessage.warning
Expect.equal msg.level "WARNING" "Incorrect message level" Expect.equal msg.level "WARNING" "Incorrect message level"
Expect.equal msg.text HtmlString.Empty "Text should have been blank" Expect.equal msg.text HtmlString.Empty "Text should have been blank"
Expect.isNone msg.description "Description should have been None" Expect.isNone msg.description "Description should have been None"
} }
test "Info is constructed properly" { test "Info is constructed properly" {
let msg = UserMessage.Info let msg = UserMessage.info
Expect.equal msg.level "Info" "Incorrect message level" Expect.equal msg.level "Info" "Incorrect message level"
Expect.equal msg.text HtmlString.Empty "Text should have been blank" Expect.equal msg.text HtmlString.Empty "Text should have been blank"
Expect.isNone msg.description "Description should have been None" Expect.isNone msg.description "Description should have been None"

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

@ -46,6 +46,7 @@ module ReferenceList =
Announcement, s.["Announcements"] Announcement, s.["Announcements"]
] ]
// fsharplint:disable RecordFieldNames MemberNames
/// This is used to create a message that is displayed to the user /// This is used to create a message that is displayed to the user
[<NoComparison; NoEquality>] [<NoComparison; NoEquality>]
@ -57,21 +58,21 @@ type UserMessage =
/// The description (further information) /// The description (further information)
description : HtmlString option description : HtmlString option
} }
with module UserMessage =
/// Error message template /// Error message template
static member Error = let error =
{ level = "ERROR" { level = "ERROR"
text = HtmlString.Empty text = HtmlString.Empty
description = None description = None
} }
/// Warning message template /// Warning message template
static member Warning = let warning =
{ level = "WARNING" { level = "WARNING"
text = HtmlString.Empty text = HtmlString.Empty
description = None description = None
} }
/// Info message template /// Info message template
static member Info = let info =
{ level = "Info" { level = "Info"
text = HtmlString.Empty text = HtmlString.Empty
description = None description = None
@ -98,9 +99,9 @@ type AppViewInfo =
/// The currently logged on small group, if there is one /// The currently logged on small group, if there is one
group : SmallGroup option group : SmallGroup option
} }
with module AppViewInfo =
/// A fresh version that can be populated to process the current request /// A fresh version that can be populated to process the current request
static member fresh = let fresh =
{ style = [] { style = []
script = [] script = []
helpLink = None helpLink = None
@ -139,9 +140,9 @@ type AssignGroups =
/// The Ids of the small groups to which the user is authorized /// The Ids of the small groups to which the user is authorized
smallGroups : string smallGroups : string
} }
with module AssignGroups =
/// Create an instance of this form from an existing user /// Create an instance of this form from an existing user
static member fromUser (u : User) = let fromUser (u : User) =
{ userId = u.userId { userId = u.userId
userName = u.fullName userName = u.fullName
smallGroups = "" smallGroups = ""
@ -177,24 +178,6 @@ type EditChurch =
interfaceAddress : string option interfaceAddress : string option
} }
with 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? /// Is this a new church?
member this.isNew () = Guid.Empty = this.churchId member this.isNew () = Guid.Empty = this.churchId
/// Populate a church from this form /// Populate a church from this form
@ -206,6 +189,25 @@ with
hasInterface = match this.hasInterface with Some x -> x | None -> false hasInterface = match this.hasInterface with Some x -> x | None -> false
interfaceAddress = match this.hasInterface with Some x when x -> this.interfaceAddress | _ -> None 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 /// Form for adding/editing small group members
@ -221,22 +223,23 @@ type EditMember =
emailType : string emailType : string
} }
with with
/// Is this a new member?
member this.isNew () = Guid.Empty = this.memberId
module EditMember =
/// Create an instance from an existing member /// Create an instance from an existing member
static member fromMember (m : Member) = let fromMember (m : Member) =
{ memberId = m.memberId { memberId = m.memberId
memberName = m.memberName memberName = m.memberName
emailAddress = m.email emailAddress = m.email
emailType = match m.format with Some f -> f | None -> "" emailType = match m.format with Some f -> f | None -> ""
} }
/// An empty instance /// An empty instance
static member empty = let empty =
{ memberId = Guid.Empty { memberId = Guid.Empty
memberName = "" memberName = ""
emailAddress = "" emailAddress = ""
emailType = "" emailType = ""
} }
/// Is this a new member?
member this.isNew () = Guid.Empty = this.memberId
/// This form allows the user to set class preferences /// This form allows the user to set class preferences
@ -282,32 +285,6 @@ type EditPreferences =
asOfDate : string asOfDate : string
} }
with 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 /// Set the properties of a small group based on the form's properties
member this.populatePreferences (prefs : ListPreferences) = member this.populatePreferences (prefs : ListPreferences) =
let isPublic, grpPw = let isPublic, grpPw =
@ -335,6 +312,34 @@ with
pageSize = this.pageSize pageSize = this.pageSize
asOfDateDisplay = AsOfDateDisplay.fromCode this.asOfDate 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 /// Form for adding or editing prayer requests
@ -357,8 +362,11 @@ type EditRequest =
text : string text : string
} }
with with
/// Is this a new request?
member this.isNew () = Guid.Empty = this.requestId
module EditRequest =
/// An empty instance to use for new requests /// An empty instance to use for new requests
static member empty = let empty =
{ requestId = Guid.Empty { requestId = Guid.Empty
requestType = CurrentRequest.code requestType = CurrentRequest.code
enteredDate = None enteredDate = None
@ -368,16 +376,14 @@ with
text = "" text = ""
} }
/// Create an instance from an existing request /// Create an instance from an existing request
static member fromRequest req = let fromRequest req =
{ EditRequest.empty with { empty with
requestId = req.prayerRequestId requestId = req.prayerRequestId
requestType = req.requestType.code requestType = req.requestType.code
requestor = req.requestor requestor = req.requestor
expiration = req.expiration.code expiration = req.expiration.code
text = req.text text = req.text
} }
/// Is this a new request?
member this.isNew () = Guid.Empty = this.requestId
/// Form for the admin-level editing of small groups /// Form for the admin-level editing of small groups
@ -391,18 +397,6 @@ type EditSmallGroup =
churchId : ChurchId churchId : ChurchId
} }
with 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? /// Is this a new small group?
member this.isNew () = Guid.Empty = this.smallGroupId member this.isNew () = Guid.Empty = this.smallGroupId
/// Populate a small group from this form /// Populate a small group from this form
@ -411,6 +405,19 @@ with
name = this.name name = this.name
churchId = this.churchId 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 /// Form for the user edit page
@ -432,25 +439,6 @@ type EditUser =
isAdmin : bool option isAdmin : bool option
} }
with 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? /// Is this a new user?
member this.isNew () = Guid.Empty = this.userId member this.isNew () = Guid.Empty = this.userId
/// Populate a user from the form /// Populate a user from the form
@ -462,8 +450,28 @@ with
isAdmin = match this.isAdmin with Some x -> x | None -> false isAdmin = match this.isAdmin with Some x -> x | None -> false
} }
|> function |> function
| u when this.password = null || this.password = "" -> u | u when isNull this.password || this.password = "" -> u
| u -> { u with passwordHash = hasher this.password } | 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 /// Form for the small group log on page
@ -476,8 +484,9 @@ type GroupLogOn =
/// Whether to remember the login /// Whether to remember the login
rememberMe : bool option rememberMe : bool option
} }
with module GroupLogOn =
static member empty = /// An empty instance
let empty =
{ smallGroupId = Guid.Empty { smallGroupId = Guid.Empty
password = "" password = ""
rememberMe = None rememberMe = None
@ -498,8 +507,9 @@ type MaintainRequests =
/// The page number of the results /// The page number of the results
pageNbr : int option pageNbr : int option
} }
with module MaintainRequests =
static member empty = /// An empty instance
let empty =
{ requests = Seq.empty { requests = Seq.empty
smallGroup = SmallGroup.empty smallGroup = SmallGroup.empty
onlyActive = None onlyActive = None
@ -536,8 +546,9 @@ type UserLogOn =
/// The URL to which the user should be redirected once login is successful /// The URL to which the user should be redirected once login is successful
redirectUrl : string option redirectUrl : string option
} }
with module UserLogOn =
static member empty = /// An empty instance
let empty =
{ emailAddress = "" { emailAddress = ""
password = "" password = ""
smallGroupId = Guid.Empty smallGroupId = Guid.Empty

19
src/PrayerTracker/Church.fs
View File

@ -26,16 +26,15 @@ let delete churchId : HttpHandler =
>=> fun next ctx -> >=> fun next ctx ->
let db = ctx.dbContext () let db = ctx.dbContext ()
task { task {
let! church = db.TryChurchById churchId match! db.TryChurchById churchId with
match church with | Some church ->
| Some ch ->
let! _, stats = findStats db churchId let! _, stats = findStats db churchId
db.RemoveEntry ch db.RemoveEntry church
let! _ = db.SaveChangesAsync () let! _ = db.SaveChangesAsync ()
let s = Views.I18N.localizer.Force () let s = Views.I18N.localizer.Force ()
addInfo ctx 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)", 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 return! redirectTo false "/web/churches" next ctx
| None -> return! fourOhFour next ctx | None -> return! fourOhFour next ctx
} }
@ -55,12 +54,11 @@ let edit churchId : HttpHandler =
|> renderHtml next ctx |> renderHtml next ctx
| _ -> | _ ->
let db = ctx.dbContext () let db = ctx.dbContext ()
let! church = db.TryChurchById churchId match! db.TryChurchById churchId with
match church with | Some church ->
| Some ch ->
return! return!
viewInfo ctx startTicks viewInfo ctx startTicks
|> Views.Church.edit (EditChurch.fromChurch ch) ctx |> Views.Church.edit (EditChurch.fromChurch church) ctx
|> renderHtml next ctx |> renderHtml next ctx
| None -> return! fourOhFour next ctx | None -> return! fourOhFour next ctx
} }
@ -89,8 +87,7 @@ let save : HttpHandler =
>=> validateCSRF >=> validateCSRF
>=> fun next ctx -> >=> fun next ctx ->
task { task {
let! result = ctx.TryBindFormAsync<EditChurch> () match! ctx.TryBindFormAsync<EditChurch> () with
match result with
| Ok m -> | Ok m ->
let db = ctx.dbContext () let db = ctx.dbContext ()
let! church = let! church =

8
src/PrayerTracker/CommonFunctions.fs
View File

@ -142,19 +142,19 @@ let htmlString (x : LocalizedString) =
/// Add an error message to the session /// Add an error message to the session
let addError ctx msg = 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 /// Add an informational message to the session
let addInfo ctx msg = 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 /// Add an informational HTML message to the session
let addHtmlInfo ctx msg = 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 /// Add a warning message to the session
let addWarning ctx msg = 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 /// 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 /// Retrieve a prayer request, and ensure that it belongs to the current class
let private findRequest (ctx : HttpContext) reqId = let private findRequest (ctx : HttpContext) reqId =
task { task {
let! req = ctx.dbContext().TryRequestById reqId match! ctx.dbContext().TryRequestById reqId with
match req with | Some req when req.smallGroupId = (currentGroup ctx).smallGroupId -> return Ok req
| Some pr when pr.smallGroupId = (currentGroup ctx).smallGroupId -> return Ok pr
| Some _ -> | Some _ ->
let s = Views.I18N.localizer.Force () let s = Views.I18N.localizer.Force ()
addError ctx s.["The prayer request you tried to access is not assigned to your group"] 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 |> Views.PrayerRequest.edit EditRequest.empty (now.ToString "yyyy-MM-dd") ctx
|> renderHtml next ctx |> renderHtml next ctx
| false -> | false ->
let! result = findRequest ctx reqId match! findRequest ctx reqId with
match result with
| Ok req -> | Ok req ->
let s = Views.I18N.localizer.Force () let s = Views.I18N.localizer.Force ()
match req.isExpired now grp.preferences.daysToExpire with match req.isExpired now grp.preferences.daysToExpire with
| true -> | true ->
{ UserMessage.Warning with { UserMessage.warning with
text = htmlLocString s.["This request is expired."] text = htmlLocString s.["This request is expired."]
description = description =
s.["To make it active again, update it as necessary, leave “{0}” and “{1}” unchecked, and it will return as an active request.", 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 >=> validateCSRF
>=> fun next ctx -> >=> fun next ctx ->
task { task {
let! result = findRequest ctx reqId match! findRequest ctx reqId with
match result with | Ok req ->
| Ok r ->
let db = ctx.dbContext () let db = ctx.dbContext ()
let s = Views.I18N.localizer.Force () let s = Views.I18N.localizer.Force ()
db.PrayerRequests.Remove r |> ignore db.PrayerRequests.Remove req |> ignore
let! _ = db.SaveChangesAsync () let! _ = db.SaveChangesAsync ()
addInfo ctx s.["The prayer request was deleted successfully"] addInfo ctx s.["The prayer request was deleted successfully"]
return! redirectTo false "/web/prayer-requests" next ctx return! redirectTo false "/web/prayer-requests" next ctx
@ -131,12 +128,11 @@ let expire reqId : HttpHandler =
requireAccess [ User ] requireAccess [ User ]
>=> fun next ctx -> >=> fun next ctx ->
task { task {
let! result = findRequest ctx reqId match! findRequest ctx reqId with
match result with | Ok req ->
| Ok r ->
let db = ctx.dbContext () let db = ctx.dbContext ()
let s = Views.I18N.localizer.Force () let s = Views.I18N.localizer.Force ()
db.UpdateEntry { r with expiration = Forced } db.UpdateEntry { req with expiration = Forced }
let! _ = db.SaveChangesAsync () let! _ = db.SaveChangesAsync ()
addInfo ctx s.["Successfully {0} prayer request", s.["Expired"].Value.ToLower ()] addInfo ctx s.["Successfully {0} prayer request", s.["Expired"].Value.ToLower ()]
return! redirectTo false "/web/prayer-requests" next ctx return! redirectTo false "/web/prayer-requests" next ctx
@ -151,17 +147,16 @@ let list groupId : HttpHandler =
let startTicks = DateTime.Now.Ticks let startTicks = DateTime.Now.Ticks
let db = ctx.dbContext () let db = ctx.dbContext ()
task { task {
let! grp = db.TryGroupById groupId match! db.TryGroupById groupId with
match grp with | Some grp when grp.preferences.isPublic ->
| Some g when g.preferences.isPublic ->
let clock = ctx.GetService<IClock> () let clock = ctx.GetService<IClock> ()
let reqs = db.AllRequestsForSmallGroup g clock None true 0 let reqs = db.AllRequestsForSmallGroup grp clock None true 0
return! return!
viewInfo ctx startTicks viewInfo ctx startTicks
|> Views.PrayerRequest.list |> Views.PrayerRequest.list
{ requests = List.ofSeq reqs { requests = List.ofSeq reqs
date = g.localDateNow clock date = grp.localDateNow clock
listGroup = g listGroup = grp
showHeader = true showHeader = true
canEmail = (tryCurrentUser >> Option.isSome) ctx canEmail = (tryCurrentUser >> Option.isSome) ctx
recipients = [] recipients = []
@ -242,12 +237,11 @@ let restore reqId : HttpHandler =
requireAccess [ User ] requireAccess [ User ]
>=> fun next ctx -> >=> fun next ctx ->
task { task {
let! result = findRequest ctx reqId match! findRequest ctx reqId with
match result with | Ok req ->
| Ok r ->
let db = ctx.dbContext () let db = ctx.dbContext ()
let s = Views.I18N.localizer.Force () 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 () let! _ = db.SaveChangesAsync ()
addInfo ctx s.["Successfully {0} prayer request", s.["Restored"].Value.ToLower ()] addInfo ctx s.["Successfully {0} prayer request", s.["Restored"].Value.ToLower ()]
return! redirectTo false "/web/prayer-requests" next ctx return! redirectTo false "/web/prayer-requests" next ctx

83
src/PrayerTracker/SmallGroup.fs
View File

@ -16,7 +16,7 @@ open System.Threading.Tasks
/// Set a small group "Remember Me" cookie /// Set a small group "Remember Me" cookie
let private setGroupCookie (ctx : HttpContext) pwHash = let private setGroupCookie (ctx : HttpContext) pwHash =
ctx.Response.Cookies.Append 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 /// GET /small-group/announcement
@ -37,16 +37,15 @@ let delete groupId : HttpHandler =
let db = ctx.dbContext () let db = ctx.dbContext ()
let s = Views.I18N.localizer.Force () let s = Views.I18N.localizer.Force ()
task { task {
let! grp = db.TryGroupById groupId match! db.TryGroupById groupId with
match grp with | Some grp ->
| Some g ->
let! reqs = db.CountRequestsBySmallGroup groupId let! reqs = db.CountRequestsBySmallGroup groupId
let! usrs = db.CountUsersBySmallGroup groupId let! usrs = db.CountUsersBySmallGroup groupId
db.RemoveEntry g db.RemoveEntry grp
let! _ = db.SaveChangesAsync () let! _ = db.SaveChangesAsync ()
addInfo ctx addInfo ctx
s.["The group {0} and its {1} prayer request(s) were deleted successfully; revoked access from {2} user(s)", 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 return! redirectTo false "/web/small-groups" next ctx
| None -> return! fourOhFour next ctx | None -> return! fourOhFour next ctx
} }
@ -60,12 +59,11 @@ let deleteMember memberId : HttpHandler =
let db = ctx.dbContext () let db = ctx.dbContext ()
let s = Views.I18N.localizer.Force () let s = Views.I18N.localizer.Force ()
task { task {
let! mbr = db.TryMemberById memberId match! db.TryMemberById memberId with
match mbr with | Some mbr when mbr.smallGroupId = (currentGroup ctx).smallGroupId ->
| Some m when m.smallGroupId = (currentGroup ctx).smallGroupId -> db.RemoveEntry mbr
db.RemoveEntry m
let! _ = db.SaveChangesAsync () 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 return! redirectTo false "/web/small-group/members" next ctx
| Some _ | Some _
| None -> return! fourOhFour next ctx | None -> return! fourOhFour next ctx
@ -87,12 +85,11 @@ let edit (groupId : SmallGroupId) : HttpHandler =
|> Views.SmallGroup.edit EditSmallGroup.empty churches ctx |> Views.SmallGroup.edit EditSmallGroup.empty churches ctx
|> renderHtml next ctx |> renderHtml next ctx
| false -> | false ->
let! grp = db.TryGroupById groupId match! db.TryGroupById groupId with
match grp with | Some grp ->
| Some g ->
return! return!
viewInfo ctx startTicks viewInfo ctx startTicks
|> Views.SmallGroup.edit (EditSmallGroup.fromGroup g) churches ctx |> Views.SmallGroup.edit (EditSmallGroup.fromGroup grp) churches ctx
|> renderHtml next ctx |> renderHtml next ctx
| None -> return! fourOhFour next ctx | None -> return! fourOhFour next ctx
} }
@ -115,12 +112,11 @@ let editMember (memberId : MemberId) : HttpHandler =
|> Views.SmallGroup.editMember EditMember.empty typs ctx |> Views.SmallGroup.editMember EditMember.empty typs ctx
|> renderHtml next ctx |> renderHtml next ctx
| false -> | false ->
let! mbr = db.TryMemberById memberId match! db.TryMemberById memberId with
match mbr with | Some mbr when mbr.smallGroupId = grp.smallGroupId ->
| Some m when m.smallGroupId = grp.smallGroupId ->
return! return!
viewInfo ctx startTicks viewInfo ctx startTicks
|> Views.SmallGroup.editMember (EditMember.fromMember m) typs ctx |> Views.SmallGroup.editMember (EditMember.fromMember mbr) typs ctx
|> renderHtml next ctx |> renderHtml next ctx
| Some _ | Some _
| None -> return! fourOhFour next ctx | None -> return! fourOhFour next ctx
@ -148,16 +144,14 @@ let logOnSubmit : HttpHandler =
>=> validateCSRF >=> validateCSRF
>=> fun next ctx -> >=> fun next ctx ->
task { task {
let! result = ctx.TryBindFormAsync<GroupLogOn> () match! ctx.TryBindFormAsync<GroupLogOn> () with
match result with
| Ok m -> | Ok m ->
let s = Views.I18N.localizer.Force () let s = Views.I18N.localizer.Force ()
let! grp = ctx.dbContext().TryGroupLogOnByPassword m.smallGroupId m.password match! ctx.dbContext().TryGroupLogOnByPassword m.smallGroupId m.password with
match grp with | Some grp ->
| Some _ -> (Some >> ctx.Session.SetSmallGroup) grp
ctx.Session.SetSmallGroup grp
match m.rememberMe with 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"]] addInfo ctx s.["Log On Successful • Welcome to {0}", s.["PrayerTracker"]]
return! redirectTo false "/web/prayer-requests/view" next ctx return! redirectTo false "/web/prayer-requests/view" next ctx
@ -251,22 +245,21 @@ let save : HttpHandler =
>=> fun next ctx -> >=> fun next ctx ->
let s = Views.I18N.localizer.Force () let s = Views.I18N.localizer.Force ()
task { task {
let! result = ctx.TryBindFormAsync<EditSmallGroup> () match! ctx.TryBindFormAsync<EditSmallGroup> () with
match result with
| Ok m -> | Ok m ->
let db = ctx.dbContext () let db = ctx.dbContext ()
let! grp = let! group =
match m.isNew () with match m.isNew () with
| true -> Task.FromResult<SmallGroup option>(Some { SmallGroup.empty with smallGroupId = Guid.NewGuid () }) | true -> Task.FromResult<SmallGroup option>(Some { SmallGroup.empty with smallGroupId = Guid.NewGuid () })
| false -> db.TryGroupById m.smallGroupId | false -> db.TryGroupById m.smallGroupId
match grp with match group with
| Some g -> | Some grp ->
m.populateGroup g m.populateGroup grp
|> function |> function
| g when m.isNew () -> | grp when m.isNew () ->
db.AddEntry g db.AddEntry grp
db.AddEntry { g.preferences with smallGroupId = g.smallGroupId } db.AddEntry { grp.preferences with smallGroupId = grp.smallGroupId }
| g -> db.UpdateEntry g | grp -> db.UpdateEntry grp
let! _ = db.SaveChangesAsync () let! _ = db.SaveChangesAsync ()
let act = s.[match m.isNew () with true -> "Added" | false -> "Updated"].Value.ToLower () let act = s.[match m.isNew () with true -> "Added" | false -> "Updated"].Value.ToLower ()
addHtmlInfo ctx s.["Successfully {0} group “{1}”", act, m.name] addHtmlInfo ctx s.["Successfully {0} group “{1}”", act, m.name]
@ -282,8 +275,7 @@ let saveMember : HttpHandler =
>=> validateCSRF >=> validateCSRF
>=> fun next ctx -> >=> fun next ctx ->
task { task {
let! result = ctx.TryBindFormAsync<EditMember> () match! ctx.TryBindFormAsync<EditMember> () with
match result with
| Ok m -> | Ok m ->
let grp = currentGroup ctx let grp = currentGroup ctx
let db = ctx.dbContext () let db = ctx.dbContext ()
@ -322,21 +314,19 @@ let savePreferences : HttpHandler =
>=> validateCSRF >=> validateCSRF
>=> fun next ctx -> >=> fun next ctx ->
task { task {
let! result = ctx.TryBindFormAsync<EditPreferences> () match! ctx.TryBindFormAsync<EditPreferences> () with
match result with
| Ok m -> | Ok m ->
let db = ctx.dbContext () let db = ctx.dbContext ()
// Since the class is stored in the session, we'll use an intermediate instance to persist it; once that // 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 // 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. // the database values, not the then out-of-sync session ones.
let! grp = db.TryGroupById (currentGroup ctx).smallGroupId match! db.TryGroupById (currentGroup ctx).smallGroupId with
match grp with | Some grp ->
| Some g -> let prefs = m.populatePreferences grp.preferences
let prefs = m.populatePreferences g.preferences
db.UpdateEntry prefs db.UpdateEntry prefs
let! _ = db.SaveChangesAsync () let! _ = db.SaveChangesAsync ()
// Refresh session instance // 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 () let s = Views.I18N.localizer.Force ()
addInfo ctx s.["Group preferences updated successfully"] addInfo ctx s.["Group preferences updated successfully"]
return! redirectTo false "/web/small-group/preferences" next ctx return! redirectTo false "/web/small-group/preferences" next ctx
@ -352,8 +342,7 @@ let sendAnnouncement : HttpHandler =
>=> fun next ctx -> >=> fun next ctx ->
let startTicks = DateTime.Now.Ticks let startTicks = DateTime.Now.Ticks
task { task {
let! result = ctx.TryBindFormAsync<Announcement> () match! ctx.TryBindFormAsync<Announcement> () with
match result with
| Ok m -> | Ok m ->
let grp = currentGroup ctx let grp = currentGroup ctx
let usr = currentUser ctx let usr = currentUser ctx

74
src/PrayerTracker/User.fs
View File

@ -18,7 +18,7 @@ open System.Threading.Tasks
let private setUserCookie (ctx : HttpContext) pwHash = let private setUserCookie (ctx : HttpContext) pwHash =
ctx.Response.Cookies.Append ( ctx.Response.Cookies.Append (
Key.Cookie.user, 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) autoRefresh)
/// Retrieve a user from the database by password /// Retrieve a user from the database by password
@ -26,18 +26,14 @@ let private setUserCookie (ctx : HttpContext) pwHash =
let private findUserByPassword m (db : AppDbContext) = let private findUserByPassword m (db : AppDbContext) =
task { task {
match! db.TryUserByEmailAndGroup m.emailAddress m.smallGroupId with match! db.TryUserByEmailAndGroup m.emailAddress m.smallGroupId with
| Some u -> | Some u when Option.isSome u.salt ->
match u.salt with
| Some salt ->
// Already upgraded; match = success // Already upgraded; match = success
let pwHash = pbkdf2Hash salt m.password let pwHash = pbkdf2Hash (Option.get u.salt) m.password
match u.passwordHash = pwHash with match u.passwordHash = pwHash with
| true -> return Some { u with passwordHash = ""; salt = None; smallGroups = List<UserSmallGroup>() }, pwHash | true -> return Some { u with passwordHash = ""; salt = None; smallGroups = List<UserSmallGroup>() }, pwHash
| _ -> return None, "" | _ -> return None, ""
| _ -> | Some u when u.passwordHash = sha1Hash m.password ->
// Not upgraded; check against old hash // Not upgraded, but password is good; upgrade 'em!
match u.passwordHash = sha1Hash m.password with
| true ->
// Upgrade 'em! // Upgrade 'em!
let salt = Guid.NewGuid () let salt = Guid.NewGuid ()
let pwHash = pbkdf2Hash salt m.password let pwHash = pbkdf2Hash salt m.password
@ -46,7 +42,6 @@ let private findUserByPassword m (db : AppDbContext) =
let! _ = db.SaveChangesAsync () let! _ = db.SaveChangesAsync ()
return Some { u with passwordHash = ""; salt = None; smallGroups = List<UserSmallGroup>() }, pwHash return Some { u with passwordHash = ""; salt = None; smallGroups = List<UserSmallGroup>() }, pwHash
| _ -> return None, "" | _ -> return None, ""
| _ -> return None, ""
} }
@ -56,8 +51,7 @@ let changePassword : HttpHandler =
>=> validateCSRF >=> validateCSRF
>=> fun next ctx -> >=> fun next ctx ->
task { task {
let! result = ctx.TryBindFormAsync<ChangePassword> () match! ctx.TryBindFormAsync<ChangePassword> () with
match result with
| Ok m -> | Ok m ->
let s = Views.I18N.localizer.Force () let s = Views.I18N.localizer.Force ()
let db = ctx.dbContext () let db = ctx.dbContext ()
@ -102,13 +96,12 @@ let delete userId : HttpHandler =
>=> fun next ctx -> >=> fun next ctx ->
task { task {
let db = ctx.dbContext () let db = ctx.dbContext ()
let! user = db.TryUserById userId match! db.TryUserById userId with
match user with | Some user ->
| Some u -> db.RemoveEntry user
db.RemoveEntry u
let! _ = db.SaveChangesAsync () let! _ = db.SaveChangesAsync ()
let s = Views.I18N.localizer.Force () 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! redirectTo false "/web/users" next ctx
| _ -> return! fourOhFour next ctx | _ -> return! fourOhFour next ctx
} }
@ -120,8 +113,7 @@ let doLogOn : HttpHandler =
>=> validateCSRF >=> validateCSRF
>=> fun next ctx -> >=> fun next ctx ->
task { task {
let! result = ctx.TryBindFormAsync<UserLogOn> () match! ctx.TryBindFormAsync<UserLogOn> () with
match result with
| Ok m -> | Ok m ->
let db = ctx.dbContext () let db = ctx.dbContext ()
let s = Views.I18N.localizer.Force () let s = Views.I18N.localizer.Force ()
@ -140,7 +132,7 @@ let doLogOn : HttpHandler =
| Some x -> x | Some x -> x
| _ -> | _ ->
let grpName = match grp with Some g -> g.name | _ -> "N/A" 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"] text = htmlLocString s.["Invalid credentials - log on unsuccessful"]
description = description =
[ s.["This is likely due to one of the following reasons"].Value [ 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 |> Views.User.edit EditUser.empty ctx
|> renderHtml next ctx |> renderHtml next ctx
| false -> | false ->
let! user = ctx.dbContext().TryUserById userId match! ctx.dbContext().TryUserById userId with
match user with | Some user ->
| Some u ->
return! return!
viewInfo ctx startTicks viewInfo ctx startTicks
|> Views.User.edit (EditUser.fromUser u) ctx |> Views.User.edit (EditUser.fromUser user) ctx
|> renderHtml next ctx |> renderHtml next ctx
| _ -> return! fourOhFour next ctx | _ -> return! fourOhFour next ctx
} }
@ -236,8 +227,7 @@ let save : HttpHandler =
>=> validateCSRF >=> validateCSRF
>=> fun next ctx -> >=> fun next ctx ->
task { task {
let! result = ctx.TryBindFormAsync<EditUser> () match! ctx.TryBindFormAsync<EditUser> () with
match result with
| Ok m -> | Ok m ->
let db = ctx.dbContext () let db = ctx.dbContext ()
let! user = let! user =
@ -257,17 +247,18 @@ let save : HttpHandler =
| _ -> user | _ -> user
match saltedUser with match saltedUser with
| Some u -> | Some u ->
m.populateUser u (pbkdf2Hash (Option.get u.salt)) let updatedUser = m.populateUser u (pbkdf2Hash (Option.get u.salt))
|> (match m.isNew () with true -> db.AddEntry | false -> db.UpdateEntry) updatedUser |> (match m.isNew () with true -> db.AddEntry | false -> db.UpdateEntry)
let! _ = db.SaveChangesAsync () let! _ = db.SaveChangesAsync ()
let s = Views.I18N.localizer.Force () let s = Views.I18N.localizer.Force ()
match m.isNew () with match m.isNew () with
| true -> | true ->
let h = CommonFunctions.htmlString let h = CommonFunctions.htmlString
{ UserMessage.Info with { UserMessage.info with
text = h s.["Successfully {0} user", s.["Added"].Value.ToLower ()] text = h s.["Successfully {0} user", s.["Added"].Value.ToLower ()]
description = 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 |> Some
} }
|> addUserMessage ctx |> addUserMessage ctx
@ -286,8 +277,7 @@ let saveGroups : HttpHandler =
>=> validateCSRF >=> validateCSRF
>=> fun next ctx -> >=> fun next ctx ->
task { task {
let! result = ctx.TryBindFormAsync<AssignGroups> () match! ctx.TryBindFormAsync<AssignGroups> () with
match result with
| Ok m -> | Ok m ->
let s = Views.I18N.localizer.Force () let s = Views.I18N.localizer.Force ()
match Seq.length m.smallGroups with match Seq.length m.smallGroups with
@ -296,20 +286,19 @@ let saveGroups : HttpHandler =
return! redirectTo false (sprintf "/web/user/%s/small-groups" (flatGuid m.userId)) next ctx return! redirectTo false (sprintf "/web/user/%s/small-groups" (flatGuid m.userId)) next ctx
| _ -> | _ ->
let db = ctx.dbContext () let db = ctx.dbContext ()
let! user = db.TryUserByIdWithGroups m.userId match! db.TryUserByIdWithGroups m.userId with
match user with | Some user ->
| Some u ->
let grps = let grps =
m.smallGroups.Split ',' m.smallGroups.Split ','
|> Array.map Guid.Parse |> Array.map Guid.Parse
|> List.ofArray |> List.ofArray
u.smallGroups user.smallGroups
|> Seq.filter (fun x -> not (grps |> List.exists (fun y -> y = x.smallGroupId))) |> Seq.filter (fun x -> not (grps |> List.exists (fun y -> y = x.smallGroupId)))
|> db.UserGroupXref.RemoveRange |> db.UserGroupXref.RemoveRange
grps grps
|> Seq.ofList |> Seq.ofList
|> Seq.filter (fun x -> not (u.smallGroups |> Seq.exists (fun y -> y.smallGroupId = x))) |> Seq.filter (fun x -> not (user.smallGroups |> Seq.exists (fun y -> y.smallGroupId = x)))
|> Seq.map (fun x -> { UserSmallGroup.empty with userId = u.userId; smallGroupId = x }) |> Seq.map (fun x -> { UserSmallGroup.empty with userId = user.userId; smallGroupId = x })
|> List.ofSeq |> List.ofSeq
|> List.iter db.AddEntry |> List.iter db.AddEntry
let! _ = db.SaveChangesAsync () let! _ = db.SaveChangesAsync ()
@ -327,14 +316,13 @@ let smallGroups userId : HttpHandler =
let startTicks = DateTime.Now.Ticks let startTicks = DateTime.Now.Ticks
let db = ctx.dbContext () let db = ctx.dbContext ()
task { task {
let! user = db.TryUserByIdWithGroups userId match! db.TryUserByIdWithGroups userId with
match user with | Some user ->
| Some u ->
let! grps = db.GroupList () 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! return!
viewInfo ctx startTicks viewInfo ctx startTicks
|> Views.User.assignGroups (AssignGroups.fromUser u) grps curGroups ctx |> Views.User.assignGroups (AssignGroups.fromUser user) grps curGroups ctx
|> renderHtml next ctx |> renderHtml next ctx
| None -> return! fourOhFour next ctx | None -> return! fourOhFour next ctx
} }

5
src/global.json
View File

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