src/PrayerTracker.UI/Utils.fs

@@ -140,6 +140,9 @@ let makeUrl url qs =
 [<RequireQualifiedAccess>]
 module Key =
     
+    /// The request start time (added via middleware, read when rendering the footer)
+    let startTime = "StartTime"
+    
     /// This contains constants for session-stored objects within PrayerTracker
     module Session =
         
@@ -155,24 +158,6 @@ module Key =
         /// 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 GroupVisibility =

src/PrayerTracker/App.fs

@@ -1,5 +1,17 @@
 namespace PrayerTracker
 
+open System
+open Microsoft.AspNetCore.Http
+
+/// Middleware to add the starting ticks for the request
+type RequestStartMiddleware (next : RequestDelegate) =
+    
+    member this.InvokeAsync (ctx : HttpContext) = task {
+        ctx.Items[Key.startTime] <- DateTime.Now.Ticks
+        return! next.Invoke ctx
+    }
+
+
 open Microsoft.AspNetCore.Builder
 open Microsoft.AspNetCore.Hosting
 
@@ -23,7 +35,6 @@ module Configure =
     let kestrel (ctx : WebHostBuilderContext) (opts : KestrelServerOptions) =
         (ctx.Configuration.GetSection >> opts.Configure >> ignore) "Kestrel"
 
-    open System
     open System.Globalization
     open Microsoft.AspNetCore.Authentication.Cookies
     open Microsoft.AspNetCore.Localization
@@ -54,19 +65,19 @@ module Configure =
         let _ = svc.AddSession()
         let _ = svc.AddAntiforgery()
         let _ = svc.AddRouting()
-        let _ = svc.AddSingleton<IClock>(SystemClock.Instance)
+        let _ = svc.AddSingleton<IClock> SystemClock.Instance
         
-        let config = svc.BuildServiceProvider().GetRequiredService<IConfiguration>()
+        let config = svc.BuildServiceProvider().GetRequiredService<IConfiguration> ()
-        let _      = svc.AddDbContext<AppDbContext>(
+        let _      =
-            (fun options ->
+            svc.AddDbContext<AppDbContext>(
-              options.UseNpgsql (config.GetConnectionString "PrayerTracker") |> ignore),
+                (fun options -> options.UseNpgsql (config.GetConnectionString "PrayerTracker") |> ignore),
                 ServiceLifetime.Scoped, ServiceLifetime.Singleton)
         ()
     
     open Giraffe
     
     let noWeb : HttpHandler = fun next ctx ->
-        redirectTo true ($"""/{string ctx.Request.RouteValues["path"]}""") next ctx
+        redirectTo true $"""/{string ctx.Request.RouteValues["path"]}""" next ctx
         
     open Giraffe.EndpointRouting
     
@@ -186,6 +197,8 @@ module Configure =
         
         let _ = app.UseStatusCodePagesWithReExecute "/error/{0}"
         let _ = app.UseStaticFiles ()
+        let _ = app.UseCookiePolicy (CookiePolicyOptions (MinimumSameSitePolicy = SameSiteMode.Strict))
+        let _ = app.UseMiddleware<RequestStartMiddleware> ()
         let _ = app.UseRouting ()
         let _ = app.UseSession ()
         let _ = app.UseRequestLocalization

src/PrayerTracker/Church.fs

@@ -33,17 +33,16 @@ open System
 
 /// GET /church/[church-id]/edit
 let edit churchId : HttpHandler = requireAccess [ Admin ] >=> fun next ctx -> task {
-    let startTicks = DateTime.Now.Ticks
     if churchId = Guid.Empty then
         return!
-            viewInfo ctx startTicks
+            viewInfo ctx
             |> Views.Church.edit EditChurch.empty ctx
             |> renderHtml next ctx
     else
         match! ctx.Db.TryChurchById (ChurchId churchId) with
         | Some church -> 
             return!
-                viewInfo ctx startTicks
+                viewInfo ctx
                 |> Views.Church.edit (EditChurch.fromChurch church) ctx
                 |> renderHtml next ctx
         | None -> return! fourOhFour ctx
@@ -51,12 +50,11 @@ let edit churchId : HttpHandler = requireAccess [ Admin ] >=> fun next ctx -> ta
 
 /// GET /churches
 let maintain : HttpHandler = requireAccess [ Admin ] >=> fun next ctx -> task {
-    let  startTicks = DateTime.Now.Ticks
     let  await    = Async.AwaitTask >> Async.RunSynchronously
     let! churches = ctx.Db.AllChurches ()
     let  stats    = churches |> List.map (fun c -> await (findStats ctx.Db c.Id))
     return!
-        viewInfo ctx startTicks
+        viewInfo ctx
         |> Views.Church.maintain churches (stats |> Map.ofList) ctx
         |> renderHtml next ctx
 }

src/PrayerTracker/CommonFunctions.fs

@@ -48,7 +48,7 @@ open PrayerTracker
 open PrayerTracker.ViewModels
 
 /// Create the common view information heading
-let viewInfo (ctx : HttpContext) startTicks =
+let viewInfo (ctx : HttpContext) =
     let msg =
         match ctx.Session.Messages with
         | [] -> []
@@ -63,9 +63,9 @@ let viewInfo (ctx : HttpContext) startTicks =
     { AppViewInfo.fresh with
         Version      = appVersion
         Messages     = msg
-        RequestStart = startTicks
+        RequestStart = ctx.Items[Key.startTime] :?> int64
-        User         = ctx.CurrentUser
+        User         = ctx.Session.CurrentUser
-        Group        = ctx.CurrentGroup
+        Group        = ctx.Session.CurrentGroup
         Layout       = layout
     }
 
@@ -141,7 +141,9 @@ open PrayerTracker.Entities
 
 /// Require one of the given access roles
 let requireAccess levels : HttpHandler = fun next ctx -> task {
-    match ctx.CurrentUser, ctx.CurrentGroup with
+    let! user  = ctx.CurrentUser  ()
+    let! group = ctx.CurrentGroup ()
+    match user, group with
     | _, _      when List.contains Public levels              -> return! next ctx
     | Some _, _ when List.contains User   levels              -> return! next ctx
     | _, Some _ when List.contains Group  levels              -> return! next ctx

src/PrayerTracker/Extensions.fs

@@ -2,6 +2,7 @@
 module PrayerTracker.Extensions
 
 open Microsoft.AspNetCore.Http
+open Microsoft.FSharpLu
 open Newtonsoft.Json
 open PrayerTracker.Entities
 open PrayerTracker.ViewModels
@@ -17,6 +18,22 @@ type ISession with
     member this.GetObject<'T> key =
         match this.GetString key with null -> Unchecked.defaultof<'T> | v -> JsonConvert.DeserializeObject<'T> v
 
+    /// The currently logged on small group
+    member this.CurrentGroup
+      with get () = this.GetObject<SmallGroup> Key.Session.currentGroup |> Option.fromObject
+       and set (v : SmallGroup option) = 
+          match v with
+          | Some group -> this.SetObject Key.Session.currentGroup group
+          | None -> this.Remove Key.Session.currentGroup
+
+    /// The currently logged on user
+    member this.CurrentUser
+      with get () = this.GetObject<User> Key.Session.currentUser |> Option.fromObject
+       and set (v : User option) =
+          match v with
+          | Some user -> this.SetObject Key.Session.currentUser user
+          | None -> this.Remove Key.Session.currentUser
+    
     /// Current messages for the session
     member this.Messages
       with get () =
@@ -26,27 +43,63 @@ type ISession with
        and set (v : UserMessage list) = this.SetObject Key.Session.userMessages v
 
 
+open System.Security.Claims
+
+/// Extensions on the claims principal
+type ClaimsPrincipal with
+    
+    /// The ID of the currently logged on small group    
+    member this.SmallGroupId =
+        if this.HasClaim (fun c -> c.Type = ClaimTypes.GroupSid) then
+            Some (idFromShort SmallGroupId (this.FindFirst(fun c -> c.Type = ClaimTypes.GroupSid).Value))
+        else None
+    
+    /// The ID of the currently signed in user    
+    member this.UserId =
+        if this.HasClaim (fun c -> c.Type = ClaimTypes.NameIdentifier) then
+            Some (idFromShort UserId (this.FindFirst(fun c -> c.Type = ClaimTypes.NameIdentifier).Value))
+        else None
+
+
 open Giraffe
-open Microsoft.FSharpLu
+open NodaTime
+open PrayerTracker
 
 /// Extensions on the ASP.NET Core HTTP context
 type HttpContext with
     
-    /// The currently logged on small group
-    member this.CurrentGroup
-      with get () = this.Session.GetObject<SmallGroup> Key.Session.currentGroup |> Option.fromObject
-       and set (v : SmallGroup option) = 
-          match v with
-          | Some group -> this.Session.SetObject Key.Session.currentGroup group
-          | None -> this.Session.Remove Key.Session.currentGroup
-
-    /// The currently logged on user
-    member this.CurrentUser
-      with get () = this.Session.GetObject<User> Key.Session.currentUser |> Option.fromObject
-       and set (v : User option) =
-          match v with
-          | Some user -> this.Session.SetObject Key.Session.currentUser user
-          | None -> this.Session.Remove Key.Session.currentUser
-
     /// The EF Core database context (via DI)
     member this.Db = this.GetService<AppDbContext> ()
+    
+    /// The system clock (via DI)
+    member this.Clock = this.GetService<IClock> ()
+    
+    /// The currently logged on small group (sets the value in the session if it is missing)
+    member this.CurrentGroup () = task {
+        match this.Session.CurrentGroup with
+        | Some group -> return Some group
+        | None ->
+            match this.User.SmallGroupId with
+            | Some groupId ->
+                match! this.Db.TryGroupById groupId with
+                | Some group ->
+                    this.Session.CurrentGroup <- Some group
+                    return Some group
+                | None -> return None
+            | None -> return None
+    }
+
+    /// The currently logged on user (sets the value in the session if it is missing)
+    member this.CurrentUser () = task {
+        match this.Session.CurrentUser with
+        | Some user -> return Some user
+        | None ->
+            match this.User.UserId with
+            | Some userId ->
+                match! this.Db.TryUserById userId with
+                | Some user ->
+                    this.Session.CurrentUser <- Some user
+                    return Some user
+                | None -> return None
+            | None -> return None
+    }

src/PrayerTracker/Home.fs

@@ -9,13 +9,13 @@ open PrayerTracker
 
 /// GET /error/[error-code]
 let error code : HttpHandler = requireAccess [ AccessLevel.Public ] >=> fun next ctx ->
-    viewInfo ctx DateTime.Now.Ticks
+    viewInfo ctx
     |> Views.Home.error code
     |> renderHtml next ctx
 
 /// GET /
 let homePage : HttpHandler = requireAccess [ AccessLevel.Public ] >=> fun next ctx ->
-    viewInfo ctx DateTime.Now.Ticks
+    viewInfo ctx
     |> Views.Home.index
     |> renderHtml next ctx
 
@@ -44,13 +44,13 @@ let language culture : HttpHandler = requireAccess [ AccessLevel.Public ] >=> fu
 
 /// GET /legal/privacy-policy
 let privacyPolicy : HttpHandler = requireAccess [ AccessLevel.Public ] >=> fun next ctx ->
-    viewInfo ctx DateTime.Now.Ticks
+    viewInfo ctx
     |> Views.Home.privacyPolicy
     |> renderHtml next ctx
 
 /// GET /legal/terms-of-service
 let tos : HttpHandler = requireAccess [ AccessLevel.Public ] >=> fun next ctx ->
-    viewInfo ctx DateTime.Now.Ticks
+    viewInfo ctx
     |> Views.Home.termsOfService
     |> renderHtml next ctx
 
@@ -68,6 +68,6 @@ let logOff : HttpHandler = requireAccess [ AccessLevel.Public ] >=> fun next ctx
 
 /// GET /unauthorized
 let unauthorized : HttpHandler = requireAccess [ AccessLevel.Public ] >=> fun next ctx ->
-    viewInfo ctx DateTime.Now.Ticks
+    viewInfo ctx
     |> Views.Home.unauthorized
     |> renderHtml next ctx

src/PrayerTracker/PrayerRequest.fs

@@ -9,7 +9,7 @@ open PrayerTracker.ViewModels
 /// Retrieve a prayer request, and ensure that it belongs to the current class
 let private findRequest (ctx : HttpContext) reqId = task {
     match! ctx.Db.TryRequestById reqId with
-    | Some req when req.SmallGroupId = ctx.CurrentGroup.Value.Id -> return Ok req
+    | Some req when req.SmallGroupId = ctx.Session.CurrentGroup.Value.Id -> return Ok req
     | Some _ ->
         let s = Views.I18N.localizer.Force ()
         addError ctx s["The prayer request you tried to access is not assigned to your group"]
@@ -17,20 +17,17 @@ let private findRequest (ctx : HttpContext) reqId = task {
     | None -> return Result.Error (fourOhFour ctx)
 }
 
-open NodaTime
-
 /// Generate a list of requests for the given date
 let private generateRequestList (ctx : HttpContext) date = task {
-    let  grp      = ctx.CurrentGroup.Value
+    let  group    = ctx.Session.CurrentGroup.Value
-    let  clock    = ctx.GetService<IClock> ()
+    let  listDate = match date with Some d -> d | None -> group.LocalDateNow ctx.Clock
-    let  listDate = match date with Some d -> d | None -> grp.LocalDateNow clock
+    let! reqs     = ctx.Db.AllRequestsForSmallGroup group ctx.Clock (Some listDate) true 0
-    let! reqs     = ctx.Db.AllRequestsForSmallGroup grp clock (Some listDate) true 0
     return
         {   Requests   = reqs
             Date       = listDate
-            SmallGroup = grp
+            SmallGroup = group
             ShowHeader = true
-            CanEmail   = Option.isSome ctx.CurrentUser
+            CanEmail   = Option.isSome ctx.User.UserId
             Recipients = []
         }
 }
@@ -45,20 +42,19 @@ let private parseListDate (date : string option) =
 
 /// GET /prayer-request/[request-id]/edit
 let edit reqId : HttpHandler = requireAccess [ User ] >=> fun next ctx -> task {
-    let startTicks = DateTime.Now.Ticks
+    let group     = ctx.Session.CurrentGroup.Value
-    let grp        = ctx.CurrentGroup.Value
+    let now       = group.LocalDateNow ctx.Clock
-    let now        = grp.LocalDateNow (ctx.GetService<IClock> ())
     let requestId = PrayerRequestId reqId
     if requestId.Value = Guid.Empty then
         return!
-            { viewInfo ctx startTicks with HelpLink = Some Help.editRequest }
+            { viewInfo ctx with HelpLink = Some Help.editRequest }
             |> Views.PrayerRequest.edit EditRequest.empty (now.ToString "yyyy-MM-dd") ctx
             |> renderHtml next ctx
     else
         match! findRequest ctx requestId with
         | Ok req ->
             let s = Views.I18N.localizer.Force ()
-            if req.IsExpired now grp.Preferences.DaysToExpire then
+            if req.IsExpired now group.Preferences.DaysToExpire then
                 { UserMessage.warning with
                     Text        = htmlLocString s["This request is expired."]
                     Description =
@@ -68,7 +64,7 @@ let edit reqId : HttpHandler = requireAccess [ User ] >=> fun next ctx -> task {
                   }
                 |> addUserMessage ctx
             return!
-                { viewInfo ctx startTicks with HelpLink = Some Help.editRequest }
+                { viewInfo ctx with HelpLink = Some Help.editRequest }
                 |> Views.PrayerRequest.edit (EditRequest.fromRequest req) "" ctx
                 |> renderHtml next ctx
         | Result.Error e -> return! e
@@ -76,18 +72,17 @@ let edit reqId : HttpHandler = requireAccess [ User ] >=> fun next ctx -> task {
 
 /// GET /prayer-requests/email/[date]
 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         = ctx.CurrentGroup.Value
+    let  group      = ctx.Session.CurrentGroup.Value
     let! list       = generateRequestList ctx listDate
-    let! recipients  = ctx.Db.AllMembersForSmallGroup grp.Id
+    let! recipients = ctx.Db.AllMembersForSmallGroup group.Id
     use! client     = Email.getConnection ()
     do! Email.sendEmails client recipients
-          grp s["Prayer Requests for {0} - {1:MMMM d, yyyy}", grp.Name, list.Date].Value
+          group s["Prayer Requests for {0} - {1:MMMM d, yyyy}", group.Name, list.Date].Value
           (list.AsHtml s) (list.AsText s) s
     return!
-        viewInfo ctx startTicks
+        viewInfo ctx
         |> Views.PrayerRequest.email { list with Recipients = recipients }
         |> renderHtml next ctx
 }
@@ -120,19 +115,17 @@ let expire reqId : HttpHandler = requireAccess [ User ] >=> fun next ctx -> task
 
 /// GET /prayer-requests/[group-id]/list
 let list groupId : HttpHandler = requireAccess [ AccessLevel.Public ] >=> fun next ctx -> task {
-    let startTicks = DateTime.Now.Ticks
     match! ctx.Db.TryGroupById groupId with
-    | Some grp when grp.Preferences.IsPublic ->
+    | Some group when group.Preferences.IsPublic ->
-        let clock = ctx.GetService<IClock> ()
+        let! reqs = ctx.Db.AllRequestsForSmallGroup group ctx.Clock None true 0
-        let! reqs  = ctx.Db.AllRequestsForSmallGroup grp clock None true 0
         return!
-            viewInfo ctx startTicks
+            viewInfo ctx
             |> Views.PrayerRequest.list
                 {   Requests   = reqs
-                    Date       = grp.LocalDateNow clock
+                    Date       = group.LocalDateNow ctx.Clock
-                    SmallGroup = grp
+                    SmallGroup = group
                     ShowHeader = true
-                    CanEmail   = Option.isSome ctx.CurrentUser
+                    CanEmail   = Option.isSome ctx.User.UserId
                     Recipients = []
                 }
             |> renderHtml next ctx
@@ -145,10 +138,9 @@ let list groupId : HttpHandler = requireAccess [ AccessLevel.Public ] >=> fun ne
 
 /// GET /prayer-requests/lists
 let lists : HttpHandler = requireAccess [ AccessLevel.Public ] >=> fun next ctx -> task {
-    let  startTicks = DateTime.Now.Ticks
     let! groups = ctx.Db.PublicAndProtectedGroups ()
     return!
-        viewInfo ctx startTicks
+        viewInfo ctx
         |> Views.PrayerRequest.lists groups
         |> renderHtml next ctx
 }
@@ -157,16 +149,15 @@ let lists : HttpHandler = requireAccess [ AccessLevel.Public ] >=> fun next ctx
 ///  - OR -
 /// GET /prayer-requests?search=[search-query]
 let maintain onlyActive : HttpHandler = requireAccess [ User ] >=> fun next ctx -> task {
-    let startTicks = DateTime.Now.Ticks
+    let group   = ctx.Session.CurrentGroup.Value
-    let grp        = ctx.CurrentGroup.Value
     let pageNbr =
         match ctx.GetQueryStringValue "page" with
         | Ok pg -> match Int32.TryParse pg with true, p -> p | false, _ -> 1
         | Result.Error _ -> 1
-    let! m = backgroundTask {
+    let! model = backgroundTask {
         match ctx.GetQueryStringValue "search" with
         | Ok search ->
-            let! reqs = ctx.Db.SearchRequestsForSmallGroup grp search pageNbr
+            let! reqs = ctx.Db.SearchRequestsForSmallGroup group search pageNbr
             return
                 { MaintainRequests.empty with
                     Requests   = reqs
@@ -174,7 +165,7 @@ let maintain onlyActive : HttpHandler = requireAccess [ User ] >=> fun next ctx
                     PageNbr    = Some pageNbr
                 }
         | Result.Error _ ->
-            let! reqs = ctx.Db.AllRequestsForSmallGroup grp (ctx.GetService<IClock> ()) None onlyActive pageNbr
+            let! reqs = ctx.Db.AllRequestsForSmallGroup group ctx.Clock None onlyActive pageNbr
             return
                 { MaintainRequests.empty with
                     Requests   = reqs
@@ -183,8 +174,8 @@ let maintain onlyActive : HttpHandler = requireAccess [ User ] >=> fun next ctx
                 }
     }
     return!
-        { viewInfo ctx startTicks with HelpLink = Some Help.maintainRequests }
+        { viewInfo ctx with HelpLink = Some Help.maintainRequests }
-        |> Views.PrayerRequest.maintain { m with SmallGroup = grp } ctx
+        |> Views.PrayerRequest.maintain { model with SmallGroup = group } ctx
         |> renderHtml next ctx
 }
 
@@ -214,36 +205,37 @@ open System.Threading.Tasks
 /// POST /prayer-request/save
 let save : HttpHandler = requireAccess [ User ] >=> validateCsrf >=> fun next ctx -> task {
     match! ctx.TryBindFormAsync<EditRequest> () with
-    | Ok m ->
+    | Ok model ->
         let! req =
-          if m.IsNew then Task.FromResult (Some { PrayerRequest.empty with Id = (Guid.NewGuid >> PrayerRequestId) () })
+          if model.IsNew then
-          else ctx.Db.TryRequestById (idFromShort PrayerRequestId m.RequestId)
+              Task.FromResult (Some { PrayerRequest.empty with Id = (Guid.NewGuid >> PrayerRequestId) () })
+          else ctx.Db.TryRequestById (idFromShort PrayerRequestId model.RequestId)
         match req with
         | Some pr ->
             let upd8 =
                 { pr with
-                    RequestType = PrayerRequestType.fromCode m.RequestType
+                    RequestType = PrayerRequestType.fromCode model.RequestType
-                    Requestor   = match m.Requestor with Some x when x.Trim () = "" -> None | x -> x
+                    Requestor   = match model.Requestor with Some x when x.Trim () = "" -> None | x -> x
-                    Text        = ckEditorToText m.Text
+                    Text        = ckEditorToText model.Text
-                    Expiration  = Expiration.fromCode m.Expiration
+                    Expiration  = Expiration.fromCode model.Expiration
                 }
-            let grp = ctx.CurrentGroup.Value
+            let group = ctx.Session.CurrentGroup.Value
-            let now = grp.LocalDateNow (ctx.GetService<IClock> ())
+            let now   = group.LocalDateNow ctx.Clock
-            match m.IsNew with
+            match model.IsNew with
             | true ->
-                let dt = defaultArg m.EnteredDate now
+                let dt = defaultArg model.EnteredDate now
                 { upd8 with
-                    SmallGroupId = grp.Id
+                    SmallGroupId = group.Id
-                    UserId       = ctx.CurrentUser.Value.Id
+                    UserId       = ctx.User.UserId.Value
                     EnteredDate  = dt
                     UpdatedDate  = dt
                   }
-            | false when defaultArg m.SkipDateUpdate false -> upd8
+            | false when defaultArg model.SkipDateUpdate false -> upd8
             | false -> { upd8 with UpdatedDate = now }
-            |> if m.IsNew then ctx.Db.AddEntry else ctx.Db.UpdateEntry
+            |> if model.IsNew then ctx.Db.AddEntry else ctx.Db.UpdateEntry
             let! _   = ctx.Db.SaveChangesAsync ()
             let  s   = Views.I18N.localizer.Force ()
-            let  act = if m.IsNew then "Added" else "Updated"
+            let  act = if model.IsNew then "Added" else "Updated"
             addInfo ctx s["Successfully {0} prayer request", s[act].Value.ToLower ()]
             return! redirectTo false "/prayer-requests" next ctx
         | None -> return! fourOhFour ctx
@@ -252,10 +244,9 @@ let save : HttpHandler = requireAccess [ User ] >=> validateCsrf >=> fun next ct
 
 /// GET /prayer-request/view/[date?]
 let view date : HttpHandler = requireAccess [ User; Group ] >=> fun next ctx -> task {
-    let  startTicks = DateTime.Now.Ticks
     let! list = generateRequestList ctx (parseListDate date)
     return!
-        viewInfo ctx startTicks
+        viewInfo ctx
         |> Views.PrayerRequest.view { list with ShowHeader = false }
         |> renderHtml next ctx
 }

src/PrayerTracker/SmallGroup.fs

@@ -8,8 +8,8 @@ open PrayerTracker.ViewModels
 
 /// GET /small-group/announcement
 let announcement : HttpHandler = requireAccess [ User ] >=> fun next ctx ->
-    { viewInfo ctx DateTime.Now.Ticks with HelpLink = Some Help.sendAnnouncement }
+    { viewInfo ctx with HelpLink = Some Help.sendAnnouncement }
-    |> Views.SmallGroup.announcement ctx.CurrentUser.Value.IsAdmin ctx
+    |> Views.SmallGroup.announcement ctx.Session.CurrentUser.Value.IsAdmin ctx
     |> renderHtml next ctx
 
 /// POST /small-group/[group-id]/delete
@@ -32,9 +32,10 @@ let delete grpId : HttpHandler = requireAccess [ Admin ] >=> validateCsrf >=> fu
 /// POST /small-group/member/[member-id]/delete
 let deleteMember mbrId : HttpHandler = requireAccess [ User ] >=> validateCsrf >=> fun next ctx -> task {
     let s        = Views.I18N.localizer.Force ()
+    let group    = ctx.Session.CurrentGroup.Value
     let memberId = MemberId mbrId
     match! ctx.Db.TryMemberById memberId with
-    | Some mbr when mbr.SmallGroupId = ctx.CurrentGroup.Value.Id ->
+    | Some mbr when mbr.SmallGroupId = group.Id ->
         ctx.Db.RemoveEntry mbr
         let! _ = ctx.Db.SaveChangesAsync ()
         addHtmlInfo ctx s["The group member “{0}” was deleted successfully", mbr.Name]
@@ -45,19 +46,18 @@ let deleteMember mbrId : HttpHandler = requireAccess [ User ] >=> validateCsrf >
 
 /// GET /small-group/[group-id]/edit
 let edit grpId : HttpHandler = requireAccess [ Admin ] >=> fun next ctx -> task {
-    let  startTicks = DateTime.Now.Ticks
     let! churches = ctx.Db.AllChurches ()
     let  groupId  = SmallGroupId grpId
     if groupId.Value = Guid.Empty then
         return!
-            viewInfo ctx startTicks
+            viewInfo ctx
             |> Views.SmallGroup.edit EditSmallGroup.empty churches ctx
             |> renderHtml next ctx
     else
         match! ctx.Db.TryGroupById groupId with
         | Some grp ->
             return!
-                viewInfo ctx startTicks
+                viewInfo ctx
                 |> Views.SmallGroup.edit (EditSmallGroup.fromGroup grp) churches ctx
                 |> renderHtml next ctx
         | None -> return! fourOhFour ctx
@@ -65,21 +65,20 @@ let edit grpId : HttpHandler = requireAccess [ Admin ] >=> fun next ctx -> task
 
 /// GET /small-group/member/[member-id]/edit
 let editMember mbrId : HttpHandler = requireAccess [ User ] >=> fun next ctx -> task {
-    let startTicks = DateTime.Now.Ticks
     let s        = Views.I18N.localizer.Force ()
-    let grp        = ctx.CurrentGroup.Value
+    let group    = ctx.Session.CurrentGroup.Value
-    let types      = ReferenceList.emailTypeList grp.Preferences.DefaultEmailType s
+    let types    = ReferenceList.emailTypeList group.Preferences.DefaultEmailType s
     let memberId = MemberId mbrId
     if memberId.Value = Guid.Empty then
         return!
-            viewInfo ctx startTicks
+            viewInfo ctx
             |> Views.SmallGroup.editMember EditMember.empty types ctx
             |> renderHtml next ctx
     else
         match! ctx.Db.TryMemberById memberId with
-        | Some mbr when mbr.SmallGroupId = grp.Id ->
+        | Some mbr when mbr.SmallGroupId = group.Id ->
             return!
-                viewInfo ctx startTicks
+                viewInfo ctx
                 |> Views.SmallGroup.editMember (EditMember.fromMember mbr) types ctx
                 |> renderHtml next ctx
         | Some _
@@ -88,11 +87,10 @@ let editMember mbrId : HttpHandler = requireAccess [ User ] >=> fun next ctx ->
 
 /// GET /small-group/log-on/[group-id?]
 let logOn grpId : HttpHandler = requireAccess [ AccessLevel.Public ] >=> fun next ctx -> task {
-    let  startTicks = DateTime.Now.Ticks
     let! groups  = ctx.Db.ProtectedGroups ()
     let  groupId = match grpId with Some gid -> shortGuid gid | None -> ""
     return!
-        { viewInfo ctx startTicks with HelpLink = Some Help.logOn }
+        { viewInfo ctx with HelpLink = Some Help.logOn }
         |> Views.SmallGroup.logOn groups groupId ctx
         |> renderHtml next ctx
 }
@@ -108,7 +106,7 @@ let logOnSubmit : HttpHandler = requireAccess [ AccessLevel.Public ] >=> validat
         let s = Views.I18N.localizer.Force ()
         match! ctx.Db.TryGroupLogOnByPassword (idFromShort SmallGroupId model.SmallGroupId) model.Password with
         | Some group ->
-            ctx.CurrentGroup <- Some group
+            ctx.Session.CurrentGroup <- Some group
             let claims   = Claim (ClaimTypes.GroupSid, shortGuid group.Id.Value) |> Seq.singleton
             let identity = ClaimsIdentity (claims, CookieAuthenticationDefaults.AuthenticationScheme)
             do! ctx.SignInAsync
@@ -126,38 +124,32 @@ let logOnSubmit : HttpHandler = requireAccess [ AccessLevel.Public ] >=> validat
 
 /// GET /small-groups
 let maintain : HttpHandler = requireAccess [ Admin ] >=> fun next ctx -> task {
-    let startTicks = DateTime.Now.Ticks
     let! groups = ctx.Db.AllGroups ()
     return!
-        viewInfo ctx startTicks
+        viewInfo ctx
         |> Views.SmallGroup.maintain groups ctx
         |> renderHtml next ctx
 }
 
 /// GET /small-group/members
 let members : HttpHandler = requireAccess [ User ] >=> fun next ctx -> task {
-    let startTicks = DateTime.Now.Ticks
+    let  group   = ctx.Session.CurrentGroup.Value
-    let grp        = ctx.CurrentGroup.Value
     let  s       = Views.I18N.localizer.Force ()
-    let! members   = ctx.Db.AllMembersForSmallGroup grp.Id
+    let! members = ctx.Db.AllMembersForSmallGroup group.Id
-    let  types     = ReferenceList.emailTypeList grp.Preferences.DefaultEmailType s |> Map.ofSeq
+    let  types   = ReferenceList.emailTypeList group.Preferences.DefaultEmailType s |> Map.ofSeq
     return!
-        { viewInfo ctx startTicks with HelpLink = Some Help.maintainGroupMembers }
+        { viewInfo ctx with HelpLink = Some Help.maintainGroupMembers }
         |> Views.SmallGroup.members members types ctx
         |> renderHtml next ctx
 }
 
-open NodaTime
-
 /// GET /small-group
 let overview : HttpHandler = requireAccess [ User ] >=> fun next ctx -> task {
-    let  startTicks = DateTime.Now.Ticks
+    let  group    = ctx.Session.CurrentGroup.Value
-    let  clock      = ctx.GetService<IClock> ()
+    let! reqs     = ctx.Db.AllRequestsForSmallGroup  group ctx.Clock None true 0
-    let  group      = ctx.CurrentGroup.Value
-    let! reqs       = ctx.Db.AllRequestsForSmallGroup  group clock None true 0
     let! reqCount = ctx.Db.CountRequestsBySmallGroup group.Id
     let! mbrCount = ctx.Db.CountMembersForSmallGroup group.Id
-    let  m          =
+    let  model    =
         { TotalActiveReqs  = List.length reqs
           AllReqs          = reqCount
           TotalMembers     = mbrCount
@@ -170,18 +162,18 @@ let overview : HttpHandler = requireAccess [ User ] >=> fun next ctx -> task {
                |> Map.ofSeq)
           }
     return!
-        viewInfo ctx startTicks
+        viewInfo ctx
-        |> Views.SmallGroup.overview m
+        |> Views.SmallGroup.overview model
         |> renderHtml next ctx
 }
 
 /// GET /small-group/preferences
 let preferences : HttpHandler = requireAccess [ User ] >=> fun next ctx -> task {
-    let  startTicks = DateTime.Now.Ticks
+    let  group = ctx.Session.CurrentGroup.Value
     let! tzs   = ctx.Db.AllTimeZones ()
     return!
-        { viewInfo ctx startTicks with HelpLink = Some Help.groupPreferences }
+        { viewInfo ctx with HelpLink = Some Help.groupPreferences }
-        |> Views.SmallGroup.preferences (EditPreferences.fromPreferences ctx.CurrentGroup.Value.Preferences) tzs ctx
+        |> Views.SmallGroup.preferences (EditPreferences.fromPreferences group.Preferences) tzs ctx
         |> renderHtml next ctx
 }
 
@@ -190,22 +182,22 @@ open System.Threading.Tasks
 /// POST /small-group/save
 let save : HttpHandler = requireAccess [ Admin ] >=> validateCsrf >=> fun next ctx -> task {
     match! ctx.TryBindFormAsync<EditSmallGroup> () with
-    | Ok m ->
+    | Ok model ->
         let s = Views.I18N.localizer.Force ()
         let! group =
-            if m.IsNew then Task.FromResult (Some { SmallGroup.empty with Id = (Guid.NewGuid >> SmallGroupId) () })
+            if model.IsNew then Task.FromResult (Some { SmallGroup.empty with Id = (Guid.NewGuid >> SmallGroupId) () })
-            else ctx.Db.TryGroupById (idFromShort SmallGroupId m.SmallGroupId)
+            else ctx.Db.TryGroupById (idFromShort SmallGroupId model.SmallGroupId)
         match group with
         | Some grp ->
-            m.populateGroup grp
+            model.populateGroup grp
             |> function
-            | grp when m.IsNew ->
+            | grp when model.IsNew ->
                 ctx.Db.AddEntry grp
                 ctx.Db.AddEntry { grp.Preferences with SmallGroupId = grp.Id }
             | grp -> ctx.Db.UpdateEntry grp
             let! _ = ctx.Db.SaveChangesAsync ()
-            let act = s[if m.IsNew then "Added" else "Updated"].Value.ToLower ()
+            let act = s[if model.IsNew then "Added" else "Updated"].Value.ToLower ()
-            addHtmlInfo ctx s["Successfully {0} group “{1}”", act, m.Name]
+            addHtmlInfo ctx s["Successfully {0} group “{1}”", act, model.Name]
             return! redirectTo false "/small-groups" next ctx
         | None -> return! fourOhFour ctx
     | Result.Error e -> return! bindError e next ctx
@@ -215,13 +207,13 @@ let save : HttpHandler = requireAccess [ Admin ] >=> validateCsrf >=> fun next c
 let saveMember : HttpHandler = requireAccess [ User ] >=> validateCsrf >=> fun next ctx -> task {
     match! ctx.TryBindFormAsync<EditMember> () with
     | Ok model ->
-        let  grp  = ctx.CurrentGroup.Value
+        let  group = ctx.Session.CurrentGroup.Value
         let! mMbr  =
             if model.IsNew then
-                Task.FromResult (Some { Member.empty with Id = (Guid.NewGuid >> MemberId) (); SmallGroupId = grp.Id })
+                Task.FromResult (Some { Member.empty with Id = (Guid.NewGuid >> MemberId) (); SmallGroupId = group.Id })
             else ctx.Db.TryMemberById (idFromShort MemberId model.MemberId)
         match mMbr with
-        | Some mbr when mbr.SmallGroupId = grp.Id ->
+        | Some mbr when mbr.SmallGroupId = group.Id ->
             { mbr with
                 Name   = model.Name
                 Email  = model.Email
@@ -245,13 +237,14 @@ let savePreferences : HttpHandler = requireAccess [ User ] >=> validateCsrf >=>
         // Since the class is stored in the session, we'll use an intermediate instance to persist it; once that works,
         // we can repopulate the session instance. That way, if the update fails, the page should still show the
         // database values, not the then out-of-sync session ones.
-        match! ctx.Db.TryGroupById ctx.CurrentGroup.Value.Id with
+        let group = ctx.Session.CurrentGroup.Value
+        match! ctx.Db.TryGroupById group.Id with
         | Some grp ->
             let prefs = model.PopulatePreferences grp.Preferences
             ctx.Db.UpdateEntry prefs
             let! _ = ctx.Db.SaveChangesAsync ()
             // Refresh session instance
-            ctx.CurrentGroup <- Some { grp with Preferences = prefs }
+            ctx.Session.CurrentGroup <- Some { grp with Preferences = prefs }
             let s = Views.I18N.localizer.Force ()
             addInfo ctx s["Group preferences updated successfully"]
             return! redirectTo false "/small-group/preferences" next ctx
@@ -264,28 +257,27 @@ open PrayerTracker.Views.CommonFunctions
 
 /// POST /small-group/announcement/send
 let sendAnnouncement : HttpHandler = requireAccess [ User ] >=> validateCsrf >=> fun next ctx -> task {
-    let startTicks = DateTime.Now.Ticks
     match! ctx.TryBindFormAsync<Announcement> () with
     | Ok model ->
-        let grp = ctx.CurrentGroup.Value
+        let group = ctx.Session.CurrentGroup.Value
-        let usr = ctx.CurrentUser.Value
+        let prefs = group.Preferences
-        let now = grp.LocalTimeNow (ctx.GetService<IClock> ())
+        let usr   = ctx.Session.CurrentUser.Value
+        let now   = group.LocalTimeNow ctx.Clock
         let s     = Views.I18N.localizer.Force ()
         // Reformat the text to use the class's font stylings
         let requestText = ckEditorToText model.Text
         let htmlText =
-            p [ _style $"font-family:{grp.Preferences.Fonts};font-size:%d{grp.Preferences.TextFontSize}pt;" ]
+            p [ _style $"font-family:{prefs.Fonts};font-size:%d{prefs.TextFontSize}pt;" ] [ rawText requestText ]
-              [ rawText requestText ]
             |> renderHtmlNode
         let plainText = (htmlToPlainText >> wordWrap 74) htmlText
         // Send the e-mails
         let! recipients =
             match model.SendToClass with
             | "N" when usr.IsAdmin -> ctx.Db.AllUsersAsMembers ()
-            | _ -> ctx.Db.AllMembersForSmallGroup grp.Id
+            | _ -> ctx.Db.AllMembersForSmallGroup group.Id
         use! client = Email.getConnection ()
-        do! Email.sendEmails client recipients grp
+        do! Email.sendEmails client recipients group
-                s["Announcement for {0} - {1:MMMM d, yyyy} {2}", grp.Name, now.Date,
+                s["Announcement for {0} - {1:MMMM d, yyyy} {2}", group.Name, now.Date,
                   (now.ToString "h:mm tt").ToLower ()].Value
                 htmlText plainText s
         // Add to the request list if desired
@@ -296,7 +288,7 @@ let sendAnnouncement : HttpHandler = requireAccess [ User ] >=> validateCsrf >=>
         | _, _ ->
             { PrayerRequest.empty with
                 Id           = (Guid.NewGuid >> PrayerRequestId) ()
-                SmallGroupId = grp.Id
+                SmallGroupId = group.Id
                 UserId       = usr.Id
                 RequestType  = (Option.get >> PrayerRequestType.fromCode) model.RequestType
                 Text         = requestText
@@ -314,7 +306,7 @@ let sendAnnouncement : HttpHandler = requireAccess [ User ] >=> validateCsrf >=>
         let andAdded = match model.AddToRequestList with Some x when x -> "and added it to the request list" | _ -> ""
         addInfo ctx s["Successfully sent announcement to all {0} {1}", toWhom, s[andAdded]]
         return!
-            viewInfo ctx startTicks
+            viewInfo ctx
             |> Views.SmallGroup.announcementSent { model with Text = htmlText }
             |> renderHtml next ctx
     | Result.Error e -> return! bindError e next ctx

src/PrayerTracker/User.fs

@@ -37,14 +37,15 @@ let changePassword : HttpHandler = requireAccess [ User ] >=> validateCsrf >=> f
     match! ctx.TryBindFormAsync<ChangePassword> () with
     | Ok model ->
         let  s      = Views.I18N.localizer.Force ()
-        let  curUsr = ctx.CurrentUser.Value
+        let  curUsr = ctx.Session.CurrentUser.Value
         let! dbUsr  = ctx.Db.TryUserById curUsr.Id
+        let  group  = ctx.Session.CurrentGroup.Value
         let! user   =
             match dbUsr with
             | Some usr ->
                 // Check the old password against a possibly non-salted hash
                 (match usr.Salt with Some salt -> pbkdf2Hash salt | None -> sha1Hash) model.OldPassword
-                |> ctx.Db.TryUserLogOnByCookie curUsr.Id ctx.CurrentGroup.Value.Id
+                |> ctx.Db.TryUserLogOnByCookie curUsr.Id group.Id
             | _ -> Task.FromResult None
         match user with
         | Some _ when model.NewPassword = model.NewPasswordConfirm ->
@@ -96,8 +97,8 @@ let doLogOn : HttpHandler = requireAccess [ AccessLevel.Public ] >=> validateCsr
             let! nextUrl = backgroundTask {
                 match usr with
                 | Some user ->
-                    ctx.CurrentUser  <- usr
+                    ctx.Session.CurrentUser  <- usr
-                    ctx.CurrentGroup <- Some group
+                    ctx.Session.CurrentGroup <- Some group
                     let claims = seq {
                         Claim (ClaimTypes.NameIdentifier, shortGuid user.Id.Value)
                         Claim (ClaimTypes.GroupSid, shortGuid group.Id.Value)
@@ -144,18 +145,17 @@ let doLogOn : HttpHandler = requireAccess [ AccessLevel.Public ] >=> validateCsr
 
 /// GET /user/[user-id]/edit
 let edit usrId : HttpHandler = requireAccess [ Admin ] >=> fun next ctx -> task {
-    let startTicks = DateTime.Now.Ticks
     let userId = UserId usrId
     if userId.Value = Guid.Empty then
         return!
-            viewInfo ctx startTicks
+            viewInfo ctx
             |> Views.User.edit EditUser.empty ctx
             |> renderHtml next ctx
     else
         match! ctx.Db.TryUserById userId with
         | Some user ->
             return!
-                viewInfo ctx startTicks
+                viewInfo ctx
                 |> Views.User.edit (EditUser.fromUser user) ctx
                 |> renderHtml next ctx
         | _ -> return! fourOhFour ctx
@@ -164,7 +164,6 @@ let edit usrId : HttpHandler = requireAccess [ Admin ] >=> fun next ctx -> task
 
 /// GET /user/log-on
 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 ()
     let  url    = Option.ofObj <| ctx.Session.GetString Key.Session.redirectUrl
@@ -174,7 +173,7 @@ let logOn : HttpHandler = requireAccess [ AccessLevel.Public ] >=> fun next ctx
         addWarning ctx s["The page you requested requires authentication; please log on below."]
     | None -> ()
     return!
-        { viewInfo ctx startTicks with HelpLink = Some Help.logOn }
+        { viewInfo ctx with HelpLink = Some Help.logOn }
         |> Views.User.logOn { UserLogOn.empty with RedirectUrl = url } groups ctx
         |> renderHtml next ctx
 }
@@ -182,10 +181,9 @@ let logOn : HttpHandler = requireAccess [ AccessLevel.Public ] >=> fun next ctx
 
 /// GET /users
 let maintain : HttpHandler = requireAccess [ Admin ] >=> fun next ctx -> task {
-    let  startTicks = DateTime.Now.Ticks
     let! users = ctx.Db.AllUsers ()
     return!
-        viewInfo ctx startTicks
+        viewInfo ctx
         |> Views.User.maintain users ctx
         |> renderHtml next ctx
 }
@@ -193,7 +191,7 @@ let maintain : HttpHandler = requireAccess [ Admin ] >=> fun next ctx -> task {
 
 /// GET /user/password
 let password : HttpHandler = requireAccess [ User ] >=> fun next ctx ->
-    { viewInfo ctx DateTime.Now.Ticks with HelpLink = Some Help.changePassword }
+    { viewInfo ctx with HelpLink = Some Help.changePassword }
     |> Views.User.changePassword ctx
     |> renderHtml next ctx
 
@@ -201,15 +199,15 @@ let password : HttpHandler = requireAccess [ User ] >=> fun next ctx ->
 /// POST /user/save
 let save : HttpHandler = requireAccess [ Admin ] >=> validateCsrf >=> fun next ctx -> task {
     match! ctx.TryBindFormAsync<EditUser> () with
-    | Ok m ->
+    | Ok model ->
         let! user =
-            if m.IsNew then Task.FromResult (Some { User.empty with Id = (Guid.NewGuid >> UserId) () })
+            if model.IsNew then Task.FromResult (Some { User.empty with Id = (Guid.NewGuid >> UserId) () })
-            else ctx.Db.TryUserById (idFromShort UserId m.UserId)
+            else ctx.Db.TryUserById (idFromShort UserId model.UserId)
         let saltedUser = 
             match user with
             | Some u ->
                 match u.Salt with
-                | None when m.Password <> "" ->
+                | None when model.Password <> "" ->
                     // Generate salt so that a new password hash can be generated
                     Some { u with Salt = Some (Guid.NewGuid ()) }
                 | _ ->
@@ -218,11 +216,11 @@ let save : HttpHandler = requireAccess [ Admin ] >=> validateCsrf >=> fun next c
             | _ -> user
         match saltedUser with
         | Some u ->
-            let updatedUser = m.PopulateUser u (pbkdf2Hash (Option.get u.Salt))
+            let updatedUser = model.PopulateUser u (pbkdf2Hash (Option.get u.Salt))
-            updatedUser |> if m.IsNew then ctx.Db.AddEntry else ctx.Db.UpdateEntry
+            updatedUser |> if model.IsNew then ctx.Db.AddEntry else ctx.Db.UpdateEntry
             let! _ = ctx.Db.SaveChangesAsync ()
             let  s = Views.I18N.localizer.Force ()
-            if m.IsNew then
+            if model.IsNew then
                 let h = CommonFunctions.htmlString
                 { UserMessage.info with
                     Text        = h s["Successfully {0} user", s["Added"].Value.ToLower ()]
@@ -275,14 +273,13 @@ let saveGroups : HttpHandler = requireAccess [ Admin ] >=> validateCsrf >=> fun
 
 /// GET /user/[user-id]/small-groups
 let smallGroups usrId : HttpHandler = requireAccess [ Admin ] >=> fun next ctx -> task {
-    let startTicks = DateTime.Now.Ticks
     let userId = UserId usrId
     match! ctx.Db.TryUserByIdWithGroups userId with
     | Some user ->
         let! groups    = ctx.Db.GroupList ()
         let  curGroups = user.SmallGroups |> Seq.map (fun g -> shortGuid g.SmallGroupId.Value) |> List.ofSeq
         return! 
-            viewInfo ctx startTicks
+            viewInfo ctx
             |> Views.User.assignGroups (AssignGroups.fromUser user) groups curGroups ctx
             |> renderHtml next ctx
     | None -> return! fourOhFour ctx