Compare commits
7 Commits
26f408bb54
...
toward-v9
| Author | SHA1 | Date | |
|---|---|---|---|
| 733a730591 | |||
| 0c1285eaa7 | |||
| c9ccfe8b68 | |||
| 2e5a1426f6 | |||
| 05394b4461 | |||
| 14b0a58d98 | |||
| bade89dd37 |
6
build.fs
6
build.fs
@@ -7,7 +7,7 @@ let execContext = Context.FakeExecutionContext.Create false "build.fsx" []
|
|||||||
Context.setExecutionContext (Context.RuntimeContext.Fake execContext)
|
Context.setExecutionContext (Context.RuntimeContext.Fake execContext)
|
||||||
|
|
||||||
/// The root path to the projects within this solution
|
/// The root path to the projects within this solution
|
||||||
let projPath = "src/PrayerTracker"
|
let projPath = "src"
|
||||||
|
|
||||||
Target.create "Clean" (fun _ ->
|
Target.create "Clean" (fun _ ->
|
||||||
!! "src/**/bin"
|
!! "src/**/bin"
|
||||||
@@ -16,7 +16,7 @@ Target.create "Clean" (fun _ ->
|
|||||||
)
|
)
|
||||||
|
|
||||||
Target.create "Test" (fun _ ->
|
Target.create "Test" (fun _ ->
|
||||||
let testPath = $"{projPath}.Tests"
|
let testPath = $"{projPath}/Tests"
|
||||||
DotNet.build (fun opts -> { opts with NoLogo = true }) $"{testPath}/PrayerTracker.Tests.fsproj"
|
DotNet.build (fun opts -> { opts with NoLogo = true }) $"{testPath}/PrayerTracker.Tests.fsproj"
|
||||||
Testing.Expecto.run
|
Testing.Expecto.run
|
||||||
(fun opts -> { opts with WorkingDirectory = $"{testPath}/bin/Release/net9.0" })
|
(fun opts -> { opts with WorkingDirectory = $"{testPath}/bin/Release/net9.0" })
|
||||||
@@ -25,7 +25,7 @@ Target.create "Test" (fun _ ->
|
|||||||
Target.create "Publish" (fun _ ->
|
Target.create "Publish" (fun _ ->
|
||||||
DotNet.publish
|
DotNet.publish
|
||||||
(fun opts -> { opts with Runtime = Some "linux-x64"; SelfContained = Some false; NoLogo = true })
|
(fun opts -> { opts with Runtime = Some "linux-x64"; SelfContained = Some false; NoLogo = true })
|
||||||
$"{projPath}/PrayerTracker.fsproj")
|
$"{projPath}/PrayerTracker/PrayerTracker.fsproj")
|
||||||
|
|
||||||
Target.create "All" ignore
|
Target.create "All" ignore
|
||||||
|
|
||||||
|
|||||||
@@ -1,9 +1,5 @@
|
|||||||
namespace PrayerTracker.Data
|
namespace PrayerTracker.Data
|
||||||
|
|
||||||
open System
|
|
||||||
open NodaTime
|
|
||||||
open PrayerTracker.Entities
|
|
||||||
|
|
||||||
/// Table names
|
/// Table names
|
||||||
[<RequireQualifiedAccess>]
|
[<RequireQualifiedAccess>]
|
||||||
module Table =
|
module Table =
|
||||||
@@ -29,6 +25,10 @@ module Table =
|
|||||||
let User = "pt_user"
|
let User = "pt_user"
|
||||||
|
|
||||||
|
|
||||||
|
open System
|
||||||
|
open NodaTime
|
||||||
|
open PrayerTracker.Entities
|
||||||
|
|
||||||
/// JSON serialization customizations
|
/// JSON serialization customizations
|
||||||
[<RequireQualifiedAccess>]
|
[<RequireQualifiedAccess>]
|
||||||
module Json =
|
module Json =
|
||||||
@@ -36,12 +36,10 @@ module Json =
|
|||||||
open System.Text.Json.Serialization
|
open System.Text.Json.Serialization
|
||||||
|
|
||||||
/// Convert a wrapped DU to/from its string representation
|
/// Convert a wrapped DU to/from its string representation
|
||||||
type WrappedJsonConverter<'T>(wrap : string -> 'T, unwrap : 'T -> string) =
|
type WrappedJsonConverter<'T>(wrap: string -> 'T, unwrap: 'T -> string) =
|
||||||
inherit JsonConverter<'T>()
|
inherit JsonConverter<'T>()
|
||||||
override _.Read(reader, _, _) =
|
override _.Read(reader, _, _) = wrap (reader.GetString())
|
||||||
wrap (reader.GetString())
|
override _.Write(writer, value, _) = writer.WriteStringValue(unwrap value)
|
||||||
override _.Write(writer, value, _) =
|
|
||||||
writer.WriteStringValue(unwrap value)
|
|
||||||
|
|
||||||
open System.Text.Json
|
open System.Text.Json
|
||||||
open NodaTime.Serialization.SystemTextJson
|
open NodaTime.Serialization.SystemTextJson
|
||||||
@@ -49,6 +47,7 @@ module Json =
|
|||||||
/// JSON serializer options to support the target domain
|
/// JSON serializer options to support the target domain
|
||||||
let options =
|
let options =
|
||||||
let opts = JsonSerializerOptions()
|
let opts = JsonSerializerOptions()
|
||||||
|
|
||||||
[ WrappedJsonConverter<AsOfDateDisplay>(AsOfDateDisplay.Parse, string) :> JsonConverter
|
[ WrappedJsonConverter<AsOfDateDisplay>(AsOfDateDisplay.Parse, string) :> JsonConverter
|
||||||
WrappedJsonConverter<EmailFormat>(EmailFormat.Parse, string)
|
WrappedJsonConverter<EmailFormat>(EmailFormat.Parse, string)
|
||||||
WrappedJsonConverter<Expiration>(Expiration.Parse, string)
|
WrappedJsonConverter<Expiration>(Expiration.Parse, string)
|
||||||
@@ -62,11 +61,17 @@ module Json =
|
|||||||
WrappedJsonConverter<UserId>(Guid.Parse >> UserId, string)
|
WrappedJsonConverter<UserId>(Guid.Parse >> UserId, string)
|
||||||
JsonFSharpConverter() ]
|
JsonFSharpConverter() ]
|
||||||
|> List.iter opts.Converters.Add
|
|> List.iter opts.Converters.Add
|
||||||
|
|
||||||
let _ = opts.ConfigureForNodaTime DateTimeZoneProviders.Tzdb
|
let _ = opts.ConfigureForNodaTime DateTimeZoneProviders.Tzdb
|
||||||
opts.PropertyNamingPolicy <- JsonNamingPolicy.CamelCase
|
opts.PropertyNamingPolicy <- JsonNamingPolicy.CamelCase
|
||||||
opts.DefaultIgnoreCondition <- JsonIgnoreCondition.WhenWritingNull
|
opts.DefaultIgnoreCondition <- JsonIgnoreCondition.WhenWritingNull
|
||||||
opts
|
opts
|
||||||
|
|
||||||
|
|
||||||
|
module private Helpers =
|
||||||
|
let instant (it: Instant) =
|
||||||
|
it.ToString()
|
||||||
|
|
||||||
open BitBadger.Documents
|
open BitBadger.Documents
|
||||||
open BitBadger.Documents.Sqlite
|
open BitBadger.Documents.Sqlite
|
||||||
|
|
||||||
@@ -77,106 +82,172 @@ module Connection =
|
|||||||
open System.Text.Json
|
open System.Text.Json
|
||||||
|
|
||||||
/// Ensure tables and indexes are defined
|
/// Ensure tables and indexes are defined
|
||||||
let setUp () = backgroundTask {
|
let setUp () =
|
||||||
|
backgroundTask {
|
||||||
Configuration.useIdField "id"
|
Configuration.useIdField "id"
|
||||||
|
|
||||||
Configuration.useSerializer
|
Configuration.useSerializer
|
||||||
{ new IDocumentSerializer with
|
{ new IDocumentSerializer with
|
||||||
member _.Serialize<'T>(it : 'T) = JsonSerializer.Serialize(it, Json.options)
|
member _.Serialize<'T>(it: 'T) =
|
||||||
member _.Deserialize<'T>(it : string) = JsonSerializer.Deserialize<'T>(it, Json.options)
|
JsonSerializer.Serialize(it, Json.options)
|
||||||
}
|
|
||||||
|
member _.Deserialize<'T>(it: string) =
|
||||||
|
JsonSerializer.Deserialize<'T>(it, Json.options) }
|
||||||
|
|
||||||
|
let! tables = Custom.list<string> "SELECT name FROM sqlite_master WHERE type = 'table'" [] _.GetString(0)
|
||||||
|
|
||||||
let! tables = Custom.list<string> "SELECT table_name FROM sqlite_master" [] _.GetString(0)
|
|
||||||
if not (List.contains Table.Church tables) then
|
if not (List.contains Table.Church tables) then
|
||||||
do! Definition.ensureTable Table.Church
|
do! Definition.ensureTable Table.Church
|
||||||
|
|
||||||
if not (List.contains Table.Group tables) then
|
if not (List.contains Table.Group tables) then
|
||||||
do! Definition.ensureTable Table.Group
|
do! Definition.ensureTable Table.Group
|
||||||
do! Definition.ensureFieldIndex Table.Group "church" [ "churchId" ]
|
do! Definition.ensureFieldIndex Table.Group "church" [ "churchId" ]
|
||||||
|
|
||||||
if not (List.contains Table.Member tables) then
|
if not (List.contains Table.Member tables) then
|
||||||
do! Definition.ensureTable Table.Member
|
do! Definition.ensureTable Table.Member
|
||||||
do! Definition.ensureFieldIndex Table.Member "group" [ "smallGroupId" ]
|
do! Definition.ensureFieldIndex Table.Member "group" [ "smallGroupId" ]
|
||||||
|
|
||||||
if not (List.contains Table.Request tables) then
|
if not (List.contains Table.Request tables) then
|
||||||
do! Definition.ensureTable Table.Request
|
do! Definition.ensureTable Table.Request
|
||||||
do! Definition.ensureFieldIndex Table.Request "group" [ "smallGroupId" ]
|
do! Definition.ensureFieldIndex Table.Request "group" [ "smallGroupId" ]
|
||||||
|
|
||||||
if not (List.contains Table.User tables) then
|
if not (List.contains Table.User tables) then
|
||||||
do! Definition.ensureTable Table.User
|
do! Definition.ensureTable Table.User
|
||||||
do! Definition.ensureFieldIndex Table.User "email" [ "email" ]
|
do! Definition.ensureFieldIndex Table.User "email" [ "email" ]
|
||||||
}
|
}
|
||||||
|
|
||||||
|
|
||||||
/// Helper functions for the PostgreSQL data implementation
|
open Microsoft.Data.Sqlite
|
||||||
[<AutoOpen>]
|
|
||||||
module private Helpers =
|
|
||||||
|
|
||||||
/// Map a row to a Prayer Request instance
|
/// Functions to retrieve small group information
|
||||||
let mapToPrayerRequest (row : RowReader) =
|
module SmallGroups =
|
||||||
{ Id = PrayerRequestId (row.uuid "id")
|
|
||||||
UserId = UserId (row.uuid "user_id")
|
|
||||||
SmallGroupId = SmallGroupId (row.uuid "small_group_id")
|
|
||||||
EnteredDate = row.fieldValue<Instant> "entered_date"
|
|
||||||
UpdatedDate = row.fieldValue<Instant> "updated_date"
|
|
||||||
Requestor = row.stringOrNone "requestor"
|
|
||||||
Text = row.string "request_text"
|
|
||||||
NotifyChaplain = row.bool "notify_chaplain"
|
|
||||||
RequestType = PrayerRequestType.Parse (row.string "request_type")
|
|
||||||
Expiration = Expiration.Parse (row.string "expiration")
|
|
||||||
}
|
|
||||||
|
|
||||||
/// Map a row to a Small Group information set
|
/// Query to retrieve data for a small group info instance
|
||||||
let mapToSmallGroupInfo (row : RowReader) =
|
let private infoQuery =
|
||||||
{ Id = Giraffe.ShortGuid.fromGuid (row.uuid "id")
|
$"SELECT g.data->>'id' AS id, g.data->>'name' AS groupName, c.data->>'name' AS churchName,
|
||||||
Name = row.string "group_name"
|
g.data->'preferences'->>'timeZoneId' AS timeZoneId, g.data->'preferences'->>'isPublic' AS isPublic
|
||||||
ChurchName = row.string "church_name"
|
FROM {Table.Group} g
|
||||||
TimeZoneId = TimeZoneId (row.string "time_zone_id")
|
INNER JOIN {Table.Church} c ON c.data->>'id' = g.data->>'churchId'"
|
||||||
IsPublic = row.bool "is_public"
|
|
||||||
}
|
/// Query to retrieve data for a small group select list item
|
||||||
|
let private itemQuery =
|
||||||
|
$"SELECT g.data->>'name' AS groupName, g.data->>'id' AS id, c.data->>'name' AS churchName
|
||||||
|
FROM {Table.Group} g
|
||||||
|
INNER JOIN {Table.Church} c ON c.data->>'id' = g.data->>'churchId'"
|
||||||
|
|
||||||
|
/// The ORDER BY clause for select list item queries
|
||||||
|
let private itemOrderBy =
|
||||||
|
Query.orderBy
|
||||||
|
[ { Field.Named "name" with Qualifier = Some "c" }; { Field.Named "name" with Qualifier = Some "g" } ]
|
||||||
|
SQLite
|
||||||
|
|
||||||
/// Map a row to a Small Group list item
|
/// Map a row to a Small Group list item
|
||||||
let mapToSmallGroupItem (row : RowReader) =
|
let private toSmallGroupItem (rdr: SqliteDataReader) =
|
||||||
Giraffe.ShortGuid.fromGuid (row.uuid "id"), $"""{row.string "church_name"} | {row.string "group_name"}"""
|
(rdr.GetOrdinal >> rdr.GetString >> Guid.Parse >> Giraffe.ShortGuid.fromGuid) "id",
|
||||||
|
$"""{(rdr.GetOrdinal >> rdr.GetString) "churchName"} | {(rdr.GetOrdinal >> rdr.GetString) "groupName"}"""
|
||||||
|
|
||||||
/// Map a row to a User instance
|
/// Get the group IDs for the given church
|
||||||
let mapToUser (row : RowReader) =
|
let internal groupIdsByChurch (churchId: ChurchId) =
|
||||||
{ Id = UserId (row.uuid "id")
|
backgroundTask {
|
||||||
FirstName = row.string "first_name"
|
let! groups = Find.byFields<SmallGroup> Table.Group All [ Field.Equal "churchId" (string churchId) ]
|
||||||
LastName = row.string "last_name"
|
return groups |> List.map _.Id
|
||||||
Email = row.string "email"
|
|
||||||
IsAdmin = row.bool "is_admin"
|
|
||||||
PasswordHash = row.string "password_hash"
|
|
||||||
LastSeen = row.fieldValueOrNone<Instant> "last_seen"
|
|
||||||
SmallGroups = []
|
|
||||||
}
|
}
|
||||||
|
|
||||||
|
/// Count the number of small groups for a church
|
||||||
|
let countByChurch (churchId: ChurchId) =
|
||||||
|
Count.byFields Table.Group All [ Field.Equal "churchId" (string churchId) ]
|
||||||
|
|
||||||
|
/// Delete a small group by its ID
|
||||||
|
let deleteById (groupId: SmallGroupId) =
|
||||||
|
backgroundTask {
|
||||||
|
use conn = Configuration.dbConn ()
|
||||||
|
use! txn = conn.BeginTransactionAsync()
|
||||||
|
|
||||||
|
let! users =
|
||||||
|
Find.byFields<User> Table.User All [ Field.InArray "smallGroups" Table.User [ (string groupId) ] ]
|
||||||
|
|
||||||
|
for user in users do
|
||||||
|
do! Patch.byId Table.User user.Id {| SmallGroups = user.SmallGroups |> List.except [ groupId ] |}
|
||||||
|
|
||||||
|
do! conn.deleteByFields Table.Request All [ Field.Equal "smallGroupId" (string groupId) ]
|
||||||
|
do! conn.deleteById Table.Group (string groupId)
|
||||||
|
|
||||||
|
do! txn.CommitAsync()
|
||||||
|
}
|
||||||
|
|
||||||
|
/// Get information for all small groups
|
||||||
|
let infoForAll () =
|
||||||
|
Custom.list $"{infoQuery} ORDER BY g.data->>'name'" [] SmallGroupInfo.FromReader
|
||||||
|
|
||||||
|
/// Get a list of small group IDs along with a description that includes the church name
|
||||||
|
let listAll () =
|
||||||
|
Custom.list $"{itemQuery} {itemOrderBy}" [] toSmallGroupItem
|
||||||
|
|
||||||
|
/// Get a list of small group IDs and descriptions for groups with a group password
|
||||||
|
let listProtected () =
|
||||||
|
Custom.list
|
||||||
|
$"{itemQuery} WHERE COALESCE(g.data->'preferences'->>'groupPassword', '') <> '' {itemOrderBy}"
|
||||||
|
[]
|
||||||
|
toSmallGroupItem
|
||||||
|
|
||||||
|
/// Get a list of small group IDs and descriptions for groups that are public or have a group password
|
||||||
|
let listPublicAndProtected () =
|
||||||
|
Custom.list
|
||||||
|
$"{infoQuery}
|
||||||
|
WHERE g.data->'preferences'->>'isPublic' = TRUE
|
||||||
|
OR COALESCE(g.data->'preferences'->>'groupPassword', '') <> ''
|
||||||
|
{itemOrderBy}"
|
||||||
|
[]
|
||||||
|
SmallGroupInfo.FromReader
|
||||||
|
|
||||||
|
/// Log on for a small group (includes list preferences)
|
||||||
|
let logOn (groupId: SmallGroupId) (password: string) =
|
||||||
|
Find.firstByFields<SmallGroup>
|
||||||
|
Table.Group
|
||||||
|
All
|
||||||
|
[ Field.Equal "id" (string groupId); Field.Equal "preferences.groupPassword" password ]
|
||||||
|
|
||||||
|
/// Save a small group
|
||||||
|
let save group = save<SmallGroup> Table.Group group
|
||||||
|
|
||||||
|
/// Save a small group's list preferences
|
||||||
|
let savePreferences (groupId: SmallGroupId) (pref: ListPreferences) =
|
||||||
|
Patch.byId Table.Group (string groupId) {| Preferences = pref |}
|
||||||
|
|
||||||
|
/// Get a small group by its ID (including list preferences)
|
||||||
|
let tryById groupId =
|
||||||
|
Find.byId<SmallGroupId, SmallGroup> Table.Group groupId
|
||||||
|
|
||||||
open BitBadger.Documents
|
|
||||||
open Npgsql
|
|
||||||
open Npgsql.FSharp
|
|
||||||
|
|
||||||
/// Functions to manipulate churches
|
/// Functions to manipulate churches
|
||||||
module Churches =
|
module Churches =
|
||||||
|
|
||||||
/// Get a list of all churches
|
/// Get a list of all churches
|
||||||
let all () =
|
let all () = Find.all<Church> Table.Church
|
||||||
Find.all<Church> Table.Church
|
|
||||||
|
|
||||||
/// Delete a church by its ID
|
/// Delete a church by its ID
|
||||||
let deleteById (churchId: ChurchId) = backgroundTask {
|
let deleteById churchId =
|
||||||
let idParam = [ [ "@churchId", Sql.uuid churchId.Value ] ]
|
backgroundTask {
|
||||||
let where = "WHERE small_group_id IN (SELECT id FROM pt.small_group WHERE church_id = @churchId)"
|
use conn = Configuration.dbConn ()
|
||||||
let! _ =
|
use! txn = conn.BeginTransactionAsync()
|
||||||
BitBadger.Documents.Postgres.Configuration.dataSource ()
|
|
||||||
|> Sql.fromDataSource
|
let! groupIds = SmallGroups.groupIdsByChurch churchId
|
||||||
|> Sql.executeTransactionAsync
|
let gIdStrings = groupIds |> List.map string
|
||||||
[ $"DELETE FROM pt.prayer_request {where}", idParam
|
|
||||||
$"DELETE FROM pt.user_small_group {where}", idParam
|
do! Delete.byFields Table.Request All [ Field.In "smallGroupId" gIdStrings ]
|
||||||
$"DELETE FROM pt.list_preference {where}", idParam
|
|
||||||
"DELETE FROM pt.small_group WHERE church_id = @churchId", idParam
|
let! users = Find.byFields<User> Table.User All [ Field.InArray "smallGroups" Table.User gIdStrings ]
|
||||||
"DELETE FROM pt.church WHERE id = @churchId", idParam ]
|
|
||||||
()
|
for user in users do
|
||||||
|
do! Patch.byId Table.User (string user.Id) {| SmallGroups = user.SmallGroups |> List.except groupIds |}
|
||||||
|
|
||||||
|
do! Delete.byFields Table.Group All [ Field.Equal "churchId" (string churchId) ]
|
||||||
|
do! Delete.byId Table.Church (string churchId)
|
||||||
|
do! txn.CommitAsync()
|
||||||
}
|
}
|
||||||
|
|
||||||
/// Save a church's information
|
/// Save a church's information
|
||||||
let save church =
|
let save church = save<Church> Table.Church church
|
||||||
save<Church> Table.Church church
|
|
||||||
|
|
||||||
/// Find a church by its ID
|
/// Find a church by its ID
|
||||||
let tryById churchId =
|
let tryById churchId =
|
||||||
@@ -188,20 +259,21 @@ module Members =
|
|||||||
|
|
||||||
/// Count members for the given small group
|
/// Count members for the given small group
|
||||||
let countByGroup (groupId: SmallGroupId) =
|
let countByGroup (groupId: SmallGroupId) =
|
||||||
Count.byFields Table.Member All [ Field.Equal "smallGroupId" groupId ]
|
Count.byFields Table.Member All [ Field.Equal "smallGroupId" (string groupId) ]
|
||||||
|
|
||||||
/// Delete a small group member by its ID
|
/// Delete a small group member by its ID
|
||||||
let deleteById (memberId: MemberId) =
|
let deleteById (memberId: MemberId) = Delete.byId Table.Member (string memberId)
|
||||||
Delete.byId Table.Member memberId
|
|
||||||
|
|
||||||
/// Retrieve all members for a given small group
|
/// Retrieve all members for a given small group
|
||||||
let forGroup (groupId : SmallGroupId) =
|
let forGroup (groupId: SmallGroupId) =
|
||||||
Find.byFieldsOrdered<Member>
|
Find.byFieldsOrdered<Member>
|
||||||
Table.Member All [ Field.Equal "smallGroupId" groupId ] [ Field.Named "memberName" ]
|
Table.Member
|
||||||
|
All
|
||||||
|
[ Field.Equal "smallGroupId" (string groupId) ]
|
||||||
|
[ Field.Named "memberName" ]
|
||||||
|
|
||||||
/// Save a small group member
|
/// Save a small group member
|
||||||
let save mbr =
|
let save mbr = save<Member> Table.Member mbr
|
||||||
save<Member> Table.Member mbr
|
|
||||||
|
|
||||||
/// Retrieve a small group member by its ID
|
/// Retrieve a small group member by its ID
|
||||||
let tryById memberId =
|
let tryById memberId =
|
||||||
@@ -210,20 +282,21 @@ module Members =
|
|||||||
|
|
||||||
/// Options to retrieve a list of requests
|
/// Options to retrieve a list of requests
|
||||||
type PrayerRequestOptions =
|
type PrayerRequestOptions =
|
||||||
{ /// The small group for which requests should be retrieved
|
{
|
||||||
SmallGroup : SmallGroup
|
/// The small group for which requests should be retrieved
|
||||||
|
SmallGroup: SmallGroup
|
||||||
|
|
||||||
/// The clock instance to use for date/time manipulation
|
/// The clock instance to use for date/time manipulation
|
||||||
Clock : IClock
|
Clock: IClock
|
||||||
|
|
||||||
/// The date for which the list is being retrieved
|
/// The date for which the list is being retrieved
|
||||||
ListDate : LocalDate option
|
ListDate: LocalDate option
|
||||||
|
|
||||||
/// Whether only active requests should be retrieved
|
/// Whether only active requests should be retrieved
|
||||||
ActiveOnly : bool
|
ActiveOnly: bool
|
||||||
|
|
||||||
/// The page number, for paged lists
|
/// The page number, for paged lists
|
||||||
PageNumber : int
|
PageNumber: int
|
||||||
}
|
}
|
||||||
|
|
||||||
|
|
||||||
@@ -233,71 +306,82 @@ module PrayerRequests =
|
|||||||
/// Central place to append sort criteria for prayer request queries
|
/// Central place to append sort criteria for prayer request queries
|
||||||
let private orderBy sort =
|
let private orderBy sort =
|
||||||
match sort with
|
match sort with
|
||||||
| SortByDate -> "updated_date DESC, entered_date DESC, requestor"
|
| SortByDate -> [ Field.Named "updatedDate DESC"; Field.Named "enteredDate DESC"; Field.Named "requestor" ]
|
||||||
| SortByRequestor -> "requestor, updated_date DESC, entered_date DESC"
|
| SortByRequestor -> [ Field.Named "requestor"; Field.Named "updatedDate DESC"; Field.Named "enteredDate DESC" ]
|
||||||
|
|> fun fields -> Query.orderBy fields SQLite
|
||||||
|
|
||||||
/// Paginate a prayer request query
|
/// Paginate a prayer request query
|
||||||
let private paginate (pageNbr : int) pageSize =
|
let private paginate (pageNbr: int) pageSize =
|
||||||
if pageNbr > 0 then $"LIMIT {pageSize} OFFSET {(pageNbr - 1) * pageSize}" else ""
|
if pageNbr > 0 then
|
||||||
|
$"LIMIT {pageSize} OFFSET {(pageNbr - 1) * pageSize}"
|
||||||
|
else
|
||||||
|
""
|
||||||
|
|
||||||
/// Count the number of prayer requests for a church
|
/// Count the number of prayer requests for a church
|
||||||
let countByChurch (churchId : ChurchId) =
|
let countByChurch churchId =
|
||||||
BitBadger.Documents.Postgres.Custom.scalar
|
backgroundTask {
|
||||||
"SELECT COUNT(id) AS req_count
|
let! groupIds = SmallGroups.groupIdsByChurch churchId
|
||||||
FROM pt.prayer_request
|
return! Count.byFields Table.Request All [ Field.In "smallGroupId" (List.map string groupIds) ]
|
||||||
WHERE small_group_id IN (SELECT id FROM pt.small_group WHERE church_id = @churchId)"
|
}
|
||||||
[ "@churchId", Sql.uuid churchId.Value ] (fun row -> row.int "req_count")
|
|
||||||
|
|
||||||
/// Count the number of prayer requests for a small group
|
/// Count the number of prayer requests for a small group
|
||||||
let countByGroup (groupId: SmallGroupId) =
|
let countByGroup (groupId: SmallGroupId) =
|
||||||
Count.byFields Table.Request All [ Field.Equal "smallGroupId" groupId ]
|
Count.byFields Table.Request All [ Field.Equal "smallGroupId" (string groupId) ]
|
||||||
|
|
||||||
/// Delete a prayer request by its ID
|
/// Delete a prayer request by its ID
|
||||||
let deleteById (reqId: PrayerRequestId) =
|
let deleteById (reqId: PrayerRequestId) = Delete.byId Table.Request (string reqId)
|
||||||
Delete.byId Table.Request reqId
|
|
||||||
|
|
||||||
/// Get all (or active) requests for a small group as of now or the specified date
|
/// Get all (or active) requests for a small group as of now or the specified date
|
||||||
let forGroup (opts : PrayerRequestOptions) =
|
let forGroup (opts: PrayerRequestOptions) =
|
||||||
let theDate = defaultArg opts.ListDate (opts.SmallGroup.LocalDateNow opts.Clock)
|
let theDate = defaultArg opts.ListDate (opts.SmallGroup.LocalDateNow opts.Clock)
|
||||||
let where, parameters =
|
|
||||||
|
let sql, parameters =
|
||||||
if opts.ActiveOnly then
|
if opts.ActiveOnly then
|
||||||
let asOf = NpgsqlParameter (
|
let expDate =
|
||||||
"@asOf",
|
|
||||||
(theDate.AtStartOfDayInZone(opts.SmallGroup.TimeZone)
|
(theDate.AtStartOfDayInZone(opts.SmallGroup.TimeZone)
|
||||||
- Duration.FromDays opts.SmallGroup.Preferences.DaysToExpire)
|
- Duration.FromDays opts.SmallGroup.Preferences.DaysToExpire)
|
||||||
.ToInstant ())
|
.ToInstant()
|
||||||
" AND ( updated_date > @asOf
|
$"""AND ( date(data->>'updatedDate') > date(:updatedDate)
|
||||||
OR expiration = @manual
|
OR data->>'expiration' = :expManual
|
||||||
OR request_type = @longTerm
|
OR data->>'requestType' IN (:typLongTerm, :typExpecting))
|
||||||
OR request_type = @expecting)
|
AND data->>'expiration' <> :expForced""",
|
||||||
AND expiration <> @forced",
|
[ SqliteParameter(":updatedDate", string expDate)
|
||||||
[ "@asOf", Sql.parameter asOf
|
SqliteParameter(":expManual", string Manual)
|
||||||
"@manual", Sql.string (string Manual)
|
SqliteParameter(":typLongTerm", string LongTermRequest)
|
||||||
"@longTerm", Sql.string (string LongTermRequest)
|
SqliteParameter(":typExpecting", string Expecting)
|
||||||
"@expecting", Sql.string (string Expecting)
|
SqliteParameter(":expForced", string Forced) ]
|
||||||
"@forced", Sql.string (string Forced) ]
|
else
|
||||||
else "", []
|
"", []
|
||||||
BitBadger.Documents.Postgres.Custom.list
|
|
||||||
$"SELECT *
|
Custom.list
|
||||||
FROM pt.prayer_request
|
$"SELECT data FROM {Table.Request}
|
||||||
WHERE small_group_id = @groupId {where}
|
WHERE data->>'smallGroupId' = :groupId
|
||||||
ORDER BY {orderBy opts.SmallGroup.Preferences.RequestSort}
|
{sql}
|
||||||
|
{orderBy opts.SmallGroup.Preferences.RequestSort}
|
||||||
{paginate opts.PageNumber opts.SmallGroup.Preferences.PageSize}"
|
{paginate opts.PageNumber opts.SmallGroup.Preferences.PageSize}"
|
||||||
(("@groupId", Sql.uuid opts.SmallGroup.Id.Value) :: parameters) mapToPrayerRequest
|
(SqliteParameter(":groupId", string opts.SmallGroup.Id) :: parameters)
|
||||||
|
fromData<PrayerRequest>
|
||||||
|
|
||||||
/// Save a prayer request
|
/// Save a prayer request
|
||||||
let save req =
|
let save req = save<PrayerRequest> Table.Request req
|
||||||
save<PrayerRequest> Table.Request req
|
|
||||||
|
|
||||||
/// Search prayer requests for the given term
|
/// Search prayer requests for the given term
|
||||||
let searchForGroup group searchTerm pageNbr =
|
let searchForGroup group searchTerm pageNbr =
|
||||||
BitBadger.Documents.Postgres.Custom.list
|
let pct = "%"
|
||||||
$"SELECT * FROM pt.prayer_request WHERE small_group_id = @groupId AND request_text ILIKE @search
|
Custom.list
|
||||||
|
$"WITH results AS (
|
||||||
|
SELECT data FROM {Table.Request}
|
||||||
|
WHERE data->>'smallGroupId' = :groupId
|
||||||
|
AND data->>'text' LIKE :search
|
||||||
UNION
|
UNION
|
||||||
SELECT * FROM pt.prayer_request WHERE small_group_id = @groupId AND COALESCE(requestor, '') ILIKE @search
|
SELECT data FROM {Table.Request}
|
||||||
ORDER BY {orderBy group.Preferences.RequestSort}
|
WHERE data->>'smallGroupId' = :groupId
|
||||||
|
AND COALESCE(data->>'requestor', '') LIKE :search)
|
||||||
|
SELECT data FROM results
|
||||||
|
{orderBy group.Preferences.RequestSort}
|
||||||
{paginate pageNbr group.Preferences.PageSize}"
|
{paginate pageNbr group.Preferences.PageSize}"
|
||||||
[ "@groupId", Sql.uuid group.Id.Value; "@search", Sql.string $"%%%s{searchTerm}%%" ] mapToPrayerRequest
|
[ SqliteParameter(":groupId", string group.Id); SqliteParameter(":search", $"{pct}%s{searchTerm}{pct}") ]
|
||||||
|
fromData<PrayerRequest>
|
||||||
|
|
||||||
/// Retrieve a prayer request by its ID
|
/// Retrieve a prayer request by its ID
|
||||||
let tryById reqId =
|
let tryById reqId =
|
||||||
@@ -306,90 +390,13 @@ module PrayerRequests =
|
|||||||
/// Update the expiration for the given prayer request
|
/// Update the expiration for the given prayer request
|
||||||
let updateExpiration (req: PrayerRequest) withTime =
|
let updateExpiration (req: PrayerRequest) withTime =
|
||||||
if withTime then
|
if withTime then
|
||||||
Patch.byId Table.Request req.Id {| UpdatedDate = req.UpdatedDate; Expiration = req.Expiration |}
|
Patch.byId
|
||||||
|
Table.Request
|
||||||
|
(string req.Id)
|
||||||
|
{| UpdatedDate = req.UpdatedDate
|
||||||
|
Expiration = req.Expiration |}
|
||||||
else
|
else
|
||||||
Patch.byId Table.Request req.Id {| Expiration = req.Expiration |}
|
Patch.byId Table.Request (string req.Id) {| Expiration = req.Expiration |}
|
||||||
|
|
||||||
|
|
||||||
/// Functions to retrieve small group information
|
|
||||||
module SmallGroups =
|
|
||||||
|
|
||||||
/// Count the number of small groups for a church
|
|
||||||
let countByChurch (churchId: ChurchId) =
|
|
||||||
Count.byFields Table.Group All [ Field.Equal "churchId" churchId ]
|
|
||||||
|
|
||||||
/// Delete a small group by its ID
|
|
||||||
let deleteById (groupId: SmallGroupId) = backgroundTask {
|
|
||||||
use conn = Configuration.dbConn ()
|
|
||||||
use txn = conn.BeginTransaction()
|
|
||||||
|
|
||||||
let! users = Find.byFields<User> Table.User All [ Field.InArray "smallGroups" Table.User [ groupId ] ]
|
|
||||||
for user in users do
|
|
||||||
do! Patch.byId Table.User user.Id {| SmallGroups = user.SmallGroups |> List.except [ groupId ] |}
|
|
||||||
do! conn.deleteByFields Table.Request All [ Field.Equal "smallGroupId" groupId ]
|
|
||||||
do! conn.deleteById Table.Group groupId
|
|
||||||
|
|
||||||
do! txn.CommitAsync()
|
|
||||||
}
|
|
||||||
|
|
||||||
/// Get information for all small groups
|
|
||||||
let infoForAll () =
|
|
||||||
BitBadger.Documents.Postgres.Custom.list
|
|
||||||
"SELECT sg.id, sg.group_name, c.church_name, lp.time_zone_id, lp.is_public
|
|
||||||
FROM pt.small_group sg
|
|
||||||
INNER JOIN pt.church c ON c.id = sg.church_id
|
|
||||||
INNER JOIN pt.list_preference lp ON lp.small_group_id = sg.id
|
|
||||||
ORDER BY sg.group_name"
|
|
||||||
[] mapToSmallGroupInfo
|
|
||||||
|
|
||||||
/// Get a list of small group IDs along with a description that includes the church name
|
|
||||||
let listAll () =
|
|
||||||
BitBadger.Documents.Postgres.Custom.list
|
|
||||||
"SELECT g.group_name, g.id, c.church_name
|
|
||||||
FROM pt.small_group g
|
|
||||||
INNER JOIN pt.church c ON c.id = g.church_id
|
|
||||||
ORDER BY c.church_name, g.group_name"
|
|
||||||
[] mapToSmallGroupItem
|
|
||||||
|
|
||||||
/// Get a list of small group IDs and descriptions for groups with a group password
|
|
||||||
let listProtected () =
|
|
||||||
BitBadger.Documents.Postgres.Custom.list
|
|
||||||
"SELECT g.group_name, g.id, c.church_name, lp.is_public
|
|
||||||
FROM pt.small_group g
|
|
||||||
INNER JOIN pt.church c ON c.id = g.church_id
|
|
||||||
INNER JOIN pt.list_preference lp ON lp.small_group_id = g.id
|
|
||||||
WHERE COALESCE(lp.group_password, '') <> ''
|
|
||||||
ORDER BY c.church_name, g.group_name"
|
|
||||||
[] mapToSmallGroupItem
|
|
||||||
|
|
||||||
/// Get a list of small group IDs and descriptions for groups that are public or have a group password
|
|
||||||
let listPublicAndProtected () =
|
|
||||||
BitBadger.Documents.Postgres.Custom.list
|
|
||||||
"SELECT g.group_name, g.id, c.church_name, lp.time_zone_id, lp.is_public
|
|
||||||
FROM pt.small_group g
|
|
||||||
INNER JOIN pt.church c ON c.id = g.church_id
|
|
||||||
INNER JOIN pt.list_preference lp ON lp.small_group_id = g.id
|
|
||||||
WHERE lp.is_public = TRUE
|
|
||||||
OR COALESCE(lp.group_password, '') <> ''
|
|
||||||
ORDER BY c.church_name, g.group_name"
|
|
||||||
[] mapToSmallGroupInfo
|
|
||||||
|
|
||||||
/// Log on for a small group (includes list preferences)
|
|
||||||
let logOn (groupId: SmallGroupId) (password: string) =
|
|
||||||
Find.firstByFields<SmallGroup>
|
|
||||||
Table.Group All [ Field.Equal "id" groupId; Field.Equal "preferences.groupPassword" password ]
|
|
||||||
|
|
||||||
/// Save a small group
|
|
||||||
let save group =
|
|
||||||
save<SmallGroup> Table.Group group
|
|
||||||
|
|
||||||
/// Save a small group's list preferences
|
|
||||||
let savePreferences (pref: ListPreferences) =
|
|
||||||
Patch.byId Table.Group pref.SmallGroupId {| Preferences = pref |}
|
|
||||||
|
|
||||||
/// Get a small group by its ID (including list preferences)
|
|
||||||
let tryById groupId =
|
|
||||||
Find.byId<SmallGroupId, SmallGroup> Table.Group groupId
|
|
||||||
|
|
||||||
|
|
||||||
/// Functions to manipulate users
|
/// Functions to manipulate users
|
||||||
@@ -400,44 +407,37 @@ module Users =
|
|||||||
Find.allOrdered<User> Table.User [ Field.Named "lastName"; Field.Named "firstName" ]
|
Find.allOrdered<User> Table.User [ Field.Named "lastName"; Field.Named "firstName" ]
|
||||||
|
|
||||||
/// Count the number of users for a church
|
/// Count the number of users for a church
|
||||||
let countByChurch (churchId : ChurchId) =
|
let countByChurch churchId =
|
||||||
BitBadger.Documents.Postgres.Custom.scalar
|
backgroundTask {
|
||||||
"SELECT COUNT(u.id) AS user_count
|
let! groupIds = SmallGroups.groupIdsByChurch churchId
|
||||||
FROM pt.pt_user u
|
return! Count.byFields Table.User All [ Field.InArray "smallGroups" Table.User (List.map string groupIds) ]
|
||||||
WHERE EXISTS (
|
}
|
||||||
SELECT 1
|
|
||||||
FROM pt.user_small_group usg
|
|
||||||
INNER JOIN pt.small_group sg ON sg.id = usg.small_group_id
|
|
||||||
WHERE usg.user_id = u.id
|
|
||||||
AND sg.church_id = @churchId)"
|
|
||||||
[ "@churchId", Sql.uuid churchId.Value ] (fun row -> row.int "user_count")
|
|
||||||
|
|
||||||
/// Count the number of users for a small group
|
/// Count the number of users for a small group
|
||||||
let countByGroup (groupId: SmallGroupId) =
|
let countByGroup (groupId: SmallGroupId) =
|
||||||
Count.byFields Table.User All [ Field.InArray "smallGroups" Table.User [ groupId ] ]
|
Count.byFields Table.User All [ Field.InArray "smallGroups" Table.User [ (string groupId) ] ]
|
||||||
|
|
||||||
/// Delete a user by its database ID
|
/// Delete a user by its database ID
|
||||||
let deleteById (userId: UserId) =
|
let deleteById (userId: UserId) = Delete.byId Table.User (string userId)
|
||||||
Delete.byId Table.User userId
|
|
||||||
|
|
||||||
/// Get a list of users authorized to administer the given small group
|
/// Get a list of users authorized to administer the given small group
|
||||||
let listByGroupId (groupId : SmallGroupId) =
|
let listByGroupId (groupId: SmallGroupId) =
|
||||||
BitBadger.Documents.Postgres.Custom.list
|
Find.byFieldsOrdered<User>
|
||||||
"SELECT u.*
|
Table.User
|
||||||
FROM pt.pt_user u
|
All
|
||||||
INNER JOIN pt.user_small_group usg ON usg.user_id = u.id
|
[ Field.InArray "smallGroups" Table.User [ (string groupId) ] ]
|
||||||
WHERE usg.small_group_id = @groupId
|
[ Field.Named "lastName"; Field.Named "firstName" ]
|
||||||
ORDER BY u.last_name, u.first_name"
|
|
||||||
[ "@groupId", Sql.uuid groupId.Value ] mapToUser
|
|
||||||
|
|
||||||
/// Save a user's information
|
/// Save a user's information
|
||||||
let save user =
|
let save user = save<User> Table.User user
|
||||||
save<User> Table.User user
|
|
||||||
|
|
||||||
/// Find a user by its e-mail address and authorized small group
|
/// Find a user by its e-mail address and authorized small group
|
||||||
let tryByEmailAndGroup (email: string) (groupId: SmallGroupId) =
|
let tryByEmailAndGroup (email: string) (groupId: SmallGroupId) =
|
||||||
Find.firstByFields<User>
|
Find.firstByFields<User>
|
||||||
Table.User All [ Field.Equal "email" email; Field.InArray "smallGroups" Table.User [ groupId ] ]
|
Table.User
|
||||||
|
All
|
||||||
|
[ Field.Equal "email" email
|
||||||
|
Field.InArray "smallGroups" Table.User [ (string groupId) ] ]
|
||||||
|
|
||||||
/// Find a user by their database ID
|
/// Find a user by their database ID
|
||||||
let tryById userId =
|
let tryById userId =
|
||||||
@@ -445,12 +445,12 @@ module Users =
|
|||||||
|
|
||||||
/// Update a user's last seen date/time
|
/// Update a user's last seen date/time
|
||||||
let updateLastSeen (userId: UserId) (now: Instant) =
|
let updateLastSeen (userId: UserId) (now: Instant) =
|
||||||
Patch.byId Table.User userId {| LastSeen = now |}
|
Patch.byId Table.User (string userId) {| LastSeen = now |}
|
||||||
|
|
||||||
/// Update a user's password hash
|
/// Update a user's password hash
|
||||||
let updatePassword (user: User) =
|
let updatePassword (user: User) =
|
||||||
Patch.byId Table.User user.Id {| PasswordHash = user.PasswordHash |}
|
Patch.byId Table.User (string user.Id) {| PasswordHash = user.PasswordHash |}
|
||||||
|
|
||||||
/// Update a user's authorized small groups
|
/// Update a user's authorized small groups
|
||||||
let updateSmallGroups (userId: UserId) (groupIds: SmallGroupId list) =
|
let updateSmallGroups (userId: UserId) (groupIds: SmallGroupId list) =
|
||||||
Patch.byId Table.User userId {| SmallGroups = groupIds |}
|
Patch.byId Table.User (string userId) {| SmallGroups = groupIds |}
|
||||||
|
|||||||
@@ -1,192 +0,0 @@
|
|||||||
namespace PrayerTracker.Data
|
|
||||||
|
|
||||||
open System.Threading
|
|
||||||
open System.Threading.Tasks
|
|
||||||
open Microsoft.Extensions.Caching.Distributed
|
|
||||||
open NodaTime
|
|
||||||
open Npgsql
|
|
||||||
|
|
||||||
/// Helper types and functions for the cache
|
|
||||||
[<AutoOpen>]
|
|
||||||
module private CacheHelpers =
|
|
||||||
|
|
||||||
open System
|
|
||||||
|
|
||||||
/// The cache entry
|
|
||||||
type Entry =
|
|
||||||
{ /// The ID of the cache entry
|
|
||||||
Id : string
|
|
||||||
|
|
||||||
/// The value to be cached
|
|
||||||
Payload : byte[]
|
|
||||||
|
|
||||||
/// When this entry will expire
|
|
||||||
ExpireAt : Instant
|
|
||||||
|
|
||||||
/// The duration by which the expiration should be pushed out when being refreshed
|
|
||||||
SlidingExpiration : Duration option
|
|
||||||
|
|
||||||
/// The must-expire-by date/time for the cache entry
|
|
||||||
AbsoluteExpiration : Instant option
|
|
||||||
}
|
|
||||||
|
|
||||||
/// Run a task synchronously
|
|
||||||
let sync<'T> (it : Task<'T>) = it |> (Async.AwaitTask >> Async.RunSynchronously)
|
|
||||||
|
|
||||||
/// Get the current instant
|
|
||||||
let getNow () = SystemClock.Instance.GetCurrentInstant ()
|
|
||||||
|
|
||||||
/// Create a parameter for the expire-at time
|
|
||||||
let expireParam (it : Instant) =
|
|
||||||
"@expireAt", Sql.parameter (NpgsqlParameter ("@expireAt", it))
|
|
||||||
|
|
||||||
/// Create a parameter for a possibly-missing NodaTime type
|
|
||||||
let optParam<'T> name (it : 'T option) =
|
|
||||||
let p = NpgsqlParameter ($"@%s{name}", if Option.isSome it then box it.Value else DBNull.Value)
|
|
||||||
p.ParameterName, Sql.parameter p
|
|
||||||
|
|
||||||
|
|
||||||
open BitBadger.Documents.Postgres
|
|
||||||
|
|
||||||
/// A distributed cache implementation in PostgreSQL used to handle sessions for myWebLog
|
|
||||||
type DistributedCache () =
|
|
||||||
|
|
||||||
// ~~~ INITIALIZATION ~~~
|
|
||||||
|
|
||||||
do
|
|
||||||
task {
|
|
||||||
let! exists =
|
|
||||||
Custom.scalar
|
|
||||||
$"SELECT EXISTS
|
|
||||||
(SELECT 1 FROM pg_tables WHERE schemaname = 'public' AND tablename = 'session')
|
|
||||||
AS does_exist"
|
|
||||||
[] (fun row -> row.bool "does_exist")
|
|
||||||
if not exists then
|
|
||||||
do! Custom.nonQuery
|
|
||||||
"CREATE TABLE session (
|
|
||||||
id TEXT NOT NULL PRIMARY KEY,
|
|
||||||
payload BYTEA NOT NULL,
|
|
||||||
expire_at TIMESTAMPTZ NOT NULL,
|
|
||||||
sliding_expiration INTERVAL,
|
|
||||||
absolute_expiration TIMESTAMPTZ);
|
|
||||||
CREATE INDEX idx_session_expiration ON session (expire_at)" []
|
|
||||||
} |> sync
|
|
||||||
|
|
||||||
// ~~~ SUPPORT FUNCTIONS ~~~
|
|
||||||
|
|
||||||
/// Get an entry, updating it for sliding expiration
|
|
||||||
let getEntry key = backgroundTask {
|
|
||||||
let idParam = "@id", Sql.string key
|
|
||||||
let! tryEntry =
|
|
||||||
Custom.single "SELECT * FROM session WHERE id = @id" [ idParam ]
|
|
||||||
(fun row ->
|
|
||||||
{ Id = row.string "id"
|
|
||||||
Payload = row.bytea "payload"
|
|
||||||
ExpireAt = row.fieldValue<Instant> "expire_at"
|
|
||||||
SlidingExpiration = row.fieldValueOrNone<Duration> "sliding_expiration"
|
|
||||||
AbsoluteExpiration = row.fieldValueOrNone<Instant> "absolute_expiration" })
|
|
||||||
match tryEntry with
|
|
||||||
| Some entry ->
|
|
||||||
let now = getNow ()
|
|
||||||
let slideExp = defaultArg entry.SlidingExpiration Duration.MinValue
|
|
||||||
let absExp = defaultArg entry.AbsoluteExpiration Instant.MinValue
|
|
||||||
let needsRefresh, item =
|
|
||||||
if entry.ExpireAt = absExp then false, entry
|
|
||||||
elif slideExp = Duration.MinValue && absExp = Instant.MinValue then false, entry
|
|
||||||
elif absExp > Instant.MinValue && entry.ExpireAt.Plus slideExp > absExp then
|
|
||||||
true, { entry with ExpireAt = absExp }
|
|
||||||
else true, { entry with ExpireAt = now.Plus slideExp }
|
|
||||||
if needsRefresh then
|
|
||||||
do! Custom.nonQuery "UPDATE session SET expire_at = @expireAt WHERE id = @id"
|
|
||||||
[ expireParam item.ExpireAt; idParam ]
|
|
||||||
return if item.ExpireAt > now then Some entry else None
|
|
||||||
| None -> return None
|
|
||||||
}
|
|
||||||
|
|
||||||
/// The last time expired entries were purged (runs every 30 minutes)
|
|
||||||
let mutable lastPurge = Instant.MinValue
|
|
||||||
|
|
||||||
/// Purge expired entries every 30 minutes
|
|
||||||
let purge () = backgroundTask {
|
|
||||||
let now = getNow ()
|
|
||||||
if lastPurge.Plus (Duration.FromMinutes 30L) < now then
|
|
||||||
do! Custom.nonQuery "DELETE FROM session WHERE expire_at < @expireAt" [ expireParam now ]
|
|
||||||
lastPurge <- now
|
|
||||||
}
|
|
||||||
|
|
||||||
/// Remove a cache entry
|
|
||||||
let removeEntry key =
|
|
||||||
Custom.nonQuery "DELETE FROM session WHERE id = @id" [ "@id", Sql.string key ]
|
|
||||||
|
|
||||||
/// Save an entry
|
|
||||||
let saveEntry (opts : DistributedCacheEntryOptions) key payload =
|
|
||||||
let now = getNow ()
|
|
||||||
let expireAt, slideExp, absExp =
|
|
||||||
if opts.SlidingExpiration.HasValue then
|
|
||||||
let slide = Duration.FromTimeSpan opts.SlidingExpiration.Value
|
|
||||||
now.Plus slide, Some slide, None
|
|
||||||
elif opts.AbsoluteExpiration.HasValue then
|
|
||||||
let exp = Instant.FromDateTimeOffset opts.AbsoluteExpiration.Value
|
|
||||||
exp, None, Some exp
|
|
||||||
elif opts.AbsoluteExpirationRelativeToNow.HasValue then
|
|
||||||
let exp = now.Plus (Duration.FromTimeSpan opts.AbsoluteExpirationRelativeToNow.Value)
|
|
||||||
exp, None, Some exp
|
|
||||||
else
|
|
||||||
// Default to 2 hour sliding expiration
|
|
||||||
let slide = Duration.FromHours 2
|
|
||||||
now.Plus slide, Some slide, None
|
|
||||||
Custom.nonQuery
|
|
||||||
"INSERT INTO session (
|
|
||||||
id, payload, expire_at, sliding_expiration, absolute_expiration
|
|
||||||
) VALUES (
|
|
||||||
@id, @payload, @expireAt, @slideExp, @absExp
|
|
||||||
) ON CONFLICT (id) DO UPDATE
|
|
||||||
SET payload = EXCLUDED.payload,
|
|
||||||
expire_at = EXCLUDED.expire_at,
|
|
||||||
sliding_expiration = EXCLUDED.sliding_expiration,
|
|
||||||
absolute_expiration = EXCLUDED.absolute_expiration"
|
|
||||||
[ "@id", Sql.string key
|
|
||||||
"@payload", Sql.bytea payload
|
|
||||||
expireParam expireAt
|
|
||||||
optParam "slideExp" slideExp
|
|
||||||
optParam "absExp" absExp ]
|
|
||||||
|
|
||||||
// ~~~ IMPLEMENTATION FUNCTIONS ~~~
|
|
||||||
|
|
||||||
/// Retrieve the data for a cache entry
|
|
||||||
let get key (_ : CancellationToken) = backgroundTask {
|
|
||||||
match! getEntry key with
|
|
||||||
| Some entry ->
|
|
||||||
do! purge ()
|
|
||||||
return entry.Payload
|
|
||||||
| None -> return null
|
|
||||||
}
|
|
||||||
|
|
||||||
/// Refresh an entry
|
|
||||||
let refresh key (cancelToken : CancellationToken) = backgroundTask {
|
|
||||||
let! _ = get key cancelToken
|
|
||||||
()
|
|
||||||
}
|
|
||||||
|
|
||||||
/// Remove an entry
|
|
||||||
let remove key (_ : CancellationToken) = backgroundTask {
|
|
||||||
do! removeEntry key
|
|
||||||
do! purge ()
|
|
||||||
}
|
|
||||||
|
|
||||||
/// Set an entry
|
|
||||||
let set key value options (_ : CancellationToken) = backgroundTask {
|
|
||||||
do! saveEntry options key value
|
|
||||||
do! purge ()
|
|
||||||
}
|
|
||||||
|
|
||||||
interface IDistributedCache with
|
|
||||||
member this.Get key = get key CancellationToken.None |> sync
|
|
||||||
member this.GetAsync (key, token) = get key token
|
|
||||||
member this.Refresh key = refresh key CancellationToken.None |> sync
|
|
||||||
member this.RefreshAsync (key, token) = refresh key token
|
|
||||||
member this.Remove key = remove key CancellationToken.None |> sync
|
|
||||||
member this.RemoveAsync (key, token) = remove key token
|
|
||||||
member this.Set (key, value, options) = set key value options CancellationToken.None |> sync
|
|
||||||
member this.SetAsync (key, value, options, token) = set key value options token
|
|
||||||
|
|
||||||
@@ -209,6 +209,8 @@ type UserId =
|
|||||||
|
|
||||||
(*-- SPECIFIC VIEW TYPES --*)
|
(*-- SPECIFIC VIEW TYPES --*)
|
||||||
|
|
||||||
|
open Microsoft.Data.Sqlite
|
||||||
|
|
||||||
/// Statistics for churches
|
/// Statistics for churches
|
||||||
[<NoComparison; NoEquality>]
|
[<NoComparison; NoEquality>]
|
||||||
type ChurchStats =
|
type ChurchStats =
|
||||||
@@ -225,7 +227,7 @@ type ChurchStats =
|
|||||||
|
|
||||||
|
|
||||||
/// Information needed to display the public/protected request list and small group maintenance pages
|
/// Information needed to display the public/protected request list and small group maintenance pages
|
||||||
[<NoComparison; NoEquality>]
|
[<CLIMutable; NoComparison; NoEquality>]
|
||||||
type SmallGroupInfo =
|
type SmallGroupInfo =
|
||||||
{
|
{
|
||||||
/// The ID of the small group
|
/// The ID of the small group
|
||||||
@@ -244,12 +246,21 @@ type SmallGroupInfo =
|
|||||||
IsPublic: bool
|
IsPublic: bool
|
||||||
}
|
}
|
||||||
|
|
||||||
|
/// Map a row to a Small Group information set
|
||||||
|
static member FromReader (rdr: SqliteDataReader) =
|
||||||
|
{ Id = Giraffe.ShortGuid.fromGuid ((rdr.GetOrdinal >> rdr.GetString >> Guid.Parse) "id")
|
||||||
|
Name = (rdr.GetOrdinal >> rdr.GetString) "groupName"
|
||||||
|
ChurchName = (rdr.GetOrdinal >> rdr.GetString) "churchName"
|
||||||
|
TimeZoneId = (rdr.GetOrdinal >> rdr.GetString >> TimeZoneId) "timeZoneId"
|
||||||
|
IsPublic = (rdr.GetOrdinal >> rdr.GetBoolean) "isPublic" }
|
||||||
|
|
||||||
|
|
||||||
(*-- ENTITIES --*)
|
(*-- ENTITIES --*)
|
||||||
|
|
||||||
open NodaTime
|
open NodaTime
|
||||||
|
|
||||||
/// This represents a church
|
/// This represents a church
|
||||||
[<NoComparison; NoEquality>]
|
[<CLIMutable; NoComparison; NoEquality>]
|
||||||
type Church =
|
type Church =
|
||||||
{
|
{
|
||||||
/// The ID of this church
|
/// The ID of this church
|
||||||
@@ -286,9 +297,6 @@ type Church =
|
|||||||
[<NoComparison; NoEquality>]
|
[<NoComparison; NoEquality>]
|
||||||
type ListPreferences =
|
type ListPreferences =
|
||||||
{
|
{
|
||||||
/// The Id of the small group to which these preferences belong
|
|
||||||
SmallGroupId: SmallGroupId
|
|
||||||
|
|
||||||
/// The days after which regular requests expire
|
/// The days after which regular requests expire
|
||||||
DaysToExpire: int
|
DaysToExpire: int
|
||||||
|
|
||||||
@@ -350,8 +358,7 @@ type ListPreferences =
|
|||||||
|
|
||||||
/// A set of preferences with their default values
|
/// A set of preferences with their default values
|
||||||
static member Empty =
|
static member Empty =
|
||||||
{ SmallGroupId = SmallGroupId Guid.Empty
|
{ DaysToExpire = 14
|
||||||
DaysToExpire = 14
|
|
||||||
DaysToKeepNew = 7
|
DaysToKeepNew = 7
|
||||||
LongTermUpdateWeeks = 4
|
LongTermUpdateWeeks = 4
|
||||||
EmailFromName = "PrayerTracker"
|
EmailFromName = "PrayerTracker"
|
||||||
@@ -371,7 +378,7 @@ type ListPreferences =
|
|||||||
|
|
||||||
|
|
||||||
/// A member of a small group
|
/// A member of a small group
|
||||||
[<NoComparison; NoEquality>]
|
[<CLIMutable; NoComparison; NoEquality>]
|
||||||
type Member =
|
type Member =
|
||||||
{
|
{
|
||||||
/// The ID of the small group member
|
/// The ID of the small group member
|
||||||
@@ -400,7 +407,7 @@ type Member =
|
|||||||
|
|
||||||
|
|
||||||
/// This represents a small group (Sunday School class, Bible study group, etc.)
|
/// This represents a small group (Sunday School class, Bible study group, etc.)
|
||||||
[<NoComparison; NoEquality>]
|
[<CLIMutable; NoComparison; NoEquality>]
|
||||||
type SmallGroup =
|
type SmallGroup =
|
||||||
{
|
{
|
||||||
/// The ID of this small group
|
/// The ID of this small group
|
||||||
@@ -444,7 +451,7 @@ type SmallGroup =
|
|||||||
|
|
||||||
|
|
||||||
/// This represents a single prayer request
|
/// This represents a single prayer request
|
||||||
[<NoComparison; NoEquality>]
|
[<CLIMutable; NoComparison; NoEquality>]
|
||||||
type PrayerRequest =
|
type PrayerRequest =
|
||||||
{
|
{
|
||||||
/// The ID of this request
|
/// The ID of this request
|
||||||
@@ -515,7 +522,7 @@ type PrayerRequest =
|
|||||||
|
|
||||||
|
|
||||||
/// This represents a user of PrayerTracker
|
/// This represents a user of PrayerTracker
|
||||||
[<NoComparison; NoEquality>]
|
[<CLIMutable; NoComparison; NoEquality>]
|
||||||
type User =
|
type User =
|
||||||
{
|
{
|
||||||
/// The ID of this user
|
/// The ID of this user
|
||||||
@@ -556,20 +563,3 @@ type User =
|
|||||||
PasswordHash = ""
|
PasswordHash = ""
|
||||||
LastSeen = None
|
LastSeen = None
|
||||||
SmallGroups = [] }
|
SmallGroups = [] }
|
||||||
|
|
||||||
|
|
||||||
/// Cross-reference between user and small group
|
|
||||||
[<NoComparison; NoEquality>]
|
|
||||||
type UserSmallGroup =
|
|
||||||
{
|
|
||||||
/// The Id of the user who has access to the small group
|
|
||||||
UserId: UserId
|
|
||||||
|
|
||||||
/// The Id of the small group to which the user has access
|
|
||||||
SmallGroupId: SmallGroupId
|
|
||||||
}
|
|
||||||
|
|
||||||
/// An empty user/small group xref
|
|
||||||
static member Empty =
|
|
||||||
{ UserId = UserId Guid.Empty
|
|
||||||
SmallGroupId = SmallGroupId Guid.Empty }
|
|
||||||
|
|||||||
@@ -3,17 +3,13 @@
|
|||||||
<ItemGroup>
|
<ItemGroup>
|
||||||
<Compile Include="Entities.fs" />
|
<Compile Include="Entities.fs" />
|
||||||
<Compile Include="Access.fs" />
|
<Compile Include="Access.fs" />
|
||||||
<Compile Include="DistributedCache.fs" />
|
|
||||||
</ItemGroup>
|
</ItemGroup>
|
||||||
|
|
||||||
<ItemGroup>
|
<ItemGroup>
|
||||||
<PackageReference Include="BitBadger.Documents.Postgres" Version="3.1.0" />
|
|
||||||
<PackageReference Include="BitBadger.Documents.Sqlite" Version="4.0.1" />
|
<PackageReference Include="BitBadger.Documents.Sqlite" Version="4.0.1" />
|
||||||
<PackageReference Include="Giraffe" Version="7.0.2" />
|
<PackageReference Include="Giraffe" Version="7.0.2" />
|
||||||
<PackageReference Include="NodaTime" Version="3.2.1" />
|
<PackageReference Include="NodaTime" Version="3.2.1" />
|
||||||
<PackageReference Include="NodaTime.Serialization.SystemTextJson" Version="1.3.0" />
|
<PackageReference Include="NodaTime.Serialization.SystemTextJson" Version="1.3.0" />
|
||||||
<PackageReference Include="Npgsql.FSharp" Version="5.7.0" />
|
|
||||||
<PackageReference Include="Npgsql.NodaTime" Version="8.0.3" />
|
|
||||||
<PackageReference Update="FSharp.Core" Version="9.0.101" />
|
<PackageReference Update="FSharp.Core" Version="9.0.101" />
|
||||||
</ItemGroup>
|
</ItemGroup>
|
||||||
|
|
||||||
|
|||||||
@@ -2,14 +2,14 @@ FROM mcr.microsoft.com/dotnet/sdk:8.0-alpine AS build
|
|||||||
WORKDIR /pt
|
WORKDIR /pt
|
||||||
COPY ./PrayerTracker.sln ./
|
COPY ./PrayerTracker.sln ./
|
||||||
COPY ./Directory.Build.props ./
|
COPY ./Directory.Build.props ./
|
||||||
COPY ./PrayerTracker/PrayerTracker.fsproj ./PrayerTracker/
|
|
||||||
COPY ./Data/PrayerTracker.Data.fsproj ./Data/
|
COPY ./Data/PrayerTracker.Data.fsproj ./Data/
|
||||||
COPY ./PrayerTracker.Tests/PrayerTracker.Tests.fsproj ./PrayerTracker.Tests/
|
|
||||||
COPY ./UI/PrayerTracker.UI.fsproj ./UI/
|
COPY ./UI/PrayerTracker.UI.fsproj ./UI/
|
||||||
|
COPY ./PrayerTracker/PrayerTracker.fsproj ./PrayerTracker/
|
||||||
|
COPY ./Tests/PrayerTracker.Tests.fsproj ./Tests/
|
||||||
RUN dotnet restore
|
RUN dotnet restore
|
||||||
|
|
||||||
COPY . ./
|
COPY . ./
|
||||||
WORKDIR /pt/PrayerTracker.Tests
|
WORKDIR /pt/Tests
|
||||||
RUN dotnet run
|
RUN dotnet run
|
||||||
|
|
||||||
WORKDIR /pt/PrayerTracker
|
WORKDIR /pt/PrayerTracker
|
||||||
|
|||||||
@@ -15,6 +15,7 @@
|
|||||||
|
|
||||||
<ItemGroup>
|
<ItemGroup>
|
||||||
<PackageReference Include="BitBadger.Documents.Postgres" Version="4.0.1" />
|
<PackageReference Include="BitBadger.Documents.Postgres" Version="4.0.1" />
|
||||||
|
<PackageReference Include="Npgsql.NodaTime" Version="9.0.2" />
|
||||||
</ItemGroup>
|
</ItemGroup>
|
||||||
|
|
||||||
</Project>
|
</Project>
|
||||||
|
|||||||
@@ -39,8 +39,7 @@ module PgMappings =
|
|||||||
ChurchId = ChurchId (row.uuid "church_id")
|
ChurchId = ChurchId (row.uuid "church_id")
|
||||||
Name = row.string "group_name"
|
Name = row.string "group_name"
|
||||||
Preferences =
|
Preferences =
|
||||||
{ SmallGroupId = SmallGroupId (row.uuid "small_group_id")
|
{ DaysToKeepNew = row.int "days_to_keep_new"
|
||||||
DaysToKeepNew = row.int "days_to_keep_new"
|
|
||||||
DaysToExpire = row.int "days_to_expire"
|
DaysToExpire = row.int "days_to_expire"
|
||||||
LongTermUpdateWeeks = row.int "long_term_update_weeks"
|
LongTermUpdateWeeks = row.int "long_term_update_weeks"
|
||||||
EmailFromName = row.string "email_from_name"
|
EmailFromName = row.string "email_from_name"
|
||||||
@@ -81,7 +80,9 @@ task {
|
|||||||
Configuration.useConnectionString (Environment.GetEnvironmentVariable "PT_SQLITE_CONN")
|
Configuration.useConnectionString (Environment.GetEnvironmentVariable "PT_SQLITE_CONN")
|
||||||
do! Connection.setUp ()
|
do! Connection.setUp ()
|
||||||
|
|
||||||
use source = NpgsqlDataSourceBuilder(Environment.GetEnvironmentVariable "PT_PG_CONN").Build()
|
let builder = NpgsqlDataSourceBuilder(Environment.GetEnvironmentVariable "PT_PG_CONN")
|
||||||
|
let _ = builder.UseNodaTime()
|
||||||
|
use source = builder.Build()
|
||||||
|
|
||||||
let! churches =
|
let! churches =
|
||||||
Sql.fromDataSource source
|
Sql.fromDataSource source
|
||||||
@@ -123,8 +124,8 @@ task {
|
|||||||
for user in users do
|
for user in users do
|
||||||
let! groups =
|
let! groups =
|
||||||
Sql.fromDataSource source
|
Sql.fromDataSource source
|
||||||
|> Sql.query "SELECT small_group_id FROM pt.user_small_group WHERE user_id = :user_id"
|
|> Sql.query "SELECT small_group_id FROM pt.user_small_group WHERE user_id = @user_id"
|
||||||
|> Sql.parameters [ ":user_id", Sql.uuid user.Id.Value ]
|
|> Sql.parameters [ "@user_id", Sql.uuid user.Id.Value ]
|
||||||
|> Sql.executeAsync (fun row -> (row.uuid >> SmallGroupId) "small_group_id")
|
|> Sql.executeAsync (fun row -> (row.uuid >> SmallGroupId) "small_group_id")
|
||||||
do! Users.save { user with SmallGroups = groups }
|
do! Users.save { user with SmallGroups = groups }
|
||||||
printfn "Migrated %d users" users.Length
|
printfn "Migrated %d users" users.Length
|
||||||
|
|||||||
@@ -7,7 +7,7 @@ Project("{6EC3EE1D-3C4E-46DD-8F32-0CC8E7565705}") = "PrayerTracker", "PrayerTrac
|
|||||||
EndProject
|
EndProject
|
||||||
Project("{6EC3EE1D-3C4E-46DD-8F32-0CC8E7565705}") = "PrayerTracker.UI", "UI\PrayerTracker.UI.fsproj", "{EEE04A2B-818C-4241-90C5-69097CB0BF71}"
|
Project("{6EC3EE1D-3C4E-46DD-8F32-0CC8E7565705}") = "PrayerTracker.UI", "UI\PrayerTracker.UI.fsproj", "{EEE04A2B-818C-4241-90C5-69097CB0BF71}"
|
||||||
EndProject
|
EndProject
|
||||||
Project("{6EC3EE1D-3C4E-46DD-8F32-0CC8E7565705}") = "PrayerTracker.Tests", "PrayerTracker.Tests\PrayerTracker.Tests.fsproj", "{786E7BE9-9370-4117-B194-02CC2F71AA09}"
|
Project("{6EC3EE1D-3C4E-46DD-8F32-0CC8E7565705}") = "PrayerTracker.Tests", "Tests\PrayerTracker.Tests.fsproj", "{786E7BE9-9370-4117-B194-02CC2F71AA09}"
|
||||||
EndProject
|
EndProject
|
||||||
Project("{6EC3EE1D-3C4E-46DD-8F32-0CC8E7565705}") = "PrayerTracker.Data", "Data\PrayerTracker.Data.fsproj", "{2B5BA107-9BDA-4A1D-A9AF-AFEE6BF12270}"
|
Project("{6EC3EE1D-3C4E-46DD-8F32-0CC8E7565705}") = "PrayerTracker.Data", "Data\PrayerTracker.Data.fsproj", "{2B5BA107-9BDA-4A1D-A9AF-AFEE6BF12270}"
|
||||||
EndProject
|
EndProject
|
||||||
|
|||||||
@@ -40,10 +40,9 @@ module Configure =
|
|||||||
open BitBadger.Documents.Sqlite
|
open BitBadger.Documents.Sqlite
|
||||||
open Microsoft.AspNetCore.Authentication.Cookies
|
open Microsoft.AspNetCore.Authentication.Cookies
|
||||||
open Microsoft.AspNetCore.Localization
|
open Microsoft.AspNetCore.Localization
|
||||||
open Microsoft.Extensions.Caching.Distributed
|
|
||||||
open Microsoft.Extensions.DependencyInjection
|
open Microsoft.Extensions.DependencyInjection
|
||||||
|
open NeoSmart.Caching.Sqlite
|
||||||
open NodaTime
|
open NodaTime
|
||||||
open Npgsql
|
|
||||||
open PrayerTracker.Data
|
open PrayerTracker.Data
|
||||||
|
|
||||||
/// Configure ASP.NET Core's service collection (dependency injection container)
|
/// Configure ASP.NET Core's service collection (dependency injection container)
|
||||||
@@ -85,8 +84,10 @@ module Configure =
|
|||||||
if (emailCfg.GetChildren >> Seq.isEmpty >> not) () then
|
if (emailCfg.GetChildren >> Seq.isEmpty >> not) () then
|
||||||
ConfigurationBinder.Bind(emailCfg, Email.smtpOptions)
|
ConfigurationBinder.Bind(emailCfg, Email.smtpOptions)
|
||||||
|
|
||||||
let _ = svc.AddSingleton<IDistributedCache, DistributedCache>()
|
let cachePath = defaultArg (Option.ofObj (cfg.GetConnectionString "SessionDB")) "./data/session.db"
|
||||||
|
let _ = svc.AddSqliteCache(fun o -> o.CachePath <- cachePath)
|
||||||
let _ = svc.AddSession()
|
let _ = svc.AddSession()
|
||||||
|
let _ = svc.AddLogging()
|
||||||
let _ = svc.AddAntiforgery()
|
let _ = svc.AddAntiforgery()
|
||||||
let _ = svc.AddRouting()
|
let _ = svc.AddRouting()
|
||||||
let _ = svc.AddSingleton<IClock> SystemClock.Instance
|
let _ = svc.AddSingleton<IClock> SystemClock.Instance
|
||||||
@@ -219,8 +220,8 @@ module Configure =
|
|||||||
open Microsoft.Extensions.Options
|
open Microsoft.Extensions.Options
|
||||||
|
|
||||||
/// Configure the application
|
/// Configure the application
|
||||||
let app (app: IApplicationBuilder) =
|
let app (app: WebApplication) =
|
||||||
let env = app.ApplicationServices.GetRequiredService<IWebHostEnvironment>()
|
let env = app.Services.GetRequiredService<IWebHostEnvironment>()
|
||||||
|
|
||||||
if env.IsDevelopment() then
|
if env.IsDevelopment() then
|
||||||
app.UseDeveloperExceptionPage()
|
app.UseDeveloperExceptionPage()
|
||||||
@@ -232,24 +233,20 @@ module Configure =
|
|||||||
let _ = app.UseCanonicalDomains()
|
let _ = app.UseCanonicalDomains()
|
||||||
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.UseCookiePolicy(CookiePolicyOptions(MinimumSameSitePolicy = SameSiteMode.Strict))
|
|
||||||
|
|
||||||
let _ = app.UseMiddleware<RequestStartMiddleware>()
|
let _ = app.UseMiddleware<RequestStartMiddleware>()
|
||||||
let _ = app.UseRouting()
|
let _ = app.UseRouting()
|
||||||
let _ = app.UseSession()
|
let _ = app.UseSession()
|
||||||
|
let _ = app.UseRequestLocalization(app.Services.GetService<IOptions<RequestLocalizationOptions>>().Value)
|
||||||
let _ =
|
|
||||||
app.UseRequestLocalization(app.ApplicationServices.GetService<IOptions<RequestLocalizationOptions>>().Value)
|
|
||||||
|
|
||||||
let _ = app.UseAuthentication()
|
let _ = app.UseAuthentication()
|
||||||
let _ = app.UseAuthorization()
|
let _ = app.UseAuthorization()
|
||||||
let _ = app.UseEndpoints(fun e -> e.MapGiraffeEndpoints routes)
|
let _ = app.UseEndpoints(fun e -> e.MapGiraffeEndpoints routes)
|
||||||
|
|
||||||
app.ApplicationServices.GetRequiredService<IStringLocalizerFactory>()
|
app.Services.GetRequiredService<IStringLocalizerFactory>()
|
||||||
|> Views.I18N.setUpFactories
|
|> Views.I18N.setUpFactories
|
||||||
|
|
||||||
|
open Microsoft.Extensions.DependencyInjection
|
||||||
|
open Microsoft.Extensions.Logging
|
||||||
|
|
||||||
/// The web application
|
/// The web application
|
||||||
module App =
|
module App =
|
||||||
@@ -258,22 +255,32 @@ module App =
|
|||||||
|
|
||||||
[<EntryPoint>]
|
[<EntryPoint>]
|
||||||
let main args =
|
let main args =
|
||||||
let contentRoot = Directory.GetCurrentDirectory()
|
|
||||||
|
|
||||||
let app =
|
let contentRoot = Directory.GetCurrentDirectory()
|
||||||
WebHostBuilder()
|
let builder =
|
||||||
.UseContentRoot(contentRoot)
|
WebApplication.CreateBuilder(
|
||||||
|
WebApplicationOptions(
|
||||||
|
Args = args,
|
||||||
|
ApplicationName = "PrayerTracker",
|
||||||
|
ContentRootPath = contentRoot,
|
||||||
|
WebRootPath = Path.Combine(contentRoot, "wwwroot")))
|
||||||
|
let _ =
|
||||||
|
builder.WebHost
|
||||||
.ConfigureAppConfiguration(Configure.configuration)
|
.ConfigureAppConfiguration(Configure.configuration)
|
||||||
.UseKestrel(Configure.kestrel)
|
.ConfigureKestrel(Configure.kestrel)
|
||||||
.UseWebRoot(Path.Combine(contentRoot, "wwwroot"))
|
|
||||||
.ConfigureServices(Configure.services)
|
.ConfigureServices(Configure.services)
|
||||||
.ConfigureLogging(Configure.logging)
|
.ConfigureLogging(Configure.logging)
|
||||||
.Configure(System.Action<IApplicationBuilder> Configure.app)
|
|
||||||
.Build()
|
|
||||||
|
|
||||||
if args.Length > 0 then
|
use app = builder.Build()
|
||||||
printfn $"Unrecognized option {args[0]}"
|
|
||||||
else
|
Configure.app app
|
||||||
|
|
||||||
|
let fac = app.Services.GetRequiredService<ILoggerFactory>()
|
||||||
|
let log = fac.CreateLogger "PrayerTracker"
|
||||||
|
log.LogInformation "Application Started"
|
||||||
|
|
||||||
app.Run()
|
app.Run()
|
||||||
|
|
||||||
|
log.LogInformation "Application Shutting Down"
|
||||||
|
|
||||||
0
|
0
|
||||||
|
|||||||
@@ -12,7 +12,7 @@ let private findStats churchId = task {
|
|||||||
let! groups = SmallGroups.countByChurch churchId
|
let! groups = SmallGroups.countByChurch churchId
|
||||||
let! requests = PrayerRequests.countByChurch churchId
|
let! requests = PrayerRequests.countByChurch churchId
|
||||||
let! users = Users.countByChurch churchId
|
let! users = Users.countByChurch churchId
|
||||||
return shortGuid churchId.Value, { SmallGroups = int groups; PrayerRequests = requests; Users = users }
|
return shortGuid churchId.Value, { SmallGroups = int groups; PrayerRequests = int requests; Users = int users }
|
||||||
}
|
}
|
||||||
|
|
||||||
// POST /church/[church-id]/delete
|
// POST /church/[church-id]/delete
|
||||||
|
|||||||
@@ -1,29 +1,25 @@
|
|||||||
[<AutoOpen>]
|
[<AutoOpen>]
|
||||||
module PrayerTracker.Extensions
|
module PrayerTracker.Extensions
|
||||||
|
|
||||||
|
open BitBadger.Documents
|
||||||
open Microsoft.AspNetCore.Http
|
open Microsoft.AspNetCore.Http
|
||||||
open Newtonsoft.Json
|
|
||||||
open NodaTime
|
open NodaTime
|
||||||
open NodaTime.Serialization.JsonNet
|
|
||||||
open PrayerTracker.Data
|
open PrayerTracker.Data
|
||||||
open PrayerTracker.Entities
|
open PrayerTracker.Entities
|
||||||
open PrayerTracker.ViewModels
|
open PrayerTracker.ViewModels
|
||||||
|
|
||||||
/// JSON.NET serializer settings for NodaTime
|
|
||||||
let private jsonSettings = JsonSerializerSettings().ConfigureForNodaTime DateTimeZoneProviders.Tzdb
|
|
||||||
|
|
||||||
/// Extensions on the .NET session object
|
/// Extensions on the .NET session object
|
||||||
type ISession with
|
type ISession with
|
||||||
|
|
||||||
/// Set an object in the session
|
/// Set an object in the session
|
||||||
member this.SetObject<'T> key (value: 'T) =
|
member this.SetObject<'T> key (value: 'T) =
|
||||||
this.SetString(key, JsonConvert.SerializeObject(value, jsonSettings))
|
this.SetString(key, (Configuration.serializer ()).Serialize value)
|
||||||
|
|
||||||
/// Get an object from the session
|
/// Get an object from the session
|
||||||
member this.TryGetObject<'T> key =
|
member this.TryGetObject<'T> key =
|
||||||
match this.GetString key with
|
match this.GetString key with
|
||||||
| null -> None
|
| null -> None
|
||||||
| v -> Some (JsonConvert.DeserializeObject<'T>(v, jsonSettings))
|
| v -> Some ((Configuration.serializer ()).Deserialize<'T> v)
|
||||||
|
|
||||||
/// The currently logged on small group
|
/// The currently logged on small group
|
||||||
member this.CurrentGroup
|
member this.CurrentGroup
|
||||||
|
|||||||
@@ -27,7 +27,7 @@
|
|||||||
<ItemGroup>
|
<ItemGroup>
|
||||||
<PackageReference Include="BitBadger.AspNetCore.CanonicalDomains" Version="1.1.0" />
|
<PackageReference Include="BitBadger.AspNetCore.CanonicalDomains" Version="1.1.0" />
|
||||||
<PackageReference Include="Giraffe.Htmx" Version="2.0.4" />
|
<PackageReference Include="Giraffe.Htmx" Version="2.0.4" />
|
||||||
<PackageReference Include="NodaTime.Serialization.JsonNet" Version="3.1.0" />
|
<PackageReference Include="NeoSmart.Caching.Sqlite.AspNetCore" Version="9.0.0" />
|
||||||
<PackageReference Update="FSharp.Core" Version="9.0.101" />
|
<PackageReference Update="FSharp.Core" Version="9.0.101" />
|
||||||
</ItemGroup>
|
</ItemGroup>
|
||||||
|
|
||||||
|
|||||||
@@ -230,7 +230,7 @@ let savePreferences : HttpHandler = requireAccess [ User ] >=> validateCsrf >=>
|
|||||||
match! SmallGroups.tryById group.Id with
|
match! SmallGroups.tryById group.Id with
|
||||||
| Some group ->
|
| Some group ->
|
||||||
let pref = model.PopulatePreferences group.Preferences
|
let pref = model.PopulatePreferences group.Preferences
|
||||||
do! SmallGroups.savePreferences pref
|
do! SmallGroups.savePreferences group.Id pref
|
||||||
// Refresh session instance
|
// Refresh session instance
|
||||||
ctx.Session.CurrentGroup <- Some { group with Preferences = pref }
|
ctx.Session.CurrentGroup <- Some { group with Preferences = pref }
|
||||||
addInfo ctx ctx.Strings["Group preferences updated successfully"]
|
addInfo ctx ctx.Strings["Group preferences updated successfully"]
|
||||||
|
|||||||
0
src/PrayerTracker/data/.gitkeep
Normal file
0
src/PrayerTracker/data/.gitkeep
Normal file
@@ -121,7 +121,6 @@ let listPreferencesTests =
|
|||||||
}
|
}
|
||||||
test "Empty is as expected" {
|
test "Empty is as expected" {
|
||||||
let mt = ListPreferences.Empty
|
let mt = ListPreferences.Empty
|
||||||
Expect.equal mt.SmallGroupId.Value Guid.Empty "The small group ID should have been an empty GUID"
|
|
||||||
Expect.equal mt.DaysToExpire 14 "The default days to expire should have been 14"
|
Expect.equal mt.DaysToExpire 14 "The default days to expire should have been 14"
|
||||||
Expect.equal mt.DaysToKeepNew 7 "The default days to keep new should have been 7"
|
Expect.equal mt.DaysToKeepNew 7 "The default days to keep new should have been 7"
|
||||||
Expect.equal mt.LongTermUpdateWeeks 4 "The default long term update weeks should have been 4"
|
Expect.equal mt.LongTermUpdateWeeks 4 "The default long term update weeks should have been 4"
|
||||||
@@ -367,13 +366,3 @@ let userTests =
|
|||||||
Expect.equal user.Name "Unit Test" "The full name should be the first and last, separated by a space"
|
Expect.equal user.Name "Unit Test" "The full name should be the first and last, separated by a space"
|
||||||
}
|
}
|
||||||
]
|
]
|
||||||
|
|
||||||
[<Tests>]
|
|
||||||
let userSmallGroupTests =
|
|
||||||
testList "UserSmallGroup" [
|
|
||||||
test "Empty is as expected" {
|
|
||||||
let mt = UserSmallGroup.Empty
|
|
||||||
Expect.equal mt.UserId.Value Guid.Empty "The user ID should have been an empty GUID"
|
|
||||||
Expect.equal mt.SmallGroupId.Value Guid.Empty "The small group ID should have been an empty GUID"
|
|
||||||
}
|
|
||||||
]
|
|
||||||
@@ -182,13 +182,6 @@ let toHtmlIds it =
|
|||||||
let renderHtmlNode = RenderView.AsString.htmlNode
|
let renderHtmlNode = RenderView.AsString.htmlNode
|
||||||
|
|
||||||
|
|
||||||
open Giraffe.Fixi
|
|
||||||
|
|
||||||
/// Create a page link that will make the request with fixi
|
|
||||||
let pageLink href attrs content =
|
|
||||||
a (List.append [ _href href; _fxGet; _fxAction href; _fxTarget "#pt-body" ] attrs) content
|
|
||||||
|
|
||||||
|
|
||||||
open Microsoft.AspNetCore.Html
|
open Microsoft.AspNetCore.Html
|
||||||
|
|
||||||
/// Render an HTML node, then return the value as an HTML string
|
/// Render an HTML node, then return the value as an HTML string
|
||||||
@@ -224,6 +217,10 @@ module TimeZones =
|
|||||||
|
|
||||||
open Giraffe.ViewEngine.Htmx
|
open Giraffe.ViewEngine.Htmx
|
||||||
|
|
||||||
|
/// Create a page link that will make the request with fixi
|
||||||
|
let pageLink href attrs content =
|
||||||
|
a (List.append [ _href href; _hxGet href ] attrs) content
|
||||||
|
|
||||||
/// Known htmx targets
|
/// Known htmx targets
|
||||||
module Target =
|
module Target =
|
||||||
|
|
||||||
|
|||||||
@@ -274,11 +274,11 @@ let private partialHead pgTitle =
|
|||||||
let private pageLayout viewInfo pgTitle content =
|
let private pageLayout viewInfo pgTitle content =
|
||||||
body [] [
|
body [] [
|
||||||
Navigation.top viewInfo
|
Navigation.top viewInfo
|
||||||
div [ _id "pt-body" ] (contentSection viewInfo pgTitle content)
|
div [ _id "pt-body"; Target.content ] (contentSection viewInfo pgTitle content)
|
||||||
match viewInfo.Layout with
|
match viewInfo.Layout with
|
||||||
| FullPage ->
|
| FullPage ->
|
||||||
script [ _src "/js/ckeditor/ckeditor.js" ] []
|
script [ _src "/js/ckeditor/ckeditor.js" ] []
|
||||||
script [ _src "/_/fixi-0.5.7.js" ] []
|
Htmx.Script.minified
|
||||||
script [ _src "/_/app.js" ] []
|
script [ _src "/_/app.js" ] []
|
||||||
| _ -> () ]
|
| _ -> () ]
|
||||||
|
|
||||||
@@ -348,4 +348,3 @@ let help pageTitle isHome content =
|
|||||||
p [ _class "pt-center-text" ] [
|
p [ _class "pt-center-text" ] [
|
||||||
a [ _href "/help"; _title s["Help Index"].Value ] [
|
a [ _href "/help"; _title s["Help Index"].Value ] [
|
||||||
rawText "« "; locStr s["Back to Help Index"] ] ] ] ] ] ] ]
|
rawText "« "; locStr s["Back to Help Index"] ] ] ] ] ] ] ]
|
||||||
|
|
||||||
@@ -15,15 +15,9 @@
|
|||||||
</ItemGroup>
|
</ItemGroup>
|
||||||
|
|
||||||
<ItemGroup>
|
<ItemGroup>
|
||||||
<PackageReference Include="Giraffe.Fixi" Version="0.5.7" />
|
|
||||||
<PackageReference Include="Giraffe.ViewEngine" Version="1.4.0" />
|
<PackageReference Include="Giraffe.ViewEngine" Version="1.4.0" />
|
||||||
<PackageReference Include="Giraffe.ViewEngine.Htmx" Version="2.0.4" />
|
<PackageReference Include="Giraffe.ViewEngine.Htmx" Version="2.0.4" />
|
||||||
<PackageReference Include="MailKit" Version="4.10.0" />
|
<PackageReference Include="MailKit" Version="4.10.0" />
|
||||||
<PackageReference Include="Microsoft.AspNetCore.Html.Abstractions" Version="2.3.0" />
|
|
||||||
<PackageReference Include="Microsoft.AspNetCore.Http" Version="2.3.0" />
|
|
||||||
<PackageReference Include="Microsoft.AspNetCore.Http.Extensions" Version="2.3.0" />
|
|
||||||
<PackageReference Include="Microsoft.AspNetCore.Mvc" Version="2.3.0" />
|
|
||||||
<PackageReference Include="Newtonsoft.Json" Version="13.0.3" />
|
|
||||||
<PackageReference Update="FSharp.Core" Version="9.0.101" />
|
<PackageReference Update="FSharp.Core" Version="9.0.101" />
|
||||||
</ItemGroup>
|
</ItemGroup>
|
||||||
|
|
||||||
|
|||||||
Reference in New Issue
Block a user