Fixes MIME parsing on WebSharper OWIN middleware. Also implements request entity body limit to 20MB to prevent rogue request entity bodies. Also fixes other perf/robustness issues. Request entity bodies are streamed to file system temp file to avoid holding in memory. Search in code for "FIXUP" to find relevant edited areas. Requires reference t…

Owin.Sitelets.fs

namespace WebSharper.Owin

// FIXUP NOTICE: CONTAINS CRITICAL BUGFIX FIXUP ON LINE 230. MORE INFO IS THERE.

open System
open System.Collections.Generic
open System.Collections.Concurrent
open System.IO
open System.Configuration
open System.Security.Principal
open System.Threading.Tasks
open System.Web
open System.Web.Security
open Microsoft.Owin
open WebSharper
open WebSharper.Sitelets
open WebSharper.Web
open System.Text

// FIXUP: The following opens are needed for various fixups (also commented as such).
open MimeKit
open Singapore.Util.Owin.Streams

module Rem = WebSharper.Core.Remoting
module Res = WebSharper.Core.Resources
module P = WebSharper.PathConventions
module M = WebSharper.Core.Metadata
type DepG = WebSharper.Core.DependencyGraph.Graph

type Env = IDictionary<string, obj>
type AppFunc = Func<Env, Task>
type MidFunc = Func<AppFunc, AppFunc>

module EnvKey =

    let HttpContext = "HttpContext"
    module WebSharper =
        let Request = "WebSharper.Request"
        let Context = "WebSharper.Context"
        // Store WebSharper user identity in the environment dictionary,
        // avoid overwriting principal set by OWIN authentication middleware
        let User = "WebSharper.User"

    let GetOrSet<'T> (env: Env) (key: string) (mk: Env -> 'T) =
        match env.TryGetValue key with
        | true, (:? 'T as x) -> x
        | _ ->
            let x = mk env
            env.[key] <- x
            x

[<NoComparison; NoEquality>]
type Options =
    internal {
        Debug : bool
        JsonProvider : Core.Json.Provider
        Metadata : M.Info
        Dependencies : DepG
        ServerRootDirectory : string
        UrlPrefix : string
        RemotingServer : option<Rem.Server>
        OnException : bool -> IOwinResponse -> exn -> Task
        ResourceContextCache : ConcurrentDictionary<string, Res.Context>
    }

    member o.WithDebug() = o.WithDebug(true)
    member o.WithDebug(d) = { o with Debug = d }
    member o.WithServerRootDirectory(d) = { o with ServerRootDirectory = d }
    member o.WithUrlPrefix(t) = { o with UrlPrefix = t }
    member o.WithOnException(f) = { o with OnException = f }

    static member DefaultOnException (debug: bool) (resp: IOwinResponse) (e: exn) =
        resp.StatusCode <- 500
        let trace = e.ToString()
        Console.Error.WriteLine trace
        resp.WriteAsync (if debug then trace else "Internal Server Error")

    static member Create() =
        let dir = Directory.GetCurrentDirectory()
        {
            Debug = false
            JsonProvider = Core.Json.Provider.Create()
            Metadata = M.Info.Empty
            Dependencies = DepG.Empty
            ServerRootDirectory = dir
            UrlPrefix = ""
            RemotingServer = None
            OnException = Options.DefaultOnException
            ResourceContextCache = ConcurrentDictionary()
        }

    static member DefaultBinDirectory =
        Path.GetDirectoryName(typeof<Options>.Assembly.Location)

[<AutoOpen>]
module private Internal =

    open System.Reflection

    [<NoComparison; NoEquality>]
    type FormData =
        {
            Files : seq<HttpPostedFileBase>
            Fields : Http.ParameterCollection
            Body : Stream
        }

    type OwinCookieUserSession(ctx: IOwinContext) =

        let refresh (cookie: string) =
            match cookie with
            | null -> ctx.Set(EnvKey.WebSharper.User, None)
            | cookie ->
                let ticket = FormsAuthentication.Decrypt cookie
                let principal = GenericPrincipal(FormsIdentity(ticket), [||])
                ctx.Set(EnvKey.WebSharper.User, Some principal)
            |> ignore 

        let ensureUserHasBeenRefreshed () = 
            if ctx.Environment.ContainsKey(EnvKey.WebSharper.User) |> not then 
                // Using `try ... with` because `FormsAuthentication.Decrypt`
                // throws an exception when there is a cookie but its format is invalid
                try refresh ctx.Request.Cookies.[FormsAuthentication.FormsCookieName]
                with _ -> refresh null

        let mkCookie (user: string) (duration: option<TimeSpan>) =
            let cookie = FormsAuthentication.GetAuthCookie(user, duration.IsSome)
            ctx.Response.Cookies.Append(cookie.Name, cookie.Value,
                CookieOptions(
                    Domain = cookie.Domain,
                    Expires =
                        (match duration with
                        | Some d -> Nullable(DateTime.UtcNow.Add(d))
                        | None -> Nullable()),
                    HttpOnly = cookie.HttpOnly,
                    Path = cookie.Path,
                    Secure = cookie.Secure))
            refresh cookie.Value

        interface IUserSession with

            member this.IsAvailable = true

            member this.GetLoggedInUser() =
                async {
                    ensureUserHasBeenRefreshed()
                    match ctx.Get<GenericPrincipal option>(EnvKey.WebSharper.User) with
                    | None -> return None
                    | Some x ->
                        if x.Identity.IsAuthenticated then
                            return Some x.Identity.Name
                        else return None
                }

            member this.LoginUser(user, ?persistent) =
                async {
                    let durationOpt =
                        match persistent with
                        | Some true -> Some (TimeSpan.FromDays(1000.*365.))
                        | _ -> None
                    mkCookie user durationOpt
                }

            member this.LoginUser(user: string, duration: TimeSpan) =
                async {
                    mkCookie user (Some duration)
                }

            member this.Logout() =
                async {
                    ctx.Response.Cookies.Append(FormsAuthentication.FormsCookieName, "",
                        CookieOptions(Expires = Nullable(DateTime.Now.AddDays(-1.))))
                    return refresh null
                }

    module O2W =

        let Method (m: string) : Http.Method =
            match m.ToLower() with
            | "connect" -> Http.Method.Connect
            | "delete" -> Http.Method.Delete
            | "get" -> Http.Method.Get
            | "head" -> Http.Method.Head
            | "options" -> Http.Method.Options
            | "post" -> Http.Method.Post
            | "put" -> Http.Method.Put
            | "trace" -> Http.Method.Trace
            | s -> Http.Method.Custom s

        let Headers (headers: IHeaderDictionary) : seq<Http.Header> =
            seq {
                for KeyValue(k, vs) in headers do
                    for v in vs do
                        yield Http.Header.Custom k v
            }

        let Query (query: IReadableStringCollection) : Http.ParameterCollection =
            Http.ParameterCollection(
                seq {
                    for KeyValue(k, vs) in query do
                        for v in vs do
                            yield (k, v)
                }
            )

        let Cookies (cookies: RequestCookieCollection) : HttpCookieCollection =
            let coll = HttpCookieCollection()
            for KeyValue(k, v) in cookies do
                coll.Add(HttpCookie(k, v))
            coll

        let ParseFormData (req: IOwinRequest) =
            // FIXUP FOR CRITICAL BUGS IN WEBSHARPER.OWIN:
            // The legacy "HttpMultipartParser" library that is originally used by WebSharper.Owin contains critical bugs and performance issues.
            // To do this, we copied from the original source for the appropriate version of WebSharper v4.1 and then edited it as indicated.
            // Original source: https://github.com/dotnet-websharper/owin/blob/d7d0f94f578b9c38e4258dec1a69cca349c981b7/WebSharper.Owin/Owin.Sitelets.fs
            // Github Issue: https://github.com/dotnet-websharper/owin/issues/25
            // 1. This has been swapped out to use MimeKit which is more robust and supported.
            // 2. MimeKit is only used to parse `multipart/form-data` requests. For "application/x-www-form-urlencoded" requests a simple query string parser built-in to .net is used.
            // 3. LengthLimitingStream is used to prevent certain forms of DoS/misuse of the system.
            // 4. We (temp file, deleted on closure) buffer the request bodies to the file system to prevent holding potentially large request bodies in memory.
            // 5. Stricter Content-Type header handling was added.
            // 6. The `Http.Request` will no longer honour the `Files` member as typically expected for multipart/form-data requests. This is because nothing in SSP will ever use file uploads in this way - at least not as of 18/09/2019.
            // 7. The `Http.Request` will no longer honour the `Body` member as typically expected, for all requests. This is because nothing in SSP will access the raw request body stream; so it is useless to hold a reference to it.
            // 8. Removed the old WebSharper way of parsing the charset (encoding) via the GetCharset function; it now uses MimeKit to do the Content-Type header parsing to determine encoding.

            let getEncoding (ct:ContentType) =
                if String.IsNullOrWhiteSpace(ct.Charset) then
                    System.Text.Encoding.GetEncoding("ISO-8859-1")
                else
                    System.Text.Encoding.GetEncoding(ct.Charset)

            let prepareBody (preambleEmitter:Stream->unit) =
                let body = new FileStream(Path.Combine(Path.GetTempPath(), Guid.NewGuid().ToString("N") + ".tmp"), FileMode.Create, FileAccess.ReadWrite, FileShare.None, 1024*32, FileOptions.DeleteOnClose)
                preambleEmitter body
                use lls = LengthLimitingStream.MegaBytes(req.Body, 20, leaveOpen = true)
                lls.CopyTo(body, 1024*32)
                body.Position <- 0L
                body

            match ContentType.TryParse(if req.ContentType <> null then req.ContentType else "") with
            | true, ct when StringComparer.OrdinalIgnoreCase.Equals(ct.MimeType, "multipart/form-data") ->
                let encoding = getEncoding ct
                use body = prepareBody (fun body ->
                    // We have to emit this as the first line to force MimeKit to properly parse the data as a multipart message.
                    using (new StreamWriter(body, encoding, 1024, true)) <| fun sw -> sw.WriteLine("Content-Type: " + req.ContentType); sw.WriteLine())

                let po = new ParserOptions(CharsetEncoding = encoding)
                match MimeEntity.Load(po, body, true, req.CallCancelled) with
                | :? Multipart as parts ->
                    let folder (values:System.Collections.Specialized.NameValueCollection) (part:MimeEntity) =
                        let key = part.ContentDisposition.Parameters.Item "name"
                        match part with
                        | :? TextPart as part -> values.Add(key, part.Text); values
                        | :? MimePart -> values
                        | _ -> values

                    let fields = parts |> Seq.fold folder (System.Collections.Specialized.NameValueCollection())
                    { Files = []; Fields = Http.ParameterCollection(fields); Body = Stream.Null }
                | _ ->
                    let fields = System.Collections.Specialized.NameValueCollection()
                    { Files = []; Fields = Http.ParameterCollection(fields); Body = Stream.Null }

            | true, ct when StringComparer.OrdinalIgnoreCase.Equals(ct.MimeType, "application/x-www-form-urlencoded") ->
                use body = prepareBody (fun _ -> ())
                use s = new StreamReader(body, getEncoding ct, false, 1024, true)
                let q = System.Web.HttpUtility.ParseQueryString(s.ReadToEnd())
                { Files = []; Fields = Http.ParameterCollection(q); Body = Stream.Null }
            
            | _ ->
                { Files = []; Fields = Http.ParameterCollection(Seq.empty); Body = Stream.Null }

        let Request (req: IOwinRequest) : Http.Request =
            EnvKey.GetOrSet<Http.Request> req.Environment EnvKey.WebSharper.Request <| fun _ ->
            let formData = ParseFormData req
            formData.Body.Seek(0L, SeekOrigin.Begin) |> ignore
            let uri =
                match req.PathBase.Value with
                | "" | "/" -> req.Uri
                | pathBase ->
                    if req.Uri.IsAbsoluteUri then
                        let uB = UriBuilder req.Uri
                        if uB.Path.StartsWith pathBase then
                            uB.Path <- uB.Path.Substring pathBase.Length
                        uB.Uri
                    else
                        req.Uri
            {
                Method = Method req.Method
                Uri = uri
                Headers = Headers req.Headers
                Post = formData.Fields
                Get = Query req.Query
                Cookies = Cookies req.Cookies
                ServerVariables = Http.ParameterCollection([])
                Body = formData.Body
                Files = formData.Files
            }

        let SetHttpContext (env: Env) (httpContext: HttpContext) : unit =
            match httpContext with
            | null -> ()
            | x -> env.[EnvKey.HttpContext] <- HttpContextWrapper(x)

        /// httpContext is passed externally because we might not be on the right thread to retrieve it.
        let SimpleContext rootDir (req: IOwinRequest) (httpContext: HttpContext) (options: Options) : Web.Context =
            let env = req.Environment
            EnvKey.GetOrSet<Web.Context> env EnvKey.WebSharper.Context <| fun env ->
                SetHttpContext env httpContext
                let owinCtx = req.Context
                let uri = req.Uri
//                let wsReq = Request req
                let session = lazy new OwinCookieUserSession(owinCtx)
                { new Web.Context() with
                    member ctx.Environment = env
                    member ctx.RequestUri = uri
                    member ctx.RootFolder = rootDir
                    member ctx.UserSession = session.Value :> _
                    member ctx.Metadata = options.Metadata
                    member ctx.Json = options.JsonProvider
                    member ctx.Dependencies = options.Dependencies
                    member ctx.ApplicationPath = options.UrlPrefix
                    member ctx.ResourceContext = WebSharper.Web.ResourceContext.ResourceContext options.UrlPrefix
                }

    module W2O =

        let WriteResponse (resp: Task<Http.Response>) (out: IOwinResponse) (onException: IOwinResponse -> exn -> Task) =
            resp.ContinueWith(fun (t: Task<Http.Response>) ->
                try
                    match t.Exception with
                    | null ->
                        let resp = t.Result
                        out.StatusCode <- resp.Status.Code
                        for name, hs in resp.Headers |> Seq.groupBy (fun h -> h.Name) do
                            out.Headers.AppendValues(name, [| for h in hs -> h.Value |])
                        // FIXUP:
                        // Removed a MemoryStream here that unnecessarily buffered the response stream.
                        resp.WriteBody(out.Body)
                    | e ->
                        (onException out e).Wait()
                with e ->
                    (onException out e).Wait()
            )

    let buildResourceContext cfg (context: IOwinContext) : Res.Context =
        let appPath = context.Request.PathBase.Value
        cfg.ResourceContextCache.GetOrAdd(appPath, fun appPath ->
            let isDebug = cfg.Debug
            let pu = P.PathUtility.VirtualPaths(appPath)
            {
                DebuggingEnabled = isDebug
                DefaultToHttp = false
                GetSetting = fun (name: string) ->
                    match ConfigurationManager.AppSettings.[name] with
                    | null -> None
                    | x -> Some x
                GetAssemblyRendering = fun name ->
                    let aid = P.AssemblyId.Create(name)
                    let url = if isDebug then pu.JavaScriptPath(aid) else pu.MinifiedJavaScriptPath(aid)
                    let version = 
                        let fileName = if isDebug then pu.JavaScriptFileName(aid) else pu.MinifiedJavaScriptFileName(aid)
                        match Shared.Metadata.ResourceHashes.TryGetValue(fileName) with
                        | true, h -> "?h=" + string h
                        | _ -> ""
                    Res.RenderLink (url + version)
                GetWebResourceRendering = fun ty resource ->
                    let id = P.AssemblyId.Create(ty)
                    let kind =
                        if resource.EndsWith(".js") || resource.EndsWith(".ts")
                            then P.ResourceKind.Script
                            else P.ResourceKind.Content
                    let r = P.EmbeddedResource.Create(kind, id, resource)
                    let url = pu.EmbeddedPath r
                    let version = 
                        match Shared.Metadata.ResourceHashes.TryGetValue(pu.EmbeddedResourceKey r) with
                        | true, h -> "?h=" + string h
                        | _ -> ""
                    Res.RenderLink (url + version)
                WebRoot = VirtualPathUtility.AppendTrailingSlash(appPath)
                RenderingCache = System.Collections.Concurrent.ConcurrentDictionary()
                ResourceDependencyCache = System.Collections.Concurrent.ConcurrentDictionary()
            } : Res.Context
        )

    [<Sealed>]
    type ContextBuilder(cfg) =
        let info = cfg.Metadata
        let graph = cfg.Dependencies
        let json = cfg.JsonProvider
        let resContext = buildResourceContext cfg

        let ( ++ ) a b =
            let a =
                match a with
                | "" -> "/"
                | _ -> VirtualPathUtility.AppendTrailingSlash(a)
            let b =
                match b with
                | "" -> "."
                | _ -> b
            VirtualPathUtility.Combine(a, b)

        let resolveUrl appPath u =
            if VirtualPathUtility.IsAppRelative(u) then
                VirtualPathUtility.ToAbsolute(u, appPath)
            else
                u

        member b.GetContext<'T when 'T : equality>(site: Sitelet<'T>, req: Http.Request, context: IOwinContext) : Context<'T> =
            let appPath = context.Request.PathBase.Value
            let link = site.Router.Link
            let prefix = cfg.UrlPrefix
            let p = appPath ++ prefix
            let link x =
                match link x with
                | None -> failwithf "Failed to link to %O" (box x)
                | Some loc ->
                    if loc.IsAbsoluteUri then string loc else
                        let loc =
                            match string loc with
                            | "" | "/" -> "."
                            | s when s.StartsWith("/") -> s.Substring(1)
                            | s -> s
                        p ++ loc
            EnvKey.GetOrSet<Context<'T>> context.Environment EnvKey.WebSharper.Context <| fun env ->
                O2W.SetHttpContext env HttpContext.Current // We are sure to be on the right thread here
                new Context<'T>(
                    ApplicationPath = appPath,
                    Environment = env,
                    Link = link,
                    Json = json,
                    Metadata = info,
                    Dependencies = graph,
                    ResourceContext = resContext context,
                    Request = req,
                    RootFolder = cfg.ServerRootDirectory,
                    UserSession = OwinCookieUserSession(context)
                )

    let dispatch (cb: ContextBuilder) (s: Sitelet<'T>) (context: IOwinContext) onException : option<Task> =
        try
            let request = O2W.Request context.Request
            let ctx = cb.GetContext(s, request, context)
            s.Router.Route(request)
            |> Option.map (fun action ->
                let content = s.Controller.Handle(action)
                let response = Content.ToResponse content ctx |> Async.StartAsTask
                W2O.WriteResponse response context.Response onException)
        with e ->
            Some (onException context.Response e)

    type Assembly =

        static member LoadFileInfo(p: string) =
            let fn = Path.GetFullPath p
            let name = AssemblyName.GetAssemblyName(fn)
            match Assembly.TryLoad(name) with
            | None -> Assembly.LoadFrom(fn)
            | Some a -> a

        static member TryLoad(name: AssemblyName) =
            try
                match Assembly.Load(name) with
                | null -> None
                | a -> Some a
            with _ -> None

    let DiscoverAssemblies (path: string) =
        let ls pat = Directory.GetFiles(path, pat)
        let files = Array.append (ls "*.dll") (ls "*.exe")
        files |> Array.choose (fun p ->
            try Some (Assembly.LoadFileInfo(p))
            with e -> None)

    // Ensule that assemblies from binDirectory are loaded.
    // Call this before any use of WebSharper.Web.Shared.*
    let PreloadAssemblies binDirectory =
        DiscoverAssemblies binDirectory |> ignore

type Options with

    static member Create(meta, graph) =
        let dir = System.IO.Directory.GetCurrentDirectory()
        let json = Core.Json.Provider.CreateTyped meta
        let remotingServer = Rem.Server.Create meta json
        {
            Debug = false
            JsonProvider = json
            Metadata = meta
            Dependencies = graph
            ServerRootDirectory = dir
            UrlPrefix = ""
            RemotingServer = Some remotingServer
            OnException = Options.DefaultOnException
            ResourceContextCache = ConcurrentDictionary()
        }

    member o.WithRunRemoting(b) =
        let server =
            if b then Some (Rem.Server.Create o.Metadata o.JsonProvider) else None
        { o with RemotingServer = server }

    static member Create(webRoot, ?binDirectory) =
        PreloadAssemblies (defaultArg binDirectory Options.DefaultBinDirectory)
        Options.Create(Shared.Metadata, Shared.Dependencies)
            .WithServerRootDirectory(webRoot)

type RemotingMiddleware(next: AppFunc, options: Options, alwaysSetContext: bool) = //, webRoot: string, server: Rem.Server, onException: IOwinResponse -> exn -> Task, alwaysSetContext: bool) =
    let webRoot = options.ServerRootDirectory
    let onException = options.OnException options.Debug

    member this.Invoke(env: Env) =
        let context = OwinContext(env) :> IOwinContext
        let httpContext = HttpContext.Current
        if alwaysSetContext then O2W.SimpleContext webRoot context.Request httpContext options |> ignore
        match options.RemotingServer with
        | None -> next.Invoke(env)
        | Some server ->
        let headers =
            O2W.Headers context.Request.Headers
            |> Seq.map (fun h -> (h.Name.ToLowerInvariant(), h.Value))
            |> Map.ofSeq
        let getReqHeader (k: string) =
            Map.tryFind (k.ToLowerInvariant()) headers
        let addRespHeaders headers =
            headers |> List.iter (fun (k, v) -> context.Response.Headers.Add(k, [|v|]))
        if Rem.IsRemotingRequest getReqHeader then
            async {
                try
                    match RpcHandler.CorsAndCsrfCheck context.Request.Method context.Request.Uri
                            (fun k -> match context.Request.Cookies.[k] with null -> None | x -> Some x)
                            getReqHeader
                            (fun k v -> context.Response.Cookies.Append(k, v,
                                            CookieOptions(Expires = Nullable(System.DateTime.UtcNow.AddYears(1000)))))
                            with
                    | Error (code, _, body) ->
                        context.Response.StatusCode <- code
                        context.Response.Write(body)
                    | Preflight headers ->
                        addRespHeaders headers
                    | Ok headers ->
                        addRespHeaders headers
                        let ctx = O2W.SimpleContext webRoot context.Request httpContext options
                        use reader = new StreamReader(context.Request.Body)
                        let! body = reader.ReadToEndAsync() |> Async.AwaitTask
                        let! resp =
                            server.HandleRequest(
                                {
                                    Body = body
                                    Headers = getReqHeader
                                }, ctx)
                        context.Response.StatusCode <- 200
                        context.Response.ContentType <- resp.ContentType
                        let bytes = Encoding.UTF8.GetBytes(resp.Content)
                        context.Response.Write(bytes, 0, bytes.Length)
                with e ->
                    return! onException context.Response e |> Async.AwaitIAsyncResult |> Async.Ignore
            }
            |> Async.StartAsTask
            :> Task
        else next.Invoke(env)

    new (next, options: Options) =
        new RemotingMiddleware(next, options, true)

    static member AsMidFunc(options: Options) =
        match options.RemotingServer with
        | Some rem ->
            MidFunc(fun next -> AppFunc(RemotingMiddleware(next, options).Invoke))
        | None -> MidFunc(fun next -> AppFunc(fun env -> next.Invoke(env)))

    // (webRoot, ?binDirectory)

    static member UseRemoting(webRoot: string, ?binDirectory: string) =
        PreloadAssemblies (defaultArg binDirectory Options.DefaultBinDirectory)
        let o = Options.Create(Shared.Metadata, Shared.Dependencies).WithServerRootDirectory(webRoot)
        fun next -> new RemotingMiddleware(next, o)

    static member AsMidFunc(webRoot: string, ?binDirectory: string) =
        let mw = RemotingMiddleware.UseRemoting(webRoot, ?binDirectory = binDirectory)
        MidFunc(fun next -> AppFunc(mw(next).Invoke))

type SiteletMiddleware<'T when 'T : equality>(next: AppFunc, config: Options, sitelet: Sitelet<'T>) =
    let cb = ContextBuilder(config)

    let appFunc =
        let siteletAppFunc = AppFunc(fun env ->
            let context = OwinContext(env) :> IOwinContext
            match dispatch cb sitelet context (config.OnException config.Debug) with
            | Some t -> t
            | None -> next.Invoke(env))
        if config.RemotingServer.IsSome then
            AppFunc(RemotingMiddleware(siteletAppFunc, config, false).Invoke)
        else
            siteletAppFunc

    member this.Invoke(env: Env) =
        appFunc.Invoke(env)

    static member AsMidFunc(config: Options, sitelet: Sitelet<'T>) =
        MidFunc(fun next ->
            let m = SiteletMiddleware(next, config, sitelet)
            AppFunc(m.Invoke))

    static member DiscoverSitelet(assemblies) =
        match HttpModule.DiscoverSitelet assemblies with
        | Some this -> this
        | None -> failwith "Failed to discover sitelet assemblies"

    static member UseDiscoveredSitelet(webRoot: string, ?binDirectory: string) =
        let binDir = defaultArg binDirectory Options.DefaultBinDirectory
        let options = Options.Create(webRoot, binDir)
        let ok =
            try
                DiscoverAssemblies binDir
                |> HttpModule.DiscoverSitelet
                |> Option.map (fun sitelet ->
                    fun next -> SiteletMiddleware<obj>(next, options, sitelet))
            with :? Reflection.ReflectionTypeLoadException as exn ->
                failwithf "%A" exn.LoaderExceptions
        match ok with
        | Some this -> this
        | None -> failwith "Failed to discover sitelet assemblies"

    static member AsMidFunc(webRoot: string, ?binDirectory: string) =
        let mw = SiteletMiddleware<obj>.UseDiscoveredSitelet(webRoot, ?binDirectory = binDirectory)
        MidFunc(fun next -> AppFunc(mw(next).Invoke))

type WebSharperOptions<'T when 'T : equality>() = 
    let mutable binDir = None
    member val ServerRootDirectory = Directory.GetCurrentDirectory() with get, set
    member this.BinDirectory
        with get () = 
            match binDir with
            | None -> Options.DefaultBinDirectory
            | Some d -> d
        and set dir = binDir <- Some dir
    member val UseRemoting = true with get, set
    member val UrlPrefix = "" with get, set
    member val Debug = false with get, set
    member val Sitelet = None with get, set
    member val DiscoverSitelet = false with get, set
    member val MetadataAndGraph = None with get, set
    member val OnException = Options.DefaultOnException with get, set

    static member DefaultOnException debug response exn =
        Options.DefaultOnException debug response exn

    member this.WithSitelet(sitelet: Sitelet<'T>) =
        this.Sitelet <- Some sitelet 
        this
        
    member this.BuildConfig() =
        let assemblies = DiscoverAssemblies this.BinDirectory

        let sitelet =
            match this.Sitelet with
            | Some s -> Some (Sitelet.Box s)
            | None when this.DiscoverSitelet -> HttpModule.DiscoverSitelet(assemblies)
            | None -> None

        let meta, graph, json =
            match this.MetadataAndGraph with
            | Some (m, g) -> m, g, Core.Json.Provider.CreateTyped m
            | None -> Shared.Metadata, Shared.Dependencies, Shared.Json

        let remotingServer =
            if this.UseRemoting then
                let rem = Rem.Server.Create meta json
                Some rem
            else None

        sitelet, {
            Debug = this.Debug
            JsonProvider = json
            Metadata = meta
            Dependencies = graph
            ServerRootDirectory = this.ServerRootDirectory
            UrlPrefix = this.UrlPrefix
            RemotingServer = remotingServer
            OnException = this.OnException
            ResourceContextCache = ConcurrentDictionary()
        }

    member this.AsMidFunc() =
        let sitelet, config = this.BuildConfig()
        match sitelet with
        | Some sitelet -> SiteletMiddleware<obj>.AsMidFunc(config, sitelet)
        | None -> RemotingMiddleware.AsMidFunc(config)

[<AutoOpen>]
module Extensions =
    type Owin.IAppBuilder with

        member this.UseWebSharperRemoting(webRoot: string, meta: M.Info) =
            this.Use(RemotingMiddleware.AsMidFunc(Options.Create(meta, DepG.FromData([ meta.Dependencies ])).WithServerRootDirectory(webRoot)))

        member this.UseWebSharperRemoting(meta: M.Info) =
            this.Use(RemotingMiddleware.AsMidFunc(Options.Create(meta, DepG.FromData([ meta.Dependencies ]))))

        member this.UseWebSharperRemoting(webRoot: string, ?binDirectory: string) =
            this.Use(RemotingMiddleware.AsMidFunc(webRoot, ?binDirectory = binDirectory))

        member this.UseWebSharperRemotingFromBin(binDirectory: string) =
            this.Use(RemotingMiddleware.AsMidFunc(binDirectory, binDirectory = binDirectory))

        member this.UseSitelet(webRoot: string, sitelet, ?binDirectory) =
            this.UseCustomSitelet(Options.Create(webRoot, ?binDirectory = binDirectory), sitelet)

        member this.UseCustomSitelet(config: Options, sitelet: Sitelet<'T>) =
            this.Use(SiteletMiddleware<'T>.AsMidFunc(config, sitelet))

        member this.UseDiscoveredSitelet(webRoot: string, ?binDirectory) =
            this.Use(SiteletMiddleware<obj>.AsMidFunc(webRoot, ?binDirectory = binDirectory))

        member this.UseWebSharper(options: WebSharperOptions<'T>) =
            this.Use(options.AsMidFunc())

Streams.fs

module Singapore.Util.Owin.Streams
open System.Threading.Tasks
open System.IO

/// Thrown when the stream has exceeded the upper-limit of data length.
exception StreamLengthLimitExceededException of MaximumLengthInBytes : int64

/// A stream which enforces an upper-limit on the length of the data being read.
type LengthLimitingStream(innerStream:Stream, maximumLengthInBytes:int64, leaveOpen:bool) =
    inherit Stream()

    let mutable totalBytesReadCount = 0L

    let incrementAndVerify (v:int) =
        totalBytesReadCount <- totalBytesReadCount + int64 v
        if totalBytesReadCount > maximumLengthInBytes then
            raise (StreamLengthLimitExceededException maximumLengthInBytes)
        v

    static member MegaBytes(innerStream, megaBytes, ?leaveOpen) = new LengthLimitingStream(innerStream, 1024L * 1024L * int64 megaBytes, defaultArg leaveOpen false)
    static member GigaBytes(innerStream, gigaBytes, ?leaveOpen) = new LengthLimitingStream(innerStream, 1024L * 1024L * 1024L * int64 gigaBytes, defaultArg leaveOpen false)

    member __.InnerStream = innerStream

    override __.CanRead = innerStream.CanRead
    override __.CanWrite = innerStream.CanWrite
    override __.CanSeek = innerStream.CanSeek
    override __.Length = innerStream.Length
    override __.CanTimeout = innerStream.CanTimeout
    override __.Position with get() = innerStream.Position and set(v) = innerStream.Position <- v
    override __.ReadTimeout with get() = innerStream.ReadTimeout and set(v) = innerStream.ReadTimeout <- v
    override __.WriteTimeout with get() = innerStream.WriteTimeout and set(v) = innerStream.WriteTimeout <- v

    override __.Dispose(disposing) =
        if disposing && not leaveOpen then innerStream.Dispose()
        base.Dispose(disposing)

    override __.Seek(offset, origin) =
        innerStream.Seek(offset, origin)

    override __.Read(buffer, offset, count) =
        innerStream.Read(buffer, offset, count)
        |> incrementAndVerify

    override __.ReadAsync(buffer, offset, count, cancellationToken) =
        async {
            let! r = innerStream.ReadAsync(buffer, offset, count, cancellationToken) |> Async.AwaitTask
            return incrementAndVerify r
        }
        |> fun computation ->
            Async.StartAsTask(computation, TaskCreationOptions.AttachedToParent, cancellationToken)

    override __.BeginRead(buffer, offset, count, callback, state) =
        innerStream.BeginRead(buffer, offset, count, callback, state)

    override __.EndRead(asyncResult) =
        innerStream.EndRead(asyncResult)
        |> incrementAndVerify

    override __.ReadByte() =
        innerStream.ReadByte()
        |> incrementAndVerify

    override __.Flush() =
        innerStream.Flush()

    override __.FlushAsync(cancellationToken) =
        innerStream.FlushAsync(cancellationToken)

    override __.SetLength(value) =
        innerStream.SetLength(value)

    override __.Write(buffer, offset, count) =
        innerStream.Write(buffer, offset, count)

    override __.WriteAsync(buffer, offset, count, cancellationToken) =
        innerStream.WriteAsync(buffer, offset, count, cancellationToken)
    
    override __.BeginWrite(buffer, offset, count, callback, state) =
        innerStream.BeginWrite(buffer, offset, count, callback, state)

    override __.EndWrite(asyncResult) =
        innerStream.EndWrite(asyncResult)

    override __.WriteByte(value) =
        innerStream.WriteByte(value)