(define aes-128-ecb (cipher-by-name "aes-128-ecb"))
(define aes-128-cbc (cipher-by-name "aes-128-cbc"))
(define aes-128-ctr (cipher-by-name "aes-128-ctr"))
(define aes-128-gcm (cipher-by-name "aes-128-gcm"))
(define aes-128-ccm (cipher-by-name "aes-128-ccm"))
(define aes-128-ocb (cipher-by-name "aes-128-ocb"))
(define rc4 (cipher-by-name "rc4"))

(define ciphers (cipher-list))
(test-assert "Cipher list is not empty" (pair? ciphers))

(for-each
 (lambda (name)
   (test-assert (format "~a cipher in list" name) (member name ciphers))
   (test-assert (format "~a cipher available" name) (cipher-by-name name)))
 '("aes-128-ecb" "aes-128-cbc" "aes-128-ctr" "aes-128-gcm" "rc4"))

(test-assert "Bogus cipher" (not (cipher-by-name "aes-128-abc")))

(let ((ctx (cipher-context-allocate!))
      (key (string->blob "YELLOW SUBMARINE"))
      (iv #f))
  (cipher-context-init! ctx aes-128-ecb key iv)
  (let* ((ciphertext (blob->string (cipher-context-update! ctx (string->blob "secret"))))
         (ciphertext (string-append ciphertext (blob->string (cipher-context-final! ctx)))))
    (cipher-context-reset! ctx)
    (cipher-context-init! ctx aes-128-ecb key iv mode: 'decrypt)
    (let* ((plaintext (blob->string (cipher-context-update! ctx (string->blob ciphertext))))
           (plaintext (string-append (blob->string (cipher-context-final! ctx)))))
      (test "Low level API roundtrip" plaintext "secret")))
  (cipher-context-free! ctx)
  (test-error "Error when accessing freed context" (cipher-context-init! ctx aes-128-ecb key iv)))

(test "Port API roundtrip"
      "secret"
      (let* ((key (string->blob "YELLOW SUBMARINE"))
             (iv #f)
             (ciphertext
              (call-with-output-string
               (lambda (out)
                 (let ((out (open-cipher-port aes-128-ecb out key iv mode: 'encrypt)))
                   (display "secret" out)
                   (close-output-port out))))))
        (call-with-output-string
         (lambda (out)
           (let ((out (open-cipher-port aes-128-ecb out key iv mode: 'decrypt)))
             (display ciphertext out)
             (close-output-port out))))))

(define (encrypt-string cipher plaintext key iv #!rest opts)
  (apply string-cipher cipher plaintext key iv mode: 'encrypt opts))

(define (decrypt-string cipher ciphertext key iv #!rest opts)
  (apply string-cipher cipher ciphertext key iv mode: 'decrypt opts))

(define (test-roundtrip cipher)
  (let ((plaintexts (map (o blob->string random-bytes) '(0 10 20)))
        (key (random-bytes (cipher-key-length cipher)))
        (iv (random-bytes (cipher-iv-length cipher))))
    (for-each
     (lambda (plaintext)
       (let ((label (format "Roundtrip ~a (~a bytes)"
                            (cipher-name cipher)
                            (string-length plaintext)))
             (ciphertext (encrypt-string cipher plaintext key iv)))
         (test label plaintext (decrypt-string cipher ciphertext key iv))))
     plaintexts)))

(test-roundtrip aes-128-cbc)
(test-roundtrip aes-128-ctr)

(let* ((cipher aes-128-cbc)
       (key-length (cipher-key-length cipher))
       (iv-length (cipher-iv-length cipher)))
  (test-error "Encryption with bogus algorithm" (encrypt-string #f "" (random-bytes key-length) (random-bytes iv-length)))
  (test-error "Encryption with too small key" (encrypt-string cipher "" (random-bytes 1) (random-bytes iv-length)))
  (test-error "Encryption with too big key" (encrypt-string cipher "" (random-bytes (add1 max-key-length)) (random-bytes iv-length)))
  (test-error "Encryption with too small IV" (encrypt-string cipher "" (random-bytes key-length) (random-bytes 1)))
  (test-assert "Encryption with too big IV" (encrypt-string cipher "" (random-bytes key-length) (random-bytes (add1 max-iv-length))))
  (test-assert "Encryption without IV in ECB mode" (encrypt-string cipher "" (random-bytes key-length) #f))
  (test-assert "Encryption of unpadded empty input" (encrypt-string cipher "" (random-bytes key-length) (random-bytes iv-length) padding: #f))
  (test-error "Encryption of unpadded input" (encrypt-string cipher "abc" (random-bytes key-length) (random-bytes iv-length) padding: #f))
  (test-assert "Encryption of manually padded input" (encrypt-string cipher (string-append "abc" (make-string 13 (integer->char 13))) (random-bytes key-length) (random-bytes iv-length) padding: #f)))

;; https://nvlpubs.nist.gov/nistpubs/Legacy/SP/nistspecialpublication800-38a.pdf
(let ((key (string->blob "\x2b\x7e\x15\x16\x28\xae\xd2\xa6\xab\xf7\x15\x88\x09\xcf\x4f\x3c"))
      (plaintext "\x6b\xc1\xbe\xe2\x2e\x40\x9f\x96\xe9\x3d\x7e\x11\x73\x93\x17\x2a"))
  (let ((ciphertext "\x3a\xd7\x7b\xb4\x0d\x7a\x36\x60\xa8\x9e\xca\xf3\x24\x66\xef\x97"))
    (test "AES-128-ECB test vector (encryption)" ciphertext (encrypt-string aes-128-ecb plaintext key #f padding: #f))
    (test "AES-128-ECB test vector (decryption)" plaintext (decrypt-string aes-128-ecb ciphertext key #f padding: #f)))
  (let ((iv (string->blob "\x00\x01\x02\x03\x04\x05\x06\x07\x08\x09\x0a\x0b\x0c\x0d\x0e\x0f"))
        (ciphertext "\x76\x49\xab\xac\x81\x19\xb2\x46\xce\xe9\x8e\x9b\x12\xe9\x19\x7d"))
    (test "AES-128-CBC test vector (encryption)" ciphertext (encrypt-string aes-128-cbc plaintext key iv padding: #f))
    (test "AES-128-CBC test vector (decryption)" plaintext (decrypt-string aes-128-cbc ciphertext key iv padding: #f)))
  (let ((iv (string->blob "\xf0\xf1\xf2\xf3\xf4\xf5\xf6\xf7\xf8\xf9\xfa\xfb\xfc\xfd\xfe\xff"))
        (ciphertext "\x87\x4d\x61\x91\xb6\x20\xe3\x26\x1b\xef\x68\x64\x99\x0d\xb6\xce"))
    (test "AES-128-CTR test vector (encryption)" ciphertext (encrypt-string aes-128-ctr plaintext key iv))
    (test "AES-128-CTR test vector (decryption)" plaintext (decrypt-string aes-128-ctr ciphertext key iv))))

(when aes-128-gcm
  (let ((key (string->blob "\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00"))
        (iv (string->blob "\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00")))
    (let ((plaintext ""))
      (receive (ciphertext tag)
          (string-encrypt-and-digest aes-128-gcm plaintext key iv tag-length: 16)
        (test "AES-GCM test vector (encryption)" "" ciphertext)
        (test "AES-GCM test vector (tag)" "\x58\xe2\xfc\xce\xfa\x7e\x30\x61\x36\x7f\x1d\x57\xa4\xe7\x45\x5a" tag)
        (test "AES-GCM test vector (decryption)" plaintext
              (string-decrypt-and-verify aes-128-gcm ciphertext tag key iv))))
    (let ((plaintext "\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00"))
      (receive (ciphertext tag)
          (string-encrypt-and-digest aes-128-gcm plaintext key iv tag-length: 16)
        (test "AES-GCM test vector (encryption)" "\x03\x88\xda\xce\x60\xb6\xa3\x92\xf3\x28\xc2\xb9\x71\xb2\xfe\x78" ciphertext)
        (test "AES-GCM test vector (tag)" "\xab\x6e\x47\xd4\x2c\xec\x13\xbd\xf5\x3a\x67\xb2\x12\x57\xbd\xdf" tag)
        (test "AES-GCM test vector (decryption)" plaintext
              (string-decrypt-and-verify aes-128-gcm ciphertext tag key iv))))
    (let ((key (string->blob "\xfe\xff\xe9\x92\x86\x65\x73\x1c\x6d\x6a\x8f\x94\x67\x30\x83\x08"))
          (iv (string->blob "\xca\xfe\xba\xbe\xfa\xce\xdb\xad\xde\xca\xf8\x88"))
          (plaintext "\xd9\x31\x32\x25\xf8\x84\x06\xe5\xa5\x59\x09\xc5\xaf\xf5\x26\x9a\x86\xa7\xa9\x53\x15\x34\xf7\xda\x2e\x4c\x30\x3d\x8a\x31\x8a\x72\x1c\x3c\x0c\x95\x95\x68\x09\x53\x2f\xcf\x0e\x24\x49\xa6\xb5\x25\xb1\x6a\xed\xf5\xaa\x0d\xe6\x57\xba\x63\x7b\x39")
          (auth-data (string->blob "\xfe\xed\xfa\xce\xde\xad\xbe\xef\xfe\xed\xfa\xce\xde\xad\xbe\xef\xab\xad\xda\xd2")))
      (receive (ciphertext tag)
          (string-encrypt-and-digest aes-128-gcm plaintext key iv tag-length: 16 auth-data: auth-data)
        (test "AES-GCM test vector (encryption)" "\x42\x83\x1e\xc2\x21\x77\x74\x24\x4b\x72\x21\xb7\x84\xd0\xd4\x9c\xe3\xaa\x21\x2f\x2c\x02\xa4\xe0\x35\xc1\x7e\x23\x29\xac\xa1\x2e\x21\xd5\x14\xb2\x54\x66\x93\x1c\x7d\x8f\x6a\x5a\xac\x84\xaa\x05\x1b\xa3\x0b\x39\x6a\x0a\xac\x97\x3d\x58\xe0\x91" ciphertext)
        (test "AES-GCM test vector (tag)" "\x5b\xc9\x4f\xbc\x32\x21\xa5\xdb\x94\xfa\xe9\x5a\xe7\x12\x1a\x47" tag)
        (test "AES-GCM test vector (decryption)" plaintext
              (string-decrypt-and-verify aes-128-gcm ciphertext tag key iv auth-data: auth-data))))))

(when aes-128-ccm
  (let ((key (string->blob "\x40\x41\x42\x43\x44\x45\x46\x47\x48\x49\x4a\x4b\x4c\x4d\x4e\x4f")))
    (let* ((plaintext "\x20\x21\x22\x23")
           (message-length (string-length plaintext))
           (iv (string->blob "\x10\x11\x12\x13\x14\x15\x16"))
           (tag-length 4)
           (auth-data (string->blob "\x00\x01\x02\x03\x04\x05\x06\x07")))
      (receive (ciphertext tag)
          (string-encrypt-and-digest aes-128-ccm plaintext key iv message-length: message-length tag-length: tag-length auth-data: auth-data)
        (test "AES-CCM test vector (encryption)" "\x71\x62\x01\x5b" ciphertext)
        (test "AES-CCM test vector (tag)" "\x4d\xac\x25\x5d" tag)
        (test "AES-CCM test vector (decryption)" plaintext
              (string-decrypt-and-verify aes-128-ccm ciphertext tag key iv message-length: message-length tag-length: tag-length auth-data: auth-data))))
    (let* ((plaintext "\x20\x21\x22\x23\x24\x25\x26\x27\x28\x29\x2a\x2b\x2c\x2d\x2e\x2f")
           (message-length (string-length plaintext))
           (iv-length 8)
           (iv (string->blob "\x10\x11\x12\x13\x14\x15\x16\x17"))
           (tag-length 6)
           (auth-data (string->blob "\x00\x01\x02\x03\x04\x05\x06\x07\x08\x09\x0a\x0b\x0c\x0d\x0e\x0f")))
      (receive (ciphertext tag)
          (string-encrypt-and-digest aes-128-ccm plaintext key iv effective-iv-length: iv-length message-length: message-length tag-length: tag-length auth-data: auth-data)
        (test "AES-CCM test vector (encryption)" "\xd2\xa1\xf0\xe0\x51\xea\x5f\x62\x08\x1a\x77\x92\x07\x3d\x59\x3d" ciphertext)
        (test "AES-CCM test vector (tag)" "\x1f\xc6\x4f\xbf\xac\xcd" tag)
        (test "AES-CCM test vector (decryption)" plaintext
              (string-decrypt-and-verify aes-128-ccm ciphertext tag key iv effective-iv-length: iv-length message-length: message-length tag-length: tag-length auth-data: auth-data))))
    (let* ((plaintext "\x20\x21\x22\x23\x24\x25\x26\x27\x28\x29\x2a\x2b\x2c\x2d\x2e\x2f\x30\x31\x32\x33\x34\x35\x36\x37")
           (message-length (string-length plaintext))
           (iv-length 12)
           (iv (string->blob "\x10\x11\x12\x13\x14\x15\x16\x17\x18\x19\x1a\x1b"))
           (tag-length 8)
           (auth-data (string->blob "\x00\x01\x02\x03\x04\x05\x06\x07\x08\x09\x0a\x0b\x0c\x0d\x0e\x0f\x10\x11\x12\x13")))
      (receive (ciphertext tag)
          (string-encrypt-and-digest aes-128-ccm plaintext key iv effective-iv-length: iv-length message-length: message-length tag-length: tag-length auth-data: auth-data)
        (test "AES-CCM test vector (encryption)" "\xe3\xb2\x01\xa9\xf5\xb7\x1a\x7a\x9b\x1c\xea\xec\xcd\x97\xe7\x0b\x61\x76\xaa\xd9\xa4\x42\x8a\xa5" ciphertext)
        (test "AES-CCM test vector (tag)" "\x48\x43\x92\xfb\xc1\xb0\x99\x51" tag)
        (test "AES-CCM test vector (decryption)" plaintext
              (string-decrypt-and-verify aes-128-ccm ciphertext tag key iv effective-iv-length: iv-length message-length: message-length tag-length: tag-length auth-data: auth-data))))))

(when aes-128-ocb
  (let ((key (string->blob "\x00\x01\x02\x03\x04\x05\x06\x07\x08\x09\x0a\x0b\x0c\x0d\x0e\x0f"))
        (auth-data (string->blob "\x00\x01\x02\x03\x04\x05\x06\x07")))
    (let ((plaintext "")
          (iv (string->blob "\xbb\xaa\x99\x88\x77\x66\x55\x44\x33\x22\x11\x00")))
      (receive (ciphertext tag)
          (string-encrypt-and-digest aes-128-ocb plaintext key iv tag-length: 16)
        (test "AES-OCB test vector (encryption)" "" ciphertext)
        (test "AES-OCB test vector (tag)" "\x78\x54\x07\xbf\xff\xc8\xad\x9e\xdc\xc5\x52\x0a\xc9\x11\x1e\xe6" tag)
        (test "AES-OCB test vector (decryption)" plaintext
              (string-decrypt-and-verify aes-128-ocb ciphertext tag key iv))))
    (let ((plaintext "\x00\x01\x02\x03\x04\x05\x06\x07")
          (iv (string->blob "\xbb\xaa\x99\x88\x77\x66\x55\x44\x33\x22\x11\x01")))
      (receive (ciphertext tag)
          (string-encrypt-and-digest aes-128-ocb plaintext key iv tag-length: 16 auth-data: auth-data)
        (test "AES-OCB test vector (encryption)" "\x68\x20\xb3\x65\x7b\x6f\x61\x5a" ciphertext)
        (test "AES-OCB test vector (tag)" "\x57\x25\xbd\xa0\xd3\xb4\xeb\x3a\x25\x7c\x9a\xf1\xf8\xf0\x30\x09" tag)
        (test "AES-OCB test vector (decryption)" plaintext
              (string-decrypt-and-verify aes-128-ocb ciphertext tag key iv auth-data: auth-data))))
    (let ((plaintext "")
          (iv (string->blob "\xbb\xaa\x99\x88\x77\x66\x55\x44\x33\x22\x11\x02")))
      (receive (ciphertext tag)
          (string-encrypt-and-digest aes-128-ocb plaintext key iv tag-length: 16 auth-data: auth-data)
        (test "AES-OCB test vector (encryption)" "" ciphertext)
        (test "AES-OCB test vector (tag)" "\x81\x01\x7f\x82\x03\xf0\x81\x27\x71\x52\xfa\xde\x69\x4a\x0a\x00" tag)
        (test "AES-OCB test vector (decryption)" plaintext
              (string-decrypt-and-verify aes-128-ocb ciphertext tag key iv auth-data: auth-data))))))

;; https://www.rfc-editor.org/rfc/rfc6229.txt
(let* ((cipher rc4)
       (key (string->blob "\x01\x02\x03\x04\x05\x06\x07\x08\x09\x0a\x0b\x0c\x0d\x0e\x0f\x10\x11\x12\x13\x14\x15\x16\x17\x18\x19\x1a\x1b\x1c\x1d\x1e\x1f\x20"))
       (plaintext "\x00\x00\x00\x00\x00\x00\x00\x00")
       (iv #f))
  (test-error "RC4-40 with invalid key length"
        (encrypt-string cipher plaintext (string->blob "\x01\x02\x03\x04\x05") #f effective-key-length: 10))
  (test "RC4-40 test vector (encryption)" "\xb2\x39\x63\x05\xf0\x3d\xc0\x27"
        (encrypt-string cipher plaintext (string->blob "\x01\x02\x03\x04\x05") #f effective-key-length: 5))
  (test "RC4-40 test vector (decryption)" plaintext
        (decrypt-string cipher "\xb2\x39\x63\x05\xf0\x3d\xc0\x27" (string->blob "\x01\x02\x03\x04\x05") #f effective-key-length: 5))
  (test "RC4-80 test vector (encryption)" "\xed\xe3\xb0\x46\x43\xe5\x86\xcc"
        (encrypt-string cipher plaintext key #f effective-key-length: 10))
  (test "RC4-80 test vector (decryption)" plaintext
        (decrypt-string cipher "\xed\xe3\xb0\x46\x43\xe5\x86\xcc" key #f effective-key-length: 10))
  (test "RC4-128 test vector (encryption)" "\x9a\xc7\xcc\x9a\x60\x9d\x1e\xf7"
        (encrypt-string cipher plaintext key #f effective-key-length: 16))
  (test "RC4-128 test vector (decryption)" plaintext
        (decrypt-string cipher "\x9a\xc7\xcc\x9a\x60\x9d\x1e\xf7" key #f effective-key-length: 16))
  (test "RC4-256 test vector (encryption)" "\xea\xa6\xbd\x25\x88\x0b\xf9\x3d"
        (encrypt-string cipher plaintext key #f effective-key-length: 32))
  (test "RC4-256 test vector (decryption)" plaintext
        (encrypt-string cipher "\xea\xa6\xbd\x25\x88\x0b\xf9\x3d" key #f effective-key-length: 32)))