schnorr-bip340.lisp

;;;; schnorr-bip340.lisp
;;;;
;;;; https://github.com/bitcoin/bips/blob/master/bip-0340/reference.py
;;;; https://github.com/bitcoin/bips/blob/master/bip-0340/test-vectors.csv
;;;;
;;;; sbcl --load schnorr-bip340.lisp --eval "(progn (run-tests) (quit))"

;;; Packages

(ql:quickload :ironclad)


;;; Globals

(defparameter +p+ #xFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFEFFFFFC2F)
(defparameter +n+ #xFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFEBAAEDCE6AF48A03BBFD25E8CD0364141)

(defparameter +g+ (cons #x79BE667EF9DCBBAC55A06295CE870B07029BFCDB2DCE28D959F2815B16F81798
                        #x483ADA7726A3C4655DA4FBFC0E1108A8FD17B448A68554199C47D08FFB10D4B8))


;;; Third Party Functions

;; https://en.wikipedia.org/wiki/Modular_exponentiation
;; https://rosettacode.org/wiki/Modular_exponentiation
(defun mod-expt (base power modulus)
  (loop with c = 1
        while (plusp power)
        do (when (oddp power)
             (setf c (mod (* base c) modulus)))
           (setf power (ash power -1))
           (setf base (mod (* base base) modulus))
        finally (return c)))


;;; Functions

(defun tagged-hash (tag msg)
  (let ((tag-hash (ironclad:digest-sequence :sha256 (string-to-octets tag))))
    (ironclad:digest-sequence :sha256 (concatenate '(vector (unsigned-byte 8))
                                                   tag-hash tag-hash msg))))


(defun is-infinite (point)
  (null point))


(defun x (point)
  (when (is-infinite point) (error "~S is infinite" point))
  (car point))


(defun y (point)
  (when (is-infinite point) (error "~S is infinite" point))
  (cdr point))


(defun point-add (p1 p2)
  (let (lam x3)
    (cond ((null p1)
           (return-from point-add p2))
          ((null p2)
           (return-from point-add p1))
          ((and (=  (x p1) (x p2))
                (/= (y p1) (y p2)))
           (return-from point-add nil))
          ((equal p1 p2)
           (setf lam (mod (* 3 (x p1) (x p1)
                             (mod-expt (* 2 (y p1)) (- +p+ 2) +p+))
                          +p+)))
          (t
           (setf lam (mod (* (- (y p2) (y p1))
                             (mod-expt (- (x p2) (x p1)) (- +p+ 2) +p+))
                          +p+))))
    (setf x3 (mod (- (* lam lam) (x p1) (x p2)) +p+))
    (cons x3 (mod (- (* lam (- (x p1) x3)) (y p1)) +p+))))


(defun point-mul (p n)
  (loop with r = nil
        for i from 0 below 256
        do (when (= 1 (logand (ash n (- i)) 1))
             (setf r (point-add r p)))
           (setf p (point-add p p))
        finally (return r)))


(defun bytes-from-int (x)
  (ironclad:integer-to-octets x :n-bits 256))  ; 32 bytes


(defun bytes-from-point (p)
  (bytes-from-int (x p)))


(defun xor-bytes (b0 b1)
  (loop for x across b0
        for y across b1
        collect (logxor x y) into lst
        finally (return (coerce lst '(vector (unsigned-byte 8))))))


(defun lift-x (x)
  (when (> x +p+)
    (return-from lift-x nil))
  (let* ((y-sq (mod (+ (mod-expt x 3 +p+) 7) +p+))
         (y (mod-expt y-sq (floor (+ +p+ 1) 4) +p+)))
    (if (/= (mod-expt y 2 +p+) y-sq)
        nil
        (cons x (if (= (logand y 1) 0)
                    y
                    (- +p+ y))))))


(defun pubkey-gen (seckey)
  (let ((d0 (ironclad:octets-to-integer seckey))
        p)
    (when (or (<= d0 1)
              (>= d0 (- +n+ 1)))
      (error "The secret key must be an integer between 1..n-1"))
    (setf p (point-mul +g+ d0))
    (when (null p)
      (error "P is null"))
    (bytes-from-point p)))


(defun schnorr-verify (msg pubkey sig)
  (when (/= (length msg) 32)
    (error "The message must be a 32-byte array."))
  (when (/= (length pubkey) 32)
    (error "The public key must be a 32-byte array."))
  (when (/= (length sig) 64)
    (error "The signature must be a 64-byte array."))
  (let ((p (lift-x (ironclad:octets-to-integer pubkey)))
        (r (ironclad:octets-to-integer (subseq sig 0 32)))
        (s (ironclad:octets-to-integer (subseq sig 32 64)))
        e rr)
    (when (or (null p)
              (>= r +p+)
              (>= s +n+))
      (return-from schnorr-verify nil))
    (setf e (mod (ironclad:octets-to-integer
                  (tagged-hash "BIP0340/challenge"
                           (concatenate 'vector (subseq sig 0 32) pubkey msg)))
                 +n+))
    (setf rr (point-add (point-mul +g+ s) (point-mul p (- +n+ e))))
    (when (or (null rr)
              (oddp (y rr))
              (/= (x rr) r))
      (return-from schnorr-verify nil))
    t))


(defun schnorr-sign (msg seckey aux-rand)
  (when (/= (length msg) 32)
    (error "MSG must be 32 bytes"))
  (when (/= (length aux-rand) 32)
    (error "AUX-RAND must be 32 bytes"))
  (let ((d0 (ironclad:octets-to-integer seckey))
        p d tt k0 r k e sig)
    (when (or (<= d0 1)
              (>= d0 (- +n+ 1)))
      (error "The secret key must be an integer between 1..n-1"))
    (setf p (point-mul +g+ d0))
    (when (null p)
      (error "P is null"))
    (setf d (if (evenp (y p))
                d0
                (- +n+ d0)))
    (setf tt (xor-bytes (bytes-from-int d)
                        (tagged-hash "BIP0340/aux" aux-rand)))
    (setf k0 (mod (ironclad:octets-to-integer
                   (tagged-hash "BIP0340/nonce"
                                (concatenate '(vector (unsigned-byte 8))
                                             tt
                                             (bytes-from-point p)
                                             msg)))
              +n+))
    (when (= k0 0)
      (error "Failure. This happens only with negligible probability."))
    (setf r (point-mul +g+ k0))
    (when (null r)
      (error "R is null."))
    (setf k (if (oddp (y r))
                (- +n+ k0)
                k0))
    (setf e (mod (ironclad:octets-to-integer
                  (tagged-hash "BIP0340/challenge"
                               (concatenate '(vector (unsigned-byte 8))
                                            (bytes-from-point r)
                                            (bytes-from-point p)
                                            msg)))
                 +n+))
    (setf sig (concatenate '(vector (unsigned-byte 8))
                           (bytes-from-point r)
                           (bytes-from-int (mod (+ k (* e d)) +n+))))
    (unless (schnorr-verify msg (bytes-from-point p) sig)
      (error "The created signature does not pass verification."))
    sig))


;;; Test Vectors

;; '(index seckey pubkey aux-rand msg sig verification-result comment)
(defvar +test-vectors+
  '((0 "0000000000000000000000000000000000000000000000000000000000000003" "F9308A019258C31049344F85F89D5229B531C845836F99B08601F113BCE036F9" "0000000000000000000000000000000000000000000000000000000000000000" "0000000000000000000000000000000000000000000000000000000000000000" "E907831F80848D1069A5371B402410364BDF1C5F8307B0084C55F1CE2DCA821525F66A4A85EA8B71E482A74F382D2CE5EBEEE8FDB2172F477DF4900D310536C0" t nil)
    (1 "B7E151628AED2A6ABF7158809CF4F3C762E7160F38B4DA56A784D9045190CFEF" "DFF1D77F2A671C5F36183726DB2341BE58FEAE1DA2DECED843240F7B502BA659" "0000000000000000000000000000000000000000000000000000000000000001" "243F6A8885A308D313198A2E03707344A4093822299F31D0082EFA98EC4E6C89" "6896BD60EEAE296DB48A229FF71DFE071BDE413E6D43F917DC8DCF8C78DE33418906D11AC976ABCCB20B091292BFF4EA897EFCB639EA871CFA95F6DE339E4B0A" t nil)
    (2 "C90FDAA22168C234C4C6628B80DC1CD129024E088A67CC74020BBEA63B14E5C9" "DD308AFEC5777E13121FA72B9CC1B7CC0139715309B086C960E18FD969774EB8" "C87AA53824B4D7AE2EB035A2B5BBBCCC080E76CDC6D1692C4B0B62D798E6D906" "7E2D58D8B3BCDF1ABADEC7829054F90DDA9805AAB56C77333024B9D0A508B75C" "5831AAEED7B44BB74E5EAB94BA9D4294C49BCF2A60728D8B4C200F50DD313C1BAB745879A5AD954A72C45A91C3A51D3C7ADEA98D82F8481E0E1E03674A6F3FB7" t nil)
    (3 "0B432B2677937381AEF05BB02A66ECD012773062CF3FA2549E44F58ED2401710" "25D1DFF95105F5253C4022F628A996AD3A0D95FBF21D468A1B33F8C160D8F517" "FFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFF" "FFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFF" "7EB0509757E246F19449885651611CB965ECC1A187DD51B64FDA1EDC9637D5EC97582B9CB13DB3933705B32BA982AF5AF25FD78881EBB32771FC5922EFC66EA3" t "test fails if msg is reduced modulo p or n")
    (4 nil "D69C3509BB99E412E68B0FE8544E72837DFA30746D8BE2AA65975F29D22DC7B9" nil "4DF3C3F68FCC83B27E9D42C90431A72499F17875C81A599B566C9889B9696703" "00000000000000000000003B78CE563F89A0ED9414F5AA28AD0D96D6795F9C6376AFB1548AF603B3EB45C9F8207DEE1060CB71C04E80F593060B07D28308D7F4" t nil)
    (5 nil "EEFDEA4CDB677750A420FEE807EACF21EB9898AE79B9768766E4FAA04A2D4A34" nil "243F6A8885A308D313198A2E03707344A4093822299F31D0082EFA98EC4E6C89" "6CFF5C3BA86C69EA4B7376F31A9BCB4F74C1976089B2D9963DA2E5543E17776969E89B4C5564D00349106B8497785DD7D1D713A8AE82B32FA79D5F7FC407D39B" nil "public key not on the curve")
    (6 nil "DFF1D77F2A671C5F36183726DB2341BE58FEAE1DA2DECED843240F7B502BA659" nil "243F6A8885A308D313198A2E03707344A4093822299F31D0082EFA98EC4E6C89" "FFF97BD5755EEEA420453A14355235D382F6472F8568A18B2F057A14602975563CC27944640AC607CD107AE10923D9EF7A73C643E166BE5EBEAFA34B1AC553E2" nil "has_even_y(R) is false")
    (7 nil "DFF1D77F2A671C5F36183726DB2341BE58FEAE1DA2DECED843240F7B502BA659" nil "243F6A8885A308D313198A2E03707344A4093822299F31D0082EFA98EC4E6C89" "1FA62E331EDBC21C394792D2AB1100A7B432B013DF3F6FF4F99FCB33E0E1515F28890B3EDB6E7189B630448B515CE4F8622A954CFE545735AAEA5134FCCDB2BD" nil "negated message")
    (8 nil "DFF1D77F2A671C5F36183726DB2341BE58FEAE1DA2DECED843240F7B502BA659" nil "243F6A8885A308D313198A2E03707344A4093822299F31D0082EFA98EC4E6C89" "6CFF5C3BA86C69EA4B7376F31A9BCB4F74C1976089B2D9963DA2E5543E177769961764B3AA9B2FFCB6EF947B6887A226E8D7C93E00C5ED0C1834FF0D0C2E6DA6" nil "negated s value")
    (9 nil "DFF1D77F2A671C5F36183726DB2341BE58FEAE1DA2DECED843240F7B502BA659" nil "243F6A8885A308D313198A2E03707344A4093822299F31D0082EFA98EC4E6C89" "0000000000000000000000000000000000000000000000000000000000000000123DDA8328AF9C23A94C1FEECFD123BA4FB73476F0D594DCB65C6425BD186051" nil "sG - eP is infinite. Test fails in  single verification if has_even_y(inf) is defined as true and x(inf) as 0")
    (10 nil "DFF1D77F2A671C5F36183726DB2341BE58FEAE1DA2DECED843240F7B502BA659" nil "243F6A8885A308D313198A2E03707344A4093822299F31D0082EFA98EC4E6C89" "00000000000000000000000000000000000000000000000000000000000000017615FBAF5AE28864013C099742DEADB4DBA87F11AC6754F93780D5A1837CF197" nil "sG - eP is infinite. Test fails in single verification if has_even_y(inf) is defined as true and x(inf) as 1")
    (11 nil "DFF1D77F2A671C5F36183726DB2341BE58FEAE1DA2DECED843240F7B502BA659" nil "243F6A8885A308D313198A2E03707344A4093822299F31D0082EFA98EC4E6C89" "4A298DACAE57395A15D0795DDBFD1DCB564DA82B0F269BC70A74F8220429BA1D69E89B4C5564D00349106B8497785DD7D1D713A8AE82B32FA79D5F7FC407D39B" nil "sig[0:32] is not an X coordinate on the curve")
    (12 nil "DFF1D77F2A671C5F36183726DB2341BE58FEAE1DA2DECED843240F7B502BA659" nil "243F6A8885A308D313198A2E03707344A4093822299F31D0082EFA98EC4E6C89" "FFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFEFFFFFC2F69E89B4C5564D00349106B8497785DD7D1D713A8AE82B32FA79D5F7FC407D39B" nil "sig[0:32] is equal to field size")
    (13 nil "DFF1D77F2A671C5F36183726DB2341BE58FEAE1DA2DECED843240F7B502BA659" nil "243F6A8885A308D313198A2E03707344A4093822299F31D0082EFA98EC4E6C89" "6CFF5C3BA86C69EA4B7376F31A9BCB4F74C1976089B2D9963DA2E5543E177769FFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFEBAAEDCE6AF48A03BBFD25E8CD0364141" nil "sig[32:64] is equal to curve order")
    (14 nil "FFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFEFFFFFC30" nil "243F6A8885A308D313198A2E03707344A4093822299F31D0082EFA98EC4E6C89" "6CFF5C3BA86C69EA4B7376F31A9BCB4F74C1976089B2D9963DA2E5543E17776969E89B4C5564D00349106B8497785DD7D1D713A8AE82B32FA79D5F7FC407D39B" nil "public key is not a valid X coordinate because it exceeds the field size")))

(defun run-tests ()
  (loop with all-passed = t
        for test in +test-vectors+
        for index    = (elt test 0)
        for seckey   = (when (elt test 1)
                         (ironclad:hex-string-to-byte-array (elt test 1)))
        for pubkey   = (ironclad:hex-string-to-byte-array (elt test 2))
        for aux-rand = (when (elt test 3)
                         (ironclad:hex-string-to-byte-array (elt test 3)))
        for msg      = (ironclad:hex-string-to-byte-array (elt test 4))
        for sig      = (ironclad:hex-string-to-byte-array (elt test 5))
        for result   = (elt test 6)
        for comment  = (elt test 7)
        for pubkey-actual = (when seckey (pubkey-gen seckey))
        for sig-actual = (when seckey (schnorr-sign msg seckey aux-rand))
        for result-actual = (schnorr-verify msg pubkey sig)
        do (format t "~%Test vector #~D:~%" index)
           (when seckey
             (if (equalp pubkey pubkey-actual)
                 (format t " * Passed key generation test.~%")
                 (progn (setf all-passed nil)
                        (format t " * Failed key generation.~%")
                        (format t "   Expected key: ~S~%" pubkey)
                        (format t "     Actual key: ~S~%" pubkey-actual)))
             (if (equalp sig sig-actual)
                 (format t " * Passed signing test.~%")
                 (progn (setf all-passed nil)
                        (format t " * Failed signing test.~%")
                        (format t "   Expected signature: ~S~%" sig)
                        (format t "     Actual signature: ~S~%" sig-actual))))
           (if (equalp result result-actual)
               (format t " * Passed verification test.~%")
               (progn (setf all-passed nil)
                      (format t " * Failed verification test.~%")
                      (format t "   Expected result: ~S~%" result)
                      (format t "     Actual result: ~S~%" result-actual)
                      (when comment
                        (format t "   Comment: ~A~%" comment))))
        finally (if all-passed
                    (format t "~%All test vectors passed.~%")
                    (format t "~%Some test vectors failed.~%"))
                (return all-passed)))

Translated from https://github.com/bitcoin/bips/blob/master/bip-0340/reference.py

Released under same license as Ironclad: BSD 3-Clause "New" or "Revised" License

https://github.com/akovalenko/bip0340 😭