From ba1c1853a79a5930ca7db7a6b368859f805df98d Mon Sep 17 00:00:00 2001 From: Ludovic Courtès Date: Thu, 29 Aug 2019 15:59:16 +0200 Subject: swh: Add hooks for rate limiting handling. * guix/swh.scm (%allow-request?, %save-rate-limit-reset-time) (%general-rate-limit-reset-time): New variables. (request-rate-limit-reached?, update-rate-limit-reset-time!): New procedures. (call): Call '%allow-request?'. Change 'swh-error' protocol to pass METHOD in addition to URL. * tests/swh.scm ("rate limit reached") ("%allow-request? and request-rate-limit-reached?"): New tests. --- tests/swh.scm | 36 ++++++++++++++++++++++++++++++++++++ 1 file changed, 36 insertions(+) (limited to 'tests') diff --git a/tests/swh.scm b/tests/swh.scm index 9a0da07ae1..e36c54e5fb 100644 --- a/tests/swh.scm +++ b/tests/swh.scm @@ -19,6 +19,7 @@ (define-module (test-swh) #:use-module (guix swh) #:use-module (guix tests http) + #:use-module (web response) #:use-module (srfi srfi-64)) ;; Test the JSON mapping machinery used in (guix swh). @@ -68,6 +69,41 @@ (directory-entry-length entry))) (lookup-directory "123")))) +(test-equal "rate limit reached" + 3000000000 + (let ((too-many (build-response + #:code 429 + #:reason-phrase "Too many requests" + + ;; Pretend we've reached the limit and it'll be reset in + ;; June 2065. + #:headers '((x-ratelimit-remaining . "0") + (x-ratelimit-reset . "3000000000"))))) + (with-http-server `((,too-many "Too bad.")) + (parameterize ((%swh-base-url (%local-url))) + (catch 'swh-error + (lambda () + (lookup-origin "http://example.org/guix.git")) + (lambda (key url method response) + ;; Ensure the reset time was recorded. + (@@ (guix swh) %general-rate-limit-reset-time))))))) + +(test-assert "%allow-request? and request-rate-limit-reached?" + ;; Here we test two things: that the rate limit set above is in effect and + ;; that %ALLOW-REQUEST? is called, and that 'request-rate-limit-reached?' + ;; returns true. + (let* ((key (gensym "skip-request")) + (skip-if-limit-reached + (lambda (url method) + (or (not (request-rate-limit-reached? url method)) + (throw key #t))))) + (parameterize ((%allow-request? skip-if-limit-reached)) + (catch key + (lambda () + (lookup-origin "http://example.org/guix.git") + #f) + (const #t))))) + (test-end "swh") ;; Local Variables: -- cgit 1.4.1