(use-modules (gnubba xmpp))

(suite "iq/message/presence stanzas"
       (tests
        (test "iq should return a simple iq stanza" e
              (assert-equal '(*TOP* (iq (@ (to "romeo@capulet.it")
                                           (type "get")
                                           (id "1234"))
                                        "payload"))
                            (e 'iq1)))
        (test "message should return a simple message stanza" e
              (assert-equal '(*TOP* (message (@ (to "romeo@capulet.it"))
                                             (body "hello, romeo!")))
                            (e 'message1)))
        (test "presence should return a simple presence stanza" e
              (assert-equal '(*TOP* (presence (@ (id "1234"))))
                            (e 'presence1)))
        (test "presence takes optional body argument" e
              (assert-equal '(*TOP* (presence (@ (id "1234")) "body"))
                            (e 'presence2)))
        (test "iq? should return #t on an iq stanza" e
              (assert-true (iq? (e 'iq1))))
        (test "iq? should return #f on any other stanza" e
              (assert-false (iq? (e 'message1))))
        (test "message? should return #t on a message stanza" e
              (assert-true (message? (e 'message1))))
        (test "message? should return #f on any other stanza" e
              (assert-false (message? (e 'iq1))))
        (test "presence? should return #t on a presence stanza" e
              (assert-true (presence? (e 'presence1))))
        (test "presence? should return #f on any other stanza" e
              (assert-false (presence? (e 'iq1)))))
       (options)
       (setups
        (setup 'iq1       (iq "payload" #:to "romeo@capulet.it" #:id "1234"))
        (setup 'message1  (message "romeo@capulet.it" "hello, romeo!"))
        (setup 'presence1 (presence #:id "1234"))
        (setup 'presence2 (presence "body" #:id "1234"))
        (setup 'presence3 (presence "body" #:id "1234" #:from "romeo@capulet.it"))))

(suite "register-temp-stanza-handler-for-id"
       (tests
        (test "handler is not executed if stanza with non-matching id is received" e
              (assert-false (error?
                             (begin
                               (register-temp-stanza-handler-for-id
                                "1234a"
                                (lambda _ (throw 'error)))
                               ((@@ (gnubba xmpp) handle-stanza) (e 'stanza))))))
        (test "handler remains if stanza with non-matching id is received" e
              (assert-equal 1
                            (begin
                              (register-temp-stanza-handler-for-id
                               "1234b"
                               (lambda _ (throw 'error)))
                              ((@@ (gnubba xmpp) handle-stanza) (e 'stanza))
                              (hash-count (const #t)
                                          (@@ (gnubba xmpp) *stanza-id-handlers*)))))
        (test "handler is removed after execution" e
              (assert-equal 0
                            (begin
                              (register-temp-stanza-handler-for-id
                               "999"
                               (lambda _ 'handler))
                              ((@@ (gnubba xmpp) handle-stanza) (e 'stanza))
                              (hash-count (const #t)
                                          (@@ (gnubba xmpp) *stanza-id-handlers*))))))
       (options)
       (setups
        (setup 'stanza (iq "payload" #:to "romeo@capulet.it" #:id "999")))
       (teardowns
        ;; always reset the internal state after each test
        (teardown e (set! (@@ (gnubba xmpp) *stanza-id-handlers*)
                          (make-hash-table)))))

(suite "register-stanza-handler"
       (tests
        (test "initially, *stanza-handlers* should be empty" e
              (assert-equal '() ((e 'handlers))))
        (test "after registering a handler *stanza-handlers* contains one handler" e
              (assert-equal 1
                            (begin
                              (register-stanza-handler (lambda _ 'handler1))
                              (length ((e 'handlers))))))
        (test "after registering two handlers *stanza-handlers* contains two handlers" e
              (assert-equal 2
                            (begin
                              (register-stanza-handler (lambda _ 'handler1))
                              (register-stanza-handler (lambda _ 'handler2))
                              (length ((e 'handlers))))))
        (test "handlers may have guards" e
              (assert-equal 3
                            (begin
                              (register-stanza-handler message?
                                                       (lambda _ 'handler1))
                              (register-stanza-handler iq?
                                                       (lambda _ 'handler2))
                              (register-stanza-handler #t
                                                       (lambda _ 'handler2))
                              (length ((e 'handlers)))))))
       (options)
       (setups
        (setup 'handlers  (lambda () (@@ (gnubba xmpp) *stanza-handlers*))))
       (teardowns
        ;; always reset the internal state after each test
        (teardown e (set! (@@ (gnubba xmpp) *stanza-handlers*) '()))))

(suite "try-stanza-handlers"
       (tests
        (test "a handler registered without a guard or #t is executed for any stanza" e
              (assert-equal '(handler2 handler1)
                            (begin
                              (register-stanza-handler
                               (lambda _ 'handler1))
                              (register-stanza-handler
                               #t
                               (lambda _ 'handler2))
                              ((@@ (gnubba xmpp) try-stanza-handlers) (e 'message1)))))
        (test "handlers with guards are only executed for stanzas that match (a)" e
              (assert-equal '(#f handler1)
                            (begin
                              (register-stanza-handler message?
                                                       (lambda _ 'handler1))
                              (register-stanza-handler iq?
                                                       (lambda _ 'handler2))
                              ((@@ (gnubba xmpp) try-stanza-handlers) (e 'message1)))))
        (test "handlers with guards are only executed for stanzas that match (b)" e
              (assert-equal '(handler2 #f)
                            (begin
                              (register-stanza-handler message?
                                                       (lambda _ 'handler1))
                              (register-stanza-handler iq?
                                                       (lambda _ 'handler2))
                              ((@@ (gnubba xmpp) try-stanza-handlers) (e 'iq1)))))
        (test "no handlers are executed if none of the guards match the stanza" e
              (assert-equal '(#f #f)
                            (begin
                              (register-stanza-handler message?
                                                       (lambda _ 'handler1))
                              (register-stanza-handler iq?
                                                       (lambda _ 'handler2))
                              ((@@ (gnubba xmpp) try-stanza-handlers) (e 'presence1)))))
        (test "when a handler throws 'halt no other handlers are executed" e
              (assert-equal '(handler2 handler3)
                            (let ((*executed* '()))
                              (register-stanza-handler
                               (lambda _ (set! *executed* (cons 'handler1 *executed*))))
                              (register-stanza-handler
                               (lambda _
                                 (set! *executed* (cons 'handler2 *executed*))
                                 (throw 'halt 'handler2)))
                              (register-stanza-handler
                               (lambda _ (set! *executed* (cons 'handler3 *executed*))))
                              (catch 'halt
                                (lambda _
                                  ((@@ (gnubba xmpp) try-stanza-handlers) (e 'message1)))
                                (lambda _ #t))
                              *executed*))))
       (options)
       (setups
        (setup 'iq1       (iq "payload" #:to "romeo@capulet.it" #:id "1234"))
        (setup 'message1  (message "romeo@capulet.it" "hello, romeo!"))
        (setup 'presence1 (presence #:id "1234")))
       (teardowns
        ;; always reset the internal state after each test
        (teardown e (set! (@@ (gnubba xmpp) *stanza-handlers*) '()))))

;; TODO
(suite "next-stanza-id!" (tests))
(suite "handle-stanza"
       (tests
        (test "calls id handler first, then generic handler" e
              (assert-equal
               '(generic-handler id-handler)
               (let ((results '()))
                 (register-stanza-handler
                  (lambda _ (set! results (cons 'generic-handler results))))
                 (register-temp-stanza-handler-for-id
                  (stanza-id (e 'stanza))
                  (lambda _ (set! results (cons 'id-handler results))))
                 ((@@ (gnubba xmpp) handle-stanza) (e 'stanza))
                 results)))
        (test "catches 'halt" e
              (assert-false
               (error?
                (begin
                  (register-stanza-handler
                   (lambda _ (throw 'never-executed)))
                  (register-temp-stanza-handler-for-id
                   (stanza-id (e 'stanza))
                   (lambda _ (throw 'halt)))
                  ((@@ (gnubba xmpp) handle-stanza) (e 'stanza)))))))
       (options)
       (setups
        (setup 'stanza (iq "payload" #:to "romeo@capulet.it" #:id "1234")))
       (teardowns
        ;; always reset the internal state after each test
        (teardown e (set! (@@ (gnubba xmpp) *stanza-handlers*) '()))))

(suite "run-handler-loop"
       (tests
        (test "does not die when a handler throws an exception" e
              (assert-false
               (error? (begin
                         (register-stanza-handler
                          (lambda _ (throw 'some-error "no reason")))
                         (call-with-input-string
                          "<iq from='test' id='123'/><iq from='someone' id='234'/>"
                          run-handler-loop)))))
        (test "processes all stanzas in the queue" e
              (assert-equal 2
               (let ((count 0))
                 (register-stanza-handler
                  (lambda _ (begin (set! count (1+ count))
                                   (throw 'some-error "no reason"))))
                 (call-with-input-string
                  "<iq from='test' id='123'/><iq from='someone' id='234'/>"
                  run-handler-loop)
                 count)))))