/
ring.clj
155 lines (138 loc) · 4.92 KB
/
ring.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
;; Copyright 2014 Red Hat, Inc, and individual contributors.
;;
;; Licensed under the Apache License, Version 2.0 (the "License");
;; you may not use this file except in compliance with the License.
;; You may obtain a copy of the License at
;;
;; http://www.apache.org/licenses/LICENSE-2.0
;;
;; Unless required by applicable law or agreed to in writing, software
;; distributed under the License is distributed on an "AS IS" BASIS,
;; WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
;; See the License for the specific language governing permissions and
;; limitations under the License.
(ns ^{:no-doc true} immutant.web.internal.ring
(:require [potemkin :refer [def-map-type]]
[clojure.java.io :as io]
[immutant.web.async :as async]
[immutant.web.internal.headers :as hdr])
(:import [java.io File InputStream OutputStream]
[clojure.lang ISeq PersistentHashMap]))
(defprotocol Session
(attribute [session key])
(set-attribute! [session key value])
(get-expiry [session])
(set-expiry [session timeout]))
(def ring-session-key "ring-session-data")
(defn ring-session [session]
(if session (attribute session ring-session-key)))
(defn set-ring-session! [session, data]
(set-attribute! session ring-session-key data))
(defn session-expirer
[timeout]
(fn [session]
(when (not= timeout (get-expiry session))
(set-expiry session timeout))
session))
(def-map-type LazyMap [^java.util.Map m]
(get [_ k default-value]
(if (.containsKey m k)
(let [v (.get m k)]
(if (delay? v)
@v
v))
default-value))
(assoc [_ k v]
(LazyMap.
(assoc
(if (instance? PersistentHashMap m)
m
(PersistentHashMap/create m)) k v)))
(dissoc [_ k]
(LazyMap.
(dissoc
(if (instance? PersistentHashMap m)
m
(PersistentHashMap/create m)) k)))
(keys [_]
(keys m)))
(defprotocol RingRequest
(server-port [x])
(server-name [x])
(remote-addr [x])
(uri [x])
(query-string [x])
(scheme [x])
(request-method [x])
(headers [x])
(content-type [x])
(content-length [x])
(character-encoding [x])
(ssl-client-cert [x])
(body [x])
(context [x])
(path-info [x]))
(defn ring-request-map
([request & extra-entries]
(->LazyMap
(let [m (doto (java.util.HashMap. 24)
(.put :server-port (delay (server-port request)))
(.put :server-name (delay (server-name request)))
(.put :remote-addr (delay (remote-addr request)))
(.put :uri (delay (uri request)))
(.put :query-string (delay (query-string request)))
(.put :scheme (delay (scheme request)))
(.put :request-method (delay (request-method request)))
(.put :headers (delay (headers request)))
(.put :content-type (delay (content-type request)))
(.put :content-length (delay (content-length request)))
(.put :character-encoding (delay (character-encoding request)))
(.put :ssl-client-cert (delay (ssl-client-cert request)))
(.put :body (delay (body request)))
(.put :context (delay (context request)))
(.put :path-info (delay (path-info request))))]
(doseq [[k v] extra-entries]
(.put m k v))
m))))
(defprotocol BodyWriter
"Writing different body types to output streams"
(write-body [body stream headers]))
(extend-protocol BodyWriter
Object
(write-body [body _ _]
(throw (IllegalStateException. (str "Can't coerce body of type " (class body)))))
nil
(write-body [_ _ _])
String
(write-body [body ^OutputStream os headers]
(.write os (.getBytes body
(or (hdr/get-character-encoding headers)
hdr/default-encoding))))
ISeq
(write-body [body ^OutputStream os headers]
(doseq [fragment body]
(write-body fragment os headers)))
File
(write-body [body ^OutputStream os _]
(io/copy body os))
InputStream
(write-body [body ^OutputStream os _]
(with-open [body body]
(io/copy body os))))
(defprotocol RingResponse
(header-map [x])
(set-status [x status])
(output-stream [x]))
(defn write-response
"Set the status, write the headers and the content"
[response {:keys [status headers body]}]
(when status
(set-status response status))
(let [hmap (header-map response)
streaming? (async/streaming-body? body)]
(hdr/write-headers hmap (if streaming?
(async/add-streaming-headers headers)
headers))
(if streaming?
(async/open-stream body hmap)
(write-body body (output-stream response) hmap))))