blogue-rpc.ss
(module blogue-rpc mzscheme
  (require (lib "unitsig.ss")
           (lib "xml.ss" "xml")
           (lib "thread.ss")
           (lib "timer.ss" "web-server")
           (lib "request-parsing.ss" "web-server")
           (lib "connection-manager.ss" "web-server"))
  (require (lib "xml-rpc.ss" "xml-rpc"))
  (require "blogue-moc.ss"
           "blogue-world.ss"
           "blogue-sig.ss")
  (provide (all-defined))
  
  (define post-xml
    `((categories . ("c1" "c2"))
      ;(dateCreated . "srfi:date")
      (description . "blah")
      (enclosure . ((length . 10)
                    (type . "text/xml")
                    (url . "blah")))
      (link . "url")
      (permaLink . "url")
      (postId . 0)
      (title . "blah")
      (userid . 0)))
  
  (define (generate-callback config@)
    (define-values/invoke-unit/sig blogue-config^ config@)
    (let ([w (load-World PostRoot)])
      (hash-table-callback/immutable
       (define (blogger.deletePost appkey postid username password publish)
         #f)
       (define (metaWeblog.newPost blogid username password post-xml publish)
         "PostId")
       (define (metaWeblog.editPost postid username password post-xml publish)
         #t)
       (define (metaWeblog.getPost postid username password)
         post-xml)
       #;(define (metaWeblog.getCategories blogid username password)
           (list))
         (define (metaWeblog.getCategories blogid username password)
           (map/World-Category
            (lambda (Category Subcategories Posts)
              (let* ([Category (bytes->string/utf-8 Category)]
                     [URL (format "~a/Categories/~a" SiteURL Category)])
                `(,(string->symbol Category) . 
                   ((description . ,Category)
                    (htmlUrl . ,URL)
                    (rssUrl . ,URL)
                    ))))
            w))
         (define (metaWeblog.newMediaObject blogid username password obj)
           ; obj = ((name . x) (type . y) (bits . z))
           `((url . "blah")))
         (define (metaWeblog.getRecentPosts blogid username password numberOfPosts)
           (list post-xml)))))
  
  (define interface-version 'v1)
  (define timeout (* 60 60 24))
  (define start (generate-request-handler (generate-callback config@)))
  
  (define (run)
    (let ([callback (generate-callback config@)])
      (empty-tag-shorthand html-empty-tags)
      (run-server 
       1048 
       (lambda (client->server server->client)
         (write-xml/content 
          (xexpr->xml ((generate-request-handler callback)
                       (let-values ([(request close?) 
                                     (read-request client->server)])
                         (set-request-bindings/raw! request 
                                                    (read-bindings (make-connection (start-timer 0 (lambda () (void)))
                                                                                    client->server server->client (current-custodian) close?)
                                                                   (request-method request)
                                                                   (request-uri request)
                                                                   (request-headers request)))
                         request)))
          server->client))
       #f)))
  (run)
  )