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

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