(import
  (chicken bitwise)
  (chicken blob)
  srfi-4
  (only srfi-1 reverse! iota every)
  test
  botan)

(test-group "library management"

  (test-assert "compatible API version"
    (botan-api-version 20191214))

  (test-assert "compatible library version"
    (apply
     (lambda (major minor patch . rest)
       (and (= major 2) (>= minor 13)))
     (botan-version)))

)

(test-group "general utilities"

  (test-group "data predicate"
    (test-assert "false is data"
      (data? #f))
    (test-assert "true is not data"
      (not (data? #t)))
    (test-assert "strings are data"
      (data? "hello"))
    (test-assert "blobs are data"
      (data? '#${deadbeef}))
    (test-assert "bytevectors are data"
      (data? '#u8(1 2 3 4))))

  (test-group "data equivalence"
    (test-assert "false equivalence"
      (data-eqv? #f #f))
    (test-assert "empty equivalence"
      (and (data-eqv? "" #f) (data-eqv? #f '#u8())))
    (test-error "type error detection"
      (data-eqv? #t 1))

    (test-assert "length mismatch"
      (not (data-eqv? "foo" "foobar")))
    (test-assert "same contents"
      (data-eqv? "\xDE\xAD\xBE\xEF" '#u8(#xDE #xAD #xBE #xEF))))

  (test-group "hex encoding"
    (test "DEADBEEF" (hex-encode '#${deadbeef}))
    (test "deadbeef" (hex-encode '#${deadbeef} downcase: #t))
    (test '#u8(#xDE #xAD #xBE #xEF) (hex-decode " dead beef ")))

  (test-group "base64 encoding"
    (test "SGVsbG8gd29ybGQh" (base64-encode "Hello world!"))
    (test '#u8(1 2 3 4) (base64-decode " AQID BA== ")))

  (test-assert "data scrubbing"
    (let* ([a "foobar!"] [b (string-copy a)])
      (data-scrub! b)
      (not (data-eqv? a b))))

)

(test-group "hash functions" (let ()

  (define hash (make-hash 'SHA-256))

  (test-assert (hash? hash))
  (test-assert (not (hash? "deadbeef")))

  (hash-update! hash "Hello world!")

  (define hash1 (hash-copy hash))
  (test 'SHA-256 (hash-name hash1))

  (hash-update! hash "How are you?")

  (test 32 (hash-length hash))

  (test "83AF05CC349B96F2D5D5E70B3D499D5BD5A2FA692EB49E36A1DD42EDC43E67E4" (hex-encode (hash-final hash)))
  (test "C0535E4BE2B79FFD93291305436BF889314E4A3FAEC05ECFFCBB7DF31AD9E51A" (hex-encode (hash-final hash1)))

))

(test-group "message authentication codes" (let ()

  (define mac (make-mac '(HMAC SHA-256)))

  (test-assert (mac? mac))
  (test-assert (not (mac? "deadbeef")))

  (test '(HMAC SHA-256) (mac-name mac))
  (test '(0 4096 1) (receive (mac-keyspec mac)))
  (test 32 (mac-length mac))

  (mac-set-key! mac (blob->u8vector/shared (string->blob "t0p $secret ;)")))
  (mac-update! mac "Hello world!")

  (test "AF36E3CD51944305938B92AF15380F648A80D4D4C7543B33EA9FA2ECCEC4529C" (hex-encode (mac-final mac)))

))

(test-group "password hashing" (let ()

  (define hash "$2a$12$93V2KYpv4GkR/XBdATirsuSiQj8TJucQt/Wmh4yBMGKd3v9nfXfQi")

  (test-assert "valid password"
    (bcrypt-valid? "t0p $secret ;)" hash))
  (test-assert "invalid password"
    (not (bcrypt-valid? "let me in" hash)))
  (test-assert "invalid hash"
    (not (bcrypt-valid? "t0p $secret ;)" (string-append hash "garbage"))))

))

(test-group "symmetric cryptography" (let ()

  (define op (make-cipher 'AES-256/GCM 'encrypt))

  (test-group "cipher properties"
    (test-assert (cipher? op))
    (test-assert (not (cipher? "foobar")))

    (test "AES-256/GCM(16)" (cipher-name op))
    (test '(32 32 1) (receive (cipher-keyspec op)))
    (test 16 (cipher-tag-length op))

    (test 12 (cipher-default-nonce-length op))
    (test-assert (cipher-valid-nonce-length? op 8))
    (test-assert (not (cipher-valid-nonce-length? op 0))))

  (test-group "encryption and decryption" (let ()
    (define key (base64-decode "7panpFbGHvy8REoJpH/p9OWa6wXy6M9H7wC41ooSp+E="))
    (define nonce '#u8(0 0 0 0 0 0 0 1))
    (cipher-set-key! op key)

    (define pt "How are you?")
    (define ct (cipher-transform op pt nonce: nonce))
    (test-assert (string? ct))
    (test "ciphertext length" (+ (string-length pt) (cipher-tag-length op)) (string-length ct))
    
    (set! op (make-cipher 'AES-256/GCM 'decrypt))
    (cipher-set-key! op key)

    (test "valid decryption" pt (cipher-transform op ct nonce: nonce))

    (let ([i (floor (/ (string-length ct) 2))])
      (string-set! ct i (case (string-ref ct i) [(#\nul #\X)] [else #\nul])))

    (test "invalid decryption" #f (cipher-transform op ct nonce: nonce))))

))

(test-group "public key cryptography" (let ()

  (define alice/sec (load-privkey "alice_rsa.pem" password: "alice"))
  (define alice/pub (privkey->pubkey alice/sec))

  (define alice/kex (load-privkey "alice_curve25519.pem"))
  (define bob/kex (load-privkey "bob_curve25519.pem"))

  (define rng (make-rng 'user))

  (test-group "key properties"
    (test-assert (privkey? alice/sec))
    (test-assert (pubkey? alice/pub))

    (test-assert (not (privkey? alice/pub)))
    (test-assert (not (pubkey? alice/sec)))

    (test 'RSA (privkey-algorithm alice/sec))
    (test 'RSA (pubkey-algorithm alice/pub))

    (test 'Curve25519 (privkey-algorithm alice/kex))
    (test 'Curve25519 (privkey-algorithm bob/kex))

    (test-assert (privkey-check alice/sec rng strong: #t))
    (test 132 (pubkey-estimated-strength alice/pub))

    (test-assert (integer? (privkey-field alice/sec 'p)))
    (test-assert (integer? (pubkey-field alice/pub 'n))))

  (test-group "encryption and decryption" (let ()
    (define op (make-pk-encrypt alice/pub '(OAEP SHA-256)))

    (test-assert (pk-encrypt? op))
    (test-assert (not (pk-decrypt? op)))

    (define pt "Hello world!")
    (define ct (pk-encrypt op rng pt))

    (test-assert (string? ct))
    (test-assert (> (string-length ct) (string-length pt)))

    (set! op (make-pk-decrypt alice/sec '(OAEP SHA-256)))

    (test-assert (pk-decrypt? op))
    (test-assert (not (pk-encrypt? op)))

    (test "valid decryption" pt (pk-decrypt op ct))

    (let ([i (floor (/ (string-length ct) 2))])
      (string-set! ct i (case (string-ref ct i) [(#\nul #\X)] [else #\nul])))

    (test "invalid decryption" #f (pk-decrypt op ct))))

  (test-group "signing and verification" (let ()
    (define op (make-pk-sign alice/sec '(PKCS1v15 SHA-256)))

    (test-assert (pk-sign? op))
    (test-assert (not (pk-verify? op)))

    (define msg "Hello world!")
    (pk-sign-update! op msg)

    (define sig (pk-sign-final op rng))

    (test-assert (u8vector? sig))

    (set! op (make-pk-verify alice/pub '(PKCS1v15 SHA-256)))

    (test-assert (pk-verify? op))
    (test-assert (not (pk-sign? op)))

    (pk-verify-update! op msg)

    (test-assert "valid signature" (pk-verify-final op sig))

    (pk-verify-update! op (string-append msg "garbage"))

    (test-assert "broken message" (not (pk-verify-final op sig)))

    (pk-verify-update! op msg)
    (let ([i (floor (/ (u8vector-length sig) 2))])
      (u8vector-set! sig i (bitwise-xor (u8vector-ref sig i) #xCC)))

    (test-assert "broken signature" (not (pk-verify-final op sig)))))

  (test-group "key agreement" (let ()
    (define op (make-pk-key-agreement alice/kex '(KDF2 SHA-256)))
    (test-assert (pk-key-agreement? op))

    (define pub (pk-key-agreement-export-public bob/kex))
    (test-assert (u8vector? pub))

    (define sec0 (pk-key-agreement op pub))
    (test-assert (u8vector? sec0))

    (set! op (make-pk-key-agreement bob/kex '(KDF2 SHA-256)))
    (test-assert (pk-key-agreement? op))

    (set! pub (pk-key-agreement-export-public alice/kex))
    (test-assert (u8vector? pub))

    (define sec1 (pk-key-agreement op pub))
    (test-assert (u8vector? sec1))

    (test-assert "equivalent secrets" (data-eqv? sec0 sec1))))

))

(test-group "X.509 certificates" (let ()

  (define-values (self intermediate root)
    (let* ([chain (load-x509-cert-chain "chust-org.pem")]
           [self (car chain)] [intermediate #f] [root #f])
      (set! chain (reverse! (cdr chain)))
      (set! root (car chain))
      (set! intermediate (reverse! (cdr chain)))
      (values self intermediate root)))

  (test-group "certificate properties"
    (test-assert (x509-cert? self))
    (test-assert (x509-cert? root))
    (test-assert (not (x509-cert? "deadbeef")))

    (test 1661558400 (x509-cert-not-before self))
    (test 1694908799 (x509-cert-not-after self))
    (test "0F9918D1804CA7D506B3B83A2B48DE2C" (hex-encode (x509-cert-serial-number self)))
    (test "182FB484D8D653B50A09F56380C24765F8EFC3E2" (hex-encode (x509-cert-subject-key-id self)))
    (test "55744FB2724FF560BA50D1D7E6515C9A01871AD7" (hex-encode (x509-cert-issuer-key-id self)))
    (test "*.chust.org" (x509-cert-subject-dn self 'CN))
    (test-assert "missing field" (not (x509-cert-subject-dn self 'OU)))
    (test "www.digicert.com" (x509-cert-issuer-dn self 'OU))
    (test-assert "missing index" (not (x509-cert-issuer-dn self 'OU 1))))

  (test-group "certificate validation"
    (test-assert (x509-usage-allowed? self 'key-agreement))
    (test-assert (not (x509-usage-allowed? self)))
    (test-assert (x509-hostname-match? self "chust.org"))
    (test-assert (not (x509-hostname-match? self "example.com")))

    (test "certificate valid"
      '(#t "Verified")
      (receive
        (x509-verify self intermediate: intermediate trusted: root hostname: "example.chust.org" time: 1686489615)))
    (test "certificate expired"
      '(#f "Certificate has expired")
      (receive
        (x509-verify self intermediate: intermediate trusted: root hostname: "example.chust.org" time: 1749561632)))
    (test "certificate hostname mismatch"
      '(#f "Certificate does not match provided name")
      (receive
        (x509-verify self intermediate: intermediate trusted: root hostname: "example.com" time: 1686489615))))

))

(test-group "one-time passwords" (let ()

  (define key (base64-decode "3ve49p/qv9eaObCaCaUxZR9v2jlF+Ac9cVC7Y/YQe7g="))

  (test-group "hashed authenticator" (let ()
    (define otp (make-hotp key))
    (test-assert (hotp? otp))
    (test-assert (not (hotp? "foobar")))

    (define codes
      (map
       (cut hotp-generate otp <>)
       (iota 4)))

    (test-assert (every integer? codes))

    (test "valid code" 2 (hotp-valid? otp (list-ref codes 1) 1))
    (test "invalid code" #f (hotp-valid? otp (list-ref codes 3) 1))
    (test "skipped code" 4 (hotp-valid? otp (list-ref codes 3) 1 resync-range: 2))))

  (test-group "time-based authenticator" (let ()
    (define otp (make-totp key))
    (test-assert (totp? otp))
    (test-assert (not (totp? "foobar")))

    (define codes
      (map
        (cut totp-generate otp time: <>)
        (iota 4 0 32)))

    (test-assert (every integer? codes))

    (test-assert "valid code" (totp-valid? otp (list-ref codes 1) time: 35))
    (test-assert "invalid code" (not (totp-valid? otp (list-ref codes 3) time: 35)))
    (test-assert "delayed code" (totp-valid? otp (list-ref codes 0) time: 45 acceptable-drift: 1))))

))

(test-group "format preserving encryption" (let ()

  (define key (base64-decode "6yhGDBXQ/80n5HPOa/B/ke8QjprnSpuBHZ88tcaHqyY="))
  (define tweak '#u8(1 2 3 4 5 6 7 8))

  (define fpe (make-fpe key))
  (test-assert (fpe? fpe))
  (test-assert (not (fpe? "fpe")))

  (define p 12345)
  (define c (fpe-encrypt fpe p tweak))

  (test "valid decryption" p (fpe-decrypt fpe c tweak))
  (test-assert "invalid decryption" (not (= p (fpe-decrypt fpe (floor (/ c 2)) tweak))))

))

(test-exit)

;; vim: set ai et ts=4 sts=2 sw=2: ;;