From 05a94953ea2a0240931f89fd72b01a5b3875a181 Mon Sep 17 00:00:00 2001 From: onodrim Date: Fri, 23 Jan 2026 11:58:32 +0100 Subject: [PATCH 1/6] feat: define models for ODRL and SHACL Define simplified models for ODRL and SHACL using classes. These models only cover the parts of the respective specifications that we need to express authorisation policies in ODRL(+SHACL). These models facilitate an internal representation of an ODRL policy that can serve as an intermediary between the raw input (e.g. ODRL policy in ttl file) and the ACL used internally by this service. --- odrl/odrl.lisp | 144 ++++++++++++++++++++++++++++++++++++++++++++++ odrl/shacl.lisp | 63 ++++++++++++++++++++ packages.lisp | 3 + sparql-parser.asd | 3 + 4 files changed, 213 insertions(+) create mode 100644 odrl/odrl.lisp create mode 100644 odrl/shacl.lisp diff --git a/odrl/odrl.lisp b/odrl/odrl.lisp new file mode 100644 index 0000000..deab838 --- /dev/null +++ b/odrl/odrl.lisp @@ -0,0 +1,144 @@ +(in-package :odrl-config) + +;; ODRL information model +;; +;; An implementation of a simplified version of the ODRL information model. This implementation is +;; intended to cover the parts of ODRL we currently need, and is not intended to support the entire +;; information model. For example, this only supports Sets and Permissions, and no other types of +;; policies or rules. Similarly, Constraints are not supported at all. +;; +;; Furthermore, this implementation explicitly deviates from ODRL's specification in some ways. +;; Consult the documentation of individual classes for more information. +(defclass concept () + ((uri :initarg :uri + :reader uri)) + (:documentation "Base class for ODRL concepts.")) + +(defclass policy (concept) + ((rules :initarg :rules + :type list + :reader rules)) ; odrl:permission + (:documentation "An ODRL Policy consisting of a set of rules.")) + +(defclass rule-set (policy) + () + (:documentation "An ODRL Set that represents any set of rules.")) + +;; TODO: Should probably replace it by something more robust. +(defun to-kebab-case (str) + "Convert a STR to kebab case. + +Note, this is a simplified version that does *not* split camel case, any upper case letters will +simply be down cased." + (string-downcase (cl-ppcre:regex-replace-all "\\s+|_" str "-"))) + +;; TODO: `supply-allowed-group' allows to specify a `constraint' argument. Currently the value for +;; `constraint' will be implicitly set based on whether there is a `query' specified. Consequently, +;; it is not possible to +;; - specify `NEVER' as value for `constraint'; and +;; - overwrite the presence of a `query' by explicitly specifying `ALWAYS' (or `NEVER') as value for +;; `constraint'. +(defclass party-collection (concept) + ((name :initarg :name + :reader name) ; vcard:fn + (description :initarg :description + :initform nil + :reader description) ; ext:description + (parameters :initarg :parameters + :initform nil + :reader parameters) ; ext:queryParameters + (query :initarg :query + :initform nil + :reader query)) ; ext:definedBy + (:documentation "An ODRL party collection. In contrast to the ODRL specification this does not explicitly contain member parties. Instead members are essentially defined by the query, if the query returns a result the (implied) party is considered a member of the party collection.")) + +(defmethod initialize-instance :after ((concept party-collection) &key) + (setf (slot-value concept 'name) (to-kebab-case (name concept)))) + +;; TODO: `define-graph' allows to specify extra options `:sparql' and `:delta'. The ODRL policy +;; currently does not allow such options to be passed. Should extend data model to support this if +;; we want to achieve full compatibility with the lisp configuration interface. +(defclass asset-collection (concept) + ((name :initarg :name + :type string + :reader name) ; vcard:fn + (description :initarg :description + :initform nil + :reader description) ; dct:description + (graph :initarg :graph + :reader graph) ; ext:graphPrefix + (assets :initarg :assets + :type list ; of `shacl:node-shape's + :reader assets)) ; ^odrl:partOf + (:documentation "An ODRL Asset collection representing a graph. In contrast to the ODRL specification this does explicitly refer to its contained assets, thereby modelling the inverse of the ODRL's partOf predicate. This inversion simplifies converting ODRL policies to ACL configurations as it allows to iterate of the necessary assets when given an asset collection, which is in turn referenced by a rule for the starting point of the ODRL to ACL conversion. Otherwise, one would somehow have to keep track of all asset instances and link them their collections. A consequence of this is that the entity creating `asset-collection' instances is responsible for inverting the relations between assets and the asset collections they part of. Furthermore, assets are represented as instances of `shacl:node-shape' and there is *no* explicit class for ODRL Assets.")) + +(defmethod initialize-instance :after ((concept asset-collection) &key) + (setf (slot-value concept 'name) (to-kebab-case (name concept)))) + +(defclass rule (concept) + ((actions :initarg :actions + :type list + :reader actions) ; odrl:action + (target :initarg :target + :type asset-collection + :reader target) ; odrl:target + (assignee :initarg :assignee + :type party-collection + :reader assignee)) ; odrl:assignee + (:documentation "An ODRL rule combines the common parts for permissions, prohibitions, and duties. In contrast to the ODRL specification we allow a rule to specify multiple actions, as `acl::access-grant's allows multiple usages to be specified.")) + +(defclass permission (rule) + () + (:documentation "An ODRL permission represents that an assignee is allowed to perform an action on a target.")) + +(defclass action (concept) + () + (:documentation "An ODRL Action class which indicates an operation that can be performed on an asset. The actual operation should be encoded in the URI of the action element. Note that the conversion to ACL currently only supports two actions: `odrl:read' and `odrl:modify', specifying any other action will lead to errors.")) + + +;; +;; Varia +;; +(defmethod print-object ((object rule-set) stream) + (print-unreadable-object (object stream) + (with-slots (uri rules) object + (format + stream + "~a <~a>~&~2t" + (type-of object) + uri + (mapcar #'uri rules))))) + +(defmethod print-object ((object rule) stream) + (print-unreadable-object (object stream) + (format stream "~a" (uri object)))) + +(defmethod print-object ((concept action) stream) + (print-unreadable-object (concept stream) + (format stream "~a" (uri concept)))) + +(defmethod print-object ((object asset-collection) stream) + (print-unreadable-object (object stream) + (with-slots (uri name description graph assets) object + (format + stream + "~a ~a~&~2t~&~2t~&~2t~&~2t" + (type-of object) + uri + name + description + graph + assets)))) + +(defmethod print-object ((object party-collection) stream) + (print-unreadable-object (object stream) + (with-slots (uri name description parameters query) object + (format + stream + "~a ~a~&~2t~&~2t~&~2t~&~2t" + (type-of object) + uri + name + description + parameters + query)))) diff --git a/odrl/shacl.lisp b/odrl/shacl.lisp new file mode 100644 index 0000000..bdface7 --- /dev/null +++ b/odrl/shacl.lisp @@ -0,0 +1,63 @@ +(in-package :odrl-config) + +;; Shapes Constraint Language (SHACL) +;; +;; A, very, simplified implementation of SHACL. This implementation is strictly limited to the +;; elements of SHACL we need in order to express which triples should be considered part of some +;; asset collection. +(defclass shape () + ((uri :initarg :uri) + (target-class :initarg :target-class + :initform nil + :reader target-class)) ; sh:targetClass + (:documentation "A SHACL shape.")) + +(defclass node-shape (shape) + ((properties :initarg :properties + :initform nil + :reader properties) ; sh:property* + ;; NOTE (04/09/2025): Used to indicate whether the property shapes are surrounded by a + ;; `sh:not'. This is a simplification, ideally we can capture and process constraints + ;; (components) in general. + (notp :initarg :notp + :type boolean + :initform nil + :reader notp)) + (:documentation "A SHACL node shape")) + +(defclass property-shape (shape) + ((path :initarg :path + :initform nil + :reader path)) ; value is a predicate URI or a `property-path' instance + (:documentation "A SHACL property shape")) + +(defclass property-path () + ((predicate-path :initarg :predicate-path + :reader predicate-path) + (object :initarg :object + :reader object)) + (:documentation "A SHACL property path.")) +;; +;; Varia +;; +(defmethod print-object ((shape node-shape) stream) + (print-unreadable-object (shape stream) + (with-slots (uri target-class properties notp) shape + (format + stream + "~a <~a>~&~2t~&~2t~&~2t" + (type-of shape) + uri + target-class + notp + properties)))) + +(defmethod print-object ((shape property-shape) stream) + (print-unreadable-object (shape stream) + (with-slots (uri path) shape + (format stream "~a <~a>~&~4t" (type-of shape) uri path)))) + +(defmethod print-object ((path property-path) stream) + (print-unreadable-object (path stream) + (with-slots (predicate-path object) path + (format stream "~a <~a> <~a>" (type-of path) predicate-path object)))) diff --git a/packages.lisp b/packages.lisp index fa091e3..551f704 100644 --- a/packages.lisp +++ b/packages.lisp @@ -151,6 +151,9 @@ (defpackage #:acl-config (:use :common-lisp)) +(defpackage #:odrl-config + (:use :common-lisp)) + (defpackage #:prefix (:use :common-lisp) (:export #:expand diff --git a/sparql-parser.asd b/sparql-parser.asd index 802c378..ab122d1 100644 --- a/sparql-parser.asd +++ b/sparql-parser.asd @@ -37,6 +37,9 @@ (:file "acl/acl") (:file "acl/configuration-interface") (:file "acl/config") + ;; ODRL configuration + (:file "odrl/odrl") + (:file "odrl/shacl") ;; ;; reasoning to determine graphs ;; (:file "reasoner/tree-mirror") ;; (:file "reasoner/prefixes") From 960b365c5c64cba0f67407af99df4ec17e84ad9d Mon Sep 17 00:00:00 2001 From: onodrim Date: Fri, 23 Jan 2026 12:00:17 +0100 Subject: [PATCH 2/6] feat: read ODRL policy from n-triples file - Parse the contents of a n-triples files using `cl-ntriples` - Convert each relevant resource to its corresponding ODRL/SHACL object. The `make-rule-set` function is used as the entrypoint for this conversion. - Triples in the input that are not relevant for model instances are simply ignored. - Add `./odrl/config.{nt,ttl}` as example for testing purposes. --- odrl/config.nt | 96 +++++++++++ odrl/config.ttl | 132 ++++++++++++++++ odrl/parse-ntriples.lisp | 332 +++++++++++++++++++++++++++++++++++++++ sparql-parser.asd | 3 +- 4 files changed, 562 insertions(+), 1 deletion(-) create mode 100644 odrl/config.nt create mode 100644 odrl/config.ttl create mode 100644 odrl/parse-ntriples.lisp diff --git a/odrl/config.nt b/odrl/config.nt new file mode 100644 index 0000000..cf6cb68 --- /dev/null +++ b/odrl/config.nt @@ -0,0 +1,96 @@ + . + . + . + . + . + . + . + . + . + . + . + "PREFIX session: \n PREFIX mu: \n PREFIX ext: \n SELECT ?account WHERE {\n session:account ?account.\n ?account ext:hasRole ext:Administrator.\n }" . + . + . + . + . + "admin" . + . + . + . + . + . + . + . + . + . + . + . + "id" . + . + . + . + . + . + . + "public-data" . + . + . + . + . + . + . + "user-data" . + . + . + . + . + . + . + . + . + . + . + "public" . + . + . + . + . + . + . + . + . + "PREFIX session: \n PREFIX mu: \n SELECT ?id WHERE {\n session:account/mu:uuid ?id.\n }" . + . + . + . + . + . + . + "push-updates" . + . + . + . + . + . + . + . + "user" . + . + . + . + . + . + . + . + . + . + . + . + . + . + . + . + . + . + . diff --git a/odrl/config.ttl b/odrl/config.ttl new file mode 100644 index 0000000..c39761d --- /dev/null +++ b/odrl/config.ttl @@ -0,0 +1,132 @@ +@prefix authors: . +@prefix books: . +@prefix example: . +@prefix ext: . +@prefix favorites: . +@prefix foaf: . +@prefix geo: . +@prefix odrl: . +@prefix push: . +@prefix schema: . +@prefix sh: . +@prefix vcard: . + +example:examplePolicy a odrl:Set ; + odrl:permission example:adminPublicRead , + example:adminPublicWrite , + example:publicRead , + example:userUserDataRead , + example:userUserDataWrite , + example:publicPushUpdatesRead , + example:publicPushUpdatesWrite . + +example:publicParty a odrl:PartyCollection ; + vcard:fn "public" . + +example:authenticatedUserParty a odrl:PartyCollection ; + vcard:fn "user" ; + ext:definedBy """PREFIX session: + PREFIX mu: + SELECT ?id WHERE { + session:account/mu:uuid ?id. + }""" ; + ext:queryParameters "id" . + +example:adminParty a odrl:PartyCollection ; + vcard:fn "admin" ; + ext:definedBy """PREFIX session: + PREFIX mu: + PREFIX ext: + SELECT ?account WHERE { + session:account ?account. + ?account ext:hasRole ext:Administrator. + }""" . + + +example:publicGraph a odrl:AssetCollection ; + vcard:fn "public-data" ; + ext:graphPrefix . + +example:userGraph a odrl:AssetCollection ; + vcard:fn "user-data" ; + ext:graphPrefix . + +# TODO: Additional options provided: `:delta t :sparql nil` +example:pushUpdatesGraph a odrl:AssetCollection ; + vcard:fn "push-updates" ; + ext:graphPrefix . + + +example:personAsset a odrl:Asset, sh:NodeShape ; + odrl:partOf example:publicGraph ; + sh:targetClass foaf:Person . + +example:personeFavoriteAuthorAsset a odrl:Asset, sh:NodeShape ; + odrl:partOf example:userGraph ; + sh:targetClass foaf:Person ; + sh:property [ + sh:path [ sh:inversePath ext:hasFavoriteAuthor ] + ] . + +example:bookAsset a odrl:Asset, sh:NodeShape ; + odrl:partOf example:publicGraph ; + sh:targetClass schema:Book . + +example:geometryAsset a odrl:Asset, sh:NodeShape ; + odrl:partOf example:publicGraph ; + sh:targetClass geo:Geometry . + +example:WildCardAssset a odrl:Asset, sh:NodeShape ; + odrl:partOf example:userGraph ; + sh:targetClass ext:all ; + sh:property [ sh:path ext:hasBook ] , + [ sh:path ext:hasSuperFavorite ] , + [ sh:path ext:longContent ] . + +example:noNameOrLabelAsset a odrl:Asset, sh:NodeShape ; + odrl:partOf example:userGraph ; + sh:targetClass ext:NoNameOrLabel ; + sh:not [ + sh:property [ sh:path ext:name ] , + [ sh:path ext:label ] + ] . + +example:updateAsset a odrl:Asset, sh:NodeShape ; + odrl:partOf example:pushUpdatesGraph ; + sh:targetClass push:Update . + + +example:adminPublicRead a odrl:Permission ; + odrl:action odrl:read ; + odrl:target example:publicGraph ; + odrl:assignee example:adminParty . + +example:adminPublicWrite a odrl:Permission ; + odrl:action odrl:modify ; + odrl:target example:publicGraph ; + odrl:assignee example:adminParty . + +example:publicRead a odrl:Permission ; + odrl:action odrl:read ; + odrl:target example:publicGraph ; + odrl:assignee example:publicParty . + +example:userUserDataRead a odrl:Permission ; + odrl:action odrl:read ; + odrl:target example:userGraph ; + odrl:assignee example:authenticatedUserParty . + +example:userUserDataWrite a odrl:Permission ; + odrl:action odrl:modify ; + odrl:target example:userGraph ; + odrl:assignee example:authenticatedUserParty . + +example:publicPushUpdatesRead a odrl:Permission ; + odrl:action odrl:read ; + odrl:target example:pushUpdatesGraph ; + odrl:assignee example:publicParty . + +example:publicPushUpdatesWrite a odrl:Permission ; + odrl:action odrl:modify ; + odrl:target example:pushUpdatesGraph ; + odrl:assignee example:publicParty . diff --git a/odrl/parse-ntriples.lisp b/odrl/parse-ntriples.lisp new file mode 100644 index 0000000..4e7967e --- /dev/null +++ b/odrl/parse-ntriples.lisp @@ -0,0 +1,332 @@ +(in-package :odrl-config) + +;; Read policy files +;; +;; Read an ODRL policy specified as n-triples in a file and convert the parsed triples to a +;; `rule-set'. +;; NOTE (23/01/2026): This is rather messy code, but once we can directly read and parse ttl files +;; at part of it should become unnecessary. The need to read and parse n-triples is due to a lack of +;; a ttl parser in common lisp. We plan to fill that gap in the future. + +(defun policy-file (&optional filename) + "Get the path to the file to read the ODRL policy from. + +If FILENAME is nil, fall back to the \"config\" as default name for the policy file." + (if (find :docker *features*) + (concatenate 'string "../config/" (or filename "config") ".nt") + "odrl/config.nt")) + +(defun read-ntriples-file (path) + "Read the n-triples file `policy-file' and return its contents as a single string." + (let ((path (asdf:system-relative-pathname :sparql-parser path))) + (alexandria:read-file-into-string path))) + +(defun load-policy-file (&optional filename) + "Read the ODRL policy from FILENAME." + (handler-case + (let ((path (policy-file filename))) + (format t "~& >> INFO: Reading ODRL policy from ~A" path) + (nt:parse-nt (read-ntriples-file path))) + (error (e) + (format t "~& >> WARN: An error occurred when trying to read the configuration file: ~% >>>> '~A'~%" e)))) + +;; Utilities +(defparameter predicates-plist + '(:dcterms-description "http://purl.org/dc/terms/description" + :ext-defined-by "http://mu.semte.ch/vocabularies/ext/definedBy" + :ext-graph-prefix "http://mu.semte.ch/vocabularies/ext/graphPrefix" + :ext-query-parameters "http://mu.semte.ch/vocabularies/ext/queryParameters" + :odrl-action "http://www.w3.org/ns/odrl/2/action" + :odrl-assignee "http://www.w3.org/ns/odrl/2/assignee" + :odrl-assigner "http://www.w3.org/ns/odrl/2/assigner" + :odrl-part-of "http://www.w3.org/ns/odrl/2/partOf" + :odrl-permission "http://www.w3.org/ns/odrl/2/permission" + :odrl-profile "http://www.w3.org/ns/odrl/2/profile" + :odrl-target "http://www.w3.org/ns/odrl/2/target" + :rdf-type "http://www.w3.org/1999/02/22-rdf-syntax-ns#type" + :sh-inverse-path "http://www.w3.org/ns/shacl#inversePath" + :sh-not "http://www.w3.org/ns/shacl#not" + :sh-path "http://www.w3.org/ns/shacl#path" + :sh-property "http://www.w3.org/ns/shacl#property" + :sh-target-class "http://www.w3.org/ns/shacl#targetClass" + :vcard-fn "http://www.w3.org/2006/vcard/ns#fn") + "A plist containing the full uris for the predicates that are used in ODRL policies.") + +(defun predicate-uri (indicator) + "Return a string containing the full uri for the predicate matching INDICATOR." + (getf predicates-plist indicator)) + +(defparameter resource-types-plist + '(:odrl-asset "http://www.w3.org/ns/odrl/2/Asset" + :odrl-asset-collection "http://www.w3.org/ns/odrl/2/AssetCollection" + :odrl-party "http://www.w3.org/ns/odrl/2/Party" + :odrl-party-collection "http://www.w3.org/ns/odrl/2/PartyCollection" + :odrl-permission "http://www.w3.org/ns/odrl/2/Permission" + :odrl-profile "http://www.w3.org/ns/odrl/2/Profile" + :odrl-set "http://www.w3.org/ns/odrl/2/Set" + :sh-node-shape "http://www.w3.org/ns/shacl#NodeShape" + :sh-property-shape "http://www.w3.org/ns/shacl#PropertyShape") + "A plist containing the full uris for the resources types used in ODRL policies.") + +(defun type-uri (indicator) + "Return a string containing the full uri for the resource type matching INDICATOR." + (getf resource-types-plist indicator)) + +;; +;; Utilities to simplify parsing triples +;; +(defun value-from-object (object) + "Return the value of the OBJECT as a string. + +OBJECT is assumed to be an object as created by cl-ntriples. For any other kind of input the result +will be NIL." + (or (getf object :object-uriref) + (getf object :object-node-id) + (getf object :literal-string))) + +(defun triple-subject (triple) + "Return the subject of TRIPLE as a string." + (first triple)) + +(defun triple-predicate (triple) + "Return the predicate of TRIPLE as a string." + (second triple)) + +(defun triple-object (triple) + "Return the cl-ntriples object that is the object of TRIPLE." + (third triple)) + +(defun triple-object-value (triple) + "Return the value of the TRIPLE's object as a string." + (value-from-object (triple-object triple))) + +(defun triples-for-predicate (predicate triples) + "Return all elements in TRIPLES that have PREDICATE as predicate value." + (remove-if-not + (lambda (triple) (string= predicate (triple-predicate triple))) + triples)) + +(defun triples-for-resource (resource triples) + "Return an triple objects in TRIPLES that have RESOURCE as subject." + (remove-if-not + (lambda (triple) (string= resource (triple-subject triple))) + triples)) + +(defun triples-for-resource-predicate (resource predicate triples) + "Return all triple objects in TRIPLES that have RESOURCE as subject and PREDICATE as predicate." + (remove-if-not + (lambda (triple) + (and (string= resource (triple-subject triple)) + (string= predicate (triple-predicate triple)))) + triples)) + +(defun triples-for-predicate-object (predicate object triples) + "Return all triple objects in TRIPLES that have PREDICATE as predicate and OBJECT as object." + (remove-if-not + (lambda (triple) + (and (string= predicate (triple-predicate triple)) + (string= object (triple-object-value triple)))) + triples)) + +(defun list-parts-in-collection (uri triples) + "Return a list of the uris of all resources that are a part of the collection resource URI in TRIPLES." + (let ((parts (triples-for-predicate-object (predicate-uri :odrl-part-of) uri triples))) + (mapcar #'triple-subject parts))) + +(defun filter-resources-for-type (type triples) + "Filter the type triples for resources of TYPE in TRIPLES. + +TYPE should be a string containing a uri for a resource type." + (remove-if-not + (lambda (triple) (string= type (triple-object-value triple))) + (triples-for-predicate (predicate-uri :rdf-type) triples))) + +(defun list-resource-uris (type triples) + "Return a list containing the uri of each resource of TYPE in TRIPLES." + (mapcar #'triple-subject (filter-resources-for-type type triples))) + +(defun list-party-collections (triples) + "List the uris for ODRL party collection resources in TRIPLES." + (list-resource-uris (type-uri :odrl-party-collection) triples)) + +(defun list-asset-collections (triples) + "List the uris for ODRL asset collection resources in TRIPLES." + (list-resource-uris (type-uri :odrl-asset-collection) triples)) + +(defun list-assets (triples) + "List the uris for ODRL asset resources in TRIPLES." + (list-resource-uris (type-uri :odrl-asset) triples)) + +(defun list-permissions-in-policy (triples) + "Return a list of the uris of all permissions in the policy defined by TRIPLES." + (mapcar + (lambda (triple) (triple-object-value triple)) + (triples-for-predicate (predicate-uri :odrl-permission) triples))) + +;; NOTE (01/10/2025): These macros are use to make the init-forms in the `let' operators in the +;; conversion functions more readable. +(defmacro first-value-for-predicate (predicate triples) + "Return the value of the first object for PREDICATE encountered in TRIPLES." + `(triple-object-value (car (triples-for-predicate ,predicate ,triples)))) + +(defmacro first-triple-for-resource (uri triples) + "Return the first triple with URI as subject in TRIPLES." + `(car (triples-for-resource ,uri ,triples))) + +(defun find-policy-uri (triples) + "Find the uri for the policy resource defined in TRIPLES." + (car (list-resource-uris (type-uri :odrl-set) triples))) + +;; +;; Conversion to ODRL +;; +(defun find-concept-with-uri (uri concepts) + "Find the concept instance in CONCEPTS that has URI as value for its uri slot." + (when uri + (find-if + (lambda (concept) (string= (slot-value concept 'uri) uri)) + concepts))) + +(defun find-shape-with-uri (uri shapes) + "Find the shape instance in SHAPES that has URI as value for its uri slot." + (when uri + (find-if + (lambda (shape) (string= (slot-value shape 'uri) uri)) + shapes))) + +(defun make-rule-set (triples) + "Make an `rule-set' instance for the resource with URI." + (let ((asset-collections (make-asset-collections triples)) + (party-collections (make-party-collections triples)) + (permissions (list-permissions-in-policy triples))) + (make-instance + 'rule-set + :uri (find-policy-uri triples) + :rules (mapcar + (lambda (permission) + (make-permission permission asset-collections party-collections triples)) + permissions)))) + +(defun make-party-collections (triples) + "Make an `party-collection' for each party collection resource in TRIPLES." + (mapcar + (lambda (uri) (make-party-collection uri triples)) + (list-party-collections triples))) + +(defun make-party-collection (uri policy-triples) + "Make an `party-collection' instance for the resource with URI." + (let* ((triples (triples-for-resource uri policy-triples)) + (name (first-value-for-predicate (predicate-uri :vcard-fn) triples)) + (description (first-value-for-predicate (predicate-uri :dcterms-description) triples)) + (parameters (triples-for-predicate (predicate-uri :ext-query-parameters) triples)) + (query (first-value-for-predicate (predicate-uri :ext-defined-by) triples))) + (make-instance + 'party-collection + :uri uri + :name name + :description description + :parameters (mapcar #'triple-object-value parameters) + ;; TODO: Make sure to remove any newlines and/or trailing spaces at the end of the string; + ;; otherwise it will not be parsed correctly + ;; Also remove any newlines at the beginning of the string + :query query))) + +(defun make-asset-collections (triples) + "Make an `asset-collection' for each asset collection resource in TRIPLES." + (let ((assets (make-node-shapes triples))) + (mapcar + (lambda (uri) (make-asset-collection uri assets triples)) + (list-asset-collections triples)))) + +(defun make-asset-collection (uri assets policy-triples) + "Make an `asset-collection' instance for the resource with URI." + (let* ((triples (triples-for-resource uri policy-triples)) + (name (first-value-for-predicate (predicate-uri :vcard-fn) triples)) + (description (first-value-for-predicate (predicate-uri :dcterms-description) triples)) + (graph (first-value-for-predicate (predicate-uri :ext-graph-prefix) triples)) + (assets-in-collection (list-parts-in-collection uri policy-triples))) + (make-instance + 'asset-collection + :uri uri + :name name + :description description + :graph graph + :assets (mapcar + (lambda (uri) (find-shape-with-uri uri assets)) + assets-in-collection)))) + +(defun make-node-shapes (triples) + "Make a `node-shape' instance for each ODRL asset resource in triples." + (mapcar + (lambda (uri) (make-node-shape uri triples)) + (list-assets triples))) + +(defun make-node-shape (uri policy-triples) + "Make a `shacl:node-shape' for the resource with URI." + (let* ((triples (triples-for-resource uri policy-triples)) + (target (first-value-for-predicate (predicate-uri :sh-target-class) triples)) + ;; NOTE (01/10/2025): Node shapes may surround their property shapes with a "sh:not" + ;; constraint component. The `not-triple' will have a non-nil value if that is the case, + ;; otherwise it will be nill. This is used in `properties' to determine whether one has to + ;; go passed an additional blank node or not to find the properties in a node shape. + (not-triple (car (triples-for-predicate (predicate-uri :sh-not) triples))) + (properties (if not-triple + (triples-for-resource-predicate + (triple-object-value not-triple) + (predicate-uri :sh-property) + policy-triples) + (triples-for-predicate (predicate-uri :sh-property) triples)))) + (make-instance + 'node-shape + :uri uri + :target-class target + :properties (mapcar + (lambda (uri) (make-property-shape uri policy-triples)) + (mapcar #'triple-object-value properties)) + :notp (when not-triple t)))) + +(defun blank-node-uri-p (uri) + "Check whether a given URI is for a blank." + ;; TODO(C): match on alphanumeric characters in id part + (cl-ppcre:scan "?" uri)) + +(defun make-property-shape (uri policy-triples) + "Make a `shacl:property-shape' instance for the resource with URI." + (let ((path (triple-object-value (first-triple-for-resource uri policy-triples)))) + (make-instance + 'property-shape + :uri uri + :path (if (blank-node-uri-p path) + (make-property-path path policy-triples) + path)))) + +(defun make-property-path (uri policy-triples) + "Make a `property-path' instance for the resource with URI." + (let* ((triple (first-triple-for-resource uri policy-triples)) + (path (triple-predicate triple)) + (object (triple-object-value triple))) + (make-instance 'property-path :predicate-path path :object object))) + +(defun make-permission (uri asset-col party-col policy-triples) + "Make a `permission' instance for the resource with URI. + +ASSET-COL and PARTY-COL should be lists of, respectively, `asset-collection' and +`party-collection' instances with which the created `permission' instance can be linked." + (let* ((triples (triples-for-resource uri policy-triples)) + (action (first-value-for-predicate (predicate-uri :odrl-action) triples)) + (target (find-concept-with-uri + (first-value-for-predicate (predicate-uri :odrl-target) triples) + asset-col)) + (assignee (find-concept-with-uri + (first-value-for-predicate (predicate-uri :odrl-assignee) triples) + party-col))) + (make-instance + 'permission + :uri uri + :actions (list (make-action action)) + :target target + :assignee assignee))) + +(defun make-action (uri) + "Make an `action' instance for the given URI." + (make-instance 'action :uri uri)) diff --git a/sparql-parser.asd b/sparql-parser.asd index ab122d1..29de6d3 100644 --- a/sparql-parser.asd +++ b/sparql-parser.asd @@ -6,7 +6,7 @@ :license "MIT" :description "Parser for the SPARQL1.1 specification." :serial t - :depends-on (alexandria cl-ppcre bordeaux-threads woo dexador jsown luckless sha1 trivial-backtrace flexi-streams) + :depends-on (alexandria cl-ppcre bordeaux-threads woo dexador jsown luckless sha1 trivial-backtrace flexi-streams cl-ntriples) :components ((:file "packages") ;; supporting code (:file "support/support") @@ -38,6 +38,7 @@ (:file "acl/configuration-interface") (:file "acl/config") ;; ODRL configuration + (:file "odrl/parse-ntriples") (:file "odrl/odrl") (:file "odrl/shacl") ;; ;; reasoning to determine graphs From 5f527ae2df8b2d90a8cee787b56b94d6a9cc8d75 Mon Sep 17 00:00:00 2001 From: onodrim Date: Fri, 23 Jan 2026 12:00:42 +0100 Subject: [PATCH 3/6] feat: convert ODRL policy to internal ACL An ODRL Set is loaded as ACL by iterating over its contained rules: 1. Each Party (Asset) Collection referenced in a rule is converted into a corresponding allowed-group (graph-specification). Consequently, collections that are not used in any rule are ignored. 2. The set of rules in the policy are "reduced" by merging rules that have the same assignee and target. Any merged rule has as actions the union of its original rules. Note, this step is necessary because ODRL only allows 1 action per rule, whereas grants can specify multiple actions. 3. Convert the reduced rules into grants. --- odrl/odrl.lisp | 83 +++++++++++++++++++++++++++++++++++++++++++++++++ odrl/shacl.lisp | 52 +++++++++++++++++++++++++++++++ 2 files changed, 135 insertions(+) diff --git a/odrl/odrl.lisp b/odrl/odrl.lisp index deab838..572e051 100644 --- a/odrl/odrl.lisp +++ b/odrl/odrl.lisp @@ -96,6 +96,89 @@ simply be down cased." (:documentation "An ODRL Action class which indicates an operation that can be performed on an asset. The actual operation should be encoded in the URI of the action element. Note that the conversion to ACL currently only supports two actions: `odrl:read' and `odrl:modify', specifying any other action will lead to errors.")) +;; +;; Conversion to sparql-parser's ACL +;; +(defgeneric odrl-to-acl (concept) + (:documentation "Convert an ODRL concept to its corresponding sparql-parser configuration macro.")) + +(defun rules-match-p (left right) + "Return t if the rules LEFT and RIGHT have the same target and assignee, nil otherwise." + (and (eq (slot-value left 'assignee) (slot-value right 'assignee)) + (eq (slot-value left 'target) (slot-value right 'target)))) + +(defun find-matching-rule (rule rules) + "Find a rule in RULES that `rules-match-p' RULE." + (find-if (lambda (r) (rules-match-p r rule)) rules)) + +(defun reduce-rules (rules) + "Reduce RULES by merging together rules that have the same assignee and target." + (let ((reduced-rules '())) + (mapcar + (lambda (rule) + (let ((matching-rule (find-matching-rule rule reduced-rules))) + (if matching-rule + (setf (slot-value matching-rule 'actions) + (union (slot-value matching-rule 'actions) + (slot-value rule 'actions))) + (push rule reduced-rules)))) + rules) + reduced-rules)) + +(defmethod odrl-to-acl ((concept rule-set)) + (with-slots (rules) concept + (let ((party-collections (mapcar (lambda (r) (slot-value r 'assignee)) rules)) + (asset-collections (mapcar (lambda (r) (slot-value r 'target)) rules))) + ;; NOTE (20/01/2026): Party and Asset Collections that are not referenced by a rule are not + ;; converted to their respective access specifications or graph specifications. Consequently, + ;; no specifications for such collections are added the service's internal state. This differs + ;; from the situation with a Lisp configuration where all defined specifications are + ;; evaluated, irrelevant whether they are used in a grant. + (handler-case + (progn + (mapcar #'odrl-to-acl (remove-duplicates party-collections)) + (mapcar #'odrl-to-acl (remove-duplicates asset-collections)) + ;; NOTE (24/01/2026): The `reduce-rules' merges rules that have the same assignee and + ;; target. These mergers allow to convert each rule to a single access-grant. + (mapcar #'odrl-to-acl (reduce-rules rules))) + (error (e) + (format t "~%Error: Could not parse the loaded ODRL policy: ~A~%" e)))))) + +(defmethod odrl-to-acl ((concept asset-collection)) + (with-slots (name graph assets) concept + (acl::define-graph* + :name (read-from-string name) + :graph graph + ;; TODO: set actual values, cf. `define-graph' macro, requires actually getting this as input + :options '(:delta t :sparql t) + :type-specifications (mapcar #'shacl-to-acl assets)))) + +(defmethod odrl-to-acl ((concept party-collection)) + (with-slots (name description parameters query) concept + (acl:supply-allowed-group name :query query :parameters parameters))) + +;; TODO: This partially replicates the logic in the `acl:grant' macro +(defmethod odrl-to-acl ((concept permission)) + (with-slots (actions target assignee) concept + (acl:grant* + :scopes (list 'acl:_) ;; TODO: support scopes + :rights (mapcar + (lambda (action) + (intern (symbol-name (odrl-to-acl action)) :keyword)) + actions) + :graph-specs (list (read-from-string (slot-value target 'name))) + :allowed-groups (list (slot-value assignee 'name))))) + +(defmethod odrl-to-acl ((concept action)) + (with-slots (uri) concept + (cond + ((cl-ppcre:scan ".*read>?$" uri) 'acl::read) + ((cl-ppcre:scan ".*modify>?$" uri) 'acl::write) + ;; NOTE (23/01/2026): The odrl:write action was deprecated by odrl:modify. We will support it + ;; anyway for convenience. + ((cl-ppcre:scan ".*write>?$" uri) 'acl::write) + (t (error "No matching right found for \"~a\"" uri))))) + ;; ;; Varia ;; diff --git a/odrl/shacl.lisp b/odrl/shacl.lisp index bdface7..3596176 100644 --- a/odrl/shacl.lisp +++ b/odrl/shacl.lisp @@ -37,6 +37,58 @@ (object :initarg :object :reader object)) (:documentation "A SHACL property path.")) + + +;; +;; Conversion to sparql-parser's ACL +;; +(defgeneric shacl-to-acl (shape &optional notp) + (:documentation "Convert a SHACL shape to its corresponding sparql-parser entity.")) + +(defmethod shacl-to-acl ((shape node-shape) &optional notp) + (declare (ignore notp)) + (with-slots (target-class properties notp) shape + (alexandria:flatten + (append + (list (if (is-empty-node-p target-class) 'acl:_ target-class)) + (if properties + (mapcar (lambda (prop) (shacl-to-acl prop notp)) properties) + '(acl::-> acl:_)))))) + +(defun is-empty-node-p (path) + "Check whether PATH is the special uri for an empty node. + +The special uri was introduced to allow users to specify \"all predicates\" in a policy, as one +would use `_' in a lisp configuration. This special uri was needed because in SHACL property paths +must have a value for their object and otherwise we could not express type specifications of the of +the form `TYPE <- _' or `TYPE ) + (t 'acl::->))) + +(defmethod shacl-to-acl ((shape property-shape) &optional notp) + ;; If value of `path' is + ;; - a URI: (make-... :direction "->" :predicate path) + ;; - a `property-path': + ;; + parse its `predicate-path' to determine value for :direction + ;; + use its `object' as value for :predicate + (with-slots (path) shape + (list + ;; NOTE (13/09/2025): The simplification of using the mere existence of a property path to mean + ;; invert the direction depends on the fact that we use no other property paths than + ;; `sh:inversePath'. This should be generalised to actually check which `predicate-path' is + ;; used. + (direction-string (typep path 'property-path) notp) + (if (typep path 'property-path) + (if (is-empty-node-p (object path)) 'acl:_ (object path)) + (if (is-empty-node-p path) 'acl:_ path))))) + ;; ;; Varia ;; From a5f26871adada41e4e9cd40c77fbe446934890a5 Mon Sep 17 00:00:00 2001 From: onodrim Date: Wed, 21 Jan 2026 12:13:27 +0100 Subject: [PATCH 4/6] chore: run assertion tests with ODRL config - Split the actual assertions to a separate function so they can be reused in multiple scenarios. - Added specific functions to run the assertion tests with either ACL or ODRL config to allow testing these flows independently. - Let `run-assertion-tests` execute the scenario twice, first with an ACL config and second with the same config in ODRL. - Removed previous example configs in favour of config used in test scenarios --- odrl/parse-ntriples.lisp | 2 +- odrl/config.nt => test/example-config.nt | 0 odrl/config.ttl => test/example-config.ttl | 0 test/scenario.lisp | 349 ++++++++++++--------- 4 files changed, 210 insertions(+), 141 deletions(-) rename odrl/config.nt => test/example-config.nt (100%) rename odrl/config.ttl => test/example-config.ttl (100%) diff --git a/odrl/parse-ntriples.lisp b/odrl/parse-ntriples.lisp index 4e7967e..de4f184 100644 --- a/odrl/parse-ntriples.lisp +++ b/odrl/parse-ntriples.lisp @@ -14,7 +14,7 @@ If FILENAME is nil, fall back to the \"config\" as default name for the policy file." (if (find :docker *features*) (concatenate 'string "../config/" (or filename "config") ".nt") - "odrl/config.nt")) + "test/example-config.nt")) (defun read-ntriples-file (path) "Read the n-triples file `policy-file' and return its contents as a single string." diff --git a/odrl/config.nt b/test/example-config.nt similarity index 100% rename from odrl/config.nt rename to test/example-config.nt diff --git a/odrl/config.ttl b/test/example-config.ttl similarity index 100% rename from odrl/config.ttl rename to test/example-config.ttl diff --git a/test/scenario.lisp b/test/scenario.lisp index 2b1b824..bcf1630 100644 --- a/test/scenario.lisp +++ b/test/scenario.lisp @@ -177,6 +177,45 @@ ,@body)) +;; TODO: Copied and modified from `with-acl-config', could probably reduce the code duplication +(defmacro with-odrl-config (&body body) + "Executes body with the access rights specification required for these tests." + `(let ((prefix::*prefixes* nil) + (acl::*access-specifications* nil) + (acl::*graphs* nil) + (acl::*rights* nil) + (delta-messenger::*delta-handlers* nil) + (client::*backend* "http://localhost:8891/sparql") + (client::*log-sparql-query-roundtrip* t) + (type-cache::*uri-graph-user-type-providers* nil) + (quad-transformations::*user-quad-transform-functions* nil)) + + (type-cache::add-type-for-prefix "http://book-store.example.com/books/" "http://schema.org/Book") + + (quad-transformations:define-quad-transformation (quad method) + ;; make quad objects which have datatype in uuid specification just strings + (if (and + ;; predicate is uuid + (string= (quad-term:uri (quad:predicate quad)) + "http://mu.semte.ch/vocabularies/core/uuid") + ;; object has datatype + (= (length (sparql-parser:match-submatches (quad:object quad))) 3)) + (let ((new-quad (quad:copy quad))) ; make new quad + (setf (quad:object new-quad) + (sparql-manipulation:make-nested-match + `(ebnf::|RDFLiteral| ,(first (sparql-parser:match-submatches (quad:object quad)))))) + ;; use the new quad + (quad-transformations:update new-quad)) + ;; otherwise keep it + (quad-transformations:keep))) + + ;; Read and load configuration from example file containing ODRL policy + (odrl-config::odrl-to-acl + (odrl-config::make-rule-set + (odrl-config::load-policy-file))) + + ,@body)) + (defmacro with-impersonation-for (user &body body) "Impersonates USER." `(server::with-call-context @@ -212,17 +251,14 @@ this point and likely a redpencil image too.") ;;;; Scenario ;;;; Boot up a container using: ;;;; docker run --name virtuoso -p 8891:8890 -e SPARQL_UPDATE=true -e "DEFAULT_GRAPH=http://mu.semte.ch/application" redpencil/virtuoso:1.2.0-rc.1; dr rm virtuoso -(defun run-assertion-tests () - (clean-up-graphs) - (store-initial-session-data) - - (with-acl-config - (format t "~&Joll is an administrator.~%") - (with-impersonation-for :joll - (format t "~&Can add authors.~%") - - (server:execute-query-for-context - "PREFIX foaf: +(defun assertion-tests () + "Set of assertions tests for this service." + (format t "~&Joll is an administrator.~%") + (with-impersonation-for :joll + (format t "~&Can add authors.~%") + + (server:execute-query-for-context + "PREFIX foaf: PREFIX schema: PREFIX authors: @@ -235,9 +271,9 @@ this point and likely a redpencil image too.") foaf:name \"Daniel Kahneman\". }") - (format t "~&Can add authors. (2)~%") - (server:execute-query-for-context - "PREFIX foaf: + (format t "~&Can add authors. (2)~%") + (server:execute-query-for-context + "PREFIX foaf: PREFIX schema: PREFIX authors: PREFIX books: @@ -254,10 +290,10 @@ this point and likely a redpencil image too.") schema:creator authors:daniel. }") - (format t "~&Can add extra book for author.~%") + (format t "~&Can add extra book for author.~%") - (server:execute-query-for-context - "PREFIX foaf: + (server:execute-query-for-context + "PREFIX foaf: PREFIX schema: PREFIX authors: PREFIX books: @@ -268,10 +304,10 @@ this point and likely a redpencil image too.") schema:creator authors:david . }") - (format t "~&Can add extra author to book.~%") + (format t "~&Can add extra author to book.~%") - (server:execute-query-for-context - "PREFIX foaf: + (server:execute-query-for-context + "PREFIX foaf: PREFIX schema: PREFIX authors: PREFIX books: @@ -282,12 +318,12 @@ this point and likely a redpencil image too.") books:abundance schema:creator authors:steven, authors:peter. }")) - (with-impersonation-for :jack - (format t "~&Jack is a user.~%") + (with-impersonation-for :jack + (format t "~&Jack is a user.~%") - (format t "~&Jack can add a favorite.~%") - (server:execute-query-for-context - "PREFIX foaf: + (format t "~&Jack can add a favorite.~%") + (server:execute-query-for-context + "PREFIX foaf: PREFIX schema: PREFIX authors: PREFIX books: @@ -298,10 +334,10 @@ this point and likely a redpencil image too.") favorites:me ext:hasBook books:gtd, books:fastAndSlow. }") - ;; jack likes all authors of the book Abundance - (format t "~&Jack can add conditional favorite authors.~%") - (server:execute-query-for-context - "PREFIX foaf: + ;; jack likes all authors of the book Abundance + (format t "~&Jack can add conditional favorite authors.~%") + (server:execute-query-for-context + "PREFIX foaf: PREFIX schema: PREFIX authors: PREFIX books: @@ -313,12 +349,12 @@ this point and likely a redpencil image too.") } WHERE { books:abundance schema:creator ?author. }") - ;; this data has no place to live, the target must be a foaf:Person and it is a book. - (format t "~&Jack can't add books as favorite author.~%") - (handler-case - (progn - (server:execute-query-for-context - "PREFIX foaf: + ;; this data has no place to live, the target must be a foaf:Person and it is a book. + (format t "~&Jack can't add books as favorite author.~%") + (handler-case + (progn + (server:execute-query-for-context + "PREFIX foaf: PREFIX schema: PREFIX authors: PREFIX books: @@ -330,12 +366,12 @@ this point and likely a redpencil image too.") } WHERE { books:abundance schema:creator/^schema:creator ?book. }") - (format t "~&ERROR: Oh noes, Jack shouldn't be allowed to do add a book as an author!~%")) - (error (e) (declare (ignore e)) t)) - ;; let's check if jack has favorite authors - (format t "~&Jack can ask for favorite authors.~%") - (server:execute-query-for-context - "PREFIX foaf: + (format t "~&ERROR: Oh noes, Jack shouldn't be allowed to do add a book as an author!~%")) + (error (e) (declare (ignore e)) t)) + ;; let's check if jack has favorite authors + (format t "~&Jack can ask for favorite authors.~%") + (server:execute-query-for-context + "PREFIX foaf: PREFIX schema: PREFIX authors: PREFIX books: @@ -345,10 +381,10 @@ this point and likely a redpencil image too.") ASK { favorites:me ext:hasFavoriteAuthor ?author. }") - ;; then let's describe the values - (format t "~&Jack can describe favorite authors.~%") - (server:execute-query-for-context - "PREFIX foaf: + ;; then let's describe the values + (format t "~&Jack can describe favorite authors.~%") + (server:execute-query-for-context + "PREFIX foaf: PREFIX schema: PREFIX authors: PREFIX books: @@ -359,11 +395,11 @@ this point and likely a redpencil image too.") favorites:me ext:hasFavoriteAuthor ?author. }") - ;; now let's replace the favorite author in two queries rather - ;; than in one - (format t "~&Jack can execute delete where and insert data in one query.~%") - (server:execute-query-for-context - "PREFIX foaf: + ;; now let's replace the favorite author in two queries rather + ;; than in one + (format t "~&Jack can execute delete where and insert data in one query.~%") + (server:execute-query-for-context + "PREFIX foaf: PREFIX schema: PREFIX authors: PREFIX books: @@ -381,37 +417,37 @@ this point and likely a redpencil image too.") } }")) - (with-impersonation-for :joll - (quad-transformations:define-quad-transformation (quad method) - ;; fix wktLiteral string representation - (let* ((object (quad:object quad)) - (datatype-match (and - (sparql-parser:match-p object) + (with-impersonation-for :joll + (quad-transformations:define-quad-transformation (quad method) + ;; fix wktLiteral string representation + (let* ((object (quad:object quad)) + (datatype-match (and + (sparql-parser:match-p object) + (eq (sparql-parser:match-term object) 'ebnf::|RDFLiteral|) + (= 3 (length (sparql-parser:match-submatches object))) + (third (sparql-parser:match-submatches object)))) + (datatype-uri (and datatype-match + (quad-term:uri + (first + (sparql-parser:match-submatches datatype-match))))) + (string-value (and (sparql-parser:match-p object) (eq (sparql-parser:match-term object) 'ebnf::|RDFLiteral|) - (= 3 (length (sparql-parser:match-submatches object))) - (third (sparql-parser:match-submatches object)))) - (datatype-uri (and datatype-match - (quad-term:uri - (first - (sparql-parser:match-submatches datatype-match))))) - (string-value (and (sparql-parser:match-p object) - (eq (sparql-parser:match-term object) 'ebnf::|RDFLiteral|) - (sparql-manipulation:string-literal-string - (first (sparql-parser:match-submatches object)))))) - (if (and datatype-uri - (string= "http://www.opengis.net/ont/geosparql#wktLiteral" datatype-uri) - (search "https://www.opengis.net/" string-value)) - (let ((new-quad (quad:copy quad)) - (new-string (cl-ppcre:regex-replace "https://" string-value "http://"))) - (setf (quad:object new-quad) - (sparql-manipulation:make-rdfliteral new-string :datatype-match datatype-match)) - (quad-transformations:update new-quad)) - (quad-transformations:keep)))) - - (format t "~&Joll can write a book title with the right URI and no type.~%") - - (server:execute-query-for-context - "PREFIX foaf: + (sparql-manipulation:string-literal-string + (first (sparql-parser:match-submatches object)))))) + (if (and datatype-uri + (string= "http://www.opengis.net/ont/geosparql#wktLiteral" datatype-uri) + (search "https://www.opengis.net/" string-value)) + (let ((new-quad (quad:copy quad)) + (new-string (cl-ppcre:regex-replace "https://" string-value "http://"))) + (setf (quad:object new-quad) + (sparql-manipulation:make-rdfliteral new-string :datatype-match datatype-match)) + (quad-transformations:update new-quad)) + (quad-transformations:keep)))) + + (format t "~&Joll can write a book title with the right URI and no type.~%") + + (server:execute-query-for-context + "PREFIX foaf: PREFIX schema: PREFIX authors: PREFIX books: @@ -422,10 +458,10 @@ this point and likely a redpencil image too.") schema:name \"On Types\". }") - (format t "~&Effective changes contain only the data that was actually changed, which is:~%- insert \"On types too.\"~%- delete \"On types too.\"~%") + (format t "~&Effective changes contain only the data that was actually changed, which is:~%- insert \"On types too.\"~%- delete \"On types too.\"~%") - (server:execute-query-for-context - "PREFIX foaf: + (server:execute-query-for-context + "PREFIX foaf: PREFIX schema: PREFIX authors: PREFIX books: @@ -436,9 +472,9 @@ this point and likely a redpencil image too.") schema:name \"On Types\", \"On Types Too\". }") - (let ((support:*string-max-size* 50)) - (server:execute-query-for-context - "PREFIX foaf: + (let ((support:*string-max-size* 50)) + (server:execute-query-for-context + "PREFIX foaf: PREFIX schema: PREFIX authors: PREFIX books: @@ -449,13 +485,13 @@ this point and likely a redpencil image too.") ext:longContent \"This is a string which has more than 50 characters in length\", \"String < 50 chars\" . }") - (format t "~&Matches yield following content for long content: ~%~A" - (server:execute-query-for-context - "PREFIX ext: + (format t "~&Matches yield following content for long content: ~%~A" + (server:execute-query-for-context + "PREFIX ext: SELECT ?content WHERE { ext:longContent ?content }")) - (server:execute-query-for-context - "PREFIX foaf: + (server:execute-query-for-context + "PREFIX foaf: PREFIX schema: PREFIX authors: PREFIX books: @@ -466,8 +502,8 @@ this point and likely a redpencil image too.") ext:longContent \"This is a string which has more than 50 characters in length\", \"String < 50 chars\" . }")) - (server:execute-query-for-context - "PREFIX foaf: + (server:execute-query-for-context + "PREFIX foaf: PREFIX schema: PREFIX authors: PREFIX books: @@ -482,10 +518,10 @@ this point and likely a redpencil image too.") schema:name ?title. }") - ;; we can delete the types + ;; we can delete the types - (server:execute-query-for-context - "PREFIX foaf: + (server:execute-query-for-context + "PREFIX foaf: PREFIX schema: PREFIX authors: PREFIX books: @@ -496,21 +532,21 @@ this point and likely a redpencil image too.") schema:name \"On Types\". }") - ;; we can have an empty construct where + ;; we can have an empty construct where - (server:execute-query-for-context - "CONSTRUCT { } WHERE { }") + (server:execute-query-for-context + "CONSTRUCT { } WHERE { }") - ;; inserting the UUID with xsd:string will just insert the UUID (configured above) + ;; inserting the UUID with xsd:string will just insert the UUID (configured above) - (server:execute-query-for-context - "PREFIX xsd: + (server:execute-query-for-context + "PREFIX xsd: PREFIX mu: INSERT DATA { mu:uuid \"123\"^^xsd:string. }") - (when *run-geosparql-tests* - (server:execute-query-for-context - "PREFIX xsd: + (when *run-geosparql-tests* + (server:execute-query-for-context + "PREFIX xsd: PREFIX ext: PREFIX mu: PREFIX geo: @@ -520,62 +556,58 @@ this point and likely a redpencil image too.") geo:asWKT \" POINT (155822.2 132723.18)\"^^. }"))) - (with-impersonation-for :jack - ;; can insert some random content - (server:execute-query-for-context - "PREFIX ext: + (with-impersonation-for :jack + ;; can insert some random content + (server:execute-query-for-context + "PREFIX ext: INSERT DATA { ext:myDisplay a ext:NoNameOrLabel; ext:score 9001; ext:level 12. }") - ;; can't insert name or label - (block :no-error - (handler-case - (server:execute-query-for-context - "PREFIX ext: + ;; can't insert name or label + (block :no-error + (handler-case + (server:execute-query-for-context + "PREFIX ext: INSERT DATA { ext:myDisplay ext:name \"Failing name\". }") - (handle-update-unit:unwritten-data-error (e) - (format t "Received expected error ~A" e) - (return-from :no-error t))) - (error 'simple-error :format-control "Expected triples not being written, but received no error.")) - (block :no-error - (handler-case - (server:execute-query-for-context - "PREFIX ext: + (handle-update-unit:unwritten-data-error (e) + (format t "Received expected error ~A" e) + (return-from :no-error t))) + (error 'simple-error :format-control "Expected triples not being written, but received no error.")) + (block :no-error + (handler-case + (server:execute-query-for-context + "PREFIX ext: INSERT DATA { ext:myDisplay ext:label \"Failing label\". }") - (handle-update-unit:unwritten-data-error (e) - (format t "Received expected error ~A" e) - (return-from :no-error t))) - (error 'simple-error :format-control "Expected triples not being written, but received no error.")) - (server:execute-query-for-context - "PREFIX ext: + (handle-update-unit:unwritten-data-error (e) + (format t "Received expected error ~A" e) + (return-from :no-error t))) + (error 'simple-error :format-control "Expected triples not being written, but received no error.")) + (server:execute-query-for-context + "PREFIX ext: INSERT DATA { ext:myDisplay ext:anotherThing \"Another thing\". }")) - ;; jack can delete (which should use CONSTRUCT) - (with-impersonation-for :jack - (server:execute-query-for-context - "PREFIX ext: + ;; jack can delete (which should use CONSTRUCT) + (with-impersonation-for :jack + (server:execute-query-for-context + "PREFIX ext: DELETE { ext:myDisplay ext:score ?score; ext:level ?level. } WHERE { ext:myDisplay a ext:NoNameOrLabel; ext:score ?score; ext:level ?level. - }")))) + }"))) -(defun run-delta-only-assertion-tests () - "Tests whether we can use graphs which only have emit data through delta-notifier but not through sparql" - ;; TODO: it would be good if this test would also verify data is effectively creating delta messages but that's not - ;; the case yet. - (with-acl-config - (client:query (coerce +(defun delta-only-assertion-tests () + (client:query (coerce "DELETE { GRAPH ?g { ?s ?p ?o } } WHERE { @@ -604,4 +636,41 @@ this point and likely a redpencil image too.") SELECT * WHERE { ?thing a push:Update. }")) - "results" "bindings"))))))) + "results" "bindings")))))) + +(defun run-assertion-tests-with-acl () + "Run the `assertion-tests' with an ACL configuration." + (format t "~%~% Running assertion tests with ACL config") + (clean-up-graphs) + (store-initial-session-data) + + (with-acl-config (assertion-tests))) + +(defun run-assertion-tests-with-odrl () + "Run the `assertion-tests' with an ODRL configuration." + (format t "~%~% Running assertion tests with ODRL config") + (clean-up-graphs) + (store-initial-session-data) + + (with-odrl-config (assertion-tests))) + +(defun run-assertion-tests () + (run-assertion-tests-with-acl) + (run-assertion-tests-with-odrl)) + +(defun run-delta-only-assertion-tests-acl () + (format t "~%~% Running delta only assertion tests with ACL config") + (with-acl-config (delta-only-assertion-tests))) + +;; TODO: This test currently fails since ODRL policies do not yet support the extra options that can +;; be passed to graph specifications. +(defun run-delta-only-assertion-tests-odrl () + (format t "~%~% Running delta only assertion tests with ODRL config") + (with-odrl-config (delta-only-assertion-tests))) + +(defun run-delta-only-assertion-tests () + "Tests whether we can use graphs which only have emit data through delta-notifier but not through sparql" + ;; TODO: it would be good if this test would also verify data is effectively creating delta messages but that's not + ;; the case yet. + (run-delta-only-assertion-tests-acl) + (run-delta-only-assertion-tests-odrl)) From 1d7af24df8c1fc3fa3482e05ab7573a74f2fb0f6 Mon Sep 17 00:00:00 2001 From: onodrim Date: Fri, 23 Jan 2026 07:56:16 +0100 Subject: [PATCH 5/6] feat: allow loading ODRL policy on service startup - Ensure any n-triples configuration is copied from the mounted config volume. - Conditionally load policy from n-triples file if `odrl-config::*use-odrl-config-p*` is set to a non-nil value. - The original lisp config confi is still evaluated as before to allow using to configure the service by setting parameters/variables. But loading an ODRL config first clears the ACL variables to remove any policy elements that would be defined in the lisp config. --- launch-sparql-parser.sh | 2 +- odrl/load-config.lisp | 13 +++++++++++++ odrl/odrl.lisp | 3 +++ sparql-parser.asd | 3 ++- 4 files changed, 19 insertions(+), 2 deletions(-) create mode 100644 odrl/load-config.lisp diff --git a/launch-sparql-parser.sh b/launch-sparql-parser.sh index 94a9399..6182428 100755 --- a/launch-sparql-parser.sh +++ b/launch-sparql-parser.sh @@ -1,6 +1,6 @@ #!/bin/bash mkdir -p /config -cp /config/*.lisp /app/config/ +cp /config/*.{lisp,nt} /app/config/ exec /usr/src/startup.sh diff --git a/odrl/load-config.lisp b/odrl/load-config.lisp new file mode 100644 index 0000000..d48da78 --- /dev/null +++ b/odrl/load-config.lisp @@ -0,0 +1,13 @@ +(in-package :cl-user) + +(when odrl-config::*use-odrl-config-p* + (format t "~& >> Loading configuration via ODRL") + ;; TODO: this is dirty + ;; Remove any configuration that was loaded by evaluating lisp config + (setf acl::*access-specifications* nil) + (setf acl::*graphs* nil) + (setf acl::*rights* nil) + ;; Load ODRL, if any + (alexandria:if-let ((triples (odrl-config::load-policy-file))) + (odrl-config::odrl-to-acl (odrl-config::make-rule-set triples)) + (format t "~&~%~%NO ODRL CONFIG MOUNTED; BOOTING WITH EMPTY CONFIGURATION~%~%"))) diff --git a/odrl/odrl.lisp b/odrl/odrl.lisp index 572e051..e6e27db 100644 --- a/odrl/odrl.lisp +++ b/odrl/odrl.lisp @@ -1,5 +1,8 @@ (in-package :odrl-config) +(defparameter *use-odrl-config-p* nil + "Non-nil means the service should load its policy from a file containing an ODRL policy.") + ;; ODRL information model ;; ;; An implementation of a simplified version of the ODRL information model. This implementation is diff --git a/sparql-parser.asd b/sparql-parser.asd index 29de6d3..28c4587 100644 --- a/sparql-parser.asd +++ b/sparql-parser.asd @@ -65,4 +65,5 @@ ;; administration (:file "administration/string-files") ;; configuration - (:file "config/config"))) + (:file "config/config") + (:file "odrl/load-config"))) From dc27c456663867cafd8ce60ea2660c170059a5a1 Mon Sep 17 00:00:00 2001 From: onodrim Date: Fri, 23 Jan 2026 16:20:49 +0100 Subject: [PATCH 6/6] chore(doc): updated README --- README.md | 70 +++++++++++++++++++++++++++++++++++++++++++++++++++++++ 1 file changed, 70 insertions(+) diff --git a/README.md b/README.md index 1827a9d..a50bdc1 100644 --- a/README.md +++ b/README.md @@ -396,6 +396,76 @@ Using the `:scopes` parameter notation it is possible to provide multiple scope :scopes '("http://services.semantic.works/people-service" "http://services.semantic.works/another-service")) ``` + +### Defining an authorization policy in ODRL + +> [!WARNING] +> Support for ODRL policies is under development and some functionality, such as using scopes, is not yet (fully) supported. + +This service also supports defining policies using [ODRL](https://www.w3.org/TR/odrl-model/), as an alternative to the lisp-style configuration illustrated above. To enable ODRL policies, set `*use-odrl-config-p*` to non-nil in the config file mounted in `./config/authorization/config.lisp` as shown below. Note, other service configuration settings, such as `*backend*`, should still be set in the same file. + +```lisp +;;;;;;;;;;;;;;;;;;; +;;; delta messenger +(in-package :delta-messenger) + +(add-delta-logger) +(add-delta-messenger "http://delta-notifier/") + +;;;;;;;;;;;;;;;;; +;;; configuration +(in-package :client) +(setf *log-sparql-query-roundtrip* t) +(setf *backend* "http://triplestore:8890/sparql") + +(in-package :server) +(setf *log-incoming-requests-p* nil) + +(in-package :odrl-config) +(setf *use-odrl-config-p* t) +``` + +The actual policy should be defined in [n-triples](https://www.w3.org/TR/n-triples/) format in a config file mounted in `./config/authorization/config.nt`. The following snippet contains the ODRL equivalent, encoded in ttl format, for the lisp access rights shown in the previous section. Note, to use this policy it should be converted from ttl to n-triples. A more comprehensive policy example can be found in the [test config]('./test/exmaple-config.ttl'). + +```ttl +@prefix ext: . +@prefix odrl: . +@prefix sh: . +@prefix vcard: . + +ext:examplePolicy a odrl:Set ; + odrl:permission ext:publicRead , + ext:publicWrite. + +ext:publicGraph a odrl:AssetCollection ; + vcard:fn "public" ; + ext:graphPrefix . + +ext:genericAsset a odrl:Asset , sh:NodeShape ; + odrl:partOf ext:publicGraph ; + sh:targetClass ext:all . + +ext:publicParty a odrl:PartyCollection ; + vcard:fn "public" . + +ext:publicRead a odrl:Permission ; + odrl:action odrl:read ; + odrl:target ext:publicGraph ; + odrl:assignee ext:publicParty . + +ext:publicWrite a odrl:Permission ; + odrl:action odrl:modify ; + odrl:target ext:publicGraph ; + odrl:assignee ext:publicParty . +``` + + +The following functionality is *not* yet supported when using an ODRL policy: +- Read policy from a ttl file instead of an n-triples file. Support ttl files is planned, the use of n-triples files is a temporary workaround due to lack of ttl parser in common lisp. +- Specifying `scopes` for a permission. +- Specifying an explicit `constraint` for an `allowed-group`, currently this is implicitly set based on whether a query is provided or not. +- Specifying options, such as whether to generate deltas, per graph definition. + ## Reference ### ACL configuration interface #### `define-graph`