Amazon Web Services With Lisp

I've just had a nice day banging my head on the wall trying to figure out why I can't talk to amazon web services with cl-trivial-http. Turns out that trivial-http doesn't actually implement HTTP to the letter. GET is supposed to send the local path and not the full URL to the server.

When you send Amazon the local path instead of the full URL, it wants to play. Just for reference, here is my test code. Hope it helps someone...

;; load up requirements
(asdf:oos 'asdf:load-op 'trivial-sockets)
(asdf:oos 'asdf:load-op 'trivial-http)
(asdf:oos 'asdf:load-op 's-xml)

;; Define parts of the REST request.
(defparameter *baseurl* "http://webservices.amazon.com/onca/xml")
(defparameter *service* "AWSECommerceService")
(defparameter *accesskeyid* "098CMPJ4AGZ7C6T1DHG2") 
(defparameter *operation* "ItemSearch")
(defparameter *searchindex* "Books")
(defparameter *default-response-group* "Request,Small")


(defparameter *search-indexes* '( "Apparel" "Automotive"  "Baby"  "Beauty"  "Blended"  "Books"  "Classical"  "DigitalMusic"  "DVD"  "Electronics"  "ForeignBooks"  "GourmetFood"  "HealthPersonalCare"  "Hobbies"  "HomeGarden"  "Jewelry"  "Kitchen"  "Magazines"  "Merchants"  "Miscellaneous"  "Music"  "MusicalInstruments"  "MusicTracks"  "OfficeProducts"  "OutdoorLiving"  "PCHardware"  "PetSupplies"  "Photo"  "Restaurants"  "Software"  "SoftwareVideoGames"  "SportingGoods"  "Tools"  "Toys"  "VHS"  "Video"  "VideoGames"  "Wireless"  "WirelessAccessories" ) )

(defparameter *response-groups* '( "Accessories" "BrowseNodeInfo" "BrowseNodes" "Cart" "CartNewReleases" "CartTopSellers" "CartSimilarities" "CustomerFull" "CustomerInfo" "CustomerLists" "CustomerReviews" "EditorialReview" "Help" "Images" "ItemAttributes" "ItemIds" "Large" "ListFull" "ListInfo" "ListItems" "ListmaniaLists" "ListMinimum" "Medium" "NewReleases" "OfferFull" "Offers" "OfferSummary" "Request" "Reviews" "SalesRank" "SearchBins" "Seller" "SellerListing" "Similarities" "Small" "Subjects" "TopSellers" "Tracks" "TransactionDetails" "VariationMinimum" "Variations" "VariationImages" "VariationSummary" ))


(defun append-parameter-to-url (url name value)
  (let ((result 
  (concatenate 'string url "&" name "=" (trivial-http:escape-url-query value)))) 
    result))

(defun make-amazon-item-search-url (search-index &key keywords power title author item-page (response-group *default-response-group*))
  (if (not (member search-index *search-indexes* :test #'string=))
      (error "~A is not a valid search index" search-index)
      (let ((result 
      (concatenate 'string 
     *baseurl* "?Service=" *service* "&AWSAccessKeyId=" *accesskeyid* 
     "&Operation=ItemSearch&SearchIndex="  search-index "&ResponseGroup=" response-group
     "&ContentType=text%2Fxml&Version=2005-03-23")))
 (if keywords 
     (setf result (append-parameter-to-url result "Keywords" keywords)))
 (if author 
     (setf result (append-parameter-to-url result "Author" author)))
 (if title  
     (setf result (append-parameter-to-url result "Title" author)))
 (if power 
     (setf result (append-parameter-to-url result "Power" power)))
 (if item-page 
     (setf result (append-parameter-to-url result "ItemPage" item-page))) 
 result))) 
   


(defun url-path (url)
  (assert (string-equal url "http://" :end1 7))
  (let ((path-start (or (position #\/ url :start 7) (length url))))
    (subseq url path-start (length url))))
  

(defun amazon-http-get (url)
  (let* ((host (thttp::url-host url))
         (port (thttp::url-port url))
         (stream (trivial-sockets:open-stream host port)))
    (format stream "GET ~A HTTP/1.0~AHost: ~A~AUser-Agent: Trivial HTTP for Common Lisp~A~A"
     (url-path url) thttp::+crlf+ host thttp::+crlf+ thttp::+crlf+ thttp::+crlf+)
    (force-output stream)
    (list
     (thttp::response-read-code stream)
     (thttp::response-read-headers stream)
     stream)))

(defun test-amazon ()
  (destructuring-bind (response headers http-stream)
      (amazon-http-get (make-amazon-item-search-url "Books" :keywords "Lisp" :item-page "25"))
    (if (not (= response 200))
 (error  "response ~A  from server" response)
 (progn 
   (format t "response ~A~%" response)
   (format t "headers ~A~%" headers)
   (loop for line = (read-line http-stream nil nil)
  while line do (format t "~A%" line))))))