-
Notifications
You must be signed in to change notification settings - Fork 11
/
core.clj
232 lines (212 loc) · 8.11 KB
/
core.clj
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
217
218
219
220
221
222
223
224
225
226
227
228
229
230
231
(ns framework.session.core
"Xiana's session management"
(:require
[clojure.string :as string]
[framework.db.core :as db]
[jsonista.core :as json]
[next.jdbc.result-set :refer [as-kebab-maps]]
[xiana.core :as xiana])
(:import
(java.util
UUID)
(org.postgresql.util
PGobject)))
;; define session protocol
(defprotocol Session
;; fetch an element (no side effect)
(fetch [_ k])
;; fetch all elements (no side effect)
(dump [_])
;; add an element (side effect)
(add! [_ k v])
;; delete an element (side effect)
(delete! [_ k])
;; erase all elements (side effect)
(erase! [_]))
(def mapper (json/object-mapper {:decode-key-fn keyword}))
(def ->json json/write-value-as-string)
(def <-json #(json/read-value % mapper))
(defn ->pgobject
"Transforms Clojure data to a PGobject that contains the data as
JSON. PGObject type defaults to `jsonb` but can be changed via
metadata key `:pgtype`"
[x]
(let [pgtype (or (:pgtype (meta x)) "jsonb")]
(doto (PGobject.)
(.setType pgtype)
(.setValue (->json x)))))
(defn <-pgobject
"Transform PGobject containing `json` or `jsonb` value to Clojure
data."
[^PGobject v]
(let [type (.getType v)
value (.getValue v)]
(if (#{"jsonb" "json"} type)
(some-> value
<-json
(with-meta {:pgtype type}))
value)))
(defn un-objectify
[table data]
(let [{session-data (keyword (name table) "session-data")
session-id (keyword (name table) "session-id")
modified-at (keyword (name table) "modified-at")} data]
{session-id (some-> session-data
<-pgobject
(assoc :modified-at modified-at))}))
(defn ->session-data [table rs]
(when-let [session-data (first rs)]
(let [[_ data] (first (un-objectify table session-data))]
data)))
(defn connect
[{backend-config :xiana/session-backend :as cfg}]
(let [ds-config {:xiana/postgresql backend-config
:xiana/jdbc-opts {:builder-fn as-kebab-maps}}
connection (cond (every? backend-config [:port :dbname :host :dbtype :user :password]) (db/connect ds-config)
(get-in cfg [:db :datasource]) cfg
:else (db/connect {:xiana/postgresql
(assoc (merge (:xiana/postgresql cfg) backend-config)
:xiana/jdbc-opts {:builder-fn as-kebab-maps})}))]
(get-in connection [:db :datasource])))
(defn- init-in-db
"Initialize persistent database session storage."
[{backend-config :xiana/session-backend :as cfg}]
(let [ds (connect cfg)
table (:session-table-name backend-config :sessions)
get-all {:select [:*]
:from [table]}
get-one (fn [k] {:select [:session_data :modified_at]
:from [table]
:where [:= :session_id k]})
insert-session (fn [k v] {:insert-into table
:values [{:session_id k
:session_data (->pgobject v)}]
:upsert {:on-conflict [:session_id]
:do-update-set [:session_data :modified-at]}})
erase-session-store {:truncate table}
delete-session (fn [k] {:delete-from table
:where [:= :session_id k]})
unpack (partial un-objectify table)]
(assoc cfg
:session-backend
;; implement the Session protocol
(reify Session
;; fetch session key:element
(fetch [_ k] (->session-data table (db/execute ds (get-one k))))
;; fetch all elements (no side effect)
(dump [_] (into {} (map unpack (db/execute ds get-all))))
;; add session key:element
(add!
[_ k v]
(let [k (or k (UUID/randomUUID))]
(when v (first (map unpack (db/execute ds (insert-session k v)))))))
;; delete session key:element
(delete! [_ k] (first (map unpack (db/execute ds (delete-session k)))))
;; erase session
(erase! [_] (db/execute ds erase-session-store))))))
(defn- init-in-memory
"Initialize session in memory."
([cfg] (init-in-memory cfg (atom {})))
([cfg m]
(assoc cfg
:session-backend
;; implement the Session protocol
(reify Session
;; fetch session key:element
(fetch [_ k] (get @m k))
;; fetch all elements (no side effect)
(dump [_] @m)
;; add session key:element
(add!
[_ k v]
(let [k (or k (UUID/randomUUID))]
(swap! m assoc k v)))
;; delete session key:element
(delete! [_ k] (swap! m dissoc k))
;; erase session
(erase! [_] (reset! m {}))))))
(defn ->session-id
[{{headers :headers
cookies :cookies
query-params :query-params} :request}]
(UUID/fromString (or (some->> headers
:session-id)
(some->> cookies
:session-id
:value)
(some->> query-params
:SESSIONID))))
(defn fetch-session
[state]
(let [session-backend (-> state :deps :session-backend)
session-id (->session-id state)
session-data (or (fetch session-backend session-id)
(throw (ex-message "Missing session data")))]
(xiana/ok (assoc state :session-data (assoc session-data :session-id session-id)))))
(defn- on-enter
[state]
(try (fetch-session state)
(catch Exception _
(xiana/error
(assoc state :response {:status 401
:body (json/write-value-as-string
{:message "Invalid or missing session"})})))))
(defn- protect
[protected-path
excluded-resource
{{uri :uri} :request
:as state}]
(if (and (string/starts-with? uri protected-path)
(not= uri (str protected-path excluded-resource)))
(on-enter state)
(xiana/ok state)))
(defn- on-leave
[{{session-id :session-id} :session-data :as state}]
(if session-id
(let [session-backend (-> state :deps :session-backend)]
(add! session-backend
session-id
(:session-data state))
;; associate the session id
(xiana/ok
(assoc-in state
[:response :headers "Session-id"]
(str session-id))))
(xiana/ok state)))
(defn protected-interceptor
"On enter allows a resource to be served when
* it is not protected
or
* the user-provided `session-id` exists in the server's session store.
If the session exists in the session store, it's copies it to the (-> state :session-data),
else responds with {:status 401
:body \"Invalid or missing session\"}
On leave, it updates the session storage from (-> state :session-data)"
[protected-path excluded-resource]
{:enter (partial protect protected-path excluded-resource)
:leave on-leave})
(def interceptor
{:enter on-enter
:leave on-leave})
(def guest-session-interceptor
{:enter
(fn [state]
(try (fetch-session state)
(catch Exception _
(let [session-backend (-> state :deps :session-backend)
session-id (UUID/randomUUID)
user-id (UUID/randomUUID)
session-data {:session-id session-id
:users/role :guest
:users/id user-id}]
(add! session-backend session-id session-data)
(xiana/ok (assoc state :session-data session-data))))))
:leave on-leave})
(defn init-backend
[{session-backend :session-backend
{storage :storage} :xiana/session-backend
:as config}]
(cond
session-backend config
(= :database storage) (init-in-db config)
:else (init-in-memory config)))