Prepare contract 0.2.0

CHANGES.md

@@ -1,5 +1,13 @@
 # Changes
 
+## 0.2.0 - 2026-05-29
+
+- Add pure response validation for declared status codes and JSON response
+  bodies.
+- Add a helper for decoding validated response bodies.
+- Tighten response-validation tests for declared statuses and response body
+  errors.
+
 ## 0.1.0 - 2026-05-24
 
 Initial release of the pure OCaml contract core.
@@ -10,4 +18,4 @@ Initial release of the pure OCaml contract core.
 - Include a users API example and focused Alcotest coverage.
 
 Current scope is intentionally small. There are no HTTP adapters, typed clients,
-mock servers, OpenAPI import, or response validation yet.
+mock servers, or OpenAPI import yet.

README.md

@@ -4,14 +4,15 @@
 [![opam](https://badgen.net/opam/v/contract)](https://opam.ocaml.org/packages/contract/)
 [![license: MIT](https://img.shields.io/badge/license-MIT-blue.svg)](LICENSE)
 
-`contract` is an OCaml library for describing HTTP API contracts as typed values. The current code covers a small pure core: endpoint definitions, path matching, scalar and JSON decoding, request validation, and OpenAPI output.
+`contract` is an OCaml library for describing HTTP API contracts as typed values. The current code covers a small pure core: endpoint definitions, path matching, scalar and JSON decoding, request and response validation, and OpenAPI output.
 
 ## Current MVP
 
-This version is a thin vertical slice for REST-style JSON APIs. It has no HTTP server dependency. A request is just a value passed to the validator.
+The current source tree is a thin vertical slice for REST-style JSON APIs. It has no HTTP server dependency.
+A request is a value passed to the validator; a response is a status plus optional JSON body checked against the endpoint's declared responses.
 Path parameters are percent-decoded after route matching.
 
-Install:
+Released package:
 
 ```sh
 opam install contract
@@ -26,9 +27,9 @@ dune exec examples/users_api.exe
 Development:
 
 ```sh
-dune fmt
 dune build @all
 dune runtest
+dune fmt
 ```
 
 Current limitations:
@@ -37,4 +38,3 @@ Current limitations:
 - no typed client yet
 - no OpenAPI import yet
 - no mock server yet
-- no response validation yet

RELEASE.md

@@ -22,13 +22,13 @@ Check that the example prints OpenAPI JSON with:
 - `GET /users/{id}`
 - `POST /users`
 
-For 0.1.0:
+For 0.2.0:
 
 ```sh
-git tag -a v0.1.0 -m "Release 0.1.0"
-git push origin v0.1.0
-opam publish
+git tag -a 0.2.0 -m "Release 0.2.0"
+git push origin 0.2.0
+opam publish --tag 0.2.0 -v 0.2.0 .
 ```
 
 Use the tag created from the checked release commit. If `opam publish` cannot be
-used from this machine, open an opam-repository pull request for `packages/contract/contract.0.1.0/opam`.
+used from this machine, open an opam-repository pull request for `packages/contract/contract.0.2.0/opam`.

contract.opam

@@ -11,7 +11,7 @@ synopsis: "Typed HTTP API contracts for OCaml"
 description: """
 contract describes REST-style HTTP API contracts as typed OCaml values.
 The current package provides a pure core for endpoint definitions, parameter
-and JSON decoding, request validation, and OpenAPI 3.0.3 output.
+and JSON decoding, request and response validation, and OpenAPI 3.0.3 output.
 """
 depends: [
   "ocaml" {>= "5.0"}

dune-project

@@ -1,13 +1,13 @@
 (lang dune 3.11)
 
 (name contract)
-(version 0.1.0)
+(version 0.2.0)
 
 (package
  (name contract)
  (synopsis "Typed HTTP API contracts for OCaml")
  (description
-  "A pure core for typed HTTP API contracts, request validation, and OpenAPI output.")
+  "A pure core for typed HTTP API contracts, request and response validation, and OpenAPI output.")
  (license MIT)
  (depends
   (ocaml (>= 5.0))

examples/users_api.ml

@@ -70,7 +70,7 @@ let create_user =
 let api : Openapi.api =
   {
     title = "Users API";
-    version = "0.1.0";
+    version = "0.2.0";
     endpoints = [ get_user; create_user ];
   }
 

lib/contract.ml

@@ -5,5 +5,6 @@ module Json_codec = Json_codec
 module Path_template = Path_template
 module Endpoint = Endpoint
 module Request = Request
+module Response = Response
 module Validate = Validate
 module Openapi = Openapi

lib/contract.mli

@@ -7,5 +7,6 @@ module Json_codec = Json_codec
 module Path_template = Path_template
 module Endpoint = Endpoint
 module Request = Request
+module Response = Response
 module Validate = Validate
 module Openapi = Openapi

lib/endpoint.mli

@@ -61,8 +61,7 @@ val body : 'a Json_codec.t -> t -> t
 (** Declare a JSON request body. *)
 
 val response : status:int -> 'a Json_codec.t -> t -> t
-(** Declare a JSON response body for [status]. Response bodies are not validated
-    by the current core validator. *)
+(** Declare a JSON response body for [status]. *)
 
 val empty_response : status:int -> t -> t
 val method_to_string : method_ -> string

lib/error.ml

@@ -1,5 +1,6 @@
 type location =
   | Method
+  | Status
   | Route
   | Path_param of string
   | Query_param of string
@@ -17,6 +18,7 @@ let make ?expected ?got ~location message = { location; message; expected; got }
 
 let location_to_string = function
   | Method -> "method"
+  | Status -> "status"
   | Route -> "route"
   | Path_param name -> "path parameter " ^ name
   | Query_param name -> "query parameter " ^ name

lib/error.mli

@@ -2,6 +2,7 @@
 
 type location =
   | Method
+  | Status
   | Route
   | Path_param of string
   | Query_param of string

lib/request.mli

@@ -4,10 +4,11 @@ type t = {
   query : (string * string) list;
   body : Yojson.Safe.t option;
 }
-(** Pure HTTP-like request value used by the validator.
+(** Pure HTTP-like request value used by the request validator.
 
     Query values are already split into key/value pairs. The library does not
-    parse URLs or perform percent-decoding yet. *)
+    parse URLs; path template matching percent-decodes captured path parameters.
+*)
 
 val make :
   ?query:(string * string) list ->

lib/response.ml

@@ -0,0 +1,5 @@
+type t = { status : int; body : Yojson.Safe.t option }
+
+let make ?body ~status () = { status; body }
+let status response = response.status
+let body response = response.body

lib/response.mli

@@ -0,0 +1,7 @@
+(** Pure HTTP-like response value used by the response validator. *)
+
+type t = { status : int; body : Yojson.Safe.t option }
+
+val make : ?body:Yojson.Safe.t -> status:int -> unit -> t
+val status : t -> int
+val body : t -> Yojson.Safe.t option

lib/validate.ml

@@ -5,6 +5,16 @@ type validated = {
   body : Yojson.Safe.t option;
 }
 
+type validated_response = {
+  endpoint : Endpoint.t;
+  status : int;
+  body : Yojson.Safe.t option;
+}
+
+type expected_response_body =
+  | No_body
+  | Json_body : 'a Json_codec.t -> expected_response_body
+
 let retag location = function
   | Ok value -> Ok value
   | Error error -> Error { error with Error.location }
@@ -21,6 +31,14 @@ let path_param_missing name =
 
 let first_value name values = List.assoc_opt name values
 
+let decode_optional_json body codec =
+  match body with
+  | None -> Ok None
+  | Some json -> (
+      match codec.Json_codec.decode json with
+      | Ok value -> Ok (Some value)
+      | Error error -> Error error)
+
 let validate_param path_values query_values = function
   | Endpoint.Path_param (name, codec) -> (
       match first_value name path_values with
@@ -38,7 +56,7 @@ let validate_param path_values query_values = function
           | Ok _ -> None
           | Error error -> Some error))
 
-let validate_body endpoint_body request_body =
+let validate_request_body endpoint_body request_body =
   match (endpoint_body, request_body) with
   | None, _ -> None
   | Some _, None ->
@@ -66,7 +84,7 @@ let request endpoint request =
           |> List.filter_map (validate_param path_values request.query)
         in
         let body_errors =
-          match validate_body endpoint.body request.body with
+          match validate_request_body endpoint.body request.body with
           | None -> []
           | Some error -> [ error ]
         in
@@ -94,10 +112,55 @@ let query validated name codec =
       | Ok value -> Ok (Some value)
       | Error error -> Error error)
 
-let body validated codec =
-  match validated.body with
-  | None -> Ok None
-  | Some json -> (
+let body (validated : validated) codec =
+  decode_optional_json validated.body codec
+
+let status_to_string status = string_of_int status
+
+let expected_response_statuses endpoint =
+  List.map
+    (fun (Endpoint.Response (status, _)) -> status_to_string status)
+    endpoint.Endpoint.responses
+
+let expected_response_for_status endpoint status =
+  List.find_map
+    (fun (Endpoint.Response (declared_status, body)) ->
+      if declared_status = status then
+        Some (match body with None -> No_body | Some codec -> Json_body codec)
+      else None)
+    endpoint.Endpoint.responses
+
+let unexpected_response_status endpoint response =
+  let expected =
+    match expected_response_statuses endpoint with
+    | [] -> None
+    | statuses -> Some (String.concat ", " statuses)
+  in
+  Error.make ?expected
+    ~got:(status_to_string (Response.status response))
+    ~location:Error.Status "unexpected response status"
+
+let validate_response_body expected_body body =
+  match (expected_body, body) with
+  | No_body, None -> None
+  | No_body, Some _ ->
+      Some (Error.make ~location:Error.Body "unexpected response body")
+  | Json_body _, None ->
+      Some (Error.make ~location:Error.Body "missing response body")
+  | Json_body codec, Some json -> (
       match codec.Json_codec.decode json with
-      | Ok value -> Ok (Some value)
-      | Error error -> Error error)
+      | Ok _ -> None
+      | Error error -> Some error)
+
+let response endpoint (response : Response.t) =
+  let status = Response.status response in
+  let body = Response.body response in
+  match expected_response_for_status endpoint status with
+  | None -> Error [ unexpected_response_status endpoint response ]
+  | Some expected_body -> (
+      match validate_response_body expected_body body with
+      | None -> Ok { endpoint; status; body }
+      | Some error -> Error [ error ])
+
+let response_body (validated : validated_response) codec =
+  decode_optional_json validated.body codec

lib/validate.mli

@@ -8,6 +8,12 @@ type validated = {
   body : Yojson.Safe.t option;
 }
 
+type validated_response = {
+  endpoint : Endpoint.t;
+  status : int;
+  body : Yojson.Safe.t option;
+}
+
 val request : Endpoint.t -> Request.t -> (validated, Error.t list) result
 (** Validate method, route, declared parameters, and request body.
 
@@ -28,3 +34,19 @@ val query : validated -> string -> 'a Codec.t -> ('a option, Error.t) result
 val body : validated -> 'a Json_codec.t -> ('a option, Error.t) result
 (** Decode the JSON body from a validated request. Missing bodies return
     [Ok None]. *)
+
+val response :
+  Endpoint.t -> Response.t -> (validated_response, Error.t list) result
+(** Validate a pure response against the endpoint's declared responses.
+
+    The status must match a declared response. If that response declares a JSON
+    body, the body must be present and decode with its codec. If it declares an
+    empty response, a present body is rejected. Duplicate response status
+    declarations use the first matching declaration. *)
+
+val response_body :
+  validated_response -> 'a Json_codec.t -> ('a option, Error.t) result
+(** Decode the JSON body from a validated response. Missing bodies return
+    [Ok None]. The caller supplies the codec because successful response
+    validation preserves the response as JSON, not as an existential decoded
+    value. *)

test/dune

@@ -7,5 +7,6 @@
   test_endpoint
   test_json_codec
   test_validate
+  test_response
   test_openapi)
  (libraries alcotest contract yojson))

test/test_contract.ml

@@ -6,5 +6,6 @@ let () =
       Test_endpoint.tests;
       Test_json_codec.tests;
       Test_validate.tests;
+      Test_response.tests;
       Test_openapi.tests;
     ]