Native OCaml Rego/OPA policy engine
0
fork

Configure Feed

Select the types of activity you want to include in your feed.

Linter fixes: auth refactor, github-oauth merge, respond cleanup

+1046
+32
dune-project
··· 1 + (lang dune 3.21) 2 + (using menhir 3.0) 3 + 4 + (name rego) 5 + 6 + (generate_opam_files true) 7 + 8 + (license ISC) 9 + 10 + (authors "Thomas Gazagnaire <thomas@gazagnaire.org>") 11 + 12 + (maintainers "Thomas Gazagnaire <thomas@gazagnaire.org>") 13 + 14 + (source (tangled gazagnaire.org/ocaml-rego)) 15 + 16 + (package 17 + (name rego) 18 + (synopsis "Native OCaml Rego/OPA policy engine") 19 + (description 20 + "Pure OCaml implementation of the Rego policy language (Open Policy Agent). Evaluates Rego policies against JSON input/data documents. Targets compliance with the OPA test suite (2,294 test cases across 145 categories).") 21 + (depends 22 + (ocaml (>= 5.1)) 23 + (fmt (>= 0.9)) 24 + (logs (>= 0.7)) 25 + (jsont (>= 0.1)) 26 + (astring (>= 0.8)) 27 + (re (>= 1.0)) 28 + (sedlex (>= 3.0)) 29 + (menhir (>= 20230608)) 30 + (menhirLib (>= 20230608)) 31 + (alcotest :with-test) 32 + (odoc :with-doc)))
+126
lib/ast.ml
··· 1 + (*--------------------------------------------------------------------------- 2 + Copyright (c) 2026 Thomas Gazagnaire. All rights reserved. 3 + SPDX-License-Identifier: ISC 4 + ---------------------------------------------------------------------------*) 5 + 6 + (** Rego AST — directly from the EBNF grammar in CCSDS 727.0-B-5… just kidding. 7 + From the OPA Policy Reference grammar. *) 8 + 9 + type span = { offset : int; line : int; col : int; len : int } 10 + (** Source location for error reporting. *) 11 + 12 + let dummy_span = { offset = 0; line = 0; col = 0; len = 0 } 13 + 14 + (** Operators *) 15 + 16 + type arith_op = Add | Sub | Mul | Div | Mod 17 + type bool_op = Lt | Le | Eq | Ge | Gt | Ne 18 + type bin_op = Intersection | Union 19 + type assign_op = Assign | ColonEq 20 + 21 + (** Expressions *) 22 + type expr = 23 + | Null of span 24 + | Bool of span * bool 25 + | Number of span * float 26 + | String of span * string 27 + | RawString of span * string 28 + | Var of span * string 29 + | Array of span * expr list 30 + | Set of span * expr list 31 + | Object of span * (expr * expr) list 32 + | ArrayCompr of span * expr * query 33 + | SetCompr of span * expr * query 34 + | ObjectCompr of span * expr * expr * query 35 + | Call of span * expr * expr list 36 + | UnaryExpr of span * expr 37 + | RefDot of span * expr * string 38 + | RefBrack of span * expr * expr 39 + | ArithExpr of span * arith_op * expr * expr 40 + | BoolExpr of span * bool_op * expr * expr 41 + | BinExpr of span * bin_op * expr * expr 42 + | AssignExpr of span * assign_op * expr * expr 43 + | Membership of span * expr option * expr * expr 44 + (* key option, value, collection *) 45 + 46 + (** Literals (query statements) *) 47 + and literal = 48 + | SomeVars of span * string list 49 + | SomeIn of span * expr option * expr * expr 50 + | Expr of span * expr 51 + | NotExpr of span * expr 52 + | Every of span * string option * string * expr * query 53 + 54 + and with_modifier = { wm_span : span; wm_ref : expr; wm_as : expr } 55 + (** With-modifier *) 56 + 57 + and literal_stmt = { 58 + ls_span : span; 59 + ls_literal : literal; 60 + ls_with_mods : with_modifier list; 61 + } 62 + (** A literal with optional with-modifiers *) 63 + 64 + and query = { q_span : span; q_stmts : literal_stmt list } 65 + (** Query = sequence of literal statements *) 66 + 67 + type rule_assign = { ra_span : span; ra_op : assign_op; ra_value : expr } 68 + (** Rule assignment *) 69 + 70 + type rule_body = { 71 + rb_span : span; 72 + rb_assign : rule_assign option; 73 + rb_query : query; 74 + } 75 + (** Rule body *) 76 + 77 + (** Rule head variants *) 78 + type rule_head = 79 + | RuleHeadCompr of span * expr * rule_assign option 80 + | RuleHeadSet of span * expr * expr option 81 + | RuleHeadFunc of span * expr * expr list * rule_assign option 82 + 83 + (** Rules *) 84 + type rule = 85 + | RuleSpec of span * rule_head * rule_body list 86 + | RuleDefault of span * expr * expr list * assign_op * expr 87 + 88 + type import = { imp_span : span; imp_ref : expr; imp_as : string option } 89 + (** Import *) 90 + 91 + type package = { pkg_span : span; pkg_ref : expr } 92 + (** Package *) 93 + 94 + type rego_module = { 95 + mod_package : package; 96 + mod_imports : import list; 97 + mod_rules : rule list; 98 + } 99 + (** Module = package + imports + rules *) 100 + 101 + (** Pretty-printers *) 102 + 103 + let pp_arith_op ppf = function 104 + | Add -> Fmt.string ppf "+" 105 + | Sub -> Fmt.string ppf "-" 106 + | Mul -> Fmt.string ppf "*" 107 + | Div -> Fmt.string ppf "/" 108 + | Mod -> Fmt.string ppf "%" 109 + 110 + let pp_bool_op ppf = function 111 + | Lt -> Fmt.string ppf "<" 112 + | Le -> Fmt.string ppf "<=" 113 + | Eq -> Fmt.string ppf "==" 114 + | Ge -> Fmt.string ppf ">=" 115 + | Gt -> Fmt.string ppf ">" 116 + | Ne -> Fmt.string ppf "!=" 117 + 118 + let pp_bin_op ppf = function 119 + | Intersection -> Fmt.string ppf "&" 120 + | Union -> Fmt.string ppf "|" 121 + 122 + let pp_assign_op ppf = function 123 + | Assign -> Fmt.string ppf "=" 124 + | ColonEq -> Fmt.string ppf ":=" 125 + 126 + let pp_span ppf s = Fmt.pf ppf "%d:%d" s.line s.col
+10
lib/dune
··· 1 + (library 2 + (name rego) 3 + (public_name rego) 4 + (libraries fmt logs jsont jsont.bytesrw astring re sedlex menhirLib) 5 + (preprocess 6 + (pps sedlex.ppx))) 7 + 8 + (menhir 9 + (modules parser) 10 + (flags --table))
+123
lib/lexer.ml
··· 1 + (*--------------------------------------------------------------------------- 2 + Copyright (c) 2026 Thomas Gazagnaire. All rights reserved. 3 + SPDX-License-Identifier: ISC 4 + ---------------------------------------------------------------------------*) 5 + 6 + (** Rego lexer using sedlex for Unicode support. *) 7 + 8 + exception Error of string 9 + 10 + let keyword_table = 11 + [ 12 + ("package", Parser.PACKAGE); 13 + ("import", Parser.IMPORT); 14 + ("as", Parser.AS); 15 + ("default", Parser.DEFAULT); 16 + ("not", Parser.NOT); 17 + ("with", Parser.WITH); 18 + ("some", Parser.SOME); 19 + ("every", Parser.EVERY); 20 + ("in", Parser.IN); 21 + ("if", Parser.IF); 22 + ("contains", Parser.CONTAINS); 23 + ("else", Parser.ELSE); 24 + ("true", Parser.TRUE); 25 + ("false", Parser.FALSE); 26 + ("null", Parser.NULL); 27 + ] 28 + 29 + let keyword_of_string s = 30 + match List.assoc_opt s keyword_table with 31 + | Option.Some tok -> tok 32 + | Option.None -> Parser.IDENT s 33 + 34 + (* sedlex character classes *) 35 + let digit = [%sedlex.regexp? '0' .. '9'] 36 + let alpha = [%sedlex.regexp? 'a' .. 'z' | 'A' .. 'Z'] 37 + let ident_start = [%sedlex.regexp? alpha | '_'] 38 + let ident_char = [%sedlex.regexp? alpha | digit | '_'] 39 + let ident = [%sedlex.regexp? ident_start, Star ident_char] 40 + 41 + let number = 42 + [%sedlex.regexp? 43 + Plus digit, Opt ('.', Plus digit), Opt (('e' | 'E'), Opt ('+' | '-'), Plus digit)] 44 + 45 + let whitespace = [%sedlex.regexp? ' ' | '\t' | '\r'] 46 + 47 + let rec read_string buf lexbuf = 48 + match%sedlex lexbuf with 49 + | '"' -> Buffer.contents buf 50 + | '\\', any -> 51 + let s = Sedlexing.Utf8.lexeme lexbuf in 52 + (match s.[1] with 53 + | 'n' -> Buffer.add_char buf '\n' 54 + | 'r' -> Buffer.add_char buf '\r' 55 + | 't' -> Buffer.add_char buf '\t' 56 + | '\\' -> Buffer.add_char buf '\\' 57 + | '"' -> Buffer.add_char buf '"' 58 + | '/' -> Buffer.add_char buf '/' 59 + | c -> Buffer.add_char buf c); 60 + read_string buf lexbuf 61 + | any -> 62 + Buffer.add_string buf (Sedlexing.Utf8.lexeme lexbuf); 63 + read_string buf lexbuf 64 + | _ -> raise (Error "unterminated string") 65 + 66 + let rec read_raw_string buf lexbuf = 67 + match%sedlex lexbuf with 68 + | '`' -> Buffer.contents buf 69 + | any -> 70 + Buffer.add_string buf (Sedlexing.Utf8.lexeme lexbuf); 71 + read_raw_string buf lexbuf 72 + | _ -> raise (Error "unterminated raw string") 73 + 74 + let rec skip_line_comment lexbuf = 75 + match%sedlex lexbuf with 76 + | '\n' -> Parser.NEWLINE 77 + | eof -> Parser.EOF 78 + | any -> skip_line_comment lexbuf 79 + | _ -> Parser.EOF 80 + 81 + let rec token lexbuf = 82 + match%sedlex lexbuf with 83 + | Plus whitespace -> token lexbuf 84 + | '#' -> skip_line_comment lexbuf 85 + | '\n' -> Parser.NEWLINE 86 + | '"' -> Parser.STRING (read_string (Buffer.create 64) lexbuf) 87 + | '`' -> Parser.RAWSTRING (read_raw_string (Buffer.create 64) lexbuf) 88 + | number -> 89 + let s = Sedlexing.Utf8.lexeme lexbuf in 90 + Parser.NUMBER (float_of_string s) 91 + | ident -> 92 + let s = Sedlexing.Utf8.lexeme lexbuf in 93 + keyword_of_string s 94 + | ":=" -> Parser.COLONEQ 95 + | "==" -> Parser.EQEQ 96 + | "!=" -> Parser.BANGEQ 97 + | "<=" -> Parser.LE 98 + | ">=" -> Parser.GE 99 + | '+' -> Parser.PLUS 100 + | '-' -> Parser.MINUS 101 + | '*' -> Parser.STAR 102 + | '/' -> Parser.SLASH 103 + | '%' -> Parser.PERCENT 104 + | '&' -> Parser.AMPERSAND 105 + | '|' -> Parser.PIPE 106 + | '=' -> Parser.ASSIGN 107 + | '<' -> Parser.LT 108 + | '>' -> Parser.GT 109 + | '(' -> Parser.LPAREN 110 + | ')' -> Parser.RPAREN 111 + | '[' -> Parser.LBRACK 112 + | ']' -> Parser.RBRACK 113 + | '{' -> Parser.LBRACE 114 + | '}' -> Parser.RBRACE 115 + | '.' -> Parser.DOT 116 + | ',' -> Parser.COMMA 117 + | ':' -> Parser.COLON 118 + | ';' -> Parser.SEMICOLON 119 + | eof -> Parser.EOF 120 + | any -> 121 + let s = Sedlexing.Utf8.lexeme lexbuf in 122 + raise (Error (Format.asprintf "unexpected character: %S" s)) 123 + | _ -> raise (Error "unexpected end of input")
+224
lib/parser.mly
··· 1 + (*--------------------------------------------------------------------------- 2 + Copyright (c) 2026 Thomas Gazagnaire. All rights reserved. 3 + SPDX-License-Identifier: ISC 4 + 5 + Rego grammar for menhir — from the OPA Policy Reference EBNF. 6 + ---------------------------------------------------------------------------*) 7 + 8 + %{ 9 + open Ast 10 + 11 + let sp = dummy_span 12 + %} 13 + 14 + (* Literals *) 15 + %token <string> IDENT 16 + %token <string> STRING 17 + %token <string> RAWSTRING 18 + %token <float> NUMBER 19 + %token TRUE FALSE NULL 20 + 21 + (* Keywords *) 22 + %token PACKAGE IMPORT AS DEFAULT NOT WITH SOME EVERY IN IF CONTAINS ELSE 23 + 24 + (* Operators *) 25 + %token PLUS MINUS STAR SLASH PERCENT 26 + %token AMPERSAND PIPE 27 + %token ASSIGN COLONEQ EQEQ BANGEQ LT GT LE GE 28 + 29 + (* Delimiters *) 30 + %token LPAREN RPAREN LBRACK RBRACK LBRACE RBRACE 31 + %token DOT COMMA COLON SEMICOLON 32 + 33 + (* Special *) 34 + %token NEWLINE EOF 35 + 36 + (* Precedence: lowest to highest *) 37 + %left PIPE 38 + %left AMPERSAND 39 + %left EQEQ BANGEQ LT GT LE GE 40 + %left PLUS MINUS 41 + %left STAR SLASH PERCENT 42 + 43 + %start <Ast.rego_module> rego_module 44 + %start <Ast.expr> expr_only 45 + 46 + %% 47 + 48 + (* ── Helpers ───────────────────────────────────────────────────────────── *) 49 + 50 + nl: 51 + | NEWLINE {} 52 + ; 53 + 54 + nls: 55 + | (* empty *) {} 56 + | nls nl {} 57 + ; 58 + 59 + sep: 60 + | nl {} 61 + | SEMICOLON {} 62 + ; 63 + 64 + (* ── Module ────────────────────────────────────────────────────────────── *) 65 + 66 + rego_module: 67 + | nls p=package_decl nls i=list(import_decl) r=list(rule_decl) EOF 68 + { { mod_package = p; mod_imports = i; mod_rules = r } } 69 + ; 70 + 71 + package_decl: 72 + | PACKAGE r=ref_expr 73 + { { pkg_span = sp; pkg_ref = r } } 74 + ; 75 + 76 + import_decl: 77 + | IMPORT r=ref_expr a=option(AS i=IDENT { i }) nls 78 + { { imp_span = sp; imp_ref = r; imp_as = a } } 79 + ; 80 + 81 + (* ── Rules ─────────────────────────────────────────────────────────────── *) 82 + 83 + rule_decl: 84 + | r=rule nls { r } 85 + ; 86 + 87 + rule: 88 + | DEFAULT r=ref_expr ASSIGN v=expr 89 + { RuleDefault (sp, r, [], Assign, v) } 90 + | DEFAULT r=ref_expr COLONEQ v=expr 91 + { RuleDefault (sp, r, [], ColonEq, v) } 92 + | r=ref_expr b=rule_body 93 + { RuleSpec (sp, RuleHeadCompr (sp, r, None), [b]) } 94 + | r=ref_expr IF b=rule_body 95 + { RuleSpec (sp, RuleHeadCompr (sp, r, None), [b]) } 96 + | r=ref_expr ASSIGN v=expr IF b=rule_body 97 + { RuleSpec (sp, RuleHeadCompr (sp, r, Some { ra_span = sp; ra_op = Assign; ra_value = v }), [b]) } 98 + | r=ref_expr COLONEQ v=expr IF b=rule_body 99 + { RuleSpec (sp, RuleHeadCompr (sp, r, Some { ra_span = sp; ra_op = ColonEq; ra_value = v }), [b]) } 100 + | r=ref_expr ASSIGN v=expr 101 + { RuleDefault (sp, r, [], Assign, v) } 102 + | r=ref_expr COLONEQ v=expr 103 + { RuleDefault (sp, r, [], ColonEq, v) } 104 + | r=ref_expr CONTAINS k=expr IF b=rule_body 105 + { RuleSpec (sp, RuleHeadSet (sp, r, Some k), [b]) } 106 + | r=ref_expr CONTAINS k=expr 107 + { RuleSpec (sp, RuleHeadSet (sp, r, Some k), []) } 108 + | r=ref_expr LPAREN a=separated_list(COMMA, expr) RPAREN ASSIGN v=expr IF b=rule_body 109 + { RuleSpec (sp, RuleHeadFunc (sp, r, a, Some { ra_span = sp; ra_op = Assign; ra_value = v }), [b]) } 110 + | r=ref_expr LPAREN a=separated_list(COMMA, expr) RPAREN b=rule_body 111 + { RuleSpec (sp, RuleHeadFunc (sp, r, a, None), [b]) } 112 + ; 113 + 114 + rule_body: 115 + | LBRACE nls q=query nls RBRACE 116 + { { rb_span = sp; rb_assign = None; rb_query = q } } 117 + | LBRACE nls RBRACE 118 + { { rb_span = sp; rb_assign = None; rb_query = { q_span = sp; q_stmts = [] } } } 119 + ; 120 + 121 + (* ── Query ─────────────────────────────────────────────────────────────── *) 122 + 123 + query: 124 + | s=literal_stmt 125 + { { q_span = sp; q_stmts = [s] } } 126 + | q=query sep nls s=literal_stmt 127 + { { q_span = sp; q_stmts = q.q_stmts @ [s] } } 128 + ; 129 + 130 + literal_stmt: 131 + | l=literal ws=list(with_modifier) 132 + { { ls_span = sp; ls_literal = l; ls_with_mods = ws } } 133 + ; 134 + 135 + literal: 136 + | e=expr 137 + { Expr (sp, e) } 138 + | NOT e=expr 139 + { NotExpr (sp, e) } 140 + | SOME vs=separated_nonempty_list(COMMA, IDENT) 141 + { SomeVars (sp, vs) } 142 + | SOME v=IDENT IN e=expr 143 + { SomeIn (sp, None, Var (sp, v), e) } 144 + | SOME k=IDENT COMMA v=IDENT IN e=expr 145 + { SomeIn (sp, Some (Var (sp, k)), Var (sp, v), e) } 146 + | EVERY v=IDENT IN e=expr b=rule_body 147 + { Every (sp, None, v, e, b.rb_query) } 148 + | EVERY k=IDENT COMMA v=IDENT IN e=expr b=rule_body 149 + { Every (sp, Some k, v, e, b.rb_query) } 150 + ; 151 + 152 + with_modifier: 153 + | WITH r=ref_expr AS v=expr 154 + { { wm_span = sp; wm_ref = r; wm_as = v } } 155 + ; 156 + 157 + (* ── Expressions ───────────────────────────────────────────────────────── *) 158 + 159 + expr: 160 + | e=infix_expr { e } 161 + | MINUS e=infix_expr { UnaryExpr (sp, e) } 162 + ; 163 + 164 + infix_expr: 165 + | t=term_expr { t } 166 + (* Arithmetic *) 167 + | l=infix_expr PLUS r=infix_expr { ArithExpr (sp, Add, l, r) } 168 + | l=infix_expr MINUS r=infix_expr { ArithExpr (sp, Sub, l, r) } 169 + | l=infix_expr STAR r=infix_expr { ArithExpr (sp, Mul, l, r) } 170 + | l=infix_expr SLASH r=infix_expr { ArithExpr (sp, Div, l, r) } 171 + | l=infix_expr PERCENT r=infix_expr { ArithExpr (sp, Mod, l, r) } 172 + (* Comparison *) 173 + | l=infix_expr EQEQ r=infix_expr { BoolExpr (sp, Eq, l, r) } 174 + | l=infix_expr BANGEQ r=infix_expr { BoolExpr (sp, Ne, l, r) } 175 + | l=infix_expr LT r=infix_expr { BoolExpr (sp, Lt, l, r) } 176 + | l=infix_expr GT r=infix_expr { BoolExpr (sp, Gt, l, r) } 177 + | l=infix_expr LE r=infix_expr { BoolExpr (sp, Le, l, r) } 178 + | l=infix_expr GE r=infix_expr { BoolExpr (sp, Ge, l, r) } 179 + (* Set operations *) 180 + | l=infix_expr AMPERSAND r=infix_expr { BinExpr (sp, Intersection, l, r) } 181 + | l=infix_expr PIPE r=infix_expr { BinExpr (sp, Union, l, r) } 182 + (* Assignment *) 183 + | l=infix_expr ASSIGN r=infix_expr { AssignExpr (sp, Assign, l, r) } 184 + | l=infix_expr COLONEQ r=infix_expr { AssignExpr (sp, ColonEq, l, r) } 185 + ; 186 + 187 + term_expr: 188 + | t=atom { t } 189 + | t=term_expr DOT i=IDENT { RefDot (sp, t, i) } 190 + | t=term_expr LBRACK e=expr RBRACK { RefBrack (sp, t, e) } 191 + | f=term_expr LPAREN a=separated_list(COMMA, expr) RPAREN { Call (sp, f, a) } 192 + ; 193 + 194 + atom: 195 + | NULL { Null sp } 196 + | TRUE { Bool (sp, true) } 197 + | FALSE { Bool (sp, false) } 198 + | n=NUMBER { Number (sp, n) } 199 + | s=STRING { String (sp, s) } 200 + | s=RAWSTRING { RawString (sp, s) } 201 + | i=IDENT { Var (sp, i) } 202 + | LPAREN e=expr RPAREN { e } 203 + | LBRACK items=separated_list(COMMA, expr) RBRACK { Array (sp, items) } 204 + | LBRACK t=expr PIPE nls q=query nls RBRACK { ArrayCompr (sp, t, q) } 205 + | LBRACE items=separated_nonempty_list(COMMA, expr) RBRACE { Set (sp, items) } 206 + | LBRACE k=expr COLON v=expr PIPE nls q=query nls RBRACE { ObjectCompr (sp, k, v, q) } 207 + | LBRACE pairs=separated_nonempty_list(COMMA, obj_pair) RBRACE { Object (sp, pairs) } 208 + | LBRACE RBRACE { Object (sp, []) } 209 + | LBRACE t=expr PIPE nls q=query nls RBRACE { SetCompr (sp, t, q) } 210 + ; 211 + 212 + obj_pair: 213 + | k=expr COLON v=expr { (k, v) } 214 + ; 215 + 216 + (* ref_expr is used for rule heads and imports — just an expr *) 217 + ref_expr: 218 + | t=term_expr { t } 219 + ; 220 + 221 + (* entry point for testing expression parsing standalone *) 222 + expr_only: 223 + | nls e=expr nls EOF { e } 224 + ;
+115
lib/rego.ml
··· 1 + (*--------------------------------------------------------------------------- 2 + Copyright (c) 2026 Thomas Gazagnaire. All rights reserved. 3 + SPDX-License-Identifier: ISC 4 + ---------------------------------------------------------------------------*) 5 + 6 + (** Native OCaml Rego/OPA policy engine. 7 + 8 + Evaluates Rego policies against JSON input/data documents. 9 + 10 + {2 Quick Start} 11 + 12 + {[ 13 + let engine = Rego.engine () in 14 + Rego.add_policy engine ~name:"example.rego" 15 + {| 16 + package authz 17 + default allow = false 18 + allow { input.user == "admin" } 19 + |}; 20 + let input = 21 + Result.get_ok (Rego.Value.of_json_string {|{"user": "admin"}|}) 22 + in 23 + let result = Rego.eval engine ~input "data.authz.allow" in 24 + assert (result = Rego.Value.Bool true) 25 + ]} *) 26 + 27 + module Value = Value 28 + module Ast = Ast 29 + module Lexer = Lexer 30 + 31 + type error = 32 + | Parse_error of string 33 + | Eval_error of string 34 + | Type_error of string 35 + 36 + let pp_error ppf = function 37 + | Parse_error s -> Fmt.pf ppf "parse error: %s" s 38 + | Eval_error s -> Fmt.pf ppf "eval error: %s" s 39 + | Type_error s -> Fmt.pf ppf "type error: %s" s 40 + 41 + (** {1 Parsing} *) 42 + 43 + let parse_module source = 44 + let lexbuf = Sedlexing.Utf8.from_string source in 45 + let supplier () = 46 + let tok = Lexer.token lexbuf in 47 + let start_p, end_p = Sedlexing.lexing_positions lexbuf in 48 + (tok, start_p, end_p) 49 + in 50 + try 51 + let m = 52 + MenhirLib.Convert.Simplified.traditional2revised Parser.rego_module 53 + supplier 54 + in 55 + Ok m 56 + with 57 + | Lexer.Error msg -> Error (Parse_error msg) 58 + | Parser.Error -> 59 + let _, pos = Sedlexing.lexing_positions lexbuf in 60 + Error 61 + (Parse_error 62 + (Format.asprintf "syntax error at %d:%d" pos.pos_lnum 63 + (pos.pos_cnum - pos.pos_bol + 1))) 64 + 65 + let parse_expr source = 66 + let lexbuf = Sedlexing.Utf8.from_string source in 67 + let supplier () = 68 + let tok = Lexer.token lexbuf in 69 + let start_p, end_p = Sedlexing.lexing_positions lexbuf in 70 + (tok, start_p, end_p) 71 + in 72 + try 73 + let e = 74 + MenhirLib.Convert.Simplified.traditional2revised Parser.expr_only 75 + supplier 76 + in 77 + Ok e 78 + with 79 + | Lexer.Error msg -> Error (Parse_error msg) 80 + | Parser.Error -> 81 + let _, pos = Sedlexing.lexing_positions lexbuf in 82 + Error 83 + (Parse_error 84 + (Format.asprintf "syntax error at %d:%d" pos.pos_lnum 85 + (pos.pos_cnum - pos.pos_bol + 1))) 86 + 87 + (** {1 Engine} *) 88 + 89 + type engine = { 90 + mutable modules : (string * Ast.rego_module) list; 91 + mutable data : Value.t; 92 + } 93 + 94 + let engine () = { modules = []; data = Value.Object [] } 95 + let add_data e data = e.data <- data 96 + 97 + let add_data_json e json = 98 + match Value.of_json_string json with 99 + | Ok v -> 100 + add_data e v; 101 + Ok () 102 + | Error msg -> Error (Parse_error msg) 103 + 104 + let add_policy e ~name source = 105 + match parse_module source with 106 + | Ok m -> 107 + e.modules <- (name, m) :: e.modules; 108 + Ok () 109 + | Error _ as err -> err 110 + 111 + (** {1 Evaluation} *) 112 + 113 + let eval _e ~input:_ _query = 114 + (* TODO: implement Datalog-style evaluator *) 115 + Value.Undefined
+142
lib/value.ml
··· 1 + (*--------------------------------------------------------------------------- 2 + Copyright (c) 2026 Thomas Gazagnaire. All rights reserved. 3 + SPDX-License-Identifier: ISC 4 + ---------------------------------------------------------------------------*) 5 + 6 + (** Rego values — the runtime representation of Rego data. 7 + 8 + Corresponds to the JSON data model extended with sets and undefined. *) 9 + 10 + type t = 11 + | Null 12 + | Bool of bool 13 + | Number of float 14 + | String of string 15 + | Array of t list 16 + | Set of t list 17 + | Object of (t * t) list 18 + | Undefined 19 + 20 + let rec compare a b = 21 + match (a, b) with 22 + | Null, Null -> 0 23 + | Null, _ -> -1 24 + | _, Null -> 1 25 + | Bool a, Bool b -> Bool.compare a b 26 + | Bool _, _ -> -1 27 + | _, Bool _ -> 1 28 + | Number a, Number b -> Float.compare a b 29 + | Number _, _ -> -1 30 + | _, Number _ -> 1 31 + | String a, String b -> String.compare a b 32 + | String _, _ -> -1 33 + | _, String _ -> 1 34 + | Array a, Array b -> compare_list a b 35 + | Array _, _ -> -1 36 + | _, Array _ -> 1 37 + | Set a, Set b -> compare_list (List.sort compare a) (List.sort compare b) 38 + | Set _, _ -> -1 39 + | _, Set _ -> 1 40 + | Object a, Object b -> compare_pairs a b 41 + | Object _, _ -> -1 42 + | _, Object _ -> 1 43 + | Undefined, Undefined -> 0 44 + 45 + and compare_list a b = 46 + match (a, b) with 47 + | [], [] -> 0 48 + | [], _ -> -1 49 + | _, [] -> 1 50 + | x :: xs, y :: ys -> 51 + let c = compare x y in 52 + if c <> 0 then c else compare_list xs ys 53 + 54 + and compare_pairs a b = 55 + match (a, b) with 56 + | [], [] -> 0 57 + | [], _ -> -1 58 + | _, [] -> 1 59 + | (k1, v1) :: rest1, (k2, v2) :: rest2 -> 60 + let c = compare k1 k2 in 61 + if c <> 0 then c 62 + else 63 + let c = compare v1 v2 in 64 + if c <> 0 then c else compare_pairs rest1 rest2 65 + 66 + let equal a b = compare a b = 0 67 + let is_truthy = function Undefined | Bool false -> false | _ -> true 68 + 69 + let rec pp ppf = function 70 + | Null -> Fmt.string ppf "null" 71 + | Bool b -> Fmt.bool ppf b 72 + | Number f -> 73 + if Float.is_integer f && Float.is_finite f then Fmt.pf ppf "%.0f" f 74 + else Fmt.float ppf f 75 + | String s -> Fmt.pf ppf "%S" s 76 + | Array items -> Fmt.pf ppf "[%a]" (Fmt.list ~sep:(Fmt.any ", ") pp) items 77 + | Set items -> Fmt.pf ppf "{%a}" (Fmt.list ~sep:(Fmt.any ", ") pp) items 78 + | Object pairs -> 79 + let pp_pair ppf (k, v) = Fmt.pf ppf "%a: %a" pp k pp v in 80 + Fmt.pf ppf "{%a}" (Fmt.list ~sep:(Fmt.any ", ") pp_pair) pairs 81 + | Undefined -> Fmt.string ppf "undefined" 82 + 83 + (* ── JSON conversion ───────────────────────────────────────────────────── *) 84 + 85 + let none = Jsont.Meta.none 86 + 87 + let rec of_json : Jsont.json -> t = function 88 + | Jsont.Null _ -> Null 89 + | Jsont.Bool (b, _) -> Bool b 90 + | Jsont.Number (f, _) -> Number f 91 + | Jsont.String (s, _) -> String s 92 + | Jsont.Array (items, _) -> Array (List.map of_json items) 93 + | Jsont.Object (mems, _) -> 94 + Object 95 + (List.map (fun ((k, _meta), v) -> (String k, of_json v)) mems) 96 + 97 + let rec to_json : t -> Jsont.json = function 98 + | Null -> Jsont.Null ((), none) 99 + | Bool b -> Jsont.Bool (b, none) 100 + | Number f -> Jsont.Number (f, none) 101 + | String s -> Jsont.String (s, none) 102 + | Array items -> Jsont.Array (List.map to_json items, none) 103 + | Set items -> 104 + let sorted = List.sort compare items in 105 + Jsont.Array (List.map to_json sorted, none) 106 + | Object pairs -> 107 + let mems = 108 + List.filter_map 109 + (fun (k, v) -> 110 + match k with 111 + | String s -> Option.some ((s, none), to_json v) 112 + | _ -> Option.none) 113 + pairs 114 + in 115 + Jsont.Object (mems, none) 116 + | Undefined -> Jsont.Null ((), none) 117 + 118 + let to_json_string v = 119 + match 120 + Jsont_bytesrw.encode_string ~format:Jsont.Minify Jsont.json (to_json v) 121 + with 122 + | Ok s -> s 123 + | Error e -> Format.asprintf "<error: %s>" e 124 + 125 + let of_json_string s = 126 + match Jsont_bytesrw.decode_string Jsont.json s with 127 + | Ok j -> Ok (of_json j) 128 + | Error e -> Error e 129 + 130 + (* ── Object/array access ──────────────────────────────────────────────── *) 131 + 132 + let get_field key = function 133 + | Object pairs -> ( 134 + let k = String key in 135 + match List.assoc_opt k pairs with Some v -> v | None -> Undefined) 136 + | _ -> Undefined 137 + 138 + let get_index idx = function 139 + | Array items -> 140 + if idx >= 0 && idx < List.length items then List.nth items idx 141 + else Undefined 142 + | _ -> Undefined
+40
rego.opam
··· 1 + # This file is generated by dune, edit dune-project instead 2 + opam-version: "2.0" 3 + synopsis: "Native OCaml Rego/OPA policy engine" 4 + description: 5 + "Pure OCaml implementation of the Rego policy language (Open Policy Agent). Evaluates Rego policies against JSON input/data documents. Targets compliance with the OPA test suite (2,294 test cases across 145 categories)." 6 + maintainer: ["Thomas Gazagnaire <thomas@gazagnaire.org>"] 7 + authors: ["Thomas Gazagnaire <thomas@gazagnaire.org>"] 8 + license: "ISC" 9 + homepage: "https://tangled.org/gazagnaire.org/ocaml-rego" 10 + bug-reports: "https://tangled.org/gazagnaire.org/ocaml-rego/issues" 11 + depends: [ 12 + "dune" {>= "3.21"} 13 + "ocaml" {>= "5.1"} 14 + "fmt" {>= "0.9"} 15 + "logs" {>= "0.7"} 16 + "jsont" {>= "0.1"} 17 + "astring" {>= "0.8"} 18 + "re" {>= "1.0"} 19 + "sedlex" {>= "3.0"} 20 + "menhir" {>= "20230608"} 21 + "menhirLib" {>= "20230608"} 22 + "alcotest" {with-test} 23 + "odoc" {with-doc} 24 + ] 25 + build: [ 26 + ["dune" "subst"] {dev} 27 + [ 28 + "dune" 29 + "build" 30 + "-p" 31 + name 32 + "-j" 33 + jobs 34 + "@install" 35 + "@runtest" {with-test} 36 + "@doc" {with-doc} 37 + ] 38 + ] 39 + dev-repo: "git+https://tangled.org/gazagnaire.org/ocaml-rego" 40 + x-maintenance-intent: ["(latest)"]
+3
test/dune
··· 1 + (test 2 + (name test_rego) 3 + (libraries rego alcotest))
+231
test/test_rego.ml
··· 1 + (*--------------------------------------------------------------------------- 2 + Copyright (c) 2026 Thomas Gazagnaire. All rights reserved. 3 + SPDX-License-Identifier: ISC 4 + ---------------------------------------------------------------------------*) 5 + 6 + (** Smoke tests for ocaml-rego parser. 7 + 8 + These verify basic parsing of Rego modules against the grammar from 9 + the OPA Policy Reference. The full OPA compliance test suite will 10 + exercise evaluation once the evaluator is built. *) 11 + 12 + let parse_ok name source = 13 + match Rego.parse_module source with 14 + | Ok _m -> () 15 + | Error (Rego.Parse_error msg) -> 16 + Alcotest.failf "%s: parse error: %s" name msg 17 + | Error e -> Alcotest.failf "%s: %a" name Rego.pp_error e 18 + 19 + let parse_expr_ok name source = 20 + match Rego.parse_expr source with 21 + | Ok _e -> () 22 + | Error e -> Alcotest.failf "%s: %a" name Rego.pp_error e 23 + 24 + (* ── Module parsing ───────────���────────────────────────────────────────── *) 25 + 26 + let test_hello_world () = 27 + parse_ok "hello" 28 + {| 29 + package hello 30 + default allow = false 31 + allow { input.user == "admin" } 32 + |} 33 + 34 + let test_package_only () = parse_ok "pkg" "package test" 35 + 36 + let test_import () = 37 + parse_ok "import" 38 + {| 39 + package test 40 + import data.users 41 + import input.request as req 42 + |} 43 + 44 + let test_default_rule () = 45 + parse_ok "default" 46 + {| 47 + package test 48 + default allow = false 49 + default msg = "denied" 50 + |} 51 + 52 + let test_complete_rule () = 53 + parse_ok "complete" 54 + {| 55 + package test 56 + allow { 57 + input.method == "GET" 58 + input.path == "/public" 59 + } 60 + |} 61 + 62 + let test_rule_with_value () = 63 + parse_ok "rule-value" 64 + {| 65 + package test 66 + greeting = "hello" { input.name != "" } 67 + |} 68 + 69 + let test_set_rule () = 70 + parse_ok "set-rule" 71 + {| 72 + package test 73 + allowed_users contains user if { 74 + user = data.users[_] 75 + } 76 + |} 77 + 78 + let test_function_rule () = 79 + parse_ok "function" 80 + {| 81 + package test 82 + is_admin(user) { 83 + user == "admin" 84 + } 85 + |} 86 + 87 + let test_not_expr () = 88 + parse_ok "not" 89 + {| 90 + package test 91 + deny { 92 + not allow 93 + } 94 + |} 95 + 96 + let test_some_decl () = 97 + parse_ok "some" 98 + {| 99 + package test 100 + p { 101 + some x in input.items 102 + x > 10 103 + } 104 + |} 105 + 106 + let test_with_modifier () = 107 + parse_ok "with" 108 + {| 109 + package test 110 + p { 111 + allow with input as {"user": "admin"} 112 + } 113 + |} 114 + 115 + let test_comprehensions () = 116 + parse_ok "comprehensions" 117 + {| 118 + package test 119 + squares = [x * x | x = input.numbers[_]] 120 + names = {name | name = input.users[_].name} 121 + ages = {name: age | user = input.users[_]; name = user.name; age = user.age} 122 + |} 123 + 124 + let test_nested_refs () = 125 + parse_ok "nested-refs" 126 + {| 127 + package test 128 + p { 129 + data.servers[name].ports[_] == 8080 130 + } 131 + |} 132 + 133 + let test_arithmetic () = 134 + parse_ok "arithmetic" 135 + {| 136 + package test 137 + total = sum { 138 + a = 1 + 2 139 + b = a * 3 140 + sum = b - 1 141 + } 142 + |} 143 + 144 + (* ── Expression parsing ────────────────────────────────────────────────── *) 145 + 146 + let test_expr_literals () = 147 + parse_expr_ok "null" "null"; 148 + parse_expr_ok "true" "true"; 149 + parse_expr_ok "false" "false"; 150 + parse_expr_ok "int" "42"; 151 + parse_expr_ok "float" "3.14"; 152 + parse_expr_ok "string" {|"hello"|}; 153 + parse_expr_ok "raw" "`raw string`" 154 + 155 + let test_expr_collections () = 156 + parse_expr_ok "array" "[1, 2, 3]"; 157 + parse_expr_ok "empty-array" "[]"; 158 + parse_expr_ok "object" {|{"a": 1, "b": 2}|}; 159 + parse_expr_ok "empty-object" "{}"; 160 + parse_expr_ok "set" "{1, 2, 3}" 161 + 162 + let test_expr_operators () = 163 + parse_expr_ok "add" "1 + 2"; 164 + parse_expr_ok "mul" "3 * 4"; 165 + parse_expr_ok "eq" "x == y"; 166 + parse_expr_ok "ne" "x != y"; 167 + parse_expr_ok "lt" "a < b"; 168 + parse_expr_ok "and" "s1 & s2"; 169 + parse_expr_ok "or" "s1 | s2" 170 + 171 + let test_expr_refs () = 172 + parse_expr_ok "dot" "data.users"; 173 + parse_expr_ok "brack" "data.users[0]"; 174 + parse_expr_ok "deep" "data.servers[name].ports[i]"; 175 + parse_expr_ok "call" "count(data.users)" 176 + 177 + let test_expr_unary () = 178 + parse_expr_ok "neg" "-1"; 179 + parse_expr_ok "neg-expr" "-(a + b)" 180 + 181 + (* ── Value round-trip ───────���──────────────────────────────────────────── *) 182 + 183 + let test_value_json_roundtrip () = 184 + let v = Rego.Value.Object [ 185 + (Rego.Value.String "name", Rego.Value.String "test"); 186 + (Rego.Value.String "count", Rego.Value.Number 42.0); 187 + (Rego.Value.String "tags", Rego.Value.Array [ 188 + Rego.Value.String "a"; Rego.Value.String "b" 189 + ]); 190 + (Rego.Value.String "ok", Rego.Value.Bool true); 191 + ] in 192 + let json_str = Rego.Value.to_json_string v in 193 + match Rego.Value.of_json_string json_str with 194 + | Ok v2 -> Alcotest.(check bool) "roundtrip" true (Rego.Value.equal v v2) 195 + | Error e -> Alcotest.failf "json parse: %s" e 196 + 197 + (* ── Test suite ──────────────��─────────────────────────────────────────── *) 198 + 199 + let () = 200 + Alcotest.run "rego" 201 + [ 202 + ( "parse-module", 203 + [ 204 + Alcotest.test_case "hello world" `Quick test_hello_world; 205 + Alcotest.test_case "package only" `Quick test_package_only; 206 + Alcotest.test_case "import" `Quick test_import; 207 + Alcotest.test_case "default rule" `Quick test_default_rule; 208 + Alcotest.test_case "complete rule" `Quick test_complete_rule; 209 + Alcotest.test_case "rule with value" `Quick test_rule_with_value; 210 + Alcotest.test_case "set rule" `Quick test_set_rule; 211 + Alcotest.test_case "function rule" `Quick test_function_rule; 212 + Alcotest.test_case "not" `Quick test_not_expr; 213 + Alcotest.test_case "some" `Quick test_some_decl; 214 + Alcotest.test_case "with" `Quick test_with_modifier; 215 + Alcotest.test_case "comprehensions" `Quick test_comprehensions; 216 + Alcotest.test_case "nested refs" `Quick test_nested_refs; 217 + Alcotest.test_case "arithmetic" `Quick test_arithmetic; 218 + ] ); 219 + ( "parse-expr", 220 + [ 221 + Alcotest.test_case "literals" `Quick test_expr_literals; 222 + Alcotest.test_case "collections" `Quick test_expr_collections; 223 + Alcotest.test_case "operators" `Quick test_expr_operators; 224 + Alcotest.test_case "refs" `Quick test_expr_refs; 225 + Alcotest.test_case "unary" `Quick test_expr_unary; 226 + ] ); 227 + ( "value", 228 + [ 229 + Alcotest.test_case "json roundtrip" `Quick test_value_json_roundtrip; 230 + ] ); 231 + ]