Something went wrong. Try again.
An adversarial testing framework for OCaml HTTP/1.1 clients and servers
Something went wrong. Try again.
123456789101112131415161718192021222324252627282930313233343536373839404142434445464748495051525354555657585960616263646566676869707172737475767778798081828384858687888990919293949596979899100101102103104105106107108109110111112113114115116117118119120121122123124125126127128129130131132133134135136137138139140141142143144145146147148149open QCheck2module Spec = Httnope_spec
let result_or_fail = function | Ok value -> value | Error message -> Alcotest.fail message
let fragment_input = let open Gen in map4 (fun seed min_size extra bytes -> (seed, min_size, min_size + extra, bytes)) int (int_range 1 32) (int_range 0 32) string_small
let seeded_fragments_reassemble = Test.make ~name:"seeded fragments reassemble and stay bounded" ~count:1_000 fragment_input (fun (seed, min_size, max_size, bytes) -> let first = result_or_fail (Spec.Transport.seeded_fragments ~seed ~min_size ~max_size bytes) in let second = result_or_fail (Spec.Transport.seeded_fragments ~seed ~min_size ~max_size bytes) in let rec bounded = function | [] -> true | [ final ] -> String.length final > 0 && String.length final <= max_size | fragment :: rest -> String.length fragment >= min_size && String.length fragment <= max_size && bounded rest in String.equal bytes (String.concat "" first) && first = second && bounded first)
let drip_input = let open Gen in pair (int_range 0 1_000) (list_size (int_range 0 20) string_small)
let drip_alternates = Test.make ~name:"drip alternates writes and waits and never ends in a wait" ~count:500 drip_input (fun (delay_ms, fragments) -> let actions = result_or_fail (Spec.Transport.compile ~write:(fun bytes -> `Write bytes) ~write_fragments:(fun parts -> `Fragments parts) ~write_bytes:(fun bytes -> `Bytes bytes) ~wait_ms:(fun milliseconds -> `Wait milliseconds) (Spec.Transport.Drip { delay_ms; fragments })) in let rec alternating = function | [] | [ `Write _ ] -> true | `Write _ :: `Wait milliseconds :: rest -> milliseconds = delay_ms && alternating rest | _ -> false in alternating actions)
let nonempty head tail = { Spec.Nonempty.head; tail }
let rule_monotone = let input = Gen.(triple int (list_size (int_range 0 20) int) int) in Test.make ~name:"adding a rule alternative is monotone" ~count:1_000 input (fun (head, tail, added) -> let original = result_or_fail (Spec.Rule.make ~strength:() ~rationale:"property" ~alternatives:(nonempty head tail)) in let extended = result_or_fail (Spec.Rule.make ~strength:() ~rationale:"property" ~alternatives:(nonempty head (tail @ [ added ]))) in let observations = (head :: tail) @ [ added; head + 1 ] in List.for_all (fun observation -> (not (Spec.Rule.holds ~matches:( = ) original observation)) || Spec.Rule.holds ~matches:( = ) extended observation) observations)
let field_constraints = Test.make ~name:"field constraints agree with ordered lookup" ~count:500 Gen.(list_size (int_range 0 20) string_small) (fun values -> let fields = List.mapi (fun index value -> ((if index mod 2 = 0 then "X-Test" else "x-TEST"), value)) values in let exactly = Spec.Pattern.Field.Exactly ("x-test", values) in let present = Spec.Pattern.Field.Present "X-TEST" in let absent = Spec.Pattern.Field.Absent "x-test" in Spec.Pattern.Field.matches exactly fields && Spec.Fields.values "X-TEST" fields = values && Spec.Pattern.Field.matches absent fields = not (Spec.Pattern.Field.matches present fields))
let checker_determinism = Test.make ~name:"checkers are deterministic and ignore elapsed time" ~count:1 Gen.unit (fun () -> let client = List.hd Httnope.Corpus.all in let client_observation elapsed_ms : Httnope.Model.observation = { case_id = client.id; elapsed_ms; outcome = Observed_error "property" } in let profile = List.hd Httnope.Conformance.field_cases in let profile_observation elapsed_ms : Httnope.Conformance.observation = { case_id = profile.case.id; elapsed_ms; outcome = Observed_timeout None; } in let server = List.hd Httnope.Server_profile.cases in let server_observation elapsed_ms : Httnope.Server_profile.observation = { case_id = server.id; elapsed_ms; wire = Timeout; effects = List.map (fun token -> (token, None)) server.probe_tokens; probe_errors = []; } in Httnope.Model.check client (client_observation None) = Httnope.Model.check client (client_observation (Some 9_999.)) && Httnope.Conformance.check profile.case (profile_observation None) = Httnope.Conformance.check profile.case (profile_observation (Some 9_999.)) && Httnope.Server_profile.check server (server_observation 0.) = Httnope.Server_profile.check server (server_observation 9_999.))
let () = Alcotest.run "httnope kernel" [ ( "properties", List.map (QCheck_alcotest.to_alcotest ~speed_level:`Quick) [ seeded_fragments_reassemble; drip_alternates; rule_monotone; field_constraints; checker_determinism; ] ); ]