Edit formatting for handlers
This commit is contained in:
@@ -90,86 +90,95 @@ open MyWebLog.ViewModels
|
||||
let makeSlug it = (Regex """\s+""").Replace((Regex "[^A-z0-9 -]").Replace(it, ""), "-").ToLowerInvariant()
|
||||
|
||||
// GET /admin/uploads
|
||||
let list : HttpHandler = requireAccess Author >=> fun next ctx -> task {
|
||||
let webLog = ctx.WebLog
|
||||
let! dbUploads = ctx.Data.Upload.FindByWebLog webLog.Id
|
||||
let diskUploads =
|
||||
let path = Path.Combine(uploadDir, webLog.Slug)
|
||||
try
|
||||
Directory.EnumerateFiles(path, "*", SearchOption.AllDirectories)
|
||||
|> Seq.map (fun file ->
|
||||
let name = Path.GetFileName file
|
||||
let create =
|
||||
match File.GetCreationTime(Path.Combine(path, file)) with
|
||||
| dt when dt > DateTime.UnixEpoch -> Some dt
|
||||
| _ -> None
|
||||
{ DisplayUpload.Id = ""
|
||||
Name = name
|
||||
Path = file.Replace($"{path}{slash}", "").Replace(name, "").Replace(slash, '/')
|
||||
UpdatedOn = create
|
||||
Source = string Disk })
|
||||
with
|
||||
| :? DirectoryNotFoundException -> [] // This is fine
|
||||
| ex ->
|
||||
warn "Upload" ctx $"Encountered {ex.GetType().Name} listing uploads for {path}:\n{ex.Message}"
|
||||
[]
|
||||
return!
|
||||
dbUploads
|
||||
|> Seq.ofList
|
||||
|> Seq.map (DisplayUpload.FromUpload webLog Database)
|
||||
|> Seq.append diskUploads
|
||||
|> Seq.sortByDescending (fun file -> file.UpdatedOn, file.Path)
|
||||
|> Views.WebLog.uploadList
|
||||
|> adminPage "Uploaded Files" next ctx
|
||||
}
|
||||
let list : HttpHandler =
|
||||
requireAccess Author
|
||||
>=> fun next ctx -> task {
|
||||
let webLog = ctx.WebLog
|
||||
let! dbUploads = ctx.Data.Upload.FindByWebLog webLog.Id
|
||||
let diskUploads =
|
||||
let path = Path.Combine(uploadDir, webLog.Slug)
|
||||
try
|
||||
Directory.EnumerateFiles(path, "*", SearchOption.AllDirectories)
|
||||
|> Seq.map (fun file ->
|
||||
let name = Path.GetFileName file
|
||||
let create =
|
||||
match File.GetCreationTime(Path.Combine(path, file)) with
|
||||
| dt when dt > DateTime.UnixEpoch -> Some dt
|
||||
| _ -> None
|
||||
{ DisplayUpload.Id = ""
|
||||
Name = name
|
||||
Path = file.Replace($"{path}{slash}", "").Replace(name, "").Replace(slash, '/')
|
||||
UpdatedOn = create
|
||||
Source = string Disk })
|
||||
with
|
||||
| :? DirectoryNotFoundException -> [] // This is fine
|
||||
| ex ->
|
||||
warn "Upload" ctx $"Encountered {ex.GetType().Name} listing uploads for {path}:\n{ex.Message}"
|
||||
[]
|
||||
return!
|
||||
dbUploads
|
||||
|> Seq.ofList
|
||||
|> Seq.map (DisplayUpload.FromUpload webLog Database)
|
||||
|> Seq.append diskUploads
|
||||
|> Seq.sortByDescending (fun file -> file.UpdatedOn, file.Path)
|
||||
|> Views.WebLog.uploadList
|
||||
|> adminPage "Uploaded Files" next ctx
|
||||
}
|
||||
|
||||
// GET /admin/upload/new
|
||||
let showNew : HttpHandler = requireAccess Author >=> fun next ctx ->
|
||||
adminPage "Upload a File" next ctx Views.WebLog.uploadNew
|
||||
let showNew : HttpHandler =
|
||||
requireAccess Author
|
||||
>=> fun next ctx -> adminPage "Upload a File" next ctx Views.WebLog.uploadNew
|
||||
|
||||
// POST /admin/upload/save
|
||||
let save : HttpHandler = requireAccess Author >=> validateCsrf >=> 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())
|
||||
let now = Noda.now ()
|
||||
let localNow = ctx.WebLog.LocalTime now
|
||||
let year = localNow.ToString "yyyy"
|
||||
let month = localNow.ToString "MM"
|
||||
let! form = ctx.BindFormAsync<UploadFileModel>()
|
||||
let save : HttpHandler =
|
||||
requireAccess Author
|
||||
>=> validateCsrf
|
||||
>=> 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())
|
||||
let now = Noda.now ()
|
||||
let localNow = ctx.WebLog.LocalTime now
|
||||
let year = localNow.ToString "yyyy"
|
||||
let month = localNow.ToString "MM"
|
||||
let! form = ctx.BindFormAsync<UploadFileModel>()
|
||||
|
||||
match UploadDestination.Parse form.Destination with
|
||||
| Database ->
|
||||
use stream = new MemoryStream()
|
||||
do! upload.CopyToAsync stream
|
||||
let file =
|
||||
{ Id = UploadId.Create()
|
||||
WebLogId = ctx.WebLog.Id
|
||||
Path = Permalink $"{year}/{month}/{fileName}"
|
||||
UpdatedOn = now
|
||||
Data = stream.ToArray() }
|
||||
do! ctx.Data.Upload.Add file
|
||||
| Disk ->
|
||||
let fullPath = Path.Combine(uploadDir, ctx.WebLog.Slug, year, month)
|
||||
let _ = Directory.CreateDirectory fullPath
|
||||
use stream = new FileStream(Path.Combine(fullPath, fileName), FileMode.Create)
|
||||
do! upload.CopyToAsync stream
|
||||
match UploadDestination.Parse form.Destination with
|
||||
| Database ->
|
||||
use stream = new MemoryStream()
|
||||
do! upload.CopyToAsync stream
|
||||
let file =
|
||||
{ Id = UploadId.Create()
|
||||
WebLogId = ctx.WebLog.Id
|
||||
Path = Permalink $"{year}/{month}/{fileName}"
|
||||
UpdatedOn = now
|
||||
Data = stream.ToArray() }
|
||||
do! ctx.Data.Upload.Add file
|
||||
| Disk ->
|
||||
let fullPath = Path.Combine(uploadDir, ctx.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 "admin/uploads" next ctx
|
||||
else
|
||||
return! RequestErrors.BAD_REQUEST "Bad request; no file present" next ctx
|
||||
}
|
||||
do! addMessage
|
||||
ctx { UserMessage.Success with Message = $"File uploaded to {form.Destination} successfully" }
|
||||
return! redirectToGet "admin/uploads" next ctx
|
||||
else
|
||||
return! RequestErrors.BAD_REQUEST "Bad request; no file present" next ctx
|
||||
}
|
||||
|
||||
// DELETE /admin/upload/{id}
|
||||
let deleteFromDb upId : HttpHandler = requireAccess WebLogAdmin >=> fun next ctx -> task {
|
||||
match! ctx.Data.Upload.Delete (UploadId upId) ctx.WebLog.Id with
|
||||
| Ok fileName ->
|
||||
do! addMessage ctx { UserMessage.Success with Message = $"{fileName} deleted successfully" }
|
||||
return! list next ctx
|
||||
| Error _ -> return! Error.notFound next ctx
|
||||
}
|
||||
let deleteFromDb upId : HttpHandler =
|
||||
requireAccess WebLogAdmin
|
||||
>=> fun next ctx -> task {
|
||||
match! ctx.Data.Upload.Delete (UploadId upId) ctx.WebLog.Id with
|
||||
| Ok fileName ->
|
||||
do! addMessage ctx { UserMessage.Success with Message = $"{fileName} deleted successfully" }
|
||||
return! list next ctx
|
||||
| Error _ -> return! Error.notFound next ctx
|
||||
}
|
||||
|
||||
/// Remove a directory tree if it is empty
|
||||
let removeEmptyDirectories (webLog: WebLog) (filePath: string) =
|
||||
@@ -183,13 +192,15 @@ let removeEmptyDirectories (webLog: WebLog) (filePath: string) =
|
||||
else finished <- true
|
||||
|
||||
// DELETE /admin/upload/disk/{**path}
|
||||
let deleteFromDisk urlParts : HttpHandler = requireAccess WebLogAdmin >=> fun next ctx -> task {
|
||||
let filePath = urlParts |> Seq.skip 1 |> Seq.head
|
||||
let path = Path.Combine(uploadDir, ctx.WebLog.Slug, filePath)
|
||||
if File.Exists path then
|
||||
File.Delete path
|
||||
removeEmptyDirectories ctx.WebLog filePath
|
||||
do! addMessage ctx { UserMessage.Success with Message = $"{filePath} deleted successfully" }
|
||||
return! list next ctx
|
||||
else return! Error.notFound next ctx
|
||||
}
|
||||
let deleteFromDisk urlParts : HttpHandler =
|
||||
requireAccess WebLogAdmin
|
||||
>=> fun next ctx -> task {
|
||||
let filePath = urlParts |> Seq.skip 1 |> Seq.head
|
||||
let path = Path.Combine(uploadDir, ctx.WebLog.Slug, filePath)
|
||||
if File.Exists path then
|
||||
File.Delete path
|
||||
removeEmptyDirectories ctx.WebLog filePath
|
||||
do! addMessage ctx { UserMessage.Success with Message = $"{filePath} deleted successfully" }
|
||||
return! list next ctx
|
||||
else return! Error.notFound next ctx
|
||||
}
|
||||
|
||||
Reference in New Issue
Block a user