Skip to content

Instantly share code, notes, and snippets.

@rgrinberg
Last active October 25, 2016 15:36
Show Gist options
  • Save rgrinberg/5733256 to your computer and use it in GitHub Desktop.
Save rgrinberg/5733256 to your computer and use it in GitHub Desktop.
simple cache server example in core
open Core.Std
open Core_extended.Std
open Async.Std
module Protocol = struct
module Client_message = struct
type t =
| Get of string
| Set of string * string
| Quit with sexp
let of_string s =
Option.try_with @@ fun () ->
match String.split ~on:' ' s with
| "QUIT"::[] -> Quit
| "GET"::k::[] -> Get k
| "SET"::k::v::[] -> Set (k,v)
| _ -> failwith "bad command"
end
module Server_message = struct
type t =
| Ok of string
| Inserted
| Not_found with sexp
let to_string = function
| Inserted -> "INSERTED\r\n"
| Ok m -> "OK\r\n" ^ m ^ "\r\n"
| Not_found -> "NOT_FOUND\r\n"
end
end
module type BoundedCache = sig
type t
val create : size:int -> t
val get : t -> key:string -> string option
val set : t -> key:string -> data:string -> unit
end
module CacheServer (Cache : BoundedCache) = struct
open Protocol
let process t req =
let open Client_message in
match req with
| Get key ->
Server_message.(match Cache.get t ~key with
| None -> Not_found
| Some x -> Ok x)
| Set (key, data) ->
Cache.set t ~key ~data;
Server_message.Inserted
| Quit -> assert false
let run_server ~host ~port ~size =
let cache = Cache.create ~size in
Tcp.Server.create (Tcp.on_port port) @@ fun _ reader writer ->
Deferred.create (fun finished ->
let rec loop () =
Reader.read_line reader >>> function
| `Ok query ->
(match Client_message.of_string query with
| None -> loop ()
| Some Client_message.Quit -> Ivar.fill finished ()
| Some req ->
let resp = process cache req in
resp |> Server_message.to_string |> Writer.write writer;
loop ())
| `Eof -> Ivar.fill finished ()
in loop ())
end
module Lru = struct
module L = Cache.Lru
type t = (string, string) L.t
let create ~size = L.create None size
let get t ~key = L.find t key
let set = L.add
end
let server =
let module CS = CacheServer(Lru) in
CS.run_server ~host:"127.0.0.1" ~port:12345 ~size:100
let () = Scheduler.go () |> never_returns
Sign up for free to join this conversation on GitHub. Already have an account? Sign in to comment