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

Version 8 #43

Merged
danieljsummers merged 37 commits from version-8 into main 2022-08-19 19:08:31 +00:00
Conversation 0 Commits 37 Files Changed 58 +209 -305
13 changed files with 209 additions and 305 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files
Showing only changes of commit ab3f8dcc43 - Show all commits

134
src/PrayerTracker.Data/Access.fs
View File

@ -60,7 +60,7 @@ module private Helpers =
Requestor = row.stringOrNone "requestor"
Text = row.string "request_text"
NotifyChaplain = row.bool "notify_chaplain"
RequestType = PrayerRequestType.fromCode (row.string "request_id")
RequestType = PrayerRequestType.fromCode (row.string "request_type")
Expiration = Expiration.fromCode (row.string "expiration")
}
@ -108,8 +108,7 @@ module Churches =
/// Get a list of all churches
let all conn =
conn
|> Sql.existingConnection
Sql.existingConnection conn
|> Sql.query "SELECT * FROM pt.church ORDER BY church_name"
|> Sql.executeAsync mapToChurch
@ -118,8 +117,7 @@ module Churches =
let idParam = [ [ "@churchId", Sql.uuid churchId.Value ] ]
let where = "WHERE small_group_id IN (SELECT id FROM pt.small_group WHERE church_id = @churchId)"
let! _ =
conn
|> Sql.existingConnection
Sql.existingConnection conn
|> Sql.executeTransactionAsync
[ $"DELETE FROM pt.prayer_request {where}", idParam
$"DELETE FROM pt.user_small_group {where}", idParam
@ -132,8 +130,7 @@ module Churches =
/// Save a church's information
let save (church : Church) conn = backgroundTask {
let! _ =
conn
|> Sql.existingConnection
Sql.existingConnection conn
|> Sql.query """
INSERT INTO pt.church (
id, church_name, city, state, has_vps_interface, interface_address
@ -159,8 +156,7 @@ module Churches =
/// Find a church by its ID
let tryById (churchId : ChurchId) conn = backgroundTask {
let! church =
conn
|> Sql.existingConnection
Sql.existingConnection conn
|> Sql.query "SELECT * FROM pt.church WHERE id = @id"
|> Sql.parameters [ "@id", Sql.uuid churchId.Value ]
|> Sql.executeAsync mapToChurch
@ -173,8 +169,7 @@ module Members =
/// Count members for the given small group
let countByGroup (groupId : SmallGroupId) conn =
conn
|> Sql.existingConnection
Sql.existingConnection conn
|> Sql.query "SELECT COUNT(id) AS mbr_count FROM pt.member WHERE small_group_id = @groupId"
|> Sql.parameters [ "@groupId", Sql.uuid groupId.Value ]
|> Sql.executeRowAsync (fun row -> row.int "mbr_count")
@ -182,8 +177,7 @@ module Members =
/// Delete a small group member by its ID
let deleteById (memberId : MemberId) conn = backgroundTask {
let! _ =
conn
|> Sql.existingConnection
Sql.existingConnection conn
|> Sql.query "DELETE FROM pt.member WHERE id = @id"
|> Sql.parameters [ "@id", Sql.uuid memberId.Value ]
|> Sql.executeNonQueryAsync
@ -192,8 +186,7 @@ module Members =
/// Retrieve all members for a given small group
let forGroup (groupId : SmallGroupId) conn =
conn
|> Sql.existingConnection
Sql.existingConnection conn
|> Sql.query "SELECT * FROM pt.member WHERE small_group_id = @groupId ORDER BY member_name"
|> Sql.parameters [ "@groupId", Sql.uuid groupId.Value ]
|> Sql.executeAsync mapToMember
@ -201,8 +194,7 @@ module Members =
/// Save a small group member
let save (mbr : Member) conn = backgroundTask {
let! _ =
conn
|> Sql.existingConnection
Sql.existingConnection conn
|> Sql.query """
INSERT INTO pt.member (
id, small_group_id, member_name, email, email_format
@ -225,8 +217,7 @@ module Members =
/// Retrieve a small group member by its ID
let tryById (memberId : MemberId) conn = backgroundTask {
let! mbr =
conn
|> Sql.existingConnection
Sql.existingConnection conn
|> Sql.query "SELECT * FROM pt.member WHERE id = @id"
|> Sql.parameters [ "@id", Sql.uuid memberId.Value ]
|> Sql.executeAsync mapToMember
@ -259,8 +250,8 @@ module PrayerRequests =
/// Central place to append sort criteria for prayer request queries
let private orderBy sort =
match sort with
| SortByDate -> "DESC updated_date, DESC entered_date, requestor"
| SortByRequestor -> "requestor, DESC updated_date, DESC entered_date"
| SortByDate -> "updated_date DESC, entered_date DESC, requestor"
| SortByRequestor -> "requestor, updated_date DESC, entered_date DESC"
/// Paginate a prayer request query
let private paginate (pageNbr : int) pageSize =
@ -268,8 +259,7 @@ module PrayerRequests =
/// Count the number of prayer requests for a church
let countByChurch (churchId : ChurchId) conn =
conn
|> Sql.existingConnection
Sql.existingConnection conn
|> Sql.query """
SELECT COUNT(id) AS req_count
FROM pt.prayer_request
@ -279,8 +269,7 @@ module PrayerRequests =
/// Count the number of prayer requests for a small group
let countByGroup (groupId : SmallGroupId) conn =
conn
|> Sql.existingConnection
Sql.existingConnection conn
|> Sql.query "SELECT COUNT(id) AS req_count FROM pt.prayer_request WHERE small_group_id = @groupId"
|> Sql.parameters [ "@groupId", Sql.uuid groupId.Value ]
|> Sql.executeRowAsync (fun row -> row.int "req_count")
@ -288,8 +277,7 @@ module PrayerRequests =
/// Delete a prayer request by its ID
let deleteById (reqId : PrayerRequestId) conn = backgroundTask {
let! _ =
conn
|> Sql.existingConnection
Sql.existingConnection conn
|> Sql.query "DELETE FROM pt.prayer_request WHERE id = @id"
|> Sql.parameters [ "@id", Sql.uuid reqId.Value ]
|> Sql.executeNonQueryAsync
@ -306,7 +294,7 @@ module PrayerRequests =
(theDate.AtStartOfDayInZone(SmallGroup.timeZone opts.SmallGroup)
- Duration.FromDays opts.SmallGroup.Preferences.DaysToExpire)
.ToInstant ())
""" AND ( updatedDate > @asOf
""" AND ( updated_date > @asOf
OR expiration = @manual
OR request_type = @longTerm
OR request_type = @expecting)
@ -317,11 +305,10 @@ module PrayerRequests =
"@expecting", Sql.string (PrayerRequestType.toCode Expecting)
"@forced", Sql.string (Expiration.toCode Forced) ]
else "", []
conn
|> Sql.existingConnection
Sql.existingConnection conn
|> Sql.query $"""
SELECT *
FROM prayer_request
FROM pt.prayer_request
WHERE small_group_id = @groupId {where}
ORDER BY {orderBy opts.SmallGroup.Preferences.RequestSort}
{paginate opts.PageNumber opts.SmallGroup.Preferences.PageSize}"""
@ -331,8 +318,7 @@ module PrayerRequests =
/// Save a prayer request
let save (req : PrayerRequest) conn = backgroundTask {
let! _ =
conn
|> Sql.existingConnection
Sql.existingConnection conn
|> Sql.query """
INSERT into pt.prayer_request (
id, request_type, user_id, small_group_id, entered_date, updated_date, requestor, request_text,
@ -365,8 +351,7 @@ module PrayerRequests =
/// Search prayer requests for the given term
let searchForGroup group searchTerm pageNbr conn =
conn
|> Sql.existingConnection
Sql.existingConnection conn
|> Sql.query $"""
SELECT * FROM pt.prayer_request WHERE small_group_id = @groupId AND request_text ILIKE @search
UNION
@ -379,8 +364,7 @@ module PrayerRequests =
/// Retrieve a prayer request by its ID
let tryById (reqId : PrayerRequestId) conn = backgroundTask {
let! req =
conn
|> Sql.existingConnection
Sql.existingConnection conn
|> Sql.query "SELECT * FROM pt.prayer_request WHERE id = @id"
|> Sql.parameters [ "@id", Sql.uuid reqId.Value ]
|> Sql.executeAsync mapToPrayerRequest
@ -395,8 +379,7 @@ module PrayerRequests =
[ "@updated", Sql.parameter (NpgsqlParameter ("@updated", req.UpdatedDate)) ]
else "", []
let! _ =
conn
|> Sql.existingConnection
Sql.existingConnection conn
|> Sql.query $"UPDATE pt.prayer_request SET expiration = @expiration{sql} WHERE id = @id"
|> Sql.parameters
([ "@expiration", Sql.string (Expiration.toCode req.Expiration)
@ -412,8 +395,7 @@ module SmallGroups =
/// Count the number of small groups for a church
let countByChurch (churchId : ChurchId) conn =
conn
|> Sql.existingConnection
Sql.existingConnection conn
|> Sql.query "SELECT COUNT(id) AS group_count FROM pt.small_group WHERE church_id = @churchId"
|> Sql.parameters [ "@churchId", Sql.uuid churchId.Value ]
|> Sql.executeRowAsync (fun row -> row.int "group_count")
@ -422,8 +404,7 @@ module SmallGroups =
let deleteById (groupId : SmallGroupId) conn = backgroundTask {
let idParam = [ [ "@groupId", Sql.uuid groupId.Value ] ]
let! _ =
conn
|> Sql.existingConnection
Sql.existingConnection conn
|> Sql.executeTransactionAsync
[ "DELETE FROM pt.prayer_request WHERE small_group_id = @groupId", idParam
"DELETE FROM pt.user_small_group WHERE small_group_id = @groupId", idParam
@ -434,10 +415,9 @@ module SmallGroups =
/// Get information for all small groups
let infoForAll conn =
conn
|> Sql.existingConnection
Sql.existingConnection conn
|> Sql.query """
SELECT sg.id, c.church_name, lp.time_zone_id
SELECT sg.id, sg.group_name, c.church_name, lp.time_zone_id, lp.is_public
FROM pt.small_group sg
INNER JOIN pt.church c ON c.id = sg.church_id
INNER JOIN pt.list_preference lp ON lp.small_group_id = sg.id
@ -446,8 +426,7 @@ module SmallGroups =
/// Get a list of small group IDs along with a description that includes the church name
let listAll conn =
conn
|> Sql.existingConnection
Sql.existingConnection conn
|> Sql.query """
SELECT g.group_name, g.id, c.church_name
FROM pt.small_group g
@ -457,8 +436,7 @@ module SmallGroups =
/// Get a list of small group IDs and descriptions for groups with a group password
let listProtected conn =
conn
|> Sql.existingConnection
Sql.existingConnection conn
|> Sql.query """
SELECT g.group_name, g.id, c.church_name, lp.is_public
FROM pt.small_group g
@ -470,10 +448,9 @@ module SmallGroups =
/// Get a list of small group IDs and descriptions for groups that are public or have a group password
let listPublicAndProtected conn =
conn
|> Sql.existingConnection
Sql.existingConnection conn
|> Sql.query """
SELECT g.group_name, g.id, c.church_name, lp.is_public
SELECT g.group_name, g.id, c.church_name, lp.time_zone_id, lp.is_public
FROM pt.small_group g
INNER JOIN pt.church c ON c.id = g.church_id
INNER JOIN pt.list_preference lp ON lp.small_group_id = g.id
@ -485,8 +462,7 @@ module SmallGroups =
/// Log on for a small group (includes list preferences)
let logOn (groupId : SmallGroupId) password conn = backgroundTask {
let! group =
conn
|> Sql.existingConnection
Sql.existingConnection conn
|> Sql.query """
SELECT sg.*, lp.*
FROM pt.small_group sg
@ -501,8 +477,7 @@ module SmallGroups =
/// Save a small group
let save (group : SmallGroup) isNew conn = backgroundTask {
let! _ =
conn
|> Sql.existingConnection
Sql.existingConnection conn
|> Sql.executeTransactionAsync [
""" INSERT INTO pt.small_group (
id, church_id, group_name
@ -524,8 +499,7 @@ module SmallGroups =
/// Save a small group's list preferences
let savePreferences (pref : ListPreferences) conn = backgroundTask {
let! _ =
conn
|> Sql.existingConnection
Sql.existingConnection conn
|> Sql.query """
UPDATE pt.list_preference
SET days_to_keep_new = @daysToKeepNew,
@ -573,8 +547,7 @@ module SmallGroups =
/// Get a small group by its ID
let tryById (groupId : SmallGroupId) conn = backgroundTask {
let! group =
conn
|> Sql.existingConnection
Sql.existingConnection conn
|> Sql.query "SELECT * FROM pt.small_group WHERE id = @id"
|> Sql.parameters [ "@id", Sql.uuid groupId.Value ]
|> Sql.executeAsync mapToSmallGroup
@ -584,8 +557,7 @@ module SmallGroups =
/// Get a small group by its ID with its list preferences populated
let tryByIdWithPreferences (groupId : SmallGroupId) conn = backgroundTask {
let! group =
conn
|> Sql.existingConnection
Sql.existingConnection conn
|> Sql.query """
SELECT sg.*, lp.*
FROM pt.small_group sg
@ -602,15 +574,13 @@ module Users =
/// Retrieve all PrayerTracker users
let all conn =
conn
|> Sql.existingConnection
Sql.existingConnection conn
|> Sql.query "SELECT * FROM pt.pt_user ORDER BY last_name, first_name"
|> Sql.executeAsync mapToUser
/// Count the number of users for a church
let countByChurch (churchId : ChurchId) conn =
conn
|> Sql.existingConnection
Sql.existingConnection conn
|> Sql.query """
SELECT COUNT(u.id) AS user_count
FROM pt.pt_user u
@ -625,8 +595,7 @@ module Users =
/// Count the number of users for a small group
let countByGroup (groupId : SmallGroupId) conn =
conn
|> Sql.existingConnection
Sql.existingConnection conn
|> Sql.query "SELECT COUNT(user_id) AS user_count FROM pt.user_small_group WHERE small_group_id = @groupId"
|> Sql.parameters [ "@groupId", Sql.uuid groupId.Value ]
|> Sql.executeRowAsync (fun row -> row.int "user_count")
@ -634,8 +603,7 @@ module Users =
/// Delete a user by its database ID
let deleteById (userId : UserId) conn = backgroundTask {
let! _ =
conn
|> Sql.existingConnection
Sql.existingConnection conn
|> Sql.query "DELETE FROM pt.pt_user WHERE id = @id"
|> Sql.parameters [ "@id", Sql.uuid userId.Value ]
|> Sql.executeNonQueryAsync
@ -644,16 +612,14 @@ module Users =
/// Get the IDs of the small groups for which the given user is authorized
let groupIdsByUserId (userId : UserId) conn =
conn
|> Sql.existingConnection
Sql.existingConnection conn
|> Sql.query "SELECT small_group_id FROM pt.user_small_group WHERE user_id = @id"
|> Sql.parameters [ "@id", Sql.uuid userId.Value ]
|> Sql.executeAsync (fun row -> SmallGroupId (row.uuid "small_group_id"))
/// Get a list of users authorized to administer the given small group
let listByGroupId (groupId : SmallGroupId) conn =
conn
|> Sql.existingConnection
Sql.existingConnection conn
|> Sql.query """
SELECT u.*
FROM pt.pt_user u
@ -666,8 +632,7 @@ module Users =
/// Save a user's information
let save (user : User) conn = backgroundTask {
let! _ =
conn
|> Sql.existingConnection
Sql.existingConnection conn
|> Sql.query """
INSERT INTO pt.pt_user (
id, first_name, last_name, email, is_admin, password_hash
@ -694,8 +659,7 @@ module Users =
/// Find a user by its e-mail address and authorized small group
let tryByEmailAndGroup email (groupId : SmallGroupId) conn = backgroundTask {
let! user =
conn
|> Sql.existingConnection
Sql.existingConnection conn
|> Sql.query """
SELECT u.*
FROM pt.pt_user u
@ -709,8 +673,7 @@ module Users =
/// Find a user by their database ID
let tryById (userId : UserId) conn = backgroundTask {
let! user =
conn
|> Sql.existingConnection
Sql.existingConnection conn
|> Sql.query "SELECT * FROM pt.pt_user WHERE id = @id"
|> Sql.parameters [ "@id", Sql.uuid userId.Value ]
|> Sql.executeAsync mapToUser
@ -720,8 +683,7 @@ module Users =
/// Update a user's last seen date/time
let updateLastSeen (userId : UserId) (now : Instant) conn = backgroundTask {
let! _ =
conn
|> Sql.existingConnection
Sql.existingConnection conn
|> Sql.query "UPDATE pt.pt_user SET last_seen = @now WHERE id = @id"
|> Sql.parameters [ "@id", Sql.uuid userId.Value; "@now", Sql.parameter (NpgsqlParameter ("@now", now)) ]
|> Sql.executeNonQueryAsync
@ -731,8 +693,7 @@ module Users =
/// Update a user's password hash
let updatePassword (user : User) conn = backgroundTask {
let! _ =
conn
|> Sql.existingConnection
Sql.existingConnection conn
|> Sql.query "UPDATE pt.pt_user SET password_hash = @passwordHash WHERE id = @id"
|> Sql.parameters [ "@id", Sql.uuid user.Id.Value; "@passwordHash", Sql.string user.PasswordHash ]
|> Sql.executeNonQueryAsync
@ -757,8 +718,7 @@ module Users =
}
if not (Seq.isEmpty queries) then
let! _ =
conn
|> Sql.existingConnection
Sql.existingConnection conn
|> Sql.executeTransactionAsync (List.ofSeq queries)
()
}

43
src/PrayerTracker.UI/PrayerRequest.fs
View File

@ -111,6 +111,7 @@ let lists (groups : SmallGroupInfo list) viewInfo =
let l = I18N.forView "Requests/Lists"
use sw = new StringWriter ()
let raw = rawLocText sw
let vi = AppViewInfo.withScopedStyles [ "#groupList { grid-template-columns: repeat(3, auto); }" ] viewInfo
[ p [] [
raw l["The groups listed below have either public or password-protected request lists."]
space
@ -122,27 +123,31 @@ let lists (groups : SmallGroupInfo list) viewInfo =
| 0 -> p [] [ raw l["There are no groups with public or password-protected request lists."] ]
| count ->
tableSummary count s
table [ _class "pt-table pt-action-table" ] [
tableHeadings s [ "Actions"; "Church"; "Group" ]
groups
|> List.map (fun grp ->
tr [] [
if grp.IsPublic then
a [ _href $"/prayer-requests/{grp.Id}/list"; _title s["View"].Value ] [ icon "list" ]
else
a [ _href $"/small-group/log-on/{grp.Id}"; _title s["Log On"].Value ] [
icon "verified_user"
]
|> List.singleton
|> td []
td [] [ str grp.ChurchName ]
td [] [ str grp.Name ]
])
|> tbody []
section [ _id "groupList"; _class "pt-table"; _ariaLabel "Small group list" ] [
div [ _class "row head" ] [
header [ _class "cell" ] [ locStr s["Actions"] ]
header [ _class "cell" ] [ locStr s["Church"] ]
header [ _class "cell" ] [ locStr s["Group"] ]
]
for group in groups do
div [ _class "row" ] [
div [ _class "cell actions" ] [
if group.IsPublic then
a [ _href $"/prayer-requests/{group.Id}/list"; _title s["View"].Value ] [
iconSized 18 "list"
]
else
a [ _href $"/small-group/log-on/{group.Id}"; _title s["Log On"].Value ] [
iconSized 18 "verified_user"
]
]
div [ _class "cell" ] [ str group.ChurchName ]
div [ _class "cell" ] [ str group.Name ]
]
]
]
|> Layout.Content.standard
|> Layout.standard viewInfo "Request Lists"
|> Layout.standard vi "Request Lists"
/// View for the prayer request maintenance page
@ -256,7 +261,7 @@ let maintain (model : MaintainRequests) (ctx : HttpContext) viewInfo =
br []
a [ _href "/prayer-requests/inactive" ] [ raw l["Show Inactive Requests"] ]
| _ ->
if defaultArg model.OnlyActive false then
if Option.isSome model.OnlyActive then
raw l["Inactive requests are currently shown"]
br []
a [ _href "/prayer-requests" ] [ raw l["Do Not Show Inactive Requests"] ]

2
src/PrayerTracker.UI/SmallGroup.fs
View File

@ -203,7 +203,7 @@ let maintain (groups : SmallGroupInfo list) ctx viewInfo =
]
a [ _href delAction
_title s["Delete This Group"].Value
_hxDelete delAction
_hxPost delAction
_hxConfirm delPrompt ] [
iconSized 18 "delete_forever"
]

33
src/PrayerTracker/App.fs
View File

@ -41,6 +41,7 @@ module Configure =
open Microsoft.Extensions.DependencyInjection
open NeoSmart.Caching.Sqlite
open NodaTime
open Npgsql
/// Configure ASP.NET Core's service collection (dependency injection container)
let services (svc : IServiceCollection) =
@ -67,6 +68,13 @@ module Configure =
let _ = svc.AddAntiforgery ()
let _ = svc.AddRouting ()
let _ = svc.AddSingleton<IClock> SystemClock.Instance
let _ =
svc.AddScoped<NpgsqlConnection>(fun sp ->
let cfg = sp.GetService<IConfiguration> ()
let conn = new NpgsqlConnection (cfg.GetConnectionString "PrayerTracker")
conn.OpenAsync () |> Async.AwaitTask |> Async.RunSynchronously
conn)
let _ = NpgsqlConnection.GlobalTypeMapper.UseNodaTime ()
()
open Giraffe
@ -215,39 +223,28 @@ module App =
use conn = new NpgsqlConnection (config.GetConnectionString "PrayerTracker")
do! conn.OpenAsync ()
let! v1Users =
conn
|> Sql.existingConnection
Sql.existingConnection conn
|> Sql.query "SELECT id, password_hash FROM pt.pt_user WHERE salt IS NULL"
|> Sql.executeAsync (fun row -> UserId (row.uuid "id"), row.string "password_hash")
for userId, oldHash in v1Users do
let pw =
[| 254uy
yield! (Encoding.UTF8.GetBytes oldHash)
|]
|> Convert.ToBase64String
let pw = Convert.ToBase64String [| 254uy; yield! (Encoding.UTF8.GetBytes oldHash) |]
let! _ =
conn
|> Sql.existingConnection
Sql.existingConnection conn
|> Sql.query "UPDATE pt.pt_user SET password_hash = @hash WHERE id = @id"
|> Sql.parameters [ "@id", Sql.uuid userId.Value; "@hash", Sql.string pw ]
|> Sql.executeNonQueryAsync
()
printfn $"Updated {v1Users.Length} users with version 1 password"
let! v2Users =
conn
|> Sql.existingConnection
Sql.existingConnection conn
|> Sql.query "SELECT id, password_hash, salt FROM pt.pt_user WHERE salt IS NOT NULL"
|> Sql.executeAsync (fun row -> UserId (row.uuid "id"), row.string "password_hash", row.uuid "salt")
for userId, oldHash, salt in v2Users do
let pw =
[| 255uy
yield! (salt.ToByteArray ())
yield! (Encoding.UTF8.GetBytes oldHash)
|]
|> Convert.ToBase64String
Convert.ToBase64String
[| 255uy; yield! (salt.ToByteArray ()); yield! (Encoding.UTF8.GetBytes oldHash) |]
let! _ =
conn
|> Sql.existingConnection
Sql.existingConnection conn
|> Sql.query "UPDATE pt.pt_user SET password_hash = @hash WHERE id = @id"
|> Sql.parameters [ "@id", Sql.uuid userId.Value; "@hash", Sql.string pw ]
|> Sql.executeNonQueryAsync

24
src/PrayerTracker/Church.fs
View File

@ -17,16 +17,15 @@ let private findStats churchId conn = task {
/// POST /church/[church-id]/delete
let delete chId : HttpHandler = requireAccess [ Admin ] >=> validateCsrf >=> fun next ctx -> task {
let churchId = ChurchId chId
use! conn = ctx.Conn
let churchId = ChurchId chId
let conn = ctx.Conn
match! Churches.tryById churchId conn with
| Some church ->
let! _, stats = findStats churchId conn
do! Churches.deleteById churchId conn
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)",
church.Name, stats.SmallGroups, stats.PrayerRequests, stats.Users]
ctx.Strings["The church {0} and its {1} small groups (with {2} prayer request(s)) were deleted successfully; revoked access from {3} user(s)",
church.Name, stats.SmallGroups, stats.PrayerRequests, stats.Users]
return! redirectTo false "/churches" next ctx
| None -> return! fourOhFour ctx
}
@ -41,8 +40,7 @@ let edit churchId : HttpHandler = requireAccess [ Admin ] >=> fun next ctx -> ta
|> Views.Church.edit EditChurch.empty ctx
|> renderHtml next ctx
else
use! conn = ctx.Conn
match! Churches.tryById (ChurchId churchId) conn with
match! Churches.tryById (ChurchId churchId) ctx.Conn with
| Some church ->
return!
viewInfo ctx
@ -53,7 +51,7 @@ let edit churchId : HttpHandler = requireAccess [ Admin ] >=> fun next ctx -> ta
/// GET /churches
let maintain : HttpHandler = requireAccess [ Admin ] >=> fun next ctx -> task {
let! conn = ctx.Conn
let conn = ctx.Conn
let! churches = Churches.all conn
let stats = churches |> List.map (fun c -> findStats c.Id conn |> Async.AwaitTask |> Async.RunSynchronously)
return!
@ -66,16 +64,14 @@ let maintain : HttpHandler = requireAccess [ Admin ] >=> fun next ctx -> task {
let save : HttpHandler = requireAccess [ Admin ] >=> validateCsrf >=> fun next ctx -> task {
match! ctx.TryBindFormAsync<EditChurch> () with
| Ok model ->
let! conn = ctx.Conn
let! church =
if model.IsNew then Task.FromResult (Some { Church.empty with Id = (Guid.NewGuid >> ChurchId) () })
else Churches.tryById (idFromShort ChurchId model.ChurchId) conn
else Churches.tryById (idFromShort ChurchId model.ChurchId) ctx.Conn
match church with
| Some ch ->
do! Churches.save (model.PopulateChurch ch) conn
let s = Views.I18N.localizer.Force ()
let act = s[if model.IsNew then "Added" else "Updated"].Value.ToLower ()
addInfo ctx s["Successfully {0} church “{1}”", act, model.Name]
do! Churches.save (model.PopulateChurch ch) ctx.Conn
let act = ctx.Strings[if model.IsNew then "Added" else "Updated"].Value.ToLower ()
addInfo ctx ctx.Strings["Successfully {0} church “{1}”", act, model.Name]
return! redirectTo false "/churches" next ctx
| None -> return! fourOhFour ctx
| Result.Error e -> return! bindError e next ctx

20
src/PrayerTracker/CommonFunctions.fs
View File

@ -6,13 +6,13 @@ open Microsoft.AspNetCore.Mvc.Rendering
/// Create a select list from an enumeration
let toSelectList<'T> valFunc textFunc withDefault emptyText (items : 'T seq) =
match items with null -> nullArg "items" | _ -> ()
[ match withDefault with
| true ->
let s = PrayerTracker.Views.I18N.localizer.Force ()
yield SelectListItem ($"""&mdash; %A{s[emptyText]} &mdash;""", "")
| _ -> ()
yield! items |> Seq.map (fun x -> SelectListItem (textFunc x, valFunc x))
if isNull items then nullArg (nameof items)
[ match withDefault with
| true ->
let s = PrayerTracker.Views.I18N.localizer.Force ()
SelectListItem ($"""&mdash; %A{s[emptyText]} &mdash;""", "")
| _ -> ()
yield! items |> Seq.map (fun x -> SelectListItem (textFunc x, valFunc x))
]
/// Create a select list from an enumeration
@ -151,8 +151,7 @@ let requireAccess levels : HttpHandler = fun next ctx -> task {
| _, Some _ when List.contains Group levels -> return! next ctx
| Some u, _ when List.contains Admin levels && u.IsAdmin -> return! next ctx
| _, _ when List.contains Admin levels ->
let s = Views.I18N.localizer.Force ()
addError ctx s["You are not authorized to view the requested page."]
addError ctx ctx.Strings["You are not authorized to view the requested page."]
return! redirectTo false "/unauthorized" next ctx
| _, _ when List.contains User levels ->
// Redirect to the user log on page
@ -162,7 +161,6 @@ let requireAccess levels : HttpHandler = fun next ctx -> task {
// Redirect to the small group log on page
return! redirectTo false "/small-group/log-on" next ctx
| _, _ ->
let s = Views.I18N.localizer.Force ()
addError ctx s["You are not authorized to view the requested page."]
addError ctx ctx.Strings["You are not authorized to view the requested page."]
return! redirectTo false "/unauthorized" next ctx
}

15
src/PrayerTracker/Extensions.fs
View File

@ -86,9 +86,7 @@ type HttpContext with
})
/// The PostgreSQL connection (configured via DI)
member this.Conn = backgroundTask {
return! this.LazyConn.Force ()
}
member this.Conn = this.GetService<NpgsqlConnection> ()
/// The system clock (via DI)
member this.Clock = this.GetService<IClock> ()
@ -96,6 +94,9 @@ type HttpContext with
/// The current instant
member this.Now = this.Clock.GetCurrentInstant ()
/// The common string localizer
member this.Strings = Views.I18N.localizer.Force ()
/// The currently logged on small group (sets the value in the session if it is missing)
member this.CurrentGroup () = task {
match this.Session.CurrentGroup with
@ -103,8 +104,7 @@ type HttpContext with
| None ->
match this.User.SmallGroupId with
| Some groupId ->
let! conn = this.Conn
match! SmallGroups.tryByIdWithPreferences groupId conn with
match! SmallGroups.tryByIdWithPreferences groupId this.Conn with
| Some group ->
this.Session.CurrentGroup <- Some group
return Some group
@ -119,11 +119,10 @@ type HttpContext with
| None ->
match this.User.UserId with
| Some userId ->
let! conn = this.Conn
match! Users.tryById userId conn with
match! Users.tryById userId this.Conn with
| Some user ->
// Set last seen for user
do! Users.updateLastSeen userId this.Now conn
do! Users.updateLastSeen userId this.Now this.Conn
this.Session.CurrentUser <- Some user
return Some user
| None -> return None

3
src/PrayerTracker/Home.fs
View File

@ -61,8 +61,7 @@ open Microsoft.AspNetCore.Authentication.Cookies
let logOff : HttpHandler = requireAccess [ AccessLevel.Public ] >=> fun next ctx -> task {
ctx.Session.Clear ()
do! ctx.SignOutAsync CookieAuthenticationDefaults.AuthenticationScheme
let s = Views.I18N.localizer.Force ()
addHtmlInfo ctx s["Log Off Successful • Have a nice day!"]
addHtmlInfo ctx ctx.Strings["Log Off Successful • Have a nice day!"]
return! redirectTo false "/" next ctx
}

60
src/PrayerTracker/PrayerRequest.fs
View File

@ -9,12 +9,10 @@ open PrayerTracker.ViewModels
/// Retrieve a prayer request, and ensure that it belongs to the current class
let private findRequest (ctx : HttpContext) reqId = task {
let! conn = ctx.Conn
match! PrayerRequests.tryById reqId conn with
match! PrayerRequests.tryById reqId ctx.Conn with
| Some req when req.SmallGroupId = ctx.Session.CurrentGroup.Value.Id -> 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"]
addError ctx ctx.Strings["The prayer request you tried to access is not assigned to your group"]
return Result.Error (redirectTo false "/unauthorized" earlyReturn ctx)
| None -> return Result.Error (fourOhFour ctx)
}
@ -23,7 +21,6 @@ let private findRequest (ctx : HttpContext) reqId = task {
let private generateRequestList (ctx : HttpContext) date = task {
let group = ctx.Session.CurrentGroup.Value
let listDate = match date with Some d -> d | None -> SmallGroup.localDateNow ctx.Clock group
let! conn = ctx.Conn
let! reqs =
PrayerRequests.forGroup
{ SmallGroup = group
@ -31,7 +28,7 @@ let private generateRequestList (ctx : HttpContext) date = task {
ListDate = Some listDate
ActiveOnly = true
PageNumber = 0
} conn
} ctx.Conn
return
{ Requests = reqs
Date = listDate
@ -65,7 +62,7 @@ let edit reqId : HttpHandler = requireAccess [ User ] >=> fun next ctx -> task {
else
match! findRequest ctx requestId with
| Ok req ->
let s = Views.I18N.localizer.Force ()
let s = ctx.Strings
if PrayerRequest.isExpired now group req then
{ UserMessage.warning with
Text = htmlLocString s["This request is expired."]
@ -84,12 +81,11 @@ let edit reqId : HttpHandler = requireAccess [ User ] >=> fun next ctx -> task {
/// GET /prayer-requests/email/[date]
let email date : HttpHandler = requireAccess [ User ] >=> fun next ctx -> task {
let s = Views.I18N.localizer.Force ()
let s = ctx.Strings
let listDate = parseListDate (Some date)
let group = ctx.Session.CurrentGroup.Value
let! list = generateRequestList ctx listDate
let! conn = ctx.Conn
let! recipients = Members.forGroup group.Id conn
let group = ctx.Session.CurrentGroup.Value
let! recipients = Members.forGroup group.Id ctx.Conn
use! client = Email.getConnection ()
do! Email.sendEmails
{ Client = client
@ -111,10 +107,8 @@ let delete reqId : HttpHandler = requireAccess [ User ] >=> validateCsrf >=> fun
let requestId = PrayerRequestId reqId
match! findRequest ctx requestId with
| Ok req ->
let s = Views.I18N.localizer.Force ()
let! conn = ctx.Conn
do! PrayerRequests.deleteById req.Id conn
addInfo ctx s["The prayer request was deleted successfully"]
do! PrayerRequests.deleteById req.Id ctx.Conn
addInfo ctx ctx.Strings["The prayer request was deleted successfully"]
return! redirectTo false "/prayer-requests" next ctx
| Result.Error e -> return! e
}
@ -124,18 +118,15 @@ let expire reqId : HttpHandler = requireAccess [ User ] >=> fun next ctx -> task
let requestId = PrayerRequestId reqId
match! findRequest ctx requestId with
| Ok req ->
let s = Views.I18N.localizer.Force ()
let! conn = ctx.Conn
do! PrayerRequests.updateExpiration { req with Expiration = Forced } false conn
addInfo ctx s["Successfully {0} prayer request", s["Expired"].Value.ToLower ()]
do! PrayerRequests.updateExpiration { req with Expiration = Forced } false ctx.Conn
addInfo ctx ctx.Strings["Successfully {0} prayer request", ctx.Strings["Expired"].Value.ToLower ()]
return! redirectTo false "/prayer-requests" next ctx
| Result.Error e -> return! e
}
/// GET /prayer-requests/[group-id]/list
let list groupId : HttpHandler = requireAccess [ AccessLevel.Public ] >=> fun next ctx -> task {
let! conn = ctx.Conn
match! SmallGroups.tryByIdWithPreferences groupId conn with
match! SmallGroups.tryByIdWithPreferences groupId ctx.Conn with
| Some group when group.Preferences.IsPublic ->
let! reqs =
PrayerRequests.forGroup
@ -144,7 +135,7 @@ let list groupId : HttpHandler = requireAccess [ AccessLevel.Public ] >=> fun ne
ListDate = None
ActiveOnly = true
PageNumber = 0
} conn
} ctx.Conn
return!
viewInfo ctx
|> Views.PrayerRequest.list
@ -157,16 +148,14 @@ let list groupId : HttpHandler = requireAccess [ AccessLevel.Public ] >=> fun ne
}
|> renderHtml next ctx
| Some _ ->
let s = Views.I18N.localizer.Force ()
addError ctx s["The request list for the group you tried to view is not public."]
addError ctx ctx.Strings["The request list for the group you tried to view is not public."]
return! redirectTo false "/unauthorized" next ctx
| None -> return! fourOhFour ctx
}
/// GET /prayer-requests/lists
let lists : HttpHandler = requireAccess [ AccessLevel.Public ] >=> fun next ctx -> task {
let! conn = ctx.Conn
let! groups = SmallGroups.listPublicAndProtected conn
let! groups = SmallGroups.listPublicAndProtected ctx.Conn
return!
viewInfo ctx
|> Views.PrayerRequest.lists groups
@ -183,10 +172,9 @@ let maintain onlyActive : HttpHandler = requireAccess [ User ] >=> fun next ctx
| Ok pg -> match Int32.TryParse pg with true, p -> p | false, _ -> 1
| Result.Error _ -> 1
let! model = backgroundTask {
let! conn = ctx.Conn
match ctx.GetQueryStringValue "search" with
| Ok search ->
let! reqs = PrayerRequests.searchForGroup group search pageNbr conn
let! reqs = PrayerRequests.searchForGroup group search pageNbr ctx.Conn
return
{ MaintainRequests.empty with
Requests = reqs
@ -201,7 +189,7 @@ let maintain onlyActive : HttpHandler = requireAccess [ User ] >=> fun next ctx
ListDate = None
ActiveOnly = onlyActive
PageNumber = pageNbr
} conn
} ctx.Conn
return
{ MaintainRequests.empty with
Requests = reqs
@ -228,10 +216,8 @@ let restore reqId : HttpHandler = requireAccess [ User ] >=> fun next ctx -> tas
let requestId = PrayerRequestId reqId
match! findRequest ctx requestId with
| Ok req ->
let s = Views.I18N.localizer.Force ()
let! conn = ctx.Conn
do! PrayerRequests.updateExpiration { req with Expiration = Automatic; UpdatedDate = ctx.Now } true conn
addInfo ctx s["Successfully {0} prayer request", s["Restored"].Value.ToLower ()]
do! PrayerRequests.updateExpiration { req with Expiration = Automatic; UpdatedDate = ctx.Now } true ctx.Conn
addInfo ctx ctx.Strings["Successfully {0} prayer request", ctx.Strings["Restored"].Value.ToLower ()]
return! redirectTo false "/prayer-requests" next ctx
| Result.Error e -> return! e
}
@ -243,7 +229,6 @@ let save : HttpHandler = requireAccess [ User ] >=> validateCsrf >=> fun next ct
match! ctx.TryBindFormAsync<EditRequest> () with
| Ok model ->
let group = ctx.Session.CurrentGroup.Value
let! conn = ctx.Conn
let! req =
if model.IsNew then
{ PrayerRequest.empty with
@ -252,7 +237,7 @@ let save : HttpHandler = requireAccess [ User ] >=> validateCsrf >=> fun next ct
UserId = ctx.User.UserId.Value
}
|> (Some >> Task.FromResult)
else PrayerRequests.tryById (idFromShort PrayerRequestId model.RequestId) conn
else PrayerRequests.tryById (idFromShort PrayerRequestId model.RequestId) ctx.Conn
match req with
| Some pr when pr.SmallGroupId = group.Id ->
let now = SmallGroup.localDateNow ctx.Clock group
@ -272,10 +257,9 @@ let save : HttpHandler = requireAccess [ User ] >=> validateCsrf >=> fun next ct
{ it with EnteredDate = dt; UpdatedDate = dt }
| it when defaultArg model.SkipDateUpdate false -> it
| it -> { it with UpdatedDate = ctx.Now }
do! PrayerRequests.save updated conn
let s = Views.I18N.localizer.Force ()
do! PrayerRequests.save updated ctx.Conn
let act = if model.IsNew then "Added" else "Updated"
addInfo ctx s["Successfully {0} prayer request", s[act].Value.ToLower ()]
addInfo ctx ctx.Strings["Successfully {0} prayer request", ctx.Strings[act].Value.ToLower ()]
return! redirectTo false "/prayer-requests" next ctx
| Some _
| None -> return! fourOhFour ctx

97
src/PrayerTracker/SmallGroup.fs
View File

@ -15,31 +15,28 @@ let announcement : HttpHandler = requireAccess [ User ] >=> fun next ctx ->
/// POST /small-group/[group-id]/delete
let delete grpId : HttpHandler = requireAccess [ Admin ] >=> validateCsrf >=> fun next ctx -> task {
let s = Views.I18N.localizer.Force ()
let groupId = SmallGroupId grpId
let! conn = ctx.Conn
let groupId = SmallGroupId grpId
let conn = ctx.Conn
match! SmallGroups.tryById groupId conn with
| Some grp ->
let! reqs = PrayerRequests.countByGroup groupId conn
let! users = Users.countByGroup groupId conn
do! SmallGroups.deleteById groupId conn
addInfo ctx
s["The group {0} and its {1} prayer request(s) were deleted successfully; revoked access from {2} user(s)",
grp.Name, reqs, users]
ctx.Strings["The group {0} and its {1} prayer request(s) were deleted successfully; revoked access from {2} user(s)",
grp.Name, reqs, users]
return! redirectTo false "/small-groups" next ctx
| None -> return! fourOhFour ctx
}
/// POST /small-group/member/[member-id]/delete
let deleteMember mbrId : HttpHandler = requireAccess [ User ] >=> validateCsrf >=> fun next ctx -> task {
let s = Views.I18N.localizer.Force ()
let group = ctx.Session.CurrentGroup.Value
let memberId = MemberId mbrId
let! conn = ctx.Conn
match! Members.tryById memberId conn with
let group = ctx.Session.CurrentGroup.Value
let memberId = MemberId mbrId
match! Members.tryById memberId ctx.Conn with
| Some mbr when mbr.SmallGroupId = group.Id ->
do! Members.deleteById memberId conn
addHtmlInfo ctx s["The group member &ldquo;{0}&rdquo; was deleted successfully", mbr.Name]
do! Members.deleteById memberId ctx.Conn
addHtmlInfo ctx ctx.Strings["The group member &ldquo;{0}&rdquo; was deleted successfully", mbr.Name]
return! redirectTo false "/small-group/members" next ctx
| Some _
| None -> return! fourOhFour ctx
@ -47,8 +44,7 @@ let deleteMember mbrId : HttpHandler = requireAccess [ User ] >=> validateCsrf >
/// GET /small-group/[group-id]/edit
let edit grpId : HttpHandler = requireAccess [ Admin ] >=> fun next ctx -> task {
let! conn = ctx.Conn
let! churches = Churches.all conn
let! churches = Churches.all ctx.Conn
let groupId = SmallGroupId grpId
if groupId.Value = Guid.Empty then
return!
@ -56,7 +52,7 @@ let edit grpId : HttpHandler = requireAccess [ Admin ] >=> fun next ctx -> task
|> Views.SmallGroup.edit EditSmallGroup.empty churches ctx
|> renderHtml next ctx
else
match! SmallGroups.tryById groupId conn with
match! SmallGroups.tryById groupId ctx.Conn with
| Some grp ->
return!
viewInfo ctx
@ -67,9 +63,8 @@ let edit grpId : HttpHandler = requireAccess [ Admin ] >=> fun next ctx -> task
/// GET /small-group/member/[member-id]/edit
let editMember mbrId : HttpHandler = requireAccess [ User ] >=> fun next ctx -> task {
let s = Views.I18N.localizer.Force ()
let group = ctx.Session.CurrentGroup.Value
let types = ReferenceList.emailTypeList group.Preferences.DefaultEmailType s
let types = ReferenceList.emailTypeList group.Preferences.DefaultEmailType ctx.Strings
let memberId = MemberId mbrId
if memberId.Value = Guid.Empty then
return!
@ -77,8 +72,7 @@ let editMember mbrId : HttpHandler = requireAccess [ User ] >=> fun next ctx ->
|> Views.SmallGroup.editMember EditMember.empty types ctx
|> renderHtml next ctx
else
let! conn = ctx.Conn
match! Members.tryById memberId conn with
match! Members.tryById memberId ctx.Conn with
| Some mbr when mbr.SmallGroupId = group.Id ->
return!
viewInfo ctx
@ -90,8 +84,7 @@ let editMember mbrId : HttpHandler = requireAccess [ User ] >=> fun next ctx ->
/// GET /small-group/log-on/[group-id?]
let logOn grpId : HttpHandler = requireAccess [ AccessLevel.Public ] >=> fun next ctx -> task {
let! conn = ctx.Conn
let! groups = SmallGroups.listProtected conn
let! groups = SmallGroups.listProtected ctx.Conn
let groupId = match grpId with Some gid -> shortGuid gid | None -> ""
return!
{ viewInfo ctx with HelpLink = Some Help.logOn }
@ -107,9 +100,7 @@ open Microsoft.AspNetCore.Authentication.Cookies
let logOnSubmit : HttpHandler = requireAccess [ AccessLevel.Public ] >=> validateCsrf >=> fun next ctx -> task {
match! ctx.TryBindFormAsync<GroupLogOn> () with
| Ok model ->
let s = Views.I18N.localizer.Force ()
let! conn = ctx.Conn
match! SmallGroups.logOn (idFromShort SmallGroupId model.SmallGroupId) model.Password conn with
match! SmallGroups.logOn (idFromShort SmallGroupId model.SmallGroupId) model.Password ctx.Conn with
| Some group ->
ctx.Session.CurrentGroup <- Some group
let identity = ClaimsIdentity (
@ -120,18 +111,17 @@ let logOnSubmit : HttpHandler = requireAccess [ AccessLevel.Public ] >=> validat
AuthenticationProperties (
IssuedUtc = DateTimeOffset.UtcNow,
IsPersistent = defaultArg model.RememberMe false))
addInfo ctx s["Log On Successful • Welcome to {0}", s["PrayerTracker"]]
addInfo ctx ctx.Strings["Log On Successful • Welcome to {0}", ctx.Strings["PrayerTracker"]]
return! redirectTo false "/prayer-requests/view" next ctx
| None ->
addError ctx s["Password incorrect - login unsuccessful"]
addError ctx ctx.Strings["Password incorrect - login unsuccessful"]
return! redirectTo false $"/small-group/log-on/{model.SmallGroupId}" next ctx
| Result.Error e -> return! bindError e next ctx
}
/// GET /small-groups
let maintain : HttpHandler = requireAccess [ Admin ] >=> fun next ctx -> task {
let! conn = ctx.Conn
let! groups = SmallGroups.infoForAll conn
let! groups = SmallGroups.infoForAll ctx.Conn
return!
viewInfo ctx
|> Views.SmallGroup.maintain groups ctx
@ -141,10 +131,8 @@ let maintain : HttpHandler = requireAccess [ Admin ] >=> fun next ctx -> task {
/// GET /small-group/members
let members : HttpHandler = requireAccess [ User ] >=> fun next ctx -> task {
let group = ctx.Session.CurrentGroup.Value
let s = Views.I18N.localizer.Force ()
let! conn = ctx.Conn
let! members = Members.forGroup group.Id conn
let types = ReferenceList.emailTypeList group.Preferences.DefaultEmailType s |> Map.ofSeq
let! members = Members.forGroup group.Id ctx.Conn
let types = ReferenceList.emailTypeList group.Preferences.DefaultEmailType ctx.Strings |> Map.ofSeq
return!
{ viewInfo ctx with HelpLink = Some Help.maintainGroupMembers }
|> Views.SmallGroup.members members types ctx
@ -154,7 +142,7 @@ let members : HttpHandler = requireAccess [ User ] >=> fun next ctx -> task {
/// GET /small-group
let overview : HttpHandler = requireAccess [ User ] >=> fun next ctx -> task {
let group = ctx.Session.CurrentGroup.Value
let! conn = ctx.Conn
let conn = ctx.Conn
let! reqs = PrayerRequests.forGroup
{ SmallGroup = group
Clock = ctx.Clock
@ -199,16 +187,14 @@ open System.Threading.Tasks
let save : HttpHandler = requireAccess [ Admin ] >=> validateCsrf >=> fun next ctx -> task {
match! ctx.TryBindFormAsync<EditSmallGroup> () with
| Ok model ->
let s = Views.I18N.localizer.Force ()
let! conn = ctx.Conn
let! tryGroup =
if model.IsNew then Task.FromResult (Some { SmallGroup.empty with Id = (Guid.NewGuid >> SmallGroupId) () })
else SmallGroups.tryById (idFromShort SmallGroupId model.SmallGroupId) conn
else SmallGroups.tryById (idFromShort SmallGroupId model.SmallGroupId) ctx.Conn
match tryGroup with
| Some group ->
do! SmallGroups.save (model.populateGroup group) model.IsNew conn
let act = s[if model.IsNew then "Added" else "Updated"].Value.ToLower ()
addHtmlInfo ctx s["Successfully {0} group “{1}”", act, model.Name]
do! SmallGroups.save (model.populateGroup group) model.IsNew ctx.Conn
let act = ctx.Strings[if model.IsNew then "Added" else "Updated"].Value.ToLower ()
addHtmlInfo ctx ctx.Strings["Successfully {0} group “{1}”", act, model.Name]
return! redirectTo false "/small-groups" next ctx
| None -> return! fourOhFour ctx
| Result.Error e -> return! bindError e next ctx
@ -219,11 +205,10 @@ let saveMember : HttpHandler = requireAccess [ User ] >=> validateCsrf >=> fun n
match! ctx.TryBindFormAsync<EditMember> () with
| Ok model ->
let group = ctx.Session.CurrentGroup.Value
let! conn = ctx.Conn
let! tryMbr =
if model.IsNew then
Task.FromResult (Some { Member.empty with Id = (Guid.NewGuid >> MemberId) (); SmallGroupId = group.Id })
else Members.tryById (idFromShort MemberId model.MemberId) conn
else Members.tryById (idFromShort MemberId model.MemberId) ctx.Conn
match tryMbr with
| Some mbr when mbr.SmallGroupId = group.Id ->
do! Members.save
@ -231,10 +216,9 @@ let saveMember : HttpHandler = requireAccess [ User ] >=> validateCsrf >=> fun n
Name = model.Name
Email = model.Email
Format = String.noneIfBlank model.Format |> Option.map EmailFormat.fromCode
} conn
let s = Views.I18N.localizer.Force ()
let act = s[if model.IsNew then "Added" else "Updated"].Value.ToLower ()
addInfo ctx s["Successfully {0} group member", act]
} ctx.Conn
let act = ctx.Strings[if model.IsNew then "Added" else "Updated"].Value.ToLower ()
addInfo ctx ctx.Strings["Successfully {0} group member", act]
return! redirectTo false "/small-group/members" next ctx
| Some _
| None -> return! fourOhFour ctx
@ -249,15 +233,13 @@ let savePreferences : HttpHandler = requireAccess [ User ] >=> validateCsrf >=>
// 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 group = ctx.Session.CurrentGroup.Value
let! conn = ctx.Conn
match! SmallGroups.tryByIdWithPreferences group.Id conn with
| Some grp ->
let pref = model.PopulatePreferences grp.Preferences
do! SmallGroups.savePreferences pref conn
match! SmallGroups.tryByIdWithPreferences group.Id ctx.Conn with
| Some group ->
let pref = model.PopulatePreferences group.Preferences
do! SmallGroups.savePreferences pref ctx.Conn
// Refresh session instance
ctx.Session.CurrentGroup <- Some { grp with Preferences = pref }
let s = Views.I18N.localizer.Force ()
addInfo ctx s["Group preferences updated successfully"]
ctx.Session.CurrentGroup <- Some { group with Preferences = pref }
addInfo ctx ctx.Strings["Group preferences updated successfully"]
return! redirectTo false "/small-group/preferences" next ctx
| None -> return! fourOhFour ctx
| Result.Error e -> return! bindError e next ctx
@ -274,7 +256,7 @@ let sendAnnouncement : HttpHandler = requireAccess [ User ] >=> validateCsrf >=>
let pref = group.Preferences
let usr = ctx.Session.CurrentUser.Value
let now = SmallGroup.localTimeNow ctx.Clock group
let s = Views.I18N.localizer.Force ()
let s = ctx.Strings
// Reformat the text to use the class's font stylings
let requestText = ckEditorToText model.Text
let htmlText =
@ -282,12 +264,11 @@ let sendAnnouncement : HttpHandler = requireAccess [ User ] >=> validateCsrf >=>
|> renderHtmlNode
let plainText = (htmlToPlainText >> wordWrap 74) htmlText
// Send the e-mails
let! conn = ctx.Conn
let! recipients = task {
if model.SendToClass = "N" && usr.IsAdmin then
let! users = Users.all conn
let! users = Users.all ctx.Conn
return users |> List.map (fun u -> { Member.empty with Name = u.Name; Email = u.Email })
else return! Members.forGroup group.Id conn
else return! Members.forGroup group.Id ctx.Conn
}
use! client = Email.getConnection ()
do! Email.sendEmails
@ -316,7 +297,7 @@ let sendAnnouncement : HttpHandler = requireAccess [ User ] >=> validateCsrf >=>
Text = requestText
EnteredDate = now.Date.AtStartOfDayInZone(zone).ToInstant()
UpdatedDate = now.InZoneLeniently(zone).ToInstant()
} conn
} ctx.Conn
// Tell 'em what they've won, Johnny!
let toWhom =
if model.SendToClass = "N" then s["{0} users", s["PrayerTracker"]].Value

72
src/PrayerTracker/User.fs
View File

@ -78,12 +78,10 @@ let sanitizeUrl providedUrl defaultUrl =
let changePassword : HttpHandler = requireAccess [ User ] >=> validateCsrf >=> fun next ctx -> task {
match! ctx.TryBindFormAsync<ChangePassword> () with
| Ok model ->
let s = Views.I18N.localizer.Force ()
let curUsr = ctx.Session.CurrentUser.Value
let hasher = PrayerTrackerPasswordHasher ()
let! conn = ctx.Conn
let! user = task {
match! Users.tryById curUsr.Id conn with
match! Users.tryById curUsr.Id ctx.Conn with
| Some usr ->
if hasher.VerifyHashedPassword (usr, usr.PasswordHash, model.OldPassword)
= PasswordVerificationResult.Success then
@ -93,27 +91,25 @@ let changePassword : HttpHandler = requireAccess [ User ] >=> validateCsrf >=> f
}
match user with
| Some usr when model.NewPassword = model.NewPasswordConfirm ->
do! Users.updatePassword { usr with PasswordHash = hasher.HashPassword (usr, model.NewPassword) } conn
addInfo ctx s["Your password was changed successfully"]
do! Users.updatePassword { usr with PasswordHash = hasher.HashPassword (usr, model.NewPassword) } ctx.Conn
addInfo ctx ctx.Strings["Your password was changed successfully"]
return! redirectTo false "/" next ctx
| Some _ ->
addError ctx s["The new passwords did not match - your password was NOT changed"]
addError ctx ctx.Strings["The new passwords did not match - your password was NOT changed"]
return! redirectTo false "/user/password" next ctx
| None ->
addError ctx s["The old password was incorrect - your password was NOT changed"]
addError ctx ctx.Strings["The old password was incorrect - your password was NOT changed"]
return! redirectTo false "/user/password" next ctx
| Result.Error e -> return! bindError e next ctx
}
/// POST /user/[user-id]/delete
let delete usrId : HttpHandler = requireAccess [ Admin ] >=> validateCsrf >=> fun next ctx -> task {
let userId = UserId usrId
let! conn = ctx.Conn
match! Users.tryById userId conn with
let userId = UserId usrId
match! Users.tryById userId ctx.Conn with
| Some user ->
do! Users.deleteById userId conn
let s = Views.I18N.localizer.Force ()
addInfo ctx s["Successfully deleted user {0}", user.Name]
do! Users.deleteById userId ctx.Conn
addInfo ctx ctx.Strings["Successfully deleted user {0}", user.Name]
return! redirectTo false "/users" next ctx
| _ -> return! fourOhFour ctx
}
@ -128,11 +124,10 @@ open Microsoft.AspNetCore.Html
let doLogOn : HttpHandler = requireAccess [ AccessLevel.Public ] >=> validateCsrf >=> fun next ctx -> task {
match! ctx.TryBindFormAsync<UserLogOn> () with
| Ok model ->
let s = Views.I18N.localizer.Force ()
let! conn = ctx.Conn
match! findUserByPassword model conn with
let s = ctx.Strings
match! findUserByPassword model ctx.Conn with
| Some user ->
match! SmallGroups.tryByIdWithPreferences (idFromShort SmallGroupId model.SmallGroupId) conn with
match! SmallGroups.tryByIdWithPreferences (idFromShort SmallGroupId model.SmallGroupId) ctx.Conn with
| Some group ->
ctx.Session.CurrentUser <- Some user
ctx.Session.CurrentGroup <- Some group
@ -146,7 +141,7 @@ let doLogOn : HttpHandler = requireAccess [ AccessLevel.Public ] >=> validateCsr
AuthenticationProperties (
IssuedUtc = DateTimeOffset.UtcNow,
IsPersistent = defaultArg model.RememberMe false))
do! Users.updateLastSeen user.Id ctx.Now conn
do! Users.updateLastSeen user.Id ctx.Now ctx.Conn
addHtmlInfo ctx s["Log On Successful • Welcome to {0}", s["PrayerTracker"]]
return! redirectTo false (sanitizeUrl model.RedirectUrl "/small-group") next ctx
| None -> return! fourOhFour ctx
@ -177,8 +172,7 @@ let edit usrId : HttpHandler = requireAccess [ Admin ] >=> fun next ctx -> task
|> Views.User.edit EditUser.empty ctx
|> renderHtml next ctx
else
let! conn = ctx.Conn
match! Users.tryById userId conn with
match! Users.tryById userId ctx.Conn with
| Some user ->
return!
viewInfo ctx
@ -189,14 +183,12 @@ let edit usrId : HttpHandler = requireAccess [ Admin ] >=> fun next ctx -> task
/// GET /user/log-on
let logOn : HttpHandler = requireAccess [ AccessLevel.Public ] >=> fun next ctx -> task {
let s = Views.I18N.localizer.Force ()
let! conn = ctx.Conn
let! groups = SmallGroups.listAll conn
let! groups = SmallGroups.listAll ctx.Conn
let url = Option.ofObj <| ctx.Session.GetString Key.Session.redirectUrl
match url with
| Some _ ->
ctx.Session.Remove Key.Session.redirectUrl
addWarning ctx s["The page you requested requires authentication; please log on below."]
addWarning ctx ctx.Strings["The page you requested requires authentication; please log on below."]
| None -> ()
return!
{ viewInfo ctx with HelpLink = Some Help.logOn }
@ -206,8 +198,7 @@ let logOn : HttpHandler = requireAccess [ AccessLevel.Public ] >=> fun next ctx
/// GET /users
let maintain : HttpHandler = requireAccess [ Admin ] >=> fun next ctx -> task {
let! conn = ctx.Conn
let! users = Users.all conn
let! users = Users.all ctx.Conn
return!
viewInfo ctx
|> Views.User.maintain users ctx
@ -226,23 +217,23 @@ open System.Threading.Tasks
let save : HttpHandler = requireAccess [ Admin ] >=> validateCsrf >=> fun next ctx -> task {
match! ctx.TryBindFormAsync<EditUser> () with
| Ok model ->
let! conn = ctx.Conn
let! user =
if model.IsNew then Task.FromResult (Some { User.empty with Id = (Guid.NewGuid >> UserId) () })
else Users.tryById (idFromShort UserId model.UserId) conn
else Users.tryById (idFromShort UserId model.UserId) ctx.Conn
match user with
| Some usr ->
let hasher = PrayerTrackerPasswordHasher ()
let updatedUser = model.PopulateUser usr (fun pw -> hasher.HashPassword (usr, pw))
do! Users.save updatedUser conn
let s = Views.I18N.localizer.Force ()
do! Users.save updatedUser ctx.Conn
let s = ctx.Strings
if model.IsNew then
let h = CommonFunctions.htmlString
{ 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", updatedUser.Name]
|> Some
h s["Please select at least one group for which this user ({0}) is authorized",
updatedUser.Name]
|> Some
}
|> addUserMessage ctx
return! redirectTo false $"/user/{shortGuid usr.Id.Value}/small-groups" next ctx
@ -257,28 +248,25 @@ let save : HttpHandler = requireAccess [ Admin ] >=> validateCsrf >=> fun next c
let saveGroups : HttpHandler = requireAccess [ Admin ] >=> validateCsrf >=> fun next ctx -> task {
match! ctx.TryBindFormAsync<AssignGroups> () with
| Ok model ->
let s = Views.I18N.localizer.Force ()
match Seq.length model.SmallGroups with
| 0 ->
addError ctx s["You must select at least one group to assign"]
addError ctx ctx.Strings["You must select at least one group to assign"]
return! redirectTo false $"/user/{model.UserId}/small-groups" next ctx
| _ ->
let! conn = ctx.Conn
do! Users.updateSmallGroups (idFromShort UserId model.UserId)
(model.SmallGroups.Split ',' |> Array.map (idFromShort SmallGroupId) |> List.ofArray) conn
addInfo ctx s["Successfully updated group permissions for {0}", model.UserName]
(model.SmallGroups.Split ',' |> Array.map (idFromShort SmallGroupId) |> List.ofArray) ctx.Conn
addInfo ctx ctx.Strings["Successfully updated group permissions for {0}", model.UserName]
return! redirectTo false "/users" next ctx
| Result.Error e -> return! bindError e next ctx
}
/// GET /user/[user-id]/small-groups
let smallGroups usrId : HttpHandler = requireAccess [ Admin ] >=> fun next ctx -> task {
let! conn = ctx.Conn
let userId = UserId usrId
match! Users.tryById userId conn with
let userId = UserId usrId
match! Users.tryById userId ctx.Conn with
| Some user ->
let! groups = SmallGroups.listAll conn
let! groupIds = Users.groupIdsByUserId userId conn
let! groups = SmallGroups.listAll ctx.Conn
let! groupIds = Users.groupIdsByUserId userId ctx.Conn
let curGroups = groupIds |> List.map (fun g -> shortGuid g.Value)
return!
viewInfo ctx

1
src/PrayerTracker/wwwroot/css/app.css
View File

@ -156,6 +156,7 @@ input[type=text],
input[type=password],
input[type=date],
input[type=number],
input[type=url],
select {
border-radius: .2rem;
border-color: var(--lighter-dark);

10
src/names-to-lower.sql
View File

@ -76,13 +76,9 @@ ALTER TABLE pt."SmallGroup" RENAME TO small_group;
ALTER INDEX pt."IX_SmallGroup_ChurchId" RENAME TO ix_small_group_church_id;
-- Time Zone
ALTER TABLE pt."TimeZone" RENAME COLUMN "TimeZoneId" TO id;
ALTER TABLE pt."TimeZone" RENAME COLUMN "Description" TO description;
ALTER TABLE pt."TimeZone" RENAME COLUMN "SortOrder" TO sort_order;
ALTER TABLE pt."TimeZone" RENAME COLUMN "IsActive" TO is_active;
ALTER TABLE pt."TimeZone" RENAME CONSTRAINT "PK_TimeZone" TO pk_time_zone;
ALTER TABLE pt."TimeZone" RENAME TO time_zone;
-- Time Zone (goes away)
ALTER TABLE pt.list_preference DROP CONSTRAINT fk_list_preference_time_zone_id;
DROP TABLE pt."TimeZone";
-- User
ALTER TABLE pt."User" RENAME COLUMN "UserId" TO id;