From 28bb423d32dac9703e4301760cd55997aaedbfff Mon Sep 17 00:00:00 2001 From: Tony Garnock-Jones Date: Wed, 9 Nov 2016 05:21:30 +1300 Subject: [PATCH] Asynchronous verification --- rmq/server.rkt | 133 ++++++++++++++++++++++--------------------------- 1 file changed, 59 insertions(+), 74 deletions(-) diff --git a/rmq/server.rkt b/rmq/server.rkt index 781a2e1..609d9f3 100644 --- a/rmq/server.rkt +++ b/rmq/server.rkt @@ -47,12 +47,16 @@ ;; (notification Topic Bytes (Option String)) (struct notification (topic-name content content-type) #:prefab) -(struct subscription (topic-name ;; Topic - expiry-deadline ;; Deadline - canonical-hub ;; URLString - callback ;; URLString - secret ;; Option Bytes - poll-interval-seconds) ;; Option Number +;; (update-subscription Topic URLString (Option SubscriptionSettings)) +(struct update-subscription (topic callback settings) #:prefab) ;; message + +;; (subscription Topic URLString SubscriptionSettings) +(struct subscription (topic callback settings-) #:prefab) ;; assertion + +(struct subscription-settings (expiry-deadline ;; Deadline + canonical-hub ;; URLString + secret ;; Option Bytes + poll-interval-seconds) ;; Option Number #:prefab) ;; (local-topic-config Topic (Option Number) (Option Number)) @@ -334,69 +338,51 @@ (actor #:name 'hub (during (local-host $host-name) (on (web-request-incoming (id req) (vh host-name) 'post ("hub" ()) $body) - ;; Initially, I had an (actor* ...) form here for fault - ;; isolation. However, this led to problems since I wanted - ;; to use `assert!` and `retract!` to signal to the - ;; `during/actor`, and the assertions were being lost as - ;; the `actor*` terminated. So instead, I'm using Rackety - ;; `with-handlers`. - (define ok? - (with-handlers [(values (lambda (e) #f))] - (define params (make-immutable-hash - (form-urlencoded->alist (bytes->string/utf-8 body)))) - (define callback (hash-ref params 'hub.callback)) - (define mode - (match (hash-ref params 'hub.mode) - ["subscribe" 'subscribe] - ["unsubscribe" 'unsubscribe])) - (define topic (hash-ref params 'hub.topic)) - (define lease-seconds - (match (hash-ref params 'hub.lease_seconds *default-lease*) - ["unbounded" #f] - [n (string->number n)])) - (define poll-interval-seconds - (match (hash-ref params 'hub.poll_interval_seconds *default-poll-interval*) - ["none" #f] - [n (string->number n)])) - (define secret-string (hash-ref params 'hub.secret #f)) - (define secret-bytes (and secret-string (string->bytes/utf-8 secret-string))) - (define expiry-deadline (and lease-seconds (+ (current-seconds) lease-seconds))) - (define canonical-hub - (url->string (resource->url (web-request-header-resource req)))) - ;; TODO: asynchronous validation - (match mode - ['subscribe - (if (subscription-change-validate "subscribe" - (or lease-seconds "unbounded") - topic - callback) - (begin - (retract! (subscription topic ? ? callback ? ?)) - (assert! (subscription topic - expiry-deadline - canonical-hub - callback - secret-bytes - poll-interval-seconds)) - #t) - #f)] - ['unsubscribe - (if (subscription-change-validate "unsubscribe" - #f - topic - callback) - (begin - (retract! (subscription topic ? ? callback ? ?)) - #t) - #f)]))) - (if ok? - (web-respond/status! id 202 #"Accepted") - (web-respond/status! id 403 #"Forbidden" #"Validation failed")))) + (asynchronous-verification-of-intent id req body) + (web-respond/status! id 202 #"Accepted"))) - (during/actor (subscription $partial-topic _ _ $callback _ _) - #:name (list 'subscription partial-topic callback) - #:on-crash (retract! (subscription partial-topic ? ? callback ? ?)) - (subscription-main partial-topic callback))) + (on (message (update-subscription $topic $callback $settings)) + (retract! (subscription topic callback ?)) + (when settings (assert! (subscription topic callback settings)))) + + (during/actor (subscription $topic $callback _) + #:name (list 'subscription topic callback) + #:on-crash (retract! (subscription topic callback ?)) + (subscription-main topic callback))) + +(define (asynchronous-verification-of-intent id req body) + (actor* (define params (make-immutable-hash (form-urlencoded->alist (bytes->string/utf-8 body)))) + (define callback (hash-ref params 'hub.callback)) + (define mode (match (hash-ref params 'hub.mode) + ["subscribe" 'subscribe] + ["unsubscribe" 'unsubscribe])) + (define topic (hash-ref params 'hub.topic)) + (define lease-seconds (match (hash-ref params 'hub.lease_seconds *default-lease*) + ["unbounded" #f] + [n (string->number n)])) + (define poll-interval-seconds + (match (hash-ref params 'hub.poll_interval_seconds *default-poll-interval*) + ["none" #f] + [n (string->number n)])) + (define secret-string (hash-ref params 'hub.secret #f)) + (define secret-bytes (and secret-string (string->bytes/utf-8 secret-string))) + (define expiry-deadline (and lease-seconds (+ (current-seconds) lease-seconds))) + (define canonical-hub (url->string (resource->url (web-request-header-resource req)))) + (match mode + ['subscribe + (when (subscription-change-validate "subscribe" + (or lease-seconds "unbounded") + topic + callback) + (send! (update-subscription topic + callback + (subscription-settings expiry-deadline + canonical-hub + secret-bytes + poll-interval-seconds))))] + ['unsubscribe + (when (subscription-change-validate "unsubscribe" #f topic callback) + (send! (update-subscription topic callback #f)))]))) (define (subscription-change-validate mode lease topic callback) (define challenge (random-hex-string 16)) @@ -461,12 +447,11 @@ *max-retry-delay*))])))) (delivery-active? #f)) - (during (subscription partial-topic - $expiry-deadline - $canonical-hub - callback - $secret-bytes - $poll-interval-seconds) + (during (subscription partial-topic callback (subscription-settings + $expiry-deadline + $canonical-hub + $secret-bytes + $poll-interval-seconds)) (define topic (url->string (combine-url/relative (canonical-topic-base-url canonical-hub) partial-topic)))