bit-badger/myWebLog
1
0
Fork 0
Code Issues 3 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="Microsoft.FSharpLu.Json" Version="0.11.7" />
<PackageReference Include="Newtonsoft.Json" Version="13.0.1" /> <PackageReference Include="Newtonsoft.Json" Version="13.0.1" />
<PackageReference Include="RethinkDb.Driver" Version="2.3.150" /> <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" /> <PackageReference Update="FSharp.Core" Version="6.0.5" />
</ItemGroup> </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> { member _.FindByWebLog webLogId = rethink<TagMap list> {
withTable Table.TagMap withTable Table.TagMap
between [| webLogId :> obj; r.Minval () |] [| webLogId :> obj, r.Maxval () |] between [| webLogId :> obj; r.Minval () |] [| webLogId :> obj; r.Maxval () |]
[ Index Index.WebLogAndTag ] [ Index Index.WebLogAndTag ]
orderBy (nameof TagMap.empty.Tag) orderBy (nameof TagMap.empty.Tag)
result; withRetryDefault conn result; withRetryDefault conn

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

@ -470,6 +470,36 @@ type EditPageModel =
MetaValues = page.Metadata |> List.map (fun m -> m.Value) |> 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 /// View model to edit a post
[<CLIMutable; NoComparison; NoEquality>] [<CLIMutable; NoComparison; NoEquality>]
@ -617,58 +647,69 @@ type EditPostModel =
EpisodeDescription = defaultArg episode.EpisodeDescription "" 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 /// Update a post with values from the submitted form
member this.UpdatePost (post : Post) (revision : Revision) now = member this.UpdatePost (post : Post) now =
{ post with let revision = { AsOf = now; Text = MarkupText.parse $"{this.Source}: {this.Text}" }
Title = this.Title // Detect a permalink change, and add the prior one to the prior list
Permalink = Permalink this.Permalink match Permalink.toString post.Permalink with
PublishedOn = if this.DoPublish then Some now else post.PublishedOn | "" -> post
UpdatedOn = now | link when link = this.Permalink -> post
Text = MarkupText.toHtml revision.Text | _ -> { post with PriorPermalinks = post.Permalink :: post.PriorPermalinks }
Tags = this.Tags.Split "," |> function
|> Seq.ofArray | post ->
|> Seq.map (fun it -> it.Trim().ToLower ()) { post with
|> Seq.filter (fun it -> it <> "") Title = this.Title
|> Seq.sort Permalink = Permalink this.Permalink
|> List.ofSeq PublishedOn = if this.DoPublish then Some now else post.PublishedOn
Template = match this.Template.Trim () with "" -> None | tmpl -> Some tmpl UpdatedOn = now
CategoryIds = this.CategoryIds |> Array.map CategoryId |> List.ofArray Text = MarkupText.toHtml revision.Text
Status = if this.DoPublish then Published else post.Status Tags = this.Tags.Split ","
Metadata = Seq.zip this.MetaNames this.MetaValues |> Seq.ofArray
|> Seq.filter (fun it -> fst it > "") |> Seq.map (fun it -> it.Trim().ToLower ())
|> Seq.map (fun it -> { Name = fst it; Value = snd it }) |> Seq.filter (fun it -> it <> "")
|> Seq.sortBy (fun it -> $"{it.Name.ToLower ()} {it.Value.ToLower ()}") |> Seq.sort
|> List.ofSeq |> List.ofSeq
Revisions = match post.Revisions |> List.tryHead with Template = match this.Template.Trim () with "" -> None | tmpl -> Some tmpl
| Some r when r.Text = revision.Text -> post.Revisions CategoryIds = this.CategoryIds |> Array.map CategoryId |> List.ofArray
| _ -> revision :: post.Revisions Status = if this.DoPublish then Published else post.Status
Episode = Metadata = Seq.zip this.MetaNames this.MetaValues
if this.IsEpisode then |> Seq.filter (fun it -> fst it > "")
Some { |> Seq.map (fun it -> { Name = fst it; Value = snd it })
Media = this.Media |> Seq.sortBy (fun it -> $"{it.Name.ToLower ()} {it.Value.ToLower ()}")
Length = this.Length |> List.ofSeq
Duration = noneIfBlank this.Duration |> Option.map TimeSpan.Parse Revisions = match post.Revisions |> List.tryHead with
MediaType = noneIfBlank this.MediaType | Some r when r.Text = revision.Text -> post.Revisions
ImageUrl = noneIfBlank this.ImageUrl | _ -> revision :: post.Revisions
Subtitle = noneIfBlank this.Subtitle Episode =
Explicit = noneIfBlank this.Explicit |> Option.map ExplicitRating.parse if this.IsEpisode then
ChapterFile = noneIfBlank this.ChapterFile Some {
ChapterType = noneIfBlank this.ChapterType Media = this.Media
TranscriptUrl = noneIfBlank this.TranscriptUrl Length = this.Length
TranscriptType = noneIfBlank this.TranscriptType Duration = noneIfBlank this.Duration |> Option.map TimeSpan.Parse
TranscriptLang = noneIfBlank this.TranscriptLang MediaType = noneIfBlank this.MediaType
TranscriptCaptions = if this.TranscriptCaptions then Some true else None ImageUrl = noneIfBlank this.ImageUrl
SeasonNumber = if this.SeasonNumber = 0 then None else Some this.SeasonNumber Subtitle = noneIfBlank this.Subtitle
SeasonDescription = noneIfBlank this.SeasonDescription Explicit = noneIfBlank this.Explicit |> Option.map ExplicitRating.parse
EpisodeNumber = match noneIfBlank this.EpisodeNumber |> Option.map Double.Parse with ChapterFile = noneIfBlank this.ChapterFile
| Some it when it = 0.0 -> None ChapterType = noneIfBlank this.ChapterType
| Some it -> Some (double it) TranscriptUrl = noneIfBlank this.TranscriptUrl
| None -> None TranscriptType = noneIfBlank this.TranscriptType
EpisodeDescription = noneIfBlank this.EpisodeDescription TranscriptLang = noneIfBlank this.TranscriptLang
} TranscriptCaptions = if this.TranscriptCaptions then Some true else None
else SeasonNumber = if this.SeasonNumber = 0 then None else Some this.SeasonNumber
None 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 /// 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 | _, None -> return! Error.notFound next ctx
} }
//#nowarn "3511"
open System.Threading.Tasks open System.Threading.Tasks
// POST /admin/page/save // POST /admin/page/save
let save : HttpHandler = requireAccess Author >=> fun next ctx -> task { let save : HttpHandler = requireAccess Author >=> fun next ctx -> task {
let! model = ctx.BindFormAsync<EditPageModel> () let! model = ctx.BindFormAsync<EditPageModel> ()
let data = ctx.Data let data = ctx.Data
let now = DateTime.UtcNow let now = DateTime.UtcNow
let pg = let tryPage =
match model.PageId with if model.IsNew then Task.FromResult (
| "new" -> Some
Task.FromResult ( { Page.empty with
Some Id = PageId.create ()
{ Page.empty with WebLogId = ctx.WebLog.Id
Id = PageId.create () AuthorId = ctx.UserId
WebLogId = ctx.WebLog.Id PublishedOn = now
AuthorId = ctx.UserId })
PublishedOn = now else data.Page.FindFullById (PageId model.PageId) ctx.WebLog.Id
}) match! tryPage with
| pgId -> data.Page.FindFullById (PageId pgId) ctx.WebLog.Id
match! pg with
| Some page when canEdit page.AuthorId ctx -> | Some page when canEdit page.AuthorId ctx ->
let updateList = page.IsInPageList <> model.IsShownInPageList let updateList = page.IsInPageList <> model.IsShownInPageList
let revision = { AsOf = now; Text = MarkupText.parse $"{model.Source}: {model.Text}" } let updatedPage = model.UpdatePage page now
// Detect a permalink change, and add the prior one to the prior list do! (if model.PageId = "new" then data.Page.Add else data.Page.Update) updatedPage
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
if updateList then do! PageListCache.update ctx if updateList then do! PageListCache.update ctx
do! addMessage ctx { UserMessage.success with Message = "Page saved successfully" } do! addMessage ctx { UserMessage.success with Message = "Page saved successfully" }
return! redirectToGet $"admin/page/{PageId.toString page.Id}/edit" next ctx 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 | _, None -> return! Error.notFound next ctx
} }
//#nowarn "3511"
// POST /admin/post/save // POST /admin/post/save
let save : HttpHandler = requireAccess Author >=> fun next ctx -> task { let save : HttpHandler = requireAccess Author >=> fun next ctx -> task {
let! model = ctx.BindFormAsync<EditPostModel> () let! model = ctx.BindFormAsync<EditPostModel> ()
let data = ctx.Data let data = ctx.Data
let now = DateTime.UtcNow let now = DateTime.UtcNow
let tryPost = let tryPost =
if model.PostId = "new" then if model.IsNew then Task.FromResult (
Task.FromResult ( Some
Some { Post.empty with
{ Post.empty with Id = PostId.create ()
Id = PostId.create () WebLogId = ctx.WebLog.Id
WebLogId = ctx.WebLog.Id AuthorId = ctx.UserId
AuthorId = ctx.UserId })
})
else data.Post.FindFullById (PostId model.PostId) ctx.WebLog.Id else data.Post.FindFullById (PostId model.PostId) ctx.WebLog.Id
match! tryPost with match! tryPost with
| Some post when canEdit post.AuthorId ctx -> | Some post when canEdit post.AuthorId ctx ->
let priorCats = post.CategoryIds let priorCats = post.CategoryIds
let revision = { AsOf = now; Text = MarkupText.parse $"{model.Source}: {model.Text}" } let updatedPost =
// Detect a permalink change, and add the prior one to the prior list model.UpdatePost post now
let post = |> function
match Permalink.toString post.Permalink with | post ->
| "" -> post if model.SetPublished then
| link when link = model.Permalink -> post let dt = parseToUtc (model.PubOverride.Value.ToString "o")
| _ -> { post with PriorPermalinks = post.Permalink :: post.PriorPermalinks } if model.SetUpdated then
let post = model.UpdatePost post revision now { post with
let post = PublishedOn = Some dt
if model.SetPublished then UpdatedOn = dt
let dt = parseToUtc (model.PubOverride.Value.ToString "o") Revisions = [ { (List.head post.Revisions) with AsOf = dt } ]
if model.SetUpdated then }
{ post with else { post with PublishedOn = Some dt }
PublishedOn = Some dt else post
UpdatedOn = dt do! (if model.PostId = "new" then data.Post.Add else data.Post.Update) updatedPost
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
// If the post was published or its categories changed, refresh the category cache // If the post was published or its categories changed, refresh the category cache
if model.DoPublish if model.DoPublish
|| not (priorCats || not (priorCats
|> List.append post.CategoryIds |> List.append updatedPost.CategoryIds
|> List.distinct |> List.distinct
|> List.length = List.length priorCats) then |> List.length = List.length priorCats) then
do! CategoryCache.update ctx 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! model = ctx.BindFormAsync<EditMyInfoModel> ()
let data = ctx.Data let data = ctx.Data
match! data.WebLogUser.FindById ctx.UserId ctx.WebLog.Id with 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 -> | Some user ->
if model.NewPassword = model.NewPasswordConfirm then do! addMessage ctx { UserMessage.error with Message = "Passwords did not match; no updates made" }
let pw, salt = return! showMyInfo user (Hash.FromAnonymousObject {|
if model.NewPassword = "" then model = { model with NewPassword = ""; NewPasswordConfirm = "" }
user.PasswordHash, user.Salt |}) next ctx
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
| None -> return! Error.notFound 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 /// Get the configured data implementation
let get (sp : IServiceProvider) : IData = let get (sp : IServiceProvider) : IData =
let config = sp.GetRequiredService<IConfiguration> () let config = sp.GetRequiredService<IConfiguration> ()
if (config.GetConnectionString >> isNull >> not) "SQLite" then 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 log = sp.GetRequiredService<ILogger<SQLiteData>> ()
let conn = new SqliteConnection (config.GetConnectionString "SQLite") let conn = new SqliteConnection (connStr)
log.LogInformation $"Using SQL database {conn.DataSource}" log.LogInformation $"Using SQL database {conn.DataSource}"
SQLiteData.setUpConnection conn |> Async.AwaitTask |> Async.RunSynchronously await (SQLiteData.setUpConnection conn)
upcast SQLiteData (conn, sp.GetRequiredService<ILogger<SQLiteData>> ()) SQLiteData (conn, log)
elif (config.GetSection "RethinkDB").Exists () then
if hasConnStr "SQLite" then
upcast createSQLite (connStr "SQLite")
elif hasConnStr "RethinkDB" then
let log = sp.GetRequiredService<ILogger<RethinkDbData>> () let log = sp.GetRequiredService<ILogger<RethinkDbData>> ()
Json.all () |> Seq.iter Converter.Serializer.Converters.Add Json.all () |> Seq.iter Converter.Serializer.Converters.Add
let rethinkCfg = DataConfig.FromConfiguration (config.GetSection "RethinkDB") let rethinkCfg = DataConfig.FromUri (connStr "RethinkDB")
let conn = rethinkCfg.CreateConnectionAsync () |> Async.AwaitTask |> Async.RunSynchronously let conn = await (rethinkCfg.CreateConnectionAsync log)
log.LogInformation $"Using RethinkDB database {rethinkCfg.Database}" upcast RethinkDbData (conn, rethinkCfg, log)
upcast RethinkDbData (conn, rethinkCfg, sp.GetRequiredService<ILogger<RethinkDbData>> ())
else else
let log = sp.GetRequiredService<ILogger<SQLiteData>> () upcast createSQLite "Data Source=./myweblog.db;Cache=Shared"
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)
open Giraffe 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 <input type="text" name="Permalink" id="permalink" class="form-control" required
value="{{ model.permalink }}"> value="{{ model.permalink }}">
<label for="permalink">Permalink</label> <label for="permalink">Permalink</label>
{%- if model.page_id != "new" %} {%- unless model.is_new %}
<span class="form-text"> <span class="form-text">
<a href="{{ "admin/page/" | append: model.page_id | append: "/permalinks" | relative_link }}"> <a href="{{ "admin/page/" | append: model.page_id | append: "/permalinks" | relative_link }}">
Manage Permalinks Manage Permalinks
@ -25,7 +25,7 @@
Manage Revisions Manage Revisions
</a> </a>
</span> </span>
{% endif -%} {% endunless -%}
</div> </div>
<div class="mb-2"> <div class="mb-2">
<label for="text">Text</label> &nbsp; &nbsp; <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 <input type="text" name="Permalink" id="permalink" class="form-control" placeholder="Permalink" required
value="{{ model.permalink }}"> value="{{ model.permalink }}">
<label for="permalink">Permalink</label> <label for="permalink">Permalink</label>
{%- if model.post_id != "new" %} {%- unless model.is_new %}
<span class="form-text"> <span class="form-text">
<a href="{{ "admin/post/" | append: model.post_id | append: "/permalinks" | relative_link }}"> <a href="{{ "admin/post/" | append: model.post_id | append: "/permalinks" | relative_link }}">
Manage Permalinks Manage Permalinks
@ -25,7 +25,7 @@
Manage Revisions Manage Revisions
</a> </a>
</span> </span>
{% endif -%} {% endunless -%}
</div> </div>
<div class="mb-2"> <div class="mb-2">
<label for="text">Text</label> &nbsp; &nbsp; <label for="text">Text</label> &nbsp; &nbsp;