From f068d20612286978ef7fdf7661107da90638281f Mon Sep 17 00:00:00 2001 From: "Daniel J. Summers" Date: Mon, 1 Aug 2022 21:57:55 -0400 Subject: [PATCH] Use short GUIDs in URLs and forms (#1) - Fully implement single-case DUs for previously aliased IDs - Capitalize entity data items --- src/PrayerTracker.Data/DataAccess.fs | 165 ++-- src/PrayerTracker.Data/Entities.fs | 739 +++++++++++------- .../PrayerTracker.Data.fsproj | 1 + src/PrayerTracker.Tests/Data/EntitiesTests.fs | 212 ++--- .../UI/CommonFunctionsTests.fs | 15 +- src/PrayerTracker.Tests/UI/ViewModelsTests.fs | 298 +++---- src/PrayerTracker.UI/Church.fs | 19 +- src/PrayerTracker.UI/CommonFunctions.fs | 14 +- src/PrayerTracker.UI/Layout.fs | 8 +- src/PrayerTracker.UI/PrayerRequest.fs | 46 +- src/PrayerTracker.UI/SmallGroup.fs | 43 +- src/PrayerTracker.UI/User.fs | 9 +- src/PrayerTracker.UI/Utils.fs | 13 +- src/PrayerTracker.UI/ViewModels.fs | 385 +++++---- src/PrayerTracker/Church.fs | 32 +- src/PrayerTracker/CommonFunctions.fs | 17 +- src/PrayerTracker/Email.fs | 12 +- src/PrayerTracker/PrayerRequest.fs | 64 +- src/PrayerTracker/SmallGroup.fs | 134 ++-- src/PrayerTracker/User.fs | 107 +-- 20 files changed, 1248 insertions(+), 1085 deletions(-) diff --git a/src/PrayerTracker.Data/DataAccess.fs b/src/PrayerTracker.Data/DataAccess.fs index 95065fb..23dbd29 100644 --- a/src/PrayerTracker.Data/DataAccess.fs +++ b/src/PrayerTracker.Data/DataAccess.fs @@ -11,13 +11,13 @@ module private Helpers = let reqSort sort (q : IQueryable) = match sort with | SortByDate -> - q.OrderByDescending(fun req -> req.updatedDate) - .ThenByDescending(fun req -> req.enteredDate) - .ThenBy (fun req -> req.requestor) + q.OrderByDescending(fun req -> req.UpdatedDate) + .ThenByDescending(fun req -> req.EnteredDate) + .ThenBy (fun req -> req.Requestor) | SortByRequestor -> - q.OrderBy(fun req -> req.requestor) - .ThenByDescending(fun req -> req.updatedDate) - .ThenByDescending (fun req -> req.enteredDate) + q.OrderBy(fun req -> req.Requestor) + .ThenByDescending(fun req -> req.UpdatedDate) + .ThenByDescending (fun req -> req.EnteredDate) /// Paginate a prayer request query let paginate (pageNbr : int) pageSize (q : IQueryable) = @@ -48,44 +48,44 @@ type AppDbContext with (*-- CHURCH EXTENSIONS --*) /// Find a church by its Id - member this.TryChurchById cId = backgroundTask { - let! church = this.Churches.SingleOrDefaultAsync (fun ch -> ch.churchId = cId) + member this.TryChurchById churchId = backgroundTask { + let! church = this.Churches.SingleOrDefaultAsync (fun ch -> ch.Id = churchId) return Option.fromObject church } /// Find all churches member this.AllChurches () = backgroundTask { - let! churches = this.Churches.OrderBy(fun ch -> ch.name).ToListAsync () + let! churches = this.Churches.OrderBy(fun ch -> ch.Name).ToListAsync () return List.ofSeq churches } (*-- MEMBER EXTENSIONS --*) /// Get a small group member by its Id - member this.TryMemberById mbrId = backgroundTask { - let! mbr = this.Members.SingleOrDefaultAsync (fun m -> m.memberId = mbrId) + member this.TryMemberById memberId = backgroundTask { + let! mbr = this.Members.SingleOrDefaultAsync (fun m -> m.Id = memberId) return Option.fromObject mbr } /// Find all members for a small group - member this.AllMembersForSmallGroup gId = backgroundTask { + member this.AllMembersForSmallGroup groupId = backgroundTask { let! members = - this.Members.Where(fun mbr -> mbr.smallGroupId = gId) - .OrderBy(fun mbr -> mbr.memberName) + this.Members.Where(fun mbr -> mbr.SmallGroupId = groupId) + .OrderBy(fun mbr -> mbr.Name) .ToListAsync () return List.ofSeq members } /// Count members for a small group - member this.CountMembersForSmallGroup gId = backgroundTask { - return! this.Members.CountAsync (fun m -> m.smallGroupId = gId) + member this.CountMembersForSmallGroup groupId = backgroundTask { + return! this.Members.CountAsync (fun m -> m.SmallGroupId = groupId) } (*-- PRAYER REQUEST EXTENSIONS --*) /// Get a prayer request by its Id member this.TryRequestById reqId = backgroundTask { - let! req = this.PrayerRequests.SingleOrDefaultAsync (fun r -> r.prayerRequestId = reqId) + let! req = this.PrayerRequests.SingleOrDefaultAsync (fun r -> r.Id = reqId) return Option.fromObject req } @@ -93,31 +93,31 @@ type AppDbContext with member this.AllRequestsForSmallGroup (grp : SmallGroup) clock listDate activeOnly pageNbr = backgroundTask { let theDate = match listDate with Some dt -> dt | _ -> grp.localDateNow clock let query = - this.PrayerRequests.Where(fun req -> req.smallGroupId = grp.smallGroupId) + this.PrayerRequests.Where(fun req -> req.SmallGroupId = grp.Id) |> function | q when activeOnly -> - let asOf = DateTime (theDate.AddDays(-(float grp.preferences.daysToExpire)).Date.Ticks, DateTimeKind.Utc) + let asOf = DateTime (theDate.AddDays(-(float grp.Preferences.DaysToExpire)).Date.Ticks, DateTimeKind.Utc) q.Where(fun req -> - ( req.updatedDate > asOf - || req.expiration = Manual - || req.requestType = LongTermRequest - || req.requestType = Expecting) - && req.expiration <> Forced) - |> reqSort grp.preferences.requestSort - |> paginate pageNbr grp.preferences.pageSize - | q -> reqSort grp.preferences.requestSort q + ( req.UpdatedDate > asOf + || req.Expiration = Manual + || req.RequestType = LongTermRequest + || req.RequestType = Expecting) + && req.Expiration <> Forced) + |> reqSort grp.Preferences.RequestSort + |> paginate pageNbr grp.Preferences.PageSize + | q -> reqSort grp.Preferences.RequestSort q let! reqs = query.ToListAsync () return List.ofSeq reqs } /// Count prayer requests for the given small group Id - member this.CountRequestsBySmallGroup gId = backgroundTask { - return! this.PrayerRequests.CountAsync (fun pr -> pr.smallGroupId = gId) + member this.CountRequestsBySmallGroup groupId = backgroundTask { + return! this.PrayerRequests.CountAsync (fun pr -> pr.SmallGroupId = groupId) } /// Count prayer requests for the given church Id - member this.CountRequestsByChurch cId = backgroundTask { - return! this.PrayerRequests.CountAsync (fun pr -> pr.smallGroup.churchId = cId) + member this.CountRequestsByChurch churchId = backgroundTask { + return! this.PrayerRequests.CountAsync (fun pr -> pr.SmallGroup.ChurchId = churchId) } /// Get all (or active) requests for a small group as of now or the specified date @@ -128,9 +128,9 @@ type AppDbContext with SELECT * FROM pt."PrayerRequest" WHERE "SmallGroupId" = {0} AND COALESCE("Requestor", '') ILIKE {1}""" let like = sprintf "%%%s%%" let query = - this.PrayerRequests.FromSqlRaw(sql, grp.smallGroupId, like searchTerm) - |> reqSort grp.preferences.requestSort - |> paginate pageNbr grp.preferences.pageSize + this.PrayerRequests.FromSqlRaw(sql, grp.Id, like searchTerm) + |> reqSort grp.Preferences.RequestSort + |> paginate pageNbr grp.Preferences.PageSize let! reqs = query.ToListAsync () return List.ofSeq reqs } @@ -138,21 +138,21 @@ type AppDbContext with (*-- SMALL GROUP EXTENSIONS --*) /// Find a small group by its Id - member this.TryGroupById gId = backgroundTask { + member this.TryGroupById groupId = backgroundTask { let! grp = - this.SmallGroups.Include(fun sg -> sg.preferences) - .SingleOrDefaultAsync (fun sg -> sg.smallGroupId = gId) + this.SmallGroups.Include(fun sg -> sg.Preferences) + .SingleOrDefaultAsync (fun sg -> sg.Id = groupId) return Option.fromObject grp } /// Get small groups that are public or password protected member this.PublicAndProtectedGroups () = backgroundTask { let! groups = - this.SmallGroups.Include(fun sg -> sg.preferences).Include(fun sg -> sg.church) + this.SmallGroups.Include(fun sg -> sg.Preferences).Include(fun sg -> sg.Church) .Where(fun sg -> - sg.preferences.isPublic - || (sg.preferences.groupPassword <> null && sg.preferences.groupPassword <> "")) - .OrderBy(fun sg -> sg.church.name).ThenBy(fun sg -> sg.name) + sg.Preferences.IsPublic + || (sg.Preferences.GroupPassword <> null && sg.Preferences.GroupPassword <> "")) + .OrderBy(fun sg -> sg.Church.Name).ThenBy(fun sg -> sg.Name) .ToListAsync () return List.ofSeq groups } @@ -160,9 +160,9 @@ type AppDbContext with /// Get small groups that are password protected member this.ProtectedGroups () = backgroundTask { let! groups = - this.SmallGroups.Include(fun sg -> sg.church) - .Where(fun sg -> sg.preferences.groupPassword <> null && sg.preferences.groupPassword <> "") - .OrderBy(fun sg -> sg.church.name).ThenBy(fun sg -> sg.name) + this.SmallGroups.Include(fun sg -> sg.Church) + .Where(fun sg -> sg.Preferences.GroupPassword <> null && sg.Preferences.GroupPassword <> "") + .OrderBy(fun sg -> sg.Church.Name).ThenBy(fun sg -> sg.Name) .ToListAsync () return List.ofSeq groups } @@ -171,10 +171,10 @@ type AppDbContext with member this.AllGroups () = backgroundTask { let! groups = this.SmallGroups - .Include(fun sg -> sg.church) - .Include(fun sg -> sg.preferences) - .Include(fun sg -> sg.preferences.timeZone) - .OrderBy(fun sg -> sg.name) + .Include(fun sg -> sg.Church) + .Include(fun sg -> sg.Preferences) + .Include(fun sg -> sg.Preferences.TimeZone) + .OrderBy(fun sg -> sg.Name) .ToListAsync () return List.ofSeq groups } @@ -182,88 +182,89 @@ type AppDbContext with /// Get a small group list by their Id, with their church prepended to their name member this.GroupList () = backgroundTask { let! groups = - this.SmallGroups.Include(fun sg -> sg.church) - .OrderBy(fun sg -> sg.church.name).ThenBy(fun sg -> sg.name) + this.SmallGroups.Include(fun sg -> sg.Church) + .OrderBy(fun sg -> sg.Church.Name).ThenBy(fun sg -> sg.Name) .ToListAsync () - return groups - |> Seq.map (fun sg -> sg.smallGroupId.ToString "N", $"{sg.church.name} | {sg.name}") - |> List.ofSeq + return + groups + |> Seq.map (fun sg -> Giraffe.ShortGuid.fromGuid sg.Id.Value, $"{sg.Church.Name} | {sg.Name}") + |> List.ofSeq } /// Log on a small group - member this.TryGroupLogOnByPassword gId pw = backgroundTask { - match! this.TryGroupById gId with - | None -> return None - | Some grp -> return if pw = grp.preferences.groupPassword then Some grp else None + member this.TryGroupLogOnByPassword groupId pw = backgroundTask { + match! this.TryGroupById groupId with + | Some grp when pw = grp.Preferences.GroupPassword -> return Some grp + | _ -> return None } /// Check a cookie log on for a small group - member this.TryGroupLogOnByCookie gId pwHash (hasher : string -> string) = backgroundTask { - match! this.TryGroupById gId with + member this.TryGroupLogOnByCookie groupId pwHash (hasher : string -> string) = backgroundTask { + match! this.TryGroupById groupId with | None -> return None - | Some grp -> return if pwHash = hasher grp.preferences.groupPassword then Some grp else None + | Some grp -> return if pwHash = hasher grp.Preferences.GroupPassword then Some grp else None } /// Count small groups for the given church Id - member this.CountGroupsByChurch cId = backgroundTask { - return! this.SmallGroups.CountAsync (fun sg -> sg.churchId = cId) + member this.CountGroupsByChurch churchId = backgroundTask { + return! this.SmallGroups.CountAsync (fun sg -> sg.ChurchId = churchId) } (*-- TIME ZONE EXTENSIONS --*) /// Get a time zone by its Id member this.TryTimeZoneById tzId = backgroundTask { - let! zone = this.TimeZones.SingleOrDefaultAsync (fun tz -> tz.timeZoneId = tzId) + let! zone = this.TimeZones.SingleOrDefaultAsync (fun tz -> tz.Id = tzId) return Option.fromObject zone } /// Get all time zones member this.AllTimeZones () = backgroundTask { - let! zones = this.TimeZones.OrderBy(fun tz -> tz.sortOrder).ToListAsync () + let! zones = this.TimeZones.OrderBy(fun tz -> tz.SortOrder).ToListAsync () return List.ofSeq zones } (*-- USER EXTENSIONS --*) /// Find a user by its Id - member this.TryUserById uId = backgroundTask { - let! usr = this.Users.SingleOrDefaultAsync (fun u -> u.userId = uId) + member this.TryUserById userId = backgroundTask { + let! usr = this.Users.SingleOrDefaultAsync (fun u -> u.Id = userId) return Option.fromObject usr } /// Find a user by its e-mail address and authorized small group - member this.TryUserByEmailAndGroup email gId = backgroundTask { + member this.TryUserByEmailAndGroup email groupId = backgroundTask { let! usr = this.Users.SingleOrDefaultAsync (fun u -> - u.emailAddress = email && u.smallGroups.Any (fun xref -> xref.smallGroupId = gId)) + u.Email = email && u.SmallGroups.Any (fun xref -> xref.SmallGroupId = groupId)) return Option.fromObject usr } /// Find a user by its Id, eagerly loading the user's groups - member this.TryUserByIdWithGroups uId = backgroundTask { - let! usr = this.Users.Include(fun u -> u.smallGroups).SingleOrDefaultAsync (fun u -> u.userId = uId) + member this.TryUserByIdWithGroups userId = backgroundTask { + let! usr = this.Users.Include(fun u -> u.SmallGroups).SingleOrDefaultAsync (fun u -> u.Id = userId) return Option.fromObject usr } /// Get a list of all users member this.AllUsers () = backgroundTask { - let! users = this.Users.OrderBy(fun u -> u.lastName).ThenBy(fun u -> u.firstName).ToListAsync () + let! users = this.Users.OrderBy(fun u -> u.LastName).ThenBy(fun u -> u.FirstName).ToListAsync () return List.ofSeq users } /// Get all PrayerTracker users as members (used to send e-mails) member this.AllUsersAsMembers () = backgroundTask { let! users = this.AllUsers () - return users |> List.map (fun u -> { Member.empty with email = u.emailAddress; memberName = u.fullName }) + return users |> List.map (fun u -> { Member.empty with Email = u.Email; Name = u.fullName }) } /// Find a user based on their credentials - member this.TryUserLogOnByPassword email pwHash gId = backgroundTask { + member this.TryUserLogOnByPassword email pwHash groupId = backgroundTask { let! usr = this.Users.SingleOrDefaultAsync (fun u -> - u.emailAddress = email - && u.passwordHash = pwHash - && u.smallGroups.Any (fun xref -> xref.smallGroupId = gId)) + u.Email = email + && u.PasswordHash = pwHash + && u.SmallGroups.Any (fun xref -> xref.SmallGroupId = groupId)) return Option.fromObject usr } @@ -272,17 +273,17 @@ type AppDbContext with match! this.TryUserByIdWithGroups uId with | None -> return None | Some usr -> - if pwHash = usr.passwordHash && usr.smallGroups |> Seq.exists (fun xref -> xref.smallGroupId = gId) then - return Some { usr with passwordHash = ""; salt = None; smallGroups = List() } + if pwHash = usr.PasswordHash && usr.SmallGroups |> Seq.exists (fun xref -> xref.SmallGroupId = gId) then + return Some { usr with PasswordHash = ""; Salt = None; SmallGroups = List() } else return None } /// Count the number of users for a small group - member this.CountUsersBySmallGroup gId = backgroundTask { - return! this.Users.CountAsync (fun u -> u.smallGroups.Any (fun xref -> xref.smallGroupId = gId)) + member this.CountUsersBySmallGroup groupId = backgroundTask { + return! this.Users.CountAsync (fun u -> u.SmallGroups.Any (fun xref -> xref.SmallGroupId = groupId)) } /// Count the number of users for a church - member this.CountUsersByChurch cId = backgroundTask { - return! this.Users.CountAsync (fun u -> u.smallGroups.Any (fun xref -> xref.smallGroup.churchId = cId)) + member this.CountUsersByChurch churchId = backgroundTask { + return! this.Users.CountAsync (fun u -> u.SmallGroups.Any (fun xref -> xref.SmallGroup.ChurchId = churchId)) } diff --git a/src/PrayerTracker.Data/Entities.fs b/src/PrayerTracker.Data/Entities.fs index 4e64591..a00049b 100644 --- a/src/PrayerTracker.Data/Entities.fs +++ b/src/PrayerTracker.Data/Entities.fs @@ -1,11 +1,5 @@ namespace PrayerTracker.Entities -open FSharp.EFCore.OptionConverter -open Microsoft.EntityFrameworkCore -open NodaTime -open System -open System.Collections.Generic - // fsharplint:disable RecordFieldNames MemberNames (*-- SUPPORT TYPES --*) @@ -18,10 +12,12 @@ type AsOfDateDisplay = | ShortDate /// The as-of date should be displayed in the culture's long date format | LongDate -with + +/// Functions to support as-of date display options +module AsOfDateDisplay = /// Convert to a DU case from a single-character string - static member fromCode code = + let fromCode code = match code with | "N" -> NoDisplay | "S" -> ShortDate @@ -29,11 +25,7 @@ with | _ -> invalidArg "code" $"Unknown code {code}" /// Convert this DU case to a single-character string - member this.code = - match this with - | NoDisplay -> "N" - | ShortDate -> "S" - | LongDate -> "L" + let toCode = function NoDisplay -> "N" | ShortDate -> "S" | LongDate -> "L" /// Acceptable e-mail formats @@ -42,20 +34,19 @@ type EmailFormat = | HtmlFormat /// Plain-text e-mail | PlainTextFormat -with + +/// Functions to support e-mail formats +module EmailFormat = /// Convert to a DU case from a single-character string - static member fromCode code = + let fromCode code = match code with | "H" -> HtmlFormat | "P" -> PlainTextFormat | _ -> invalidArg "code" $"Unknown code {code}" /// Convert this DU case to a single-character string - member this.code = - match this with - | HtmlFormat -> "H" - | PlainTextFormat -> "P" + let toCode = function HtmlFormat -> "H" | PlainTextFormat -> "P" /// Expiration for requests @@ -66,10 +57,12 @@ type Expiration = | Manual /// Force immediate expiration | Forced -with + +/// Functions to support expirations +module Expiration = /// Convert to a DU case from a single-character string - static member fromCode code = + let fromCode code = match code with | "A" -> Automatic | "M" -> Manual @@ -77,11 +70,7 @@ with | _ -> invalidArg "code" $"Unknown code {code}" /// Convert this DU case to a single-character string - member this.code = - match this with - | Automatic -> "A" - | Manual -> "M" - | Forced -> "F" + let toCode = function Automatic -> "A" | Manual -> "M" | Forced -> "F" /// Types of prayer requests @@ -96,10 +85,12 @@ type PrayerRequestType = | PraiseReport /// Announcements | Announcement -with + +/// Functions to support prayer request types +module PrayerRequestType = /// Convert to a DU case from a single-character string - static member fromCode code = + let fromCode code = match code with | "C" -> CurrentRequest | "L" -> LongTermRequest @@ -109,8 +100,8 @@ with | _ -> invalidArg "code" $"Unknown code {code}" /// Convert this DU case to a single-character string - member this.code = - match this with + let toCode = + function | CurrentRequest -> "C" | LongTermRequest -> "L" | Expecting -> "E" @@ -124,20 +115,71 @@ type RequestSort = | SortByDate /// Sort by requestor/subject, then by date | SortByRequestor -with + +/// Functions to support request sorts +module RequestSort = /// Convert to a DU case from a single-character string - static member fromCode code = + let fromCode code = match code with | "D" -> SortByDate | "R" -> SortByRequestor | _ -> invalidArg "code" $"Unknown code {code}" /// Convert this DU case to a single-character string - member this.code = - match this with - | SortByDate -> "D" - | SortByRequestor -> "R" + let toCode = function SortByDate -> "D" | SortByRequestor -> "R" + + +open System + +/// PK type for the Church entity +type ChurchId = + | ChurchId of Guid +with + /// The GUID value of the church ID + member this.Value = this |> function ChurchId guid -> guid + + +/// PK type for the Member entity +type MemberId = + | MemberId of Guid +with + /// The GUID value of the member ID + member this.Value = this |> function MemberId guid -> guid + + +/// PK type for the PrayerRequest entity +type PrayerRequestId = + | PrayerRequestId of Guid +with + /// The GUID value of the prayer request ID + member this.Value = this |> function PrayerRequestId guid -> guid + + +/// PK type for the SmallGroup entity +type SmallGroupId = + | SmallGroupId of Guid +with + /// The GUID value of the small group ID + member this.Value = this |> function SmallGroupId guid -> guid + + +/// PK type for the TimeZone entity +type TimeZoneId = TimeZoneId of string + +/// Functions to support time zone IDs +module TimeZoneId = + + /// Convert a time zone ID to its string value + let toString = function TimeZoneId it -> it + + +/// PK type for the User entity +type UserId = + | UserId of Guid +with + /// The GUID value of the user ID + member this.Value = this |> function UserId guid -> guid /// EF Core value converters for the discriminated union types above @@ -148,7 +190,7 @@ module Converters = open System.Linq.Expressions let private asOfFromDU = - <@ Func(fun (x : AsOfDateDisplay) -> x.code) @> + <@ Func(AsOfDateDisplay.toCode) @> |> LeafExpressionConverter.QuotationToExpression |> unbox>> @@ -157,8 +199,18 @@ module Converters = |> LeafExpressionConverter.QuotationToExpression |> unbox>> + let private churchIdFromDU = + <@ Func(fun it -> it.Value) @> + |> LeafExpressionConverter.QuotationToExpression + |> unbox>> + + let private churchIdToDU = + <@ Func(ChurchId) @> + |> LeafExpressionConverter.QuotationToExpression + |> unbox>> + let private emailFromDU = - <@ Func(fun (x : EmailFormat) -> x.code) @> + <@ Func(EmailFormat.toCode) @> |> LeafExpressionConverter.QuotationToExpression |> unbox>> @@ -167,8 +219,20 @@ module Converters = |> LeafExpressionConverter.QuotationToExpression |> unbox>> + let private emailOptionFromDU = + <@ Func(fun opt -> + match opt with Some fmt -> EmailFormat.toCode fmt | None -> null) @> + |> LeafExpressionConverter.QuotationToExpression + |> unbox>> + + let private emailOptionToDU = + <@ Func(fun opt -> + match opt with "" | null -> None | it -> Some (EmailFormat.fromCode it)) @> + |> LeafExpressionConverter.QuotationToExpression + |> unbox>> + let private expFromDU = - <@ Func(fun (x : Expiration) -> x.code) @> + <@ Func(Expiration.toCode) @> |> LeafExpressionConverter.QuotationToExpression |> unbox>> @@ -177,8 +241,38 @@ module Converters = |> LeafExpressionConverter.QuotationToExpression |> unbox>> + let private memberIdFromDU = + <@ Func(fun it -> it.Value) @> + |> LeafExpressionConverter.QuotationToExpression + |> unbox>> + + let private memberIdToDU = + <@ Func(MemberId) @> + |> LeafExpressionConverter.QuotationToExpression + |> unbox>> + + let private prayerReqIdFromDU = + <@ Func(fun it -> it.Value) @> + |> LeafExpressionConverter.QuotationToExpression + |> unbox>> + + let private prayerReqIdToDU = + <@ Func(PrayerRequestId) @> + |> LeafExpressionConverter.QuotationToExpression + |> unbox>> + + let private smallGrpIdFromDU = + <@ Func(fun it -> it.Value) @> + |> LeafExpressionConverter.QuotationToExpression + |> unbox>> + + let private smallGrpIdToDU = + <@ Func(SmallGroupId) @> + |> LeafExpressionConverter.QuotationToExpression + |> unbox>> + let private sortFromDU = - <@ Func(fun (x : RequestSort) -> x.code) @> + <@ Func(RequestSort.toCode) @> |> LeafExpressionConverter.QuotationToExpression |> unbox>> @@ -188,7 +282,7 @@ module Converters = |> unbox>> let private typFromDU = - <@ Func(fun (x : PrayerRequestType) -> x.code) @> + <@ Func(PrayerRequestType.toCode) @> |> LeafExpressionConverter.QuotationToExpression |> unbox>> @@ -197,493 +291,534 @@ module Converters = |> LeafExpressionConverter.QuotationToExpression |> unbox>> + let private tzIdFromDU = + <@ Func(TimeZoneId.toString) @> + |> LeafExpressionConverter.QuotationToExpression + |> unbox>> + + let private tzIdToDU = + <@ Func(TimeZoneId) @> + |> LeafExpressionConverter.QuotationToExpression + |> unbox>> + + let private userIdFromDU = + <@ Func(fun it -> it.Value) @> + |> LeafExpressionConverter.QuotationToExpression + |> unbox>> + + let private userIdToDU = + <@ Func(UserId) @> + |> LeafExpressionConverter.QuotationToExpression + |> unbox>> + /// Conversion between a string and an AsOfDateDisplay DU value type AsOfDateDisplayConverter () = inherit ValueConverter (asOfFromDU, asOfToDU) + /// Conversion between a GUID and a church ID + type ChurchIdConverter () = + inherit ValueConverter (churchIdFromDU, churchIdToDU) + /// Conversion between a string and an EmailFormat DU value type EmailFormatConverter () = inherit ValueConverter (emailFromDU, emailToDU) + /// Conversion between a string an an optional EmailFormat DU value + type EmailFormatOptionConverter () = + inherit ValueConverter (emailOptionFromDU, emailOptionToDU) + /// Conversion between a string and an Expiration DU value type ExpirationConverter () = inherit ValueConverter (expFromDU, expToDU) - /// Conversion between a string and an AsOfDateDisplay DU value + /// Conversion between a GUID and a member ID + type MemberIdConverter () = + inherit ValueConverter (memberIdFromDU, memberIdToDU) + + /// Conversion between a GUID and a prayer request ID + type PrayerRequestIdConverter () = + inherit ValueConverter (prayerReqIdFromDU, prayerReqIdToDU) + + /// Conversion between a string and a PrayerRequestType DU value type PrayerRequestTypeConverter () = inherit ValueConverter (typFromDU, typToDU) /// Conversion between a string and a RequestSort DU value type RequestSortConverter () = inherit ValueConverter (sortFromDU, sortToDU) + + /// Conversion between a GUID and a small group ID + type SmallGroupIdConverter () = + inherit ValueConverter (smallGrpIdFromDU, smallGrpIdToDU) + + /// Conversion between a string and a time zone ID + type TimeZoneIdConverter () = + inherit ValueConverter (tzIdFromDU, tzIdToDU) + + /// Conversion between a GUID and a user ID + type UserIdConverter () = + inherit ValueConverter (userIdFromDU, userIdToDU) /// Statistics for churches [] type ChurchStats = { /// The number of small groups in the church - smallGroups : int + SmallGroups : int /// The number of prayer requests in the church - prayerRequests : int + PrayerRequests : int /// The number of users who can access small groups in the church - users : int + Users : int } -/// PK type for the Church entity -type ChurchId = Guid - -/// PK type for the Member entity -type MemberId = Guid - -/// PK type for the PrayerRequest entity -type PrayerRequestId = Guid - -/// PK type for the SmallGroup entity -type SmallGroupId = Guid - -/// PK type for the TimeZone entity -type TimeZoneId = string - -/// PK type for the User entity -type UserId = Guid - -/// PK for User/SmallGroup cross-reference table -type UserSmallGroupKey = - { /// The ID of the user to whom access is granted - userId : UserId - - /// The ID of the small group to which the entry grants access - smallGroupId : SmallGroupId - } - (*-- ENTITIES --*) +open System.Collections.Generic +open FSharp.EFCore.OptionConverter +open Microsoft.EntityFrameworkCore +open NodaTime + /// This represents a church type [] Church = - { /// The Id of this church - churchId : ChurchId + { /// The ID of this church + Id : ChurchId /// The name of the church - name : string + Name : string /// The city where the church is - city : string + City : string - /// The state where the church is - st : string + /// The 2-letter state or province code for the church's location + State : string /// Does this church have an active interface with Virtual Prayer Room? - hasInterface : bool + HasInterface : bool /// The address for the interface - interfaceAddress : string option + InterfaceAddress : string option /// Small groups for this church - smallGroups : ICollection + SmallGroups : ICollection } with /// An empty church // aww... how sad :( static member empty = - { churchId = Guid.Empty - name = "" - city = "" - st = "" - hasInterface = false - interfaceAddress = None - smallGroups = List () + { Id = ChurchId Guid.Empty + Name = "" + City = "" + State = "" + HasInterface = false + InterfaceAddress = None + SmallGroups = List () } /// Configure EF for this entity static member internal configureEF (mb : ModelBuilder) = mb.Entity (fun m -> m.ToTable "Church" |> ignore - m.Property(fun e -> e.churchId).HasColumnName "ChurchId" |> ignore - m.Property(fun e -> e.name).HasColumnName("Name").IsRequired () |> ignore - m.Property(fun e -> e.city).HasColumnName("City").IsRequired () |> ignore - m.Property(fun e -> e.st).HasColumnName("ST").IsRequired().HasMaxLength 2 |> ignore - m.Property(fun e -> e.hasInterface).HasColumnName "HasVirtualPrayerRoomInterface" |> ignore - m.Property(fun e -> e.interfaceAddress).HasColumnName "InterfaceAddress" |> ignore) + m.Property(fun e -> e.Id).HasColumnName "ChurchId" |> ignore + m.Property(fun e -> e.Name).HasColumnName("Name").IsRequired () |> ignore + m.Property(fun e -> e.City).HasColumnName("City").IsRequired () |> ignore + m.Property(fun e -> e.State).HasColumnName("ST").IsRequired().HasMaxLength 2 |> ignore + m.Property(fun e -> e.HasInterface).HasColumnName "HasVirtualPrayerRoomInterface" |> ignore + m.Property(fun e -> e.InterfaceAddress).HasColumnName "InterfaceAddress" |> ignore) |> ignore - mb.Model.FindEntityType(typeof).FindProperty("interfaceAddress") + mb.Model.FindEntityType(typeof).FindProperty("Id").SetValueConverter(Converters.ChurchIdConverter ()) + mb.Model.FindEntityType(typeof).FindProperty("InterfaceAddress") .SetValueConverter(OptionConverter ()) /// Preferences for the form and format of the prayer request list and [] ListPreferences = { /// The Id of the small group to which these preferences belong - smallGroupId : SmallGroupId + SmallGroupId : SmallGroupId /// The days after which regular requests expire - daysToExpire : int + DaysToExpire : int /// The number of days a new or updated request is considered new - daysToKeepNew : int + DaysToKeepNew : int /// The number of weeks after which long-term requests are flagged for follow-up - longTermUpdateWeeks : int + LongTermUpdateWeeks : int /// The name from which e-mails are sent - emailFromName : string + EmailFromName : string /// The e-mail address from which e-mails are sent - emailFromAddress : string + EmailFromAddress : string /// The fonts to use in generating the list of prayer requests - listFonts : string + Fonts : string /// The color for the prayer request list headings - headingColor : string + HeadingColor : string /// The color for the lines offsetting the prayer request list headings - lineColor : string + LineColor : string /// The font size for the headings on the prayer request list - headingFontSize : int + HeadingFontSize : int /// The font size for the text on the prayer request list - textFontSize : int + TextFontSize : int /// The order in which the prayer requests are sorted - requestSort : RequestSort + RequestSort : RequestSort /// The password used for "small group login" (view-only request list) - groupPassword : string + GroupPassword : string /// The default e-mail type for this class - defaultEmailType : EmailFormat + DefaultEmailType : EmailFormat /// Whether this class makes its request list public - isPublic : bool + IsPublic : bool /// The time zone which this class uses (use tzdata names) - timeZoneId : TimeZoneId + TimeZoneId : TimeZoneId /// The time zone information - timeZone : TimeZone + TimeZone : TimeZone /// The number of requests displayed per page - pageSize : int + PageSize : int /// How the as-of date should be automatically displayed - asOfDateDisplay : AsOfDateDisplay + AsOfDateDisplay : AsOfDateDisplay } with /// A set of preferences with their default values static member empty = - { smallGroupId = Guid.Empty - daysToExpire = 14 - daysToKeepNew = 7 - longTermUpdateWeeks = 4 - emailFromName = "PrayerTracker" - emailFromAddress = "prayer@djs-consulting.com" - listFonts = "Century Gothic,Tahoma,Luxi Sans,sans-serif" - headingColor = "maroon" - lineColor = "navy" - headingFontSize = 16 - textFontSize = 12 - requestSort = SortByDate - groupPassword = "" - defaultEmailType = HtmlFormat - isPublic = false - timeZoneId = "America/Denver" - timeZone = TimeZone.empty - pageSize = 100 - asOfDateDisplay = NoDisplay + { SmallGroupId = SmallGroupId Guid.Empty + DaysToExpire = 14 + DaysToKeepNew = 7 + LongTermUpdateWeeks = 4 + EmailFromName = "PrayerTracker" + EmailFromAddress = "prayer@djs-consulting.com" + Fonts = "Century Gothic,Tahoma,Luxi Sans,sans-serif" + HeadingColor = "maroon" + LineColor = "navy" + HeadingFontSize = 16 + TextFontSize = 12 + RequestSort = SortByDate + GroupPassword = "" + DefaultEmailType = HtmlFormat + IsPublic = false + TimeZoneId = TimeZoneId "America/Denver" + TimeZone = TimeZone.empty + PageSize = 100 + AsOfDateDisplay = NoDisplay } /// Configure EF for this entity static member internal configureEF (mb : ModelBuilder) = mb.Entity (fun m -> m.ToTable "ListPreference" |> ignore - m.HasKey (fun e -> e.smallGroupId :> obj) |> ignore - m.Property(fun e -> e.smallGroupId).HasColumnName "SmallGroupId" |> ignore - m.Property(fun e -> e.daysToKeepNew) + m.HasKey (fun e -> e.SmallGroupId :> obj) |> ignore + m.Property(fun e -> e.SmallGroupId).HasColumnName "SmallGroupId" |> ignore + m.Property(fun e -> e.DaysToKeepNew) .HasColumnName("DaysToKeepNew") .IsRequired() .HasDefaultValue 7 |> ignore - m.Property(fun e -> e.daysToExpire) + m.Property(fun e -> e.DaysToExpire) .HasColumnName("DaysToExpire") .IsRequired() .HasDefaultValue 14 |> ignore - m.Property(fun e -> e.longTermUpdateWeeks) + m.Property(fun e -> e.LongTermUpdateWeeks) .HasColumnName("LongTermUpdateWeeks") .IsRequired() .HasDefaultValue 4 |> ignore - m.Property(fun e -> e.emailFromName) + m.Property(fun e -> e.EmailFromName) .HasColumnName("EmailFromName") .IsRequired() .HasDefaultValue "PrayerTracker" |> ignore - m.Property(fun e -> e.emailFromAddress) + m.Property(fun e -> e.EmailFromAddress) .HasColumnName("EmailFromAddress") .IsRequired() .HasDefaultValue "prayer@djs-consulting.com" |> ignore - m.Property(fun e -> e.listFonts) + m.Property(fun e -> e.Fonts) .HasColumnName("ListFonts") .IsRequired() .HasDefaultValue "Century Gothic,Tahoma,Luxi Sans,sans-serif" |> ignore - m.Property(fun e -> e.headingColor) + m.Property(fun e -> e.HeadingColor) .HasColumnName("HeadingColor") .IsRequired() .HasDefaultValue "maroon" |> ignore - m.Property(fun e -> e.lineColor) + m.Property(fun e -> e.LineColor) .HasColumnName("LineColor") .IsRequired() .HasDefaultValue "navy" |> ignore - m.Property(fun e -> e.headingFontSize) + m.Property(fun e -> e.HeadingFontSize) .HasColumnName("HeadingFontSize") .IsRequired() .HasDefaultValue 16 |> ignore - m.Property(fun e -> e.textFontSize) + m.Property(fun e -> e.TextFontSize) .HasColumnName("TextFontSize") .IsRequired() .HasDefaultValue 12 |> ignore - m.Property(fun e -> e.requestSort) + m.Property(fun e -> e.RequestSort) .HasColumnName("RequestSort") .IsRequired() .HasMaxLength(1) .HasDefaultValue SortByDate |> ignore - m.Property(fun e -> e.groupPassword) + m.Property(fun e -> e.GroupPassword) .HasColumnName("GroupPassword") .IsRequired() .HasDefaultValue "" |> ignore - m.Property(fun e -> e.defaultEmailType) + m.Property(fun e -> e.DefaultEmailType) .HasColumnName("DefaultEmailType") .IsRequired() .HasDefaultValue HtmlFormat |> ignore - m.Property(fun e -> e.isPublic) + m.Property(fun e -> e.IsPublic) .HasColumnName("IsPublic") .IsRequired() .HasDefaultValue false |> ignore - m.Property(fun e -> e.timeZoneId) + m.Property(fun e -> e.TimeZoneId) .HasColumnName("TimeZoneId") .IsRequired() .HasDefaultValue "America/Denver" |> ignore - m.Property(fun e -> e.pageSize) + m.Property(fun e -> e.PageSize) .HasColumnName("PageSize") .IsRequired() .HasDefaultValue 100 |> ignore - m.Property(fun e -> e.asOfDateDisplay) + m.Property(fun e -> e.AsOfDateDisplay) .HasColumnName("AsOfDateDisplay") .IsRequired() .HasMaxLength(1) .HasDefaultValue NoDisplay |> ignore) |> ignore - mb.Model.FindEntityType(typeof).FindProperty("requestSort") + mb.Model.FindEntityType(typeof).FindProperty("SmallGroupId") + .SetValueConverter(Converters.SmallGroupIdConverter ()) + mb.Model.FindEntityType(typeof).FindProperty("RequestSort") .SetValueConverter(Converters.RequestSortConverter ()) - mb.Model.FindEntityType(typeof).FindProperty("defaultEmailType") + mb.Model.FindEntityType(typeof).FindProperty("DefaultEmailType") .SetValueConverter(Converters.EmailFormatConverter ()) - mb.Model.FindEntityType(typeof).FindProperty("asOfDateDisplay") + mb.Model.FindEntityType(typeof).FindProperty("TimeZoneId") + .SetValueConverter(Converters.TimeZoneIdConverter ()) + mb.Model.FindEntityType(typeof).FindProperty("AsOfDateDisplay") .SetValueConverter(Converters.AsOfDateDisplayConverter ()) /// A member of a small group and [] Member = - { /// The Id of the member - memberId : MemberId + { /// The ID of the small group member + Id : MemberId /// The Id of the small group to which this member belongs - smallGroupId : SmallGroupId + SmallGroupId : SmallGroupId /// The name of the member - memberName : string + Name : string /// The e-mail address for the member - email : string + Email : string - /// The type of e-mail preferred by this member (see constants) - format : string option // TODO - do I need a custom formatter for this? + /// The type of e-mail preferred by this member + Format : EmailFormat option /// The small group to which this member belongs - smallGroup : SmallGroup + SmallGroup : SmallGroup } with /// An empty member static member empty = - { memberId = Guid.Empty - smallGroupId = Guid.Empty - memberName = "" - email = "" - format = None - smallGroup = SmallGroup.empty + { Id = MemberId Guid.Empty + SmallGroupId = SmallGroupId Guid.Empty + Name = "" + Email = "" + Format = None + SmallGroup = SmallGroup.empty } /// Configure EF for this entity static member internal configureEF (mb : ModelBuilder) = mb.Entity (fun m -> m.ToTable "Member" |> ignore - m.Property(fun e -> e.memberId).HasColumnName "MemberId" |> ignore - m.Property(fun e -> e.smallGroupId).HasColumnName "SmallGroupId" |> ignore - m.Property(fun e -> e.memberName).HasColumnName("MemberName").IsRequired() |> ignore - m.Property(fun e -> e.email).HasColumnName("Email").IsRequired() |> ignore - m.Property(fun e -> e.format).HasColumnName "Format" |> ignore) + m.Property(fun e -> e.Id).HasColumnName "MemberId" |> ignore + m.Property(fun e -> e.SmallGroupId).HasColumnName "SmallGroupId" |> ignore + m.Property(fun e -> e.Name).HasColumnName("MemberName").IsRequired() |> ignore + m.Property(fun e -> e.Email).HasColumnName("Email").IsRequired() |> ignore + m.Property(fun e -> e.Format).HasColumnName "Format" |> ignore) |> ignore - mb.Model.FindEntityType(typeof).FindProperty("format").SetValueConverter(OptionConverter ()) + mb.Model.FindEntityType(typeof).FindProperty("Id").SetValueConverter(Converters.MemberIdConverter ()) + mb.Model.FindEntityType(typeof).FindProperty("SmallGroupId") + .SetValueConverter(Converters.SmallGroupIdConverter ()) + mb.Model.FindEntityType(typeof).FindProperty("Format") + .SetValueConverter(Converters.EmailFormatOptionConverter ()) /// This represents a single prayer request and [] PrayerRequest = - { /// The Id of this request - prayerRequestId : PrayerRequestId + { /// The ID of this request + Id : PrayerRequestId /// The type of the request - requestType : PrayerRequestType + RequestType : PrayerRequestType - /// The user who entered the request - userId : UserId + /// The ID of the user who entered the request + UserId : UserId /// The small group to which this request belongs - smallGroupId : SmallGroupId + SmallGroupId : SmallGroupId /// The date/time on which this request was entered - enteredDate : DateTime + EnteredDate : DateTime /// The date/time this request was last updated - updatedDate : DateTime + UpdatedDate : DateTime /// The name of the requestor or subject, or title of announcement - requestor : string option + Requestor : string option /// The text of the request - text : string + Text : string /// Whether the chaplain should be notified for this request - notifyChaplain : bool + NotifyChaplain : bool /// The user who entered this request - user : User + User : User /// The small group to which this request belongs - smallGroup : SmallGroup + SmallGroup : SmallGroup /// Is this request expired? - expiration : Expiration + Expiration : Expiration } with /// An empty request static member empty = - { prayerRequestId = Guid.Empty - requestType = CurrentRequest - userId = Guid.Empty - smallGroupId = Guid.Empty - enteredDate = DateTime.MinValue - updatedDate = DateTime.MinValue - requestor = None - text = "" - notifyChaplain = false - user = User.empty - smallGroup = SmallGroup.empty - expiration = Automatic + { Id = PrayerRequestId Guid.Empty + RequestType = CurrentRequest + UserId = UserId Guid.Empty + SmallGroupId = SmallGroupId Guid.Empty + EnteredDate = DateTime.MinValue + UpdatedDate = DateTime.MinValue + Requestor = None + Text = "" + NotifyChaplain = false + User = User.empty + SmallGroup = SmallGroup.empty + Expiration = Automatic } /// Is this request expired? member this.isExpired (curr : DateTime) expDays = - match this.expiration with + match this.Expiration with | Forced -> true | Manual -> false | Automatic -> - match this.requestType with + match this.RequestType with | LongTermRequest | Expecting -> false - | _ -> curr.AddDays(-(float expDays)).Date > this.updatedDate.Date // Automatic expiration + | _ -> curr.AddDays(-(float expDays)).Date > this.UpdatedDate.Date // Automatic expiration /// Is an update required for this long-term request? member this.updateRequired curr expDays updWeeks = match this.isExpired curr expDays with | true -> false - | false -> curr.AddDays(-(float (updWeeks * 7))).Date > this.updatedDate.Date + | false -> curr.AddDays(-(float (updWeeks * 7))).Date > this.UpdatedDate.Date /// Configure EF for this entity static member internal configureEF (mb : ModelBuilder) = mb.Entity (fun m -> m.ToTable "PrayerRequest" |> ignore - m.Property(fun e -> e.prayerRequestId).HasColumnName "PrayerRequestId" |> ignore - m.Property(fun e -> e.requestType).HasColumnName("RequestType").IsRequired() |> ignore - m.Property(fun e -> e.userId).HasColumnName "UserId" |> ignore - m.Property(fun e -> e.smallGroupId).HasColumnName "SmallGroupId" |> ignore - m.Property(fun e -> e.enteredDate).HasColumnName "EnteredDate" |> ignore - m.Property(fun e -> e.updatedDate).HasColumnName "UpdatedDate" |> ignore - m.Property(fun e -> e.requestor).HasColumnName "Requestor" |> ignore - m.Property(fun e -> e.text).HasColumnName("Text").IsRequired() |> ignore - m.Property(fun e -> e.notifyChaplain).HasColumnName "NotifyChaplain" |> ignore - m.Property(fun e -> e.expiration).HasColumnName "Expiration" |> ignore) + m.Property(fun e -> e.Id).HasColumnName "PrayerRequestId" |> ignore + m.Property(fun e -> e.RequestType).HasColumnName("RequestType").IsRequired() |> ignore + m.Property(fun e -> e.UserId).HasColumnName "UserId" |> ignore + m.Property(fun e -> e.SmallGroupId).HasColumnName "SmallGroupId" |> ignore + m.Property(fun e -> e.EnteredDate).HasColumnName "EnteredDate" |> ignore + m.Property(fun e -> e.UpdatedDate).HasColumnName "UpdatedDate" |> ignore + m.Property(fun e -> e.Requestor).HasColumnName "Requestor" |> ignore + m.Property(fun e -> e.Text).HasColumnName("Text").IsRequired() |> ignore + m.Property(fun e -> e.NotifyChaplain).HasColumnName "NotifyChaplain" |> ignore + m.Property(fun e -> e.Expiration).HasColumnName "Expiration" |> ignore) |> ignore - mb.Model.FindEntityType(typeof).FindProperty("requestType") + mb.Model.FindEntityType(typeof).FindProperty("Id") + .SetValueConverter(Converters.PrayerRequestIdConverter ()) + mb.Model.FindEntityType(typeof).FindProperty("RequestType") .SetValueConverter(Converters.PrayerRequestTypeConverter ()) - mb.Model.FindEntityType(typeof).FindProperty("requestor") + mb.Model.FindEntityType(typeof).FindProperty("UserId") + .SetValueConverter(Converters.UserIdConverter ()) + mb.Model.FindEntityType(typeof).FindProperty("SmallGroupId") + .SetValueConverter(Converters.SmallGroupIdConverter ()) + mb.Model.FindEntityType(typeof).FindProperty("Requestor") .SetValueConverter(OptionConverter ()) - mb.Model.FindEntityType(typeof).FindProperty("expiration") + mb.Model.FindEntityType(typeof).FindProperty("Expiration") .SetValueConverter(Converters.ExpirationConverter ()) /// This represents a small group (Sunday School class, Bible study group, etc.) and [] SmallGroup = - { /// The Id of this small group - smallGroupId : SmallGroupId + { /// The ID of this small group + Id : SmallGroupId /// The church to which this group belongs - churchId : ChurchId + ChurchId : ChurchId /// The name of the group - name : string + Name : string /// The church to which this small group belongs - church : Church + Church : Church /// The preferences for the request list - preferences : ListPreferences + Preferences : ListPreferences /// The members of the group - members : ICollection + Members : ICollection /// Prayer requests for this small group - prayerRequests : ICollection + PrayerRequests : ICollection /// The users authorized to manage this group - users : ICollection + Users : ICollection } with /// An empty small group static member empty = - { smallGroupId = Guid.Empty - churchId = Guid.Empty - name = "" - church = Church.empty - preferences = ListPreferences.empty - members = List () - prayerRequests = List () - users = List () + { Id = SmallGroupId Guid.Empty + ChurchId = ChurchId Guid.Empty + Name = "" + Church = Church.empty + Preferences = ListPreferences.empty + Members = List () + PrayerRequests = List () + Users = List () } /// Get the local date for this group member this.localTimeNow (clock : IClock) = match clock with null -> nullArg "clock" | _ -> () + let tzId = TimeZoneId.toString this.Preferences.TimeZoneId let tz = - if DateTimeZoneProviders.Tzdb.Ids.Contains this.preferences.timeZoneId then - DateTimeZoneProviders.Tzdb[this.preferences.timeZoneId] + if DateTimeZoneProviders.Tzdb.Ids.Contains tzId then DateTimeZoneProviders.Tzdb[tzId] else DateTimeZone.Utc clock.GetCurrentInstant().InZone(tz).ToDateTimeUnspecified () @@ -695,146 +830,158 @@ with static member internal configureEF (mb : ModelBuilder) = mb.Entity (fun m -> m.ToTable "SmallGroup" |> ignore - m.Property(fun e -> e.smallGroupId).HasColumnName "SmallGroupId" |> ignore - m.Property(fun e -> e.churchId).HasColumnName "ChurchId" |> ignore - m.Property(fun e -> e.name).HasColumnName("Name").IsRequired() |> ignore - m.HasOne(fun e -> e.preferences) |> ignore) + m.Property(fun e -> e.Id).HasColumnName "SmallGroupId" |> ignore + m.Property(fun e -> e.ChurchId).HasColumnName "ChurchId" |> ignore + m.Property(fun e -> e.Name).HasColumnName("Name").IsRequired() |> ignore + m.HasOne(fun e -> e.Preferences) |> ignore) |> ignore + mb.Model.FindEntityType(typeof).FindProperty("Id") + .SetValueConverter(Converters.SmallGroupIdConverter ()) + mb.Model.FindEntityType(typeof).FindProperty("ChurchId") + .SetValueConverter(Converters.ChurchIdConverter ()) /// This represents a time zone in which a class may reside and [] TimeZone = { /// The Id for this time zone (uses tzdata names) - timeZoneId : TimeZoneId + Id : TimeZoneId /// The description of this time zone - description : string + Description : string /// The order in which this timezone should be displayed - sortOrder : int + SortOrder : int /// Whether this timezone is active - isActive : bool + IsActive : bool } with /// An empty time zone static member empty = - { timeZoneId = "" - description = "" - sortOrder = 0 - isActive = false + { Id = TimeZoneId "" + Description = "" + SortOrder = 0 + IsActive = false } /// Configure EF for this entity static member internal configureEF (mb : ModelBuilder) = mb.Entity ( fun m -> m.ToTable "TimeZone" |> ignore - m.Property(fun e -> e.timeZoneId).HasColumnName "TimeZoneId" |> ignore - m.Property(fun e -> e.description).HasColumnName("Description").IsRequired() |> ignore - m.Property(fun e -> e.sortOrder).HasColumnName "SortOrder" |> ignore - m.Property(fun e -> e.isActive).HasColumnName "IsActive" |> ignore) + m.Property(fun e -> e.Id).HasColumnName "TimeZoneId" |> ignore + m.Property(fun e -> e.Description).HasColumnName("Description").IsRequired() |> ignore + m.Property(fun e -> e.SortOrder).HasColumnName "SortOrder" |> ignore + m.Property(fun e -> e.IsActive).HasColumnName "IsActive" |> ignore) |> ignore + mb.Model.FindEntityType(typeof).FindProperty("Id") + .SetValueConverter(Converters.TimeZoneIdConverter ()) /// This represents a user of PrayerTracker and [] User = - { /// The Id of this user - userId : UserId + { /// The ID of this user + Id : UserId /// The first name of this user - firstName : string + FirstName : string /// The last name of this user - lastName : string + LastName : string /// The e-mail address of the user - emailAddress : string + Email : string /// Whether this user is a PrayerTracker system administrator - isAdmin : bool + IsAdmin : bool /// The user's hashed password - passwordHash : string + PasswordHash : string /// The salt for the user's hashed password - salt : Guid option + Salt : Guid option /// The small groups which this user is authorized - smallGroups : ICollection + SmallGroups : ICollection } with /// An empty user static member empty = - { userId = Guid.Empty - firstName = "" - lastName = "" - emailAddress = "" - isAdmin = false - passwordHash = "" - salt = None - smallGroups = List () + { Id = UserId Guid.Empty + FirstName = "" + LastName = "" + Email = "" + IsAdmin = false + PasswordHash = "" + Salt = None + SmallGroups = List () } /// The full name of the user member this.fullName = - $"{this.firstName} {this.lastName}" + $"{this.FirstName} {this.LastName}" /// Configure EF for this entity static member internal configureEF (mb : ModelBuilder) = mb.Entity (fun m -> m.ToTable "User" |> ignore m.Ignore(fun e -> e.fullName :> obj) |> ignore - m.Property(fun e -> e.userId).HasColumnName "UserId" |> ignore - m.Property(fun e -> e.firstName).HasColumnName("FirstName").IsRequired() |> ignore - m.Property(fun e -> e.lastName).HasColumnName("LastName").IsRequired() |> ignore - m.Property(fun e -> e.emailAddress).HasColumnName("EmailAddress").IsRequired() |> ignore - m.Property(fun e -> e.isAdmin).HasColumnName "IsSystemAdmin" |> ignore - m.Property(fun e -> e.passwordHash).HasColumnName("PasswordHash").IsRequired() |> ignore - m.Property(fun e -> e.salt).HasColumnName "Salt" |> ignore) + m.Property(fun e -> e.Id).HasColumnName "UserId" |> ignore + m.Property(fun e -> e.FirstName).HasColumnName("FirstName").IsRequired() |> ignore + m.Property(fun e -> e.LastName).HasColumnName("LastName").IsRequired() |> ignore + m.Property(fun e -> e.Email).HasColumnName("EmailAddress").IsRequired() |> ignore + m.Property(fun e -> e.IsAdmin).HasColumnName "IsSystemAdmin" |> ignore + m.Property(fun e -> e.PasswordHash).HasColumnName("PasswordHash").IsRequired() |> ignore + m.Property(fun e -> e.Salt).HasColumnName "Salt" |> ignore) |> ignore - mb.Model.FindEntityType(typeof).FindProperty("salt") + mb.Model.FindEntityType(typeof).FindProperty("Id").SetValueConverter(Converters.UserIdConverter ()) + mb.Model.FindEntityType(typeof).FindProperty("Salt") .SetValueConverter(OptionConverter ()) /// Cross-reference between user and small group and [] UserSmallGroup = { /// The Id of the user who has access to the small group - userId : UserId + UserId : UserId /// The Id of the small group to which the user has access - smallGroupId : SmallGroupId + SmallGroupId : SmallGroupId /// The user who has access to the small group - user : User + User : User /// The small group to which the user has access - smallGroup : SmallGroup + SmallGroup : SmallGroup } with /// An empty user/small group xref static member empty = - { userId = Guid.Empty - smallGroupId = Guid.Empty - user = User.empty - smallGroup = SmallGroup.empty + { UserId = UserId Guid.Empty + SmallGroupId = SmallGroupId Guid.Empty + User = User.empty + SmallGroup = SmallGroup.empty } /// Configure EF for this entity static member internal configureEF (mb : ModelBuilder) = mb.Entity (fun m -> m.ToTable "User_SmallGroup" |> ignore - m.HasKey(fun e -> { userId = e.userId; smallGroupId = e.smallGroupId } :> obj) |> ignore - m.Property(fun e -> e.userId).HasColumnName "UserId" |> ignore - m.Property(fun e -> e.smallGroupId).HasColumnName "SmallGroupId" |> ignore - m.HasOne(fun e -> e.user) - .WithMany(fun e -> e.smallGroups :> IEnumerable) - .HasForeignKey(fun e -> e.userId :> obj) + m.HasKey(fun e -> {| UserId = e.UserId; SmallGroupId = e.SmallGroupId |} :> obj) |> ignore + m.Property(fun e -> e.UserId).HasColumnName "UserId" |> ignore + m.Property(fun e -> e.SmallGroupId).HasColumnName "SmallGroupId" |> ignore + m.HasOne(fun e -> e.User) + .WithMany(fun e -> e.SmallGroups :> IEnumerable) + .HasForeignKey(fun e -> e.UserId :> obj) |> ignore - m.HasOne(fun e -> e.smallGroup) - .WithMany(fun e -> e.users :> IEnumerable) - .HasForeignKey(fun e -> e.smallGroupId :> obj) + m.HasOne(fun e -> e.SmallGroup) + .WithMany(fun e -> e.Users :> IEnumerable) + .HasForeignKey(fun e -> e.SmallGroupId :> obj) |> ignore) |> ignore + mb.Model.FindEntityType(typeof).FindProperty("UserId") + .SetValueConverter(Converters.UserIdConverter ()) + mb.Model.FindEntityType(typeof).FindProperty("SmallGroupId") + .SetValueConverter(Converters.SmallGroupIdConverter ()) + \ No newline at end of file diff --git a/src/PrayerTracker.Data/PrayerTracker.Data.fsproj b/src/PrayerTracker.Data/PrayerTracker.Data.fsproj index 3566319..0fbe868 100644 --- a/src/PrayerTracker.Data/PrayerTracker.Data.fsproj +++ b/src/PrayerTracker.Data/PrayerTracker.Data.fsproj @@ -14,6 +14,7 @@ + diff --git a/src/PrayerTracker.Tests/Data/EntitiesTests.fs b/src/PrayerTracker.Tests/Data/EntitiesTests.fs index b511878..0df2439 100644 --- a/src/PrayerTracker.Tests/Data/EntitiesTests.fs +++ b/src/PrayerTracker.Tests/Data/EntitiesTests.fs @@ -9,13 +9,13 @@ open System let asOfDateDisplayTests = testList "AsOfDateDisplay" [ test "NoDisplay code is correct" { - Expect.equal NoDisplay.code "N" "The code for NoDisplay should have been \"N\"" + Expect.equal (AsOfDateDisplay.toCode NoDisplay) "N" "The code for NoDisplay should have been \"N\"" } test "ShortDate code is correct" { - Expect.equal ShortDate.code "S" "The code for ShortDate should have been \"S\"" + Expect.equal (AsOfDateDisplay.toCode ShortDate) "S" "The code for ShortDate should have been \"S\"" } test "LongDate code is correct" { - Expect.equal LongDate.code "L" "The code for LongDate should have been \"N\"" + Expect.equal (AsOfDateDisplay.toCode LongDate) "L" "The code for LongDate should have been \"N\"" } test "fromCode N should return NoDisplay" { Expect.equal (AsOfDateDisplay.fromCode "N") NoDisplay "\"N\" should have been converted to NoDisplay" @@ -37,14 +37,14 @@ let churchTests = testList "Church" [ test "empty is as expected" { let mt = Church.empty - Expect.equal mt.churchId Guid.Empty "The church ID should have been an empty GUID" - Expect.equal mt.name "" "The name should have been blank" - Expect.equal mt.city "" "The city should have been blank" - Expect.equal mt.st "" "The state should have been blank" - Expect.isFalse mt.hasInterface "The church should not show that it has an interface" - Expect.isNone mt.interfaceAddress "The interface address should not exist" - Expect.isNotNull mt.smallGroups "The small groups navigation property should not be null" - Expect.isEmpty mt.smallGroups "There should be no small groups for an empty church" + Expect.equal mt.Id.Value Guid.Empty "The church ID should have been an empty GUID" + Expect.equal mt.Name "" "The name should have been blank" + Expect.equal mt.City "" "The city should have been blank" + Expect.equal mt.State "" "The state should have been blank" + Expect.isFalse mt.HasInterface "The church should not show that it has an interface" + Expect.isNone mt.InterfaceAddress "The interface address should not exist" + Expect.isNotNull mt.SmallGroups "The small groups navigation property should not be null" + Expect.isEmpty mt.SmallGroups "There should be no small groups for an empty church" } ] @@ -52,10 +52,10 @@ let churchTests = let emailFormatTests = testList "EmailFormat" [ test "HtmlFormat code is correct" { - Expect.equal HtmlFormat.code "H" "The code for HtmlFormat should have been \"H\"" + Expect.equal (EmailFormat.toCode HtmlFormat) "H" "The code for HtmlFormat should have been \"H\"" } test "PlainTextFormat code is correct" { - Expect.equal PlainTextFormat.code "P" "The code for PlainTextFormat should have been \"P\"" + Expect.equal (EmailFormat.toCode PlainTextFormat) "P" "The code for PlainTextFormat should have been \"P\"" } test "fromCode H should return HtmlFormat" { Expect.equal (EmailFormat.fromCode "H") HtmlFormat "\"H\" should have been converted to HtmlFormat" @@ -74,13 +74,13 @@ let emailFormatTests = let expirationTests = testList "Expiration" [ test "Automatic code is correct" { - Expect.equal Automatic.code "A" "The code for Automatic should have been \"A\"" + Expect.equal (Expiration.toCode Automatic) "A" "The code for Automatic should have been \"A\"" } test "Manual code is correct" { - Expect.equal Manual.code "M" "The code for Manual should have been \"M\"" + Expect.equal (Expiration.toCode Manual) "M" "The code for Manual should have been \"M\"" } test "Forced code is correct" { - Expect.equal Forced.code "F" "The code for Forced should have been \"F\"" + Expect.equal (Expiration.toCode Forced) "F" "The code for Forced should have been \"F\"" } test "fromCode A should return Automatic" { Expect.equal (Expiration.fromCode "A") Automatic "\"A\" should have been converted to Automatic" @@ -102,27 +102,28 @@ let listPreferencesTests = testList "ListPreferences" [ test "empty is as expected" { let mt = ListPreferences.empty - Expect.equal mt.smallGroupId Guid.Empty "The small group ID should have been an empty GUID" - Expect.equal mt.daysToExpire 14 "The default days to expire should have been 14" - Expect.equal mt.daysToKeepNew 7 "The default days to keep new should have been 7" - Expect.equal mt.longTermUpdateWeeks 4 "The default long term update weeks should have been 4" - Expect.equal mt.emailFromName "PrayerTracker" "The default e-mail from name should have been PrayerTracker" - Expect.equal mt.emailFromAddress "prayer@djs-consulting.com" + Expect.equal mt.SmallGroupId.Value Guid.Empty "The small group ID should have been an empty GUID" + Expect.equal mt.DaysToExpire 14 "The default days to expire should have been 14" + Expect.equal mt.DaysToKeepNew 7 "The default days to keep new should have been 7" + Expect.equal mt.LongTermUpdateWeeks 4 "The default long term update weeks should have been 4" + Expect.equal mt.EmailFromName "PrayerTracker" "The default e-mail from name should have been PrayerTracker" + Expect.equal mt.EmailFromAddress "prayer@djs-consulting.com" "The default e-mail from address should have been prayer@djs-consulting.com" - Expect.equal mt.listFonts "Century Gothic,Tahoma,Luxi Sans,sans-serif" - "The default list fonts were incorrect" - Expect.equal mt.headingColor "maroon" "The default heading text color should have been maroon" - Expect.equal mt.lineColor "navy" "The default heding line color should have been navy" - Expect.equal mt.headingFontSize 16 "The default heading font size should have been 16" - Expect.equal mt.textFontSize 12 "The default text font size should have been 12" - Expect.equal mt.requestSort SortByDate "The default request sort should have been by date" - Expect.equal mt.groupPassword "" "The default group password should have been blank" - Expect.equal mt.defaultEmailType HtmlFormat "The default e-mail type should have been HTML" - Expect.isFalse mt.isPublic "The isPublic flag should not have been set" - Expect.equal mt.timeZoneId "America/Denver" "The default time zone should have been America/Denver" - Expect.equal mt.timeZone.timeZoneId "" "The default preferences should have included an empty time zone" - Expect.equal mt.pageSize 100 "The default page size should have been 100" - Expect.equal mt.asOfDateDisplay NoDisplay "The as-of date display should have been No Display" + Expect.equal mt.Fonts "Century Gothic,Tahoma,Luxi Sans,sans-serif" "The default list fonts were incorrect" + Expect.equal mt.HeadingColor "maroon" "The default heading text color should have been maroon" + Expect.equal mt.LineColor "navy" "The default heding line color should have been navy" + Expect.equal mt.HeadingFontSize 16 "The default heading font size should have been 16" + Expect.equal mt.TextFontSize 12 "The default text font size should have been 12" + Expect.equal mt.RequestSort SortByDate "The default request sort should have been by date" + Expect.equal mt.GroupPassword "" "The default group password should have been blank" + Expect.equal mt.DefaultEmailType HtmlFormat "The default e-mail type should have been HTML" + Expect.isFalse mt.IsPublic "The isPublic flag should not have been set" + Expect.equal (TimeZoneId.toString mt.TimeZoneId) "America/Denver" + "The default time zone should have been America/Denver" + Expect.equal (TimeZoneId.toString mt.TimeZone.Id) "" + "The default preferences should have included an empty time zone" + Expect.equal mt.PageSize 100 "The default page size should have been 100" + Expect.equal mt.AsOfDateDisplay NoDisplay "The as-of date display should have been No Display" } ] @@ -131,12 +132,12 @@ let memberTests = testList "Member" [ test "empty is as expected" { let mt = Member.empty - Expect.equal mt.memberId Guid.Empty "The member ID should have been an empty GUID" - Expect.equal mt.smallGroupId Guid.Empty "The small group ID should have been an empty GUID" - Expect.equal mt.memberName "" "The member name should have been blank" - Expect.equal mt.email "" "The member e-mail address should have been blank" - Expect.isNone mt.format "The preferred e-mail format should not exist" - Expect.equal mt.smallGroup.smallGroupId Guid.Empty "The small group should have been an empty one" + Expect.equal mt.Id.Value Guid.Empty "The member ID should have been an empty GUID" + Expect.equal mt.SmallGroupId.Value Guid.Empty "The small group ID should have been an empty GUID" + Expect.equal mt.Name "" "The member name should have been blank" + Expect.equal mt.Email "" "The member e-mail address should have been blank" + Expect.isNone mt.Format "The preferred e-mail format should not exist" + Expect.equal mt.SmallGroup.Id.Value Guid.Empty "The small group should have been an empty one" } ] @@ -145,62 +146,62 @@ let prayerRequestTests = testList "PrayerRequest" [ test "empty is as expected" { let mt = PrayerRequest.empty - Expect.equal mt.prayerRequestId Guid.Empty "The request ID should have been an empty GUID" - Expect.equal mt.requestType CurrentRequest "The request type should have been Current" - Expect.equal mt.userId Guid.Empty "The user ID should have been an empty GUID" - Expect.equal mt.smallGroupId Guid.Empty "The small group ID should have been an empty GUID" - Expect.equal mt.enteredDate DateTime.MinValue "The entered date should have been the minimum" - Expect.equal mt.updatedDate DateTime.MinValue "The updated date should have been the minimum" - Expect.isNone mt.requestor "The requestor should not exist" - Expect.equal mt.text "" "The request text should have been blank" - Expect.isFalse mt.notifyChaplain "The notify chaplain flag should not have been set" - Expect.equal mt.expiration Automatic "The expiration should have been Automatic" - Expect.equal mt.user.userId Guid.Empty "The user should have been an empty one" - Expect.equal mt.smallGroup.smallGroupId Guid.Empty "The small group should have been an empty one" + Expect.equal mt.Id.Value Guid.Empty "The request ID should have been an empty GUID" + Expect.equal mt.RequestType CurrentRequest "The request type should have been Current" + Expect.equal mt.UserId.Value Guid.Empty "The user ID should have been an empty GUID" + Expect.equal mt.SmallGroupId.Value Guid.Empty "The small group ID should have been an empty GUID" + Expect.equal mt.EnteredDate DateTime.MinValue "The entered date should have been the minimum" + Expect.equal mt.UpdatedDate DateTime.MinValue "The updated date should have been the minimum" + Expect.isNone mt.Requestor "The requestor should not exist" + Expect.equal mt.Text "" "The request text should have been blank" + Expect.isFalse mt.NotifyChaplain "The notify chaplain flag should not have been set" + Expect.equal mt.Expiration Automatic "The expiration should have been Automatic" + Expect.equal mt.User.Id.Value Guid.Empty "The user should have been an empty one" + Expect.equal mt.SmallGroup.Id.Value Guid.Empty "The small group should have been an empty one" } test "isExpired always returns false for expecting requests" { - let req = { PrayerRequest.empty with requestType = Expecting } + let req = { PrayerRequest.empty with RequestType = Expecting } Expect.isFalse (req.isExpired DateTime.Now 0) "An expecting request should never be considered expired" } test "isExpired always returns false for manually-expired requests" { - let req = { PrayerRequest.empty with updatedDate = DateTime.Now.AddMonths -1; expiration = Manual } + let req = { PrayerRequest.empty with UpdatedDate = DateTime.Now.AddMonths -1; Expiration = Manual } Expect.isFalse (req.isExpired DateTime.Now 4) "A never-expired request should never be considered expired" } test "isExpired always returns false for long term/recurring requests" { - let req = { PrayerRequest.empty with requestType = LongTermRequest } + let req = { PrayerRequest.empty with RequestType = LongTermRequest } Expect.isFalse (req.isExpired DateTime.Now 0) "A recurring/long-term request should never be considered expired" } test "isExpired always returns true for force-expired requests" { - let req = { PrayerRequest.empty with updatedDate = DateTime.Now; expiration = Forced } + let req = { PrayerRequest.empty with UpdatedDate = DateTime.Now; Expiration = Forced } Expect.isTrue (req.isExpired DateTime.Now 5) "A force-expired request should always be considered expired" } test "isExpired returns false for non-expired requests" { let now = DateTime.Now - let req = { PrayerRequest.empty with updatedDate = now.AddDays -5. } + let req = { PrayerRequest.empty with UpdatedDate = now.AddDays -5. } Expect.isFalse (req.isExpired now 7) "A request updated 5 days ago should not be considered expired" } test "isExpired returns true for expired requests" { let now = DateTime.Now - let req = { PrayerRequest.empty with updatedDate = now.AddDays -8. } + let req = { PrayerRequest.empty with UpdatedDate = now.AddDays -8. } Expect.isTrue (req.isExpired now 7) "A request updated 8 days ago should be considered expired" } test "isExpired returns true for same-day expired requests" { let now = DateTime.Now - let req = { PrayerRequest.empty with updatedDate = now.Date.AddDays(-7.).AddSeconds -1. } + let req = { PrayerRequest.empty with UpdatedDate = now.Date.AddDays(-7.).AddSeconds -1. } Expect.isTrue (req.isExpired now 7) "A request entered a second before midnight should be considered expired" } test "updateRequired returns false for expired requests" { - let req = { PrayerRequest.empty with expiration = Forced } + let req = { PrayerRequest.empty with Expiration = Forced } Expect.isFalse (req.updateRequired DateTime.Now 7 4) "An expired request should not require an update" } test "updateRequired returns false when an update is not required for an active request" { let now = DateTime.Now let req = { PrayerRequest.empty with - requestType = LongTermRequest - updatedDate = now.AddDays -14. + RequestType = LongTermRequest + UpdatedDate = now.AddDays -14. } Expect.isFalse (req.updateRequired now 7 4) "An active request updated 14 days ago should not require an update until 28 days" @@ -209,8 +210,8 @@ let prayerRequestTests = let now = DateTime.Now let req = { PrayerRequest.empty with - requestType = LongTermRequest - updatedDate = now.AddDays -34. + RequestType = LongTermRequest + UpdatedDate = now.AddDays -34. } Expect.isTrue (req.updateRequired now 7 4) "An active request updated 34 days ago should require an update (past 28 days)" @@ -221,19 +222,21 @@ let prayerRequestTests = let prayerRequestTypeTests = testList "PrayerRequestType" [ test "CurrentRequest code is correct" { - Expect.equal CurrentRequest.code "C" "The code for CurrentRequest should have been \"C\"" + Expect.equal (PrayerRequestType.toCode CurrentRequest) "C" + "The code for CurrentRequest should have been \"C\"" } test "LongTermRequest code is correct" { - Expect.equal LongTermRequest.code "L" "The code for LongTermRequest should have been \"L\"" + Expect.equal (PrayerRequestType.toCode LongTermRequest) "L" + "The code for LongTermRequest should have been \"L\"" } test "PraiseReport code is correct" { - Expect.equal PraiseReport.code "P" "The code for PraiseReport should have been \"P\"" + Expect.equal (PrayerRequestType.toCode PraiseReport) "P" "The code for PraiseReport should have been \"P\"" } test "Expecting code is correct" { - Expect.equal Expecting.code "E" "The code for Expecting should have been \"E\"" + Expect.equal (PrayerRequestType.toCode Expecting) "E" "The code for Expecting should have been \"E\"" } test "Announcement code is correct" { - Expect.equal Announcement.code "A" "The code for Announcement should have been \"A\"" + Expect.equal (PrayerRequestType.toCode Announcement) "A" "The code for Announcement should have been \"A\"" } test "fromCode C should return CurrentRequest" { Expect.equal (PrayerRequestType.fromCode "C") CurrentRequest @@ -264,10 +267,10 @@ let prayerRequestTypeTests = let requestSortTests = testList "RequestSort" [ test "SortByDate code is correct" { - Expect.equal SortByDate.code "D" "The code for SortByDate should have been \"D\"" + Expect.equal (RequestSort.toCode SortByDate) "D" "The code for SortByDate should have been \"D\"" } test "SortByRequestor code is correct" { - Expect.equal SortByRequestor.code "R" "The code for SortByRequestor should have been \"R\"" + Expect.equal (RequestSort.toCode SortByRequestor) "R" "The code for SortByRequestor should have been \"R\"" } test "fromCode D should return SortByDate" { Expect.equal (RequestSort.fromCode "D") SortByDate "\"D\" should have been converted to SortByDate" @@ -290,23 +293,23 @@ let smallGroupTests = FakeClock (Instant.FromDateTimeUtc now) |> f yield test "empty is as expected" { let mt = SmallGroup.empty - Expect.equal mt.smallGroupId Guid.Empty "The small group ID should have been an empty GUID" - Expect.equal mt.churchId Guid.Empty "The church ID should have been an empty GUID" - Expect.equal mt.name "" "The name should have been blank" - Expect.equal mt.church.churchId Guid.Empty "The church should have been an empty one" - Expect.isNotNull mt.members "The members navigation property should not be null" - Expect.isEmpty mt.members "There should be no members for an empty small group" - Expect.isNotNull mt.prayerRequests "The prayer requests navigation property should not be null" - Expect.isEmpty mt.prayerRequests "There should be no prayer requests for an empty small group" - Expect.isNotNull mt.users "The users navigation property should not be null" - Expect.isEmpty mt.users "There should be no users for an empty small group" + Expect.equal mt.Id.Value Guid.Empty "The small group ID should have been an empty GUID" + Expect.equal mt.ChurchId.Value Guid.Empty "The church ID should have been an empty GUID" + Expect.equal mt.Name "" "The name should have been blank" + Expect.equal mt.Church.Id.Value Guid.Empty "The church should have been an empty one" + Expect.isNotNull mt.Members "The members navigation property should not be null" + Expect.isEmpty mt.Members "There should be no members for an empty small group" + Expect.isNotNull mt.PrayerRequests "The prayer requests navigation property should not be null" + Expect.isEmpty mt.PrayerRequests "There should be no prayer requests for an empty small group" + Expect.isNotNull mt.Users "The users navigation property should not be null" + Expect.isEmpty mt.Users "There should be no users for an empty small group" } yield! testFixture withFakeClock [ "localTimeNow adjusts the time ahead of UTC", fun clock -> let grp = { SmallGroup.empty with - preferences = { ListPreferences.empty with timeZoneId = "Europe/Berlin" } + Preferences = { ListPreferences.empty with TimeZoneId = TimeZoneId "Europe/Berlin" } } Expect.isGreaterThan (grp.localTimeNow clock) now "UTC to Europe/Berlin should have added hours" "localTimeNow adjusts the time behind UTC", @@ -315,7 +318,10 @@ let smallGroupTests = "UTC to America/Denver should have subtracted hours" "localTimeNow returns UTC when the time zone is invalid", fun clock -> - let grp = { SmallGroup.empty with preferences = { ListPreferences.empty with timeZoneId = "garbage" } } + let grp = + { SmallGroup.empty with + Preferences = { ListPreferences.empty with TimeZoneId = TimeZoneId "garbage" } + } Expect.equal (grp.localTimeNow clock) now "UTC should have been returned for an invalid time zone" ] yield test "localTimeNow fails when clock is not passed" { @@ -334,10 +340,10 @@ let timeZoneTests = testList "TimeZone" [ test "empty is as expected" { let mt = TimeZone.empty - Expect.equal mt.timeZoneId "" "The time zone ID should have been blank" - Expect.equal mt.description "" "The description should have been blank" - Expect.equal mt.sortOrder 0 "The sort order should have been zero" - Expect.isFalse mt.isActive "The is-active flag should not have been set" + Expect.equal (TimeZoneId.toString mt.Id) "" "The time zone ID should have been blank" + Expect.equal mt.Description "" "The description should have been blank" + Expect.equal mt.SortOrder 0 "The sort order should have been zero" + Expect.isFalse mt.IsActive "The is-active flag should not have been set" } ] @@ -346,18 +352,18 @@ let userTests = testList "User" [ test "empty is as expected" { let mt = User.empty - Expect.equal mt.userId Guid.Empty "The user ID should have been an empty GUID" - Expect.equal mt.firstName "" "The first name should have been blank" - Expect.equal mt.lastName "" "The last name should have been blank" - Expect.equal mt.emailAddress "" "The e-mail address should have been blank" - Expect.isFalse mt.isAdmin "The is admin flag should not have been set" - Expect.equal mt.passwordHash "" "The password hash should have been blank" - Expect.isNone mt.salt "The password salt should not exist" - Expect.isNotNull mt.smallGroups "The small groups navigation property should not have been null" - Expect.isEmpty mt.smallGroups "There should be no small groups for an empty user" + Expect.equal mt.Id.Value Guid.Empty "The user ID should have been an empty GUID" + Expect.equal mt.FirstName "" "The first name should have been blank" + Expect.equal mt.LastName "" "The last name should have been blank" + Expect.equal mt.Email "" "The e-mail address should have been blank" + Expect.isFalse mt.IsAdmin "The is admin flag should not have been set" + Expect.equal mt.PasswordHash "" "The password hash should have been blank" + Expect.isNone mt.Salt "The password salt should not exist" + Expect.isNotNull mt.SmallGroups "The small groups navigation property should not have been null" + Expect.isEmpty mt.SmallGroups "There should be no small groups for an empty user" } test "fullName concatenates first and last names" { - let user = { User.empty with firstName = "Unit"; lastName = "Test" } + let user = { User.empty with FirstName = "Unit"; LastName = "Test" } Expect.equal user.fullName "Unit Test" "The full name should be the first and last, separated by a space" } ] @@ -367,9 +373,9 @@ let userSmallGroupTests = testList "UserSmallGroup" [ test "empty is as expected" { let mt = UserSmallGroup.empty - Expect.equal mt.userId Guid.Empty "The user ID should have been an empty GUID" - Expect.equal mt.smallGroupId Guid.Empty "The small group ID should have been an empty GUID" - Expect.equal mt.user.userId Guid.Empty "The user should have been an empty one" - Expect.equal mt.smallGroup.smallGroupId Guid.Empty "The small group should have been an empty one" + Expect.equal mt.UserId.Value Guid.Empty "The user ID should have been an empty GUID" + Expect.equal mt.SmallGroupId.Value Guid.Empty "The small group ID should have been an empty GUID" + Expect.equal mt.User.Id.Value Guid.Empty "The user should have been an empty one" + Expect.equal mt.SmallGroup.Id.Value Guid.Empty "The small group should have been an empty one" } ] diff --git a/src/PrayerTracker.Tests/UI/CommonFunctionsTests.fs b/src/PrayerTracker.Tests/UI/CommonFunctionsTests.fs index f858ce1..19f4cb3 100644 --- a/src/PrayerTracker.Tests/UI/CommonFunctionsTests.fs +++ b/src/PrayerTracker.Tests/UI/CommonFunctionsTests.fs @@ -178,37 +178,38 @@ let tableSummaryTests = module TimeZones = + open PrayerTracker.Entities open PrayerTracker.Views.CommonFunctions.TimeZones [] let nameTests = testList "TimeZones.name" [ test "succeeds for US Eastern time" { - Expect.equal (name "America/New_York" _s |> string) "Eastern" + Expect.equal (name (TimeZoneId "America/New_York") _s |> string) "Eastern" "US Eastern time zone not returned correctly" } test "succeeds for US Central time" { - Expect.equal (name "America/Chicago" _s |> string) "Central" + Expect.equal (name (TimeZoneId "America/Chicago") _s |> string) "Central" "US Central time zone not returned correctly" } test "succeeds for US Mountain time" { - Expect.equal (name "America/Denver" _s |> string) "Mountain" + Expect.equal (name (TimeZoneId "America/Denver") _s |> string) "Mountain" "US Mountain time zone not returned correctly" } test "succeeds for US Mountain (AZ) time" { - Expect.equal (name "America/Phoenix" _s |> string) "Mountain (Arizona)" + Expect.equal (name (TimeZoneId "America/Phoenix") _s |> string) "Mountain (Arizona)" "US Mountain (AZ) time zone not returned correctly" } test "succeeds for US Pacific time" { - Expect.equal (name "America/Los_Angeles" _s |> string) "Pacific" + Expect.equal (name (TimeZoneId "America/Los_Angeles") _s |> string) "Pacific" "US Pacific time zone not returned correctly" } test "succeeds for Central European time" { - Expect.equal (name "Europe/Berlin" _s |> string) "Central European" + Expect.equal (name (TimeZoneId "Europe/Berlin") _s |> string) "Central European" "Central European time zone not returned correctly" } test "fails for unexpected time zone" { - Expect.equal (name "Wakanda" _s |> string) "Wakanda" + Expect.equal (name (TimeZoneId "Wakanda") _s |> string) "Wakanda" "Unexpected time zone should have returned the original ID" } ] diff --git a/src/PrayerTracker.Tests/UI/ViewModelsTests.fs b/src/PrayerTracker.Tests/UI/ViewModelsTests.fs index ab1678a..2b9d94b 100644 --- a/src/PrayerTracker.Tests/UI/ViewModelsTests.fs +++ b/src/PrayerTracker.Tests/UI/ViewModelsTests.fs @@ -21,9 +21,12 @@ module ReferenceListTests = test "has all three options listed" { let asOf = ReferenceList.asOfDateList _s Expect.hasCountOf asOf 3u countAll "There should have been 3 as-of choices returned" - Expect.exists asOf (fun (x, _) -> x = NoDisplay.code) "The option for no display was not found" - Expect.exists asOf (fun (x, _) -> x = ShortDate.code) "The option for a short date was not found" - Expect.exists asOf (fun (x, _) -> x = LongDate.code) "The option for a full date was not found" + Expect.exists asOf (fun (x, _) -> x = AsOfDateDisplay.toCode NoDisplay) + "The option for no display was not found" + Expect.exists asOf (fun (x, _) -> x = AsOfDateDisplay.toCode ShortDate) + "The option for a short date was not found" + Expect.exists asOf (fun (x, _) -> x = AsOfDateDisplay.toCode LongDate) + "The option for a full date was not found" } ] @@ -37,9 +40,9 @@ module ReferenceListTests = Expect.equal (fst top) "" "The default option should have been blank" Expect.equal (snd top).Value "Group Default (HTML Format)" "The default option label was incorrect" let nxt = typs |> Seq.skip 1 |> Seq.head - Expect.equal (fst nxt) HtmlFormat.code "The 2nd option should have been HTML" + Expect.equal (fst nxt) (EmailFormat.toCode HtmlFormat) "The 2nd option should have been HTML" let lst = typs |> Seq.last - Expect.equal (fst lst) PlainTextFormat.code "The 3rd option should have been plain text" + Expect.equal (fst lst) (EmailFormat.toCode PlainTextFormat) "The 3rd option should have been plain text" } ] @@ -49,17 +52,19 @@ module ReferenceListTests = test "excludes immediate expiration if not required" { let exps = ReferenceList.expirationList _s false Expect.hasCountOf exps 2u countAll "There should have been 2 expiration types returned" - Expect.exists exps (fun (exp, _) -> exp = Automatic.code) + Expect.exists exps (fun (exp, _) -> exp = Expiration.toCode Automatic) "The option for automatic expiration was not found" - Expect.exists exps (fun (exp, _) -> exp = Manual.code) "The option for manual expiration was not found" + Expect.exists exps (fun (exp, _) -> exp = Expiration.toCode Manual) + "The option for manual expiration was not found" } test "includes immediate expiration if required" { let exps = ReferenceList.expirationList _s true Expect.hasCountOf exps 3u countAll "There should have been 3 expiration types returned" - Expect.exists exps (fun (exp, _) -> exp = Automatic.code) + Expect.exists exps (fun (exp, _) -> exp = Expiration.toCode Automatic) "The option for automatic expiration was not found" - Expect.exists exps (fun (exp, _) -> exp = Manual.code) "The option for manual expiration was not found" - Expect.exists exps (fun (exp, _) -> exp = Forced.code) + Expect.exists exps (fun (exp, _) -> exp = Expiration.toCode Manual) + "The option for manual expiration was not found" + Expect.exists exps (fun (exp, _) -> exp = Expiration.toCode Forced) "The option for immediate expiration was not found" } ] @@ -127,9 +132,9 @@ let appViewInfoTests = let assignGroupsTests = testList "AssignGroups" [ test "fromUser populates correctly" { - let usr = { User.empty with userId = Guid.NewGuid (); firstName = "Alice"; lastName = "Bob" } + let usr = { User.empty with Id = (Guid.NewGuid >> UserId) (); FirstName = "Alice"; LastName = "Bob" } let asg = AssignGroups.fromUser usr - Expect.equal asg.UserId usr.userId "The user ID was not filled correctly" + Expect.equal asg.UserId (shortGuid usr.Id.Value) "The user ID was not filled correctly" Expect.equal asg.UserName usr.fullName "The user name was not filled correctly" Expect.equal asg.SmallGroups "" "The small group string was not filled correctly" } @@ -141,38 +146,38 @@ let editChurchTests = test "fromChurch populates correctly when interface exists" { let church = { Church.empty with - churchId = Guid.NewGuid () - name = "Unit Test" - city = "Testlandia" - st = "UT" - hasInterface = true - interfaceAddress = Some "https://test-dem-units.test" + Id = (Guid.NewGuid >> ChurchId) () + Name = "Unit Test" + City = "Testlandia" + State = "UT" + HasInterface = true + InterfaceAddress = Some "https://test-dem-units.test" } let edit = EditChurch.fromChurch church - Expect.equal edit.ChurchId church.churchId "The church ID was not filled correctly" - Expect.equal edit.Name church.name "The church name was not filled correctly" - Expect.equal edit.City church.city "The church's city was not filled correctly" - Expect.equal edit.State church.st "The church's state was not filled correctly" + Expect.equal edit.ChurchId (shortGuid church.Id.Value) "The church ID was not filled correctly" + Expect.equal edit.Name church.Name "The church name was not filled correctly" + Expect.equal edit.City church.City "The church's city was not filled correctly" + Expect.equal edit.State church.State "The church's state was not filled correctly" Expect.isSome edit.HasInterface "The church should show that it has an interface" Expect.equal edit.HasInterface (Some true) "The hasInterface flag should be true" Expect.isSome edit.InterfaceAddress "The interface address should exist" - Expect.equal edit.InterfaceAddress church.interfaceAddress "The interface address was not filled correctly" + Expect.equal edit.InterfaceAddress church.InterfaceAddress "The interface address was not filled correctly" } test "fromChurch populates correctly when interface does not exist" { let edit = EditChurch.fromChurch { Church.empty with - churchId = Guid.NewGuid () - name = "Unit Test" - city = "Testlandia" - st = "UT" + Id = (Guid.NewGuid >> ChurchId) () + Name = "Unit Test" + City = "Testlandia" + State = "UT" } Expect.isNone edit.HasInterface "The church should not show that it has an interface" Expect.isNone edit.InterfaceAddress "The interface address should not exist" } test "empty is as expected" { let edit = EditChurch.empty - Expect.equal edit.ChurchId Guid.Empty "The church ID should be the empty GUID" + Expect.equal edit.ChurchId emptyGuid "The church ID should be the empty GUID" Expect.equal edit.Name "" "The church name should be blank" Expect.equal edit.City "" "The church's city should be blank" Expect.equal edit.State "" "The church's state should be blank" @@ -183,13 +188,13 @@ let editChurchTests = Expect.isTrue EditChurch.empty.IsNew "An empty GUID should be flagged as a new church" } test "isNew works on an existing church" { - Expect.isFalse { EditChurch.empty with ChurchId = Guid.NewGuid () }.IsNew + Expect.isFalse { EditChurch.empty with ChurchId = (Guid.NewGuid >> shortGuid) () }.IsNew "A non-empty GUID should not be flagged as a new church" } test "populateChurch works correctly when an interface exists" { let edit = { EditChurch.empty with - ChurchId = Guid.NewGuid () + ChurchId = (Guid.NewGuid >> shortGuid) () Name = "Test Baptist Church" City = "Testerville" State = "TE" @@ -197,23 +202,23 @@ let editChurchTests = InterfaceAddress = Some "https://test.units" } let church = edit.PopulateChurch Church.empty - Expect.notEqual church.churchId edit.ChurchId "The church ID should not have been modified" - Expect.equal church.name edit.Name "The church name was not updated correctly" - Expect.equal church.city edit.City "The church's city was not updated correctly" - Expect.equal church.st edit.State "The church's state was not updated correctly" - Expect.isTrue church.hasInterface "The church should show that it has an interface" - Expect.isSome church.interfaceAddress "The interface address should exist" - Expect.equal church.interfaceAddress edit.InterfaceAddress "The interface address was not updated correctly" + Expect.notEqual (shortGuid church.Id.Value) edit.ChurchId "The church ID should not have been modified" + Expect.equal church.Name edit.Name "The church name was not updated correctly" + Expect.equal church.City edit.City "The church's city was not updated correctly" + Expect.equal church.State edit.State "The church's state was not updated correctly" + Expect.isTrue church.HasInterface "The church should show that it has an interface" + Expect.isSome church.InterfaceAddress "The interface address should exist" + Expect.equal church.InterfaceAddress edit.InterfaceAddress "The interface address was not updated correctly" } test "populateChurch works correctly when an interface does not exist" { let church = { EditChurch.empty with - Name = "Test Baptist Church" - City = "Testerville" - State = "TE" + Name = "Test Baptist Church" + City = "Testerville" + State = "TE" }.PopulateChurch Church.empty - Expect.isFalse church.hasInterface "The church should show that it has an interface" - Expect.isNone church.interfaceAddress "The interface address should exist" + Expect.isFalse church.HasInterface "The church should show that it has an interface" + Expect.isNone church.InterfaceAddress "The interface address should exist" } ] @@ -223,23 +228,23 @@ let editMemberTests = test "fromMember populates with group default format" { let mbr = { Member.empty with - memberId = Guid.NewGuid () - memberName = "Test Name" - email = "test_units@example.com" + Id = (Guid.NewGuid >> MemberId) () + Name = "Test Name" + Email = "test_units@example.com" } let edit = EditMember.fromMember mbr - Expect.equal edit.MemberId mbr.memberId "The member ID was not filled correctly" - Expect.equal edit.Name mbr.memberName "The member name was not filled correctly" - Expect.equal edit.Email mbr.email "The e-mail address was not filled correctly" + Expect.equal edit.MemberId (shortGuid mbr.Id.Value) "The member ID was not filled correctly" + Expect.equal edit.Name mbr.Name "The member name was not filled correctly" + Expect.equal edit.Email mbr.Email "The e-mail address was not filled correctly" Expect.equal edit.Format "" "The e-mail format should have been blank for group default" } test "fromMember populates with specific format" { - let edit = EditMember.fromMember { Member.empty with format = Some HtmlFormat.code } - Expect.equal edit.Format HtmlFormat.code "The e-mail format was not filled correctly" + let edit = EditMember.fromMember { Member.empty with Format = Some HtmlFormat } + Expect.equal edit.Format (EmailFormat.toCode HtmlFormat) "The e-mail format was not filled correctly" } test "empty is as expected" { let edit = EditMember.empty - Expect.equal edit.MemberId Guid.Empty "The member ID should have been an empty GUID" + Expect.equal edit.MemberId emptyGuid "The member ID should have been an empty GUID" Expect.equal edit.Name "" "The member name should have been blank" Expect.equal edit.Email "" "The e-mail address should have been blank" Expect.equal edit.Format "" "The e-mail format should have been blank" @@ -248,7 +253,7 @@ let editMemberTests = Expect.isTrue EditMember.empty.IsNew "An empty GUID should be flagged as a new member" } test "isNew works for an existing member" { - Expect.isFalse { EditMember.empty with MemberId = Guid.NewGuid () }.IsNew + Expect.isFalse { EditMember.empty with MemberId = (Guid.NewGuid >> shortGuid) () }.IsNew "A non-empty GUID should not be flagged as a new member" } ] @@ -259,45 +264,47 @@ let editPreferencesTests = test "fromPreferences succeeds for named colors and private list" { let prefs = ListPreferences.empty let edit = EditPreferences.fromPreferences prefs - Expect.equal edit.ExpireDays prefs.daysToExpire "The expiration days were not filled correctly" - Expect.equal edit.DaysToKeepNew prefs.daysToKeepNew "The days to keep new were not filled correctly" - Expect.equal edit.LongTermUpdateWeeks prefs.longTermUpdateWeeks + Expect.equal edit.ExpireDays prefs.DaysToExpire "The expiration days were not filled correctly" + Expect.equal edit.DaysToKeepNew prefs.DaysToKeepNew "The days to keep new were not filled correctly" + Expect.equal edit.LongTermUpdateWeeks prefs.LongTermUpdateWeeks "The weeks for update were not filled correctly" - Expect.equal edit.RequestSort prefs.requestSort.code "The request sort was not filled correctly" - Expect.equal edit.EmailFromName prefs.emailFromName "The e-mail from name was not filled correctly" - Expect.equal edit.EmailFromAddress prefs.emailFromAddress "The e-mail from address was not filled correctly" - Expect.equal edit.DefaultEmailType prefs.defaultEmailType.code + Expect.equal edit.RequestSort (RequestSort.toCode prefs.RequestSort) + "The request sort was not filled correctly" + Expect.equal edit.EmailFromName prefs.EmailFromName "The e-mail from name was not filled correctly" + Expect.equal edit.EmailFromAddress prefs.EmailFromAddress "The e-mail from address was not filled correctly" + Expect.equal edit.DefaultEmailType (EmailFormat.toCode prefs.DefaultEmailType) "The default e-mail type was not filled correctly" Expect.equal edit.LineColorType "Name" "The heading line color type was not derived correctly" - Expect.equal edit.LineColor prefs.lineColor "The heading line color was not filled correctly" + Expect.equal edit.LineColor prefs.LineColor "The heading line color was not filled correctly" Expect.equal edit.HeadingColorType "Name" "The heading text color type was not derived correctly" - Expect.equal edit.HeadingColor prefs.headingColor "The heading text color was not filled correctly" - Expect.equal edit.Fonts prefs.listFonts "The list fonts were not filled correctly" - Expect.equal edit.HeadingFontSize prefs.headingFontSize "The heading font size was not filled correctly" - Expect.equal edit.ListFontSize prefs.textFontSize "The list text font size was not filled correctly" - Expect.equal edit.TimeZone prefs.timeZoneId "The time zone was not filled correctly" + Expect.equal edit.HeadingColor prefs.HeadingColor "The heading text color was not filled correctly" + Expect.equal edit.Fonts prefs.Fonts "The list fonts were not filled correctly" + Expect.equal edit.HeadingFontSize prefs.HeadingFontSize "The heading font size was not filled correctly" + Expect.equal edit.ListFontSize prefs.TextFontSize "The list text font size was not filled correctly" + Expect.equal edit.TimeZone (TimeZoneId.toString prefs.TimeZoneId) "The time zone was not filled correctly" Expect.isSome edit.GroupPassword "The group password should have been set" - Expect.equal edit.GroupPassword (Some prefs.groupPassword) "The group password was not filled correctly" + Expect.equal edit.GroupPassword (Some prefs.GroupPassword) "The group password was not filled correctly" Expect.equal edit.Visibility RequestVisibility.``private`` "The list visibility was not derived correctly" - Expect.equal edit.PageSize prefs.pageSize "The page size was not filled correctly" - Expect.equal edit.AsOfDate prefs.asOfDateDisplay.code "The as-of date display was not filled correctly" + Expect.equal edit.PageSize prefs.PageSize "The page size was not filled correctly" + Expect.equal edit.AsOfDate (AsOfDateDisplay.toCode prefs.AsOfDateDisplay) + "The as-of date display was not filled correctly" } test "fromPreferences succeeds for RGB line color and password-protected list" { - let prefs = { ListPreferences.empty with lineColor = "#ff0000"; groupPassword = "pw" } + let prefs = { ListPreferences.empty with LineColor = "#ff0000"; GroupPassword = "pw" } let edit = EditPreferences.fromPreferences prefs Expect.equal edit.LineColorType "RGB" "The heading line color type was not derived correctly" - Expect.equal edit.LineColor prefs.lineColor "The heading line color was not filled correctly" + Expect.equal edit.LineColor prefs.LineColor "The heading line color was not filled correctly" Expect.isSome edit.GroupPassword "The group password should have been set" - Expect.equal edit.GroupPassword (Some prefs.groupPassword) "The group password was not filled correctly" + Expect.equal edit.GroupPassword (Some prefs.GroupPassword) "The group password was not filled correctly" Expect.equal edit.Visibility RequestVisibility.passwordProtected "The list visibility was not derived correctly" } test "fromPreferences succeeds for RGB text color and public list" { - let prefs = { ListPreferences.empty with headingColor = "#0000ff"; isPublic = true } + let prefs = { ListPreferences.empty with HeadingColor = "#0000ff"; IsPublic = true } let edit = EditPreferences.fromPreferences prefs Expect.equal edit.HeadingColorType "RGB" "The heading text color type was not derived correctly" - Expect.equal edit.HeadingColor prefs.headingColor "The heading text color was not filled correctly" + Expect.equal edit.HeadingColor prefs.HeadingColor "The heading text color was not filled correctly" Expect.isSome edit.GroupPassword "The group password should have been set" Expect.equal edit.GroupPassword (Some "") "The group password was not filled correctly" Expect.equal edit.Visibility RequestVisibility.``public`` @@ -310,35 +317,38 @@ let editRequestTests = testList "EditRequest" [ test "empty is as expected" { let mt = EditRequest.empty - Expect.equal mt.RequestId Guid.Empty "The request ID should be an empty GUID" - Expect.equal mt.RequestType CurrentRequest.code "The request type should have been \"Current\"" + Expect.equal mt.RequestId emptyGuid "The request ID should be an empty GUID" + Expect.equal mt.RequestType (PrayerRequestType.toCode CurrentRequest) + "The request type should have been \"Current\"" Expect.isNone mt.EnteredDate "The entered date should have been None" Expect.isNone mt.SkipDateUpdate """The "skip date update" flag should have been None""" Expect.isNone mt.Requestor "The requestor should have been None" - Expect.equal mt.Expiration Automatic.code """The expiration should have been "A" (Automatic)""" + Expect.equal mt.Expiration (Expiration.toCode Automatic) + """The expiration should have been "A" (Automatic)""" Expect.equal mt.Text "" "The text should have been blank" } test "fromRequest succeeds" { let req = { PrayerRequest.empty with - prayerRequestId = Guid.NewGuid () - requestType = CurrentRequest - requestor = Some "Me" - expiration = Manual - text = "the text" - } + Id = (Guid.NewGuid >> PrayerRequestId) () + RequestType = CurrentRequest + Requestor = Some "Me" + Expiration = Manual + Text = "the text" + } let edit = EditRequest.fromRequest req - Expect.equal edit.RequestId req.prayerRequestId "The request ID was not filled correctly" - Expect.equal edit.RequestType req.requestType.code "The request type was not filled correctly" - Expect.equal edit.Requestor req.requestor "The requestor was not filled correctly" - Expect.equal edit.Expiration Manual.code "The expiration was not filled correctly" - Expect.equal edit.Text req.text "The text was not filled correctly" + Expect.equal edit.RequestId (shortGuid req.Id.Value) "The request ID was not filled correctly" + Expect.equal edit.RequestType (PrayerRequestType.toCode req.RequestType) + "The request type was not filled correctly" + Expect.equal edit.Requestor req.Requestor "The requestor was not filled correctly" + Expect.equal edit.Expiration (Expiration.toCode Manual) "The expiration was not filled correctly" + Expect.equal edit.Text req.Text "The text was not filled correctly" } test "isNew works for a new request" { Expect.isTrue EditRequest.empty.IsNew "An empty GUID should be flagged as a new request" } test "isNew works for an existing request" { - Expect.isFalse { EditRequest.empty with RequestId = Guid.NewGuid () }.IsNew + Expect.isFalse { EditRequest.empty with RequestId = (Guid.NewGuid >> shortGuid) () }.IsNew "A non-empty GUID should not be flagged as a new request" } ] @@ -349,37 +359,37 @@ let editSmallGroupTests = test "fromGroup succeeds" { let grp = { SmallGroup.empty with - smallGroupId = Guid.NewGuid () - name = "test group" - churchId = Guid.NewGuid () + Id = (Guid.NewGuid >> SmallGroupId) () + Name = "test group" + ChurchId = (Guid.NewGuid >> ChurchId) () } let edit = EditSmallGroup.fromGroup grp - Expect.equal edit.SmallGroupId grp.smallGroupId "The small group ID was not filled correctly" - Expect.equal edit.Name grp.name "The name was not filled correctly" - Expect.equal edit.ChurchId grp.churchId "The church ID was not filled correctly" + Expect.equal edit.SmallGroupId (shortGuid grp.Id.Value) "The small group ID was not filled correctly" + Expect.equal edit.Name grp.Name "The name was not filled correctly" + Expect.equal edit.ChurchId (shortGuid grp.ChurchId.Value) "The church ID was not filled correctly" } test "empty is as expected" { let mt = EditSmallGroup.empty - Expect.equal mt.SmallGroupId Guid.Empty "The small group ID should be an empty GUID" + Expect.equal mt.SmallGroupId emptyGuid "The small group ID should be an empty GUID" Expect.equal mt.Name "" "The name should be blank" - Expect.equal mt.ChurchId Guid.Empty "The church ID should be an empty GUID" + Expect.equal mt.ChurchId emptyGuid "The church ID should be an empty GUID" } test "isNew works for a new small group" { Expect.isTrue EditSmallGroup.empty.IsNew "An empty GUID should be flagged as a new small group" } test "isNew works for an existing small group" { - Expect.isFalse { EditSmallGroup.empty with SmallGroupId = Guid.NewGuid () }.IsNew + Expect.isFalse { EditSmallGroup.empty with SmallGroupId = (Guid.NewGuid >> shortGuid) () }.IsNew "A non-empty GUID should not be flagged as a new small group" } test "populateGroup succeeds" { let edit = { EditSmallGroup.empty with Name = "test name" - ChurchId = Guid.NewGuid () + ChurchId = (Guid.NewGuid >> shortGuid) () } let grp = edit.populateGroup SmallGroup.empty - Expect.equal grp.name edit.Name "The name was not populated correctly" - Expect.equal grp.churchId edit.ChurchId "The church ID was not populated correctly" + Expect.equal grp.Name edit.Name "The name was not populated correctly" + Expect.equal grp.ChurchId (idFromShort ChurchId edit.ChurchId) "The church ID was not populated correctly" } ] @@ -388,7 +398,7 @@ let editUserTests = testList "EditUser" [ test "empty is as expected" { let mt = EditUser.empty - Expect.equal mt.UserId Guid.Empty "The user ID should be an empty GUID" + Expect.equal mt.UserId emptyGuid "The user ID should be an empty GUID" Expect.equal mt.FirstName "" "The first name should be blank" Expect.equal mt.LastName "" "The last name should be blank" Expect.equal mt.Email "" "The e-mail address should be blank" @@ -399,23 +409,23 @@ let editUserTests = test "fromUser succeeds" { let usr = { User.empty with - userId = Guid.NewGuid () - firstName = "user" - lastName = "test" - emailAddress = "a@b.c" + Id = (Guid.NewGuid >> UserId) () + FirstName = "user" + LastName = "test" + Email = "a@b.c" } let edit = EditUser.fromUser usr - Expect.equal edit.UserId usr.userId "The user ID was not filled correctly" - Expect.equal edit.FirstName usr.firstName "The first name was not filled correctly" - Expect.equal edit.LastName usr.lastName "The last name was not filled correctly" - Expect.equal edit.Email usr.emailAddress "The e-mail address was not filled correctly" + Expect.equal edit.UserId (shortGuid usr.Id.Value) "The user ID was not filled correctly" + Expect.equal edit.FirstName usr.FirstName "The first name was not filled correctly" + Expect.equal edit.LastName usr.LastName "The last name was not filled correctly" + Expect.equal edit.Email usr.Email "The e-mail address was not filled correctly" Expect.isNone edit.IsAdmin "The IsAdmin flag was not filled correctly" } test "isNew works for a new user" { Expect.isTrue EditUser.empty.IsNew "An empty GUID should be flagged as a new user" } test "isNew works for an existing user" { - Expect.isFalse { EditUser.empty with UserId = Guid.NewGuid () }.IsNew + Expect.isFalse { EditUser.empty with UserId = (Guid.NewGuid >> shortGuid) () }.IsNew "A non-empty GUID should not be flagged as a new user" } test "populateUser succeeds" { @@ -429,11 +439,11 @@ let editUserTests = } let hasher = fun x -> x + "+" let usr = edit.PopulateUser User.empty hasher - Expect.equal usr.firstName edit.FirstName "The first name was not populated correctly" - Expect.equal usr.lastName edit.LastName "The last name was not populated correctly" - Expect.equal usr.emailAddress edit.Email "The e-mail address was not populated correctly" - Expect.isTrue usr.isAdmin "The isAdmin flag was not populated correctly" - Expect.equal usr.passwordHash (hasher edit.Password) "The password hash was not populated correctly" + Expect.equal usr.FirstName edit.FirstName "The first name was not populated correctly" + Expect.equal usr.LastName edit.LastName "The last name was not populated correctly" + Expect.equal usr.Email edit.Email "The e-mail address was not populated correctly" + Expect.isTrue usr.IsAdmin "The isAdmin flag was not populated correctly" + Expect.equal usr.PasswordHash (hasher edit.Password) "The password hash was not populated correctly" } ] @@ -442,7 +452,7 @@ let groupLogOnTests = testList "GroupLogOn" [ test "empty is as expected" { let mt = GroupLogOn.empty - Expect.equal mt.SmallGroupId Guid.Empty "The small group ID should be an empty GUID" + Expect.equal mt.SmallGroupId emptyGuid "The small group ID should be an empty GUID" Expect.equal mt.Password "" "The password should be blank" Expect.isNone mt.RememberMe "Remember Me should be None" } @@ -454,7 +464,7 @@ let maintainRequestsTests = test "empty is as expected" { let mt = MaintainRequests.empty Expect.isEmpty mt.Requests "The requests for the model should have been empty" - Expect.equal mt.SmallGroup.smallGroupId Guid.Empty "The small group should have been an empty one" + Expect.equal mt.SmallGroup.Id.Value Guid.Empty "The small group should have been an empty one" Expect.isNone mt.OnlyActive "The only active flag should have been None" Expect.isNone mt.SearchTerm "The search term should have been None" Expect.isNone mt.PageNbr "The page number should have been None" @@ -490,21 +500,21 @@ let requestListTests = let withRequestList f () = { Requests = [ { PrayerRequest.empty with - requestType = CurrentRequest - requestor = Some "Zeb" - text = "zyx" - updatedDate = DateTime.Today + RequestType = CurrentRequest + Requestor = Some "Zeb" + Text = "zyx" + UpdatedDate = DateTime.Today } { PrayerRequest.empty with - requestType = CurrentRequest - requestor = Some "Aaron" - text = "abc" - updatedDate = DateTime.Today - TimeSpan.FromDays 9. + RequestType = CurrentRequest + Requestor = Some "Aaron" + Text = "abc" + UpdatedDate = DateTime.Today - TimeSpan.FromDays 9. } { PrayerRequest.empty with - requestType = PraiseReport - text = "nmo" - updatedDate = DateTime.Today + RequestType = PraiseReport + Text = "nmo" + UpdatedDate = DateTime.Today } ] Date = DateTime.Today @@ -517,7 +527,7 @@ let requestListTests = yield! testFixture withRequestList [ "AsHtml succeeds without header or as-of date", fun reqList -> - let htmlList = { reqList with SmallGroup = { reqList.SmallGroup with name = "Test HTML Group" } } + let htmlList = { reqList with SmallGroup = { reqList.SmallGroup with Name = "Test HTML Group" } } let html = htmlList.AsHtml _s Expect.equal -1 (html.IndexOf "Test HTML Group") "The small group name should not have existed (no header)" @@ -557,7 +567,7 @@ let requestListTests = fun reqList -> let htmlList = { reqList with - SmallGroup = { reqList.SmallGroup with name = "Test HTML Group" } + SmallGroup = { reqList.SmallGroup with Name = "Test HTML Group" } ShowHeader = true } let html = htmlList.AsHtml _s @@ -578,12 +588,12 @@ let requestListTests = { reqList with SmallGroup = { reqList.SmallGroup with - preferences = { reqList.SmallGroup.preferences with asOfDateDisplay = ShortDate } + Preferences = { reqList.SmallGroup.Preferences with AsOfDateDisplay = ShortDate } } } let html = htmlList.AsHtml _s let expected = - htmlList.Requests[0].updatedDate.ToShortDateString () + htmlList.Requests[0].UpdatedDate.ToShortDateString () |> sprintf """Zeb — zyx  (as of %s)""" // spot check; if one request has it, they all should Expect.stringContains html expected "Expected short as-of date not found" @@ -593,20 +603,20 @@ let requestListTests = { reqList with SmallGroup = { reqList.SmallGroup with - preferences = { reqList.SmallGroup.preferences with asOfDateDisplay = LongDate } + Preferences = { reqList.SmallGroup.Preferences with AsOfDateDisplay = LongDate } } } let html = htmlList.AsHtml _s let expected = - htmlList.Requests[0].updatedDate.ToLongDateString () + htmlList.Requests[0].UpdatedDate.ToLongDateString () |> sprintf """Zeb — zyx  (as of %s)""" // spot check; if one request has it, they all should Expect.stringContains html expected "Expected long as-of date not found" "AsText succeeds with no as-of date", fun reqList -> - let textList = { reqList with SmallGroup = { reqList.SmallGroup with name = "Test Group" } } + let textList = { reqList with SmallGroup = { reqList.SmallGroup with Name = "Test Group" } } let text = textList.AsText _s - Expect.stringContains text $"{textList.SmallGroup.name}\n" "Small group name not found" + Expect.stringContains text $"{textList.SmallGroup.Name}\n" "Small group name not found" Expect.stringContains text "Prayer Requests\n" "List heading not found" Expect.stringContains text ((textList.Date.ToString "MMMM d, yyyy") + "\n \n") "List date not found" Expect.stringContains text "--------------------\n CURRENT REQUESTS\n--------------------\n" @@ -623,12 +633,12 @@ let requestListTests = { reqList with SmallGroup = { reqList.SmallGroup with - preferences = { reqList.SmallGroup.preferences with asOfDateDisplay = ShortDate } + Preferences = { reqList.SmallGroup.Preferences with AsOfDateDisplay = ShortDate } } } let text = textList.AsText _s let expected = - textList.Requests[0].updatedDate.ToShortDateString () + textList.Requests[0].UpdatedDate.ToShortDateString () |> 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" @@ -638,12 +648,12 @@ let requestListTests = { reqList with SmallGroup = { reqList.SmallGroup with - preferences = { reqList.SmallGroup.preferences with asOfDateDisplay = LongDate } + Preferences = { reqList.SmallGroup.Preferences with AsOfDateDisplay = LongDate } } } let text = textList.AsText _s let expected = - textList.Requests[0].updatedDate.ToLongDateString () + textList.Requests[0].UpdatedDate.ToLongDateString () |> 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" @@ -663,7 +673,7 @@ let requestListTests = let _, _, reqs = Option.get maybeCurrent Expect.hasCountOf reqs 2u countAll "There should have been two requests" let first = List.head reqs - Expect.equal first.text "zyx" "The requests should be sorted by updated date descending" + Expect.equal first.Text "zyx" "The requests should be sorted by updated date descending" Expect.isTrue (allReqs |> List.exists (fun (typ, _, _) -> typ = PraiseReport)) "There should have been praise reports" Expect.isFalse (allReqs |> List.exists (fun (typ, _, _) -> typ = Announcement)) @@ -674,14 +684,14 @@ let requestListTests = { reqList with SmallGroup = { reqList.SmallGroup with - preferences = { reqList.SmallGroup.preferences with requestSort = SortByRequestor } + Preferences = { reqList.SmallGroup.Preferences with RequestSort = SortByRequestor } } } let allReqs = newList.RequestsByType _s let _, _, reqs = allReqs |> List.find (fun (typ, _, _) -> typ = CurrentRequest) Expect.hasCountOf reqs 2u countAll "There should have been two requests" let first = List.head reqs - Expect.equal first.text "abc" "The requests should be sorted by requestor" + Expect.equal first.Text "abc" "The requests should be sorted by requestor" ] ] @@ -692,7 +702,7 @@ let userLogOnTests = let mt = UserLogOn.empty Expect.equal mt.Email "" "The e-mail address should be blank" Expect.equal mt.Password "" "The password should be blank" - Expect.equal mt.SmallGroupId Guid.Empty "The small group ID should be an empty GUID" + Expect.equal mt.SmallGroupId emptyGuid "The small group ID should be an empty GUID" Expect.isNone mt.RememberMe "Remember Me should be None" Expect.isNone mt.RedirectUrl "Redirect URL should be None" } diff --git a/src/PrayerTracker.UI/Church.fs b/src/PrayerTracker.UI/Church.fs index 4ea6d3d..3d5164f 100644 --- a/src/PrayerTracker.UI/Church.fs +++ b/src/PrayerTracker.UI/Church.fs @@ -1,6 +1,7 @@ module PrayerTracker.Views.Church open Giraffe.ViewEngine +open PrayerTracker open PrayerTracker.Entities open PrayerTracker.ViewModels @@ -19,7 +20,7 @@ let edit (model : EditChurch) ctx viewInfo = |> AppViewInfo.withOnLoadScript "PT.church.edit.onPageLoad" form [ _action "/church/save"; _method "post"; _class "pt-center-columns"; Target.content ] [ csrfToken ctx - input [ _type "hidden"; _name (nameof model.ChurchId); _value (flatGuid model.ChurchId) ] + input [ _type "hidden"; _name (nameof model.ChurchId); _value model.ChurchId ] div [ _fieldRow ] [ div [ _inputField ] [ label [ _for (nameof model.Name) ] [ locStr s["Church Name"] ] @@ -65,10 +66,10 @@ let maintain (churches : Church list) (stats : Map) ctx vi tableHeadings s [ "Actions"; "Name"; "Location"; "Groups"; "Requests"; "Users"; "Interface?" ] churches |> List.map (fun ch -> - let chId = flatGuid ch.churchId + let chId = shortGuid ch.Id.Value let delAction = $"/church/{chId}/delete" let delPrompt = s["Are you sure you want to delete this {0}? This action cannot be undone.", - $"""{s["Church"].Value.ToLower ()} ({ch.name})"""] + $"""{s["Church"].Value.ToLower ()} ({ch.Name})"""] tr [] [ td [] [ a [ _href $"/church/{chId}/edit"; _title s["Edit This Church"].Value ] [ icon "edit" ] @@ -78,12 +79,12 @@ let maintain (churches : Church list) (stats : Map) ctx vi icon "delete_forever" ] ] - td [] [ str ch.name ] - td [] [ str ch.city; rawText ", "; str ch.st ] - td [ _class "pt-right-text" ] [ rawText (stats[chId].smallGroups.ToString "N0") ] - td [ _class "pt-right-text" ] [ rawText (stats[chId].prayerRequests.ToString "N0") ] - td [ _class "pt-right-text" ] [ rawText (stats[chId].users.ToString "N0") ] - td [ _class "pt-center-text" ] [ locStr s[if ch.hasInterface then "Yes" else "No"] ] + td [] [ str ch.Name ] + td [] [ str ch.City; rawText ", "; str ch.State ] + td [ _class "pt-right-text" ] [ rawText (stats[chId].SmallGroups.ToString "N0") ] + td [ _class "pt-right-text" ] [ rawText (stats[chId].PrayerRequests.ToString "N0") ] + td [ _class "pt-right-text" ] [ rawText (stats[chId].Users.ToString "N0") ] + td [ _class "pt-center-text" ] [ locStr s[if ch.HasInterface then "Yes" else "No"] ] ]) |> tbody [] ] diff --git a/src/PrayerTracker.UI/CommonFunctions.fs b/src/PrayerTracker.UI/CommonFunctions.fs index 0f00478..003965a 100644 --- a/src/PrayerTracker.UI/CommonFunctions.fs +++ b/src/PrayerTracker.UI/CommonFunctions.fs @@ -103,16 +103,6 @@ let selectDefault text = $"— %s{text} —" /// Generate a standard submit button with icon and text let submit attrs ico text = button (_type "submit" :: attrs) [ icon ico; rawText "  "; locStr text ] - -open System - -// TODO: this is where to implement issue #1 -/// Format a GUID with no dashes (used for URLs and forms) -let flatGuid (x : Guid) = x.ToString "N" - -/// An empty GUID string (used for "add" actions) -let emptyGuid = flatGuid Guid.Empty - /// Create an HTML onsubmit event handler let _onsubmit = attr "onsubmit" @@ -167,6 +157,7 @@ let renderHtmlString = renderHtmlNode >> HtmlString module TimeZones = open System.Collections.Generic + open PrayerTracker.Entities /// Cross-reference between time zone Ids and their English names let private xref = @@ -180,7 +171,8 @@ module TimeZones = |> Map.ofList /// Get the name of a time zone, given its Id - let name tzId (s : IStringLocalizer) = + let name timeZoneId (s : IStringLocalizer) = + let tzId = TimeZoneId.toString timeZoneId try s[xref[tzId]] with :? KeyNotFoundException -> LocalizedString (tzId, tzId) diff --git a/src/PrayerTracker.UI/Layout.fs b/src/PrayerTracker.UI/Layout.fs index b303bf3..55baa66 100644 --- a/src/PrayerTracker.UI/Layout.fs +++ b/src/PrayerTracker.UI/Layout.fs @@ -50,7 +50,7 @@ module Navigation = ] ] ] - if u.isAdmin then + if u.IsAdmin then li [ _class "dropdown" ] [ a [ _dropdown _ariaLabel s["Administration"].Value @@ -167,8 +167,8 @@ module Navigation = icon "group" space match m.User with - | Some _ -> a [ _href "/small-group"; Target.content ] [ strong [] [ str g.name ] ] - | None -> strong [] [ str g.name ] + | Some _ -> a [ _href "/small-group"; Target.content ] [ strong [] [ str g.Name ] ] + | None -> strong [] [ str g.Name ] rawText "  " ] | None -> [] @@ -297,7 +297,7 @@ let private contentSection viewInfo pgTitle (content : XmlNode) = [ yield! messages viewInfo match viewInfo.ScopedStyle with | [] -> () - | styles -> style [ _scoped ] (styles |> List.map (fun it -> rawText $"{it};")) + | styles -> style [ _scoped ] (styles |> List.map (fun it -> rawText $"{it}; ")) content htmlFooter viewInfo for jsFile in viewInfo.Script do diff --git a/src/PrayerTracker.UI/PrayerRequest.fs b/src/PrayerTracker.UI/PrayerRequest.fs index 7ced85d..d89de0f 100644 --- a/src/PrayerTracker.UI/PrayerRequest.fs +++ b/src/PrayerTracker.UI/PrayerRequest.fs @@ -17,13 +17,13 @@ let edit (model : EditRequest) today ctx viewInfo = let vi = AppViewInfo.withOnLoadScript "PT.initCKEditor" viewInfo form [ _action "/prayer-request/save"; _method "post"; _class "pt-center-columns"; Target.content ] [ csrfToken ctx - inputField "hidden" (nameof model.RequestId) (flatGuid model.RequestId) [] + inputField "hidden" (nameof model.RequestId) model.RequestId [] div [ _fieldRow ] [ div [ _inputField ] [ label [ _for (nameof model.RequestType) ] [ locStr s["Request Type"] ] ReferenceList.requestTypeList s |> Seq.ofList - |> Seq.map (fun (typ, desc) -> typ.code, desc.Value) + |> Seq.map (fun (typ, desc) -> PrayerRequestType.toCode typ, desc.Value) |> selectList (nameof model.RequestType) model.RequestType [ _required; _autofocus ] ] div [ _inputField ] [ @@ -76,10 +76,10 @@ let edit (model : EditRequest) today ctx viewInfo = /// View for the request e-mail results page let email model viewInfo = let s = I18N.localizer.Force () - let pageTitle = $"""{s["Prayer Requests"].Value} • {model.SmallGroup.name}""" - let prefs = model.SmallGroup.preferences - let addresses = model.Recipients |> List.map (fun mbr -> $"{mbr.memberName} <{mbr.email}>") |> String.concat ", " - [ p [ _style $"font-family:{prefs.listFonts};font-size:%i{prefs.textFontSize}pt;" ] [ + let pageTitle = $"""{s["Prayer Requests"].Value} • {model.SmallGroup.Name}""" + let prefs = model.SmallGroup.Preferences + let addresses = model.Recipients |> List.map (fun mbr -> $"{mbr.Name} <{mbr.Email}>") |> String.concat ", " + [ p [ _style $"font-family:{prefs.Fonts};font-size:%i{prefs.TextFontSize}pt;" ] [ locStr s["The request list was sent to the following people, via individual e-mails"] rawText ":" br [] @@ -126,9 +126,9 @@ let lists (groups : SmallGroup list) viewInfo = tableHeadings s [ "Actions"; "Church"; "Group" ] groups |> List.map (fun grp -> - let grpId = flatGuid grp.smallGroupId + let grpId = shortGuid grp.Id.Value tr [] [ - if grp.preferences.isPublic then + if grp.Preferences.IsPublic then a [ _href $"/prayer-requests/{grpId}/list"; _title s["View"].Value ] [ icon "list" ] else a [ _href $"/small-group/log-on/{grpId}"; _title s["Log On"].Value ] [ @@ -136,8 +136,8 @@ let lists (groups : SmallGroup list) viewInfo = ] |> List.singleton |> td [] - td [] [ str grp.church.name ] - td [] [ str grp.name ] + td [] [ str grp.Church.Name ] + td [] [ str grp.Name ] ]) |> tbody [] ] @@ -153,19 +153,19 @@ let maintain (model : MaintainRequests) (ctx : HttpContext) viewInfo = use sw = new StringWriter () let raw = rawLocText sw let now = model.SmallGroup.localDateNow (ctx.GetService ()) - let prefs = model.SmallGroup.preferences + let prefs = model.SmallGroup.Preferences let types = ReferenceList.requestTypeList s |> Map.ofList let updReq (req : PrayerRequest) = - if req.updateRequired now prefs.daysToExpire prefs.longTermUpdateWeeks then "pt-request-update" else "" + if req.updateRequired now prefs.DaysToExpire prefs.LongTermUpdateWeeks then "pt-request-update" else "" |> _class let reqExp (req : PrayerRequest) = - _class (if req.isExpired now prefs.daysToExpire then "pt-request-expired" else "") + _class (if req.isExpired now prefs.DaysToExpire then "pt-request-expired" else "") /// Iterate the sequence once, before we render, so we can get the count of it at the top of the table let requests = model.Requests |> List.map (fun req -> - let reqId = flatGuid req.prayerRequestId - let reqText = htmlToPlainText req.text + let reqId = shortGuid req.Id.Value + let reqText = htmlToPlainText req.Text let delAction = $"/prayer-request/{reqId}/delete" let delPrompt = [ s["Are you sure you want to delete this {0}? This action cannot be undone.", @@ -180,7 +180,7 @@ let maintain (model : MaintainRequests) (ctx : HttpContext) viewInfo = a [ _href $"/prayer-request/{reqId}/edit"; _title l["Edit This Prayer Request"].Value ] [ icon "edit" ] - if req.isExpired now prefs.daysToExpire then + if req.isExpired now prefs.DaysToExpire then a [ _href $"/prayer-request/{reqId}/restore" _title l["Restore This Inactive Request"].Value ] [ icon "visibility" @@ -197,10 +197,10 @@ let maintain (model : MaintainRequests) (ctx : HttpContext) viewInfo = ] ] td [ updReq req ] [ - str (req.updatedDate.ToString(s["MMMM d, yyyy"].Value, Globalization.CultureInfo.CurrentUICulture)) + str (req.UpdatedDate.ToString(s["MMMM d, yyyy"].Value, Globalization.CultureInfo.CurrentUICulture)) ] - td [] [ locStr types[req.requestType] ] - td [ reqExp req ] [ str (match req.requestor with Some r -> r | None -> " ") ] + td [] [ locStr types[req.RequestType] ] + td [ reqExp req ] [ str (match req.Requestor with Some r -> r | None -> " ") ] td [] [ match reqText.Length with | len when len < 60 -> rawText reqText @@ -265,7 +265,7 @@ let maintain (model : MaintainRequests) (ctx : HttpContext) viewInfo = let withPage = match pg with 2 -> search | _ -> ("page", string (pg - 1)) :: search a [ _href (makeUrl url withPage) ] [ icon "keyboard_arrow_left"; space; raw l["Previous Page"] ] rawText "     " - match requests.Length = model.SmallGroup.preferences.pageSize with + match requests.Length = model.SmallGroup.Preferences.PageSize with | true -> a [ _href (makeUrl url (("page", string (pg + 1)) :: search)) ] [ raw l["Next Page"]; space; icon "keyboard_arrow_right" @@ -281,13 +281,13 @@ let maintain (model : MaintainRequests) (ctx : HttpContext) viewInfo = /// View for the printable prayer request list let print model version = let s = I18N.localizer.Force () - let pageTitle = $"""{s["Prayer Requests"].Value} • {model.SmallGroup.name}""" + let pageTitle = $"""{s["Prayer Requests"].Value} • {model.SmallGroup.Name}""" let imgAlt = $"""{s["PrayerTracker"].Value} {s["from Bit Badger Solutions"].Value}""" article [] [ rawText (model.AsHtml s) br [] hr [] - div [ _style $"font-size:70%%;font-family:{model.SmallGroup.preferences.listFonts};" ] [ + div [ _style $"font-size:70%%;font-family:{model.SmallGroup.Preferences.Fonts};" ] [ img [ _src $"""/img/{s["footer_en"].Value}.png""" _style "vertical-align:text-bottom;" _alt imgAlt @@ -302,7 +302,7 @@ let print model version = /// View for the prayer request list let view model viewInfo = let s = I18N.localizer.Force () - let pageTitle = $"""{s["Prayer Requests"].Value} • {model.SmallGroup.name}""" + let pageTitle = $"""{s["Prayer Requests"].Value} • {model.SmallGroup.Name}""" let spacer = rawText "       " let dtString = model.Date.ToString "yyyy-MM-dd" div [ _class "pt-center-text" ] [ diff --git a/src/PrayerTracker.UI/SmallGroup.fs b/src/PrayerTracker.UI/SmallGroup.fs index 9a68963..0faa9f5 100644 --- a/src/PrayerTracker.UI/SmallGroup.fs +++ b/src/PrayerTracker.UI/SmallGroup.fs @@ -2,6 +2,7 @@ open Giraffe.ViewEngine open Microsoft.Extensions.Localization +open PrayerTracker open PrayerTracker.Entities open PrayerTracker.ViewModels @@ -45,8 +46,8 @@ let announcement isAdmin ctx viewInfo = label [ _for (nameof model.RequestType) ] [ locStr s["Request Type"] ] reqTypes |> Seq.ofList - |> Seq.map (fun (typ, desc) -> typ.code, desc.Value) - |> selectList (nameof model.RequestType) Announcement.code [] + |> Seq.map (fun (typ, desc) -> PrayerRequestType.toCode typ, desc.Value) + |> selectList (nameof model.RequestType) (PrayerRequestType.toCode Announcement) [] ] ] div [ _fieldRow ] [ submit [] "send" s["Send Announcement"] ] @@ -76,7 +77,7 @@ let edit (model : EditSmallGroup) (churches : Church list) ctx viewInfo = let pageTitle = if model.IsNew then "Add a New Group" else "Edit Group" form [ _action "/small-group/save"; _method "post"; _class "pt-center-columns"; Target.content ] [ csrfToken ctx - inputField "hidden" (nameof model.SmallGroupId) (flatGuid model.SmallGroupId) [] + inputField "hidden" (nameof model.SmallGroupId) model.SmallGroupId [] div [ _fieldRow ] [ div [ _inputField ] [ label [ _for (nameof model.Name) ] [ locStr s["Group Name"] ] @@ -88,9 +89,9 @@ let edit (model : EditSmallGroup) (churches : Church list) ctx viewInfo = label [ _for (nameof model.ChurchId) ] [ locStr s["Church"] ] seq { "", selectDefault s["Select Church"].Value - yield! churches |> List.map (fun c -> flatGuid c.churchId, c.name) + yield! churches |> List.map (fun c -> shortGuid c.Id.Value, c.Name) } - |> selectList (nameof model.ChurchId) (flatGuid model.ChurchId) [ _required ] + |> selectList (nameof model.ChurchId) model.ChurchId [ _required ] ] ] div [ _fieldRow ] [ submit [] "save" s["Save Group"] ] @@ -111,7 +112,7 @@ let editMember (model : EditMember) (types : (string * LocalizedString) seq) ctx ] viewInfo form [ _action "/small-group/member/save"; _method "post"; _class "pt-center-columns"; Target.content ] [ csrfToken ctx - inputField "hidden" (nameof model.MemberId) (flatGuid model.MemberId) [] + inputField "hidden" (nameof model.MemberId) model.MemberId [] div [ _fieldRow ] [ div [ _inputField ] [ label [ _for (nameof model.Name) ] [ locStr s["Member Name"] ] @@ -140,7 +141,7 @@ let editMember (model : EditMember) (types : (string * LocalizedString) seq) ctx /// View for the small group log on page let logOn (groups : SmallGroup list) grpId ctx viewInfo = let s = I18N.localizer.Force () - let model = { SmallGroupId = System.Guid.Empty; Password = ""; RememberMe = None } + let model = { SmallGroupId = emptyGuid; Password = ""; RememberMe = None } let vi = AppViewInfo.withOnLoadScript "PT.smallGroup.logOn.onPageLoad" viewInfo form [ _action "/small-group/log-on/submit"; _method "post"; _class "pt-center-columns"; Target.body ] [ csrfToken ctx @@ -153,7 +154,7 @@ let logOn (groups : SmallGroup list) grpId ctx viewInfo = "", selectDefault s["Select Group"].Value yield! groups - |> List.map (fun grp -> flatGuid grp.smallGroupId, $"{grp.church.name} | {grp.name}") + |> List.map (fun grp -> shortGuid grp.Id.Value, $"{grp.Church.Name} | {grp.Name}") } |> selectList (nameof model.SmallGroupId) grpId [ _required ] ] @@ -187,10 +188,10 @@ let maintain (groups : SmallGroup list) ctx viewInfo = tableHeadings s [ "Actions"; "Name"; "Church"; "Time Zone"] groups |> List.map (fun g -> - let grpId = flatGuid g.smallGroupId + let grpId = shortGuid g.Id.Value let delAction = $"/small-group/{grpId}/delete" let delPrompt = s["Are you sure you want to delete this {0}? This action cannot be undone.", - $"""{s["Small Group"].Value.ToLower ()} ({g.name})""" ].Value + $"""{s["Small Group"].Value.ToLower ()} ({g.Name})""" ].Value tr [] [ td [] [ a [ _href $"/small-group/{grpId}/edit"; _title s["Edit This Group"].Value ] [ icon "edit" ] @@ -200,9 +201,9 @@ let maintain (groups : SmallGroup list) ctx viewInfo = icon "delete_forever" ] ] - td [] [ str g.name ] - td [] [ str g.church.name ] - td [] [ locStr (TimeZones.name g.preferences.timeZoneId s) ] + td [] [ str g.Name ] + td [] [ str g.Church.Name ] + td [] [ locStr (TimeZones.name g.Preferences.TimeZoneId s) ] ]) |> tbody [] ] @@ -233,11 +234,11 @@ let members (members : Member list) (emailTypes : Map) tableHeadings s [ "Actions"; "Name"; "E-mail Address"; "Format"] members |> List.map (fun mbr -> - let mbrId = flatGuid mbr.memberId + let mbrId = shortGuid mbr.Id.Value let delAction = $"/small-group/member/{mbrId}/delete" let delPrompt = s["Are you sure you want to delete this {0}? This action cannot be undone.", s["group member"]] - .Value.Replace("?", $" ({mbr.memberName})?") + .Value.Replace("?", $" ({mbr.Name})?") tr [] [ td [] [ a [ _href $"/small-group/member/{mbrId}/edit"; _title s["Edit This Group Member"].Value ] [ @@ -249,9 +250,9 @@ let members (members : Member list) (emailTypes : Map) icon "delete_forever" ] ] - td [] [ str mbr.memberName ] - td [] [ str mbr.email ] - td [] [ locStr emailTypes[defaultArg mbr.format ""] ] + td [] [ str mbr.Name ] + td [] [ str mbr.Email ] + td [] [ locStr emailTypes[defaultArg (mbr.Format |> Option.map EmailFormat.toCode) ""] ] ]) |> tbody [] ] @@ -326,7 +327,6 @@ let overview model viewInfo = open System.IO -open PrayerTracker /// View for the small group preferences page let preferences (model : EditPreferences) (tzs : TimeZone list) ctx viewInfo = @@ -494,7 +494,10 @@ let preferences (model : EditPreferences) (tzs : TimeZone list) ctx viewInfo = label [ _for (nameof model.TimeZone) ] [ locStr s["Time Zone"] ] seq { "", selectDefault s["Select"].Value - yield! tzs |> List.map (fun tz -> tz.timeZoneId, (TimeZones.name tz.timeZoneId s).Value) + yield! + tzs + |> List.map (fun tz -> + TimeZoneId.toString tz.Id, (TimeZones.name tz.Id s).Value) } |> selectList (nameof model.TimeZone) model.TimeZone [ _required ] ] diff --git a/src/PrayerTracker.UI/User.fs b/src/PrayerTracker.UI/User.fs index 5fb0bc7..3de292e 100644 --- a/src/PrayerTracker.UI/User.fs +++ b/src/PrayerTracker.UI/User.fs @@ -1,6 +1,7 @@ module PrayerTracker.Views.User open Giraffe.ViewEngine +open PrayerTracker open PrayerTracker.ViewModels /// View for the group assignment page @@ -9,7 +10,7 @@ let assignGroups model groups curGroups ctx viewInfo = let pageTitle = sprintf "%s • %A" model.UserName s["Assign Groups"] form [ _action "/user/small-groups/save"; _method "post"; _class "pt-center-columns"; Target.content ] [ csrfToken ctx - inputField "hidden" (nameof model.UserId) (flatGuid model.UserId) [] + inputField "hidden" (nameof model.UserId) model.UserId [] inputField "hidden" (nameof model.UserName) model.UserName [] table [ _class "pt-table" ] [ thead [] [ @@ -108,7 +109,7 @@ let edit (model : EditUser) ctx viewInfo = _onsubmit $"""return PT.compareValidation('{nameof model.Password}','{nameof model.PasswordConfirm}','%A{s["The passwords do not match"]}')""" Target.content ] [ csrfToken ctx - inputField "hidden" (nameof model.UserId) (flatGuid model.UserId) [] + inputField "hidden" (nameof model.UserId) model.UserId [] div [ _fieldRow ] [ div [ _inputField ] [ label [ _for (nameof model.FirstName) ] [ locStr s["First Name"] ] @@ -195,7 +196,7 @@ let maintain (users : User list) ctx viewInfo = tableHeadings s [ "Actions"; "Name"; "Admin?" ] users |> List.map (fun user -> - let userId = flatGuid user.userId + let userId = shortGuid user.Id.Value let delAction = $"/user/{userId}/delete" let delPrompt = s["Are you sure you want to delete this {0}? This action cannot be undone.", $"""{s["User"].Value.ToLower ()} ({user.fullName})"""].Value @@ -213,7 +214,7 @@ let maintain (users : User list) ctx viewInfo = ] td [] [ str user.fullName ] td [ _class "pt-center-text" ] [ - if user.isAdmin then strong [] [ locStr s["Yes"] ] else locStr s["No"] + if user.IsAdmin then strong [] [ locStr s["Yes"] ] else locStr s["No"] ] ]) |> tbody [] diff --git a/src/PrayerTracker.UI/Utils.fs b/src/PrayerTracker.UI/Utils.fs index 5940c86..901937c 100644 --- a/src/PrayerTracker.UI/Utils.fs +++ b/src/PrayerTracker.UI/Utils.fs @@ -12,12 +12,23 @@ let sha1Hash (x : string) = |> Seq.map (fun chr -> chr.ToString "x2") |> String.concat "" - /// Hash a string using 1,024 rounds of PBKDF2 and a salt let pbkdf2Hash (salt : Guid) (x : string) = use alg = new Rfc2898DeriveBytes (x, Encoding.UTF8.GetBytes (salt.ToString "N"), 1024) (alg.GetBytes >> Convert.ToBase64String) 64 +open Giraffe + +/// Parse a short-GUID-based ID from a string +let idFromShort<'T> (f : Guid -> 'T) strValue = + (ShortGuid.toGuid >> f) strValue + +/// Format a GUID as a short GUID +let shortGuid = ShortGuid.fromGuid + +/// An empty short GUID string (used for "add" actions) +let emptyGuid = shortGuid Guid.Empty + /// String helper functions module String = diff --git a/src/PrayerTracker.UI/ViewModels.fs b/src/PrayerTracker.UI/ViewModels.fs index 38a11c8..9a0c8ed 100644 --- a/src/PrayerTracker.UI/ViewModels.fs +++ b/src/PrayerTracker.UI/ViewModels.fs @@ -10,11 +10,11 @@ open PrayerTracker.Entities module ReferenceList = /// A localized list of the AsOfDateDisplay DU cases - let asOfDateList (s : IStringLocalizer) = - [ NoDisplay.code, s["Do not display the “as of” date"] - ShortDate.code, s["Display a short “as of” date"] - LongDate.code, s["Display a full “as of” date"] - ] + let asOfDateList (s : IStringLocalizer) = [ + AsOfDateDisplay.toCode NoDisplay, s["Do not display the “as of” date"] + AsOfDateDisplay.toCode ShortDate, s["Display a short “as of” date"] + AsOfDateDisplay.toCode LongDate, s["Display a full “as of” date"] + ] /// A list of e-mail type options let emailTypeList def (s : IStringLocalizer) = @@ -22,26 +22,26 @@ module ReferenceList = let defaultType = s[match def with HtmlFormat -> "HTML Format" | PlainTextFormat -> "Plain-Text Format"].Value seq { - "", LocalizedString ("", $"""{s["Group Default"].Value} ({defaultType})""") - HtmlFormat.code, s["HTML Format"] - PlainTextFormat.code, s["Plain-Text Format"] + "", LocalizedString ("", $"""{s["Group Default"].Value} ({defaultType})""") + EmailFormat.toCode HtmlFormat, s["HTML Format"] + EmailFormat.toCode PlainTextFormat, s["Plain-Text Format"] } /// A list of expiration options - let expirationList (s : IStringLocalizer) includeExpireNow = - [ Automatic.code, s["Expire Normally"] - Manual.code, s["Request Never Expires"] - if includeExpireNow then Forced.code, s["Expire Immediately"] - ] + let expirationList (s : IStringLocalizer) includeExpireNow = [ + Expiration.toCode Automatic, s["Expire Normally"] + Expiration.toCode Manual, s["Request Never Expires"] + if includeExpireNow then Expiration.toCode Forced, s["Expire Immediately"] + ] /// A list of request types - let requestTypeList (s : IStringLocalizer) = - [ CurrentRequest, s["Current Requests"] - LongTermRequest, s["Long-Term Requests"] - PraiseReport, s["Praise Reports"] - Expecting, s["Expecting"] - Announcement, s["Announcements"] - ] + let requestTypeList (s : IStringLocalizer) = [ + CurrentRequest, s["Current Requests"] + LongTermRequest, s["Long-Term Requests"] + PraiseReport, s["Praise Reports"] + Expecting, s["Expecting"] + Announcement, s["Announcements"] + ] /// A user message level @@ -209,7 +209,7 @@ with [] type AssignGroups = { /// The Id of the user being assigned - UserId : UserId + UserId : string /// The full name of the user being assigned UserName : string @@ -222,10 +222,10 @@ type AssignGroups = module AssignGroups = /// Create an instance of this form from an existing user - let fromUser (u : User) = - { UserId = u.userId - UserName = u.fullName - SmallGroups = "" + let fromUser (user : User) = + { UserId = shortGuid user.Id.Value + UserName = user.fullName + SmallGroups = "" } @@ -246,8 +246,8 @@ type ChangePassword = /// Form for adding or editing a church [] type EditChurch = - { /// The Id of the church - ChurchId : ChurchId + { /// The ID of the church + ChurchId : string /// The name of the church Name : string @@ -267,40 +267,39 @@ type EditChurch = with /// Is this a new church? - member this.IsNew - with get () = Guid.Empty = this.ChurchId + member this.IsNew = emptyGuid = this.ChurchId /// Populate a church from this form member this.PopulateChurch (church : Church) = { church with - name = this.Name - city = this.City - st = this.State - hasInterface = match this.HasInterface with Some x -> x | None -> false - interfaceAddress = match this.HasInterface with Some x when x -> this.InterfaceAddress | _ -> None + Name = this.Name + City = this.City + State = this.State + HasInterface = match this.HasInterface with Some x -> x | None -> false + InterfaceAddress = match this.HasInterface with Some x when x -> this.InterfaceAddress | _ -> None } /// Support for the EditChurch type module EditChurch = /// Create an instance from an existing church - let fromChurch (ch : Church) = - { ChurchId = ch.churchId - Name = ch.name - City = ch.city - State = ch.st - HasInterface = match ch.hasInterface with true -> Some true | false -> None - InterfaceAddress = ch.interfaceAddress + let fromChurch (church : Church) = + { ChurchId = shortGuid church.Id.Value + Name = church.Name + City = church.City + State = church.State + HasInterface = match church.HasInterface with true -> Some true | false -> None + InterfaceAddress = church.InterfaceAddress } /// An instance to use for adding churches let empty = - { ChurchId = Guid.Empty - Name = "" - City = "" - State = "" - HasInterface = None - InterfaceAddress = None + { ChurchId = emptyGuid + Name = "" + City = "" + State = "" + HasInterface = None + InterfaceAddress = None } @@ -308,7 +307,7 @@ module EditChurch = [] type EditMember = { /// The Id for this small group member (not user-entered) - MemberId : MemberId + MemberId : string /// The name of the member Name : string @@ -322,26 +321,25 @@ type EditMember = with /// Is this a new member? - member this.IsNew - with get () = Guid.Empty = this.MemberId + member this.IsNew = emptyGuid = this.MemberId /// Support for the EditMember type module EditMember = /// Create an instance from an existing member - let fromMember (m : Member) = - { MemberId = m.memberId - Name = m.memberName - Email = m.email - Format = match m.format with Some f -> f | None -> "" + let fromMember (mbr : Member) = + { MemberId = shortGuid mbr.Id.Value + Name = mbr.Name + Email = mbr.Email + Format = match mbr.Format with Some fmt -> EmailFormat.toCode fmt | None -> "" } /// An empty instance let empty = - { MemberId = Guid.Empty - Name = "" - Email = "" - Format = "" + { MemberId = emptyGuid + Name = "" + Email = "" + Format = "" } @@ -416,23 +414,23 @@ with | RequestVisibility.``private`` | _ -> false, "" { prefs with - daysToExpire = this.ExpireDays - daysToKeepNew = this.DaysToKeepNew - longTermUpdateWeeks = this.LongTermUpdateWeeks - requestSort = RequestSort.fromCode this.RequestSort - emailFromName = this.EmailFromName - emailFromAddress = this.EmailFromAddress - defaultEmailType = EmailFormat.fromCode this.DefaultEmailType - lineColor = this.LineColor - headingColor = this.HeadingColor - listFonts = this.Fonts - headingFontSize = this.HeadingFontSize - textFontSize = this.ListFontSize - timeZoneId = this.TimeZone - isPublic = isPublic - groupPassword = grpPw - pageSize = this.PageSize - asOfDateDisplay = AsOfDateDisplay.fromCode this.AsOfDate + DaysToExpire = this.ExpireDays + DaysToKeepNew = this.DaysToKeepNew + LongTermUpdateWeeks = this.LongTermUpdateWeeks + RequestSort = RequestSort.fromCode this.RequestSort + EmailFromName = this.EmailFromName + EmailFromAddress = this.EmailFromAddress + DefaultEmailType = EmailFormat.fromCode this.DefaultEmailType + LineColor = this.LineColor + HeadingColor = this.HeadingColor + Fonts = this.Fonts + HeadingFontSize = this.HeadingFontSize + TextFontSize = this.ListFontSize + TimeZoneId = TimeZoneId this.TimeZone + IsPublic = isPublic + GroupPassword = grpPw + PageSize = this.PageSize + AsOfDateDisplay = AsOfDateDisplay.fromCode this.AsOfDate } /// Support for the EditPreferences type @@ -440,37 +438,37 @@ module EditPreferences = /// Populate an edit form from existing preferences let fromPreferences (prefs : ListPreferences) = let setType (x : string) = match x.StartsWith "#" with true -> "RGB" | false -> "Name" - { ExpireDays = prefs.daysToExpire - DaysToKeepNew = prefs.daysToKeepNew - LongTermUpdateWeeks = prefs.longTermUpdateWeeks - RequestSort = prefs.requestSort.code - EmailFromName = prefs.emailFromName - EmailFromAddress = prefs.emailFromAddress - DefaultEmailType = prefs.defaultEmailType.code - LineColorType = setType prefs.lineColor - LineColor = prefs.lineColor - HeadingColorType = setType prefs.headingColor - HeadingColor = prefs.headingColor - Fonts = prefs.listFonts - HeadingFontSize = prefs.headingFontSize - ListFontSize = prefs.textFontSize - TimeZone = prefs.timeZoneId - GroupPassword = Some prefs.groupPassword - PageSize = prefs.pageSize - AsOfDate = prefs.asOfDateDisplay.code - Visibility = - match true with - | _ when prefs.isPublic -> RequestVisibility.``public`` - | _ when prefs.groupPassword = "" -> RequestVisibility.``private`` - | _ -> RequestVisibility.passwordProtected + { ExpireDays = prefs.DaysToExpire + DaysToKeepNew = prefs.DaysToKeepNew + LongTermUpdateWeeks = prefs.LongTermUpdateWeeks + RequestSort = RequestSort.toCode prefs.RequestSort + EmailFromName = prefs.EmailFromName + EmailFromAddress = prefs.EmailFromAddress + DefaultEmailType = EmailFormat.toCode prefs.DefaultEmailType + LineColorType = setType prefs.LineColor + LineColor = prefs.LineColor + HeadingColorType = setType prefs.HeadingColor + HeadingColor = prefs.HeadingColor + Fonts = prefs.Fonts + HeadingFontSize = prefs.HeadingFontSize + ListFontSize = prefs.TextFontSize + TimeZone = TimeZoneId.toString prefs.TimeZoneId + GroupPassword = Some prefs.GroupPassword + PageSize = prefs.PageSize + AsOfDate = AsOfDateDisplay.toCode prefs.AsOfDateDisplay + Visibility = + match true with + | _ when prefs.IsPublic -> RequestVisibility.``public`` + | _ when prefs.GroupPassword = "" -> RequestVisibility.``private`` + | _ -> RequestVisibility.passwordProtected } /// Form for adding or editing prayer requests [] type EditRequest = - { /// The Id of the request - RequestId : PrayerRequestId + { /// The ID of the request + RequestId : string /// The type of the request RequestType : string @@ -493,82 +491,80 @@ type EditRequest = with /// Is this a new request? - member this.IsNew - with get () = Guid.Empty = this.RequestId + member this.IsNew = emptyGuid = this.RequestId /// Support for the EditRequest type module EditRequest = /// An empty instance to use for new requests let empty = - { RequestId = Guid.Empty - RequestType = CurrentRequest.code - EnteredDate = None - SkipDateUpdate = None - Requestor = None - Expiration = Automatic.code - Text = "" + { RequestId = emptyGuid + RequestType = PrayerRequestType.toCode CurrentRequest + EnteredDate = None + SkipDateUpdate = None + Requestor = None + Expiration = Expiration.toCode Automatic + Text = "" } /// Create an instance from an existing request - let fromRequest req = + let fromRequest (req : PrayerRequest) = { empty with - RequestId = req.prayerRequestId - RequestType = req.requestType.code - Requestor = req.requestor - Expiration = req.expiration.code - Text = req.text + RequestId = shortGuid req.Id.Value + RequestType = PrayerRequestType.toCode req.RequestType + Requestor = req.Requestor + Expiration = Expiration.toCode req.Expiration + Text = req.Text } /// Form for the admin-level editing of small groups [] type EditSmallGroup = - { /// The Id of the small group - SmallGroupId : SmallGroupId + { /// The ID of the small group + SmallGroupId : string /// The name of the small group Name : string - /// The Id of the church to which this small group belongs - ChurchId : ChurchId + /// The ID of the church to which this small group belongs + ChurchId : string } with /// Is this a new small group? - member this.IsNew - with get () = Guid.Empty = this.SmallGroupId + member this.IsNew = emptyGuid = this.SmallGroupId /// Populate a small group from this form member this.populateGroup (grp : SmallGroup) = { grp with - name = this.Name - churchId = this.ChurchId + Name = this.Name + ChurchId = idFromShort ChurchId this.ChurchId } /// Support for the EditSmallGroup type module EditSmallGroup = /// Create an instance from an existing small group - let fromGroup (g : SmallGroup) = - { SmallGroupId = g.smallGroupId - Name = g.name - ChurchId = g.churchId + let fromGroup (grp : SmallGroup) = + { SmallGroupId = shortGuid grp.Id.Value + Name = grp.Name + ChurchId = shortGuid grp.ChurchId.Value } /// An empty instance (used when adding a new group) let empty = - { SmallGroupId = Guid.Empty - Name = "" - ChurchId = Guid.Empty + { SmallGroupId = emptyGuid + Name = "" + ChurchId = emptyGuid } /// Form for the user edit page [] type EditUser = - { /// The Id of the user - UserId : UserId + { /// The ID of the user + UserId : string /// The first name of the user FirstName : string @@ -591,43 +587,42 @@ type EditUser = with /// Is this a new user? - member this.IsNew - with get () = Guid.Empty = this.UserId + member this.IsNew = emptyGuid = this.UserId /// Populate a user from the form member this.PopulateUser (user : User) hasher = { user with - firstName = this.FirstName - lastName = this.LastName - emailAddress = this.Email - isAdmin = defaultArg this.IsAdmin false - } + FirstName = this.FirstName + LastName = this.LastName + Email = this.Email + IsAdmin = defaultArg this.IsAdmin false + } |> function | u when isNull this.Password || this.Password = "" -> u - | u -> { u with passwordHash = hasher this.Password } + | u -> { u with PasswordHash = hasher this.Password } /// Support for the EditUser type module EditUser = /// An empty instance let empty = - { UserId = Guid.Empty - FirstName = "" - LastName = "" - Email = "" - Password = "" - PasswordConfirm = "" - IsAdmin = None + { UserId = emptyGuid + FirstName = "" + LastName = "" + Email = "" + Password = "" + PasswordConfirm = "" + IsAdmin = None } /// Create an instance from an existing user let fromUser (user : User) = { empty with - UserId = user.userId - FirstName = user.firstName - LastName = user.lastName - Email = user.emailAddress - IsAdmin = if user.isAdmin then Some true else None + UserId = shortGuid user.Id.Value + FirstName = user.FirstName + LastName = user.LastName + Email = user.Email + IsAdmin = if user.IsAdmin then Some true else None } @@ -635,7 +630,7 @@ module EditUser = [] type GroupLogOn = { /// The ID of the small group to which the user is logging on - SmallGroupId : SmallGroupId + SmallGroupId : string /// The password entered Password : string @@ -649,9 +644,9 @@ module GroupLogOn = /// An empty instance let empty = - { SmallGroupId = Guid.Empty - Password = "" - RememberMe = None + { SmallGroupId = emptyGuid + Password = "" + RememberMe = None } @@ -679,11 +674,11 @@ module MaintainRequests = /// An empty instance let empty = - { Requests = [] - SmallGroup = SmallGroup.empty - OnlyActive = None - SearchTerm = None - PageNbr = None + { Requests = [] + SmallGroup = SmallGroup.empty + OnlyActive = None + SearchTerm = None + PageNbr = None } @@ -714,7 +709,7 @@ type UserLogOn = Password : string /// The ID of the small group to which the user is logging on - SmallGroupId : SmallGroupId + SmallGroupId : string /// Whether to remember the login RememberMe : bool option @@ -728,11 +723,11 @@ module UserLogOn = /// An empty instance let empty = - { Email = "" - Password = "" - SmallGroupId = Guid.Empty - RememberMe = None - RedirectUrl = None + { Email = "" + Password = "" + SmallGroupId = emptyGuid + RememberMe = None + RedirectUrl = None } @@ -765,13 +760,13 @@ with ReferenceList.requestTypeList s |> List.map (fun (typ, name) -> let sort = - match this.SmallGroup.preferences.requestSort with - | SortByDate -> Seq.sortByDescending (fun req -> req.updatedDate) - | SortByRequestor -> Seq.sortBy (fun req -> req.requestor) + match this.SmallGroup.Preferences.RequestSort with + | SortByDate -> Seq.sortByDescending (fun req -> req.UpdatedDate) + | SortByRequestor -> Seq.sortBy (fun req -> req.Requestor) let reqs = this.Requests |> Seq.ofList - |> Seq.filter (fun req -> req.requestType = typ) + |> Seq.filter (fun req -> req.RequestType = typ) |> sort |> List.ofSeq typ, name, reqs) @@ -779,20 +774,20 @@ with /// Is this request new? member this.IsNew (req : PrayerRequest) = - (this.Date - req.updatedDate).Days <= this.SmallGroup.preferences.daysToKeepNew + (this.Date - req.UpdatedDate).Days <= this.SmallGroup.Preferences.DaysToKeepNew /// Generate this list as HTML member this.AsHtml (s : IStringLocalizer) = - let prefs = this.SmallGroup.preferences - let asOfSize = Math.Round (float prefs.textFontSize * 0.8, 2) + let prefs = this.SmallGroup.Preferences + let asOfSize = Math.Round (float prefs.TextFontSize * 0.8, 2) [ if this.ShowHeader then - div [ _style $"text-align:center;font-family:{prefs.listFonts}" ] [ - span [ _style $"font-size:%i{prefs.headingFontSize}pt;" ] [ + div [ _style $"text-align:center;font-family:{prefs.Fonts}" ] [ + span [ _style $"font-size:%i{prefs.HeadingFontSize}pt;" ] [ strong [] [ str s["Prayer Requests"].Value ] ] br [] - span [ _style $"font-size:%i{prefs.textFontSize}pt;" ] [ - strong [] [ str this.SmallGroup.name ] + span [ _style $"font-size:%i{prefs.TextFontSize}pt;" ] [ + strong [] [ str this.SmallGroup.Name ] br [] str (this.Date.ToString s["MMMM d, yyyy"].Value) ] @@ -800,9 +795,9 @@ with br [] for _, name, reqs in this.RequestsByType s do div [ _style "padding-left:10px;padding-bottom:.5em;" ] [ - table [ _style $"font-family:{prefs.listFonts};page-break-inside:avoid;" ] [ + table [ _style $"font-family:{prefs.Fonts};page-break-inside:avoid;" ] [ tr [] [ - td [ _style $"font-size:%i{prefs.headingFontSize}pt;color:{prefs.headingColor};padding:3px 0;border-top:solid 3px {prefs.lineColor};border-bottom:solid 3px {prefs.lineColor};font-weight:bold;" ] [ + td [ _style $"font-size:%i{prefs.HeadingFontSize}pt;color:{prefs.HeadingColor};padding:3px 0;border-top:solid 3px {prefs.LineColor};border-bottom:solid 3px {prefs.LineColor};font-weight:bold;" ] [ rawText "    "; str name.Value; rawText "    " ] ] @@ -811,22 +806,22 @@ with reqs |> List.map (fun req -> let bullet = if this.IsNew req then "circle" else "disc" - li [ _style $"list-style-type:{bullet};font-family:{prefs.listFonts};font-size:%i{prefs.textFontSize}pt;padding-bottom:.25em;" ] [ - match req.requestor with + li [ _style $"list-style-type:{bullet};font-family:{prefs.Fonts};font-size:%i{prefs.TextFontSize}pt;padding-bottom:.25em;" ] [ + match req.Requestor with | Some r when r <> "" -> strong [] [ str r ] rawText " — " | Some _ -> () | None -> () - rawText req.text - match prefs.asOfDateDisplay with + rawText req.Text + match prefs.AsOfDateDisplay with | NoDisplay -> () | ShortDate | LongDate -> let dt = - match prefs.asOfDateDisplay with - | ShortDate -> req.updatedDate.ToShortDateString () - | LongDate -> req.updatedDate.ToLongDateString () + match prefs.AsOfDateDisplay with + | ShortDate -> req.UpdatedDate.ToShortDateString () + | LongDate -> req.UpdatedDate.ToLongDateString () | _ -> "" i [ _style $"font-size:%.2f{asOfSize}pt" ] [ rawText "  ("; str s["as of"].Value; str " "; str dt; rawText ")" @@ -840,7 +835,7 @@ with /// Generate this list as plain text member this.AsText (s : IStringLocalizer) = seq { - this.SmallGroup.name + this.SmallGroup.Name s["Prayer Requests"].Value this.Date.ToString s["MMMM d, yyyy"].Value " " @@ -851,17 +846,17 @@ with dashes for req in reqs do let bullet = if this.IsNew req then "+" else "-" - let requestor = match req.requestor with Some r -> $"{r} - " | None -> "" - match this.SmallGroup.preferences.asOfDateDisplay with + let requestor = match req.Requestor with Some r -> $"{r} - " | None -> "" + match this.SmallGroup.Preferences.AsOfDateDisplay with | NoDisplay -> "" | _ -> let dt = - match this.SmallGroup.preferences.asOfDateDisplay with - | ShortDate -> req.updatedDate.ToShortDateString () - | LongDate -> req.updatedDate.ToLongDateString () + match this.SmallGroup.Preferences.AsOfDateDisplay with + | ShortDate -> req.UpdatedDate.ToShortDateString () + | LongDate -> req.UpdatedDate.ToLongDateString () | _ -> "" $""" ({s["as of"].Value} {dt})""" - |> sprintf " %s %s%s%s" bullet requestor (htmlToPlainText req.text) + |> sprintf " %s %s%s%s" bullet requestor (htmlToPlainText req.Text) " " } |> String.concat "\n" diff --git a/src/PrayerTracker/Church.fs b/src/PrayerTracker/Church.fs index 2eb987b..7f0a12e 100644 --- a/src/PrayerTracker/Church.fs +++ b/src/PrayerTracker/Church.fs @@ -1,24 +1,21 @@ module PrayerTracker.Handlers.Church -open System -open System.Threading.Tasks open Giraffe open PrayerTracker open PrayerTracker.Entities open PrayerTracker.ViewModels -open PrayerTracker.Views.CommonFunctions /// Find statistics for the given church let private findStats (db : AppDbContext) churchId = task { let! grps = db.CountGroupsByChurch churchId let! reqs = db.CountRequestsByChurch churchId let! usrs = db.CountUsersByChurch churchId - return flatGuid churchId, { smallGroups = grps; prayerRequests = reqs; users = usrs } + return shortGuid churchId.Value, { SmallGroups = grps; PrayerRequests = reqs; Users = usrs } } - /// POST /church/[church-id]/delete -let delete churchId : HttpHandler = requireAccess [ Admin ] >=> validateCsrf >=> fun next ctx -> task { +let delete chId : HttpHandler = requireAccess [ Admin ] >=> validateCsrf >=> fun next ctx -> task { + let churchId = ChurchId chId match! ctx.db.TryChurchById churchId with | Some church -> let! _, stats = findStats ctx.db churchId @@ -27,11 +24,12 @@ let delete churchId : HttpHandler = requireAccess [ Admin ] >=> validateCsrf >=> let s = Views.I18N.localizer.Force () addInfo ctx s["The church {0} and its {1} small groups (with {2} prayer request(s)) were deleted successfully; revoked access from {3} user(s)", - church.name, stats.smallGroups, stats.prayerRequests, stats.users] + church.Name, stats.SmallGroups, stats.PrayerRequests, stats.Users] return! redirectTo false "/churches" next ctx | None -> return! fourOhFour next ctx } +open System /// GET /church/[church-id]/edit let edit churchId : HttpHandler = requireAccess [ Admin ] >=> fun next ctx -> task { @@ -42,7 +40,7 @@ let edit churchId : HttpHandler = requireAccess [ Admin ] >=> fun next ctx -> ta |> Views.Church.edit EditChurch.empty ctx |> renderHtml next ctx else - match! ctx.db.TryChurchById churchId with + match! ctx.db.TryChurchById (ChurchId churchId) with | Some church -> return! viewInfo ctx startTicks @@ -51,35 +49,35 @@ let edit churchId : HttpHandler = requireAccess [ Admin ] >=> fun next ctx -> ta | None -> return! fourOhFour next ctx } - /// GET /churches let maintain : HttpHandler = requireAccess [ Admin ] >=> fun next ctx -> task { let startTicks = DateTime.Now.Ticks let await = Async.AwaitTask >> Async.RunSynchronously let! churches = ctx.db.AllChurches () - let stats = churches |> List.map (fun c -> await (findStats ctx.db c.churchId)) + let stats = churches |> List.map (fun c -> await (findStats ctx.db c.Id)) return! viewInfo ctx startTicks |> Views.Church.maintain churches (stats |> Map.ofList) ctx |> renderHtml next ctx } +open System.Threading.Tasks /// POST /church/save let save : HttpHandler = requireAccess [ Admin ] >=> validateCsrf >=> fun next ctx -> task { match! ctx.TryBindFormAsync () with - | Ok m -> + | Ok model -> let! church = - if m.IsNew then Task.FromResult (Some { Church.empty with churchId = Guid.NewGuid () }) - else ctx.db.TryChurchById m.ChurchId + if model.IsNew then Task.FromResult (Some { Church.empty with Id = (Guid.NewGuid >> ChurchId) () }) + else ctx.db.TryChurchById (idFromShort ChurchId model.ChurchId) match church with | Some ch -> - m.PopulateChurch ch - |> (if m.IsNew then ctx.db.AddEntry else ctx.db.UpdateEntry) + model.PopulateChurch ch + |> (if model.IsNew then ctx.db.AddEntry else ctx.db.UpdateEntry) let! _ = ctx.db.SaveChangesAsync () let s = Views.I18N.localizer.Force () - let act = s[if m.IsNew then "Added" else "Updated"].Value.ToLower () - addInfo ctx s["Successfully {0} church “{1}”", act, m.Name] + let act = s[if model.IsNew then "Added" else "Updated"].Value.ToLower () + addInfo ctx s["Successfully {0} church “{1}”", act, model.Name] return! redirectTo false "/churches" next ctx | None -> return! fourOhFour next ctx | Result.Error e -> return! bindError e next ctx diff --git a/src/PrayerTracker/CommonFunctions.fs b/src/PrayerTracker/CommonFunctions.fs index f2bdccf..888f61d 100644 --- a/src/PrayerTracker/CommonFunctions.fs +++ b/src/PrayerTracker/CommonFunctions.fs @@ -72,8 +72,8 @@ let viewInfo (ctx : HttpContext) startTicks = // The idle timeout is 2 hours; if the app pool is recycled or the actual session goes away, we will log the // user back in transparently using this cookie. Every request resets the timer. let timeout = - { Id = u.userId - GroupId = (currentGroup ctx).smallGroupId + { Id = u.Id.Value + GroupId = (currentGroup ctx).Id.Value Until = DateTime.UtcNow.AddHours(2.).Ticks Password = "" } @@ -163,6 +163,7 @@ type AccessLevel = open Microsoft.AspNetCore.Http.Extensions +open PrayerTracker.Entities /// Require the given access role (also refreshes "Remember Me" user and group logons) let requireAccess level : HttpHandler = @@ -177,11 +178,11 @@ let requireAccess level : HttpHandler = try match TimeoutCookie.fromPayload ctx.Request.Cookies[Key.Cookie.timeout] with | Some c when c.Password = saltedTimeoutHash c -> - let! user = ctx.db.TryUserById c.Id + let! user = ctx.db.TryUserById (UserId c.Id) match user with | Some _ -> ctx.Session.user <- user - let! grp = ctx.db.TryGroupById c.GroupId + let! grp = ctx.db.TryGroupById (SmallGroupId c.GroupId) ctx.Session.smallGroup <- grp | _ -> () | _ -> () @@ -193,11 +194,11 @@ let requireAccess level : HttpHandler = let logOnUserFromCookie (ctx : HttpContext) = task { match UserCookie.fromPayload ctx.Request.Cookies[Key.Cookie.user] with | Some c -> - let! user = ctx.db.TryUserLogOnByCookie c.Id c.GroupId c.PasswordHash + let! user = ctx.db.TryUserLogOnByCookie (UserId c.Id) (SmallGroupId c.GroupId) c.PasswordHash match user with | Some _ -> ctx.Session.user <- user - let! grp = ctx.db.TryGroupById c.GroupId + let! grp = ctx.db.TryGroupById (SmallGroupId c.GroupId) ctx.Session.smallGroup <- grp // Rewrite the cookie to extend the expiration ctx.Response.Cookies.Append (Key.Cookie.user, c.toPayload (), autoRefresh) @@ -213,7 +214,7 @@ let requireAccess level : HttpHandler = let logOnGroupFromCookie (ctx : HttpContext) = task { match GroupCookie.fromPayload ctx.Request.Cookies[Key.Cookie.group] with | Some c -> - let! grp = ctx.db.TryGroupLogOnByCookie c.GroupId c.PasswordHash sha1Hash + let! grp = ctx.db.TryGroupLogOnByCookie (SmallGroupId c.GroupId) c.PasswordHash sha1Hash match grp with | Some _ -> ctx.Session.smallGroup <- grp @@ -236,7 +237,7 @@ let requireAccess level : HttpHandler = | _ when level |> List.contains User && isUserLoggedOn ctx -> return! next ctx | _ when level |> List.contains Group && isGroupLoggedOn ctx -> return! next ctx | _ when level |> List.contains Admin && isUserLoggedOn ctx -> - match (currentUser ctx).isAdmin with + match (currentUser ctx).IsAdmin with | true -> return! next ctx | false -> let s = Views.I18N.localizer.Force () diff --git a/src/PrayerTracker/Email.fs b/src/PrayerTracker/Email.fs index c9a1e78..3226a27 100644 --- a/src/PrayerTracker/Email.fs +++ b/src/PrayerTracker/Email.fs @@ -22,9 +22,9 @@ let getConnection () = task { /// Create a mail message object, filled with everything but the body content let createMessage (grp : SmallGroup) subj = let msg = new MimeMessage () - msg.From.Add (MailboxAddress (grp.preferences.emailFromName, fromAddress)) + msg.From.Add (MailboxAddress (grp.Preferences.EmailFromName, fromAddress)) msg.Subject <- subj - msg.ReplyTo.Add (MailboxAddress (grp.preferences.emailFromName, grp.preferences.emailFromAddress)) + msg.ReplyTo.Add (MailboxAddress (grp.Preferences.EmailFromName, grp.Preferences.EmailFromAddress)) msg /// Create an HTML-format e-mail message @@ -63,12 +63,8 @@ let sendEmails (client : SmtpClient) (recipients : Member list) grp subj html te use plainTextMsg = createTextMessage grp subj text s for mbr in recipients do - let emailType = - match mbr.format with - | Some f -> EmailFormat.fromCode f - | None -> grp.preferences.defaultEmailType - let emailTo = MailboxAddress (mbr.memberName, mbr.email) - match emailType with + let emailTo = MailboxAddress (mbr.Name, mbr.Email) + match defaultArg mbr.Format grp.Preferences.DefaultEmailType with | HtmlFormat -> htmlMsg.To.Add emailTo let! _ = client.SendAsync htmlMsg diff --git a/src/PrayerTracker/PrayerRequest.fs b/src/PrayerTracker/PrayerRequest.fs index 39efd37..8deb1bd 100644 --- a/src/PrayerTracker/PrayerRequest.fs +++ b/src/PrayerTracker/PrayerRequest.fs @@ -12,7 +12,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! ctx.db.TryRequestById reqId with - | Some req when req.smallGroupId = (currentGroup ctx).smallGroupId -> return Ok req + | Some req when req.SmallGroupId = (currentGroup ctx).Id -> return Ok req | Some _ -> let s = Views.I18N.localizer.Force () addError ctx s["The prayer request you tried to access is not assigned to your group"] @@ -27,12 +27,12 @@ let private generateRequestList ctx date = task { let listDate = match date with Some d -> d | None -> grp.localDateNow clock let! reqs = ctx.db.AllRequestsForSmallGroup grp clock (Some listDate) true 0 return - { Requests = reqs - Date = listDate - SmallGroup = grp - ShowHeader = true - CanEmail = Option.isSome ctx.Session.user - Recipients = [] + { Requests = reqs + Date = listDate + SmallGroup = grp + ShowHeader = true + CanEmail = Option.isSome ctx.Session.user + Recipients = [] } } @@ -44,20 +44,21 @@ let private parseListDate (date : string option) = /// GET /prayer-request/[request-id]/edit -let edit (reqId : PrayerRequestId) : HttpHandler = requireAccess [ User ] >=> fun next ctx -> task { +let edit reqId : HttpHandler = requireAccess [ User ] >=> fun next ctx -> task { let startTicks = DateTime.Now.Ticks let grp = currentGroup ctx let now = grp.localDateNow (ctx.GetService ()) - if reqId = Guid.Empty then + let requestId = PrayerRequestId reqId + if requestId.Value = Guid.Empty then return! { viewInfo ctx startTicks with Script = [ "ckeditor/ckeditor" ]; HelpLink = Some Help.editRequest } |> Views.PrayerRequest.edit EditRequest.empty (now.ToString "yyyy-MM-dd") ctx |> renderHtml next ctx else - match! findRequest ctx reqId with + match! findRequest ctx requestId with | Ok req -> let s = Views.I18N.localizer.Force () - if req.isExpired now grp.preferences.daysToExpire then + if req.isExpired now grp.Preferences.DaysToExpire then { UserMessage.warning with Text = htmlLocString s["This request is expired."] Description = @@ -81,10 +82,10 @@ let email date : HttpHandler = requireAccess [ User ] >=> fun next ctx -> task { let listDate = parseListDate (Some date) let grp = currentGroup ctx let! list = generateRequestList ctx listDate - let! recipients = ctx.db.AllMembersForSmallGroup grp.smallGroupId + let! recipients = ctx.db.AllMembersForSmallGroup grp.Id use! client = Email.getConnection () do! Email.sendEmails client recipients - grp s["Prayer Requests for {0} - {1:MMMM d, yyyy}", grp.name, list.Date].Value + grp s["Prayer Requests for {0} - {1:MMMM d, yyyy}", grp.Name, list.Date].Value (list.AsHtml s) (list.AsText s) s return! viewInfo ctx startTicks @@ -95,7 +96,8 @@ let email date : HttpHandler = requireAccess [ User ] >=> fun next ctx -> task { /// POST /prayer-request/[request-id]/delete let delete reqId : HttpHandler = requireAccess [ User ] >=> validateCsrf >=> fun next ctx -> task { - match! findRequest ctx reqId with + let requestId = PrayerRequestId reqId + match! findRequest ctx requestId with | Ok req -> let s = Views.I18N.localizer.Force () ctx.db.PrayerRequests.Remove req |> ignore @@ -108,10 +110,11 @@ let delete reqId : HttpHandler = requireAccess [ User ] >=> validateCsrf >=> fun /// GET /prayer-request/[request-id]/expire let expire reqId : HttpHandler = requireAccess [ User ] >=> fun next ctx -> task { - match! findRequest ctx reqId with + let requestId = PrayerRequestId reqId + match! findRequest ctx requestId with | Ok req -> let s = Views.I18N.localizer.Force () - ctx.db.UpdateEntry { req with expiration = Forced } + ctx.db.UpdateEntry { req with Expiration = Forced } let! _ = ctx.db.SaveChangesAsync () addInfo ctx s["Successfully {0} prayer request", s["Expired"].Value.ToLower ()] return! redirectTo false "/prayer-requests" next ctx @@ -123,7 +126,7 @@ let expire reqId : HttpHandler = requireAccess [ User ] >=> fun next ctx -> task let list groupId : HttpHandler = requireAccess [ AccessLevel.Public ] >=> fun next ctx -> task { let startTicks = DateTime.Now.Ticks match! ctx.db.TryGroupById groupId with - | Some grp when grp.preferences.isPublic -> + | Some grp when grp.Preferences.IsPublic -> let clock = ctx.GetService () let! reqs = ctx.db.AllRequestsForSmallGroup grp clock None true 0 return! @@ -203,10 +206,11 @@ let print date : HttpHandler = requireAccess [ User; Group ] >=> fun next ctx -> /// GET /prayer-request/[request-id]/restore let restore reqId : HttpHandler = requireAccess [ User ] >=> fun next ctx -> task { - match! findRequest ctx reqId with + let requestId = PrayerRequestId reqId + match! findRequest ctx requestId with | Ok req -> let s = Views.I18N.localizer.Force () - ctx.db.UpdateEntry { req with expiration = Automatic; updatedDate = DateTime.Now } + ctx.db.UpdateEntry { req with Expiration = Automatic; UpdatedDate = DateTime.Now } let! _ = ctx.db.SaveChangesAsync () addInfo ctx s["Successfully {0} prayer request", s["Restored"].Value.ToLower ()] return! redirectTo false "/prayer-requests" next ctx @@ -219,16 +223,16 @@ let save : HttpHandler = requireAccess [ User ] >=> validateCsrf >=> fun next ct match! ctx.TryBindFormAsync () with | Ok m -> let! req = - if m.IsNew then Task.FromResult (Some { PrayerRequest.empty with prayerRequestId = Guid.NewGuid () }) - else ctx.db.TryRequestById m.RequestId + if m.IsNew then Task.FromResult (Some { PrayerRequest.empty with Id = (Guid.NewGuid >> PrayerRequestId) () }) + else ctx.db.TryRequestById (idFromShort PrayerRequestId m.RequestId) match req with | Some pr -> let upd8 = { pr with - requestType = PrayerRequestType.fromCode m.RequestType - requestor = match m.Requestor with Some x when x.Trim () = "" -> None | x -> x - text = ckEditorToText m.Text - expiration = Expiration.fromCode m.Expiration + RequestType = PrayerRequestType.fromCode m.RequestType + Requestor = match m.Requestor with Some x when x.Trim () = "" -> None | x -> x + Text = ckEditorToText m.Text + Expiration = Expiration.fromCode m.Expiration } let grp = currentGroup ctx let now = grp.localDateNow (ctx.GetService ()) @@ -236,13 +240,13 @@ let save : HttpHandler = requireAccess [ User ] >=> validateCsrf >=> fun next ct | true -> let dt = defaultArg m.EnteredDate now { upd8 with - smallGroupId = grp.smallGroupId - userId = (currentUser ctx).userId - enteredDate = dt - updatedDate = dt + SmallGroupId = grp.Id + UserId = (currentUser ctx).Id + EnteredDate = dt + UpdatedDate = dt } | false when defaultArg m.SkipDateUpdate false -> upd8 - | false -> { upd8 with updatedDate = now } + | false -> { upd8 with UpdatedDate = now } |> if m.IsNew then ctx.db.AddEntry else ctx.db.UpdateEntry let! _ = ctx.db.SaveChangesAsync () let s = Views.I18N.localizer.Force () diff --git a/src/PrayerTracker/SmallGroup.fs b/src/PrayerTracker/SmallGroup.fs index cead3e9..26dc411 100644 --- a/src/PrayerTracker/SmallGroup.fs +++ b/src/PrayerTracker/SmallGroup.fs @@ -1,34 +1,29 @@ module PrayerTracker.Handlers.SmallGroup +open System open Giraffe -open Giraffe.ViewEngine open Microsoft.AspNetCore.Http -open NodaTime open PrayerTracker open PrayerTracker.Cookies open PrayerTracker.Entities open PrayerTracker.ViewModels -open PrayerTracker.Views.CommonFunctions -open System -open System.Threading.Tasks /// Set a small group "Remember Me" cookie let private setGroupCookie (ctx : HttpContext) pwHash = ctx.Response.Cookies.Append - (Key.Cookie.group, { GroupId = (currentGroup ctx).smallGroupId; PasswordHash = pwHash }.toPayload (), + (Key.Cookie.group, { GroupId = (currentGroup ctx).Id.Value; PasswordHash = pwHash }.toPayload (), autoRefresh) - /// GET /small-group/announcement let announcement : HttpHandler = requireAccess [ User ] >=> fun next ctx -> { viewInfo ctx DateTime.Now.Ticks with HelpLink = Some Help.sendAnnouncement; Script = [ "ckeditor/ckeditor" ] } - |> Views.SmallGroup.announcement (currentUser ctx).isAdmin ctx + |> Views.SmallGroup.announcement (currentUser ctx).IsAdmin ctx |> renderHtml next ctx - /// POST /small-group/[group-id]/delete -let delete groupId : HttpHandler = requireAccess [ Admin ] >=> validateCsrf >=> fun next ctx -> task { - let s = Views.I18N.localizer.Force () +let delete grpId : HttpHandler = requireAccess [ Admin ] >=> validateCsrf >=> fun next ctx -> task { + let s = Views.I18N.localizer.Force () + let groupId = SmallGroupId grpId match! ctx.db.TryGroupById groupId with | Some grp -> let! reqs = ctx.db.CountRequestsBySmallGroup groupId @@ -37,31 +32,31 @@ let delete groupId : HttpHandler = requireAccess [ Admin ] >=> validateCsrf >=> let! _ = ctx.db.SaveChangesAsync () addInfo ctx s["The group {0} and its {1} prayer request(s) were deleted successfully; revoked access from {2} user(s)", - grp.name, reqs, users] + grp.Name, reqs, users] return! redirectTo false "/small-groups" next ctx | None -> return! fourOhFour next ctx } - /// POST /small-group/member/[member-id]/delete -let deleteMember memberId : HttpHandler = requireAccess [ User ] >=> validateCsrf >=> fun next ctx -> task { - let s = Views.I18N.localizer.Force () +let deleteMember mbrId : HttpHandler = requireAccess [ User ] >=> validateCsrf >=> fun next ctx -> task { + let s = Views.I18N.localizer.Force () + let memberId = MemberId mbrId match! ctx.db.TryMemberById memberId with - | Some mbr when mbr.smallGroupId = (currentGroup ctx).smallGroupId -> + | Some mbr when mbr.SmallGroupId = (currentGroup ctx).Id -> ctx.db.RemoveEntry mbr let! _ = ctx.db.SaveChangesAsync () - addHtmlInfo ctx s["The group member “{0}” was deleted successfully", mbr.memberName] + addHtmlInfo ctx s["The group member “{0}” was deleted successfully", mbr.Name] return! redirectTo false "/small-group/members" next ctx | Some _ | None -> return! fourOhFour next ctx } - /// GET /small-group/[group-id]/edit -let edit (groupId : SmallGroupId) : HttpHandler = requireAccess [ Admin ] >=> fun next ctx -> task { +let edit grpId : HttpHandler = requireAccess [ Admin ] >=> fun next ctx -> task { let startTicks = DateTime.Now.Ticks let! churches = ctx.db.AllChurches () - if groupId = Guid.Empty then + let groupId = SmallGroupId grpId + if groupId.Value = Guid.Empty then return! viewInfo ctx startTicks |> Views.SmallGroup.edit EditSmallGroup.empty churches ctx @@ -76,21 +71,21 @@ let edit (groupId : SmallGroupId) : HttpHandler = requireAccess [ Admin ] >=> fu | None -> return! fourOhFour next ctx } - /// GET /small-group/member/[member-id]/edit -let editMember (memberId : MemberId) : HttpHandler = requireAccess [ User ] >=> fun next ctx -> task { +let editMember mbrId : HttpHandler = requireAccess [ User ] >=> fun next ctx -> task { let startTicks = DateTime.Now.Ticks let s = Views.I18N.localizer.Force () let grp = currentGroup ctx - let types = ReferenceList.emailTypeList grp.preferences.defaultEmailType s - if memberId = Guid.Empty then + let types = ReferenceList.emailTypeList grp.Preferences.DefaultEmailType s + let memberId = MemberId mbrId + if memberId.Value = Guid.Empty then return! viewInfo ctx startTicks |> Views.SmallGroup.editMember EditMember.empty types ctx |> renderHtml next ctx else match! ctx.db.TryMemberById memberId with - | Some mbr when mbr.smallGroupId = grp.smallGroupId -> + | Some mbr when mbr.SmallGroupId = grp.Id -> return! viewInfo ctx startTicks |> Views.SmallGroup.editMember (EditMember.fromMember mbr) types ctx @@ -99,25 +94,23 @@ let editMember (memberId : MemberId) : HttpHandler = requireAccess [ User ] >=> | None -> return! fourOhFour next ctx } - /// GET /small-group/log-on/[group-id?] -let logOn (groupId : SmallGroupId option) : HttpHandler = requireAccess [ AccessLevel.Public ] >=> fun next ctx -> task { +let logOn grpId : HttpHandler = requireAccess [ AccessLevel.Public ] >=> fun next ctx -> task { let startTicks = DateTime.Now.Ticks let! groups = ctx.db.ProtectedGroups () - let grpId = match groupId with Some gid -> flatGuid gid | None -> "" + let groupId = match grpId with Some gid -> shortGuid gid | None -> "" return! { viewInfo ctx startTicks with HelpLink = Some Help.logOn } - |> Views.SmallGroup.logOn groups grpId ctx + |> Views.SmallGroup.logOn groups groupId ctx |> renderHtml next ctx } - /// POST /small-group/log-on/submit let logOnSubmit : HttpHandler = requireAccess [ AccessLevel.Public ] >=> validateCsrf >=> fun next ctx -> task { match! ctx.TryBindFormAsync () with | Ok m -> let s = Views.I18N.localizer.Force () - match! ctx.db.TryGroupLogOnByPassword m.SmallGroupId m.Password with + match! ctx.db.TryGroupLogOnByPassword (idFromShort SmallGroupId m.SmallGroupId) m.Password with | Some grp -> ctx.Session.smallGroup <- Some grp if defaultArg m.RememberMe false then (setGroupCookie ctx << sha1Hash) m.Password @@ -125,11 +118,10 @@ let logOnSubmit : HttpHandler = requireAccess [ AccessLevel.Public ] >=> validat return! redirectTo false "/prayer-requests/view" next ctx | None -> addError ctx s["Password incorrect - login unsuccessful"] - return! redirectTo false $"/small-group/log-on/{flatGuid m.SmallGroupId}" next ctx + return! redirectTo false $"/small-group/log-on/{m.SmallGroupId}" next ctx | Result.Error e -> return! bindError e next ctx } - /// GET /small-groups let maintain : HttpHandler = requireAccess [ Admin ] >=> fun next ctx -> task { let startTicks = DateTime.Now.Ticks @@ -140,28 +132,28 @@ let maintain : HttpHandler = requireAccess [ Admin ] >=> fun next ctx -> task { |> renderHtml next ctx } - /// GET /small-group/members let members : HttpHandler = requireAccess [ User ] >=> fun next ctx -> task { let startTicks = DateTime.Now.Ticks let grp = currentGroup ctx let s = Views.I18N.localizer.Force () - let! members = ctx.db.AllMembersForSmallGroup grp.smallGroupId - let types = ReferenceList.emailTypeList grp.preferences.defaultEmailType s |> Map.ofSeq + let! members = ctx.db.AllMembersForSmallGroup grp.Id + let types = ReferenceList.emailTypeList grp.Preferences.DefaultEmailType s |> Map.ofSeq return! { viewInfo ctx startTicks with HelpLink = Some Help.maintainGroupMembers } |> Views.SmallGroup.members members types ctx |> renderHtml next ctx } +open NodaTime /// GET /small-group let overview : HttpHandler = requireAccess [ User ] >=> fun next ctx -> task { let startTicks = DateTime.Now.Ticks let clock = ctx.GetService () let! reqs = ctx.db.AllRequestsForSmallGroup (currentGroup ctx) clock None true 0 - let! reqCount = ctx.db.CountRequestsBySmallGroup (currentGroup ctx).smallGroupId - let! mbrCount = ctx.db.CountMembersForSmallGroup (currentGroup ctx).smallGroupId + let! reqCount = ctx.db.CountRequestsBySmallGroup (currentGroup ctx).Id + let! mbrCount = ctx.db.CountMembersForSmallGroup (currentGroup ctx).Id let m = { TotalActiveReqs = List.length reqs AllReqs = reqCount @@ -169,9 +161,9 @@ let overview : HttpHandler = requireAccess [ User ] >=> fun next ctx -> task { ActiveReqsByType = (reqs |> Seq.ofList - |> Seq.map (fun req -> req.requestType) + |> Seq.map (fun req -> req.RequestType) |> 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) } return! @@ -180,17 +172,17 @@ let overview : HttpHandler = requireAccess [ User ] >=> fun next ctx -> task { |> renderHtml next ctx } - /// GET /small-group/preferences let preferences : HttpHandler = requireAccess [ User ] >=> fun next ctx -> task { let startTicks = DateTime.Now.Ticks let! tzs = ctx.db.AllTimeZones () return! { viewInfo ctx startTicks with HelpLink = Some Help.groupPreferences } - |> Views.SmallGroup.preferences (EditPreferences.fromPreferences (currentGroup ctx).preferences) tzs ctx + |> Views.SmallGroup.preferences (EditPreferences.fromPreferences (currentGroup ctx).Preferences) tzs ctx |> renderHtml next ctx } +open System.Threading.Tasks /// POST /small-group/save let save : HttpHandler = requireAccess [ Admin ] >=> validateCsrf >=> fun next ctx -> task { @@ -198,15 +190,15 @@ let save : HttpHandler = requireAccess [ Admin ] >=> validateCsrf >=> fun next c | Ok m -> let s = Views.I18N.localizer.Force () let! group = - if m.IsNew then Task.FromResult (Some { SmallGroup.empty with smallGroupId = Guid.NewGuid () }) - else ctx.db.TryGroupById m.SmallGroupId + if m.IsNew then Task.FromResult (Some { SmallGroup.empty with Id = (Guid.NewGuid >> SmallGroupId) () }) + else ctx.db.TryGroupById (idFromShort SmallGroupId m.SmallGroupId) match group with | Some grp -> m.populateGroup grp |> function | grp when m.IsNew -> ctx.db.AddEntry grp - ctx.db.AddEntry { grp.preferences with smallGroupId = grp.smallGroupId } + ctx.db.AddEntry { grp.Preferences with SmallGroupId = grp.Id } | grp -> ctx.db.UpdateEntry grp let! _ = ctx.db.SaveChangesAsync () let act = s[if m.IsNew then "Added" else "Updated"].Value.ToLower () @@ -216,27 +208,26 @@ let save : HttpHandler = requireAccess [ Admin ] >=> validateCsrf >=> fun next c | Result.Error e -> return! bindError e next ctx } - /// POST /small-group/member/save let saveMember : HttpHandler = requireAccess [ User ] >=> validateCsrf >=> fun next ctx -> task { match! ctx.TryBindFormAsync () with - | Ok m -> + | Ok model -> let grp = currentGroup ctx let! mMbr = - if m.IsNew then - Task.FromResult (Some { Member.empty with memberId = Guid.NewGuid (); smallGroupId = grp.smallGroupId }) - else ctx.db.TryMemberById m.MemberId + if model.IsNew then + Task.FromResult (Some { Member.empty with Id = (Guid.NewGuid >> MemberId) (); SmallGroupId = grp.Id }) + else ctx.db.TryMemberById (idFromShort MemberId model.MemberId) match mMbr with - | Some mbr when mbr.smallGroupId = grp.smallGroupId -> + | Some mbr when mbr.SmallGroupId = grp.Id -> { mbr with - memberName = m.Name - email = m.Email - format = match m.Format with "" | null -> None | _ -> Some m.Format + Name = model.Name + Email = model.Email + Format = match model.Format with "" | null -> None | _ -> Some (EmailFormat.fromCode model.Format) } - |> if m.IsNew then ctx.db.AddEntry else ctx.db.UpdateEntry + |> if model.IsNew then ctx.db.AddEntry else ctx.db.UpdateEntry let! _ = ctx.db.SaveChangesAsync () let s = Views.I18N.localizer.Force () - let act = s[if m.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] return! redirectTo false "/small-group/members" next ctx | Some _ @@ -244,7 +235,6 @@ let saveMember : HttpHandler = requireAccess [ User ] >=> validateCsrf >=> fun n | Result.Error e -> return! bindError e next ctx } - /// POST /small-group/preferences/save let savePreferences : HttpHandler = requireAccess [ User ] >=> validateCsrf >=> fun next ctx -> task { match! ctx.TryBindFormAsync () with @@ -252,13 +242,13 @@ let savePreferences : HttpHandler = requireAccess [ User ] >=> validateCsrf >=> // 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. - match! ctx.db.TryGroupById (currentGroup ctx).smallGroupId with + match! ctx.db.TryGroupById (currentGroup ctx).Id with | Some grp -> - let prefs = m.PopulatePreferences grp.preferences + let prefs = m.PopulatePreferences grp.Preferences ctx.db.UpdateEntry prefs let! _ = ctx.db.SaveChangesAsync () // Refresh session instance - ctx.Session.smallGroup <- Some { grp with preferences = prefs } + ctx.Session.smallGroup <- Some { grp with Preferences = prefs } let s = Views.I18N.localizer.Force () addInfo ctx s["Group preferences updated successfully"] return! redirectTo false "/small-group/preferences" next ctx @@ -266,6 +256,8 @@ let savePreferences : HttpHandler = requireAccess [ User ] >=> validateCsrf >=> | Result.Error e -> return! bindError e next ctx } +open Giraffe.ViewEngine +open PrayerTracker.Views.CommonFunctions /// POST /small-group/announcement/send let sendAnnouncement : HttpHandler = requireAccess [ User ] >=> validateCsrf >=> fun next ctx -> task { @@ -279,18 +271,18 @@ let sendAnnouncement : HttpHandler = requireAccess [ User ] >=> validateCsrf >=> // Reformat the text to use the class's font stylings let requestText = ckEditorToText m.Text let htmlText = - p [ _style $"font-family:{grp.preferences.listFonts};font-size:%d{grp.preferences.textFontSize}pt;" ] + p [ _style $"font-family:{grp.Preferences.Fonts};font-size:%d{grp.Preferences.TextFontSize}pt;" ] [ rawText requestText ] |> renderHtmlNode let plainText = (htmlToPlainText >> wordWrap 74) htmlText // Send the e-mails let! recipients = match m.SendToClass with - | "N" when usr.isAdmin -> ctx.db.AllUsersAsMembers () - | _ -> ctx.db.AllMembersForSmallGroup grp.smallGroupId + | "N" when usr.IsAdmin -> ctx.db.AllUsersAsMembers () + | _ -> ctx.db.AllMembersForSmallGroup grp.Id use! client = Email.getConnection () do! Email.sendEmails client recipients grp - s["Announcement for {0} - {1:MMMM d, yyyy} {2}", grp.name, now.Date, + s["Announcement for {0} - {1:MMMM d, yyyy} {2}", grp.Name, now.Date, (now.ToString "h:mm tt").ToLower ()].Value htmlText plainText s // Add to the request list if desired @@ -300,13 +292,13 @@ let sendAnnouncement : HttpHandler = requireAccess [ User ] >=> validateCsrf >=> | _, Some x when not x -> () | _, _ -> { PrayerRequest.empty with - prayerRequestId = Guid.NewGuid () - smallGroupId = grp.smallGroupId - userId = usr.userId - requestType = (Option.get >> PrayerRequestType.fromCode) m.RequestType - text = requestText - enteredDate = now - updatedDate = now + Id = (Guid.NewGuid >> PrayerRequestId) () + SmallGroupId = grp.Id + UserId = usr.Id + RequestType = (Option.get >> PrayerRequestType.fromCode) m.RequestType + Text = requestText + EnteredDate = now + UpdatedDate = now } |> ctx.db.AddEntry let! _ = ctx.db.SaveChangesAsync () diff --git a/src/PrayerTracker/User.fs b/src/PrayerTracker/User.fs index 450a811..89cd0bb 100644 --- a/src/PrayerTracker/User.fs +++ b/src/PrayerTracker/User.fs @@ -1,47 +1,45 @@ module PrayerTracker.Handlers.User -open System -open System.Collections.Generic -open System.Net -open System.Threading.Tasks open Giraffe -open Microsoft.AspNetCore.Html open Microsoft.AspNetCore.Http open PrayerTracker open PrayerTracker.Cookies open PrayerTracker.Entities open PrayerTracker.ViewModels -open PrayerTracker.Views.CommonFunctions /// Set the user's "remember me" cookie let private setUserCookie (ctx : HttpContext) pwHash = ctx.Response.Cookies.Append ( Key.Cookie.user, - { Id = (currentUser ctx).userId; GroupId = (currentGroup ctx).smallGroupId; PasswordHash = pwHash }.toPayload (), + { Id = (currentUser ctx).Id.Value; GroupId = (currentGroup ctx).Id.Value; PasswordHash = pwHash }.toPayload (), autoRefresh) +open System +open System.Collections.Generic + /// Retrieve a user from the database by password // If the hashes do not match, determine if it matches a previous scheme, and upgrade them if it does -let private findUserByPassword m (db : AppDbContext) = task { - match! db.TryUserByEmailAndGroup m.Email m.SmallGroupId with - | Some u when Option.isSome u.salt -> +let private findUserByPassword model (db : AppDbContext) = task { + match! db.TryUserByEmailAndGroup model.Email (idFromShort SmallGroupId model.SmallGroupId) with + | Some u when Option.isSome u.Salt -> // Already upgraded; match = success - let pwHash = pbkdf2Hash (Option.get u.salt) m.Password - if u.passwordHash = pwHash then - return Some { u with passwordHash = ""; salt = None; smallGroups = List() }, pwHash + let pwHash = pbkdf2Hash (Option.get u.Salt) model.Password + if u.PasswordHash = pwHash then + return Some { u with PasswordHash = ""; Salt = None; SmallGroups = List() }, pwHash else return None, "" - | Some u when u.passwordHash = sha1Hash m.Password -> + | Some u when u.PasswordHash = sha1Hash model.Password -> // Not upgraded, but password is good; upgrade 'em! // Upgrade 'em! let salt = Guid.NewGuid () - let pwHash = pbkdf2Hash salt m.Password - let upgraded = { u with salt = Some salt; passwordHash = pwHash } + let pwHash = pbkdf2Hash salt model.Password + let upgraded = { u with Salt = Some salt; PasswordHash = pwHash } db.UpdateEntry upgraded let! _ = db.SaveChangesAsync () - return Some { u with passwordHash = ""; salt = None; smallGroups = List() }, pwHash + return Some { u with PasswordHash = ""; Salt = None; SmallGroups = List() }, pwHash | _ -> return None, "" } +open System.Threading.Tasks /// POST /user/password/change let changePassword : HttpHandler = requireAccess [ User ] >=> validateCsrf >=> fun next ctx -> task { @@ -49,13 +47,13 @@ let changePassword : HttpHandler = requireAccess [ User ] >=> validateCsrf >=> f | Ok m -> let s = Views.I18N.localizer.Force () let curUsr = currentUser ctx - let! dbUsr = ctx.db.TryUserById curUsr.userId + let! dbUsr = ctx.db.TryUserById curUsr.Id let! user = match dbUsr with | Some usr -> // Check the old password against a possibly non-salted hash - (match usr.salt with Some salt -> pbkdf2Hash salt | None -> sha1Hash) m.OldPassword - |> ctx.db.TryUserLogOnByCookie curUsr.userId (currentGroup ctx).smallGroupId + (match usr.Salt with Some salt -> pbkdf2Hash salt | None -> sha1Hash) m.OldPassword + |> ctx.db.TryUserLogOnByCookie curUsr.Id (currentGroup ctx).Id | _ -> Task.FromResult None match user with | Some _ when m.NewPassword = m.NewPasswordConfirm -> @@ -63,10 +61,10 @@ let changePassword : HttpHandler = requireAccess [ User ] >=> validateCsrf >=> f | Some usr -> // Generate new salt whenever the password is changed let salt = Guid.NewGuid () - ctx.db.UpdateEntry { usr with passwordHash = pbkdf2Hash salt m.NewPassword; salt = Some salt } + ctx.db.UpdateEntry { usr with PasswordHash = pbkdf2Hash salt m.NewPassword; Salt = Some salt } let! _ = ctx.db.SaveChangesAsync () // If the user is remembered, update the cookie with the new hash - if ctx.Request.Cookies.Keys.Contains Key.Cookie.user then setUserCookie ctx usr.passwordHash + if ctx.Request.Cookies.Keys.Contains Key.Cookie.user then setUserCookie ctx usr.PasswordHash addInfo ctx s["Your password was changed successfully"] | None -> addError ctx s["Unable to change password"] return! redirectTo false "/" next ctx @@ -79,9 +77,9 @@ let changePassword : HttpHandler = requireAccess [ User ] >=> validateCsrf >=> f | Result.Error e -> return! bindError e next ctx } - /// POST /user/[user-id]/delete -let delete userId : HttpHandler = requireAccess [ Admin ] >=> validateCsrf >=> fun next ctx -> task { +let delete usrId : HttpHandler = requireAccess [ Admin ] >=> validateCsrf >=> fun next ctx -> task { + let userId = UserId usrId match! ctx.db.TryUserById userId with | Some user -> ctx.db.RemoveEntry user @@ -92,33 +90,36 @@ let delete userId : HttpHandler = requireAccess [ Admin ] >=> validateCsrf >=> f | _ -> return! fourOhFour next ctx } +open System.Net +open Microsoft.AspNetCore.Html /// POST /user/log-on let doLogOn : HttpHandler = requireAccess [ AccessLevel.Public ] >=> validateCsrf >=> fun next ctx -> task { match! ctx.TryBindFormAsync () with - | Ok m -> + | Ok model -> let s = Views.I18N.localizer.Force () - let! usr, pwHash = findUserByPassword m ctx.db - let! grp = ctx.db.TryGroupById m.SmallGroupId + let! usr, pwHash = findUserByPassword model ctx.db + let! grp = ctx.db.TryGroupById (idFromShort SmallGroupId model.SmallGroupId) let nextUrl = match usr with | Some _ -> ctx.Session.user <- usr ctx.Session.smallGroup <- grp - if defaultArg m.RememberMe false then setUserCookie ctx pwHash + if defaultArg model.RememberMe false then setUserCookie ctx pwHash addHtmlInfo ctx s["Log On Successful • Welcome to {0}", s["PrayerTracker"]] - match m.RedirectUrl with + match model.RedirectUrl with | None -> "/small-group" + // TODO: ensure "x" is a local URL | Some x when x = "" -> "/small-group" | Some x -> x | _ -> - let grpName = match grp with Some g -> g.name | _ -> "N/A" + let grpName = match grp with Some g -> g.Name | _ -> "N/A" { UserMessage.error with Text = htmlLocString s["Invalid credentials - log on unsuccessful"] Description = [ s["This is likely due to one of the following reasons"].Value ":
  • " - s["The e-mail address “{0}” is invalid.", WebUtility.HtmlEncode m.Email].Value + s["The e-mail address “{0}” is invalid.", WebUtility.HtmlEncode model.Email].Value "
  • " s["The password entered does not match the password for the given e-mail address."].Value "
  • " @@ -137,9 +138,10 @@ let doLogOn : HttpHandler = requireAccess [ AccessLevel.Public ] >=> validateCsr /// GET /user/[user-id]/edit -let edit (userId : UserId) : HttpHandler = requireAccess [ Admin ] >=> fun next ctx -> task { +let edit usrId : HttpHandler = requireAccess [ Admin ] >=> fun next ctx -> task { let startTicks = DateTime.Now.Ticks - if userId = Guid.Empty then + let userId = UserId usrId + if userId.Value = Guid.Empty then return! viewInfo ctx startTicks |> Views.User.edit EditUser.empty ctx @@ -196,22 +198,22 @@ let save : HttpHandler = requireAccess [ Admin ] >=> validateCsrf >=> fun next c match! ctx.TryBindFormAsync () with | Ok m -> let! user = - if m.IsNew then Task.FromResult (Some { User.empty with userId = Guid.NewGuid () }) - else ctx.db.TryUserById m.UserId + if m.IsNew then Task.FromResult (Some { User.empty with Id = (Guid.NewGuid >> UserId) () }) + else ctx.db.TryUserById (idFromShort UserId m.UserId) let saltedUser = match user with | Some u -> - match u.salt with + match u.Salt with | None when m.Password <> "" -> // Generate salt so that a new password hash can be generated - Some { u with salt = Some (Guid.NewGuid ()) } + Some { u with Salt = Some (Guid.NewGuid ()) } | _ -> // Leave the user with no salt, so prior hash can be validated/upgraded user | _ -> user match saltedUser with | Some u -> - let updatedUser = m.PopulateUser u (pbkdf2Hash (Option.get u.salt)) + let updatedUser = m.PopulateUser u (pbkdf2Hash (Option.get u.Salt)) updatedUser |> if m.IsNew then ctx.db.AddEntry else ctx.db.UpdateEntry let! _ = ctx.db.SaveChangesAsync () let s = Views.I18N.localizer.Force () @@ -225,7 +227,7 @@ let save : HttpHandler = requireAccess [ Admin ] >=> validateCsrf >=> fun next c |> Some } |> addUserMessage ctx - return! redirectTo false $"/user/{flatGuid u.userId}/small-groups" next ctx + return! redirectTo false $"/user/{shortGuid u.Id.Value}/small-groups" next ctx else addInfo ctx s["Successfully {0} user", s["Updated"].Value.ToLower ()] return! redirectTo false "/users" next ctx @@ -237,30 +239,30 @@ let save : HttpHandler = requireAccess [ Admin ] >=> validateCsrf >=> fun next c /// POST /user/small-groups/save let saveGroups : HttpHandler = requireAccess [ Admin ] >=> validateCsrf >=> fun next ctx -> task { match! ctx.TryBindFormAsync () with - | Ok m -> + | Ok model -> let s = Views.I18N.localizer.Force () - match Seq.length m.SmallGroups with + match Seq.length model.SmallGroups with | 0 -> addError ctx s["You must select at least one group to assign"] - return! redirectTo false $"/user/{flatGuid m.UserId}/small-groups" next ctx + return! redirectTo false $"/user/{model.UserId}/small-groups" next ctx | _ -> - match! ctx.db.TryUserByIdWithGroups m.UserId with + match! ctx.db.TryUserByIdWithGroups (idFromShort UserId model.UserId) with | Some user -> let groups = - m.SmallGroups.Split ',' - |> Array.map Guid.Parse + model.SmallGroups.Split ',' + |> Array.map (idFromShort SmallGroupId) |> List.ofArray - user.smallGroups - |> Seq.filter (fun x -> not (groups |> List.exists (fun y -> y = x.smallGroupId))) + user.SmallGroups + |> Seq.filter (fun x -> not (groups |> List.exists (fun y -> y = x.SmallGroupId))) |> ctx.db.UserGroupXref.RemoveRange groups |> Seq.ofList - |> Seq.filter (fun x -> not (user.smallGroups |> Seq.exists (fun y -> y.smallGroupId = x))) - |> Seq.map (fun x -> { UserSmallGroup.empty with userId = user.userId; smallGroupId = x }) + |> Seq.filter (fun x -> not (user.SmallGroups |> Seq.exists (fun y -> y.SmallGroupId = x))) + |> Seq.map (fun x -> { UserSmallGroup.empty with UserId = user.Id; SmallGroupId = x }) |> List.ofSeq |> List.iter ctx.db.AddEntry let! _ = ctx.db.SaveChangesAsync () - addInfo ctx s["Successfully updated group permissions for {0}", m.UserName] + addInfo ctx s["Successfully updated group permissions for {0}", model.UserName] return! redirectTo false "/users" next ctx | _ -> return! fourOhFour next ctx | Result.Error e -> return! bindError e next ctx @@ -268,12 +270,13 @@ let saveGroups : HttpHandler = requireAccess [ Admin ] >=> validateCsrf >=> fun /// GET /user/[user-id]/small-groups -let smallGroups userId : HttpHandler = requireAccess [ Admin ] >=> fun next ctx -> task { +let smallGroups usrId : HttpHandler = requireAccess [ Admin ] >=> fun next ctx -> task { let startTicks = DateTime.Now.Ticks + let userId = UserId usrId match! ctx.db.TryUserByIdWithGroups userId with | Some user -> let! groups = ctx.db.GroupList () - let curGroups = user.smallGroups |> Seq.map (fun g -> flatGuid g.smallGroupId) |> List.ofSeq + let curGroups = user.SmallGroups |> Seq.map (fun g -> shortGuid g.SmallGroupId.Value) |> List.ofSeq return! viewInfo ctx startTicks |> Views.User.assignGroups (AssignGroups.fromUser user) groups curGroups ctx