WIP on SQL migration

This commit is contained in:
Daniel J. Summers 2022-08-13 11:05:59 -04:00
parent e621cd6a1f
commit 29ff0afc6c
4 changed files with 172 additions and 17 deletions

View File

@ -52,6 +52,22 @@ module private Helpers =
SmallGroup = SmallGroup.empty
}
/// Map a row to a Prayer Request instance
let mapToPrayerRequest (row : RowReader) =
{ 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.fromCode (row.string "request_id")
Expiration = Expiration.fromCode (row.string "expiration")
User = User.empty
SmallGroup = SmallGroup.empty
}
/// Map a row to a Small Group instance
let mapToSmallGroup (row : RowReader) =
{ Id = SmallGroupId (row.uuid "id")
@ -64,6 +80,14 @@ module private Helpers =
Users = ResizeArray ()
}
/// Map a row to a Small Group information set
let mapToSmallGroupInfo (row : RowReader) =
{ Id = Giraffe.ShortGuid.fromGuid (row.uuid "id")
Name = row.string "group_name"
ChurchName = row.string "church_name"
TimeZoneId = TimeZoneId (row.string "time_zone_id")
}
/// Map a row to a Small Group list item
let mapToSmallGroupItem (row : RowReader) =
Giraffe.ShortGuid.fromGuid (row.uuid "id"), $"""{row.string "church_name"} | {row.string "group_name"}"""
@ -156,6 +180,14 @@ module Churches =
/// Functions to manipulate small group members
module Members =
/// Count members for the given small group
let countByGroup (groupId : SmallGroupId) conn =
conn
|> Sql.existingConnection
|> Sql.query "SELECT COUNT(id) AS mbr_count FROM pt.member WHERE small_group_id = @groupId"
|> Sql.parameters [ "@groupId", Sql.uuid groupId.Value ]
|> Sql.executeRowAsync (fun row -> row.int "mbr_count")
/// Delete a small group member by its ID
let deleteById (memberId : MemberId) conn = backgroundTask {
let! _ =
@ -167,6 +199,14 @@ module Members =
return ()
}
/// Retrieve all members for a given small group
let forGroup (groupId : SmallGroupId) conn =
conn
|> Sql.existingConnection
|> Sql.query "SELECT * FROM pt.member WHERE small_group_id = @groupId ORDER BY member_name"
|> Sql.parameters [ "@groupId", Sql.uuid groupId.Value ]
|> Sql.executeAsync mapToMember
/// Retrieve a small group member by its ID
let tryById (memberId : MemberId) conn = backgroundTask {
let! mbr =
@ -179,9 +219,38 @@ module Members =
}
/// Options to retrieve a list of requests
type PrayerRequestOptions =
{ /// The small group for which requests should be retrieved
SmallGroup : SmallGroup
/// The clock instance to use for date/time manipulation
Clock : IClock
/// The date for which the list is being retrieved
ListDate : LocalDate option
/// Whether only active requests should be retrieved
ActiveOnly : bool
/// The page number, for paged lists
PageNumber : int
}
/// Functions to manipulate prayer requests
module PrayerRequests =
/// Central place to append sort criteria for prayer request queries
let private orderBy sort =
match sort with
| SortByDate -> "DESC updated_date, DESC entered_date, requestor"
| SortByRequestor -> "requestor, DESC updated_date, DESC entered_date"
/// Paginate a prayer request query
let private paginate (pageNbr : int) pageSize =
if pageNbr > 0 then $"LIMIT {pageSize} OFFSET {(pageNbr - 1) * pageSize}" else ""
/// Count the number of prayer requests for a church
let countByChurch (churchId : ChurchId) conn =
conn
@ -200,8 +269,40 @@ module PrayerRequests =
|> Sql.query "SELECT COUNT(id) AS req_count FROM pt.prayer_request WHERE small_group_id = @groupId"
|> Sql.parameters [ "@groupId", Sql.uuid groupId.Value ]
|> Sql.executeRowAsync (fun row -> row.int "req_count")
/// Get all (or active) requests for a small group as of now or the specified date
let forGroup (opts : PrayerRequestOptions) conn =
let theDate = defaultArg opts.ListDate (SmallGroup.localDateNow opts.Clock opts.SmallGroup)
let where, parameters =
if opts.ActiveOnly then
let asOf = NpgsqlParameter (
"@asOf",
(theDate.AtStartOfDayInZone(SmallGroup.timeZone opts.SmallGroup)
- Duration.FromDays opts.SmallGroup.Preferences.DaysToExpire)
.ToInstant ())
""" AND ( updatedDate > @asOf
OR expiration = @manual
OR request_type = @longTerm
OR request_type = @expecting)
AND expiration <> @forced""",
[ "@asOf", Sql.parameter asOf
"@manual", Sql.string (Expiration.toCode Manual)
"@longTerm", Sql.string (PrayerRequestType.toCode LongTermRequest)
"@expecting", Sql.string (PrayerRequestType.toCode Expecting)
"@forced", Sql.string (Expiration.toCode Forced) ]
else "", []
conn
|> Sql.existingConnection
|> Sql.query $"""
SELECT *
FROM prayer_request
WHERE small_group_id = @groupId {where}
ORDER BY {orderBy opts.SmallGroup.Preferences.RequestSort}
{paginate opts.PageNumber opts.SmallGroup.Preferences.PageSize}"""
|> Sql.parameters (("@groupId", Sql.uuid opts.SmallGroup.Id.Value) :: parameters)
|> Sql.executeAsync mapToPrayerRequest
/// Functions to retrieve small group information
module SmallGroups =
@ -227,6 +328,18 @@ module SmallGroups =
return ()
}
/// Get information for all small groups
let infoForAll conn =
conn
|> Sql.existingConnection
|> Sql.query """
SELECT sg.id, c.church_name, lp.time_zone_id
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"""
|> Sql.executeAsync mapToSmallGroupInfo
/// Get a list of small group IDs along with a description that includes the church name
let listAll conn =
conn
@ -251,6 +364,22 @@ module SmallGroups =
ORDER BY c.church_name, g.group_name"""
|> Sql.executeAsync mapToSmallGroupItem
/// Log on for a small group (includes list preferences)
let logOn (groupId : SmallGroupId) password conn = backgroundTask {
let! group =
conn
|> Sql.existingConnection
|> Sql.query """
SELECT sg.*, lp.*
FROM pt.small_group sg
INNER JOIN pt.list_preference lp ON lp.small_group_id = sg.id
WHERE sg.id = @id
AND lp.group_password = @password"""
|> Sql.parameters [ "@id", Sql.uuid groupId.Value; "@password", Sql.string password ]
|> Sql.executeAsync mapToSmallGroupWithPreferences
return List.tryHead group
}
/// Get a small group by its ID
let tryById (groupId : SmallGroupId) conn = backgroundTask {
let! group =
@ -345,7 +474,7 @@ module Users =
|> Sql.executeAsync mapToUser
/// Save a user's information
let save user conn = backgroundTask {
let save (user : User) conn = backgroundTask {
let! _ =
conn
|> Sql.existingConnection
@ -410,7 +539,7 @@ module Users =
}
/// Update a user's password hash
let updatePassword user conn = backgroundTask {
let updatePassword (user : User) conn = backgroundTask {
let! _ =
conn
|> Sql.existingConnection

View File

@ -956,3 +956,20 @@ module PrayerRequest =
if isExpired asOf group req then false
else asOf.PlusWeeks -group.Preferences.LongTermUpdateWeeks
>= req.UpdatedDate.InZone(SmallGroup.timeZone group).Date
/// Information needed to display the small group maintenance page
[<NoComparison; NoEquality>]
type SmallGroupInfo =
{ /// The ID of the small group
Id : string
/// The name of the small group
Name : string
/// The name of the church to which the small group belongs
ChurchName : string
/// The ID of the time zone for the small group
TimeZoneId : TimeZoneId
}

View File

@ -178,7 +178,7 @@ let logOn (groups : (string * string) list) grpId ctx viewInfo =
/// View for the small group maintenance page
let maintain (groups : SmallGroup list) ctx viewInfo =
let maintain (groups : SmallGroupInfo list) ctx viewInfo =
let s = I18N.localizer.Force ()
let vi = AppViewInfo.withScopedStyles [ "#groupList { grid-template-columns: repeat(4, auto); }" ] viewInfo
let groupTable =
@ -193,13 +193,12 @@ let maintain (groups : SmallGroup list) ctx viewInfo =
header [ _class "cell" ] [ locStr s["Time Zone"] ]
]
for group in groups do
let grpId = shortGuid group.Id.Value
let delAction = $"/small-group/{grpId}/delete"
let delAction = $"/small-group/{group.Id}/delete"
let delPrompt = s["Are you sure you want to delete this {0}? This action cannot be undone.",
$"""{s["Small Group"].Value.ToLower ()} ({group.Name})""" ].Value
div [ _class "row" ] [
div [ _class "cell actions" ] [
a [ _href $"/small-group/{grpId}/edit"; _title s["Edit This Group"].Value ] [
a [ _href $"/small-group/{group.Id}/edit"; _title s["Edit This Group"].Value ] [
iconSized 18 "edit"
]
a [ _href delAction
@ -210,8 +209,8 @@ let maintain (groups : SmallGroup list) ctx viewInfo =
]
]
div [ _class "cell" ] [ str group.Name ]
div [ _class "cell" ] [ str group.Church.Name ]
div [ _class "cell" ] [ locStr (TimeZones.name group.Preferences.TimeZoneId s) ]
div [ _class "cell" ] [ str group.ChurchName ]
div [ _class "cell" ] [ locStr (TimeZones.name group.TimeZoneId s) ]
]
]
[ div [ _class "pt-center-text" ] [

View File

@ -107,8 +107,9 @@ open Microsoft.AspNetCore.Authentication.Cookies
let logOnSubmit : HttpHandler = requireAccess [ AccessLevel.Public ] >=> validateCsrf >=> fun next ctx -> task {
match! ctx.TryBindFormAsync<GroupLogOn> () with
| Ok model ->
let s = Views.I18N.localizer.Force ()
match! ctx.Db.TryGroupLogOnByPassword (idFromShort SmallGroupId model.SmallGroupId) model.Password with
let s = Views.I18N.localizer.Force ()
let! conn = ctx.Conn
match! SmallGroups.logOn (idFromShort SmallGroupId model.SmallGroupId) model.Password conn with
| Some group ->
ctx.Session.CurrentGroup <- Some group
let identity = ClaimsIdentity (
@ -129,7 +130,8 @@ let logOnSubmit : HttpHandler = requireAccess [ AccessLevel.Public ] >=> validat
/// GET /small-groups
let maintain : HttpHandler = requireAccess [ Admin ] >=> fun next ctx -> task {
let! groups = ctx.Db.AllGroups ()
let! conn = ctx.Conn
let! groups = SmallGroups.infoForAll conn
return!
viewInfo ctx
|> Views.SmallGroup.maintain groups ctx
@ -140,7 +142,8 @@ let maintain : HttpHandler = requireAccess [ Admin ] >=> fun next ctx -> task {
let members : HttpHandler = requireAccess [ User ] >=> fun next ctx -> task {
let group = ctx.Session.CurrentGroup.Value
let s = Views.I18N.localizer.Force ()
let! members = ctx.Db.AllMembersForSmallGroup group.Id
let! conn = ctx.Conn
let! members = Members.forGroup group.Id conn
let types = ReferenceList.emailTypeList group.Preferences.DefaultEmailType s |> Map.ofSeq
return!
{ viewInfo ctx with HelpLink = Some Help.maintainGroupMembers }
@ -152,10 +155,16 @@ let members : HttpHandler = requireAccess [ User ] >=> fun next ctx -> task {
let overview : HttpHandler = requireAccess [ User ] >=> fun next ctx -> task {
let group = ctx.Session.CurrentGroup.Value
let! conn = ctx.Conn
let! reqs = ctx.Db.AllRequestsForSmallGroup group ctx.Clock None true 0
let! reqCount = ctx.Db.CountRequestsBySmallGroup group.Id
let! mbrCount = ctx.Db.CountMembersForSmallGroup group.Id
let! admins = Users.listByGroupId group.Id conn
let! reqs = PrayerRequests.forGroup
{ SmallGroup = group
Clock = ctx.Clock
ListDate = None
ActiveOnly = true
PageNumber = 0
} conn
let! reqCount = PrayerRequests.countByGroup group.Id conn
let! mbrCount = Members.countByGroup group.Id conn
let! admins = Users.listByGroupId group.Id conn
let model =
{ TotalActiveReqs = List.length reqs
AllReqs = reqCount
@ -177,6 +186,7 @@ let overview : HttpHandler = requireAccess [ User ] >=> fun next ctx -> task {
/// GET /small-group/preferences
let preferences : HttpHandler = requireAccess [ User ] >=> fun next ctx -> task {
// TODO: stopped here
let group = ctx.Session.CurrentGroup.Value
let! tzs = ctx.Db.AllTimeZones ()
return!