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

KindCoveredAll%
expression075 0.0
branch04 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
 ;;; (load #p"patches/model.lisp")
3
 
4
 (in-package :org.datagraph.spocq)
5
 
6
 (dsu:modpackage :org.datagraph.spocq
7
   (:export :ws-url
8
            :make-ws-url
9
            :parse-ws-url
10
            :ws-url-scheme
11
            :ws-url-user
12
            :ws-url-password
13
            :ws-url-authority
14
            :ws-url-port
15
            :ws-url-path
16
            ))
17
 
18
 (defstruct (ws-url (:include iri (lexical-form "")))
19
   scheme
20
   user
21
   password
22
   authority
23
   port
24
   path
25
   )
26
 
27
 (defparameter *ws-url-scanner*
28
   (cl-ppcre:create-scanner `(:sequence :start-anchor
29
                                        (:sequence (:register (:alternation "ws" "wss"))
30
                                                   "://"
31
                                                    (:greedy-repetition
32
                                                     0 1
33
                                                     (:sequence
34
                                                      (:greedy-repetition
35
                                                       0 1
36
                                                       (:sequence
37
                                                        (:greedy-repetition 0 1
38
                                                                            (:register
39
                                                                             (:greedy-repetition 1 nil (:inverted-char-class #\:))))
40
                                                        ":"
41
                                                        (:greedy-repetition 0 1
42
                                                                            (:register
43
                                                                             (:greedy-repetition 1 nil (:inverted-char-class #\@))))
44
                                                        "@"))
45
                                                      (:register
46
                                                       (:greedy-repetition 1 nil (:inverted-char-class #\: #\/)))
47
                                                      (:greedy-repetition 0 1
48
                                                                          (:sequence ":"
49
                                                                                     (:register
50
                                                                                      (:greedy-repetition 1 nil (:inverted-char-class #\/)))))
51
                                                      (:greedy-repetition 0 1
52
                                                        (:register (:sequence "/"
53
                                                                              (:greedy-repetition 0 nil :everything)))))))
54
                                        :end-anchor))
55
   "ws[s]://[username][:password]@host.domain[:port]/path")
56
 
57
 (defun parse-ws-url (value)
58
   (multiple-value-bind (whole strings)
59
                        (cl-ppcre:scan-to-strings *ws-url-scanner* value)
60
     (if whole
61
         (values (loop for i from 0 for property in '(:scheme :user :password :authority :port :path)
62
                   for value = (aref strings i)
63
                   when value
64
                   append (list property (case property
65
                                           (:scheme (intern (string-upcase value) :keyword))
66
                                           (:port (parse-integer value))
67
                                           (t value))))
68
                 whole)
69
         (error "Invalid ws uri lexical form: ~s" value))))
70
 ;;; (parse-ws-url "ws://test.dydra.com")
71
 ;;; (parse-ws-url "ws://test.dydra.com/")
72
 ;;; (parse-ws-url "wss://test.dydra.com")
73
 ;;; (parse-ws-url "ws://test.dydra.com:8883")
74
 ;;; (parse-ws-url "ws://test.dydra.com:8883/account/repo/sparql")
75
 ;;; (parse-ws-url "ws://u:p@test.dydra.com")
76
 
77
 (defmethod ensure-iri-lexical-form ((uri ws-url))
78
   (let ((value (ws-url-lexical-form uri)))
79
     (if (plusp (length value))
80
         value
81
         (let ((scheme (ws-url-scheme uri))
82
               (user (ws-url-user uri))
83
               (password (ws-url-password uri))
84
               (authority (ws-url-authority uri))
85
               (port (ws-url-port uri))
86
               (path (ws-url-path uri)))
87
           (setf (spocq::ws-url-lexical-form uri)
88
                 (format nil "~(~a~)://~:[~2*~;~@[~a~]:~@[~a~]@~]~@[~a~]~@[:~a~]~@[~a~]"
89
                         scheme
90
                         (or user password)
91
                         user password authority port path
92
                         ))))))
93
 
94
 (defgeneric spocq:ws-url (value)
95
   (:method ((lexical-form cl:string))
96
     (multiple-value-bind (initargs lexical-form) (spocq:parse-ws-url lexical-form)
97
       (destructuring-bind (&key scheme (port (ecase scheme (:ws 80) (:wss 443)))
98
                            &allow-other-keys) initargs
99
         (apply #'spocq:make-ws-url :lexical-form lexical-form
100
                :scheme (if (eql port 443) :wss scheme)
101
                :port port
102
                initargs))))
103
   (:method ((url spocq:ws-url))
104
     (ensure-iri-lexical-form url)))
105
 
106
 (defmethod spocq.i::parse-uri-by-scheme ((type (eql :ws)) string)
107
   (spocq:ws-url string))
108
 
109
 (defmethod spocq.i::construct-uri-term ((scheme (eql :ws)) lexical-form)
110
   (spocq:ws-url lexical-form))
111
 ;;; (spocq:ws-url "ws://test.dydra.com")
112