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

WIP on F# 6 formatting / conversion

Browse Source
This commit is contained in:
Daniel J. Summers 2022-07-12 22:43:01 -04:00
parent 1d4e66b863
commit 47fb9884f1
25 changed files with 4498 additions and 4516 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

6
src/PrayerTracker.Data/AppDbContext.fs
View File

@ -69,7 +69,11 @@ type AppDbContext (options : DbContextOptions<AppDbContext>) =
member this.AsyncSaveChanges () = member this.AsyncSaveChanges () =
this.SaveChangesAsync () |> Async.AwaitTask this.SaveChangesAsync () |> Async.AwaitTask
override __.OnModelCreating (modelBuilder : ModelBuilder) = override _.OnConfiguring (optionsBuilder : DbContextOptionsBuilder) =
base.OnConfiguring optionsBuilder
optionsBuilder.UseQueryTrackingBehavior QueryTrackingBehavior.NoTracking |> ignore
override _.OnModelCreating (modelBuilder : ModelBuilder) =
base.OnModelCreating modelBuilder base.OnModelCreating modelBuilder
modelBuilder.HasDefaultSchema "pt" |> ignore modelBuilder.HasDefaultSchema "pt" |> ignore

365
src/PrayerTracker.Data/DataAccess.fs
View File

@ -1,39 +1,33 @@
[<AutoOpen>] [<AutoOpen>]
module PrayerTracker.DataAccess module PrayerTracker.DataAccess
open Microsoft.EntityFrameworkCore
open PrayerTracker.Entities
open System.Collections.Generic
open System.Linq open System.Linq
open PrayerTracker.Entities
[<AutoOpen>] [<AutoOpen>]
module private Helpers = module private Helpers =
open Microsoft.FSharpLu
open System.Threading.Tasks
/// Central place to append sort criteria for prayer request queries /// Central place to append sort criteria for prayer request queries
let reqSort sort (q : IQueryable<PrayerRequest>) = let reqSort sort (q : IQueryable<PrayerRequest>) =
match sort with match sort with
| SortByDate -> | SortByDate ->
query { q.OrderByDescending(fun req -> req.updatedDate)
for req in q do .ThenByDescending(fun req -> req.enteredDate)
sortByDescending req.updatedDate .ThenBy (fun req -> req.requestor)
thenByDescending req.enteredDate
thenBy req.requestor
}
| SortByRequestor -> | SortByRequestor ->
query { q.OrderBy(fun req -> req.requestor)
for req in q do .ThenByDescending(fun req -> req.updatedDate)
sortBy req.requestor .ThenByDescending (fun req -> req.enteredDate)
thenByDescending req.updatedDate
thenByDescending req.enteredDate
}
/// Convert a possibly-null object to an option, wrapped as a task /// Paginate a prayer request query
let toOptionTask<'T> (item : 'T) = (Option.fromObject >> Task.FromResult) item let paginate pageNbr pageSize (q : IQueryable<PrayerRequest>) =
q.Skip((pageNbr - 1) * pageSize).Take pageSize
open System.Collections.Generic
open Microsoft.EntityFrameworkCore
open Microsoft.FSharpLu
type AppDbContext with type AppDbContext with
(*-- DISCONNECTED DATA EXTENSIONS --*) (*-- DISCONNECTED DATA EXTENSIONS --*)
@ -53,328 +47,241 @@ type AppDbContext with
(*-- CHURCH EXTENSIONS --*) (*-- CHURCH EXTENSIONS --*)
/// Find a church by its Id /// Find a church by its Id
member this.TryChurchById cId = member this.TryChurchById cId = backgroundTask {
query { let! church = this.Churches.SingleOrDefaultAsync (fun ch -> ch.churchId = cId)
for ch in this.Churches.AsNoTracking () do return Option.fromObject church
where (ch.churchId = cId)
exactlyOneOrDefault
} }
|> toOptionTask
/// Find all churches /// Find all churches
member this.AllChurches () = member this.AllChurches () = backgroundTask {
task { let! churches = this.Churches.OrderBy(fun ch -> ch.name).ToListAsync ()
let q =
query {
for ch in this.Churches.AsNoTracking () do
sortBy ch.name
}
let! churches = q.ToListAsync ()
return List.ofSeq churches return List.ofSeq churches
} }
(*-- MEMBER EXTENSIONS --*) (*-- MEMBER EXTENSIONS --*)
/// Get a small group member by its Id /// Get a small group member by its Id
member this.TryMemberById mId = member this.TryMemberById mbrId = backgroundTask {
query { let! mbr = this.Members.SingleOrDefaultAsync (fun m -> m.memberId = mbrId)
for mbr in this.Members.AsNoTracking () do return Option.fromObject mbr
where (mbr.memberId = mId)
select mbr
exactlyOneOrDefault
} }
|> toOptionTask
/// Find all members for a small group /// Find all members for a small group
member this.AllMembersForSmallGroup gId = member this.AllMembersForSmallGroup gId = backgroundTask {
task { let! members =
let q = this.Members.Where(fun mbr -> mbr.smallGroupId = gId)
query { .OrderBy(fun mbr -> mbr.memberName)
for mbr in this.Members.AsNoTracking () do .ToListAsync ()
where (mbr.smallGroupId = gId) return List.ofSeq members
sortBy mbr.memberName
}
let! mbrs = q.ToListAsync ()
return List.ofSeq mbrs
} }
/// Count members for a small group /// Count members for a small group
member this.CountMembersForSmallGroup gId = member this.CountMembersForSmallGroup gId = backgroundTask {
this.Members.CountAsync (fun m -> m.smallGroupId = gId) return! this.Members.CountAsync (fun m -> m.smallGroupId = gId)
}
(*-- PRAYER REQUEST EXTENSIONS --*) (*-- PRAYER REQUEST EXTENSIONS --*)
/// Get a prayer request by its Id /// Get a prayer request by its Id
member this.TryRequestById reqId = member this.TryRequestById reqId = backgroundTask {
query { let! req = this.PrayerRequests.SingleOrDefaultAsync (fun r -> r.prayerRequestId = reqId)
for req in this.PrayerRequests.AsNoTracking () do return Option.fromObject req
where (req.prayerRequestId = reqId)
exactlyOneOrDefault
} }
|> toOptionTask
/// Get all (or active) requests for a small group as of now or the specified date /// Get all (or active) requests for a small group as of now or the specified date
// TODO: why not make this an async list like the rest of these methods? member this.AllRequestsForSmallGroup (grp : SmallGroup) clock listDate activeOnly pageNbr = backgroundTask {
member this.AllRequestsForSmallGroup (grp : SmallGroup) clock listDate activeOnly pageNbr : PrayerRequest seq =
let theDate = match listDate with Some dt -> dt | _ -> grp.localDateNow clock let theDate = match listDate with Some dt -> dt | _ -> grp.localDateNow clock
query { let query =
for req in this.PrayerRequests.AsNoTracking () do this.PrayerRequests.Where(fun req -> req.smallGroupId = grp.smallGroupId)
where (req.smallGroupId = grp.smallGroupId)
}
|> function |> function
| q when activeOnly -> | q when activeOnly ->
let asOf = theDate.AddDays(-(float grp.preferences.daysToExpire)).Date let asOf = theDate.AddDays(-(float grp.preferences.daysToExpire)).Date
query { q.Where(fun req ->
for req in q do ( req.updatedDate > asOf
where ( ( req.updatedDate > asOf
|| req.expiration = Manual || req.expiration = Manual
|| req.requestType = LongTermRequest || req.requestType = LongTermRequest
|| req.requestType = Expecting) || req.requestType = Expecting)
&& req.expiration <> Forced) && req.expiration <> Forced)
}
| q -> q
|> reqSort grp.preferences.requestSort |> reqSort grp.preferences.requestSort
|> function |> paginate pageNbr grp.preferences.pageSize
| q -> | q -> reqSort grp.preferences.requestSort q
match activeOnly with let! reqs = query.ToListAsync ()
| true -> upcast q return List.ofSeq reqs
| false ->
upcast query {
for req in q do
skip ((pageNbr - 1) * grp.preferences.pageSize)
take grp.preferences.pageSize
} }
/// Count prayer requests for the given small group Id /// Count prayer requests for the given small group Id
member this.CountRequestsBySmallGroup gId = member this.CountRequestsBySmallGroup gId = backgroundTask {
this.PrayerRequests.CountAsync (fun pr -> pr.smallGroupId = gId) return! this.PrayerRequests.CountAsync (fun pr -> pr.smallGroupId = gId)
}
/// Count prayer requests for the given church Id /// Count prayer requests for the given church Id
member this.CountRequestsByChurch cId = member this.CountRequestsByChurch cId = backgroundTask {
this.PrayerRequests.CountAsync (fun pr -> pr.smallGroup.churchId = cId) return! this.PrayerRequests.CountAsync (fun pr -> pr.smallGroup.churchId = cId)
}
/// Get all (or active) requests for a small group as of now or the specified date /// Get all (or active) requests for a small group as of now or the specified date
// TODO: same as above... member this.SearchRequestsForSmallGroup (grp : SmallGroup) (searchTerm : string) pageNbr = backgroundTask {
member this.SearchRequestsForSmallGroup (grp : SmallGroup) (searchTerm : string) pageNbr : PrayerRequest seq = let sql = """
let pgSz = grp.preferences.pageSize SELECT * FROM pt."PrayerRequest" WHERE "SmallGroupId" = {0} AND "Text" ILIKE {1}
let toSkip = (pageNbr - 1) * pgSz
let sql =
""" SELECT * FROM pt."PrayerRequest" WHERE "SmallGroupId" = {0} AND "Text" ILIKE {1}
UNION UNION
SELECT * FROM pt."PrayerRequest" WHERE "SmallGroupId" = {0} AND COALESCE("Requestor", '') ILIKE {1}""" SELECT * FROM pt."PrayerRequest" WHERE "SmallGroupId" = {0} AND COALESCE("Requestor", '') ILIKE {1}"""
let like = sprintf "%%%s%%" let like = sprintf "%%%s%%"
this.PrayerRequests.FromSqlRaw(sql, grp.smallGroupId, like searchTerm).AsNoTracking () let query =
this.PrayerRequests.FromSqlRaw(sql, grp.smallGroupId, like searchTerm)
|> reqSort grp.preferences.requestSort |> reqSort grp.preferences.requestSort
|> function |> paginate pageNbr grp.preferences.pageSize
| q -> let! reqs = query.ToListAsync ()
upcast query { return List.ofSeq reqs
for req in q do
skip toSkip
take pgSz
} }
(*-- SMALL GROUP EXTENSIONS --*) (*-- SMALL GROUP EXTENSIONS --*)
/// Find a small group by its Id /// Find a small group by its Id
member this.TryGroupById gId = member this.TryGroupById gId = backgroundTask {
query { let! grp =
for grp in this.SmallGroups.AsNoTracking().Include (fun sg -> sg.preferences) do this.SmallGroups.Include(fun sg -> sg.preferences)
where (grp.smallGroupId = gId) .SingleOrDefaultAsync (fun sg -> sg.smallGroupId = gId)
exactlyOneOrDefault return Option.fromObject grp
} }
|> toOptionTask
/// Get small groups that are public or password protected /// Get small groups that are public or password protected
member this.PublicAndProtectedGroups () = member this.PublicAndProtectedGroups () = backgroundTask {
task { let! groups =
let smallGroups = this.SmallGroups.AsNoTracking().Include(fun sg -> sg.preferences).Include (fun sg -> sg.church) this.SmallGroups.Include(fun sg -> sg.preferences).Include(fun sg -> sg.church)
let q = .Where(fun sg ->
query { sg.preferences.isPublic
for grp in smallGroups do || (sg.preferences.groupPassword <> null && sg.preferences.groupPassword <> ""))
where ( grp.preferences.isPublic .OrderBy(fun sg -> sg.church.name).ThenBy(fun sg -> sg.name)
|| (grp.preferences.groupPassword <> null && grp.preferences.groupPassword <> "")) .ToListAsync ()
sortBy grp.church.name return List.ofSeq groups
thenBy grp.name
}
let! grps = q.ToListAsync ()
return List.ofSeq grps
} }
/// Get small groups that are password protected /// Get small groups that are password protected
member this.ProtectedGroups () = member this.ProtectedGroups () = backgroundTask {
task { let! groups =
let q = this.SmallGroups.Include(fun sg -> sg.church)
query { .Where(fun sg -> sg.preferences.groupPassword <> null && sg.preferences.groupPassword <> "")
for grp in this.SmallGroups.AsNoTracking().Include (fun sg -> sg.church) do .OrderBy(fun sg -> sg.church.name).ThenBy(fun sg -> sg.name)
where (grp.preferences.groupPassword <> null && grp.preferences.groupPassword <> "") .ToListAsync ()
sortBy grp.church.name return List.ofSeq groups
thenBy grp.name
}
let! grps = q.ToListAsync ()
return List.ofSeq grps
} }
/// Get all small groups /// Get all small groups
member this.AllGroups () = member this.AllGroups () = backgroundTask {
task { let! groups =
let! grps = this.SmallGroups
this.SmallGroups.AsNoTracking()
.Include(fun sg -> sg.church) .Include(fun sg -> sg.church)
.Include(fun sg -> sg.preferences) .Include(fun sg -> sg.preferences)
.Include(fun sg -> sg.preferences.timeZone) .Include(fun sg -> sg.preferences.timeZone)
.OrderBy(fun sg -> sg.name) .OrderBy(fun sg -> sg.name)
.ToListAsync () .ToListAsync ()
return List.ofSeq grps return List.ofSeq groups
} }
/// Get a small group list by their Id, with their church prepended to their name /// Get a small group list by their Id, with their church prepended to their name
member this.GroupList () = member this.GroupList () = backgroundTask {
task { let! groups =
let q = this.SmallGroups.Include(fun sg -> sg.church)
query { .OrderBy(fun sg -> sg.church.name).ThenBy(fun sg -> sg.name)
for grp in this.SmallGroups.AsNoTracking().Include (fun sg -> sg.church) do .ToListAsync ()
sortBy grp.church.name return groups
thenBy grp.name |> Seq.map (fun sg -> sg.smallGroupId.ToString "N", $"{sg.church.name} | {sg.name}")
}
let! grps = q.ToListAsync ()
return grps
|> Seq.map (fun grp -> grp.smallGroupId.ToString "N", $"{grp.church.name} | {grp.name}")
|> List.ofSeq |> List.ofSeq
} }
/// Log on a small group /// Log on a small group
member this.TryGroupLogOnByPassword gId pw = member this.TryGroupLogOnByPassword gId pw = backgroundTask {
task {
match! this.TryGroupById gId with match! this.TryGroupById gId with
| None -> return None | None -> return None
| Some grp -> | Some grp -> return if pw = grp.preferences.groupPassword then Some grp else None
match pw = grp.preferences.groupPassword with
| true -> return Some grp
| _ -> return None
} }
/// Check a cookie log on for a small group /// Check a cookie log on for a small group
member this.TryGroupLogOnByCookie gId pwHash (hasher : string -> string) = member this.TryGroupLogOnByCookie gId pwHash (hasher : string -> string) = backgroundTask {
task {
match! this.TryGroupById gId with match! this.TryGroupById gId with
| None -> return None | None -> return None
| Some grp -> | Some grp -> return if pwHash = hasher grp.preferences.groupPassword then Some grp else None
match pwHash = hasher grp.preferences.groupPassword with
| true -> return Some grp
| _ -> return None
} }
/// Count small groups for the given church Id /// Count small groups for the given church Id
member this.CountGroupsByChurch cId = member this.CountGroupsByChurch cId = backgroundTask {
this.SmallGroups.CountAsync (fun sg -> sg.churchId = cId) return! this.SmallGroups.CountAsync (fun sg -> sg.churchId = cId)
}
(*-- TIME ZONE EXTENSIONS --*) (*-- TIME ZONE EXTENSIONS --*)
/// Get a time zone by its Id /// Get a time zone by its Id
member this.TryTimeZoneById tzId = member this.TryTimeZoneById tzId = backgroundTask {
query { let! zone = this.TimeZones.SingleOrDefaultAsync (fun tz -> tz.timeZoneId = tzId)
for tz in this.TimeZones do return Option.fromObject zone
where (tz.timeZoneId = tzId)
exactlyOneOrDefault
} }
|> toOptionTask
/// Get all time zones /// Get all time zones
member this.AllTimeZones () = member this.AllTimeZones () = backgroundTask {
task { let! zones = this.TimeZones.OrderBy(fun tz -> tz.sortOrder).ToListAsync ()
let q = return List.ofSeq zones
query {
for tz in this.TimeZones do
sortBy tz.sortOrder
}
let! tzs = q.ToListAsync ()
return List.ofSeq tzs
} }
(*-- USER EXTENSIONS --*) (*-- USER EXTENSIONS --*)
/// Find a user by its Id /// Find a user by its Id
member this.TryUserById uId = member this.TryUserById uId = backgroundTask {
query { let! usr = this.Users.SingleOrDefaultAsync (fun u -> u.userId = uId)
for usr in this.Users.AsNoTracking () do return Option.fromObject usr
where (usr.userId = uId)
exactlyOneOrDefault
} }
|> toOptionTask
/// Find a user by its e-mail address and authorized small group /// Find a user by its e-mail address and authorized small group
member this.TryUserByEmailAndGroup email gId = member this.TryUserByEmailAndGroup email gId = backgroundTask {
query { let! usr =
for usr in this.Users.AsNoTracking () do this.Users.SingleOrDefaultAsync (fun u ->
where (usr.emailAddress = email && usr.smallGroups.Any (fun xref -> xref.smallGroupId = gId)) u.emailAddress = email && u.smallGroups.Any (fun xref -> xref.smallGroupId = gId))
exactlyOneOrDefault return Option.fromObject usr
} }
|> toOptionTask
/// Find a user by its Id (tracked entity), eagerly loading the user's groups /// Find a user by its Id, eagerly loading the user's groups
member this.TryUserByIdWithGroups uId = member this.TryUserByIdWithGroups uId = backgroundTask {
query { let! usr = this.Users.Include(fun u -> u.smallGroups).SingleOrDefaultAsync (fun u -> u.userId = uId)
for usr in this.Users.AsNoTracking().Include (fun u -> u.smallGroups) do return Option.fromObject usr
where (usr.userId = uId)
exactlyOneOrDefault
} }
|> toOptionTask
/// Get a list of all users /// Get a list of all users
member this.AllUsers () = member this.AllUsers () = backgroundTask {
task { let! users = this.Users.OrderBy(fun u -> u.lastName).ThenBy(fun u -> u.firstName).ToListAsync ()
let q = return List.ofSeq users
query {
for usr in this.Users.AsNoTracking () do
sortBy usr.lastName
thenBy usr.firstName
}
let! usrs = q.ToListAsync ()
return List.ofSeq usrs
} }
/// Get all PrayerTracker users as members (used to send e-mails) /// Get all PrayerTracker users as members (used to send e-mails)
member this.AllUsersAsMembers () = member this.AllUsersAsMembers () = backgroundTask {
task { let! users = this.AllUsers ()
let q = return users |> List.map (fun u -> { Member.empty with email = u.emailAddress; memberName = u.fullName })
query {
for usr in this.Users.AsNoTracking () do
sortBy usr.lastName
thenBy usr.firstName
select { Member.empty with email = usr.emailAddress; memberName = usr.fullName }
}
let! usrs = q.ToListAsync ()
return List.ofSeq usrs
} }
/// Find a user based on their credentials /// Find a user based on their credentials
member this.TryUserLogOnByPassword email pwHash gId = member this.TryUserLogOnByPassword email pwHash gId = backgroundTask {
query { let! usr =
for usr in this.Users.AsNoTracking () do this.Users.SingleOrDefaultAsync (fun u ->
where ( usr.emailAddress = email u.emailAddress = email
&& usr.passwordHash = pwHash && u.passwordHash = pwHash
&& usr.smallGroups.Any (fun xref -> xref.smallGroupId = gId)) && u.smallGroups.Any (fun xref -> xref.smallGroupId = gId))
exactlyOneOrDefault return Option.fromObject usr
} }
|> toOptionTask
/// Find a user based on credentials stored in a cookie /// Find a user based on credentials stored in a cookie
member this.TryUserLogOnByCookie uId gId pwHash = member this.TryUserLogOnByCookie uId gId pwHash = backgroundTask {
task {
match! this.TryUserByIdWithGroups uId with match! this.TryUserByIdWithGroups uId with
| None -> return None | None -> return None
| Some usr -> | Some usr ->
match pwHash = usr.passwordHash && usr.smallGroups |> Seq.exists (fun xref -> xref.smallGroupId = gId) with if pwHash = usr.passwordHash && usr.smallGroups |> Seq.exists (fun xref -> xref.smallGroupId = gId) then
| true ->
this.Entry<User>(usr).State <- EntityState.Detached
return Some { usr with passwordHash = ""; salt = None; smallGroups = List<UserSmallGroup>() } return Some { usr with passwordHash = ""; salt = None; smallGroups = List<UserSmallGroup>() }
| _ -> return None else return None
} }
/// Count the number of users for a small group /// Count the number of users for a small group
member this.CountUsersBySmallGroup gId = member this.CountUsersBySmallGroup gId = backgroundTask {
this.Users.CountAsync (fun u -> u.smallGroups.Any (fun xref -> xref.smallGroupId = gId)) return! this.Users.CountAsync (fun u -> u.smallGroups.Any (fun xref -> xref.smallGroupId = gId))
}
/// Count the number of users for a church /// Count the number of users for a church
member this.CountUsersByChurch cId = member this.CountUsersByChurch cId = backgroundTask {
this.Users.CountAsync (fun u -> u.smallGroups.Any (fun xref -> xref.smallGroup.churchId = cId)) return! this.Users.CountAsync (fun u -> u.smallGroups.Any (fun xref -> xref.smallGroup.churchId = cId))
}

132
src/PrayerTracker.Data/Entities.fs
View File

@ -19,13 +19,15 @@ type AsOfDateDisplay =
/// The as-of date should be displayed in the culture's long date format /// The as-of date should be displayed in the culture's long date format
| LongDate | LongDate
with with
/// Convert to a DU case from a single-character string /// Convert to a DU case from a single-character string
static member fromCode code = static member fromCode code =
match code with match code with
| "N" -> NoDisplay | "N" -> NoDisplay
| "S" -> ShortDate | "S" -> ShortDate
| "L" -> LongDate | "L" -> LongDate
| _ -> invalidArg "code" (sprintf "Unknown code %s" code) | _ -> invalidArg "code" $"Unknown code {code}"
/// Convert this DU case to a single-character string /// Convert this DU case to a single-character string
member this.code = member this.code =
match this with match this with
@ -41,12 +43,14 @@ type EmailFormat =
/// Plain-text e-mail /// Plain-text e-mail
| PlainTextFormat | PlainTextFormat
with with
/// Convert to a DU case from a single-character string /// Convert to a DU case from a single-character string
static member fromCode code = static member fromCode code =
match code with match code with
| "H" -> HtmlFormat | "H" -> HtmlFormat
| "P" -> PlainTextFormat | "P" -> PlainTextFormat
| _ -> invalidArg "code" (sprintf "Unknown code %s" code) | _ -> invalidArg "code" $"Unknown code {code}"
/// Convert this DU case to a single-character string /// Convert this DU case to a single-character string
member this.code = member this.code =
match this with match this with
@ -63,13 +67,15 @@ type Expiration =
/// Force immediate expiration /// Force immediate expiration
| Forced | Forced
with with
/// Convert to a DU case from a single-character string /// Convert to a DU case from a single-character string
static member fromCode code = static member fromCode code =
match code with match code with
| "A" -> Automatic | "A" -> Automatic
| "M" -> Manual | "M" -> Manual
| "F" -> Forced | "F" -> Forced
| _ -> invalidArg "code" (sprintf "Unknown code %s" code) | _ -> invalidArg "code" $"Unknown code {code}"
/// Convert this DU case to a single-character string /// Convert this DU case to a single-character string
member this.code = member this.code =
match this with match this with
@ -91,6 +97,7 @@ type PrayerRequestType =
/// Announcements /// Announcements
| Announcement | Announcement
with with
/// Convert to a DU case from a single-character string /// Convert to a DU case from a single-character string
static member fromCode code = static member fromCode code =
match code with match code with
@ -99,7 +106,8 @@ with
| "E" -> Expecting | "E" -> Expecting
| "P" -> PraiseReport | "P" -> PraiseReport
| "A" -> Announcement | "A" -> Announcement
| _ -> invalidArg "code" (sprintf "Unknown code %s" code) | _ -> invalidArg "code" $"Unknown code {code}"
/// Convert this DU case to a single-character string /// Convert this DU case to a single-character string
member this.code = member this.code =
match this with match this with
@ -117,12 +125,14 @@ type RequestSort =
/// Sort by requestor/subject, then by date /// Sort by requestor/subject, then by date
| SortByRequestor | SortByRequestor
with with
/// Convert to a DU case from a single-character string /// Convert to a DU case from a single-character string
static member fromCode code = static member fromCode code =
match code with match code with
| "D" -> SortByDate | "D" -> SortByDate
| "R" -> SortByRequestor | "R" -> SortByRequestor
| _ -> invalidArg "code" (sprintf "Unknown code %s" code) | _ -> invalidArg "code" $"Unknown code {code}"
/// Convert this DU case to a single-character string /// Convert this DU case to a single-character string
member this.code = member this.code =
match this with match this with
@ -130,7 +140,9 @@ with
| SortByRequestor -> "R" | SortByRequestor -> "R"
/// EF Core value converters for the discriminated union types above
module Converters = module Converters =
open Microsoft.EntityFrameworkCore.Storage.ValueConversion open Microsoft.EntityFrameworkCore.Storage.ValueConversion
open Microsoft.FSharp.Linq.RuntimeHelpers open Microsoft.FSharp.Linq.RuntimeHelpers
open System.Linq.Expressions open System.Linq.Expressions
@ -211,8 +223,10 @@ module Converters =
type ChurchStats = type ChurchStats =
{ /// The number of small groups in the church { /// The number of small groups in the church
smallGroups : int smallGroups : int
/// The number of prayer requests in the church /// The number of prayer requests in the church
prayerRequests : int prayerRequests : int
/// The number of users who can access small groups in the church /// The number of users who can access small groups in the church
users : int users : int
} }
@ -237,7 +251,10 @@ type UserId = Guid
/// PK for User/SmallGroup cross-reference table /// PK for User/SmallGroup cross-reference table
type UserSmallGroupKey = type UserSmallGroupKey =
{ userId : UserId { /// 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 smallGroupId : SmallGroupId
} }
@ -247,21 +264,26 @@ type UserSmallGroupKey =
type [<CLIMutable; NoComparison; NoEquality>] Church = type [<CLIMutable; NoComparison; NoEquality>] Church =
{ /// The Id of this church { /// The Id of this church
churchId : ChurchId churchId : ChurchId
/// The name of the church /// The name of the church
name : string name : string
/// The city where the church is /// The city where the church is
city : string city : string
/// The state where the church is /// The state where the church is
st : string st : string
/// Does this church have an active interface with Virtual Prayer Room? /// Does this church have an active interface with Virtual Prayer Room?
hasInterface : bool hasInterface : bool
/// The address for the interface /// The address for the interface
interfaceAddress : string option interfaceAddress : string option
/// Small groups for this church /// Small groups for this church
smallGroups : ICollection<SmallGroup> smallGroups : ICollection<SmallGroup>
} }
with with
/// An empty church /// An empty church
// aww... how sad :( // aww... how sad :(
static member empty = static member empty =
@ -273,10 +295,10 @@ type [<CLIMutable; NoComparison; NoEquality>] Church =
interfaceAddress = None interfaceAddress = None
smallGroups = List<SmallGroup> () smallGroups = List<SmallGroup> ()
} }
/// Configure EF for this entity /// Configure EF for this entity
static member internal configureEF (mb : ModelBuilder) = static member internal configureEF (mb : ModelBuilder) =
mb.Entity<Church> ( mb.Entity<Church> (fun m ->
fun m ->
m.ToTable "Church" |> ignore m.ToTable "Church" |> ignore
m.Property(fun e -> e.churchId).HasColumnName "ChurchId" |> 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.name).HasColumnName("Name").IsRequired () |> ignore
@ -293,44 +315,63 @@ type [<CLIMutable; NoComparison; NoEquality>] Church =
and [<CLIMutable; NoComparison; NoEquality>] ListPreferences = and [<CLIMutable; NoComparison; NoEquality>] ListPreferences =
{ /// The Id of the small group to which these preferences belong { /// The Id of the small group to which these preferences belong
smallGroupId : SmallGroupId smallGroupId : SmallGroupId
/// The days after which regular requests expire /// The days after which regular requests expire
daysToExpire : int daysToExpire : int
/// The number of days a new or updated request is considered new /// 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 /// 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 /// The name from which e-mails are sent
emailFromName : string emailFromName : string
/// The e-mail address from which e-mails are sent /// 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 /// The fonts to use in generating the list of prayer requests
listFonts : string listFonts : string
/// The color for the prayer request list headings /// The color for the prayer request list headings
headingColor : string headingColor : string
/// The color for the lines offsetting the prayer request list headings /// 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 /// 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 /// The font size for the text on the prayer request list
textFontSize : int textFontSize : int
/// The order in which the prayer requests are sorted /// The order in which the prayer requests are sorted
requestSort : RequestSort requestSort : RequestSort
/// The password used for "small group login" (view-only request list) /// The password used for "small group login" (view-only request list)
groupPassword : string groupPassword : string
/// The default e-mail type for this class /// The default e-mail type for this class
defaultEmailType : EmailFormat defaultEmailType : EmailFormat
/// Whether this class makes its request list public /// Whether this class makes its request list public
isPublic : bool isPublic : bool
/// The time zone which this class uses (use tzdata names) /// The time zone which this class uses (use tzdata names)
timeZoneId : TimeZoneId timeZoneId : TimeZoneId
/// The time zone information /// The time zone information
timeZone : TimeZone timeZone : TimeZone
/// The number of requests displayed per page /// The number of requests displayed per page
pageSize : int pageSize : int
/// How the as-of date should be automatically displayed /// How the as-of date should be automatically displayed
asOfDateDisplay : AsOfDateDisplay asOfDateDisplay : AsOfDateDisplay
} }
with with
/// A set of preferences with their default values /// A set of preferences with their default values
static member empty = static member empty =
{ smallGroupId = Guid.Empty { smallGroupId = Guid.Empty
@ -353,10 +394,10 @@ and [<CLIMutable; NoComparison; NoEquality>] ListPreferences =
pageSize = 100 pageSize = 100
asOfDateDisplay = NoDisplay asOfDateDisplay = NoDisplay
} }
/// Configure EF for this entity /// Configure EF for this entity
static member internal configureEF (mb : ModelBuilder) = static member internal configureEF (mb : ModelBuilder) =
mb.Entity<ListPreferences> ( mb.Entity<ListPreferences> (fun m ->
fun m ->
m.ToTable "ListPreference" |> ignore m.ToTable "ListPreference" |> ignore
m.HasKey (fun e -> e.smallGroupId :> obj) |> ignore m.HasKey (fun e -> e.smallGroupId :> obj) |> ignore
m.Property(fun e -> e.smallGroupId).HasColumnName "SmallGroupId" |> ignore m.Property(fun e -> e.smallGroupId).HasColumnName "SmallGroupId" |> ignore
@ -460,18 +501,24 @@ and [<CLIMutable; NoComparison; NoEquality>] ListPreferences =
and [<CLIMutable; NoComparison; NoEquality>] Member = and [<CLIMutable; NoComparison; NoEquality>] Member =
{ /// The Id of the member { /// The Id of the member
memberId : MemberId memberId : MemberId
/// The Id of the small group to which this member belongs /// The Id of the small group to which this member belongs
smallGroupId : SmallGroupId smallGroupId : SmallGroupId
/// The name of the member /// The name of the member
memberName : string memberName : string
/// The e-mail address for the member /// The e-mail address for the member
email : string email : string
/// The type of e-mail preferred by this member (see <see cref="EmailTypes"/> constants) /// The type of e-mail preferred by this member (see <see cref="EmailTypes"/> constants)
format : string option // TODO - do I need a custom formatter for this? format : string option // TODO - do I need a custom formatter for this?
/// The small group to which this member belongs /// The small group to which this member belongs
smallGroup : SmallGroup smallGroup : SmallGroup
} }
with with
/// An empty member /// An empty member
static member empty = static member empty =
{ memberId = Guid.Empty { memberId = Guid.Empty
@ -481,10 +528,10 @@ and [<CLIMutable; NoComparison; NoEquality>] Member =
format = None format = None
smallGroup = SmallGroup.empty smallGroup = SmallGroup.empty
} }
/// Configure EF for this entity /// Configure EF for this entity
static member internal configureEF (mb : ModelBuilder) = static member internal configureEF (mb : ModelBuilder) =
mb.Entity<Member> ( mb.Entity<Member> (fun m ->
fun m ->
m.ToTable "Member" |> ignore m.ToTable "Member" |> ignore
m.Property(fun e -> e.memberId).HasColumnName "MemberId" |> ignore m.Property(fun e -> e.memberId).HasColumnName "MemberId" |> ignore
m.Property(fun e -> e.smallGroupId).HasColumnName "SmallGroupId" |> ignore m.Property(fun e -> e.smallGroupId).HasColumnName "SmallGroupId" |> ignore
@ -499,30 +546,42 @@ and [<CLIMutable; NoComparison; NoEquality>] Member =
and [<CLIMutable; NoComparison; NoEquality>] PrayerRequest = and [<CLIMutable; NoComparison; NoEquality>] PrayerRequest =
{ /// The Id of this request { /// The Id of this request
prayerRequestId : PrayerRequestId prayerRequestId : PrayerRequestId
/// The type of the request /// The type of the request
requestType : PrayerRequestType requestType : PrayerRequestType
/// The user who entered the request /// The user who entered the request
userId : UserId userId : UserId
/// The small group to which this request belongs /// The small group to which this request belongs
smallGroupId : SmallGroupId smallGroupId : SmallGroupId
/// The date/time on which this request was entered /// The date/time on which this request was entered
enteredDate : DateTime enteredDate : DateTime
/// The date/time this request was last updated /// The date/time this request was last updated
updatedDate : DateTime updatedDate : DateTime
/// The name of the requestor or subject, or title of announcement /// The name of the requestor or subject, or title of announcement
requestor : string option requestor : string option
/// The text of the request /// The text of the request
text : string text : string
/// Whether the chaplain should be notified for this request /// Whether the chaplain should be notified for this request
notifyChaplain : bool notifyChaplain : bool
/// The user who entered this request /// The user who entered this request
user : User user : User
/// The small group to which this request belongs /// The small group to which this request belongs
smallGroup : SmallGroup smallGroup : SmallGroup
/// Is this request expired? /// Is this request expired?
expiration : Expiration expiration : Expiration
} }
with with
/// An empty request /// An empty request
static member empty = static member empty =
{ prayerRequestId = Guid.Empty { prayerRequestId = Guid.Empty
@ -538,6 +597,7 @@ and [<CLIMutable; NoComparison; NoEquality>] PrayerRequest =
smallGroup = SmallGroup.empty smallGroup = SmallGroup.empty
expiration = Automatic expiration = Automatic
} }
/// Is this request expired? /// Is this request expired?
member this.isExpired (curr : DateTime) expDays = member this.isExpired (curr : DateTime) expDays =
match this.expiration with match this.expiration with
@ -557,8 +617,7 @@ and [<CLIMutable; NoComparison; NoEquality>] PrayerRequest =
/// Configure EF for this entity /// Configure EF for this entity
static member internal configureEF (mb : ModelBuilder) = static member internal configureEF (mb : ModelBuilder) =
mb.Entity<PrayerRequest> ( mb.Entity<PrayerRequest> (fun m ->
fun m ->
m.ToTable "PrayerRequest" |> ignore m.ToTable "PrayerRequest" |> ignore
m.Property(fun e -> e.prayerRequestId).HasColumnName "PrayerRequestId" |> 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.requestType).HasColumnName("RequestType").IsRequired() |> ignore
@ -598,7 +657,8 @@ and [<CLIMutable; NoComparison; NoEquality>] SmallGroup =
/// The users authorized to manage this group /// The users authorized to manage this group
users : ICollection<UserSmallGroup> users : ICollection<UserSmallGroup>
} }
with with
/// An empty small group /// An empty small group
static member empty = static member empty =
{ smallGroupId = Guid.Empty { smallGroupId = Guid.Empty
@ -615,10 +675,10 @@ and [<CLIMutable; NoComparison; NoEquality>] SmallGroup =
member this.localTimeNow (clock : IClock) = member this.localTimeNow (clock : IClock) =
match clock with null -> nullArg "clock" | _ -> () match clock with null -> nullArg "clock" | _ -> ()
let tz = let tz =
match DateTimeZoneProviders.Tzdb.Ids.Contains this.preferences.timeZoneId with if DateTimeZoneProviders.Tzdb.Ids.Contains this.preferences.timeZoneId then
| true -> DateTimeZoneProviders.Tzdb.[this.preferences.timeZoneId] DateTimeZoneProviders.Tzdb[this.preferences.timeZoneId]
| false -> DateTimeZone.Utc else DateTimeZone.Utc
clock.GetCurrentInstant().InZone(tz).ToDateTimeUnspecified() clock.GetCurrentInstant().InZone(tz).ToDateTimeUnspecified ()
/// Get the local date for this group /// Get the local date for this group
member this.localDateNow clock = member this.localDateNow clock =
@ -626,8 +686,7 @@ and [<CLIMutable; NoComparison; NoEquality>] SmallGroup =
/// Configure EF for this entity /// Configure EF for this entity
static member internal configureEF (mb : ModelBuilder) = static member internal configureEF (mb : ModelBuilder) =
mb.Entity<SmallGroup> ( mb.Entity<SmallGroup> (fun m ->
fun m ->
m.ToTable "SmallGroup" |> ignore m.ToTable "SmallGroup" |> ignore
m.Property(fun e -> e.smallGroupId).HasColumnName "SmallGroupId" |> ignore m.Property(fun e -> e.smallGroupId).HasColumnName "SmallGroupId" |> ignore
m.Property(fun e -> e.churchId).HasColumnName "ChurchId" |> ignore m.Property(fun e -> e.churchId).HasColumnName "ChurchId" |> ignore
@ -647,7 +706,8 @@ and [<CLIMutable; NoComparison; NoEquality>] TimeZone =
/// Whether this timezone is active /// Whether this timezone is active
isActive : bool isActive : bool
} }
with with
/// An empty time zone /// An empty time zone
static member empty = static member empty =
{ timeZoneId = "" { timeZoneId = ""
@ -655,10 +715,10 @@ and [<CLIMutable; NoComparison; NoEquality>] TimeZone =
sortOrder = 0 sortOrder = 0
isActive = false isActive = false
} }
/// Configure EF for this entity /// Configure EF for this entity
static member internal configureEF (mb : ModelBuilder) = static member internal configureEF (mb : ModelBuilder) =
mb.Entity<TimeZone> ( mb.Entity<TimeZone> ( fun m ->
fun m ->
m.ToTable "TimeZone" |> ignore m.ToTable "TimeZone" |> ignore
m.Property(fun e -> e.timeZoneId).HasColumnName "TimeZoneId" |> 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.description).HasColumnName("Description").IsRequired() |> ignore
@ -686,7 +746,8 @@ and [<CLIMutable; NoComparison; NoEquality>] User =
/// The small groups which this user is authorized /// The small groups which this user is authorized
smallGroups : ICollection<UserSmallGroup> smallGroups : ICollection<UserSmallGroup>
} }
with with
/// An empty user /// An empty user
static member empty = static member empty =
{ userId = Guid.Empty { userId = Guid.Empty
@ -698,14 +759,14 @@ and [<CLIMutable; NoComparison; NoEquality>] User =
salt = None salt = None
smallGroups = List<UserSmallGroup> () smallGroups = List<UserSmallGroup> ()
} }
/// The full name of the user /// The full name of the user
member this.fullName = member this.fullName =
sprintf "%s %s" this.firstName this.lastName $"{this.firstName} {this.lastName}"
/// Configure EF for this entity /// Configure EF for this entity
static member internal configureEF (mb : ModelBuilder) = static member internal configureEF (mb : ModelBuilder) =
mb.Entity<User> ( mb.Entity<User> (fun m ->
fun m ->
m.ToTable "User" |> ignore m.ToTable "User" |> ignore
m.Ignore(fun e -> e.fullName :> obj) |> ignore m.Ignore(fun e -> e.fullName :> obj) |> ignore
m.Property(fun e -> e.userId).HasColumnName "UserId" |> ignore m.Property(fun e -> e.userId).HasColumnName "UserId" |> ignore
@ -731,7 +792,8 @@ and [<CLIMutable; NoComparison; NoEquality>] UserSmallGroup =
/// The small group to which the user has access /// The small group to which the user has access
smallGroup : SmallGroup smallGroup : SmallGroup
} }
with with
/// An empty user/small group xref /// An empty user/small group xref
static member empty = static member empty =
{ userId = Guid.Empty { userId = Guid.Empty
@ -739,10 +801,10 @@ and [<CLIMutable; NoComparison; NoEquality>] UserSmallGroup =
user = User.empty user = User.empty
smallGroup = SmallGroup.empty smallGroup = SmallGroup.empty
} }
/// Configure EF for this entity /// Configure EF for this entity
static member internal configureEF (mb : ModelBuilder) = static member internal configureEF (mb : ModelBuilder) =
mb.Entity<UserSmallGroup> ( mb.Entity<UserSmallGroup> (fun m ->
fun m ->
m.ToTable "User_SmallGroup" |> ignore m.ToTable "User_SmallGroup" |> ignore
m.HasKey(fun e -> { userId = e.userId; smallGroupId = e.smallGroupId } :> obj) |> 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.userId).HasColumnName "UserId" |> ignore

9
src/PrayerTracker.Tests/UI/UtilsTests.fs
View File

@ -53,7 +53,8 @@ let htmlToPlainTextTests =
"Non-breaking spaces should have been replaced with spaces" "Non-breaking spaces should have been replaced with spaces"
} }
test "does all replacements at one time" { test "does all replacements at one time" {
Expect.equal (htmlToPlainText " &lt;&nbsp;&lt;<br>test") "< <\ntest" "All replacements were not made correctly" Expect.equal (htmlToPlainText " &lt;&nbsp;&lt;<br>test") "< <\ntest"
"All replacements were not made correctly"
} }
test "does not fail when passed null" { test "does not fail when passed null" {
Expect.equal (htmlToPlainText null) "" "Should return an empty string for null input" Expect.equal (htmlToPlainText null) "" "Should return an empty string for null input"
@ -63,7 +64,8 @@ let htmlToPlainTextTests =
} }
test "preserves blank lines for two consecutive line breaks" { test "preserves blank lines for two consecutive line breaks" {
let expected = "Paragraph 1\n\nParagraph 2\n\n...and paragraph 3" let expected = "Paragraph 1\n\nParagraph 2\n\n...and paragraph 3"
Expect.equal (htmlToPlainText "Paragraph 1<br><br>Paragraph 2<br><br>...and <strong>paragraph</strong> <i>3</i>") Expect.equal
(htmlToPlainText "Paragraph 1<br><br>Paragraph 2<br><br>...and <strong>paragraph</strong> <i>3</i>")
expected "Blank lines not preserved for consecutive line breaks" expected "Blank lines not preserved for consecutive line breaks"
} }
] ]
@ -87,7 +89,8 @@ let makeUrlTests =
let sndAsStringTests = let sndAsStringTests =
testList "sndAsString" [ testList "sndAsString" [
test "converts the second item to a string" { test "converts the second item to a string" {
Expect.equal (sndAsString ("a", 5)) "5" "The second part of the tuple should have been converted to a string" Expect.equal (sndAsString ("a", 5)) "5"
"The second part of the tuple should have been converted to a string"
} }
] ]

57
src/PrayerTracker.UI/Church.fs
View File

@ -9,21 +9,22 @@ let edit (m : EditChurch) ctx vi =
let pageTitle = match m.isNew () with true -> "Add a New Church" | false -> "Edit Church" let pageTitle = match m.isNew () with true -> "Add a New Church" | false -> "Edit Church"
let s = I18N.localizer.Force () let s = I18N.localizer.Force ()
[ form [ _action "/web/church/save"; _method "post"; _class "pt-center-columns" ] [ [ form [ _action "/web/church/save"; _method "post"; _class "pt-center-columns" ] [
style [ _scoped ] style [ _scoped ] [
[ rawText "#name { width: 20rem; } #city { width: 10rem; } #st { width: 3rem; } #interfaceAddress { width: 30rem; }" ] rawText "#name { width: 20rem; } #city { width: 10rem; } #st { width: 3rem; } #interfaceAddress { width: 30rem; }"
]
csrfToken ctx csrfToken ctx
input [ _type "hidden"; _name "churchId"; _value (flatGuid m.churchId) ] input [ _type "hidden"; _name "churchId"; _value (flatGuid m.churchId) ]
div [ _class "pt-field-row" ] [ div [ _class "pt-field-row" ] [
div [ _class "pt-field" ] [ div [ _class "pt-field" ] [
label [ _for "name" ] [ locStr s.["Church Name"] ] label [ _for "name" ] [ locStr s["Church Name"] ]
input [ _type "text"; _name "name"; _id "name"; _required; _autofocus; _value m.name ] input [ _type "text"; _name "name"; _id "name"; _required; _autofocus; _value m.name ]
] ]
div [ _class "pt-field" ] [ div [ _class "pt-field" ] [
label [ _for "City"] [ locStr s.["City"] ] label [ _for "City"] [ locStr s["City"] ]
input [ _type "text"; _name "city"; _id "city"; _required; _value m.city ] input [ _type "text"; _name "city"; _id "city"; _required; _value m.city ]
] ]
div [ _class "pt-field" ] [ div [ _class "pt-field" ] [
label [ _for "ST" ] [ locStr s.["State"] ] label [ _for "ST" ] [ locStr s["State"] ]
input [ _type "text"; _name "st"; _id "st"; _required; _minlength "2"; _maxlength "2"; _value m.st ] input [ _type "text"; _name "st"; _id "st"; _required; _minlength "2"; _maxlength "2"; _value m.st ]
] ]
] ]
@ -34,17 +35,19 @@ let edit (m : EditChurch) ctx vi =
_id "hasInterface" _id "hasInterface"
_value "True" _value "True"
match m.hasInterface with Some x when x -> _checked | _ -> () ] match m.hasInterface with Some x when x -> _checked | _ -> () ]
label [ _for "hasInterface" ] [ locStr s.["Has an interface with Virtual Prayer Room"] ] label [ _for "hasInterface" ] [ locStr s["Has an interface with Virtual Prayer Room"] ]
] ]
] ]
div [ _class "pt-field-row pt-fadeable"; _id "divInterfaceAddress" ] [ div [ _class "pt-field-row pt-fadeable"; _id "divInterfaceAddress" ] [
div [ _class "pt-field" ] [ div [ _class "pt-field" ] [
label [ _for "interfaceAddress" ] [ locStr s.["VPR Interface URL"] ] label [ _for "interfaceAddress" ] [ locStr s["VPR Interface URL"] ]
input [ _type "url"; _name "interfaceAddress"; _id "interfaceAddress"; input
_value (match m.interfaceAddress with Some ia -> ia | None -> "") ] [ _type "url"; _name "interfaceAddress"; _id "interfaceAddress";
_value (match m.interfaceAddress with Some ia -> ia | None -> "")
] ]
] ]
div [ _class "pt-field-row" ] [ submit [] "save" s.["Save Church"] ] ]
div [ _class "pt-field-row" ] [ submit [] "save" s["Save Church"] ]
] ]
script [] [ rawText "PT.onLoad(PT.church.edit.onPageLoad)" ] script [] [ rawText "PT.onLoad(PT.church.edit.onPageLoad)" ]
] ]
@ -62,42 +65,42 @@ let maintain (churches : Church list) (stats : Map<string, ChurchStats>) ctx vi
table [ _class "pt-table pt-action-table" ] [ table [ _class "pt-table pt-action-table" ] [
thead [] [ thead [] [
tr [] [ tr [] [
th [] [ locStr s.["Actions"] ] th [] [ locStr s["Actions"] ]
th [] [ locStr s.["Name"] ] th [] [ locStr s["Name"] ]
th [] [ locStr s.["Location"] ] th [] [ locStr s["Location"] ]
th [] [ locStr s.["Groups"] ] th [] [ locStr s["Groups"] ]
th [] [ locStr s.["Requests"] ] th [] [ locStr s["Requests"] ]
th [] [ locStr s.["Users"] ] th [] [ locStr s["Users"] ]
th [] [ locStr s.["Interface?"] ] th [] [ locStr s["Interface?"] ]
] ]
] ]
churches churches
|> List.map (fun ch -> |> List.map (fun ch ->
let chId = flatGuid ch.churchId let chId = flatGuid ch.churchId
let delAction = $"/web/church/{chId}/delete" let delAction = $"/web/church/{chId}/delete"
let delPrompt = s.["Are you sure you want to delete this {0}? This action cannot be undone.", 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 [] [ tr [] [
td [] [ td [] [
a [ _href $"/web/church/{chId}/edit"; _title s.["Edit This Church"].Value ] [ icon "edit" ] a [ _href $"/web/church/{chId}/edit"; _title s["Edit This Church"].Value ] [ icon "edit" ]
a [ _href delAction a [ _href delAction
_title s.["Delete This Church"].Value _title s["Delete This Church"].Value
_onclick $"return PT.confirmDelete('{delAction}','{delPrompt}')" ] _onclick $"return PT.confirmDelete('{delAction}','{delPrompt}')" ]
[ icon "delete_forever" ] [ icon "delete_forever" ]
] ]
td [] [ str ch.name ] td [] [ str ch.name ]
td [] [ str ch.city; rawText ", "; str ch.st ] 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].smallGroups.ToString "N0") ]
td [ _class "pt-right-text" ] [ rawText (stats.[chId].prayerRequests.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-right-text" ] [ rawText (stats[chId].users.ToString "N0") ]
td [ _class "pt-center-text" ] [ locStr s.[match ch.hasInterface with true -> "Yes" | false -> "No"] ] td [ _class "pt-center-text" ] [ locStr s[if ch.hasInterface then "Yes" else "No"] ]
]) ])
|> tbody [] |> tbody []
] ]
[ div [ _class "pt-center-text" ] [ [ div [ _class "pt-center-text" ] [
br [] br []
a [ _href $"/web/church/{emptyGuid}/edit"; _title s.["Add a New Church"].Value ] a [ _href $"/web/church/{emptyGuid}/edit"; _title s["Add a New Church"].Value ]
[ icon "add_circle"; rawText " &nbsp;"; locStr s.["Add a New Church"] ] [ icon "add_circle"; rawText " &nbsp;"; locStr s["Add a New Church"] ]
br [] br []
br [] br []
] ]

78
src/PrayerTracker.UI/CommonFunctions.fs
View File

@ -1,16 +1,14 @@
[<AutoOpen>] [<AutoOpen>]
module PrayerTracker.Views.CommonFunctions module PrayerTracker.Views.CommonFunctions
open System.IO
open System.Text.Encodings.Web
open Giraffe open Giraffe
open Giraffe.ViewEngine open Giraffe.ViewEngine
open Microsoft.AspNetCore.Antiforgery open Microsoft.AspNetCore.Antiforgery
open Microsoft.AspNetCore.Html
open Microsoft.AspNetCore.Http open Microsoft.AspNetCore.Http
open Microsoft.AspNetCore.Mvc.Localization open Microsoft.AspNetCore.Mvc.Localization
open Microsoft.Extensions.Localization open Microsoft.Extensions.Localization
open System
open System.IO
open System.Text.Encodings.Web
/// Encoded text for a localized string /// Encoded text for a localized string
let locStr (text : LocalizedString) = str text.Value let locStr (text : LocalizedString) = str text.Value
@ -42,58 +40,62 @@ let tableSummary itemCount (s : IStringLocalizer) =
div [ _class "pt-center-text" ] [ div [ _class "pt-center-text" ] [
small [] [ small [] [
match itemCount with match itemCount with
| 0 -> s.["No Entries to Display"] | 0 -> s["No Entries to Display"]
| 1 -> s.["Displaying {0} Entry", itemCount] | 1 -> s["Displaying {0} Entry", itemCount]
| _ -> s.["Displaying {0} Entries", itemCount] | _ -> s["Displaying {0} Entries", itemCount]
|> locStr |> locStr
] ]
] ]
/// Generate a list of named HTML colors /// Generate a list of named HTML colors
let namedColorList name selected attrs (s : IStringLocalizer) = let namedColorList name selected attrs (s : IStringLocalizer) =
/// The list of HTML named colors (name, display, text color) // The list of HTML named colors (name, display, text color)
seq { seq {
("aqua", s.["Aqua"], "black") ("aqua", s["Aqua"], "black")
("black", s.["Black"], "white") ("black", s["Black"], "white")
("blue", s.["Blue"], "white") ("blue", s["Blue"], "white")
("fuchsia", s.["Fuchsia"], "black") ("fuchsia", s["Fuchsia"], "black")
("gray", s.["Gray"], "white") ("gray", s["Gray"], "white")
("green", s.["Green"], "white") ("green", s["Green"], "white")
("lime", s.["Lime"], "black") ("lime", s["Lime"], "black")
("maroon", s.["Maroon"], "white") ("maroon", s["Maroon"], "white")
("navy", s.["Navy"], "white") ("navy", s["Navy"], "white")
("olive", s.["Olive"], "white") ("olive", s["Olive"], "white")
("purple", s.["Purple"], "white") ("purple", s["Purple"], "white")
("red", s.["Red"], "black") ("red", s["Red"], "black")
("silver", s.["Silver"], "black") ("silver", s["Silver"], "black")
("teal", s.["Teal"], "white") ("teal", s["Teal"], "white")
("white", s.["White"], "black") ("white", s["White"], "black")
("yellow", s.["Yellow"], "black") ("yellow", s["Yellow"], "black")
} }
|> Seq.map (fun color -> |> Seq.map (fun color ->
let (colorName, dispText, txtColor) = color let colorName, text, txtColor = color
option [ yield _value colorName option
yield _style $"background-color:{colorName};color:{txtColor};" [ _value colorName
match colorName = selected with true -> yield _selected | false -> () ] [ _style $"background-color:{colorName};color:{txtColor};"
encodedText (dispText.Value.ToLower ()) if colorName = selected then _selected
]) ] [ encodedText (text.Value.ToLower ()) ])
|> List.ofSeq |> List.ofSeq
|> select (_name name :: attrs) |> select (_name name :: attrs)
/// Generate an input[type=radio] that is selected if its value is the current value /// Generate an input[type=radio] that is selected if its value is the current value
let radio name domId value current = let radio name domId value current =
input [ _type "radio" input
[ _type "radio"
_name name _name name
_id domId _id domId
_value value _value value
match value = current with true -> _checked | false -> () ] if value = current then _checked
]
/// Generate a select list with the current value selected /// Generate a select list with the current value selected
let selectList name selected attrs items = let selectList name selected attrs items =
items items
|> Seq.map (fun (value, text) -> |> Seq.map (fun (value, text) ->
option [ _value value option
match value = selected with true -> _selected | false -> () ] [ encodedText text ]) [ _value value
if value = selected then _selected
] [ encodedText text ])
|> List.ofSeq |> List.ofSeq
|> select (List.concat [ [ _name name; _id name ]; attrs ]) |> select (List.concat [ [ _name name; _id name ]; attrs ])
@ -103,6 +105,9 @@ let selectDefault text = $"— {text} —"
/// Generate a standard submit button with icon and text /// Generate a standard submit button with icon and text
let submit attrs ico text = button (_type "submit" :: attrs) [ icon ico; rawText " &nbsp;"; locStr text ] let submit attrs ico text = button (_type "submit" :: attrs) [ icon ico; rawText " &nbsp;"; locStr text ]
open System
/// Format a GUID with no dashes (used for URLs and forms) /// Format a GUID with no dashes (used for URLs and forms)
let flatGuid (x : Guid) = x.ToString "N" let flatGuid (x : Guid) = x.ToString "N"
@ -129,6 +134,9 @@ let _scoped = flag "scoped"
/// The name this function used to have when the view engine was part of Giraffe /// The name this function used to have when the view engine was part of Giraffe
let renderHtmlNode = RenderView.AsString.htmlNode let renderHtmlNode = RenderView.AsString.htmlNode
open Microsoft.AspNetCore.Html
/// Render an HTML node, then return the value as an HTML string /// Render an HTML node, then return the value as an HTML string
let renderHtmlString = renderHtmlNode >> HtmlString let renderHtmlString = renderHtmlNode >> HtmlString
@ -151,5 +159,5 @@ module TimeZones =
/// Get the name of a time zone, given its Id /// Get the name of a time zone, given its Id
let name tzId (s : IStringLocalizer) = let name tzId (s : IStringLocalizer) =
try s.[xref.[tzId]] try s[xref[tzId]]
with :? KeyNotFoundException -> LocalizedString (tzId, tzId) with :? KeyNotFoundException -> LocalizedString (tzId, tzId)

195
src/PrayerTracker.UI/Home.fs
View File

@ -1,10 +1,9 @@
/// Views associated with the home page, or those that don't fit anywhere else /// Views associated with the home page, or those that don't fit anywhere else
module PrayerTracker.Views.Home module PrayerTracker.Views.Home
open Giraffe.ViewEngine
open Microsoft.AspNetCore.Html
open PrayerTracker.ViewModels
open System.IO open System.IO
open Giraffe.ViewEngine
open PrayerTracker.ViewModels
/// The error page /// The error page
let error code vi = let error code vi =
@ -13,31 +12,30 @@ let error code vi =
use sw = new StringWriter () use sw = new StringWriter ()
let raw = rawLocText sw let raw = rawLocText sw
let is404 = "404" = code let is404 = "404" = code
let pageTitle = match is404 with true -> "Page Not Found" | false -> "Server Error" let pageTitle = if is404 then "Page Not Found" else "Server Error"
[ yield! [ yield!
match is404 with if is404 then
| true ->
[ p [] [ [ p [] [
raw l.["The page you requested cannot be found."] raw l["The page you requested cannot be found."]
raw l.["Please use your &ldquo;Back&rdquo; button to return to {0}.", s.["PrayerTracker"]] raw l["Please use your &ldquo;Back&rdquo; button to return to {0}.", s["PrayerTracker"]]
] ]
p [] [ p [] [
raw l.["If you reached this page from a link within {0}, please copy the link from the browser's address bar, and send it to support, along with the group for which you were currently authenticated (if any).", raw l["If you reached this page from a link within {0}, please copy the link from the browser's address bar, and send it to support, along with the group for which you were currently authenticated (if any).",
s.["PrayerTracker"]] s["PrayerTracker"]]
] ]
] ]
| false -> else
[ p [] [ [ p [] [
raw l.["An error ({0}) has occurred.", code] raw l["An error ({0}) has occurred.", code]
raw l.["Please use your &ldquo;Back&rdquo; button to return to {0}.", s.["PrayerTracker"]] raw l["Please use your &ldquo;Back&rdquo; button to return to {0}.", s["PrayerTracker"]]
] ]
] ]
br [] br []
hr [] hr []
div [ _style "font-size:70%;font-family:-apple-system,BlinkMacSystemFont,'Segoe UI',Roboto,Oxygen-Sans,Ubuntu,Cantarell,'Helvetica Neue',sans-serif" ] [ div [ _style "font-size:70%;font-family:-apple-system,BlinkMacSystemFont,'Segoe UI',Roboto,Oxygen-Sans,Ubuntu,Cantarell,'Helvetica Neue',sans-serif" ] [
img [ _src $"""/img/%A{s.["footer_en"]}.png""" img [ _src $"""/img/%A{s["footer_en"]}.png"""
_alt $"""%A{s.["PrayerTracker"]} %A{s.["from Bit Badger Solutions"]}""" _alt $"""%A{s["PrayerTracker"]} %A{s["from Bit Badger Solutions"]}"""
_title $"""%A{s.["PrayerTracker"]} %A{s.["from Bit Badger Solutions"]}""" _title $"""%A{s["PrayerTracker"]} %A{s["from Bit Badger Solutions"]}"""
_style "vertical-align:text-bottom;" ] _style "vertical-align:text-bottom;" ]
str vi.version str vi.version
] ]
@ -54,70 +52,70 @@ let index vi =
let raw = rawLocText sw let raw = rawLocText sw
[ p [] [ [ p [] [
raw l.["Welcome to <strong>{0}</strong>!", s.["PrayerTracker"]] raw l["Welcome to <strong>{0}</strong>!", s["PrayerTracker"]]
space space
raw l.["{0} is an interactive website that provides churches, Sunday School classes, and other organizations an easy way to keep up with their prayer requests.", raw l["{0} is an interactive website that provides churches, Sunday School classes, and other organizations an easy way to keep up with their prayer requests.",
s.["PrayerTracker"]] s["PrayerTracker"]]
space space
raw l.["It is provided at no charge, as a ministry and a community service."] raw l["It is provided at no charge, as a ministry and a community service."]
] ]
h4 [] [ raw l.["What Does It Do?"] ] h4 [] [ raw l["What Does It Do?"] ]
p [] [ p [] [
raw l.["{0} has what you need to make maintaining a prayer request list a breeze.", s.["PrayerTracker"]] raw l["{0} has what you need to make maintaining a prayer request list a breeze.", s["PrayerTracker"]]
space space
raw l.["Some of the things it can do..."] raw l["Some of the things it can do..."]
] ]
ul [] [ ul [] [
li [] [ li [] [
raw l.["It drops old requests off the list automatically."] raw l["It drops old requests off the list automatically."]
space space
raw l.["Requests other than “{0}” requests will expire at 14 days, though this can be changed by the organization.", raw l["Requests other than “{0}” requests will expire at 14 days, though this can be changed by the organization.",
s.["Long-Term Requests"]] s["Long-Term Requests"]]
space space
raw l.["This expiration is based on the last update, not the initial request."] raw l["This expiration is based on the last update, not the initial request."]
space space
raw l.["(And, once requests do “drop off”, they are not gone - they may be recovered if needed.)"] raw l["(And, once requests do “drop off”, they are not gone - they may be recovered if needed.)"]
] ]
li [] [ li [] [
raw l.["Requests can be viewed any time."] raw l["Requests can be viewed any time."]
space space
raw l.["Lists can be made public, or they can be secured with a password, if desired."] raw l["Lists can be made public, or they can be secured with a password, if desired."]
] ]
li [] [ li [] [
raw l.["Lists can be e-mailed to a pre-defined list of members."] raw l["Lists can be e-mailed to a pre-defined list of members."]
space space
raw l.["This can be useful for folks who may not be able to write down all the requests during class, but want a list so that they can pray for them the rest of week."] raw l["This can be useful for folks who may not be able to write down all the requests during class, but want a list so that they can pray for them the rest of week."]
space space
raw l.["E-mails are sent individually to each person, which keeps the e-mail list private and keeps the messages from being flagged as spam."] raw l["E-mails are sent individually to each person, which keeps the e-mail list private and keeps the messages from being flagged as spam."]
] ]
li [] [ li [] [
raw l.["The look and feel of the list can be configured for each group."] raw l["The look and feel of the list can be configured for each group."]
space space
raw l.["All fonts, colors, and sizes can be customized."] raw l["All fonts, colors, and sizes can be customized."]
space space
raw l.["This allows for configuration of large-print lists, among other things."] raw l["This allows for configuration of large-print lists, among other things."]
] ]
] ]
h4 [] [ raw l.["How Can Your Organization Use {0}?", s.["PrayerTracker"]] ] h4 [] [ raw l["How Can Your Organization Use {0}?", s["PrayerTracker"]] ]
p [] [ p [] [
raw l.["Like God’s gift of salvation, {0} is free for the asking for any church, Sunday School class, or other organization who wishes to use it.", raw l["Like God’s gift of salvation, {0} is free for the asking for any church, Sunday School class, or other organization who wishes to use it.",
s.["PrayerTracker"]] s["PrayerTracker"]]
space space
raw l.["If your organization would like to get set up, just <a href=\"mailto:daniel@djs-consulting.com?subject=New%20{0}%20Class\">e-mail</a> Daniel and let him know.", raw l["If your organization would like to get set up, just <a href=\"mailto:daniel@djs-consulting.com?subject=New%20{0}%20Class\">e-mail</a> Daniel and let him know.",
s.["PrayerTracker"]] s["PrayerTracker"]]
] ]
h4 [] [ raw l.["Do I Have to Register to See the Requests?"] ] h4 [] [ raw l["Do I Have to Register to See the Requests?"] ]
p [] [ p [] [
raw l.["This depends on the group."] raw l["This depends on the group."]
space space
raw l.["Lists can be configured to be password-protected, but they do not have to be."] raw l["Lists can be configured to be password-protected, but they do not have to be."]
space space
raw l.["If you click on the “{0}” link above, you will see a list of groups - those that do not indicate that they require logging in are publicly viewable.", raw l["If you click on the “{0}” link above, you will see a list of groups - those that do not indicate that they require logging in are publicly viewable.",
s.["View Request List"]] s["View Request List"]]
] ]
h4 [] [ raw l.["How Does It Work?"] ] h4 [] [ raw l["How Does It Work?"] ]
p [] [ p [] [
raw l.["Check out the “{0}” link above - it details each of the processes and how they work.", s.["Help"]] raw l["Check out the “{0}” link above - it details each of the processes and how they work.", s["Help"]]
] ]
] ]
|> Layout.Content.standard |> Layout.Content.standard
@ -131,65 +129,66 @@ let privacyPolicy vi =
use sw = new StringWriter () use sw = new StringWriter ()
let raw = rawLocText sw let raw = rawLocText sw
[ p [ _class "pt-right-text" ] [ small[] [ em [] [ raw l.["(as of July 31, 2018)"] ] ] ] [ p [ _class "pt-right-text" ] [ small [] [ em [] [ raw l["(as of July 31, 2018)"] ] ] ]
p [] [ p [] [
raw l.["The nature of the service is one where privacy is a must."] raw l["The nature of the service is one where privacy is a must."]
space space
raw l.["The items below will help you understand the data we collect, access, and store on your behalf as you use this service."] raw l["The items below will help you understand the data we collect, access, and store on your behalf as you use this service."]
] ]
h3 [] [ raw l.["What We Collect"] ] h3 [] [ raw l["What We Collect"] ]
ul [] [ ul [] [
li [] [ li [] [
strong [] [ raw l.["Identifying Data"] ] strong [] [ raw l["Identifying Data"] ]
rawText " &ndash; " rawText " &ndash; "
raw l.["{0} stores the first and last names, e-mail addresses, and hashed passwords of all authorized users.", s.["PrayerTracker"]] raw l["{0} stores the first and last names, e-mail addresses, and hashed passwords of all authorized users.",
s["PrayerTracker"]]
space space
raw l.["Users are also associated with one or more small groups."] raw l["Users are also associated with one or more small groups."]
] ]
li [] [ li [] [
strong [] [ raw l.["User Provided Data"] ] strong [] [ raw l["User Provided Data"] ]
rawText " &ndash; " rawText " &ndash; "
raw l.["{0} stores the text of prayer requests.", s.["PrayerTracker"]] raw l["{0} stores the text of prayer requests.", s["PrayerTracker"]]
space space
raw l.["It also stores names and e-mail addreses of small group members, and plain-text passwords for small groups with password-protected lists."] raw l["It also stores names and e-mail addreses of small group members, and plain-text passwords for small groups with password-protected lists."]
] ]
] ]
h3 [] [ raw l.["How Your Data Is Accessed / Secured"] ] h3 [] [ raw l["How Your Data Is Accessed / Secured"] ]
ul [] [ ul [] [
li [] [ li [] [
raw l.["While you are signed in, {0} utilizes a session cookie, and transmits that cookie to the server to establish your identity.", raw l["While you are signed in, {0} utilizes a session cookie, and transmits that cookie to the server to establish your identity.",
s.["PrayerTracker"]] s["PrayerTracker"]]
space space
raw l.["If you utilize the “{0}” box on sign in, a second cookie is stored, and transmitted to establish a session; this cookie is removed by clicking the “{1}” link.", raw l["If you utilize the “{0}” box on sign in, a second cookie is stored, and transmitted to establish a session; this cookie is removed by clicking the “{1}” link.",
s.["Remember Me"], s.["Log Off"]] s["Remember Me"], s["Log Off"]]
space space
raw l.["Both of these cookies are encrypted, both in your browser and in transit."] raw l["Both of these cookies are encrypted, both in your browser and in transit."]
space space
raw l.["Finally, a third cookie is used to maintain your currently selected language, so that this selection is maintained across browser sessions."] raw l["Finally, a third cookie is used to maintain your currently selected language, so that this selection is maintained across browser sessions."]
] ]
li [] [ li [] [
raw l.["Data for your small group is returned to you, as required, to display and edit."] raw l["Data for your small group is returned to you, as required, to display and edit."]
space space
raw l.["{0} also sends e-mails on behalf of the configured owner of a small group; these e-mails are sent from prayer@djs-consulting.com, with the “Reply To” header set to the configured owner of the small group.", raw l["{0} also sends e-mails on behalf of the configured owner of a small group; these e-mails are sent from prayer@djs-consulting.com, with the “Reply To” header set to the configured owner of the small group.",
s.["PrayerTracker"]] s["PrayerTracker"]]
space space
raw l.["Distinct e-mails are sent to each user, as to not disclose the other recipients."] raw l["Distinct e-mails are sent to each user, as to not disclose the other recipients."]
space space
raw l.["On the server, all data is stored in a controlled-access database."] raw l["On the server, all data is stored in a controlled-access database."]
] ]
li [] [ li [] [
raw l.["Your data is backed up, along with other Bit Badger Solutions hosted systems, in a rolling manner; backups are preserved for the prior 7 days, and backups from the 1st and 15th are preserved for 3 months."] raw l["Your data is backed up, along with other Bit Badger Solutions hosted systems, in a rolling manner; backups are preserved for the prior 7 days, and backups from the 1st and 15th are preserved for 3 months."]
space space
raw l.["These backups are stored in a private cloud data repository."] raw l["These backups are stored in a private cloud data repository."]
] ]
li [] [ li [] [
raw l.["Access to servers and backups is strictly controlled and monitored for unauthorized access attempts."] raw l["Access to servers and backups is strictly controlled and monitored for unauthorized access attempts."]
] ]
] ]
h3 [] [ raw l.["Removing Your Data"] ] h3 [] [ raw l["Removing Your Data"] ]
p [] [ p [] [
raw l.["At any time, you may choose to discontinue using {0}; just e-mail Daniel, as you did to register, and request deletion of your small group.", raw l["At any time, you may choose to discontinue using {0}; just e-mail Daniel, as you did to register, and request deletion of your small group.",
s.["PrayerTracker"]] s["PrayerTracker"]]
] ]
] ]
|> Layout.Content.standard |> Layout.Content.standard
@ -203,41 +202,41 @@ let termsOfService vi =
use sw = new StringWriter () use sw = new StringWriter ()
let raw = rawLocText sw let raw = rawLocText sw
let ppLink = let ppLink =
a [ _href "/web/legal/privacy-policy" ] [ str (s.["Privacy Policy"].Value.ToLower ()) ] a [ _href "/web/legal/privacy-policy" ] [ str (s["Privacy Policy"].Value.ToLower ()) ]
|> renderHtmlString |> renderHtmlString
[ p [ _class "pt-right-text" ] [ small [] [ em [] [ raw l.["(as of May 24, 2018)"] ] ] ] [ p [ _class "pt-right-text" ] [ small [] [ em [] [ raw l["(as of May 24, 2018)"] ] ] ]
h3 [] [ str "1. "; raw l.["Acceptance of Terms"] ] h3 [] [ str "1. "; raw l["Acceptance of Terms"] ]
p [] [ p [] [
raw l.["By accessing this web site, you are agreeing to be bound by these Terms and Conditions, and that you are responsible to ensure that your use of this site complies with all applicable laws."] raw l["By accessing this web site, you are agreeing to be bound by these Terms and Conditions, and that you are responsible to ensure that your use of this site complies with all applicable laws."]
space space
raw l.["Your continued use of this site implies your acceptance of these terms."] raw l["Your continued use of this site implies your acceptance of these terms."]
] ]
h3 [] [ str "2. "; raw l.["Description of Service and Registration"] ] h3 [] [ str "2. "; raw l["Description of Service and Registration"] ]
p [] [ p [] [
raw l.["{0} is a service that allows individuals to enter and amend prayer requests on behalf of organizations.", raw l["{0} is a service that allows individuals to enter and amend prayer requests on behalf of organizations.",
s.["PrayerTracker"]] s["PrayerTracker"]]
space space
raw l.["Registration is accomplished via e-mail to Daniel Summers (daniel at bitbadger dot solutions, substituting punctuation)."] raw l["Registration is accomplished via e-mail to Daniel Summers (daniel at bitbadger dot solutions, substituting punctuation)."]
space space
raw l.["See our {0} for details on the personal (user) information we maintain.", ppLink] raw l["See our {0} for details on the personal (user) information we maintain.", ppLink]
] ]
h3 [] [ str "3. "; raw l.["Liability"] ] h3 [] [ str "3. "; raw l["Liability"] ]
p [] [ p [] [
raw l.["This service is provided “as is”, and no warranty (express or implied) exists."] raw l["This service is provided “as is”, and no warranty (express or implied) exists."]
space space
raw l.["The service and its developers may not be held liable for any damages that may arise through the use of this service."] raw l["The service and its developers may not be held liable for any damages that may arise through the use of this service."]
] ]
h3 [] [ str "4. "; raw l.["Updates to Terms"] ] h3 [] [ str "4. "; raw l["Updates to Terms"] ]
p [] [ p [] [
raw l.["These terms and conditions may be updated at any time."] raw l["These terms and conditions may be updated at any time."]
space space
raw l.["When these terms are updated, users will be notified by a system-generated announcement."] raw l["When these terms are updated, users will be notified by a system-generated announcement."]
space space
raw l.["Additionally, the date at the top of this page will be updated."] raw l["Additionally, the date at the top of this page will be updated."]
] ]
hr [] hr []
p [] [ raw l.["You may also wish to review our {0} to learn how we handle your data.", ppLink] ] p [] [ raw l["You may also wish to review our {0} to learn how we handle your data.", ppLink] ]
] ]
|> Layout.Content.standard |> Layout.Content.standard
|> Layout.standard vi "Terms of Service" |> Layout.standard vi "Terms of Service"
@ -250,12 +249,12 @@ let unauthorized vi =
use sw = new StringWriter () use sw = new StringWriter ()
let raw = rawLocText sw let raw = rawLocText sw
[ p [] [ [ p [] [
raw l.["If you feel you have reached this page in error, please <a href=\"mailto:daniel@djs-consulting.com?Subject={0}%20Unauthorized%20Access\">contact Daniel</a> and provide the details as to what you were doing (i.e., what link did you click, where had you been, etc.).", raw l["If you feel you have reached this page in error, please <a href=\"mailto:daniel@djs-consulting.com?Subject={0}%20Unauthorized%20Access\">contact Daniel</a> and provide the details as to what you were doing (i.e., what link did you click, where had you been, etc.).",
s.["PrayerTracker"]] s["PrayerTracker"]]
] ]
p [] [ p [] [
raw l.["Otherwise, you may select one of the links above to get back into an authorized portion of {0}.", raw l["Otherwise, you may select one of the links above to get back into an authorized portion of {0}.",
s.["PrayerTracker"]] s["PrayerTracker"]]
] ]
] ]
|> Layout.Content.standard |> Layout.Content.standard

149
src/PrayerTracker.UI/Layout.fs
View File

@ -9,7 +9,7 @@ open System.Globalization
/// Get the two-character language code for the current request /// Get the two-character language code for the current request
let langCode () = match CultureInfo.CurrentCulture.Name.StartsWith "es" with true -> "es" | _ -> "en" let langCode () = if CultureInfo.CurrentCulture.Name.StartsWith "es" then "es" else "en"
/// Navigation items /// Navigation items
@ -17,95 +17,101 @@ module Navigation =
/// Top navigation bar /// Top navigation bar
let top m = let top m =
let s = PrayerTracker.Views.I18N.localizer.Force () let s = I18N.localizer.Force ()
let menuSpacer = rawText "&nbsp; " let menuSpacer = rawText "&nbsp; "
let leftLinks = [ let leftLinks = [
match m.user with match m.user with
| Some u -> | Some u ->
li [ _class "dropdown" ] [ li [ _class "dropdown" ] [
a [ _class "dropbtn"; _role "button"; _aria "label" s.["Requests"].Value; _title s.["Requests"].Value ] a [ _class "dropbtn"; _role "button"; _aria "label" s["Requests"].Value; _title s["Requests"].Value ]
[ icon "question_answer"; space; locStr s.["Requests"]; space; icon "keyboard_arrow_down" ] [ icon "question_answer"; space; locStr s["Requests"]; space; icon "keyboard_arrow_down" ]
div [ _class "dropdown-content"; _role "menu" ] [ div [ _class "dropdown-content"; _role "menu" ] [
a [ _href "/web/prayer-requests" ] [ icon "compare_arrows"; menuSpacer; locStr s.["Maintain"] ] a [ _href "/web/prayer-requests" ] [ icon "compare_arrows"; menuSpacer; locStr s["Maintain"] ]
a [ _href "/web/prayer-requests/view" ] [ icon "list"; menuSpacer; locStr s.["View List"] ] a [ _href "/web/prayer-requests/view" ] [ icon "list"; menuSpacer; locStr s["View List"] ]
] ]
] ]
li [ _class "dropdown" ] [ li [ _class "dropdown" ] [
a [ _class "dropbtn"; _role "button"; _aria "label" s.["Group"].Value; _title s.["Group"].Value ] a [ _class "dropbtn"; _role "button"; _aria "label" s["Group"].Value; _title s["Group"].Value ]
[ icon "group"; space; locStr s.["Group"]; space; icon "keyboard_arrow_down" ] [ icon "group"; space; locStr s["Group"]; space; icon "keyboard_arrow_down" ]
div [ _class "dropdown-content"; _role "menu" ] [ div [ _class "dropdown-content"; _role "menu" ] [
a [ _href "/web/small-group/members" ] [ icon "email"; menuSpacer; locStr s.["Maintain Group Members"] ] a [ _href "/web/small-group/members" ]
a [ _href "/web/small-group/announcement" ] [ icon "send"; menuSpacer; locStr s.["Send Announcement"] ] [ icon "email"; menuSpacer; locStr s["Maintain Group Members"] ]
a [ _href "/web/small-group/preferences" ] [ icon "build"; menuSpacer; locStr s.["Change Preferences"] ] a [ _href "/web/small-group/announcement" ]
[ icon "send"; menuSpacer; locStr s["Send Announcement"] ]
a [ _href "/web/small-group/preferences" ]
[ icon "build"; menuSpacer; locStr s["Change Preferences"] ]
] ]
] ]
match u.isAdmin with if u.isAdmin then
| true ->
li [ _class "dropdown" ] [ li [ _class "dropdown" ] [
a [ _class "dropbtn"; _role "button"; _aria "label" s.["Administration"].Value; _title s.["Administration"].Value ] a [ _class "dropbtn"
[ icon "settings"; space; locStr s.["Administration"]; space; icon "keyboard_arrow_down" ] _role "button"
_aria "label" s["Administration"].Value
_title s["Administration"].Value
] [ icon "settings"; space; locStr s["Administration"]; space; icon "keyboard_arrow_down" ]
div [ _class "dropdown-content"; _role "menu" ] [ div [ _class "dropdown-content"; _role "menu" ] [
a [ _href "/web/churches" ] [ icon "home"; menuSpacer; locStr s.["Churches"] ] a [ _href "/web/churches" ] [ icon "home"; menuSpacer; locStr s["Churches"] ]
a [ _href "/web/small-groups" ] [ icon "send"; menuSpacer; locStr s.["Groups"] ] a [ _href "/web/small-groups" ] [ icon "send"; menuSpacer; locStr s["Groups"] ]
a [ _href "/web/users" ] [ icon "build"; menuSpacer; locStr s.["Users"] ] a [ _href "/web/users" ] [ icon "build"; menuSpacer; locStr s["Users"] ]
] ]
] ]
| false -> ()
| None -> | None ->
match m.group with match m.group with
| Some _ -> | Some _ ->
li [] [ li [] [
a [ _href "/web/prayer-requests/view" a [ _href "/web/prayer-requests/view"
_aria "label" s.["View Request List"].Value _aria "label" s["View Request List"].Value
_title s.["View Request List"].Value ] _title s["View Request List"].Value
[ icon "list"; space; locStr s.["View Request List"] ] ] [ icon "list"; space; locStr s["View Request List"] ]
] ]
| None -> | None ->
li [ _class "dropdown" ] [ li [ _class "dropdown" ] [
a [ _class "dropbtn"; _role "button"; _aria "label" s.["Log On"].Value; _title s.["Log On"].Value ] a [ _class "dropbtn"
[ icon "security"; space; locStr s.["Log On"]; space; icon "keyboard_arrow_down" ] _role "button"
_aria "label" s["Log On"].Value
_title s["Log On"].Value
] [ icon "security"; space; locStr s["Log On"]; space; icon "keyboard_arrow_down" ]
div [ _class "dropdown-content"; _role "menu" ] [ div [ _class "dropdown-content"; _role "menu" ] [
a [ _href "/web/user/log-on" ] [ icon "person"; menuSpacer; locStr s.["User"] ] a [ _href "/web/user/log-on" ] [ icon "person"; menuSpacer; locStr s["User"] ]
a [ _href "/web/small-group/log-on" ] [ icon "group"; menuSpacer; locStr s.["Group"] ] a [ _href "/web/small-group/log-on" ] [ icon "group"; menuSpacer; locStr s["Group"] ]
] ]
] ]
li [] [ li [] [
a [ _href "/web/prayer-requests/lists" a [ _href "/web/prayer-requests/lists"
_aria "label" s.["View Request List"].Value _aria "label" s["View Request List"].Value
_title s.["View Request List"].Value ] _title s["View Request List"].Value
[ icon "list"; space; locStr s.["View Request List"] ] ] [ icon "list"; space; locStr s["View Request List"] ]
] ]
li [] [ li [] [
a [ _href $"https://docs.prayer.bitbadger.solutions/{langCode ()}" a [ _href $"https://docs.prayer.bitbadger.solutions/{langCode ()}"
_aria "label" s.["Help"].Value; _aria "label" s["Help"].Value;
_title s.["View Help"].Value _title s["View Help"].Value
_target "_blank" _target "_blank"
] ] [ icon "help"; space; locStr s["Help"] ]
[ icon "help"; space; locStr s.["Help"] ]
] ]
] ]
let rightLinks = let rightLinks =
match m.group with match m.group with
| Some _ -> | Some _ -> [
[ match m.user with match m.user with
| Some _ -> | Some _ ->
li [] [ li [] [
a [ _href "/web/user/password" a [ _href "/web/user/password"
_aria "label" s.["Change Your Password"].Value _aria "label" s["Change Your Password"].Value
_title s.["Change Your Password"].Value ] _title s["Change Your Password"].Value
[ icon "lock"; space; locStr s.["Change Your Password"] ] ] [ icon "lock"; space; locStr s["Change Your Password"] ]
] ]
| None -> () | None -> ()
li [] [ li [] [
a [ _href "/web/log-off"; _aria "label" s.["Log Off"].Value; _title s.["Log Off"].Value ] a [ _href "/web/log-off"; _aria "label" s["Log Off"].Value; _title s["Log Off"].Value ]
[ icon "power_settings_new"; space; locStr s.["Log Off"] ] [ icon "power_settings_new"; space; locStr s["Log Off"] ]
] ]
] ]
| None -> List.empty | None -> []
header [ _class "pt-title-bar" ] [ header [ _class "pt-title-bar" ] [
section [ _class "pt-title-bar-left" ] [ section [ _class "pt-title-bar-left" ] [
span [ _class "pt-title-bar-home" ] [ span [ _class "pt-title-bar-home" ] [
a [ _href "/web/"; _title s.["Home"].Value ] [ locStr s.["PrayerTracker"] ] a [ _href "/web/"; _title s["Home"].Value ] [ locStr s["PrayerTracker"] ]
] ]
ul [] leftLinks ul [] leftLinks
] ]
@ -120,28 +126,28 @@ module Navigation =
let s = I18N.localizer.Force () let s = I18N.localizer.Force ()
header [ _id "pt-language" ] [ header [ _id "pt-language" ] [
div [] [ div [] [
span [ _class "u" ] [ locStr s.["Language"]; rawText ": " ] span [ _class "u" ] [ locStr s["Language"]; rawText ": " ]
match langCode () with match langCode () with
| "es" -> | "es" ->
locStr s.["Spanish"] locStr s["Spanish"]
rawText " &nbsp; &bull; &nbsp; " rawText " &nbsp; &bull; &nbsp; "
a [ _href "/web/language/en" ] [ locStr s.["Change to English"] ] a [ _href "/web/language/en" ] [ locStr s["Change to English"] ]
| _ -> | _ ->
locStr s.["English"] locStr s["English"]
rawText " &nbsp; &bull; &nbsp; " rawText " &nbsp; &bull; &nbsp; "
a [ _href "/web/language/es" ] [ locStr s.["Cambie a Español"] ] a [ _href "/web/language/es" ] [ locStr s["Cambie a Español"] ]
] ]
match m.group with match m.group with
| Some g -> | Some g ->[
[ match m.user with match m.user with
| Some u -> | Some u ->
span [ _class "u" ] [ locStr s.["Currently Logged On"] ] span [ _class "u" ] [ locStr s["Currently Logged On"] ]
rawText "&nbsp; &nbsp;" rawText "&nbsp; &nbsp;"
icon "person" icon "person"
strong [] [ str u.fullName ] strong [] [ str u.fullName ]
rawText "&nbsp; &nbsp; " rawText "&nbsp; &nbsp; "
| None -> | None ->
locStr s.["Logged On as a Member of"] locStr s["Logged On as a Member of"]
rawText "&nbsp; " rawText "&nbsp; "
icon "group" icon "group"
space space
@ -157,6 +163,7 @@ module Navigation =
/// Content layouts /// Content layouts
module Content = module Content =
/// Content layout that tops at 60rem /// Content layout that tops at 60rem
let standard = div [ _class "pt-content" ] let standard = div [ _class "pt-content" ]
@ -167,6 +174,7 @@ module Content =
/// Separator for parts of the title /// Separator for parts of the title
let private titleSep = rawText " &#xab; " let private titleSep = rawText " &#xab; "
/// Common HTML head tag items
let private commonHead = let private commonHead =
[ meta [ _name "viewport"; _content "width=device-width, initial-scale=1" ] [ meta [ _name "viewport"; _content "width=device-width, initial-scale=1" ]
meta [ _name "generator"; _content "Giraffe" ] meta [ _name "generator"; _content "Giraffe" ]
@ -180,7 +188,7 @@ let private htmlHead m pageTitle =
let s = I18N.localizer.Force () let s = I18N.localizer.Force ()
head [] [ head [] [
meta [ _charset "UTF-8" ] meta [ _charset "UTF-8" ]
title [] [ locStr pageTitle; titleSep; locStr s.["PrayerTracker"] ] title [] [ locStr pageTitle; titleSep; locStr s["PrayerTracker"] ]
yield! commonHead yield! commonHead
for cssFile in m.style do for cssFile in m.style do
link [ _rel "stylesheet"; _href $"/css/{cssFile}.css"; _type "text/css" ] link [ _rel "stylesheet"; _href $"/css/{cssFile}.css"; _type "text/css" ]
@ -192,11 +200,8 @@ let private htmlHead m pageTitle =
let private helpLink link = let private helpLink link =
let s = I18N.localizer.Force () let s = I18N.localizer.Force ()
sup [] [ sup [] [
a [ _href link a [ _href link; _title s["Click for Help on This Page"].Value; _onclick $"return PT.showHelp('{link}')" ]
_title s.["Click for Help on This Page"].Value [ icon "help_outline" ]
_onclick $"return PT.showHelp('{link}')" ] [
icon "help_outline"
]
] ]
/// Render the page title, and optionally a help link /// Render the page title, and optionally a help link
@ -217,7 +222,7 @@ let private messages m =
match msg.level with match msg.level with
| "Info" -> () | "Info" -> ()
| lvl -> | lvl ->
strong [] [ locStr s.[lvl] ] strong [] [ locStr s[lvl] ]
rawText " &#xbb; " rawText " &#xbb; "
rawText msg.text.Value rawText msg.text.Value
match msg.description with match msg.description with
@ -232,37 +237,35 @@ let private messages m =
/// Render the <footer> at the bottom of the page /// Render the <footer> at the bottom of the page
let private htmlFooter m = let private htmlFooter m =
let s = I18N.localizer.Force () let s = I18N.localizer.Force ()
let imgText = sprintf "%O %O" s.["PrayerTracker"] s.["from Bit Badger Solutions"] let imgText = sprintf "%O %O" s["PrayerTracker"] s["from Bit Badger Solutions"]
let resultTime = TimeSpan(DateTime.Now.Ticks - m.requestStart).TotalSeconds let resultTime = TimeSpan(DateTime.Now.Ticks - m.requestStart).TotalSeconds
footer [] [ footer [] [
div [ _id "pt-legal" ] [ div [ _id "pt-legal" ] [
a [ _href "/web/legal/privacy-policy" ] [ locStr s.["Privacy Policy"] ] a [ _href "/web/legal/privacy-policy" ] [ locStr s["Privacy Policy"] ]
rawText " &bull; " rawText " &bull; "
a [ _href "/web/legal/terms-of-service" ] [ locStr s.["Terms of Service"] ] a [ _href "/web/legal/terms-of-service" ] [ locStr s["Terms of Service"] ]
rawText " &bull; " rawText " &bull; "
a [ _href "https://github.com/bit-badger/PrayerTracker" a [ _href "https://github.com/bit-badger/PrayerTracker"
_title s.["View source code and get technical support"].Value _title s["View source code and get technical support"].Value
_target "_blank" _target "_blank"
_rel "noopener" ] [ _rel "noopener"
locStr s.["Source & Support"] ] [ locStr s["Source & Support"]
] ]
] ]
div [ _id "pt-footer" ] [ div [ _id "pt-footer" ] [
a [ _href "/web/"; _style "line-height:28px;" ] [ a [ _href "/web/"; _style "line-height:28px;" ]
img [ _src $"""/img/%O{s.["footer_en"]}.png"""; _alt imgText; _title imgText ] [ img [ _src $"""/img/%O{s["footer_en"]}.png"""; _alt imgText; _title imgText ] ]
]
str m.version str m.version
space space
i [ _title s.["This page loaded in {0:N3} seconds", resultTime].Value; _class "material-icons md-18" ] [ i [ _title s["This page loaded in {0:N3} seconds", resultTime].Value; _class "material-icons md-18" ]
str "schedule" [ str "schedule" ]
]
] ]
] ]
/// The standard layout for PrayerTracker /// The standard layout for PrayerTracker
let standard m pageTitle (content : XmlNode) = let standard m pageTitle (content : XmlNode) =
let s = I18N.localizer.Force () let s = I18N.localizer.Force ()
let ttl = s.[pageTitle] let ttl = s[pageTitle]
html [ _lang "" ] [ html [ _lang "" ] [
htmlHead m ttl htmlHead m ttl
body [] [ body [] [
@ -280,11 +283,11 @@ let standard m pageTitle (content : XmlNode) =
/// A layout with nothing but a title and content /// A layout with nothing but a title and content
let bare pageTitle content = let bare pageTitle content =
let s = I18N.localizer.Force () let s = I18N.localizer.Force ()
let ttl = s.[pageTitle] let ttl = s[pageTitle]
html [ _lang "" ] [ html [ _lang "" ] [
head [] [ head [] [
meta [ _charset "UTF-8" ] meta [ _charset "UTF-8" ]
title [] [ locStr ttl; titleSep; locStr s.["PrayerTracker"] ] title [] [ locStr ttl; titleSep; locStr s["PrayerTracker"] ]
] ]
body [] [ content ] body [] [ content ]
] ]

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

@ -1,5 +1,7 @@
module PrayerTracker.Views.PrayerRequest module PrayerTracker.Views.PrayerRequest
open System
open System.IO
open Giraffe open Giraffe
open Giraffe.ViewEngine open Giraffe.ViewEngine
open Microsoft.AspNetCore.Http open Microsoft.AspNetCore.Http
@ -7,52 +9,48 @@ open NodaTime
open PrayerTracker open PrayerTracker
open PrayerTracker.Entities open PrayerTracker.Entities
open PrayerTracker.ViewModels open PrayerTracker.ViewModels
open System
open System.IO
open System.Text
/// View for the prayer request edit page /// View for the prayer request edit page
let edit (m : EditRequest) today ctx vi = let edit (m : EditRequest) today ctx vi =
let s = I18N.localizer.Force () let s = I18N.localizer.Force ()
let pageTitle = match m.isNew () with true -> "Add a New Request" | false -> "Edit Request" let pageTitle = if m.isNew () then "Add a New Request" else "Edit Request"
[ form [ _action "/web/prayer-request/save"; _method "post"; _class "pt-center-columns" ] [ [ form [ _action "/web/prayer-request/save"; _method "post"; _class "pt-center-columns" ] [
csrfToken ctx csrfToken ctx
input [ _type "hidden"; _name "requestId"; _value (flatGuid m.requestId) ] input [ _type "hidden"; _name "requestId"; _value (flatGuid m.requestId) ]
div [ _class "pt-field-row" ] [ div [ _class "pt-field-row" ] [
div [ _class "pt-field" ] [ div [ _class "pt-field" ] [
label [ _for "requestType" ] [ locStr s.["Request Type"] ] label [ _for "requestType" ] [ locStr s["Request Type"] ]
ReferenceList.requestTypeList s ReferenceList.requestTypeList s
|> Seq.ofList |> Seq.ofList
|> Seq.map (fun (typ, desc) -> typ.code, desc.Value) |> Seq.map (fun (typ, desc) -> typ.code, desc.Value)
|> selectList "requestType" m.requestType [ _required; _autofocus ] |> selectList "requestType" m.requestType [ _required; _autofocus ]
] ]
div [ _class "pt-field" ] [ div [ _class "pt-field" ] [
label [ _for "requestor" ] [ locStr s.["Requestor / Subject"] ] label [ _for "requestor" ] [ locStr s["Requestor / Subject"] ]
input [ _type "text" input [ _type "text"
_name "requestor" _name "requestor"
_id "requestor" _id "requestor"
_value (match m.requestor with Some x -> x | None -> "") ] _value (match m.requestor with Some x -> x | None -> "") ]
] ]
match m.isNew () with if m.isNew () then
| true ->
div [ _class "pt-field" ] [ div [ _class "pt-field" ] [
label [ _for "enteredDate" ] [ locStr s.["Date"] ] label [ _for "enteredDate" ] [ locStr s["Date"] ]
input [ _type "date"; _name "enteredDate"; _id "enteredDate"; _placeholder today ] input [ _type "date"; _name "enteredDate"; _id "enteredDate"; _placeholder today ]
] ]
| false -> else
div [ _class "pt-field" ] [ div [ _class "pt-field" ] [
div [ _class "pt-checkbox-field" ] [ div [ _class "pt-checkbox-field" ] [
br [] br []
input [ _type "checkbox"; _name "skipDateUpdate"; _id "skipDateUpdate"; _value "True" ] input [ _type "checkbox"; _name "skipDateUpdate"; _id "skipDateUpdate"; _value "True" ]
label [ _for "skipDateUpdate" ] [ locStr s.["Check to not update the date"] ] label [ _for "skipDateUpdate" ] [ locStr s["Check to not update the date"] ]
br [] br []
small [] [ em [] [ str (s.["Typo Corrections"].Value.ToLower ()); rawText ", etc." ] ] small [] [ em [] [ str (s["Typo Corrections"].Value.ToLower ()); rawText ", etc." ] ]
] ]
] ]
] ]
div [ _class "pt-field-row" ] [ div [ _class "pt-field-row" ] [
div [ _class "pt-field" ] [ div [ _class "pt-field" ] [
label [] [ locStr s.["Expiration"] ] label [] [ locStr s["Expiration"] ]
ReferenceList.expirationList s ((m.isNew >> not) ()) ReferenceList.expirationList s ((m.isNew >> not) ())
|> List.map (fun exp -> |> List.map (fun exp ->
let radioId = $"expiration_{fst exp}" let radioId = $"expiration_{fst exp}"
@ -66,11 +64,11 @@ let edit (m : EditRequest) today ctx vi =
] ]
div [ _class "pt-field-row" ] [ div [ _class "pt-field-row" ] [
div [ _class "pt-field pt-editor" ] [ div [ _class "pt-field pt-editor" ] [
label [ _for "text" ] [ locStr s.["Request"] ] label [ _for "text" ] [ locStr s["Request"] ]
textarea [ _name "text"; _id "text" ] [ str m.text ] textarea [ _name "text"; _id "text" ] [ str m.text ]
] ]
] ]
div [ _class "pt-field-row" ] [ submit [] "save" s.["Save Request"] ] div [ _class "pt-field-row" ] [ submit [] "save" s["Save Request"] ]
] ]
script [] [ rawText "PT.onLoad(PT.initCKEditor)" ] script [] [ rawText "PT.onLoad(PT.initCKEditor)" ]
] ]
@ -80,24 +78,21 @@ let edit (m : EditRequest) today ctx vi =
/// View for the request e-mail results page /// View for the request e-mail results page
let email m vi = let email m vi =
let s = I18N.localizer.Force () let s = I18N.localizer.Force ()
let pageTitle = $"""{s.["Prayer Requests"].Value} • {m.listGroup.name}""" let pageTitle = $"""{s["Prayer Requests"].Value} • {m.listGroup.name}"""
let prefs = m.listGroup.preferences let prefs = m.listGroup.preferences
let addresses = let addresses = String.Join (", ", m.recipients |> List.map (fun mbr -> $"{mbr.memberName} <{mbr.email}>"))
m.recipients
|> List.fold (fun (acc : StringBuilder) mbr -> acc.AppendFormat(", {0} <{1}>", mbr.memberName, mbr.email))
(StringBuilder ())
[ p [ _style $"font-family:{prefs.listFonts};font-size:%i{prefs.textFontSize}pt;" ] [ [ p [ _style $"font-family:{prefs.listFonts};font-size:%i{prefs.textFontSize}pt;" ] [
locStr s.["The request list was sent to the following people, via individual e-mails"] locStr s["The request list was sent to the following people, via individual e-mails"]
rawText ":" rawText ":"
br [] br []
small [] [ str (addresses.Remove(0, 2).ToString ()) ] small [] [ str addresses ]
] ]
span [ _class "pt-email-heading" ] [ locStr s.["HTML Format"]; rawText ":" ] span [ _class "pt-email-heading" ] [ locStr s["HTML Format"]; rawText ":" ]
div [ _class "pt-email-canvas" ] [ rawText (m.asHtml s) ] div [ _class "pt-email-canvas" ] [ rawText (m.asHtml s) ]
br [] br []
br [] br []
span [ _class "pt-email-heading" ] [ locStr s.["Plain-Text Format"]; rawText ":" ] span [ _class "pt-email-heading" ] [ locStr s["Plain-Text Format"]; rawText ":" ]
div[ _class "pt-email-canvas" ] [ pre [] [ str (m.asText s) ] ] div [ _class "pt-email-canvas" ] [ pre [] [ str (m.asText s) ] ]
] ]
|> Layout.Content.standard |> Layout.Content.standard
|> Layout.standard vi pageTitle |> Layout.standard vi pageTitle
@ -113,39 +108,38 @@ let list (m : RequestList) vi =
/// View for the prayer request lists page /// View for the prayer request lists page
let lists (grps : SmallGroup list) vi = let lists (groups : SmallGroup list) vi =
let s = I18N.localizer.Force () let s = I18N.localizer.Force ()
let l = I18N.forView "Requests/Lists" let l = I18N.forView "Requests/Lists"
use sw = new StringWriter () use sw = new StringWriter ()
let raw = rawLocText sw let raw = rawLocText sw
[ p [] [ [ p [] [
raw l.["The groups listed below have either public or password-protected request lists."] raw l["The groups listed below have either public or password-protected request lists."]
space space
raw l.["Those with list icons are public, and those with log on icons are password-protected."] raw l["Those with list icons are public, and those with log on icons are password-protected."]
space space
raw l.["Click the appropriate icon to log on or view the request list."] raw l["Click the appropriate icon to log on or view the request list."]
] ]
match grps.Length with match groups.Length with
| 0 -> p [] [ raw l.["There are no groups with public or password-protected request lists."] ] | 0 -> p [] [ raw l["There are no groups with public or password-protected request lists."] ]
| count -> | count ->
tableSummary count s tableSummary count s
table [ _class "pt-table pt-action-table" ] [ table [ _class "pt-table pt-action-table" ] [
thead [] [ thead [] [
tr [] [ tr [] [
th [] [ locStr s.["Actions"] ] th [] [ locStr s["Actions"] ]
th [] [ locStr s.["Church"] ] th [] [ locStr s["Church"] ]
th [] [ locStr s.["Group"] ] th [] [ locStr s["Group"] ]
] ]
] ]
grps groups
|> List.map (fun grp -> |> List.map (fun grp ->
let grpId = flatGuid grp.smallGroupId let grpId = flatGuid grp.smallGroupId
tr [] [ tr [] [
match grp.preferences.isPublic with if grp.preferences.isPublic then
| true -> a [ _href $"/web/prayer-requests/{grpId}/list"; _title s["View"].Value ] [ icon "list" ]
a [ _href $"/web/prayer-requests/{grpId}/list"; _title s.["View"].Value ] [ icon "list" ] else
| false -> a [ _href $"/web/small-group/log-on/{grpId}"; _title s["Log On"].Value ]
a [ _href $"/web/small-group/log-on/{grpId}"; _title s.["Log On"].Value ]
[ icon "verified_user" ] [ icon "verified_user" ]
|> List.singleton |> List.singleton
|> td [] |> td []
@ -168,12 +162,12 @@ let maintain m (ctx : HttpContext) vi =
let now = m.smallGroup.localDateNow (ctx.GetService<IClock> ()) let now = m.smallGroup.localDateNow (ctx.GetService<IClock> ())
let typs = ReferenceList.requestTypeList s |> Map.ofList let typs = ReferenceList.requestTypeList s |> Map.ofList
let updReq (req : PrayerRequest) = let updReq (req : PrayerRequest) =
match req.updateRequired now m.smallGroup.preferences.daysToExpire m.smallGroup.preferences.longTermUpdateWeeks with if req.updateRequired now m.smallGroup.preferences.daysToExpire m.smallGroup.preferences.longTermUpdateWeeks then
| true -> "pt-request-update" "pt-request-update"
| false -> "" else ""
|> _class |> _class
let reqExp (req : PrayerRequest) = let reqExp (req : PrayerRequest) =
_class (match req.isExpired now m.smallGroup.preferences.daysToExpire with true -> "pt-request-expired" | false -> "") _class (if req.isExpired now m.smallGroup.preferences.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 /// Iterate the sequence once, before we render, so we can get the count of it at the top of the table
let requests = let requests =
m.requests m.requests
@ -182,65 +176,63 @@ let maintain m (ctx : HttpContext) vi =
let reqText = htmlToPlainText req.text let reqText = htmlToPlainText req.text
let delAction = $"/web/prayer-request/{reqId}/delete" let delAction = $"/web/prayer-request/{reqId}/delete"
let delPrompt = let delPrompt =
[ s.["Are you sure you want to delete this {0}? This action cannot be undone.", [ s["Are you sure you want to delete this {0}? This action cannot be undone.",
s.["Prayer Request"].Value.ToLower() ] s["Prayer Request"].Value.ToLower() ].Value
.Value
"\\n" "\\n"
l.["(If the prayer request has been answered, or an event has passed, consider inactivating it instead.)"] l["(If the prayer request has been answered, or an event has passed, consider inactivating it instead.)"]
.Value .Value
] ]
|> String.concat "" |> String.concat ""
tr [] [ tr [] [
td [] [ td [] [
a [ _href $"/web/prayer-request/{reqId}/edit"; _title l.["Edit This Prayer Request"].Value ] a [ _href $"/web/prayer-request/{reqId}/edit"; _title l["Edit This Prayer Request"].Value ]
[ icon "edit" ] [ icon "edit" ]
match req.isExpired now m.smallGroup.preferences.daysToExpire with if req.isExpired now m.smallGroup.preferences.daysToExpire then
| true ->
a [ _href $"/web/prayer-request/{reqId}/restore" a [ _href $"/web/prayer-request/{reqId}/restore"
_title l.["Restore This Inactive Request"].Value ] _title l["Restore This Inactive Request"].Value ]
[ icon "visibility" ] [ icon "visibility" ]
| false -> else
a [ _href $"/web/prayer-request/{reqId}/expire" a [ _href $"/web/prayer-request/{reqId}/expire"
_title l.["Expire This Request Immediately"].Value ] _title l["Expire This Request Immediately"].Value ]
[ icon "visibility_off" ] [ icon "visibility_off" ]
a [ _href delAction; _title l.["Delete This Request"].Value; a [ _href delAction; _title l["Delete This Request"].Value;
_onclick $"return PT.confirmDelete('{delAction}','{delPrompt}')" ] _onclick $"return PT.confirmDelete('{delAction}','{delPrompt}')" ]
[ icon "delete_forever" ] [ icon "delete_forever" ]
] ]
td [ updReq req ] [ 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 typs.[req.requestType] ] td [] [ locStr typs[req.requestType] ]
td [ reqExp req ] [ str (match req.requestor with Some r -> r | None -> " ") ] td [ reqExp req ] [ str (match req.requestor with Some r -> r | None -> " ") ]
td [] [ td [] [
match reqText.Length with match reqText.Length with
| len when len < 60 -> rawText reqText | len when len < 60 -> rawText reqText
| _ -> rawText $"{reqText.[0..59]}&hellip;" | _ -> rawText $"{reqText[0..59]}&hellip;"
] ]
]) ])
|> List.ofSeq |> List.ofSeq
[ div [ _class "pt-center-text" ] [ [ div [ _class "pt-center-text" ] [
br [] br []
a [ _href $"/web/prayer-request/{emptyGuid}/edit"; _title s.["Add a New Request"].Value ] a [ _href $"/web/prayer-request/{emptyGuid}/edit"; _title s["Add a New Request"].Value ]
[ icon "add_circle"; rawText " &nbsp;"; locStr s.["Add a New Request"] ] [ icon "add_circle"; rawText " &nbsp;"; locStr s["Add a New Request"] ]
rawText " &nbsp; &nbsp; &nbsp; " rawText " &nbsp; &nbsp; &nbsp; "
a [ _href "/web/prayer-requests/view"; _title s.["View Prayer Request List"].Value ] a [ _href "/web/prayer-requests/view"; _title s["View Prayer Request List"].Value ]
[ icon "list"; rawText " &nbsp;"; locStr s.["View Prayer Request List"] ] [ icon "list"; rawText " &nbsp;"; locStr s["View Prayer Request List"] ]
match m.searchTerm with match m.searchTerm with
| Some _ -> | Some _ ->
rawText " &nbsp; &nbsp; &nbsp; " rawText " &nbsp; &nbsp; &nbsp; "
a [ _href "/web/prayer-requests"; _title l.["Clear Search Criteria"].Value ] a [ _href "/web/prayer-requests"; _title l["Clear Search Criteria"].Value ]
[ icon "highlight_off"; rawText " &nbsp;"; raw l.["Clear Search Criteria"] ] [ icon "highlight_off"; rawText " &nbsp;"; raw l["Clear Search Criteria"] ]
| None -> () | None -> ()
] ]
form [ _action "/web/prayer-requests"; _method "get"; _class "pt-center-text pt-search-form" ] [ form [ _action "/web/prayer-requests"; _method "get"; _class "pt-center-text pt-search-form" ] [
input [ _type "text" input [ _type "text"
_name "search" _name "search"
_placeholder l.["Search requests..."].Value _placeholder l["Search requests..."].Value
_value (defaultArg m.searchTerm "") _value (defaultArg m.searchTerm "")
] ]
space space
submit [] "search" s.["Search"] submit [] "search" s["Search"]
] ]
br [] br []
tableSummary requests.Length s tableSummary requests.Length s
@ -250,11 +242,11 @@ let maintain m (ctx : HttpContext) vi =
table [ _class "pt-table pt-action-table" ] [ table [ _class "pt-table pt-action-table" ] [
thead [] [ thead [] [
tr [] [ tr [] [
th [] [ locStr s.["Actions"] ] th [] [ locStr s["Actions"] ]
th [] [ locStr s.["Updated Date"] ] th [] [ locStr s["Updated Date"] ]
th [] [ locStr s.["Type"] ] th [] [ locStr s["Type"] ]
th [] [ locStr s.["Requestor"] ] th [] [ locStr s["Requestor"] ]
th [] [ locStr s.["Request"] ] th [] [ locStr s["Request"] ]
] ]
] ]
tbody [] requests tbody [] requests
@ -263,15 +255,15 @@ let maintain m (ctx : HttpContext) vi =
br [] br []
match m.onlyActive with match m.onlyActive with
| Some true -> | Some true ->
raw l.["Inactive requests are currently not shown"] raw l["Inactive requests are currently not shown"]
br [] br []
a [ _href "/web/prayer-requests/inactive" ] [ raw l.["Show Inactive Requests"] ] a [ _href "/web/prayer-requests/inactive" ] [ raw l["Show Inactive Requests"] ]
| _ -> | _ ->
match Option.isSome m.onlyActive with match Option.isSome m.onlyActive with
| true -> | true ->
raw l.["Inactive requests are currently shown"] raw l["Inactive requests are currently shown"]
br [] br []
a [ _href "/web/prayer-requests" ] [ raw l.["Do Not Show Inactive Requests"] ] a [ _href "/web/prayer-requests" ] [ raw l["Do Not Show Inactive Requests"] ]
br [] br []
br [] br []
| false -> () | false -> ()
@ -285,12 +277,12 @@ let maintain m (ctx : HttpContext) vi =
// button (_type "submit" :: attrs) [ icon ico; rawText " &nbsp;"; locStr text ] // button (_type "submit" :: attrs) [ icon ico; rawText " &nbsp;"; locStr text ]
let withPage = match pg with 2 -> srch | _ -> ("page", string (pg - 1)) :: srch let withPage = match pg with 2 -> srch | _ -> ("page", string (pg - 1)) :: srch
a [ _href (makeUrl url withPage) ] a [ _href (makeUrl url withPage) ]
[ icon "keyboard_arrow_left"; space; raw l.["Previous Page"] ] [ icon "keyboard_arrow_left"; space; raw l["Previous Page"] ]
rawText " &nbsp; &nbsp; " rawText " &nbsp; &nbsp; "
match requests.Length = m.smallGroup.preferences.pageSize with match requests.Length = m.smallGroup.preferences.pageSize with
| true -> | true ->
a [ _href (makeUrl url (("page", string (pg + 1)) :: srch)) ] a [ _href (makeUrl url (("page", string (pg + 1)) :: srch)) ]
[ raw l.["Next Page"]; space; icon "keyboard_arrow_right" ] [ raw l["Next Page"]; space; icon "keyboard_arrow_right" ]
| false -> () | false -> ()
] ]
form [ _id "DeleteForm"; _action ""; _method "post" ] [ csrfToken ctx ] form [ _id "DeleteForm"; _action ""; _method "post" ] [ csrfToken ctx ]
@ -302,14 +294,14 @@ let maintain m (ctx : HttpContext) vi =
/// View for the printable prayer request list /// View for the printable prayer request list
let print m version = let print m version =
let s = I18N.localizer.Force () let s = I18N.localizer.Force ()
let pageTitle = $"""{s.["Prayer Requests"].Value} • {m.listGroup.name}""" let pageTitle = $"""{s["Prayer Requests"].Value} • {m.listGroup.name}"""
let imgAlt = $"""{s.["PrayerTracker"].Value} {s.["from Bit Badger Solutions"].Value}""" let imgAlt = $"""{s["PrayerTracker"].Value} {s["from Bit Badger Solutions"].Value}"""
article [] [ article [] [
rawText (m.asHtml s) rawText (m.asHtml s)
br [] br []
hr [] hr []
div [ _style $"font-size:70%%;font-family:{m.listGroup.preferences.listFonts};" ] [ div [ _style $"font-size:70%%;font-family:{m.listGroup.preferences.listFonts};" ] [
img [ _src $"""/img/{s.["footer_en"].Value}.png""" img [ _src $"""/img/{s["footer_en"].Value}.png"""
_style "vertical-align:text-bottom;" _style "vertical-align:text-bottom;"
_alt imgAlt _alt imgAlt
_title imgAlt ] _title imgAlt ]
@ -323,45 +315,38 @@ let print m version =
/// View for the prayer request list /// View for the prayer request list
let view m vi = let view m vi =
let s = I18N.localizer.Force () let s = I18N.localizer.Force ()
let pageTitle = $"""{s.["Prayer Requests"].Value} • {m.listGroup.name}""" let pageTitle = $"""{s["Prayer Requests"].Value} • {m.listGroup.name}"""
let spacer = rawText " &nbsp; &nbsp; &nbsp; " let spacer = rawText " &nbsp; &nbsp; &nbsp; "
let dtString = m.date.ToString "yyyy-MM-dd" let dtString = m.date.ToString "yyyy-MM-dd"
[ div [ _class "pt-center-text" ] [ [ div [ _class "pt-center-text" ] [
br [] br []
a [ _class "pt-icon-link" a [ _class "pt-icon-link"
_href $"/web/prayer-requests/print/{dtString}" _href $"/web/prayer-requests/print/{dtString}"
_title s.["View Printable"].Value ] [ _title s["View Printable"].Value
icon "print"; rawText " &nbsp;"; locStr s.["View Printable"] ] [ icon "print"; rawText " &nbsp;"; locStr s["View Printable"] ]
] if m.canEmail then
match m.canEmail with
| true ->
spacer spacer
match m.date.DayOfWeek = DayOfWeek.Sunday with if m.date.DayOfWeek <> DayOfWeek.Sunday then
| true -> ()
| false ->
let rec findSunday (date : DateTime) = let rec findSunday (date : DateTime) =
match date.DayOfWeek = DayOfWeek.Sunday with if date.DayOfWeek = DayOfWeek.Sunday then date else findSunday (date.AddDays 1.)
| true -> date
| false -> findSunday (date.AddDays 1.)
let sunday = findSunday m.date let sunday = findSunday m.date
a [ _class "pt-icon-link" a [ _class "pt-icon-link"
_href $"""/web/prayer-requests/view/{sunday.ToString "yyyy-MM-dd"}""" _href $"""/web/prayer-requests/view/{sunday.ToString "yyyy-MM-dd"}"""
_title s.["List for Next Sunday"].Value ] [ _title s["List for Next Sunday"].Value ] [
icon "update"; rawText " &nbsp;"; locStr s.["List for Next Sunday"] icon "update"; rawText " &nbsp;"; locStr s["List for Next Sunday"]
] ]
spacer spacer
let emailPrompt = s.["This will e-mail the current list to every member of your group, without further prompting. Are you sure this is what you are ready to do?"].Value let emailPrompt = s["This will e-mail the current list to every member of your group, without further prompting. Are you sure this is what you are ready to do?"].Value
a [ _class "pt-icon-link" a [ _class "pt-icon-link"
_href $"/web/prayer-requests/email/{dtString}" _href $"/web/prayer-requests/email/{dtString}"
_title s.["Send via E-mail"].Value _title s["Send via E-mail"].Value
_onclick $"return PT.requests.view.promptBeforeEmail('{emailPrompt}')" ] [ _onclick $"return PT.requests.view.promptBeforeEmail('{emailPrompt}')" ] [
icon "mail_outline"; rawText " &nbsp;"; locStr s.["Send via E-mail"] icon "mail_outline"; rawText " &nbsp;"; locStr s["Send via E-mail"]
] ]
spacer spacer
a [ _class "pt-icon-link"; _href "/web/prayer-requests"; _title s.["Maintain Prayer Requests"].Value ] [ a [ _class "pt-icon-link"; _href "/web/prayer-requests"; _title s["Maintain Prayer Requests"].Value ] [
icon "compare_arrows"; rawText " &nbsp;"; locStr s.["Maintain Prayer Requests"] icon "compare_arrows"; rawText " &nbsp;"; locStr s["Maintain Prayer Requests"]
] ]
| false -> ()
] ]
br [] br []
rawText (m.asHtml s) rawText (m.asHtml s)

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

@ -1,11 +1,11 @@
module PrayerTracker.Views.SmallGroup module PrayerTracker.Views.SmallGroup
open System.IO
open Giraffe.ViewEngine open Giraffe.ViewEngine
open Microsoft.Extensions.Localization open Microsoft.Extensions.Localization
open PrayerTracker open PrayerTracker
open PrayerTracker.Entities open PrayerTracker.Entities
open PrayerTracker.ViewModels open PrayerTracker.ViewModels
open System.IO
/// View for the announcement page /// View for the announcement page
let announcement isAdmin ctx vi = let announcement isAdmin ctx vi =
@ -15,40 +15,39 @@ let announcement isAdmin ctx vi =
csrfToken ctx csrfToken ctx
div [ _class "pt-field-row" ] [ div [ _class "pt-field-row" ] [
div [ _class "pt-field pt-editor" ] [ div [ _class "pt-field pt-editor" ] [
label [ _for "text" ] [ locStr s.["Announcement Text"] ] label [ _for "text" ] [ locStr s["Announcement Text"] ]
textarea [ _name "text"; _id "text"; _autofocus ] [] textarea [ _name "text"; _id "text"; _autofocus ] []
] ]
] ]
match isAdmin with if isAdmin then
| true ->
div [ _class "pt-field-row" ] [ div [ _class "pt-field-row" ] [
div [ _class "pt-field" ] [ div [ _class "pt-field" ] [
label [] [ locStr s.["Send Announcement to"]; rawText ":" ] label [] [ locStr s["Send Announcement to"]; rawText ":" ]
div [ _class "pt-center-text" ] [ div [ _class "pt-center-text" ] [
radio "sendToClass" "sendY" "Y" "Y" radio "sendToClass" "sendY" "Y" "Y"
label [ _for "sendY" ] [ locStr s.["This Group"]; rawText " &nbsp; &nbsp; " ] label [ _for "sendY" ] [ locStr s["This Group"]; rawText " &nbsp; &nbsp; " ]
radio "sendToClass" "sendN" "N" "Y" radio "sendToClass" "sendN" "N" "Y"
label [ _for "sendN" ] [ locStr s.["All {0} Users", s.["PrayerTracker"]] ] label [ _for "sendN" ] [ locStr s["All {0} Users", s["PrayerTracker"]] ]
] ]
] ]
] ]
| false -> input [ _type "hidden"; _name "sendToClass"; _value "Y" ] else input [ _type "hidden"; _name "sendToClass"; _value "Y" ]
div [ _class "pt-field-row pt-fadeable pt-shown"; _id "divAddToList" ] [ div [ _class "pt-field-row pt-fadeable pt-shown"; _id "divAddToList" ] [
div [ _class "pt-checkbox-field" ] [ div [ _class "pt-checkbox-field" ] [
input [ _type "checkbox"; _name "addToRequestList"; _id "addToRequestList"; _value "True" ] input [ _type "checkbox"; _name "addToRequestList"; _id "addToRequestList"; _value "True" ]
label [ _for "addToRequestList" ] [ locStr s.["Add to Request List"] ] label [ _for "addToRequestList" ] [ locStr s["Add to Request List"] ]
] ]
] ]
div [ _class "pt-field-row pt-fadeable"; _id "divCategory" ] [ div [ _class "pt-field-row pt-fadeable"; _id "divCategory" ] [
div [ _class "pt-field" ] [ div [ _class "pt-field" ] [
label [ _for "requestType" ] [ locStr s.["Request Type"] ] label [ _for "requestType" ] [ locStr s["Request Type"] ]
reqTypes reqTypes
|> Seq.ofList |> Seq.ofList
|> Seq.map (fun (typ, desc) -> typ.code, desc.Value) |> Seq.map (fun (typ, desc) -> typ.code, desc.Value)
|> selectList "requestType" "Announcement" [] |> selectList "requestType" "Announcement" []
] ]
] ]
div [ _class "pt-field-row" ] [ submit [] "send" s.["Send Announcement"] ] div [ _class "pt-field-row" ] [ submit [] "send" s["Send Announcement"] ]
] ]
script [] [ rawText "PT.onLoad(PT.smallGroup.announcement.onPageLoad)" ] script [] [ rawText "PT.onLoad(PT.smallGroup.announcement.onPageLoad)" ]
] ]
@ -59,11 +58,11 @@ let announcement isAdmin ctx vi =
/// View for once an announcement has been sent /// View for once an announcement has been sent
let announcementSent (m : Announcement) vi = let announcementSent (m : Announcement) vi =
let s = I18N.localizer.Force () let s = I18N.localizer.Force ()
[ span [ _class "pt-email-heading" ] [ locStr s.["HTML Format"]; rawText ":" ] [ span [ _class "pt-email-heading" ] [ locStr s["HTML Format"]; rawText ":" ]
div [ _class "pt-email-canvas" ] [ rawText m.text ] div [ _class "pt-email-canvas" ] [ rawText m.text ]
br [] br []
br [] br []
span [ _class "pt-email-heading" ] [ locStr s.["Plain-Text Format"]; rawText ":" ] span [ _class "pt-email-heading" ] [ locStr s["Plain-Text Format"]; rawText ":" ]
div [ _class "pt-email-canvas" ] [ pre [] [ str (m.plainText ()) ] ] div [ _class "pt-email-canvas" ] [ pre [] [ str (m.plainText ()) ] ]
] ]
|> Layout.Content.standard |> Layout.Content.standard
@ -79,21 +78,21 @@ let edit (m : EditSmallGroup) (churches : Church list) ctx vi =
input [ _type "hidden"; _name "smallGroupId"; _value (flatGuid m.smallGroupId) ] input [ _type "hidden"; _name "smallGroupId"; _value (flatGuid m.smallGroupId) ]
div [ _class "pt-field-row" ] [ div [ _class "pt-field-row" ] [
div [ _class "pt-field" ] [ div [ _class "pt-field" ] [
label [ _for "name" ] [ locStr s.["Group Name"] ] label [ _for "name" ] [ locStr s["Group Name"] ]
input [ _type "text"; _name "name"; _id "name"; _value m.name; _required; _autofocus ] input [ _type "text"; _name "name"; _id "name"; _value m.name; _required; _autofocus ]
] ]
] ]
div [ _class "pt-field-row" ] [ div [ _class "pt-field-row" ] [
div [ _class "pt-field" ] [ div [ _class "pt-field" ] [
label [ _for "churchId" ] [ locStr s.["Church"] ] label [ _for "churchId" ] [ locStr s["Church"] ]
seq { seq {
"", selectDefault s.["Select Church"].Value "", selectDefault s["Select Church"].Value
yield! churches |> List.map (fun c -> flatGuid c.churchId, c.name) yield! churches |> List.map (fun c -> flatGuid c.churchId, c.name)
} }
|> selectList "churchId" (flatGuid m.churchId) [ _required ] |> selectList "churchId" (flatGuid m.churchId) [ _required ]
] ]
] ]
div [ _class "pt-field-row" ] [ submit [] "save" s.["Save Group"] ] div [ _class "pt-field-row" ] [ submit [] "save" s["Save Group"] ]
] ]
|> List.singleton |> List.singleton
|> Layout.Content.standard |> Layout.Content.standard
@ -110,23 +109,23 @@ let editMember (m : EditMember) (typs : (string * LocalizedString) seq) ctx vi =
input [ _type "hidden"; _name "memberId"; _value (flatGuid m.memberId) ] input [ _type "hidden"; _name "memberId"; _value (flatGuid m.memberId) ]
div [ _class "pt-field-row" ] [ div [ _class "pt-field-row" ] [
div [ _class "pt-field" ] [ div [ _class "pt-field" ] [
label [ _for "memberName" ] [ locStr s.["Member Name"] ] label [ _for "memberName" ] [ locStr s["Member Name"] ]
input [ _type "text"; _name "memberName"; _id "memberName"; _required; _autofocus; _value m.memberName ] input [ _type "text"; _name "memberName"; _id "memberName"; _required; _autofocus; _value m.memberName ]
] ]
div [ _class "pt-field" ] [ div [ _class "pt-field" ] [
label [ _for "emailAddress" ] [ locStr s.["E-mail Address"] ] label [ _for "emailAddress" ] [ locStr s["E-mail Address"] ]
input [ _type "email"; _name "emailAddress"; _id "emailAddress"; _required; _value m.emailAddress ] input [ _type "email"; _name "emailAddress"; _id "emailAddress"; _required; _value m.emailAddress ]
] ]
] ]
div [ _class "pt-field-row" ] [ div [ _class "pt-field-row" ] [
div [ _class "pt-field" ] [ div [ _class "pt-field" ] [
label [ _for "emailType" ] [ locStr s.["E-mail Format"] ] label [ _for "emailType" ] [ locStr s["E-mail Format"] ]
typs typs
|> Seq.map (fun typ -> fst typ, (snd typ).Value) |> Seq.map (fun typ -> fst typ, (snd typ).Value)
|> selectList "emailType" m.emailType [] |> selectList "emailType" m.emailType []
] ]
] ]
div [ _class "pt-field-row" ] [ submit [] "save" s.["Save"] ] div [ _class "pt-field-row" ] [ submit [] "save" s["Save"] ]
] ]
|> List.singleton |> List.singleton
|> Layout.Content.standard |> Layout.Content.standard
@ -140,30 +139,31 @@ let logOn (grps : SmallGroup list) grpId ctx vi =
csrfToken ctx csrfToken ctx
div [ _class "pt-field-row" ] [ div [ _class "pt-field-row" ] [
div [ _class "pt-field" ] [ div [ _class "pt-field" ] [
label [ _for "smallGroupId" ] [ locStr s.["Group"] ] label [ _for "smallGroupId" ] [ locStr s["Group"] ]
seq { seq {
match grps.Length with match grps.Length with
| 0 -> "", s.["There are no classes with passwords defined"].Value | 0 -> "", s["There are no classes with passwords defined"].Value
| _ -> | _ ->
"", selectDefault s.["Select Group"].Value "", selectDefault s["Select Group"].Value
yield! grps yield!
grps
|> List.map (fun grp -> flatGuid grp.smallGroupId, $"{grp.church.name} | {grp.name}") |> List.map (fun grp -> flatGuid grp.smallGroupId, $"{grp.church.name} | {grp.name}")
} }
|> selectList "smallGroupId" grpId [ _required ] |> selectList "smallGroupId" grpId [ _required ]
] ]
div [ _class "pt-field" ] [ div [ _class "pt-field" ] [
label [ _for "password" ] [ locStr s.["Password"] ] label [ _for "password" ] [ locStr s["Password"] ]
input [ _type "password"; _name "password"; _id "password"; _required; input [ _type "password"; _name "password"; _id "password"; _required;
_placeholder (s.["Case-Sensitive"].Value.ToLower ()) ] _placeholder (s["Case-Sensitive"].Value.ToLower ()) ]
] ]
] ]
div [ _class "pt-checkbox-field" ] [ div [ _class "pt-checkbox-field" ] [
input [ _type "checkbox"; _name "rememberMe"; _id "rememberMe"; _value "True" ] input [ _type "checkbox"; _name "rememberMe"; _id "rememberMe"; _value "True" ]
label [ _for "rememberMe" ] [ locStr s.["Remember Me"] ] label [ _for "rememberMe" ] [ locStr s["Remember Me"] ]
br [] br []
small [] [ em [] [ str (s.["Requires Cookies"].Value.ToLower ()) ] ] small [] [ em [] [ str (s["Requires Cookies"].Value.ToLower ()) ] ]
] ]
div [ _class "pt-field-row" ] [ submit [] "account_circle" s.["Log On"] ] div [ _class "pt-field-row" ] [ submit [] "account_circle" s["Log On"] ]
] ]
script [] [ rawText "PT.onLoad(PT.smallGroup.logOn.onPageLoad)" ] script [] [ rawText "PT.onLoad(PT.smallGroup.logOn.onPageLoad)" ]
] ]
@ -181,23 +181,24 @@ let maintain (grps : SmallGroup list) ctx vi =
table [ _class "pt-table pt-action-table" ] [ table [ _class "pt-table pt-action-table" ] [
thead [] [ thead [] [
tr [] [ tr [] [
th [] [ locStr s.["Actions"] ] th [] [ locStr s["Actions"] ]
th [] [ locStr s.["Name"] ] th [] [ locStr s["Name"] ]
th [] [ locStr s.["Church"] ] th [] [ locStr s["Church"] ]
th [] [ locStr s.["Time Zone"] ] th [] [ locStr s["Time Zone"] ]
] ]
] ]
grps grps
|> List.map (fun g -> |> List.map (fun g ->
let grpId = flatGuid g.smallGroupId let grpId = flatGuid g.smallGroupId
let delAction = $"/web/small-group/{grpId}/delete" let delAction = $"/web/small-group/{grpId}/delete"
let delPrompt = s.["Are you sure you want to delete this {0}? This action cannot be undone.", 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 [] [ tr [] [
td [] [ td [] [
a [ _href $"/web/small-group/{grpId}/edit"; _title s.["Edit This Group"].Value ] [ icon "edit" ] a [ _href $"/web/small-group/{grpId}/edit"; _title s["Edit This Group"].Value ]
[ icon "edit" ]
a [ _href delAction a [ _href delAction
_title s.["Delete This Group"].Value _title s["Delete This Group"].Value
_onclick $"return PT.confirmDelete('{delAction}','{delPrompt}')" ] _onclick $"return PT.confirmDelete('{delAction}','{delPrompt}')" ]
[ icon "delete_forever" ] [ icon "delete_forever" ]
] ]
@ -209,10 +210,10 @@ let maintain (grps : SmallGroup list) ctx vi =
] ]
[ div [ _class "pt-center-text" ] [ [ div [ _class "pt-center-text" ] [
br [] br []
a [ _href $"/web/small-group/{emptyGuid}/edit"; _title s.["Add a New Group"].Value ] [ a [ _href $"/web/small-group/{emptyGuid}/edit"; _title s["Add a New Group"].Value ] [
icon "add_circle" icon "add_circle"
rawText " &nbsp;" rawText " &nbsp;"
locStr s.["Add a New Group"] locStr s["Add a New Group"]
] ]
br [] br []
br [] br []
@ -235,10 +236,10 @@ let members (mbrs : Member list) (emailTyps : Map<string, LocalizedString>) ctx
table [ _class "pt-table pt-action-table" ] [ table [ _class "pt-table pt-action-table" ] [
thead [] [ thead [] [
tr [] [ tr [] [
th [] [ locStr s.["Actions"] ] th [] [ locStr s["Actions"] ]
th [] [ locStr s.["Name"] ] th [] [ locStr s["Name"] ]
th [] [ locStr s.["E-mail Address"] ] th [] [ locStr s["E-mail Address"] ]
th [] [ locStr s.["Format"] ] th [] [ locStr s["Format"] ]
] ]
] ]
mbrs mbrs
@ -246,28 +247,27 @@ let members (mbrs : Member list) (emailTyps : Map<string, LocalizedString>) ctx
let mbrId = flatGuid mbr.memberId let mbrId = flatGuid mbr.memberId
let delAction = $"/web/small-group/member/{mbrId}/delete" let delAction = $"/web/small-group/member/{mbrId}/delete"
let delPrompt = let delPrompt =
s.["Are you sure you want to delete this {0}? This action cannot be undone.", s.["group member"]] s["Are you sure you want to delete this {0}? This action cannot be undone.", s["group member"]]
.Value .Value.Replace("?", $" ({mbr.memberName})?")
.Replace("?", $" ({mbr.memberName})?")
tr [] [ tr [] [
td [] [ td [] [
a [ _href $"/web/small-group/member/{mbrId}/edit"; _title s.["Edit This Group Member"].Value ] a [ _href $"/web/small-group/member/{mbrId}/edit"; _title s["Edit This Group Member"].Value ]
[ icon "edit" ] [ icon "edit" ]
a [ _href delAction a [ _href delAction
_title s.["Delete This Group Member"].Value _title s["Delete This Group Member"].Value
_onclick $"return PT.confirmDelete('{delAction}','{delPrompt}')" ] _onclick $"return PT.confirmDelete('{delAction}','{delPrompt}')" ]
[ icon "delete_forever" ] [ icon "delete_forever" ]
] ]
td [] [ str mbr.memberName ] td [] [ str mbr.memberName ]
td [] [ str mbr.email ] td [] [ str mbr.email ]
td [] [ locStr emailTyps.[defaultArg mbr.format ""] ] td [] [ locStr emailTyps[defaultArg mbr.format ""] ]
]) ])
|> tbody [] |> tbody []
] ]
[ div [ _class"pt-center-text" ] [ [ div [ _class"pt-center-text" ] [
br [] br []
a [ _href $"/web/small-group/member/{emptyGuid}/edit"; _title s.["Add a New Group Member"].Value ] a [ _href $"/web/small-group/member/{emptyGuid}/edit"; _title s["Add a New Group Member"].Value ]
[ icon "add_circle"; rawText " &nbsp;"; locStr s.["Add a New Group Member"] ] [ icon "add_circle"; rawText " &nbsp;"; locStr s["Add a New Group Member"] ]
br [] br []
br [] br []
] ]
@ -288,52 +288,53 @@ let overview m vi =
section [] [ section [] [
header [ _role "heading" ] [ header [ _role "heading" ] [
iconSized 72 "bookmark_border" iconSized 72 "bookmark_border"
locStr s.["Quick Actions"] locStr s["Quick Actions"]
] ]
div [] [ div [] [
a [ _href "/web/prayer-requests/view" ] [ icon "list"; linkSpacer; locStr s.["View Prayer Request List"] ] a [ _href "/web/prayer-requests/view" ]
[ icon "list"; linkSpacer; locStr s["View Prayer Request List"] ]
hr [] hr []
a [ _href "/web/small-group/announcement" ] [ icon "send"; linkSpacer; locStr s.["Send Announcement"] ] a [ _href "/web/small-group/announcement" ] [ icon "send"; linkSpacer; locStr s["Send Announcement"] ]
hr [] hr []
a [ _href "/web/small-group/preferences" ] [ icon "build"; linkSpacer; locStr s.["Change Preferences"] ] a [ _href "/web/small-group/preferences" ] [ icon "build"; linkSpacer; locStr s["Change Preferences"] ]
] ]
] ]
section [] [ section [] [
header [ _role "heading" ] [ header [ _role "heading" ] [
iconSized 72 "question_answer" iconSized 72 "question_answer"
locStr s.["Prayer Requests"] locStr s["Prayer Requests"]
] ]
div [] [ div [] [
p [ _class "pt-center-text" ] [ p [ _class "pt-center-text" ] [
strong [] [ str (m.totalActiveReqs.ToString "N0"); space; locStr s.["Active Requests"] ] strong [] [ str (m.totalActiveReqs.ToString "N0"); space; locStr s["Active Requests"] ]
] ]
hr [] hr []
for cat in m.activeReqsByCat do for cat in m.activeReqsByCat do
str (cat.Value.ToString "N0") str (cat.Value.ToString "N0")
space space
locStr typs.[cat.Key] locStr typs[cat.Key]
br [] br []
br [] br []
str (m.allReqs.ToString "N0") str (m.allReqs.ToString "N0")
space space
locStr s.["Total Requests"] locStr s["Total Requests"]
hr [] hr []
a [ _href "/web/prayer-requests/maintain" ] [ a [ _href "/web/prayer-requests/maintain" ] [
icon "compare_arrows" icon "compare_arrows"
linkSpacer linkSpacer
locStr s.["Maintain Prayer Requests"] locStr s["Maintain Prayer Requests"]
] ]
] ]
] ]
section [] [ section [] [
header [ _role "heading" ] [ header [ _role "heading" ] [
iconSized 72 "people_outline" iconSized 72 "people_outline"
locStr s.["Group Members"] locStr s["Group Members"]
] ]
div [ _class "pt-center-text" ] [ div [ _class "pt-center-text" ] [
strong [] [ str (m.totalMbrs.ToString "N0"); space; locStr s.["Members"] ] strong [] [ str (m.totalMbrs.ToString "N0"); space; locStr s["Members"] ]
hr [] hr []
a [ _href "/web/small-group/members" ] [ icon "email"; linkSpacer; locStr s.["Maintain Group Members"] ] a [ _href "/web/small-group/members" ] [ icon "email"; linkSpacer; locStr s["Maintain Group Members"] ]
] ]
] ]
] ]
@ -352,61 +353,62 @@ let preferences (m : EditPreferences) (tzs : TimeZone list) ctx vi =
style [ _scoped ] [ rawText "#expireDays, #daysToKeepNew, #longTermUpdateWeeks, #headingFontSize, #listFontSize, #pageSize { width: 3rem; } #emailFromAddress { width: 20rem; } #listFonts { width: 40rem; } @media screen and (max-width: 40rem) { #listFonts { width: 100%; } }" ] style [ _scoped ] [ rawText "#expireDays, #daysToKeepNew, #longTermUpdateWeeks, #headingFontSize, #listFontSize, #pageSize { width: 3rem; } #emailFromAddress { width: 20rem; } #listFonts { width: 40rem; } @media screen and (max-width: 40rem) { #listFonts { width: 100%; } }" ]
csrfToken ctx csrfToken ctx
fieldset [] [ fieldset [] [
legend [] [ strong [] [ icon "date_range"; rawText " &nbsp;"; locStr s.["Dates"] ] ] legend [] [ strong [] [ icon "date_range"; rawText " &nbsp;"; locStr s["Dates"] ] ]
div [ _class "pt-field-row" ] [ div [ _class "pt-field-row" ] [
div [ _class "pt-field" ] [ div [ _class "pt-field" ] [
label [ _for "expireDays" ] [ locStr s.["Requests Expire After"] ] label [ _for "expireDays" ] [ locStr s["Requests Expire After"] ]
span [] [ span [] [
input [ _type "number"; _name "expireDays"; _id "expireDays"; _min "1"; _max "30"; _required; _autofocus input [ _type "number"; _name "expireDays"; _id "expireDays"; _min "1"; _max "30"; _required
_value (string m.expireDays) ] _autofocus; _value (string m.expireDays) ]
space; str (s.["Days"].Value.ToLower ()) space; str (s["Days"].Value.ToLower ())
] ]
] ]
div [ _class "pt-field" ] [ div [ _class "pt-field" ] [
label [ _for "daysToKeepNew" ] [ locStr s.["Requests “New” For"] ] label [ _for "daysToKeepNew" ] [ locStr s["Requests “New” For"] ]
span [] [ span [] [
input [ _type "number"; _name "daysToKeepNew"; _id "daysToKeepNew"; _min "1"; _max "30"; _required input [ _type "number"; _name "daysToKeepNew"; _id "daysToKeepNew"; _min "1"; _max "30"
_value (string m.daysToKeepNew) ] _required; _value (string m.daysToKeepNew) ]
space; str (s.["Days"].Value.ToLower ()) space; str (s["Days"].Value.ToLower ())
] ]
] ]
div [ _class "pt-field" ] [ div [ _class "pt-field" ] [
label [ _for "longTermUpdateWeeks" ] [ locStr s.["Long-Term Requests Alerted for Update"] ] label [ _for "longTermUpdateWeeks" ] [ locStr s["Long-Term Requests Alerted for Update"] ]
span [] [ span [] [
input [ _type "number"; _name "longTermUpdateWeeks"; _id "longTermUpdateWeeks"; _min "1"; _max "30" input [ _type "number"; _name "longTermUpdateWeeks"; _id "longTermUpdateWeeks"; _min "1"
_required; _value (string m.longTermUpdateWeeks) ] _max "30"; _required; _value (string m.longTermUpdateWeeks) ]
space; str (s.["Weeks"].Value.ToLower ()) space; str (s["Weeks"].Value.ToLower ())
] ]
] ]
] ]
] ]
fieldset [] [ fieldset [] [
legend [] [ strong [] [ icon "sort"; rawText " &nbsp;"; locStr s.["Request Sorting"] ] ] legend [] [ strong [] [ icon "sort"; rawText " &nbsp;"; locStr s["Request Sorting"] ] ]
radio "requestSort" "requestSort_D" "D" m.requestSort radio "requestSort" "requestSort_D" "D" m.requestSort
label [ _for "requestSort_D" ] [ locStr s.["Sort by Last Updated Date"] ] label [ _for "requestSort_D" ] [ locStr s["Sort by Last Updated Date"] ]
rawText " &nbsp; " rawText " &nbsp; "
radio "requestSort" "requestSort_R" "R" m.requestSort radio "requestSort" "requestSort_R" "R" m.requestSort
label [ _for "requestSort_R" ] [ locStr s.["Sort by Requestor Name"] ] label [ _for "requestSort_R" ] [ locStr s["Sort by Requestor Name"] ]
] ]
fieldset [] [ fieldset [] [
legend [] [ strong [] [ icon "mail_outline"; rawText " &nbsp;"; locStr s.["E-mail"] ] ] legend [] [ strong [] [ icon "mail_outline"; rawText " &nbsp;"; locStr s["E-mail"] ] ]
div [ _class "pt-field-row" ] [ div [ _class "pt-field-row" ] [
div [ _class "pt-field" ] [ div [ _class "pt-field" ] [
label [ _for "emailFromName" ] [ locStr s.["From Name"] ] label [ _for "emailFromName" ] [ locStr s["From Name"] ]
input [ _type "text"; _name "emailFromName"; _id "emailFromName"; _required; _value m.emailFromName ] input [ _type "text"; _name "emailFromName"; _id "emailFromName"; _required; _value m.emailFromName ]
] ]
div [ _class "pt-field" ] [ div [ _class "pt-field" ] [
label [ _for "emailFromAddress" ] [ locStr s.["From Address"] ] label [ _for "emailFromAddress" ] [ locStr s["From Address"] ]
input [ _type "email"; _name "emailFromAddress"; _id "emailFromAddress"; _required input [ _type "email"; _name "emailFromAddress"; _id "emailFromAddress"; _required
_value m.emailFromAddress ] _value m.emailFromAddress ]
] ]
] ]
div [ _class "pt-field-row" ] [ div [ _class "pt-field-row" ] [
div [ _class "pt-field" ] [ div [ _class "pt-field" ] [
label [ _for "defaultEmailType" ] [ locStr s.["E-mail Format"] ] label [ _for "defaultEmailType" ] [ locStr s["E-mail Format"] ]
seq { seq {
"", selectDefault s.["Select"].Value "", selectDefault s["Select"].Value
yield! ReferenceList.emailTypeList HtmlFormat s yield!
ReferenceList.emailTypeList HtmlFormat s
|> Seq.skip 1 |> Seq.skip 1
|> Seq.map (fun typ -> fst typ, (snd typ).Value) |> Seq.map (fun typ -> fst typ, (snd typ).Value)
} }
@ -415,19 +417,19 @@ let preferences (m : EditPreferences) (tzs : TimeZone list) ctx vi =
] ]
] ]
fieldset [] [ fieldset [] [
legend [] [ strong [] [ icon "color_lens"; rawText " &nbsp;"; locStr s.["Colors"] ]; rawText " ***" ] legend [] [ strong [] [ icon "color_lens"; rawText " &nbsp;"; locStr s["Colors"] ]; rawText " ***" ]
div [ _class "pt-field-row" ] [ div [ _class "pt-field-row" ] [
div [ _class "pt-field" ] [ div [ _class "pt-field" ] [
label [ _class "pt-center-text" ] [ locStr s.["Color of Heading Lines"] ] label [ _class "pt-center-text" ] [ locStr s["Color of Heading Lines"] ]
span [] [ span [] [
radio "headingLineType" "headingLineType_Name" "Name" m.headingLineType radio "headingLineType" "headingLineType_Name" "Name" m.headingLineType
label [ _for "headingLineType_Name" ] [ locStr s.["Named Color"] ] label [ _for "headingLineType_Name" ] [ locStr s["Named Color"] ]
namedColorList "headingLineColor" m.headingLineColor namedColorList "headingLineColor" m.headingLineColor
[ _id "headingLineColor_Select" [ _id "headingLineColor_Select"
match m.headingLineColor.StartsWith "#" with true -> _disabled | false -> () ] s match m.headingLineColor.StartsWith "#" with true -> _disabled | false -> () ] s
rawText "&nbsp; &nbsp; "; str (s.["or"].Value.ToUpper ()) rawText "&nbsp; &nbsp; "; str (s["or"].Value.ToUpper ())
radio "headingLineType" "headingLineType_RGB" "RGB" m.headingLineType radio "headingLineType" "headingLineType_RGB" "RGB" m.headingLineType
label [ _for "headingLineType_RGB" ] [ locStr s.["Custom Color"] ] label [ _for "headingLineType_RGB" ] [ locStr s["Custom Color"] ]
input [ _type "color" input [ _type "color"
_name "headingLineColor" _name "headingLineColor"
_id "headingLineColor_Color" _id "headingLineColor_Color"
@ -438,16 +440,16 @@ let preferences (m : EditPreferences) (tzs : TimeZone list) ctx vi =
] ]
div [ _class "pt-field-row" ] [ div [ _class "pt-field-row" ] [
div [ _class "pt-field" ] [ div [ _class "pt-field" ] [
label [ _class "pt-center-text" ] [ locStr s.["Color of Heading Text"] ] label [ _class "pt-center-text" ] [ locStr s["Color of Heading Text"] ]
span [] [ span [] [
radio "headingTextType" "headingTextType_Name" "Name" m.headingTextType radio "headingTextType" "headingTextType_Name" "Name" m.headingTextType
label [ _for "headingTextType_Name" ] [ locStr s.["Named Color"] ] label [ _for "headingTextType_Name" ] [ locStr s["Named Color"] ]
namedColorList "headingTextColor" m.headingTextColor namedColorList "headingTextColor" m.headingTextColor
[ _id "headingTextColor_Select" [ _id "headingTextColor_Select"
match m.headingTextColor.StartsWith "#" with true -> _disabled | false -> () ] s match m.headingTextColor.StartsWith "#" with true -> _disabled | false -> () ] s
rawText "&nbsp; &nbsp; "; str (s.["or"].Value.ToUpper ()) rawText "&nbsp; &nbsp; "; str (s["or"].Value.ToUpper ())
radio "headingTextType" "headingTextType_RGB" "RGB" m.headingTextType radio "headingTextType" "headingTextType_RGB" "RGB" m.headingTextType
label [ _for "headingTextType_RGB" ] [ locStr s.["Custom Color"] ] label [ _for "headingTextType_RGB" ] [ locStr s["Custom Color"] ]
input [ _type "color" input [ _type "color"
_name "headingTextColor" _name "headingTextColor"
_id "headingTextColor_Color" _id "headingTextColor_Color"
@ -458,87 +460,86 @@ let preferences (m : EditPreferences) (tzs : TimeZone list) ctx vi =
] ]
] ]
fieldset [] [ fieldset [] [
legend [] [ strong [] [ icon "font_download"; rawText " &nbsp;"; locStr s.["Fonts"] ] ] legend [] [ strong [] [ icon "font_download"; rawText " &nbsp;"; locStr s["Fonts"] ] ]
div [ _class "pt-field" ] [ div [ _class "pt-field" ] [
label [ _for "listFonts" ] [ locStr s.["Fonts** for List"] ] label [ _for "listFonts" ] [ locStr s["Fonts** for List"] ]
input [ _type "text"; _name "listFonts"; _id "listFonts"; _required; _value m.listFonts ] input [ _type "text"; _name "listFonts"; _id "listFonts"; _required; _value m.listFonts ]
] ]
div [ _class "pt-field-row" ] [ div [ _class "pt-field-row" ] [
div [ _class "pt-field" ] [ div [ _class "pt-field" ] [
label [ _for "headingFontSize" ] [ locStr s.["Heading Text Size"] ] label [ _for "headingFontSize" ] [ locStr s["Heading Text Size"] ]
input [ _type "number"; _name "headingFontSize"; _id "headingFontSize"; _min "8"; _max "24"; _required input [ _type "number"; _name "headingFontSize"; _id "headingFontSize"; _min "8"; _max "24"
_value (string m.headingFontSize) ] _required; _value (string m.headingFontSize) ]
] ]
div [ _class "pt-field" ] [ div [ _class "pt-field" ] [
label [ _for "listFontSize" ] [ locStr s.["List Text Size"] ] label [ _for "listFontSize" ] [ locStr s["List Text Size"] ]
input [ _type "number"; _name "listFontSize"; _id "listFontSize"; _min "8"; _max "24"; _required input [ _type "number"; _name "listFontSize"; _id "listFontSize"; _min "8"; _max "24"; _required
_value (string m.listFontSize) ] _value (string m.listFontSize) ]
] ]
] ]
] ]
fieldset [] [ fieldset [] [
legend [] [ strong [] [ icon "settings"; rawText " &nbsp;"; locStr s.["Other Settings"] ] ] legend [] [ strong [] [ icon "settings"; rawText " &nbsp;"; locStr s["Other Settings"] ] ]
div [ _class "pt-field-row" ] [ div [ _class "pt-field-row" ] [
div [ _class "pt-field" ] [ div [ _class "pt-field" ] [
label [ _for "timeZone" ] [ locStr s.["Time Zone"] ] label [ _for "timeZone" ] [ locStr s["Time Zone"] ]
seq { seq {
"", selectDefault s.["Select"].Value "", selectDefault s["Select"].Value
yield! tzs |> List.map (fun tz -> tz.timeZoneId, (TimeZones.name tz.timeZoneId s).Value) yield! tzs |> List.map (fun tz -> tz.timeZoneId, (TimeZones.name tz.timeZoneId s).Value)
} }
|> selectList "timeZone" m.timeZone [ _required ] |> selectList "timeZone" m.timeZone [ _required ]
] ]
] ]
div [ _class "pt-field" ] [ div [ _class "pt-field" ] [
label [] [ locStr s.["Request List Visibility"] ] label [] [ locStr s["Request List Visibility"] ]
span [] [ span [] [
radio "listVisibility" "viz_Public" (string RequestVisibility.``public``) (string m.listVisibility) radio "listVisibility" "viz_Public" (string RequestVisibility.``public``) (string m.listVisibility)
label [ _for "viz_Public" ] [ locStr s.["Public"] ] label [ _for "viz_Public" ] [ locStr s["Public"] ]
rawText " &nbsp;" rawText " &nbsp;"
radio "listVisibility" "viz_Private" (string RequestVisibility.``private``) (string m.listVisibility) radio "listVisibility" "viz_Private" (string RequestVisibility.``private``)
label [ _for "viz_Private" ] [ locStr s.["Private"] ] (string m.listVisibility)
label [ _for "viz_Private" ] [ locStr s["Private"] ]
rawText " &nbsp;" rawText " &nbsp;"
radio "listVisibility" "viz_Password" (string RequestVisibility.passwordProtected) (string m.listVisibility) radio "listVisibility" "viz_Password" (string RequestVisibility.passwordProtected)
label [ _for "viz_Password" ] [ locStr s.["Password Protected"] ] (string m.listVisibility)
label [ _for "viz_Password" ] [ locStr s["Password Protected"] ]
] ]
] ]
div [ _id "divClassPassword" let classSuffix = if m.listVisibility = RequestVisibility.passwordProtected then " pt-show" else ""
match m.listVisibility = RequestVisibility.passwordProtected with div [ _id "divClassPassword"; _class $"pt-field-row pt-fadeable{classSuffix}" ] [
| true -> _class "pt-field-row pt-fadeable pt-show"
| false -> _class "pt-field-row pt-fadeable"
] [
div [ _class "pt-field" ] [ div [ _class "pt-field" ] [
label [ _for "groupPassword" ] [ locStr s.["Group Password (Used to Read Online)"] ] label [ _for "groupPassword" ] [ locStr s["Group Password (Used to Read Online)"] ]
input [ _type "text"; _name "groupPassword"; _id "groupPassword"; input [ _type "text"; _name "groupPassword"; _id "groupPassword";
_value (match m.groupPassword with Some x -> x | None -> "") ] _value (match m.groupPassword with Some x -> x | None -> "") ]
] ]
] ]
div [ _class "pt-field-row" ] [ div [ _class "pt-field-row" ] [
div [ _class "pt-field" ] [ div [ _class "pt-field" ] [
label [ _for "pageSize" ] [ locStr s.["Page Size"] ] label [ _for "pageSize" ] [ locStr s["Page Size"] ]
input [ _type "number"; _name "pageSize"; _id "pageSize"; _min "10"; _max "255"; _required input [ _type "number"; _name "pageSize"; _id "pageSize"; _min "10"; _max "255"; _required
_value (string m.pageSize) ] _value (string m.pageSize) ]
] ]
div [ _class "pt-field" ] [ div [ _class "pt-field" ] [
label [ _for "asOfDate" ] [ locStr s.["“As of” Date Display"] ] label [ _for "asOfDate" ] [ locStr s["“As of” Date Display"] ]
ReferenceList.asOfDateList s ReferenceList.asOfDateList s
|> List.map (fun (code, desc) -> code, desc.Value) |> List.map (fun (code, desc) -> code, desc.Value)
|> selectList "asOfDate" m.asOfDate [ _required ] |> selectList "asOfDate" m.asOfDate [ _required ]
] ]
] ]
] ]
div [ _class "pt-field-row" ] [ submit [] "save" s.["Save Preferences"] ] div [ _class "pt-field-row" ] [ submit [] "save" s["Save Preferences"] ]
] ]
p [] [ p [] [
rawText "** " rawText "** "
raw l.["List font names, separated by commas."] raw l["List font names, separated by commas."]
space space
raw l.["The first font that is matched is the one that is used."] raw l["The first font that is matched is the one that is used."]
space space
raw l.["Ending with either “serif” or “sans-serif” will cause the user's browser to use the default “serif” font (“Times New Roman” on Windows) or “sans-serif” font (“Arial” on Windows) if no other fonts in the list are found."] raw l["Ending with either “serif” or “sans-serif” will cause the user's browser to use the default “serif” font (“Times New Roman” on Windows) or “sans-serif” font (“Arial” on Windows) if no other fonts in the list are found."]
] ]
p [] [ p [] [
rawText "*** " rawText "*** "
raw l.["If you want a custom color, you may be able to get some ideas (and a list of RGB values for those colors) from the W3 School's <a href=\"http://www.w3schools.com/html/html_colornames.asp\" title=\"HTML Color List - W3 School\">HTML color name list</a>."] raw l["If you want a custom color, you may be able to get some ideas (and a list of RGB values for those colors) from the W3 School's <a href=\"http://www.w3schools.com/html/html_colornames.asp\" title=\"HTML Color List - W3 School\">HTML color name list</a>."]
] ]
script [] [ rawText "PT.onLoad(PT.smallGroup.preferences.onPageLoad)" ] script [] [ rawText "PT.onLoad(PT.smallGroup.preferences.onPageLoad)" ]
] ]

80
src/PrayerTracker.UI/User.fs
View File

@ -7,7 +7,7 @@ open PrayerTracker.ViewModels
/// View for the group assignment page /// View for the group assignment page
let assignGroups m groups curGroups ctx vi = let assignGroups m groups curGroups ctx vi =
let s = I18N.localizer.Force () let s = I18N.localizer.Force ()
let pageTitle = sprintf "%s • %A" m.userName s.["Assign Groups"] let pageTitle = sprintf "%s • %A" m.userName s["Assign Groups"]
form [ _action "/web/user/small-groups/save"; _method "post"; _class "pt-center-columns" ] [ form [ _action "/web/user/small-groups/save"; _method "post"; _class "pt-center-columns" ] [
csrfToken ctx csrfToken ctx
input [ _type "hidden"; _name "userId"; _value (flatGuid m.userId) ] input [ _type "hidden"; _name "userId"; _value (flatGuid m.userId) ]
@ -16,7 +16,7 @@ let assignGroups m groups curGroups ctx vi =
thead [] [ thead [] [
tr [] [ tr [] [
th [] [ rawText "&nbsp;" ] th [] [ rawText "&nbsp;" ]
th [] [ locStr s.["Group"] ] th [] [ locStr s["Group"] ]
] ]
] ]
groups groups
@ -34,7 +34,7 @@ let assignGroups m groups curGroups ctx vi =
]) ])
|> tbody [] |> tbody []
] ]
div [ _class "pt-field-row" ] [ submit [] "save" s.["Save Group Assignments"] ] div [ _class "pt-field-row" ] [ submit [] "save" s["Save Group Assignments"] ]
] ]
|> List.singleton |> List.singleton
|> Layout.Content.standard |> Layout.Content.standard
@ -45,22 +45,22 @@ let assignGroups m groups curGroups ctx vi =
let changePassword ctx vi = let changePassword ctx vi =
let s = I18N.localizer.Force () let s = I18N.localizer.Force ()
[ p [ _class "pt-center-text" ] [ [ p [ _class "pt-center-text" ] [
locStr s.["To change your password, enter your current password in the specified box below, then enter your new password twice."] locStr s["To change your password, enter your current password in the specified box below, then enter your new password twice."]
] ]
form [ _action "/web/user/password/change" form [ _action "/web/user/password/change"
_method "post" _method "post"
_onsubmit $"""return PT.compareValidation('newPassword','newPasswordConfirm','%A{s.["The passwords do not match"]}')""" ] [ _onsubmit $"""return PT.compareValidation('newPassword','newPasswordConfirm','%A{s["The passwords do not match"]}')""" ] [
style [ _scoped ] [ rawText "#oldPassword, #newPassword, #newPasswordConfirm { width: 10rem; } "] style [ _scoped ] [ rawText "#oldPassword, #newPassword, #newPasswordConfirm { width: 10rem; } "]
csrfToken ctx csrfToken ctx
div [ _class "pt-field-row" ] [ div [ _class "pt-field-row" ] [
div [ _class "pt-field" ] [ div [ _class "pt-field" ] [
label [ _for "oldPassword" ] [ locStr s.["Current Password"] ] label [ _for "oldPassword" ] [ locStr s["Current Password"] ]
input [ _type "password"; _name "oldPassword"; _id "oldPassword"; _required; _autofocus ] input [ _type "password"; _name "oldPassword"; _id "oldPassword"; _required; _autofocus ]
] ]
] ]
div [ _class "pt-field-row" ] [ div [ _class "pt-field-row" ] [
div [ _class "pt-field" ] [ div [ _class "pt-field" ] [
label [ _for "newPassword" ] [ locStr s.["New Password Twice"] ] label [ _for "newPassword" ] [ locStr s["New Password Twice"] ]
input [ _type "password"; _name "newPassword"; _id "newPassword"; _required ] input [ _type "password"; _name "newPassword"; _id "newPassword"; _required ]
] ]
div [ _class "pt-field" ] [ div [ _class "pt-field" ] [
@ -70,7 +70,7 @@ let changePassword ctx vi =
] ]
div [ _class "pt-field-row" ] [ div [ _class "pt-field-row" ] [
submit [ _onclick "document.getElementById('newPasswordConfirm').setCustomValidity('')" ] "done" submit [ _onclick "document.getElementById('newPasswordConfirm').setCustomValidity('')" ] "done"
s.["Change Your Password"] s["Change Your Password"]
] ]
] ]
] ]
@ -81,35 +81,35 @@ let changePassword ctx vi =
/// View for the edit user page /// View for the edit user page
let edit (m : EditUser) ctx vi = let edit (m : EditUser) ctx vi =
let s = I18N.localizer.Force () let s = I18N.localizer.Force ()
let pageTitle = match m.isNew () with true -> "Add a New User" | false -> "Edit User" let pageTitle = if m.isNew () then "Add a New User" else "Edit User"
let pwPlaceholder = s.[match m.isNew () with true -> "" | false -> "No change"].Value let pwPlaceholder = s[if m.isNew () then "" else "No change"].Value
[ form [ _action "/web/user/edit/save"; _method "post"; _class "pt-center-columns" [ form [ _action "/web/user/edit/save"; _method "post"; _class "pt-center-columns"
_onsubmit $"""return PT.compareValidation('password','passwordConfirm','%A{s.["The passwords do not match"]}')""" ] [ _onsubmit $"""return PT.compareValidation('password','passwordConfirm','%A{s["The passwords do not match"]}')""" ] [
style [ _scoped ] style [ _scoped ]
[ rawText "#firstName, #lastName, #password, #passwordConfirm { width: 10rem; } #emailAddress { width: 20rem; } " ] [ rawText "#firstName, #lastName, #password, #passwordConfirm { width: 10rem; } #emailAddress { width: 20rem; } " ]
csrfToken ctx csrfToken ctx
input [ _type "hidden"; _name "userId"; _value (flatGuid m.userId) ] input [ _type "hidden"; _name "userId"; _value (flatGuid m.userId) ]
div [ _class "pt-field-row" ] [ div [ _class "pt-field-row" ] [
div [ _class "pt-field" ] [ div [ _class "pt-field" ] [
label [ _for "firstName" ] [ locStr s.["First Name"] ] label [ _for "firstName" ] [ locStr s["First Name"] ]
input [ _type "text"; _name "firstName"; _id "firstName"; _value m.firstName; _required; _autofocus ] input [ _type "text"; _name "firstName"; _id "firstName"; _value m.firstName; _required; _autofocus ]
] ]
div [ _class "pt-field" ] [ div [ _class "pt-field" ] [
label [ _for "lastName" ] [ locStr s.["Last Name"] ] label [ _for "lastName" ] [ locStr s["Last Name"] ]
input [ _type "text"; _name "lastName"; _id "lastName"; _value m.lastName; _required ] input [ _type "text"; _name "lastName"; _id "lastName"; _value m.lastName; _required ]
] ]
div [ _class "pt-field" ] [ div [ _class "pt-field" ] [
label [ _for "emailAddress" ] [ locStr s.["E-mail Address"] ] label [ _for "emailAddress" ] [ locStr s["E-mail Address"] ]
input [ _type "email"; _name "emailAddress"; _id "emailAddress"; _value m.emailAddress; _required ] input [ _type "email"; _name "emailAddress"; _id "emailAddress"; _value m.emailAddress; _required ]
] ]
] ]
div [ _class "pt-field-row" ] [ div [ _class "pt-field-row" ] [
div [ _class "pt-field" ] [ div [ _class "pt-field" ] [
label [ _for "password" ] [ locStr s.["Password"] ] label [ _for "password" ] [ locStr s["Password"] ]
input [ _type "password"; _name "password"; _id "password"; _placeholder pwPlaceholder ] input [ _type "password"; _name "password"; _id "password"; _placeholder pwPlaceholder ]
] ]
div [ _class "pt-field" ] [ div [ _class "pt-field" ] [
label [ _for "passwordConfirm" ] [ locStr s.["Password Again"] ] label [ _for "passwordConfirm" ] [ locStr s["Password Again"] ]
input [ _type "password"; _name "passwordConfirm"; _id "passwordConfirm"; _placeholder pwPlaceholder ] input [ _type "password"; _name "passwordConfirm"; _id "passwordConfirm"; _placeholder pwPlaceholder ]
] ]
] ]
@ -119,9 +119,9 @@ let edit (m : EditUser) ctx vi =
_id "isAdmin" _id "isAdmin"
_value "True" _value "True"
match m.isAdmin with Some x when x -> _checked | _ -> () ] match m.isAdmin with Some x when x -> _checked | _ -> () ]
label [ _for "isAdmin" ] [ locStr s.["This user is a PrayerTracker administrator"] ] label [ _for "isAdmin" ] [ locStr s["This user is a PrayerTracker administrator"] ]
] ]
div [ _class "pt-field-row" ] [ submit [] "save" s.["Save User"] ] div [ _class "pt-field-row" ] [ submit [] "save" s["Save User"] ]
] ]
script [] [ rawText $"PT.onLoad(PT.user.edit.onPageLoad({(string (m.isNew ())).ToLower ()}))" ] script [] [ rawText $"PT.onLoad(PT.user.edit.onPageLoad({(string (m.isNew ())).ToLower ()}))" ]
] ]
@ -138,33 +138,33 @@ let logOn (m : UserLogOn) groups ctx vi =
input [ _type "hidden"; _name "redirectUrl"; _value (defaultArg m.redirectUrl "") ] input [ _type "hidden"; _name "redirectUrl"; _value (defaultArg m.redirectUrl "") ]
div [ _class "pt-field-row" ] [ div [ _class "pt-field-row" ] [
div [ _class "pt-field" ] [ div [ _class "pt-field" ] [
label [ _for "emailAddress"] [ locStr s.["E-mail Address"] ] label [ _for "emailAddress"] [ locStr s["E-mail Address"] ]
input [ _type "email"; _name "emailAddress"; _id "emailAddress"; _value m.emailAddress; _required; _autofocus ] input [ _type "email"; _name "emailAddress"; _id "emailAddress"; _value m.emailAddress; _required
_autofocus ]
] ]
div [ _class "pt-field" ] [ div [ _class "pt-field" ] [
label [ _for "password" ] [ locStr s.["Password"] ] label [ _for "password" ] [ locStr s["Password"] ]
input [ _type "password"; _name "password"; _id "password"; _required; input [ _type "password"; _name "password"; _id "password"; _required;
_placeholder (sprintf "(%s)" (s.["Case-Sensitive"].Value.ToLower ())) ] _placeholder (sprintf "(%s)" (s["Case-Sensitive"].Value.ToLower ())) ]
] ]
] ]
div [ _class "pt-field-row" ] [ div [ _class "pt-field-row" ] [
div [ _class "pt-field" ] [ div [ _class "pt-field" ] [
label [ _for "smallGroupId" ] [ locStr s.["Group"] ] label [ _for "smallGroupId" ] [ locStr s["Group"] ]
seq { seq {
"", selectDefault s.["Select Group"].Value "", selectDefault s["Select Group"].Value
yield! groups yield! groups
} }
|> selectList "smallGroupId" "" [ _required ] |> selectList "smallGroupId" "" [ _required ]
] ]
] ]
div [ _class "pt-checkbox-field" ] [ div [ _class "pt-checkbox-field" ] [
input [ _type "checkbox"; _name "rememberMe"; _id "rememberMe"; _value "True" ] input [ _type "checkbox"; _name "rememberMe"; _id "rememberMe"; _value "True" ]
label [ _for "rememberMe" ] [ locStr s.["Remember Me"] ] label [ _for "rememberMe" ] [ locStr s["Remember Me"] ]
br [] br []
small [] [ em [] [ rawText "("; str (s.["Requires Cookies"].Value.ToLower ()); rawText ")" ] ] small [] [ em [] [ rawText "("; str (s["Requires Cookies"].Value.ToLower ()); rawText ")" ] ]
] ]
div [ _class "pt-field-row" ] [ submit [] "account_circle" s.["Log On"] ] div [ _class "pt-field-row" ] [ submit [] "account_circle" s["Log On"] ]
] ]
|> List.singleton |> List.singleton
|> Layout.Content.standard |> Layout.Content.standard
@ -181,40 +181,38 @@ let maintain (users : User list) ctx vi =
table [ _class "pt-table pt-action-table" ] [ table [ _class "pt-table pt-action-table" ] [
thead [] [ thead [] [
tr [] [ tr [] [
th [] [ locStr s.["Actions"] ] th [] [ locStr s["Actions"] ]
th [] [ locStr s.["Name"] ] th [] [ locStr s["Name"] ]
th [] [ locStr s.["Admin?"] ] th [] [ locStr s["Admin?"] ]
] ]
] ]
users users
|> List.map (fun user -> |> List.map (fun user ->
let userId = flatGuid user.userId let userId = flatGuid user.userId
let delAction = $"/web/user/{userId}/delete" let delAction = $"/web/user/{userId}/delete"
let delPrompt = s.["Are you sure you want to delete this {0}? This action cannot be undone.", let delPrompt = s["Are you sure you want to delete this {0}? This action cannot be undone.",
$"""{s.["User"].Value.ToLower ()} ({user.fullName})"""].Value $"""{s["User"].Value.ToLower ()} ({user.fullName})"""].Value
tr [] [ tr [] [
td [] [ td [] [
a [ _href $"/web/user/{userId}/edit"; _title s.["Edit This User"].Value ] [ icon "edit" ] a [ _href $"/web/user/{userId}/edit"; _title s["Edit This User"].Value ] [ icon "edit" ]
a [ _href $"/web/user/{userId}/small-groups"; _title s.["Assign Groups to This User"].Value ] a [ _href $"/web/user/{userId}/small-groups"; _title s["Assign Groups to This User"].Value ]
[ icon "group" ] [ icon "group" ]
a [ _href delAction a [ _href delAction
_title s.["Delete This User"].Value _title s["Delete This User"].Value
_onclick $"return PT.confirmDelete('{delAction}','{delPrompt}')" ] _onclick $"return PT.confirmDelete('{delAction}','{delPrompt}')" ]
[ icon "delete_forever" ] [ icon "delete_forever" ]
] ]
td [] [ str user.fullName ] td [] [ str user.fullName ]
td [ _class "pt-center-text" ] [ td [ _class "pt-center-text" ] [
match user.isAdmin with if user.isAdmin then strong [] [ locStr s["Yes"] ] else locStr s["No"]
| true -> strong [] [ locStr s.["Yes"] ]
| false -> locStr s.["No"]
] ]
]) ])
|> tbody [] |> tbody []
] ]
[ div [ _class "pt-center-text" ] [ [ div [ _class "pt-center-text" ] [
br [] br []
a [ _href $"/web/user/{emptyGuid}/edit"; _title s.["Add a New User"].Value ] a [ _href $"/web/user/{emptyGuid}/edit"; _title s["Add a New User"].Value ]
[ icon "add_circle"; rawText " &nbsp;"; locStr s.["Add a New User"] ] [ icon "add_circle"; rawText " &nbsp;"; locStr s["Add a New User"] ]
br [] br []
br [] br []
] ]

78
src/PrayerTracker.UI/Utils.fs
View File

@ -1,11 +1,9 @@
[<AutoOpen>] [<AutoOpen>]
module PrayerTracker.Utils module PrayerTracker.Utils
open System.Net open System
open System.Security.Cryptography open System.Security.Cryptography
open System.Text open System.Text
open System.Text.RegularExpressions
open System
/// Hash a string with a SHA1 hash /// Hash a string with a SHA1 hash
let sha1Hash (x : string) = let sha1Hash (x : string) =
@ -35,13 +33,15 @@ module String =
match haystack.IndexOf needle with match haystack.IndexOf needle with
| -1 -> haystack | -1 -> haystack
| idx -> | idx ->
[ haystack.[0..idx - 1] [ haystack[0..idx - 1]
replacement replacement
haystack.[idx + needle.Length..] haystack[idx + needle.Length..]
] ]
|> String.concat "" |> String.concat ""
open System.Text.RegularExpressions
/// Strip HTML tags from the given string /// Strip HTML tags from the given string
// Adapted from http://www.dijksterhuis.org/safely-cleaning-html-with-strip_tags-in-csharp/ // Adapted from http://www.dijksterhuis.org/safely-cleaning-html-with-strip_tags-in-csharp/
let stripTags allowedTags input = let stripTags allowedTags input =
@ -51,15 +51,12 @@ let stripTags allowedTags input =
let htmlTag = tag.Value.ToLower () let htmlTag = tag.Value.ToLower ()
let isAllowed = let isAllowed =
allowedTags allowedTags
|> List.fold |> List.fold (fun acc t ->
(fun acc t ->
acc acc
|| htmlTag.IndexOf $"<{t}>" = 0 || htmlTag.IndexOf $"<{t}>" = 0
|| htmlTag.IndexOf $"<{t} " = 0 || htmlTag.IndexOf $"<{t} " = 0
|| htmlTag.IndexOf $"</{t}" = 0) false || htmlTag.IndexOf $"</{t}" = 0) false
match isAllowed with if isAllowed then output <- String.replaceFirst tag.Value "" output
| true -> ()
| false -> output <- String.replaceFirst tag.Value "" output
output output
@ -75,30 +72,28 @@ let wordWrap charPerLine (input : string) =
| 0 -> () | 0 -> ()
| _ -> | _ ->
while charPerLine < remaining.Length do while charPerLine < remaining.Length do
match charPerLine + 1 < remaining.Length && remaining.[charPerLine] = ' ' with if charPerLine + 1 < remaining.Length && remaining[charPerLine] = ' ' then
| true ->
// Line length is followed by a space; return [charPerLine] as a line // Line length is followed by a space; return [charPerLine] as a line
yield remaining.[0..charPerLine - 1] yield remaining[0..charPerLine - 1]
remaining <- remaining.[charPerLine + 1..] remaining <- remaining[charPerLine + 1..]
| false -> else
match remaining.[0..charPerLine - 1].LastIndexOf ' ' with match remaining[0..charPerLine - 1].LastIndexOf ' ' with
| -1 -> | -1 ->
// No whitespace; just break it at [characters] // No whitespace; just break it at [characters]
yield remaining.[0..charPerLine - 1] yield remaining[0..charPerLine - 1]
remaining <- remaining.[charPerLine..] remaining <- remaining[charPerLine..]
| spaceIdx -> | spaceIdx ->
// Break on the last space in the line // Break on the last space in the line
yield remaining.[0..spaceIdx - 1] yield remaining[0..spaceIdx - 1]
remaining <- remaining.[spaceIdx + 1..] remaining <- remaining[spaceIdx + 1..]
// Leftovers - yum! // Leftovers - yum!
match remaining.Length with 0 -> () | _ -> yield remaining match remaining.Length with 0 -> () | _ -> yield remaining
} }
|> Seq.fold (fun (acc : StringBuilder) line -> acc.AppendFormat ("{0}\n", line)) (StringBuilder ()) |> Seq.fold (fun (acc : StringBuilder) -> acc.AppendLine) (StringBuilder ())
|> string |> string
/// Modify the text returned by CKEditor into the format we need for request and announcement text /// Modify the text returned by CKEditor into the format we need for request and announcement text
let ckEditorToText (text : string) = let ckEditorToText (text : string) =
let trim (str : string) = str.Trim ()
[ "\n\t", "" [ "\n\t", ""
"&nbsp;", " " "&nbsp;", " "
" ", "&#xa0; " " ", "&#xa0; "
@ -107,9 +102,11 @@ let ckEditorToText (text : string) =
"<p>", "" "<p>", ""
] ]
|> List.fold (fun (txt : string) (x, y) -> String.replace x y txt) text |> List.fold (fun (txt : string) (x, y) -> String.replace x y txt) text
|> trim |> String.trim
open System.Net
/// Convert an HTML piece of text to plain text /// Convert an HTML piece of text to plain text
let htmlToPlainText html = let htmlToPlainText html =
match html with match html with
@ -127,16 +124,9 @@ let sndAsString x = (snd >> string) x
/// Make a URL with query string parameters /// Make a URL with query string parameters
let makeUrl (url : string) (qs : (string * string) list) = let makeUrl url qs =
let queryString = if List.isEmpty qs then url
qs else $"""{url}?{String.Join('&', List.map (fun (k, v) -> $"%s{k}={WebUtility.UrlEncode v}") qs)}"""
|> List.fold
(fun (acc : StringBuilder) (key, value) ->
acc.Append(key).Append("=").Append(WebUtility.UrlEncode value).Append "&")
(StringBuilder ())
match queryString.Length with
| 0 -> url
| _ -> queryString.Insert(0, "?").Insert(0, url).Remove(queryString.Length - 1, 1).ToString ()
/// "Magic string" repository /// "Magic string" repository
@ -145,37 +135,49 @@ module Key =
/// This contains constants for session-stored objects within PrayerTracker /// This contains constants for session-stored objects within PrayerTracker
module Session = module Session =
/// The currently logged-on small group /// The currently logged-on small group
let currentGroup = "CurrentGroup" let currentGroup = "CurrentGroup"
/// The currently logged-on user /// The currently logged-on user
let currentUser = "CurrentUser" let currentUser = "CurrentUser"
/// User messages to be displayed the next time a page is sent /// User messages to be displayed the next time a page is sent
let userMessages = "UserMessages" let userMessages = "UserMessages"
/// The URL to which the user should be redirected once they have logged in /// The URL to which the user should be redirected once they have logged in
let redirectUrl = "RedirectUrl" let redirectUrl = "RedirectUrl"
/// Names and value names for use with cookies /// Names and value names for use with cookies
module Cookie = module Cookie =
/// The name of the user cookie /// The name of the user cookie
let user = "LoggedInUser" let user = "LoggedInUser"
/// The name of the class cookie /// The name of the class cookie
let group = "LoggedInClass" let group = "LoggedInClass"
/// The name of the culture cookie /// The name of the culture cookie
let culture = "CurrentCulture" let culture = "CurrentCulture"
/// The name of the idle timeout cookie /// The name of the idle timeout cookie
let timeout = "TimeoutCookie" let timeout = "TimeoutCookie"
/// The cookies that should be cleared when a user or group logs off /// The cookies that should be cleared when a user or group logs off
let logOffCookies = [ user; group; timeout ] let logOffCookies = [ user; group; timeout ]
/// Enumerated values for small group request list visibility (derived from preferences, used in UI) /// Enumerated values for small group request list visibility (derived from preferences, used in UI)
module RequestVisibility = module RequestVisibility =
/// Requests are publicly accessible /// Requests are publicly accessible
[<Literal>] [<Literal>]
let ``public`` = 1 let ``public`` = 1
/// The small group members can enter a password to view the request list /// The small group members can enter a password to view the request list
[<Literal>] [<Literal>]
let passwordProtected = 2 let passwordProtected = 2
/// No one can see the requests for a small group except its administrators ("User" access level) /// No one can see the requests for a small group except its administrators ("User" access level)
[<Literal>] [<Literal>]
let ``private`` = 3 let ``private`` = 3
@ -183,25 +185,35 @@ module RequestVisibility =
/// Links for help locations /// Links for help locations
module Help = module Help =
/// Help link for small group preference edit page /// Help link for small group preference edit page
let groupPreferences = "small-group/preferences" let groupPreferences = "small-group/preferences"
/// Help link for send announcement page /// Help link for send announcement page
let sendAnnouncement = "small-group/announcement" let sendAnnouncement = "small-group/announcement"
/// Help link for maintain group members page /// Help link for maintain group members page
let maintainGroupMembers = "small-group/members" let maintainGroupMembers = "small-group/members"
/// Help link for request edit page /// Help link for request edit page
let editRequest = "requests/edit" let editRequest = "requests/edit"
/// Help link for maintain requests page /// Help link for maintain requests page
let maintainRequests = "requests/maintain" let maintainRequests = "requests/maintain"
/// Help link for view request list page /// Help link for view request list page
let viewRequestList = "requests/view" let viewRequestList = "requests/view"
/// Help link for user and class login pages /// Help link for user and class login pages
let logOn = "user/log-on" let logOn = "user/log-on"
/// Help link for user password change page /// Help link for user password change page
let changePassword = "user/password" let changePassword = "user/password"
/// Create a full link for a help page /// Create a full link for a help page
let fullLink lang url = $"https://docs.prayer.bitbadger.solutions/%s{lang}/%s{url}.html" let fullLink lang url = $"https://docs.prayer.bitbadger.solutions/%s{lang}/%s{url}.html"
/// This class serves as a common anchor for resources /// This class serves as a common anchor for resources
type Common () = type Common () =
do () do ()

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

@ -4,7 +4,6 @@ open Microsoft.AspNetCore.Html
open Microsoft.Extensions.Localization open Microsoft.Extensions.Localization
open PrayerTracker open PrayerTracker
open PrayerTracker.Entities open PrayerTracker.Entities
open System
/// Helper module to return localized reference lists /// Helper module to return localized reference lists
@ -12,38 +11,36 @@ module ReferenceList =
/// A localized list of the AsOfDateDisplay DU cases /// A localized list of the AsOfDateDisplay DU cases
let asOfDateList (s : IStringLocalizer) = let asOfDateList (s : IStringLocalizer) =
[ NoDisplay.code, s.["Do not display the “as of” date"] [ NoDisplay.code, s["Do not display the “as of” date"]
ShortDate.code, s.["Display a short “as of” date"] ShortDate.code, s["Display a short “as of” date"]
LongDate.code, s.["Display a full “as of” date"] LongDate.code, s["Display a full “as of” date"]
] ]
/// A list of e-mail type options /// A list of e-mail type options
let emailTypeList def (s : IStringLocalizer) = let emailTypeList def (s : IStringLocalizer) =
// Localize the default type // Localize the default type
let defaultType = let defaultType =
match def with s[match def with HtmlFormat -> "HTML Format" | PlainTextFormat -> "Plain-Text Format"].Value
| HtmlFormat -> s.["HTML Format"].Value
| PlainTextFormat -> s.["Plain-Text Format"].Value
seq { seq {
"", LocalizedString ("", $"""{s.["Group Default"].Value} ({defaultType})""") "", LocalizedString ("", $"""{s["Group Default"].Value} ({defaultType})""")
HtmlFormat.code, s.["HTML Format"] HtmlFormat.code, s["HTML Format"]
PlainTextFormat.code, s.["Plain-Text Format"] PlainTextFormat.code, s["Plain-Text Format"]
} }
/// A list of expiration options /// A list of expiration options
let expirationList (s : IStringLocalizer) includeExpireNow = let expirationList (s : IStringLocalizer) includeExpireNow =
[ Automatic.code, s.["Expire Normally"] [ Automatic.code, s["Expire Normally"]
Manual.code, s.["Request Never Expires"] Manual.code, s["Request Never Expires"]
match includeExpireNow with true -> Forced.code, s.["Expire Immediately"] | false -> () if includeExpireNow then Forced.code, s["Expire Immediately"]
] ]
/// A list of request types /// A list of request types
let requestTypeList (s : IStringLocalizer) = let requestTypeList (s : IStringLocalizer) =
[ CurrentRequest, s.["Current Requests"] [ CurrentRequest, s["Current Requests"]
LongTermRequest, s.["Long-Term Requests"] LongTermRequest, s["Long-Term Requests"]
PraiseReport, s.["Praise Reports"] PraiseReport, s["Praise Reports"]
Expecting, s.["Expecting"] Expecting, s["Expecting"]
Announcement, s.["Announcements"] Announcement, s["Announcements"]
] ]
// fsharplint:disable RecordFieldNames MemberNames // fsharplint:disable RecordFieldNames MemberNames
@ -53,24 +50,31 @@ module ReferenceList =
type UserMessage = type UserMessage =
{ /// The type { /// The type
level : string level : string
/// The actual message /// The actual message
text : HtmlString text : HtmlString
/// The description (further information) /// The description (further information)
description : HtmlString option description : HtmlString option
} }
/// Support for the UserMessage type
module UserMessage = module UserMessage =
/// Error message template /// Error message template
let error = let error =
{ level = "ERROR" { level = "ERROR"
text = HtmlString.Empty text = HtmlString.Empty
description = None description = None
} }
/// Warning message template /// Warning message template
let warning = let warning =
{ level = "WARNING" { level = "WARNING"
text = HtmlString.Empty text = HtmlString.Empty
description = None description = None
} }
/// Info message template /// Info message template
let info = let info =
{ level = "Info" { level = "Info"
@ -79,27 +83,39 @@ module UserMessage =
} }
open System
/// View model required by the layout template, given as first parameter for all pages in PrayerTracker /// View model required by the layout template, given as first parameter for all pages in PrayerTracker
[<NoComparison; NoEquality>] [<NoComparison; NoEquality>]
type AppViewInfo = type AppViewInfo =
{ /// CSS files for the page { /// CSS files for the page
style : string list style : string list
/// JavaScript files for the page /// JavaScript files for the page
script : string list script : string list
/// The link for help on this page /// The link for help on this page
helpLink : string option helpLink : string option
/// Messages to be displayed to the user /// Messages to be displayed to the user
messages : UserMessage list messages : UserMessage list
/// The current version of PrayerTracker /// The current version of PrayerTracker
version : string version : string
/// The ticks when the request started /// The ticks when the request started
requestStart : int64 requestStart : int64
/// The currently logged on user, if there is one /// The currently logged on user, if there is one
user : User option user : User option
/// The currently logged on small group, if there is one /// The currently logged on small group, if there is one
group : SmallGroup option group : SmallGroup option
} }
/// Support for the AppViewInfo type
module AppViewInfo = module AppViewInfo =
/// A fresh version that can be populated to process the current request /// A fresh version that can be populated to process the current request
let fresh = let fresh =
{ style = [] { style = []
@ -118,14 +134,18 @@ module AppViewInfo =
type Announcement = type Announcement =
{ /// Whether the announcement should be sent to the class or to PrayerTracker users { /// Whether the announcement should be sent to the class or to PrayerTracker users
sendToClass : string sendToClass : string
/// The text of the announcement /// The text of the announcement
text : string text : string
/// Whether this announcement should be added to the "Announcements" of the prayer list /// Whether this announcement should be added to the "Announcements" of the prayer list
addToRequestList : bool option addToRequestList : bool option
/// The ID of the request type to which this announcement should be added /// The ID of the request type to which this announcement should be added
requestType : string option requestType : string option
} }
with with
/// The text of the announcement, in plain text /// The text of the announcement, in plain text
member this.plainText () = (htmlToPlainText >> wordWrap 74) this.text member this.plainText () = (htmlToPlainText >> wordWrap 74) this.text
@ -135,12 +155,17 @@ with
type AssignGroups = type AssignGroups =
{ /// The Id of the user being assigned { /// The Id of the user being assigned
userId : UserId userId : UserId
/// The full name of the user being assigned /// The full name of the user being assigned
userName : string userName : string
/// The Ids of the small groups to which the user is authorized /// The Ids of the small groups to which the user is authorized
smallGroups : string smallGroups : string
} }
/// Support for the AssignGroups type
module AssignGroups = module AssignGroups =
/// Create an instance of this form from an existing user /// Create an instance of this form from an existing user
let fromUser (u : User) = let fromUser (u : User) =
{ userId = u.userId { userId = u.userId
@ -166,20 +191,27 @@ type ChangePassword =
type EditChurch = type EditChurch =
{ /// The Id of the church { /// The Id of the church
churchId : ChurchId churchId : ChurchId
/// The name of the church /// The name of the church
name : string name : string
/// The city for the church /// The city for the church
city : string city : string
/// The state for the church /// The state for the church
st : string st : string
/// Whether the church has an active VPR interface /// Whether the church has an active VPR interface
hasInterface : bool option hasInterface : bool option
/// The address for the interface /// The address for the interface
interfaceAddress : string option interfaceAddress : string option
} }
with with
/// Is this a new church? /// Is this a new church?
member this.isNew () = Guid.Empty = this.churchId member this.isNew () = Guid.Empty = this.churchId
/// Populate a church from this form /// Populate a church from this form
member this.populateChurch (church : Church) = member this.populateChurch (church : Church) =
{ church with { church with
@ -189,7 +221,10 @@ with
hasInterface = match this.hasInterface with Some x -> x | None -> false hasInterface = match this.hasInterface with Some x -> x | None -> false
interfaceAddress = match this.hasInterface with Some x when x -> this.interfaceAddress | _ -> None interfaceAddress = match this.hasInterface with Some x when x -> this.interfaceAddress | _ -> None
} }
/// Support for the EditChurch type
module EditChurch = module EditChurch =
/// Create an instance from an existing church /// Create an instance from an existing church
let fromChurch (ch : Church) = let fromChurch (ch : Church) =
{ churchId = ch.churchId { churchId = ch.churchId
@ -199,6 +234,7 @@ module EditChurch =
hasInterface = match ch.hasInterface with true -> Some true | false -> None hasInterface = match ch.hasInterface with true -> Some true | false -> None
interfaceAddress = ch.interfaceAddress interfaceAddress = ch.interfaceAddress
} }
/// An instance to use for adding churches /// An instance to use for adding churches
let empty = let empty =
{ churchId = Guid.Empty { churchId = Guid.Empty
@ -215,17 +251,24 @@ module EditChurch =
type EditMember = type EditMember =
{ /// The Id for this small group member (not user-entered) { /// The Id for this small group member (not user-entered)
memberId : MemberId memberId : MemberId
/// The name of the member /// The name of the member
memberName : string memberName : string
/// The e-mail address /// The e-mail address
emailAddress : string emailAddress : string
/// The e-mail format /// The e-mail format
emailType : string emailType : string
} }
with with
/// Is this a new member? /// Is this a new member?
member this.isNew () = Guid.Empty = this.memberId member this.isNew () = Guid.Empty = this.memberId
/// Support for the EditMember type
module EditMember = module EditMember =
/// Create an instance from an existing member /// Create an instance from an existing member
let fromMember (m : Member) = let fromMember (m : Member) =
{ memberId = m.memberId { memberId = m.memberId
@ -233,6 +276,7 @@ module EditMember =
emailAddress = m.email emailAddress = m.email
emailType = match m.format with Some f -> f | None -> "" emailType = match m.format with Some f -> f | None -> ""
} }
/// An empty instance /// An empty instance
let empty = let empty =
{ memberId = Guid.Empty { memberId = Guid.Empty
@ -247,44 +291,63 @@ module EditMember =
type EditPreferences = type EditPreferences =
{ /// The number of days after which requests are automatically expired { /// The number of days after which requests are automatically expired
expireDays : int expireDays : int
/// The number of days requests are considered "new" /// The number of days requests are considered "new"
daysToKeepNew : int daysToKeepNew : int
/// The number of weeks after which a long-term requests is flagged as requiring an update /// The number of weeks after which a long-term requests is flagged as requiring an update
longTermUpdateWeeks : int longTermUpdateWeeks : int
/// Whether to sort by updated date or requestor/subject /// Whether to sort by updated date or requestor/subject
requestSort : string requestSort : string
/// The name from which e-mail will be sent /// The name from which e-mail will be sent
emailFromName : string emailFromName : string
/// The e-mail address from which e-mail will be sent /// The e-mail address from which e-mail will be sent
emailFromAddress : string emailFromAddress : string
/// The default e-mail type for this group /// The default e-mail type for this group
defaultEmailType : string defaultEmailType : string
/// Whether the heading line color uses named colors or R/G/B /// Whether the heading line color uses named colors or R/G/B
headingLineType : string headingLineType : string
/// The named color for the heading lines /// The named color for the heading lines
headingLineColor : string headingLineColor : string
/// Whether the heading text color uses named colors or R/G/B /// Whether the heading text color uses named colors or R/G/B
headingTextType : string headingTextType : string
/// The named color for the heading text /// The named color for the heading text
headingTextColor : string headingTextColor : string
/// The fonts to use for the list /// The fonts to use for the list
listFonts : string listFonts : string
/// The font size for the heading text /// The font size for the heading text
headingFontSize : int headingFontSize : int
/// The font size for the list text /// The font size for the list text
listFontSize : int listFontSize : int
/// The time zone for the class /// The time zone for the class
timeZone : string timeZone : string
/// The list visibility /// The list visibility
listVisibility : int listVisibility : int
/// The small group password /// The small group password
groupPassword : string option groupPassword : string option
/// The page size for search / inactive requests /// The page size for search / inactive requests
pageSize : int pageSize : int
/// How the as-of date should be displayed /// How the as-of date should be displayed
asOfDate : string asOfDate : string
} }
with with
/// Set the properties of a small group based on the form's properties /// Set the properties of a small group based on the form's properties
member this.populatePreferences (prefs : ListPreferences) = member this.populatePreferences (prefs : ListPreferences) =
let isPublic, grpPw = let isPublic, grpPw =
@ -312,6 +375,8 @@ with
pageSize = this.pageSize pageSize = this.pageSize
asOfDateDisplay = AsOfDateDisplay.fromCode this.asOfDate asOfDateDisplay = AsOfDateDisplay.fromCode this.asOfDate
} }
/// Support for the EditPreferences type
module EditPreferences = module EditPreferences =
/// Populate an edit form from existing preferences /// Populate an edit form from existing preferences
let fromPreferences (prefs : ListPreferences) = let fromPreferences (prefs : ListPreferences) =
@ -347,24 +412,33 @@ module EditPreferences =
type EditRequest = type EditRequest =
{ /// The Id of the request { /// The Id of the request
requestId : PrayerRequestId requestId : PrayerRequestId
/// The type of the request /// The type of the request
requestType : string requestType : string
/// The date of the request /// The date of the request
//[<Display (Name = "Date")>]
enteredDate : DateTime option enteredDate : DateTime option
/// Whether to update the date or not /// Whether to update the date or not
skipDateUpdate : bool option skipDateUpdate : bool option
/// The requestor or subject /// The requestor or subject
requestor : string option requestor : string option
/// How this request is expired /// How this request is expired
expiration : string expiration : string
/// The text of the request /// The text of the request
text : string text : string
} }
with with
/// Is this a new request? /// Is this a new request?
member this.isNew () = Guid.Empty = this.requestId member this.isNew () = Guid.Empty = this.requestId
/// Support for the EditRequest type
module EditRequest = module EditRequest =
/// An empty instance to use for new requests /// An empty instance to use for new requests
let empty = let empty =
{ requestId = Guid.Empty { requestId = Guid.Empty
@ -375,6 +449,7 @@ module EditRequest =
expiration = Automatic.code expiration = Automatic.code
text = "" text = ""
} }
/// Create an instance from an existing request /// Create an instance from an existing request
let fromRequest req = let fromRequest req =
{ empty with { empty with
@ -391,27 +466,35 @@ module EditRequest =
type EditSmallGroup = type EditSmallGroup =
{ /// The Id of the small group { /// The Id of the small group
smallGroupId : SmallGroupId smallGroupId : SmallGroupId
/// The name of the small group /// The name of the small group
name : string name : string
/// The Id of the church to which this small group belongs /// The Id of the church to which this small group belongs
churchId : ChurchId churchId : ChurchId
} }
with with
/// Is this a new small group? /// Is this a new small group?
member this.isNew () = Guid.Empty = this.smallGroupId member this.isNew () = Guid.Empty = this.smallGroupId
/// Populate a small group from this form /// Populate a small group from this form
member this.populateGroup (grp : SmallGroup) = member this.populateGroup (grp : SmallGroup) =
{ grp with { grp with
name = this.name name = this.name
churchId = this.churchId churchId = this.churchId
} }
/// Support for the EditSmallGroup type
module EditSmallGroup = module EditSmallGroup =
/// Create an instance from an existing small group /// Create an instance from an existing small group
let fromGroup (g : SmallGroup) = let fromGroup (g : SmallGroup) =
{ smallGroupId = g.smallGroupId { smallGroupId = g.smallGroupId
name = g.name name = g.name
churchId = g.churchId churchId = g.churchId
} }
/// An empty instance (used when adding a new group) /// An empty instance (used when adding a new group)
let empty = let empty =
{ smallGroupId = Guid.Empty { smallGroupId = Guid.Empty
@ -425,22 +508,30 @@ module EditSmallGroup =
type EditUser = type EditUser =
{ /// The Id of the user { /// The Id of the user
userId : UserId userId : UserId
/// The first name of the user /// The first name of the user
firstName : string firstName : string
/// The last name of the user /// The last name of the user
lastName : string lastName : string
/// The e-mail address for the user /// The e-mail address for the user
emailAddress : string emailAddress : string
/// The password for the user /// The password for the user
password : string password : string
/// The password hash for the user a second time /// The password hash for the user a second time
passwordConfirm : string passwordConfirm : string
/// Is this user a PrayerTracker administrator? /// Is this user a PrayerTracker administrator?
isAdmin : bool option isAdmin : bool option
} }
with with
/// Is this a new user? /// Is this a new user?
member this.isNew () = Guid.Empty = this.userId member this.isNew () = Guid.Empty = this.userId
/// Populate a user from the form /// Populate a user from the form
member this.populateUser (user : User) hasher = member this.populateUser (user : User) hasher =
{ user with { user with
@ -452,7 +543,10 @@ with
|> function |> function
| u when isNull this.password || this.password = "" -> u | u when isNull this.password || this.password = "" -> u
| u -> { u with passwordHash = hasher this.password } | u -> { u with passwordHash = hasher this.password }
/// Support for the EditUser type
module EditUser = module EditUser =
/// An empty instance /// An empty instance
let empty = let empty =
{ userId = Guid.Empty { userId = Guid.Empty
@ -463,6 +557,7 @@ module EditUser =
passwordConfirm = "" passwordConfirm = ""
isAdmin = None isAdmin = None
} }
/// Create an instance from an existing user /// Create an instance from an existing user
let fromUser (user : User) = let fromUser (user : User) =
{ empty with { empty with
@ -479,12 +574,17 @@ module EditUser =
type GroupLogOn = type GroupLogOn =
{ /// The ID of the small group to which the user is logging on { /// The ID of the small group to which the user is logging on
smallGroupId : SmallGroupId smallGroupId : SmallGroupId
/// The password entered /// The password entered
password : string password : string
/// Whether to remember the login /// Whether to remember the login
rememberMe : bool option rememberMe : bool option
} }
/// Support for the GroupLogOn type
module GroupLogOn = module GroupLogOn =
/// An empty instance /// An empty instance
let empty = let empty =
{ smallGroupId = Guid.Empty { smallGroupId = Guid.Empty
@ -498,16 +598,23 @@ module GroupLogOn =
type MaintainRequests = type MaintainRequests =
{ /// The requests to be displayed { /// The requests to be displayed
requests : PrayerRequest seq requests : PrayerRequest seq
/// The small group to which the requests belong /// The small group to which the requests belong
smallGroup : SmallGroup smallGroup : SmallGroup
/// Whether only active requests are included /// Whether only active requests are included
onlyActive : bool option onlyActive : bool option
/// The search term for the requests /// The search term for the requests
searchTerm : string option searchTerm : string option
/// The page number of the results /// The page number of the results
pageNbr : int option pageNbr : int option
} }
/// Support for the MaintainRequests type
module MaintainRequests = module MaintainRequests =
/// An empty instance /// An empty instance
let empty = let empty =
{ requests = Seq.empty { requests = Seq.empty
@ -523,10 +630,13 @@ module MaintainRequests =
type Overview = type Overview =
{ /// The total number of active requests { /// The total number of active requests
totalActiveReqs : int totalActiveReqs : int
/// The numbers of active requests by category /// The numbers of active requests by category
activeReqsByCat : Map<PrayerRequestType, int> activeReqsByCat : Map<PrayerRequestType, int>
/// A count of all requests /// A count of all requests
allReqs : int allReqs : int
/// A count of all members /// A count of all members
totalMbrs : int totalMbrs : int
} }
@ -537,16 +647,23 @@ type Overview =
type UserLogOn = type UserLogOn =
{ /// The e-mail address of the user { /// The e-mail address of the user
emailAddress : string emailAddress : string
/// The password entered /// The password entered
password : string password : string
/// The ID of the small group to which the user is logging on /// The ID of the small group to which the user is logging on
smallGroupId : SmallGroupId smallGroupId : SmallGroupId
/// Whether to remember the login /// Whether to remember the login
rememberMe : bool option rememberMe : bool option
/// The URL to which the user should be redirected once login is successful /// The URL to which the user should be redirected once login is successful
redirectUrl : string option redirectUrl : string option
} }
/// Support for the UserLogOn type
module UserLogOn = module UserLogOn =
/// An empty instance /// An empty instance
let empty = let empty =
{ emailAddress = "" { emailAddress = ""
@ -563,18 +680,30 @@ open Giraffe.ViewEngine
type RequestList = type RequestList =
{ /// The prayer request list { /// The prayer request list
requests : PrayerRequest list requests : PrayerRequest list
/// The date for which this list is being generated /// The date for which this list is being generated
date : DateTime date : DateTime
/// The small group to which this list belongs /// The small group to which this list belongs
listGroup : SmallGroup listGroup : SmallGroup
/// Whether to show the class header /// Whether to show the class header
showHeader : bool showHeader : bool
/// The list of recipients (populated if requests are e-mailed) /// The list of recipients (populated if requests are e-mailed)
recipients : Member list recipients : Member list
/// Whether the user can e-mail this list /// Whether the user can e-mail this list
canEmail : bool canEmail : bool
} }
with with
/// Group requests by their type, along with the type and its localized string
member private this.requestsByType (s : IStringLocalizer) =
ReferenceList.requestTypeList s
|> List.map (fun (typ, name) -> typ, name, this.requests |> List.filter (fun req -> req.requestType = typ))
|> List.filter (fun (_, _, reqs) -> not (List.isEmpty reqs))
/// Get the requests for a specified type /// Get the requests for a specified type
member this.requestsInCategory cat = member this.requestsInCategory cat =
let reqs = let reqs =
@ -585,52 +714,45 @@ with
| SortByDate -> reqs |> Seq.sortByDescending (fun req -> req.updatedDate) | SortByDate -> reqs |> Seq.sortByDescending (fun req -> req.updatedDate)
| SortByRequestor -> reqs |> Seq.sortBy (fun req -> req.requestor) | SortByRequestor -> reqs |> Seq.sortBy (fun req -> req.requestor)
|> List.ofSeq |> List.ofSeq
/// Is this request new? /// Is this request new?
member this.isNew (req : PrayerRequest) = member this.isNew (req : PrayerRequest) =
(this.date - req.updatedDate).Days <= this.listGroup.preferences.daysToKeepNew (this.date - req.updatedDate).Days <= this.listGroup.preferences.daysToKeepNew
/// Generate this list as HTML /// Generate this list as HTML
member this.asHtml (s : IStringLocalizer) = member this.asHtml (s : IStringLocalizer) =
let prefs = this.listGroup.preferences let prefs = this.listGroup.preferences
let asOfSize = Math.Round (float prefs.textFontSize * 0.8, 2) let asOfSize = Math.Round (float prefs.textFontSize * 0.8, 2)
[ match this.showHeader with [ if this.showHeader then
| true ->
div [ _style $"text-align:center;font-family:{prefs.listFonts}" ] [ div [ _style $"text-align:center;font-family:{prefs.listFonts}" ] [
span [ _style $"font-size:%i{prefs.headingFontSize}pt;" ] [ span [ _style $"font-size:%i{prefs.headingFontSize}pt;" ] [
strong [] [ str s.["Prayer Requests"].Value ] strong [] [ str s["Prayer Requests"].Value ]
] ]
br [] br []
span [ _style $"font-size:%i{prefs.textFontSize}pt;" ] [ span [ _style $"font-size:%i{prefs.textFontSize}pt;" ] [
strong [] [ str this.listGroup.name ] strong [] [ str this.listGroup.name ]
br [] br []
str (this.date.ToString s.["MMMM d, yyyy"].Value) str (this.date.ToString s["MMMM d, yyyy"].Value)
] ]
] ]
br [] br []
| false -> () for _, name, reqs in this.requestsByType s do
let typs = ReferenceList.requestTypeList s
for cat in
typs
|> Seq.ofList
|> Seq.map fst
|> Seq.filter (fun c -> 0 < (this.requests |> List.filter (fun req -> req.requestType = c) |> List.length)) do
let reqs = this.requestsInCategory cat
let catName = typs |> List.filter (fun t -> fst t = cat) |> List.head |> snd
div [ _style "padding-left:10px;padding-bottom:.5em;" ] [ div [ _style "padding-left:10px;padding-bottom:.5em;" ] [
table [ _style $"font-family:{prefs.listFonts};page-break-inside:avoid;" ] [ table [ _style $"font-family:{prefs.listFonts};page-break-inside:avoid;" ] [
tr [] [ 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 "&nbsp; &nbsp; "; str catName.Value; rawText "&nbsp; &nbsp; " rawText "&nbsp; &nbsp; "; str name.Value; rawText "&nbsp; &nbsp; "
] ]
] ]
] ]
] ]
reqs reqs
|> List.map (fun req -> |> List.map (fun req ->
let bullet = match this.isNew req with true -> "circle" | false -> "disc" 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;" ] [ li [ _style $"list-style-type:{bullet};font-family:{prefs.listFonts};font-size:%i{prefs.textFontSize}pt;padding-bottom:.25em;" ] [
match req.requestor with match req.requestor with
| Some rqstr when rqstr <> "" -> | Some r when r <> "" ->
strong [] [ str rqstr ] strong [] [ str r ]
rawText " &mdash; " rawText " &mdash; "
| Some _ -> () | Some _ -> ()
| None -> () | None -> ()
@ -645,7 +767,7 @@ with
| LongDate -> req.updatedDate.ToLongDateString () | LongDate -> req.updatedDate.ToLongDateString ()
| _ -> "" | _ -> ""
i [ _style $"font-size:%.2f{asOfSize}pt" ] [ i [ _style $"font-size:%.2f{asOfSize}pt" ] [
rawText "&nbsp; ("; str s.["as of"].Value; str " "; str dt; rawText ")" rawText "&nbsp; ("; str s["as of"].Value; str " "; str dt; rawText ")"
] ]
]) ])
|> ul [] |> ul []
@ -657,24 +779,17 @@ with
member this.asText (s : IStringLocalizer) = member this.asText (s : IStringLocalizer) =
seq { seq {
this.listGroup.name this.listGroup.name
s.["Prayer Requests"].Value s["Prayer Requests"].Value
this.date.ToString s.["MMMM d, yyyy"].Value this.date.ToString s["MMMM d, yyyy"].Value
" " " "
let typs = ReferenceList.requestTypeList s for _, name, reqs in this.requestsByType s do
for cat in let dashes = String.replicate (name.Value.Length + 4) "-"
typs
|> Seq.ofList
|> Seq.map fst
|> Seq.filter (fun c -> 0 < (this.requests |> List.filter (fun req -> req.requestType = c) |> List.length)) do
let reqs = this.requestsInCategory cat
let typ = (typs |> List.filter (fun t -> fst t = cat) |> List.head |> snd).Value
let dashes = String.replicate (typ.Length + 4) "-"
dashes dashes
$" {typ.ToUpper ()}" $" {name.Value.ToUpper ()}"
dashes dashes
for req in reqs do for req in reqs do
let bullet = match this.isNew req with true -> "+" | false -> "-" let bullet = if this.isNew req then "+" else "-"
let requestor = match req.requestor with Some r -> sprintf "%s - " r | None -> "" let requestor = match req.requestor with Some r -> $"{r} - " | None -> ""
match this.listGroup.preferences.asOfDateDisplay with match this.listGroup.preferences.asOfDateDisplay with
| NoDisplay -> "" | NoDisplay -> ""
| _ -> | _ ->
@ -683,7 +798,7 @@ with
| ShortDate -> req.updatedDate.ToShortDateString () | ShortDate -> req.updatedDate.ToShortDateString ()
| LongDate -> req.updatedDate.ToLongDateString () | LongDate -> req.updatedDate.ToLongDateString ()
| _ -> "" | _ -> ""
$""" ({s.["as of"].Value} {dt})""" $""" ({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)
" " " "
} }

67
src/PrayerTracker/App.fs
View File

@ -35,35 +35,36 @@ module Configure =
(ctx.Configuration.GetSection >> opts.Configure >> ignore) "Kestrel" (ctx.Configuration.GetSection >> opts.Configure >> ignore) "Kestrel"
let services (svc : IServiceCollection) = let services (svc : IServiceCollection) =
svc.AddOptions() let _ = svc.AddOptions()
.AddLocalization(fun options -> options.ResourcesPath <- "Resources") let _ = svc.AddLocalization(fun options -> options.ResourcesPath <- "Resources")
.Configure<RequestLocalizationOptions>( let _ =
fun (opts : RequestLocalizationOptions) -> svc.Configure<RequestLocalizationOptions>(fun (opts : RequestLocalizationOptions) ->
let supportedCultures = let supportedCultures =[|
[| CultureInfo "en-US"; CultureInfo "en-GB"; CultureInfo "en-AU"; CultureInfo "en" CultureInfo "en-US"; CultureInfo "en-GB"; CultureInfo "en-AU"; CultureInfo "en"
CultureInfo "es-MX"; CultureInfo "es-ES"; CultureInfo "es" CultureInfo "es-MX"; CultureInfo "es-ES"; CultureInfo "es"
|] |]
opts.DefaultRequestCulture <- RequestCulture ("en-US", "en-US") opts.DefaultRequestCulture <- RequestCulture ("en-US", "en-US")
opts.SupportedCultures <- supportedCultures opts.SupportedCultures <- supportedCultures
opts.SupportedUICultures <- supportedCultures) opts.SupportedUICultures <- supportedCultures)
.AddDistributedMemoryCache() let _ = svc.AddDistributedMemoryCache()
.AddSession() let _ = svc.AddSession()
.AddAntiforgery() let _ = svc.AddAntiforgery()
.AddRouting() let _ = svc.AddRouting()
.AddSingleton<IClock>(SystemClock.Instance) let _ = svc.AddSingleton<IClock>(SystemClock.Instance)
|> ignore
let config = svc.BuildServiceProvider().GetRequiredService<IConfiguration>() let config = svc.BuildServiceProvider().GetRequiredService<IConfiguration>()
let crypto = config.GetSection "CookieCrypto" let crypto = config.GetSection "CookieCrypto"
CookieCrypto (crypto.["Key"], crypto.["IV"]) |> setCrypto CookieCrypto (crypto["Key"], crypto["IV"]) |> setCrypto
svc.AddDbContext<AppDbContext>(
let _ = svc.AddDbContext<AppDbContext>(
(fun options -> (fun options ->
options.UseNpgsql (config.GetConnectionString "PrayerTracker") |> ignore), options.UseNpgsql (config.GetConnectionString "PrayerTracker") |> ignore),
ServiceLifetime.Scoped, ServiceLifetime.Singleton) ServiceLifetime.Scoped, ServiceLifetime.Singleton)
|> ignore ()
/// Routes for PrayerTracker /// Routes for PrayerTracker
let routes = let routes = [
[ subRoute "/web" [ subRoute "/web" [
GET_HEAD [ GET_HEAD [
subRoute "/church" [ subRoute "/church" [
route "es" Handlers.Church.maintain route "es" Handlers.Church.maintain
@ -147,36 +148,36 @@ module Configure =
/// Giraffe error handler /// Giraffe error handler
let errorHandler (ex : exn) (logger : ILogger) = let errorHandler (ex : exn) (logger : ILogger) =
logger.LogError(EventId(), ex, "An unhandled exception has occurred while executing the request.") logger.LogError (EventId(), ex, "An unhandled exception has occurred while executing the request.")
clearResponse >=> setStatusCode 500 >=> text ex.Message clearResponse >=> setStatusCode 500 >=> text ex.Message
/// Configure logging /// Configure logging
let logging (log : ILoggingBuilder) = let logging (log : ILoggingBuilder) =
let env = log.Services.BuildServiceProvider().GetService<IWebHostEnvironment> () let env = log.Services.BuildServiceProvider().GetService<IWebHostEnvironment> ()
match env.IsDevelopment () with if env.IsDevelopment () then log else log.AddFilter (fun l -> l > LogLevel.Information)
| true -> log
| false -> log.AddFilter (fun l -> l > LogLevel.Information)
|> function l -> l.AddConsole().AddDebug() |> function l -> l.AddConsole().AddDebug()
|> ignore |> ignore
let app (app : IApplicationBuilder) = let app (app : IApplicationBuilder) =
let env = app.ApplicationServices.GetRequiredService<IWebHostEnvironment>() let env = app.ApplicationServices.GetRequiredService<IWebHostEnvironment>()
(match env.IsDevelopment () with if env.IsDevelopment () then
| true -> let _ = app.UseDeveloperExceptionPage ()
app.UseDeveloperExceptionPage () ()
| false -> else
try try
use scope = app.ApplicationServices.GetRequiredService<IServiceScopeFactory>().CreateScope () use scope = app.ApplicationServices.GetRequiredService<IServiceScopeFactory>().CreateScope ()
scope.ServiceProvider.GetService<AppDbContext>().Database.Migrate () scope.ServiceProvider.GetService<AppDbContext>().Database.Migrate ()
with _ -> () // om nom nom with _ -> () // om nom nom
app.UseGiraffeErrorHandler errorHandler) let _ = app.UseGiraffeErrorHandler errorHandler
.UseStatusCodePagesWithReExecute("/error/{0}") ()
.UseStaticFiles()
.UseRouting() let _ = app.UseStatusCodePagesWithReExecute "/error/{0}"
.UseSession() let _ = app.UseStaticFiles ()
.UseRequestLocalization(app.ApplicationServices.GetService<IOptions<RequestLocalizationOptions>>().Value) let _ = app.UseRouting ()
.UseEndpoints (fun e -> e.MapGiraffeEndpoints routes) let _ = app.UseSession ()
|> ignore let _ = app.UseRequestLocalization
(app.ApplicationServices.GetService<IOptions<RequestLocalizationOptions>>().Value)
let _ = app.UseEndpoints (fun e -> e.MapGiraffeEndpoints routes)
Views.I18N.setUpFactories <| app.ApplicationServices.GetRequiredService<IStringLocalizerFactory> () Views.I18N.setUpFactories <| app.ApplicationServices.GetRequiredService<IStringLocalizerFactory> ()

50
src/PrayerTracker/Church.fs
View File

@ -1,12 +1,12 @@
module PrayerTracker.Handlers.Church module PrayerTracker.Handlers.Church
open System
open System.Threading.Tasks
open Giraffe open Giraffe
open PrayerTracker open PrayerTracker
open PrayerTracker.Entities open PrayerTracker.Entities
open PrayerTracker.ViewModels open PrayerTracker.ViewModels
open PrayerTracker.Views.CommonFunctions open PrayerTracker.Views.CommonFunctions
open System
open System.Threading.Tasks
/// Find statistics for the given church /// Find statistics for the given church
let private findStats (db : AppDbContext) churchId = task { let private findStats (db : AppDbContext) churchId = task {
@ -14,14 +14,11 @@ let private findStats (db : AppDbContext) churchId = task {
let! reqs = db.CountRequestsByChurch churchId let! reqs = db.CountRequestsByChurch churchId
let! usrs = db.CountUsersByChurch churchId let! usrs = db.CountUsersByChurch churchId
return flatGuid churchId, { smallGroups = grps; prayerRequests = reqs; users = usrs } return flatGuid churchId, { smallGroups = grps; prayerRequests = reqs; users = usrs }
} }
/// POST /church/[church-id]/delete /// POST /church/[church-id]/delete
let delete churchId : HttpHandler = let delete churchId : HttpHandler = requireAccess [ Admin ] >=> validateCSRF >=> fun next ctx -> task {
requireAccess [ Admin ]
>=> validateCSRF
>=> fun next ctx -> task {
match! ctx.db.TryChurchById churchId with match! ctx.db.TryChurchById churchId with
| Some church -> | Some church ->
let! _, stats = findStats ctx.db churchId let! _, stats = findStats ctx.db churchId
@ -29,25 +26,22 @@ let delete churchId : HttpHandler =
let! _ = ctx.db.SaveChangesAsync () let! _ = ctx.db.SaveChangesAsync ()
let s = Views.I18N.localizer.Force () let s = Views.I18N.localizer.Force ()
addInfo ctx addInfo ctx
s.["The church {0} and its {1} small groups (with {2} prayer request(s)) were deleted successfully; revoked access from {3} user(s)", s["The church {0} and its {1} small groups (with {2} prayer request(s)) were deleted successfully; revoked access from {3} user(s)",
church.name, stats.smallGroups, stats.prayerRequests, stats.users] church.name, stats.smallGroups, stats.prayerRequests, stats.users]
return! redirectTo false "/web/churches" next ctx return! redirectTo false "/web/churches" next ctx
| None -> return! fourOhFour next ctx | None -> return! fourOhFour next ctx
} }
/// GET /church/[church-id]/edit /// GET /church/[church-id]/edit
let edit churchId : HttpHandler = let edit churchId : HttpHandler = requireAccess [ Admin ] >=> fun next ctx -> task {
requireAccess [ Admin ]
>=> fun next ctx -> task {
let startTicks = DateTime.Now.Ticks let startTicks = DateTime.Now.Ticks
match churchId with if churchId = Guid.Empty then
| x when x = Guid.Empty ->
return! return!
viewInfo ctx startTicks viewInfo ctx startTicks
|> Views.Church.edit EditChurch.empty ctx |> Views.Church.edit EditChurch.empty ctx
|> renderHtml next ctx |> renderHtml next ctx
| _ -> else
match! ctx.db.TryChurchById churchId with match! ctx.db.TryChurchById churchId with
| Some church -> | Some church ->
return! return!
@ -55,13 +49,11 @@ let edit churchId : HttpHandler =
|> Views.Church.edit (EditChurch.fromChurch church) ctx |> Views.Church.edit (EditChurch.fromChurch church) ctx
|> renderHtml next ctx |> renderHtml next ctx
| None -> return! fourOhFour next ctx | None -> return! fourOhFour next ctx
} }
/// GET /churches /// GET /churches
let maintain : HttpHandler = let maintain : HttpHandler = requireAccess [ Admin ] >=> fun next ctx -> task {
requireAccess [ Admin ]
>=> fun next ctx -> task {
let startTicks = DateTime.Now.Ticks let startTicks = DateTime.Now.Ticks
let await = Async.AwaitTask >> Async.RunSynchronously let await = Async.AwaitTask >> Async.RunSynchronously
let! churches = ctx.db.AllChurches () let! churches = ctx.db.AllChurches ()
@ -70,29 +62,25 @@ let maintain : HttpHandler =
viewInfo ctx startTicks viewInfo ctx startTicks
|> Views.Church.maintain churches (stats |> Map.ofList) ctx |> Views.Church.maintain churches (stats |> Map.ofList) ctx
|> renderHtml next ctx |> renderHtml next ctx
} }
/// POST /church/save /// POST /church/save
let save : HttpHandler = let save : HttpHandler = requireAccess [ Admin ] >=> validateCSRF >=> fun next ctx -> task {
requireAccess [ Admin ]
>=> validateCSRF
>=> fun next ctx -> task {
match! ctx.TryBindFormAsync<EditChurch> () with match! ctx.TryBindFormAsync<EditChurch> () with
| Ok m -> | Ok m ->
let! church = let! church =
match m.isNew () with if m.isNew () then Task.FromResult (Some { Church.empty with churchId = Guid.NewGuid () })
| true -> Task.FromResult<Church option>(Some { Church.empty with churchId = Guid.NewGuid () }) else ctx.db.TryChurchById m.churchId
| false -> ctx.db.TryChurchById m.churchId
match church with match church with
| Some ch -> | Some ch ->
m.populateChurch ch m.populateChurch ch
|> (match m.isNew () with true -> ctx.db.AddEntry | false -> ctx.db.UpdateEntry) |> (if m.isNew () then ctx.db.AddEntry else ctx.db.UpdateEntry)
let! _ = ctx.db.SaveChangesAsync () let! _ = ctx.db.SaveChangesAsync ()
let s = Views.I18N.localizer.Force () let s = Views.I18N.localizer.Force ()
let act = s.[match m.isNew () with true -> "Added" | _ -> "Updated"].Value.ToLower () let act = s[if m.isNew () then "Added" else "Updated"].Value.ToLower ()
addInfo ctx s.["Successfully {0} church “{1}”", act, m.name] addInfo ctx s["Successfully {0} church “{1}”", act, m.name]
return! redirectTo false "/web/churches" next ctx return! redirectTo false "/web/churches" next ctx
| None -> return! fourOhFour next ctx | None -> return! fourOhFour next ctx
| Error e -> return! bindError e next ctx | Error e -> return! bindError e next ctx
} }

45
src/PrayerTracker/CommonFunctions.fs
View File

@ -2,6 +2,10 @@
[<AutoOpen>] [<AutoOpen>]
module PrayerTracker.Handlers.CommonFunctions module PrayerTracker.Handlers.CommonFunctions
open System
open System.Net
open System.Reflection
open System.Threading.Tasks
open Giraffe open Giraffe
open Microsoft.AspNetCore.Antiforgery open Microsoft.AspNetCore.Antiforgery
open Microsoft.AspNetCore.Html open Microsoft.AspNetCore.Html
@ -12,10 +16,6 @@ open Microsoft.Extensions.Localization
open PrayerTracker open PrayerTracker
open PrayerTracker.Cookies open PrayerTracker.Cookies
open PrayerTracker.ViewModels open PrayerTracker.ViewModels
open System
open System.Net
open System.Reflection
open System.Threading.Tasks
/// Create a select list from an enumeration /// Create a select list from an enumeration
let toSelectList<'T> valFunc textFunc withDefault emptyText (items : 'T seq) = let toSelectList<'T> valFunc textFunc withDefault emptyText (items : 'T seq) =
@ -23,7 +23,7 @@ let toSelectList<'T> valFunc textFunc withDefault emptyText (items : 'T seq) =
[ match withDefault with [ match withDefault with
| true -> | true ->
let s = PrayerTracker.Views.I18N.localizer.Force () let s = PrayerTracker.Views.I18N.localizer.Force ()
yield SelectListItem ($"""&mdash; %A{s.[emptyText]} &mdash;""", "") yield SelectListItem ($"""&mdash; %A{s[emptyText]} &mdash;""", "")
| _ -> () | _ -> ()
yield! items |> Seq.map (fun x -> SelectListItem (textFunc x, valFunc x)) yield! items |> Seq.map (fun x -> SelectListItem (textFunc x, valFunc x))
] ]
@ -81,7 +81,8 @@ let viewInfo (ctx : HttpContext) startTicks =
} }
ctx.Response.Cookies.Append ctx.Response.Cookies.Append
(Key.Cookie.timeout, { timeout with Password = saltedTimeoutHash timeout }.toPayload (), (Key.Cookie.timeout, { timeout with Password = saltedTimeoutHash timeout }.toPayload (),
CookieOptions (Expires = Nullable<DateTimeOffset> (DateTimeOffset (DateTime timeout.Until)), HttpOnly = true)) CookieOptions (Expires = Nullable<DateTimeOffset> (DateTimeOffset (DateTime timeout.Until)),
HttpOnly = true))
| None -> () | None -> ()
{ AppViewInfo.fresh with { AppViewInfo.fresh with
version = appVersion version = appVersion
@ -97,7 +98,7 @@ let renderHtml next ctx view =
/// Display an error regarding form submission /// Display an error regarding form submission
let bindError (msg : string) next (ctx : HttpContext) = let bindError (msg : string) next (ctx : HttpContext) =
System.Console.WriteLine msg Console.WriteLine msg
ctx.SetStatusCode 400 ctx.SetStatusCode 400
text msg next ctx text msg next ctx
@ -108,13 +109,12 @@ let fourOhFour next (ctx : HttpContext) =
/// Handler to validate CSRF prevention token /// Handler to validate CSRF prevention token
let validateCSRF : HttpHandler = let validateCSRF : HttpHandler = fun next ctx -> task {
fun next ctx -> task {
match! (ctx.GetService<IAntiforgery> ()).IsRequestValidAsync ctx with match! (ctx.GetService<IAntiforgery> ()).IsRequestValidAsync ctx with
| true -> return! next ctx | true -> return! next ctx
| false -> | false ->
return! (clearResponse >=> setStatusCode 400 >=> text "Quit hacking...") (fun _ -> Task.FromResult None) ctx return! (clearResponse >=> setStatusCode 400 >=> text "Quit hacking...") (fun _ -> Task.FromResult None) ctx
} }
/// Add a message to the session /// Add a message to the session
@ -168,7 +168,7 @@ let requireAccess level : HttpHandler =
let logOnUserFromTimeoutCookie (ctx : HttpContext) = task { let logOnUserFromTimeoutCookie (ctx : HttpContext) = task {
// Make sure the cookie hasn't been tampered with // Make sure the cookie hasn't been tampered with
try try
match TimeoutCookie.fromPayload ctx.Request.Cookies.[Key.Cookie.timeout] with match TimeoutCookie.fromPayload ctx.Request.Cookies[Key.Cookie.timeout] with
| Some c when c.Password = saltedTimeoutHash c -> | Some c when c.Password = saltedTimeoutHash c ->
let! user = ctx.db.TryUserById c.Id let! user = ctx.db.TryUserById c.Id
match user with match user with
@ -184,7 +184,7 @@ let requireAccess level : HttpHandler =
/// Attempt to log the user on from their stored cookie /// Attempt to log the user on from their stored cookie
let logOnUserFromCookie (ctx : HttpContext) = task { let logOnUserFromCookie (ctx : HttpContext) = task {
match UserCookie.fromPayload ctx.Request.Cookies.[Key.Cookie.user] with match UserCookie.fromPayload ctx.Request.Cookies[Key.Cookie.user] with
| Some c -> | Some c ->
let! user = ctx.db.TryUserLogOnByCookie c.Id c.GroupId c.PasswordHash let! user = ctx.db.TryUserLogOnByCookie c.Id c.GroupId c.PasswordHash
match user with match user with
@ -203,9 +203,8 @@ let requireAccess level : HttpHandler =
ctx.Session.smallGroup |> Option.isSome ctx.Session.smallGroup |> Option.isSome
/// Attempt to log the small group on from their stored cookie /// Attempt to log the small group on from their stored cookie
let logOnGroupFromCookie (ctx : HttpContext) = let logOnGroupFromCookie (ctx : HttpContext) = task {
task { match GroupCookie.fromPayload ctx.Request.Cookies[Key.Cookie.group] with
match GroupCookie.fromPayload ctx.Request.Cookies.[Key.Cookie.group] with
| Some c -> | Some c ->
let! grp = ctx.db.TryGroupLogOnByCookie c.GroupId c.PasswordHash sha1Hash let! grp = ctx.db.TryGroupLogOnByCookie c.GroupId c.PasswordHash sha1Hash
match grp with match grp with
@ -217,17 +216,13 @@ let requireAccess level : HttpHandler =
| None -> () | None -> ()
} }
fun next ctx -> FSharp.Control.Tasks.Affine.task { fun next ctx -> task {
// Auto-logon user or class, if required // Auto-logon user or class, if required
match isUserLoggedOn ctx with if not (isUserLoggedOn ctx) then
| true -> ()
| false ->
do! logOnUserFromTimeoutCookie ctx do! logOnUserFromTimeoutCookie ctx
match isUserLoggedOn ctx with if not (isUserLoggedOn ctx) then
| true -> ()
| false ->
do! logOnUserFromCookie ctx do! logOnUserFromCookie ctx
match isGroupLoggedOn ctx with true -> () | false -> do! logOnGroupFromCookie ctx if not (isGroupLoggedOn ctx) then do! logOnGroupFromCookie ctx
match true with match true with
| _ when level |> List.contains Public -> return! next ctx | _ when level |> List.contains Public -> return! next ctx
@ -238,7 +233,7 @@ let requireAccess level : HttpHandler =
| true -> return! next ctx | true -> return! next ctx
| false -> | false ->
let s = Views.I18N.localizer.Force () let s = Views.I18N.localizer.Force ()
addError ctx s.["You are not authorized to view the requested page."] addError ctx s["You are not authorized to view the requested page."]
return! redirectTo false "/web/unauthorized" next ctx return! redirectTo false "/web/unauthorized" next ctx
| _ when level |> List.contains User -> | _ when level |> List.contains User ->
// Redirect to the user log on page // Redirect to the user log on page
@ -250,6 +245,6 @@ let requireAccess level : HttpHandler =
return! redirectTo false "/web/small-group/log-on" next ctx return! redirectTo false "/web/small-group/log-on" next ctx
| _ -> | _ ->
let s = Views.I18N.localizer.Force () let s = Views.I18N.localizer.Force ()
addError ctx s.["You are not authorized to view the requested page."] addError ctx s["You are not authorized to view the requested page."]
return! redirectTo false "/web/unauthorized" next ctx return! redirectTo false "/web/unauthorized" next ctx
} }

24
src/PrayerTracker/Cookies.fs
View File

@ -10,10 +10,12 @@ open System.IO
/// Cryptography settings to use for encrypting cookies /// Cryptography settings to use for encrypting cookies
type CookieCrypto (key : string, iv : string) = type CookieCrypto (key : string, iv : string) =
/// The key for the AES encryptor/decryptor /// The key for the AES encryptor/decryptor
member __.Key = Convert.FromBase64String key member _.Key = Convert.FromBase64String key
/// The initialization vector for the AES encryptor/decryptor /// The initialization vector for the AES encryptor/decryptor
member __.IV = Convert.FromBase64String iv member _.IV = Convert.FromBase64String iv
/// Helpers for encrypting/decrypting cookies /// Helpers for encrypting/decrypting cookies
@ -62,14 +64,17 @@ type GroupCookie =
{ /// The Id of the small group { /// The Id of the small group
[<JsonProperty "g">] [<JsonProperty "g">]
GroupId : Guid GroupId : Guid
/// The password hash of the small group /// The password hash of the small group
[<JsonProperty "p">] [<JsonProperty "p">]
PasswordHash : string PasswordHash : string
} }
with with
/// Convert these properties to a cookie payload /// Convert these properties to a cookie payload
member this.toPayload () = member this.toPayload () =
encryptCookie this encryptCookie this
/// Create a set of strongly-typed properties from the cookie payload /// Create a set of strongly-typed properties from the cookie payload
static member fromPayload x = static member fromPayload x =
try decryptCookie<GroupCookie> x with _ -> None try decryptCookie<GroupCookie> x with _ -> None
@ -80,20 +85,25 @@ type TimeoutCookie =
{ /// The Id of the small group to which the user is currently logged in { /// The Id of the small group to which the user is currently logged in
[<JsonProperty "g">] [<JsonProperty "g">]
GroupId : Guid GroupId : Guid
/// The Id of the user who is currently logged in /// The Id of the user who is currently logged in
[<JsonProperty "i">] [<JsonProperty "i">]
Id : Guid Id : Guid
/// The salted timeout hash to ensure that there has been no tampering with the cookie /// The salted timeout hash to ensure that there has been no tampering with the cookie
[<JsonProperty "p">] [<JsonProperty "p">]
Password : string Password : string
/// How long this cookie is valid /// How long this cookie is valid
[<JsonProperty "u">] [<JsonProperty "u">]
Until : int64 Until : int64
} }
with with
/// Convert this set of properties to the cookie payload /// Convert this set of properties to the cookie payload
member this.toPayload () = member this.toPayload () =
encryptCookie this encryptCookie this
/// Create a strongly-typed timeout cookie from the cookie payload /// Create a strongly-typed timeout cookie from the cookie payload
static member fromPayload x = static member fromPayload x =
try decryptCookie<TimeoutCookie> x with _ -> None try decryptCookie<TimeoutCookie> x with _ -> None
@ -104,17 +114,21 @@ type UserCookie =
{ /// The Id of the group into to which the user is logged { /// The Id of the group into to which the user is logged
[< JsonProperty "g">] [< JsonProperty "g">]
GroupId : Guid GroupId : Guid
/// The Id of the user /// The Id of the user
[<JsonProperty "i">] [<JsonProperty "i">]
Id : Guid Id : Guid
/// The user's password hash /// The user's password hash
[<JsonProperty "p">] [<JsonProperty "p">]
PasswordHash : string PasswordHash : string
} }
with with
/// Convert this set of properties to a cookie payload /// Convert this set of properties to a cookie payload
member this.toPayload () = member this.toPayload () =
encryptCookie this encryptCookie this
/// Create the strongly-typed cookie properties from a cookie payload /// Create the strongly-typed cookie properties from a cookie payload
static member fromPayload x = static member fromPayload x =
try decryptCookie<UserCookie> x with _ -> None try decryptCookie<UserCookie> x with _ -> None

17
src/PrayerTracker/Email.fs
View File

@ -17,7 +17,7 @@ let getConnection () = task {
let client = new SmtpClient () let client = new SmtpClient ()
do! client.ConnectAsync ("127.0.0.1", 25, SecureSocketOptions.None) do! client.ConnectAsync ("127.0.0.1", 25, SecureSocketOptions.None)
return client return client
} }
/// Create a mail message object, filled with everything but the body content /// Create a mail message object, filled with everything but the body content
let createMessage (grp : SmallGroup) subj = let createMessage (grp : SmallGroup) subj =
@ -33,9 +33,9 @@ let createHtmlMessage grp subj body (s : IStringLocalizer) =
[ """<!DOCTYPE html><html xmlns="http://www.w3.org/1999/xhtml"><head><title></title></head><body>""" [ """<!DOCTYPE html><html xmlns="http://www.w3.org/1999/xhtml"><head><title></title></head><body>"""
body body
"""<hr><div style="text-align:right;font-family:Arial,Helvetica,sans-serif;font-size:8pt;padding-right:10px;">""" """<hr><div style="text-align:right;font-family:Arial,Helvetica,sans-serif;font-size:8pt;padding-right:10px;">"""
s.["Generated by P R A Y E R T R A C K E R"].Value s["Generated by P R A Y E R T R A C K E R"].Value
"<br><small>" "<br><small>"
s.["from Bit Badger Solutions"].Value s["from Bit Badger Solutions"].Value
"</small></div></body></html>" "</small></div></body></html>"
] ]
|> String.concat "" |> String.concat ""
@ -48,9 +48,9 @@ let createTextMessage grp subj body (s : IStringLocalizer) =
let bodyText = let bodyText =
[ body [ body
"\n\n--\n" "\n\n--\n"
s.["Generated by P R A Y E R T R A C K E R"].Value s["Generated by P R A Y E R T R A C K E R"].Value
"\n" "\n"
s.["from Bit Badger Solutions"].Value s["from Bit Badger Solutions"].Value
] ]
|> String.concat "" |> String.concat ""
let msg = createMessage grp subj let msg = createMessage grp subj
@ -63,7 +63,10 @@ let sendEmails (client : SmtpClient) (recipients : Member list) grp subj html te
let plainTextMsg = createTextMessage grp subj text s let plainTextMsg = createTextMessage grp subj text s
for mbr in recipients do for mbr in recipients do
let emailType = match mbr.format with Some f -> EmailFormat.fromCode f | None -> grp.preferences.defaultEmailType let emailType =
match mbr.format with
| Some f -> EmailFormat.fromCode f
| None -> grp.preferences.defaultEmailType
let emailTo = MailboxAddress (mbr.memberName, mbr.email) let emailTo = MailboxAddress (mbr.memberName, mbr.email)
match emailType with match emailType with
| HtmlFormat -> | HtmlFormat ->
@ -74,4 +77,4 @@ let sendEmails (client : SmtpClient) (recipients : Member list) grp subj html te
plainTextMsg.To.Add emailTo plainTextMsg.To.Add emailTo
do! client.SendAsync plainTextMsg do! client.SendAsync plainTextMsg
plainTextMsg.To.Clear () plainTextMsg.To.Clear ()
} }

36
src/PrayerTracker/Home.fs
View File

@ -1,34 +1,28 @@
module PrayerTracker.Handlers.Home module PrayerTracker.Handlers.Home
open System
open System.Globalization
open Giraffe open Giraffe
open Microsoft.AspNetCore.Http open Microsoft.AspNetCore.Http
open Microsoft.AspNetCore.Localization open Microsoft.AspNetCore.Localization
open PrayerTracker open PrayerTracker
open System
open System.Globalization
/// GET /error/[error-code] /// GET /error/[error-code]
let error code : HttpHandler = let error code : HttpHandler = requireAccess [ AccessLevel.Public ] >=> fun next ctx ->
requireAccess [ AccessLevel.Public ]
>=> fun next ctx ->
viewInfo ctx DateTime.Now.Ticks viewInfo ctx DateTime.Now.Ticks
|> Views.Home.error code |> Views.Home.error code
|> renderHtml next ctx |> renderHtml next ctx
/// GET / /// GET /
let homePage : HttpHandler = let homePage : HttpHandler = requireAccess [ AccessLevel.Public ] >=> fun next ctx ->
requireAccess [ AccessLevel.Public ]
>=> fun next ctx ->
viewInfo ctx DateTime.Now.Ticks viewInfo ctx DateTime.Now.Ticks
|> Views.Home.index |> Views.Home.index
|> renderHtml next ctx |> renderHtml next ctx
/// GET /language/[culture] /// GET /language/[culture]
let language culture : HttpHandler = let language culture : HttpHandler = requireAccess [ AccessLevel.Public ] >=> fun next ctx ->
requireAccess [ AccessLevel.Public ]
>=> fun next ctx ->
try try
match culture with match culture with
| null | null
@ -47,44 +41,36 @@ let language culture : HttpHandler =
CookieRequestCultureProvider.MakeCookieValue (RequestCulture c), CookieRequestCultureProvider.MakeCookieValue (RequestCulture c),
CookieOptions (Expires = Nullable<DateTimeOffset> (DateTimeOffset (DateTime.Now.AddYears 1)))) CookieOptions (Expires = Nullable<DateTimeOffset> (DateTimeOffset (DateTime.Now.AddYears 1))))
| _ -> () | _ -> ()
let url = match string ctx.Request.Headers.["Referer"] with null | "" -> "/web/" | r -> r let url = match string ctx.Request.Headers["Referer"] with null | "" -> "/web/" | r -> r
redirectTo false url next ctx redirectTo false url next ctx
/// GET /legal/privacy-policy /// GET /legal/privacy-policy
let privacyPolicy : HttpHandler = let privacyPolicy : HttpHandler = requireAccess [ AccessLevel.Public ] >=> fun next ctx ->
requireAccess [ AccessLevel.Public ]
>=> fun next ctx ->
viewInfo ctx DateTime.Now.Ticks viewInfo ctx DateTime.Now.Ticks
|> Views.Home.privacyPolicy |> Views.Home.privacyPolicy
|> renderHtml next ctx |> renderHtml next ctx
/// GET /legal/terms-of-service /// GET /legal/terms-of-service
let tos : HttpHandler = let tos : HttpHandler = requireAccess [ AccessLevel.Public ] >=> fun next ctx ->
requireAccess [ AccessLevel.Public ]
>=> fun next ctx ->
viewInfo ctx DateTime.Now.Ticks viewInfo ctx DateTime.Now.Ticks
|> Views.Home.termsOfService |> Views.Home.termsOfService
|> renderHtml next ctx |> renderHtml next ctx
/// GET /log-off /// GET /log-off
let logOff : HttpHandler = let logOff : HttpHandler = requireAccess [ AccessLevel.Public ] >=> fun next ctx ->
requireAccess [ AccessLevel.Public ]
>=> fun next ctx ->
ctx.Session.Clear () ctx.Session.Clear ()
// Remove cookies if they exist // Remove cookies if they exist
Key.Cookie.logOffCookies |> List.iter ctx.Response.Cookies.Delete Key.Cookie.logOffCookies |> List.iter ctx.Response.Cookies.Delete
let s = Views.I18N.localizer.Force () let s = Views.I18N.localizer.Force ()
addHtmlInfo ctx s.["Log Off Successful • Have a nice day!"] addHtmlInfo ctx s["Log Off Successful • Have a nice day!"]
redirectTo false "/web/" next ctx redirectTo false "/web/" next ctx
/// GET /unauthorized /// GET /unauthorized
let unauthorized : HttpHandler = let unauthorized : HttpHandler = requireAccess [ AccessLevel.Public ] >=> fun next ctx ->
requireAccess [ AccessLevel.Public ]
>=> fun next ctx ->
viewInfo ctx DateTime.Now.Ticks viewInfo ctx DateTime.Now.Ticks
|> Views.Home.unauthorized |> Views.Home.unauthorized
|> renderHtml next ctx |> renderHtml next ctx

153
src/PrayerTracker/PrayerRequest.fs
View File

@ -1,13 +1,13 @@
module PrayerTracker.Handlers.PrayerRequest module PrayerTracker.Handlers.PrayerRequest
open System
open System.Threading.Tasks
open Giraffe open Giraffe
open Microsoft.AspNetCore.Http open Microsoft.AspNetCore.Http
open NodaTime open NodaTime
open PrayerTracker open PrayerTracker
open PrayerTracker.Entities open PrayerTracker.Entities
open PrayerTracker.ViewModels open PrayerTracker.ViewModels
open System
open System.Threading.Tasks
/// Retrieve a prayer request, and ensure that it belongs to the current class /// Retrieve a prayer request, and ensure that it belongs to the current class
let private findRequest (ctx : HttpContext) reqId = task { let private findRequest (ctx : HttpContext) reqId = task {
@ -15,20 +15,18 @@ let private findRequest (ctx : HttpContext) reqId = task {
| Some req when req.smallGroupId = (currentGroup ctx).smallGroupId -> return Ok req | Some req when req.smallGroupId = (currentGroup ctx).smallGroupId -> return Ok req
| Some _ -> | Some _ ->
let s = Views.I18N.localizer.Force () let s = Views.I18N.localizer.Force ()
addError ctx s.["The prayer request you tried to access is not assigned to your group"] addError ctx s["The prayer request you tried to access is not assigned to your group"]
return Error (redirectTo false "/web/unauthorized") return Error (redirectTo false "/web/unauthorized")
| None -> return Error fourOhFour | None -> return Error fourOhFour
} }
/// Generate a list of requests for the given date /// Generate a list of requests for the given date
let private generateRequestList ctx date = let private generateRequestList ctx date = task {
let grp = currentGroup ctx let grp = currentGroup ctx
let clock = ctx.GetService<IClock> () let clock = ctx.GetService<IClock> ()
let listDate = let listDate = match date with Some d -> d | None -> grp.localDateNow clock
match date with let! reqs = ctx.db.AllRequestsForSmallGroup grp clock (Some listDate) true 0
| Some d -> d return
| None -> grp.localDateNow clock
let reqs = ctx.db.AllRequestsForSmallGroup grp clock (Some listDate) true 0
{ requests = reqs |> List.ofSeq { requests = reqs |> List.ofSeq
date = listDate date = listDate
listGroup = grp listGroup = grp
@ -36,6 +34,7 @@ let private generateRequestList ctx date =
canEmail = ctx.Session.user |> Option.isSome canEmail = ctx.Session.user |> Option.isSome
recipients = [] recipients = []
} }
}
/// Parse a string into a date (optionally, of course) /// Parse a string into a date (optionally, of course)
let private parseListDate (date : string option) = let private parseListDate (date : string option) =
@ -45,106 +44,92 @@ let private parseListDate (date : string option) =
/// GET /prayer-request/[request-id]/edit /// GET /prayer-request/[request-id]/edit
let edit (reqId : PrayerRequestId) : HttpHandler = let edit (reqId : PrayerRequestId) : HttpHandler = requireAccess [ User ] >=> fun next ctx -> task {
requireAccess [ User ]
>=> fun next ctx -> task {
let startTicks = DateTime.Now.Ticks let startTicks = DateTime.Now.Ticks
let grp = currentGroup ctx let grp = currentGroup ctx
let now = grp.localDateNow (ctx.GetService<IClock> ()) let now = grp.localDateNow (ctx.GetService<IClock> ())
match reqId = Guid.Empty with if reqId = Guid.Empty then
| true ->
return! return!
{ viewInfo ctx startTicks with script = [ "ckeditor/ckeditor" ]; helpLink = Some Help.editRequest } { viewInfo ctx startTicks with script = [ "ckeditor/ckeditor" ]; helpLink = Some Help.editRequest }
|> Views.PrayerRequest.edit EditRequest.empty (now.ToString "yyyy-MM-dd") ctx |> Views.PrayerRequest.edit EditRequest.empty (now.ToString "yyyy-MM-dd") ctx
|> renderHtml next ctx |> renderHtml next ctx
| false -> else
match! findRequest ctx reqId with match! findRequest ctx reqId with
| Ok req -> | Ok req ->
let s = Views.I18N.localizer.Force () let s = Views.I18N.localizer.Force ()
match req.isExpired now grp.preferences.daysToExpire with if req.isExpired now grp.preferences.daysToExpire then
| true ->
{ UserMessage.warning with { UserMessage.warning with
text = htmlLocString s.["This request is expired."] text = htmlLocString s["This request is expired."]
description = description =
s.["To make it active again, update it as necessary, leave “{0}” and “{1}” unchecked, and it will return as an active request.", s["To make it active again, update it as necessary, leave “{0}” and “{1}” unchecked, and it will return as an active request.",
s.["Expire Immediately"], s.["Check to not update the date"]] s["Expire Immediately"], s["Check to not update the date"]]
|> (htmlLocString >> Some) |> (htmlLocString >> Some)
} }
|> addUserMessage ctx |> addUserMessage ctx
| false -> ()
return! return!
{ viewInfo ctx startTicks with script = [ "ckeditor/ckeditor" ]; helpLink = Some Help.editRequest } { viewInfo ctx startTicks with script = [ "ckeditor/ckeditor" ]; helpLink = Some Help.editRequest }
|> Views.PrayerRequest.edit (EditRequest.fromRequest req) "" ctx |> Views.PrayerRequest.edit (EditRequest.fromRequest req) "" ctx
|> renderHtml next ctx |> renderHtml next ctx
| Error e -> return! e next ctx | Error e -> return! e next ctx
} }
/// GET /prayer-requests/email/[date] /// GET /prayer-requests/email/[date]
let email date : HttpHandler = let email date : HttpHandler = requireAccess [ User ] >=> fun next ctx -> task {
requireAccess [ User ]
>=> fun next ctx -> task {
let startTicks = DateTime.Now.Ticks let startTicks = DateTime.Now.Ticks
let s = Views.I18N.localizer.Force () let s = Views.I18N.localizer.Force ()
let listDate = parseListDate (Some date) let listDate = parseListDate (Some date)
let grp = currentGroup ctx let grp = currentGroup ctx
let list = generateRequestList ctx listDate let! list = generateRequestList ctx listDate
let! recipients = ctx.db.AllMembersForSmallGroup grp.smallGroupId let! recipients = ctx.db.AllMembersForSmallGroup grp.smallGroupId
use! client = Email.getConnection () use! client = Email.getConnection ()
do! Email.sendEmails client recipients 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 (list.asHtml s) (list.asText s) s
return! return!
viewInfo ctx startTicks viewInfo ctx startTicks
|> Views.PrayerRequest.email { list with recipients = recipients } |> Views.PrayerRequest.email { list with recipients = recipients }
|> renderHtml next ctx |> renderHtml next ctx
} }
/// POST /prayer-request/[request-id]/delete /// POST /prayer-request/[request-id]/delete
let delete reqId : HttpHandler = let delete reqId : HttpHandler = requireAccess [ User ] >=> validateCSRF >=> fun next ctx -> task {
requireAccess [ User ]
>=> validateCSRF
>=> fun next ctx -> task {
match! findRequest ctx reqId with match! findRequest ctx reqId with
| Ok req -> | Ok req ->
let s = Views.I18N.localizer.Force () let s = Views.I18N.localizer.Force ()
ctx.db.PrayerRequests.Remove req |> ignore ctx.db.PrayerRequests.Remove req |> ignore
let! _ = ctx.db.SaveChangesAsync () let! _ = ctx.db.SaveChangesAsync ()
addInfo ctx s.["The prayer request was deleted successfully"] addInfo ctx s["The prayer request was deleted successfully"]
return! redirectTo false "/web/prayer-requests" next ctx return! redirectTo false "/web/prayer-requests" next ctx
| Error e -> return! e next ctx | Error e -> return! e next ctx
} }
/// GET /prayer-request/[request-id]/expire /// GET /prayer-request/[request-id]/expire
let expire reqId : HttpHandler = let expire reqId : HttpHandler = requireAccess [ User ] >=> fun next ctx -> task {
requireAccess [ User ]
>=> fun next ctx -> task {
match! findRequest ctx reqId with match! findRequest ctx reqId with
| Ok req -> | Ok req ->
let s = Views.I18N.localizer.Force () let s = Views.I18N.localizer.Force ()
ctx.db.UpdateEntry { req with expiration = Forced } ctx.db.UpdateEntry { req with expiration = Forced }
let! _ = ctx.db.SaveChangesAsync () let! _ = ctx.db.SaveChangesAsync ()
addInfo ctx s.["Successfully {0} prayer request", s.["Expired"].Value.ToLower ()] addInfo ctx s["Successfully {0} prayer request", s["Expired"].Value.ToLower ()]
return! redirectTo false "/web/prayer-requests" next ctx return! redirectTo false "/web/prayer-requests" next ctx
| Error e -> return! e next ctx | Error e -> return! e next ctx
} }
/// GET /prayer-requests/[group-id]/list /// GET /prayer-requests/[group-id]/list
let list groupId : HttpHandler = let list groupId : HttpHandler = requireAccess [ AccessLevel.Public ] >=> fun next ctx -> task {
requireAccess [ AccessLevel.Public ]
>=> fun next ctx -> task {
let startTicks = DateTime.Now.Ticks let startTicks = DateTime.Now.Ticks
match! ctx.db.TryGroupById groupId with match! ctx.db.TryGroupById groupId with
| Some grp when grp.preferences.isPublic -> | Some grp when grp.preferences.isPublic ->
let clock = ctx.GetService<IClock> () let clock = ctx.GetService<IClock> ()
let reqs = ctx.db.AllRequestsForSmallGroup grp clock None true 0 let! reqs = ctx.db.AllRequestsForSmallGroup grp clock None true 0
return! return!
viewInfo ctx startTicks viewInfo ctx startTicks
|> Views.PrayerRequest.list |> Views.PrayerRequest.list
{ requests = List.ofSeq reqs { requests = reqs
date = grp.localDateNow clock date = grp.localDateNow clock
listGroup = grp listGroup = grp
showHeader = true showHeader = true
@ -154,92 +139,88 @@ let list groupId : HttpHandler =
|> renderHtml next ctx |> renderHtml next ctx
| Some _ -> | Some _ ->
let s = Views.I18N.localizer.Force () let s = Views.I18N.localizer.Force ()
addError ctx s.["The request list for the group you tried to view is not public."] addError ctx s["The request list for the group you tried to view is not public."]
return! redirectTo false "/web/unauthorized" next ctx return! redirectTo false "/web/unauthorized" next ctx
| None -> return! fourOhFour next ctx | None -> return! fourOhFour next ctx
} }
/// GET /prayer-requests/lists /// GET /prayer-requests/lists
let lists : HttpHandler = let lists : HttpHandler = requireAccess [ AccessLevel.Public ] >=> fun next ctx -> task {
requireAccess [ AccessLevel.Public ]
>=> fun next ctx -> task {
let startTicks = DateTime.Now.Ticks let startTicks = DateTime.Now.Ticks
let! grps = ctx.db.PublicAndProtectedGroups () let! groups = ctx.db.PublicAndProtectedGroups ()
return! return!
viewInfo ctx startTicks viewInfo ctx startTicks
|> Views.PrayerRequest.lists grps |> Views.PrayerRequest.lists groups
|> renderHtml next ctx |> renderHtml next ctx
} }
/// GET /prayer-requests[/inactive?] /// GET /prayer-requests[/inactive?]
/// - OR - /// - OR -
/// GET /prayer-requests?search=[search-query] /// GET /prayer-requests?search=[search-query]
let maintain onlyActive : HttpHandler = let maintain onlyActive : HttpHandler = requireAccess [ User ] >=> fun next ctx -> task {
requireAccess [ User ]
>=> fun next ctx ->
let startTicks = DateTime.Now.Ticks let startTicks = DateTime.Now.Ticks
let grp = currentGroup ctx let grp = currentGroup ctx
let pageNbr = let pageNbr =
match ctx.GetQueryStringValue "page" with match ctx.GetQueryStringValue "page" with
| Ok pg -> match Int32.TryParse pg with true, p -> p | false, _ -> 1 | Ok pg -> match Int32.TryParse pg with true, p -> p | false, _ -> 1
| Error _ -> 1 | Error _ -> 1
let m = let! m = backgroundTask {
match ctx.GetQueryStringValue "search" with match ctx.GetQueryStringValue "search" with
| Ok srch -> | Ok search ->
let! reqs = ctx.db.SearchRequestsForSmallGroup grp search pageNbr
return
{ MaintainRequests.empty with { MaintainRequests.empty with
requests = ctx.db.SearchRequestsForSmallGroup grp srch pageNbr requests = reqs
searchTerm = Some srch searchTerm = Some search
pageNbr = Some pageNbr pageNbr = Some pageNbr
} }
| Error _ -> | Error _ ->
let! reqs = ctx.db.AllRequestsForSmallGroup grp (ctx.GetService<IClock> ()) None onlyActive pageNbr
return
{ MaintainRequests.empty with { MaintainRequests.empty with
requests = ctx.db.AllRequestsForSmallGroup grp (ctx.GetService<IClock> ()) None onlyActive pageNbr requests = reqs
onlyActive = Some onlyActive onlyActive = Some onlyActive
pageNbr = match onlyActive with true -> None | false -> Some pageNbr pageNbr = match onlyActive with true -> None | false -> Some pageNbr
} }
}
return!
{ viewInfo ctx startTicks with helpLink = Some Help.maintainRequests } { viewInfo ctx startTicks with helpLink = Some Help.maintainRequests }
|> Views.PrayerRequest.maintain { m with smallGroup = grp } ctx |> Views.PrayerRequest.maintain { m with smallGroup = grp } ctx
|> renderHtml next ctx |> renderHtml next ctx
}
/// GET /prayer-request/print/[date] /// GET /prayer-request/print/[date]
let print date : HttpHandler = let print date : HttpHandler = requireAccess [ User; Group ] >=> fun next ctx -> task {
requireAccess [ User; Group ] let! list = generateRequestList ctx (parseListDate (Some date))
>=> fun next ctx -> return!
let list = parseListDate (Some date) |> generateRequestList ctx
Views.PrayerRequest.print list appVersion Views.PrayerRequest.print list appVersion
|> renderHtml next ctx |> renderHtml next ctx
}
/// GET /prayer-request/[request-id]/restore /// GET /prayer-request/[request-id]/restore
let restore reqId : HttpHandler = let restore reqId : HttpHandler = requireAccess [ User ] >=> fun next ctx -> task {
requireAccess [ User ]
>=> fun next ctx -> task {
match! findRequest ctx reqId with match! findRequest ctx reqId with
| Ok req -> | Ok req ->
let s = Views.I18N.localizer.Force () 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 () let! _ = ctx.db.SaveChangesAsync ()
addInfo ctx s.["Successfully {0} prayer request", s.["Restored"].Value.ToLower ()] addInfo ctx s["Successfully {0} prayer request", s["Restored"].Value.ToLower ()]
return! redirectTo false "/web/prayer-requests" next ctx return! redirectTo false "/web/prayer-requests" next ctx
| Error e -> return! e next ctx | Error e -> return! e next ctx
} }
/// POST /prayer-request/save /// POST /prayer-request/save
let save : HttpHandler = let save : HttpHandler = requireAccess [ User ] >=> validateCSRF >=> fun next ctx -> task {
requireAccess [ User ]
>=> validateCSRF
>=> fun next ctx -> task {
match! ctx.TryBindFormAsync<EditRequest> () with match! ctx.TryBindFormAsync<EditRequest> () with
| Ok m -> | Ok m ->
let! req = let! req =
match m.isNew () with if m.isNew () then Task.FromResult (Some { PrayerRequest.empty with prayerRequestId = Guid.NewGuid () })
| true -> Task.FromResult (Some { PrayerRequest.empty with prayerRequestId = Guid.NewGuid () }) else ctx.db.TryRequestById m.requestId
| false -> ctx.db.TryRequestById m.requestId
match req with match req with
| Some pr -> | Some pr ->
let upd8 = let upd8 =
@ -262,23 +243,23 @@ let save : HttpHandler =
} }
| false when Option.isSome m.skipDateUpdate && Option.get m.skipDateUpdate -> upd8 | false when Option.isSome m.skipDateUpdate && Option.get m.skipDateUpdate -> upd8
| false -> { upd8 with updatedDate = now } | false -> { upd8 with updatedDate = now }
|> (match m.isNew () with true -> ctx.db.AddEntry | false -> ctx.db.UpdateEntry) |> (if m.isNew () then ctx.db.AddEntry else ctx.db.UpdateEntry)
let! _ = ctx.db.SaveChangesAsync () let! _ = ctx.db.SaveChangesAsync ()
let s = Views.I18N.localizer.Force () let s = Views.I18N.localizer.Force ()
let act = match m.isNew () with true -> "Added" | false -> "Updated" let act = if m.isNew () then "Added" else "Updated"
addInfo ctx s.["Successfully {0} prayer request", s.[act].Value.ToLower ()] addInfo ctx s["Successfully {0} prayer request", s.[act].Value.ToLower ()]
return! redirectTo false "/web/prayer-requests" next ctx return! redirectTo false "/web/prayer-requests" next ctx
| None -> return! fourOhFour next ctx | None -> return! fourOhFour next ctx
| Error e -> return! bindError e next ctx | Error e -> return! bindError e next ctx
} }
/// GET /prayer-request/view/[date?] /// GET /prayer-request/view/[date?]
let view date : HttpHandler = let view date : HttpHandler = requireAccess [ User; Group ] >=> fun next ctx -> task {
requireAccess [ User; Group ]
>=> fun next ctx ->
let startTicks = DateTime.Now.Ticks let startTicks = DateTime.Now.Ticks
let list = parseListDate date |> generateRequestList ctx let! list = generateRequestList ctx (parseListDate date)
return!
viewInfo ctx startTicks viewInfo ctx startTicks
|> Views.PrayerRequest.view { list with showHeader = false } |> Views.PrayerRequest.view { list with showHeader = false }
|> renderHtml next ctx |> renderHtml next ctx
}

179
src/PrayerTracker/SmallGroup.fs
View File

@ -15,24 +15,19 @@ open System.Threading.Tasks
/// Set a small group "Remember Me" cookie /// Set a small group "Remember Me" cookie
let private setGroupCookie (ctx : HttpContext) pwHash = let private setGroupCookie (ctx : HttpContext) pwHash =
ctx.Response.Cookies.Append ctx.Response.Cookies.Append
(Key.Cookie.group, { GroupId = (currentGroup ctx).smallGroupId; PasswordHash = pwHash }.toPayload (), autoRefresh) (Key.Cookie.group, { GroupId = (currentGroup ctx).smallGroupId; PasswordHash = pwHash }.toPayload (),
autoRefresh)
/// GET /small-group/announcement /// GET /small-group/announcement
let announcement : HttpHandler = let announcement : HttpHandler = requireAccess [ User ] >=> fun next ctx ->
requireAccess [ User ] { viewInfo ctx DateTime.Now.Ticks with helpLink = Some Help.sendAnnouncement; script = [ "ckeditor/ckeditor" ] }
>=> fun next ctx ->
let startTicks = DateTime.Now.Ticks
{ viewInfo ctx startTicks 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 |> renderHtml next ctx
/// POST /small-group/[group-id]/delete /// POST /small-group/[group-id]/delete
let delete groupId : HttpHandler = let delete groupId : HttpHandler = requireAccess [ Admin ] >=> validateCSRF >=> fun next ctx -> task {
requireAccess [ Admin ]
>=> validateCSRF
>=> fun next ctx -> task {
let s = Views.I18N.localizer.Force () let s = Views.I18N.localizer.Force ()
match! ctx.db.TryGroupById groupId with match! ctx.db.TryGroupById groupId with
| Some grp -> | Some grp ->
@ -41,43 +36,37 @@ let delete groupId : HttpHandler =
ctx.db.RemoveEntry grp ctx.db.RemoveEntry grp
let! _ = ctx.db.SaveChangesAsync () let! _ = ctx.db.SaveChangesAsync ()
addInfo ctx addInfo ctx
s.["The group {0} and its {1} prayer request(s) were deleted successfully; revoked access from {2} user(s)", s["The group {0} and its {1} prayer request(s) were deleted successfully; revoked access from {2} user(s)",
grp.name, reqs, usrs] grp.name, reqs, usrs]
return! redirectTo false "/web/small-groups" next ctx return! redirectTo false "/web/small-groups" next ctx
| None -> return! fourOhFour next ctx | None -> return! fourOhFour next ctx
} }
/// POST /small-group/member/[member-id]/delete /// POST /small-group/member/[member-id]/delete
let deleteMember memberId : HttpHandler = let deleteMember memberId : HttpHandler = requireAccess [ User ] >=> validateCSRF >=> fun next ctx -> task {
requireAccess [ User ]
>=> validateCSRF
>=> fun next ctx -> task {
let s = Views.I18N.localizer.Force () let s = Views.I18N.localizer.Force ()
match! ctx.db.TryMemberById memberId with match! ctx.db.TryMemberById memberId with
| Some mbr when mbr.smallGroupId = (currentGroup ctx).smallGroupId -> | Some mbr when mbr.smallGroupId = (currentGroup ctx).smallGroupId ->
ctx.db.RemoveEntry mbr ctx.db.RemoveEntry mbr
let! _ = ctx.db.SaveChangesAsync () let! _ = ctx.db.SaveChangesAsync ()
addHtmlInfo ctx s.["The group member &ldquo;{0}&rdquo; was deleted successfully", mbr.memberName] addHtmlInfo ctx s["The group member &ldquo;{0}&rdquo; was deleted successfully", mbr.memberName]
return! redirectTo false "/web/small-group/members" next ctx return! redirectTo false "/web/small-group/members" next ctx
| Some _ | Some _
| None -> return! fourOhFour next ctx | None -> return! fourOhFour next ctx
} }
/// GET /small-group/[group-id]/edit /// GET /small-group/[group-id]/edit
let edit (groupId : SmallGroupId) : HttpHandler = let edit (groupId : SmallGroupId) : HttpHandler = requireAccess [ Admin ] >=> fun next ctx -> task {
requireAccess [ Admin ]
>=> fun next ctx -> task {
let startTicks = DateTime.Now.Ticks let startTicks = DateTime.Now.Ticks
let! churches = ctx.db.AllChurches () let! churches = ctx.db.AllChurches ()
match groupId = Guid.Empty with if groupId = Guid.Empty then
| true ->
return! return!
viewInfo ctx startTicks viewInfo ctx startTicks
|> Views.SmallGroup.edit EditSmallGroup.empty churches ctx |> Views.SmallGroup.edit EditSmallGroup.empty churches ctx
|> renderHtml next ctx |> renderHtml next ctx
| false -> else
match! ctx.db.TryGroupById groupId with match! ctx.db.TryGroupById groupId with
| Some grp -> | Some grp ->
return! return!
@ -85,25 +74,21 @@ let edit (groupId : SmallGroupId) : HttpHandler =
|> Views.SmallGroup.edit (EditSmallGroup.fromGroup grp) churches ctx |> Views.SmallGroup.edit (EditSmallGroup.fromGroup grp) churches ctx
|> renderHtml next ctx |> renderHtml next ctx
| None -> return! fourOhFour next ctx | None -> return! fourOhFour next ctx
} }
/// GET /small-group/member/[member-id]/edit /// GET /small-group/member/[member-id]/edit
let editMember (memberId : MemberId) : HttpHandler = let editMember (memberId : MemberId) : HttpHandler = requireAccess [ User ] >=> fun next ctx -> task {
requireAccess [ User ]
>=> fun next ctx ->
let startTicks = DateTime.Now.Ticks let startTicks = DateTime.Now.Ticks
let s = Views.I18N.localizer.Force () let s = Views.I18N.localizer.Force ()
let grp = currentGroup ctx let grp = currentGroup ctx
let typs = ReferenceList.emailTypeList grp.preferences.defaultEmailType s let typs = ReferenceList.emailTypeList grp.preferences.defaultEmailType s
task { if memberId = Guid.Empty then
match memberId = Guid.Empty with
| true ->
return! return!
viewInfo ctx startTicks viewInfo ctx startTicks
|> Views.SmallGroup.editMember EditMember.empty typs ctx |> Views.SmallGroup.editMember EditMember.empty typs ctx
|> renderHtml next ctx |> renderHtml next ctx
| false -> else
match! ctx.db.TryMemberById memberId with match! ctx.db.TryMemberById memberId with
| Some mbr when mbr.smallGroupId = grp.smallGroupId -> | Some mbr when mbr.smallGroupId = grp.smallGroupId ->
return! return!
@ -112,30 +97,23 @@ let editMember (memberId : MemberId) : HttpHandler =
|> renderHtml next ctx |> renderHtml next ctx
| Some _ | Some _
| None -> return! fourOhFour next ctx | None -> return! fourOhFour next ctx
} }
/// GET /small-group/log-on/[group-id?] /// GET /small-group/log-on/[group-id?]
let logOn (groupId : SmallGroupId option) : HttpHandler = let logOn (groupId : SmallGroupId option) : HttpHandler = requireAccess [ AccessLevel.Public ] >=> fun next ctx -> task {
requireAccess [ AccessLevel.Public ]
>=> fun next ctx ->
let startTicks = DateTime.Now.Ticks let startTicks = DateTime.Now.Ticks
task {
let! grps = ctx.db.ProtectedGroups () let! grps = ctx.db.ProtectedGroups ()
let grpId = match groupId with Some gid -> flatGuid gid | None -> "" let grpId = match groupId with Some gid -> flatGuid gid | None -> ""
return! return!
{ viewInfo ctx startTicks with helpLink = Some Help.logOn } { viewInfo ctx startTicks with helpLink = Some Help.logOn }
|> Views.SmallGroup.logOn grps grpId ctx |> Views.SmallGroup.logOn grps grpId ctx
|> renderHtml next ctx |> renderHtml next ctx
} }
/// POST /small-group/log-on/submit /// POST /small-group/log-on/submit
let logOnSubmit : HttpHandler = let logOnSubmit : HttpHandler = requireAccess [ AccessLevel.Public ] >=> validateCSRF >=> fun next ctx -> task {
requireAccess [ AccessLevel.Public ]
>=> validateCSRF
>=> fun next ctx ->
task {
match! ctx.TryBindFormAsync<GroupLogOn> () with match! ctx.TryBindFormAsync<GroupLogOn> () with
| Ok m -> | Ok m ->
let s = Views.I18N.localizer.Force () let s = Views.I18N.localizer.Force ()
@ -145,54 +123,45 @@ let logOnSubmit : HttpHandler =
match m.rememberMe with match m.rememberMe with
| Some x when x -> (setGroupCookie ctx << sha1Hash) m.password | Some x when x -> (setGroupCookie ctx << sha1Hash) m.password
| _ -> () | _ -> ()
addInfo ctx s.["Log On Successful • Welcome to {0}", s.["PrayerTracker"]] addInfo ctx s["Log On Successful • Welcome to {0}", s["PrayerTracker"]]
return! redirectTo false "/web/prayer-requests/view" next ctx return! redirectTo false "/web/prayer-requests/view" next ctx
| None -> | None ->
addError ctx s.["Password incorrect - login unsuccessful"] addError ctx s["Password incorrect - login unsuccessful"]
return! redirectTo false $"/web/small-group/log-on/{flatGuid m.smallGroupId}" next ctx return! redirectTo false $"/web/small-group/log-on/{flatGuid m.smallGroupId}" next ctx
| Error e -> return! bindError e next ctx | Error e -> return! bindError e next ctx
} }
/// GET /small-groups /// GET /small-groups
let maintain : HttpHandler = let maintain : HttpHandler = requireAccess [ Admin ] >=> fun next ctx -> task {
requireAccess [ Admin ]
>=> fun next ctx ->
let startTicks = DateTime.Now.Ticks let startTicks = DateTime.Now.Ticks
task {
let! grps = ctx.db.AllGroups () let! grps = ctx.db.AllGroups ()
return! return!
viewInfo ctx startTicks viewInfo ctx startTicks
|> Views.SmallGroup.maintain grps ctx |> Views.SmallGroup.maintain grps ctx
|> renderHtml next ctx |> renderHtml next ctx
} }
/// GET /small-group/members /// GET /small-group/members
let members : HttpHandler = let members : HttpHandler = requireAccess [ User ] >=> fun next ctx -> task {
requireAccess [ User ]
>=> fun next ctx ->
let startTicks = DateTime.Now.Ticks let startTicks = DateTime.Now.Ticks
let grp = currentGroup ctx let grp = currentGroup ctx
let s = Views.I18N.localizer.Force () let s = Views.I18N.localizer.Force ()
task {
let! mbrs = ctx.db.AllMembersForSmallGroup grp.smallGroupId let! mbrs = ctx.db.AllMembersForSmallGroup grp.smallGroupId
let typs = ReferenceList.emailTypeList grp.preferences.defaultEmailType s |> Map.ofSeq let typs = ReferenceList.emailTypeList grp.preferences.defaultEmailType s |> Map.ofSeq
return! return!
{ viewInfo ctx startTicks with helpLink = Some Help.maintainGroupMembers } { viewInfo ctx startTicks with helpLink = Some Help.maintainGroupMembers }
|> Views.SmallGroup.members mbrs typs ctx |> Views.SmallGroup.members mbrs typs ctx
|> renderHtml next ctx |> renderHtml next ctx
} }
/// GET /small-group /// GET /small-group
let overview : HttpHandler = let overview : HttpHandler = requireAccess [ User ] >=> fun next ctx -> task {
requireAccess [ User ]
>=> fun next ctx ->
let startTicks = DateTime.Now.Ticks let startTicks = DateTime.Now.Ticks
let clock = ctx.GetService<IClock> () let clock = ctx.GetService<IClock> ()
task { let! reqs = ctx.db.AllRequestsForSmallGroup (currentGroup ctx) clock None true 0
let reqs = ctx.db.AllRequestsForSmallGroup (currentGroup ctx) clock None true 0 |> List.ofSeq
let! reqCount = ctx.db.CountRequestsBySmallGroup (currentGroup ctx).smallGroupId let! reqCount = ctx.db.CountRequestsBySmallGroup (currentGroup ctx).smallGroupId
let! mbrCount = ctx.db.CountMembersForSmallGroup (currentGroup ctx).smallGroupId let! mbrCount = ctx.db.CountMembersForSmallGroup (currentGroup ctx).smallGroupId
let m = let m =
@ -211,36 +180,28 @@ let overview : HttpHandler =
viewInfo ctx startTicks viewInfo ctx startTicks
|> Views.SmallGroup.overview m |> Views.SmallGroup.overview m
|> renderHtml next ctx |> renderHtml next ctx
} }
/// GET /small-group/preferences /// GET /small-group/preferences
let preferences : HttpHandler = let preferences : HttpHandler = requireAccess [ User ] >=> fun next ctx -> task {
requireAccess [ User ]
>=> fun next ctx ->
let startTicks = DateTime.Now.Ticks let startTicks = DateTime.Now.Ticks
task {
let! tzs = ctx.db.AllTimeZones () let! tzs = ctx.db.AllTimeZones ()
return! return!
{ viewInfo ctx startTicks with helpLink = Some Help.groupPreferences } { 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 |> renderHtml next ctx
} }
/// POST /small-group/save /// POST /small-group/save
let save : HttpHandler = let save : HttpHandler = requireAccess [ Admin ] >=> validateCSRF >=> fun next ctx -> task {
requireAccess [ Admin ]
>=> validateCSRF
>=> fun next ctx ->
let s = Views.I18N.localizer.Force ()
task {
match! ctx.TryBindFormAsync<EditSmallGroup> () with match! ctx.TryBindFormAsync<EditSmallGroup> () with
| Ok m -> | Ok m ->
let s = Views.I18N.localizer.Force ()
let! group = let! group =
match m.isNew () with if m.isNew () then Task.FromResult (Some { SmallGroup.empty with smallGroupId = Guid.NewGuid () })
| true -> Task.FromResult<SmallGroup option>(Some { SmallGroup.empty with smallGroupId = Guid.NewGuid () }) else ctx.db.TryGroupById m.smallGroupId
| false -> ctx.db.TryGroupById m.smallGroupId
match group with match group with
| Some grp -> | Some grp ->
m.populateGroup grp m.populateGroup grp
@ -250,33 +211,23 @@ let save : HttpHandler =
ctx.db.AddEntry { grp.preferences with smallGroupId = grp.smallGroupId } ctx.db.AddEntry { grp.preferences with smallGroupId = grp.smallGroupId }
| grp -> ctx.db.UpdateEntry grp | grp -> ctx.db.UpdateEntry grp
let! _ = ctx.db.SaveChangesAsync () let! _ = ctx.db.SaveChangesAsync ()
let act = s.[match m.isNew () with true -> "Added" | false -> "Updated"].Value.ToLower () let act = s[if m.isNew () then "Added" else "Updated"].Value.ToLower ()
addHtmlInfo ctx s.["Successfully {0} group “{1}”", act, m.name] addHtmlInfo ctx s["Successfully {0} group “{1}”", act, m.name]
return! redirectTo false "/web/small-groups" next ctx return! redirectTo false "/web/small-groups" next ctx
| None -> return! fourOhFour next ctx | None -> return! fourOhFour next ctx
| Error e -> return! bindError e next ctx | Error e -> return! bindError e next ctx
} }
/// POST /small-group/member/save /// POST /small-group/member/save
let saveMember : HttpHandler = let saveMember : HttpHandler = requireAccess [ User ] >=> validateCSRF >=> fun next ctx -> task {
requireAccess [ User ]
>=> validateCSRF
>=> fun next ctx ->
task {
match! ctx.TryBindFormAsync<EditMember> () with match! ctx.TryBindFormAsync<EditMember> () with
| Ok m -> | Ok m ->
let grp = currentGroup ctx let grp = currentGroup ctx
let! mMbr = let! mMbr =
match m.isNew () with if m.isNew () then
| true -> Task.FromResult (Some { Member.empty with memberId = Guid.NewGuid (); smallGroupId = grp.smallGroupId })
Task.FromResult<Member option> else ctx.db.TryMemberById m.memberId
(Some
{ Member.empty with
memberId = Guid.NewGuid ()
smallGroupId = grp.smallGroupId
})
| false -> ctx.db.TryMemberById m.memberId
match mMbr with match mMbr with
| Some mbr when mbr.smallGroupId = grp.smallGroupId -> | Some mbr when mbr.smallGroupId = grp.smallGroupId ->
{ mbr with { mbr with
@ -284,29 +235,25 @@ let saveMember : HttpHandler =
email = m.emailAddress email = m.emailAddress
format = match m.emailType with "" | null -> None | _ -> Some m.emailType format = match m.emailType with "" | null -> None | _ -> Some m.emailType
} }
|> (match m.isNew () with true -> ctx.db.AddEntry | false -> ctx.db.UpdateEntry) |> (if m.isNew () then ctx.db.AddEntry else ctx.db.UpdateEntry)
let! _ = ctx.db.SaveChangesAsync () let! _ = ctx.db.SaveChangesAsync ()
let s = Views.I18N.localizer.Force () let s = Views.I18N.localizer.Force ()
let act = s.[match m.isNew () with true -> "Added" | false -> "Updated"].Value.ToLower () let act = s[if m.isNew () then "Added" else "Updated"].Value.ToLower ()
addInfo ctx s.["Successfully {0} group member", act] addInfo ctx s["Successfully {0} group member", act]
return! redirectTo false "/web/small-group/members" next ctx return! redirectTo false "/web/small-group/members" next ctx
| Some _ | Some _
| None -> return! fourOhFour next ctx | None -> return! fourOhFour next ctx
| Error e -> return! bindError e next ctx | Error e -> return! bindError e next ctx
} }
/// POST /small-group/preferences/save /// POST /small-group/preferences/save
let savePreferences : HttpHandler = let savePreferences : HttpHandler = requireAccess [ User ] >=> validateCSRF >=> fun next ctx -> task {
requireAccess [ User ]
>=> validateCSRF
>=> fun next ctx ->
task {
match! ctx.TryBindFormAsync<EditPreferences> () with match! ctx.TryBindFormAsync<EditPreferences> () with
| Ok m -> | Ok m ->
// Since the class is stored in the session, we'll use an intermediate instance to persist it; once that // Since the class is stored in the session, we'll use an intermediate instance to persist it; once that works,
// works, we can repopulate the session instance. That way, if the update fails, the page should still show // we can repopulate the session instance. That way, if the update fails, the page should still show the
// the database values, not the then out-of-sync session ones. // database values, not the then out-of-sync session ones.
match! ctx.db.TryGroupById (currentGroup ctx).smallGroupId with match! ctx.db.TryGroupById (currentGroup ctx).smallGroupId with
| Some grp -> | Some grp ->
let prefs = m.populatePreferences grp.preferences let prefs = m.populatePreferences grp.preferences
@ -315,20 +262,16 @@ let savePreferences : HttpHandler =
// Refresh session instance // 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 () let s = Views.I18N.localizer.Force ()
addInfo ctx s.["Group preferences updated successfully"] addInfo ctx s["Group preferences updated successfully"]
return! redirectTo false "/web/small-group/preferences" next ctx return! redirectTo false "/web/small-group/preferences" next ctx
| None -> return! fourOhFour next ctx | None -> return! fourOhFour next ctx
| Error e -> return! bindError e next ctx | Error e -> return! bindError e next ctx
} }
/// POST /small-group/announcement/send /// POST /small-group/announcement/send
let sendAnnouncement : HttpHandler = let sendAnnouncement : HttpHandler = requireAccess [ User ] >=> validateCSRF >=> fun next ctx -> task {
requireAccess [ User ]
>=> validateCSRF
>=> fun next ctx ->
let startTicks = DateTime.Now.Ticks let startTicks = DateTime.Now.Ticks
task {
match! ctx.TryBindFormAsync<Announcement> () with match! ctx.TryBindFormAsync<Announcement> () with
| Ok m -> | Ok m ->
let grp = currentGroup ctx let grp = currentGroup ctx
@ -349,8 +292,8 @@ let sendAnnouncement : HttpHandler =
| _ -> ctx.db.AllMembersForSmallGroup grp.smallGroupId | _ -> ctx.db.AllMembersForSmallGroup grp.smallGroupId
use! client = Email.getConnection () use! client = Email.getConnection ()
do! Email.sendEmails client recipients grp do! Email.sendEmails client recipients grp
s.["Announcement for {0} - {1:MMMM d, yyyy} {2}", s["Announcement for {0} - {1:MMMM d, yyyy} {2}", grp.name, now.Date,
grp.name, now.Date, (now.ToString "h:mm tt").ToLower ()].Value (now.ToString "h:mm tt").ToLower ()].Value
htmlText plainText s htmlText plainText s
// Add to the request list if desired // Add to the request list if desired
match m.sendToClass, m.addToRequestList with match m.sendToClass, m.addToRequestList with
@ -373,13 +316,13 @@ let sendAnnouncement : HttpHandler =
// Tell 'em what they've won, Johnny! // Tell 'em what they've won, Johnny!
let toWhom = let toWhom =
match m.sendToClass with match m.sendToClass with
| "N" -> s.["{0} users", s.["PrayerTracker"]].Value | "N" -> s["{0} users", s["PrayerTracker"]].Value
| _ -> s.["Group Members"].Value.ToLower () | _ -> s["Group Members"].Value.ToLower ()
let andAdded = match m.addToRequestList with Some x when x -> "and added it to the request list" | _ -> "" let andAdded = match m.addToRequestList with Some x when x -> "and added it to the request list" | _ -> ""
addInfo ctx s.["Successfully sent announcement to all {0} {1}", toWhom, s.[andAdded]] addInfo ctx s["Successfully sent announcement to all {0} {1}", toWhom, s[andAdded]]
return! return!
viewInfo ctx startTicks viewInfo ctx startTicks
|> Views.SmallGroup.announcementSent { m with text = htmlText } |> Views.SmallGroup.announcementSent { m with text = htmlText }
|> renderHtml next ctx |> renderHtml next ctx
| Error e -> return! bindError e next ctx | Error e -> return! bindError e next ctx
} }

141
src/PrayerTracker/User.fs
View File

@ -1,5 +1,9 @@
module PrayerTracker.Handlers.User module PrayerTracker.Handlers.User
open System
open System.Collections.Generic
open System.Net
open System.Threading.Tasks
open Giraffe open Giraffe
open Microsoft.AspNetCore.Html open Microsoft.AspNetCore.Html
open Microsoft.AspNetCore.Http open Microsoft.AspNetCore.Http
@ -8,10 +12,6 @@ open PrayerTracker.Cookies
open PrayerTracker.Entities open PrayerTracker.Entities
open PrayerTracker.ViewModels open PrayerTracker.ViewModels
open PrayerTracker.Views.CommonFunctions open PrayerTracker.Views.CommonFunctions
open System
open System.Collections.Generic
open System.Net
open System.Threading.Tasks
/// Set the user's "remember me" cookie /// Set the user's "remember me" cookie
let private setUserCookie (ctx : HttpContext) pwHash = let private setUserCookie (ctx : HttpContext) pwHash =
@ -27,9 +27,9 @@ let private findUserByPassword m (db : AppDbContext) = task {
| Some u when Option.isSome u.salt -> | Some u when Option.isSome u.salt ->
// Already upgraded; match = success // Already upgraded; match = success
let pwHash = pbkdf2Hash (Option.get u.salt) m.password let pwHash = pbkdf2Hash (Option.get u.salt) m.password
match u.passwordHash = pwHash with if u.passwordHash = pwHash then
| true -> return Some { u with passwordHash = ""; salt = None; smallGroups = List<UserSmallGroup>() }, pwHash return Some { u with passwordHash = ""; salt = None; smallGroups = List<UserSmallGroup>() }, pwHash
| _ -> return None, "" else return None, ""
| Some u when u.passwordHash = sha1Hash m.password -> | Some u when u.passwordHash = sha1Hash m.password ->
// Not upgraded, but password is good; upgrade 'em! // Not upgraded, but password is good; upgrade 'em!
// Upgrade 'em! // Upgrade 'em!
@ -40,14 +40,11 @@ let private findUserByPassword m (db : AppDbContext) = task {
let! _ = db.SaveChangesAsync () let! _ = db.SaveChangesAsync ()
return Some { u with passwordHash = ""; salt = None; smallGroups = List<UserSmallGroup>() }, pwHash return Some { u with passwordHash = ""; salt = None; smallGroups = List<UserSmallGroup>() }, pwHash
| _ -> return None, "" | _ -> return None, ""
} }
/// POST /user/password/change /// POST /user/password/change
let changePassword : HttpHandler = let changePassword : HttpHandler = requireAccess [ User ] >=> validateCSRF >=> fun next ctx -> task {
requireAccess [ User ]
>=> validateCSRF
>=> fun next ctx -> task {
match! ctx.TryBindFormAsync<ChangePassword> () with match! ctx.TryBindFormAsync<ChangePassword> () with
| Ok m -> | Ok m ->
let s = Views.I18N.localizer.Force () let s = Views.I18N.localizer.Force ()
@ -57,55 +54,47 @@ let changePassword : HttpHandler =
match dbUsr with match dbUsr with
| Some usr -> | Some usr ->
// Check the old password against a possibly non-salted hash // Check the old password against a possibly non-salted hash
(match usr.salt with | Some salt -> pbkdf2Hash salt | _ -> sha1Hash) m.oldPassword (match usr.salt with Some salt -> pbkdf2Hash salt | None -> sha1Hash) m.oldPassword
|> ctx.db.TryUserLogOnByCookie curUsr.userId (currentGroup ctx).smallGroupId |> ctx.db.TryUserLogOnByCookie curUsr.userId (currentGroup ctx).smallGroupId
| _ -> Task.FromResult None | _ -> Task.FromResult None
match user with match user with
| Some _ when m.newPassword = m.newPasswordConfirm -> | Some _ when m.newPassword = m.newPasswordConfirm ->
match dbUsr with match dbUsr with
| Some usr -> | Some usr ->
// Generate salt if it has not been already // Generate new salt whenever the password is changed
let salt = match usr.salt with Some s -> s | _ -> Guid.NewGuid () 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 () let! _ = ctx.db.SaveChangesAsync ()
// If the user is remembered, update the cookie with the new hash // If the user is remembered, update the cookie with the new hash
match ctx.Request.Cookies.Keys.Contains Key.Cookie.user with if ctx.Request.Cookies.Keys.Contains Key.Cookie.user then setUserCookie ctx usr.passwordHash
| true -> setUserCookie ctx usr.passwordHash addInfo ctx s["Your password was changed successfully"]
| _ -> () | None -> addError ctx s["Unable to change password"]
addInfo ctx s.["Your password was changed successfully"]
| None -> addError ctx s.["Unable to change password"]
return! redirectTo false "/web/" next ctx return! redirectTo false "/web/" next ctx
| Some _ -> | Some _ ->
addError ctx s.["The new passwords did not match - your password was NOT changed"] addError ctx s["The new passwords did not match - your password was NOT changed"]
return! redirectTo false "/web/user/password" next ctx return! redirectTo false "/web/user/password" next ctx
| None -> | None ->
addError ctx s.["The old password was incorrect - your password was NOT changed"] addError ctx s["The old password was incorrect - your password was NOT changed"]
return! redirectTo false "/web/user/password" next ctx return! redirectTo false "/web/user/password" next ctx
| Error e -> return! bindError e next ctx | Error e -> return! bindError e next ctx
} }
/// POST /user/[user-id]/delete /// POST /user/[user-id]/delete
let delete userId : HttpHandler = let delete userId : HttpHandler = requireAccess [ Admin ] >=> validateCSRF >=> fun next ctx -> task {
requireAccess [ Admin ]
>=> validateCSRF
>=> fun next ctx -> task {
match! ctx.db.TryUserById userId with match! ctx.db.TryUserById userId with
| Some user -> | Some user ->
ctx.db.RemoveEntry user ctx.db.RemoveEntry user
let! _ = ctx.db.SaveChangesAsync () let! _ = ctx.db.SaveChangesAsync ()
let s = Views.I18N.localizer.Force () let s = Views.I18N.localizer.Force ()
addInfo ctx s.["Successfully deleted user {0}", user.fullName] addInfo ctx s["Successfully deleted user {0}", user.fullName]
return! redirectTo false "/web/users" next ctx return! redirectTo false "/web/users" next ctx
| _ -> return! fourOhFour next ctx | _ -> return! fourOhFour next ctx
} }
/// POST /user/log-on /// POST /user/log-on
let doLogOn : HttpHandler = let doLogOn : HttpHandler = requireAccess [ AccessLevel.Public ] >=> validateCSRF >=> fun next ctx -> task {
requireAccess [ AccessLevel.Public ]
>=> validateCSRF
>=> fun next ctx -> task {
match! ctx.TryBindFormAsync<UserLogOn> () with match! ctx.TryBindFormAsync<UserLogOn> () with
| Ok m -> | Ok m ->
let s = Views.I18N.localizer.Force () let s = Views.I18N.localizer.Force ()
@ -117,7 +106,7 @@ let doLogOn : HttpHandler =
ctx.Session.user <- usr ctx.Session.user <- usr
ctx.Session.smallGroup <- grp ctx.Session.smallGroup <- grp
match m.rememberMe with Some x when x -> setUserCookie ctx pwHash | _ -> () match m.rememberMe with Some x when x -> setUserCookie ctx pwHash | _ -> ()
addHtmlInfo ctx s.["Log On Successful • Welcome to {0}", s.["PrayerTracker"]] addHtmlInfo ctx s["Log On Successful • Welcome to {0}", s["PrayerTracker"]]
match m.redirectUrl with match m.redirectUrl with
| None -> "/web/small-group" | None -> "/web/small-group"
| Some x when x = "" -> "/web/small-group" | Some x when x = "" -> "/web/small-group"
@ -125,15 +114,16 @@ let doLogOn : HttpHandler =
| _ -> | _ ->
let grpName = match grp with Some g -> g.name | _ -> "N/A" let grpName = match grp with Some g -> g.name | _ -> "N/A"
{ UserMessage.error with { UserMessage.error with
text = htmlLocString s.["Invalid credentials - log on unsuccessful"] text = htmlLocString s["Invalid credentials - log on unsuccessful"]
description = description =
[ s.["This is likely due to one of the following reasons"].Value [ s["This is likely due to one of the following reasons"].Value
":<ul><li>" ":<ul><li>"
s.["The e-mail address “{0}” is invalid.", WebUtility.HtmlEncode m.emailAddress].Value s["The e-mail address “{0}” is invalid.", WebUtility.HtmlEncode m.emailAddress].Value
"</li><li>" "</li><li>"
s.["The password entered does not match the password for the given e-mail address."].Value s["The password entered does not match the password for the given e-mail address."].Value
"</li><li>" "</li><li>"
s.["You are not authorized to administer the group “{0}”.", WebUtility.HtmlEncode grpName].Value s["You are not authorized to administer the group “{0}”.",
WebUtility.HtmlEncode grpName].Value
"</li></ul>" "</li></ul>"
] ]
|> String.concat "" |> String.concat ""
@ -143,21 +133,18 @@ let doLogOn : HttpHandler =
"/web/user/log-on" "/web/user/log-on"
return! redirectTo false nextUrl next ctx return! redirectTo false nextUrl next ctx
| Error e -> return! bindError e next ctx | Error e -> return! bindError e next ctx
} }
/// GET /user/[user-id]/edit /// GET /user/[user-id]/edit
let edit (userId : UserId) : HttpHandler = let edit (userId : UserId) : HttpHandler = requireAccess [ Admin ] >=> fun next ctx -> task {
requireAccess [ Admin ]
>=> fun next ctx -> task {
let startTicks = DateTime.Now.Ticks let startTicks = DateTime.Now.Ticks
match userId = Guid.Empty with if userId = Guid.Empty then
| true ->
return! return!
viewInfo ctx startTicks viewInfo ctx startTicks
|> Views.User.edit EditUser.empty ctx |> Views.User.edit EditUser.empty ctx
|> renderHtml next ctx |> renderHtml next ctx
| false -> else
match! ctx.db.TryUserById userId with match! ctx.db.TryUserById userId with
| Some user -> | Some user ->
return! return!
@ -165,13 +152,11 @@ let edit (userId : UserId) : HttpHandler =
|> Views.User.edit (EditUser.fromUser user) ctx |> Views.User.edit (EditUser.fromUser user) ctx
|> renderHtml next ctx |> renderHtml next ctx
| _ -> return! fourOhFour next ctx | _ -> return! fourOhFour next ctx
} }
/// GET /user/log-on /// GET /user/log-on
let logOn : HttpHandler = let logOn : HttpHandler = requireAccess [ AccessLevel.Public ] >=> fun next ctx -> task {
requireAccess [ AccessLevel.Public ]
>=> fun next ctx -> task {
let startTicks = DateTime.Now.Ticks let startTicks = DateTime.Now.Ticks
let s = Views.I18N.localizer.Force () let s = Views.I18N.localizer.Force ()
let! groups = ctx.db.GroupList () let! groups = ctx.db.GroupList ()
@ -179,48 +164,40 @@ let logOn : HttpHandler =
match url with match url with
| Some _ -> | Some _ ->
ctx.Session.Remove Key.Session.redirectUrl ctx.Session.Remove Key.Session.redirectUrl
addWarning ctx s.["The page you requested requires authentication; please log on below."] addWarning ctx s["The page you requested requires authentication; please log on below."]
| None -> () | None -> ()
return! return!
{ viewInfo ctx startTicks with helpLink = Some Help.logOn } { viewInfo ctx startTicks with helpLink = Some Help.logOn }
|> Views.User.logOn { UserLogOn.empty with redirectUrl = url } groups ctx |> Views.User.logOn { UserLogOn.empty with redirectUrl = url } groups ctx
|> renderHtml next ctx |> renderHtml next ctx
} }
/// GET /users /// GET /users
let maintain : HttpHandler = let maintain : HttpHandler = requireAccess [ Admin ] >=> fun next ctx -> task {
requireAccess [ Admin ]
>=> fun next ctx -> task {
let startTicks = DateTime.Now.Ticks let startTicks = DateTime.Now.Ticks
let! users = ctx.db.AllUsers () let! users = ctx.db.AllUsers ()
return! return!
viewInfo ctx startTicks viewInfo ctx startTicks
|> Views.User.maintain users ctx |> Views.User.maintain users ctx
|> renderHtml next ctx |> renderHtml next ctx
} }
/// GET /user/password /// GET /user/password
let password : HttpHandler = let password : HttpHandler = requireAccess [ User ] >=> fun next ctx ->
requireAccess [ User ]
>=> fun next ctx ->
{ viewInfo ctx DateTime.Now.Ticks with helpLink = Some Help.changePassword } { viewInfo ctx DateTime.Now.Ticks with helpLink = Some Help.changePassword }
|> Views.User.changePassword ctx |> Views.User.changePassword ctx
|> renderHtml next ctx |> renderHtml next ctx
/// POST /user/save /// POST /user/save
let save : HttpHandler = let save : HttpHandler = requireAccess [ Admin ] >=> validateCSRF >=> fun next ctx -> task {
requireAccess [ Admin ]
>=> validateCSRF
>=> fun next ctx -> task {
match! ctx.TryBindFormAsync<EditUser> () with match! ctx.TryBindFormAsync<EditUser> () with
| Ok m -> | Ok m ->
let! user = let! user =
match m.isNew () with if m.isNew () then Task.FromResult (Some { User.empty with userId = Guid.NewGuid () })
| true -> Task.FromResult (Some { User.empty with userId = Guid.NewGuid () }) else ctx.db.TryUserById m.userId
| false -> ctx.db.TryUserById m.userId
let saltedUser = let saltedUser =
match user with match user with
| Some u -> | Some u ->
@ -235,40 +212,36 @@ let save : HttpHandler =
match saltedUser with match saltedUser with
| Some u -> | Some u ->
let updatedUser = m.populateUser u (pbkdf2Hash (Option.get u.salt)) let updatedUser = m.populateUser u (pbkdf2Hash (Option.get u.salt))
updatedUser |> (match m.isNew () with true -> ctx.db.AddEntry | false -> ctx.db.UpdateEntry) updatedUser |> (if m.isNew () then ctx.db.AddEntry else ctx.db.UpdateEntry)
let! _ = ctx.db.SaveChangesAsync () let! _ = ctx.db.SaveChangesAsync ()
let s = Views.I18N.localizer.Force () let s = Views.I18N.localizer.Force ()
match m.isNew () with if m.isNew () then
| true ->
let h = CommonFunctions.htmlString let h = CommonFunctions.htmlString
{ UserMessage.info with { UserMessage.info with
text = h s.["Successfully {0} user", s.["Added"].Value.ToLower ()] text = h s["Successfully {0} user", s["Added"].Value.ToLower ()]
description = description =
h s.["Please select at least one group for which this user ({0}) is authorized", h s["Please select at least one group for which this user ({0}) is authorized",
updatedUser.fullName] updatedUser.fullName]
|> Some |> Some
} }
|> addUserMessage ctx |> addUserMessage ctx
return! redirectTo false $"/web/user/{flatGuid u.userId}/small-groups" next ctx return! redirectTo false $"/web/user/{flatGuid u.userId}/small-groups" next ctx
| false -> else
addInfo ctx s.["Successfully {0} user", s.["Updated"].Value.ToLower ()] addInfo ctx s["Successfully {0} user", s["Updated"].Value.ToLower ()]
return! redirectTo false "/web/users" next ctx return! redirectTo false "/web/users" next ctx
| None -> return! fourOhFour next ctx | None -> return! fourOhFour next ctx
| Error e -> return! bindError e next ctx | Error e -> return! bindError e next ctx
} }
/// POST /user/small-groups/save /// POST /user/small-groups/save
let saveGroups : HttpHandler = let saveGroups : HttpHandler = requireAccess [ Admin ] >=> validateCSRF >=> fun next ctx -> task {
requireAccess [ Admin ]
>=> validateCSRF
>=> fun next ctx -> task {
match! ctx.TryBindFormAsync<AssignGroups> () with match! ctx.TryBindFormAsync<AssignGroups> () with
| Ok m -> | Ok m ->
let s = Views.I18N.localizer.Force () let s = Views.I18N.localizer.Force ()
match Seq.length m.smallGroups with match Seq.length m.smallGroups with
| 0 -> | 0 ->
addError ctx s.["You must select at least one group to assign"] addError ctx s["You must select at least one group to assign"]
return! redirectTo false $"/web/user/{flatGuid m.userId}/small-groups" next ctx return! redirectTo false $"/web/user/{flatGuid m.userId}/small-groups" next ctx
| _ -> | _ ->
match! ctx.db.TryUserByIdWithGroups m.userId with match! ctx.db.TryUserByIdWithGroups m.userId with
@ -287,17 +260,15 @@ let saveGroups : HttpHandler =
|> List.ofSeq |> List.ofSeq
|> List.iter ctx.db.AddEntry |> List.iter ctx.db.AddEntry
let! _ = ctx.db.SaveChangesAsync () let! _ = ctx.db.SaveChangesAsync ()
addInfo ctx s.["Successfully updated group permissions for {0}", m.userName] addInfo ctx s["Successfully updated group permissions for {0}", m.userName]
return! redirectTo false "/web/users" next ctx return! redirectTo false "/web/users" next ctx
| _ -> return! fourOhFour next ctx | _ -> return! fourOhFour next ctx
| Error e -> return! bindError e next ctx | Error e -> return! bindError e next ctx
} }
/// GET /user/[user-id]/small-groups /// GET /user/[user-id]/small-groups
let smallGroups userId : HttpHandler = let smallGroups userId : HttpHandler = requireAccess [ Admin ] >=> fun next ctx -> task {
requireAccess [ Admin ]
>=> fun next ctx -> task {
let startTicks = DateTime.Now.Ticks let startTicks = DateTime.Now.Ticks
match! ctx.db.TryUserByIdWithGroups userId with match! ctx.db.TryUserByIdWithGroups userId with
| Some user -> | Some user ->
@ -308,4 +279,4 @@ let smallGroups userId : HttpHandler =
|> Views.User.assignGroups (AssignGroups.fromUser user) grps curGroups ctx |> Views.User.assignGroups (AssignGroups.fromUser user) grps curGroups ctx
|> renderHtml next ctx |> renderHtml next ctx
| None -> return! fourOhFour next ctx | None -> return! fourOhFour next ctx
} }