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

Version 8 #43

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

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

@ -69,7 +69,11 @@ type AppDbContext (options : DbContextOptions<AppDbContext>) =
member this.AsyncSaveChanges () =
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
modelBuilder.HasDefaultSchema "pt" |> ignore

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

@ -1,39 +1,33 @@
[<AutoOpen>]
module PrayerTracker.DataAccess
open Microsoft.EntityFrameworkCore
open PrayerTracker.Entities
open System.Collections.Generic
open System.Linq
open PrayerTracker.Entities
[<AutoOpen>]
module private Helpers =
open Microsoft.FSharpLu
open System.Threading.Tasks
/// Central place to append sort criteria for prayer request queries
let reqSort sort (q : IQueryable<PrayerRequest>) =
match sort with
| SortByDate ->
query {
for req in q do
sortByDescending req.updatedDate
thenByDescending req.enteredDate
thenBy req.requestor
}
q.OrderByDescending(fun req -> req.updatedDate)
.ThenByDescending(fun req -> req.enteredDate)
.ThenBy (fun req -> req.requestor)
| SortByRequestor ->
query {
for req in q do
sortBy req.requestor
thenByDescending req.updatedDate
thenByDescending req.enteredDate
}
q.OrderBy(fun req -> req.requestor)
.ThenByDescending(fun req -> req.updatedDate)
.ThenByDescending (fun req -> req.enteredDate)
/// Convert a possibly-null object to an option, wrapped as a task
let toOptionTask<'T> (item : 'T) = (Option.fromObject >> Task.FromResult) item
/// Paginate a prayer request query
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
(*-- DISCONNECTED DATA EXTENSIONS --*)
@ -53,328 +47,241 @@ type AppDbContext with
(*-- CHURCH EXTENSIONS --*)
/// Find a church by its Id
member this.TryChurchById cId =
query {
for ch in this.Churches.AsNoTracking () do
where (ch.churchId = cId)
exactlyOneOrDefault
member this.TryChurchById cId = backgroundTask {
let! church = this.Churches.SingleOrDefaultAsync (fun ch -> ch.churchId = cId)
return Option.fromObject church
}
|> toOptionTask
/// Find all churches
member this.AllChurches () =
task {
let q =
query {
for ch in this.Churches.AsNoTracking () do
sortBy ch.name
}
let! churches = q.ToListAsync ()
member this.AllChurches () = backgroundTask {
let! churches = this.Churches.OrderBy(fun ch -> ch.name).ToListAsync ()
return List.ofSeq churches
}
(*-- MEMBER EXTENSIONS --*)
/// Get a small group member by its Id
member this.TryMemberById mId =
query {
for mbr in this.Members.AsNoTracking () do
where (mbr.memberId = mId)
select mbr
exactlyOneOrDefault
member this.TryMemberById mbrId = backgroundTask {
let! mbr = this.Members.SingleOrDefaultAsync (fun m -> m.memberId = mbrId)
return Option.fromObject mbr
}
|> toOptionTask
/// Find all members for a small group
member this.AllMembersForSmallGroup gId =
task {
let q =
query {
for mbr in this.Members.AsNoTracking () do
where (mbr.smallGroupId = gId)
sortBy mbr.memberName
}
let! mbrs = q.ToListAsync ()
return List.ofSeq mbrs
member this.AllMembersForSmallGroup gId = backgroundTask {
let! members =
this.Members.Where(fun mbr -> mbr.smallGroupId = gId)
.OrderBy(fun mbr -> mbr.memberName)
.ToListAsync ()
return List.ofSeq members
}
/// Count members for a small group
member this.CountMembersForSmallGroup gId =
this.Members.CountAsync (fun m -> m.smallGroupId = gId)
member this.CountMembersForSmallGroup gId = backgroundTask {
return! this.Members.CountAsync (fun m -> m.smallGroupId = gId)
}
(*-- PRAYER REQUEST EXTENSIONS --*)
/// Get a prayer request by its Id
member this.TryRequestById reqId =
query {
for req in this.PrayerRequests.AsNoTracking () do
where (req.prayerRequestId = reqId)
exactlyOneOrDefault
member this.TryRequestById reqId = backgroundTask {
let! req = this.PrayerRequests.SingleOrDefaultAsync (fun r -> r.prayerRequestId = reqId)
return Option.fromObject req
}
|> toOptionTask
/// 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 : PrayerRequest seq =
member this.AllRequestsForSmallGroup (grp : SmallGroup) clock listDate activeOnly pageNbr = backgroundTask {
let theDate = match listDate with Some dt -> dt | _ -> grp.localDateNow clock
query {
for req in this.PrayerRequests.AsNoTracking () do
where (req.smallGroupId = grp.smallGroupId)
}
let query =
this.PrayerRequests.Where(fun req -> req.smallGroupId = grp.smallGroupId)
|> function
| q when activeOnly ->
let asOf = theDate.AddDays(-(float grp.preferences.daysToExpire)).Date
query {
for req in q do
where ( ( req.updatedDate > asOf
q.Where(fun req ->
( req.updatedDate > asOf
|| req.expiration = Manual
|| req.requestType = LongTermRequest
|| req.requestType = Expecting)
&& req.expiration <> Forced)
}
| q -> q
|> reqSort grp.preferences.requestSort
|> function
| q ->
match activeOnly with
| true -> upcast q
| false ->
upcast query {
for req in q do
skip ((pageNbr - 1) * grp.preferences.pageSize)
take grp.preferences.pageSize
|> paginate pageNbr grp.preferences.pageSize
| q -> reqSort grp.preferences.requestSort q
let! reqs = query.ToListAsync ()
return List.ofSeq reqs
}
/// Count prayer requests for the given small group Id
member this.CountRequestsBySmallGroup gId =
this.PrayerRequests.CountAsync (fun pr -> pr.smallGroupId = gId)
member this.CountRequestsBySmallGroup gId = backgroundTask {
return! this.PrayerRequests.CountAsync (fun pr -> pr.smallGroupId = gId)
}
/// Count prayer requests for the given church Id
member this.CountRequestsByChurch cId =
this.PrayerRequests.CountAsync (fun pr -> pr.smallGroup.churchId = cId)
member this.CountRequestsByChurch cId = backgroundTask {
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
// TODO: same as above...
member this.SearchRequestsForSmallGroup (grp : SmallGroup) (searchTerm : string) pageNbr : PrayerRequest seq =
let pgSz = grp.preferences.pageSize
let toSkip = (pageNbr - 1) * pgSz
let sql =
""" SELECT * FROM pt."PrayerRequest" WHERE "SmallGroupId" = {0} AND "Text" ILIKE {1}
member this.SearchRequestsForSmallGroup (grp : SmallGroup) (searchTerm : string) pageNbr = backgroundTask {
let sql = """
SELECT * FROM pt."PrayerRequest" WHERE "SmallGroupId" = {0} AND "Text" ILIKE {1}
UNION
SELECT * FROM pt."PrayerRequest" WHERE "SmallGroupId" = {0} AND COALESCE("Requestor", '') ILIKE {1}"""
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
|> function
| q ->
upcast query {
for req in q do
skip toSkip
take pgSz
|> paginate pageNbr grp.preferences.pageSize
let! reqs = query.ToListAsync ()
return List.ofSeq reqs
}
(*-- SMALL GROUP EXTENSIONS --*)
/// Find a small group by its Id
member this.TryGroupById gId =
query {
for grp in this.SmallGroups.AsNoTracking().Include (fun sg -> sg.preferences) do
where (grp.smallGroupId = gId)
exactlyOneOrDefault
member this.TryGroupById gId = backgroundTask {
let! grp =
this.SmallGroups.Include(fun sg -> sg.preferences)
.SingleOrDefaultAsync (fun sg -> sg.smallGroupId = gId)
return Option.fromObject grp
}
|> toOptionTask
/// Get small groups that are public or password protected
member this.PublicAndProtectedGroups () =
task {
let smallGroups = this.SmallGroups.AsNoTracking().Include(fun sg -> sg.preferences).Include (fun sg -> sg.church)
let q =
query {
for grp in smallGroups do
where ( grp.preferences.isPublic
|| (grp.preferences.groupPassword <> null && grp.preferences.groupPassword <> ""))
sortBy grp.church.name
thenBy grp.name
}
let! grps = q.ToListAsync ()
return List.ofSeq grps
member this.PublicAndProtectedGroups () = backgroundTask {
let! groups =
this.SmallGroups.Include(fun sg -> sg.preferences).Include(fun sg -> sg.church)
.Where(fun sg ->
sg.preferences.isPublic
|| (sg.preferences.groupPassword <> null && sg.preferences.groupPassword <> ""))
.OrderBy(fun sg -> sg.church.name).ThenBy(fun sg -> sg.name)
.ToListAsync ()
return List.ofSeq groups
}
/// Get small groups that are password protected
member this.ProtectedGroups () =
task {
let q =
query {
for grp in this.SmallGroups.AsNoTracking().Include (fun sg -> sg.church) do
where (grp.preferences.groupPassword <> null && grp.preferences.groupPassword <> "")
sortBy grp.church.name
thenBy grp.name
}
let! grps = q.ToListAsync ()
return List.ofSeq grps
member this.ProtectedGroups () = backgroundTask {
let! groups =
this.SmallGroups.Include(fun sg -> sg.church)
.Where(fun sg -> sg.preferences.groupPassword <> null && sg.preferences.groupPassword <> "")
.OrderBy(fun sg -> sg.church.name).ThenBy(fun sg -> sg.name)
.ToListAsync ()
return List.ofSeq groups
}
/// Get all small groups
member this.AllGroups () =
task {
let! grps =
this.SmallGroups.AsNoTracking()
member this.AllGroups () = backgroundTask {
let! groups =
this.SmallGroups
.Include(fun sg -> sg.church)
.Include(fun sg -> sg.preferences)
.Include(fun sg -> sg.preferences.timeZone)
.OrderBy(fun sg -> sg.name)
.ToListAsync ()
return List.ofSeq grps
return List.ofSeq groups
}
/// Get a small group list by their Id, with their church prepended to their name
member this.GroupList () =
task {
let q =
query {
for grp in this.SmallGroups.AsNoTracking().Include (fun sg -> sg.church) do
sortBy grp.church.name
thenBy grp.name
}
let! grps = q.ToListAsync ()
return grps
|> Seq.map (fun grp -> grp.smallGroupId.ToString "N", $"{grp.church.name} | {grp.name}")
member this.GroupList () = backgroundTask {
let! groups =
this.SmallGroups.Include(fun sg -> sg.church)
.OrderBy(fun sg -> sg.church.name).ThenBy(fun sg -> sg.name)
.ToListAsync ()
return groups
|> Seq.map (fun sg -> sg.smallGroupId.ToString "N", $"{sg.church.name} | {sg.name}")
|> List.ofSeq
}
/// Log on a small group
member this.TryGroupLogOnByPassword gId pw =
task {
member this.TryGroupLogOnByPassword gId pw = backgroundTask {
match! this.TryGroupById gId with
| None -> return None
| Some grp ->
match pw = grp.preferences.groupPassword with
| true -> return Some grp
| _ -> return None
| Some grp -> return if pw = grp.preferences.groupPassword then Some grp else None
}
/// Check a cookie log on for a small group
member this.TryGroupLogOnByCookie gId pwHash (hasher : string -> string) =
task {
member this.TryGroupLogOnByCookie gId pwHash (hasher : string -> string) = backgroundTask {
match! this.TryGroupById gId with
| None -> return None
| Some grp ->
match pwHash = hasher grp.preferences.groupPassword with
| true -> return Some grp
| _ -> return None
| Some grp -> return if pwHash = hasher grp.preferences.groupPassword then Some grp else None
}
/// Count small groups for the given church Id
member this.CountGroupsByChurch cId =
this.SmallGroups.CountAsync (fun sg -> sg.churchId = cId)
member this.CountGroupsByChurch cId = backgroundTask {
return! this.SmallGroups.CountAsync (fun sg -> sg.churchId = cId)
}
(*-- TIME ZONE EXTENSIONS --*)
/// Get a time zone by its Id
member this.TryTimeZoneById tzId =
query {
for tz in this.TimeZones do
where (tz.timeZoneId = tzId)
exactlyOneOrDefault
member this.TryTimeZoneById tzId = backgroundTask {
let! zone = this.TimeZones.SingleOrDefaultAsync (fun tz -> tz.timeZoneId = tzId)
return Option.fromObject zone
}
|> toOptionTask
/// Get all time zones
member this.AllTimeZones () =
task {
let q =
query {
for tz in this.TimeZones do
sortBy tz.sortOrder
}
let! tzs = q.ToListAsync ()
return List.ofSeq tzs
member this.AllTimeZones () = backgroundTask {
let! zones = this.TimeZones.OrderBy(fun tz -> tz.sortOrder).ToListAsync ()
return List.ofSeq zones
}
(*-- USER EXTENSIONS --*)
/// Find a user by its Id
member this.TryUserById uId =
query {
for usr in this.Users.AsNoTracking () do
where (usr.userId = uId)
exactlyOneOrDefault
member this.TryUserById uId = backgroundTask {
let! usr = this.Users.SingleOrDefaultAsync (fun u -> u.userId = uId)
return Option.fromObject usr
}
|> toOptionTask
/// Find a user by its e-mail address and authorized small group
member this.TryUserByEmailAndGroup email gId =
query {
for usr in this.Users.AsNoTracking () do
where (usr.emailAddress = email && usr.smallGroups.Any (fun xref -> xref.smallGroupId = gId))
exactlyOneOrDefault
member this.TryUserByEmailAndGroup email gId = backgroundTask {
let! usr =
this.Users.SingleOrDefaultAsync (fun u ->
u.emailAddress = email && u.smallGroups.Any (fun xref -> xref.smallGroupId = gId))
return Option.fromObject usr
}
|> toOptionTask
/// Find a user by its Id (tracked entity), eagerly loading the user's groups
member this.TryUserByIdWithGroups uId =
query {
for usr in this.Users.AsNoTracking().Include (fun u -> u.smallGroups) do
where (usr.userId = uId)
exactlyOneOrDefault
/// Find a user by its Id, eagerly loading the user's groups
member this.TryUserByIdWithGroups uId = backgroundTask {
let! usr = this.Users.Include(fun u -> u.smallGroups).SingleOrDefaultAsync (fun u -> u.userId = uId)
return Option.fromObject usr
}
|> toOptionTask
/// Get a list of all users
member this.AllUsers () =
task {
let q =
query {
for usr in this.Users.AsNoTracking () do
sortBy usr.lastName
thenBy usr.firstName
}
let! usrs = q.ToListAsync ()
return List.ofSeq usrs
member this.AllUsers () = backgroundTask {
let! users = this.Users.OrderBy(fun u -> u.lastName).ThenBy(fun u -> u.firstName).ToListAsync ()
return List.ofSeq users
}
/// Get all PrayerTracker users as members (used to send e-mails)
member this.AllUsersAsMembers () =
task {
let q =
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
member this.AllUsersAsMembers () = backgroundTask {
let! users = this.AllUsers ()
return users |> List.map (fun u -> { Member.empty with email = u.emailAddress; memberName = u.fullName })
}
/// Find a user based on their credentials
member this.TryUserLogOnByPassword email pwHash gId =
query {
for usr in this.Users.AsNoTracking () do
where ( usr.emailAddress = email
&& usr.passwordHash = pwHash
&& usr.smallGroups.Any (fun xref -> xref.smallGroupId = gId))
exactlyOneOrDefault
member this.TryUserLogOnByPassword email pwHash gId = backgroundTask {
let! usr =
this.Users.SingleOrDefaultAsync (fun u ->
u.emailAddress = email
&& u.passwordHash = pwHash
&& u.smallGroups.Any (fun xref -> xref.smallGroupId = gId))
return Option.fromObject usr
}
|> toOptionTask
/// Find a user based on credentials stored in a cookie
member this.TryUserLogOnByCookie uId gId pwHash =
task {
member this.TryUserLogOnByCookie uId gId pwHash = backgroundTask {
match! this.TryUserByIdWithGroups uId with
| None -> return None
| Some usr ->
match pwHash = usr.passwordHash && usr.smallGroups |> Seq.exists (fun xref -> xref.smallGroupId = gId) with
| true ->
this.Entry<User>(usr).State <- EntityState.Detached
if pwHash = usr.passwordHash && usr.smallGroups |> Seq.exists (fun xref -> xref.smallGroupId = gId) then
return Some { usr with passwordHash = ""; salt = None; smallGroups = List<UserSmallGroup>() }
| _ -> return None
else return None
}
/// Count the number of users for a small group
member this.CountUsersBySmallGroup gId =
this.Users.CountAsync (fun u -> u.smallGroups.Any (fun xref -> xref.smallGroupId = gId))
member this.CountUsersBySmallGroup gId = backgroundTask {
return! this.Users.CountAsync (fun u -> u.smallGroups.Any (fun xref -> xref.smallGroupId = gId))
}
/// Count the number of users for a church
member this.CountUsersByChurch cId =
this.Users.CountAsync (fun u -> u.smallGroups.Any (fun xref -> xref.smallGroup.churchId = cId))
member this.CountUsersByChurch cId = backgroundTask {
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
| LongDate
with
/// Convert to a DU case from a single-character string
static member fromCode code =
match code with
| "N" -> NoDisplay
| "S" -> ShortDate
| "L" -> LongDate
| _ -> invalidArg "code" (sprintf "Unknown code %s" code)
| _ -> invalidArg "code" $"Unknown code {code}"
/// Convert this DU case to a single-character string
member this.code =
match this with
@ -41,12 +43,14 @@ type EmailFormat =
/// Plain-text e-mail
| PlainTextFormat
with
/// Convert to a DU case from a single-character string
static member fromCode code =
match code with
| "H" -> HtmlFormat
| "P" -> PlainTextFormat
| _ -> invalidArg "code" (sprintf "Unknown code %s" code)
| _ -> invalidArg "code" $"Unknown code {code}"
/// Convert this DU case to a single-character string
member this.code =
match this with
@ -63,13 +67,15 @@ type Expiration =
/// Force immediate expiration
| Forced
with
/// Convert to a DU case from a single-character string
static member fromCode code =
match code with
| "A" -> Automatic
| "M" -> Manual
| "F" -> Forced
| _ -> invalidArg "code" (sprintf "Unknown code %s" code)
| _ -> invalidArg "code" $"Unknown code {code}"
/// Convert this DU case to a single-character string
member this.code =
match this with
@ -91,6 +97,7 @@ type PrayerRequestType =
/// Announcements
| Announcement
with
/// Convert to a DU case from a single-character string
static member fromCode code =
match code with
@ -99,7 +106,8 @@ with
| "E" -> Expecting
| "P" -> PraiseReport
| "A" -> Announcement
| _ -> invalidArg "code" (sprintf "Unknown code %s" code)
| _ -> invalidArg "code" $"Unknown code {code}"
/// Convert this DU case to a single-character string
member this.code =
match this with
@ -117,12 +125,14 @@ type RequestSort =
/// Sort by requestor/subject, then by date
| SortByRequestor
with
/// Convert to a DU case from a single-character string
static member fromCode code =
match code with
| "D" -> SortByDate
| "R" -> SortByRequestor
| _ -> invalidArg "code" (sprintf "Unknown code %s" code)
| _ -> invalidArg "code" $"Unknown code {code}"
/// Convert this DU case to a single-character string
member this.code =
match this with
@ -130,7 +140,9 @@ with
| SortByRequestor -> "R"
/// EF Core value converters for the discriminated union types above
module Converters =
open Microsoft.EntityFrameworkCore.Storage.ValueConversion
open Microsoft.FSharp.Linq.RuntimeHelpers
open System.Linq.Expressions
@ -211,8 +223,10 @@ module Converters =
type ChurchStats =
{ /// The number of small groups in the church
smallGroups : int
/// The number of prayer requests in the church
prayerRequests : int
/// The number of users who can access small groups in the church
users : int
}
@ -237,7 +251,10 @@ type UserId = Guid
/// PK for User/SmallGroup cross-reference table
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
}
@ -247,21 +264,26 @@ type UserSmallGroupKey =
type [<CLIMutable; NoComparison; NoEquality>] Church =
{ /// The Id of this church
churchId : ChurchId
/// The name of the church
name : string
/// The city where the church is
city : string
/// The state where the church is
st : string
/// Does this church have an active interface with Virtual Prayer Room?
hasInterface : bool
/// The address for the interface
interfaceAddress : string option
/// Small groups for this church
smallGroups : ICollection<SmallGroup>
}
with
with
/// An empty church
// aww... how sad :(
static member empty =
@ -273,10 +295,10 @@ type [<CLIMutable; NoComparison; NoEquality>] Church =
interfaceAddress = None
smallGroups = List<SmallGroup> ()
}
/// Configure EF for this entity
static member internal configureEF (mb : ModelBuilder) =
mb.Entity<Church> (
fun m ->
mb.Entity<Church> (fun m ->
m.ToTable "Church" |> ignore
m.Property(fun e -> e.churchId).HasColumnName "ChurchId" |> ignore
m.Property(fun e -> e.name).HasColumnName("Name").IsRequired () |> ignore
@ -293,44 +315,63 @@ type [<CLIMutable; NoComparison; NoEquality>] Church =
and [<CLIMutable; NoComparison; NoEquality>] ListPreferences =
{ /// The Id of the small group to which these preferences belong
smallGroupId : SmallGroupId
/// The days after which regular requests expire
daysToExpire : int
/// The number of days a new or updated request is considered new
daysToKeepNew : int
/// The number of weeks after which long-term requests are flagged for follow-up
longTermUpdateWeeks : int
/// The name from which e-mails are sent
emailFromName : string
/// The e-mail address from which e-mails are sent
emailFromAddress : string
/// The fonts to use in generating the list of prayer requests
listFonts : string
/// The color for the prayer request list headings
headingColor : string
/// The color for the lines offsetting the prayer request list headings
lineColor : string
/// The font size for the headings on the prayer request list
headingFontSize : int
/// The font size for the text on the prayer request list
textFontSize : int
/// The order in which the prayer requests are sorted
requestSort : RequestSort
/// The password used for "small group login" (view-only request list)
groupPassword : string
/// The default e-mail type for this class
defaultEmailType : EmailFormat
/// Whether this class makes its request list public
isPublic : bool
/// The time zone which this class uses (use tzdata names)
timeZoneId : TimeZoneId
/// The time zone information
timeZone : TimeZone
/// The number of requests displayed per page
pageSize : int
/// How the as-of date should be automatically displayed
asOfDateDisplay : AsOfDateDisplay
}
with
with
/// A set of preferences with their default values
static member empty =
{ smallGroupId = Guid.Empty
@ -353,10 +394,10 @@ and [<CLIMutable; NoComparison; NoEquality>] ListPreferences =
pageSize = 100
asOfDateDisplay = NoDisplay
}
/// Configure EF for this entity
static member internal configureEF (mb : ModelBuilder) =
mb.Entity<ListPreferences> (
fun m ->
mb.Entity<ListPreferences> (fun m ->
m.ToTable "ListPreference" |> ignore
m.HasKey (fun e -> e.smallGroupId :> obj) |> ignore
m.Property(fun e -> e.smallGroupId).HasColumnName "SmallGroupId" |> ignore
@ -460,18 +501,24 @@ and [<CLIMutable; NoComparison; NoEquality>] ListPreferences =
and [<CLIMutable; NoComparison; NoEquality>] Member =
{ /// The Id of the member
memberId : MemberId
/// The Id of the small group to which this member belongs
smallGroupId : SmallGroupId
/// The name of the member
memberName : string
/// The e-mail address for the member
email : string
/// 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?
/// The small group to which this member belongs
smallGroup : SmallGroup
}
with
with
/// An empty member
static member empty =
{ memberId = Guid.Empty
@ -481,10 +528,10 @@ and [<CLIMutable; NoComparison; NoEquality>] Member =
format = None
smallGroup = SmallGroup.empty
}
/// Configure EF for this entity
static member internal configureEF (mb : ModelBuilder) =
mb.Entity<Member> (
fun m ->
mb.Entity<Member> (fun m ->
m.ToTable "Member" |> ignore
m.Property(fun e -> e.memberId).HasColumnName "MemberId" |> ignore
m.Property(fun e -> e.smallGroupId).HasColumnName "SmallGroupId" |> ignore
@ -499,30 +546,42 @@ and [<CLIMutable; NoComparison; NoEquality>] Member =
and [<CLIMutable; NoComparison; NoEquality>] PrayerRequest =
{ /// The Id of this request
prayerRequestId : PrayerRequestId
/// The type of the request
requestType : PrayerRequestType
/// The user who entered the request
userId : UserId
/// The small group to which this request belongs
smallGroupId : SmallGroupId
/// The date/time on which this request was entered
enteredDate : DateTime
/// The date/time this request was last updated
updatedDate : DateTime
/// The name of the requestor or subject, or title of announcement
requestor : string option
/// The text of the request
text : string
/// Whether the chaplain should be notified for this request
notifyChaplain : bool
/// The user who entered this request
user : User
/// The small group to which this request belongs
smallGroup : SmallGroup
/// Is this request expired?
expiration : Expiration
}
with
with
/// An empty request
static member empty =
{ prayerRequestId = Guid.Empty
@ -538,6 +597,7 @@ and [<CLIMutable; NoComparison; NoEquality>] PrayerRequest =
smallGroup = SmallGroup.empty
expiration = Automatic
}
/// Is this request expired?
member this.isExpired (curr : DateTime) expDays =
match this.expiration with
@ -557,8 +617,7 @@ and [<CLIMutable; NoComparison; NoEquality>] PrayerRequest =
/// Configure EF for this entity
static member internal configureEF (mb : ModelBuilder) =
mb.Entity<PrayerRequest> (
fun m ->
mb.Entity<PrayerRequest> (fun m ->
m.ToTable "PrayerRequest" |> ignore
m.Property(fun e -> e.prayerRequestId).HasColumnName "PrayerRequestId" |> ignore
m.Property(fun e -> e.requestType).HasColumnName("RequestType").IsRequired() |> ignore
@ -598,7 +657,8 @@ and [<CLIMutable; NoComparison; NoEquality>] SmallGroup =
/// The users authorized to manage this group
users : ICollection<UserSmallGroup>
}
with
with
/// An empty small group
static member empty =
{ smallGroupId = Guid.Empty
@ -615,10 +675,10 @@ and [<CLIMutable; NoComparison; NoEquality>] SmallGroup =
member this.localTimeNow (clock : IClock) =
match clock with null -> nullArg "clock" | _ -> ()
let tz =
match DateTimeZoneProviders.Tzdb.Ids.Contains this.preferences.timeZoneId with
| true -> DateTimeZoneProviders.Tzdb.[this.preferences.timeZoneId]
| false -> DateTimeZone.Utc
clock.GetCurrentInstant().InZone(tz).ToDateTimeUnspecified()
if DateTimeZoneProviders.Tzdb.Ids.Contains this.preferences.timeZoneId then
DateTimeZoneProviders.Tzdb[this.preferences.timeZoneId]
else DateTimeZone.Utc
clock.GetCurrentInstant().InZone(tz).ToDateTimeUnspecified ()
/// Get the local date for this group
member this.localDateNow clock =
@ -626,8 +686,7 @@ and [<CLIMutable; NoComparison; NoEquality>] SmallGroup =
/// Configure EF for this entity
static member internal configureEF (mb : ModelBuilder) =
mb.Entity<SmallGroup> (
fun m ->
mb.Entity<SmallGroup> (fun m ->
m.ToTable "SmallGroup" |> ignore
m.Property(fun e -> e.smallGroupId).HasColumnName "SmallGroupId" |> ignore
m.Property(fun e -> e.churchId).HasColumnName "ChurchId" |> ignore
@ -647,7 +706,8 @@ and [<CLIMutable; NoComparison; NoEquality>] TimeZone =
/// Whether this timezone is active
isActive : bool
}
with
with
/// An empty time zone
static member empty =
{ timeZoneId = ""
@ -655,10 +715,10 @@ and [<CLIMutable; NoComparison; NoEquality>] TimeZone =
sortOrder = 0
isActive = false
}
/// Configure EF for this entity
static member internal configureEF (mb : ModelBuilder) =
mb.Entity<TimeZone> (
fun m ->
mb.Entity<TimeZone> ( fun m ->
m.ToTable "TimeZone" |> ignore
m.Property(fun e -> e.timeZoneId).HasColumnName "TimeZoneId" |> ignore
m.Property(fun e -> e.description).HasColumnName("Description").IsRequired() |> ignore
@ -686,7 +746,8 @@ and [<CLIMutable; NoComparison; NoEquality>] User =
/// The small groups which this user is authorized
smallGroups : ICollection<UserSmallGroup>
}
with
with
/// An empty user
static member empty =
{ userId = Guid.Empty
@ -698,14 +759,14 @@ and [<CLIMutable; NoComparison; NoEquality>] User =
salt = None
smallGroups = List<UserSmallGroup> ()
}
/// The full name of the user
member this.fullName =
sprintf "%s %s" this.firstName this.lastName
$"{this.firstName} {this.lastName}"
/// Configure EF for this entity
static member internal configureEF (mb : ModelBuilder) =
mb.Entity<User> (
fun m ->
mb.Entity<User> (fun m ->
m.ToTable "User" |> ignore
m.Ignore(fun e -> e.fullName :> obj) |> 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
smallGroup : SmallGroup
}
with
with
/// An empty user/small group xref
static member empty =
{ userId = Guid.Empty
@ -739,10 +801,10 @@ and [<CLIMutable; NoComparison; NoEquality>] UserSmallGroup =
user = User.empty
smallGroup = SmallGroup.empty
}
/// Configure EF for this entity
static member internal configureEF (mb : ModelBuilder) =
mb.Entity<UserSmallGroup> (
fun m ->
mb.Entity<UserSmallGroup> (fun m ->
m.ToTable "User_SmallGroup" |> ignore
m.HasKey(fun e -> { userId = e.userId; smallGroupId = e.smallGroupId } :> obj) |> ignore
m.Property(fun e -> e.userId).HasColumnName "UserId" |> ignore

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

@ -53,7 +53,8 @@ let htmlToPlainTextTests =
"Non-breaking spaces should have been replaced with spaces"
}
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" {
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" {
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"
}
]
@ -87,7 +89,8 @@ let makeUrlTests =
let sndAsStringTests =
testList "sndAsString" [
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 s = I18N.localizer.Force ()
[ form [ _action "/web/church/save"; _method "post"; _class "pt-center-columns" ] [
style [ _scoped ]
[ rawText "#name { width: 20rem; } #city { width: 10rem; } #st { width: 3rem; } #interfaceAddress { width: 30rem; }" ]
style [ _scoped ] [
rawText "#name { width: 20rem; } #city { width: 10rem; } #st { width: 3rem; } #interfaceAddress { width: 30rem; }"
]
csrfToken ctx
input [ _type "hidden"; _name "churchId"; _value (flatGuid m.churchId) ]
div [ _class "pt-field-row" ] [
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 ]
]
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 ]
]
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 ]
]
]
@ -34,17 +35,19 @@ let edit (m : EditChurch) ctx vi =
_id "hasInterface"
_value "True"
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" ] [
label [ _for "interfaceAddress" ] [ locStr s.["VPR Interface URL"] ]
input [ _type "url"; _name "interfaceAddress"; _id "interfaceAddress";
_value (match m.interfaceAddress with Some ia -> ia | None -> "") ]
label [ _for "interfaceAddress" ] [ locStr s["VPR Interface URL"] ]
input
[ _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)" ]
]
@ -62,42 +65,42 @@ let maintain (churches : Church list) (stats : Map<string, ChurchStats>) ctx vi
table [ _class "pt-table pt-action-table" ] [
thead [] [
tr [] [
th [] [ locStr s.["Actions"] ]
th [] [ locStr s.["Name"] ]
th [] [ locStr s.["Location"] ]
th [] [ locStr s.["Groups"] ]
th [] [ locStr s.["Requests"] ]
th [] [ locStr s.["Users"] ]
th [] [ locStr s.["Interface?"] ]
th [] [ locStr s["Actions"] ]
th [] [ locStr s["Name"] ]
th [] [ locStr s["Location"] ]
th [] [ locStr s["Groups"] ]
th [] [ locStr s["Requests"] ]
th [] [ locStr s["Users"] ]
th [] [ locStr s["Interface?"] ]
]
]
churches
|> List.map (fun ch ->
let chId = flatGuid ch.churchId
let delAction = $"/web/church/{chId}/delete"
let delPrompt = s.["Are you sure you want to delete this {0}? This action cannot be undone.",
$"""{s.["Church"].Value.ToLower ()} ({ch.name})"""]
let delPrompt = s["Are you sure you want to delete this {0}? This action cannot be undone.",
$"""{s["Church"].Value.ToLower ()} ({ch.name})"""]
tr [] [
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
_title s.["Delete This Church"].Value
_title s["Delete This Church"].Value
_onclick $"return PT.confirmDelete('{delAction}','{delPrompt}')" ]
[ icon "delete_forever" ]
]
td [] [ str ch.name ]
td [] [ str ch.city; rawText ", "; str ch.st ]
td [ _class "pt-right-text" ] [ rawText (stats.[chId].smallGroups.ToString "N0") ]
td [ _class "pt-right-text" ] [ rawText (stats.[chId].prayerRequests.ToString "N0") ]
td [ _class "pt-right-text" ] [ rawText (stats.[chId].users.ToString "N0") ]
td [ _class "pt-center-text" ] [ locStr s.[match ch.hasInterface with true -> "Yes" | false -> "No"] ]
td [ _class "pt-right-text" ] [ rawText (stats[chId].smallGroups.ToString "N0") ]
td [ _class "pt-right-text" ] [ rawText (stats[chId].prayerRequests.ToString "N0") ]
td [ _class "pt-right-text" ] [ rawText (stats[chId].users.ToString "N0") ]
td [ _class "pt-center-text" ] [ locStr s[if ch.hasInterface then "Yes" else "No"] ]
])
|> tbody []
]
[ div [ _class "pt-center-text" ] [
br []
a [ _href $"/web/church/{emptyGuid}/edit"; _title s.["Add a New Church"].Value ]
[ icon "add_circle"; rawText " &nbsp;"; locStr s.["Add a New Church"] ]
a [ _href $"/web/church/{emptyGuid}/edit"; _title s["Add a New Church"].Value ]
[ icon "add_circle"; rawText " &nbsp;"; locStr s["Add a New Church"] ]
br []
br []
]

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

@ -1,16 +1,14 @@
[<AutoOpen>]
module PrayerTracker.Views.CommonFunctions
open System.IO
open System.Text.Encodings.Web
open Giraffe
open Giraffe.ViewEngine
open Microsoft.AspNetCore.Antiforgery
open Microsoft.AspNetCore.Html
open Microsoft.AspNetCore.Http
open Microsoft.AspNetCore.Mvc.Localization
open Microsoft.Extensions.Localization
open System
open System.IO
open System.Text.Encodings.Web
/// Encoded text for a localized string
let locStr (text : LocalizedString) = str text.Value
@ -42,58 +40,62 @@ let tableSummary itemCount (s : IStringLocalizer) =
div [ _class "pt-center-text" ] [
small [] [
match itemCount with
| 0 -> s.["No Entries to Display"]
| 1 -> s.["Displaying {0} Entry", itemCount]
| _ -> s.["Displaying {0} Entries", itemCount]
| 0 -> s["No Entries to Display"]
| 1 -> s["Displaying {0} Entry", itemCount]
| _ -> s["Displaying {0} Entries", itemCount]
|> locStr
]
]
/// Generate a list of named HTML colors
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 {
("aqua", s.["Aqua"], "black")
("black", s.["Black"], "white")
("blue", s.["Blue"], "white")
("fuchsia", s.["Fuchsia"], "black")
("gray", s.["Gray"], "white")
("green", s.["Green"], "white")
("lime", s.["Lime"], "black")
("maroon", s.["Maroon"], "white")
("navy", s.["Navy"], "white")
("olive", s.["Olive"], "white")
("purple", s.["Purple"], "white")
("red", s.["Red"], "black")
("silver", s.["Silver"], "black")
("teal", s.["Teal"], "white")
("white", s.["White"], "black")
("yellow", s.["Yellow"], "black")
("aqua", s["Aqua"], "black")
("black", s["Black"], "white")
("blue", s["Blue"], "white")
("fuchsia", s["Fuchsia"], "black")
("gray", s["Gray"], "white")
("green", s["Green"], "white")
("lime", s["Lime"], "black")
("maroon", s["Maroon"], "white")
("navy", s["Navy"], "white")
("olive", s["Olive"], "white")
("purple", s["Purple"], "white")
("red", s["Red"], "black")
("silver", s["Silver"], "black")
("teal", s["Teal"], "white")
("white", s["White"], "black")
("yellow", s["Yellow"], "black")
}
|> Seq.map (fun color ->
let (colorName, dispText, txtColor) = color
option [ yield _value colorName
yield _style $"background-color:{colorName};color:{txtColor};"
match colorName = selected with true -> yield _selected | false -> () ] [
encodedText (dispText.Value.ToLower ())
])
let colorName, text, txtColor = color
option
[ _value colorName
_style $"background-color:{colorName};color:{txtColor};"
if colorName = selected then _selected
] [ encodedText (text.Value.ToLower ()) ])
|> List.ofSeq
|> select (_name name :: attrs)
/// Generate an input[type=radio] that is selected if its value is the current value
let radio name domId value current =
input [ _type "radio"
input
[ _type "radio"
_name name
_id domId
_value value
match value = current with true -> _checked | false -> () ]
if value = current then _checked
]
/// Generate a select list with the current value selected
let selectList name selected attrs items =
items
|> Seq.map (fun (value, text) ->
option [ _value value
match value = selected with true -> _selected | false -> () ] [ encodedText text ])
option
[ _value value
if value = selected then _selected
] [ encodedText text ])
|> List.ofSeq
|> 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
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)
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
let renderHtmlNode = RenderView.AsString.htmlNode
open Microsoft.AspNetCore.Html
/// Render an HTML node, then return the value as an HTML string
let renderHtmlString = renderHtmlNode >> HtmlString
@ -151,5 +159,5 @@ module TimeZones =
/// Get the name of a time zone, given its Id
let name tzId (s : IStringLocalizer) =
try s.[xref.[tzId]]
try s[xref[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
module PrayerTracker.Views.Home
open Giraffe.ViewEngine
open Microsoft.AspNetCore.Html
open PrayerTracker.ViewModels
open System.IO
open Giraffe.ViewEngine
open PrayerTracker.ViewModels
/// The error page
let error code vi =
@ -13,31 +12,30 @@ let error code vi =
use sw = new StringWriter ()
let raw = rawLocText sw
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!
match is404 with
| true ->
if is404 then
[ p [] [
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["The page you requested cannot be found."]
raw l["Please use your &ldquo;Back&rdquo; button to return to {0}.", s["PrayerTracker"]]
]
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).",
s.["PrayerTracker"]]
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"]]
]
]
| false ->
else
[ p [] [
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["An error ({0}) has occurred.", code]
raw l["Please use your &ldquo;Back&rdquo; button to return to {0}.", s["PrayerTracker"]]
]
]
br []
hr []
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"""
_alt $"""%A{s.["PrayerTracker"]} %A{s.["from Bit Badger Solutions"]}"""
_title $"""%A{s.["PrayerTracker"]} %A{s.["from Bit Badger Solutions"]}"""
img [ _src $"""/img/%A{s["footer_en"]}.png"""
_alt $"""%A{s["PrayerTracker"]} %A{s["from Bit Badger Solutions"]}"""
_title $"""%A{s["PrayerTracker"]} %A{s["from Bit Badger Solutions"]}"""
_style "vertical-align:text-bottom;" ]
str vi.version
]
@ -54,70 +52,70 @@ let index vi =
let raw = rawLocText sw
[ p [] [
raw l.["Welcome to <strong>{0}</strong>!", s.["PrayerTracker"]]
raw l["Welcome to <strong>{0}</strong>!", s["PrayerTracker"]]
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.",
s.["PrayerTracker"]]
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"]]
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 [] [
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
raw l.["Some of the things it can do..."]
raw l["Some of the things it can do..."]
]
ul [] [
li [] [
raw l.["It drops old requests off the list automatically."]
raw l["It drops old requests off the list automatically."]
space
raw l.["Requests other than “{0}” requests will expire at 14 days, though this can be changed by the organization.",
s.["Long-Term Requests"]]
raw l["Requests other than “{0}” requests will expire at 14 days, though this can be changed by the organization.",
s["Long-Term Requests"]]
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
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 [] [
raw l.["Requests can be viewed any time."]
raw l["Requests can be viewed any time."]
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 [] [
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
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
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 [] [
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
raw l.["All fonts, colors, and sizes can be customized."]
raw l["All fonts, colors, and sizes can be customized."]
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 [] [
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"]]
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"]]
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.",
s.["PrayerTracker"]]
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"]]
]
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 [] [
raw l.["This depends on the group."]
raw l["This depends on the group."]
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
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"]]
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"]]
]
h4 [] [ raw l.["How Does It Work?"] ]
h4 [] [ raw l["How Does It Work?"] ]
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
@ -131,65 +129,66 @@ let privacyPolicy vi =
use sw = new StringWriter ()
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 [] [
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
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 [] [
li [] [
strong [] [ raw l.["Identifying Data"] ]
strong [] [ raw l["Identifying Data"] ]
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
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 [] [
strong [] [ raw l.["User Provided Data"] ]
strong [] [ raw l["User Provided Data"] ]
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
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 [] [
li [] [
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"]]
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"]]
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.",
s.["Remember Me"], s.["Log Off"]]
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"]]
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
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 [] [
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
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"]]
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"]]
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
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 [] [
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
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 [] [
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 [] [
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"]]
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"]]
]
]
|> Layout.Content.standard
@ -203,41 +202,41 @@ let termsOfService vi =
use sw = new StringWriter ()
let raw = rawLocText sw
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
[ p [ _class "pt-right-text" ] [ small [] [ em [] [ raw l.["(as of May 24, 2018)"] ] ] ]
h3 [] [ str "1. "; raw l.["Acceptance of Terms"] ]
[ p [ _class "pt-right-text" ] [ small [] [ em [] [ raw l["(as of May 24, 2018)"] ] ] ]
h3 [] [ str "1. "; raw l["Acceptance of Terms"] ]
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
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 [] [
raw l.["{0} is a service that allows individuals to enter and amend prayer requests on behalf of organizations.",
s.["PrayerTracker"]]
raw l["{0} is a service that allows individuals to enter and amend prayer requests on behalf of organizations.",
s["PrayerTracker"]]
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
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 [] [
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
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 [] [
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
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
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 []
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.standard vi "Terms of Service"
@ -250,12 +249,12 @@ let unauthorized vi =
use sw = new StringWriter ()
let raw = rawLocText sw
[ 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.).",
s.["PrayerTracker"]]
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"]]
]
p [] [
raw l.["Otherwise, you may select one of the links above to get back into an authorized portion of {0}.",
s.["PrayerTracker"]]
raw l["Otherwise, you may select one of the links above to get back into an authorized portion of {0}.",
s["PrayerTracker"]]
]
]
|> 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
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
@ -17,95 +17,101 @@ module Navigation =
/// Top navigation bar
let top m =
let s = PrayerTracker.Views.I18N.localizer.Force ()
let s = I18N.localizer.Force ()
let menuSpacer = rawText "&nbsp; "
let leftLinks = [
match m.user with
| Some u ->
li [ _class "dropdown" ] [
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" ]
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" ]
div [ _class "dropdown-content"; _role "menu" ] [
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" ] [ icon "compare_arrows"; menuSpacer; locStr s["Maintain"] ]
a [ _href "/web/prayer-requests/view" ] [ icon "list"; menuSpacer; locStr s["View List"] ]
]
]
li [ _class "dropdown" ] [
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" ]
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" ]
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/announcement" ] [ icon "send"; menuSpacer; locStr s.["Send Announcement"] ]
a [ _href "/web/small-group/preferences" ] [ icon "build"; menuSpacer; locStr s.["Change Preferences"] ]
a [ _href "/web/small-group/members" ]
[ icon "email"; menuSpacer; locStr s["Maintain Group Members"] ]
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
| true ->
if u.isAdmin then
li [ _class "dropdown" ] [
a [ _class "dropbtn"; _role "button"; _aria "label" s.["Administration"].Value; _title s.["Administration"].Value ]
[ icon "settings"; space; locStr s.["Administration"]; space; icon "keyboard_arrow_down" ]
a [ _class "dropbtn"
_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" ] [
a [ _href "/web/churches" ] [ icon "home"; menuSpacer; locStr s.["Churches"] ]
a [ _href "/web/small-groups" ] [ icon "send"; menuSpacer; locStr s.["Groups"] ]
a [ _href "/web/users" ] [ icon "build"; menuSpacer; locStr s.["Users"] ]
a [ _href "/web/churches" ] [ icon "home"; menuSpacer; locStr s["Churches"] ]
a [ _href "/web/small-groups" ] [ icon "send"; menuSpacer; locStr s["Groups"] ]
a [ _href "/web/users" ] [ icon "build"; menuSpacer; locStr s["Users"] ]
]
]
| false -> ()
| None ->
match m.group with
| Some _ ->
li [] [
a [ _href "/web/prayer-requests/view"
_aria "label" s.["View Request List"].Value
_title s.["View Request List"].Value ]
[ icon "list"; space; locStr s.["View Request List"] ]
_aria "label" s["View Request List"].Value
_title s["View Request List"].Value
] [ icon "list"; space; locStr s["View Request List"] ]
]
| None ->
li [ _class "dropdown" ] [
a [ _class "dropbtn"; _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" ]
a [ _class "dropbtn"
_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" ] [
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/user/log-on" ] [ icon "person"; menuSpacer; locStr s["User"] ]
a [ _href "/web/small-group/log-on" ] [ icon "group"; menuSpacer; locStr s["Group"] ]
]
]
li [] [
a [ _href "/web/prayer-requests/lists"
_aria "label" s.["View Request List"].Value
_title s.["View Request List"].Value ]
[ icon "list"; space; locStr s.["View Request List"] ]
_aria "label" s["View Request List"].Value
_title s["View Request List"].Value
] [ icon "list"; space; locStr s["View Request List"] ]
]
li [] [
a [ _href $"https://docs.prayer.bitbadger.solutions/{langCode ()}"
_aria "label" s.["Help"].Value;
_title s.["View Help"].Value
_aria "label" s["Help"].Value;
_title s["View Help"].Value
_target "_blank"
]
[ icon "help"; space; locStr s.["Help"] ]
] [ icon "help"; space; locStr s["Help"] ]
]
]
let rightLinks =
match m.group with
| Some _ ->
[ match m.user with
| Some _ -> [
match m.user with
| Some _ ->
li [] [
a [ _href "/web/user/password"
_aria "label" s.["Change Your Password"].Value
_title s.["Change Your Password"].Value ]
[ icon "lock"; space; locStr s.["Change Your Password"] ]
_aria "label" s["Change Your Password"].Value
_title s["Change Your Password"].Value
] [ icon "lock"; space; locStr s["Change Your Password"] ]
]
| None -> ()
li [] [
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"] ]
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"] ]
]
]
| None -> List.empty
| None -> []
header [ _class "pt-title-bar" ] [
section [ _class "pt-title-bar-left" ] [
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
]
@ -120,28 +126,28 @@ module Navigation =
let s = I18N.localizer.Force ()
header [ _id "pt-language" ] [
div [] [
span [ _class "u" ] [ locStr s.["Language"]; rawText ": " ]
span [ _class "u" ] [ locStr s["Language"]; rawText ": " ]
match langCode () with
| "es" ->
locStr s.["Spanish"]
locStr s["Spanish"]
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; "
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
| Some g ->
[ match m.user with
| Some g ->[
match m.user with
| Some u ->
span [ _class "u" ] [ locStr s.["Currently Logged On"] ]
span [ _class "u" ] [ locStr s["Currently Logged On"] ]
rawText "&nbsp; &nbsp;"
icon "person"
strong [] [ str u.fullName ]
rawText "&nbsp; &nbsp; "
| None ->
locStr s.["Logged On as a Member of"]
locStr s["Logged On as a Member of"]
rawText "&nbsp; "
icon "group"
space
@ -157,6 +163,7 @@ module Navigation =
/// Content layouts
module Content =
/// Content layout that tops at 60rem
let standard = div [ _class "pt-content" ]
@ -167,6 +174,7 @@ module Content =
/// Separator for parts of the title
let private titleSep = rawText " &#xab; "
/// Common HTML head tag items
let private commonHead =
[ meta [ _name "viewport"; _content "width=device-width, initial-scale=1" ]
meta [ _name "generator"; _content "Giraffe" ]
@ -180,7 +188,7 @@ let private htmlHead m pageTitle =
let s = I18N.localizer.Force ()
head [] [
meta [ _charset "UTF-8" ]
title [] [ locStr pageTitle; titleSep; locStr s.["PrayerTracker"] ]
title [] [ locStr pageTitle; titleSep; locStr s["PrayerTracker"] ]
yield! commonHead
for cssFile in m.style do
link [ _rel "stylesheet"; _href $"/css/{cssFile}.css"; _type "text/css" ]
@ -192,11 +200,8 @@ let private htmlHead m pageTitle =
let private helpLink link =
let s = I18N.localizer.Force ()
sup [] [
a [ _href link
_title s.["Click for Help on This Page"].Value
_onclick $"return PT.showHelp('{link}')" ] [
icon "help_outline"
]
a [ _href link; _title s["Click for Help on This Page"].Value; _onclick $"return PT.showHelp('{link}')" ]
[ icon "help_outline" ]
]
/// Render the page title, and optionally a help link
@ -217,7 +222,7 @@ let private messages m =
match msg.level with
| "Info" -> ()
| lvl ->
strong [] [ locStr s.[lvl] ]
strong [] [ locStr s[lvl] ]
rawText " &#xbb; "
rawText msg.text.Value
match msg.description with
@ -232,37 +237,35 @@ let private messages m =
/// Render the <footer> at the bottom of the page
let private htmlFooter m =
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
footer [] [
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; "
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; "
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"
_rel "noopener" ] [
locStr s.["Source & Support"]
_rel "noopener"
] [ locStr s["Source & Support"]
]
]
div [ _id "pt-footer" ] [
a [ _href "/web/"; _style "line-height:28px;" ] [
img [ _src $"""/img/%O{s.["footer_en"]}.png"""; _alt imgText; _title imgText ]
]
a [ _href "/web/"; _style "line-height:28px;" ]
[ img [ _src $"""/img/%O{s["footer_en"]}.png"""; _alt imgText; _title imgText ] ]
str m.version
space
i [ _title s.["This page loaded in {0:N3} seconds", resultTime].Value; _class "material-icons md-18" ] [
str "schedule"
]
i [ _title s["This page loaded in {0:N3} seconds", resultTime].Value; _class "material-icons md-18" ]
[ str "schedule" ]
]
]
/// The standard layout for PrayerTracker
let standard m pageTitle (content : XmlNode) =
let s = I18N.localizer.Force ()
let ttl = s.[pageTitle]
let ttl = s[pageTitle]
html [ _lang "" ] [
htmlHead m ttl
body [] [
@ -280,11 +283,11 @@ let standard m pageTitle (content : XmlNode) =
/// A layout with nothing but a title and content
let bare pageTitle content =
let s = I18N.localizer.Force ()
let ttl = s.[pageTitle]
let ttl = s[pageTitle]
html [ _lang "" ] [
head [] [
meta [ _charset "UTF-8" ]
title [] [ locStr ttl; titleSep; locStr s.["PrayerTracker"] ]
title [] [ locStr ttl; titleSep; locStr s["PrayerTracker"] ]
]
body [] [ content ]
]

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

@ -1,5 +1,7 @@
module PrayerTracker.Views.PrayerRequest
open System
open System.IO
open Giraffe
open Giraffe.ViewEngine
open Microsoft.AspNetCore.Http
@ -7,52 +9,48 @@ open NodaTime
open PrayerTracker
open PrayerTracker.Entities
open PrayerTracker.ViewModels
open System
open System.IO
open System.Text
/// View for the prayer request edit page
let edit (m : EditRequest) today ctx vi =
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" ] [
csrfToken ctx
input [ _type "hidden"; _name "requestId"; _value (flatGuid m.requestId) ]
div [ _class "pt-field-row" ] [
div [ _class "pt-field" ] [
label [ _for "requestType" ] [ locStr s.["Request Type"] ]
label [ _for "requestType" ] [ locStr s["Request Type"] ]
ReferenceList.requestTypeList s
|> Seq.ofList
|> Seq.map (fun (typ, desc) -> typ.code, desc.Value)
|> selectList "requestType" m.requestType [ _required; _autofocus ]
]
div [ _class "pt-field" ] [
label [ _for "requestor" ] [ locStr s.["Requestor / Subject"] ]
label [ _for "requestor" ] [ locStr s["Requestor / Subject"] ]
input [ _type "text"
_name "requestor"
_id "requestor"
_value (match m.requestor with Some x -> x | None -> "") ]
]
match m.isNew () with
| true ->
if m.isNew () then
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 ]
]
| false ->
else
div [ _class "pt-field" ] [
div [ _class "pt-checkbox-field" ] [
br []
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 []
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" ] [
label [] [ locStr s.["Expiration"] ]
label [] [ locStr s["Expiration"] ]
ReferenceList.expirationList s ((m.isNew >> not) ())
|> List.map (fun 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 pt-editor" ] [
label [ _for "text" ] [ locStr s.["Request"] ]
label [ _for "text" ] [ locStr s["Request"] ]
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)" ]
]
@ -80,24 +78,21 @@ let edit (m : EditRequest) today ctx vi =
/// View for the request e-mail results page
let email m vi =
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 addresses =
m.recipients
|> List.fold (fun (acc : StringBuilder) mbr -> acc.AppendFormat(", {0} <{1}>", mbr.memberName, mbr.email))
(StringBuilder ())
let addresses = String.Join (", ", m.recipients |> List.map (fun mbr -> $"{mbr.memberName} <{mbr.email}>"))
[ 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 ":"
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) ]
br []
br []
span [ _class "pt-email-heading" ] [ locStr s.["Plain-Text Format"]; rawText ":" ]
div[ _class "pt-email-canvas" ] [ pre [] [ str (m.asText s) ] ]
span [ _class "pt-email-heading" ] [ locStr s["Plain-Text Format"]; rawText ":" ]
div [ _class "pt-email-canvas" ] [ pre [] [ str (m.asText s) ] ]
]
|> Layout.Content.standard
|> Layout.standard vi pageTitle
@ -113,39 +108,38 @@ let list (m : RequestList) vi =
/// 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 l = I18N.forView "Requests/Lists"
use sw = new StringWriter ()
let raw = rawLocText sw
[ 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
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
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
| 0 -> p [] [ raw l.["There are no groups with public or password-protected request lists."] ]
match groups.Length with
| 0 -> p [] [ raw l["There are no groups with public or password-protected request lists."] ]
| count ->
tableSummary count s
table [ _class "pt-table pt-action-table" ] [
thead [] [
tr [] [
th [] [ locStr s.["Actions"] ]
th [] [ locStr s.["Church"] ]
th [] [ locStr s.["Group"] ]
th [] [ locStr s["Actions"] ]
th [] [ locStr s["Church"] ]
th [] [ locStr s["Group"] ]
]
]
grps
groups
|> List.map (fun grp ->
let grpId = flatGuid grp.smallGroupId
tr [] [
match grp.preferences.isPublic with
| true ->
a [ _href $"/web/prayer-requests/{grpId}/list"; _title s.["View"].Value ] [ icon "list" ]
| false ->
a [ _href $"/web/small-group/log-on/{grpId}"; _title s.["Log On"].Value ]
if grp.preferences.isPublic then
a [ _href $"/web/prayer-requests/{grpId}/list"; _title s["View"].Value ] [ icon "list" ]
else
a [ _href $"/web/small-group/log-on/{grpId}"; _title s["Log On"].Value ]
[ icon "verified_user" ]
|> List.singleton
|> td []
@ -168,12 +162,12 @@ let maintain m (ctx : HttpContext) vi =
let now = m.smallGroup.localDateNow (ctx.GetService<IClock> ())
let typs = ReferenceList.requestTypeList s |> Map.ofList
let updReq (req : PrayerRequest) =
match req.updateRequired now m.smallGroup.preferences.daysToExpire m.smallGroup.preferences.longTermUpdateWeeks with
| true -> "pt-request-update"
| false -> ""
if req.updateRequired now m.smallGroup.preferences.daysToExpire m.smallGroup.preferences.longTermUpdateWeeks then
"pt-request-update"
else ""
|> _class
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
let requests =
m.requests
@ -182,65 +176,63 @@ let maintain m (ctx : HttpContext) vi =
let reqText = htmlToPlainText req.text
let delAction = $"/web/prayer-request/{reqId}/delete"
let delPrompt =
[ s.["Are you sure you want to delete this {0}? This action cannot be undone.",
s.["Prayer Request"].Value.ToLower() ]
.Value
[ s["Are you sure you want to delete this {0}? This action cannot be undone.",
s["Prayer Request"].Value.ToLower() ].Value
"\\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
]
|> String.concat ""
tr [] [
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" ]
match req.isExpired now m.smallGroup.preferences.daysToExpire with
| true ->
if req.isExpired now m.smallGroup.preferences.daysToExpire then
a [ _href $"/web/prayer-request/{reqId}/restore"
_title l.["Restore This Inactive Request"].Value ]
_title l["Restore This Inactive Request"].Value ]
[ icon "visibility" ]
| false ->
else
a [ _href $"/web/prayer-request/{reqId}/expire"
_title l.["Expire This Request Immediately"].Value ]
_title l["Expire This Request Immediately"].Value ]
[ 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}')" ]
[ icon "delete_forever" ]
]
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 [] [
match reqText.Length with
| len when len < 60 -> rawText reqText
| _ -> rawText $"{reqText.[0..59]}&hellip;"
| _ -> rawText $"{reqText[0..59]}&hellip;"
]
])
|> List.ofSeq
[ div [ _class "pt-center-text" ] [
br []
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"] ]
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"] ]
rawText " &nbsp; &nbsp; &nbsp; "
a [ _href "/web/prayer-requests/view"; _title s.["View Prayer Request List"].Value ]
[ icon "list"; rawText " &nbsp;"; locStr s.["View Prayer Request List"] ]
a [ _href "/web/prayer-requests/view"; _title s["View Prayer Request List"].Value ]
[ icon "list"; rawText " &nbsp;"; locStr s["View Prayer Request List"] ]
match m.searchTerm with
| Some _ ->
rawText " &nbsp; &nbsp; &nbsp; "
a [ _href "/web/prayer-requests"; _title l.["Clear Search Criteria"].Value ]
[ icon "highlight_off"; rawText " &nbsp;"; raw l.["Clear Search Criteria"] ]
a [ _href "/web/prayer-requests"; _title l["Clear Search Criteria"].Value ]
[ icon "highlight_off"; rawText " &nbsp;"; raw l["Clear Search Criteria"] ]
| None -> ()
]
form [ _action "/web/prayer-requests"; _method "get"; _class "pt-center-text pt-search-form" ] [
input [ _type "text"
_name "search"
_placeholder l.["Search requests..."].Value
_placeholder l["Search requests..."].Value
_value (defaultArg m.searchTerm "")
]
space
submit [] "search" s.["Search"]
submit [] "search" s["Search"]
]
br []
tableSummary requests.Length s
@ -250,11 +242,11 @@ let maintain m (ctx : HttpContext) vi =
table [ _class "pt-table pt-action-table" ] [
thead [] [
tr [] [
th [] [ locStr s.["Actions"] ]
th [] [ locStr s.["Updated Date"] ]
th [] [ locStr s.["Type"] ]
th [] [ locStr s.["Requestor"] ]
th [] [ locStr s.["Request"] ]
th [] [ locStr s["Actions"] ]
th [] [ locStr s["Updated Date"] ]
th [] [ locStr s["Type"] ]
th [] [ locStr s["Requestor"] ]
th [] [ locStr s["Request"] ]
]
]
tbody [] requests
@ -263,15 +255,15 @@ let maintain m (ctx : HttpContext) vi =
br []
match m.onlyActive with
| Some true ->
raw l.["Inactive requests are currently not shown"]
raw l["Inactive requests are currently not shown"]
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
| true ->
raw l.["Inactive requests are currently shown"]
raw l["Inactive requests are currently shown"]
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 []
| false -> ()
@ -285,12 +277,12 @@ let maintain m (ctx : HttpContext) vi =
// button (_type "submit" :: attrs) [ icon ico; rawText " &nbsp;"; locStr text ]
let withPage = match pg with 2 -> srch | _ -> ("page", string (pg - 1)) :: srch
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; "
match requests.Length = m.smallGroup.preferences.pageSize with
| true ->
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 -> ()
]
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
let print m version =
let s = I18N.localizer.Force ()
let pageTitle = $"""{s.["Prayer Requests"].Value} • {m.listGroup.name}"""
let imgAlt = $"""{s.["PrayerTracker"].Value} {s.["from Bit Badger Solutions"].Value}"""
let pageTitle = $"""{s["Prayer Requests"].Value} • {m.listGroup.name}"""
let imgAlt = $"""{s["PrayerTracker"].Value} {s["from Bit Badger Solutions"].Value}"""
article [] [
rawText (m.asHtml s)
br []
hr []
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;"
_alt imgAlt
_title imgAlt ]
@ -323,45 +315,38 @@ let print m version =
/// View for the prayer request list
let view m vi =
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 dtString = m.date.ToString "yyyy-MM-dd"
[ div [ _class "pt-center-text" ] [
br []
a [ _class "pt-icon-link"
_href $"/web/prayer-requests/print/{dtString}"
_title s.["View Printable"].Value ] [
icon "print"; rawText " &nbsp;"; locStr s.["View Printable"]
]
match m.canEmail with
| true ->
_title s["View Printable"].Value
] [ icon "print"; rawText " &nbsp;"; locStr s["View Printable"] ]
if m.canEmail then
spacer
match m.date.DayOfWeek = DayOfWeek.Sunday with
| true -> ()
| false ->
if m.date.DayOfWeek <> DayOfWeek.Sunday then
let rec findSunday (date : DateTime) =
match date.DayOfWeek = DayOfWeek.Sunday with
| true -> date
| false -> findSunday (date.AddDays 1.)
if date.DayOfWeek = DayOfWeek.Sunday then date else findSunday (date.AddDays 1.)
let sunday = findSunday m.date
a [ _class "pt-icon-link"
_href $"""/web/prayer-requests/view/{sunday.ToString "yyyy-MM-dd"}"""
_title s.["List for Next Sunday"].Value ] [
icon "update"; rawText " &nbsp;"; locStr s.["List for Next Sunday"]
_title s["List for Next Sunday"].Value ] [
icon "update"; rawText " &nbsp;"; locStr s["List for Next Sunday"]
]
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"
_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}')" ] [
icon "mail_outline"; rawText " &nbsp;"; locStr s.["Send via E-mail"]
icon "mail_outline"; rawText " &nbsp;"; locStr s["Send via E-mail"]
]
spacer
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"]
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"]
]
| false -> ()
]
br []
rawText (m.asHtml s)

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

@ -1,11 +1,11 @@
module PrayerTracker.Views.SmallGroup
open System.IO
open Giraffe.ViewEngine
open Microsoft.Extensions.Localization
open PrayerTracker
open PrayerTracker.Entities
open PrayerTracker.ViewModels
open System.IO
/// View for the announcement page
let announcement isAdmin ctx vi =
@ -15,40 +15,39 @@ let announcement isAdmin ctx vi =
csrfToken ctx
div [ _class "pt-field-row" ] [
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 ] []
]
]
match isAdmin with
| true ->
if isAdmin then
div [ _class "pt-field-row" ] [
div [ _class "pt-field" ] [
label [] [ locStr s.["Send Announcement to"]; rawText ":" ]
label [] [ locStr s["Send Announcement to"]; rawText ":" ]
div [ _class "pt-center-text" ] [
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"
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-checkbox-field" ] [
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" ] [
label [ _for "requestType" ] [ locStr s.["Request Type"] ]
label [ _for "requestType" ] [ locStr s["Request Type"] ]
reqTypes
|> Seq.ofList
|> Seq.map (fun (typ, desc) -> typ.code, desc.Value)
|> 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)" ]
]
@ -59,11 +58,11 @@ let announcement isAdmin ctx vi =
/// View for once an announcement has been sent
let announcementSent (m : Announcement) vi =
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 ]
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 ()) ] ]
]
|> 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) ]
div [ _class "pt-field-row" ] [
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 ]
]
]
div [ _class "pt-field-row" ] [
div [ _class "pt-field" ] [
label [ _for "churchId" ] [ locStr s.["Church"] ]
label [ _for "churchId" ] [ locStr s["Church"] ]
seq {
"", selectDefault s.["Select Church"].Value
"", selectDefault s["Select Church"].Value
yield! churches |> List.map (fun c -> flatGuid c.churchId, c.name)
}
|> 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
|> 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) ]
div [ _class "pt-field-row" ] [
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 ]
]
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 ]
]
]
div [ _class "pt-field-row" ] [
div [ _class "pt-field" ] [
label [ _for "emailType" ] [ locStr s.["E-mail Format"] ]
label [ _for "emailType" ] [ locStr s["E-mail Format"] ]
typs
|> Seq.map (fun typ -> fst typ, (snd typ).Value)
|> selectList "emailType" m.emailType []
]
]
div [ _class "pt-field-row" ] [ submit [] "save" s.["Save"] ]
div [ _class "pt-field-row" ] [ submit [] "save" s["Save"] ]
]
|> List.singleton
|> Layout.Content.standard
@ -140,30 +139,31 @@ let logOn (grps : SmallGroup list) grpId ctx vi =
csrfToken ctx
div [ _class "pt-field-row" ] [
div [ _class "pt-field" ] [
label [ _for "smallGroupId" ] [ locStr s.["Group"] ]
label [ _for "smallGroupId" ] [ locStr s["Group"] ]
seq {
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
yield! grps
"", selectDefault s["Select Group"].Value
yield!
grps
|> List.map (fun grp -> flatGuid grp.smallGroupId, $"{grp.church.name} | {grp.name}")
}
|> selectList "smallGroupId" grpId [ _required ]
]
div [ _class "pt-field" ] [
label [ _for "password" ] [ locStr s.["Password"] ]
label [ _for "password" ] [ locStr s["Password"] ]
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" ] [
input [ _type "checkbox"; _name "rememberMe"; _id "rememberMe"; _value "True" ]
label [ _for "rememberMe" ] [ locStr s.["Remember Me"] ]
label [ _for "rememberMe" ] [ locStr s["Remember Me"] ]
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)" ]
]
@ -181,23 +181,24 @@ let maintain (grps : SmallGroup list) ctx vi =
table [ _class "pt-table pt-action-table" ] [
thead [] [
tr [] [
th [] [ locStr s.["Actions"] ]
th [] [ locStr s.["Name"] ]
th [] [ locStr s.["Church"] ]
th [] [ locStr s.["Time Zone"] ]
th [] [ locStr s["Actions"] ]
th [] [ locStr s["Name"] ]
th [] [ locStr s["Church"] ]
th [] [ locStr s["Time Zone"] ]
]
]
grps
|> List.map (fun g ->
let grpId = flatGuid g.smallGroupId
let delAction = $"/web/small-group/{grpId}/delete"
let delPrompt = s.["Are you sure you want to delete this {0}? This action cannot be undone.",
$"""{s.["Small Group"].Value.ToLower ()} ({g.name})""" ].Value
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
tr [] [
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
_title s.["Delete This Group"].Value
_title s["Delete This Group"].Value
_onclick $"return PT.confirmDelete('{delAction}','{delPrompt}')" ]
[ icon "delete_forever" ]
]
@ -209,10 +210,10 @@ let maintain (grps : SmallGroup list) ctx vi =
]
[ div [ _class "pt-center-text" ] [
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"
rawText " &nbsp;"
locStr s.["Add a New Group"]
locStr s["Add a New Group"]
]
br []
br []
@ -235,10 +236,10 @@ let members (mbrs : Member list) (emailTyps : Map<string, LocalizedString>) ctx
table [ _class "pt-table pt-action-table" ] [
thead [] [
tr [] [
th [] [ locStr s.["Actions"] ]
th [] [ locStr s.["Name"] ]
th [] [ locStr s.["E-mail Address"] ]
th [] [ locStr s.["Format"] ]
th [] [ locStr s["Actions"] ]
th [] [ locStr s["Name"] ]
th [] [ locStr s["E-mail Address"] ]
th [] [ locStr s["Format"] ]
]
]
mbrs
@ -246,28 +247,27 @@ let members (mbrs : Member list) (emailTyps : Map<string, LocalizedString>) ctx
let mbrId = flatGuid mbr.memberId
let delAction = $"/web/small-group/member/{mbrId}/delete"
let delPrompt =
s.["Are you sure you want to delete this {0}? This action cannot be undone.", s.["group member"]]
.Value
.Replace("?", $" ({mbr.memberName})?")
s["Are you sure you want to delete this {0}? This action cannot be undone.", s["group member"]]
.Value.Replace("?", $" ({mbr.memberName})?")
tr [] [
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" ]
a [ _href delAction
_title s.["Delete This Group Member"].Value
_title s["Delete This Group Member"].Value
_onclick $"return PT.confirmDelete('{delAction}','{delPrompt}')" ]
[ icon "delete_forever" ]
]
td [] [ str mbr.memberName ]
td [] [ str mbr.email ]
td [] [ locStr emailTyps.[defaultArg mbr.format ""] ]
td [] [ locStr emailTyps[defaultArg mbr.format ""] ]
])
|> tbody []
]
[ div [ _class"pt-center-text" ] [
br []
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"] ]
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"] ]
br []
br []
]
@ -288,52 +288,53 @@ let overview m vi =
section [] [
header [ _role "heading" ] [
iconSized 72 "bookmark_border"
locStr s.["Quick Actions"]
locStr s["Quick Actions"]
]
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 []
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 []
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 [] [
header [ _role "heading" ] [
iconSized 72 "question_answer"
locStr s.["Prayer Requests"]
locStr s["Prayer Requests"]
]
div [] [
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 []
for cat in m.activeReqsByCat do
str (cat.Value.ToString "N0")
space
locStr typs.[cat.Key]
locStr typs[cat.Key]
br []
br []
str (m.allReqs.ToString "N0")
space
locStr s.["Total Requests"]
locStr s["Total Requests"]
hr []
a [ _href "/web/prayer-requests/maintain" ] [
icon "compare_arrows"
linkSpacer
locStr s.["Maintain Prayer Requests"]
locStr s["Maintain Prayer Requests"]
]
]
]
section [] [
header [ _role "heading" ] [
iconSized 72 "people_outline"
locStr s.["Group Members"]
locStr s["Group Members"]
]
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 []
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%; } }" ]
csrfToken ctx
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" ] [
label [ _for "expireDays" ] [ locStr s.["Requests Expire After"] ]
label [ _for "expireDays" ] [ locStr s["Requests Expire After"] ]
span [] [
input [ _type "number"; _name "expireDays"; _id "expireDays"; _min "1"; _max "30"; _required; _autofocus
_value (string m.expireDays) ]
space; str (s.["Days"].Value.ToLower ())
input [ _type "number"; _name "expireDays"; _id "expireDays"; _min "1"; _max "30"; _required
_autofocus; _value (string m.expireDays) ]
space; str (s["Days"].Value.ToLower ())
]
]
div [ _class "pt-field" ] [
label [ _for "daysToKeepNew" ] [ locStr s.["Requests “New” For"] ]
label [ _for "daysToKeepNew" ] [ locStr s["Requests “New” For"] ]
span [] [
input [ _type "number"; _name "daysToKeepNew"; _id "daysToKeepNew"; _min "1"; _max "30"; _required
_value (string m.daysToKeepNew) ]
space; str (s.["Days"].Value.ToLower ())
input [ _type "number"; _name "daysToKeepNew"; _id "daysToKeepNew"; _min "1"; _max "30"
_required; _value (string m.daysToKeepNew) ]
space; str (s["Days"].Value.ToLower ())
]
]
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 [] [
input [ _type "number"; _name "longTermUpdateWeeks"; _id "longTermUpdateWeeks"; _min "1"; _max "30"
_required; _value (string m.longTermUpdateWeeks) ]
space; str (s.["Weeks"].Value.ToLower ())
input [ _type "number"; _name "longTermUpdateWeeks"; _id "longTermUpdateWeeks"; _min "1"
_max "30"; _required; _value (string m.longTermUpdateWeeks) ]
space; str (s["Weeks"].Value.ToLower ())
]
]
]
]
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
label [ _for "requestSort_D" ] [ locStr s.["Sort by Last Updated Date"] ]
label [ _for "requestSort_D" ] [ locStr s["Sort by Last Updated Date"] ]
rawText " &nbsp; "
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 [] [
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" ] [
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 ]
]
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
_value m.emailFromAddress ]
]
]
div [ _class "pt-field-row" ] [
div [ _class "pt-field" ] [
label [ _for "defaultEmailType" ] [ locStr s.["E-mail Format"] ]
label [ _for "defaultEmailType" ] [ locStr s["E-mail Format"] ]
seq {
"", selectDefault s.["Select"].Value
yield! ReferenceList.emailTypeList HtmlFormat s
"", selectDefault s["Select"].Value
yield!
ReferenceList.emailTypeList HtmlFormat s
|> Seq.skip 1
|> Seq.map (fun typ -> fst typ, (snd typ).Value)
}
@ -415,19 +417,19 @@ let preferences (m : EditPreferences) (tzs : TimeZone list) ctx vi =
]
]
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" ] [
label [ _class "pt-center-text" ] [ locStr s.["Color of Heading Lines"] ]
label [ _class "pt-center-text" ] [ locStr s["Color of Heading Lines"] ]
span [] [
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
[ _id "headingLineColor_Select"
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
label [ _for "headingLineType_RGB" ] [ locStr s.["Custom Color"] ]
label [ _for "headingLineType_RGB" ] [ locStr s["Custom Color"] ]
input [ _type "color"
_name "headingLineColor"
_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" ] [
label [ _class "pt-center-text" ] [ locStr s.["Color of Heading Text"] ]
label [ _class "pt-center-text" ] [ locStr s["Color of Heading Text"] ]
span [] [
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
[ _id "headingTextColor_Select"
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
label [ _for "headingTextType_RGB" ] [ locStr s.["Custom Color"] ]
label [ _for "headingTextType_RGB" ] [ locStr s["Custom Color"] ]
input [ _type "color"
_name "headingTextColor"
_id "headingTextColor_Color"
@ -458,87 +460,86 @@ let preferences (m : EditPreferences) (tzs : TimeZone list) ctx vi =
]
]
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" ] [
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 ]
]
div [ _class "pt-field-row" ] [
div [ _class "pt-field" ] [
label [ _for "headingFontSize" ] [ locStr s.["Heading Text Size"] ]
input [ _type "number"; _name "headingFontSize"; _id "headingFontSize"; _min "8"; _max "24"; _required
_value (string m.headingFontSize) ]
label [ _for "headingFontSize" ] [ locStr s["Heading Text Size"] ]
input [ _type "number"; _name "headingFontSize"; _id "headingFontSize"; _min "8"; _max "24"
_required; _value (string m.headingFontSize) ]
]
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
_value (string m.listFontSize) ]
]
]
]
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" ] [
label [ _for "timeZone" ] [ locStr s.["Time Zone"] ]
label [ _for "timeZone" ] [ locStr s["Time Zone"] ]
seq {
"", selectDefault s.["Select"].Value
"", selectDefault s["Select"].Value
yield! tzs |> List.map (fun tz -> tz.timeZoneId, (TimeZones.name tz.timeZoneId s).Value)
}
|> selectList "timeZone" m.timeZone [ _required ]
]
]
div [ _class "pt-field" ] [
label [] [ locStr s.["Request List Visibility"] ]
label [] [ locStr s["Request List Visibility"] ]
span [] [
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;"
radio "listVisibility" "viz_Private" (string RequestVisibility.``private``) (string m.listVisibility)
label [ _for "viz_Private" ] [ locStr s.["Private"] ]
radio "listVisibility" "viz_Private" (string RequestVisibility.``private``)
(string m.listVisibility)
label [ _for "viz_Private" ] [ locStr s["Private"] ]
rawText " &nbsp;"
radio "listVisibility" "viz_Password" (string RequestVisibility.passwordProtected) (string m.listVisibility)
label [ _for "viz_Password" ] [ locStr s.["Password Protected"] ]
radio "listVisibility" "viz_Password" (string RequestVisibility.passwordProtected)
(string m.listVisibility)
label [ _for "viz_Password" ] [ locStr s["Password Protected"] ]
]
]
div [ _id "divClassPassword"
match m.listVisibility = RequestVisibility.passwordProtected with
| true -> _class "pt-field-row pt-fadeable pt-show"
| false -> _class "pt-field-row pt-fadeable"
] [
let classSuffix = if m.listVisibility = RequestVisibility.passwordProtected then " pt-show" else ""
div [ _id "divClassPassword"; _class $"pt-field-row pt-fadeable{classSuffix}" ] [
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";
_value (match m.groupPassword with Some x -> x | None -> "") ]
]
]
div [ _class "pt-field-row" ] [
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
_value (string m.pageSize) ]
]
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
|> List.map (fun (code, desc) -> code, desc.Value)
|> 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 [] [
rawText "** "
raw l.["List font names, separated by commas."]
raw l["List font names, separated by commas."]
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
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 [] [
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)" ]
]

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

@ -7,7 +7,7 @@ open PrayerTracker.ViewModels
/// View for the group assignment page
let assignGroups m groups curGroups ctx vi =
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" ] [
csrfToken ctx
input [ _type "hidden"; _name "userId"; _value (flatGuid m.userId) ]
@ -16,7 +16,7 @@ let assignGroups m groups curGroups ctx vi =
thead [] [
tr [] [
th [] [ rawText "&nbsp;" ]
th [] [ locStr s.["Group"] ]
th [] [ locStr s["Group"] ]
]
]
groups
@ -34,7 +34,7 @@ let assignGroups m groups curGroups ctx vi =
])
|> 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
|> Layout.Content.standard
@ -45,22 +45,22 @@ let assignGroups m groups curGroups ctx vi =
let changePassword ctx vi =
let s = I18N.localizer.Force ()
[ 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"
_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; } "]
csrfToken ctx
div [ _class "pt-field-row" ] [
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 ]
]
]
div [ _class "pt-field-row" ] [
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 ]
]
div [ _class "pt-field" ] [
@ -70,7 +70,7 @@ let changePassword ctx vi =
]
div [ _class "pt-field-row" ] [
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
let edit (m : EditUser) ctx vi =
let s = I18N.localizer.Force ()
let pageTitle = match m.isNew () with true -> "Add a New User" | false -> "Edit User"
let pwPlaceholder = s.[match m.isNew () with true -> "" | false -> "No change"].Value
let pageTitle = if m.isNew () then "Add a New User" else "Edit User"
let pwPlaceholder = s[if m.isNew () then "" else "No change"].Value
[ 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 ]
[ rawText "#firstName, #lastName, #password, #passwordConfirm { width: 10rem; } #emailAddress { width: 20rem; } " ]
csrfToken ctx
input [ _type "hidden"; _name "userId"; _value (flatGuid m.userId) ]
div [ _class "pt-field-row" ] [
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 ]
]
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 ]
]
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 ]
]
]
div [ _class "pt-field-row" ] [
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 ]
]
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 ]
]
]
@ -119,9 +119,9 @@ let edit (m : EditUser) ctx vi =
_id "isAdmin"
_value "True"
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 ()}))" ]
]
@ -138,33 +138,33 @@ let logOn (m : UserLogOn) groups ctx vi =
input [ _type "hidden"; _name "redirectUrl"; _value (defaultArg m.redirectUrl "") ]
div [ _class "pt-field-row" ] [
div [ _class "pt-field" ] [
label [ _for "emailAddress"] [ locStr s.["E-mail Address"] ]
input [ _type "email"; _name "emailAddress"; _id "emailAddress"; _value m.emailAddress; _required; _autofocus ]
label [ _for "emailAddress"] [ locStr s["E-mail Address"] ]
input [ _type "email"; _name "emailAddress"; _id "emailAddress"; _value m.emailAddress; _required
_autofocus ]
]
div [ _class "pt-field" ] [
label [ _for "password" ] [ locStr s.["Password"] ]
label [ _for "password" ] [ locStr s["Password"] ]
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" ] [
label [ _for "smallGroupId" ] [ locStr s.["Group"] ]
label [ _for "smallGroupId" ] [ locStr s["Group"] ]
seq {
"", selectDefault s.["Select Group"].Value
"", selectDefault s["Select Group"].Value
yield! groups
}
|> selectList "smallGroupId" "" [ _required ]
]
]
div [ _class "pt-checkbox-field" ] [
input [ _type "checkbox"; _name "rememberMe"; _id "rememberMe"; _value "True" ]
label [ _for "rememberMe" ] [ locStr s.["Remember Me"] ]
label [ _for "rememberMe" ] [ locStr s["Remember Me"] ]
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
|> Layout.Content.standard
@ -181,40 +181,38 @@ let maintain (users : User list) ctx vi =
table [ _class "pt-table pt-action-table" ] [
thead [] [
tr [] [
th [] [ locStr s.["Actions"] ]
th [] [ locStr s.["Name"] ]
th [] [ locStr s.["Admin?"] ]
th [] [ locStr s["Actions"] ]
th [] [ locStr s["Name"] ]
th [] [ locStr s["Admin?"] ]
]
]
users
|> List.map (fun user ->
let userId = flatGuid user.userId
let delAction = $"/web/user/{userId}/delete"
let delPrompt = s.["Are you sure you want to delete this {0}? This action cannot be undone.",
$"""{s.["User"].Value.ToLower ()} ({user.fullName})"""].Value
let delPrompt = s["Are you sure you want to delete this {0}? This action cannot be undone.",
$"""{s["User"].Value.ToLower ()} ({user.fullName})"""].Value
tr [] [
td [] [
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}/edit"; _title s["Edit This User"].Value ] [ icon "edit" ]
a [ _href $"/web/user/{userId}/small-groups"; _title s["Assign Groups to This User"].Value ]
[ icon "group" ]
a [ _href delAction
_title s.["Delete This User"].Value
_title s["Delete This User"].Value
_onclick $"return PT.confirmDelete('{delAction}','{delPrompt}')" ]
[ icon "delete_forever" ]
]
td [] [ str user.fullName ]
td [ _class "pt-center-text" ] [
match user.isAdmin with
| true -> strong [] [ locStr s.["Yes"] ]
| false -> locStr s.["No"]
if user.isAdmin then strong [] [ locStr s["Yes"] ] else locStr s["No"]
]
])
|> tbody []
]
[ div [ _class "pt-center-text" ] [
br []
a [ _href $"/web/user/{emptyGuid}/edit"; _title s.["Add a New User"].Value ]
[ icon "add_circle"; rawText " &nbsp;"; locStr s.["Add a New User"] ]
a [ _href $"/web/user/{emptyGuid}/edit"; _title s["Add a New User"].Value ]
[ icon "add_circle"; rawText " &nbsp;"; locStr s["Add a New User"] ]
br []
br []
]

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

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

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

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

50
src/PrayerTracker/Church.fs
View File

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

45
src/PrayerTracker/CommonFunctions.fs
View File

@ -2,6 +2,10 @@
[<AutoOpen>]
module PrayerTracker.Handlers.CommonFunctions
open System
open System.Net
open System.Reflection
open System.Threading.Tasks
open Giraffe
open Microsoft.AspNetCore.Antiforgery
open Microsoft.AspNetCore.Html
@ -12,10 +16,6 @@ open Microsoft.Extensions.Localization
open PrayerTracker
open PrayerTracker.Cookies
open PrayerTracker.ViewModels
open System
open System.Net
open System.Reflection
open System.Threading.Tasks
/// Create a select list from an enumeration
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
| true ->
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))
]
@ -81,7 +81,8 @@ let viewInfo (ctx : HttpContext) startTicks =
}
ctx.Response.Cookies.Append
(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 -> ()
{ AppViewInfo.fresh with
version = appVersion
@ -97,7 +98,7 @@ let renderHtml next ctx view =
/// Display an error regarding form submission
let bindError (msg : string) next (ctx : HttpContext) =
System.Console.WriteLine msg
Console.WriteLine msg
ctx.SetStatusCode 400
text msg next ctx
@ -108,13 +109,12 @@ let fourOhFour next (ctx : HttpContext) =
/// Handler to validate CSRF prevention token
let validateCSRF : HttpHandler =
fun next ctx -> task {
let validateCSRF : HttpHandler = fun next ctx -> task {
match! (ctx.GetService<IAntiforgery> ()).IsRequestValidAsync ctx with
| true -> return! next ctx
| false ->
return! (clearResponse >=> setStatusCode 400 >=> text "Quit hacking...") (fun _ -> Task.FromResult None) ctx
}
}
/// Add a message to the session
@ -168,7 +168,7 @@ let requireAccess level : HttpHandler =
let logOnUserFromTimeoutCookie (ctx : HttpContext) = task {
// Make sure the cookie hasn't been tampered with
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 ->
let! user = ctx.db.TryUserById c.Id
match user with
@ -184,7 +184,7 @@ let requireAccess level : HttpHandler =
/// Attempt to log the user on from their stored cookie
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 ->
let! user = ctx.db.TryUserLogOnByCookie c.Id c.GroupId c.PasswordHash
match user with
@ -203,9 +203,8 @@ let requireAccess level : HttpHandler =
ctx.Session.smallGroup |> Option.isSome
/// Attempt to log the small group on from their stored cookie
let logOnGroupFromCookie (ctx : HttpContext) =
task {
match GroupCookie.fromPayload ctx.Request.Cookies.[Key.Cookie.group] with
let logOnGroupFromCookie (ctx : HttpContext) = task {
match GroupCookie.fromPayload ctx.Request.Cookies[Key.Cookie.group] with
| Some c ->
let! grp = ctx.db.TryGroupLogOnByCookie c.GroupId c.PasswordHash sha1Hash
match grp with
@ -217,17 +216,13 @@ let requireAccess level : HttpHandler =
| None -> ()
}
fun next ctx -> FSharp.Control.Tasks.Affine.task {
fun next ctx -> task {
// Auto-logon user or class, if required
match isUserLoggedOn ctx with
| true -> ()
| false ->
if not (isUserLoggedOn ctx) then
do! logOnUserFromTimeoutCookie ctx
match isUserLoggedOn ctx with
| true -> ()
| false ->
if not (isUserLoggedOn ctx) then
do! logOnUserFromCookie ctx
match isGroupLoggedOn ctx with true -> () | false -> do! logOnGroupFromCookie ctx
if not (isGroupLoggedOn ctx) then do! logOnGroupFromCookie ctx
match true with
| _ when level |> List.contains Public -> return! next ctx
@ -238,7 +233,7 @@ let requireAccess level : HttpHandler =
| true -> return! next ctx
| false ->
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
| _ when level |> List.contains User ->
// 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
| _ ->
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
}

24
src/PrayerTracker/Cookies.fs
View File

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

17
src/PrayerTracker/Email.fs
View File

@ -17,7 +17,7 @@ let getConnection () = task {
let client = new SmtpClient ()
do! client.ConnectAsync ("127.0.0.1", 25, SecureSocketOptions.None)
return client
}
}
/// Create a mail message object, filled with everything but the body content
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>"""
body
"""<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>"
s.["from Bit Badger Solutions"].Value
s["from Bit Badger Solutions"].Value
"</small></div></body></html>"
]
|> String.concat ""
@ -48,9 +48,9 @@ let createTextMessage grp subj body (s : IStringLocalizer) =
let bodyText =
[ body
"\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"
s.["from Bit Badger Solutions"].Value
s["from Bit Badger Solutions"].Value
]
|> String.concat ""
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
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)
match emailType with
| HtmlFormat ->
@ -74,4 +77,4 @@ let sendEmails (client : SmtpClient) (recipients : Member list) grp subj html te
plainTextMsg.To.Add emailTo
do! client.SendAsync plainTextMsg
plainTextMsg.To.Clear ()
}
}

36
src/PrayerTracker/Home.fs
View File

@ -1,34 +1,28 @@
module PrayerTracker.Handlers.Home
open System
open System.Globalization
open Giraffe
open Microsoft.AspNetCore.Http
open Microsoft.AspNetCore.Localization
open PrayerTracker
open System
open System.Globalization
/// GET /error/[error-code]
let error code : HttpHandler =
requireAccess [ AccessLevel.Public ]
>=> fun next ctx ->
let error code : HttpHandler = requireAccess [ AccessLevel.Public ] >=> fun next ctx ->
viewInfo ctx DateTime.Now.Ticks
|> Views.Home.error code
|> renderHtml next ctx
/// GET /
let homePage : HttpHandler =
requireAccess [ AccessLevel.Public ]
>=> fun next ctx ->
let homePage : HttpHandler = requireAccess [ AccessLevel.Public ] >=> fun next ctx ->
viewInfo ctx DateTime.Now.Ticks
|> Views.Home.index
|> renderHtml next ctx
/// GET /language/[culture]
let language culture : HttpHandler =
requireAccess [ AccessLevel.Public ]
>=> fun next ctx ->
let language culture : HttpHandler = requireAccess [ AccessLevel.Public ] >=> fun next ctx ->
try
match culture with
| null
@ -47,44 +41,36 @@ let language culture : HttpHandler =
CookieRequestCultureProvider.MakeCookieValue (RequestCulture c),
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
/// GET /legal/privacy-policy
let privacyPolicy : HttpHandler =
requireAccess [ AccessLevel.Public ]
>=> fun next ctx ->
let privacyPolicy : HttpHandler = requireAccess [ AccessLevel.Public ] >=> fun next ctx ->
viewInfo ctx DateTime.Now.Ticks
|> Views.Home.privacyPolicy
|> renderHtml next ctx
/// GET /legal/terms-of-service
let tos : HttpHandler =
requireAccess [ AccessLevel.Public ]
>=> fun next ctx ->
let tos : HttpHandler = requireAccess [ AccessLevel.Public ] >=> fun next ctx ->
viewInfo ctx DateTime.Now.Ticks
|> Views.Home.termsOfService
|> renderHtml next ctx
/// GET /log-off
let logOff : HttpHandler =
requireAccess [ AccessLevel.Public ]
>=> fun next ctx ->
let logOff : HttpHandler = requireAccess [ AccessLevel.Public ] >=> fun next ctx ->
ctx.Session.Clear ()
// Remove cookies if they exist
Key.Cookie.logOffCookies |> List.iter ctx.Response.Cookies.Delete
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
/// GET /unauthorized
let unauthorized : HttpHandler =
requireAccess [ AccessLevel.Public ]
>=> fun next ctx ->
let unauthorized : HttpHandler = requireAccess [ AccessLevel.Public ] >=> fun next ctx ->
viewInfo ctx DateTime.Now.Ticks
|> Views.Home.unauthorized
|> renderHtml next ctx

153
src/PrayerTracker/PrayerRequest.fs
View File

@ -1,13 +1,13 @@
module PrayerTracker.Handlers.PrayerRequest
open System
open System.Threading.Tasks
open Giraffe
open Microsoft.AspNetCore.Http
open NodaTime
open PrayerTracker
open PrayerTracker.Entities
open PrayerTracker.ViewModels
open System
open System.Threading.Tasks
/// Retrieve a prayer request, and ensure that it belongs to the current class
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 _ ->
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")
| None -> return Error fourOhFour
}
}
/// 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 clock = ctx.GetService<IClock> ()
let listDate =
match date with
| Some d -> d
| None -> grp.localDateNow clock
let reqs = ctx.db.AllRequestsForSmallGroup grp clock (Some listDate) true 0
let listDate = match date with Some d -> d | None -> grp.localDateNow clock
let! reqs = ctx.db.AllRequestsForSmallGroup grp clock (Some listDate) true 0
return
{ requests = reqs |> List.ofSeq
date = listDate
listGroup = grp
@ -36,6 +34,7 @@ let private generateRequestList ctx date =
canEmail = ctx.Session.user |> Option.isSome
recipients = []
}
}
/// Parse a string into a date (optionally, of course)
let private parseListDate (date : string option) =
@ -45,106 +44,92 @@ let private parseListDate (date : string option) =
/// GET /prayer-request/[request-id]/edit
let edit (reqId : PrayerRequestId) : HttpHandler =
requireAccess [ User ]
>=> fun next ctx -> task {
let edit (reqId : PrayerRequestId) : HttpHandler = requireAccess [ User ] >=> fun next ctx -> task {
let startTicks = DateTime.Now.Ticks
let grp = currentGroup ctx
let now = grp.localDateNow (ctx.GetService<IClock> ())
match reqId = Guid.Empty with
| true ->
if reqId = Guid.Empty then
return!
{ viewInfo ctx startTicks with script = [ "ckeditor/ckeditor" ]; helpLink = Some Help.editRequest }
|> Views.PrayerRequest.edit EditRequest.empty (now.ToString "yyyy-MM-dd") ctx
|> renderHtml next ctx
| false ->
else
match! findRequest ctx reqId with
| Ok req ->
let s = Views.I18N.localizer.Force ()
match req.isExpired now grp.preferences.daysToExpire with
| true ->
if req.isExpired now grp.preferences.daysToExpire then
{ UserMessage.warning with
text = htmlLocString s.["This request is expired."]
text = htmlLocString s["This request is expired."]
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.["Expire Immediately"], s.["Check to not update the date"]]
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"]]
|> (htmlLocString >> Some)
}
|> addUserMessage ctx
| false -> ()
return!
{ viewInfo ctx startTicks with script = [ "ckeditor/ckeditor" ]; helpLink = Some Help.editRequest }
|> Views.PrayerRequest.edit (EditRequest.fromRequest req) "" ctx
|> renderHtml next ctx
| Error e -> return! e next ctx
}
}
/// GET /prayer-requests/email/[date]
let email date : HttpHandler =
requireAccess [ User ]
>=> fun next ctx -> task {
let email date : HttpHandler = requireAccess [ User ] >=> fun next ctx -> task {
let startTicks = DateTime.Now.Ticks
let s = Views.I18N.localizer.Force ()
let listDate = parseListDate (Some date)
let grp = currentGroup ctx
let list = generateRequestList ctx listDate
let! list = generateRequestList ctx listDate
let! recipients = ctx.db.AllMembersForSmallGroup grp.smallGroupId
use! client = Email.getConnection ()
do! Email.sendEmails client recipients
grp s.["Prayer Requests for {0} - {1:MMMM d, yyyy}", grp.name, list.date].Value
grp s["Prayer Requests for {0} - {1:MMMM d, yyyy}", grp.name, list.date].Value
(list.asHtml s) (list.asText s) s
return!
viewInfo ctx startTicks
|> Views.PrayerRequest.email { list with recipients = recipients }
|> renderHtml next ctx
}
}
/// POST /prayer-request/[request-id]/delete
let delete reqId : HttpHandler =
requireAccess [ User ]
>=> validateCSRF
>=> fun next ctx -> task {
let delete reqId : HttpHandler = requireAccess [ User ] >=> validateCSRF >=> fun next ctx -> task {
match! findRequest ctx reqId with
| Ok req ->
let s = Views.I18N.localizer.Force ()
ctx.db.PrayerRequests.Remove req |> ignore
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
| Error e -> return! e next ctx
}
}
/// GET /prayer-request/[request-id]/expire
let expire reqId : HttpHandler =
requireAccess [ User ]
>=> fun next ctx -> task {
let expire reqId : HttpHandler = requireAccess [ User ] >=> fun next ctx -> task {
match! findRequest ctx reqId with
| Ok req ->
let s = Views.I18N.localizer.Force ()
ctx.db.UpdateEntry { req with expiration = Forced }
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
| Error e -> return! e next ctx
}
}
/// GET /prayer-requests/[group-id]/list
let list groupId : HttpHandler =
requireAccess [ AccessLevel.Public ]
>=> fun next ctx -> task {
let list groupId : HttpHandler = requireAccess [ AccessLevel.Public ] >=> fun next ctx -> task {
let startTicks = DateTime.Now.Ticks
match! ctx.db.TryGroupById groupId with
| Some grp when grp.preferences.isPublic ->
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!
viewInfo ctx startTicks
|> Views.PrayerRequest.list
{ requests = List.ofSeq reqs
{ requests = reqs
date = grp.localDateNow clock
listGroup = grp
showHeader = true
@ -154,92 +139,88 @@ let list groupId : HttpHandler =
|> renderHtml next ctx
| Some _ ->
let s = Views.I18N.localizer.Force ()
addError ctx s.["The request list for the group you tried to view is not public."]
addError ctx s["The request list for the group you tried to view is not public."]
return! redirectTo false "/web/unauthorized" next ctx
| None -> return! fourOhFour next ctx
}
}
/// GET /prayer-requests/lists
let lists : HttpHandler =
requireAccess [ AccessLevel.Public ]
>=> fun next ctx -> task {
let lists : HttpHandler = requireAccess [ AccessLevel.Public ] >=> fun next ctx -> task {
let startTicks = DateTime.Now.Ticks
let! grps = ctx.db.PublicAndProtectedGroups ()
let! groups = ctx.db.PublicAndProtectedGroups ()
return!
viewInfo ctx startTicks
|> Views.PrayerRequest.lists grps
|> Views.PrayerRequest.lists groups
|> renderHtml next ctx
}
}
/// GET /prayer-requests[/inactive?]
/// - OR -
/// GET /prayer-requests?search=[search-query]
let maintain onlyActive : HttpHandler =
requireAccess [ User ]
>=> fun next ctx ->
let maintain onlyActive : HttpHandler = requireAccess [ User ] >=> fun next ctx -> task {
let startTicks = DateTime.Now.Ticks
let grp = currentGroup ctx
let pageNbr =
match ctx.GetQueryStringValue "page" with
| Ok pg -> match Int32.TryParse pg with true, p -> p | false, _ -> 1
| Error _ -> 1
let m =
let! m = backgroundTask {
match ctx.GetQueryStringValue "search" with
| Ok srch ->
| Ok search ->
let! reqs = ctx.db.SearchRequestsForSmallGroup grp search pageNbr
return
{ MaintainRequests.empty with
requests = ctx.db.SearchRequestsForSmallGroup grp srch pageNbr
searchTerm = Some srch
requests = reqs
searchTerm = Some search
pageNbr = Some pageNbr
}
| Error _ ->
let! reqs = ctx.db.AllRequestsForSmallGroup grp (ctx.GetService<IClock> ()) None onlyActive pageNbr
return
{ MaintainRequests.empty with
requests = ctx.db.AllRequestsForSmallGroup grp (ctx.GetService<IClock> ()) None onlyActive pageNbr
requests = reqs
onlyActive = Some onlyActive
pageNbr = match onlyActive with true -> None | false -> Some pageNbr
}
}
return!
{ viewInfo ctx startTicks with helpLink = Some Help.maintainRequests }
|> Views.PrayerRequest.maintain { m with smallGroup = grp } ctx
|> renderHtml next ctx
}
/// GET /prayer-request/print/[date]
let print date : HttpHandler =
requireAccess [ User; Group ]
>=> fun next ctx ->
let list = parseListDate (Some date) |> generateRequestList ctx
let print date : HttpHandler = requireAccess [ User; Group ] >=> fun next ctx -> task {
let! list = generateRequestList ctx (parseListDate (Some date))
return!
Views.PrayerRequest.print list appVersion
|> renderHtml next ctx
}
/// GET /prayer-request/[request-id]/restore
let restore reqId : HttpHandler =
requireAccess [ User ]
>=> fun next ctx -> task {
let restore reqId : HttpHandler = requireAccess [ User ] >=> fun next ctx -> task {
match! findRequest ctx reqId with
| Ok req ->
let s = Views.I18N.localizer.Force ()
ctx.db.UpdateEntry { req with expiration = Automatic; updatedDate = DateTime.Now }
let! _ = ctx.db.SaveChangesAsync ()
addInfo ctx s.["Successfully {0} prayer request", s.["Restored"].Value.ToLower ()]
addInfo ctx s["Successfully {0} prayer request", s["Restored"].Value.ToLower ()]
return! redirectTo false "/web/prayer-requests" next ctx
| Error e -> return! e next ctx
}
}
/// POST /prayer-request/save
let save : HttpHandler =
requireAccess [ User ]
>=> validateCSRF
>=> fun next ctx -> task {
let save : HttpHandler = requireAccess [ User ] >=> validateCSRF >=> fun next ctx -> task {
match! ctx.TryBindFormAsync<EditRequest> () with
| Ok m ->
let! req =
match m.isNew () with
| true -> Task.FromResult (Some { PrayerRequest.empty with prayerRequestId = Guid.NewGuid () })
| false -> ctx.db.TryRequestById m.requestId
if m.isNew () then Task.FromResult (Some { PrayerRequest.empty with prayerRequestId = Guid.NewGuid () })
else ctx.db.TryRequestById m.requestId
match req with
| Some pr ->
let upd8 =
@ -262,23 +243,23 @@ let save : HttpHandler =
}
| false when Option.isSome m.skipDateUpdate && Option.get m.skipDateUpdate -> upd8
| 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 s = Views.I18N.localizer.Force ()
let act = match m.isNew () with true -> "Added" | false -> "Updated"
addInfo ctx s.["Successfully {0} prayer request", s.[act].Value.ToLower ()]
let act = if m.isNew () then "Added" else "Updated"
addInfo ctx s["Successfully {0} prayer request", s.[act].Value.ToLower ()]
return! redirectTo false "/web/prayer-requests" next ctx
| None -> return! fourOhFour next ctx
| Error e -> return! bindError e next ctx
}
}
/// GET /prayer-request/view/[date?]
let view date : HttpHandler =
requireAccess [ User; Group ]
>=> fun next ctx ->
let view date : HttpHandler = requireAccess [ User; Group ] >=> fun next ctx -> task {
let startTicks = DateTime.Now.Ticks
let list = parseListDate date |> generateRequestList ctx
let! list = generateRequestList ctx (parseListDate date)
return!
viewInfo ctx startTicks
|> Views.PrayerRequest.view { list with showHeader = false }
|> 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
let private setGroupCookie (ctx : HttpContext) pwHash =
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
let announcement : HttpHandler =
requireAccess [ User ]
>=> fun next ctx ->
let startTicks = DateTime.Now.Ticks
{ viewInfo ctx startTicks with helpLink = Some Help.sendAnnouncement; script = [ "ckeditor/ckeditor" ] }
let announcement : HttpHandler = requireAccess [ User ] >=> fun next ctx ->
{ viewInfo ctx DateTime.Now.Ticks with helpLink = Some Help.sendAnnouncement; script = [ "ckeditor/ckeditor" ] }
|> Views.SmallGroup.announcement (currentUser ctx).isAdmin ctx
|> renderHtml next ctx
/// POST /small-group/[group-id]/delete
let delete groupId : HttpHandler =
requireAccess [ Admin ]
>=> validateCSRF
>=> fun next ctx -> task {
let delete groupId : HttpHandler = requireAccess [ Admin ] >=> validateCSRF >=> fun next ctx -> task {
let s = Views.I18N.localizer.Force ()
match! ctx.db.TryGroupById groupId with
| Some grp ->
@ -41,43 +36,37 @@ let delete groupId : HttpHandler =
ctx.db.RemoveEntry grp
let! _ = ctx.db.SaveChangesAsync ()
addInfo ctx
s.["The group {0} and its {1} prayer request(s) were deleted successfully; revoked access from {2} user(s)",
s["The group {0} and its {1} prayer request(s) were deleted successfully; revoked access from {2} user(s)",
grp.name, reqs, usrs]
return! redirectTo false "/web/small-groups" next ctx
| None -> return! fourOhFour next ctx
}
}
/// POST /small-group/member/[member-id]/delete
let deleteMember memberId : HttpHandler =
requireAccess [ User ]
>=> validateCSRF
>=> fun next ctx -> task {
let deleteMember memberId : HttpHandler = requireAccess [ User ] >=> validateCSRF >=> fun next ctx -> task {
let s = Views.I18N.localizer.Force ()
match! ctx.db.TryMemberById memberId with
| Some mbr when mbr.smallGroupId = (currentGroup ctx).smallGroupId ->
ctx.db.RemoveEntry mbr
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
| Some _
| None -> return! fourOhFour next ctx
}
}
/// GET /small-group/[group-id]/edit
let edit (groupId : SmallGroupId) : HttpHandler =
requireAccess [ Admin ]
>=> fun next ctx -> task {
let edit (groupId : SmallGroupId) : HttpHandler = requireAccess [ Admin ] >=> fun next ctx -> task {
let startTicks = DateTime.Now.Ticks
let! churches = ctx.db.AllChurches ()
match groupId = Guid.Empty with
| true ->
if groupId = Guid.Empty then
return!
viewInfo ctx startTicks
|> Views.SmallGroup.edit EditSmallGroup.empty churches ctx
|> renderHtml next ctx
| false ->
else
match! ctx.db.TryGroupById groupId with
| Some grp ->
return!
@ -85,25 +74,21 @@ let edit (groupId : SmallGroupId) : HttpHandler =
|> Views.SmallGroup.edit (EditSmallGroup.fromGroup grp) churches ctx
|> renderHtml next ctx
| None -> return! fourOhFour next ctx
}
}
/// GET /small-group/member/[member-id]/edit
let editMember (memberId : MemberId) : HttpHandler =
requireAccess [ User ]
>=> fun next ctx ->
let editMember (memberId : MemberId) : HttpHandler = requireAccess [ User ] >=> fun next ctx -> task {
let startTicks = DateTime.Now.Ticks
let s = Views.I18N.localizer.Force ()
let grp = currentGroup ctx
let typs = ReferenceList.emailTypeList grp.preferences.defaultEmailType s
task {
match memberId = Guid.Empty with
| true ->
if memberId = Guid.Empty then
return!
viewInfo ctx startTicks
|> Views.SmallGroup.editMember EditMember.empty typs ctx
|> renderHtml next ctx
| false ->
else
match! ctx.db.TryMemberById memberId with
| Some mbr when mbr.smallGroupId = grp.smallGroupId ->
return!
@ -112,30 +97,23 @@ let editMember (memberId : MemberId) : HttpHandler =
|> renderHtml next ctx
| Some _
| None -> return! fourOhFour next ctx
}
}
/// GET /small-group/log-on/[group-id?]
let logOn (groupId : SmallGroupId option) : HttpHandler =
requireAccess [ AccessLevel.Public ]
>=> fun next ctx ->
let logOn (groupId : SmallGroupId option) : HttpHandler = requireAccess [ AccessLevel.Public ] >=> fun next ctx -> task {
let startTicks = DateTime.Now.Ticks
task {
let! grps = ctx.db.ProtectedGroups ()
let grpId = match groupId with Some gid -> flatGuid gid | None -> ""
return!
{ viewInfo ctx startTicks with helpLink = Some Help.logOn }
|> Views.SmallGroup.logOn grps grpId ctx
|> renderHtml next ctx
}
}
/// POST /small-group/log-on/submit
let logOnSubmit : HttpHandler =
requireAccess [ AccessLevel.Public ]
>=> validateCSRF
>=> fun next ctx ->
task {
let logOnSubmit : HttpHandler = requireAccess [ AccessLevel.Public ] >=> validateCSRF >=> fun next ctx -> task {
match! ctx.TryBindFormAsync<GroupLogOn> () with
| Ok m ->
let s = Views.I18N.localizer.Force ()
@ -145,54 +123,45 @@ let logOnSubmit : HttpHandler =
match m.rememberMe with
| 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
| 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
| Error e -> return! bindError e next ctx
}
}
/// GET /small-groups
let maintain : HttpHandler =
requireAccess [ Admin ]
>=> fun next ctx ->
let maintain : HttpHandler = requireAccess [ Admin ] >=> fun next ctx -> task {
let startTicks = DateTime.Now.Ticks
task {
let! grps = ctx.db.AllGroups ()
return!
viewInfo ctx startTicks
|> Views.SmallGroup.maintain grps ctx
|> renderHtml next ctx
}
}
/// GET /small-group/members
let members : HttpHandler =
requireAccess [ User ]
>=> fun next ctx ->
let members : HttpHandler = requireAccess [ User ] >=> fun next ctx -> task {
let startTicks = DateTime.Now.Ticks
let grp = currentGroup ctx
let s = Views.I18N.localizer.Force ()
task {
let! mbrs = ctx.db.AllMembersForSmallGroup grp.smallGroupId
let typs = ReferenceList.emailTypeList grp.preferences.defaultEmailType s |> Map.ofSeq
return!
{ viewInfo ctx startTicks with helpLink = Some Help.maintainGroupMembers }
|> Views.SmallGroup.members mbrs typs ctx
|> renderHtml next ctx
}
}
/// GET /small-group
let overview : HttpHandler =
requireAccess [ User ]
>=> fun next ctx ->
let overview : HttpHandler = requireAccess [ User ] >=> fun next ctx -> task {
let startTicks = DateTime.Now.Ticks
let clock = ctx.GetService<IClock> ()
task {
let reqs = ctx.db.AllRequestsForSmallGroup (currentGroup ctx) clock None true 0 |> List.ofSeq
let! reqs = ctx.db.AllRequestsForSmallGroup (currentGroup ctx) clock None true 0
let! reqCount = ctx.db.CountRequestsBySmallGroup (currentGroup ctx).smallGroupId
let! mbrCount = ctx.db.CountMembersForSmallGroup (currentGroup ctx).smallGroupId
let m =
@ -211,36 +180,28 @@ let overview : HttpHandler =
viewInfo ctx startTicks
|> Views.SmallGroup.overview m
|> renderHtml next ctx
}
}
/// GET /small-group/preferences
let preferences : HttpHandler =
requireAccess [ User ]
>=> fun next ctx ->
let preferences : HttpHandler = requireAccess [ User ] >=> fun next ctx -> task {
let startTicks = DateTime.Now.Ticks
task {
let! tzs = ctx.db.AllTimeZones ()
return!
{ viewInfo ctx startTicks with helpLink = Some Help.groupPreferences }
|> Views.SmallGroup.preferences (EditPreferences.fromPreferences (currentGroup ctx).preferences) tzs ctx
|> renderHtml next ctx
}
}
/// POST /small-group/save
let save : HttpHandler =
requireAccess [ Admin ]
>=> validateCSRF
>=> fun next ctx ->
let s = Views.I18N.localizer.Force ()
task {
let save : HttpHandler = requireAccess [ Admin ] >=> validateCSRF >=> fun next ctx -> task {
match! ctx.TryBindFormAsync<EditSmallGroup> () with
| Ok m ->
let s = Views.I18N.localizer.Force ()
let! group =
match m.isNew () with
| true -> Task.FromResult<SmallGroup option>(Some { SmallGroup.empty with smallGroupId = Guid.NewGuid () })
| false -> ctx.db.TryGroupById m.smallGroupId
if m.isNew () then Task.FromResult (Some { SmallGroup.empty with smallGroupId = Guid.NewGuid () })
else ctx.db.TryGroupById m.smallGroupId
match group with
| Some grp ->
m.populateGroup grp
@ -250,33 +211,23 @@ let save : HttpHandler =
ctx.db.AddEntry { grp.preferences with smallGroupId = grp.smallGroupId }
| grp -> ctx.db.UpdateEntry grp
let! _ = ctx.db.SaveChangesAsync ()
let act = s.[match m.isNew () with true -> "Added" | false -> "Updated"].Value.ToLower ()
addHtmlInfo ctx s.["Successfully {0} group “{1}”", act, m.name]
let act = s[if m.isNew () then "Added" else "Updated"].Value.ToLower ()
addHtmlInfo ctx s["Successfully {0} group “{1}”", act, m.name]
return! redirectTo false "/web/small-groups" next ctx
| None -> return! fourOhFour next ctx
| Error e -> return! bindError e next ctx
}
}
/// POST /small-group/member/save
let saveMember : HttpHandler =
requireAccess [ User ]
>=> validateCSRF
>=> fun next ctx ->
task {
let saveMember : HttpHandler = requireAccess [ User ] >=> validateCSRF >=> fun next ctx -> task {
match! ctx.TryBindFormAsync<EditMember> () with
| Ok m ->
let grp = currentGroup ctx
let! mMbr =
match m.isNew () with
| true ->
Task.FromResult<Member option>
(Some
{ Member.empty with
memberId = Guid.NewGuid ()
smallGroupId = grp.smallGroupId
})
| false -> ctx.db.TryMemberById m.memberId
if m.isNew () then
Task.FromResult (Some { Member.empty with memberId = Guid.NewGuid (); smallGroupId = grp.smallGroupId })
else ctx.db.TryMemberById m.memberId
match mMbr with
| Some mbr when mbr.smallGroupId = grp.smallGroupId ->
{ mbr with
@ -284,29 +235,25 @@ let saveMember : HttpHandler =
email = m.emailAddress
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 s = Views.I18N.localizer.Force ()
let act = s.[match m.isNew () with true -> "Added" | false -> "Updated"].Value.ToLower ()
addInfo ctx s.["Successfully {0} group member", act]
let act = s[if m.isNew () then "Added" else "Updated"].Value.ToLower ()
addInfo ctx s["Successfully {0} group member", act]
return! redirectTo false "/web/small-group/members" next ctx
| Some _
| None -> return! fourOhFour next ctx
| Error e -> return! bindError e next ctx
}
}
/// POST /small-group/preferences/save
let savePreferences : HttpHandler =
requireAccess [ User ]
>=> validateCSRF
>=> fun next ctx ->
task {
let savePreferences : HttpHandler = requireAccess [ User ] >=> validateCSRF >=> fun next ctx -> task {
match! ctx.TryBindFormAsync<EditPreferences> () with
| Ok m ->
// Since the class is stored in the session, we'll use an intermediate instance to persist it; once that
// works, we can repopulate the session instance. That way, if the update fails, the page should still show
// the database values, not the then out-of-sync session ones.
// Since the class is stored in the session, we'll use an intermediate instance to persist it; once that works,
// we can repopulate the session instance. That way, if the update fails, the page should still show the
// database values, not the then out-of-sync session ones.
match! ctx.db.TryGroupById (currentGroup ctx).smallGroupId with
| Some grp ->
let prefs = m.populatePreferences grp.preferences
@ -315,20 +262,16 @@ let savePreferences : HttpHandler =
// Refresh session instance
ctx.Session.smallGroup <- Some { grp with preferences = prefs }
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
| None -> return! fourOhFour next ctx
| Error e -> return! bindError e next ctx
}
}
/// POST /small-group/announcement/send
let sendAnnouncement : HttpHandler =
requireAccess [ User ]
>=> validateCSRF
>=> fun next ctx ->
let sendAnnouncement : HttpHandler = requireAccess [ User ] >=> validateCSRF >=> fun next ctx -> task {
let startTicks = DateTime.Now.Ticks
task {
match! ctx.TryBindFormAsync<Announcement> () with
| Ok m ->
let grp = currentGroup ctx
@ -349,8 +292,8 @@ let sendAnnouncement : HttpHandler =
| _ -> ctx.db.AllMembersForSmallGroup grp.smallGroupId
use! client = Email.getConnection ()
do! Email.sendEmails client recipients grp
s.["Announcement for {0} - {1:MMMM d, yyyy} {2}",
grp.name, now.Date, (now.ToString "h:mm tt").ToLower ()].Value
s["Announcement for {0} - {1:MMMM d, yyyy} {2}", grp.name, now.Date,
(now.ToString "h:mm tt").ToLower ()].Value
htmlText plainText s
// Add to the request list if desired
match m.sendToClass, m.addToRequestList with
@ -373,13 +316,13 @@ let sendAnnouncement : HttpHandler =
// Tell 'em what they've won, Johnny!
let toWhom =
match m.sendToClass with
| "N" -> s.["{0} users", s.["PrayerTracker"]].Value
| _ -> s.["Group Members"].Value.ToLower ()
| "N" -> s["{0} users", s["PrayerTracker"]].Value
| _ -> s["Group Members"].Value.ToLower ()
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!
viewInfo ctx startTicks
|> Views.SmallGroup.announcementSent { m with text = htmlText }
|> renderHtml next ctx
| Error e -> return! bindError e next ctx
}
}

141
src/PrayerTracker/User.fs
View File

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