giraffe.ml

open System
open System.Data
open System.Text.Json
open Microsoft.FSharp.Core

type request = { path: string; body: string; headers: (string * string) list }
type response = { body: string; code: int; headers: (string * string) list }
type 'env context = { request: request; response: response; env: 'env }

type 'env handler = 'env context -> 'env context option
type 'env middleware = 'env handler -> 'env handler

let (>=>) h1 h2 : 'env handler = fun ctx ->
  match h1 ctx with
  | Some ctx -> h2 ctx
  | None -> None

let default_response = { code = 204; headers = []; body = "" }

let skip<'env> : 'env handler = fun ctx -> None
let next<'env> : 'env handler = fun ctx -> Some ctx

let map_response f = fun ctx ->
  next { ctx with context.response = f ctx.response }

let clear<'env> : 'env handler = map_response (fun _ -> default_response)

let not_found<'env> : 'env handler =
  map_response (fun x -> { x with code = 404; body = "handler for this request not found" })

let set_header key value : 'env handler =
  map_response (fun x -> { x with headers = (key, value) :: x.headers})

let write_json code (item: 'a) : 'env handler =
  map_response (fun x -> { x with body = JsonSerializer.Serialize(item); code = code})

let path path : 'env handler = fun ctx ->
  if ctx.request.path = path
  then next ctx
  else skip ctx

let choose (handlers: 'env handler list) : 'env handler = fun ctx ->
  let rec loop handlers =
    match handlers with
    | [] -> skip ctx
    | handler::tail ->
      match handler ctx with
      | Some ctx -> next ctx
      | None -> loop tail
  in
  loop handlers

let require_auth (bad_auth: 'env handler) roles: 'env handler = fun ctx ->
  let role_auth = ctx.request.headers
                  |> Seq.tryFind (fun (k, v) -> k = "Authorization")
                  |> Option.map snd
                  |> Option.map (fun token -> Seq.contains token roles)
                  |> Option.defaultValue false
  if role_auth
  then next ctx
  else bad_auth ctx

let bad_auth<'env> : 'env handler = write_json 403 "bad auth"

type Env = {
  service_provider: IServiceProvider 
}

type Todo = { text: string; is_checked: bool }
type Repos =
  abstract GetAll<'t> : 't -> 't list

let with_service<'s> (handler: 's -> Env handler) : Env handler = fun ctx ->
  let s = ctx.env.service_provider.GetService(typeof<'s>) :?> 's
  handler s ctx

let with_service2<'s1, 's2> (handler: 's1 -> 's2 -> Env handler) : Env handler = fun ctx ->
  let s1 = ctx.env.service_provider.GetService(typeof<'s1>) :?> 's1
  let s2 = ctx.env.service_provider.GetService(typeof<'s2>) :?> 's2
  handler s1 s2 ctx
  
let create_user : Env handler = with_service<Repos> (fun repos ->
  let all = repos.GetAll()
  write_json 200 all
) 
  
let router : Env handler = set_header "Server" "F#" >=> choose [
  path "/api/hello" >=> write_json 200 "hello user";
  
  path "/api/me" >=> require_auth bad_auth ["user"] >=> write_json 200 "you are user";
  path "/api/me/admin" >=> require_auth bad_auth ["admin"] >=> write_json 200 "you are admin";

  path "/api/v2/me" >=> choose [
    require_auth skip ["user"] >=> write_json 200 "you are user";
    require_auth skip ["admin"] >=> write_json 200 "you are admin"
  ];
  
  not_found;
]

let env = {
  service_provider = null
}

{ path = "/api/v2/me"; body = ""; headers = [("Authorization", "admin")] }
|> fun req -> { request = req; response = default_response; env = env } 
|> router
|> Option.map _.response
|> printfn "%A"