Simple File Server Pipeline

fileserver.fs

open System.IO
open Freya.Core
open Freya.Core.Operators
open Freya.Machines.Http
open Freya.Routers.Uri.Template
open Freya.Types.Http

// Configuration

let fileTypes =
    Map.ofList [
        ".gif", MediaType.parse "image/gif"
        ".html", MediaType.parse "text/html"
        ".png", MediaType.parse "image/png" ]

// Optics

let fileRoot_ =
    State.value_ "freya.FileServer.Root"

let fileSegments_ =
    Route.list_ "segments"

// Properties

let fileRoot =
    Freya.memo (Option.get <!> Freya.Optic.get fileRoot_)

let filePath =
    Freya.memo (Option.get <!> Freya.Optic.get fileSegments_)

let fileInfo =
    Freya.memo ((fun x y -> FileInfo (Path.Combine (Array.ofSeq (x :: y)))) <!> fileRoot <*> filePath)

// Decisions

let fileExists =
    (fun (x: FileInfo) -> x.Exists) <!> fileInfo

// Handlers

let fileOk =
    (fun (x: FileInfo) ->
        { Data = File.ReadAllBytes x.FullName
          Description =
            { Charset = None
              Encodings = None
              MediaType = Map.tryFind x.Extension fileTypes
              Languages = None } }) <!> fileInfo

// Resources

let fileResource =
    freyaMachine {
        exists fileExists
        methods [ GET; HEAD; OPTIONS ]
        handleOk fileOk }

// Routers

let fileRouter =
    freyaRouter {
        resource "{/segments*}" fileResource }

// Server

let fileServer root =
    Freya.Optic.set fileRoot_ (Some root) >?= fileRouter

// Type

open System
open Microsoft.Owin.Hosting

type FileServer () =
    member __.Configuration () =
        OwinAppFunc.ofFreya (fileServer @"Z:\Code\kolektiv\freya\stack\machines\docs\http\html")

// Main

[<EntryPoint>]
let main _ =

    let _ = WebApp.Start<FileServer> ("http://localhost:7000")
    let _ = Console.ReadLine ()

    0