diff --git a/build.fsx b/build.fsx index 50b9aa1..552973c 100644 --- a/build.fsx +++ b/build.fsx @@ -26,7 +26,7 @@ Target.create "Test" (fun _ -> let testPath = $"{projPath}.Tests" DotNet.build (fun opts -> { opts with NoLogo = true }) $"{testPath}/PrayerTracker.Tests.fsproj" Expecto.run - (fun opts -> { opts with WorkingDirectory = $"{testPath}/bin/Release/net6.0" }) + (fun opts -> { opts with WorkingDirectory = $"{testPath}/bin/Release/net7.0" }) [ "PrayerTracker.Tests.dll" ]) Target.create "Publish" (fun _ -> diff --git a/src/.dockerignore b/src/.dockerignore new file mode 100644 index 0000000..a267a97 --- /dev/null +++ b/src/.dockerignore @@ -0,0 +1,2 @@ +**/bin/* +**/obj/* \ No newline at end of file diff --git a/src/Directory.Build.props b/src/Directory.Build.props index d54687e..d0aaa2c 100644 --- a/src/Directory.Build.props +++ b/src/Directory.Build.props @@ -1,11 +1,11 @@ - net6.0 - 8.0.0.0 - 8.0.0.0 + net7.0 + 8.1.0.0 + 8.1.0.0 danieljsummers Bit Badger Solutions - 8.0.0 + 8.1.0 Embedded diff --git a/src/Dockerfile b/src/Dockerfile new file mode 100644 index 0000000..d652e29 --- /dev/null +++ b/src/Dockerfile @@ -0,0 +1,25 @@ +FROM mcr.microsoft.com/dotnet/sdk:7.0-alpine AS build +WORKDIR /pt +COPY ./PrayerTracker.sln ./ +COPY ./Directory.Build.props ./ +COPY ./PrayerTracker/PrayerTracker.fsproj ./PrayerTracker/ +COPY ./PrayerTracker.Data/PrayerTracker.Data.fsproj ./PrayerTracker.Data/ +COPY ./PrayerTracker.Tests/PrayerTracker.Tests.fsproj ./PrayerTracker.Tests/ +COPY ./PrayerTracker.UI/PrayerTracker.UI.fsproj ./PrayerTracker.UI/ +RUN dotnet restore + +COPY . ./ +WORKDIR /pt/PrayerTracker.Tests +RUN dotnet run + +WORKDIR /pt/PrayerTracker +RUN dotnet publish -c Release -r linux-x64 + +FROM mcr.microsoft.com/dotnet/aspnet:7.0-alpine as final +WORKDIR /app +RUN apk add --no-cache icu-libs +ENV DOTNET_SYSTEM_GLOBALIZATION_INVARIANT=false +COPY --from=build /pt/PrayerTracker/bin/Release/net7.0/linux-x64/publish/ ./ + +EXPOSE 80 +CMD [ "dotnet", "/app/PrayerTracker.dll" ] diff --git a/src/PrayerTracker.Data/Access.fs b/src/PrayerTracker.Data/Access.fs index 28c2167..6794496 100644 --- a/src/PrayerTracker.Data/Access.fs +++ b/src/PrayerTracker.Data/Access.fs @@ -103,126 +103,93 @@ module private Helpers = } +open BitBadger.Npgsql.FSharp.Documents + /// Functions to manipulate churches module Churches = /// Get a list of all churches - let all conn = - Sql.existingConnection conn - |> Sql.query "SELECT * FROM pt.church ORDER BY church_name" - |> Sql.executeAsync mapToChurch + let all () = + Custom.list "SELECT * FROM pt.church ORDER BY church_name" [] mapToChurch /// Delete a church by its ID - let deleteById (churchId : ChurchId) conn = backgroundTask { + let deleteById (churchId : ChurchId) = backgroundTask { 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! _ = - Sql.existingConnection conn + Configuration.dataSource () + |> Sql.fromDataSource |> Sql.executeTransactionAsync [ $"DELETE FROM pt.prayer_request {where}", idParam $"DELETE FROM pt.user_small_group {where}", idParam $"DELETE FROM pt.list_preference {where}", idParam "DELETE FROM pt.small_group WHERE church_id = @churchId", idParam "DELETE FROM pt.church WHERE id = @churchId", idParam ] - return () + () } /// Save a church's information - let save (church : Church) conn = backgroundTask { - let! _ = - Sql.existingConnection conn - |> Sql.query """ - INSERT INTO pt.church ( - id, church_name, city, state, has_vps_interface, interface_address - ) VALUES ( - @id, @name, @city, @state, @hasVpsInterface, @interfaceAddress - ) ON CONFLICT (id) DO UPDATE - SET church_name = EXCLUDED.church_name, - city = EXCLUDED.city, - state = EXCLUDED.state, - has_vps_interface = EXCLUDED.has_vps_interface, - interface_address = EXCLUDED.interface_address""" - |> Sql.parameters - [ "@id", Sql.uuid church.Id.Value - "@name", Sql.string church.Name - "@city", Sql.string church.City - "@state", Sql.string church.State - "@hasVpsInterface", Sql.bool church.HasVpsInterface - "@interfaceAddress", Sql.stringOrNone church.InterfaceAddress ] - |> Sql.executeNonQueryAsync - return () - } + let save (church : Church) = + Custom.nonQuery + "INSERT INTO pt.church ( + id, church_name, city, state, has_vps_interface, interface_address + ) VALUES ( + @id, @name, @city, @state, @hasVpsInterface, @interfaceAddress + ) ON CONFLICT (id) DO UPDATE + SET church_name = EXCLUDED.church_name, + city = EXCLUDED.city, + state = EXCLUDED.state, + has_vps_interface = EXCLUDED.has_vps_interface, + interface_address = EXCLUDED.interface_address" + [ "@id", Sql.uuid church.Id.Value + "@name", Sql.string church.Name + "@city", Sql.string church.City + "@state", Sql.string church.State + "@hasVpsInterface", Sql.bool church.HasVpsInterface + "@interfaceAddress", Sql.stringOrNone church.InterfaceAddress ] /// Find a church by its ID - let tryById (churchId : ChurchId) conn = backgroundTask { - let! church = - Sql.existingConnection conn - |> Sql.query "SELECT * FROM pt.church WHERE id = @id" - |> Sql.parameters [ "@id", Sql.uuid churchId.Value ] - |> Sql.executeAsync mapToChurch - return List.tryHead church - } + let tryById (churchId : ChurchId) = + Custom.single "SELECT * FROM pt.church WHERE id = @id" [ "@id", Sql.uuid churchId.Value ] mapToChurch /// Functions to manipulate small group members module Members = /// Count members for the given small group - let countByGroup (groupId : SmallGroupId) conn = - 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") + let countByGroup (groupId : SmallGroupId) = + Custom.scalar "SELECT COUNT(id) AS mbr_count FROM pt.member WHERE small_group_id = @groupId" + [ "@groupId", Sql.uuid groupId.Value ] (fun row -> row.int "mbr_count") /// Delete a small group member by its ID - let deleteById (memberId : MemberId) conn = backgroundTask { - let! _ = - Sql.existingConnection conn - |> Sql.query "DELETE FROM pt.member WHERE id = @id" - |> Sql.parameters [ "@id", Sql.uuid memberId.Value ] - |> Sql.executeNonQueryAsync - return () - } + let deleteById (memberId : MemberId) = + Custom.nonQuery "DELETE FROM pt.member WHERE id = @id" [ "@id", Sql.uuid memberId.Value ] /// Retrieve all members for a given small group - let forGroup (groupId : SmallGroupId) conn = - 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 + let forGroup (groupId : SmallGroupId) = + Custom.list "SELECT * FROM pt.member WHERE small_group_id = @groupId ORDER BY member_name" + [ "@groupId", Sql.uuid groupId.Value ] mapToMember /// Save a small group member - let save (mbr : Member) conn = backgroundTask { - let! _ = - Sql.existingConnection conn - |> 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 () - } + let save (mbr : Member) = + Custom.nonQuery + "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" + [ "@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) ] /// Retrieve a small group member by its ID - let tryById (memberId : MemberId) conn = backgroundTask { - let! mbr = - Sql.existingConnection conn - |> Sql.query "SELECT * FROM pt.member WHERE id = @id" - |> Sql.parameters [ "@id", Sql.uuid memberId.Value ] - |> Sql.executeAsync mapToMember - return List.tryHead mbr - } + let tryById (memberId : MemberId) = + Custom.single "SELECT * FROM pt.member WHERE id = @id" [ "@id", Sql.uuid memberId.Value ] mapToMember /// Options to retrieve a list of requests @@ -258,34 +225,24 @@ module PrayerRequests = if pageNbr > 0 then $"LIMIT {pageSize} OFFSET {(pageNbr - 1) * pageSize}" else "" /// Count the number of prayer requests for a church - let countByChurch (churchId : ChurchId) conn = - Sql.existingConnection conn - |> Sql.query """ - SELECT COUNT(id) AS req_count - FROM pt.prayer_request - WHERE small_group_id IN (SELECT id FROM pt.small_group WHERE church_id = @churchId)""" - |> Sql.parameters [ "@churchId", Sql.uuid churchId.Value ] - |> Sql.executeRowAsync (fun row -> row.int "req_count") + let countByChurch (churchId : ChurchId) = + Custom.scalar + "SELECT COUNT(id) AS req_count + FROM pt.prayer_request + WHERE small_group_id IN (SELECT id FROM pt.small_group WHERE church_id = @churchId)" + [ "@churchId", Sql.uuid churchId.Value ] (fun row -> row.int "req_count") /// Count the number of prayer requests for a small group - let countByGroup (groupId : SmallGroupId) conn = - 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") + let countByGroup (groupId : SmallGroupId) = + Custom.scalar "SELECT COUNT(id) AS req_count FROM pt.prayer_request WHERE small_group_id = @groupId" + [ "@groupId", Sql.uuid groupId.Value ] (fun row -> row.int "req_count") /// Delete a prayer request by its ID - let deleteById (reqId : PrayerRequestId) conn = backgroundTask { - let! _ = - Sql.existingConnection conn - |> Sql.query "DELETE FROM pt.prayer_request WHERE id = @id" - |> Sql.parameters [ "@id", Sql.uuid reqId.Value ] - |> Sql.executeNonQueryAsync - return () - } + let deleteById (reqId : PrayerRequestId) = + Custom.nonQuery "DELETE FROM pt.prayer_request WHERE id = @id" [ "@id", Sql.uuid reqId.Value ] /// 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) = let theDate = defaultArg opts.ListDate (SmallGroup.localDateNow opts.Clock opts.SmallGroup) let where, parameters = if opts.ActiveOnly then @@ -294,198 +251,167 @@ module PrayerRequests = (theDate.AtStartOfDayInZone(SmallGroup.timeZone opts.SmallGroup) - Duration.FromDays opts.SmallGroup.Preferences.DaysToExpire) .ToInstant ()) - """ AND ( updated_date > @asOf + " AND ( updated_date > @asOf OR expiration = @manual OR request_type = @longTerm OR request_type = @expecting) - AND expiration <> @forced""", + AND expiration <> @forced", [ "@asOf", Sql.parameter asOf "@manual", Sql.string (Expiration.toCode Manual) "@longTerm", Sql.string (PrayerRequestType.toCode LongTermRequest) "@expecting", Sql.string (PrayerRequestType.toCode Expecting) "@forced", Sql.string (Expiration.toCode Forced) ] else "", [] - Sql.existingConnection conn - |> Sql.query $""" - SELECT * - FROM pt.prayer_request - WHERE small_group_id = @groupId {where} - ORDER BY {orderBy opts.SmallGroup.Preferences.RequestSort} - {paginate opts.PageNumber opts.SmallGroup.Preferences.PageSize}""" - |> Sql.parameters (("@groupId", Sql.uuid opts.SmallGroup.Id.Value) :: parameters) - |> Sql.executeAsync mapToPrayerRequest + Custom.list + $"SELECT * + FROM pt.prayer_request + WHERE small_group_id = @groupId {where} + ORDER BY {orderBy opts.SmallGroup.Preferences.RequestSort} + {paginate opts.PageNumber opts.SmallGroup.Preferences.PageSize}" + (("@groupId", Sql.uuid opts.SmallGroup.Id.Value) :: parameters) mapToPrayerRequest /// Save a prayer request - let save (req : PrayerRequest) conn = backgroundTask { - let! _ = - 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, - 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 () - } + let save (req : PrayerRequest) = + Custom.nonQuery + "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" + [ "@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) ] /// Search prayer requests for the given term - let searchForGroup group searchTerm pageNbr conn = - Sql.existingConnection conn - |> Sql.query $""" - SELECT * FROM pt.prayer_request WHERE small_group_id = @groupId AND request_text ILIKE @search - UNION - SELECT * FROM pt.prayer_request WHERE small_group_id = @groupId AND COALESCE(requestor, '') ILIKE @search - ORDER BY {orderBy group.Preferences.RequestSort} - {paginate pageNbr group.Preferences.PageSize}""" - |> Sql.parameters [ "@groupId", Sql.uuid group.Id.Value; "@search", Sql.string $"%%%s{searchTerm}%%" ] - |> Sql.executeAsync mapToPrayerRequest + let searchForGroup group searchTerm pageNbr = + Custom.list + $"SELECT * FROM pt.prayer_request WHERE small_group_id = @groupId AND request_text ILIKE @search + UNION + SELECT * FROM pt.prayer_request WHERE small_group_id = @groupId AND COALESCE(requestor, '') ILIKE @search + ORDER BY {orderBy group.Preferences.RequestSort} + {paginate pageNbr group.Preferences.PageSize}" + [ "@groupId", Sql.uuid group.Id.Value; "@search", Sql.string $"%%%s{searchTerm}%%" ] mapToPrayerRequest /// Retrieve a prayer request by its ID - let tryById (reqId : PrayerRequestId) conn = backgroundTask { - let! req = - Sql.existingConnection conn - |> Sql.query "SELECT * FROM pt.prayer_request WHERE id = @id" - |> Sql.parameters [ "@id", Sql.uuid reqId.Value ] - |> Sql.executeAsync mapToPrayerRequest - return List.tryHead req - } + let tryById (reqId : PrayerRequestId) = + Custom.single "SELECT * FROM pt.prayer_request WHERE id = @id" [ "@id", Sql.uuid reqId.Value ] + mapToPrayerRequest /// Update the expiration for the given prayer request - let updateExpiration (req : PrayerRequest) withTime conn = backgroundTask { + let updateExpiration (req : PrayerRequest) withTime = let sql, parameters = if withTime then ", updated_date = @updated", [ "@updated", Sql.parameter (NpgsqlParameter ("@updated", req.UpdatedDate)) ] else "", [] - let! _ = - 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) - "@id", Sql.uuid req.Id.Value ] - |> List.append parameters) - |> Sql.executeNonQueryAsync - return () - } + Custom.nonQuery $"UPDATE pt.prayer_request SET expiration = @expiration{sql} WHERE id = @id" + ([ "@expiration", Sql.string (Expiration.toCode req.Expiration) + "@id", Sql.uuid req.Id.Value ] + |> List.append parameters) /// Functions to retrieve small group information module SmallGroups = /// Count the number of small groups for a church - let countByChurch (churchId : ChurchId) conn = - 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") + let countByChurch (churchId : ChurchId) = + Custom.scalar "SELECT COUNT(id) AS group_count FROM pt.small_group WHERE church_id = @churchId" + [ "@churchId", Sql.uuid churchId.Value ] (fun row -> row.int "group_count") /// Delete a small group by its ID - let deleteById (groupId : SmallGroupId) conn = backgroundTask { + let deleteById (groupId : SmallGroupId) = backgroundTask { let idParam = [ [ "@groupId", Sql.uuid groupId.Value ] ] let! _ = - Sql.existingConnection conn + Configuration.dataSource () + |> Sql.fromDataSource |> 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 "DELETE FROM pt.list_preference WHERE small_group_id = @groupId", idParam "DELETE FROM pt.small_group WHERE id = @groupId", idParam ] - return () + () } /// Get information for all small groups - let infoForAll conn = - Sql.existingConnection conn - |> Sql.query """ - 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 - ORDER BY sg.group_name""" - |> Sql.executeAsync mapToSmallGroupInfo + let infoForAll () = + Custom.list + "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 + ORDER BY sg.group_name" + [] mapToSmallGroupInfo /// Get a list of small group IDs along with a description that includes the church name - let listAll conn = - Sql.existingConnection conn - |> Sql.query """ - SELECT g.group_name, g.id, c.church_name - FROM pt.small_group g - INNER JOIN pt.church c ON c.id = g.church_id - ORDER BY c.church_name, g.group_name""" - |> Sql.executeAsync mapToSmallGroupItem + let listAll () = + Custom.list + "SELECT g.group_name, g.id, c.church_name + FROM pt.small_group g + INNER JOIN pt.church c ON c.id = g.church_id + ORDER BY c.church_name, g.group_name" + [] mapToSmallGroupItem /// Get a list of small group IDs and descriptions for groups with a group password - let listProtected conn = - Sql.existingConnection conn - |> 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 COALESCE(lp.group_password, '') <> '' - ORDER BY c.church_name, g.group_name""" - |> Sql.executeAsync mapToSmallGroupItem + let listProtected () = + Custom.list + "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 COALESCE(lp.group_password, '') <> '' + ORDER BY c.church_name, g.group_name" + [] mapToSmallGroupItem /// Get a list of small group IDs and descriptions for groups that are public or have a group password - let listPublicAndProtected conn = - Sql.existingConnection conn - |> Sql.query """ - 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 - WHERE lp.is_public = TRUE - OR COALESCE(lp.group_password, '') <> '' - ORDER BY c.church_name, g.group_name""" - |> Sql.executeAsync mapToSmallGroupInfo + let listPublicAndProtected () = + Custom.list + "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 + WHERE lp.is_public = TRUE + OR COALESCE(lp.group_password, '') <> '' + ORDER BY c.church_name, g.group_name" + [] mapToSmallGroupInfo /// Log on for a small group (includes list preferences) - let logOn (groupId : SmallGroupId) password conn = backgroundTask { - let! group = - Sql.existingConnection conn - |> Sql.query """ - SELECT sg.*, lp.* - FROM pt.small_group sg - INNER JOIN pt.list_preference lp ON lp.small_group_id = sg.id - WHERE sg.id = @id - AND lp.group_password = @password""" - |> Sql.parameters [ "@id", Sql.uuid groupId.Value; "@password", Sql.string password ] - |> Sql.executeAsync mapToSmallGroupWithPreferences - return List.tryHead group - } + let logOn (groupId : SmallGroupId) password = + Custom.single + "SELECT sg.*, lp.* + FROM pt.small_group sg + INNER JOIN pt.list_preference lp ON lp.small_group_id = sg.id + WHERE sg.id = @id + AND lp.group_password = @password" + [ "@id", Sql.uuid groupId.Value; "@password", Sql.string password ] mapToSmallGroupWithPreferences /// Save a small group - let save (group : SmallGroup) isNew conn = backgroundTask { + let save (group : SmallGroup) isNew = backgroundTask { let! _ = - Sql.existingConnection conn + Configuration.dataSource () + |> Sql.fromDataSource |> Sql.executeTransactionAsync [ - """ INSERT INTO pt.small_group ( + "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""", + ) 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 ] ] @@ -493,216 +419,154 @@ module SmallGroups = "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! _ = - Sql.existingConnection conn - |> 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 () - } + let savePreferences (pref : ListPreferences) = + Custom.nonQuery + "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" + [ "@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) ] /// Get a small group by its ID - let tryById (groupId : SmallGroupId) conn = backgroundTask { - let! group = - Sql.existingConnection conn - |> Sql.query "SELECT * FROM pt.small_group WHERE id = @id" - |> Sql.parameters [ "@id", Sql.uuid groupId.Value ] - |> Sql.executeAsync mapToSmallGroup - return List.tryHead group - } + let tryById (groupId : SmallGroupId) = + Custom.single "SELECT * FROM pt.small_group WHERE id = @id" [ "@id", Sql.uuid groupId.Value ] mapToSmallGroup /// Get a small group by its ID with its list preferences populated - let tryByIdWithPreferences (groupId : SmallGroupId) conn = backgroundTask { - let! group = - Sql.existingConnection conn - |> Sql.query """ - SELECT sg.*, lp.* - FROM pt.small_group sg - INNER JOIN pt.list_preference lp ON lp.small_group_id = sg.id - WHERE sg.id = @id""" - |> Sql.parameters [ "@id", Sql.uuid groupId.Value ] - |> Sql.executeAsync mapToSmallGroupWithPreferences - return List.tryHead group - } + let tryByIdWithPreferences (groupId : SmallGroupId) = + Custom.single + "SELECT sg.*, lp.* + FROM pt.small_group sg + INNER JOIN pt.list_preference lp ON lp.small_group_id = sg.id + WHERE sg.id = @id" + [ "@id", Sql.uuid groupId.Value ] mapToSmallGroupWithPreferences /// Functions to manipulate users module Users = /// Retrieve all PrayerTracker users - let all conn = - Sql.existingConnection conn - |> Sql.query "SELECT * FROM pt.pt_user ORDER BY last_name, first_name" - |> Sql.executeAsync mapToUser + let all () = + Custom.list "SELECT * FROM pt.pt_user ORDER BY last_name, first_name" [] mapToUser /// Count the number of users for a church - let countByChurch (churchId : ChurchId) conn = - Sql.existingConnection conn - |> Sql.query """ - SELECT COUNT(u.id) AS user_count - FROM pt.pt_user u - WHERE EXISTS ( - SELECT 1 - FROM pt.user_small_group usg - INNER JOIN pt.small_group sg ON sg.id = usg.small_group_id - WHERE usg.user_id = u.id - AND sg.church_id = @churchId)""" - |> Sql.parameters [ "@churchId", Sql.uuid churchId.Value ] - |> Sql.executeRowAsync (fun row -> row.int "user_count") + let countByChurch (churchId : ChurchId) = + Custom.scalar + "SELECT COUNT(u.id) AS user_count + FROM pt.pt_user u + WHERE EXISTS ( + SELECT 1 + FROM pt.user_small_group usg + INNER JOIN pt.small_group sg ON sg.id = usg.small_group_id + WHERE usg.user_id = u.id + AND sg.church_id = @churchId)" + [ "@churchId", Sql.uuid churchId.Value ] (fun row -> row.int "user_count") /// Count the number of users for a small group - let countByGroup (groupId : SmallGroupId) conn = - 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") + let countByGroup (groupId : SmallGroupId) = + Custom.scalar "SELECT COUNT(user_id) AS user_count FROM pt.user_small_group WHERE small_group_id = @groupId" + [ "@groupId", Sql.uuid groupId.Value ] (fun row -> row.int "user_count") /// Delete a user by its database ID - let deleteById (userId : UserId) conn = backgroundTask { - let! _ = - Sql.existingConnection conn - |> Sql.query "DELETE FROM pt.pt_user WHERE id = @id" - |> Sql.parameters [ "@id", Sql.uuid userId.Value ] - |> Sql.executeNonQueryAsync - return () - } + let deleteById (userId : UserId) = + Custom.nonQuery "DELETE FROM pt.pt_user WHERE id = @id" [ "@id", Sql.uuid userId.Value ] /// Get the IDs of the small groups for which the given user is authorized - let groupIdsByUserId (userId : UserId) conn = - 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")) + let groupIdsByUserId (userId : UserId) = + Custom.list "SELECT small_group_id FROM pt.user_small_group WHERE user_id = @id" + [ "@id", Sql.uuid userId.Value ] (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 = - Sql.existingConnection conn - |> Sql.query """ - SELECT u.* - FROM pt.pt_user u - INNER JOIN pt.user_small_group usg ON usg.user_id = u.id - WHERE usg.small_group_id = @groupId - ORDER BY u.last_name, u.first_name""" - |> Sql.parameters [ "@groupId", Sql.uuid groupId.Value ] - |> Sql.executeAsync mapToUser + let listByGroupId (groupId : SmallGroupId) = + Custom.list + "SELECT u.* + FROM pt.pt_user u + INNER JOIN pt.user_small_group usg ON usg.user_id = u.id + WHERE usg.small_group_id = @groupId + ORDER BY u.last_name, u.first_name" + [ "@groupId", Sql.uuid groupId.Value ] mapToUser /// Save a user's information - let save (user : User) conn = backgroundTask { - let! _ = - Sql.existingConnection conn - |> Sql.query """ - INSERT INTO pt.pt_user ( - id, first_name, last_name, email, is_admin, password_hash - ) VALUES ( - @id, @firstName, @lastName, @email, @isAdmin, @passwordHash - ) ON CONFLICT (id) DO UPDATE - SET first_name = EXCLUDED.first_name, - last_name = EXCLUDED.last_name, - email = EXCLUDED.email, - is_admin = EXCLUDED.is_admin, - password_hash = EXCLUDED.password_hash""" - |> Sql.parameters - [ "@id", Sql.uuid user.Id.Value - "@firstName", Sql.string user.FirstName - "@lastName", Sql.string user.LastName - "@email", Sql.string user.Email - "@isAdmin", Sql.bool user.IsAdmin - "@passwordHash", Sql.string user.PasswordHash - ] - |> Sql.executeNonQueryAsync - return () - } + let save (user : User) = + Custom.nonQuery + "INSERT INTO pt.pt_user ( + id, first_name, last_name, email, is_admin, password_hash + ) VALUES ( + @id, @firstName, @lastName, @email, @isAdmin, @passwordHash + ) ON CONFLICT (id) DO UPDATE + SET first_name = EXCLUDED.first_name, + last_name = EXCLUDED.last_name, + email = EXCLUDED.email, + is_admin = EXCLUDED.is_admin, + password_hash = EXCLUDED.password_hash" + [ "@id", Sql.uuid user.Id.Value + "@firstName", Sql.string user.FirstName + "@lastName", Sql.string user.LastName + "@email", Sql.string user.Email + "@isAdmin", Sql.bool user.IsAdmin + "@passwordHash", Sql.string user.PasswordHash ] /// Find a user by its e-mail address and authorized small group - let tryByEmailAndGroup email (groupId : SmallGroupId) conn = backgroundTask { - let! user = - Sql.existingConnection conn - |> Sql.query """ - SELECT u.* - FROM pt.pt_user u - INNER JOIN pt.user_small_group usg ON usg.user_id = u.id AND usg.small_group_id = @groupId - WHERE u.email = @email""" - |> Sql.parameters [ "@email", Sql.string email; "@groupId", Sql.uuid groupId.Value ] - |> Sql.executeAsync mapToUser - return List.tryHead user - } + let tryByEmailAndGroup email (groupId : SmallGroupId) = + Custom.single + "SELECT u.* + FROM pt.pt_user u + INNER JOIN pt.user_small_group usg ON usg.user_id = u.id AND usg.small_group_id = @groupId + WHERE u.email = @email" + [ "@email", Sql.string email; "@groupId", Sql.uuid groupId.Value ] mapToUser /// Find a user by their database ID - let tryById (userId : UserId) conn = backgroundTask { - let! user = - Sql.existingConnection conn - |> Sql.query "SELECT * FROM pt.pt_user WHERE id = @id" - |> Sql.parameters [ "@id", Sql.uuid userId.Value ] - |> Sql.executeAsync mapToUser - return List.tryHead user - } + let tryById (userId : UserId) = + Custom.single "SELECT * FROM pt.pt_user WHERE id = @id" [ "@id", Sql.uuid userId.Value ] mapToUser /// Update a user's last seen date/time - let updateLastSeen (userId : UserId) (now : Instant) conn = backgroundTask { - let! _ = - 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 - return () - } + let updateLastSeen (userId : UserId) (now : Instant) = + Custom.nonQuery "UPDATE pt.pt_user SET last_seen = @now WHERE id = @id" + [ "@id", Sql.uuid userId.Value; "@now", Sql.parameter (NpgsqlParameter ("@now", now)) ] /// Update a user's password hash - let updatePassword (user : User) conn = backgroundTask { - let! _ = - 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 - return () - } + let updatePassword (user : User) = + Custom.nonQuery "UPDATE pt.pt_user SET password_hash = @passwordHash WHERE id = @id" + [ "@id", Sql.uuid user.Id.Value; "@passwordHash", Sql.string user.PasswordHash ] /// Update a user's authorized small groups - let updateSmallGroups (userId : UserId) groupIds conn = backgroundTask { - let! existingGroupIds = groupIdsByUserId userId conn + let updateSmallGroups (userId : UserId) groupIds = backgroundTask { + let! existingGroupIds = groupIdsByUserId userId let toAdd = groupIds |> List.filter (fun it -> existingGroupIds |> List.exists (fun grpId -> grpId = it) |> not) let toDelete = @@ -718,7 +582,8 @@ module Users = } if not (Seq.isEmpty queries) then let! _ = - Sql.existingConnection conn + Configuration.dataSource () + |> Sql.fromDataSource |> Sql.executeTransactionAsync (List.ofSeq queries) () } diff --git a/src/PrayerTracker.Data/DistributedCache.fs b/src/PrayerTracker.Data/DistributedCache.fs index 8abf8c8..e6b669e 100644 --- a/src/PrayerTracker.Data/DistributedCache.fs +++ b/src/PrayerTracker.Data/DistributedCache.fs @@ -47,33 +47,30 @@ module private CacheHelpers = p.ParameterName, Sql.parameter p +open BitBadger.Npgsql.FSharp.Documents + /// A distributed cache implementation in PostgreSQL used to handle sessions for myWebLog -type DistributedCache (connStr : string) = +type DistributedCache () = // ~~~ INITIALIZATION ~~~ do task { let! exists = - Sql.connect connStr - |> Sql.query $" - SELECT EXISTS - (SELECT 1 FROM pg_tables WHERE schemaname = 'public' AND tablename = 'session') - AS does_exist" - |> Sql.executeRowAsync (fun row -> row.bool "does_exist") + Custom.scalar + $"SELECT EXISTS + (SELECT 1 FROM pg_tables WHERE schemaname = 'public' AND tablename = 'session') + AS does_exist" + [] (fun row -> row.bool "does_exist") if not exists then - let! _ = - Sql.connect connStr - |> Sql.query + do! Custom.nonQuery "CREATE TABLE session ( id TEXT NOT NULL PRIMARY KEY, payload BYTEA NOT NULL, expire_at TIMESTAMPTZ NOT NULL, sliding_expiration INTERVAL, absolute_expiration TIMESTAMPTZ); - CREATE INDEX idx_session_expiration ON session (expire_at)" - |> Sql.executeNonQueryAsync - () + CREATE INDEX idx_session_expiration ON session (expire_at)" [] } |> sync // ~~~ SUPPORT FUNCTIONS ~~~ @@ -82,16 +79,14 @@ type DistributedCache (connStr : string) = let getEntry key = backgroundTask { let idParam = "@id", Sql.string key let! tryEntry = - Sql.connect connStr - |> Sql.query "SELECT * FROM session WHERE id = @id" - |> Sql.parameters [ idParam ] - |> Sql.executeAsync (fun row -> - { Id = row.string "id" - Payload = row.bytea "payload" - ExpireAt = row.fieldValue "expire_at" - SlidingExpiration = row.fieldValueOrNone "sliding_expiration" - AbsoluteExpiration = row.fieldValueOrNone "absolute_expiration" }) - match List.tryHead tryEntry with + Custom.single "SELECT * FROM session WHERE id = @id" [ idParam ] + (fun row -> + { Id = row.string "id" + Payload = row.bytea "payload" + ExpireAt = row.fieldValue "expire_at" + SlidingExpiration = row.fieldValueOrNone "sliding_expiration" + AbsoluteExpiration = row.fieldValueOrNone "absolute_expiration" }) + match tryEntry with | Some entry -> let now = getNow () let slideExp = defaultArg entry.SlidingExpiration Duration.MinValue @@ -103,12 +98,8 @@ type DistributedCache (connStr : string) = true, { entry with ExpireAt = absExp } else true, { entry with ExpireAt = now.Plus slideExp } if needsRefresh then - let! _ = - Sql.connect connStr - |> Sql.query "UPDATE session SET expire_at = @expireAt WHERE id = @id" - |> Sql.parameters [ expireParam item.ExpireAt; idParam ] - |> Sql.executeNonQueryAsync - () + do! Custom.nonQuery "UPDATE session SET expire_at = @expireAt WHERE id = @id" + [ expireParam item.ExpireAt; idParam ] return if item.ExpireAt > now then Some entry else None | None -> return None } @@ -120,26 +111,16 @@ type DistributedCache (connStr : string) = let purge () = backgroundTask { let now = getNow () if lastPurge.Plus (Duration.FromMinutes 30L) < now then - let! _ = - Sql.connect connStr - |> Sql.query "DELETE FROM session WHERE expire_at < @expireAt" - |> Sql.parameters [ expireParam now ] - |> Sql.executeNonQueryAsync + do! Custom.nonQuery "DELETE FROM session WHERE expire_at < @expireAt" [ expireParam now ] lastPurge <- now } /// Remove a cache entry - let removeEntry key = backgroundTask { - let! _ = - Sql.connect connStr - |> Sql.query "DELETE FROM session WHERE id = @id" - |> Sql.parameters [ "@id", Sql.string key ] - |> Sql.executeNonQueryAsync - () - } + let removeEntry key = + Custom.nonQuery "DELETE FROM session WHERE id = @id" [ "@id", Sql.string key ] /// Save an entry - let saveEntry (opts : DistributedCacheEntryOptions) key payload = backgroundTask { + let saveEntry (opts : DistributedCacheEntryOptions) key payload = let now = getNow () let expireAt, slideExp, absExp = if opts.SlidingExpiration.HasValue then @@ -155,27 +136,21 @@ type DistributedCache (connStr : string) = // Default to 2 hour sliding expiration let slide = Duration.FromHours 2 now.Plus slide, Some slide, None - let! _ = - Sql.connect connStr - |> Sql.query - "INSERT INTO session ( - id, payload, expire_at, sliding_expiration, absolute_expiration - ) VALUES ( - @id, @payload, @expireAt, @slideExp, @absExp - ) ON CONFLICT (id) DO UPDATE - SET payload = EXCLUDED.payload, - expire_at = EXCLUDED.expire_at, - sliding_expiration = EXCLUDED.sliding_expiration, - absolute_expiration = EXCLUDED.absolute_expiration" - |> Sql.parameters - [ "@id", Sql.string key - "@payload", Sql.bytea payload - expireParam expireAt - optParam "slideExp" slideExp - optParam "absExp" absExp ] - |> Sql.executeNonQueryAsync - () - } + Custom.nonQuery + "INSERT INTO session ( + id, payload, expire_at, sliding_expiration, absolute_expiration + ) VALUES ( + @id, @payload, @expireAt, @slideExp, @absExp + ) ON CONFLICT (id) DO UPDATE + SET payload = EXCLUDED.payload, + expire_at = EXCLUDED.expire_at, + sliding_expiration = EXCLUDED.sliding_expiration, + absolute_expiration = EXCLUDED.absolute_expiration" + [ "@id", Sql.string key + "@payload", Sql.bytea payload + expireParam expireAt + optParam "slideExp" slideExp + optParam "absExp" absExp ] // ~~~ IMPLEMENTATION FUNCTIONS ~~~ diff --git a/src/PrayerTracker.Data/PrayerTracker.Data.fsproj b/src/PrayerTracker.Data/PrayerTracker.Data.fsproj index 40cae83..52b7df9 100644 --- a/src/PrayerTracker.Data/PrayerTracker.Data.fsproj +++ b/src/PrayerTracker.Data/PrayerTracker.Data.fsproj @@ -1,9 +1,5 @@  - - net6.0 - - @@ -11,11 +7,12 @@ + - - - - + + + + diff --git a/src/PrayerTracker.Tests/PrayerTracker.Tests.fsproj b/src/PrayerTracker.Tests/PrayerTracker.Tests.fsproj index e98224a..d6ad743 100644 --- a/src/PrayerTracker.Tests/PrayerTracker.Tests.fsproj +++ b/src/PrayerTracker.Tests/PrayerTracker.Tests.fsproj @@ -2,7 +2,6 @@ Exe - net6.0 @@ -16,8 +15,8 @@ - - + + diff --git a/src/PrayerTracker.Tests/UI/ViewModelsTests.fs b/src/PrayerTracker.Tests/UI/ViewModelsTests.fs index 0ba5f54..739fa0c 100644 --- a/src/PrayerTracker.Tests/UI/ViewModelsTests.fs +++ b/src/PrayerTracker.Tests/UI/ViewModelsTests.fs @@ -650,7 +650,7 @@ let requestListTests = } let text = textList.AsText _s let expected = - textList.Requests[0].UpdatedDate.InUtc().Date.ToString ("d", null) + textList.Requests[0].UpdatedDate.InZone(SmallGroup.timeZone reqList.SmallGroup).Date.ToString ("d", null) |> sprintf " + Zeb - zyx (as of %s)" // spot check; if one request has it, they all should Expect.stringContains text expected "Expected short as-of date not found" @@ -665,7 +665,7 @@ let requestListTests = } let text = textList.AsText _s let expected = - textList.Requests[0].UpdatedDate.InUtc().Date.ToString ("D", null) + textList.Requests[0].UpdatedDate.InZone(SmallGroup.timeZone reqList.SmallGroup).Date.ToString ("D", null) |> sprintf " + Zeb - zyx (as of %s)" // spot check; if one request has it, they all should Expect.stringContains text expected "Expected long as-of date not found" diff --git a/src/PrayerTracker.UI/I18N.fs b/src/PrayerTracker.UI/I18N.fs index 9fcb1d2..31cb66c 100644 --- a/src/PrayerTracker.UI/I18N.fs +++ b/src/PrayerTracker.UI/I18N.fs @@ -19,4 +19,4 @@ let localizer = lazy (stringLocFactory.Create ("Common", resAsmName)) /// Get a view localizer let forView (view : string) = - htmlLocFactory.Create ($"""Views.{view.Replace ('/', '.')}""", resAsmName) + htmlLocFactory.Create ($"Views.{view.Replace ('/', '.')}", resAsmName) diff --git a/src/PrayerTracker.UI/Layout.fs b/src/PrayerTracker.UI/Layout.fs index d5380d1..e32b3be 100644 --- a/src/PrayerTracker.UI/Layout.fs +++ b/src/PrayerTracker.UI/Layout.fs @@ -304,14 +304,14 @@ let private contentSection viewInfo pgTitle (content : XmlNode) = [ | Some onLoad -> let doCall = if onLoad.EndsWith ")" then "" else "()" script [] [ - rawText $""" + rawText $" window.doOnLoad = () => {{ if (window.PT) {{ {onLoad}{doCall} delete window.doOnLoad }} else {{ setTimeout(window.doOnLoad, 500) }} }} - window.doOnLoad()""" + window.doOnLoad()" ] | None -> () ] diff --git a/src/PrayerTracker.UI/PrayerTracker.UI.fsproj b/src/PrayerTracker.UI/PrayerTracker.UI.fsproj index 8a976c0..7995a7c 100644 --- a/src/PrayerTracker.UI/PrayerTracker.UI.fsproj +++ b/src/PrayerTracker.UI/PrayerTracker.UI.fsproj @@ -1,9 +1,5 @@  - - net6.0 - - @@ -18,16 +14,15 @@ - - - + + - - + + diff --git a/src/PrayerTracker.UI/Utils.fs b/src/PrayerTracker.UI/Utils.fs index 941846d..07778af 100644 --- a/src/PrayerTracker.UI/Utils.fs +++ b/src/PrayerTracker.UI/Utils.fs @@ -2,9 +2,6 @@ module PrayerTracker.Utils open System -open System.Security.Cryptography -open System.Text - open Giraffe /// Parse a short-GUID-based ID from a string diff --git a/src/PrayerTracker/App.fs b/src/PrayerTracker/App.fs index b78c96a..485fd1b 100644 --- a/src/PrayerTracker/App.fs +++ b/src/PrayerTracker/App.fs @@ -35,6 +35,7 @@ module Configure = (ctx.Configuration.GetSection >> opts.Configure >> ignore) "Kestrel" open System.Globalization + open BitBadger.Npgsql.FSharp.Documents open Microsoft.AspNetCore.Authentication.Cookies open Microsoft.AspNetCore.Localization open Microsoft.Extensions.Caching.Distributed @@ -63,21 +64,18 @@ module Configure = opts.SlidingExpiration <- true opts.AccessDeniedPath <- "/error/403") let _ = svc.AddAuthorization () - let _ = - svc.AddSingleton (fun sp -> - let cfg = sp.GetService () - DistributedCache (cfg.GetConnectionString "PrayerTracker") :> IDistributedCache) + + let cfg = svc.BuildServiceProvider().GetService () + let dsb = NpgsqlDataSourceBuilder (cfg.GetConnectionString "PrayerTracker") + let _ = dsb.UseNodaTime() + Configuration.useDataSource (dsb.Build ()) + + let _ = svc.AddSingleton () let _ = svc.AddSession () let _ = svc.AddAntiforgery () let _ = svc.AddRouting () let _ = svc.AddSingleton SystemClock.Instance - let _ = - svc.AddScoped(fun sp -> - let cfg = sp.GetService () - let conn = new NpgsqlConnection (cfg.GetConnectionString "PrayerTracker") - conn.OpenAsync () |> Async.AwaitTask |> Async.RunSynchronously - conn) - let _ = NpgsqlConnection.GlobalTypeMapper.UseNodaTime () + () open Giraffe diff --git a/src/PrayerTracker/Church.fs b/src/PrayerTracker/Church.fs index a669853..7f13810 100644 --- a/src/PrayerTracker/Church.fs +++ b/src/PrayerTracker/Church.fs @@ -8,21 +8,20 @@ open PrayerTracker.Entities open PrayerTracker.ViewModels /// Find statistics for the given church -let private findStats churchId conn = task { - let! groups = SmallGroups.countByChurch churchId conn - let! requests = PrayerRequests.countByChurch churchId conn - let! users = Users.countByChurch churchId conn +let private findStats churchId = task { + let! groups = SmallGroups.countByChurch churchId + let! requests = PrayerRequests.countByChurch churchId + let! users = Users.countByChurch churchId return shortGuid churchId.Value, { SmallGroups = groups; PrayerRequests = requests; Users = users } } -/// POST /church/[church-id]/delete +// POST /church/[church-id]/delete let delete chId : HttpHandler = requireAccess [ Admin ] >=> validateCsrf >=> fun next ctx -> task { let churchId = ChurchId chId - let conn = ctx.Conn - match! Churches.tryById churchId conn with + match! Churches.tryById churchId with | Some church -> - let! _, stats = findStats churchId conn - do! Churches.deleteById churchId conn + let! _, stats = findStats churchId + do! Churches.deleteById churchId addInfo ctx ctx.Strings["The church “{0}” and its {1} small group(s) (with {2} prayer request(s)) were deleted successfully; revoked access from {3} user(s)", church.Name, stats.SmallGroups, stats.PrayerRequests, stats.Users] @@ -32,7 +31,7 @@ let delete chId : HttpHandler = requireAccess [ Admin ] >=> validateCsrf >=> fun open System -/// GET /church/[church-id]/edit +// GET /church/[church-id]/edit let edit churchId : HttpHandler = requireAccess [ Admin ] >=> fun next ctx -> task { if churchId = Guid.Empty then return! @@ -40,7 +39,7 @@ let edit churchId : HttpHandler = requireAccess [ Admin ] >=> fun next ctx -> ta |> Views.Church.edit EditChurch.empty ctx |> renderHtml next ctx else - match! Churches.tryById (ChurchId churchId) ctx.Conn with + match! Churches.tryById (ChurchId churchId) with | Some church -> return! viewInfo ctx @@ -49,27 +48,26 @@ let edit churchId : HttpHandler = requireAccess [ Admin ] >=> fun next ctx -> ta | None -> return! fourOhFour ctx } -/// GET /churches +// GET /churches let maintain : HttpHandler = requireAccess [ Admin ] >=> fun next ctx -> task { - let conn = ctx.Conn - let! churches = Churches.all conn - let stats = churches |> List.map (fun c -> findStats c.Id conn |> Async.AwaitTask |> Async.RunSynchronously) + let! churches = Churches.all () + let stats = churches |> List.map (fun c -> findStats c.Id |> Async.AwaitTask |> Async.RunSynchronously) return! viewInfo ctx |> Views.Church.maintain churches (stats |> Map.ofList) ctx |> renderHtml next ctx } -/// POST /church/save +// POST /church/save let save : HttpHandler = requireAccess [ Admin ] >=> validateCsrf >=> fun next ctx -> task { match! ctx.TryBindFormAsync () with | Ok model -> let! church = if model.IsNew then Task.FromResult (Some { Church.empty with Id = (Guid.NewGuid >> ChurchId) () }) - else Churches.tryById (idFromShort ChurchId model.ChurchId) ctx.Conn + else Churches.tryById (idFromShort ChurchId model.ChurchId) match church with | Some ch -> - do! Churches.save (model.PopulateChurch ch) ctx.Conn + do! Churches.save (model.PopulateChurch ch) 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 diff --git a/src/PrayerTracker/Email.fs b/src/PrayerTracker/Email.fs index ce06ca6..c559910 100644 --- a/src/PrayerTracker/Email.fs +++ b/src/PrayerTracker/Email.fs @@ -2,10 +2,8 @@ module PrayerTracker.Email open MailKit.Net.Smtp -open MailKit.Security open Microsoft.Extensions.Localization open MimeKit -open MimeKit.Text open PrayerTracker.Entities /// Parameters required to send an e-mail @@ -35,11 +33,13 @@ type EmailOptions = /// The e-mail address from which e-mail is sent let private fromAddress = "prayer@bitbadger.solutions" +open MailKit.Security +open Microsoft.Extensions.Configuration + /// Get an SMTP client connection -// FIXME: make host configurable -let getConnection () = task { +let getConnection (cfg : IConfiguration) = task { let client = new SmtpClient () - do! client.ConnectAsync ("127.0.0.1", 25, SecureSocketOptions.None) + do! client.ConnectAsync (cfg.GetConnectionString "SmtpServer", 25, SecureSocketOptions.None) return client } @@ -51,6 +51,8 @@ let createMessage opts = msg.ReplyTo.Add (MailboxAddress (opts.Group.Preferences.EmailFromName, opts.Group.Preferences.EmailFromAddress)) msg +open MimeKit.Text + /// Create an HTML-format e-mail message let createHtmlMessage opts = let bodyText = diff --git a/src/PrayerTracker/Extensions.fs b/src/PrayerTracker/Extensions.fs index 6f6411d..7cb69ac 100644 --- a/src/PrayerTracker/Extensions.fs +++ b/src/PrayerTracker/Extensions.fs @@ -76,14 +76,11 @@ type HttpContext with /// The system clock (via DI) member this.Clock = this.GetService () - /// The PostgreSQL connection (configured via DI) - member this.Conn = this.GetService () - /// The current instant member this.Now = this.Clock.GetCurrentInstant () /// The common string localizer - member this.Strings = Views.I18N.localizer.Force () + member _.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 { @@ -92,7 +89,7 @@ type HttpContext with | None -> match this.User.SmallGroupId with | Some groupId -> - match! SmallGroups.tryByIdWithPreferences groupId this.Conn with + match! SmallGroups.tryByIdWithPreferences groupId with | Some group -> this.Session.CurrentGroup <- Some group return Some group @@ -107,10 +104,10 @@ type HttpContext with | None -> match this.User.UserId with | Some userId -> - match! Users.tryById userId this.Conn with + match! Users.tryById userId with | Some user -> // Set last seen for user - do! Users.updateLastSeen userId this.Now this.Conn + do! Users.updateLastSeen userId this.Now this.Session.CurrentUser <- Some user return Some user | None -> return None diff --git a/src/PrayerTracker/Home.fs b/src/PrayerTracker/Home.fs index 03bf10d..261c48c 100644 --- a/src/PrayerTracker/Home.fs +++ b/src/PrayerTracker/Home.fs @@ -7,19 +7,19 @@ open Microsoft.AspNetCore.Http open Microsoft.AspNetCore.Localization open PrayerTracker -/// GET /error/[error-code] +// GET /error/[error-code] let error code : HttpHandler = requireAccess [ AccessLevel.Public ] >=> fun next ctx -> viewInfo ctx |> Views.Home.error code |> renderHtml next ctx -/// GET / +// GET / let homePage : HttpHandler = requireAccess [ AccessLevel.Public ] >=> fun next ctx -> viewInfo ctx |> Views.Home.index |> renderHtml next ctx -/// GET /language/[culture] +// GET /language/[culture] let language culture : HttpHandler = requireAccess [ AccessLevel.Public ] >=> fun next ctx -> try match culture with @@ -42,13 +42,13 @@ let language culture : HttpHandler = requireAccess [ AccessLevel.Public ] >=> fu let url = match string ctx.Request.Headers["Referer"] with null | "" -> "/" | r -> r redirectTo false url next ctx -/// GET /legal/privacy-policy +// GET /legal/privacy-policy let privacyPolicy : HttpHandler = requireAccess [ AccessLevel.Public ] >=> fun next ctx -> viewInfo ctx |> Views.Home.privacyPolicy |> renderHtml next ctx -/// GET /legal/terms-of-service +// GET /legal/terms-of-service let tos : HttpHandler = requireAccess [ AccessLevel.Public ] >=> fun next ctx -> viewInfo ctx |> Views.Home.termsOfService @@ -57,7 +57,7 @@ let tos : HttpHandler = requireAccess [ AccessLevel.Public ] >=> fun next ctx -> open Microsoft.AspNetCore.Authentication open Microsoft.AspNetCore.Authentication.Cookies -/// GET /log-off +// GET /log-off let logOff : HttpHandler = requireAccess [ AccessLevel.Public ] >=> fun next ctx -> task { ctx.Session.Clear () do! ctx.SignOutAsync CookieAuthenticationDefaults.AuthenticationScheme @@ -65,7 +65,7 @@ let logOff : HttpHandler = requireAccess [ AccessLevel.Public ] >=> fun next ctx return! redirectTo false "/" next ctx } -/// GET /unauthorized +// GET /unauthorized let unauthorized : HttpHandler = requireAccess [ AccessLevel.Public ] >=> fun next ctx -> viewInfo ctx |> Views.Home.unauthorized diff --git a/src/PrayerTracker/PrayerRequest.fs b/src/PrayerTracker/PrayerRequest.fs index e577190..527ff15 100644 --- a/src/PrayerTracker/PrayerRequest.fs +++ b/src/PrayerTracker/PrayerRequest.fs @@ -9,7 +9,7 @@ open PrayerTracker.ViewModels /// Retrieve a prayer request, and ensure that it belongs to the current class let private findRequest (ctx : HttpContext) reqId = task { - match! PrayerRequests.tryById reqId ctx.Conn with + match! PrayerRequests.tryById reqId with | Some req when req.SmallGroupId = ctx.Session.CurrentGroup.Value.Id -> return Ok req | Some _ -> addError ctx ctx.Strings["The prayer request you tried to access is not assigned to your group"] @@ -28,7 +28,7 @@ let private generateRequestList (ctx : HttpContext) date = task { ListDate = Some listDate ActiveOnly = true PageNumber = 0 - } ctx.Conn + } return { Requests = reqs Date = listDate @@ -49,7 +49,7 @@ let private parseListDate (date : string option) = open System -/// GET /prayer-request/[request-id]/edit +// GET /prayer-request/[request-id]/edit let edit reqId : HttpHandler = requireAccess [ User ] >=> fun next ctx -> task { let group = ctx.Session.CurrentGroup.Value let now = SmallGroup.localDateNow ctx.Clock group @@ -79,14 +79,16 @@ let edit reqId : HttpHandler = requireAccess [ User ] >=> fun next ctx -> task { | Result.Error e -> return! e } -/// GET /prayer-requests/email/[date] +open Microsoft.Extensions.Configuration + +// GET /prayer-requests/email/[date] let email date : HttpHandler = requireAccess [ User ] >=> fun next ctx -> task { let s = ctx.Strings let listDate = parseListDate (Some date) let! list = generateRequestList ctx listDate let group = ctx.Session.CurrentGroup.Value - let! recipients = Members.forGroup group.Id ctx.Conn - use! client = Email.getConnection () + let! recipients = Members.forGroup group.Id + use! client = Email.getConnection (ctx.GetService ()) do! Email.sendEmails { Client = client Recipients = recipients @@ -102,31 +104,31 @@ let email date : HttpHandler = requireAccess [ User ] >=> fun next ctx -> task { |> renderHtml next ctx } -/// POST /prayer-request/[request-id]/delete +// POST /prayer-request/[request-id]/delete let delete reqId : HttpHandler = requireAccess [ User ] >=> validateCsrf >=> fun next ctx -> task { let requestId = PrayerRequestId reqId match! findRequest ctx requestId with | Ok req -> - do! PrayerRequests.deleteById req.Id ctx.Conn + do! PrayerRequests.deleteById req.Id addInfo ctx ctx.Strings["The prayer request was deleted successfully"] return! redirectTo false "/prayer-requests" next ctx | Result.Error e -> return! e } -/// GET /prayer-request/[request-id]/expire +// GET /prayer-request/[request-id]/expire let expire reqId : HttpHandler = requireAccess [ User ] >=> fun next ctx -> task { let requestId = PrayerRequestId reqId match! findRequest ctx requestId with | Ok req -> - do! PrayerRequests.updateExpiration { req with Expiration = Forced } false ctx.Conn + do! PrayerRequests.updateExpiration { req with Expiration = Forced } false 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 +// GET /prayer-requests/[group-id]/list let list groupId : HttpHandler = requireAccess [ AccessLevel.Public ] >=> fun next ctx -> task { - match! SmallGroups.tryByIdWithPreferences (SmallGroupId groupId) ctx.Conn with + match! SmallGroups.tryByIdWithPreferences (SmallGroupId groupId) with | Some group when group.Preferences.IsPublic -> let! reqs = PrayerRequests.forGroup @@ -135,7 +137,7 @@ let list groupId : HttpHandler = requireAccess [ AccessLevel.Public ] >=> fun ne ListDate = None ActiveOnly = true PageNumber = 0 - } ctx.Conn + } return! viewInfo ctx |> Views.PrayerRequest.list @@ -153,18 +155,18 @@ let list groupId : HttpHandler = requireAccess [ AccessLevel.Public ] >=> fun ne | None -> return! fourOhFour ctx } -/// GET /prayer-requests/lists +// GET /prayer-requests/lists let lists : HttpHandler = requireAccess [ AccessLevel.Public ] >=> fun next ctx -> task { - let! groups = SmallGroups.listPublicAndProtected ctx.Conn + let! groups = SmallGroups.listPublicAndProtected () return! viewInfo ctx |> Views.PrayerRequest.lists groups |> renderHtml next ctx } -/// GET /prayer-requests[/inactive?] -/// - OR - -/// GET /prayer-requests?search=[search-query] +// GET /prayer-requests[/inactive?] +// - OR - +// GET /prayer-requests?search=[search-query] let maintain onlyActive : HttpHandler = requireAccess [ User ] >=> fun next ctx -> task { let group = ctx.Session.CurrentGroup.Value let pageNbr = @@ -174,7 +176,7 @@ let maintain onlyActive : HttpHandler = requireAccess [ User ] >=> fun next ctx let! model = backgroundTask { match ctx.GetQueryStringValue "search" with | Ok search -> - let! reqs = PrayerRequests.searchForGroup group search pageNbr ctx.Conn + let! reqs = PrayerRequests.searchForGroup group search pageNbr return { MaintainRequests.empty with Requests = reqs @@ -189,7 +191,7 @@ let maintain onlyActive : HttpHandler = requireAccess [ User ] >=> fun next ctx ListDate = None ActiveOnly = onlyActive PageNumber = pageNbr - } ctx.Conn + } return { MaintainRequests.empty with Requests = reqs @@ -203,7 +205,7 @@ let maintain onlyActive : HttpHandler = requireAccess [ User ] >=> fun next ctx |> renderHtml next ctx } -/// GET /prayer-request/print/[date] +// GET /prayer-request/print/[date] let print date : HttpHandler = requireAccess [ User; Group ] >=> fun next ctx -> task { let! list = generateRequestList ctx (parseListDate (Some date)) return! @@ -211,12 +213,12 @@ let print date : HttpHandler = requireAccess [ User; Group ] >=> fun next ctx -> |> renderHtml next ctx } -/// GET /prayer-request/[request-id]/restore +// GET /prayer-request/[request-id]/restore let restore reqId : HttpHandler = requireAccess [ User ] >=> fun next ctx -> task { let requestId = PrayerRequestId reqId match! findRequest ctx requestId with | Ok req -> - do! PrayerRequests.updateExpiration { req with Expiration = Automatic; UpdatedDate = ctx.Now } true ctx.Conn + do! PrayerRequests.updateExpiration { req with Expiration = Automatic; UpdatedDate = ctx.Now } true 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 @@ -224,7 +226,7 @@ let restore reqId : HttpHandler = requireAccess [ User ] >=> fun next ctx -> tas open System.Threading.Tasks -/// POST /prayer-request/save +// POST /prayer-request/save let save : HttpHandler = requireAccess [ User ] >=> validateCsrf >=> fun next ctx -> task { match! ctx.TryBindFormAsync () with | Ok model -> @@ -237,7 +239,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) ctx.Conn + else PrayerRequests.tryById (idFromShort PrayerRequestId model.RequestId) match req with | Some pr when pr.SmallGroupId = group.Id -> let now = SmallGroup.localDateNow ctx.Clock group @@ -257,7 +259,7 @@ 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 ctx.Conn + do! PrayerRequests.save updated let act = if model.IsNew then "Added" else "Updated" addInfo ctx ctx.Strings["Successfully {0} prayer request", ctx.Strings[act].Value.ToLower ()] return! redirectTo false "/prayer-requests" next ctx @@ -266,7 +268,7 @@ let save : HttpHandler = requireAccess [ User ] >=> validateCsrf >=> fun next ct | Result.Error e -> return! bindError e next ctx } -/// GET /prayer-request/view/[date?] +// GET /prayer-request/view/[date?] let view date : HttpHandler = requireAccess [ User; Group ] >=> fun next ctx -> task { let! list = generateRequestList ctx (parseListDate date) return! diff --git a/src/PrayerTracker/PrayerTracker.fsproj b/src/PrayerTracker/PrayerTracker.fsproj index 6864a3d..583871d 100644 --- a/src/PrayerTracker/PrayerTracker.fsproj +++ b/src/PrayerTracker/PrayerTracker.fsproj @@ -2,7 +2,7 @@ Exe - True + False False @@ -24,10 +24,9 @@ - - - - + + + diff --git a/src/PrayerTracker/SmallGroup.fs b/src/PrayerTracker/SmallGroup.fs index 2b16b32..3629d55 100644 --- a/src/PrayerTracker/SmallGroup.fs +++ b/src/PrayerTracker/SmallGroup.fs @@ -7,21 +7,20 @@ open PrayerTracker.Data open PrayerTracker.Entities open PrayerTracker.ViewModels -/// GET /small-group/announcement +// GET /small-group/announcement let announcement : HttpHandler = requireAccess [ User ] >=> fun next ctx -> { viewInfo ctx with HelpLink = Some Help.sendAnnouncement } |> Views.SmallGroup.announcement ctx.Session.CurrentUser.Value.IsAdmin ctx |> renderHtml next ctx -/// POST /small-group/[group-id]/delete +// POST /small-group/[group-id]/delete let delete grpId : HttpHandler = requireAccess [ Admin ] >=> validateCsrf >=> fun next ctx -> task { let groupId = SmallGroupId grpId - let conn = ctx.Conn - match! SmallGroups.tryById groupId conn with + match! SmallGroups.tryById groupId with | Some grp -> - let! reqs = PrayerRequests.countByGroup groupId conn - let! users = Users.countByGroup groupId conn - do! SmallGroups.deleteById groupId conn + let! reqs = PrayerRequests.countByGroup groupId + let! users = Users.countByGroup groupId + do! SmallGroups.deleteById groupId addInfo ctx ctx.Strings["The group “{0}” and its {1} prayer request(s) were deleted successfully; revoked access from {2} user(s)", grp.Name, reqs, users] @@ -29,22 +28,22 @@ let delete grpId : HttpHandler = requireAccess [ Admin ] >=> validateCsrf >=> fu | None -> return! fourOhFour ctx } -/// POST /small-group/member/[member-id]/delete +// POST /small-group/member/[member-id]/delete let deleteMember mbrId : HttpHandler = requireAccess [ User ] >=> validateCsrf >=> fun next ctx -> task { let group = ctx.Session.CurrentGroup.Value let memberId = MemberId mbrId - match! Members.tryById memberId ctx.Conn with + match! Members.tryById memberId with | Some mbr when mbr.SmallGroupId = group.Id -> - do! Members.deleteById memberId ctx.Conn + do! Members.deleteById memberId addHtmlInfo ctx ctx.Strings["The group member “{0}” was deleted successfully", mbr.Name] return! redirectTo false "/small-group/members" next ctx | Some _ | None -> return! fourOhFour ctx } -/// GET /small-group/[group-id]/edit +// GET /small-group/[group-id]/edit let edit grpId : HttpHandler = requireAccess [ Admin ] >=> fun next ctx -> task { - let! churches = Churches.all ctx.Conn + let! churches = Churches.all () let groupId = SmallGroupId grpId if groupId.Value = Guid.Empty then return! @@ -52,7 +51,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 ctx.Conn with + match! SmallGroups.tryById groupId with | Some grp -> return! viewInfo ctx @@ -61,7 +60,7 @@ let edit grpId : HttpHandler = requireAccess [ Admin ] >=> fun next ctx -> task | None -> return! fourOhFour ctx } -/// GET /small-group/member/[member-id]/edit +// GET /small-group/member/[member-id]/edit let editMember mbrId : HttpHandler = requireAccess [ User ] >=> fun next ctx -> task { let group = ctx.Session.CurrentGroup.Value let types = ReferenceList.emailTypeList group.Preferences.DefaultEmailType ctx.Strings @@ -72,7 +71,7 @@ let editMember mbrId : HttpHandler = requireAccess [ User ] >=> fun next ctx -> |> Views.SmallGroup.editMember EditMember.empty types ctx |> renderHtml next ctx else - match! Members.tryById memberId ctx.Conn with + match! Members.tryById memberId with | Some mbr when mbr.SmallGroupId = group.Id -> return! viewInfo ctx @@ -82,9 +81,9 @@ let editMember mbrId : HttpHandler = requireAccess [ User ] >=> fun next ctx -> | None -> return! fourOhFour ctx } -/// GET /small-group/log-on/[group-id?] +// GET /small-group/log-on/[group-id?] let logOn grpId : HttpHandler = requireAccess [ AccessLevel.Public ] >=> fun next ctx -> task { - let! groups = SmallGroups.listProtected ctx.Conn + let! groups = SmallGroups.listProtected () let groupId = match grpId with Some gid -> shortGuid gid | None -> "" return! { viewInfo ctx with HelpLink = Some Help.logOn } @@ -96,11 +95,11 @@ open System.Security.Claims open Microsoft.AspNetCore.Authentication open Microsoft.AspNetCore.Authentication.Cookies -/// POST /small-group/log-on/submit +// POST /small-group/log-on/submit let logOnSubmit : HttpHandler = requireAccess [ AccessLevel.Public ] >=> validateCsrf >=> fun next ctx -> task { match! ctx.TryBindFormAsync () with | Ok model -> - match! SmallGroups.logOn (idFromShort SmallGroupId model.SmallGroupId) model.Password ctx.Conn with + match! SmallGroups.logOn (idFromShort SmallGroupId model.SmallGroupId) model.Password with | Some group -> ctx.Session.CurrentGroup <- Some group let identity = ClaimsIdentity ( @@ -119,19 +118,19 @@ let logOnSubmit : HttpHandler = requireAccess [ AccessLevel.Public ] >=> validat | Result.Error e -> return! bindError e next ctx } -/// GET /small-groups +// GET /small-groups let maintain : HttpHandler = requireAccess [ Admin ] >=> fun next ctx -> task { - let! groups = SmallGroups.infoForAll ctx.Conn + let! groups = SmallGroups.infoForAll () return! viewInfo ctx |> Views.SmallGroup.maintain groups ctx |> renderHtml next ctx } -/// GET /small-group/members +// GET /small-group/members let members : HttpHandler = requireAccess [ User ] >=> fun next ctx -> task { let group = ctx.Session.CurrentGroup.Value - let! members = Members.forGroup group.Id ctx.Conn + let! members = Members.forGroup group.Id let types = ReferenceList.emailTypeList group.Preferences.DefaultEmailType ctx.Strings |> Map.ofSeq return! { viewInfo ctx with HelpLink = Some Help.maintainGroupMembers } @@ -139,20 +138,19 @@ let members : HttpHandler = requireAccess [ User ] >=> fun next ctx -> task { |> renderHtml next ctx } -/// GET /small-group +// GET /small-group let overview : HttpHandler = requireAccess [ User ] >=> fun next ctx -> task { let group = ctx.Session.CurrentGroup.Value - let conn = ctx.Conn let! reqs = PrayerRequests.forGroup { SmallGroup = group Clock = ctx.Clock ListDate = None ActiveOnly = true PageNumber = 0 - } conn - let! reqCount = PrayerRequests.countByGroup group.Id conn - let! mbrCount = Members.countByGroup group.Id conn - let! admins = Users.listByGroupId group.Id conn + } + let! reqCount = PrayerRequests.countByGroup group.Id + let! mbrCount = Members.countByGroup group.Id + let! admins = Users.listByGroupId group.Id let model = { TotalActiveReqs = List.length reqs AllReqs = reqCount @@ -173,7 +171,7 @@ let overview : HttpHandler = requireAccess [ User ] >=> fun next ctx -> task { |> renderHtml next ctx } -/// GET /small-group/preferences +// GET /small-group/preferences let preferences : HttpHandler = requireAccess [ User ] >=> fun next ctx -> task { return! { viewInfo ctx with HelpLink = Some Help.groupPreferences } @@ -183,16 +181,16 @@ let preferences : HttpHandler = requireAccess [ User ] >=> fun next ctx -> task open System.Threading.Tasks -/// POST /small-group/save +// POST /small-group/save let save : HttpHandler = requireAccess [ Admin ] >=> validateCsrf >=> fun next ctx -> task { match! ctx.TryBindFormAsync () with | Ok model -> let! tryGroup = if model.IsNew then Task.FromResult (Some { SmallGroup.empty with Id = (Guid.NewGuid >> SmallGroupId) () }) - else SmallGroups.tryById (idFromShort SmallGroupId model.SmallGroupId) ctx.Conn + else SmallGroups.tryById (idFromShort SmallGroupId model.SmallGroupId) match tryGroup with | Some group -> - do! SmallGroups.save (model.populateGroup group) model.IsNew ctx.Conn + do! SmallGroups.save (model.populateGroup group) model.IsNew 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 @@ -200,7 +198,7 @@ let save : HttpHandler = requireAccess [ Admin ] >=> validateCsrf >=> fun next c | Result.Error e -> return! bindError e next ctx } -/// POST /small-group/member/save +// POST /small-group/member/save let saveMember : HttpHandler = requireAccess [ User ] >=> validateCsrf >=> fun next ctx -> task { match! ctx.TryBindFormAsync () with | Ok model -> @@ -208,7 +206,7 @@ let saveMember : HttpHandler = requireAccess [ User ] >=> validateCsrf >=> fun n 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) ctx.Conn + else Members.tryById (idFromShort MemberId model.MemberId) match tryMbr with | Some mbr when mbr.SmallGroupId = group.Id -> do! Members.save @@ -216,7 +214,7 @@ let saveMember : HttpHandler = requireAccess [ User ] >=> validateCsrf >=> fun n Name = model.Name Email = model.Email Format = String.noneIfBlank model.Format |> Option.map EmailFormat.fromCode - } 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 @@ -225,18 +223,18 @@ let saveMember : HttpHandler = requireAccess [ User ] >=> validateCsrf >=> fun n | Result.Error e -> return! bindError e next ctx } -/// POST /small-group/preferences/save +// POST /small-group/preferences/save let savePreferences : HttpHandler = requireAccess [ User ] >=> validateCsrf >=> fun next ctx -> task { match! ctx.TryBindFormAsync () with | Ok model -> // Since the class is stored in the session, we'll use an intermediate instance to persist it; once that works, // we can repopulate the session instance. That way, if the update fails, the page should still show the // database values, not the then out-of-sync session ones. - let group = ctx.Session.CurrentGroup.Value - match! SmallGroups.tryByIdWithPreferences group.Id ctx.Conn with + let group = ctx.Session.CurrentGroup.Value + match! SmallGroups.tryByIdWithPreferences group.Id with | Some group -> let pref = model.PopulatePreferences group.Preferences - do! SmallGroups.savePreferences pref ctx.Conn + do! SmallGroups.savePreferences pref // Refresh session instance ctx.Session.CurrentGroup <- Some { group with Preferences = pref } addInfo ctx ctx.Strings["Group preferences updated successfully"] @@ -247,8 +245,9 @@ let savePreferences : HttpHandler = requireAccess [ User ] >=> validateCsrf >=> open Giraffe.ViewEngine open PrayerTracker.Views.CommonFunctions +open Microsoft.Extensions.Configuration -/// POST /small-group/announcement/send +// POST /small-group/announcement/send let sendAnnouncement : HttpHandler = requireAccess [ User ] >=> validateCsrf >=> fun next ctx -> task { match! ctx.TryBindFormAsync () with | Ok model -> @@ -266,11 +265,11 @@ let sendAnnouncement : HttpHandler = requireAccess [ User ] >=> validateCsrf >=> // Send the e-mails let! recipients = task { if model.SendToClass = "N" && usr.IsAdmin then - let! users = Users.all ctx.Conn + let! users = Users.all () return users |> List.map (fun u -> { Member.empty with Name = u.Name; Email = u.Email }) - else return! Members.forGroup group.Id ctx.Conn + else return! Members.forGroup group.Id } - use! client = Email.getConnection () + use! client = Email.getConnection (ctx.GetService ()) do! Email.sendEmails { Client = client Recipients = recipients @@ -297,7 +296,7 @@ let sendAnnouncement : HttpHandler = requireAccess [ User ] >=> validateCsrf >=> Text = requestText EnteredDate = now.Date.AtStartOfDayInZone(zone).ToInstant() UpdatedDate = now.InZoneLeniently(zone).ToInstant() - } ctx.Conn + } // Tell 'em what they've won, Johnny! let toWhom = if model.SendToClass = "N" then s["{0} users", s["PrayerTracker"]].Value diff --git a/src/PrayerTracker/User.fs b/src/PrayerTracker/User.fs index 56b865b..f3828eb 100644 --- a/src/PrayerTracker/User.fs +++ b/src/PrayerTracker/User.fs @@ -9,6 +9,8 @@ open PrayerTracker.Data open PrayerTracker.Entities open PrayerTracker.ViewModels +#nowarn "44" // The default Rfc2898DeriveBytes is used to identify passwords to be upgraded + /// Password hashing implementation extending ASP.NET Core's identity implementation [] module Hashing = @@ -53,15 +55,15 @@ module Hashing = /// Retrieve a user from the database by password, upgrading password hashes if required -let private findUserByPassword model conn = task { - match! Users.tryByEmailAndGroup model.Email (idFromShort SmallGroupId model.SmallGroupId) conn with +let private findUserByPassword model = task { + match! Users.tryByEmailAndGroup model.Email (idFromShort SmallGroupId model.SmallGroupId) with | Some user -> let hasher = PrayerTrackerPasswordHasher () match hasher.VerifyHashedPassword (user, user.PasswordHash, model.Password) with | PasswordVerificationResult.Success -> return Some user | PasswordVerificationResult.SuccessRehashNeeded -> let upgraded = { user with PasswordHash = hasher.HashPassword (user, model.Password) } - do! Users.updatePassword upgraded conn + do! Users.updatePassword upgraded return Some upgraded | _ -> return None | None -> return None @@ -74,14 +76,14 @@ let sanitizeUrl providedUrl defaultUrl = elif Seq.exists Char.IsControl url then defaultUrl else url -/// POST /user/password/change +// POST /user/password/change let changePassword : HttpHandler = requireAccess [ User ] >=> validateCsrf >=> fun next ctx -> task { match! ctx.TryBindFormAsync () with | Ok model -> let curUsr = ctx.Session.CurrentUser.Value let hasher = PrayerTrackerPasswordHasher () let! user = task { - match! Users.tryById curUsr.Id ctx.Conn with + match! Users.tryById curUsr.Id with | Some usr -> if hasher.VerifyHashedPassword (usr, usr.PasswordHash, model.OldPassword) = PasswordVerificationResult.Success then @@ -91,7 +93,7 @@ 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) } ctx.Conn + do! Users.updatePassword { usr with PasswordHash = hasher.HashPassword (usr, model.NewPassword) } addInfo ctx ctx.Strings["Your password was changed successfully"] return! redirectTo false "/" next ctx | Some _ -> @@ -103,12 +105,12 @@ let changePassword : HttpHandler = requireAccess [ User ] >=> validateCsrf >=> f | Result.Error e -> return! bindError e next ctx } -/// POST /user/[user-id]/delete +// POST /user/[user-id]/delete let delete usrId : HttpHandler = requireAccess [ Admin ] >=> validateCsrf >=> fun next ctx -> task { let userId = UserId usrId - match! Users.tryById userId ctx.Conn with + match! Users.tryById userId with | Some user -> - do! Users.deleteById userId ctx.Conn + do! Users.deleteById userId addInfo ctx ctx.Strings["Successfully deleted user {0}", user.Name] return! redirectTo false "/users" next ctx | _ -> return! fourOhFour ctx @@ -120,14 +122,14 @@ open Microsoft.AspNetCore.Authentication open Microsoft.AspNetCore.Authentication.Cookies open Microsoft.AspNetCore.Html -/// POST /user/log-on +// POST /user/log-on let doLogOn : HttpHandler = requireAccess [ AccessLevel.Public ] >=> validateCsrf >=> fun next ctx -> task { match! ctx.TryBindFormAsync () with | Ok model -> let s = ctx.Strings - match! findUserByPassword model ctx.Conn with + match! findUserByPassword model with | Some user -> - match! SmallGroups.tryByIdWithPreferences (idFromShort SmallGroupId model.SmallGroupId) ctx.Conn with + match! SmallGroups.tryByIdWithPreferences (idFromShort SmallGroupId model.SmallGroupId) with | Some group -> ctx.Session.CurrentUser <- Some user ctx.Session.CurrentGroup <- Some group @@ -141,7 +143,7 @@ let doLogOn : HttpHandler = requireAccess [ AccessLevel.Public ] >=> validateCsr AuthenticationProperties ( IssuedUtc = DateTimeOffset.UtcNow, IsPersistent = defaultArg model.RememberMe false)) - do! Users.updateLastSeen user.Id ctx.Now ctx.Conn + do! Users.updateLastSeen user.Id ctx.Now 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 @@ -163,7 +165,7 @@ let doLogOn : HttpHandler = requireAccess [ AccessLevel.Public ] >=> validateCsr | Result.Error e -> return! bindError e next ctx } -/// GET /user/[user-id]/edit +// GET /user/[user-id]/edit let edit usrId : HttpHandler = requireAccess [ Admin ] >=> fun next ctx -> task { let userId = UserId usrId if userId.Value = Guid.Empty then @@ -172,7 +174,7 @@ let edit usrId : HttpHandler = requireAccess [ Admin ] >=> fun next ctx -> task |> Views.User.edit EditUser.empty ctx |> renderHtml next ctx else - match! Users.tryById userId ctx.Conn with + match! Users.tryById userId with | Some user -> return! viewInfo ctx @@ -181,9 +183,9 @@ let edit usrId : HttpHandler = requireAccess [ Admin ] >=> fun next ctx -> task | _ -> return! fourOhFour ctx } -/// GET /user/log-on +// GET /user/log-on let logOn : HttpHandler = requireAccess [ AccessLevel.Public ] >=> fun next ctx -> task { - let! groups = SmallGroups.listAll ctx.Conn + let! groups = SmallGroups.listAll () let url = Option.ofObj <| ctx.Session.GetString Key.Session.redirectUrl match url with | Some _ -> @@ -196,16 +198,16 @@ let logOn : HttpHandler = requireAccess [ AccessLevel.Public ] >=> fun next ctx |> renderHtml next ctx } -/// GET /users +// GET /users let maintain : HttpHandler = requireAccess [ Admin ] >=> fun next ctx -> task { - let! users = Users.all ctx.Conn + let! users = Users.all () return! viewInfo ctx |> Views.User.maintain users ctx |> renderHtml next ctx } -/// GET /user/password +// GET /user/password let password : HttpHandler = requireAccess [ User ] >=> fun next ctx -> { viewInfo ctx with HelpLink = Some Help.changePassword } |> Views.User.changePassword ctx @@ -213,18 +215,18 @@ let password : HttpHandler = requireAccess [ User ] >=> fun next ctx -> open System.Threading.Tasks -/// POST /user/save +// POST /user/save let save : HttpHandler = requireAccess [ Admin ] >=> validateCsrf >=> fun next ctx -> task { match! ctx.TryBindFormAsync () with | Ok model -> let! user = if model.IsNew then Task.FromResult (Some { User.empty with Id = (Guid.NewGuid >> UserId) () }) - else Users.tryById (idFromShort UserId model.UserId) ctx.Conn + else Users.tryById (idFromShort UserId model.UserId) match user with | Some usr -> let hasher = PrayerTrackerPasswordHasher () let updatedUser = model.PopulateUser usr (fun pw -> hasher.HashPassword (usr, pw)) - do! Users.save updatedUser ctx.Conn + do! Users.save updatedUser let s = ctx.Strings if model.IsNew then let h = CommonFunctions.htmlString @@ -244,7 +246,7 @@ let save : HttpHandler = requireAccess [ Admin ] >=> validateCsrf >=> fun next c | Result.Error e -> return! bindError e next ctx } -/// POST /user/small-groups/save +// POST /user/small-groups/save let saveGroups : HttpHandler = requireAccess [ Admin ] >=> validateCsrf >=> fun next ctx -> task { match! ctx.TryBindFormAsync () with | Ok model -> @@ -254,19 +256,19 @@ let saveGroups : HttpHandler = requireAccess [ Admin ] >=> validateCsrf >=> fun return! redirectTo false $"/user/{model.UserId}/small-groups" next ctx | _ -> do! Users.updateSmallGroups (idFromShort UserId model.UserId) - (model.SmallGroups.Split ',' |> Array.map (idFromShort SmallGroupId) |> List.ofArray) ctx.Conn + (model.SmallGroups.Split ',' |> Array.map (idFromShort SmallGroupId) |> List.ofArray) 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 +// GET /user/[user-id]/small-groups let smallGroups usrId : HttpHandler = requireAccess [ Admin ] >=> fun next ctx -> task { let userId = UserId usrId - match! Users.tryById userId ctx.Conn with + match! Users.tryById userId with | Some user -> - let! groups = SmallGroups.listAll ctx.Conn - let! groupIds = Users.groupIdsByUserId userId ctx.Conn + let! groups = SmallGroups.listAll () + let! groupIds = Users.groupIdsByUserId userId let curGroups = groupIds |> List.map (fun g -> shortGuid g.Value) return! viewInfo ctx