/// Handlers to manipulate posts module MyWebLog.Handlers.Post open System open System.Collections.Generic open MyWebLog /// Parse a slug and page number from an "everything else" URL let private parseSlugAndPage webLog (slugAndPage: string seq) = let fullPath = slugAndPage |> Seq.head let slugPath = slugAndPage |> Seq.skip 1 |> Seq.head let slugs, isFeed = let feedName = $"/{webLog.Rss.FeedName}" let notBlank = Array.filter (fun it -> it <> "") if ( (webLog.Rss.IsCategoryEnabled && fullPath.StartsWith "/category/") || (webLog.Rss.IsTagEnabled && fullPath.StartsWith "/tag/" )) && slugPath.EndsWith feedName then notBlank (slugPath.Replace(feedName, "").Split "/"), true else notBlank (slugPath.Split "/"), false let pageIdx = Array.IndexOf (slugs, "page") let pageNbr = match pageIdx with | -1 -> Some 1 | idx when idx + 2 = slugs.Length -> Some (int slugs[pageIdx + 1]) | _ -> None let slugParts = if pageIdx > 0 then Array.truncate pageIdx slugs else slugs pageNbr, String.Join("/", slugParts), isFeed /// The type of post list being prepared [] type ListType = | AdminList | CategoryList | PostList | SinglePost | TagList open System.Threading.Tasks open MyWebLog.Data open MyWebLog.ViewModels /// Convert a list of posts into items ready to be displayed let preparePostList webLog posts listType (url: string) pageNbr perPage (data: IData) = task { let! authors = getAuthors webLog posts data let! tagMappings = getTagMappings webLog posts data let relUrl it = Some <| webLog.RelativeUrl(Permalink it) let postItems = posts |> Seq.ofList |> Seq.truncate perPage |> Seq.map (PostListItem.FromPost webLog) |> Array.ofSeq let! olderPost, newerPost = match listType with | SinglePost -> 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 | SinglePost, _ -> newerPost |> Option.map (fun it -> string it.Permalink) | _, 1 -> None | PostList, 2 when webLog.DefaultPage = "posts" -> Some "" | PostList, _ -> relUrl $"page/{pageNbr - 1}" | CategoryList, 2 -> relUrl $"category/{url}/" | CategoryList, _ -> relUrl $"category/{url}/page/{pageNbr - 1}" | TagList, 2 -> relUrl $"tag/{url}/" | TagList, _ -> relUrl $"tag/{url}/page/{pageNbr - 1}" | AdminList, 2 -> relUrl "admin/posts" | AdminList, _ -> relUrl $"admin/posts/page/{pageNbr - 1}" let olderLink = match listType, List.length posts > perPage with | 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}" | TagList, true -> relUrl $"tag/{url}/page/{pageNbr + 1}" | AdminList, true -> relUrl $"admin/posts/page/{pageNbr + 1}" let model = { Posts = postItems Authors = authors Subtitle = None NewerLink = newerLink NewerName = newerPost |> Option.map _.Title OlderLink = olderLink OlderName = olderPost |> Option.map _.Title } return makeHash {||} |> addToHash ViewContext.Model model |> addToHash "tag_mappings" tagMappings |> addToHash ViewContext.IsPost (match listType with SinglePost -> true | _ -> false) } open Giraffe // GET /page/{pageNbr} let pageOfPosts pageNbr : HttpHandler = fun next ctx -> task { let count = ctx.WebLog.PostsPerPage let data = ctx.Data let! posts = data.Post.FindPageOfPublishedPosts ctx.WebLog.Id pageNbr count let! hash = preparePostList ctx.WebLog posts PostList "" pageNbr count data let title = match pageNbr, ctx.WebLog.DefaultPage with | 1, "posts" -> None | _, "posts" -> Some $"Page {pageNbr}" | _, _ -> Some $"Page {pageNbr} « Posts" return! match title with Some ttl -> addToHash ViewContext.PageTitle ttl hash | None -> hash |> function | hash -> if pageNbr = 1 && ctx.WebLog.DefaultPage = "posts" then addToHash ViewContext.IsHome true hash else hash |> themedView "index" next ctx } // GET /page/{pageNbr}/ let redirectToPageOfPosts (pageNbr: int) : HttpHandler = fun next ctx -> redirectTo true (ctx.WebLog.RelativeUrl(Permalink $"page/{pageNbr}")) next ctx // GET /category/{slug}/ // GET /category/{slug}/page/{pageNbr} let pageOfCategorizedPosts slugAndPage : HttpHandler = fun next ctx -> task { let webLog = ctx.WebLog let data = ctx.Data match parseSlugAndPage webLog slugAndPage with | Some pageNbr, slug, isFeed -> match CategoryCache.get ctx |> Array.tryFind (fun cat -> cat.Slug = slug) with | Some cat when isFeed -> return! Feed.generate (Feed.CategoryFeed ((CategoryId cat.Id), $"category/{slug}/{webLog.Rss.FeedName}")) (defaultArg webLog.Rss.ItemsInFeed webLog.PostsPerPage) next ctx | Some cat -> // Category pages include posts in subcategories match! data.Post.FindPageOfCategorizedPosts webLog.Id (getCategoryIds slug ctx) pageNbr webLog.PostsPerPage with | posts when List.length posts > 0 -> let! hash = preparePostList webLog posts CategoryList cat.Slug pageNbr webLog.PostsPerPage data let pgTitle = if pageNbr = 1 then "" else $""" (Page {pageNbr})""" return! addToHash ViewContext.PageTitle $"{cat.Name}: Category Archive{pgTitle}" hash |> addToHash "subtitle" (defaultArg cat.Description "") |> addToHash ViewContext.IsCategory true |> addToHash ViewContext.IsCategoryHome (pageNbr = 1) |> addToHash ViewContext.Slug slug |> themedView "index" next ctx | _ -> return! Error.notFound next ctx | None -> return! Error.notFound next ctx | None, _, _ -> return! Error.notFound next ctx } open System.Web // GET /tag/{tag}/ // GET /tag/{tag}/page/{pageNbr} let pageOfTaggedPosts slugAndPage : HttpHandler = fun next ctx -> task { let webLog = ctx.WebLog let data = ctx.Data match parseSlugAndPage webLog slugAndPage with | Some pageNbr, rawTag, isFeed -> let urlTag = HttpUtility.UrlDecode rawTag let! tag = backgroundTask { match! data.TagMap.FindByUrlValue urlTag webLog.Id with | Some m -> return m.Tag | None -> return urlTag } if isFeed then return! Feed.generate (Feed.TagFeed(tag, $"tag/{rawTag}/{webLog.Rss.FeedName}")) (defaultArg webLog.Rss.ItemsInFeed webLog.PostsPerPage) next ctx else match! data.Post.FindPageOfTaggedPosts webLog.Id tag pageNbr webLog.PostsPerPage with | posts when List.length posts > 0 -> let! hash = preparePostList webLog posts TagList rawTag pageNbr webLog.PostsPerPage data let pgTitle = if pageNbr = 1 then "" else $""" (Page {pageNbr})""" return! addToHash ViewContext.PageTitle $"Posts Tagged “{tag}”{pgTitle}" hash |> addToHash ViewContext.IsTag true |> addToHash ViewContext.IsTagHome (pageNbr = 1) |> addToHash ViewContext.Slug rawTag |> themedView "index" next ctx // Other systems use hyphens for spaces; redirect if this is an old tag link | _ -> let spacedTag = tag.Replace("-", " ") match! data.Post.FindPageOfTaggedPosts webLog.Id spacedTag pageNbr 1 with | posts when List.length posts > 0 -> let endUrl = if pageNbr = 1 then "" else $"page/{pageNbr}" return! redirectTo true (webLog.RelativeUrl(Permalink $"""tag/{spacedTag.Replace (" ", "+")}/{endUrl}""")) next ctx | _ -> return! Error.notFound next ctx | None, _, _ -> return! Error.notFound next ctx } // GET / let home : HttpHandler = fun next ctx -> task { let webLog = ctx.WebLog match webLog.DefaultPage with | "posts" -> return! pageOfPosts 1 next ctx | pageId -> match! ctx.Data.Page.FindById (PageId pageId) webLog.Id with | Some page -> return! hashForPage page.Title |> addToHash "page" (DisplayPage.FromPage webLog page) |> addToHash ViewContext.IsHome true |> themedView (defaultArg page.Template "single-page") next ctx | None -> return! Error.notFound next ctx } // GET /{post-permalink}?chapters let chapters (post: Post) : HttpHandler = match post.Episode with | Some ep -> match ep.Chapters with | Some chapters -> json chapters | None -> match ep.ChapterFile with | Some file -> redirectTo true file | None -> Error.notFound | None -> Error.notFound // ~~ ADMINISTRATION ~~ // GET /admin/posts // GET /admin/posts/page/{pageNbr} let all pageNbr : HttpHandler = requireAccess Author >=> fun next ctx -> task { let data = ctx.Data let! posts = data.Post.FindPageOfPosts ctx.WebLog.Id pageNbr 25 let! hash = preparePostList ctx.WebLog posts AdminList "" pageNbr 25 data return! addToHash ViewContext.PageTitle "Posts" hash |> withAntiCsrf ctx |> adminView "post-list" next ctx } // GET /admin/post/{id}/edit let edit postId : HttpHandler = requireAccess Author >=> fun next ctx -> task { let data = ctx.Data let! result = task { match postId with | "new" -> return Some ("Write a New Post", { Post.Empty with Id = PostId "new" }) | _ -> match! data.Post.FindFullById (PostId postId) ctx.WebLog.Id with | Some post -> return Some ("Edit Post", post) | None -> return None } match result with | Some (title, post) when canEdit post.AuthorId ctx -> let! templates = templatesForTheme ctx "post" let model = EditPostModel.FromPost ctx.WebLog post return! hashForPage title |> withAntiCsrf ctx |> addToHash ViewContext.Model model |> addToHash "metadata" ( Array.zip model.MetaNames model.MetaValues |> Array.mapi (fun idx (name, value) -> [| string idx; name; value |])) |> addToHash "templates" templates |> addToHash "explicit_values" [| KeyValuePair.Create("", "– Default –") 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 | None -> return! Error.notFound next ctx } // POST /admin/post/{id}/delete let delete postId : HttpHandler = requireAccess WebLogAdmin >=> fun next ctx -> task { match! ctx.Data.Post.Delete (PostId postId) ctx.WebLog.Id with | true -> do! addMessage ctx { UserMessage.Success with Message = "Post deleted successfully" } | false -> do! addMessage ctx { UserMessage.Error with Message = "Post not found; nothing deleted" } return! redirectToGet "admin/posts" next ctx } // GET /admin/post/{id}/permalinks let editPermalinks postId : HttpHandler = requireAccess Author >=> fun next ctx -> task { match! ctx.Data.Post.FindFullById (PostId postId) ctx.WebLog.Id with | Some post when canEdit post.AuthorId ctx -> return! hashForPage "Manage Prior Permalinks" |> withAntiCsrf ctx |> addToHash ViewContext.Model (ManagePermalinksModel.FromPost post) |> adminView "permalinks" next ctx | Some _ -> return! Error.notAuthorized next ctx | None -> return! Error.notFound next ctx } // POST /admin/post/permalinks let savePermalinks : HttpHandler = requireAccess Author >=> fun next ctx -> task { let! model = ctx.BindFormAsync() let postId = PostId model.Id match! ctx.Data.Post.FindById postId ctx.WebLog.Id with | Some post when canEdit post.AuthorId ctx -> let links = model.Prior |> Array.map Permalink |> List.ofArray match! ctx.Data.Post.UpdatePriorPermalinks postId ctx.WebLog.Id links with | true -> do! addMessage ctx { UserMessage.Success with Message = "Post permalinks saved successfully" } return! redirectToGet $"admin/post/{model.Id}/permalinks" next ctx | false -> return! Error.notFound next ctx | Some _ -> return! Error.notAuthorized next ctx | None -> return! Error.notFound next ctx } // GET /admin/post/{id}/revisions let editRevisions postId : HttpHandler = requireAccess Author >=> fun next ctx -> task { match! ctx.Data.Post.FindFullById (PostId postId) ctx.WebLog.Id with | Some post when canEdit post.AuthorId ctx -> return! hashForPage "Manage Post Revisions" |> withAntiCsrf ctx |> addToHash ViewContext.Model (ManageRevisionsModel.FromPost ctx.WebLog post) |> adminView "revisions" next ctx | Some _ -> return! Error.notAuthorized next ctx | None -> return! Error.notFound next ctx } // GET /admin/post/{id}/revisions/purge let purgeRevisions postId : HttpHandler = requireAccess Author >=> fun next ctx -> task { let data = ctx.Data match! data.Post.FindFullById (PostId postId) ctx.WebLog.Id with | Some post when canEdit post.AuthorId ctx -> do! data.Post.Update { post with Revisions = [ List.head post.Revisions ] } do! addMessage ctx { UserMessage.Success with Message = "Prior revisions purged successfully" } return! redirectToGet $"admin/post/{postId}/revisions" next ctx | Some _ -> return! Error.notAuthorized next ctx | None -> return! Error.notFound next ctx } open Microsoft.AspNetCore.Http /// Find the post and the requested revision let private findPostRevision postId revDate (ctx: HttpContext) = task { match! ctx.Data.Post.FindFullById (PostId postId) ctx.WebLog.Id with | Some post -> let asOf = parseToUtc revDate return Some post, post.Revisions |> List.tryFind (fun r -> r.AsOf = asOf) | None -> return None, None } // GET /admin/post/{id}/revision/{revision-date}/preview let previewRevision (postId, revDate) : HttpHandler = requireAccess Author >=> fun next ctx -> task { match! findPostRevision postId revDate ctx with | Some post, Some rev when canEdit post.AuthorId ctx -> return! {| content = [ """
""" rev.Text.AsHtml() |> addBaseToRelativeUrls ctx.WebLog.ExtraPath "
" ] |> String.concat "" |} |> makeHash |> adminBareView "" next ctx | Some _, Some _ -> return! Error.notAuthorized next ctx | None, _ | _, None -> return! Error.notFound next ctx } // POST /admin/post/{id}/revision/{revision-date}/restore let restoreRevision (postId, revDate) : HttpHandler = requireAccess Author >=> fun next ctx -> task { match! findPostRevision postId revDate ctx with | Some post, Some rev when canEdit post.AuthorId ctx -> do! ctx.Data.Post.Update { post with 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" } return! redirectToGet $"admin/post/{postId}/revisions" next ctx | Some _, Some _ -> return! Error.notAuthorized next ctx | None, _ | _, None -> return! Error.notFound next ctx } // POST /admin/post/{id}/revision/{revision-date}/delete let deleteRevision (postId, revDate) : HttpHandler = requireAccess Author >=> fun next ctx -> task { match! findPostRevision postId revDate ctx with | Some post, Some rev when canEdit post.AuthorId ctx -> do! ctx.Data.Post.Update { post with Revisions = post.Revisions |> List.filter (fun r -> r.AsOf <> rev.AsOf) } do! addMessage ctx { UserMessage.Success with Message = "Revision deleted successfully" } return! adminBareView "" next ctx (makeHash {| content = "" |}) | Some _, Some _ -> return! Error.notAuthorized next ctx | None, _ | _, None -> return! Error.notFound next ctx } // GET /admin/post/{id}/chapters let manageChapters postId : HttpHandler = requireAccess Author >=> fun next ctx -> task { match! ctx.Data.Post.FindById (PostId postId) ctx.WebLog.Id with | Some post when Option.isSome post.Episode && Option.isSome post.Episode.Value.Chapters && canEdit post.AuthorId ctx -> return! adminPage "Manage Chapters" true (Views.Post.chapters false (ManageChaptersModel.Create post)) next ctx | Some _ | None -> return! Error.notFound next ctx } // GET /admin/post/{id}/chapter/{idx} let editChapter (postId, index) : HttpHandler = requireAccess Author >=> fun next ctx -> task { match! ctx.Data.Post.FindById (PostId postId) ctx.WebLog.Id with | Some post when Option.isSome post.Episode && Option.isSome post.Episode.Value.Chapters && canEdit post.AuthorId ctx -> let chapter = if index = -1 then Some Chapter.Empty else let chapters = post.Episode.Value.Chapters.Value if index < List.length chapters then Some chapters[index] else None match chapter with | Some chap -> return! adminBarePage (if index = -1 then "Add a Chapter" else "Edit Chapter") true (Views.Post.chapterEdit (EditChapterModel.FromChapter post.Id index chap)) next ctx | None -> return! Error.notFound next ctx | Some _ | None -> return! Error.notFound next ctx } // POST /admin/post/{id}/chapter/{idx} let saveChapter (postId, index) : HttpHandler = requireAccess Author >=> fun next ctx -> task { let data = ctx.Data match! data.Post.FindById (PostId postId) ctx.WebLog.Id with | Some post when Option.isSome post.Episode && Option.isSome post.Episode.Value.Chapters && canEdit post.AuthorId ctx -> let! form = ctx.BindFormAsync() let chapters = post.Episode.Value.Chapters.Value if index >= -1 && index < List.length chapters then try let chapter = form.ToChapter() let existing = if index = -1 then chapters else List.removeAt index chapters let updatedPost = { post with Episode = Some { post.Episode.Value with Chapters = Some (chapter :: existing |> List.sortBy _.StartTime) } } do! data.Post.Update updatedPost do! addMessage ctx { UserMessage.Success with Message = "Chapter saved successfully" } return! adminPage "Manage Chapters" true (Views.Post.chapterList form.AddAnother (ManageChaptersModel.Create updatedPost)) next ctx with | ex -> return! Error.server ex.Message next ctx else return! Error.notFound next ctx | Some _ | None -> return! Error.notFound next ctx } // DELETE /admin/post/{id}/chapter/{idx} let deleteChapter (postId, index) : HttpHandler = requireAccess Author >=> fun next ctx -> task { let data = ctx.Data match! data.Post.FindById (PostId postId) ctx.WebLog.Id with | Some post when Option.isSome post.Episode && Option.isSome post.Episode.Value.Chapters && canEdit post.AuthorId ctx -> let chapters = post.Episode.Value.Chapters.Value if index >= 0 && index < List.length chapters then let updatedPost = { post with Episode = Some { post.Episode.Value with Chapters = Some (List.removeAt index chapters) } } do! data.Post.Update updatedPost do! addMessage ctx { UserMessage.Success with Message = "Chapter deleted successfully" } return! adminPage "Manage Chapters" true (Views.Post.chapterList false (ManageChaptersModel.Create updatedPost)) next ctx else return! Error.notFound next ctx | Some _ | None -> return! Error.notFound next ctx } // POST /admin/post/save let save : HttpHandler = requireAccess Author >=> fun next ctx -> task { let! model = ctx.BindFormAsync() let data = ctx.Data let tryPost = if model.IsNew then { Post.Empty with Id = PostId.Create() WebLogId = ctx.WebLog.Id AuthorId = ctx.UserId } |> someTask else data.Post.FindFullById (PostId model.PostId) ctx.WebLog.Id match! tryPost with | Some post when canEdit post.AuthorId ctx -> let priorCats = post.CategoryIds let updatedPost = model.UpdatePost post (Noda.now ()) |> function | post -> if model.SetPublished then let dt = parseToUtc (model.PubOverride.Value.ToString "o") if model.SetUpdated then { post with PublishedOn = Some dt UpdatedOn = dt Revisions = [ { (List.head post.Revisions) with AsOf = dt } ] } else { post with PublishedOn = Some dt } else post do! (if model.PostId = "new" then data.Post.Add else data.Post.Update) updatedPost // If the post was published or its categories changed, refresh the category cache if model.DoPublish || not (priorCats |> List.append updatedPost.CategoryIds |> List.distinct |> 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}/edit" next ctx | Some _ -> return! Error.notAuthorized next ctx | None -> return! Error.notFound next ctx }