source: project/release/4/estraier-client/tests/run.scm @ 15839

(load "../estraier-client.scm")

(use test posix http-client)

(import estraier-client)

;; This will start the server, we hope
(system "rm -rf masterdir")              ; Just in case
(system "estmaster init masterdir")
(printf "Waiting for estmaster to startup...")
(system "estmaster start -bg masterdir > /dev/null 2>&1")
(sleep 2)

(define master-uri "http://admin:admin@localhost:1978/master")
(define node-uri "http://admin:admin@localhost:1978/node/testnode")

(test-group "node master API"
  (test "Empty node list on init" '() (master-nodes master-uri))
  (test-error "Cannot connect with invalid credentials"
              (master-nodes "http://admin:invalid@localhost:1978/master"))
  (let ((nodes (begin (master-add-node master-uri "testnode")
                      (master-add-node master-uri "testnode2" "testlabel")
                      (master-nodes master-uri))))
    (test "After adding two nodes, they show up"
          '("testnode" "testnode2")
          (map car nodes))
    (test "Node label is accepted"
          '("testnode" "testlabel")
          (map cadr nodes)))
  (test "After deleting a node, it is gone"
        '("testnode")
        (begin (master-delete-node master-uri "testnode2")
               (map car (master-nodes master-uri))))
  (let ((users (begin (master-add-user master-uri "testuser" "password"
                                       fullname: "Joe testuser"
                                       description: "This is just a test")
                      (master-users master-uri))))
    (test "After adding a user, it shows up"
          '("admin" "testuser")
          (map car users)))
  (test "After deleting a user, it is gone"
        '("admin")
        (begin (master-delete-user master-uri "testuser")
               (map car (master-users master-uri)))))

;; TODO: more in-depth tests of master result values

(test-group "node API"
  (let ((info (node-info node-uri)))
    (test "Node-info reports zero documents at first"
          0 (alist-ref 'document-count info))
    (test "Node-info reports zero words at first"
          0 (alist-ref 'word-count info))
    (test "Node-info reports no guests at first"
          '() (alist-ref 'guest-users info))
    (test "Node-info reports no admins at first"
          '() (alist-ref 'admin-users info)))
  (test "Cache usage starts out empty"
        0.0 (node-cache-usage node-uri))
  (test "Document list starts out empty"
        '() (list-documents node-uri))

  (test "After registering admins and guests, they are listed in node info"
        '(("guest1" "guest2" "both") ("admin1" "admin2" "both"))
        (begin (register-guest-user node-uri "guest1")
               (register-guest-user node-uri "guest2")
               (register-guest-user node-uri "both")
               (register-admin-user node-uri "admin1")
               (register-admin-user node-uri "admin2")
               (register-admin-user node-uri "both")
               (let ((info (node-info node-uri)))
                 (list (alist-ref 'guest-users info)
                       (alist-ref 'admin-users info)))))
  (test "After unregistering users, they are not listed"
        '(("guest2") ("admin2"))
        (begin (unregister-user node-uri "guest1")
               (unregister-user node-uri "admin1")
               (unregister-user node-uri "both")
               (let ((info (node-info node-uri)))
                 (list (alist-ref 'guest-users info)
                       (alist-ref 'admin-users info)))))
  
  (test-error "Putting document without URI is an error"
              (put-document node-uri "This is just a test" '()))
  (test-assert "Putting documents with URIs succeed"
               (begin
                 (put-document node-uri '("Just a test for estraier")
                               '((@uri . "/test1") (my-tag . "something")))
                 (put-document node-uri '("Another test for estraier")
                               '((@uri . "/test2") (my-tag . "foo") (my-other-tag . "whatever")))
                 #t))
  ;; If we don't sync, the newly added docs don't (always?) show up...
  (test-assert "Synchronize works" (begin (node-sync node-uri) #t))
  (let ((info (node-info node-uri)))
    (test "Node-info reports the new documents"
          2 (alist-ref 'document-count info))
    (test "Node-info reports the total number of words"
          6 (alist-ref 'word-count info))  ;; "test for estraier" is in both
    ;; Why does this still report zero?
    #;(test-assert "Size is nonzero" (> 0 (alist-ref 'size info))))
  (test "Documents are listed"
        '("/test1" "/test2")
        (map (lambda (l) (alist-ref '@uri l)) (list-documents node-uri)))
  (test "Skipping list results works"
        '("/test2")
        (map (lambda (l) (alist-ref '@uri l))
             (list-documents node-uri prev: "/test1")))
  (test "Maximum result length is used"
        '("/test1")
        (map (lambda (l) (alist-ref '@uri l))
             (list-documents node-uri max: 1)))
  (test "Document keywords are correct"
        '("a" "estraier" "for" "just" "test")
        (sort (map car (document-keywords node-uri uri: "/test1")) string<?))

  (receive (doc meta)
    (get-document node-uri uri: "/test1")
    (test "Get-document returns document"
          '("Just a test for estraier")
          (values doc))
    (test "Get-document returns attributes"
          '("/test1" "something")
          (list (alist-ref '@uri meta) (alist-ref 'my-tag meta)))
    (test-assert "Updating gives no error"
                 (begin
                   (update-attributes
                    node-uri (alist-update! 'my-tag "or other" meta))
                   #t))
    (receive (doc meta)
      (get-document node-uri uri: "/test1")
      (test "Get-document returns updated attributes"
            "or other"
            (alist-ref 'my-tag meta))
      (test-assert "Putting a modified doc gives no error"
                   (begin
                     (put-document node-uri
                                   '("Simply a test for estraier")
                                   meta)
                     (node-sync node-uri) 
                    #t))
      (receive (doc meta)
        (get-document node-uri uri: "/test1")
        (test "Updated document is accepted"
              '("Simply a test for estraier")
              (values doc)))))

  (test "Document-attribute returns correct attributes"
        "or other"
        (document-attribute node-uri 'my-tag uri: "/test1"))

  ;; XXX: This makes assumptions about the ordering of the docs in the
  ;; result set.  It should not do that :)
  (receive (results meta-data)
    (find-documents node-uri phrase: "test")
    (test "Find-documents finds both docs"
          '(((#f . "Another ") ("test" . "test") (#f . " for estraier"))
            ((#f . "Simply a ") ("test" . "test") (#f . " for estraier")))
          (map car results))
    (test "URI matches put-document"
          "/test1"
          (alist-ref '@uri (cdr (cadr results))))
    (test "document-uri->id gives result that matches search result details"
          (alist-ref '@id (cdr (cadr results)))
          (document-uri->id node-uri "/test1")))

  (receive (results meta-data)
    (find-documents node-uri attr-phrases: '("my-tag STREQ foo"
                                             "my-other-tag STREQ whatever"))
    (test "Find-documents can search attributes"
          '(((#f . "Another test for estraier")))
          (map car results))
    (test-assert "Find-documents can search up to 10 attributes"
                 (find-documents node-uri
                                 attr-phrases: '("0" "1" "2" "3" "4" "5"
                                                 "6" "7" "8" "9")))
    (test-error "Find-documents cannot search more than 10 attributes"
                (find-documents node-uri
                                attr-phrases: '("0" "1" "2" "3" "4" "5"
                                                "6" "7" "8" "9" "10"))))

  (test "Deleted documents are not listed"
        '("/test1")
        (begin
          (delete-document node-uri uri: "/test2")
          (map (lambda (l) (alist-ref '@uri l)) (list-documents node-uri))))
  
  (test "Clearing node results in empty document list"
        '()
        (begin (master-clear-node master-uri "testnode")
               (list-documents node-uri))))

;; TODO: Test search options (especially attributes)

(test-group "cleanup"
 (test-assert "Clean shutdown" (begin (master-shutdown master-uri) #t))
 (test-error "After shutdown, server is unreachable" (master-nodes master-uri)))
(system "rm -rf masterdir")