Make allow_extra_fields as default

CHANGES.md

@@ -5,9 +5,18 @@
   plain string constants.
 - PPX: Respect the `[@json.name "..."]` attribute in `of_json` error
   messages.
-- **[breaking]** PPX: Ignore extra JSON object fields by default in the native
+- PPX: Ignore extra JSON object fields by default in the native
   PPX, matching the Melange PPX. Add `[@json.disallow_extra_fields]` for
   records and inline records that should reject unknown keys.
+- PPX: `[@@deriving jsonschema]` now generates
+  `"additionalProperties": true` for records by default, matching the JSON
+  derivers which ignore unknown object keys. Add
+  `[@@jsonschema.disallow_extra_fields]` (and
+  `[@jsonschema.disallow_extra_fields]` on inline records in variants) to opt
+  back into strict objects (`"additionalProperties": false`).
+  `[@@jsonschema.allow_extra_fields]` is still accepted for backwards
+  compatibility but is now a no-op; combining it with `disallow_extra_fields`
+  is rejected.
 - Library: Add `Melange_json.unknown_variant_case`, a record type with
   fields `tag : string` and `payload : Melange_json.t list option`,
   meant to be referenced as the argument of a catch-all constructor (see
@@ -111,86 +120,104 @@
 ## Old versions changes (from bs-json)
 
 ### 5.0.4
-* Rewrote `Encode.list` to be stack-safe and much faster.
+
+- Rewrote `Encode.list` to be stack-safe and much faster.
 
 ### 5.0.2
-* Added `Json.Decode.id`
+
+- Added `Json.Decode.id`
 
 ### 5.0.1
-* Dual licensed as LGPL-3.0 and MPL-2.0. MPL is mostly equivalent to LGPL but
+
+- Dual licensed as LGPL-3.0 and MPL-2.0. MPL is mostly equivalent to LGPL but
   relaxes its restriction on linking, which works better with the JavaScript
   packaging and distribution model.
 
 ### 5.0.0
-* Removed deprecated `arrayOf` encoder
-* Renamed `dict` encoder to `jsonDict`
-* Added new `dict` encoder that takes an additional encoder argument used to
+
+- Removed deprecated `arrayOf` encoder
+- Renamed `dict` encoder to `jsonDict`
+- Added new `dict` encoder that takes an additional encoder argument used to
   encode the contained values, and so it's consistent with the respective `dict`
   decoder.
 
 ### 4.0.0
-* Bumped `bs-platform` peer dependency to 5.0.4 to stop the compiler's
+
+- Bumped `bs-platform` peer dependency to 5.0.4 to stop the compiler's
   complaining.
 
 ### 3.0.0
-* Replace usage of `Js.Date.toJSON` with `Js.Date.toJSONUsafe`, which is exactly
+
+- Replace usage of `Js.Date.toJSON` with `Js.Date.toJSONUsafe`, which is exactly
   the same, just to avoid deprecation warnings for end users (Thanks Bob!)
-* Requires `bs-platform` >= 4.0.2
+- Requires `bs-platform` >= 4.0.2
 
 ### 2.0.0
-* Removed `Json.Decode.boolean`, `Json.Encode.boolean`,
+
+- Removed `Json.Decode.boolean`, `Json.Encode.boolean`,
   `Json.Encode.booleanArray`
-* Requires `bs-platform` >= 3.0.0
+- Requires `bs-platform` >= 3.0.0
 
 ### 1.3.1
-* Reverted commits that broke backwards compatibility despite only affecting the
+
+- Reverted commits that broke backwards compatibility despite only affecting the
   implementation
 
 ### 1.3.0
-* Deprecated `Json.Decode.boolean`, `Json.Encode.boolean`,
+
+- Deprecated `Json.Decode.boolean`, `Json.Encode.boolean`,
   `Json.Encode.booleanArray`
-* Added `Json.Encode.boolArray`
+- Added `Json.Encode.boolArray`
 
 ### 1.2.0
-* Added `Json.Encode.char` and `Json.Decode.char`
+
+- Added `Json.Encode.char` and `Json.Decode.char`
 
 ### 1.1.0
-* Added "stack traces" to higher-order decoders, making it easier to find the
+
+- Added "stack traces" to higher-order decoders, making it easier to find the
   location of an error.
 
 ### 1.0.1
-* Moved repository from `reasonml-community/bs-json` to `glennsl/bs-json`
-* Renamed NPM package from `bs-json` to `@glennsl/bs-json`
+
+- Moved repository from `reasonml-community/bs-json` to `glennsl/bs-json`
+- Renamed NPM package from `bs-json` to `@glennsl/bs-json`
 
 ### 1.0.0
-* Replaced `Json.Encoder.array` with `Json.Encode.arrayOf` renamed to `array`.
+
+- Replaced `Json.Encoder.array` with `Json.Encode.arrayOf` renamed to `array`.
   Deprecated `arrayOf` alias.
-* Added `Json.parse`, `Json.parseOrRaise`, `Json.stringify`
-* Added `date` encoder and decoder
-* Added `tuple2`/`tuple3`/`tuple4` encoders and decoders
-* Fixed bug where js integers > 32-bit were rejected as integers by
+- Added `Json.parse`, `Json.parseOrRaise`, `Json.stringify`
+- Added `date` encoder and decoder
+- Added `tuple2`/`tuple3`/`tuple4` encoders and decoders
+- Fixed bug where js integers > 32-bit were rejected as integers by
   Json.Decode.int (#15)
 
 ### 0.2.4
-* Added `Json.Encode.bool`
-* Added `Json.Encode.pair`
-* Added `Json.Encode.withDefault`
-* Added `Json.Encode.nullable`
-* Added `Json.Encode.arrayOf`
-* Added `Json.Encode.jsonArray` as replacement for `Json.Encode.array`
-* Deprecated `Json.Encode.array`
+
+- Added `Json.Encode.bool`
+- Added `Json.Encode.pair`
+- Added `Json.Encode.withDefault`
+- Added `Json.Encode.nullable`
+- Added `Json.Encode.arrayOf`
+- Added `Json.Encode.jsonArray` as replacement for `Json.Encode.array`
+- Deprecated `Json.Encode.array`
 
 ### 0.2.3
-* Fixed embarrassing bug where an API was used that isn't available on IE
+
+- Fixed embarrassing bug where an API was used that isn't available on IE
   (honestly more embarrassed on behalf of IE though)
 
 ### 0.2.2
-* Added `Json.Decode.pair`
+
+- Added `Json.Decode.pair`
 
 ### 0.2.1
-* Added `Json.Encode.list`
+
+- Added `Json.Encode.list`
 
 ### 0.2.0
-* Breaking: Renamed `Json.Encode.object_` to `Json.Encode.dict`
-* Added `Json.Encode.object_` taking a list of properties instead of a
+
+- Breaking: Renamed `Json.Encode.object_` to `Json.Encode.dict`
+- Added `Json.Encode.object_` taking a list of properties instead of a
   Json.Dict.t as before

JSONSCHEMA.md

@@ -80,14 +80,14 @@ Such a type will be turned into a JSON schema like this:
         "street": { "type": "string" }
       },
       "required": [ "zip", "city", "street" ],
-      "additionalProperties": false
+      "additionalProperties": true
     },
     "email": { "type": "string" },
     "age": { "type": "integer" },
     "name": { "type": "string" }
   },
   "required": [ "address", "age", "name" ],
-  "additionalProperties": false
+  "additionalProperties": true
 }
 ```
 
@@ -368,7 +368,7 @@ type t = {
     },
   },
   "required": [ "name" ], 
-  "additionalProperties": false 
+  "additionalProperties": true 
 }
 ```
 
@@ -389,7 +389,7 @@ type t = {
     },
   },
   "required": [], 
-  "additionalProperties": false 
+  "additionalProperties": true 
 }
 ```
 #### Result
@@ -615,35 +615,42 @@ type t =
 
 #### Records
 
-Records are converted to `{ "type": "object", "properties": {...}, "required": [...], "additionalProperties": false }`.
+Records are converted to `{ "type": "object", "properties": {...}, "required": [...], "additionalProperties": true }`.
 
 The fields of type `option` are not included in the `required` list.
 
-By default, additionalProperties are not allowed in objects. To allow additionalProperties, use the `allow_extra_fields` attribute:
+By default, additional properties are allowed in objects, matching the JSON
+derivers which ignore unknown object keys. To reject unknown keys and generate
+a strict schema, use the `disallow_extra_fields` attribute:
 
 ```ocaml
 type company = {
   name : string;
   employees : int;
 }
 [@@deriving jsonschema]
-[@@jsonschema.allow_extra_fields]
+[@@jsonschema.disallow_extra_fields]
 ```
 
-This annotation will generate a schema with `"additionalProperties": true`, allowing for additional fields not defined in the record:
+This annotation will generate a schema with `"additionalProperties": false`,
+rejecting fields not defined in the record:
 
 ```json
 {
   "type": "object",
   "properties": {
     "name": { "type": "string" },
-    "age": { "type": "integer" }
+    "employees": { "type": "integer" }
   },
-  "required": [ "name", "age" ],
-  "additionalProperties": true
+  "required": [ "name", "employees" ],
+  "additionalProperties": false
 }
 ```
 
+`[@@jsonschema.allow_extra_fields]` is still accepted for backwards
+compatibility but is now a no-op (allowing extra fields is the default);
+combining it with `disallow_extra_fields` on the same type is an error.
+
 When the JSON object keys differ from the ocaml field names, users can specify the corresponding JSON key implicitly using `[@key "field"]`, for example:
 
 ```ocaml
@@ -656,16 +663,16 @@ type t = {
 
 #### Inline Records in Variants
 
-You can use the `[@jsonschema.allow_extra_fields]` attribute on a constructor with an inline record to allow additional fields in that record:
+Inline records in variants also allow additional fields by default. Use the `[@jsonschema.disallow_extra_fields]` attribute on a constructor with an inline record to reject unknown keys for that record:
 
 ```ocaml
-type inline_record_with_extra_fields =
-  | User of { name : string; email : string } [@jsonschema.allow_extra_fields]
+type inline_record_with_strict_fields =
+  | User of { name : string; email : string } [@jsonschema.disallow_extra_fields]
   | Guest of { ip : string }
 [@@deriving jsonschema]
 ```
 
-This will generate a schema that allows additional fields for the `User` variant's record but not for the `Guest` variant:
+This will generate a schema that rejects additional fields for the `User` variant's record but allows them for the `Guest` variant:
 
 ```json
 {
@@ -681,7 +688,7 @@ This will generate a schema that allows additional fields for the `User` variant
             "name": { "type": "string" }
           },
           "required": [ "email", "name" ],
-          "additionalProperties": true
+          "additionalProperties": false
         }
       ],
       "unevaluatedItems": false,
@@ -696,7 +703,7 @@ This will generate a schema that allows additional fields for the `User` variant
           "type": "object",
           "properties": { "ip": { "type": "string" } },
           "required": [ "ip" ],
-          "additionalProperties": false
+          "additionalProperties": true
         }
       ],
       "unevaluatedItems": false,
@@ -803,7 +810,7 @@ type tree =
                 "value": { "type": "integer" }
               },
               "required": [ "right", "left", "value" ],
-              "additionalProperties": false
+              "additionalProperties": true
             }
           ],
           "unevaluatedItems": false,
@@ -894,7 +901,7 @@ This generates `expr_jsonschema` containing all definitions in `$defs`:
                 "cond": { "$ref": "#/$defs/expr" }
               },
               "required": [ "then_", "cond" ],
-              "additionalProperties": false
+              "additionalProperties": true
             }
           ],
           "unevaluatedItems": false,
@@ -941,7 +948,7 @@ type t = {
     "name": { "description": "The user's full name", "type": "string" }
   },
   "required": [ "name" ],
-  "additionalProperties": false
+  "additionalProperties": true
 }
 ```
 
@@ -962,7 +969,7 @@ type t = {
     "name": { "description": "The user's full name", "type": "string" }
   },
   "required": [ "name" ],
-  "additionalProperties": false
+  "additionalProperties": true
 }
 ```
 
@@ -983,7 +990,7 @@ type t = {
     "name": { "format": "date-time", "type": "string" }
   },
   "required": [ "name" ],
-  "additionalProperties": false
+  "additionalProperties": true
 }
 ```
 
@@ -1004,7 +1011,7 @@ type t = {
     "score": { "maximum": 100, "type": "integer" }
   },
   "required": [ "score" ],
-  "additionalProperties": false
+  "additionalProperties": true
 }
 ```
 
@@ -1025,7 +1032,7 @@ type t = {
     "score": { "minimum": 0, "type": "integer" }
   },
   "required": [ "score" ],
-  "additionalProperties": false
+  "additionalProperties": true
 }
 ```
 
@@ -1062,7 +1069,7 @@ type t = {
     "status":   { "default": [ "Active" ],  "anyOf": [ ... ] }
   },
   "required": [],
-  "additionalProperties": false
+  "additionalProperties": true
 }
 ```
 
@@ -1087,7 +1094,7 @@ type t = {
     "created_at": { "format": "date-time", "description": "Creation timestamp", "type": "string" }
   },
   "required": [ "score", "created_at" ],
-  "additionalProperties": false
+  "additionalProperties": true
 }
 ```
 

ppx/jsonschema/attrs.ml

@@ -44,6 +44,18 @@ let jsonschema_cd_allow_extra_fields =
     Ast_pattern.(pstr nil)
     (fun () -> ())
 
+let jsonschema_td_disallow_extra_fields =
+  Attribute.declare "jsonschema.disallow_extra_fields"
+    Attribute.Context.type_declaration
+    Ast_pattern.(pstr nil)
+    (fun () -> ())
+
+let jsonschema_cd_disallow_extra_fields =
+  Attribute.declare "jsonschema.disallow_extra_fields"
+    Attribute.Context.constructor_declaration
+    Ast_pattern.(pstr nil)
+    (fun () -> ())
+
 let jsonschema_option =
   Attribute.declare_flag "jsonschema.option"
     Attribute.Context.label_declaration
@@ -175,6 +187,8 @@ let attributes =
     Attribute.T jsonschema_polymorphic_variant_name;
     Attribute.T jsonschema_td_allow_extra_fields;
     Attribute.T jsonschema_cd_allow_extra_fields;
+    Attribute.T jsonschema_td_disallow_extra_fields;
+    Attribute.T jsonschema_cd_disallow_extra_fields;
     Attribute.T jsonschema_option;
     Attribute.T jsonschema_ld_description;
     Attribute.T jsonschema_td_description;