From 9307ace24ac7664672d01074661d50b1658c435d Mon Sep 17 00:00:00 2001 From: "Daniel J. Summers" Date: Fri, 1 Jul 2022 20:59:21 -0400 Subject: [PATCH] WIP on saving uploads (#2) --- src/MyWebLog.Domain/ViewModels.fs | 9 ++++++ src/MyWebLog/DotLiquidBespoke.fs | 4 +-- src/MyWebLog/Handlers/Routes.fs | 10 ++++-- src/MyWebLog/Handlers/Upload.fs | 51 +++++++++++++++++++++++++++++++ src/MyWebLog/Maintenance.fs | 3 +- src/admin-theme/upload-new.liquid | 31 +++++++++++++++++++ 6 files changed, 101 insertions(+), 7 deletions(-) create mode 100644 src/admin-theme/upload-new.liquid diff --git a/src/MyWebLog.Domain/ViewModels.fs b/src/MyWebLog.Domain/ViewModels.fs index 2b1d836..c237282 100644 --- a/src/MyWebLog.Domain/ViewModels.fs +++ b/src/MyWebLog.Domain/ViewModels.fs @@ -878,6 +878,15 @@ type SettingsModel = } +/// View model for uploading a file +[] +type UploadFileModel = + { /// The upload destination + destination : string + } + + +/// A message displayed to the user [] type UserMessage = { /// The level of the message diff --git a/src/MyWebLog/DotLiquidBespoke.fs b/src/MyWebLog/DotLiquidBespoke.fs index e644c72..87ad11b 100644 --- a/src/MyWebLog/DotLiquidBespoke.fs +++ b/src/MyWebLog/DotLiquidBespoke.fs @@ -223,8 +223,8 @@ let register () = Template.RegisterTag "user_links" [ // Domain types - typeof; typeof; typeof; typeof; typeof; typeof - typeof; typeof + typeof; typeof; typeof; typeof; typeof + typeof; typeof; typeof; typeof // View models typeof; typeof; typeof; typeof typeof; typeof; typeof; typeof diff --git a/src/MyWebLog/Handlers/Routes.fs b/src/MyWebLog/Handlers/Routes.fs index 985afaa..e0e8a1b 100644 --- a/src/MyWebLog/Handlers/Routes.fs +++ b/src/MyWebLog/Handlers/Routes.fs @@ -107,11 +107,11 @@ module Asset = /// The primary myWebLog router let router : HttpHandler = choose [ - GET >=> choose [ + GET_HEAD >=> choose [ route "/" >=> Post.home ] subRoute "/admin" (requireUser >=> choose [ - GET >=> choose [ + GET_HEAD >=> choose [ subRoute "/categor" (choose [ route "ies" >=> Admin.listCategories route "ies/bare" >=> Admin.listCategoriesBare @@ -144,7 +144,8 @@ let router : HttpHandler = choose [ ]) route "/theme/update" >=> Admin.themeUpdatePage subRoute "/upload" (choose [ - route "s" >=> Upload.list + route "s" >=> Upload.list + route "/new" >=> Upload.showNew ]) route "/user/edit" >=> User.edit ] @@ -176,6 +177,9 @@ let router : HttpHandler = choose [ ]) ]) route "/theme/update" >=> Admin.updateTheme + subRoute "/upload" (choose [ + route "/save" >=> Upload.save + ]) route "/user/save" >=> User.save ] ]) diff --git a/src/MyWebLog/Handlers/Upload.fs b/src/MyWebLog/Handlers/Upload.fs index 204b0cf..35d6e37 100644 --- a/src/MyWebLog/Handlers/Upload.fs +++ b/src/MyWebLog/Handlers/Upload.fs @@ -71,9 +71,13 @@ let serve (urlParts : string seq) : HttpHandler = fun next ctx -> task { // ADMIN +open System.Text.RegularExpressions open DotLiquid open MyWebLog.ViewModels +/// Turn a string into a lowercase URL-safe slug +let makeSlug it = ((Regex """\s+""").Replace ((Regex "[^A-z0-9 ]").Replace (it, ""), "-")).ToLowerInvariant () + // GET /admin/uploads let list : HttpHandler = fun next ctx -> task { let webLog = ctx.WebLog @@ -114,3 +118,50 @@ let list : HttpHandler = fun next ctx -> task { |} |> viewForTheme "admin" "upload-list" next ctx } + +// GET /admin/upload/new +let showNew : HttpHandler = fun next ctx -> task { + return! + Hash.FromAnonymousObject {| + csrf = csrfToken ctx + destination = UploadDestination.toString ctx.WebLog.uploads + page_title = "Upload a File" + |} + |> viewForTheme "admin" "upload-new" next ctx +} + +// POST /admin/upload/save +let save : HttpHandler = 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.Join ('.', makeSlug (Path.GetFileNameWithoutExtension upload.FileName), + Path.GetExtension(upload.FileName).ToLowerInvariant ()) + let webLog = ctx.WebLog + let localNow = WebLog.localTime webLog DateTime.Now + let year = localNow.ToString "yyyy" + let month = localNow.ToString "MM" + let! form = ctx.BindFormAsync () + + match UploadDestination.parse form.destination with + | Database -> + use stream = new MemoryStream () + do! upload.CopyToAsync stream + let file = + { id = UploadId.create () + webLogId = webLog.id + path = Permalink $"{year}/{month}/{fileName}" + updatedOn = DateTime.UtcNow + data = stream.ToArray () + } + do! ctx.Data.Upload.add file + | Disk -> + let fullPath = Path.Combine ("wwwroot", webLog.slug, year, month) + let _ = Directory.CreateDirectory fullPath + 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" } + return! redirectToGet (WebLog.relativeUrl ctx.WebLog (Permalink "admin/uploads")) next ctx + else + return! RequestErrors.BAD_REQUEST "Bad request; no file present" next ctx +} diff --git a/src/MyWebLog/Maintenance.fs b/src/MyWebLog/Maintenance.fs index 8504e3f..de2bfc5 100644 --- a/src/MyWebLog/Maintenance.fs +++ b/src/MyWebLog/Maintenance.fs @@ -2,7 +2,6 @@ module MyWebLog.Maintenance open System open System.IO -open System.Text.RegularExpressions open Microsoft.Extensions.DependencyInjection open MyWebLog.Data @@ -24,7 +23,7 @@ let private doCreateWebLog (args : string[]) (sp : IServiceProvider) = task { let webLogId = WebLogId.create () let userId = WebLogUserId.create () let homePageId = PageId.create () - let slug = ((Regex """\s+""").Replace ((Regex "[^A-z0-9 ]").Replace (args[2], ""), "-")).ToLowerInvariant () + let slug = Handlers.Upload.makeSlug args[2] do! data.WebLog.add { WebLog.empty with diff --git a/src/admin-theme/upload-new.liquid b/src/admin-theme/upload-new.liquid new file mode 100644 index 0000000..8bbfa25 --- /dev/null +++ b/src/admin-theme/upload-new.liquid @@ -0,0 +1,31 @@ +

{{ page_title }}

+
+
+ +
+
+
+ + +
+
+
+ Destination
+
+ + + + +
+
+
+
+
+ +
+
+
+