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

Kind	Covered	All	%
expression	87	1076	8.1
branch	6	58	10.3

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.server.implementation)

5

6

(:documentation "linked data platform protocol"

7

8

"This file implements the http binding for a linked data platform service.

9

10

It provides GET, PATCH, PUT, POST and DELETE operators for resources and containers.

11

(+ means covered in http-api-tests, - means implemented, but not testsd)

12

13

GET : the request uri designates either a simple resource - LPD-NR or LDP-RS, or an LDP-C.

14

+ LDP-NR : retrieved from the file system or redirected to the remote location

15

+ LDP-RS : content is retrieved from the respective graph

16

+ LDP-C : resources, the response depends on the request return preference

17

either just the structural and meta-data or that plus the member content

18

- with optional slicing.

19

20

PUT : request uri is the resource itself; operation distinguishes resource type

21

- LDP-NR : is delegated to the file system and the request content is stored opaquely

22

- LDP-RS : the content replaces the respective graph.

23

any membership assertions in a parent LDP-BC and -DC assertions are stable,

24

but an LDP-IC reference could change.

25

- LDP-C : the content replaces that of the respective graph, as per LPDP-RS,

26

but there are limitations.

27

any changes are retricted to meta-data and membership assertions are immutable.

28

29

POST : the relation between the document content and the request uri depends on the resource type

30

+ LDP-NR : is stored opaquely in content-adressable local files or remote locations

31

 - LDP-RS : the request content is merged into the respective graph to augment the resources' rdf content.

32

as it is additive, no reference can change.

33

+ LDP-C : the request resource is the container and content is the contained element.

34

the member identifier is either supplied in the location header (which can be relative) as a slug

35

   this serves as the base for parsing the request content and as the graph which holds the member resource content

36

37

DELETE : the request uri is unambiguosly an LDP-C or LDP-RS

38

 - LDP-NR : delete opaquely as per mapping to the file system; delete any LDP-BC and -DB assertions, -IC are not possible

39

 - LDP-RS : delete the resource itself; delete containment, direct membership or indirect membership assertions

40

+ LDP-C : delete the resource itself.

41

member deletion follows LDP-BC, LDP-DC and LDP-IC links based on configuration.

42

43

 PATCH : permit SPARQL only, are delegated to the query processor, and constrained to apply to the target

44

resource graph only

45

- LDP-RS

46

- LDP-C

47

48

the LDP-NR determination involves the request content type.

49

any RDF document type is handled as LDP-RS while non RDF is LDP-NR

50

51

 The LDP working group explicitly limited their recommendation on auth issues to use cases and scenarios.

52

This means there are no specific requirements as to authorization granularity.

53

This implementation places controls at the repository level.

54

The authentication transpires as normal for HTTP via token, password or location.

55

 The target repository is defined per host and initial authorization proceeds with respect to access controls

56

at that level.

57

 In addition, the respective resources permit also WAC specifications, whihc then apply tot he rarget resource

58

for the request.

59

60

issues and questions:

61

62

in text :

63

64

4.2.1.3 : etags for non-rdf / non-sparql resources

65

LDP-NR resources are described by a metadata resource, which is represented as a graph.

66

the revision information for changes to this graph serves as the etag

67

68

4.2.1.4 : need to provide the header, eg: rel=type, http://www.w3.org/ns/ldp#Resource link header

69

this is interpreted in requests and gernated in responses.

70

71

4.2.1.5 : upon creation the respective new uri must become the base uri during request processing.

72

this is accomplished in the graph-store-response method specific to /ldp resources in order

73

for it to be available in the decode methods. if none was present in the request, the generated

74

value is added to the request headers. not that there is no standard request header for an

75

explicit base uri.

76

77

4.4.1.2 : are type triples materialized?

78

if no is present in the request content, they are added in order to be available when retrieving

79

the resource from the store.

80

81

5.2.3.10 : allow clients to suggest the URI for a resource created through POST

82

iff no base iri is present, then iff a Location is present, it is use to set the base iri.

83

  otherwise if a Slug header is present, it is used to generate the location - initially as the base iri.

84

this coupld be simplified to work with just the location and slug

85

86

in general :

87

88

is there a way to change some incidental data about a container, for example

89

- a dc:title

90

- the membership term for a direct container

91

or does one accomplish this with graph store requests? with sparql patch requests?

92

93

does a response comprise exactly one resource, particularly a container, or more than one?

94

5.1 example 14, what does a typed response for a direct container include also an indirect container.

95

96

<> :

97

  the question re its values was asked explicitly (https://lists.w3.org/Archives/Public/ietf-http-wg/2012OctDec/0122.html)

98

with one alternative suggested, that the base can come from the location header of the post

99

  (http://www.w3.org/Protocols/HTTP/1.1/rfc2616bis/issues/#i80), but there was some scepticism and no conclusion.

100

  given the recommendation examples, the base issue seems to have been decided to be 'the created resource'

101

102

non <> subjects:

103

 is any posted content with a subject other than <> added to the container or appended to the newly created mamber?

104

105

is deletion transitive?

106

5.2.5 says nothing about deleting containers. is the consequence transitive?

107

 5.4.3 also says nothing about deleting the container, just the containment link as a consequence of deleting the contained resource.

108

 in (http://www.w3.org/TR/ldp-primer/) the best practice note about the bug tracker indicates the to delete the product resource would delete also its bug reports, but

109

the example deletes a bug only. no example deletes the product.

110

- GET is transitive, according to prefer.result=representation

111

- DELETE is unspecified

112

113

how does one move a resource from one container to another?

114

 by using patch on the two containers or by resorting to something outside of ldp in order to get transactional integrity?

115

 there is a mention in item 10 of the techincal issues in the charter, but the word appears in no other ldp document.

116

there is not use in the mailing list archive.

117

118

how are collations specified: sparql's order by does not include collation and does not reference

119

the three.argument version of fn:compare, but rather

120

   'The collation for fn:compare is defined by XPath and identified by http://www.w3.org/2005/xpath-functions/collation/codepoint.

121

This collation allows for string comparison based on code point values.

122

Codepoint string equivalence can be tested with RDF term equivalence.'

123

124

if a POST request includes both a header uri specification (slug or location) and the content includes

125

relative subject uri, what is the precedence?

126

")

127

128

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

129

130

(defparameter *ldp-repository-id* "openrdf-sesame/ldp")

131

(defparameter *class.ldp-http-request* 'ldp-http-request)

132

(defparameter *class.ldp-http-response* 'ldp-http-response)

133

134

;;; removed |/:account/:repository/:graph/:element*|

135

136

(defclass |ldp|:|Resource| (ldp:resource)

137

()

138

(:metaclass ldp:resource-class))

139

140

(defclass |ldp|:|RDFSource| (|ldp|:|Resource| ldp:rdf-source )

141

()

142

(:metaclass ldp:resource-class))

143

144

(defclass |ldp|:|NonRDFSource| (|ldp|:|Resource| ldp:non-rdf-source )

145

()

146

(:metaclass ldp:resource-class))

147

148

(defclass |ldp|:|Container| (|ldp|:|RDFSource| ldp:container)

149

()

150

(:metaclass ldp:resource-class))

151

152

(defclass |ldp|:|BasicContainer| (|ldp|:|Container| ldp:basic-container)

153

()

154

(:metaclass ldp:resource-class))

155

156

(defclass |ldp|:|DirectContainer| (|ldp|:|Container| ldp:direct-container)

157

()

158

(:metaclass ldp:resource-class))

159

160

(defclass |ldp|:|IndirectContainer| (|ldp|:|Container| ldp:indirect-container)

161

()

162

(:metaclass ldp:resource-class))

163

164

(defclass ldp-http-request (tbnl:tbnl-request) ())

165

(defclass ldp-http-response (tbnl:tbnl-response) ())

166

167

168

(defgeneric request-type-link-header-type (request)

169

(:documentation "Extract the class declaration from a request type link")

170

(:method ((request http:request))

171

(request-type-link-header-type (http:request-header request :link)))

172

(:method ((header string))

173

(let* ((links (split-string header #\,))

174

(scanner (load-time-value

175

(cl-ppcre:create-scanner `(:sequence :start-anchor

176

#\<

177

                                                          (:register

178

                                                           (:greedy-repetition 0 nil

179

                                                                               (:inverted-char-class #\< #\> #\" #\{ #\}

180

                                                                                                     :whitespace-char-class

181

                                                                                                     (:range ,(code-char #x00) ,(code-char #x20)))))

182

#\>

183

                                                          (:greedy-repetition 0 nil :whitespace-char-class)

184

#\;

185

                                                          (:greedy-repetition 0 nil :whitespace-char-class)

186

                                                          "rel=" (:greedy-repetition 0 1 #\") "type" (:greedy-repetition 0 1 #\")))))

187

(types (loop for link in links

188

collect (multiple-value-bind (match strings)

189

                                                 (cl-ppcre:scan-to-strings scanner link)

190

(or (and match

191

                                       (let ((type (dydra:intern-iri (aref strings 0))))

192

                                         (when (and (symbolp type) (subtypep type 'ldp:resource))

193

type)))

194

                                  (http:bad-request "Invalid type link: ~s" link))))))

195

(if (rest types)

196

(flet ((minimum-type (t1 t2)

197

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

198

(reduce #'minimum-type types))

199

(first types))))

200

(:method ((type null))

201

nil)

202

(:method ((type t))

203

(http:bad-request "Invalid type link: ~s" type)))

204

;;; (request-type-link-header-type "<http://www.w3.org/ns/ldp#NonRDFSource>; rel=\"type\"")

205

;;; (request-type-link-header-type "<http://www.w3.org/ns/ldp#NonRDFSource>; rel=type")

206

207

(defgeneric compute-response-type-link-header (resource)

208

(:method ((type symbol))

209

(format nil "<~a>; rel=type" (dydra:iri-lexical-form type)))

210

(:method ((resource null))

211

"<http://www.w3.org/ns/ldp#Resource>; rel=type")

212

(:method ((resource ldp:container))

213

(compute-response-type-link-header (type-of resource)))

214

(:method ((resource ldp:resource))

215

"<http://www.w3.org/ns/ldp#Resource>; rel=type"

216

;;(describe resource)

217

;;"<http://www.w3.org/ns/ldp#BasicContainer>; rel=type"

218

)

219

(:method ((resource t))

220

nil))

221

222

223

(defmethod http:make-resource ((class ldp:resource-class) (request http:request) &rest args

224

&key path

225

                                (identifier (dydra:intern-iri (concatenate 'string "http://"

226

                                                                           (http:request-header request :host)

227

                                                                           path)))

228

&allow-other-keys)

229

(declare (dynamic-extent args))

230

;; extract header hists and parameters

231

(let* ((link-class (request-type-link-header-type request)))

232

;; iff a class is provided, use it. otherwise the generic class will suffice until

233

;; the content is read

234

;;!! must distinguish between put class and post class

235

(cond ((equal "/" path) ; the root is hardwired to ba a basic container

236

(setf class (find-class |ldp|:|BasicContainer|)))

237

(link-class

238

(setf class link-class)))

239

     (dydra:log-debug "make-resource: class: ~s path: ~s identifier: ~s" (class-name class) path identifier)

240

(apply #'dydra:ensure-instance class :request request :identifier identifier args)))

241

;;; (clrhash (class-cache (find-class '|ldp|:|BasicContainer|)))

242

243

244

(defparameter *default-agent* nil)

245

 ;;; (defparameter *default-agent* (make-instance 'dydra:user :name "jhacker" :id (intern-iri "http://dydra.com/users/jhacker") :location "127.0.0.1"))

246

247

;;; this would come into play iff authorization constraints are to be applied to individual resources.

248

;;; in order to do this, an auth prologue would have to be added to linked-data-platform-response

249

;;; and/or its method combination would need to be changed.

250

(defmethod http:authorize-request ((resource ldp:resource) (request http:request))

251

;; to test

252

(let* ((host-name (http:request-header request :host))

253

(repository-id (cond ((host-repository-id host-name :if-does-not-exist nil))

254

(t

255

                                (dydra:log-warn  "No repository defined for host: ~s" host-name)

256

                                (http:bad-request "No repository defined for host: ~s" host-name))))

257

(repository (dydra:repository repository-id))

258

(agent (http:request-agent request)))

259

(unless agent

260

(setf agent *default-agent*)

261

(setf (http:request-agent request) agent))

262

;; to short circuit

263

;; (setf (http:request-agent request) (spocq.i::system-agent))

264

;; otherwise

265

(when agent

266

;; control for authorized access to the repository itself is left to transaction creation

267

(setf (dydra:resource-store-repository-id resource) repository-id)

268

;; control for existence

269

(if (dydra:repository-exists-p repository)

270

;; control for disabled repositories

271

(if (dydra:repository-enabled-p repository-id)

272

;; control for access to the resource

273

(dydra:access-authorized-p repository agent (request-access-mode request))

274

(http:bad-request "The repository has been disabled: ~s." repository-id))

275

(http:not-found "Repository not found: ~a." repository)))))

276

277

(defmethod dydra:task-operation-access-mode ((task dydra:ldp-task) (op symbol))

278

(request-access-mode op))

279

280

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

281

(defclass ldp-resource-function (http:resource-function)

282

((http.i::default-accept-header

283

:initform "text/turtle"

284

:allocation :class))

285

(:metaclass c2mop:funcallable-standard-class)

286

(:documentation "A specialized resourc function for linked data platform

287

which sets the default response media type")))

288

289

290

;;; header argument handling

291

292

(let ((whitespace '(:greedy-repetition 0 nil :whitespace-char-class)))

293

(setf (cl-ppcre:parse-tree-synonym 'whitespace) whitespace))

294

295

(defparameter *prefer-header-scanner*

296

(cl-ppcre:create-scanner '(:sequence :start-anchor

297

                                        "Prefer:" whitespace "return" whitespace #\=  whitespace "representation"

298

                                        (:register (:greedy-repetition 0 nil :everything))

299

:end-anchor)

300

:case-insensitive-mode t))

301

(defparameter *prefer-parameter-scanner*

302

(cl-ppcre:create-scanner '(:sequence :start-anchor whitespace #\; whitespace

303

(:register spocq.i::pn_prefix)

304

(:sequence whitespace #\= whitespace

305

                                                   (:register (:greedy-repetition 0 nil (:inverted-char-class #\;)))))))

306

 ;;; (cl-ppcre:scan-to-strings  *prefer-header-scanner*  "Prefer: return=representation; max-triple-count=\"500\"" :start 0)

307

308

309

(defun unquote-header-argument (string)

310

"RFC7240 permits both quoted and unquoted tokens"

311

(let ((length (length string)))

312

(if (> length 1)

313

(if (eql (char string 0) #\")

314

(if (eql (char string (1- length)) #\")

315

(subseq string 1 (1- length))

316

(http:bad-request " invalid argument value: ~s" string))

317

string)

318

string)))

319

320

(defun parse-integer-header-argument (string)

321

(handler-case (parse-integer (unquote-header-argument string))

322

(error (c) (http:bad-request (format nil "Invalid integer argument ~s: ~a" string c)))))

323

324

(defun parse-iri-list-header-argument (string)

325

(loop for iri in (de.setf.utility:split-string (unquote-header-argument string) #\space)

326

collect (spocq.i::intern-iri iri)))

327

328

(defgeneric parse-header-argument-value (initarg string)

329

(:method ((initarg (eql :include)) (value string))

330

(parse-iri-list-header-argument value))

331

(:method ((initarg (eql :omit)) (value string))

332

(parse-iri-list-header-argument value))

333

(:method ((initarg (eql :max-triple-count)) (value string))

334

(parse-integer-header-argument value))

335

(:method ((initarg (eql :max-member-count)) (value string))

336

(parse-integer-header-argument value))

337

(:method ((initarg (eql :max-kbyte-count)) (value string))

338

(parse-integer-header-argument value)))

339

340

(defparameter *prefer-parameters*

341

'(:return :include :omit :max-triple-count :max-member-count :max-kbyte-count))

342

343

(defun compute-prefer-header-bindings (header &optional (parameter-keywords *prefer-parameters*))

344

(multiple-value-bind (match strings) (cl-ppcre:scan-to-strings *prefer-header-scanner* header)

345

(when match

346

(loop with parameters = (aref strings 0)

347

with start = 0

348

with end = (length parameters)

349

until (>= start end)

350

         for (match key-value) = (multiple-value-list (cl-ppcre:scan-to-strings *prefer-parameter-scanner* parameters :start start))

351

if match

352

append (let* ((key (aref key-value 0))

353

(initarg-key (or (find key parameter-keywords :test #'string-equal)

354

                                        (http:bad-request "Invalid prefer parameter: ~s" header)))

355

(value (aref key-value 1))

356

(initarg-value (parse-header-argument-value initarg-key value)))

357

(incf start (length match))

358

(list initarg-key initarg-value))

359

else do (http:bad-request " invalid prefer parmeter: ~s" header)))))

360

361

(defgeneric compute-effective-member-type (request-content-type field-type link-header-type)

362

(:documentation "For a given request, use any header type and type asserted in the content field

363

together with the content media type to derive and effective type or reject those given.")

364

(:method ((request-content-type mime:rdf) (field-type null) (header-type null))

365

|ldp|:|RDFSource|)

366

(:method ((request-content-type mime:rdf) (field-type null) (header-type symbol))

367

(case header-type

368

(|ldp|:|Resource| |ldp|:|RDFSource|)

369

(t header-type)))

370

(:method ((request-content-type mime:mime-type) (field-type null) (header-type null))

371

|ldp|:|NonRDFSource|)

372

(:method ((request-content-type t) (field-type t) (header-type t))

373

field-type)

374

(:method ((request-content-type t) (field-type null) (header-type t))

375

header-type)

376

(:method ((request-content-type null) (field-type null) (header-type null))

377

nil))

378

379

380

(defgeneric compute-resource-external-identifier (resource &optional member-identifier)

381

(:method ((resource ldp:resource) &optional member-identifier)

382

(let* ((repository (spocq.i::instance-repository resource))

383

(repository-identifier (spocq.e:repository-identifier repository))

384

(instance-identifier (spocq.e:instance-identifier resource)))

385

(if (and (null member-identifier)

386

;; module http/https scheme ?!

387

(spocq.e:iri-equal repository-identifier instance-identifier))

388

repository-identifier

389

           (intern-iri (format nil "~/format-csv-iri-namestring//ldp?resource=~/format-csv-iri-namestring/"

390

repository-identifier

391

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

392

393

;;; (compute-response-type-link-header "Prefer: return=representation; max-triple-count=\"500\"")

394

395

(defparameter *ldp-include* nil)

396

(defparameter *ldp-omit* nil)

397

(defparameter *ldp-page* nil)

398

(defparameter *ldp-max-triple-count* nil)

399

(defparameter *ldp-max-member-count* nil)

400

(defparameter *ldp-max-kbyte-count* nil)

401

402

(defmethod http:request-argument-list ((request ldp-http-request))

403

"add to the base arguemnt those which are extracted from the ldb representations header."

404

(let ((base-arguments (call-next-method))

405

(ldp-arguments (loop for header in (http:request-headers request)

406

for binding = (compute-prefer-header-bindings header)

407

when binding

408

collect binding)))

409

(spocq.i::plist-merge (append ldp-arguments

410

base-arguments)

411

:include *ldp-include*

412

:omit *ldp-omit*

413

:max-triple-count *ldp-max-triple-count*

414

:max-member-count *ldp-max-member-count*

415

:max-kbyte-count *ldp-max-kbyte-count*

416

:page *ldp-page*)))

417

418

 (defmethod graph-store-options :before ((resource |/:account/:repository/ldp|) request response request-type response-type)

419

(setf (http:response-header response :accept-post) "text/turtle, application/n-triples")

420

(setf (http:response-header response :accept-patch) "application/sparql-update")

421

nil)

422

423

 (defmethod graph-store-head :before ((resource |/:account/:repository/ldp|) request response request-type response-type

424

                                      &key (context (resource-graph resource)) (target context))

425

(unless target

426

(http:bad-request "A resource must be specified."))

427

(let ((ldp-resource (ldp:ensure-resource :identifier target

428

                                            :repository (resource-repository resource))))

429

     (pushnew (compute-response-type-link-header ldp-resource) (http:response-header response :link) :test #'equal))

430

(setf (http:response-header response :accept-post) "text/turtle, application/n-triples")

431

(setf (http:response-header response :accept-patch) "application/sparql-update")

432

nil)

433

434

;;; dispatch linked data platform access according to combination of content media type and length

435

 (defmethod graph-store-response :delete ((resource |/:account/:repository/ldp|) request response (request-type t) (response-type t))

436

(indirect-linked-data-platform-response :delete resource request response request response-type nil))

437

438

 (defmethod graph-store-response :get ((resource |/:account/:repository/ldp|) request response (request-type t) (response-type t))

439

"Respond with graph content. Allow an optional context"

440

(indirect-linked-data-platform-response :get resource request response request-type response-type nil))

441

442

 (defmethod graph-store-response :post ((resource |/:account/:repository/ldp|) request response (request-type null) (response-type t))

443

(http:bad-request "A content-type must be provided: ~a~@[~a~]" resource (resource-graph resource)))

444

445

 (defmethod graph-store-response :post ((resource |/:account/:repository/ldp|) request response (request-type t) (response-type t))

446

;; persuant to https://www.w3.org/TR/ldp/#ldpr-resource, adjust the base iri to reflect any slug

447

(let* ((location (http:request-header request "Location")))

448

(log-graph-store-service-response resource request location)

449

;; introduce a default base uri for triple content -normally, there is no header present

450

(let ((member-type (or (request-type-link-header-type request)

451

(typecase request-type

452

(mime:rdf '|ldp|:|RDFSource|)

453

(t '|ldp|:|NonRDFSource|)))))

454

(unless (http:request-header request :base-iri)

455

;; manufacture a base-iri for decoding.

456

;; slug takes precedence, then location, in order to interpret

457

;; correctly the header for remote non-rdf resources

458

(let ((location (http:request-header request :location))

459

(slug (http:request-header request :slug)))

460

(cond (slug

461

(let* ((target (or (resource-graph resource) (resource-identifier resource)))

462

                         (base-iri (compute-member-iri target :slug slug :container-p (when member-type (subtypep member-type 'ldp:container)))))

463

(setf (http:request-base-iri request) (iri-lexical-form base-iri))))

464

(location

465

(setf (http:request-base-iri request) location))))))

466

(typecase request-type

467

(mime:rdf

468

(labels ((post-content (pathname effective-request-type)

469

                   (unwind-protect (indirect-linked-data-platform-response :post resource request response effective-request-type response-type pathname)

470

(conditional-delete-file pathname)))

471

(process-location (stream)

472

(setf (http:request-header request :location) nil)

473

(let ((request-content-stream (http:request-content-stream request)))

474

                     (unwind-protect (progn (setf (http:request-content-stream request) stream)

475

                                       (multiple-value-call #'post-content (call-next-method)))

476

(setf (http:request-content-stream request) request-content-stream)))))

477

(if location

478

              (hunchentoot::call-with-open-request-stream #'process-location location :accept request-type)

479

(multiple-value-call #'post-content (call-next-method)))))

480

(t

481

(if location

482

            (indirect-linked-data-platform-response :post resource request response request-type response-type (intern-iri location))

483

;; otherwise save in account-specific location and pass that

484

(flet ((post-saved-content (pathname effective-request-type)

485

(let* ((hash-pathname (spocq.i::file-hash-pathname pathname))

486

(hash-pathname-namestring (namestring hash-pathname)))

487

                       (unless (every #'(lambda (c) (or (alphanumericp c) (eql c #\/))) hash-pathname-namestring)

488

;; constrain just in case

489

                         (http:bad-request "Invalid location: ~s" hash-pathname-namestring))

490

(setf hash-pathname

491

                             (make-pathname :directory (append '(:relative "data") (rest (pathname-directory hash-pathname)))

492

:defaults hash-pathname))

493

                       (let* ((repository-pathname (repository-pathname (resource-repository resource)))

494

                              (persistent-pathname (merge-pathnames hash-pathname repository-pathname))

495

(file-url (spocq.i::intern-file-url hash-pathname))

496

(succeeded nil))

497

(cond ((probe-file persistent-pathname)

498

(conditional-delete-file pathname))

499

(t

500

(ensure-directories-exist persistent-pathname)

501

(rename-file pathname persistent-pathname)))

502

(unwind-protect

503

                             (multiple-value-prog1 (indirect-linked-data-platform-response :post resource request response effective-request-type response-type file-url)

504

(setf succeeded t))

505

                           (unless succeeded (conditional-delete-file persistent-pathname)))))))

506

(multiple-value-call #'post-saved-content (call-next-method))))))))

507

508

509

510

 (defgeneric indirect-linked-data-platform-response (method resource request response request-type response-type request-source &key target)

511

(:method :before (method resource request response request-type response-type request-source &rest args)

512

(declare (ignore args))

513

(dydra:log-debug "indirect-linked-data-platform-response: ~s ~s ~s (~s ~s)"

514

dydra:*task-id* resource

515

(http:request-headers request)

516

request-type

517

response-type)

518

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

519

(describe resource))

520

(when (typep request spocq.i::*linked-data-platform.describe-type*)

521

(describe request))

522

(when (typep response spocq.i::*linked-data-platform.describe-type*)

523

(describe response)))

524

525

;; these should be handled by the specializations, above

526

   (:method ((method (eql :head)) (resource repository-resource) request response request-type response-type request-source &key target)

527

(declare (ignore target))

528

(log-warn "indirect-linked-data-platform-response: head: ~s" resource)

529

(http:no-content))

530

531

   (:method ((method (eql :options)) (resource repository-resource) request response request-type response-type request-source &key target)

532

(declare (ignore target))

533

(log-warn "indirect-linked-data-platform-response: options: ~s" resource)

534

(http:no-content))

535

536

   (:method ((method t) (resource |/:account/:repository/ldp|) request response request-type response-type request-source

537

&key (target (or (resource-graph resource) (resource-identifier resource))))

538

(let ((ldp-resource (ldp:ensure-resource :identifier target

539

                                                :repository (resource-repository resource))))

540

       (linked-data-platform-response method ldp-resource request response request-type response-type request-source)))

541

542

   (:method ((method t) (resource |/:account/:repository/:graph|) request response request-type response-type request-source

543

&key (target (or (resource-graph resource) (resource-identifier resource))))

544

(let ((ldp-resource (ldp:ensure-resource :identifier target

545

                                              :repository (resource-repository resource))))

546

       (linked-data-platform-response method ldp-resource request response request-type response-type request-source)))

547

548

   (:method ((method t) (resource |/:account/:repository/:graph/:element*|) request response request-type response-type request-source

549

&key (target (or (resource-graph resource) (resource-identifier resource))))

550

;; in this case, it is the resource itself

551

(let ((ldp-resource (ldp:ensure-resource :identifier target

552

                                               :repository (resource-repository resource))))

553

       (linked-data-platform-response method ldp-resource request response request-type response-type request-source))))

554

555

556

 (defgeneric linked-data-platform-response (method resource request response request-type response-type request-source)

557

(:documentation "Given the target resource, the request object and the response object,

558

perform the operation on the target. the operation is that of the original request.")

559

560

   (:method :around ((method t) (resource ldp:resource) request response request-type response-type request-source)

561

"Wrap all requests with logic - post authorization, to

562

- determine the target container,

563

- open a transaction (type respective the request method),

564

- bind the request to the repository and then,

565

- continue with the operation implementation"

566

567

(let* ((repository-id (dydra:repository-id (ldp::resource-repository resource)))

568

(dydra:*task-id* (or (request-id request) (dydra:make-task-id)))

569

(argument-list (http:request-argument-list request))

570

(parsed-argument-list (parse-http-configuration argument-list))

571

(dydra:*base-iri* (dydra:instance-identifier resource)))

572

(setf (http:response-allow response) '(:DELETE :HEAD :OPTIONS :GET :PATCH :POST :PUT))

573

(setf (http:response-header response :accept-post) "text/turtle, application/n-triples")

574

(setf (http:response-header response :accept-patch) "application/sparql-update")

575

;; always add the abstract resurce

576

(push "<http://www.w3.org/ns/ldp#Resource>; rel=type" (http:response-header response :link))

577

578

(with-http-configuration (list* :task-id dydra:*task-id* parsed-argument-list)

579

(let ((task (dydra:make-ldp-task

580

:operation method

581

:agent (http:request-agent request)

582

:dynamic-bindings dydra:*dynamic-bindings*

583

:repository-id repository-id

584

:response-content-type response-type

585

:revision-id dydra:*revision-id*

586

:task-id dydra:*task-id*

587

:user-id dydra:*user-id*))

588

(disposition (case (request-access-mode method)

589

(|acl|:|Write| :commit)

590

(|acl|:|Read| :continue))))

591

(handler-case

592

(dydra:with-task-environment (:task task :normal-disposition disposition)

593

                 (dydra:log-debug "with task transaction ~s ~s" *task* *transaction*) ; should include the task id, the repository and the pertinent revision

594

(let ((dydra:*query* dydra:*task*))

595

;; make sure instance is current wrt the store

596

(dydra:synchronize-resource resource)

597

;; set provisionally, but allow post to replace this value

598

(let ((revision-id (dydra:instance-store-revision resource))

599

(if-match (http:request-header request :if-match))

600

                         (etag-scanner (load-time-value (cl-ppcre:create-scanner '(:sequence #\" (:register (:greedy-repetition 1 nil (:inverted-char-class #\"))) #\")))))

601

                     (dydra:log-debug "contingent if-match constraint: revision-id: ~a if-match: ~a" revision-id if-match)

602

(when if-match

603

                       (let ((etag-value (first (coerce (nth-value 1 (cl-ppcre:scan-to-strings etag-scanner if-match)) 'list))))

604

(unless etag-value

605

(http:bad-request "Invalid If-Match value: ~a" if-match))

606

(unless (equal etag-value revision-id)

607

                           (http:precondition-failed "Expected ETAG ~a != ~a" revision-id etag-value))))

608

;; add the etag for read methods only

609

                     ;; (setf (http:response-header response :etag) (write-to-string revision-id))

610

)

611

(multiple-value-prog1 (call-next-method)

612

(dydra:log-debug "ldp: ~s ~s ~s"

613

dydra:*task-id* resource

614

(http:response-headers response)))))

615

(spocq.e:task-authorization-error (c)

616

(http:unauthorized (format nil "~a" c))))))))

617

618

   (:method ((method (eql :delete)) (resource ldp:resource) request response request-type response-type request-source)

619

(let* ((start-time (get-universal-time))

620

(repository (spocq.i::instance-repository resource))

621

(object-identifier (compute-resource-external-identifier resource))

622

(task-uuid (spocq.i::intern-uuid dydra:*task-id*))

623

(client-request-id (request-client-request-id request)))

624

(ldp:resource-delete resource)

625

(setf (http:response-etag response) (dydra:resolve-repository-revision-id repository))

626

(setf (http:response-header response "Client-Request-ID") client-request-id)

627

(setf (http:response-header response "Request-ID") dydra:*task-id*)

628

(spocq.i::make-list-solution-field

629

:dimensions spocq.i::*construct-dimensions*

630

:solutions (spocq.i::filter-solution-field `((,task-uuid |as|:|id| ,task-uuid)

631

                                                     (,task-uuid |rdf|:|type| |as|:|Delete|)

632

                                                     (,task-uuid |rdf|:|type| |mthd|:|DELETE|)

633

                                                     (,task-uuid |prov|:|startedAtTime| ,(spocq.i::universal-time-date-time start-time))

634

                                                     (,task-uuid |prov|:|endedAtTime| ,(spocq.i::universal-time-date-time (get-universal-time)))

635

                                                     (,task-uuid |as|:|actor| ,(spocq.i::agent-identifier (http:request-agent request)))

636

                                                     (,task-uuid |as|:|object| ,object-identifier)

637

                                                     (,task-uuid |as|:|inReplyTo| ,client-request-id))

638

                                                   (complement #'null)))))

639

640

   (:method ((method (eql :get)) (resource ldp:rdf-source) request response request-type response-type request-source)

641

"Return a representation of a resource which comprises rdf, constrained by page argument.

642

For containers, recognize also include/omit and member limits.

643

handle paging depending on presence of max count and/or page"

644

(let* ((revision-identifier (http:request-if-match request))

645

(external-identifier nil))

646

(labels ((external-identifier ()

647

                  (or external-identifier (setf external-identifier (compute-resource-external-identifier resource))))

648

(page-location-url (page)

649

                  (format nil "~a~:[?~;&~]page=~a" (external-identifier) (find #\? external-identifier) page)))

650

(multiple-value-bind (solutions page-count)

651

(ldp:resource-get resource

652

:page *ldp-page*

653

:include *ldp-include*

654

:omit *ldp-omit*

655

                                                :max-member-count *ldp-max-member-count*

656

                                                :max-triple-count *ldp-max-triple-count*

657

                                                :revision revision-identifier)

658

(when page-count

659

(push (page-location-url 1) (http:response-header response :link))

660

(when (> *ldp-page* 1)

661

(push (page-location-url (1- *ldp-page*)) (http:response-header response :link)))

662

(when (< *ldp-page* page-count)

663

(push (page-location-url (1+ *ldp-page*)) (http:response-header response :link)))

664

(push (page-location-url page-count) (http:response-header response :link)))

665

           (setf (http:response-header response :location) (dydra:iri-lexical-form (dydra:instance-identifier resource)))

666

           (pushnew (compute-response-type-link-header resource) (http:response-header response :link) :test #'equal)

667

;; use as etag the revision id for the current revision

668

(setf (http:response-header response :etag) (or revision-identifier

669

                                                           (write-to-string (dydra:repository-revision-id *repository*))))

670

(dydra:make-list-solution-field

671

:dimensions dydra:*construct-dimensions*

672

:solutions solutions)))))

673

674

   (:method ((method (eql :get)) (resource ldp:non-rdf-source) request response request-type response-type request-source)

675

"Return a representation of an opaque non-rdf resource.

676

If it is local, perform any content negotiation inline and return nil.

677

If it is remote redirect."

678

(let* ((revision-identifier (http:request-if-match request))

679

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

680

(location (ldp::resource-location resource)))

681

(cond (location

682

(typecase location

683

                (spocq:file-url ;; content-negotiate and emit. type will have defaulted to turtle

684

(let ((pathname (let* ((repository (spocq.i::instance-repository resource))

685

                                        (repository-pathname (repository-pathname repository))

686

                                        (url-pathname (spocq.i::file-url-pathname location)))

687

(case (first (pathname-directory url-pathname))

688

                                     (:absolute (http:bad-request "Invalid resource location: ~s" location))

689

(:relative ))

690

(let* ((namestring (namestring url-pathname)))

691

                                     (unless (every #'(lambda (c) (or (alphanumericp c) (eql c #\/))) namestring)

692

;; constrain just in case

693

                                       (http:bad-request "Invalid location: ~s" namestring)))

694

                                   (merge-pathnames url-pathname repository-pathname))))

695

(setf (http:response-header response :etag) (or revision-identifier

696

                                                                   (write-to-string (dydra:repository-revision-id *repository*))))

697

(when (and (null response-type) media-type)

698

                     (setf (http:response-header response :content-type) (mime:mime-type-namestring media-type)))

699

(cond ((probe-file pathname)

700

                          (setf (http:response-header response :last-modified) (hunchentoot:rfc-1123-date (or (file-write-date pathname)

701

                                                                                                              (get-universal-time))))

702

                          (http:copy-stream pathname (http:response-content-stream response)))

703

(t

704

(http:not-found "Non-RDF source not found: ~s: ~s"

705

(instance-identifier resource)

706

location)))))

707

(spocq:http-url ;; redirect

708

(setf (http:response-header response :location) (iri-lexical-form location))

709

(setf (http:response-content-length response) 0)

710

(http:see-other :location (iri-lexical-form location)))

711

(t

712

(http:bad-request "Resource href location is not supported: ~s: ~s"

713

(instance-identifier resource)

714

location))))

715

(t

716

(http:not-found "Non-RDF source not found: ~s"

717

(instance-identifier resource))))

718

nil))

719

720

   (:method ((method (eql :patch)) (resource ldp:resource) request response (request-type mime:application/sparql-update) response-type request-source)

721

(let ((base-iri (dydra:instance-identifier resource)))

722

(ldp:resource-patch resource (parse-sparql (http:request-body request) :base-iri base-iri))))

723

724

   (:method ((method (eql :post)) (resource ldp:container) request response (request-type mime:rdf) response-type request-source)

725

"posting rdf content to a container:

726

the resource class determines how to decode the request content

727

any link type specified means create a member from the decoded request content."

728

(let* ((start-time (get-universal-time))

729

(repository (spocq.i::instance-repository resource))

730

(content-field (dydra:parse-nquads request-source))

731

(member-field-type (ldp:resource-type content-field))

732

(member-link-type (request-type-link-header-type request))

733

            (member-type (compute-effective-member-type request-type member-field-type member-link-type))

734

;; base iri should have been patched prior to parsing the request content

735

(member-slug (http:request-header request :slug))

736

(member (if (and member-slug member-type)

737

                        ;; must be invoked theoruhg a path (eg graph-store-response) which established a base iri

738

                        (let* ((member-identifier (intern-iri (or (http:request-header request :base-iri)

739

                                                                  (http:bad-request "a request base iri is required.")))))

740

(make-instance member-type

741

:triples (if (null member-field-type)

742

                                         (cons `(,member-identifier |rdf|:|type| ,member-type) content-field)

743

content-field)

744

:identifier member-identifier

745

:repository (spocq.i::instance-repository resource)))

746

(make-instance '|ldp|:|RDFSource|

747

:triples content-field

748

:repository (spocq.i::instance-repository resource))))

749

(location-identifier (ldp:resource-post resource member))

750

(task-uuid (spocq.i::intern-uuid dydra:*task-id*))

751

(client-request-id (request-client-request-id request)))

752

(setf (http:response-header response :location) (dydra:iri-lexical-form location-identifier))

753

(setf (http:response-etag response) (dydra:resolve-repository-revision-id repository))

754

(setf (http:response-header response "Client-Request-ID") client-request-id)

755

(setf (http:response-header response "Request-ID") dydra:*task-id*)

756

;; once the post happens, the resource will have been aligned with the type

757

;; the response should reflect the end class

758

(when member-type

759

         (pushnew (compute-response-type-link-header member-type) (http:response-header response :link) :test #'equal))

760

;; the etag is not provided for modifications,, but if it were, it would

761

;; need to reflect the transaction id, rather its reference revision

762

(http:created)

763

       (let* ((object-identifier (compute-resource-external-identifier resource (instance-identifier member))))

764

(spocq.i::make-list-solution-field

765

:dimensions spocq.i::*construct-dimensions*

766

:solutions (spocq.i::filter-solution-field `((,task-uuid |as|:|id| ,task-uuid)

767

                                                       (,task-uuid |rdf|:|type| |as|:|Update|)

768

                                                       (,task-uuid |rdf|:|type| |mthd|:|POST|)

769

                                                       (,task-uuid <http://purl.org/dc/terms/title> ,member-slug)

770

                                                       (,task-uuid |prov|:|startedAtTime| ,(spocq.i::universal-time-date-time start-time))

771

                                                       (,task-uuid |prov|:|endedAtTime| ,(spocq.i::universal-time-date-time (get-universal-time)))

772

                                                       (,task-uuid |as|:|actor| ,(spocq.i::agent-identifier (http:request-agent request)))

773

                                                       (,task-uuid |as|:|object| ,object-identifier)

774

                                                       (,task-uuid |as|:|inReplyTo| ,client-request-id))

775

                                                     (complement #'null))))))

776

777

   (:method ((method (eql :post)) (resource ldp:container) request response (request-type mime:mime-type) response-type (request-source spocq:iri))

778

"posting non-rdf content to a container:

779

construct a non-rdf-resource to cache the location and metadata and post that.

780

see https://ci.mines-stetienne.fr/rdfp/ for media type predicate"

781

(let* ((start-time (get-universal-time))

782

(repository (spocq.i::instance-repository resource))

783

(member-link-type (request-type-link-header-type request))

784

(member-type (compute-effective-member-type request-type nil member-link-type))

785

(member-identifier (intern-iri (or (http:request-header request :base-iri)

786

                                               (http:bad-request "a request base iri is required."))))

787

(request-type-url (or (spocq.i::mime-type-url request-type :if-does-not-exist nil)

788

                                  (http:unsupported-media-type "LDP: post media type not supported: ~a" (type-of request-type))))

789

(content-field `((,member-identifier |rdf|:|type| ,member-type)

790

                             (,member-identifier <https://w3id.org/rdfp/mediaType> ,request-type-url)

791

(,member-identifier |dcat|:|downloadURL| ,request-source)))

792

;; base iri should have been patched prior to parsing the request content

793

(member-slug (http:request-header request :slug))

794

(member (make-instance member-type

795

:triples content-field

796

:identifier member-identifier

797

:repository (spocq.i::instance-repository resource)))

798

(location-identifier (ldp:resource-post resource member))

799

(task-uuid (spocq.i::intern-uuid dydra:*task-id*))

800

(client-request-id (request-client-request-id request)))

801

(setf (http:response-header response :location) (dydra:iri-lexical-form location-identifier))

802

(setf (http:response-etag response) (dydra:resolve-repository-revision-id repository))

803

(setf (http:response-header response "Client-Request-ID") client-request-id)

804

(setf (http:response-header response "Request-ID") dydra:*task-id*)

805

;; once the post happens, the resource will have been aligned with the type

806

;; the response should reflect the end class

807

       (pushnew (compute-response-type-link-header member-type) (http:response-header response :link) :test #'equal)

808

;; the etag is not provided for modifications,, but if it were, it would

809

;; need to reflect the transaction id, rather its reference revision

810

(http:created)

811

(let* ((object-identifier (compute-resource-external-identifier resource member-identifier)))

812

(spocq.i::make-list-solution-field

813

:dimensions spocq.i::*construct-dimensions*

814

:solutions (spocq.i::filter-solution-field `((,task-uuid |as|:|id| ,task-uuid)

815

                                                       (,task-uuid |rdf|:|type| |as|:|Update|)

816

                                                       (,task-uuid |rdf|:|type| |mthd|:|POST|)

817

                                                       (,task-uuid <http://purl.org/dc/terms/title> ,member-slug)

818

                                                       (,task-uuid |prov|:|startedAtTime| ,(spocq.i::universal-time-date-time start-time))

819

                                                       (,task-uuid |prov|:|endedAtTime| ,(spocq.i::universal-time-date-time (get-universal-time)))

820

                                                       (,task-uuid |as|:|actor| ,(spocq.i::agent-identifier (http:request-agent request)))

821

                                                       (,task-uuid |as|:|object| ,object-identifier)

822

                                                       (,task-uuid |as|:|inReplyTo| ,client-request-id))

823

                                                     (complement #'null))))))

824

825

   (:method ((method (eql :put)) (resource ldp:resource) request response (request-type t) response-type request-source)

826

"Replace the 'identified resource'.

827

First clear its graph, then insert any triples and any quads in the given graph.

828

Quads in another graph leas to a BAD-REQUEST error."

829

(handler-case (ldp:resource-put resource (dydra:parse-nquads request-source))

830

(spocq.e:constraint-violation (condition)

831

                                     (push  "<http://www.w3.org/ns/ldp#contains>; rel=\"http://www.w3.org/ns/ldp#constrainedBy\""

832

                                            (http:response-header response :link))

833

                                     (apply #'http:conflict (condition-format-control condition) (condition-format-arguments condition)))

834

(spocq.e:request-error (condition)

835

                              (apply #'http:bad-request (condition-format-control condition) (condition-format-arguments condition))))

836

     (setf (http:response-header response :location) (dydra:iri-lexical-form (dydra:instance-identifier resource)))

837

     (pushnew (compute-response-type-link-header resource) (http:response-header response :link) :test #'equal)

838

;; the etag is not provided for modifications,, but if it were, it would

839

;; need to reflect the transaction id, rather its reference revision

840

(http:created)))

841

842

843

;;; validation

844

845

(load-time-validate (compute-prefer-header-bindings)

846

(mapcar #'compute-prefer-header-bindings

847

'("Prefer: return=representation; max-triple-count=\"500\""

848

"Prefer: return=representation; max-member-count=\"10\""

849

                               "Prefer: return=representation; max-member-count=\"10\"; max-kbyte-count=\"100\""

850

                               "Prefer: return=representation; omit=\"http://www.w3.org/ns/ldp#PreferMembership http://www.w3.org/ns/ldp#PreferContainment\""

851

                               "Prefer: return=representation; include=\"http://www.w3.org/ns/ldp#PreferMinimalContainer\""

852

))

853

'((:MAX-TRIPLE-COUNT 500) (:MAX-MEMBER-COUNT 10)

854

(:MAX-MEMBER-COUNT 10 :MAX-KBYTE-COUNT 100)

855

                       (:OMIT (|http://www.w3.org/ns/ldp#|:|PreferMembership| |http://www.w3.org/ns/ldp#|:|PreferContainment|))

856

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