From 80e7e26d51b6056a83ff814d91a8d1ddeb6dec25 Mon Sep 17 00:00:00 2001 From: "Daniel J. Summers" Date: Sat, 20 Aug 2022 09:00:15 -0400 Subject: [PATCH] WIP on NodaTime implementation --- src/MyWebLog.Data/Interfaces.fs | 4 ++-- src/MyWebLog.Data/Postgres/PostgresPostData.fs | 8 ++++---- src/MyWebLog.Data/SQLite/SQLitePostData.fs | 6 +++--- src/MyWebLog.Domain/SupportTypes.fs | 6 ++++++ src/MyWebLog.Domain/ViewModels.fs | 4 +--- src/MyWebLog/Caches.fs | 4 ++++ src/MyWebLog/Handlers/Admin.fs | 4 +++- src/MyWebLog/Handlers/Feed.fs | 10 +++++----- src/MyWebLog/Handlers/Helpers.fs | 3 ++- src/MyWebLog/Handlers/Page.fs | 6 ++---- src/MyWebLog/Handlers/Post.fs | 11 +++++------ src/MyWebLog/Handlers/Routes.fs | 2 +- src/MyWebLog/Handlers/Upload.fs | 13 ++++++++----- src/MyWebLog/Handlers/User.fs | 12 +++++++----- src/MyWebLog/Maintenance.fs | 7 ++++--- src/MyWebLog/Program.fs | 8 +++++--- 16 files changed, 62 insertions(+), 46 deletions(-) diff --git a/src/MyWebLog.Data/Interfaces.fs b/src/MyWebLog.Data/Interfaces.fs index afa5e0c..970a2b3 100644 --- a/src/MyWebLog.Data/Interfaces.fs +++ b/src/MyWebLog.Data/Interfaces.fs @@ -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 /// 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 + abstract member FindSurroundingPosts : WebLogId -> publishedOn : Instant -> Task /// Restore posts from a backup abstract member Restore : Post list -> Task diff --git a/src/MyWebLog.Data/Postgres/PostgresPostData.fs b/src/MyWebLog.Data/Postgres/PostgresPostData.fs index 4e5cb61..1e06242 100644 --- a/src/MyWebLog.Data/Postgres/PostgresPostData.fs +++ b/src/MyWebLog.Data/Postgres/PostgresPostData.fs @@ -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 diff --git a/src/MyWebLog.Data/SQLite/SQLitePostData.fs b/src/MyWebLog.Data/SQLite/SQLitePostData.fs index 3a8f7fd..ab15dcc 100644 --- a/src/MyWebLog.Data/SQLite/SQLitePostData.fs +++ b/src/MyWebLog.Data/SQLite/SQLitePostData.fs @@ -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 { diff --git a/src/MyWebLog.Domain/SupportTypes.fs b/src/MyWebLog.Domain/SupportTypes.fs index 30e6910..c3457dc 100644 --- a/src/MyWebLog.Domain/SupportTypes.fs +++ b/src/MyWebLog.Domain/SupportTypes.fs @@ -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 diff --git a/src/MyWebLog.Domain/ViewModels.fs b/src/MyWebLog.Domain/ViewModels.fs index d2e71b1..f7d204f 100644 --- a/src/MyWebLog.Domain/ViewModels.fs +++ b/src/MyWebLog.Domain/ViewModels.fs @@ -3,7 +3,6 @@ open System open MyWebLog open NodaTime -open NodaTime.Text /// Helper functions for view models [] @@ -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 "" diff --git a/src/MyWebLog/Caches.fs b/src/MyWebLog/Caches.fs index 5042f55..81fa5b3 100644 --- a/src/MyWebLog/Caches.fs +++ b/src/MyWebLog/Caches.fs @@ -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 () + /// The system clock + member this.Clock = this.RequestServices.GetRequiredService () + /// The cross-site request forgery token set for this request member this.CsrfTokenSet = this.AntiForgery.GetAndStoreTokens this diff --git a/src/MyWebLog/Handlers/Admin.fs b/src/MyWebLog/Handlers/Admin.fs index b4ece20..04932c0 100644 --- a/src/MyWebLog/Handlers/Admin.fs +++ b/src/MyWebLog/Handlers/Admin.fs @@ -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 () } } diff --git a/src/MyWebLog/Handlers/Feed.fs b/src/MyWebLog/Handlers/Feed.fs index 7efec6b..7db1dd9 100644 --- a/src/MyWebLog/Handlers/Feed.fs +++ b/src/MyWebLog/Handlers/Feed.fs @@ -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" diff --git a/src/MyWebLog/Handlers/Helpers.fs b/src/MyWebLog/Handlers/Helpers.fs index 77b6241..ee7075c 100644 --- a/src/MyWebLog/Handlers/Helpers.fs +++ b/src/MyWebLog/Handlers/Helpers.fs @@ -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 diff --git a/src/MyWebLog/Handlers/Page.fs b/src/MyWebLog/Handlers/Page.fs index 8869cd8..58f67c5 100644 --- a/src/MyWebLog/Handlers/Page.fs +++ b/src/MyWebLog/Handlers/Page.fs @@ -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 () let data = ctx.Data - let now = DateTime.UtcNow + let now = ctx.Clock.GetCurrentInstant () let tryPage = if model.IsNew then { Page.empty with diff --git a/src/MyWebLog/Handlers/Post.fs b/src/MyWebLog/Handlers/Post.fs index f79bfbe..98883c4 100644 --- a/src/MyWebLog/Handlers/Post.fs +++ b/src/MyWebLog/Handlers/Post.fs @@ -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 () 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 diff --git a/src/MyWebLog/Handlers/Routes.fs b/src/MyWebLog/Handlers/Routes.fs index 1239c0c..e664a9d 100644 --- a/src/MyWebLog/Handlers/Routes.fs +++ b/src/MyWebLog/Handlers/Routes.fs @@ -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 } diff --git a/src/MyWebLog/Handlers/Upload.fs b/src/MyWebLog/Handlers/Upload.fs index 3755484..9e6a2b0 100644 --- a/src/MyWebLog/Handlers/Upload.fs +++ b/src/MyWebLog/Handlers/Upload.fs @@ -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 () @@ -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 diff --git a/src/MyWebLog/Handlers/User.fs b/src/MyWebLog/Handlers/User.fs index 608d2b3..bd19066 100644 --- a/src/MyWebLog/Handlers/User.fs +++ b/src/MyWebLog/Handlers/User.fs @@ -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 } - diff --git a/src/MyWebLog/Maintenance.fs b/src/MyWebLog/Maintenance.fs index 814405a..6088888 100644 --- a/src/MyWebLog/Maintenance.fs +++ b/src/MyWebLog/Maintenance.fs @@ -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 diff --git a/src/MyWebLog/Program.fs b/src/MyWebLog/Program.fs index 182d1cf..4e7ff12 100644 --- a/src/MyWebLog/Program.fs +++ b/src/MyWebLog/Program.fs @@ -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) = @@ -31,6 +29,9 @@ type WebLogMiddleware (next : RequestDelegate, log : ILogger) 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 serializer + let _ = builder.Services.AddSingleton serializer + let _ = builder.Services.AddSingleton SystemClock.Instance task { do! data.StartUp ()