WIP on SQL migration

- Restructure to eliminate time zone table
This commit is contained in:
Daniel J. Summers 2022-08-13 22:35:48 -04:00
parent 29ff0afc6c
commit 42976da1bd
8 changed files with 297 additions and 91 deletions

View File

@ -86,6 +86,7 @@ module private Helpers =
Name = row.string "group_name" Name = row.string "group_name"
ChurchName = row.string "church_name" ChurchName = row.string "church_name"
TimeZoneId = TimeZoneId (row.string "time_zone_id") TimeZoneId = TimeZoneId (row.string "time_zone_id")
IsPublic = row.bool "is_public"
} }
/// Map a row to a Small Group list item /// Map a row to a Small Group list item
@ -207,6 +208,30 @@ module Members =
|> Sql.parameters [ "@groupId", Sql.uuid groupId.Value ] |> Sql.parameters [ "@groupId", Sql.uuid groupId.Value ]
|> Sql.executeAsync mapToMember |> Sql.executeAsync mapToMember
/// Save a small group member
let save (mbr : Member) conn = backgroundTask {
let! _ =
conn
|> Sql.existingConnection
|> Sql.query """
INSERT INTO pt.member (
id, small_group_id, member_name, email, email_format
) VALUES (
@id, @groupId, @name, @email, @format
) ON CONFLICT (id) DO UPDATE
SET member_name = EXCLUDED.member_name,
email = EXCLUDED.email,
email_format = EXCLUDED.email_format"""
|> Sql.parameters
[ "@id", Sql.uuid mbr.Id.Value
"@groupId", Sql.uuid mbr.SmallGroupId.Value
"@name", Sql.string mbr.Name
"@email", Sql.string mbr.Email
"@format", Sql.stringOrNone (mbr.Format |> Option.map EmailFormat.toCode) ]
|> Sql.executeNonQueryAsync
return ()
}
/// Retrieve a small group member by its ID /// Retrieve a small group member by its ID
let tryById (memberId : MemberId) conn = backgroundTask { let tryById (memberId : MemberId) conn = backgroundTask {
let! mbr = let! mbr =
@ -270,6 +295,17 @@ module PrayerRequests =
|> Sql.parameters [ "@groupId", Sql.uuid groupId.Value ] |> Sql.parameters [ "@groupId", Sql.uuid groupId.Value ]
|> Sql.executeRowAsync (fun row -> row.int "req_count") |> Sql.executeRowAsync (fun row -> row.int "req_count")
/// Delete a prayer request by its ID
let deleteById (reqId : PrayerRequestId) conn = backgroundTask {
let! _ =
conn
|> Sql.existingConnection
|> Sql.query "DELETE FROM pt.prayer_request WHERE id = @id"
|> Sql.parameters [ "@id", Sql.uuid reqId.Value ]
|> Sql.executeNonQueryAsync
return ()
}
/// Get all (or active) requests for a small group as of now or the specified date /// Get all (or active) requests for a small group as of now or the specified date
let forGroup (opts : PrayerRequestOptions) conn = let forGroup (opts : PrayerRequestOptions) conn =
let theDate = defaultArg opts.ListDate (SmallGroup.localDateNow opts.Clock opts.SmallGroup) let theDate = defaultArg opts.ListDate (SmallGroup.localDateNow opts.Clock opts.SmallGroup)
@ -302,6 +338,65 @@ module PrayerRequests =
|> Sql.parameters (("@groupId", Sql.uuid opts.SmallGroup.Id.Value) :: parameters) |> Sql.parameters (("@groupId", Sql.uuid opts.SmallGroup.Id.Value) :: parameters)
|> Sql.executeAsync mapToPrayerRequest |> Sql.executeAsync mapToPrayerRequest
/// Save a prayer request
let save (req : PrayerRequest) conn = backgroundTask {
let! _ =
conn
|> Sql.existingConnection
|> Sql.query """
INSERT into pt.prayer_request (
id, request_type, user_id, small_group_id, entered_date, updated_date, requestor, request_text,
notify_chaplain, expiration
) VALUES (
@id, @type, @userId, @groupId, @entered, @updated, @requestor, @text,
@notifyChaplain, @expiration
) ON CONFLICT (id) DO UPDATE
SET request_type = EXCLUDED.request_type,
updated_date = EXCLUDED.updated_date,
requestor = EXCLUDED.requestor,
request_text = EXCLUDED.request_text,
notify_chaplain = EXCLUDED.notify_chaplain,
expiration = EXCLUDED.expiration"""
|> Sql.parameters
[ "@id", Sql.uuid req.Id.Value
"@type", Sql.string (PrayerRequestType.toCode req.RequestType)
"@userId", Sql.uuid req.UserId.Value
"@groupId", Sql.uuid req.SmallGroupId.Value
"@entered", Sql.parameter (NpgsqlParameter ("@entered", req.EnteredDate))
"@updated", Sql.parameter (NpgsqlParameter ("@updated", req.UpdatedDate))
"@requestor", Sql.stringOrNone req.Requestor
"@text", Sql.string req.Text
"@notifyChaplain", Sql.bool req.NotifyChaplain
"@expiration", Sql.string (Expiration.toCode req.Expiration)
]
|> Sql.executeNonQueryAsync
return ()
}
/// Retrieve a prayer request by its ID
let tryById (reqId : PrayerRequestId) conn = backgroundTask {
let! req =
conn
|> Sql.existingConnection
|> Sql.query "SELECT * FROM pt.prayer_request WHERE id = @id"
|> Sql.parameters [ "@id", Sql.uuid reqId.Value ]
|> Sql.executeAsync mapToPrayerRequest
return List.tryHead req
}
/// Update the expiration for the given prayer request
let updateExpiration (req : PrayerRequest) conn = backgroundTask {
let! _ =
conn
|> Sql.existingConnection
|> Sql.query "UPDATE pt.prayer_request SET expiration = @expiration WHERE id = @id"
|> Sql.parameters
[ "@expiration", Sql.string (Expiration.toCode req.Expiration)
"@id", Sql.uuid req.Id.Value ]
|> Sql.executeNonQueryAsync
return ()
}
/// Functions to retrieve small group information /// Functions to retrieve small group information
module SmallGroups = module SmallGroups =
@ -356,7 +451,7 @@ module SmallGroups =
conn conn
|> Sql.existingConnection |> Sql.existingConnection
|> Sql.query """ |> Sql.query """
SELECT g.group_name, g.id, c.church_name SELECT g.group_name, g.id, c.church_name, lp.is_public
FROM pt.small_group g FROM pt.small_group g
INNER JOIN pt.church c ON c.id = g.church_id INNER JOIN pt.church c ON c.id = g.church_id
INNER JOIN pt.list_preference lp ON lp.small_group_id = g.id INNER JOIN pt.list_preference lp ON lp.small_group_id = g.id
@ -364,6 +459,20 @@ module SmallGroups =
ORDER BY c.church_name, g.group_name""" ORDER BY c.church_name, g.group_name"""
|> Sql.executeAsync mapToSmallGroupItem |> Sql.executeAsync mapToSmallGroupItem
/// 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.query """
SELECT g.group_name, g.id, c.church_name, 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
WHERE lp.is_public = TRUE
OR COALESCE(lp.group_password, '') <> ''
ORDER BY c.church_name, g.group_name"""
|> Sql.executeAsync mapToSmallGroupInfo
/// Log on for a small group (includes list preferences) /// Log on for a small group (includes list preferences)
let logOn (groupId : SmallGroupId) password conn = backgroundTask { let logOn (groupId : SmallGroupId) password conn = backgroundTask {
let! group = let! group =
@ -380,6 +489,78 @@ module SmallGroups =
return List.tryHead group return List.tryHead group
} }
/// Save a small group
let save (group : SmallGroup) isNew conn = backgroundTask {
let! _ =
conn
|> Sql.existingConnection
|> Sql.executeTransactionAsync [
""" INSERT INTO pt.small_group (
id, church_id, group_name
) VALUES (
@id, @churchId, @name
) ON CONFLICT (id) DO UPDATE
SET church_id = EXCLUDED.church_id,
group_name = EXCLUDED.group_name""",
[ [ "@id", Sql.uuid group.Id.Value
"@churchId", Sql.uuid group.ChurchId.Value
"@name", Sql.string group.Name ] ]
if isNew then
"INSERT INTO pt.list_preference (small_group_id) VALUES (@id)",
[ [ "@id", Sql.uuid group.Id.Value ] ]
]
return ()
}
/// Save a small group's list preferences
let savePreferences (pref : ListPreferences) conn = backgroundTask {
let! _ =
conn
|> Sql.existingConnection
|> Sql.query """
UPDATE pt.list_preference
SET days_to_keep_new = @daysToKeepNew,
days_to_expire = @daysToExpire,
long_term_update_weeks = @longTermUpdateWeeks,
email_from_name = @emailFromName,
email_from_address = @emailFromAddress,
fonts = @fonts,
heading_color = @headingColor,
line_color = @lineColor,
heading_font_size = @headingFontSize,
text_font_size = @textFontSize,
request_sort = @requestSort,
group_password = @groupPassword,
default_email_type = @defaultEmailType,
is_public = @isPublic,
time_zone_id = @timeZoneId,
page_size = @pageSize,
as_of_date_display = @asOfDateDisplay
WHERE small_group_id = @groupId"""
|> Sql.parameters
[ "@groupId", Sql.uuid pref.SmallGroupId.Value
"@daysToKeepNew", Sql.int pref.DaysToKeepNew
"@daysToExpire", Sql.int pref.DaysToExpire
"@longTermUpdateWeeks", Sql.int pref.LongTermUpdateWeeks
"@emailFromName", Sql.string pref.EmailFromName
"@emailFromAddress", Sql.string pref.EmailFromAddress
"@fonts", Sql.string pref.Fonts
"@headingColor", Sql.string pref.HeadingColor
"@lineColor", Sql.string pref.LineColor
"@headingFontSize", Sql.int pref.HeadingFontSize
"@textFontSize", Sql.int pref.TextFontSize
"@requestSort", Sql.string (RequestSort.toCode pref.RequestSort)
"@groupPassword", Sql.string pref.GroupPassword
"@defaultEmailType", Sql.string (EmailFormat.toCode pref.DefaultEmailType)
"@isPublic", Sql.bool pref.IsPublic
"@timeZoneId", Sql.string (TimeZoneId.toString pref.TimeZoneId)
"@pageSize", Sql.int pref.PageSize
"@asOfDateDisplay", Sql.string (AsOfDateDisplay.toCode pref.AsOfDateDisplay)
]
|> Sql.executeNonQueryAsync
return ()
}
/// Get a small group by its ID /// Get a small group by its ID
let tryById (groupId : SmallGroupId) conn = backgroundTask { let tryById (groupId : SmallGroupId) conn = backgroundTask {
let! group = let! group =

View File

@ -958,7 +958,7 @@ module PrayerRequest =
>= req.UpdatedDate.InZone(SmallGroup.timeZone group).Date >= req.UpdatedDate.InZone(SmallGroup.timeZone group).Date
/// Information needed to display the small group maintenance page /// Information needed to display the public/protected request list and small group maintenance pages
[<NoComparison; NoEquality>] [<NoComparison; NoEquality>]
type SmallGroupInfo = type SmallGroupInfo =
{ /// The ID of the small group { /// The ID of the small group
@ -972,4 +972,7 @@ type SmallGroupInfo =
/// The ID of the time zone for the small group /// The ID of the time zone for the small group
TimeZoneId : TimeZoneId TimeZoneId : TimeZoneId
/// Whether the small group has a publicly-available request list
IsPublic : bool
} }

View File

@ -156,25 +156,28 @@ let renderHtmlString = renderHtmlNode >> HtmlString
/// Utility methods to help with time zones (and localization of their names) /// Utility methods to help with time zones (and localization of their names)
module TimeZones = module TimeZones =
open System.Collections.Generic
open PrayerTracker.Entities open PrayerTracker.Entities
/// Cross-reference between time zone Ids and their English names /// Cross-reference between time zone Ids and their English names
let private xref = let private xref = [
[ "America/Chicago", "Central" TimeZoneId "America/Chicago", "Central"
"America/Denver", "Mountain" TimeZoneId "America/Denver", "Mountain"
"America/Los_Angeles", "Pacific" TimeZoneId "America/Los_Angeles", "Pacific"
"America/New_York", "Eastern" TimeZoneId "America/New_York", "Eastern"
"America/Phoenix", "Mountain (Arizona)" TimeZoneId "America/Phoenix", "Mountain (Arizona)"
"Europe/Berlin", "Central European" TimeZoneId "Europe/Berlin", "Central European"
] ]
|> Map.ofList
/// Get the name of a time zone, given its Id /// Get the name of a time zone, given its Id
let name timeZoneId (s : IStringLocalizer) = let name timeZoneId (s : IStringLocalizer) =
match xref |> List.tryFind (fun it -> fst it = timeZoneId) with
| Some tz -> s[snd tz]
| None ->
let tzId = TimeZoneId.toString timeZoneId let tzId = TimeZoneId.toString timeZoneId
try s[xref[tzId]] LocalizedString (tzId, tzId)
with :? KeyNotFoundException -> LocalizedString (tzId, tzId)
/// All known time zones in their defined order
let all = xref |> List.map fst
open Giraffe.ViewEngine.Htmx open Giraffe.ViewEngine.Htmx

View File

@ -106,7 +106,7 @@ let list (model : RequestList) viewInfo =
/// View for the prayer request lists page /// View for the prayer request lists page
let lists (groups : SmallGroup list) viewInfo = let lists (groups : SmallGroupInfo list) viewInfo =
let s = I18N.localizer.Force () let s = I18N.localizer.Force ()
let l = I18N.forView "Requests/Lists" let l = I18N.forView "Requests/Lists"
use sw = new StringWriter () use sw = new StringWriter ()
@ -126,17 +126,16 @@ let lists (groups : SmallGroup list) viewInfo =
tableHeadings s [ "Actions"; "Church"; "Group" ] tableHeadings s [ "Actions"; "Church"; "Group" ]
groups groups
|> List.map (fun grp -> |> List.map (fun grp ->
let grpId = shortGuid grp.Id.Value
tr [] [ tr [] [
if grp.Preferences.IsPublic then if grp.IsPublic then
a [ _href $"/prayer-requests/{grpId}/list"; _title s["View"].Value ] [ icon "list" ] a [ _href $"/prayer-requests/{grp.Id}/list"; _title s["View"].Value ] [ icon "list" ]
else else
a [ _href $"/small-group/log-on/{grpId}"; _title s["Log On"].Value ] [ a [ _href $"/small-group/log-on/{grp.Id}"; _title s["Log On"].Value ] [
icon "verified_user" icon "verified_user"
] ]
|> List.singleton |> List.singleton
|> td [] |> td []
td [] [ str grp.Church.Name ] td [] [ str grp.ChurchName ]
td [] [ str grp.Name ] td [] [ str grp.Name ]
]) ])
|> tbody [] |> tbody []

View File

@ -351,7 +351,7 @@ let overview model viewInfo =
open System.IO open System.IO
/// View for the small group preferences page /// View for the small group preferences page
let preferences (model : EditPreferences) (tzs : TimeZone list) ctx viewInfo = let preferences (model : EditPreferences) ctx viewInfo =
let s = I18N.localizer.Force () let s = I18N.localizer.Force ()
let l = I18N.forView "SmallGroup/Preferences" let l = I18N.forView "SmallGroup/Preferences"
use sw = new StringWriter () use sw = new StringWriter ()
@ -518,9 +518,8 @@ let preferences (model : EditPreferences) (tzs : TimeZone list) ctx viewInfo =
seq { seq {
"", selectDefault s["Select"].Value "", selectDefault s["Select"].Value
yield! yield!
tzs TimeZones.all
|> List.map (fun tz -> |> List.map (fun tz -> TimeZoneId.toString tz, (TimeZones.name tz s).Value)
TimeZoneId.toString tz.Id, (TimeZones.name tz.Id s).Value)
} }
|> selectList (nameof model.TimeZone) model.TimeZone [ _required ] |> selectList (nameof model.TimeZone) model.TimeZone [ _required ]
] ]

View File

@ -33,6 +33,13 @@ module String =
| -1 -> haystack | -1 -> haystack
| idx -> String.concat "" [ haystack[0..idx - 1]; replacement; haystack[idx + needle.Length..] ] | idx -> String.concat "" [ haystack[0..idx - 1]; replacement; haystack[idx + needle.Length..] ]
/// Convert a string to an option, with null, blank, and whitespace becoming None
let noneIfBlank (str : string) =
match str with
| null -> None
| it when it.Trim () = "" -> None
| it -> Some it
open System.Text.RegularExpressions open System.Text.RegularExpressions

View File

@ -3,12 +3,14 @@
open Giraffe open Giraffe
open Microsoft.AspNetCore.Http open Microsoft.AspNetCore.Http
open PrayerTracker open PrayerTracker
open PrayerTracker.Data
open PrayerTracker.Entities open PrayerTracker.Entities
open PrayerTracker.ViewModels open PrayerTracker.ViewModels
/// 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 = task { let private findRequest (ctx : HttpContext) reqId = task {
match! ctx.Db.TryRequestById reqId with let! conn = ctx.Conn
match! PrayerRequests.tryById reqId conn with
| Some req when req.SmallGroupId = ctx.Session.CurrentGroup.Value.Id -> return Ok req | Some req when req.SmallGroupId = ctx.Session.CurrentGroup.Value.Id -> return Ok req
| Some _ -> | Some _ ->
let s = Views.I18N.localizer.Force () let s = Views.I18N.localizer.Force ()
@ -21,7 +23,15 @@ let private findRequest (ctx : HttpContext) reqId = task {
let private generateRequestList (ctx : HttpContext) date = task { let private generateRequestList (ctx : HttpContext) date = task {
let group = ctx.Session.CurrentGroup.Value let group = ctx.Session.CurrentGroup.Value
let listDate = match date with Some d -> d | None -> SmallGroup.localDateNow ctx.Clock group let listDate = match date with Some d -> d | None -> SmallGroup.localDateNow ctx.Clock group
let! reqs = ctx.Db.AllRequestsForSmallGroup group ctx.Clock (Some listDate) true 0 let! conn = ctx.Conn
let! reqs =
PrayerRequests.forGroup
{ SmallGroup = group
Clock = ctx.Clock
ListDate = Some listDate
ActiveOnly = true
PageNumber = 0
} conn
return return
{ Requests = reqs { Requests = reqs
Date = listDate Date = listDate
@ -78,7 +88,8 @@ let email date : HttpHandler = requireAccess [ User ] >=> fun next ctx -> task {
let listDate = parseListDate (Some date) let listDate = parseListDate (Some date)
let group = ctx.Session.CurrentGroup.Value let group = ctx.Session.CurrentGroup.Value
let! list = generateRequestList ctx listDate let! list = generateRequestList ctx listDate
let! recipients = ctx.Db.AllMembersForSmallGroup group.Id let! conn = ctx.Conn
let! recipients = Members.forGroup group.Id conn
use! client = Email.getConnection () use! client = Email.getConnection ()
do! Email.sendEmails do! Email.sendEmails
{ Client = client { Client = client
@ -101,8 +112,8 @@ let delete reqId : HttpHandler = requireAccess [ User ] >=> validateCsrf >=> fun
match! findRequest ctx requestId with match! findRequest ctx requestId with
| Ok req -> | Ok req ->
let s = Views.I18N.localizer.Force () let s = Views.I18N.localizer.Force ()
ctx.Db.PrayerRequests.Remove req |> ignore let! conn = ctx.Conn
let! _ = ctx.Db.SaveChangesAsync () do! PrayerRequests.deleteById req.Id conn
addInfo ctx s["The prayer request was deleted successfully"] addInfo ctx s["The prayer request was deleted successfully"]
return! redirectTo false "/prayer-requests" next ctx return! redirectTo false "/prayer-requests" next ctx
| Result.Error e -> return! e | Result.Error e -> return! e
@ -114,8 +125,8 @@ let expire reqId : HttpHandler = requireAccess [ User ] >=> fun next ctx -> task
match! findRequest ctx requestId with match! findRequest ctx requestId with
| Ok req -> | Ok req ->
let s = Views.I18N.localizer.Force () let s = Views.I18N.localizer.Force ()
ctx.Db.UpdateEntry { req with Expiration = Forced } let! conn = ctx.Conn
let! _ = ctx.Db.SaveChangesAsync () do! PrayerRequests.updateExpiration { req with Expiration = Forced } conn
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 "/prayer-requests" next ctx return! redirectTo false "/prayer-requests" next ctx
| Result.Error e -> return! e | Result.Error e -> return! e
@ -123,9 +134,17 @@ let expire reqId : HttpHandler = requireAccess [ User ] >=> fun next ctx -> task
/// GET /prayer-requests/[group-id]/list /// GET /prayer-requests/[group-id]/list
let list groupId : HttpHandler = requireAccess [ AccessLevel.Public ] >=> fun next ctx -> task { let list groupId : HttpHandler = requireAccess [ AccessLevel.Public ] >=> fun next ctx -> task {
match! ctx.Db.TryGroupById groupId with let! conn = ctx.Conn
match! SmallGroups.tryByIdWithPreferences groupId conn with
| Some group when group.Preferences.IsPublic -> | Some group when group.Preferences.IsPublic ->
let! reqs = ctx.Db.AllRequestsForSmallGroup group ctx.Clock None true 0 let! reqs =
PrayerRequests.forGroup
{ SmallGroup = group
Clock = ctx.Clock
ListDate = None
ActiveOnly = true
PageNumber = 0
} conn
return! return!
viewInfo ctx viewInfo ctx
|> Views.PrayerRequest.list |> Views.PrayerRequest.list
@ -146,7 +165,8 @@ let list groupId : HttpHandler = requireAccess [ AccessLevel.Public ] >=> fun ne
/// GET /prayer-requests/lists /// GET /prayer-requests/lists
let lists : HttpHandler = requireAccess [ AccessLevel.Public ] >=> fun next ctx -> task { let lists : HttpHandler = requireAccess [ AccessLevel.Public ] >=> fun next ctx -> task {
let! groups = ctx.Db.PublicAndProtectedGroups () let! conn = ctx.Conn
let! groups = SmallGroups.listPublicAndProtected conn
return! return!
viewInfo ctx viewInfo ctx
|> Views.PrayerRequest.lists groups |> Views.PrayerRequest.lists groups
@ -157,6 +177,7 @@ let lists : HttpHandler = requireAccess [ AccessLevel.Public ] >=> fun next ctx
/// - OR - /// - OR -
/// GET /prayer-requests?search=[search-query] /// GET /prayer-requests?search=[search-query]
let maintain onlyActive : HttpHandler = requireAccess [ User ] >=> fun next ctx -> task { let maintain onlyActive : HttpHandler = requireAccess [ User ] >=> fun next ctx -> task {
// TODO: stopped here
let group = ctx.Session.CurrentGroup.Value let group = ctx.Session.CurrentGroup.Value
let pageNbr = let pageNbr =
match ctx.GetQueryStringValue "page" with match ctx.GetQueryStringValue "page" with

View File

@ -174,7 +174,8 @@ let overview : HttpHandler = requireAccess [ User ] >=> fun next ctx -> task {
|> Seq.ofList |> Seq.ofList
|> Seq.map (fun req -> req.RequestType) |> Seq.map (fun req -> req.RequestType)
|> Seq.distinct |> Seq.distinct
|> Seq.map (fun reqType -> reqType, reqs |> List.filter (fun r -> r.RequestType = reqType) |> List.length) |> Seq.map (fun reqType ->
reqType, reqs |> List.filter (fun r -> r.RequestType = reqType) |> List.length)
|> Map.ofSeq) |> Map.ofSeq)
Admins = admins Admins = admins
} }
@ -186,12 +187,9 @@ let overview : HttpHandler = requireAccess [ User ] >=> fun next ctx -> task {
/// GET /small-group/preferences /// GET /small-group/preferences
let preferences : HttpHandler = requireAccess [ User ] >=> fun next ctx -> task { let preferences : HttpHandler = requireAccess [ User ] >=> fun next ctx -> task {
// TODO: stopped here
let group = ctx.Session.CurrentGroup.Value
let! tzs = ctx.Db.AllTimeZones ()
return! return!
{ viewInfo ctx with HelpLink = Some Help.groupPreferences } { viewInfo ctx with HelpLink = Some Help.groupPreferences }
|> Views.SmallGroup.preferences (EditPreferences.fromPreferences group.Preferences) tzs ctx |> Views.SmallGroup.preferences (EditPreferences.fromPreferences ctx.Session.CurrentGroup.Value.Preferences) ctx
|> renderHtml next ctx |> renderHtml next ctx
} }
@ -202,18 +200,13 @@ let save : HttpHandler = requireAccess [ Admin ] >=> validateCsrf >=> fun next c
match! ctx.TryBindFormAsync<EditSmallGroup> () with match! ctx.TryBindFormAsync<EditSmallGroup> () with
| Ok model -> | Ok model ->
let s = Views.I18N.localizer.Force () let s = Views.I18N.localizer.Force ()
let! group = let! conn = ctx.Conn
let! tryGroup =
if model.IsNew then Task.FromResult (Some { SmallGroup.empty with Id = (Guid.NewGuid >> SmallGroupId) () }) if model.IsNew then Task.FromResult (Some { SmallGroup.empty with Id = (Guid.NewGuid >> SmallGroupId) () })
else ctx.Db.TryGroupById (idFromShort SmallGroupId model.SmallGroupId) else SmallGroups.tryById (idFromShort SmallGroupId model.SmallGroupId) conn
match group with match tryGroup with
| Some grp -> | Some group ->
model.populateGroup grp do! SmallGroups.save (model.populateGroup group) model.IsNew conn
|> function
| grp when model.IsNew ->
ctx.Db.AddEntry grp
ctx.Db.AddEntry { grp.Preferences with SmallGroupId = grp.Id }
| grp -> ctx.Db.UpdateEntry grp
let! _ = ctx.Db.SaveChangesAsync ()
let act = s[if model.IsNew then "Added" else "Updated"].Value.ToLower () let act = s[if model.IsNew then "Added" else "Updated"].Value.ToLower ()
addHtmlInfo ctx s["Successfully {0} group “{1}”", act, model.Name] addHtmlInfo ctx s["Successfully {0} group “{1}”", act, model.Name]
return! redirectTo false "/small-groups" next ctx return! redirectTo false "/small-groups" next ctx
@ -226,19 +219,19 @@ let saveMember : HttpHandler = requireAccess [ User ] >=> validateCsrf >=> fun n
match! ctx.TryBindFormAsync<EditMember> () with match! ctx.TryBindFormAsync<EditMember> () with
| Ok model -> | Ok model ->
let group = ctx.Session.CurrentGroup.Value let group = ctx.Session.CurrentGroup.Value
let! mMbr = let! conn = ctx.Conn
let! tryMbr =
if model.IsNew then if model.IsNew then
Task.FromResult (Some { Member.empty with Id = (Guid.NewGuid >> MemberId) (); SmallGroupId = group.Id }) Task.FromResult (Some { Member.empty with Id = (Guid.NewGuid >> MemberId) (); SmallGroupId = group.Id })
else ctx.Db.TryMemberById (idFromShort MemberId model.MemberId) else Members.tryById (idFromShort MemberId model.MemberId) conn
match mMbr with match tryMbr with
| Some mbr when mbr.SmallGroupId = group.Id -> | Some mbr when mbr.SmallGroupId = group.Id ->
do! Members.save
{ mbr with { mbr with
Name = model.Name Name = model.Name
Email = model.Email Email = model.Email
Format = match model.Format with "" | null -> None | _ -> Some (EmailFormat.fromCode model.Format) Format = String.noneIfBlank model.Format |> Option.map EmailFormat.fromCode
} } conn
|> if model.IsNew then ctx.Db.AddEntry else ctx.Db.UpdateEntry
let! _ = ctx.Db.SaveChangesAsync ()
let s = Views.I18N.localizer.Force () let s = Views.I18N.localizer.Force ()
let act = s[if model.IsNew then "Added" else "Updated"].Value.ToLower () let act = s[if model.IsNew then "Added" else "Updated"].Value.ToLower ()
addInfo ctx s["Successfully {0} group member", act] addInfo ctx s["Successfully {0} group member", act]
@ -256,13 +249,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 // 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. // database values, not the then out-of-sync session ones.
let group = ctx.Session.CurrentGroup.Value let group = ctx.Session.CurrentGroup.Value
match! ctx.Db.TryGroupById group.Id with let! conn = ctx.Conn
match! SmallGroups.tryByIdWithPreferences group.Id conn with
| Some grp -> | Some grp ->
let prefs = model.PopulatePreferences grp.Preferences let pref = model.PopulatePreferences grp.Preferences
ctx.Db.UpdateEntry prefs do! SmallGroups.savePreferences pref conn
let! _ = ctx.Db.SaveChangesAsync ()
// Refresh session instance // Refresh session instance
ctx.Session.CurrentGroup <- Some { grp with Preferences = prefs } ctx.Session.CurrentGroup <- Some { grp with Preferences = pref }
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 "/small-group/preferences" next ctx return! redirectTo false "/small-group/preferences" next ctx
@ -289,10 +282,13 @@ let sendAnnouncement : HttpHandler = requireAccess [ User ] >=> validateCsrf >=>
|> renderHtmlNode |> renderHtmlNode
let plainText = (htmlToPlainText >> wordWrap 74) htmlText let plainText = (htmlToPlainText >> wordWrap 74) htmlText
// Send the e-mails // Send the e-mails
let! recipients = let! conn = ctx.Conn
match model.SendToClass with let! recipients = task {
| "N" when usr.IsAdmin -> ctx.Db.AllUsersAsMembers () if model.SendToClass = "N" && usr.IsAdmin then
| _ -> ctx.Db.AllMembersForSmallGroup group.Id let! users = Users.all conn
return users |> List.map (fun u -> { Member.empty with Name = u.Name; Email = u.Email })
else return! Members.forGroup group.Id conn
}
use! client = Email.getConnection () use! client = Email.getConnection ()
do! Email.sendEmails do! Email.sendEmails
{ Client = client { Client = client
@ -311,6 +307,7 @@ let sendAnnouncement : HttpHandler = requireAccess [ User ] >=> validateCsrf >=>
| _, Some x when not x -> () | _, Some x when not x -> ()
| _, _ -> | _, _ ->
let zone = SmallGroup.timeZone group let zone = SmallGroup.timeZone group
do! PrayerRequests.save
{ PrayerRequest.empty with { PrayerRequest.empty with
Id = (Guid.NewGuid >> PrayerRequestId) () Id = (Guid.NewGuid >> PrayerRequestId) ()
SmallGroupId = group.Id SmallGroupId = group.Id
@ -319,15 +316,11 @@ let sendAnnouncement : HttpHandler = requireAccess [ User ] >=> validateCsrf >=>
Text = requestText Text = requestText
EnteredDate = now.Date.AtStartOfDayInZone(zone).ToInstant() EnteredDate = now.Date.AtStartOfDayInZone(zone).ToInstant()
UpdatedDate = now.InZoneLeniently(zone).ToInstant() UpdatedDate = now.InZoneLeniently(zone).ToInstant()
} } conn
|> ctx.Db.AddEntry
let! _ = ctx.Db.SaveChangesAsync ()
()
// Tell 'em what they've won, Johnny! // Tell 'em what they've won, Johnny!
let toWhom = let toWhom =
match model.SendToClass with if model.SendToClass = "N" then s["{0} users", s["PrayerTracker"]].Value
| "N" -> s["{0} users", s["PrayerTracker"]].Value else s["Group Members"].Value.ToLower ()
| _ -> s["Group Members"].Value.ToLower ()
let andAdded = match model.AddToRequestList with Some x when x -> "and added it to the request list" | _ -> "" let andAdded = match model.AddToRequestList with Some x when x -> "and added it to the request list" | _ -> ""
addInfo ctx s["Successfully sent announcement to all {0} {1}", toWhom, s[andAdded]] addInfo ctx s["Successfully sent announcement to all {0} {1}", toWhom, s[andAdded]]
return! return!