Native OCaml Rego/OPA policy engine
Linter fixes: auth refactor, github-oauth merge, respond cleanup
+1046
+32
dune-project
+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
+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
+10
lib/dune
+123
lib/lexer.ml
+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
+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
+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
+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
+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)"]
+231
test/test_rego.ml
+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
+
]