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

Kind	Covered	All	%
expression	0	235	0.0
branch	0	26	0.0

Key

Not instrumented

Conditionalized out

Executed

Not executed

Both branches taken

One branch taken

Neither branch taken

1

(in-package :spocq.si)

2

3

 (defmethod repository-patch-multipart-content ((repository spocq.i::lmdb-replicable-repository) (input-stream stream) &key

4

                                                content-type context method

5

content-encoding

6

                                                (request http:*request*)

7

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

8

                                                (revision-id (or (http:request-query-argument request "revision-id")

9

                                                                 (http:request-header request "Revision")

10

                                                                 (dydra:make-revision-id)))

11

(task-id nil))

12

(declare (ignore content-encoding))

13

;; extract a default type and the separator from the content type

14

(let* ((boundary (mime:mime-type-boundary content-type))

15

(separator (concatenate 'string "--" boundary)) ; https://tools.ietf.org/html/rfc2046

16

(accepted-content-type (mime:mime-type (or (mime:mime-type-content-type content-type)

17

                                                     mime:application/n-quads)))

18

(original-graph-name context)

19

(repository-id (dydra:repository-id repository))

20

(base-revision-id (http:request-header request "If-Match"))

21

(line-number 0)

22

(statement-count 0)

23

(deleted-count 0)

24

(inserted-count 0)

25

(transaction-uuid nil))

26

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

27

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

28

(when (find repository-id spocq.i::*disabled-repositories* :test #'string-equal)

29

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

30

;; Generate a new transaction id and check that, if an explicit base revision

31

;; was supplied, that it matches the current head.

32

(let ((spocq.i::*repository* repository)

33

(spocq.i::*repository-id* repository-id)

34

(start (spocq.e:unix-now)))

35

;; If a revision id has been supplied, it serves as the transaction id.

36

;; otherwise, a new ne has been generated.

37

;; this determines where to place the content in the revision space.

38

       (dydra:with-open-transaction (repository-id :id revision-id :revision-id "HEAD" :normal-disposition :commit

39

:serialize t)

40

(when base-revision-id

41

(unless (equalp base-revision-id (spocq.i::transaction-parent-revision-id *transaction*))

42

(http:precondition-failed "The repository has been modified: ~s: ~s != ~s"

43

repository-id

44

                                       (spocq.i::transaction-parent-revision-id *transaction*)

45

base-revision-id)))

46

(setf transaction-uuid (spocq.i::transaction-id *transaction*))

47

         (let* ((insert-operation (spocq.i::set-uuid-state (spocq.i::string-to-uuid transaction-uuid (spocq.i::make-uuid-vector)) :insert))

48

                (delete-operation (spocq.i::set-uuid-state (spocq.i::string-to-uuid transaction-uuid (spocq.i::make-uuid-vector)) :delete))

49

(operation insert-operation)

50

(ordinal (rlmdb:get-metadata-ordinal repository))

51

(graph-name original-graph-name)

52

(content-type accepted-content-type))

53

(labels ((read-next-line ()

54

(when (peek-char t input-stream nil)

55

(incf line-number)

56

(read-line input-stream)))

57

(read-part-header ()

58

(setf graph-name original-graph-name)

59

(setf content-type accepted-content-type)

60

(let* ((CHUNGA:*ACCEPT-BOGUS-EOLS* t)

61

(headers (tbnl::read-http-headers input-stream)))

62

(loop for (keyword . value) in headers

63

do (incf line-number)

64

do (case keyword

65

                               ;; content type alternatives limited to inclusive sub-types of the accepted type

66

                               (:content-type (setf content-type (mime:mime-type value))

67

                                              (unless (typep (mime:mime-type value) accepted-content-type)

68

                                                (error "invalid content-type[~d]: ~s" line-number value)))

69

                               (:x-http-method-override (cond ((or (equalp value "put") (equalp value "post"))

70

                                                               (setf operation insert-operation))

71

                                                              ((equalp value "delete")

72

                                                               (setf operation delete-operation))))

73

(:graph (setf graph-name (dydra:intern-iri value)))

74

(t ))))

75

;; count blank line

76

(incf line-number))

77

(supply-statements (set-operation accept-quad)

78

(loop for line = (read-next-line)

79

until (null line)

80

do (cond ((zerop (length line)))

81

                                 ((string= separator line :end2 (min (length separator) (length line)))

82

                                  (setf line (string-trim #(#\space #\tab #\return #\linefeed) line))

83

                                  (when (and (>= (length line) (length separator))

84

                                             (string= "--" line :start2 (- (length line) 2)))

85

(return))

86

(read-part-header)

87

(funcall set-operation operation))

88

(t

89

                                  (let ((statement (dydra:parse-nquads-statement line)))

90

(unless statement

91

                                      (error "invalid statement[~d]: ~s" line-number line))

92

(incf statement-count)

93

(if (cdddr statement)

94

(funcall accept-quad statement)

95

                                        (funcall accept-quad (append statement (list graph-name))))))))))

96

(rlmdb::repository-accept-field repository #'supply-statements)

97

(rlmdb:put-repository-metadata repository :uuid transaction-uuid

98

:ordinal (1+ ordinal)

99

:end (spocq.e:unix-now)

100

:start start))))

101

;; upon completion, return transaction record

102

;; do not write a transaction event - that happens as part of the transaction-close(commit)

103

(let ((rr

104

(if (spocq.i::repository-is-revisioned repository)

105

(let* ((rlr (rlmdb:get-revision-log-record repository transaction-uuid)))

106

(cond (rlr

107

                           ;; change to correspond to import document rather than repository changes

108

                           (setf (rlmdb:revision-log-record-removed-count rlr) deleted-count)

109

                           (setf (rlmdb:revision-log-record-inserted-count rlr) inserted-count)

110

rlr)

111

(t

112

                           (log-warn "repository-patch-multipart-content: no revision log record: ~s ~s" repository transaction-uuid)

113

nil)))

114

(let* ((mr (rlmdb:get-metadata-record repository)))

115

(cond (mr

116

mr)

117

(t

118

                           (log-warn "repository-patch-multipart-content: no metadata record: ~s" repository)

119

nil))))))

120

(log-notice "service ~s: ~s ~s ~s. complete: ~s"

121

task-id method repository-id client-request-id (or rr transaction-uuid))

122

(values rr deleted-count inserted-count)))))