/// 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.categoryEnabled && fullPath.StartsWith "/category/") || (webLog.rss.tagEnabled && 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 DotLiquid 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 ctx (data : IData) = task { let! authors = getAuthors webLog posts data let! tagMappings = getTagMappings webLog posts data let relUrl it = Some <| WebLog.relativeUrl webLog (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 dateTime = defaultArg post.publishedOn post.updatedOn data.Post.FindSurroundingPosts webLog.id dateTime | _ -> Task.FromResult (None, None) let newerLink = match listType, pageNbr with | SinglePost, _ -> newerPost |> Option.map (fun p -> Permalink.toString p.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 p -> Permalink.toString p.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 (fun p -> p.title) OlderLink = olderLink OlderName = olderPost |> Option.map (fun p -> p.title) } return Hash.FromAnonymousObject {| model = model categories = CategoryCache.get ctx tag_mappings = tagMappings is_post = 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 ctx data let title = match pageNbr, ctx.WebLog.defaultPage with | 1, "posts" -> None | _, "posts" -> Some $"Page {pageNbr}" | _, _ -> Some $"Page {pageNbr} « Posts" match title with Some ttl -> hash.Add ("page_title", ttl) | None -> () if pageNbr = 1 && ctx.WebLog.defaultPage = "posts" then hash.Add ("is_home", true) return! themedView "index" next ctx hash } // GET /page/{pageNbr}/ let redirectToPageOfPosts (pageNbr : int) : HttpHandler = fun next ctx -> redirectTo true (WebLog.relativeUrl ctx.WebLog (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 ctx data let pgTitle = if pageNbr = 1 then "" else $""" (Page {pageNbr})""" return! addToHash "page_title" $"{cat.Name}: Category Archive{pgTitle}" hash |> addToHash "subtitle" (defaultArg cat.Description "") |> addToHash "is_category" true |> addToHash "is_category_home" (pageNbr = 1) |> addToHash "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 ctx data let pgTitle = if pageNbr = 1 then "" else $""" (Page {pageNbr})""" return! addToHash "page_title" $"Posts Tagged “{tag}”{pgTitle}" hash |> addToHash "is_tag" true |> addToHash "is_tag_home" (pageNbr = 1) |> addToHash "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 webLog (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! Hash.FromAnonymousObject {| page_title = page.title page = DisplayPage.fromPage webLog page categories = CategoryCache.get ctx is_home = true |} |> themedView (defaultArg page.template "single-page") next ctx | None -> return! Error.notFound next ctx } // 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 ctx data return! addToHash "page_title" "Posts" hash |> addToHash "csrf" ctx.CsrfTokenSet |> viewForTheme "admin" "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! cats = data.Category.FindAllForView ctx.WebLog.id let! templates = templatesForTheme ctx "post" let model = EditPostModel.fromPost ctx.WebLog post return! Hash.FromAnonymousObject {| page_title = title csrf = ctx.CsrfTokenSet model = model metadata = Array.zip model.MetaNames model.MetaValues |> Array.mapi (fun idx (name, value) -> [| string idx; name; value |]) templates = templates categories = cats explicit_values = [| KeyValuePair.Create ("", "– Default –") KeyValuePair.Create (ExplicitRating.toString Yes, "Yes") KeyValuePair.Create (ExplicitRating.toString No, "No") KeyValuePair.Create (ExplicitRating.toString Clean, "Clean") |] |} |> viewForTheme "admin" "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! Hash.FromAnonymousObject {| page_title = "Manage Prior Permalinks" csrf = ctx.CsrfTokenSet model = ManagePermalinksModel.fromPost post |} |> viewForTheme "admin" "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! Hash.FromAnonymousObject {| page_title = "Manage Post Revisions" csrf = ctx.CsrfTokenSet model = ManageRevisionsModel.fromPost ctx.WebLog post |} |> viewForTheme "admin" "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! Hash.FromAnonymousObject {| content = $"""
{MarkupText.toHtml rev.text}
""" |} |> bareForTheme "admin" "" 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 = DateTime.UtcNow } :: (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! bareForTheme "admin" "" next ctx (Hash.FromAnonymousObject {| content = "" |}) | Some _, Some _ -> return! Error.notAuthorized next ctx | None, _ | _, None -> return! Error.notFound next ctx } //#nowarn "3511" // POST /admin/post/save 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.PostId = "new" then Task.FromResult ( Some { Post.empty with id = PostId.create () webLogId = ctx.WebLog.id authorId = ctx.UserId }) 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 revision = { asOf = now; text = MarkupText.parse $"{model.Source}: {model.Text}" } // Detect a permalink change, and add the prior one to the prior list let post = match Permalink.toString post.permalink with | "" -> post | link when link = model.Permalink -> post | _ -> { post with priorPermalinks = post.permalink :: post.priorPermalinks } let post = model.updatePost post revision now let 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) post // If the post was published or its categories changed, refresh the category cache if model.DoPublish || not (priorCats |> List.append post.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/{PostId.toString post.id}/edit" next ctx | Some _ -> return! Error.notAuthorized next ctx | None -> return! Error.notFound next ctx }