Restore user/group if missing from session (#39)
- Move start ticks to its own middleware
This commit is contained in:
parent
5e4891869f
commit
c3f7067899
|
@ -140,6 +140,9 @@ let makeUrl url qs =
|
||||||
[<RequireQualifiedAccess>]
|
[<RequireQualifiedAccess>]
|
||||||
module Key =
|
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
|
/// This contains constants for session-stored objects within PrayerTracker
|
||||||
module Session =
|
module Session =
|
||||||
|
|
||||||
|
@ -155,24 +158,6 @@ module Key =
|
||||||
/// The URL to which the user should be redirected once they have logged in
|
/// The URL to which the user should be redirected once they have logged in
|
||||||
let redirectUrl = "RedirectUrl"
|
let redirectUrl = "RedirectUrl"
|
||||||
|
|
||||||
/// Names and value names for use with cookies
|
|
||||||
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)
|
/// Enumerated values for small group request list visibility (derived from preferences, used in UI)
|
||||||
module GroupVisibility =
|
module GroupVisibility =
|
||||||
|
|
|
@ -1,5 +1,17 @@
|
||||||
namespace PrayerTracker
|
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.Builder
|
||||||
open Microsoft.AspNetCore.Hosting
|
open Microsoft.AspNetCore.Hosting
|
||||||
|
|
||||||
|
@ -23,7 +35,6 @@ module Configure =
|
||||||
let kestrel (ctx : WebHostBuilderContext) (opts : KestrelServerOptions) =
|
let kestrel (ctx : WebHostBuilderContext) (opts : KestrelServerOptions) =
|
||||||
(ctx.Configuration.GetSection >> opts.Configure >> ignore) "Kestrel"
|
(ctx.Configuration.GetSection >> opts.Configure >> ignore) "Kestrel"
|
||||||
|
|
||||||
open System
|
|
||||||
open System.Globalization
|
open System.Globalization
|
||||||
open Microsoft.AspNetCore.Authentication.Cookies
|
open Microsoft.AspNetCore.Authentication.Cookies
|
||||||
open Microsoft.AspNetCore.Localization
|
open Microsoft.AspNetCore.Localization
|
||||||
|
@ -54,19 +65,19 @@ module Configure =
|
||||||
let _ = svc.AddSession()
|
let _ = svc.AddSession()
|
||||||
let _ = svc.AddAntiforgery()
|
let _ = svc.AddAntiforgery()
|
||||||
let _ = svc.AddRouting()
|
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)
|
ServiceLifetime.Scoped, ServiceLifetime.Singleton)
|
||||||
()
|
()
|
||||||
|
|
||||||
open Giraffe
|
open Giraffe
|
||||||
|
|
||||||
let noWeb : HttpHandler = fun next ctx ->
|
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
|
open Giraffe.EndpointRouting
|
||||||
|
|
||||||
|
@ -186,6 +197,8 @@ module Configure =
|
||||||
|
|
||||||
let _ = app.UseStatusCodePagesWithReExecute "/error/{0}"
|
let _ = app.UseStatusCodePagesWithReExecute "/error/{0}"
|
||||||
let _ = app.UseStaticFiles ()
|
let _ = app.UseStaticFiles ()
|
||||||
|
let _ = app.UseCookiePolicy (CookiePolicyOptions (MinimumSameSitePolicy = SameSiteMode.Strict))
|
||||||
|
let _ = app.UseMiddleware<RequestStartMiddleware> ()
|
||||||
let _ = app.UseRouting ()
|
let _ = app.UseRouting ()
|
||||||
let _ = app.UseSession ()
|
let _ = app.UseSession ()
|
||||||
let _ = app.UseRequestLocalization
|
let _ = app.UseRequestLocalization
|
||||||
|
|
|
@ -33,17 +33,16 @@ open System
|
||||||
|
|
||||||
/// GET /church/[church-id]/edit
|
/// 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
|
|
||||||
if churchId = Guid.Empty then
|
if churchId = Guid.Empty then
|
||||||
return!
|
return!
|
||||||
viewInfo ctx startTicks
|
viewInfo ctx
|
||||||
|> Views.Church.edit EditChurch.empty ctx
|
|> Views.Church.edit EditChurch.empty ctx
|
||||||
|> renderHtml next ctx
|
|> renderHtml next ctx
|
||||||
else
|
else
|
||||||
match! ctx.Db.TryChurchById (ChurchId churchId) with
|
match! ctx.Db.TryChurchById (ChurchId churchId) with
|
||||||
| Some church ->
|
| Some church ->
|
||||||
return!
|
return!
|
||||||
viewInfo ctx startTicks
|
viewInfo ctx
|
||||||
|> Views.Church.edit (EditChurch.fromChurch church) ctx
|
|> Views.Church.edit (EditChurch.fromChurch church) ctx
|
||||||
|> renderHtml next ctx
|
|> renderHtml next ctx
|
||||||
| None -> return! fourOhFour ctx
|
| None -> return! fourOhFour ctx
|
||||||
|
@ -51,12 +50,11 @@ let edit churchId : HttpHandler = requireAccess [ Admin ] >=> fun next ctx -> ta
|
||||||
|
|
||||||
/// GET /churches
|
/// 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 await = Async.AwaitTask >> Async.RunSynchronously
|
let! churches = ctx.Db.AllChurches ()
|
||||||
let! churches = ctx.Db.AllChurches ()
|
let stats = churches |> List.map (fun c -> await (findStats ctx.Db c.Id))
|
||||||
let stats = churches |> List.map (fun c -> await (findStats ctx.Db c.Id))
|
|
||||||
return!
|
return!
|
||||||
viewInfo ctx startTicks
|
viewInfo ctx
|
||||||
|> Views.Church.maintain churches (stats |> Map.ofList) ctx
|
|> Views.Church.maintain churches (stats |> Map.ofList) ctx
|
||||||
|> renderHtml next ctx
|
|> renderHtml next ctx
|
||||||
}
|
}
|
||||||
|
|
|
@ -48,7 +48,7 @@ open PrayerTracker
|
||||||
open PrayerTracker.ViewModels
|
open PrayerTracker.ViewModels
|
||||||
|
|
||||||
/// Create the common view information heading
|
/// Create the common view information heading
|
||||||
let viewInfo (ctx : HttpContext) startTicks =
|
let viewInfo (ctx : HttpContext) =
|
||||||
let msg =
|
let msg =
|
||||||
match ctx.Session.Messages with
|
match ctx.Session.Messages with
|
||||||
| [] -> []
|
| [] -> []
|
||||||
|
@ -63,9 +63,9 @@ let viewInfo (ctx : HttpContext) startTicks =
|
||||||
{ AppViewInfo.fresh with
|
{ AppViewInfo.fresh with
|
||||||
Version = appVersion
|
Version = appVersion
|
||||||
Messages = msg
|
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
|
Layout = layout
|
||||||
}
|
}
|
||||||
|
|
||||||
|
@ -141,7 +141,9 @@ open PrayerTracker.Entities
|
||||||
|
|
||||||
/// Require one of the given access roles
|
/// Require one of the given access roles
|
||||||
let requireAccess levels : HttpHandler = fun next ctx -> task {
|
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
|
| _, _ when List.contains Public levels -> return! next ctx
|
||||||
| Some _, _ when List.contains User levels -> return! next ctx
|
| Some _, _ when List.contains User levels -> return! next ctx
|
||||||
| _, Some _ when List.contains Group levels -> return! next ctx
|
| _, Some _ when List.contains Group levels -> return! next ctx
|
||||||
|
|
|
@ -2,6 +2,7 @@
|
||||||
module PrayerTracker.Extensions
|
module PrayerTracker.Extensions
|
||||||
|
|
||||||
open Microsoft.AspNetCore.Http
|
open Microsoft.AspNetCore.Http
|
||||||
|
open Microsoft.FSharpLu
|
||||||
open Newtonsoft.Json
|
open Newtonsoft.Json
|
||||||
open PrayerTracker.Entities
|
open PrayerTracker.Entities
|
||||||
open PrayerTracker.ViewModels
|
open PrayerTracker.ViewModels
|
||||||
|
@ -17,6 +18,22 @@ type ISession with
|
||||||
member this.GetObject<'T> key =
|
member this.GetObject<'T> key =
|
||||||
match this.GetString key with null -> Unchecked.defaultof<'T> | v -> JsonConvert.DeserializeObject<'T> v
|
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
|
/// Current messages for the session
|
||||||
member this.Messages
|
member this.Messages
|
||||||
with get () =
|
with get () =
|
||||||
|
@ -26,27 +43,63 @@ type ISession with
|
||||||
and set (v : UserMessage list) = this.SetObject Key.Session.userMessages v
|
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 Giraffe
|
||||||
open Microsoft.FSharpLu
|
open NodaTime
|
||||||
|
open PrayerTracker
|
||||||
|
|
||||||
/// Extensions on the ASP.NET Core HTTP context
|
/// Extensions on the ASP.NET Core HTTP context
|
||||||
type HttpContext with
|
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)
|
/// The EF Core database context (via DI)
|
||||||
member this.Db = this.GetService<AppDbContext> ()
|
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
|
||||||
|
}
|
||||||
|
|
|
@ -9,13 +9,13 @@ open PrayerTracker
|
||||||
|
|
||||||
/// GET /error/[error-code]
|
/// 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
|
viewInfo ctx
|
||||||
|> Views.Home.error code
|
|> Views.Home.error code
|
||||||
|> renderHtml next ctx
|
|> renderHtml next ctx
|
||||||
|
|
||||||
/// GET /
|
/// GET /
|
||||||
let homePage : HttpHandler = requireAccess [ AccessLevel.Public ] >=> fun next ctx ->
|
let homePage : HttpHandler = requireAccess [ AccessLevel.Public ] >=> fun next ctx ->
|
||||||
viewInfo ctx DateTime.Now.Ticks
|
viewInfo ctx
|
||||||
|> Views.Home.index
|
|> Views.Home.index
|
||||||
|> renderHtml next ctx
|
|> renderHtml next ctx
|
||||||
|
|
||||||
|
@ -44,13 +44,13 @@ let language culture : HttpHandler = requireAccess [ AccessLevel.Public ] >=> fu
|
||||||
|
|
||||||
/// GET /legal/privacy-policy
|
/// 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
|
viewInfo ctx
|
||||||
|> Views.Home.privacyPolicy
|
|> Views.Home.privacyPolicy
|
||||||
|> renderHtml next ctx
|
|> renderHtml next ctx
|
||||||
|
|
||||||
/// GET /legal/terms-of-service
|
/// GET /legal/terms-of-service
|
||||||
let tos : HttpHandler = requireAccess [ AccessLevel.Public ] >=> fun next ctx ->
|
let tos : HttpHandler = requireAccess [ AccessLevel.Public ] >=> fun next ctx ->
|
||||||
viewInfo ctx DateTime.Now.Ticks
|
viewInfo ctx
|
||||||
|> Views.Home.termsOfService
|
|> Views.Home.termsOfService
|
||||||
|> renderHtml next ctx
|
|> renderHtml next ctx
|
||||||
|
|
||||||
|
@ -68,6 +68,6 @@ let logOff : HttpHandler = requireAccess [ AccessLevel.Public ] >=> fun next ctx
|
||||||
|
|
||||||
/// GET /unauthorized
|
/// 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
|
viewInfo ctx
|
||||||
|> Views.Home.unauthorized
|
|> Views.Home.unauthorized
|
||||||
|> renderHtml next ctx
|
|> renderHtml next ctx
|
||||||
|
|
|
@ -9,7 +9,7 @@ open PrayerTracker.ViewModels
|
||||||
/// Retrieve a prayer request, and ensure that it belongs to the current class
|
/// Retrieve a prayer request, and ensure that it belongs to the current class
|
||||||
let private findRequest (ctx : HttpContext) reqId = task {
|
let private findRequest (ctx : HttpContext) reqId = task {
|
||||||
match! ctx.Db.TryRequestById reqId with
|
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 _ ->
|
| Some _ ->
|
||||||
let s = Views.I18N.localizer.Force ()
|
let s = Views.I18N.localizer.Force ()
|
||||||
addError ctx s["The prayer request you tried to access is not assigned to your group"]
|
addError ctx s["The prayer request you tried to access is not assigned to your group"]
|
||||||
|
@ -17,20 +17,17 @@ let private findRequest (ctx : HttpContext) reqId = task {
|
||||||
| None -> return Result.Error (fourOhFour ctx)
|
| None -> return Result.Error (fourOhFour ctx)
|
||||||
}
|
}
|
||||||
|
|
||||||
open NodaTime
|
|
||||||
|
|
||||||
/// Generate a list of requests for the given date
|
/// Generate a list of requests for the given date
|
||||||
let private generateRequestList (ctx : HttpContext) date = task {
|
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
|
return
|
||||||
{ Requests = reqs
|
{ Requests = reqs
|
||||||
Date = listDate
|
Date = listDate
|
||||||
SmallGroup = grp
|
SmallGroup = group
|
||||||
ShowHeader = true
|
ShowHeader = true
|
||||||
CanEmail = Option.isSome ctx.CurrentUser
|
CanEmail = Option.isSome ctx.User.UserId
|
||||||
Recipients = []
|
Recipients = []
|
||||||
}
|
}
|
||||||
}
|
}
|
||||||
|
@ -45,20 +42,19 @@ let private parseListDate (date : string option) =
|
||||||
|
|
||||||
/// GET /prayer-request/[request-id]/edit
|
/// GET /prayer-request/[request-id]/edit
|
||||||
let edit reqId : HttpHandler = requireAccess [ User ] >=> fun next ctx -> task {
|
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
|
||||||
let requestId = PrayerRequestId reqId
|
|
||||||
if requestId.Value = Guid.Empty then
|
if requestId.Value = Guid.Empty then
|
||||||
return!
|
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
|
|> Views.PrayerRequest.edit EditRequest.empty (now.ToString "yyyy-MM-dd") ctx
|
||||||
|> renderHtml next ctx
|
|> renderHtml next ctx
|
||||||
else
|
else
|
||||||
match! findRequest ctx requestId with
|
match! findRequest ctx requestId with
|
||||||
| Ok req ->
|
| Ok req ->
|
||||||
let s = Views.I18N.localizer.Force ()
|
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
|
{ UserMessage.warning with
|
||||||
Text = htmlLocString s["This request is expired."]
|
Text = htmlLocString s["This request is expired."]
|
||||||
Description =
|
Description =
|
||||||
|
@ -68,7 +64,7 @@ let edit reqId : HttpHandler = requireAccess [ User ] >=> fun next ctx -> task {
|
||||||
}
|
}
|
||||||
|> addUserMessage ctx
|
|> addUserMessage ctx
|
||||||
return!
|
return!
|
||||||
{ viewInfo ctx startTicks with HelpLink = Some Help.editRequest }
|
{ viewInfo ctx with HelpLink = Some Help.editRequest }
|
||||||
|> Views.PrayerRequest.edit (EditRequest.fromRequest req) "" ctx
|
|> Views.PrayerRequest.edit (EditRequest.fromRequest req) "" ctx
|
||||||
|> renderHtml next ctx
|
|> renderHtml next ctx
|
||||||
| Result.Error e -> return! e
|
| Result.Error e -> return! e
|
||||||
|
@ -76,18 +72,17 @@ let edit reqId : HttpHandler = requireAccess [ User ] >=> fun next ctx -> task {
|
||||||
|
|
||||||
/// GET /prayer-requests/email/[date]
|
/// 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 s = Views.I18N.localizer.Force ()
|
let listDate = parseListDate (Some date)
|
||||||
let listDate = parseListDate (Some date)
|
let group = ctx.Session.CurrentGroup.Value
|
||||||
let grp = ctx.CurrentGroup.Value
|
let! list = generateRequestList ctx listDate
|
||||||
let! list = generateRequestList ctx listDate
|
let! recipients = ctx.Db.AllMembersForSmallGroup group.Id
|
||||||
let! recipients = ctx.Db.AllMembersForSmallGroup grp.Id
|
use! client = Email.getConnection ()
|
||||||
use! client = Email.getConnection ()
|
|
||||||
do! Email.sendEmails client recipients
|
do! Email.sendEmails client recipients
|
||||||
grp s["Prayer Requests for {0} - {1:MMMM d, yyyy}", grp.Name, list.Date].Value
|
group s["Prayer Requests for {0} - {1:MMMM d, yyyy}", group.Name, list.Date].Value
|
||||||
(list.AsHtml s) (list.AsText s) s
|
(list.AsHtml s) (list.AsText s) s
|
||||||
return!
|
return!
|
||||||
viewInfo ctx startTicks
|
viewInfo ctx
|
||||||
|> Views.PrayerRequest.email { list with Recipients = recipients }
|
|> Views.PrayerRequest.email { list with Recipients = recipients }
|
||||||
|> renderHtml next ctx
|
|> renderHtml next ctx
|
||||||
}
|
}
|
||||||
|
@ -120,19 +115,17 @@ let expire reqId : HttpHandler = requireAccess [ User ] >=> fun next ctx -> task
|
||||||
|
|
||||||
/// GET /prayer-requests/[group-id]/list
|
/// 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
|
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!
|
return!
|
||||||
viewInfo ctx startTicks
|
viewInfo ctx
|
||||||
|> Views.PrayerRequest.list
|
|> Views.PrayerRequest.list
|
||||||
{ Requests = reqs
|
{ Requests = reqs
|
||||||
Date = grp.LocalDateNow clock
|
Date = group.LocalDateNow ctx.Clock
|
||||||
SmallGroup = grp
|
SmallGroup = group
|
||||||
ShowHeader = true
|
ShowHeader = true
|
||||||
CanEmail = Option.isSome ctx.CurrentUser
|
CanEmail = Option.isSome ctx.User.UserId
|
||||||
Recipients = []
|
Recipients = []
|
||||||
}
|
}
|
||||||
|> renderHtml next ctx
|
|> renderHtml next ctx
|
||||||
|
@ -145,10 +138,9 @@ let list groupId : HttpHandler = requireAccess [ AccessLevel.Public ] >=> fun ne
|
||||||
|
|
||||||
/// GET /prayer-requests/lists
|
/// 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! groups = ctx.Db.PublicAndProtectedGroups ()
|
||||||
let! groups = ctx.Db.PublicAndProtectedGroups ()
|
|
||||||
return!
|
return!
|
||||||
viewInfo ctx startTicks
|
viewInfo ctx
|
||||||
|> Views.PrayerRequest.lists groups
|
|> Views.PrayerRequest.lists groups
|
||||||
|> renderHtml next ctx
|
|> renderHtml next ctx
|
||||||
}
|
}
|
||||||
|
@ -157,16 +149,15 @@ let lists : HttpHandler = requireAccess [ AccessLevel.Public ] >=> fun next ctx
|
||||||
/// - OR -
|
/// - OR -
|
||||||
/// GET /prayer-requests?search=[search-query]
|
/// GET /prayer-requests?search=[search-query]
|
||||||
let maintain onlyActive : HttpHandler = requireAccess [ User ] >=> fun next ctx -> task {
|
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 =
|
||||||
let pageNbr =
|
|
||||||
match ctx.GetQueryStringValue "page" with
|
match ctx.GetQueryStringValue "page" with
|
||||||
| Ok pg -> match Int32.TryParse pg with true, p -> p | false, _ -> 1
|
| Ok pg -> match Int32.TryParse pg with true, p -> p | false, _ -> 1
|
||||||
| Result.Error _ -> 1
|
| Result.Error _ -> 1
|
||||||
let! m = backgroundTask {
|
let! model = backgroundTask {
|
||||||
match ctx.GetQueryStringValue "search" with
|
match ctx.GetQueryStringValue "search" with
|
||||||
| Ok search ->
|
| Ok search ->
|
||||||
let! reqs = ctx.Db.SearchRequestsForSmallGroup grp search pageNbr
|
let! reqs = ctx.Db.SearchRequestsForSmallGroup group search pageNbr
|
||||||
return
|
return
|
||||||
{ MaintainRequests.empty with
|
{ MaintainRequests.empty with
|
||||||
Requests = reqs
|
Requests = reqs
|
||||||
|
@ -174,7 +165,7 @@ let maintain onlyActive : HttpHandler = requireAccess [ User ] >=> fun next ctx
|
||||||
PageNbr = Some pageNbr
|
PageNbr = Some pageNbr
|
||||||
}
|
}
|
||||||
| Result.Error _ ->
|
| 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
|
return
|
||||||
{ MaintainRequests.empty with
|
{ MaintainRequests.empty with
|
||||||
Requests = reqs
|
Requests = reqs
|
||||||
|
@ -183,8 +174,8 @@ let maintain onlyActive : HttpHandler = requireAccess [ User ] >=> fun next ctx
|
||||||
}
|
}
|
||||||
}
|
}
|
||||||
return!
|
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
|
|> renderHtml next ctx
|
||||||
}
|
}
|
||||||
|
|
||||||
|
@ -214,36 +205,37 @@ open System.Threading.Tasks
|
||||||
/// POST /prayer-request/save
|
/// 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
|
match! ctx.TryBindFormAsync<EditRequest> () with
|
||||||
| Ok m ->
|
| Ok model ->
|
||||||
let! req =
|
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
|
match req with
|
||||||
| Some pr ->
|
| Some pr ->
|
||||||
let upd8 =
|
let upd8 =
|
||||||
{ pr with
|
{ 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 ->
|
| true ->
|
||||||
let dt = defaultArg m.EnteredDate now
|
let dt = defaultArg model.EnteredDate now
|
||||||
{ upd8 with
|
{ upd8 with
|
||||||
SmallGroupId = grp.Id
|
SmallGroupId = group.Id
|
||||||
UserId = ctx.CurrentUser.Value.Id
|
UserId = ctx.User.UserId.Value
|
||||||
EnteredDate = dt
|
EnteredDate = dt
|
||||||
UpdatedDate = dt
|
UpdatedDate = dt
|
||||||
}
|
}
|
||||||
| false when defaultArg m.SkipDateUpdate false -> upd8
|
| false when defaultArg model.SkipDateUpdate false -> upd8
|
||||||
| false -> { upd8 with UpdatedDate = now }
|
| 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! _ = ctx.Db.SaveChangesAsync ()
|
||||||
let s = Views.I18N.localizer.Force ()
|
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 ()]
|
addInfo ctx s["Successfully {0} prayer request", s[act].Value.ToLower ()]
|
||||||
return! redirectTo false "/prayer-requests" next ctx
|
return! redirectTo false "/prayer-requests" next ctx
|
||||||
| None -> return! fourOhFour ctx
|
| None -> return! fourOhFour ctx
|
||||||
|
@ -252,10 +244,9 @@ let save : HttpHandler = requireAccess [ User ] >=> validateCsrf >=> fun next ct
|
||||||
|
|
||||||
/// GET /prayer-request/view/[date?]
|
/// GET /prayer-request/view/[date?]
|
||||||
let view date : HttpHandler = requireAccess [ User; Group ] >=> fun next ctx -> task {
|
let view date : HttpHandler = requireAccess [ User; Group ] >=> fun next ctx -> task {
|
||||||
let startTicks = DateTime.Now.Ticks
|
let! list = generateRequestList ctx (parseListDate date)
|
||||||
let! list = generateRequestList ctx (parseListDate date)
|
|
||||||
return!
|
return!
|
||||||
viewInfo ctx startTicks
|
viewInfo ctx
|
||||||
|> Views.PrayerRequest.view { list with ShowHeader = false }
|
|> Views.PrayerRequest.view { list with ShowHeader = false }
|
||||||
|> renderHtml next ctx
|
|> renderHtml next ctx
|
||||||
}
|
}
|
||||||
|
|
|
@ -8,8 +8,8 @@ open PrayerTracker.ViewModels
|
||||||
|
|
||||||
/// GET /small-group/announcement
|
/// GET /small-group/announcement
|
||||||
let announcement : HttpHandler = requireAccess [ User ] >=> fun next ctx ->
|
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
|
|> renderHtml next ctx
|
||||||
|
|
||||||
/// POST /small-group/[group-id]/delete
|
/// 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
|
/// POST /small-group/member/[member-id]/delete
|
||||||
let deleteMember mbrId : HttpHandler = requireAccess [ User ] >=> validateCsrf >=> fun next ctx -> task {
|
let deleteMember mbrId : HttpHandler = requireAccess [ User ] >=> validateCsrf >=> fun next ctx -> task {
|
||||||
let s = Views.I18N.localizer.Force ()
|
let s = Views.I18N.localizer.Force ()
|
||||||
|
let group = ctx.Session.CurrentGroup.Value
|
||||||
let memberId = MemberId mbrId
|
let memberId = MemberId mbrId
|
||||||
match! ctx.Db.TryMemberById memberId with
|
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
|
ctx.Db.RemoveEntry mbr
|
||||||
let! _ = ctx.Db.SaveChangesAsync ()
|
let! _ = ctx.Db.SaveChangesAsync ()
|
||||||
addHtmlInfo ctx s["The group member “{0}” was deleted successfully", mbr.Name]
|
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
|
/// GET /small-group/[group-id]/edit
|
||||||
let edit grpId : HttpHandler = requireAccess [ Admin ] >=> fun next ctx -> task {
|
let edit grpId : HttpHandler = requireAccess [ Admin ] >=> fun next ctx -> task {
|
||||||
let startTicks = DateTime.Now.Ticks
|
let! churches = ctx.Db.AllChurches ()
|
||||||
let! churches = ctx.Db.AllChurches ()
|
let groupId = SmallGroupId grpId
|
||||||
let groupId = SmallGroupId grpId
|
|
||||||
if groupId.Value = Guid.Empty then
|
if groupId.Value = Guid.Empty then
|
||||||
return!
|
return!
|
||||||
viewInfo ctx startTicks
|
viewInfo ctx
|
||||||
|> Views.SmallGroup.edit EditSmallGroup.empty churches ctx
|
|> Views.SmallGroup.edit EditSmallGroup.empty churches ctx
|
||||||
|> renderHtml next ctx
|
|> renderHtml next ctx
|
||||||
else
|
else
|
||||||
match! ctx.Db.TryGroupById groupId with
|
match! ctx.Db.TryGroupById groupId with
|
||||||
| Some grp ->
|
| Some grp ->
|
||||||
return!
|
return!
|
||||||
viewInfo ctx startTicks
|
viewInfo ctx
|
||||||
|> Views.SmallGroup.edit (EditSmallGroup.fromGroup grp) churches ctx
|
|> Views.SmallGroup.edit (EditSmallGroup.fromGroup grp) churches ctx
|
||||||
|> renderHtml next ctx
|
|> renderHtml next ctx
|
||||||
| None -> return! fourOhFour 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
|
/// GET /small-group/member/[member-id]/edit
|
||||||
let editMember mbrId : HttpHandler = requireAccess [ User ] >=> fun next ctx -> task {
|
let editMember mbrId : HttpHandler = requireAccess [ User ] >=> fun next ctx -> task {
|
||||||
let startTicks = DateTime.Now.Ticks
|
let s = Views.I18N.localizer.Force ()
|
||||||
let s = Views.I18N.localizer.Force ()
|
let group = ctx.Session.CurrentGroup.Value
|
||||||
let grp = ctx.CurrentGroup.Value
|
let types = ReferenceList.emailTypeList group.Preferences.DefaultEmailType s
|
||||||
let types = ReferenceList.emailTypeList grp.Preferences.DefaultEmailType s
|
let memberId = MemberId mbrId
|
||||||
let memberId = MemberId mbrId
|
|
||||||
if memberId.Value = Guid.Empty then
|
if memberId.Value = Guid.Empty then
|
||||||
return!
|
return!
|
||||||
viewInfo ctx startTicks
|
viewInfo ctx
|
||||||
|> Views.SmallGroup.editMember EditMember.empty types ctx
|
|> Views.SmallGroup.editMember EditMember.empty types ctx
|
||||||
|> renderHtml next ctx
|
|> renderHtml next ctx
|
||||||
else
|
else
|
||||||
match! ctx.Db.TryMemberById memberId with
|
match! ctx.Db.TryMemberById memberId with
|
||||||
| Some mbr when mbr.SmallGroupId = grp.Id ->
|
| Some mbr when mbr.SmallGroupId = group.Id ->
|
||||||
return!
|
return!
|
||||||
viewInfo ctx startTicks
|
viewInfo ctx
|
||||||
|> Views.SmallGroup.editMember (EditMember.fromMember mbr) types ctx
|
|> Views.SmallGroup.editMember (EditMember.fromMember mbr) types ctx
|
||||||
|> renderHtml next ctx
|
|> renderHtml next ctx
|
||||||
| Some _
|
| Some _
|
||||||
|
@ -88,11 +87,10 @@ let editMember mbrId : HttpHandler = requireAccess [ User ] >=> fun next ctx ->
|
||||||
|
|
||||||
/// GET /small-group/log-on/[group-id?]
|
/// GET /small-group/log-on/[group-id?]
|
||||||
let logOn grpId : HttpHandler = requireAccess [ AccessLevel.Public ] >=> fun next ctx -> task {
|
let logOn grpId : HttpHandler = requireAccess [ AccessLevel.Public ] >=> fun next ctx -> task {
|
||||||
let startTicks = DateTime.Now.Ticks
|
let! groups = ctx.Db.ProtectedGroups ()
|
||||||
let! groups = ctx.Db.ProtectedGroups ()
|
let groupId = match grpId with Some gid -> shortGuid gid | None -> ""
|
||||||
let groupId = match grpId with Some gid -> shortGuid gid | None -> ""
|
|
||||||
return!
|
return!
|
||||||
{ viewInfo ctx startTicks with HelpLink = Some Help.logOn }
|
{ viewInfo ctx with HelpLink = Some Help.logOn }
|
||||||
|> Views.SmallGroup.logOn groups groupId ctx
|
|> Views.SmallGroup.logOn groups groupId ctx
|
||||||
|> renderHtml next ctx
|
|> renderHtml next ctx
|
||||||
}
|
}
|
||||||
|
@ -108,7 +106,7 @@ let logOnSubmit : HttpHandler = requireAccess [ AccessLevel.Public ] >=> validat
|
||||||
let s = Views.I18N.localizer.Force ()
|
let s = Views.I18N.localizer.Force ()
|
||||||
match! ctx.Db.TryGroupLogOnByPassword (idFromShort SmallGroupId model.SmallGroupId) model.Password with
|
match! ctx.Db.TryGroupLogOnByPassword (idFromShort SmallGroupId model.SmallGroupId) model.Password with
|
||||||
| Some group ->
|
| Some group ->
|
||||||
ctx.CurrentGroup <- Some group
|
ctx.Session.CurrentGroup <- Some group
|
||||||
let claims = Claim (ClaimTypes.GroupSid, shortGuid group.Id.Value) |> Seq.singleton
|
let claims = Claim (ClaimTypes.GroupSid, shortGuid group.Id.Value) |> Seq.singleton
|
||||||
let identity = ClaimsIdentity (claims, CookieAuthenticationDefaults.AuthenticationScheme)
|
let identity = ClaimsIdentity (claims, CookieAuthenticationDefaults.AuthenticationScheme)
|
||||||
do! ctx.SignInAsync
|
do! ctx.SignInAsync
|
||||||
|
@ -126,38 +124,32 @@ let logOnSubmit : HttpHandler = requireAccess [ AccessLevel.Public ] >=> validat
|
||||||
|
|
||||||
/// GET /small-groups
|
/// GET /small-groups
|
||||||
let maintain : HttpHandler = requireAccess [ Admin ] >=> fun next ctx -> task {
|
let maintain : HttpHandler = requireAccess [ Admin ] >=> fun next ctx -> task {
|
||||||
let startTicks = DateTime.Now.Ticks
|
|
||||||
let! groups = ctx.Db.AllGroups ()
|
let! groups = ctx.Db.AllGroups ()
|
||||||
return!
|
return!
|
||||||
viewInfo ctx startTicks
|
viewInfo ctx
|
||||||
|> Views.SmallGroup.maintain groups ctx
|
|> Views.SmallGroup.maintain groups ctx
|
||||||
|> renderHtml next ctx
|
|> renderHtml next ctx
|
||||||
}
|
}
|
||||||
|
|
||||||
/// GET /small-group/members
|
/// GET /small-group/members
|
||||||
let members : HttpHandler = requireAccess [ User ] >=> fun next ctx -> task {
|
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 s = Views.I18N.localizer.Force ()
|
let! members = ctx.Db.AllMembersForSmallGroup group.Id
|
||||||
let! members = ctx.Db.AllMembersForSmallGroup grp.Id
|
let types = ReferenceList.emailTypeList group.Preferences.DefaultEmailType s |> Map.ofSeq
|
||||||
let types = ReferenceList.emailTypeList grp.Preferences.DefaultEmailType s |> Map.ofSeq
|
|
||||||
return!
|
return!
|
||||||
{ viewInfo ctx startTicks with HelpLink = Some Help.maintainGroupMembers }
|
{ viewInfo ctx with HelpLink = Some Help.maintainGroupMembers }
|
||||||
|> Views.SmallGroup.members members types ctx
|
|> Views.SmallGroup.members members types ctx
|
||||||
|> renderHtml next ctx
|
|> renderHtml next ctx
|
||||||
}
|
}
|
||||||
|
|
||||||
open NodaTime
|
|
||||||
|
|
||||||
/// GET /small-group
|
/// GET /small-group
|
||||||
let overview : HttpHandler = requireAccess [ User ] >=> fun next ctx -> task {
|
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! reqCount = ctx.Db.CountRequestsBySmallGroup group.Id
|
||||||
let! reqs = ctx.Db.AllRequestsForSmallGroup group clock None true 0
|
let! mbrCount = ctx.Db.CountMembersForSmallGroup group.Id
|
||||||
let! reqCount = ctx.Db.CountRequestsBySmallGroup group.Id
|
let model =
|
||||||
let! mbrCount = ctx.Db.CountMembersForSmallGroup group.Id
|
|
||||||
let m =
|
|
||||||
{ TotalActiveReqs = List.length reqs
|
{ TotalActiveReqs = List.length reqs
|
||||||
AllReqs = reqCount
|
AllReqs = reqCount
|
||||||
TotalMembers = mbrCount
|
TotalMembers = mbrCount
|
||||||
|
@ -170,18 +162,18 @@ let overview : HttpHandler = requireAccess [ User ] >=> fun next ctx -> task {
|
||||||
|> Map.ofSeq)
|
|> Map.ofSeq)
|
||||||
}
|
}
|
||||||
return!
|
return!
|
||||||
viewInfo ctx startTicks
|
viewInfo ctx
|
||||||
|> Views.SmallGroup.overview m
|
|> Views.SmallGroup.overview model
|
||||||
|> renderHtml next ctx
|
|> renderHtml next ctx
|
||||||
}
|
}
|
||||||
|
|
||||||
/// GET /small-group/preferences
|
/// GET /small-group/preferences
|
||||||
let preferences : HttpHandler = requireAccess [ User ] >=> fun next ctx -> task {
|
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 ()
|
let! tzs = ctx.Db.AllTimeZones ()
|
||||||
return!
|
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
|
|> renderHtml next ctx
|
||||||
}
|
}
|
||||||
|
|
||||||
|
@ -190,22 +182,22 @@ open System.Threading.Tasks
|
||||||
/// POST /small-group/save
|
/// POST /small-group/save
|
||||||
let save : HttpHandler = requireAccess [ Admin ] >=> validateCsrf >=> fun next ctx -> task {
|
let save : HttpHandler = requireAccess [ Admin ] >=> validateCsrf >=> fun next ctx -> task {
|
||||||
match! ctx.TryBindFormAsync<EditSmallGroup> () with
|
match! ctx.TryBindFormAsync<EditSmallGroup> () with
|
||||||
| Ok m ->
|
| Ok model ->
|
||||||
let s = Views.I18N.localizer.Force ()
|
let s = Views.I18N.localizer.Force ()
|
||||||
let! group =
|
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
|
match group with
|
||||||
| Some grp ->
|
| Some grp ->
|
||||||
m.populateGroup grp
|
model.populateGroup grp
|
||||||
|> function
|
|> function
|
||||||
| grp when m.IsNew ->
|
| grp when model.IsNew ->
|
||||||
ctx.Db.AddEntry grp
|
ctx.Db.AddEntry grp
|
||||||
ctx.Db.AddEntry { grp.Preferences with SmallGroupId = grp.Id }
|
ctx.Db.AddEntry { grp.Preferences with SmallGroupId = grp.Id }
|
||||||
| grp -> ctx.Db.UpdateEntry grp
|
| grp -> ctx.Db.UpdateEntry grp
|
||||||
let! _ = ctx.Db.SaveChangesAsync ()
|
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
|
return! redirectTo false "/small-groups" next ctx
|
||||||
| None -> return! fourOhFour ctx
|
| None -> return! fourOhFour ctx
|
||||||
| Result.Error e -> return! bindError e next 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 {
|
let saveMember : HttpHandler = requireAccess [ User ] >=> validateCsrf >=> fun next ctx -> task {
|
||||||
match! ctx.TryBindFormAsync<EditMember> () with
|
match! ctx.TryBindFormAsync<EditMember> () with
|
||||||
| Ok model ->
|
| Ok model ->
|
||||||
let grp = ctx.CurrentGroup.Value
|
let group = ctx.Session.CurrentGroup.Value
|
||||||
let! mMbr =
|
let! mMbr =
|
||||||
if model.IsNew then
|
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)
|
else ctx.Db.TryMemberById (idFromShort MemberId model.MemberId)
|
||||||
match mMbr with
|
match mMbr with
|
||||||
| Some mbr when mbr.SmallGroupId = grp.Id ->
|
| Some mbr when mbr.SmallGroupId = group.Id ->
|
||||||
{ mbr with
|
{ mbr with
|
||||||
Name = model.Name
|
Name = model.Name
|
||||||
Email = model.Email
|
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,
|
// 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
|
// 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.
|
// 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 ->
|
| Some grp ->
|
||||||
let prefs = model.PopulatePreferences grp.Preferences
|
let prefs = model.PopulatePreferences grp.Preferences
|
||||||
ctx.Db.UpdateEntry prefs
|
ctx.Db.UpdateEntry prefs
|
||||||
let! _ = ctx.Db.SaveChangesAsync ()
|
let! _ = ctx.Db.SaveChangesAsync ()
|
||||||
// Refresh session instance
|
// Refresh session instance
|
||||||
ctx.CurrentGroup <- Some { grp with Preferences = prefs }
|
ctx.Session.CurrentGroup <- Some { grp with Preferences = prefs }
|
||||||
let s = Views.I18N.localizer.Force ()
|
let s = Views.I18N.localizer.Force ()
|
||||||
addInfo ctx s["Group preferences updated successfully"]
|
addInfo ctx s["Group preferences updated successfully"]
|
||||||
return! redirectTo false "/small-group/preferences" next ctx
|
return! redirectTo false "/small-group/preferences" next ctx
|
||||||
|
@ -264,28 +257,27 @@ open PrayerTracker.Views.CommonFunctions
|
||||||
|
|
||||||
/// POST /small-group/announcement/send
|
/// POST /small-group/announcement/send
|
||||||
let sendAnnouncement : HttpHandler = requireAccess [ User ] >=> validateCsrf >=> fun next ctx -> task {
|
let sendAnnouncement : HttpHandler = requireAccess [ User ] >=> validateCsrf >=> fun next ctx -> task {
|
||||||
let startTicks = DateTime.Now.Ticks
|
|
||||||
match! ctx.TryBindFormAsync<Announcement> () with
|
match! ctx.TryBindFormAsync<Announcement> () with
|
||||||
| Ok model ->
|
| 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 s = Views.I18N.localizer.Force ()
|
let now = group.LocalTimeNow ctx.Clock
|
||||||
|
let s = Views.I18N.localizer.Force ()
|
||||||
// Reformat the text to use the class's font stylings
|
// Reformat the text to use the class's font stylings
|
||||||
let requestText = ckEditorToText model.Text
|
let requestText = ckEditorToText model.Text
|
||||||
let htmlText =
|
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
|
|> renderHtmlNode
|
||||||
let plainText = (htmlToPlainText >> wordWrap 74) htmlText
|
let plainText = (htmlToPlainText >> wordWrap 74) htmlText
|
||||||
// Send the e-mails
|
// Send the e-mails
|
||||||
let! recipients =
|
let! recipients =
|
||||||
match model.SendToClass with
|
match model.SendToClass with
|
||||||
| "N" when usr.IsAdmin -> ctx.Db.AllUsersAsMembers ()
|
| "N" when usr.IsAdmin -> ctx.Db.AllUsersAsMembers ()
|
||||||
| _ -> ctx.Db.AllMembersForSmallGroup grp.Id
|
| _ -> ctx.Db.AllMembersForSmallGroup group.Id
|
||||||
use! client = Email.getConnection ()
|
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
|
(now.ToString "h:mm tt").ToLower ()].Value
|
||||||
htmlText plainText s
|
htmlText plainText s
|
||||||
// Add to the request list if desired
|
// Add to the request list if desired
|
||||||
|
@ -296,7 +288,7 @@ let sendAnnouncement : HttpHandler = requireAccess [ User ] >=> validateCsrf >=>
|
||||||
| _, _ ->
|
| _, _ ->
|
||||||
{ PrayerRequest.empty with
|
{ PrayerRequest.empty with
|
||||||
Id = (Guid.NewGuid >> PrayerRequestId) ()
|
Id = (Guid.NewGuid >> PrayerRequestId) ()
|
||||||
SmallGroupId = grp.Id
|
SmallGroupId = group.Id
|
||||||
UserId = usr.Id
|
UserId = usr.Id
|
||||||
RequestType = (Option.get >> PrayerRequestType.fromCode) model.RequestType
|
RequestType = (Option.get >> PrayerRequestType.fromCode) model.RequestType
|
||||||
Text = requestText
|
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" | _ -> ""
|
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]]
|
addInfo ctx s["Successfully sent announcement to all {0} {1}", toWhom, s[andAdded]]
|
||||||
return!
|
return!
|
||||||
viewInfo ctx startTicks
|
viewInfo ctx
|
||||||
|> Views.SmallGroup.announcementSent { model with Text = htmlText }
|
|> Views.SmallGroup.announcementSent { model with Text = htmlText }
|
||||||
|> renderHtml next ctx
|
|> renderHtml next ctx
|
||||||
| Result.Error e -> return! bindError e next ctx
|
| Result.Error e -> return! bindError e next ctx
|
||||||
|
|
|
@ -37,14 +37,15 @@ let changePassword : HttpHandler = requireAccess [ User ] >=> validateCsrf >=> f
|
||||||
match! ctx.TryBindFormAsync<ChangePassword> () with
|
match! ctx.TryBindFormAsync<ChangePassword> () with
|
||||||
| Ok model ->
|
| Ok model ->
|
||||||
let s = Views.I18N.localizer.Force ()
|
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! dbUsr = ctx.Db.TryUserById curUsr.Id
|
||||||
|
let group = ctx.Session.CurrentGroup.Value
|
||||||
let! user =
|
let! user =
|
||||||
match dbUsr with
|
match dbUsr with
|
||||||
| Some usr ->
|
| Some usr ->
|
||||||
// Check the old password against a possibly non-salted hash
|
// Check the old password against a possibly non-salted hash
|
||||||
(match usr.Salt with Some salt -> pbkdf2Hash salt | None -> sha1Hash) model.OldPassword
|
(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
|
| _ -> Task.FromResult None
|
||||||
match user with
|
match user with
|
||||||
| Some _ when model.NewPassword = model.NewPasswordConfirm ->
|
| Some _ when model.NewPassword = model.NewPasswordConfirm ->
|
||||||
|
@ -96,8 +97,8 @@ let doLogOn : HttpHandler = requireAccess [ AccessLevel.Public ] >=> validateCsr
|
||||||
let! nextUrl = backgroundTask {
|
let! nextUrl = backgroundTask {
|
||||||
match usr with
|
match usr with
|
||||||
| Some user ->
|
| Some user ->
|
||||||
ctx.CurrentUser <- usr
|
ctx.Session.CurrentUser <- usr
|
||||||
ctx.CurrentGroup <- Some group
|
ctx.Session.CurrentGroup <- Some group
|
||||||
let claims = seq {
|
let claims = seq {
|
||||||
Claim (ClaimTypes.NameIdentifier, shortGuid user.Id.Value)
|
Claim (ClaimTypes.NameIdentifier, shortGuid user.Id.Value)
|
||||||
Claim (ClaimTypes.GroupSid, shortGuid group.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
|
/// GET /user/[user-id]/edit
|
||||||
let edit usrId : HttpHandler = requireAccess [ Admin ] >=> fun next ctx -> task {
|
let edit usrId : HttpHandler = requireAccess [ Admin ] >=> fun next ctx -> task {
|
||||||
let startTicks = DateTime.Now.Ticks
|
|
||||||
let userId = UserId usrId
|
let userId = UserId usrId
|
||||||
if userId.Value = Guid.Empty then
|
if userId.Value = Guid.Empty then
|
||||||
return!
|
return!
|
||||||
viewInfo ctx startTicks
|
viewInfo ctx
|
||||||
|> Views.User.edit EditUser.empty ctx
|
|> Views.User.edit EditUser.empty ctx
|
||||||
|> renderHtml next ctx
|
|> renderHtml next ctx
|
||||||
else
|
else
|
||||||
match! ctx.Db.TryUserById userId with
|
match! ctx.Db.TryUserById userId with
|
||||||
| Some user ->
|
| Some user ->
|
||||||
return!
|
return!
|
||||||
viewInfo ctx startTicks
|
viewInfo ctx
|
||||||
|> Views.User.edit (EditUser.fromUser user) ctx
|
|> Views.User.edit (EditUser.fromUser user) ctx
|
||||||
|> renderHtml next ctx
|
|> renderHtml next ctx
|
||||||
| _ -> return! fourOhFour ctx
|
| _ -> return! fourOhFour ctx
|
||||||
|
@ -164,17 +164,16 @@ let edit usrId : HttpHandler = requireAccess [ Admin ] >=> fun next ctx -> task
|
||||||
|
|
||||||
/// GET /user/log-on
|
/// 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 s = Views.I18N.localizer.Force ()
|
let! groups = ctx.Db.GroupList ()
|
||||||
let! groups = ctx.Db.GroupList ()
|
let url = Option.ofObj <| ctx.Session.GetString Key.Session.redirectUrl
|
||||||
let url = Option.ofObj <| ctx.Session.GetString Key.Session.redirectUrl
|
|
||||||
match url with
|
match url with
|
||||||
| Some _ ->
|
| Some _ ->
|
||||||
ctx.Session.Remove Key.Session.redirectUrl
|
ctx.Session.Remove Key.Session.redirectUrl
|
||||||
addWarning ctx s["The page you requested requires authentication; please log on below."]
|
addWarning ctx s["The page you requested requires authentication; please log on below."]
|
||||||
| None -> ()
|
| None -> ()
|
||||||
return!
|
return!
|
||||||
{ viewInfo ctx startTicks with HelpLink = Some Help.logOn }
|
{ viewInfo ctx with HelpLink = Some Help.logOn }
|
||||||
|> Views.User.logOn { UserLogOn.empty with RedirectUrl = url } groups ctx
|
|> Views.User.logOn { UserLogOn.empty with RedirectUrl = url } groups ctx
|
||||||
|> renderHtml next ctx
|
|> renderHtml next ctx
|
||||||
}
|
}
|
||||||
|
@ -182,10 +181,9 @@ let logOn : HttpHandler = requireAccess [ AccessLevel.Public ] >=> fun next ctx
|
||||||
|
|
||||||
/// GET /users
|
/// 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 ()
|
||||||
let! users = ctx.Db.AllUsers ()
|
|
||||||
return!
|
return!
|
||||||
viewInfo ctx startTicks
|
viewInfo ctx
|
||||||
|> Views.User.maintain users ctx
|
|> Views.User.maintain users ctx
|
||||||
|> renderHtml next ctx
|
|> renderHtml next ctx
|
||||||
}
|
}
|
||||||
|
@ -193,7 +191,7 @@ let maintain : HttpHandler = requireAccess [ Admin ] >=> fun next ctx -> task {
|
||||||
|
|
||||||
/// GET /user/password
|
/// 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 }
|
{ viewInfo ctx with HelpLink = Some Help.changePassword }
|
||||||
|> Views.User.changePassword ctx
|
|> Views.User.changePassword ctx
|
||||||
|> renderHtml next ctx
|
|> renderHtml next ctx
|
||||||
|
|
||||||
|
@ -201,15 +199,15 @@ let password : HttpHandler = requireAccess [ User ] >=> fun next ctx ->
|
||||||
/// POST /user/save
|
/// 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
|
match! ctx.TryBindFormAsync<EditUser> () with
|
||||||
| Ok m ->
|
| Ok model ->
|
||||||
let! user =
|
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 =
|
let saltedUser =
|
||||||
match user with
|
match user with
|
||||||
| Some u ->
|
| Some u ->
|
||||||
match u.Salt with
|
match u.Salt with
|
||||||
| None when m.Password <> "" ->
|
| None when model.Password <> "" ->
|
||||||
// Generate salt so that a new password hash can be generated
|
// Generate salt so that a new password hash can be generated
|
||||||
Some { u with Salt = Some (Guid.NewGuid ()) }
|
Some { u with Salt = Some (Guid.NewGuid ()) }
|
||||||
| _ ->
|
| _ ->
|
||||||
|
@ -218,11 +216,11 @@ let save : HttpHandler = requireAccess [ Admin ] >=> validateCsrf >=> fun next c
|
||||||
| _ -> user
|
| _ -> user
|
||||||
match saltedUser with
|
match saltedUser with
|
||||||
| Some u ->
|
| 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! _ = ctx.Db.SaveChangesAsync ()
|
||||||
let s = Views.I18N.localizer.Force ()
|
let s = Views.I18N.localizer.Force ()
|
||||||
if m.IsNew then
|
if model.IsNew then
|
||||||
let h = CommonFunctions.htmlString
|
let h = CommonFunctions.htmlString
|
||||||
{ UserMessage.info with
|
{ UserMessage.info with
|
||||||
Text = h s["Successfully {0} user", s["Added"].Value.ToLower ()]
|
Text = h s["Successfully {0} user", s["Added"].Value.ToLower ()]
|
||||||
|
@ -275,14 +273,13 @@ let saveGroups : HttpHandler = requireAccess [ Admin ] >=> validateCsrf >=> fun
|
||||||
|
|
||||||
/// GET /user/[user-id]/small-groups
|
/// GET /user/[user-id]/small-groups
|
||||||
let smallGroups usrId : HttpHandler = requireAccess [ Admin ] >=> fun next ctx -> task {
|
let smallGroups usrId : HttpHandler = requireAccess [ Admin ] >=> fun next ctx -> task {
|
||||||
let startTicks = DateTime.Now.Ticks
|
let userId = UserId usrId
|
||||||
let userId = UserId usrId
|
|
||||||
match! ctx.Db.TryUserByIdWithGroups userId with
|
match! ctx.Db.TryUserByIdWithGroups userId with
|
||||||
| Some user ->
|
| Some user ->
|
||||||
let! groups = ctx.Db.GroupList ()
|
let! groups = ctx.Db.GroupList ()
|
||||||
let curGroups = user.SmallGroups |> Seq.map (fun g -> shortGuid g.SmallGroupId.Value) |> List.ofSeq
|
let curGroups = user.SmallGroups |> Seq.map (fun g -> shortGuid g.SmallGroupId.Value) |> List.ofSeq
|
||||||
return!
|
return!
|
||||||
viewInfo ctx startTicks
|
viewInfo ctx
|
||||||
|> Views.User.assignGroups (AssignGroups.fromUser user) groups curGroups ctx
|
|> Views.User.assignGroups (AssignGroups.fromUser user) groups curGroups ctx
|
||||||
|> renderHtml next ctx
|
|> renderHtml next ctx
|
||||||
| None -> return! fourOhFour ctx
|
| None -> return! fourOhFour ctx
|
||||||
|
|
Loading…
Reference in New Issue
Block a user