Serve embedded resources via Suave

Embedded.fs

module Embedded

open System
open System.IO
open System.Reflection
open Suave
open Suave.Http
open Suave.Types
open Suave.Socket

let private ass = Assembly.GetExecutingAssembly()

let private resources =
    ass.GetManifestResourceNames()

let private CACHE_CONTROL_MAX_AGE = 600

let private lastModified = DateTime.UtcNow

let private send_embedded resourceName r =
    let write_embedded file (r : HttpRequest) = async {
      use s = ass.GetManifestResourceStream(resourceName)

      if s.Length > 0L then
        do! async_writeln r.connection (sprintf "Content-Length: %d" s.Length) r.line_buffer

      do! async_writeln r.connection "" r.line_buffer

      if s.Length > 0L then
        do! transfer_x r.connection s }

    async { do! response_f 200 "OK" (write_embedded resourceName) r } |> succeed

let resource resourceName =
    if resources |> Array.exists ((=) resourceName) then
      let send_it _ = 
        let mimes = mime_type <| IO.Path.GetExtension resourceName
        #if DEBUG
        set_mime_type mimes 
        >> send_embedded (resourceName)
        #else
        set_header "Cache-Control" (sprintf "max-age=%d" CACHE_CONTROL_MAX_AGE)
        >> set_header "Last-Modified" (lastModified.ToString("R"))
        >> set_header "Expires" (DateTime.UtcNow.AddSeconds(float(CACHE_CONTROL_MAX_AGE)).ToString("R")) 
        >> set_mime_type mimes 
        >> send_embedded (resourceName)
        #endif
      warbler ( fun (r:HttpRequest) ->
        let modified_since = (r.headers ? ``if-modified-since`` )
        match modified_since with
        | Some v -> let date = DateTime.Parse v
                    if lastModified > date then send_it ()
                    else NOT_MODIFIED
        | None   -> send_it ())
    else
      never

let browse_embedded : WebPart =
    warbler (fun req -> resource (req.url.TrimStart([| '/' |])))