Skip to content

Instantly share code, notes, and snippets.

@kolektiv
Last active October 30, 2017 21:07
Show Gist options
  • Star 2 You must be signed in to star a gist
  • Fork 0 You must be signed in to fork a gist
  • Save kolektiv/3d28ae35657275ecc29c to your computer and use it in GitHub Desktop.
Save kolektiv/3d28ae35657275ecc29c to your computer and use it in GitHub Desktop.
A content negotiated resource in Freya
open System
open System.Text
open Freya.Core
open Freya.Machine
open Freya.Machine.Extensions.Http
open Freya.Machine.Router
open Freya.Router
open Freya.Types.Http
open Microsoft.Owin.Hosting
(* Representation/Negotiation
Freya doesn't impose any choice of serializer or encoding on you,
as it's usually best left to the developer to decide what their app
needs. We'll assume you've got some functions that will serialize
your resources to JSON and XML in this case.
We write a represent function which looks at the results of the
content negotiation, given as an instance of the Specification type.
We're only interested in the negotiation of MediaTypes in this case.
The results returned are lists of acceptable MediaTypes, ordered by
client preference.
Our function returns a Representation (actually a Freya<Representation>
as everything is a function in Freya!) which describes what this data is
and how it's represented. Here we only care that we've encoded the data
as UTF-8, and we've serialized it in a specific way.
This is the kind of code you only write once per app in general. *)
let json _ =
"""{ "Hello": "World" }"""
let xml _ =
"""<Hello>World</Hello>"""
let represent res spec =
let serialized, mediaType =
match spec.MediaTypes with
| Free -> json res, MediaType.Json
| Negotiated (m :: _) when m = MediaType.Json -> json res, MediaType.Json
| Negotiated (m :: _) when m = MediaType.Xml -> xml res, MediaType.Xml
| _ -> failwith "Representation Failure"
Freya.init
{ Data = Encoding.UTF8.GetBytes serialized
Description =
{ Charset = Some Charset.Utf8
Encodings = None
MediaType = Some mediaType
Languages = None } }
(* Resources
We're creating a very simple resource here, all we're providing is a
handler, which will be called when the server wants to return a
200 OK response, and some configuration - in this case, which
MediaTypes are supported for this resource. Again - the MediaTypes are
actually given as a function - although they're static here, it is possible
to change things like this at runtime.
The simple fact of providing MediaTypes in this way means that the request
will now be negotiated when an Accept header is present (this is a
very declarative configuration model).
You probably wouldn't specify MediaTypes on every resource in a real
app - you'd define one or more resources containing common properties
like this, and then include them within resources. Resources with
Freya.Machine are completely nestable in this sense.
You would likely do the same with the "using http" statement here, which
tells the resource that it should use the HTTP processing state
machine. *)
let exampleMediaTypes =
Freya.init [
MediaType.Json
MediaType.Xml ]
let exampleHandler =
represent "Hello World"
(* Allowed/Exists
Supporting extra logic is optional, but you can add in extra logical checks
(in fact overriding the default results of these checks) by adding new
elements to the resource.
In this case we've added two very simple decision
functions (Freya<bool>) which just look at an untyped query string for
their data. Of course normally you'd want to actualy be checking if the
resource existed, or there was some token in the request which matched a
requirement for being allowed to obtain a resource.
These could be written more succinctly, but this way is clearer. In many
cases you may also wish to only evaluate one of these functions once,
though it's used in multiple places (per request) and you can do that
by adding |> Freya.memo as we've done here with "exampleAllowed" - this
will now be evaluated at-most-once per request. *)
let exampleAllowed =
freya {
let! query = Freya.getLens Request.query
return query <> "forbidden" } |> Freya.memo
let exampleExists =
freya {
let! query = Freya.getLens Request.query
return query <> "missing" }
let exampleResource =
freyaMachine {
using http
allowed exampleAllowed
exists exampleExists
mediaTypesSupported exampleMediaTypes
handleOk exampleHandler } |> FreyaMachine.toPipeline
(* Routing
We need to hook our resource up to a path, so we use the Freya.Router
to do this. Just a simple root resource for this example. *)
let exampleRouter =
freyaRouter {
resource "/" exampleResource } |> FreyaRouter.toPipeline
(* App
We want to turn our router in to an OWIN AppFunc, so we can run it
using any OWIN compatible server. *)
let exampleApp =
exampleRouter |> OwinAppFunc.ofFreya
(* Katana
We'll use Katana to host our little example app. It'll need an app
type. *)
type ExampleApp () =
member __.Configuration () =
exampleApp
(* Entry
Finally, we'll spin up our server as a quick and dirty console
app on localhost for testing. *)
[<EntryPoint>]
let main _ =
let _ = WebApp.Start<ExampleApp> "http://localhost:8080"
let _ = Console.ReadLine ()
0
@kolektiv
Copy link
Author

WebMachine have something like this as a diagram for their graph: https://raw.githubusercontent.com/wiki/basho/webmachine/images/http-headers-status-v3.png

Our graph isn't quite the same, and is also complicated by the fact that our graph actually works on an extension model. The absolute default graph in a resource is Start --> Finish unless you say something like using http which will modify that graph at runtime (in the "compilation" step). That's how we currently implement CORS - you would be using http and using httpCors, which will extend the graph with HTTP support and then CORS support where that's needed (and again, luckily, ordering in the computation expression doesn't matter here).

You can even write your own extensions to add processing steps to the graph if needed (for example, you could write an extension which would introduce WebDAV support). However, that is definitely not for the faint-hearted at this point, and it should never be needed if people just want to do simple and accurate HTTP work.

Sign up for free to join this conversation on GitHub. Already have an account? Sign in to comment