bit-badger/myWebLog
1
0
Fork 0
Code Issues 4 Pull Requests Packages Projects Releases 11 Activity

Eliminate compiler warnings

Browse Source 
- Change RethinkDB to use connection-string style settings
This commit is contained in:
Daniel J. Summers
2022-07-19 20:59:53 -04:00
parent 7eaad4a076
commit 1e987fdf72
9 changed files with 178 additions and 172 deletions
Download Patch File Download Diff File Expand all files Collapse all files

61
src/MyWebLog/Handlers/Page.fs
View File

@@ -172,55 +172,28 @@ let deleteRevision (pgId, revDate) : HttpHandler = requireAccess Author >=> fun
| _, None -> return! Error.notFound next ctx
}
//#nowarn "3511"
open System.Threading.Tasks
// POST /admin/page/save
let save : HttpHandler = requireAccess Author >=> fun next ctx -> task {
let! model = ctx.BindFormAsync<EditPageModel> ()
let data = ctx.Data
let now = DateTime.UtcNow
let pg =
match model.PageId with
| "new" ->
Task.FromResult (
Some
{ Page.empty with
Id = PageId.create ()
WebLogId = ctx.WebLog.Id
AuthorId = ctx.UserId
PublishedOn = now
})
| pgId -> data.Page.FindFullById (PageId pgId) ctx.WebLog.Id
match! pg with
let! model = ctx.BindFormAsync<EditPageModel> ()
let data = ctx.Data
let now = DateTime.UtcNow
let tryPage =
if model.IsNew then Task.FromResult (
Some
{ Page.empty with
Id = PageId.create ()
WebLogId = ctx.WebLog.Id
AuthorId = ctx.UserId
PublishedOn = now
})
else data.Page.FindFullById (PageId model.PageId) ctx.WebLog.Id
match! tryPage with
| Some page when canEdit page.AuthorId ctx ->
let updateList = page.IsInPageList <> model.IsShownInPageList
let revision = { AsOf = now; Text = MarkupText.parse $"{model.Source}: {model.Text}" }
// Detect a permalink change, and add the prior one to the prior list
let page =
match Permalink.toString page.Permalink with
| "" -> page
| link when link = model.Permalink -> page
| _ -> { page with PriorPermalinks = page.Permalink :: page.PriorPermalinks }
let page =
{ page with
Title = model.Title
Permalink = Permalink model.Permalink
UpdatedOn = now
IsInPageList = model.IsShownInPageList
Template = match model.Template with "" -> None | tmpl -> Some tmpl
Text = MarkupText.toHtml revision.Text
Metadata = Seq.zip model.MetaNames model.MetaValues
|> Seq.filter (fun it -> fst it > "")
|> Seq.map (fun it -> { Name = fst it; Value = snd it })
|> Seq.sortBy (fun it -> $"{it.Name.ToLower ()} {it.Value.ToLower ()}")
|> List.ofSeq
Revisions = match page.Revisions |> List.tryHead with
| Some r when r.Text = revision.Text -> page.Revisions
| _ -> revision :: page.Revisions
}
do! (if model.PageId = "new" then data.Page.Add else data.Page.Update) page
let updateList = page.IsInPageList <> model.IsShownInPageList
let updatedPage = model.UpdatePage page now
do! (if model.PageId = "new" then data.Page.Add else data.Page.Update) updatedPage
if updateList then do! PageListCache.update ctx
do! addMessage ctx { UserMessage.success with Message = "Page saved successfully" }
return! redirectToGet $"admin/page/{PageId.toString page.Id}/edit" next ctx

56
src/MyWebLog/Handlers/Post.fs
View File

@@ -376,50 +376,42 @@ let deleteRevision (postId, revDate) : HttpHandler = requireAccess Author >=> fu
| _, None -> return! Error.notFound next ctx
}
//#nowarn "3511"
// POST /admin/post/save
let save : HttpHandler = requireAccess Author >=> fun next ctx -> task {
let! model = ctx.BindFormAsync<EditPostModel> ()
let data = ctx.Data
let now = DateTime.UtcNow
let tryPost =
if model.PostId = "new" then
Task.FromResult (
Some
{ Post.empty with
Id = PostId.create ()
WebLogId = ctx.WebLog.Id
AuthorId = ctx.UserId
})
if model.IsNew then Task.FromResult (
Some
{ Post.empty with
Id = PostId.create ()
WebLogId = ctx.WebLog.Id
AuthorId = ctx.UserId
})
else data.Post.FindFullById (PostId model.PostId) ctx.WebLog.Id
match! tryPost with
| Some post when canEdit post.AuthorId ctx ->
let priorCats = post.CategoryIds
let revision = { AsOf = now; Text = MarkupText.parse $"{model.Source}: {model.Text}" }
// Detect a permalink change, and add the prior one to the prior list
let post =
match Permalink.toString post.Permalink with
| "" -> post
| link when link = model.Permalink -> post
| _ -> { post with PriorPermalinks = post.Permalink :: post.PriorPermalinks }
let post = model.UpdatePost post revision now
let post =
if model.SetPublished then
let dt = parseToUtc (model.PubOverride.Value.ToString "o")
if model.SetUpdated then
{ post with
PublishedOn = Some dt
UpdatedOn = dt
Revisions = [ { (List.head post.Revisions) with AsOf = dt } ]
}
else { post with PublishedOn = Some dt }
else post
do! (if model.PostId = "new" then data.Post.Add else data.Post.Update) post
let priorCats = post.CategoryIds
let updatedPost =
model.UpdatePost post now
|> function
| post ->
if model.SetPublished then
let dt = parseToUtc (model.PubOverride.Value.ToString "o")
if model.SetUpdated then
{ post with
PublishedOn = Some dt
UpdatedOn = dt
Revisions = [ { (List.head post.Revisions) with AsOf = dt } ]
}
else { post with PublishedOn = Some dt }
else post
do! (if model.PostId = "new" then data.Post.Add else data.Post.Update) updatedPost
// If the post was published or its categories changed, refresh the category cache
if model.DoPublish
|| not (priorCats
|> List.append post.CategoryIds
|> List.append updatedPost.CategoryIds
|> List.distinct
|> List.length = List.length priorCats) then
do! CategoryCache.update ctx

47
src/MyWebLog/Handlers/User.fs
View File

@@ -91,30 +91,29 @@ let saveMyInfo : HttpHandler = requireAccess Author >=> fun next ctx -> task {
let! model = ctx.BindFormAsync<EditMyInfoModel> ()
let data = ctx.Data
match! data.WebLogUser.FindById ctx.UserId ctx.WebLog.Id with
| Some user when model.NewPassword = model.NewPasswordConfirm ->
let pw, salt =
if model.NewPassword = "" then
user.PasswordHash, user.Salt
else
let newSalt = Guid.NewGuid ()
hashedPassword model.NewPassword user.Email newSalt, newSalt
let user =
{ user with
FirstName = model.FirstName
LastName = model.LastName
PreferredName = model.PreferredName
PasswordHash = pw
Salt = salt
}
do! data.WebLogUser.Update user
let pwMsg = if model.NewPassword = "" then "" else " and updated your password"
do! addMessage ctx { UserMessage.success with Message = $"Saved your information{pwMsg} successfully" }
return! redirectToGet "admin/user/my-info" next ctx
| Some user ->
if model.NewPassword = model.NewPasswordConfirm then
let pw, salt =
if model.NewPassword = "" then
user.PasswordHash, user.Salt
else
let newSalt = Guid.NewGuid ()
hashedPassword model.NewPassword user.Email newSalt, newSalt
let user =
{ user with
FirstName = model.FirstName
LastName = model.LastName
PreferredName = model.PreferredName
PasswordHash = pw
Salt = salt
}
do! data.WebLogUser.Update user
let pwMsg = if model.NewPassword = "" then "" else " and updated your password"
do! addMessage ctx { UserMessage.success with Message = $"Saved your information{pwMsg} successfully" }
return! redirectToGet "admin/user/my-info" next ctx
else
do! addMessage ctx { UserMessage.error with Message = "Passwords did not match; no updates made" }
return! showMyInfo user (Hash.FromAnonymousObject {|
model = { model with NewPassword = ""; NewPasswordConfirm = "" }
|}) next ctx
do! addMessage ctx { UserMessage.error with Message = "Passwords did not match; no updates made" }
return! showMyInfo user (Hash.FromAnonymousObject {|
model = { model with NewPassword = ""; NewPasswordConfirm = "" }
|}) next ctx
| None -> return! Error.notFound next ctx
}

31
src/MyWebLog/Program.fs
View File

@@ -39,26 +39,27 @@ module DataImplementation =
/// Get the configured data implementation
let get (sp : IServiceProvider) : IData =
let config = sp.GetRequiredService<IConfiguration> ()
if (config.GetConnectionString >> isNull >> not) "SQLite" then
let config = sp.GetRequiredService<IConfiguration> ()
let await it = (Async.AwaitTask >> Async.RunSynchronously) it
let connStr name = config.GetConnectionString name
let hasConnStr name = (connStr >> isNull >> not) name
let createSQLite connStr =
let log = sp.GetRequiredService<ILogger<SQLiteData>> ()
let conn = new SqliteConnection (config.GetConnectionString "SQLite")
let conn = new SqliteConnection (connStr)
log.LogInformation $"Using SQL database {conn.DataSource}"
SQLiteData.setUpConnection conn |> Async.AwaitTask |> Async.RunSynchronously
upcast SQLiteData (conn, sp.GetRequiredService<ILogger<SQLiteData>> ())
elif (config.GetSection "RethinkDB").Exists () then
await (SQLiteData.setUpConnection conn)
SQLiteData (conn, log)
if hasConnStr "SQLite" then
upcast createSQLite (connStr "SQLite")
elif hasConnStr "RethinkDB" then
let log = sp.GetRequiredService<ILogger<RethinkDbData>> ()
Json.all () |> Seq.iter Converter.Serializer.Converters.Add
let rethinkCfg = DataConfig.FromConfiguration (config.GetSection "RethinkDB")
let conn = rethinkCfg.CreateConnectionAsync () |> Async.AwaitTask |> Async.RunSynchronously
log.LogInformation $"Using RethinkDB database {rethinkCfg.Database}"
upcast RethinkDbData (conn, rethinkCfg, sp.GetRequiredService<ILogger<RethinkDbData>> ())
let rethinkCfg = DataConfig.FromUri (connStr "RethinkDB")
let conn = await (rethinkCfg.CreateConnectionAsync log)
upcast RethinkDbData (conn, rethinkCfg, log)
else
let log = sp.GetRequiredService<ILogger<SQLiteData>> ()
log.LogInformation "Using default SQLite database myweblog.db"
let conn = new SqliteConnection ("Data Source=./myweblog.db;Cache=Shared")
SQLiteData.setUpConnection conn |> Async.AwaitTask |> Async.RunSynchronously
upcast SQLiteData (conn, log)
upcast createSQLite "Data Source=./myweblog.db;Cache=Shared"
open Giraffe