;; -*- mode: Scheme; -*-
;;
;; This file is part of TweetNaCl for CHICKEN
;; Copyright (c) 2015 by Thomas Chust.  All rights reserved.
;;
;; Permission is hereby granted, free of charge, to any person
;; obtaining a copy of this software and associated documentation
;; files (the Software), to deal in the Software without restriction,
;; including without limitation the rights to use, copy, modify,
;; merge, publish, distribute, sublicense, and/or sell copies of the
;; Software, and to permit persons to whom the Software is furnished
;; to do so, subject to the following conditions:
;; 
;; The above copyright notice and this permission notice shall be
;; included in all copies or substantial portions of the Software.
;; 
;; THE SOFTWARE IS PROVIDED ASIS, WITHOUT WARRANTY OF ANY KIND,
;; EXPRESS OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF
;; MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND
;; NONINFRINGEMENT. IN NO EVENT SHALL THE AUTHORS OR COPYRIGHT HOLDERS
;; BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER LIABILITY, WHETHER IN AN
;; ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM, OUT OF OR IN
;; CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE
;; SOFTWARE.

(import
  (only (chicken blob) string->blob)
  tweetnacl srfi-4 test)

(define plain "Hello world! Let's use TweetNaCl for private communication :-)")

(test-group "asymmetric algorithms"

  (test-group "boxes"
    (let* ((alice-pk #${38ec1d223d95b4a71ba93d1dec4aa99dadc9887f10eb467ab0e148bea0bea03d})
	   (alice-sk #${6c0d4a72b5f7e7f816f5f0f9ab992893a10f49b8d61eaa3c2d3ddec6c76efa24})
	   (bob-pk #${1a29d867ee740c0c6acec12e21a5b4f845d237e5236e3769ec3ce4fe61822b07})
	   (bob-sk #${284e1c6e7b244d432d56b5d210be997ad703d1f4aae873efab1e3ad961a40ee9})
	   (bad-sk #${284e1c6e7b244d43fffffffffffffffffffffffffffff3efab1e3ad961a40ee9})
	   (nonce (make-u8vector asymmetric-box-noncebytes 42))
	   (bad-nonce (make-u8vector asymmetric-box-noncebytes 23))
	   (crypt ((asymmetric-box bob-pk alice-sk) plain nonce)))
      (test "box roundtrip" plain ((asymmetric-unbox alice-pk bob-sk) crypt nonce))
      (test "scalar multiplication primitive" (scalarmult* alice-sk bob-pk) (scalarmult* bob-sk alice-pk))
      (test "secret box compatibility" plain ((symmetric-unbox (derive-symmetric-box-key alice-pk bob-sk)) crypt nonce))
      (test-assert "bad nonce detection" (not ((asymmetric-unbox alice-pk bob-sk) crypt bad-nonce)))
      (test-assert "bad secret key detection" (not ((asymmetric-unbox alice-pk bad-sk) crypt nonce)))
      (string-set! crypt 23 #\nul)
      (test-assert "damage detection" (not ((asymmetric-unbox alice-pk bob-sk) crypt nonce)))))

  (test-group "signatures"
    (let* ((eve-pk #${44559306e5f711b5be074733eb6e7468ecd482f0a689997a14505cf58ad4de43})
	   (eve-sk #${0718fd32289ec592cfd2cdc0f838bdcdaffe838d5d0a75ead1c49fd754d422c544559306e5f711b5be074733eb6e7468ecd482f0a689997a14505cf58ad4de43})
	   (bad-pk #${44559306e5f7ffffffffffffffffffffffffffffa689997a14505cf58ad4de43})
	   (signed ((asymmetric-sign eve-sk) plain)))
      (test "sign roundtrip" plain ((asymmetric-verify eve-pk) signed))
      (test-assert "bad public key detection" (not ((asymmetric-verify bad-pk) signed)))
      (string-set! signed 23 #\nul)
      (test-assert "damage detection" (not ((asymmetric-verify eve-pk) signed)))))

)

(test-group "symmetric algorithms"

  (test-group "boxes"
    (let* ((eve-k #${b4d3f64119e17ab5da5bb5618449e690fed752594bd72277e6f20caee12d1a0c})
	   (bad-k #${b4d3f64ffffffffffffff5618449e690ffffffffffffff77e6f20caee12d1a0c})
	   (nonce (make-u8vector asymmetric-box-noncebytes 42))
	   (bad-nonce (make-u8vector asymmetric-box-noncebytes 23))
	   (crypt ((symmetric-box eve-k) plain nonce)))
      (test "box roundtrip" plain ((symmetric-unbox eve-k) crypt nonce))
      (test-assert "bad nonce detection" (not ((symmetric-unbox eve-k) crypt bad-nonce)))
      (test-assert "bad key detection" (not ((symmetric-unbox bad-k) crypt nonce)))
      (string-set! crypt 23 #\nul)
      (test-assert "damage detection" (not ((symmetric-unbox eve-k) crypt nonce)))))

  (test-group "one-time signatures"
    (let* ((eve-k #${7abfa988ef67acfd36ae0ecfebc7997d377e6012df62ad6ff53d2030cc33596b})
	   (bad-k #${7abfa988ef67acfd36ae0ecfebc7997d377e601ffffffffffffffffffff3596b})
	   (signed ((symmetric-sign eve-k) plain)))
      (test "sign roundtrip" plain ((symmetric-verify eve-k) signed))
      (test-assert "bad key detection" (not ((symmetric-verify bad-k) signed)))
      (string-set! signed 23 #\nul)
      (test-assert "damage detection" (not ((symmetric-verify eve-k) signed)))))

  (test-group "random streams"
    (let ((alice-pk #${38ec1d223d95b4a71ba93d1dec4aa99dadc9887f10eb467ab0e148bea0bea03d})
	   (alice-sk #${6c0d4a72b5f7e7f816f5f0f9ab992893a10f49b8d61eaa3c2d3ddec6c76efa24})
	   (bob-pk #${1a29d867ee740c0c6acec12e21a5b4f845d237e5236e3769ec3ce4fe61822b07})
	   (bob-sk #${284e1c6e7b244d432d56b5d210be997ad703d1f4aae873efab1e3ad961a40ee9})
           (rng-k #${4b94b23477e98dd33f657c9f657251bc9a93796f3b7176697e1744674d46aea6})
          (nonce (make-u8vector random-stream-noncebytes 42)))
      (test "xor roundtrip" plain (stream-xor! (stream-xor plain (open-random-stream rng-k nonce)) (open-random-stream rng-k nonce)))
      (test "key agreement" plain (stream-xor! (stream-xor plain (open-random-stream (derive-random-stream-key alice-pk bob-sk) nonce)) (open-random-stream (derive-random-stream-key bob-pk alice-sk) nonce)))))

  (test "hash"
	#${26b1e0b85b28fcbe81a877b34c88e190f2dae3ee5982bc17319be324704d965e0870666966742457ae395773577514fb583171bd456563cbe89df5f17ae4e931}
	(string->blob (hash plain)))

)

(test-exit)