#!/usr/bin/env scheme-script
;; -*- mode: scheme; coding: utf-8 -*-
;; Copyright © 2009 Göran Weinholt <goran@weinholt.se>
;;
;; This program is free software: you can redistribute it and/or modify
;; it under the terms of the GNU General Public License as published by
;; the Free Software Foundation, either version 3 of the License, or
;; (at your option) any later version.
;;
;; This program is distributed in the hope that it will be useful,
;; but WITHOUT ANY WARRANTY; without even the implied warranty of
;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
;; GNU General Public License for more details.
;;
;; You should have received a copy of the GNU General Public License
;; along with this program.  If not, see <http://www.gnu.org/licenses/>.
#!r6rs

(import (weinholt crypto md5)
        (rnrs))

(define (test/s expect . data)
  (let ((result (md5->string (apply md5 (map string->utf8 data)))))
    (unless (string-ci=? result expect)
      (error 'test "Bad result" result))))

(test/s "5793f7e3037448b250ae716b43ece2c2" (make-string 100000 #\A))
(test/s "48fcdb8b87ce8ef779774199a856091d" (make-string 1000000 #\A))

;; From RFC 1321
(test/s "d41d8cd98f00b204e9800998ecf8427e" "")
(test/s "0cc175b9c0f1b6a831c399e269772661" "a")
(test/s "900150983cd24fb0d6963f7d28e17f72" "abc")
(test/s "f96b697d7cb7938d525a2f31aaf161d0" "message digest")
(test/s "c3fcd3d76192e4007dfb496cca67e13b" "abcdefghijklmnopqrstuvwxyz")
(test/s "d174ab98d277d9f5a5611c2c9f419d9f" "ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz0123456789")
(test/s "57edf4a22be3c955ac49da2e2107b67a" "12345678901234567890123456789012345678901234567890123456789012345678901234567890")

;; From RFC 2104/2202
(define (test-hmac expect key data)
  (let ((result (md5->string (hmac-md5 key data))))
    (unless (string-ci=? result expect)
      (error 'test-hmac "bad result" result expect))))

(test-hmac "9294727a3638bb1c13f48ef8158bfc9d"
           (make-bytevector 16 #x0b)
           (string->utf8 "Hi There"))

(test-hmac "750c783e6ab0b503eaa86e310a5db738"
           (string->utf8 "Jefe")
           (string->utf8 "what do ya want for nothing?"))

(test-hmac "56be34521d144c88dbb8c733f0e8b3f6"
           (make-bytevector 16 #xAA)
           (make-bytevector 50 #xDD))

(test-hmac "697eaf0aca3a3aea3a75164746ffaa79"
           #vu8(#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)
           (make-bytevector 50 #xcd))

(test-hmac "56461ef2342edc00f9bab995690efd4c"
           (make-bytevector 16 #x0c)
           (string->utf8 "Test With Truncation")) ;; not testing truncation...
;; digest-96 = 0x56461ef2342edc00f9bab995

(test-hmac "6b1ab7fe4bd7bf8f0b62e6ce61b9d0cd"
           (make-bytevector 80 #xaa)
           (string->utf8 "Test Using Larger Than Block-Size Key - Hash Key First"))

(test-hmac "6f630fad67cda0ee1fb1f562db3aa53e"
           (make-bytevector 80 #xaa)
           (string->utf8 "Test Using Larger Than Block-Size Key and Larger Than One Block-Size Data"))
