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

Kind	Covered	All	%
expression	0	103	0.0
branch	0	6	0.0

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

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

4

5

(defparameter *web-ui.print-methods* nil)

6

7

(http:def-resource-function web-ui (resource request response)

8

(:log )

9

(:auth http:authenticate-request-password)

10

(:auth http:authenticate-request-token)

11

(:auth http:authenticate-request-session)

12

(:auth http:authenticate-request-location)

13

14

(:auth http:authorize-request)

15

16

   ;; queries may appear as get or post requests with the appropriate combination of content and accept type

17

;; in any case, the query result must be encoded as per accept type

18

(:encode :default mime:application/json)

19

20

(:decode mime:application/json)

21

22

(:method :around (resource request response content-type accept)

23

(when *web-ui.print-methods*

24

(let ((*print-pretty* nil))

25

(map nil 'print (compute-applicable-methods #'web-ui

26

                                                     (list resource request response content-type accept)))

27

(describe request)))

28

(call-next-method))

29

30

;; permit head requests for the standard response media types

31

;; graph store and views

32

   (:head ((resource graph-store-service-resource) request response (request-type t) (response-type mime:application/json))

33

(web-ui-head resource request response request-type response-type))

34

35

;; need to add get/post requests for ld+json to extract the context from the request haeader

36

;; and provide the headers for the response

37

;; for graph content

38

#+(or)

39

( ;; these will conflict

40

   (:get ((resource |/:account/:repository/:view|) request response (request-type null) (response-type mime:application/json))

41

(web-ui-get-view resource request response request-type response-type))

42

   (:get ((resource |/admin/accounts/:account/repositories/:repository/configuration/:property|) request response (request-type null) (response-type mime:application/json))

43

(web-ui-get-view resource request response request-type response-type))

44

45

46

   (:put ((resource |/:account/:repository/:view|) request response (request-type mime:application/json) (response-type t))

47

(web-ui-put-view resource request response request-type response-type))

48

   (:put ((resource |/admin/accounts/:account/repositories/:repository/configuration/:property|) request response (request-type mime:application/json) (response-type t))

49

(web-ui-put-view resource request response request-type response-type))

50

)

51

)

52

53

54

(defgeneric web-ui-head (resource request response request-type response-type &key context)

55

(:method ((resource repository-resource) request response request-type response-type

56

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

57

(web-ui-head (resource-repository resource) request response request-type response-type

58

:context context))

59

60

(:method ((repository dydra:repository) request response request-type response-type &rest args)

61

(declare (dynamic-extent args))

62

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

63

(or (http:request-header request "Revision")

64

(http:request-header request "Accept-Datetime"))

65

(dydra:repository-revision-id repository)

66

"HEAD"))

67

(revision (spocq.i::compute-repository-revision repository revision-id)))

68

(apply #'web-ui-head revision request response request-type response-type args)))

69

70

(:method ((revision dydra:repository-revision) request response request-type response-type

71

&key context)

72

(let* ((revision-id (repository-revision-id revision))

73

(modification-time (or (dydra:repository-write-date revision) (get-universal-time)))

74

(rfc1123-modification-time (http:encode-rfc1123 modification-time)))

75

(flet ((graph-is-not-empty ()

76

(spocq.i::repository-pattern-match-p revision nil nil nil context)))

77

;; an empty repository is to be reported as not-found

78

(cond ((or (request-is-silent request *graph-store-get-is-silent*)

79

(graph-is-not-empty))

80

(when (http:request-cache-matched-p request revision-id modification-time)

81

(http:not-modified))

82

(setf (http:response-header response :Access-Control-Expose-Headers) "*")

83

(setf (http:response-header response :Access-Control-Allow-Origin) "*")

84

(setf (http:response-header response :Access-Control-Allow-Credentials) "true")

85

(setf (http:response-etag response) revision-id)

86

(setf (http:response-last-modified response) rfc1123-modification-time)

87

(setf (http:response-accept-ranges response) nil)

88

                (setf (http:response-cache-control response) (if (dydra:repository-public-p revision) "public" "private"))

89

(if *memento-response-headers*

90

                    (set-memento-response-headers response revision-id :rfc1123-modification-time rfc1123-modification-time)

91

(setf (http:response-vary response) "*"))

92

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

93

nil)

94

(t

95

(http:not-found)))))))

96

97

#+(or)

98

(defgeneric web-ui-get-view (resource request response request-type response-type)

99

(:method (request response request-type response-type)

100

(let ((view-text (repository-view resource (resource-view resource))))

101

(json-encode `(("view" . ,view-text))

102

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