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 | (ns ird.gate-test
(:require [cljs.test :refer [deftest is testing]]
[cljs.core.async :refer [<! go]]
[ird.client :as ird]
[ird.errors :as err]
[ird.gate :as gate]
[ird.ipfs :as ipfs]
[ird.test-util :as tu :refer [deftest-async]]))
(def registrations-page
{:registrations [{:id "reg-1" :domain "safe.ro"}
{:id "reg-2" :domain "prod.ro"}
{:id "reg-3" :domain "Sub.Prod.ro"}]
:next_cursor nil})
(defn- with-registrations-http
"An :http-fn answering the registrations listing and delegating every other
request to OTHER (default: record into CAPTURED and answer 200 {})."
([captured] (with-registrations-http captured (tu/capturing captured)))
([_captured other]
(fn [req]
(if (re-find #"/domains/registrations\?" (:url req))
(go {:status 200 :body (tu/->json registrations-page)})
(other req)))))
(defn- gated-client
"Channel of [client captured] for a gated client whose non-listing requests
are answered by OTHER (see with-registrations-http)."
([opts] (gated-client opts nil))
([opts other]
(go (let [captured (atom [])
http (if other
(with-registrations-http captured other)
(with-registrations-http captured))]
[(<! (ird/make-gated-client (merge {:api-key "ird_k" :http-fn http} opts)))
captured]))))
(defn- registration-404
"Answers 404 to the single-registration lookup done on a cache miss."
[captured]
(tu/responding captured 404 {:error {:code "not-found" :message "no such registration"}}))
(defn- denied? [v] (and (tu/error? v) (err/domain-denied? v)))
(deftest-async matching-test
;; exact match, case-insensitive, trailing dot ignored
(let [[client _] (<! (gated-client {:denied-domains ["Prod.RO"]}))]
(is (denied? (<! (gate/check client "POST /x" {:domain "prod.ro."})))))
;; wildcard matches subdomains and the bare suffix
(let [[client _] (<! (gated-client {:denied-domains ["*.prod.ro"]}))]
(is (denied? (<! (gate/check client "POST /x" {:domain "api.prod.ro"}))))
(is (denied? (<! (gate/check client "POST /x" {:domain "prod.ro"}))))
(is (nil? (<! (gate/check client "POST /x" {:domain "notprod.ro"})))))
;; allow-list denies everything not listed
(let [[client _] (<! (gated-client {:allowed-domains ["safe.ro"]}))]
(is (nil? (<! (gate/check client "POST /x" {:domain "safe.ro"}))))
(let [e (<! (gate/check client "POST /x" {:domain "other.ro"}))]
(is (denied? e))
(is (= "other.ro" (:domain (ex-data e))))
(is (= "POST /x" (:op (ex-data e))))))
;; deny wins over allow
(let [[client _] (<! (gated-client {:allowed-domains ["*.ro"] :denied-domains ["prod.ro"]}))]
(is (nil? (<! (gate/check client "POST /x" {:domain "safe.ro"}))))
(let [e (<! (gate/check client "POST /x" {:domain "prod.ro"}))]
(is (denied? e))
(is (= "prod.ro" (:matched-pattern (ex-data e))))))
;; an empty allow-list denies every domain mutation
(let [[client _] (<! (gated-client {:allowed-domains []}))]
(is (denied? (<! (gate/check client "POST /x" {:domain "anything.ro"}))))))
(deftest-async registration-id-resolution-test
;; ids resolve to domains through the cache built at attach time
(let [[client captured] (<! (gated-client {:denied-domains ["prod.ro"]}))]
(is (denied? (<! (gate/check client "POST /y" {:registration-id "reg-2"}))))
(is (nil? (<! (gate/check client "POST /y" {:registration-id "reg-1"}))))
(is (empty? @captured) "cache hits make no request"))
;; cached domains are normalized
(let [[client _] (<! (gated-client {:denied-domains ["sub.prod.ro"]}))]
(is (denied? (<! (gate/check client "POST /y" {:registration-id "reg-3"})))))
;; cache miss fetches the single registration, applies the gate and caches
(let [captured (atom [])
late (tu/responding captured 200 {:registration {:id "reg-late" :domain "prod.ro"}})
[client _] (<! (gated-client {:denied-domains ["prod.ro"]} late))]
(is (denied? (<! (gate/check client "POST /y" {:registration-id "reg-late"}))))
(is (= ["GET /domains/registrations/reg-late"] (mapv tu/op-of @captured)))
(is (denied? (<! (gate/check client "POST /y" {:registration-id "reg-late"}))))
(is (= 1 (count @captured)) "second check is served from the cache"))
;; id unknown to cache and API passes under a pure deny-list
(let [[client _] (<! (gated-client {:denied-domains ["prod.ro"]} (registration-404 (atom []))))]
(is (nil? (<! (gate/check client "POST /y" {:registration-id "reg-unknown"})))))
;; id unknown to cache and API fails closed under an allow-list
(let [[client _] (<! (gated-client {:allowed-domains ["safe.ro"]} (registration-404 (atom []))))
e (<! (gate/check client "POST /y" {:registration-id "reg-unknown"}))]
(is (denied? e))
(is (nil? (:domain (ex-data e))))))
(deftest-async gateway-domain-pins-test
;; attaching pins to a denied gateway domain fails before the POST
(let [captured (atom [])
lookup (tu/responding captured 200 {:domain {:id "gw-1" :domain "gw.prod.ro"}})
[client _] (<! (gated-client {:denied-domains ["*.prod.ro"]} lookup))
e (<! (ipfs/update-domain-pins client "gw-1" {:add ["pin-1"]}))]
(is (denied? e))
(is (= "gw.prod.ro" (:domain (ex-data e))))
(is (= ["GET /ipfs/domains/gw-1"] (mapv tu/op-of @captured)) "only the lookup went out"))
;; an allowed gateway domain sends the delta
(let [captured (atom [])
lookup (tu/responding captured 200 {:domain {:id "gw-2" :domain "gw.safe.ro" :pin_count 1}})
[client _] (<! (gated-client {:denied-domains ["*.prod.ro"]} lookup))
resp (<! (ipfs/update-domain-pins client "gw-2" {:add ["pin-1"]}))]
(is (= 1 (get-in resp [:domain :pin_count])))
(is (= ["GET /ipfs/domains/gw-2" "POST /ipfs/domains/gw-2/pins"] (mapv tu/op-of @captured)))
(is (= {:add ["pin-1"]} (tu/json-body (second @captured)))))
;; an ungated client skips the lookup entirely
(let [captured (atom [])
client (ird/make-client {:api-key "ird_k" :http-fn (tu/capturing captured)})]
(<! (ipfs/update-domain-pins client "gw-3" {:remove ["pin-1"]}))
(is (= ["POST /ipfs/domains/gw-3/pins"] (mapv tu/op-of @captured)))))
(deftest-async gate-lifecycle-test
;; a client without gate options has no gate and check is a no-op
(let [client (ird/make-client {:api-key "ird_k"})]
(is (nil? (:gate client)))
(is (nil? (<! (gate/check client "POST /x" {:domain "anything.ro"})))))
;; gate options on an anonymous client deliver a config error, without a request
(let [captured (atom [])
e (<! (ird/make-gated-client {:denied-domains ["x.ro"] :http-fn (tu/capturing captured)}))]
(is (err/config-error? e))
(is (re-find #"require an authenticated client" (ex-message e)))
(is (empty? @captured)))
;; a failing registration fetch is delivered
(let [e (<! (ird/make-gated-client {:api-key "k" :denied-domains ["x.ro"]
:http-fn (tu/responding 401 {:error {:code "unauthorized" :message "no"}})}))]
(is (err/api-error? e)))
;; the gate refuses before any request reaches the transport
(let [[client captured] (<! (gated-client {:denied-domains ["prod.ro"]}))]
(is (denied? (<! (gate/check client "POST /x" {:domain "prod.ro"}))))
(is (empty? @captured)))
;; refresh picks up newly registered domains
(let [calls (atom 0)
other (fn [req]
(swap! calls inc)
(go (if (re-find #"/domains/registrations/reg-9$" (:url req))
{:status 404 :body (tu/->json {:error {:code "not-found" :message "no"}})}
{:status 200 :body "{}"})))
[client _] (<! (gated-client {:allowed-domains ["safe.ro" "new.ro"]} other))]
(is (denied? (<! (gate/check client "POST /y" {:registration-id "reg-9"}))))
(let [refreshed (assoc client :http-fn
(tu/responding 200 {:registrations [{:id "reg-9" :domain "new.ro"}] :next_cursor nil}))]
(is (= {"reg-9" "new.ro"} (<! (gate/refresh refreshed)))))
(is (nil? (<! (gate/check client "POST /y" {:registration-id "reg-9"}))) "the shared cache atom was updated")))
(deftest normalize-test
(is (= "example.ro" (gate/normalize " Example.RO. ")))
(is (nil? (gate/normalize "")))
(is (nil? (gate/normalize nil))))
|