(module elliptic-curve-cryptography
  *
  (import
    scheme
    (chicken base)
    (only (chicken memory representation) record-instance? record-instance-slot)
    matchable
    modular-arithmetic elliptic-curve-parameters elliptic-curve-arithmetic)

;; Generate an ECDSA key pair and returns the public and private keys
(define (ecc-generate-keys parameters random-integer)
  (match-let* ([($ ec-parameters _ _ _ G n h params-name) parameters])
    (lambda ()
      (let* ([d (add1 (random-integer (sub1 n)))]
	     [P (with-elliptic-curve parameters (* G d))])
	(values P d)))))

;; Sign using ECDSA
(define (ecc-sign parameters random-integer)
  (match-let* ([($ ec-parameters _ _ _ G n h params-name) parameters])
    (lambda (d message)
      (let retry ()
	(let* ([k (add1 (random-integer (sub1 n)))]
	       [Q (with-elliptic-curve parameters (* G k))]
	       [r (modulo (real-part Q) n)])
	  (if (zero? r)
	      (retry)
	      (let ([s (with-modulus n (/ (+ (* r d) message) k))])
		(if (zero? s)
		    (retry)
		    (cons r s)))))))))

;; Verify signature using ECDSA
(define (ecc-verify parameters)
  (match-let* ([($ ec-parameters _ _ _ G n h params-name) parameters])
    (lambda (P message signature)
      (match-let ([(r . s) signature])
	(and (on-elliptic-curve? parameters P)
	     (< 0 r n)
	     (< 0 s n)
	     (with-modulus n
	       (let* ([1/s (/ s)]
		      [u1 (* 1/s message)]
		      [u2 (* 1/s r)])
		 (with-elliptic-curve parameters
		   (let* ([Q (+ (* G u1) (* P u2))]
			  [v (modulo (real-part Q) n)])
		     (= v r))))))))))
  
;; Generate a shared secret using ECKA
(define (ecc-generate-secret parameters)
  (match-let* ([($ ec-parameters _ _ _ G n h params-name) parameters])
    (lambda (d P)
      (unless (on-elliptic-curve? parameters P)
	(error 'ecc-generate-secret "public key not on the elliptic curve" P))
      (let* ([S (with-elliptic-curve parameters (* (* P h) (with-modulus n (/ d h))))])
	(if (zero? S)
	    (error 'ecc-generate-secret "derived secret is the neutral element")
	    S)))))

)

;; vim: set ai et ts=8 sts=2 sw=2 ft=scheme: ;;