;; mzcrypto: crypto library for mzscheme
;; Copyright (C) 2007 Dimitris Vyzovitis <[email protected]>
;;
;; This library is free software; you can redistribute it and/or
;; modify it under the terms of the GNU Lesser General Public
;; License as published by the Free Software Foundation; either
;; version 2.1 of the License, or (at your option) any later version.
;;
;; This library 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
;; Lesser General Public License for more details.
;;
;; You should have received a copy of the GNU Lesser General Public
;; License along with this library; if not, write to the Free Software
;; Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA  02110-1301,
;; USA

(module test mzscheme
  (require (lib "list.ss" "srfi" "1")
           (lib "check.ss" "srfi" "78")
           (only (lib "etc.ss") identity))
  (require "crypto.ss" (only "util.ss" hex))
  (provide (all-defined))
  
  (define (do-digest-final dg)
    (let-values (((obs olen) (digest-final! dg))) obs))

  (define (test-sha1)
    (check (hex (sha1 #"")) 
           => #"da39a3ee5e6b4b0d3255bfef95601890afd80709")
    (check (hex (sha1 #"abc")) 
           => #"a9993e364706816aba3e25717850c26c9cd0d89d")
    (check (hex (sha1 #"abcdef")) 
           => #"1f8ac10f23c5b5bc1167bda84b833e5c057a77d2")
  
    (let ((x (digest-new digest:sha1)))
      (digest-update! x #"abc")
      (check (hex (digest->bytes x))
             => #"a9993e364706816aba3e25717850c26c9cd0d89d")
      (digest-update! x #"abcdef" 3 (bytes-length #"abcdef"))
      (check (hex (do-digest-final x))
             => #"1f8ac10f23c5b5bc1167bda84b833e5c057a77d2")))
  
  (define (test-digest dt df)
    (define x (digest-new dt))
    (let* ((bs (random-bytes 128))
           (xbs (df bs)))
      (digest-update! x bs)
      (check (digest->bytes x) => xbs)
      (check (do-digest-final x) => xbs))
    
    (let ((k (random-bytes 20))
          (msg #"The cat is in the box."))
      (check (hmac dt k (open-input-bytes msg)) => (hmac dt k msg))))
  
  (define (test-pubkey ktype dgtype)
    (define k (generate-key ktype 1024))
    (define privkbs (private-key->bytes k))
    (define privk (bytes->private-key ktype privkbs))
    (define pubkbs (public-key->bytes k))
    (define pubk (bytes->public-key ktype pubkbs))

    (check (pkey-private? privk) => #t)
    (check (pkey-private? pubk) => #f)
    (check (= (bytes-length privkbs) (bytes-length pubkbs)) => #f)
    (check (pkey=? k pubk privk) => #t) ; libcrypto cmps only public components
  
    (let ((x (digest-new dgtype)))
      (digest-update! x (random-bytes 128))
      (check (with-handlers* ((exn:fail? (lambda x 'fail)))
               (digest-sign x pubk)) => 'fail)
      (let-values (((sig len) (digest-sign x privk)))
        (check (digest-verify x pubk sig) => #t)))
    
    (let ((bs (random-bytes 128)))
      (check (with-handlers* ((exn:fail? (lambda x 'fail)))
               (sign pubk dgtype bs)) => 'fail)
      (check (verify pubk dgtype (sign privk dgtype bs) bs) => #t))
    
    (let ((bs (random-bytes 128)))
      (check (verify pubk dgtype 
                     (sign privk dgtype (open-input-bytes bs)) 
                     (open-input-bytes bs)) 
             => #t)))

  (define (test-cipher algo)
    (define msg 
      #"Maybe the cat is out of the box! Where is the cat?")
    (define-values (k iv) (generate-key algo))
    
    (check (decrypt algo k iv (encrypt algo k iv msg)) => msg)

    (let* ((cin (encrypt algo k iv (open-input-bytes msg)))
           (pin (decrypt algo k iv cin)))
      (check (read-bytes (bytes-length msg) pin) => msg)
      (check (eof-object? (read pin)) => #t))
    
    (let-values (((pin) (open-input-bytes msg))
                 ((cin cout) (make-pipe))
                 ((pout) (open-output-bytes)))
      (encrypt algo k iv pin cout)
      (close-output-port cout)
      (decrypt algo k iv cin pout)
      (check (get-output-bytes pout) => msg))
    
    (let-values (((cin pout) (encrypt algo k iv))
                 ((pin cout) (decrypt algo k iv)))
      (write-bytes msg pout)
      (close-output-port pout)
      (write-bytes (read-bytes (* (cipher-block-size algo)
                                  (ceiling (/ (bytes-length msg) 
                                              (cipher-block-size algo))))
                               cin)
                   cout)
      (close-output-port cout)
      (check (read-bytes (bytes-length msg) pin) => msg)))
  
  (define (test-encrypt/pkey algo)
    (define privk (generate-key pkey:rsa 1024))
    (define pubk (pkey->public-key privk))
    (define msg #"the cat is still alive...")
    (let ((ct (encrypt/pkey pubk msg)))
      (check (with-handlers* ((exn:fail? (lambda x 'fail)))
               (decrypt/pkey pubk ct)) => 'fail)
      (check (decrypt/pkey privk ct) => msg))
    (let-values (((sk iv ct) (encrypt/envelope pubk algo msg)))
      (check (with-handlers* ((exn:fail? (lambda x 'fail)))
               (decrypt/envelope pubk algo sk iv ct)) => 'fail)
      (check (decrypt/envelope privk algo sk iv ct) => msg)))
 
  (define (test-dh params)
    (define-values (priv1 pub1) (generate-key params))
    (define-values (priv2 pub2) (generate-key params))
    (check (equal?(compute-key priv1 pub2) (compute-key priv2 pub1)) => #t))
 
  (define (run-tests)
    (define digests 
      (filter identity
              (list digest:md5 
                    digest:ripemd160
                    digest:dss1
                    digest:sha1
                    digest:sha224
                    digest:sha256
                    digest:sha384
                    digest:sha512)))
    (define hashes
      (filter identity
              (list md5 
                    ripemd160
                    dss1
                    sha1
                    sha224
                    sha256
                    sha384
                    sha512)))
    (define ciphers
      (filter identity
              (list cipher:des
                    cipher:des-ede
                    cipher:des-ede3
                    cipher:idea
                    cipher:bf
                    cipher:cast5
                    cipher:aes-128
                    cipher:aes-192
                    cipher:aes-256
                    cipher:camellia-128
                    cipher:camellia-192
                    cipher:camellia-256)))
    
    (define dhparams
      (list dh:192 dh:512 dh:1024 dh:2048 dh:4096))
    
    (when digest:sha1 (test-sha1))
    (for-each test-digest digests hashes)
    (for-each (lambda (x) (test-pubkey pkey:rsa x)) pkey:rsa:digests)
    (for-each (lambda (x) (test-pubkey pkey:dsa x))
              pkey:dsa:digests)
    (for-each test-cipher ciphers)
    (for-each (lambda (x) (test-encrypt/pkey x)) ciphers)
    (for-each test-dh dhparams)
    
    (check-report))
  
)