├── .gitignore ├── .ocamlformat ├── .ocp-indent ├── .travis.yml ├── Makefile ├── README.md ├── dune-project ├── h2.opam ├── lib ├── dune ├── frame_header.ml ├── parse.ml ├── parse.mli ├── pqueue.ml ├── reader.ml ├── serialize.ml ├── serialize.mli ├── types.ml └── types.mli └── test ├── README.md ├── continuation_frame_test.ml ├── data_frame_test.ml ├── dune ├── go_away_frame_test.ml ├── h2_test.ml ├── headers_frame_test.ml ├── ping_frame_test.ml ├── priority_frame_test.ml ├── priority_test.ml ├── push_promise_frame_test.ml ├── rst_stream_frame_test.ml ├── settings_frame_test.ml ├── util.ml └── window_frame_test.ml /.gitignore: -------------------------------------------------------------------------------- 1 | 2 | # Created by https://www.gitignore.io/api/ocaml 3 | 4 | ### OCaml ### 5 | *.annot 6 | *.cmo 7 | *.cma 8 | *.cmi 9 | *.a 10 | *.o 11 | *.cmx 12 | *.cmxs 13 | *.cmxa 14 | 15 | # ocamlbuild working directory 16 | _build/ 17 | 18 | # ocamlbuild targets 19 | *.byte 20 | *.native 21 | 22 | # oasis generated files 23 | setup.data 24 | setup.log 25 | 26 | 27 | # End of https://www.gitignore.io/api/ocaml 28 | **/.merlin 29 | 30 | _opam 31 | *.install 32 | -------------------------------------------------------------------------------- /.ocamlformat: -------------------------------------------------------------------------------- 1 | wrap-comments=true 2 | margin=82 3 | doc-comments=before 4 | field-space=loose 5 | infix-precedence=parens 6 | -------------------------------------------------------------------------------- /.ocp-indent: -------------------------------------------------------------------------------- 1 | JaneStreet 2 | -------------------------------------------------------------------------------- /.travis.yml: -------------------------------------------------------------------------------- 1 | language: c 2 | install: wget https://raw.githubusercontent.com/ocaml/ocaml-ci-scripts/master/.travis-docker.sh 3 | script: bash -ex .travis-docker.sh 4 | services: 5 | - docker 6 | env: 7 | global: 8 | - PINS="h2:." 9 | - DISTRO="debian-stable" 10 | matrix: 11 | - PACKAGE="h2" OCAML_VERSION="4.04" 12 | - PACKAGE="h2" OCAML_VERSION="4.05" 13 | - PACKAGE="h2" OCAML_VERSION="4.06" 14 | -------------------------------------------------------------------------------- /Makefile: -------------------------------------------------------------------------------- 1 | .PHONY: default build install uninstall test clean utop 2 | 3 | default: build 4 | 5 | build: 6 | dune build 7 | 8 | test: 9 | dune runtest -f 10 | 11 | install: 12 | dune install 13 | 14 | uninstall: 15 | dune uninstall 16 | 17 | clean: 18 | dune clean 19 | 20 | utop: 21 | dune utop lib 22 | -------------------------------------------------------------------------------- /README.md: -------------------------------------------------------------------------------- 1 | ### For something that is much further along please see: https://github.com/anmonteiro/http2af 2 | 3 | 4 | 5 | # HTTP/2 protocol [WIP] 6 | 7 | This is a work in progress implementation of the HTTP/2 protocol stack in OCaml. 8 | 9 | ## What's available so far? 10 | 11 | * Parser/Serializer for HTTP/2 frames. 12 | 13 | ## What's left? 14 | 15 | * Everything :) 16 | 1. Priority (A simple weighted priority queue is [**available.**](https://github.com/anuragsoni/h2/blob/a7e5bc6135be308d0da5453a2cb048b0057d65b2/lib/pqueue.ml) Priority Tree needs to be implemented. 17 | 2. Hpack 18 | 3. HTTP/2 stream/connection state machines 19 | 20 | ## Notes 21 | 22 | One of the goal of the implementation will be to make it easy to embed in other OCaml programs. This implementation will not handle TLS, HTTP/1 connection upgrades, etc. 23 | -------------------------------------------------------------------------------- /dune-project: -------------------------------------------------------------------------------- 1 | (lang dune 1.1) 2 | (name http2) 3 | -------------------------------------------------------------------------------- /h2.opam: -------------------------------------------------------------------------------- 1 | opam-version: "2.0" 2 | name: "h2" 3 | maintainer: "Anurag Soni " 4 | authors: ["Anurag Soni "] 5 | homepage: "https://github.com/anuragsoni/h2" 6 | dev-repo: "git+https://github.com/anuragsoni/h2" 7 | bug-reports: "https://github.com/anuragsoni/h2/issues" 8 | license: "BSD-3-clause" 9 | build: [ 10 | ["dune" "subst"] {pinned} 11 | ["dune" "build" "-p" name "-j" jobs] 12 | ] 13 | run-test: [ 14 | ["dune" "runtest" "-p" name] 15 | ] 16 | depends: [ 17 | "ocaml" { >= "4.04.2" } 18 | "dune" {build & >= "1.1"} 19 | "angstrom" {>= "0.9.0"} 20 | "faraday" {>= "0.5.0" } 21 | "base" {>= "0.11.0"} 22 | "psq" 23 | "hex" {with-test} 24 | "alcotest" {with-test} 25 | ] 26 | -------------------------------------------------------------------------------- /lib/dune: -------------------------------------------------------------------------------- 1 | (library 2 | (public_name h2) 3 | (libraries base angstrom faraday psq) 4 | ) 5 | -------------------------------------------------------------------------------- /lib/frame_header.ml: -------------------------------------------------------------------------------- 1 | open Base 2 | open Types 3 | 4 | let zero_frame_types = [FrameSettings; FramePing; FrameGoAway] 5 | 6 | let non_zero_frame_types = 7 | [ FrameData 8 | ; FrameHeaders 9 | ; FramePriority 10 | ; FrameRSTStream 11 | ; FramePushPromise 12 | ; FrameContinuation ] 13 | 14 | let check_frame_header settings frame_header frame_type = 15 | let open Polymorphic_compare in 16 | let {enable_push; _} = settings in 17 | let {flags; length; stream_id} = frame_header in 18 | let check_frame_type = function 19 | | FrameData when stream_id = 0x0l -> 20 | Error 21 | (ConnectionError 22 | (ProtocolError, "data frames must be associated with a stream")) 23 | | FrameHeaders when test_padded flags && length < 1 -> 24 | Error 25 | (ConnectionError 26 | (FrameSizeError, "insufficient payload for padding length")) 27 | | FrameHeaders when test_priority flags && length < 5 -> 28 | Error 29 | (ConnectionError 30 | (FrameSizeError, "insufficient payload for priority fields")) 31 | | FrameHeaders when test_padded flags && test_priority flags && length < 6 -> 32 | Error 33 | (ConnectionError 34 | ( FrameSizeError 35 | , "insufficient payload for Pad length and priority fields" )) 36 | | FramePriority when length <> 5 -> 37 | Error (StreamError (FrameSizeError, stream_id)) 38 | | FrameRSTStream when length <> 4 -> 39 | Error 40 | (ConnectionError 41 | (FrameSizeError, "payload length is not 4 in rst stream frame")) 42 | | FrameSettings when length % 6 <> 0 -> 43 | Error 44 | (ConnectionError 45 | ( FrameSizeError 46 | , "payload length is not multiple of 6 in settings frame" )) 47 | | FrameSettings when test_ack flags && length <> 0 -> 48 | Error 49 | (ConnectionError 50 | (FrameSizeError, "payload length must be 0 if ack flag is set")) 51 | | FramePushPromise when not enable_push -> 52 | Error (ConnectionError (ProtocolError, "push not enabled")) 53 | | FramePushPromise when not (is_response stream_id) -> 54 | Error 55 | (ConnectionError 56 | (ProtocolError, "push promise must be used with response streams")) 57 | | FramePing when length <> 8 -> 58 | Error 59 | (ConnectionError (FrameSizeError, "payload length is 8 in ping frame")) 60 | | FrameGoAway when length < 8 -> 61 | Error 62 | (ConnectionError 63 | (FrameSizeError, "go away body must be 8 bytes or more")) 64 | | FrameWindowUpdate when length <> 4 -> 65 | Error 66 | (ConnectionError 67 | (FrameSizeError, "payload length is 4 in window update frame")) 68 | | _ -> Ok {flags; length; stream_id} 69 | in 70 | if length > settings.max_frame_size then 71 | Error (ConnectionError (FrameSizeError, "exceeded maximum frame size")) 72 | else if 73 | List.exists ~f:(fun x -> x = frame_type) non_zero_frame_types 74 | && is_control stream_id 75 | then Error (ConnectionError (ProtocolError, "cannot use in control stream")) 76 | else if 77 | List.exists ~f:(fun x -> x = frame_type) zero_frame_types 78 | && not (is_control stream_id) 79 | then Error (ConnectionError (ProtocolError, "cannot use in non-zero stream")) 80 | else check_frame_type frame_type 81 | -------------------------------------------------------------------------------- /lib/parse.ml: -------------------------------------------------------------------------------- 1 | open Base 2 | open Angstrom 3 | open Types 4 | 5 | let frame_length = 6 | lift3 7 | (fun x y z -> (x lsl 16) lor (y lsl 8) lor z) 8 | any_uint8 any_uint8 any_uint8 9 | 10 | let frame_type = lift (fun x -> frame_type_to_id x) any_uint8 11 | 12 | let frame_flags = any_uint8 13 | 14 | let extract_stream_id s = 15 | let open Int32 in 16 | s land ((1l lsl 31) - 1l) 17 | 18 | let stream_identifier = lift (fun x -> extract_stream_id x) Angstrom.BE.any_int32 19 | 20 | let parse_payload_with_padding frame_header parse_fn = 21 | if test_padded frame_header.flags then 22 | any_uint8 23 | >>= fun pad_length -> 24 | let body_length = frame_header.length - pad_length - 1 in 25 | if body_length < 0 then 26 | fail ("padding is not enough " ^ Int.to_string pad_length) 27 | else parse_fn body_length 28 | else parse_fn frame_header.length 29 | 30 | let parse_data_frame frame_header = 31 | let parse_data length = lift (fun x -> DataFrame x) (take length) in 32 | parse_payload_with_padding frame_header parse_data 33 | 34 | let parse_priority = 35 | lift2 36 | (fun s w -> 37 | let e = test_exclusive s in 38 | let p = 39 | {exclusive = e; weight = w; stream_dependency = extract_stream_id s} 40 | in 41 | p ) 42 | Angstrom.BE.any_int32 any_uint8 43 | 44 | let parse_priority_frame = parse_priority >>| fun x -> PriorityFrame x 45 | 46 | let parse_header_frame frame_header = 47 | let parse_fn = 48 | if test_priority frame_header.flags then fun length -> 49 | lift2 50 | (fun priority headers -> HeadersFrame (Some priority, headers)) 51 | parse_priority 52 | (take (length - 5)) 53 | else fun length -> lift (fun x -> HeadersFrame (None, x)) (take length) 54 | in 55 | parse_payload_with_padding frame_header parse_fn 56 | 57 | let parse_error_code = lift (fun x -> error_code_to_id x) Angstrom.BE.any_int32 58 | 59 | let parse_rst_stream = lift (fun x -> RSTStreamFrame x) parse_error_code 60 | 61 | let parse_settings_frame frame_header = 62 | let num_settings = frame_header.length / 6 in 63 | let parse_setting = 64 | lift2 65 | (fun k v -> 66 | Option.map (settings_key_to_id k) ~f:(fun s -> (s, Int32.to_int_exn v)) 67 | ) 68 | BE.any_int16 BE.any_int32 69 | in 70 | lift 71 | (fun s -> SettingsFrame (List.filter_opt s)) 72 | (* TODO: This ignores unknown settings, check if this needs to be a protocol 73 | error. *) 74 | (count num_settings parse_setting) 75 | 76 | let parse_push_promise_frame frame_header = 77 | let parse_fn length = 78 | lift2 79 | (fun s h -> PushPromiseFrame (s, h)) 80 | stream_identifier 81 | (take (length - 4)) 82 | in 83 | parse_payload_with_padding frame_header parse_fn 84 | 85 | let parse_ping_frame = lift (fun x -> PingFrame x) (take 8) 86 | 87 | let parse_go_away frame_header = 88 | lift3 89 | (fun s e x -> GoAwayFrame (s, e, x)) 90 | stream_identifier parse_error_code 91 | (take (frame_header.length - 8)) 92 | 93 | let parse_window_frame = 94 | BE.any_int32 95 | >>= fun w -> 96 | let w' = clear_bit (Int32.to_int_exn w) 31 in 97 | if w' = 0 then fail "Window update must not be 0" 98 | else return (WindowUpdateFrame w') 99 | 100 | let parse_continuation_frame frame_header = 101 | lift (fun x -> ContinuationFrame x) (take frame_header.length) 102 | 103 | let parse_unknown_frame typ frame_header = 104 | lift (fun x -> UnknownFrame (typ, x)) (take frame_header.length) 105 | 106 | let get_parser_for_frame frame_header frame_type = 107 | match frame_type with 108 | | FrameData -> parse_data_frame frame_header 109 | | FrameHeaders -> parse_header_frame frame_header 110 | | FramePriority -> parse_priority_frame 111 | | FrameRSTStream -> parse_rst_stream 112 | | FrameSettings -> parse_settings_frame frame_header 113 | | FramePushPromise -> parse_push_promise_frame frame_header 114 | | FramePing -> parse_ping_frame 115 | | FrameGoAway -> parse_go_away frame_header 116 | | FrameWindowUpdate -> parse_window_frame 117 | | FrameContinuation -> parse_continuation_frame frame_header 118 | | FrameUnknown typ -> parse_unknown_frame typ frame_header 119 | 120 | let parse_frame_header = 121 | lift4 122 | (fun length frame_type flags stream_id -> 123 | (frame_type, {flags; length; stream_id}) ) 124 | frame_length frame_type frame_flags stream_identifier 125 | "frame header" <* commit 126 | 127 | let parse_frame_payload frame_type frame_header = 128 | get_parser_for_frame frame_header frame_type "frame payload" <* commit 129 | -------------------------------------------------------------------------------- /lib/parse.mli: -------------------------------------------------------------------------------- 1 | open Types 2 | 3 | val parse_frame_header : (frame_type_id * frame_header) Angstrom.t 4 | 5 | val parse_frame_payload : 6 | frame_type_id -> frame_header -> frame_payload Angstrom.t 7 | -------------------------------------------------------------------------------- /lib/pqueue.ml: -------------------------------------------------------------------------------- 1 | module Priority : sig 2 | type deficit = int 3 | 4 | type weight = int 5 | 6 | type t = {deficit : deficit; weight : weight} 7 | 8 | val compare : t -> t -> int 9 | 10 | val deficit_of_weight : weight -> deficit 11 | end = struct 12 | type deficit = int 13 | 14 | type weight = int 15 | 16 | type t = {deficit : deficit; weight : weight} 17 | 18 | let compare {deficit = d1; _} {deficit = d2; _} = compare (d1 : int) d2 19 | 20 | let steps = 65536 21 | 22 | let deficit_table = 23 | let round x = floor (x +. 0.5) in 24 | Array.init 256 (fun i -> 25 | int_of_float (round (float_of_int steps /. float_of_int (i + 1))) ) 26 | 27 | let deficit_of_weight w = deficit_table.(w - 1) 28 | end 29 | 30 | module Make (V : sig 31 | type v 32 | end) = 33 | struct 34 | module Q = 35 | Psq.Make 36 | (Int32) 37 | (struct 38 | type t = Priority.t * V.v 39 | 40 | let compare (p1, _) (p2, _) = Priority.compare p1 p2 41 | end) 42 | 43 | type t = {base_deficit : Priority.deficit; queue : Q.t} 44 | 45 | let empty = {base_deficit = 0; queue = Q.empty} 46 | 47 | let is_empty {queue; _} = Q.is_empty queue 48 | 49 | let size {queue; _} = Q.size queue 50 | 51 | let add k ({Priority.weight; deficit} as p) v ({base_deficit; queue} as q) = 52 | let d = Priority.deficit_of_weight weight in 53 | let b = if deficit = 0 then base_deficit else deficit in 54 | let deficit' = max (b + d) base_deficit in 55 | let p' = {p with deficit = deficit'} in 56 | let queue' = Q.add k (p', v) queue in 57 | {q with queue = queue'} 58 | 59 | let pop {queue; _} = 60 | match Q.pop queue with 61 | | None -> None 62 | | Some ((k, (p, v)), q') -> 63 | let base_deficit = p.deficit in 64 | Some (k, p, v, {base_deficit; queue = q'}) 65 | 66 | let remove k q = 67 | let f = Q.find k q.queue in 68 | match f with 69 | | None -> (None, q) 70 | | Some (_, v) -> ( 71 | match Q.min q.queue with 72 | | None -> failwith "can't find min value" 73 | | Some (k', (p', _)) -> 74 | if k' = k then 75 | (* We removed the min element. Update base_deficit just like we do in 76 | [pop] *) 77 | (Some v, {base_deficit = p'.deficit; queue = Q.remove k q.queue}) 78 | else (Some v, {q with queue = Q.remove k q.queue}) ) 79 | end 80 | -------------------------------------------------------------------------------- /lib/reader.ml: -------------------------------------------------------------------------------- 1 | open Base 2 | module FT = Types 3 | 4 | type continuable = [`Headers | `PushPromise] 5 | 6 | type partial = {frame : continuable; buffer : Bigstringaf.t} 7 | 8 | type t = {partial : partial option} 9 | 10 | let create = {partial = None} 11 | 12 | let frame_header = Angstrom.parse_bigstring Parse.parse_frame_header 13 | 14 | let frame_payload frame_type frame_header = 15 | Angstrom.parse_bigstring (Parse.parse_frame_payload frame_type frame_header) 16 | 17 | let read_frame conn bs = 18 | let open Result.Monad_infix in 19 | let create_error m = FT.ConnectionError (FT.ProtocolError, m) in 20 | Result.map_error ~f:create_error (frame_header bs) 21 | >>= fun (frame_type, frame_header) -> 22 | Frame_header.check_frame_header conn frame_header frame_type 23 | >>= fun frame_header -> 24 | Result.map_error ~f:create_error 25 | (frame_payload frame_type frame_header 26 | (Bigstringaf.sub bs ~off:9 ~len:frame_header.length)) 27 | -------------------------------------------------------------------------------- /lib/serialize.ml: -------------------------------------------------------------------------------- 1 | open Faraday 2 | 3 | type frame_info = 4 | { flags : Types.frame_flags 5 | ; stream_id : Types.stream_id 6 | ; padding : Types.padding option } 7 | 8 | let make_frame_info ~set_flag ~stream_id = 9 | {flags = set_flag Types.default_flags; stream_id; padding = None} 10 | 11 | let write_24 t i = 12 | let w0 = (i lsr 16) land 0xff in 13 | let w1 = (i lsr 8) land 0xff in 14 | let w2 = i land 0xff in 15 | write_uint8 t w0 ; write_uint8 t w1 ; write_uint8 t w2 16 | 17 | let write_frame_header t frame_type {Types.length; flags; stream_id} = 18 | write_24 t length ; 19 | write_uint8 t (Types.frame_type_of_id frame_type) ; 20 | write_uint8 t flags ; 21 | BE.write_uint32 t stream_id 22 | 23 | let write_padded info length writer = 24 | match info.padding with 25 | | None -> 26 | let header = 27 | {Types.length; flags = info.flags; stream_id = info.stream_id} 28 | in 29 | (header, writer) 30 | | Some padding -> 31 | let flags = Types.set_padded info.flags in 32 | let pad_length = String.length padding in 33 | let new_length = length + pad_length + 1 in 34 | let new_writer t = 35 | write_uint8 t pad_length ; writer t ; write_string t padding 36 | in 37 | let header = 38 | {Types.length = new_length; flags; stream_id = info.stream_id} 39 | in 40 | (header, new_writer) 41 | 42 | let write_data_frame info body = 43 | let writer t = write_string t body in 44 | let length = String.length body in 45 | write_padded info length writer 46 | 47 | let write_priority {Types.exclusive; stream_dependency; weight} = 48 | let stream = 49 | if exclusive then Types.set_exclusive stream_dependency 50 | else stream_dependency 51 | in 52 | fun t -> BE.write_uint32 t stream ; write_uint8 t weight 53 | 54 | let write_headers_frame info priority headers = 55 | match priority with 56 | | None -> 57 | let length = String.length headers in 58 | let writer t = write_string t headers in 59 | write_padded info length writer 60 | | Some priority' -> 61 | let length = String.length headers + 5 in 62 | let info' = {info with flags = Types.set_priority info.flags} in 63 | let writer t = 64 | (write_priority priority') t ; 65 | write_string t headers 66 | in 67 | write_padded info' length writer 68 | 69 | let write_priority_frame info priority = 70 | let header = 71 | {Types.flags = info.flags; stream_id = info.stream_id; length = 5} 72 | in 73 | (header, write_priority priority) 74 | 75 | let write_rst_stream_frame info e = 76 | let error_code = Types.error_code_of_id e in 77 | let header = 78 | {Types.flags = info.flags; stream_id = info.stream_id; length = 4} 79 | in 80 | (header, fun t -> BE.write_uint32 t error_code) 81 | 82 | let write_settings_frame info settings = 83 | let writer t = 84 | let rec aux = function 85 | | [] -> () 86 | | (key, value) :: xs -> 87 | BE.write_uint16 t (Types.settings_key_from_id key) ; 88 | BE.write_uint32 t (Int32.of_int value) ; 89 | aux xs 90 | in 91 | aux settings 92 | in 93 | let header = 94 | { Types.flags = info.flags 95 | ; stream_id = info.stream_id 96 | ; length = List.length settings * 6 } 97 | in 98 | (header, writer) 99 | 100 | let write_push_promise_frame info stream header_block = 101 | let length = 4 + String.length header_block in 102 | let writer t = BE.write_uint32 t stream ; write_string t header_block in 103 | write_padded info length writer 104 | 105 | let write_ping_frame info payload = 106 | let header = 107 | {Types.flags = info.flags; stream_id = info.stream_id; length = 8} 108 | in 109 | let writer t = write_string t payload in 110 | (header, writer) 111 | 112 | let write_go_away_frame info stream_id error_code_id debug_data = 113 | let header = 114 | { Types.flags = info.flags 115 | ; stream_id = info.stream_id 116 | ; length = 8 + String.length debug_data } 117 | in 118 | let writer t = 119 | BE.write_uint32 t stream_id ; 120 | BE.write_uint32 t (Types.error_code_of_id error_code_id) ; 121 | write_string t debug_data 122 | in 123 | (header, writer) 124 | 125 | let write_window_frame info window_size = 126 | let header = 127 | {Types.flags = info.flags; stream_id = info.stream_id; length = 4} 128 | in 129 | (* TODO: How to handle reserved bit? *) 130 | let writer t = BE.write_uint32 t (Int32.of_int window_size) in 131 | (header, writer) 132 | 133 | let write_continuation_frame info header_block = 134 | let header = 135 | { Types.flags = info.flags 136 | ; stream_id = info.stream_id 137 | ; length = String.length header_block } 138 | in 139 | let writer t = write_string t header_block in 140 | (header, writer) 141 | 142 | (* TODO: This should probably be removed. We could handle unknown frames with its 143 | own error code. Also, a server/client implementing HTTP/2 spec might never 144 | actually need to serialize an unknown frame? *) 145 | let write_unknown_frame info payload = 146 | let writer t = write_string t payload in 147 | write_padded info (String.length payload) writer 148 | 149 | let get_writer info frame = 150 | match frame with 151 | | Types.DataFrame body -> write_data_frame info body 152 | | Types.HeadersFrame (priority, headers) -> 153 | write_headers_frame info priority headers 154 | | Types.PriorityFrame p -> write_priority_frame info p 155 | | Types.RSTStreamFrame e -> write_rst_stream_frame info e 156 | | Types.SettingsFrame settings -> write_settings_frame info settings 157 | | Types.PushPromiseFrame (stream, header_block) -> 158 | write_push_promise_frame info stream header_block 159 | | Types.PingFrame payload -> write_ping_frame info payload 160 | | Types.GoAwayFrame (stream_id, error_code_id, debug_data) -> 161 | write_go_away_frame info stream_id error_code_id debug_data 162 | | Types.WindowUpdateFrame window_size -> write_window_frame info window_size 163 | | Types.ContinuationFrame header_block -> 164 | write_continuation_frame info header_block 165 | | Types.UnknownFrame (_, payload) -> write_unknown_frame info payload 166 | 167 | let write_frame t info payload = 168 | let header, writer = get_writer info payload in 169 | let ft = Types.frame_payload_to_frame_id payload in 170 | write_frame_header t ft header ; 171 | writer t 172 | -------------------------------------------------------------------------------- /lib/serialize.mli: -------------------------------------------------------------------------------- 1 | type frame_info = 2 | { flags : Types.frame_flags 3 | ; stream_id : Types.stream_id 4 | ; padding : Types.padding option } 5 | 6 | val make_frame_info : set_flag:(int -> int) -> stream_id:int32 -> frame_info 7 | 8 | val write_frame : Faraday.t -> frame_info -> Types.frame_payload -> unit 9 | -------------------------------------------------------------------------------- /lib/types.ml: -------------------------------------------------------------------------------- 1 | open Base 2 | 3 | (* Utilities *) 4 | 5 | let test_bit_int32 x i = 6 | let open Int32 in 7 | x land (1l lsl i) <> 0l 8 | 9 | let test_bit x i = x land (1 lsl i) <> 0 10 | 11 | let set_bit x i = x lor (1 lsl i) 12 | 13 | let set_bit_int32 x i = 14 | let open Int32 in 15 | x lor (1l lsl i) 16 | 17 | let clear_bit x i = x land lnot (1 lsl i) 18 | 19 | let clear_bit_int32 x i = 20 | let open Int32 in 21 | x land lnot (1l lsl i) 22 | 23 | (* Constants *) 24 | 25 | let frame_header_length = 9 26 | 27 | let max_payload_length = Int.pow 2 14 28 | 29 | (* Stream identifer *) 30 | 31 | type stream_id = int32 32 | 33 | (* Errors *) 34 | 35 | type error_code = int32 36 | 37 | type error_code_id = 38 | | NoError 39 | | ProtocolError 40 | | InternalError 41 | | FlowControlError 42 | | SettingsTimeout 43 | | StreamClosed 44 | | FrameSizeError 45 | | RefusedStream 46 | | Cancel 47 | | CompressionError 48 | | ConnectError 49 | | EnhanceYourCalm 50 | | InadequateSecurity 51 | | HTTP11Required 52 | | UnknownErrorCode of int32 53 | 54 | let error_code_of_id = function 55 | | NoError -> 0x0l 56 | | ProtocolError -> 0x1l 57 | | InternalError -> 0x2l 58 | | FlowControlError -> 0x3l 59 | | SettingsTimeout -> 0x4l 60 | | StreamClosed -> 0x5l 61 | | FrameSizeError -> 0x6l 62 | | RefusedStream -> 0x7l 63 | | Cancel -> 0x8l 64 | | CompressionError -> 0x9l 65 | | ConnectError -> 0xal 66 | | EnhanceYourCalm -> 0xbl 67 | | InadequateSecurity -> 0xcl 68 | | HTTP11Required -> 0xdl 69 | | UnknownErrorCode x -> x 70 | 71 | let error_code_to_id = function 72 | | 0x0l -> NoError 73 | | 0x1l -> ProtocolError 74 | | 0x2l -> InternalError 75 | | 0x3l -> FlowControlError 76 | | 0x4l -> SettingsTimeout 77 | | 0x5l -> StreamClosed 78 | | 0x6l -> FrameSizeError 79 | | 0x7l -> RefusedStream 80 | | 0x8l -> Cancel 81 | | 0x9l -> CompressionError 82 | | 0xal -> ConnectError 83 | | 0xbl -> EnhanceYourCalm 84 | | 0xcl -> InadequateSecurity 85 | | 0xdl -> HTTP11Required 86 | | w -> UnknownErrorCode w 87 | 88 | type http2_error = 89 | | ConnectionError of error_code_id * string 90 | | StreamError of error_code_id * stream_id 91 | 92 | let error_code_id_of_http = function 93 | | ConnectionError (err, _) -> err 94 | | StreamError (err, _) -> err 95 | 96 | (** HTTP/2 Settings key *) 97 | 98 | type settings_key_id = 99 | | SettingsHeaderTableSize 100 | | SettingsEnablePush 101 | | SettingsMaxConcurrentStreams 102 | | SettingsInitialWindowSize 103 | | SettingsMaxFrameSize 104 | | SettingsMaxHeaderListSize 105 | 106 | type window_size = int 107 | 108 | type settings_value = int 109 | 110 | let settings_key_from_id = function 111 | | SettingsHeaderTableSize -> 0x1 112 | | SettingsEnablePush -> 0x2 113 | | SettingsMaxConcurrentStreams -> 0x3 114 | | SettingsInitialWindowSize -> 0x4 115 | | SettingsMaxFrameSize -> 0x5 116 | | SettingsMaxHeaderListSize -> 0x6 117 | 118 | let settings_key_to_id = function 119 | | 0x1 -> Some SettingsHeaderTableSize 120 | | 0x2 -> Some SettingsEnablePush 121 | | 0x3 -> Some SettingsMaxConcurrentStreams 122 | | 0x4 -> Some SettingsInitialWindowSize 123 | | 0x5 -> Some SettingsMaxFrameSize 124 | | 0x6 -> Some SettingsMaxHeaderListSize 125 | | _ -> None 126 | 127 | let default_initial_window_size = 65535 128 | 129 | let max_window_size = 2147483647 130 | 131 | let is_window_overflow w = test_bit w 31 132 | 133 | type settings_list = (settings_key_id * settings_value) list 134 | 135 | type settings = 136 | { header_table_size : int 137 | ; enable_push : bool 138 | ; max_concurrent_streams : int option 139 | ; initial_window_size : window_size 140 | ; max_frame_size : int 141 | ; max_header_list_size : int option } 142 | 143 | let default_settings = 144 | { header_table_size = 4096 145 | ; enable_push = true 146 | ; max_concurrent_streams = None 147 | ; initial_window_size = default_initial_window_size 148 | ; max_frame_size = 16384 149 | ; max_header_list_size = None } 150 | 151 | let check_settings_value = function 152 | | SettingsEnablePush, v -> 153 | if v <> 0 && v <> 1 then 154 | Some (ConnectionError (ProtocolError, "enable push must be 0 or 1")) 155 | else None 156 | | SettingsInitialWindowSize, v -> 157 | if v > 2147483647 then 158 | Some 159 | (ConnectionError 160 | (FlowControlError, "Window size must be less than or equal to 65535")) 161 | else None 162 | | SettingsMaxFrameSize, v -> 163 | if v < 16395 || v > 16777215 then 164 | Some 165 | (ConnectionError 166 | ( ProtocolError 167 | , "Max frame size must be in between 16384 and 16777215" )) 168 | else None 169 | | _ -> None 170 | 171 | let check_settings_list settings = 172 | let results = List.filter_map ~f:check_settings_value settings in 173 | match results with [] -> None | x :: _ -> Some x 174 | 175 | let update_settings settings kvs = 176 | let update settings = function 177 | | SettingsHeaderTableSize, v -> {settings with header_table_size = v} 178 | | SettingsEnablePush, v -> {settings with enable_push = v > 0} 179 | | SettingsMaxConcurrentStreams, v -> 180 | {settings with max_concurrent_streams = Some v} 181 | | SettingsInitialWindowSize, v -> {settings with initial_window_size = v} 182 | | SettingsMaxFrameSize, v -> {settings with max_frame_size = v} 183 | | SettingsMaxHeaderListSize, v -> 184 | {settings with max_header_list_size = Some v} 185 | in 186 | List.fold_left kvs ~init:settings ~f:update 187 | 188 | type weight = int 189 | 190 | type priority = {exclusive : bool; stream_dependency : stream_id; weight : weight} 191 | 192 | let default_priority = {exclusive = false; stream_dependency = 0l; weight = 16} 193 | 194 | let highest_priority = {exclusive = false; stream_dependency = 0l; weight = 256} 195 | 196 | type padding = string 197 | 198 | (* Raw HTTP/2 frame types *) 199 | 200 | type frame_type = int 201 | 202 | type frame_type_id = 203 | | FrameData 204 | | FrameHeaders 205 | | FramePriority 206 | | FrameRSTStream 207 | | FrameSettings 208 | | FramePushPromise 209 | | FramePing 210 | | FrameGoAway 211 | | FrameWindowUpdate 212 | | FrameContinuation 213 | | FrameUnknown of int 214 | 215 | let frame_type_of_id = function 216 | | FrameData -> 0x0 217 | | FrameHeaders -> 0x1 218 | | FramePriority -> 0x2 219 | | FrameRSTStream -> 0x3 220 | | FrameSettings -> 0x4 221 | | FramePushPromise -> 0x5 222 | | FramePing -> 0x6 223 | | FrameGoAway -> 0x7 224 | | FrameWindowUpdate -> 0x8 225 | | FrameContinuation -> 0x9 226 | | FrameUnknown x -> x 227 | 228 | let frame_type_to_id = function 229 | | 0x0 -> FrameData 230 | | 0x1 -> FrameHeaders 231 | | 0x2 -> FramePriority 232 | | 0x3 -> FrameRSTStream 233 | | 0x4 -> FrameSettings 234 | | 0x5 -> FramePushPromise 235 | | 0x6 -> FramePing 236 | | 0x7 -> FrameGoAway 237 | | 0x8 -> FrameWindowUpdate 238 | | 0x9 -> FrameContinuation 239 | | id -> FrameUnknown id 240 | 241 | let frame_type_id_to_name = function 242 | | FrameData -> "DATA" 243 | | FrameHeaders -> "HEADERS" 244 | | FramePriority -> "PRIORITY" 245 | | FrameRSTStream -> "RST_STREAM" 246 | | FrameSettings -> "SETTINGS" 247 | | FramePushPromise -> "PUSH_PROMISE" 248 | | FramePing -> "PING" 249 | | FrameGoAway -> "GOAWAY" 250 | | FrameWindowUpdate -> "WINDOW_UPDATE" 251 | | FrameContinuation -> "CONTINUATION" 252 | | FrameUnknown _ -> "UNKNOWN" 253 | 254 | (* Flags *) 255 | 256 | type frame_flags = int 257 | 258 | type flag_type = 259 | | FlagDataEndStream 260 | | FlagDataPadded 261 | | FlagHeadersEndStream 262 | | FlagHeadersEndHeaders 263 | | FlagHeadersPadded 264 | | FlagHeadersPriority 265 | | FlagSettingsAck 266 | | FlagPingAck 267 | | FlagContinuationEndHeaders 268 | | FlagPushPromiseEndHeaders 269 | | FlagPushPromisePadded 270 | 271 | let has_flag t flag = t land flag = flag 272 | 273 | let flag_type_to_id = function 274 | | FlagDataEndStream -> 0x1 275 | | FlagDataPadded -> 0x8 276 | | FlagHeadersEndStream -> 0x1 277 | | FlagHeadersEndHeaders -> 0x4 278 | | FlagHeadersPadded -> 0x8 279 | | FlagHeadersPriority -> 0x20 280 | | FlagSettingsAck -> 0x1 281 | | FlagPingAck -> 0x1 282 | | FlagContinuationEndHeaders -> 0x4 283 | | FlagPushPromiseEndHeaders -> 0x4 284 | | FlagPushPromisePadded -> 0x8 285 | 286 | let flag_type_to_name = function 287 | | FlagDataEndStream -> "END_STREAM" 288 | | FlagDataPadded -> "PADDED" 289 | | FlagHeadersEndStream -> "END_STREAM" 290 | | FlagHeadersEndHeaders -> "END_HEADERS" 291 | | FlagHeadersPadded -> "PADDED" 292 | | FlagHeadersPriority -> "PRIORITY" 293 | | FlagSettingsAck -> "ACK" 294 | | FlagPingAck -> "ACK" 295 | | FlagContinuationEndHeaders -> "END_HEADERS" 296 | | FlagPushPromiseEndHeaders -> "END_HEADERS" 297 | | FlagPushPromisePadded -> "PADDED" 298 | 299 | let flags_for_frame_type_id = function 300 | | FrameData -> [FlagDataEndStream; FlagDataPadded] 301 | | FrameHeaders -> 302 | [ FlagHeadersEndStream 303 | ; FlagHeadersEndHeaders 304 | ; FlagHeadersPadded 305 | ; FlagHeadersPriority ] 306 | | FrameSettings -> [FlagSettingsAck] 307 | | FramePing -> [FlagPingAck] 308 | | FrameContinuation -> [FlagContinuationEndHeaders] 309 | | FramePushPromise -> [FlagPushPromiseEndHeaders; FlagPushPromisePadded] 310 | | _ -> [] 311 | 312 | let default_flags = 0 313 | 314 | let test_end_stream x = test_bit x 0 315 | 316 | let test_ack x = test_bit x 0 317 | 318 | let test_end_header x = test_bit x 2 319 | 320 | let test_padded x = test_bit x 3 321 | 322 | let test_priority x = test_bit x 5 323 | 324 | let set_end_stream x = set_bit x 0 325 | 326 | let set_ack x = set_bit x 0 327 | 328 | let set_end_header x = set_bit x 2 329 | 330 | let set_padded x = set_bit x 3 331 | 332 | let set_priority x = set_bit x 5 333 | 334 | (* Streams *) 335 | 336 | let is_control id = Int32.(id = 0l) 337 | 338 | let is_request id = Int32.(id % 2l = 1l) 339 | 340 | let is_response id = 341 | let open Int32 in 342 | if id = 0l then false else id % 2l = 0l 343 | 344 | let test_exclusive id = test_bit_int32 id 31 345 | 346 | let set_exclusive id = set_bit_int32 id 31 347 | 348 | let clear_exclusive id = clear_bit_int32 id 31 349 | 350 | (* HTTP/2 frame types *) 351 | 352 | type data_frame = string 353 | 354 | type frame_header = {length : int; flags : frame_flags; stream_id : stream_id} 355 | 356 | type frame_payload = 357 | | DataFrame of data_frame 358 | | HeadersFrame of priority option * string 359 | | PriorityFrame of priority 360 | | RSTStreamFrame of error_code_id 361 | | SettingsFrame of settings_list 362 | | PushPromiseFrame of stream_id * string 363 | | PingFrame of string 364 | | GoAwayFrame of stream_id * error_code_id * string 365 | | WindowUpdateFrame of window_size 366 | | ContinuationFrame of string 367 | | UnknownFrame of frame_type * string 368 | 369 | let frame_payload_to_frame_id = function 370 | | DataFrame _ -> FrameData 371 | | HeadersFrame _ -> FrameHeaders 372 | | PriorityFrame _ -> FramePriority 373 | | RSTStreamFrame _ -> FrameRSTStream 374 | | SettingsFrame _ -> FrameSettings 375 | | PushPromiseFrame _ -> FramePushPromise 376 | | PingFrame _ -> FramePing 377 | | GoAwayFrame _ -> FrameGoAway 378 | | WindowUpdateFrame _ -> FrameWindowUpdate 379 | | ContinuationFrame _ -> FrameContinuation 380 | | UnknownFrame (x, _) -> FrameUnknown x 381 | 382 | type frame = {frame_header : frame_header; frame_payload : frame_payload} 383 | 384 | let is_padding_defined = function 385 | | DataFrame _ -> true 386 | | HeadersFrame _ -> true 387 | | PriorityFrame _ -> false 388 | | RSTStreamFrame _ -> false 389 | | SettingsFrame _ -> false 390 | | PushPromiseFrame _ -> true 391 | | PingFrame _ -> false 392 | | GoAwayFrame _ -> false 393 | | WindowUpdateFrame _ -> false 394 | | ContinuationFrame _ -> false 395 | | UnknownFrame _ -> false 396 | -------------------------------------------------------------------------------- /lib/types.mli: -------------------------------------------------------------------------------- 1 | val test_bit : int -> int -> bool 2 | 3 | val test_bit_int32 : int32 -> int -> bool 4 | 5 | val set_bit : int -> int -> int 6 | 7 | val clear_bit : int -> int -> int 8 | 9 | val frame_header_length : int 10 | 11 | val max_payload_length : int 12 | 13 | type stream_id = int32 14 | 15 | (** Error Codes. See: {{: http://http2.github.io/http2-spec/#ErrorCodes} 16 | http://http2.github.io/http2-spec/#ErrorCodes *) 17 | type error_code = int32 18 | 19 | type error_code_id = 20 | | NoError 21 | | ProtocolError 22 | | InternalError 23 | | FlowControlError 24 | | SettingsTimeout 25 | | StreamClosed 26 | | FrameSizeError 27 | | RefusedStream 28 | | Cancel 29 | | CompressionError 30 | | ConnectError 31 | | EnhanceYourCalm 32 | | InadequateSecurity 33 | | HTTP11Required 34 | | UnknownErrorCode of int32 35 | 36 | val error_code_of_id : error_code_id -> error_code 37 | 38 | val error_code_to_id : error_code -> error_code_id 39 | 40 | type http2_error = 41 | | ConnectionError of error_code_id * string 42 | | StreamError of error_code_id * stream_id 43 | 44 | val error_code_id_of_http : http2_error -> error_code_id 45 | 46 | (** HTTP/2 Settings Registry. See: {{: 47 | http://http2.github.io/http2-spec/#iana-settings} 48 | http://http2.github.io/http2-spec/#iana-settings} *) 49 | type settings_key_id = 50 | | SettingsHeaderTableSize 51 | | SettingsEnablePush 52 | | SettingsMaxConcurrentStreams 53 | | SettingsInitialWindowSize 54 | | SettingsMaxFrameSize 55 | | SettingsMaxHeaderListSize 56 | 57 | type window_size = int 58 | 59 | type settings_value = int 60 | 61 | val settings_key_from_id : settings_key_id -> int 62 | 63 | val settings_key_to_id : int -> settings_key_id option 64 | 65 | val default_initial_window_size : window_size 66 | 67 | val max_window_size : window_size 68 | 69 | val is_window_overflow : window_size -> bool 70 | 71 | type settings_list = (settings_key_id * settings_value) list 72 | 73 | type settings = 74 | { header_table_size : int 75 | ; enable_push : bool 76 | ; max_concurrent_streams : int option 77 | ; initial_window_size : window_size 78 | ; max_frame_size : int 79 | ; max_header_list_size : int option } 80 | 81 | val default_settings : settings 82 | 83 | val check_settings_value : settings_key_id * settings_value -> http2_error option 84 | 85 | val check_settings_list : settings_list -> http2_error option 86 | 87 | val update_settings : settings -> settings_list -> settings 88 | 89 | type weight = int 90 | 91 | type priority = {exclusive : bool; stream_dependency : stream_id; weight : weight} 92 | 93 | (** Default priority for all streams. See: {{: 94 | http://http2.github.io/http2-spec/#pri-default} 95 | http://http2.github.io/http2-spec/#pri-default} *) 96 | val default_priority : priority 97 | 98 | (** Maximum priority for any stream. See: 99 | {{:http://http2.github.io/http2-spec/#rfc.section.5.3.2} 100 | http://http2.github.io/http2-spec/#rfc.section.5.3.2} *) 101 | val highest_priority : priority 102 | 103 | (** The HTTP/2 frame type. See: {{: 104 | http://http2.github.io/http2-spec/#rfc.section.11.2} 105 | http://http2.github.io/http2-spec/#rfc.section.11.2} *) 106 | type frame_type = int 107 | 108 | type frame_type_id = 109 | | FrameData 110 | | FrameHeaders 111 | | FramePriority 112 | | FrameRSTStream 113 | | FrameSettings 114 | | FramePushPromise 115 | | FramePing 116 | | FrameGoAway 117 | | FrameWindowUpdate 118 | | FrameContinuation 119 | | FrameUnknown of int 120 | 121 | val frame_type_of_id : frame_type_id -> frame_type 122 | 123 | val frame_type_to_id : frame_type -> frame_type_id 124 | 125 | val frame_type_id_to_name : frame_type_id -> string 126 | 127 | type frame_flags = int 128 | 129 | type flag_type = 130 | | FlagDataEndStream 131 | | FlagDataPadded 132 | | FlagHeadersEndStream 133 | | FlagHeadersEndHeaders 134 | | FlagHeadersPadded 135 | | FlagHeadersPriority 136 | | FlagSettingsAck 137 | | FlagPingAck 138 | | FlagContinuationEndHeaders 139 | | FlagPushPromiseEndHeaders 140 | | FlagPushPromisePadded 141 | 142 | val has_flag : frame_flags -> frame_flags -> bool 143 | 144 | val flag_type_to_id : flag_type -> int 145 | 146 | val flag_type_to_name : flag_type -> string 147 | 148 | val flags_for_frame_type_id : frame_type_id -> flag_type list 149 | 150 | val default_flags : frame_flags 151 | 152 | val test_end_stream : frame_flags -> bool 153 | 154 | val test_end_header : frame_flags -> bool 155 | 156 | val test_ack : frame_flags -> bool 157 | 158 | val test_padded : frame_flags -> bool 159 | 160 | val test_priority : frame_flags -> bool 161 | 162 | val set_end_stream : frame_flags -> frame_flags 163 | 164 | val set_ack : frame_flags -> frame_flags 165 | 166 | val set_end_header : frame_flags -> frame_flags 167 | 168 | val set_padded : frame_flags -> frame_flags 169 | 170 | val set_priority : frame_flags -> frame_flags 171 | 172 | val is_control : stream_id -> bool 173 | 174 | val is_request : stream_id -> bool 175 | 176 | val is_response : stream_id -> bool 177 | 178 | val test_exclusive : stream_id -> bool 179 | 180 | val set_exclusive : stream_id -> stream_id 181 | 182 | val clear_exclusive : stream_id -> stream_id 183 | 184 | type padding = string 185 | 186 | (** FrameHeader is the 9 byte header of all HTTP/2 frames. See: 187 | {{:http://http2.github.io/http2-spec/#FrameHeader} 188 | http://http2.github.io/http2-spec/#FrameHeader}*) 189 | type frame_header = {length : int; flags : frame_flags; stream_id : stream_id} 190 | 191 | type data_frame = string 192 | 193 | type frame_payload = 194 | | DataFrame of data_frame 195 | | HeadersFrame of priority option * string 196 | | PriorityFrame of priority 197 | | RSTStreamFrame of error_code_id 198 | | SettingsFrame of settings_list 199 | | PushPromiseFrame of stream_id * string 200 | | PingFrame of string 201 | | GoAwayFrame of stream_id * error_code_id * string 202 | | WindowUpdateFrame of window_size 203 | | ContinuationFrame of string 204 | | UnknownFrame of frame_type * string 205 | 206 | val frame_payload_to_frame_id : frame_payload -> frame_type_id 207 | 208 | type frame = {frame_header : frame_header; frame_payload : frame_payload} 209 | 210 | val is_padding_defined : frame_payload -> bool 211 | -------------------------------------------------------------------------------- /test/README.md: -------------------------------------------------------------------------------- 1 | ## HTTP/2 frame tests 2 | 3 | The tests are adapter from the sample data present at: https://github.com/http2jp/http2-frame-test-case 4 | 5 | We use OCaml [hex](https://github.com/mirage/ocaml-hex) library to decode the payload from the test json files. 6 | -------------------------------------------------------------------------------- /test/continuation_frame_test.ml: -------------------------------------------------------------------------------- 1 | open H2 2 | 3 | let wire = "000000090000000032" 4 | 5 | let wire' = "00000D090000000032746869732069732064756D6D79" 6 | 7 | let serialize_continuation_frame () = 8 | let info = {Serialize.flags = 0; stream_id = 50l; padding = None} in 9 | let f = Faraday.create 0 in 10 | Serialize.write_frame f info (Types.ContinuationFrame "") ; 11 | let output = Faraday.serialize_to_string f in 12 | Alcotest.(check string) "serialize" wire (Util.hex_of_string output) 13 | 14 | let serialize_continuation_frame' () = 15 | let info = {Serialize.flags = 0; stream_id = 50l; padding = None} in 16 | let f = Faraday.create 13 in 17 | Serialize.write_frame f info (Types.ContinuationFrame "this is dummy") ; 18 | let output = Faraday.serialize_to_string f in 19 | Alcotest.(check string) "serialize" wire' (Util.hex_of_string output) 20 | 21 | let tests = 22 | [ ( "Serialize continuation frame without header block" 23 | , `Quick 24 | , serialize_continuation_frame ) 25 | ; ( "Serialize continuation frame with header block" 26 | , `Quick 27 | , serialize_continuation_frame' ) ] 28 | -------------------------------------------------------------------------------- /test/data_frame_test.ml: -------------------------------------------------------------------------------- 1 | open H2 2 | open Types 3 | 4 | (* Payload with padding *) 5 | let wire = "0000140008000000020648656C6C6F2C20776F726C6421486F77647921" 6 | 7 | let wire_no_padding = "0000080001000000017465737464617461" 8 | 9 | let extract_payload = function DataFrame x -> x | _ -> failwith "BAD PAYLOAD" 10 | 11 | let parse_data_frame_with_padding () = 12 | let parsed = Util.parse_success wire in 13 | Alcotest.(check int) "Header flags" 8 parsed.frame_header.flags ; 14 | Alcotest.(check int) "Length" 20 parsed.frame_header.length ; 15 | Alcotest.(check int32) "StreamId" 2l parsed.frame_header.stream_id ; 16 | Alcotest.(check bool) "Padded" true (test_padded parsed.frame_header.flags) ; 17 | Alcotest.(check string) 18 | "Payload" "Hello, world!" 19 | (extract_payload parsed.frame_payload) 20 | 21 | let parse_data_frame_no_padding () = 22 | let parsed = Util.parse_success wire_no_padding in 23 | Alcotest.(check int) "Length" 8 parsed.frame_header.length ; 24 | Alcotest.(check int) "Flags" 1 parsed.frame_header.flags ; 25 | Alcotest.(check int32) "StreamId" 1l parsed.frame_header.stream_id ; 26 | Alcotest.(check bool) "Padded" false (test_padded parsed.frame_header.flags) ; 27 | Alcotest.(check string) 28 | "Payload" "testdata" 29 | (extract_payload parsed.frame_payload) 30 | 31 | let serialize_data_frame_with_padding () = 32 | let info = {Serialize.flags = 8; stream_id = 2l; padding = Some "Howdy!"} in 33 | let f = Faraday.create 20 in 34 | Serialize.write_frame f info (DataFrame "Hello, world!") ; 35 | let serialized = Faraday.serialize_to_string f in 36 | Alcotest.(check string) 37 | "Serialized data frame" wire 38 | (Util.hex_of_string serialized) 39 | 40 | let serialize_data_frame_without_padding () = 41 | let info = {Serialize.flags = 1; stream_id = 1l; padding = None} in 42 | let f = Faraday.create 8 in 43 | Serialize.write_frame f info (DataFrame "testdata") ; 44 | let serialized = Faraday.serialize_to_string f in 45 | Alcotest.(check string) 46 | "Serialized data frame without padding" wire_no_padding 47 | (Util.hex_of_string serialized) 48 | 49 | let tests = 50 | [ ( "Can parse dataframe payload with padding" 51 | , `Quick 52 | , parse_data_frame_with_padding ) 53 | ; ( "Can parse dataframe payload without padding" 54 | , `Quick 55 | , parse_data_frame_no_padding ) 56 | ; ( "Can serialize data frame with padding" 57 | , `Quick 58 | , serialize_data_frame_with_padding ) 59 | ; ( "Can serialize data frame without padding" 60 | , `Quick 61 | , serialize_data_frame_without_padding ) ] 62 | -------------------------------------------------------------------------------- /test/dune: -------------------------------------------------------------------------------- 1 | (executables 2 | (names h2_test) 3 | (libraries base hex alcotest h2)) 4 | 5 | (alias 6 | (name runtest) 7 | (deps h2_test.exe) 8 | (action (run %{deps} -q --color=always))) 9 | -------------------------------------------------------------------------------- /test/go_away_frame_test.ml: -------------------------------------------------------------------------------- 1 | open H2 2 | 3 | let wire = "0000170700000000000000001E00000009687061636B2069732062726F6B656E" 4 | 5 | let serialize_go_away_frame () = 6 | let info = {Serialize.flags = 0; stream_id = 0l; padding = None} in 7 | let f = Faraday.create 23 in 8 | Serialize.write_frame f info 9 | (Types.GoAwayFrame (30l, Types.error_code_to_id 9l, "hpack is broken")) ; 10 | let output = Faraday.serialize_to_string f in 11 | Alcotest.(check string) "Serialize" wire (Util.hex_of_string output) 12 | 13 | let tests = [("Serialize go away frame", `Quick, serialize_go_away_frame)] 14 | -------------------------------------------------------------------------------- /test/h2_test.ml: -------------------------------------------------------------------------------- 1 | let frame_tests = 2 | [ ("Dataframe tests", Data_frame_test.tests) 3 | ; ("Headers frame tests", Headers_frame_test.tests) 4 | ; ("Priority frame tests", Priority_frame_test.tests) 5 | ; ("RSTStream frame tests", Rst_stream_frame_test.tests) 6 | ; ("Settings frame tests", Settings_frame_test.tests) 7 | ; ("Push promise frame tests", Push_promise_frame_test.tests) 8 | ; ("Ping frame test", Ping_frame_test.tests) 9 | ; ("GoAway frame test", Go_away_frame_test.tests) 10 | ; ("Window frame test", Window_frame_test.tests) 11 | ; ("Continuation frame test", Continuation_frame_test.tests) ] 12 | 13 | let priority_queue_tests = [("Priority queue tests", Priority_test.tests)] 14 | 15 | let () = 16 | Alcotest.run "H2 tests" (List.concat [frame_tests; priority_queue_tests]) 17 | -------------------------------------------------------------------------------- /test/headers_frame_test.ml: -------------------------------------------------------------------------------- 1 | open H2 2 | 3 | let wire_no_priority = "00000D010400000001746869732069732064756D6D79" 4 | 5 | let wire_priority = 6 | "000022012C000000030F8000001409746869732069732064756D6D79546869732069732070616464696E67" 7 | 8 | let serialize_headers_frame_no_priority () = 9 | let info = {Serialize.flags = 4; stream_id = 1l; padding = None} in 10 | let f = Faraday.create 13 in 11 | Serialize.write_frame f info (Types.HeadersFrame (None, "this is dummy")) ; 12 | let output = Faraday.serialize_to_string f in 13 | Alcotest.(check string) 14 | "Serialize" wire_no_priority (Util.hex_of_string output) 15 | 16 | let serialize_headers_frame_with_priority () = 17 | let info = 18 | {Serialize.flags = 44; stream_id = 3l; padding = Some "This is padding"} 19 | in 20 | let priority = {Types.exclusive = true; stream_dependency = 20l; weight = 9} in 21 | let f = Faraday.create 35 in 22 | Serialize.write_frame f info 23 | (Types.HeadersFrame (Some priority, "this is dummy")) ; 24 | let output = Faraday.serialize_to_string f in 25 | Alcotest.(check string) "Serialize" wire_priority (Util.hex_of_string output) 26 | 27 | let tests = 28 | [ ( "Serialize headers with no priority" 29 | , `Quick 30 | , serialize_headers_frame_no_priority ) 31 | ; ( "Serialize headers with priority" 32 | , `Quick 33 | , serialize_headers_frame_with_priority ) ] 34 | -------------------------------------------------------------------------------- /test/ping_frame_test.ml: -------------------------------------------------------------------------------- 1 | open H2 2 | 3 | let wire = "0000080600000000006465616462656566" 4 | 5 | let serialize_ping_frame () = 6 | let f = Faraday.create 8 in 7 | let info = {Serialize.flags = 0; stream_id = 0l; padding = None} in 8 | Serialize.write_frame f info (Types.PingFrame "deadbeef") ; 9 | let output = Faraday.serialize_to_string f in 10 | Alcotest.(check string) "serialize" wire (Util.hex_of_string output) 11 | 12 | let tests = [("Serialize ping frame", `Quick, serialize_ping_frame)] 13 | -------------------------------------------------------------------------------- /test/priority_frame_test.ml: -------------------------------------------------------------------------------- 1 | open H2 2 | open Types 3 | 4 | let extract_payload = function 5 | | PriorityFrame f -> f 6 | | _ -> failwith "INVALID PAYLOAD" 7 | 8 | let wire = "0000050200000000090000000B07" 9 | 10 | let wire2 = "0000050200000000018000000440" 11 | 12 | let parse_priority_frame () = 13 | let parsed = Util.parse_success wire in 14 | let payload = extract_payload parsed.frame_payload in 15 | let parsed2 = Util.parse_success wire2 in 16 | let payload2 = extract_payload parsed2.frame_payload in 17 | (* First frame *) 18 | Alcotest.(check int) "Flags" 0 parsed.frame_header.flags ; 19 | Alcotest.(check int32) "Stream id" 9l parsed.frame_header.stream_id ; 20 | Alcotest.(check int) "length" 5 parsed.frame_header.length ; 21 | Alcotest.(check int32) "Stream dependency" 11l payload.stream_dependency ; 22 | Alcotest.(check int) "Weight" 7 payload.weight ; 23 | Alcotest.(check bool) "Is exclusive" false payload.exclusive ; 24 | (* Second frame *) 25 | Alcotest.(check int) "Flags" 0 parsed2.frame_header.flags ; 26 | Alcotest.(check int32) "Stream id" 1l parsed2.frame_header.stream_id ; 27 | Alcotest.(check int) "Length" 5 parsed2.frame_header.length ; 28 | Alcotest.(check int32) "Stream dependency" 4l payload2.stream_dependency ; 29 | Alcotest.(check int) "Weight" 64 payload2.weight ; 30 | Alcotest.(check bool) "is exclusive" true payload2.exclusive 31 | 32 | let serialize_priority_frame_1 () = 33 | let info = {Serialize.flags = 0; padding = None; stream_id = 9l} in 34 | let f = Faraday.create 5 in 35 | let priority = {exclusive = false; stream_dependency = 11l; weight = 7} in 36 | Serialize.write_frame f info (PriorityFrame priority) ; 37 | let res = Faraday.serialize_to_string f in 38 | Alcotest.(check string) "Serialized" wire (Util.hex_of_string res) 39 | 40 | let serialize_priority_frame_2 () = 41 | let info = {Serialize.flags = 0; padding = None; stream_id = 1l} in 42 | let f = Faraday.create 5 in 43 | let priority = {exclusive = true; stream_dependency = 4l; weight = 64} in 44 | Serialize.write_frame f info (PriorityFrame priority) ; 45 | let res = Faraday.serialize_to_string f in 46 | Alcotest.(check string) "Serialized" wire2 (Util.hex_of_string res) 47 | 48 | let tests = 49 | [ ("Can parse priority frame", `Quick, parse_priority_frame) 50 | ; ( "Can serialize priority frame payload wire" 51 | , `Quick 52 | , serialize_priority_frame_1 ) 53 | ; ("Can serialize second priority frame", `Quick, serialize_priority_frame_2) 54 | ] 55 | -------------------------------------------------------------------------------- /test/priority_test.ml: -------------------------------------------------------------------------------- 1 | open H2 2 | 3 | module P = Pqueue.Make (struct 4 | type v = int32 5 | end) 6 | 7 | let new_p w = {Pqueue.Priority.weight = w; deficit = 0} 8 | 9 | let repeat queue num = 10 | let rec loop q n acc = 11 | if n = 0 then acc 12 | else 13 | match P.pop q with 14 | | None -> failwith "invalid queue" 15 | | Some (k, p, v, q') -> loop (P.add k p v q') (n - 1) (k :: acc) 16 | in 17 | loop queue num [] 18 | 19 | let test_priority_queue () = 20 | let q = P.empty in 21 | let q = P.add 1l (new_p 201) 1l q in 22 | let q = P.add 3l (new_p 101) 3l q in 23 | let q = P.add 5l (new_p 1) 5l q in 24 | Alcotest.(check bool) "Check if empty" false (P.is_empty q) ; 25 | let t = repeat q 1000 in 26 | let count_1 = List.filter (fun x -> x = 1l) t |> List.length in 27 | let count_3 = List.filter (fun x -> x = 3l) t |> List.length in 28 | let count_5 = List.filter (fun x -> x = 5l) t |> List.length in 29 | (* After multiple repetitions, the frequency of 1, 3 and 5 is proportional to 30 | their weight*) 31 | Alcotest.(check int) "Number of items with weight 1" 664 count_1 ; 32 | Alcotest.(check int) "Number of items with weight 3" 333 count_3 ; 33 | Alcotest.(check int) "Number of items with weight 5" 3 count_5 34 | 35 | let tests = [("Priority queue can add/pop items", `Quick, test_priority_queue)] 36 | -------------------------------------------------------------------------------- /test/push_promise_frame_test.ml: -------------------------------------------------------------------------------- 1 | open H2 2 | 3 | let wire = "000018050C0000000A060000000C746869732069732064756D6D79486F77647921" 4 | 5 | let wire' = "000011050c0000000a0000000c746869732069732064756d6d79" 6 | 7 | let extract_payload payload = 8 | let open Types in 9 | match payload with 10 | | PushPromiseFrame (s, m) -> (s, m) 11 | | _ -> failwith "INVALID FRAME" 12 | 13 | let parse_push_promise_frame () = 14 | let parsed = Util.parse_success wire in 15 | Alcotest.(check int) "Flags" 12 parsed.frame_header.flags ; 16 | Alcotest.(check int32) "Stream id" 10l parsed.frame_header.stream_id ; 17 | Alcotest.(check int) "Length" 24 parsed.frame_header.length ; 18 | let stream, message = extract_payload parsed.frame_payload in 19 | Alcotest.(check int32) "Stream id" 12l stream ; 20 | Alcotest.(check string) "message" "this is dummy" message 21 | 22 | let serialize_push_promise_frame_with_padding () = 23 | let info = {Serialize.flags = 12; stream_id = 10l; padding = Some "Howdy!"} in 24 | let f = Faraday.create 24 in 25 | Serialize.write_frame f info (Types.PushPromiseFrame (12l, "this is dummy")) ; 26 | let output = Faraday.serialize_to_string f in 27 | Alcotest.(check string) "Serialized" (Util.string_of_hex wire) output 28 | 29 | let serialize_push_promise_frame_without_padding () = 30 | let info = {Serialize.flags = 12; stream_id = 10l; padding = None} in 31 | let f = Faraday.create 24 in 32 | Serialize.write_frame f info (Types.PushPromiseFrame (12l, "this is dummy")) ; 33 | let output = Faraday.serialize_to_string f in 34 | Alcotest.(check string) "Serialized" (Util.string_of_hex wire') output 35 | 36 | let tests = 37 | [ ("Can parse push promise frame", `Quick, parse_push_promise_frame) 38 | ; ( "Can serialize push promise frame with padding" 39 | , `Quick 40 | , serialize_push_promise_frame_with_padding ) 41 | ; ( "Can serialize push promise frame without padding" 42 | , `Quick 43 | , serialize_push_promise_frame_without_padding ) ] 44 | -------------------------------------------------------------------------------- /test/rst_stream_frame_test.ml: -------------------------------------------------------------------------------- 1 | open H2 2 | open Types 3 | 4 | let wire = "00000403000000000500000008" 5 | 6 | let wire2 = "000004030000000001000001A4" 7 | 8 | let extract_payload = function 9 | | RSTStreamFrame e -> e 10 | | _ -> failwith "BAD PAYLOAD" 11 | 12 | let parse_rst_frame () = 13 | let parsed = Util.parse_success wire in 14 | let error = extract_payload parsed.frame_payload in 15 | Alcotest.(check int) "Length" 4 parsed.frame_header.length ; 16 | Alcotest.(check int) "flags" 0 parsed.frame_header.flags ; 17 | Alcotest.(check int32) "stream id" 5l parsed.frame_header.stream_id ; 18 | Alcotest.(check int32) "Error code" 8l (error_code_of_id error) 19 | 20 | let parse_rst_frame' () = 21 | let parsed = Util.parse_success wire2 in 22 | let error = extract_payload parsed.frame_payload in 23 | Alcotest.(check int) "Length" 4 parsed.frame_header.length ; 24 | Alcotest.(check int) "flags" 0 parsed.frame_header.flags ; 25 | Alcotest.(check int32) "stream id" 1l parsed.frame_header.stream_id ; 26 | Alcotest.(check int32) "Error code" 420l (error_code_of_id error) 27 | 28 | let serialize_rst_frame () = 29 | let f = Faraday.create 4 in 30 | let info = {Serialize.flags = 0; stream_id = 5l; padding = None} in 31 | let e = error_code_to_id 8l in 32 | Serialize.write_frame f info (RSTStreamFrame e) ; 33 | let res = Faraday.serialize_to_string f in 34 | Alcotest.(check string) "Serialized rst frame" wire (Util.hex_of_string res) 35 | 36 | let serialize_rst_frame' () = 37 | let f = Faraday.create 4 in 38 | let info = {Serialize.flags = 0; stream_id = 1l; padding = None} in 39 | let e = error_code_to_id 420l in 40 | Serialize.write_frame f info (RSTStreamFrame e) ; 41 | let res = Faraday.serialize_to_string f in 42 | Alcotest.(check string) "Serialized rst frame" wire2 (Util.hex_of_string res) 43 | 44 | let tests = 45 | [ ("Can parse rst stream frame", `Quick, parse_rst_frame) 46 | ; ("Second rst frame test", `Quick, parse_rst_frame') 47 | ; ("Serialize rst stream frame", `Quick, serialize_rst_frame) 48 | ; ("Serialize rst stream 2", `Quick, serialize_rst_frame') ] 49 | -------------------------------------------------------------------------------- /test/settings_frame_test.ml: -------------------------------------------------------------------------------- 1 | open H2 2 | 3 | let wire = "00000C040000000000000100002000000300001388" 4 | 5 | let serialize_settings () = 6 | let input = 7 | [ (Types.SettingsHeaderTableSize, 8192) 8 | ; (Types.SettingsMaxConcurrentStreams, 5000) ] 9 | in 10 | let info = {Serialize.flags = 0; stream_id = 0l; padding = None} in 11 | let f = Faraday.create 12 in 12 | Serialize.write_frame f info (Types.SettingsFrame input) ; 13 | let output = Faraday.serialize_to_string f in 14 | Alcotest.(check string) 15 | "Serialize settings frame" wire (Util.hex_of_string output) 16 | 17 | let tests = [("Can serialize settings frame", `Quick, serialize_settings)] 18 | -------------------------------------------------------------------------------- /test/util.ml: -------------------------------------------------------------------------------- 1 | open H2 2 | open Parse 3 | 4 | let parse_frame = 5 | let open Angstrom in 6 | parse_frame_header 7 | >>= fun (frame_type, frame_header) -> 8 | parse_frame_payload frame_type frame_header 9 | >>| fun frame_payload -> {Types.frame_header; frame_payload} 10 | 11 | let parse_success wire = 12 | let req_payload = Hex.to_string (`Hex wire) in 13 | match Angstrom.parse_string parse_frame req_payload with 14 | | Ok frame -> frame 15 | | _ -> failwith "ERROR" 16 | 17 | let string_of_hex s = Hex.to_string (`Hex s) 18 | 19 | let hex_of_string s = 20 | let (`Hex hex) = Hex.of_string s in 21 | String.uppercase_ascii hex 22 | -------------------------------------------------------------------------------- /test/window_frame_test.ml: -------------------------------------------------------------------------------- 1 | open H2 2 | 3 | let wire = "000004080000000032000003E8" 4 | 5 | let serialize_window_frame () = 6 | let info = {Serialize.flags = 0; stream_id = 50l; padding = None} in 7 | let f = Faraday.create 4 in 8 | Serialize.write_frame f info (Types.WindowUpdateFrame 1000) ; 9 | let output = Faraday.serialize_to_string f in 10 | Alcotest.(check string) "Serialize" wire (Util.hex_of_string output) 11 | 12 | let tests = [("Serialize window frame", `Quick, serialize_window_frame)] 13 | --------------------------------------------------------------------------------