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

WIP on module/member conversion

Browse Source 
Support types done
This commit is contained in:
Daniel J. Summers
2023-12-16 12:24:45 -05:00
parent 5fe2077974
commit d8ce59a6cd
37 changed files with 705 additions and 721 deletions
Download Patch File Download Diff File Expand all files Collapse all files

18
src/MyWebLog/Caches.fs
View File

@@ -194,8 +194,8 @@ module TemplateCache =
let private hasInclude = Regex ("""{% include_template \"(.*)\" %}""", RegexOptions.None, TimeSpan.FromSeconds 2)
/// Get a template for the given theme and template name
let get (themeId : ThemeId) (templateName : string) (data : IData) = backgroundTask {
let templatePath = $"{ThemeId.toString themeId}/{templateName}"
let get (themeId: ThemeId) (templateName: string) (data: IData) = backgroundTask {
let templatePath = $"{themeId}/{templateName}"
match _cache.ContainsKey templatePath with
| true -> return Ok _cache[templatePath]
| false ->
@@ -215,7 +215,7 @@ module TemplateCache =
if childNotFound = "" then child.Groups[1].Value
else $"{childNotFound}; {child.Groups[1].Value}"
""
text <- text.Replace (child.Value, childText)
text <- text.Replace(child.Value, childText)
if childNotFound <> "" then
let s = if childNotFound.IndexOf ";" >= 0 then "s" else ""
return Error $"Could not find the child template{s} {childNotFound} required by {templateName}"
@@ -223,8 +223,8 @@ module TemplateCache =
_cache[templatePath] <- Template.Parse (text, SyntaxCompatibility.DotLiquid22)
return Ok _cache[templatePath]
| None ->
return Error $"Theme ID {ThemeId.toString themeId} does not have a template named {templateName}"
| None -> return Result.Error $"Theme ID {ThemeId.toString themeId} does not exist"
return Error $"Theme ID {themeId} does not have a template named {templateName}"
| None -> return Error $"Theme ID {themeId} does not exist"
}
/// Get all theme/template names currently cached
@@ -232,16 +232,16 @@ module TemplateCache =
_cache.Keys |> Seq.sort |> Seq.toList
/// Invalidate all template cache entries for the given theme ID
let invalidateTheme (themeId : ThemeId) =
let keyPrefix = ThemeId.toString themeId
let invalidateTheme (themeId: ThemeId) =
let keyPrefix = string themeId
_cache.Keys
|> Seq.filter (fun key -> key.StartsWith keyPrefix)
|> Seq.filter _.StartsWith(keyPrefix)
|> List.ofSeq
|> List.iter (fun key -> match _cache.TryRemove key with _, _ -> ())
/// Remove all entries from the template cache
let empty () =
_cache.Clear ()
_cache.Clear()
/// A cache of asset names by themes

6
src/MyWebLog/DotLiquidBespoke.fs
View File

@@ -95,9 +95,9 @@ type NavLinkFilter () =
/// A filter to generate a link for theme asset (image, stylesheet, script, etc.)
type ThemeAssetFilter () =
static member ThemeAsset (ctx : Context, asset : string) =
WebLog.relativeUrl ctx.WebLog (Permalink $"themes/{ThemeId.toString ctx.WebLog.ThemeId}/{asset}")
type ThemeAssetFilter() =
static member ThemeAsset(ctx: Context, asset: string) =
WebLog.relativeUrl ctx.WebLog (Permalink $"themes/{ctx.WebLog.ThemeId}/{asset}")
/// Create various items in the page header based on the state of the page being generated

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

@@ -37,7 +37,7 @@ module Dashboard =
let admin : HttpHandler = requireAccess Administrator >=> fun next ctx -> task {
match! TemplateCache.get adminTheme "theme-list-body" ctx.Data with
| Ok bodyTemplate ->
let! themes = ctx.Data.Theme.All ()
let! themes = ctx.Data.Theme.All()
let cachedTemplates = TemplateCache.allNames ()
let! hash =
hashForPage "myWebLog Administration"
@@ -50,10 +50,10 @@ module Dashboard =
themes
|> Seq.ofList
|> Seq.map (fun it -> [|
ThemeId.toString it.Id
string it.Id
it.Name
cachedTemplates
|> List.filter (fun n -> n.StartsWith (ThemeId.toString it.Id))
|> List.filter _.StartsWith(string it.Id)
|> List.length
|> string
|])
@@ -61,8 +61,8 @@ module Dashboard =
|> addToHash "web_logs" (
WebLogCache.all ()
|> Seq.ofList
|> Seq.sortBy (fun it -> it.Name)
|> Seq.map (fun it -> [| WebLogId.toString it.Id; it.Name; it.UrlBase |])
|> Seq.sortBy _.Name
|> Seq.map (fun it -> [| string it.Id; it.Name; it.UrlBase |])
|> Array.ofSeq)
|> addViewContext ctx
return!
@@ -317,7 +317,7 @@ module TagMapping =
addToHash "mappings" mappings hash
|> addToHash "mapping_ids" (
mappings
|> List.map (fun it -> { Name = it.Tag; Value = TagMapId.toString it.Id }))
|> List.map (fun it -> { Name = it.Tag; Value = string it.Id }))
}
// GET /admin/settings/tag-mappings
@@ -348,13 +348,13 @@ module TagMapping =
// POST /admin/settings/tag-mapping/save
let save : HttpHandler = fun next ctx -> task {
let data = ctx.Data
let! model = ctx.BindFormAsync<EditTagMapModel> ()
let! model = ctx.BindFormAsync<EditTagMapModel>()
let tagMap =
if model.IsNew then someTask { TagMap.empty with Id = TagMapId.create (); WebLogId = ctx.WebLog.Id }
if model.IsNew then someTask { TagMap.empty with Id = TagMapId.Create(); WebLogId = ctx.WebLog.Id }
else data.TagMap.FindById (TagMapId model.Id) ctx.WebLog.Id
match! tagMap with
| Some tm ->
do! data.TagMap.Save { tm with Tag = model.Tag.ToLower (); UrlValue = model.UrlValue.ToLower () }
do! data.TagMap.Save { tm with Tag = model.Tag.ToLower(); UrlValue = model.UrlValue.ToLower() }
do! addMessage ctx { UserMessage.success with Message = "Tag mapping saved successfully" }
return! all next ctx
| None -> return! Error.notFound next ctx
@@ -395,17 +395,17 @@ module Theme =
|> adminBareView "theme-upload" next ctx
/// Update the name and version for a theme based on the version.txt file, if present
let private updateNameAndVersion (theme : Theme) (zip : ZipArchive) = backgroundTask {
let private updateNameAndVersion (theme: Theme) (zip: ZipArchive) = backgroundTask {
let now () = DateTime.UtcNow.ToString "yyyyMMdd.HHmm"
match zip.Entries |> Seq.filter (fun it -> it.FullName = "version.txt") |> Seq.tryHead with
| Some versionItem ->
use versionFile = new StreamReader(versionItem.Open ())
let! versionText = versionFile.ReadToEndAsync ()
use versionFile = new StreamReader(versionItem.Open())
let! versionText = versionFile.ReadToEndAsync()
let parts = versionText.Trim().Replace("\r", "").Split "\n"
let displayName = if parts[0] > "" then parts[0] else ThemeId.toString theme.Id
let displayName = if parts[0] > "" then parts[0] else string theme.Id
let version = if parts.Length > 1 && parts[1] > "" then parts[1] else now ()
return { theme with Name = displayName; Version = version }
| None -> return { theme with Name = ThemeId.toString theme.Id; Version = now () }
| None -> return { theme with Name = string theme.Id; Version = now () }
}
/// Update the theme with all templates from the ZIP archive
@@ -476,16 +476,16 @@ module Theme =
let data = ctx.Data
let! exists = data.Theme.Exists themeId
let isNew = not exists
let! model = ctx.BindFormAsync<UploadThemeModel> ()
let! model = ctx.BindFormAsync<UploadThemeModel>()
if isNew || model.DoOverwrite then
// Load the theme to the database
use stream = new MemoryStream ()
use stream = new MemoryStream()
do! themeFile.CopyToAsync stream
let! _ = loadFromZip themeId stream data
do! ThemeAssetCache.refreshTheme themeId data
TemplateCache.invalidateTheme themeId
// Save the .zip file
use file = new FileStream ($"{ThemeId.toString themeId}-theme.zip", FileMode.Create)
use file = new FileStream($"{themeId}-theme.zip", FileMode.Create)
do! themeFile.CopyToAsync file
do! addMessage ctx
{ UserMessage.success with
@@ -556,18 +556,18 @@ module WebLog =
KeyValuePair.Create("posts", "- First Page of Posts -")
yield! allPages
|> List.sortBy _.Title.ToLower()
|> List.map (fun p -> KeyValuePair.Create(p.Id.Value, p.Title))
|> List.map (fun p -> KeyValuePair.Create(string p.Id, p.Title))
}
|> Array.ofSeq)
|> addToHash "themes" (
themes
|> Seq.ofList
|> Seq.map (fun it ->
KeyValuePair.Create (ThemeId.toString it.Id, $"{it.Name} (v{it.Version})"))
KeyValuePair.Create(string it.Id, $"{it.Name} (v{it.Version})"))
|> Array.ofSeq)
|> addToHash "upload_values" [|
KeyValuePair.Create (UploadDestination.toString Database, "Database")
KeyValuePair.Create (UploadDestination.toString Disk, "Disk")
KeyValuePair.Create(string Database, "Database")
KeyValuePair.Create(string Disk, "Disk")
|]
|> addToHash "users" (users |> List.map (DisplayUser.fromUser ctx.WebLog) |> Array.ofList)
|> addToHash "rss_model" (EditRssModel.fromRssOptions ctx.WebLog.Rss)

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

@@ -37,7 +37,7 @@ let deriveFeedType (ctx : HttpContext) feedPath : (FeedType * int) option =
| false ->
// Category and tag feeds are handled by defined routes; check for custom feed
match webLog.Rss.CustomFeeds
|> List.tryFind (fun it -> feedPath.EndsWith it.Path.Value) with
|> List.tryFind (fun it -> feedPath.EndsWith(string it.Path)) with
| Some feed ->
debug (fun () -> "Found custom feed")
Some (Custom (feed, feedPath), feed.Podcast |> Option.map _.ItemsInFeed |> Option.defaultValue postCount)
@@ -48,7 +48,7 @@ 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: CategoryId) =
let cat = CategoryCache.get ctx |> Array.find (fun c -> c.Id = catId.Value)
let cat = CategoryCache.get ctx |> Array.find (fun c -> c.Id = string catId)
getCategoryIds cat.Slug ctx
let data = ctx.Data
match feedType with
@@ -86,51 +86,50 @@ module private Namespace =
let rawVoice = "http://www.rawvoice.com/rawvoiceRssModule/"
/// Create a feed item from the given post
let private toFeedItem webLog (authors : MetaItem list) (cats : DisplayCategory[]) (tagMaps : TagMap list)
(post : Post) =
let private toFeedItem webLog (authors: MetaItem list) (cats: DisplayCategory array) (tagMaps: TagMap list)
(post: Post) =
let plainText =
let endingP = post.Text.IndexOf "</p>"
stripHtml <| if endingP >= 0 then post.Text[..(endingP - 1)] else post.Text
let item = SyndicationItem (
let item = SyndicationItem(
Id = WebLog.absoluteUrl webLog post.Permalink,
Title = TextSyndicationContent.CreateHtmlContent post.Title,
PublishDate = post.PublishedOn.Value.ToDateTimeOffset (),
LastUpdatedTime = post.UpdatedOn.ToDateTimeOffset (),
PublishDate = post.PublishedOn.Value.ToDateTimeOffset(),
LastUpdatedTime = post.UpdatedOn.ToDateTimeOffset(),
Content = TextSyndicationContent.CreatePlaintextContent plainText)
item.AddPermalink (Uri item.Id)
let xmlDoc = XmlDocument ()
let xmlDoc = XmlDocument()
let encoded =
let txt =
post.Text
.Replace("src=\"/", $"src=\"{webLog.UrlBase}/")
.Replace ("href=\"/", $"href=\"{webLog.UrlBase}/")
let it = xmlDoc.CreateElement ("content", "encoded", Namespace.content)
let _ = it.AppendChild (xmlDoc.CreateCDataSection txt)
.Replace("href=\"/", $"href=\"{webLog.UrlBase}/")
let it = xmlDoc.CreateElement("content", "encoded", Namespace.content)
let _ = it.AppendChild(xmlDoc.CreateCDataSection txt)
it
item.ElementExtensions.Add encoded
item.Authors.Add (SyndicationPerson (
Name = (authors |> List.find (fun a -> a.Name = WebLogUserId.toString post.AuthorId)).Value))
item.Authors.Add(SyndicationPerson(Name = (authors |> List.find (fun a -> a.Name = string post.AuthorId)).Value))
[ post.CategoryIds
|> List.map (fun catId ->
let cat = cats |> Array.find (fun c -> c.Id = catId.Value)
SyndicationCategory (cat.Name, WebLog.absoluteUrl webLog (Permalink $"category/{cat.Slug}/"), cat.Name))
let cat = cats |> Array.find (fun c -> c.Id = string catId)
SyndicationCategory(cat.Name, WebLog.absoluteUrl webLog (Permalink $"category/{cat.Slug}/"), cat.Name))
post.Tags
|> List.map (fun tag ->
let urlTag =
match tagMaps |> List.tryFind (fun tm -> tm.Tag = tag) with
| Some tm -> tm.UrlValue
| None -> tag.Replace (" ", "+")
SyndicationCategory (tag, WebLog.absoluteUrl webLog (Permalink $"tag/{urlTag}/"), $"{tag} (tag)"))
SyndicationCategory(tag, WebLog.absoluteUrl webLog (Permalink $"tag/{urlTag}/"), $"{tag} (tag)"))
]
|> List.concat
|> List.iter item.Categories.Add
item
/// Convert non-absolute URLs to an absolute URL for this web log
let toAbsolute webLog (link : string) =
let toAbsolute webLog (link: string) =
if link.StartsWith "http" then link else WebLog.absoluteUrl webLog (Permalink link)
/// Add episode information to a podcast feed item
@@ -141,8 +140,8 @@ let private addEpisode webLog (podcast : PodcastOptions) (episode : Episode) (po
| link when Option.isSome podcast.MediaBaseUrl -> $"{podcast.MediaBaseUrl.Value}{link}"
| link -> WebLog.absoluteUrl webLog (Permalink link)
let epMediaType = [ episode.MediaType; podcast.DefaultMediaType ] |> List.tryFind Option.isSome |> Option.flatten
let epImageUrl = defaultArg episode.ImageUrl podcast.ImageUrl.Value |> toAbsolute webLog
let epExplicit = (defaultArg episode.Explicit podcast.Explicit).Value
let epImageUrl = defaultArg episode.ImageUrl (string podcast.ImageUrl) |> toAbsolute webLog
let epExplicit = string (defaultArg episode.Explicit podcast.Explicit)
let xmlDoc = XmlDocument()
let enclosure =
@@ -298,7 +297,7 @@ let private addPodcast webLog (rssFeed : SyndicationFeed) (feed : CustomFeed) =
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, podcast.Explicit.Value)
rssFeed.ElementExtensions.Add("explicit", Namespace.iTunes, string podcast.Explicit)
podcast.Subtitle |> Option.iter (fun sub -> rssFeed.ElementExtensions.Add ("subtitle", Namespace.iTunes, sub))
podcast.FundingUrl
|> Option.iter (fun url ->
@@ -309,7 +308,7 @@ let private addPodcast webLog (rssFeed : SyndicationFeed) (feed : CustomFeed) =
podcast.PodcastGuid
|> Option.iter (fun guid ->
rssFeed.ElementExtensions.Add("guid", Namespace.podcast, guid.ToString().ToLowerInvariant()))
podcast.Medium |> Option.iter (fun med -> rssFeed.ElementExtensions.Add("medium", Namespace.podcast, med.Value))
podcast.Medium |> Option.iter (fun med -> rssFeed.ElementExtensions.Add("medium", Namespace.podcast, string med))
/// Get the feed's self reference and non-feed link
let private selfAndLink webLog feedType ctx =
@@ -368,7 +367,7 @@ let createFeed (feedType : FeedType) posts : HttpHandler = fun next ctx -> backg
match podcast, post.Episode with
| Some feed, Some episode -> addEpisode webLog (Option.get feed.Podcast) episode post item
| Some _, _ ->
warn "Feed" ctx $"[{webLog.Name} {self.Value}] \"{stripHtml post.Title}\" has no media"
warn "Feed" ctx $"[{webLog.Name} {self}] \"{stripHtml post.Title}\" has no media"
item
| _ -> item
@@ -427,7 +426,7 @@ let saveSettings : HttpHandler = requireAccess WebLogAdmin >=> fun next ctx -> t
let editCustomFeed feedId : HttpHandler = requireAccess WebLogAdmin >=> fun next ctx ->
let customFeed =
match feedId with
| "new" -> Some { CustomFeed.empty with Id = CustomFeedId "new" }
| "new" -> Some { CustomFeed.Empty with Id = CustomFeedId "new" }
| _ -> ctx.WebLog.Rss.CustomFeeds |> List.tryFind (fun f -> f.Id = CustomFeedId feedId)
match customFeed with
| Some f ->
@@ -436,13 +435,13 @@ let editCustomFeed feedId : HttpHandler = requireAccess WebLogAdmin >=> fun next
|> addToHash ViewContext.Model (EditCustomFeedModel.fromFeed f)
|> addToHash "medium_values" [|
KeyValuePair.Create("", "&ndash; Unspecified &ndash;")
KeyValuePair.Create(Podcast.Value, "Podcast")
KeyValuePair.Create(Music.Value, "Music")
KeyValuePair.Create(Video.Value, "Video")
KeyValuePair.Create(Film.Value, "Film")
KeyValuePair.Create(Audiobook.Value, "Audiobook")
KeyValuePair.Create(Newsletter.Value, "Newsletter")
KeyValuePair.Create(Blog.Value, "Blog")
KeyValuePair.Create(string Podcast, "Podcast")
KeyValuePair.Create(string Music, "Music")
KeyValuePair.Create(string Video, "Video")
KeyValuePair.Create(string Film, "Film")
KeyValuePair.Create(string Audiobook, "Audiobook")
KeyValuePair.Create(string Newsletter, "Newsletter")
KeyValuePair.Create(string Blog, "Blog")
|]
|> adminView "custom-feed-edit" next ctx
| None -> Error.notFound next ctx
@@ -455,8 +454,8 @@ let saveCustomFeed : HttpHandler = requireAccess WebLogAdmin >=> fun next ctx ->
let! model = ctx.BindFormAsync<EditCustomFeedModel> ()
let theFeed =
match model.Id with
| "new" -> Some { CustomFeed.empty with Id = CustomFeedId.create () }
| _ -> webLog.Rss.CustomFeeds |> List.tryFind (fun it -> CustomFeedId.toString it.Id = model.Id)
| "new" -> Some { CustomFeed.Empty with Id = CustomFeedId.Create() }
| _ -> webLog.Rss.CustomFeeds |> List.tryFind (fun it -> string it.Id = model.Id)
match theFeed with
| Some feed ->
let feeds = model.UpdateFeed feed :: (webLog.Rss.CustomFeeds |> List.filter (fun it -> it.Id <> feed.Id))
@@ -467,7 +466,7 @@ let saveCustomFeed : HttpHandler = requireAccess WebLogAdmin >=> fun next ctx ->
UserMessage.success with
Message = $"""Successfully {if model.Id = "new" then "add" else "sav"}ed custom feed"""
}
return! redirectToGet $"admin/settings/rss/{CustomFeedId.toString feed.Id}/edit" next ctx
return! redirectToGet $"admin/settings/rss/{feed.Id}/edit" next ctx
| None -> return! Error.notFound next ctx
| None -> return! Error.notFound next ctx
}

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

@@ -352,8 +352,8 @@ let requireAccess level : HttpHandler = fun next ctx -> task {
| Some userLevel ->
do! addMessage ctx
{ UserMessage.warning with
Message = $"The page you tried to access requires {level.Value} privileges"
Detail = Some $"Your account only has {userLevel.Value} privileges"
Message = $"The page you tried to access requires {level} privileges"
Detail = Some $"Your account only has {userLevel} privileges"
}
return! Error.notAuthorized next ctx
| None ->

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

@@ -193,7 +193,7 @@ let save : HttpHandler = requireAccess Author >=> fun next ctx -> task {
do! (if model.IsNew 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/{page.Id.Value}/edit" next ctx
return! redirectToGet $"admin/page/{page.Id}/edit" next ctx
| Some _ -> return! Error.notAuthorized next ctx
| None -> return! Error.notFound next ctx
}

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

@@ -58,7 +58,7 @@ let preparePostList webLog posts listType (url: string) pageNbr perPage (data: I
| _ -> Task.FromResult (None, None)
let newerLink =
match listType, pageNbr with
| SinglePost, _ -> newerPost |> Option.map _.Permalink.Value
| SinglePost, _ -> newerPost |> Option.map (fun it -> string it.Permalink)
| _, 1 -> None
| PostList, 2 when webLog.DefaultPage = "posts" -> Some ""
| PostList, _ -> relUrl $"page/{pageNbr - 1}"
@@ -70,7 +70,7 @@ let preparePostList webLog posts listType (url: string) pageNbr perPage (data: I
| AdminList, _ -> relUrl $"admin/posts/page/{pageNbr - 1}"
let olderLink =
match listType, List.length posts > perPage with
| SinglePost, _ -> olderPost |> Option.map _.Permalink.Value
| SinglePost, _ -> olderPost |> Option.map (fun it -> string it.Permalink)
| _, false -> None
| PostList, true -> relUrl $"page/{pageNbr + 1}"
| CategoryList, true -> relUrl $"category/{url}/page/{pageNbr + 1}"
@@ -243,9 +243,9 @@ let edit postId : HttpHandler = requireAccess Author >=> fun next ctx -> task {
|> addToHash "templates" templates
|> addToHash "explicit_values" [|
KeyValuePair.Create("", "&ndash; Default &ndash;")
KeyValuePair.Create(Yes.Value, "Yes")
KeyValuePair.Create(No.Value, "No")
KeyValuePair.Create(Clean.Value, "Clean")
KeyValuePair.Create(string Yes, "Yes")
KeyValuePair.Create(string No, "No")
KeyValuePair.Create(string Clean, "Clean")
|]
|> adminView "post-edit" next ctx
| Some _ -> return! Error.notAuthorized next ctx
@@ -410,7 +410,7 @@ let save : HttpHandler = requireAccess Author >=> fun next ctx -> task {
|> List.length = List.length priorCats) then
do! CategoryCache.update ctx
do! addMessage ctx { UserMessage.success with Message = "Post saved successfully" }
return! redirectToGet $"admin/post/{post.Id.Value}/edit" next ctx
return! redirectToGet $"admin/post/{post.Id}/edit" next ctx
| Some _ -> return! Error.notAuthorized next ctx
| None -> return! Error.notFound next ctx
}

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

@@ -88,13 +88,13 @@ module CatchAll =
module Asset =
// GET /theme/{theme}/{**path}
let serve (urlParts : string seq) : HttpHandler = fun next ctx -> task {
let serve (urlParts: string seq) : HttpHandler = fun next ctx -> task {
let path = urlParts |> Seq.skip 1 |> Seq.head
match! ctx.Data.ThemeAsset.FindById (ThemeAssetId.ofString path) with
match! ctx.Data.ThemeAsset.FindById(ThemeAssetId.Parse path) with
| Some asset ->
match Upload.checkModified asset.UpdatedOn ctx with
| Some threeOhFour -> return! threeOhFour next ctx
| None -> return! Upload.sendFile (asset.UpdatedOn.ToDateTimeUtc ()) path asset.Data next ctx
| None -> return! Upload.sendFile (asset.UpdatedOn.ToDateTimeUtc()) path asset.Data next ctx
| None -> return! Error.notFound next ctx
}

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

@@ -107,7 +107,7 @@ let list : HttpHandler = requireAccess Author >=> fun next ctx -> task {
Name = name
Path = file.Replace($"{path}{slash}", "").Replace(name, "").Replace (slash, '/')
UpdatedOn = create
Source = UploadDestination.toString Disk
Source = string Disk
})
|> List.ofSeq
with
@@ -131,7 +131,7 @@ let list : HttpHandler = requireAccess Author >=> fun next ctx -> task {
let showNew : HttpHandler = requireAccess Author >=> fun next ctx ->
hashForPage "Upload a File"
|> withAntiCsrf ctx
|> addToHash "destination" (UploadDestination.toString ctx.WebLog.Uploads)
|> addToHash "destination" (string ctx.WebLog.Uploads)
|> adminView "upload-new" next ctx
@@ -144,29 +144,29 @@ let save : HttpHandler = requireAccess Author >=> fun next ctx -> task {
if ctx.Request.HasFormContentType && ctx.Request.Form.Files.Count > 0 then
let upload = Seq.head ctx.Request.Form.Files
let fileName = String.Concat (makeSlug (Path.GetFileNameWithoutExtension upload.FileName),
Path.GetExtension(upload.FileName).ToLowerInvariant ())
Path.GetExtension(upload.FileName).ToLowerInvariant())
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> ()
let! form = ctx.BindFormAsync<UploadFileModel>()
match UploadDestination.parse form.Destination with
match UploadDestination.Parse form.Destination with
| Database ->
use stream = new MemoryStream ()
use stream = new MemoryStream()
do! upload.CopyToAsync stream
let file =
{ Id = UploadId.create ()
{ Id = UploadId.Create()
WebLogId = ctx.WebLog.Id
Path = Permalink $"{year}/{month}/{fileName}"
UpdatedOn = now
Data = stream.ToArray ()
Data = stream.ToArray()
}
do! ctx.Data.Upload.Add file
| Disk ->
let fullPath = Path.Combine (uploadDir, ctx.WebLog.Slug, year, month)
let fullPath = Path.Combine(uploadDir, ctx.WebLog.Slug, year, month)
let _ = Directory.CreateDirectory fullPath
use stream = new FileStream (Path.Combine (fullPath, fileName), FileMode.Create)
use stream = new FileStream(Path.Combine(fullPath, fileName), FileMode.Create)
do! upload.CopyToAsync stream
do! addMessage ctx { UserMessage.success with Message = $"File uploaded to {form.Destination} successfully" }

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

@@ -48,22 +48,22 @@ open Microsoft.AspNetCore.Authentication.Cookies
// POST /user/log-on
let doLogOn : HttpHandler = fun next ctx -> task {
let! model = ctx.BindFormAsync<LogOnModel> ()
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}")
Claim (ClaimTypes.GivenName, user.PreferredName)
Claim (ClaimTypes.Role, user.AccessLevel.Value)
Claim(ClaimTypes.NameIdentifier, string user.Id)
Claim(ClaimTypes.Name, $"{user.FirstName} {user.LastName}")
Claim(ClaimTypes.GivenName, user.PreferredName)
Claim(ClaimTypes.Role, string user.AccessLevel)
}
let identity = ClaimsIdentity (claims, CookieAuthenticationDefaults.AuthenticationScheme)
let identity = ClaimsIdentity(claims, CookieAuthenticationDefaults.AuthenticationScheme)
do! ctx.SignInAsync (identity.AuthenticationType, ClaimsPrincipal identity,
AuthenticationProperties (IssuedUtc = DateTimeOffset.UtcNow))
do! ctx.SignInAsync(identity.AuthenticationType, ClaimsPrincipal identity,
AuthenticationProperties(IssuedUtc = DateTimeOffset.UtcNow))
do! data.WebLogUser.SetLastSeen user.Id user.WebLogId
do! addMessage ctx
{ UserMessage.success with
@@ -110,10 +110,10 @@ let private showEdit (model : EditUserModel) : HttpHandler = fun next ctx ->
|> withAntiCsrf ctx
|> addToHash ViewContext.Model model
|> addToHash "access_levels" [|
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")
KeyValuePair.Create(string Author, "Author")
KeyValuePair.Create(string Editor, "Editor")
KeyValuePair.Create(string WebLogAdmin, "Web Log Admin")
if ctx.HasAccessLevel Administrator then KeyValuePair.Create(string Administrator, "Administrator")
|]
|> adminBareView "user-edit" next ctx
@@ -159,7 +159,7 @@ let private showMyInfo (model : EditMyInfoModel) (user : WebLogUser) : HttpHandl
hashForPage "Edit Your Information"
|> withAntiCsrf ctx
|> addToHash ViewContext.Model model
|> addToHash "access_level" (user.AccessLevel.Value)
|> addToHash "access_level" (string user.AccessLevel)
|> addToHash "created_on" (WebLog.localTime ctx.WebLog user.CreatedOn)
|> addToHash "last_seen_on" (WebLog.localTime ctx.WebLog
(defaultArg user.LastSeenOn (Instant.FromUnixTimeSeconds 0)))
@@ -208,7 +208,7 @@ let save : HttpHandler = requireAccess WebLogAdmin >=> fun next ctx -> task {
let tryUser =
if model.IsNew then
{ WebLogUser.empty with
Id = WebLogUserId.create ()
Id = WebLogUserId.Create()
WebLogId = ctx.WebLog.Id
CreatedOn = Noda.now ()
} |> someTask

28
src/MyWebLog/Maintenance.fs
View File

@@ -21,8 +21,8 @@ let private doCreateWebLog (args : string[]) (sp : IServiceProvider) = task {
| false, _ -> raise <| TimeZoneNotFoundException $"Cannot find IANA timezone for {local}"
// Create the web log
let webLogId = WebLogId.create ()
let userId = WebLogUserId.create ()
let webLogId = WebLogId.Create()
let userId = WebLogUserId.Create()
let homePageId = PageId.Create()
let slug = Handlers.Upload.makeSlug args[2]
@@ -37,7 +37,7 @@ let private doCreateWebLog (args : string[]) (sp : IServiceProvider) = task {
Name = args[2]
Slug = slug
UrlBase = args[1]
DefaultPage = homePageId.Value
DefaultPage = string homePageId
TimeZone = timeZone
}
@@ -110,8 +110,8 @@ let private importPriorPermalinks urlBase file (sp : IServiceProvider) = task {
let! withLinks = data.Post.FindFullById post.Id post.WebLogId
let! _ = data.Post.UpdatePriorPermalinks post.Id post.WebLogId
(old :: withLinks.Value.PriorPermalinks)
printfn $"{old.Value} -> {current.Value}"
| None -> eprintfn $"Cannot find current post for {current.Value}"
printfn $"{old} -> {current}"
| None -> eprintfn $"Cannot find current post for {current}"
printfn "Done!"
| None -> eprintfn $"No web log found at {urlBase}"
}
@@ -144,7 +144,7 @@ let loadTheme (args : string[]) (sp : IServiceProvider) = task {
let! theme = Handlers.Admin.Theme.loadFromZip themeId copy data
let fac = sp.GetRequiredService<ILoggerFactory> ()
let log = fac.CreateLogger "MyWebLog.Themes"
log.LogInformation $"{theme.Name} v{theme.Version} ({ThemeId.toString theme.Id}) loaded"
log.LogInformation $"{theme.Name} v{theme.Version} ({theme.Id}) loaded"
| Error message -> eprintfn $"{message}"
else
eprintfn "Usage: myWebLog load-theme [theme-zip-file-name]"
@@ -333,13 +333,13 @@ module Backup =
return { archive with WebLog = { archive.WebLog with UrlBase = defaultArg newUrlBase webLog.UrlBase } }
| Some _ ->
// Err'body gets new IDs...
let newWebLogId = WebLogId.create ()
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
let newUserIds = archive.Users |> List.map (fun user -> user.Id, WebLogUserId.create ()) |> dict
let newUpIds = archive.Uploads |> List.map (fun up -> up.Id, UploadId.create ()) |> dict
let newWebLogId = WebLogId.Create()
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
let newUserIds = archive.Users |> List.map (fun user -> user.Id, WebLogUserId.Create()) |> dict
let newUpIds = archive.Uploads |> List.map (fun up -> up.Id, UploadId.Create() ) |> dict
return
{ archive with
WebLog = { archive.WebLog with Id = newWebLogId; UrlBase = Option.get newUrlBase }
@@ -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 {other.Value}, not a WebLogAdmin"
| other -> eprintfn $"ERROR: {email} is an {other}, not a WebLogAdmin"
| None -> eprintfn $"ERROR: no user {email} found at {urlBase}"
| None -> eprintfn $"ERROR: no web log found for {urlBase}"
}

2
src/MyWebLog/Program.fs
View File

@@ -15,7 +15,7 @@ type WebLogMiddleware (next : RequestDelegate, log : ILogger<WebLogMiddleware>)
let path = $"{ctx.Request.Scheme}://{ctx.Request.Host.Value}{ctx.Request.Path.Value}"
match WebLogCache.tryGet path with
| Some webLog ->
if isDebug then log.LogDebug $"Resolved web log {WebLogId.toString webLog.Id} for {path}"
if isDebug then log.LogDebug $"Resolved web log {webLog.Id} for {path}"
ctx.Items["webLog"] <- webLog
if PageListCache.exists ctx then () else do! PageListCache.update ctx
if CategoryCache.exists ctx then () else do! CategoryCache.update ctx