(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"))
(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)
`((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)
)