Changeset 15847 in project


Ignore:
Timestamp:
09/13/09 12:03:05 (10 years ago)
Author:
sjamaan
Message:

Make the API more logical by requiring a base URI, and a node name in case of nodes

Location:
release/4/estraier-client
Files:
2 edited

Legend:

Unmodified
Added
Removed
  • release/4/estraier-client/estraier-client.scm

    r15846 r15847  
    3535; http://trac.callcc.org
    3636
    37 ;; TODO: Perhaps split URIs into "base uri" and "node name".
    38 
    3937(module estraier-client
    4038  (get-node-info node-cache-usage optimize-node sync-node document-uri->id
     
    8583;;;; Node API
    8684
    87 (define (node-uri node action . args)
    88   (let ((uri (if (uri-reference? node)
    89                  (apply update-uri node args)
    90                  (apply update-uri (uri-reference node) args))))
    91     (update-uri uri path: (append (uri-path uri) (list action)))))
    92 
    93 (define (get-node-info node)
     85(define (node-uri base-uri node action . args)
     86  (let* ((rel (update-uri (uri-reference "") path: (list "node" node action)))
     87         (uri (if (uri-reference? base-uri)
     88                  (uri-relative-to rel base-uri)
     89                  (uri-relative-to rel (uri-reference base-uri)))))
     90    (apply update-uri uri args)))
     91
     92(define (get-node-info base-uri node)
    9493  (exec
    95    (node-uri node "inform")
     94   (node-uri base-uri node "inform")
    9695   #f
    9796   (lambda (in)
     
    110109         (guest-users . ,guests))))))
    111110
    112 (define (node-cache-usage node)
    113   (string->number (exec (node-uri node "cacheusage") #f read-line)))
    114 
    115 (define (optimize-node node)
    116   (exec (node-uri node "optimize") #f discard-output))
    117 
    118 (define (sync-node node)
    119   (exec (node-uri node "sync") #f discard-output))
    120 
    121 (define (list-documents node #!key max prev)
    122   (exec (node-uri node "list" query: `((max . ,max) (prev . ,prev)))
     111(define (node-cache-usage base-uri node)
     112  (string->number (exec (node-uri base-uri node "cacheusage") #f read-line)))
     113
     114(define (optimize-node base-uri node)
     115  (exec (node-uri base-uri node "optimize") #f discard-output))
     116
     117(define (sync-node base-uri node)
     118  (exec (node-uri base-uri node "sync") #f discard-output))
     119
     120(define (list-documents base-uri node #!key max prev)
     121  (exec (node-uri base-uri node "list" query: `((max . ,max) (prev . ,prev)))
    123122        #f
    124123        (lambda (in)
     
    155154    (values document metadata)))
    156155
    157 (define (put-document node contents attribs)
     156(define (put-document base-uri node contents attribs)
    158157  (exec
    159    (make-request uri: (node-uri node "put_doc")
     158   (make-request uri: (node-uri base-uri node "put_doc")
    160159                 method: 'POST major: 1 minor: 0
    161160                 headers: (headers '((content-type text/x-estraier-draft))))
     
    165164   discard-output))
    166165
    167 (define (delete-document node #!key id uri)
    168   (exec (node-uri node "out_doc" query: (id/uri->alist id uri))
    169         #f discard-output))
    170 
    171 (define (document-uri->id node uri)
    172   (exec (node-uri node "uri_to_id" query: `((uri . ,uri))) #f read-line))
    173 
    174 (define (get-document node #!key id uri)
     166(define (delete-document base-uri node #!key id uri)
     167  (exec (node-uri base-uri node "out_doc" query: (id/uri->alist id uri))
     168        #f discard-output))
     169
     170(define (document-uri->id base-uri node uri)
     171  (exec (node-uri base-uri node "uri_to_id"
     172                  query: `((uri . ,uri))) #f read-line))
     173
     174(define (get-document base-uri node #!key id uri)
    175175  (apply values
    176176         (exec
    177           (node-uri node "get_doc" query: (id/uri->alist id uri))
     177          (node-uri base-uri node "get_doc" query: (id/uri->alist id uri))
    178178          #f (lambda (in)
    179179               (call-with-values (lambda () (read-draft in)) list)))))
     
    183183;; requires both @uri and @id!  Anything not present is reset or
    184184;; removed.  It's identical to put-document, except for the doc body.
    185 (define (update-attributes node attribs)
     185(define (update-attributes base-uri node attribs)
    186186  (exec
    187    (make-request uri: (node-uri node "edit_doc")
     187   (make-request uri: (node-uri base-uri node "edit_doc")
    188188                 method: 'POST major: 1 minor: 0
    189189                 headers: (headers '((content-type text/x-estraier-draft))))
     
    193193   discard-output))
    194194
    195 (define (document-attribute node attrib #!key id uri)
    196   (exec (node-uri node "get_doc_attr" query: (cons `(attr . ,attrib)
    197                                                   (id/uri->alist id uri)))
     195(define (document-attribute base-uri node attrib #!key id uri)
     196  (exec (node-uri base-uri node "get_doc_attr"
     197                  query: (cons `(attr . ,attrib) (id/uri->alist id uri)))
    198198        #f read-line))
    199199
    200 (define (document-keywords node #!key id uri)
    201   (exec (node-uri node "etch_doc" query: (id/uri->alist id uri))
     200(define (document-keywords base-uri node #!key id uri)
     201  (exec (node-uri base-uri node "etch_doc" query: (id/uri->alist id uri))
    202202        #f
    203203        (lambda (in)
     
    213213
    214214;; Attrs are ANDed together.  All attribute phrases must match
    215 (define (find-documents node #!key phrase (attr-phrases '()) order max options
    216                         auxiliary distinct depth wwidth hwidth awidth skip mask)
     215(define (find-documents base-uri node #!key phrase (attr-phrases '())
     216                        order max options auxiliary distinct depth
     217                        wwidth hwidth awidth skip mask)
    217218  (when (> (length attr-phrases) 10)
    218219    (error (string-append "You can't provide more than 10 attribute phrases. "
     
    227228   (apply
    228229    values
    229     (exec (node-uri node "search"
     230    (exec (node-uri base-uri node "search"
    230231                    query: `((phrase . ,phrase) (order . ,order)
    231232                             (max . ,max)       (options . ,options)
     
    279280              (list documents meta)))))))
    280281
    281 (define (_set-user node name mode)
    282   (exec (node-uri node "_set_user" query: `((name . ,name) (mode . ,mode)))
     282(define (_set-user base-uri node name mode)
     283  (exec (node-uri base-uri node "_set_user"
     284                  query: `((name . ,name) (mode . ,mode)))
    283285        #f read-lines))
    284286
    285 (define (unregister-user node name)
    286   (_set-user node name 0))
    287 
    288 (define (register-admin-user node name)
    289   (_set-user node name 1))
    290 
    291 (define (register-guest-user node name)
    292   (_set-user node name 2))
     287(define (unregister-user base-uri node name)
     288  (_set-user base-uri node name 0))
     289
     290(define (register-admin-user base-uri node name)
     291  (_set-user base-uri node name 1))
     292
     293(define (register-guest-user base-uri node name)
     294  (_set-user base-uri node name 2))
    293295
    294296;; TODO: _set_link
     
    296298;;;; Master API
    297299
    298 (define (master-uri master action . args)
    299   (let ((uri (if (uri-reference? master)
    300                  (apply update-uri master args)
    301                  (apply update-uri (uri-reference master) args))))
    302     (update-uri uri query: (alist-update! 'action action (uri-query uri)))))
    303 
    304 (define (shutdown-master master)
    305   (exec (master-uri master "shutdown") #f discard-output))
    306 
    307 (define (sync-master master)
    308   (exec (master-uri master "sync") #f discard-output))
    309 
    310 (define (backup-master master)
    311   (exec (master-uri master "backup") #f discard-output))
    312 
    313 (define (rotate-log master)
    314   (exec (master-uri master "logrtt") #f discard-output))
    315 
    316 (define (list-nodes master)
     300(define (master-uri base-uri action . args)
     301  (let ((uri (if (uri-reference? base-uri)
     302                 (apply update-uri base-uri args)
     303                 (apply update-uri (uri-reference base-uri) args))))
     304    (update-uri uri
     305                path: (append (uri-path uri) (list "master"))
     306                query: (alist-update! 'action action (uri-query uri)))))
     307
     308(define (shutdown-master base-uri)
     309  (exec (master-uri base-uri "shutdown") #f discard-output))
     310
     311(define (sync-master base-uri)
     312  (exec (master-uri base-uri "sync") #f discard-output))
     313
     314(define (backup-master base-uri)
     315  (exec (master-uri base-uri "backup") #f discard-output))
     316
     317(define (rotate-log base-uri)
     318  (exec (master-uri base-uri "logrtt") #f discard-output))
     319
     320(define (list-nodes base-uri)
    317321  (map (lambda (line)
    318322         (string-split line "\t" #t))
    319        (exec (master-uri master "nodelist") #f read-lines)))
    320 
    321 (define (add-node master node-name #!optional node-label)
    322   (exec (master-uri master "nodeadd"
     323       (exec (master-uri base-uri "nodelist") #f read-lines)))
     324
     325(define (add-node base-uri node-name #!optional node-label)
     326  (exec (master-uri base-uri "nodeadd"
    323327                    query: `((name . ,node-name) (label . ,node-label)))
    324328        #f discard-output))
    325329
    326 (define (delete-node master node-name)
    327   (exec (master-uri master "nodedel" query: `((name . ,node-name)))
    328         #f discard-output))
    329 
    330 (define (clear-node master node-name)
    331   (exec (master-uri master "nodeclr" query: `((name . ,node-name)))
    332         #f discard-output))
    333 
    334 (define (list-users master)
    335   (exec (master-uri master "userlist")
     330(define (delete-node base-uri node-name)
     331  (exec (master-uri base-uri "nodedel" query: `((name . ,node-name)))
     332        #f discard-output))
     333
     334(define (clear-node base-uri node-name)
     335  (exec (master-uri base-uri "nodeclr" query: `((name . ,node-name)))
     336        #f discard-output))
     337
     338(define (list-users base-uri)
     339  (exec (master-uri base-uri "userlist")
    336340        #f
    337341        (lambda (in)
     
    343347                      (cons (string-split line "\t" #t) lines)))))))
    344348
    345 (define (add-user master username password
    346                          #!key flags fullname description)
    347   (exec (make-request uri: (master-uri master "useradd")
     349(define (add-user base-uri username password
     350                  #!key flags fullname description)
     351  (exec (make-request uri: (master-uri base-uri "useradd")
    348352                      method: 'POST major: 1 minor: 0)
    349353        `((name . ,username) (passwd . ,password)
     
    351355        discard-output))
    352356
    353 (define (delete-user master username)
    354   (exec (master-uri master "userdel" query: `((name . ,username)))
     357(define (delete-user base-uri username)
     358  (exec (master-uri base-uri "userdel" query: `((name . ,username)))
    355359        #f discard-output))
    356360
  • release/4/estraier-client/tests/run.scm

    r15846 r15847  
    1212(sleep 2)
    1313
    14 (define master-uri "http://admin:admin@localhost:1978/master")
    15 (define node-uri "http://admin:admin@localhost:1978/node/testnode")
     14(define base-uri "http://admin:admin@localhost:1978")
    1615
    1716(test-group "node master API"
    18   (test "Empty node list on init" '() (list-nodes master-uri))
     17  (test "Empty node list on init" '() (list-nodes base-uri))
    1918  (test-error "Cannot connect with invalid credentials"
    20               (list-nodes "http://admin:invalid@localhost:1978/master"))
    21   (let ((nodes (begin (add-node master-uri "testnode")
    22                       (add-node master-uri "testnode2" "testlabel")
    23                       (list-nodes master-uri))))
     19              (list-nodes "http://admin:invalid@localhost:1978"))
     20  (let ((nodes (begin (add-node base-uri "testnode")
     21                      (add-node base-uri "testnode2" "testlabel")
     22                      (list-nodes base-uri))))
    2423    (test "After adding two nodes, they show up"
    2524          '("testnode" "testnode2")
     
    3029  (test "After deleting a node, it is gone"
    3130        '("testnode")
    32         (begin (delete-node master-uri "testnode2")
    33                (map car (list-nodes master-uri))))
    34   (let ((users (begin (add-user master-uri "testuser" "password"
     31        (begin (delete-node base-uri "testnode2")
     32               (map car (list-nodes base-uri))))
     33  (let ((users (begin (add-user base-uri "testuser" "password"
    3534                                fullname: "Joe testuser"
    3635                                description: "This is just a test")
    37                       (list-users master-uri))))
     36                      (list-users base-uri))))
    3837    (test "After adding a user, it shows up"
    3938          '("admin" "testuser")
     
    4140  (test "After deleting a user, it is gone"
    4241        '("admin")
    43         (begin (delete-user master-uri "testuser")
    44                (map car (list-users master-uri)))))
     42        (begin (delete-user base-uri "testuser")
     43               (map car (list-users base-uri)))))
    4544
    4645;; TODO: more in-depth tests of master result values
    4746
    4847(test-group "node API"
    49   (let ((info (get-node-info node-uri)))
     48  (let ((info (get-node-info base-uri "testnode")))
    5049    (test "Get-node-info reports zero documents at first"
    5150          0 (alist-ref 'document-count info))
     
    5756          '() (alist-ref 'admin-users info)))
    5857  (test "Cache usage starts out empty"
    59         0.0 (node-cache-usage node-uri))
     58        0.0 (node-cache-usage base-uri "testnode"))
    6059  (test "Document list starts out empty"
    61         '() (list-documents node-uri))
     60        '() (list-documents base-uri "testnode"))
    6261
    6362  (test "After registering admins and guests, they are listed in node info"
    6463        '(("guest1" "guest2" "both") ("admin1" "admin2" "both"))
    65         (begin (register-guest-user node-uri "guest1")
    66                (register-guest-user node-uri "guest2")
    67                (register-guest-user node-uri "both")
    68                (register-admin-user node-uri "admin1")
    69                (register-admin-user node-uri "admin2")
    70                (register-admin-user node-uri "both")
    71                (let ((info (get-node-info node-uri)))
     64        (begin (register-guest-user base-uri "testnode" "guest1")
     65               (register-guest-user base-uri "testnode" "guest2")
     66               (register-guest-user base-uri "testnode" "both")
     67               (register-admin-user base-uri "testnode" "admin1")
     68               (register-admin-user base-uri "testnode" "admin2")
     69               (register-admin-user base-uri "testnode" "both")
     70               (let ((info (get-node-info base-uri "testnode")))
    7271                 (list (alist-ref 'guest-users info)
    7372                       (alist-ref 'admin-users info)))))
    7473  (test "After unregistering users, they are not listed"
    7574        '(("guest2") ("admin2"))
    76         (begin (unregister-user node-uri "guest1")
    77                (unregister-user node-uri "admin1")
    78                (unregister-user node-uri "both")
    79                (let ((info (get-node-info node-uri)))
     75        (begin (unregister-user base-uri "testnode" "guest1")
     76               (unregister-user base-uri "testnode" "admin1")
     77               (unregister-user base-uri "testnode" "both")
     78               (let ((info (get-node-info base-uri "testnode")))
    8079                 (list (alist-ref 'guest-users info)
    8180                       (alist-ref 'admin-users info)))))
    8281 
    8382  (test-error "Putting document without URI is an error"
    84               (put-document node-uri "This is just a test" '()))
     83              (put-document base-uri "testnode" "This is just a test" '()))
    8584  (test-assert "Putting documents with URIs succeed"
    8685               (begin
    87                  (put-document node-uri '("Just a test for estraier")
     86                 (put-document base-uri "testnode" '("Just a test for estraier")
    8887                               '((@uri . "/test1") (my-tag . "something")))
    89                  (put-document node-uri '("Another test for estraier")
     88                 (put-document base-uri "testnode" '("Another test for estraier")
    9089                               '((@uri . "/test2") (my-tag . "foo") (my-other-tag . "whatever")))
    9190                 #t))
    9291  ;; If we don't sync, the newly added docs don't (always?) show up...
    93   (test-assert "Synchronize works" (begin (sync-node node-uri) #t))
    94   (let ((info (get-node-info node-uri)))
     92  (test-assert "Synchronize works" (begin (sync-node base-uri "testnode") #t))
     93  (let ((info (get-node-info base-uri "testnode")))
    9594    (test "Get-node-info reports the new documents"
    9695          2 (alist-ref 'document-count info))
     
    101100  (test "Documents are listed"
    102101        '("/test1" "/test2")
    103         (map (lambda (l) (alist-ref '@uri l)) (list-documents node-uri)))
     102        (map (lambda (l) (alist-ref '@uri l)) (list-documents base-uri "testnode")))
    104103  (test "Skipping list results works"
    105104        '("/test2")
    106105        (map (lambda (l) (alist-ref '@uri l))
    107              (list-documents node-uri prev: "/test1")))
     106             (list-documents base-uri "testnode" prev: "/test1")))
    108107  (test "Maximum result length is used"
    109108        '("/test1")
    110109        (map (lambda (l) (alist-ref '@uri l))
    111              (list-documents node-uri max: 1)))
     110             (list-documents base-uri "testnode" max: 1)))
    112111  (test "Document keywords are correct"
    113112        '("a" "estraier" "for" "just" "test")
    114         (sort (map car (document-keywords node-uri uri: "/test1")) string<?))
     113        (sort (map car (document-keywords base-uri "testnode" uri: "/test1")) string<?))
    115114
    116115  (receive (doc meta)
    117     (get-document node-uri uri: "/test1")
     116    (get-document base-uri "testnode" uri: "/test1")
    118117    (test "Get-document returns document"
    119118          '("Just a test for estraier")
     
    125124                 (begin
    126125                   (update-attributes
    127                     node-uri (alist-update! 'my-tag "or other" meta))
     126                    base-uri "testnode" (alist-update! 'my-tag "or other" meta))
    128127                   #t))
    129128    (receive (doc meta)
    130       (get-document node-uri uri: "/test1")
     129      (get-document base-uri "testnode" uri: "/test1")
    131130      (test "Get-document returns updated attributes"
    132131            "or other"
     
    134133      (test-assert "Putting a modified doc gives no error"
    135134                   (begin
    136                      (put-document node-uri
     135                     (put-document base-uri "testnode"
    137136                                   '("Simply a test for estraier")
    138137                                   meta)
    139                      (sync-node node-uri)
     138                     (sync-node base-uri "testnode")
    140139                    #t))
    141140      (receive (doc meta)
    142         (get-document node-uri uri: "/test1")
     141        (get-document base-uri "testnode" uri: "/test1")
    143142        (test "Updated document is accepted"
    144143              '("Simply a test for estraier")
     
    147146  (test "Document-attribute returns correct attributes"
    148147        "or other"
    149         (document-attribute node-uri 'my-tag uri: "/test1"))
     148        (document-attribute base-uri "testnode" 'my-tag uri: "/test1"))
    150149
    151150  ;; XXX: This makes assumptions about the ordering of the docs in the
    152151  ;; result set.  It should not do that :)
    153152  (receive (results meta-data)
    154     (find-documents node-uri phrase: "test")
     153    (find-documents base-uri "testnode" phrase: "test")
    155154    (test "Find-documents finds both docs"
    156155          '(((#f . "Another ") ("test" . "test") (#f . " for estraier"))
     
    162161    (test "document-uri->id gives result that matches search result details"
    163162          (alist-ref '@id (cdr (cadr results)))
    164           (document-uri->id node-uri "/test1")))
     163          (document-uri->id base-uri "testnode" "/test1")))
    165164
    166165  (receive (results meta-data)
    167     (find-documents node-uri attr-phrases: '("my-tag STREQ foo"
     166    (find-documents base-uri "testnode" attr-phrases: '("my-tag STREQ foo"
    168167                                             "my-other-tag STREQ whatever"))
    169168    (test "Find-documents can search attributes"
     
    171170          (map car results))
    172171    (test-assert "Find-documents can search up to 10 attributes"
    173                  (find-documents node-uri
     172                 (find-documents base-uri "testnode"
    174173                                 attr-phrases: '("0" "1" "2" "3" "4" "5"
    175174                                                 "6" "7" "8" "9")))
    176175    (test-error "Find-documents cannot search more than 10 attributes"
    177                 (find-documents node-uri
     176                (find-documents base-uri "testnode"
    178177                                attr-phrases: '("0" "1" "2" "3" "4" "5"
    179178                                                "6" "7" "8" "9" "10"))))
     
    182181        '("/test1")
    183182        (begin
    184           (delete-document node-uri uri: "/test2")
    185           (map (lambda (l) (alist-ref '@uri l)) (list-documents node-uri))))
     183          (delete-document base-uri "testnode" uri: "/test2")
     184          (map (lambda (l) (alist-ref '@uri l)) (list-documents base-uri "testnode"))))
    186185 
    187186  (test "Clearing node results in empty document list"
    188187        '()
    189         (begin (clear-node master-uri "testnode")
    190                (list-documents node-uri))))
     188        (begin (clear-node base-uri "testnode")
     189               (list-documents base-uri "testnode"))))
    191190
    192191;; TODO: Test search options (especially attributes)
    193192
    194193(test-group "cleanup"
    195  (test-assert "Clean shutdown" (begin (shutdown-master master-uri) #t))
    196  (test-error "After shutdown, server is unreachable" (list-nodes master-uri)))
     194 (test-assert "Clean shutdown" (begin (shutdown-master base-uri) #t))
     195 (test-error "After shutdown, server is unreachable" (list-nodes base-uri)))
    197196(system "rm -rf masterdir")
Note: See TracChangeset for help on using the changeset viewer.