Coverage report: /home/ellis/comp/core/lib/obj/srv.lisp

KindCoveredAll%
expression058 0.0
branch06 0.0
Key
Not instrumented
Conditionalized out
Executed
Not executed
 
Both branches taken
One branch taken
Neither branch taken
1
 ;;; srv.lisp --- Sans-IO Service Protocol
2
 
3
 ;; Base Protocol used by any type of managed/stateful service.
4
 
5
 ;;; Commentary:
6
 
7
 ;; As NET/SRV started coming together I realized we need proper isolation of
8
 ;; the implementations (UDP, HTTP/S, and EXTernal at TOW) from the core
9
 ;; protocol.
10
 
11
 ;; This package provides as much common functionality as possible and may be
12
 ;; further extended by the implementations.
13
 
14
 ;; Notably, this package does not perform any IO itself, that is totally up to
15
 ;; the implementation. The objects in this package consume incoming packets,
16
 ;; requests, and events via HANDLE-* functions.
17
 
18
 ;;;; TODO:
19
 
20
 ;; request/response? here
21
 ;; engine? either here or obj/eng.lisp, build on std/task, std/thread
22
 
23
 ;; %service-protocol
24
 
25
 ;; session? prob here or in HTTP/S impl
26
 ;; connection? lower-level than session
27
 
28
 ;; endpoint? closer to service
29
 ;; transport? closer to socket
30
 ;; routes? build on std/pipe, probably in net/srv/*
31
 
32
 ;; configs for everything
33
 
34
 ;; program-service -> sb-ext:run-program IO
35
 
36
 ;;;; REFS:
37
 
38
 ;; Tower: https://github.com/tower-rs/tower
39
 
40
 ;; Axum: https://github.com/tokio-rs/axum
41
 
42
 ;;; Code:
43
 (in-package :obj/srv)
44
 
45
 ;;; Vars
46
 (defvar *service* nil)
47
 (defvar *service-table* (make-hash-table :weakness :value))
48
 (defvar *request* nil)
49
 (defvar *response* nil)
50
 
51
 ;;; Utils
52
 (defun in-request-p () (and (boundp '*request*) *request*))
53
 (defun in-response-p () (and (boundp '*response*) *response*))
54
 
55
 ;;; Conditions
56
 (define-condition service-condition (condition) ())
57
 (eval-always
58
   (deferror service-error (service-condition error) () (:auto t)))
59
 (deferror simple-service-error (service-error simple-condition) () (:auto t))
60
 
61
 (define-condition service-warning (service-condition warning) ())
62
 
63
 (defwarning simple-service-warning (service-warning simple-warning) () (:auto t))
64
 
65
 (deferror bad-request (service-error) ())
66
 
67
 ;;; Objects
68
 (defclass engine () 
69
   ((service :accessor service :initarg :service 
70
             :documentation "A link to the SERVICE which owns this instance.")))
71
 
72
 (defclass service (id)
73
   ((request-class :type symbol :initarg :request-class :accessor service-request-class)
74
    (response-class :type symbol :initarg :response-class :accessor service-response-class)
75
    (engine :type engine :accessor engine :initarg :engine)))
76
 
77
 (defclass response () ())
78
 
79
 (defgeneric make-response (&rest args &key &allow-other-keys))
80
 
81
 (defclass service-response (response)
82
   ((content-type :reader content-type)
83
    (content-length :reader content-length :initform nil)))
84
 
85
 (defmethod response-ok-p ((res response)) t)
86
 
87
 (defclass request ()
88
   ((data :initarg :data :accessor data)))
89
 
90
 (defgeneric make-request (&rest args &key &allow-other-keys))
91
 
92
 (defclass service-request (request)
93
   ((content-stream :initarg :content-stream :reader content-stream)
94
    (service :initarg :service
95
             :reader service)
96
    (session :initform nil
97
             :accessor session)
98
    (protocol :initarg :request-protocol :reader request-protocol)))
99
 
100
 (defconfig service-config () ())
101
   
102
 ;;; Protocol
103
 (defgeneric service (self)
104
   (:method ((self t)) (when (boundp '*service*) *service*))
105
   (:method ((self symbol)) (gethash self *service-table*))
106
   (:method ((self string)) (gethash (symbolicate (string-upcase self)) *service-table*)))
107
 
108
 (defgeneric restart-service (self)
109
   (:documentation "Restart a service.")
110
   (:method ((self t))
111
     (stop self)
112
     (start self)))
113
 
114
 (defgeneric process-request (req)
115
   (:documentation "Function called by PROCESS-CONNECTION after reading incoming headers. Calls
116
 HANDLE-REQUEST to dispatch to a route and return output to the client using
117
 START-OUTPUT.
118
 
119
 Return value is ignored."))
120
 
121
 (defgeneric handle-request (self request)
122
   (:documentation "Function called after fetching a request. Used to establish error handling,
123
 logging, etc."))
124
 (defgeneric dispatch-request (self request)
125
   (:documentation "Function called after 'handle-request' which routes a request to a service."))
126
 
127
 (defgeneric send-response (service stream &key content &allow-other-keys))
128
 (defgeneric send-request (client req &key &allow-other-keys))
129
 (defgeneric response-ok-p (res))
130
 (defgeneric response-status (res))
131
 (defgeneric (setf response-status) (new res))
132
 
133
 ;;; Tasks
134
 (define-task-kernel service-task-kernel () ()
135
   "Default task kernel for service-based tasks.")