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

(import test estraier-client http-client
        (chicken condition) (chicken process-context) (chicken string)
        (chicken process) (chicken io) (chicken format) (chicken sort))

;; Avoid listening on the default estraier port because the main Salmonella
;; runs on the same server as qwiki, which uses estraier in a default config.
(define server-port
  (string->number
   (or (get-environment-variable "ESTRAIER_CLIENT_TEST_PORT") "8080")))

(test-begin "estraier")

;; This will start the server, we hope
(handle-exceptions exn
  (error (conc "Couldn't start or initialize estmaster. "
               "You probably don't have hyper-estraier installed. "
               "If you do, check $ESTRAIER_CLIENT_TEST_PORT (default 8080)"))
 (system* "rm -rf masterdir")          ; Just in case
 (system* "estmaster init masterdir")
;; Try and replace the portnumber with another value.  Ugly, I know
 (let* ((contents (with-input-from-file "masterdir/_conf" read-lines))
        (changed-contents (map (lambda (l)
                                 (if (substring-index "portnum:" l)
                                     (conc "portnum: " server-port) l))
                               contents)))
   (with-output-to-file "masterdir/_conf"
     (lambda () (for-each print changed-contents))))
 (printf "Waiting for estmaster to startup...")
 (system* "estmaster start -bg masterdir > /dev/null 2>&1"))
(sleep 2)

(define base-uri (conc "http://admin:admin@localhost:" server-port))

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

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

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

  (test "After registering admins and guests, they are listed in node info"
        '(("guest1" "guest2" "both") ("admin1" "admin2" "both"))
        (begin (register-guest-user base-uri "testnode" "guest1")
               (register-guest-user base-uri "testnode" "guest2")
               (register-guest-user base-uri "testnode" "both")
               (register-admin-user base-uri "testnode" "admin1")
               (register-admin-user base-uri "testnode" "admin2")
               (register-admin-user base-uri "testnode" "both")
               (let ((info (get-node-info base-uri "testnode")))
                 (list (alist-ref 'guest-users info)
                       (alist-ref 'admin-users info)))))
  (test "After unregistering users, they are not listed"
        '(("guest2") ("admin2"))
        (begin (unregister-user base-uri "testnode" "guest1")
               (unregister-user base-uri "testnode" "admin1")
               (unregister-user base-uri "testnode" "both")
               (let ((info (get-node-info base-uri "testnode")))
                 (list (alist-ref 'guest-users info)
                       (alist-ref 'admin-users info)))))
  
  (test-error "Putting document without URI is an error"
              (put-document base-uri "testnode" "This is just a test" '()))
  (test-assert "Putting documents with URIs succeed"
               (begin
                 (put-document base-uri "testnode" '("Just a test for estraier")
                               '((@uri . "/test1") (my-tag . "something")))
                 (put-document base-uri "testnode" '("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 (sync-node base-uri "testnode") #t))
  (let ((info (get-node-info base-uri "testnode")))
    (test "Get-node-info reports the new documents"
          2 (alist-ref 'document-count info))
    (test "Get-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 base-uri "testnode")))
  (test "Skipping list results works"
        '("/test2")
        (map (lambda (l) (alist-ref '@uri l))
             (list-documents base-uri "testnode" prev: "/test1")))
  (test "Maximum result length is used"
        '("/test1")
        (map (lambda (l) (alist-ref '@uri l))
             (list-documents base-uri "testnode" max: 1)))
  (test "Document keywords are correct"
        '("a" "estraier" "for" "just" "test")
        (sort (map car (document-keywords base-uri "testnode" uri: "/test1")) string<?))

  (receive (doc meta)
    (get-document base-uri "testnode" 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
                    base-uri "testnode" (alist-update! 'my-tag "or other" meta))
                   #t))
    (receive (doc meta)
      (get-document base-uri "testnode" 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 base-uri "testnode"
                                   '("Simply a test for estraier")
                                   meta)
                     (sync-node base-uri "testnode") 
                    #t))
      (receive (doc meta)
        (get-document base-uri "testnode" uri: "/test1")
        (test "Updated document is accepted"
              '("Simply a test for estraier")
              (values doc)))))

  (test "Document-attribute returns correct attributes"
        "or other"
        (document-attribute base-uri "testnode" '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 base-uri "testnode" 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 base-uri "testnode" "/test1")))

  (receive (results meta-data)
    (find-documents base-uri "testnode" phrase: "test" max: 1)
    (test "Find-documents honors result 'max limit"
          '(((#f . "Another ") ("test" . "test") (#f . " for estraier")))
          (map car results))
    ;; XXX: This is really quite ugly and could use improvement. How far do we go?
    (test "Still returns number of hits correctly"
          (list "2") (alist-ref 'HIT meta-data)))

  (receive (results meta-data)
    (find-documents base-uri "testnode" 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 base-uri "testnode"
                                 attr-phrases: '("0" "1" "2" "3" "4" "5"
                                                 "6" "7" "8" "9")))
    (test-error "Find-documents cannot search more than 10 attributes"
                (find-documents base-uri "testnode"
                                attr-phrases: '("0" "1" "2" "3" "4" "5"
                                                "6" "7" "8" "9" "10"))))

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

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

(test-end)

(unless (zero? (test-failure-count)) (exit 1))