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

v2 RC2 (#33)

Browse Source 
* Add PostgreSQL back end (#30)
* Upgrade password storage (#32)
* Change podcast/episode storage for SQLite (#29)
* Move date/time handling to NodaTime (#31)
This commit was merged in pull request #33.
This commit is contained in:
Daniel J. Summers
2022-08-21 18:56:18 -04:00
committed by GitHub
parent 1ec664ad24
commit 5f3daa1de9
45 changed files with 3820 additions and 1306 deletions
Download Patch File Download Diff File Expand all files Collapse all files

31
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 =
@@ -12,23 +13,22 @@ module Dashboard =
// GET /admin/dashboard
let user : HttpHandler = requireAccess Author >=> fun next ctx -> task {
let getCount (f : WebLogId -> Task<int>) = f ctx.WebLog.Id
let data = ctx.Data
let posts = getCount (data.Post.CountByStatus Published)
let drafts = getCount (data.Post.CountByStatus Draft)
let pages = getCount data.Page.CountAll
let listed = getCount data.Page.CountListed
let cats = getCount data.Category.CountAll
let topCats = getCount data.Category.CountTopLevel
let! _ = Task.WhenAll (posts, drafts, pages, listed, cats, topCats)
let data = ctx.Data
let! posts = getCount (data.Post.CountByStatus Published)
let! drafts = getCount (data.Post.CountByStatus Draft)
let! pages = getCount data.Page.CountAll
let! listed = getCount data.Page.CountListed
let! cats = getCount data.Category.CountAll
let! topCats = getCount data.Category.CountTopLevel
return!
hashForPage "Dashboard"
|> addToHash ViewContext.Model {
Posts = posts.Result
Drafts = drafts.Result
Pages = pages.Result
ListedPages = listed.Result
Categories = cats.Result
TopLevelCategories = topCats.Result
Posts = posts
Drafts = drafts
Pages = pages
ListedPages = listed
Categories = cats
TopLevelCategories = topCats
}
|> adminView "dashboard" next ctx
}
@@ -344,7 +344,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 = Noda.now () }
:: (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 = Noda.now ()
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 = Noda.now () }
:: (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 (Noda.now ())
|> 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 = Noda.now ()
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

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

@@ -2,19 +2,32 @@
module MyWebLog.Handlers.User
open System
open System.Security.Cryptography
open System.Text
open Microsoft.AspNetCore.Http
open Microsoft.AspNetCore.Identity
open MyWebLog
open NodaTime
// ~~ LOG ON / LOG OFF ~~
/// Hash a password for a given user
let hashedPassword (plainText : string) (email : string) (salt : Guid) =
let allSalt = Array.concat [ salt.ToByteArray (); Encoding.UTF8.GetBytes email ]
use alg = new Rfc2898DeriveBytes (plainText, allSalt, 2_048)
Convert.ToBase64String (alg.GetBytes 64)
/// Create a password hash a password for a given user
let createPasswordHash user password =
PasswordHasher<WebLogUser>().HashPassword (user, password)
/// Verify whether a password is valid
let verifyPassword user password (ctx : HttpContext) = backgroundTask {
match user with
| Some usr ->
let hasher = PasswordHasher<WebLogUser> ()
match hasher.VerifyHashedPassword (usr, usr.PasswordHash, password) with
| PasswordVerificationResult.Success -> return Ok ()
| PasswordVerificationResult.SuccessRehashNeeded ->
do! ctx.Data.WebLogUser.Update { usr with PasswordHash = hasher.HashPassword (usr, password) }
return Ok ()
| _ -> return Error "Log on attempt unsuccessful"
| None -> return Error "Log on attempt unsuccessful"
}
open Giraffe
open MyWebLog
open MyWebLog.ViewModels
// GET /user/log-on
@@ -35,10 +48,12 @@ open Microsoft.AspNetCore.Authentication.Cookies
// POST /user/log-on
let doLogOn : HttpHandler = fun next ctx -> task {
let! model = ctx.BindFormAsync<LogOnModel> ()
let data = ctx.Data
match! data.WebLogUser.FindByEmail model.EmailAddress ctx.WebLog.Id with
| Some user when user.PasswordHash = hashedPassword model.Password user.Email user.Salt ->
let! model = ctx.BindFormAsync<LogOnModel> ()
let data = ctx.Data
let! tryUser = data.WebLogUser.FindByEmail model.EmailAddress ctx.WebLog.Id
match! verifyPassword tryUser model.Password ctx with
| Ok _ ->
let user = tryUser.Value
let claims = seq {
Claim (ClaimTypes.NameIdentifier, WebLogUserId.toString user.Id)
Claim (ClaimTypes.Name, $"{user.FirstName} {user.LastName}")
@@ -59,8 +74,8 @@ let doLogOn : HttpHandler = fun next ctx -> task {
match model.ReturnTo with
| Some url -> redirectTo false url next ctx
| None -> redirectToGet "admin/dashboard" next ctx
| _ ->
do! addMessage ctx { UserMessage.error with Message = "Log on attempt unsuccessful" }
| Error msg ->
do! addMessage ctx { UserMessage.error with Message = msg }
return! logOn model.ReturnTo next ctx
}
@@ -147,7 +162,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
@@ -164,19 +181,13 @@ let saveMyInfo : HttpHandler = requireAccess Author >=> fun next ctx -> task {
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 pw = if model.NewPassword = "" then user.PasswordHash else createPasswordHash user model.NewPassword
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"
@@ -198,9 +209,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 = Noda.now ()
} |> someTask
else data.WebLogUser.FindById (WebLogUserId model.Id) ctx.WebLog.Id
match! tryUser with
@@ -211,9 +222,7 @@ let save : HttpHandler = requireAccess WebLogAdmin >=> fun next ctx -> task {
else
let toUpdate =
if model.Password = "" then updatedUser
else
let salt = Guid.NewGuid ()
{ updatedUser with PasswordHash = hashedPassword model.Password model.Email salt; Salt = salt }
else { updatedUser with PasswordHash = createPasswordHash updatedUser model.Password }
do! (if model.IsNew then data.WebLogUser.Add else data.WebLogUser.Update) toUpdate
do! addMessage ctx
{ UserMessage.success with
@@ -227,4 +236,3 @@ let save : HttpHandler = requireAccess WebLogAdmin >=> fun next ctx -> task {
next ctx
| None -> return! Error.notFound next ctx
}