bit-badger/myWebLog
1
0
Fork 0
Code Issues 2 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
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

2
src/MyWebLog.Data/MyWebLog.Data.fsproj
View File

@ -16,7 +16,7 @@
<PackageReference Include="Microsoft.FSharpLu.Json" Version="0.11.7" />
<PackageReference Include="Newtonsoft.Json" Version="13.0.1" />
<PackageReference Include="RethinkDb.Driver" Version="2.3.150" />
<PackageReference Include="RethinkDb.Driver.FSharp" Version="0.9.0-beta-06" />
<PackageReference Include="RethinkDb.Driver.FSharp" Version="0.9.0-beta-07" />
<PackageReference Update="FSharp.Core" Version="6.0.5" />
</ItemGroup>

2
src/MyWebLog.Data/RethinkDbData.fs
View File

@ -676,7 +676,7 @@ type RethinkDbData (conn : Net.IConnection, config : DataConfig, log : ILogger<R
member _.FindByWebLog webLogId = rethink<TagMap list> {
withTable Table.TagMap
between [| webLogId :> obj; r.Minval () |] [| webLogId :> obj, r.Maxval () |]
between [| webLogId :> obj; r.Minval () |] [| webLogId :> obj; r.Maxval () |]
[ Index Index.WebLogAndTag ]
orderBy (nameof TagMap.empty.Tag)
result; withRetryDefault conn

143
src/MyWebLog.Domain/ViewModels.fs
View File

@ -469,6 +469,36 @@ type EditPageModel =
MetaNames = page.Metadata |> List.map (fun m -> m.Name) |> Array.ofList
MetaValues = page.Metadata |> List.map (fun m -> m.Value) |> Array.ofList
}
/// Whether this is a new page
member this.IsNew = this.PageId = "new"
/// Update a page with values from this model
member this.UpdatePage (page : Page) now =
let revision = { AsOf = now; Text = MarkupText.parse $"{this.Source}: {this.Text}" }
// Detect a permalink change, and add the prior one to the prior list
match Permalink.toString page.Permalink with
| "" -> page
| link when link = this.Permalink -> page
| _ -> { page with PriorPermalinks = page.Permalink :: page.PriorPermalinks }
|> function
| page ->
{ page with
Title = this.Title
Permalink = Permalink this.Permalink
UpdatedOn = now
IsInPageList = this.IsShownInPageList
Template = match this.Template with "" -> None | tmpl -> Some tmpl
Text = MarkupText.toHtml revision.Text
Metadata = Seq.zip this.MetaNames this.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
}
/// View model to edit a post
@ -617,58 +647,69 @@ type EditPostModel =
EpisodeDescription = defaultArg episode.EpisodeDescription ""
}
/// Whether this is a new post
member this.IsNew = this.PostId = "new"
/// Update a post with values from the submitted form
member this.UpdatePost (post : Post) (revision : Revision) now =
{ post with
Title = this.Title
Permalink = Permalink this.Permalink
PublishedOn = if this.DoPublish then Some now else post.PublishedOn
UpdatedOn = now
Text = MarkupText.toHtml revision.Text
Tags = this.Tags.Split ","
|> Seq.ofArray
|> Seq.map (fun it -> it.Trim().ToLower ())
|> Seq.filter (fun it -> it <> "")
|> Seq.sort
|> List.ofSeq
Template = match this.Template.Trim () with "" -> None | tmpl -> Some tmpl
CategoryIds = this.CategoryIds |> Array.map CategoryId |> List.ofArray
Status = if this.DoPublish then Published else post.Status
Metadata = Seq.zip this.MetaNames this.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 post.Revisions |> List.tryHead with
| Some r when r.Text = revision.Text -> post.Revisions
| _ -> revision :: post.Revisions
Episode =
if this.IsEpisode then
Some {
Media = this.Media
Length = this.Length
Duration = noneIfBlank this.Duration |> Option.map TimeSpan.Parse
MediaType = noneIfBlank this.MediaType
ImageUrl = noneIfBlank this.ImageUrl
Subtitle = noneIfBlank this.Subtitle
Explicit = noneIfBlank this.Explicit |> Option.map ExplicitRating.parse
ChapterFile = noneIfBlank this.ChapterFile
ChapterType = noneIfBlank this.ChapterType
TranscriptUrl = noneIfBlank this.TranscriptUrl
TranscriptType = noneIfBlank this.TranscriptType
TranscriptLang = noneIfBlank this.TranscriptLang
TranscriptCaptions = if this.TranscriptCaptions then Some true else None
SeasonNumber = if this.SeasonNumber = 0 then None else Some this.SeasonNumber
SeasonDescription = noneIfBlank this.SeasonDescription
EpisodeNumber = match noneIfBlank this.EpisodeNumber |> Option.map Double.Parse with
| Some it when it = 0.0 -> None
| Some it -> Some (double it)
| None -> None
EpisodeDescription = noneIfBlank this.EpisodeDescription
}
else
None
}
member this.UpdatePost (post : Post) now =
let revision = { AsOf = now; Text = MarkupText.parse $"{this.Source}: {this.Text}" }
// Detect a permalink change, and add the prior one to the prior list
match Permalink.toString post.Permalink with
| "" -> post
| link when link = this.Permalink -> post
| _ -> { post with PriorPermalinks = post.Permalink :: post.PriorPermalinks }
|> function
| post ->
{ post with
Title = this.Title
Permalink = Permalink this.Permalink
PublishedOn = if this.DoPublish then Some now else post.PublishedOn
UpdatedOn = now
Text = MarkupText.toHtml revision.Text
Tags = this.Tags.Split ","
|> Seq.ofArray
|> Seq.map (fun it -> it.Trim().ToLower ())
|> Seq.filter (fun it -> it <> "")
|> Seq.sort
|> List.ofSeq
Template = match this.Template.Trim () with "" -> None | tmpl -> Some tmpl
CategoryIds = this.CategoryIds |> Array.map CategoryId |> List.ofArray
Status = if this.DoPublish then Published else post.Status
Metadata = Seq.zip this.MetaNames this.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 post.Revisions |> List.tryHead with
| Some r when r.Text = revision.Text -> post.Revisions
| _ -> revision :: post.Revisions
Episode =
if this.IsEpisode then
Some {
Media = this.Media
Length = this.Length
Duration = noneIfBlank this.Duration |> Option.map TimeSpan.Parse
MediaType = noneIfBlank this.MediaType
ImageUrl = noneIfBlank this.ImageUrl
Subtitle = noneIfBlank this.Subtitle
Explicit = noneIfBlank this.Explicit |> Option.map ExplicitRating.parse
ChapterFile = noneIfBlank this.ChapterFile
ChapterType = noneIfBlank this.ChapterType
TranscriptUrl = noneIfBlank this.TranscriptUrl
TranscriptType = noneIfBlank this.TranscriptType
TranscriptLang = noneIfBlank this.TranscriptLang
TranscriptCaptions = if this.TranscriptCaptions then Some true else None
SeasonNumber = if this.SeasonNumber = 0 then None else Some this.SeasonNumber
SeasonDescription = noneIfBlank this.SeasonDescription
EpisodeNumber = match noneIfBlank this.EpisodeNumber |> Option.map Double.Parse with
| Some it when it = 0.0 -> None
| Some it -> Some (double it)
| None -> None
EpisodeDescription = noneIfBlank this.EpisodeDescription
}
else
None
}
/// View model to edit RSS settings

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

4
src/admin-theme/page-edit.liquid
View File

@ -15,7 +15,7 @@
<input type="text" name="Permalink" id="permalink" class="form-control" required
value="{{ model.permalink }}">
<label for="permalink">Permalink</label>
{%- if model.page_id != "new" %}
{%- unless model.is_new %}
<span class="form-text">
<a href="{{ "admin/page/" | append: model.page_id | append: "/permalinks" | relative_link }}">
Manage Permalinks
@ -25,7 +25,7 @@
Manage Revisions
</a>
</span>
{% endif -%}
{% endunless -%}
</div>
<div class="mb-2">
<label for="text">Text</label> &nbsp; &nbsp;

4
src/admin-theme/post-edit.liquid
View File

@ -15,7 +15,7 @@
<input type="text" name="Permalink" id="permalink" class="form-control" placeholder="Permalink" required
value="{{ model.permalink }}">
<label for="permalink">Permalink</label>
{%- if model.post_id != "new" %}
{%- unless model.is_new %}
<span class="form-text">
<a href="{{ "admin/post/" | append: model.post_id | append: "/permalinks" | relative_link }}">
Manage Permalinks
@ -25,7 +25,7 @@
Manage Revisions
</a>
</span>
{% endif -%}
{% endunless -%}
</div>
<div class="mb-2">
<label for="text">Text</label> &nbsp; &nbsp;