diff --git a/src/MyWebLog/Handlers/Upload.fs b/src/MyWebLog/Handlers/Upload.fs index 1ce16e1..204b0cf 100644 --- a/src/MyWebLog/Handlers/Upload.fs +++ b/src/MyWebLog/Handlers/Upload.fs @@ -4,6 +4,7 @@ module MyWebLog.Handlers.Upload open System open Giraffe open Microsoft.AspNetCore.Http +open Microsoft.Net.Http.Headers open MyWebLog /// Helper functions for this module @@ -15,6 +16,12 @@ module private Helpers = /// A MIME type mapper instance to use when serving files from the database let mimeMap = FileExtensionContentTypeProvider () + /// A cache control header that instructs the browser to cache the result for no more than 30 days + let cacheForThirtyDays = + let hdr = CacheControlHeaderValue() + hdr.MaxAge <- Some (TimeSpan.FromDays 30) |> Option.toNullable + hdr + /// Determine if the file has been modified since the date/time specified by the If-Modified-Since header let checkModified since (ctx : HttpContext) : HttpHandler option = @@ -24,55 +31,55 @@ let checkModified since (ctx : HttpContext) : HttpHandler option = | _ -> Some (setStatusCode 304 >=> setBodyFromString "Not Modified") +open System.IO open Microsoft.AspNetCore.Http.Headers -open Microsoft.Net.Http.Headers /// Derive a MIME type based on the extension of the file let deriveMimeType path = match mimeMap.TryGetContentType path with true, typ -> typ | false, _ -> "application/octet-stream" /// Send a file, caching the response for 30 days -let sendFile updatedOn path data : HttpHandler = fun next ctx -> task { +let sendFile updatedOn path (data : byte[]) : HttpHandler = fun next ctx -> task { let headers = ResponseHeaders ctx.Response.Headers - headers.LastModified <- Some (DateTimeOffset updatedOn) |> Option.toNullable headers.ContentType <- (deriveMimeType >> MediaTypeHeaderValue) path - headers.CacheControl <- - let hdr = CacheControlHeaderValue() - hdr.MaxAge <- Some (TimeSpan.FromDays 30) |> Option.toNullable - hdr - return! setBody data next ctx + headers.CacheControl <- cacheForThirtyDays + let stream = new MemoryStream (data) + return! streamData true stream None (Some (DateTimeOffset updatedOn)) next ctx } // GET /upload/{web-log-slug}/{**path} let serve (urlParts : string seq) : HttpHandler = fun next ctx -> task { + let webLog = ctx.WebLog let parts = (urlParts |> Seq.skip 1 |> Seq.head).Split '/' let slug = Array.head parts - let path = String.Join ('/', parts |> Array.skip 1) - let webLog = ctx.WebLog if slug = webLog.slug then - match! ctx.Data.Upload.findByPath path webLog.id with - | Some upload -> - match checkModified upload.updatedOn ctx with - | Some threeOhFour -> return! threeOhFour next ctx - | None -> return! sendFile upload.updatedOn path upload.data next ctx - | None -> return! Error.notFound next ctx + // Static file middleware will not work in subdirectories; check for an actual file first + let fileName = Path.Combine ("wwwroot", (Seq.head urlParts)[1..]) + if File.Exists fileName then + return! streamFile true fileName None None next ctx + else + let path = String.Join ('/', Array.skip 1 parts) + match! ctx.Data.Upload.findByPath path webLog.id with + | Some upload -> + match checkModified upload.updatedOn ctx with + | Some threeOhFour -> return! threeOhFour next ctx + | None -> return! sendFile upload.updatedOn path upload.data next ctx + | None -> return! Error.notFound next ctx else return! Error.notFound next ctx } // ADMIN -open System.IO open DotLiquid open MyWebLog.ViewModels // GET /admin/uploads let list : HttpHandler = fun next ctx -> task { - let webLog = ctx.WebLog - let! dbUploads = ctx.Data.Upload.findByWebLog webLog.id - let diskUploads = + let webLog = ctx.WebLog + let! dbUploads = ctx.Data.Upload.findByWebLog webLog.id + let diskUploads = let path = Path.Combine ("wwwroot", "upload", webLog.slug) - printfn $"Files in %s{path}" try Directory.EnumerateFiles (path, "*", SearchOption.AllDirectories) |> Seq.map (fun file -> @@ -83,7 +90,7 @@ let list : HttpHandler = fun next ctx -> task { | _ -> None { DisplayUpload.id = "" name = name - path = file.Substring(8).Replace (name, "") + path = file.Replace($"{path}/", "").Replace (name, "") updatedOn = create source = UploadDestination.toString Disk }) @@ -93,7 +100,6 @@ let list : HttpHandler = fun next ctx -> task { | ex -> warn "Upload" ctx $"Encountered {ex.GetType().Name} listing uploads for {path}:\n{ex.Message}" [] - printfn "done" let allFiles = dbUploads |> List.map (DisplayUpload.fromUpload Database) @@ -107,4 +113,4 @@ let list : HttpHandler = fun next ctx -> task { files = allFiles |} |> viewForTheme "admin" "upload-list" next ctx - } \ No newline at end of file + } diff --git a/src/admin-theme/post-list.liquid b/src/admin-theme/post-list.liquid index a952cdd..f7c19a6 100644 --- a/src/admin-theme/post-list.liquid +++ b/src/admin-theme/post-list.liquid @@ -42,7 +42,7 @@