atproto libraries implementation in ocaml

lexicon: switch JSON from yojson to simdjsont

Changed files
+193 -127
.beads
lib
test
lexicon
+1 -1
.beads/issues.jsonl
··· 28 {"id":"atproto-52","title":"Implement Lexicon validation","description":"Implement Lexicon-based validation for AT Protocol data. This validates records and API payloads against schemas.","design":"## Module Structure\n\n```ocaml\n(* atproto-lexicon/lib/validator.ml *)\ntype validation_error = {\n path: string list;\n message: string;\n}\n\nval validate_record :\n registry:Registry.t -\u003e\n nsid:Nsid.t -\u003e\n value:Dag_cbor.value -\u003e\n (unit, validation_error list) result\n\nval validate_xrpc_params :\n registry:Registry.t -\u003e\n nsid:Nsid.t -\u003e\n params:(string * string) list -\u003e\n (unit, validation_error list) result\n\nval validate_xrpc_input :\n registry:Registry.t -\u003e\n nsid:Nsid.t -\u003e\n input:Jsont.json -\u003e\n (unit, validation_error list) result\n\nval validate_xrpc_output :\n registry:Registry.t -\u003e\n nsid:Nsid.t -\u003e\n output:Jsont.json -\u003e\n (unit, validation_error list) result\n```\n\n## Constraint Types\n\n- **String**: minLength, maxLength, minGraphemes, maxGraphemes, format, enum, const\n- **Integer**: minimum, maximum, enum, const\n- **Bytes**: minLength, maxLength\n- **Array**: minLength, maxLength, items type\n- **Blob**: maxSize, accept (MIME types)\n- **Union**: open/closed, refs\n\n## Format Validators (Parser-based, NO REGEX)\n\nEach format has a dedicated parser module:\n\n```ocaml\n(* atproto-lexicon/lib/formats.ml *)\n\nlet validate_did s = Did.of_string s |\u003e Result.is_ok\nlet validate_handle s = Handle.of_string s |\u003e Result.is_ok\nlet validate_nsid s = Nsid.of_string s |\u003e Result.is_ok\nlet validate_tid s = Tid.of_string s |\u003e Result.is_ok\nlet validate_cid s = Cid.of_string s |\u003e Result.is_ok\nlet validate_at_uri s = At_uri.of_string s |\u003e Result.is_ok\nlet validate_at_identifier s = \n Did.of_string s |\u003e Result.is_ok || Handle.of_string s |\u003e Result.is_ok\nlet validate_record_key s = Record_key.of_string s |\u003e Result.is_ok\n\nlet validate_datetime s =\n (* Hand-written RFC-3339 parser *)\n parse_datetime s |\u003e Result.is_ok\n\nlet validate_language s =\n (* BCP-47 language tag parser *)\n parse_language_tag s |\u003e Result.is_ok\n\nlet validate_uri s =\n (* RFC-3986 URI parser *)\n Uri.of_string s |\u003e Option.is_some\n```\n\n## Dependencies\n- atproto-lexicon (schema)\n- atproto-syntax (format validators)\n- jsont","acceptance_criteria":"- Validate records against schemas\n- Validate XRPC params, input, output\n- Proper error messages with paths\n- All constraint types supported\n- All record-data interop tests pass","status":"closed","priority":1,"issue_type":"feature","assignee":"claude","created_at":"2025-12-28T00:11:39.125440686+01:00","updated_at":"2025-12-28T10:25:46.671434007+01:00","closed_at":"2025-12-28T10:25:46.671434007+01:00","labels":["application","lexicon"],"dependencies":[{"issue_id":"atproto-52","depends_on_id":"atproto-50","type":"parent-child","created_at":"2025-12-28T00:12:05.375287273+01:00","created_by":"daemon"},{"issue_id":"atproto-52","depends_on_id":"atproto-51","type":"blocks","created_at":"2025-12-28T00:12:09.479940241+01:00","created_by":"daemon"}]} 29 {"id":"atproto-53","title":"Implement Lexicon code generation","description":"Implement code generation from Lexicon schemas to OCaml types and API bindings.","design":"## Module Structure\n\n```ocaml\n(* atproto-lexicon-gen/lib/codegen.ml *)\ntype config = {\n output_dir: string;\n module_prefix: string;\n}\n\nval generate_types : config:config -\u003e lexicon:Lexicon.t -\u003e unit\nval generate_client : config:config -\u003e lexicons:Lexicon.t list -\u003e unit\n```\n\n## Generated Code Example\n\nInput Lexicon:\n```json\n{\n \"id\": \"app.bsky.feed.post\",\n \"defs\": {\n \"main\": {\n \"type\": \"record\",\n \"record\": {\n \"type\": \"object\",\n \"properties\": {\n \"text\": { \"type\": \"string\", \"maxGraphemes\": 300 },\n \"createdAt\": { \"type\": \"string\", \"format\": \"datetime\" }\n }\n }\n }\n }\n}\n```\n\nGenerated OCaml:\n```ocaml\nmodule App_bsky_feed_post = struct\n type t = {\n text: string;\n created_at: Ptime.t;\n }\n \n let jsont : t Jsont.t =\n Jsont.obj \"app.bsky.feed.post\" @@ fun o -\u003e\n let text = Jsont.obj_mem o \"text\" Jsont.string in\n let created_at = Jsont.obj_mem o \"createdAt\" Datetime.jsont in\n Jsont.obj_finish o { text; created_at }\n \n val to_dag_cbor : t -\u003e Dag_cbor.value\n val of_dag_cbor : Dag_cbor.value -\u003e (t, error) result\nend\n```\n\n## CLI Tool\n\n```bash\natproto-lexicon-gen --input lexicons/ --output lib/generated/\n```\n\n## Dependencies\n- atproto-lexicon\n- jsont","acceptance_criteria":"- Generate OCaml types from Lexicon schemas\n- Generate encoders/decoders\n- Type-safe API bindings\n- CLI tool for code generation","status":"closed","priority":2,"issue_type":"feature","assignee":"claude","created_at":"2025-12-28T00:11:47.861552784+01:00","updated_at":"2025-12-28T11:28:03.226633204+01:00","closed_at":"2025-12-28T11:28:03.226633204+01:00","labels":["application","codegen"],"dependencies":[{"issue_id":"atproto-53","depends_on_id":"atproto-50","type":"parent-child","created_at":"2025-12-28T00:12:06.539440409+01:00","created_by":"daemon"},{"issue_id":"atproto-53","depends_on_id":"atproto-51","type":"blocks","created_at":"2025-12-28T00:12:11.189125052+01:00","created_by":"daemon"}]} 30 {"id":"atproto-54","title":"Implement high-level API client","description":"Implement high-level API client for AT Protocol / Bluesky. This provides a user-friendly interface for common operations.","design":"## Module Structure\n\n```ocaml\n(* atproto-api/lib/agent.ml *)\ntype t\n\nval create : pds:Uri.t -\u003e t\n\n(* Authentication *)\nval login : t -\u003e identifier:string -\u003e password:string -\u003e (t, error) result\nval login_oauth : t -\u003e tokens:Oauth.tokens -\u003e t\nval refresh_session : t -\u003e (t, error) result\n\n(* Profile *)\nval get_profile : t -\u003e actor:string -\u003e (profile, error) result\nval update_profile : t -\u003e display_name:string option -\u003e ... -\u003e (unit, error) result\n\n(* Posts *)\nval create_post : t -\u003e text:string -\u003e ?reply:reply_ref -\u003e ... -\u003e (post_ref, error) result\nval delete_post : t -\u003e uri:At_uri.t -\u003e (unit, error) result\n\n(* Social *)\nval like : t -\u003e uri:At_uri.t -\u003e cid:Cid.t -\u003e (like_ref, error) result\nval follow : t -\u003e did:Did.t -\u003e (follow_ref, error) result\nval unfollow : t -\u003e uri:At_uri.t -\u003e (unit, error) result\n\n(* Feed *)\nval get_timeline : t -\u003e ?cursor:string -\u003e ?limit:int -\u003e (timeline, error) result\nval get_author_feed : t -\u003e actor:string -\u003e ... -\u003e (feed, error) result\n\n(* atproto-api/lib/richtext.ml *)\ntype t\n\nval create : string -\u003e t\nval detect_facets : t -\u003e t (* auto-detect mentions, links *)\nval add_mention : t -\u003e start:int -\u003e end_:int -\u003e did:Did.t -\u003e t\nval add_link : t -\u003e start:int -\u003e end_:int -\u003e uri:Uri.t -\u003e t\nval to_post_record : t -\u003e Dag_cbor.value\n```\n\n## Jsont Codecs for API Types\n\n```ocaml\nlet profile_jsont : profile Jsont.t =\n Jsont.obj \"profile\" @@ fun o -\u003e\n let did = Jsont.obj_mem o \"did\" did_jsont in\n let handle = Jsont.obj_mem o \"handle\" handle_jsont in\n let display_name = Jsont.obj_mem o \"displayName\" ~opt:true Jsont.string in\n let description = Jsont.obj_mem o \"description\" ~opt:true Jsont.string in\n let avatar = Jsont.obj_mem o \"avatar\" ~opt:true Jsont.string in\n let followers_count = Jsont.obj_mem o \"followersCount\" ~opt:true Jsont.int in\n let follows_count = Jsont.obj_mem o \"followsCount\" ~opt:true Jsont.int in\n let posts_count = Jsont.obj_mem o \"postsCount\" ~opt:true Jsont.int in\n Jsont.obj_finish o { did; handle; display_name; description; avatar; \n followers_count; follows_count; posts_count }\n\nlet facet_jsont : facet Jsont.t =\n Jsont.obj \"facet\" @@ fun o -\u003e\n let index = Jsont.obj_mem o \"index\" byte_slice_jsont in\n let features = Jsont.obj_mem o \"features\" (Jsont.list facet_feature_jsont) in\n Jsont.obj_finish o { index; features }\n```\n\n## RichText Facets\n\n```json\n{\n \"text\": \"Hello @alice.bsky.social!\",\n \"facets\": [\n {\n \"index\": { \"byteStart\": 6, \"byteEnd\": 25 },\n \"features\": [\n { \"$type\": \"app.bsky.richtext.facet#mention\", \"did\": \"did:plc:...\" }\n ]\n }\n ]\n}\n```\n\n## Dependencies\n- atproto-xrpc\n- atproto-identity\n- atproto-repo\n- jsont","acceptance_criteria":"- Session management (login, logout, refresh)\n- Common operations (post, like, follow, etc.)\n- RichText handling (mentions, links, facets)\n- Timeline and feed fetching\n- Profile operations","status":"closed","priority":2,"issue_type":"feature","assignee":"claude","created_at":"2025-12-28T00:12:00.736309435+01:00","updated_at":"2025-12-28T11:47:47.071271001+01:00","closed_at":"2025-12-28T11:47:47.071271001+01:00","labels":["api","application"],"dependencies":[{"issue_id":"atproto-54","depends_on_id":"atproto-50","type":"parent-child","created_at":"2025-12-28T00:12:07.636789403+01:00","created_by":"daemon"},{"issue_id":"atproto-54","depends_on_id":"atproto-41","type":"blocks","created_at":"2025-12-28T00:12:12.376875324+01:00","created_by":"daemon"},{"issue_id":"atproto-54","depends_on_id":"atproto-33","type":"blocks","created_at":"2025-12-28T00:12:13.060557136+01:00","created_by":"daemon"},{"issue_id":"atproto-54","depends_on_id":"atproto-25","type":"blocks","created_at":"2025-12-28T00:12:13.934360048+01:00","created_by":"daemon"}]} 31 - {"id":"atproto-5l1","title":"Refactor JSON to simdjsont (replace yojson/jsont)","description":"","notes":"Next steps: migrate lib/crypto/jwt.ml off Yojson.Safe to Atproto_json/Simdjsont.Json (header_to_json/claims_to_json + *_of_json + create/decode_unverified); add atproto-json to lib/crypto/dune; run dune runtest test/crypto + full runtest; then continue with other Yojson hotspots (xrpc client/server, identity did_resolver, sync firehose, ipld blob).","status":"in_progress","priority":1,"issue_type":"feature","created_at":"2026-01-01T18:06:10.17746938+01:00","updated_at":"2026-01-01T19:32:47.437650903+01:00","dependencies":[{"issue_id":"atproto-5l1","depends_on_id":"atproto-dqs","type":"blocks","created_at":"2026-01-01T18:06:39.648046004+01:00","created_by":"daemon"}]} 32 {"id":"atproto-60","title":"Implement effects-based I/O abstraction","description":"Implement the effects-based I/O abstraction layer that makes all libraries runtime-agnostic.","design":"## Module Structure\n\n```ocaml\n(* atproto-effects/lib/effects.ml *)\n\n(* HTTP effects *)\ntype http_request = {\n method_: [ `GET | `POST | `PUT | `DELETE ];\n uri: Uri.t;\n headers: (string * string) list;\n body: string option;\n}\n\ntype http_response = {\n status: int;\n headers: (string * string) list;\n body: string;\n}\n\ntype _ Effect.t +=\n | Http_request : http_request -\u003e http_response Effect.t\n\n(* DNS effects *)\ntype _ Effect.t +=\n | Dns_txt : string -\u003e string list Effect.t\n | Dns_a : string -\u003e string list Effect.t\n\n(* Time effects *)\ntype _ Effect.t +=\n | Now : Ptime.t Effect.t\n | Sleep : float -\u003e unit Effect.t\n\n(* Random effects *)\ntype _ Effect.t +=\n | Random_bytes : int -\u003e bytes Effect.t\n\n(* atproto-effects-eio/lib/handler.ml *)\nval run : (unit -\u003e 'a) -\u003e 'a\n```\n\n## Handler Example (eio)\n\n```ocaml\nlet run f =\n Effect.Deep.match_ f ()\n {\n retc = Fun.id;\n exnc = raise;\n effc = fun (type a) (e : a Effect.t) -\u003e\n match e with\n | Http_request req -\u003e\n Some (fun (k : (a, _) continuation) -\u003e\n let resp = Eio_client.request req in\n continue k resp)\n | Dns_txt domain -\u003e\n Some (fun k -\u003e\n let records = Eio_dns.txt domain in\n continue k records)\n | _ -\u003e None\n }\n```\n\n## Dependencies\n- eio (for testing handler)","acceptance_criteria":"- Effect types for HTTP, DNS, time, random\n- eio-based handler for testing\n- Handler composition utilities\n- Performance benchmarks","status":"closed","priority":1,"issue_type":"feature","assignee":"claude","created_at":"2025-12-28T00:12:29.021401617+01:00","updated_at":"2025-12-28T11:57:08.264086142+01:00","closed_at":"2025-12-28T11:57:08.264086142+01:00","labels":["effects","infrastructure"],"dependencies":[{"issue_id":"atproto-60","depends_on_id":"atproto-1","type":"parent-child","created_at":"2025-12-28T00:12:55.467983208+01:00","created_by":"daemon"}]} 33 {"id":"atproto-61","title":"Set up interoperability test suite","description":"Set up and run the AT Protocol interoperability tests from bluesky-social/atproto-interop-tests.","design":"## Test Structure\n\n```\ntest/\n├── interop/\n│ ├── syntax_test.ml # Handle, DID, NSID, TID, etc.\n│ ├── crypto_test.ml # Signatures, did:key\n│ ├── data_model_test.ml # DAG-CBOR, CID\n│ ├── mst_test.ml # Key heights, tree structure\n│ ├── lexicon_test.ml # Schema and record validation\n│ └── firehose_test.ml # Commit proofs\n├── fixtures/ # Cloned from atproto-interop-tests\n└── dune\n```\n\n## Test Approach\n\n1. Clone test vectors from GitHub\n2. Parse JSON fixtures using jsont\n3. Parse text fixtures line by line\n4. Run each test case\n5. Compare output to expected values\n\n## Example Test\n\n```ocaml\nlet load_json_fixtures path =\n let json = Jsont.of_file path in\n Jsont.decode (Jsont.list fixture_jsont) json\n\nlet%test \"handle_syntax_valid\" =\n let fixtures = load_lines \"fixtures/syntax/handle_syntax_valid.txt\" in\n List.for_all (fun line -\u003e\n match Handle.of_string line with\n | Ok _ -\u003e true\n | Error _ -\u003e false\n ) fixtures\n\nlet%test \"handle_syntax_invalid\" =\n let fixtures = load_lines \"fixtures/syntax/handle_syntax_invalid.txt\" in\n List.for_all (fun line -\u003e\n match Handle.of_string line with\n | Ok _ -\u003e false\n | Error _ -\u003e true\n ) fixtures\n\nlet%test \"crypto_signature_fixtures\" =\n let fixtures = load_json_fixtures \"fixtures/crypto/signature-fixtures.json\" in\n List.for_all (fun fixture -\u003e\n let message = Base64.decode fixture.message_base64 in\n let signature = Base64.decode fixture.signature_base64 in\n let key = Did_key.of_string fixture.public_key_did in\n let result = Crypto.verify key message signature in\n result = fixture.valid_signature\n ) fixtures\n```\n\n## Dependencies\n- alcotest or ounit2\n- jsont","acceptance_criteria":"- All syntax interop tests pass\n- All crypto interop tests pass\n- All data-model interop tests pass\n- All MST interop tests pass\n- All lexicon interop tests pass\n- All firehose interop tests pass","status":"closed","priority":1,"issue_type":"task","created_at":"2025-12-28T00:12:40.553908313+01:00","updated_at":"2025-12-28T13:25:34.614867702+01:00","closed_at":"2025-12-28T13:25:34.614867702+01:00","labels":["conformance","testing"],"dependencies":[{"issue_id":"atproto-61","depends_on_id":"atproto-1","type":"parent-child","created_at":"2025-12-28T00:12:56.180809368+01:00","created_by":"daemon"}]} 34 {"id":"atproto-62","title":"Set up monorepo package structure","description":"Set up the monorepo structure for multiple opam packages within a single repository.","design":"## Repository Structure\n\n```\natproto/\n├── dune-project # Root with all packages\n├── packages/\n│ ├── atproto-syntax/\n│ │ ├── lib/\n│ │ │ ├── dune\n│ │ │ └── *.ml\n│ │ ├── test/\n│ │ │ ├── dune\n│ │ │ └── *_test.ml\n│ │ └── atproto-syntax.opam\n│ ├── atproto-crypto/\n│ ├── atproto-multibase/\n│ ├── atproto-ipld/\n│ ├── atproto-mst/\n│ ├── atproto-repo/\n│ ├── atproto-identity/\n│ ├── atproto-xrpc/\n│ ├── atproto-sync/\n│ ├── atproto-lexicon/\n│ ├── atproto-lexicon-gen/\n│ ├── atproto-api/\n│ └── atproto-effects/\n├── examples/\n│ ├── simple_client/\n│ └── firehose_consumer/\n└── interop-tests/\n```\n\n## dune-project\n\n```lisp\n(lang dune 3.20)\n(name atproto)\n(generate_opam_files true)\n\n(package\n (name atproto-syntax)\n (synopsis \"AT Protocol identifier syntax parsing\")\n (depends\n (ocaml (\u003e= 5.4))\n re\n ptime))\n\n(package\n (name atproto-crypto)\n ...)\n```\n\n## CI (.github/workflows/ci.yml)\n\n- OCaml 5.4 matrix\n- Build all packages\n- Run all tests\n- Run interop tests","acceptance_criteria":"- Multi-package dune-project structure\n- Separate opam files per package\n- CI pipeline for building and testing\n- Documentation generation setup","status":"closed","priority":1,"issue_type":"task","created_at":"2025-12-28T00:12:50.547102438+01:00","updated_at":"2025-12-28T11:57:18.856810633+01:00","closed_at":"2025-12-28T11:57:18.856810633+01:00","labels":["infrastructure","setup"],"dependencies":[{"issue_id":"atproto-62","depends_on_id":"atproto-1","type":"parent-child","created_at":"2025-12-28T00:12:57.015938611+01:00","created_by":"daemon"}]}
··· 28 {"id":"atproto-52","title":"Implement Lexicon validation","description":"Implement Lexicon-based validation for AT Protocol data. This validates records and API payloads against schemas.","design":"## Module Structure\n\n```ocaml\n(* atproto-lexicon/lib/validator.ml *)\ntype validation_error = {\n path: string list;\n message: string;\n}\n\nval validate_record :\n registry:Registry.t -\u003e\n nsid:Nsid.t -\u003e\n value:Dag_cbor.value -\u003e\n (unit, validation_error list) result\n\nval validate_xrpc_params :\n registry:Registry.t -\u003e\n nsid:Nsid.t -\u003e\n params:(string * string) list -\u003e\n (unit, validation_error list) result\n\nval validate_xrpc_input :\n registry:Registry.t -\u003e\n nsid:Nsid.t -\u003e\n input:Jsont.json -\u003e\n (unit, validation_error list) result\n\nval validate_xrpc_output :\n registry:Registry.t -\u003e\n nsid:Nsid.t -\u003e\n output:Jsont.json -\u003e\n (unit, validation_error list) result\n```\n\n## Constraint Types\n\n- **String**: minLength, maxLength, minGraphemes, maxGraphemes, format, enum, const\n- **Integer**: minimum, maximum, enum, const\n- **Bytes**: minLength, maxLength\n- **Array**: minLength, maxLength, items type\n- **Blob**: maxSize, accept (MIME types)\n- **Union**: open/closed, refs\n\n## Format Validators (Parser-based, NO REGEX)\n\nEach format has a dedicated parser module:\n\n```ocaml\n(* atproto-lexicon/lib/formats.ml *)\n\nlet validate_did s = Did.of_string s |\u003e Result.is_ok\nlet validate_handle s = Handle.of_string s |\u003e Result.is_ok\nlet validate_nsid s = Nsid.of_string s |\u003e Result.is_ok\nlet validate_tid s = Tid.of_string s |\u003e Result.is_ok\nlet validate_cid s = Cid.of_string s |\u003e Result.is_ok\nlet validate_at_uri s = At_uri.of_string s |\u003e Result.is_ok\nlet validate_at_identifier s = \n Did.of_string s |\u003e Result.is_ok || Handle.of_string s |\u003e Result.is_ok\nlet validate_record_key s = Record_key.of_string s |\u003e Result.is_ok\n\nlet validate_datetime s =\n (* Hand-written RFC-3339 parser *)\n parse_datetime s |\u003e Result.is_ok\n\nlet validate_language s =\n (* BCP-47 language tag parser *)\n parse_language_tag s |\u003e Result.is_ok\n\nlet validate_uri s =\n (* RFC-3986 URI parser *)\n Uri.of_string s |\u003e Option.is_some\n```\n\n## Dependencies\n- atproto-lexicon (schema)\n- atproto-syntax (format validators)\n- jsont","acceptance_criteria":"- Validate records against schemas\n- Validate XRPC params, input, output\n- Proper error messages with paths\n- All constraint types supported\n- All record-data interop tests pass","status":"closed","priority":1,"issue_type":"feature","assignee":"claude","created_at":"2025-12-28T00:11:39.125440686+01:00","updated_at":"2025-12-28T10:25:46.671434007+01:00","closed_at":"2025-12-28T10:25:46.671434007+01:00","labels":["application","lexicon"],"dependencies":[{"issue_id":"atproto-52","depends_on_id":"atproto-50","type":"parent-child","created_at":"2025-12-28T00:12:05.375287273+01:00","created_by":"daemon"},{"issue_id":"atproto-52","depends_on_id":"atproto-51","type":"blocks","created_at":"2025-12-28T00:12:09.479940241+01:00","created_by":"daemon"}]} 29 {"id":"atproto-53","title":"Implement Lexicon code generation","description":"Implement code generation from Lexicon schemas to OCaml types and API bindings.","design":"## Module Structure\n\n```ocaml\n(* atproto-lexicon-gen/lib/codegen.ml *)\ntype config = {\n output_dir: string;\n module_prefix: string;\n}\n\nval generate_types : config:config -\u003e lexicon:Lexicon.t -\u003e unit\nval generate_client : config:config -\u003e lexicons:Lexicon.t list -\u003e unit\n```\n\n## Generated Code Example\n\nInput Lexicon:\n```json\n{\n \"id\": \"app.bsky.feed.post\",\n \"defs\": {\n \"main\": {\n \"type\": \"record\",\n \"record\": {\n \"type\": \"object\",\n \"properties\": {\n \"text\": { \"type\": \"string\", \"maxGraphemes\": 300 },\n \"createdAt\": { \"type\": \"string\", \"format\": \"datetime\" }\n }\n }\n }\n }\n}\n```\n\nGenerated OCaml:\n```ocaml\nmodule App_bsky_feed_post = struct\n type t = {\n text: string;\n created_at: Ptime.t;\n }\n \n let jsont : t Jsont.t =\n Jsont.obj \"app.bsky.feed.post\" @@ fun o -\u003e\n let text = Jsont.obj_mem o \"text\" Jsont.string in\n let created_at = Jsont.obj_mem o \"createdAt\" Datetime.jsont in\n Jsont.obj_finish o { text; created_at }\n \n val to_dag_cbor : t -\u003e Dag_cbor.value\n val of_dag_cbor : Dag_cbor.value -\u003e (t, error) result\nend\n```\n\n## CLI Tool\n\n```bash\natproto-lexicon-gen --input lexicons/ --output lib/generated/\n```\n\n## Dependencies\n- atproto-lexicon\n- jsont","acceptance_criteria":"- Generate OCaml types from Lexicon schemas\n- Generate encoders/decoders\n- Type-safe API bindings\n- CLI tool for code generation","status":"closed","priority":2,"issue_type":"feature","assignee":"claude","created_at":"2025-12-28T00:11:47.861552784+01:00","updated_at":"2025-12-28T11:28:03.226633204+01:00","closed_at":"2025-12-28T11:28:03.226633204+01:00","labels":["application","codegen"],"dependencies":[{"issue_id":"atproto-53","depends_on_id":"atproto-50","type":"parent-child","created_at":"2025-12-28T00:12:06.539440409+01:00","created_by":"daemon"},{"issue_id":"atproto-53","depends_on_id":"atproto-51","type":"blocks","created_at":"2025-12-28T00:12:11.189125052+01:00","created_by":"daemon"}]} 30 {"id":"atproto-54","title":"Implement high-level API client","description":"Implement high-level API client for AT Protocol / Bluesky. This provides a user-friendly interface for common operations.","design":"## Module Structure\n\n```ocaml\n(* atproto-api/lib/agent.ml *)\ntype t\n\nval create : pds:Uri.t -\u003e t\n\n(* Authentication *)\nval login : t -\u003e identifier:string -\u003e password:string -\u003e (t, error) result\nval login_oauth : t -\u003e tokens:Oauth.tokens -\u003e t\nval refresh_session : t -\u003e (t, error) result\n\n(* Profile *)\nval get_profile : t -\u003e actor:string -\u003e (profile, error) result\nval update_profile : t -\u003e display_name:string option -\u003e ... -\u003e (unit, error) result\n\n(* Posts *)\nval create_post : t -\u003e text:string -\u003e ?reply:reply_ref -\u003e ... -\u003e (post_ref, error) result\nval delete_post : t -\u003e uri:At_uri.t -\u003e (unit, error) result\n\n(* Social *)\nval like : t -\u003e uri:At_uri.t -\u003e cid:Cid.t -\u003e (like_ref, error) result\nval follow : t -\u003e did:Did.t -\u003e (follow_ref, error) result\nval unfollow : t -\u003e uri:At_uri.t -\u003e (unit, error) result\n\n(* Feed *)\nval get_timeline : t -\u003e ?cursor:string -\u003e ?limit:int -\u003e (timeline, error) result\nval get_author_feed : t -\u003e actor:string -\u003e ... -\u003e (feed, error) result\n\n(* atproto-api/lib/richtext.ml *)\ntype t\n\nval create : string -\u003e t\nval detect_facets : t -\u003e t (* auto-detect mentions, links *)\nval add_mention : t -\u003e start:int -\u003e end_:int -\u003e did:Did.t -\u003e t\nval add_link : t -\u003e start:int -\u003e end_:int -\u003e uri:Uri.t -\u003e t\nval to_post_record : t -\u003e Dag_cbor.value\n```\n\n## Jsont Codecs for API Types\n\n```ocaml\nlet profile_jsont : profile Jsont.t =\n Jsont.obj \"profile\" @@ fun o -\u003e\n let did = Jsont.obj_mem o \"did\" did_jsont in\n let handle = Jsont.obj_mem o \"handle\" handle_jsont in\n let display_name = Jsont.obj_mem o \"displayName\" ~opt:true Jsont.string in\n let description = Jsont.obj_mem o \"description\" ~opt:true Jsont.string in\n let avatar = Jsont.obj_mem o \"avatar\" ~opt:true Jsont.string in\n let followers_count = Jsont.obj_mem o \"followersCount\" ~opt:true Jsont.int in\n let follows_count = Jsont.obj_mem o \"followsCount\" ~opt:true Jsont.int in\n let posts_count = Jsont.obj_mem o \"postsCount\" ~opt:true Jsont.int in\n Jsont.obj_finish o { did; handle; display_name; description; avatar; \n followers_count; follows_count; posts_count }\n\nlet facet_jsont : facet Jsont.t =\n Jsont.obj \"facet\" @@ fun o -\u003e\n let index = Jsont.obj_mem o \"index\" byte_slice_jsont in\n let features = Jsont.obj_mem o \"features\" (Jsont.list facet_feature_jsont) in\n Jsont.obj_finish o { index; features }\n```\n\n## RichText Facets\n\n```json\n{\n \"text\": \"Hello @alice.bsky.social!\",\n \"facets\": [\n {\n \"index\": { \"byteStart\": 6, \"byteEnd\": 25 },\n \"features\": [\n { \"$type\": \"app.bsky.richtext.facet#mention\", \"did\": \"did:plc:...\" }\n ]\n }\n ]\n}\n```\n\n## Dependencies\n- atproto-xrpc\n- atproto-identity\n- atproto-repo\n- jsont","acceptance_criteria":"- Session management (login, logout, refresh)\n- Common operations (post, like, follow, etc.)\n- RichText handling (mentions, links, facets)\n- Timeline and feed fetching\n- Profile operations","status":"closed","priority":2,"issue_type":"feature","assignee":"claude","created_at":"2025-12-28T00:12:00.736309435+01:00","updated_at":"2025-12-28T11:47:47.071271001+01:00","closed_at":"2025-12-28T11:47:47.071271001+01:00","labels":["api","application"],"dependencies":[{"issue_id":"atproto-54","depends_on_id":"atproto-50","type":"parent-child","created_at":"2025-12-28T00:12:07.636789403+01:00","created_by":"daemon"},{"issue_id":"atproto-54","depends_on_id":"atproto-41","type":"blocks","created_at":"2025-12-28T00:12:12.376875324+01:00","created_by":"daemon"},{"issue_id":"atproto-54","depends_on_id":"atproto-33","type":"blocks","created_at":"2025-12-28T00:12:13.060557136+01:00","created_by":"daemon"},{"issue_id":"atproto-54","depends_on_id":"atproto-25","type":"blocks","created_at":"2025-12-28T00:12:13.934360048+01:00","created_by":"daemon"}]} 31 + {"id":"atproto-5l1","title":"Refactor JSON to simdjsont (replace yojson/jsont)","description":"","notes":"Migrated atproto-lexicon off Yojson onto simdjsont.Json.t + Simdjsont.decode Codec.value. Updated lib/lexicon/{parser,validator,atproto_lexicon,codegen} and lib/lexicon/dune. Updated test/lexicon/test_lexicon.ml fixtures loader + patterns. Verified: dune runtest test/lexicon OK; dune build @install OK.","status":"in_progress","priority":1,"issue_type":"feature","created_at":"2026-01-01T18:06:10.17746938+01:00","updated_at":"2026-01-01T20:40:51.684953681+01:00","dependencies":[{"issue_id":"atproto-5l1","depends_on_id":"atproto-dqs","type":"blocks","created_at":"2026-01-01T18:06:39.648046004+01:00","created_by":"daemon"}]} 32 {"id":"atproto-60","title":"Implement effects-based I/O abstraction","description":"Implement the effects-based I/O abstraction layer that makes all libraries runtime-agnostic.","design":"## Module Structure\n\n```ocaml\n(* atproto-effects/lib/effects.ml *)\n\n(* HTTP effects *)\ntype http_request = {\n method_: [ `GET | `POST | `PUT | `DELETE ];\n uri: Uri.t;\n headers: (string * string) list;\n body: string option;\n}\n\ntype http_response = {\n status: int;\n headers: (string * string) list;\n body: string;\n}\n\ntype _ Effect.t +=\n | Http_request : http_request -\u003e http_response Effect.t\n\n(* DNS effects *)\ntype _ Effect.t +=\n | Dns_txt : string -\u003e string list Effect.t\n | Dns_a : string -\u003e string list Effect.t\n\n(* Time effects *)\ntype _ Effect.t +=\n | Now : Ptime.t Effect.t\n | Sleep : float -\u003e unit Effect.t\n\n(* Random effects *)\ntype _ Effect.t +=\n | Random_bytes : int -\u003e bytes Effect.t\n\n(* atproto-effects-eio/lib/handler.ml *)\nval run : (unit -\u003e 'a) -\u003e 'a\n```\n\n## Handler Example (eio)\n\n```ocaml\nlet run f =\n Effect.Deep.match_ f ()\n {\n retc = Fun.id;\n exnc = raise;\n effc = fun (type a) (e : a Effect.t) -\u003e\n match e with\n | Http_request req -\u003e\n Some (fun (k : (a, _) continuation) -\u003e\n let resp = Eio_client.request req in\n continue k resp)\n | Dns_txt domain -\u003e\n Some (fun k -\u003e\n let records = Eio_dns.txt domain in\n continue k records)\n | _ -\u003e None\n }\n```\n\n## Dependencies\n- eio (for testing handler)","acceptance_criteria":"- Effect types for HTTP, DNS, time, random\n- eio-based handler for testing\n- Handler composition utilities\n- Performance benchmarks","status":"closed","priority":1,"issue_type":"feature","assignee":"claude","created_at":"2025-12-28T00:12:29.021401617+01:00","updated_at":"2025-12-28T11:57:08.264086142+01:00","closed_at":"2025-12-28T11:57:08.264086142+01:00","labels":["effects","infrastructure"],"dependencies":[{"issue_id":"atproto-60","depends_on_id":"atproto-1","type":"parent-child","created_at":"2025-12-28T00:12:55.467983208+01:00","created_by":"daemon"}]} 33 {"id":"atproto-61","title":"Set up interoperability test suite","description":"Set up and run the AT Protocol interoperability tests from bluesky-social/atproto-interop-tests.","design":"## Test Structure\n\n```\ntest/\n├── interop/\n│ ├── syntax_test.ml # Handle, DID, NSID, TID, etc.\n│ ├── crypto_test.ml # Signatures, did:key\n│ ├── data_model_test.ml # DAG-CBOR, CID\n│ ├── mst_test.ml # Key heights, tree structure\n│ ├── lexicon_test.ml # Schema and record validation\n│ └── firehose_test.ml # Commit proofs\n├── fixtures/ # Cloned from atproto-interop-tests\n└── dune\n```\n\n## Test Approach\n\n1. Clone test vectors from GitHub\n2. Parse JSON fixtures using jsont\n3. Parse text fixtures line by line\n4. Run each test case\n5. Compare output to expected values\n\n## Example Test\n\n```ocaml\nlet load_json_fixtures path =\n let json = Jsont.of_file path in\n Jsont.decode (Jsont.list fixture_jsont) json\n\nlet%test \"handle_syntax_valid\" =\n let fixtures = load_lines \"fixtures/syntax/handle_syntax_valid.txt\" in\n List.for_all (fun line -\u003e\n match Handle.of_string line with\n | Ok _ -\u003e true\n | Error _ -\u003e false\n ) fixtures\n\nlet%test \"handle_syntax_invalid\" =\n let fixtures = load_lines \"fixtures/syntax/handle_syntax_invalid.txt\" in\n List.for_all (fun line -\u003e\n match Handle.of_string line with\n | Ok _ -\u003e false\n | Error _ -\u003e true\n ) fixtures\n\nlet%test \"crypto_signature_fixtures\" =\n let fixtures = load_json_fixtures \"fixtures/crypto/signature-fixtures.json\" in\n List.for_all (fun fixture -\u003e\n let message = Base64.decode fixture.message_base64 in\n let signature = Base64.decode fixture.signature_base64 in\n let key = Did_key.of_string fixture.public_key_did in\n let result = Crypto.verify key message signature in\n result = fixture.valid_signature\n ) fixtures\n```\n\n## Dependencies\n- alcotest or ounit2\n- jsont","acceptance_criteria":"- All syntax interop tests pass\n- All crypto interop tests pass\n- All data-model interop tests pass\n- All MST interop tests pass\n- All lexicon interop tests pass\n- All firehose interop tests pass","status":"closed","priority":1,"issue_type":"task","created_at":"2025-12-28T00:12:40.553908313+01:00","updated_at":"2025-12-28T13:25:34.614867702+01:00","closed_at":"2025-12-28T13:25:34.614867702+01:00","labels":["conformance","testing"],"dependencies":[{"issue_id":"atproto-61","depends_on_id":"atproto-1","type":"parent-child","created_at":"2025-12-28T00:12:56.180809368+01:00","created_by":"daemon"}]} 34 {"id":"atproto-62","title":"Set up monorepo package structure","description":"Set up the monorepo structure for multiple opam packages within a single repository.","design":"## Repository Structure\n\n```\natproto/\n├── dune-project # Root with all packages\n├── packages/\n│ ├── atproto-syntax/\n│ │ ├── lib/\n│ │ │ ├── dune\n│ │ │ └── *.ml\n│ │ ├── test/\n│ │ │ ├── dune\n│ │ │ └── *_test.ml\n│ │ └── atproto-syntax.opam\n│ ├── atproto-crypto/\n│ ├── atproto-multibase/\n│ ├── atproto-ipld/\n│ ├── atproto-mst/\n│ ├── atproto-repo/\n│ ├── atproto-identity/\n│ ├── atproto-xrpc/\n│ ├── atproto-sync/\n│ ├── atproto-lexicon/\n│ ├── atproto-lexicon-gen/\n│ ├── atproto-api/\n│ └── atproto-effects/\n├── examples/\n│ ├── simple_client/\n│ └── firehose_consumer/\n└── interop-tests/\n```\n\n## dune-project\n\n```lisp\n(lang dune 3.20)\n(name atproto)\n(generate_opam_files true)\n\n(package\n (name atproto-syntax)\n (synopsis \"AT Protocol identifier syntax parsing\")\n (depends\n (ocaml (\u003e= 5.4))\n re\n ptime))\n\n(package\n (name atproto-crypto)\n ...)\n```\n\n## CI (.github/workflows/ci.yml)\n\n- OCaml 5.4 matrix\n- Build all packages\n- Run all tests\n- Run interop tests","acceptance_criteria":"- Multi-package dune-project structure\n- Separate opam files per package\n- CI pipeline for building and testing\n- Documentation generation setup","status":"closed","priority":1,"issue_type":"task","created_at":"2025-12-28T00:12:50.547102438+01:00","updated_at":"2025-12-28T11:57:18.856810633+01:00","closed_at":"2025-12-28T11:57:18.856810633+01:00","labels":["infrastructure","setup"],"dependencies":[{"issue_id":"atproto-62","depends_on_id":"atproto-1","type":"parent-child","created_at":"2025-12-28T00:12:57.015938611+01:00","created_by":"daemon"}]}
+9 -5
lib/lexicon/atproto_lexicon.ml
··· 15 16 {[ 17 (* Parse a Lexicon schema *) 18 - let schema_json = Yojson.Safe.from_file "app.bsky.feed.post.json" in 19 let schema = Parser.parse_schema schema_json in 20 21 (* Validate a record against a schema *) 22 let record = 23 - `Assoc 24 [ 25 - ("$type", `String "app.bsky.feed.post"); 26 - ("text", `String "Hello!"); 27 - ("createdAt", `String "2024-01-01T00:00:00Z"); 28 ] 29 in 30 match Validator.validate_record schema record with
··· 15 16 {[ 17 (* Parse a Lexicon schema *) 18 + let schema_json = 19 + match Parser.of_file "app.bsky.feed.post.json" with 20 + | Ok lex -> lex 21 + | Error msg -> failwith (Parser.error_to_string msg) 22 + in 23 let schema = Parser.parse_schema schema_json in 24 25 (* Validate a record against a schema *) 26 let record = 27 + Simdjsont.Json.Object 28 [ 29 + ("$type", Simdjsont.Json.String "app.bsky.feed.post"); 30 + ("text", Simdjsont.Json.String "Hello!"); 31 + ("createdAt", Simdjsont.Json.String "2024-01-01T00:00:00Z"); 32 ] 33 in 34 match Validator.validate_record schema record with
+9 -9
lib/lexicon/codegen.ml
··· 5 6 Generated code includes: 7 - OCaml record types matching Lexicon schemas 8 - - JSON encoders/decoders using Yojson 9 - DAG-CBOR encoders/decoders 10 - Type-safe XRPC client methods *) 11 ··· 103 | Schema.Array arr -> 104 Printf.sprintf "%s list" (field_type_to_ocaml arr.items) 105 | Schema.Object _ -> 106 - "Yojson.Basic.t" (* Inline objects become raw JSON for now *) 107 | Schema.Ref r -> ref_to_ocaml r.ref_ 108 | Schema.Union u -> union_to_ocaml u 109 in ··· 117 | Schema.String _ -> "string" 118 | Schema.Bytes _ -> "string" 119 | Schema.Cid_link _ -> "Cid.t" 120 - | Schema.Unknown _ -> "Yojson.Basic.t" 121 122 and format_to_ocaml (fmt : Schema.string_format) : string = 123 match fmt with ··· 140 let name = String.sub ref_str 1 (String.length ref_str - 1) in 141 Printf.sprintf "%s.t" (String.capitalize_ascii (camel_to_snake name)) 142 else 143 - (* External ref like "app.bsky.actor.defs#basicView" -> Yojson.Basic.t for now *) 144 - "Yojson.Basic.t" 145 146 and union_to_ocaml (_u : Schema.union_type) : string = 147 (* Unions become raw JSON for now - full union support would require variant types *) 148 - "Yojson.Basic.t" 149 150 (** {1 Code Generation} *) 151 ··· 296 297 (* Generate output type if present *) 298 emit_blank e; 299 - emit e "type output = Yojson.Basic.t"; 300 301 dedent e; 302 emit e "end"; ··· 320 emit e (Printf.sprintf "let nsid = \"%s\"" lexicon.id); 321 322 emit_blank e; 323 - emit e "type input = Yojson.Basic.t"; 324 emit_blank e; 325 - emit e "type output = Yojson.Basic.t"; 326 327 dedent e; 328 emit e "end";
··· 5 6 Generated code includes: 7 - OCaml record types matching Lexicon schemas 8 + - JSON encoders/decoders using simdjsont 9 - DAG-CBOR encoders/decoders 10 - Type-safe XRPC client methods *) 11 ··· 103 | Schema.Array arr -> 104 Printf.sprintf "%s list" (field_type_to_ocaml arr.items) 105 | Schema.Object _ -> 106 + "Simdjsont.Json.t" (* Inline objects become raw JSON for now *) 107 | Schema.Ref r -> ref_to_ocaml r.ref_ 108 | Schema.Union u -> union_to_ocaml u 109 in ··· 117 | Schema.String _ -> "string" 118 | Schema.Bytes _ -> "string" 119 | Schema.Cid_link _ -> "Cid.t" 120 + | Schema.Unknown _ -> "Simdjsont.Json.t" 121 122 and format_to_ocaml (fmt : Schema.string_format) : string = 123 match fmt with ··· 140 let name = String.sub ref_str 1 (String.length ref_str - 1) in 141 Printf.sprintf "%s.t" (String.capitalize_ascii (camel_to_snake name)) 142 else 143 + (* External ref like "app.bsky.actor.defs#basicView" -> Simdjsont.Json.t for now *) 144 + "Simdjsont.Json.t" 145 146 and union_to_ocaml (_u : Schema.union_type) : string = 147 (* Unions become raw JSON for now - full union support would require variant types *) 148 + "Simdjsont.Json.t" 149 150 (** {1 Code Generation} *) 151 ··· 296 297 (* Generate output type if present *) 298 emit_blank e; 299 + emit e "type output = Simdjsont.Json.t"; 300 301 dedent e; 302 emit e "end"; ··· 320 emit e (Printf.sprintf "let nsid = \"%s\"" lexicon.id); 321 322 emit_blank e; 323 + emit e "type input = Simdjsont.Json.t"; 324 emit_blank e; 325 + emit e "type output = Simdjsont.Json.t"; 326 327 dedent e; 328 emit e "end";
+1 -1
lib/lexicon/dune
··· 1 (library 2 (name atproto_lexicon) 3 (public_name atproto-lexicon) 4 - (libraries atproto_syntax yojson) 5 (preprocess no_preprocessing))
··· 1 (library 2 (name atproto_lexicon) 3 (public_name atproto-lexicon) 4 + (libraries atproto_syntax simdjsont) 5 (preprocess no_preprocessing))
+55 -33
lib/lexicon/parser.ml
··· 17 18 let error_to_string e = Format.asprintf "%a" pp_error e 19 20 (** Helper to get string from JSON *) 21 let get_string key json = 22 match json with 23 - | `Assoc pairs -> ( 24 match List.assoc_opt key pairs with 25 - | Some (`String s) -> Some s 26 | _ -> None) 27 | _ -> None 28 ··· 32 (** Helper to get int from JSON *) 33 let get_int key json = 34 match json with 35 - | `Assoc pairs -> ( 36 - match List.assoc_opt key pairs with Some (`Int i) -> Some i | _ -> None) 37 | _ -> None 38 39 (** Helper to get bool from JSON *) 40 let get_bool key json = 41 match json with 42 - | `Assoc pairs -> ( 43 - match List.assoc_opt key pairs with Some (`Bool b) -> Some b | _ -> None) 44 | _ -> None 45 46 (** Helper to get list from JSON *) 47 let get_list key json = 48 match json with 49 - | `Assoc pairs -> ( 50 - match List.assoc_opt key pairs with Some (`List l) -> Some l | _ -> None) 51 | _ -> None 52 53 (** Helper to get assoc from JSON *) 54 let get_assoc key json = 55 match json with 56 - | `Assoc pairs -> ( 57 match List.assoc_opt key pairs with 58 - | Some (`Assoc a) -> Some a 59 | _ -> None) 60 | _ -> None 61 ··· 63 let get_string_list key json = 64 match get_list key json with 65 | Some l -> 66 - Some (List.filter_map (function `String s -> Some s | _ -> None) l) 67 | None -> None 68 69 (** Helper to get int list *) 70 let get_int_list key json = 71 match get_list key json with 72 - | Some l -> Some (List.filter_map (function `Int i -> Some i | _ -> None) l) 73 | None -> None 74 75 (** Parse a field type from JSON *) ··· 149 }) 150 | "array" -> ( 151 match json with 152 - | `Assoc pairs -> ( 153 match List.assoc_opt "items" pairs with 154 | Some items_json -> ( 155 match parse_field_type items_json with ··· 263 | Some encoding -> 264 let schema = 265 match json with 266 - | `Assoc pairs -> ( 267 match List.assoc_opt "schema" pairs with 268 | Some schema_json -> ( 269 match parse_field_type schema_json with ··· 292 (** Parse message from JSON *) 293 let parse_message json : (Schema.message, error) result = 294 match json with 295 - | `Assoc pairs -> ( 296 match List.assoc_opt "schema" pairs with 297 | Some schema_json -> ( 298 match parse_field_type schema_json with ··· 333 | None -> Schema.Any 334 in 335 match json with 336 - | `Assoc pairs -> ( 337 match List.assoc_opt "record" pairs with 338 | Some record_json -> ( 339 match parse_object_type record_json with ··· 352 | "query" -> 353 let parameters = 354 match json with 355 - | `Assoc pairs -> ( 356 match List.assoc_opt "parameters" pairs with 357 | Some p -> ( 358 match parse_params p with ··· 363 in 364 let output = 365 match json with 366 - | `Assoc pairs -> ( 367 match List.assoc_opt "output" pairs with 368 | Some o -> ( 369 match parse_body o with ··· 383 | "procedure" -> 384 let parameters = 385 match json with 386 - | `Assoc pairs -> ( 387 match List.assoc_opt "parameters" pairs with 388 | Some p -> ( 389 match parse_params p with ··· 394 in 395 let input = 396 match json with 397 - | `Assoc pairs -> ( 398 match List.assoc_opt "input" pairs with 399 | Some i -> ( 400 match parse_body i with ··· 405 in 406 let output = 407 match json with 408 - | `Assoc pairs -> ( 409 match List.assoc_opt "output" pairs with 410 | Some o -> ( 411 match parse_body o with ··· 426 | "subscription" -> 427 let parameters = 428 match json with 429 - | `Assoc pairs -> ( 430 match List.assoc_opt "parameters" pairs with 431 | Some p -> ( 432 match parse_params p with ··· 437 in 438 let message = 439 match json with 440 - | `Assoc pairs -> ( 441 match List.assoc_opt "message" pairs with 442 | Some m -> ( 443 match parse_message m with ··· 565 (** Parse a complete lexicon from JSON *) 566 let parse_lexicon json : (Schema.lexicon, error) result = 567 match json with 568 - | `Assoc _ -> ( 569 match get_int "lexicon" json with 570 | None -> Error (`Missing_field "lexicon") 571 | Some version -> ( ··· 593 594 (** Parse a lexicon from a JSON string *) 595 let of_string s : (Schema.lexicon, error) result = 596 - try 597 - let json = Yojson.Basic.from_string s in 598 - parse_lexicon json 599 - with Yojson.Json_error msg -> Error (`Parse_error msg) 600 601 (** Parse a lexicon from a file *) 602 let of_file path : (Schema.lexicon, error) result = 603 try 604 - let json = Yojson.Basic.from_file path in 605 - parse_lexicon json 606 - with 607 - | Yojson.Json_error msg -> Error (`Parse_error msg) 608 - | Sys_error msg -> Error (`Parse_error msg)
··· 17 18 let error_to_string e = Format.asprintf "%a" pp_error e 19 20 + type json = Simdjsont.Json.t 21 + 22 + let int_of_int64 (i : int64) : int option = 23 + if 24 + Int64.compare i (Int64.of_int max_int) > 0 25 + || Int64.compare i (Int64.of_int min_int) < 0 26 + then None 27 + else Some (Int64.to_int i) 28 + 29 (** Helper to get string from JSON *) 30 let get_string key json = 31 match json with 32 + | Simdjsont.Json.Object pairs -> ( 33 match List.assoc_opt key pairs with 34 + | Some (Simdjsont.Json.String s) -> Some s 35 | _ -> None) 36 | _ -> None 37 ··· 41 (** Helper to get int from JSON *) 42 let get_int key json = 43 match json with 44 + | Simdjsont.Json.Object pairs -> ( 45 + match List.assoc_opt key pairs with 46 + | Some (Simdjsont.Json.Int i) -> int_of_int64 i 47 + | _ -> None) 48 | _ -> None 49 50 (** Helper to get bool from JSON *) 51 let get_bool key json = 52 match json with 53 + | Simdjsont.Json.Object pairs -> ( 54 + match List.assoc_opt key pairs with 55 + | Some (Simdjsont.Json.Bool b) -> Some b 56 + | _ -> None) 57 | _ -> None 58 59 (** Helper to get list from JSON *) 60 let get_list key json = 61 match json with 62 + | Simdjsont.Json.Object pairs -> ( 63 + match List.assoc_opt key pairs with 64 + | Some (Simdjsont.Json.Array l) -> Some l 65 + | _ -> None) 66 | _ -> None 67 68 (** Helper to get assoc from JSON *) 69 let get_assoc key json = 70 match json with 71 + | Simdjsont.Json.Object pairs -> ( 72 match List.assoc_opt key pairs with 73 + | Some (Simdjsont.Json.Object a) -> Some a 74 | _ -> None) 75 | _ -> None 76 ··· 78 let get_string_list key json = 79 match get_list key json with 80 | Some l -> 81 + Some 82 + (List.filter_map 83 + (function Simdjsont.Json.String s -> Some s | _ -> None) 84 + l) 85 | None -> None 86 87 (** Helper to get int list *) 88 let get_int_list key json = 89 match get_list key json with 90 + | Some l -> 91 + Some 92 + (List.filter_map 93 + (function Simdjsont.Json.Int i -> int_of_int64 i | _ -> None) 94 + l) 95 | None -> None 96 97 (** Parse a field type from JSON *) ··· 171 }) 172 | "array" -> ( 173 match json with 174 + | Simdjsont.Json.Object pairs -> ( 175 match List.assoc_opt "items" pairs with 176 | Some items_json -> ( 177 match parse_field_type items_json with ··· 285 | Some encoding -> 286 let schema = 287 match json with 288 + | Simdjsont.Json.Object pairs -> ( 289 match List.assoc_opt "schema" pairs with 290 | Some schema_json -> ( 291 match parse_field_type schema_json with ··· 314 (** Parse message from JSON *) 315 let parse_message json : (Schema.message, error) result = 316 match json with 317 + | Simdjsont.Json.Object pairs -> ( 318 match List.assoc_opt "schema" pairs with 319 | Some schema_json -> ( 320 match parse_field_type schema_json with ··· 355 | None -> Schema.Any 356 in 357 match json with 358 + | Simdjsont.Json.Object pairs -> ( 359 match List.assoc_opt "record" pairs with 360 | Some record_json -> ( 361 match parse_object_type record_json with ··· 374 | "query" -> 375 let parameters = 376 match json with 377 + | Simdjsont.Json.Object pairs -> ( 378 match List.assoc_opt "parameters" pairs with 379 | Some p -> ( 380 match parse_params p with ··· 385 in 386 let output = 387 match json with 388 + | Simdjsont.Json.Object pairs -> ( 389 match List.assoc_opt "output" pairs with 390 | Some o -> ( 391 match parse_body o with ··· 405 | "procedure" -> 406 let parameters = 407 match json with 408 + | Simdjsont.Json.Object pairs -> ( 409 match List.assoc_opt "parameters" pairs with 410 | Some p -> ( 411 match parse_params p with ··· 416 in 417 let input = 418 match json with 419 + | Simdjsont.Json.Object pairs -> ( 420 match List.assoc_opt "input" pairs with 421 | Some i -> ( 422 match parse_body i with ··· 427 in 428 let output = 429 match json with 430 + | Simdjsont.Json.Object pairs -> ( 431 match List.assoc_opt "output" pairs with 432 | Some o -> ( 433 match parse_body o with ··· 448 | "subscription" -> 449 let parameters = 450 match json with 451 + | Simdjsont.Json.Object pairs -> ( 452 match List.assoc_opt "parameters" pairs with 453 | Some p -> ( 454 match parse_params p with ··· 459 in 460 let message = 461 match json with 462 + | Simdjsont.Json.Object pairs -> ( 463 match List.assoc_opt "message" pairs with 464 | Some m -> ( 465 match parse_message m with ··· 587 (** Parse a complete lexicon from JSON *) 588 let parse_lexicon json : (Schema.lexicon, error) result = 589 match json with 590 + | Simdjsont.Json.Object _ -> ( 591 match get_int "lexicon" json with 592 | None -> Error (`Missing_field "lexicon") 593 | Some version -> ( ··· 615 616 (** Parse a lexicon from a JSON string *) 617 let of_string s : (Schema.lexicon, error) result = 618 + match Simdjsont.decode Simdjsont.Codec.value s with 619 + | Ok json -> parse_lexicon json 620 + | Error msg -> Error (`Parse_error msg) 621 622 (** Parse a lexicon from a file *) 623 let of_file path : (Schema.lexicon, error) result = 624 try 625 + let ic = open_in path in 626 + let len = in_channel_length ic in 627 + let s = really_input_string ic len in 628 + close_in ic; 629 + of_string s 630 + with Sys_error msg -> Error (`Parse_error msg)
+84 -51
lib/lexicon/validator.ml
··· 202 203 (* === JSON value helpers === *) 204 205 - type json = Yojson.Basic.t 206 207 let get_string key = function 208 - | `Assoc pairs -> ( 209 match List.assoc_opt key pairs with 210 - | Some (`String s) -> Some s 211 | _ -> None) 212 | _ -> None 213 214 let get_int key = function 215 - | `Assoc pairs -> ( 216 - match List.assoc_opt key pairs with Some (`Int i) -> Some i | _ -> None) 217 | _ -> None 218 219 let get_bool key = function 220 - | `Assoc pairs -> ( 221 - match List.assoc_opt key pairs with Some (`Bool b) -> Some b | _ -> None) 222 | _ -> None 223 224 - let is_null = function `Null -> true | _ -> false 225 226 (* === Field validators === *) 227 228 (** Validate a boolean value *) 229 let validate_boolean ~path json = 230 - match json with `Bool _ -> [] | _ -> [ error ~path "expected boolean" ] 231 232 (** Validate an integer value with constraints *) 233 let validate_integer ~path ?minimum ?maximum ?enum ?const json = 234 match json with 235 - | `Int i -> 236 - let errs = ref [] in 237 - (match const with 238 - | Some c when i <> c -> 239 - errs := error ~path (Printf.sprintf "must be %d" c) :: !errs 240 - | _ -> ()); 241 - (match enum with 242 - | Some values when not (List.mem i values) -> 243 - errs := error ~path "value not in enum" :: !errs 244 - | _ -> ()); 245 - (match minimum with 246 - | Some min when i < min -> 247 - errs := error ~path (Printf.sprintf "must be >= %d" min) :: !errs 248 - | _ -> ()); 249 - (match maximum with 250 - | Some max when i > max -> 251 - errs := error ~path (Printf.sprintf "must be <= %d" max) :: !errs 252 - | _ -> ()); 253 - !errs 254 | _ -> [ error ~path "expected integer" ] 255 256 (** Validate a string value with constraints *) 257 let validate_string ~path ?format ?min_length ?max_length ?min_graphemes 258 ?max_graphemes ?enum ?const ?known_values:_ json = 259 match json with 260 - | `String s -> 261 let errs = ref [] in 262 (match const with 263 | Some c when s <> c -> ··· 301 (** Validate a bytes value (expects $bytes object) *) 302 let validate_bytes ~path ?min_length ?max_length json = 303 match json with 304 - | `Assoc pairs -> ( 305 match List.assoc_opt "$bytes" pairs with 306 - | Some (`String b64) -> 307 (* Decode base64 to get actual length *) 308 let len = String.length b64 * 3 / 4 in 309 (* approximate *) ··· 327 (** Validate a CID link (expects $link object) *) 328 let validate_cid_link ~path json = 329 match json with 330 - | `Assoc pairs -> ( 331 match List.assoc_opt "$link" pairs with 332 - | Some (`String _cid) -> [] 333 | _ -> [ error ~path "expected $link object" ]) 334 | _ -> [ error ~path "expected $link object" ] 335 336 (** Validate a blob value *) 337 let validate_blob ~path ?max_size ?accept json = 338 match json with 339 - | `Assoc pairs -> ( 340 match List.assoc_opt "$type" pairs with 341 - | Some (`String "blob") -> 342 let errs = ref [] in 343 (* Check mimeType *) 344 (match List.assoc_opt "mimeType" pairs with 345 - | Some (`String mime) -> ( 346 match accept with 347 | Some patterns -> 348 let matches = ··· 365 | None -> errs := error ~path "missing mimeType" :: !errs); 366 (* Check size *) 367 (match List.assoc_opt "size" pairs with 368 - | Some (`Int size) -> ( 369 - match max_size with 370 - | Some max when size > max -> 371 - errs := 372 - error ~path (Printf.sprintf "blob size must be <= %d" max) 373 - :: !errs 374 - | _ -> ()) 375 | Some _ -> errs := error ~path "size must be integer" :: !errs 376 | None -> errs := error ~path "missing size" :: !errs); 377 (* Check ref *) ··· 393 This is part of the data model restrictions. *) 394 let validate_unknown ~path json = 395 match json with 396 - | `Bool _ -> [ error ~path "unknown type cannot contain boolean" ] 397 - | `Assoc pairs -> ( 398 (* Check for $bytes - not allowed in unknown *) 399 match List.assoc_opt "$bytes" pairs with 400 | Some _ -> [ error ~path "unknown type cannot contain bytes ($bytes)" ] 401 | None -> ( 402 (* Check for blob ($type: "blob") - not allowed in unknown *) 403 match List.assoc_opt "$type" pairs with 404 - | Some (`String "blob") -> 405 [ error ~path "unknown type cannot contain blob" ] 406 | _ -> [])) 407 | _ -> [] ··· 455 456 and validate_array ~resolver ~path (arr : Schema.array_type) json = 457 match json with 458 - | `List items -> 459 let errs = ref [] in 460 (* Check length constraints *) 461 let len = List.length items in ··· 484 485 and validate_object ~resolver ~path (obj : Schema.object_type) json = 486 match json with 487 - | `Assoc pairs -> 488 let errs = ref [] in 489 (* Check required fields *) 490 List.iter ··· 520 | None -> ( 521 (* Fallback: require an object for unresolved refs *) 522 match json with 523 - | `Assoc _ -> [] 524 | _ -> [ error ~path "expected object for ref" ]) 525 526 and validate_union ~resolver ~path (union : Schema.union_type) json = 527 match json with 528 - | `Assoc pairs -> ( 529 match List.assoc_opt "$type" pairs with 530 - | Some (`String type_ref) -> 531 let errs = ref [] in 532 (* Check if type is in allowed refs for closed unions *) 533 (if union.closed then
··· 202 203 (* === JSON value helpers === *) 204 205 + type json = Simdjsont.Json.t 206 207 let get_string key = function 208 + | Simdjsont.Json.Object pairs -> ( 209 match List.assoc_opt key pairs with 210 + | Some (Simdjsont.Json.String s) -> Some s 211 | _ -> None) 212 | _ -> None 213 214 let get_int key = function 215 + | Simdjsont.Json.Object pairs -> ( 216 + match List.assoc_opt key pairs with 217 + | Some (Simdjsont.Json.Int i) -> 218 + if 219 + Int64.compare i (Int64.of_int max_int) > 0 220 + || Int64.compare i (Int64.of_int min_int) < 0 221 + then None 222 + else Some (Int64.to_int i) 223 + | _ -> None) 224 | _ -> None 225 226 let get_bool key = function 227 + | Simdjsont.Json.Object pairs -> ( 228 + match List.assoc_opt key pairs with 229 + | Some (Simdjsont.Json.Bool b) -> Some b 230 + | _ -> None) 231 | _ -> None 232 233 + let is_null = function Simdjsont.Json.Null -> true | _ -> false 234 235 (* === Field validators === *) 236 237 (** Validate a boolean value *) 238 let validate_boolean ~path json = 239 + match json with 240 + | Simdjsont.Json.Bool _ -> [] 241 + | _ -> [ error ~path "expected boolean" ] 242 243 (** Validate an integer value with constraints *) 244 let validate_integer ~path ?minimum ?maximum ?enum ?const json = 245 match json with 246 + | Simdjsont.Json.Int i64 -> ( 247 + let i_opt = 248 + if 249 + Int64.compare i64 (Int64.of_int max_int) > 0 250 + || Int64.compare i64 (Int64.of_int min_int) < 0 251 + then None 252 + else Some (Int64.to_int i64) 253 + in 254 + match i_opt with 255 + | None -> [ error ~path "integer out of int range" ] 256 + | Some i -> 257 + let errs = ref [] in 258 + (match const with 259 + | Some c when i <> c -> 260 + errs := error ~path (Printf.sprintf "must be %d" c) :: !errs 261 + | _ -> ()); 262 + (match enum with 263 + | Some values when not (List.mem i values) -> 264 + errs := error ~path "value not in enum" :: !errs 265 + | _ -> ()); 266 + (match minimum with 267 + | Some min when i < min -> 268 + errs := error ~path (Printf.sprintf "must be >= %d" min) :: !errs 269 + | _ -> ()); 270 + (match maximum with 271 + | Some max when i > max -> 272 + errs := error ~path (Printf.sprintf "must be <= %d" max) :: !errs 273 + | _ -> ()); 274 + !errs) 275 | _ -> [ error ~path "expected integer" ] 276 277 (** Validate a string value with constraints *) 278 let validate_string ~path ?format ?min_length ?max_length ?min_graphemes 279 ?max_graphemes ?enum ?const ?known_values:_ json = 280 match json with 281 + | Simdjsont.Json.String s -> 282 let errs = ref [] in 283 (match const with 284 | Some c when s <> c -> ··· 322 (** Validate a bytes value (expects $bytes object) *) 323 let validate_bytes ~path ?min_length ?max_length json = 324 match json with 325 + | Simdjsont.Json.Object pairs -> ( 326 match List.assoc_opt "$bytes" pairs with 327 + | Some (Simdjsont.Json.String b64) -> 328 (* Decode base64 to get actual length *) 329 let len = String.length b64 * 3 / 4 in 330 (* approximate *) ··· 348 (** Validate a CID link (expects $link object) *) 349 let validate_cid_link ~path json = 350 match json with 351 + | Simdjsont.Json.Object pairs -> ( 352 match List.assoc_opt "$link" pairs with 353 + | Some (Simdjsont.Json.String _cid) -> [] 354 | _ -> [ error ~path "expected $link object" ]) 355 | _ -> [ error ~path "expected $link object" ] 356 357 (** Validate a blob value *) 358 let validate_blob ~path ?max_size ?accept json = 359 match json with 360 + | Simdjsont.Json.Object pairs -> ( 361 match List.assoc_opt "$type" pairs with 362 + | Some (Simdjsont.Json.String "blob") -> 363 let errs = ref [] in 364 (* Check mimeType *) 365 (match List.assoc_opt "mimeType" pairs with 366 + | Some (Simdjsont.Json.String mime) -> ( 367 match accept with 368 | Some patterns -> 369 let matches = ··· 386 | None -> errs := error ~path "missing mimeType" :: !errs); 387 (* Check size *) 388 (match List.assoc_opt "size" pairs with 389 + | Some (Simdjsont.Json.Int size64) -> ( 390 + let size = 391 + if 392 + Int64.compare size64 (Int64.of_int max_int) > 0 393 + || Int64.compare size64 (Int64.of_int min_int) < 0 394 + then None 395 + else Some (Int64.to_int size64) 396 + in 397 + match size with 398 + | None -> errs := error ~path "size out of int range" :: !errs 399 + | Some size -> ( 400 + match max_size with 401 + | Some max when size > max -> 402 + errs := 403 + error ~path 404 + (Printf.sprintf "blob size must be <= %d" max) 405 + :: !errs 406 + | _ -> ())) 407 | Some _ -> errs := error ~path "size must be integer" :: !errs 408 | None -> errs := error ~path "missing size" :: !errs); 409 (* Check ref *) ··· 425 This is part of the data model restrictions. *) 426 let validate_unknown ~path json = 427 match json with 428 + | Simdjsont.Json.Bool _ -> 429 + [ error ~path "unknown type cannot contain boolean" ] 430 + | Simdjsont.Json.Object pairs -> ( 431 (* Check for $bytes - not allowed in unknown *) 432 match List.assoc_opt "$bytes" pairs with 433 | Some _ -> [ error ~path "unknown type cannot contain bytes ($bytes)" ] 434 | None -> ( 435 (* Check for blob ($type: "blob") - not allowed in unknown *) 436 match List.assoc_opt "$type" pairs with 437 + | Some (Simdjsont.Json.String "blob") -> 438 [ error ~path "unknown type cannot contain blob" ] 439 | _ -> [])) 440 | _ -> [] ··· 488 489 and validate_array ~resolver ~path (arr : Schema.array_type) json = 490 match json with 491 + | Simdjsont.Json.Array items -> 492 let errs = ref [] in 493 (* Check length constraints *) 494 let len = List.length items in ··· 517 518 and validate_object ~resolver ~path (obj : Schema.object_type) json = 519 match json with 520 + | Simdjsont.Json.Object pairs -> 521 let errs = ref [] in 522 (* Check required fields *) 523 List.iter ··· 553 | None -> ( 554 (* Fallback: require an object for unresolved refs *) 555 match json with 556 + | Simdjsont.Json.Object _ -> [] 557 | _ -> [ error ~path "expected object for ref" ]) 558 559 and validate_union ~resolver ~path (union : Schema.union_type) json = 560 match json with 561 + | Simdjsont.Json.Object pairs -> ( 562 match List.assoc_opt "$type" pairs with 563 + | Some (Simdjsont.Json.String type_ref) -> 564 let errs = ref [] in 565 (* Check if type is in allowed refs for closed unions *) 566 (if union.closed then
+34 -27
test/lexicon/test_lexicon.ml
··· 11 let ic = open_in path in 12 let content = really_input_string ic (in_channel_length ic) in 13 close_in ic; 14 - Yojson.Basic.from_string content 15 16 (** Read catalog lexicon file *) 17 let read_catalog_file filename = ··· 23 let test_valid_lexicons () = 24 let fixtures = read_fixture_json "lexicon-valid.json" in 25 match fixtures with 26 - | `List items -> 27 List.iter 28 (fun item -> 29 match item with 30 - | `Assoc pairs -> ( 31 let name = 32 match List.assoc_opt "name" pairs with 33 - | Some (`String s) -> s 34 | _ -> "unknown" 35 in 36 match List.assoc_opt "lexicon" pairs with 37 | Some lexicon_json -> ( 38 - let lexicon_str = Yojson.Basic.to_string lexicon_json in 39 match Parser.of_string lexicon_str with 40 | Ok lexicon -> 41 Alcotest.(check bool) ··· 54 let test_invalid_lexicons () = 55 let fixtures = read_fixture_json "lexicon-invalid.json" in 56 match fixtures with 57 - | `List items -> 58 List.iter 59 (fun item -> 60 match item with 61 - | `Assoc pairs -> ( 62 let name = 63 match List.assoc_opt "name" pairs with 64 - | Some (`String s) -> s 65 | _ -> "unknown" 66 in 67 match List.assoc_opt "lexicon" pairs with 68 | Some lexicon_json -> ( 69 - let lexicon_str = Yojson.Basic.to_string lexicon_json in 70 match Parser.of_string lexicon_str with 71 | Ok _ -> 72 (* Some "invalid" lexicons may be parseable but semantically invalid *) ··· 313 let resolver = make_resolver lexicon in 314 let fixtures = read_fixture_json "record-data-valid.json" in 315 match fixtures with 316 - | `List items -> 317 List.iter 318 (fun item -> 319 match item with 320 - | `Assoc pairs -> ( 321 let name = 322 match List.assoc_opt "name" pairs with 323 - | Some (`String s) -> s 324 | _ -> "unknown" 325 in 326 match List.assoc_opt "data" pairs with ··· 352 let resolver = make_resolver lexicon in 353 let fixtures = read_fixture_json "record-data-invalid.json" in 354 match fixtures with 355 - | `List items -> 356 List.iter 357 (fun item -> 358 match item with 359 - | `Assoc pairs -> ( 360 let name = 361 match List.assoc_opt "name" pairs with 362 - | Some (`String s) -> s 363 | _ -> "unknown" 364 in 365 match List.assoc_opt "data" pairs with ··· 386 | None -> Alcotest.fail "could not load record schema" 387 | Some schema -> 388 (* Missing required 'integer' field *) 389 - let data = `Assoc [ ("$type", `String "example.lexicon.record") ] in 390 let errors = Validator.validate_record ~path:[] schema data in 391 Alcotest.(check bool) "has errors" true (errors <> []); 392 let has_required_error = ··· 403 | Some schema -> 404 (* Wrong type for integer field *) 405 let data = 406 - `Assoc 407 [ 408 - ("$type", `String "example.lexicon.record"); 409 - ("integer", `String "not-an-integer"); 410 ] 411 in 412 let errors = Validator.validate_record ~path:[] schema data in ··· 425 | Some schema -> 426 (* Invalid DID format in nested formats object *) 427 let data = 428 - `Assoc 429 [ 430 - ("$type", `String "example.lexicon.record"); 431 - ("integer", `Int 1); 432 - ("formats", `Assoc [ ("did", `String "invalid-did") ]); 433 ] 434 in 435 let _errors = Validator.validate_record ~path:[] schema data in ··· 443 | Some schema -> 444 (* Integer out of range *) 445 let data = 446 - `Assoc 447 [ 448 - ("$type", `String "example.lexicon.record"); 449 - ("integer", `Int 1); 450 - ("rangeInteger", `Int 9000); 451 ] 452 in 453 let errors = Validator.validate_record ~path:[] schema data in
··· 11 let ic = open_in path in 12 let content = really_input_string ic (in_channel_length ic) in 13 close_in ic; 14 + match Simdjsont.decode Simdjsont.Codec.value content with 15 + | Ok json -> json 16 + | Error msg -> failwith msg 17 18 (** Read catalog lexicon file *) 19 let read_catalog_file filename = ··· 25 let test_valid_lexicons () = 26 let fixtures = read_fixture_json "lexicon-valid.json" in 27 match fixtures with 28 + | Simdjsont.Json.Array items -> 29 List.iter 30 (fun item -> 31 match item with 32 + | Simdjsont.Json.Object pairs -> ( 33 let name = 34 match List.assoc_opt "name" pairs with 35 + | Some (Simdjsont.Json.String s) -> s 36 | _ -> "unknown" 37 in 38 match List.assoc_opt "lexicon" pairs with 39 | Some lexicon_json -> ( 40 + let lexicon_str = Simdjsont.Json.to_string lexicon_json in 41 match Parser.of_string lexicon_str with 42 | Ok lexicon -> 43 Alcotest.(check bool) ··· 56 let test_invalid_lexicons () = 57 let fixtures = read_fixture_json "lexicon-invalid.json" in 58 match fixtures with 59 + | Simdjsont.Json.Array items -> 60 List.iter 61 (fun item -> 62 match item with 63 + | Simdjsont.Json.Object pairs -> ( 64 let name = 65 match List.assoc_opt "name" pairs with 66 + | Some (Simdjsont.Json.String s) -> s 67 | _ -> "unknown" 68 in 69 match List.assoc_opt "lexicon" pairs with 70 | Some lexicon_json -> ( 71 + let lexicon_str = Simdjsont.Json.to_string lexicon_json in 72 match Parser.of_string lexicon_str with 73 | Ok _ -> 74 (* Some "invalid" lexicons may be parseable but semantically invalid *) ··· 315 let resolver = make_resolver lexicon in 316 let fixtures = read_fixture_json "record-data-valid.json" in 317 match fixtures with 318 + | Simdjsont.Json.Array items -> 319 List.iter 320 (fun item -> 321 match item with 322 + | Simdjsont.Json.Object pairs -> ( 323 let name = 324 match List.assoc_opt "name" pairs with 325 + | Some (Simdjsont.Json.String s) -> s 326 | _ -> "unknown" 327 in 328 match List.assoc_opt "data" pairs with ··· 354 let resolver = make_resolver lexicon in 355 let fixtures = read_fixture_json "record-data-invalid.json" in 356 match fixtures with 357 + | Simdjsont.Json.Array items -> 358 List.iter 359 (fun item -> 360 match item with 361 + | Simdjsont.Json.Object pairs -> ( 362 let name = 363 match List.assoc_opt "name" pairs with 364 + | Some (Simdjsont.Json.String s) -> s 365 | _ -> "unknown" 366 in 367 match List.assoc_opt "data" pairs with ··· 388 | None -> Alcotest.fail "could not load record schema" 389 | Some schema -> 390 (* Missing required 'integer' field *) 391 + let data = 392 + Simdjsont.Json.Object 393 + [ ("$type", Simdjsont.Json.String "example.lexicon.record") ] 394 + in 395 let errors = Validator.validate_record ~path:[] schema data in 396 Alcotest.(check bool) "has errors" true (errors <> []); 397 let has_required_error = ··· 408 | Some schema -> 409 (* Wrong type for integer field *) 410 let data = 411 + Simdjsont.Json.Object 412 [ 413 + ("$type", Simdjsont.Json.String "example.lexicon.record"); 414 + ("integer", Simdjsont.Json.String "not-an-integer"); 415 ] 416 in 417 let errors = Validator.validate_record ~path:[] schema data in ··· 430 | Some schema -> 431 (* Invalid DID format in nested formats object *) 432 let data = 433 + Simdjsont.Json.Object 434 [ 435 + ("$type", Simdjsont.Json.String "example.lexicon.record"); 436 + ("integer", Simdjsont.Json.Int 1L); 437 + ( "formats", 438 + Simdjsont.Json.Object 439 + [ ("did", Simdjsont.Json.String "invalid-did") ] ); 440 ] 441 in 442 let _errors = Validator.validate_record ~path:[] schema data in ··· 450 | Some schema -> 451 (* Integer out of range *) 452 let data = 453 + Simdjsont.Json.Object 454 [ 455 + ("$type", Simdjsont.Json.String "example.lexicon.record"); 456 + ("integer", Simdjsont.Json.Int 1L); 457 + ("rangeInteger", Simdjsont.Json.Int 9000L); 458 ] 459 in 460 let errors = Validator.validate_record ~path:[] schema data in