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

WIP on module/member conversion

Browse Source
This commit is contained in:
Daniel J. Summers
2023-12-14 23:49:38 -05:00
parent ec2d43acde
commit 7071d606f1
19 changed files with 250 additions and 255 deletions
Download Patch File Download Diff File Expand all files Collapse all files

4
src/MyWebLog/Caches.fs
View File

@@ -42,7 +42,7 @@ module Extensions =
member this.UserAccessLevel =
this.User.Claims
|> Seq.tryFind (fun claim -> claim.Type = ClaimTypes.Role)
|> Option.map (fun claim -> AccessLevel.parse claim.Value)
|> Option.map (fun claim -> AccessLevel.Parse claim.Value)
/// The user ID for the current request
member this.UserId =
@@ -53,7 +53,7 @@ module Extensions =
/// Does the current user have the requested level of access?
member this.HasAccessLevel level =
defaultArg (this.UserAccessLevel |> Option.map (AccessLevel.hasAccess level)) false
defaultArg (this.UserAccessLevel |> Option.map (fun it -> it.HasAccess level)) false
open System.Collections.Concurrent

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

@@ -177,7 +177,7 @@ module Category =
let data = ctx.Data
let! model = ctx.BindFormAsync<EditCategoryModel> ()
let category =
if model.IsNew then someTask { Category.empty with Id = CategoryId.create (); WebLogId = ctx.WebLog.Id }
if model.IsNew then someTask { Category.empty with Id = CategoryId.Create(); WebLogId = ctx.WebLog.Id }
else data.Category.FindById (CategoryId model.CategoryId) ctx.WebLog.Id
match! category with
| Some cat ->

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

@@ -48,8 +48,8 @@ let deriveFeedType (ctx : HttpContext) feedPath : (FeedType * int) option =
/// Determine the function to retrieve posts for the given feed
let private getFeedPosts ctx feedType =
let childIds catId =
let cat = CategoryCache.get ctx |> Array.find (fun c -> c.Id = CategoryId.toString catId)
let childIds (catId: CategoryId) =
let cat = CategoryCache.get ctx |> Array.find (fun c -> c.Id = catId.Value)
getCategoryIds cat.Slug ctx
let data = ctx.Data
match feedType with
@@ -116,7 +116,7 @@ let private toFeedItem webLog (authors : MetaItem list) (cats : DisplayCategory[
Name = (authors |> List.find (fun a -> a.Name = WebLogUserId.toString post.AuthorId)).Value))
[ post.CategoryIds
|> List.map (fun catId ->
let cat = cats |> Array.find (fun c -> c.Id = CategoryId.toString catId)
let cat = cats |> Array.find (fun c -> c.Id = catId.Value)
SyndicationCategory (cat.Name, WebLog.absoluteUrl webLog (Permalink $"category/{cat.Slug}/"), cat.Name))
post.Tags
|> List.map (fun tag ->
@@ -143,28 +143,27 @@ let private addEpisode webLog (podcast : PodcastOptions) (episode : Episode) (po
| link -> WebLog.absoluteUrl webLog (Permalink link)
let epMediaType = [ episode.MediaType; podcast.DefaultMediaType ] |> List.tryFind Option.isSome |> Option.flatten
let epImageUrl = defaultArg episode.ImageUrl (Permalink.toString podcast.ImageUrl) |> toAbsolute webLog
let epExplicit = defaultArg episode.Explicit podcast.Explicit |> ExplicitRating.toString
let epExplicit = (defaultArg episode.Explicit podcast.Explicit).Value
let xmlDoc = XmlDocument ()
let xmlDoc = XmlDocument()
let enclosure =
let it = xmlDoc.CreateElement "enclosure"
it.SetAttribute ("url", epMediaUrl)
it.SetAttribute ("length", string episode.Length)
epMediaType |> Option.iter (fun typ -> it.SetAttribute ("type", typ))
it.SetAttribute("url", epMediaUrl)
it.SetAttribute("length", string episode.Length)
epMediaType |> Option.iter (fun typ -> it.SetAttribute("type", typ))
it
let image =
let it = xmlDoc.CreateElement ("itunes", "image", Namespace.iTunes)
it.SetAttribute ("href", epImageUrl)
let it = xmlDoc.CreateElement("itunes", "image", Namespace.iTunes)
it.SetAttribute("href", epImageUrl)
it
item.ElementExtensions.Add enclosure
item.ElementExtensions.Add image
item.ElementExtensions.Add ("creator", Namespace.dc, podcast.DisplayedAuthor)
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.formatDuration episode
|> Option.iter (fun it -> item.ElementExtensions.Add ("duration", Namespace.iTunes, it))
item.ElementExtensions.Add("creator", Namespace.dc, podcast.DisplayedAuthor)
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.FormatDuration() |> Option.iter (fun it -> item.ElementExtensions.Add("duration", Namespace.iTunes, it))
match episode.ChapterFile with
| Some chapters ->
@@ -174,21 +173,20 @@ let private addEpisode webLog (podcast : PodcastOptions) (episode : Episode) (po
| Some mime -> Some mime
| None when chapters.EndsWith ".json" -> Some "application/json+chapters"
| None -> None
let elt = xmlDoc.CreateElement ("podcast", "chapters", Namespace.podcast)
elt.SetAttribute ("url", url)
typ |> Option.iter (fun it -> elt.SetAttribute ("type", it))
let elt = xmlDoc.CreateElement("podcast", "chapters", Namespace.podcast)
elt.SetAttribute("url", url)
typ |> Option.iter (fun it -> elt.SetAttribute("type", it))
item.ElementExtensions.Add elt
| None -> ()
match episode.TranscriptUrl with
| Some transcript ->
let url = toAbsolute webLog transcript
let elt = xmlDoc.CreateElement ("podcast", "transcript", Namespace.podcast)
elt.SetAttribute ("url", url)
elt.SetAttribute ("type", Option.get episode.TranscriptType)
episode.TranscriptLang |> Option.iter (fun it -> elt.SetAttribute ("language", it))
if defaultArg episode.TranscriptCaptions false then
elt.SetAttribute ("rel", "captions")
let elt = xmlDoc.CreateElement("podcast", "transcript", Namespace.podcast)
elt.SetAttribute("url", url)
elt.SetAttribute("type", Option.get episode.TranscriptType)
episode.TranscriptLang |> Option.iter (fun it -> elt.SetAttribute("language", it))
if defaultArg episode.TranscriptCaptions false then elt.SetAttribute("rel", "captions")
item.ElementExtensions.Add elt
| None -> ()
@@ -196,38 +194,37 @@ let private addEpisode webLog (podcast : PodcastOptions) (episode : Episode) (po
| Some season ->
match episode.SeasonDescription with
| Some desc ->
let elt = xmlDoc.CreateElement ("podcast", "season", Namespace.podcast)
elt.SetAttribute ("name", desc)
let elt = xmlDoc.CreateElement("podcast", "season", Namespace.podcast)
elt.SetAttribute("name", desc)
elt.InnerText <- string season
item.ElementExtensions.Add elt
| None -> item.ElementExtensions.Add ("season", Namespace.podcast, string season)
| None -> item.ElementExtensions.Add("season", Namespace.podcast, string season)
| None -> ()
match episode.EpisodeNumber with
| Some epNumber ->
match episode.EpisodeDescription with
| Some desc ->
let elt = xmlDoc.CreateElement ("podcast", "episode", Namespace.podcast)
elt.SetAttribute ("name", desc)
let elt = xmlDoc.CreateElement("podcast", "episode", Namespace.podcast)
elt.SetAttribute("name", desc)
elt.InnerText <- string epNumber
item.ElementExtensions.Add elt
| None -> item.ElementExtensions.Add ("episode", Namespace.podcast, string epNumber)
| None -> item.ElementExtensions.Add("episode", Namespace.podcast, string epNumber)
| None -> ()
if post.Metadata |> List.exists (fun it -> it.Name = "chapter") then
try
let chapters = xmlDoc.CreateElement ("psc", "chapters", Namespace.psc)
chapters.SetAttribute ("version", "1.2")
let chapters = xmlDoc.CreateElement("psc", "chapters", Namespace.psc)
chapters.SetAttribute("version", "1.2")
post.Metadata
|> List.filter (fun it -> it.Name = "chapter")
|> List.map (fun it ->
TimeSpan.Parse (it.Value.Split(" ")[0]), it.Value.Substring (it.Value.IndexOf(" ") + 1))
|> List.map (fun it -> TimeSpan.Parse(it.Value.Split(" ")[0]), it.Value[it.Value.IndexOf(" ") + 1..])
|> List.sortBy fst
|> List.iter (fun chap ->
let chapter = xmlDoc.CreateElement ("psc", "chapter", Namespace.psc)
chapter.SetAttribute ("start", (fst chap).ToString "hh:mm:ss")
chapter.SetAttribute ("title", snd chap)
let chapter = xmlDoc.CreateElement("psc", "chapter", Namespace.psc)
chapter.SetAttribute("start", (fst chap).ToString "hh:mm:ss")
chapter.SetAttribute("title", snd chap)
chapters.AppendChild chapter |> ignore)
item.ElementExtensions.Add chapters
@@ -300,21 +297,21 @@ let private addPodcast webLog (rssFeed : SyndicationFeed) (feed : CustomFeed) =
rssFeed.ElementExtensions.Add categorization
rssFeed.ElementExtensions.Add iTunesImage
rssFeed.ElementExtensions.Add rawVoice
rssFeed.ElementExtensions.Add ("summary", Namespace.iTunes, podcast.Summary)
rssFeed.ElementExtensions.Add ("author", Namespace.iTunes, podcast.DisplayedAuthor)
rssFeed.ElementExtensions.Add ("explicit", Namespace.iTunes, ExplicitRating.toString podcast.Explicit)
rssFeed.ElementExtensions.Add("summary", Namespace.iTunes, podcast.Summary)
rssFeed.ElementExtensions.Add("author", Namespace.iTunes, podcast.DisplayedAuthor)
rssFeed.ElementExtensions.Add("explicit", Namespace.iTunes, podcast.Explicit.Value)
podcast.Subtitle |> Option.iter (fun sub -> rssFeed.ElementExtensions.Add ("subtitle", Namespace.iTunes, sub))
podcast.FundingUrl
|> Option.iter (fun url ->
let funding = xmlDoc.CreateElement ("podcast", "funding", Namespace.podcast)
funding.SetAttribute ("url", toAbsolute webLog url)
let funding = xmlDoc.CreateElement("podcast", "funding", Namespace.podcast)
funding.SetAttribute("url", toAbsolute webLog url)
funding.InnerText <- defaultArg podcast.FundingText "Support This Podcast"
rssFeed.ElementExtensions.Add funding)
podcast.PodcastGuid
|> Option.iter (fun guid ->
rssFeed.ElementExtensions.Add ("guid", Namespace.podcast, guid.ToString().ToLowerInvariant ()))
rssFeed.ElementExtensions.Add("guid", Namespace.podcast, guid.ToString().ToLowerInvariant()))
podcast.Medium
|> Option.iter (fun med -> rssFeed.ElementExtensions.Add ("medium", Namespace.podcast, PodcastMedium.toString med))
|> Option.iter (fun med -> rssFeed.ElementExtensions.Add("medium", Namespace.podcast, PodcastMedium.toString med))
/// Get the feed's self reference and non-feed link
let private selfAndLink webLog feedType ctx =

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

@@ -348,12 +348,12 @@ let requireUser : HttpHandler = requiresAuthentication Error.notAuthorized
/// Require a specific level of access for a route
let requireAccess level : HttpHandler = fun next ctx -> task {
match ctx.UserAccessLevel with
| Some userLevel when AccessLevel.hasAccess level userLevel -> return! next ctx
| Some userLevel when userLevel.HasAccess level -> return! next ctx
| Some userLevel ->
do! addMessage ctx
{ UserMessage.warning with
Message = $"The page you tried to access requires {AccessLevel.toString level} privileges"
Detail = Some $"Your account only has {AccessLevel.toString userLevel} privileges"
Message = $"The page you tried to access requires {level.Value} privileges"
Detail = Some $"Your account only has {userLevel.Value} privileges"
}
return! Error.notAuthorized next ctx
| None ->

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

@@ -242,10 +242,10 @@ let edit postId : HttpHandler = requireAccess Author >=> fun next ctx -> task {
|> Array.mapi (fun idx (name, value) -> [| string idx; name; value |]))
|> addToHash "templates" templates
|> addToHash "explicit_values" [|
KeyValuePair.Create ("", "&ndash; Default &ndash;")
KeyValuePair.Create (ExplicitRating.toString Yes, "Yes")
KeyValuePair.Create (ExplicitRating.toString No, "No")
KeyValuePair.Create (ExplicitRating.toString Clean, "Clean")
KeyValuePair.Create("", "&ndash; Default &ndash;")
KeyValuePair.Create(Yes.Value, "Yes")
KeyValuePair.Create(No.Value, "No")
KeyValuePair.Create(Clean.Value, "Clean")
|]
|> adminView "post-edit" next ctx
| Some _ -> return! Error.notAuthorized next ctx

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

@@ -58,7 +58,7 @@ let doLogOn : HttpHandler = fun next ctx -> task {
Claim (ClaimTypes.NameIdentifier, WebLogUserId.toString user.Id)
Claim (ClaimTypes.Name, $"{user.FirstName} {user.LastName}")
Claim (ClaimTypes.GivenName, user.PreferredName)
Claim (ClaimTypes.Role, AccessLevel.toString user.AccessLevel)
Claim (ClaimTypes.Role, user.AccessLevel.Value)
}
let identity = ClaimsIdentity (claims, CookieAuthenticationDefaults.AuthenticationScheme)
@@ -110,11 +110,10 @@ let private showEdit (model : EditUserModel) : HttpHandler = fun next ctx ->
|> withAntiCsrf ctx
|> addToHash ViewContext.Model model
|> addToHash "access_levels" [|
KeyValuePair.Create (AccessLevel.toString Author, "Author")
KeyValuePair.Create (AccessLevel.toString Editor, "Editor")
KeyValuePair.Create (AccessLevel.toString WebLogAdmin, "Web Log Admin")
if ctx.HasAccessLevel Administrator then
KeyValuePair.Create (AccessLevel.toString Administrator, "Administrator")
KeyValuePair.Create(Author.Value, "Author")
KeyValuePair.Create(Editor.Value, "Editor")
KeyValuePair.Create(WebLogAdmin.Value, "Web Log Admin")
if ctx.HasAccessLevel Administrator then KeyValuePair.Create(Administrator.Value, "Administrator")
|]
|> adminBareView "user-edit" next ctx
@@ -160,7 +159,7 @@ let private showMyInfo (model : EditMyInfoModel) (user : WebLogUser) : HttpHandl
hashForPage "Edit Your Information"
|> withAntiCsrf ctx
|> addToHash ViewContext.Model model
|> addToHash "access_level" (AccessLevel.toString user.AccessLevel)
|> addToHash "access_level" (user.AccessLevel.Value)
|> addToHash "created_on" (WebLog.localTime ctx.WebLog user.CreatedOn)
|> addToHash "last_seen_on" (WebLog.localTime ctx.WebLog
(defaultArg user.LastSeenOn (Instant.FromUnixTimeSeconds 0)))

4
src/MyWebLog/Maintenance.fs
View File

@@ -334,7 +334,7 @@ module Backup =
| Some _ ->
// Err'body gets new IDs...
let newWebLogId = WebLogId.create ()
let newCatIds = archive.Categories |> List.map (fun cat -> cat.Id, CategoryId.create ()) |> dict
let newCatIds = archive.Categories |> List.map (fun cat -> cat.Id, CategoryId.Create ()) |> dict
let newMapIds = archive.TagMappings |> List.map (fun tm -> tm.Id, TagMapId.create ()) |> dict
let newPageIds = archive.Pages |> List.map (fun page -> page.Id, PageId.create ()) |> dict
let newPostIds = archive.Posts |> List.map (fun post -> post.Id, PostId.create ()) |> dict
@@ -481,7 +481,7 @@ let private doUserUpgrade urlBase email (data : IData) = task {
| WebLogAdmin ->
do! data.WebLogUser.Update { user with AccessLevel = Administrator }
printfn $"{email} is now an Administrator user"
| other -> eprintfn $"ERROR: {email} is an {AccessLevel.toString other}, not a WebLogAdmin"
| other -> eprintfn $"ERROR: {email} is an {other.Value}, not a WebLogAdmin"
| None -> eprintfn $"ERROR: no user {email} found at {urlBase}"
| None -> eprintfn $"ERROR: no web log found for {urlBase}"
}