Skip to content
Newer
Older
100644 73 lines (66 sloc) 2.34 KB
874a0e4 @greghendershott Initial commit.
authored
1 #lang racket
2
3 (require xml
4 net/base64
5 (planet gh/http/request)
6 (planet gh/http/head)
7 "exn.rkt"
8 "util.rkt")
9
10 (define/contract/provide (post-with-retry uri xs-post-data heads [try 1])
7d9b614 @greghendershott post-with-retry really accepts any dict? for the post data.
authored
11 ((string? dict? dict?)
874a0e4 @greghendershott Initial commit.
authored
12 (exact-positive-integer?)
13 . ->* .
14 xexpr?)
15 (define data (string->bytes/utf-8 (dict->form-urlencoded xs-post-data)))
16 (log-debug (tr "POST" data))
17 (call/output-request
18 "1.1" "POST" uri data #f heads
19 (lambda (in h)
20 (define e (read-entity/xexpr in h))
21 (match (extract-http-code h)
22 [200 e]
23 [503
24 (if (<= try 5)
25 (let ([sleep-time (sqr try)]) ;wait longer each time
4ee08f8 @greghendershott Fix/generalize log-info message.
authored
26 (log-info (format "AWS returned 503. Try ~a in ~a secs."
874a0e4 @greghendershott Initial commit.
authored
27 (add1 try) sleep-time))
28 (sleep sleep-time)
29 (post-with-retry uri xs-post-data heads (add1 try)))
30 (error 'post-with-retry "too many 503 retries; giving up"))]
31 [else
32 (raise (header&response->exn:fail:aws
33 h e (current-continuation-marks)))]))))
34
35 (define/provide (set-next-token params token)
36 (cons (list 'NextToken token)
37 (filter (lambda (x) (not (equal? (car x) 'NextToken)))
38 params)))
39
40 (define/provide (timestamp [seconds (current-seconds)])
41 (seconds->gmt-8601-string 'T/Z seconds))
42
43 ;; SDB docs:
44 ;; "To ensure that you can read all the data you sent via REST, if a
45 ;; response contains invalid XML characters, Amazon SimpleDB
46 ;; automatically Base64-encodes the UTF-8 octets of the text."
47 ;;
48 ;; Example:
49 ;; <Attribute>
50 ;; <Name encoding="base64">...</Name>
51 ;; <Value encoding="base64">...</Value>
52 ;; </Attribute>
53 ;;
54 ;; "When designing your application, make sure to scrub any data for
55 ;; invalid characters or design your application to handle
56 ;; Base64-encoded results."
57 (define/contract/provide (attribute-xexpr->attrib-pair x)
58 (xexpr? . -> . (list/c symbol? string?))
59 ;; (Attribute () (Name () x) (Value () x))
60 (match x
61 [(list 'Attribute _ name val)
62 (let ([name (maybe-decode name)]
63 [val (maybe-decode val)])
64 (list (if (string? name) (string->symbol name) name)
65 val))]))
66
67 (define/provide (maybe-decode x)
68 (match x
69 [(list (or 'Name 'Value) attrs val)
70 (match (assoc 'Encoding attrs)
71 [(list 'Encoding "base64") (base64-decode val)]
72 [else val])]))
Something went wrong with that request. Please try again.