93 lines
2.7 KiB
OCaml
93 lines
2.7 KiB
OCaml
#require "miou.unix"
|
|
|
|
#require "mirage-crypto-rng-miou-unix"
|
|
|
|
#require "vif"
|
|
|
|
#require "digestif.c"
|
|
|
|
#require "base64"
|
|
|
|
type cfg = Config
|
|
|
|
let index _req server Config =
|
|
Vif.Response.with_string server `OK "Hello from an OCaml script!"
|
|
|
|
let hex _req arg server Config =
|
|
Vif.Response.with_string server `OK (Fmt.str "%02x\n%!" arg)
|
|
|
|
let digest req server Config =
|
|
let ic = Vif.Request.to_stream req in
|
|
let rec go ctx =
|
|
match Vif.Stream.get ic with
|
|
| Some str -> go (Digestif.SHA1.feed_string ctx str)
|
|
| None -> Digestif.SHA1.get ctx
|
|
in
|
|
let hash = go Digestif.SHA1.empty in
|
|
let hash = Digestif.SHA1.to_hex hash in
|
|
Vif.Response.with_string server `OK hash
|
|
|
|
let random req len server Config =
|
|
let buf = Bytes.create 0x7ff in
|
|
Vif.Response.with_stream server `OK @@ fun oc ->
|
|
let rec go rem =
|
|
if rem > 0 then begin
|
|
let len = Int.min rem (Bytes.length buf) in
|
|
Mirage_crypto_rng.generate_into buf len;
|
|
let str = Bytes.sub_string buf 0 len in
|
|
let str = Base64.encode_exn str in
|
|
Vif.Stream.put oc str;
|
|
go (rem - len)
|
|
end
|
|
in
|
|
go len
|
|
|
|
type foo = { username: string; password: string; age: int option }
|
|
|
|
let foo =
|
|
let open Json_encoding in
|
|
let username = req "username" string in
|
|
let password = req "password" string in
|
|
let age = opt "age" int in
|
|
let foo = obj3 username password age in
|
|
let inj (username, password, age) = { username; password; age } in
|
|
let prj { username; password; age } = (username, password, age) in
|
|
conv prj inj foo
|
|
|
|
let login req server Config =
|
|
match Vif.Request.to_json req with
|
|
| Ok (foo : foo) ->
|
|
Logs.debug (fun m -> m "username: %s" foo.username);
|
|
Logs.debug (fun m -> m "password: %s" foo.password);
|
|
Vif.Response.with_string server `OK "Foo"
|
|
| Error (`Msg err) ->
|
|
Logs.err (fun m -> m "Invalid JSON: %s" err);
|
|
Vif.Response.with_string server `Not_acceptable err
|
|
|
|
let routes =
|
|
let open Vif.U in
|
|
let open Vif.R in
|
|
let open Vif.Content_type in
|
|
[
|
|
get (rel /?? nil) --> index
|
|
; get (rel / "random" /% Tyre.int /?? nil) --> random
|
|
; get (rel / "hex" /% Tyre.int /?? nil) --> hex
|
|
; post any (rel / "digest" /?? nil) --> digest
|
|
; post (json_encoding foo) (rel / "json" /?? nil) --> login
|
|
]
|
|
|
|
let default req target server Config =
|
|
Logs.debug (fun m -> m "We are into the default case");
|
|
Vif.Response.with_string server `Not_found (Fmt.str "%S not found\n%!" target)
|
|
|
|
let rng =
|
|
let open Mirage_crypto_rng_miou_unix in
|
|
let finally = kill in
|
|
Vif.D.device ~name:"rng" ~finally [] @@ fun Config ->
|
|
initialize (module Pfortuna)
|
|
|
|
let () =
|
|
Miou_unix.run @@ fun () ->
|
|
let sockaddr = Unix.(ADDR_INET (inet_addr_loopback, 8080)) in
|
|
let cfg = Vif.config sockaddr in
|
|
Vif.run ~cfg ~default ~devices:Vif.Ds.[ rng ] routes Config
|