.NET 6 #32
@ -1,9 +1,9 @@
|
|||||||
<Project>
|
<Project>
|
||||||
<PropertyGroup>
|
<PropertyGroup>
|
||||||
<AssemblyVersion>7.5.0.0</AssemblyVersion>
|
<AssemblyVersion>7.6.0.0</AssemblyVersion>
|
||||||
<FileVersion>7.5.0.0</FileVersion>
|
<FileVersion>7.6.0.0</FileVersion>
|
||||||
<Authors>danieljsummers</Authors>
|
<Authors>danieljsummers</Authors>
|
||||||
<Company>Bit Badger Solutions</Company>
|
<Company>Bit Badger Solutions</Company>
|
||||||
<Version>7.5.0</Version>
|
<Version>7.6.0</Version>
|
||||||
</PropertyGroup>
|
</PropertyGroup>
|
||||||
</Project>
|
</Project>
|
||||||
|
@ -1,7 +1,6 @@
|
|||||||
[<AutoOpen>]
|
[<AutoOpen>]
|
||||||
module PrayerTracker.DataAccess
|
module PrayerTracker.DataAccess
|
||||||
|
|
||||||
open FSharp.Control.Tasks.ContextInsensitive
|
|
||||||
open Microsoft.EntityFrameworkCore
|
open Microsoft.EntityFrameworkCore
|
||||||
open PrayerTracker.Entities
|
open PrayerTracker.Entities
|
||||||
open System.Collections.Generic
|
open System.Collections.Generic
|
||||||
|
@ -6,6 +6,8 @@ open NodaTime
|
|||||||
open System
|
open System
|
||||||
open System.Collections.Generic
|
open System.Collections.Generic
|
||||||
|
|
||||||
|
// fsharplint:disable RecordFieldNames MemberNames
|
||||||
|
|
||||||
(*-- SUPPORT TYPES --*)
|
(*-- SUPPORT TYPES --*)
|
||||||
|
|
||||||
/// How as-of dates should (or should not) be displayed with requests
|
/// How as-of dates should (or should not) be displayed with requests
|
||||||
|
@ -10,6 +10,7 @@ open PrayerTracker
|
|||||||
open PrayerTracker.Entities
|
open PrayerTracker.Entities
|
||||||
open System
|
open System
|
||||||
|
|
||||||
|
// fsharplint:disable RecordFieldNames
|
||||||
|
|
||||||
type ChurchTable =
|
type ChurchTable =
|
||||||
{ churchId : OperationBuilder<AddColumnOperation>
|
{ churchId : OperationBuilder<AddColumnOperation>
|
||||||
|
@ -1,7 +1,7 @@
|
|||||||
<Project Sdk="Microsoft.NET.Sdk">
|
<Project Sdk="Microsoft.NET.Sdk">
|
||||||
|
|
||||||
<PropertyGroup>
|
<PropertyGroup>
|
||||||
<TargetFramework>net5.0</TargetFramework>
|
<TargetFramework>net6.0</TargetFramework>
|
||||||
</PropertyGroup>
|
</PropertyGroup>
|
||||||
|
|
||||||
<ItemGroup>
|
<ItemGroup>
|
||||||
@ -14,10 +14,9 @@
|
|||||||
|
|
||||||
<ItemGroup>
|
<ItemGroup>
|
||||||
<PackageReference Include="FSharp.EFCore.OptionConverter" Version="1.0.0" />
|
<PackageReference Include="FSharp.EFCore.OptionConverter" Version="1.0.0" />
|
||||||
<PackageReference Include="Microsoft.FSharpLu" Version="0.11.6" />
|
<PackageReference Include="Microsoft.FSharpLu" Version="0.11.7" />
|
||||||
<PackageReference Include="NodaTime" Version="2.4.7" />
|
<PackageReference Include="NodaTime" Version="3.0.5" />
|
||||||
<PackageReference Include="Npgsql.EntityFrameworkCore.PostgreSQL" Version="3.1.2" />
|
<PackageReference Include="Npgsql.EntityFrameworkCore.PostgreSQL" Version="5.0.10" />
|
||||||
<PackageReference Include="TaskBuilder.fs" Version="2.1.0" />
|
|
||||||
</ItemGroup>
|
</ItemGroup>
|
||||||
|
|
||||||
</Project>
|
</Project>
|
||||||
|
@ -2,7 +2,7 @@
|
|||||||
|
|
||||||
<PropertyGroup>
|
<PropertyGroup>
|
||||||
<OutputType>Exe</OutputType>
|
<OutputType>Exe</OutputType>
|
||||||
<TargetFramework>net5.0</TargetFramework>
|
<TargetFramework>net6.0</TargetFramework>
|
||||||
</PropertyGroup>
|
</PropertyGroup>
|
||||||
|
|
||||||
<ItemGroup>
|
<ItemGroup>
|
||||||
@ -15,9 +15,9 @@
|
|||||||
</ItemGroup>
|
</ItemGroup>
|
||||||
|
|
||||||
<ItemGroup>
|
<ItemGroup>
|
||||||
<PackageReference Include="Expecto" Version="8.13.1" />
|
<PackageReference Include="Expecto" Version="9.0.4" />
|
||||||
<PackageReference Include="Expecto.VisualStudio.TestAdapter" Version="10.0.2" />
|
<PackageReference Include="Expecto.VisualStudio.TestAdapter" Version="10.0.2" />
|
||||||
<PackageReference Include="NodaTime.Testing" Version="2.4.7" />
|
<PackageReference Include="NodaTime.Testing" Version="3.0.5" />
|
||||||
</ItemGroup>
|
</ItemGroup>
|
||||||
|
|
||||||
<ItemGroup>
|
<ItemGroup>
|
||||||
|
@ -1,7 +1,7 @@
|
|||||||
module PrayerTracker.UI.CommonFunctionsTests
|
module PrayerTracker.UI.CommonFunctionsTests
|
||||||
|
|
||||||
open Expecto
|
open Expecto
|
||||||
open Giraffe.GiraffeViewEngine
|
open Giraffe.ViewEngine
|
||||||
open Microsoft.AspNetCore.Mvc.Localization
|
open Microsoft.AspNetCore.Mvc.Localization
|
||||||
open Microsoft.Extensions.Localization
|
open Microsoft.Extensions.Localization
|
||||||
open PrayerTracker.Tests.TestLocalization
|
open PrayerTracker.Tests.TestLocalization
|
||||||
|
@ -1,6 +1,6 @@
|
|||||||
module PrayerTracker.Views.Church
|
module PrayerTracker.Views.Church
|
||||||
|
|
||||||
open Giraffe.GiraffeViewEngine
|
open Giraffe.ViewEngine
|
||||||
open PrayerTracker.Entities
|
open PrayerTracker.Entities
|
||||||
open PrayerTracker.ViewModels
|
open PrayerTracker.ViewModels
|
||||||
|
|
||||||
|
@ -2,8 +2,9 @@
|
|||||||
module PrayerTracker.Views.CommonFunctions
|
module PrayerTracker.Views.CommonFunctions
|
||||||
|
|
||||||
open Giraffe
|
open Giraffe
|
||||||
open Giraffe.GiraffeViewEngine
|
open Giraffe.ViewEngine
|
||||||
open Microsoft.AspNetCore.Antiforgery
|
open Microsoft.AspNetCore.Antiforgery
|
||||||
|
open Microsoft.AspNetCore.Html
|
||||||
open Microsoft.AspNetCore.Http
|
open Microsoft.AspNetCore.Http
|
||||||
open Microsoft.AspNetCore.Mvc.Localization
|
open Microsoft.AspNetCore.Mvc.Localization
|
||||||
open Microsoft.Extensions.Localization
|
open Microsoft.Extensions.Localization
|
||||||
@ -125,6 +126,13 @@ let _onsubmit = attr "onsubmit"
|
|||||||
let _scoped = flag "scoped"
|
let _scoped = flag "scoped"
|
||||||
|
|
||||||
|
|
||||||
|
/// The name this function used to have when the view engine was part of Giraffe
|
||||||
|
let renderHtmlNode = RenderView.AsString.htmlNode
|
||||||
|
|
||||||
|
/// Render an HTML node, then return the value as an HTML string
|
||||||
|
let renderHtmlString = renderHtmlNode >> HtmlString
|
||||||
|
|
||||||
|
|
||||||
/// Utility methods to help with time zones (and localization of their names)
|
/// Utility methods to help with time zones (and localization of their names)
|
||||||
module TimeZones =
|
module TimeZones =
|
||||||
|
|
||||||
|
@ -1,7 +1,7 @@
|
|||||||
/// Views associated with the home page, or those that don't fit anywhere else
|
/// Views associated with the home page, or those that don't fit anywhere else
|
||||||
module PrayerTracker.Views.Home
|
module PrayerTracker.Views.Home
|
||||||
|
|
||||||
open Giraffe.GiraffeViewEngine
|
open Giraffe.ViewEngine
|
||||||
open Microsoft.AspNetCore.Html
|
open Microsoft.AspNetCore.Html
|
||||||
open PrayerTracker.ViewModels
|
open PrayerTracker.ViewModels
|
||||||
open System.IO
|
open System.IO
|
||||||
@ -204,7 +204,7 @@ let termsOfService vi =
|
|||||||
let raw = rawLocText sw
|
let raw = rawLocText sw
|
||||||
let ppLink =
|
let ppLink =
|
||||||
a [ _href "/web/legal/privacy-policy" ] [ str (s.["Privacy Policy"].Value.ToLower ()) ]
|
a [ _href "/web/legal/privacy-policy" ] [ str (s.["Privacy Policy"].Value.ToLower ()) ]
|
||||||
|> (renderHtmlNode >> HtmlString)
|
|> renderHtmlString
|
||||||
|
|
||||||
[ p [ _class "pt-right-text" ] [ small [] [ em [] [ raw l.["(as of May 24, 2018)"] ] ] ]
|
[ p [ _class "pt-right-text" ] [ small [] [ em [] [ raw l.["(as of May 24, 2018)"] ] ] ]
|
||||||
h3 [] [ str "1. "; raw l.["Acceptance of Terms"] ]
|
h3 [] [ str "1. "; raw l.["Acceptance of Terms"] ]
|
||||||
|
@ -1,7 +1,7 @@
|
|||||||
/// Layout items for PrayerTracker
|
/// Layout items for PrayerTracker
|
||||||
module PrayerTracker.Views.Layout
|
module PrayerTracker.Views.Layout
|
||||||
|
|
||||||
open Giraffe.GiraffeViewEngine
|
open Giraffe.ViewEngine
|
||||||
open PrayerTracker
|
open PrayerTracker
|
||||||
open PrayerTracker.ViewModels
|
open PrayerTracker.ViewModels
|
||||||
open System
|
open System
|
||||||
|
@ -1,7 +1,7 @@
|
|||||||
module PrayerTracker.Views.PrayerRequest
|
module PrayerTracker.Views.PrayerRequest
|
||||||
|
|
||||||
open Giraffe
|
open Giraffe
|
||||||
open Giraffe.GiraffeViewEngine
|
open Giraffe.ViewEngine
|
||||||
open Microsoft.AspNetCore.Http
|
open Microsoft.AspNetCore.Http
|
||||||
open NodaTime
|
open NodaTime
|
||||||
open PrayerTracker
|
open PrayerTracker
|
||||||
|
@ -1,7 +1,7 @@
|
|||||||
<Project Sdk="Microsoft.NET.Sdk">
|
<Project Sdk="Microsoft.NET.Sdk">
|
||||||
|
|
||||||
<PropertyGroup>
|
<PropertyGroup>
|
||||||
<TargetFramework>net5.0</TargetFramework>
|
<TargetFramework>net6.0</TargetFramework>
|
||||||
</PropertyGroup>
|
</PropertyGroup>
|
||||||
|
|
||||||
<ItemGroup>
|
<ItemGroup>
|
||||||
@ -18,13 +18,14 @@
|
|||||||
</ItemGroup>
|
</ItemGroup>
|
||||||
|
|
||||||
<ItemGroup>
|
<ItemGroup>
|
||||||
<PackageReference Include="Giraffe" Version="4.0.1" />
|
<PackageReference Include="Giraffe" Version="5.0.0" />
|
||||||
<PackageReference Include="MailKit" Version="2.5.1" />
|
<PackageReference Include="Giraffe.ViewEngine" Version="1.4.0" />
|
||||||
|
<PackageReference Include="MailKit" Version="2.15.0" />
|
||||||
<PackageReference Include="Microsoft.AspNetCore.Html.Abstractions" Version="2.2.0" />
|
<PackageReference Include="Microsoft.AspNetCore.Html.Abstractions" Version="2.2.0" />
|
||||||
<PackageReference Include="Microsoft.AspNetCore.Http" Version="2.2.2" />
|
<PackageReference Include="Microsoft.AspNetCore.Http" Version="2.2.2" />
|
||||||
<PackageReference Include="Microsoft.AspNetCore.Http.Extensions" Version="2.2.0" />
|
<PackageReference Include="Microsoft.AspNetCore.Http.Extensions" Version="2.2.0" />
|
||||||
<PackageReference Include="Microsoft.AspNetCore.Mvc" Version="2.2.0" />
|
<PackageReference Include="Microsoft.AspNetCore.Mvc" Version="2.2.0" />
|
||||||
<PackageReference Include="Newtonsoft.Json" Version="12.0.3" />
|
<PackageReference Include="Newtonsoft.Json" Version="13.0.1" />
|
||||||
</ItemGroup>
|
</ItemGroup>
|
||||||
|
|
||||||
<ItemGroup>
|
<ItemGroup>
|
||||||
|
@ -1,6 +1,6 @@
|
|||||||
module PrayerTracker.Views.SmallGroup
|
module PrayerTracker.Views.SmallGroup
|
||||||
|
|
||||||
open Giraffe.GiraffeViewEngine
|
open Giraffe.ViewEngine
|
||||||
open Microsoft.Extensions.Localization
|
open Microsoft.Extensions.Localization
|
||||||
open PrayerTracker
|
open PrayerTracker
|
||||||
open PrayerTracker.Entities
|
open PrayerTracker.Entities
|
||||||
|
@ -1,6 +1,6 @@
|
|||||||
module PrayerTracker.Views.User
|
module PrayerTracker.Views.User
|
||||||
|
|
||||||
open Giraffe.GiraffeViewEngine
|
open Giraffe.ViewEngine
|
||||||
open PrayerTracker.Entities
|
open PrayerTracker.Entities
|
||||||
open PrayerTracker.ViewModels
|
open PrayerTracker.ViewModels
|
||||||
|
|
||||||
|
@ -557,7 +557,7 @@ module UserLogOn =
|
|||||||
}
|
}
|
||||||
|
|
||||||
|
|
||||||
open Giraffe.GiraffeViewEngine
|
open Giraffe.ViewEngine
|
||||||
|
|
||||||
/// This represents a list of requests
|
/// This represents a list of requests
|
||||||
type RequestList =
|
type RequestList =
|
||||||
@ -651,7 +651,7 @@ with
|
|||||||
|> ul []
|
|> ul []
|
||||||
br []
|
br []
|
||||||
]
|
]
|
||||||
|> renderHtmlNodes
|
|> RenderView.AsString.htmlNodes
|
||||||
|
|
||||||
/// Generate this list as plain text
|
/// Generate this list as plain text
|
||||||
member this.asText (s : IStringLocalizer) =
|
member this.asText (s : IStringLocalizer) =
|
||||||
|
@ -9,7 +9,7 @@ module Configure =
|
|||||||
|
|
||||||
open Cookies
|
open Cookies
|
||||||
open Giraffe
|
open Giraffe
|
||||||
open Giraffe.TokenRouter
|
open Giraffe.EndpointRouting
|
||||||
open Microsoft.AspNetCore.Localization
|
open Microsoft.AspNetCore.Localization
|
||||||
open Microsoft.AspNetCore.Server.Kestrel.Core
|
open Microsoft.AspNetCore.Server.Kestrel.Core
|
||||||
open Microsoft.EntityFrameworkCore
|
open Microsoft.EntityFrameworkCore
|
||||||
@ -49,22 +49,22 @@ module Configure =
|
|||||||
.AddDistributedMemoryCache()
|
.AddDistributedMemoryCache()
|
||||||
.AddSession()
|
.AddSession()
|
||||||
.AddAntiforgery()
|
.AddAntiforgery()
|
||||||
|
.AddRouting()
|
||||||
.AddSingleton<IClock>(SystemClock.Instance)
|
.AddSingleton<IClock>(SystemClock.Instance)
|
||||||
|> ignore
|
|> ignore
|
||||||
let config = svc.BuildServiceProvider().GetRequiredService<IConfiguration>()
|
let config = svc.BuildServiceProvider().GetRequiredService<IConfiguration>()
|
||||||
let crypto = config.GetSection "CookieCrypto"
|
let crypto = config.GetSection "CookieCrypto"
|
||||||
CookieCrypto (crypto.["Key"], crypto.["IV"]) |> setCrypto
|
CookieCrypto (crypto.["Key"], crypto.["IV"]) |> setCrypto
|
||||||
svc.AddDbContext<AppDbContext>(
|
svc.AddDbContext<AppDbContext>(
|
||||||
fun options ->
|
(fun options ->
|
||||||
options.UseNpgsql (config.GetConnectionString "PrayerTracker") |> ignore)
|
options.UseNpgsql (config.GetConnectionString "PrayerTracker") |> ignore),
|
||||||
|
ServiceLifetime.Scoped, ServiceLifetime.Singleton)
|
||||||
|> ignore
|
|> ignore
|
||||||
|
|
||||||
/// Routes for PrayerTracker
|
/// Routes for PrayerTracker
|
||||||
let webApp =
|
let routes =
|
||||||
router Handlers.CommonFunctions.fourOhFour [
|
[ subRoute "/web" [
|
||||||
// Traditional web app routes
|
GET_HEAD [
|
||||||
subRoute"/web" [
|
|
||||||
GET [
|
|
||||||
subRoute "/church" [
|
subRoute "/church" [
|
||||||
route "es" Handlers.Church.maintain
|
route "es" Handlers.Church.maintain
|
||||||
routef "/%O/edit" Handlers.Church.edit
|
routef "/%O/edit" Handlers.Church.edit
|
||||||
@ -145,6 +145,7 @@ module Configure =
|
|||||||
route "/" (redirectTo false "/web/")
|
route "/" (redirectTo false "/web/")
|
||||||
]
|
]
|
||||||
|
|
||||||
|
/// Giraffe error handler
|
||||||
let errorHandler (ex : exn) (logger : ILogger) =
|
let errorHandler (ex : exn) (logger : ILogger) =
|
||||||
logger.LogError(EventId(), ex, "An unhandled exception has occurred while executing the request.")
|
logger.LogError(EventId(), ex, "An unhandled exception has occurred while executing the request.")
|
||||||
clearResponse >=> setStatusCode 500 >=> text ex.Message
|
clearResponse >=> setStatusCode 500 >=> text ex.Message
|
||||||
@ -171,9 +172,10 @@ module Configure =
|
|||||||
app.UseGiraffeErrorHandler errorHandler)
|
app.UseGiraffeErrorHandler errorHandler)
|
||||||
.UseStatusCodePagesWithReExecute("/error/{0}")
|
.UseStatusCodePagesWithReExecute("/error/{0}")
|
||||||
.UseStaticFiles()
|
.UseStaticFiles()
|
||||||
|
.UseRouting()
|
||||||
.UseSession()
|
.UseSession()
|
||||||
.UseRequestLocalization(app.ApplicationServices.GetService<IOptions<RequestLocalizationOptions>>().Value)
|
.UseRequestLocalization(app.ApplicationServices.GetService<IOptions<RequestLocalizationOptions>>().Value)
|
||||||
.UseGiraffe(webApp)
|
.UseEndpoints (fun e -> e.MapGiraffeEndpoints routes)
|
||||||
|> ignore
|
|> ignore
|
||||||
Views.I18N.setUpFactories <| app.ApplicationServices.GetRequiredService<IStringLocalizerFactory> ()
|
Views.I18N.setUpFactories <| app.ApplicationServices.GetRequiredService<IStringLocalizerFactory> ()
|
||||||
|
|
||||||
|
@ -1,6 +1,5 @@
|
|||||||
module PrayerTracker.Handlers.Church
|
module PrayerTracker.Handlers.Church
|
||||||
|
|
||||||
open FSharp.Control.Tasks.V2.ContextInsensitive
|
|
||||||
open Giraffe
|
open Giraffe
|
||||||
open PrayerTracker
|
open PrayerTracker
|
||||||
open PrayerTracker.Entities
|
open PrayerTracker.Entities
|
||||||
@ -10,8 +9,7 @@ open System
|
|||||||
open System.Threading.Tasks
|
open System.Threading.Tasks
|
||||||
|
|
||||||
/// Find statistics for the given church
|
/// Find statistics for the given church
|
||||||
let private findStats (db : AppDbContext) churchId =
|
let private findStats (db : AppDbContext) churchId = task {
|
||||||
task {
|
|
||||||
let! grps = db.CountGroupsByChurch churchId
|
let! grps = db.CountGroupsByChurch churchId
|
||||||
let! reqs = db.CountRequestsByChurch churchId
|
let! reqs = db.CountRequestsByChurch churchId
|
||||||
let! usrs = db.CountUsersByChurch churchId
|
let! usrs = db.CountUsersByChurch churchId
|
||||||
@ -23,14 +21,12 @@ let private findStats (db : AppDbContext) churchId =
|
|||||||
let delete churchId : HttpHandler =
|
let delete churchId : HttpHandler =
|
||||||
requireAccess [ Admin ]
|
requireAccess [ Admin ]
|
||||||
>=> validateCSRF
|
>=> validateCSRF
|
||||||
>=> fun next ctx ->
|
>=> fun next ctx -> task {
|
||||||
let db = ctx.dbContext ()
|
match! ctx.db.TryChurchById churchId with
|
||||||
task {
|
|
||||||
match! db.TryChurchById churchId with
|
|
||||||
| Some church ->
|
| Some church ->
|
||||||
let! _, stats = findStats db churchId
|
let! _, stats = findStats ctx.db churchId
|
||||||
db.RemoveEntry church
|
ctx.db.RemoveEntry church
|
||||||
let! _ = db.SaveChangesAsync ()
|
let! _ = ctx.db.SaveChangesAsync ()
|
||||||
let s = Views.I18N.localizer.Force ()
|
let s = Views.I18N.localizer.Force ()
|
||||||
addInfo ctx
|
addInfo ctx
|
||||||
s.["The church {0} and its {1} small groups (with {2} prayer request(s)) were deleted successfully; revoked access from {3} user(s)",
|
s.["The church {0} and its {1} small groups (with {2} prayer request(s)) were deleted successfully; revoked access from {3} user(s)",
|
||||||
@ -43,9 +39,8 @@ let delete churchId : HttpHandler =
|
|||||||
/// GET /church/[church-id]/edit
|
/// GET /church/[church-id]/edit
|
||||||
let edit churchId : HttpHandler =
|
let edit churchId : HttpHandler =
|
||||||
requireAccess [ Admin ]
|
requireAccess [ Admin ]
|
||||||
>=> fun next ctx ->
|
>=> fun next ctx -> task {
|
||||||
let startTicks = DateTime.Now.Ticks
|
let startTicks = DateTime.Now.Ticks
|
||||||
task {
|
|
||||||
match churchId with
|
match churchId with
|
||||||
| x when x = Guid.Empty ->
|
| x when x = Guid.Empty ->
|
||||||
return!
|
return!
|
||||||
@ -53,8 +48,7 @@ let edit churchId : HttpHandler =
|
|||||||
|> Views.Church.edit EditChurch.empty ctx
|
|> Views.Church.edit EditChurch.empty ctx
|
||||||
|> renderHtml next ctx
|
|> renderHtml next ctx
|
||||||
| _ ->
|
| _ ->
|
||||||
let db = ctx.dbContext ()
|
match! ctx.db.TryChurchById churchId with
|
||||||
match! db.TryChurchById churchId with
|
|
||||||
| Some church ->
|
| Some church ->
|
||||||
return!
|
return!
|
||||||
viewInfo ctx startTicks
|
viewInfo ctx startTicks
|
||||||
@ -67,13 +61,11 @@ let edit churchId : HttpHandler =
|
|||||||
/// GET /churches
|
/// GET /churches
|
||||||
let maintain : HttpHandler =
|
let maintain : HttpHandler =
|
||||||
requireAccess [ Admin ]
|
requireAccess [ Admin ]
|
||||||
>=> fun next ctx ->
|
>=> fun next ctx -> task {
|
||||||
let startTicks = DateTime.Now.Ticks
|
let startTicks = DateTime.Now.Ticks
|
||||||
let await = Async.AwaitTask >> Async.RunSynchronously
|
let await = Async.AwaitTask >> Async.RunSynchronously
|
||||||
let db = ctx.dbContext ()
|
let! churches = ctx.db.AllChurches ()
|
||||||
task {
|
let stats = churches |> List.map (fun c -> await (findStats ctx.db c.churchId))
|
||||||
let! churches = db.AllChurches ()
|
|
||||||
let stats = churches |> List.map (fun c -> await (findStats db c.churchId))
|
|
||||||
return!
|
return!
|
||||||
viewInfo ctx startTicks
|
viewInfo ctx startTicks
|
||||||
|> Views.Church.maintain churches (stats |> Map.ofList) ctx
|
|> Views.Church.maintain churches (stats |> Map.ofList) ctx
|
||||||
@ -85,20 +77,18 @@ let maintain : HttpHandler =
|
|||||||
let save : HttpHandler =
|
let save : HttpHandler =
|
||||||
requireAccess [ Admin ]
|
requireAccess [ Admin ]
|
||||||
>=> validateCSRF
|
>=> validateCSRF
|
||||||
>=> fun next ctx ->
|
>=> fun next ctx -> task {
|
||||||
task {
|
|
||||||
match! ctx.TryBindFormAsync<EditChurch> () with
|
match! ctx.TryBindFormAsync<EditChurch> () with
|
||||||
| Ok m ->
|
| Ok m ->
|
||||||
let db = ctx.dbContext ()
|
|
||||||
let! church =
|
let! church =
|
||||||
match m.isNew () with
|
match m.isNew () with
|
||||||
| true -> Task.FromResult<Church option>(Some { Church.empty with churchId = Guid.NewGuid () })
|
| true -> Task.FromResult<Church option>(Some { Church.empty with churchId = Guid.NewGuid () })
|
||||||
| false -> db.TryChurchById m.churchId
|
| false -> ctx.db.TryChurchById m.churchId
|
||||||
match church with
|
match church with
|
||||||
| Some ch ->
|
| Some ch ->
|
||||||
m.populateChurch ch
|
m.populateChurch ch
|
||||||
|> (match m.isNew () with true -> db.AddEntry | false -> db.UpdateEntry)
|
|> (match m.isNew () with true -> ctx.db.AddEntry | false -> ctx.db.UpdateEntry)
|
||||||
let! _ = db.SaveChangesAsync ()
|
let! _ = ctx.db.SaveChangesAsync ()
|
||||||
let s = Views.I18N.localizer.Force ()
|
let s = Views.I18N.localizer.Force ()
|
||||||
let act = s.[match m.isNew () with true -> "Added" | _ -> "Updated"].Value.ToLower ()
|
let act = s.[match m.isNew () with true -> "Added" | _ -> "Updated"].Value.ToLower ()
|
||||||
addInfo ctx s.["Successfully {0} church “{1}”", act, m.name]
|
addInfo ctx s.["Successfully {0} church “{1}”", act, m.name]
|
||||||
|
@ -2,7 +2,6 @@
|
|||||||
[<AutoOpen>]
|
[<AutoOpen>]
|
||||||
module PrayerTracker.Handlers.CommonFunctions
|
module PrayerTracker.Handlers.CommonFunctions
|
||||||
|
|
||||||
open FSharp.Control.Tasks.V2.ContextInsensitive
|
|
||||||
open Giraffe
|
open Giraffe
|
||||||
open Microsoft.AspNetCore.Antiforgery
|
open Microsoft.AspNetCore.Antiforgery
|
||||||
open Microsoft.AspNetCore.Html
|
open Microsoft.AspNetCore.Html
|
||||||
@ -54,31 +53,23 @@ let appVersion =
|
|||||||
|> String.concat ""
|
|> String.concat ""
|
||||||
#endif
|
#endif
|
||||||
|
|
||||||
/// An option of the currently signed-in user
|
|
||||||
let tryCurrentUser (ctx : HttpContext) =
|
|
||||||
ctx.Session.GetUser ()
|
|
||||||
|
|
||||||
/// The currently signed-in user (will raise if none exists)
|
/// The currently signed-in user (will raise if none exists)
|
||||||
let currentUser ctx =
|
let currentUser (ctx : HttpContext) =
|
||||||
match tryCurrentUser ctx with Some u -> u | None -> nullArg "User"
|
match ctx.Session.user with Some u -> u | None -> nullArg "User"
|
||||||
|
|
||||||
/// An option of the currently signed-in small group
|
|
||||||
let tryCurrentGroup (ctx : HttpContext) =
|
|
||||||
ctx.Session.GetSmallGroup ()
|
|
||||||
|
|
||||||
/// The currently signed-in small group (will raise if none exists)
|
/// The currently signed-in small group (will raise if none exists)
|
||||||
let currentGroup ctx =
|
let currentGroup (ctx : HttpContext) =
|
||||||
match tryCurrentGroup ctx with Some g -> g | None -> nullArg "SmallGroup"
|
match ctx.Session.smallGroup with Some g -> g | None -> nullArg "SmallGroup"
|
||||||
|
|
||||||
/// Create the common view information heading
|
/// Create the common view information heading
|
||||||
let viewInfo (ctx : HttpContext) startTicks =
|
let viewInfo (ctx : HttpContext) startTicks =
|
||||||
let msg =
|
let msg =
|
||||||
match ctx.Session.GetMessages () with
|
match ctx.Session.messages with
|
||||||
| [] -> []
|
| [] -> []
|
||||||
| x ->
|
| x ->
|
||||||
ctx.Session.SetMessages []
|
ctx.Session.messages <- []
|
||||||
x
|
x
|
||||||
match tryCurrentUser ctx with
|
match ctx.Session.user with
|
||||||
| Some u ->
|
| Some u ->
|
||||||
// The idle timeout is 2 hours; if the app pool is recycled or the actual session goes away, we will log the
|
// The idle timeout is 2 hours; if the app pool is recycled or the actual session goes away, we will log the
|
||||||
// user back in transparently using this cookie. Every request resets the timer.
|
// user back in transparently using this cookie. Every request resets the timer.
|
||||||
@ -96,8 +87,8 @@ let viewInfo (ctx : HttpContext) startTicks =
|
|||||||
version = appVersion
|
version = appVersion
|
||||||
messages = msg
|
messages = msg
|
||||||
requestStart = startTicks
|
requestStart = startTicks
|
||||||
user = ctx.Session.GetUser ()
|
user = ctx.Session.user
|
||||||
group = ctx.Session.GetSmallGroup ()
|
group = ctx.Session.smallGroup
|
||||||
}
|
}
|
||||||
|
|
||||||
/// The view is the last parameter, so it can be composed
|
/// The view is the last parameter, so it can be composed
|
||||||
@ -118,11 +109,8 @@ let fourOhFour next (ctx : HttpContext) =
|
|||||||
|
|
||||||
/// Handler to validate CSRF prevention token
|
/// Handler to validate CSRF prevention token
|
||||||
let validateCSRF : HttpHandler =
|
let validateCSRF : HttpHandler =
|
||||||
fun next ctx ->
|
fun next ctx -> task {
|
||||||
let antiForgery = ctx.GetService<IAntiforgery> ()
|
match! (ctx.GetService<IAntiforgery> ()).IsRequestValidAsync ctx with
|
||||||
task {
|
|
||||||
let! isValid = antiForgery.IsRequestValidAsync ctx
|
|
||||||
match isValid with
|
|
||||||
| true -> return! next ctx
|
| true -> return! next ctx
|
||||||
| false ->
|
| false ->
|
||||||
return! (clearResponse >=> setStatusCode 400 >=> text "Quit hacking...") (fun _ -> Task.FromResult None) ctx
|
return! (clearResponse >=> setStatusCode 400 >=> text "Quit hacking...") (fun _ -> Task.FromResult None) ctx
|
||||||
@ -131,7 +119,7 @@ let validateCSRF : HttpHandler =
|
|||||||
|
|
||||||
/// Add a message to the session
|
/// Add a message to the session
|
||||||
let addUserMessage (ctx : HttpContext) msg =
|
let addUserMessage (ctx : HttpContext) msg =
|
||||||
msg :: ctx.Session.GetMessages () |> ctx.Session.SetMessages
|
ctx.Session.messages <- msg :: ctx.Session.messages
|
||||||
|
|
||||||
/// Convert a localized string to an HTML string
|
/// Convert a localized string to an HTML string
|
||||||
let htmlLocString (x : LocalizedString) =
|
let htmlLocString (x : LocalizedString) =
|
||||||
@ -174,22 +162,20 @@ let requireAccess level : HttpHandler =
|
|||||||
|
|
||||||
/// Is there currently a user logged on?
|
/// Is there currently a user logged on?
|
||||||
let isUserLoggedOn (ctx : HttpContext) =
|
let isUserLoggedOn (ctx : HttpContext) =
|
||||||
ctx.Session.GetUser () |> Option.isSome
|
ctx.Session.user |> Option.isSome
|
||||||
|
|
||||||
/// Log a user on from the timeout cookie
|
/// Log a user on from the timeout cookie
|
||||||
let logOnUserFromTimeoutCookie (ctx : HttpContext) =
|
let logOnUserFromTimeoutCookie (ctx : HttpContext) = task {
|
||||||
task {
|
|
||||||
// Make sure the cookie hasn't been tampered with
|
// Make sure the cookie hasn't been tampered with
|
||||||
try
|
try
|
||||||
match TimeoutCookie.fromPayload ctx.Request.Cookies.[Key.Cookie.timeout] with
|
match TimeoutCookie.fromPayload ctx.Request.Cookies.[Key.Cookie.timeout] with
|
||||||
| Some c when c.Password = saltedTimeoutHash c ->
|
| Some c when c.Password = saltedTimeoutHash c ->
|
||||||
let db = ctx.dbContext ()
|
let! user = ctx.db.TryUserById c.Id
|
||||||
let! user = db.TryUserById c.Id
|
|
||||||
match user with
|
match user with
|
||||||
| Some _ ->
|
| Some _ ->
|
||||||
ctx.Session.SetUser user
|
ctx.Session.user <- user
|
||||||
let! grp = db.TryGroupById c.GroupId
|
let! grp = ctx.db.TryGroupById c.GroupId
|
||||||
ctx.Session.SetSmallGroup grp
|
ctx.Session.smallGroup <- grp
|
||||||
| _ -> ()
|
| _ -> ()
|
||||||
| _ -> ()
|
| _ -> ()
|
||||||
// If something above doesn't work, the user doesn't get logged in
|
// If something above doesn't work, the user doesn't get logged in
|
||||||
@ -197,17 +183,15 @@ let requireAccess level : HttpHandler =
|
|||||||
}
|
}
|
||||||
|
|
||||||
/// Attempt to log the user on from their stored cookie
|
/// Attempt to log the user on from their stored cookie
|
||||||
let logOnUserFromCookie (ctx : HttpContext) =
|
let logOnUserFromCookie (ctx : HttpContext) = task {
|
||||||
task {
|
|
||||||
match UserCookie.fromPayload ctx.Request.Cookies.[Key.Cookie.user] with
|
match UserCookie.fromPayload ctx.Request.Cookies.[Key.Cookie.user] with
|
||||||
| Some c ->
|
| Some c ->
|
||||||
let db = ctx.dbContext ()
|
let! user = ctx.db.TryUserLogOnByCookie c.Id c.GroupId c.PasswordHash
|
||||||
let! user = db.TryUserLogOnByCookie c.Id c.GroupId c.PasswordHash
|
|
||||||
match user with
|
match user with
|
||||||
| Some _ ->
|
| Some _ ->
|
||||||
ctx.Session.SetUser user
|
ctx.Session.user <- user
|
||||||
let! grp = db.TryGroupById c.GroupId
|
let! grp = ctx.db.TryGroupById c.GroupId
|
||||||
ctx.Session.SetSmallGroup grp
|
ctx.Session.smallGroup <- grp
|
||||||
// Rewrite the cookie to extend the expiration
|
// Rewrite the cookie to extend the expiration
|
||||||
ctx.Response.Cookies.Append (Key.Cookie.user, c.toPayload (), autoRefresh)
|
ctx.Response.Cookies.Append (Key.Cookie.user, c.toPayload (), autoRefresh)
|
||||||
| _ -> ()
|
| _ -> ()
|
||||||
@ -216,25 +200,24 @@ let requireAccess level : HttpHandler =
|
|||||||
|
|
||||||
/// Is there currently a small group (or member thereof) logged on?
|
/// Is there currently a small group (or member thereof) logged on?
|
||||||
let isGroupLoggedOn (ctx : HttpContext) =
|
let isGroupLoggedOn (ctx : HttpContext) =
|
||||||
ctx.Session.GetSmallGroup () |> Option.isSome
|
ctx.Session.smallGroup |> Option.isSome
|
||||||
|
|
||||||
/// Attempt to log the small group on from their stored cookie
|
/// Attempt to log the small group on from their stored cookie
|
||||||
let logOnGroupFromCookie (ctx : HttpContext) =
|
let logOnGroupFromCookie (ctx : HttpContext) =
|
||||||
task {
|
task {
|
||||||
match GroupCookie.fromPayload ctx.Request.Cookies.[Key.Cookie.group] with
|
match GroupCookie.fromPayload ctx.Request.Cookies.[Key.Cookie.group] with
|
||||||
| Some c ->
|
| Some c ->
|
||||||
let! grp = (ctx.dbContext ()).TryGroupLogOnByCookie c.GroupId c.PasswordHash sha1Hash
|
let! grp = ctx.db.TryGroupLogOnByCookie c.GroupId c.PasswordHash sha1Hash
|
||||||
match grp with
|
match grp with
|
||||||
| Some _ ->
|
| Some _ ->
|
||||||
ctx.Session.SetSmallGroup grp
|
ctx.Session.smallGroup <- grp
|
||||||
// Rewrite the cookie to extend the expiration
|
// Rewrite the cookie to extend the expiration
|
||||||
ctx.Response.Cookies.Append (Key.Cookie.group, c.toPayload (), autoRefresh)
|
ctx.Response.Cookies.Append (Key.Cookie.group, c.toPayload (), autoRefresh)
|
||||||
| None -> ()
|
| None -> ()
|
||||||
| None -> ()
|
| None -> ()
|
||||||
}
|
}
|
||||||
|
|
||||||
fun next ctx ->
|
fun next ctx -> FSharp.Control.Tasks.Affine.task {
|
||||||
task {
|
|
||||||
// Auto-logon user or class, if required
|
// Auto-logon user or class, if required
|
||||||
match isUserLoggedOn ctx with
|
match isUserLoggedOn ctx with
|
||||||
| true -> ()
|
| true -> ()
|
||||||
|
@ -6,6 +6,7 @@ open System
|
|||||||
open System.Security.Cryptography
|
open System.Security.Cryptography
|
||||||
open System.IO
|
open System.IO
|
||||||
|
|
||||||
|
// fsharplint:disable MemberNames
|
||||||
|
|
||||||
/// Cryptography settings to use for encrypting cookies
|
/// Cryptography settings to use for encrypting cookies
|
||||||
type CookieCrypto (key : string, iv : string) =
|
type CookieCrypto (key : string, iv : string) =
|
||||||
@ -24,7 +25,7 @@ module private Crypto =
|
|||||||
|
|
||||||
/// Encrypt a cookie payload
|
/// Encrypt a cookie payload
|
||||||
let encrypt (payload : string) =
|
let encrypt (payload : string) =
|
||||||
use aes = new AesManaged ()
|
use aes = Aes.Create ()
|
||||||
use enc = aes.CreateEncryptor (crypto.Key, crypto.IV)
|
use enc = aes.CreateEncryptor (crypto.Key, crypto.IV)
|
||||||
use ms = new MemoryStream ()
|
use ms = new MemoryStream ()
|
||||||
use cs = new CryptoStream (ms, enc, CryptoStreamMode.Write)
|
use cs = new CryptoStream (ms, enc, CryptoStreamMode.Write)
|
||||||
@ -35,7 +36,7 @@ module private Crypto =
|
|||||||
|
|
||||||
/// Decrypt a cookie payload
|
/// Decrypt a cookie payload
|
||||||
let decrypt payload =
|
let decrypt payload =
|
||||||
use aes = new AesManaged ()
|
use aes = Aes.Create ()
|
||||||
use dec = aes.CreateDecryptor (crypto.Key, crypto.IV)
|
use dec = aes.CreateDecryptor (crypto.Key, crypto.IV)
|
||||||
use ms = new MemoryStream (Convert.FromBase64String payload)
|
use ms = new MemoryStream (Convert.FromBase64String payload)
|
||||||
use cs = new CryptoStream (ms, dec, CryptoStreamMode.Read)
|
use cs = new CryptoStream (ms, dec, CryptoStreamMode.Read)
|
||||||
|
@ -1,7 +1,6 @@
|
|||||||
/// Methods for sending e-mails
|
/// Methods for sending e-mails
|
||||||
module PrayerTracker.Email
|
module PrayerTracker.Email
|
||||||
|
|
||||||
open FSharp.Control.Tasks.ContextInsensitive
|
|
||||||
open MailKit.Net.Smtp
|
open MailKit.Net.Smtp
|
||||||
open MailKit.Security
|
open MailKit.Security
|
||||||
open Microsoft.Extensions.Localization
|
open Microsoft.Extensions.Localization
|
||||||
@ -14,8 +13,7 @@ let private fromAddress = "prayer@bitbadger.solutions"
|
|||||||
|
|
||||||
/// Get an SMTP client connection
|
/// Get an SMTP client connection
|
||||||
// FIXME: make host configurable
|
// FIXME: make host configurable
|
||||||
let getConnection () =
|
let getConnection () = task {
|
||||||
task {
|
|
||||||
let client = new SmtpClient ()
|
let client = new SmtpClient ()
|
||||||
do! client.ConnectAsync ("127.0.0.1", 25, SecureSocketOptions.None)
|
do! client.ConnectAsync ("127.0.0.1", 25, SecureSocketOptions.None)
|
||||||
return client
|
return client
|
||||||
@ -60,8 +58,7 @@ let createTextMessage grp subj body (s : IStringLocalizer) =
|
|||||||
msg
|
msg
|
||||||
|
|
||||||
/// Send e-mails to a class
|
/// Send e-mails to a class
|
||||||
let sendEmails (client : SmtpClient) (recipients : Member list) grp subj html text s =
|
let sendEmails (client : SmtpClient) (recipients : Member list) grp subj html text s = task {
|
||||||
task {
|
|
||||||
let htmlMsg = createHtmlMessage grp subj html s
|
let htmlMsg = createHtmlMessage grp subj html s
|
||||||
let plainTextMsg = createTextMessage grp subj text s
|
let plainTextMsg = createTextMessage grp subj text s
|
||||||
|
|
||||||
|
@ -2,11 +2,13 @@
|
|||||||
module PrayerTracker.Extensions
|
module PrayerTracker.Extensions
|
||||||
|
|
||||||
open Microsoft.AspNetCore.Http
|
open Microsoft.AspNetCore.Http
|
||||||
|
open Microsoft.Extensions.DependencyInjection
|
||||||
open Microsoft.FSharpLu
|
open Microsoft.FSharpLu
|
||||||
open Newtonsoft.Json
|
open Newtonsoft.Json
|
||||||
open PrayerTracker.Entities
|
open PrayerTracker.Entities
|
||||||
open PrayerTracker.ViewModels
|
open PrayerTracker.ViewModels
|
||||||
|
|
||||||
|
// fsharplint:disable MemberNames
|
||||||
|
|
||||||
type ISession with
|
type ISession with
|
||||||
/// Set an object in the session
|
/// Set an object in the session
|
||||||
@ -19,28 +21,32 @@ type ISession with
|
|||||||
| null -> Unchecked.defaultof<'T>
|
| null -> Unchecked.defaultof<'T>
|
||||||
| v -> JsonConvert.DeserializeObject<'T> v
|
| v -> JsonConvert.DeserializeObject<'T> v
|
||||||
|
|
||||||
member this.GetSmallGroup () =
|
/// The current small group for the session
|
||||||
this.GetObject<SmallGroup> Key.Session.currentGroup |> Option.fromObject
|
member this.smallGroup
|
||||||
member this.SetSmallGroup (group : SmallGroup option) =
|
with get () = this.GetObject<SmallGroup> Key.Session.currentGroup |> Option.fromObject
|
||||||
match group with
|
and set (v : SmallGroup option) =
|
||||||
| Some g -> this.SetObject Key.Session.currentGroup g
|
match v with
|
||||||
|
| Some group -> this.SetObject Key.Session.currentGroup group
|
||||||
| None -> this.Remove Key.Session.currentGroup
|
| None -> this.Remove Key.Session.currentGroup
|
||||||
|
|
||||||
member this.GetUser () =
|
/// The current user for the session
|
||||||
this.GetObject<User> Key.Session.currentUser |> Option.fromObject
|
member this.user
|
||||||
member this.SetUser (user: User option) =
|
with get () = this.GetObject<User> Key.Session.currentUser |> Option.fromObject
|
||||||
match user with
|
and set (v : User option) =
|
||||||
| Some u -> this.SetObject Key.Session.currentUser u
|
match v with
|
||||||
|
| Some user -> this.SetObject Key.Session.currentUser user
|
||||||
| None -> this.Remove Key.Session.currentUser
|
| None -> this.Remove Key.Session.currentUser
|
||||||
|
|
||||||
member this.GetMessages () =
|
/// Current messages for the session
|
||||||
|
member this.messages
|
||||||
|
with get () =
|
||||||
match box (this.GetObject<UserMessage list> Key.Session.userMessages) with
|
match box (this.GetObject<UserMessage list> Key.Session.userMessages) with
|
||||||
| null -> List.empty<UserMessage>
|
| null -> List.empty<UserMessage>
|
||||||
| msgs -> unbox msgs
|
| msgs -> unbox msgs
|
||||||
member this.SetMessages (messages : UserMessage list) =
|
and set (v : UserMessage list) = this.SetObject Key.Session.userMessages v
|
||||||
this.SetObject Key.Session.userMessages messages
|
|
||||||
|
|
||||||
|
|
||||||
type HttpContext with
|
type HttpContext with
|
||||||
/// Get the EF database context from DI
|
/// The EF Core database context (via DI)
|
||||||
member this.dbContext () : AppDbContext = downcast this.RequestServices.GetService typeof<AppDbContext>
|
member this.db
|
||||||
|
with get () = this.RequestServices.GetRequiredService<AppDbContext> ()
|
||||||
|
@ -1,6 +1,5 @@
|
|||||||
module PrayerTracker.Handlers.PrayerRequest
|
module PrayerTracker.Handlers.PrayerRequest
|
||||||
|
|
||||||
open FSharp.Control.Tasks.V2.ContextInsensitive
|
|
||||||
open Giraffe
|
open Giraffe
|
||||||
open Microsoft.AspNetCore.Http
|
open Microsoft.AspNetCore.Http
|
||||||
open NodaTime
|
open NodaTime
|
||||||
@ -11,9 +10,8 @@ open System
|
|||||||
open System.Threading.Tasks
|
open System.Threading.Tasks
|
||||||
|
|
||||||
/// Retrieve a prayer request, and ensure that it belongs to the current class
|
/// Retrieve a prayer request, and ensure that it belongs to the current class
|
||||||
let private findRequest (ctx : HttpContext) reqId =
|
let private findRequest (ctx : HttpContext) reqId = task {
|
||||||
task {
|
match! ctx.db.TryRequestById reqId with
|
||||||
match! ctx.dbContext().TryRequestById reqId with
|
|
||||||
| Some req when req.smallGroupId = (currentGroup ctx).smallGroupId -> return Ok req
|
| Some req when req.smallGroupId = (currentGroup ctx).smallGroupId -> return Ok req
|
||||||
| Some _ ->
|
| Some _ ->
|
||||||
let s = Views.I18N.localizer.Force ()
|
let s = Views.I18N.localizer.Force ()
|
||||||
@ -30,12 +28,12 @@ let private generateRequestList ctx date =
|
|||||||
match date with
|
match date with
|
||||||
| Some d -> d
|
| Some d -> d
|
||||||
| None -> grp.localDateNow clock
|
| None -> grp.localDateNow clock
|
||||||
let reqs = ctx.dbContext().AllRequestsForSmallGroup grp clock (Some listDate) true 0
|
let reqs = ctx.db.AllRequestsForSmallGroup grp clock (Some listDate) true 0
|
||||||
{ requests = reqs |> List.ofSeq
|
{ requests = reqs |> List.ofSeq
|
||||||
date = listDate
|
date = listDate
|
||||||
listGroup = grp
|
listGroup = grp
|
||||||
showHeader = true
|
showHeader = true
|
||||||
canEmail = tryCurrentUser ctx |> Option.isSome
|
canEmail = ctx.Session.user |> Option.isSome
|
||||||
recipients = []
|
recipients = []
|
||||||
}
|
}
|
||||||
|
|
||||||
@ -49,11 +47,10 @@ let private parseListDate (date : string option) =
|
|||||||
/// GET /prayer-request/[request-id]/edit
|
/// GET /prayer-request/[request-id]/edit
|
||||||
let edit (reqId : PrayerRequestId) : HttpHandler =
|
let edit (reqId : PrayerRequestId) : HttpHandler =
|
||||||
requireAccess [ User ]
|
requireAccess [ User ]
|
||||||
>=> fun next ctx ->
|
>=> fun next ctx -> task {
|
||||||
let startTicks = DateTime.Now.Ticks
|
let startTicks = DateTime.Now.Ticks
|
||||||
let grp = currentGroup ctx
|
let grp = currentGroup ctx
|
||||||
let now = grp.localDateNow (ctx.GetService<IClock> ())
|
let now = grp.localDateNow (ctx.GetService<IClock> ())
|
||||||
task {
|
|
||||||
match reqId = Guid.Empty with
|
match reqId = Guid.Empty with
|
||||||
| true ->
|
| true ->
|
||||||
return!
|
return!
|
||||||
@ -86,14 +83,13 @@ let edit (reqId : PrayerRequestId) : HttpHandler =
|
|||||||
/// GET /prayer-requests/email/[date]
|
/// GET /prayer-requests/email/[date]
|
||||||
let email date : HttpHandler =
|
let email date : HttpHandler =
|
||||||
requireAccess [ User ]
|
requireAccess [ User ]
|
||||||
>=> fun next ctx ->
|
>=> fun next ctx -> task {
|
||||||
let startTicks = DateTime.Now.Ticks
|
let startTicks = DateTime.Now.Ticks
|
||||||
let s = Views.I18N.localizer.Force ()
|
let s = Views.I18N.localizer.Force ()
|
||||||
let listDate = parseListDate (Some date)
|
let listDate = parseListDate (Some date)
|
||||||
let grp = currentGroup ctx
|
let grp = currentGroup ctx
|
||||||
task {
|
|
||||||
let list = generateRequestList ctx listDate
|
let list = generateRequestList ctx listDate
|
||||||
let! recipients = ctx.dbContext().AllMembersForSmallGroup grp.smallGroupId
|
let! recipients = ctx.db.AllMembersForSmallGroup grp.smallGroupId
|
||||||
use! client = Email.getConnection ()
|
use! client = Email.getConnection ()
|
||||||
do! Email.sendEmails client recipients
|
do! Email.sendEmails client recipients
|
||||||
grp s.["Prayer Requests for {0} - {1:MMMM d, yyyy}", grp.name, list.date].Value
|
grp s.["Prayer Requests for {0} - {1:MMMM d, yyyy}", grp.name, list.date].Value
|
||||||
@ -109,14 +105,12 @@ let email date : HttpHandler =
|
|||||||
let delete reqId : HttpHandler =
|
let delete reqId : HttpHandler =
|
||||||
requireAccess [ User ]
|
requireAccess [ User ]
|
||||||
>=> validateCSRF
|
>=> validateCSRF
|
||||||
>=> fun next ctx ->
|
>=> fun next ctx -> task {
|
||||||
task {
|
|
||||||
match! findRequest ctx reqId with
|
match! findRequest ctx reqId with
|
||||||
| Ok req ->
|
| Ok req ->
|
||||||
let db = ctx.dbContext ()
|
|
||||||
let s = Views.I18N.localizer.Force ()
|
let s = Views.I18N.localizer.Force ()
|
||||||
db.PrayerRequests.Remove req |> ignore
|
ctx.db.PrayerRequests.Remove req |> ignore
|
||||||
let! _ = db.SaveChangesAsync ()
|
let! _ = ctx.db.SaveChangesAsync ()
|
||||||
addInfo ctx s.["The prayer request was deleted successfully"]
|
addInfo ctx s.["The prayer request was deleted successfully"]
|
||||||
return! redirectTo false "/web/prayer-requests" next ctx
|
return! redirectTo false "/web/prayer-requests" next ctx
|
||||||
| Error e -> return! e next ctx
|
| Error e -> return! e next ctx
|
||||||
@ -126,14 +120,12 @@ let delete reqId : HttpHandler =
|
|||||||
/// GET /prayer-request/[request-id]/expire
|
/// GET /prayer-request/[request-id]/expire
|
||||||
let expire reqId : HttpHandler =
|
let expire reqId : HttpHandler =
|
||||||
requireAccess [ User ]
|
requireAccess [ User ]
|
||||||
>=> fun next ctx ->
|
>=> fun next ctx -> task {
|
||||||
task {
|
|
||||||
match! findRequest ctx reqId with
|
match! findRequest ctx reqId with
|
||||||
| Ok req ->
|
| Ok req ->
|
||||||
let db = ctx.dbContext ()
|
|
||||||
let s = Views.I18N.localizer.Force ()
|
let s = Views.I18N.localizer.Force ()
|
||||||
db.UpdateEntry { req with expiration = Forced }
|
ctx.db.UpdateEntry { req with expiration = Forced }
|
||||||
let! _ = db.SaveChangesAsync ()
|
let! _ = ctx.db.SaveChangesAsync ()
|
||||||
addInfo ctx s.["Successfully {0} prayer request", s.["Expired"].Value.ToLower ()]
|
addInfo ctx s.["Successfully {0} prayer request", s.["Expired"].Value.ToLower ()]
|
||||||
return! redirectTo false "/web/prayer-requests" next ctx
|
return! redirectTo false "/web/prayer-requests" next ctx
|
||||||
| Error e -> return! e next ctx
|
| Error e -> return! e next ctx
|
||||||
@ -143,14 +135,12 @@ let expire reqId : HttpHandler =
|
|||||||
/// GET /prayer-requests/[group-id]/list
|
/// GET /prayer-requests/[group-id]/list
|
||||||
let list groupId : HttpHandler =
|
let list groupId : HttpHandler =
|
||||||
requireAccess [ AccessLevel.Public ]
|
requireAccess [ AccessLevel.Public ]
|
||||||
>=> fun next ctx ->
|
>=> fun next ctx -> task {
|
||||||
let startTicks = DateTime.Now.Ticks
|
let startTicks = DateTime.Now.Ticks
|
||||||
let db = ctx.dbContext ()
|
match! ctx.db.TryGroupById groupId with
|
||||||
task {
|
|
||||||
match! db.TryGroupById groupId with
|
|
||||||
| Some grp when grp.preferences.isPublic ->
|
| Some grp when grp.preferences.isPublic ->
|
||||||
let clock = ctx.GetService<IClock> ()
|
let clock = ctx.GetService<IClock> ()
|
||||||
let reqs = db.AllRequestsForSmallGroup grp clock None true 0
|
let reqs = ctx.db.AllRequestsForSmallGroup grp clock None true 0
|
||||||
return!
|
return!
|
||||||
viewInfo ctx startTicks
|
viewInfo ctx startTicks
|
||||||
|> Views.PrayerRequest.list
|
|> Views.PrayerRequest.list
|
||||||
@ -158,7 +148,7 @@ let list groupId : HttpHandler =
|
|||||||
date = grp.localDateNow clock
|
date = grp.localDateNow clock
|
||||||
listGroup = grp
|
listGroup = grp
|
||||||
showHeader = true
|
showHeader = true
|
||||||
canEmail = (tryCurrentUser >> Option.isSome) ctx
|
canEmail = ctx.Session.user |> Option.isSome
|
||||||
recipients = []
|
recipients = []
|
||||||
}
|
}
|
||||||
|> renderHtml next ctx
|
|> renderHtml next ctx
|
||||||
@ -173,10 +163,9 @@ let list groupId : HttpHandler =
|
|||||||
/// GET /prayer-requests/lists
|
/// GET /prayer-requests/lists
|
||||||
let lists : HttpHandler =
|
let lists : HttpHandler =
|
||||||
requireAccess [ AccessLevel.Public ]
|
requireAccess [ AccessLevel.Public ]
|
||||||
>=> fun next ctx ->
|
>=> fun next ctx -> task {
|
||||||
let startTicks = DateTime.Now.Ticks
|
let startTicks = DateTime.Now.Ticks
|
||||||
task {
|
let! grps = ctx.db.PublicAndProtectedGroups ()
|
||||||
let! grps = ctx.dbContext().PublicAndProtectedGroups ()
|
|
||||||
return!
|
return!
|
||||||
viewInfo ctx startTicks
|
viewInfo ctx startTicks
|
||||||
|> Views.PrayerRequest.lists grps
|
|> Views.PrayerRequest.lists grps
|
||||||
@ -191,9 +180,7 @@ let maintain onlyActive : HttpHandler =
|
|||||||
requireAccess [ User ]
|
requireAccess [ User ]
|
||||||
>=> fun next ctx ->
|
>=> fun next ctx ->
|
||||||
let startTicks = DateTime.Now.Ticks
|
let startTicks = DateTime.Now.Ticks
|
||||||
let db = ctx.dbContext ()
|
|
||||||
let grp = currentGroup ctx
|
let grp = currentGroup ctx
|
||||||
task {
|
|
||||||
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
|
||||||
@ -202,47 +189,40 @@ let maintain onlyActive : HttpHandler =
|
|||||||
match ctx.GetQueryStringValue "search" with
|
match ctx.GetQueryStringValue "search" with
|
||||||
| Ok srch ->
|
| Ok srch ->
|
||||||
{ MaintainRequests.empty with
|
{ MaintainRequests.empty with
|
||||||
requests = db.SearchRequestsForSmallGroup grp srch pageNbr
|
requests = ctx.db.SearchRequestsForSmallGroup grp srch pageNbr
|
||||||
searchTerm = Some srch
|
searchTerm = Some srch
|
||||||
pageNbr = Some pageNbr
|
pageNbr = Some pageNbr
|
||||||
}
|
}
|
||||||
| Error _ ->
|
| Error _ ->
|
||||||
{ MaintainRequests.empty with
|
{ MaintainRequests.empty with
|
||||||
requests = db.AllRequestsForSmallGroup grp (ctx.GetService<IClock> ()) None onlyActive pageNbr
|
requests = ctx.db.AllRequestsForSmallGroup grp (ctx.GetService<IClock> ()) None onlyActive pageNbr
|
||||||
onlyActive = Some onlyActive
|
onlyActive = Some onlyActive
|
||||||
pageNbr = match onlyActive with true -> None | false -> Some pageNbr
|
pageNbr = match onlyActive with true -> None | false -> Some pageNbr
|
||||||
}
|
}
|
||||||
return!
|
|
||||||
{ viewInfo ctx startTicks with helpLink = Some Help.maintainRequests }
|
{ viewInfo ctx startTicks with helpLink = Some Help.maintainRequests }
|
||||||
|> Views.PrayerRequest.maintain { m with smallGroup = grp } ctx
|
|> Views.PrayerRequest.maintain { m with smallGroup = grp } ctx
|
||||||
|> renderHtml next ctx
|
|> renderHtml next ctx
|
||||||
}
|
|
||||||
|
|
||||||
|
|
||||||
/// GET /prayer-request/print/[date]
|
/// GET /prayer-request/print/[date]
|
||||||
let print date : HttpHandler =
|
let print date : HttpHandler =
|
||||||
requireAccess [ User; Group ]
|
requireAccess [ User; Group ]
|
||||||
>=> fun next ctx ->
|
>=> fun next ctx ->
|
||||||
let listDate = parseListDate (Some date)
|
let list = parseListDate (Some date) |> generateRequestList ctx
|
||||||
task {
|
|
||||||
let list = generateRequestList ctx listDate
|
|
||||||
return!
|
|
||||||
Views.PrayerRequest.print list appVersion
|
Views.PrayerRequest.print list appVersion
|
||||||
|> renderHtml next ctx
|
|> renderHtml next ctx
|
||||||
}
|
|
||||||
|
|
||||||
|
|
||||||
/// GET /prayer-request/[request-id]/restore
|
/// GET /prayer-request/[request-id]/restore
|
||||||
let restore reqId : HttpHandler =
|
let restore reqId : HttpHandler =
|
||||||
requireAccess [ User ]
|
requireAccess [ User ]
|
||||||
>=> fun next ctx ->
|
>=> fun next ctx -> task {
|
||||||
task {
|
|
||||||
match! findRequest ctx reqId with
|
match! findRequest ctx reqId with
|
||||||
| Ok req ->
|
| Ok req ->
|
||||||
let db = ctx.dbContext ()
|
|
||||||
let s = Views.I18N.localizer.Force ()
|
let s = Views.I18N.localizer.Force ()
|
||||||
db.UpdateEntry { req with expiration = Automatic; updatedDate = DateTime.Now }
|
ctx.db.UpdateEntry { req with expiration = Automatic; updatedDate = DateTime.Now }
|
||||||
let! _ = db.SaveChangesAsync ()
|
let! _ = ctx.db.SaveChangesAsync ()
|
||||||
addInfo ctx s.["Successfully {0} prayer request", s.["Restored"].Value.ToLower ()]
|
addInfo ctx s.["Successfully {0} prayer request", s.["Restored"].Value.ToLower ()]
|
||||||
return! redirectTo false "/web/prayer-requests" next ctx
|
return! redirectTo false "/web/prayer-requests" next ctx
|
||||||
| Error e -> return! e next ctx
|
| Error e -> return! e next ctx
|
||||||
@ -253,15 +233,13 @@ let restore reqId : HttpHandler =
|
|||||||
let save : HttpHandler =
|
let save : HttpHandler =
|
||||||
requireAccess [ User ]
|
requireAccess [ User ]
|
||||||
>=> validateCSRF
|
>=> validateCSRF
|
||||||
>=> fun next ctx ->
|
>=> fun next ctx -> task {
|
||||||
task {
|
|
||||||
match! ctx.TryBindFormAsync<EditRequest> () with
|
match! ctx.TryBindFormAsync<EditRequest> () with
|
||||||
| Ok m ->
|
| Ok m ->
|
||||||
let db = ctx.dbContext ()
|
|
||||||
let! req =
|
let! req =
|
||||||
match m.isNew () with
|
match m.isNew () with
|
||||||
| true -> Task.FromResult (Some { PrayerRequest.empty with prayerRequestId = Guid.NewGuid () })
|
| true -> Task.FromResult (Some { PrayerRequest.empty with prayerRequestId = Guid.NewGuid () })
|
||||||
| false -> db.TryRequestById m.requestId
|
| false -> ctx.db.TryRequestById m.requestId
|
||||||
match req with
|
match req with
|
||||||
| Some pr ->
|
| Some pr ->
|
||||||
let upd8 =
|
let upd8 =
|
||||||
@ -284,8 +262,8 @@ let save : HttpHandler =
|
|||||||
}
|
}
|
||||||
| false when Option.isSome m.skipDateUpdate && Option.get m.skipDateUpdate -> upd8
|
| false when Option.isSome m.skipDateUpdate && Option.get m.skipDateUpdate -> upd8
|
||||||
| false -> { upd8 with updatedDate = now }
|
| false -> { upd8 with updatedDate = now }
|
||||||
|> (match m.isNew () with true -> db.AddEntry | false -> db.UpdateEntry)
|
|> (match m.isNew () with true -> ctx.db.AddEntry | false -> ctx.db.UpdateEntry)
|
||||||
let! _ = db.SaveChangesAsync ()
|
let! _ = ctx.db.SaveChangesAsync ()
|
||||||
let s = Views.I18N.localizer.Force ()
|
let s = Views.I18N.localizer.Force ()
|
||||||
let act = match m.isNew () with true -> "Added" | false -> "Updated"
|
let act = match m.isNew () with true -> "Added" | false -> "Updated"
|
||||||
addInfo ctx s.["Successfully {0} prayer request", s.[act].Value.ToLower ()]
|
addInfo ctx s.["Successfully {0} prayer request", s.[act].Value.ToLower ()]
|
||||||
@ -300,11 +278,7 @@ let view date : HttpHandler =
|
|||||||
requireAccess [ User; Group ]
|
requireAccess [ User; Group ]
|
||||||
>=> fun next ctx ->
|
>=> fun next ctx ->
|
||||||
let startTicks = DateTime.Now.Ticks
|
let startTicks = DateTime.Now.Ticks
|
||||||
let listDate = parseListDate date
|
let list = parseListDate date |> generateRequestList ctx
|
||||||
task {
|
|
||||||
let list = generateRequestList ctx listDate
|
|
||||||
return!
|
|
||||||
viewInfo ctx startTicks
|
viewInfo ctx startTicks
|
||||||
|> Views.PrayerRequest.view { list with showHeader = false }
|
|> Views.PrayerRequest.view { list with showHeader = false }
|
||||||
|> renderHtml next ctx
|
|> renderHtml next ctx
|
||||||
}
|
|
||||||
|
@ -1,7 +1,7 @@
|
|||||||
<Project Sdk="Microsoft.NET.Sdk.Web">
|
<Project Sdk="Microsoft.NET.Sdk.Web">
|
||||||
|
|
||||||
<PropertyGroup>
|
<PropertyGroup>
|
||||||
<TargetFramework>net5.0</TargetFramework>
|
<TargetFramework>net6.0</TargetFramework>
|
||||||
</PropertyGroup>
|
</PropertyGroup>
|
||||||
|
|
||||||
<ItemGroup>
|
<ItemGroup>
|
||||||
@ -23,10 +23,9 @@
|
|||||||
</ItemGroup>
|
</ItemGroup>
|
||||||
|
|
||||||
<ItemGroup>
|
<ItemGroup>
|
||||||
<PackageReference Include="Giraffe" Version="4.0.1" />
|
<PackageReference Include="Giraffe" Version="5.0.0" />
|
||||||
<PackageReference Include="Giraffe.TokenRouter" Version="1.0.0" />
|
|
||||||
<PackageReference Include="Microsoft.VisualStudio.Web.CodeGeneration.Design" Version="3.1.1" />
|
<PackageReference Include="Microsoft.VisualStudio.Web.CodeGeneration.Design" Version="3.1.1" />
|
||||||
<PackageReference Include="Npgsql.EntityFrameworkCore.PostgreSQL" Version="3.1.2" />
|
<PackageReference Include="Npgsql.EntityFrameworkCore.PostgreSQL" Version="5.0.10" />
|
||||||
</ItemGroup>
|
</ItemGroup>
|
||||||
|
|
||||||
<ItemGroup>
|
<ItemGroup>
|
||||||
|
@ -1,8 +1,7 @@
|
|||||||
module PrayerTracker.Handlers.SmallGroup
|
module PrayerTracker.Handlers.SmallGroup
|
||||||
|
|
||||||
open FSharp.Control.Tasks.V2.ContextInsensitive
|
|
||||||
open Giraffe
|
open Giraffe
|
||||||
open Giraffe.GiraffeViewEngine
|
open Giraffe.ViewEngine
|
||||||
open Microsoft.AspNetCore.Http
|
open Microsoft.AspNetCore.Http
|
||||||
open NodaTime
|
open NodaTime
|
||||||
open PrayerTracker
|
open PrayerTracker
|
||||||
@ -33,16 +32,14 @@ let announcement : HttpHandler =
|
|||||||
let delete groupId : HttpHandler =
|
let delete groupId : HttpHandler =
|
||||||
requireAccess [ Admin ]
|
requireAccess [ Admin ]
|
||||||
>=> validateCSRF
|
>=> validateCSRF
|
||||||
>=> fun next ctx ->
|
>=> fun next ctx -> task {
|
||||||
let db = ctx.dbContext ()
|
|
||||||
let s = Views.I18N.localizer.Force ()
|
let s = Views.I18N.localizer.Force ()
|
||||||
task {
|
match! ctx.db.TryGroupById groupId with
|
||||||
match! db.TryGroupById groupId with
|
|
||||||
| Some grp ->
|
| Some grp ->
|
||||||
let! reqs = db.CountRequestsBySmallGroup groupId
|
let! reqs = ctx.db.CountRequestsBySmallGroup groupId
|
||||||
let! usrs = db.CountUsersBySmallGroup groupId
|
let! usrs = ctx.db.CountUsersBySmallGroup groupId
|
||||||
db.RemoveEntry grp
|
ctx.db.RemoveEntry grp
|
||||||
let! _ = db.SaveChangesAsync ()
|
let! _ = ctx.db.SaveChangesAsync ()
|
||||||
addInfo ctx
|
addInfo ctx
|
||||||
s.["The group {0} and its {1} prayer request(s) were deleted successfully; revoked access from {2} user(s)",
|
s.["The group {0} and its {1} prayer request(s) were deleted successfully; revoked access from {2} user(s)",
|
||||||
grp.name, reqs, usrs]
|
grp.name, reqs, usrs]
|
||||||
@ -55,14 +52,12 @@ let delete groupId : HttpHandler =
|
|||||||
let deleteMember memberId : HttpHandler =
|
let deleteMember memberId : HttpHandler =
|
||||||
requireAccess [ User ]
|
requireAccess [ User ]
|
||||||
>=> validateCSRF
|
>=> validateCSRF
|
||||||
>=> fun next ctx ->
|
>=> fun next ctx -> task {
|
||||||
let db = ctx.dbContext ()
|
|
||||||
let s = Views.I18N.localizer.Force ()
|
let s = Views.I18N.localizer.Force ()
|
||||||
task {
|
match! ctx.db.TryMemberById memberId with
|
||||||
match! db.TryMemberById memberId with
|
|
||||||
| Some mbr when mbr.smallGroupId = (currentGroup ctx).smallGroupId ->
|
| Some mbr when mbr.smallGroupId = (currentGroup ctx).smallGroupId ->
|
||||||
db.RemoveEntry mbr
|
ctx.db.RemoveEntry mbr
|
||||||
let! _ = db.SaveChangesAsync ()
|
let! _ = ctx.db.SaveChangesAsync ()
|
||||||
addHtmlInfo ctx s.["The group member “{0}” was deleted successfully", mbr.memberName]
|
addHtmlInfo ctx s.["The group member “{0}” was deleted successfully", mbr.memberName]
|
||||||
return! redirectTo false "/web/small-group/members" next ctx
|
return! redirectTo false "/web/small-group/members" next ctx
|
||||||
| Some _
|
| Some _
|
||||||
@ -73,11 +68,9 @@ let deleteMember memberId : HttpHandler =
|
|||||||
/// GET /small-group/[group-id]/edit
|
/// GET /small-group/[group-id]/edit
|
||||||
let edit (groupId : SmallGroupId) : HttpHandler =
|
let edit (groupId : SmallGroupId) : HttpHandler =
|
||||||
requireAccess [ Admin ]
|
requireAccess [ Admin ]
|
||||||
>=> fun next ctx ->
|
>=> fun next ctx -> task {
|
||||||
let startTicks = DateTime.Now.Ticks
|
let startTicks = DateTime.Now.Ticks
|
||||||
let db = ctx.dbContext ()
|
let! churches = ctx.db.AllChurches ()
|
||||||
task {
|
|
||||||
let! churches = db.AllChurches ()
|
|
||||||
match groupId = Guid.Empty with
|
match groupId = Guid.Empty with
|
||||||
| true ->
|
| true ->
|
||||||
return!
|
return!
|
||||||
@ -85,7 +78,7 @@ let edit (groupId : SmallGroupId) : HttpHandler =
|
|||||||
|> Views.SmallGroup.edit EditSmallGroup.empty churches ctx
|
|> Views.SmallGroup.edit EditSmallGroup.empty churches ctx
|
||||||
|> renderHtml next ctx
|
|> renderHtml next ctx
|
||||||
| false ->
|
| false ->
|
||||||
match! db.TryGroupById groupId with
|
match! ctx.db.TryGroupById groupId with
|
||||||
| Some grp ->
|
| Some grp ->
|
||||||
return!
|
return!
|
||||||
viewInfo ctx startTicks
|
viewInfo ctx startTicks
|
||||||
@ -100,7 +93,6 @@ let editMember (memberId : MemberId) : HttpHandler =
|
|||||||
requireAccess [ User ]
|
requireAccess [ User ]
|
||||||
>=> fun next ctx ->
|
>=> fun next ctx ->
|
||||||
let startTicks = DateTime.Now.Ticks
|
let startTicks = DateTime.Now.Ticks
|
||||||
let db = ctx.dbContext ()
|
|
||||||
let s = Views.I18N.localizer.Force ()
|
let s = Views.I18N.localizer.Force ()
|
||||||
let grp = currentGroup ctx
|
let grp = currentGroup ctx
|
||||||
let typs = ReferenceList.emailTypeList grp.preferences.defaultEmailType s
|
let typs = ReferenceList.emailTypeList grp.preferences.defaultEmailType s
|
||||||
@ -112,7 +104,7 @@ let editMember (memberId : MemberId) : HttpHandler =
|
|||||||
|> Views.SmallGroup.editMember EditMember.empty typs ctx
|
|> Views.SmallGroup.editMember EditMember.empty typs ctx
|
||||||
|> renderHtml next ctx
|
|> renderHtml next ctx
|
||||||
| false ->
|
| false ->
|
||||||
match! db.TryMemberById memberId with
|
match! ctx.db.TryMemberById memberId with
|
||||||
| Some mbr when mbr.smallGroupId = grp.smallGroupId ->
|
| Some mbr when mbr.smallGroupId = grp.smallGroupId ->
|
||||||
return!
|
return!
|
||||||
viewInfo ctx startTicks
|
viewInfo ctx startTicks
|
||||||
@ -129,7 +121,7 @@ let logOn (groupId : SmallGroupId option) : HttpHandler =
|
|||||||
>=> fun next ctx ->
|
>=> fun next ctx ->
|
||||||
let startTicks = DateTime.Now.Ticks
|
let startTicks = DateTime.Now.Ticks
|
||||||
task {
|
task {
|
||||||
let! grps = ctx.dbContext().ProtectedGroups ()
|
let! grps = ctx.db.ProtectedGroups ()
|
||||||
let grpId = match groupId with Some gid -> flatGuid gid | None -> ""
|
let grpId = match groupId with Some gid -> flatGuid gid | None -> ""
|
||||||
return!
|
return!
|
||||||
{ viewInfo ctx startTicks with helpLink = Some Help.logOn }
|
{ viewInfo ctx startTicks with helpLink = Some Help.logOn }
|
||||||
@ -147,9 +139,9 @@ let logOnSubmit : HttpHandler =
|
|||||||
match! ctx.TryBindFormAsync<GroupLogOn> () with
|
match! ctx.TryBindFormAsync<GroupLogOn> () with
|
||||||
| Ok m ->
|
| Ok m ->
|
||||||
let s = Views.I18N.localizer.Force ()
|
let s = Views.I18N.localizer.Force ()
|
||||||
match! ctx.dbContext().TryGroupLogOnByPassword m.smallGroupId m.password with
|
match! ctx.db.TryGroupLogOnByPassword m.smallGroupId m.password with
|
||||||
| Some grp ->
|
| Some grp ->
|
||||||
(Some >> ctx.Session.SetSmallGroup) grp
|
ctx.Session.smallGroup <- Some grp
|
||||||
match m.rememberMe with
|
match m.rememberMe with
|
||||||
| Some x when x -> (setGroupCookie ctx << sha1Hash) m.password
|
| Some x when x -> (setGroupCookie ctx << sha1Hash) m.password
|
||||||
| _ -> ()
|
| _ -> ()
|
||||||
@ -168,7 +160,7 @@ let maintain : HttpHandler =
|
|||||||
>=> fun next ctx ->
|
>=> fun next ctx ->
|
||||||
let startTicks = DateTime.Now.Ticks
|
let startTicks = DateTime.Now.Ticks
|
||||||
task {
|
task {
|
||||||
let! grps = ctx.dbContext().AllGroups ()
|
let! grps = ctx.db.AllGroups ()
|
||||||
return!
|
return!
|
||||||
viewInfo ctx startTicks
|
viewInfo ctx startTicks
|
||||||
|> Views.SmallGroup.maintain grps ctx
|
|> Views.SmallGroup.maintain grps ctx
|
||||||
@ -181,11 +173,10 @@ let members : HttpHandler =
|
|||||||
requireAccess [ User ]
|
requireAccess [ User ]
|
||||||
>=> fun next ctx ->
|
>=> fun next ctx ->
|
||||||
let startTicks = DateTime.Now.Ticks
|
let startTicks = DateTime.Now.Ticks
|
||||||
let db = ctx.dbContext ()
|
|
||||||
let grp = currentGroup ctx
|
let grp = currentGroup ctx
|
||||||
let s = Views.I18N.localizer.Force ()
|
let s = Views.I18N.localizer.Force ()
|
||||||
task {
|
task {
|
||||||
let! mbrs = db.AllMembersForSmallGroup grp.smallGroupId
|
let! mbrs = ctx.db.AllMembersForSmallGroup grp.smallGroupId
|
||||||
let typs = ReferenceList.emailTypeList grp.preferences.defaultEmailType s |> Map.ofSeq
|
let typs = ReferenceList.emailTypeList grp.preferences.defaultEmailType s |> Map.ofSeq
|
||||||
return!
|
return!
|
||||||
{ viewInfo ctx startTicks with helpLink = Some Help.maintainGroupMembers }
|
{ viewInfo ctx startTicks with helpLink = Some Help.maintainGroupMembers }
|
||||||
@ -199,12 +190,11 @@ let overview : HttpHandler =
|
|||||||
requireAccess [ User ]
|
requireAccess [ User ]
|
||||||
>=> fun next ctx ->
|
>=> fun next ctx ->
|
||||||
let startTicks = DateTime.Now.Ticks
|
let startTicks = DateTime.Now.Ticks
|
||||||
let db = ctx.dbContext ()
|
|
||||||
let clock = ctx.GetService<IClock> ()
|
let clock = ctx.GetService<IClock> ()
|
||||||
task {
|
task {
|
||||||
let reqs = db.AllRequestsForSmallGroup (currentGroup ctx) clock None true 0 |> List.ofSeq
|
let reqs = ctx.db.AllRequestsForSmallGroup (currentGroup ctx) clock None true 0 |> List.ofSeq
|
||||||
let! reqCount = db.CountRequestsBySmallGroup (currentGroup ctx).smallGroupId
|
let! reqCount = ctx.db.CountRequestsBySmallGroup (currentGroup ctx).smallGroupId
|
||||||
let! mbrCount = db.CountMembersForSmallGroup (currentGroup ctx).smallGroupId
|
let! mbrCount = ctx.db.CountMembersForSmallGroup (currentGroup ctx).smallGroupId
|
||||||
let m =
|
let m =
|
||||||
{ totalActiveReqs = List.length reqs
|
{ totalActiveReqs = List.length reqs
|
||||||
allReqs = reqCount
|
allReqs = reqCount
|
||||||
@ -230,7 +220,7 @@ let preferences : HttpHandler =
|
|||||||
>=> fun next ctx ->
|
>=> fun next ctx ->
|
||||||
let startTicks = DateTime.Now.Ticks
|
let startTicks = DateTime.Now.Ticks
|
||||||
task {
|
task {
|
||||||
let! tzs = ctx.dbContext().AllTimeZones ()
|
let! tzs = ctx.db.AllTimeZones ()
|
||||||
return!
|
return!
|
||||||
{ viewInfo ctx startTicks with helpLink = Some Help.groupPreferences }
|
{ viewInfo ctx startTicks with helpLink = Some Help.groupPreferences }
|
||||||
|> Views.SmallGroup.preferences (EditPreferences.fromPreferences (currentGroup ctx).preferences) tzs ctx
|
|> Views.SmallGroup.preferences (EditPreferences.fromPreferences (currentGroup ctx).preferences) tzs ctx
|
||||||
@ -247,20 +237,19 @@ let save : HttpHandler =
|
|||||||
task {
|
task {
|
||||||
match! ctx.TryBindFormAsync<EditSmallGroup> () with
|
match! ctx.TryBindFormAsync<EditSmallGroup> () with
|
||||||
| Ok m ->
|
| Ok m ->
|
||||||
let db = ctx.dbContext ()
|
|
||||||
let! group =
|
let! group =
|
||||||
match m.isNew () with
|
match m.isNew () with
|
||||||
| true -> Task.FromResult<SmallGroup option>(Some { SmallGroup.empty with smallGroupId = Guid.NewGuid () })
|
| true -> Task.FromResult<SmallGroup option>(Some { SmallGroup.empty with smallGroupId = Guid.NewGuid () })
|
||||||
| false -> db.TryGroupById m.smallGroupId
|
| false -> ctx.db.TryGroupById m.smallGroupId
|
||||||
match group with
|
match group with
|
||||||
| Some grp ->
|
| Some grp ->
|
||||||
m.populateGroup grp
|
m.populateGroup grp
|
||||||
|> function
|
|> function
|
||||||
| grp when m.isNew () ->
|
| grp when m.isNew () ->
|
||||||
db.AddEntry grp
|
ctx.db.AddEntry grp
|
||||||
db.AddEntry { grp.preferences with smallGroupId = grp.smallGroupId }
|
ctx.db.AddEntry { grp.preferences with smallGroupId = grp.smallGroupId }
|
||||||
| grp -> db.UpdateEntry grp
|
| grp -> ctx.db.UpdateEntry grp
|
||||||
let! _ = db.SaveChangesAsync ()
|
let! _ = ctx.db.SaveChangesAsync ()
|
||||||
let act = s.[match m.isNew () with true -> "Added" | false -> "Updated"].Value.ToLower ()
|
let act = s.[match m.isNew () with true -> "Added" | false -> "Updated"].Value.ToLower ()
|
||||||
addHtmlInfo ctx s.["Successfully {0} group “{1}”", act, m.name]
|
addHtmlInfo ctx s.["Successfully {0} group “{1}”", act, m.name]
|
||||||
return! redirectTo false "/web/small-groups" next ctx
|
return! redirectTo false "/web/small-groups" next ctx
|
||||||
@ -278,7 +267,6 @@ let saveMember : HttpHandler =
|
|||||||
match! ctx.TryBindFormAsync<EditMember> () with
|
match! ctx.TryBindFormAsync<EditMember> () with
|
||||||
| Ok m ->
|
| Ok m ->
|
||||||
let grp = currentGroup ctx
|
let grp = currentGroup ctx
|
||||||
let db = ctx.dbContext ()
|
|
||||||
let! mMbr =
|
let! mMbr =
|
||||||
match m.isNew () with
|
match m.isNew () with
|
||||||
| true ->
|
| true ->
|
||||||
@ -288,7 +276,7 @@ let saveMember : HttpHandler =
|
|||||||
memberId = Guid.NewGuid ()
|
memberId = Guid.NewGuid ()
|
||||||
smallGroupId = grp.smallGroupId
|
smallGroupId = grp.smallGroupId
|
||||||
})
|
})
|
||||||
| false -> db.TryMemberById m.memberId
|
| false -> ctx.db.TryMemberById m.memberId
|
||||||
match mMbr with
|
match mMbr with
|
||||||
| Some mbr when mbr.smallGroupId = grp.smallGroupId ->
|
| Some mbr when mbr.smallGroupId = grp.smallGroupId ->
|
||||||
{ mbr with
|
{ mbr with
|
||||||
@ -296,8 +284,8 @@ let saveMember : HttpHandler =
|
|||||||
email = m.emailAddress
|
email = m.emailAddress
|
||||||
format = match m.emailType with "" | null -> None | _ -> Some m.emailType
|
format = match m.emailType with "" | null -> None | _ -> Some m.emailType
|
||||||
}
|
}
|
||||||
|> (match m.isNew () with true -> db.AddEntry | false -> db.UpdateEntry)
|
|> (match m.isNew () with true -> ctx.db.AddEntry | false -> ctx.db.UpdateEntry)
|
||||||
let! _ = db.SaveChangesAsync ()
|
let! _ = ctx.db.SaveChangesAsync ()
|
||||||
let s = Views.I18N.localizer.Force ()
|
let s = Views.I18N.localizer.Force ()
|
||||||
let act = s.[match m.isNew () with true -> "Added" | false -> "Updated"].Value.ToLower ()
|
let act = s.[match m.isNew () with true -> "Added" | false -> "Updated"].Value.ToLower ()
|
||||||
addInfo ctx s.["Successfully {0} group member", act]
|
addInfo ctx s.["Successfully {0} group member", act]
|
||||||
@ -316,17 +304,16 @@ let savePreferences : HttpHandler =
|
|||||||
task {
|
task {
|
||||||
match! ctx.TryBindFormAsync<EditPreferences> () with
|
match! ctx.TryBindFormAsync<EditPreferences> () with
|
||||||
| Ok m ->
|
| Ok m ->
|
||||||
let db = ctx.dbContext ()
|
|
||||||
// Since the class is stored in the session, we'll use an intermediate instance to persist it; once that
|
// Since the class is stored in the session, we'll use an intermediate instance to persist it; once that
|
||||||
// works, we can repopulate the session instance. That way, if the update fails, the page should still show
|
// 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.
|
// the database values, not the then out-of-sync session ones.
|
||||||
match! db.TryGroupById (currentGroup ctx).smallGroupId with
|
match! ctx.db.TryGroupById (currentGroup ctx).smallGroupId with
|
||||||
| Some grp ->
|
| Some grp ->
|
||||||
let prefs = m.populatePreferences grp.preferences
|
let prefs = m.populatePreferences grp.preferences
|
||||||
db.UpdateEntry prefs
|
ctx.db.UpdateEntry prefs
|
||||||
let! _ = db.SaveChangesAsync ()
|
let! _ = ctx.db.SaveChangesAsync ()
|
||||||
// Refresh session instance
|
// Refresh session instance
|
||||||
ctx.Session.SetSmallGroup <| Some { grp with preferences = prefs }
|
ctx.Session.smallGroup <- Some { grp with preferences = prefs }
|
||||||
let s = Views.I18N.localizer.Force ()
|
let s = Views.I18N.localizer.Force ()
|
||||||
addInfo ctx s.["Group preferences updated successfully"]
|
addInfo ctx s.["Group preferences updated successfully"]
|
||||||
return! redirectTo false "/web/small-group/preferences" next ctx
|
return! redirectTo false "/web/small-group/preferences" next ctx
|
||||||
@ -346,7 +333,6 @@ let sendAnnouncement : HttpHandler =
|
|||||||
| Ok m ->
|
| Ok m ->
|
||||||
let grp = currentGroup ctx
|
let grp = currentGroup ctx
|
||||||
let usr = currentUser ctx
|
let usr = currentUser ctx
|
||||||
let db = ctx.dbContext ()
|
|
||||||
let now = grp.localTimeNow (ctx.GetService<IClock> ())
|
let now = grp.localTimeNow (ctx.GetService<IClock> ())
|
||||||
let s = Views.I18N.localizer.Force ()
|
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
|
||||||
@ -359,8 +345,8 @@ let sendAnnouncement : HttpHandler =
|
|||||||
// Send the e-mails
|
// Send the e-mails
|
||||||
let! recipients =
|
let! recipients =
|
||||||
match m.sendToClass with
|
match m.sendToClass with
|
||||||
| "N" when usr.isAdmin -> db.AllUsersAsMembers ()
|
| "N" when usr.isAdmin -> ctx.db.AllUsersAsMembers ()
|
||||||
| _ -> db.AllMembersForSmallGroup grp.smallGroupId
|
| _ -> ctx.db.AllMembersForSmallGroup grp.smallGroupId
|
||||||
use! client = Email.getConnection ()
|
use! client = Email.getConnection ()
|
||||||
do! Email.sendEmails client recipients grp
|
do! Email.sendEmails client recipients grp
|
||||||
s.["Announcement for {0} - {1:MMMM d, yyyy} {2}",
|
s.["Announcement for {0} - {1:MMMM d, yyyy} {2}",
|
||||||
@ -381,8 +367,8 @@ let sendAnnouncement : HttpHandler =
|
|||||||
enteredDate = now
|
enteredDate = now
|
||||||
updatedDate = now
|
updatedDate = now
|
||||||
}
|
}
|
||||||
|> db.AddEntry
|
|> ctx.db.AddEntry
|
||||||
let! _ = db.SaveChangesAsync ()
|
let! _ = ctx.db.SaveChangesAsync ()
|
||||||
()
|
()
|
||||||
// Tell 'em what they've won, Johnny!
|
// Tell 'em what they've won, Johnny!
|
||||||
let toWhom =
|
let toWhom =
|
||||||
|
@ -1,6 +1,5 @@
|
|||||||
module PrayerTracker.Handlers.User
|
module PrayerTracker.Handlers.User
|
||||||
|
|
||||||
open FSharp.Control.Tasks.V2.ContextInsensitive
|
|
||||||
open Giraffe
|
open Giraffe
|
||||||
open Microsoft.AspNetCore.Html
|
open Microsoft.AspNetCore.Html
|
||||||
open Microsoft.AspNetCore.Http
|
open Microsoft.AspNetCore.Http
|
||||||
@ -23,8 +22,7 @@ let private setUserCookie (ctx : HttpContext) pwHash =
|
|||||||
|
|
||||||
/// Retrieve a user from the database by password
|
/// Retrieve a user from the database by password
|
||||||
// If the hashes do not match, determine if it matches a previous scheme, and upgrade them if it does
|
// If the hashes do not match, determine if it matches a previous scheme, and upgrade them if it does
|
||||||
let private findUserByPassword m (db : AppDbContext) =
|
let private findUserByPassword m (db : AppDbContext) = task {
|
||||||
task {
|
|
||||||
match! db.TryUserByEmailAndGroup m.emailAddress m.smallGroupId with
|
match! db.TryUserByEmailAndGroup m.emailAddress m.smallGroupId with
|
||||||
| Some u when Option.isSome u.salt ->
|
| Some u when Option.isSome u.salt ->
|
||||||
// Already upgraded; match = success
|
// Already upgraded; match = success
|
||||||
@ -49,20 +47,18 @@ let private findUserByPassword m (db : AppDbContext) =
|
|||||||
let changePassword : HttpHandler =
|
let changePassword : HttpHandler =
|
||||||
requireAccess [ User ]
|
requireAccess [ User ]
|
||||||
>=> validateCSRF
|
>=> validateCSRF
|
||||||
>=> fun next ctx ->
|
>=> fun next ctx -> task {
|
||||||
task {
|
|
||||||
match! ctx.TryBindFormAsync<ChangePassword> () with
|
match! ctx.TryBindFormAsync<ChangePassword> () with
|
||||||
| Ok m ->
|
| Ok m ->
|
||||||
let s = Views.I18N.localizer.Force ()
|
let s = Views.I18N.localizer.Force ()
|
||||||
let db = ctx.dbContext ()
|
|
||||||
let curUsr = currentUser ctx
|
let curUsr = currentUser ctx
|
||||||
let! dbUsr = db.TryUserById curUsr.userId
|
let! dbUsr = ctx.db.TryUserById curUsr.userId
|
||||||
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 | _ -> sha1Hash) m.oldPassword
|
(match usr.salt with | Some salt -> pbkdf2Hash salt | _ -> sha1Hash) m.oldPassword
|
||||||
|> db.TryUserLogOnByCookie curUsr.userId (currentGroup ctx).smallGroupId
|
|> ctx.db.TryUserLogOnByCookie curUsr.userId (currentGroup ctx).smallGroupId
|
||||||
| _ -> Task.FromResult None
|
| _ -> Task.FromResult None
|
||||||
match user with
|
match user with
|
||||||
| Some _ when m.newPassword = m.newPasswordConfirm ->
|
| Some _ when m.newPassword = m.newPasswordConfirm ->
|
||||||
@ -70,8 +66,8 @@ let changePassword : HttpHandler =
|
|||||||
| Some usr ->
|
| Some usr ->
|
||||||
// Generate salt if it has not been already
|
// Generate salt if it has not been already
|
||||||
let salt = match usr.salt with Some s -> s | _ -> Guid.NewGuid ()
|
let salt = match usr.salt with Some s -> s | _ -> Guid.NewGuid ()
|
||||||
db.UpdateEntry { usr with passwordHash = pbkdf2Hash salt m.newPassword; salt = Some salt }
|
ctx.db.UpdateEntry { usr with passwordHash = pbkdf2Hash salt m.newPassword; salt = Some salt }
|
||||||
let! _ = db.SaveChangesAsync ()
|
let! _ = ctx.db.SaveChangesAsync ()
|
||||||
// If the user is remembered, update the cookie with the new hash
|
// If the user is remembered, update the cookie with the new hash
|
||||||
match ctx.Request.Cookies.Keys.Contains Key.Cookie.user with
|
match ctx.Request.Cookies.Keys.Contains Key.Cookie.user with
|
||||||
| true -> setUserCookie ctx usr.passwordHash
|
| true -> setUserCookie ctx usr.passwordHash
|
||||||
@ -93,13 +89,11 @@ let changePassword : HttpHandler =
|
|||||||
let delete userId : HttpHandler =
|
let delete userId : HttpHandler =
|
||||||
requireAccess [ Admin ]
|
requireAccess [ Admin ]
|
||||||
>=> validateCSRF
|
>=> validateCSRF
|
||||||
>=> fun next ctx ->
|
>=> fun next ctx -> task {
|
||||||
task {
|
match! ctx.db.TryUserById userId with
|
||||||
let db = ctx.dbContext ()
|
|
||||||
match! db.TryUserById userId with
|
|
||||||
| Some user ->
|
| Some user ->
|
||||||
db.RemoveEntry user
|
ctx.db.RemoveEntry user
|
||||||
let! _ = db.SaveChangesAsync ()
|
let! _ = ctx.db.SaveChangesAsync ()
|
||||||
let s = Views.I18N.localizer.Force ()
|
let s = Views.I18N.localizer.Force ()
|
||||||
addInfo ctx s.["Successfully deleted user {0}", user.fullName]
|
addInfo ctx s.["Successfully deleted user {0}", user.fullName]
|
||||||
return! redirectTo false "/web/users" next ctx
|
return! redirectTo false "/web/users" next ctx
|
||||||
@ -111,19 +105,17 @@ let delete userId : HttpHandler =
|
|||||||
let doLogOn : HttpHandler =
|
let doLogOn : HttpHandler =
|
||||||
requireAccess [ AccessLevel.Public ]
|
requireAccess [ AccessLevel.Public ]
|
||||||
>=> validateCSRF
|
>=> validateCSRF
|
||||||
>=> fun next ctx ->
|
>=> fun next ctx -> task {
|
||||||
task {
|
|
||||||
match! ctx.TryBindFormAsync<UserLogOn> () with
|
match! ctx.TryBindFormAsync<UserLogOn> () with
|
||||||
| Ok m ->
|
| Ok m ->
|
||||||
let db = ctx.dbContext ()
|
|
||||||
let s = Views.I18N.localizer.Force ()
|
let s = Views.I18N.localizer.Force ()
|
||||||
let! usr, pwHash = findUserByPassword m db
|
let! usr, pwHash = findUserByPassword m ctx.db
|
||||||
let! grp = db.TryGroupById m.smallGroupId
|
let! grp = ctx.db.TryGroupById m.smallGroupId
|
||||||
let nextUrl =
|
let nextUrl =
|
||||||
match usr with
|
match usr with
|
||||||
| Some _ ->
|
| Some _ ->
|
||||||
ctx.Session.SetUser usr
|
ctx.Session.user <- usr
|
||||||
ctx.Session.SetSmallGroup grp
|
ctx.Session.smallGroup <- grp
|
||||||
match m.rememberMe with Some x when x -> setUserCookie ctx pwHash | _ -> ()
|
match m.rememberMe with Some x when x -> setUserCookie ctx pwHash | _ -> ()
|
||||||
addHtmlInfo ctx s.["Log On Successful • Welcome to {0}", s.["PrayerTracker"]]
|
addHtmlInfo ctx s.["Log On Successful • Welcome to {0}", s.["PrayerTracker"]]
|
||||||
match m.redirectUrl with
|
match m.redirectUrl with
|
||||||
@ -157,9 +149,8 @@ let doLogOn : HttpHandler =
|
|||||||
/// GET /user/[user-id]/edit
|
/// GET /user/[user-id]/edit
|
||||||
let edit (userId : UserId) : HttpHandler =
|
let edit (userId : UserId) : HttpHandler =
|
||||||
requireAccess [ Admin ]
|
requireAccess [ Admin ]
|
||||||
>=> fun next ctx ->
|
>=> fun next ctx -> task {
|
||||||
let startTicks = DateTime.Now.Ticks
|
let startTicks = DateTime.Now.Ticks
|
||||||
task {
|
|
||||||
match userId = Guid.Empty with
|
match userId = Guid.Empty with
|
||||||
| true ->
|
| true ->
|
||||||
return!
|
return!
|
||||||
@ -167,7 +158,7 @@ let edit (userId : UserId) : HttpHandler =
|
|||||||
|> Views.User.edit EditUser.empty ctx
|
|> Views.User.edit EditUser.empty ctx
|
||||||
|> renderHtml next ctx
|
|> renderHtml next ctx
|
||||||
| false ->
|
| false ->
|
||||||
match! ctx.dbContext().TryUserById userId with
|
match! ctx.db.TryUserById userId with
|
||||||
| Some user ->
|
| Some user ->
|
||||||
return!
|
return!
|
||||||
viewInfo ctx startTicks
|
viewInfo ctx startTicks
|
||||||
@ -180,11 +171,10 @@ let edit (userId : UserId) : HttpHandler =
|
|||||||
/// GET /user/log-on
|
/// GET /user/log-on
|
||||||
let logOn : HttpHandler =
|
let logOn : HttpHandler =
|
||||||
requireAccess [ AccessLevel.Public ]
|
requireAccess [ AccessLevel.Public ]
|
||||||
>=> fun next ctx ->
|
>=> fun next ctx -> task {
|
||||||
let startTicks = DateTime.Now.Ticks
|
let startTicks = DateTime.Now.Ticks
|
||||||
let s = Views.I18N.localizer.Force ()
|
let s = Views.I18N.localizer.Force ()
|
||||||
task {
|
let! groups = ctx.db.GroupList ()
|
||||||
let! groups = ctx.dbContext().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 _ ->
|
||||||
@ -201,10 +191,9 @@ let logOn : HttpHandler =
|
|||||||
/// GET /users
|
/// GET /users
|
||||||
let maintain : HttpHandler =
|
let maintain : HttpHandler =
|
||||||
requireAccess [ Admin ]
|
requireAccess [ Admin ]
|
||||||
>=> fun next ctx ->
|
>=> fun next ctx -> task {
|
||||||
let startTicks = DateTime.Now.Ticks
|
let startTicks = DateTime.Now.Ticks
|
||||||
task {
|
let! users = ctx.db.AllUsers ()
|
||||||
let! users = ctx.dbContext().AllUsers ()
|
|
||||||
return!
|
return!
|
||||||
viewInfo ctx startTicks
|
viewInfo ctx startTicks
|
||||||
|> Views.User.maintain users ctx
|
|> Views.User.maintain users ctx
|
||||||
@ -225,15 +214,13 @@ let password : HttpHandler =
|
|||||||
let save : HttpHandler =
|
let save : HttpHandler =
|
||||||
requireAccess [ Admin ]
|
requireAccess [ Admin ]
|
||||||
>=> validateCSRF
|
>=> validateCSRF
|
||||||
>=> fun next ctx ->
|
>=> fun next ctx -> task {
|
||||||
task {
|
|
||||||
match! ctx.TryBindFormAsync<EditUser> () with
|
match! ctx.TryBindFormAsync<EditUser> () with
|
||||||
| Ok m ->
|
| Ok m ->
|
||||||
let db = ctx.dbContext ()
|
|
||||||
let! user =
|
let! user =
|
||||||
match m.isNew () with
|
match m.isNew () with
|
||||||
| true -> Task.FromResult (Some { User.empty with userId = Guid.NewGuid () })
|
| true -> Task.FromResult (Some { User.empty with userId = Guid.NewGuid () })
|
||||||
| false -> db.TryUserById m.userId
|
| false -> ctx.db.TryUserById m.userId
|
||||||
let saltedUser =
|
let saltedUser =
|
||||||
match user with
|
match user with
|
||||||
| Some u ->
|
| Some u ->
|
||||||
@ -248,8 +235,8 @@ let save : HttpHandler =
|
|||||||
match saltedUser with
|
match saltedUser with
|
||||||
| Some u ->
|
| Some u ->
|
||||||
let updatedUser = m.populateUser u (pbkdf2Hash (Option.get u.salt))
|
let updatedUser = m.populateUser u (pbkdf2Hash (Option.get u.salt))
|
||||||
updatedUser |> (match m.isNew () with true -> db.AddEntry | false -> db.UpdateEntry)
|
updatedUser |> (match m.isNew () with true -> ctx.db.AddEntry | false -> ctx.db.UpdateEntry)
|
||||||
let! _ = db.SaveChangesAsync ()
|
let! _ = ctx.db.SaveChangesAsync ()
|
||||||
let s = Views.I18N.localizer.Force ()
|
let s = Views.I18N.localizer.Force ()
|
||||||
match m.isNew () with
|
match m.isNew () with
|
||||||
| true ->
|
| true ->
|
||||||
@ -275,8 +262,7 @@ let save : HttpHandler =
|
|||||||
let saveGroups : HttpHandler =
|
let saveGroups : HttpHandler =
|
||||||
requireAccess [ Admin ]
|
requireAccess [ Admin ]
|
||||||
>=> validateCSRF
|
>=> validateCSRF
|
||||||
>=> fun next ctx ->
|
>=> fun next ctx -> task {
|
||||||
task {
|
|
||||||
match! ctx.TryBindFormAsync<AssignGroups> () with
|
match! ctx.TryBindFormAsync<AssignGroups> () with
|
||||||
| Ok m ->
|
| Ok m ->
|
||||||
let s = Views.I18N.localizer.Force ()
|
let s = Views.I18N.localizer.Force ()
|
||||||
@ -285,8 +271,7 @@ let saveGroups : HttpHandler =
|
|||||||
addError ctx s.["You must select at least one group to assign"]
|
addError ctx s.["You must select at least one group to assign"]
|
||||||
return! redirectTo false $"/web/user/{flatGuid m.userId}/small-groups" next ctx
|
return! redirectTo false $"/web/user/{flatGuid m.userId}/small-groups" next ctx
|
||||||
| _ ->
|
| _ ->
|
||||||
let db = ctx.dbContext ()
|
match! ctx.db.TryUserByIdWithGroups m.userId with
|
||||||
match! db.TryUserByIdWithGroups m.userId with
|
|
||||||
| Some user ->
|
| Some user ->
|
||||||
let grps =
|
let grps =
|
||||||
m.smallGroups.Split ','
|
m.smallGroups.Split ','
|
||||||
@ -294,14 +279,14 @@ let saveGroups : HttpHandler =
|
|||||||
|> List.ofArray
|
|> List.ofArray
|
||||||
user.smallGroups
|
user.smallGroups
|
||||||
|> Seq.filter (fun x -> not (grps |> List.exists (fun y -> y = x.smallGroupId)))
|
|> Seq.filter (fun x -> not (grps |> List.exists (fun y -> y = x.smallGroupId)))
|
||||||
|> db.UserGroupXref.RemoveRange
|
|> ctx.db.UserGroupXref.RemoveRange
|
||||||
grps
|
grps
|
||||||
|> Seq.ofList
|
|> Seq.ofList
|
||||||
|> Seq.filter (fun x -> not (user.smallGroups |> Seq.exists (fun y -> y.smallGroupId = x)))
|
|> Seq.filter (fun x -> not (user.smallGroups |> Seq.exists (fun y -> y.smallGroupId = x)))
|
||||||
|> Seq.map (fun x -> { UserSmallGroup.empty with userId = user.userId; smallGroupId = x })
|
|> Seq.map (fun x -> { UserSmallGroup.empty with userId = user.userId; smallGroupId = x })
|
||||||
|> List.ofSeq
|
|> List.ofSeq
|
||||||
|> List.iter db.AddEntry
|
|> List.iter ctx.db.AddEntry
|
||||||
let! _ = db.SaveChangesAsync ()
|
let! _ = ctx.db.SaveChangesAsync ()
|
||||||
addInfo ctx s.["Successfully updated group permissions for {0}", m.userName]
|
addInfo ctx s.["Successfully updated group permissions for {0}", m.userName]
|
||||||
return! redirectTo false "/web/users" next ctx
|
return! redirectTo false "/web/users" next ctx
|
||||||
| _ -> return! fourOhFour next ctx
|
| _ -> return! fourOhFour next ctx
|
||||||
@ -312,13 +297,11 @@ let saveGroups : HttpHandler =
|
|||||||
/// GET /user/[user-id]/small-groups
|
/// GET /user/[user-id]/small-groups
|
||||||
let smallGroups userId : HttpHandler =
|
let smallGroups userId : HttpHandler =
|
||||||
requireAccess [ Admin ]
|
requireAccess [ Admin ]
|
||||||
>=> fun next ctx ->
|
>=> fun next ctx -> task {
|
||||||
let startTicks = DateTime.Now.Ticks
|
let startTicks = DateTime.Now.Ticks
|
||||||
let db = ctx.dbContext ()
|
match! ctx.db.TryUserByIdWithGroups userId with
|
||||||
task {
|
|
||||||
match! db.TryUserByIdWithGroups userId with
|
|
||||||
| Some user ->
|
| Some user ->
|
||||||
let! grps = db.GroupList ()
|
let! grps = ctx.db.GroupList ()
|
||||||
let curGroups = user.smallGroups |> Seq.map (fun g -> flatGuid g.smallGroupId) |> List.ofSeq
|
let curGroups = user.smallGroups |> Seq.map (fun g -> flatGuid g.smallGroupId) |> List.ofSeq
|
||||||
return!
|
return!
|
||||||
viewInfo ctx startTicks
|
viewInfo ctx startTicks
|
||||||
|
Loading…
Reference in New Issue
Block a user