Coverage report: /development/source/library/org/datagraph/spocq-shard/src/spocq-server/extensions/linked-data-platform.lisp

Kind	Covered	All	%
expression	5	938	0.5
branch	1	108	0.9

Key

Not instrumented

Conditionalized out

Executed

Not executed

Both branches taken

One branch taken

Neither branch taken

1

 ;;; -*- Mode: lisp; Syntax: ansi-common-lisp; Base: 10; Package: org.datagraph.spocq.server.implementation; -*-

2

3

4

(in-package :org.datagraph.spocq.implementation)

5

6

(:documentation "linked data platform protocol"

7

8

"This file implements the internal operators for a linked data platform service.

9

10

The functions apply to ldp:resource instances and implement the ldp operations

11

in the context of a single repository.

12

The repository is identified for both direct and indirect references by the

13

path present in the absolute url.

14

Each response function establishes a dynamic context which includes a read or

15

read/write transaction for the respective repository.

16

17

This means that the authorization follows the same logic as sparql and gsp:

18

19

- first determine the account and the repository as a function of the host

20

- then establish agent identity wrt the account and/or request authentication

21

properties

22

- verify agent authorization for the resource wrt the account/repository acl

23

values

24

25

Indirect identification is the intended pattern.

26

The repository identity is not reflected in the resource identifiers, as a

27

consequence of which, the authorization is independent of target resource.

28

It would be possible to implement delegated authorization by authorizing

29

first with the direct resource as target and then adopting its user/account

30

as the agent to authorize against the indirect resource.

31

")

32

33

;;; (load "/development/source/library/org/datagraph/spocq/src/server/ldp.lisp")

34

35

(defpackage :org.datagraph.ldp

36

(:nicknames :ldp :ldp)

37

(:export :*max-member-count*

38

:*max-triple-count*

39

:resource-delete

40

:resource-get

41

:resource-patch

42

:resource-post

43

:resource-put

44

45

:basic-container

46

:basic-container-p

47

:compute-member-iri

48

:compute-resource

49

:container

50

:container-is-member-of-relation

51

:container-has-member-relation

52

:container-membership-resource

53

:container-p

54

:direct-container

55

:direct-container-p

56

:ensure-resource

57

:ensure-instance

58

:find-instance

59

:find-resource

60

:indirect-container

61

:indirect-container-p

62

:hasMemberRelation

63

:isMemberOfRelation

64

:load-resource

65

:non-rdf-source

66

:rdf-source

67

:resource

68

:resource-class

69

:resource-location

70

:resource-locations

71

:resource-p

72

:resource-repository

73

:resource-triples

74

:resource-type

75

:typed-resource

76

:typed-resource-p

77

))

78

79

(defpackage "http://www.w3.org/ns/ldp#"

80

(:use )

81

(:nicknames "ldp")

82

(:export "constainedBy"

83

"contains"

84

"hasMemberRelation"

85

"insertedContentRelation"

86

"isMemberOfRelation"

87

"member"

88

"membershipResource"

89

"pageSequence"

90

"pageSortCollation"

91

"pageSortCriteria"

92

"pageSortOrder"

93

"pageSortPredicate"

94

"Ascending"

95

"BasicContainer"

96

"Container"

97

"Descending"

98

"DirectContainer"

99

"IndirectContainer"

100

"MemberSubject"

101

"NonRDFSource"

102

"Page"

103

"PageSortCriterion"

104

"PreferContainment"

105

"PreferEmptyContainer"

106

"PreferMembership"

107

"PreferMinimalContainer"

108

"RDFSource"

109

"Resource"))

110

111

(eval-when (:compile-toplevel :load-toplevel :execute)

112

(cl-user::add-iri-package "http://www.w3.org/ns/ldp#"))

113

114

(defvar *linked-data-platform.describe-type* nil)

115

116

(defvar ldp:*max-triple-count* nil)

117

(defvar ldp:*max-member-count* nil)

118

119

(defparameter *transitive-containment-properties* '(|ldp|:|member| |ldp|:|contains|)

120

"specifies the properties to be deleted recursively. the default list includes the

121

concrete properties ldp:member and ldp:contains only.

122

All others defined by the presence of a |ldp|:|membershipResource| assertion,

123

must be specified per configuration.")

124

125

 (defmethod (setf spocq.i:configuration-parameter) ((value list) (parameter (eql :transitive-containment-properties)))

126

(assert (every #'stringp value) ()

127

"Invalid containment properts list: ~s" value)

128

(setq *transitive-containment-properties*

129

(loop for property in value collect (intern-iri property))))

130

131

;;; (report-virtual-repository-hosts #p"/tmp/vhosts.txt" :upstream-host "spocq-ldp")

132

;;; (report-virtual-repository-hosts nil :upstream-host "spocq-ldp")

133

134

(defclass ldp:resource-class (cached-persistent-class)

135

((spocq.i::cache

136

:allocation :class

137

;; use a cache which is weak-keyed as those are the means of reference

138

:initform (make-registry :weakness :key :test 'equalp)

139

     :documentation "The cache for resource is allocated for the abstract class only, in order that the are shared

140

independent of class.")))

141

142

(defclass ldp:resource (persistent-graph-object cached-persistent-object)

143

((triples

144

:initform nil :initarg :triples

145

:reader ldp::get-resource-triples :writer ldp::setf-resource-triples

146

:documentation "The application-level data is this list of triples.

147

LDP operators target this set of triples for gets and for put/post modification.

148

The persistence protocol handles transformation between this and the source graph

149

as well as the read/write synchronization")

150

(repository

151

:initarg :repository :reader ldp::resource-repository))

152

(:metaclass ldp:resource-class)

153

(:documentation "The primary addition for an ldp:resource is its triple set.

154

For a simple rdf source, this is an arbitrary statement set.

155

For a container, this is the statement et in the container."))

156

157

(defmethod compute-resource-store-repository-id ((instance ldp:resource))

158

(compute-resource-store-repository-id (ldp::resource-repository instance)))

159

160

(defun ldp:resource-p (object)

161

(typep object 'ldp:resource))

162

163

(defclass ldp:typed-resource (ldp:resource)

164

()

165

(:metaclass ldp:resource-class)

166

(:documentation "A protocol class to indicate that the type is fixed, even when the

167

resource is new and, as a consequence, no persistent data is present"))

168

169

(defun ldp:typed-resource-p (object)

170

(typep object 'ldp:typed-resource))

171

172

(defclass ldp:rdf-source (ldp:typed-resource ldp:resource)

173

()

174

(:metaclass ldp:resource-class))

175

176

(defclass ldp:non-rdf-source (ldp:resource)

177

())

178

179

(defclass ldp:container (ldp:rdf-source cached-persistent-graph-object)

180

()

181

(:metaclass ldp:resource-class))

182

183

(defun ldp:container-p (object)

184

(typep object 'ldp:container))

185

186

(defclass ldp:basic-container (ldp:container)

187

()

188

(:metaclass ldp:resource-class))

189

190

(defun ldp:basic-container-p (object)

191

(typep object 'ldp:basic-container))

192

193

(defclass ldp:direct-container (ldp:container)

194

((is-member-of-relation

195

:initarg :is-member-of-relation

196

:accessor ldp:container-is-member-of-relation)

197

(member-relation

198

:initarg :member-relation

199

:accessor ldp:container-has-member-relation)

200

(membership-resource

201

:initarg :membership-resource

202

:accessor ldp:container-membership-resource))

203

(:metaclass ldp:resource-class))

204

205

(defun ldp:direct-container-p (object)

206

(typep object 'ldp:direct-container))

207

208

(defclass ldp:indirect-container (ldp:container)

209

()

210

(:metaclass ldp:resource-class))

211

212

(defun ldp:indirect-container-p (object)

213

(typep object 'ldp:indirect-container))

214

215

 (defmethod initialize-instance ((instance ldp:resource) &rest args &key (repository (error "repository is required.")))

216

(declare (dynamic-extent args))

217

(apply #'call-next-method instance

218

:store-repository-id (repository-id repository)

219

args))

220

221

(defmethod initialize-instance ((instance ldp:direct-container) &rest args

222

&key has-member-relation is-member-of-relation

223

identifier

224

(membership-resource identifier))

225

(declare (dynamic-extent args))

226

(assert (and (or has-member-relation is-member-of-relation)

227

(not (and has-member-relation is-member-of-relation)))

228

()

229

"Invalid direct container membership: ~a - ~a"

230

has-member-relation is-member-of-relation)

231

(call-next-method instance

232

:membership-resource membership-resource

233

args))

234

235

 (defmethod initialize-instance ((instance ldp:indirect-container) &key has-member-relation is-member-of-relation)

236

(assert (and (or has-member-relation is-member-of-relation)

237

(not (and has-member-relation is-member-of-relation)))

238

()

239

"Invalid direct container membership: ~a - ~a"

240

has-member-relation is-member-of-relation)

241

(call-next-method))

242

243

244

(defgeneric ldp::resource-media-type (object)

245

(:method ((field list))

246

     (let ((type-statement (find <https://w3id.org/rdfp/mediaType> field :key #'statement-predicate :test #'iri-equal)))

247

(when type-statement (spocq.i::url-mime-type (statement-object type-statement)))))

248

(:method ((resource ldp:resource))

249

(ldp::resource-media-type (ldp:resource-triples resource))))

250

251

;;; processing components

252

253

(defclass ldp-task (data-task)

254

())

255

256

(defun ldp-task-p (object)

257

(typep object 'ldp-task))

258

259

(defun make-ldp-task (&rest args)

260

(declare (dynamic-extent args))

261

(apply #'make-instance 'ldp-task args))

262

263

(defmethod query-dynamic-bindings ((task ldp-task))

264

nil)

265

266

(defun slice-ldp-sequence (sequence &key page limit)

267

(if page

268

(values (loop for solution in (nthcdr (* (1- page) limit) sequence)

269

for i below limit

270

collect solution)

271

(ceiling (length sequence) limit))

272

sequence))

273

274

#+(or)

275

;; given just a max triple count, page the member content to try to get everything

276

;; respective a given member onto the same page.

277

;; first, correlate the member pages, then slice the collections,

278

;; then flatten those which fit.

279

(let ((paged-member-content (make-registry)))

280

(loop for id in member-identifiers

281

do (setf (gethash id paged-member-content) nil))

282

(loop with last-member-id = nil

283

with last-member-content = ()

284

for start = (* max-triple-count (or page 0))

285

for end = (+ start max-triple-count)

286

for statement in member-content

287

for id = (first statement)

288

do (progn

289

          (when (and (not (equal id last-member-id)) (nth-value 1 (gethash id paged-member-content)))

290

(setf (gethash id paged-member-content) (reverse last-member-content)

291

last-member-content ()

292

last-member-id id))

293

(push statement last-member-content)))

294

(append minimal-content ))

295

296

(defun slice-ldp-member-sequence (sequence &key (page 1) limit)

297

"given a list of statements and slice constraints in terms of page and page

298

size limit, return a flat sequence with member content which extends onto the

299

given page, but does not extend onto the next."

300

(unless page (setf page 1))

301

(let ((member-content (make-registry))

302

(members ()))

303

(loop for statement in sequence

304

for (subject predicate object) = statement

305

do (pushnew subject members)

306

do (push statement (gethash subject member-content)))

307

;; (print (sort (copy-list members) #'string-lessp :key #'iri-lexical-form))

308

(setf members (sort members #'string-lessp :key #'iri-lexical-form))

309

(loop for page-number from 1

310

while members

311

for page-content = (loop

312

with collected-subject-content = ()

313

with page-length = 0

314

for subject = (first members)

315

if subject

316

                            do (let* ((subject-content (gethash subject member-content))

317

(subject-length (length subject-content)))

318

(cond ((>= subject-length limit)

319

(cond (collected-subject-content

320

                                               (return (nreverse collected-subject-content)))

321

(t

322

(pop members)

323

                                               (return (list (reverse subject-content))))))

324

                                       ((> (+ page-length subject-length) limit)

325

                                        (return (nreverse collected-subject-content)))

326

(t

327

                                        (push (reverse subject-content) collected-subject-content)

328

(incf page-length subject-length)

329

(pop members))))

330

else return (nreverse collected-subject-content))

331

;; do (print (cons page-number page-content))

332

when (>= page-number page)

333

do (return (when (= page-number page) (reduce #'append page-content))))))

334

335

336

#+(or)

337

(loop for i from 1 below 5

338

collect (list :page i

339

:content (slice-ldp-member-sequence '((<http://example.org/1> 1 1)

340

                                                       (<http://example.org/1> 1 2)

341

                                                       (<http://example.org/1> 1 3)

342

                                                       (<http://example.org/2> 2 2)

343

                                                       (<http://example.org/3> 3 3)

344

                                                       (<http://example.org/a> e f)

345

                                                       (<http://example.org/a> e g)

346

                                                       (<http://example.org/a> e h)

347

                                                       (<http://example.org/a> e g)

348

                                                       (<http://example.org/b> x f)

349

                                                       (<http://example.org/b> x g)

350

                                                       (<http://example.org/b> x h)

351

                                                       (<http://example.org/c> x y))

352

                                                     :page i :limit 3)))

353

354

;;; generic api operators

355

356

(defgeneric ldp:resource-delete (resource)

357

(:documentation "Delete the given resource by removing its graph.

358

Iff the resource appears in a container, remove also its membership relation.")

359

(:method :before ((resource t))

360

;(print (compute-applicable-methods #'ldp:resource-delete (list resource)))

361

(when (typep resource *linked-data-platform.describe-type*)

362

(describe resource))))

363

364

(defgeneric ldp:resource-get (resource &key page include omit max-triple-count max-member-count revision)

365

(:documentation "GIven a resource, return its materialized triple field.

366

The operation differs according to resource type:

367

- ldp:RDFSource has whatever non-specific content is present in its graph

368

- ldp:BasicContainer includes the RDFSource content (including the ldp:contains assertions)

369

plus the contained resource content for a return value of include/omit

370

     - ldp:DirectContainer includes the RDFSource content (including the link declarations and the respective assertions)

371

plus the contained resource content for a return value of include/omit

372

     whereby member content is stored in a distinct graph for each respective member and must be consolidated")

373

(:method :after ((resource t) &key page include omit max-member-count max-triple-count revision)

374

(declare (ignore page include omit max-member-count max-triple-count revision))

375

(when (typep resource *linked-data-platform.describe-type*)

376

(print :after-resource-get)

377

(describe resource))))

378

379

(defgeneric ldp:resource-patch (resource specification)

380

(:documentation "Given a resource, perform the specified update operation.

381

Specializations support SPARQL update )in the form of a query) and rdf-graph

382

content (in the form of a triple field.")

383

(:method :before ((resource t) (specification t))

384

(when (typep resource *linked-data-platform.describe-type*)

385

(print :before-resource-patch)

386

(describe resource)

387

(print specification))))

388

389

(defgeneric ldp:resource-post (resource field &key member-identifier)

390

(:documentation "post content to another resource")

391

(:method ((resource ldp:resource) (field list) &rest args)

392

(declare (dynamic-extent args))

393

(multiple-value-bind (updated-resource updated-field)

394

(update-class-from-field resource field)

395

(apply #'ldp-resource-post updated-resource updated-field args)))

396

(:method ((resource ldp:typed-resource) field &rest args)

397

(declare (dynamic-extent args))

398

(apply #'ldp-resource-post resource field args)))

399

400

(defgeneric ldp-resource-post (resource field)

401

(:documentation "Post the given triple content into the given container resource.

402

The general parameters permit the identifier for the target resource only.

403

When the target is a container, the additional keword arguments 'key' and 'identifier'

404

are allowed to specify what to use to construct the member identifier.")

405

(:method :before ((resource t) (field t))

406

(when (typep resource *linked-data-platform.describe-type*)

407

(print :before-resource-post)

408

(describe resource)

409

(print field))))

410

411

(defgeneric ldp:resource-put (resource field)

412

(:method ((resource ldp:resource) field)

413

(multiple-value-bind (updated-resource updated-field)

414

;; presume an RDF source for put

415

                          (update-class-from-field resource field '|http://www.w3.org/ns/ldp#|:|RDFSource|)

416

(ldp-resource-put updated-resource updated-field)))

417

(:method ((resource ldp:typed-resource) field)

418

(ldp-resource-put resource field)))

419

420

(defgeneric ldp-resource-put (resource field)

421

(:documentation "Store new or replace the resource content.

422

Various constraints exist on the content depending on the resource type and upon whether

423

the resource is being created or modified.

424

- in all cases, limit the resource type in the field to at most one

425

- if a new resource has no type in the field, add an assertion respective the instance type,

426

which will have been derived from the request header

427

- if the resource exists, do not permit a type change (there are no subtypes)

428

- if the resource exists as a container, do not permit changes to contaiment statements.

429

that is, the put can patch content other than containment and type")

430

(:method :before ((resource t) (field t))

431

(when (typep resource *linked-data-platform.describe-type*)

432

(print :before-resource-put)

433

(describe resource)

434

(print field))))

435

436

437

;;;

438

439

(defmethod commit-resource :before ((resource t))

440

(when (typep resource *linked-data-platform.describe-type*)

441

(print :before-commit-resource)

442

(describe resource)

443

(print (list :triples (ldp::get-resource-triples resource)))

444

(print (list :graph (get-instance-store-graph resource)))))

445

(defmethod commit-resource :after ((resource t))

446

(when (typep resource *linked-data-platform.describe-type*)

447

(print :after-commit-resource)

448

(describe resource)))

449

(defmethod synchronize-resource :after ((resource t))

450

(when (typep resource *linked-data-platform.describe-type*)

451

(print :after-synchronize-resource)

452

(describe resource)))

453

454

(defgeneric ldp:load-resource (identifier)

455

(:documentation "Given an identifier, determine its class, create an instance

456

and load the state given the identifier.

457

When constructing the instance, capture the current active repository as its persistent store.")

458

(:method ((resource ldp:resource))

459

(read-resource resource)))

460

461

;;; (trace ldp:ensure-resource ldp:ensure-instance ldp:find-resource ldp:find-instance)

462

(defun ldp:ensure-resource (&rest args &key identifier repository)

463

"Given an identifier and a source repository, retrieve an existing instance

464

from the abstract cache class and if none is present, load it from the repository."

465

(declare (dynamic-extent args)

466

(ignore identifier repository))

467

(apply #'ldp:ensure-instance 'ldp:resource args))

468

469

(defgeneric ldp:ensure-instance (class &key identifier repository)

470

(:method ((class t) &rest args)

471

(declare (dynamic-extent args))

472

(apply #'ldp:find-instance class :if-does-not-exist :error args)))

473

474

(defun ldp:find-resource (&rest args &key identifier repository if-does-not-exist)

475

"Given an identifier and a source repository, retrieve an existing instance

476

from the abstract cache class. if none is present, look for it from the repository.

477

If none is present there, allow :if-does-not-exists to specify the outcome."

478

(declare (dynamic-extent args)

479

(ignore identifier repository if-does-not-exist))

480

(apply #'ldp:find-instance 'ldp:resource args))

481

482

;;; (clrhash (class-cache (find-class 'ldp:resource)))

483

(defgeneric ldp:find-instance (class &key identifier repository if-does-not-exist)

484

(:method ((class symbol) &rest args)

485

(declare (dynamic-extent args))

486

(apply #'ldp:find-instance (find-class class) args))

487

(:method ((class ldp:resource-class) &key identifier repository (if-does-not-exist :error))

488

(unless (typep identifier 'iri-designator)

489

(spocq.e:argument-type-error :operator 'ldp:find-instance :expected-type 'iri-designator

490

:datum identifier))

491

(let ((existing-instance (get-registry identifier (class-cache class))))

492

;(print (list :find-resource :existing existing-instance))

493

(cond (existing-instance

494

(values existing-instance t))

495

(t

496

              (let ((resource-class (ldp:resource-type  (repository-match-field repository <urn:dydra:all> identifier |rdf|:|type| nil))))

497

; (print (list :find-resource :class resource-class))

498

(cond (resource-class

499

(unless (subtypep resource-class class)

500

(error "invalid ldp class ~s" resource-class))

501

(ldp:load-resource (make-persistent-instance resource-class

502

                                                                    :identifier identifier

503

                                                                    :repository repository)))

504

(t

505

(ecase if-does-not-exist

506

((nil) nil)

507

(:error

508

(http:not-found "Undefined resource: ~a" identifier)))))))))))

509

510

(defgeneric ldp:resource (identifier &rest args)

511

(:documentation "Given an identifier, locate the instance or instantiate it.

512

    In the second case, either retrieve the projection from the persistent state or make a new instance.

513

If retrieved, the type is part of the state. If created anew, the type can appear either as a

514

request header or in the content itself.")

515

(:method ((identifier string) &rest args &key (repository *repository*) &allow-other-keys)

516

(apply #'ldp:ensure-resource :identifier (intern-iri identifier) :repository repository args))

517

(:method ((identifier spocq:iri) &rest args &key (repository *repository*) &allow-other-keys)

518

(apply #'ldp:ensure-resource :identifier identifier :repository repository args))

519

(:method ((resource ldp:resource) &rest args)

520

(declare (ignore args))

521

resource))

522

523

(defgeneric ldp:resource-type (object)

524

(:method ((field list))

525

(let ((types (intersection '(|ldp|:|Resource| ;; recommendation examples us also the abstract type

526

|ldp|:|RDFSource| |ldp|:|NonRDFSource|

527

                                  |ldp|:|BasicContainer| |ldp|:|DirectContainer| |ldp|:|IndirectContainer|)

528

(loop for statement in field

529

                                  when (eq (statement-predicate statement) |rdf|:|type|)

530

collect (statement-object statement)))))

531

(flet ((minimum-type (t1 t2)

532

(if (subtypep t1 t2) t1 t2)))

533

(cond ((rest types)

534

(reduce #'minimum-type types))

535

(types

536

(first types))

537

               (t ; absent a specification, return nil and leave it to the caller to decide what to do

538

nil)))))

539

(:method ((instance ldp:resource))

540

(ldp:resource-type (ldp:resource-triples instance))))

541

542

(defgeneric ldp::resource-locations (field)

543

(:method ((field list))

544

(loop for statement in field

545

when (eq (statement-predicate statement) |dcat|:|downloadURL|)

546

collect (statement-object statement)))

547

(:method ((instance ldp:resource))

548

(ldp::resource-locations (ldp:resource-triples instance))))

549

550

(defun ldp::resource-location (resource)

551

(first (ldp::resource-locations resource)))

552

553

(defgeneric resource-default-type (resource)

554

(:method ((resource ldp:resource))

555

"the default for the abstract class is the simples concrete class"

556

'|ldp|:|RDFSource|)

557

(:method ((resource ldp:typed-resource))

558

(type-of resource)))

559

560

561

(defgeneric update-class-from-field (resource field &optional default-type)

562

(:documentation "given a resource instance and a field, if a type is present in the field

563

coerce the instance to that type unless there is a conflict.

564

return possibly changed instance a/or field.")

565

(:method ((resource ldp:resource) (field null) &optional default-type)

566

;; if no type is present, adopt from the typed resource, or reject the request

567

(if (typep resource 'ldp:typed-resource)

568

         (values resource (cons `(,(instance-identifier resource) |rdf|:|type| ,(type-of resource)) field))

569

(if default-type

570

             (values (change-class resource default-type) (cons `(,(instance-identifier resource) |rdf|:|type| ,default-type) field))

571

(spocq.e:request-error :format-control "Resource type must be supplied: ~s"

572

                                    :format-arguments (list (instance-identifier resource))))))

573

(:method ((resource ldp:resource) (field cons) &optional default-type)

574

(let ((field-type (ldp:resource-type field)))

575

(if field-type

576

           ;; if a type is specified, a typed resource must agree, while an untyped resource should be changed

577

(if (typep resource 'ldp:typed-resource)

578

(if (eq (type-of resource) field-type)

579

(values resource field)

580

                   (spocq.e:constraint-violation :format-control "Request would modify the container type: ~s: ~a->~a"

581

                                                 :format-arguments (list (instance-identifier resource) (type-of resource) field-type)))

582

(values (change-class resource field-type) field))

583

(update-class-from-field resource nil default-type)))))

584

585

#+(or)

586

;; cannot sync here, as this happens before the authorization step

587

;; which also means, before the repository has been derived from the request host name

588

(defmethod ensure-instance ((class ldp:resource-class) &rest initargs)

589

(declare (ignore initargs) (dynamic-extent initargs))

590

(call-next-method)

591

(let ((instance (call-next-method)))

592

(case (instance-state instance)

593

(:hollow (read-resource instance)))

594

instance))

595

596

(defgeneric ldp:load-resource (identifier)

597

(:documentation "Given an identifier, determine its class, instantiate an instance instance

598

and load the state given the identifier.

599

When constructing the instance, capture the current active repository as its persistent store.")

600

(:method ((resource ldp:resource))

601

(read-resource resource))

602

(:method ((identifier spocq:iri))

603

     (let ((class (ldp:resource-type (repository-match-field *repository* <urn:dydra:all> identifier |rdf|:|type| nil))))

604

(unless class

605

(http:not-found "Undefined resource: ~a" identifier))

606

(ldp:load-resource (make-persistent-instance class

607

                                                    :identifier identifier

608

                                                    :store-repository-id (repository-id *repository*))))))

609

610

(defmethod instance-graph-identifier ((resource ldp:resource))

611

"limit the resource instance graph to that which it itself identifies."

612

(instance-identifier resource))

613

614

(defmethod encode-store-graph ((resource ldp:resource))

615

"An ldp resource holds all state in its triple field.

616

Prepare this for the store by transforming it into quads"

617

(let ((identifier (instance-identifier resource)))

618

(loop for (s p o) in (ldp::get-resource-triples resource)

619

collect (list identifier s p o))))

620

621

(defmethod decode-store-graph ((resource ldp:resource) field)

622

(call-next-method)

623

(let ((triple-field (mapcar #'rest field)))

624

(multiple-value-bind (updated-resource updated-field)

625

(update-class-from-field resource triple-field)

626

(unless (eq updated-field triple-field)

627

(setf field (cons (cons (instance-identifier resource) (first updated-field))

628

(get-instance-store-graph resource)))

629

(setf-instance-store-graph field resource)

630

(setf (instance-state resource) :dirty))

631

(ldp::setf-resource-triples updated-field updated-resource)

632

field)))

633

634

(defgeneric ldp:resource-triples (resource &key revision)

635

(:method ((identifier spocq:iri) &rest args)

636

(declare (dynamic-extent args))

637

(apply #'ldp:resource-triples (ldp:resource identifier) args))

638

(:method ((resource ldp:resource) &key revision)

639

(cond ((null revision)

640

(synchronize-resource resource)

641

(ldp::get-resource-triples resource))

642

((eql revision (instance-store-revision resource))

643

(ldp::get-resource-triples resource))

644

(t

645

;; retrieve a specific revision

646

;;!!! should associate the specific revision of the resoure's repository

647

(multiple-value-bind (resource-again store-graph)

648

(read-resource resource)

649

(declare (ignore resource-again))

650

(mapcar #'rest store-graph))))))

651

652

(defgeneric (setf ldp:resource-triples) (triples resource)

653

(:method ((triples list) (resource ldp:resource))

654

(setf (instance-state resource) :dirty)

655

(ldp::setf-resource-triples triples resource)))

656

657

658

659

660

661

662

;;; protocol operations for the respective resource classes

663

;;; - delete

664

;;; - get

665

;;; - post

666

;;; - put

667

;;; in general, presume the request control flow has synchronized the instance, read from or write to

668

;;; the triple set and thnen, for writes, commit to synchronize back to the store.

669

;;; the read-path synchronization should project store->store-graph->triples while the

670

;;; write-path commit should effect the opposite triples->store-graph->store projection

671

;;; any cross-resource references are inserted/deleted explicitly

672

673

;;; ldp-rs : an rdf source

674

675

(defmethod ldp:resource-delete ((resource ldp:resource))

676

"Delete a rdf source by deleting its graph and any references to it.

677

Any contaienr operations are handled by a different specialization"

678

(let* ((identifier (instance-identifier resource))

679

(basic-container-ids (loop for (nil id nil nil)

680

;; c.s.p.o

681

                                        in (append (repository-match-field *transaction* |urn:dydra|:|all| nil |ldp|:|contains| identifier)

682

                                                   (repository-match-field *transaction* |urn:dydra|:|all| nil |ldp|:|member| identifier))

683

collect id))

684

(direct-container-references (run-sparql-internal `(spocq.a:|select|

685

                                                        (spocq.a:|graph| |urn:dydra|:|all|

686

                                                                 (spocq.a:|bgp|

687

                                                                          (spocq.a:|triple| ?::s |ldp|:|membershipResource| ?::p)

688

                                                                          (spocq.a:|triple| ?::s ?::p ,identifier)))

689

                                                        (?::s ?::p))

690

                                              :repository-id (repository-id *transaction*)

691

:agent *agent*))

692

(relations-to-delete (append (loop for id in basic-container-ids

693

;; c.s.p.o

694

                                         collect `(,id ,id |ldp|:|contains| ,identifier))

695

                                       (loop for (id property) in direct-container-references

696

                                         collect `(,id ,id ,property ,identifier)))))

697

     (log-debug "resource-delete: basic-container-ids: ~s~&direct-container-references: ~s~&relations-to-delete: ~s~&"

698

basic-container-ids direct-container-references relations-to-delete)

699

(repository-clear-graph *transaction* identifier)

700

(when relations-to-delete

701

(repository-delete-field *transaction* relations-to-delete))

702

(ldp::setf-resource-triples nil resource)

703

(setf-instance-store-graph nil resource)

704

(setf (instance-state resource) :deleted)

705

identifier))

706

 ;;; (with-open-repository ("openrdf-sesame/ldp" :read-only-p t) (repository-match-field *transaction* <http://ldp.stage.dydra.com/> <http://ldp.stage.dydra.com/> <http://www.w3.org/ns/ldp#contains> nil))

707

 ;;; (with-open-repository ("openrdf-sesame/ldp" :read-only-p t) (repository-match-field *transaction* <http://ldp.stage.dydra.com/> nil <http://www.w3.org/ns/ldp#contains> nil))

708

 ;;; (with-open-repository ("openrdf-sesame/ldp" :read-only-p t) (repository-match-field *transaction* |urn:dydra|:|all| nil <http://www.w3.org/ns/ldp#contains> nil))

709

710

 (defmethod ldp:resource-get ((resource ldp:resource) &key return page include omit (max-triple-count ldp:*max-triple-count*)

711

max-member-count revision)

712

   "The base method just retrieves or computes the triples for the resource and slices them if specified.

713

If the (base 0) page is supplied use it to slice the triple content"

714

(declare (ignore return include omit max-member-count))

715

   (slice-ldp-sequence (ldp:resource-triples resource :revision revision) :page page :limit max-triple-count))

716

717

(defmethod ldp:resource-patch ((resource ldp:resource) (specification string))

718

(ldp:resource-patch resource (parse-sparql specification)))

719

720

(defmethod ldp:resource-patch ((resource ldp:resource) (specification query))

721

(setf (task-dataset-graphs specification) `(:from (,(instance-identifier resource))))

722

(run-sparql-internal specification)

723

(synchronize-resource resource)

724

(instance-identifier resource))

725

726

(defmethod ldp-resource-post ((resource ldp:rdf-source) (content list))

727

"POST content direct to a rdf resource - wheter a container or just rdf,

728

by augmenting its graph's content."

729

(when content

730

(setf (ldp:resource-triples resource)

731

(append (ldp:resource-triples resource) content))

732

(commit-resource resource))

733

(instance-identifier resource))

734

735

(defmethod ldp-resource-put ((resource ldp:resource) (field list))

736

(let ((resource-identifier (instance-identifier resource)))

737

(setf (ldp:resource-triples resource) field)

738

(commit-resource resource)

739

resource-identifier))

740

741

742

;;; ldp-rs

743

;;; need post, put, patch, delete for simple rdf resource w/o content structure

744

745

(defmethod ldp-resource-put :around ((resource ldp:rdf-source) (field list))

746

(call-next-method))

747

748

;;; ldp-bc : a basic container maintains the ldp:contains relation

749

750

(defmethod ldp:resource-delete ((resource ldp:basic-container))

751

   "Delete an rdf container by deleting its graph, any membership or containment assertions related to it

752

and, recursively, any contained content"

753

(let* ((identifier (instance-identifier resource))

754

(triples (ldp:resource-triples resource)))

755

;; first, eliminate any references and this resource's own content

756

(call-next-method)

757

;; then recurse to its members.

758

(loop for (nil property id) in triples

759

when (find property *transitive-containment-properties* :test #'iri-equal)

760

do (ldp:resource-delete (ldp:resource id)))

761

identifier))

762

763

;;; see https://www.w3.org/TR/ldp/#prefer-parameters

764

 (defmethod ldp:resource-get ((resource ldp:basic-container) &key page include omit max-member-count max-triple-count

765

(revision (instance-store-revision resource)))

766

"Generate a graph which represents the container content subject to the include/omit specification

767

   if preferences do not limit content, augment the immediate content with that of the contained resource.

768

   given a slice, apply it to both the immediate content or the membership, depending on moit/include preferences."

769

(let ((minimal-content (ldp:resource-triples resource :revision revision))

770

(member-predicate |ldp|:|contains|))

771

(cond ((find |http://www.w3.org/ns/ldp#|:|PreferContainment| omit)

772

(slice-ldp-sequence (remove member-predicate minimal-content :key #'second)

773

:page page :limit max-triple-count))

774

((find |http://www.w3.org/ns/ldp#|:|PreferMinimalContainer| include)

775

(slice-ldp-sequence minimal-content

776

:page page :limit max-triple-count))

777

(t

778

(log-debug "resource-get: include: ~s, omit: ~s" include omit)

779

(let* ((member-repository (ldp:resource-repository resource))

780

                   ;; extract the member slice from the cached triples, rather than querying

781

(member-identifiers (loop for (nil predicate member) in minimal-content

782

                                         when (equalp predicate member-predicate)

783

collect member)))

784

(multiple-value-bind (sliced-member-identifiers page-count)

785

(if (and page max-member-count)

786

                                       (slice-ldp-sequence member-identifiers :page page :limit max-member-count)

787

member-identifiers)

788

(let ((member-content (loop for member-identifier in sliced-member-identifiers

789

                                        for member = (ldp:find-resource :identifier member-identifier :repository member-repository

790

                                                                        :if-does-not-exist nil)

791

when member

792

                                        append (ldp:resource-triples member :revision revision))))

793

(values (append minimal-content member-content)

794

page-count))))))))

795

796

#+(or) ; the respective sparql expression

797

(parse-sparql "

798

prefix ldp: <http://www.w3.org/ns/ldp#>

799

select ?s ?p ?o

800

where {

801

    { select ?memberGraph where { graph ?container { ?container ldp:contains ?memberGraph } } offset 0 limit 100 }

802

{ graph ?memberGraph { ?s ?p ?o } }

803

}")

804

805

806

(defmethod ldp-resource-post ((resource ldp:basic-container) (member ldp:rdf-source))

807

"POST a rdf resource to a container as a member.

808

For a simple container, this requores just a ldp:contains statement."

809

;; reconcile new links: determine the additions, insert to the containers

810

(let* ((member-predicate |ldp|:|contains|)

811

(identifier (instance-identifier resource))

812

(member-identifier (instance-identifier member)))

813

(push `(,identifier ,member-predicate ,member-identifier) (ldp:resource-triples resource))

814

;; insert the additional statements on their own

815

(repository-insert-field *transaction*

816

                              `((spocq.a:|graph| ,member-identifier ,(ldp::get-resource-triples member))))

817

;; then synchronize the container

818

(commit-resource resource)

819

;; and discard a possible cached member

820

member-identifier))

821

822

(defmethod ldp-resource-post ((resource ldp:basic-container) (member ldp:non-rdf-source))

823

"POST a non-rdf resource to a container as related metadata.

824

For a simple container, this requores just a ldp:contains statement."

825

;; reconcile new links: determine the additions, insert to the containers

826

(let* ((member-predicate |ldp|:|contains|)

827

(identifier (instance-identifier resource))

828

(member-identifier (instance-identifier member)))

829

(push `(,identifier ,member-predicate ,member-identifier) (ldp:resource-triples resource))

830

;; insert the additional statements on their own

831

(repository-insert-field *transaction*

832

                              `((spocq.a:|graph| ,member-identifier ,(ldp::get-resource-triples member))))

833

;; then synchronize the container

834

(commit-resource resource)

835

;; and discard a possible cached member

836

member-identifier))

837

838

839

840

841

(defmethod ldp-resource-put ((resource ldp:basic-container) (field list))

842

;; verify no change to existing links;

843

;; then insert the field into the respective graph

844

(let ((old-field (ldp:resource-triples resource)))

845

(when (unless (resource-new-p resource))

846

(let* ((container-relation |ldp|:|contains|)

847

(old-contained (loop for statement in old-field

848

for (nil predicate member) = statement

849

when (equalp predicate container-relation)

850

collect member))

851

(new-contained (loop for (nil predicate member) in field

852

when (equal predicate container-relation)

853

collect member)))

854

(when (set-exclusive-or old-contained new-contained)

855

             (log-debug "Modification includes conflicting containment relations: ~s old: ~s new: ~s"

856

(instance-identifier resource) old-contained new-contained)

857

(unless (administrator-p *agent*)

858

               (spocq.e:constraint-violation :format-control "Request would modify containment relations: ~s"

859

                                             :format-arguments (list (instance-identifier resource)))))))

860

(call-next-method resource field)))

861

862

;;; ldp-dc

863

864

(defmethod ldp:resource-delete ((resource ldp:direct-container))

865

   "Delete an rdf container by deleting its graph, any membership or containment assertions related to it

866

and, recursively, any contained content"

867

(let* ((identifier (instance-identifier resource))

868

(triples (ldp:resource-triples resource)))

869

;; first, eliminate any references and this resource's own content

870

(call-next-method)

871

;; then recurse to its members.

872

(loop for (nil property id) in triples

873

when (find property *transitive-containment-properties* :test #'iri-equal)

874

do (ldp:resource-delete (ldp:resource id)))

875

identifier))

876

877

(defmethod ldp-resource-post ((resource ldp:direct-container) (member ldp:rdf-source))

878

;; add the basic containment link and the declared links in the membership resource

879

(let* ((member-predicate |ldp|:|contains|)

880

(identifier (instance-identifier resource))

881

(member-identifier (instance-identifier member))

882

(membership-resource-identifier (ldp:container-membership-resource resource))

883

(has-member-relation (ldp:container-has-member-relation resource))

884

(is-member-of-relation (ldp:container-is-member-of-relation resource)))

885

;;;???

886

(let ((membership-triple `(,identifier ,member-predicate ,member-identifier))

887

(triples (ldp:resource-triples resource)))

888

(push membership-triple (ldp:resource-triples resource))

889

(ldp::setf-resource-triples (cons membership-triple triples) resource)

890

;;; insert the additional statement plus any relations

891

(repository-insert-field *transaction*

892

                                `((spocq.a:|graph| ,member-identifier ,(ldp::get-resource-triples member))

893

(spocq.a:|graph| ,membership-resource-identifier

894

,(if has-member-relation

895

                                                `(spocq.a:|triple| ,membership-resource-identifier ,has-member-relation ,member-identifier)

896

                                                `(spocq.a:|triple| ,member-identifier ,is-member-of-relation ,membership-resource-identifier)))))

897

(commit-resource resource)

898

member-identifier)))

899

900

901

(defmethod ldp-resource-put ((resource ldp:direct-container) (field list))

902

;; verify no change to existing links;

903

;; iff the container is also the membership resource, also the membership resource;

904

;; then insert the field into the respective graph

905

(let* ((container-relation |ldp|:|contains|)

906

(container-identifier (instance-identifier resource))

907

(membership-resource-identifier (ldp:container-membership-resource resource))

908

(has-member-relation (ldp:container-has-member-relation resource))

909

(is-member-of-relation (ldp:container-is-member-of-relation resource))

910

(old-contained (loop for statement in (ldp:resource-triples resource)

911

for (nil predicate member) = statement

912

when (equalp predicate container-relation)

913

collect member))

914

(new-contained (loop for (nil nil predicate member) in field

915

when (equal container-relation predicate)

916

collect member))

917

(old-members (when (equalp container-identifier membership-resource-identifier)

918

(if has-member-relation

919

(loop for statement in (instance-store-graph resource)

920

for (nil nil predicate member) = statement

921

when (equalp predicate has-member-relation)

922

collect member)

923

(loop for statement in (instance-store-graph resource)

924

for (nil member predicate nil) = statement

925

when (equalp predicate is-member-of-relation)

926

collect member))))

927

(new-members (when (equalp container-identifier membership-resource-identifier)

928

(if has-member-relation

929

(loop for (nil nil predicate member) in field

930

when (equal has-member-relation predicate)

931

collect member)

932

(loop for (nil member predicate nil) in field

933

when (equal is-member-of-relation predicate)

934

collect member)))))

935

(when (or (set-exclusive-or old-contained new-contained)

936

(set-exclusive-or old-members new-members))

937

       (log-debug "Modification includes conflicting containment relations: ~s old: ~s + ~s new: ~s + ~s"

938

                  (instance-identifier resource) old-contained old-members new-contained new-members)

939

(unless (administrator-p *agent*)

940

(spocq.e:constraint-violation :format-control "Request would modify containment relations: ~s"

941

                                       :format-arguments (list (instance-identifier resource)))))

942

(call-next-method resource field)))

943

944

945

;;; ensure that the initial resource are present in the database for a given host

946

(defun initialize-ldp-repository (host repository-id)

947

(let ((root-container-id (intern-iri (concatenate 'string "http://" host "/"))))

948

(with-open-repository (repository-id :read-only-p nil :normal-disposition :commit)

949

       (unless  (repository-match-field *transaction* root-container-id root-container-id |rdf|:|type| nil)

950

         (repository-insert-field *transaction* `((spocq.a:|quad| ,root-container-id |rdf|:|type| |ldp|:|BasicContainer| ,root-container-id)))))))

951

;;; (initialize-ldp-repository "example.org" "openrdf-sesame/ldp")

952

;;; (spocq.i::initialize-ldp-repository "ldp.stage.dydra.com" "openrdf-sesame/ldp")

953