(define-test-module (test module sph storage dg user)
  (import
    (sph random-data)
    (sph storage dg)
    (rnrs bytevectors)
    (sph list)
    (test helper sph storage dg)
    (sph storage dg user))

  (define-test (user-create-delete)
    (dg-txn-call-write
      (l (txn)
        (let*
          ( (size-before (test-helper-dg-count-btree-entries))
            (names (test-helper-dg-data-random-string 2))
            (passwords (test-helper-dg-data-random-string 2))
            (user-ids (map (l (a b) (user-create txn a b)) names passwords)))
          (assert-and (assert-true "exists" (apply user-exists? txn names))
            (assert-true "id->name" (list-set-equal? names (apply user-id->name txn user-ids)))
            (assert-true "name->id" (list-set-equal? user-ids (apply user-name->id txn names)))
            (assert-true "authenticate"
              (equal? (list #t #f #f #t)
                (map integer? (debug-log (produce (l (a b) (user-authenticate txn a b)) names passwords)))))
            (assert-true "deletion"
              (begin (apply user-delete user-ids)
                (every not (produce (l (a b) (user-authenticate txn a b)) names passwords))))
            (assert-true "size-after" (= size-before (test-helper-dg-count-btree-entries))))))))

  (define-procedure-tests tests (user-create-delete))

  (l (settings)
    (let*
      ( (settings (test-helper-dg-default-test-settings settings))
        (result (test-execute-procedures settings tests)))
      (test-helper-dg-database-exit) result)))

#;(define (test-user-set+ref)
  (let
    ( (before-count (test-env-dg-count-all))
      (user-ide
        (map any->list
          (map user-create (test-env-dg-random-interns-string 2)
            (test-env-dg-random-interns-string 2))))
      (field (map any->list (test-env-dg-random-interns-string 2)))
      (value (map any->list (test-env-dg-random-interns-string 2))))
    (assert-and
      (begin (each (l (ide field value) (apply user-set! ide field value)) user-ide field value)
        (assert-equal (q (#t #f #f #t)) (map true? (produce user-ref user-ide field))))
      (begin (apply user-delete (apply append user-ide))
        (let (after-count (test-env-dg-count-all)) (assert-equal before-count after-count))))))

#;(define (test-user-update-name inp exp)
  (let*
    ( (old-names (test-env-dg-random-interns-string 2))
      (passwords (test-env-dg-random-interns-string 2))
      (user-ide (map user-create old-names passwords)) (before-count (test-env-dg-count-all))
      (new-names (test-env-dg-random-interns-string 2)))
    (each user-update-name user-ide new-names)
    (assert-and (assert-equal (q (#f #f #t #t)) (map user-exists? (append old-names new-names)))
      (assert-equal (q (#f #f)) (map user-authenticate old-names passwords))
      (assert-true (every integer? (map user-authenticate new-names passwords)))
      (assert-true (list-set-equal? new-names (user-ide->name user-ide))))))