diff --git a/src/MyWebLog.Data/MyWebLog.Data.fsproj b/src/MyWebLog.Data/MyWebLog.Data.fsproj index f6d5557..e489f9e 100644 --- a/src/MyWebLog.Data/MyWebLog.Data.fsproj +++ b/src/MyWebLog.Data/MyWebLog.Data.fsproj @@ -16,7 +16,7 @@ - + diff --git a/src/MyWebLog.Data/RethinkDbData.fs b/src/MyWebLog.Data/RethinkDbData.fs index bf3b2da..d9c7ae6 100644 --- a/src/MyWebLog.Data/RethinkDbData.fs +++ b/src/MyWebLog.Data/RethinkDbData.fs @@ -676,7 +676,7 @@ type RethinkDbData (conn : Net.IConnection, config : DataConfig, log : ILogger { 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 diff --git a/src/MyWebLog.Domain/ViewModels.fs b/src/MyWebLog.Domain/ViewModels.fs index fbf2583..33355ff 100644 --- a/src/MyWebLog.Domain/ViewModels.fs +++ b/src/MyWebLog.Domain/ViewModels.fs @@ -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 diff --git a/src/MyWebLog/Handlers/Page.fs b/src/MyWebLog/Handlers/Page.fs index 9b4507d..6737b47 100644 --- a/src/MyWebLog/Handlers/Page.fs +++ b/src/MyWebLog/Handlers/Page.fs @@ -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 () - 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 () + 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 diff --git a/src/MyWebLog/Handlers/Post.fs b/src/MyWebLog/Handlers/Post.fs index dbca310..5a9aaef 100644 --- a/src/MyWebLog/Handlers/Post.fs +++ b/src/MyWebLog/Handlers/Post.fs @@ -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 () 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 diff --git a/src/MyWebLog/Handlers/User.fs b/src/MyWebLog/Handlers/User.fs index 90a8b36..e4a5276 100644 --- a/src/MyWebLog/Handlers/User.fs +++ b/src/MyWebLog/Handlers/User.fs @@ -91,30 +91,29 @@ let saveMyInfo : HttpHandler = requireAccess Author >=> fun next ctx -> task { let! model = ctx.BindFormAsync () 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 } diff --git a/src/MyWebLog/Program.fs b/src/MyWebLog/Program.fs index 81e88a4..e81eafd 100644 --- a/src/MyWebLog/Program.fs +++ b/src/MyWebLog/Program.fs @@ -39,26 +39,27 @@ module DataImplementation = /// Get the configured data implementation let get (sp : IServiceProvider) : IData = - let config = sp.GetRequiredService () - if (config.GetConnectionString >> isNull >> not) "SQLite" then + let config = sp.GetRequiredService () + 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> () - 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> ()) - 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> () 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> ()) + let rethinkCfg = DataConfig.FromUri (connStr "RethinkDB") + let conn = await (rethinkCfg.CreateConnectionAsync log) + upcast RethinkDbData (conn, rethinkCfg, log) else - let log = sp.GetRequiredService> () - 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 diff --git a/src/admin-theme/page-edit.liquid b/src/admin-theme/page-edit.liquid index 9d5a49e..7946a64 100644 --- a/src/admin-theme/page-edit.liquid +++ b/src/admin-theme/page-edit.liquid @@ -15,7 +15,7 @@ - {%- if model.page_id != "new" %} + {%- unless model.is_new %} Manage Permalinks @@ -25,7 +25,7 @@ Manage Revisions - {% endif -%} + {% endunless -%}
    diff --git a/src/admin-theme/post-edit.liquid b/src/admin-theme/post-edit.liquid index 3ac3649..92f5d1d 100644 --- a/src/admin-theme/post-edit.liquid +++ b/src/admin-theme/post-edit.liquid @@ -15,7 +15,7 @@ - {%- if model.post_id != "new" %} + {%- unless model.is_new %} Manage Permalinks @@ -25,7 +25,7 @@ Manage Revisions - {% endif -%} + {% endunless -%}