rl3/aws/ecs/ecs.sls

   1 (library
   2   (rl3 aws ecs ecs)
   3
   4   (export keyword-search
   5           item-lookup)
   6
   7   (import
   8    (rnrs base)
   9    (only (rnrs io simple)
  10          display newline)
  11    (only (rl3 aws configuration)
  12          aws-configuration)
  13    (only (rnrs io ports)
  14          close-port)
  15    (only (rl3 aws awscredentials)
  16          aws-credentials-associate-tag
  17          aws-credentials-secret-key
  18          aws-credentials-access-key)
  19    (only (rl3 web uri)
  20          make-uri uri->string)
  21    (only (rl3 web http)
  22          http-invoke http-ascii-port-from-binary-port)
  23    (only (rl3 web pipes htmlprag)
  24          html->sxml)
  25    (only (rl3 types dates)
  26          current-time-rfc2822)
  27    (only (rl3 aws awsauth)
  28          aws-s3-auth-str
  29          aws-s3-auth-mac)
  30    (only (rl3 aws s3 s3headers)
  31          host-header date-header)
  32    (only (rl3 web uri url parms)
  33          parms->query)
  34    (only (rl3 aws s3 s3headers)
  35          host-header))
  36
  37   (define ecs-host (aws-configuration 'host))
  38
  39   (define ecshost-header (host-header ecs-host))
  40
  41   (define search-parms
  42     '( ("Operation"   . "ItemSearch")
  43        ("SearchIndex" . "KindleStore")))
  44
  45   (define itemlookup-parms
  46     '(("Operation"   . "ItemLookup")))
  47
  48   (define ecs-parms
  49     (lambda (creds)
  50       `(("Service"        . "AWSECommerceService")
  51         ("Version"        . "2008-03-03")
  52         ("Associate-Tag"  . ,(aws-credentials-associate-tag creds))
  53         ("AWSAccessKeyId" . ,(aws-credentials-access-key creds)))))
  54
  55   (define keyword-search
  56     (lambda (creds words)
  57       (let ((parms (append search-parms (ecs-parms creds)
  58                            `(("Keywords" . ,words)))))
  59         (let ((uri (make-uri "http" #f ecs-host #f "/onca/xml" (parms->query parms) "")))
  60           (let-values (((hdrs hip) (http-invoke 'GET (uri->string uri)
  61                                                 `(,ecshost-header))))
  62             (let ((tip (http-ascii-port-from-binary-port hip)))
  63               (let ((results (html->sxml tip)))
  64                 (close-port tip)
  65                 results)))))))
  66
  67   (define item-lookup
  68     (lambda (creds asin)
  69       (let ((parms (append itemlookup-parms (ecs-parms creds)
  70                            `(("IdType" . "ASIN")
  71                              ("ItemId" . ,asin)
  72                              ("ResponseGroup" . "SalesRank,Small,EditorialReview,Reviews")))))
  73         (let ((uri (make-uri "http" #f ecs-host #f "/onca/xml" (parms->query parms) "")))
  74           (let-values (((hdrs hip) (http-invoke 'GET (uri->string uri)
  75                                                 `(,ecshost-header))))
  76             (let ((tip (http-ascii-port-from-binary-port hip)))
  77               (let ((results (html->sxml tip)))
  78                 (close-port tip)
  79                 results)))))))
  80   )
  81
  82
  83