#lang racket
(require (planet gh/http/request)
(planet gh/http/head)
xml
"util.rkt"
)
(struct exn:fail:aws exn:fail
(http-code
http-text
aws-code
aws-message)
#:transparent)
(provide (struct-out exn:fail:aws))
(define/contract/provide (check-response p h)
(input-port? string? . -> . string? )
(define http-code (extract-http-code h))
(define http-text (extract-http-text h))
(match http-code
[200 h]
[206 h]
[301 h]
[302 h]
[307 h] [else
(define x (read-entity/bytes p h))
(raise (header&response->exn:fail:aws h x (current-continuation-marks)))]))
(define/contract/provide (header&response->exn:fail:aws h e ccm)
(string? (or/c bytes? xexpr?) continuation-mark-set? . -> . exn:fail:aws?)
(log-debug (format "~a ~a" h e))
(define http-code (extract-http-code h))
(define http-text (extract-http-text h))
(cond
[(bytes? e)
(match e
[(regexp "<Code>(.*?)</Code>.*?<Message>(.*?)</Message>"
(list _ aws-code aws-msg))
(exn:fail:aws (format "HTTP ~a \"~a\". AWS Code=\"~a\" Message=\"~a\""
http-code http-text aws-code aws-msg)
ccm
http-code
http-text
aws-code
aws-msg)]
[else
(exn:fail:aws (format "HTTP ~a \"~a\"." http-code http-text)
ccm
http-code
http-text
#f
#f)])]
[(xexpr? e)
(define aws-code (first-tag-value e 'Code))
(define aws-msg (first-tag-value e 'Message))
(exn:fail:aws (format "HTTP ~a \"~a\". AWS Code=\"~a\" Message=\"~a\""
http-code http-text aws-code aws-msg)
ccm
http-code
http-text
aws-code
aws-msg)]))