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

WIP on NodaTime implementation

Browse Source
This commit is contained in:
Daniel J. Summers 2022-08-20 09:00:15 -04:00
parent 0b2a17d4c8
commit 80e7e26d51
16 changed files with 62 additions and 46 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

4
src/MyWebLog.Data/Interfaces.fs
View File

@ -1,9 +1,9 @@
namespace MyWebLog.Data
open System
open System.Threading.Tasks
open MyWebLog
open MyWebLog.ViewModels
open NodaTime
/// The result of a category deletion attempt
type CategoryDeleteResult =
@ -137,7 +137,7 @@ type IPostData =
WebLogId -> tag : string -> pageNbr : int -> postsPerPage : int -> Task<Post list>
/// Find the next older and newer post for the given published date/time (excluding revisions and prior permalinks)
abstract member FindSurroundingPosts : WebLogId -> publishedOn : DateTime -> Task<Post option * Post option>
abstract member FindSurroundingPosts : WebLogId -> publishedOn : Instant -> Task<Post option * Post option>
/// Restore posts from a backup
abstract member Restore : Post list -> Task<unit>

8
src/MyWebLog.Data/Postgres/PostgresPostData.fs
View File

@ -1,9 +1,9 @@
namespace MyWebLog.Data.Postgres
open System
open MyWebLog
open MyWebLog.Data
open Newtonsoft.Json
open NodaTime
open Npgsql
open Npgsql.FSharp
@ -238,11 +238,11 @@ type PostgresPostData (conn : NpgsqlConnection) =
|> Sql.executeAsync Map.toPost
/// Find the next newest and oldest post from a publish date for the given web log
let findSurroundingPosts webLogId (publishedOn : DateTime) = backgroundTask {
let findSurroundingPosts webLogId (publishedOn : Instant) = backgroundTask {
let queryParams = Sql.parameters [
webLogIdParam webLogId
"@status", Sql.string (PostStatus.toString Published)
"@publishedOn", Sql.timestamptz publishedOn
typedParam "@publishedOn" publishedOn
"@status", Sql.string (PostStatus.toString Published)
]
let! older =
Sql.existingConnection conn

6
src/MyWebLog.Data/SQLite/SQLitePostData.fs
View File

@ -1,10 +1,10 @@
namespace MyWebLog.Data.SQLite
open System
open System.Threading.Tasks
open Microsoft.Data.Sqlite
open MyWebLog
open MyWebLog.Data
open NodaTime
/// SQLite myWebLog post data implementation
type SQLitePostData (conn : SqliteConnection) =
@ -487,7 +487,7 @@ type SQLitePostData (conn : SqliteConnection) =
}
/// Find the next newest and oldest post from a publish date for the given web log
let findSurroundingPosts webLogId (publishedOn : DateTime) = backgroundTask {
let findSurroundingPosts webLogId (publishedOn : Instant) = backgroundTask {
use cmd = conn.CreateCommand ()
cmd.CommandText <- $"
{selectPost}
@ -498,7 +498,7 @@ type SQLitePostData (conn : SqliteConnection) =
LIMIT 1"
addWebLogId cmd webLogId
[ cmd.Parameters.AddWithValue ("@status", PostStatus.toString Published)
cmd.Parameters.AddWithValue ("@publishedOn", publishedOn)
cmd.Parameters.AddWithValue ("@publishedOn", instantParam publishedOn)
] |> ignore
use! rdr = cmd.ExecuteReaderAsync ()
let! older = backgroundTask {

6
src/MyWebLog.Domain/SupportTypes.fs
View File

@ -138,6 +138,8 @@ module ExplicitRating =
| x -> raise (invalidArg "rating" $"{x} is not a valid explicit rating")
open NodaTime.Text
/// A podcast episode
type Episode =
{ /// The URL to the media file for the episode (may be permalink)
@ -215,6 +217,10 @@ module Episode =
EpisodeNumber = None
EpisodeDescription = None
}
/// Format a duration for an episode
let formatDuration ep =
ep.Duration |> Option.map (DurationPattern.CreateWithInvariantCulture("H:mm:ss").Format)
open Markdig

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

@ -3,7 +3,6 @@
open System
open MyWebLog
open NodaTime
open NodaTime.Text
/// Helper functions for view models
[<AutoOpen>]
@ -706,7 +705,6 @@ type EditPostModel =
| Some rev -> rev
| None -> Revision.empty
let post = if post.Metadata |> List.isEmpty then { post with Metadata = [ MetaItem.empty ] } else post
let format = DurationPattern.CreateWithInvariantCulture("H:mm:ss").Format
let episode = defaultArg post.Episode Episode.empty
{ PostId = PostId.toString post.Id
Title = post.Title
@ -726,7 +724,7 @@ type EditPostModel =
IsEpisode = Option.isSome post.Episode
Media = episode.Media
Length = episode.Length
Duration = defaultArg (episode.Duration |> Option.map format) ""
Duration = defaultArg (Episode.formatDuration episode) ""
MediaType = defaultArg episode.MediaType ""
ImageUrl = defaultArg episode.ImageUrl ""
Subtitle = defaultArg episode.Subtitle ""

4
src/MyWebLog/Caches.fs
View File

@ -11,6 +11,7 @@ module Extensions =
open Microsoft.AspNetCore.Antiforgery
open Microsoft.Extensions.Configuration
open Microsoft.Extensions.DependencyInjection
open NodaTime
/// Hold variable for the configured generator string
let mutable private generatorString : string option = None
@ -20,6 +21,9 @@ module Extensions =
/// The anti-CSRF service
member this.AntiForgery = this.RequestServices.GetRequiredService<IAntiforgery> ()
/// The system clock
member this.Clock = this.RequestServices.GetRequiredService<IClock> ()
/// The cross-site request forgery token set for this request
member this.CsrfTokenSet = this.AntiForgery.GetAndStoreTokens this

4
src/MyWebLog/Handlers/Admin.fs
View File

@ -5,6 +5,7 @@ open System.Threading.Tasks
open Giraffe
open MyWebLog
open MyWebLog.ViewModels
open NodaTime
/// ~~ DASHBOARDS ~~
module Dashboard =
@ -344,7 +345,8 @@ module Theme =
do! asset.Open().CopyToAsync stream
do! data.ThemeAsset.Save
{ Id = ThemeAssetId (themeId, assetName)
UpdatedOn = asset.LastWriteTime.DateTime
UpdatedOn = LocalDateTime.FromDateTime(asset.LastWriteTime.DateTime)
.InZoneLeniently(DateTimeZone.Utc).ToInstant ()
Data = stream.ToArray ()
}
}

10
src/MyWebLog/Handlers/Feed.fs
View File

@ -95,8 +95,8 @@ let private toFeedItem webLog (authors : MetaItem list) (cats : DisplayCategory[
let item = SyndicationItem (
Id = WebLog.absoluteUrl webLog post.Permalink,
Title = TextSyndicationContent.CreateHtmlContent post.Title,
PublishDate = DateTimeOffset post.PublishedOn.Value,
LastUpdatedTime = DateTimeOffset post.UpdatedOn,
PublishDate = post.PublishedOn.Value.ToDateTimeOffset (),
LastUpdatedTime = post.UpdatedOn.ToDateTimeOffset (),
Content = TextSyndicationContent.CreatePlaintextContent plainText)
item.AddPermalink (Uri item.Id)
@ -163,8 +163,8 @@ let private addEpisode webLog (podcast : PodcastOptions) (episode : Episode) (po
item.ElementExtensions.Add ("author", Namespace.iTunes, podcast.DisplayedAuthor)
item.ElementExtensions.Add ("explicit", Namespace.iTunes, epExplicit)
episode.Subtitle |> Option.iter (fun it -> item.ElementExtensions.Add ("subtitle", Namespace.iTunes, it))
episode.Duration
|> Option.iter (fun it -> item.ElementExtensions.Add ("duration", Namespace.iTunes, it.ToString """hh\:mm\:ss"""))
Episode.formatDuration episode
|> Option.iter (fun it -> item.ElementExtensions.Add ("duration", Namespace.iTunes, it))
match episode.ChapterFile with
| Some chapters ->
@ -381,7 +381,7 @@ let createFeed (feedType : FeedType) posts : HttpHandler = fun next ctx -> backg
addNamespace feed "content" Namespace.content
setTitleAndDescription feedType webLog cats feed
feed.LastUpdatedTime <- (List.head posts).UpdatedOn |> DateTimeOffset
feed.LastUpdatedTime <- (List.head posts).UpdatedOn.ToDateTimeOffset ()
feed.Generator <- ctx.Generator
feed.Items <- posts |> Seq.ofList |> Seq.map toItem
feed.Language <- "en"

3
src/MyWebLog/Handlers/Helpers.fs
View File

@ -419,10 +419,11 @@ let getCategoryIds slug ctx =
open System
open System.Globalization
open NodaTime
/// Parse a date/time to UTC
let parseToUtc (date : string) =
DateTime.Parse (date, null, DateTimeStyles.AdjustToUniversal)
Instant.FromDateTimeUtc (DateTime.Parse (date, null, DateTimeStyles.AdjustToUniversal))
open Microsoft.Extensions.DependencyInjection
open Microsoft.Extensions.Logging

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

@ -139,15 +139,13 @@ let previewRevision (pgId, revDate) : HttpHandler = requireAccess Author >=> fun
| _, None -> return! Error.notFound next ctx
}
open System
// POST /admin/page/{id}/revision/{revision-date}/restore
let restoreRevision (pgId, revDate) : HttpHandler = requireAccess Author >=> fun next ctx -> task {
match! findPageRevision pgId revDate ctx with
| Some pg, Some rev when canEdit pg.AuthorId ctx ->
do! ctx.Data.Page.Update
{ pg with
Revisions = { rev with AsOf = DateTime.UtcNow }
Revisions = { rev with AsOf = ctx.Clock.GetCurrentInstant () }
:: (pg.Revisions |> List.filter (fun r -> r.AsOf <> rev.AsOf))
}
do! addMessage ctx { UserMessage.success with Message = "Revision restored successfully" }
@ -173,7 +171,7 @@ let deleteRevision (pgId, revDate) : HttpHandler = requireAccess Author >=> fun
let save : HttpHandler = requireAccess Author >=> fun next ctx -> task {
let! model = ctx.BindFormAsync<EditPageModel> ()
let data = ctx.Data
let now = DateTime.UtcNow
let now = ctx.Clock.GetCurrentInstant ()
let tryPage =
if model.IsNew then
{ Page.empty with

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

@ -52,9 +52,9 @@ let preparePostList webLog posts listType (url : string) pageNbr perPage (data :
let! olderPost, newerPost =
match listType with
| SinglePost ->
let post = List.head posts
let dateTime = defaultArg post.PublishedOn post.UpdatedOn
data.Post.FindSurroundingPosts webLog.Id dateTime
let post = List.head posts
let target = defaultArg post.PublishedOn post.UpdatedOn
data.Post.FindSurroundingPosts webLog.Id target
| _ -> Task.FromResult (None, None)
let newerLink =
match listType, pageNbr with
@ -350,7 +350,7 @@ let restoreRevision (postId, revDate) : HttpHandler = requireAccess Author >=> f
| Some post, Some rev when canEdit post.AuthorId ctx ->
do! ctx.Data.Post.Update
{ post with
Revisions = { rev with AsOf = DateTime.UtcNow }
Revisions = { rev with AsOf = ctx.Clock.GetCurrentInstant () }
:: (post.Revisions |> List.filter (fun r -> r.AsOf <> rev.AsOf))
}
do! addMessage ctx { UserMessage.success with Message = "Revision restored successfully" }
@ -376,7 +376,6 @@ let deleteRevision (postId, revDate) : HttpHandler = requireAccess Author >=> fu
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.IsNew then
{ Post.empty with
@ -389,7 +388,7 @@ let save : HttpHandler = requireAccess Author >=> fun next ctx -> task {
| Some post when canEdit post.AuthorId ctx ->
let priorCats = post.CategoryIds
let updatedPost =
model.UpdatePost post now
model.UpdatePost post (ctx.Clock.GetCurrentInstant ())
|> function
| post ->
if model.SetPublished then

2
src/MyWebLog/Handlers/Routes.fs
View File

@ -94,7 +94,7 @@ module Asset =
| Some asset ->
match Upload.checkModified asset.UpdatedOn ctx with
| Some threeOhFour -> return! threeOhFour next ctx
| None -> return! Upload.sendFile asset.UpdatedOn path asset.Data next ctx
| None -> return! Upload.sendFile (asset.UpdatedOn.ToDateTimeUtc ()) path asset.Data next ctx
| None -> return! Error.notFound next ctx
}

13
src/MyWebLog/Handlers/Upload.fs
View File

@ -29,15 +29,17 @@ module private Helpers =
// ~~ SERVING UPLOADS ~~
open System.Globalization
open Giraffe
open Microsoft.AspNetCore.Http
open NodaTime
/// Determine if the file has been modified since the date/time specified by the If-Modified-Since header
let checkModified since (ctx : HttpContext) : HttpHandler option =
match ctx.Request.Headers.IfModifiedSince with
| it when it.Count < 1 -> None
| it when since > DateTime.Parse it[0] -> None
| _ -> Some (setStatusCode 304 >=> setBodyFromString "Not Modified")
| it when since > Instant.FromDateTimeUtc (DateTime.Parse (it[0], null, DateTimeStyles.AdjustToUniversal)) -> None
| _ -> Some (setStatusCode 304)
open Microsoft.AspNetCore.Http.Headers
@ -73,7 +75,7 @@ let serve (urlParts : string seq) : HttpHandler = fun next ctx -> task {
| Some upload ->
match checkModified upload.UpdatedOn ctx with
| Some threeOhFour -> return! threeOhFour next ctx
| None -> return! sendFile upload.UpdatedOn path upload.Data next ctx
| None -> return! sendFile (upload.UpdatedOn.ToDateTimeUtc ()) path upload.Data next ctx
| None -> return! Error.notFound next ctx
else
return! Error.notFound next ctx
@ -143,7 +145,8 @@ let save : HttpHandler = requireAccess Author >=> fun next ctx -> task {
let upload = Seq.head ctx.Request.Form.Files
let fileName = String.Concat (makeSlug (Path.GetFileNameWithoutExtension upload.FileName),
Path.GetExtension(upload.FileName).ToLowerInvariant ())
let localNow = WebLog.localTime ctx.WebLog DateTime.Now
let now = ctx.Clock.GetCurrentInstant ()
let localNow = WebLog.localTime ctx.WebLog now
let year = localNow.ToString "yyyy"
let month = localNow.ToString "MM"
let! form = ctx.BindFormAsync<UploadFileModel> ()
@ -156,7 +159,7 @@ let save : HttpHandler = requireAccess Author >=> fun next ctx -> task {
{ Id = UploadId.create ()
WebLogId = ctx.WebLog.Id
Path = Permalink $"{year}/{month}/{fileName}"
UpdatedOn = DateTime.UtcNow
UpdatedOn = now
Data = stream.ToArray ()
}
do! ctx.Data.Upload.Add file

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

@ -4,6 +4,7 @@ module MyWebLog.Handlers.User
open System
open System.Security.Cryptography
open System.Text
open NodaTime
// ~~ LOG ON / LOG OFF ~~
@ -147,7 +148,9 @@ let private showMyInfo (model : EditMyInfoModel) (user : WebLogUser) : HttpHandl
|> addToHash ViewContext.Model model
|> addToHash "access_level" (AccessLevel.toString user.AccessLevel)
|> addToHash "created_on" (WebLog.localTime ctx.WebLog user.CreatedOn)
|> addToHash "last_seen_on" (WebLog.localTime ctx.WebLog (defaultArg user.LastSeenOn DateTime.UnixEpoch))
|> addToHash "last_seen_on" (WebLog.localTime ctx.WebLog
(defaultArg user.LastSeenOn (Instant.FromUnixTimeSeconds 0)))
|> adminView "my-info" next ctx
@ -198,9 +201,9 @@ let save : HttpHandler = requireAccess WebLogAdmin >=> fun next ctx -> task {
let tryUser =
if model.IsNew then
{ WebLogUser.empty with
Id = WebLogUserId.create ()
WebLogId = ctx.WebLog.Id
CreatedOn = DateTime.UtcNow
Id = WebLogUserId.create ()
WebLogId = ctx.WebLog.Id
CreatedOn = ctx.Clock.GetCurrentInstant ()
} |> someTask
else data.WebLogUser.FindById (WebLogUserId model.Id) ctx.WebLog.Id
match! tryUser with
@ -227,4 +230,3 @@ let save : HttpHandler = requireAccess WebLogAdmin >=> fun next ctx -> task {
next ctx
| None -> return! Error.notFound next ctx
}

7
src/MyWebLog/Maintenance.fs
View File

@ -4,6 +4,7 @@ open System
open System.IO
open Microsoft.Extensions.DependencyInjection
open MyWebLog.Data
open NodaTime
/// Create the web log information
let private doCreateWebLog (args : string[]) (sp : IServiceProvider) = task {
@ -42,7 +43,7 @@ let private doCreateWebLog (args : string[]) (sp : IServiceProvider) = task {
// Create the admin user
let salt = Guid.NewGuid ()
let now = DateTime.UtcNow
let now = SystemClock.Instance.GetCurrentInstant ()
do! data.WebLogUser.Add
{ WebLogUser.empty with
@ -165,7 +166,7 @@ module Backup =
Id : ThemeAssetId
/// The updated date for this asset
UpdatedOn : DateTime
UpdatedOn : Instant
/// The data for this asset, base-64 encoded
Data : string
@ -197,7 +198,7 @@ module Backup =
Path : Permalink
/// The date/time this upload was last updated (file time)
UpdatedOn : DateTime
UpdatedOn : Instant
/// The data for the upload, base-64 encoded
Data : string

8
src/MyWebLog/Program.fs
View File

@ -3,8 +3,6 @@ open Microsoft.Data.Sqlite
open Microsoft.Extensions.Configuration
open Microsoft.Extensions.Logging
open MyWebLog
open Newtonsoft.Json
open Npgsql
/// Middleware to derive the current web log
type WebLogMiddleware (next : RequestDelegate, log : ILogger<WebLogMiddleware>) =
@ -31,6 +29,9 @@ type WebLogMiddleware (next : RequestDelegate, log : ILogger<WebLogMiddleware>)
open System
open Microsoft.Extensions.DependencyInjection
open MyWebLog.Data
open Newtonsoft.Json
open NodaTime
open Npgsql
/// Logic to obtain a data connection and implementation based on configured values
module DataImplementation =
@ -118,7 +119,8 @@ let rec main args =
let sp = builder.Services.BuildServiceProvider ()
let data, serializer = DataImplementation.get sp
let _ = builder.Services.AddSingleton<JsonSerializer> serializer
let _ = builder.Services.AddSingleton<JsonSerializer> serializer
let _ = builder.Services.AddSingleton<IClock> SystemClock.Instance
task {
do! data.StartUp ()